From 91a40ac786c92e10fb5574e19ca1ef28887006ed Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Beno=C3=AEt=20Vi=C3=A9?= <benoit.vie@meteo.fr> Date: Tue, 26 Apr 2022 10:28:06 +0200 Subject: [PATCH] Initial ICCARE_BASE branch from ICCARE_BASE user source - does not compile ! --- src/ICCARE_BASE/BASIC.f90 | 43064 ---------------- src/ICCARE_BASE/aer2lima.f90 | 375 - src/ICCARE_BASE/aerocamsn.f90 | 82 - src/ICCARE_BASE/allocate_physio.F90 | 175 - src/ICCARE_BASE/allocate_teb_veg_pgd.F90 | 139 - src/ICCARE_BASE/ch_aer_cond.f90 | 124 - src/ICCARE_BASE/ch_aer_driver.f90 | 357 - src/ICCARE_BASE/ch_aer_eqm_initn.f90 | 421 - src/ICCARE_BASE/ch_aer_growth.f90 | 26 - src/ICCARE_BASE/ch_aer_kulmala.f90 | 178 - src/ICCARE_BASE/ch_aer_maattanen_ionind.f90 | 644 - src/ICCARE_BASE/ch_aer_maattanen_neutral.f90 | 335 - src/ICCARE_BASE/ch_aer_mineral.f90 | 229 - src/ICCARE_BASE/ch_aer_mod_init.f90 | 311 - src/ICCARE_BASE/ch_aer_mode_merging.f90 | 176 - src/ICCARE_BASE/ch_aer_nucl.f90 | 249 - src/ICCARE_BASE/ch_aer_solv.f90 | 434 - src/ICCARE_BASE/ch_aer_vehkamaki.f90 | 216 - src/ICCARE_BASE/ch_ini_orilam.f90 | 287 - src/ICCARE_BASE/ch_init_fieldn.f90 | 447 - src/ICCARE_BASE/ch_meteo_trans_lima.f90 | 348 - src/ICCARE_BASE/ch_monitorn.f90 | 1628 - src/ICCARE_BASE/ch_orilam.f90 | 155 - src/ICCARE_BASE/compute_isba_parameters.F90 | 1135 - src/ICCARE_BASE/convert_patch_isba.F90 | 1012 - src/ICCARE_BASE/coupling_dmsn.F90 | 58 - src/ICCARE_BASE/coupling_isban.F90 | 1443 - src/ICCARE_BASE/coupling_megann.F90 | 247 - src/ICCARE_BASE/coupling_seaflux_orogn.F90 | 215 - src/ICCARE_BASE/coupling_seaflux_sbln.F90 | 359 - src/ICCARE_BASE/coupling_seafluxn.F90 | 867 - src/ICCARE_BASE/coupling_sltn.F90 | 303 - src/ICCARE_BASE/coupling_surf_atmn.F90 | 677 - src/ICCARE_BASE/coupling_tebn.F90 | 1065 - src/ICCARE_BASE/default_desfmn.f90 | 1409 - src/ICCARE_BASE/dustcamsn.f90 | 214 - src/ICCARE_BASE/emproc.F90 | 292 - src/ICCARE_BASE/endstep.f90 | 668 - src/ICCARE_BASE/get_vegtype_2_patch_mask.F90 | 84 - src/ICCARE_BASE/ground_paramn.f90 | 1034 - src/ICCARE_BASE/ini_budget.f90 | 4727 -- src/ICCARE_BASE/ini_lb.f90 | 1672 - src/ICCARE_BASE/ini_lima_cold_mixed.f90 | 1464 - src/ICCARE_BASE/ini_modeln.f90 | 2696 - src/ICCARE_BASE/ini_nsv.f90 | 893 - src/ICCARE_BASE/ini_prog_var.f90 | 499 - src/ICCARE_BASE/init_megann.F90 | 486 - src/ICCARE_BASE/init_salt.f90 | 68 - src/ICCARE_BASE/init_slt.F90 | 79 - src/ICCARE_BASE/init_surf_atmn.F90 | 859 - src/ICCARE_BASE/lima_mixed_fast_processes.f90 | 1863 - src/ICCARE_BASE/mgn2mech.F90 | 323 - src/ICCARE_BASE/mnh_oasis_recv.F90 | 253 - src/ICCARE_BASE/modd_ch_aeron.f90 | 225 - src/ICCARE_BASE/modd_ch_aerosol.f90 | 278 - src/ICCARE_BASE/modd_ch_surfn.F90 | 97 - src/ICCARE_BASE/modd_csts_salt.f90 | 55 - src/ICCARE_BASE/modd_dms_surf_fieldsn.F90 | 74 - src/ICCARE_BASE/modd_dmsn.F90 | 55 - src/ICCARE_BASE/modd_dust.f90 | 109 - src/ICCARE_BASE/modd_isban.F90 | 820 - src/ICCARE_BASE/modd_megann.F90 | 207 - src/ICCARE_BASE/modd_param_lima.f90 | 224 - src/ICCARE_BASE/modd_param_lima_cold.f90 | 163 - src/ICCARE_BASE/modd_prep_real.f90 | 120 - src/ICCARE_BASE/modd_salt.f90 | 108 - src/ICCARE_BASE/modd_slt_surf.F90 | 32 - src/ICCARE_BASE/modd_surfexn.F90 | 285 - src/ICCARE_BASE/mode_aero_psd.f90 | 1089 - src/ICCARE_BASE/mode_dust_psd.f90 | 826 - src/ICCARE_BASE/mode_gamma_etc.F90 | 554 - src/ICCARE_BASE/mode_megan.F90 | 1235 - src/ICCARE_BASE/mode_salt_psd.f90 | 836 - src/ICCARE_BASE/modeln.f90 | 2323 - src/ICCARE_BASE/modn_ch_orilam.f90 | 55 - src/ICCARE_BASE/modn_param_lima.f90 | 36 - src/ICCARE_BASE/modn_surf_atmn.F90 | 270 - src/ICCARE_BASE/pgd_dms.F90 | 197 - src/ICCARE_BASE/pgd_surf_atm.F90 | 257 - src/ICCARE_BASE/prep_ideal_case.f90 | 1948 - src/ICCARE_BASE/prep_real_case.f90 | 1420 - src/ICCARE_BASE/put_sfxcpln.F90 | 190 - src/ICCARE_BASE/rain_ice_elec.f90 | 5850 --- src/ICCARE_BASE/read_chem_data_cams_case.f90 | 1108 - .../read_chem_data_mozart_case.f90 | 812 - src/ICCARE_BASE/read_dmsn.F90 | 102 - src/ICCARE_BASE/read_exsegn.f90 | 2999 -- src/ICCARE_BASE/read_field.f90 | 1963 - .../read_lima_data_netcdf_case.f90 | 898 - src/ICCARE_BASE/read_nam_pgd_chemistry.F90 | 120 - src/ICCARE_BASE/read_nam_pgd_dms.F90 | 154 - src/ICCARE_BASE/resolved_cloud.f90 | 1105 - src/ICCARE_BASE/saltcamsn.f90 | 281 - src/ICCARE_BASE/saltlfin.f90 | 280 - src/ICCARE_BASE/set_mask.f90 | 181 - src/ICCARE_BASE/surfex_alloc.F90 | 244 - src/ICCARE_BASE/update_esm_surf_atmn.F90 | 304 - src/ICCARE_BASE/update_esm_tebn.F90 | 199 - src/ICCARE_BASE/ver_prep_netcdf_case.f90 | 222 - src/ICCARE_BASE/write_diag_pgd_isban.F90 | 642 - src/ICCARE_BASE/write_diag_seb_isban.F90 | 2166 - src/ICCARE_BASE/write_lbn.f90 | 867 - src/ICCARE_BASE/write_lfifm1_for_diag.f90 | 4136 -- src/ICCARE_BASE/write_lfin.f90 | 2600 - src/ICCARE_BASE/write_pgd_surf_atmn.F90 | 216 - src/ICCARE_BASE/writesurf_dmsn.F90 | 91 - src/ICCARE_BASE/writesurf_isban.F90 | 550 - src/MNH/BASIC.f90 | 18081 +++---- src/MNH/ch_aer_driver.f90 | 448 +- src/MNH/ch_aer_eqm_initn.f90 | 20 +- src/MNH/ch_aer_growth.f90 | 252 +- src/MNH/ch_aer_mineral.f90 | 128 +- src/MNH/ch_aer_nucl.f90 | 320 +- src/MNH/ch_aer_solv.f90 | 465 +- src/MNH/ch_ini_orilam.f90 | 322 +- src/MNH/ch_init_fieldn.f90 | 55 +- src/MNH/ch_monitorn.f90 | 235 +- src/MNH/ch_orilam.f90 | 130 +- src/MNH/default_desfmn.f90 | 5 + src/MNH/endstep.f90 | 24 +- src/MNH/ground_paramn.f90 | 4 +- src/MNH/ini_budget.f90 | 33 +- src/MNH/ini_lb.f90 | 46 +- src/MNH/ini_lima_cold_mixed.f90 | 120 +- src/MNH/ini_modeln.f90 | 3 +- src/MNH/ini_nsv.f90 | 2 +- src/MNH/ini_prog_var.f90 | 19 +- src/MNH/init_salt.f90 | 44 +- src/MNH/lima_mixed_fast_processes.f90 | 2003 +- src/MNH/mnh_oasis_recv.F90 | 1 + src/MNH/modd_ch_aeron.f90 | 217 +- src/MNH/modd_ch_aerosol.f90 | 291 +- src/MNH/modd_csts_salt.f90 | 3 +- src/MNH/modd_dust.f90 | 5 +- src/MNH/modd_param_lima.f90 | 12 +- src/MNH/modd_param_lima_cold.f90 | 47 +- src/MNH/modd_prep_real.f90 | 3 + src/MNH/modd_salt.f90 | 34 +- src/MNH/mode_aero_psd.f90 | 359 +- src/MNH/mode_dust_psd.f90 | 101 +- src/MNH/mode_salt_psd.f90 | 69 +- src/MNH/modeln.f90 | 2 + src/MNH/modn_ch_orilam.f90 | 47 +- src/MNH/modn_param_lima.f90 | 2 +- src/MNH/prep_ideal_case.f90 | 15 + src/MNH/prep_real_case.f90 | 194 +- src/MNH/rain_ice_elec.f90 | 3 +- src/MNH/read_exsegn.f90 | 70 +- src/MNH/read_field.f90 | 11 +- src/MNH/resolved_cloud.f90 | 75 +- src/MNH/saltlfin.f90 | 31 +- src/MNH/set_mask.f90 | 96 +- src/MNH/ver_prep_netcdf_case.f90 | 19 +- src/MNH/write_lbn.f90 | 12 +- src/MNH/write_lfifm1_for_diag.f90 | 4 +- src/MNH/write_lfin.f90 | 20 +- src/SURFEX/allocate_physio.F90 | 8 +- src/SURFEX/allocate_teb_veg_pgd.F90 | 1 + src/SURFEX/compute_isba_parameters.F90 | 1 + src/SURFEX/convert_patch_isba.F90 | 10 + src/SURFEX/coupling_isban.F90 | 52 +- src/SURFEX/coupling_megann.F90 | 49 +- src/SURFEX/coupling_seaflux_orogn.F90 | 5 +- src/SURFEX/coupling_seaflux_sbln.F90 | 6 +- src/SURFEX/coupling_seafluxn.F90 | 35 +- src/SURFEX/coupling_sltn.F90 | 75 +- src/SURFEX/coupling_tebn.F90 | 8 +- src/SURFEX/get_vegtype_2_patch_mask.F90 | 3 +- src/SURFEX/init_megann.F90 | 106 +- src/SURFEX/init_slt.F90 | 65 +- src/SURFEX/init_surf_atmn.F90 | 74 +- src/SURFEX/modd_ch_surfn.F90 | 13 +- src/SURFEX/modd_isban.F90 | 4 +- src/SURFEX/modd_megann.F90 | 13 +- src/SURFEX/modd_slt_surf.F90 | 9 +- src/SURFEX/modd_surfexn.F90 | 5 + src/SURFEX/modn_surf_atmn.F90 | 8 +- src/SURFEX/pgd_surf_atm.F90 | 7 +- src/SURFEX/put_sfxcpln.F90 | 12 +- src/SURFEX/read_nam_pgd_chemistry.F90 | 10 +- src/SURFEX/surfex_alloc.F90 | 6 + src/SURFEX/update_esm_surf_atmn.F90 | 67 +- src/SURFEX/write_diag_pgd_isban.F90 | 14 + src/SURFEX/write_diag_seb_isban.F90 | 26 +- src/SURFEX/write_pgd_surf_atmn.F90 | 14 +- src/SURFEX/writesurf_isban.F90 | 23 +- 186 files changed, 13852 insertions(+), 130921 deletions(-) delete mode 100644 src/ICCARE_BASE/BASIC.f90 delete mode 100644 src/ICCARE_BASE/aer2lima.f90 delete mode 100644 src/ICCARE_BASE/aerocamsn.f90 delete mode 100644 src/ICCARE_BASE/allocate_physio.F90 delete mode 100644 src/ICCARE_BASE/allocate_teb_veg_pgd.F90 delete mode 100644 src/ICCARE_BASE/ch_aer_cond.f90 delete mode 100644 src/ICCARE_BASE/ch_aer_driver.f90 delete mode 100644 src/ICCARE_BASE/ch_aer_eqm_initn.f90 delete mode 100644 src/ICCARE_BASE/ch_aer_growth.f90 delete mode 100644 src/ICCARE_BASE/ch_aer_kulmala.f90 delete mode 100644 src/ICCARE_BASE/ch_aer_maattanen_ionind.f90 delete mode 100644 src/ICCARE_BASE/ch_aer_maattanen_neutral.f90 delete mode 100644 src/ICCARE_BASE/ch_aer_mineral.f90 delete mode 100644 src/ICCARE_BASE/ch_aer_mod_init.f90 delete mode 100644 src/ICCARE_BASE/ch_aer_mode_merging.f90 delete mode 100644 src/ICCARE_BASE/ch_aer_nucl.f90 delete mode 100644 src/ICCARE_BASE/ch_aer_solv.f90 delete mode 100644 src/ICCARE_BASE/ch_aer_vehkamaki.f90 delete mode 100644 src/ICCARE_BASE/ch_ini_orilam.f90 delete mode 100644 src/ICCARE_BASE/ch_init_fieldn.f90 delete mode 100644 src/ICCARE_BASE/ch_meteo_trans_lima.f90 delete mode 100644 src/ICCARE_BASE/ch_monitorn.f90 delete mode 100644 src/ICCARE_BASE/ch_orilam.f90 delete mode 100644 src/ICCARE_BASE/compute_isba_parameters.F90 delete mode 100644 src/ICCARE_BASE/convert_patch_isba.F90 delete mode 100644 src/ICCARE_BASE/coupling_dmsn.F90 delete mode 100644 src/ICCARE_BASE/coupling_isban.F90 delete mode 100644 src/ICCARE_BASE/coupling_megann.F90 delete mode 100644 src/ICCARE_BASE/coupling_seaflux_orogn.F90 delete mode 100644 src/ICCARE_BASE/coupling_seaflux_sbln.F90 delete mode 100644 src/ICCARE_BASE/coupling_seafluxn.F90 delete mode 100644 src/ICCARE_BASE/coupling_sltn.F90 delete mode 100644 src/ICCARE_BASE/coupling_surf_atmn.F90 delete mode 100644 src/ICCARE_BASE/coupling_tebn.F90 delete mode 100644 src/ICCARE_BASE/default_desfmn.f90 delete mode 100644 src/ICCARE_BASE/dustcamsn.f90 delete mode 100644 src/ICCARE_BASE/emproc.F90 delete mode 100644 src/ICCARE_BASE/endstep.f90 delete mode 100644 src/ICCARE_BASE/get_vegtype_2_patch_mask.F90 delete mode 100644 src/ICCARE_BASE/ground_paramn.f90 delete mode 100644 src/ICCARE_BASE/ini_budget.f90 delete mode 100644 src/ICCARE_BASE/ini_lb.f90 delete mode 100644 src/ICCARE_BASE/ini_lima_cold_mixed.f90 delete mode 100644 src/ICCARE_BASE/ini_modeln.f90 delete mode 100644 src/ICCARE_BASE/ini_nsv.f90 delete mode 100644 src/ICCARE_BASE/ini_prog_var.f90 delete mode 100644 src/ICCARE_BASE/init_megann.F90 delete mode 100644 src/ICCARE_BASE/init_salt.f90 delete mode 100644 src/ICCARE_BASE/init_slt.F90 delete mode 100644 src/ICCARE_BASE/init_surf_atmn.F90 delete mode 100644 src/ICCARE_BASE/lima_mixed_fast_processes.f90 delete mode 100644 src/ICCARE_BASE/mgn2mech.F90 delete mode 100644 src/ICCARE_BASE/mnh_oasis_recv.F90 delete mode 100644 src/ICCARE_BASE/modd_ch_aeron.f90 delete mode 100644 src/ICCARE_BASE/modd_ch_aerosol.f90 delete mode 100644 src/ICCARE_BASE/modd_ch_surfn.F90 delete mode 100644 src/ICCARE_BASE/modd_csts_salt.f90 delete mode 100644 src/ICCARE_BASE/modd_dms_surf_fieldsn.F90 delete mode 100644 src/ICCARE_BASE/modd_dmsn.F90 delete mode 100644 src/ICCARE_BASE/modd_dust.f90 delete mode 100644 src/ICCARE_BASE/modd_isban.F90 delete mode 100644 src/ICCARE_BASE/modd_megann.F90 delete mode 100644 src/ICCARE_BASE/modd_param_lima.f90 delete mode 100644 src/ICCARE_BASE/modd_param_lima_cold.f90 delete mode 100644 src/ICCARE_BASE/modd_prep_real.f90 delete mode 100644 src/ICCARE_BASE/modd_salt.f90 delete mode 100644 src/ICCARE_BASE/modd_slt_surf.F90 delete mode 100644 src/ICCARE_BASE/modd_surfexn.F90 delete mode 100644 src/ICCARE_BASE/mode_aero_psd.f90 delete mode 100644 src/ICCARE_BASE/mode_dust_psd.f90 delete mode 100644 src/ICCARE_BASE/mode_gamma_etc.F90 delete mode 100644 src/ICCARE_BASE/mode_megan.F90 delete mode 100644 src/ICCARE_BASE/mode_salt_psd.f90 delete mode 100644 src/ICCARE_BASE/modeln.f90 delete mode 100644 src/ICCARE_BASE/modn_ch_orilam.f90 delete mode 100644 src/ICCARE_BASE/modn_param_lima.f90 delete mode 100644 src/ICCARE_BASE/modn_surf_atmn.F90 delete mode 100644 src/ICCARE_BASE/pgd_dms.F90 delete mode 100644 src/ICCARE_BASE/pgd_surf_atm.F90 delete mode 100644 src/ICCARE_BASE/prep_ideal_case.f90 delete mode 100644 src/ICCARE_BASE/prep_real_case.f90 delete mode 100644 src/ICCARE_BASE/put_sfxcpln.F90 delete mode 100644 src/ICCARE_BASE/rain_ice_elec.f90 delete mode 100644 src/ICCARE_BASE/read_chem_data_cams_case.f90 delete mode 100644 src/ICCARE_BASE/read_chem_data_mozart_case.f90 delete mode 100644 src/ICCARE_BASE/read_dmsn.F90 delete mode 100644 src/ICCARE_BASE/read_exsegn.f90 delete mode 100644 src/ICCARE_BASE/read_field.f90 delete mode 100644 src/ICCARE_BASE/read_lima_data_netcdf_case.f90 delete mode 100644 src/ICCARE_BASE/read_nam_pgd_chemistry.F90 delete mode 100644 src/ICCARE_BASE/read_nam_pgd_dms.F90 delete mode 100644 src/ICCARE_BASE/resolved_cloud.f90 delete mode 100644 src/ICCARE_BASE/saltcamsn.f90 delete mode 100644 src/ICCARE_BASE/saltlfin.f90 delete mode 100644 src/ICCARE_BASE/set_mask.f90 delete mode 100644 src/ICCARE_BASE/surfex_alloc.F90 delete mode 100644 src/ICCARE_BASE/update_esm_surf_atmn.F90 delete mode 100644 src/ICCARE_BASE/update_esm_tebn.F90 delete mode 100644 src/ICCARE_BASE/ver_prep_netcdf_case.f90 delete mode 100644 src/ICCARE_BASE/write_diag_pgd_isban.F90 delete mode 100644 src/ICCARE_BASE/write_diag_seb_isban.F90 delete mode 100644 src/ICCARE_BASE/write_lbn.f90 delete mode 100644 src/ICCARE_BASE/write_lfifm1_for_diag.f90 delete mode 100644 src/ICCARE_BASE/write_lfin.f90 delete mode 100644 src/ICCARE_BASE/write_pgd_surf_atmn.F90 delete mode 100644 src/ICCARE_BASE/writesurf_dmsn.F90 delete mode 100644 src/ICCARE_BASE/writesurf_isban.F90 mode change 100755 => 100644 src/MNH/BASIC.f90 diff --git a/src/ICCARE_BASE/BASIC.f90 b/src/ICCARE_BASE/BASIC.f90 deleted file mode 100644 index b08332e85..000000000 --- a/src/ICCARE_BASE/BASIC.f90 +++ /dev/null @@ -1,43064 +0,0 @@ -! -!======================================================================== -! -! The following species appear on the left hand side of a reaction, -! but they are not in the list of prognostic variables. Make sure that -! they are defined elsewhere (in begin_module as TPK%something): -! H2 -! O1D -! W_O2 -! O3P -! H2O -! CO2 -! N2 -! O2 -! -!======================================================================== -! -! The following species appear on the right hand side of a reaction, -! but they are not in the list of prognostic variables. Make sure that -! they are really final products or defined elsewhere: -! H2 -! O1D -! O3P -! H2O -! CO2 -! N2 -! O2 -! -!======================================================================== -! -! END of preprocessor comments -! -!======================================================================== -! -! the chemical reactions implemented are the following ... -! -! K001=!ZRATES(:,001)::NO2-->O3P+NO -! K002=!ZRATES(:,002)::O3-->O1D+O2 -! K003=!ZRATES(:,003)::O3-->O3P+O2 -! K004=!ZRATES(:,004)::HONO-->OH+NO -! K005=!ZRATES(:,005)::HNO3-->OH+NO2 -! K006=!ZRATES(:,006)::HNO4-->0.65*HO2+0.65*NO2+0.35*OH+0.35*NO3 -! K007=!ZRATES(:,007)::NO3-->NO+O2 -! K008=!ZRATES(:,008)::NO3-->NO2+O3P -! K009=!ZRATES(:,009)::H2O2-->OH+OH -! K010=!ZRATES(:,010)::HCHO-->H2+CO -! K011=!ZRATES(:,011)::HCHO-->HO2+HO2+CO -! K012=!ZRATES(:,012)::ALD-->MO2+HO2+CO -! K013=!ZRATES(:,013)::OP1-->HCHO+HO2+OH -! K014=!ZRATES(:,014)::OP2-->0.96205*ALD+0.96205*HO2+0.03795*MO2+OH -! K015=!ZRATES(:,015)::KET-->1.00000*CARBOP+1.00000*ALKAP -! K016=!ZRATES(:,016)::CARBO-->0.06517*HCHO+0.69622*CARBOP+0.75830*HO2+0.91924*CO+0.20842*H2 -! K017=!ZRATES(:,017)::ONIT-->0.20*ALD+0.80*KET+HO2+NO2 -! K018=TPK%M*6.00E-34*(TPK%T/300)**(-2.3)::O3P+O2-->O3 -! K019=8.00E-12*exp(-(2060.0/TPK%T))::O3P+O3-->2.0*O2 -! K020=1.80E-11*exp(-(-110.0/TPK%T))::O1D+N2-->O3P+N2 -! K021=3.20E-11*exp(-(-70.0/TPK%T))::O1D+O2-->O3P+O2 -! K022=2.20E-10::O1D+H2O-->OH+OH -! K023=1.60E-12*exp(-(940.0/TPK%T))::O3+OH-->HO2+O2 -! K024=1.10E-14*exp(-(500.0/TPK%T))::O3+HO2-->OH+2.0*O2 -! K025=4.80E-11*exp(-(-250.0/TPK%T))::OH+HO2-->H2O+O2 -! K026=2.90E-12*exp(-(160.0/TPK%T))::H2O2+OH-->HO2+H2O -! K027=2.3E-13*EXP(600./TPK%T)+1.7E-33*TPK%M*EXP(1000./TPK%T)::HO2+HO2-->H2O2+O2 -! K028=3.22E-34*EXP(2800./TPK%T)+2.38E-54*TPK%M*EXP(3200./TPK%T)::HO2+HO2+H2O-->H2O2+H2O+O2 -! K029=@TROE(1.,9.00E-32,1.5,3.00E-11,0.0,TPK%M,TPK%T,KVECNPT)::O3P+NO-->NO2 -! K030=6.50E-12*exp(-(-120.0/TPK%T))::O3P+NO2-->NO+O2 -! K031=@TROE(1.,9.00E-32,2.0,2.20E-11,0.0,TPK%M,TPK%T,KVECNPT)::O3P+NO2-->NO3 -! K032=@TROE(1.,7.00E-31,2.6,1.50E-11,0.5,TPK%M,TPK%T,KVECNPT)::OH+NO-->HONO -! K033=@TROE(1.,2.60E-30,3.2,2.40E-11,1.3,TPK%M,TPK%T,KVECNPT)::OH+NO2-->HNO3 -! K034=2.20E-11::OH+NO3-->NO2+HO2 -! K035=3.70E-12*exp(-(-250.0/TPK%T))::HO2+NO-->NO2+OH -! K036=@TROE(1.,1.80E-31,3.2,4.70E-12,1.4,TPK%M,TPK%T,KVECNPT)::HO2+NO2-->HNO4 -! K037=@TROE_EQUIL(1.80E-31,3.2,4.70E-12,1.4,4.76E+26,10900.,TPK%M,TPK%T,KVECNPT)::HNO4-->HO2+NO2 -! K038=3.50E-12::HO2+NO3-->0.3*HNO3+0.7*NO2+0.7*OH -! K039=1.80E-11*exp(-(390.0/TPK%T))::OH+HONO-->H2O+NO2 -! K040=(7.2E-15*EXP(785/TPK%T))+(1.9E-33*EXP(725/TPK%T)*TPK%M)/(1+(1.9E-33*EXP(725/TPK%T)*TPK%M)/(4.1E-16*EXP(1440/TPK%T)))::OH+HNO3-->NO3+H2O -! K041=1.30E-12*exp(-(-380.0/TPK%T))::OH+HNO4-->NO2+H2O+O2 -! K042=2.00E-12*exp(-(1400.0/TPK%T))::O3+NO-->NO2+O2 -! K043=1.20E-13*exp(-(2450.0/TPK%T))::O3+NO2-->NO3+O2 -! K044=3.30E-39*exp(-(-530.0/TPK%T))::NO+NO+O2-->NO2+NO2 -! K045=1.50E-11*exp(-(-170.0/TPK%T))::NO3+NO-->NO2+NO2 -! K046=4.50E-14*exp(-(1260.0/TPK%T))::NO3+NO2-->NO+NO2+O2 -! K047=@TROE(1.,2.20E-30,3.9,1.50E-12,0.7,TPK%M,TPK%T,KVECNPT)::NO3+NO2-->N2O5 -! K048=@TROE_EQUIL(2.20E-30,3.9,1.50E-12,0.7,3.70E+26,11000.0,TPK%M,TPK%T,KVECNPT)::N2O5-->NO2+NO3 -! K049=8.50E-13*exp(-(2450.0/TPK%T))::NO3+NO3-->NO2+NO2+O2 -! K050=3.30E-12*exp(-(900.0/TPK%T))::NH3+OH--> -! K051=5.50E-12*exp(-(2000.0/TPK%T))::OH+H2-->H2O+HO2 -! K052=@TROE(1.,3.00E-31,3.3,1.50E-12,0.0,TPK%M,TPK%T,KVECNPT)::OH+SO2-->SULF+HO2 -! K053=1.5E-13*(1.+2.439E-20*TPK%M)::CO+OH-->HO2+CO2 -! K054=6.00E-11::BIO+O3P-->0.91868*ALKE+0.05*HCHO+0.02*OH+0.01*CO+0.13255*CARBO+0.28*HO2+0.15*XO2 -! K055=0.00E-01*exp(-(-13.0/TPK%T))::CARBO+O3P-->ALD -! K056=TPK%T*TPK%T*7.44E-18*exp(-(1361./TPK%T))::CH4+OH-->MO2+H2O -! K057=1.51E-17*TPK%T*TPK%T*exp(-(492./TPK%T))::ETH+OH-->ALKAP -! K058=3.76E-12*exp(-(260.0/TPK%T))+1.70E-12*exp(-(155.0/TPK%T))+1.21E-12*exp(-(125.0/TPK%T))::ALKA+OH-->0.87811*ALKAP+0.12793*HO2+0.08173*ALD+0.03498*KET+0.00835*CARBO+0.00140*HCHO+0.00878*ORA1+0.00878*CO+0.00878*OH+H2O -! K059=1.78E-12*exp(-(-438.0/TPK%T))+6.07E-13*exp(-(-500.0/TPK%T))+0.00E-01*exp(-(-448.0/TPK%T))::ALKE+OH-->1.02529*ALKEP+0.00000*BIOP -! K060=2.54E-11*exp(-(-410.0/TPK%T))+0.00E-01*exp(-(-444.0/TPK%T))+0.00E-01::BIO+OH-->1.00000*BIOP -! K061=3.31E-12*exp(-(-355.0/TPK%T))+3.45E-13::ARO+OH-->0.93968*ADD+0.10318*XO2+0.10318*HO2+0.00276*PHO -! K062=1.00E-11::HCHO+OH-->HO2+CO+H2O -! K063=5.55E-12*exp(-(-331.0/TPK%T))::ALD+OH-->1.00000*CARBOP+H2O -! K064=TPK%T*TPK%T*5.68E-18*exp(-(-92.0/TPK%T))::KET+OH-->1.00000*CARBOP+H2O -! K065=1.32E-11+1.88E-12*exp(-(-175.0/TPK%T))::CARBO+OH-->0.51419*CARBOP+0.16919*CARBO+1.01732*CO+0.51208*HO2+0.00000*HCHO+0.06253*ALD+0.00853*KET+0.10162*XO2+0.75196*H2O -! K066=4.50E-13::ORA1+OH-->HO2+CO2+H2O -! K067=6.00E-13::ORA2+OH--> -! K068=2.93E-12*exp(-(-190.0/TPK%T))::OP1+OH-->0.65*MO2+0.35*HCHO+0.35*OH -! K069=3.36E-12*exp(-(-190.0/TPK%T))::OP2+OH-->0.40341*ALKAP+0.05413*CARBOP+0.07335*ALD+0.37591*KET+0.09333*XO2+0.02915*HO2+0.02915*HCHO+0.44925*OH -! K070=3.80E-14+1.59E-14*exp(-(-500.0/TPK%T))::PAN+OH-->0.57839*HCHO+0.21863*CARBO+0.71893*NO3+0.28107*PAN+0.28107*HO2+0.29733*H2O+XO2 -! K071=5.31E-12*exp(-(260.0/TPK%T))::ONIT+OH-->1.00000*ALKAP+NO2+H2O -! K072=3.40E-13*exp(-(1900.0/TPK%T))::HCHO+NO3-->HO2+HNO3+CO -! K073=1.40E-12*exp(-(1900.0/TPK%T))::ALD+NO3-->1.00000*CARBOP+HNO3 -! K074=1.62E-12*exp(-(1900.0/TPK%T))+0.00E-01*exp(-(150.0/TPK%T))+1.94E-14*exp(-(1000.0/TPK%T))::CARBO+NO3-->0.91567*HNO3+0.38881*CARBOP+0.10530*CARBO+0.05265*ALD+0.00632*KET+0.10530*NO2+0.10530*XO2+0.63217*HO2+1.33723*CO+0.00000*OLN -! K075=4.92E-16::ARO+NO3-->HNO3+PHO -! K076=4.35E-18*TPK%T*TPK%T*exp(-(2282.0/TPK%T))+1.91E-14*exp(-(450.0/TPK%T))+1.08E-15*exp(-(-450.0/TPK%T))+0.00E-01::ALKE+NO3-->0.00000*CARBO+0.93768*OLN -! K077=4.00E-12*exp(-(446.0/TPK%T))+0.00E-01*exp(-(-490.0/TPK%T))+0.00E-01::BIO+NO3-->0.91741*CARBO+1.00000*OLN -! K078=3.76E-16*exp(-(500.0/TPK%T))::PAN+NO3-->0.60*ONIT+0.60*NO3+0.40000*PAN+0.40*HCHO+0.40*NO2+XO2 -! K079=8.17E-15*exp(-(2580.0/TPK%T))+4.32E-16*exp(-(1800.0/TPK%T))+2.87E-17*exp(-(845.0/TPK%T))+0.00E-01*exp(-(2283.0/TPK%T))::ALKE+O3-->0.48290*HCHO+0.51468*ALD+0.07377*KET+0.00000*CARBO+0.35120*CO+0.15343*ORA1+0.08143*ORA2+0.23451*HO2+0.39435*OH+0.05705*CARBOP+0.03196*ETH+0.00000*ALKE+0.04300*CH4+0.13966*MO2+0.09815*ALKAP+0.01833*H2O2+0.00000*XO2+0.05409*H2+0.00000*O3P -! K080=7.86E-15*exp(-(1913.0/TPK%T))+0.00E-01*exp(-(732.0/TPK%T))+0.00E-01::BIO+O3-->0.90000*HCHO+0.00000*ALD+0.00000*KET+0.39754*CARBO+0.36000*CO+0.37388*ALKE+0.00000*ALKAP+0.17000*CARBOP+0.03000*MO2+0.15000*ORA1+0.00000*ORA2+0.28000*OH+0.30000*HO2+0.00100*H2O2+0.05000*H2+0.13000*XO2+0.09000*O3P -! K081=0.00E-01*exp(-(2112.0/TPK%T))+1.38E-19::CARBO+O3-->0.00000*HCHO+1.07583*CARBO+0.15692*ALD+0.10788*ORA1+0.20595*ORA2+0.27460*CARBOP+0.10149*OP2+0.64728*CO+0.28441*HO2+0.20595*OH+0.00000*H2 -! K082=7.20E-17*exp(-(1700.0/TPK%T))::PAN+O3-->0.70*HCHO+0.30000*PAN+0.70*NO2+0.13*CO+0.04*H2+0.11*ORA1+0.08*HO2+0.036*OH+0.70000*CARBOP -! K083=2.00E-11::PHO+NO2-->0.10670*ARO+ONIT -! K084=1.00E-11::PHO+HO2-->1.06698*ARO -! K085=3.60E-11::ADD+NO2-->ARO+HONO -! K086=1.66E-17*exp(-(-1044.0/TPK%T))::ADD+O2-->0.98*AROP+0.02*ARO+0.02*HO2 -! K087=2.80E-11::ADD+O3-->ARO+OH -! K088=@TROE(5.86E-01,9.70E-29,5.6,9.30E-12,1.5,TPK%M,TPK%T,KVECNPT)::CARBOP+NO2-->1.00000*PAN -! K089=@TROE_EQUIL(9.70E-29,5.6,9.30E-12,1.5,1.16E+28,13954.,TPK%M,TPK%T,KVECNPT)::PAN-->1.00000*CARBOP+NO2 -! K090=4.20E-12*exp(-(-180.0/TPK%T))::MO2+NO-->HCHO+HO2+NO2 -! K091=4.36E-12::ALKAP+NO-->0.33144*ALD+0.03002*HCHO+0.54531*KET+0.03407*CARBO+0.74265*HO2+0.09016*MO2+0.08187*ALKAP+0.13007*XO2+0.08459*ONIT+0.91541*NO2 -! K092=6.93E-12::ALKEP+NO-->1.39870*HCHO+0.42125*ALD+0.05220*KET+HO2+NO2 -! K093=4.00E-12::BIOP+NO-->0.45463*CARBO+0.60600*HCHO+0.00000*ALD+0.00000*KET+0.37815*ALKE+0.84700*HO2+0.84700*NO2+0.15300*ONIT -! K094=4.00E-12::AROP+NO-->0.95115*NO2+0.95115*HO2+2.06993*CARBO+0.04885*ONIT -! K095=1.22E-11::CARBOP+NO-->0.78134*MO2+0.09532*CARBOP+0.05848*HCHO+0.07368*ALD+0.08670*CARBO+0.12334*HO2+0.02563*XO2+NO2 -! K096=4.00E-12::OLN+NO-->0.18401*ONIT+1.81599*NO2+0.18401*HO2+0.23419*HCHO+1.01182*ALD+0.37862*KET -! K097=3.80E-13*exp(-(-800.0/TPK%T))::MO2+HO2-->OP1 -! K098=6.16E-14*exp(-(-700.0/TPK%T))+1.52E-13*exp(-(-1300.0/TPK%T))::ALKAP+HO2-->1.00524*OP2 -! K099=1.81E-13*exp(-(-1300.0/TPK%T))::ALKEP+HO2-->1.00524*OP2 -! K0100=1.28E-13*exp(-(-1300.0/TPK%T))+0.00E-01::BIOP+HO2-->1.00524*OP2 -! K0101=3.75E-13*exp(-(-980.0/TPK%T))::AROP+HO2-->1.00524*OP2 -! K0102=5.94E-13*exp(-(-550.0/TPK%T))+1.99E-16*exp(-(-2640.0/TPK%T))+5.56E-14*exp(-(-1300.0/TPK%T))::CARBOP+HO2-->0.80904*OP2+0.17307*ORA2+0.17307*O3 -! K103=1.66E-13*exp(-(-1300.0/TPK%T))::OLN+HO2-->ONIT -! K104=9.10E-14*exp(-(-416.0/TPK%T))::MO2+MO2-->1.33*HCHO+0.66*HO2 -! K105=1.03E-14*exp(-(-158.0/TPK%T))+6.24E-14*exp(-(-431.0/TPK%T))+1.53E-14*exp(-(-467.0/TPK%T))+4.34E-15*exp(-(-633.0/TPK%T))::ALKAP+MO2-->0.80556*HCHO+0.98383*HO2+0.56070*ALD+0.09673*KET+0.01390*MO2+0.07976*CARBO+0.13370*XO2+0.00385*ALKAP -! K106=1.57E-13*exp(-(-708.0/TPK%T))::ALKEP+MO2-->1.42894*HCHO+0.46413*ALD+0.03814*KET+HO2 -! K107=1.36E-13*exp(-(-708.0/TPK%T))::BIOP+MO2-->0.56064*CARBO+0.48074*ALKE+1.00000*HO2+1.09000*HCHO+0.00000*ALD+0.00000*KET -! K108=3.56E-14*exp(-(-708.0/TPK%T))::AROP+MO2-->HCHO+1.02767*HO2+1.99461*CARBO -! K109=1.77E-11*exp(-(440.0/TPK%T))+1.48E-16*exp(-(-2510.0/TPK%T))+3.10E-13*exp(-(-508.0/TPK%T))::CARBOP+MO2-->0.95723*HCHO+0.82998*HO2+0.56031*MO2+0.13684*ORA2+0.05954*CARBOP+0.15387*CARBO+0.08295*ALD+0.02212*XO2 -! K110=1.12E-13*exp(-(-708.0/TPK%T))::OLN+MO2-->0.88625*HCHO+0.67560*HO2+0.67560*ONIT+0.41524*ALD+0.09667*KET+0.32440*NO2 -! K111=4.44E-14*exp(-(-211.0/TPK%T))+2.23E-13*exp(-(-460.0/TPK%T))+4.10E-14*exp(-(-522.0/TPK%T))+1.17E-14*exp(-(-683.0/TPK%T))::ALKAP+CARBOP-->0.71461*ALD+0.48079*HO2+0.51480*MO2+0.49810*ORA2+0.18819*KET+0.07600*HCHO+0.00828*ALKAP+0.11306*XO2+0.06954*CARBO -! K112=4.36E-13*exp(-(-765.0/TPK%T))::ALKEP+CARBOP-->0.68192*HCHO+0.68374*ALD+0.50078*HO2+0.50078*MO2+0.49922*ORA2+0.06579*KET -! K113=7.60E-13*exp(-(-765.0/TPK%T))::BIOP+CARBOP-->0.78591*CARBO+0.24463*ALKE+0.50600*HO2+0.49400*ORA2+0.34000*HCHO+0.50600*MO2+0.00000*ALD+0.00000*KET -! K114=3.63E-13*exp(-(-765.0/TPK%T))::AROP+CARBOP-->MO2+HO2+1.99455*CARBO -! K115=7.73E-13*exp(-(-530.0/TPK%T))+1.70E-13*exp(-(-565.0/TPK%T))::CARBOP+CARBOP-->1.66702*MO2+0.05821*CARBOP+0.03432*HCHO+0.10777*CARBO+0.06969*ALD+0.02190*KET+0.07566*HO2+0.01593*XO2+0.09955*ORA2 -! K116=4.85E-13*exp(-(-765.0/TPK%T))::OLN+CARBOP-->0.66562*ONIT+0.51037*MO2+0.48963*ORA2+0.17599*HO2+0.13414*HCHO+0.42122*ALD+0.10822*KET+0.00000*NO2 -! K117=4.19E-15*exp(-(-1000.0/TPK%T))::OLN+OLN-->2.00*ONIT+HO2 -! K118=2.48E-14*exp(-(-1000.0/TPK%T))::OLN+OLN-->0.00000*HCHO+0.00000*ALD+0.00000*KET+0.00000*HO2+0.00000*NO2+0.00000*ONIT -! K119=1.20E-12::MO2+NO3-->HCHO+HO2+NO2 -! K120=1.20E-12::ALKAP+NO3-->0.33743*ALD+0.81290*HO2+0.03142*HCHO+0.62978*KET+0.03531*CARBO+0.09731*MO2+0.08994*ALKAP+0.16271*XO2+NO2 -! K121=1.20E-12::ALKEP+NO3-->1.40909*HCHO+0.43039*ALD+0.02051*KET+HO2+NO2 -! K122=1.20E-12::BIOP+NO3-->0.61160*CARBO+0.42729*ALKE+0.68600*HCHO+0.00000*ALD+0.00000*KET+HO2+NO2 -! K123=1.20E-12::AROP+NO3-->2.81904*CARBO+HO2+NO2 -! K124=3.48E-12::CARBOP+NO3-->0.91910*MO2+0.03175*CARBOP+0.03175*HCHO+0.03455*CARBO+0.02936*ALD+0.04915*HO2+0.01021*XO2+NO2 -! K125=1.20E-12::OLN+NO3-->0.25928*ONIT+1.74072*NO2+0.25928*HO2+0.20740*HCHO+0.91850*ALD+0.34740*KET -! K126=1.66E-13*exp(-(-1300.0/TPK%T))::XO2+HO2-->1.00524*OP2 -! K127=5.99E-15*exp(-(-1510.0/TPK%T))::XO2+MO2-->HCHO+HO2 -! K128=1.69E-14*exp(-(-1560.0/TPK%T))::XO2+CARBOP-->MO2 -! K129=7.13E-17*exp(-(-2950.0/TPK%T))::XO2+XO2--> -! K130=4.00E-12::XO2+NO-->NO2 -! K131=1.20E-12::XO2+NO3-->NO2 -! K132=1.00E-40::SULF--> -! K133=5.40E-13::DMS+NO3-->SO2+NO2 -! K134=1.30E-11*exp(-(400./TPK%T))::DMS+O3P-->SO2 -! K135=(TPK%T*exp(-234./TPK%T)+8.4E-10*exp(7230./TPK%T)+2.68E-10*exp(7810./TPK%T))/(1.04E11*TPK%T+88.1*exp(7460./TPK%T))::DMS+OH-->0.8*SO2 -! KTC1=@KT(0.05,48.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::O3-->WC_O3 -! KTC2=@KT(0.11,34.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::H2O2-->WC_H2O2 -! KTC3=@KT(0.0001,30.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::NO-->WC_NO -! KTC4=@KT(0.0015,46.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::NO2-->WC_NO2 -! KTC5=@KT(0.05,62.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::NO3-->WC_NO3 -! KTC6=@KT(0.0037,108.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::N2O5-->WC_N2O5 -! KTC7=@KT(0.05,47.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::HONO-->WC_HONO -! KTC8=@KT(0.054,63.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::HNO3-->WC_HNO3 -! KTC9=@KT(0.05,79.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::HNO4-->WC_HNO4 -! KTC10=@KT(0.04,17.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::NH3-->WC_NH3 -! KTC11=@KT(0.05,17.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::OH-->WC_OH -! KTC12=@KT(0.2,30.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::HO2-->WC_HO2 -! KTC13=@KT(0.0002,44.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::CO2-->WC_CO2 -! KTC14=@KT(0.11,64.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::SO2-->WC_SO2 -! KTC15=@KT(0.07,98.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::SULF-->WC_SULF -! KTC16=@KT(0.04,30.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::HCHO-->WC_HCHO -! KTC17=@KT(0.012,46.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::ORA1-->WC_ORA1 -! KTC18=@KT(0.03,60.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::ORA2-->WC_ORA2 -! KTC19=@KT(0.05,47.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::MO2-->WC_MO2 -! KTC20=@KT(0.007,48.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::OP1-->WC_OP1 -! KTC21=@KT(0.05,48.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(1.03e-2,-2830.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_O3-->O3 -! KTC22=@KT(0.11,34.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(8.44e4,-7600.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_H2O2-->H2O2 -! KTC23=@KT(0.0001,30.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(1.92e-3,-1790.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_NO-->NO -! KTC24=@KT(0.0015,46.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(1.2e-2,-2400.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_NO2-->NO2 -! KTC25=@KT(0.05,62.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(3.8e-2,0.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_NO3-->NO3 -! KTC26=@KT(0.0037,108.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(8.8e-2,-3600.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_N2O5-->N2O5 -! KTC27=@KT(0.05,47.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(5.0e1,-4880.,1.6e-3,1760.,0.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_HONO-->HONO -! KTC28=@KT(0.054,63.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(2.1e5,-10500.,2.2e1,0.,0.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_HNO3-->HNO3 -! KTC29=@KT(0.05,79.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(1.2e4,-6900.,1.26e-6,0.,0.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_HNO4-->HNO4 -! KTC30=@KT(0.04,17.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFB(6.02e1,-4160.,1.7e-5,4350.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_NH3-->NH3 -! KTC31=@KT(0.05,17.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(3.9e1,0.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_OH-->OH -! KTC32=@KT(0.2,30.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(6.9e2,0.,1.6e-5,0.,0.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_HO2-->HO2 -! KTC33=@KT(0.0002,44.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(3.4e-2,-2710.,4.3e-7,920.,4.7e-11,1780.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_CO2-->CO2 -! KTC34=@KT(0.11,64.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(1.36,-2930.,1.3e-2,-1965.,6.4e-8,-1430.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_SO2-->SO2 -! KTC35=@KT(0.07,98.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(2.1e5,-8700.,1.0e3,0.,1.0e-2,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_SULF-->SULF -! KTC36=@KT(0.04,30.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(3.23e3,-7100.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_HCHO-->HCHO -! KTC37=@KT(0.012,46.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(8.9e3,-6100.,1.8e-4,150.,0.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_ORA1-->ORA1 -! KTC38=@KT(0.03,60.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(4.1e3,-6200.,1.74e-5,0.,0.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_ORA2-->ORA2 -! KTC39=@KT(0.05,47.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(2.45e0,-5280.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_MO2-->MO2 -! KTC40=@KT(0.007,48.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(3.e2,-5280.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_OP1-->OP1 -! KTR1=@KT(0.05,48.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::O3-->WR_O3 -! KTR2=@KT(0.11,34.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::H2O2-->WR_H2O2 -! KTR3=@KT(0.0001,30.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::NO-->WR_NO -! KTR4=@KT(0.0015,46.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::NO2-->WR_NO2 -! KTR5=@KT(0.05,62.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::NO3-->WR_NO3 -! KTR6=@KT(0.0037,108.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::N2O5-->WR_N2O5 -! KTR7=@KT(0.05,47.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::HONO-->WR_HONO -! KTR8=@KT(0.054,63.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::HNO3-->WR_HNO3 -! KTR9=@KT(0.05,79.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::HNO4-->WR_HNO4 -! KTR10=@KT(0.04,17.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::NH3-->WR_NH3 -! KTR11=@KT(0.05,17.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::OH-->WR_OH -! KTR12=@KT(0.2,30.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::HO2-->WR_HO2 -! KTR13=@KT(0.0002,44.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::CO2-->WR_CO2 -! KTR14=@KT(0.11,64.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::SO2-->WR_SO2 -! KTR15=@KT(0.07,98.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::SULF-->WR_SULF -! KTR16=@KT(0.04,30.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::HCHO-->WR_HCHO -! KTR17=@KT(0.012,46.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::ORA1-->WR_ORA1 -! KTR18=@KT(0.03,60.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::ORA2-->WR_ORA2 -! KTR19=@KT(0.05,47.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::MO2-->WR_MO2 -! KTR20=@KT(0.007,48.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::OP1-->WR_OP1 -! KTR21=@KT(0.05,48.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(1.03e-2,-2830.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_O3-->O3 -! KTR22=@KT(0.11,34.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(8.44e4,-7600.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_H2O2-->H2O2 -! KTR23=@KT(0.0001,30.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(1.92e-3,-1790.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_NO-->NO -! KTR24=@KT(0.0015,46.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(1.2e-2,-2400.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_NO2-->NO2 -! KTR25=@KT(0.05,62.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(3.8e-2,0.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_NO3-->NO3 -! KTR26=@KT(0.0037,108.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(8.8e-2,-3600.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_N2O5-->N2O5 -! KTR27=@KT(0.05,47.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(5.0e1,-4880.,1.6e-3,1760.,0.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_HONO-->HONO -! KTR28=@KT(0.054,63.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(2.1e5,-10500.,2.2e1,0.,0.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_HNO3-->HNO3 -! KTR29=@KT(0.05,79.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(1.2e4,-6900.,1.26e-6,0.,0.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_HNO4-->HNO4 -! KTR30=@KT(0.04,17.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFB(6.02e1,-4160.,1.7e-5,4350.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_NH3-->NH3 -! KTR31=@KT(0.05,17.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(3.9e1,0.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_OH-->OH -! KTR32=@KT(0.2,30.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(6.9e2,0.,1.6e-5,0.,0.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_HO2-->HO2 -! KTR33=@KT(0.0002,44.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(3.4e-2,-2710.,4.3e-7,920.,4.7e-11,1780.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_CO2-->CO2 -! KTR34=@KT(0.11,64.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(1.36,-2930.,1.3e-2,-1965.,6.4e-8,-1430.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_SO2-->SO2 -! KTR35=@KT(0.07,98.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(2.1e5,-8700.,1.0e3,0.,1.0e-2,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_SULF-->SULF -! KTR36=@KT(0.04,30.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(3.23e3,-7100.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_HCHO-->HCHO -! KTR37=@KT(0.012,46.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(8.9e3,-6100.,1.8e-4,150.,0.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_ORA1-->ORA1 -! KTR38=@KT(0.03,60.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(4.1e3,-6200.,1.74e-5,0.,0.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_ORA2-->ORA2 -! KTR39=@KT(0.05,47.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(2.45e0,-5280.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_MO2-->MO2 -! KTR40=@KT(0.007,48.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(3.e2,-5280.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_OP1-->OP1 -! KC1=!ZRATES(:,018)::WC_H2O2-->WC_OH+WC_OH -! KC2=(3.6E+9*exp(-930.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLECCLOUD::WC_OH+WC_OH-->WC_H2O2 -! KC3=((2.8E+10*10.**(-TPK%PHC)+3.5E+10*exp(-720.*(1./TPK%T-1./298.15))*1.6e-5)/(1.6e-5+10.**(-TPK%PHC)))/TPK%MOL2MOLECCLOUD::WC_OH+WC_HO2--> -! KC4=(3.2E+7*exp(-1700.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLECCLOUD::WC_H2O2+WC_OH-->WC_HO2 -! KC5=((8.3E+5*exp(-2700.*(1./TPK%T-1./298.15))*(10.**(-TPK%PHC))**2.+9.6E+7*exp(-910.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)*1.6e-5)/(1.6e-5+10.**(-TPK%PHC))**2.)/TPK%MOL2MOLECCLOUD::WC_HO2+WC_HO2-->WC_H2O2 -! KC6=(1.5E+9*exp(-1500.*(1./TPK%T-1./298.15))*1.6e-5/(1.6e-5+10.**(-TPK%PHC)))/TPK%MOL2MOLECCLOUD::WC_O3+WC_HO2-->WC_OH -! KC7=(2.7E+9*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)/(1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)+(10.**(-TPK%PHC))**2.))/TPK%MOL2MOLECCLOUD::WC_OH+WC_SO2-->WC_ASO3 -! KC8=(1.0E+10*10.**(-TPK%PHC)/(1.6e-3*exp(-1760.*(1./TPK%T-1./298.15))+10.**(-TPK%PHC)))/TPK%MOL2MOLECCLOUD::WC_HONO+WC_OH-->WC_NO2 -! KC9=((1.8E+9*10.**(-TPK%PHC)+4.5E+9*1.6e-5)/(1.6e-5+10.**(-TPK%PHC)))/TPK%MOL2MOLECCLOUD::WC_NO2+WC_HO2-->WC_HNO4 -! KC10=2.6E-2*10.**(-TPK%PHC)/(1.26e-6+10.**(-TPK%PHC))::WC_HNO4-->WC_HO2+WC_NO2 -! KC11=1.1E0*1.26e-6/(1.26e-6+10.**(-TPK%PHC))::WC_HNO4-->WC_HONO -! KC12=(3.3E+5*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*(10.**(-TPK%PHC))**2./((1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)+(10.**(-TPK%PHC))**2.)*(1.26e-6+10.**(-TPK%PHC))))/TPK%MOL2MOLECCLOUD::WC_HNO4+WC_SO2-->WC_SULF+WC_HNO3 -! KC13=!ZRATES(:,019)*2.2e+1/(2.2e+1+10.**(-TPK%PHC))::WC_HNO3-->WC_NO2+WC_OH -! KC14=1.0E+10::WC_N2O5-->WC_HNO3+WC_HNO3 -! KC15=(1.0E+5*1.0e+3*1.0e-2/(1.0e+3*1.0e-2+1.0e+3*10.**(-TPK%PHC)+(10.**(-TPK%PHC))**2.))/TPK%MOL2MOLECCLOUD::WC_NO3+WC_SULF-->WC_HNO3+WC_ASO4 -! KC16=(1.3E+9*exp(-2200.*(1./TPK%T-1./298.15))*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)/(1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)+(10.**(-TPK%PHC))**2.))/TPK%MOL2MOLECCLOUD::WC_NO3+WC_SO2-->WC_HNO3+WC_ASO3 -! KC17=(1.7E+8*exp(-2200.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLECCLOUD::WC_MO2+WC_MO2-->2.00*WC_HCHO+2.00*WC_HO2 -! KC18=(5.0E+5*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)/(1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)+(10.**(-TPK%PHC))**2.))/TPK%MOL2MOLECCLOUD::WC_MO2+WC_SO2-->WC_OP1+WC_ASO3 -! KC19=(7.8E+8*exp(-1000.*(1./TPK%T-1./298.15))*2.5e3*exp(4030.*(1./TPK%T-1./298.15))/(1.+2.5e3*exp(4030.*(1./TPK%T-1./298.15))))/TPK%MOL2MOLECCLOUD::WC_HCHO+WC_OH-->WC_ORA1+WC_HO2 -! KC20=((1.0E+8*exp(-1000.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)+3.4E+9*exp(-1200.*(1./TPK%T-1./298.15))*1.8e-4*exp(150.*(1./TPK%T-1./298.15)))/(1.8e-4*exp(150.*(1./TPK%T-1./298.15))+10.**(-TPK%PHC)))/TPK%MOL2MOLECCLOUD::WC_ORA1+WC_OH-->WC_CO2+WC_HO2 -! KC21=((7.9E+2*exp(-2900.*(1./TPK%T-1./298.15))*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)+2.5E+7*exp(-2450.*(1./TPK%T-1./298.15))*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15)))/((1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)+(10.**(-TPK%PHC))**2.)*(1.+2.5e3*exp(4030.*(1./TPK%T-1./298.15)))))/TPK%MOL2MOLECCLOUD::WC_SO2+WC_HCHO-->WC_AHMS -! KC22=7.7E-3*exp(-9200.*(1./TPK%T-1./298.15))+3.7E+3*1.e-14*EXP(-6716*(1./TPK%T-1./298.15))/10.**(-TPK%PHC)::WC_AHMS-->WC_SO2+WC_HCHO -! KC23=3.0E+8/TPK%MOL2MOLECCLOUD::WC_AHMS+WC_OH-->WC_HO2+WC_ORA1+WC_SO2 -! KC24=1.1E+9::WC_ASO3+W_O2-->WC_ASO5 -! KC25=(1.7E+9*10.**(-TPK%PHC)/(1.6e-5+10.**(-TPK%PHC)))/TPK%MOL2MOLECCLOUD::WC_ASO5+WC_HO2-->WC_AHSO5 -! KC26=(2.2E+8*exp(-2600.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLECCLOUD::WC_ASO5+WC_ASO5-->WC_ASO4+WC_ASO4 -! KC27=(7.1E+6*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)*10.**(-TPK%PHC)/(1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)+(10.**(-TPK%PHC))**2.))/TPK%MOL2MOLECCLOUD::WC_AHSO5+WC_SO2-->2.00*WC_SULF -! KC28=4.6E+2*exp(-1100.*(1./TPK%T-1./298.15))::WC_ASO4-->WC_SULF+WC_OH -! KC29=((3.7E+5*exp(-5500.*(1./TPK%T-1./298.15))*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)+1.5E+9*exp(-5300.*(1./TPK%T-1./298.15))*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15)))/(1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)+(10.**(-TPK%PHC))**2.))/TPK%MOL2MOLECCLOUD::WC_SO2+WC_O3-->WC_SULF -! KC30=(9.1E+7*exp(-3600.*(1./TPK%T-1./298.15))*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)*10.**(-TPK%PHC)/(1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)+(10.**(-TPK%PHC))**2.))/TPK%MOL2MOLECCLOUD::WC_SO2+WC_H2O2-->WC_SULF -! KR1=!ZRATES(:,018)::WR_H2O2-->WR_OH+WR_OH -! KR2=(3.6E+9*exp(-930.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLECRAIN::WR_OH+WR_OH-->WR_H2O2 -! KR3=((2.8E+10*10.**(-TPK%PHR)+3.5E+10*exp(-720.*(1./TPK%T-1./298.15))*1.6e-5)/(1.6e-5+10.**(-TPK%PHR)))/TPK%MOL2MOLECRAIN::WR_OH+WR_HO2--> -! KR4=(3.2E+7*exp(-1700.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLECRAIN::WR_H2O2+WR_OH-->WR_HO2 -! KR5=((8.3E+5*exp(-2700.*(1./TPK%T-1./298.15))*(10.**(-TPK%PHR))**2.+9.6E+7*exp(-910.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)*1.6e-5)/(1.6e-5+10.**(-TPK%PHR))**2.)/TPK%MOL2MOLECRAIN::WR_HO2+WR_HO2-->WR_H2O2 -! KR6=(1.5E+9*exp(-1500.*(1./TPK%T-1./298.15))*1.6e-5/(1.6e-5+10.**(-TPK%PHR)))/TPK%MOL2MOLECRAIN::WR_O3+WR_HO2-->WR_OH -! KR7=(2.7E+9*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)/(1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)+(10.**(-TPK%PHR))**2.))/TPK%MOL2MOLECRAIN::WR_OH+WR_SO2-->WR_ASO3 -! KR8=(1.0E+10*10.**(-TPK%PHR)/(1.6e-3*exp(-1760.*(1./TPK%T-1./298.15))+10.**(-TPK%PHR)))/TPK%MOL2MOLECRAIN::WR_HONO+WR_OH-->WR_NO2 -! KR9=((1.8E+9*10.**(-TPK%PHR)+4.5E+9*1.6e-5)/(1.6e-5+10.**(-TPK%PHR)))/TPK%MOL2MOLECRAIN::WR_NO2+WR_HO2-->WR_HNO4 -! KR10=2.6E-2*10.**(-TPK%PHR)/(1.26e-6+10.**(-TPK%PHR))::WR_HNO4-->WR_HO2+WR_NO2 -! KR11=1.1E0*1.26e-6/(1.26e-6+10.**(-TPK%PHR))::WR_HNO4-->WR_HONO -! KR12=(3.3E+5*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*(10.**(-TPK%PHR))**2./((1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)+(10.**(-TPK%PHR))**2.)*(1.26e-6+10.**(-TPK%PHR))))/TPK%MOL2MOLECRAIN::WR_HNO4+WR_SO2-->WR_SULF+WR_HNO3 -! KR13=!ZRATES(:,019)*2.2e+1/(2.2e+1+10.**(-TPK%PHR))::WR_HNO3-->WR_NO2+WR_OH -! KR14=1.0E+10::WR_N2O5-->WR_HNO3+WR_HNO3 -! KR15=(1.0E+5*1.0e+3*1.0e-2/(1.0e+3*1.0e-2+1.0e+3*10.**(-TPK%PHR)+(10.**(-TPK%PHR))**2.))/TPK%MOL2MOLECRAIN::WR_NO3+WR_SULF-->WR_HNO3+WR_ASO4 -! KR16=(1.3E+9*exp(-2200.*(1./TPK%T-1./298.15))*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)/(1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)+(10.**(-TPK%PHR))**2.))/TPK%MOL2MOLECRAIN::WR_NO3+WR_SO2-->WR_HNO3+WR_ASO3 -! KR17=(1.7E+8*exp(-2200.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLECRAIN::WR_MO2+WR_MO2-->2.00*WR_HCHO+2.00*WR_HO2 -! KR18=(5.0E+5*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)/(1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)+(10.**(-TPK%PHR))**2.))/TPK%MOL2MOLECRAIN::WR_MO2+WR_SO2-->WR_OP1+WR_ASO3 -! KR19=(7.8E+8*exp(-1000.*(1./TPK%T-1./298.15))*2.5e3*exp(4030.*(1./TPK%T-1./298.15))/(1.+2.5e3*exp(4030.*(1./TPK%T-1./298.15))))/TPK%MOL2MOLECRAIN::WR_HCHO+WR_OH-->WR_ORA1+WR_HO2 -! KR20=((1.0E+8*exp(-1000.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)+3.4E+9*exp(-1200.*(1./TPK%T-1./298.15))*1.8e-4*exp(150.*(1./TPK%T-1./298.15)))/(1.8e-4*exp(150.*(1./TPK%T-1./298.15))+10.**(-TPK%PHR)))/TPK%MOL2MOLECRAIN::WR_ORA1+WR_OH-->WR_CO2+WR_HO2 -! KR21=((7.9E+2*exp(-2900.*(1./TPK%T-1./298.15))*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)+2.5E+7*exp(-2450.*(1./TPK%T-1./298.15))*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15)))/((1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)+(10.**(-TPK%PHR))**2.)*(1.+2.5e3*exp(4030.*(1./TPK%T-1./298.15)))))/TPK%MOL2MOLECRAIN::WR_SO2+WR_HCHO-->WR_AHMS -! KR22=7.7E-3*exp(-9200.*(1./TPK%T-1./298.15))+3.7E+3*1.e-14*EXP(-6716*(1./TPK%T-1./298.15))/10.**(-TPK%PHR)::WR_AHMS-->WR_SO2+WR_HCHO -! KR23=3.0E+8/TPK%MOL2MOLECRAIN::WR_AHMS+WR_OH-->WR_HO2+WR_ORA1+WR_SO2 -! KR24=1.1E+9::WR_ASO3+W_O2-->WR_ASO5 -! KR25=(1.7E+9*10.**(-TPK%PHR)/(1.6e-5+10.**(-TPK%PHR)))/TPK%MOL2MOLECRAIN::WR_ASO5+WR_HO2-->WR_AHSO5 -! KR26=(2.2E+8*exp(-2600.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLECRAIN::WR_ASO5+WR_ASO5-->WR_ASO4+WR_ASO4 -! KR27=(7.1E+6*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)*10.**(-TPK%PHR)/(1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)+(10.**(-TPK%PHR))**2.))/TPK%MOL2MOLECRAIN::WR_AHSO5+WR_SO2-->2.00*WR_SULF -! KR28=4.6E+2*exp(-1100.*(1./TPK%T-1./298.15))::WR_ASO4-->WR_SULF+WR_OH -! KR29=((3.7E+5*exp(-5500.*(1./TPK%T-1./298.15))*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)+1.5E+9*exp(-5300.*(1./TPK%T-1./298.15))*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15)))/(1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)+(10.**(-TPK%PHR))**2.))/TPK%MOL2MOLECRAIN::WR_SO2+WR_O3-->WR_SULF -! KR30=(9.1E+7*exp(-3600.*(1./TPK%T-1./298.15))*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)*10.**(-TPK%PHR)/(1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)+(10.**(-TPK%PHR))**2.))/TPK%MOL2MOLECRAIN::WR_SO2+WR_H2O2-->WR_SULF -! -!======================================================================== -! -! the prognostic chemical species are the following ... -! -! 1. O3 PCONC(:,1) -! 2. H2O2 PCONC(:,2) -! 3. NO PCONC(:,3) -! 4. NO2 PCONC(:,4) -! 5. NO3 PCONC(:,5) -! 6. N2O5 PCONC(:,6) -! 7. HONO PCONC(:,7) -! 8. HNO3 PCONC(:,8) -! 9. HNO4 PCONC(:,9) -! 10. NH3 PCONC(:,10) -! 11. DMS PCONC(:,11) -! 12. SO2 PCONC(:,12) -! 13. SULF PCONC(:,13) -! 14. CO PCONC(:,14) -! 15. OH PCONC(:,15) -! 16. HO2 PCONC(:,16) -! 17. CH4 PCONC(:,17) -! 18. ETH PCONC(:,18) -! 19. ALKA PCONC(:,19) -! 20. ALKE PCONC(:,20) -! 21. BIO PCONC(:,21) -! 22. ARO PCONC(:,22) -! 23. HCHO PCONC(:,23) -! 24. ALD PCONC(:,24) -! 25. KET PCONC(:,25) -! 26. CARBO PCONC(:,26) -! 27. ONIT PCONC(:,27) -! 28. PAN PCONC(:,28) -! 29. OP1 PCONC(:,29) -! 30. OP2 PCONC(:,30) -! 31. ORA1 PCONC(:,31) -! 32. ORA2 PCONC(:,32) -! 33. MO2 PCONC(:,33) -! 34. ALKAP PCONC(:,34) -! 35. ALKEP PCONC(:,35) -! 36. BIOP PCONC(:,36) -! 37. PHO PCONC(:,37) -! 38. ADD PCONC(:,38) -! 39. AROP PCONC(:,39) -! 40. CARBOP PCONC(:,40) -! 41. OLN PCONC(:,41) -! 42. XO2 PCONC(:,42) -! 43. WC_O3 PCONC(:,43) -! 44. WC_H2O2 PCONC(:,44) -! 45. WC_NO PCONC(:,45) -! 46. WC_NO2 PCONC(:,46) -! 47. WC_NO3 PCONC(:,47) -! 48. WC_N2O5 PCONC(:,48) -! 49. WC_HONO PCONC(:,49) -! 50. WC_HNO3 PCONC(:,50) -! 51. WC_HNO4 PCONC(:,51) -! 52. WC_NH3 PCONC(:,52) -! 53. WC_OH PCONC(:,53) -! 54. WC_HO2 PCONC(:,54) -! 55. WC_CO2 PCONC(:,55) -! 56. WC_SO2 PCONC(:,56) -! 57. WC_SULF PCONC(:,57) -! 58. WC_HCHO PCONC(:,58) -! 59. WC_ORA1 PCONC(:,59) -! 60. WC_ORA2 PCONC(:,60) -! 61. WC_MO2 PCONC(:,61) -! 62. WC_OP1 PCONC(:,62) -! 63. WC_ASO3 PCONC(:,63) -! 64. WC_ASO4 PCONC(:,64) -! 65. WC_ASO5 PCONC(:,65) -! 66. WC_AHSO5 PCONC(:,66) -! 67. WC_AHMS PCONC(:,67) -! 68. WR_O3 PCONC(:,68) -! 69. WR_H2O2 PCONC(:,69) -! 70. WR_NO PCONC(:,70) -! 71. WR_NO2 PCONC(:,71) -! 72. WR_NO3 PCONC(:,72) -! 73. WR_N2O5 PCONC(:,73) -! 74. WR_HONO PCONC(:,74) -! 75. WR_HNO3 PCONC(:,75) -! 76. WR_HNO4 PCONC(:,76) -! 77. WR_NH3 PCONC(:,77) -! 78. WR_OH PCONC(:,78) -! 79. WR_HO2 PCONC(:,79) -! 80. WR_CO2 PCONC(:,80) -! 81. WR_SO2 PCONC(:,81) -! 82. WR_SULF PCONC(:,82) -! 83. WR_HCHO PCONC(:,83) -! 84. WR_ORA1 PCONC(:,84) -! 85. WR_ORA2 PCONC(:,85) -! 86. WR_MO2 PCONC(:,86) -! 87. WR_OP1 PCONC(:,87) -! 88. WR_ASO3 PCONC(:,88) -! 89. WR_ASO4 PCONC(:,89) -! 90. WR_ASO5 PCONC(:,90) -! 91. WR_AHSO5 PCONC(:,91) -! 92. WR_AHMS PCONC(:,92) -! -!======================================================================== -! -! the individual chemical terms are the following ... -! -! terms for O3: -! + K018*<O3P>*<O2> -! + 0.17307*K0102*<CARBOP>*<HO2> -! + KTC21*<WC_O3> -! + KTR21*<WR_O3> -! - K002*<O3> -! - K003*<O3> -! - K019*<O3P>*<O3> -! - K023*<O3>*<OH> -! - K024*<O3>*<HO2> -! - K042*<O3>*<NO> -! - K043*<O3>*<NO2> -! - K079*<ALKE>*<O3> -! - K080*<BIO>*<O3> -! - K081*<CARBO>*<O3> -! - K082*<PAN>*<O3> -! - K087*<ADD>*<O3> -! - KTC1*<O3> -! - KTR1*<O3> -! terms for H2O2: -! + K027*<HO2>*<HO2> -! + K028*<HO2>*<HO2>*<H2O> -! + 0.01833*K079*<ALKE>*<O3> -! + 0.00100*K080*<BIO>*<O3> -! + KTC22*<WC_H2O2> -! + KTR22*<WR_H2O2> -! - K009*<H2O2> -! - K026*<H2O2>*<OH> -! - KTC2*<H2O2> -! - KTR2*<H2O2> -! terms for NO: -! + K001*<NO2> -! + K004*<HONO> -! + K007*<NO3> -! + K030*<O3P>*<NO2> -! + K046*<NO3>*<NO2> -! + KTC23*<WC_NO> -! + KTR23*<WR_NO> -! - K029*<O3P>*<NO> -! - K032*<OH>*<NO> -! - K035*<HO2>*<NO> -! - K042*<O3>*<NO> -! - K044*<NO>*<NO>*<O2> -! - K044*<NO>*<NO>*<O2> -! - K045*<NO3>*<NO> -! - K090*<MO2>*<NO> -! - K091*<ALKAP>*<NO> -! - K092*<ALKEP>*<NO> -! - K093*<BIOP>*<NO> -! - K094*<AROP>*<NO> -! - K095*<CARBOP>*<NO> -! - K096*<OLN>*<NO> -! - K130*<XO2>*<NO> -! - KTC3*<NO> -! - KTR3*<NO> -! terms for NO2: -! + K005*<HNO3> -! + 0.65*K006*<HNO4> -! + K008*<NO3> -! + K017*<ONIT> -! + K029*<O3P>*<NO> -! + K034*<OH>*<NO3> -! + K035*<HO2>*<NO> -! + K037*<HNO4> -! + 0.7*K038*<HO2>*<NO3> -! + K039*<OH>*<HONO> -! + K041*<OH>*<HNO4> -! + K042*<O3>*<NO> -! + K044*<NO>*<NO>*<O2> -! + K044*<NO>*<NO>*<O2> -! + K045*<NO3>*<NO> -! + K045*<NO3>*<NO> -! + K046*<NO3>*<NO2> -! + K048*<N2O5> -! + K049*<NO3>*<NO3> -! + K049*<NO3>*<NO3> -! + K071*<ONIT>*<OH> -! + 0.10530*K074*<CARBO>*<NO3> -! + 0.40*K078*<PAN>*<NO3> -! + 0.70*K082*<PAN>*<O3> -! + K089*<PAN> -! + K090*<MO2>*<NO> -! + 0.91541*K091*<ALKAP>*<NO> -! + K092*<ALKEP>*<NO> -! + 0.84700*K093*<BIOP>*<NO> -! + 0.95115*K094*<AROP>*<NO> -! + K095*<CARBOP>*<NO> -! + 1.81599*K096*<OLN>*<NO> -! + 0.32440*K110*<OLN>*<MO2> -! + 0.00000*K116*<OLN>*<CARBOP> -! + 0.00000*K118*<OLN>*<OLN> -! + K119*<MO2>*<NO3> -! + K120*<ALKAP>*<NO3> -! + K121*<ALKEP>*<NO3> -! + K122*<BIOP>*<NO3> -! + K123*<AROP>*<NO3> -! + K124*<CARBOP>*<NO3> -! + 1.74072*K125*<OLN>*<NO3> -! + K130*<XO2>*<NO> -! + K131*<XO2>*<NO3> -! + K133*<DMS>*<NO3> -! + KTC24*<WC_NO2> -! + KTR24*<WR_NO2> -! - K001*<NO2> -! - K030*<O3P>*<NO2> -! - K031*<O3P>*<NO2> -! - K033*<OH>*<NO2> -! - K036*<HO2>*<NO2> -! - K043*<O3>*<NO2> -! - K046*<NO3>*<NO2> -! - K047*<NO3>*<NO2> -! - K083*<PHO>*<NO2> -! - K085*<ADD>*<NO2> -! - K088*<CARBOP>*<NO2> -! - KTC4*<NO2> -! - KTR4*<NO2> -! terms for NO3: -! + 0.35*K006*<HNO4> -! + K031*<O3P>*<NO2> -! + K040*<OH>*<HNO3> -! + K043*<O3>*<NO2> -! + K048*<N2O5> -! + 0.71893*K070*<PAN>*<OH> -! + 0.60*K078*<PAN>*<NO3> -! + KTC25*<WC_NO3> -! + KTR25*<WR_NO3> -! - K007*<NO3> -! - K008*<NO3> -! - K034*<OH>*<NO3> -! - K038*<HO2>*<NO3> -! - K045*<NO3>*<NO> -! - K046*<NO3>*<NO2> -! - K047*<NO3>*<NO2> -! - K049*<NO3>*<NO3> -! - K049*<NO3>*<NO3> -! - K072*<HCHO>*<NO3> -! - K073*<ALD>*<NO3> -! - K074*<CARBO>*<NO3> -! - K075*<ARO>*<NO3> -! - K076*<ALKE>*<NO3> -! - K077*<BIO>*<NO3> -! - K078*<PAN>*<NO3> -! - K119*<MO2>*<NO3> -! - K120*<ALKAP>*<NO3> -! - K121*<ALKEP>*<NO3> -! - K122*<BIOP>*<NO3> -! - K123*<AROP>*<NO3> -! - K124*<CARBOP>*<NO3> -! - K125*<OLN>*<NO3> -! - K131*<XO2>*<NO3> -! - K133*<DMS>*<NO3> -! - KTC5*<NO3> -! - KTR5*<NO3> -! terms for N2O5: -! + K047*<NO3>*<NO2> -! + KTC26*<WC_N2O5> -! + KTR26*<WR_N2O5> -! - K048*<N2O5> -! - KTC6*<N2O5> -! - KTR6*<N2O5> -! terms for HONO: -! + K032*<OH>*<NO> -! + K085*<ADD>*<NO2> -! + KTC27*<WC_HONO> -! + KTR27*<WR_HONO> -! - K004*<HONO> -! - K039*<OH>*<HONO> -! - KTC7*<HONO> -! - KTR7*<HONO> -! terms for HNO3: -! + K033*<OH>*<NO2> -! + 0.3*K038*<HO2>*<NO3> -! + K072*<HCHO>*<NO3> -! + K073*<ALD>*<NO3> -! + 0.91567*K074*<CARBO>*<NO3> -! + K075*<ARO>*<NO3> -! + KTC28*<WC_HNO3> -! + KTR28*<WR_HNO3> -! - K005*<HNO3> -! - K040*<OH>*<HNO3> -! - KTC8*<HNO3> -! - KTR8*<HNO3> -! terms for HNO4: -! + K036*<HO2>*<NO2> -! + KTC29*<WC_HNO4> -! + KTR29*<WR_HNO4> -! - K006*<HNO4> -! - K037*<HNO4> -! - K041*<OH>*<HNO4> -! - KTC9*<HNO4> -! - KTR9*<HNO4> -! terms for NH3: -! + KTC30*<WC_NH3> -! + KTR30*<WR_NH3> -! - K050*<NH3>*<OH> -! - KTC10*<NH3> -! - KTR10*<NH3> -! terms for DMS: -! + 0.0 -! - K133*<DMS>*<NO3> -! - K134*<DMS>*<O3P> -! - K135*<DMS>*<OH> -! terms for SO2: -! + K133*<DMS>*<NO3> -! + K134*<DMS>*<O3P> -! + 0.8*K135*<DMS>*<OH> -! + KTC34*<WC_SO2> -! + KTR34*<WR_SO2> -! - K052*<OH>*<SO2> -! - KTC14*<SO2> -! - KTR14*<SO2> -! terms for SULF: -! + K052*<OH>*<SO2> -! + KTC35*<WC_SULF> -! + KTR35*<WR_SULF> -! - K132*<SULF> -! - KTC15*<SULF> -! - KTR15*<SULF> -! terms for CO: -! + K010*<HCHO> -! + K011*<HCHO> -! + K012*<ALD> -! + 0.91924*K016*<CARBO> -! + 0.01*K054*<BIO>*<O3P> -! + 0.00878*K058*<ALKA>*<OH> -! + K062*<HCHO>*<OH> -! + 1.01732*K065*<CARBO>*<OH> -! + K072*<HCHO>*<NO3> -! + 1.33723*K074*<CARBO>*<NO3> -! + 0.35120*K079*<ALKE>*<O3> -! + 0.36000*K080*<BIO>*<O3> -! + 0.64728*K081*<CARBO>*<O3> -! + 0.13*K082*<PAN>*<O3> -! - K053*<CO>*<OH> -! terms for OH: -! + K004*<HONO> -! + K005*<HNO3> -! + 0.35*K006*<HNO4> -! + K009*<H2O2> -! + K009*<H2O2> -! + K013*<OP1> -! + K014*<OP2> -! + K022*<O1D>*<H2O> -! + K022*<O1D>*<H2O> -! + K024*<O3>*<HO2> -! + K035*<HO2>*<NO> -! + 0.7*K038*<HO2>*<NO3> -! + 0.02*K054*<BIO>*<O3P> -! + 0.00878*K058*<ALKA>*<OH> -! + 0.35*K068*<OP1>*<OH> -! + 0.44925*K069*<OP2>*<OH> -! + 0.39435*K079*<ALKE>*<O3> -! + 0.28000*K080*<BIO>*<O3> -! + 0.20595*K081*<CARBO>*<O3> -! + 0.036*K082*<PAN>*<O3> -! + K087*<ADD>*<O3> -! + KTC31*<WC_OH> -! + KTR31*<WR_OH> -! - K023*<O3>*<OH> -! - K025*<OH>*<HO2> -! - K026*<H2O2>*<OH> -! - K032*<OH>*<NO> -! - K033*<OH>*<NO2> -! - K034*<OH>*<NO3> -! - K039*<OH>*<HONO> -! - K040*<OH>*<HNO3> -! - K041*<OH>*<HNO4> -! - K050*<NH3>*<OH> -! - K051*<OH>*<H2> -! - K052*<OH>*<SO2> -! - K053*<CO>*<OH> -! - K056*<CH4>*<OH> -! - K057*<ETH>*<OH> -! - K058*<ALKA>*<OH> -! - K059*<ALKE>*<OH> -! - K060*<BIO>*<OH> -! - K061*<ARO>*<OH> -! - K062*<HCHO>*<OH> -! - K063*<ALD>*<OH> -! - K064*<KET>*<OH> -! - K065*<CARBO>*<OH> -! - K066*<ORA1>*<OH> -! - K067*<ORA2>*<OH> -! - K068*<OP1>*<OH> -! - K069*<OP2>*<OH> -! - K070*<PAN>*<OH> -! - K071*<ONIT>*<OH> -! - K135*<DMS>*<OH> -! - KTC11*<OH> -! - KTR11*<OH> -! terms for HO2: -! + 0.65*K006*<HNO4> -! + K011*<HCHO> -! + K011*<HCHO> -! + K012*<ALD> -! + K013*<OP1> -! + 0.96205*K014*<OP2> -! + 0.75830*K016*<CARBO> -! + K017*<ONIT> -! + K023*<O3>*<OH> -! + K026*<H2O2>*<OH> -! + K034*<OH>*<NO3> -! + K037*<HNO4> -! + K051*<OH>*<H2> -! + K052*<OH>*<SO2> -! + K053*<CO>*<OH> -! + 0.28*K054*<BIO>*<O3P> -! + 0.12793*K058*<ALKA>*<OH> -! + 0.10318*K061*<ARO>*<OH> -! + K062*<HCHO>*<OH> -! + 0.51208*K065*<CARBO>*<OH> -! + K066*<ORA1>*<OH> -! + 0.02915*K069*<OP2>*<OH> -! + 0.28107*K070*<PAN>*<OH> -! + K072*<HCHO>*<NO3> -! + 0.63217*K074*<CARBO>*<NO3> -! + 0.23451*K079*<ALKE>*<O3> -! + 0.30000*K080*<BIO>*<O3> -! + 0.28441*K081*<CARBO>*<O3> -! + 0.08*K082*<PAN>*<O3> -! + 0.02*K086*<ADD>*<O2> -! + K090*<MO2>*<NO> -! + 0.74265*K091*<ALKAP>*<NO> -! + K092*<ALKEP>*<NO> -! + 0.84700*K093*<BIOP>*<NO> -! + 0.95115*K094*<AROP>*<NO> -! + 0.12334*K095*<CARBOP>*<NO> -! + 0.18401*K096*<OLN>*<NO> -! + 0.66*K104*<MO2>*<MO2> -! + 0.98383*K105*<ALKAP>*<MO2> -! + K106*<ALKEP>*<MO2> -! + 1.00000*K107*<BIOP>*<MO2> -! + 1.02767*K108*<AROP>*<MO2> -! + 0.82998*K109*<CARBOP>*<MO2> -! + 0.67560*K110*<OLN>*<MO2> -! + 0.48079*K111*<ALKAP>*<CARBOP> -! + 0.50078*K112*<ALKEP>*<CARBOP> -! + 0.50600*K113*<BIOP>*<CARBOP> -! + K114*<AROP>*<CARBOP> -! + 0.07566*K115*<CARBOP>*<CARBOP> -! + 0.17599*K116*<OLN>*<CARBOP> -! + K117*<OLN>*<OLN> -! + 0.00000*K118*<OLN>*<OLN> -! + K119*<MO2>*<NO3> -! + 0.81290*K120*<ALKAP>*<NO3> -! + K121*<ALKEP>*<NO3> -! + K122*<BIOP>*<NO3> -! + K123*<AROP>*<NO3> -! + 0.04915*K124*<CARBOP>*<NO3> -! + 0.25928*K125*<OLN>*<NO3> -! + K127*<XO2>*<MO2> -! + KTC32*<WC_HO2> -! + KTR32*<WR_HO2> -! - K024*<O3>*<HO2> -! - K025*<OH>*<HO2> -! - K027*<HO2>*<HO2> -! - K027*<HO2>*<HO2> -! - K028*<HO2>*<HO2>*<H2O> -! - K028*<HO2>*<HO2>*<H2O> -! - K035*<HO2>*<NO> -! - K036*<HO2>*<NO2> -! - K038*<HO2>*<NO3> -! - K084*<PHO>*<HO2> -! - K097*<MO2>*<HO2> -! - K098*<ALKAP>*<HO2> -! - K099*<ALKEP>*<HO2> -! - K0100*<BIOP>*<HO2> -! - K0101*<AROP>*<HO2> -! - K0102*<CARBOP>*<HO2> -! - K103*<OLN>*<HO2> -! - K126*<XO2>*<HO2> -! - KTC12*<HO2> -! - KTR12*<HO2> -! terms for CH4: -! + 0.04300*K079*<ALKE>*<O3> -! - K056*<CH4>*<OH> -! terms for ETH: -! + 0.03196*K079*<ALKE>*<O3> -! - K057*<ETH>*<OH> -! terms for ALKA: -! + 0.0 -! - K058*<ALKA>*<OH> -! terms for ALKE: -! + 0.91868*K054*<BIO>*<O3P> -! + 0.00000*K079*<ALKE>*<O3> -! + 0.37388*K080*<BIO>*<O3> -! + 0.37815*K093*<BIOP>*<NO> -! + 0.48074*K107*<BIOP>*<MO2> -! + 0.24463*K113*<BIOP>*<CARBOP> -! + 0.42729*K122*<BIOP>*<NO3> -! - K059*<ALKE>*<OH> -! - K076*<ALKE>*<NO3> -! - K079*<ALKE>*<O3> -! terms for BIO: -! + 0.0 -! - K054*<BIO>*<O3P> -! - K060*<BIO>*<OH> -! - K077*<BIO>*<NO3> -! - K080*<BIO>*<O3> -! terms for ARO: -! + 0.10670*K083*<PHO>*<NO2> -! + 1.06698*K084*<PHO>*<HO2> -! + K085*<ADD>*<NO2> -! + 0.02*K086*<ADD>*<O2> -! + K087*<ADD>*<O3> -! - K061*<ARO>*<OH> -! - K075*<ARO>*<NO3> -! terms for HCHO: -! + K013*<OP1> -! + 0.06517*K016*<CARBO> -! + 0.05*K054*<BIO>*<O3P> -! + 0.00140*K058*<ALKA>*<OH> -! + 0.00000*K065*<CARBO>*<OH> -! + 0.35*K068*<OP1>*<OH> -! + 0.02915*K069*<OP2>*<OH> -! + 0.57839*K070*<PAN>*<OH> -! + 0.40*K078*<PAN>*<NO3> -! + 0.48290*K079*<ALKE>*<O3> -! + 0.90000*K080*<BIO>*<O3> -! + 0.00000*K081*<CARBO>*<O3> -! + 0.70*K082*<PAN>*<O3> -! + K090*<MO2>*<NO> -! + 0.03002*K091*<ALKAP>*<NO> -! + 1.39870*K092*<ALKEP>*<NO> -! + 0.60600*K093*<BIOP>*<NO> -! + 0.05848*K095*<CARBOP>*<NO> -! + 0.23419*K096*<OLN>*<NO> -! + 1.33*K104*<MO2>*<MO2> -! + 0.80556*K105*<ALKAP>*<MO2> -! + 1.42894*K106*<ALKEP>*<MO2> -! + 1.09000*K107*<BIOP>*<MO2> -! + K108*<AROP>*<MO2> -! + 0.95723*K109*<CARBOP>*<MO2> -! + 0.88625*K110*<OLN>*<MO2> -! + 0.07600*K111*<ALKAP>*<CARBOP> -! + 0.68192*K112*<ALKEP>*<CARBOP> -! + 0.34000*K113*<BIOP>*<CARBOP> -! + 0.03432*K115*<CARBOP>*<CARBOP> -! + 0.13414*K116*<OLN>*<CARBOP> -! + 0.00000*K118*<OLN>*<OLN> -! + K119*<MO2>*<NO3> -! + 0.03142*K120*<ALKAP>*<NO3> -! + 1.40909*K121*<ALKEP>*<NO3> -! + 0.68600*K122*<BIOP>*<NO3> -! + 0.03175*K124*<CARBOP>*<NO3> -! + 0.20740*K125*<OLN>*<NO3> -! + K127*<XO2>*<MO2> -! + KTC36*<WC_HCHO> -! + KTR36*<WR_HCHO> -! - K010*<HCHO> -! - K011*<HCHO> -! - K062*<HCHO>*<OH> -! - K072*<HCHO>*<NO3> -! - KTC16*<HCHO> -! - KTR16*<HCHO> -! terms for ALD: -! + 0.96205*K014*<OP2> -! + 0.20*K017*<ONIT> -! + K055*<CARBO>*<O3P> -! + 0.08173*K058*<ALKA>*<OH> -! + 0.06253*K065*<CARBO>*<OH> -! + 0.07335*K069*<OP2>*<OH> -! + 0.05265*K074*<CARBO>*<NO3> -! + 0.51468*K079*<ALKE>*<O3> -! + 0.00000*K080*<BIO>*<O3> -! + 0.15692*K081*<CARBO>*<O3> -! + 0.33144*K091*<ALKAP>*<NO> -! + 0.42125*K092*<ALKEP>*<NO> -! + 0.00000*K093*<BIOP>*<NO> -! + 0.07368*K095*<CARBOP>*<NO> -! + 1.01182*K096*<OLN>*<NO> -! + 0.56070*K105*<ALKAP>*<MO2> -! + 0.46413*K106*<ALKEP>*<MO2> -! + 0.00000*K107*<BIOP>*<MO2> -! + 0.08295*K109*<CARBOP>*<MO2> -! + 0.41524*K110*<OLN>*<MO2> -! + 0.71461*K111*<ALKAP>*<CARBOP> -! + 0.68374*K112*<ALKEP>*<CARBOP> -! + 0.00000*K113*<BIOP>*<CARBOP> -! + 0.06969*K115*<CARBOP>*<CARBOP> -! + 0.42122*K116*<OLN>*<CARBOP> -! + 0.00000*K118*<OLN>*<OLN> -! + 0.33743*K120*<ALKAP>*<NO3> -! + 0.43039*K121*<ALKEP>*<NO3> -! + 0.00000*K122*<BIOP>*<NO3> -! + 0.02936*K124*<CARBOP>*<NO3> -! + 0.91850*K125*<OLN>*<NO3> -! - K012*<ALD> -! - K063*<ALD>*<OH> -! - K073*<ALD>*<NO3> -! terms for KET: -! + 0.80*K017*<ONIT> -! + 0.03498*K058*<ALKA>*<OH> -! + 0.00853*K065*<CARBO>*<OH> -! + 0.37591*K069*<OP2>*<OH> -! + 0.00632*K074*<CARBO>*<NO3> -! + 0.07377*K079*<ALKE>*<O3> -! + 0.00000*K080*<BIO>*<O3> -! + 0.54531*K091*<ALKAP>*<NO> -! + 0.05220*K092*<ALKEP>*<NO> -! + 0.00000*K093*<BIOP>*<NO> -! + 0.37862*K096*<OLN>*<NO> -! + 0.09673*K105*<ALKAP>*<MO2> -! + 0.03814*K106*<ALKEP>*<MO2> -! + 0.00000*K107*<BIOP>*<MO2> -! + 0.09667*K110*<OLN>*<MO2> -! + 0.18819*K111*<ALKAP>*<CARBOP> -! + 0.06579*K112*<ALKEP>*<CARBOP> -! + 0.00000*K113*<BIOP>*<CARBOP> -! + 0.02190*K115*<CARBOP>*<CARBOP> -! + 0.10822*K116*<OLN>*<CARBOP> -! + 0.00000*K118*<OLN>*<OLN> -! + 0.62978*K120*<ALKAP>*<NO3> -! + 0.02051*K121*<ALKEP>*<NO3> -! + 0.00000*K122*<BIOP>*<NO3> -! + 0.34740*K125*<OLN>*<NO3> -! - K015*<KET> -! - K064*<KET>*<OH> -! terms for CARBO: -! + 0.13255*K054*<BIO>*<O3P> -! + 0.00835*K058*<ALKA>*<OH> -! + 0.16919*K065*<CARBO>*<OH> -! + 0.21863*K070*<PAN>*<OH> -! + 0.10530*K074*<CARBO>*<NO3> -! + 0.00000*K076*<ALKE>*<NO3> -! + 0.91741*K077*<BIO>*<NO3> -! + 0.00000*K079*<ALKE>*<O3> -! + 0.39754*K080*<BIO>*<O3> -! + 1.07583*K081*<CARBO>*<O3> -! + 0.03407*K091*<ALKAP>*<NO> -! + 0.45463*K093*<BIOP>*<NO> -! + 2.06993*K094*<AROP>*<NO> -! + 0.08670*K095*<CARBOP>*<NO> -! + 0.07976*K105*<ALKAP>*<MO2> -! + 0.56064*K107*<BIOP>*<MO2> -! + 1.99461*K108*<AROP>*<MO2> -! + 0.15387*K109*<CARBOP>*<MO2> -! + 0.06954*K111*<ALKAP>*<CARBOP> -! + 0.78591*K113*<BIOP>*<CARBOP> -! + 1.99455*K114*<AROP>*<CARBOP> -! + 0.10777*K115*<CARBOP>*<CARBOP> -! + 0.03531*K120*<ALKAP>*<NO3> -! + 0.61160*K122*<BIOP>*<NO3> -! + 2.81904*K123*<AROP>*<NO3> -! + 0.03455*K124*<CARBOP>*<NO3> -! - K016*<CARBO> -! - K055*<CARBO>*<O3P> -! - K065*<CARBO>*<OH> -! - K074*<CARBO>*<NO3> -! - K081*<CARBO>*<O3> -! terms for ONIT: -! + 0.60*K078*<PAN>*<NO3> -! + K083*<PHO>*<NO2> -! + 0.08459*K091*<ALKAP>*<NO> -! + 0.15300*K093*<BIOP>*<NO> -! + 0.04885*K094*<AROP>*<NO> -! + 0.18401*K096*<OLN>*<NO> -! + K103*<OLN>*<HO2> -! + 0.67560*K110*<OLN>*<MO2> -! + 0.66562*K116*<OLN>*<CARBOP> -! + 2.00*K117*<OLN>*<OLN> -! + 0.00000*K118*<OLN>*<OLN> -! + 0.25928*K125*<OLN>*<NO3> -! - K017*<ONIT> -! - K071*<ONIT>*<OH> -! terms for PAN: -! + 0.28107*K070*<PAN>*<OH> -! + 0.40000*K078*<PAN>*<NO3> -! + 0.30000*K082*<PAN>*<O3> -! + 1.00000*K088*<CARBOP>*<NO2> -! - K070*<PAN>*<OH> -! - K078*<PAN>*<NO3> -! - K082*<PAN>*<O3> -! - K089*<PAN> -! terms for OP1: -! + K097*<MO2>*<HO2> -! + KTC40*<WC_OP1> -! + KTR40*<WR_OP1> -! - K013*<OP1> -! - K068*<OP1>*<OH> -! - KTC20*<OP1> -! - KTR20*<OP1> -! terms for OP2: -! + 0.10149*K081*<CARBO>*<O3> -! + 1.00524*K098*<ALKAP>*<HO2> -! + 1.00524*K099*<ALKEP>*<HO2> -! + 1.00524*K0100*<BIOP>*<HO2> -! + 1.00524*K0101*<AROP>*<HO2> -! + 0.80904*K0102*<CARBOP>*<HO2> -! + 1.00524*K126*<XO2>*<HO2> -! - K014*<OP2> -! - K069*<OP2>*<OH> -! terms for ORA1: -! + 0.00878*K058*<ALKA>*<OH> -! + 0.15343*K079*<ALKE>*<O3> -! + 0.15000*K080*<BIO>*<O3> -! + 0.10788*K081*<CARBO>*<O3> -! + 0.11*K082*<PAN>*<O3> -! + KTC37*<WC_ORA1> -! + KTR37*<WR_ORA1> -! - K066*<ORA1>*<OH> -! - KTC17*<ORA1> -! - KTR17*<ORA1> -! terms for ORA2: -! + 0.08143*K079*<ALKE>*<O3> -! + 0.00000*K080*<BIO>*<O3> -! + 0.20595*K081*<CARBO>*<O3> -! + 0.17307*K0102*<CARBOP>*<HO2> -! + 0.13684*K109*<CARBOP>*<MO2> -! + 0.49810*K111*<ALKAP>*<CARBOP> -! + 0.49922*K112*<ALKEP>*<CARBOP> -! + 0.49400*K113*<BIOP>*<CARBOP> -! + 0.09955*K115*<CARBOP>*<CARBOP> -! + 0.48963*K116*<OLN>*<CARBOP> -! + KTC38*<WC_ORA2> -! + KTR38*<WR_ORA2> -! - K067*<ORA2>*<OH> -! - KTC18*<ORA2> -! - KTR18*<ORA2> -! terms for MO2: -! + K012*<ALD> -! + 0.03795*K014*<OP2> -! + K056*<CH4>*<OH> -! + 0.65*K068*<OP1>*<OH> -! + 0.13966*K079*<ALKE>*<O3> -! + 0.03000*K080*<BIO>*<O3> -! + 0.09016*K091*<ALKAP>*<NO> -! + 0.78134*K095*<CARBOP>*<NO> -! + 0.01390*K105*<ALKAP>*<MO2> -! + 0.56031*K109*<CARBOP>*<MO2> -! + 0.51480*K111*<ALKAP>*<CARBOP> -! + 0.50078*K112*<ALKEP>*<CARBOP> -! + 0.50600*K113*<BIOP>*<CARBOP> -! + K114*<AROP>*<CARBOP> -! + 1.66702*K115*<CARBOP>*<CARBOP> -! + 0.51037*K116*<OLN>*<CARBOP> -! + 0.09731*K120*<ALKAP>*<NO3> -! + 0.91910*K124*<CARBOP>*<NO3> -! + K128*<XO2>*<CARBOP> -! + KTC39*<WC_MO2> -! + KTR39*<WR_MO2> -! - K090*<MO2>*<NO> -! - K097*<MO2>*<HO2> -! - K104*<MO2>*<MO2> -! - K104*<MO2>*<MO2> -! - K105*<ALKAP>*<MO2> -! - K106*<ALKEP>*<MO2> -! - K107*<BIOP>*<MO2> -! - K108*<AROP>*<MO2> -! - K109*<CARBOP>*<MO2> -! - K110*<OLN>*<MO2> -! - K119*<MO2>*<NO3> -! - K127*<XO2>*<MO2> -! - KTC19*<MO2> -! - KTR19*<MO2> -! terms for ALKAP: -! + 1.00000*K015*<KET> -! + K057*<ETH>*<OH> -! + 0.87811*K058*<ALKA>*<OH> -! + 0.40341*K069*<OP2>*<OH> -! + 1.00000*K071*<ONIT>*<OH> -! + 0.09815*K079*<ALKE>*<O3> -! + 0.00000*K080*<BIO>*<O3> -! + 0.08187*K091*<ALKAP>*<NO> -! + 0.00385*K105*<ALKAP>*<MO2> -! + 0.00828*K111*<ALKAP>*<CARBOP> -! + 0.08994*K120*<ALKAP>*<NO3> -! - K091*<ALKAP>*<NO> -! - K098*<ALKAP>*<HO2> -! - K105*<ALKAP>*<MO2> -! - K111*<ALKAP>*<CARBOP> -! - K120*<ALKAP>*<NO3> -! terms for ALKEP: -! + 1.02529*K059*<ALKE>*<OH> -! - K092*<ALKEP>*<NO> -! - K099*<ALKEP>*<HO2> -! - K106*<ALKEP>*<MO2> -! - K112*<ALKEP>*<CARBOP> -! - K121*<ALKEP>*<NO3> -! terms for BIOP: -! + 0.00000*K059*<ALKE>*<OH> -! + 1.00000*K060*<BIO>*<OH> -! - K093*<BIOP>*<NO> -! - K0100*<BIOP>*<HO2> -! - K107*<BIOP>*<MO2> -! - K113*<BIOP>*<CARBOP> -! - K122*<BIOP>*<NO3> -! terms for PHO: -! + 0.00276*K061*<ARO>*<OH> -! + K075*<ARO>*<NO3> -! - K083*<PHO>*<NO2> -! - K084*<PHO>*<HO2> -! terms for ADD: -! + 0.93968*K061*<ARO>*<OH> -! - K085*<ADD>*<NO2> -! - K086*<ADD>*<O2> -! - K087*<ADD>*<O3> -! terms for AROP: -! + 0.98*K086*<ADD>*<O2> -! - K094*<AROP>*<NO> -! - K0101*<AROP>*<HO2> -! - K108*<AROP>*<MO2> -! - K114*<AROP>*<CARBOP> -! - K123*<AROP>*<NO3> -! terms for CARBOP: -! + 1.00000*K015*<KET> -! + 0.69622*K016*<CARBO> -! + 1.00000*K063*<ALD>*<OH> -! + 1.00000*K064*<KET>*<OH> -! + 0.51419*K065*<CARBO>*<OH> -! + 0.05413*K069*<OP2>*<OH> -! + 1.00000*K073*<ALD>*<NO3> -! + 0.38881*K074*<CARBO>*<NO3> -! + 0.05705*K079*<ALKE>*<O3> -! + 0.17000*K080*<BIO>*<O3> -! + 0.27460*K081*<CARBO>*<O3> -! + 0.70000*K082*<PAN>*<O3> -! + 1.00000*K089*<PAN> -! + 0.09532*K095*<CARBOP>*<NO> -! + 0.05954*K109*<CARBOP>*<MO2> -! + 0.05821*K115*<CARBOP>*<CARBOP> -! + 0.03175*K124*<CARBOP>*<NO3> -! - K088*<CARBOP>*<NO2> -! - K095*<CARBOP>*<NO> -! - K0102*<CARBOP>*<HO2> -! - K109*<CARBOP>*<MO2> -! - K111*<ALKAP>*<CARBOP> -! - K112*<ALKEP>*<CARBOP> -! - K113*<BIOP>*<CARBOP> -! - K114*<AROP>*<CARBOP> -! - K115*<CARBOP>*<CARBOP> -! - K115*<CARBOP>*<CARBOP> -! - K116*<OLN>*<CARBOP> -! - K124*<CARBOP>*<NO3> -! - K128*<XO2>*<CARBOP> -! terms for OLN: -! + 0.00000*K074*<CARBO>*<NO3> -! + 0.93768*K076*<ALKE>*<NO3> -! + 1.00000*K077*<BIO>*<NO3> -! - K096*<OLN>*<NO> -! - K103*<OLN>*<HO2> -! - K110*<OLN>*<MO2> -! - K116*<OLN>*<CARBOP> -! - K117*<OLN>*<OLN> -! - K117*<OLN>*<OLN> -! - K118*<OLN>*<OLN> -! - K118*<OLN>*<OLN> -! - K125*<OLN>*<NO3> -! terms for XO2: -! + 0.15*K054*<BIO>*<O3P> -! + 0.10318*K061*<ARO>*<OH> -! + 0.10162*K065*<CARBO>*<OH> -! + 0.09333*K069*<OP2>*<OH> -! + K070*<PAN>*<OH> -! + 0.10530*K074*<CARBO>*<NO3> -! + K078*<PAN>*<NO3> -! + 0.00000*K079*<ALKE>*<O3> -! + 0.13000*K080*<BIO>*<O3> -! + 0.13007*K091*<ALKAP>*<NO> -! + 0.02563*K095*<CARBOP>*<NO> -! + 0.13370*K105*<ALKAP>*<MO2> -! + 0.02212*K109*<CARBOP>*<MO2> -! + 0.11306*K111*<ALKAP>*<CARBOP> -! + 0.01593*K115*<CARBOP>*<CARBOP> -! + 0.16271*K120*<ALKAP>*<NO3> -! + 0.01021*K124*<CARBOP>*<NO3> -! - K126*<XO2>*<HO2> -! - K127*<XO2>*<MO2> -! - K128*<XO2>*<CARBOP> -! - K129*<XO2>*<XO2> -! - K129*<XO2>*<XO2> -! - K130*<XO2>*<NO> -! - K131*<XO2>*<NO3> -! terms for WC_O3: -! + KTC1*<O3> -! - KTC21*<WC_O3> -! - KC6*<WC_O3>*<WC_HO2> -! - KC29*<WC_SO2>*<WC_O3> -! terms for WC_H2O2: -! + KTC2*<H2O2> -! + KC2*<WC_OH>*<WC_OH> -! + KC5*<WC_HO2>*<WC_HO2> -! - KTC22*<WC_H2O2> -! - KC1*<WC_H2O2> -! - KC4*<WC_H2O2>*<WC_OH> -! - KC30*<WC_SO2>*<WC_H2O2> -! terms for WC_NO: -! + KTC3*<NO> -! - KTC23*<WC_NO> -! terms for WC_NO2: -! + KTC4*<NO2> -! + KC8*<WC_HONO>*<WC_OH> -! + KC10*<WC_HNO4> -! + KC13*<WC_HNO3> -! - KTC24*<WC_NO2> -! - KC9*<WC_NO2>*<WC_HO2> -! terms for WC_NO3: -! + KTC5*<NO3> -! - KTC25*<WC_NO3> -! - KC15*<WC_NO3>*<WC_SULF> -! - KC16*<WC_NO3>*<WC_SO2> -! terms for WC_N2O5: -! + KTC6*<N2O5> -! - KTC26*<WC_N2O5> -! - KC14*<WC_N2O5> -! terms for WC_HONO: -! + KTC7*<HONO> -! + KC11*<WC_HNO4> -! - KTC27*<WC_HONO> -! - KC8*<WC_HONO>*<WC_OH> -! terms for WC_HNO3: -! + KTC8*<HNO3> -! + KC12*<WC_HNO4>*<WC_SO2> -! + KC14*<WC_N2O5> -! + KC14*<WC_N2O5> -! + KC15*<WC_NO3>*<WC_SULF> -! + KC16*<WC_NO3>*<WC_SO2> -! - KTC28*<WC_HNO3> -! - KC13*<WC_HNO3> -! terms for WC_HNO4: -! + KTC9*<HNO4> -! + KC9*<WC_NO2>*<WC_HO2> -! - KTC29*<WC_HNO4> -! - KC10*<WC_HNO4> -! - KC11*<WC_HNO4> -! - KC12*<WC_HNO4>*<WC_SO2> -! terms for WC_NH3: -! + KTC10*<NH3> -! - KTC30*<WC_NH3> -! terms for WC_OH: -! + KTC11*<OH> -! + KC1*<WC_H2O2> -! + KC1*<WC_H2O2> -! + KC6*<WC_O3>*<WC_HO2> -! + KC13*<WC_HNO3> -! + KC28*<WC_ASO4> -! - KTC31*<WC_OH> -! - KC2*<WC_OH>*<WC_OH> -! - KC2*<WC_OH>*<WC_OH> -! - KC3*<WC_OH>*<WC_HO2> -! - KC4*<WC_H2O2>*<WC_OH> -! - KC7*<WC_OH>*<WC_SO2> -! - KC8*<WC_HONO>*<WC_OH> -! - KC19*<WC_HCHO>*<WC_OH> -! - KC20*<WC_ORA1>*<WC_OH> -! - KC23*<WC_AHMS>*<WC_OH> -! terms for WC_HO2: -! + KTC12*<HO2> -! + KC4*<WC_H2O2>*<WC_OH> -! + KC10*<WC_HNO4> -! + 2.00*KC17*<WC_MO2>*<WC_MO2> -! + KC19*<WC_HCHO>*<WC_OH> -! + KC20*<WC_ORA1>*<WC_OH> -! + KC23*<WC_AHMS>*<WC_OH> -! - KTC32*<WC_HO2> -! - KC3*<WC_OH>*<WC_HO2> -! - KC5*<WC_HO2>*<WC_HO2> -! - KC5*<WC_HO2>*<WC_HO2> -! - KC6*<WC_O3>*<WC_HO2> -! - KC9*<WC_NO2>*<WC_HO2> -! - KC25*<WC_ASO5>*<WC_HO2> -! terms for WC_CO2: -! + KTC13*<CO2> -! + KC20*<WC_ORA1>*<WC_OH> -! - KTC33*<WC_CO2> -! terms for WC_SO2: -! + KTC14*<SO2> -! + KC22*<WC_AHMS> -! + KC23*<WC_AHMS>*<WC_OH> -! - KTC34*<WC_SO2> -! - KC7*<WC_OH>*<WC_SO2> -! - KC12*<WC_HNO4>*<WC_SO2> -! - KC16*<WC_NO3>*<WC_SO2> -! - KC18*<WC_MO2>*<WC_SO2> -! - KC21*<WC_SO2>*<WC_HCHO> -! - KC27*<WC_AHSO5>*<WC_SO2> -! - KC29*<WC_SO2>*<WC_O3> -! - KC30*<WC_SO2>*<WC_H2O2> -! terms for WC_SULF: -! + KTC15*<SULF> -! + KC12*<WC_HNO4>*<WC_SO2> -! + 2.00*KC27*<WC_AHSO5>*<WC_SO2> -! + KC28*<WC_ASO4> -! + KC29*<WC_SO2>*<WC_O3> -! + KC30*<WC_SO2>*<WC_H2O2> -! - KTC35*<WC_SULF> -! - KC15*<WC_NO3>*<WC_SULF> -! terms for WC_HCHO: -! + KTC16*<HCHO> -! + 2.00*KC17*<WC_MO2>*<WC_MO2> -! + KC22*<WC_AHMS> -! - KTC36*<WC_HCHO> -! - KC19*<WC_HCHO>*<WC_OH> -! - KC21*<WC_SO2>*<WC_HCHO> -! terms for WC_ORA1: -! + KTC17*<ORA1> -! + KC19*<WC_HCHO>*<WC_OH> -! + KC23*<WC_AHMS>*<WC_OH> -! - KTC37*<WC_ORA1> -! - KC20*<WC_ORA1>*<WC_OH> -! terms for WC_ORA2: -! + KTC18*<ORA2> -! - KTC38*<WC_ORA2> -! terms for WC_MO2: -! + KTC19*<MO2> -! - KTC39*<WC_MO2> -! - KC17*<WC_MO2>*<WC_MO2> -! - KC17*<WC_MO2>*<WC_MO2> -! - KC18*<WC_MO2>*<WC_SO2> -! terms for WC_OP1: -! + KTC20*<OP1> -! + KC18*<WC_MO2>*<WC_SO2> -! - KTC40*<WC_OP1> -! terms for WC_ASO3: -! + KC7*<WC_OH>*<WC_SO2> -! + KC16*<WC_NO3>*<WC_SO2> -! + KC18*<WC_MO2>*<WC_SO2> -! - KC24*<WC_ASO3>*<W_O2> -! terms for WC_ASO4: -! + KC15*<WC_NO3>*<WC_SULF> -! + KC26*<WC_ASO5>*<WC_ASO5> -! + KC26*<WC_ASO5>*<WC_ASO5> -! - KC28*<WC_ASO4> -! terms for WC_ASO5: -! + KC24*<WC_ASO3>*<W_O2> -! - KC25*<WC_ASO5>*<WC_HO2> -! - KC26*<WC_ASO5>*<WC_ASO5> -! - KC26*<WC_ASO5>*<WC_ASO5> -! terms for WC_AHSO5: -! + KC25*<WC_ASO5>*<WC_HO2> -! - KC27*<WC_AHSO5>*<WC_SO2> -! terms for WC_AHMS: -! + KC21*<WC_SO2>*<WC_HCHO> -! - KC22*<WC_AHMS> -! - KC23*<WC_AHMS>*<WC_OH> -! terms for WR_O3: -! + KTR1*<O3> -! - KTR21*<WR_O3> -! - KR6*<WR_O3>*<WR_HO2> -! - KR29*<WR_SO2>*<WR_O3> -! terms for WR_H2O2: -! + KTR2*<H2O2> -! + KR2*<WR_OH>*<WR_OH> -! + KR5*<WR_HO2>*<WR_HO2> -! - KTR22*<WR_H2O2> -! - KR1*<WR_H2O2> -! - KR4*<WR_H2O2>*<WR_OH> -! - KR30*<WR_SO2>*<WR_H2O2> -! terms for WR_NO: -! + KTR3*<NO> -! - KTR23*<WR_NO> -! terms for WR_NO2: -! + KTR4*<NO2> -! + KR8*<WR_HONO>*<WR_OH> -! + KR10*<WR_HNO4> -! + KR13*<WR_HNO3> -! - KTR24*<WR_NO2> -! - KR9*<WR_NO2>*<WR_HO2> -! terms for WR_NO3: -! + KTR5*<NO3> -! - KTR25*<WR_NO3> -! - KR15*<WR_NO3>*<WR_SULF> -! - KR16*<WR_NO3>*<WR_SO2> -! terms for WR_N2O5: -! + KTR6*<N2O5> -! - KTR26*<WR_N2O5> -! - KR14*<WR_N2O5> -! terms for WR_HONO: -! + KTR7*<HONO> -! + KR11*<WR_HNO4> -! - KTR27*<WR_HONO> -! - KR8*<WR_HONO>*<WR_OH> -! terms for WR_HNO3: -! + KTR8*<HNO3> -! + KR12*<WR_HNO4>*<WR_SO2> -! + KR14*<WR_N2O5> -! + KR14*<WR_N2O5> -! + KR15*<WR_NO3>*<WR_SULF> -! + KR16*<WR_NO3>*<WR_SO2> -! - KTR28*<WR_HNO3> -! - KR13*<WR_HNO3> -! terms for WR_HNO4: -! + KTR9*<HNO4> -! + KR9*<WR_NO2>*<WR_HO2> -! - KTR29*<WR_HNO4> -! - KR10*<WR_HNO4> -! - KR11*<WR_HNO4> -! - KR12*<WR_HNO4>*<WR_SO2> -! terms for WR_NH3: -! + KTR10*<NH3> -! - KTR30*<WR_NH3> -! terms for WR_OH: -! + KTR11*<OH> -! + KR1*<WR_H2O2> -! + KR1*<WR_H2O2> -! + KR6*<WR_O3>*<WR_HO2> -! + KR13*<WR_HNO3> -! + KR28*<WR_ASO4> -! - KTR31*<WR_OH> -! - KR2*<WR_OH>*<WR_OH> -! - KR2*<WR_OH>*<WR_OH> -! - KR3*<WR_OH>*<WR_HO2> -! - KR4*<WR_H2O2>*<WR_OH> -! - KR7*<WR_OH>*<WR_SO2> -! - KR8*<WR_HONO>*<WR_OH> -! - KR19*<WR_HCHO>*<WR_OH> -! - KR20*<WR_ORA1>*<WR_OH> -! - KR23*<WR_AHMS>*<WR_OH> -! terms for WR_HO2: -! + KTR12*<HO2> -! + KR4*<WR_H2O2>*<WR_OH> -! + KR10*<WR_HNO4> -! + 2.00*KR17*<WR_MO2>*<WR_MO2> -! + KR19*<WR_HCHO>*<WR_OH> -! + KR20*<WR_ORA1>*<WR_OH> -! + KR23*<WR_AHMS>*<WR_OH> -! - KTR32*<WR_HO2> -! - KR3*<WR_OH>*<WR_HO2> -! - KR5*<WR_HO2>*<WR_HO2> -! - KR5*<WR_HO2>*<WR_HO2> -! - KR6*<WR_O3>*<WR_HO2> -! - KR9*<WR_NO2>*<WR_HO2> -! - KR25*<WR_ASO5>*<WR_HO2> -! terms for WR_CO2: -! + KTR13*<CO2> -! + KR20*<WR_ORA1>*<WR_OH> -! - KTR33*<WR_CO2> -! terms for WR_SO2: -! + KTR14*<SO2> -! + KR22*<WR_AHMS> -! + KR23*<WR_AHMS>*<WR_OH> -! - KTR34*<WR_SO2> -! - KR7*<WR_OH>*<WR_SO2> -! - KR12*<WR_HNO4>*<WR_SO2> -! - KR16*<WR_NO3>*<WR_SO2> -! - KR18*<WR_MO2>*<WR_SO2> -! - KR21*<WR_SO2>*<WR_HCHO> -! - KR27*<WR_AHSO5>*<WR_SO2> -! - KR29*<WR_SO2>*<WR_O3> -! - KR30*<WR_SO2>*<WR_H2O2> -! terms for WR_SULF: -! + KTR15*<SULF> -! + KR12*<WR_HNO4>*<WR_SO2> -! + 2.00*KR27*<WR_AHSO5>*<WR_SO2> -! + KR28*<WR_ASO4> -! + KR29*<WR_SO2>*<WR_O3> -! + KR30*<WR_SO2>*<WR_H2O2> -! - KTR35*<WR_SULF> -! - KR15*<WR_NO3>*<WR_SULF> -! terms for WR_HCHO: -! + KTR16*<HCHO> -! + 2.00*KR17*<WR_MO2>*<WR_MO2> -! + KR22*<WR_AHMS> -! - KTR36*<WR_HCHO> -! - KR19*<WR_HCHO>*<WR_OH> -! - KR21*<WR_SO2>*<WR_HCHO> -! terms for WR_ORA1: -! + KTR17*<ORA1> -! + KR19*<WR_HCHO>*<WR_OH> -! + KR23*<WR_AHMS>*<WR_OH> -! - KTR37*<WR_ORA1> -! - KR20*<WR_ORA1>*<WR_OH> -! terms for WR_ORA2: -! + KTR18*<ORA2> -! - KTR38*<WR_ORA2> -! terms for WR_MO2: -! + KTR19*<MO2> -! - KTR39*<WR_MO2> -! - KR17*<WR_MO2>*<WR_MO2> -! - KR17*<WR_MO2>*<WR_MO2> -! - KR18*<WR_MO2>*<WR_SO2> -! terms for WR_OP1: -! + KTR20*<OP1> -! + KR18*<WR_MO2>*<WR_SO2> -! - KTR40*<WR_OP1> -! terms for WR_ASO3: -! + KR7*<WR_OH>*<WR_SO2> -! + KR16*<WR_NO3>*<WR_SO2> -! + KR18*<WR_MO2>*<WR_SO2> -! - KR24*<WR_ASO3>*<W_O2> -! terms for WR_ASO4: -! + KR15*<WR_NO3>*<WR_SULF> -! + KR26*<WR_ASO5>*<WR_ASO5> -! + KR26*<WR_ASO5>*<WR_ASO5> -! - KR28*<WR_ASO4> -! terms for WR_ASO5: -! + KR24*<WR_ASO3>*<W_O2> -! - KR25*<WR_ASO5>*<WR_HO2> -! - KR26*<WR_ASO5>*<WR_ASO5> -! - KR26*<WR_ASO5>*<WR_ASO5> -! terms for WR_AHSO5: -! + KR25*<WR_ASO5>*<WR_HO2> -! - KR27*<WR_AHSO5>*<WR_SO2> -! terms for WR_AHMS: -! + KR21*<WR_SO2>*<WR_HCHO> -! - KR22*<WR_AHMS> -! - KR23*<WR_AHMS>*<WR_OH> -! -!======================================================================== -! -!! ######################## - MODULE MODD_CH_M9_SCHEME -!! ######################## -!! This code has been created automatically by preprocessor m10, -!! version: 9.7, copyright 1995-1999 by Meteo France/Universite Paul Sabatier. -!! Please report all bugs to K. Suhre (Lab. d'Aerologie UPS/CNRS). -!! -!!*** *MODD_CH_M9_SCHEME* -!! -!! PURPOSE -!! ------- -! definition of variables and types for the chemical core system -!! -!!** METHOD -!! ------ -!! All constants and auxiliary variables are stored in one common -!! data type (CCSTYPE). This allows to pass them all as one single -!! variable in the argument lists of the CCS. -!! The constants NEQ, NEQAQ and NREAC are duplicated here in order -!! to avoid decouple the CCS from the other modules of MNHC. -!! Variables to be transfered from the meteorological part are stored -!! in the data type METEOTRANSTYPE (number, value and name). -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Karsten Suhre (LA) -!! -!! MODIFICATIONS -!! ------------- -!! Original 26/07/96 -!! Modified 05/05/98: Vectorization (Vincent Crassier & KS) -!! Modified 31/10/03: New interface for better MesoNH compilation (D. Gazen) -!! -!!---------------------------------------------------------------------- -!! DECLARATIONS -!! ------------ -IMPLICIT NONE -INTEGER, DIMENSION(2), PARAMETER :: JPNEQ = (/42,92/) ! number of prognostic chemical species -INTEGER, DIMENSION(2), PARAMETER :: JPNEQAQ = (/0,50/) ! number of prognostic aqueous phase chemical species -INTEGER, DIMENSION(2), PARAMETER :: JPNREAC = (/135,275/) ! number of chemical reactions -INTEGER, DIMENSION(2), PARAMETER :: JPNMETEOVARS = (/13,13/) ! number of meteorological variables -INTEGER, DIMENSION(2), PARAMETER :: JPNNONZEROTERMS = (/615,951/) ! number of non-zero terms returned by CH_TERMS -! -CHARACTER(LEN=32), DIMENSION(JPNEQ(2)), TARGET :: CNAMES ! names of the species -CHARACTER(LEN=32), DIMENSION(JPNREAC(2)), TARGET :: CREACS ! the reaction rate names -CHARACTER(LEN=256), DIMENSION(JPNREAC(2)), TARGET :: CFULLREACS ! the full reactions -! -TYPE CCSTYPE ! reaction rates and auxiliary variables - LOGICAL :: LUSECHAQ - LOGICAL :: LCH_PH - INTEGER :: NEQ ! number of prognostic chemical species - INTEGER :: NEQAQ ! number of prognostic aqueous phase chemical species - INTEGER :: NREAC ! number of chemical reactions - INTEGER :: NMETEOVARS ! number of meteorological variables - INTEGER :: NNONZEROTERMS ! number of non-zero terms returned by CH_TE -REAL,DIMENSION(:),POINTER :: K001=>NULL() -REAL,DIMENSION(:),POINTER :: K002=>NULL() -REAL,DIMENSION(:),POINTER :: K003=>NULL() -REAL,DIMENSION(:),POINTER :: K004=>NULL() -REAL,DIMENSION(:),POINTER :: K005=>NULL() -REAL,DIMENSION(:),POINTER :: K006=>NULL() -REAL,DIMENSION(:),POINTER :: K007=>NULL() -REAL,DIMENSION(:),POINTER :: K008=>NULL() -REAL,DIMENSION(:),POINTER :: K009=>NULL() -REAL,DIMENSION(:),POINTER :: K010=>NULL() -REAL,DIMENSION(:),POINTER :: K011=>NULL() -REAL,DIMENSION(:),POINTER :: K012=>NULL() -REAL,DIMENSION(:),POINTER :: K013=>NULL() -REAL,DIMENSION(:),POINTER :: K014=>NULL() -REAL,DIMENSION(:),POINTER :: K015=>NULL() -REAL,DIMENSION(:),POINTER :: K016=>NULL() -REAL,DIMENSION(:),POINTER :: K017=>NULL() -REAL,DIMENSION(:),POINTER :: K018=>NULL() -REAL,DIMENSION(:),POINTER :: K019=>NULL() -REAL,DIMENSION(:),POINTER :: K020=>NULL() -REAL,DIMENSION(:),POINTER :: K021=>NULL() -REAL,DIMENSION(:),POINTER :: K022=>NULL() -REAL,DIMENSION(:),POINTER :: K023=>NULL() -REAL,DIMENSION(:),POINTER :: K024=>NULL() -REAL,DIMENSION(:),POINTER :: K025=>NULL() -REAL,DIMENSION(:),POINTER :: K026=>NULL() -REAL,DIMENSION(:),POINTER :: K027=>NULL() -REAL,DIMENSION(:),POINTER :: K028=>NULL() -REAL,DIMENSION(:),POINTER :: K029=>NULL() -REAL,DIMENSION(:),POINTER :: K030=>NULL() -REAL,DIMENSION(:),POINTER :: K031=>NULL() -REAL,DIMENSION(:),POINTER :: K032=>NULL() -REAL,DIMENSION(:),POINTER :: K033=>NULL() -REAL,DIMENSION(:),POINTER :: K034=>NULL() -REAL,DIMENSION(:),POINTER :: K035=>NULL() -REAL,DIMENSION(:),POINTER :: K036=>NULL() -REAL,DIMENSION(:),POINTER :: K037=>NULL() -REAL,DIMENSION(:),POINTER :: K038=>NULL() -REAL,DIMENSION(:),POINTER :: K039=>NULL() -REAL,DIMENSION(:),POINTER :: K040=>NULL() -REAL,DIMENSION(:),POINTER :: K041=>NULL() -REAL,DIMENSION(:),POINTER :: K042=>NULL() -REAL,DIMENSION(:),POINTER :: K043=>NULL() -REAL,DIMENSION(:),POINTER :: K044=>NULL() -REAL,DIMENSION(:),POINTER :: K045=>NULL() -REAL,DIMENSION(:),POINTER :: K046=>NULL() -REAL,DIMENSION(:),POINTER :: K047=>NULL() -REAL,DIMENSION(:),POINTER :: K048=>NULL() -REAL,DIMENSION(:),POINTER :: K049=>NULL() -REAL,DIMENSION(:),POINTER :: K050=>NULL() -REAL,DIMENSION(:),POINTER :: K051=>NULL() -REAL,DIMENSION(:),POINTER :: K052=>NULL() -REAL,DIMENSION(:),POINTER :: K053=>NULL() -REAL,DIMENSION(:),POINTER :: K054=>NULL() -REAL,DIMENSION(:),POINTER :: K055=>NULL() -REAL,DIMENSION(:),POINTER :: K056=>NULL() -REAL,DIMENSION(:),POINTER :: K057=>NULL() -REAL,DIMENSION(:),POINTER :: K058=>NULL() -REAL,DIMENSION(:),POINTER :: K059=>NULL() -REAL,DIMENSION(:),POINTER :: K060=>NULL() -REAL,DIMENSION(:),POINTER :: K061=>NULL() -REAL,DIMENSION(:),POINTER :: K062=>NULL() -REAL,DIMENSION(:),POINTER :: K063=>NULL() -REAL,DIMENSION(:),POINTER :: K064=>NULL() -REAL,DIMENSION(:),POINTER :: K065=>NULL() -REAL,DIMENSION(:),POINTER :: K066=>NULL() -REAL,DIMENSION(:),POINTER :: K067=>NULL() -REAL,DIMENSION(:),POINTER :: K068=>NULL() -REAL,DIMENSION(:),POINTER :: K069=>NULL() -REAL,DIMENSION(:),POINTER :: K070=>NULL() -REAL,DIMENSION(:),POINTER :: K071=>NULL() -REAL,DIMENSION(:),POINTER :: K072=>NULL() -REAL,DIMENSION(:),POINTER :: K073=>NULL() -REAL,DIMENSION(:),POINTER :: K074=>NULL() -REAL,DIMENSION(:),POINTER :: K075=>NULL() -REAL,DIMENSION(:),POINTER :: K076=>NULL() -REAL,DIMENSION(:),POINTER :: K077=>NULL() -REAL,DIMENSION(:),POINTER :: K078=>NULL() -REAL,DIMENSION(:),POINTER :: K079=>NULL() -REAL,DIMENSION(:),POINTER :: K080=>NULL() -REAL,DIMENSION(:),POINTER :: K081=>NULL() -REAL,DIMENSION(:),POINTER :: K082=>NULL() -REAL,DIMENSION(:),POINTER :: K083=>NULL() -REAL,DIMENSION(:),POINTER :: K084=>NULL() -REAL,DIMENSION(:),POINTER :: K085=>NULL() -REAL,DIMENSION(:),POINTER :: K086=>NULL() -REAL,DIMENSION(:),POINTER :: K087=>NULL() -REAL,DIMENSION(:),POINTER :: K088=>NULL() -REAL,DIMENSION(:),POINTER :: K089=>NULL() -REAL,DIMENSION(:),POINTER :: K090=>NULL() -REAL,DIMENSION(:),POINTER :: K091=>NULL() -REAL,DIMENSION(:),POINTER :: K092=>NULL() -REAL,DIMENSION(:),POINTER :: K093=>NULL() -REAL,DIMENSION(:),POINTER :: K094=>NULL() -REAL,DIMENSION(:),POINTER :: K095=>NULL() -REAL,DIMENSION(:),POINTER :: K096=>NULL() -REAL,DIMENSION(:),POINTER :: K097=>NULL() -REAL,DIMENSION(:),POINTER :: K098=>NULL() -REAL,DIMENSION(:),POINTER :: K099=>NULL() -REAL,DIMENSION(:),POINTER :: K0100=>NULL() -REAL,DIMENSION(:),POINTER :: K0101=>NULL() -REAL,DIMENSION(:),POINTER :: K0102=>NULL() -REAL,DIMENSION(:),POINTER :: K103=>NULL() -REAL,DIMENSION(:),POINTER :: K104=>NULL() -REAL,DIMENSION(:),POINTER :: K105=>NULL() -REAL,DIMENSION(:),POINTER :: K106=>NULL() -REAL,DIMENSION(:),POINTER :: K107=>NULL() -REAL,DIMENSION(:),POINTER :: K108=>NULL() -REAL,DIMENSION(:),POINTER :: K109=>NULL() -REAL,DIMENSION(:),POINTER :: K110=>NULL() -REAL,DIMENSION(:),POINTER :: K111=>NULL() -REAL,DIMENSION(:),POINTER :: K112=>NULL() -REAL,DIMENSION(:),POINTER :: K113=>NULL() -REAL,DIMENSION(:),POINTER :: K114=>NULL() -REAL,DIMENSION(:),POINTER :: K115=>NULL() -REAL,DIMENSION(:),POINTER :: K116=>NULL() -REAL,DIMENSION(:),POINTER :: K117=>NULL() -REAL,DIMENSION(:),POINTER :: K118=>NULL() -REAL,DIMENSION(:),POINTER :: K119=>NULL() -REAL,DIMENSION(:),POINTER :: K120=>NULL() -REAL,DIMENSION(:),POINTER :: K121=>NULL() -REAL,DIMENSION(:),POINTER :: K122=>NULL() -REAL,DIMENSION(:),POINTER :: K123=>NULL() -REAL,DIMENSION(:),POINTER :: K124=>NULL() -REAL,DIMENSION(:),POINTER :: K125=>NULL() -REAL,DIMENSION(:),POINTER :: K126=>NULL() -REAL,DIMENSION(:),POINTER :: K127=>NULL() -REAL,DIMENSION(:),POINTER :: K128=>NULL() -REAL,DIMENSION(:),POINTER :: K129=>NULL() -REAL,DIMENSION(:),POINTER :: K130=>NULL() -REAL,DIMENSION(:),POINTER :: K131=>NULL() -REAL,DIMENSION(:),POINTER :: K132=>NULL() -REAL,DIMENSION(:),POINTER :: K133=>NULL() -REAL,DIMENSION(:),POINTER :: K134=>NULL() -REAL,DIMENSION(:),POINTER :: K135=>NULL() -REAL,DIMENSION(:),POINTER :: KTC1=>NULL() -REAL,DIMENSION(:),POINTER :: KTC2=>NULL() -REAL,DIMENSION(:),POINTER :: KTC3=>NULL() -REAL,DIMENSION(:),POINTER :: KTC4=>NULL() -REAL,DIMENSION(:),POINTER :: KTC5=>NULL() -REAL,DIMENSION(:),POINTER :: KTC6=>NULL() -REAL,DIMENSION(:),POINTER :: KTC7=>NULL() -REAL,DIMENSION(:),POINTER :: KTC8=>NULL() -REAL,DIMENSION(:),POINTER :: KTC9=>NULL() -REAL,DIMENSION(:),POINTER :: KTC10=>NULL() -REAL,DIMENSION(:),POINTER :: KTC11=>NULL() -REAL,DIMENSION(:),POINTER :: KTC12=>NULL() -REAL,DIMENSION(:),POINTER :: KTC13=>NULL() -REAL,DIMENSION(:),POINTER :: KTC14=>NULL() -REAL,DIMENSION(:),POINTER :: KTC15=>NULL() -REAL,DIMENSION(:),POINTER :: KTC16=>NULL() -REAL,DIMENSION(:),POINTER :: KTC17=>NULL() -REAL,DIMENSION(:),POINTER :: KTC18=>NULL() -REAL,DIMENSION(:),POINTER :: KTC19=>NULL() -REAL,DIMENSION(:),POINTER :: KTC20=>NULL() -REAL,DIMENSION(:),POINTER :: KTC21=>NULL() -REAL,DIMENSION(:),POINTER :: KTC22=>NULL() -REAL,DIMENSION(:),POINTER :: KTC23=>NULL() -REAL,DIMENSION(:),POINTER :: KTC24=>NULL() -REAL,DIMENSION(:),POINTER :: KTC25=>NULL() -REAL,DIMENSION(:),POINTER :: KTC26=>NULL() -REAL,DIMENSION(:),POINTER :: KTC27=>NULL() -REAL,DIMENSION(:),POINTER :: KTC28=>NULL() -REAL,DIMENSION(:),POINTER :: KTC29=>NULL() -REAL,DIMENSION(:),POINTER :: KTC30=>NULL() -REAL,DIMENSION(:),POINTER :: KTC31=>NULL() -REAL,DIMENSION(:),POINTER :: KTC32=>NULL() -REAL,DIMENSION(:),POINTER :: KTC33=>NULL() -REAL,DIMENSION(:),POINTER :: KTC34=>NULL() -REAL,DIMENSION(:),POINTER :: KTC35=>NULL() -REAL,DIMENSION(:),POINTER :: KTC36=>NULL() -REAL,DIMENSION(:),POINTER :: KTC37=>NULL() -REAL,DIMENSION(:),POINTER :: KTC38=>NULL() -REAL,DIMENSION(:),POINTER :: KTC39=>NULL() -REAL,DIMENSION(:),POINTER :: KTC40=>NULL() -REAL,DIMENSION(:),POINTER :: KTR1=>NULL() -REAL,DIMENSION(:),POINTER :: KTR2=>NULL() -REAL,DIMENSION(:),POINTER :: KTR3=>NULL() -REAL,DIMENSION(:),POINTER :: KTR4=>NULL() -REAL,DIMENSION(:),POINTER :: KTR5=>NULL() -REAL,DIMENSION(:),POINTER :: KTR6=>NULL() -REAL,DIMENSION(:),POINTER :: KTR7=>NULL() -REAL,DIMENSION(:),POINTER :: KTR8=>NULL() -REAL,DIMENSION(:),POINTER :: KTR9=>NULL() -REAL,DIMENSION(:),POINTER :: KTR10=>NULL() -REAL,DIMENSION(:),POINTER :: KTR11=>NULL() -REAL,DIMENSION(:),POINTER :: KTR12=>NULL() -REAL,DIMENSION(:),POINTER :: KTR13=>NULL() -REAL,DIMENSION(:),POINTER :: KTR14=>NULL() -REAL,DIMENSION(:),POINTER :: KTR15=>NULL() -REAL,DIMENSION(:),POINTER :: KTR16=>NULL() -REAL,DIMENSION(:),POINTER :: KTR17=>NULL() -REAL,DIMENSION(:),POINTER :: KTR18=>NULL() -REAL,DIMENSION(:),POINTER :: KTR19=>NULL() -REAL,DIMENSION(:),POINTER :: KTR20=>NULL() -REAL,DIMENSION(:),POINTER :: KTR21=>NULL() -REAL,DIMENSION(:),POINTER :: KTR22=>NULL() -REAL,DIMENSION(:),POINTER :: KTR23=>NULL() -REAL,DIMENSION(:),POINTER :: KTR24=>NULL() -REAL,DIMENSION(:),POINTER :: KTR25=>NULL() -REAL,DIMENSION(:),POINTER :: KTR26=>NULL() -REAL,DIMENSION(:),POINTER :: KTR27=>NULL() -REAL,DIMENSION(:),POINTER :: KTR28=>NULL() -REAL,DIMENSION(:),POINTER :: KTR29=>NULL() -REAL,DIMENSION(:),POINTER :: KTR30=>NULL() -REAL,DIMENSION(:),POINTER :: KTR31=>NULL() -REAL,DIMENSION(:),POINTER :: KTR32=>NULL() -REAL,DIMENSION(:),POINTER :: KTR33=>NULL() -REAL,DIMENSION(:),POINTER :: KTR34=>NULL() -REAL,DIMENSION(:),POINTER :: KTR35=>NULL() -REAL,DIMENSION(:),POINTER :: KTR36=>NULL() -REAL,DIMENSION(:),POINTER :: KTR37=>NULL() -REAL,DIMENSION(:),POINTER :: KTR38=>NULL() -REAL,DIMENSION(:),POINTER :: KTR39=>NULL() -REAL,DIMENSION(:),POINTER :: KTR40=>NULL() -REAL,DIMENSION(:),POINTER :: KC1=>NULL() -REAL,DIMENSION(:),POINTER :: KC2=>NULL() -REAL,DIMENSION(:),POINTER :: KC3=>NULL() -REAL,DIMENSION(:),POINTER :: KC4=>NULL() -REAL,DIMENSION(:),POINTER :: KC5=>NULL() -REAL,DIMENSION(:),POINTER :: KC6=>NULL() -REAL,DIMENSION(:),POINTER :: KC7=>NULL() -REAL,DIMENSION(:),POINTER :: KC8=>NULL() -REAL,DIMENSION(:),POINTER :: KC9=>NULL() -REAL,DIMENSION(:),POINTER :: KC10=>NULL() -REAL,DIMENSION(:),POINTER :: KC11=>NULL() -REAL,DIMENSION(:),POINTER :: KC12=>NULL() -REAL,DIMENSION(:),POINTER :: KC13=>NULL() -REAL,DIMENSION(:),POINTER :: KC14=>NULL() -REAL,DIMENSION(:),POINTER :: KC15=>NULL() -REAL,DIMENSION(:),POINTER :: KC16=>NULL() -REAL,DIMENSION(:),POINTER :: KC17=>NULL() -REAL,DIMENSION(:),POINTER :: KC18=>NULL() -REAL,DIMENSION(:),POINTER :: KC19=>NULL() -REAL,DIMENSION(:),POINTER :: KC20=>NULL() -REAL,DIMENSION(:),POINTER :: KC21=>NULL() -REAL,DIMENSION(:),POINTER :: KC22=>NULL() -REAL,DIMENSION(:),POINTER :: KC23=>NULL() -REAL,DIMENSION(:),POINTER :: KC24=>NULL() -REAL,DIMENSION(:),POINTER :: KC25=>NULL() -REAL,DIMENSION(:),POINTER :: KC26=>NULL() -REAL,DIMENSION(:),POINTER :: KC27=>NULL() -REAL,DIMENSION(:),POINTER :: KC28=>NULL() -REAL,DIMENSION(:),POINTER :: KC29=>NULL() -REAL,DIMENSION(:),POINTER :: KC30=>NULL() -REAL,DIMENSION(:),POINTER :: KR1=>NULL() -REAL,DIMENSION(:),POINTER :: KR2=>NULL() -REAL,DIMENSION(:),POINTER :: KR3=>NULL() -REAL,DIMENSION(:),POINTER :: KR4=>NULL() -REAL,DIMENSION(:),POINTER :: KR5=>NULL() -REAL,DIMENSION(:),POINTER :: KR6=>NULL() -REAL,DIMENSION(:),POINTER :: KR7=>NULL() -REAL,DIMENSION(:),POINTER :: KR8=>NULL() -REAL,DIMENSION(:),POINTER :: KR9=>NULL() -REAL,DIMENSION(:),POINTER :: KR10=>NULL() -REAL,DIMENSION(:),POINTER :: KR11=>NULL() -REAL,DIMENSION(:),POINTER :: KR12=>NULL() -REAL,DIMENSION(:),POINTER :: KR13=>NULL() -REAL,DIMENSION(:),POINTER :: KR14=>NULL() -REAL,DIMENSION(:),POINTER :: KR15=>NULL() -REAL,DIMENSION(:),POINTER :: KR16=>NULL() -REAL,DIMENSION(:),POINTER :: KR17=>NULL() -REAL,DIMENSION(:),POINTER :: KR18=>NULL() -REAL,DIMENSION(:),POINTER :: KR19=>NULL() -REAL,DIMENSION(:),POINTER :: KR20=>NULL() -REAL,DIMENSION(:),POINTER :: KR21=>NULL() -REAL,DIMENSION(:),POINTER :: KR22=>NULL() -REAL,DIMENSION(:),POINTER :: KR23=>NULL() -REAL,DIMENSION(:),POINTER :: KR24=>NULL() -REAL,DIMENSION(:),POINTER :: KR25=>NULL() -REAL,DIMENSION(:),POINTER :: KR26=>NULL() -REAL,DIMENSION(:),POINTER :: KR27=>NULL() -REAL,DIMENSION(:),POINTER :: KR28=>NULL() -REAL,DIMENSION(:),POINTER :: KR29=>NULL() -REAL,DIMENSION(:),POINTER :: KR30=>NULL() -! output channel (NOUT) and verbosity level (NVERB) - INTEGER :: NOUT -INTEGER,DIMENSION(:),POINTER :: NVERB=>NULL() -! auxiliary variables defined by the user, if any (e.g. O2, N2, H2O) -! /BEGIN_MODULE/ -! -! supplementary variables of the CCS that are to be placed into -! the TYPE definition of TPK (to be addressed e.g. as TPK%O2): -! -INTEGER,DIMENSION(:),POINTER :: MODELLEVEL ! index of the model level (1 for box model) -REAL,DIMENSION(:),POINTER :: T, &! temperature (K) - PRESSURE, &! pressure (atm) - M, &! air density (molec/cm3) - H2O, &! conc. of water molecules (molec/cm3) - CLOUDWATER, &! cloud water (kg/kg) - RAINWATER, &! rain water (kg/kg) - RHODREF, &! ref dry air density (kg/m3) - O2, N2, H2, &! conc. of oxigen nitrogen, hydrogen (molec/cm3) - OH, O1D, O3P, &! (molec/cm3) at equilibrium (fast species) - LON, &! longitude of curtrent grid point (degree) - LAT ! latitude of curtrent grid point (degree) -INTEGER,DIMENSION(:),POINTER :: YEAR, MONTH, DAY ! starting date of experiment (~DTEXP) -REAL,DIMENSION(:),POINTER :: LWC, &! cloud liquid water content (vol/vol) - MOL2MOLECCLOUD, &! conversion factor mole/L to molec/cm3 in cloud - RADC, &! mean radius of cloud droplet (µm) - PHC, &! pH value of cloud water - LWR, &! rain liquid water content (vol/vol) - MOL2MOLECRAIN, &! conversion factor mole/L to molec/cm3 in rain - RADR, &! mean radius of rain drops (µm) - PHR, &! pH value of rain water - CO2, &! conc. of CO2 (molec/cm3) - RCH, &! perfect gases constant - W_O2 ! conc. of O2 in aqueous phase at equilibrium (M) -! -! /END_MODULE/ -END TYPE CCSTYPE -! -! Use array of CCSTYPE to handle the 8 possible models : -! TACCS(i) refers to the CCSTYPE variable of the ith model -! You should declare a TYPE(CCSTYPE) pointer variable TZK to point to -! TACCS(i) in each subroutine that deals with CCSTYPE variables : -! -! TYPE(CCSTYPE),POINTER :: TZK -! -! TZK=>TACCS(KMI) -! -TYPE(CCSTYPE), DIMENSION(8), TARGET, SAVE :: TACCS ! 8 models -! -! list of chemical species indices -INTEGER, PARAMETER :: JP_O3 = 1 -INTEGER, PARAMETER :: JP_H2O2 = 2 -INTEGER, PARAMETER :: JP_NO = 3 -INTEGER, PARAMETER :: JP_NO2 = 4 -INTEGER, PARAMETER :: JP_NO3 = 5 -INTEGER, PARAMETER :: JP_N2O5 = 6 -INTEGER, PARAMETER :: JP_HONO = 7 -INTEGER, PARAMETER :: JP_HNO3 = 8 -INTEGER, PARAMETER :: JP_HNO4 = 9 -INTEGER, PARAMETER :: JP_NH3 = 10 -INTEGER, PARAMETER :: JP_DMS = 11 -INTEGER, PARAMETER :: JP_SO2 = 12 -INTEGER, PARAMETER :: JP_SULF = 13 -INTEGER, PARAMETER :: JP_CO = 14 -INTEGER, PARAMETER :: JP_OH = 15 -INTEGER, PARAMETER :: JP_HO2 = 16 -INTEGER, PARAMETER :: JP_CH4 = 17 -INTEGER, PARAMETER :: JP_ETH = 18 -INTEGER, PARAMETER :: JP_ALKA = 19 -INTEGER, PARAMETER :: JP_ALKE = 20 -INTEGER, PARAMETER :: JP_BIO = 21 -INTEGER, PARAMETER :: JP_ARO = 22 -INTEGER, PARAMETER :: JP_HCHO = 23 -INTEGER, PARAMETER :: JP_ALD = 24 -INTEGER, PARAMETER :: JP_KET = 25 -INTEGER, PARAMETER :: JP_CARBO = 26 -INTEGER, PARAMETER :: JP_ONIT = 27 -INTEGER, PARAMETER :: JP_PAN = 28 -INTEGER, PARAMETER :: JP_OP1 = 29 -INTEGER, PARAMETER :: JP_OP2 = 30 -INTEGER, PARAMETER :: JP_ORA1 = 31 -INTEGER, PARAMETER :: JP_ORA2 = 32 -INTEGER, PARAMETER :: JP_MO2 = 33 -INTEGER, PARAMETER :: JP_ALKAP = 34 -INTEGER, PARAMETER :: JP_ALKEP = 35 -INTEGER, PARAMETER :: JP_BIOP = 36 -INTEGER, PARAMETER :: JP_PHO = 37 -INTEGER, PARAMETER :: JP_ADD = 38 -INTEGER, PARAMETER :: JP_AROP = 39 -INTEGER, PARAMETER :: JP_CARBOP = 40 -INTEGER, PARAMETER :: JP_OLN = 41 -INTEGER, PARAMETER :: JP_XO2 = 42 -INTEGER, PARAMETER :: JP_WC_O3 = 43 -INTEGER, PARAMETER :: JP_WC_H2O2 = 44 -INTEGER, PARAMETER :: JP_WC_NO = 45 -INTEGER, PARAMETER :: JP_WC_NO2 = 46 -INTEGER, PARAMETER :: JP_WC_NO3 = 47 -INTEGER, PARAMETER :: JP_WC_N2O5 = 48 -INTEGER, PARAMETER :: JP_WC_HONO = 49 -INTEGER, PARAMETER :: JP_WC_HNO3 = 50 -INTEGER, PARAMETER :: JP_WC_HNO4 = 51 -INTEGER, PARAMETER :: JP_WC_NH3 = 52 -INTEGER, PARAMETER :: JP_WC_OH = 53 -INTEGER, PARAMETER :: JP_WC_HO2 = 54 -INTEGER, PARAMETER :: JP_WC_CO2 = 55 -INTEGER, PARAMETER :: JP_WC_SO2 = 56 -INTEGER, PARAMETER :: JP_WC_SULF = 57 -INTEGER, PARAMETER :: JP_WC_HCHO = 58 -INTEGER, PARAMETER :: JP_WC_ORA1 = 59 -INTEGER, PARAMETER :: JP_WC_ORA2 = 60 -INTEGER, PARAMETER :: JP_WC_MO2 = 61 -INTEGER, PARAMETER :: JP_WC_OP1 = 62 -INTEGER, PARAMETER :: JP_WC_ASO3 = 63 -INTEGER, PARAMETER :: JP_WC_ASO4 = 64 -INTEGER, PARAMETER :: JP_WC_ASO5 = 65 -INTEGER, PARAMETER :: JP_WC_AHSO5 = 66 -INTEGER, PARAMETER :: JP_WC_AHMS = 67 -INTEGER, PARAMETER :: JP_WR_O3 = 68 -INTEGER, PARAMETER :: JP_WR_H2O2 = 69 -INTEGER, PARAMETER :: JP_WR_NO = 70 -INTEGER, PARAMETER :: JP_WR_NO2 = 71 -INTEGER, PARAMETER :: JP_WR_NO3 = 72 -INTEGER, PARAMETER :: JP_WR_N2O5 = 73 -INTEGER, PARAMETER :: JP_WR_HONO = 74 -INTEGER, PARAMETER :: JP_WR_HNO3 = 75 -INTEGER, PARAMETER :: JP_WR_HNO4 = 76 -INTEGER, PARAMETER :: JP_WR_NH3 = 77 -INTEGER, PARAMETER :: JP_WR_OH = 78 -INTEGER, PARAMETER :: JP_WR_HO2 = 79 -INTEGER, PARAMETER :: JP_WR_CO2 = 80 -INTEGER, PARAMETER :: JP_WR_SO2 = 81 -INTEGER, PARAMETER :: JP_WR_SULF = 82 -INTEGER, PARAMETER :: JP_WR_HCHO = 83 -INTEGER, PARAMETER :: JP_WR_ORA1 = 84 -INTEGER, PARAMETER :: JP_WR_ORA2 = 85 -INTEGER, PARAMETER :: JP_WR_MO2 = 86 -INTEGER, PARAMETER :: JP_WR_OP1 = 87 -INTEGER, PARAMETER :: JP_WR_ASO3 = 88 -INTEGER, PARAMETER :: JP_WR_ASO4 = 89 -INTEGER, PARAMETER :: JP_WR_ASO5 = 90 -INTEGER, PARAMETER :: JP_WR_AHSO5 = 91 -INTEGER, PARAMETER :: JP_WR_AHMS = 92 -! -END MODULE MODD_CH_M9_SCHEME -! -!======================================================================== -! -! ########################## - MODULE MODI_CH_ALLOCATE_TACCS -! ########################## -!! This code has been created automatically by preprocessor m10, -!! version: 9.7, copyright 1995-1999 by Meteo France/Universite Paul Sabatier. -!! Please report all bugs to K. Suhre (Lab. d'Aerologie UPS/CNRS). -INTERFACE -SUBROUTINE CH_ALLOCATE_TACCS(KMI,KVECNPT) -IMPLICIT NONE -INTEGER, INTENT(IN) :: KMI ! model index -INTEGER, INTENT(IN) :: KVECNPT -END SUBROUTINE CH_ALLOCATE_TACCS -END INTERFACE -END MODULE MODI_CH_ALLOCATE_TACCS -! -!======================================================================== -! -! ###################################### - SUBROUTINE CH_ALLOCATE_TACCS(KMI,KVECNPT) -! ###################################### -!! This code has been created automatically by preprocessor m10, -!! version: 9.7, copyright 1995-1999 by Meteo France/Universite Paul Sabatier. -!! Please report all bugs to K. Suhre (Lab. d'Aerologie UPS/CNRS). -!!*** *CH_ALLOCATE_TACCS* -!! -!! PURPOSE -!! ------- -! Allocation of all CCSTYPE variables for model KMI -!! -!!** METHOD -!! ------ -!! -!! -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Gazen Didier (LA) -!! -!! MODIFICATIONS -!! ------------- -!! Original 21/06/2005 -!! -!!---------------------------------------------------------------------- -!! -!! EXTERNAL -!! -------- -!! none -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -USE MODD_CH_M9_SCHEME -!! -!! EXPLICIT ARGUMENTS -!! ------------------ -IMPLICIT NONE -INTEGER, INTENT(IN) :: KMI ! model index -INTEGER, INTENT(IN) :: KVECNPT -!! -!!---------------------------------------------------------------------- -! /BEGIN_INITIAL/ -! /END_INITIAL/ -! initialisation of the names of the chemical species -ALLOCATE(TACCS(KMI)%K001(KVECNPT)) -ALLOCATE(TACCS(KMI)%K002(KVECNPT)) -ALLOCATE(TACCS(KMI)%K003(KVECNPT)) -ALLOCATE(TACCS(KMI)%K004(KVECNPT)) -ALLOCATE(TACCS(KMI)%K005(KVECNPT)) -ALLOCATE(TACCS(KMI)%K006(KVECNPT)) -ALLOCATE(TACCS(KMI)%K007(KVECNPT)) -ALLOCATE(TACCS(KMI)%K008(KVECNPT)) -ALLOCATE(TACCS(KMI)%K009(KVECNPT)) -ALLOCATE(TACCS(KMI)%K010(KVECNPT)) -ALLOCATE(TACCS(KMI)%K011(KVECNPT)) -ALLOCATE(TACCS(KMI)%K012(KVECNPT)) -ALLOCATE(TACCS(KMI)%K013(KVECNPT)) -ALLOCATE(TACCS(KMI)%K014(KVECNPT)) -ALLOCATE(TACCS(KMI)%K015(KVECNPT)) -ALLOCATE(TACCS(KMI)%K016(KVECNPT)) -ALLOCATE(TACCS(KMI)%K017(KVECNPT)) -ALLOCATE(TACCS(KMI)%K018(KVECNPT)) -ALLOCATE(TACCS(KMI)%K019(KVECNPT)) -ALLOCATE(TACCS(KMI)%K020(KVECNPT)) -ALLOCATE(TACCS(KMI)%K021(KVECNPT)) -ALLOCATE(TACCS(KMI)%K022(KVECNPT)) -ALLOCATE(TACCS(KMI)%K023(KVECNPT)) -ALLOCATE(TACCS(KMI)%K024(KVECNPT)) -ALLOCATE(TACCS(KMI)%K025(KVECNPT)) -ALLOCATE(TACCS(KMI)%K026(KVECNPT)) -ALLOCATE(TACCS(KMI)%K027(KVECNPT)) -ALLOCATE(TACCS(KMI)%K028(KVECNPT)) -ALLOCATE(TACCS(KMI)%K029(KVECNPT)) -ALLOCATE(TACCS(KMI)%K030(KVECNPT)) -ALLOCATE(TACCS(KMI)%K031(KVECNPT)) -ALLOCATE(TACCS(KMI)%K032(KVECNPT)) -ALLOCATE(TACCS(KMI)%K033(KVECNPT)) -ALLOCATE(TACCS(KMI)%K034(KVECNPT)) -ALLOCATE(TACCS(KMI)%K035(KVECNPT)) -ALLOCATE(TACCS(KMI)%K036(KVECNPT)) -ALLOCATE(TACCS(KMI)%K037(KVECNPT)) -ALLOCATE(TACCS(KMI)%K038(KVECNPT)) -ALLOCATE(TACCS(KMI)%K039(KVECNPT)) -ALLOCATE(TACCS(KMI)%K040(KVECNPT)) -ALLOCATE(TACCS(KMI)%K041(KVECNPT)) -ALLOCATE(TACCS(KMI)%K042(KVECNPT)) -ALLOCATE(TACCS(KMI)%K043(KVECNPT)) -ALLOCATE(TACCS(KMI)%K044(KVECNPT)) -ALLOCATE(TACCS(KMI)%K045(KVECNPT)) -ALLOCATE(TACCS(KMI)%K046(KVECNPT)) -ALLOCATE(TACCS(KMI)%K047(KVECNPT)) -ALLOCATE(TACCS(KMI)%K048(KVECNPT)) -ALLOCATE(TACCS(KMI)%K049(KVECNPT)) -ALLOCATE(TACCS(KMI)%K050(KVECNPT)) -ALLOCATE(TACCS(KMI)%K051(KVECNPT)) -ALLOCATE(TACCS(KMI)%K052(KVECNPT)) -ALLOCATE(TACCS(KMI)%K053(KVECNPT)) -ALLOCATE(TACCS(KMI)%K054(KVECNPT)) -ALLOCATE(TACCS(KMI)%K055(KVECNPT)) -ALLOCATE(TACCS(KMI)%K056(KVECNPT)) -ALLOCATE(TACCS(KMI)%K057(KVECNPT)) -ALLOCATE(TACCS(KMI)%K058(KVECNPT)) -ALLOCATE(TACCS(KMI)%K059(KVECNPT)) -ALLOCATE(TACCS(KMI)%K060(KVECNPT)) -ALLOCATE(TACCS(KMI)%K061(KVECNPT)) -ALLOCATE(TACCS(KMI)%K062(KVECNPT)) -ALLOCATE(TACCS(KMI)%K063(KVECNPT)) -ALLOCATE(TACCS(KMI)%K064(KVECNPT)) -ALLOCATE(TACCS(KMI)%K065(KVECNPT)) -ALLOCATE(TACCS(KMI)%K066(KVECNPT)) -ALLOCATE(TACCS(KMI)%K067(KVECNPT)) -ALLOCATE(TACCS(KMI)%K068(KVECNPT)) -ALLOCATE(TACCS(KMI)%K069(KVECNPT)) -ALLOCATE(TACCS(KMI)%K070(KVECNPT)) -ALLOCATE(TACCS(KMI)%K071(KVECNPT)) -ALLOCATE(TACCS(KMI)%K072(KVECNPT)) -ALLOCATE(TACCS(KMI)%K073(KVECNPT)) -ALLOCATE(TACCS(KMI)%K074(KVECNPT)) -ALLOCATE(TACCS(KMI)%K075(KVECNPT)) -ALLOCATE(TACCS(KMI)%K076(KVECNPT)) -ALLOCATE(TACCS(KMI)%K077(KVECNPT)) -ALLOCATE(TACCS(KMI)%K078(KVECNPT)) -ALLOCATE(TACCS(KMI)%K079(KVECNPT)) -ALLOCATE(TACCS(KMI)%K080(KVECNPT)) -ALLOCATE(TACCS(KMI)%K081(KVECNPT)) -ALLOCATE(TACCS(KMI)%K082(KVECNPT)) -ALLOCATE(TACCS(KMI)%K083(KVECNPT)) -ALLOCATE(TACCS(KMI)%K084(KVECNPT)) -ALLOCATE(TACCS(KMI)%K085(KVECNPT)) -ALLOCATE(TACCS(KMI)%K086(KVECNPT)) -ALLOCATE(TACCS(KMI)%K087(KVECNPT)) -ALLOCATE(TACCS(KMI)%K088(KVECNPT)) -ALLOCATE(TACCS(KMI)%K089(KVECNPT)) -ALLOCATE(TACCS(KMI)%K090(KVECNPT)) -ALLOCATE(TACCS(KMI)%K091(KVECNPT)) -ALLOCATE(TACCS(KMI)%K092(KVECNPT)) -ALLOCATE(TACCS(KMI)%K093(KVECNPT)) -ALLOCATE(TACCS(KMI)%K094(KVECNPT)) -ALLOCATE(TACCS(KMI)%K095(KVECNPT)) -ALLOCATE(TACCS(KMI)%K096(KVECNPT)) -ALLOCATE(TACCS(KMI)%K097(KVECNPT)) -ALLOCATE(TACCS(KMI)%K098(KVECNPT)) -ALLOCATE(TACCS(KMI)%K099(KVECNPT)) -ALLOCATE(TACCS(KMI)%K0100(KVECNPT)) -ALLOCATE(TACCS(KMI)%K0101(KVECNPT)) -ALLOCATE(TACCS(KMI)%K0102(KVECNPT)) -ALLOCATE(TACCS(KMI)%K103(KVECNPT)) -ALLOCATE(TACCS(KMI)%K104(KVECNPT)) -ALLOCATE(TACCS(KMI)%K105(KVECNPT)) -ALLOCATE(TACCS(KMI)%K106(KVECNPT)) -ALLOCATE(TACCS(KMI)%K107(KVECNPT)) -ALLOCATE(TACCS(KMI)%K108(KVECNPT)) -ALLOCATE(TACCS(KMI)%K109(KVECNPT)) -ALLOCATE(TACCS(KMI)%K110(KVECNPT)) -ALLOCATE(TACCS(KMI)%K111(KVECNPT)) -ALLOCATE(TACCS(KMI)%K112(KVECNPT)) -ALLOCATE(TACCS(KMI)%K113(KVECNPT)) -ALLOCATE(TACCS(KMI)%K114(KVECNPT)) -ALLOCATE(TACCS(KMI)%K115(KVECNPT)) -ALLOCATE(TACCS(KMI)%K116(KVECNPT)) -ALLOCATE(TACCS(KMI)%K117(KVECNPT)) -ALLOCATE(TACCS(KMI)%K118(KVECNPT)) -ALLOCATE(TACCS(KMI)%K119(KVECNPT)) -ALLOCATE(TACCS(KMI)%K120(KVECNPT)) -ALLOCATE(TACCS(KMI)%K121(KVECNPT)) -ALLOCATE(TACCS(KMI)%K122(KVECNPT)) -ALLOCATE(TACCS(KMI)%K123(KVECNPT)) -ALLOCATE(TACCS(KMI)%K124(KVECNPT)) -ALLOCATE(TACCS(KMI)%K125(KVECNPT)) -ALLOCATE(TACCS(KMI)%K126(KVECNPT)) -ALLOCATE(TACCS(KMI)%K127(KVECNPT)) -ALLOCATE(TACCS(KMI)%K128(KVECNPT)) -ALLOCATE(TACCS(KMI)%K129(KVECNPT)) -ALLOCATE(TACCS(KMI)%K130(KVECNPT)) -ALLOCATE(TACCS(KMI)%K131(KVECNPT)) -ALLOCATE(TACCS(KMI)%K132(KVECNPT)) -ALLOCATE(TACCS(KMI)%K133(KVECNPT)) -ALLOCATE(TACCS(KMI)%K134(KVECNPT)) -ALLOCATE(TACCS(KMI)%K135(KVECNPT)) -IF (TACCS(KMI)%LUSECHAQ) THEN - ALLOCATE(TACCS(KMI)%KTC1(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC2(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC3(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC4(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC5(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC6(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC7(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC8(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC9(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC10(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC11(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC12(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC13(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC14(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC15(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC16(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC17(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC18(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC19(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC20(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC21(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC22(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC23(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC24(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC25(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC26(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC27(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC28(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC29(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC30(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC31(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC32(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC33(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC34(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC35(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC36(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC37(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC38(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC39(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTC40(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR1(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR2(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR3(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR4(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR5(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR6(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR7(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR8(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR9(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR10(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR11(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR12(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR13(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR14(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR15(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR16(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR17(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR18(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR19(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR20(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR21(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR22(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR23(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR24(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR25(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR26(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR27(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR28(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR29(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR30(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR31(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR32(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR33(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR34(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR35(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR36(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR37(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR38(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR39(KVECNPT)) - ALLOCATE(TACCS(KMI)%KTR40(KVECNPT)) - ALLOCATE(TACCS(KMI)%KC1(KVECNPT)) - ALLOCATE(TACCS(KMI)%KC2(KVECNPT)) - ALLOCATE(TACCS(KMI)%KC3(KVECNPT)) - ALLOCATE(TACCS(KMI)%KC4(KVECNPT)) - ALLOCATE(TACCS(KMI)%KC5(KVECNPT)) - ALLOCATE(TACCS(KMI)%KC6(KVECNPT)) - ALLOCATE(TACCS(KMI)%KC7(KVECNPT)) - ALLOCATE(TACCS(KMI)%KC8(KVECNPT)) - ALLOCATE(TACCS(KMI)%KC9(KVECNPT)) - ALLOCATE(TACCS(KMI)%KC10(KVECNPT)) - ALLOCATE(TACCS(KMI)%KC11(KVECNPT)) - ALLOCATE(TACCS(KMI)%KC12(KVECNPT)) - ALLOCATE(TACCS(KMI)%KC13(KVECNPT)) - ALLOCATE(TACCS(KMI)%KC14(KVECNPT)) - ALLOCATE(TACCS(KMI)%KC15(KVECNPT)) - ALLOCATE(TACCS(KMI)%KC16(KVECNPT)) - ALLOCATE(TACCS(KMI)%KC17(KVECNPT)) - ALLOCATE(TACCS(KMI)%KC18(KVECNPT)) - ALLOCATE(TACCS(KMI)%KC19(KVECNPT)) - ALLOCATE(TACCS(KMI)%KC20(KVECNPT)) - ALLOCATE(TACCS(KMI)%KC21(KVECNPT)) - ALLOCATE(TACCS(KMI)%KC22(KVECNPT)) - ALLOCATE(TACCS(KMI)%KC23(KVECNPT)) - ALLOCATE(TACCS(KMI)%KC24(KVECNPT)) - ALLOCATE(TACCS(KMI)%KC25(KVECNPT)) - ALLOCATE(TACCS(KMI)%KC26(KVECNPT)) - ALLOCATE(TACCS(KMI)%KC27(KVECNPT)) - ALLOCATE(TACCS(KMI)%KC28(KVECNPT)) - ALLOCATE(TACCS(KMI)%KC29(KVECNPT)) - ALLOCATE(TACCS(KMI)%KC30(KVECNPT)) - ALLOCATE(TACCS(KMI)%KR1(KVECNPT)) - ALLOCATE(TACCS(KMI)%KR2(KVECNPT)) - ALLOCATE(TACCS(KMI)%KR3(KVECNPT)) - ALLOCATE(TACCS(KMI)%KR4(KVECNPT)) - ALLOCATE(TACCS(KMI)%KR5(KVECNPT)) - ALLOCATE(TACCS(KMI)%KR6(KVECNPT)) - ALLOCATE(TACCS(KMI)%KR7(KVECNPT)) - ALLOCATE(TACCS(KMI)%KR8(KVECNPT)) - ALLOCATE(TACCS(KMI)%KR9(KVECNPT)) - ALLOCATE(TACCS(KMI)%KR10(KVECNPT)) - ALLOCATE(TACCS(KMI)%KR11(KVECNPT)) - ALLOCATE(TACCS(KMI)%KR12(KVECNPT)) - ALLOCATE(TACCS(KMI)%KR13(KVECNPT)) - ALLOCATE(TACCS(KMI)%KR14(KVECNPT)) - ALLOCATE(TACCS(KMI)%KR15(KVECNPT)) - ALLOCATE(TACCS(KMI)%KR16(KVECNPT)) - ALLOCATE(TACCS(KMI)%KR17(KVECNPT)) - ALLOCATE(TACCS(KMI)%KR18(KVECNPT)) - ALLOCATE(TACCS(KMI)%KR19(KVECNPT)) - ALLOCATE(TACCS(KMI)%KR20(KVECNPT)) - ALLOCATE(TACCS(KMI)%KR21(KVECNPT)) - ALLOCATE(TACCS(KMI)%KR22(KVECNPT)) - ALLOCATE(TACCS(KMI)%KR23(KVECNPT)) - ALLOCATE(TACCS(KMI)%KR24(KVECNPT)) - ALLOCATE(TACCS(KMI)%KR25(KVECNPT)) - ALLOCATE(TACCS(KMI)%KR26(KVECNPT)) - ALLOCATE(TACCS(KMI)%KR27(KVECNPT)) - ALLOCATE(TACCS(KMI)%KR28(KVECNPT)) - ALLOCATE(TACCS(KMI)%KR29(KVECNPT)) - ALLOCATE(TACCS(KMI)%KR30(KVECNPT)) -END IF -ALLOCATE(TACCS(KMI)%NVERB(KVECNPT)) -ALLOCATE(TACCS(KMI)%MODELLEVEL(KVECNPT)) -ALLOCATE(TACCS(KMI)%T(KVECNPT)) -ALLOCATE(TACCS(KMI)%PRESSURE(KVECNPT)) -ALLOCATE(TACCS(KMI)%M(KVECNPT)) -ALLOCATE(TACCS(KMI)%H2O(KVECNPT)) -ALLOCATE(TACCS(KMI)%CLOUDWATER(KVECNPT)) -ALLOCATE(TACCS(KMI)%RAINWATER(KVECNPT)) -ALLOCATE(TACCS(KMI)%RHODREF(KVECNPT)) -ALLOCATE(TACCS(KMI)%O2(KVECNPT)) -ALLOCATE(TACCS(KMI)%N2(KVECNPT)) -ALLOCATE(TACCS(KMI)%H2(KVECNPT)) -ALLOCATE(TACCS(KMI)%OH(KVECNPT)) -ALLOCATE(TACCS(KMI)%O1D(KVECNPT)) -ALLOCATE(TACCS(KMI)%O3P(KVECNPT)) -ALLOCATE(TACCS(KMI)%LAT(KVECNPT)) -ALLOCATE(TACCS(KMI)%LON(KVECNPT)) -ALLOCATE(TACCS(KMI)%YEAR(KVECNPT)) -ALLOCATE(TACCS(KMI)%MONTH(KVECNPT)) -ALLOCATE(TACCS(KMI)%DAY(KVECNPT)) -ALLOCATE(TACCS(KMI)%LWC(KVECNPT)) -ALLOCATE(TACCS(KMI)%MOL2MOLECCLOUD(KVECNPT)) -ALLOCATE(TACCS(KMI)%RADC(KVECNPT)) -ALLOCATE(TACCS(KMI)%PHC(KVECNPT)) -ALLOCATE(TACCS(KMI)%LWR(KVECNPT)) -ALLOCATE(TACCS(KMI)%MOL2MOLECRAIN(KVECNPT)) -ALLOCATE(TACCS(KMI)%RADR(KVECNPT)) -ALLOCATE(TACCS(KMI)%PHR(KVECNPT)) -ALLOCATE(TACCS(KMI)%CO2(KVECNPT)) -ALLOCATE(TACCS(KMI)%RCH(KVECNPT)) -ALLOCATE(TACCS(KMI)%W_O2(KVECNPT)) -END SUBROUTINE CH_ALLOCATE_TACCS -! -!======================================================================== -! -! ########################## - MODULE MODI_CH_DEALLOCATE_TACCS -! ########################## -!! This code has been created automatically by preprocessor m10, -!! version: 9.7, copyright 1995-1999 by Meteo France/Universite Paul Sabatier. -!! Please report all bugs to K. Suhre (Lab. d'Aerologie UPS/CNRS). -INTERFACE -SUBROUTINE CH_DEALLOCATE_TACCS(KMI) -IMPLICIT NONE -INTEGER, INTENT(IN) :: KMI ! model index -END SUBROUTINE CH_DEALLOCATE_TACCS -END INTERFACE -END MODULE MODI_CH_DEALLOCATE_TACCS -! -!======================================================================== -! -! ################################### - SUBROUTINE CH_DEALLOCATE_TACCS(KMI) -! ################################### -!! This code has been created automatically by preprocessor m10, -!! version: 9.7, copyright 1995-1999 by Meteo France/Universite Paul Sabatier. -!! Please report all bugs to K. Suhre (Lab. d'Aerologie UPS/CNRS). -!!*** *CH_DEALLOCATE_TACCS* -!! -!! PURPOSE -!! ------- -! Deallocation of all CCSTYPE variables for model KMI -!! -!!** METHOD -!! ------ -!! -!! -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Gazen Didier (LA) -!! -!! MODIFICATIONS -!! ------------- -!! Original 21/06/2005 -!! -!!---------------------------------------------------------------------- -!! -!! EXTERNAL -!! -------- -!! none -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -USE MODD_CH_M9_SCHEME -!! -!! EXPLICIT ARGUMENTS -!! ------------------ -IMPLICIT NONE -INTEGER, INTENT(IN) :: KMI ! model index -!! -!!---------------------------------------------------------------------- -! /BEGIN_INITIAL/ -! /END_INITIAL/ -! initialisation of the names of the chemical species -IF (ASSOCIATED(TACCS(KMI)%K001)) DEALLOCATE(TACCS(KMI)%K001) -IF (ASSOCIATED(TACCS(KMI)%K002)) DEALLOCATE(TACCS(KMI)%K002) -IF (ASSOCIATED(TACCS(KMI)%K003)) DEALLOCATE(TACCS(KMI)%K003) -IF (ASSOCIATED(TACCS(KMI)%K004)) DEALLOCATE(TACCS(KMI)%K004) -IF (ASSOCIATED(TACCS(KMI)%K005)) DEALLOCATE(TACCS(KMI)%K005) -IF (ASSOCIATED(TACCS(KMI)%K006)) DEALLOCATE(TACCS(KMI)%K006) -IF (ASSOCIATED(TACCS(KMI)%K007)) DEALLOCATE(TACCS(KMI)%K007) -IF (ASSOCIATED(TACCS(KMI)%K008)) DEALLOCATE(TACCS(KMI)%K008) -IF (ASSOCIATED(TACCS(KMI)%K009)) DEALLOCATE(TACCS(KMI)%K009) -IF (ASSOCIATED(TACCS(KMI)%K010)) DEALLOCATE(TACCS(KMI)%K010) -IF (ASSOCIATED(TACCS(KMI)%K011)) DEALLOCATE(TACCS(KMI)%K011) -IF (ASSOCIATED(TACCS(KMI)%K012)) DEALLOCATE(TACCS(KMI)%K012) -IF (ASSOCIATED(TACCS(KMI)%K013)) DEALLOCATE(TACCS(KMI)%K013) -IF (ASSOCIATED(TACCS(KMI)%K014)) DEALLOCATE(TACCS(KMI)%K014) -IF (ASSOCIATED(TACCS(KMI)%K015)) DEALLOCATE(TACCS(KMI)%K015) -IF (ASSOCIATED(TACCS(KMI)%K016)) DEALLOCATE(TACCS(KMI)%K016) -IF (ASSOCIATED(TACCS(KMI)%K017)) DEALLOCATE(TACCS(KMI)%K017) -IF (ASSOCIATED(TACCS(KMI)%K018)) DEALLOCATE(TACCS(KMI)%K018) -IF (ASSOCIATED(TACCS(KMI)%K019)) DEALLOCATE(TACCS(KMI)%K019) -IF (ASSOCIATED(TACCS(KMI)%K020)) DEALLOCATE(TACCS(KMI)%K020) -IF (ASSOCIATED(TACCS(KMI)%K021)) DEALLOCATE(TACCS(KMI)%K021) -IF (ASSOCIATED(TACCS(KMI)%K022)) DEALLOCATE(TACCS(KMI)%K022) -IF (ASSOCIATED(TACCS(KMI)%K023)) DEALLOCATE(TACCS(KMI)%K023) -IF (ASSOCIATED(TACCS(KMI)%K024)) DEALLOCATE(TACCS(KMI)%K024) -IF (ASSOCIATED(TACCS(KMI)%K025)) DEALLOCATE(TACCS(KMI)%K025) -IF (ASSOCIATED(TACCS(KMI)%K026)) DEALLOCATE(TACCS(KMI)%K026) -IF (ASSOCIATED(TACCS(KMI)%K027)) DEALLOCATE(TACCS(KMI)%K027) -IF (ASSOCIATED(TACCS(KMI)%K028)) DEALLOCATE(TACCS(KMI)%K028) -IF (ASSOCIATED(TACCS(KMI)%K029)) DEALLOCATE(TACCS(KMI)%K029) -IF (ASSOCIATED(TACCS(KMI)%K030)) DEALLOCATE(TACCS(KMI)%K030) -IF (ASSOCIATED(TACCS(KMI)%K031)) DEALLOCATE(TACCS(KMI)%K031) -IF (ASSOCIATED(TACCS(KMI)%K032)) DEALLOCATE(TACCS(KMI)%K032) -IF (ASSOCIATED(TACCS(KMI)%K033)) DEALLOCATE(TACCS(KMI)%K033) -IF (ASSOCIATED(TACCS(KMI)%K034)) DEALLOCATE(TACCS(KMI)%K034) -IF (ASSOCIATED(TACCS(KMI)%K035)) DEALLOCATE(TACCS(KMI)%K035) -IF (ASSOCIATED(TACCS(KMI)%K036)) DEALLOCATE(TACCS(KMI)%K036) -IF (ASSOCIATED(TACCS(KMI)%K037)) DEALLOCATE(TACCS(KMI)%K037) -IF (ASSOCIATED(TACCS(KMI)%K038)) DEALLOCATE(TACCS(KMI)%K038) -IF (ASSOCIATED(TACCS(KMI)%K039)) DEALLOCATE(TACCS(KMI)%K039) -IF (ASSOCIATED(TACCS(KMI)%K040)) DEALLOCATE(TACCS(KMI)%K040) -IF (ASSOCIATED(TACCS(KMI)%K041)) DEALLOCATE(TACCS(KMI)%K041) -IF (ASSOCIATED(TACCS(KMI)%K042)) DEALLOCATE(TACCS(KMI)%K042) -IF (ASSOCIATED(TACCS(KMI)%K043)) DEALLOCATE(TACCS(KMI)%K043) -IF (ASSOCIATED(TACCS(KMI)%K044)) DEALLOCATE(TACCS(KMI)%K044) -IF (ASSOCIATED(TACCS(KMI)%K045)) DEALLOCATE(TACCS(KMI)%K045) -IF (ASSOCIATED(TACCS(KMI)%K046)) DEALLOCATE(TACCS(KMI)%K046) -IF (ASSOCIATED(TACCS(KMI)%K047)) DEALLOCATE(TACCS(KMI)%K047) -IF (ASSOCIATED(TACCS(KMI)%K048)) DEALLOCATE(TACCS(KMI)%K048) -IF (ASSOCIATED(TACCS(KMI)%K049)) DEALLOCATE(TACCS(KMI)%K049) -IF (ASSOCIATED(TACCS(KMI)%K050)) DEALLOCATE(TACCS(KMI)%K050) -IF (ASSOCIATED(TACCS(KMI)%K051)) DEALLOCATE(TACCS(KMI)%K051) -IF (ASSOCIATED(TACCS(KMI)%K052)) DEALLOCATE(TACCS(KMI)%K052) -IF (ASSOCIATED(TACCS(KMI)%K053)) DEALLOCATE(TACCS(KMI)%K053) -IF (ASSOCIATED(TACCS(KMI)%K054)) DEALLOCATE(TACCS(KMI)%K054) -IF (ASSOCIATED(TACCS(KMI)%K055)) DEALLOCATE(TACCS(KMI)%K055) -IF (ASSOCIATED(TACCS(KMI)%K056)) DEALLOCATE(TACCS(KMI)%K056) -IF (ASSOCIATED(TACCS(KMI)%K057)) DEALLOCATE(TACCS(KMI)%K057) -IF (ASSOCIATED(TACCS(KMI)%K058)) DEALLOCATE(TACCS(KMI)%K058) -IF (ASSOCIATED(TACCS(KMI)%K059)) DEALLOCATE(TACCS(KMI)%K059) -IF (ASSOCIATED(TACCS(KMI)%K060)) DEALLOCATE(TACCS(KMI)%K060) -IF (ASSOCIATED(TACCS(KMI)%K061)) DEALLOCATE(TACCS(KMI)%K061) -IF (ASSOCIATED(TACCS(KMI)%K062)) DEALLOCATE(TACCS(KMI)%K062) -IF (ASSOCIATED(TACCS(KMI)%K063)) DEALLOCATE(TACCS(KMI)%K063) -IF (ASSOCIATED(TACCS(KMI)%K064)) DEALLOCATE(TACCS(KMI)%K064) -IF (ASSOCIATED(TACCS(KMI)%K065)) DEALLOCATE(TACCS(KMI)%K065) -IF (ASSOCIATED(TACCS(KMI)%K066)) DEALLOCATE(TACCS(KMI)%K066) -IF (ASSOCIATED(TACCS(KMI)%K067)) DEALLOCATE(TACCS(KMI)%K067) -IF (ASSOCIATED(TACCS(KMI)%K068)) DEALLOCATE(TACCS(KMI)%K068) -IF (ASSOCIATED(TACCS(KMI)%K069)) DEALLOCATE(TACCS(KMI)%K069) -IF (ASSOCIATED(TACCS(KMI)%K070)) DEALLOCATE(TACCS(KMI)%K070) -IF (ASSOCIATED(TACCS(KMI)%K071)) DEALLOCATE(TACCS(KMI)%K071) -IF (ASSOCIATED(TACCS(KMI)%K072)) DEALLOCATE(TACCS(KMI)%K072) -IF (ASSOCIATED(TACCS(KMI)%K073)) DEALLOCATE(TACCS(KMI)%K073) -IF (ASSOCIATED(TACCS(KMI)%K074)) DEALLOCATE(TACCS(KMI)%K074) -IF (ASSOCIATED(TACCS(KMI)%K075)) DEALLOCATE(TACCS(KMI)%K075) -IF (ASSOCIATED(TACCS(KMI)%K076)) DEALLOCATE(TACCS(KMI)%K076) -IF (ASSOCIATED(TACCS(KMI)%K077)) DEALLOCATE(TACCS(KMI)%K077) -IF (ASSOCIATED(TACCS(KMI)%K078)) DEALLOCATE(TACCS(KMI)%K078) -IF (ASSOCIATED(TACCS(KMI)%K079)) DEALLOCATE(TACCS(KMI)%K079) -IF (ASSOCIATED(TACCS(KMI)%K080)) DEALLOCATE(TACCS(KMI)%K080) -IF (ASSOCIATED(TACCS(KMI)%K081)) DEALLOCATE(TACCS(KMI)%K081) -IF (ASSOCIATED(TACCS(KMI)%K082)) DEALLOCATE(TACCS(KMI)%K082) -IF (ASSOCIATED(TACCS(KMI)%K083)) DEALLOCATE(TACCS(KMI)%K083) -IF (ASSOCIATED(TACCS(KMI)%K084)) DEALLOCATE(TACCS(KMI)%K084) -IF (ASSOCIATED(TACCS(KMI)%K085)) DEALLOCATE(TACCS(KMI)%K085) -IF (ASSOCIATED(TACCS(KMI)%K086)) DEALLOCATE(TACCS(KMI)%K086) -IF (ASSOCIATED(TACCS(KMI)%K087)) DEALLOCATE(TACCS(KMI)%K087) -IF (ASSOCIATED(TACCS(KMI)%K088)) DEALLOCATE(TACCS(KMI)%K088) -IF (ASSOCIATED(TACCS(KMI)%K089)) DEALLOCATE(TACCS(KMI)%K089) -IF (ASSOCIATED(TACCS(KMI)%K090)) DEALLOCATE(TACCS(KMI)%K090) -IF (ASSOCIATED(TACCS(KMI)%K091)) DEALLOCATE(TACCS(KMI)%K091) -IF (ASSOCIATED(TACCS(KMI)%K092)) DEALLOCATE(TACCS(KMI)%K092) -IF (ASSOCIATED(TACCS(KMI)%K093)) DEALLOCATE(TACCS(KMI)%K093) -IF (ASSOCIATED(TACCS(KMI)%K094)) DEALLOCATE(TACCS(KMI)%K094) -IF (ASSOCIATED(TACCS(KMI)%K095)) DEALLOCATE(TACCS(KMI)%K095) -IF (ASSOCIATED(TACCS(KMI)%K096)) DEALLOCATE(TACCS(KMI)%K096) -IF (ASSOCIATED(TACCS(KMI)%K097)) DEALLOCATE(TACCS(KMI)%K097) -IF (ASSOCIATED(TACCS(KMI)%K098)) DEALLOCATE(TACCS(KMI)%K098) -IF (ASSOCIATED(TACCS(KMI)%K099)) DEALLOCATE(TACCS(KMI)%K099) -IF (ASSOCIATED(TACCS(KMI)%K0100)) DEALLOCATE(TACCS(KMI)%K0100) -IF (ASSOCIATED(TACCS(KMI)%K0101)) DEALLOCATE(TACCS(KMI)%K0101) -IF (ASSOCIATED(TACCS(KMI)%K0102)) DEALLOCATE(TACCS(KMI)%K0102) -IF (ASSOCIATED(TACCS(KMI)%K103)) DEALLOCATE(TACCS(KMI)%K103) -IF (ASSOCIATED(TACCS(KMI)%K104)) DEALLOCATE(TACCS(KMI)%K104) -IF (ASSOCIATED(TACCS(KMI)%K105)) DEALLOCATE(TACCS(KMI)%K105) -IF (ASSOCIATED(TACCS(KMI)%K106)) DEALLOCATE(TACCS(KMI)%K106) -IF (ASSOCIATED(TACCS(KMI)%K107)) DEALLOCATE(TACCS(KMI)%K107) -IF (ASSOCIATED(TACCS(KMI)%K108)) DEALLOCATE(TACCS(KMI)%K108) -IF (ASSOCIATED(TACCS(KMI)%K109)) DEALLOCATE(TACCS(KMI)%K109) -IF (ASSOCIATED(TACCS(KMI)%K110)) DEALLOCATE(TACCS(KMI)%K110) -IF (ASSOCIATED(TACCS(KMI)%K111)) DEALLOCATE(TACCS(KMI)%K111) -IF (ASSOCIATED(TACCS(KMI)%K112)) DEALLOCATE(TACCS(KMI)%K112) -IF (ASSOCIATED(TACCS(KMI)%K113)) DEALLOCATE(TACCS(KMI)%K113) -IF (ASSOCIATED(TACCS(KMI)%K114)) DEALLOCATE(TACCS(KMI)%K114) -IF (ASSOCIATED(TACCS(KMI)%K115)) DEALLOCATE(TACCS(KMI)%K115) -IF (ASSOCIATED(TACCS(KMI)%K116)) DEALLOCATE(TACCS(KMI)%K116) -IF (ASSOCIATED(TACCS(KMI)%K117)) DEALLOCATE(TACCS(KMI)%K117) -IF (ASSOCIATED(TACCS(KMI)%K118)) DEALLOCATE(TACCS(KMI)%K118) -IF (ASSOCIATED(TACCS(KMI)%K119)) DEALLOCATE(TACCS(KMI)%K119) -IF (ASSOCIATED(TACCS(KMI)%K120)) DEALLOCATE(TACCS(KMI)%K120) -IF (ASSOCIATED(TACCS(KMI)%K121)) DEALLOCATE(TACCS(KMI)%K121) -IF (ASSOCIATED(TACCS(KMI)%K122)) DEALLOCATE(TACCS(KMI)%K122) -IF (ASSOCIATED(TACCS(KMI)%K123)) DEALLOCATE(TACCS(KMI)%K123) -IF (ASSOCIATED(TACCS(KMI)%K124)) DEALLOCATE(TACCS(KMI)%K124) -IF (ASSOCIATED(TACCS(KMI)%K125)) DEALLOCATE(TACCS(KMI)%K125) -IF (ASSOCIATED(TACCS(KMI)%K126)) DEALLOCATE(TACCS(KMI)%K126) -IF (ASSOCIATED(TACCS(KMI)%K127)) DEALLOCATE(TACCS(KMI)%K127) -IF (ASSOCIATED(TACCS(KMI)%K128)) DEALLOCATE(TACCS(KMI)%K128) -IF (ASSOCIATED(TACCS(KMI)%K129)) DEALLOCATE(TACCS(KMI)%K129) -IF (ASSOCIATED(TACCS(KMI)%K130)) DEALLOCATE(TACCS(KMI)%K130) -IF (ASSOCIATED(TACCS(KMI)%K131)) DEALLOCATE(TACCS(KMI)%K131) -IF (ASSOCIATED(TACCS(KMI)%K132)) DEALLOCATE(TACCS(KMI)%K132) -IF (ASSOCIATED(TACCS(KMI)%K133)) DEALLOCATE(TACCS(KMI)%K133) -IF (ASSOCIATED(TACCS(KMI)%K134)) DEALLOCATE(TACCS(KMI)%K134) -IF (ASSOCIATED(TACCS(KMI)%K135)) DEALLOCATE(TACCS(KMI)%K135) -IF (ASSOCIATED(TACCS(KMI)%KTC1)) DEALLOCATE(TACCS(KMI)%KTC1) -IF (ASSOCIATED(TACCS(KMI)%KTC2)) DEALLOCATE(TACCS(KMI)%KTC2) -IF (ASSOCIATED(TACCS(KMI)%KTC3)) DEALLOCATE(TACCS(KMI)%KTC3) -IF (ASSOCIATED(TACCS(KMI)%KTC4)) DEALLOCATE(TACCS(KMI)%KTC4) -IF (ASSOCIATED(TACCS(KMI)%KTC5)) DEALLOCATE(TACCS(KMI)%KTC5) -IF (ASSOCIATED(TACCS(KMI)%KTC6)) DEALLOCATE(TACCS(KMI)%KTC6) -IF (ASSOCIATED(TACCS(KMI)%KTC7)) DEALLOCATE(TACCS(KMI)%KTC7) -IF (ASSOCIATED(TACCS(KMI)%KTC8)) DEALLOCATE(TACCS(KMI)%KTC8) -IF (ASSOCIATED(TACCS(KMI)%KTC9)) DEALLOCATE(TACCS(KMI)%KTC9) -IF (ASSOCIATED(TACCS(KMI)%KTC10)) DEALLOCATE(TACCS(KMI)%KTC10) -IF (ASSOCIATED(TACCS(KMI)%KTC11)) DEALLOCATE(TACCS(KMI)%KTC11) -IF (ASSOCIATED(TACCS(KMI)%KTC12)) DEALLOCATE(TACCS(KMI)%KTC12) -IF (ASSOCIATED(TACCS(KMI)%KTC13)) DEALLOCATE(TACCS(KMI)%KTC13) -IF (ASSOCIATED(TACCS(KMI)%KTC14)) DEALLOCATE(TACCS(KMI)%KTC14) -IF (ASSOCIATED(TACCS(KMI)%KTC15)) DEALLOCATE(TACCS(KMI)%KTC15) -IF (ASSOCIATED(TACCS(KMI)%KTC16)) DEALLOCATE(TACCS(KMI)%KTC16) -IF (ASSOCIATED(TACCS(KMI)%KTC17)) DEALLOCATE(TACCS(KMI)%KTC17) -IF (ASSOCIATED(TACCS(KMI)%KTC18)) DEALLOCATE(TACCS(KMI)%KTC18) -IF (ASSOCIATED(TACCS(KMI)%KTC19)) DEALLOCATE(TACCS(KMI)%KTC19) -IF (ASSOCIATED(TACCS(KMI)%KTC20)) DEALLOCATE(TACCS(KMI)%KTC20) -IF (ASSOCIATED(TACCS(KMI)%KTC21)) DEALLOCATE(TACCS(KMI)%KTC21) -IF (ASSOCIATED(TACCS(KMI)%KTC22)) DEALLOCATE(TACCS(KMI)%KTC22) -IF (ASSOCIATED(TACCS(KMI)%KTC23)) DEALLOCATE(TACCS(KMI)%KTC23) -IF (ASSOCIATED(TACCS(KMI)%KTC24)) DEALLOCATE(TACCS(KMI)%KTC24) -IF (ASSOCIATED(TACCS(KMI)%KTC25)) DEALLOCATE(TACCS(KMI)%KTC25) -IF (ASSOCIATED(TACCS(KMI)%KTC26)) DEALLOCATE(TACCS(KMI)%KTC26) -IF (ASSOCIATED(TACCS(KMI)%KTC27)) DEALLOCATE(TACCS(KMI)%KTC27) -IF (ASSOCIATED(TACCS(KMI)%KTC28)) DEALLOCATE(TACCS(KMI)%KTC28) -IF (ASSOCIATED(TACCS(KMI)%KTC29)) DEALLOCATE(TACCS(KMI)%KTC29) -IF (ASSOCIATED(TACCS(KMI)%KTC30)) DEALLOCATE(TACCS(KMI)%KTC30) -IF (ASSOCIATED(TACCS(KMI)%KTC31)) DEALLOCATE(TACCS(KMI)%KTC31) -IF (ASSOCIATED(TACCS(KMI)%KTC32)) DEALLOCATE(TACCS(KMI)%KTC32) -IF (ASSOCIATED(TACCS(KMI)%KTC33)) DEALLOCATE(TACCS(KMI)%KTC33) -IF (ASSOCIATED(TACCS(KMI)%KTC34)) DEALLOCATE(TACCS(KMI)%KTC34) -IF (ASSOCIATED(TACCS(KMI)%KTC35)) DEALLOCATE(TACCS(KMI)%KTC35) -IF (ASSOCIATED(TACCS(KMI)%KTC36)) DEALLOCATE(TACCS(KMI)%KTC36) -IF (ASSOCIATED(TACCS(KMI)%KTC37)) DEALLOCATE(TACCS(KMI)%KTC37) -IF (ASSOCIATED(TACCS(KMI)%KTC38)) DEALLOCATE(TACCS(KMI)%KTC38) -IF (ASSOCIATED(TACCS(KMI)%KTC39)) DEALLOCATE(TACCS(KMI)%KTC39) -IF (ASSOCIATED(TACCS(KMI)%KTC40)) DEALLOCATE(TACCS(KMI)%KTC40) -IF (ASSOCIATED(TACCS(KMI)%KTR1)) DEALLOCATE(TACCS(KMI)%KTR1) -IF (ASSOCIATED(TACCS(KMI)%KTR2)) DEALLOCATE(TACCS(KMI)%KTR2) -IF (ASSOCIATED(TACCS(KMI)%KTR3)) DEALLOCATE(TACCS(KMI)%KTR3) -IF (ASSOCIATED(TACCS(KMI)%KTR4)) DEALLOCATE(TACCS(KMI)%KTR4) -IF (ASSOCIATED(TACCS(KMI)%KTR5)) DEALLOCATE(TACCS(KMI)%KTR5) -IF (ASSOCIATED(TACCS(KMI)%KTR6)) DEALLOCATE(TACCS(KMI)%KTR6) -IF (ASSOCIATED(TACCS(KMI)%KTR7)) DEALLOCATE(TACCS(KMI)%KTR7) -IF (ASSOCIATED(TACCS(KMI)%KTR8)) DEALLOCATE(TACCS(KMI)%KTR8) -IF (ASSOCIATED(TACCS(KMI)%KTR9)) DEALLOCATE(TACCS(KMI)%KTR9) -IF (ASSOCIATED(TACCS(KMI)%KTR10)) DEALLOCATE(TACCS(KMI)%KTR10) -IF (ASSOCIATED(TACCS(KMI)%KTR11)) DEALLOCATE(TACCS(KMI)%KTR11) -IF (ASSOCIATED(TACCS(KMI)%KTR12)) DEALLOCATE(TACCS(KMI)%KTR12) -IF (ASSOCIATED(TACCS(KMI)%KTR13)) DEALLOCATE(TACCS(KMI)%KTR13) -IF (ASSOCIATED(TACCS(KMI)%KTR14)) DEALLOCATE(TACCS(KMI)%KTR14) -IF (ASSOCIATED(TACCS(KMI)%KTR15)) DEALLOCATE(TACCS(KMI)%KTR15) -IF (ASSOCIATED(TACCS(KMI)%KTR16)) DEALLOCATE(TACCS(KMI)%KTR16) -IF (ASSOCIATED(TACCS(KMI)%KTR17)) DEALLOCATE(TACCS(KMI)%KTR17) -IF (ASSOCIATED(TACCS(KMI)%KTR18)) DEALLOCATE(TACCS(KMI)%KTR18) -IF (ASSOCIATED(TACCS(KMI)%KTR19)) DEALLOCATE(TACCS(KMI)%KTR19) -IF (ASSOCIATED(TACCS(KMI)%KTR20)) DEALLOCATE(TACCS(KMI)%KTR20) -IF (ASSOCIATED(TACCS(KMI)%KTR21)) DEALLOCATE(TACCS(KMI)%KTR21) -IF (ASSOCIATED(TACCS(KMI)%KTR22)) DEALLOCATE(TACCS(KMI)%KTR22) -IF (ASSOCIATED(TACCS(KMI)%KTR23)) DEALLOCATE(TACCS(KMI)%KTR23) -IF (ASSOCIATED(TACCS(KMI)%KTR24)) DEALLOCATE(TACCS(KMI)%KTR24) -IF (ASSOCIATED(TACCS(KMI)%KTR25)) DEALLOCATE(TACCS(KMI)%KTR25) -IF (ASSOCIATED(TACCS(KMI)%KTR26)) DEALLOCATE(TACCS(KMI)%KTR26) -IF (ASSOCIATED(TACCS(KMI)%KTR27)) DEALLOCATE(TACCS(KMI)%KTR27) -IF (ASSOCIATED(TACCS(KMI)%KTR28)) DEALLOCATE(TACCS(KMI)%KTR28) -IF (ASSOCIATED(TACCS(KMI)%KTR29)) DEALLOCATE(TACCS(KMI)%KTR29) -IF (ASSOCIATED(TACCS(KMI)%KTR30)) DEALLOCATE(TACCS(KMI)%KTR30) -IF (ASSOCIATED(TACCS(KMI)%KTR31)) DEALLOCATE(TACCS(KMI)%KTR31) -IF (ASSOCIATED(TACCS(KMI)%KTR32)) DEALLOCATE(TACCS(KMI)%KTR32) -IF (ASSOCIATED(TACCS(KMI)%KTR33)) DEALLOCATE(TACCS(KMI)%KTR33) -IF (ASSOCIATED(TACCS(KMI)%KTR34)) DEALLOCATE(TACCS(KMI)%KTR34) -IF (ASSOCIATED(TACCS(KMI)%KTR35)) DEALLOCATE(TACCS(KMI)%KTR35) -IF (ASSOCIATED(TACCS(KMI)%KTR36)) DEALLOCATE(TACCS(KMI)%KTR36) -IF (ASSOCIATED(TACCS(KMI)%KTR37)) DEALLOCATE(TACCS(KMI)%KTR37) -IF (ASSOCIATED(TACCS(KMI)%KTR38)) DEALLOCATE(TACCS(KMI)%KTR38) -IF (ASSOCIATED(TACCS(KMI)%KTR39)) DEALLOCATE(TACCS(KMI)%KTR39) -IF (ASSOCIATED(TACCS(KMI)%KTR40)) DEALLOCATE(TACCS(KMI)%KTR40) -IF (ASSOCIATED(TACCS(KMI)%KC1)) DEALLOCATE(TACCS(KMI)%KC1) -IF (ASSOCIATED(TACCS(KMI)%KC2)) DEALLOCATE(TACCS(KMI)%KC2) -IF (ASSOCIATED(TACCS(KMI)%KC3)) DEALLOCATE(TACCS(KMI)%KC3) -IF (ASSOCIATED(TACCS(KMI)%KC4)) DEALLOCATE(TACCS(KMI)%KC4) -IF (ASSOCIATED(TACCS(KMI)%KC5)) DEALLOCATE(TACCS(KMI)%KC5) -IF (ASSOCIATED(TACCS(KMI)%KC6)) DEALLOCATE(TACCS(KMI)%KC6) -IF (ASSOCIATED(TACCS(KMI)%KC7)) DEALLOCATE(TACCS(KMI)%KC7) -IF (ASSOCIATED(TACCS(KMI)%KC8)) DEALLOCATE(TACCS(KMI)%KC8) -IF (ASSOCIATED(TACCS(KMI)%KC9)) DEALLOCATE(TACCS(KMI)%KC9) -IF (ASSOCIATED(TACCS(KMI)%KC10)) DEALLOCATE(TACCS(KMI)%KC10) -IF (ASSOCIATED(TACCS(KMI)%KC11)) DEALLOCATE(TACCS(KMI)%KC11) -IF (ASSOCIATED(TACCS(KMI)%KC12)) DEALLOCATE(TACCS(KMI)%KC12) -IF (ASSOCIATED(TACCS(KMI)%KC13)) DEALLOCATE(TACCS(KMI)%KC13) -IF (ASSOCIATED(TACCS(KMI)%KC14)) DEALLOCATE(TACCS(KMI)%KC14) -IF (ASSOCIATED(TACCS(KMI)%KC15)) DEALLOCATE(TACCS(KMI)%KC15) -IF (ASSOCIATED(TACCS(KMI)%KC16)) DEALLOCATE(TACCS(KMI)%KC16) -IF (ASSOCIATED(TACCS(KMI)%KC17)) DEALLOCATE(TACCS(KMI)%KC17) -IF (ASSOCIATED(TACCS(KMI)%KC18)) DEALLOCATE(TACCS(KMI)%KC18) -IF (ASSOCIATED(TACCS(KMI)%KC19)) DEALLOCATE(TACCS(KMI)%KC19) -IF (ASSOCIATED(TACCS(KMI)%KC20)) DEALLOCATE(TACCS(KMI)%KC20) -IF (ASSOCIATED(TACCS(KMI)%KC21)) DEALLOCATE(TACCS(KMI)%KC21) -IF (ASSOCIATED(TACCS(KMI)%KC22)) DEALLOCATE(TACCS(KMI)%KC22) -IF (ASSOCIATED(TACCS(KMI)%KC23)) DEALLOCATE(TACCS(KMI)%KC23) -IF (ASSOCIATED(TACCS(KMI)%KC24)) DEALLOCATE(TACCS(KMI)%KC24) -IF (ASSOCIATED(TACCS(KMI)%KC25)) DEALLOCATE(TACCS(KMI)%KC25) -IF (ASSOCIATED(TACCS(KMI)%KC26)) DEALLOCATE(TACCS(KMI)%KC26) -IF (ASSOCIATED(TACCS(KMI)%KC27)) DEALLOCATE(TACCS(KMI)%KC27) -IF (ASSOCIATED(TACCS(KMI)%KC28)) DEALLOCATE(TACCS(KMI)%KC28) -IF (ASSOCIATED(TACCS(KMI)%KC29)) DEALLOCATE(TACCS(KMI)%KC29) -IF (ASSOCIATED(TACCS(KMI)%KC30)) DEALLOCATE(TACCS(KMI)%KC30) -IF (ASSOCIATED(TACCS(KMI)%KR1)) DEALLOCATE(TACCS(KMI)%KR1) -IF (ASSOCIATED(TACCS(KMI)%KR2)) DEALLOCATE(TACCS(KMI)%KR2) -IF (ASSOCIATED(TACCS(KMI)%KR3)) DEALLOCATE(TACCS(KMI)%KR3) -IF (ASSOCIATED(TACCS(KMI)%KR4)) DEALLOCATE(TACCS(KMI)%KR4) -IF (ASSOCIATED(TACCS(KMI)%KR5)) DEALLOCATE(TACCS(KMI)%KR5) -IF (ASSOCIATED(TACCS(KMI)%KR6)) DEALLOCATE(TACCS(KMI)%KR6) -IF (ASSOCIATED(TACCS(KMI)%KR7)) DEALLOCATE(TACCS(KMI)%KR7) -IF (ASSOCIATED(TACCS(KMI)%KR8)) DEALLOCATE(TACCS(KMI)%KR8) -IF (ASSOCIATED(TACCS(KMI)%KR9)) DEALLOCATE(TACCS(KMI)%KR9) -IF (ASSOCIATED(TACCS(KMI)%KR10)) DEALLOCATE(TACCS(KMI)%KR10) -IF (ASSOCIATED(TACCS(KMI)%KR11)) DEALLOCATE(TACCS(KMI)%KR11) -IF (ASSOCIATED(TACCS(KMI)%KR12)) DEALLOCATE(TACCS(KMI)%KR12) -IF (ASSOCIATED(TACCS(KMI)%KR13)) DEALLOCATE(TACCS(KMI)%KR13) -IF (ASSOCIATED(TACCS(KMI)%KR14)) DEALLOCATE(TACCS(KMI)%KR14) -IF (ASSOCIATED(TACCS(KMI)%KR15)) DEALLOCATE(TACCS(KMI)%KR15) -IF (ASSOCIATED(TACCS(KMI)%KR16)) DEALLOCATE(TACCS(KMI)%KR16) -IF (ASSOCIATED(TACCS(KMI)%KR17)) DEALLOCATE(TACCS(KMI)%KR17) -IF (ASSOCIATED(TACCS(KMI)%KR18)) DEALLOCATE(TACCS(KMI)%KR18) -IF (ASSOCIATED(TACCS(KMI)%KR19)) DEALLOCATE(TACCS(KMI)%KR19) -IF (ASSOCIATED(TACCS(KMI)%KR20)) DEALLOCATE(TACCS(KMI)%KR20) -IF (ASSOCIATED(TACCS(KMI)%KR21)) DEALLOCATE(TACCS(KMI)%KR21) -IF (ASSOCIATED(TACCS(KMI)%KR22)) DEALLOCATE(TACCS(KMI)%KR22) -IF (ASSOCIATED(TACCS(KMI)%KR23)) DEALLOCATE(TACCS(KMI)%KR23) -IF (ASSOCIATED(TACCS(KMI)%KR24)) DEALLOCATE(TACCS(KMI)%KR24) -IF (ASSOCIATED(TACCS(KMI)%KR25)) DEALLOCATE(TACCS(KMI)%KR25) -IF (ASSOCIATED(TACCS(KMI)%KR26)) DEALLOCATE(TACCS(KMI)%KR26) -IF (ASSOCIATED(TACCS(KMI)%KR27)) DEALLOCATE(TACCS(KMI)%KR27) -IF (ASSOCIATED(TACCS(KMI)%KR28)) DEALLOCATE(TACCS(KMI)%KR28) -IF (ASSOCIATED(TACCS(KMI)%KR29)) DEALLOCATE(TACCS(KMI)%KR29) -IF (ASSOCIATED(TACCS(KMI)%KR30)) DEALLOCATE(TACCS(KMI)%KR30) -IF (ASSOCIATED(TACCS(KMI)%NVERB)) DEALLOCATE(TACCS(KMI)%NVERB) -IF (ASSOCIATED(TACCS(KMI)%MODELLEVEL)) DEALLOCATE(TACCS(KMI)%MODELLEVEL) -IF (ASSOCIATED(TACCS(KMI)%T)) DEALLOCATE(TACCS(KMI)%T) -IF (ASSOCIATED(TACCS(KMI)%PRESSURE)) DEALLOCATE(TACCS(KMI)%PRESSURE) -IF (ASSOCIATED(TACCS(KMI)%M)) DEALLOCATE(TACCS(KMI)%M) -IF (ASSOCIATED(TACCS(KMI)%H2O)) DEALLOCATE(TACCS(KMI)%H2O) -IF (ASSOCIATED(TACCS(KMI)%CLOUDWATER)) DEALLOCATE(TACCS(KMI)%CLOUDWATER) -IF (ASSOCIATED(TACCS(KMI)%RAINWATER)) DEALLOCATE(TACCS(KMI)%RAINWATER) -IF (ASSOCIATED(TACCS(KMI)%RHODREF)) DEALLOCATE(TACCS(KMI)%RHODREF) -IF (ASSOCIATED(TACCS(KMI)%O2)) DEALLOCATE(TACCS(KMI)%O2) -IF (ASSOCIATED(TACCS(KMI)%N2)) DEALLOCATE(TACCS(KMI)%N2) -IF (ASSOCIATED(TACCS(KMI)%H2)) DEALLOCATE(TACCS(KMI)%H2) -IF (ASSOCIATED(TACCS(KMI)%OH)) DEALLOCATE(TACCS(KMI)%OH) -IF (ASSOCIATED(TACCS(KMI)%O1D)) DEALLOCATE(TACCS(KMI)%O1D) -IF (ASSOCIATED(TACCS(KMI)%O3P)) DEALLOCATE(TACCS(KMI)%O3P) -IF (ASSOCIATED(TACCS(KMI)%LAT)) DEALLOCATE(TACCS(KMI)%LAT) -IF (ASSOCIATED(TACCS(KMI)%LON)) DEALLOCATE(TACCS(KMI)%LON) -IF (ASSOCIATED(TACCS(KMI)%YEAR)) DEALLOCATE(TACCS(KMI)%YEAR) -IF (ASSOCIATED(TACCS(KMI)%MONTH)) DEALLOCATE(TACCS(KMI)%MONTH) -IF (ASSOCIATED(TACCS(KMI)%DAY)) DEALLOCATE(TACCS(KMI)%DAY) -IF (ASSOCIATED(TACCS(KMI)%LWC)) DEALLOCATE(TACCS(KMI)%LWC) -IF (ASSOCIATED(TACCS(KMI)%MOL2MOLECCLOUD)) DEALLOCATE(TACCS(KMI)%MOL2MOLECCLOUD) -IF (ASSOCIATED(TACCS(KMI)%RADC)) DEALLOCATE(TACCS(KMI)%RADC) -IF (ASSOCIATED(TACCS(KMI)%PHC)) DEALLOCATE(TACCS(KMI)%PHC) -IF (ASSOCIATED(TACCS(KMI)%LWR)) DEALLOCATE(TACCS(KMI)%LWR) -IF (ASSOCIATED(TACCS(KMI)%MOL2MOLECRAIN)) DEALLOCATE(TACCS(KMI)%MOL2MOLECRAIN) -IF (ASSOCIATED(TACCS(KMI)%RADR)) DEALLOCATE(TACCS(KMI)%RADR) -IF (ASSOCIATED(TACCS(KMI)%PHR)) DEALLOCATE(TACCS(KMI)%PHR) -IF (ASSOCIATED(TACCS(KMI)%CO2)) DEALLOCATE(TACCS(KMI)%CO2) -IF (ASSOCIATED(TACCS(KMI)%RCH)) DEALLOCATE(TACCS(KMI)%RCH) -IF (ASSOCIATED(TACCS(KMI)%W_O2)) DEALLOCATE(TACCS(KMI)%W_O2) -END SUBROUTINE CH_DEALLOCATE_TACCS -! -!======================================================================== -! -! ####################### - MODULE MODI_CH_INIT_CCS -! ####################### -!! This code has been created automatically by preprocessor m10, -!! version: 9.7, copyright 1995-1999 by Meteo France/Universite Paul Sabatier. -!! Please report all bugs to K. Suhre (Lab. d'Aerologie UPS/CNRS). -INTERFACE -SUBROUTINE CH_INIT_CCS(KMI,OUSECHAQ,OCH_PH,KOUT,KVERB) -IMPLICIT NONE -INTEGER, INTENT(IN) :: KMI ! model number -LOGICAL, INTENT(IN) :: OUSECHAQ -LOGICAL, INTENT(IN) :: OCH_PH -INTEGER, INTENT(IN) :: KOUT, KVERB ! stdout output, verbosity level -END SUBROUTINE CH_INIT_CCS -END INTERFACE -END MODULE MODI_CH_INIT_CCS -! -!======================================================================== -! -! ###################################################### - SUBROUTINE CH_INIT_CCS(KMI,OUSECHAQ,OCH_PH,KOUT,KVERB) -! ###################################################### -!! This code has been created automatically by preprocessor m10, -!! version: 9.7, copyright 1995-1999 by Meteo France/Universite Paul Sabatier. -!! Please report all bugs to K. Suhre (Lab. d'Aerologie UPS/CNRS). -!!*** *CH_INIT_CCS* -!! -!! PURPOSE -!! ------- -! initialization of the chemical reaction mechanism -!! -!!** METHOD -!! ------ -!! -!! The variables CNAMES and CREACS of MODD_CH_M9_SCHEME are defined here. -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Karsten Suhre (LA) -!! -!! MODIFICATIONS -!! ------------- -!! Original 26/07/96 -!! Modified 05/05/98: Vectorization (Vincent Crassier & KS) -!! Modified 31/10/03: New interface for better MesoNH compilation (D. Gazen) -!! -!!---------------------------------------------------------------------- -!! -!! EXTERNAL -!! -------- -!! none -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -USE MODD_CH_M9_SCHEME -!! -!! EXPLICIT ARGUMENTS -!! ------------------ -IMPLICIT NONE -INTEGER, INTENT(IN) :: KMI ! model number -LOGICAL, INTENT(IN) :: OUSECHAQ -LOGICAL, INTENT(IN) :: OCH_PH -INTEGER, INTENT(IN) :: KOUT, KVERB ! stdout output, verbosity level -!! -!! LOCAL VARIABLES -!! --------------- -LOGICAL, SAVE :: GFIRSTCALL = .TRUE. -INTEGER :: JII ! loop control -INTEGER :: INDX -!! -!!---------------------------------------------------------------------- -! /BEGIN_INITIAL/ -! /END_INITIAL/ -INDX = 1 -IF (OUSECHAQ) INDX = 2 -TACCS(KMI)%NEQ = JPNEQ(INDX) -TACCS(KMI)%NEQAQ = JPNEQAQ(INDX) -TACCS(KMI)%NREAC = JPNREAC(INDX) -TACCS(KMI)%NMETEOVARS = JPNMETEOVARS(INDX) -TACCS(KMI)%NNONZEROTERMS = JPNNONZEROTERMS(INDX) -! -TACCS(KMI)%LUSECHAQ = OUSECHAQ -TACCS(KMI)%LCH_PH = OCH_PH -TACCS(KMI)%NOUT = KOUT -! -IF (GFIRSTCALL) THEN - GFIRSTCALL = .FALSE. -! initialisation of the names of the chemical species - CNAMES(1) = 'O3' - CNAMES(2) = 'H2O2' - CNAMES(3) = 'NO' - CNAMES(4) = 'NO2' - CNAMES(5) = 'NO3' - CNAMES(6) = 'N2O5' - CNAMES(7) = 'HONO' - CNAMES(8) = 'HNO3' - CNAMES(9) = 'HNO4' - CNAMES(10) = 'NH3' - CNAMES(11) = 'DMS' - CNAMES(12) = 'SO2' - CNAMES(13) = 'SULF' - CNAMES(14) = 'CO' - CNAMES(15) = 'OH' - CNAMES(16) = 'HO2' - CNAMES(17) = 'CH4' - CNAMES(18) = 'ETH' - CNAMES(19) = 'ALKA' - CNAMES(20) = 'ALKE' - CNAMES(21) = 'BIO' - CNAMES(22) = 'ARO' - CNAMES(23) = 'HCHO' - CNAMES(24) = 'ALD' - CNAMES(25) = 'KET' - CNAMES(26) = 'CARBO' - CNAMES(27) = 'ONIT' - CNAMES(28) = 'PAN' - CNAMES(29) = 'OP1' - CNAMES(30) = 'OP2' - CNAMES(31) = 'ORA1' - CNAMES(32) = 'ORA2' - CNAMES(33) = 'MO2' - CNAMES(34) = 'ALKAP' - CNAMES(35) = 'ALKEP' - CNAMES(36) = 'BIOP' - CNAMES(37) = 'PHO' - CNAMES(38) = 'ADD' - CNAMES(39) = 'AROP' - CNAMES(40) = 'CARBOP' - CNAMES(41) = 'OLN' - CNAMES(42) = 'XO2' - CNAMES(43) = 'WC_O3' - CNAMES(44) = 'WC_H2O2' - CNAMES(45) = 'WC_NO' - CNAMES(46) = 'WC_NO2' - CNAMES(47) = 'WC_NO3' - CNAMES(48) = 'WC_N2O5' - CNAMES(49) = 'WC_HONO' - CNAMES(50) = 'WC_HNO3' - CNAMES(51) = 'WC_HNO4' - CNAMES(52) = 'WC_NH3' - CNAMES(53) = 'WC_OH' - CNAMES(54) = 'WC_HO2' - CNAMES(55) = 'WC_CO2' - CNAMES(56) = 'WC_SO2' - CNAMES(57) = 'WC_SULF' - CNAMES(58) = 'WC_HCHO' - CNAMES(59) = 'WC_ORA1' - CNAMES(60) = 'WC_ORA2' - CNAMES(61) = 'WC_MO2' - CNAMES(62) = 'WC_OP1' - CNAMES(63) = 'WC_ASO3' - CNAMES(64) = 'WC_ASO4' - CNAMES(65) = 'WC_ASO5' - CNAMES(66) = 'WC_AHSO5' - CNAMES(67) = 'WC_AHMS' - CNAMES(68) = 'WR_O3' - CNAMES(69) = 'WR_H2O2' - CNAMES(70) = 'WR_NO' - CNAMES(71) = 'WR_NO2' - CNAMES(72) = 'WR_NO3' - CNAMES(73) = 'WR_N2O5' - CNAMES(74) = 'WR_HONO' - CNAMES(75) = 'WR_HNO3' - CNAMES(76) = 'WR_HNO4' - CNAMES(77) = 'WR_NH3' - CNAMES(78) = 'WR_OH' - CNAMES(79) = 'WR_HO2' - CNAMES(80) = 'WR_CO2' - CNAMES(81) = 'WR_SO2' - CNAMES(82) = 'WR_SULF' - CNAMES(83) = 'WR_HCHO' - CNAMES(84) = 'WR_ORA1' - CNAMES(85) = 'WR_ORA2' - CNAMES(86) = 'WR_MO2' - CNAMES(87) = 'WR_OP1' - CNAMES(88) = 'WR_ASO3' - CNAMES(89) = 'WR_ASO4' - CNAMES(90) = 'WR_ASO5' - CNAMES(91) = 'WR_AHSO5' - CNAMES(92) = 'WR_AHMS' -! initialisation of the names of the reactions - CREACS(1) = 'K001' - CREACS(2) = 'K002' - CREACS(3) = 'K003' - CREACS(4) = 'K004' - CREACS(5) = 'K005' - CREACS(6) = 'K006' - CREACS(7) = 'K007' - CREACS(8) = 'K008' - CREACS(9) = 'K009' - CREACS(10) = 'K010' - CREACS(11) = 'K011' - CREACS(12) = 'K012' - CREACS(13) = 'K013' - CREACS(14) = 'K014' - CREACS(15) = 'K015' - CREACS(16) = 'K016' - CREACS(17) = 'K017' - CREACS(18) = 'K018' - CREACS(19) = 'K019' - CREACS(20) = 'K020' - CREACS(21) = 'K021' - CREACS(22) = 'K022' - CREACS(23) = 'K023' - CREACS(24) = 'K024' - CREACS(25) = 'K025' - CREACS(26) = 'K026' - CREACS(27) = 'K027' - CREACS(28) = 'K028' - CREACS(29) = 'K029' - CREACS(30) = 'K030' - CREACS(31) = 'K031' - CREACS(32) = 'K032' - CREACS(33) = 'K033' - CREACS(34) = 'K034' - CREACS(35) = 'K035' - CREACS(36) = 'K036' - CREACS(37) = 'K037' - CREACS(38) = 'K038' - CREACS(39) = 'K039' - CREACS(40) = 'K040' - CREACS(41) = 'K041' - CREACS(42) = 'K042' - CREACS(43) = 'K043' - CREACS(44) = 'K044' - CREACS(45) = 'K045' - CREACS(46) = 'K046' - CREACS(47) = 'K047' - CREACS(48) = 'K048' - CREACS(49) = 'K049' - CREACS(50) = 'K050' - CREACS(51) = 'K051' - CREACS(52) = 'K052' - CREACS(53) = 'K053' - CREACS(54) = 'K054' - CREACS(55) = 'K055' - CREACS(56) = 'K056' - CREACS(57) = 'K057' - CREACS(58) = 'K058' - CREACS(59) = 'K059' - CREACS(60) = 'K060' - CREACS(61) = 'K061' - CREACS(62) = 'K062' - CREACS(63) = 'K063' - CREACS(64) = 'K064' - CREACS(65) = 'K065' - CREACS(66) = 'K066' - CREACS(67) = 'K067' - CREACS(68) = 'K068' - CREACS(69) = 'K069' - CREACS(70) = 'K070' - CREACS(71) = 'K071' - CREACS(72) = 'K072' - CREACS(73) = 'K073' - CREACS(74) = 'K074' - CREACS(75) = 'K075' - CREACS(76) = 'K076' - CREACS(77) = 'K077' - CREACS(78) = 'K078' - CREACS(79) = 'K079' - CREACS(80) = 'K080' - CREACS(81) = 'K081' - CREACS(82) = 'K082' - CREACS(83) = 'K083' - CREACS(84) = 'K084' - CREACS(85) = 'K085' - CREACS(86) = 'K086' - CREACS(87) = 'K087' - CREACS(88) = 'K088' - CREACS(89) = 'K089' - CREACS(90) = 'K090' - CREACS(91) = 'K091' - CREACS(92) = 'K092' - CREACS(93) = 'K093' - CREACS(94) = 'K094' - CREACS(95) = 'K095' - CREACS(96) = 'K096' - CREACS(97) = 'K097' - CREACS(98) = 'K098' - CREACS(99) = 'K099' - CREACS(100) = 'K0100' - CREACS(101) = 'K0101' - CREACS(102) = 'K0102' - CREACS(103) = 'K103' - CREACS(104) = 'K104' - CREACS(105) = 'K105' - CREACS(106) = 'K106' - CREACS(107) = 'K107' - CREACS(108) = 'K108' - CREACS(109) = 'K109' - CREACS(110) = 'K110' - CREACS(111) = 'K111' - CREACS(112) = 'K112' - CREACS(113) = 'K113' - CREACS(114) = 'K114' - CREACS(115) = 'K115' - CREACS(116) = 'K116' - CREACS(117) = 'K117' - CREACS(118) = 'K118' - CREACS(119) = 'K119' - CREACS(120) = 'K120' - CREACS(121) = 'K121' - CREACS(122) = 'K122' - CREACS(123) = 'K123' - CREACS(124) = 'K124' - CREACS(125) = 'K125' - CREACS(126) = 'K126' - CREACS(127) = 'K127' - CREACS(128) = 'K128' - CREACS(129) = 'K129' - CREACS(130) = 'K130' - CREACS(131) = 'K131' - CREACS(132) = 'K132' - CREACS(133) = 'K133' - CREACS(134) = 'K134' - CREACS(135) = 'K135' - CREACS(136) = 'KTC1' - CREACS(137) = 'KTC2' - CREACS(138) = 'KTC3' - CREACS(139) = 'KTC4' - CREACS(140) = 'KTC5' - CREACS(141) = 'KTC6' - CREACS(142) = 'KTC7' - CREACS(143) = 'KTC8' - CREACS(144) = 'KTC9' - CREACS(145) = 'KTC10' - CREACS(146) = 'KTC11' - CREACS(147) = 'KTC12' - CREACS(148) = 'KTC13' - CREACS(149) = 'KTC14' - CREACS(150) = 'KTC15' - CREACS(151) = 'KTC16' - CREACS(152) = 'KTC17' - CREACS(153) = 'KTC18' - CREACS(154) = 'KTC19' - CREACS(155) = 'KTC20' - CREACS(156) = 'KTC21' - CREACS(157) = 'KTC22' - CREACS(158) = 'KTC23' - CREACS(159) = 'KTC24' - CREACS(160) = 'KTC25' - CREACS(161) = 'KTC26' - CREACS(162) = 'KTC27' - CREACS(163) = 'KTC28' - CREACS(164) = 'KTC29' - CREACS(165) = 'KTC30' - CREACS(166) = 'KTC31' - CREACS(167) = 'KTC32' - CREACS(168) = 'KTC33' - CREACS(169) = 'KTC34' - CREACS(170) = 'KTC35' - CREACS(171) = 'KTC36' - CREACS(172) = 'KTC37' - CREACS(173) = 'KTC38' - CREACS(174) = 'KTC39' - CREACS(175) = 'KTC40' - CREACS(176) = 'KTR1' - CREACS(177) = 'KTR2' - CREACS(178) = 'KTR3' - CREACS(179) = 'KTR4' - CREACS(180) = 'KTR5' - CREACS(181) = 'KTR6' - CREACS(182) = 'KTR7' - CREACS(183) = 'KTR8' - CREACS(184) = 'KTR9' - CREACS(185) = 'KTR10' - CREACS(186) = 'KTR11' - CREACS(187) = 'KTR12' - CREACS(188) = 'KTR13' - CREACS(189) = 'KTR14' - CREACS(190) = 'KTR15' - CREACS(191) = 'KTR16' - CREACS(192) = 'KTR17' - CREACS(193) = 'KTR18' - CREACS(194) = 'KTR19' - CREACS(195) = 'KTR20' - CREACS(196) = 'KTR21' - CREACS(197) = 'KTR22' - CREACS(198) = 'KTR23' - CREACS(199) = 'KTR24' - CREACS(200) = 'KTR25' - CREACS(201) = 'KTR26' - CREACS(202) = 'KTR27' - CREACS(203) = 'KTR28' - CREACS(204) = 'KTR29' - CREACS(205) = 'KTR30' - CREACS(206) = 'KTR31' - CREACS(207) = 'KTR32' - CREACS(208) = 'KTR33' - CREACS(209) = 'KTR34' - CREACS(210) = 'KTR35' - CREACS(211) = 'KTR36' - CREACS(212) = 'KTR37' - CREACS(213) = 'KTR38' - CREACS(214) = 'KTR39' - CREACS(215) = 'KTR40' - CREACS(216) = 'KC1' - CREACS(217) = 'KC2' - CREACS(218) = 'KC3' - CREACS(219) = 'KC4' - CREACS(220) = 'KC5' - CREACS(221) = 'KC6' - CREACS(222) = 'KC7' - CREACS(223) = 'KC8' - CREACS(224) = 'KC9' - CREACS(225) = 'KC10' - CREACS(226) = 'KC11' - CREACS(227) = 'KC12' - CREACS(228) = 'KC13' - CREACS(229) = 'KC14' - CREACS(230) = 'KC15' - CREACS(231) = 'KC16' - CREACS(232) = 'KC17' - CREACS(233) = 'KC18' - CREACS(234) = 'KC19' - CREACS(235) = 'KC20' - CREACS(236) = 'KC21' - CREACS(237) = 'KC22' - CREACS(238) = 'KC23' - CREACS(239) = 'KC24' - CREACS(240) = 'KC25' - CREACS(241) = 'KC26' - CREACS(242) = 'KC27' - CREACS(243) = 'KC28' - CREACS(244) = 'KC29' - CREACS(245) = 'KC30' - CREACS(246) = 'KR1' - CREACS(247) = 'KR2' - CREACS(248) = 'KR3' - CREACS(249) = 'KR4' - CREACS(250) = 'KR5' - CREACS(251) = 'KR6' - CREACS(252) = 'KR7' - CREACS(253) = 'KR8' - CREACS(254) = 'KR9' - CREACS(255) = 'KR10' - CREACS(256) = 'KR11' - CREACS(257) = 'KR12' - CREACS(258) = 'KR13' - CREACS(259) = 'KR14' - CREACS(260) = 'KR15' - CREACS(261) = 'KR16' - CREACS(262) = 'KR17' - CREACS(263) = 'KR18' - CREACS(264) = 'KR19' - CREACS(265) = 'KR20' - CREACS(266) = 'KR21' - CREACS(267) = 'KR22' - CREACS(268) = 'KR23' - CREACS(269) = 'KR24' - CREACS(270) = 'KR25' - CREACS(271) = 'KR26' - CREACS(272) = 'KR27' - CREACS(273) = 'KR28' - CREACS(274) = 'KR29' - CREACS(275) = 'KR30' -! initialisation of the full reactions - CFULLREACS(1) = 'K001=!ZRATES(:,001)::NO2-->O3P+NO' - CFULLREACS(2) = 'K002=!ZRATES(:,002)::O3-->O1D+O2' - CFULLREACS(3) = 'K003=!ZRATES(:,003)::O3-->O3P+O2' - CFULLREACS(4) = 'K004=!ZRATES(:,004)::HONO-->OH+NO' - CFULLREACS(5) = 'K005=!ZRATES(:,005)::HNO3-->OH+NO2' - CFULLREACS(6) = 'K006=!ZRATES(:,006)::HNO4-->0.65*HO2+0.65*NO2+0.35*OH+0.35*NO& -&3' - CFULLREACS(7) = 'K007=!ZRATES(:,007)::NO3-->NO+O2' - CFULLREACS(8) = 'K008=!ZRATES(:,008)::NO3-->NO2+O3P' - CFULLREACS(9) = 'K009=!ZRATES(:,009)::H2O2-->OH+OH' - CFULLREACS(10) = 'K010=!ZRATES(:,010)::HCHO-->H2+CO' - CFULLREACS(11) = 'K011=!ZRATES(:,011)::HCHO-->HO2+HO2+CO' - CFULLREACS(12) = 'K012=!ZRATES(:,012)::ALD-->MO2+HO2+CO' - CFULLREACS(13) = 'K013=!ZRATES(:,013)::OP1-->HCHO+HO2+OH' - CFULLREACS(14) = 'K014=!ZRATES(:,014)::OP2-->0.96205*ALD+0.96205*HO2+0.03795*M& -&O2+OH' - CFULLREACS(15) = 'K015=!ZRATES(:,015)::KET-->1.00000*CARBOP+1.00000*ALKAP' - CFULLREACS(16) = 'K016=!ZRATES(:,016)::CARBO-->0.06517*HCHO+0.69622*CARBOP+0.7& -&5830*HO2+0.91924*CO+0.20842*H2' - CFULLREACS(17) = 'K017=!ZRATES(:,017)::ONIT-->0.20*ALD+0.80*KET+HO2+NO2' - CFULLREACS(18) = 'K018=TPK%M*6.00E-34*(TPK%T/300)**(-2.3)::O3P+O2-->O3' - CFULLREACS(19) = 'K019=8.00E-12*exp(-(2060.0/TPK%T))::O3P+O3-->2.0*O2' - CFULLREACS(20) = 'K020=1.80E-11*exp(-(-110.0/TPK%T))::O1D+N2-->O3P+N2' - CFULLREACS(21) = 'K021=3.20E-11*exp(-(-70.0/TPK%T))::O1D+O2-->O3P+O2' - CFULLREACS(22) = 'K022=2.20E-10::O1D+H2O-->OH+OH' - CFULLREACS(23) = 'K023=1.60E-12*exp(-(940.0/TPK%T))::O3+OH-->HO2+O2' - CFULLREACS(24) = 'K024=1.10E-14*exp(-(500.0/TPK%T))::O3+HO2-->OH+2.0*O2' - CFULLREACS(25) = 'K025=4.80E-11*exp(-(-250.0/TPK%T))::OH+HO2-->H2O+O2' - CFULLREACS(26) = 'K026=2.90E-12*exp(-(160.0/TPK%T))::H2O2+OH-->HO2+H2O' - CFULLREACS(27) = 'K027=2.3E-13*EXP(600./TPK%T)+1.7E-33*TPK%M*EXP(1000./TPK%T):& -&:HO2+HO2-->H2O2+O2' - CFULLREACS(28) = 'K028=3.22E-34*EXP(2800./TPK%T)+2.38E-54*TPK%M*EXP(3200./TPK%& -&T)::HO2+HO2+H2O-->H2O2+H2O+O2' - CFULLREACS(29) = 'K029=@TROE(1.,9.00E-32,1.5,3.00E-11,0.0,TPK%M,TPK%T,KVECNPT)& -&::O3P+NO-->NO2' - CFULLREACS(30) = 'K030=6.50E-12*exp(-(-120.0/TPK%T))::O3P+NO2-->NO+O2' - CFULLREACS(31) = 'K031=@TROE(1.,9.00E-32,2.0,2.20E-11,0.0,TPK%M,TPK%T,KVECNPT)& -&::O3P+NO2-->NO3' - CFULLREACS(32) = 'K032=@TROE(1.,7.00E-31,2.6,1.50E-11,0.5,TPK%M,TPK%T,KVECNPT)& -&::OH+NO-->HONO' - CFULLREACS(33) = 'K033=@TROE(1.,2.60E-30,3.2,2.40E-11,1.3,TPK%M,TPK%T,KVECNPT)& -&::OH+NO2-->HNO3' - CFULLREACS(34) = 'K034=2.20E-11::OH+NO3-->NO2+HO2' - CFULLREACS(35) = 'K035=3.70E-12*exp(-(-250.0/TPK%T))::HO2+NO-->NO2+OH' - CFULLREACS(36) = 'K036=@TROE(1.,1.80E-31,3.2,4.70E-12,1.4,TPK%M,TPK%T,KVECNPT)& -&::HO2+NO2-->HNO4' - CFULLREACS(37) = 'K037=@TROE_EQUIL(1.80E-31,3.2,4.70E-12,1.4,4.76E+26,10900.,T& -&PK%M,TPK%T,KVECNPT)::HNO4-->HO2+NO2' - CFULLREACS(38) = 'K038=3.50E-12::HO2+NO3-->0.3*HNO3+0.7*NO2+0.7*OH' - CFULLREACS(39) = 'K039=1.80E-11*exp(-(390.0/TPK%T))::OH+HONO-->H2O+NO2' - CFULLREACS(40) = 'K040=(7.2E-15*EXP(785/TPK%T))+(1.9E-33*EXP(725/TPK%T)*TPK%M)& -&/(1+(1.9E-33*EXP(725/TPK%T)*TPK%M)/(4.1E-16*EXP(1440/TPK%T)))::OH+HNO3-->NO3+H& -&2O' - CFULLREACS(41) = 'K041=1.30E-12*exp(-(-380.0/TPK%T))::OH+HNO4-->NO2+H2O+O2' - CFULLREACS(42) = 'K042=2.00E-12*exp(-(1400.0/TPK%T))::O3+NO-->NO2+O2' - CFULLREACS(43) = 'K043=1.20E-13*exp(-(2450.0/TPK%T))::O3+NO2-->NO3+O2' - CFULLREACS(44) = 'K044=3.30E-39*exp(-(-530.0/TPK%T))::NO+NO+O2-->NO2+NO2' - CFULLREACS(45) = 'K045=1.50E-11*exp(-(-170.0/TPK%T))::NO3+NO-->NO2+NO2' - CFULLREACS(46) = 'K046=4.50E-14*exp(-(1260.0/TPK%T))::NO3+NO2-->NO+NO2+O2' - CFULLREACS(47) = 'K047=@TROE(1.,2.20E-30,3.9,1.50E-12,0.7,TPK%M,TPK%T,KVECNPT)& -&::NO3+NO2-->N2O5' - CFULLREACS(48) = 'K048=@TROE_EQUIL(2.20E-30,3.9,1.50E-12,0.7,3.70E+26,11000.0,& -&TPK%M,TPK%T,KVECNPT)::N2O5-->NO2+NO3' - CFULLREACS(49) = 'K049=8.50E-13*exp(-(2450.0/TPK%T))::NO3+NO3-->NO2+NO2+O2' - CFULLREACS(50) = 'K050=3.30E-12*exp(-(900.0/TPK%T))::NH3+OH-->' - CFULLREACS(51) = 'K051=5.50E-12*exp(-(2000.0/TPK%T))::OH+H2-->H2O+HO2' - CFULLREACS(52) = 'K052=@TROE(1.,3.00E-31,3.3,1.50E-12,0.0,TPK%M,TPK%T,KVECNPT)& -&::OH+SO2-->SULF+HO2' - CFULLREACS(53) = 'K053=1.5E-13*(1.+2.439E-20*TPK%M)::CO+OH-->HO2+CO2' - CFULLREACS(54) = 'K054=6.00E-11::BIO+O3P-->0.91868*ALKE+0.05*HCHO+0.02*OH+0.01& -&*CO+0.13255*CARBO+0.28*HO2+0.15*XO2' - CFULLREACS(55) = 'K055=0.00E-01*exp(-(-13.0/TPK%T))::CARBO+O3P-->ALD' - CFULLREACS(56) = 'K056=TPK%T*TPK%T*7.44E-18*exp(-(1361./TPK%T))::CH4+OH-->MO2+& -&H2O' - CFULLREACS(57) = 'K057=1.51E-17*TPK%T*TPK%T*exp(-(492./TPK%T))::ETH+OH-->ALKAP& -&' - CFULLREACS(58) = 'K058=3.76E-12*exp(-(260.0/TPK%T))+1.70E-12*exp(-(155.0/TPK%T& -&))+1.21E-12*exp(-(125.0/TPK%T))::ALKA+OH-->0.87811*ALKAP+0.12793*HO2+0.08173*A& -&LD+0.03498*KET+0.00835*CARBO+0.00140*HCHO+0.00878*ORA1+0.00878*CO+0.00878*OH+H& -&2O' - CFULLREACS(59) = 'K059=1.78E-12*exp(-(-438.0/TPK%T))+6.07E-13*exp(-(-500.0/TPK& -&%T))+0.00E-01*exp(-(-448.0/TPK%T))::ALKE+OH-->1.02529*ALKEP+0.00000*BIOP' - CFULLREACS(60) = 'K060=2.54E-11*exp(-(-410.0/TPK%T))+0.00E-01*exp(-(-444.0/TPK& -&%T))+0.00E-01::BIO+OH-->1.00000*BIOP' - CFULLREACS(61) = 'K061=3.31E-12*exp(-(-355.0/TPK%T))+3.45E-13::ARO+OH-->0.9396& -&8*ADD+0.10318*XO2+0.10318*HO2+0.00276*PHO' - CFULLREACS(62) = 'K062=1.00E-11::HCHO+OH-->HO2+CO+H2O' - CFULLREACS(63) = 'K063=5.55E-12*exp(-(-331.0/TPK%T))::ALD+OH-->1.00000*CARBOP+& -&H2O' - CFULLREACS(64) = 'K064=TPK%T*TPK%T*5.68E-18*exp(-(-92.0/TPK%T))::KET+OH-->1.00& -&000*CARBOP+H2O' - CFULLREACS(65) = 'K065=1.32E-11+1.88E-12*exp(-(-175.0/TPK%T))::CARBO+OH-->0.51& -&419*CARBOP+0.16919*CARBO+1.01732*CO+0.51208*HO2+0.00000*HCHO+0.06253*ALD+0.008& -&53*KET+0.10162*XO2+0.75196*H2O' - CFULLREACS(66) = 'K066=4.50E-13::ORA1+OH-->HO2+CO2+H2O' - CFULLREACS(67) = 'K067=6.00E-13::ORA2+OH-->' - CFULLREACS(68) = 'K068=2.93E-12*exp(-(-190.0/TPK%T))::OP1+OH-->0.65*MO2+0.35*H& -&CHO+0.35*OH' - CFULLREACS(69) = 'K069=3.36E-12*exp(-(-190.0/TPK%T))::OP2+OH-->0.40341*ALKAP+0& -&.05413*CARBOP+0.07335*ALD+0.37591*KET+0.09333*XO2+0.02915*HO2+0.02915*HCHO+0.4& -&4925*OH' - CFULLREACS(70) = 'K070=3.80E-14+1.59E-14*exp(-(-500.0/TPK%T))::PAN+OH-->0.5783& -&9*HCHO+0.21863*CARBO+0.71893*NO3+0.28107*PAN+0.28107*HO2+0.29733*H2O+XO2' - CFULLREACS(71) = 'K071=5.31E-12*exp(-(260.0/TPK%T))::ONIT+OH-->1.00000*ALKAP+N& -&O2+H2O' - CFULLREACS(72) = 'K072=3.40E-13*exp(-(1900.0/TPK%T))::HCHO+NO3-->HO2+HNO3+CO' - CFULLREACS(73) = 'K073=1.40E-12*exp(-(1900.0/TPK%T))::ALD+NO3-->1.00000*CARBOP& -&+HNO3' - CFULLREACS(74) = 'K074=1.62E-12*exp(-(1900.0/TPK%T))+0.00E-01*exp(-(150.0/TPK%& -&T))+1.94E-14*exp(-(1000.0/TPK%T))::CARBO+NO3-->0.91567*HNO3+0.38881*CARBOP+0.1& -&0530*CARBO+0.05265*ALD+0.00632*KET+0.10530*NO2+0.10530*XO2+0.63217*HO2+1.33723& -&*CO+0.00000*OLN' - CFULLREACS(75) = 'K075=4.92E-16::ARO+NO3-->HNO3+PHO' - CFULLREACS(76) = 'K076=4.35E-18*TPK%T*TPK%T*exp(-(2282.0/TPK%T))+1.91E-14*exp(& -&-(450.0/TPK%T))+1.08E-15*exp(-(-450.0/TPK%T))+0.00E-01::ALKE+NO3-->0.00000*CAR& -&BO+0.93768*OLN' - CFULLREACS(77) = 'K077=4.00E-12*exp(-(446.0/TPK%T))+0.00E-01*exp(-(-490.0/TPK%& -&T))+0.00E-01::BIO+NO3-->0.91741*CARBO+1.00000*OLN' - CFULLREACS(78) = 'K078=3.76E-16*exp(-(500.0/TPK%T))::PAN+NO3-->0.60*ONIT+0.60*& -&NO3+0.40000*PAN+0.40*HCHO+0.40*NO2+XO2' - CFULLREACS(79) = 'K079=8.17E-15*exp(-(2580.0/TPK%T))+4.32E-16*exp(-(1800.0/TPK& -&%T))+2.87E-17*exp(-(845.0/TPK%T))+0.00E-01*exp(-(2283.0/TPK%T))::ALKE+O3-->0.4& -&8290*HCHO+0.51468*ALD+0.07377*KET+0.00000*CARBO+0.35120*CO+0.15343*ORA1+0.0814& -&3*ORA2+0.23451*HO2+0.39435*OH+0.05705*CARBOP+0.03196*ETH+0.00000*ALKE+0.04300*& -&CH4+0.13966*MO2+0.09815*ALKAP+0.01833*H2O2+0.00000*XO2+0.05409*H2+0.00000*O3P' - CFULLREACS(80) = 'K080=7.86E-15*exp(-(1913.0/TPK%T))+0.00E-01*exp(-(732.0/TPK%& -&T))+0.00E-01::BIO+O3-->0.90000*HCHO+0.00000*ALD+0.00000*KET+0.39754*CARBO+0.36& -&000*CO+0.37388*ALKE+0.00000*ALKAP+0.17000*CARBOP+0.03000*MO2+0.15000*ORA1+0.00& -&000*ORA2+0.28000*OH+0.30000*HO2+0.00100*H2O2+0.05000*H2+0.13000*XO2+0.09000*O3& -&P' - CFULLREACS(81) = 'K081=0.00E-01*exp(-(2112.0/TPK%T))+1.38E-19::CARBO+O3-->0.00& -&000*HCHO+1.07583*CARBO+0.15692*ALD+0.10788*ORA1+0.20595*ORA2+0.27460*CARBOP+0.& -&10149*OP2+0.64728*CO+0.28441*HO2+0.20595*OH+0.00000*H2' - CFULLREACS(82) = 'K082=7.20E-17*exp(-(1700.0/TPK%T))::PAN+O3-->0.70*HCHO+0.300& -&00*PAN+0.70*NO2+0.13*CO+0.04*H2+0.11*ORA1+0.08*HO2+0.036*OH+0.70000*CARBOP' - CFULLREACS(83) = 'K083=2.00E-11::PHO+NO2-->0.10670*ARO+ONIT' - CFULLREACS(84) = 'K084=1.00E-11::PHO+HO2-->1.06698*ARO' - CFULLREACS(85) = 'K085=3.60E-11::ADD+NO2-->ARO+HONO' - CFULLREACS(86) = 'K086=1.66E-17*exp(-(-1044.0/TPK%T))::ADD+O2-->0.98*AROP+0.02& -&*ARO+0.02*HO2' - CFULLREACS(87) = 'K087=2.80E-11::ADD+O3-->ARO+OH' - CFULLREACS(88) = 'K088=@TROE(5.86E-01,9.70E-29,5.6,9.30E-12,1.5,TPK%M,TPK%T,KV& -&ECNPT)::CARBOP+NO2-->1.00000*PAN' - CFULLREACS(89) = 'K089=@TROE_EQUIL(9.70E-29,5.6,9.30E-12,1.5,1.16E+28,13954.,T& -&PK%M,TPK%T,KVECNPT)::PAN-->1.00000*CARBOP+NO2' - CFULLREACS(90) = 'K090=4.20E-12*exp(-(-180.0/TPK%T))::MO2+NO-->HCHO+HO2+NO2' - CFULLREACS(91) = 'K091=4.36E-12::ALKAP+NO-->0.33144*ALD+0.03002*HCHO+0.54531*K& -&ET+0.03407*CARBO+0.74265*HO2+0.09016*MO2+0.08187*ALKAP+0.13007*XO2+0.08459*ONI& -&T+0.91541*NO2' - CFULLREACS(92) = 'K092=6.93E-12::ALKEP+NO-->1.39870*HCHO+0.42125*ALD+0.05220*K& -&ET+HO2+NO2' - CFULLREACS(93) = 'K093=4.00E-12::BIOP+NO-->0.45463*CARBO+0.60600*HCHO+0.00000*& -&ALD+0.00000*KET+0.37815*ALKE+0.84700*HO2+0.84700*NO2+0.15300*ONIT' - CFULLREACS(94) = 'K094=4.00E-12::AROP+NO-->0.95115*NO2+0.95115*HO2+2.06993*CAR& -&BO+0.04885*ONIT' - CFULLREACS(95) = 'K095=1.22E-11::CARBOP+NO-->0.78134*MO2+0.09532*CARBOP+0.0584& -&8*HCHO+0.07368*ALD+0.08670*CARBO+0.12334*HO2+0.02563*XO2+NO2' - CFULLREACS(96) = 'K096=4.00E-12::OLN+NO-->0.18401*ONIT+1.81599*NO2+0.18401*HO2& -&+0.23419*HCHO+1.01182*ALD+0.37862*KET' - CFULLREACS(97) = 'K097=3.80E-13*exp(-(-800.0/TPK%T))::MO2+HO2-->OP1' - CFULLREACS(98) = 'K098=6.16E-14*exp(-(-700.0/TPK%T))+1.52E-13*exp(-(-1300.0/TP& -&K%T))::ALKAP+HO2-->1.00524*OP2' - CFULLREACS(99) = 'K099=1.81E-13*exp(-(-1300.0/TPK%T))::ALKEP+HO2-->1.00524*OP2& -&' - CFULLREACS(100) = 'K0100=1.28E-13*exp(-(-1300.0/TPK%T))+0.00E-01::BIOP+HO2-->1& -&.00524*OP2' - CFULLREACS(101) = 'K0101=3.75E-13*exp(-(-980.0/TPK%T))::AROP+HO2-->1.00524*OP2& -&' - CFULLREACS(102) = 'K0102=5.94E-13*exp(-(-550.0/TPK%T))+1.99E-16*exp(-(-2640.0/& -&TPK%T))+5.56E-14*exp(-(-1300.0/TPK%T))::CARBOP+HO2-->0.80904*OP2+0.17307*ORA2+& -&0.17307*O3' - CFULLREACS(103) = 'K103=1.66E-13*exp(-(-1300.0/TPK%T))::OLN+HO2-->ONIT' - CFULLREACS(104) = 'K104=9.10E-14*exp(-(-416.0/TPK%T))::MO2+MO2-->1.33*HCHO+0.6& -&6*HO2' - CFULLREACS(105) = 'K105=1.03E-14*exp(-(-158.0/TPK%T))+6.24E-14*exp(-(-431.0/TP& -&K%T))+1.53E-14*exp(-(-467.0/TPK%T))+4.34E-15*exp(-(-633.0/TPK%T))::ALKAP+MO2--& -&>0.80556*HCHO+0.98383*HO2+0.56070*ALD+0.09673*KET+0.01390*MO2+0.07976*CARBO+0.& -&13370*XO2+0.00385*ALKAP' - CFULLREACS(106) = 'K106=1.57E-13*exp(-(-708.0/TPK%T))::ALKEP+MO2-->1.42894*HCH& -&O+0.46413*ALD+0.03814*KET+HO2' - CFULLREACS(107) = 'K107=1.36E-13*exp(-(-708.0/TPK%T))::BIOP+MO2-->0.56064*CARB& -&O+0.48074*ALKE+1.00000*HO2+1.09000*HCHO+0.00000*ALD+0.00000*KET' - CFULLREACS(108) = 'K108=3.56E-14*exp(-(-708.0/TPK%T))::AROP+MO2-->HCHO+1.02767& -&*HO2+1.99461*CARBO' - CFULLREACS(109) = 'K109=1.77E-11*exp(-(440.0/TPK%T))+1.48E-16*exp(-(-2510.0/TP& -&K%T))+3.10E-13*exp(-(-508.0/TPK%T))::CARBOP+MO2-->0.95723*HCHO+0.82998*HO2+0.5& -&6031*MO2+0.13684*ORA2+0.05954*CARBOP+0.15387*CARBO+0.08295*ALD+0.02212*XO2' - CFULLREACS(110) = 'K110=1.12E-13*exp(-(-708.0/TPK%T))::OLN+MO2-->0.88625*HCHO+& -&0.67560*HO2+0.67560*ONIT+0.41524*ALD+0.09667*KET+0.32440*NO2' - CFULLREACS(111) = 'K111=4.44E-14*exp(-(-211.0/TPK%T))+2.23E-13*exp(-(-460.0/TP& -&K%T))+4.10E-14*exp(-(-522.0/TPK%T))+1.17E-14*exp(-(-683.0/TPK%T))::ALKAP+CARBO& -&P-->0.71461*ALD+0.48079*HO2+0.51480*MO2+0.49810*ORA2+0.18819*KET+0.07600*HCHO+& -&0.00828*ALKAP+0.11306*XO2+0.06954*CARBO' - CFULLREACS(112) = 'K112=4.36E-13*exp(-(-765.0/TPK%T))::ALKEP+CARBOP-->0.68192*& -&HCHO+0.68374*ALD+0.50078*HO2+0.50078*MO2+0.49922*ORA2+0.06579*KET' - CFULLREACS(113) = 'K113=7.60E-13*exp(-(-765.0/TPK%T))::BIOP+CARBOP-->0.78591*C& -&ARBO+0.24463*ALKE+0.50600*HO2+0.49400*ORA2+0.34000*HCHO+0.50600*MO2+0.00000*AL& -&D+0.00000*KET' - CFULLREACS(114) = 'K114=3.63E-13*exp(-(-765.0/TPK%T))::AROP+CARBOP-->MO2+HO2+1& -&.99455*CARBO' - CFULLREACS(115) = 'K115=7.73E-13*exp(-(-530.0/TPK%T))+1.70E-13*exp(-(-565.0/TP& -&K%T))::CARBOP+CARBOP-->1.66702*MO2+0.05821*CARBOP+0.03432*HCHO+0.10777*CARBO+0& -&.06969*ALD+0.02190*KET+0.07566*HO2+0.01593*XO2+0.09955*ORA2' - CFULLREACS(116) = 'K116=4.85E-13*exp(-(-765.0/TPK%T))::OLN+CARBOP-->0.66562*ON& -&IT+0.51037*MO2+0.48963*ORA2+0.17599*HO2+0.13414*HCHO+0.42122*ALD+0.10822*KET+0& -&.00000*NO2' - CFULLREACS(117) = 'K117=4.19E-15*exp(-(-1000.0/TPK%T))::OLN+OLN-->2.00*ONIT+HO& -&2' - CFULLREACS(118) = 'K118=2.48E-14*exp(-(-1000.0/TPK%T))::OLN+OLN-->0.00000*HCHO& -&+0.00000*ALD+0.00000*KET+0.00000*HO2+0.00000*NO2+0.00000*ONIT' - CFULLREACS(119) = 'K119=1.20E-12::MO2+NO3-->HCHO+HO2+NO2' - CFULLREACS(120) = 'K120=1.20E-12::ALKAP+NO3-->0.33743*ALD+0.81290*HO2+0.03142*& -&HCHO+0.62978*KET+0.03531*CARBO+0.09731*MO2+0.08994*ALKAP+0.16271*XO2+NO2' - CFULLREACS(121) = 'K121=1.20E-12::ALKEP+NO3-->1.40909*HCHO+0.43039*ALD+0.02051& -&*KET+HO2+NO2' - CFULLREACS(122) = 'K122=1.20E-12::BIOP+NO3-->0.61160*CARBO+0.42729*ALKE+0.6860& -&0*HCHO+0.00000*ALD+0.00000*KET+HO2+NO2' - CFULLREACS(123) = 'K123=1.20E-12::AROP+NO3-->2.81904*CARBO+HO2+NO2' - CFULLREACS(124) = 'K124=3.48E-12::CARBOP+NO3-->0.91910*MO2+0.03175*CARBOP+0.03& -&175*HCHO+0.03455*CARBO+0.02936*ALD+0.04915*HO2+0.01021*XO2+NO2' - CFULLREACS(125) = 'K125=1.20E-12::OLN+NO3-->0.25928*ONIT+1.74072*NO2+0.25928*H& -&O2+0.20740*HCHO+0.91850*ALD+0.34740*KET' - CFULLREACS(126) = 'K126=1.66E-13*exp(-(-1300.0/TPK%T))::XO2+HO2-->1.00524*OP2' - CFULLREACS(127) = 'K127=5.99E-15*exp(-(-1510.0/TPK%T))::XO2+MO2-->HCHO+HO2' - CFULLREACS(128) = 'K128=1.69E-14*exp(-(-1560.0/TPK%T))::XO2+CARBOP-->MO2' - CFULLREACS(129) = 'K129=7.13E-17*exp(-(-2950.0/TPK%T))::XO2+XO2-->' - CFULLREACS(130) = 'K130=4.00E-12::XO2+NO-->NO2' - CFULLREACS(131) = 'K131=1.20E-12::XO2+NO3-->NO2' - CFULLREACS(132) = 'K132=1.00E-40::SULF-->' - CFULLREACS(133) = 'K133=5.40E-13::DMS+NO3-->SO2+NO2' - CFULLREACS(134) = 'K134=1.30E-11*exp(-(400./TPK%T))::DMS+O3P-->SO2' - CFULLREACS(135) = 'K135=(TPK%T*exp(-234./TPK%T)+8.4E-10*exp(7230./TPK%T)+2.68E& -&-10*exp(7810./TPK%T))/(1.04E11*TPK%T+88.1*exp(7460./TPK%T))::DMS+OH-->0.8*SO2' - CFULLREACS(136) = 'KTC1=@KT(0.05,48.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::O3-->WC_& -&O3' - CFULLREACS(137) = 'KTC2=@KT(0.11,34.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::H2O2-->W& -&C_H2O2' - CFULLREACS(138) = 'KTC3=@KT(0.0001,30.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::NO-->W& -&C_NO' - CFULLREACS(139) = 'KTC4=@KT(0.0015,46.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::NO2-->& -&WC_NO2' - CFULLREACS(140) = 'KTC5=@KT(0.05,62.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::NO3-->WC& -&_NO3' - CFULLREACS(141) = 'KTC6=@KT(0.0037,108.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::N2O5-& -&->WC_N2O5' - CFULLREACS(142) = 'KTC7=@KT(0.05,47.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::HONO-->W& -&C_HONO' - CFULLREACS(143) = 'KTC8=@KT(0.054,63.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::HNO3-->& -&WC_HNO3' - CFULLREACS(144) = 'KTC9=@KT(0.05,79.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::HNO4-->W& -&C_HNO4' - CFULLREACS(145) = 'KTC10=@KT(0.04,17.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::NH3-->W& -&C_NH3' - CFULLREACS(146) = 'KTC11=@KT(0.05,17.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::OH-->WC& -&_OH' - CFULLREACS(147) = 'KTC12=@KT(0.2,30.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::HO2-->WC& -&_HO2' - CFULLREACS(148) = 'KTC13=@KT(0.0002,44.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::CO2--& -&>WC_CO2' - CFULLREACS(149) = 'KTC14=@KT(0.11,64.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::SO2-->W& -&C_SO2' - CFULLREACS(150) = 'KTC15=@KT(0.07,98.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::SULF-->& -&WC_SULF' - CFULLREACS(151) = 'KTC16=@KT(0.04,30.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::HCHO-->& -&WC_HCHO' - CFULLREACS(152) = 'KTC17=@KT(0.012,46.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::ORA1--& -&>WC_ORA1' - CFULLREACS(153) = 'KTC18=@KT(0.03,60.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::ORA2-->& -&WC_ORA2' - CFULLREACS(154) = 'KTC19=@KT(0.05,47.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::MO2-->W& -&C_MO2' - CFULLREACS(155) = 'KTC20=@KT(0.007,48.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::OP1-->& -&WC_OP1' - CFULLREACS(156) = 'KTC21=@KT(0.05,48.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(1.03e-2,& -&-2830.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_O3-->O3' - CFULLREACS(157) = 'KTC22=@KT(0.11,34.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(8.44e4,-& -&7600.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_H2O2-->H2O2' - CFULLREACS(158) = 'KTC23=@KT(0.0001,30.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(1.92e-& -&3,-1790.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_NO-->NO' - CFULLREACS(159) = 'KTC24=@KT(0.0015,46.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(1.2e-2& -&,-2400.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_NO2-->NO2' - CFULLREACS(160) = 'KTC25=@KT(0.05,62.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(3.8e-2,0& -&.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_NO3-->NO3' - CFULLREACS(161) = 'KTC26=@KT(0.0037,108.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(8.8e-& -&2,-3600.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_N2O5-->N2O5' - CFULLREACS(162) = 'KTC27=@KT(0.05,47.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(5.0e1,-4& -&880.,1.6e-3,1760.,0.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_HONO-->HONO' - CFULLREACS(163) = 'KTC28=@KT(0.054,63.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(2.1e5,-& -&10500.,2.2e1,0.,0.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_HNO3-->HNO3' - CFULLREACS(164) = 'KTC29=@KT(0.05,79.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(1.2e4,-6& -&900.,1.26e-6,0.,0.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_HNO4-->HNO4' - CFULLREACS(165) = 'KTC30=@KT(0.04,17.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFB(6.02e1,-& -&4160.,1.7e-5,4350.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_NH3-->NH3' - CFULLREACS(166) = 'KTC31=@KT(0.05,17.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(3.9e1,0.& -&,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_OH-->OH' - CFULLREACS(167) = 'KTC32=@KT(0.2,30.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(6.9e2,0.,& -&1.6e-5,0.,0.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_HO2-->HO2' - CFULLREACS(168) = 'KTC33=@KT(0.0002,44.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(3.4e-2& -&,-2710.,4.3e-7,920.,4.7e-11,1780.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_CO& -&2-->CO2' - CFULLREACS(169) = 'KTC34=@KT(0.11,64.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(1.36,-29& -&30.,1.3e-2,-1965.,6.4e-8,-1430.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_SO2-& -&->SO2' - CFULLREACS(170) = 'KTC35=@KT(0.07,98.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(2.1e5,-8& -&700.,1.0e3,0.,1.0e-2,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_SULF-->SULF' - CFULLREACS(171) = 'KTC36=@KT(0.04,30.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(3.23e3,-& -&7100.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_HCHO-->HCHO' - CFULLREACS(172) = 'KTC37=@KT(0.012,46.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(8.9e3,-& -&6100.,1.8e-4,150.,0.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_ORA1-->ORA1' - CFULLREACS(173) = 'KTC38=@KT(0.03,60.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(4.1e3,-6& -&200.,1.74e-5,0.,0.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_ORA2-->ORA2' - CFULLREACS(174) = 'KTC39=@KT(0.05,47.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(2.45e0,-& -&5280.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_MO2-->MO2' - CFULLREACS(175) = 'KTC40=@KT(0.007,48.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(3.e2,-5& -&280.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_OP1-->OP1' - CFULLREACS(176) = 'KTR1=@KT(0.05,48.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::O3-->WR_& -&O3' - CFULLREACS(177) = 'KTR2=@KT(0.11,34.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::H2O2-->W& -&R_H2O2' - CFULLREACS(178) = 'KTR3=@KT(0.0001,30.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::NO-->W& -&R_NO' - CFULLREACS(179) = 'KTR4=@KT(0.0015,46.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::NO2-->& -&WR_NO2' - CFULLREACS(180) = 'KTR5=@KT(0.05,62.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::NO3-->WR& -&_NO3' - CFULLREACS(181) = 'KTR6=@KT(0.0037,108.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::N2O5-& -&->WR_N2O5' - CFULLREACS(182) = 'KTR7=@KT(0.05,47.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::HONO-->W& -&R_HONO' - CFULLREACS(183) = 'KTR8=@KT(0.054,63.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::HNO3-->& -&WR_HNO3' - CFULLREACS(184) = 'KTR9=@KT(0.05,79.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::HNO4-->W& -&R_HNO4' - CFULLREACS(185) = 'KTR10=@KT(0.04,17.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::NH3-->W& -&R_NH3' - CFULLREACS(186) = 'KTR11=@KT(0.05,17.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::OH-->WR& -&_OH' - CFULLREACS(187) = 'KTR12=@KT(0.2,30.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::HO2-->WR& -&_HO2' - CFULLREACS(188) = 'KTR13=@KT(0.0002,44.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::CO2--& -&>WR_CO2' - CFULLREACS(189) = 'KTR14=@KT(0.11,64.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::SO2-->W& -&R_SO2' - CFULLREACS(190) = 'KTR15=@KT(0.07,98.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::SULF-->& -&WR_SULF' - CFULLREACS(191) = 'KTR16=@KT(0.04,30.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::HCHO-->& -&WR_HCHO' - CFULLREACS(192) = 'KTR17=@KT(0.012,46.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::ORA1--& -&>WR_ORA1' - CFULLREACS(193) = 'KTR18=@KT(0.03,60.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::ORA2-->& -&WR_ORA2' - CFULLREACS(194) = 'KTR19=@KT(0.05,47.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::MO2-->W& -&R_MO2' - CFULLREACS(195) = 'KTR20=@KT(0.007,48.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::OP1-->& -&WR_OP1' - CFULLREACS(196) = 'KTR21=@KT(0.05,48.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(1.03e-2,& -&-2830.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_O3-->O3' - CFULLREACS(197) = 'KTR22=@KT(0.11,34.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(8.44e4,-& -&7600.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_H2O2-->H2O2' - CFULLREACS(198) = 'KTR23=@KT(0.0001,30.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(1.92e-& -&3,-1790.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_NO-->NO' - CFULLREACS(199) = 'KTR24=@KT(0.0015,46.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(1.2e-2& -&,-2400.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_NO2-->NO2' - CFULLREACS(200) = 'KTR25=@KT(0.05,62.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(3.8e-2,0& -&.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_NO3-->NO3' - CFULLREACS(201) = 'KTR26=@KT(0.0037,108.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(8.8e-& -&2,-3600.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_N2O5-->N2O5' - CFULLREACS(202) = 'KTR27=@KT(0.05,47.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(5.0e1,-4& -&880.,1.6e-3,1760.,0.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_HONO-->HONO' - CFULLREACS(203) = 'KTR28=@KT(0.054,63.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(2.1e5,-& -&10500.,2.2e1,0.,0.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_HNO3-->HNO3' - CFULLREACS(204) = 'KTR29=@KT(0.05,79.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(1.2e4,-6& -&900.,1.26e-6,0.,0.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_HNO4-->HNO4' - CFULLREACS(205) = 'KTR30=@KT(0.04,17.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFB(6.02e1,-& -&4160.,1.7e-5,4350.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_NH3-->NH3' - CFULLREACS(206) = 'KTR31=@KT(0.05,17.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(3.9e1,0.& -&,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_OH-->OH' - CFULLREACS(207) = 'KTR32=@KT(0.2,30.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(6.9e2,0.,& -&1.6e-5,0.,0.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_HO2-->HO2' - CFULLREACS(208) = 'KTR33=@KT(0.0002,44.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(3.4e-2& -&,-2710.,4.3e-7,920.,4.7e-11,1780.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_CO& -&2-->CO2' - CFULLREACS(209) = 'KTR34=@KT(0.11,64.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(1.36,-29& -&30.,1.3e-2,-1965.,6.4e-8,-1430.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_SO2-& -&->SO2' - CFULLREACS(210) = 'KTR35=@KT(0.07,98.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(2.1e5,-8& -&700.,1.0e3,0.,1.0e-2,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_SULF-->SULF' - CFULLREACS(211) = 'KTR36=@KT(0.04,30.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(3.23e3,-& -&7100.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_HCHO-->HCHO' - CFULLREACS(212) = 'KTR37=@KT(0.012,46.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(8.9e3,-& -&6100.,1.8e-4,150.,0.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_ORA1-->ORA1' - CFULLREACS(213) = 'KTR38=@KT(0.03,60.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(4.1e3,-6& -&200.,1.74e-5,0.,0.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_ORA2-->ORA2' - CFULLREACS(214) = 'KTR39=@KT(0.05,47.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(2.45e0,-& -&5280.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_MO2-->MO2' - CFULLREACS(215) = 'KTR40=@KT(0.007,48.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(3.e2,-5& -&280.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_OP1-->OP1' - CFULLREACS(216) = 'KC1=!ZRATES(:,018)::WC_H2O2-->WC_OH+WC_OH' - CFULLREACS(217) = 'KC2=(3.6E+9*exp(-930.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLECC& -&LOUD::WC_OH+WC_OH-->WC_H2O2' - CFULLREACS(218) = 'KC3=((2.8E+10*10.**(-TPK%PHC)+3.5E+10*exp(-720.*(1./TPK%T-1& -&./298.15))*1.6e-5)/(1.6e-5+10.**(-TPK%PHC)))/TPK%MOL2MOLECCLOUD::WC_OH+WC_HO2-& -&->' - CFULLREACS(219) = 'KC4=(3.2E+7*exp(-1700.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLEC& -&CLOUD::WC_H2O2+WC_OH-->WC_HO2' - CFULLREACS(220) = 'KC5=((8.3E+5*exp(-2700.*(1./TPK%T-1./298.15))*(10.**(-TPK%P& -&HC))**2.+9.6E+7*exp(-910.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)*1.6e-5)/(1.6e-& -&5+10.**(-TPK%PHC))**2.)/TPK%MOL2MOLECCLOUD::WC_HO2+WC_HO2-->WC_H2O2' - CFULLREACS(221) = 'KC6=(1.5E+9*exp(-1500.*(1./TPK%T-1./298.15))*1.6e-5/(1.6e-5& -&+10.**(-TPK%PHC)))/TPK%MOL2MOLECCLOUD::WC_O3+WC_HO2-->WC_OH' - CFULLREACS(222) = 'KC7=(2.7E+9*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-T& -&PK%PHC)/(1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./& -&298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)+(10.**(-TPK%PH& -&C))**2.))/TPK%MOL2MOLECCLOUD::WC_OH+WC_SO2-->WC_ASO3' - CFULLREACS(223) = 'KC8=(1.0E+10*10.**(-TPK%PHC)/(1.6e-3*exp(-1760.*(1./TPK%T-1& -&./298.15))+10.**(-TPK%PHC)))/TPK%MOL2MOLECCLOUD::WC_HONO+WC_OH-->WC_NO2' - CFULLREACS(224) = 'KC9=((1.8E+9*10.**(-TPK%PHC)+4.5E+9*1.6e-5)/(1.6e-5+10.**(-& -&TPK%PHC)))/TPK%MOL2MOLECCLOUD::WC_NO2+WC_HO2-->WC_HNO4' - CFULLREACS(225) = 'KC10=2.6E-2*10.**(-TPK%PHC)/(1.26e-6+10.**(-TPK%PHC))::WC_H& -&NO4-->WC_HO2+WC_NO2' - CFULLREACS(226) = 'KC11=1.1E0*1.26e-6/(1.26e-6+10.**(-TPK%PHC))::WC_HNO4-->WC_& -&HONO' - CFULLREACS(227) = 'KC12=(3.3E+5*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*(10.**(& -&-TPK%PHC))**2./((1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./T& -&PK%T-1./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)+(10.**& -&(-TPK%PHC))**2.)*(1.26e-6+10.**(-TPK%PHC))))/TPK%MOL2MOLECCLOUD::WC_HNO4+WC_SO& -&2-->WC_SULF+WC_HNO3' - CFULLREACS(228) = 'KC13=!ZRATES(:,019)*2.2e+1/(2.2e+1+10.**(-TPK%PHC))::WC_HNO& -&3-->WC_NO2+WC_OH' - CFULLREACS(229) = 'KC14=1.0E+10::WC_N2O5-->WC_HNO3+WC_HNO3' - CFULLREACS(230) = 'KC15=(1.0E+5*1.0e+3*1.0e-2/(1.0e+3*1.0e-2+1.0e+3*10.**(-TPK& -&%PHC)+(10.**(-TPK%PHC))**2.))/TPK%MOL2MOLECCLOUD::WC_NO3+WC_SULF-->WC_HNO3+WC_& -&ASO4' - CFULLREACS(231) = 'KC16=(1.3E+9*exp(-2200.*(1./TPK%T-1./298.15))*1.3e-2*exp(19& -&65.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)/(1.3e-2*exp(1965.*(1./TPK%T-1./298.1& -&5))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.1& -&5))*10.**(-TPK%PHC)+(10.**(-TPK%PHC))**2.))/TPK%MOL2MOLECCLOUD::WC_NO3+WC_SO2-& -&->WC_HNO3+WC_ASO3' - CFULLREACS(232) = 'KC17=(1.7E+8*exp(-2200.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLE& -&CCLOUD::WC_MO2+WC_MO2-->2.00*WC_HCHO+2.00*WC_HO2' - CFULLREACS(233) = 'KC18=(5.0E+5*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-& -&TPK%PHC)/(1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1.& -&/298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)+(10.**(-TPK%P& -&HC))**2.))/TPK%MOL2MOLECCLOUD::WC_MO2+WC_SO2-->WC_OP1+WC_ASO3' - CFULLREACS(234) = 'KC19=(7.8E+8*exp(-1000.*(1./TPK%T-1./298.15))*2.5e3*exp(403& -&0.*(1./TPK%T-1./298.15))/(1.+2.5e3*exp(4030.*(1./TPK%T-1./298.15))))/TPK%MOL2M& -&OLECCLOUD::WC_HCHO+WC_OH-->WC_ORA1+WC_HO2' - CFULLREACS(235) = 'KC20=((1.0E+8*exp(-1000.*(1./TPK%T-1./298.15))*10.**(-TPK%P& -&HC)+3.4E+9*exp(-1200.*(1./TPK%T-1./298.15))*1.8e-4*exp(150.*(1./TPK%T-1./298.1& -&5)))/(1.8e-4*exp(150.*(1./TPK%T-1./298.15))+10.**(-TPK%PHC)))/TPK%MOL2MOLECCLO& -&UD::WC_ORA1+WC_OH-->WC_CO2+WC_HO2' - CFULLREACS(236) = 'KC21=((7.9E+2*exp(-2900.*(1./TPK%T-1./298.15))*1.3e-2*exp(1& -&965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)+2.5E+7*exp(-2450.*(1./TPK%T-1./298.& -&15))*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.& -&15)))/((1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./2& -&98.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)+(10.**(-TPK%PHC& -&))**2.)*(1.+2.5e3*exp(4030.*(1./TPK%T-1./298.15)))))/TPK%MOL2MOLECCLOUD::WC_SO& -&2+WC_HCHO-->WC_AHMS' - CFULLREACS(237) = 'KC22=7.7E-3*exp(-9200.*(1./TPK%T-1./298.15))+3.7E+3*1.e-14*& -&EXP(-6716*(1./TPK%T-1./298.15))/10.**(-TPK%PHC)::WC_AHMS-->WC_SO2+WC_HCHO' - CFULLREACS(238) = 'KC23=3.0E+8/TPK%MOL2MOLECCLOUD::WC_AHMS+WC_OH-->WC_HO2+WC_O& -&RA1+WC_SO2' - CFULLREACS(239) = 'KC24=1.1E+9::WC_ASO3+W_O2-->WC_ASO5' - CFULLREACS(240) = 'KC25=(1.7E+9*10.**(-TPK%PHC)/(1.6e-5+10.**(-TPK%PHC)))/TPK%& -&MOL2MOLECCLOUD::WC_ASO5+WC_HO2-->WC_AHSO5' - CFULLREACS(241) = 'KC26=(2.2E+8*exp(-2600.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLE& -&CCLOUD::WC_ASO5+WC_ASO5-->WC_ASO4+WC_ASO4' - CFULLREACS(242) = 'KC27=(7.1E+6*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-& -&TPK%PHC)*10.**(-TPK%PHC)/(1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(14& -&30.*(1./TPK%T-1./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PH& -&C)+(10.**(-TPK%PHC))**2.))/TPK%MOL2MOLECCLOUD::WC_AHSO5+WC_SO2-->2.00*WC_SULF' - CFULLREACS(243) = 'KC28=4.6E+2*exp(-1100.*(1./TPK%T-1./298.15))::WC_ASO4-->WC_& -&SULF+WC_OH' - CFULLREACS(244) = 'KC29=((3.7E+5*exp(-5500.*(1./TPK%T-1./298.15))*1.3e-2*exp(1& -&965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)+1.5E+9*exp(-5300.*(1./TPK%T-1./298.& -&15))*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.& -&15)))/(1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./29& -&8.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)+(10.**(-TPK%PHC)& -&)**2.))/TPK%MOL2MOLECCLOUD::WC_SO2+WC_O3-->WC_SULF' - CFULLREACS(245) = 'KC30=(9.1E+7*exp(-3600.*(1./TPK%T-1./298.15))*1.3e-2*exp(19& -&65.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)*10.**(-TPK%PHC)/(1.3e-2*exp(1965.*(1& -&./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-2*exp(1965.*(1& -&./TPK%T-1./298.15))*10.**(-TPK%PHC)+(10.**(-TPK%PHC))**2.))/TPK%MOL2MOLECCLOUD& -&::WC_SO2+WC_H2O2-->WC_SULF' - CFULLREACS(246) = 'KR1=!ZRATES(:,018)::WR_H2O2-->WR_OH+WR_OH' - CFULLREACS(247) = 'KR2=(3.6E+9*exp(-930.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLECR& -&AIN::WR_OH+WR_OH-->WR_H2O2' - CFULLREACS(248) = 'KR3=((2.8E+10*10.**(-TPK%PHR)+3.5E+10*exp(-720.*(1./TPK%T-1& -&./298.15))*1.6e-5)/(1.6e-5+10.**(-TPK%PHR)))/TPK%MOL2MOLECRAIN::WR_OH+WR_HO2--& -&>' - CFULLREACS(249) = 'KR4=(3.2E+7*exp(-1700.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLEC& -&RAIN::WR_H2O2+WR_OH-->WR_HO2' - CFULLREACS(250) = 'KR5=((8.3E+5*exp(-2700.*(1./TPK%T-1./298.15))*(10.**(-TPK%P& -&HR))**2.+9.6E+7*exp(-910.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)*1.6e-5)/(1.6e-& -&5+10.**(-TPK%PHR))**2.)/TPK%MOL2MOLECRAIN::WR_HO2+WR_HO2-->WR_H2O2' - CFULLREACS(251) = 'KR6=(1.5E+9*exp(-1500.*(1./TPK%T-1./298.15))*1.6e-5/(1.6e-5& -&+10.**(-TPK%PHR)))/TPK%MOL2MOLECRAIN::WR_O3+WR_HO2-->WR_OH' - CFULLREACS(252) = 'KR7=(2.7E+9*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-T& -&PK%PHR)/(1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./& -&298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)+(10.**(-TPK%PH& -&R))**2.))/TPK%MOL2MOLECRAIN::WR_OH+WR_SO2-->WR_ASO3' - CFULLREACS(253) = 'KR8=(1.0E+10*10.**(-TPK%PHR)/(1.6e-3*exp(-1760.*(1./TPK%T-1& -&./298.15))+10.**(-TPK%PHR)))/TPK%MOL2MOLECRAIN::WR_HONO+WR_OH-->WR_NO2' - CFULLREACS(254) = 'KR9=((1.8E+9*10.**(-TPK%PHR)+4.5E+9*1.6e-5)/(1.6e-5+10.**(-& -&TPK%PHR)))/TPK%MOL2MOLECRAIN::WR_NO2+WR_HO2-->WR_HNO4' - CFULLREACS(255) = 'KR10=2.6E-2*10.**(-TPK%PHR)/(1.26e-6+10.**(-TPK%PHR))::WR_H& -&NO4-->WR_HO2+WR_NO2' - CFULLREACS(256) = 'KR11=1.1E0*1.26e-6/(1.26e-6+10.**(-TPK%PHR))::WR_HNO4-->WR_& -&HONO' - CFULLREACS(257) = 'KR12=(3.3E+5*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*(10.**(& -&-TPK%PHR))**2./((1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./T& -&PK%T-1./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)+(10.**& -&(-TPK%PHR))**2.)*(1.26e-6+10.**(-TPK%PHR))))/TPK%MOL2MOLECRAIN::WR_HNO4+WR_SO2& -&-->WR_SULF+WR_HNO3' - CFULLREACS(258) = 'KR13=!ZRATES(:,019)*2.2e+1/(2.2e+1+10.**(-TPK%PHR))::WR_HNO& -&3-->WR_NO2+WR_OH' - CFULLREACS(259) = 'KR14=1.0E+10::WR_N2O5-->WR_HNO3+WR_HNO3' - CFULLREACS(260) = 'KR15=(1.0E+5*1.0e+3*1.0e-2/(1.0e+3*1.0e-2+1.0e+3*10.**(-TPK& -&%PHR)+(10.**(-TPK%PHR))**2.))/TPK%MOL2MOLECRAIN::WR_NO3+WR_SULF-->WR_HNO3+WR_A& -&SO4' - CFULLREACS(261) = 'KR16=(1.3E+9*exp(-2200.*(1./TPK%T-1./298.15))*1.3e-2*exp(19& -&65.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)/(1.3e-2*exp(1965.*(1./TPK%T-1./298.1& -&5))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.1& -&5))*10.**(-TPK%PHR)+(10.**(-TPK%PHR))**2.))/TPK%MOL2MOLECRAIN::WR_NO3+WR_SO2--& -&>WR_HNO3+WR_ASO3' - CFULLREACS(262) = 'KR17=(1.7E+8*exp(-2200.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLE& -&CRAIN::WR_MO2+WR_MO2-->2.00*WR_HCHO+2.00*WR_HO2' - CFULLREACS(263) = 'KR18=(5.0E+5*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-& -&TPK%PHR)/(1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1.& -&/298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)+(10.**(-TPK%P& -&HR))**2.))/TPK%MOL2MOLECRAIN::WR_MO2+WR_SO2-->WR_OP1+WR_ASO3' - CFULLREACS(264) = 'KR19=(7.8E+8*exp(-1000.*(1./TPK%T-1./298.15))*2.5e3*exp(403& -&0.*(1./TPK%T-1./298.15))/(1.+2.5e3*exp(4030.*(1./TPK%T-1./298.15))))/TPK%MOL2M& -&OLECRAIN::WR_HCHO+WR_OH-->WR_ORA1+WR_HO2' - CFULLREACS(265) = 'KR20=((1.0E+8*exp(-1000.*(1./TPK%T-1./298.15))*10.**(-TPK%P& -&HR)+3.4E+9*exp(-1200.*(1./TPK%T-1./298.15))*1.8e-4*exp(150.*(1./TPK%T-1./298.1& -&5)))/(1.8e-4*exp(150.*(1./TPK%T-1./298.15))+10.**(-TPK%PHR)))/TPK%MOL2MOLECRAI& -&N::WR_ORA1+WR_OH-->WR_CO2+WR_HO2' - CFULLREACS(266) = 'KR21=((7.9E+2*exp(-2900.*(1./TPK%T-1./298.15))*1.3e-2*exp(1& -&965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)+2.5E+7*exp(-2450.*(1./TPK%T-1./298.& -&15))*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.& -&15)))/((1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./2& -&98.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)+(10.**(-TPK%PHR& -&))**2.)*(1.+2.5e3*exp(4030.*(1./TPK%T-1./298.15)))))/TPK%MOL2MOLECRAIN::WR_SO2& -&+WR_HCHO-->WR_AHMS' - CFULLREACS(267) = 'KR22=7.7E-3*exp(-9200.*(1./TPK%T-1./298.15))+3.7E+3*1.e-14*& -&EXP(-6716*(1./TPK%T-1./298.15))/10.**(-TPK%PHR)::WR_AHMS-->WR_SO2+WR_HCHO' - CFULLREACS(268) = 'KR23=3.0E+8/TPK%MOL2MOLECRAIN::WR_AHMS+WR_OH-->WR_HO2+WR_OR& -&A1+WR_SO2' - CFULLREACS(269) = 'KR24=1.1E+9::WR_ASO3+W_O2-->WR_ASO5' - CFULLREACS(270) = 'KR25=(1.7E+9*10.**(-TPK%PHR)/(1.6e-5+10.**(-TPK%PHR)))/TPK%& -&MOL2MOLECRAIN::WR_ASO5+WR_HO2-->WR_AHSO5' - CFULLREACS(271) = 'KR26=(2.2E+8*exp(-2600.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLE& -&CRAIN::WR_ASO5+WR_ASO5-->WR_ASO4+WR_ASO4' - CFULLREACS(272) = 'KR27=(7.1E+6*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-& -&TPK%PHR)*10.**(-TPK%PHR)/(1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(14& -&30.*(1./TPK%T-1./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PH& -&R)+(10.**(-TPK%PHR))**2.))/TPK%MOL2MOLECRAIN::WR_AHSO5+WR_SO2-->2.00*WR_SULF' - CFULLREACS(273) = 'KR28=4.6E+2*exp(-1100.*(1./TPK%T-1./298.15))::WR_ASO4-->WR_& -&SULF+WR_OH' - CFULLREACS(274) = 'KR29=((3.7E+5*exp(-5500.*(1./TPK%T-1./298.15))*1.3e-2*exp(1& -&965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)+1.5E+9*exp(-5300.*(1./TPK%T-1./298.& -&15))*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.& -&15)))/(1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./29& -&8.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)+(10.**(-TPK%PHR)& -&)**2.))/TPK%MOL2MOLECRAIN::WR_SO2+WR_O3-->WR_SULF' - CFULLREACS(275) = 'KR30=(9.1E+7*exp(-3600.*(1./TPK%T-1./298.15))*1.3e-2*exp(19& -&65.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)*10.**(-TPK%PHR)/(1.3e-2*exp(1965.*(1& -&./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-2*exp(1965.*(1& -&./TPK%T-1./298.15))*10.**(-TPK%PHR)+(10.**(-TPK%PHR))**2.))/TPK%MOL2MOLECRAIN:& -&:WR_SO2+WR_H2O2-->WR_SULF' -END IF -IF (KVERB >= 5) THEN -! print information to KOUT - WRITE(KOUT,*) 'CH_INIT_CCS: prognostic variables for model ',KMI - DO JII = 1, TACCS(KMI)%NEQ - WRITE(KOUT,'(I4,2A)') JII, '. ', TRIM(CNAMES(JII)) - END DO - WRITE(KOUT,*) 'CH_INIT_CCS: implemented reactions for model ',KMI - DO JII = 1, TACCS(KMI)%NREAC - WRITE(KOUT,'(I4,2A)') JII, '. ', TRIM(CFULLREACS(JII)) - END DO -END IF -RETURN -END SUBROUTINE CH_INIT_CCS -! -!======================================================================== -! -!! ########################## - MODULE MODI_CH_GET_CNAMES -!! ########################## -!! This code has been created automatically by preprocessor m10, -!! version: 9.7, copyright 1995-1999 by Meteo France/Universite Paul Sabatier. -!! Please report all bugs to K. Suhre (Lab. d'Aerologie UPS/CNRS). -INTERFACE -SUBROUTINE CH_GET_CNAMES(HNAMES) -IMPLICIT NONE -CHARACTER(LEN=32), DIMENSION(:), INTENT(OUT) :: HNAMES -END SUBROUTINE CH_GET_CNAMES -END INTERFACE -END MODULE MODI_CH_GET_CNAMES -! -!======================================================================== -! -!! ################################# - SUBROUTINE CH_GET_CNAMES(HNAMES) -!! ################################# -!! This code has been created automatically by preprocessor m10, -!! version: 9.7, copyright 1995-1999 by Meteo France/Universite Paul Sabatier. -!! Please report all bugs to K. Suhre (Lab. d'Aerologie UPS/CNRS). -!! -!!*** *CH_GET_CNAMES* -!! -!! PURPOSE -!! ------- -! return the names for the chemical species in HNAMES -!! -!!** METHOD -!! ------ -!! simple -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Karsten Suhre (LA) -!! -!! MODIFICATIONS -!! ------------- -!! Original 26/07/96 -!! Modified 05/05/98: Vectorization (Vincent Crassier & KS) -!! Modified 31/10/03: New interface for better MesoNH compilation (D. Gazen) -!! -!!---------------------------------------------------------------------- -!! -!! EXTERNAL -!! -------- -!! none -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -USE MODD_CH_M9_SCHEME -!! -!! EXPLICIT ARGUMENTS -!! ------------------ -IMPLICIT NONE -!! -!! LOCAL VARIABLES -!! --------------- -CHARACTER(LEN=32), DIMENSION(:), INTENT(OUT) :: HNAMES -INTEGER :: ISIZE -!! -!!---------------------------------------------------------------------- -!! -! copy the names of the chemical species into HNAMES -ISIZE = SIZE(HNAMES) -HNAMES = CNAMES(1:ISIZE) -RETURN -END SUBROUTINE CH_GET_CNAMES -! -!======================================================================== -! -!! ####################### - MODULE MODI_CH_PRODLOSS -!! ####################### -INTERFACE -SUBROUTINE CH_PRODLOSS(PTIME,PCONC,PPROD,PLOSS,KMI,KVECNPT,KEQ) -IMPLICIT NONE -REAL, INTENT(IN) :: PTIME -INTEGER, INTENT(IN) :: KVECNPT -INTEGER, INTENT(IN) :: KEQ -REAL, INTENT(IN), DIMENSION(KVECNPT,KEQ) :: PCONC -REAL, INTENT(OUT), DIMENSION(KVECNPT,KEQ) :: PPROD, PLOSS -INTEGER, INTENT(IN) :: KMI -END SUBROUTINE CH_PRODLOSS -END INTERFACE -END MODULE MODI_CH_PRODLOSS -! -!======================================================================== -! -!! ################################################### - SUBROUTINE CH_PRODLOSS(PTIME,PCONC,PPROD,PLOSS,KMI,KVECNPT,KEQ) -!! ################################################### -!! This code has been created automatically by preprocessor m10, -!! version: 9.7, copyright 1995-1999 by Meteo France/Universite Paul Sabatier. -!! Please report all bugs to K. Suhre (Lab. d'Aerologie UPS/CNRS). -!! -!!*** *MODD_CH_PRODLOSS* -!! -!! PURPOSE -!! ------- -! calculation of production and loss terms for diagnostics -!! -!!** METHOD -!! ------ -!! The terms of temporal derivative of the chemical species, -!! written as: -!! d/dt PCONC = CH_FCN = PPROD - PCONC*PLOSS, -!! are calculated for diagnostic purposes. -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Karsten Suhre (LA) -!! -!! MODIFICATIONS -!! ------------- -!! Original 26/07/96 -!! Modified 05/05/98: Vectorization (Vincent Crassier & KS) -!! Modified 31/10/03: New interface for better MesoNH compilation (D. Gazen) -!! -!!---------------------------------------------------------------------- -!! -!! EXTERNAL -!! -------- -!! none -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -USE MODD_CH_M9_SCHEME -USE MODI_CH_PRODLOSS_AQ -USE MODI_CH_PRODLOSS_GAZ -!! -!! EXPLICIT ARGUMENTS -!! ------------------ -IMPLICIT NONE -REAL, INTENT(IN) :: PTIME -INTEGER, INTENT(IN) :: KVECNPT -INTEGER, INTENT(IN) :: KEQ -REAL, INTENT(IN), DIMENSION(KVECNPT,KEQ) :: PCONC -REAL, INTENT(OUT), DIMENSION(KVECNPT,KEQ) :: PPROD, PLOSS -INTEGER, INTENT(IN) :: KMI -TYPE(CCSTYPE), POINTER :: TPK -TPK=>TACCS(KMI) -IF (TPK%LUSECHAQ) THEN - CALL CH_PRODLOSS_AQ(PTIME,PCONC,PPROD,PLOSS,KMI,KVECNPT,KEQ) -ELSE - CALL CH_PRODLOSS_GAZ(PTIME,PCONC,PPROD,PLOSS,KMI,KVECNPT,KEQ) -END IF -END SUBROUTINE CH_PRODLOSS -! -!======================================================================== -! -!! ########################## - MODULE MODI_CH_PRODLOSS_AQ -!! ########################## -INTERFACE -SUBROUTINE CH_PRODLOSS_AQ(PTIME,PCONC,PPROD,PLOSS,KMI,KVECNPT,KEQ) -IMPLICIT NONE -REAL, INTENT(IN) :: PTIME -INTEGER, INTENT(IN) :: KVECNPT -INTEGER, INTENT(IN) :: KEQ -REAL, INTENT(IN), DIMENSION(KVECNPT,KEQ) :: PCONC -REAL, INTENT(OUT), DIMENSION(KVECNPT,KEQ) :: PPROD, PLOSS -INTEGER, INTENT(IN) :: KMI -END SUBROUTINE CH_PRODLOSS_AQ -END INTERFACE -END MODULE MODI_CH_PRODLOSS_AQ -! -!======================================================================== -! -!! ################################################################## - SUBROUTINE CH_PRODLOSS_AQ(PTIME,PCONC,PPROD,PLOSS,KMI,KVECNPT,KEQ) -!! ################################################################## -!! This code has been created automatically by preprocessor m10, -!! version: 9.7, copyright 1995-1999 by Meteo France/Universite Paul Sabatier. -!! Please report all bugs to K. Suhre (Lab. d'Aerologie UPS/CNRS). -!! -!!*** *MODD_CH_PRODLOSS* -!! -!! PURPOSE -!! ------- -! calculation of production and loss terms for diagnostics -!! -!!** METHOD -!! ------ -!! The terms of temporal derivative of the chemical species, -!! written as: -!! d/dt PCONC = CH_FCN = PPROD - PCONC*PLOSS, -!! are calculated for diagnostic purposes. -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Karsten Suhre (LA) -!! -!! MODIFICATIONS -!! ------------- -!! Original 26/07/96 -!! Modified 05/05/98: Vectorization (Vincent Crassier & KS) -!! Modified 31/10/03: New interface for better MesoNH compilation (D. Gazen) -!! -!!---------------------------------------------------------------------- -!! -!! EXTERNAL -!! -------- -!! none -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -USE MODD_CH_M9_SCHEME -!! -!! EXPLICIT ARGUMENTS -!! ------------------ -IMPLICIT NONE -REAL, INTENT(IN) :: PTIME -INTEGER, INTENT(IN) :: KVECNPT -INTEGER, INTENT(IN) :: KEQ -REAL, INTENT(IN), DIMENSION(KVECNPT,KEQ) :: PCONC -REAL, INTENT(OUT), DIMENSION(KVECNPT,KEQ) :: PPROD, PLOSS -INTEGER, INTENT(IN) :: KMI -TYPE(CCSTYPE), POINTER :: TPK -TPK=>TACCS(KMI) -! /BEGIN_CODE/ -TPK%O1D(:)=(TPK%K002(:)*PCONC(:,JP_O3))/(TPK%K020(:)*TPK%N2(:)+TPK%K021(:)*TPK%O2(:)+& - &TPK%K022(:)*TPK%H2O(:)) -TPK%O3P(:)=(TPK%K001(:)*PCONC(:,JP_NO2)+TPK%K003(:)*PCONC(:,JP_O3)+TPK%K008(:)*PCONC(:,JP_NO3)+& - &TPK%K020(:)*TPK%O1D(:)*TPK%N2(:)+TPK%K021(:)*TPK%O1D(:)*TPK%O2(:)+& - &0.00000*TPK%K079(:)*PCONC(:,JP_ALKE)*PCONC(:,JP_O3)+& - &0.09000*TPK%K080(:)*PCONC(:,JP_BIO)*PCONC(:,JP_O3))/& - &(TPK%K018(:)*TPK%O2(:)+TPK%K019(:)*PCONC(:,JP_O3)+TPK%K029(:)*PCONC(:,JP_NO)+& - &TPK%K030(:)*PCONC(:,JP_NO2)+TPK%K031(:)*PCONC(:,JP_NO2)+TPK%K054(:)*PCONC(:,JP_BIO)+& - &TPK%K055(:)*PCONC(:,JP_CARBO)+TPK%K134(:)*PCONC(:,JP_DMS)) -! /END_CODE/ -CALL SUB0 -CALL SUB1 -CALL SUB2 -CALL SUB3 -CALL SUB4 -CALL SUB5 -CALL SUB6 -CALL SUB7 -CALL SUB8 -CALL SUB9 - -CONTAINS - -SUBROUTINE SUB0 -! -!Indices 1 a 10 -! -! -!PPROD(O3) = +K018*<O3P>*<O2>+0.17307*K0102*<CARBOP>*<HO2>+KTC21*<WC_O3>+KTR21* -!<WR_O3> - PPROD(:,1) = +TPK%K018(:)*TPK%O3P(:)*TPK%O2(:)+0.17307*TPK%K0102(:)*PCONC(:,40& -&)*PCONC(:,16)+TPK%KTC21(:)*PCONC(:,43)+TPK%KTR21(:)*PCONC(:,68) -!PLOSS(O3) = +K002+K003+K019*<O3P>+K023*<OH>+K024*<HO2>+K042*<NO>+K043*<NO2>+K0 -!79*<ALKE>+K080*<BIO>+K081*<CARBO>+K082*<PAN>+K087*<ADD>+KTC1+KTR1 - PLOSS(:,1) = +TPK%K002(:)+TPK%K003(:)+TPK%K019(:)*TPK%O3P(:)+TPK%K023(:)*PCONC& -&(:,15)+TPK%K024(:)*PCONC(:,16)+TPK%K042(:)*PCONC(:,3)+TPK%K043(:)*PCONC(:,4)+T& -&PK%K079(:)*PCONC(:,20)+TPK%K080(:)*PCONC(:,21)+TPK%K081(:)*PCONC(:,26)+TPK%K08& -&2(:)*PCONC(:,28)+TPK%K087(:)*PCONC(:,38)+TPK%KTC1(:)+TPK%KTR1(:) -! -!PPROD(H2O2) = +K027*<HO2>*<HO2>+K028*<HO2>*<HO2>*<H2O>+0.01833*K079*<ALKE>*<O3 -!>+0.00100*K080*<BIO>*<O3>+KTC22*<WC_H2O2>+KTR22*<WR_H2O2> - PPROD(:,2) = +TPK%K027(:)*PCONC(:,16)*PCONC(:,16)+TPK%K028(:)*PCONC(:,16)*PCON& -&C(:,16)*TPK%H2O(:)+0.01833*TPK%K079(:)*PCONC(:,20)*PCONC(:,1)+0.00100*TPK%K080& -&(:)*PCONC(:,21)*PCONC(:,1)+TPK%KTC22(:)*PCONC(:,44)+TPK%KTR22(:)*PCONC(:,69) -!PLOSS(H2O2) = +K009+K026*<OH>+KTC2+KTR2 - PLOSS(:,2) = +TPK%K009(:)+TPK%K026(:)*PCONC(:,15)+TPK%KTC2(:)+TPK%KTR2(:) -! -!PPROD(NO) = +K001*<NO2>+K004*<HONO>+K007*<NO3>+K030*<O3P>*<NO2>+K046*<NO3>*<NO -!2>+KTC23*<WC_NO>+KTR23*<WR_NO> - PPROD(:,3) = +TPK%K001(:)*PCONC(:,4)+TPK%K004(:)*PCONC(:,7)+TPK%K007(:)*PCONC(& -&:,5)+TPK%K030(:)*TPK%O3P(:)*PCONC(:,4)+TPK%K046(:)*PCONC(:,5)*PCONC(:,4)+TPK%K& -&TC23(:)*PCONC(:,45)+TPK%KTR23(:)*PCONC(:,70) -!PLOSS(NO) = +K029*<O3P>+K032*<OH>+K035*<HO2>+K042*<O3>+K044*<NO>*<O2>+K044*<NO -!>*<O2>+K045*<NO3>+K090*<MO2>+K091*<ALKAP>+K092*<ALKEP>+K093*<BIOP>+K094*<AROP> -!+K095*<CARBOP>+K096*<OLN>+K130*<XO2>+KTC3+KTR3 - PLOSS(:,3) = +TPK%K029(:)*TPK%O3P(:)+TPK%K032(:)*PCONC(:,15)+TPK%K035(:)*PCONC& -&(:,16)+TPK%K042(:)*PCONC(:,1)+TPK%K044(:)*PCONC(:,3)*TPK%O2(:)+TPK%K044(:)*PCO& -&NC(:,3)*TPK%O2(:)+TPK%K045(:)*PCONC(:,5)+TPK%K090(:)*PCONC(:,33)+TPK%K091(:)*P& -&CONC(:,34)+TPK%K092(:)*PCONC(:,35)+TPK%K093(:)*PCONC(:,36)+TPK%K094(:)*PCONC(:& -&,39)+TPK%K095(:)*PCONC(:,40)+TPK%K096(:)*PCONC(:,41)+TPK%K130(:)*PCONC(:,42)+T& -&PK%KTC3(:)+TPK%KTR3(:) -! -!PPROD(NO2) = +K005*<HNO3>+0.65*K006*<HNO4>+K008*<NO3>+K017*<ONIT>+K029*<O3P>*< -!NO>+K034*<OH>*<NO3>+K035*<HO2>*<NO>+K037*<HNO4>+0.7*K038*<HO2>*<NO3>+K039*<OH> -!*<HONO>+K041*<OH>*<HNO4>+K042*<O3>*<NO>+K044*<NO>*<NO>*<O2>+K044*<NO>*<NO>*<O2 -!>+K045*<NO3>*<NO>+K045*<NO3>*<NO>+K046*<NO3>*<NO2>+K048*<N2O5>+K049*<NO3>*<NO3 -!>+K049*<NO3>*<NO3>+K071*<ONIT>*<OH>+0.10530*K074*<CARBO>*<NO3>+0.40*K078*<PAN> -!*<NO3>+0.70*K082*<PAN>*<O3>+K089*<PAN>+K090*<MO2>*<NO>+0.91541*K091*<ALKAP>*<N -!O>+K092*<ALKEP>*<NO>+0.84700*K093*<BIOP>*<NO>+0.95115*K094*<AROP>*<NO>+K095*<C -!ARBOP>*<NO>+1.81599*K096*<OLN>*<NO>+0.32440*K110*<OLN>*<MO2>+0.00000*K116*<OLN -!>*<CARBOP>+0.00000*K118*<OLN>*<OLN>+K119*<MO2>*<NO3>+K120*<ALKAP>*<NO3>+K121*< -!ALKEP>*<NO3>+K122*<BIOP>*<NO3>+K123*<AROP>*<NO3>+K124*<CARBOP>*<NO3>+1.74072*K -!125*<OLN>*<NO3>+K130*<XO2>*<NO>+K131*<XO2>*<NO3>+K133*<DMS>*<NO3>+KTC24*<WC_NO -!2>+KTR24*<WR_NO2> - PPROD(:,4) = +TPK%K005(:)*PCONC(:,8)+0.65*TPK%K006(:)*PCONC(:,9)+TPK%K008(:)*P& -&CONC(:,5)+TPK%K017(:)*PCONC(:,27)+TPK%K029(:)*TPK%O3P(:)*PCONC(:,3)+TPK%K034(:& -&)*PCONC(:,15)*PCONC(:,5)+TPK%K035(:)*PCONC(:,16)*PCONC(:,3)+TPK%K037(:)*PCONC(& -&:,9)+0.7*TPK%K038(:)*PCONC(:,16)*PCONC(:,5)+TPK%K039(:)*PCONC(:,15)*PCONC(:,7)& -&+TPK%K041(:)*PCONC(:,15)*PCONC(:,9)+TPK%K042(:)*PCONC(:,1)*PCONC(:,3)+TPK%K044& -&(:)*PCONC(:,3)*PCONC(:,3)*TPK%O2(:)+TPK%K044(:)*PCONC(:,3)*PCONC(:,3)*TPK%O2(:& -&)+TPK%K045(:)*PCONC(:,5)*PCONC(:,3)+TPK%K045(:)*PCONC(:,5)*PCONC(:,3)+TPK%K046& -&(:)*PCONC(:,5)*PCONC(:,4)+TPK%K048(:)*PCONC(:,6)+TPK%K049(:)*PCONC(:,5)*PCONC(& -&:,5)+TPK%K049(:)*PCONC(:,5)*PCONC(:,5)+TPK%K071(:)*PCONC(:,27)*PCONC(:,15)+0.1& -&0530*TPK%K074(:)*PCONC(:,26)*PCONC(:,5)+0.40*TPK%K078(:)*PCONC(:,28)*PCONC(:,5& -&)+0.70*TPK%K082(:)*PCONC(:,28)*PCONC(:,1)+TPK%K089(:)*PCONC(:,28)+TPK%K090(:)*& -&PCONC(:,33)*PCONC(:,3)+0.91541*TPK%K091(:)*PCONC(:,34)*PCONC(:,3)+TPK%K092(:)*& -&PCONC(:,35)*PCONC(:,3)+0.84700*TPK%K093(:)*PCONC(:,36)*PCONC(:,3)+0.95115*TPK%& -&K094(:)*PCONC(:,39)*PCONC(:,3)+TPK%K095(:)*PCONC(:,40)*PCONC(:,3)+1.81599*TPK%& -&K096(:)*PCONC(:,41)*PCONC(:,3)+0.32440*TPK%K110(:)*PCONC(:,41)*PCONC(:,33)+0.0& -&0000*TPK%K116(:)*PCONC(:,41)*PCONC(:,40)+0.00000*TPK%K118(:)*PCONC(:,41)*PCONC& -&(:,41)+TPK%K119(:)*PCONC(:,33)*PCONC(:,5)+TPK%K120(:)*PCONC(:,34)*PCONC(:,5)+T& -&PK%K121(:)*PCONC(:,35)*PCONC(:,5)+TPK%K122(:)*PCONC(:,36)*PCONC(:,5)+TPK%K123(& -&:)*PCONC(:,39)*PCONC(:,5)+TPK%K124(:)*PCONC(:,40)*PCONC(:,5)+1.74072*TPK%K125(& -&:)*PCONC(:,41)*PCONC(:,5)+TPK%K130(:)*PCONC(:,42)*PCONC(:,3)+TPK%K131(:)*PCONC& -&(:,42)*PCONC(:,5)+TPK%K133(:)*PCONC(:,11)*PCONC(:,5)+TPK%KTC24(:)*PCONC(:,46)+& -&TPK%KTR24(:)*PCONC(:,71) -!PLOSS(NO2) = +K001+K030*<O3P>+K031*<O3P>+K033*<OH>+K036*<HO2>+K043*<O3>+K046*< -!NO3>+K047*<NO3>+K083*<PHO>+K085*<ADD>+K088*<CARBOP>+KTC4+KTR4 - PLOSS(:,4) = +TPK%K001(:)+TPK%K030(:)*TPK%O3P(:)+TPK%K031(:)*TPK%O3P(:)+TPK%K0& -&33(:)*PCONC(:,15)+TPK%K036(:)*PCONC(:,16)+TPK%K043(:)*PCONC(:,1)+TPK%K046(:)*P& -&CONC(:,5)+TPK%K047(:)*PCONC(:,5)+TPK%K083(:)*PCONC(:,37)+TPK%K085(:)*PCONC(:,3& -&8)+TPK%K088(:)*PCONC(:,40)+TPK%KTC4(:)+TPK%KTR4(:) -! -!PPROD(NO3) = +0.35*K006*<HNO4>+K031*<O3P>*<NO2>+K040*<OH>*<HNO3>+K043*<O3>*<NO -!2>+K048*<N2O5>+0.71893*K070*<PAN>*<OH>+0.60*K078*<PAN>*<NO3>+KTC25*<WC_NO3>+KT -!R25*<WR_NO3> - PPROD(:,5) = +0.35*TPK%K006(:)*PCONC(:,9)+TPK%K031(:)*TPK%O3P(:)*PCONC(:,4)+TP& -&K%K040(:)*PCONC(:,15)*PCONC(:,8)+TPK%K043(:)*PCONC(:,1)*PCONC(:,4)+TPK%K048(:)& -&*PCONC(:,6)+0.71893*TPK%K070(:)*PCONC(:,28)*PCONC(:,15)+0.60*TPK%K078(:)*PCONC& -&(:,28)*PCONC(:,5)+TPK%KTC25(:)*PCONC(:,47)+TPK%KTR25(:)*PCONC(:,72) -!PLOSS(NO3) = +K007+K008+K034*<OH>+K038*<HO2>+K045*<NO>+K046*<NO2>+K047*<NO2>+K -!049*<NO3>+K049*<NO3>+K072*<HCHO>+K073*<ALD>+K074*<CARBO>+K075*<ARO>+K076*<ALKE -!>+K077*<BIO>+K078*<PAN>+K119*<MO2>+K120*<ALKAP>+K121*<ALKEP>+K122*<BIOP>+K123* -!<AROP>+K124*<CARBOP>+K125*<OLN>+K131*<XO2>+K133*<DMS>+KTC5+KTR5 - PLOSS(:,5) = +TPK%K007(:)+TPK%K008(:)+TPK%K034(:)*PCONC(:,15)+TPK%K038(:)*PCON& -&C(:,16)+TPK%K045(:)*PCONC(:,3)+TPK%K046(:)*PCONC(:,4)+TPK%K047(:)*PCONC(:,4)+T& -&PK%K049(:)*PCONC(:,5)+TPK%K049(:)*PCONC(:,5)+TPK%K072(:)*PCONC(:,23)+TPK%K073(& -&:)*PCONC(:,24)+TPK%K074(:)*PCONC(:,26)+TPK%K075(:)*PCONC(:,22)+TPK%K076(:)*PCO& -&NC(:,20)+TPK%K077(:)*PCONC(:,21)+TPK%K078(:)*PCONC(:,28)+TPK%K119(:)*PCONC(:,3& -&3)+TPK%K120(:)*PCONC(:,34)+TPK%K121(:)*PCONC(:,35)+TPK%K122(:)*PCONC(:,36)+TPK& -&%K123(:)*PCONC(:,39)+TPK%K124(:)*PCONC(:,40)+TPK%K125(:)*PCONC(:,41)+TPK%K131(& -&:)*PCONC(:,42)+TPK%K133(:)*PCONC(:,11)+TPK%KTC5(:)+TPK%KTR5(:) -! -!PPROD(N2O5) = +K047*<NO3>*<NO2>+KTC26*<WC_N2O5>+KTR26*<WR_N2O5> - PPROD(:,6) = +TPK%K047(:)*PCONC(:,5)*PCONC(:,4)+TPK%KTC26(:)*PCONC(:,48)+TPK%K& -&TR26(:)*PCONC(:,73) -!PLOSS(N2O5) = +K048+KTC6+KTR6 - PLOSS(:,6) = +TPK%K048(:)+TPK%KTC6(:)+TPK%KTR6(:) -! -!PPROD(HONO) = +K032*<OH>*<NO>+K085*<ADD>*<NO2>+KTC27*<WC_HONO>+KTR27*<WR_HONO> - PPROD(:,7) = +TPK%K032(:)*PCONC(:,15)*PCONC(:,3)+TPK%K085(:)*PCONC(:,38)*PCONC& -&(:,4)+TPK%KTC27(:)*PCONC(:,49)+TPK%KTR27(:)*PCONC(:,74) -!PLOSS(HONO) = +K004+K039*<OH>+KTC7+KTR7 - PLOSS(:,7) = +TPK%K004(:)+TPK%K039(:)*PCONC(:,15)+TPK%KTC7(:)+TPK%KTR7(:) -! -!PPROD(HNO3) = +K033*<OH>*<NO2>+0.3*K038*<HO2>*<NO3>+K072*<HCHO>*<NO3>+K073*<AL -!D>*<NO3>+0.91567*K074*<CARBO>*<NO3>+K075*<ARO>*<NO3>+KTC28*<WC_HNO3>+KTR28*<WR -!_HNO3> - PPROD(:,8) = +TPK%K033(:)*PCONC(:,15)*PCONC(:,4)+0.3*TPK%K038(:)*PCONC(:,16)*P& -&CONC(:,5)+TPK%K072(:)*PCONC(:,23)*PCONC(:,5)+TPK%K073(:)*PCONC(:,24)*PCONC(:,5& -&)+0.91567*TPK%K074(:)*PCONC(:,26)*PCONC(:,5)+TPK%K075(:)*PCONC(:,22)*PCONC(:,5& -&)+TPK%KTC28(:)*PCONC(:,50)+TPK%KTR28(:)*PCONC(:,75) -!PLOSS(HNO3) = +K005+K040*<OH>+KTC8+KTR8 - PLOSS(:,8) = +TPK%K005(:)+TPK%K040(:)*PCONC(:,15)+TPK%KTC8(:)+TPK%KTR8(:) -! -!PPROD(HNO4) = +K036*<HO2>*<NO2>+KTC29*<WC_HNO4>+KTR29*<WR_HNO4> - PPROD(:,9) = +TPK%K036(:)*PCONC(:,16)*PCONC(:,4)+TPK%KTC29(:)*PCONC(:,51)+TPK%& -&KTR29(:)*PCONC(:,76) -!PLOSS(HNO4) = +K006+K037+K041*<OH>+KTC9+KTR9 - PLOSS(:,9) = +TPK%K006(:)+TPK%K037(:)+TPK%K041(:)*PCONC(:,15)+TPK%KTC9(:)+TPK%& -&KTR9(:) -! -!PPROD(NH3) = +KTC30*<WC_NH3>+KTR30*<WR_NH3> - PPROD(:,10) = +TPK%KTC30(:)*PCONC(:,52)+TPK%KTR30(:)*PCONC(:,77) -!PLOSS(NH3) = +K050*<OH>+KTC10+KTR10 - PLOSS(:,10) = +TPK%K050(:)*PCONC(:,15)+TPK%KTC10(:)+TPK%KTR10(:) -! -RETURN -END SUBROUTINE SUB0 -! -SUBROUTINE SUB1 -! -!Indices 11 a 20 -! -! -!PPROD(DMS) = 0.0 - PPROD(:,11) = 0.0 -!PLOSS(DMS) = +K133*<NO3>+K134*<O3P>+K135*<OH> - PLOSS(:,11) = +TPK%K133(:)*PCONC(:,5)+TPK%K134(:)*TPK%O3P(:)+TPK%K135(:)*PCONC& -&(:,15) -! -!PPROD(SO2) = +K133*<DMS>*<NO3>+K134*<DMS>*<O3P>+0.8*K135*<DMS>*<OH>+KTC34*<WC_ -!SO2>+KTR34*<WR_SO2> - PPROD(:,12) = +TPK%K133(:)*PCONC(:,11)*PCONC(:,5)+TPK%K134(:)*PCONC(:,11)*TPK%& -&O3P(:)+0.8*TPK%K135(:)*PCONC(:,11)*PCONC(:,15)+TPK%KTC34(:)*PCONC(:,56)+TPK%KT& -&R34(:)*PCONC(:,81) -!PLOSS(SO2) = +K052*<OH>+KTC14+KTR14 - PLOSS(:,12) = +TPK%K052(:)*PCONC(:,15)+TPK%KTC14(:)+TPK%KTR14(:) -! -!PPROD(SULF) = +K052*<OH>*<SO2>+KTC35*<WC_SULF>+KTR35*<WR_SULF> - PPROD(:,13) = +TPK%K052(:)*PCONC(:,15)*PCONC(:,12)+TPK%KTC35(:)*PCONC(:,57)+TP& -&K%KTR35(:)*PCONC(:,82) -!PLOSS(SULF) = +K132+KTC15+KTR15 - PLOSS(:,13) = +TPK%K132(:)+TPK%KTC15(:)+TPK%KTR15(:) -! -!PPROD(CO) = +K010*<HCHO>+K011*<HCHO>+K012*<ALD>+0.91924*K016*<CARBO>+0.01*K054 -!*<BIO>*<O3P>+0.00878*K058*<ALKA>*<OH>+K062*<HCHO>*<OH>+1.01732*K065*<CARBO>*<O -!H>+K072*<HCHO>*<NO3>+1.33723*K074*<CARBO>*<NO3>+0.35120*K079*<ALKE>*<O3>+0.360 -!00*K080*<BIO>*<O3>+0.64728*K081*<CARBO>*<O3>+0.13*K082*<PAN>*<O3> - PPROD(:,14) = +TPK%K010(:)*PCONC(:,23)+TPK%K011(:)*PCONC(:,23)+TPK%K012(:)*PCO& -&NC(:,24)+0.91924*TPK%K016(:)*PCONC(:,26)+0.01*TPK%K054(:)*PCONC(:,21)*TPK%O3P(& -&:)+0.00878*TPK%K058(:)*PCONC(:,19)*PCONC(:,15)+TPK%K062(:)*PCONC(:,23)*PCONC(:& -&,15)+1.01732*TPK%K065(:)*PCONC(:,26)*PCONC(:,15)+TPK%K072(:)*PCONC(:,23)*PCONC& -&(:,5)+1.33723*TPK%K074(:)*PCONC(:,26)*PCONC(:,5)+0.35120*TPK%K079(:)*PCONC(:,2& -&0)*PCONC(:,1)+0.36000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.64728*TPK%K081(:)*P& -&CONC(:,26)*PCONC(:,1)+0.13*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) -!PLOSS(CO) = +K053*<OH> - PLOSS(:,14) = +TPK%K053(:)*PCONC(:,15) -! -!PPROD(OH) = +K004*<HONO>+K005*<HNO3>+0.35*K006*<HNO4>+K009*<H2O2>+K009*<H2O2>+ -!K013*<OP1>+K014*<OP2>+K022*<O1D>*<H2O>+K022*<O1D>*<H2O>+K024*<O3>*<HO2>+K035*< -!HO2>*<NO>+0.7*K038*<HO2>*<NO3>+0.02*K054*<BIO>*<O3P>+0.00878*K058*<ALKA>*<OH>+ -!0.35*K068*<OP1>*<OH>+0.44925*K069*<OP2>*<OH>+0.39435*K079*<ALKE>*<O3>+0.28000* -!K080*<BIO>*<O3>+0.20595*K081*<CARBO>*<O3>+0.036*K082*<PAN>*<O3>+K087*<ADD>*<O3 -!>+KTC31*<WC_OH>+KTR31*<WR_OH> - PPROD(:,15) = +TPK%K004(:)*PCONC(:,7)+TPK%K005(:)*PCONC(:,8)+0.35*TPK%K006(:)*& -&PCONC(:,9)+TPK%K009(:)*PCONC(:,2)+TPK%K009(:)*PCONC(:,2)+TPK%K013(:)*PCONC(:,2& -&9)+TPK%K014(:)*PCONC(:,30)+TPK%K022(:)*TPK%O1D(:)*TPK%H2O(:)+TPK%K022(:)*TPK%O& -&1D(:)*TPK%H2O(:)+TPK%K024(:)*PCONC(:,1)*PCONC(:,16)+TPK%K035(:)*PCONC(:,16)*PC& -&ONC(:,3)+0.7*TPK%K038(:)*PCONC(:,16)*PCONC(:,5)+0.02*TPK%K054(:)*PCONC(:,21)*T& -&PK%O3P(:)+0.00878*TPK%K058(:)*PCONC(:,19)*PCONC(:,15)+0.35*TPK%K068(:)*PCONC(:& -&,29)*PCONC(:,15)+0.44925*TPK%K069(:)*PCONC(:,30)*PCONC(:,15)+0.39435*TPK%K079(& -&:)*PCONC(:,20)*PCONC(:,1)+0.28000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.20595*T& -&PK%K081(:)*PCONC(:,26)*PCONC(:,1)+0.036*TPK%K082(:)*PCONC(:,28)*PCONC(:,1)+TPK& -&%K087(:)*PCONC(:,38)*PCONC(:,1)+TPK%KTC31(:)*PCONC(:,53)+TPK%KTR31(:)*PCONC(:,& -&78) -!PLOSS(OH) = +K023*<O3>+K025*<HO2>+K026*<H2O2>+K032*<NO>+K033*<NO2>+K034*<NO3>+ -!K039*<HONO>+K040*<HNO3>+K041*<HNO4>+K050*<NH3>+K051*<H2>+K052*<SO2>+K053*<CO>+ -!K056*<CH4>+K057*<ETH>+K058*<ALKA>+K059*<ALKE>+K060*<BIO>+K061*<ARO>+K062*<HCHO -!>+K063*<ALD>+K064*<KET>+K065*<CARBO>+K066*<ORA1>+K067*<ORA2>+K068*<OP1>+K069*< -!OP2>+K070*<PAN>+K071*<ONIT>+K135*<DMS>+KTC11+KTR11 - PLOSS(:,15) = +TPK%K023(:)*PCONC(:,1)+TPK%K025(:)*PCONC(:,16)+TPK%K026(:)*PCON& -&C(:,2)+TPK%K032(:)*PCONC(:,3)+TPK%K033(:)*PCONC(:,4)+TPK%K034(:)*PCONC(:,5)+TP& -&K%K039(:)*PCONC(:,7)+TPK%K040(:)*PCONC(:,8)+TPK%K041(:)*PCONC(:,9)+TPK%K050(:)& -&*PCONC(:,10)+TPK%K051(:)*TPK%H2(:)+TPK%K052(:)*PCONC(:,12)+TPK%K053(:)*PCONC(:& -&,14)+TPK%K056(:)*PCONC(:,17)+TPK%K057(:)*PCONC(:,18)+TPK%K058(:)*PCONC(:,19)+T& -&PK%K059(:)*PCONC(:,20)+TPK%K060(:)*PCONC(:,21)+TPK%K061(:)*PCONC(:,22)+TPK%K06& -&2(:)*PCONC(:,23)+TPK%K063(:)*PCONC(:,24)+TPK%K064(:)*PCONC(:,25)+TPK%K065(:)*P& -&CONC(:,26)+TPK%K066(:)*PCONC(:,31)+TPK%K067(:)*PCONC(:,32)+TPK%K068(:)*PCONC(:& -&,29)+TPK%K069(:)*PCONC(:,30)+TPK%K070(:)*PCONC(:,28)+TPK%K071(:)*PCONC(:,27)+T& -&PK%K135(:)*PCONC(:,11)+TPK%KTC11(:)+TPK%KTR11(:) -! -!PPROD(HO2) = +0.65*K006*<HNO4>+K011*<HCHO>+K011*<HCHO>+K012*<ALD>+K013*<OP1>+0 -!.96205*K014*<OP2>+0.75830*K016*<CARBO>+K017*<ONIT>+K023*<O3>*<OH>+K026*<H2O2>* -!<OH>+K034*<OH>*<NO3>+K037*<HNO4>+K051*<OH>*<H2>+K052*<OH>*<SO2>+K053*<CO>*<OH> -!+0.28*K054*<BIO>*<O3P>+0.12793*K058*<ALKA>*<OH>+0.10318*K061*<ARO>*<OH>+K062*< -!HCHO>*<OH>+0.51208*K065*<CARBO>*<OH>+K066*<ORA1>*<OH>+0.02915*K069*<OP2>*<OH>+ -!0.28107*K070*<PAN>*<OH>+K072*<HCHO>*<NO3>+0.63217*K074*<CARBO>*<NO3>+0.23451*K -!079*<ALKE>*<O3>+0.30000*K080*<BIO>*<O3>+0.28441*K081*<CARBO>*<O3>+0.08*K082*<P -!AN>*<O3>+0.02*K086*<ADD>*<O2>+K090*<MO2>*<NO>+0.74265*K091*<ALKAP>*<NO>+K092*< -!ALKEP>*<NO>+0.84700*K093*<BIOP>*<NO>+0.95115*K094*<AROP>*<NO>+0.12334*K095*<CA -!RBOP>*<NO>+0.18401*K096*<OLN>*<NO>+0.66*K104*<MO2>*<MO2>+0.98383*K105*<ALKAP>* -!<MO2>+K106*<ALKEP>*<MO2>+1.00000*K107*<BIOP>*<MO2>+1.02767*K108*<AROP>*<MO2>+0 -!.82998*K109*<CARBOP>*<MO2>+0.67560*K110*<OLN>*<MO2>+0.48079*K111*<ALKAP>*<CARB -!OP>+0.50078*K112*<ALKEP>*<CARBOP>+0.50600*K113*<BIOP>*<CARBOP>+K114*<AROP>*<CA -!RBOP>+0.07566*K115*<CARBOP>*<CARBOP>+0.17599*K116*<OLN>*<CARBOP>+K117*<OLN>*<O -!LN>+0.00000*K118*<OLN>*<OLN>+K119*<MO2>*<NO3>+0.81290*K120*<ALKAP>*<NO3>+K121* -!<ALKEP>*<NO3>+K122*<BIOP>*<NO3>+K123*<AROP>*<NO3>+0.04915*K124*<CARBOP>*<NO3>+ -!0.25928*K125*<OLN>*<NO3>+K127*<XO2>*<MO2>+KTC32*<WC_HO2>+KTR32*<WR_HO2> - PPROD(:,16) = +0.65*TPK%K006(:)*PCONC(:,9)+TPK%K011(:)*PCONC(:,23)+TPK%K011(:)& -&*PCONC(:,23)+TPK%K012(:)*PCONC(:,24)+TPK%K013(:)*PCONC(:,29)+0.96205*TPK%K014(& -&:)*PCONC(:,30)+0.75830*TPK%K016(:)*PCONC(:,26)+TPK%K017(:)*PCONC(:,27)+TPK%K02& -&3(:)*PCONC(:,1)*PCONC(:,15)+TPK%K026(:)*PCONC(:,2)*PCONC(:,15)+TPK%K034(:)*PCO& -&NC(:,15)*PCONC(:,5)+TPK%K037(:)*PCONC(:,9)+TPK%K051(:)*PCONC(:,15)*TPK%H2(:)+T& -&PK%K052(:)*PCONC(:,15)*PCONC(:,12)+TPK%K053(:)*PCONC(:,14)*PCONC(:,15)+0.28*TP& -&K%K054(:)*PCONC(:,21)*TPK%O3P(:)+0.12793*TPK%K058(:)*PCONC(:,19)*PCONC(:,15)+0& -&.10318*TPK%K061(:)*PCONC(:,22)*PCONC(:,15)+TPK%K062(:)*PCONC(:,23)*PCONC(:,15)& -&+0.51208*TPK%K065(:)*PCONC(:,26)*PCONC(:,15)+TPK%K066(:)*PCONC(:,31)*PCONC(:,1& -&5)+0.02915*TPK%K069(:)*PCONC(:,30)*PCONC(:,15)+0.28107*TPK%K070(:)*PCONC(:,28)& -&*PCONC(:,15)+TPK%K072(:)*PCONC(:,23)*PCONC(:,5)+0.63217*TPK%K074(:)*PCONC(:,26& -&)*PCONC(:,5)+0.23451*TPK%K079(:)*PCONC(:,20)*PCONC(:,1)+0.30000*TPK%K080(:)*PC& -&ONC(:,21)*PCONC(:,1)+0.28441*TPK%K081(:)*PCONC(:,26)*PCONC(:,1)+0.08*TPK%K082(& -&:)*PCONC(:,28)*PCONC(:,1)+0.02*TPK%K086(:)*PCONC(:,38)*TPK%O2(:)+TPK%K090(:)*P& -&CONC(:,33)*PCONC(:,3)+0.74265*TPK%K091(:)*PCONC(:,34)*PCONC(:,3)+TPK%K092(:)*P& -&CONC(:,35)*PCONC(:,3)+0.84700*TPK%K093(:)*PCONC(:,36)*PCONC(:,3)+0.95115*TPK%K& -&094(:)*PCONC(:,39)*PCONC(:,3)+0.12334*TPK%K095(:)*PCONC(:,40)*PCONC(:,3)+0.184& -&01*TPK%K096(:)*PCONC(:,41)*PCONC(:,3)+0.66*TPK%K104(:)*PCONC(:,33)*PCONC(:,33)& -&+0.98383*TPK%K105(:)*PCONC(:,34)*PCONC(:,33)+TPK%K106(:)*PCONC(:,35)*PCONC(:,3& -&3)+1.00000*TPK%K107(:)*PCONC(:,36)*PCONC(:,33)+1.02767*TPK%K108(:)*PCONC(:,39)& -&*PCONC(:,33)+0.82998*TPK%K109(:)*PCONC(:,40)*PCONC(:,33)+0.67560*TPK%K110(:)*P& -&CONC(:,41)*PCONC(:,33)+0.48079*TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.50078*TPK& -&%K112(:)*PCONC(:,35)*PCONC(:,40)+0.50600*TPK%K113(:)*PCONC(:,36)*PCONC(:,40)+T& -&PK%K114(:)*PCONC(:,39)*PCONC(:,40)+0.07566*TPK%K115(:)*PCONC(:,40)*PCONC(:,40)& -&+0.17599*TPK%K116(:)*PCONC(:,41)*PCONC(:,40)+TPK%K117(:)*PCONC(:,41)*PCONC(:,4& -&1)+0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,41)+TPK%K119(:)*PCONC(:,33)*PCONC(:& -&,5)+0.81290*TPK%K120(:)*PCONC(:,34)*PCONC(:,5)+TPK%K121(:)*PCONC(:,35)*PCONC(:& -&,5)+TPK%K122(:)*PCONC(:,36)*PCONC(:,5)+TPK%K123(:)*PCONC(:,39)*PCONC(:,5)+0.04& -&915*TPK%K124(:)*PCONC(:,40)*PCONC(:,5)+0.25928*TPK%K125(:)*PCONC(:,41)*PCONC(:& -&,5)+TPK%K127(:)*PCONC(:,42)*PCONC(:,33)+TPK%KTC32(:)*PCONC(:,54)+TPK%KTR32(:)*& -&PCONC(:,79) -!PLOSS(HO2) = +K024*<O3>+K025*<OH>+K027*<HO2>+K027*<HO2>+K028*<HO2>*<H2O>+K028* -!<HO2>*<H2O>+K035*<NO>+K036*<NO2>+K038*<NO3>+K084*<PHO>+K097*<MO2>+K098*<ALKAP> -!+K099*<ALKEP>+K0100*<BIOP>+K0101*<AROP>+K0102*<CARBOP>+K103*<OLN>+K126*<XO2>+K -!TC12+KTR12 - PLOSS(:,16) = +TPK%K024(:)*PCONC(:,1)+TPK%K025(:)*PCONC(:,15)+TPK%K027(:)*PCON& -&C(:,16)+TPK%K027(:)*PCONC(:,16)+TPK%K028(:)*PCONC(:,16)*TPK%H2O(:)+TPK%K028(:)& -&*PCONC(:,16)*TPK%H2O(:)+TPK%K035(:)*PCONC(:,3)+TPK%K036(:)*PCONC(:,4)+TPK%K038& -&(:)*PCONC(:,5)+TPK%K084(:)*PCONC(:,37)+TPK%K097(:)*PCONC(:,33)+TPK%K098(:)*PCO& -&NC(:,34)+TPK%K099(:)*PCONC(:,35)+TPK%K0100(:)*PCONC(:,36)+TPK%K0101(:)*PCONC(:& -&,39)+TPK%K0102(:)*PCONC(:,40)+TPK%K103(:)*PCONC(:,41)+TPK%K126(:)*PCONC(:,42)+& -&TPK%KTC12(:)+TPK%KTR12(:) -! -!PPROD(CH4) = +0.04300*K079*<ALKE>*<O3> - PPROD(:,17) = +0.04300*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -!PLOSS(CH4) = +K056*<OH> - PLOSS(:,17) = +TPK%K056(:)*PCONC(:,15) -! -!PPROD(ETH) = +0.03196*K079*<ALKE>*<O3> - PPROD(:,18) = +0.03196*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -!PLOSS(ETH) = +K057*<OH> - PLOSS(:,18) = +TPK%K057(:)*PCONC(:,15) -! -!PPROD(ALKA) = 0.0 - PPROD(:,19) = 0.0 -!PLOSS(ALKA) = +K058*<OH> - PLOSS(:,19) = +TPK%K058(:)*PCONC(:,15) -! -!PPROD(ALKE) = +0.91868*K054*<BIO>*<O3P>+0.00000*K079*<ALKE>*<O3>+0.37388*K080* -!<BIO>*<O3>+0.37815*K093*<BIOP>*<NO>+0.48074*K107*<BIOP>*<MO2>+0.24463*K113*<BI -!OP>*<CARBOP>+0.42729*K122*<BIOP>*<NO3> - PPROD(:,20) = +0.91868*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:)+0.00000*TPK%K079(:)*& -&PCONC(:,20)*PCONC(:,1)+0.37388*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.37815*TPK%& -&K093(:)*PCONC(:,36)*PCONC(:,3)+0.48074*TPK%K107(:)*PCONC(:,36)*PCONC(:,33)+0.2& -&4463*TPK%K113(:)*PCONC(:,36)*PCONC(:,40)+0.42729*TPK%K122(:)*PCONC(:,36)*PCONC& -&(:,5) -!PLOSS(ALKE) = +K059*<OH>+K076*<NO3>+K079*<O3> - PLOSS(:,20) = +TPK%K059(:)*PCONC(:,15)+TPK%K076(:)*PCONC(:,5)+TPK%K079(:)*PCON& -&C(:,1) -! -RETURN -END SUBROUTINE SUB1 -! -SUBROUTINE SUB2 -! -!Indices 21 a 30 -! -! -!PPROD(BIO) = 0.0 - PPROD(:,21) = 0.0 -!PLOSS(BIO) = +K054*<O3P>+K060*<OH>+K077*<NO3>+K080*<O3> - PLOSS(:,21) = +TPK%K054(:)*TPK%O3P(:)+TPK%K060(:)*PCONC(:,15)+TPK%K077(:)*PCON& -&C(:,5)+TPK%K080(:)*PCONC(:,1) -! -!PPROD(ARO) = +0.10670*K083*<PHO>*<NO2>+1.06698*K084*<PHO>*<HO2>+K085*<ADD>*<NO -!2>+0.02*K086*<ADD>*<O2>+K087*<ADD>*<O3> - PPROD(:,22) = +0.10670*TPK%K083(:)*PCONC(:,37)*PCONC(:,4)+1.06698*TPK%K084(:)*& -&PCONC(:,37)*PCONC(:,16)+TPK%K085(:)*PCONC(:,38)*PCONC(:,4)+0.02*TPK%K086(:)*PC& -&ONC(:,38)*TPK%O2(:)+TPK%K087(:)*PCONC(:,38)*PCONC(:,1) -!PLOSS(ARO) = +K061*<OH>+K075*<NO3> - PLOSS(:,22) = +TPK%K061(:)*PCONC(:,15)+TPK%K075(:)*PCONC(:,5) -! -!PPROD(HCHO) = +K013*<OP1>+0.06517*K016*<CARBO>+0.05*K054*<BIO>*<O3P>+0.00140*K -!058*<ALKA>*<OH>+0.00000*K065*<CARBO>*<OH>+0.35*K068*<OP1>*<OH>+0.02915*K069*<O -!P2>*<OH>+0.57839*K070*<PAN>*<OH>+0.40*K078*<PAN>*<NO3>+0.48290*K079*<ALKE>*<O3 -!>+0.90000*K080*<BIO>*<O3>+0.00000*K081*<CARBO>*<O3>+0.70*K082*<PAN>*<O3>+K090* -!<MO2>*<NO>+0.03002*K091*<ALKAP>*<NO>+1.39870*K092*<ALKEP>*<NO>+0.60600*K093*<B -!IOP>*<NO>+0.05848*K095*<CARBOP>*<NO>+0.23419*K096*<OLN>*<NO>+1.33*K104*<MO2>*< -!MO2>+0.80556*K105*<ALKAP>*<MO2>+1.42894*K106*<ALKEP>*<MO2>+1.09000*K107*<BIOP> -!*<MO2>+K108*<AROP>*<MO2>+0.95723*K109*<CARBOP>*<MO2>+0.88625*K110*<OLN>*<MO2>+ -!0.07600*K111*<ALKAP>*<CARBOP>+0.68192*K112*<ALKEP>*<CARBOP>+0.34000*K113*<BIOP -!>*<CARBOP>+0.03432*K115*<CARBOP>*<CARBOP>+0.13414*K116*<OLN>*<CARBOP>+0.00000* -!K118*<OLN>*<OLN>+K119*<MO2>*<NO3>+0.03142*K120*<ALKAP>*<NO3>+1.40909*K121*<ALK -!EP>*<NO3>+0.68600*K122*<BIOP>*<NO3>+0.03175*K124*<CARBOP>*<NO3>+0.20740*K125*< -!OLN>*<NO3>+K127*<XO2>*<MO2>+KTC36*<WC_HCHO>+KTR36*<WR_HCHO> - PPROD(:,23) = +TPK%K013(:)*PCONC(:,29)+0.06517*TPK%K016(:)*PCONC(:,26)+0.05*TP& -&K%K054(:)*PCONC(:,21)*TPK%O3P(:)+0.00140*TPK%K058(:)*PCONC(:,19)*PCONC(:,15)+0& -&.00000*TPK%K065(:)*PCONC(:,26)*PCONC(:,15)+0.35*TPK%K068(:)*PCONC(:,29)*PCONC(& -&:,15)+0.02915*TPK%K069(:)*PCONC(:,30)*PCONC(:,15)+0.57839*TPK%K070(:)*PCONC(:,& -&28)*PCONC(:,15)+0.40*TPK%K078(:)*PCONC(:,28)*PCONC(:,5)+0.48290*TPK%K079(:)*PC& -&ONC(:,20)*PCONC(:,1)+0.90000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.00000*TPK%K0& -&81(:)*PCONC(:,26)*PCONC(:,1)+0.70*TPK%K082(:)*PCONC(:,28)*PCONC(:,1)+TPK%K090(& -&:)*PCONC(:,33)*PCONC(:,3)+0.03002*TPK%K091(:)*PCONC(:,34)*PCONC(:,3)+1.39870*T& -&PK%K092(:)*PCONC(:,35)*PCONC(:,3)+0.60600*TPK%K093(:)*PCONC(:,36)*PCONC(:,3)+0& -&.05848*TPK%K095(:)*PCONC(:,40)*PCONC(:,3)+0.23419*TPK%K096(:)*PCONC(:,41)*PCON& -&C(:,3)+1.33*TPK%K104(:)*PCONC(:,33)*PCONC(:,33)+0.80556*TPK%K105(:)*PCONC(:,34& -&)*PCONC(:,33)+1.42894*TPK%K106(:)*PCONC(:,35)*PCONC(:,33)+1.09000*TPK%K107(:)*& -&PCONC(:,36)*PCONC(:,33)+TPK%K108(:)*PCONC(:,39)*PCONC(:,33)+0.95723*TPK%K109(:& -&)*PCONC(:,40)*PCONC(:,33)+0.88625*TPK%K110(:)*PCONC(:,41)*PCONC(:,33)+0.07600*& -&TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.68192*TPK%K112(:)*PCONC(:,35)*PCONC(:,40& -&)+0.34000*TPK%K113(:)*PCONC(:,36)*PCONC(:,40)+0.03432*TPK%K115(:)*PCONC(:,40)*& -&PCONC(:,40)+0.13414*TPK%K116(:)*PCONC(:,41)*PCONC(:,40)+0.00000*TPK%K118(:)*PC& -&ONC(:,41)*PCONC(:,41)+TPK%K119(:)*PCONC(:,33)*PCONC(:,5)+0.03142*TPK%K120(:)*P& -&CONC(:,34)*PCONC(:,5)+1.40909*TPK%K121(:)*PCONC(:,35)*PCONC(:,5)+0.68600*TPK%K& -&122(:)*PCONC(:,36)*PCONC(:,5)+0.03175*TPK%K124(:)*PCONC(:,40)*PCONC(:,5)+0.207& -&40*TPK%K125(:)*PCONC(:,41)*PCONC(:,5)+TPK%K127(:)*PCONC(:,42)*PCONC(:,33)+TPK%& -&KTC36(:)*PCONC(:,58)+TPK%KTR36(:)*PCONC(:,83) -!PLOSS(HCHO) = +K010+K011+K062*<OH>+K072*<NO3>+KTC16+KTR16 - PLOSS(:,23) = +TPK%K010(:)+TPK%K011(:)+TPK%K062(:)*PCONC(:,15)+TPK%K072(:)*PCO& -&NC(:,5)+TPK%KTC16(:)+TPK%KTR16(:) -! -!PPROD(ALD) = +0.96205*K014*<OP2>+0.20*K017*<ONIT>+K055*<CARBO>*<O3P>+0.08173*K -!058*<ALKA>*<OH>+0.06253*K065*<CARBO>*<OH>+0.07335*K069*<OP2>*<OH>+0.05265*K074 -!*<CARBO>*<NO3>+0.51468*K079*<ALKE>*<O3>+0.00000*K080*<BIO>*<O3>+0.15692*K081*< -!CARBO>*<O3>+0.33144*K091*<ALKAP>*<NO>+0.42125*K092*<ALKEP>*<NO>+0.00000*K093*< -!BIOP>*<NO>+0.07368*K095*<CARBOP>*<NO>+1.01182*K096*<OLN>*<NO>+0.56070*K105*<AL -!KAP>*<MO2>+0.46413*K106*<ALKEP>*<MO2>+0.00000*K107*<BIOP>*<MO2>+0.08295*K109*< -!CARBOP>*<MO2>+0.41524*K110*<OLN>*<MO2>+0.71461*K111*<ALKAP>*<CARBOP>+0.68374*K -!112*<ALKEP>*<CARBOP>+0.00000*K113*<BIOP>*<CARBOP>+0.06969*K115*<CARBOP>*<CARBO -!P>+0.42122*K116*<OLN>*<CARBOP>+0.00000*K118*<OLN>*<OLN>+0.33743*K120*<ALKAP>*< -!NO3>+0.43039*K121*<ALKEP>*<NO3>+0.00000*K122*<BIOP>*<NO3>+0.02936*K124*<CARBOP -!>*<NO3>+0.91850*K125*<OLN>*<NO3> - PPROD(:,24) = +0.96205*TPK%K014(:)*PCONC(:,30)+0.20*TPK%K017(:)*PCONC(:,27)+TP& -&K%K055(:)*PCONC(:,26)*TPK%O3P(:)+0.08173*TPK%K058(:)*PCONC(:,19)*PCONC(:,15)+0& -&.06253*TPK%K065(:)*PCONC(:,26)*PCONC(:,15)+0.07335*TPK%K069(:)*PCONC(:,30)*PCO& -&NC(:,15)+0.05265*TPK%K074(:)*PCONC(:,26)*PCONC(:,5)+0.51468*TPK%K079(:)*PCONC(& -&:,20)*PCONC(:,1)+0.00000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.15692*TPK%K081(:& -&)*PCONC(:,26)*PCONC(:,1)+0.33144*TPK%K091(:)*PCONC(:,34)*PCONC(:,3)+0.42125*TP& -&K%K092(:)*PCONC(:,35)*PCONC(:,3)+0.00000*TPK%K093(:)*PCONC(:,36)*PCONC(:,3)+0.& -&07368*TPK%K095(:)*PCONC(:,40)*PCONC(:,3)+1.01182*TPK%K096(:)*PCONC(:,41)*PCONC& -&(:,3)+0.56070*TPK%K105(:)*PCONC(:,34)*PCONC(:,33)+0.46413*TPK%K106(:)*PCONC(:,& -&35)*PCONC(:,33)+0.00000*TPK%K107(:)*PCONC(:,36)*PCONC(:,33)+0.08295*TPK%K109(:& -&)*PCONC(:,40)*PCONC(:,33)+0.41524*TPK%K110(:)*PCONC(:,41)*PCONC(:,33)+0.71461*& -&TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.68374*TPK%K112(:)*PCONC(:,35)*PCONC(:,40& -&)+0.00000*TPK%K113(:)*PCONC(:,36)*PCONC(:,40)+0.06969*TPK%K115(:)*PCONC(:,40)*& -&PCONC(:,40)+0.42122*TPK%K116(:)*PCONC(:,41)*PCONC(:,40)+0.00000*TPK%K118(:)*PC& -&ONC(:,41)*PCONC(:,41)+0.33743*TPK%K120(:)*PCONC(:,34)*PCONC(:,5)+0.43039*TPK%K& -&121(:)*PCONC(:,35)*PCONC(:,5)+0.00000*TPK%K122(:)*PCONC(:,36)*PCONC(:,5)+0.029& -&36*TPK%K124(:)*PCONC(:,40)*PCONC(:,5)+0.91850*TPK%K125(:)*PCONC(:,41)*PCONC(:,& -&5) -!PLOSS(ALD) = +K012+K063*<OH>+K073*<NO3> - PLOSS(:,24) = +TPK%K012(:)+TPK%K063(:)*PCONC(:,15)+TPK%K073(:)*PCONC(:,5) -! -!PPROD(KET) = +0.80*K017*<ONIT>+0.03498*K058*<ALKA>*<OH>+0.00853*K065*<CARBO>*< -!OH>+0.37591*K069*<OP2>*<OH>+0.00632*K074*<CARBO>*<NO3>+0.07377*K079*<ALKE>*<O3 -!>+0.00000*K080*<BIO>*<O3>+0.54531*K091*<ALKAP>*<NO>+0.05220*K092*<ALKEP>*<NO>+ -!0.00000*K093*<BIOP>*<NO>+0.37862*K096*<OLN>*<NO>+0.09673*K105*<ALKAP>*<MO2>+0. -!03814*K106*<ALKEP>*<MO2>+0.00000*K107*<BIOP>*<MO2>+0.09667*K110*<OLN>*<MO2>+0. -!18819*K111*<ALKAP>*<CARBOP>+0.06579*K112*<ALKEP>*<CARBOP>+0.00000*K113*<BIOP>* -!<CARBOP>+0.02190*K115*<CARBOP>*<CARBOP>+0.10822*K116*<OLN>*<CARBOP>+0.00000*K1 -!18*<OLN>*<OLN>+0.62978*K120*<ALKAP>*<NO3>+0.02051*K121*<ALKEP>*<NO3>+0.00000*K -!122*<BIOP>*<NO3>+0.34740*K125*<OLN>*<NO3> - PPROD(:,25) = +0.80*TPK%K017(:)*PCONC(:,27)+0.03498*TPK%K058(:)*PCONC(:,19)*PC& -&ONC(:,15)+0.00853*TPK%K065(:)*PCONC(:,26)*PCONC(:,15)+0.37591*TPK%K069(:)*PCON& -&C(:,30)*PCONC(:,15)+0.00632*TPK%K074(:)*PCONC(:,26)*PCONC(:,5)+0.07377*TPK%K07& -&9(:)*PCONC(:,20)*PCONC(:,1)+0.00000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.54531& -&*TPK%K091(:)*PCONC(:,34)*PCONC(:,3)+0.05220*TPK%K092(:)*PCONC(:,35)*PCONC(:,3)& -&+0.00000*TPK%K093(:)*PCONC(:,36)*PCONC(:,3)+0.37862*TPK%K096(:)*PCONC(:,41)*PC& -&ONC(:,3)+0.09673*TPK%K105(:)*PCONC(:,34)*PCONC(:,33)+0.03814*TPK%K106(:)*PCONC& -&(:,35)*PCONC(:,33)+0.00000*TPK%K107(:)*PCONC(:,36)*PCONC(:,33)+0.09667*TPK%K11& -&0(:)*PCONC(:,41)*PCONC(:,33)+0.18819*TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.065& -&79*TPK%K112(:)*PCONC(:,35)*PCONC(:,40)+0.00000*TPK%K113(:)*PCONC(:,36)*PCONC(:& -&,40)+0.02190*TPK%K115(:)*PCONC(:,40)*PCONC(:,40)+0.10822*TPK%K116(:)*PCONC(:,4& -&1)*PCONC(:,40)+0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,41)+0.62978*TPK%K120(:)& -&*PCONC(:,34)*PCONC(:,5)+0.02051*TPK%K121(:)*PCONC(:,35)*PCONC(:,5)+0.00000*TPK& -&%K122(:)*PCONC(:,36)*PCONC(:,5)+0.34740*TPK%K125(:)*PCONC(:,41)*PCONC(:,5) -!PLOSS(KET) = +K015+K064*<OH> - PLOSS(:,25) = +TPK%K015(:)+TPK%K064(:)*PCONC(:,15) -! -!PPROD(CARBO) = +0.13255*K054*<BIO>*<O3P>+0.00835*K058*<ALKA>*<OH>+0.16919*K065 -!*<CARBO>*<OH>+0.21863*K070*<PAN>*<OH>+0.10530*K074*<CARBO>*<NO3>+0.00000*K076* -!<ALKE>*<NO3>+0.91741*K077*<BIO>*<NO3>+0.00000*K079*<ALKE>*<O3>+0.39754*K080*<B -!IO>*<O3>+1.07583*K081*<CARBO>*<O3>+0.03407*K091*<ALKAP>*<NO>+0.45463*K093*<BIO -!P>*<NO>+2.06993*K094*<AROP>*<NO>+0.08670*K095*<CARBOP>*<NO>+0.07976*K105*<ALKA -!P>*<MO2>+0.56064*K107*<BIOP>*<MO2>+1.99461*K108*<AROP>*<MO2>+0.15387*K109*<CAR -!BOP>*<MO2>+0.06954*K111*<ALKAP>*<CARBOP>+0.78591*K113*<BIOP>*<CARBOP>+1.99455* -!K114*<AROP>*<CARBOP>+0.10777*K115*<CARBOP>*<CARBOP>+0.03531*K120*<ALKAP>*<NO3> -!+0.61160*K122*<BIOP>*<NO3>+2.81904*K123*<AROP>*<NO3>+0.03455*K124*<CARBOP>*<NO -!3> - PPROD(:,26) = +0.13255*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:)+0.00835*TPK%K058(:)*& -&PCONC(:,19)*PCONC(:,15)+0.16919*TPK%K065(:)*PCONC(:,26)*PCONC(:,15)+0.21863*TP& -&K%K070(:)*PCONC(:,28)*PCONC(:,15)+0.10530*TPK%K074(:)*PCONC(:,26)*PCONC(:,5)+0& -&.00000*TPK%K076(:)*PCONC(:,20)*PCONC(:,5)+0.91741*TPK%K077(:)*PCONC(:,21)*PCON& -&C(:,5)+0.00000*TPK%K079(:)*PCONC(:,20)*PCONC(:,1)+0.39754*TPK%K080(:)*PCONC(:,& -&21)*PCONC(:,1)+1.07583*TPK%K081(:)*PCONC(:,26)*PCONC(:,1)+0.03407*TPK%K091(:)*& -&PCONC(:,34)*PCONC(:,3)+0.45463*TPK%K093(:)*PCONC(:,36)*PCONC(:,3)+2.06993*TPK%& -&K094(:)*PCONC(:,39)*PCONC(:,3)+0.08670*TPK%K095(:)*PCONC(:,40)*PCONC(:,3)+0.07& -&976*TPK%K105(:)*PCONC(:,34)*PCONC(:,33)+0.56064*TPK%K107(:)*PCONC(:,36)*PCONC(& -&:,33)+1.99461*TPK%K108(:)*PCONC(:,39)*PCONC(:,33)+0.15387*TPK%K109(:)*PCONC(:,& -&40)*PCONC(:,33)+0.06954*TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.78591*TPK%K113(:& -&)*PCONC(:,36)*PCONC(:,40)+1.99455*TPK%K114(:)*PCONC(:,39)*PCONC(:,40)+0.10777*& -&TPK%K115(:)*PCONC(:,40)*PCONC(:,40)+0.03531*TPK%K120(:)*PCONC(:,34)*PCONC(:,5)& -&+0.61160*TPK%K122(:)*PCONC(:,36)*PCONC(:,5)+2.81904*TPK%K123(:)*PCONC(:,39)*PC& -&ONC(:,5)+0.03455*TPK%K124(:)*PCONC(:,40)*PCONC(:,5) -!PLOSS(CARBO) = +K016+K055*<O3P>+K065*<OH>+K074*<NO3>+K081*<O3> - PLOSS(:,26) = +TPK%K016(:)+TPK%K055(:)*TPK%O3P(:)+TPK%K065(:)*PCONC(:,15)+TPK%& -&K074(:)*PCONC(:,5)+TPK%K081(:)*PCONC(:,1) -! -!PPROD(ONIT) = +0.60*K078*<PAN>*<NO3>+K083*<PHO>*<NO2>+0.08459*K091*<ALKAP>*<NO -!>+0.15300*K093*<BIOP>*<NO>+0.04885*K094*<AROP>*<NO>+0.18401*K096*<OLN>*<NO>+K1 -!03*<OLN>*<HO2>+0.67560*K110*<OLN>*<MO2>+0.66562*K116*<OLN>*<CARBOP>+2.00*K117* -!<OLN>*<OLN>+0.00000*K118*<OLN>*<OLN>+0.25928*K125*<OLN>*<NO3> - PPROD(:,27) = +0.60*TPK%K078(:)*PCONC(:,28)*PCONC(:,5)+TPK%K083(:)*PCONC(:,37)& -&*PCONC(:,4)+0.08459*TPK%K091(:)*PCONC(:,34)*PCONC(:,3)+0.15300*TPK%K093(:)*PCO& -&NC(:,36)*PCONC(:,3)+0.04885*TPK%K094(:)*PCONC(:,39)*PCONC(:,3)+0.18401*TPK%K09& -&6(:)*PCONC(:,41)*PCONC(:,3)+TPK%K103(:)*PCONC(:,41)*PCONC(:,16)+0.67560*TPK%K1& -&10(:)*PCONC(:,41)*PCONC(:,33)+0.66562*TPK%K116(:)*PCONC(:,41)*PCONC(:,40)+2.00& -&*TPK%K117(:)*PCONC(:,41)*PCONC(:,41)+0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,4& -&1)+0.25928*TPK%K125(:)*PCONC(:,41)*PCONC(:,5) -!PLOSS(ONIT) = +K017+K071*<OH> - PLOSS(:,27) = +TPK%K017(:)+TPK%K071(:)*PCONC(:,15) -! -!PPROD(PAN) = +0.28107*K070*<PAN>*<OH>+0.40000*K078*<PAN>*<NO3>+0.30000*K082*<P -!AN>*<O3>+1.00000*K088*<CARBOP>*<NO2> - PPROD(:,28) = +0.28107*TPK%K070(:)*PCONC(:,28)*PCONC(:,15)+0.40000*TPK%K078(:)& -&*PCONC(:,28)*PCONC(:,5)+0.30000*TPK%K082(:)*PCONC(:,28)*PCONC(:,1)+1.00000*TPK& -&%K088(:)*PCONC(:,40)*PCONC(:,4) -!PLOSS(PAN) = +K070*<OH>+K078*<NO3>+K082*<O3>+K089 - PLOSS(:,28) = +TPK%K070(:)*PCONC(:,15)+TPK%K078(:)*PCONC(:,5)+TPK%K082(:)*PCON& -&C(:,1)+TPK%K089(:) -! -!PPROD(OP1) = +K097*<MO2>*<HO2>+KTC40*<WC_OP1>+KTR40*<WR_OP1> - PPROD(:,29) = +TPK%K097(:)*PCONC(:,33)*PCONC(:,16)+TPK%KTC40(:)*PCONC(:,62)+TP& -&K%KTR40(:)*PCONC(:,87) -!PLOSS(OP1) = +K013+K068*<OH>+KTC20+KTR20 - PLOSS(:,29) = +TPK%K013(:)+TPK%K068(:)*PCONC(:,15)+TPK%KTC20(:)+TPK%KTR20(:) -! -!PPROD(OP2) = +0.10149*K081*<CARBO>*<O3>+1.00524*K098*<ALKAP>*<HO2>+1.00524*K09 -!9*<ALKEP>*<HO2>+1.00524*K0100*<BIOP>*<HO2>+1.00524*K0101*<AROP>*<HO2>+0.80904* -!K0102*<CARBOP>*<HO2>+1.00524*K126*<XO2>*<HO2> - PPROD(:,30) = +0.10149*TPK%K081(:)*PCONC(:,26)*PCONC(:,1)+1.00524*TPK%K098(:)*& -&PCONC(:,34)*PCONC(:,16)+1.00524*TPK%K099(:)*PCONC(:,35)*PCONC(:,16)+1.00524*TP& -&K%K0100(:)*PCONC(:,36)*PCONC(:,16)+1.00524*TPK%K0101(:)*PCONC(:,39)*PCONC(:,16& -&)+0.80904*TPK%K0102(:)*PCONC(:,40)*PCONC(:,16)+1.00524*TPK%K126(:)*PCONC(:,42)& -&*PCONC(:,16) -!PLOSS(OP2) = +K014+K069*<OH> - PLOSS(:,30) = +TPK%K014(:)+TPK%K069(:)*PCONC(:,15) -! -RETURN -END SUBROUTINE SUB2 -! -SUBROUTINE SUB3 -! -!Indices 31 a 40 -! -! -!PPROD(ORA1) = +0.00878*K058*<ALKA>*<OH>+0.15343*K079*<ALKE>*<O3>+0.15000*K080* -!<BIO>*<O3>+0.10788*K081*<CARBO>*<O3>+0.11*K082*<PAN>*<O3>+KTC37*<WC_ORA1>+KTR3 -!7*<WR_ORA1> - PPROD(:,31) = +0.00878*TPK%K058(:)*PCONC(:,19)*PCONC(:,15)+0.15343*TPK%K079(:)& -&*PCONC(:,20)*PCONC(:,1)+0.15000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.10788*TPK& -&%K081(:)*PCONC(:,26)*PCONC(:,1)+0.11*TPK%K082(:)*PCONC(:,28)*PCONC(:,1)+TPK%KT& -&C37(:)*PCONC(:,59)+TPK%KTR37(:)*PCONC(:,84) -!PLOSS(ORA1) = +K066*<OH>+KTC17+KTR17 - PLOSS(:,31) = +TPK%K066(:)*PCONC(:,15)+TPK%KTC17(:)+TPK%KTR17(:) -! -!PPROD(ORA2) = +0.08143*K079*<ALKE>*<O3>+0.00000*K080*<BIO>*<O3>+0.20595*K081*< -!CARBO>*<O3>+0.17307*K0102*<CARBOP>*<HO2>+0.13684*K109*<CARBOP>*<MO2>+0.49810*K -!111*<ALKAP>*<CARBOP>+0.49922*K112*<ALKEP>*<CARBOP>+0.49400*K113*<BIOP>*<CARBOP -!>+0.09955*K115*<CARBOP>*<CARBOP>+0.48963*K116*<OLN>*<CARBOP>+KTC38*<WC_ORA2>+K -!TR38*<WR_ORA2> - PPROD(:,32) = +0.08143*TPK%K079(:)*PCONC(:,20)*PCONC(:,1)+0.00000*TPK%K080(:)*& -&PCONC(:,21)*PCONC(:,1)+0.20595*TPK%K081(:)*PCONC(:,26)*PCONC(:,1)+0.17307*TPK%& -&K0102(:)*PCONC(:,40)*PCONC(:,16)+0.13684*TPK%K109(:)*PCONC(:,40)*PCONC(:,33)+0& -&.49810*TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.49922*TPK%K112(:)*PCONC(:,35)*PCO& -&NC(:,40)+0.49400*TPK%K113(:)*PCONC(:,36)*PCONC(:,40)+0.09955*TPK%K115(:)*PCONC& -&(:,40)*PCONC(:,40)+0.48963*TPK%K116(:)*PCONC(:,41)*PCONC(:,40)+TPK%KTC38(:)*PC& -&ONC(:,60)+TPK%KTR38(:)*PCONC(:,85) -!PLOSS(ORA2) = +K067*<OH>+KTC18+KTR18 - PLOSS(:,32) = +TPK%K067(:)*PCONC(:,15)+TPK%KTC18(:)+TPK%KTR18(:) -! -!PPROD(MO2) = +K012*<ALD>+0.03795*K014*<OP2>+K056*<CH4>*<OH>+0.65*K068*<OP1>*<O -!H>+0.13966*K079*<ALKE>*<O3>+0.03000*K080*<BIO>*<O3>+0.09016*K091*<ALKAP>*<NO>+ -!0.78134*K095*<CARBOP>*<NO>+0.01390*K105*<ALKAP>*<MO2>+0.56031*K109*<CARBOP>*<M -!O2>+0.51480*K111*<ALKAP>*<CARBOP>+0.50078*K112*<ALKEP>*<CARBOP>+0.50600*K113*< -!BIOP>*<CARBOP>+K114*<AROP>*<CARBOP>+1.66702*K115*<CARBOP>*<CARBOP>+0.51037*K11 -!6*<OLN>*<CARBOP>+0.09731*K120*<ALKAP>*<NO3>+0.91910*K124*<CARBOP>*<NO3>+K128*< -!XO2>*<CARBOP>+KTC39*<WC_MO2>+KTR39*<WR_MO2> - PPROD(:,33) = +TPK%K012(:)*PCONC(:,24)+0.03795*TPK%K014(:)*PCONC(:,30)+TPK%K05& -&6(:)*PCONC(:,17)*PCONC(:,15)+0.65*TPK%K068(:)*PCONC(:,29)*PCONC(:,15)+0.13966*& -&TPK%K079(:)*PCONC(:,20)*PCONC(:,1)+0.03000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+& -&0.09016*TPK%K091(:)*PCONC(:,34)*PCONC(:,3)+0.78134*TPK%K095(:)*PCONC(:,40)*PCO& -&NC(:,3)+0.01390*TPK%K105(:)*PCONC(:,34)*PCONC(:,33)+0.56031*TPK%K109(:)*PCONC(& -&:,40)*PCONC(:,33)+0.51480*TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.50078*TPK%K112& -&(:)*PCONC(:,35)*PCONC(:,40)+0.50600*TPK%K113(:)*PCONC(:,36)*PCONC(:,40)+TPK%K1& -&14(:)*PCONC(:,39)*PCONC(:,40)+1.66702*TPK%K115(:)*PCONC(:,40)*PCONC(:,40)+0.51& -&037*TPK%K116(:)*PCONC(:,41)*PCONC(:,40)+0.09731*TPK%K120(:)*PCONC(:,34)*PCONC(& -&:,5)+0.91910*TPK%K124(:)*PCONC(:,40)*PCONC(:,5)+TPK%K128(:)*PCONC(:,42)*PCONC(& -&:,40)+TPK%KTC39(:)*PCONC(:,61)+TPK%KTR39(:)*PCONC(:,86) -!PLOSS(MO2) = +K090*<NO>+K097*<HO2>+K104*<MO2>+K104*<MO2>+K105*<ALKAP>+K106*<AL -!KEP>+K107*<BIOP>+K108*<AROP>+K109*<CARBOP>+K110*<OLN>+K119*<NO3>+K127*<XO2>+KT -!C19+KTR19 - PLOSS(:,33) = +TPK%K090(:)*PCONC(:,3)+TPK%K097(:)*PCONC(:,16)+TPK%K104(:)*PCON& -&C(:,33)+TPK%K104(:)*PCONC(:,33)+TPK%K105(:)*PCONC(:,34)+TPK%K106(:)*PCONC(:,35& -&)+TPK%K107(:)*PCONC(:,36)+TPK%K108(:)*PCONC(:,39)+TPK%K109(:)*PCONC(:,40)+TPK%& -&K110(:)*PCONC(:,41)+TPK%K119(:)*PCONC(:,5)+TPK%K127(:)*PCONC(:,42)+TPK%KTC19(:& -&)+TPK%KTR19(:) -! -!PPROD(ALKAP) = +1.00000*K015*<KET>+K057*<ETH>*<OH>+0.87811*K058*<ALKA>*<OH>+0. -!40341*K069*<OP2>*<OH>+1.00000*K071*<ONIT>*<OH>+0.09815*K079*<ALKE>*<O3>+0.0000 -!0*K080*<BIO>*<O3>+0.08187*K091*<ALKAP>*<NO>+0.00385*K105*<ALKAP>*<MO2>+0.00828 -!*K111*<ALKAP>*<CARBOP>+0.08994*K120*<ALKAP>*<NO3> - PPROD(:,34) = +1.00000*TPK%K015(:)*PCONC(:,25)+TPK%K057(:)*PCONC(:,18)*PCONC(:& -&,15)+0.87811*TPK%K058(:)*PCONC(:,19)*PCONC(:,15)+0.40341*TPK%K069(:)*PCONC(:,3& -&0)*PCONC(:,15)+1.00000*TPK%K071(:)*PCONC(:,27)*PCONC(:,15)+0.09815*TPK%K079(:)& -&*PCONC(:,20)*PCONC(:,1)+0.00000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.08187*TPK& -&%K091(:)*PCONC(:,34)*PCONC(:,3)+0.00385*TPK%K105(:)*PCONC(:,34)*PCONC(:,33)+0.& -&00828*TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.08994*TPK%K120(:)*PCONC(:,34)*PCON& -&C(:,5) -!PLOSS(ALKAP) = +K091*<NO>+K098*<HO2>+K105*<MO2>+K111*<CARBOP>+K120*<NO3> - PLOSS(:,34) = +TPK%K091(:)*PCONC(:,3)+TPK%K098(:)*PCONC(:,16)+TPK%K105(:)*PCON& -&C(:,33)+TPK%K111(:)*PCONC(:,40)+TPK%K120(:)*PCONC(:,5) -! -!PPROD(ALKEP) = +1.02529*K059*<ALKE>*<OH> - PPROD(:,35) = +1.02529*TPK%K059(:)*PCONC(:,20)*PCONC(:,15) -!PLOSS(ALKEP) = +K092*<NO>+K099*<HO2>+K106*<MO2>+K112*<CARBOP>+K121*<NO3> - PLOSS(:,35) = +TPK%K092(:)*PCONC(:,3)+TPK%K099(:)*PCONC(:,16)+TPK%K106(:)*PCON& -&C(:,33)+TPK%K112(:)*PCONC(:,40)+TPK%K121(:)*PCONC(:,5) -! -!PPROD(BIOP) = +0.00000*K059*<ALKE>*<OH>+1.00000*K060*<BIO>*<OH> - PPROD(:,36) = +0.00000*TPK%K059(:)*PCONC(:,20)*PCONC(:,15)+1.00000*TPK%K060(:)& -&*PCONC(:,21)*PCONC(:,15) -!PLOSS(BIOP) = +K093*<NO>+K0100*<HO2>+K107*<MO2>+K113*<CARBOP>+K122*<NO3> - PLOSS(:,36) = +TPK%K093(:)*PCONC(:,3)+TPK%K0100(:)*PCONC(:,16)+TPK%K107(:)*PCO& -&NC(:,33)+TPK%K113(:)*PCONC(:,40)+TPK%K122(:)*PCONC(:,5) -! -!PPROD(PHO) = +0.00276*K061*<ARO>*<OH>+K075*<ARO>*<NO3> - PPROD(:,37) = +0.00276*TPK%K061(:)*PCONC(:,22)*PCONC(:,15)+TPK%K075(:)*PCONC(:& -&,22)*PCONC(:,5) -!PLOSS(PHO) = +K083*<NO2>+K084*<HO2> - PLOSS(:,37) = +TPK%K083(:)*PCONC(:,4)+TPK%K084(:)*PCONC(:,16) -! -!PPROD(ADD) = +0.93968*K061*<ARO>*<OH> - PPROD(:,38) = +0.93968*TPK%K061(:)*PCONC(:,22)*PCONC(:,15) -!PLOSS(ADD) = +K085*<NO2>+K086*<O2>+K087*<O3> - PLOSS(:,38) = +TPK%K085(:)*PCONC(:,4)+TPK%K086(:)*TPK%O2(:)+TPK%K087(:)*PCONC(& -&:,1) -! -!PPROD(AROP) = +0.98*K086*<ADD>*<O2> - PPROD(:,39) = +0.98*TPK%K086(:)*PCONC(:,38)*TPK%O2(:) -!PLOSS(AROP) = +K094*<NO>+K0101*<HO2>+K108*<MO2>+K114*<CARBOP>+K123*<NO3> - PLOSS(:,39) = +TPK%K094(:)*PCONC(:,3)+TPK%K0101(:)*PCONC(:,16)+TPK%K108(:)*PCO& -&NC(:,33)+TPK%K114(:)*PCONC(:,40)+TPK%K123(:)*PCONC(:,5) -! -!PPROD(CARBOP) = +1.00000*K015*<KET>+0.69622*K016*<CARBO>+1.00000*K063*<ALD>*<O -!H>+1.00000*K064*<KET>*<OH>+0.51419*K065*<CARBO>*<OH>+0.05413*K069*<OP2>*<OH>+1 -!.00000*K073*<ALD>*<NO3>+0.38881*K074*<CARBO>*<NO3>+0.05705*K079*<ALKE>*<O3>+0. -!17000*K080*<BIO>*<O3>+0.27460*K081*<CARBO>*<O3>+0.70000*K082*<PAN>*<O3>+1.0000 -!0*K089*<PAN>+0.09532*K095*<CARBOP>*<NO>+0.05954*K109*<CARBOP>*<MO2>+0.05821*K1 -!15*<CARBOP>*<CARBOP>+0.03175*K124*<CARBOP>*<NO3> - PPROD(:,40) = +1.00000*TPK%K015(:)*PCONC(:,25)+0.69622*TPK%K016(:)*PCONC(:,26)& -&+1.00000*TPK%K063(:)*PCONC(:,24)*PCONC(:,15)+1.00000*TPK%K064(:)*PCONC(:,25)*P& -&CONC(:,15)+0.51419*TPK%K065(:)*PCONC(:,26)*PCONC(:,15)+0.05413*TPK%K069(:)*PCO& -&NC(:,30)*PCONC(:,15)+1.00000*TPK%K073(:)*PCONC(:,24)*PCONC(:,5)+0.38881*TPK%K0& -&74(:)*PCONC(:,26)*PCONC(:,5)+0.05705*TPK%K079(:)*PCONC(:,20)*PCONC(:,1)+0.1700& -&0*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.27460*TPK%K081(:)*PCONC(:,26)*PCONC(:,1& -&)+0.70000*TPK%K082(:)*PCONC(:,28)*PCONC(:,1)+1.00000*TPK%K089(:)*PCONC(:,28)+0& -&.09532*TPK%K095(:)*PCONC(:,40)*PCONC(:,3)+0.05954*TPK%K109(:)*PCONC(:,40)*PCON& -&C(:,33)+0.05821*TPK%K115(:)*PCONC(:,40)*PCONC(:,40)+0.03175*TPK%K124(:)*PCONC(& -&:,40)*PCONC(:,5) -!PLOSS(CARBOP) = +K088*<NO2>+K095*<NO>+K0102*<HO2>+K109*<MO2>+K111*<ALKAP>+K112 -!*<ALKEP>+K113*<BIOP>+K114*<AROP>+K115*<CARBOP>+K115*<CARBOP>+K116*<OLN>+K124*< -!NO3>+K128*<XO2> - PLOSS(:,40) = +TPK%K088(:)*PCONC(:,4)+TPK%K095(:)*PCONC(:,3)+TPK%K0102(:)*PCON& -&C(:,16)+TPK%K109(:)*PCONC(:,33)+TPK%K111(:)*PCONC(:,34)+TPK%K112(:)*PCONC(:,35& -&)+TPK%K113(:)*PCONC(:,36)+TPK%K114(:)*PCONC(:,39)+TPK%K115(:)*PCONC(:,40)+TPK%& -&K115(:)*PCONC(:,40)+TPK%K116(:)*PCONC(:,41)+TPK%K124(:)*PCONC(:,5)+TPK%K128(:)& -&*PCONC(:,42) -! -RETURN -END SUBROUTINE SUB3 -! -SUBROUTINE SUB4 -! -!Indices 41 a 50 -! -! -!PPROD(OLN) = +0.00000*K074*<CARBO>*<NO3>+0.93768*K076*<ALKE>*<NO3>+1.00000*K07 -!7*<BIO>*<NO3> - PPROD(:,41) = +0.00000*TPK%K074(:)*PCONC(:,26)*PCONC(:,5)+0.93768*TPK%K076(:)*& -&PCONC(:,20)*PCONC(:,5)+1.00000*TPK%K077(:)*PCONC(:,21)*PCONC(:,5) -!PLOSS(OLN) = +K096*<NO>+K103*<HO2>+K110*<MO2>+K116*<CARBOP>+K117*<OLN>+K117*<O -!LN>+K118*<OLN>+K118*<OLN>+K125*<NO3> - PLOSS(:,41) = +TPK%K096(:)*PCONC(:,3)+TPK%K103(:)*PCONC(:,16)+TPK%K110(:)*PCON& -&C(:,33)+TPK%K116(:)*PCONC(:,40)+TPK%K117(:)*PCONC(:,41)+TPK%K117(:)*PCONC(:,41& -&)+TPK%K118(:)*PCONC(:,41)+TPK%K118(:)*PCONC(:,41)+TPK%K125(:)*PCONC(:,5) -! -!PPROD(XO2) = +0.15*K054*<BIO>*<O3P>+0.10318*K061*<ARO>*<OH>+0.10162*K065*<CARB -!O>*<OH>+0.09333*K069*<OP2>*<OH>+K070*<PAN>*<OH>+0.10530*K074*<CARBO>*<NO3>+K07 -!8*<PAN>*<NO3>+0.00000*K079*<ALKE>*<O3>+0.13000*K080*<BIO>*<O3>+0.13007*K091*<A -!LKAP>*<NO>+0.02563*K095*<CARBOP>*<NO>+0.13370*K105*<ALKAP>*<MO2>+0.02212*K109* -!<CARBOP>*<MO2>+0.11306*K111*<ALKAP>*<CARBOP>+0.01593*K115*<CARBOP>*<CARBOP>+0. -!16271*K120*<ALKAP>*<NO3>+0.01021*K124*<CARBOP>*<NO3> - PPROD(:,42) = +0.15*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:)+0.10318*TPK%K061(:)*PCO& -&NC(:,22)*PCONC(:,15)+0.10162*TPK%K065(:)*PCONC(:,26)*PCONC(:,15)+0.09333*TPK%K& -&069(:)*PCONC(:,30)*PCONC(:,15)+TPK%K070(:)*PCONC(:,28)*PCONC(:,15)+0.10530*TPK& -&%K074(:)*PCONC(:,26)*PCONC(:,5)+TPK%K078(:)*PCONC(:,28)*PCONC(:,5)+0.00000*TPK& -&%K079(:)*PCONC(:,20)*PCONC(:,1)+0.13000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.1& -&3007*TPK%K091(:)*PCONC(:,34)*PCONC(:,3)+0.02563*TPK%K095(:)*PCONC(:,40)*PCONC(& -&:,3)+0.13370*TPK%K105(:)*PCONC(:,34)*PCONC(:,33)+0.02212*TPK%K109(:)*PCONC(:,4& -&0)*PCONC(:,33)+0.11306*TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.01593*TPK%K115(:)& -&*PCONC(:,40)*PCONC(:,40)+0.16271*TPK%K120(:)*PCONC(:,34)*PCONC(:,5)+0.01021*TP& -&K%K124(:)*PCONC(:,40)*PCONC(:,5) -!PLOSS(XO2) = +K126*<HO2>+K127*<MO2>+K128*<CARBOP>+K129*<XO2>+K129*<XO2>+K130*< -!NO>+K131*<NO3> - PLOSS(:,42) = +TPK%K126(:)*PCONC(:,16)+TPK%K127(:)*PCONC(:,33)+TPK%K128(:)*PCO& -&NC(:,40)+TPK%K129(:)*PCONC(:,42)+TPK%K129(:)*PCONC(:,42)+TPK%K130(:)*PCONC(:,3& -&)+TPK%K131(:)*PCONC(:,5) -! -!PPROD(WC_O3) = +KTC1*<O3> - PPROD(:,43) = +TPK%KTC1(:)*PCONC(:,1) -!PLOSS(WC_O3) = +KTC21+KC6*<WC_HO2>+KC29*<WC_SO2> - PLOSS(:,43) = +TPK%KTC21(:)+TPK%KC6(:)*PCONC(:,54)+TPK%KC29(:)*PCONC(:,56) -! -!PPROD(WC_H2O2) = +KTC2*<H2O2>+KC2*<WC_OH>*<WC_OH>+KC5*<WC_HO2>*<WC_HO2> - PPROD(:,44) = +TPK%KTC2(:)*PCONC(:,2)+TPK%KC2(:)*PCONC(:,53)*PCONC(:,53)+TPK%K& -&C5(:)*PCONC(:,54)*PCONC(:,54) -!PLOSS(WC_H2O2) = +KTC22+KC1+KC4*<WC_OH>+KC30*<WC_SO2> - PLOSS(:,44) = +TPK%KTC22(:)+TPK%KC1(:)+TPK%KC4(:)*PCONC(:,53)+TPK%KC30(:)*PCON& -&C(:,56) -! -!PPROD(WC_NO) = +KTC3*<NO> - PPROD(:,45) = +TPK%KTC3(:)*PCONC(:,3) -!PLOSS(WC_NO) = +KTC23 - PLOSS(:,45) = +TPK%KTC23(:) -! -!PPROD(WC_NO2) = +KTC4*<NO2>+KC8*<WC_HONO>*<WC_OH>+KC10*<WC_HNO4>+KC13*<WC_HNO3 -!> - PPROD(:,46) = +TPK%KTC4(:)*PCONC(:,4)+TPK%KC8(:)*PCONC(:,49)*PCONC(:,53)+TPK%K& -&C10(:)*PCONC(:,51)+TPK%KC13(:)*PCONC(:,50) -!PLOSS(WC_NO2) = +KTC24+KC9*<WC_HO2> - PLOSS(:,46) = +TPK%KTC24(:)+TPK%KC9(:)*PCONC(:,54) -! -!PPROD(WC_NO3) = +KTC5*<NO3> - PPROD(:,47) = +TPK%KTC5(:)*PCONC(:,5) -!PLOSS(WC_NO3) = +KTC25+KC15*<WC_SULF>+KC16*<WC_SO2> - PLOSS(:,47) = +TPK%KTC25(:)+TPK%KC15(:)*PCONC(:,57)+TPK%KC16(:)*PCONC(:,56) -! -!PPROD(WC_N2O5) = +KTC6*<N2O5> - PPROD(:,48) = +TPK%KTC6(:)*PCONC(:,6) -!PLOSS(WC_N2O5) = +KTC26+KC14 - PLOSS(:,48) = +TPK%KTC26(:)+TPK%KC14(:) -! -!PPROD(WC_HONO) = +KTC7*<HONO>+KC11*<WC_HNO4> - PPROD(:,49) = +TPK%KTC7(:)*PCONC(:,7)+TPK%KC11(:)*PCONC(:,51) -!PLOSS(WC_HONO) = +KTC27+KC8*<WC_OH> - PLOSS(:,49) = +TPK%KTC27(:)+TPK%KC8(:)*PCONC(:,53) -! -!PPROD(WC_HNO3) = +KTC8*<HNO3>+KC12*<WC_HNO4>*<WC_SO2>+KC14*<WC_N2O5>+KC14*<WC_ -!N2O5>+KC15*<WC_NO3>*<WC_SULF>+KC16*<WC_NO3>*<WC_SO2> - PPROD(:,50) = +TPK%KTC8(:)*PCONC(:,8)+TPK%KC12(:)*PCONC(:,51)*PCONC(:,56)+TPK%& -&KC14(:)*PCONC(:,48)+TPK%KC14(:)*PCONC(:,48)+TPK%KC15(:)*PCONC(:,47)*PCONC(:,57& -&)+TPK%KC16(:)*PCONC(:,47)*PCONC(:,56) -!PLOSS(WC_HNO3) = +KTC28+KC13 - PLOSS(:,50) = +TPK%KTC28(:)+TPK%KC13(:) -! -RETURN -END SUBROUTINE SUB4 -! -SUBROUTINE SUB5 -! -!Indices 51 a 60 -! -! -!PPROD(WC_HNO4) = +KTC9*<HNO4>+KC9*<WC_NO2>*<WC_HO2> - PPROD(:,51) = +TPK%KTC9(:)*PCONC(:,9)+TPK%KC9(:)*PCONC(:,46)*PCONC(:,54) -!PLOSS(WC_HNO4) = +KTC29+KC10+KC11+KC12*<WC_SO2> - PLOSS(:,51) = +TPK%KTC29(:)+TPK%KC10(:)+TPK%KC11(:)+TPK%KC12(:)*PCONC(:,56) -! -!PPROD(WC_NH3) = +KTC10*<NH3> - PPROD(:,52) = +TPK%KTC10(:)*PCONC(:,10) -!PLOSS(WC_NH3) = +KTC30 - PLOSS(:,52) = +TPK%KTC30(:) -! -!PPROD(WC_OH) = +KTC11*<OH>+KC1*<WC_H2O2>+KC1*<WC_H2O2>+KC6*<WC_O3>*<WC_HO2>+KC -!13*<WC_HNO3>+KC28*<WC_ASO4> - PPROD(:,53) = +TPK%KTC11(:)*PCONC(:,15)+TPK%KC1(:)*PCONC(:,44)+TPK%KC1(:)*PCON& -&C(:,44)+TPK%KC6(:)*PCONC(:,43)*PCONC(:,54)+TPK%KC13(:)*PCONC(:,50)+TPK%KC28(:)& -&*PCONC(:,64) -!PLOSS(WC_OH) = +KTC31+KC2*<WC_OH>+KC2*<WC_OH>+KC3*<WC_HO2>+KC4*<WC_H2O2>+KC7*< -!WC_SO2>+KC8*<WC_HONO>+KC19*<WC_HCHO>+KC20*<WC_ORA1>+KC23*<WC_AHMS> - PLOSS(:,53) = +TPK%KTC31(:)+TPK%KC2(:)*PCONC(:,53)+TPK%KC2(:)*PCONC(:,53)+TPK%& -&KC3(:)*PCONC(:,54)+TPK%KC4(:)*PCONC(:,44)+TPK%KC7(:)*PCONC(:,56)+TPK%KC8(:)*PC& -&ONC(:,49)+TPK%KC19(:)*PCONC(:,58)+TPK%KC20(:)*PCONC(:,59)+TPK%KC23(:)*PCONC(:,& -&67) -! -!PPROD(WC_HO2) = +KTC12*<HO2>+KC4*<WC_H2O2>*<WC_OH>+KC10*<WC_HNO4>+2.00*KC17*<W -!C_MO2>*<WC_MO2>+KC19*<WC_HCHO>*<WC_OH>+KC20*<WC_ORA1>*<WC_OH>+KC23*<WC_AHMS>*< -!WC_OH> - PPROD(:,54) = +TPK%KTC12(:)*PCONC(:,16)+TPK%KC4(:)*PCONC(:,44)*PCONC(:,53)+TPK& -&%KC10(:)*PCONC(:,51)+2.00*TPK%KC17(:)*PCONC(:,61)*PCONC(:,61)+TPK%KC19(:)*PCON& -&C(:,58)*PCONC(:,53)+TPK%KC20(:)*PCONC(:,59)*PCONC(:,53)+TPK%KC23(:)*PCONC(:,67& -&)*PCONC(:,53) -!PLOSS(WC_HO2) = +KTC32+KC3*<WC_OH>+KC5*<WC_HO2>+KC5*<WC_HO2>+KC6*<WC_O3>+KC9*< -!WC_NO2>+KC25*<WC_ASO5> - PLOSS(:,54) = +TPK%KTC32(:)+TPK%KC3(:)*PCONC(:,53)+TPK%KC5(:)*PCONC(:,54)+TPK%& -&KC5(:)*PCONC(:,54)+TPK%KC6(:)*PCONC(:,43)+TPK%KC9(:)*PCONC(:,46)+TPK%KC25(:)*P& -&CONC(:,65) -! -!PPROD(WC_CO2) = +KTC13*<CO2>+KC20*<WC_ORA1>*<WC_OH> - PPROD(:,55) = +TPK%KTC13(:)*TPK%CO2(:)+TPK%KC20(:)*PCONC(:,59)*PCONC(:,53) -!PLOSS(WC_CO2) = +KTC33 - PLOSS(:,55) = +TPK%KTC33(:) -! -!PPROD(WC_SO2) = +KTC14*<SO2>+KC22*<WC_AHMS>+KC23*<WC_AHMS>*<WC_OH> - PPROD(:,56) = +TPK%KTC14(:)*PCONC(:,12)+TPK%KC22(:)*PCONC(:,67)+TPK%KC23(:)*PC& -&ONC(:,67)*PCONC(:,53) -!PLOSS(WC_SO2) = +KTC34+KC7*<WC_OH>+KC12*<WC_HNO4>+KC16*<WC_NO3>+KC18*<WC_MO2>+ -!KC21*<WC_HCHO>+KC27*<WC_AHSO5>+KC29*<WC_O3>+KC30*<WC_H2O2> - PLOSS(:,56) = +TPK%KTC34(:)+TPK%KC7(:)*PCONC(:,53)+TPK%KC12(:)*PCONC(:,51)+TPK& -&%KC16(:)*PCONC(:,47)+TPK%KC18(:)*PCONC(:,61)+TPK%KC21(:)*PCONC(:,58)+TPK%KC27(& -&:)*PCONC(:,66)+TPK%KC29(:)*PCONC(:,43)+TPK%KC30(:)*PCONC(:,44) -! -!PPROD(WC_SULF) = +KTC15*<SULF>+KC12*<WC_HNO4>*<WC_SO2>+2.00*KC27*<WC_AHSO5>*<W -!C_SO2>+KC28*<WC_ASO4>+KC29*<WC_SO2>*<WC_O3>+KC30*<WC_SO2>*<WC_H2O2> - PPROD(:,57) = +TPK%KTC15(:)*PCONC(:,13)+TPK%KC12(:)*PCONC(:,51)*PCONC(:,56)+2.& -&00*TPK%KC27(:)*PCONC(:,66)*PCONC(:,56)+TPK%KC28(:)*PCONC(:,64)+TPK%KC29(:)*PCO& -&NC(:,56)*PCONC(:,43)+TPK%KC30(:)*PCONC(:,56)*PCONC(:,44) -!PLOSS(WC_SULF) = +KTC35+KC15*<WC_NO3> - PLOSS(:,57) = +TPK%KTC35(:)+TPK%KC15(:)*PCONC(:,47) -! -!PPROD(WC_HCHO) = +KTC16*<HCHO>+2.00*KC17*<WC_MO2>*<WC_MO2>+KC22*<WC_AHMS> - PPROD(:,58) = +TPK%KTC16(:)*PCONC(:,23)+2.00*TPK%KC17(:)*PCONC(:,61)*PCONC(:,6& -&1)+TPK%KC22(:)*PCONC(:,67) -!PLOSS(WC_HCHO) = +KTC36+KC19*<WC_OH>+KC21*<WC_SO2> - PLOSS(:,58) = +TPK%KTC36(:)+TPK%KC19(:)*PCONC(:,53)+TPK%KC21(:)*PCONC(:,56) -! -!PPROD(WC_ORA1) = +KTC17*<ORA1>+KC19*<WC_HCHO>*<WC_OH>+KC23*<WC_AHMS>*<WC_OH> - PPROD(:,59) = +TPK%KTC17(:)*PCONC(:,31)+TPK%KC19(:)*PCONC(:,58)*PCONC(:,53)+TP& -&K%KC23(:)*PCONC(:,67)*PCONC(:,53) -!PLOSS(WC_ORA1) = +KTC37+KC20*<WC_OH> - PLOSS(:,59) = +TPK%KTC37(:)+TPK%KC20(:)*PCONC(:,53) -! -!PPROD(WC_ORA2) = +KTC18*<ORA2> - PPROD(:,60) = +TPK%KTC18(:)*PCONC(:,32) -!PLOSS(WC_ORA2) = +KTC38 - PLOSS(:,60) = +TPK%KTC38(:) -! -RETURN -END SUBROUTINE SUB5 -! -SUBROUTINE SUB6 -! -!Indices 61 a 70 -! -! -!PPROD(WC_MO2) = +KTC19*<MO2> - PPROD(:,61) = +TPK%KTC19(:)*PCONC(:,33) -!PLOSS(WC_MO2) = +KTC39+KC17*<WC_MO2>+KC17*<WC_MO2>+KC18*<WC_SO2> - PLOSS(:,61) = +TPK%KTC39(:)+TPK%KC17(:)*PCONC(:,61)+TPK%KC17(:)*PCONC(:,61)+TP& -&K%KC18(:)*PCONC(:,56) -! -!PPROD(WC_OP1) = +KTC20*<OP1>+KC18*<WC_MO2>*<WC_SO2> - PPROD(:,62) = +TPK%KTC20(:)*PCONC(:,29)+TPK%KC18(:)*PCONC(:,61)*PCONC(:,56) -!PLOSS(WC_OP1) = +KTC40 - PLOSS(:,62) = +TPK%KTC40(:) -! -!PPROD(WC_ASO3) = +KC7*<WC_OH>*<WC_SO2>+KC16*<WC_NO3>*<WC_SO2>+KC18*<WC_MO2>*<W -!C_SO2> - PPROD(:,63) = +TPK%KC7(:)*PCONC(:,53)*PCONC(:,56)+TPK%KC16(:)*PCONC(:,47)*PCON& -&C(:,56)+TPK%KC18(:)*PCONC(:,61)*PCONC(:,56) -!PLOSS(WC_ASO3) = +KC24*<W_O2> - PLOSS(:,63) = +TPK%KC24(:)*TPK%W_O2(:) -! -!PPROD(WC_ASO4) = +KC15*<WC_NO3>*<WC_SULF>+KC26*<WC_ASO5>*<WC_ASO5>+KC26*<WC_AS -!O5>*<WC_ASO5> - PPROD(:,64) = +TPK%KC15(:)*PCONC(:,47)*PCONC(:,57)+TPK%KC26(:)*PCONC(:,65)*PCO& -&NC(:,65)+TPK%KC26(:)*PCONC(:,65)*PCONC(:,65) -!PLOSS(WC_ASO4) = +KC28 - PLOSS(:,64) = +TPK%KC28(:) -! -!PPROD(WC_ASO5) = +KC24*<WC_ASO3>*<W_O2> - PPROD(:,65) = +TPK%KC24(:)*PCONC(:,63)*TPK%W_O2(:) -!PLOSS(WC_ASO5) = +KC25*<WC_HO2>+KC26*<WC_ASO5>+KC26*<WC_ASO5> - PLOSS(:,65) = +TPK%KC25(:)*PCONC(:,54)+TPK%KC26(:)*PCONC(:,65)+TPK%KC26(:)*PCO& -&NC(:,65) -! -!PPROD(WC_AHSO5) = +KC25*<WC_ASO5>*<WC_HO2> - PPROD(:,66) = +TPK%KC25(:)*PCONC(:,65)*PCONC(:,54) -!PLOSS(WC_AHSO5) = +KC27*<WC_SO2> - PLOSS(:,66) = +TPK%KC27(:)*PCONC(:,56) -! -!PPROD(WC_AHMS) = +KC21*<WC_SO2>*<WC_HCHO> - PPROD(:,67) = +TPK%KC21(:)*PCONC(:,56)*PCONC(:,58) -!PLOSS(WC_AHMS) = +KC22+KC23*<WC_OH> - PLOSS(:,67) = +TPK%KC22(:)+TPK%KC23(:)*PCONC(:,53) -! -!PPROD(WR_O3) = +KTR1*<O3> - PPROD(:,68) = +TPK%KTR1(:)*PCONC(:,1) -!PLOSS(WR_O3) = +KTR21+KR6*<WR_HO2>+KR29*<WR_SO2> - PLOSS(:,68) = +TPK%KTR21(:)+TPK%KR6(:)*PCONC(:,79)+TPK%KR29(:)*PCONC(:,81) -! -!PPROD(WR_H2O2) = +KTR2*<H2O2>+KR2*<WR_OH>*<WR_OH>+KR5*<WR_HO2>*<WR_HO2> - PPROD(:,69) = +TPK%KTR2(:)*PCONC(:,2)+TPK%KR2(:)*PCONC(:,78)*PCONC(:,78)+TPK%K& -&R5(:)*PCONC(:,79)*PCONC(:,79) -!PLOSS(WR_H2O2) = +KTR22+KR1+KR4*<WR_OH>+KR30*<WR_SO2> - PLOSS(:,69) = +TPK%KTR22(:)+TPK%KR1(:)+TPK%KR4(:)*PCONC(:,78)+TPK%KR30(:)*PCON& -&C(:,81) -! -!PPROD(WR_NO) = +KTR3*<NO> - PPROD(:,70) = +TPK%KTR3(:)*PCONC(:,3) -!PLOSS(WR_NO) = +KTR23 - PLOSS(:,70) = +TPK%KTR23(:) -! -RETURN -END SUBROUTINE SUB6 -! -SUBROUTINE SUB7 -! -!Indices 71 a 80 -! -! -!PPROD(WR_NO2) = +KTR4*<NO2>+KR8*<WR_HONO>*<WR_OH>+KR10*<WR_HNO4>+KR13*<WR_HNO3 -!> - PPROD(:,71) = +TPK%KTR4(:)*PCONC(:,4)+TPK%KR8(:)*PCONC(:,74)*PCONC(:,78)+TPK%K& -&R10(:)*PCONC(:,76)+TPK%KR13(:)*PCONC(:,75) -!PLOSS(WR_NO2) = +KTR24+KR9*<WR_HO2> - PLOSS(:,71) = +TPK%KTR24(:)+TPK%KR9(:)*PCONC(:,79) -! -!PPROD(WR_NO3) = +KTR5*<NO3> - PPROD(:,72) = +TPK%KTR5(:)*PCONC(:,5) -!PLOSS(WR_NO3) = +KTR25+KR15*<WR_SULF>+KR16*<WR_SO2> - PLOSS(:,72) = +TPK%KTR25(:)+TPK%KR15(:)*PCONC(:,82)+TPK%KR16(:)*PCONC(:,81) -! -!PPROD(WR_N2O5) = +KTR6*<N2O5> - PPROD(:,73) = +TPK%KTR6(:)*PCONC(:,6) -!PLOSS(WR_N2O5) = +KTR26+KR14 - PLOSS(:,73) = +TPK%KTR26(:)+TPK%KR14(:) -! -!PPROD(WR_HONO) = +KTR7*<HONO>+KR11*<WR_HNO4> - PPROD(:,74) = +TPK%KTR7(:)*PCONC(:,7)+TPK%KR11(:)*PCONC(:,76) -!PLOSS(WR_HONO) = +KTR27+KR8*<WR_OH> - PLOSS(:,74) = +TPK%KTR27(:)+TPK%KR8(:)*PCONC(:,78) -! -!PPROD(WR_HNO3) = +KTR8*<HNO3>+KR12*<WR_HNO4>*<WR_SO2>+KR14*<WR_N2O5>+KR14*<WR_ -!N2O5>+KR15*<WR_NO3>*<WR_SULF>+KR16*<WR_NO3>*<WR_SO2> - PPROD(:,75) = +TPK%KTR8(:)*PCONC(:,8)+TPK%KR12(:)*PCONC(:,76)*PCONC(:,81)+TPK%& -&KR14(:)*PCONC(:,73)+TPK%KR14(:)*PCONC(:,73)+TPK%KR15(:)*PCONC(:,72)*PCONC(:,82& -&)+TPK%KR16(:)*PCONC(:,72)*PCONC(:,81) -!PLOSS(WR_HNO3) = +KTR28+KR13 - PLOSS(:,75) = +TPK%KTR28(:)+TPK%KR13(:) -! -!PPROD(WR_HNO4) = +KTR9*<HNO4>+KR9*<WR_NO2>*<WR_HO2> - PPROD(:,76) = +TPK%KTR9(:)*PCONC(:,9)+TPK%KR9(:)*PCONC(:,71)*PCONC(:,79) -!PLOSS(WR_HNO4) = +KTR29+KR10+KR11+KR12*<WR_SO2> - PLOSS(:,76) = +TPK%KTR29(:)+TPK%KR10(:)+TPK%KR11(:)+TPK%KR12(:)*PCONC(:,81) -! -!PPROD(WR_NH3) = +KTR10*<NH3> - PPROD(:,77) = +TPK%KTR10(:)*PCONC(:,10) -!PLOSS(WR_NH3) = +KTR30 - PLOSS(:,77) = +TPK%KTR30(:) -! -!PPROD(WR_OH) = +KTR11*<OH>+KR1*<WR_H2O2>+KR1*<WR_H2O2>+KR6*<WR_O3>*<WR_HO2>+KR -!13*<WR_HNO3>+KR28*<WR_ASO4> - PPROD(:,78) = +TPK%KTR11(:)*PCONC(:,15)+TPK%KR1(:)*PCONC(:,69)+TPK%KR1(:)*PCON& -&C(:,69)+TPK%KR6(:)*PCONC(:,68)*PCONC(:,79)+TPK%KR13(:)*PCONC(:,75)+TPK%KR28(:)& -&*PCONC(:,89) -!PLOSS(WR_OH) = +KTR31+KR2*<WR_OH>+KR2*<WR_OH>+KR3*<WR_HO2>+KR4*<WR_H2O2>+KR7*< -!WR_SO2>+KR8*<WR_HONO>+KR19*<WR_HCHO>+KR20*<WR_ORA1>+KR23*<WR_AHMS> - PLOSS(:,78) = +TPK%KTR31(:)+TPK%KR2(:)*PCONC(:,78)+TPK%KR2(:)*PCONC(:,78)+TPK%& -&KR3(:)*PCONC(:,79)+TPK%KR4(:)*PCONC(:,69)+TPK%KR7(:)*PCONC(:,81)+TPK%KR8(:)*PC& -&ONC(:,74)+TPK%KR19(:)*PCONC(:,83)+TPK%KR20(:)*PCONC(:,84)+TPK%KR23(:)*PCONC(:,& -&92) -! -!PPROD(WR_HO2) = +KTR12*<HO2>+KR4*<WR_H2O2>*<WR_OH>+KR10*<WR_HNO4>+2.00*KR17*<W -!R_MO2>*<WR_MO2>+KR19*<WR_HCHO>*<WR_OH>+KR20*<WR_ORA1>*<WR_OH>+KR23*<WR_AHMS>*< -!WR_OH> - PPROD(:,79) = +TPK%KTR12(:)*PCONC(:,16)+TPK%KR4(:)*PCONC(:,69)*PCONC(:,78)+TPK& -&%KR10(:)*PCONC(:,76)+2.00*TPK%KR17(:)*PCONC(:,86)*PCONC(:,86)+TPK%KR19(:)*PCON& -&C(:,83)*PCONC(:,78)+TPK%KR20(:)*PCONC(:,84)*PCONC(:,78)+TPK%KR23(:)*PCONC(:,92& -&)*PCONC(:,78) -!PLOSS(WR_HO2) = +KTR32+KR3*<WR_OH>+KR5*<WR_HO2>+KR5*<WR_HO2>+KR6*<WR_O3>+KR9*< -!WR_NO2>+KR25*<WR_ASO5> - PLOSS(:,79) = +TPK%KTR32(:)+TPK%KR3(:)*PCONC(:,78)+TPK%KR5(:)*PCONC(:,79)+TPK%& -&KR5(:)*PCONC(:,79)+TPK%KR6(:)*PCONC(:,68)+TPK%KR9(:)*PCONC(:,71)+TPK%KR25(:)*P& -&CONC(:,90) -! -!PPROD(WR_CO2) = +KTR13*<CO2>+KR20*<WR_ORA1>*<WR_OH> - PPROD(:,80) = +TPK%KTR13(:)*TPK%CO2(:)+TPK%KR20(:)*PCONC(:,84)*PCONC(:,78) -!PLOSS(WR_CO2) = +KTR33 - PLOSS(:,80) = +TPK%KTR33(:) -! -RETURN -END SUBROUTINE SUB7 -! -SUBROUTINE SUB8 -! -!Indices 81 a 90 -! -! -!PPROD(WR_SO2) = +KTR14*<SO2>+KR22*<WR_AHMS>+KR23*<WR_AHMS>*<WR_OH> - PPROD(:,81) = +TPK%KTR14(:)*PCONC(:,12)+TPK%KR22(:)*PCONC(:,92)+TPK%KR23(:)*PC& -&ONC(:,92)*PCONC(:,78) -!PLOSS(WR_SO2) = +KTR34+KR7*<WR_OH>+KR12*<WR_HNO4>+KR16*<WR_NO3>+KR18*<WR_MO2>+ -!KR21*<WR_HCHO>+KR27*<WR_AHSO5>+KR29*<WR_O3>+KR30*<WR_H2O2> - PLOSS(:,81) = +TPK%KTR34(:)+TPK%KR7(:)*PCONC(:,78)+TPK%KR12(:)*PCONC(:,76)+TPK& -&%KR16(:)*PCONC(:,72)+TPK%KR18(:)*PCONC(:,86)+TPK%KR21(:)*PCONC(:,83)+TPK%KR27(& -&:)*PCONC(:,91)+TPK%KR29(:)*PCONC(:,68)+TPK%KR30(:)*PCONC(:,69) -! -!PPROD(WR_SULF) = +KTR15*<SULF>+KR12*<WR_HNO4>*<WR_SO2>+2.00*KR27*<WR_AHSO5>*<W -!R_SO2>+KR28*<WR_ASO4>+KR29*<WR_SO2>*<WR_O3>+KR30*<WR_SO2>*<WR_H2O2> - PPROD(:,82) = +TPK%KTR15(:)*PCONC(:,13)+TPK%KR12(:)*PCONC(:,76)*PCONC(:,81)+2.& -&00*TPK%KR27(:)*PCONC(:,91)*PCONC(:,81)+TPK%KR28(:)*PCONC(:,89)+TPK%KR29(:)*PCO& -&NC(:,81)*PCONC(:,68)+TPK%KR30(:)*PCONC(:,81)*PCONC(:,69) -!PLOSS(WR_SULF) = +KTR35+KR15*<WR_NO3> - PLOSS(:,82) = +TPK%KTR35(:)+TPK%KR15(:)*PCONC(:,72) -! -!PPROD(WR_HCHO) = +KTR16*<HCHO>+2.00*KR17*<WR_MO2>*<WR_MO2>+KR22*<WR_AHMS> - PPROD(:,83) = +TPK%KTR16(:)*PCONC(:,23)+2.00*TPK%KR17(:)*PCONC(:,86)*PCONC(:,8& -&6)+TPK%KR22(:)*PCONC(:,92) -!PLOSS(WR_HCHO) = +KTR36+KR19*<WR_OH>+KR21*<WR_SO2> - PLOSS(:,83) = +TPK%KTR36(:)+TPK%KR19(:)*PCONC(:,78)+TPK%KR21(:)*PCONC(:,81) -! -!PPROD(WR_ORA1) = +KTR17*<ORA1>+KR19*<WR_HCHO>*<WR_OH>+KR23*<WR_AHMS>*<WR_OH> - PPROD(:,84) = +TPK%KTR17(:)*PCONC(:,31)+TPK%KR19(:)*PCONC(:,83)*PCONC(:,78)+TP& -&K%KR23(:)*PCONC(:,92)*PCONC(:,78) -!PLOSS(WR_ORA1) = +KTR37+KR20*<WR_OH> - PLOSS(:,84) = +TPK%KTR37(:)+TPK%KR20(:)*PCONC(:,78) -! -!PPROD(WR_ORA2) = +KTR18*<ORA2> - PPROD(:,85) = +TPK%KTR18(:)*PCONC(:,32) -!PLOSS(WR_ORA2) = +KTR38 - PLOSS(:,85) = +TPK%KTR38(:) -! -!PPROD(WR_MO2) = +KTR19*<MO2> - PPROD(:,86) = +TPK%KTR19(:)*PCONC(:,33) -!PLOSS(WR_MO2) = +KTR39+KR17*<WR_MO2>+KR17*<WR_MO2>+KR18*<WR_SO2> - PLOSS(:,86) = +TPK%KTR39(:)+TPK%KR17(:)*PCONC(:,86)+TPK%KR17(:)*PCONC(:,86)+TP& -&K%KR18(:)*PCONC(:,81) -! -!PPROD(WR_OP1) = +KTR20*<OP1>+KR18*<WR_MO2>*<WR_SO2> - PPROD(:,87) = +TPK%KTR20(:)*PCONC(:,29)+TPK%KR18(:)*PCONC(:,86)*PCONC(:,81) -!PLOSS(WR_OP1) = +KTR40 - PLOSS(:,87) = +TPK%KTR40(:) -! -!PPROD(WR_ASO3) = +KR7*<WR_OH>*<WR_SO2>+KR16*<WR_NO3>*<WR_SO2>+KR18*<WR_MO2>*<W -!R_SO2> - PPROD(:,88) = +TPK%KR7(:)*PCONC(:,78)*PCONC(:,81)+TPK%KR16(:)*PCONC(:,72)*PCON& -&C(:,81)+TPK%KR18(:)*PCONC(:,86)*PCONC(:,81) -!PLOSS(WR_ASO3) = +KR24*<W_O2> - PLOSS(:,88) = +TPK%KR24(:)*TPK%W_O2(:) -! -!PPROD(WR_ASO4) = +KR15*<WR_NO3>*<WR_SULF>+KR26*<WR_ASO5>*<WR_ASO5>+KR26*<WR_AS -!O5>*<WR_ASO5> - PPROD(:,89) = +TPK%KR15(:)*PCONC(:,72)*PCONC(:,82)+TPK%KR26(:)*PCONC(:,90)*PCO& -&NC(:,90)+TPK%KR26(:)*PCONC(:,90)*PCONC(:,90) -!PLOSS(WR_ASO4) = +KR28 - PLOSS(:,89) = +TPK%KR28(:) -! -!PPROD(WR_ASO5) = +KR24*<WR_ASO3>*<W_O2> - PPROD(:,90) = +TPK%KR24(:)*PCONC(:,88)*TPK%W_O2(:) -!PLOSS(WR_ASO5) = +KR25*<WR_HO2>+KR26*<WR_ASO5>+KR26*<WR_ASO5> - PLOSS(:,90) = +TPK%KR25(:)*PCONC(:,79)+TPK%KR26(:)*PCONC(:,90)+TPK%KR26(:)*PCO& -&NC(:,90) -! -RETURN -END SUBROUTINE SUB8 -! -SUBROUTINE SUB9 -! -!Indices 91 a 92 -! -! -!PPROD(WR_AHSO5) = +KR25*<WR_ASO5>*<WR_HO2> - PPROD(:,91) = +TPK%KR25(:)*PCONC(:,90)*PCONC(:,79) -!PLOSS(WR_AHSO5) = +KR27*<WR_SO2> - PLOSS(:,91) = +TPK%KR27(:)*PCONC(:,81) -! -!PPROD(WR_AHMS) = +KR21*<WR_SO2>*<WR_HCHO> - PPROD(:,92) = +TPK%KR21(:)*PCONC(:,81)*PCONC(:,83) -!PLOSS(WR_AHMS) = +KR22+KR23*<WR_OH> - PLOSS(:,92) = +TPK%KR22(:)+TPK%KR23(:)*PCONC(:,78) -! -RETURN -END SUBROUTINE SUB9 -! -END SUBROUTINE CH_PRODLOSS_AQ -! -! -!======================================================================== -! -!! ########################## - MODULE MODI_CH_PRODLOSS_GAZ -!! ########################## -INTERFACE -SUBROUTINE CH_PRODLOSS_GAZ(PTIME,PCONC,PPROD,PLOSS,KMI,KVECNPT,KEQ) -IMPLICIT NONE -REAL, INTENT(IN) :: PTIME -INTEGER, INTENT(IN) :: KVECNPT -INTEGER, INTENT(IN) :: KEQ -REAL, INTENT(IN), DIMENSION(KVECNPT,KEQ) :: PCONC -REAL, INTENT(OUT), DIMENSION(KVECNPT,KEQ) :: PPROD, PLOSS -INTEGER, INTENT(IN) :: KMI -END SUBROUTINE CH_PRODLOSS_GAZ -END INTERFACE -END MODULE MODI_CH_PRODLOSS_GAZ -! -!======================================================================== -! -!! ################################################################## - SUBROUTINE CH_PRODLOSS_GAZ(PTIME,PCONC,PPROD,PLOSS,KMI,KVECNPT,KEQ) -!! ################################################################## -!! This code has been created automatically by preprocessor m10, -!! version: 9.7, copyright 1995-1999 by Meteo France/Universite Paul Sabatier. -!! Please report all bugs to K. Suhre (Lab. d'Aerologie UPS/CNRS). -!! -!!*** *MODD_CH_PRODLOSS* -!! -!! PURPOSE -!! ------- -! calculation of production and loss terms for diagnostics -!! -!!** METHOD -!! ------ -!! The terms of temporal derivative of the chemical species, -!! written as: -!! d/dt PCONC = CH_FCN = PPROD - PCONC*PLOSS, -!! are calculated for diagnostic purposes. -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Karsten Suhre (LA) -!! -!! MODIFICATIONS -!! ------------- -!! Original 26/07/96 -!! Modified 05/05/98: Vectorization (Vincent Crassier & KS) -!! Modified 31/10/03: New interface for better MesoNH compilation (D. Gazen) -!! -!!---------------------------------------------------------------------- -!! -!! EXTERNAL -!! -------- -!! none -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -USE MODD_CH_M9_SCHEME -!! -!! EXPLICIT ARGUMENTS -!! ------------------ -IMPLICIT NONE -REAL, INTENT(IN) :: PTIME -INTEGER, INTENT(IN) :: KVECNPT -INTEGER, INTENT(IN) :: KEQ -REAL, INTENT(IN), DIMENSION(KVECNPT,KEQ) :: PCONC -REAL, INTENT(OUT), DIMENSION(KVECNPT,KEQ) :: PPROD, PLOSS -INTEGER, INTENT(IN) :: KMI -TYPE(CCSTYPE), POINTER :: TPK -TPK=>TACCS(KMI) -! /BEGIN_CODE/ -TPK%O1D(:)=(TPK%K002(:)*PCONC(:,JP_O3))/(TPK%K020(:)*TPK%N2(:)+TPK%K021(:)*TPK%O2(:)+& - &TPK%K022(:)*TPK%H2O(:)) -TPK%O3P(:)=(TPK%K001(:)*PCONC(:,JP_NO2)+TPK%K003(:)*PCONC(:,JP_O3)+TPK%K008(:)*PCONC(:,JP_NO3)+& - &TPK%K020(:)*TPK%O1D(:)*TPK%N2(:)+TPK%K021(:)*TPK%O1D(:)*TPK%O2(:)+& - &0.00000*TPK%K079(:)*PCONC(:,JP_ALKE)*PCONC(:,JP_O3)+& - &0.09000*TPK%K080(:)*PCONC(:,JP_BIO)*PCONC(:,JP_O3))/& - &(TPK%K018(:)*TPK%O2(:)+TPK%K019(:)*PCONC(:,JP_O3)+TPK%K029(:)*PCONC(:,JP_NO)+& - &TPK%K030(:)*PCONC(:,JP_NO2)+TPK%K031(:)*PCONC(:,JP_NO2)+TPK%K054(:)*PCONC(:,JP_BIO)+& - &TPK%K055(:)*PCONC(:,JP_CARBO)+TPK%K134(:)*PCONC(:,JP_DMS)) -! /END_CODE/ -CALL SUB0 -CALL SUB1 -CALL SUB2 -CALL SUB3 -CALL SUB4 - -CONTAINS - -SUBROUTINE SUB0 -! -!Indices 1 a 10 -! -! -!PPROD(O3) = +K018*<O3P>*<O2>+0.17307*K0102*<CARBOP>*<HO2> - PPROD(:,1) = +TPK%K018(:)*TPK%O3P(:)*TPK%O2(:)+0.17307*TPK%K0102(:)*PCONC(:,40& -&)*PCONC(:,16) -!PLOSS(O3) = +K002+K003+K019*<O3P>+K023*<OH>+K024*<HO2>+K042*<NO>+K043*<NO2>+K0 -!79*<ALKE>+K080*<BIO>+K081*<CARBO>+K082*<PAN>+K087*<ADD> - PLOSS(:,1) = +TPK%K002(:)+TPK%K003(:)+TPK%K019(:)*TPK%O3P(:)+TPK%K023(:)*PCONC& -&(:,15)+TPK%K024(:)*PCONC(:,16)+TPK%K042(:)*PCONC(:,3)+TPK%K043(:)*PCONC(:,4)+T& -&PK%K079(:)*PCONC(:,20)+TPK%K080(:)*PCONC(:,21)+TPK%K081(:)*PCONC(:,26)+TPK%K08& -&2(:)*PCONC(:,28)+TPK%K087(:)*PCONC(:,38) -! -!PPROD(H2O2) = +K027*<HO2>*<HO2>+K028*<HO2>*<HO2>*<H2O>+0.01833*K079*<ALKE>*<O3 -!>+0.00100*K080*<BIO>*<O3> - PPROD(:,2) = +TPK%K027(:)*PCONC(:,16)*PCONC(:,16)+TPK%K028(:)*PCONC(:,16)*PCON& -&C(:,16)*TPK%H2O(:)+0.01833*TPK%K079(:)*PCONC(:,20)*PCONC(:,1)+0.00100*TPK%K080& -&(:)*PCONC(:,21)*PCONC(:,1) -!PLOSS(H2O2) = +K009+K026*<OH> - PLOSS(:,2) = +TPK%K009(:)+TPK%K026(:)*PCONC(:,15) -! -!PPROD(NO) = +K001*<NO2>+K004*<HONO>+K007*<NO3>+K030*<O3P>*<NO2>+K046*<NO3>*<NO -!2> - PPROD(:,3) = +TPK%K001(:)*PCONC(:,4)+TPK%K004(:)*PCONC(:,7)+TPK%K007(:)*PCONC(& -&:,5)+TPK%K030(:)*TPK%O3P(:)*PCONC(:,4)+TPK%K046(:)*PCONC(:,5)*PCONC(:,4) -!PLOSS(NO) = +K029*<O3P>+K032*<OH>+K035*<HO2>+K042*<O3>+K044*<NO>*<O2>+K044*<NO -!>*<O2>+K045*<NO3>+K090*<MO2>+K091*<ALKAP>+K092*<ALKEP>+K093*<BIOP>+K094*<AROP> -!+K095*<CARBOP>+K096*<OLN>+K130*<XO2> - PLOSS(:,3) = +TPK%K029(:)*TPK%O3P(:)+TPK%K032(:)*PCONC(:,15)+TPK%K035(:)*PCONC& -&(:,16)+TPK%K042(:)*PCONC(:,1)+TPK%K044(:)*PCONC(:,3)*TPK%O2(:)+TPK%K044(:)*PCO& -&NC(:,3)*TPK%O2(:)+TPK%K045(:)*PCONC(:,5)+TPK%K090(:)*PCONC(:,33)+TPK%K091(:)*P& -&CONC(:,34)+TPK%K092(:)*PCONC(:,35)+TPK%K093(:)*PCONC(:,36)+TPK%K094(:)*PCONC(:& -&,39)+TPK%K095(:)*PCONC(:,40)+TPK%K096(:)*PCONC(:,41)+TPK%K130(:)*PCONC(:,42) -! -!PPROD(NO2) = +K005*<HNO3>+0.65*K006*<HNO4>+K008*<NO3>+K017*<ONIT>+K029*<O3P>*< -!NO>+K034*<OH>*<NO3>+K035*<HO2>*<NO>+K037*<HNO4>+0.7*K038*<HO2>*<NO3>+K039*<OH> -!*<HONO>+K041*<OH>*<HNO4>+K042*<O3>*<NO>+K044*<NO>*<NO>*<O2>+K044*<NO>*<NO>*<O2 -!>+K045*<NO3>*<NO>+K045*<NO3>*<NO>+K046*<NO3>*<NO2>+K048*<N2O5>+K049*<NO3>*<NO3 -!>+K049*<NO3>*<NO3>+K071*<ONIT>*<OH>+0.10530*K074*<CARBO>*<NO3>+0.40*K078*<PAN> -!*<NO3>+0.70*K082*<PAN>*<O3>+K089*<PAN>+K090*<MO2>*<NO>+0.91541*K091*<ALKAP>*<N -!O>+K092*<ALKEP>*<NO>+0.84700*K093*<BIOP>*<NO>+0.95115*K094*<AROP>*<NO>+K095*<C -!ARBOP>*<NO>+1.81599*K096*<OLN>*<NO>+0.32440*K110*<OLN>*<MO2>+0.00000*K116*<OLN -!>*<CARBOP>+0.00000*K118*<OLN>*<OLN>+K119*<MO2>*<NO3>+K120*<ALKAP>*<NO3>+K121*< -!ALKEP>*<NO3>+K122*<BIOP>*<NO3>+K123*<AROP>*<NO3>+K124*<CARBOP>*<NO3>+1.74072*K -!125*<OLN>*<NO3>+K130*<XO2>*<NO>+K131*<XO2>*<NO3>+K133*<DMS>*<NO3> - PPROD(:,4) = +TPK%K005(:)*PCONC(:,8)+0.65*TPK%K006(:)*PCONC(:,9)+TPK%K008(:)*P& -&CONC(:,5)+TPK%K017(:)*PCONC(:,27)+TPK%K029(:)*TPK%O3P(:)*PCONC(:,3)+TPK%K034(:& -&)*PCONC(:,15)*PCONC(:,5)+TPK%K035(:)*PCONC(:,16)*PCONC(:,3)+TPK%K037(:)*PCONC(& -&:,9)+0.7*TPK%K038(:)*PCONC(:,16)*PCONC(:,5)+TPK%K039(:)*PCONC(:,15)*PCONC(:,7)& -&+TPK%K041(:)*PCONC(:,15)*PCONC(:,9)+TPK%K042(:)*PCONC(:,1)*PCONC(:,3)+TPK%K044& -&(:)*PCONC(:,3)*PCONC(:,3)*TPK%O2(:)+TPK%K044(:)*PCONC(:,3)*PCONC(:,3)*TPK%O2(:& -&)+TPK%K045(:)*PCONC(:,5)*PCONC(:,3)+TPK%K045(:)*PCONC(:,5)*PCONC(:,3)+TPK%K046& -&(:)*PCONC(:,5)*PCONC(:,4)+TPK%K048(:)*PCONC(:,6)+TPK%K049(:)*PCONC(:,5)*PCONC(& -&:,5)+TPK%K049(:)*PCONC(:,5)*PCONC(:,5)+TPK%K071(:)*PCONC(:,27)*PCONC(:,15)+0.1& -&0530*TPK%K074(:)*PCONC(:,26)*PCONC(:,5)+0.40*TPK%K078(:)*PCONC(:,28)*PCONC(:,5& -&)+0.70*TPK%K082(:)*PCONC(:,28)*PCONC(:,1)+TPK%K089(:)*PCONC(:,28)+TPK%K090(:)*& -&PCONC(:,33)*PCONC(:,3)+0.91541*TPK%K091(:)*PCONC(:,34)*PCONC(:,3)+TPK%K092(:)*& -&PCONC(:,35)*PCONC(:,3)+0.84700*TPK%K093(:)*PCONC(:,36)*PCONC(:,3)+0.95115*TPK%& -&K094(:)*PCONC(:,39)*PCONC(:,3)+TPK%K095(:)*PCONC(:,40)*PCONC(:,3)+1.81599*TPK%& -&K096(:)*PCONC(:,41)*PCONC(:,3)+0.32440*TPK%K110(:)*PCONC(:,41)*PCONC(:,33)+0.0& -&0000*TPK%K116(:)*PCONC(:,41)*PCONC(:,40)+0.00000*TPK%K118(:)*PCONC(:,41)*PCONC& -&(:,41)+TPK%K119(:)*PCONC(:,33)*PCONC(:,5)+TPK%K120(:)*PCONC(:,34)*PCONC(:,5)+T& -&PK%K121(:)*PCONC(:,35)*PCONC(:,5)+TPK%K122(:)*PCONC(:,36)*PCONC(:,5)+TPK%K123(& -&:)*PCONC(:,39)*PCONC(:,5)+TPK%K124(:)*PCONC(:,40)*PCONC(:,5)+1.74072*TPK%K125(& -&:)*PCONC(:,41)*PCONC(:,5)+TPK%K130(:)*PCONC(:,42)*PCONC(:,3)+TPK%K131(:)*PCONC& -&(:,42)*PCONC(:,5)+TPK%K133(:)*PCONC(:,11)*PCONC(:,5) -!PLOSS(NO2) = +K001+K030*<O3P>+K031*<O3P>+K033*<OH>+K036*<HO2>+K043*<O3>+K046*< -!NO3>+K047*<NO3>+K083*<PHO>+K085*<ADD>+K088*<CARBOP> - PLOSS(:,4) = +TPK%K001(:)+TPK%K030(:)*TPK%O3P(:)+TPK%K031(:)*TPK%O3P(:)+TPK%K0& -&33(:)*PCONC(:,15)+TPK%K036(:)*PCONC(:,16)+TPK%K043(:)*PCONC(:,1)+TPK%K046(:)*P& -&CONC(:,5)+TPK%K047(:)*PCONC(:,5)+TPK%K083(:)*PCONC(:,37)+TPK%K085(:)*PCONC(:,3& -&8)+TPK%K088(:)*PCONC(:,40) -! -!PPROD(NO3) = +0.35*K006*<HNO4>+K031*<O3P>*<NO2>+K040*<OH>*<HNO3>+K043*<O3>*<NO -!2>+K048*<N2O5>+0.71893*K070*<PAN>*<OH>+0.60*K078*<PAN>*<NO3> - PPROD(:,5) = +0.35*TPK%K006(:)*PCONC(:,9)+TPK%K031(:)*TPK%O3P(:)*PCONC(:,4)+TP& -&K%K040(:)*PCONC(:,15)*PCONC(:,8)+TPK%K043(:)*PCONC(:,1)*PCONC(:,4)+TPK%K048(:)& -&*PCONC(:,6)+0.71893*TPK%K070(:)*PCONC(:,28)*PCONC(:,15)+0.60*TPK%K078(:)*PCONC& -&(:,28)*PCONC(:,5) -!PLOSS(NO3) = +K007+K008+K034*<OH>+K038*<HO2>+K045*<NO>+K046*<NO2>+K047*<NO2>+K -!049*<NO3>+K049*<NO3>+K072*<HCHO>+K073*<ALD>+K074*<CARBO>+K075*<ARO>+K076*<ALKE -!>+K077*<BIO>+K078*<PAN>+K119*<MO2>+K120*<ALKAP>+K121*<ALKEP>+K122*<BIOP>+K123* -!<AROP>+K124*<CARBOP>+K125*<OLN>+K131*<XO2>+K133*<DMS> - PLOSS(:,5) = +TPK%K007(:)+TPK%K008(:)+TPK%K034(:)*PCONC(:,15)+TPK%K038(:)*PCON& -&C(:,16)+TPK%K045(:)*PCONC(:,3)+TPK%K046(:)*PCONC(:,4)+TPK%K047(:)*PCONC(:,4)+T& -&PK%K049(:)*PCONC(:,5)+TPK%K049(:)*PCONC(:,5)+TPK%K072(:)*PCONC(:,23)+TPK%K073(& -&:)*PCONC(:,24)+TPK%K074(:)*PCONC(:,26)+TPK%K075(:)*PCONC(:,22)+TPK%K076(:)*PCO& -&NC(:,20)+TPK%K077(:)*PCONC(:,21)+TPK%K078(:)*PCONC(:,28)+TPK%K119(:)*PCONC(:,3& -&3)+TPK%K120(:)*PCONC(:,34)+TPK%K121(:)*PCONC(:,35)+TPK%K122(:)*PCONC(:,36)+TPK& -&%K123(:)*PCONC(:,39)+TPK%K124(:)*PCONC(:,40)+TPK%K125(:)*PCONC(:,41)+TPK%K131(& -&:)*PCONC(:,42)+TPK%K133(:)*PCONC(:,11) -! -!PPROD(N2O5) = +K047*<NO3>*<NO2> - PPROD(:,6) = +TPK%K047(:)*PCONC(:,5)*PCONC(:,4) -!PLOSS(N2O5) = +K048 - PLOSS(:,6) = +TPK%K048(:) -! -!PPROD(HONO) = +K032*<OH>*<NO>+K085*<ADD>*<NO2> - PPROD(:,7) = +TPK%K032(:)*PCONC(:,15)*PCONC(:,3)+TPK%K085(:)*PCONC(:,38)*PCONC& -&(:,4) -!PLOSS(HONO) = +K004+K039*<OH> - PLOSS(:,7) = +TPK%K004(:)+TPK%K039(:)*PCONC(:,15) -! -!PPROD(HNO3) = +K033*<OH>*<NO2>+0.3*K038*<HO2>*<NO3>+K072*<HCHO>*<NO3>+K073*<AL -!D>*<NO3>+0.91567*K074*<CARBO>*<NO3>+K075*<ARO>*<NO3> - PPROD(:,8) = +TPK%K033(:)*PCONC(:,15)*PCONC(:,4)+0.3*TPK%K038(:)*PCONC(:,16)*P& -&CONC(:,5)+TPK%K072(:)*PCONC(:,23)*PCONC(:,5)+TPK%K073(:)*PCONC(:,24)*PCONC(:,5& -&)+0.91567*TPK%K074(:)*PCONC(:,26)*PCONC(:,5)+TPK%K075(:)*PCONC(:,22)*PCONC(:,5& -&) -!PLOSS(HNO3) = +K005+K040*<OH> - PLOSS(:,8) = +TPK%K005(:)+TPK%K040(:)*PCONC(:,15) -! -!PPROD(HNO4) = +K036*<HO2>*<NO2> - PPROD(:,9) = +TPK%K036(:)*PCONC(:,16)*PCONC(:,4) -!PLOSS(HNO4) = +K006+K037+K041*<OH> - PLOSS(:,9) = +TPK%K006(:)+TPK%K037(:)+TPK%K041(:)*PCONC(:,15) -! -!PPROD(NH3) = 0.0 - PPROD(:,10) = 0.0 -!PLOSS(NH3) = +K050*<OH> - PLOSS(:,10) = +TPK%K050(:)*PCONC(:,15) -! -RETURN -END SUBROUTINE SUB0 -! -SUBROUTINE SUB1 -! -!Indices 11 a 20 -! -! -!PPROD(DMS) = 0.0 - PPROD(:,11) = 0.0 -!PLOSS(DMS) = +K133*<NO3>+K134*<O3P>+K135*<OH> - PLOSS(:,11) = +TPK%K133(:)*PCONC(:,5)+TPK%K134(:)*TPK%O3P(:)+TPK%K135(:)*PCONC& -&(:,15) -! -!PPROD(SO2) = +K133*<DMS>*<NO3>+K134*<DMS>*<O3P>+0.8*K135*<DMS>*<OH> - PPROD(:,12) = +TPK%K133(:)*PCONC(:,11)*PCONC(:,5)+TPK%K134(:)*PCONC(:,11)*TPK%& -&O3P(:)+0.8*TPK%K135(:)*PCONC(:,11)*PCONC(:,15) -!PLOSS(SO2) = +K052*<OH> - PLOSS(:,12) = +TPK%K052(:)*PCONC(:,15) -! -!PPROD(SULF) = +K052*<OH>*<SO2> - PPROD(:,13) = +TPK%K052(:)*PCONC(:,15)*PCONC(:,12) -!PLOSS(SULF) = +K132 - PLOSS(:,13) = +TPK%K132(:) -! -!PPROD(CO) = +K010*<HCHO>+K011*<HCHO>+K012*<ALD>+0.91924*K016*<CARBO>+0.01*K054 -!*<BIO>*<O3P>+0.00878*K058*<ALKA>*<OH>+K062*<HCHO>*<OH>+1.01732*K065*<CARBO>*<O -!H>+K072*<HCHO>*<NO3>+1.33723*K074*<CARBO>*<NO3>+0.35120*K079*<ALKE>*<O3>+0.360 -!00*K080*<BIO>*<O3>+0.64728*K081*<CARBO>*<O3>+0.13*K082*<PAN>*<O3> - PPROD(:,14) = +TPK%K010(:)*PCONC(:,23)+TPK%K011(:)*PCONC(:,23)+TPK%K012(:)*PCO& -&NC(:,24)+0.91924*TPK%K016(:)*PCONC(:,26)+0.01*TPK%K054(:)*PCONC(:,21)*TPK%O3P(& -&:)+0.00878*TPK%K058(:)*PCONC(:,19)*PCONC(:,15)+TPK%K062(:)*PCONC(:,23)*PCONC(:& -&,15)+1.01732*TPK%K065(:)*PCONC(:,26)*PCONC(:,15)+TPK%K072(:)*PCONC(:,23)*PCONC& -&(:,5)+1.33723*TPK%K074(:)*PCONC(:,26)*PCONC(:,5)+0.35120*TPK%K079(:)*PCONC(:,2& -&0)*PCONC(:,1)+0.36000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.64728*TPK%K081(:)*P& -&CONC(:,26)*PCONC(:,1)+0.13*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) -!PLOSS(CO) = +K053*<OH> - PLOSS(:,14) = +TPK%K053(:)*PCONC(:,15) -! -!PPROD(OH) = +K004*<HONO>+K005*<HNO3>+0.35*K006*<HNO4>+K009*<H2O2>+K009*<H2O2>+ -!K013*<OP1>+K014*<OP2>+K022*<O1D>*<H2O>+K022*<O1D>*<H2O>+K024*<O3>*<HO2>+K035*< -!HO2>*<NO>+0.7*K038*<HO2>*<NO3>+0.02*K054*<BIO>*<O3P>+0.00878*K058*<ALKA>*<OH>+ -!0.35*K068*<OP1>*<OH>+0.44925*K069*<OP2>*<OH>+0.39435*K079*<ALKE>*<O3>+0.28000* -!K080*<BIO>*<O3>+0.20595*K081*<CARBO>*<O3>+0.036*K082*<PAN>*<O3>+K087*<ADD>*<O3 -!> - PPROD(:,15) = +TPK%K004(:)*PCONC(:,7)+TPK%K005(:)*PCONC(:,8)+0.35*TPK%K006(:)*& -&PCONC(:,9)+TPK%K009(:)*PCONC(:,2)+TPK%K009(:)*PCONC(:,2)+TPK%K013(:)*PCONC(:,2& -&9)+TPK%K014(:)*PCONC(:,30)+TPK%K022(:)*TPK%O1D(:)*TPK%H2O(:)+TPK%K022(:)*TPK%O& -&1D(:)*TPK%H2O(:)+TPK%K024(:)*PCONC(:,1)*PCONC(:,16)+TPK%K035(:)*PCONC(:,16)*PC& -&ONC(:,3)+0.7*TPK%K038(:)*PCONC(:,16)*PCONC(:,5)+0.02*TPK%K054(:)*PCONC(:,21)*T& -&PK%O3P(:)+0.00878*TPK%K058(:)*PCONC(:,19)*PCONC(:,15)+0.35*TPK%K068(:)*PCONC(:& -&,29)*PCONC(:,15)+0.44925*TPK%K069(:)*PCONC(:,30)*PCONC(:,15)+0.39435*TPK%K079(& -&:)*PCONC(:,20)*PCONC(:,1)+0.28000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.20595*T& -&PK%K081(:)*PCONC(:,26)*PCONC(:,1)+0.036*TPK%K082(:)*PCONC(:,28)*PCONC(:,1)+TPK& -&%K087(:)*PCONC(:,38)*PCONC(:,1) -!PLOSS(OH) = +K023*<O3>+K025*<HO2>+K026*<H2O2>+K032*<NO>+K033*<NO2>+K034*<NO3>+ -!K039*<HONO>+K040*<HNO3>+K041*<HNO4>+K050*<NH3>+K051*<H2>+K052*<SO2>+K053*<CO>+ -!K056*<CH4>+K057*<ETH>+K058*<ALKA>+K059*<ALKE>+K060*<BIO>+K061*<ARO>+K062*<HCHO -!>+K063*<ALD>+K064*<KET>+K065*<CARBO>+K066*<ORA1>+K067*<ORA2>+K068*<OP1>+K069*< -!OP2>+K070*<PAN>+K071*<ONIT>+K135*<DMS> - PLOSS(:,15) = +TPK%K023(:)*PCONC(:,1)+TPK%K025(:)*PCONC(:,16)+TPK%K026(:)*PCON& -&C(:,2)+TPK%K032(:)*PCONC(:,3)+TPK%K033(:)*PCONC(:,4)+TPK%K034(:)*PCONC(:,5)+TP& -&K%K039(:)*PCONC(:,7)+TPK%K040(:)*PCONC(:,8)+TPK%K041(:)*PCONC(:,9)+TPK%K050(:)& -&*PCONC(:,10)+TPK%K051(:)*TPK%H2(:)+TPK%K052(:)*PCONC(:,12)+TPK%K053(:)*PCONC(:& -&,14)+TPK%K056(:)*PCONC(:,17)+TPK%K057(:)*PCONC(:,18)+TPK%K058(:)*PCONC(:,19)+T& -&PK%K059(:)*PCONC(:,20)+TPK%K060(:)*PCONC(:,21)+TPK%K061(:)*PCONC(:,22)+TPK%K06& -&2(:)*PCONC(:,23)+TPK%K063(:)*PCONC(:,24)+TPK%K064(:)*PCONC(:,25)+TPK%K065(:)*P& -&CONC(:,26)+TPK%K066(:)*PCONC(:,31)+TPK%K067(:)*PCONC(:,32)+TPK%K068(:)*PCONC(:& -&,29)+TPK%K069(:)*PCONC(:,30)+TPK%K070(:)*PCONC(:,28)+TPK%K071(:)*PCONC(:,27)+T& -&PK%K135(:)*PCONC(:,11) -! -!PPROD(HO2) = +0.65*K006*<HNO4>+K011*<HCHO>+K011*<HCHO>+K012*<ALD>+K013*<OP1>+0 -!.96205*K014*<OP2>+0.75830*K016*<CARBO>+K017*<ONIT>+K023*<O3>*<OH>+K026*<H2O2>* -!<OH>+K034*<OH>*<NO3>+K037*<HNO4>+K051*<OH>*<H2>+K052*<OH>*<SO2>+K053*<CO>*<OH> -!+0.28*K054*<BIO>*<O3P>+0.12793*K058*<ALKA>*<OH>+0.10318*K061*<ARO>*<OH>+K062*< -!HCHO>*<OH>+0.51208*K065*<CARBO>*<OH>+K066*<ORA1>*<OH>+0.02915*K069*<OP2>*<OH>+ -!0.28107*K070*<PAN>*<OH>+K072*<HCHO>*<NO3>+0.63217*K074*<CARBO>*<NO3>+0.23451*K -!079*<ALKE>*<O3>+0.30000*K080*<BIO>*<O3>+0.28441*K081*<CARBO>*<O3>+0.08*K082*<P -!AN>*<O3>+0.02*K086*<ADD>*<O2>+K090*<MO2>*<NO>+0.74265*K091*<ALKAP>*<NO>+K092*< -!ALKEP>*<NO>+0.84700*K093*<BIOP>*<NO>+0.95115*K094*<AROP>*<NO>+0.12334*K095*<CA -!RBOP>*<NO>+0.18401*K096*<OLN>*<NO>+0.66*K104*<MO2>*<MO2>+0.98383*K105*<ALKAP>* -!<MO2>+K106*<ALKEP>*<MO2>+1.00000*K107*<BIOP>*<MO2>+1.02767*K108*<AROP>*<MO2>+0 -!.82998*K109*<CARBOP>*<MO2>+0.67560*K110*<OLN>*<MO2>+0.48079*K111*<ALKAP>*<CARB -!OP>+0.50078*K112*<ALKEP>*<CARBOP>+0.50600*K113*<BIOP>*<CARBOP>+K114*<AROP>*<CA -!RBOP>+0.07566*K115*<CARBOP>*<CARBOP>+0.17599*K116*<OLN>*<CARBOP>+K117*<OLN>*<O -!LN>+0.00000*K118*<OLN>*<OLN>+K119*<MO2>*<NO3>+0.81290*K120*<ALKAP>*<NO3>+K121* -!<ALKEP>*<NO3>+K122*<BIOP>*<NO3>+K123*<AROP>*<NO3>+0.04915*K124*<CARBOP>*<NO3>+ -!0.25928*K125*<OLN>*<NO3>+K127*<XO2>*<MO2> - PPROD(:,16) = +0.65*TPK%K006(:)*PCONC(:,9)+TPK%K011(:)*PCONC(:,23)+TPK%K011(:)& -&*PCONC(:,23)+TPK%K012(:)*PCONC(:,24)+TPK%K013(:)*PCONC(:,29)+0.96205*TPK%K014(& -&:)*PCONC(:,30)+0.75830*TPK%K016(:)*PCONC(:,26)+TPK%K017(:)*PCONC(:,27)+TPK%K02& -&3(:)*PCONC(:,1)*PCONC(:,15)+TPK%K026(:)*PCONC(:,2)*PCONC(:,15)+TPK%K034(:)*PCO& -&NC(:,15)*PCONC(:,5)+TPK%K037(:)*PCONC(:,9)+TPK%K051(:)*PCONC(:,15)*TPK%H2(:)+T& -&PK%K052(:)*PCONC(:,15)*PCONC(:,12)+TPK%K053(:)*PCONC(:,14)*PCONC(:,15)+0.28*TP& -&K%K054(:)*PCONC(:,21)*TPK%O3P(:)+0.12793*TPK%K058(:)*PCONC(:,19)*PCONC(:,15)+0& -&.10318*TPK%K061(:)*PCONC(:,22)*PCONC(:,15)+TPK%K062(:)*PCONC(:,23)*PCONC(:,15)& -&+0.51208*TPK%K065(:)*PCONC(:,26)*PCONC(:,15)+TPK%K066(:)*PCONC(:,31)*PCONC(:,1& -&5)+0.02915*TPK%K069(:)*PCONC(:,30)*PCONC(:,15)+0.28107*TPK%K070(:)*PCONC(:,28)& -&*PCONC(:,15)+TPK%K072(:)*PCONC(:,23)*PCONC(:,5)+0.63217*TPK%K074(:)*PCONC(:,26& -&)*PCONC(:,5)+0.23451*TPK%K079(:)*PCONC(:,20)*PCONC(:,1)+0.30000*TPK%K080(:)*PC& -&ONC(:,21)*PCONC(:,1)+0.28441*TPK%K081(:)*PCONC(:,26)*PCONC(:,1)+0.08*TPK%K082(& -&:)*PCONC(:,28)*PCONC(:,1)+0.02*TPK%K086(:)*PCONC(:,38)*TPK%O2(:)+TPK%K090(:)*P& -&CONC(:,33)*PCONC(:,3)+0.74265*TPK%K091(:)*PCONC(:,34)*PCONC(:,3)+TPK%K092(:)*P& -&CONC(:,35)*PCONC(:,3)+0.84700*TPK%K093(:)*PCONC(:,36)*PCONC(:,3)+0.95115*TPK%K& -&094(:)*PCONC(:,39)*PCONC(:,3)+0.12334*TPK%K095(:)*PCONC(:,40)*PCONC(:,3)+0.184& -&01*TPK%K096(:)*PCONC(:,41)*PCONC(:,3)+0.66*TPK%K104(:)*PCONC(:,33)*PCONC(:,33)& -&+0.98383*TPK%K105(:)*PCONC(:,34)*PCONC(:,33)+TPK%K106(:)*PCONC(:,35)*PCONC(:,3& -&3)+1.00000*TPK%K107(:)*PCONC(:,36)*PCONC(:,33)+1.02767*TPK%K108(:)*PCONC(:,39)& -&*PCONC(:,33)+0.82998*TPK%K109(:)*PCONC(:,40)*PCONC(:,33)+0.67560*TPK%K110(:)*P& -&CONC(:,41)*PCONC(:,33)+0.48079*TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.50078*TPK& -&%K112(:)*PCONC(:,35)*PCONC(:,40)+0.50600*TPK%K113(:)*PCONC(:,36)*PCONC(:,40)+T& -&PK%K114(:)*PCONC(:,39)*PCONC(:,40)+0.07566*TPK%K115(:)*PCONC(:,40)*PCONC(:,40)& -&+0.17599*TPK%K116(:)*PCONC(:,41)*PCONC(:,40)+TPK%K117(:)*PCONC(:,41)*PCONC(:,4& -&1)+0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,41)+TPK%K119(:)*PCONC(:,33)*PCONC(:& -&,5)+0.81290*TPK%K120(:)*PCONC(:,34)*PCONC(:,5)+TPK%K121(:)*PCONC(:,35)*PCONC(:& -&,5)+TPK%K122(:)*PCONC(:,36)*PCONC(:,5)+TPK%K123(:)*PCONC(:,39)*PCONC(:,5)+0.04& -&915*TPK%K124(:)*PCONC(:,40)*PCONC(:,5)+0.25928*TPK%K125(:)*PCONC(:,41)*PCONC(:& -&,5)+TPK%K127(:)*PCONC(:,42)*PCONC(:,33) -!PLOSS(HO2) = +K024*<O3>+K025*<OH>+K027*<HO2>+K027*<HO2>+K028*<HO2>*<H2O>+K028* -!<HO2>*<H2O>+K035*<NO>+K036*<NO2>+K038*<NO3>+K084*<PHO>+K097*<MO2>+K098*<ALKAP> -!+K099*<ALKEP>+K0100*<BIOP>+K0101*<AROP>+K0102*<CARBOP>+K103*<OLN>+K126*<XO2> - PLOSS(:,16) = +TPK%K024(:)*PCONC(:,1)+TPK%K025(:)*PCONC(:,15)+TPK%K027(:)*PCON& -&C(:,16)+TPK%K027(:)*PCONC(:,16)+TPK%K028(:)*PCONC(:,16)*TPK%H2O(:)+TPK%K028(:)& -&*PCONC(:,16)*TPK%H2O(:)+TPK%K035(:)*PCONC(:,3)+TPK%K036(:)*PCONC(:,4)+TPK%K038& -&(:)*PCONC(:,5)+TPK%K084(:)*PCONC(:,37)+TPK%K097(:)*PCONC(:,33)+TPK%K098(:)*PCO& -&NC(:,34)+TPK%K099(:)*PCONC(:,35)+TPK%K0100(:)*PCONC(:,36)+TPK%K0101(:)*PCONC(:& -&,39)+TPK%K0102(:)*PCONC(:,40)+TPK%K103(:)*PCONC(:,41)+TPK%K126(:)*PCONC(:,42) -! -!PPROD(CH4) = +0.04300*K079*<ALKE>*<O3> - PPROD(:,17) = +0.04300*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -!PLOSS(CH4) = +K056*<OH> - PLOSS(:,17) = +TPK%K056(:)*PCONC(:,15) -! -!PPROD(ETH) = +0.03196*K079*<ALKE>*<O3> - PPROD(:,18) = +0.03196*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -!PLOSS(ETH) = +K057*<OH> - PLOSS(:,18) = +TPK%K057(:)*PCONC(:,15) -! -!PPROD(ALKA) = 0.0 - PPROD(:,19) = 0.0 -!PLOSS(ALKA) = +K058*<OH> - PLOSS(:,19) = +TPK%K058(:)*PCONC(:,15) -! -!PPROD(ALKE) = +0.91868*K054*<BIO>*<O3P>+0.00000*K079*<ALKE>*<O3>+0.37388*K080* -!<BIO>*<O3>+0.37815*K093*<BIOP>*<NO>+0.48074*K107*<BIOP>*<MO2>+0.24463*K113*<BI -!OP>*<CARBOP>+0.42729*K122*<BIOP>*<NO3> - PPROD(:,20) = +0.91868*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:)+0.00000*TPK%K079(:)*& -&PCONC(:,20)*PCONC(:,1)+0.37388*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.37815*TPK%& -&K093(:)*PCONC(:,36)*PCONC(:,3)+0.48074*TPK%K107(:)*PCONC(:,36)*PCONC(:,33)+0.2& -&4463*TPK%K113(:)*PCONC(:,36)*PCONC(:,40)+0.42729*TPK%K122(:)*PCONC(:,36)*PCONC& -&(:,5) -!PLOSS(ALKE) = +K059*<OH>+K076*<NO3>+K079*<O3> - PLOSS(:,20) = +TPK%K059(:)*PCONC(:,15)+TPK%K076(:)*PCONC(:,5)+TPK%K079(:)*PCON& -&C(:,1) -! -RETURN -END SUBROUTINE SUB1 -! -SUBROUTINE SUB2 -! -!Indices 21 a 30 -! -! -!PPROD(BIO) = 0.0 - PPROD(:,21) = 0.0 -!PLOSS(BIO) = +K054*<O3P>+K060*<OH>+K077*<NO3>+K080*<O3> - PLOSS(:,21) = +TPK%K054(:)*TPK%O3P(:)+TPK%K060(:)*PCONC(:,15)+TPK%K077(:)*PCON& -&C(:,5)+TPK%K080(:)*PCONC(:,1) -! -!PPROD(ARO) = +0.10670*K083*<PHO>*<NO2>+1.06698*K084*<PHO>*<HO2>+K085*<ADD>*<NO -!2>+0.02*K086*<ADD>*<O2>+K087*<ADD>*<O3> - PPROD(:,22) = +0.10670*TPK%K083(:)*PCONC(:,37)*PCONC(:,4)+1.06698*TPK%K084(:)*& -&PCONC(:,37)*PCONC(:,16)+TPK%K085(:)*PCONC(:,38)*PCONC(:,4)+0.02*TPK%K086(:)*PC& -&ONC(:,38)*TPK%O2(:)+TPK%K087(:)*PCONC(:,38)*PCONC(:,1) -!PLOSS(ARO) = +K061*<OH>+K075*<NO3> - PLOSS(:,22) = +TPK%K061(:)*PCONC(:,15)+TPK%K075(:)*PCONC(:,5) -! -!PPROD(HCHO) = +K013*<OP1>+0.06517*K016*<CARBO>+0.05*K054*<BIO>*<O3P>+0.00140*K -!058*<ALKA>*<OH>+0.00000*K065*<CARBO>*<OH>+0.35*K068*<OP1>*<OH>+0.02915*K069*<O -!P2>*<OH>+0.57839*K070*<PAN>*<OH>+0.40*K078*<PAN>*<NO3>+0.48290*K079*<ALKE>*<O3 -!>+0.90000*K080*<BIO>*<O3>+0.00000*K081*<CARBO>*<O3>+0.70*K082*<PAN>*<O3>+K090* -!<MO2>*<NO>+0.03002*K091*<ALKAP>*<NO>+1.39870*K092*<ALKEP>*<NO>+0.60600*K093*<B -!IOP>*<NO>+0.05848*K095*<CARBOP>*<NO>+0.23419*K096*<OLN>*<NO>+1.33*K104*<MO2>*< -!MO2>+0.80556*K105*<ALKAP>*<MO2>+1.42894*K106*<ALKEP>*<MO2>+1.09000*K107*<BIOP> -!*<MO2>+K108*<AROP>*<MO2>+0.95723*K109*<CARBOP>*<MO2>+0.88625*K110*<OLN>*<MO2>+ -!0.07600*K111*<ALKAP>*<CARBOP>+0.68192*K112*<ALKEP>*<CARBOP>+0.34000*K113*<BIOP -!>*<CARBOP>+0.03432*K115*<CARBOP>*<CARBOP>+0.13414*K116*<OLN>*<CARBOP>+0.00000* -!K118*<OLN>*<OLN>+K119*<MO2>*<NO3>+0.03142*K120*<ALKAP>*<NO3>+1.40909*K121*<ALK -!EP>*<NO3>+0.68600*K122*<BIOP>*<NO3>+0.03175*K124*<CARBOP>*<NO3>+0.20740*K125*< -!OLN>*<NO3>+K127*<XO2>*<MO2> - PPROD(:,23) = +TPK%K013(:)*PCONC(:,29)+0.06517*TPK%K016(:)*PCONC(:,26)+0.05*TP& -&K%K054(:)*PCONC(:,21)*TPK%O3P(:)+0.00140*TPK%K058(:)*PCONC(:,19)*PCONC(:,15)+0& -&.00000*TPK%K065(:)*PCONC(:,26)*PCONC(:,15)+0.35*TPK%K068(:)*PCONC(:,29)*PCONC(& -&:,15)+0.02915*TPK%K069(:)*PCONC(:,30)*PCONC(:,15)+0.57839*TPK%K070(:)*PCONC(:,& -&28)*PCONC(:,15)+0.40*TPK%K078(:)*PCONC(:,28)*PCONC(:,5)+0.48290*TPK%K079(:)*PC& -&ONC(:,20)*PCONC(:,1)+0.90000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.00000*TPK%K0& -&81(:)*PCONC(:,26)*PCONC(:,1)+0.70*TPK%K082(:)*PCONC(:,28)*PCONC(:,1)+TPK%K090(& -&:)*PCONC(:,33)*PCONC(:,3)+0.03002*TPK%K091(:)*PCONC(:,34)*PCONC(:,3)+1.39870*T& -&PK%K092(:)*PCONC(:,35)*PCONC(:,3)+0.60600*TPK%K093(:)*PCONC(:,36)*PCONC(:,3)+0& -&.05848*TPK%K095(:)*PCONC(:,40)*PCONC(:,3)+0.23419*TPK%K096(:)*PCONC(:,41)*PCON& -&C(:,3)+1.33*TPK%K104(:)*PCONC(:,33)*PCONC(:,33)+0.80556*TPK%K105(:)*PCONC(:,34& -&)*PCONC(:,33)+1.42894*TPK%K106(:)*PCONC(:,35)*PCONC(:,33)+1.09000*TPK%K107(:)*& -&PCONC(:,36)*PCONC(:,33)+TPK%K108(:)*PCONC(:,39)*PCONC(:,33)+0.95723*TPK%K109(:& -&)*PCONC(:,40)*PCONC(:,33)+0.88625*TPK%K110(:)*PCONC(:,41)*PCONC(:,33)+0.07600*& -&TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.68192*TPK%K112(:)*PCONC(:,35)*PCONC(:,40& -&)+0.34000*TPK%K113(:)*PCONC(:,36)*PCONC(:,40)+0.03432*TPK%K115(:)*PCONC(:,40)*& -&PCONC(:,40)+0.13414*TPK%K116(:)*PCONC(:,41)*PCONC(:,40)+0.00000*TPK%K118(:)*PC& -&ONC(:,41)*PCONC(:,41)+TPK%K119(:)*PCONC(:,33)*PCONC(:,5)+0.03142*TPK%K120(:)*P& -&CONC(:,34)*PCONC(:,5)+1.40909*TPK%K121(:)*PCONC(:,35)*PCONC(:,5)+0.68600*TPK%K& -&122(:)*PCONC(:,36)*PCONC(:,5)+0.03175*TPK%K124(:)*PCONC(:,40)*PCONC(:,5)+0.207& -&40*TPK%K125(:)*PCONC(:,41)*PCONC(:,5)+TPK%K127(:)*PCONC(:,42)*PCONC(:,33) -!PLOSS(HCHO) = +K010+K011+K062*<OH>+K072*<NO3> - PLOSS(:,23) = +TPK%K010(:)+TPK%K011(:)+TPK%K062(:)*PCONC(:,15)+TPK%K072(:)*PCO& -&NC(:,5) -! -!PPROD(ALD) = +0.96205*K014*<OP2>+0.20*K017*<ONIT>+K055*<CARBO>*<O3P>+0.08173*K -!058*<ALKA>*<OH>+0.06253*K065*<CARBO>*<OH>+0.07335*K069*<OP2>*<OH>+0.05265*K074 -!*<CARBO>*<NO3>+0.51468*K079*<ALKE>*<O3>+0.00000*K080*<BIO>*<O3>+0.15692*K081*< -!CARBO>*<O3>+0.33144*K091*<ALKAP>*<NO>+0.42125*K092*<ALKEP>*<NO>+0.00000*K093*< -!BIOP>*<NO>+0.07368*K095*<CARBOP>*<NO>+1.01182*K096*<OLN>*<NO>+0.56070*K105*<AL -!KAP>*<MO2>+0.46413*K106*<ALKEP>*<MO2>+0.00000*K107*<BIOP>*<MO2>+0.08295*K109*< -!CARBOP>*<MO2>+0.41524*K110*<OLN>*<MO2>+0.71461*K111*<ALKAP>*<CARBOP>+0.68374*K -!112*<ALKEP>*<CARBOP>+0.00000*K113*<BIOP>*<CARBOP>+0.06969*K115*<CARBOP>*<CARBO -!P>+0.42122*K116*<OLN>*<CARBOP>+0.00000*K118*<OLN>*<OLN>+0.33743*K120*<ALKAP>*< -!NO3>+0.43039*K121*<ALKEP>*<NO3>+0.00000*K122*<BIOP>*<NO3>+0.02936*K124*<CARBOP -!>*<NO3>+0.91850*K125*<OLN>*<NO3> - PPROD(:,24) = +0.96205*TPK%K014(:)*PCONC(:,30)+0.20*TPK%K017(:)*PCONC(:,27)+TP& -&K%K055(:)*PCONC(:,26)*TPK%O3P(:)+0.08173*TPK%K058(:)*PCONC(:,19)*PCONC(:,15)+0& -&.06253*TPK%K065(:)*PCONC(:,26)*PCONC(:,15)+0.07335*TPK%K069(:)*PCONC(:,30)*PCO& -&NC(:,15)+0.05265*TPK%K074(:)*PCONC(:,26)*PCONC(:,5)+0.51468*TPK%K079(:)*PCONC(& -&:,20)*PCONC(:,1)+0.00000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.15692*TPK%K081(:& -&)*PCONC(:,26)*PCONC(:,1)+0.33144*TPK%K091(:)*PCONC(:,34)*PCONC(:,3)+0.42125*TP& -&K%K092(:)*PCONC(:,35)*PCONC(:,3)+0.00000*TPK%K093(:)*PCONC(:,36)*PCONC(:,3)+0.& -&07368*TPK%K095(:)*PCONC(:,40)*PCONC(:,3)+1.01182*TPK%K096(:)*PCONC(:,41)*PCONC& -&(:,3)+0.56070*TPK%K105(:)*PCONC(:,34)*PCONC(:,33)+0.46413*TPK%K106(:)*PCONC(:,& -&35)*PCONC(:,33)+0.00000*TPK%K107(:)*PCONC(:,36)*PCONC(:,33)+0.08295*TPK%K109(:& -&)*PCONC(:,40)*PCONC(:,33)+0.41524*TPK%K110(:)*PCONC(:,41)*PCONC(:,33)+0.71461*& -&TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.68374*TPK%K112(:)*PCONC(:,35)*PCONC(:,40& -&)+0.00000*TPK%K113(:)*PCONC(:,36)*PCONC(:,40)+0.06969*TPK%K115(:)*PCONC(:,40)*& -&PCONC(:,40)+0.42122*TPK%K116(:)*PCONC(:,41)*PCONC(:,40)+0.00000*TPK%K118(:)*PC& -&ONC(:,41)*PCONC(:,41)+0.33743*TPK%K120(:)*PCONC(:,34)*PCONC(:,5)+0.43039*TPK%K& -&121(:)*PCONC(:,35)*PCONC(:,5)+0.00000*TPK%K122(:)*PCONC(:,36)*PCONC(:,5)+0.029& -&36*TPK%K124(:)*PCONC(:,40)*PCONC(:,5)+0.91850*TPK%K125(:)*PCONC(:,41)*PCONC(:,& -&5) -!PLOSS(ALD) = +K012+K063*<OH>+K073*<NO3> - PLOSS(:,24) = +TPK%K012(:)+TPK%K063(:)*PCONC(:,15)+TPK%K073(:)*PCONC(:,5) -! -!PPROD(KET) = +0.80*K017*<ONIT>+0.03498*K058*<ALKA>*<OH>+0.00853*K065*<CARBO>*< -!OH>+0.37591*K069*<OP2>*<OH>+0.00632*K074*<CARBO>*<NO3>+0.07377*K079*<ALKE>*<O3 -!>+0.00000*K080*<BIO>*<O3>+0.54531*K091*<ALKAP>*<NO>+0.05220*K092*<ALKEP>*<NO>+ -!0.00000*K093*<BIOP>*<NO>+0.37862*K096*<OLN>*<NO>+0.09673*K105*<ALKAP>*<MO2>+0. -!03814*K106*<ALKEP>*<MO2>+0.00000*K107*<BIOP>*<MO2>+0.09667*K110*<OLN>*<MO2>+0. -!18819*K111*<ALKAP>*<CARBOP>+0.06579*K112*<ALKEP>*<CARBOP>+0.00000*K113*<BIOP>* -!<CARBOP>+0.02190*K115*<CARBOP>*<CARBOP>+0.10822*K116*<OLN>*<CARBOP>+0.00000*K1 -!18*<OLN>*<OLN>+0.62978*K120*<ALKAP>*<NO3>+0.02051*K121*<ALKEP>*<NO3>+0.00000*K -!122*<BIOP>*<NO3>+0.34740*K125*<OLN>*<NO3> - PPROD(:,25) = +0.80*TPK%K017(:)*PCONC(:,27)+0.03498*TPK%K058(:)*PCONC(:,19)*PC& -&ONC(:,15)+0.00853*TPK%K065(:)*PCONC(:,26)*PCONC(:,15)+0.37591*TPK%K069(:)*PCON& -&C(:,30)*PCONC(:,15)+0.00632*TPK%K074(:)*PCONC(:,26)*PCONC(:,5)+0.07377*TPK%K07& -&9(:)*PCONC(:,20)*PCONC(:,1)+0.00000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.54531& -&*TPK%K091(:)*PCONC(:,34)*PCONC(:,3)+0.05220*TPK%K092(:)*PCONC(:,35)*PCONC(:,3)& -&+0.00000*TPK%K093(:)*PCONC(:,36)*PCONC(:,3)+0.37862*TPK%K096(:)*PCONC(:,41)*PC& -&ONC(:,3)+0.09673*TPK%K105(:)*PCONC(:,34)*PCONC(:,33)+0.03814*TPK%K106(:)*PCONC& -&(:,35)*PCONC(:,33)+0.00000*TPK%K107(:)*PCONC(:,36)*PCONC(:,33)+0.09667*TPK%K11& -&0(:)*PCONC(:,41)*PCONC(:,33)+0.18819*TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.065& -&79*TPK%K112(:)*PCONC(:,35)*PCONC(:,40)+0.00000*TPK%K113(:)*PCONC(:,36)*PCONC(:& -&,40)+0.02190*TPK%K115(:)*PCONC(:,40)*PCONC(:,40)+0.10822*TPK%K116(:)*PCONC(:,4& -&1)*PCONC(:,40)+0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,41)+0.62978*TPK%K120(:)& -&*PCONC(:,34)*PCONC(:,5)+0.02051*TPK%K121(:)*PCONC(:,35)*PCONC(:,5)+0.00000*TPK& -&%K122(:)*PCONC(:,36)*PCONC(:,5)+0.34740*TPK%K125(:)*PCONC(:,41)*PCONC(:,5) -!PLOSS(KET) = +K015+K064*<OH> - PLOSS(:,25) = +TPK%K015(:)+TPK%K064(:)*PCONC(:,15) -! -!PPROD(CARBO) = +0.13255*K054*<BIO>*<O3P>+0.00835*K058*<ALKA>*<OH>+0.16919*K065 -!*<CARBO>*<OH>+0.21863*K070*<PAN>*<OH>+0.10530*K074*<CARBO>*<NO3>+0.00000*K076* -!<ALKE>*<NO3>+0.91741*K077*<BIO>*<NO3>+0.00000*K079*<ALKE>*<O3>+0.39754*K080*<B -!IO>*<O3>+1.07583*K081*<CARBO>*<O3>+0.03407*K091*<ALKAP>*<NO>+0.45463*K093*<BIO -!P>*<NO>+2.06993*K094*<AROP>*<NO>+0.08670*K095*<CARBOP>*<NO>+0.07976*K105*<ALKA -!P>*<MO2>+0.56064*K107*<BIOP>*<MO2>+1.99461*K108*<AROP>*<MO2>+0.15387*K109*<CAR -!BOP>*<MO2>+0.06954*K111*<ALKAP>*<CARBOP>+0.78591*K113*<BIOP>*<CARBOP>+1.99455* -!K114*<AROP>*<CARBOP>+0.10777*K115*<CARBOP>*<CARBOP>+0.03531*K120*<ALKAP>*<NO3> -!+0.61160*K122*<BIOP>*<NO3>+2.81904*K123*<AROP>*<NO3>+0.03455*K124*<CARBOP>*<NO -!3> - PPROD(:,26) = +0.13255*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:)+0.00835*TPK%K058(:)*& -&PCONC(:,19)*PCONC(:,15)+0.16919*TPK%K065(:)*PCONC(:,26)*PCONC(:,15)+0.21863*TP& -&K%K070(:)*PCONC(:,28)*PCONC(:,15)+0.10530*TPK%K074(:)*PCONC(:,26)*PCONC(:,5)+0& -&.00000*TPK%K076(:)*PCONC(:,20)*PCONC(:,5)+0.91741*TPK%K077(:)*PCONC(:,21)*PCON& -&C(:,5)+0.00000*TPK%K079(:)*PCONC(:,20)*PCONC(:,1)+0.39754*TPK%K080(:)*PCONC(:,& -&21)*PCONC(:,1)+1.07583*TPK%K081(:)*PCONC(:,26)*PCONC(:,1)+0.03407*TPK%K091(:)*& -&PCONC(:,34)*PCONC(:,3)+0.45463*TPK%K093(:)*PCONC(:,36)*PCONC(:,3)+2.06993*TPK%& -&K094(:)*PCONC(:,39)*PCONC(:,3)+0.08670*TPK%K095(:)*PCONC(:,40)*PCONC(:,3)+0.07& -&976*TPK%K105(:)*PCONC(:,34)*PCONC(:,33)+0.56064*TPK%K107(:)*PCONC(:,36)*PCONC(& -&:,33)+1.99461*TPK%K108(:)*PCONC(:,39)*PCONC(:,33)+0.15387*TPK%K109(:)*PCONC(:,& -&40)*PCONC(:,33)+0.06954*TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.78591*TPK%K113(:& -&)*PCONC(:,36)*PCONC(:,40)+1.99455*TPK%K114(:)*PCONC(:,39)*PCONC(:,40)+0.10777*& -&TPK%K115(:)*PCONC(:,40)*PCONC(:,40)+0.03531*TPK%K120(:)*PCONC(:,34)*PCONC(:,5)& -&+0.61160*TPK%K122(:)*PCONC(:,36)*PCONC(:,5)+2.81904*TPK%K123(:)*PCONC(:,39)*PC& -&ONC(:,5)+0.03455*TPK%K124(:)*PCONC(:,40)*PCONC(:,5) -!PLOSS(CARBO) = +K016+K055*<O3P>+K065*<OH>+K074*<NO3>+K081*<O3> - PLOSS(:,26) = +TPK%K016(:)+TPK%K055(:)*TPK%O3P(:)+TPK%K065(:)*PCONC(:,15)+TPK%& -&K074(:)*PCONC(:,5)+TPK%K081(:)*PCONC(:,1) -! -!PPROD(ONIT) = +0.60*K078*<PAN>*<NO3>+K083*<PHO>*<NO2>+0.08459*K091*<ALKAP>*<NO -!>+0.15300*K093*<BIOP>*<NO>+0.04885*K094*<AROP>*<NO>+0.18401*K096*<OLN>*<NO>+K1 -!03*<OLN>*<HO2>+0.67560*K110*<OLN>*<MO2>+0.66562*K116*<OLN>*<CARBOP>+2.00*K117* -!<OLN>*<OLN>+0.00000*K118*<OLN>*<OLN>+0.25928*K125*<OLN>*<NO3> - PPROD(:,27) = +0.60*TPK%K078(:)*PCONC(:,28)*PCONC(:,5)+TPK%K083(:)*PCONC(:,37)& -&*PCONC(:,4)+0.08459*TPK%K091(:)*PCONC(:,34)*PCONC(:,3)+0.15300*TPK%K093(:)*PCO& -&NC(:,36)*PCONC(:,3)+0.04885*TPK%K094(:)*PCONC(:,39)*PCONC(:,3)+0.18401*TPK%K09& -&6(:)*PCONC(:,41)*PCONC(:,3)+TPK%K103(:)*PCONC(:,41)*PCONC(:,16)+0.67560*TPK%K1& -&10(:)*PCONC(:,41)*PCONC(:,33)+0.66562*TPK%K116(:)*PCONC(:,41)*PCONC(:,40)+2.00& -&*TPK%K117(:)*PCONC(:,41)*PCONC(:,41)+0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,4& -&1)+0.25928*TPK%K125(:)*PCONC(:,41)*PCONC(:,5) -!PLOSS(ONIT) = +K017+K071*<OH> - PLOSS(:,27) = +TPK%K017(:)+TPK%K071(:)*PCONC(:,15) -! -!PPROD(PAN) = +0.28107*K070*<PAN>*<OH>+0.40000*K078*<PAN>*<NO3>+0.30000*K082*<P -!AN>*<O3>+1.00000*K088*<CARBOP>*<NO2> - PPROD(:,28) = +0.28107*TPK%K070(:)*PCONC(:,28)*PCONC(:,15)+0.40000*TPK%K078(:)& -&*PCONC(:,28)*PCONC(:,5)+0.30000*TPK%K082(:)*PCONC(:,28)*PCONC(:,1)+1.00000*TPK& -&%K088(:)*PCONC(:,40)*PCONC(:,4) -!PLOSS(PAN) = +K070*<OH>+K078*<NO3>+K082*<O3>+K089 - PLOSS(:,28) = +TPK%K070(:)*PCONC(:,15)+TPK%K078(:)*PCONC(:,5)+TPK%K082(:)*PCON& -&C(:,1)+TPK%K089(:) -! -!PPROD(OP1) = +K097*<MO2>*<HO2> - PPROD(:,29) = +TPK%K097(:)*PCONC(:,33)*PCONC(:,16) -!PLOSS(OP1) = +K013+K068*<OH> - PLOSS(:,29) = +TPK%K013(:)+TPK%K068(:)*PCONC(:,15) -! -!PPROD(OP2) = +0.10149*K081*<CARBO>*<O3>+1.00524*K098*<ALKAP>*<HO2>+1.00524*K09 -!9*<ALKEP>*<HO2>+1.00524*K0100*<BIOP>*<HO2>+1.00524*K0101*<AROP>*<HO2>+0.80904* -!K0102*<CARBOP>*<HO2>+1.00524*K126*<XO2>*<HO2> - PPROD(:,30) = +0.10149*TPK%K081(:)*PCONC(:,26)*PCONC(:,1)+1.00524*TPK%K098(:)*& -&PCONC(:,34)*PCONC(:,16)+1.00524*TPK%K099(:)*PCONC(:,35)*PCONC(:,16)+1.00524*TP& -&K%K0100(:)*PCONC(:,36)*PCONC(:,16)+1.00524*TPK%K0101(:)*PCONC(:,39)*PCONC(:,16& -&)+0.80904*TPK%K0102(:)*PCONC(:,40)*PCONC(:,16)+1.00524*TPK%K126(:)*PCONC(:,42)& -&*PCONC(:,16) -!PLOSS(OP2) = +K014+K069*<OH> - PLOSS(:,30) = +TPK%K014(:)+TPK%K069(:)*PCONC(:,15) -! -RETURN -END SUBROUTINE SUB2 -! -SUBROUTINE SUB3 -! -!Indices 31 a 40 -! -! -!PPROD(ORA1) = +0.00878*K058*<ALKA>*<OH>+0.15343*K079*<ALKE>*<O3>+0.15000*K080* -!<BIO>*<O3>+0.10788*K081*<CARBO>*<O3>+0.11*K082*<PAN>*<O3> - PPROD(:,31) = +0.00878*TPK%K058(:)*PCONC(:,19)*PCONC(:,15)+0.15343*TPK%K079(:)& -&*PCONC(:,20)*PCONC(:,1)+0.15000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.10788*TPK& -&%K081(:)*PCONC(:,26)*PCONC(:,1)+0.11*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) -!PLOSS(ORA1) = +K066*<OH> - PLOSS(:,31) = +TPK%K066(:)*PCONC(:,15) -! -!PPROD(ORA2) = +0.08143*K079*<ALKE>*<O3>+0.00000*K080*<BIO>*<O3>+0.20595*K081*< -!CARBO>*<O3>+0.17307*K0102*<CARBOP>*<HO2>+0.13684*K109*<CARBOP>*<MO2>+0.49810*K -!111*<ALKAP>*<CARBOP>+0.49922*K112*<ALKEP>*<CARBOP>+0.49400*K113*<BIOP>*<CARBOP -!>+0.09955*K115*<CARBOP>*<CARBOP>+0.48963*K116*<OLN>*<CARBOP> - PPROD(:,32) = +0.08143*TPK%K079(:)*PCONC(:,20)*PCONC(:,1)+0.00000*TPK%K080(:)*& -&PCONC(:,21)*PCONC(:,1)+0.20595*TPK%K081(:)*PCONC(:,26)*PCONC(:,1)+0.17307*TPK%& -&K0102(:)*PCONC(:,40)*PCONC(:,16)+0.13684*TPK%K109(:)*PCONC(:,40)*PCONC(:,33)+0& -&.49810*TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.49922*TPK%K112(:)*PCONC(:,35)*PCO& -&NC(:,40)+0.49400*TPK%K113(:)*PCONC(:,36)*PCONC(:,40)+0.09955*TPK%K115(:)*PCONC& -&(:,40)*PCONC(:,40)+0.48963*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) -!PLOSS(ORA2) = +K067*<OH> - PLOSS(:,32) = +TPK%K067(:)*PCONC(:,15) -! -!PPROD(MO2) = +K012*<ALD>+0.03795*K014*<OP2>+K056*<CH4>*<OH>+0.65*K068*<OP1>*<O -!H>+0.13966*K079*<ALKE>*<O3>+0.03000*K080*<BIO>*<O3>+0.09016*K091*<ALKAP>*<NO>+ -!0.78134*K095*<CARBOP>*<NO>+0.01390*K105*<ALKAP>*<MO2>+0.56031*K109*<CARBOP>*<M -!O2>+0.51480*K111*<ALKAP>*<CARBOP>+0.50078*K112*<ALKEP>*<CARBOP>+0.50600*K113*< -!BIOP>*<CARBOP>+K114*<AROP>*<CARBOP>+1.66702*K115*<CARBOP>*<CARBOP>+0.51037*K11 -!6*<OLN>*<CARBOP>+0.09731*K120*<ALKAP>*<NO3>+0.91910*K124*<CARBOP>*<NO3>+K128*< -!XO2>*<CARBOP> - PPROD(:,33) = +TPK%K012(:)*PCONC(:,24)+0.03795*TPK%K014(:)*PCONC(:,30)+TPK%K05& -&6(:)*PCONC(:,17)*PCONC(:,15)+0.65*TPK%K068(:)*PCONC(:,29)*PCONC(:,15)+0.13966*& -&TPK%K079(:)*PCONC(:,20)*PCONC(:,1)+0.03000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+& -&0.09016*TPK%K091(:)*PCONC(:,34)*PCONC(:,3)+0.78134*TPK%K095(:)*PCONC(:,40)*PCO& -&NC(:,3)+0.01390*TPK%K105(:)*PCONC(:,34)*PCONC(:,33)+0.56031*TPK%K109(:)*PCONC(& -&:,40)*PCONC(:,33)+0.51480*TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.50078*TPK%K112& -&(:)*PCONC(:,35)*PCONC(:,40)+0.50600*TPK%K113(:)*PCONC(:,36)*PCONC(:,40)+TPK%K1& -&14(:)*PCONC(:,39)*PCONC(:,40)+1.66702*TPK%K115(:)*PCONC(:,40)*PCONC(:,40)+0.51& -&037*TPK%K116(:)*PCONC(:,41)*PCONC(:,40)+0.09731*TPK%K120(:)*PCONC(:,34)*PCONC(& -&:,5)+0.91910*TPK%K124(:)*PCONC(:,40)*PCONC(:,5)+TPK%K128(:)*PCONC(:,42)*PCONC(& -&:,40) -!PLOSS(MO2) = +K090*<NO>+K097*<HO2>+K104*<MO2>+K104*<MO2>+K105*<ALKAP>+K106*<AL -!KEP>+K107*<BIOP>+K108*<AROP>+K109*<CARBOP>+K110*<OLN>+K119*<NO3>+K127*<XO2> - PLOSS(:,33) = +TPK%K090(:)*PCONC(:,3)+TPK%K097(:)*PCONC(:,16)+TPK%K104(:)*PCON& -&C(:,33)+TPK%K104(:)*PCONC(:,33)+TPK%K105(:)*PCONC(:,34)+TPK%K106(:)*PCONC(:,35& -&)+TPK%K107(:)*PCONC(:,36)+TPK%K108(:)*PCONC(:,39)+TPK%K109(:)*PCONC(:,40)+TPK%& -&K110(:)*PCONC(:,41)+TPK%K119(:)*PCONC(:,5)+TPK%K127(:)*PCONC(:,42) -! -!PPROD(ALKAP) = +1.00000*K015*<KET>+K057*<ETH>*<OH>+0.87811*K058*<ALKA>*<OH>+0. -!40341*K069*<OP2>*<OH>+1.00000*K071*<ONIT>*<OH>+0.09815*K079*<ALKE>*<O3>+0.0000 -!0*K080*<BIO>*<O3>+0.08187*K091*<ALKAP>*<NO>+0.00385*K105*<ALKAP>*<MO2>+0.00828 -!*K111*<ALKAP>*<CARBOP>+0.08994*K120*<ALKAP>*<NO3> - PPROD(:,34) = +1.00000*TPK%K015(:)*PCONC(:,25)+TPK%K057(:)*PCONC(:,18)*PCONC(:& -&,15)+0.87811*TPK%K058(:)*PCONC(:,19)*PCONC(:,15)+0.40341*TPK%K069(:)*PCONC(:,3& -&0)*PCONC(:,15)+1.00000*TPK%K071(:)*PCONC(:,27)*PCONC(:,15)+0.09815*TPK%K079(:)& -&*PCONC(:,20)*PCONC(:,1)+0.00000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.08187*TPK& -&%K091(:)*PCONC(:,34)*PCONC(:,3)+0.00385*TPK%K105(:)*PCONC(:,34)*PCONC(:,33)+0.& -&00828*TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.08994*TPK%K120(:)*PCONC(:,34)*PCON& -&C(:,5) -!PLOSS(ALKAP) = +K091*<NO>+K098*<HO2>+K105*<MO2>+K111*<CARBOP>+K120*<NO3> - PLOSS(:,34) = +TPK%K091(:)*PCONC(:,3)+TPK%K098(:)*PCONC(:,16)+TPK%K105(:)*PCON& -&C(:,33)+TPK%K111(:)*PCONC(:,40)+TPK%K120(:)*PCONC(:,5) -! -!PPROD(ALKEP) = +1.02529*K059*<ALKE>*<OH> - PPROD(:,35) = +1.02529*TPK%K059(:)*PCONC(:,20)*PCONC(:,15) -!PLOSS(ALKEP) = +K092*<NO>+K099*<HO2>+K106*<MO2>+K112*<CARBOP>+K121*<NO3> - PLOSS(:,35) = +TPK%K092(:)*PCONC(:,3)+TPK%K099(:)*PCONC(:,16)+TPK%K106(:)*PCON& -&C(:,33)+TPK%K112(:)*PCONC(:,40)+TPK%K121(:)*PCONC(:,5) -! -!PPROD(BIOP) = +0.00000*K059*<ALKE>*<OH>+1.00000*K060*<BIO>*<OH> - PPROD(:,36) = +0.00000*TPK%K059(:)*PCONC(:,20)*PCONC(:,15)+1.00000*TPK%K060(:)& -&*PCONC(:,21)*PCONC(:,15) -!PLOSS(BIOP) = +K093*<NO>+K0100*<HO2>+K107*<MO2>+K113*<CARBOP>+K122*<NO3> - PLOSS(:,36) = +TPK%K093(:)*PCONC(:,3)+TPK%K0100(:)*PCONC(:,16)+TPK%K107(:)*PCO& -&NC(:,33)+TPK%K113(:)*PCONC(:,40)+TPK%K122(:)*PCONC(:,5) -! -!PPROD(PHO) = +0.00276*K061*<ARO>*<OH>+K075*<ARO>*<NO3> - PPROD(:,37) = +0.00276*TPK%K061(:)*PCONC(:,22)*PCONC(:,15)+TPK%K075(:)*PCONC(:& -&,22)*PCONC(:,5) -!PLOSS(PHO) = +K083*<NO2>+K084*<HO2> - PLOSS(:,37) = +TPK%K083(:)*PCONC(:,4)+TPK%K084(:)*PCONC(:,16) -! -!PPROD(ADD) = +0.93968*K061*<ARO>*<OH> - PPROD(:,38) = +0.93968*TPK%K061(:)*PCONC(:,22)*PCONC(:,15) -!PLOSS(ADD) = +K085*<NO2>+K086*<O2>+K087*<O3> - PLOSS(:,38) = +TPK%K085(:)*PCONC(:,4)+TPK%K086(:)*TPK%O2(:)+TPK%K087(:)*PCONC(& -&:,1) -! -!PPROD(AROP) = +0.98*K086*<ADD>*<O2> - PPROD(:,39) = +0.98*TPK%K086(:)*PCONC(:,38)*TPK%O2(:) -!PLOSS(AROP) = +K094*<NO>+K0101*<HO2>+K108*<MO2>+K114*<CARBOP>+K123*<NO3> - PLOSS(:,39) = +TPK%K094(:)*PCONC(:,3)+TPK%K0101(:)*PCONC(:,16)+TPK%K108(:)*PCO& -&NC(:,33)+TPK%K114(:)*PCONC(:,40)+TPK%K123(:)*PCONC(:,5) -! -!PPROD(CARBOP) = +1.00000*K015*<KET>+0.69622*K016*<CARBO>+1.00000*K063*<ALD>*<O -!H>+1.00000*K064*<KET>*<OH>+0.51419*K065*<CARBO>*<OH>+0.05413*K069*<OP2>*<OH>+1 -!.00000*K073*<ALD>*<NO3>+0.38881*K074*<CARBO>*<NO3>+0.05705*K079*<ALKE>*<O3>+0. -!17000*K080*<BIO>*<O3>+0.27460*K081*<CARBO>*<O3>+0.70000*K082*<PAN>*<O3>+1.0000 -!0*K089*<PAN>+0.09532*K095*<CARBOP>*<NO>+0.05954*K109*<CARBOP>*<MO2>+0.05821*K1 -!15*<CARBOP>*<CARBOP>+0.03175*K124*<CARBOP>*<NO3> - PPROD(:,40) = +1.00000*TPK%K015(:)*PCONC(:,25)+0.69622*TPK%K016(:)*PCONC(:,26)& -&+1.00000*TPK%K063(:)*PCONC(:,24)*PCONC(:,15)+1.00000*TPK%K064(:)*PCONC(:,25)*P& -&CONC(:,15)+0.51419*TPK%K065(:)*PCONC(:,26)*PCONC(:,15)+0.05413*TPK%K069(:)*PCO& -&NC(:,30)*PCONC(:,15)+1.00000*TPK%K073(:)*PCONC(:,24)*PCONC(:,5)+0.38881*TPK%K0& -&74(:)*PCONC(:,26)*PCONC(:,5)+0.05705*TPK%K079(:)*PCONC(:,20)*PCONC(:,1)+0.1700& -&0*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.27460*TPK%K081(:)*PCONC(:,26)*PCONC(:,1& -&)+0.70000*TPK%K082(:)*PCONC(:,28)*PCONC(:,1)+1.00000*TPK%K089(:)*PCONC(:,28)+0& -&.09532*TPK%K095(:)*PCONC(:,40)*PCONC(:,3)+0.05954*TPK%K109(:)*PCONC(:,40)*PCON& -&C(:,33)+0.05821*TPK%K115(:)*PCONC(:,40)*PCONC(:,40)+0.03175*TPK%K124(:)*PCONC(& -&:,40)*PCONC(:,5) -!PLOSS(CARBOP) = +K088*<NO2>+K095*<NO>+K0102*<HO2>+K109*<MO2>+K111*<ALKAP>+K112 -!*<ALKEP>+K113*<BIOP>+K114*<AROP>+K115*<CARBOP>+K115*<CARBOP>+K116*<OLN>+K124*< -!NO3>+K128*<XO2> - PLOSS(:,40) = +TPK%K088(:)*PCONC(:,4)+TPK%K095(:)*PCONC(:,3)+TPK%K0102(:)*PCON& -&C(:,16)+TPK%K109(:)*PCONC(:,33)+TPK%K111(:)*PCONC(:,34)+TPK%K112(:)*PCONC(:,35& -&)+TPK%K113(:)*PCONC(:,36)+TPK%K114(:)*PCONC(:,39)+TPK%K115(:)*PCONC(:,40)+TPK%& -&K115(:)*PCONC(:,40)+TPK%K116(:)*PCONC(:,41)+TPK%K124(:)*PCONC(:,5)+TPK%K128(:)& -&*PCONC(:,42) -! -RETURN -END SUBROUTINE SUB3 -! -SUBROUTINE SUB4 -! -!Indices 41 a 42 -! -! -!PPROD(OLN) = +0.00000*K074*<CARBO>*<NO3>+0.93768*K076*<ALKE>*<NO3>+1.00000*K07 -!7*<BIO>*<NO3> - PPROD(:,41) = +0.00000*TPK%K074(:)*PCONC(:,26)*PCONC(:,5)+0.93768*TPK%K076(:)*& -&PCONC(:,20)*PCONC(:,5)+1.00000*TPK%K077(:)*PCONC(:,21)*PCONC(:,5) -!PLOSS(OLN) = +K096*<NO>+K103*<HO2>+K110*<MO2>+K116*<CARBOP>+K117*<OLN>+K117*<O -!LN>+K118*<OLN>+K118*<OLN>+K125*<NO3> - PLOSS(:,41) = +TPK%K096(:)*PCONC(:,3)+TPK%K103(:)*PCONC(:,16)+TPK%K110(:)*PCON& -&C(:,33)+TPK%K116(:)*PCONC(:,40)+TPK%K117(:)*PCONC(:,41)+TPK%K117(:)*PCONC(:,41& -&)+TPK%K118(:)*PCONC(:,41)+TPK%K118(:)*PCONC(:,41)+TPK%K125(:)*PCONC(:,5) -! -!PPROD(XO2) = +0.15*K054*<BIO>*<O3P>+0.10318*K061*<ARO>*<OH>+0.10162*K065*<CARB -!O>*<OH>+0.09333*K069*<OP2>*<OH>+K070*<PAN>*<OH>+0.10530*K074*<CARBO>*<NO3>+K07 -!8*<PAN>*<NO3>+0.00000*K079*<ALKE>*<O3>+0.13000*K080*<BIO>*<O3>+0.13007*K091*<A -!LKAP>*<NO>+0.02563*K095*<CARBOP>*<NO>+0.13370*K105*<ALKAP>*<MO2>+0.02212*K109* -!<CARBOP>*<MO2>+0.11306*K111*<ALKAP>*<CARBOP>+0.01593*K115*<CARBOP>*<CARBOP>+0. -!16271*K120*<ALKAP>*<NO3>+0.01021*K124*<CARBOP>*<NO3> - PPROD(:,42) = +0.15*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:)+0.10318*TPK%K061(:)*PCO& -&NC(:,22)*PCONC(:,15)+0.10162*TPK%K065(:)*PCONC(:,26)*PCONC(:,15)+0.09333*TPK%K& -&069(:)*PCONC(:,30)*PCONC(:,15)+TPK%K070(:)*PCONC(:,28)*PCONC(:,15)+0.10530*TPK& -&%K074(:)*PCONC(:,26)*PCONC(:,5)+TPK%K078(:)*PCONC(:,28)*PCONC(:,5)+0.00000*TPK& -&%K079(:)*PCONC(:,20)*PCONC(:,1)+0.13000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.1& -&3007*TPK%K091(:)*PCONC(:,34)*PCONC(:,3)+0.02563*TPK%K095(:)*PCONC(:,40)*PCONC(& -&:,3)+0.13370*TPK%K105(:)*PCONC(:,34)*PCONC(:,33)+0.02212*TPK%K109(:)*PCONC(:,4& -&0)*PCONC(:,33)+0.11306*TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.01593*TPK%K115(:)& -&*PCONC(:,40)*PCONC(:,40)+0.16271*TPK%K120(:)*PCONC(:,34)*PCONC(:,5)+0.01021*TP& -&K%K124(:)*PCONC(:,40)*PCONC(:,5) -!PLOSS(XO2) = +K126*<HO2>+K127*<MO2>+K128*<CARBOP>+K129*<XO2>+K129*<XO2>+K130*< -!NO>+K131*<NO3> - PLOSS(:,42) = +TPK%K126(:)*PCONC(:,16)+TPK%K127(:)*PCONC(:,33)+TPK%K128(:)*PCO& -&NC(:,40)+TPK%K129(:)*PCONC(:,42)+TPK%K129(:)*PCONC(:,42)+TPK%K130(:)*PCONC(:,3& -&)+TPK%K131(:)*PCONC(:,5) -! -RETURN -END SUBROUTINE SUB4 -! -END SUBROUTINE CH_PRODLOSS_GAZ -! -! -!======================================================================== -! -!! ################## - MODULE MODI_CH_FCN -!! ################## -!! This code has been created automatically by preprocessor m10, -!! version: 9.7, copyright 1995-1999 by Meteo France/Universite Paul Sabatier. -!! Please report all bugs to K. Suhre (Lab. d'Aerologie UPS/CNRS). -INTERFACE -SUBROUTINE CH_FCN(PTIME,PCONC,PDCDT,KMI,KVECNPT,KEQ) -IMPLICIT NONE -REAL, INTENT(IN) :: PTIME -INTEGER, INTENT(IN) :: KVECNPT -INTEGER, INTENT(IN) :: KEQ -REAL, INTENT(IN), DIMENSION(KVECNPT,KEQ) :: PCONC -REAL, INTENT(OUT), DIMENSION(KVECNPT,KEQ) :: PDCDT -INTEGER, INTENT(IN) :: KMI -!! -END SUBROUTINE CH_FCN -END INTERFACE -END MODULE MODI_CH_FCN -! -!======================================================================== -! -!! ######################################## - SUBROUTINE CH_FCN(PTIME,PCONC,PDCDT,KMI,KVECNPT,KEQ) -!! ######################################## -!! This code has been created automatically by preprocessor m10, -!! version: 9.7, copyright 1995-1999 by Meteo France/Universite Paul Sabatier. -!! Please report all bugs to K. Suhre (Lab. d'Aerologie UPS/CNRS). -!!*** *CH_FCN* -!! -!! PURPOSE -!! ------- -! calculation of first derivative for the chemical reaction mechanism -!! -!!** METHOD -!! ------ -!! For each prognostic chemical species the first derivative is -!! calculated as defined by the chemical reaction mechanism. -!! The reaction rates and other user-defined auxiliary variables are -!! transfered in the TYPE(CCSTYPE) variable TPK%. -!! The subroutine PRODLOSS is called in order to calculate P and L -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Karsten Suhre (LA) -!! -!! MODIFICATIONS -!! ------------- -!! Original 26/07/96 -!! Modified 05/05/98: Vectorization (Vincent Crassier & KS) -!! Modified 31/10/03: New interface for better MesoNH compilation (D. Gazen) -!! -!!---------------------------------------------------------------------- -!! -!! EXTERNAL -!! -------- -USE MODI_CH_PRODLOSS -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! none -!! -!! EXPLICIT ARGUMENTS -!! ------------------ -IMPLICIT NONE -REAL, INTENT(IN) :: PTIME -INTEGER, INTENT(IN) :: KVECNPT -INTEGER, INTENT(IN) :: KEQ -REAL, INTENT(IN), DIMENSION(KVECNPT,KEQ) :: PCONC -REAL, INTENT(OUT), DIMENSION(KVECNPT,KEQ) :: PDCDT -INTEGER, INTENT(IN) :: KMI -!! -!! LOCAL VARIABLES -!! --------------- -REAL, DIMENSION(KVECNPT,KEQ) :: ZPROD, ZLOSS -!! -!!---------------------------------------------------------------------- -!! -CALL CH_PRODLOSS(PTIME,PCONC,ZPROD,ZLOSS,KMI,KVECNPT,KEQ) -PDCDT(:,:) = ZPROD(:,:) - PCONC(:,:) * ZLOSS(:,:) -RETURN -END SUBROUTINE CH_FCN -! -! -!======================================================================== -! -!! ################## - MODULE MODI_CH_JAC -!! ################## -!! This code has been created automatically by preprocessor m10, -!! version: 9.7, copyright 1995-1999 by Meteo France/Universite Paul Sabatier. -!! Please report all bugs to K. Suhre (Lab. d'Aerologie UPS/CNRS). -INTERFACE -SUBROUTINE CH_JAC(PTIME,PCONC,PJAC,KMI,KVECNPT,KEQ) -IMPLICIT NONE -REAL, INTENT(IN) :: PTIME -INTEGER, INTENT(IN) :: KVECNPT -INTEGER, INTENT(IN) :: KEQ -REAL, INTENT(IN), DIMENSION(KVECNPT,KEQ) :: PCONC -REAL, INTENT(OUT), DIMENSION(KVECNPT,KEQ,KEQ) :: PJAC -INTEGER, INTENT(IN) :: KMI -END SUBROUTINE CH_JAC -END INTERFACE -END MODULE MODI_CH_JAC -! -!======================================================================== -! -!! ####################################### - SUBROUTINE CH_JAC(PTIME,PCONC,PJAC,KMI,KVECNPT,KEQ) -!! ####################################### -!! This code has been created automatically by preprocessor m10, -!! version: 9.7, copyright 1995-1999 by Meteo France/Universite Paul Sabatier. -!! Please report all bugs to K. Suhre (Lab. d'Aerologie UPS/CNRS). -!!*** *CH_JAC* -!! -!! PURPOSE -!! ------- -! calculation of the JACOBIAN matrix -!! -!!** METHOD -!! ------ -!! The Jacobian matrix J is calculated as defined by the chemical -!! reaction mechanism. -!! The reaction rates and other user-defined auxiliary variables are -!! transfered in the TYPE(CCSTYPE) variable TPK%. -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Karsten Suhre (LA) -!! -!! MODIFICATIONS -!! ------------- -!! Original 26/07/96 -!! Modified 05/05/98: Vectorization (Vincent Crassier & KS) -!! Modified 31/10/03: New interface for better MesoNH compilation (D. Gazen) -!! -!!---------------------------------------------------------------------- -!! -!! EXTERNAL -!! -------- -!! none -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -USE MODD_CH_M9_SCHEME -USE MODI_CH_JAC_AQ -USE MODI_CH_JAC_GAZ -!! -!! EXPLICIT ARGUMENTS -!! ------------------ -IMPLICIT NONE -REAL, INTENT(IN) :: PTIME -INTEGER, INTENT(IN) :: KVECNPT -INTEGER, INTENT(IN) :: KEQ -REAL, INTENT(IN), DIMENSION(KVECNPT,KEQ) :: PCONC -REAL, INTENT(OUT), DIMENSION(KVECNPT,KEQ,KEQ) :: PJAC -INTEGER, INTENT(IN) :: KMI -! -TYPE(CCSTYPE), POINTER :: TPK -!! -!!---------------------------------------------------------------------- -!! -TPK=>TACCS(KMI) -IF (TPK%LUSECHAQ) THEN - CALL CH_JAC_AQ(PTIME,PCONC,PJAC,KMI,KVECNPT,KEQ) -ELSE - CALL CH_JAC_GAZ(PTIME,PCONC,PJAC,KMI,KVECNPT,KEQ) -END IF -END SUBROUTINE CH_JAC -! -!======================================================================== -! -!! ################## - MODULE MODI_CH_JAC_AQ -!! ################## -INTERFACE -SUBROUTINE CH_JAC_AQ(PTIME,PCONC,PJAC,KMI,KVECNPT,KEQ) -IMPLICIT NONE -REAL, INTENT(IN) :: PTIME -INTEGER, INTENT(IN) :: KVECNPT -INTEGER, INTENT(IN) :: KEQ -REAL, INTENT(IN), DIMENSION(KVECNPT,KEQ) :: PCONC -REAL, INTENT(OUT), DIMENSION(KVECNPT,KEQ,KEQ) :: PJAC -INTEGER, INTENT(IN) :: KMI -END SUBROUTINE CH_JAC_AQ -END INTERFACE -END MODULE MODI_CH_JAC_AQ -! -!======================================================================== -! -!! #################### - SUBROUTINE CH_JAC_AQ(PTIME,PCONC,PJAC,KMI,KVECNPT,KEQ) -!! #################### -!! This code has been created automatically by preprocessor m10, -!! version: 9.7, copyright 1995-1999 by Meteo France/Universite Paul Sabatier. -!! Please report all bugs to K. Suhre (Lab. d'Aerologie UPS/CNRS). -!!*** *CH_JAC* -!! -!! PURPOSE -!! ------- -! calculation of the JACOBIAN matrix -!! -!!** METHOD -!! ------ -!! The Jacobian matrix J is calculated as defined by the chemical -!! reaction mechanism. -!! The reaction rates and other user-defined auxiliary variables are -!! transfered in the TYPE(CCSTYPE) variable TPK%. -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Karsten Suhre (LA) -!! -!! MODIFICATIONS -!! ------------- -!! Original 26/07/96 -!! Modified 05/05/98: Vectorization (Vincent Crassier & KS) -!! Modified 31/10/03: New interface for better MesoNH compilation (D. Gazen) -!! -!!---------------------------------------------------------------------- -!! -!! EXTERNAL -!! -------- -!! none -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -USE MODD_CH_M9_SCHEME -!! -!! EXPLICIT ARGUMENTS -!! ------------------ -IMPLICIT NONE -REAL, INTENT(IN) :: PTIME -INTEGER, INTENT(IN) :: KVECNPT -INTEGER, INTENT(IN) :: KEQ -REAL, INTENT(IN), DIMENSION(KVECNPT,KEQ) :: PCONC -REAL, INTENT(OUT), DIMENSION(KVECNPT,KEQ,KEQ) :: PJAC -INTEGER, INTENT(IN) :: KMI -! -TYPE(CCSTYPE), POINTER :: TPK -TPK=>TACCS(KMI) -! -! /BEGIN_CODE/ -TPK%O1D(:)=(TPK%K002(:)*PCONC(:,JP_O3))/(TPK%K020(:)*TPK%N2(:)+TPK%K021(:)*TPK%O2(:)+& - &TPK%K022(:)*TPK%H2O(:)) -TPK%O3P(:)=(TPK%K001(:)*PCONC(:,JP_NO2)+TPK%K003(:)*PCONC(:,JP_O3)+TPK%K008(:)*PCONC(:,JP_NO3)+& - &TPK%K020(:)*TPK%O1D(:)*TPK%N2(:)+TPK%K021(:)*TPK%O1D(:)*TPK%O2(:)+& - &0.00000*TPK%K079(:)*PCONC(:,JP_ALKE)*PCONC(:,JP_O3)+& - &0.09000*TPK%K080(:)*PCONC(:,JP_BIO)*PCONC(:,JP_O3))/& - &(TPK%K018(:)*TPK%O2(:)+TPK%K019(:)*PCONC(:,JP_O3)+TPK%K029(:)*PCONC(:,JP_NO)+& - &TPK%K030(:)*PCONC(:,JP_NO2)+TPK%K031(:)*PCONC(:,JP_NO2)+TPK%K054(:)*PCONC(:,JP_BIO)+& - &TPK%K055(:)*PCONC(:,JP_CARBO)+TPK%K134(:)*PCONC(:,JP_DMS)) -! /END_CODE/ -PJAC(:,:,:) = 0.0 -CALL SUBJ0 -CALL SUBJ1 -CALL SUBJ2 -CALL SUBJ3 -CALL SUBJ4 -CALL SUBJ5 -CALL SUBJ6 -CALL SUBJ7 -CALL SUBJ8 -CALL SUBJ9 -CALL SUBJ10 -CALL SUBJ11 -CALL SUBJ12 -CALL SUBJ13 -CALL SUBJ14 -CALL SUBJ15 -CALL SUBJ16 -CALL SUBJ17 -CALL SUBJ18 -! - -CONTAINS - -SUBROUTINE SUBJ0 -! -!Indices 1 a 5 -! -! -!O3/O3=-K002-K003-K019*<O3P>-K023*<OH>-K024*<HO2>-K042*<NO>-K043*<NO2>-K079*<AL -!KE>-K080*<BIO>-K081*<CARBO>-K082*<PAN>-K087*<ADD>-KTC1-KTR1 - PJAC(:,1,1)=-TPK%K002(:)-TPK%K003(:)-TPK%K019(:)*TPK%O3P(:)-TPK%K023(:)*PCONC(& -&:,15)-TPK%K024(:)*PCONC(:,16)-TPK%K042(:)*PCONC(:,3)-TPK%K043(:)*PCONC(:,4)-TP& -&K%K079(:)*PCONC(:,20)-TPK%K080(:)*PCONC(:,21)-TPK%K081(:)*PCONC(:,26)-TPK%K082& -&(:)*PCONC(:,28)-TPK%K087(:)*PCONC(:,38)-TPK%KTC1(:)-TPK%KTR1(:) -! -!O3/H2O2=0.0 -! -!O3/NO=-K042*<O3> - PJAC(:,1,3)=-TPK%K042(:)*PCONC(:,1) -! -!O3/NO2=-K043*<O3> - PJAC(:,1,4)=-TPK%K043(:)*PCONC(:,1) -! -!O3/NO3=0.0 -! -!O3/N2O5=0.0 -! -!O3/HONO=0.0 -! -!O3/HNO3=0.0 -! -!O3/HNO4=0.0 -! -!O3/NH3=0.0 -! -!O3/DMS=0.0 -! -!O3/SO2=0.0 -! -!O3/SULF=0.0 -! -!O3/CO=0.0 -! -!O3/OH=-K023*<O3> - PJAC(:,1,15)=-TPK%K023(:)*PCONC(:,1) -! -!O3/HO2=-K024*<O3>+0.17307*K0102*<CARBOP> - PJAC(:,1,16)=-TPK%K024(:)*PCONC(:,1)+0.17307*TPK%K0102(:)*PCONC(:,40) -! -!O3/CH4=0.0 -! -!O3/ETH=0.0 -! -!O3/ALKA=0.0 -! -!O3/ALKE=-K079*<O3> - PJAC(:,1,20)=-TPK%K079(:)*PCONC(:,1) -! -!O3/BIO=-K080*<O3> - PJAC(:,1,21)=-TPK%K080(:)*PCONC(:,1) -! -!O3/ARO=0.0 -! -!O3/HCHO=0.0 -! -!O3/ALD=0.0 -! -!O3/KET=0.0 -! -!O3/CARBO=-K081*<O3> - PJAC(:,1,26)=-TPK%K081(:)*PCONC(:,1) -! -!O3/ONIT=0.0 -! -!O3/PAN=-K082*<O3> - PJAC(:,1,28)=-TPK%K082(:)*PCONC(:,1) -! -!O3/OP1=0.0 -! -!O3/OP2=0.0 -! -!O3/ORA1=0.0 -! -!O3/ORA2=0.0 -! -!O3/MO2=0.0 -! -!O3/ALKAP=0.0 -! -!O3/ALKEP=0.0 -! -!O3/BIOP=0.0 -! -!O3/PHO=0.0 -! -!O3/ADD=-K087*<O3> - PJAC(:,1,38)=-TPK%K087(:)*PCONC(:,1) -! -!O3/AROP=0.0 -! -!O3/CARBOP=+0.17307*K0102*<HO2> - PJAC(:,1,40)=+0.17307*TPK%K0102(:)*PCONC(:,16) -! -!O3/OLN=0.0 -! -!O3/XO2=0.0 -! -!O3/WC_O3=+KTC21 - PJAC(:,1,43)=+TPK%KTC21(:) -! -!O3/WC_H2O2=0.0 -! -!O3/WC_NO=0.0 -! -!O3/WC_NO2=0.0 -! -!O3/WC_NO3=0.0 -! -!O3/WC_N2O5=0.0 -! -!O3/WC_HONO=0.0 -! -!O3/WC_HNO3=0.0 -! -!O3/WC_HNO4=0.0 -! -!O3/WC_NH3=0.0 -! -!O3/WC_OH=0.0 -! -!O3/WC_HO2=0.0 -! -!O3/WC_CO2=0.0 -! -!O3/WC_SO2=0.0 -! -!O3/WC_SULF=0.0 -! -!O3/WC_HCHO=0.0 -! -!O3/WC_ORA1=0.0 -! -!O3/WC_ORA2=0.0 -! -!O3/WC_MO2=0.0 -! -!O3/WC_OP1=0.0 -! -!O3/WC_ASO3=0.0 -! -!O3/WC_ASO4=0.0 -! -!O3/WC_ASO5=0.0 -! -!O3/WC_AHSO5=0.0 -! -!O3/WC_AHMS=0.0 -! -!O3/WR_O3=+KTR21 - PJAC(:,1,68)=+TPK%KTR21(:) -! -!O3/WR_H2O2=0.0 -! -!O3/WR_NO=0.0 -! -!O3/WR_NO2=0.0 -! -!O3/WR_NO3=0.0 -! -!O3/WR_N2O5=0.0 -! -!O3/WR_HONO=0.0 -! -!O3/WR_HNO3=0.0 -! -!O3/WR_HNO4=0.0 -! -!O3/WR_NH3=0.0 -! -!O3/WR_OH=0.0 -! -!O3/WR_HO2=0.0 -! -!O3/WR_CO2=0.0 -! -!O3/WR_SO2=0.0 -! -!O3/WR_SULF=0.0 -! -!O3/WR_HCHO=0.0 -! -!O3/WR_ORA1=0.0 -! -!O3/WR_ORA2=0.0 -! -!O3/WR_MO2=0.0 -! -!O3/WR_OP1=0.0 -! -!O3/WR_ASO3=0.0 -! -!O3/WR_ASO4=0.0 -! -!O3/WR_ASO5=0.0 -! -!O3/WR_AHSO5=0.0 -! -!O3/WR_AHMS=0.0 -! -!H2O2/O3=+0.01833*K079*<ALKE>+0.00100*K080*<BIO> - PJAC(:,2,1)=+0.01833*TPK%K079(:)*PCONC(:,20)+0.00100*TPK%K080(:)*PCONC(:,21) -! -!H2O2/H2O2=-K009-K026*<OH>-KTC2-KTR2 - PJAC(:,2,2)=-TPK%K009(:)-TPK%K026(:)*PCONC(:,15)-TPK%KTC2(:)-TPK%KTR2(:) -! -!H2O2/NO=0.0 -! -!H2O2/NO2=0.0 -! -!H2O2/NO3=0.0 -! -!H2O2/N2O5=0.0 -! -!H2O2/HONO=0.0 -! -!H2O2/HNO3=0.0 -! -!H2O2/HNO4=0.0 -! -!H2O2/NH3=0.0 -! -!H2O2/DMS=0.0 -! -!H2O2/SO2=0.0 -! -!H2O2/SULF=0.0 -! -!H2O2/CO=0.0 -! -!H2O2/OH=-K026*<H2O2> - PJAC(:,2,15)=-TPK%K026(:)*PCONC(:,2) -! -!H2O2/HO2=+K027*<HO2>+K027*<HO2>+K028*<HO2>*<H2O>+K028*<HO2>*<H2O> - PJAC(:,2,16)=+TPK%K027(:)*PCONC(:,16)+TPK%K027(:)*PCONC(:,16)+TPK%K028(:)*PCON& -&C(:,16)*TPK%H2O(:)+TPK%K028(:)*PCONC(:,16)*TPK%H2O(:) -! -!H2O2/CH4=0.0 -! -!H2O2/ETH=0.0 -! -!H2O2/ALKA=0.0 -! -!H2O2/ALKE=+0.01833*K079*<O3> - PJAC(:,2,20)=+0.01833*TPK%K079(:)*PCONC(:,1) -! -!H2O2/BIO=+0.00100*K080*<O3> - PJAC(:,2,21)=+0.00100*TPK%K080(:)*PCONC(:,1) -! -!H2O2/ARO=0.0 -! -!H2O2/HCHO=0.0 -! -!H2O2/ALD=0.0 -! -!H2O2/KET=0.0 -! -!H2O2/CARBO=0.0 -! -!H2O2/ONIT=0.0 -! -!H2O2/PAN=0.0 -! -!H2O2/OP1=0.0 -! -!H2O2/OP2=0.0 -! -!H2O2/ORA1=0.0 -! -!H2O2/ORA2=0.0 -! -!H2O2/MO2=0.0 -! -!H2O2/ALKAP=0.0 -! -!H2O2/ALKEP=0.0 -! -!H2O2/BIOP=0.0 -! -!H2O2/PHO=0.0 -! -!H2O2/ADD=0.0 -! -!H2O2/AROP=0.0 -! -!H2O2/CARBOP=0.0 -! -!H2O2/OLN=0.0 -! -!H2O2/XO2=0.0 -! -!H2O2/WC_O3=0.0 -! -!H2O2/WC_H2O2=+KTC22 - PJAC(:,2,44)=+TPK%KTC22(:) -! -!H2O2/WC_NO=0.0 -! -!H2O2/WC_NO2=0.0 -! -!H2O2/WC_NO3=0.0 -! -!H2O2/WC_N2O5=0.0 -! -!H2O2/WC_HONO=0.0 -! -!H2O2/WC_HNO3=0.0 -! -!H2O2/WC_HNO4=0.0 -! -!H2O2/WC_NH3=0.0 -! -!H2O2/WC_OH=0.0 -! -!H2O2/WC_HO2=0.0 -! -!H2O2/WC_CO2=0.0 -! -!H2O2/WC_SO2=0.0 -! -!H2O2/WC_SULF=0.0 -! -!H2O2/WC_HCHO=0.0 -! -!H2O2/WC_ORA1=0.0 -! -!H2O2/WC_ORA2=0.0 -! -!H2O2/WC_MO2=0.0 -! -!H2O2/WC_OP1=0.0 -! -!H2O2/WC_ASO3=0.0 -! -!H2O2/WC_ASO4=0.0 -! -!H2O2/WC_ASO5=0.0 -! -!H2O2/WC_AHSO5=0.0 -! -!H2O2/WC_AHMS=0.0 -! -!H2O2/WR_O3=0.0 -! -!H2O2/WR_H2O2=+KTR22 - PJAC(:,2,69)=+TPK%KTR22(:) -! -!H2O2/WR_NO=0.0 -! -!H2O2/WR_NO2=0.0 -! -!H2O2/WR_NO3=0.0 -! -!H2O2/WR_N2O5=0.0 -! -!H2O2/WR_HONO=0.0 -! -!H2O2/WR_HNO3=0.0 -! -!H2O2/WR_HNO4=0.0 -! -!H2O2/WR_NH3=0.0 -! -!H2O2/WR_OH=0.0 -! -!H2O2/WR_HO2=0.0 -! -!H2O2/WR_CO2=0.0 -! -!H2O2/WR_SO2=0.0 -! -!H2O2/WR_SULF=0.0 -! -!H2O2/WR_HCHO=0.0 -! -!H2O2/WR_ORA1=0.0 -! -!H2O2/WR_ORA2=0.0 -! -!H2O2/WR_MO2=0.0 -! -!H2O2/WR_OP1=0.0 -! -!H2O2/WR_ASO3=0.0 -! -!H2O2/WR_ASO4=0.0 -! -!H2O2/WR_ASO5=0.0 -! -!H2O2/WR_AHSO5=0.0 -! -!H2O2/WR_AHMS=0.0 -! -!NO/O3=-K042*<NO> - PJAC(:,3,1)=-TPK%K042(:)*PCONC(:,3) -! -!NO/H2O2=0.0 -! -!NO/NO=-K029*<O3P>-K032*<OH>-K035*<HO2>-K042*<O3>-K044*<NO>*<O2>-K044*<NO>*<O2> -!-K044*<NO>*<O2>-K044*<NO>*<O2>-K045*<NO3>-K090*<MO2>-K091*<ALKAP>-K092*<ALKEP> -!-K093*<BIOP>-K094*<AROP>-K095*<CARBOP>-K096*<OLN>-K130*<XO2>-KTC3-KTR3 - PJAC(:,3,3)=-TPK%K029(:)*TPK%O3P(:)-TPK%K032(:)*PCONC(:,15)-TPK%K035(:)*PCONC(& -&:,16)-TPK%K042(:)*PCONC(:,1)-TPK%K044(:)*PCONC(:,3)*TPK%O2(:)-TPK%K044(:)*PCON& -&C(:,3)*TPK%O2(:)-TPK%K044(:)*PCONC(:,3)*TPK%O2(:)-TPK%K044(:)*PCONC(:,3)*TPK%O& -&2(:)-TPK%K045(:)*PCONC(:,5)-TPK%K090(:)*PCONC(:,33)-TPK%K091(:)*PCONC(:,34)-TP& -&K%K092(:)*PCONC(:,35)-TPK%K093(:)*PCONC(:,36)-TPK%K094(:)*PCONC(:,39)-TPK%K095& -&(:)*PCONC(:,40)-TPK%K096(:)*PCONC(:,41)-TPK%K130(:)*PCONC(:,42)-TPK%KTC3(:)-TP& -&K%KTR3(:) -! -!NO/NO2=+K001+K030*<O3P>+K046*<NO3> - PJAC(:,3,4)=+TPK%K001(:)+TPK%K030(:)*TPK%O3P(:)+TPK%K046(:)*PCONC(:,5) -! -!NO/NO3=+K007-K045*<NO>+K046*<NO2> - PJAC(:,3,5)=+TPK%K007(:)-TPK%K045(:)*PCONC(:,3)+TPK%K046(:)*PCONC(:,4) -! -!NO/N2O5=0.0 -! -!NO/HONO=+K004 - PJAC(:,3,7)=+TPK%K004(:) -! -!NO/HNO3=0.0 -! -!NO/HNO4=0.0 -! -!NO/NH3=0.0 -! -!NO/DMS=0.0 -! -!NO/SO2=0.0 -! -!NO/SULF=0.0 -! -!NO/CO=0.0 -! -!NO/OH=-K032*<NO> - PJAC(:,3,15)=-TPK%K032(:)*PCONC(:,3) -! -!NO/HO2=-K035*<NO> - PJAC(:,3,16)=-TPK%K035(:)*PCONC(:,3) -! -!NO/CH4=0.0 -! -!NO/ETH=0.0 -! -!NO/ALKA=0.0 -! -!NO/ALKE=0.0 -! -!NO/BIO=0.0 -! -!NO/ARO=0.0 -! -!NO/HCHO=0.0 -! -!NO/ALD=0.0 -! -!NO/KET=0.0 -! -!NO/CARBO=0.0 -! -!NO/ONIT=0.0 -! -!NO/PAN=0.0 -! -!NO/OP1=0.0 -! -!NO/OP2=0.0 -! -!NO/ORA1=0.0 -! -!NO/ORA2=0.0 -! -!NO/MO2=-K090*<NO> - PJAC(:,3,33)=-TPK%K090(:)*PCONC(:,3) -! -!NO/ALKAP=-K091*<NO> - PJAC(:,3,34)=-TPK%K091(:)*PCONC(:,3) -! -!NO/ALKEP=-K092*<NO> - PJAC(:,3,35)=-TPK%K092(:)*PCONC(:,3) -! -!NO/BIOP=-K093*<NO> - PJAC(:,3,36)=-TPK%K093(:)*PCONC(:,3) -! -!NO/PHO=0.0 -! -!NO/ADD=0.0 -! -!NO/AROP=-K094*<NO> - PJAC(:,3,39)=-TPK%K094(:)*PCONC(:,3) -! -!NO/CARBOP=-K095*<NO> - PJAC(:,3,40)=-TPK%K095(:)*PCONC(:,3) -! -!NO/OLN=-K096*<NO> - PJAC(:,3,41)=-TPK%K096(:)*PCONC(:,3) -! -!NO/XO2=-K130*<NO> - PJAC(:,3,42)=-TPK%K130(:)*PCONC(:,3) -! -!NO/WC_O3=0.0 -! -!NO/WC_H2O2=0.0 -! -!NO/WC_NO=+KTC23 - PJAC(:,3,45)=+TPK%KTC23(:) -! -!NO/WC_NO2=0.0 -! -!NO/WC_NO3=0.0 -! -!NO/WC_N2O5=0.0 -! -!NO/WC_HONO=0.0 -! -!NO/WC_HNO3=0.0 -! -!NO/WC_HNO4=0.0 -! -!NO/WC_NH3=0.0 -! -!NO/WC_OH=0.0 -! -!NO/WC_HO2=0.0 -! -!NO/WC_CO2=0.0 -! -!NO/WC_SO2=0.0 -! -!NO/WC_SULF=0.0 -! -!NO/WC_HCHO=0.0 -! -!NO/WC_ORA1=0.0 -! -!NO/WC_ORA2=0.0 -! -!NO/WC_MO2=0.0 -! -!NO/WC_OP1=0.0 -! -!NO/WC_ASO3=0.0 -! -!NO/WC_ASO4=0.0 -! -!NO/WC_ASO5=0.0 -! -!NO/WC_AHSO5=0.0 -! -!NO/WC_AHMS=0.0 -! -!NO/WR_O3=0.0 -! -!NO/WR_H2O2=0.0 -! -!NO/WR_NO=+KTR23 - PJAC(:,3,70)=+TPK%KTR23(:) -! -!NO/WR_NO2=0.0 -! -!NO/WR_NO3=0.0 -! -!NO/WR_N2O5=0.0 -! -!NO/WR_HONO=0.0 -! -!NO/WR_HNO3=0.0 -! -!NO/WR_HNO4=0.0 -! -!NO/WR_NH3=0.0 -! -!NO/WR_OH=0.0 -! -!NO/WR_HO2=0.0 -! -!NO/WR_CO2=0.0 -! -!NO/WR_SO2=0.0 -! -!NO/WR_SULF=0.0 -! -!NO/WR_HCHO=0.0 -! -!NO/WR_ORA1=0.0 -! -!NO/WR_ORA2=0.0 -! -!NO/WR_MO2=0.0 -! -!NO/WR_OP1=0.0 -! -!NO/WR_ASO3=0.0 -! -!NO/WR_ASO4=0.0 -! -!NO/WR_ASO5=0.0 -! -!NO/WR_AHSO5=0.0 -! -!NO/WR_AHMS=0.0 -! -!NO2/O3=+K042*<NO>-K043*<NO2>+0.70*K082*<PAN> - PJAC(:,4,1)=+TPK%K042(:)*PCONC(:,3)-TPK%K043(:)*PCONC(:,4)+0.70*TPK%K082(:)*PC& -&ONC(:,28) -! -!NO2/H2O2=0.0 -! -!NO2/NO=+K029*<O3P>+K035*<HO2>+K042*<O3>+K044*<NO>*<O2>+K044*<NO>*<O2>+K044*<NO -!>*<O2>+K044*<NO>*<O2>+K045*<NO3>+K045*<NO3>+K090*<MO2>+0.91541*K091*<ALKAP>+K0 -!92*<ALKEP>+0.84700*K093*<BIOP>+0.95115*K094*<AROP>+K095*<CARBOP>+1.81599*K096* -!<OLN>+K130*<XO2> - PJAC(:,4,3)=+TPK%K029(:)*TPK%O3P(:)+TPK%K035(:)*PCONC(:,16)+TPK%K042(:)*PCONC(& -&:,1)+TPK%K044(:)*PCONC(:,3)*TPK%O2(:)+TPK%K044(:)*PCONC(:,3)*TPK%O2(:)+TPK%K04& -&4(:)*PCONC(:,3)*TPK%O2(:)+TPK%K044(:)*PCONC(:,3)*TPK%O2(:)+TPK%K045(:)*PCONC(:& -&,5)+TPK%K045(:)*PCONC(:,5)+TPK%K090(:)*PCONC(:,33)+0.91541*TPK%K091(:)*PCONC(:& -&,34)+TPK%K092(:)*PCONC(:,35)+0.84700*TPK%K093(:)*PCONC(:,36)+0.95115*TPK%K094(& -&:)*PCONC(:,39)+TPK%K095(:)*PCONC(:,40)+1.81599*TPK%K096(:)*PCONC(:,41)+TPK%K13& -&0(:)*PCONC(:,42) -! -!NO2/NO2=-K001-K030*<O3P>-K031*<O3P>-K033*<OH>-K036*<HO2>-K043*<O3>+K046*<NO3>- -!K046*<NO3>-K047*<NO3>-K083*<PHO>-K085*<ADD>-K088*<CARBOP>-KTC4-KTR4 - PJAC(:,4,4)=-TPK%K001(:)-TPK%K030(:)*TPK%O3P(:)-TPK%K031(:)*TPK%O3P(:)-TPK%K03& -&3(:)*PCONC(:,15)-TPK%K036(:)*PCONC(:,16)-TPK%K043(:)*PCONC(:,1)+TPK%K046(:)*PC& -&ONC(:,5)-TPK%K046(:)*PCONC(:,5)-TPK%K047(:)*PCONC(:,5)-TPK%K083(:)*PCONC(:,37)& -&-TPK%K085(:)*PCONC(:,38)-TPK%K088(:)*PCONC(:,40)-TPK%KTC4(:)-TPK%KTR4(:) -! -!NO2/NO3=+K008+K034*<OH>+0.7*K038*<HO2>+K045*<NO>+K045*<NO>+K046*<NO2>-K046*<NO -!2>-K047*<NO2>+K049*<NO3>+K049*<NO3>+K049*<NO3>+K049*<NO3>+0.10530*K074*<CARBO> -!+0.40*K078*<PAN>+K119*<MO2>+K120*<ALKAP>+K121*<ALKEP>+K122*<BIOP>+K123*<AROP>+ -!K124*<CARBOP>+1.74072*K125*<OLN>+K131*<XO2>+K133*<DMS> - PJAC(:,4,5)=+TPK%K008(:)+TPK%K034(:)*PCONC(:,15)+0.7*TPK%K038(:)*PCONC(:,16)+T& -&PK%K045(:)*PCONC(:,3)+TPK%K045(:)*PCONC(:,3)+TPK%K046(:)*PCONC(:,4)-TPK%K046(:& -&)*PCONC(:,4)-TPK%K047(:)*PCONC(:,4)+TPK%K049(:)*PCONC(:,5)+TPK%K049(:)*PCONC(:& -&,5)+TPK%K049(:)*PCONC(:,5)+TPK%K049(:)*PCONC(:,5)+0.10530*TPK%K074(:)*PCONC(:,& -&26)+0.40*TPK%K078(:)*PCONC(:,28)+TPK%K119(:)*PCONC(:,33)+TPK%K120(:)*PCONC(:,3& -&4)+TPK%K121(:)*PCONC(:,35)+TPK%K122(:)*PCONC(:,36)+TPK%K123(:)*PCONC(:,39)+TPK& -&%K124(:)*PCONC(:,40)+1.74072*TPK%K125(:)*PCONC(:,41)+TPK%K131(:)*PCONC(:,42)+T& -&PK%K133(:)*PCONC(:,11) -! -!NO2/N2O5=+K048 - PJAC(:,4,6)=+TPK%K048(:) -! -!NO2/HONO=+K039*<OH> - PJAC(:,4,7)=+TPK%K039(:)*PCONC(:,15) -! -!NO2/HNO3=+K005 - PJAC(:,4,8)=+TPK%K005(:) -! -!NO2/HNO4=+0.65*K006+K037+K041*<OH> - PJAC(:,4,9)=+0.65*TPK%K006(:)+TPK%K037(:)+TPK%K041(:)*PCONC(:,15) -! -!NO2/NH3=0.0 -! -!NO2/DMS=+K133*<NO3> - PJAC(:,4,11)=+TPK%K133(:)*PCONC(:,5) -! -!NO2/SO2=0.0 -! -!NO2/SULF=0.0 -! -!NO2/CO=0.0 -! -!NO2/OH=-K033*<NO2>+K034*<NO3>+K039*<HONO>+K041*<HNO4>+K071*<ONIT> - PJAC(:,4,15)=-TPK%K033(:)*PCONC(:,4)+TPK%K034(:)*PCONC(:,5)+TPK%K039(:)*PCONC(& -&:,7)+TPK%K041(:)*PCONC(:,9)+TPK%K071(:)*PCONC(:,27) -! -!NO2/HO2=+K035*<NO>-K036*<NO2>+0.7*K038*<NO3> - PJAC(:,4,16)=+TPK%K035(:)*PCONC(:,3)-TPK%K036(:)*PCONC(:,4)+0.7*TPK%K038(:)*PC& -&ONC(:,5) -! -!NO2/CH4=0.0 -! -!NO2/ETH=0.0 -! -!NO2/ALKA=0.0 -! -!NO2/ALKE=0.0 -! -!NO2/BIO=0.0 -! -!NO2/ARO=0.0 -! -!NO2/HCHO=0.0 -! -!NO2/ALD=0.0 -! -!NO2/KET=0.0 -! -!NO2/CARBO=+0.10530*K074*<NO3> - PJAC(:,4,26)=+0.10530*TPK%K074(:)*PCONC(:,5) -! -!NO2/ONIT=+K017+K071*<OH> - PJAC(:,4,27)=+TPK%K017(:)+TPK%K071(:)*PCONC(:,15) -! -!NO2/PAN=+0.40*K078*<NO3>+0.70*K082*<O3>+K089 - PJAC(:,4,28)=+0.40*TPK%K078(:)*PCONC(:,5)+0.70*TPK%K082(:)*PCONC(:,1)+TPK%K089& -&(:) -! -!NO2/OP1=0.0 -! -!NO2/OP2=0.0 -! -!NO2/ORA1=0.0 -! -!NO2/ORA2=0.0 -! -!NO2/MO2=+K090*<NO>+0.32440*K110*<OLN>+K119*<NO3> - PJAC(:,4,33)=+TPK%K090(:)*PCONC(:,3)+0.32440*TPK%K110(:)*PCONC(:,41)+TPK%K119(& -&:)*PCONC(:,5) -! -!NO2/ALKAP=+0.91541*K091*<NO>+K120*<NO3> - PJAC(:,4,34)=+0.91541*TPK%K091(:)*PCONC(:,3)+TPK%K120(:)*PCONC(:,5) -! -!NO2/ALKEP=+K092*<NO>+K121*<NO3> - PJAC(:,4,35)=+TPK%K092(:)*PCONC(:,3)+TPK%K121(:)*PCONC(:,5) -! -!NO2/BIOP=+0.84700*K093*<NO>+K122*<NO3> - PJAC(:,4,36)=+0.84700*TPK%K093(:)*PCONC(:,3)+TPK%K122(:)*PCONC(:,5) -! -!NO2/PHO=-K083*<NO2> - PJAC(:,4,37)=-TPK%K083(:)*PCONC(:,4) -! -!NO2/ADD=-K085*<NO2> - PJAC(:,4,38)=-TPK%K085(:)*PCONC(:,4) -! -!NO2/AROP=+0.95115*K094*<NO>+K123*<NO3> - PJAC(:,4,39)=+0.95115*TPK%K094(:)*PCONC(:,3)+TPK%K123(:)*PCONC(:,5) -! -!NO2/CARBOP=-K088*<NO2>+K095*<NO>+0.00000*K116*<OLN>+K124*<NO3> - PJAC(:,4,40)=-TPK%K088(:)*PCONC(:,4)+TPK%K095(:)*PCONC(:,3)+0.00000*TPK%K116(:& -&)*PCONC(:,41)+TPK%K124(:)*PCONC(:,5) -! -!NO2/OLN=+1.81599*K096*<NO>+0.32440*K110*<MO2>+0.00000*K116*<CARBOP>+0.00000*K1 -!18*<OLN>+0.00000*K118*<OLN>+1.74072*K125*<NO3> - PJAC(:,4,41)=+1.81599*TPK%K096(:)*PCONC(:,3)+0.32440*TPK%K110(:)*PCONC(:,33)+0& -&.00000*TPK%K116(:)*PCONC(:,40)+0.00000*TPK%K118(:)*PCONC(:,41)+0.00000*TPK%K11& -&8(:)*PCONC(:,41)+1.74072*TPK%K125(:)*PCONC(:,5) -! -!NO2/XO2=+K130*<NO>+K131*<NO3> - PJAC(:,4,42)=+TPK%K130(:)*PCONC(:,3)+TPK%K131(:)*PCONC(:,5) -! -!NO2/WC_O3=0.0 -! -!NO2/WC_H2O2=0.0 -! -!NO2/WC_NO=0.0 -! -!NO2/WC_NO2=+KTC24 - PJAC(:,4,46)=+TPK%KTC24(:) -! -!NO2/WC_NO3=0.0 -! -!NO2/WC_N2O5=0.0 -! -!NO2/WC_HONO=0.0 -! -!NO2/WC_HNO3=0.0 -! -!NO2/WC_HNO4=0.0 -! -!NO2/WC_NH3=0.0 -! -!NO2/WC_OH=0.0 -! -!NO2/WC_HO2=0.0 -! -!NO2/WC_CO2=0.0 -! -!NO2/WC_SO2=0.0 -! -!NO2/WC_SULF=0.0 -! -!NO2/WC_HCHO=0.0 -! -!NO2/WC_ORA1=0.0 -! -!NO2/WC_ORA2=0.0 -! -!NO2/WC_MO2=0.0 -! -!NO2/WC_OP1=0.0 -! -!NO2/WC_ASO3=0.0 -! -!NO2/WC_ASO4=0.0 -! -!NO2/WC_ASO5=0.0 -! -!NO2/WC_AHSO5=0.0 -! -!NO2/WC_AHMS=0.0 -! -!NO2/WR_O3=0.0 -! -!NO2/WR_H2O2=0.0 -! -!NO2/WR_NO=0.0 -! -!NO2/WR_NO2=+KTR24 - PJAC(:,4,71)=+TPK%KTR24(:) -! -!NO2/WR_NO3=0.0 -! -!NO2/WR_N2O5=0.0 -! -!NO2/WR_HONO=0.0 -! -!NO2/WR_HNO3=0.0 -! -!NO2/WR_HNO4=0.0 -! -!NO2/WR_NH3=0.0 -! -!NO2/WR_OH=0.0 -! -!NO2/WR_HO2=0.0 -! -!NO2/WR_CO2=0.0 -! -!NO2/WR_SO2=0.0 -! -!NO2/WR_SULF=0.0 -! -!NO2/WR_HCHO=0.0 -! -!NO2/WR_ORA1=0.0 -! -!NO2/WR_ORA2=0.0 -! -!NO2/WR_MO2=0.0 -! -!NO2/WR_OP1=0.0 -! -!NO2/WR_ASO3=0.0 -! -!NO2/WR_ASO4=0.0 -! -!NO2/WR_ASO5=0.0 -! -!NO2/WR_AHSO5=0.0 -! -!NO2/WR_AHMS=0.0 -! -!NO3/O3=+K043*<NO2> - PJAC(:,5,1)=+TPK%K043(:)*PCONC(:,4) -! -!NO3/H2O2=0.0 -! -!NO3/NO=-K045*<NO3> - PJAC(:,5,3)=-TPK%K045(:)*PCONC(:,5) -! -!NO3/NO2=+K031*<O3P>+K043*<O3>-K046*<NO3>-K047*<NO3> - PJAC(:,5,4)=+TPK%K031(:)*TPK%O3P(:)+TPK%K043(:)*PCONC(:,1)-TPK%K046(:)*PCONC(:& -&,5)-TPK%K047(:)*PCONC(:,5) -! -!NO3/NO3=-K007-K008-K034*<OH>-K038*<HO2>-K045*<NO>-K046*<NO2>-K047*<NO2>-K049*< -!NO3>-K049*<NO3>-K049*<NO3>-K049*<NO3>-K072*<HCHO>-K073*<ALD>-K074*<CARBO>-K075 -!*<ARO>-K076*<ALKE>-K077*<BIO>+0.60*K078*<PAN>-K078*<PAN>-K119*<MO2>-K120*<ALKA -!P>-K121*<ALKEP>-K122*<BIOP>-K123*<AROP>-K124*<CARBOP>-K125*<OLN>-K131*<XO2>-K1 -!33*<DMS>-KTC5-KTR5 - PJAC(:,5,5)=-TPK%K007(:)-TPK%K008(:)-TPK%K034(:)*PCONC(:,15)-TPK%K038(:)*PCONC& -&(:,16)-TPK%K045(:)*PCONC(:,3)-TPK%K046(:)*PCONC(:,4)-TPK%K047(:)*PCONC(:,4)-TP& -&K%K049(:)*PCONC(:,5)-TPK%K049(:)*PCONC(:,5)-TPK%K049(:)*PCONC(:,5)-TPK%K049(:)& -&*PCONC(:,5)-TPK%K072(:)*PCONC(:,23)-TPK%K073(:)*PCONC(:,24)-TPK%K074(:)*PCONC(& -&:,26)-TPK%K075(:)*PCONC(:,22)-TPK%K076(:)*PCONC(:,20)-TPK%K077(:)*PCONC(:,21)+& -&0.60*TPK%K078(:)*PCONC(:,28)-TPK%K078(:)*PCONC(:,28)-TPK%K119(:)*PCONC(:,33)-T& -&PK%K120(:)*PCONC(:,34)-TPK%K121(:)*PCONC(:,35)-TPK%K122(:)*PCONC(:,36)-TPK%K12& -&3(:)*PCONC(:,39)-TPK%K124(:)*PCONC(:,40)-TPK%K125(:)*PCONC(:,41)-TPK%K131(:)*P& -&CONC(:,42)-TPK%K133(:)*PCONC(:,11)-TPK%KTC5(:)-TPK%KTR5(:) -! -!NO3/N2O5=+K048 - PJAC(:,5,6)=+TPK%K048(:) -! -!NO3/HONO=0.0 -! -!NO3/HNO3=+K040*<OH> - PJAC(:,5,8)=+TPK%K040(:)*PCONC(:,15) -! -!NO3/HNO4=+0.35*K006 - PJAC(:,5,9)=+0.35*TPK%K006(:) -! -!NO3/NH3=0.0 -! -!NO3/DMS=-K133*<NO3> - PJAC(:,5,11)=-TPK%K133(:)*PCONC(:,5) -! -!NO3/SO2=0.0 -! -!NO3/SULF=0.0 -! -!NO3/CO=0.0 -! -!NO3/OH=-K034*<NO3>+K040*<HNO3>+0.71893*K070*<PAN> - PJAC(:,5,15)=-TPK%K034(:)*PCONC(:,5)+TPK%K040(:)*PCONC(:,8)+0.71893*TPK%K070(:& -&)*PCONC(:,28) -! -!NO3/HO2=-K038*<NO3> - PJAC(:,5,16)=-TPK%K038(:)*PCONC(:,5) -! -!NO3/CH4=0.0 -! -!NO3/ETH=0.0 -! -!NO3/ALKA=0.0 -! -!NO3/ALKE=-K076*<NO3> - PJAC(:,5,20)=-TPK%K076(:)*PCONC(:,5) -! -!NO3/BIO=-K077*<NO3> - PJAC(:,5,21)=-TPK%K077(:)*PCONC(:,5) -! -!NO3/ARO=-K075*<NO3> - PJAC(:,5,22)=-TPK%K075(:)*PCONC(:,5) -! -!NO3/HCHO=-K072*<NO3> - PJAC(:,5,23)=-TPK%K072(:)*PCONC(:,5) -! -!NO3/ALD=-K073*<NO3> - PJAC(:,5,24)=-TPK%K073(:)*PCONC(:,5) -! -!NO3/KET=0.0 -! -!NO3/CARBO=-K074*<NO3> - PJAC(:,5,26)=-TPK%K074(:)*PCONC(:,5) -! -!NO3/ONIT=0.0 -! -!NO3/PAN=+0.71893*K070*<OH>+0.60*K078*<NO3>-K078*<NO3> - PJAC(:,5,28)=+0.71893*TPK%K070(:)*PCONC(:,15)+0.60*TPK%K078(:)*PCONC(:,5)-TPK%& -&K078(:)*PCONC(:,5) -! -!NO3/OP1=0.0 -! -!NO3/OP2=0.0 -! -!NO3/ORA1=0.0 -! -!NO3/ORA2=0.0 -! -!NO3/MO2=-K119*<NO3> - PJAC(:,5,33)=-TPK%K119(:)*PCONC(:,5) -! -!NO3/ALKAP=-K120*<NO3> - PJAC(:,5,34)=-TPK%K120(:)*PCONC(:,5) -! -!NO3/ALKEP=-K121*<NO3> - PJAC(:,5,35)=-TPK%K121(:)*PCONC(:,5) -! -!NO3/BIOP=-K122*<NO3> - PJAC(:,5,36)=-TPK%K122(:)*PCONC(:,5) -! -!NO3/PHO=0.0 -! -!NO3/ADD=0.0 -! -!NO3/AROP=-K123*<NO3> - PJAC(:,5,39)=-TPK%K123(:)*PCONC(:,5) -! -!NO3/CARBOP=-K124*<NO3> - PJAC(:,5,40)=-TPK%K124(:)*PCONC(:,5) -! -!NO3/OLN=-K125*<NO3> - PJAC(:,5,41)=-TPK%K125(:)*PCONC(:,5) -! -!NO3/XO2=-K131*<NO3> - PJAC(:,5,42)=-TPK%K131(:)*PCONC(:,5) -! -!NO3/WC_O3=0.0 -! -!NO3/WC_H2O2=0.0 -! -!NO3/WC_NO=0.0 -! -!NO3/WC_NO2=0.0 -! -!NO3/WC_NO3=+KTC25 - PJAC(:,5,47)=+TPK%KTC25(:) -! -!NO3/WC_N2O5=0.0 -! -!NO3/WC_HONO=0.0 -! -!NO3/WC_HNO3=0.0 -! -!NO3/WC_HNO4=0.0 -! -!NO3/WC_NH3=0.0 -! -!NO3/WC_OH=0.0 -! -!NO3/WC_HO2=0.0 -! -!NO3/WC_CO2=0.0 -! -!NO3/WC_SO2=0.0 -! -!NO3/WC_SULF=0.0 -! -!NO3/WC_HCHO=0.0 -! -!NO3/WC_ORA1=0.0 -! -!NO3/WC_ORA2=0.0 -! -!NO3/WC_MO2=0.0 -! -!NO3/WC_OP1=0.0 -! -!NO3/WC_ASO3=0.0 -! -!NO3/WC_ASO4=0.0 -! -!NO3/WC_ASO5=0.0 -! -!NO3/WC_AHSO5=0.0 -! -!NO3/WC_AHMS=0.0 -! -!NO3/WR_O3=0.0 -! -!NO3/WR_H2O2=0.0 -! -!NO3/WR_NO=0.0 -! -!NO3/WR_NO2=0.0 -! -!NO3/WR_NO3=+KTR25 - PJAC(:,5,72)=+TPK%KTR25(:) -! -!NO3/WR_N2O5=0.0 -! -!NO3/WR_HONO=0.0 -! -!NO3/WR_HNO3=0.0 -! -!NO3/WR_HNO4=0.0 -! -!NO3/WR_NH3=0.0 -! -!NO3/WR_OH=0.0 -! -!NO3/WR_HO2=0.0 -! -!NO3/WR_CO2=0.0 -! -!NO3/WR_SO2=0.0 -! -!NO3/WR_SULF=0.0 -! -!NO3/WR_HCHO=0.0 -! -!NO3/WR_ORA1=0.0 -! -!NO3/WR_ORA2=0.0 -! -!NO3/WR_MO2=0.0 -! -!NO3/WR_OP1=0.0 -! -!NO3/WR_ASO3=0.0 -! -!NO3/WR_ASO4=0.0 -! -!NO3/WR_ASO5=0.0 -! -!NO3/WR_AHSO5=0.0 -! -!NO3/WR_AHMS=0.0 -! -RETURN -END SUBROUTINE SUBJ0 -! -SUBROUTINE SUBJ1 -! -!Indices 6 a 10 -! -! -!N2O5/O3=0.0 -! -!N2O5/H2O2=0.0 -! -!N2O5/NO=0.0 -! -!N2O5/NO2=+K047*<NO3> - PJAC(:,6,4)=+TPK%K047(:)*PCONC(:,5) -! -!N2O5/NO3=+K047*<NO2> - PJAC(:,6,5)=+TPK%K047(:)*PCONC(:,4) -! -!N2O5/N2O5=-K048-KTC6-KTR6 - PJAC(:,6,6)=-TPK%K048(:)-TPK%KTC6(:)-TPK%KTR6(:) -! -!N2O5/HONO=0.0 -! -!N2O5/HNO3=0.0 -! -!N2O5/HNO4=0.0 -! -!N2O5/NH3=0.0 -! -!N2O5/DMS=0.0 -! -!N2O5/SO2=0.0 -! -!N2O5/SULF=0.0 -! -!N2O5/CO=0.0 -! -!N2O5/OH=0.0 -! -!N2O5/HO2=0.0 -! -!N2O5/CH4=0.0 -! -!N2O5/ETH=0.0 -! -!N2O5/ALKA=0.0 -! -!N2O5/ALKE=0.0 -! -!N2O5/BIO=0.0 -! -!N2O5/ARO=0.0 -! -!N2O5/HCHO=0.0 -! -!N2O5/ALD=0.0 -! -!N2O5/KET=0.0 -! -!N2O5/CARBO=0.0 -! -!N2O5/ONIT=0.0 -! -!N2O5/PAN=0.0 -! -!N2O5/OP1=0.0 -! -!N2O5/OP2=0.0 -! -!N2O5/ORA1=0.0 -! -!N2O5/ORA2=0.0 -! -!N2O5/MO2=0.0 -! -!N2O5/ALKAP=0.0 -! -!N2O5/ALKEP=0.0 -! -!N2O5/BIOP=0.0 -! -!N2O5/PHO=0.0 -! -!N2O5/ADD=0.0 -! -!N2O5/AROP=0.0 -! -!N2O5/CARBOP=0.0 -! -!N2O5/OLN=0.0 -! -!N2O5/XO2=0.0 -! -!N2O5/WC_O3=0.0 -! -!N2O5/WC_H2O2=0.0 -! -!N2O5/WC_NO=0.0 -! -!N2O5/WC_NO2=0.0 -! -!N2O5/WC_NO3=0.0 -! -!N2O5/WC_N2O5=+KTC26 - PJAC(:,6,48)=+TPK%KTC26(:) -! -!N2O5/WC_HONO=0.0 -! -!N2O5/WC_HNO3=0.0 -! -!N2O5/WC_HNO4=0.0 -! -!N2O5/WC_NH3=0.0 -! -!N2O5/WC_OH=0.0 -! -!N2O5/WC_HO2=0.0 -! -!N2O5/WC_CO2=0.0 -! -!N2O5/WC_SO2=0.0 -! -!N2O5/WC_SULF=0.0 -! -!N2O5/WC_HCHO=0.0 -! -!N2O5/WC_ORA1=0.0 -! -!N2O5/WC_ORA2=0.0 -! -!N2O5/WC_MO2=0.0 -! -!N2O5/WC_OP1=0.0 -! -!N2O5/WC_ASO3=0.0 -! -!N2O5/WC_ASO4=0.0 -! -!N2O5/WC_ASO5=0.0 -! -!N2O5/WC_AHSO5=0.0 -! -!N2O5/WC_AHMS=0.0 -! -!N2O5/WR_O3=0.0 -! -!N2O5/WR_H2O2=0.0 -! -!N2O5/WR_NO=0.0 -! -!N2O5/WR_NO2=0.0 -! -!N2O5/WR_NO3=0.0 -! -!N2O5/WR_N2O5=+KTR26 - PJAC(:,6,73)=+TPK%KTR26(:) -! -!N2O5/WR_HONO=0.0 -! -!N2O5/WR_HNO3=0.0 -! -!N2O5/WR_HNO4=0.0 -! -!N2O5/WR_NH3=0.0 -! -!N2O5/WR_OH=0.0 -! -!N2O5/WR_HO2=0.0 -! -!N2O5/WR_CO2=0.0 -! -!N2O5/WR_SO2=0.0 -! -!N2O5/WR_SULF=0.0 -! -!N2O5/WR_HCHO=0.0 -! -!N2O5/WR_ORA1=0.0 -! -!N2O5/WR_ORA2=0.0 -! -!N2O5/WR_MO2=0.0 -! -!N2O5/WR_OP1=0.0 -! -!N2O5/WR_ASO3=0.0 -! -!N2O5/WR_ASO4=0.0 -! -!N2O5/WR_ASO5=0.0 -! -!N2O5/WR_AHSO5=0.0 -! -!N2O5/WR_AHMS=0.0 -! -!HONO/O3=0.0 -! -!HONO/H2O2=0.0 -! -!HONO/NO=+K032*<OH> - PJAC(:,7,3)=+TPK%K032(:)*PCONC(:,15) -! -!HONO/NO2=+K085*<ADD> - PJAC(:,7,4)=+TPK%K085(:)*PCONC(:,38) -! -!HONO/NO3=0.0 -! -!HONO/N2O5=0.0 -! -!HONO/HONO=-K004-K039*<OH>-KTC7-KTR7 - PJAC(:,7,7)=-TPK%K004(:)-TPK%K039(:)*PCONC(:,15)-TPK%KTC7(:)-TPK%KTR7(:) -! -!HONO/HNO3=0.0 -! -!HONO/HNO4=0.0 -! -!HONO/NH3=0.0 -! -!HONO/DMS=0.0 -! -!HONO/SO2=0.0 -! -!HONO/SULF=0.0 -! -!HONO/CO=0.0 -! -!HONO/OH=+K032*<NO>-K039*<HONO> - PJAC(:,7,15)=+TPK%K032(:)*PCONC(:,3)-TPK%K039(:)*PCONC(:,7) -! -!HONO/HO2=0.0 -! -!HONO/CH4=0.0 -! -!HONO/ETH=0.0 -! -!HONO/ALKA=0.0 -! -!HONO/ALKE=0.0 -! -!HONO/BIO=0.0 -! -!HONO/ARO=0.0 -! -!HONO/HCHO=0.0 -! -!HONO/ALD=0.0 -! -!HONO/KET=0.0 -! -!HONO/CARBO=0.0 -! -!HONO/ONIT=0.0 -! -!HONO/PAN=0.0 -! -!HONO/OP1=0.0 -! -!HONO/OP2=0.0 -! -!HONO/ORA1=0.0 -! -!HONO/ORA2=0.0 -! -!HONO/MO2=0.0 -! -!HONO/ALKAP=0.0 -! -!HONO/ALKEP=0.0 -! -!HONO/BIOP=0.0 -! -!HONO/PHO=0.0 -! -!HONO/ADD=+K085*<NO2> - PJAC(:,7,38)=+TPK%K085(:)*PCONC(:,4) -! -!HONO/AROP=0.0 -! -!HONO/CARBOP=0.0 -! -!HONO/OLN=0.0 -! -!HONO/XO2=0.0 -! -!HONO/WC_O3=0.0 -! -!HONO/WC_H2O2=0.0 -! -!HONO/WC_NO=0.0 -! -!HONO/WC_NO2=0.0 -! -!HONO/WC_NO3=0.0 -! -!HONO/WC_N2O5=0.0 -! -!HONO/WC_HONO=+KTC27 - PJAC(:,7,49)=+TPK%KTC27(:) -! -!HONO/WC_HNO3=0.0 -! -!HONO/WC_HNO4=0.0 -! -!HONO/WC_NH3=0.0 -! -!HONO/WC_OH=0.0 -! -!HONO/WC_HO2=0.0 -! -!HONO/WC_CO2=0.0 -! -!HONO/WC_SO2=0.0 -! -!HONO/WC_SULF=0.0 -! -!HONO/WC_HCHO=0.0 -! -!HONO/WC_ORA1=0.0 -! -!HONO/WC_ORA2=0.0 -! -!HONO/WC_MO2=0.0 -! -!HONO/WC_OP1=0.0 -! -!HONO/WC_ASO3=0.0 -! -!HONO/WC_ASO4=0.0 -! -!HONO/WC_ASO5=0.0 -! -!HONO/WC_AHSO5=0.0 -! -!HONO/WC_AHMS=0.0 -! -!HONO/WR_O3=0.0 -! -!HONO/WR_H2O2=0.0 -! -!HONO/WR_NO=0.0 -! -!HONO/WR_NO2=0.0 -! -!HONO/WR_NO3=0.0 -! -!HONO/WR_N2O5=0.0 -! -!HONO/WR_HONO=+KTR27 - PJAC(:,7,74)=+TPK%KTR27(:) -! -!HONO/WR_HNO3=0.0 -! -!HONO/WR_HNO4=0.0 -! -!HONO/WR_NH3=0.0 -! -!HONO/WR_OH=0.0 -! -!HONO/WR_HO2=0.0 -! -!HONO/WR_CO2=0.0 -! -!HONO/WR_SO2=0.0 -! -!HONO/WR_SULF=0.0 -! -!HONO/WR_HCHO=0.0 -! -!HONO/WR_ORA1=0.0 -! -!HONO/WR_ORA2=0.0 -! -!HONO/WR_MO2=0.0 -! -!HONO/WR_OP1=0.0 -! -!HONO/WR_ASO3=0.0 -! -!HONO/WR_ASO4=0.0 -! -!HONO/WR_ASO5=0.0 -! -!HONO/WR_AHSO5=0.0 -! -!HONO/WR_AHMS=0.0 -! -!HNO3/O3=0.0 -! -!HNO3/H2O2=0.0 -! -!HNO3/NO=0.0 -! -!HNO3/NO2=+K033*<OH> - PJAC(:,8,4)=+TPK%K033(:)*PCONC(:,15) -! -!HNO3/NO3=+0.3*K038*<HO2>+K072*<HCHO>+K073*<ALD>+0.91567*K074*<CARBO>+K075*<ARO -!> - PJAC(:,8,5)=+0.3*TPK%K038(:)*PCONC(:,16)+TPK%K072(:)*PCONC(:,23)+TPK%K073(:)*P& -&CONC(:,24)+0.91567*TPK%K074(:)*PCONC(:,26)+TPK%K075(:)*PCONC(:,22) -! -!HNO3/N2O5=0.0 -! -!HNO3/HONO=0.0 -! -!HNO3/HNO3=-K005-K040*<OH>-KTC8-KTR8 - PJAC(:,8,8)=-TPK%K005(:)-TPK%K040(:)*PCONC(:,15)-TPK%KTC8(:)-TPK%KTR8(:) -! -!HNO3/HNO4=0.0 -! -!HNO3/NH3=0.0 -! -!HNO3/DMS=0.0 -! -!HNO3/SO2=0.0 -! -!HNO3/SULF=0.0 -! -!HNO3/CO=0.0 -! -!HNO3/OH=+K033*<NO2>-K040*<HNO3> - PJAC(:,8,15)=+TPK%K033(:)*PCONC(:,4)-TPK%K040(:)*PCONC(:,8) -! -!HNO3/HO2=+0.3*K038*<NO3> - PJAC(:,8,16)=+0.3*TPK%K038(:)*PCONC(:,5) -! -!HNO3/CH4=0.0 -! -!HNO3/ETH=0.0 -! -!HNO3/ALKA=0.0 -! -!HNO3/ALKE=0.0 -! -!HNO3/BIO=0.0 -! -!HNO3/ARO=+K075*<NO3> - PJAC(:,8,22)=+TPK%K075(:)*PCONC(:,5) -! -!HNO3/HCHO=+K072*<NO3> - PJAC(:,8,23)=+TPK%K072(:)*PCONC(:,5) -! -!HNO3/ALD=+K073*<NO3> - PJAC(:,8,24)=+TPK%K073(:)*PCONC(:,5) -! -!HNO3/KET=0.0 -! -!HNO3/CARBO=+0.91567*K074*<NO3> - PJAC(:,8,26)=+0.91567*TPK%K074(:)*PCONC(:,5) -! -!HNO3/ONIT=0.0 -! -!HNO3/PAN=0.0 -! -!HNO3/OP1=0.0 -! -!HNO3/OP2=0.0 -! -!HNO3/ORA1=0.0 -! -!HNO3/ORA2=0.0 -! -!HNO3/MO2=0.0 -! -!HNO3/ALKAP=0.0 -! -!HNO3/ALKEP=0.0 -! -!HNO3/BIOP=0.0 -! -!HNO3/PHO=0.0 -! -!HNO3/ADD=0.0 -! -!HNO3/AROP=0.0 -! -!HNO3/CARBOP=0.0 -! -!HNO3/OLN=0.0 -! -!HNO3/XO2=0.0 -! -!HNO3/WC_O3=0.0 -! -!HNO3/WC_H2O2=0.0 -! -!HNO3/WC_NO=0.0 -! -!HNO3/WC_NO2=0.0 -! -!HNO3/WC_NO3=0.0 -! -!HNO3/WC_N2O5=0.0 -! -!HNO3/WC_HONO=0.0 -! -!HNO3/WC_HNO3=+KTC28 - PJAC(:,8,50)=+TPK%KTC28(:) -! -!HNO3/WC_HNO4=0.0 -! -!HNO3/WC_NH3=0.0 -! -!HNO3/WC_OH=0.0 -! -!HNO3/WC_HO2=0.0 -! -!HNO3/WC_CO2=0.0 -! -!HNO3/WC_SO2=0.0 -! -!HNO3/WC_SULF=0.0 -! -!HNO3/WC_HCHO=0.0 -! -!HNO3/WC_ORA1=0.0 -! -!HNO3/WC_ORA2=0.0 -! -!HNO3/WC_MO2=0.0 -! -!HNO3/WC_OP1=0.0 -! -!HNO3/WC_ASO3=0.0 -! -!HNO3/WC_ASO4=0.0 -! -!HNO3/WC_ASO5=0.0 -! -!HNO3/WC_AHSO5=0.0 -! -!HNO3/WC_AHMS=0.0 -! -!HNO3/WR_O3=0.0 -! -!HNO3/WR_H2O2=0.0 -! -!HNO3/WR_NO=0.0 -! -!HNO3/WR_NO2=0.0 -! -!HNO3/WR_NO3=0.0 -! -!HNO3/WR_N2O5=0.0 -! -!HNO3/WR_HONO=0.0 -! -!HNO3/WR_HNO3=+KTR28 - PJAC(:,8,75)=+TPK%KTR28(:) -! -!HNO3/WR_HNO4=0.0 -! -!HNO3/WR_NH3=0.0 -! -!HNO3/WR_OH=0.0 -! -!HNO3/WR_HO2=0.0 -! -!HNO3/WR_CO2=0.0 -! -!HNO3/WR_SO2=0.0 -! -!HNO3/WR_SULF=0.0 -! -!HNO3/WR_HCHO=0.0 -! -!HNO3/WR_ORA1=0.0 -! -!HNO3/WR_ORA2=0.0 -! -!HNO3/WR_MO2=0.0 -! -!HNO3/WR_OP1=0.0 -! -!HNO3/WR_ASO3=0.0 -! -!HNO3/WR_ASO4=0.0 -! -!HNO3/WR_ASO5=0.0 -! -!HNO3/WR_AHSO5=0.0 -! -!HNO3/WR_AHMS=0.0 -! -!HNO4/O3=0.0 -! -!HNO4/H2O2=0.0 -! -!HNO4/NO=0.0 -! -!HNO4/NO2=+K036*<HO2> - PJAC(:,9,4)=+TPK%K036(:)*PCONC(:,16) -! -!HNO4/NO3=0.0 -! -!HNO4/N2O5=0.0 -! -!HNO4/HONO=0.0 -! -!HNO4/HNO3=0.0 -! -!HNO4/HNO4=-K006-K037-K041*<OH>-KTC9-KTR9 - PJAC(:,9,9)=-TPK%K006(:)-TPK%K037(:)-TPK%K041(:)*PCONC(:,15)-TPK%KTC9(:)-TPK%K& -&TR9(:) -! -!HNO4/NH3=0.0 -! -!HNO4/DMS=0.0 -! -!HNO4/SO2=0.0 -! -!HNO4/SULF=0.0 -! -!HNO4/CO=0.0 -! -!HNO4/OH=-K041*<HNO4> - PJAC(:,9,15)=-TPK%K041(:)*PCONC(:,9) -! -!HNO4/HO2=+K036*<NO2> - PJAC(:,9,16)=+TPK%K036(:)*PCONC(:,4) -! -!HNO4/CH4=0.0 -! -!HNO4/ETH=0.0 -! -!HNO4/ALKA=0.0 -! -!HNO4/ALKE=0.0 -! -!HNO4/BIO=0.0 -! -!HNO4/ARO=0.0 -! -!HNO4/HCHO=0.0 -! -!HNO4/ALD=0.0 -! -!HNO4/KET=0.0 -! -!HNO4/CARBO=0.0 -! -!HNO4/ONIT=0.0 -! -!HNO4/PAN=0.0 -! -!HNO4/OP1=0.0 -! -!HNO4/OP2=0.0 -! -!HNO4/ORA1=0.0 -! -!HNO4/ORA2=0.0 -! -!HNO4/MO2=0.0 -! -!HNO4/ALKAP=0.0 -! -!HNO4/ALKEP=0.0 -! -!HNO4/BIOP=0.0 -! -!HNO4/PHO=0.0 -! -!HNO4/ADD=0.0 -! -!HNO4/AROP=0.0 -! -!HNO4/CARBOP=0.0 -! -!HNO4/OLN=0.0 -! -!HNO4/XO2=0.0 -! -!HNO4/WC_O3=0.0 -! -!HNO4/WC_H2O2=0.0 -! -!HNO4/WC_NO=0.0 -! -!HNO4/WC_NO2=0.0 -! -!HNO4/WC_NO3=0.0 -! -!HNO4/WC_N2O5=0.0 -! -!HNO4/WC_HONO=0.0 -! -!HNO4/WC_HNO3=0.0 -! -!HNO4/WC_HNO4=+KTC29 - PJAC(:,9,51)=+TPK%KTC29(:) -! -!HNO4/WC_NH3=0.0 -! -!HNO4/WC_OH=0.0 -! -!HNO4/WC_HO2=0.0 -! -!HNO4/WC_CO2=0.0 -! -!HNO4/WC_SO2=0.0 -! -!HNO4/WC_SULF=0.0 -! -!HNO4/WC_HCHO=0.0 -! -!HNO4/WC_ORA1=0.0 -! -!HNO4/WC_ORA2=0.0 -! -!HNO4/WC_MO2=0.0 -! -!HNO4/WC_OP1=0.0 -! -!HNO4/WC_ASO3=0.0 -! -!HNO4/WC_ASO4=0.0 -! -!HNO4/WC_ASO5=0.0 -! -!HNO4/WC_AHSO5=0.0 -! -!HNO4/WC_AHMS=0.0 -! -!HNO4/WR_O3=0.0 -! -!HNO4/WR_H2O2=0.0 -! -!HNO4/WR_NO=0.0 -! -!HNO4/WR_NO2=0.0 -! -!HNO4/WR_NO3=0.0 -! -!HNO4/WR_N2O5=0.0 -! -!HNO4/WR_HONO=0.0 -! -!HNO4/WR_HNO3=0.0 -! -!HNO4/WR_HNO4=+KTR29 - PJAC(:,9,76)=+TPK%KTR29(:) -! -!HNO4/WR_NH3=0.0 -! -!HNO4/WR_OH=0.0 -! -!HNO4/WR_HO2=0.0 -! -!HNO4/WR_CO2=0.0 -! -!HNO4/WR_SO2=0.0 -! -!HNO4/WR_SULF=0.0 -! -!HNO4/WR_HCHO=0.0 -! -!HNO4/WR_ORA1=0.0 -! -!HNO4/WR_ORA2=0.0 -! -!HNO4/WR_MO2=0.0 -! -!HNO4/WR_OP1=0.0 -! -!HNO4/WR_ASO3=0.0 -! -!HNO4/WR_ASO4=0.0 -! -!HNO4/WR_ASO5=0.0 -! -!HNO4/WR_AHSO5=0.0 -! -!HNO4/WR_AHMS=0.0 -! -!NH3/O3=0.0 -! -!NH3/H2O2=0.0 -! -!NH3/NO=0.0 -! -!NH3/NO2=0.0 -! -!NH3/NO3=0.0 -! -!NH3/N2O5=0.0 -! -!NH3/HONO=0.0 -! -!NH3/HNO3=0.0 -! -!NH3/HNO4=0.0 -! -!NH3/NH3=-K050*<OH>-KTC10-KTR10 - PJAC(:,10,10)=-TPK%K050(:)*PCONC(:,15)-TPK%KTC10(:)-TPK%KTR10(:) -! -!NH3/DMS=0.0 -! -!NH3/SO2=0.0 -! -!NH3/SULF=0.0 -! -!NH3/CO=0.0 -! -!NH3/OH=-K050*<NH3> - PJAC(:,10,15)=-TPK%K050(:)*PCONC(:,10) -! -!NH3/HO2=0.0 -! -!NH3/CH4=0.0 -! -!NH3/ETH=0.0 -! -!NH3/ALKA=0.0 -! -!NH3/ALKE=0.0 -! -!NH3/BIO=0.0 -! -!NH3/ARO=0.0 -! -!NH3/HCHO=0.0 -! -!NH3/ALD=0.0 -! -!NH3/KET=0.0 -! -!NH3/CARBO=0.0 -! -!NH3/ONIT=0.0 -! -!NH3/PAN=0.0 -! -!NH3/OP1=0.0 -! -!NH3/OP2=0.0 -! -!NH3/ORA1=0.0 -! -!NH3/ORA2=0.0 -! -!NH3/MO2=0.0 -! -!NH3/ALKAP=0.0 -! -!NH3/ALKEP=0.0 -! -!NH3/BIOP=0.0 -! -!NH3/PHO=0.0 -! -!NH3/ADD=0.0 -! -!NH3/AROP=0.0 -! -!NH3/CARBOP=0.0 -! -!NH3/OLN=0.0 -! -!NH3/XO2=0.0 -! -!NH3/WC_O3=0.0 -! -!NH3/WC_H2O2=0.0 -! -!NH3/WC_NO=0.0 -! -!NH3/WC_NO2=0.0 -! -!NH3/WC_NO3=0.0 -! -!NH3/WC_N2O5=0.0 -! -!NH3/WC_HONO=0.0 -! -!NH3/WC_HNO3=0.0 -! -!NH3/WC_HNO4=0.0 -! -!NH3/WC_NH3=+KTC30 - PJAC(:,10,52)=+TPK%KTC30(:) -! -!NH3/WC_OH=0.0 -! -!NH3/WC_HO2=0.0 -! -!NH3/WC_CO2=0.0 -! -!NH3/WC_SO2=0.0 -! -!NH3/WC_SULF=0.0 -! -!NH3/WC_HCHO=0.0 -! -!NH3/WC_ORA1=0.0 -! -!NH3/WC_ORA2=0.0 -! -!NH3/WC_MO2=0.0 -! -!NH3/WC_OP1=0.0 -! -!NH3/WC_ASO3=0.0 -! -!NH3/WC_ASO4=0.0 -! -!NH3/WC_ASO5=0.0 -! -!NH3/WC_AHSO5=0.0 -! -!NH3/WC_AHMS=0.0 -! -!NH3/WR_O3=0.0 -! -!NH3/WR_H2O2=0.0 -! -!NH3/WR_NO=0.0 -! -!NH3/WR_NO2=0.0 -! -!NH3/WR_NO3=0.0 -! -!NH3/WR_N2O5=0.0 -! -!NH3/WR_HONO=0.0 -! -!NH3/WR_HNO3=0.0 -! -!NH3/WR_HNO4=0.0 -! -!NH3/WR_NH3=+KTR30 - PJAC(:,10,77)=+TPK%KTR30(:) -! -!NH3/WR_OH=0.0 -! -!NH3/WR_HO2=0.0 -! -!NH3/WR_CO2=0.0 -! -!NH3/WR_SO2=0.0 -! -!NH3/WR_SULF=0.0 -! -!NH3/WR_HCHO=0.0 -! -!NH3/WR_ORA1=0.0 -! -!NH3/WR_ORA2=0.0 -! -!NH3/WR_MO2=0.0 -! -!NH3/WR_OP1=0.0 -! -!NH3/WR_ASO3=0.0 -! -!NH3/WR_ASO4=0.0 -! -!NH3/WR_ASO5=0.0 -! -!NH3/WR_AHSO5=0.0 -! -!NH3/WR_AHMS=0.0 -! -RETURN -END SUBROUTINE SUBJ1 -! -SUBROUTINE SUBJ2 -! -!Indices 11 a 15 -! -! -!DMS/O3=0.0 -! -!DMS/H2O2=0.0 -! -!DMS/NO=0.0 -! -!DMS/NO2=0.0 -! -!DMS/NO3=-K133*<DMS> - PJAC(:,11,5)=-TPK%K133(:)*PCONC(:,11) -! -!DMS/N2O5=0.0 -! -!DMS/HONO=0.0 -! -!DMS/HNO3=0.0 -! -!DMS/HNO4=0.0 -! -!DMS/NH3=0.0 -! -!DMS/DMS=-K133*<NO3>-K134*<O3P>-K135*<OH> - PJAC(:,11,11)=-TPK%K133(:)*PCONC(:,5)-TPK%K134(:)*TPK%O3P(:)-TPK%K135(:)*PCONC& -&(:,15) -! -!DMS/SO2=0.0 -! -!DMS/SULF=0.0 -! -!DMS/CO=0.0 -! -!DMS/OH=-K135*<DMS> - PJAC(:,11,15)=-TPK%K135(:)*PCONC(:,11) -! -!DMS/HO2=0.0 -! -!DMS/CH4=0.0 -! -!DMS/ETH=0.0 -! -!DMS/ALKA=0.0 -! -!DMS/ALKE=0.0 -! -!DMS/BIO=0.0 -! -!DMS/ARO=0.0 -! -!DMS/HCHO=0.0 -! -!DMS/ALD=0.0 -! -!DMS/KET=0.0 -! -!DMS/CARBO=0.0 -! -!DMS/ONIT=0.0 -! -!DMS/PAN=0.0 -! -!DMS/OP1=0.0 -! -!DMS/OP2=0.0 -! -!DMS/ORA1=0.0 -! -!DMS/ORA2=0.0 -! -!DMS/MO2=0.0 -! -!DMS/ALKAP=0.0 -! -!DMS/ALKEP=0.0 -! -!DMS/BIOP=0.0 -! -!DMS/PHO=0.0 -! -!DMS/ADD=0.0 -! -!DMS/AROP=0.0 -! -!DMS/CARBOP=0.0 -! -!DMS/OLN=0.0 -! -!DMS/XO2=0.0 -! -!DMS/WC_O3=0.0 -! -!DMS/WC_H2O2=0.0 -! -!DMS/WC_NO=0.0 -! -!DMS/WC_NO2=0.0 -! -!DMS/WC_NO3=0.0 -! -!DMS/WC_N2O5=0.0 -! -!DMS/WC_HONO=0.0 -! -!DMS/WC_HNO3=0.0 -! -!DMS/WC_HNO4=0.0 -! -!DMS/WC_NH3=0.0 -! -!DMS/WC_OH=0.0 -! -!DMS/WC_HO2=0.0 -! -!DMS/WC_CO2=0.0 -! -!DMS/WC_SO2=0.0 -! -!DMS/WC_SULF=0.0 -! -!DMS/WC_HCHO=0.0 -! -!DMS/WC_ORA1=0.0 -! -!DMS/WC_ORA2=0.0 -! -!DMS/WC_MO2=0.0 -! -!DMS/WC_OP1=0.0 -! -!DMS/WC_ASO3=0.0 -! -!DMS/WC_ASO4=0.0 -! -!DMS/WC_ASO5=0.0 -! -!DMS/WC_AHSO5=0.0 -! -!DMS/WC_AHMS=0.0 -! -!DMS/WR_O3=0.0 -! -!DMS/WR_H2O2=0.0 -! -!DMS/WR_NO=0.0 -! -!DMS/WR_NO2=0.0 -! -!DMS/WR_NO3=0.0 -! -!DMS/WR_N2O5=0.0 -! -!DMS/WR_HONO=0.0 -! -!DMS/WR_HNO3=0.0 -! -!DMS/WR_HNO4=0.0 -! -!DMS/WR_NH3=0.0 -! -!DMS/WR_OH=0.0 -! -!DMS/WR_HO2=0.0 -! -!DMS/WR_CO2=0.0 -! -!DMS/WR_SO2=0.0 -! -!DMS/WR_SULF=0.0 -! -!DMS/WR_HCHO=0.0 -! -!DMS/WR_ORA1=0.0 -! -!DMS/WR_ORA2=0.0 -! -!DMS/WR_MO2=0.0 -! -!DMS/WR_OP1=0.0 -! -!DMS/WR_ASO3=0.0 -! -!DMS/WR_ASO4=0.0 -! -!DMS/WR_ASO5=0.0 -! -!DMS/WR_AHSO5=0.0 -! -!DMS/WR_AHMS=0.0 -! -!SO2/O3=0.0 -! -!SO2/H2O2=0.0 -! -!SO2/NO=0.0 -! -!SO2/NO2=0.0 -! -!SO2/NO3=+K133*<DMS> - PJAC(:,12,5)=+TPK%K133(:)*PCONC(:,11) -! -!SO2/N2O5=0.0 -! -!SO2/HONO=0.0 -! -!SO2/HNO3=0.0 -! -!SO2/HNO4=0.0 -! -!SO2/NH3=0.0 -! -!SO2/DMS=+K133*<NO3>+K134*<O3P>+0.8*K135*<OH> - PJAC(:,12,11)=+TPK%K133(:)*PCONC(:,5)+TPK%K134(:)*TPK%O3P(:)+0.8*TPK%K135(:)*P& -&CONC(:,15) -! -!SO2/SO2=-K052*<OH>-KTC14-KTR14 - PJAC(:,12,12)=-TPK%K052(:)*PCONC(:,15)-TPK%KTC14(:)-TPK%KTR14(:) -! -!SO2/SULF=0.0 -! -!SO2/CO=0.0 -! -!SO2/OH=-K052*<SO2>+0.8*K135*<DMS> - PJAC(:,12,15)=-TPK%K052(:)*PCONC(:,12)+0.8*TPK%K135(:)*PCONC(:,11) -! -!SO2/HO2=0.0 -! -!SO2/CH4=0.0 -! -!SO2/ETH=0.0 -! -!SO2/ALKA=0.0 -! -!SO2/ALKE=0.0 -! -!SO2/BIO=0.0 -! -!SO2/ARO=0.0 -! -!SO2/HCHO=0.0 -! -!SO2/ALD=0.0 -! -!SO2/KET=0.0 -! -!SO2/CARBO=0.0 -! -!SO2/ONIT=0.0 -! -!SO2/PAN=0.0 -! -!SO2/OP1=0.0 -! -!SO2/OP2=0.0 -! -!SO2/ORA1=0.0 -! -!SO2/ORA2=0.0 -! -!SO2/MO2=0.0 -! -!SO2/ALKAP=0.0 -! -!SO2/ALKEP=0.0 -! -!SO2/BIOP=0.0 -! -!SO2/PHO=0.0 -! -!SO2/ADD=0.0 -! -!SO2/AROP=0.0 -! -!SO2/CARBOP=0.0 -! -!SO2/OLN=0.0 -! -!SO2/XO2=0.0 -! -!SO2/WC_O3=0.0 -! -!SO2/WC_H2O2=0.0 -! -!SO2/WC_NO=0.0 -! -!SO2/WC_NO2=0.0 -! -!SO2/WC_NO3=0.0 -! -!SO2/WC_N2O5=0.0 -! -!SO2/WC_HONO=0.0 -! -!SO2/WC_HNO3=0.0 -! -!SO2/WC_HNO4=0.0 -! -!SO2/WC_NH3=0.0 -! -!SO2/WC_OH=0.0 -! -!SO2/WC_HO2=0.0 -! -!SO2/WC_CO2=0.0 -! -!SO2/WC_SO2=+KTC34 - PJAC(:,12,56)=+TPK%KTC34(:) -! -!SO2/WC_SULF=0.0 -! -!SO2/WC_HCHO=0.0 -! -!SO2/WC_ORA1=0.0 -! -!SO2/WC_ORA2=0.0 -! -!SO2/WC_MO2=0.0 -! -!SO2/WC_OP1=0.0 -! -!SO2/WC_ASO3=0.0 -! -!SO2/WC_ASO4=0.0 -! -!SO2/WC_ASO5=0.0 -! -!SO2/WC_AHSO5=0.0 -! -!SO2/WC_AHMS=0.0 -! -!SO2/WR_O3=0.0 -! -!SO2/WR_H2O2=0.0 -! -!SO2/WR_NO=0.0 -! -!SO2/WR_NO2=0.0 -! -!SO2/WR_NO3=0.0 -! -!SO2/WR_N2O5=0.0 -! -!SO2/WR_HONO=0.0 -! -!SO2/WR_HNO3=0.0 -! -!SO2/WR_HNO4=0.0 -! -!SO2/WR_NH3=0.0 -! -!SO2/WR_OH=0.0 -! -!SO2/WR_HO2=0.0 -! -!SO2/WR_CO2=0.0 -! -!SO2/WR_SO2=+KTR34 - PJAC(:,12,81)=+TPK%KTR34(:) -! -!SO2/WR_SULF=0.0 -! -!SO2/WR_HCHO=0.0 -! -!SO2/WR_ORA1=0.0 -! -!SO2/WR_ORA2=0.0 -! -!SO2/WR_MO2=0.0 -! -!SO2/WR_OP1=0.0 -! -!SO2/WR_ASO3=0.0 -! -!SO2/WR_ASO4=0.0 -! -!SO2/WR_ASO5=0.0 -! -!SO2/WR_AHSO5=0.0 -! -!SO2/WR_AHMS=0.0 -! -!SULF/O3=0.0 -! -!SULF/H2O2=0.0 -! -!SULF/NO=0.0 -! -!SULF/NO2=0.0 -! -!SULF/NO3=0.0 -! -!SULF/N2O5=0.0 -! -!SULF/HONO=0.0 -! -!SULF/HNO3=0.0 -! -!SULF/HNO4=0.0 -! -!SULF/NH3=0.0 -! -!SULF/DMS=0.0 -! -!SULF/SO2=+K052*<OH> - PJAC(:,13,12)=+TPK%K052(:)*PCONC(:,15) -! -!SULF/SULF=-K132-KTC15-KTR15 - PJAC(:,13,13)=-TPK%K132(:)-TPK%KTC15(:)-TPK%KTR15(:) -! -!SULF/CO=0.0 -! -!SULF/OH=+K052*<SO2> - PJAC(:,13,15)=+TPK%K052(:)*PCONC(:,12) -! -!SULF/HO2=0.0 -! -!SULF/CH4=0.0 -! -!SULF/ETH=0.0 -! -!SULF/ALKA=0.0 -! -!SULF/ALKE=0.0 -! -!SULF/BIO=0.0 -! -!SULF/ARO=0.0 -! -!SULF/HCHO=0.0 -! -!SULF/ALD=0.0 -! -!SULF/KET=0.0 -! -!SULF/CARBO=0.0 -! -!SULF/ONIT=0.0 -! -!SULF/PAN=0.0 -! -!SULF/OP1=0.0 -! -!SULF/OP2=0.0 -! -!SULF/ORA1=0.0 -! -!SULF/ORA2=0.0 -! -!SULF/MO2=0.0 -! -!SULF/ALKAP=0.0 -! -!SULF/ALKEP=0.0 -! -!SULF/BIOP=0.0 -! -!SULF/PHO=0.0 -! -!SULF/ADD=0.0 -! -!SULF/AROP=0.0 -! -!SULF/CARBOP=0.0 -! -!SULF/OLN=0.0 -! -!SULF/XO2=0.0 -! -!SULF/WC_O3=0.0 -! -!SULF/WC_H2O2=0.0 -! -!SULF/WC_NO=0.0 -! -!SULF/WC_NO2=0.0 -! -!SULF/WC_NO3=0.0 -! -!SULF/WC_N2O5=0.0 -! -!SULF/WC_HONO=0.0 -! -!SULF/WC_HNO3=0.0 -! -!SULF/WC_HNO4=0.0 -! -!SULF/WC_NH3=0.0 -! -!SULF/WC_OH=0.0 -! -!SULF/WC_HO2=0.0 -! -!SULF/WC_CO2=0.0 -! -!SULF/WC_SO2=0.0 -! -!SULF/WC_SULF=+KTC35 - PJAC(:,13,57)=+TPK%KTC35(:) -! -!SULF/WC_HCHO=0.0 -! -!SULF/WC_ORA1=0.0 -! -!SULF/WC_ORA2=0.0 -! -!SULF/WC_MO2=0.0 -! -!SULF/WC_OP1=0.0 -! -!SULF/WC_ASO3=0.0 -! -!SULF/WC_ASO4=0.0 -! -!SULF/WC_ASO5=0.0 -! -!SULF/WC_AHSO5=0.0 -! -!SULF/WC_AHMS=0.0 -! -!SULF/WR_O3=0.0 -! -!SULF/WR_H2O2=0.0 -! -!SULF/WR_NO=0.0 -! -!SULF/WR_NO2=0.0 -! -!SULF/WR_NO3=0.0 -! -!SULF/WR_N2O5=0.0 -! -!SULF/WR_HONO=0.0 -! -!SULF/WR_HNO3=0.0 -! -!SULF/WR_HNO4=0.0 -! -!SULF/WR_NH3=0.0 -! -!SULF/WR_OH=0.0 -! -!SULF/WR_HO2=0.0 -! -!SULF/WR_CO2=0.0 -! -!SULF/WR_SO2=0.0 -! -!SULF/WR_SULF=+KTR35 - PJAC(:,13,82)=+TPK%KTR35(:) -! -!SULF/WR_HCHO=0.0 -! -!SULF/WR_ORA1=0.0 -! -!SULF/WR_ORA2=0.0 -! -!SULF/WR_MO2=0.0 -! -!SULF/WR_OP1=0.0 -! -!SULF/WR_ASO3=0.0 -! -!SULF/WR_ASO4=0.0 -! -!SULF/WR_ASO5=0.0 -! -!SULF/WR_AHSO5=0.0 -! -!SULF/WR_AHMS=0.0 -! -!CO/O3=+0.35120*K079*<ALKE>+0.36000*K080*<BIO>+0.64728*K081*<CARBO>+0.13*K082*< -!PAN> - PJAC(:,14,1)=+0.35120*TPK%K079(:)*PCONC(:,20)+0.36000*TPK%K080(:)*PCONC(:,21)+& -&0.64728*TPK%K081(:)*PCONC(:,26)+0.13*TPK%K082(:)*PCONC(:,28) -! -!CO/H2O2=0.0 -! -!CO/NO=0.0 -! -!CO/NO2=0.0 -! -!CO/NO3=+K072*<HCHO>+1.33723*K074*<CARBO> - PJAC(:,14,5)=+TPK%K072(:)*PCONC(:,23)+1.33723*TPK%K074(:)*PCONC(:,26) -! -!CO/N2O5=0.0 -! -!CO/HONO=0.0 -! -!CO/HNO3=0.0 -! -!CO/HNO4=0.0 -! -!CO/NH3=0.0 -! -!CO/DMS=0.0 -! -!CO/SO2=0.0 -! -!CO/SULF=0.0 -! -!CO/CO=-K053*<OH> - PJAC(:,14,14)=-TPK%K053(:)*PCONC(:,15) -! -!CO/OH=-K053*<CO>+0.00878*K058*<ALKA>+K062*<HCHO>+1.01732*K065*<CARBO> - PJAC(:,14,15)=-TPK%K053(:)*PCONC(:,14)+0.00878*TPK%K058(:)*PCONC(:,19)+TPK%K06& -&2(:)*PCONC(:,23)+1.01732*TPK%K065(:)*PCONC(:,26) -! -!CO/HO2=0.0 -! -!CO/CH4=0.0 -! -!CO/ETH=0.0 -! -!CO/ALKA=+0.00878*K058*<OH> - PJAC(:,14,19)=+0.00878*TPK%K058(:)*PCONC(:,15) -! -!CO/ALKE=+0.35120*K079*<O3> - PJAC(:,14,20)=+0.35120*TPK%K079(:)*PCONC(:,1) -! -!CO/BIO=+0.01*K054*<O3P>+0.36000*K080*<O3> - PJAC(:,14,21)=+0.01*TPK%K054(:)*TPK%O3P(:)+0.36000*TPK%K080(:)*PCONC(:,1) -! -!CO/ARO=0.0 -! -!CO/HCHO=+K010+K011+K062*<OH>+K072*<NO3> - PJAC(:,14,23)=+TPK%K010(:)+TPK%K011(:)+TPK%K062(:)*PCONC(:,15)+TPK%K072(:)*PCO& -&NC(:,5) -! -!CO/ALD=+K012 - PJAC(:,14,24)=+TPK%K012(:) -! -!CO/KET=0.0 -! -!CO/CARBO=+0.91924*K016+1.01732*K065*<OH>+1.33723*K074*<NO3>+0.64728*K081*<O3> - PJAC(:,14,26)=+0.91924*TPK%K016(:)+1.01732*TPK%K065(:)*PCONC(:,15)+1.33723*TPK& -&%K074(:)*PCONC(:,5)+0.64728*TPK%K081(:)*PCONC(:,1) -! -!CO/ONIT=0.0 -! -!CO/PAN=+0.13*K082*<O3> - PJAC(:,14,28)=+0.13*TPK%K082(:)*PCONC(:,1) -! -!CO/OP1=0.0 -! -!CO/OP2=0.0 -! -!CO/ORA1=0.0 -! -!CO/ORA2=0.0 -! -!CO/MO2=0.0 -! -!CO/ALKAP=0.0 -! -!CO/ALKEP=0.0 -! -!CO/BIOP=0.0 -! -!CO/PHO=0.0 -! -!CO/ADD=0.0 -! -!CO/AROP=0.0 -! -!CO/CARBOP=0.0 -! -!CO/OLN=0.0 -! -!CO/XO2=0.0 -! -!CO/WC_O3=0.0 -! -!CO/WC_H2O2=0.0 -! -!CO/WC_NO=0.0 -! -!CO/WC_NO2=0.0 -! -!CO/WC_NO3=0.0 -! -!CO/WC_N2O5=0.0 -! -!CO/WC_HONO=0.0 -! -!CO/WC_HNO3=0.0 -! -!CO/WC_HNO4=0.0 -! -!CO/WC_NH3=0.0 -! -!CO/WC_OH=0.0 -! -!CO/WC_HO2=0.0 -! -!CO/WC_CO2=0.0 -! -!CO/WC_SO2=0.0 -! -!CO/WC_SULF=0.0 -! -!CO/WC_HCHO=0.0 -! -!CO/WC_ORA1=0.0 -! -!CO/WC_ORA2=0.0 -! -!CO/WC_MO2=0.0 -! -!CO/WC_OP1=0.0 -! -!CO/WC_ASO3=0.0 -! -!CO/WC_ASO4=0.0 -! -!CO/WC_ASO5=0.0 -! -!CO/WC_AHSO5=0.0 -! -!CO/WC_AHMS=0.0 -! -!CO/WR_O3=0.0 -! -!CO/WR_H2O2=0.0 -! -!CO/WR_NO=0.0 -! -!CO/WR_NO2=0.0 -! -!CO/WR_NO3=0.0 -! -!CO/WR_N2O5=0.0 -! -!CO/WR_HONO=0.0 -! -!CO/WR_HNO3=0.0 -! -!CO/WR_HNO4=0.0 -! -!CO/WR_NH3=0.0 -! -!CO/WR_OH=0.0 -! -!CO/WR_HO2=0.0 -! -!CO/WR_CO2=0.0 -! -!CO/WR_SO2=0.0 -! -!CO/WR_SULF=0.0 -! -!CO/WR_HCHO=0.0 -! -!CO/WR_ORA1=0.0 -! -!CO/WR_ORA2=0.0 -! -!CO/WR_MO2=0.0 -! -!CO/WR_OP1=0.0 -! -!CO/WR_ASO3=0.0 -! -!CO/WR_ASO4=0.0 -! -!CO/WR_ASO5=0.0 -! -!CO/WR_AHSO5=0.0 -! -!CO/WR_AHMS=0.0 -! -!OH/O3=-K023*<OH>+K024*<HO2>+0.39435*K079*<ALKE>+0.28000*K080*<BIO>+0.20595*K08 -!1*<CARBO>+0.036*K082*<PAN>+K087*<ADD> - PJAC(:,15,1)=-TPK%K023(:)*PCONC(:,15)+TPK%K024(:)*PCONC(:,16)+0.39435*TPK%K079& -&(:)*PCONC(:,20)+0.28000*TPK%K080(:)*PCONC(:,21)+0.20595*TPK%K081(:)*PCONC(:,26& -&)+0.036*TPK%K082(:)*PCONC(:,28)+TPK%K087(:)*PCONC(:,38) -! -!OH/H2O2=+K009+K009-K026*<OH> - PJAC(:,15,2)=+TPK%K009(:)+TPK%K009(:)-TPK%K026(:)*PCONC(:,15) -! -!OH/NO=-K032*<OH>+K035*<HO2> - PJAC(:,15,3)=-TPK%K032(:)*PCONC(:,15)+TPK%K035(:)*PCONC(:,16) -! -!OH/NO2=-K033*<OH> - PJAC(:,15,4)=-TPK%K033(:)*PCONC(:,15) -! -!OH/NO3=-K034*<OH>+0.7*K038*<HO2> - PJAC(:,15,5)=-TPK%K034(:)*PCONC(:,15)+0.7*TPK%K038(:)*PCONC(:,16) -! -!OH/N2O5=0.0 -! -!OH/HONO=+K004-K039*<OH> - PJAC(:,15,7)=+TPK%K004(:)-TPK%K039(:)*PCONC(:,15) -! -!OH/HNO3=+K005-K040*<OH> - PJAC(:,15,8)=+TPK%K005(:)-TPK%K040(:)*PCONC(:,15) -! -!OH/HNO4=+0.35*K006-K041*<OH> - PJAC(:,15,9)=+0.35*TPK%K006(:)-TPK%K041(:)*PCONC(:,15) -! -!OH/NH3=-K050*<OH> - PJAC(:,15,10)=-TPK%K050(:)*PCONC(:,15) -! -!OH/DMS=-K135*<OH> - PJAC(:,15,11)=-TPK%K135(:)*PCONC(:,15) -! -!OH/SO2=-K052*<OH> - PJAC(:,15,12)=-TPK%K052(:)*PCONC(:,15) -! -!OH/SULF=0.0 -! -!OH/CO=-K053*<OH> - PJAC(:,15,14)=-TPK%K053(:)*PCONC(:,15) -! -!OH/OH=-K023*<O3>-K025*<HO2>-K026*<H2O2>-K032*<NO>-K033*<NO2>-K034*<NO3>-K039*< -!HONO>-K040*<HNO3>-K041*<HNO4>-K050*<NH3>-K051*<H2>-K052*<SO2>-K053*<CO>-K056*< -!CH4>-K057*<ETH>+0.00878*K058*<ALKA>-K058*<ALKA>-K059*<ALKE>-K060*<BIO>-K061*<A -!RO>-K062*<HCHO>-K063*<ALD>-K064*<KET>-K065*<CARBO>-K066*<ORA1>-K067*<ORA2>+0.3 -!5*K068*<OP1>-K068*<OP1>+0.44925*K069*<OP2>-K069*<OP2>-K070*<PAN>-K071*<ONIT>-K -!135*<DMS>-KTC11-KTR11 - PJAC(:,15,15)=-TPK%K023(:)*PCONC(:,1)-TPK%K025(:)*PCONC(:,16)-TPK%K026(:)*PCON& -&C(:,2)-TPK%K032(:)*PCONC(:,3)-TPK%K033(:)*PCONC(:,4)-TPK%K034(:)*PCONC(:,5)-TP& -&K%K039(:)*PCONC(:,7)-TPK%K040(:)*PCONC(:,8)-TPK%K041(:)*PCONC(:,9)-TPK%K050(:)& -&*PCONC(:,10)-TPK%K051(:)*TPK%H2(:)-TPK%K052(:)*PCONC(:,12)-TPK%K053(:)*PCONC(:& -&,14)-TPK%K056(:)*PCONC(:,17)-TPK%K057(:)*PCONC(:,18)+0.00878*TPK%K058(:)*PCONC& -&(:,19)-TPK%K058(:)*PCONC(:,19)-TPK%K059(:)*PCONC(:,20)-TPK%K060(:)*PCONC(:,21)& -&-TPK%K061(:)*PCONC(:,22)-TPK%K062(:)*PCONC(:,23)-TPK%K063(:)*PCONC(:,24)-TPK%K& -&064(:)*PCONC(:,25)-TPK%K065(:)*PCONC(:,26)-TPK%K066(:)*PCONC(:,31)-TPK%K067(:)& -&*PCONC(:,32)+0.35*TPK%K068(:)*PCONC(:,29)-TPK%K068(:)*PCONC(:,29)+0.44925*TPK%& -&K069(:)*PCONC(:,30)-TPK%K069(:)*PCONC(:,30)-TPK%K070(:)*PCONC(:,28)-TPK%K071(:& -&)*PCONC(:,27)-TPK%K135(:)*PCONC(:,11)-TPK%KTC11(:)-TPK%KTR11(:) -! -!OH/HO2=+K024*<O3>-K025*<OH>+K035*<NO>+0.7*K038*<NO3> - PJAC(:,15,16)=+TPK%K024(:)*PCONC(:,1)-TPK%K025(:)*PCONC(:,15)+TPK%K035(:)*PCON& -&C(:,3)+0.7*TPK%K038(:)*PCONC(:,5) -! -!OH/CH4=-K056*<OH> - PJAC(:,15,17)=-TPK%K056(:)*PCONC(:,15) -! -!OH/ETH=-K057*<OH> - PJAC(:,15,18)=-TPK%K057(:)*PCONC(:,15) -! -!OH/ALKA=+0.00878*K058*<OH>-K058*<OH> - PJAC(:,15,19)=+0.00878*TPK%K058(:)*PCONC(:,15)-TPK%K058(:)*PCONC(:,15) -! -!OH/ALKE=-K059*<OH>+0.39435*K079*<O3> - PJAC(:,15,20)=-TPK%K059(:)*PCONC(:,15)+0.39435*TPK%K079(:)*PCONC(:,1) -! -!OH/BIO=+0.02*K054*<O3P>-K060*<OH>+0.28000*K080*<O3> - PJAC(:,15,21)=+0.02*TPK%K054(:)*TPK%O3P(:)-TPK%K060(:)*PCONC(:,15)+0.28000*TPK& -&%K080(:)*PCONC(:,1) -! -!OH/ARO=-K061*<OH> - PJAC(:,15,22)=-TPK%K061(:)*PCONC(:,15) -! -!OH/HCHO=-K062*<OH> - PJAC(:,15,23)=-TPK%K062(:)*PCONC(:,15) -! -!OH/ALD=-K063*<OH> - PJAC(:,15,24)=-TPK%K063(:)*PCONC(:,15) -! -!OH/KET=-K064*<OH> - PJAC(:,15,25)=-TPK%K064(:)*PCONC(:,15) -! -!OH/CARBO=-K065*<OH>+0.20595*K081*<O3> - PJAC(:,15,26)=-TPK%K065(:)*PCONC(:,15)+0.20595*TPK%K081(:)*PCONC(:,1) -! -!OH/ONIT=-K071*<OH> - PJAC(:,15,27)=-TPK%K071(:)*PCONC(:,15) -! -!OH/PAN=-K070*<OH>+0.036*K082*<O3> - PJAC(:,15,28)=-TPK%K070(:)*PCONC(:,15)+0.036*TPK%K082(:)*PCONC(:,1) -! -!OH/OP1=+K013+0.35*K068*<OH>-K068*<OH> - PJAC(:,15,29)=+TPK%K013(:)+0.35*TPK%K068(:)*PCONC(:,15)-TPK%K068(:)*PCONC(:,15& -&) -! -!OH/OP2=+K014+0.44925*K069*<OH>-K069*<OH> - PJAC(:,15,30)=+TPK%K014(:)+0.44925*TPK%K069(:)*PCONC(:,15)-TPK%K069(:)*PCONC(:& -&,15) -! -!OH/ORA1=-K066*<OH> - PJAC(:,15,31)=-TPK%K066(:)*PCONC(:,15) -! -!OH/ORA2=-K067*<OH> - PJAC(:,15,32)=-TPK%K067(:)*PCONC(:,15) -! -!OH/MO2=0.0 -! -!OH/ALKAP=0.0 -! -!OH/ALKEP=0.0 -! -!OH/BIOP=0.0 -! -!OH/PHO=0.0 -! -!OH/ADD=+K087*<O3> - PJAC(:,15,38)=+TPK%K087(:)*PCONC(:,1) -! -!OH/AROP=0.0 -! -!OH/CARBOP=0.0 -! -!OH/OLN=0.0 -! -!OH/XO2=0.0 -! -!OH/WC_O3=0.0 -! -!OH/WC_H2O2=0.0 -! -!OH/WC_NO=0.0 -! -!OH/WC_NO2=0.0 -! -!OH/WC_NO3=0.0 -! -!OH/WC_N2O5=0.0 -! -!OH/WC_HONO=0.0 -! -!OH/WC_HNO3=0.0 -! -!OH/WC_HNO4=0.0 -! -!OH/WC_NH3=0.0 -! -!OH/WC_OH=+KTC31 - PJAC(:,15,53)=+TPK%KTC31(:) -! -!OH/WC_HO2=0.0 -! -!OH/WC_CO2=0.0 -! -!OH/WC_SO2=0.0 -! -!OH/WC_SULF=0.0 -! -!OH/WC_HCHO=0.0 -! -!OH/WC_ORA1=0.0 -! -!OH/WC_ORA2=0.0 -! -!OH/WC_MO2=0.0 -! -!OH/WC_OP1=0.0 -! -!OH/WC_ASO3=0.0 -! -!OH/WC_ASO4=0.0 -! -!OH/WC_ASO5=0.0 -! -!OH/WC_AHSO5=0.0 -! -!OH/WC_AHMS=0.0 -! -!OH/WR_O3=0.0 -! -!OH/WR_H2O2=0.0 -! -!OH/WR_NO=0.0 -! -!OH/WR_NO2=0.0 -! -!OH/WR_NO3=0.0 -! -!OH/WR_N2O5=0.0 -! -!OH/WR_HONO=0.0 -! -!OH/WR_HNO3=0.0 -! -!OH/WR_HNO4=0.0 -! -!OH/WR_NH3=0.0 -! -!OH/WR_OH=+KTR31 - PJAC(:,15,78)=+TPK%KTR31(:) -! -!OH/WR_HO2=0.0 -! -!OH/WR_CO2=0.0 -! -!OH/WR_SO2=0.0 -! -!OH/WR_SULF=0.0 -! -!OH/WR_HCHO=0.0 -! -!OH/WR_ORA1=0.0 -! -!OH/WR_ORA2=0.0 -! -!OH/WR_MO2=0.0 -! -!OH/WR_OP1=0.0 -! -!OH/WR_ASO3=0.0 -! -!OH/WR_ASO4=0.0 -! -!OH/WR_ASO5=0.0 -! -!OH/WR_AHSO5=0.0 -! -!OH/WR_AHMS=0.0 -! -RETURN -END SUBROUTINE SUBJ2 -! -SUBROUTINE SUBJ3 -! -!Indices 16 a 20 -! -! -!HO2/O3=+K023*<OH>-K024*<HO2>+0.23451*K079*<ALKE>+0.30000*K080*<BIO>+0.28441*K0 -!81*<CARBO>+0.08*K082*<PAN> - PJAC(:,16,1)=+TPK%K023(:)*PCONC(:,15)-TPK%K024(:)*PCONC(:,16)+0.23451*TPK%K079& -&(:)*PCONC(:,20)+0.30000*TPK%K080(:)*PCONC(:,21)+0.28441*TPK%K081(:)*PCONC(:,26& -&)+0.08*TPK%K082(:)*PCONC(:,28) -! -!HO2/H2O2=+K026*<OH> - PJAC(:,16,2)=+TPK%K026(:)*PCONC(:,15) -! -!HO2/NO=-K035*<HO2>+K090*<MO2>+0.74265*K091*<ALKAP>+K092*<ALKEP>+0.84700*K093*< -!BIOP>+0.95115*K094*<AROP>+0.12334*K095*<CARBOP>+0.18401*K096*<OLN> - PJAC(:,16,3)=-TPK%K035(:)*PCONC(:,16)+TPK%K090(:)*PCONC(:,33)+0.74265*TPK%K091& -&(:)*PCONC(:,34)+TPK%K092(:)*PCONC(:,35)+0.84700*TPK%K093(:)*PCONC(:,36)+0.9511& -&5*TPK%K094(:)*PCONC(:,39)+0.12334*TPK%K095(:)*PCONC(:,40)+0.18401*TPK%K096(:)*& -&PCONC(:,41) -! -!HO2/NO2=-K036*<HO2> - PJAC(:,16,4)=-TPK%K036(:)*PCONC(:,16) -! -!HO2/NO3=+K034*<OH>-K038*<HO2>+K072*<HCHO>+0.63217*K074*<CARBO>+K119*<MO2>+0.81 -!290*K120*<ALKAP>+K121*<ALKEP>+K122*<BIOP>+K123*<AROP>+0.04915*K124*<CARBOP>+0. -!25928*K125*<OLN> - PJAC(:,16,5)=+TPK%K034(:)*PCONC(:,15)-TPK%K038(:)*PCONC(:,16)+TPK%K072(:)*PCON& -&C(:,23)+0.63217*TPK%K074(:)*PCONC(:,26)+TPK%K119(:)*PCONC(:,33)+0.81290*TPK%K1& -&20(:)*PCONC(:,34)+TPK%K121(:)*PCONC(:,35)+TPK%K122(:)*PCONC(:,36)+TPK%K123(:)*& -&PCONC(:,39)+0.04915*TPK%K124(:)*PCONC(:,40)+0.25928*TPK%K125(:)*PCONC(:,41) -! -!HO2/N2O5=0.0 -! -!HO2/HONO=0.0 -! -!HO2/HNO3=0.0 -! -!HO2/HNO4=+0.65*K006+K037 - PJAC(:,16,9)=+0.65*TPK%K006(:)+TPK%K037(:) -! -!HO2/NH3=0.0 -! -!HO2/DMS=0.0 -! -!HO2/SO2=+K052*<OH> - PJAC(:,16,12)=+TPK%K052(:)*PCONC(:,15) -! -!HO2/SULF=0.0 -! -!HO2/CO=+K053*<OH> - PJAC(:,16,14)=+TPK%K053(:)*PCONC(:,15) -! -!HO2/OH=+K023*<O3>-K025*<HO2>+K026*<H2O2>+K034*<NO3>+K051*<H2>+K052*<SO2>+K053* -!<CO>+0.12793*K058*<ALKA>+0.10318*K061*<ARO>+K062*<HCHO>+0.51208*K065*<CARBO>+K -!066*<ORA1>+0.02915*K069*<OP2>+0.28107*K070*<PAN> - PJAC(:,16,15)=+TPK%K023(:)*PCONC(:,1)-TPK%K025(:)*PCONC(:,16)+TPK%K026(:)*PCON& -&C(:,2)+TPK%K034(:)*PCONC(:,5)+TPK%K051(:)*TPK%H2(:)+TPK%K052(:)*PCONC(:,12)+TP& -&K%K053(:)*PCONC(:,14)+0.12793*TPK%K058(:)*PCONC(:,19)+0.10318*TPK%K061(:)*PCON& -&C(:,22)+TPK%K062(:)*PCONC(:,23)+0.51208*TPK%K065(:)*PCONC(:,26)+TPK%K066(:)*PC& -&ONC(:,31)+0.02915*TPK%K069(:)*PCONC(:,30)+0.28107*TPK%K070(:)*PCONC(:,28) -! -!HO2/HO2=-K024*<O3>-K025*<OH>-K027*<HO2>-K027*<HO2>-K027*<HO2>-K027*<HO2>-K028* -!<HO2>*<H2O>-K028*<HO2>*<H2O>-K028*<HO2>*<H2O>-K028*<HO2>*<H2O>-K035*<NO>-K036* -!<NO2>-K038*<NO3>-K084*<PHO>-K097*<MO2>-K098*<ALKAP>-K099*<ALKEP>-K0100*<BIOP>- -!K0101*<AROP>-K0102*<CARBOP>-K103*<OLN>-K126*<XO2>-KTC12-KTR12 - PJAC(:,16,16)=-TPK%K024(:)*PCONC(:,1)-TPK%K025(:)*PCONC(:,15)-TPK%K027(:)*PCON& -&C(:,16)-TPK%K027(:)*PCONC(:,16)-TPK%K027(:)*PCONC(:,16)-TPK%K027(:)*PCONC(:,16& -&)-TPK%K028(:)*PCONC(:,16)*TPK%H2O(:)-TPK%K028(:)*PCONC(:,16)*TPK%H2O(:)-TPK%K0& -&28(:)*PCONC(:,16)*TPK%H2O(:)-TPK%K028(:)*PCONC(:,16)*TPK%H2O(:)-TPK%K035(:)*PC& -&ONC(:,3)-TPK%K036(:)*PCONC(:,4)-TPK%K038(:)*PCONC(:,5)-TPK%K084(:)*PCONC(:,37)& -&-TPK%K097(:)*PCONC(:,33)-TPK%K098(:)*PCONC(:,34)-TPK%K099(:)*PCONC(:,35)-TPK%K& -&0100(:)*PCONC(:,36)-TPK%K0101(:)*PCONC(:,39)-TPK%K0102(:)*PCONC(:,40)-TPK%K103& -&(:)*PCONC(:,41)-TPK%K126(:)*PCONC(:,42)-TPK%KTC12(:)-TPK%KTR12(:) -! -!HO2/CH4=0.0 -! -!HO2/ETH=0.0 -! -!HO2/ALKA=+0.12793*K058*<OH> - PJAC(:,16,19)=+0.12793*TPK%K058(:)*PCONC(:,15) -! -!HO2/ALKE=+0.23451*K079*<O3> - PJAC(:,16,20)=+0.23451*TPK%K079(:)*PCONC(:,1) -! -!HO2/BIO=+0.28*K054*<O3P>+0.30000*K080*<O3> - PJAC(:,16,21)=+0.28*TPK%K054(:)*TPK%O3P(:)+0.30000*TPK%K080(:)*PCONC(:,1) -! -!HO2/ARO=+0.10318*K061*<OH> - PJAC(:,16,22)=+0.10318*TPK%K061(:)*PCONC(:,15) -! -!HO2/HCHO=+K011+K011+K062*<OH>+K072*<NO3> - PJAC(:,16,23)=+TPK%K011(:)+TPK%K011(:)+TPK%K062(:)*PCONC(:,15)+TPK%K072(:)*PCO& -&NC(:,5) -! -!HO2/ALD=+K012 - PJAC(:,16,24)=+TPK%K012(:) -! -!HO2/KET=0.0 -! -!HO2/CARBO=+0.75830*K016+0.51208*K065*<OH>+0.63217*K074*<NO3>+0.28441*K081*<O3> - PJAC(:,16,26)=+0.75830*TPK%K016(:)+0.51208*TPK%K065(:)*PCONC(:,15)+0.63217*TPK& -&%K074(:)*PCONC(:,5)+0.28441*TPK%K081(:)*PCONC(:,1) -! -!HO2/ONIT=+K017 - PJAC(:,16,27)=+TPK%K017(:) -! -!HO2/PAN=+0.28107*K070*<OH>+0.08*K082*<O3> - PJAC(:,16,28)=+0.28107*TPK%K070(:)*PCONC(:,15)+0.08*TPK%K082(:)*PCONC(:,1) -! -!HO2/OP1=+K013 - PJAC(:,16,29)=+TPK%K013(:) -! -!HO2/OP2=+0.96205*K014+0.02915*K069*<OH> - PJAC(:,16,30)=+0.96205*TPK%K014(:)+0.02915*TPK%K069(:)*PCONC(:,15) -! -!HO2/ORA1=+K066*<OH> - PJAC(:,16,31)=+TPK%K066(:)*PCONC(:,15) -! -!HO2/ORA2=0.0 -! -!HO2/MO2=+K090*<NO>-K097*<HO2>+0.66*K104*<MO2>+0.66*K104*<MO2>+0.98383*K105*<AL -!KAP>+K106*<ALKEP>+1.00000*K107*<BIOP>+1.02767*K108*<AROP>+0.82998*K109*<CARBOP -!>+0.67560*K110*<OLN>+K119*<NO3>+K127*<XO2> - PJAC(:,16,33)=+TPK%K090(:)*PCONC(:,3)-TPK%K097(:)*PCONC(:,16)+0.66*TPK%K104(:)& -&*PCONC(:,33)+0.66*TPK%K104(:)*PCONC(:,33)+0.98383*TPK%K105(:)*PCONC(:,34)+TPK%& -&K106(:)*PCONC(:,35)+1.00000*TPK%K107(:)*PCONC(:,36)+1.02767*TPK%K108(:)*PCONC(& -&:,39)+0.82998*TPK%K109(:)*PCONC(:,40)+0.67560*TPK%K110(:)*PCONC(:,41)+TPK%K119& -&(:)*PCONC(:,5)+TPK%K127(:)*PCONC(:,42) -! -!HO2/ALKAP=+0.74265*K091*<NO>-K098*<HO2>+0.98383*K105*<MO2>+0.48079*K111*<CARBO -!P>+0.81290*K120*<NO3> - PJAC(:,16,34)=+0.74265*TPK%K091(:)*PCONC(:,3)-TPK%K098(:)*PCONC(:,16)+0.98383*& -&TPK%K105(:)*PCONC(:,33)+0.48079*TPK%K111(:)*PCONC(:,40)+0.81290*TPK%K120(:)*PC& -&ONC(:,5) -! -!HO2/ALKEP=+K092*<NO>-K099*<HO2>+K106*<MO2>+0.50078*K112*<CARBOP>+K121*<NO3> - PJAC(:,16,35)=+TPK%K092(:)*PCONC(:,3)-TPK%K099(:)*PCONC(:,16)+TPK%K106(:)*PCON& -&C(:,33)+0.50078*TPK%K112(:)*PCONC(:,40)+TPK%K121(:)*PCONC(:,5) -! -!HO2/BIOP=+0.84700*K093*<NO>-K0100*<HO2>+1.00000*K107*<MO2>+0.50600*K113*<CARBO -!P>+K122*<NO3> - PJAC(:,16,36)=+0.84700*TPK%K093(:)*PCONC(:,3)-TPK%K0100(:)*PCONC(:,16)+1.00000& -&*TPK%K107(:)*PCONC(:,33)+0.50600*TPK%K113(:)*PCONC(:,40)+TPK%K122(:)*PCONC(:,5& -&) -! -!HO2/PHO=-K084*<HO2> - PJAC(:,16,37)=-TPK%K084(:)*PCONC(:,16) -! -!HO2/ADD=+0.02*K086*<O2> - PJAC(:,16,38)=+0.02*TPK%K086(:)*TPK%O2(:) -! -!HO2/AROP=+0.95115*K094*<NO>-K0101*<HO2>+1.02767*K108*<MO2>+K114*<CARBOP>+K123* -!<NO3> - PJAC(:,16,39)=+0.95115*TPK%K094(:)*PCONC(:,3)-TPK%K0101(:)*PCONC(:,16)+1.02767& -&*TPK%K108(:)*PCONC(:,33)+TPK%K114(:)*PCONC(:,40)+TPK%K123(:)*PCONC(:,5) -! -!HO2/CARBOP=+0.12334*K095*<NO>-K0102*<HO2>+0.82998*K109*<MO2>+0.48079*K111*<ALK -!AP>+0.50078*K112*<ALKEP>+0.50600*K113*<BIOP>+K114*<AROP>+0.07566*K115*<CARBOP> -!+0.07566*K115*<CARBOP>+0.17599*K116*<OLN>+0.04915*K124*<NO3> - PJAC(:,16,40)=+0.12334*TPK%K095(:)*PCONC(:,3)-TPK%K0102(:)*PCONC(:,16)+0.82998& -&*TPK%K109(:)*PCONC(:,33)+0.48079*TPK%K111(:)*PCONC(:,34)+0.50078*TPK%K112(:)*P& -&CONC(:,35)+0.50600*TPK%K113(:)*PCONC(:,36)+TPK%K114(:)*PCONC(:,39)+0.07566*TPK& -&%K115(:)*PCONC(:,40)+0.07566*TPK%K115(:)*PCONC(:,40)+0.17599*TPK%K116(:)*PCONC& -&(:,41)+0.04915*TPK%K124(:)*PCONC(:,5) -! -!HO2/OLN=+0.18401*K096*<NO>-K103*<HO2>+0.67560*K110*<MO2>+0.17599*K116*<CARBOP> -!+K117*<OLN>+K117*<OLN>+0.00000*K118*<OLN>+0.00000*K118*<OLN>+0.25928*K125*<NO3 -!> - PJAC(:,16,41)=+0.18401*TPK%K096(:)*PCONC(:,3)-TPK%K103(:)*PCONC(:,16)+0.67560*& -&TPK%K110(:)*PCONC(:,33)+0.17599*TPK%K116(:)*PCONC(:,40)+TPK%K117(:)*PCONC(:,41& -&)+TPK%K117(:)*PCONC(:,41)+0.00000*TPK%K118(:)*PCONC(:,41)+0.00000*TPK%K118(:)*& -&PCONC(:,41)+0.25928*TPK%K125(:)*PCONC(:,5) -! -!HO2/XO2=-K126*<HO2>+K127*<MO2> - PJAC(:,16,42)=-TPK%K126(:)*PCONC(:,16)+TPK%K127(:)*PCONC(:,33) -! -!HO2/WC_O3=0.0 -! -!HO2/WC_H2O2=0.0 -! -!HO2/WC_NO=0.0 -! -!HO2/WC_NO2=0.0 -! -!HO2/WC_NO3=0.0 -! -!HO2/WC_N2O5=0.0 -! -!HO2/WC_HONO=0.0 -! -!HO2/WC_HNO3=0.0 -! -!HO2/WC_HNO4=0.0 -! -!HO2/WC_NH3=0.0 -! -!HO2/WC_OH=0.0 -! -!HO2/WC_HO2=+KTC32 - PJAC(:,16,54)=+TPK%KTC32(:) -! -!HO2/WC_CO2=0.0 -! -!HO2/WC_SO2=0.0 -! -!HO2/WC_SULF=0.0 -! -!HO2/WC_HCHO=0.0 -! -!HO2/WC_ORA1=0.0 -! -!HO2/WC_ORA2=0.0 -! -!HO2/WC_MO2=0.0 -! -!HO2/WC_OP1=0.0 -! -!HO2/WC_ASO3=0.0 -! -!HO2/WC_ASO4=0.0 -! -!HO2/WC_ASO5=0.0 -! -!HO2/WC_AHSO5=0.0 -! -!HO2/WC_AHMS=0.0 -! -!HO2/WR_O3=0.0 -! -!HO2/WR_H2O2=0.0 -! -!HO2/WR_NO=0.0 -! -!HO2/WR_NO2=0.0 -! -!HO2/WR_NO3=0.0 -! -!HO2/WR_N2O5=0.0 -! -!HO2/WR_HONO=0.0 -! -!HO2/WR_HNO3=0.0 -! -!HO2/WR_HNO4=0.0 -! -!HO2/WR_NH3=0.0 -! -!HO2/WR_OH=0.0 -! -!HO2/WR_HO2=+KTR32 - PJAC(:,16,79)=+TPK%KTR32(:) -! -!HO2/WR_CO2=0.0 -! -!HO2/WR_SO2=0.0 -! -!HO2/WR_SULF=0.0 -! -!HO2/WR_HCHO=0.0 -! -!HO2/WR_ORA1=0.0 -! -!HO2/WR_ORA2=0.0 -! -!HO2/WR_MO2=0.0 -! -!HO2/WR_OP1=0.0 -! -!HO2/WR_ASO3=0.0 -! -!HO2/WR_ASO4=0.0 -! -!HO2/WR_ASO5=0.0 -! -!HO2/WR_AHSO5=0.0 -! -!HO2/WR_AHMS=0.0 -! -!CH4/O3=+0.04300*K079*<ALKE> - PJAC(:,17,1)=+0.04300*TPK%K079(:)*PCONC(:,20) -! -!CH4/H2O2=0.0 -! -!CH4/NO=0.0 -! -!CH4/NO2=0.0 -! -!CH4/NO3=0.0 -! -!CH4/N2O5=0.0 -! -!CH4/HONO=0.0 -! -!CH4/HNO3=0.0 -! -!CH4/HNO4=0.0 -! -!CH4/NH3=0.0 -! -!CH4/DMS=0.0 -! -!CH4/SO2=0.0 -! -!CH4/SULF=0.0 -! -!CH4/CO=0.0 -! -!CH4/OH=-K056*<CH4> - PJAC(:,17,15)=-TPK%K056(:)*PCONC(:,17) -! -!CH4/HO2=0.0 -! -!CH4/CH4=-K056*<OH> - PJAC(:,17,17)=-TPK%K056(:)*PCONC(:,15) -! -!CH4/ETH=0.0 -! -!CH4/ALKA=0.0 -! -!CH4/ALKE=+0.04300*K079*<O3> - PJAC(:,17,20)=+0.04300*TPK%K079(:)*PCONC(:,1) -! -!CH4/BIO=0.0 -! -!CH4/ARO=0.0 -! -!CH4/HCHO=0.0 -! -!CH4/ALD=0.0 -! -!CH4/KET=0.0 -! -!CH4/CARBO=0.0 -! -!CH4/ONIT=0.0 -! -!CH4/PAN=0.0 -! -!CH4/OP1=0.0 -! -!CH4/OP2=0.0 -! -!CH4/ORA1=0.0 -! -!CH4/ORA2=0.0 -! -!CH4/MO2=0.0 -! -!CH4/ALKAP=0.0 -! -!CH4/ALKEP=0.0 -! -!CH4/BIOP=0.0 -! -!CH4/PHO=0.0 -! -!CH4/ADD=0.0 -! -!CH4/AROP=0.0 -! -!CH4/CARBOP=0.0 -! -!CH4/OLN=0.0 -! -!CH4/XO2=0.0 -! -!CH4/WC_O3=0.0 -! -!CH4/WC_H2O2=0.0 -! -!CH4/WC_NO=0.0 -! -!CH4/WC_NO2=0.0 -! -!CH4/WC_NO3=0.0 -! -!CH4/WC_N2O5=0.0 -! -!CH4/WC_HONO=0.0 -! -!CH4/WC_HNO3=0.0 -! -!CH4/WC_HNO4=0.0 -! -!CH4/WC_NH3=0.0 -! -!CH4/WC_OH=0.0 -! -!CH4/WC_HO2=0.0 -! -!CH4/WC_CO2=0.0 -! -!CH4/WC_SO2=0.0 -! -!CH4/WC_SULF=0.0 -! -!CH4/WC_HCHO=0.0 -! -!CH4/WC_ORA1=0.0 -! -!CH4/WC_ORA2=0.0 -! -!CH4/WC_MO2=0.0 -! -!CH4/WC_OP1=0.0 -! -!CH4/WC_ASO3=0.0 -! -!CH4/WC_ASO4=0.0 -! -!CH4/WC_ASO5=0.0 -! -!CH4/WC_AHSO5=0.0 -! -!CH4/WC_AHMS=0.0 -! -!CH4/WR_O3=0.0 -! -!CH4/WR_H2O2=0.0 -! -!CH4/WR_NO=0.0 -! -!CH4/WR_NO2=0.0 -! -!CH4/WR_NO3=0.0 -! -!CH4/WR_N2O5=0.0 -! -!CH4/WR_HONO=0.0 -! -!CH4/WR_HNO3=0.0 -! -!CH4/WR_HNO4=0.0 -! -!CH4/WR_NH3=0.0 -! -!CH4/WR_OH=0.0 -! -!CH4/WR_HO2=0.0 -! -!CH4/WR_CO2=0.0 -! -!CH4/WR_SO2=0.0 -! -!CH4/WR_SULF=0.0 -! -!CH4/WR_HCHO=0.0 -! -!CH4/WR_ORA1=0.0 -! -!CH4/WR_ORA2=0.0 -! -!CH4/WR_MO2=0.0 -! -!CH4/WR_OP1=0.0 -! -!CH4/WR_ASO3=0.0 -! -!CH4/WR_ASO4=0.0 -! -!CH4/WR_ASO5=0.0 -! -!CH4/WR_AHSO5=0.0 -! -!CH4/WR_AHMS=0.0 -! -!ETH/O3=+0.03196*K079*<ALKE> - PJAC(:,18,1)=+0.03196*TPK%K079(:)*PCONC(:,20) -! -!ETH/H2O2=0.0 -! -!ETH/NO=0.0 -! -!ETH/NO2=0.0 -! -!ETH/NO3=0.0 -! -!ETH/N2O5=0.0 -! -!ETH/HONO=0.0 -! -!ETH/HNO3=0.0 -! -!ETH/HNO4=0.0 -! -!ETH/NH3=0.0 -! -!ETH/DMS=0.0 -! -!ETH/SO2=0.0 -! -!ETH/SULF=0.0 -! -!ETH/CO=0.0 -! -!ETH/OH=-K057*<ETH> - PJAC(:,18,15)=-TPK%K057(:)*PCONC(:,18) -! -!ETH/HO2=0.0 -! -!ETH/CH4=0.0 -! -!ETH/ETH=-K057*<OH> - PJAC(:,18,18)=-TPK%K057(:)*PCONC(:,15) -! -!ETH/ALKA=0.0 -! -!ETH/ALKE=+0.03196*K079*<O3> - PJAC(:,18,20)=+0.03196*TPK%K079(:)*PCONC(:,1) -! -!ETH/BIO=0.0 -! -!ETH/ARO=0.0 -! -!ETH/HCHO=0.0 -! -!ETH/ALD=0.0 -! -!ETH/KET=0.0 -! -!ETH/CARBO=0.0 -! -!ETH/ONIT=0.0 -! -!ETH/PAN=0.0 -! -!ETH/OP1=0.0 -! -!ETH/OP2=0.0 -! -!ETH/ORA1=0.0 -! -!ETH/ORA2=0.0 -! -!ETH/MO2=0.0 -! -!ETH/ALKAP=0.0 -! -!ETH/ALKEP=0.0 -! -!ETH/BIOP=0.0 -! -!ETH/PHO=0.0 -! -!ETH/ADD=0.0 -! -!ETH/AROP=0.0 -! -!ETH/CARBOP=0.0 -! -!ETH/OLN=0.0 -! -!ETH/XO2=0.0 -! -!ETH/WC_O3=0.0 -! -!ETH/WC_H2O2=0.0 -! -!ETH/WC_NO=0.0 -! -!ETH/WC_NO2=0.0 -! -!ETH/WC_NO3=0.0 -! -!ETH/WC_N2O5=0.0 -! -!ETH/WC_HONO=0.0 -! -!ETH/WC_HNO3=0.0 -! -!ETH/WC_HNO4=0.0 -! -!ETH/WC_NH3=0.0 -! -!ETH/WC_OH=0.0 -! -!ETH/WC_HO2=0.0 -! -!ETH/WC_CO2=0.0 -! -!ETH/WC_SO2=0.0 -! -!ETH/WC_SULF=0.0 -! -!ETH/WC_HCHO=0.0 -! -!ETH/WC_ORA1=0.0 -! -!ETH/WC_ORA2=0.0 -! -!ETH/WC_MO2=0.0 -! -!ETH/WC_OP1=0.0 -! -!ETH/WC_ASO3=0.0 -! -!ETH/WC_ASO4=0.0 -! -!ETH/WC_ASO5=0.0 -! -!ETH/WC_AHSO5=0.0 -! -!ETH/WC_AHMS=0.0 -! -!ETH/WR_O3=0.0 -! -!ETH/WR_H2O2=0.0 -! -!ETH/WR_NO=0.0 -! -!ETH/WR_NO2=0.0 -! -!ETH/WR_NO3=0.0 -! -!ETH/WR_N2O5=0.0 -! -!ETH/WR_HONO=0.0 -! -!ETH/WR_HNO3=0.0 -! -!ETH/WR_HNO4=0.0 -! -!ETH/WR_NH3=0.0 -! -!ETH/WR_OH=0.0 -! -!ETH/WR_HO2=0.0 -! -!ETH/WR_CO2=0.0 -! -!ETH/WR_SO2=0.0 -! -!ETH/WR_SULF=0.0 -! -!ETH/WR_HCHO=0.0 -! -!ETH/WR_ORA1=0.0 -! -!ETH/WR_ORA2=0.0 -! -!ETH/WR_MO2=0.0 -! -!ETH/WR_OP1=0.0 -! -!ETH/WR_ASO3=0.0 -! -!ETH/WR_ASO4=0.0 -! -!ETH/WR_ASO5=0.0 -! -!ETH/WR_AHSO5=0.0 -! -!ETH/WR_AHMS=0.0 -! -!ALKA/O3=0.0 -! -!ALKA/H2O2=0.0 -! -!ALKA/NO=0.0 -! -!ALKA/NO2=0.0 -! -!ALKA/NO3=0.0 -! -!ALKA/N2O5=0.0 -! -!ALKA/HONO=0.0 -! -!ALKA/HNO3=0.0 -! -!ALKA/HNO4=0.0 -! -!ALKA/NH3=0.0 -! -!ALKA/DMS=0.0 -! -!ALKA/SO2=0.0 -! -!ALKA/SULF=0.0 -! -!ALKA/CO=0.0 -! -!ALKA/OH=-K058*<ALKA> - PJAC(:,19,15)=-TPK%K058(:)*PCONC(:,19) -! -!ALKA/HO2=0.0 -! -!ALKA/CH4=0.0 -! -!ALKA/ETH=0.0 -! -!ALKA/ALKA=-K058*<OH> - PJAC(:,19,19)=-TPK%K058(:)*PCONC(:,15) -! -!ALKA/ALKE=0.0 -! -!ALKA/BIO=0.0 -! -!ALKA/ARO=0.0 -! -!ALKA/HCHO=0.0 -! -!ALKA/ALD=0.0 -! -!ALKA/KET=0.0 -! -!ALKA/CARBO=0.0 -! -!ALKA/ONIT=0.0 -! -!ALKA/PAN=0.0 -! -!ALKA/OP1=0.0 -! -!ALKA/OP2=0.0 -! -!ALKA/ORA1=0.0 -! -!ALKA/ORA2=0.0 -! -!ALKA/MO2=0.0 -! -!ALKA/ALKAP=0.0 -! -!ALKA/ALKEP=0.0 -! -!ALKA/BIOP=0.0 -! -!ALKA/PHO=0.0 -! -!ALKA/ADD=0.0 -! -!ALKA/AROP=0.0 -! -!ALKA/CARBOP=0.0 -! -!ALKA/OLN=0.0 -! -!ALKA/XO2=0.0 -! -!ALKA/WC_O3=0.0 -! -!ALKA/WC_H2O2=0.0 -! -!ALKA/WC_NO=0.0 -! -!ALKA/WC_NO2=0.0 -! -!ALKA/WC_NO3=0.0 -! -!ALKA/WC_N2O5=0.0 -! -!ALKA/WC_HONO=0.0 -! -!ALKA/WC_HNO3=0.0 -! -!ALKA/WC_HNO4=0.0 -! -!ALKA/WC_NH3=0.0 -! -!ALKA/WC_OH=0.0 -! -!ALKA/WC_HO2=0.0 -! -!ALKA/WC_CO2=0.0 -! -!ALKA/WC_SO2=0.0 -! -!ALKA/WC_SULF=0.0 -! -!ALKA/WC_HCHO=0.0 -! -!ALKA/WC_ORA1=0.0 -! -!ALKA/WC_ORA2=0.0 -! -!ALKA/WC_MO2=0.0 -! -!ALKA/WC_OP1=0.0 -! -!ALKA/WC_ASO3=0.0 -! -!ALKA/WC_ASO4=0.0 -! -!ALKA/WC_ASO5=0.0 -! -!ALKA/WC_AHSO5=0.0 -! -!ALKA/WC_AHMS=0.0 -! -!ALKA/WR_O3=0.0 -! -!ALKA/WR_H2O2=0.0 -! -!ALKA/WR_NO=0.0 -! -!ALKA/WR_NO2=0.0 -! -!ALKA/WR_NO3=0.0 -! -!ALKA/WR_N2O5=0.0 -! -!ALKA/WR_HONO=0.0 -! -!ALKA/WR_HNO3=0.0 -! -!ALKA/WR_HNO4=0.0 -! -!ALKA/WR_NH3=0.0 -! -!ALKA/WR_OH=0.0 -! -!ALKA/WR_HO2=0.0 -! -!ALKA/WR_CO2=0.0 -! -!ALKA/WR_SO2=0.0 -! -!ALKA/WR_SULF=0.0 -! -!ALKA/WR_HCHO=0.0 -! -!ALKA/WR_ORA1=0.0 -! -!ALKA/WR_ORA2=0.0 -! -!ALKA/WR_MO2=0.0 -! -!ALKA/WR_OP1=0.0 -! -!ALKA/WR_ASO3=0.0 -! -!ALKA/WR_ASO4=0.0 -! -!ALKA/WR_ASO5=0.0 -! -!ALKA/WR_AHSO5=0.0 -! -!ALKA/WR_AHMS=0.0 -! -!ALKE/O3=+0.00000*K079*<ALKE>-K079*<ALKE>+0.37388*K080*<BIO> - PJAC(:,20,1)=+0.00000*TPK%K079(:)*PCONC(:,20)-TPK%K079(:)*PCONC(:,20)+0.37388*& -&TPK%K080(:)*PCONC(:,21) -! -!ALKE/H2O2=0.0 -! -!ALKE/NO=+0.37815*K093*<BIOP> - PJAC(:,20,3)=+0.37815*TPK%K093(:)*PCONC(:,36) -! -!ALKE/NO2=0.0 -! -!ALKE/NO3=-K076*<ALKE>+0.42729*K122*<BIOP> - PJAC(:,20,5)=-TPK%K076(:)*PCONC(:,20)+0.42729*TPK%K122(:)*PCONC(:,36) -! -!ALKE/N2O5=0.0 -! -!ALKE/HONO=0.0 -! -!ALKE/HNO3=0.0 -! -!ALKE/HNO4=0.0 -! -!ALKE/NH3=0.0 -! -!ALKE/DMS=0.0 -! -!ALKE/SO2=0.0 -! -!ALKE/SULF=0.0 -! -!ALKE/CO=0.0 -! -!ALKE/OH=-K059*<ALKE> - PJAC(:,20,15)=-TPK%K059(:)*PCONC(:,20) -! -!ALKE/HO2=0.0 -! -!ALKE/CH4=0.0 -! -!ALKE/ETH=0.0 -! -!ALKE/ALKA=0.0 -! -!ALKE/ALKE=-K059*<OH>-K076*<NO3>+0.00000*K079*<O3>-K079*<O3> - PJAC(:,20,20)=-TPK%K059(:)*PCONC(:,15)-TPK%K076(:)*PCONC(:,5)+0.00000*TPK%K079& -&(:)*PCONC(:,1)-TPK%K079(:)*PCONC(:,1) -! -!ALKE/BIO=+0.91868*K054*<O3P>+0.37388*K080*<O3> - PJAC(:,20,21)=+0.91868*TPK%K054(:)*TPK%O3P(:)+0.37388*TPK%K080(:)*PCONC(:,1) -! -!ALKE/ARO=0.0 -! -!ALKE/HCHO=0.0 -! -!ALKE/ALD=0.0 -! -!ALKE/KET=0.0 -! -!ALKE/CARBO=0.0 -! -!ALKE/ONIT=0.0 -! -!ALKE/PAN=0.0 -! -!ALKE/OP1=0.0 -! -!ALKE/OP2=0.0 -! -!ALKE/ORA1=0.0 -! -!ALKE/ORA2=0.0 -! -!ALKE/MO2=+0.48074*K107*<BIOP> - PJAC(:,20,33)=+0.48074*TPK%K107(:)*PCONC(:,36) -! -!ALKE/ALKAP=0.0 -! -!ALKE/ALKEP=0.0 -! -!ALKE/BIOP=+0.37815*K093*<NO>+0.48074*K107*<MO2>+0.24463*K113*<CARBOP>+0.42729* -!K122*<NO3> - PJAC(:,20,36)=+0.37815*TPK%K093(:)*PCONC(:,3)+0.48074*TPK%K107(:)*PCONC(:,33)+& -&0.24463*TPK%K113(:)*PCONC(:,40)+0.42729*TPK%K122(:)*PCONC(:,5) -! -!ALKE/PHO=0.0 -! -!ALKE/ADD=0.0 -! -!ALKE/AROP=0.0 -! -!ALKE/CARBOP=+0.24463*K113*<BIOP> - PJAC(:,20,40)=+0.24463*TPK%K113(:)*PCONC(:,36) -! -!ALKE/OLN=0.0 -! -!ALKE/XO2=0.0 -! -!ALKE/WC_O3=0.0 -! -!ALKE/WC_H2O2=0.0 -! -!ALKE/WC_NO=0.0 -! -!ALKE/WC_NO2=0.0 -! -!ALKE/WC_NO3=0.0 -! -!ALKE/WC_N2O5=0.0 -! -!ALKE/WC_HONO=0.0 -! -!ALKE/WC_HNO3=0.0 -! -!ALKE/WC_HNO4=0.0 -! -!ALKE/WC_NH3=0.0 -! -!ALKE/WC_OH=0.0 -! -!ALKE/WC_HO2=0.0 -! -!ALKE/WC_CO2=0.0 -! -!ALKE/WC_SO2=0.0 -! -!ALKE/WC_SULF=0.0 -! -!ALKE/WC_HCHO=0.0 -! -!ALKE/WC_ORA1=0.0 -! -!ALKE/WC_ORA2=0.0 -! -!ALKE/WC_MO2=0.0 -! -!ALKE/WC_OP1=0.0 -! -!ALKE/WC_ASO3=0.0 -! -!ALKE/WC_ASO4=0.0 -! -!ALKE/WC_ASO5=0.0 -! -!ALKE/WC_AHSO5=0.0 -! -!ALKE/WC_AHMS=0.0 -! -!ALKE/WR_O3=0.0 -! -!ALKE/WR_H2O2=0.0 -! -!ALKE/WR_NO=0.0 -! -!ALKE/WR_NO2=0.0 -! -!ALKE/WR_NO3=0.0 -! -!ALKE/WR_N2O5=0.0 -! -!ALKE/WR_HONO=0.0 -! -!ALKE/WR_HNO3=0.0 -! -!ALKE/WR_HNO4=0.0 -! -!ALKE/WR_NH3=0.0 -! -!ALKE/WR_OH=0.0 -! -!ALKE/WR_HO2=0.0 -! -!ALKE/WR_CO2=0.0 -! -!ALKE/WR_SO2=0.0 -! -!ALKE/WR_SULF=0.0 -! -!ALKE/WR_HCHO=0.0 -! -!ALKE/WR_ORA1=0.0 -! -!ALKE/WR_ORA2=0.0 -! -!ALKE/WR_MO2=0.0 -! -!ALKE/WR_OP1=0.0 -! -!ALKE/WR_ASO3=0.0 -! -!ALKE/WR_ASO4=0.0 -! -!ALKE/WR_ASO5=0.0 -! -!ALKE/WR_AHSO5=0.0 -! -!ALKE/WR_AHMS=0.0 -! -RETURN -END SUBROUTINE SUBJ3 -! -SUBROUTINE SUBJ4 -! -!Indices 21 a 25 -! -! -!BIO/O3=-K080*<BIO> - PJAC(:,21,1)=-TPK%K080(:)*PCONC(:,21) -! -!BIO/H2O2=0.0 -! -!BIO/NO=0.0 -! -!BIO/NO2=0.0 -! -!BIO/NO3=-K077*<BIO> - PJAC(:,21,5)=-TPK%K077(:)*PCONC(:,21) -! -!BIO/N2O5=0.0 -! -!BIO/HONO=0.0 -! -!BIO/HNO3=0.0 -! -!BIO/HNO4=0.0 -! -!BIO/NH3=0.0 -! -!BIO/DMS=0.0 -! -!BIO/SO2=0.0 -! -!BIO/SULF=0.0 -! -!BIO/CO=0.0 -! -!BIO/OH=-K060*<BIO> - PJAC(:,21,15)=-TPK%K060(:)*PCONC(:,21) -! -!BIO/HO2=0.0 -! -!BIO/CH4=0.0 -! -!BIO/ETH=0.0 -! -!BIO/ALKA=0.0 -! -!BIO/ALKE=0.0 -! -!BIO/BIO=-K054*<O3P>-K060*<OH>-K077*<NO3>-K080*<O3> - PJAC(:,21,21)=-TPK%K054(:)*TPK%O3P(:)-TPK%K060(:)*PCONC(:,15)-TPK%K077(:)*PCON& -&C(:,5)-TPK%K080(:)*PCONC(:,1) -! -!BIO/ARO=0.0 -! -!BIO/HCHO=0.0 -! -!BIO/ALD=0.0 -! -!BIO/KET=0.0 -! -!BIO/CARBO=0.0 -! -!BIO/ONIT=0.0 -! -!BIO/PAN=0.0 -! -!BIO/OP1=0.0 -! -!BIO/OP2=0.0 -! -!BIO/ORA1=0.0 -! -!BIO/ORA2=0.0 -! -!BIO/MO2=0.0 -! -!BIO/ALKAP=0.0 -! -!BIO/ALKEP=0.0 -! -!BIO/BIOP=0.0 -! -!BIO/PHO=0.0 -! -!BIO/ADD=0.0 -! -!BIO/AROP=0.0 -! -!BIO/CARBOP=0.0 -! -!BIO/OLN=0.0 -! -!BIO/XO2=0.0 -! -!BIO/WC_O3=0.0 -! -!BIO/WC_H2O2=0.0 -! -!BIO/WC_NO=0.0 -! -!BIO/WC_NO2=0.0 -! -!BIO/WC_NO3=0.0 -! -!BIO/WC_N2O5=0.0 -! -!BIO/WC_HONO=0.0 -! -!BIO/WC_HNO3=0.0 -! -!BIO/WC_HNO4=0.0 -! -!BIO/WC_NH3=0.0 -! -!BIO/WC_OH=0.0 -! -!BIO/WC_HO2=0.0 -! -!BIO/WC_CO2=0.0 -! -!BIO/WC_SO2=0.0 -! -!BIO/WC_SULF=0.0 -! -!BIO/WC_HCHO=0.0 -! -!BIO/WC_ORA1=0.0 -! -!BIO/WC_ORA2=0.0 -! -!BIO/WC_MO2=0.0 -! -!BIO/WC_OP1=0.0 -! -!BIO/WC_ASO3=0.0 -! -!BIO/WC_ASO4=0.0 -! -!BIO/WC_ASO5=0.0 -! -!BIO/WC_AHSO5=0.0 -! -!BIO/WC_AHMS=0.0 -! -!BIO/WR_O3=0.0 -! -!BIO/WR_H2O2=0.0 -! -!BIO/WR_NO=0.0 -! -!BIO/WR_NO2=0.0 -! -!BIO/WR_NO3=0.0 -! -!BIO/WR_N2O5=0.0 -! -!BIO/WR_HONO=0.0 -! -!BIO/WR_HNO3=0.0 -! -!BIO/WR_HNO4=0.0 -! -!BIO/WR_NH3=0.0 -! -!BIO/WR_OH=0.0 -! -!BIO/WR_HO2=0.0 -! -!BIO/WR_CO2=0.0 -! -!BIO/WR_SO2=0.0 -! -!BIO/WR_SULF=0.0 -! -!BIO/WR_HCHO=0.0 -! -!BIO/WR_ORA1=0.0 -! -!BIO/WR_ORA2=0.0 -! -!BIO/WR_MO2=0.0 -! -!BIO/WR_OP1=0.0 -! -!BIO/WR_ASO3=0.0 -! -!BIO/WR_ASO4=0.0 -! -!BIO/WR_ASO5=0.0 -! -!BIO/WR_AHSO5=0.0 -! -!BIO/WR_AHMS=0.0 -! -!ARO/O3=+K087*<ADD> - PJAC(:,22,1)=+TPK%K087(:)*PCONC(:,38) -! -!ARO/H2O2=0.0 -! -!ARO/NO=0.0 -! -!ARO/NO2=+0.10670*K083*<PHO>+K085*<ADD> - PJAC(:,22,4)=+0.10670*TPK%K083(:)*PCONC(:,37)+TPK%K085(:)*PCONC(:,38) -! -!ARO/NO3=-K075*<ARO> - PJAC(:,22,5)=-TPK%K075(:)*PCONC(:,22) -! -!ARO/N2O5=0.0 -! -!ARO/HONO=0.0 -! -!ARO/HNO3=0.0 -! -!ARO/HNO4=0.0 -! -!ARO/NH3=0.0 -! -!ARO/DMS=0.0 -! -!ARO/SO2=0.0 -! -!ARO/SULF=0.0 -! -!ARO/CO=0.0 -! -!ARO/OH=-K061*<ARO> - PJAC(:,22,15)=-TPK%K061(:)*PCONC(:,22) -! -!ARO/HO2=+1.06698*K084*<PHO> - PJAC(:,22,16)=+1.06698*TPK%K084(:)*PCONC(:,37) -! -!ARO/CH4=0.0 -! -!ARO/ETH=0.0 -! -!ARO/ALKA=0.0 -! -!ARO/ALKE=0.0 -! -!ARO/BIO=0.0 -! -!ARO/ARO=-K061*<OH>-K075*<NO3> - PJAC(:,22,22)=-TPK%K061(:)*PCONC(:,15)-TPK%K075(:)*PCONC(:,5) -! -!ARO/HCHO=0.0 -! -!ARO/ALD=0.0 -! -!ARO/KET=0.0 -! -!ARO/CARBO=0.0 -! -!ARO/ONIT=0.0 -! -!ARO/PAN=0.0 -! -!ARO/OP1=0.0 -! -!ARO/OP2=0.0 -! -!ARO/ORA1=0.0 -! -!ARO/ORA2=0.0 -! -!ARO/MO2=0.0 -! -!ARO/ALKAP=0.0 -! -!ARO/ALKEP=0.0 -! -!ARO/BIOP=0.0 -! -!ARO/PHO=+0.10670*K083*<NO2>+1.06698*K084*<HO2> - PJAC(:,22,37)=+0.10670*TPK%K083(:)*PCONC(:,4)+1.06698*TPK%K084(:)*PCONC(:,16) -! -!ARO/ADD=+K085*<NO2>+0.02*K086*<O2>+K087*<O3> - PJAC(:,22,38)=+TPK%K085(:)*PCONC(:,4)+0.02*TPK%K086(:)*TPK%O2(:)+TPK%K087(:)*P& -&CONC(:,1) -! -!ARO/AROP=0.0 -! -!ARO/CARBOP=0.0 -! -!ARO/OLN=0.0 -! -!ARO/XO2=0.0 -! -!ARO/WC_O3=0.0 -! -!ARO/WC_H2O2=0.0 -! -!ARO/WC_NO=0.0 -! -!ARO/WC_NO2=0.0 -! -!ARO/WC_NO3=0.0 -! -!ARO/WC_N2O5=0.0 -! -!ARO/WC_HONO=0.0 -! -!ARO/WC_HNO3=0.0 -! -!ARO/WC_HNO4=0.0 -! -!ARO/WC_NH3=0.0 -! -!ARO/WC_OH=0.0 -! -!ARO/WC_HO2=0.0 -! -!ARO/WC_CO2=0.0 -! -!ARO/WC_SO2=0.0 -! -!ARO/WC_SULF=0.0 -! -!ARO/WC_HCHO=0.0 -! -!ARO/WC_ORA1=0.0 -! -!ARO/WC_ORA2=0.0 -! -!ARO/WC_MO2=0.0 -! -!ARO/WC_OP1=0.0 -! -!ARO/WC_ASO3=0.0 -! -!ARO/WC_ASO4=0.0 -! -!ARO/WC_ASO5=0.0 -! -!ARO/WC_AHSO5=0.0 -! -!ARO/WC_AHMS=0.0 -! -!ARO/WR_O3=0.0 -! -!ARO/WR_H2O2=0.0 -! -!ARO/WR_NO=0.0 -! -!ARO/WR_NO2=0.0 -! -!ARO/WR_NO3=0.0 -! -!ARO/WR_N2O5=0.0 -! -!ARO/WR_HONO=0.0 -! -!ARO/WR_HNO3=0.0 -! -!ARO/WR_HNO4=0.0 -! -!ARO/WR_NH3=0.0 -! -!ARO/WR_OH=0.0 -! -!ARO/WR_HO2=0.0 -! -!ARO/WR_CO2=0.0 -! -!ARO/WR_SO2=0.0 -! -!ARO/WR_SULF=0.0 -! -!ARO/WR_HCHO=0.0 -! -!ARO/WR_ORA1=0.0 -! -!ARO/WR_ORA2=0.0 -! -!ARO/WR_MO2=0.0 -! -!ARO/WR_OP1=0.0 -! -!ARO/WR_ASO3=0.0 -! -!ARO/WR_ASO4=0.0 -! -!ARO/WR_ASO5=0.0 -! -!ARO/WR_AHSO5=0.0 -! -!ARO/WR_AHMS=0.0 -! -!HCHO/O3=+0.48290*K079*<ALKE>+0.90000*K080*<BIO>+0.00000*K081*<CARBO>+0.70*K082 -!*<PAN> - PJAC(:,23,1)=+0.48290*TPK%K079(:)*PCONC(:,20)+0.90000*TPK%K080(:)*PCONC(:,21)+& -&0.00000*TPK%K081(:)*PCONC(:,26)+0.70*TPK%K082(:)*PCONC(:,28) -! -!HCHO/H2O2=0.0 -! -!HCHO/NO=+K090*<MO2>+0.03002*K091*<ALKAP>+1.39870*K092*<ALKEP>+0.60600*K093*<BI -!OP>+0.05848*K095*<CARBOP>+0.23419*K096*<OLN> - PJAC(:,23,3)=+TPK%K090(:)*PCONC(:,33)+0.03002*TPK%K091(:)*PCONC(:,34)+1.39870*& -&TPK%K092(:)*PCONC(:,35)+0.60600*TPK%K093(:)*PCONC(:,36)+0.05848*TPK%K095(:)*PC& -&ONC(:,40)+0.23419*TPK%K096(:)*PCONC(:,41) -! -!HCHO/NO2=0.0 -! -!HCHO/NO3=-K072*<HCHO>+0.40*K078*<PAN>+K119*<MO2>+0.03142*K120*<ALKAP>+1.40909* -!K121*<ALKEP>+0.68600*K122*<BIOP>+0.03175*K124*<CARBOP>+0.20740*K125*<OLN> - PJAC(:,23,5)=-TPK%K072(:)*PCONC(:,23)+0.40*TPK%K078(:)*PCONC(:,28)+TPK%K119(:)& -&*PCONC(:,33)+0.03142*TPK%K120(:)*PCONC(:,34)+1.40909*TPK%K121(:)*PCONC(:,35)+0& -&.68600*TPK%K122(:)*PCONC(:,36)+0.03175*TPK%K124(:)*PCONC(:,40)+0.20740*TPK%K12& -&5(:)*PCONC(:,41) -! -!HCHO/N2O5=0.0 -! -!HCHO/HONO=0.0 -! -!HCHO/HNO3=0.0 -! -!HCHO/HNO4=0.0 -! -!HCHO/NH3=0.0 -! -!HCHO/DMS=0.0 -! -!HCHO/SO2=0.0 -! -!HCHO/SULF=0.0 -! -!HCHO/CO=0.0 -! -!HCHO/OH=+0.00140*K058*<ALKA>-K062*<HCHO>+0.00000*K065*<CARBO>+0.35*K068*<OP1>+ -!0.02915*K069*<OP2>+0.57839*K070*<PAN> - PJAC(:,23,15)=+0.00140*TPK%K058(:)*PCONC(:,19)-TPK%K062(:)*PCONC(:,23)+0.00000& -&*TPK%K065(:)*PCONC(:,26)+0.35*TPK%K068(:)*PCONC(:,29)+0.02915*TPK%K069(:)*PCON& -&C(:,30)+0.57839*TPK%K070(:)*PCONC(:,28) -! -!HCHO/HO2=0.0 -! -!HCHO/CH4=0.0 -! -!HCHO/ETH=0.0 -! -!HCHO/ALKA=+0.00140*K058*<OH> - PJAC(:,23,19)=+0.00140*TPK%K058(:)*PCONC(:,15) -! -!HCHO/ALKE=+0.48290*K079*<O3> - PJAC(:,23,20)=+0.48290*TPK%K079(:)*PCONC(:,1) -! -!HCHO/BIO=+0.05*K054*<O3P>+0.90000*K080*<O3> - PJAC(:,23,21)=+0.05*TPK%K054(:)*TPK%O3P(:)+0.90000*TPK%K080(:)*PCONC(:,1) -! -!HCHO/ARO=0.0 -! -!HCHO/HCHO=-K010-K011-K062*<OH>-K072*<NO3>-KTC16-KTR16 - PJAC(:,23,23)=-TPK%K010(:)-TPK%K011(:)-TPK%K062(:)*PCONC(:,15)-TPK%K072(:)*PCO& -&NC(:,5)-TPK%KTC16(:)-TPK%KTR16(:) -! -!HCHO/ALD=0.0 -! -!HCHO/KET=0.0 -! -!HCHO/CARBO=+0.06517*K016+0.00000*K065*<OH>+0.00000*K081*<O3> - PJAC(:,23,26)=+0.06517*TPK%K016(:)+0.00000*TPK%K065(:)*PCONC(:,15)+0.00000*TPK& -&%K081(:)*PCONC(:,1) -! -!HCHO/ONIT=0.0 -! -!HCHO/PAN=+0.57839*K070*<OH>+0.40*K078*<NO3>+0.70*K082*<O3> - PJAC(:,23,28)=+0.57839*TPK%K070(:)*PCONC(:,15)+0.40*TPK%K078(:)*PCONC(:,5)+0.7& -&0*TPK%K082(:)*PCONC(:,1) -! -!HCHO/OP1=+K013+0.35*K068*<OH> - PJAC(:,23,29)=+TPK%K013(:)+0.35*TPK%K068(:)*PCONC(:,15) -! -!HCHO/OP2=+0.02915*K069*<OH> - PJAC(:,23,30)=+0.02915*TPK%K069(:)*PCONC(:,15) -! -!HCHO/ORA1=0.0 -! -!HCHO/ORA2=0.0 -! -!HCHO/MO2=+K090*<NO>+1.33*K104*<MO2>+1.33*K104*<MO2>+0.80556*K105*<ALKAP>+1.428 -!94*K106*<ALKEP>+1.09000*K107*<BIOP>+K108*<AROP>+0.95723*K109*<CARBOP>+0.88625* -!K110*<OLN>+K119*<NO3>+K127*<XO2> - PJAC(:,23,33)=+TPK%K090(:)*PCONC(:,3)+1.33*TPK%K104(:)*PCONC(:,33)+1.33*TPK%K1& -&04(:)*PCONC(:,33)+0.80556*TPK%K105(:)*PCONC(:,34)+1.42894*TPK%K106(:)*PCONC(:,& -&35)+1.09000*TPK%K107(:)*PCONC(:,36)+TPK%K108(:)*PCONC(:,39)+0.95723*TPK%K109(:& -&)*PCONC(:,40)+0.88625*TPK%K110(:)*PCONC(:,41)+TPK%K119(:)*PCONC(:,5)+TPK%K127(& -&:)*PCONC(:,42) -! -!HCHO/ALKAP=+0.03002*K091*<NO>+0.80556*K105*<MO2>+0.07600*K111*<CARBOP>+0.03142 -!*K120*<NO3> - PJAC(:,23,34)=+0.03002*TPK%K091(:)*PCONC(:,3)+0.80556*TPK%K105(:)*PCONC(:,33)+& -&0.07600*TPK%K111(:)*PCONC(:,40)+0.03142*TPK%K120(:)*PCONC(:,5) -! -!HCHO/ALKEP=+1.39870*K092*<NO>+1.42894*K106*<MO2>+0.68192*K112*<CARBOP>+1.40909 -!*K121*<NO3> - PJAC(:,23,35)=+1.39870*TPK%K092(:)*PCONC(:,3)+1.42894*TPK%K106(:)*PCONC(:,33)+& -&0.68192*TPK%K112(:)*PCONC(:,40)+1.40909*TPK%K121(:)*PCONC(:,5) -! -!HCHO/BIOP=+0.60600*K093*<NO>+1.09000*K107*<MO2>+0.34000*K113*<CARBOP>+0.68600* -!K122*<NO3> - PJAC(:,23,36)=+0.60600*TPK%K093(:)*PCONC(:,3)+1.09000*TPK%K107(:)*PCONC(:,33)+& -&0.34000*TPK%K113(:)*PCONC(:,40)+0.68600*TPK%K122(:)*PCONC(:,5) -! -!HCHO/PHO=0.0 -! -!HCHO/ADD=0.0 -! -!HCHO/AROP=+K108*<MO2> - PJAC(:,23,39)=+TPK%K108(:)*PCONC(:,33) -! -!HCHO/CARBOP=+0.05848*K095*<NO>+0.95723*K109*<MO2>+0.07600*K111*<ALKAP>+0.68192 -!*K112*<ALKEP>+0.34000*K113*<BIOP>+0.03432*K115*<CARBOP>+0.03432*K115*<CARBOP>+ -!0.13414*K116*<OLN>+0.03175*K124*<NO3> - PJAC(:,23,40)=+0.05848*TPK%K095(:)*PCONC(:,3)+0.95723*TPK%K109(:)*PCONC(:,33)+& -&0.07600*TPK%K111(:)*PCONC(:,34)+0.68192*TPK%K112(:)*PCONC(:,35)+0.34000*TPK%K1& -&13(:)*PCONC(:,36)+0.03432*TPK%K115(:)*PCONC(:,40)+0.03432*TPK%K115(:)*PCONC(:,& -&40)+0.13414*TPK%K116(:)*PCONC(:,41)+0.03175*TPK%K124(:)*PCONC(:,5) -! -!HCHO/OLN=+0.23419*K096*<NO>+0.88625*K110*<MO2>+0.13414*K116*<CARBOP>+0.00000*K -!118*<OLN>+0.00000*K118*<OLN>+0.20740*K125*<NO3> - PJAC(:,23,41)=+0.23419*TPK%K096(:)*PCONC(:,3)+0.88625*TPK%K110(:)*PCONC(:,33)+& -&0.13414*TPK%K116(:)*PCONC(:,40)+0.00000*TPK%K118(:)*PCONC(:,41)+0.00000*TPK%K1& -&18(:)*PCONC(:,41)+0.20740*TPK%K125(:)*PCONC(:,5) -! -!HCHO/XO2=+K127*<MO2> - PJAC(:,23,42)=+TPK%K127(:)*PCONC(:,33) -! -!HCHO/WC_O3=0.0 -! -!HCHO/WC_H2O2=0.0 -! -!HCHO/WC_NO=0.0 -! -!HCHO/WC_NO2=0.0 -! -!HCHO/WC_NO3=0.0 -! -!HCHO/WC_N2O5=0.0 -! -!HCHO/WC_HONO=0.0 -! -!HCHO/WC_HNO3=0.0 -! -!HCHO/WC_HNO4=0.0 -! -!HCHO/WC_NH3=0.0 -! -!HCHO/WC_OH=0.0 -! -!HCHO/WC_HO2=0.0 -! -!HCHO/WC_CO2=0.0 -! -!HCHO/WC_SO2=0.0 -! -!HCHO/WC_SULF=0.0 -! -!HCHO/WC_HCHO=+KTC36 - PJAC(:,23,58)=+TPK%KTC36(:) -! -!HCHO/WC_ORA1=0.0 -! -!HCHO/WC_ORA2=0.0 -! -!HCHO/WC_MO2=0.0 -! -!HCHO/WC_OP1=0.0 -! -!HCHO/WC_ASO3=0.0 -! -!HCHO/WC_ASO4=0.0 -! -!HCHO/WC_ASO5=0.0 -! -!HCHO/WC_AHSO5=0.0 -! -!HCHO/WC_AHMS=0.0 -! -!HCHO/WR_O3=0.0 -! -!HCHO/WR_H2O2=0.0 -! -!HCHO/WR_NO=0.0 -! -!HCHO/WR_NO2=0.0 -! -!HCHO/WR_NO3=0.0 -! -!HCHO/WR_N2O5=0.0 -! -!HCHO/WR_HONO=0.0 -! -!HCHO/WR_HNO3=0.0 -! -!HCHO/WR_HNO4=0.0 -! -!HCHO/WR_NH3=0.0 -! -!HCHO/WR_OH=0.0 -! -!HCHO/WR_HO2=0.0 -! -!HCHO/WR_CO2=0.0 -! -!HCHO/WR_SO2=0.0 -! -!HCHO/WR_SULF=0.0 -! -!HCHO/WR_HCHO=+KTR36 - PJAC(:,23,83)=+TPK%KTR36(:) -! -!HCHO/WR_ORA1=0.0 -! -!HCHO/WR_ORA2=0.0 -! -!HCHO/WR_MO2=0.0 -! -!HCHO/WR_OP1=0.0 -! -!HCHO/WR_ASO3=0.0 -! -!HCHO/WR_ASO4=0.0 -! -!HCHO/WR_ASO5=0.0 -! -!HCHO/WR_AHSO5=0.0 -! -!HCHO/WR_AHMS=0.0 -! -!ALD/O3=+0.51468*K079*<ALKE>+0.00000*K080*<BIO>+0.15692*K081*<CARBO> - PJAC(:,24,1)=+0.51468*TPK%K079(:)*PCONC(:,20)+0.00000*TPK%K080(:)*PCONC(:,21)+& -&0.15692*TPK%K081(:)*PCONC(:,26) -! -!ALD/H2O2=0.0 -! -!ALD/NO=+0.33144*K091*<ALKAP>+0.42125*K092*<ALKEP>+0.00000*K093*<BIOP>+0.07368* -!K095*<CARBOP>+1.01182*K096*<OLN> - PJAC(:,24,3)=+0.33144*TPK%K091(:)*PCONC(:,34)+0.42125*TPK%K092(:)*PCONC(:,35)+& -&0.00000*TPK%K093(:)*PCONC(:,36)+0.07368*TPK%K095(:)*PCONC(:,40)+1.01182*TPK%K0& -&96(:)*PCONC(:,41) -! -!ALD/NO2=0.0 -! -!ALD/NO3=-K073*<ALD>+0.05265*K074*<CARBO>+0.33743*K120*<ALKAP>+0.43039*K121*<AL -!KEP>+0.00000*K122*<BIOP>+0.02936*K124*<CARBOP>+0.91850*K125*<OLN> - PJAC(:,24,5)=-TPK%K073(:)*PCONC(:,24)+0.05265*TPK%K074(:)*PCONC(:,26)+0.33743*& -&TPK%K120(:)*PCONC(:,34)+0.43039*TPK%K121(:)*PCONC(:,35)+0.00000*TPK%K122(:)*PC& -&ONC(:,36)+0.02936*TPK%K124(:)*PCONC(:,40)+0.91850*TPK%K125(:)*PCONC(:,41) -! -!ALD/N2O5=0.0 -! -!ALD/HONO=0.0 -! -!ALD/HNO3=0.0 -! -!ALD/HNO4=0.0 -! -!ALD/NH3=0.0 -! -!ALD/DMS=0.0 -! -!ALD/SO2=0.0 -! -!ALD/SULF=0.0 -! -!ALD/CO=0.0 -! -!ALD/OH=+0.08173*K058*<ALKA>-K063*<ALD>+0.06253*K065*<CARBO>+0.07335*K069*<OP2> - PJAC(:,24,15)=+0.08173*TPK%K058(:)*PCONC(:,19)-TPK%K063(:)*PCONC(:,24)+0.06253& -&*TPK%K065(:)*PCONC(:,26)+0.07335*TPK%K069(:)*PCONC(:,30) -! -!ALD/HO2=0.0 -! -!ALD/CH4=0.0 -! -!ALD/ETH=0.0 -! -!ALD/ALKA=+0.08173*K058*<OH> - PJAC(:,24,19)=+0.08173*TPK%K058(:)*PCONC(:,15) -! -!ALD/ALKE=+0.51468*K079*<O3> - PJAC(:,24,20)=+0.51468*TPK%K079(:)*PCONC(:,1) -! -!ALD/BIO=+0.00000*K080*<O3> - PJAC(:,24,21)=+0.00000*TPK%K080(:)*PCONC(:,1) -! -!ALD/ARO=0.0 -! -!ALD/HCHO=0.0 -! -!ALD/ALD=-K012-K063*<OH>-K073*<NO3> - PJAC(:,24,24)=-TPK%K012(:)-TPK%K063(:)*PCONC(:,15)-TPK%K073(:)*PCONC(:,5) -! -!ALD/KET=0.0 -! -!ALD/CARBO=+K055*<O3P>+0.06253*K065*<OH>+0.05265*K074*<NO3>+0.15692*K081*<O3> - PJAC(:,24,26)=+TPK%K055(:)*TPK%O3P(:)+0.06253*TPK%K065(:)*PCONC(:,15)+0.05265*& -&TPK%K074(:)*PCONC(:,5)+0.15692*TPK%K081(:)*PCONC(:,1) -! -!ALD/ONIT=+0.20*K017 - PJAC(:,24,27)=+0.20*TPK%K017(:) -! -!ALD/PAN=0.0 -! -!ALD/OP1=0.0 -! -!ALD/OP2=+0.96205*K014+0.07335*K069*<OH> - PJAC(:,24,30)=+0.96205*TPK%K014(:)+0.07335*TPK%K069(:)*PCONC(:,15) -! -!ALD/ORA1=0.0 -! -!ALD/ORA2=0.0 -! -!ALD/MO2=+0.56070*K105*<ALKAP>+0.46413*K106*<ALKEP>+0.00000*K107*<BIOP>+0.08295 -!*K109*<CARBOP>+0.41524*K110*<OLN> - PJAC(:,24,33)=+0.56070*TPK%K105(:)*PCONC(:,34)+0.46413*TPK%K106(:)*PCONC(:,35)& -&+0.00000*TPK%K107(:)*PCONC(:,36)+0.08295*TPK%K109(:)*PCONC(:,40)+0.41524*TPK%K& -&110(:)*PCONC(:,41) -! -!ALD/ALKAP=+0.33144*K091*<NO>+0.56070*K105*<MO2>+0.71461*K111*<CARBOP>+0.33743* -!K120*<NO3> - PJAC(:,24,34)=+0.33144*TPK%K091(:)*PCONC(:,3)+0.56070*TPK%K105(:)*PCONC(:,33)+& -&0.71461*TPK%K111(:)*PCONC(:,40)+0.33743*TPK%K120(:)*PCONC(:,5) -! -!ALD/ALKEP=+0.42125*K092*<NO>+0.46413*K106*<MO2>+0.68374*K112*<CARBOP>+0.43039* -!K121*<NO3> - PJAC(:,24,35)=+0.42125*TPK%K092(:)*PCONC(:,3)+0.46413*TPK%K106(:)*PCONC(:,33)+& -&0.68374*TPK%K112(:)*PCONC(:,40)+0.43039*TPK%K121(:)*PCONC(:,5) -! -!ALD/BIOP=+0.00000*K093*<NO>+0.00000*K107*<MO2>+0.00000*K113*<CARBOP>+0.00000*K -!122*<NO3> - PJAC(:,24,36)=+0.00000*TPK%K093(:)*PCONC(:,3)+0.00000*TPK%K107(:)*PCONC(:,33)+& -&0.00000*TPK%K113(:)*PCONC(:,40)+0.00000*TPK%K122(:)*PCONC(:,5) -! -!ALD/PHO=0.0 -! -!ALD/ADD=0.0 -! -!ALD/AROP=0.0 -! -!ALD/CARBOP=+0.07368*K095*<NO>+0.08295*K109*<MO2>+0.71461*K111*<ALKAP>+0.68374* -!K112*<ALKEP>+0.00000*K113*<BIOP>+0.06969*K115*<CARBOP>+0.06969*K115*<CARBOP>+0 -!.42122*K116*<OLN>+0.02936*K124*<NO3> - PJAC(:,24,40)=+0.07368*TPK%K095(:)*PCONC(:,3)+0.08295*TPK%K109(:)*PCONC(:,33)+& -&0.71461*TPK%K111(:)*PCONC(:,34)+0.68374*TPK%K112(:)*PCONC(:,35)+0.00000*TPK%K1& -&13(:)*PCONC(:,36)+0.06969*TPK%K115(:)*PCONC(:,40)+0.06969*TPK%K115(:)*PCONC(:,& -&40)+0.42122*TPK%K116(:)*PCONC(:,41)+0.02936*TPK%K124(:)*PCONC(:,5) -! -!ALD/OLN=+1.01182*K096*<NO>+0.41524*K110*<MO2>+0.42122*K116*<CARBOP>+0.00000*K1 -!18*<OLN>+0.00000*K118*<OLN>+0.91850*K125*<NO3> - PJAC(:,24,41)=+1.01182*TPK%K096(:)*PCONC(:,3)+0.41524*TPK%K110(:)*PCONC(:,33)+& -&0.42122*TPK%K116(:)*PCONC(:,40)+0.00000*TPK%K118(:)*PCONC(:,41)+0.00000*TPK%K1& -&18(:)*PCONC(:,41)+0.91850*TPK%K125(:)*PCONC(:,5) -! -!ALD/XO2=0.0 -! -!ALD/WC_O3=0.0 -! -!ALD/WC_H2O2=0.0 -! -!ALD/WC_NO=0.0 -! -!ALD/WC_NO2=0.0 -! -!ALD/WC_NO3=0.0 -! -!ALD/WC_N2O5=0.0 -! -!ALD/WC_HONO=0.0 -! -!ALD/WC_HNO3=0.0 -! -!ALD/WC_HNO4=0.0 -! -!ALD/WC_NH3=0.0 -! -!ALD/WC_OH=0.0 -! -!ALD/WC_HO2=0.0 -! -!ALD/WC_CO2=0.0 -! -!ALD/WC_SO2=0.0 -! -!ALD/WC_SULF=0.0 -! -!ALD/WC_HCHO=0.0 -! -!ALD/WC_ORA1=0.0 -! -!ALD/WC_ORA2=0.0 -! -!ALD/WC_MO2=0.0 -! -!ALD/WC_OP1=0.0 -! -!ALD/WC_ASO3=0.0 -! -!ALD/WC_ASO4=0.0 -! -!ALD/WC_ASO5=0.0 -! -!ALD/WC_AHSO5=0.0 -! -!ALD/WC_AHMS=0.0 -! -!ALD/WR_O3=0.0 -! -!ALD/WR_H2O2=0.0 -! -!ALD/WR_NO=0.0 -! -!ALD/WR_NO2=0.0 -! -!ALD/WR_NO3=0.0 -! -!ALD/WR_N2O5=0.0 -! -!ALD/WR_HONO=0.0 -! -!ALD/WR_HNO3=0.0 -! -!ALD/WR_HNO4=0.0 -! -!ALD/WR_NH3=0.0 -! -!ALD/WR_OH=0.0 -! -!ALD/WR_HO2=0.0 -! -!ALD/WR_CO2=0.0 -! -!ALD/WR_SO2=0.0 -! -!ALD/WR_SULF=0.0 -! -!ALD/WR_HCHO=0.0 -! -!ALD/WR_ORA1=0.0 -! -!ALD/WR_ORA2=0.0 -! -!ALD/WR_MO2=0.0 -! -!ALD/WR_OP1=0.0 -! -!ALD/WR_ASO3=0.0 -! -!ALD/WR_ASO4=0.0 -! -!ALD/WR_ASO5=0.0 -! -!ALD/WR_AHSO5=0.0 -! -!ALD/WR_AHMS=0.0 -! -!KET/O3=+0.07377*K079*<ALKE>+0.00000*K080*<BIO> - PJAC(:,25,1)=+0.07377*TPK%K079(:)*PCONC(:,20)+0.00000*TPK%K080(:)*PCONC(:,21) -! -!KET/H2O2=0.0 -! -!KET/NO=+0.54531*K091*<ALKAP>+0.05220*K092*<ALKEP>+0.00000*K093*<BIOP>+0.37862* -!K096*<OLN> - PJAC(:,25,3)=+0.54531*TPK%K091(:)*PCONC(:,34)+0.05220*TPK%K092(:)*PCONC(:,35)+& -&0.00000*TPK%K093(:)*PCONC(:,36)+0.37862*TPK%K096(:)*PCONC(:,41) -! -!KET/NO2=0.0 -! -!KET/NO3=+0.00632*K074*<CARBO>+0.62978*K120*<ALKAP>+0.02051*K121*<ALKEP>+0.0000 -!0*K122*<BIOP>+0.34740*K125*<OLN> - PJAC(:,25,5)=+0.00632*TPK%K074(:)*PCONC(:,26)+0.62978*TPK%K120(:)*PCONC(:,34)+& -&0.02051*TPK%K121(:)*PCONC(:,35)+0.00000*TPK%K122(:)*PCONC(:,36)+0.34740*TPK%K1& -&25(:)*PCONC(:,41) -! -!KET/N2O5=0.0 -! -!KET/HONO=0.0 -! -!KET/HNO3=0.0 -! -!KET/HNO4=0.0 -! -!KET/NH3=0.0 -! -!KET/DMS=0.0 -! -!KET/SO2=0.0 -! -!KET/SULF=0.0 -! -!KET/CO=0.0 -! -!KET/OH=+0.03498*K058*<ALKA>-K064*<KET>+0.00853*K065*<CARBO>+0.37591*K069*<OP2> - PJAC(:,25,15)=+0.03498*TPK%K058(:)*PCONC(:,19)-TPK%K064(:)*PCONC(:,25)+0.00853& -&*TPK%K065(:)*PCONC(:,26)+0.37591*TPK%K069(:)*PCONC(:,30) -! -!KET/HO2=0.0 -! -!KET/CH4=0.0 -! -!KET/ETH=0.0 -! -!KET/ALKA=+0.03498*K058*<OH> - PJAC(:,25,19)=+0.03498*TPK%K058(:)*PCONC(:,15) -! -!KET/ALKE=+0.07377*K079*<O3> - PJAC(:,25,20)=+0.07377*TPK%K079(:)*PCONC(:,1) -! -!KET/BIO=+0.00000*K080*<O3> - PJAC(:,25,21)=+0.00000*TPK%K080(:)*PCONC(:,1) -! -!KET/ARO=0.0 -! -!KET/HCHO=0.0 -! -!KET/ALD=0.0 -! -!KET/KET=-K015-K064*<OH> - PJAC(:,25,25)=-TPK%K015(:)-TPK%K064(:)*PCONC(:,15) -! -!KET/CARBO=+0.00853*K065*<OH>+0.00632*K074*<NO3> - PJAC(:,25,26)=+0.00853*TPK%K065(:)*PCONC(:,15)+0.00632*TPK%K074(:)*PCONC(:,5) -! -!KET/ONIT=+0.80*K017 - PJAC(:,25,27)=+0.80*TPK%K017(:) -! -!KET/PAN=0.0 -! -!KET/OP1=0.0 -! -!KET/OP2=+0.37591*K069*<OH> - PJAC(:,25,30)=+0.37591*TPK%K069(:)*PCONC(:,15) -! -!KET/ORA1=0.0 -! -!KET/ORA2=0.0 -! -!KET/MO2=+0.09673*K105*<ALKAP>+0.03814*K106*<ALKEP>+0.00000*K107*<BIOP>+0.09667 -!*K110*<OLN> - PJAC(:,25,33)=+0.09673*TPK%K105(:)*PCONC(:,34)+0.03814*TPK%K106(:)*PCONC(:,35)& -&+0.00000*TPK%K107(:)*PCONC(:,36)+0.09667*TPK%K110(:)*PCONC(:,41) -! -!KET/ALKAP=+0.54531*K091*<NO>+0.09673*K105*<MO2>+0.18819*K111*<CARBOP>+0.62978* -!K120*<NO3> - PJAC(:,25,34)=+0.54531*TPK%K091(:)*PCONC(:,3)+0.09673*TPK%K105(:)*PCONC(:,33)+& -&0.18819*TPK%K111(:)*PCONC(:,40)+0.62978*TPK%K120(:)*PCONC(:,5) -! -!KET/ALKEP=+0.05220*K092*<NO>+0.03814*K106*<MO2>+0.06579*K112*<CARBOP>+0.02051* -!K121*<NO3> - PJAC(:,25,35)=+0.05220*TPK%K092(:)*PCONC(:,3)+0.03814*TPK%K106(:)*PCONC(:,33)+& -&0.06579*TPK%K112(:)*PCONC(:,40)+0.02051*TPK%K121(:)*PCONC(:,5) -! -!KET/BIOP=+0.00000*K093*<NO>+0.00000*K107*<MO2>+0.00000*K113*<CARBOP>+0.00000*K -!122*<NO3> - PJAC(:,25,36)=+0.00000*TPK%K093(:)*PCONC(:,3)+0.00000*TPK%K107(:)*PCONC(:,33)+& -&0.00000*TPK%K113(:)*PCONC(:,40)+0.00000*TPK%K122(:)*PCONC(:,5) -! -!KET/PHO=0.0 -! -!KET/ADD=0.0 -! -!KET/AROP=0.0 -! -!KET/CARBOP=+0.18819*K111*<ALKAP>+0.06579*K112*<ALKEP>+0.00000*K113*<BIOP>+0.02 -!190*K115*<CARBOP>+0.02190*K115*<CARBOP>+0.10822*K116*<OLN> - PJAC(:,25,40)=+0.18819*TPK%K111(:)*PCONC(:,34)+0.06579*TPK%K112(:)*PCONC(:,35)& -&+0.00000*TPK%K113(:)*PCONC(:,36)+0.02190*TPK%K115(:)*PCONC(:,40)+0.02190*TPK%K& -&115(:)*PCONC(:,40)+0.10822*TPK%K116(:)*PCONC(:,41) -! -!KET/OLN=+0.37862*K096*<NO>+0.09667*K110*<MO2>+0.10822*K116*<CARBOP>+0.00000*K1 -!18*<OLN>+0.00000*K118*<OLN>+0.34740*K125*<NO3> - PJAC(:,25,41)=+0.37862*TPK%K096(:)*PCONC(:,3)+0.09667*TPK%K110(:)*PCONC(:,33)+& -&0.10822*TPK%K116(:)*PCONC(:,40)+0.00000*TPK%K118(:)*PCONC(:,41)+0.00000*TPK%K1& -&18(:)*PCONC(:,41)+0.34740*TPK%K125(:)*PCONC(:,5) -! -!KET/XO2=0.0 -! -!KET/WC_O3=0.0 -! -!KET/WC_H2O2=0.0 -! -!KET/WC_NO=0.0 -! -!KET/WC_NO2=0.0 -! -!KET/WC_NO3=0.0 -! -!KET/WC_N2O5=0.0 -! -!KET/WC_HONO=0.0 -! -!KET/WC_HNO3=0.0 -! -!KET/WC_HNO4=0.0 -! -!KET/WC_NH3=0.0 -! -!KET/WC_OH=0.0 -! -!KET/WC_HO2=0.0 -! -!KET/WC_CO2=0.0 -! -!KET/WC_SO2=0.0 -! -!KET/WC_SULF=0.0 -! -!KET/WC_HCHO=0.0 -! -!KET/WC_ORA1=0.0 -! -!KET/WC_ORA2=0.0 -! -!KET/WC_MO2=0.0 -! -!KET/WC_OP1=0.0 -! -!KET/WC_ASO3=0.0 -! -!KET/WC_ASO4=0.0 -! -!KET/WC_ASO5=0.0 -! -!KET/WC_AHSO5=0.0 -! -!KET/WC_AHMS=0.0 -! -!KET/WR_O3=0.0 -! -!KET/WR_H2O2=0.0 -! -!KET/WR_NO=0.0 -! -!KET/WR_NO2=0.0 -! -!KET/WR_NO3=0.0 -! -!KET/WR_N2O5=0.0 -! -!KET/WR_HONO=0.0 -! -!KET/WR_HNO3=0.0 -! -!KET/WR_HNO4=0.0 -! -!KET/WR_NH3=0.0 -! -!KET/WR_OH=0.0 -! -!KET/WR_HO2=0.0 -! -!KET/WR_CO2=0.0 -! -!KET/WR_SO2=0.0 -! -!KET/WR_SULF=0.0 -! -!KET/WR_HCHO=0.0 -! -!KET/WR_ORA1=0.0 -! -!KET/WR_ORA2=0.0 -! -!KET/WR_MO2=0.0 -! -!KET/WR_OP1=0.0 -! -!KET/WR_ASO3=0.0 -! -!KET/WR_ASO4=0.0 -! -!KET/WR_ASO5=0.0 -! -!KET/WR_AHSO5=0.0 -! -!KET/WR_AHMS=0.0 -! -RETURN -END SUBROUTINE SUBJ4 -! -SUBROUTINE SUBJ5 -! -!Indices 26 a 30 -! -! -!CARBO/O3=+0.00000*K079*<ALKE>+0.39754*K080*<BIO>+1.07583*K081*<CARBO>-K081*<CA -!RBO> - PJAC(:,26,1)=+0.00000*TPK%K079(:)*PCONC(:,20)+0.39754*TPK%K080(:)*PCONC(:,21)+& -&1.07583*TPK%K081(:)*PCONC(:,26)-TPK%K081(:)*PCONC(:,26) -! -!CARBO/H2O2=0.0 -! -!CARBO/NO=+0.03407*K091*<ALKAP>+0.45463*K093*<BIOP>+2.06993*K094*<AROP>+0.08670 -!*K095*<CARBOP> - PJAC(:,26,3)=+0.03407*TPK%K091(:)*PCONC(:,34)+0.45463*TPK%K093(:)*PCONC(:,36)+& -&2.06993*TPK%K094(:)*PCONC(:,39)+0.08670*TPK%K095(:)*PCONC(:,40) -! -!CARBO/NO2=0.0 -! -!CARBO/NO3=+0.10530*K074*<CARBO>-K074*<CARBO>+0.00000*K076*<ALKE>+0.91741*K077* -!<BIO>+0.03531*K120*<ALKAP>+0.61160*K122*<BIOP>+2.81904*K123*<AROP>+0.03455*K12 -!4*<CARBOP> - PJAC(:,26,5)=+0.10530*TPK%K074(:)*PCONC(:,26)-TPK%K074(:)*PCONC(:,26)+0.00000*& -&TPK%K076(:)*PCONC(:,20)+0.91741*TPK%K077(:)*PCONC(:,21)+0.03531*TPK%K120(:)*PC& -&ONC(:,34)+0.61160*TPK%K122(:)*PCONC(:,36)+2.81904*TPK%K123(:)*PCONC(:,39)+0.03& -&455*TPK%K124(:)*PCONC(:,40) -! -!CARBO/N2O5=0.0 -! -!CARBO/HONO=0.0 -! -!CARBO/HNO3=0.0 -! -!CARBO/HNO4=0.0 -! -!CARBO/NH3=0.0 -! -!CARBO/DMS=0.0 -! -!CARBO/SO2=0.0 -! -!CARBO/SULF=0.0 -! -!CARBO/CO=0.0 -! -!CARBO/OH=+0.00835*K058*<ALKA>+0.16919*K065*<CARBO>-K065*<CARBO>+0.21863*K070*< -!PAN> - PJAC(:,26,15)=+0.00835*TPK%K058(:)*PCONC(:,19)+0.16919*TPK%K065(:)*PCONC(:,26)& -&-TPK%K065(:)*PCONC(:,26)+0.21863*TPK%K070(:)*PCONC(:,28) -! -!CARBO/HO2=0.0 -! -!CARBO/CH4=0.0 -! -!CARBO/ETH=0.0 -! -!CARBO/ALKA=+0.00835*K058*<OH> - PJAC(:,26,19)=+0.00835*TPK%K058(:)*PCONC(:,15) -! -!CARBO/ALKE=+0.00000*K076*<NO3>+0.00000*K079*<O3> - PJAC(:,26,20)=+0.00000*TPK%K076(:)*PCONC(:,5)+0.00000*TPK%K079(:)*PCONC(:,1) -! -!CARBO/BIO=+0.13255*K054*<O3P>+0.91741*K077*<NO3>+0.39754*K080*<O3> - PJAC(:,26,21)=+0.13255*TPK%K054(:)*TPK%O3P(:)+0.91741*TPK%K077(:)*PCONC(:,5)+0& -&.39754*TPK%K080(:)*PCONC(:,1) -! -!CARBO/ARO=0.0 -! -!CARBO/HCHO=0.0 -! -!CARBO/ALD=0.0 -! -!CARBO/KET=0.0 -! -!CARBO/CARBO=-K016-K055*<O3P>+0.16919*K065*<OH>-K065*<OH>+0.10530*K074*<NO3>-K0 -!74*<NO3>+1.07583*K081*<O3>-K081*<O3> - PJAC(:,26,26)=-TPK%K016(:)-TPK%K055(:)*TPK%O3P(:)+0.16919*TPK%K065(:)*PCONC(:,& -&15)-TPK%K065(:)*PCONC(:,15)+0.10530*TPK%K074(:)*PCONC(:,5)-TPK%K074(:)*PCONC(:& -&,5)+1.07583*TPK%K081(:)*PCONC(:,1)-TPK%K081(:)*PCONC(:,1) -! -!CARBO/ONIT=0.0 -! -!CARBO/PAN=+0.21863*K070*<OH> - PJAC(:,26,28)=+0.21863*TPK%K070(:)*PCONC(:,15) -! -!CARBO/OP1=0.0 -! -!CARBO/OP2=0.0 -! -!CARBO/ORA1=0.0 -! -!CARBO/ORA2=0.0 -! -!CARBO/MO2=+0.07976*K105*<ALKAP>+0.56064*K107*<BIOP>+1.99461*K108*<AROP>+0.1538 -!7*K109*<CARBOP> - PJAC(:,26,33)=+0.07976*TPK%K105(:)*PCONC(:,34)+0.56064*TPK%K107(:)*PCONC(:,36)& -&+1.99461*TPK%K108(:)*PCONC(:,39)+0.15387*TPK%K109(:)*PCONC(:,40) -! -!CARBO/ALKAP=+0.03407*K091*<NO>+0.07976*K105*<MO2>+0.06954*K111*<CARBOP>+0.0353 -!1*K120*<NO3> - PJAC(:,26,34)=+0.03407*TPK%K091(:)*PCONC(:,3)+0.07976*TPK%K105(:)*PCONC(:,33)+& -&0.06954*TPK%K111(:)*PCONC(:,40)+0.03531*TPK%K120(:)*PCONC(:,5) -! -!CARBO/ALKEP=0.0 -! -!CARBO/BIOP=+0.45463*K093*<NO>+0.56064*K107*<MO2>+0.78591*K113*<CARBOP>+0.61160 -!*K122*<NO3> - PJAC(:,26,36)=+0.45463*TPK%K093(:)*PCONC(:,3)+0.56064*TPK%K107(:)*PCONC(:,33)+& -&0.78591*TPK%K113(:)*PCONC(:,40)+0.61160*TPK%K122(:)*PCONC(:,5) -! -!CARBO/PHO=0.0 -! -!CARBO/ADD=0.0 -! -!CARBO/AROP=+2.06993*K094*<NO>+1.99461*K108*<MO2>+1.99455*K114*<CARBOP>+2.81904 -!*K123*<NO3> - PJAC(:,26,39)=+2.06993*TPK%K094(:)*PCONC(:,3)+1.99461*TPK%K108(:)*PCONC(:,33)+& -&1.99455*TPK%K114(:)*PCONC(:,40)+2.81904*TPK%K123(:)*PCONC(:,5) -! -!CARBO/CARBOP=+0.08670*K095*<NO>+0.15387*K109*<MO2>+0.06954*K111*<ALKAP>+0.7859 -!1*K113*<BIOP>+1.99455*K114*<AROP>+0.10777*K115*<CARBOP>+0.10777*K115*<CARBOP>+ -!0.03455*K124*<NO3> - PJAC(:,26,40)=+0.08670*TPK%K095(:)*PCONC(:,3)+0.15387*TPK%K109(:)*PCONC(:,33)+& -&0.06954*TPK%K111(:)*PCONC(:,34)+0.78591*TPK%K113(:)*PCONC(:,36)+1.99455*TPK%K1& -&14(:)*PCONC(:,39)+0.10777*TPK%K115(:)*PCONC(:,40)+0.10777*TPK%K115(:)*PCONC(:,& -&40)+0.03455*TPK%K124(:)*PCONC(:,5) -! -!CARBO/OLN=0.0 -! -!CARBO/XO2=0.0 -! -!CARBO/WC_O3=0.0 -! -!CARBO/WC_H2O2=0.0 -! -!CARBO/WC_NO=0.0 -! -!CARBO/WC_NO2=0.0 -! -!CARBO/WC_NO3=0.0 -! -!CARBO/WC_N2O5=0.0 -! -!CARBO/WC_HONO=0.0 -! -!CARBO/WC_HNO3=0.0 -! -!CARBO/WC_HNO4=0.0 -! -!CARBO/WC_NH3=0.0 -! -!CARBO/WC_OH=0.0 -! -!CARBO/WC_HO2=0.0 -! -!CARBO/WC_CO2=0.0 -! -!CARBO/WC_SO2=0.0 -! -!CARBO/WC_SULF=0.0 -! -!CARBO/WC_HCHO=0.0 -! -!CARBO/WC_ORA1=0.0 -! -!CARBO/WC_ORA2=0.0 -! -!CARBO/WC_MO2=0.0 -! -!CARBO/WC_OP1=0.0 -! -!CARBO/WC_ASO3=0.0 -! -!CARBO/WC_ASO4=0.0 -! -!CARBO/WC_ASO5=0.0 -! -!CARBO/WC_AHSO5=0.0 -! -!CARBO/WC_AHMS=0.0 -! -!CARBO/WR_O3=0.0 -! -!CARBO/WR_H2O2=0.0 -! -!CARBO/WR_NO=0.0 -! -!CARBO/WR_NO2=0.0 -! -!CARBO/WR_NO3=0.0 -! -!CARBO/WR_N2O5=0.0 -! -!CARBO/WR_HONO=0.0 -! -!CARBO/WR_HNO3=0.0 -! -!CARBO/WR_HNO4=0.0 -! -!CARBO/WR_NH3=0.0 -! -!CARBO/WR_OH=0.0 -! -!CARBO/WR_HO2=0.0 -! -!CARBO/WR_CO2=0.0 -! -!CARBO/WR_SO2=0.0 -! -!CARBO/WR_SULF=0.0 -! -!CARBO/WR_HCHO=0.0 -! -!CARBO/WR_ORA1=0.0 -! -!CARBO/WR_ORA2=0.0 -! -!CARBO/WR_MO2=0.0 -! -!CARBO/WR_OP1=0.0 -! -!CARBO/WR_ASO3=0.0 -! -!CARBO/WR_ASO4=0.0 -! -!CARBO/WR_ASO5=0.0 -! -!CARBO/WR_AHSO5=0.0 -! -!CARBO/WR_AHMS=0.0 -! -!ONIT/O3=0.0 -! -!ONIT/H2O2=0.0 -! -!ONIT/NO=+0.08459*K091*<ALKAP>+0.15300*K093*<BIOP>+0.04885*K094*<AROP>+0.18401* -!K096*<OLN> - PJAC(:,27,3)=+0.08459*TPK%K091(:)*PCONC(:,34)+0.15300*TPK%K093(:)*PCONC(:,36)+& -&0.04885*TPK%K094(:)*PCONC(:,39)+0.18401*TPK%K096(:)*PCONC(:,41) -! -!ONIT/NO2=+K083*<PHO> - PJAC(:,27,4)=+TPK%K083(:)*PCONC(:,37) -! -!ONIT/NO3=+0.60*K078*<PAN>+0.25928*K125*<OLN> - PJAC(:,27,5)=+0.60*TPK%K078(:)*PCONC(:,28)+0.25928*TPK%K125(:)*PCONC(:,41) -! -!ONIT/N2O5=0.0 -! -!ONIT/HONO=0.0 -! -!ONIT/HNO3=0.0 -! -!ONIT/HNO4=0.0 -! -!ONIT/NH3=0.0 -! -!ONIT/DMS=0.0 -! -!ONIT/SO2=0.0 -! -!ONIT/SULF=0.0 -! -!ONIT/CO=0.0 -! -!ONIT/OH=-K071*<ONIT> - PJAC(:,27,15)=-TPK%K071(:)*PCONC(:,27) -! -!ONIT/HO2=+K103*<OLN> - PJAC(:,27,16)=+TPK%K103(:)*PCONC(:,41) -! -!ONIT/CH4=0.0 -! -!ONIT/ETH=0.0 -! -!ONIT/ALKA=0.0 -! -!ONIT/ALKE=0.0 -! -!ONIT/BIO=0.0 -! -!ONIT/ARO=0.0 -! -!ONIT/HCHO=0.0 -! -!ONIT/ALD=0.0 -! -!ONIT/KET=0.0 -! -!ONIT/CARBO=0.0 -! -!ONIT/ONIT=-K017-K071*<OH> - PJAC(:,27,27)=-TPK%K017(:)-TPK%K071(:)*PCONC(:,15) -! -!ONIT/PAN=+0.60*K078*<NO3> - PJAC(:,27,28)=+0.60*TPK%K078(:)*PCONC(:,5) -! -!ONIT/OP1=0.0 -! -!ONIT/OP2=0.0 -! -!ONIT/ORA1=0.0 -! -!ONIT/ORA2=0.0 -! -!ONIT/MO2=+0.67560*K110*<OLN> - PJAC(:,27,33)=+0.67560*TPK%K110(:)*PCONC(:,41) -! -!ONIT/ALKAP=+0.08459*K091*<NO> - PJAC(:,27,34)=+0.08459*TPK%K091(:)*PCONC(:,3) -! -!ONIT/ALKEP=0.0 -! -!ONIT/BIOP=+0.15300*K093*<NO> - PJAC(:,27,36)=+0.15300*TPK%K093(:)*PCONC(:,3) -! -!ONIT/PHO=+K083*<NO2> - PJAC(:,27,37)=+TPK%K083(:)*PCONC(:,4) -! -!ONIT/ADD=0.0 -! -!ONIT/AROP=+0.04885*K094*<NO> - PJAC(:,27,39)=+0.04885*TPK%K094(:)*PCONC(:,3) -! -!ONIT/CARBOP=+0.66562*K116*<OLN> - PJAC(:,27,40)=+0.66562*TPK%K116(:)*PCONC(:,41) -! -!ONIT/OLN=+0.18401*K096*<NO>+K103*<HO2>+0.67560*K110*<MO2>+0.66562*K116*<CARBOP -!>+2.00*K117*<OLN>+2.00*K117*<OLN>+0.00000*K118*<OLN>+0.00000*K118*<OLN>+0.2592 -!8*K125*<NO3> - PJAC(:,27,41)=+0.18401*TPK%K096(:)*PCONC(:,3)+TPK%K103(:)*PCONC(:,16)+0.67560*& -&TPK%K110(:)*PCONC(:,33)+0.66562*TPK%K116(:)*PCONC(:,40)+2.00*TPK%K117(:)*PCONC& -&(:,41)+2.00*TPK%K117(:)*PCONC(:,41)+0.00000*TPK%K118(:)*PCONC(:,41)+0.00000*TP& -&K%K118(:)*PCONC(:,41)+0.25928*TPK%K125(:)*PCONC(:,5) -! -!ONIT/XO2=0.0 -! -!ONIT/WC_O3=0.0 -! -!ONIT/WC_H2O2=0.0 -! -!ONIT/WC_NO=0.0 -! -!ONIT/WC_NO2=0.0 -! -!ONIT/WC_NO3=0.0 -! -!ONIT/WC_N2O5=0.0 -! -!ONIT/WC_HONO=0.0 -! -!ONIT/WC_HNO3=0.0 -! -!ONIT/WC_HNO4=0.0 -! -!ONIT/WC_NH3=0.0 -! -!ONIT/WC_OH=0.0 -! -!ONIT/WC_HO2=0.0 -! -!ONIT/WC_CO2=0.0 -! -!ONIT/WC_SO2=0.0 -! -!ONIT/WC_SULF=0.0 -! -!ONIT/WC_HCHO=0.0 -! -!ONIT/WC_ORA1=0.0 -! -!ONIT/WC_ORA2=0.0 -! -!ONIT/WC_MO2=0.0 -! -!ONIT/WC_OP1=0.0 -! -!ONIT/WC_ASO3=0.0 -! -!ONIT/WC_ASO4=0.0 -! -!ONIT/WC_ASO5=0.0 -! -!ONIT/WC_AHSO5=0.0 -! -!ONIT/WC_AHMS=0.0 -! -!ONIT/WR_O3=0.0 -! -!ONIT/WR_H2O2=0.0 -! -!ONIT/WR_NO=0.0 -! -!ONIT/WR_NO2=0.0 -! -!ONIT/WR_NO3=0.0 -! -!ONIT/WR_N2O5=0.0 -! -!ONIT/WR_HONO=0.0 -! -!ONIT/WR_HNO3=0.0 -! -!ONIT/WR_HNO4=0.0 -! -!ONIT/WR_NH3=0.0 -! -!ONIT/WR_OH=0.0 -! -!ONIT/WR_HO2=0.0 -! -!ONIT/WR_CO2=0.0 -! -!ONIT/WR_SO2=0.0 -! -!ONIT/WR_SULF=0.0 -! -!ONIT/WR_HCHO=0.0 -! -!ONIT/WR_ORA1=0.0 -! -!ONIT/WR_ORA2=0.0 -! -!ONIT/WR_MO2=0.0 -! -!ONIT/WR_OP1=0.0 -! -!ONIT/WR_ASO3=0.0 -! -!ONIT/WR_ASO4=0.0 -! -!ONIT/WR_ASO5=0.0 -! -!ONIT/WR_AHSO5=0.0 -! -!ONIT/WR_AHMS=0.0 -! -!PAN/O3=+0.30000*K082*<PAN>-K082*<PAN> - PJAC(:,28,1)=+0.30000*TPK%K082(:)*PCONC(:,28)-TPK%K082(:)*PCONC(:,28) -! -!PAN/H2O2=0.0 -! -!PAN/NO=0.0 -! -!PAN/NO2=+1.00000*K088*<CARBOP> - PJAC(:,28,4)=+1.00000*TPK%K088(:)*PCONC(:,40) -! -!PAN/NO3=+0.40000*K078*<PAN>-K078*<PAN> - PJAC(:,28,5)=+0.40000*TPK%K078(:)*PCONC(:,28)-TPK%K078(:)*PCONC(:,28) -! -!PAN/N2O5=0.0 -! -!PAN/HONO=0.0 -! -!PAN/HNO3=0.0 -! -!PAN/HNO4=0.0 -! -!PAN/NH3=0.0 -! -!PAN/DMS=0.0 -! -!PAN/SO2=0.0 -! -!PAN/SULF=0.0 -! -!PAN/CO=0.0 -! -!PAN/OH=+0.28107*K070*<PAN>-K070*<PAN> - PJAC(:,28,15)=+0.28107*TPK%K070(:)*PCONC(:,28)-TPK%K070(:)*PCONC(:,28) -! -!PAN/HO2=0.0 -! -!PAN/CH4=0.0 -! -!PAN/ETH=0.0 -! -!PAN/ALKA=0.0 -! -!PAN/ALKE=0.0 -! -!PAN/BIO=0.0 -! -!PAN/ARO=0.0 -! -!PAN/HCHO=0.0 -! -!PAN/ALD=0.0 -! -!PAN/KET=0.0 -! -!PAN/CARBO=0.0 -! -!PAN/ONIT=0.0 -! -!PAN/PAN=+0.28107*K070*<OH>-K070*<OH>+0.40000*K078*<NO3>-K078*<NO3>+0.30000*K08 -!2*<O3>-K082*<O3>-K089 - PJAC(:,28,28)=+0.28107*TPK%K070(:)*PCONC(:,15)-TPK%K070(:)*PCONC(:,15)+0.40000& -&*TPK%K078(:)*PCONC(:,5)-TPK%K078(:)*PCONC(:,5)+0.30000*TPK%K082(:)*PCONC(:,1)-& -&TPK%K082(:)*PCONC(:,1)-TPK%K089(:) -! -!PAN/OP1=0.0 -! -!PAN/OP2=0.0 -! -!PAN/ORA1=0.0 -! -!PAN/ORA2=0.0 -! -!PAN/MO2=0.0 -! -!PAN/ALKAP=0.0 -! -!PAN/ALKEP=0.0 -! -!PAN/BIOP=0.0 -! -!PAN/PHO=0.0 -! -!PAN/ADD=0.0 -! -!PAN/AROP=0.0 -! -!PAN/CARBOP=+1.00000*K088*<NO2> - PJAC(:,28,40)=+1.00000*TPK%K088(:)*PCONC(:,4) -! -!PAN/OLN=0.0 -! -!PAN/XO2=0.0 -! -!PAN/WC_O3=0.0 -! -!PAN/WC_H2O2=0.0 -! -!PAN/WC_NO=0.0 -! -!PAN/WC_NO2=0.0 -! -!PAN/WC_NO3=0.0 -! -!PAN/WC_N2O5=0.0 -! -!PAN/WC_HONO=0.0 -! -!PAN/WC_HNO3=0.0 -! -!PAN/WC_HNO4=0.0 -! -!PAN/WC_NH3=0.0 -! -!PAN/WC_OH=0.0 -! -!PAN/WC_HO2=0.0 -! -!PAN/WC_CO2=0.0 -! -!PAN/WC_SO2=0.0 -! -!PAN/WC_SULF=0.0 -! -!PAN/WC_HCHO=0.0 -! -!PAN/WC_ORA1=0.0 -! -!PAN/WC_ORA2=0.0 -! -!PAN/WC_MO2=0.0 -! -!PAN/WC_OP1=0.0 -! -!PAN/WC_ASO3=0.0 -! -!PAN/WC_ASO4=0.0 -! -!PAN/WC_ASO5=0.0 -! -!PAN/WC_AHSO5=0.0 -! -!PAN/WC_AHMS=0.0 -! -!PAN/WR_O3=0.0 -! -!PAN/WR_H2O2=0.0 -! -!PAN/WR_NO=0.0 -! -!PAN/WR_NO2=0.0 -! -!PAN/WR_NO3=0.0 -! -!PAN/WR_N2O5=0.0 -! -!PAN/WR_HONO=0.0 -! -!PAN/WR_HNO3=0.0 -! -!PAN/WR_HNO4=0.0 -! -!PAN/WR_NH3=0.0 -! -!PAN/WR_OH=0.0 -! -!PAN/WR_HO2=0.0 -! -!PAN/WR_CO2=0.0 -! -!PAN/WR_SO2=0.0 -! -!PAN/WR_SULF=0.0 -! -!PAN/WR_HCHO=0.0 -! -!PAN/WR_ORA1=0.0 -! -!PAN/WR_ORA2=0.0 -! -!PAN/WR_MO2=0.0 -! -!PAN/WR_OP1=0.0 -! -!PAN/WR_ASO3=0.0 -! -!PAN/WR_ASO4=0.0 -! -!PAN/WR_ASO5=0.0 -! -!PAN/WR_AHSO5=0.0 -! -!PAN/WR_AHMS=0.0 -! -!OP1/O3=0.0 -! -!OP1/H2O2=0.0 -! -!OP1/NO=0.0 -! -!OP1/NO2=0.0 -! -!OP1/NO3=0.0 -! -!OP1/N2O5=0.0 -! -!OP1/HONO=0.0 -! -!OP1/HNO3=0.0 -! -!OP1/HNO4=0.0 -! -!OP1/NH3=0.0 -! -!OP1/DMS=0.0 -! -!OP1/SO2=0.0 -! -!OP1/SULF=0.0 -! -!OP1/CO=0.0 -! -!OP1/OH=-K068*<OP1> - PJAC(:,29,15)=-TPK%K068(:)*PCONC(:,29) -! -!OP1/HO2=+K097*<MO2> - PJAC(:,29,16)=+TPK%K097(:)*PCONC(:,33) -! -!OP1/CH4=0.0 -! -!OP1/ETH=0.0 -! -!OP1/ALKA=0.0 -! -!OP1/ALKE=0.0 -! -!OP1/BIO=0.0 -! -!OP1/ARO=0.0 -! -!OP1/HCHO=0.0 -! -!OP1/ALD=0.0 -! -!OP1/KET=0.0 -! -!OP1/CARBO=0.0 -! -!OP1/ONIT=0.0 -! -!OP1/PAN=0.0 -! -!OP1/OP1=-K013-K068*<OH>-KTC20-KTR20 - PJAC(:,29,29)=-TPK%K013(:)-TPK%K068(:)*PCONC(:,15)-TPK%KTC20(:)-TPK%KTR20(:) -! -!OP1/OP2=0.0 -! -!OP1/ORA1=0.0 -! -!OP1/ORA2=0.0 -! -!OP1/MO2=+K097*<HO2> - PJAC(:,29,33)=+TPK%K097(:)*PCONC(:,16) -! -!OP1/ALKAP=0.0 -! -!OP1/ALKEP=0.0 -! -!OP1/BIOP=0.0 -! -!OP1/PHO=0.0 -! -!OP1/ADD=0.0 -! -!OP1/AROP=0.0 -! -!OP1/CARBOP=0.0 -! -!OP1/OLN=0.0 -! -!OP1/XO2=0.0 -! -!OP1/WC_O3=0.0 -! -!OP1/WC_H2O2=0.0 -! -!OP1/WC_NO=0.0 -! -!OP1/WC_NO2=0.0 -! -!OP1/WC_NO3=0.0 -! -!OP1/WC_N2O5=0.0 -! -!OP1/WC_HONO=0.0 -! -!OP1/WC_HNO3=0.0 -! -!OP1/WC_HNO4=0.0 -! -!OP1/WC_NH3=0.0 -! -!OP1/WC_OH=0.0 -! -!OP1/WC_HO2=0.0 -! -!OP1/WC_CO2=0.0 -! -!OP1/WC_SO2=0.0 -! -!OP1/WC_SULF=0.0 -! -!OP1/WC_HCHO=0.0 -! -!OP1/WC_ORA1=0.0 -! -!OP1/WC_ORA2=0.0 -! -!OP1/WC_MO2=0.0 -! -!OP1/WC_OP1=+KTC40 - PJAC(:,29,62)=+TPK%KTC40(:) -! -!OP1/WC_ASO3=0.0 -! -!OP1/WC_ASO4=0.0 -! -!OP1/WC_ASO5=0.0 -! -!OP1/WC_AHSO5=0.0 -! -!OP1/WC_AHMS=0.0 -! -!OP1/WR_O3=0.0 -! -!OP1/WR_H2O2=0.0 -! -!OP1/WR_NO=0.0 -! -!OP1/WR_NO2=0.0 -! -!OP1/WR_NO3=0.0 -! -!OP1/WR_N2O5=0.0 -! -!OP1/WR_HONO=0.0 -! -!OP1/WR_HNO3=0.0 -! -!OP1/WR_HNO4=0.0 -! -!OP1/WR_NH3=0.0 -! -!OP1/WR_OH=0.0 -! -!OP1/WR_HO2=0.0 -! -!OP1/WR_CO2=0.0 -! -!OP1/WR_SO2=0.0 -! -!OP1/WR_SULF=0.0 -! -!OP1/WR_HCHO=0.0 -! -!OP1/WR_ORA1=0.0 -! -!OP1/WR_ORA2=0.0 -! -!OP1/WR_MO2=0.0 -! -!OP1/WR_OP1=+KTR40 - PJAC(:,29,87)=+TPK%KTR40(:) -! -!OP1/WR_ASO3=0.0 -! -!OP1/WR_ASO4=0.0 -! -!OP1/WR_ASO5=0.0 -! -!OP1/WR_AHSO5=0.0 -! -!OP1/WR_AHMS=0.0 -! -!OP2/O3=+0.10149*K081*<CARBO> - PJAC(:,30,1)=+0.10149*TPK%K081(:)*PCONC(:,26) -! -!OP2/H2O2=0.0 -! -!OP2/NO=0.0 -! -!OP2/NO2=0.0 -! -!OP2/NO3=0.0 -! -!OP2/N2O5=0.0 -! -!OP2/HONO=0.0 -! -!OP2/HNO3=0.0 -! -!OP2/HNO4=0.0 -! -!OP2/NH3=0.0 -! -!OP2/DMS=0.0 -! -!OP2/SO2=0.0 -! -!OP2/SULF=0.0 -! -!OP2/CO=0.0 -! -!OP2/OH=-K069*<OP2> - PJAC(:,30,15)=-TPK%K069(:)*PCONC(:,30) -! -!OP2/HO2=+1.00524*K098*<ALKAP>+1.00524*K099*<ALKEP>+1.00524*K0100*<BIOP>+1.0052 -!4*K0101*<AROP>+0.80904*K0102*<CARBOP>+1.00524*K126*<XO2> - PJAC(:,30,16)=+1.00524*TPK%K098(:)*PCONC(:,34)+1.00524*TPK%K099(:)*PCONC(:,35)& -&+1.00524*TPK%K0100(:)*PCONC(:,36)+1.00524*TPK%K0101(:)*PCONC(:,39)+0.80904*TPK& -&%K0102(:)*PCONC(:,40)+1.00524*TPK%K126(:)*PCONC(:,42) -! -!OP2/CH4=0.0 -! -!OP2/ETH=0.0 -! -!OP2/ALKA=0.0 -! -!OP2/ALKE=0.0 -! -!OP2/BIO=0.0 -! -!OP2/ARO=0.0 -! -!OP2/HCHO=0.0 -! -!OP2/ALD=0.0 -! -!OP2/KET=0.0 -! -!OP2/CARBO=+0.10149*K081*<O3> - PJAC(:,30,26)=+0.10149*TPK%K081(:)*PCONC(:,1) -! -!OP2/ONIT=0.0 -! -!OP2/PAN=0.0 -! -!OP2/OP1=0.0 -! -!OP2/OP2=-K014-K069*<OH> - PJAC(:,30,30)=-TPK%K014(:)-TPK%K069(:)*PCONC(:,15) -! -!OP2/ORA1=0.0 -! -!OP2/ORA2=0.0 -! -!OP2/MO2=0.0 -! -!OP2/ALKAP=+1.00524*K098*<HO2> - PJAC(:,30,34)=+1.00524*TPK%K098(:)*PCONC(:,16) -! -!OP2/ALKEP=+1.00524*K099*<HO2> - PJAC(:,30,35)=+1.00524*TPK%K099(:)*PCONC(:,16) -! -!OP2/BIOP=+1.00524*K0100*<HO2> - PJAC(:,30,36)=+1.00524*TPK%K0100(:)*PCONC(:,16) -! -!OP2/PHO=0.0 -! -!OP2/ADD=0.0 -! -!OP2/AROP=+1.00524*K0101*<HO2> - PJAC(:,30,39)=+1.00524*TPK%K0101(:)*PCONC(:,16) -! -!OP2/CARBOP=+0.80904*K0102*<HO2> - PJAC(:,30,40)=+0.80904*TPK%K0102(:)*PCONC(:,16) -! -!OP2/OLN=0.0 -! -!OP2/XO2=+1.00524*K126*<HO2> - PJAC(:,30,42)=+1.00524*TPK%K126(:)*PCONC(:,16) -! -!OP2/WC_O3=0.0 -! -!OP2/WC_H2O2=0.0 -! -!OP2/WC_NO=0.0 -! -!OP2/WC_NO2=0.0 -! -!OP2/WC_NO3=0.0 -! -!OP2/WC_N2O5=0.0 -! -!OP2/WC_HONO=0.0 -! -!OP2/WC_HNO3=0.0 -! -!OP2/WC_HNO4=0.0 -! -!OP2/WC_NH3=0.0 -! -!OP2/WC_OH=0.0 -! -!OP2/WC_HO2=0.0 -! -!OP2/WC_CO2=0.0 -! -!OP2/WC_SO2=0.0 -! -!OP2/WC_SULF=0.0 -! -!OP2/WC_HCHO=0.0 -! -!OP2/WC_ORA1=0.0 -! -!OP2/WC_ORA2=0.0 -! -!OP2/WC_MO2=0.0 -! -!OP2/WC_OP1=0.0 -! -!OP2/WC_ASO3=0.0 -! -!OP2/WC_ASO4=0.0 -! -!OP2/WC_ASO5=0.0 -! -!OP2/WC_AHSO5=0.0 -! -!OP2/WC_AHMS=0.0 -! -!OP2/WR_O3=0.0 -! -!OP2/WR_H2O2=0.0 -! -!OP2/WR_NO=0.0 -! -!OP2/WR_NO2=0.0 -! -!OP2/WR_NO3=0.0 -! -!OP2/WR_N2O5=0.0 -! -!OP2/WR_HONO=0.0 -! -!OP2/WR_HNO3=0.0 -! -!OP2/WR_HNO4=0.0 -! -!OP2/WR_NH3=0.0 -! -!OP2/WR_OH=0.0 -! -!OP2/WR_HO2=0.0 -! -!OP2/WR_CO2=0.0 -! -!OP2/WR_SO2=0.0 -! -!OP2/WR_SULF=0.0 -! -!OP2/WR_HCHO=0.0 -! -!OP2/WR_ORA1=0.0 -! -!OP2/WR_ORA2=0.0 -! -!OP2/WR_MO2=0.0 -! -!OP2/WR_OP1=0.0 -! -!OP2/WR_ASO3=0.0 -! -!OP2/WR_ASO4=0.0 -! -!OP2/WR_ASO5=0.0 -! -!OP2/WR_AHSO5=0.0 -! -!OP2/WR_AHMS=0.0 -! -RETURN -END SUBROUTINE SUBJ5 -! -SUBROUTINE SUBJ6 -! -!Indices 31 a 35 -! -! -!ORA1/O3=+0.15343*K079*<ALKE>+0.15000*K080*<BIO>+0.10788*K081*<CARBO>+0.11*K082 -!*<PAN> - PJAC(:,31,1)=+0.15343*TPK%K079(:)*PCONC(:,20)+0.15000*TPK%K080(:)*PCONC(:,21)+& -&0.10788*TPK%K081(:)*PCONC(:,26)+0.11*TPK%K082(:)*PCONC(:,28) -! -!ORA1/H2O2=0.0 -! -!ORA1/NO=0.0 -! -!ORA1/NO2=0.0 -! -!ORA1/NO3=0.0 -! -!ORA1/N2O5=0.0 -! -!ORA1/HONO=0.0 -! -!ORA1/HNO3=0.0 -! -!ORA1/HNO4=0.0 -! -!ORA1/NH3=0.0 -! -!ORA1/DMS=0.0 -! -!ORA1/SO2=0.0 -! -!ORA1/SULF=0.0 -! -!ORA1/CO=0.0 -! -!ORA1/OH=+0.00878*K058*<ALKA>-K066*<ORA1> - PJAC(:,31,15)=+0.00878*TPK%K058(:)*PCONC(:,19)-TPK%K066(:)*PCONC(:,31) -! -!ORA1/HO2=0.0 -! -!ORA1/CH4=0.0 -! -!ORA1/ETH=0.0 -! -!ORA1/ALKA=+0.00878*K058*<OH> - PJAC(:,31,19)=+0.00878*TPK%K058(:)*PCONC(:,15) -! -!ORA1/ALKE=+0.15343*K079*<O3> - PJAC(:,31,20)=+0.15343*TPK%K079(:)*PCONC(:,1) -! -!ORA1/BIO=+0.15000*K080*<O3> - PJAC(:,31,21)=+0.15000*TPK%K080(:)*PCONC(:,1) -! -!ORA1/ARO=0.0 -! -!ORA1/HCHO=0.0 -! -!ORA1/ALD=0.0 -! -!ORA1/KET=0.0 -! -!ORA1/CARBO=+0.10788*K081*<O3> - PJAC(:,31,26)=+0.10788*TPK%K081(:)*PCONC(:,1) -! -!ORA1/ONIT=0.0 -! -!ORA1/PAN=+0.11*K082*<O3> - PJAC(:,31,28)=+0.11*TPK%K082(:)*PCONC(:,1) -! -!ORA1/OP1=0.0 -! -!ORA1/OP2=0.0 -! -!ORA1/ORA1=-K066*<OH>-KTC17-KTR17 - PJAC(:,31,31)=-TPK%K066(:)*PCONC(:,15)-TPK%KTC17(:)-TPK%KTR17(:) -! -!ORA1/ORA2=0.0 -! -!ORA1/MO2=0.0 -! -!ORA1/ALKAP=0.0 -! -!ORA1/ALKEP=0.0 -! -!ORA1/BIOP=0.0 -! -!ORA1/PHO=0.0 -! -!ORA1/ADD=0.0 -! -!ORA1/AROP=0.0 -! -!ORA1/CARBOP=0.0 -! -!ORA1/OLN=0.0 -! -!ORA1/XO2=0.0 -! -!ORA1/WC_O3=0.0 -! -!ORA1/WC_H2O2=0.0 -! -!ORA1/WC_NO=0.0 -! -!ORA1/WC_NO2=0.0 -! -!ORA1/WC_NO3=0.0 -! -!ORA1/WC_N2O5=0.0 -! -!ORA1/WC_HONO=0.0 -! -!ORA1/WC_HNO3=0.0 -! -!ORA1/WC_HNO4=0.0 -! -!ORA1/WC_NH3=0.0 -! -!ORA1/WC_OH=0.0 -! -!ORA1/WC_HO2=0.0 -! -!ORA1/WC_CO2=0.0 -! -!ORA1/WC_SO2=0.0 -! -!ORA1/WC_SULF=0.0 -! -!ORA1/WC_HCHO=0.0 -! -!ORA1/WC_ORA1=+KTC37 - PJAC(:,31,59)=+TPK%KTC37(:) -! -!ORA1/WC_ORA2=0.0 -! -!ORA1/WC_MO2=0.0 -! -!ORA1/WC_OP1=0.0 -! -!ORA1/WC_ASO3=0.0 -! -!ORA1/WC_ASO4=0.0 -! -!ORA1/WC_ASO5=0.0 -! -!ORA1/WC_AHSO5=0.0 -! -!ORA1/WC_AHMS=0.0 -! -!ORA1/WR_O3=0.0 -! -!ORA1/WR_H2O2=0.0 -! -!ORA1/WR_NO=0.0 -! -!ORA1/WR_NO2=0.0 -! -!ORA1/WR_NO3=0.0 -! -!ORA1/WR_N2O5=0.0 -! -!ORA1/WR_HONO=0.0 -! -!ORA1/WR_HNO3=0.0 -! -!ORA1/WR_HNO4=0.0 -! -!ORA1/WR_NH3=0.0 -! -!ORA1/WR_OH=0.0 -! -!ORA1/WR_HO2=0.0 -! -!ORA1/WR_CO2=0.0 -! -!ORA1/WR_SO2=0.0 -! -!ORA1/WR_SULF=0.0 -! -!ORA1/WR_HCHO=0.0 -! -!ORA1/WR_ORA1=+KTR37 - PJAC(:,31,84)=+TPK%KTR37(:) -! -!ORA1/WR_ORA2=0.0 -! -!ORA1/WR_MO2=0.0 -! -!ORA1/WR_OP1=0.0 -! -!ORA1/WR_ASO3=0.0 -! -!ORA1/WR_ASO4=0.0 -! -!ORA1/WR_ASO5=0.0 -! -!ORA1/WR_AHSO5=0.0 -! -!ORA1/WR_AHMS=0.0 -! -!ORA2/O3=+0.08143*K079*<ALKE>+0.00000*K080*<BIO>+0.20595*K081*<CARBO> - PJAC(:,32,1)=+0.08143*TPK%K079(:)*PCONC(:,20)+0.00000*TPK%K080(:)*PCONC(:,21)+& -&0.20595*TPK%K081(:)*PCONC(:,26) -! -!ORA2/H2O2=0.0 -! -!ORA2/NO=0.0 -! -!ORA2/NO2=0.0 -! -!ORA2/NO3=0.0 -! -!ORA2/N2O5=0.0 -! -!ORA2/HONO=0.0 -! -!ORA2/HNO3=0.0 -! -!ORA2/HNO4=0.0 -! -!ORA2/NH3=0.0 -! -!ORA2/DMS=0.0 -! -!ORA2/SO2=0.0 -! -!ORA2/SULF=0.0 -! -!ORA2/CO=0.0 -! -!ORA2/OH=-K067*<ORA2> - PJAC(:,32,15)=-TPK%K067(:)*PCONC(:,32) -! -!ORA2/HO2=+0.17307*K0102*<CARBOP> - PJAC(:,32,16)=+0.17307*TPK%K0102(:)*PCONC(:,40) -! -!ORA2/CH4=0.0 -! -!ORA2/ETH=0.0 -! -!ORA2/ALKA=0.0 -! -!ORA2/ALKE=+0.08143*K079*<O3> - PJAC(:,32,20)=+0.08143*TPK%K079(:)*PCONC(:,1) -! -!ORA2/BIO=+0.00000*K080*<O3> - PJAC(:,32,21)=+0.00000*TPK%K080(:)*PCONC(:,1) -! -!ORA2/ARO=0.0 -! -!ORA2/HCHO=0.0 -! -!ORA2/ALD=0.0 -! -!ORA2/KET=0.0 -! -!ORA2/CARBO=+0.20595*K081*<O3> - PJAC(:,32,26)=+0.20595*TPK%K081(:)*PCONC(:,1) -! -!ORA2/ONIT=0.0 -! -!ORA2/PAN=0.0 -! -!ORA2/OP1=0.0 -! -!ORA2/OP2=0.0 -! -!ORA2/ORA1=0.0 -! -!ORA2/ORA2=-K067*<OH>-KTC18-KTR18 - PJAC(:,32,32)=-TPK%K067(:)*PCONC(:,15)-TPK%KTC18(:)-TPK%KTR18(:) -! -!ORA2/MO2=+0.13684*K109*<CARBOP> - PJAC(:,32,33)=+0.13684*TPK%K109(:)*PCONC(:,40) -! -!ORA2/ALKAP=+0.49810*K111*<CARBOP> - PJAC(:,32,34)=+0.49810*TPK%K111(:)*PCONC(:,40) -! -!ORA2/ALKEP=+0.49922*K112*<CARBOP> - PJAC(:,32,35)=+0.49922*TPK%K112(:)*PCONC(:,40) -! -!ORA2/BIOP=+0.49400*K113*<CARBOP> - PJAC(:,32,36)=+0.49400*TPK%K113(:)*PCONC(:,40) -! -!ORA2/PHO=0.0 -! -!ORA2/ADD=0.0 -! -!ORA2/AROP=0.0 -! -!ORA2/CARBOP=+0.17307*K0102*<HO2>+0.13684*K109*<MO2>+0.49810*K111*<ALKAP>+0.499 -!22*K112*<ALKEP>+0.49400*K113*<BIOP>+0.09955*K115*<CARBOP>+0.09955*K115*<CARBOP -!>+0.48963*K116*<OLN> - PJAC(:,32,40)=+0.17307*TPK%K0102(:)*PCONC(:,16)+0.13684*TPK%K109(:)*PCONC(:,33& -&)+0.49810*TPK%K111(:)*PCONC(:,34)+0.49922*TPK%K112(:)*PCONC(:,35)+0.49400*TPK%& -&K113(:)*PCONC(:,36)+0.09955*TPK%K115(:)*PCONC(:,40)+0.09955*TPK%K115(:)*PCONC(& -&:,40)+0.48963*TPK%K116(:)*PCONC(:,41) -! -!ORA2/OLN=+0.48963*K116*<CARBOP> - PJAC(:,32,41)=+0.48963*TPK%K116(:)*PCONC(:,40) -! -!ORA2/XO2=0.0 -! -!ORA2/WC_O3=0.0 -! -!ORA2/WC_H2O2=0.0 -! -!ORA2/WC_NO=0.0 -! -!ORA2/WC_NO2=0.0 -! -!ORA2/WC_NO3=0.0 -! -!ORA2/WC_N2O5=0.0 -! -!ORA2/WC_HONO=0.0 -! -!ORA2/WC_HNO3=0.0 -! -!ORA2/WC_HNO4=0.0 -! -!ORA2/WC_NH3=0.0 -! -!ORA2/WC_OH=0.0 -! -!ORA2/WC_HO2=0.0 -! -!ORA2/WC_CO2=0.0 -! -!ORA2/WC_SO2=0.0 -! -!ORA2/WC_SULF=0.0 -! -!ORA2/WC_HCHO=0.0 -! -!ORA2/WC_ORA1=0.0 -! -!ORA2/WC_ORA2=+KTC38 - PJAC(:,32,60)=+TPK%KTC38(:) -! -!ORA2/WC_MO2=0.0 -! -!ORA2/WC_OP1=0.0 -! -!ORA2/WC_ASO3=0.0 -! -!ORA2/WC_ASO4=0.0 -! -!ORA2/WC_ASO5=0.0 -! -!ORA2/WC_AHSO5=0.0 -! -!ORA2/WC_AHMS=0.0 -! -!ORA2/WR_O3=0.0 -! -!ORA2/WR_H2O2=0.0 -! -!ORA2/WR_NO=0.0 -! -!ORA2/WR_NO2=0.0 -! -!ORA2/WR_NO3=0.0 -! -!ORA2/WR_N2O5=0.0 -! -!ORA2/WR_HONO=0.0 -! -!ORA2/WR_HNO3=0.0 -! -!ORA2/WR_HNO4=0.0 -! -!ORA2/WR_NH3=0.0 -! -!ORA2/WR_OH=0.0 -! -!ORA2/WR_HO2=0.0 -! -!ORA2/WR_CO2=0.0 -! -!ORA2/WR_SO2=0.0 -! -!ORA2/WR_SULF=0.0 -! -!ORA2/WR_HCHO=0.0 -! -!ORA2/WR_ORA1=0.0 -! -!ORA2/WR_ORA2=+KTR38 - PJAC(:,32,85)=+TPK%KTR38(:) -! -!ORA2/WR_MO2=0.0 -! -!ORA2/WR_OP1=0.0 -! -!ORA2/WR_ASO3=0.0 -! -!ORA2/WR_ASO4=0.0 -! -!ORA2/WR_ASO5=0.0 -! -!ORA2/WR_AHSO5=0.0 -! -!ORA2/WR_AHMS=0.0 -! -!MO2/O3=+0.13966*K079*<ALKE>+0.03000*K080*<BIO> - PJAC(:,33,1)=+0.13966*TPK%K079(:)*PCONC(:,20)+0.03000*TPK%K080(:)*PCONC(:,21) -! -!MO2/H2O2=0.0 -! -!MO2/NO=-K090*<MO2>+0.09016*K091*<ALKAP>+0.78134*K095*<CARBOP> - PJAC(:,33,3)=-TPK%K090(:)*PCONC(:,33)+0.09016*TPK%K091(:)*PCONC(:,34)+0.78134*& -&TPK%K095(:)*PCONC(:,40) -! -!MO2/NO2=0.0 -! -!MO2/NO3=-K119*<MO2>+0.09731*K120*<ALKAP>+0.91910*K124*<CARBOP> - PJAC(:,33,5)=-TPK%K119(:)*PCONC(:,33)+0.09731*TPK%K120(:)*PCONC(:,34)+0.91910*& -&TPK%K124(:)*PCONC(:,40) -! -!MO2/N2O5=0.0 -! -!MO2/HONO=0.0 -! -!MO2/HNO3=0.0 -! -!MO2/HNO4=0.0 -! -!MO2/NH3=0.0 -! -!MO2/DMS=0.0 -! -!MO2/SO2=0.0 -! -!MO2/SULF=0.0 -! -!MO2/CO=0.0 -! -!MO2/OH=+K056*<CH4>+0.65*K068*<OP1> - PJAC(:,33,15)=+TPK%K056(:)*PCONC(:,17)+0.65*TPK%K068(:)*PCONC(:,29) -! -!MO2/HO2=-K097*<MO2> - PJAC(:,33,16)=-TPK%K097(:)*PCONC(:,33) -! -!MO2/CH4=+K056*<OH> - PJAC(:,33,17)=+TPK%K056(:)*PCONC(:,15) -! -!MO2/ETH=0.0 -! -!MO2/ALKA=0.0 -! -!MO2/ALKE=+0.13966*K079*<O3> - PJAC(:,33,20)=+0.13966*TPK%K079(:)*PCONC(:,1) -! -!MO2/BIO=+0.03000*K080*<O3> - PJAC(:,33,21)=+0.03000*TPK%K080(:)*PCONC(:,1) -! -!MO2/ARO=0.0 -! -!MO2/HCHO=0.0 -! -!MO2/ALD=+K012 - PJAC(:,33,24)=+TPK%K012(:) -! -!MO2/KET=0.0 -! -!MO2/CARBO=0.0 -! -!MO2/ONIT=0.0 -! -!MO2/PAN=0.0 -! -!MO2/OP1=+0.65*K068*<OH> - PJAC(:,33,29)=+0.65*TPK%K068(:)*PCONC(:,15) -! -!MO2/OP2=+0.03795*K014 - PJAC(:,33,30)=+0.03795*TPK%K014(:) -! -!MO2/ORA1=0.0 -! -!MO2/ORA2=0.0 -! -!MO2/MO2=-K090*<NO>-K097*<HO2>-K104*<MO2>-K104*<MO2>-K104*<MO2>-K104*<MO2>+0.01 -!390*K105*<ALKAP>-K105*<ALKAP>-K106*<ALKEP>-K107*<BIOP>-K108*<AROP>+0.56031*K10 -!9*<CARBOP>-K109*<CARBOP>-K110*<OLN>-K119*<NO3>-K127*<XO2>-KTC19-KTR19 - PJAC(:,33,33)=-TPK%K090(:)*PCONC(:,3)-TPK%K097(:)*PCONC(:,16)-TPK%K104(:)*PCON& -&C(:,33)-TPK%K104(:)*PCONC(:,33)-TPK%K104(:)*PCONC(:,33)-TPK%K104(:)*PCONC(:,33& -&)+0.01390*TPK%K105(:)*PCONC(:,34)-TPK%K105(:)*PCONC(:,34)-TPK%K106(:)*PCONC(:,& -&35)-TPK%K107(:)*PCONC(:,36)-TPK%K108(:)*PCONC(:,39)+0.56031*TPK%K109(:)*PCONC(& -&:,40)-TPK%K109(:)*PCONC(:,40)-TPK%K110(:)*PCONC(:,41)-TPK%K119(:)*PCONC(:,5)-T& -&PK%K127(:)*PCONC(:,42)-TPK%KTC19(:)-TPK%KTR19(:) -! -!MO2/ALKAP=+0.09016*K091*<NO>+0.01390*K105*<MO2>-K105*<MO2>+0.51480*K111*<CARBO -!P>+0.09731*K120*<NO3> - PJAC(:,33,34)=+0.09016*TPK%K091(:)*PCONC(:,3)+0.01390*TPK%K105(:)*PCONC(:,33)-& -&TPK%K105(:)*PCONC(:,33)+0.51480*TPK%K111(:)*PCONC(:,40)+0.09731*TPK%K120(:)*PC& -&ONC(:,5) -! -!MO2/ALKEP=-K106*<MO2>+0.50078*K112*<CARBOP> - PJAC(:,33,35)=-TPK%K106(:)*PCONC(:,33)+0.50078*TPK%K112(:)*PCONC(:,40) -! -!MO2/BIOP=-K107*<MO2>+0.50600*K113*<CARBOP> - PJAC(:,33,36)=-TPK%K107(:)*PCONC(:,33)+0.50600*TPK%K113(:)*PCONC(:,40) -! -!MO2/PHO=0.0 -! -!MO2/ADD=0.0 -! -!MO2/AROP=-K108*<MO2>+K114*<CARBOP> - PJAC(:,33,39)=-TPK%K108(:)*PCONC(:,33)+TPK%K114(:)*PCONC(:,40) -! -!MO2/CARBOP=+0.78134*K095*<NO>+0.56031*K109*<MO2>-K109*<MO2>+0.51480*K111*<ALKA -!P>+0.50078*K112*<ALKEP>+0.50600*K113*<BIOP>+K114*<AROP>+1.66702*K115*<CARBOP>+ -!1.66702*K115*<CARBOP>+0.51037*K116*<OLN>+0.91910*K124*<NO3>+K128*<XO2> - PJAC(:,33,40)=+0.78134*TPK%K095(:)*PCONC(:,3)+0.56031*TPK%K109(:)*PCONC(:,33)-& -&TPK%K109(:)*PCONC(:,33)+0.51480*TPK%K111(:)*PCONC(:,34)+0.50078*TPK%K112(:)*PC& -&ONC(:,35)+0.50600*TPK%K113(:)*PCONC(:,36)+TPK%K114(:)*PCONC(:,39)+1.66702*TPK%& -&K115(:)*PCONC(:,40)+1.66702*TPK%K115(:)*PCONC(:,40)+0.51037*TPK%K116(:)*PCONC(& -&:,41)+0.91910*TPK%K124(:)*PCONC(:,5)+TPK%K128(:)*PCONC(:,42) -! -!MO2/OLN=-K110*<MO2>+0.51037*K116*<CARBOP> - PJAC(:,33,41)=-TPK%K110(:)*PCONC(:,33)+0.51037*TPK%K116(:)*PCONC(:,40) -! -!MO2/XO2=-K127*<MO2>+K128*<CARBOP> - PJAC(:,33,42)=-TPK%K127(:)*PCONC(:,33)+TPK%K128(:)*PCONC(:,40) -! -!MO2/WC_O3=0.0 -! -!MO2/WC_H2O2=0.0 -! -!MO2/WC_NO=0.0 -! -!MO2/WC_NO2=0.0 -! -!MO2/WC_NO3=0.0 -! -!MO2/WC_N2O5=0.0 -! -!MO2/WC_HONO=0.0 -! -!MO2/WC_HNO3=0.0 -! -!MO2/WC_HNO4=0.0 -! -!MO2/WC_NH3=0.0 -! -!MO2/WC_OH=0.0 -! -!MO2/WC_HO2=0.0 -! -!MO2/WC_CO2=0.0 -! -!MO2/WC_SO2=0.0 -! -!MO2/WC_SULF=0.0 -! -!MO2/WC_HCHO=0.0 -! -!MO2/WC_ORA1=0.0 -! -!MO2/WC_ORA2=0.0 -! -!MO2/WC_MO2=+KTC39 - PJAC(:,33,61)=+TPK%KTC39(:) -! -!MO2/WC_OP1=0.0 -! -!MO2/WC_ASO3=0.0 -! -!MO2/WC_ASO4=0.0 -! -!MO2/WC_ASO5=0.0 -! -!MO2/WC_AHSO5=0.0 -! -!MO2/WC_AHMS=0.0 -! -!MO2/WR_O3=0.0 -! -!MO2/WR_H2O2=0.0 -! -!MO2/WR_NO=0.0 -! -!MO2/WR_NO2=0.0 -! -!MO2/WR_NO3=0.0 -! -!MO2/WR_N2O5=0.0 -! -!MO2/WR_HONO=0.0 -! -!MO2/WR_HNO3=0.0 -! -!MO2/WR_HNO4=0.0 -! -!MO2/WR_NH3=0.0 -! -!MO2/WR_OH=0.0 -! -!MO2/WR_HO2=0.0 -! -!MO2/WR_CO2=0.0 -! -!MO2/WR_SO2=0.0 -! -!MO2/WR_SULF=0.0 -! -!MO2/WR_HCHO=0.0 -! -!MO2/WR_ORA1=0.0 -! -!MO2/WR_ORA2=0.0 -! -!MO2/WR_MO2=+KTR39 - PJAC(:,33,86)=+TPK%KTR39(:) -! -!MO2/WR_OP1=0.0 -! -!MO2/WR_ASO3=0.0 -! -!MO2/WR_ASO4=0.0 -! -!MO2/WR_ASO5=0.0 -! -!MO2/WR_AHSO5=0.0 -! -!MO2/WR_AHMS=0.0 -! -!ALKAP/O3=+0.09815*K079*<ALKE>+0.00000*K080*<BIO> - PJAC(:,34,1)=+0.09815*TPK%K079(:)*PCONC(:,20)+0.00000*TPK%K080(:)*PCONC(:,21) -! -!ALKAP/H2O2=0.0 -! -!ALKAP/NO=+0.08187*K091*<ALKAP>-K091*<ALKAP> - PJAC(:,34,3)=+0.08187*TPK%K091(:)*PCONC(:,34)-TPK%K091(:)*PCONC(:,34) -! -!ALKAP/NO2=0.0 -! -!ALKAP/NO3=+0.08994*K120*<ALKAP>-K120*<ALKAP> - PJAC(:,34,5)=+0.08994*TPK%K120(:)*PCONC(:,34)-TPK%K120(:)*PCONC(:,34) -! -!ALKAP/N2O5=0.0 -! -!ALKAP/HONO=0.0 -! -!ALKAP/HNO3=0.0 -! -!ALKAP/HNO4=0.0 -! -!ALKAP/NH3=0.0 -! -!ALKAP/DMS=0.0 -! -!ALKAP/SO2=0.0 -! -!ALKAP/SULF=0.0 -! -!ALKAP/CO=0.0 -! -!ALKAP/OH=+K057*<ETH>+0.87811*K058*<ALKA>+0.40341*K069*<OP2>+1.00000*K071*<ONIT -!> - PJAC(:,34,15)=+TPK%K057(:)*PCONC(:,18)+0.87811*TPK%K058(:)*PCONC(:,19)+0.40341& -&*TPK%K069(:)*PCONC(:,30)+1.00000*TPK%K071(:)*PCONC(:,27) -! -!ALKAP/HO2=-K098*<ALKAP> - PJAC(:,34,16)=-TPK%K098(:)*PCONC(:,34) -! -!ALKAP/CH4=0.0 -! -!ALKAP/ETH=+K057*<OH> - PJAC(:,34,18)=+TPK%K057(:)*PCONC(:,15) -! -!ALKAP/ALKA=+0.87811*K058*<OH> - PJAC(:,34,19)=+0.87811*TPK%K058(:)*PCONC(:,15) -! -!ALKAP/ALKE=+0.09815*K079*<O3> - PJAC(:,34,20)=+0.09815*TPK%K079(:)*PCONC(:,1) -! -!ALKAP/BIO=+0.00000*K080*<O3> - PJAC(:,34,21)=+0.00000*TPK%K080(:)*PCONC(:,1) -! -!ALKAP/ARO=0.0 -! -!ALKAP/HCHO=0.0 -! -!ALKAP/ALD=0.0 -! -!ALKAP/KET=+1.00000*K015 - PJAC(:,34,25)=+1.00000*TPK%K015(:) -! -!ALKAP/CARBO=0.0 -! -!ALKAP/ONIT=+1.00000*K071*<OH> - PJAC(:,34,27)=+1.00000*TPK%K071(:)*PCONC(:,15) -! -!ALKAP/PAN=0.0 -! -!ALKAP/OP1=0.0 -! -!ALKAP/OP2=+0.40341*K069*<OH> - PJAC(:,34,30)=+0.40341*TPK%K069(:)*PCONC(:,15) -! -!ALKAP/ORA1=0.0 -! -!ALKAP/ORA2=0.0 -! -!ALKAP/MO2=+0.00385*K105*<ALKAP>-K105*<ALKAP> - PJAC(:,34,33)=+0.00385*TPK%K105(:)*PCONC(:,34)-TPK%K105(:)*PCONC(:,34) -! -!ALKAP/ALKAP=+0.08187*K091*<NO>-K091*<NO>-K098*<HO2>+0.00385*K105*<MO2>-K105*<M -!O2>+0.00828*K111*<CARBOP>-K111*<CARBOP>+0.08994*K120*<NO3>-K120*<NO3> - PJAC(:,34,34)=+0.08187*TPK%K091(:)*PCONC(:,3)-TPK%K091(:)*PCONC(:,3)-TPK%K098(& -&:)*PCONC(:,16)+0.00385*TPK%K105(:)*PCONC(:,33)-TPK%K105(:)*PCONC(:,33)+0.00828& -&*TPK%K111(:)*PCONC(:,40)-TPK%K111(:)*PCONC(:,40)+0.08994*TPK%K120(:)*PCONC(:,5& -&)-TPK%K120(:)*PCONC(:,5) -! -!ALKAP/ALKEP=0.0 -! -!ALKAP/BIOP=0.0 -! -!ALKAP/PHO=0.0 -! -!ALKAP/ADD=0.0 -! -!ALKAP/AROP=0.0 -! -!ALKAP/CARBOP=+0.00828*K111*<ALKAP>-K111*<ALKAP> - PJAC(:,34,40)=+0.00828*TPK%K111(:)*PCONC(:,34)-TPK%K111(:)*PCONC(:,34) -! -!ALKAP/OLN=0.0 -! -!ALKAP/XO2=0.0 -! -!ALKAP/WC_O3=0.0 -! -!ALKAP/WC_H2O2=0.0 -! -!ALKAP/WC_NO=0.0 -! -!ALKAP/WC_NO2=0.0 -! -!ALKAP/WC_NO3=0.0 -! -!ALKAP/WC_N2O5=0.0 -! -!ALKAP/WC_HONO=0.0 -! -!ALKAP/WC_HNO3=0.0 -! -!ALKAP/WC_HNO4=0.0 -! -!ALKAP/WC_NH3=0.0 -! -!ALKAP/WC_OH=0.0 -! -!ALKAP/WC_HO2=0.0 -! -!ALKAP/WC_CO2=0.0 -! -!ALKAP/WC_SO2=0.0 -! -!ALKAP/WC_SULF=0.0 -! -!ALKAP/WC_HCHO=0.0 -! -!ALKAP/WC_ORA1=0.0 -! -!ALKAP/WC_ORA2=0.0 -! -!ALKAP/WC_MO2=0.0 -! -!ALKAP/WC_OP1=0.0 -! -!ALKAP/WC_ASO3=0.0 -! -!ALKAP/WC_ASO4=0.0 -! -!ALKAP/WC_ASO5=0.0 -! -!ALKAP/WC_AHSO5=0.0 -! -!ALKAP/WC_AHMS=0.0 -! -!ALKAP/WR_O3=0.0 -! -!ALKAP/WR_H2O2=0.0 -! -!ALKAP/WR_NO=0.0 -! -!ALKAP/WR_NO2=0.0 -! -!ALKAP/WR_NO3=0.0 -! -!ALKAP/WR_N2O5=0.0 -! -!ALKAP/WR_HONO=0.0 -! -!ALKAP/WR_HNO3=0.0 -! -!ALKAP/WR_HNO4=0.0 -! -!ALKAP/WR_NH3=0.0 -! -!ALKAP/WR_OH=0.0 -! -!ALKAP/WR_HO2=0.0 -! -!ALKAP/WR_CO2=0.0 -! -!ALKAP/WR_SO2=0.0 -! -!ALKAP/WR_SULF=0.0 -! -!ALKAP/WR_HCHO=0.0 -! -!ALKAP/WR_ORA1=0.0 -! -!ALKAP/WR_ORA2=0.0 -! -!ALKAP/WR_MO2=0.0 -! -!ALKAP/WR_OP1=0.0 -! -!ALKAP/WR_ASO3=0.0 -! -!ALKAP/WR_ASO4=0.0 -! -!ALKAP/WR_ASO5=0.0 -! -!ALKAP/WR_AHSO5=0.0 -! -!ALKAP/WR_AHMS=0.0 -! -!ALKEP/O3=0.0 -! -!ALKEP/H2O2=0.0 -! -!ALKEP/NO=-K092*<ALKEP> - PJAC(:,35,3)=-TPK%K092(:)*PCONC(:,35) -! -!ALKEP/NO2=0.0 -! -!ALKEP/NO3=-K121*<ALKEP> - PJAC(:,35,5)=-TPK%K121(:)*PCONC(:,35) -! -!ALKEP/N2O5=0.0 -! -!ALKEP/HONO=0.0 -! -!ALKEP/HNO3=0.0 -! -!ALKEP/HNO4=0.0 -! -!ALKEP/NH3=0.0 -! -!ALKEP/DMS=0.0 -! -!ALKEP/SO2=0.0 -! -!ALKEP/SULF=0.0 -! -!ALKEP/CO=0.0 -! -!ALKEP/OH=+1.02529*K059*<ALKE> - PJAC(:,35,15)=+1.02529*TPK%K059(:)*PCONC(:,20) -! -!ALKEP/HO2=-K099*<ALKEP> - PJAC(:,35,16)=-TPK%K099(:)*PCONC(:,35) -! -!ALKEP/CH4=0.0 -! -!ALKEP/ETH=0.0 -! -!ALKEP/ALKA=0.0 -! -!ALKEP/ALKE=+1.02529*K059*<OH> - PJAC(:,35,20)=+1.02529*TPK%K059(:)*PCONC(:,15) -! -!ALKEP/BIO=0.0 -! -!ALKEP/ARO=0.0 -! -!ALKEP/HCHO=0.0 -! -!ALKEP/ALD=0.0 -! -!ALKEP/KET=0.0 -! -!ALKEP/CARBO=0.0 -! -!ALKEP/ONIT=0.0 -! -!ALKEP/PAN=0.0 -! -!ALKEP/OP1=0.0 -! -!ALKEP/OP2=0.0 -! -!ALKEP/ORA1=0.0 -! -!ALKEP/ORA2=0.0 -! -!ALKEP/MO2=-K106*<ALKEP> - PJAC(:,35,33)=-TPK%K106(:)*PCONC(:,35) -! -!ALKEP/ALKAP=0.0 -! -!ALKEP/ALKEP=-K092*<NO>-K099*<HO2>-K106*<MO2>-K112*<CARBOP>-K121*<NO3> - PJAC(:,35,35)=-TPK%K092(:)*PCONC(:,3)-TPK%K099(:)*PCONC(:,16)-TPK%K106(:)*PCON& -&C(:,33)-TPK%K112(:)*PCONC(:,40)-TPK%K121(:)*PCONC(:,5) -! -!ALKEP/BIOP=0.0 -! -!ALKEP/PHO=0.0 -! -!ALKEP/ADD=0.0 -! -!ALKEP/AROP=0.0 -! -!ALKEP/CARBOP=-K112*<ALKEP> - PJAC(:,35,40)=-TPK%K112(:)*PCONC(:,35) -! -!ALKEP/OLN=0.0 -! -!ALKEP/XO2=0.0 -! -!ALKEP/WC_O3=0.0 -! -!ALKEP/WC_H2O2=0.0 -! -!ALKEP/WC_NO=0.0 -! -!ALKEP/WC_NO2=0.0 -! -!ALKEP/WC_NO3=0.0 -! -!ALKEP/WC_N2O5=0.0 -! -!ALKEP/WC_HONO=0.0 -! -!ALKEP/WC_HNO3=0.0 -! -!ALKEP/WC_HNO4=0.0 -! -!ALKEP/WC_NH3=0.0 -! -!ALKEP/WC_OH=0.0 -! -!ALKEP/WC_HO2=0.0 -! -!ALKEP/WC_CO2=0.0 -! -!ALKEP/WC_SO2=0.0 -! -!ALKEP/WC_SULF=0.0 -! -!ALKEP/WC_HCHO=0.0 -! -!ALKEP/WC_ORA1=0.0 -! -!ALKEP/WC_ORA2=0.0 -! -!ALKEP/WC_MO2=0.0 -! -!ALKEP/WC_OP1=0.0 -! -!ALKEP/WC_ASO3=0.0 -! -!ALKEP/WC_ASO4=0.0 -! -!ALKEP/WC_ASO5=0.0 -! -!ALKEP/WC_AHSO5=0.0 -! -!ALKEP/WC_AHMS=0.0 -! -!ALKEP/WR_O3=0.0 -! -!ALKEP/WR_H2O2=0.0 -! -!ALKEP/WR_NO=0.0 -! -!ALKEP/WR_NO2=0.0 -! -!ALKEP/WR_NO3=0.0 -! -!ALKEP/WR_N2O5=0.0 -! -!ALKEP/WR_HONO=0.0 -! -!ALKEP/WR_HNO3=0.0 -! -!ALKEP/WR_HNO4=0.0 -! -!ALKEP/WR_NH3=0.0 -! -!ALKEP/WR_OH=0.0 -! -!ALKEP/WR_HO2=0.0 -! -!ALKEP/WR_CO2=0.0 -! -!ALKEP/WR_SO2=0.0 -! -!ALKEP/WR_SULF=0.0 -! -!ALKEP/WR_HCHO=0.0 -! -!ALKEP/WR_ORA1=0.0 -! -!ALKEP/WR_ORA2=0.0 -! -!ALKEP/WR_MO2=0.0 -! -!ALKEP/WR_OP1=0.0 -! -!ALKEP/WR_ASO3=0.0 -! -!ALKEP/WR_ASO4=0.0 -! -!ALKEP/WR_ASO5=0.0 -! -!ALKEP/WR_AHSO5=0.0 -! -!ALKEP/WR_AHMS=0.0 -! -RETURN -END SUBROUTINE SUBJ6 -! -SUBROUTINE SUBJ7 -! -!Indices 36 a 40 -! -! -!BIOP/O3=0.0 -! -!BIOP/H2O2=0.0 -! -!BIOP/NO=-K093*<BIOP> - PJAC(:,36,3)=-TPK%K093(:)*PCONC(:,36) -! -!BIOP/NO2=0.0 -! -!BIOP/NO3=-K122*<BIOP> - PJAC(:,36,5)=-TPK%K122(:)*PCONC(:,36) -! -!BIOP/N2O5=0.0 -! -!BIOP/HONO=0.0 -! -!BIOP/HNO3=0.0 -! -!BIOP/HNO4=0.0 -! -!BIOP/NH3=0.0 -! -!BIOP/DMS=0.0 -! -!BIOP/SO2=0.0 -! -!BIOP/SULF=0.0 -! -!BIOP/CO=0.0 -! -!BIOP/OH=+0.00000*K059*<ALKE>+1.00000*K060*<BIO> - PJAC(:,36,15)=+0.00000*TPK%K059(:)*PCONC(:,20)+1.00000*TPK%K060(:)*PCONC(:,21) -! -!BIOP/HO2=-K0100*<BIOP> - PJAC(:,36,16)=-TPK%K0100(:)*PCONC(:,36) -! -!BIOP/CH4=0.0 -! -!BIOP/ETH=0.0 -! -!BIOP/ALKA=0.0 -! -!BIOP/ALKE=+0.00000*K059*<OH> - PJAC(:,36,20)=+0.00000*TPK%K059(:)*PCONC(:,15) -! -!BIOP/BIO=+1.00000*K060*<OH> - PJAC(:,36,21)=+1.00000*TPK%K060(:)*PCONC(:,15) -! -!BIOP/ARO=0.0 -! -!BIOP/HCHO=0.0 -! -!BIOP/ALD=0.0 -! -!BIOP/KET=0.0 -! -!BIOP/CARBO=0.0 -! -!BIOP/ONIT=0.0 -! -!BIOP/PAN=0.0 -! -!BIOP/OP1=0.0 -! -!BIOP/OP2=0.0 -! -!BIOP/ORA1=0.0 -! -!BIOP/ORA2=0.0 -! -!BIOP/MO2=-K107*<BIOP> - PJAC(:,36,33)=-TPK%K107(:)*PCONC(:,36) -! -!BIOP/ALKAP=0.0 -! -!BIOP/ALKEP=0.0 -! -!BIOP/BIOP=-K093*<NO>-K0100*<HO2>-K107*<MO2>-K113*<CARBOP>-K122*<NO3> - PJAC(:,36,36)=-TPK%K093(:)*PCONC(:,3)-TPK%K0100(:)*PCONC(:,16)-TPK%K107(:)*PCO& -&NC(:,33)-TPK%K113(:)*PCONC(:,40)-TPK%K122(:)*PCONC(:,5) -! -!BIOP/PHO=0.0 -! -!BIOP/ADD=0.0 -! -!BIOP/AROP=0.0 -! -!BIOP/CARBOP=-K113*<BIOP> - PJAC(:,36,40)=-TPK%K113(:)*PCONC(:,36) -! -!BIOP/OLN=0.0 -! -!BIOP/XO2=0.0 -! -!BIOP/WC_O3=0.0 -! -!BIOP/WC_H2O2=0.0 -! -!BIOP/WC_NO=0.0 -! -!BIOP/WC_NO2=0.0 -! -!BIOP/WC_NO3=0.0 -! -!BIOP/WC_N2O5=0.0 -! -!BIOP/WC_HONO=0.0 -! -!BIOP/WC_HNO3=0.0 -! -!BIOP/WC_HNO4=0.0 -! -!BIOP/WC_NH3=0.0 -! -!BIOP/WC_OH=0.0 -! -!BIOP/WC_HO2=0.0 -! -!BIOP/WC_CO2=0.0 -! -!BIOP/WC_SO2=0.0 -! -!BIOP/WC_SULF=0.0 -! -!BIOP/WC_HCHO=0.0 -! -!BIOP/WC_ORA1=0.0 -! -!BIOP/WC_ORA2=0.0 -! -!BIOP/WC_MO2=0.0 -! -!BIOP/WC_OP1=0.0 -! -!BIOP/WC_ASO3=0.0 -! -!BIOP/WC_ASO4=0.0 -! -!BIOP/WC_ASO5=0.0 -! -!BIOP/WC_AHSO5=0.0 -! -!BIOP/WC_AHMS=0.0 -! -!BIOP/WR_O3=0.0 -! -!BIOP/WR_H2O2=0.0 -! -!BIOP/WR_NO=0.0 -! -!BIOP/WR_NO2=0.0 -! -!BIOP/WR_NO3=0.0 -! -!BIOP/WR_N2O5=0.0 -! -!BIOP/WR_HONO=0.0 -! -!BIOP/WR_HNO3=0.0 -! -!BIOP/WR_HNO4=0.0 -! -!BIOP/WR_NH3=0.0 -! -!BIOP/WR_OH=0.0 -! -!BIOP/WR_HO2=0.0 -! -!BIOP/WR_CO2=0.0 -! -!BIOP/WR_SO2=0.0 -! -!BIOP/WR_SULF=0.0 -! -!BIOP/WR_HCHO=0.0 -! -!BIOP/WR_ORA1=0.0 -! -!BIOP/WR_ORA2=0.0 -! -!BIOP/WR_MO2=0.0 -! -!BIOP/WR_OP1=0.0 -! -!BIOP/WR_ASO3=0.0 -! -!BIOP/WR_ASO4=0.0 -! -!BIOP/WR_ASO5=0.0 -! -!BIOP/WR_AHSO5=0.0 -! -!BIOP/WR_AHMS=0.0 -! -!PHO/O3=0.0 -! -!PHO/H2O2=0.0 -! -!PHO/NO=0.0 -! -!PHO/NO2=-K083*<PHO> - PJAC(:,37,4)=-TPK%K083(:)*PCONC(:,37) -! -!PHO/NO3=+K075*<ARO> - PJAC(:,37,5)=+TPK%K075(:)*PCONC(:,22) -! -!PHO/N2O5=0.0 -! -!PHO/HONO=0.0 -! -!PHO/HNO3=0.0 -! -!PHO/HNO4=0.0 -! -!PHO/NH3=0.0 -! -!PHO/DMS=0.0 -! -!PHO/SO2=0.0 -! -!PHO/SULF=0.0 -! -!PHO/CO=0.0 -! -!PHO/OH=+0.00276*K061*<ARO> - PJAC(:,37,15)=+0.00276*TPK%K061(:)*PCONC(:,22) -! -!PHO/HO2=-K084*<PHO> - PJAC(:,37,16)=-TPK%K084(:)*PCONC(:,37) -! -!PHO/CH4=0.0 -! -!PHO/ETH=0.0 -! -!PHO/ALKA=0.0 -! -!PHO/ALKE=0.0 -! -!PHO/BIO=0.0 -! -!PHO/ARO=+0.00276*K061*<OH>+K075*<NO3> - PJAC(:,37,22)=+0.00276*TPK%K061(:)*PCONC(:,15)+TPK%K075(:)*PCONC(:,5) -! -!PHO/HCHO=0.0 -! -!PHO/ALD=0.0 -! -!PHO/KET=0.0 -! -!PHO/CARBO=0.0 -! -!PHO/ONIT=0.0 -! -!PHO/PAN=0.0 -! -!PHO/OP1=0.0 -! -!PHO/OP2=0.0 -! -!PHO/ORA1=0.0 -! -!PHO/ORA2=0.0 -! -!PHO/MO2=0.0 -! -!PHO/ALKAP=0.0 -! -!PHO/ALKEP=0.0 -! -!PHO/BIOP=0.0 -! -!PHO/PHO=-K083*<NO2>-K084*<HO2> - PJAC(:,37,37)=-TPK%K083(:)*PCONC(:,4)-TPK%K084(:)*PCONC(:,16) -! -!PHO/ADD=0.0 -! -!PHO/AROP=0.0 -! -!PHO/CARBOP=0.0 -! -!PHO/OLN=0.0 -! -!PHO/XO2=0.0 -! -!PHO/WC_O3=0.0 -! -!PHO/WC_H2O2=0.0 -! -!PHO/WC_NO=0.0 -! -!PHO/WC_NO2=0.0 -! -!PHO/WC_NO3=0.0 -! -!PHO/WC_N2O5=0.0 -! -!PHO/WC_HONO=0.0 -! -!PHO/WC_HNO3=0.0 -! -!PHO/WC_HNO4=0.0 -! -!PHO/WC_NH3=0.0 -! -!PHO/WC_OH=0.0 -! -!PHO/WC_HO2=0.0 -! -!PHO/WC_CO2=0.0 -! -!PHO/WC_SO2=0.0 -! -!PHO/WC_SULF=0.0 -! -!PHO/WC_HCHO=0.0 -! -!PHO/WC_ORA1=0.0 -! -!PHO/WC_ORA2=0.0 -! -!PHO/WC_MO2=0.0 -! -!PHO/WC_OP1=0.0 -! -!PHO/WC_ASO3=0.0 -! -!PHO/WC_ASO4=0.0 -! -!PHO/WC_ASO5=0.0 -! -!PHO/WC_AHSO5=0.0 -! -!PHO/WC_AHMS=0.0 -! -!PHO/WR_O3=0.0 -! -!PHO/WR_H2O2=0.0 -! -!PHO/WR_NO=0.0 -! -!PHO/WR_NO2=0.0 -! -!PHO/WR_NO3=0.0 -! -!PHO/WR_N2O5=0.0 -! -!PHO/WR_HONO=0.0 -! -!PHO/WR_HNO3=0.0 -! -!PHO/WR_HNO4=0.0 -! -!PHO/WR_NH3=0.0 -! -!PHO/WR_OH=0.0 -! -!PHO/WR_HO2=0.0 -! -!PHO/WR_CO2=0.0 -! -!PHO/WR_SO2=0.0 -! -!PHO/WR_SULF=0.0 -! -!PHO/WR_HCHO=0.0 -! -!PHO/WR_ORA1=0.0 -! -!PHO/WR_ORA2=0.0 -! -!PHO/WR_MO2=0.0 -! -!PHO/WR_OP1=0.0 -! -!PHO/WR_ASO3=0.0 -! -!PHO/WR_ASO4=0.0 -! -!PHO/WR_ASO5=0.0 -! -!PHO/WR_AHSO5=0.0 -! -!PHO/WR_AHMS=0.0 -! -!ADD/O3=-K087*<ADD> - PJAC(:,38,1)=-TPK%K087(:)*PCONC(:,38) -! -!ADD/H2O2=0.0 -! -!ADD/NO=0.0 -! -!ADD/NO2=-K085*<ADD> - PJAC(:,38,4)=-TPK%K085(:)*PCONC(:,38) -! -!ADD/NO3=0.0 -! -!ADD/N2O5=0.0 -! -!ADD/HONO=0.0 -! -!ADD/HNO3=0.0 -! -!ADD/HNO4=0.0 -! -!ADD/NH3=0.0 -! -!ADD/DMS=0.0 -! -!ADD/SO2=0.0 -! -!ADD/SULF=0.0 -! -!ADD/CO=0.0 -! -!ADD/OH=+0.93968*K061*<ARO> - PJAC(:,38,15)=+0.93968*TPK%K061(:)*PCONC(:,22) -! -!ADD/HO2=0.0 -! -!ADD/CH4=0.0 -! -!ADD/ETH=0.0 -! -!ADD/ALKA=0.0 -! -!ADD/ALKE=0.0 -! -!ADD/BIO=0.0 -! -!ADD/ARO=+0.93968*K061*<OH> - PJAC(:,38,22)=+0.93968*TPK%K061(:)*PCONC(:,15) -! -!ADD/HCHO=0.0 -! -!ADD/ALD=0.0 -! -!ADD/KET=0.0 -! -!ADD/CARBO=0.0 -! -!ADD/ONIT=0.0 -! -!ADD/PAN=0.0 -! -!ADD/OP1=0.0 -! -!ADD/OP2=0.0 -! -!ADD/ORA1=0.0 -! -!ADD/ORA2=0.0 -! -!ADD/MO2=0.0 -! -!ADD/ALKAP=0.0 -! -!ADD/ALKEP=0.0 -! -!ADD/BIOP=0.0 -! -!ADD/PHO=0.0 -! -!ADD/ADD=-K085*<NO2>-K086*<O2>-K087*<O3> - PJAC(:,38,38)=-TPK%K085(:)*PCONC(:,4)-TPK%K086(:)*TPK%O2(:)-TPK%K087(:)*PCONC(& -&:,1) -! -!ADD/AROP=0.0 -! -!ADD/CARBOP=0.0 -! -!ADD/OLN=0.0 -! -!ADD/XO2=0.0 -! -!ADD/WC_O3=0.0 -! -!ADD/WC_H2O2=0.0 -! -!ADD/WC_NO=0.0 -! -!ADD/WC_NO2=0.0 -! -!ADD/WC_NO3=0.0 -! -!ADD/WC_N2O5=0.0 -! -!ADD/WC_HONO=0.0 -! -!ADD/WC_HNO3=0.0 -! -!ADD/WC_HNO4=0.0 -! -!ADD/WC_NH3=0.0 -! -!ADD/WC_OH=0.0 -! -!ADD/WC_HO2=0.0 -! -!ADD/WC_CO2=0.0 -! -!ADD/WC_SO2=0.0 -! -!ADD/WC_SULF=0.0 -! -!ADD/WC_HCHO=0.0 -! -!ADD/WC_ORA1=0.0 -! -!ADD/WC_ORA2=0.0 -! -!ADD/WC_MO2=0.0 -! -!ADD/WC_OP1=0.0 -! -!ADD/WC_ASO3=0.0 -! -!ADD/WC_ASO4=0.0 -! -!ADD/WC_ASO5=0.0 -! -!ADD/WC_AHSO5=0.0 -! -!ADD/WC_AHMS=0.0 -! -!ADD/WR_O3=0.0 -! -!ADD/WR_H2O2=0.0 -! -!ADD/WR_NO=0.0 -! -!ADD/WR_NO2=0.0 -! -!ADD/WR_NO3=0.0 -! -!ADD/WR_N2O5=0.0 -! -!ADD/WR_HONO=0.0 -! -!ADD/WR_HNO3=0.0 -! -!ADD/WR_HNO4=0.0 -! -!ADD/WR_NH3=0.0 -! -!ADD/WR_OH=0.0 -! -!ADD/WR_HO2=0.0 -! -!ADD/WR_CO2=0.0 -! -!ADD/WR_SO2=0.0 -! -!ADD/WR_SULF=0.0 -! -!ADD/WR_HCHO=0.0 -! -!ADD/WR_ORA1=0.0 -! -!ADD/WR_ORA2=0.0 -! -!ADD/WR_MO2=0.0 -! -!ADD/WR_OP1=0.0 -! -!ADD/WR_ASO3=0.0 -! -!ADD/WR_ASO4=0.0 -! -!ADD/WR_ASO5=0.0 -! -!ADD/WR_AHSO5=0.0 -! -!ADD/WR_AHMS=0.0 -! -!AROP/O3=0.0 -! -!AROP/H2O2=0.0 -! -!AROP/NO=-K094*<AROP> - PJAC(:,39,3)=-TPK%K094(:)*PCONC(:,39) -! -!AROP/NO2=0.0 -! -!AROP/NO3=-K123*<AROP> - PJAC(:,39,5)=-TPK%K123(:)*PCONC(:,39) -! -!AROP/N2O5=0.0 -! -!AROP/HONO=0.0 -! -!AROP/HNO3=0.0 -! -!AROP/HNO4=0.0 -! -!AROP/NH3=0.0 -! -!AROP/DMS=0.0 -! -!AROP/SO2=0.0 -! -!AROP/SULF=0.0 -! -!AROP/CO=0.0 -! -!AROP/OH=0.0 -! -!AROP/HO2=-K0101*<AROP> - PJAC(:,39,16)=-TPK%K0101(:)*PCONC(:,39) -! -!AROP/CH4=0.0 -! -!AROP/ETH=0.0 -! -!AROP/ALKA=0.0 -! -!AROP/ALKE=0.0 -! -!AROP/BIO=0.0 -! -!AROP/ARO=0.0 -! -!AROP/HCHO=0.0 -! -!AROP/ALD=0.0 -! -!AROP/KET=0.0 -! -!AROP/CARBO=0.0 -! -!AROP/ONIT=0.0 -! -!AROP/PAN=0.0 -! -!AROP/OP1=0.0 -! -!AROP/OP2=0.0 -! -!AROP/ORA1=0.0 -! -!AROP/ORA2=0.0 -! -!AROP/MO2=-K108*<AROP> - PJAC(:,39,33)=-TPK%K108(:)*PCONC(:,39) -! -!AROP/ALKAP=0.0 -! -!AROP/ALKEP=0.0 -! -!AROP/BIOP=0.0 -! -!AROP/PHO=0.0 -! -!AROP/ADD=+0.98*K086*<O2> - PJAC(:,39,38)=+0.98*TPK%K086(:)*TPK%O2(:) -! -!AROP/AROP=-K094*<NO>-K0101*<HO2>-K108*<MO2>-K114*<CARBOP>-K123*<NO3> - PJAC(:,39,39)=-TPK%K094(:)*PCONC(:,3)-TPK%K0101(:)*PCONC(:,16)-TPK%K108(:)*PCO& -&NC(:,33)-TPK%K114(:)*PCONC(:,40)-TPK%K123(:)*PCONC(:,5) -! -!AROP/CARBOP=-K114*<AROP> - PJAC(:,39,40)=-TPK%K114(:)*PCONC(:,39) -! -!AROP/OLN=0.0 -! -!AROP/XO2=0.0 -! -!AROP/WC_O3=0.0 -! -!AROP/WC_H2O2=0.0 -! -!AROP/WC_NO=0.0 -! -!AROP/WC_NO2=0.0 -! -!AROP/WC_NO3=0.0 -! -!AROP/WC_N2O5=0.0 -! -!AROP/WC_HONO=0.0 -! -!AROP/WC_HNO3=0.0 -! -!AROP/WC_HNO4=0.0 -! -!AROP/WC_NH3=0.0 -! -!AROP/WC_OH=0.0 -! -!AROP/WC_HO2=0.0 -! -!AROP/WC_CO2=0.0 -! -!AROP/WC_SO2=0.0 -! -!AROP/WC_SULF=0.0 -! -!AROP/WC_HCHO=0.0 -! -!AROP/WC_ORA1=0.0 -! -!AROP/WC_ORA2=0.0 -! -!AROP/WC_MO2=0.0 -! -!AROP/WC_OP1=0.0 -! -!AROP/WC_ASO3=0.0 -! -!AROP/WC_ASO4=0.0 -! -!AROP/WC_ASO5=0.0 -! -!AROP/WC_AHSO5=0.0 -! -!AROP/WC_AHMS=0.0 -! -!AROP/WR_O3=0.0 -! -!AROP/WR_H2O2=0.0 -! -!AROP/WR_NO=0.0 -! -!AROP/WR_NO2=0.0 -! -!AROP/WR_NO3=0.0 -! -!AROP/WR_N2O5=0.0 -! -!AROP/WR_HONO=0.0 -! -!AROP/WR_HNO3=0.0 -! -!AROP/WR_HNO4=0.0 -! -!AROP/WR_NH3=0.0 -! -!AROP/WR_OH=0.0 -! -!AROP/WR_HO2=0.0 -! -!AROP/WR_CO2=0.0 -! -!AROP/WR_SO2=0.0 -! -!AROP/WR_SULF=0.0 -! -!AROP/WR_HCHO=0.0 -! -!AROP/WR_ORA1=0.0 -! -!AROP/WR_ORA2=0.0 -! -!AROP/WR_MO2=0.0 -! -!AROP/WR_OP1=0.0 -! -!AROP/WR_ASO3=0.0 -! -!AROP/WR_ASO4=0.0 -! -!AROP/WR_ASO5=0.0 -! -!AROP/WR_AHSO5=0.0 -! -!AROP/WR_AHMS=0.0 -! -!CARBOP/O3=+0.05705*K079*<ALKE>+0.17000*K080*<BIO>+0.27460*K081*<CARBO>+0.70000 -!*K082*<PAN> - PJAC(:,40,1)=+0.05705*TPK%K079(:)*PCONC(:,20)+0.17000*TPK%K080(:)*PCONC(:,21)+& -&0.27460*TPK%K081(:)*PCONC(:,26)+0.70000*TPK%K082(:)*PCONC(:,28) -! -!CARBOP/H2O2=0.0 -! -!CARBOP/NO=+0.09532*K095*<CARBOP>-K095*<CARBOP> - PJAC(:,40,3)=+0.09532*TPK%K095(:)*PCONC(:,40)-TPK%K095(:)*PCONC(:,40) -! -!CARBOP/NO2=-K088*<CARBOP> - PJAC(:,40,4)=-TPK%K088(:)*PCONC(:,40) -! -!CARBOP/NO3=+1.00000*K073*<ALD>+0.38881*K074*<CARBO>+0.03175*K124*<CARBOP>-K124 -!*<CARBOP> - PJAC(:,40,5)=+1.00000*TPK%K073(:)*PCONC(:,24)+0.38881*TPK%K074(:)*PCONC(:,26)+& -&0.03175*TPK%K124(:)*PCONC(:,40)-TPK%K124(:)*PCONC(:,40) -! -!CARBOP/N2O5=0.0 -! -!CARBOP/HONO=0.0 -! -!CARBOP/HNO3=0.0 -! -!CARBOP/HNO4=0.0 -! -!CARBOP/NH3=0.0 -! -!CARBOP/DMS=0.0 -! -!CARBOP/SO2=0.0 -! -!CARBOP/SULF=0.0 -! -!CARBOP/CO=0.0 -! -!CARBOP/OH=+1.00000*K063*<ALD>+1.00000*K064*<KET>+0.51419*K065*<CARBO>+0.05413* -!K069*<OP2> - PJAC(:,40,15)=+1.00000*TPK%K063(:)*PCONC(:,24)+1.00000*TPK%K064(:)*PCONC(:,25)& -&+0.51419*TPK%K065(:)*PCONC(:,26)+0.05413*TPK%K069(:)*PCONC(:,30) -! -!CARBOP/HO2=-K0102*<CARBOP> - PJAC(:,40,16)=-TPK%K0102(:)*PCONC(:,40) -! -!CARBOP/CH4=0.0 -! -!CARBOP/ETH=0.0 -! -!CARBOP/ALKA=0.0 -! -!CARBOP/ALKE=+0.05705*K079*<O3> - PJAC(:,40,20)=+0.05705*TPK%K079(:)*PCONC(:,1) -! -!CARBOP/BIO=+0.17000*K080*<O3> - PJAC(:,40,21)=+0.17000*TPK%K080(:)*PCONC(:,1) -! -!CARBOP/ARO=0.0 -! -!CARBOP/HCHO=0.0 -! -!CARBOP/ALD=+1.00000*K063*<OH>+1.00000*K073*<NO3> - PJAC(:,40,24)=+1.00000*TPK%K063(:)*PCONC(:,15)+1.00000*TPK%K073(:)*PCONC(:,5) -! -!CARBOP/KET=+1.00000*K015+1.00000*K064*<OH> - PJAC(:,40,25)=+1.00000*TPK%K015(:)+1.00000*TPK%K064(:)*PCONC(:,15) -! -!CARBOP/CARBO=+0.69622*K016+0.51419*K065*<OH>+0.38881*K074*<NO3>+0.27460*K081*< -!O3> - PJAC(:,40,26)=+0.69622*TPK%K016(:)+0.51419*TPK%K065(:)*PCONC(:,15)+0.38881*TPK& -&%K074(:)*PCONC(:,5)+0.27460*TPK%K081(:)*PCONC(:,1) -! -!CARBOP/ONIT=0.0 -! -!CARBOP/PAN=+0.70000*K082*<O3>+1.00000*K089 - PJAC(:,40,28)=+0.70000*TPK%K082(:)*PCONC(:,1)+1.00000*TPK%K089(:) -! -!CARBOP/OP1=0.0 -! -!CARBOP/OP2=+0.05413*K069*<OH> - PJAC(:,40,30)=+0.05413*TPK%K069(:)*PCONC(:,15) -! -!CARBOP/ORA1=0.0 -! -!CARBOP/ORA2=0.0 -! -!CARBOP/MO2=+0.05954*K109*<CARBOP>-K109*<CARBOP> - PJAC(:,40,33)=+0.05954*TPK%K109(:)*PCONC(:,40)-TPK%K109(:)*PCONC(:,40) -! -!CARBOP/ALKAP=-K111*<CARBOP> - PJAC(:,40,34)=-TPK%K111(:)*PCONC(:,40) -! -!CARBOP/ALKEP=-K112*<CARBOP> - PJAC(:,40,35)=-TPK%K112(:)*PCONC(:,40) -! -!CARBOP/BIOP=-K113*<CARBOP> - PJAC(:,40,36)=-TPK%K113(:)*PCONC(:,40) -! -!CARBOP/PHO=0.0 -! -!CARBOP/ADD=0.0 -! -!CARBOP/AROP=-K114*<CARBOP> - PJAC(:,40,39)=-TPK%K114(:)*PCONC(:,40) -! -!CARBOP/CARBOP=-K088*<NO2>+0.09532*K095*<NO>-K095*<NO>-K0102*<HO2>+0.05954*K109 -!*<MO2>-K109*<MO2>-K111*<ALKAP>-K112*<ALKEP>-K113*<BIOP>-K114*<AROP>+0.05821*K1 -!15*<CARBOP>+0.05821*K115*<CARBOP>-K115*<CARBOP>-K115*<CARBOP>-K115*<CARBOP>-K1 -!15*<CARBOP>-K116*<OLN>+0.03175*K124*<NO3>-K124*<NO3>-K128*<XO2> - PJAC(:,40,40)=-TPK%K088(:)*PCONC(:,4)+0.09532*TPK%K095(:)*PCONC(:,3)-TPK%K095(& -&:)*PCONC(:,3)-TPK%K0102(:)*PCONC(:,16)+0.05954*TPK%K109(:)*PCONC(:,33)-TPK%K10& -&9(:)*PCONC(:,33)-TPK%K111(:)*PCONC(:,34)-TPK%K112(:)*PCONC(:,35)-TPK%K113(:)*P& -&CONC(:,36)-TPK%K114(:)*PCONC(:,39)+0.05821*TPK%K115(:)*PCONC(:,40)+0.05821*TPK& -&%K115(:)*PCONC(:,40)-TPK%K115(:)*PCONC(:,40)-TPK%K115(:)*PCONC(:,40)-TPK%K115(& -&:)*PCONC(:,40)-TPK%K115(:)*PCONC(:,40)-TPK%K116(:)*PCONC(:,41)+0.03175*TPK%K12& -&4(:)*PCONC(:,5)-TPK%K124(:)*PCONC(:,5)-TPK%K128(:)*PCONC(:,42) -! -!CARBOP/OLN=-K116*<CARBOP> - PJAC(:,40,41)=-TPK%K116(:)*PCONC(:,40) -! -!CARBOP/XO2=-K128*<CARBOP> - PJAC(:,40,42)=-TPK%K128(:)*PCONC(:,40) -! -!CARBOP/WC_O3=0.0 -! -!CARBOP/WC_H2O2=0.0 -! -!CARBOP/WC_NO=0.0 -! -!CARBOP/WC_NO2=0.0 -! -!CARBOP/WC_NO3=0.0 -! -!CARBOP/WC_N2O5=0.0 -! -!CARBOP/WC_HONO=0.0 -! -!CARBOP/WC_HNO3=0.0 -! -!CARBOP/WC_HNO4=0.0 -! -!CARBOP/WC_NH3=0.0 -! -!CARBOP/WC_OH=0.0 -! -!CARBOP/WC_HO2=0.0 -! -!CARBOP/WC_CO2=0.0 -! -!CARBOP/WC_SO2=0.0 -! -!CARBOP/WC_SULF=0.0 -! -!CARBOP/WC_HCHO=0.0 -! -!CARBOP/WC_ORA1=0.0 -! -!CARBOP/WC_ORA2=0.0 -! -!CARBOP/WC_MO2=0.0 -! -!CARBOP/WC_OP1=0.0 -! -!CARBOP/WC_ASO3=0.0 -! -!CARBOP/WC_ASO4=0.0 -! -!CARBOP/WC_ASO5=0.0 -! -!CARBOP/WC_AHSO5=0.0 -! -!CARBOP/WC_AHMS=0.0 -! -!CARBOP/WR_O3=0.0 -! -!CARBOP/WR_H2O2=0.0 -! -!CARBOP/WR_NO=0.0 -! -!CARBOP/WR_NO2=0.0 -! -!CARBOP/WR_NO3=0.0 -! -!CARBOP/WR_N2O5=0.0 -! -!CARBOP/WR_HONO=0.0 -! -!CARBOP/WR_HNO3=0.0 -! -!CARBOP/WR_HNO4=0.0 -! -!CARBOP/WR_NH3=0.0 -! -!CARBOP/WR_OH=0.0 -! -!CARBOP/WR_HO2=0.0 -! -!CARBOP/WR_CO2=0.0 -! -!CARBOP/WR_SO2=0.0 -! -!CARBOP/WR_SULF=0.0 -! -!CARBOP/WR_HCHO=0.0 -! -!CARBOP/WR_ORA1=0.0 -! -!CARBOP/WR_ORA2=0.0 -! -!CARBOP/WR_MO2=0.0 -! -!CARBOP/WR_OP1=0.0 -! -!CARBOP/WR_ASO3=0.0 -! -!CARBOP/WR_ASO4=0.0 -! -!CARBOP/WR_ASO5=0.0 -! -!CARBOP/WR_AHSO5=0.0 -! -!CARBOP/WR_AHMS=0.0 -! -RETURN -END SUBROUTINE SUBJ7 -! -SUBROUTINE SUBJ8 -! -!Indices 41 a 45 -! -! -!OLN/O3=0.0 -! -!OLN/H2O2=0.0 -! -!OLN/NO=-K096*<OLN> - PJAC(:,41,3)=-TPK%K096(:)*PCONC(:,41) -! -!OLN/NO2=0.0 -! -!OLN/NO3=+0.00000*K074*<CARBO>+0.93768*K076*<ALKE>+1.00000*K077*<BIO>-K125*<OLN -!> - PJAC(:,41,5)=+0.00000*TPK%K074(:)*PCONC(:,26)+0.93768*TPK%K076(:)*PCONC(:,20)+& -&1.00000*TPK%K077(:)*PCONC(:,21)-TPK%K125(:)*PCONC(:,41) -! -!OLN/N2O5=0.0 -! -!OLN/HONO=0.0 -! -!OLN/HNO3=0.0 -! -!OLN/HNO4=0.0 -! -!OLN/NH3=0.0 -! -!OLN/DMS=0.0 -! -!OLN/SO2=0.0 -! -!OLN/SULF=0.0 -! -!OLN/CO=0.0 -! -!OLN/OH=0.0 -! -!OLN/HO2=-K103*<OLN> - PJAC(:,41,16)=-TPK%K103(:)*PCONC(:,41) -! -!OLN/CH4=0.0 -! -!OLN/ETH=0.0 -! -!OLN/ALKA=0.0 -! -!OLN/ALKE=+0.93768*K076*<NO3> - PJAC(:,41,20)=+0.93768*TPK%K076(:)*PCONC(:,5) -! -!OLN/BIO=+1.00000*K077*<NO3> - PJAC(:,41,21)=+1.00000*TPK%K077(:)*PCONC(:,5) -! -!OLN/ARO=0.0 -! -!OLN/HCHO=0.0 -! -!OLN/ALD=0.0 -! -!OLN/KET=0.0 -! -!OLN/CARBO=+0.00000*K074*<NO3> - PJAC(:,41,26)=+0.00000*TPK%K074(:)*PCONC(:,5) -! -!OLN/ONIT=0.0 -! -!OLN/PAN=0.0 -! -!OLN/OP1=0.0 -! -!OLN/OP2=0.0 -! -!OLN/ORA1=0.0 -! -!OLN/ORA2=0.0 -! -!OLN/MO2=-K110*<OLN> - PJAC(:,41,33)=-TPK%K110(:)*PCONC(:,41) -! -!OLN/ALKAP=0.0 -! -!OLN/ALKEP=0.0 -! -!OLN/BIOP=0.0 -! -!OLN/PHO=0.0 -! -!OLN/ADD=0.0 -! -!OLN/AROP=0.0 -! -!OLN/CARBOP=-K116*<OLN> - PJAC(:,41,40)=-TPK%K116(:)*PCONC(:,41) -! -!OLN/OLN=-K096*<NO>-K103*<HO2>-K110*<MO2>-K116*<CARBOP>-K117*<OLN>-K117*<OLN>-K -!117*<OLN>-K117*<OLN>-K118*<OLN>-K118*<OLN>-K118*<OLN>-K118*<OLN>-K125*<NO3> - PJAC(:,41,41)=-TPK%K096(:)*PCONC(:,3)-TPK%K103(:)*PCONC(:,16)-TPK%K110(:)*PCON& -&C(:,33)-TPK%K116(:)*PCONC(:,40)-TPK%K117(:)*PCONC(:,41)-TPK%K117(:)*PCONC(:,41& -&)-TPK%K117(:)*PCONC(:,41)-TPK%K117(:)*PCONC(:,41)-TPK%K118(:)*PCONC(:,41)-TPK%& -&K118(:)*PCONC(:,41)-TPK%K118(:)*PCONC(:,41)-TPK%K118(:)*PCONC(:,41)-TPK%K125(:& -&)*PCONC(:,5) -! -!OLN/XO2=0.0 -! -!OLN/WC_O3=0.0 -! -!OLN/WC_H2O2=0.0 -! -!OLN/WC_NO=0.0 -! -!OLN/WC_NO2=0.0 -! -!OLN/WC_NO3=0.0 -! -!OLN/WC_N2O5=0.0 -! -!OLN/WC_HONO=0.0 -! -!OLN/WC_HNO3=0.0 -! -!OLN/WC_HNO4=0.0 -! -!OLN/WC_NH3=0.0 -! -!OLN/WC_OH=0.0 -! -!OLN/WC_HO2=0.0 -! -!OLN/WC_CO2=0.0 -! -!OLN/WC_SO2=0.0 -! -!OLN/WC_SULF=0.0 -! -!OLN/WC_HCHO=0.0 -! -!OLN/WC_ORA1=0.0 -! -!OLN/WC_ORA2=0.0 -! -!OLN/WC_MO2=0.0 -! -!OLN/WC_OP1=0.0 -! -!OLN/WC_ASO3=0.0 -! -!OLN/WC_ASO4=0.0 -! -!OLN/WC_ASO5=0.0 -! -!OLN/WC_AHSO5=0.0 -! -!OLN/WC_AHMS=0.0 -! -!OLN/WR_O3=0.0 -! -!OLN/WR_H2O2=0.0 -! -!OLN/WR_NO=0.0 -! -!OLN/WR_NO2=0.0 -! -!OLN/WR_NO3=0.0 -! -!OLN/WR_N2O5=0.0 -! -!OLN/WR_HONO=0.0 -! -!OLN/WR_HNO3=0.0 -! -!OLN/WR_HNO4=0.0 -! -!OLN/WR_NH3=0.0 -! -!OLN/WR_OH=0.0 -! -!OLN/WR_HO2=0.0 -! -!OLN/WR_CO2=0.0 -! -!OLN/WR_SO2=0.0 -! -!OLN/WR_SULF=0.0 -! -!OLN/WR_HCHO=0.0 -! -!OLN/WR_ORA1=0.0 -! -!OLN/WR_ORA2=0.0 -! -!OLN/WR_MO2=0.0 -! -!OLN/WR_OP1=0.0 -! -!OLN/WR_ASO3=0.0 -! -!OLN/WR_ASO4=0.0 -! -!OLN/WR_ASO5=0.0 -! -!OLN/WR_AHSO5=0.0 -! -!OLN/WR_AHMS=0.0 -! -!XO2/O3=+0.00000*K079*<ALKE>+0.13000*K080*<BIO> - PJAC(:,42,1)=+0.00000*TPK%K079(:)*PCONC(:,20)+0.13000*TPK%K080(:)*PCONC(:,21) -! -!XO2/H2O2=0.0 -! -!XO2/NO=+0.13007*K091*<ALKAP>+0.02563*K095*<CARBOP>-K130*<XO2> - PJAC(:,42,3)=+0.13007*TPK%K091(:)*PCONC(:,34)+0.02563*TPK%K095(:)*PCONC(:,40)-& -&TPK%K130(:)*PCONC(:,42) -! -!XO2/NO2=0.0 -! -!XO2/NO3=+0.10530*K074*<CARBO>+K078*<PAN>+0.16271*K120*<ALKAP>+0.01021*K124*<CA -!RBOP>-K131*<XO2> - PJAC(:,42,5)=+0.10530*TPK%K074(:)*PCONC(:,26)+TPK%K078(:)*PCONC(:,28)+0.16271*& -&TPK%K120(:)*PCONC(:,34)+0.01021*TPK%K124(:)*PCONC(:,40)-TPK%K131(:)*PCONC(:,42& -&) -! -!XO2/N2O5=0.0 -! -!XO2/HONO=0.0 -! -!XO2/HNO3=0.0 -! -!XO2/HNO4=0.0 -! -!XO2/NH3=0.0 -! -!XO2/DMS=0.0 -! -!XO2/SO2=0.0 -! -!XO2/SULF=0.0 -! -!XO2/CO=0.0 -! -!XO2/OH=+0.10318*K061*<ARO>+0.10162*K065*<CARBO>+0.09333*K069*<OP2>+K070*<PAN> - PJAC(:,42,15)=+0.10318*TPK%K061(:)*PCONC(:,22)+0.10162*TPK%K065(:)*PCONC(:,26)& -&+0.09333*TPK%K069(:)*PCONC(:,30)+TPK%K070(:)*PCONC(:,28) -! -!XO2/HO2=-K126*<XO2> - PJAC(:,42,16)=-TPK%K126(:)*PCONC(:,42) -! -!XO2/CH4=0.0 -! -!XO2/ETH=0.0 -! -!XO2/ALKA=0.0 -! -!XO2/ALKE=+0.00000*K079*<O3> - PJAC(:,42,20)=+0.00000*TPK%K079(:)*PCONC(:,1) -! -!XO2/BIO=+0.15*K054*<O3P>+0.13000*K080*<O3> - PJAC(:,42,21)=+0.15*TPK%K054(:)*TPK%O3P(:)+0.13000*TPK%K080(:)*PCONC(:,1) -! -!XO2/ARO=+0.10318*K061*<OH> - PJAC(:,42,22)=+0.10318*TPK%K061(:)*PCONC(:,15) -! -!XO2/HCHO=0.0 -! -!XO2/ALD=0.0 -! -!XO2/KET=0.0 -! -!XO2/CARBO=+0.10162*K065*<OH>+0.10530*K074*<NO3> - PJAC(:,42,26)=+0.10162*TPK%K065(:)*PCONC(:,15)+0.10530*TPK%K074(:)*PCONC(:,5) -! -!XO2/ONIT=0.0 -! -!XO2/PAN=+K070*<OH>+K078*<NO3> - PJAC(:,42,28)=+TPK%K070(:)*PCONC(:,15)+TPK%K078(:)*PCONC(:,5) -! -!XO2/OP1=0.0 -! -!XO2/OP2=+0.09333*K069*<OH> - PJAC(:,42,30)=+0.09333*TPK%K069(:)*PCONC(:,15) -! -!XO2/ORA1=0.0 -! -!XO2/ORA2=0.0 -! -!XO2/MO2=+0.13370*K105*<ALKAP>+0.02212*K109*<CARBOP>-K127*<XO2> - PJAC(:,42,33)=+0.13370*TPK%K105(:)*PCONC(:,34)+0.02212*TPK%K109(:)*PCONC(:,40)& -&-TPK%K127(:)*PCONC(:,42) -! -!XO2/ALKAP=+0.13007*K091*<NO>+0.13370*K105*<MO2>+0.11306*K111*<CARBOP>+0.16271* -!K120*<NO3> - PJAC(:,42,34)=+0.13007*TPK%K091(:)*PCONC(:,3)+0.13370*TPK%K105(:)*PCONC(:,33)+& -&0.11306*TPK%K111(:)*PCONC(:,40)+0.16271*TPK%K120(:)*PCONC(:,5) -! -!XO2/ALKEP=0.0 -! -!XO2/BIOP=0.0 -! -!XO2/PHO=0.0 -! -!XO2/ADD=0.0 -! -!XO2/AROP=0.0 -! -!XO2/CARBOP=+0.02563*K095*<NO>+0.02212*K109*<MO2>+0.11306*K111*<ALKAP>+0.01593* -!K115*<CARBOP>+0.01593*K115*<CARBOP>+0.01021*K124*<NO3>-K128*<XO2> - PJAC(:,42,40)=+0.02563*TPK%K095(:)*PCONC(:,3)+0.02212*TPK%K109(:)*PCONC(:,33)+& -&0.11306*TPK%K111(:)*PCONC(:,34)+0.01593*TPK%K115(:)*PCONC(:,40)+0.01593*TPK%K1& -&15(:)*PCONC(:,40)+0.01021*TPK%K124(:)*PCONC(:,5)-TPK%K128(:)*PCONC(:,42) -! -!XO2/OLN=0.0 -! -!XO2/XO2=-K126*<HO2>-K127*<MO2>-K128*<CARBOP>-K129*<XO2>-K129*<XO2>-K129*<XO2>- -!K129*<XO2>-K130*<NO>-K131*<NO3> - PJAC(:,42,42)=-TPK%K126(:)*PCONC(:,16)-TPK%K127(:)*PCONC(:,33)-TPK%K128(:)*PCO& -&NC(:,40)-TPK%K129(:)*PCONC(:,42)-TPK%K129(:)*PCONC(:,42)-TPK%K129(:)*PCONC(:,4& -&2)-TPK%K129(:)*PCONC(:,42)-TPK%K130(:)*PCONC(:,3)-TPK%K131(:)*PCONC(:,5) -! -!XO2/WC_O3=0.0 -! -!XO2/WC_H2O2=0.0 -! -!XO2/WC_NO=0.0 -! -!XO2/WC_NO2=0.0 -! -!XO2/WC_NO3=0.0 -! -!XO2/WC_N2O5=0.0 -! -!XO2/WC_HONO=0.0 -! -!XO2/WC_HNO3=0.0 -! -!XO2/WC_HNO4=0.0 -! -!XO2/WC_NH3=0.0 -! -!XO2/WC_OH=0.0 -! -!XO2/WC_HO2=0.0 -! -!XO2/WC_CO2=0.0 -! -!XO2/WC_SO2=0.0 -! -!XO2/WC_SULF=0.0 -! -!XO2/WC_HCHO=0.0 -! -!XO2/WC_ORA1=0.0 -! -!XO2/WC_ORA2=0.0 -! -!XO2/WC_MO2=0.0 -! -!XO2/WC_OP1=0.0 -! -!XO2/WC_ASO3=0.0 -! -!XO2/WC_ASO4=0.0 -! -!XO2/WC_ASO5=0.0 -! -!XO2/WC_AHSO5=0.0 -! -!XO2/WC_AHMS=0.0 -! -!XO2/WR_O3=0.0 -! -!XO2/WR_H2O2=0.0 -! -!XO2/WR_NO=0.0 -! -!XO2/WR_NO2=0.0 -! -!XO2/WR_NO3=0.0 -! -!XO2/WR_N2O5=0.0 -! -!XO2/WR_HONO=0.0 -! -!XO2/WR_HNO3=0.0 -! -!XO2/WR_HNO4=0.0 -! -!XO2/WR_NH3=0.0 -! -!XO2/WR_OH=0.0 -! -!XO2/WR_HO2=0.0 -! -!XO2/WR_CO2=0.0 -! -!XO2/WR_SO2=0.0 -! -!XO2/WR_SULF=0.0 -! -!XO2/WR_HCHO=0.0 -! -!XO2/WR_ORA1=0.0 -! -!XO2/WR_ORA2=0.0 -! -!XO2/WR_MO2=0.0 -! -!XO2/WR_OP1=0.0 -! -!XO2/WR_ASO3=0.0 -! -!XO2/WR_ASO4=0.0 -! -!XO2/WR_ASO5=0.0 -! -!XO2/WR_AHSO5=0.0 -! -!XO2/WR_AHMS=0.0 -! -!WC_O3/O3=+KTC1 - PJAC(:,43,1)=+TPK%KTC1(:) -! -!WC_O3/H2O2=0.0 -! -!WC_O3/NO=0.0 -! -!WC_O3/NO2=0.0 -! -!WC_O3/NO3=0.0 -! -!WC_O3/N2O5=0.0 -! -!WC_O3/HONO=0.0 -! -!WC_O3/HNO3=0.0 -! -!WC_O3/HNO4=0.0 -! -!WC_O3/NH3=0.0 -! -!WC_O3/DMS=0.0 -! -!WC_O3/SO2=0.0 -! -!WC_O3/SULF=0.0 -! -!WC_O3/CO=0.0 -! -!WC_O3/OH=0.0 -! -!WC_O3/HO2=0.0 -! -!WC_O3/CH4=0.0 -! -!WC_O3/ETH=0.0 -! -!WC_O3/ALKA=0.0 -! -!WC_O3/ALKE=0.0 -! -!WC_O3/BIO=0.0 -! -!WC_O3/ARO=0.0 -! -!WC_O3/HCHO=0.0 -! -!WC_O3/ALD=0.0 -! -!WC_O3/KET=0.0 -! -!WC_O3/CARBO=0.0 -! -!WC_O3/ONIT=0.0 -! -!WC_O3/PAN=0.0 -! -!WC_O3/OP1=0.0 -! -!WC_O3/OP2=0.0 -! -!WC_O3/ORA1=0.0 -! -!WC_O3/ORA2=0.0 -! -!WC_O3/MO2=0.0 -! -!WC_O3/ALKAP=0.0 -! -!WC_O3/ALKEP=0.0 -! -!WC_O3/BIOP=0.0 -! -!WC_O3/PHO=0.0 -! -!WC_O3/ADD=0.0 -! -!WC_O3/AROP=0.0 -! -!WC_O3/CARBOP=0.0 -! -!WC_O3/OLN=0.0 -! -!WC_O3/XO2=0.0 -! -!WC_O3/WC_O3=-KTC21-KC6*<WC_HO2>-KC29*<WC_SO2> - PJAC(:,43,43)=-TPK%KTC21(:)-TPK%KC6(:)*PCONC(:,54)-TPK%KC29(:)*PCONC(:,56) -! -!WC_O3/WC_H2O2=0.0 -! -!WC_O3/WC_NO=0.0 -! -!WC_O3/WC_NO2=0.0 -! -!WC_O3/WC_NO3=0.0 -! -!WC_O3/WC_N2O5=0.0 -! -!WC_O3/WC_HONO=0.0 -! -!WC_O3/WC_HNO3=0.0 -! -!WC_O3/WC_HNO4=0.0 -! -!WC_O3/WC_NH3=0.0 -! -!WC_O3/WC_OH=0.0 -! -!WC_O3/WC_HO2=-KC6*<WC_O3> - PJAC(:,43,54)=-TPK%KC6(:)*PCONC(:,43) -! -!WC_O3/WC_CO2=0.0 -! -!WC_O3/WC_SO2=-KC29*<WC_O3> - PJAC(:,43,56)=-TPK%KC29(:)*PCONC(:,43) -! -!WC_O3/WC_SULF=0.0 -! -!WC_O3/WC_HCHO=0.0 -! -!WC_O3/WC_ORA1=0.0 -! -!WC_O3/WC_ORA2=0.0 -! -!WC_O3/WC_MO2=0.0 -! -!WC_O3/WC_OP1=0.0 -! -!WC_O3/WC_ASO3=0.0 -! -!WC_O3/WC_ASO4=0.0 -! -!WC_O3/WC_ASO5=0.0 -! -!WC_O3/WC_AHSO5=0.0 -! -!WC_O3/WC_AHMS=0.0 -! -!WC_O3/WR_O3=0.0 -! -!WC_O3/WR_H2O2=0.0 -! -!WC_O3/WR_NO=0.0 -! -!WC_O3/WR_NO2=0.0 -! -!WC_O3/WR_NO3=0.0 -! -!WC_O3/WR_N2O5=0.0 -! -!WC_O3/WR_HONO=0.0 -! -!WC_O3/WR_HNO3=0.0 -! -!WC_O3/WR_HNO4=0.0 -! -!WC_O3/WR_NH3=0.0 -! -!WC_O3/WR_OH=0.0 -! -!WC_O3/WR_HO2=0.0 -! -!WC_O3/WR_CO2=0.0 -! -!WC_O3/WR_SO2=0.0 -! -!WC_O3/WR_SULF=0.0 -! -!WC_O3/WR_HCHO=0.0 -! -!WC_O3/WR_ORA1=0.0 -! -!WC_O3/WR_ORA2=0.0 -! -!WC_O3/WR_MO2=0.0 -! -!WC_O3/WR_OP1=0.0 -! -!WC_O3/WR_ASO3=0.0 -! -!WC_O3/WR_ASO4=0.0 -! -!WC_O3/WR_ASO5=0.0 -! -!WC_O3/WR_AHSO5=0.0 -! -!WC_O3/WR_AHMS=0.0 -! -!WC_H2O2/O3=0.0 -! -!WC_H2O2/H2O2=+KTC2 - PJAC(:,44,2)=+TPK%KTC2(:) -! -!WC_H2O2/NO=0.0 -! -!WC_H2O2/NO2=0.0 -! -!WC_H2O2/NO3=0.0 -! -!WC_H2O2/N2O5=0.0 -! -!WC_H2O2/HONO=0.0 -! -!WC_H2O2/HNO3=0.0 -! -!WC_H2O2/HNO4=0.0 -! -!WC_H2O2/NH3=0.0 -! -!WC_H2O2/DMS=0.0 -! -!WC_H2O2/SO2=0.0 -! -!WC_H2O2/SULF=0.0 -! -!WC_H2O2/CO=0.0 -! -!WC_H2O2/OH=0.0 -! -!WC_H2O2/HO2=0.0 -! -!WC_H2O2/CH4=0.0 -! -!WC_H2O2/ETH=0.0 -! -!WC_H2O2/ALKA=0.0 -! -!WC_H2O2/ALKE=0.0 -! -!WC_H2O2/BIO=0.0 -! -!WC_H2O2/ARO=0.0 -! -!WC_H2O2/HCHO=0.0 -! -!WC_H2O2/ALD=0.0 -! -!WC_H2O2/KET=0.0 -! -!WC_H2O2/CARBO=0.0 -! -!WC_H2O2/ONIT=0.0 -! -!WC_H2O2/PAN=0.0 -! -!WC_H2O2/OP1=0.0 -! -!WC_H2O2/OP2=0.0 -! -!WC_H2O2/ORA1=0.0 -! -!WC_H2O2/ORA2=0.0 -! -!WC_H2O2/MO2=0.0 -! -!WC_H2O2/ALKAP=0.0 -! -!WC_H2O2/ALKEP=0.0 -! -!WC_H2O2/BIOP=0.0 -! -!WC_H2O2/PHO=0.0 -! -!WC_H2O2/ADD=0.0 -! -!WC_H2O2/AROP=0.0 -! -!WC_H2O2/CARBOP=0.0 -! -!WC_H2O2/OLN=0.0 -! -!WC_H2O2/XO2=0.0 -! -!WC_H2O2/WC_O3=0.0 -! -!WC_H2O2/WC_H2O2=-KTC22-KC1-KC4*<WC_OH>-KC30*<WC_SO2> - PJAC(:,44,44)=-TPK%KTC22(:)-TPK%KC1(:)-TPK%KC4(:)*PCONC(:,53)-TPK%KC30(:)*PCON& -&C(:,56) -! -!WC_H2O2/WC_NO=0.0 -! -!WC_H2O2/WC_NO2=0.0 -! -!WC_H2O2/WC_NO3=0.0 -! -!WC_H2O2/WC_N2O5=0.0 -! -!WC_H2O2/WC_HONO=0.0 -! -!WC_H2O2/WC_HNO3=0.0 -! -!WC_H2O2/WC_HNO4=0.0 -! -!WC_H2O2/WC_NH3=0.0 -! -!WC_H2O2/WC_OH=+KC2*<WC_OH>+KC2*<WC_OH>-KC4*<WC_H2O2> - PJAC(:,44,53)=+TPK%KC2(:)*PCONC(:,53)+TPK%KC2(:)*PCONC(:,53)-TPK%KC4(:)*PCONC(& -&:,44) -! -!WC_H2O2/WC_HO2=+KC5*<WC_HO2>+KC5*<WC_HO2> - PJAC(:,44,54)=+TPK%KC5(:)*PCONC(:,54)+TPK%KC5(:)*PCONC(:,54) -! -!WC_H2O2/WC_CO2=0.0 -! -!WC_H2O2/WC_SO2=-KC30*<WC_H2O2> - PJAC(:,44,56)=-TPK%KC30(:)*PCONC(:,44) -! -!WC_H2O2/WC_SULF=0.0 -! -!WC_H2O2/WC_HCHO=0.0 -! -!WC_H2O2/WC_ORA1=0.0 -! -!WC_H2O2/WC_ORA2=0.0 -! -!WC_H2O2/WC_MO2=0.0 -! -!WC_H2O2/WC_OP1=0.0 -! -!WC_H2O2/WC_ASO3=0.0 -! -!WC_H2O2/WC_ASO4=0.0 -! -!WC_H2O2/WC_ASO5=0.0 -! -!WC_H2O2/WC_AHSO5=0.0 -! -!WC_H2O2/WC_AHMS=0.0 -! -!WC_H2O2/WR_O3=0.0 -! -!WC_H2O2/WR_H2O2=0.0 -! -!WC_H2O2/WR_NO=0.0 -! -!WC_H2O2/WR_NO2=0.0 -! -!WC_H2O2/WR_NO3=0.0 -! -!WC_H2O2/WR_N2O5=0.0 -! -!WC_H2O2/WR_HONO=0.0 -! -!WC_H2O2/WR_HNO3=0.0 -! -!WC_H2O2/WR_HNO4=0.0 -! -!WC_H2O2/WR_NH3=0.0 -! -!WC_H2O2/WR_OH=0.0 -! -!WC_H2O2/WR_HO2=0.0 -! -!WC_H2O2/WR_CO2=0.0 -! -!WC_H2O2/WR_SO2=0.0 -! -!WC_H2O2/WR_SULF=0.0 -! -!WC_H2O2/WR_HCHO=0.0 -! -!WC_H2O2/WR_ORA1=0.0 -! -!WC_H2O2/WR_ORA2=0.0 -! -!WC_H2O2/WR_MO2=0.0 -! -!WC_H2O2/WR_OP1=0.0 -! -!WC_H2O2/WR_ASO3=0.0 -! -!WC_H2O2/WR_ASO4=0.0 -! -!WC_H2O2/WR_ASO5=0.0 -! -!WC_H2O2/WR_AHSO5=0.0 -! -!WC_H2O2/WR_AHMS=0.0 -! -!WC_NO/O3=0.0 -! -!WC_NO/H2O2=0.0 -! -!WC_NO/NO=+KTC3 - PJAC(:,45,3)=+TPK%KTC3(:) -! -!WC_NO/NO2=0.0 -! -!WC_NO/NO3=0.0 -! -!WC_NO/N2O5=0.0 -! -!WC_NO/HONO=0.0 -! -!WC_NO/HNO3=0.0 -! -!WC_NO/HNO4=0.0 -! -!WC_NO/NH3=0.0 -! -!WC_NO/DMS=0.0 -! -!WC_NO/SO2=0.0 -! -!WC_NO/SULF=0.0 -! -!WC_NO/CO=0.0 -! -!WC_NO/OH=0.0 -! -!WC_NO/HO2=0.0 -! -!WC_NO/CH4=0.0 -! -!WC_NO/ETH=0.0 -! -!WC_NO/ALKA=0.0 -! -!WC_NO/ALKE=0.0 -! -!WC_NO/BIO=0.0 -! -!WC_NO/ARO=0.0 -! -!WC_NO/HCHO=0.0 -! -!WC_NO/ALD=0.0 -! -!WC_NO/KET=0.0 -! -!WC_NO/CARBO=0.0 -! -!WC_NO/ONIT=0.0 -! -!WC_NO/PAN=0.0 -! -!WC_NO/OP1=0.0 -! -!WC_NO/OP2=0.0 -! -!WC_NO/ORA1=0.0 -! -!WC_NO/ORA2=0.0 -! -!WC_NO/MO2=0.0 -! -!WC_NO/ALKAP=0.0 -! -!WC_NO/ALKEP=0.0 -! -!WC_NO/BIOP=0.0 -! -!WC_NO/PHO=0.0 -! -!WC_NO/ADD=0.0 -! -!WC_NO/AROP=0.0 -! -!WC_NO/CARBOP=0.0 -! -!WC_NO/OLN=0.0 -! -!WC_NO/XO2=0.0 -! -!WC_NO/WC_O3=0.0 -! -!WC_NO/WC_H2O2=0.0 -! -!WC_NO/WC_NO=-KTC23 - PJAC(:,45,45)=-TPK%KTC23(:) -! -!WC_NO/WC_NO2=0.0 -! -!WC_NO/WC_NO3=0.0 -! -!WC_NO/WC_N2O5=0.0 -! -!WC_NO/WC_HONO=0.0 -! -!WC_NO/WC_HNO3=0.0 -! -!WC_NO/WC_HNO4=0.0 -! -!WC_NO/WC_NH3=0.0 -! -!WC_NO/WC_OH=0.0 -! -!WC_NO/WC_HO2=0.0 -! -!WC_NO/WC_CO2=0.0 -! -!WC_NO/WC_SO2=0.0 -! -!WC_NO/WC_SULF=0.0 -! -!WC_NO/WC_HCHO=0.0 -! -!WC_NO/WC_ORA1=0.0 -! -!WC_NO/WC_ORA2=0.0 -! -!WC_NO/WC_MO2=0.0 -! -!WC_NO/WC_OP1=0.0 -! -!WC_NO/WC_ASO3=0.0 -! -!WC_NO/WC_ASO4=0.0 -! -!WC_NO/WC_ASO5=0.0 -! -!WC_NO/WC_AHSO5=0.0 -! -!WC_NO/WC_AHMS=0.0 -! -!WC_NO/WR_O3=0.0 -! -!WC_NO/WR_H2O2=0.0 -! -!WC_NO/WR_NO=0.0 -! -!WC_NO/WR_NO2=0.0 -! -!WC_NO/WR_NO3=0.0 -! -!WC_NO/WR_N2O5=0.0 -! -!WC_NO/WR_HONO=0.0 -! -!WC_NO/WR_HNO3=0.0 -! -!WC_NO/WR_HNO4=0.0 -! -!WC_NO/WR_NH3=0.0 -! -!WC_NO/WR_OH=0.0 -! -!WC_NO/WR_HO2=0.0 -! -!WC_NO/WR_CO2=0.0 -! -!WC_NO/WR_SO2=0.0 -! -!WC_NO/WR_SULF=0.0 -! -!WC_NO/WR_HCHO=0.0 -! -!WC_NO/WR_ORA1=0.0 -! -!WC_NO/WR_ORA2=0.0 -! -!WC_NO/WR_MO2=0.0 -! -!WC_NO/WR_OP1=0.0 -! -!WC_NO/WR_ASO3=0.0 -! -!WC_NO/WR_ASO4=0.0 -! -!WC_NO/WR_ASO5=0.0 -! -!WC_NO/WR_AHSO5=0.0 -! -!WC_NO/WR_AHMS=0.0 -! -RETURN -END SUBROUTINE SUBJ8 -! -SUBROUTINE SUBJ9 -! -!Indices 46 a 50 -! -! -!WC_NO2/O3=0.0 -! -!WC_NO2/H2O2=0.0 -! -!WC_NO2/NO=0.0 -! -!WC_NO2/NO2=+KTC4 - PJAC(:,46,4)=+TPK%KTC4(:) -! -!WC_NO2/NO3=0.0 -! -!WC_NO2/N2O5=0.0 -! -!WC_NO2/HONO=0.0 -! -!WC_NO2/HNO3=0.0 -! -!WC_NO2/HNO4=0.0 -! -!WC_NO2/NH3=0.0 -! -!WC_NO2/DMS=0.0 -! -!WC_NO2/SO2=0.0 -! -!WC_NO2/SULF=0.0 -! -!WC_NO2/CO=0.0 -! -!WC_NO2/OH=0.0 -! -!WC_NO2/HO2=0.0 -! -!WC_NO2/CH4=0.0 -! -!WC_NO2/ETH=0.0 -! -!WC_NO2/ALKA=0.0 -! -!WC_NO2/ALKE=0.0 -! -!WC_NO2/BIO=0.0 -! -!WC_NO2/ARO=0.0 -! -!WC_NO2/HCHO=0.0 -! -!WC_NO2/ALD=0.0 -! -!WC_NO2/KET=0.0 -! -!WC_NO2/CARBO=0.0 -! -!WC_NO2/ONIT=0.0 -! -!WC_NO2/PAN=0.0 -! -!WC_NO2/OP1=0.0 -! -!WC_NO2/OP2=0.0 -! -!WC_NO2/ORA1=0.0 -! -!WC_NO2/ORA2=0.0 -! -!WC_NO2/MO2=0.0 -! -!WC_NO2/ALKAP=0.0 -! -!WC_NO2/ALKEP=0.0 -! -!WC_NO2/BIOP=0.0 -! -!WC_NO2/PHO=0.0 -! -!WC_NO2/ADD=0.0 -! -!WC_NO2/AROP=0.0 -! -!WC_NO2/CARBOP=0.0 -! -!WC_NO2/OLN=0.0 -! -!WC_NO2/XO2=0.0 -! -!WC_NO2/WC_O3=0.0 -! -!WC_NO2/WC_H2O2=0.0 -! -!WC_NO2/WC_NO=0.0 -! -!WC_NO2/WC_NO2=-KTC24-KC9*<WC_HO2> - PJAC(:,46,46)=-TPK%KTC24(:)-TPK%KC9(:)*PCONC(:,54) -! -!WC_NO2/WC_NO3=0.0 -! -!WC_NO2/WC_N2O5=0.0 -! -!WC_NO2/WC_HONO=+KC8*<WC_OH> - PJAC(:,46,49)=+TPK%KC8(:)*PCONC(:,53) -! -!WC_NO2/WC_HNO3=+KC13 - PJAC(:,46,50)=+TPK%KC13(:) -! -!WC_NO2/WC_HNO4=+KC10 - PJAC(:,46,51)=+TPK%KC10(:) -! -!WC_NO2/WC_NH3=0.0 -! -!WC_NO2/WC_OH=+KC8*<WC_HONO> - PJAC(:,46,53)=+TPK%KC8(:)*PCONC(:,49) -! -!WC_NO2/WC_HO2=-KC9*<WC_NO2> - PJAC(:,46,54)=-TPK%KC9(:)*PCONC(:,46) -! -!WC_NO2/WC_CO2=0.0 -! -!WC_NO2/WC_SO2=0.0 -! -!WC_NO2/WC_SULF=0.0 -! -!WC_NO2/WC_HCHO=0.0 -! -!WC_NO2/WC_ORA1=0.0 -! -!WC_NO2/WC_ORA2=0.0 -! -!WC_NO2/WC_MO2=0.0 -! -!WC_NO2/WC_OP1=0.0 -! -!WC_NO2/WC_ASO3=0.0 -! -!WC_NO2/WC_ASO4=0.0 -! -!WC_NO2/WC_ASO5=0.0 -! -!WC_NO2/WC_AHSO5=0.0 -! -!WC_NO2/WC_AHMS=0.0 -! -!WC_NO2/WR_O3=0.0 -! -!WC_NO2/WR_H2O2=0.0 -! -!WC_NO2/WR_NO=0.0 -! -!WC_NO2/WR_NO2=0.0 -! -!WC_NO2/WR_NO3=0.0 -! -!WC_NO2/WR_N2O5=0.0 -! -!WC_NO2/WR_HONO=0.0 -! -!WC_NO2/WR_HNO3=0.0 -! -!WC_NO2/WR_HNO4=0.0 -! -!WC_NO2/WR_NH3=0.0 -! -!WC_NO2/WR_OH=0.0 -! -!WC_NO2/WR_HO2=0.0 -! -!WC_NO2/WR_CO2=0.0 -! -!WC_NO2/WR_SO2=0.0 -! -!WC_NO2/WR_SULF=0.0 -! -!WC_NO2/WR_HCHO=0.0 -! -!WC_NO2/WR_ORA1=0.0 -! -!WC_NO2/WR_ORA2=0.0 -! -!WC_NO2/WR_MO2=0.0 -! -!WC_NO2/WR_OP1=0.0 -! -!WC_NO2/WR_ASO3=0.0 -! -!WC_NO2/WR_ASO4=0.0 -! -!WC_NO2/WR_ASO5=0.0 -! -!WC_NO2/WR_AHSO5=0.0 -! -!WC_NO2/WR_AHMS=0.0 -! -!WC_NO3/O3=0.0 -! -!WC_NO3/H2O2=0.0 -! -!WC_NO3/NO=0.0 -! -!WC_NO3/NO2=0.0 -! -!WC_NO3/NO3=+KTC5 - PJAC(:,47,5)=+TPK%KTC5(:) -! -!WC_NO3/N2O5=0.0 -! -!WC_NO3/HONO=0.0 -! -!WC_NO3/HNO3=0.0 -! -!WC_NO3/HNO4=0.0 -! -!WC_NO3/NH3=0.0 -! -!WC_NO3/DMS=0.0 -! -!WC_NO3/SO2=0.0 -! -!WC_NO3/SULF=0.0 -! -!WC_NO3/CO=0.0 -! -!WC_NO3/OH=0.0 -! -!WC_NO3/HO2=0.0 -! -!WC_NO3/CH4=0.0 -! -!WC_NO3/ETH=0.0 -! -!WC_NO3/ALKA=0.0 -! -!WC_NO3/ALKE=0.0 -! -!WC_NO3/BIO=0.0 -! -!WC_NO3/ARO=0.0 -! -!WC_NO3/HCHO=0.0 -! -!WC_NO3/ALD=0.0 -! -!WC_NO3/KET=0.0 -! -!WC_NO3/CARBO=0.0 -! -!WC_NO3/ONIT=0.0 -! -!WC_NO3/PAN=0.0 -! -!WC_NO3/OP1=0.0 -! -!WC_NO3/OP2=0.0 -! -!WC_NO3/ORA1=0.0 -! -!WC_NO3/ORA2=0.0 -! -!WC_NO3/MO2=0.0 -! -!WC_NO3/ALKAP=0.0 -! -!WC_NO3/ALKEP=0.0 -! -!WC_NO3/BIOP=0.0 -! -!WC_NO3/PHO=0.0 -! -!WC_NO3/ADD=0.0 -! -!WC_NO3/AROP=0.0 -! -!WC_NO3/CARBOP=0.0 -! -!WC_NO3/OLN=0.0 -! -!WC_NO3/XO2=0.0 -! -!WC_NO3/WC_O3=0.0 -! -!WC_NO3/WC_H2O2=0.0 -! -!WC_NO3/WC_NO=0.0 -! -!WC_NO3/WC_NO2=0.0 -! -!WC_NO3/WC_NO3=-KTC25-KC15*<WC_SULF>-KC16*<WC_SO2> - PJAC(:,47,47)=-TPK%KTC25(:)-TPK%KC15(:)*PCONC(:,57)-TPK%KC16(:)*PCONC(:,56) -! -!WC_NO3/WC_N2O5=0.0 -! -!WC_NO3/WC_HONO=0.0 -! -!WC_NO3/WC_HNO3=0.0 -! -!WC_NO3/WC_HNO4=0.0 -! -!WC_NO3/WC_NH3=0.0 -! -!WC_NO3/WC_OH=0.0 -! -!WC_NO3/WC_HO2=0.0 -! -!WC_NO3/WC_CO2=0.0 -! -!WC_NO3/WC_SO2=-KC16*<WC_NO3> - PJAC(:,47,56)=-TPK%KC16(:)*PCONC(:,47) -! -!WC_NO3/WC_SULF=-KC15*<WC_NO3> - PJAC(:,47,57)=-TPK%KC15(:)*PCONC(:,47) -! -!WC_NO3/WC_HCHO=0.0 -! -!WC_NO3/WC_ORA1=0.0 -! -!WC_NO3/WC_ORA2=0.0 -! -!WC_NO3/WC_MO2=0.0 -! -!WC_NO3/WC_OP1=0.0 -! -!WC_NO3/WC_ASO3=0.0 -! -!WC_NO3/WC_ASO4=0.0 -! -!WC_NO3/WC_ASO5=0.0 -! -!WC_NO3/WC_AHSO5=0.0 -! -!WC_NO3/WC_AHMS=0.0 -! -!WC_NO3/WR_O3=0.0 -! -!WC_NO3/WR_H2O2=0.0 -! -!WC_NO3/WR_NO=0.0 -! -!WC_NO3/WR_NO2=0.0 -! -!WC_NO3/WR_NO3=0.0 -! -!WC_NO3/WR_N2O5=0.0 -! -!WC_NO3/WR_HONO=0.0 -! -!WC_NO3/WR_HNO3=0.0 -! -!WC_NO3/WR_HNO4=0.0 -! -!WC_NO3/WR_NH3=0.0 -! -!WC_NO3/WR_OH=0.0 -! -!WC_NO3/WR_HO2=0.0 -! -!WC_NO3/WR_CO2=0.0 -! -!WC_NO3/WR_SO2=0.0 -! -!WC_NO3/WR_SULF=0.0 -! -!WC_NO3/WR_HCHO=0.0 -! -!WC_NO3/WR_ORA1=0.0 -! -!WC_NO3/WR_ORA2=0.0 -! -!WC_NO3/WR_MO2=0.0 -! -!WC_NO3/WR_OP1=0.0 -! -!WC_NO3/WR_ASO3=0.0 -! -!WC_NO3/WR_ASO4=0.0 -! -!WC_NO3/WR_ASO5=0.0 -! -!WC_NO3/WR_AHSO5=0.0 -! -!WC_NO3/WR_AHMS=0.0 -! -!WC_N2O5/O3=0.0 -! -!WC_N2O5/H2O2=0.0 -! -!WC_N2O5/NO=0.0 -! -!WC_N2O5/NO2=0.0 -! -!WC_N2O5/NO3=0.0 -! -!WC_N2O5/N2O5=+KTC6 - PJAC(:,48,6)=+TPK%KTC6(:) -! -!WC_N2O5/HONO=0.0 -! -!WC_N2O5/HNO3=0.0 -! -!WC_N2O5/HNO4=0.0 -! -!WC_N2O5/NH3=0.0 -! -!WC_N2O5/DMS=0.0 -! -!WC_N2O5/SO2=0.0 -! -!WC_N2O5/SULF=0.0 -! -!WC_N2O5/CO=0.0 -! -!WC_N2O5/OH=0.0 -! -!WC_N2O5/HO2=0.0 -! -!WC_N2O5/CH4=0.0 -! -!WC_N2O5/ETH=0.0 -! -!WC_N2O5/ALKA=0.0 -! -!WC_N2O5/ALKE=0.0 -! -!WC_N2O5/BIO=0.0 -! -!WC_N2O5/ARO=0.0 -! -!WC_N2O5/HCHO=0.0 -! -!WC_N2O5/ALD=0.0 -! -!WC_N2O5/KET=0.0 -! -!WC_N2O5/CARBO=0.0 -! -!WC_N2O5/ONIT=0.0 -! -!WC_N2O5/PAN=0.0 -! -!WC_N2O5/OP1=0.0 -! -!WC_N2O5/OP2=0.0 -! -!WC_N2O5/ORA1=0.0 -! -!WC_N2O5/ORA2=0.0 -! -!WC_N2O5/MO2=0.0 -! -!WC_N2O5/ALKAP=0.0 -! -!WC_N2O5/ALKEP=0.0 -! -!WC_N2O5/BIOP=0.0 -! -!WC_N2O5/PHO=0.0 -! -!WC_N2O5/ADD=0.0 -! -!WC_N2O5/AROP=0.0 -! -!WC_N2O5/CARBOP=0.0 -! -!WC_N2O5/OLN=0.0 -! -!WC_N2O5/XO2=0.0 -! -!WC_N2O5/WC_O3=0.0 -! -!WC_N2O5/WC_H2O2=0.0 -! -!WC_N2O5/WC_NO=0.0 -! -!WC_N2O5/WC_NO2=0.0 -! -!WC_N2O5/WC_NO3=0.0 -! -!WC_N2O5/WC_N2O5=-KTC26-KC14 - PJAC(:,48,48)=-TPK%KTC26(:)-TPK%KC14(:) -! -!WC_N2O5/WC_HONO=0.0 -! -!WC_N2O5/WC_HNO3=0.0 -! -!WC_N2O5/WC_HNO4=0.0 -! -!WC_N2O5/WC_NH3=0.0 -! -!WC_N2O5/WC_OH=0.0 -! -!WC_N2O5/WC_HO2=0.0 -! -!WC_N2O5/WC_CO2=0.0 -! -!WC_N2O5/WC_SO2=0.0 -! -!WC_N2O5/WC_SULF=0.0 -! -!WC_N2O5/WC_HCHO=0.0 -! -!WC_N2O5/WC_ORA1=0.0 -! -!WC_N2O5/WC_ORA2=0.0 -! -!WC_N2O5/WC_MO2=0.0 -! -!WC_N2O5/WC_OP1=0.0 -! -!WC_N2O5/WC_ASO3=0.0 -! -!WC_N2O5/WC_ASO4=0.0 -! -!WC_N2O5/WC_ASO5=0.0 -! -!WC_N2O5/WC_AHSO5=0.0 -! -!WC_N2O5/WC_AHMS=0.0 -! -!WC_N2O5/WR_O3=0.0 -! -!WC_N2O5/WR_H2O2=0.0 -! -!WC_N2O5/WR_NO=0.0 -! -!WC_N2O5/WR_NO2=0.0 -! -!WC_N2O5/WR_NO3=0.0 -! -!WC_N2O5/WR_N2O5=0.0 -! -!WC_N2O5/WR_HONO=0.0 -! -!WC_N2O5/WR_HNO3=0.0 -! -!WC_N2O5/WR_HNO4=0.0 -! -!WC_N2O5/WR_NH3=0.0 -! -!WC_N2O5/WR_OH=0.0 -! -!WC_N2O5/WR_HO2=0.0 -! -!WC_N2O5/WR_CO2=0.0 -! -!WC_N2O5/WR_SO2=0.0 -! -!WC_N2O5/WR_SULF=0.0 -! -!WC_N2O5/WR_HCHO=0.0 -! -!WC_N2O5/WR_ORA1=0.0 -! -!WC_N2O5/WR_ORA2=0.0 -! -!WC_N2O5/WR_MO2=0.0 -! -!WC_N2O5/WR_OP1=0.0 -! -!WC_N2O5/WR_ASO3=0.0 -! -!WC_N2O5/WR_ASO4=0.0 -! -!WC_N2O5/WR_ASO5=0.0 -! -!WC_N2O5/WR_AHSO5=0.0 -! -!WC_N2O5/WR_AHMS=0.0 -! -!WC_HONO/O3=0.0 -! -!WC_HONO/H2O2=0.0 -! -!WC_HONO/NO=0.0 -! -!WC_HONO/NO2=0.0 -! -!WC_HONO/NO3=0.0 -! -!WC_HONO/N2O5=0.0 -! -!WC_HONO/HONO=+KTC7 - PJAC(:,49,7)=+TPK%KTC7(:) -! -!WC_HONO/HNO3=0.0 -! -!WC_HONO/HNO4=0.0 -! -!WC_HONO/NH3=0.0 -! -!WC_HONO/DMS=0.0 -! -!WC_HONO/SO2=0.0 -! -!WC_HONO/SULF=0.0 -! -!WC_HONO/CO=0.0 -! -!WC_HONO/OH=0.0 -! -!WC_HONO/HO2=0.0 -! -!WC_HONO/CH4=0.0 -! -!WC_HONO/ETH=0.0 -! -!WC_HONO/ALKA=0.0 -! -!WC_HONO/ALKE=0.0 -! -!WC_HONO/BIO=0.0 -! -!WC_HONO/ARO=0.0 -! -!WC_HONO/HCHO=0.0 -! -!WC_HONO/ALD=0.0 -! -!WC_HONO/KET=0.0 -! -!WC_HONO/CARBO=0.0 -! -!WC_HONO/ONIT=0.0 -! -!WC_HONO/PAN=0.0 -! -!WC_HONO/OP1=0.0 -! -!WC_HONO/OP2=0.0 -! -!WC_HONO/ORA1=0.0 -! -!WC_HONO/ORA2=0.0 -! -!WC_HONO/MO2=0.0 -! -!WC_HONO/ALKAP=0.0 -! -!WC_HONO/ALKEP=0.0 -! -!WC_HONO/BIOP=0.0 -! -!WC_HONO/PHO=0.0 -! -!WC_HONO/ADD=0.0 -! -!WC_HONO/AROP=0.0 -! -!WC_HONO/CARBOP=0.0 -! -!WC_HONO/OLN=0.0 -! -!WC_HONO/XO2=0.0 -! -!WC_HONO/WC_O3=0.0 -! -!WC_HONO/WC_H2O2=0.0 -! -!WC_HONO/WC_NO=0.0 -! -!WC_HONO/WC_NO2=0.0 -! -!WC_HONO/WC_NO3=0.0 -! -!WC_HONO/WC_N2O5=0.0 -! -!WC_HONO/WC_HONO=-KTC27-KC8*<WC_OH> - PJAC(:,49,49)=-TPK%KTC27(:)-TPK%KC8(:)*PCONC(:,53) -! -!WC_HONO/WC_HNO3=0.0 -! -!WC_HONO/WC_HNO4=+KC11 - PJAC(:,49,51)=+TPK%KC11(:) -! -!WC_HONO/WC_NH3=0.0 -! -!WC_HONO/WC_OH=-KC8*<WC_HONO> - PJAC(:,49,53)=-TPK%KC8(:)*PCONC(:,49) -! -!WC_HONO/WC_HO2=0.0 -! -!WC_HONO/WC_CO2=0.0 -! -!WC_HONO/WC_SO2=0.0 -! -!WC_HONO/WC_SULF=0.0 -! -!WC_HONO/WC_HCHO=0.0 -! -!WC_HONO/WC_ORA1=0.0 -! -!WC_HONO/WC_ORA2=0.0 -! -!WC_HONO/WC_MO2=0.0 -! -!WC_HONO/WC_OP1=0.0 -! -!WC_HONO/WC_ASO3=0.0 -! -!WC_HONO/WC_ASO4=0.0 -! -!WC_HONO/WC_ASO5=0.0 -! -!WC_HONO/WC_AHSO5=0.0 -! -!WC_HONO/WC_AHMS=0.0 -! -!WC_HONO/WR_O3=0.0 -! -!WC_HONO/WR_H2O2=0.0 -! -!WC_HONO/WR_NO=0.0 -! -!WC_HONO/WR_NO2=0.0 -! -!WC_HONO/WR_NO3=0.0 -! -!WC_HONO/WR_N2O5=0.0 -! -!WC_HONO/WR_HONO=0.0 -! -!WC_HONO/WR_HNO3=0.0 -! -!WC_HONO/WR_HNO4=0.0 -! -!WC_HONO/WR_NH3=0.0 -! -!WC_HONO/WR_OH=0.0 -! -!WC_HONO/WR_HO2=0.0 -! -!WC_HONO/WR_CO2=0.0 -! -!WC_HONO/WR_SO2=0.0 -! -!WC_HONO/WR_SULF=0.0 -! -!WC_HONO/WR_HCHO=0.0 -! -!WC_HONO/WR_ORA1=0.0 -! -!WC_HONO/WR_ORA2=0.0 -! -!WC_HONO/WR_MO2=0.0 -! -!WC_HONO/WR_OP1=0.0 -! -!WC_HONO/WR_ASO3=0.0 -! -!WC_HONO/WR_ASO4=0.0 -! -!WC_HONO/WR_ASO5=0.0 -! -!WC_HONO/WR_AHSO5=0.0 -! -!WC_HONO/WR_AHMS=0.0 -! -!WC_HNO3/O3=0.0 -! -!WC_HNO3/H2O2=0.0 -! -!WC_HNO3/NO=0.0 -! -!WC_HNO3/NO2=0.0 -! -!WC_HNO3/NO3=0.0 -! -!WC_HNO3/N2O5=0.0 -! -!WC_HNO3/HONO=0.0 -! -!WC_HNO3/HNO3=+KTC8 - PJAC(:,50,8)=+TPK%KTC8(:) -! -!WC_HNO3/HNO4=0.0 -! -!WC_HNO3/NH3=0.0 -! -!WC_HNO3/DMS=0.0 -! -!WC_HNO3/SO2=0.0 -! -!WC_HNO3/SULF=0.0 -! -!WC_HNO3/CO=0.0 -! -!WC_HNO3/OH=0.0 -! -!WC_HNO3/HO2=0.0 -! -!WC_HNO3/CH4=0.0 -! -!WC_HNO3/ETH=0.0 -! -!WC_HNO3/ALKA=0.0 -! -!WC_HNO3/ALKE=0.0 -! -!WC_HNO3/BIO=0.0 -! -!WC_HNO3/ARO=0.0 -! -!WC_HNO3/HCHO=0.0 -! -!WC_HNO3/ALD=0.0 -! -!WC_HNO3/KET=0.0 -! -!WC_HNO3/CARBO=0.0 -! -!WC_HNO3/ONIT=0.0 -! -!WC_HNO3/PAN=0.0 -! -!WC_HNO3/OP1=0.0 -! -!WC_HNO3/OP2=0.0 -! -!WC_HNO3/ORA1=0.0 -! -!WC_HNO3/ORA2=0.0 -! -!WC_HNO3/MO2=0.0 -! -!WC_HNO3/ALKAP=0.0 -! -!WC_HNO3/ALKEP=0.0 -! -!WC_HNO3/BIOP=0.0 -! -!WC_HNO3/PHO=0.0 -! -!WC_HNO3/ADD=0.0 -! -!WC_HNO3/AROP=0.0 -! -!WC_HNO3/CARBOP=0.0 -! -!WC_HNO3/OLN=0.0 -! -!WC_HNO3/XO2=0.0 -! -!WC_HNO3/WC_O3=0.0 -! -!WC_HNO3/WC_H2O2=0.0 -! -!WC_HNO3/WC_NO=0.0 -! -!WC_HNO3/WC_NO2=0.0 -! -!WC_HNO3/WC_NO3=+KC15*<WC_SULF>+KC16*<WC_SO2> - PJAC(:,50,47)=+TPK%KC15(:)*PCONC(:,57)+TPK%KC16(:)*PCONC(:,56) -! -!WC_HNO3/WC_N2O5=+KC14+KC14 - PJAC(:,50,48)=+TPK%KC14(:)+TPK%KC14(:) -! -!WC_HNO3/WC_HONO=0.0 -! -!WC_HNO3/WC_HNO3=-KTC28-KC13 - PJAC(:,50,50)=-TPK%KTC28(:)-TPK%KC13(:) -! -!WC_HNO3/WC_HNO4=+KC12*<WC_SO2> - PJAC(:,50,51)=+TPK%KC12(:)*PCONC(:,56) -! -!WC_HNO3/WC_NH3=0.0 -! -!WC_HNO3/WC_OH=0.0 -! -!WC_HNO3/WC_HO2=0.0 -! -!WC_HNO3/WC_CO2=0.0 -! -!WC_HNO3/WC_SO2=+KC12*<WC_HNO4>+KC16*<WC_NO3> - PJAC(:,50,56)=+TPK%KC12(:)*PCONC(:,51)+TPK%KC16(:)*PCONC(:,47) -! -!WC_HNO3/WC_SULF=+KC15*<WC_NO3> - PJAC(:,50,57)=+TPK%KC15(:)*PCONC(:,47) -! -!WC_HNO3/WC_HCHO=0.0 -! -!WC_HNO3/WC_ORA1=0.0 -! -!WC_HNO3/WC_ORA2=0.0 -! -!WC_HNO3/WC_MO2=0.0 -! -!WC_HNO3/WC_OP1=0.0 -! -!WC_HNO3/WC_ASO3=0.0 -! -!WC_HNO3/WC_ASO4=0.0 -! -!WC_HNO3/WC_ASO5=0.0 -! -!WC_HNO3/WC_AHSO5=0.0 -! -!WC_HNO3/WC_AHMS=0.0 -! -!WC_HNO3/WR_O3=0.0 -! -!WC_HNO3/WR_H2O2=0.0 -! -!WC_HNO3/WR_NO=0.0 -! -!WC_HNO3/WR_NO2=0.0 -! -!WC_HNO3/WR_NO3=0.0 -! -!WC_HNO3/WR_N2O5=0.0 -! -!WC_HNO3/WR_HONO=0.0 -! -!WC_HNO3/WR_HNO3=0.0 -! -!WC_HNO3/WR_HNO4=0.0 -! -!WC_HNO3/WR_NH3=0.0 -! -!WC_HNO3/WR_OH=0.0 -! -!WC_HNO3/WR_HO2=0.0 -! -!WC_HNO3/WR_CO2=0.0 -! -!WC_HNO3/WR_SO2=0.0 -! -!WC_HNO3/WR_SULF=0.0 -! -!WC_HNO3/WR_HCHO=0.0 -! -!WC_HNO3/WR_ORA1=0.0 -! -!WC_HNO3/WR_ORA2=0.0 -! -!WC_HNO3/WR_MO2=0.0 -! -!WC_HNO3/WR_OP1=0.0 -! -!WC_HNO3/WR_ASO3=0.0 -! -!WC_HNO3/WR_ASO4=0.0 -! -!WC_HNO3/WR_ASO5=0.0 -! -!WC_HNO3/WR_AHSO5=0.0 -! -!WC_HNO3/WR_AHMS=0.0 -! -RETURN -END SUBROUTINE SUBJ9 -! -SUBROUTINE SUBJ10 -! -!Indices 51 a 55 -! -! -!WC_HNO4/O3=0.0 -! -!WC_HNO4/H2O2=0.0 -! -!WC_HNO4/NO=0.0 -! -!WC_HNO4/NO2=0.0 -! -!WC_HNO4/NO3=0.0 -! -!WC_HNO4/N2O5=0.0 -! -!WC_HNO4/HONO=0.0 -! -!WC_HNO4/HNO3=0.0 -! -!WC_HNO4/HNO4=+KTC9 - PJAC(:,51,9)=+TPK%KTC9(:) -! -!WC_HNO4/NH3=0.0 -! -!WC_HNO4/DMS=0.0 -! -!WC_HNO4/SO2=0.0 -! -!WC_HNO4/SULF=0.0 -! -!WC_HNO4/CO=0.0 -! -!WC_HNO4/OH=0.0 -! -!WC_HNO4/HO2=0.0 -! -!WC_HNO4/CH4=0.0 -! -!WC_HNO4/ETH=0.0 -! -!WC_HNO4/ALKA=0.0 -! -!WC_HNO4/ALKE=0.0 -! -!WC_HNO4/BIO=0.0 -! -!WC_HNO4/ARO=0.0 -! -!WC_HNO4/HCHO=0.0 -! -!WC_HNO4/ALD=0.0 -! -!WC_HNO4/KET=0.0 -! -!WC_HNO4/CARBO=0.0 -! -!WC_HNO4/ONIT=0.0 -! -!WC_HNO4/PAN=0.0 -! -!WC_HNO4/OP1=0.0 -! -!WC_HNO4/OP2=0.0 -! -!WC_HNO4/ORA1=0.0 -! -!WC_HNO4/ORA2=0.0 -! -!WC_HNO4/MO2=0.0 -! -!WC_HNO4/ALKAP=0.0 -! -!WC_HNO4/ALKEP=0.0 -! -!WC_HNO4/BIOP=0.0 -! -!WC_HNO4/PHO=0.0 -! -!WC_HNO4/ADD=0.0 -! -!WC_HNO4/AROP=0.0 -! -!WC_HNO4/CARBOP=0.0 -! -!WC_HNO4/OLN=0.0 -! -!WC_HNO4/XO2=0.0 -! -!WC_HNO4/WC_O3=0.0 -! -!WC_HNO4/WC_H2O2=0.0 -! -!WC_HNO4/WC_NO=0.0 -! -!WC_HNO4/WC_NO2=+KC9*<WC_HO2> - PJAC(:,51,46)=+TPK%KC9(:)*PCONC(:,54) -! -!WC_HNO4/WC_NO3=0.0 -! -!WC_HNO4/WC_N2O5=0.0 -! -!WC_HNO4/WC_HONO=0.0 -! -!WC_HNO4/WC_HNO3=0.0 -! -!WC_HNO4/WC_HNO4=-KTC29-KC10-KC11-KC12*<WC_SO2> - PJAC(:,51,51)=-TPK%KTC29(:)-TPK%KC10(:)-TPK%KC11(:)-TPK%KC12(:)*PCONC(:,56) -! -!WC_HNO4/WC_NH3=0.0 -! -!WC_HNO4/WC_OH=0.0 -! -!WC_HNO4/WC_HO2=+KC9*<WC_NO2> - PJAC(:,51,54)=+TPK%KC9(:)*PCONC(:,46) -! -!WC_HNO4/WC_CO2=0.0 -! -!WC_HNO4/WC_SO2=-KC12*<WC_HNO4> - PJAC(:,51,56)=-TPK%KC12(:)*PCONC(:,51) -! -!WC_HNO4/WC_SULF=0.0 -! -!WC_HNO4/WC_HCHO=0.0 -! -!WC_HNO4/WC_ORA1=0.0 -! -!WC_HNO4/WC_ORA2=0.0 -! -!WC_HNO4/WC_MO2=0.0 -! -!WC_HNO4/WC_OP1=0.0 -! -!WC_HNO4/WC_ASO3=0.0 -! -!WC_HNO4/WC_ASO4=0.0 -! -!WC_HNO4/WC_ASO5=0.0 -! -!WC_HNO4/WC_AHSO5=0.0 -! -!WC_HNO4/WC_AHMS=0.0 -! -!WC_HNO4/WR_O3=0.0 -! -!WC_HNO4/WR_H2O2=0.0 -! -!WC_HNO4/WR_NO=0.0 -! -!WC_HNO4/WR_NO2=0.0 -! -!WC_HNO4/WR_NO3=0.0 -! -!WC_HNO4/WR_N2O5=0.0 -! -!WC_HNO4/WR_HONO=0.0 -! -!WC_HNO4/WR_HNO3=0.0 -! -!WC_HNO4/WR_HNO4=0.0 -! -!WC_HNO4/WR_NH3=0.0 -! -!WC_HNO4/WR_OH=0.0 -! -!WC_HNO4/WR_HO2=0.0 -! -!WC_HNO4/WR_CO2=0.0 -! -!WC_HNO4/WR_SO2=0.0 -! -!WC_HNO4/WR_SULF=0.0 -! -!WC_HNO4/WR_HCHO=0.0 -! -!WC_HNO4/WR_ORA1=0.0 -! -!WC_HNO4/WR_ORA2=0.0 -! -!WC_HNO4/WR_MO2=0.0 -! -!WC_HNO4/WR_OP1=0.0 -! -!WC_HNO4/WR_ASO3=0.0 -! -!WC_HNO4/WR_ASO4=0.0 -! -!WC_HNO4/WR_ASO5=0.0 -! -!WC_HNO4/WR_AHSO5=0.0 -! -!WC_HNO4/WR_AHMS=0.0 -! -!WC_NH3/O3=0.0 -! -!WC_NH3/H2O2=0.0 -! -!WC_NH3/NO=0.0 -! -!WC_NH3/NO2=0.0 -! -!WC_NH3/NO3=0.0 -! -!WC_NH3/N2O5=0.0 -! -!WC_NH3/HONO=0.0 -! -!WC_NH3/HNO3=0.0 -! -!WC_NH3/HNO4=0.0 -! -!WC_NH3/NH3=+KTC10 - PJAC(:,52,10)=+TPK%KTC10(:) -! -!WC_NH3/DMS=0.0 -! -!WC_NH3/SO2=0.0 -! -!WC_NH3/SULF=0.0 -! -!WC_NH3/CO=0.0 -! -!WC_NH3/OH=0.0 -! -!WC_NH3/HO2=0.0 -! -!WC_NH3/CH4=0.0 -! -!WC_NH3/ETH=0.0 -! -!WC_NH3/ALKA=0.0 -! -!WC_NH3/ALKE=0.0 -! -!WC_NH3/BIO=0.0 -! -!WC_NH3/ARO=0.0 -! -!WC_NH3/HCHO=0.0 -! -!WC_NH3/ALD=0.0 -! -!WC_NH3/KET=0.0 -! -!WC_NH3/CARBO=0.0 -! -!WC_NH3/ONIT=0.0 -! -!WC_NH3/PAN=0.0 -! -!WC_NH3/OP1=0.0 -! -!WC_NH3/OP2=0.0 -! -!WC_NH3/ORA1=0.0 -! -!WC_NH3/ORA2=0.0 -! -!WC_NH3/MO2=0.0 -! -!WC_NH3/ALKAP=0.0 -! -!WC_NH3/ALKEP=0.0 -! -!WC_NH3/BIOP=0.0 -! -!WC_NH3/PHO=0.0 -! -!WC_NH3/ADD=0.0 -! -!WC_NH3/AROP=0.0 -! -!WC_NH3/CARBOP=0.0 -! -!WC_NH3/OLN=0.0 -! -!WC_NH3/XO2=0.0 -! -!WC_NH3/WC_O3=0.0 -! -!WC_NH3/WC_H2O2=0.0 -! -!WC_NH3/WC_NO=0.0 -! -!WC_NH3/WC_NO2=0.0 -! -!WC_NH3/WC_NO3=0.0 -! -!WC_NH3/WC_N2O5=0.0 -! -!WC_NH3/WC_HONO=0.0 -! -!WC_NH3/WC_HNO3=0.0 -! -!WC_NH3/WC_HNO4=0.0 -! -!WC_NH3/WC_NH3=-KTC30 - PJAC(:,52,52)=-TPK%KTC30(:) -! -!WC_NH3/WC_OH=0.0 -! -!WC_NH3/WC_HO2=0.0 -! -!WC_NH3/WC_CO2=0.0 -! -!WC_NH3/WC_SO2=0.0 -! -!WC_NH3/WC_SULF=0.0 -! -!WC_NH3/WC_HCHO=0.0 -! -!WC_NH3/WC_ORA1=0.0 -! -!WC_NH3/WC_ORA2=0.0 -! -!WC_NH3/WC_MO2=0.0 -! -!WC_NH3/WC_OP1=0.0 -! -!WC_NH3/WC_ASO3=0.0 -! -!WC_NH3/WC_ASO4=0.0 -! -!WC_NH3/WC_ASO5=0.0 -! -!WC_NH3/WC_AHSO5=0.0 -! -!WC_NH3/WC_AHMS=0.0 -! -!WC_NH3/WR_O3=0.0 -! -!WC_NH3/WR_H2O2=0.0 -! -!WC_NH3/WR_NO=0.0 -! -!WC_NH3/WR_NO2=0.0 -! -!WC_NH3/WR_NO3=0.0 -! -!WC_NH3/WR_N2O5=0.0 -! -!WC_NH3/WR_HONO=0.0 -! -!WC_NH3/WR_HNO3=0.0 -! -!WC_NH3/WR_HNO4=0.0 -! -!WC_NH3/WR_NH3=0.0 -! -!WC_NH3/WR_OH=0.0 -! -!WC_NH3/WR_HO2=0.0 -! -!WC_NH3/WR_CO2=0.0 -! -!WC_NH3/WR_SO2=0.0 -! -!WC_NH3/WR_SULF=0.0 -! -!WC_NH3/WR_HCHO=0.0 -! -!WC_NH3/WR_ORA1=0.0 -! -!WC_NH3/WR_ORA2=0.0 -! -!WC_NH3/WR_MO2=0.0 -! -!WC_NH3/WR_OP1=0.0 -! -!WC_NH3/WR_ASO3=0.0 -! -!WC_NH3/WR_ASO4=0.0 -! -!WC_NH3/WR_ASO5=0.0 -! -!WC_NH3/WR_AHSO5=0.0 -! -!WC_NH3/WR_AHMS=0.0 -! -!WC_OH/O3=0.0 -! -!WC_OH/H2O2=0.0 -! -!WC_OH/NO=0.0 -! -!WC_OH/NO2=0.0 -! -!WC_OH/NO3=0.0 -! -!WC_OH/N2O5=0.0 -! -!WC_OH/HONO=0.0 -! -!WC_OH/HNO3=0.0 -! -!WC_OH/HNO4=0.0 -! -!WC_OH/NH3=0.0 -! -!WC_OH/DMS=0.0 -! -!WC_OH/SO2=0.0 -! -!WC_OH/SULF=0.0 -! -!WC_OH/CO=0.0 -! -!WC_OH/OH=+KTC11 - PJAC(:,53,15)=+TPK%KTC11(:) -! -!WC_OH/HO2=0.0 -! -!WC_OH/CH4=0.0 -! -!WC_OH/ETH=0.0 -! -!WC_OH/ALKA=0.0 -! -!WC_OH/ALKE=0.0 -! -!WC_OH/BIO=0.0 -! -!WC_OH/ARO=0.0 -! -!WC_OH/HCHO=0.0 -! -!WC_OH/ALD=0.0 -! -!WC_OH/KET=0.0 -! -!WC_OH/CARBO=0.0 -! -!WC_OH/ONIT=0.0 -! -!WC_OH/PAN=0.0 -! -!WC_OH/OP1=0.0 -! -!WC_OH/OP2=0.0 -! -!WC_OH/ORA1=0.0 -! -!WC_OH/ORA2=0.0 -! -!WC_OH/MO2=0.0 -! -!WC_OH/ALKAP=0.0 -! -!WC_OH/ALKEP=0.0 -! -!WC_OH/BIOP=0.0 -! -!WC_OH/PHO=0.0 -! -!WC_OH/ADD=0.0 -! -!WC_OH/AROP=0.0 -! -!WC_OH/CARBOP=0.0 -! -!WC_OH/OLN=0.0 -! -!WC_OH/XO2=0.0 -! -!WC_OH/WC_O3=+KC6*<WC_HO2> - PJAC(:,53,43)=+TPK%KC6(:)*PCONC(:,54) -! -!WC_OH/WC_H2O2=+KC1+KC1-KC4*<WC_OH> - PJAC(:,53,44)=+TPK%KC1(:)+TPK%KC1(:)-TPK%KC4(:)*PCONC(:,53) -! -!WC_OH/WC_NO=0.0 -! -!WC_OH/WC_NO2=0.0 -! -!WC_OH/WC_NO3=0.0 -! -!WC_OH/WC_N2O5=0.0 -! -!WC_OH/WC_HONO=-KC8*<WC_OH> - PJAC(:,53,49)=-TPK%KC8(:)*PCONC(:,53) -! -!WC_OH/WC_HNO3=+KC13 - PJAC(:,53,50)=+TPK%KC13(:) -! -!WC_OH/WC_HNO4=0.0 -! -!WC_OH/WC_NH3=0.0 -! -!WC_OH/WC_OH=-KTC31-KC2*<WC_OH>-KC2*<WC_OH>-KC2*<WC_OH>-KC2*<WC_OH>-KC3*<WC_HO2 -!>-KC4*<WC_H2O2>-KC7*<WC_SO2>-KC8*<WC_HONO>-KC19*<WC_HCHO>-KC20*<WC_ORA1>-KC23* -!<WC_AHMS> - PJAC(:,53,53)=-TPK%KTC31(:)-TPK%KC2(:)*PCONC(:,53)-TPK%KC2(:)*PCONC(:,53)-TPK%& -&KC2(:)*PCONC(:,53)-TPK%KC2(:)*PCONC(:,53)-TPK%KC3(:)*PCONC(:,54)-TPK%KC4(:)*PC& -&ONC(:,44)-TPK%KC7(:)*PCONC(:,56)-TPK%KC8(:)*PCONC(:,49)-TPK%KC19(:)*PCONC(:,58& -&)-TPK%KC20(:)*PCONC(:,59)-TPK%KC23(:)*PCONC(:,67) -! -!WC_OH/WC_HO2=-KC3*<WC_OH>+KC6*<WC_O3> - PJAC(:,53,54)=-TPK%KC3(:)*PCONC(:,53)+TPK%KC6(:)*PCONC(:,43) -! -!WC_OH/WC_CO2=0.0 -! -!WC_OH/WC_SO2=-KC7*<WC_OH> - PJAC(:,53,56)=-TPK%KC7(:)*PCONC(:,53) -! -!WC_OH/WC_SULF=0.0 -! -!WC_OH/WC_HCHO=-KC19*<WC_OH> - PJAC(:,53,58)=-TPK%KC19(:)*PCONC(:,53) -! -!WC_OH/WC_ORA1=-KC20*<WC_OH> - PJAC(:,53,59)=-TPK%KC20(:)*PCONC(:,53) -! -!WC_OH/WC_ORA2=0.0 -! -!WC_OH/WC_MO2=0.0 -! -!WC_OH/WC_OP1=0.0 -! -!WC_OH/WC_ASO3=0.0 -! -!WC_OH/WC_ASO4=+KC28 - PJAC(:,53,64)=+TPK%KC28(:) -! -!WC_OH/WC_ASO5=0.0 -! -!WC_OH/WC_AHSO5=0.0 -! -!WC_OH/WC_AHMS=-KC23*<WC_OH> - PJAC(:,53,67)=-TPK%KC23(:)*PCONC(:,53) -! -!WC_OH/WR_O3=0.0 -! -!WC_OH/WR_H2O2=0.0 -! -!WC_OH/WR_NO=0.0 -! -!WC_OH/WR_NO2=0.0 -! -!WC_OH/WR_NO3=0.0 -! -!WC_OH/WR_N2O5=0.0 -! -!WC_OH/WR_HONO=0.0 -! -!WC_OH/WR_HNO3=0.0 -! -!WC_OH/WR_HNO4=0.0 -! -!WC_OH/WR_NH3=0.0 -! -!WC_OH/WR_OH=0.0 -! -!WC_OH/WR_HO2=0.0 -! -!WC_OH/WR_CO2=0.0 -! -!WC_OH/WR_SO2=0.0 -! -!WC_OH/WR_SULF=0.0 -! -!WC_OH/WR_HCHO=0.0 -! -!WC_OH/WR_ORA1=0.0 -! -!WC_OH/WR_ORA2=0.0 -! -!WC_OH/WR_MO2=0.0 -! -!WC_OH/WR_OP1=0.0 -! -!WC_OH/WR_ASO3=0.0 -! -!WC_OH/WR_ASO4=0.0 -! -!WC_OH/WR_ASO5=0.0 -! -!WC_OH/WR_AHSO5=0.0 -! -!WC_OH/WR_AHMS=0.0 -! -!WC_HO2/O3=0.0 -! -!WC_HO2/H2O2=0.0 -! -!WC_HO2/NO=0.0 -! -!WC_HO2/NO2=0.0 -! -!WC_HO2/NO3=0.0 -! -!WC_HO2/N2O5=0.0 -! -!WC_HO2/HONO=0.0 -! -!WC_HO2/HNO3=0.0 -! -!WC_HO2/HNO4=0.0 -! -!WC_HO2/NH3=0.0 -! -!WC_HO2/DMS=0.0 -! -!WC_HO2/SO2=0.0 -! -!WC_HO2/SULF=0.0 -! -!WC_HO2/CO=0.0 -! -!WC_HO2/OH=0.0 -! -!WC_HO2/HO2=+KTC12 - PJAC(:,54,16)=+TPK%KTC12(:) -! -!WC_HO2/CH4=0.0 -! -!WC_HO2/ETH=0.0 -! -!WC_HO2/ALKA=0.0 -! -!WC_HO2/ALKE=0.0 -! -!WC_HO2/BIO=0.0 -! -!WC_HO2/ARO=0.0 -! -!WC_HO2/HCHO=0.0 -! -!WC_HO2/ALD=0.0 -! -!WC_HO2/KET=0.0 -! -!WC_HO2/CARBO=0.0 -! -!WC_HO2/ONIT=0.0 -! -!WC_HO2/PAN=0.0 -! -!WC_HO2/OP1=0.0 -! -!WC_HO2/OP2=0.0 -! -!WC_HO2/ORA1=0.0 -! -!WC_HO2/ORA2=0.0 -! -!WC_HO2/MO2=0.0 -! -!WC_HO2/ALKAP=0.0 -! -!WC_HO2/ALKEP=0.0 -! -!WC_HO2/BIOP=0.0 -! -!WC_HO2/PHO=0.0 -! -!WC_HO2/ADD=0.0 -! -!WC_HO2/AROP=0.0 -! -!WC_HO2/CARBOP=0.0 -! -!WC_HO2/OLN=0.0 -! -!WC_HO2/XO2=0.0 -! -!WC_HO2/WC_O3=-KC6*<WC_HO2> - PJAC(:,54,43)=-TPK%KC6(:)*PCONC(:,54) -! -!WC_HO2/WC_H2O2=+KC4*<WC_OH> - PJAC(:,54,44)=+TPK%KC4(:)*PCONC(:,53) -! -!WC_HO2/WC_NO=0.0 -! -!WC_HO2/WC_NO2=-KC9*<WC_HO2> - PJAC(:,54,46)=-TPK%KC9(:)*PCONC(:,54) -! -!WC_HO2/WC_NO3=0.0 -! -!WC_HO2/WC_N2O5=0.0 -! -!WC_HO2/WC_HONO=0.0 -! -!WC_HO2/WC_HNO3=0.0 -! -!WC_HO2/WC_HNO4=+KC10 - PJAC(:,54,51)=+TPK%KC10(:) -! -!WC_HO2/WC_NH3=0.0 -! -!WC_HO2/WC_OH=-KC3*<WC_HO2>+KC4*<WC_H2O2>+KC19*<WC_HCHO>+KC20*<WC_ORA1>+KC23*<W -!C_AHMS> - PJAC(:,54,53)=-TPK%KC3(:)*PCONC(:,54)+TPK%KC4(:)*PCONC(:,44)+TPK%KC19(:)*PCONC& -&(:,58)+TPK%KC20(:)*PCONC(:,59)+TPK%KC23(:)*PCONC(:,67) -! -!WC_HO2/WC_HO2=-KTC32-KC3*<WC_OH>-KC5*<WC_HO2>-KC5*<WC_HO2>-KC5*<WC_HO2>-KC5*<W -!C_HO2>-KC6*<WC_O3>-KC9*<WC_NO2>-KC25*<WC_ASO5> - PJAC(:,54,54)=-TPK%KTC32(:)-TPK%KC3(:)*PCONC(:,53)-TPK%KC5(:)*PCONC(:,54)-TPK%& -&KC5(:)*PCONC(:,54)-TPK%KC5(:)*PCONC(:,54)-TPK%KC5(:)*PCONC(:,54)-TPK%KC6(:)*PC& -&ONC(:,43)-TPK%KC9(:)*PCONC(:,46)-TPK%KC25(:)*PCONC(:,65) -! -!WC_HO2/WC_CO2=0.0 -! -!WC_HO2/WC_SO2=0.0 -! -!WC_HO2/WC_SULF=0.0 -! -!WC_HO2/WC_HCHO=+KC19*<WC_OH> - PJAC(:,54,58)=+TPK%KC19(:)*PCONC(:,53) -! -!WC_HO2/WC_ORA1=+KC20*<WC_OH> - PJAC(:,54,59)=+TPK%KC20(:)*PCONC(:,53) -! -!WC_HO2/WC_ORA2=0.0 -! -!WC_HO2/WC_MO2=+2.00*KC17*<WC_MO2>+2.00*KC17*<WC_MO2> - PJAC(:,54,61)=+2.00*TPK%KC17(:)*PCONC(:,61)+2.00*TPK%KC17(:)*PCONC(:,61) -! -!WC_HO2/WC_OP1=0.0 -! -!WC_HO2/WC_ASO3=0.0 -! -!WC_HO2/WC_ASO4=0.0 -! -!WC_HO2/WC_ASO5=-KC25*<WC_HO2> - PJAC(:,54,65)=-TPK%KC25(:)*PCONC(:,54) -! -!WC_HO2/WC_AHSO5=0.0 -! -!WC_HO2/WC_AHMS=+KC23*<WC_OH> - PJAC(:,54,67)=+TPK%KC23(:)*PCONC(:,53) -! -!WC_HO2/WR_O3=0.0 -! -!WC_HO2/WR_H2O2=0.0 -! -!WC_HO2/WR_NO=0.0 -! -!WC_HO2/WR_NO2=0.0 -! -!WC_HO2/WR_NO3=0.0 -! -!WC_HO2/WR_N2O5=0.0 -! -!WC_HO2/WR_HONO=0.0 -! -!WC_HO2/WR_HNO3=0.0 -! -!WC_HO2/WR_HNO4=0.0 -! -!WC_HO2/WR_NH3=0.0 -! -!WC_HO2/WR_OH=0.0 -! -!WC_HO2/WR_HO2=0.0 -! -!WC_HO2/WR_CO2=0.0 -! -!WC_HO2/WR_SO2=0.0 -! -!WC_HO2/WR_SULF=0.0 -! -!WC_HO2/WR_HCHO=0.0 -! -!WC_HO2/WR_ORA1=0.0 -! -!WC_HO2/WR_ORA2=0.0 -! -!WC_HO2/WR_MO2=0.0 -! -!WC_HO2/WR_OP1=0.0 -! -!WC_HO2/WR_ASO3=0.0 -! -!WC_HO2/WR_ASO4=0.0 -! -!WC_HO2/WR_ASO5=0.0 -! -!WC_HO2/WR_AHSO5=0.0 -! -!WC_HO2/WR_AHMS=0.0 -! -!WC_CO2/O3=0.0 -! -!WC_CO2/H2O2=0.0 -! -!WC_CO2/NO=0.0 -! -!WC_CO2/NO2=0.0 -! -!WC_CO2/NO3=0.0 -! -!WC_CO2/N2O5=0.0 -! -!WC_CO2/HONO=0.0 -! -!WC_CO2/HNO3=0.0 -! -!WC_CO2/HNO4=0.0 -! -!WC_CO2/NH3=0.0 -! -!WC_CO2/DMS=0.0 -! -!WC_CO2/SO2=0.0 -! -!WC_CO2/SULF=0.0 -! -!WC_CO2/CO=0.0 -! -!WC_CO2/OH=0.0 -! -!WC_CO2/HO2=0.0 -! -!WC_CO2/CH4=0.0 -! -!WC_CO2/ETH=0.0 -! -!WC_CO2/ALKA=0.0 -! -!WC_CO2/ALKE=0.0 -! -!WC_CO2/BIO=0.0 -! -!WC_CO2/ARO=0.0 -! -!WC_CO2/HCHO=0.0 -! -!WC_CO2/ALD=0.0 -! -!WC_CO2/KET=0.0 -! -!WC_CO2/CARBO=0.0 -! -!WC_CO2/ONIT=0.0 -! -!WC_CO2/PAN=0.0 -! -!WC_CO2/OP1=0.0 -! -!WC_CO2/OP2=0.0 -! -!WC_CO2/ORA1=0.0 -! -!WC_CO2/ORA2=0.0 -! -!WC_CO2/MO2=0.0 -! -!WC_CO2/ALKAP=0.0 -! -!WC_CO2/ALKEP=0.0 -! -!WC_CO2/BIOP=0.0 -! -!WC_CO2/PHO=0.0 -! -!WC_CO2/ADD=0.0 -! -!WC_CO2/AROP=0.0 -! -!WC_CO2/CARBOP=0.0 -! -!WC_CO2/OLN=0.0 -! -!WC_CO2/XO2=0.0 -! -!WC_CO2/WC_O3=0.0 -! -!WC_CO2/WC_H2O2=0.0 -! -!WC_CO2/WC_NO=0.0 -! -!WC_CO2/WC_NO2=0.0 -! -!WC_CO2/WC_NO3=0.0 -! -!WC_CO2/WC_N2O5=0.0 -! -!WC_CO2/WC_HONO=0.0 -! -!WC_CO2/WC_HNO3=0.0 -! -!WC_CO2/WC_HNO4=0.0 -! -!WC_CO2/WC_NH3=0.0 -! -!WC_CO2/WC_OH=+KC20*<WC_ORA1> - PJAC(:,55,53)=+TPK%KC20(:)*PCONC(:,59) -! -!WC_CO2/WC_HO2=0.0 -! -!WC_CO2/WC_CO2=-KTC33 - PJAC(:,55,55)=-TPK%KTC33(:) -! -!WC_CO2/WC_SO2=0.0 -! -!WC_CO2/WC_SULF=0.0 -! -!WC_CO2/WC_HCHO=0.0 -! -!WC_CO2/WC_ORA1=+KC20*<WC_OH> - PJAC(:,55,59)=+TPK%KC20(:)*PCONC(:,53) -! -!WC_CO2/WC_ORA2=0.0 -! -!WC_CO2/WC_MO2=0.0 -! -!WC_CO2/WC_OP1=0.0 -! -!WC_CO2/WC_ASO3=0.0 -! -!WC_CO2/WC_ASO4=0.0 -! -!WC_CO2/WC_ASO5=0.0 -! -!WC_CO2/WC_AHSO5=0.0 -! -!WC_CO2/WC_AHMS=0.0 -! -!WC_CO2/WR_O3=0.0 -! -!WC_CO2/WR_H2O2=0.0 -! -!WC_CO2/WR_NO=0.0 -! -!WC_CO2/WR_NO2=0.0 -! -!WC_CO2/WR_NO3=0.0 -! -!WC_CO2/WR_N2O5=0.0 -! -!WC_CO2/WR_HONO=0.0 -! -!WC_CO2/WR_HNO3=0.0 -! -!WC_CO2/WR_HNO4=0.0 -! -!WC_CO2/WR_NH3=0.0 -! -!WC_CO2/WR_OH=0.0 -! -!WC_CO2/WR_HO2=0.0 -! -!WC_CO2/WR_CO2=0.0 -! -!WC_CO2/WR_SO2=0.0 -! -!WC_CO2/WR_SULF=0.0 -! -!WC_CO2/WR_HCHO=0.0 -! -!WC_CO2/WR_ORA1=0.0 -! -!WC_CO2/WR_ORA2=0.0 -! -!WC_CO2/WR_MO2=0.0 -! -!WC_CO2/WR_OP1=0.0 -! -!WC_CO2/WR_ASO3=0.0 -! -!WC_CO2/WR_ASO4=0.0 -! -!WC_CO2/WR_ASO5=0.0 -! -!WC_CO2/WR_AHSO5=0.0 -! -!WC_CO2/WR_AHMS=0.0 -! -RETURN -END SUBROUTINE SUBJ10 -! -SUBROUTINE SUBJ11 -! -!Indices 56 a 60 -! -! -!WC_SO2/O3=0.0 -! -!WC_SO2/H2O2=0.0 -! -!WC_SO2/NO=0.0 -! -!WC_SO2/NO2=0.0 -! -!WC_SO2/NO3=0.0 -! -!WC_SO2/N2O5=0.0 -! -!WC_SO2/HONO=0.0 -! -!WC_SO2/HNO3=0.0 -! -!WC_SO2/HNO4=0.0 -! -!WC_SO2/NH3=0.0 -! -!WC_SO2/DMS=0.0 -! -!WC_SO2/SO2=+KTC14 - PJAC(:,56,12)=+TPK%KTC14(:) -! -!WC_SO2/SULF=0.0 -! -!WC_SO2/CO=0.0 -! -!WC_SO2/OH=0.0 -! -!WC_SO2/HO2=0.0 -! -!WC_SO2/CH4=0.0 -! -!WC_SO2/ETH=0.0 -! -!WC_SO2/ALKA=0.0 -! -!WC_SO2/ALKE=0.0 -! -!WC_SO2/BIO=0.0 -! -!WC_SO2/ARO=0.0 -! -!WC_SO2/HCHO=0.0 -! -!WC_SO2/ALD=0.0 -! -!WC_SO2/KET=0.0 -! -!WC_SO2/CARBO=0.0 -! -!WC_SO2/ONIT=0.0 -! -!WC_SO2/PAN=0.0 -! -!WC_SO2/OP1=0.0 -! -!WC_SO2/OP2=0.0 -! -!WC_SO2/ORA1=0.0 -! -!WC_SO2/ORA2=0.0 -! -!WC_SO2/MO2=0.0 -! -!WC_SO2/ALKAP=0.0 -! -!WC_SO2/ALKEP=0.0 -! -!WC_SO2/BIOP=0.0 -! -!WC_SO2/PHO=0.0 -! -!WC_SO2/ADD=0.0 -! -!WC_SO2/AROP=0.0 -! -!WC_SO2/CARBOP=0.0 -! -!WC_SO2/OLN=0.0 -! -!WC_SO2/XO2=0.0 -! -!WC_SO2/WC_O3=-KC29*<WC_SO2> - PJAC(:,56,43)=-TPK%KC29(:)*PCONC(:,56) -! -!WC_SO2/WC_H2O2=-KC30*<WC_SO2> - PJAC(:,56,44)=-TPK%KC30(:)*PCONC(:,56) -! -!WC_SO2/WC_NO=0.0 -! -!WC_SO2/WC_NO2=0.0 -! -!WC_SO2/WC_NO3=-KC16*<WC_SO2> - PJAC(:,56,47)=-TPK%KC16(:)*PCONC(:,56) -! -!WC_SO2/WC_N2O5=0.0 -! -!WC_SO2/WC_HONO=0.0 -! -!WC_SO2/WC_HNO3=0.0 -! -!WC_SO2/WC_HNO4=-KC12*<WC_SO2> - PJAC(:,56,51)=-TPK%KC12(:)*PCONC(:,56) -! -!WC_SO2/WC_NH3=0.0 -! -!WC_SO2/WC_OH=-KC7*<WC_SO2>+KC23*<WC_AHMS> - PJAC(:,56,53)=-TPK%KC7(:)*PCONC(:,56)+TPK%KC23(:)*PCONC(:,67) -! -!WC_SO2/WC_HO2=0.0 -! -!WC_SO2/WC_CO2=0.0 -! -!WC_SO2/WC_SO2=-KTC34-KC7*<WC_OH>-KC12*<WC_HNO4>-KC16*<WC_NO3>-KC18*<WC_MO2>-KC -!21*<WC_HCHO>-KC27*<WC_AHSO5>-KC29*<WC_O3>-KC30*<WC_H2O2> - PJAC(:,56,56)=-TPK%KTC34(:)-TPK%KC7(:)*PCONC(:,53)-TPK%KC12(:)*PCONC(:,51)-TPK& -&%KC16(:)*PCONC(:,47)-TPK%KC18(:)*PCONC(:,61)-TPK%KC21(:)*PCONC(:,58)-TPK%KC27(& -&:)*PCONC(:,66)-TPK%KC29(:)*PCONC(:,43)-TPK%KC30(:)*PCONC(:,44) -! -!WC_SO2/WC_SULF=0.0 -! -!WC_SO2/WC_HCHO=-KC21*<WC_SO2> - PJAC(:,56,58)=-TPK%KC21(:)*PCONC(:,56) -! -!WC_SO2/WC_ORA1=0.0 -! -!WC_SO2/WC_ORA2=0.0 -! -!WC_SO2/WC_MO2=-KC18*<WC_SO2> - PJAC(:,56,61)=-TPK%KC18(:)*PCONC(:,56) -! -!WC_SO2/WC_OP1=0.0 -! -!WC_SO2/WC_ASO3=0.0 -! -!WC_SO2/WC_ASO4=0.0 -! -!WC_SO2/WC_ASO5=0.0 -! -!WC_SO2/WC_AHSO5=-KC27*<WC_SO2> - PJAC(:,56,66)=-TPK%KC27(:)*PCONC(:,56) -! -!WC_SO2/WC_AHMS=+KC22+KC23*<WC_OH> - PJAC(:,56,67)=+TPK%KC22(:)+TPK%KC23(:)*PCONC(:,53) -! -!WC_SO2/WR_O3=0.0 -! -!WC_SO2/WR_H2O2=0.0 -! -!WC_SO2/WR_NO=0.0 -! -!WC_SO2/WR_NO2=0.0 -! -!WC_SO2/WR_NO3=0.0 -! -!WC_SO2/WR_N2O5=0.0 -! -!WC_SO2/WR_HONO=0.0 -! -!WC_SO2/WR_HNO3=0.0 -! -!WC_SO2/WR_HNO4=0.0 -! -!WC_SO2/WR_NH3=0.0 -! -!WC_SO2/WR_OH=0.0 -! -!WC_SO2/WR_HO2=0.0 -! -!WC_SO2/WR_CO2=0.0 -! -!WC_SO2/WR_SO2=0.0 -! -!WC_SO2/WR_SULF=0.0 -! -!WC_SO2/WR_HCHO=0.0 -! -!WC_SO2/WR_ORA1=0.0 -! -!WC_SO2/WR_ORA2=0.0 -! -!WC_SO2/WR_MO2=0.0 -! -!WC_SO2/WR_OP1=0.0 -! -!WC_SO2/WR_ASO3=0.0 -! -!WC_SO2/WR_ASO4=0.0 -! -!WC_SO2/WR_ASO5=0.0 -! -!WC_SO2/WR_AHSO5=0.0 -! -!WC_SO2/WR_AHMS=0.0 -! -!WC_SULF/O3=0.0 -! -!WC_SULF/H2O2=0.0 -! -!WC_SULF/NO=0.0 -! -!WC_SULF/NO2=0.0 -! -!WC_SULF/NO3=0.0 -! -!WC_SULF/N2O5=0.0 -! -!WC_SULF/HONO=0.0 -! -!WC_SULF/HNO3=0.0 -! -!WC_SULF/HNO4=0.0 -! -!WC_SULF/NH3=0.0 -! -!WC_SULF/DMS=0.0 -! -!WC_SULF/SO2=0.0 -! -!WC_SULF/SULF=+KTC15 - PJAC(:,57,13)=+TPK%KTC15(:) -! -!WC_SULF/CO=0.0 -! -!WC_SULF/OH=0.0 -! -!WC_SULF/HO2=0.0 -! -!WC_SULF/CH4=0.0 -! -!WC_SULF/ETH=0.0 -! -!WC_SULF/ALKA=0.0 -! -!WC_SULF/ALKE=0.0 -! -!WC_SULF/BIO=0.0 -! -!WC_SULF/ARO=0.0 -! -!WC_SULF/HCHO=0.0 -! -!WC_SULF/ALD=0.0 -! -!WC_SULF/KET=0.0 -! -!WC_SULF/CARBO=0.0 -! -!WC_SULF/ONIT=0.0 -! -!WC_SULF/PAN=0.0 -! -!WC_SULF/OP1=0.0 -! -!WC_SULF/OP2=0.0 -! -!WC_SULF/ORA1=0.0 -! -!WC_SULF/ORA2=0.0 -! -!WC_SULF/MO2=0.0 -! -!WC_SULF/ALKAP=0.0 -! -!WC_SULF/ALKEP=0.0 -! -!WC_SULF/BIOP=0.0 -! -!WC_SULF/PHO=0.0 -! -!WC_SULF/ADD=0.0 -! -!WC_SULF/AROP=0.0 -! -!WC_SULF/CARBOP=0.0 -! -!WC_SULF/OLN=0.0 -! -!WC_SULF/XO2=0.0 -! -!WC_SULF/WC_O3=+KC29*<WC_SO2> - PJAC(:,57,43)=+TPK%KC29(:)*PCONC(:,56) -! -!WC_SULF/WC_H2O2=+KC30*<WC_SO2> - PJAC(:,57,44)=+TPK%KC30(:)*PCONC(:,56) -! -!WC_SULF/WC_NO=0.0 -! -!WC_SULF/WC_NO2=0.0 -! -!WC_SULF/WC_NO3=-KC15*<WC_SULF> - PJAC(:,57,47)=-TPK%KC15(:)*PCONC(:,57) -! -!WC_SULF/WC_N2O5=0.0 -! -!WC_SULF/WC_HONO=0.0 -! -!WC_SULF/WC_HNO3=0.0 -! -!WC_SULF/WC_HNO4=+KC12*<WC_SO2> - PJAC(:,57,51)=+TPK%KC12(:)*PCONC(:,56) -! -!WC_SULF/WC_NH3=0.0 -! -!WC_SULF/WC_OH=0.0 -! -!WC_SULF/WC_HO2=0.0 -! -!WC_SULF/WC_CO2=0.0 -! -!WC_SULF/WC_SO2=+KC12*<WC_HNO4>+2.00*KC27*<WC_AHSO5>+KC29*<WC_O3>+KC30*<WC_H2O2 -!> - PJAC(:,57,56)=+TPK%KC12(:)*PCONC(:,51)+2.00*TPK%KC27(:)*PCONC(:,66)+TPK%KC29(:& -&)*PCONC(:,43)+TPK%KC30(:)*PCONC(:,44) -! -!WC_SULF/WC_SULF=-KTC35-KC15*<WC_NO3> - PJAC(:,57,57)=-TPK%KTC35(:)-TPK%KC15(:)*PCONC(:,47) -! -!WC_SULF/WC_HCHO=0.0 -! -!WC_SULF/WC_ORA1=0.0 -! -!WC_SULF/WC_ORA2=0.0 -! -!WC_SULF/WC_MO2=0.0 -! -!WC_SULF/WC_OP1=0.0 -! -!WC_SULF/WC_ASO3=0.0 -! -!WC_SULF/WC_ASO4=+KC28 - PJAC(:,57,64)=+TPK%KC28(:) -! -!WC_SULF/WC_ASO5=0.0 -! -!WC_SULF/WC_AHSO5=+2.00*KC27*<WC_SO2> - PJAC(:,57,66)=+2.00*TPK%KC27(:)*PCONC(:,56) -! -!WC_SULF/WC_AHMS=0.0 -! -!WC_SULF/WR_O3=0.0 -! -!WC_SULF/WR_H2O2=0.0 -! -!WC_SULF/WR_NO=0.0 -! -!WC_SULF/WR_NO2=0.0 -! -!WC_SULF/WR_NO3=0.0 -! -!WC_SULF/WR_N2O5=0.0 -! -!WC_SULF/WR_HONO=0.0 -! -!WC_SULF/WR_HNO3=0.0 -! -!WC_SULF/WR_HNO4=0.0 -! -!WC_SULF/WR_NH3=0.0 -! -!WC_SULF/WR_OH=0.0 -! -!WC_SULF/WR_HO2=0.0 -! -!WC_SULF/WR_CO2=0.0 -! -!WC_SULF/WR_SO2=0.0 -! -!WC_SULF/WR_SULF=0.0 -! -!WC_SULF/WR_HCHO=0.0 -! -!WC_SULF/WR_ORA1=0.0 -! -!WC_SULF/WR_ORA2=0.0 -! -!WC_SULF/WR_MO2=0.0 -! -!WC_SULF/WR_OP1=0.0 -! -!WC_SULF/WR_ASO3=0.0 -! -!WC_SULF/WR_ASO4=0.0 -! -!WC_SULF/WR_ASO5=0.0 -! -!WC_SULF/WR_AHSO5=0.0 -! -!WC_SULF/WR_AHMS=0.0 -! -!WC_HCHO/O3=0.0 -! -!WC_HCHO/H2O2=0.0 -! -!WC_HCHO/NO=0.0 -! -!WC_HCHO/NO2=0.0 -! -!WC_HCHO/NO3=0.0 -! -!WC_HCHO/N2O5=0.0 -! -!WC_HCHO/HONO=0.0 -! -!WC_HCHO/HNO3=0.0 -! -!WC_HCHO/HNO4=0.0 -! -!WC_HCHO/NH3=0.0 -! -!WC_HCHO/DMS=0.0 -! -!WC_HCHO/SO2=0.0 -! -!WC_HCHO/SULF=0.0 -! -!WC_HCHO/CO=0.0 -! -!WC_HCHO/OH=0.0 -! -!WC_HCHO/HO2=0.0 -! -!WC_HCHO/CH4=0.0 -! -!WC_HCHO/ETH=0.0 -! -!WC_HCHO/ALKA=0.0 -! -!WC_HCHO/ALKE=0.0 -! -!WC_HCHO/BIO=0.0 -! -!WC_HCHO/ARO=0.0 -! -!WC_HCHO/HCHO=+KTC16 - PJAC(:,58,23)=+TPK%KTC16(:) -! -!WC_HCHO/ALD=0.0 -! -!WC_HCHO/KET=0.0 -! -!WC_HCHO/CARBO=0.0 -! -!WC_HCHO/ONIT=0.0 -! -!WC_HCHO/PAN=0.0 -! -!WC_HCHO/OP1=0.0 -! -!WC_HCHO/OP2=0.0 -! -!WC_HCHO/ORA1=0.0 -! -!WC_HCHO/ORA2=0.0 -! -!WC_HCHO/MO2=0.0 -! -!WC_HCHO/ALKAP=0.0 -! -!WC_HCHO/ALKEP=0.0 -! -!WC_HCHO/BIOP=0.0 -! -!WC_HCHO/PHO=0.0 -! -!WC_HCHO/ADD=0.0 -! -!WC_HCHO/AROP=0.0 -! -!WC_HCHO/CARBOP=0.0 -! -!WC_HCHO/OLN=0.0 -! -!WC_HCHO/XO2=0.0 -! -!WC_HCHO/WC_O3=0.0 -! -!WC_HCHO/WC_H2O2=0.0 -! -!WC_HCHO/WC_NO=0.0 -! -!WC_HCHO/WC_NO2=0.0 -! -!WC_HCHO/WC_NO3=0.0 -! -!WC_HCHO/WC_N2O5=0.0 -! -!WC_HCHO/WC_HONO=0.0 -! -!WC_HCHO/WC_HNO3=0.0 -! -!WC_HCHO/WC_HNO4=0.0 -! -!WC_HCHO/WC_NH3=0.0 -! -!WC_HCHO/WC_OH=-KC19*<WC_HCHO> - PJAC(:,58,53)=-TPK%KC19(:)*PCONC(:,58) -! -!WC_HCHO/WC_HO2=0.0 -! -!WC_HCHO/WC_CO2=0.0 -! -!WC_HCHO/WC_SO2=-KC21*<WC_HCHO> - PJAC(:,58,56)=-TPK%KC21(:)*PCONC(:,58) -! -!WC_HCHO/WC_SULF=0.0 -! -!WC_HCHO/WC_HCHO=-KTC36-KC19*<WC_OH>-KC21*<WC_SO2> - PJAC(:,58,58)=-TPK%KTC36(:)-TPK%KC19(:)*PCONC(:,53)-TPK%KC21(:)*PCONC(:,56) -! -!WC_HCHO/WC_ORA1=0.0 -! -!WC_HCHO/WC_ORA2=0.0 -! -!WC_HCHO/WC_MO2=+2.00*KC17*<WC_MO2>+2.00*KC17*<WC_MO2> - PJAC(:,58,61)=+2.00*TPK%KC17(:)*PCONC(:,61)+2.00*TPK%KC17(:)*PCONC(:,61) -! -!WC_HCHO/WC_OP1=0.0 -! -!WC_HCHO/WC_ASO3=0.0 -! -!WC_HCHO/WC_ASO4=0.0 -! -!WC_HCHO/WC_ASO5=0.0 -! -!WC_HCHO/WC_AHSO5=0.0 -! -!WC_HCHO/WC_AHMS=+KC22 - PJAC(:,58,67)=+TPK%KC22(:) -! -!WC_HCHO/WR_O3=0.0 -! -!WC_HCHO/WR_H2O2=0.0 -! -!WC_HCHO/WR_NO=0.0 -! -!WC_HCHO/WR_NO2=0.0 -! -!WC_HCHO/WR_NO3=0.0 -! -!WC_HCHO/WR_N2O5=0.0 -! -!WC_HCHO/WR_HONO=0.0 -! -!WC_HCHO/WR_HNO3=0.0 -! -!WC_HCHO/WR_HNO4=0.0 -! -!WC_HCHO/WR_NH3=0.0 -! -!WC_HCHO/WR_OH=0.0 -! -!WC_HCHO/WR_HO2=0.0 -! -!WC_HCHO/WR_CO2=0.0 -! -!WC_HCHO/WR_SO2=0.0 -! -!WC_HCHO/WR_SULF=0.0 -! -!WC_HCHO/WR_HCHO=0.0 -! -!WC_HCHO/WR_ORA1=0.0 -! -!WC_HCHO/WR_ORA2=0.0 -! -!WC_HCHO/WR_MO2=0.0 -! -!WC_HCHO/WR_OP1=0.0 -! -!WC_HCHO/WR_ASO3=0.0 -! -!WC_HCHO/WR_ASO4=0.0 -! -!WC_HCHO/WR_ASO5=0.0 -! -!WC_HCHO/WR_AHSO5=0.0 -! -!WC_HCHO/WR_AHMS=0.0 -! -!WC_ORA1/O3=0.0 -! -!WC_ORA1/H2O2=0.0 -! -!WC_ORA1/NO=0.0 -! -!WC_ORA1/NO2=0.0 -! -!WC_ORA1/NO3=0.0 -! -!WC_ORA1/N2O5=0.0 -! -!WC_ORA1/HONO=0.0 -! -!WC_ORA1/HNO3=0.0 -! -!WC_ORA1/HNO4=0.0 -! -!WC_ORA1/NH3=0.0 -! -!WC_ORA1/DMS=0.0 -! -!WC_ORA1/SO2=0.0 -! -!WC_ORA1/SULF=0.0 -! -!WC_ORA1/CO=0.0 -! -!WC_ORA1/OH=0.0 -! -!WC_ORA1/HO2=0.0 -! -!WC_ORA1/CH4=0.0 -! -!WC_ORA1/ETH=0.0 -! -!WC_ORA1/ALKA=0.0 -! -!WC_ORA1/ALKE=0.0 -! -!WC_ORA1/BIO=0.0 -! -!WC_ORA1/ARO=0.0 -! -!WC_ORA1/HCHO=0.0 -! -!WC_ORA1/ALD=0.0 -! -!WC_ORA1/KET=0.0 -! -!WC_ORA1/CARBO=0.0 -! -!WC_ORA1/ONIT=0.0 -! -!WC_ORA1/PAN=0.0 -! -!WC_ORA1/OP1=0.0 -! -!WC_ORA1/OP2=0.0 -! -!WC_ORA1/ORA1=+KTC17 - PJAC(:,59,31)=+TPK%KTC17(:) -! -!WC_ORA1/ORA2=0.0 -! -!WC_ORA1/MO2=0.0 -! -!WC_ORA1/ALKAP=0.0 -! -!WC_ORA1/ALKEP=0.0 -! -!WC_ORA1/BIOP=0.0 -! -!WC_ORA1/PHO=0.0 -! -!WC_ORA1/ADD=0.0 -! -!WC_ORA1/AROP=0.0 -! -!WC_ORA1/CARBOP=0.0 -! -!WC_ORA1/OLN=0.0 -! -!WC_ORA1/XO2=0.0 -! -!WC_ORA1/WC_O3=0.0 -! -!WC_ORA1/WC_H2O2=0.0 -! -!WC_ORA1/WC_NO=0.0 -! -!WC_ORA1/WC_NO2=0.0 -! -!WC_ORA1/WC_NO3=0.0 -! -!WC_ORA1/WC_N2O5=0.0 -! -!WC_ORA1/WC_HONO=0.0 -! -!WC_ORA1/WC_HNO3=0.0 -! -!WC_ORA1/WC_HNO4=0.0 -! -!WC_ORA1/WC_NH3=0.0 -! -!WC_ORA1/WC_OH=+KC19*<WC_HCHO>-KC20*<WC_ORA1>+KC23*<WC_AHMS> - PJAC(:,59,53)=+TPK%KC19(:)*PCONC(:,58)-TPK%KC20(:)*PCONC(:,59)+TPK%KC23(:)*PCO& -&NC(:,67) -! -!WC_ORA1/WC_HO2=0.0 -! -!WC_ORA1/WC_CO2=0.0 -! -!WC_ORA1/WC_SO2=0.0 -! -!WC_ORA1/WC_SULF=0.0 -! -!WC_ORA1/WC_HCHO=+KC19*<WC_OH> - PJAC(:,59,58)=+TPK%KC19(:)*PCONC(:,53) -! -!WC_ORA1/WC_ORA1=-KTC37-KC20*<WC_OH> - PJAC(:,59,59)=-TPK%KTC37(:)-TPK%KC20(:)*PCONC(:,53) -! -!WC_ORA1/WC_ORA2=0.0 -! -!WC_ORA1/WC_MO2=0.0 -! -!WC_ORA1/WC_OP1=0.0 -! -!WC_ORA1/WC_ASO3=0.0 -! -!WC_ORA1/WC_ASO4=0.0 -! -!WC_ORA1/WC_ASO5=0.0 -! -!WC_ORA1/WC_AHSO5=0.0 -! -!WC_ORA1/WC_AHMS=+KC23*<WC_OH> - PJAC(:,59,67)=+TPK%KC23(:)*PCONC(:,53) -! -!WC_ORA1/WR_O3=0.0 -! -!WC_ORA1/WR_H2O2=0.0 -! -!WC_ORA1/WR_NO=0.0 -! -!WC_ORA1/WR_NO2=0.0 -! -!WC_ORA1/WR_NO3=0.0 -! -!WC_ORA1/WR_N2O5=0.0 -! -!WC_ORA1/WR_HONO=0.0 -! -!WC_ORA1/WR_HNO3=0.0 -! -!WC_ORA1/WR_HNO4=0.0 -! -!WC_ORA1/WR_NH3=0.0 -! -!WC_ORA1/WR_OH=0.0 -! -!WC_ORA1/WR_HO2=0.0 -! -!WC_ORA1/WR_CO2=0.0 -! -!WC_ORA1/WR_SO2=0.0 -! -!WC_ORA1/WR_SULF=0.0 -! -!WC_ORA1/WR_HCHO=0.0 -! -!WC_ORA1/WR_ORA1=0.0 -! -!WC_ORA1/WR_ORA2=0.0 -! -!WC_ORA1/WR_MO2=0.0 -! -!WC_ORA1/WR_OP1=0.0 -! -!WC_ORA1/WR_ASO3=0.0 -! -!WC_ORA1/WR_ASO4=0.0 -! -!WC_ORA1/WR_ASO5=0.0 -! -!WC_ORA1/WR_AHSO5=0.0 -! -!WC_ORA1/WR_AHMS=0.0 -! -!WC_ORA2/O3=0.0 -! -!WC_ORA2/H2O2=0.0 -! -!WC_ORA2/NO=0.0 -! -!WC_ORA2/NO2=0.0 -! -!WC_ORA2/NO3=0.0 -! -!WC_ORA2/N2O5=0.0 -! -!WC_ORA2/HONO=0.0 -! -!WC_ORA2/HNO3=0.0 -! -!WC_ORA2/HNO4=0.0 -! -!WC_ORA2/NH3=0.0 -! -!WC_ORA2/DMS=0.0 -! -!WC_ORA2/SO2=0.0 -! -!WC_ORA2/SULF=0.0 -! -!WC_ORA2/CO=0.0 -! -!WC_ORA2/OH=0.0 -! -!WC_ORA2/HO2=0.0 -! -!WC_ORA2/CH4=0.0 -! -!WC_ORA2/ETH=0.0 -! -!WC_ORA2/ALKA=0.0 -! -!WC_ORA2/ALKE=0.0 -! -!WC_ORA2/BIO=0.0 -! -!WC_ORA2/ARO=0.0 -! -!WC_ORA2/HCHO=0.0 -! -!WC_ORA2/ALD=0.0 -! -!WC_ORA2/KET=0.0 -! -!WC_ORA2/CARBO=0.0 -! -!WC_ORA2/ONIT=0.0 -! -!WC_ORA2/PAN=0.0 -! -!WC_ORA2/OP1=0.0 -! -!WC_ORA2/OP2=0.0 -! -!WC_ORA2/ORA1=0.0 -! -!WC_ORA2/ORA2=+KTC18 - PJAC(:,60,32)=+TPK%KTC18(:) -! -!WC_ORA2/MO2=0.0 -! -!WC_ORA2/ALKAP=0.0 -! -!WC_ORA2/ALKEP=0.0 -! -!WC_ORA2/BIOP=0.0 -! -!WC_ORA2/PHO=0.0 -! -!WC_ORA2/ADD=0.0 -! -!WC_ORA2/AROP=0.0 -! -!WC_ORA2/CARBOP=0.0 -! -!WC_ORA2/OLN=0.0 -! -!WC_ORA2/XO2=0.0 -! -!WC_ORA2/WC_O3=0.0 -! -!WC_ORA2/WC_H2O2=0.0 -! -!WC_ORA2/WC_NO=0.0 -! -!WC_ORA2/WC_NO2=0.0 -! -!WC_ORA2/WC_NO3=0.0 -! -!WC_ORA2/WC_N2O5=0.0 -! -!WC_ORA2/WC_HONO=0.0 -! -!WC_ORA2/WC_HNO3=0.0 -! -!WC_ORA2/WC_HNO4=0.0 -! -!WC_ORA2/WC_NH3=0.0 -! -!WC_ORA2/WC_OH=0.0 -! -!WC_ORA2/WC_HO2=0.0 -! -!WC_ORA2/WC_CO2=0.0 -! -!WC_ORA2/WC_SO2=0.0 -! -!WC_ORA2/WC_SULF=0.0 -! -!WC_ORA2/WC_HCHO=0.0 -! -!WC_ORA2/WC_ORA1=0.0 -! -!WC_ORA2/WC_ORA2=-KTC38 - PJAC(:,60,60)=-TPK%KTC38(:) -! -!WC_ORA2/WC_MO2=0.0 -! -!WC_ORA2/WC_OP1=0.0 -! -!WC_ORA2/WC_ASO3=0.0 -! -!WC_ORA2/WC_ASO4=0.0 -! -!WC_ORA2/WC_ASO5=0.0 -! -!WC_ORA2/WC_AHSO5=0.0 -! -!WC_ORA2/WC_AHMS=0.0 -! -!WC_ORA2/WR_O3=0.0 -! -!WC_ORA2/WR_H2O2=0.0 -! -!WC_ORA2/WR_NO=0.0 -! -!WC_ORA2/WR_NO2=0.0 -! -!WC_ORA2/WR_NO3=0.0 -! -!WC_ORA2/WR_N2O5=0.0 -! -!WC_ORA2/WR_HONO=0.0 -! -!WC_ORA2/WR_HNO3=0.0 -! -!WC_ORA2/WR_HNO4=0.0 -! -!WC_ORA2/WR_NH3=0.0 -! -!WC_ORA2/WR_OH=0.0 -! -!WC_ORA2/WR_HO2=0.0 -! -!WC_ORA2/WR_CO2=0.0 -! -!WC_ORA2/WR_SO2=0.0 -! -!WC_ORA2/WR_SULF=0.0 -! -!WC_ORA2/WR_HCHO=0.0 -! -!WC_ORA2/WR_ORA1=0.0 -! -!WC_ORA2/WR_ORA2=0.0 -! -!WC_ORA2/WR_MO2=0.0 -! -!WC_ORA2/WR_OP1=0.0 -! -!WC_ORA2/WR_ASO3=0.0 -! -!WC_ORA2/WR_ASO4=0.0 -! -!WC_ORA2/WR_ASO5=0.0 -! -!WC_ORA2/WR_AHSO5=0.0 -! -!WC_ORA2/WR_AHMS=0.0 -! -RETURN -END SUBROUTINE SUBJ11 -! -SUBROUTINE SUBJ12 -! -!Indices 61 a 65 -! -! -!WC_MO2/O3=0.0 -! -!WC_MO2/H2O2=0.0 -! -!WC_MO2/NO=0.0 -! -!WC_MO2/NO2=0.0 -! -!WC_MO2/NO3=0.0 -! -!WC_MO2/N2O5=0.0 -! -!WC_MO2/HONO=0.0 -! -!WC_MO2/HNO3=0.0 -! -!WC_MO2/HNO4=0.0 -! -!WC_MO2/NH3=0.0 -! -!WC_MO2/DMS=0.0 -! -!WC_MO2/SO2=0.0 -! -!WC_MO2/SULF=0.0 -! -!WC_MO2/CO=0.0 -! -!WC_MO2/OH=0.0 -! -!WC_MO2/HO2=0.0 -! -!WC_MO2/CH4=0.0 -! -!WC_MO2/ETH=0.0 -! -!WC_MO2/ALKA=0.0 -! -!WC_MO2/ALKE=0.0 -! -!WC_MO2/BIO=0.0 -! -!WC_MO2/ARO=0.0 -! -!WC_MO2/HCHO=0.0 -! -!WC_MO2/ALD=0.0 -! -!WC_MO2/KET=0.0 -! -!WC_MO2/CARBO=0.0 -! -!WC_MO2/ONIT=0.0 -! -!WC_MO2/PAN=0.0 -! -!WC_MO2/OP1=0.0 -! -!WC_MO2/OP2=0.0 -! -!WC_MO2/ORA1=0.0 -! -!WC_MO2/ORA2=0.0 -! -!WC_MO2/MO2=+KTC19 - PJAC(:,61,33)=+TPK%KTC19(:) -! -!WC_MO2/ALKAP=0.0 -! -!WC_MO2/ALKEP=0.0 -! -!WC_MO2/BIOP=0.0 -! -!WC_MO2/PHO=0.0 -! -!WC_MO2/ADD=0.0 -! -!WC_MO2/AROP=0.0 -! -!WC_MO2/CARBOP=0.0 -! -!WC_MO2/OLN=0.0 -! -!WC_MO2/XO2=0.0 -! -!WC_MO2/WC_O3=0.0 -! -!WC_MO2/WC_H2O2=0.0 -! -!WC_MO2/WC_NO=0.0 -! -!WC_MO2/WC_NO2=0.0 -! -!WC_MO2/WC_NO3=0.0 -! -!WC_MO2/WC_N2O5=0.0 -! -!WC_MO2/WC_HONO=0.0 -! -!WC_MO2/WC_HNO3=0.0 -! -!WC_MO2/WC_HNO4=0.0 -! -!WC_MO2/WC_NH3=0.0 -! -!WC_MO2/WC_OH=0.0 -! -!WC_MO2/WC_HO2=0.0 -! -!WC_MO2/WC_CO2=0.0 -! -!WC_MO2/WC_SO2=-KC18*<WC_MO2> - PJAC(:,61,56)=-TPK%KC18(:)*PCONC(:,61) -! -!WC_MO2/WC_SULF=0.0 -! -!WC_MO2/WC_HCHO=0.0 -! -!WC_MO2/WC_ORA1=0.0 -! -!WC_MO2/WC_ORA2=0.0 -! -!WC_MO2/WC_MO2=-KTC39-KC17*<WC_MO2>-KC17*<WC_MO2>-KC17*<WC_MO2>-KC17*<WC_MO2>-K -!C18*<WC_SO2> - PJAC(:,61,61)=-TPK%KTC39(:)-TPK%KC17(:)*PCONC(:,61)-TPK%KC17(:)*PCONC(:,61)-TP& -&K%KC17(:)*PCONC(:,61)-TPK%KC17(:)*PCONC(:,61)-TPK%KC18(:)*PCONC(:,56) -! -!WC_MO2/WC_OP1=0.0 -! -!WC_MO2/WC_ASO3=0.0 -! -!WC_MO2/WC_ASO4=0.0 -! -!WC_MO2/WC_ASO5=0.0 -! -!WC_MO2/WC_AHSO5=0.0 -! -!WC_MO2/WC_AHMS=0.0 -! -!WC_MO2/WR_O3=0.0 -! -!WC_MO2/WR_H2O2=0.0 -! -!WC_MO2/WR_NO=0.0 -! -!WC_MO2/WR_NO2=0.0 -! -!WC_MO2/WR_NO3=0.0 -! -!WC_MO2/WR_N2O5=0.0 -! -!WC_MO2/WR_HONO=0.0 -! -!WC_MO2/WR_HNO3=0.0 -! -!WC_MO2/WR_HNO4=0.0 -! -!WC_MO2/WR_NH3=0.0 -! -!WC_MO2/WR_OH=0.0 -! -!WC_MO2/WR_HO2=0.0 -! -!WC_MO2/WR_CO2=0.0 -! -!WC_MO2/WR_SO2=0.0 -! -!WC_MO2/WR_SULF=0.0 -! -!WC_MO2/WR_HCHO=0.0 -! -!WC_MO2/WR_ORA1=0.0 -! -!WC_MO2/WR_ORA2=0.0 -! -!WC_MO2/WR_MO2=0.0 -! -!WC_MO2/WR_OP1=0.0 -! -!WC_MO2/WR_ASO3=0.0 -! -!WC_MO2/WR_ASO4=0.0 -! -!WC_MO2/WR_ASO5=0.0 -! -!WC_MO2/WR_AHSO5=0.0 -! -!WC_MO2/WR_AHMS=0.0 -! -!WC_OP1/O3=0.0 -! -!WC_OP1/H2O2=0.0 -! -!WC_OP1/NO=0.0 -! -!WC_OP1/NO2=0.0 -! -!WC_OP1/NO3=0.0 -! -!WC_OP1/N2O5=0.0 -! -!WC_OP1/HONO=0.0 -! -!WC_OP1/HNO3=0.0 -! -!WC_OP1/HNO4=0.0 -! -!WC_OP1/NH3=0.0 -! -!WC_OP1/DMS=0.0 -! -!WC_OP1/SO2=0.0 -! -!WC_OP1/SULF=0.0 -! -!WC_OP1/CO=0.0 -! -!WC_OP1/OH=0.0 -! -!WC_OP1/HO2=0.0 -! -!WC_OP1/CH4=0.0 -! -!WC_OP1/ETH=0.0 -! -!WC_OP1/ALKA=0.0 -! -!WC_OP1/ALKE=0.0 -! -!WC_OP1/BIO=0.0 -! -!WC_OP1/ARO=0.0 -! -!WC_OP1/HCHO=0.0 -! -!WC_OP1/ALD=0.0 -! -!WC_OP1/KET=0.0 -! -!WC_OP1/CARBO=0.0 -! -!WC_OP1/ONIT=0.0 -! -!WC_OP1/PAN=0.0 -! -!WC_OP1/OP1=+KTC20 - PJAC(:,62,29)=+TPK%KTC20(:) -! -!WC_OP1/OP2=0.0 -! -!WC_OP1/ORA1=0.0 -! -!WC_OP1/ORA2=0.0 -! -!WC_OP1/MO2=0.0 -! -!WC_OP1/ALKAP=0.0 -! -!WC_OP1/ALKEP=0.0 -! -!WC_OP1/BIOP=0.0 -! -!WC_OP1/PHO=0.0 -! -!WC_OP1/ADD=0.0 -! -!WC_OP1/AROP=0.0 -! -!WC_OP1/CARBOP=0.0 -! -!WC_OP1/OLN=0.0 -! -!WC_OP1/XO2=0.0 -! -!WC_OP1/WC_O3=0.0 -! -!WC_OP1/WC_H2O2=0.0 -! -!WC_OP1/WC_NO=0.0 -! -!WC_OP1/WC_NO2=0.0 -! -!WC_OP1/WC_NO3=0.0 -! -!WC_OP1/WC_N2O5=0.0 -! -!WC_OP1/WC_HONO=0.0 -! -!WC_OP1/WC_HNO3=0.0 -! -!WC_OP1/WC_HNO4=0.0 -! -!WC_OP1/WC_NH3=0.0 -! -!WC_OP1/WC_OH=0.0 -! -!WC_OP1/WC_HO2=0.0 -! -!WC_OP1/WC_CO2=0.0 -! -!WC_OP1/WC_SO2=+KC18*<WC_MO2> - PJAC(:,62,56)=+TPK%KC18(:)*PCONC(:,61) -! -!WC_OP1/WC_SULF=0.0 -! -!WC_OP1/WC_HCHO=0.0 -! -!WC_OP1/WC_ORA1=0.0 -! -!WC_OP1/WC_ORA2=0.0 -! -!WC_OP1/WC_MO2=+KC18*<WC_SO2> - PJAC(:,62,61)=+TPK%KC18(:)*PCONC(:,56) -! -!WC_OP1/WC_OP1=-KTC40 - PJAC(:,62,62)=-TPK%KTC40(:) -! -!WC_OP1/WC_ASO3=0.0 -! -!WC_OP1/WC_ASO4=0.0 -! -!WC_OP1/WC_ASO5=0.0 -! -!WC_OP1/WC_AHSO5=0.0 -! -!WC_OP1/WC_AHMS=0.0 -! -!WC_OP1/WR_O3=0.0 -! -!WC_OP1/WR_H2O2=0.0 -! -!WC_OP1/WR_NO=0.0 -! -!WC_OP1/WR_NO2=0.0 -! -!WC_OP1/WR_NO3=0.0 -! -!WC_OP1/WR_N2O5=0.0 -! -!WC_OP1/WR_HONO=0.0 -! -!WC_OP1/WR_HNO3=0.0 -! -!WC_OP1/WR_HNO4=0.0 -! -!WC_OP1/WR_NH3=0.0 -! -!WC_OP1/WR_OH=0.0 -! -!WC_OP1/WR_HO2=0.0 -! -!WC_OP1/WR_CO2=0.0 -! -!WC_OP1/WR_SO2=0.0 -! -!WC_OP1/WR_SULF=0.0 -! -!WC_OP1/WR_HCHO=0.0 -! -!WC_OP1/WR_ORA1=0.0 -! -!WC_OP1/WR_ORA2=0.0 -! -!WC_OP1/WR_MO2=0.0 -! -!WC_OP1/WR_OP1=0.0 -! -!WC_OP1/WR_ASO3=0.0 -! -!WC_OP1/WR_ASO4=0.0 -! -!WC_OP1/WR_ASO5=0.0 -! -!WC_OP1/WR_AHSO5=0.0 -! -!WC_OP1/WR_AHMS=0.0 -! -!WC_ASO3/O3=0.0 -! -!WC_ASO3/H2O2=0.0 -! -!WC_ASO3/NO=0.0 -! -!WC_ASO3/NO2=0.0 -! -!WC_ASO3/NO3=0.0 -! -!WC_ASO3/N2O5=0.0 -! -!WC_ASO3/HONO=0.0 -! -!WC_ASO3/HNO3=0.0 -! -!WC_ASO3/HNO4=0.0 -! -!WC_ASO3/NH3=0.0 -! -!WC_ASO3/DMS=0.0 -! -!WC_ASO3/SO2=0.0 -! -!WC_ASO3/SULF=0.0 -! -!WC_ASO3/CO=0.0 -! -!WC_ASO3/OH=0.0 -! -!WC_ASO3/HO2=0.0 -! -!WC_ASO3/CH4=0.0 -! -!WC_ASO3/ETH=0.0 -! -!WC_ASO3/ALKA=0.0 -! -!WC_ASO3/ALKE=0.0 -! -!WC_ASO3/BIO=0.0 -! -!WC_ASO3/ARO=0.0 -! -!WC_ASO3/HCHO=0.0 -! -!WC_ASO3/ALD=0.0 -! -!WC_ASO3/KET=0.0 -! -!WC_ASO3/CARBO=0.0 -! -!WC_ASO3/ONIT=0.0 -! -!WC_ASO3/PAN=0.0 -! -!WC_ASO3/OP1=0.0 -! -!WC_ASO3/OP2=0.0 -! -!WC_ASO3/ORA1=0.0 -! -!WC_ASO3/ORA2=0.0 -! -!WC_ASO3/MO2=0.0 -! -!WC_ASO3/ALKAP=0.0 -! -!WC_ASO3/ALKEP=0.0 -! -!WC_ASO3/BIOP=0.0 -! -!WC_ASO3/PHO=0.0 -! -!WC_ASO3/ADD=0.0 -! -!WC_ASO3/AROP=0.0 -! -!WC_ASO3/CARBOP=0.0 -! -!WC_ASO3/OLN=0.0 -! -!WC_ASO3/XO2=0.0 -! -!WC_ASO3/WC_O3=0.0 -! -!WC_ASO3/WC_H2O2=0.0 -! -!WC_ASO3/WC_NO=0.0 -! -!WC_ASO3/WC_NO2=0.0 -! -!WC_ASO3/WC_NO3=+KC16*<WC_SO2> - PJAC(:,63,47)=+TPK%KC16(:)*PCONC(:,56) -! -!WC_ASO3/WC_N2O5=0.0 -! -!WC_ASO3/WC_HONO=0.0 -! -!WC_ASO3/WC_HNO3=0.0 -! -!WC_ASO3/WC_HNO4=0.0 -! -!WC_ASO3/WC_NH3=0.0 -! -!WC_ASO3/WC_OH=+KC7*<WC_SO2> - PJAC(:,63,53)=+TPK%KC7(:)*PCONC(:,56) -! -!WC_ASO3/WC_HO2=0.0 -! -!WC_ASO3/WC_CO2=0.0 -! -!WC_ASO3/WC_SO2=+KC7*<WC_OH>+KC16*<WC_NO3>+KC18*<WC_MO2> - PJAC(:,63,56)=+TPK%KC7(:)*PCONC(:,53)+TPK%KC16(:)*PCONC(:,47)+TPK%KC18(:)*PCON& -&C(:,61) -! -!WC_ASO3/WC_SULF=0.0 -! -!WC_ASO3/WC_HCHO=0.0 -! -!WC_ASO3/WC_ORA1=0.0 -! -!WC_ASO3/WC_ORA2=0.0 -! -!WC_ASO3/WC_MO2=+KC18*<WC_SO2> - PJAC(:,63,61)=+TPK%KC18(:)*PCONC(:,56) -! -!WC_ASO3/WC_OP1=0.0 -! -!WC_ASO3/WC_ASO3=-KC24*<W_O2> - PJAC(:,63,63)=-TPK%KC24(:)*TPK%W_O2(:) -! -!WC_ASO3/WC_ASO4=0.0 -! -!WC_ASO3/WC_ASO5=0.0 -! -!WC_ASO3/WC_AHSO5=0.0 -! -!WC_ASO3/WC_AHMS=0.0 -! -!WC_ASO3/WR_O3=0.0 -! -!WC_ASO3/WR_H2O2=0.0 -! -!WC_ASO3/WR_NO=0.0 -! -!WC_ASO3/WR_NO2=0.0 -! -!WC_ASO3/WR_NO3=0.0 -! -!WC_ASO3/WR_N2O5=0.0 -! -!WC_ASO3/WR_HONO=0.0 -! -!WC_ASO3/WR_HNO3=0.0 -! -!WC_ASO3/WR_HNO4=0.0 -! -!WC_ASO3/WR_NH3=0.0 -! -!WC_ASO3/WR_OH=0.0 -! -!WC_ASO3/WR_HO2=0.0 -! -!WC_ASO3/WR_CO2=0.0 -! -!WC_ASO3/WR_SO2=0.0 -! -!WC_ASO3/WR_SULF=0.0 -! -!WC_ASO3/WR_HCHO=0.0 -! -!WC_ASO3/WR_ORA1=0.0 -! -!WC_ASO3/WR_ORA2=0.0 -! -!WC_ASO3/WR_MO2=0.0 -! -!WC_ASO3/WR_OP1=0.0 -! -!WC_ASO3/WR_ASO3=0.0 -! -!WC_ASO3/WR_ASO4=0.0 -! -!WC_ASO3/WR_ASO5=0.0 -! -!WC_ASO3/WR_AHSO5=0.0 -! -!WC_ASO3/WR_AHMS=0.0 -! -!WC_ASO4/O3=0.0 -! -!WC_ASO4/H2O2=0.0 -! -!WC_ASO4/NO=0.0 -! -!WC_ASO4/NO2=0.0 -! -!WC_ASO4/NO3=0.0 -! -!WC_ASO4/N2O5=0.0 -! -!WC_ASO4/HONO=0.0 -! -!WC_ASO4/HNO3=0.0 -! -!WC_ASO4/HNO4=0.0 -! -!WC_ASO4/NH3=0.0 -! -!WC_ASO4/DMS=0.0 -! -!WC_ASO4/SO2=0.0 -! -!WC_ASO4/SULF=0.0 -! -!WC_ASO4/CO=0.0 -! -!WC_ASO4/OH=0.0 -! -!WC_ASO4/HO2=0.0 -! -!WC_ASO4/CH4=0.0 -! -!WC_ASO4/ETH=0.0 -! -!WC_ASO4/ALKA=0.0 -! -!WC_ASO4/ALKE=0.0 -! -!WC_ASO4/BIO=0.0 -! -!WC_ASO4/ARO=0.0 -! -!WC_ASO4/HCHO=0.0 -! -!WC_ASO4/ALD=0.0 -! -!WC_ASO4/KET=0.0 -! -!WC_ASO4/CARBO=0.0 -! -!WC_ASO4/ONIT=0.0 -! -!WC_ASO4/PAN=0.0 -! -!WC_ASO4/OP1=0.0 -! -!WC_ASO4/OP2=0.0 -! -!WC_ASO4/ORA1=0.0 -! -!WC_ASO4/ORA2=0.0 -! -!WC_ASO4/MO2=0.0 -! -!WC_ASO4/ALKAP=0.0 -! -!WC_ASO4/ALKEP=0.0 -! -!WC_ASO4/BIOP=0.0 -! -!WC_ASO4/PHO=0.0 -! -!WC_ASO4/ADD=0.0 -! -!WC_ASO4/AROP=0.0 -! -!WC_ASO4/CARBOP=0.0 -! -!WC_ASO4/OLN=0.0 -! -!WC_ASO4/XO2=0.0 -! -!WC_ASO4/WC_O3=0.0 -! -!WC_ASO4/WC_H2O2=0.0 -! -!WC_ASO4/WC_NO=0.0 -! -!WC_ASO4/WC_NO2=0.0 -! -!WC_ASO4/WC_NO3=+KC15*<WC_SULF> - PJAC(:,64,47)=+TPK%KC15(:)*PCONC(:,57) -! -!WC_ASO4/WC_N2O5=0.0 -! -!WC_ASO4/WC_HONO=0.0 -! -!WC_ASO4/WC_HNO3=0.0 -! -!WC_ASO4/WC_HNO4=0.0 -! -!WC_ASO4/WC_NH3=0.0 -! -!WC_ASO4/WC_OH=0.0 -! -!WC_ASO4/WC_HO2=0.0 -! -!WC_ASO4/WC_CO2=0.0 -! -!WC_ASO4/WC_SO2=0.0 -! -!WC_ASO4/WC_SULF=+KC15*<WC_NO3> - PJAC(:,64,57)=+TPK%KC15(:)*PCONC(:,47) -! -!WC_ASO4/WC_HCHO=0.0 -! -!WC_ASO4/WC_ORA1=0.0 -! -!WC_ASO4/WC_ORA2=0.0 -! -!WC_ASO4/WC_MO2=0.0 -! -!WC_ASO4/WC_OP1=0.0 -! -!WC_ASO4/WC_ASO3=0.0 -! -!WC_ASO4/WC_ASO4=-KC28 - PJAC(:,64,64)=-TPK%KC28(:) -! -!WC_ASO4/WC_ASO5=+KC26*<WC_ASO5>+KC26*<WC_ASO5>+KC26*<WC_ASO5>+KC26*<WC_ASO5> - PJAC(:,64,65)=+TPK%KC26(:)*PCONC(:,65)+TPK%KC26(:)*PCONC(:,65)+TPK%KC26(:)*PCO& -&NC(:,65)+TPK%KC26(:)*PCONC(:,65) -! -!WC_ASO4/WC_AHSO5=0.0 -! -!WC_ASO4/WC_AHMS=0.0 -! -!WC_ASO4/WR_O3=0.0 -! -!WC_ASO4/WR_H2O2=0.0 -! -!WC_ASO4/WR_NO=0.0 -! -!WC_ASO4/WR_NO2=0.0 -! -!WC_ASO4/WR_NO3=0.0 -! -!WC_ASO4/WR_N2O5=0.0 -! -!WC_ASO4/WR_HONO=0.0 -! -!WC_ASO4/WR_HNO3=0.0 -! -!WC_ASO4/WR_HNO4=0.0 -! -!WC_ASO4/WR_NH3=0.0 -! -!WC_ASO4/WR_OH=0.0 -! -!WC_ASO4/WR_HO2=0.0 -! -!WC_ASO4/WR_CO2=0.0 -! -!WC_ASO4/WR_SO2=0.0 -! -!WC_ASO4/WR_SULF=0.0 -! -!WC_ASO4/WR_HCHO=0.0 -! -!WC_ASO4/WR_ORA1=0.0 -! -!WC_ASO4/WR_ORA2=0.0 -! -!WC_ASO4/WR_MO2=0.0 -! -!WC_ASO4/WR_OP1=0.0 -! -!WC_ASO4/WR_ASO3=0.0 -! -!WC_ASO4/WR_ASO4=0.0 -! -!WC_ASO4/WR_ASO5=0.0 -! -!WC_ASO4/WR_AHSO5=0.0 -! -!WC_ASO4/WR_AHMS=0.0 -! -!WC_ASO5/O3=0.0 -! -!WC_ASO5/H2O2=0.0 -! -!WC_ASO5/NO=0.0 -! -!WC_ASO5/NO2=0.0 -! -!WC_ASO5/NO3=0.0 -! -!WC_ASO5/N2O5=0.0 -! -!WC_ASO5/HONO=0.0 -! -!WC_ASO5/HNO3=0.0 -! -!WC_ASO5/HNO4=0.0 -! -!WC_ASO5/NH3=0.0 -! -!WC_ASO5/DMS=0.0 -! -!WC_ASO5/SO2=0.0 -! -!WC_ASO5/SULF=0.0 -! -!WC_ASO5/CO=0.0 -! -!WC_ASO5/OH=0.0 -! -!WC_ASO5/HO2=0.0 -! -!WC_ASO5/CH4=0.0 -! -!WC_ASO5/ETH=0.0 -! -!WC_ASO5/ALKA=0.0 -! -!WC_ASO5/ALKE=0.0 -! -!WC_ASO5/BIO=0.0 -! -!WC_ASO5/ARO=0.0 -! -!WC_ASO5/HCHO=0.0 -! -!WC_ASO5/ALD=0.0 -! -!WC_ASO5/KET=0.0 -! -!WC_ASO5/CARBO=0.0 -! -!WC_ASO5/ONIT=0.0 -! -!WC_ASO5/PAN=0.0 -! -!WC_ASO5/OP1=0.0 -! -!WC_ASO5/OP2=0.0 -! -!WC_ASO5/ORA1=0.0 -! -!WC_ASO5/ORA2=0.0 -! -!WC_ASO5/MO2=0.0 -! -!WC_ASO5/ALKAP=0.0 -! -!WC_ASO5/ALKEP=0.0 -! -!WC_ASO5/BIOP=0.0 -! -!WC_ASO5/PHO=0.0 -! -!WC_ASO5/ADD=0.0 -! -!WC_ASO5/AROP=0.0 -! -!WC_ASO5/CARBOP=0.0 -! -!WC_ASO5/OLN=0.0 -! -!WC_ASO5/XO2=0.0 -! -!WC_ASO5/WC_O3=0.0 -! -!WC_ASO5/WC_H2O2=0.0 -! -!WC_ASO5/WC_NO=0.0 -! -!WC_ASO5/WC_NO2=0.0 -! -!WC_ASO5/WC_NO3=0.0 -! -!WC_ASO5/WC_N2O5=0.0 -! -!WC_ASO5/WC_HONO=0.0 -! -!WC_ASO5/WC_HNO3=0.0 -! -!WC_ASO5/WC_HNO4=0.0 -! -!WC_ASO5/WC_NH3=0.0 -! -!WC_ASO5/WC_OH=0.0 -! -!WC_ASO5/WC_HO2=-KC25*<WC_ASO5> - PJAC(:,65,54)=-TPK%KC25(:)*PCONC(:,65) -! -!WC_ASO5/WC_CO2=0.0 -! -!WC_ASO5/WC_SO2=0.0 -! -!WC_ASO5/WC_SULF=0.0 -! -!WC_ASO5/WC_HCHO=0.0 -! -!WC_ASO5/WC_ORA1=0.0 -! -!WC_ASO5/WC_ORA2=0.0 -! -!WC_ASO5/WC_MO2=0.0 -! -!WC_ASO5/WC_OP1=0.0 -! -!WC_ASO5/WC_ASO3=+KC24*<W_O2> - PJAC(:,65,63)=+TPK%KC24(:)*TPK%W_O2(:) -! -!WC_ASO5/WC_ASO4=0.0 -! -!WC_ASO5/WC_ASO5=-KC25*<WC_HO2>-KC26*<WC_ASO5>-KC26*<WC_ASO5>-KC26*<WC_ASO5>-KC -!26*<WC_ASO5> - PJAC(:,65,65)=-TPK%KC25(:)*PCONC(:,54)-TPK%KC26(:)*PCONC(:,65)-TPK%KC26(:)*PCO& -&NC(:,65)-TPK%KC26(:)*PCONC(:,65)-TPK%KC26(:)*PCONC(:,65) -! -!WC_ASO5/WC_AHSO5=0.0 -! -!WC_ASO5/WC_AHMS=0.0 -! -!WC_ASO5/WR_O3=0.0 -! -!WC_ASO5/WR_H2O2=0.0 -! -!WC_ASO5/WR_NO=0.0 -! -!WC_ASO5/WR_NO2=0.0 -! -!WC_ASO5/WR_NO3=0.0 -! -!WC_ASO5/WR_N2O5=0.0 -! -!WC_ASO5/WR_HONO=0.0 -! -!WC_ASO5/WR_HNO3=0.0 -! -!WC_ASO5/WR_HNO4=0.0 -! -!WC_ASO5/WR_NH3=0.0 -! -!WC_ASO5/WR_OH=0.0 -! -!WC_ASO5/WR_HO2=0.0 -! -!WC_ASO5/WR_CO2=0.0 -! -!WC_ASO5/WR_SO2=0.0 -! -!WC_ASO5/WR_SULF=0.0 -! -!WC_ASO5/WR_HCHO=0.0 -! -!WC_ASO5/WR_ORA1=0.0 -! -!WC_ASO5/WR_ORA2=0.0 -! -!WC_ASO5/WR_MO2=0.0 -! -!WC_ASO5/WR_OP1=0.0 -! -!WC_ASO5/WR_ASO3=0.0 -! -!WC_ASO5/WR_ASO4=0.0 -! -!WC_ASO5/WR_ASO5=0.0 -! -!WC_ASO5/WR_AHSO5=0.0 -! -!WC_ASO5/WR_AHMS=0.0 -! -RETURN -END SUBROUTINE SUBJ12 -! -SUBROUTINE SUBJ13 -! -!Indices 66 a 70 -! -! -!WC_AHSO5/O3=0.0 -! -!WC_AHSO5/H2O2=0.0 -! -!WC_AHSO5/NO=0.0 -! -!WC_AHSO5/NO2=0.0 -! -!WC_AHSO5/NO3=0.0 -! -!WC_AHSO5/N2O5=0.0 -! -!WC_AHSO5/HONO=0.0 -! -!WC_AHSO5/HNO3=0.0 -! -!WC_AHSO5/HNO4=0.0 -! -!WC_AHSO5/NH3=0.0 -! -!WC_AHSO5/DMS=0.0 -! -!WC_AHSO5/SO2=0.0 -! -!WC_AHSO5/SULF=0.0 -! -!WC_AHSO5/CO=0.0 -! -!WC_AHSO5/OH=0.0 -! -!WC_AHSO5/HO2=0.0 -! -!WC_AHSO5/CH4=0.0 -! -!WC_AHSO5/ETH=0.0 -! -!WC_AHSO5/ALKA=0.0 -! -!WC_AHSO5/ALKE=0.0 -! -!WC_AHSO5/BIO=0.0 -! -!WC_AHSO5/ARO=0.0 -! -!WC_AHSO5/HCHO=0.0 -! -!WC_AHSO5/ALD=0.0 -! -!WC_AHSO5/KET=0.0 -! -!WC_AHSO5/CARBO=0.0 -! -!WC_AHSO5/ONIT=0.0 -! -!WC_AHSO5/PAN=0.0 -! -!WC_AHSO5/OP1=0.0 -! -!WC_AHSO5/OP2=0.0 -! -!WC_AHSO5/ORA1=0.0 -! -!WC_AHSO5/ORA2=0.0 -! -!WC_AHSO5/MO2=0.0 -! -!WC_AHSO5/ALKAP=0.0 -! -!WC_AHSO5/ALKEP=0.0 -! -!WC_AHSO5/BIOP=0.0 -! -!WC_AHSO5/PHO=0.0 -! -!WC_AHSO5/ADD=0.0 -! -!WC_AHSO5/AROP=0.0 -! -!WC_AHSO5/CARBOP=0.0 -! -!WC_AHSO5/OLN=0.0 -! -!WC_AHSO5/XO2=0.0 -! -!WC_AHSO5/WC_O3=0.0 -! -!WC_AHSO5/WC_H2O2=0.0 -! -!WC_AHSO5/WC_NO=0.0 -! -!WC_AHSO5/WC_NO2=0.0 -! -!WC_AHSO5/WC_NO3=0.0 -! -!WC_AHSO5/WC_N2O5=0.0 -! -!WC_AHSO5/WC_HONO=0.0 -! -!WC_AHSO5/WC_HNO3=0.0 -! -!WC_AHSO5/WC_HNO4=0.0 -! -!WC_AHSO5/WC_NH3=0.0 -! -!WC_AHSO5/WC_OH=0.0 -! -!WC_AHSO5/WC_HO2=+KC25*<WC_ASO5> - PJAC(:,66,54)=+TPK%KC25(:)*PCONC(:,65) -! -!WC_AHSO5/WC_CO2=0.0 -! -!WC_AHSO5/WC_SO2=-KC27*<WC_AHSO5> - PJAC(:,66,56)=-TPK%KC27(:)*PCONC(:,66) -! -!WC_AHSO5/WC_SULF=0.0 -! -!WC_AHSO5/WC_HCHO=0.0 -! -!WC_AHSO5/WC_ORA1=0.0 -! -!WC_AHSO5/WC_ORA2=0.0 -! -!WC_AHSO5/WC_MO2=0.0 -! -!WC_AHSO5/WC_OP1=0.0 -! -!WC_AHSO5/WC_ASO3=0.0 -! -!WC_AHSO5/WC_ASO4=0.0 -! -!WC_AHSO5/WC_ASO5=+KC25*<WC_HO2> - PJAC(:,66,65)=+TPK%KC25(:)*PCONC(:,54) -! -!WC_AHSO5/WC_AHSO5=-KC27*<WC_SO2> - PJAC(:,66,66)=-TPK%KC27(:)*PCONC(:,56) -! -!WC_AHSO5/WC_AHMS=0.0 -! -!WC_AHSO5/WR_O3=0.0 -! -!WC_AHSO5/WR_H2O2=0.0 -! -!WC_AHSO5/WR_NO=0.0 -! -!WC_AHSO5/WR_NO2=0.0 -! -!WC_AHSO5/WR_NO3=0.0 -! -!WC_AHSO5/WR_N2O5=0.0 -! -!WC_AHSO5/WR_HONO=0.0 -! -!WC_AHSO5/WR_HNO3=0.0 -! -!WC_AHSO5/WR_HNO4=0.0 -! -!WC_AHSO5/WR_NH3=0.0 -! -!WC_AHSO5/WR_OH=0.0 -! -!WC_AHSO5/WR_HO2=0.0 -! -!WC_AHSO5/WR_CO2=0.0 -! -!WC_AHSO5/WR_SO2=0.0 -! -!WC_AHSO5/WR_SULF=0.0 -! -!WC_AHSO5/WR_HCHO=0.0 -! -!WC_AHSO5/WR_ORA1=0.0 -! -!WC_AHSO5/WR_ORA2=0.0 -! -!WC_AHSO5/WR_MO2=0.0 -! -!WC_AHSO5/WR_OP1=0.0 -! -!WC_AHSO5/WR_ASO3=0.0 -! -!WC_AHSO5/WR_ASO4=0.0 -! -!WC_AHSO5/WR_ASO5=0.0 -! -!WC_AHSO5/WR_AHSO5=0.0 -! -!WC_AHSO5/WR_AHMS=0.0 -! -!WC_AHMS/O3=0.0 -! -!WC_AHMS/H2O2=0.0 -! -!WC_AHMS/NO=0.0 -! -!WC_AHMS/NO2=0.0 -! -!WC_AHMS/NO3=0.0 -! -!WC_AHMS/N2O5=0.0 -! -!WC_AHMS/HONO=0.0 -! -!WC_AHMS/HNO3=0.0 -! -!WC_AHMS/HNO4=0.0 -! -!WC_AHMS/NH3=0.0 -! -!WC_AHMS/DMS=0.0 -! -!WC_AHMS/SO2=0.0 -! -!WC_AHMS/SULF=0.0 -! -!WC_AHMS/CO=0.0 -! -!WC_AHMS/OH=0.0 -! -!WC_AHMS/HO2=0.0 -! -!WC_AHMS/CH4=0.0 -! -!WC_AHMS/ETH=0.0 -! -!WC_AHMS/ALKA=0.0 -! -!WC_AHMS/ALKE=0.0 -! -!WC_AHMS/BIO=0.0 -! -!WC_AHMS/ARO=0.0 -! -!WC_AHMS/HCHO=0.0 -! -!WC_AHMS/ALD=0.0 -! -!WC_AHMS/KET=0.0 -! -!WC_AHMS/CARBO=0.0 -! -!WC_AHMS/ONIT=0.0 -! -!WC_AHMS/PAN=0.0 -! -!WC_AHMS/OP1=0.0 -! -!WC_AHMS/OP2=0.0 -! -!WC_AHMS/ORA1=0.0 -! -!WC_AHMS/ORA2=0.0 -! -!WC_AHMS/MO2=0.0 -! -!WC_AHMS/ALKAP=0.0 -! -!WC_AHMS/ALKEP=0.0 -! -!WC_AHMS/BIOP=0.0 -! -!WC_AHMS/PHO=0.0 -! -!WC_AHMS/ADD=0.0 -! -!WC_AHMS/AROP=0.0 -! -!WC_AHMS/CARBOP=0.0 -! -!WC_AHMS/OLN=0.0 -! -!WC_AHMS/XO2=0.0 -! -!WC_AHMS/WC_O3=0.0 -! -!WC_AHMS/WC_H2O2=0.0 -! -!WC_AHMS/WC_NO=0.0 -! -!WC_AHMS/WC_NO2=0.0 -! -!WC_AHMS/WC_NO3=0.0 -! -!WC_AHMS/WC_N2O5=0.0 -! -!WC_AHMS/WC_HONO=0.0 -! -!WC_AHMS/WC_HNO3=0.0 -! -!WC_AHMS/WC_HNO4=0.0 -! -!WC_AHMS/WC_NH3=0.0 -! -!WC_AHMS/WC_OH=-KC23*<WC_AHMS> - PJAC(:,67,53)=-TPK%KC23(:)*PCONC(:,67) -! -!WC_AHMS/WC_HO2=0.0 -! -!WC_AHMS/WC_CO2=0.0 -! -!WC_AHMS/WC_SO2=+KC21*<WC_HCHO> - PJAC(:,67,56)=+TPK%KC21(:)*PCONC(:,58) -! -!WC_AHMS/WC_SULF=0.0 -! -!WC_AHMS/WC_HCHO=+KC21*<WC_SO2> - PJAC(:,67,58)=+TPK%KC21(:)*PCONC(:,56) -! -!WC_AHMS/WC_ORA1=0.0 -! -!WC_AHMS/WC_ORA2=0.0 -! -!WC_AHMS/WC_MO2=0.0 -! -!WC_AHMS/WC_OP1=0.0 -! -!WC_AHMS/WC_ASO3=0.0 -! -!WC_AHMS/WC_ASO4=0.0 -! -!WC_AHMS/WC_ASO5=0.0 -! -!WC_AHMS/WC_AHSO5=0.0 -! -!WC_AHMS/WC_AHMS=-KC22-KC23*<WC_OH> - PJAC(:,67,67)=-TPK%KC22(:)-TPK%KC23(:)*PCONC(:,53) -! -!WC_AHMS/WR_O3=0.0 -! -!WC_AHMS/WR_H2O2=0.0 -! -!WC_AHMS/WR_NO=0.0 -! -!WC_AHMS/WR_NO2=0.0 -! -!WC_AHMS/WR_NO3=0.0 -! -!WC_AHMS/WR_N2O5=0.0 -! -!WC_AHMS/WR_HONO=0.0 -! -!WC_AHMS/WR_HNO3=0.0 -! -!WC_AHMS/WR_HNO4=0.0 -! -!WC_AHMS/WR_NH3=0.0 -! -!WC_AHMS/WR_OH=0.0 -! -!WC_AHMS/WR_HO2=0.0 -! -!WC_AHMS/WR_CO2=0.0 -! -!WC_AHMS/WR_SO2=0.0 -! -!WC_AHMS/WR_SULF=0.0 -! -!WC_AHMS/WR_HCHO=0.0 -! -!WC_AHMS/WR_ORA1=0.0 -! -!WC_AHMS/WR_ORA2=0.0 -! -!WC_AHMS/WR_MO2=0.0 -! -!WC_AHMS/WR_OP1=0.0 -! -!WC_AHMS/WR_ASO3=0.0 -! -!WC_AHMS/WR_ASO4=0.0 -! -!WC_AHMS/WR_ASO5=0.0 -! -!WC_AHMS/WR_AHSO5=0.0 -! -!WC_AHMS/WR_AHMS=0.0 -! -!WR_O3/O3=+KTR1 - PJAC(:,68,1)=+TPK%KTR1(:) -! -!WR_O3/H2O2=0.0 -! -!WR_O3/NO=0.0 -! -!WR_O3/NO2=0.0 -! -!WR_O3/NO3=0.0 -! -!WR_O3/N2O5=0.0 -! -!WR_O3/HONO=0.0 -! -!WR_O3/HNO3=0.0 -! -!WR_O3/HNO4=0.0 -! -!WR_O3/NH3=0.0 -! -!WR_O3/DMS=0.0 -! -!WR_O3/SO2=0.0 -! -!WR_O3/SULF=0.0 -! -!WR_O3/CO=0.0 -! -!WR_O3/OH=0.0 -! -!WR_O3/HO2=0.0 -! -!WR_O3/CH4=0.0 -! -!WR_O3/ETH=0.0 -! -!WR_O3/ALKA=0.0 -! -!WR_O3/ALKE=0.0 -! -!WR_O3/BIO=0.0 -! -!WR_O3/ARO=0.0 -! -!WR_O3/HCHO=0.0 -! -!WR_O3/ALD=0.0 -! -!WR_O3/KET=0.0 -! -!WR_O3/CARBO=0.0 -! -!WR_O3/ONIT=0.0 -! -!WR_O3/PAN=0.0 -! -!WR_O3/OP1=0.0 -! -!WR_O3/OP2=0.0 -! -!WR_O3/ORA1=0.0 -! -!WR_O3/ORA2=0.0 -! -!WR_O3/MO2=0.0 -! -!WR_O3/ALKAP=0.0 -! -!WR_O3/ALKEP=0.0 -! -!WR_O3/BIOP=0.0 -! -!WR_O3/PHO=0.0 -! -!WR_O3/ADD=0.0 -! -!WR_O3/AROP=0.0 -! -!WR_O3/CARBOP=0.0 -! -!WR_O3/OLN=0.0 -! -!WR_O3/XO2=0.0 -! -!WR_O3/WC_O3=0.0 -! -!WR_O3/WC_H2O2=0.0 -! -!WR_O3/WC_NO=0.0 -! -!WR_O3/WC_NO2=0.0 -! -!WR_O3/WC_NO3=0.0 -! -!WR_O3/WC_N2O5=0.0 -! -!WR_O3/WC_HONO=0.0 -! -!WR_O3/WC_HNO3=0.0 -! -!WR_O3/WC_HNO4=0.0 -! -!WR_O3/WC_NH3=0.0 -! -!WR_O3/WC_OH=0.0 -! -!WR_O3/WC_HO2=0.0 -! -!WR_O3/WC_CO2=0.0 -! -!WR_O3/WC_SO2=0.0 -! -!WR_O3/WC_SULF=0.0 -! -!WR_O3/WC_HCHO=0.0 -! -!WR_O3/WC_ORA1=0.0 -! -!WR_O3/WC_ORA2=0.0 -! -!WR_O3/WC_MO2=0.0 -! -!WR_O3/WC_OP1=0.0 -! -!WR_O3/WC_ASO3=0.0 -! -!WR_O3/WC_ASO4=0.0 -! -!WR_O3/WC_ASO5=0.0 -! -!WR_O3/WC_AHSO5=0.0 -! -!WR_O3/WC_AHMS=0.0 -! -!WR_O3/WR_O3=-KTR21-KR6*<WR_HO2>-KR29*<WR_SO2> - PJAC(:,68,68)=-TPK%KTR21(:)-TPK%KR6(:)*PCONC(:,79)-TPK%KR29(:)*PCONC(:,81) -! -!WR_O3/WR_H2O2=0.0 -! -!WR_O3/WR_NO=0.0 -! -!WR_O3/WR_NO2=0.0 -! -!WR_O3/WR_NO3=0.0 -! -!WR_O3/WR_N2O5=0.0 -! -!WR_O3/WR_HONO=0.0 -! -!WR_O3/WR_HNO3=0.0 -! -!WR_O3/WR_HNO4=0.0 -! -!WR_O3/WR_NH3=0.0 -! -!WR_O3/WR_OH=0.0 -! -!WR_O3/WR_HO2=-KR6*<WR_O3> - PJAC(:,68,79)=-TPK%KR6(:)*PCONC(:,68) -! -!WR_O3/WR_CO2=0.0 -! -!WR_O3/WR_SO2=-KR29*<WR_O3> - PJAC(:,68,81)=-TPK%KR29(:)*PCONC(:,68) -! -!WR_O3/WR_SULF=0.0 -! -!WR_O3/WR_HCHO=0.0 -! -!WR_O3/WR_ORA1=0.0 -! -!WR_O3/WR_ORA2=0.0 -! -!WR_O3/WR_MO2=0.0 -! -!WR_O3/WR_OP1=0.0 -! -!WR_O3/WR_ASO3=0.0 -! -!WR_O3/WR_ASO4=0.0 -! -!WR_O3/WR_ASO5=0.0 -! -!WR_O3/WR_AHSO5=0.0 -! -!WR_O3/WR_AHMS=0.0 -! -!WR_H2O2/O3=0.0 -! -!WR_H2O2/H2O2=+KTR2 - PJAC(:,69,2)=+TPK%KTR2(:) -! -!WR_H2O2/NO=0.0 -! -!WR_H2O2/NO2=0.0 -! -!WR_H2O2/NO3=0.0 -! -!WR_H2O2/N2O5=0.0 -! -!WR_H2O2/HONO=0.0 -! -!WR_H2O2/HNO3=0.0 -! -!WR_H2O2/HNO4=0.0 -! -!WR_H2O2/NH3=0.0 -! -!WR_H2O2/DMS=0.0 -! -!WR_H2O2/SO2=0.0 -! -!WR_H2O2/SULF=0.0 -! -!WR_H2O2/CO=0.0 -! -!WR_H2O2/OH=0.0 -! -!WR_H2O2/HO2=0.0 -! -!WR_H2O2/CH4=0.0 -! -!WR_H2O2/ETH=0.0 -! -!WR_H2O2/ALKA=0.0 -! -!WR_H2O2/ALKE=0.0 -! -!WR_H2O2/BIO=0.0 -! -!WR_H2O2/ARO=0.0 -! -!WR_H2O2/HCHO=0.0 -! -!WR_H2O2/ALD=0.0 -! -!WR_H2O2/KET=0.0 -! -!WR_H2O2/CARBO=0.0 -! -!WR_H2O2/ONIT=0.0 -! -!WR_H2O2/PAN=0.0 -! -!WR_H2O2/OP1=0.0 -! -!WR_H2O2/OP2=0.0 -! -!WR_H2O2/ORA1=0.0 -! -!WR_H2O2/ORA2=0.0 -! -!WR_H2O2/MO2=0.0 -! -!WR_H2O2/ALKAP=0.0 -! -!WR_H2O2/ALKEP=0.0 -! -!WR_H2O2/BIOP=0.0 -! -!WR_H2O2/PHO=0.0 -! -!WR_H2O2/ADD=0.0 -! -!WR_H2O2/AROP=0.0 -! -!WR_H2O2/CARBOP=0.0 -! -!WR_H2O2/OLN=0.0 -! -!WR_H2O2/XO2=0.0 -! -!WR_H2O2/WC_O3=0.0 -! -!WR_H2O2/WC_H2O2=0.0 -! -!WR_H2O2/WC_NO=0.0 -! -!WR_H2O2/WC_NO2=0.0 -! -!WR_H2O2/WC_NO3=0.0 -! -!WR_H2O2/WC_N2O5=0.0 -! -!WR_H2O2/WC_HONO=0.0 -! -!WR_H2O2/WC_HNO3=0.0 -! -!WR_H2O2/WC_HNO4=0.0 -! -!WR_H2O2/WC_NH3=0.0 -! -!WR_H2O2/WC_OH=0.0 -! -!WR_H2O2/WC_HO2=0.0 -! -!WR_H2O2/WC_CO2=0.0 -! -!WR_H2O2/WC_SO2=0.0 -! -!WR_H2O2/WC_SULF=0.0 -! -!WR_H2O2/WC_HCHO=0.0 -! -!WR_H2O2/WC_ORA1=0.0 -! -!WR_H2O2/WC_ORA2=0.0 -! -!WR_H2O2/WC_MO2=0.0 -! -!WR_H2O2/WC_OP1=0.0 -! -!WR_H2O2/WC_ASO3=0.0 -! -!WR_H2O2/WC_ASO4=0.0 -! -!WR_H2O2/WC_ASO5=0.0 -! -!WR_H2O2/WC_AHSO5=0.0 -! -!WR_H2O2/WC_AHMS=0.0 -! -!WR_H2O2/WR_O3=0.0 -! -!WR_H2O2/WR_H2O2=-KTR22-KR1-KR4*<WR_OH>-KR30*<WR_SO2> - PJAC(:,69,69)=-TPK%KTR22(:)-TPK%KR1(:)-TPK%KR4(:)*PCONC(:,78)-TPK%KR30(:)*PCON& -&C(:,81) -! -!WR_H2O2/WR_NO=0.0 -! -!WR_H2O2/WR_NO2=0.0 -! -!WR_H2O2/WR_NO3=0.0 -! -!WR_H2O2/WR_N2O5=0.0 -! -!WR_H2O2/WR_HONO=0.0 -! -!WR_H2O2/WR_HNO3=0.0 -! -!WR_H2O2/WR_HNO4=0.0 -! -!WR_H2O2/WR_NH3=0.0 -! -!WR_H2O2/WR_OH=+KR2*<WR_OH>+KR2*<WR_OH>-KR4*<WR_H2O2> - PJAC(:,69,78)=+TPK%KR2(:)*PCONC(:,78)+TPK%KR2(:)*PCONC(:,78)-TPK%KR4(:)*PCONC(& -&:,69) -! -!WR_H2O2/WR_HO2=+KR5*<WR_HO2>+KR5*<WR_HO2> - PJAC(:,69,79)=+TPK%KR5(:)*PCONC(:,79)+TPK%KR5(:)*PCONC(:,79) -! -!WR_H2O2/WR_CO2=0.0 -! -!WR_H2O2/WR_SO2=-KR30*<WR_H2O2> - PJAC(:,69,81)=-TPK%KR30(:)*PCONC(:,69) -! -!WR_H2O2/WR_SULF=0.0 -! -!WR_H2O2/WR_HCHO=0.0 -! -!WR_H2O2/WR_ORA1=0.0 -! -!WR_H2O2/WR_ORA2=0.0 -! -!WR_H2O2/WR_MO2=0.0 -! -!WR_H2O2/WR_OP1=0.0 -! -!WR_H2O2/WR_ASO3=0.0 -! -!WR_H2O2/WR_ASO4=0.0 -! -!WR_H2O2/WR_ASO5=0.0 -! -!WR_H2O2/WR_AHSO5=0.0 -! -!WR_H2O2/WR_AHMS=0.0 -! -!WR_NO/O3=0.0 -! -!WR_NO/H2O2=0.0 -! -!WR_NO/NO=+KTR3 - PJAC(:,70,3)=+TPK%KTR3(:) -! -!WR_NO/NO2=0.0 -! -!WR_NO/NO3=0.0 -! -!WR_NO/N2O5=0.0 -! -!WR_NO/HONO=0.0 -! -!WR_NO/HNO3=0.0 -! -!WR_NO/HNO4=0.0 -! -!WR_NO/NH3=0.0 -! -!WR_NO/DMS=0.0 -! -!WR_NO/SO2=0.0 -! -!WR_NO/SULF=0.0 -! -!WR_NO/CO=0.0 -! -!WR_NO/OH=0.0 -! -!WR_NO/HO2=0.0 -! -!WR_NO/CH4=0.0 -! -!WR_NO/ETH=0.0 -! -!WR_NO/ALKA=0.0 -! -!WR_NO/ALKE=0.0 -! -!WR_NO/BIO=0.0 -! -!WR_NO/ARO=0.0 -! -!WR_NO/HCHO=0.0 -! -!WR_NO/ALD=0.0 -! -!WR_NO/KET=0.0 -! -!WR_NO/CARBO=0.0 -! -!WR_NO/ONIT=0.0 -! -!WR_NO/PAN=0.0 -! -!WR_NO/OP1=0.0 -! -!WR_NO/OP2=0.0 -! -!WR_NO/ORA1=0.0 -! -!WR_NO/ORA2=0.0 -! -!WR_NO/MO2=0.0 -! -!WR_NO/ALKAP=0.0 -! -!WR_NO/ALKEP=0.0 -! -!WR_NO/BIOP=0.0 -! -!WR_NO/PHO=0.0 -! -!WR_NO/ADD=0.0 -! -!WR_NO/AROP=0.0 -! -!WR_NO/CARBOP=0.0 -! -!WR_NO/OLN=0.0 -! -!WR_NO/XO2=0.0 -! -!WR_NO/WC_O3=0.0 -! -!WR_NO/WC_H2O2=0.0 -! -!WR_NO/WC_NO=0.0 -! -!WR_NO/WC_NO2=0.0 -! -!WR_NO/WC_NO3=0.0 -! -!WR_NO/WC_N2O5=0.0 -! -!WR_NO/WC_HONO=0.0 -! -!WR_NO/WC_HNO3=0.0 -! -!WR_NO/WC_HNO4=0.0 -! -!WR_NO/WC_NH3=0.0 -! -!WR_NO/WC_OH=0.0 -! -!WR_NO/WC_HO2=0.0 -! -!WR_NO/WC_CO2=0.0 -! -!WR_NO/WC_SO2=0.0 -! -!WR_NO/WC_SULF=0.0 -! -!WR_NO/WC_HCHO=0.0 -! -!WR_NO/WC_ORA1=0.0 -! -!WR_NO/WC_ORA2=0.0 -! -!WR_NO/WC_MO2=0.0 -! -!WR_NO/WC_OP1=0.0 -! -!WR_NO/WC_ASO3=0.0 -! -!WR_NO/WC_ASO4=0.0 -! -!WR_NO/WC_ASO5=0.0 -! -!WR_NO/WC_AHSO5=0.0 -! -!WR_NO/WC_AHMS=0.0 -! -!WR_NO/WR_O3=0.0 -! -!WR_NO/WR_H2O2=0.0 -! -!WR_NO/WR_NO=-KTR23 - PJAC(:,70,70)=-TPK%KTR23(:) -! -!WR_NO/WR_NO2=0.0 -! -!WR_NO/WR_NO3=0.0 -! -!WR_NO/WR_N2O5=0.0 -! -!WR_NO/WR_HONO=0.0 -! -!WR_NO/WR_HNO3=0.0 -! -!WR_NO/WR_HNO4=0.0 -! -!WR_NO/WR_NH3=0.0 -! -!WR_NO/WR_OH=0.0 -! -!WR_NO/WR_HO2=0.0 -! -!WR_NO/WR_CO2=0.0 -! -!WR_NO/WR_SO2=0.0 -! -!WR_NO/WR_SULF=0.0 -! -!WR_NO/WR_HCHO=0.0 -! -!WR_NO/WR_ORA1=0.0 -! -!WR_NO/WR_ORA2=0.0 -! -!WR_NO/WR_MO2=0.0 -! -!WR_NO/WR_OP1=0.0 -! -!WR_NO/WR_ASO3=0.0 -! -!WR_NO/WR_ASO4=0.0 -! -!WR_NO/WR_ASO5=0.0 -! -!WR_NO/WR_AHSO5=0.0 -! -!WR_NO/WR_AHMS=0.0 -! -RETURN -END SUBROUTINE SUBJ13 -! -SUBROUTINE SUBJ14 -! -!Indices 71 a 75 -! -! -!WR_NO2/O3=0.0 -! -!WR_NO2/H2O2=0.0 -! -!WR_NO2/NO=0.0 -! -!WR_NO2/NO2=+KTR4 - PJAC(:,71,4)=+TPK%KTR4(:) -! -!WR_NO2/NO3=0.0 -! -!WR_NO2/N2O5=0.0 -! -!WR_NO2/HONO=0.0 -! -!WR_NO2/HNO3=0.0 -! -!WR_NO2/HNO4=0.0 -! -!WR_NO2/NH3=0.0 -! -!WR_NO2/DMS=0.0 -! -!WR_NO2/SO2=0.0 -! -!WR_NO2/SULF=0.0 -! -!WR_NO2/CO=0.0 -! -!WR_NO2/OH=0.0 -! -!WR_NO2/HO2=0.0 -! -!WR_NO2/CH4=0.0 -! -!WR_NO2/ETH=0.0 -! -!WR_NO2/ALKA=0.0 -! -!WR_NO2/ALKE=0.0 -! -!WR_NO2/BIO=0.0 -! -!WR_NO2/ARO=0.0 -! -!WR_NO2/HCHO=0.0 -! -!WR_NO2/ALD=0.0 -! -!WR_NO2/KET=0.0 -! -!WR_NO2/CARBO=0.0 -! -!WR_NO2/ONIT=0.0 -! -!WR_NO2/PAN=0.0 -! -!WR_NO2/OP1=0.0 -! -!WR_NO2/OP2=0.0 -! -!WR_NO2/ORA1=0.0 -! -!WR_NO2/ORA2=0.0 -! -!WR_NO2/MO2=0.0 -! -!WR_NO2/ALKAP=0.0 -! -!WR_NO2/ALKEP=0.0 -! -!WR_NO2/BIOP=0.0 -! -!WR_NO2/PHO=0.0 -! -!WR_NO2/ADD=0.0 -! -!WR_NO2/AROP=0.0 -! -!WR_NO2/CARBOP=0.0 -! -!WR_NO2/OLN=0.0 -! -!WR_NO2/XO2=0.0 -! -!WR_NO2/WC_O3=0.0 -! -!WR_NO2/WC_H2O2=0.0 -! -!WR_NO2/WC_NO=0.0 -! -!WR_NO2/WC_NO2=0.0 -! -!WR_NO2/WC_NO3=0.0 -! -!WR_NO2/WC_N2O5=0.0 -! -!WR_NO2/WC_HONO=0.0 -! -!WR_NO2/WC_HNO3=0.0 -! -!WR_NO2/WC_HNO4=0.0 -! -!WR_NO2/WC_NH3=0.0 -! -!WR_NO2/WC_OH=0.0 -! -!WR_NO2/WC_HO2=0.0 -! -!WR_NO2/WC_CO2=0.0 -! -!WR_NO2/WC_SO2=0.0 -! -!WR_NO2/WC_SULF=0.0 -! -!WR_NO2/WC_HCHO=0.0 -! -!WR_NO2/WC_ORA1=0.0 -! -!WR_NO2/WC_ORA2=0.0 -! -!WR_NO2/WC_MO2=0.0 -! -!WR_NO2/WC_OP1=0.0 -! -!WR_NO2/WC_ASO3=0.0 -! -!WR_NO2/WC_ASO4=0.0 -! -!WR_NO2/WC_ASO5=0.0 -! -!WR_NO2/WC_AHSO5=0.0 -! -!WR_NO2/WC_AHMS=0.0 -! -!WR_NO2/WR_O3=0.0 -! -!WR_NO2/WR_H2O2=0.0 -! -!WR_NO2/WR_NO=0.0 -! -!WR_NO2/WR_NO2=-KTR24-KR9*<WR_HO2> - PJAC(:,71,71)=-TPK%KTR24(:)-TPK%KR9(:)*PCONC(:,79) -! -!WR_NO2/WR_NO3=0.0 -! -!WR_NO2/WR_N2O5=0.0 -! -!WR_NO2/WR_HONO=+KR8*<WR_OH> - PJAC(:,71,74)=+TPK%KR8(:)*PCONC(:,78) -! -!WR_NO2/WR_HNO3=+KR13 - PJAC(:,71,75)=+TPK%KR13(:) -! -!WR_NO2/WR_HNO4=+KR10 - PJAC(:,71,76)=+TPK%KR10(:) -! -!WR_NO2/WR_NH3=0.0 -! -!WR_NO2/WR_OH=+KR8*<WR_HONO> - PJAC(:,71,78)=+TPK%KR8(:)*PCONC(:,74) -! -!WR_NO2/WR_HO2=-KR9*<WR_NO2> - PJAC(:,71,79)=-TPK%KR9(:)*PCONC(:,71) -! -!WR_NO2/WR_CO2=0.0 -! -!WR_NO2/WR_SO2=0.0 -! -!WR_NO2/WR_SULF=0.0 -! -!WR_NO2/WR_HCHO=0.0 -! -!WR_NO2/WR_ORA1=0.0 -! -!WR_NO2/WR_ORA2=0.0 -! -!WR_NO2/WR_MO2=0.0 -! -!WR_NO2/WR_OP1=0.0 -! -!WR_NO2/WR_ASO3=0.0 -! -!WR_NO2/WR_ASO4=0.0 -! -!WR_NO2/WR_ASO5=0.0 -! -!WR_NO2/WR_AHSO5=0.0 -! -!WR_NO2/WR_AHMS=0.0 -! -!WR_NO3/O3=0.0 -! -!WR_NO3/H2O2=0.0 -! -!WR_NO3/NO=0.0 -! -!WR_NO3/NO2=0.0 -! -!WR_NO3/NO3=+KTR5 - PJAC(:,72,5)=+TPK%KTR5(:) -! -!WR_NO3/N2O5=0.0 -! -!WR_NO3/HONO=0.0 -! -!WR_NO3/HNO3=0.0 -! -!WR_NO3/HNO4=0.0 -! -!WR_NO3/NH3=0.0 -! -!WR_NO3/DMS=0.0 -! -!WR_NO3/SO2=0.0 -! -!WR_NO3/SULF=0.0 -! -!WR_NO3/CO=0.0 -! -!WR_NO3/OH=0.0 -! -!WR_NO3/HO2=0.0 -! -!WR_NO3/CH4=0.0 -! -!WR_NO3/ETH=0.0 -! -!WR_NO3/ALKA=0.0 -! -!WR_NO3/ALKE=0.0 -! -!WR_NO3/BIO=0.0 -! -!WR_NO3/ARO=0.0 -! -!WR_NO3/HCHO=0.0 -! -!WR_NO3/ALD=0.0 -! -!WR_NO3/KET=0.0 -! -!WR_NO3/CARBO=0.0 -! -!WR_NO3/ONIT=0.0 -! -!WR_NO3/PAN=0.0 -! -!WR_NO3/OP1=0.0 -! -!WR_NO3/OP2=0.0 -! -!WR_NO3/ORA1=0.0 -! -!WR_NO3/ORA2=0.0 -! -!WR_NO3/MO2=0.0 -! -!WR_NO3/ALKAP=0.0 -! -!WR_NO3/ALKEP=0.0 -! -!WR_NO3/BIOP=0.0 -! -!WR_NO3/PHO=0.0 -! -!WR_NO3/ADD=0.0 -! -!WR_NO3/AROP=0.0 -! -!WR_NO3/CARBOP=0.0 -! -!WR_NO3/OLN=0.0 -! -!WR_NO3/XO2=0.0 -! -!WR_NO3/WC_O3=0.0 -! -!WR_NO3/WC_H2O2=0.0 -! -!WR_NO3/WC_NO=0.0 -! -!WR_NO3/WC_NO2=0.0 -! -!WR_NO3/WC_NO3=0.0 -! -!WR_NO3/WC_N2O5=0.0 -! -!WR_NO3/WC_HONO=0.0 -! -!WR_NO3/WC_HNO3=0.0 -! -!WR_NO3/WC_HNO4=0.0 -! -!WR_NO3/WC_NH3=0.0 -! -!WR_NO3/WC_OH=0.0 -! -!WR_NO3/WC_HO2=0.0 -! -!WR_NO3/WC_CO2=0.0 -! -!WR_NO3/WC_SO2=0.0 -! -!WR_NO3/WC_SULF=0.0 -! -!WR_NO3/WC_HCHO=0.0 -! -!WR_NO3/WC_ORA1=0.0 -! -!WR_NO3/WC_ORA2=0.0 -! -!WR_NO3/WC_MO2=0.0 -! -!WR_NO3/WC_OP1=0.0 -! -!WR_NO3/WC_ASO3=0.0 -! -!WR_NO3/WC_ASO4=0.0 -! -!WR_NO3/WC_ASO5=0.0 -! -!WR_NO3/WC_AHSO5=0.0 -! -!WR_NO3/WC_AHMS=0.0 -! -!WR_NO3/WR_O3=0.0 -! -!WR_NO3/WR_H2O2=0.0 -! -!WR_NO3/WR_NO=0.0 -! -!WR_NO3/WR_NO2=0.0 -! -!WR_NO3/WR_NO3=-KTR25-KR15*<WR_SULF>-KR16*<WR_SO2> - PJAC(:,72,72)=-TPK%KTR25(:)-TPK%KR15(:)*PCONC(:,82)-TPK%KR16(:)*PCONC(:,81) -! -!WR_NO3/WR_N2O5=0.0 -! -!WR_NO3/WR_HONO=0.0 -! -!WR_NO3/WR_HNO3=0.0 -! -!WR_NO3/WR_HNO4=0.0 -! -!WR_NO3/WR_NH3=0.0 -! -!WR_NO3/WR_OH=0.0 -! -!WR_NO3/WR_HO2=0.0 -! -!WR_NO3/WR_CO2=0.0 -! -!WR_NO3/WR_SO2=-KR16*<WR_NO3> - PJAC(:,72,81)=-TPK%KR16(:)*PCONC(:,72) -! -!WR_NO3/WR_SULF=-KR15*<WR_NO3> - PJAC(:,72,82)=-TPK%KR15(:)*PCONC(:,72) -! -!WR_NO3/WR_HCHO=0.0 -! -!WR_NO3/WR_ORA1=0.0 -! -!WR_NO3/WR_ORA2=0.0 -! -!WR_NO3/WR_MO2=0.0 -! -!WR_NO3/WR_OP1=0.0 -! -!WR_NO3/WR_ASO3=0.0 -! -!WR_NO3/WR_ASO4=0.0 -! -!WR_NO3/WR_ASO5=0.0 -! -!WR_NO3/WR_AHSO5=0.0 -! -!WR_NO3/WR_AHMS=0.0 -! -!WR_N2O5/O3=0.0 -! -!WR_N2O5/H2O2=0.0 -! -!WR_N2O5/NO=0.0 -! -!WR_N2O5/NO2=0.0 -! -!WR_N2O5/NO3=0.0 -! -!WR_N2O5/N2O5=+KTR6 - PJAC(:,73,6)=+TPK%KTR6(:) -! -!WR_N2O5/HONO=0.0 -! -!WR_N2O5/HNO3=0.0 -! -!WR_N2O5/HNO4=0.0 -! -!WR_N2O5/NH3=0.0 -! -!WR_N2O5/DMS=0.0 -! -!WR_N2O5/SO2=0.0 -! -!WR_N2O5/SULF=0.0 -! -!WR_N2O5/CO=0.0 -! -!WR_N2O5/OH=0.0 -! -!WR_N2O5/HO2=0.0 -! -!WR_N2O5/CH4=0.0 -! -!WR_N2O5/ETH=0.0 -! -!WR_N2O5/ALKA=0.0 -! -!WR_N2O5/ALKE=0.0 -! -!WR_N2O5/BIO=0.0 -! -!WR_N2O5/ARO=0.0 -! -!WR_N2O5/HCHO=0.0 -! -!WR_N2O5/ALD=0.0 -! -!WR_N2O5/KET=0.0 -! -!WR_N2O5/CARBO=0.0 -! -!WR_N2O5/ONIT=0.0 -! -!WR_N2O5/PAN=0.0 -! -!WR_N2O5/OP1=0.0 -! -!WR_N2O5/OP2=0.0 -! -!WR_N2O5/ORA1=0.0 -! -!WR_N2O5/ORA2=0.0 -! -!WR_N2O5/MO2=0.0 -! -!WR_N2O5/ALKAP=0.0 -! -!WR_N2O5/ALKEP=0.0 -! -!WR_N2O5/BIOP=0.0 -! -!WR_N2O5/PHO=0.0 -! -!WR_N2O5/ADD=0.0 -! -!WR_N2O5/AROP=0.0 -! -!WR_N2O5/CARBOP=0.0 -! -!WR_N2O5/OLN=0.0 -! -!WR_N2O5/XO2=0.0 -! -!WR_N2O5/WC_O3=0.0 -! -!WR_N2O5/WC_H2O2=0.0 -! -!WR_N2O5/WC_NO=0.0 -! -!WR_N2O5/WC_NO2=0.0 -! -!WR_N2O5/WC_NO3=0.0 -! -!WR_N2O5/WC_N2O5=0.0 -! -!WR_N2O5/WC_HONO=0.0 -! -!WR_N2O5/WC_HNO3=0.0 -! -!WR_N2O5/WC_HNO4=0.0 -! -!WR_N2O5/WC_NH3=0.0 -! -!WR_N2O5/WC_OH=0.0 -! -!WR_N2O5/WC_HO2=0.0 -! -!WR_N2O5/WC_CO2=0.0 -! -!WR_N2O5/WC_SO2=0.0 -! -!WR_N2O5/WC_SULF=0.0 -! -!WR_N2O5/WC_HCHO=0.0 -! -!WR_N2O5/WC_ORA1=0.0 -! -!WR_N2O5/WC_ORA2=0.0 -! -!WR_N2O5/WC_MO2=0.0 -! -!WR_N2O5/WC_OP1=0.0 -! -!WR_N2O5/WC_ASO3=0.0 -! -!WR_N2O5/WC_ASO4=0.0 -! -!WR_N2O5/WC_ASO5=0.0 -! -!WR_N2O5/WC_AHSO5=0.0 -! -!WR_N2O5/WC_AHMS=0.0 -! -!WR_N2O5/WR_O3=0.0 -! -!WR_N2O5/WR_H2O2=0.0 -! -!WR_N2O5/WR_NO=0.0 -! -!WR_N2O5/WR_NO2=0.0 -! -!WR_N2O5/WR_NO3=0.0 -! -!WR_N2O5/WR_N2O5=-KTR26-KR14 - PJAC(:,73,73)=-TPK%KTR26(:)-TPK%KR14(:) -! -!WR_N2O5/WR_HONO=0.0 -! -!WR_N2O5/WR_HNO3=0.0 -! -!WR_N2O5/WR_HNO4=0.0 -! -!WR_N2O5/WR_NH3=0.0 -! -!WR_N2O5/WR_OH=0.0 -! -!WR_N2O5/WR_HO2=0.0 -! -!WR_N2O5/WR_CO2=0.0 -! -!WR_N2O5/WR_SO2=0.0 -! -!WR_N2O5/WR_SULF=0.0 -! -!WR_N2O5/WR_HCHO=0.0 -! -!WR_N2O5/WR_ORA1=0.0 -! -!WR_N2O5/WR_ORA2=0.0 -! -!WR_N2O5/WR_MO2=0.0 -! -!WR_N2O5/WR_OP1=0.0 -! -!WR_N2O5/WR_ASO3=0.0 -! -!WR_N2O5/WR_ASO4=0.0 -! -!WR_N2O5/WR_ASO5=0.0 -! -!WR_N2O5/WR_AHSO5=0.0 -! -!WR_N2O5/WR_AHMS=0.0 -! -!WR_HONO/O3=0.0 -! -!WR_HONO/H2O2=0.0 -! -!WR_HONO/NO=0.0 -! -!WR_HONO/NO2=0.0 -! -!WR_HONO/NO3=0.0 -! -!WR_HONO/N2O5=0.0 -! -!WR_HONO/HONO=+KTR7 - PJAC(:,74,7)=+TPK%KTR7(:) -! -!WR_HONO/HNO3=0.0 -! -!WR_HONO/HNO4=0.0 -! -!WR_HONO/NH3=0.0 -! -!WR_HONO/DMS=0.0 -! -!WR_HONO/SO2=0.0 -! -!WR_HONO/SULF=0.0 -! -!WR_HONO/CO=0.0 -! -!WR_HONO/OH=0.0 -! -!WR_HONO/HO2=0.0 -! -!WR_HONO/CH4=0.0 -! -!WR_HONO/ETH=0.0 -! -!WR_HONO/ALKA=0.0 -! -!WR_HONO/ALKE=0.0 -! -!WR_HONO/BIO=0.0 -! -!WR_HONO/ARO=0.0 -! -!WR_HONO/HCHO=0.0 -! -!WR_HONO/ALD=0.0 -! -!WR_HONO/KET=0.0 -! -!WR_HONO/CARBO=0.0 -! -!WR_HONO/ONIT=0.0 -! -!WR_HONO/PAN=0.0 -! -!WR_HONO/OP1=0.0 -! -!WR_HONO/OP2=0.0 -! -!WR_HONO/ORA1=0.0 -! -!WR_HONO/ORA2=0.0 -! -!WR_HONO/MO2=0.0 -! -!WR_HONO/ALKAP=0.0 -! -!WR_HONO/ALKEP=0.0 -! -!WR_HONO/BIOP=0.0 -! -!WR_HONO/PHO=0.0 -! -!WR_HONO/ADD=0.0 -! -!WR_HONO/AROP=0.0 -! -!WR_HONO/CARBOP=0.0 -! -!WR_HONO/OLN=0.0 -! -!WR_HONO/XO2=0.0 -! -!WR_HONO/WC_O3=0.0 -! -!WR_HONO/WC_H2O2=0.0 -! -!WR_HONO/WC_NO=0.0 -! -!WR_HONO/WC_NO2=0.0 -! -!WR_HONO/WC_NO3=0.0 -! -!WR_HONO/WC_N2O5=0.0 -! -!WR_HONO/WC_HONO=0.0 -! -!WR_HONO/WC_HNO3=0.0 -! -!WR_HONO/WC_HNO4=0.0 -! -!WR_HONO/WC_NH3=0.0 -! -!WR_HONO/WC_OH=0.0 -! -!WR_HONO/WC_HO2=0.0 -! -!WR_HONO/WC_CO2=0.0 -! -!WR_HONO/WC_SO2=0.0 -! -!WR_HONO/WC_SULF=0.0 -! -!WR_HONO/WC_HCHO=0.0 -! -!WR_HONO/WC_ORA1=0.0 -! -!WR_HONO/WC_ORA2=0.0 -! -!WR_HONO/WC_MO2=0.0 -! -!WR_HONO/WC_OP1=0.0 -! -!WR_HONO/WC_ASO3=0.0 -! -!WR_HONO/WC_ASO4=0.0 -! -!WR_HONO/WC_ASO5=0.0 -! -!WR_HONO/WC_AHSO5=0.0 -! -!WR_HONO/WC_AHMS=0.0 -! -!WR_HONO/WR_O3=0.0 -! -!WR_HONO/WR_H2O2=0.0 -! -!WR_HONO/WR_NO=0.0 -! -!WR_HONO/WR_NO2=0.0 -! -!WR_HONO/WR_NO3=0.0 -! -!WR_HONO/WR_N2O5=0.0 -! -!WR_HONO/WR_HONO=-KTR27-KR8*<WR_OH> - PJAC(:,74,74)=-TPK%KTR27(:)-TPK%KR8(:)*PCONC(:,78) -! -!WR_HONO/WR_HNO3=0.0 -! -!WR_HONO/WR_HNO4=+KR11 - PJAC(:,74,76)=+TPK%KR11(:) -! -!WR_HONO/WR_NH3=0.0 -! -!WR_HONO/WR_OH=-KR8*<WR_HONO> - PJAC(:,74,78)=-TPK%KR8(:)*PCONC(:,74) -! -!WR_HONO/WR_HO2=0.0 -! -!WR_HONO/WR_CO2=0.0 -! -!WR_HONO/WR_SO2=0.0 -! -!WR_HONO/WR_SULF=0.0 -! -!WR_HONO/WR_HCHO=0.0 -! -!WR_HONO/WR_ORA1=0.0 -! -!WR_HONO/WR_ORA2=0.0 -! -!WR_HONO/WR_MO2=0.0 -! -!WR_HONO/WR_OP1=0.0 -! -!WR_HONO/WR_ASO3=0.0 -! -!WR_HONO/WR_ASO4=0.0 -! -!WR_HONO/WR_ASO5=0.0 -! -!WR_HONO/WR_AHSO5=0.0 -! -!WR_HONO/WR_AHMS=0.0 -! -!WR_HNO3/O3=0.0 -! -!WR_HNO3/H2O2=0.0 -! -!WR_HNO3/NO=0.0 -! -!WR_HNO3/NO2=0.0 -! -!WR_HNO3/NO3=0.0 -! -!WR_HNO3/N2O5=0.0 -! -!WR_HNO3/HONO=0.0 -! -!WR_HNO3/HNO3=+KTR8 - PJAC(:,75,8)=+TPK%KTR8(:) -! -!WR_HNO3/HNO4=0.0 -! -!WR_HNO3/NH3=0.0 -! -!WR_HNO3/DMS=0.0 -! -!WR_HNO3/SO2=0.0 -! -!WR_HNO3/SULF=0.0 -! -!WR_HNO3/CO=0.0 -! -!WR_HNO3/OH=0.0 -! -!WR_HNO3/HO2=0.0 -! -!WR_HNO3/CH4=0.0 -! -!WR_HNO3/ETH=0.0 -! -!WR_HNO3/ALKA=0.0 -! -!WR_HNO3/ALKE=0.0 -! -!WR_HNO3/BIO=0.0 -! -!WR_HNO3/ARO=0.0 -! -!WR_HNO3/HCHO=0.0 -! -!WR_HNO3/ALD=0.0 -! -!WR_HNO3/KET=0.0 -! -!WR_HNO3/CARBO=0.0 -! -!WR_HNO3/ONIT=0.0 -! -!WR_HNO3/PAN=0.0 -! -!WR_HNO3/OP1=0.0 -! -!WR_HNO3/OP2=0.0 -! -!WR_HNO3/ORA1=0.0 -! -!WR_HNO3/ORA2=0.0 -! -!WR_HNO3/MO2=0.0 -! -!WR_HNO3/ALKAP=0.0 -! -!WR_HNO3/ALKEP=0.0 -! -!WR_HNO3/BIOP=0.0 -! -!WR_HNO3/PHO=0.0 -! -!WR_HNO3/ADD=0.0 -! -!WR_HNO3/AROP=0.0 -! -!WR_HNO3/CARBOP=0.0 -! -!WR_HNO3/OLN=0.0 -! -!WR_HNO3/XO2=0.0 -! -!WR_HNO3/WC_O3=0.0 -! -!WR_HNO3/WC_H2O2=0.0 -! -!WR_HNO3/WC_NO=0.0 -! -!WR_HNO3/WC_NO2=0.0 -! -!WR_HNO3/WC_NO3=0.0 -! -!WR_HNO3/WC_N2O5=0.0 -! -!WR_HNO3/WC_HONO=0.0 -! -!WR_HNO3/WC_HNO3=0.0 -! -!WR_HNO3/WC_HNO4=0.0 -! -!WR_HNO3/WC_NH3=0.0 -! -!WR_HNO3/WC_OH=0.0 -! -!WR_HNO3/WC_HO2=0.0 -! -!WR_HNO3/WC_CO2=0.0 -! -!WR_HNO3/WC_SO2=0.0 -! -!WR_HNO3/WC_SULF=0.0 -! -!WR_HNO3/WC_HCHO=0.0 -! -!WR_HNO3/WC_ORA1=0.0 -! -!WR_HNO3/WC_ORA2=0.0 -! -!WR_HNO3/WC_MO2=0.0 -! -!WR_HNO3/WC_OP1=0.0 -! -!WR_HNO3/WC_ASO3=0.0 -! -!WR_HNO3/WC_ASO4=0.0 -! -!WR_HNO3/WC_ASO5=0.0 -! -!WR_HNO3/WC_AHSO5=0.0 -! -!WR_HNO3/WC_AHMS=0.0 -! -!WR_HNO3/WR_O3=0.0 -! -!WR_HNO3/WR_H2O2=0.0 -! -!WR_HNO3/WR_NO=0.0 -! -!WR_HNO3/WR_NO2=0.0 -! -!WR_HNO3/WR_NO3=+KR15*<WR_SULF>+KR16*<WR_SO2> - PJAC(:,75,72)=+TPK%KR15(:)*PCONC(:,82)+TPK%KR16(:)*PCONC(:,81) -! -!WR_HNO3/WR_N2O5=+KR14+KR14 - PJAC(:,75,73)=+TPK%KR14(:)+TPK%KR14(:) -! -!WR_HNO3/WR_HONO=0.0 -! -!WR_HNO3/WR_HNO3=-KTR28-KR13 - PJAC(:,75,75)=-TPK%KTR28(:)-TPK%KR13(:) -! -!WR_HNO3/WR_HNO4=+KR12*<WR_SO2> - PJAC(:,75,76)=+TPK%KR12(:)*PCONC(:,81) -! -!WR_HNO3/WR_NH3=0.0 -! -!WR_HNO3/WR_OH=0.0 -! -!WR_HNO3/WR_HO2=0.0 -! -!WR_HNO3/WR_CO2=0.0 -! -!WR_HNO3/WR_SO2=+KR12*<WR_HNO4>+KR16*<WR_NO3> - PJAC(:,75,81)=+TPK%KR12(:)*PCONC(:,76)+TPK%KR16(:)*PCONC(:,72) -! -!WR_HNO3/WR_SULF=+KR15*<WR_NO3> - PJAC(:,75,82)=+TPK%KR15(:)*PCONC(:,72) -! -!WR_HNO3/WR_HCHO=0.0 -! -!WR_HNO3/WR_ORA1=0.0 -! -!WR_HNO3/WR_ORA2=0.0 -! -!WR_HNO3/WR_MO2=0.0 -! -!WR_HNO3/WR_OP1=0.0 -! -!WR_HNO3/WR_ASO3=0.0 -! -!WR_HNO3/WR_ASO4=0.0 -! -!WR_HNO3/WR_ASO5=0.0 -! -!WR_HNO3/WR_AHSO5=0.0 -! -!WR_HNO3/WR_AHMS=0.0 -! -RETURN -END SUBROUTINE SUBJ14 -! -SUBROUTINE SUBJ15 -! -!Indices 76 a 80 -! -! -!WR_HNO4/O3=0.0 -! -!WR_HNO4/H2O2=0.0 -! -!WR_HNO4/NO=0.0 -! -!WR_HNO4/NO2=0.0 -! -!WR_HNO4/NO3=0.0 -! -!WR_HNO4/N2O5=0.0 -! -!WR_HNO4/HONO=0.0 -! -!WR_HNO4/HNO3=0.0 -! -!WR_HNO4/HNO4=+KTR9 - PJAC(:,76,9)=+TPK%KTR9(:) -! -!WR_HNO4/NH3=0.0 -! -!WR_HNO4/DMS=0.0 -! -!WR_HNO4/SO2=0.0 -! -!WR_HNO4/SULF=0.0 -! -!WR_HNO4/CO=0.0 -! -!WR_HNO4/OH=0.0 -! -!WR_HNO4/HO2=0.0 -! -!WR_HNO4/CH4=0.0 -! -!WR_HNO4/ETH=0.0 -! -!WR_HNO4/ALKA=0.0 -! -!WR_HNO4/ALKE=0.0 -! -!WR_HNO4/BIO=0.0 -! -!WR_HNO4/ARO=0.0 -! -!WR_HNO4/HCHO=0.0 -! -!WR_HNO4/ALD=0.0 -! -!WR_HNO4/KET=0.0 -! -!WR_HNO4/CARBO=0.0 -! -!WR_HNO4/ONIT=0.0 -! -!WR_HNO4/PAN=0.0 -! -!WR_HNO4/OP1=0.0 -! -!WR_HNO4/OP2=0.0 -! -!WR_HNO4/ORA1=0.0 -! -!WR_HNO4/ORA2=0.0 -! -!WR_HNO4/MO2=0.0 -! -!WR_HNO4/ALKAP=0.0 -! -!WR_HNO4/ALKEP=0.0 -! -!WR_HNO4/BIOP=0.0 -! -!WR_HNO4/PHO=0.0 -! -!WR_HNO4/ADD=0.0 -! -!WR_HNO4/AROP=0.0 -! -!WR_HNO4/CARBOP=0.0 -! -!WR_HNO4/OLN=0.0 -! -!WR_HNO4/XO2=0.0 -! -!WR_HNO4/WC_O3=0.0 -! -!WR_HNO4/WC_H2O2=0.0 -! -!WR_HNO4/WC_NO=0.0 -! -!WR_HNO4/WC_NO2=0.0 -! -!WR_HNO4/WC_NO3=0.0 -! -!WR_HNO4/WC_N2O5=0.0 -! -!WR_HNO4/WC_HONO=0.0 -! -!WR_HNO4/WC_HNO3=0.0 -! -!WR_HNO4/WC_HNO4=0.0 -! -!WR_HNO4/WC_NH3=0.0 -! -!WR_HNO4/WC_OH=0.0 -! -!WR_HNO4/WC_HO2=0.0 -! -!WR_HNO4/WC_CO2=0.0 -! -!WR_HNO4/WC_SO2=0.0 -! -!WR_HNO4/WC_SULF=0.0 -! -!WR_HNO4/WC_HCHO=0.0 -! -!WR_HNO4/WC_ORA1=0.0 -! -!WR_HNO4/WC_ORA2=0.0 -! -!WR_HNO4/WC_MO2=0.0 -! -!WR_HNO4/WC_OP1=0.0 -! -!WR_HNO4/WC_ASO3=0.0 -! -!WR_HNO4/WC_ASO4=0.0 -! -!WR_HNO4/WC_ASO5=0.0 -! -!WR_HNO4/WC_AHSO5=0.0 -! -!WR_HNO4/WC_AHMS=0.0 -! -!WR_HNO4/WR_O3=0.0 -! -!WR_HNO4/WR_H2O2=0.0 -! -!WR_HNO4/WR_NO=0.0 -! -!WR_HNO4/WR_NO2=+KR9*<WR_HO2> - PJAC(:,76,71)=+TPK%KR9(:)*PCONC(:,79) -! -!WR_HNO4/WR_NO3=0.0 -! -!WR_HNO4/WR_N2O5=0.0 -! -!WR_HNO4/WR_HONO=0.0 -! -!WR_HNO4/WR_HNO3=0.0 -! -!WR_HNO4/WR_HNO4=-KTR29-KR10-KR11-KR12*<WR_SO2> - PJAC(:,76,76)=-TPK%KTR29(:)-TPK%KR10(:)-TPK%KR11(:)-TPK%KR12(:)*PCONC(:,81) -! -!WR_HNO4/WR_NH3=0.0 -! -!WR_HNO4/WR_OH=0.0 -! -!WR_HNO4/WR_HO2=+KR9*<WR_NO2> - PJAC(:,76,79)=+TPK%KR9(:)*PCONC(:,71) -! -!WR_HNO4/WR_CO2=0.0 -! -!WR_HNO4/WR_SO2=-KR12*<WR_HNO4> - PJAC(:,76,81)=-TPK%KR12(:)*PCONC(:,76) -! -!WR_HNO4/WR_SULF=0.0 -! -!WR_HNO4/WR_HCHO=0.0 -! -!WR_HNO4/WR_ORA1=0.0 -! -!WR_HNO4/WR_ORA2=0.0 -! -!WR_HNO4/WR_MO2=0.0 -! -!WR_HNO4/WR_OP1=0.0 -! -!WR_HNO4/WR_ASO3=0.0 -! -!WR_HNO4/WR_ASO4=0.0 -! -!WR_HNO4/WR_ASO5=0.0 -! -!WR_HNO4/WR_AHSO5=0.0 -! -!WR_HNO4/WR_AHMS=0.0 -! -!WR_NH3/O3=0.0 -! -!WR_NH3/H2O2=0.0 -! -!WR_NH3/NO=0.0 -! -!WR_NH3/NO2=0.0 -! -!WR_NH3/NO3=0.0 -! -!WR_NH3/N2O5=0.0 -! -!WR_NH3/HONO=0.0 -! -!WR_NH3/HNO3=0.0 -! -!WR_NH3/HNO4=0.0 -! -!WR_NH3/NH3=+KTR10 - PJAC(:,77,10)=+TPK%KTR10(:) -! -!WR_NH3/DMS=0.0 -! -!WR_NH3/SO2=0.0 -! -!WR_NH3/SULF=0.0 -! -!WR_NH3/CO=0.0 -! -!WR_NH3/OH=0.0 -! -!WR_NH3/HO2=0.0 -! -!WR_NH3/CH4=0.0 -! -!WR_NH3/ETH=0.0 -! -!WR_NH3/ALKA=0.0 -! -!WR_NH3/ALKE=0.0 -! -!WR_NH3/BIO=0.0 -! -!WR_NH3/ARO=0.0 -! -!WR_NH3/HCHO=0.0 -! -!WR_NH3/ALD=0.0 -! -!WR_NH3/KET=0.0 -! -!WR_NH3/CARBO=0.0 -! -!WR_NH3/ONIT=0.0 -! -!WR_NH3/PAN=0.0 -! -!WR_NH3/OP1=0.0 -! -!WR_NH3/OP2=0.0 -! -!WR_NH3/ORA1=0.0 -! -!WR_NH3/ORA2=0.0 -! -!WR_NH3/MO2=0.0 -! -!WR_NH3/ALKAP=0.0 -! -!WR_NH3/ALKEP=0.0 -! -!WR_NH3/BIOP=0.0 -! -!WR_NH3/PHO=0.0 -! -!WR_NH3/ADD=0.0 -! -!WR_NH3/AROP=0.0 -! -!WR_NH3/CARBOP=0.0 -! -!WR_NH3/OLN=0.0 -! -!WR_NH3/XO2=0.0 -! -!WR_NH3/WC_O3=0.0 -! -!WR_NH3/WC_H2O2=0.0 -! -!WR_NH3/WC_NO=0.0 -! -!WR_NH3/WC_NO2=0.0 -! -!WR_NH3/WC_NO3=0.0 -! -!WR_NH3/WC_N2O5=0.0 -! -!WR_NH3/WC_HONO=0.0 -! -!WR_NH3/WC_HNO3=0.0 -! -!WR_NH3/WC_HNO4=0.0 -! -!WR_NH3/WC_NH3=0.0 -! -!WR_NH3/WC_OH=0.0 -! -!WR_NH3/WC_HO2=0.0 -! -!WR_NH3/WC_CO2=0.0 -! -!WR_NH3/WC_SO2=0.0 -! -!WR_NH3/WC_SULF=0.0 -! -!WR_NH3/WC_HCHO=0.0 -! -!WR_NH3/WC_ORA1=0.0 -! -!WR_NH3/WC_ORA2=0.0 -! -!WR_NH3/WC_MO2=0.0 -! -!WR_NH3/WC_OP1=0.0 -! -!WR_NH3/WC_ASO3=0.0 -! -!WR_NH3/WC_ASO4=0.0 -! -!WR_NH3/WC_ASO5=0.0 -! -!WR_NH3/WC_AHSO5=0.0 -! -!WR_NH3/WC_AHMS=0.0 -! -!WR_NH3/WR_O3=0.0 -! -!WR_NH3/WR_H2O2=0.0 -! -!WR_NH3/WR_NO=0.0 -! -!WR_NH3/WR_NO2=0.0 -! -!WR_NH3/WR_NO3=0.0 -! -!WR_NH3/WR_N2O5=0.0 -! -!WR_NH3/WR_HONO=0.0 -! -!WR_NH3/WR_HNO3=0.0 -! -!WR_NH3/WR_HNO4=0.0 -! -!WR_NH3/WR_NH3=-KTR30 - PJAC(:,77,77)=-TPK%KTR30(:) -! -!WR_NH3/WR_OH=0.0 -! -!WR_NH3/WR_HO2=0.0 -! -!WR_NH3/WR_CO2=0.0 -! -!WR_NH3/WR_SO2=0.0 -! -!WR_NH3/WR_SULF=0.0 -! -!WR_NH3/WR_HCHO=0.0 -! -!WR_NH3/WR_ORA1=0.0 -! -!WR_NH3/WR_ORA2=0.0 -! -!WR_NH3/WR_MO2=0.0 -! -!WR_NH3/WR_OP1=0.0 -! -!WR_NH3/WR_ASO3=0.0 -! -!WR_NH3/WR_ASO4=0.0 -! -!WR_NH3/WR_ASO5=0.0 -! -!WR_NH3/WR_AHSO5=0.0 -! -!WR_NH3/WR_AHMS=0.0 -! -!WR_OH/O3=0.0 -! -!WR_OH/H2O2=0.0 -! -!WR_OH/NO=0.0 -! -!WR_OH/NO2=0.0 -! -!WR_OH/NO3=0.0 -! -!WR_OH/N2O5=0.0 -! -!WR_OH/HONO=0.0 -! -!WR_OH/HNO3=0.0 -! -!WR_OH/HNO4=0.0 -! -!WR_OH/NH3=0.0 -! -!WR_OH/DMS=0.0 -! -!WR_OH/SO2=0.0 -! -!WR_OH/SULF=0.0 -! -!WR_OH/CO=0.0 -! -!WR_OH/OH=+KTR11 - PJAC(:,78,15)=+TPK%KTR11(:) -! -!WR_OH/HO2=0.0 -! -!WR_OH/CH4=0.0 -! -!WR_OH/ETH=0.0 -! -!WR_OH/ALKA=0.0 -! -!WR_OH/ALKE=0.0 -! -!WR_OH/BIO=0.0 -! -!WR_OH/ARO=0.0 -! -!WR_OH/HCHO=0.0 -! -!WR_OH/ALD=0.0 -! -!WR_OH/KET=0.0 -! -!WR_OH/CARBO=0.0 -! -!WR_OH/ONIT=0.0 -! -!WR_OH/PAN=0.0 -! -!WR_OH/OP1=0.0 -! -!WR_OH/OP2=0.0 -! -!WR_OH/ORA1=0.0 -! -!WR_OH/ORA2=0.0 -! -!WR_OH/MO2=0.0 -! -!WR_OH/ALKAP=0.0 -! -!WR_OH/ALKEP=0.0 -! -!WR_OH/BIOP=0.0 -! -!WR_OH/PHO=0.0 -! -!WR_OH/ADD=0.0 -! -!WR_OH/AROP=0.0 -! -!WR_OH/CARBOP=0.0 -! -!WR_OH/OLN=0.0 -! -!WR_OH/XO2=0.0 -! -!WR_OH/WC_O3=0.0 -! -!WR_OH/WC_H2O2=0.0 -! -!WR_OH/WC_NO=0.0 -! -!WR_OH/WC_NO2=0.0 -! -!WR_OH/WC_NO3=0.0 -! -!WR_OH/WC_N2O5=0.0 -! -!WR_OH/WC_HONO=0.0 -! -!WR_OH/WC_HNO3=0.0 -! -!WR_OH/WC_HNO4=0.0 -! -!WR_OH/WC_NH3=0.0 -! -!WR_OH/WC_OH=0.0 -! -!WR_OH/WC_HO2=0.0 -! -!WR_OH/WC_CO2=0.0 -! -!WR_OH/WC_SO2=0.0 -! -!WR_OH/WC_SULF=0.0 -! -!WR_OH/WC_HCHO=0.0 -! -!WR_OH/WC_ORA1=0.0 -! -!WR_OH/WC_ORA2=0.0 -! -!WR_OH/WC_MO2=0.0 -! -!WR_OH/WC_OP1=0.0 -! -!WR_OH/WC_ASO3=0.0 -! -!WR_OH/WC_ASO4=0.0 -! -!WR_OH/WC_ASO5=0.0 -! -!WR_OH/WC_AHSO5=0.0 -! -!WR_OH/WC_AHMS=0.0 -! -!WR_OH/WR_O3=+KR6*<WR_HO2> - PJAC(:,78,68)=+TPK%KR6(:)*PCONC(:,79) -! -!WR_OH/WR_H2O2=+KR1+KR1-KR4*<WR_OH> - PJAC(:,78,69)=+TPK%KR1(:)+TPK%KR1(:)-TPK%KR4(:)*PCONC(:,78) -! -!WR_OH/WR_NO=0.0 -! -!WR_OH/WR_NO2=0.0 -! -!WR_OH/WR_NO3=0.0 -! -!WR_OH/WR_N2O5=0.0 -! -!WR_OH/WR_HONO=-KR8*<WR_OH> - PJAC(:,78,74)=-TPK%KR8(:)*PCONC(:,78) -! -!WR_OH/WR_HNO3=+KR13 - PJAC(:,78,75)=+TPK%KR13(:) -! -!WR_OH/WR_HNO4=0.0 -! -!WR_OH/WR_NH3=0.0 -! -!WR_OH/WR_OH=-KTR31-KR2*<WR_OH>-KR2*<WR_OH>-KR2*<WR_OH>-KR2*<WR_OH>-KR3*<WR_HO2 -!>-KR4*<WR_H2O2>-KR7*<WR_SO2>-KR8*<WR_HONO>-KR19*<WR_HCHO>-KR20*<WR_ORA1>-KR23* -!<WR_AHMS> - PJAC(:,78,78)=-TPK%KTR31(:)-TPK%KR2(:)*PCONC(:,78)-TPK%KR2(:)*PCONC(:,78)-TPK%& -&KR2(:)*PCONC(:,78)-TPK%KR2(:)*PCONC(:,78)-TPK%KR3(:)*PCONC(:,79)-TPK%KR4(:)*PC& -&ONC(:,69)-TPK%KR7(:)*PCONC(:,81)-TPK%KR8(:)*PCONC(:,74)-TPK%KR19(:)*PCONC(:,83& -&)-TPK%KR20(:)*PCONC(:,84)-TPK%KR23(:)*PCONC(:,92) -! -!WR_OH/WR_HO2=-KR3*<WR_OH>+KR6*<WR_O3> - PJAC(:,78,79)=-TPK%KR3(:)*PCONC(:,78)+TPK%KR6(:)*PCONC(:,68) -! -!WR_OH/WR_CO2=0.0 -! -!WR_OH/WR_SO2=-KR7*<WR_OH> - PJAC(:,78,81)=-TPK%KR7(:)*PCONC(:,78) -! -!WR_OH/WR_SULF=0.0 -! -!WR_OH/WR_HCHO=-KR19*<WR_OH> - PJAC(:,78,83)=-TPK%KR19(:)*PCONC(:,78) -! -!WR_OH/WR_ORA1=-KR20*<WR_OH> - PJAC(:,78,84)=-TPK%KR20(:)*PCONC(:,78) -! -!WR_OH/WR_ORA2=0.0 -! -!WR_OH/WR_MO2=0.0 -! -!WR_OH/WR_OP1=0.0 -! -!WR_OH/WR_ASO3=0.0 -! -!WR_OH/WR_ASO4=+KR28 - PJAC(:,78,89)=+TPK%KR28(:) -! -!WR_OH/WR_ASO5=0.0 -! -!WR_OH/WR_AHSO5=0.0 -! -!WR_OH/WR_AHMS=-KR23*<WR_OH> - PJAC(:,78,92)=-TPK%KR23(:)*PCONC(:,78) -! -!WR_HO2/O3=0.0 -! -!WR_HO2/H2O2=0.0 -! -!WR_HO2/NO=0.0 -! -!WR_HO2/NO2=0.0 -! -!WR_HO2/NO3=0.0 -! -!WR_HO2/N2O5=0.0 -! -!WR_HO2/HONO=0.0 -! -!WR_HO2/HNO3=0.0 -! -!WR_HO2/HNO4=0.0 -! -!WR_HO2/NH3=0.0 -! -!WR_HO2/DMS=0.0 -! -!WR_HO2/SO2=0.0 -! -!WR_HO2/SULF=0.0 -! -!WR_HO2/CO=0.0 -! -!WR_HO2/OH=0.0 -! -!WR_HO2/HO2=+KTR12 - PJAC(:,79,16)=+TPK%KTR12(:) -! -!WR_HO2/CH4=0.0 -! -!WR_HO2/ETH=0.0 -! -!WR_HO2/ALKA=0.0 -! -!WR_HO2/ALKE=0.0 -! -!WR_HO2/BIO=0.0 -! -!WR_HO2/ARO=0.0 -! -!WR_HO2/HCHO=0.0 -! -!WR_HO2/ALD=0.0 -! -!WR_HO2/KET=0.0 -! -!WR_HO2/CARBO=0.0 -! -!WR_HO2/ONIT=0.0 -! -!WR_HO2/PAN=0.0 -! -!WR_HO2/OP1=0.0 -! -!WR_HO2/OP2=0.0 -! -!WR_HO2/ORA1=0.0 -! -!WR_HO2/ORA2=0.0 -! -!WR_HO2/MO2=0.0 -! -!WR_HO2/ALKAP=0.0 -! -!WR_HO2/ALKEP=0.0 -! -!WR_HO2/BIOP=0.0 -! -!WR_HO2/PHO=0.0 -! -!WR_HO2/ADD=0.0 -! -!WR_HO2/AROP=0.0 -! -!WR_HO2/CARBOP=0.0 -! -!WR_HO2/OLN=0.0 -! -!WR_HO2/XO2=0.0 -! -!WR_HO2/WC_O3=0.0 -! -!WR_HO2/WC_H2O2=0.0 -! -!WR_HO2/WC_NO=0.0 -! -!WR_HO2/WC_NO2=0.0 -! -!WR_HO2/WC_NO3=0.0 -! -!WR_HO2/WC_N2O5=0.0 -! -!WR_HO2/WC_HONO=0.0 -! -!WR_HO2/WC_HNO3=0.0 -! -!WR_HO2/WC_HNO4=0.0 -! -!WR_HO2/WC_NH3=0.0 -! -!WR_HO2/WC_OH=0.0 -! -!WR_HO2/WC_HO2=0.0 -! -!WR_HO2/WC_CO2=0.0 -! -!WR_HO2/WC_SO2=0.0 -! -!WR_HO2/WC_SULF=0.0 -! -!WR_HO2/WC_HCHO=0.0 -! -!WR_HO2/WC_ORA1=0.0 -! -!WR_HO2/WC_ORA2=0.0 -! -!WR_HO2/WC_MO2=0.0 -! -!WR_HO2/WC_OP1=0.0 -! -!WR_HO2/WC_ASO3=0.0 -! -!WR_HO2/WC_ASO4=0.0 -! -!WR_HO2/WC_ASO5=0.0 -! -!WR_HO2/WC_AHSO5=0.0 -! -!WR_HO2/WC_AHMS=0.0 -! -!WR_HO2/WR_O3=-KR6*<WR_HO2> - PJAC(:,79,68)=-TPK%KR6(:)*PCONC(:,79) -! -!WR_HO2/WR_H2O2=+KR4*<WR_OH> - PJAC(:,79,69)=+TPK%KR4(:)*PCONC(:,78) -! -!WR_HO2/WR_NO=0.0 -! -!WR_HO2/WR_NO2=-KR9*<WR_HO2> - PJAC(:,79,71)=-TPK%KR9(:)*PCONC(:,79) -! -!WR_HO2/WR_NO3=0.0 -! -!WR_HO2/WR_N2O5=0.0 -! -!WR_HO2/WR_HONO=0.0 -! -!WR_HO2/WR_HNO3=0.0 -! -!WR_HO2/WR_HNO4=+KR10 - PJAC(:,79,76)=+TPK%KR10(:) -! -!WR_HO2/WR_NH3=0.0 -! -!WR_HO2/WR_OH=-KR3*<WR_HO2>+KR4*<WR_H2O2>+KR19*<WR_HCHO>+KR20*<WR_ORA1>+KR23*<W -!R_AHMS> - PJAC(:,79,78)=-TPK%KR3(:)*PCONC(:,79)+TPK%KR4(:)*PCONC(:,69)+TPK%KR19(:)*PCONC& -&(:,83)+TPK%KR20(:)*PCONC(:,84)+TPK%KR23(:)*PCONC(:,92) -! -!WR_HO2/WR_HO2=-KTR32-KR3*<WR_OH>-KR5*<WR_HO2>-KR5*<WR_HO2>-KR5*<WR_HO2>-KR5*<W -!R_HO2>-KR6*<WR_O3>-KR9*<WR_NO2>-KR25*<WR_ASO5> - PJAC(:,79,79)=-TPK%KTR32(:)-TPK%KR3(:)*PCONC(:,78)-TPK%KR5(:)*PCONC(:,79)-TPK%& -&KR5(:)*PCONC(:,79)-TPK%KR5(:)*PCONC(:,79)-TPK%KR5(:)*PCONC(:,79)-TPK%KR6(:)*PC& -&ONC(:,68)-TPK%KR9(:)*PCONC(:,71)-TPK%KR25(:)*PCONC(:,90) -! -!WR_HO2/WR_CO2=0.0 -! -!WR_HO2/WR_SO2=0.0 -! -!WR_HO2/WR_SULF=0.0 -! -!WR_HO2/WR_HCHO=+KR19*<WR_OH> - PJAC(:,79,83)=+TPK%KR19(:)*PCONC(:,78) -! -!WR_HO2/WR_ORA1=+KR20*<WR_OH> - PJAC(:,79,84)=+TPK%KR20(:)*PCONC(:,78) -! -!WR_HO2/WR_ORA2=0.0 -! -!WR_HO2/WR_MO2=+2.00*KR17*<WR_MO2>+2.00*KR17*<WR_MO2> - PJAC(:,79,86)=+2.00*TPK%KR17(:)*PCONC(:,86)+2.00*TPK%KR17(:)*PCONC(:,86) -! -!WR_HO2/WR_OP1=0.0 -! -!WR_HO2/WR_ASO3=0.0 -! -!WR_HO2/WR_ASO4=0.0 -! -!WR_HO2/WR_ASO5=-KR25*<WR_HO2> - PJAC(:,79,90)=-TPK%KR25(:)*PCONC(:,79) -! -!WR_HO2/WR_AHSO5=0.0 -! -!WR_HO2/WR_AHMS=+KR23*<WR_OH> - PJAC(:,79,92)=+TPK%KR23(:)*PCONC(:,78) -! -!WR_CO2/O3=0.0 -! -!WR_CO2/H2O2=0.0 -! -!WR_CO2/NO=0.0 -! -!WR_CO2/NO2=0.0 -! -!WR_CO2/NO3=0.0 -! -!WR_CO2/N2O5=0.0 -! -!WR_CO2/HONO=0.0 -! -!WR_CO2/HNO3=0.0 -! -!WR_CO2/HNO4=0.0 -! -!WR_CO2/NH3=0.0 -! -!WR_CO2/DMS=0.0 -! -!WR_CO2/SO2=0.0 -! -!WR_CO2/SULF=0.0 -! -!WR_CO2/CO=0.0 -! -!WR_CO2/OH=0.0 -! -!WR_CO2/HO2=0.0 -! -!WR_CO2/CH4=0.0 -! -!WR_CO2/ETH=0.0 -! -!WR_CO2/ALKA=0.0 -! -!WR_CO2/ALKE=0.0 -! -!WR_CO2/BIO=0.0 -! -!WR_CO2/ARO=0.0 -! -!WR_CO2/HCHO=0.0 -! -!WR_CO2/ALD=0.0 -! -!WR_CO2/KET=0.0 -! -!WR_CO2/CARBO=0.0 -! -!WR_CO2/ONIT=0.0 -! -!WR_CO2/PAN=0.0 -! -!WR_CO2/OP1=0.0 -! -!WR_CO2/OP2=0.0 -! -!WR_CO2/ORA1=0.0 -! -!WR_CO2/ORA2=0.0 -! -!WR_CO2/MO2=0.0 -! -!WR_CO2/ALKAP=0.0 -! -!WR_CO2/ALKEP=0.0 -! -!WR_CO2/BIOP=0.0 -! -!WR_CO2/PHO=0.0 -! -!WR_CO2/ADD=0.0 -! -!WR_CO2/AROP=0.0 -! -!WR_CO2/CARBOP=0.0 -! -!WR_CO2/OLN=0.0 -! -!WR_CO2/XO2=0.0 -! -!WR_CO2/WC_O3=0.0 -! -!WR_CO2/WC_H2O2=0.0 -! -!WR_CO2/WC_NO=0.0 -! -!WR_CO2/WC_NO2=0.0 -! -!WR_CO2/WC_NO3=0.0 -! -!WR_CO2/WC_N2O5=0.0 -! -!WR_CO2/WC_HONO=0.0 -! -!WR_CO2/WC_HNO3=0.0 -! -!WR_CO2/WC_HNO4=0.0 -! -!WR_CO2/WC_NH3=0.0 -! -!WR_CO2/WC_OH=0.0 -! -!WR_CO2/WC_HO2=0.0 -! -!WR_CO2/WC_CO2=0.0 -! -!WR_CO2/WC_SO2=0.0 -! -!WR_CO2/WC_SULF=0.0 -! -!WR_CO2/WC_HCHO=0.0 -! -!WR_CO2/WC_ORA1=0.0 -! -!WR_CO2/WC_ORA2=0.0 -! -!WR_CO2/WC_MO2=0.0 -! -!WR_CO2/WC_OP1=0.0 -! -!WR_CO2/WC_ASO3=0.0 -! -!WR_CO2/WC_ASO4=0.0 -! -!WR_CO2/WC_ASO5=0.0 -! -!WR_CO2/WC_AHSO5=0.0 -! -!WR_CO2/WC_AHMS=0.0 -! -!WR_CO2/WR_O3=0.0 -! -!WR_CO2/WR_H2O2=0.0 -! -!WR_CO2/WR_NO=0.0 -! -!WR_CO2/WR_NO2=0.0 -! -!WR_CO2/WR_NO3=0.0 -! -!WR_CO2/WR_N2O5=0.0 -! -!WR_CO2/WR_HONO=0.0 -! -!WR_CO2/WR_HNO3=0.0 -! -!WR_CO2/WR_HNO4=0.0 -! -!WR_CO2/WR_NH3=0.0 -! -!WR_CO2/WR_OH=+KR20*<WR_ORA1> - PJAC(:,80,78)=+TPK%KR20(:)*PCONC(:,84) -! -!WR_CO2/WR_HO2=0.0 -! -!WR_CO2/WR_CO2=-KTR33 - PJAC(:,80,80)=-TPK%KTR33(:) -! -!WR_CO2/WR_SO2=0.0 -! -!WR_CO2/WR_SULF=0.0 -! -!WR_CO2/WR_HCHO=0.0 -! -!WR_CO2/WR_ORA1=+KR20*<WR_OH> - PJAC(:,80,84)=+TPK%KR20(:)*PCONC(:,78) -! -!WR_CO2/WR_ORA2=0.0 -! -!WR_CO2/WR_MO2=0.0 -! -!WR_CO2/WR_OP1=0.0 -! -!WR_CO2/WR_ASO3=0.0 -! -!WR_CO2/WR_ASO4=0.0 -! -!WR_CO2/WR_ASO5=0.0 -! -!WR_CO2/WR_AHSO5=0.0 -! -!WR_CO2/WR_AHMS=0.0 -! -RETURN -END SUBROUTINE SUBJ15 -! -SUBROUTINE SUBJ16 -! -!Indices 81 a 85 -! -! -!WR_SO2/O3=0.0 -! -!WR_SO2/H2O2=0.0 -! -!WR_SO2/NO=0.0 -! -!WR_SO2/NO2=0.0 -! -!WR_SO2/NO3=0.0 -! -!WR_SO2/N2O5=0.0 -! -!WR_SO2/HONO=0.0 -! -!WR_SO2/HNO3=0.0 -! -!WR_SO2/HNO4=0.0 -! -!WR_SO2/NH3=0.0 -! -!WR_SO2/DMS=0.0 -! -!WR_SO2/SO2=+KTR14 - PJAC(:,81,12)=+TPK%KTR14(:) -! -!WR_SO2/SULF=0.0 -! -!WR_SO2/CO=0.0 -! -!WR_SO2/OH=0.0 -! -!WR_SO2/HO2=0.0 -! -!WR_SO2/CH4=0.0 -! -!WR_SO2/ETH=0.0 -! -!WR_SO2/ALKA=0.0 -! -!WR_SO2/ALKE=0.0 -! -!WR_SO2/BIO=0.0 -! -!WR_SO2/ARO=0.0 -! -!WR_SO2/HCHO=0.0 -! -!WR_SO2/ALD=0.0 -! -!WR_SO2/KET=0.0 -! -!WR_SO2/CARBO=0.0 -! -!WR_SO2/ONIT=0.0 -! -!WR_SO2/PAN=0.0 -! -!WR_SO2/OP1=0.0 -! -!WR_SO2/OP2=0.0 -! -!WR_SO2/ORA1=0.0 -! -!WR_SO2/ORA2=0.0 -! -!WR_SO2/MO2=0.0 -! -!WR_SO2/ALKAP=0.0 -! -!WR_SO2/ALKEP=0.0 -! -!WR_SO2/BIOP=0.0 -! -!WR_SO2/PHO=0.0 -! -!WR_SO2/ADD=0.0 -! -!WR_SO2/AROP=0.0 -! -!WR_SO2/CARBOP=0.0 -! -!WR_SO2/OLN=0.0 -! -!WR_SO2/XO2=0.0 -! -!WR_SO2/WC_O3=0.0 -! -!WR_SO2/WC_H2O2=0.0 -! -!WR_SO2/WC_NO=0.0 -! -!WR_SO2/WC_NO2=0.0 -! -!WR_SO2/WC_NO3=0.0 -! -!WR_SO2/WC_N2O5=0.0 -! -!WR_SO2/WC_HONO=0.0 -! -!WR_SO2/WC_HNO3=0.0 -! -!WR_SO2/WC_HNO4=0.0 -! -!WR_SO2/WC_NH3=0.0 -! -!WR_SO2/WC_OH=0.0 -! -!WR_SO2/WC_HO2=0.0 -! -!WR_SO2/WC_CO2=0.0 -! -!WR_SO2/WC_SO2=0.0 -! -!WR_SO2/WC_SULF=0.0 -! -!WR_SO2/WC_HCHO=0.0 -! -!WR_SO2/WC_ORA1=0.0 -! -!WR_SO2/WC_ORA2=0.0 -! -!WR_SO2/WC_MO2=0.0 -! -!WR_SO2/WC_OP1=0.0 -! -!WR_SO2/WC_ASO3=0.0 -! -!WR_SO2/WC_ASO4=0.0 -! -!WR_SO2/WC_ASO5=0.0 -! -!WR_SO2/WC_AHSO5=0.0 -! -!WR_SO2/WC_AHMS=0.0 -! -!WR_SO2/WR_O3=-KR29*<WR_SO2> - PJAC(:,81,68)=-TPK%KR29(:)*PCONC(:,81) -! -!WR_SO2/WR_H2O2=-KR30*<WR_SO2> - PJAC(:,81,69)=-TPK%KR30(:)*PCONC(:,81) -! -!WR_SO2/WR_NO=0.0 -! -!WR_SO2/WR_NO2=0.0 -! -!WR_SO2/WR_NO3=-KR16*<WR_SO2> - PJAC(:,81,72)=-TPK%KR16(:)*PCONC(:,81) -! -!WR_SO2/WR_N2O5=0.0 -! -!WR_SO2/WR_HONO=0.0 -! -!WR_SO2/WR_HNO3=0.0 -! -!WR_SO2/WR_HNO4=-KR12*<WR_SO2> - PJAC(:,81,76)=-TPK%KR12(:)*PCONC(:,81) -! -!WR_SO2/WR_NH3=0.0 -! -!WR_SO2/WR_OH=-KR7*<WR_SO2>+KR23*<WR_AHMS> - PJAC(:,81,78)=-TPK%KR7(:)*PCONC(:,81)+TPK%KR23(:)*PCONC(:,92) -! -!WR_SO2/WR_HO2=0.0 -! -!WR_SO2/WR_CO2=0.0 -! -!WR_SO2/WR_SO2=-KTR34-KR7*<WR_OH>-KR12*<WR_HNO4>-KR16*<WR_NO3>-KR18*<WR_MO2>-KR -!21*<WR_HCHO>-KR27*<WR_AHSO5>-KR29*<WR_O3>-KR30*<WR_H2O2> - PJAC(:,81,81)=-TPK%KTR34(:)-TPK%KR7(:)*PCONC(:,78)-TPK%KR12(:)*PCONC(:,76)-TPK& -&%KR16(:)*PCONC(:,72)-TPK%KR18(:)*PCONC(:,86)-TPK%KR21(:)*PCONC(:,83)-TPK%KR27(& -&:)*PCONC(:,91)-TPK%KR29(:)*PCONC(:,68)-TPK%KR30(:)*PCONC(:,69) -! -!WR_SO2/WR_SULF=0.0 -! -!WR_SO2/WR_HCHO=-KR21*<WR_SO2> - PJAC(:,81,83)=-TPK%KR21(:)*PCONC(:,81) -! -!WR_SO2/WR_ORA1=0.0 -! -!WR_SO2/WR_ORA2=0.0 -! -!WR_SO2/WR_MO2=-KR18*<WR_SO2> - PJAC(:,81,86)=-TPK%KR18(:)*PCONC(:,81) -! -!WR_SO2/WR_OP1=0.0 -! -!WR_SO2/WR_ASO3=0.0 -! -!WR_SO2/WR_ASO4=0.0 -! -!WR_SO2/WR_ASO5=0.0 -! -!WR_SO2/WR_AHSO5=-KR27*<WR_SO2> - PJAC(:,81,91)=-TPK%KR27(:)*PCONC(:,81) -! -!WR_SO2/WR_AHMS=+KR22+KR23*<WR_OH> - PJAC(:,81,92)=+TPK%KR22(:)+TPK%KR23(:)*PCONC(:,78) -! -!WR_SULF/O3=0.0 -! -!WR_SULF/H2O2=0.0 -! -!WR_SULF/NO=0.0 -! -!WR_SULF/NO2=0.0 -! -!WR_SULF/NO3=0.0 -! -!WR_SULF/N2O5=0.0 -! -!WR_SULF/HONO=0.0 -! -!WR_SULF/HNO3=0.0 -! -!WR_SULF/HNO4=0.0 -! -!WR_SULF/NH3=0.0 -! -!WR_SULF/DMS=0.0 -! -!WR_SULF/SO2=0.0 -! -!WR_SULF/SULF=+KTR15 - PJAC(:,82,13)=+TPK%KTR15(:) -! -!WR_SULF/CO=0.0 -! -!WR_SULF/OH=0.0 -! -!WR_SULF/HO2=0.0 -! -!WR_SULF/CH4=0.0 -! -!WR_SULF/ETH=0.0 -! -!WR_SULF/ALKA=0.0 -! -!WR_SULF/ALKE=0.0 -! -!WR_SULF/BIO=0.0 -! -!WR_SULF/ARO=0.0 -! -!WR_SULF/HCHO=0.0 -! -!WR_SULF/ALD=0.0 -! -!WR_SULF/KET=0.0 -! -!WR_SULF/CARBO=0.0 -! -!WR_SULF/ONIT=0.0 -! -!WR_SULF/PAN=0.0 -! -!WR_SULF/OP1=0.0 -! -!WR_SULF/OP2=0.0 -! -!WR_SULF/ORA1=0.0 -! -!WR_SULF/ORA2=0.0 -! -!WR_SULF/MO2=0.0 -! -!WR_SULF/ALKAP=0.0 -! -!WR_SULF/ALKEP=0.0 -! -!WR_SULF/BIOP=0.0 -! -!WR_SULF/PHO=0.0 -! -!WR_SULF/ADD=0.0 -! -!WR_SULF/AROP=0.0 -! -!WR_SULF/CARBOP=0.0 -! -!WR_SULF/OLN=0.0 -! -!WR_SULF/XO2=0.0 -! -!WR_SULF/WC_O3=0.0 -! -!WR_SULF/WC_H2O2=0.0 -! -!WR_SULF/WC_NO=0.0 -! -!WR_SULF/WC_NO2=0.0 -! -!WR_SULF/WC_NO3=0.0 -! -!WR_SULF/WC_N2O5=0.0 -! -!WR_SULF/WC_HONO=0.0 -! -!WR_SULF/WC_HNO3=0.0 -! -!WR_SULF/WC_HNO4=0.0 -! -!WR_SULF/WC_NH3=0.0 -! -!WR_SULF/WC_OH=0.0 -! -!WR_SULF/WC_HO2=0.0 -! -!WR_SULF/WC_CO2=0.0 -! -!WR_SULF/WC_SO2=0.0 -! -!WR_SULF/WC_SULF=0.0 -! -!WR_SULF/WC_HCHO=0.0 -! -!WR_SULF/WC_ORA1=0.0 -! -!WR_SULF/WC_ORA2=0.0 -! -!WR_SULF/WC_MO2=0.0 -! -!WR_SULF/WC_OP1=0.0 -! -!WR_SULF/WC_ASO3=0.0 -! -!WR_SULF/WC_ASO4=0.0 -! -!WR_SULF/WC_ASO5=0.0 -! -!WR_SULF/WC_AHSO5=0.0 -! -!WR_SULF/WC_AHMS=0.0 -! -!WR_SULF/WR_O3=+KR29*<WR_SO2> - PJAC(:,82,68)=+TPK%KR29(:)*PCONC(:,81) -! -!WR_SULF/WR_H2O2=+KR30*<WR_SO2> - PJAC(:,82,69)=+TPK%KR30(:)*PCONC(:,81) -! -!WR_SULF/WR_NO=0.0 -! -!WR_SULF/WR_NO2=0.0 -! -!WR_SULF/WR_NO3=-KR15*<WR_SULF> - PJAC(:,82,72)=-TPK%KR15(:)*PCONC(:,82) -! -!WR_SULF/WR_N2O5=0.0 -! -!WR_SULF/WR_HONO=0.0 -! -!WR_SULF/WR_HNO3=0.0 -! -!WR_SULF/WR_HNO4=+KR12*<WR_SO2> - PJAC(:,82,76)=+TPK%KR12(:)*PCONC(:,81) -! -!WR_SULF/WR_NH3=0.0 -! -!WR_SULF/WR_OH=0.0 -! -!WR_SULF/WR_HO2=0.0 -! -!WR_SULF/WR_CO2=0.0 -! -!WR_SULF/WR_SO2=+KR12*<WR_HNO4>+2.00*KR27*<WR_AHSO5>+KR29*<WR_O3>+KR30*<WR_H2O2 -!> - PJAC(:,82,81)=+TPK%KR12(:)*PCONC(:,76)+2.00*TPK%KR27(:)*PCONC(:,91)+TPK%KR29(:& -&)*PCONC(:,68)+TPK%KR30(:)*PCONC(:,69) -! -!WR_SULF/WR_SULF=-KTR35-KR15*<WR_NO3> - PJAC(:,82,82)=-TPK%KTR35(:)-TPK%KR15(:)*PCONC(:,72) -! -!WR_SULF/WR_HCHO=0.0 -! -!WR_SULF/WR_ORA1=0.0 -! -!WR_SULF/WR_ORA2=0.0 -! -!WR_SULF/WR_MO2=0.0 -! -!WR_SULF/WR_OP1=0.0 -! -!WR_SULF/WR_ASO3=0.0 -! -!WR_SULF/WR_ASO4=+KR28 - PJAC(:,82,89)=+TPK%KR28(:) -! -!WR_SULF/WR_ASO5=0.0 -! -!WR_SULF/WR_AHSO5=+2.00*KR27*<WR_SO2> - PJAC(:,82,91)=+2.00*TPK%KR27(:)*PCONC(:,81) -! -!WR_SULF/WR_AHMS=0.0 -! -!WR_HCHO/O3=0.0 -! -!WR_HCHO/H2O2=0.0 -! -!WR_HCHO/NO=0.0 -! -!WR_HCHO/NO2=0.0 -! -!WR_HCHO/NO3=0.0 -! -!WR_HCHO/N2O5=0.0 -! -!WR_HCHO/HONO=0.0 -! -!WR_HCHO/HNO3=0.0 -! -!WR_HCHO/HNO4=0.0 -! -!WR_HCHO/NH3=0.0 -! -!WR_HCHO/DMS=0.0 -! -!WR_HCHO/SO2=0.0 -! -!WR_HCHO/SULF=0.0 -! -!WR_HCHO/CO=0.0 -! -!WR_HCHO/OH=0.0 -! -!WR_HCHO/HO2=0.0 -! -!WR_HCHO/CH4=0.0 -! -!WR_HCHO/ETH=0.0 -! -!WR_HCHO/ALKA=0.0 -! -!WR_HCHO/ALKE=0.0 -! -!WR_HCHO/BIO=0.0 -! -!WR_HCHO/ARO=0.0 -! -!WR_HCHO/HCHO=+KTR16 - PJAC(:,83,23)=+TPK%KTR16(:) -! -!WR_HCHO/ALD=0.0 -! -!WR_HCHO/KET=0.0 -! -!WR_HCHO/CARBO=0.0 -! -!WR_HCHO/ONIT=0.0 -! -!WR_HCHO/PAN=0.0 -! -!WR_HCHO/OP1=0.0 -! -!WR_HCHO/OP2=0.0 -! -!WR_HCHO/ORA1=0.0 -! -!WR_HCHO/ORA2=0.0 -! -!WR_HCHO/MO2=0.0 -! -!WR_HCHO/ALKAP=0.0 -! -!WR_HCHO/ALKEP=0.0 -! -!WR_HCHO/BIOP=0.0 -! -!WR_HCHO/PHO=0.0 -! -!WR_HCHO/ADD=0.0 -! -!WR_HCHO/AROP=0.0 -! -!WR_HCHO/CARBOP=0.0 -! -!WR_HCHO/OLN=0.0 -! -!WR_HCHO/XO2=0.0 -! -!WR_HCHO/WC_O3=0.0 -! -!WR_HCHO/WC_H2O2=0.0 -! -!WR_HCHO/WC_NO=0.0 -! -!WR_HCHO/WC_NO2=0.0 -! -!WR_HCHO/WC_NO3=0.0 -! -!WR_HCHO/WC_N2O5=0.0 -! -!WR_HCHO/WC_HONO=0.0 -! -!WR_HCHO/WC_HNO3=0.0 -! -!WR_HCHO/WC_HNO4=0.0 -! -!WR_HCHO/WC_NH3=0.0 -! -!WR_HCHO/WC_OH=0.0 -! -!WR_HCHO/WC_HO2=0.0 -! -!WR_HCHO/WC_CO2=0.0 -! -!WR_HCHO/WC_SO2=0.0 -! -!WR_HCHO/WC_SULF=0.0 -! -!WR_HCHO/WC_HCHO=0.0 -! -!WR_HCHO/WC_ORA1=0.0 -! -!WR_HCHO/WC_ORA2=0.0 -! -!WR_HCHO/WC_MO2=0.0 -! -!WR_HCHO/WC_OP1=0.0 -! -!WR_HCHO/WC_ASO3=0.0 -! -!WR_HCHO/WC_ASO4=0.0 -! -!WR_HCHO/WC_ASO5=0.0 -! -!WR_HCHO/WC_AHSO5=0.0 -! -!WR_HCHO/WC_AHMS=0.0 -! -!WR_HCHO/WR_O3=0.0 -! -!WR_HCHO/WR_H2O2=0.0 -! -!WR_HCHO/WR_NO=0.0 -! -!WR_HCHO/WR_NO2=0.0 -! -!WR_HCHO/WR_NO3=0.0 -! -!WR_HCHO/WR_N2O5=0.0 -! -!WR_HCHO/WR_HONO=0.0 -! -!WR_HCHO/WR_HNO3=0.0 -! -!WR_HCHO/WR_HNO4=0.0 -! -!WR_HCHO/WR_NH3=0.0 -! -!WR_HCHO/WR_OH=-KR19*<WR_HCHO> - PJAC(:,83,78)=-TPK%KR19(:)*PCONC(:,83) -! -!WR_HCHO/WR_HO2=0.0 -! -!WR_HCHO/WR_CO2=0.0 -! -!WR_HCHO/WR_SO2=-KR21*<WR_HCHO> - PJAC(:,83,81)=-TPK%KR21(:)*PCONC(:,83) -! -!WR_HCHO/WR_SULF=0.0 -! -!WR_HCHO/WR_HCHO=-KTR36-KR19*<WR_OH>-KR21*<WR_SO2> - PJAC(:,83,83)=-TPK%KTR36(:)-TPK%KR19(:)*PCONC(:,78)-TPK%KR21(:)*PCONC(:,81) -! -!WR_HCHO/WR_ORA1=0.0 -! -!WR_HCHO/WR_ORA2=0.0 -! -!WR_HCHO/WR_MO2=+2.00*KR17*<WR_MO2>+2.00*KR17*<WR_MO2> - PJAC(:,83,86)=+2.00*TPK%KR17(:)*PCONC(:,86)+2.00*TPK%KR17(:)*PCONC(:,86) -! -!WR_HCHO/WR_OP1=0.0 -! -!WR_HCHO/WR_ASO3=0.0 -! -!WR_HCHO/WR_ASO4=0.0 -! -!WR_HCHO/WR_ASO5=0.0 -! -!WR_HCHO/WR_AHSO5=0.0 -! -!WR_HCHO/WR_AHMS=+KR22 - PJAC(:,83,92)=+TPK%KR22(:) -! -!WR_ORA1/O3=0.0 -! -!WR_ORA1/H2O2=0.0 -! -!WR_ORA1/NO=0.0 -! -!WR_ORA1/NO2=0.0 -! -!WR_ORA1/NO3=0.0 -! -!WR_ORA1/N2O5=0.0 -! -!WR_ORA1/HONO=0.0 -! -!WR_ORA1/HNO3=0.0 -! -!WR_ORA1/HNO4=0.0 -! -!WR_ORA1/NH3=0.0 -! -!WR_ORA1/DMS=0.0 -! -!WR_ORA1/SO2=0.0 -! -!WR_ORA1/SULF=0.0 -! -!WR_ORA1/CO=0.0 -! -!WR_ORA1/OH=0.0 -! -!WR_ORA1/HO2=0.0 -! -!WR_ORA1/CH4=0.0 -! -!WR_ORA1/ETH=0.0 -! -!WR_ORA1/ALKA=0.0 -! -!WR_ORA1/ALKE=0.0 -! -!WR_ORA1/BIO=0.0 -! -!WR_ORA1/ARO=0.0 -! -!WR_ORA1/HCHO=0.0 -! -!WR_ORA1/ALD=0.0 -! -!WR_ORA1/KET=0.0 -! -!WR_ORA1/CARBO=0.0 -! -!WR_ORA1/ONIT=0.0 -! -!WR_ORA1/PAN=0.0 -! -!WR_ORA1/OP1=0.0 -! -!WR_ORA1/OP2=0.0 -! -!WR_ORA1/ORA1=+KTR17 - PJAC(:,84,31)=+TPK%KTR17(:) -! -!WR_ORA1/ORA2=0.0 -! -!WR_ORA1/MO2=0.0 -! -!WR_ORA1/ALKAP=0.0 -! -!WR_ORA1/ALKEP=0.0 -! -!WR_ORA1/BIOP=0.0 -! -!WR_ORA1/PHO=0.0 -! -!WR_ORA1/ADD=0.0 -! -!WR_ORA1/AROP=0.0 -! -!WR_ORA1/CARBOP=0.0 -! -!WR_ORA1/OLN=0.0 -! -!WR_ORA1/XO2=0.0 -! -!WR_ORA1/WC_O3=0.0 -! -!WR_ORA1/WC_H2O2=0.0 -! -!WR_ORA1/WC_NO=0.0 -! -!WR_ORA1/WC_NO2=0.0 -! -!WR_ORA1/WC_NO3=0.0 -! -!WR_ORA1/WC_N2O5=0.0 -! -!WR_ORA1/WC_HONO=0.0 -! -!WR_ORA1/WC_HNO3=0.0 -! -!WR_ORA1/WC_HNO4=0.0 -! -!WR_ORA1/WC_NH3=0.0 -! -!WR_ORA1/WC_OH=0.0 -! -!WR_ORA1/WC_HO2=0.0 -! -!WR_ORA1/WC_CO2=0.0 -! -!WR_ORA1/WC_SO2=0.0 -! -!WR_ORA1/WC_SULF=0.0 -! -!WR_ORA1/WC_HCHO=0.0 -! -!WR_ORA1/WC_ORA1=0.0 -! -!WR_ORA1/WC_ORA2=0.0 -! -!WR_ORA1/WC_MO2=0.0 -! -!WR_ORA1/WC_OP1=0.0 -! -!WR_ORA1/WC_ASO3=0.0 -! -!WR_ORA1/WC_ASO4=0.0 -! -!WR_ORA1/WC_ASO5=0.0 -! -!WR_ORA1/WC_AHSO5=0.0 -! -!WR_ORA1/WC_AHMS=0.0 -! -!WR_ORA1/WR_O3=0.0 -! -!WR_ORA1/WR_H2O2=0.0 -! -!WR_ORA1/WR_NO=0.0 -! -!WR_ORA1/WR_NO2=0.0 -! -!WR_ORA1/WR_NO3=0.0 -! -!WR_ORA1/WR_N2O5=0.0 -! -!WR_ORA1/WR_HONO=0.0 -! -!WR_ORA1/WR_HNO3=0.0 -! -!WR_ORA1/WR_HNO4=0.0 -! -!WR_ORA1/WR_NH3=0.0 -! -!WR_ORA1/WR_OH=+KR19*<WR_HCHO>-KR20*<WR_ORA1>+KR23*<WR_AHMS> - PJAC(:,84,78)=+TPK%KR19(:)*PCONC(:,83)-TPK%KR20(:)*PCONC(:,84)+TPK%KR23(:)*PCO& -&NC(:,92) -! -!WR_ORA1/WR_HO2=0.0 -! -!WR_ORA1/WR_CO2=0.0 -! -!WR_ORA1/WR_SO2=0.0 -! -!WR_ORA1/WR_SULF=0.0 -! -!WR_ORA1/WR_HCHO=+KR19*<WR_OH> - PJAC(:,84,83)=+TPK%KR19(:)*PCONC(:,78) -! -!WR_ORA1/WR_ORA1=-KTR37-KR20*<WR_OH> - PJAC(:,84,84)=-TPK%KTR37(:)-TPK%KR20(:)*PCONC(:,78) -! -!WR_ORA1/WR_ORA2=0.0 -! -!WR_ORA1/WR_MO2=0.0 -! -!WR_ORA1/WR_OP1=0.0 -! -!WR_ORA1/WR_ASO3=0.0 -! -!WR_ORA1/WR_ASO4=0.0 -! -!WR_ORA1/WR_ASO5=0.0 -! -!WR_ORA1/WR_AHSO5=0.0 -! -!WR_ORA1/WR_AHMS=+KR23*<WR_OH> - PJAC(:,84,92)=+TPK%KR23(:)*PCONC(:,78) -! -!WR_ORA2/O3=0.0 -! -!WR_ORA2/H2O2=0.0 -! -!WR_ORA2/NO=0.0 -! -!WR_ORA2/NO2=0.0 -! -!WR_ORA2/NO3=0.0 -! -!WR_ORA2/N2O5=0.0 -! -!WR_ORA2/HONO=0.0 -! -!WR_ORA2/HNO3=0.0 -! -!WR_ORA2/HNO4=0.0 -! -!WR_ORA2/NH3=0.0 -! -!WR_ORA2/DMS=0.0 -! -!WR_ORA2/SO2=0.0 -! -!WR_ORA2/SULF=0.0 -! -!WR_ORA2/CO=0.0 -! -!WR_ORA2/OH=0.0 -! -!WR_ORA2/HO2=0.0 -! -!WR_ORA2/CH4=0.0 -! -!WR_ORA2/ETH=0.0 -! -!WR_ORA2/ALKA=0.0 -! -!WR_ORA2/ALKE=0.0 -! -!WR_ORA2/BIO=0.0 -! -!WR_ORA2/ARO=0.0 -! -!WR_ORA2/HCHO=0.0 -! -!WR_ORA2/ALD=0.0 -! -!WR_ORA2/KET=0.0 -! -!WR_ORA2/CARBO=0.0 -! -!WR_ORA2/ONIT=0.0 -! -!WR_ORA2/PAN=0.0 -! -!WR_ORA2/OP1=0.0 -! -!WR_ORA2/OP2=0.0 -! -!WR_ORA2/ORA1=0.0 -! -!WR_ORA2/ORA2=+KTR18 - PJAC(:,85,32)=+TPK%KTR18(:) -! -!WR_ORA2/MO2=0.0 -! -!WR_ORA2/ALKAP=0.0 -! -!WR_ORA2/ALKEP=0.0 -! -!WR_ORA2/BIOP=0.0 -! -!WR_ORA2/PHO=0.0 -! -!WR_ORA2/ADD=0.0 -! -!WR_ORA2/AROP=0.0 -! -!WR_ORA2/CARBOP=0.0 -! -!WR_ORA2/OLN=0.0 -! -!WR_ORA2/XO2=0.0 -! -!WR_ORA2/WC_O3=0.0 -! -!WR_ORA2/WC_H2O2=0.0 -! -!WR_ORA2/WC_NO=0.0 -! -!WR_ORA2/WC_NO2=0.0 -! -!WR_ORA2/WC_NO3=0.0 -! -!WR_ORA2/WC_N2O5=0.0 -! -!WR_ORA2/WC_HONO=0.0 -! -!WR_ORA2/WC_HNO3=0.0 -! -!WR_ORA2/WC_HNO4=0.0 -! -!WR_ORA2/WC_NH3=0.0 -! -!WR_ORA2/WC_OH=0.0 -! -!WR_ORA2/WC_HO2=0.0 -! -!WR_ORA2/WC_CO2=0.0 -! -!WR_ORA2/WC_SO2=0.0 -! -!WR_ORA2/WC_SULF=0.0 -! -!WR_ORA2/WC_HCHO=0.0 -! -!WR_ORA2/WC_ORA1=0.0 -! -!WR_ORA2/WC_ORA2=0.0 -! -!WR_ORA2/WC_MO2=0.0 -! -!WR_ORA2/WC_OP1=0.0 -! -!WR_ORA2/WC_ASO3=0.0 -! -!WR_ORA2/WC_ASO4=0.0 -! -!WR_ORA2/WC_ASO5=0.0 -! -!WR_ORA2/WC_AHSO5=0.0 -! -!WR_ORA2/WC_AHMS=0.0 -! -!WR_ORA2/WR_O3=0.0 -! -!WR_ORA2/WR_H2O2=0.0 -! -!WR_ORA2/WR_NO=0.0 -! -!WR_ORA2/WR_NO2=0.0 -! -!WR_ORA2/WR_NO3=0.0 -! -!WR_ORA2/WR_N2O5=0.0 -! -!WR_ORA2/WR_HONO=0.0 -! -!WR_ORA2/WR_HNO3=0.0 -! -!WR_ORA2/WR_HNO4=0.0 -! -!WR_ORA2/WR_NH3=0.0 -! -!WR_ORA2/WR_OH=0.0 -! -!WR_ORA2/WR_HO2=0.0 -! -!WR_ORA2/WR_CO2=0.0 -! -!WR_ORA2/WR_SO2=0.0 -! -!WR_ORA2/WR_SULF=0.0 -! -!WR_ORA2/WR_HCHO=0.0 -! -!WR_ORA2/WR_ORA1=0.0 -! -!WR_ORA2/WR_ORA2=-KTR38 - PJAC(:,85,85)=-TPK%KTR38(:) -! -!WR_ORA2/WR_MO2=0.0 -! -!WR_ORA2/WR_OP1=0.0 -! -!WR_ORA2/WR_ASO3=0.0 -! -!WR_ORA2/WR_ASO4=0.0 -! -!WR_ORA2/WR_ASO5=0.0 -! -!WR_ORA2/WR_AHSO5=0.0 -! -!WR_ORA2/WR_AHMS=0.0 -! -RETURN -END SUBROUTINE SUBJ16 -! -SUBROUTINE SUBJ17 -! -!Indices 86 a 90 -! -! -!WR_MO2/O3=0.0 -! -!WR_MO2/H2O2=0.0 -! -!WR_MO2/NO=0.0 -! -!WR_MO2/NO2=0.0 -! -!WR_MO2/NO3=0.0 -! -!WR_MO2/N2O5=0.0 -! -!WR_MO2/HONO=0.0 -! -!WR_MO2/HNO3=0.0 -! -!WR_MO2/HNO4=0.0 -! -!WR_MO2/NH3=0.0 -! -!WR_MO2/DMS=0.0 -! -!WR_MO2/SO2=0.0 -! -!WR_MO2/SULF=0.0 -! -!WR_MO2/CO=0.0 -! -!WR_MO2/OH=0.0 -! -!WR_MO2/HO2=0.0 -! -!WR_MO2/CH4=0.0 -! -!WR_MO2/ETH=0.0 -! -!WR_MO2/ALKA=0.0 -! -!WR_MO2/ALKE=0.0 -! -!WR_MO2/BIO=0.0 -! -!WR_MO2/ARO=0.0 -! -!WR_MO2/HCHO=0.0 -! -!WR_MO2/ALD=0.0 -! -!WR_MO2/KET=0.0 -! -!WR_MO2/CARBO=0.0 -! -!WR_MO2/ONIT=0.0 -! -!WR_MO2/PAN=0.0 -! -!WR_MO2/OP1=0.0 -! -!WR_MO2/OP2=0.0 -! -!WR_MO2/ORA1=0.0 -! -!WR_MO2/ORA2=0.0 -! -!WR_MO2/MO2=+KTR19 - PJAC(:,86,33)=+TPK%KTR19(:) -! -!WR_MO2/ALKAP=0.0 -! -!WR_MO2/ALKEP=0.0 -! -!WR_MO2/BIOP=0.0 -! -!WR_MO2/PHO=0.0 -! -!WR_MO2/ADD=0.0 -! -!WR_MO2/AROP=0.0 -! -!WR_MO2/CARBOP=0.0 -! -!WR_MO2/OLN=0.0 -! -!WR_MO2/XO2=0.0 -! -!WR_MO2/WC_O3=0.0 -! -!WR_MO2/WC_H2O2=0.0 -! -!WR_MO2/WC_NO=0.0 -! -!WR_MO2/WC_NO2=0.0 -! -!WR_MO2/WC_NO3=0.0 -! -!WR_MO2/WC_N2O5=0.0 -! -!WR_MO2/WC_HONO=0.0 -! -!WR_MO2/WC_HNO3=0.0 -! -!WR_MO2/WC_HNO4=0.0 -! -!WR_MO2/WC_NH3=0.0 -! -!WR_MO2/WC_OH=0.0 -! -!WR_MO2/WC_HO2=0.0 -! -!WR_MO2/WC_CO2=0.0 -! -!WR_MO2/WC_SO2=0.0 -! -!WR_MO2/WC_SULF=0.0 -! -!WR_MO2/WC_HCHO=0.0 -! -!WR_MO2/WC_ORA1=0.0 -! -!WR_MO2/WC_ORA2=0.0 -! -!WR_MO2/WC_MO2=0.0 -! -!WR_MO2/WC_OP1=0.0 -! -!WR_MO2/WC_ASO3=0.0 -! -!WR_MO2/WC_ASO4=0.0 -! -!WR_MO2/WC_ASO5=0.0 -! -!WR_MO2/WC_AHSO5=0.0 -! -!WR_MO2/WC_AHMS=0.0 -! -!WR_MO2/WR_O3=0.0 -! -!WR_MO2/WR_H2O2=0.0 -! -!WR_MO2/WR_NO=0.0 -! -!WR_MO2/WR_NO2=0.0 -! -!WR_MO2/WR_NO3=0.0 -! -!WR_MO2/WR_N2O5=0.0 -! -!WR_MO2/WR_HONO=0.0 -! -!WR_MO2/WR_HNO3=0.0 -! -!WR_MO2/WR_HNO4=0.0 -! -!WR_MO2/WR_NH3=0.0 -! -!WR_MO2/WR_OH=0.0 -! -!WR_MO2/WR_HO2=0.0 -! -!WR_MO2/WR_CO2=0.0 -! -!WR_MO2/WR_SO2=-KR18*<WR_MO2> - PJAC(:,86,81)=-TPK%KR18(:)*PCONC(:,86) -! -!WR_MO2/WR_SULF=0.0 -! -!WR_MO2/WR_HCHO=0.0 -! -!WR_MO2/WR_ORA1=0.0 -! -!WR_MO2/WR_ORA2=0.0 -! -!WR_MO2/WR_MO2=-KTR39-KR17*<WR_MO2>-KR17*<WR_MO2>-KR17*<WR_MO2>-KR17*<WR_MO2>-K -!R18*<WR_SO2> - PJAC(:,86,86)=-TPK%KTR39(:)-TPK%KR17(:)*PCONC(:,86)-TPK%KR17(:)*PCONC(:,86)-TP& -&K%KR17(:)*PCONC(:,86)-TPK%KR17(:)*PCONC(:,86)-TPK%KR18(:)*PCONC(:,81) -! -!WR_MO2/WR_OP1=0.0 -! -!WR_MO2/WR_ASO3=0.0 -! -!WR_MO2/WR_ASO4=0.0 -! -!WR_MO2/WR_ASO5=0.0 -! -!WR_MO2/WR_AHSO5=0.0 -! -!WR_MO2/WR_AHMS=0.0 -! -!WR_OP1/O3=0.0 -! -!WR_OP1/H2O2=0.0 -! -!WR_OP1/NO=0.0 -! -!WR_OP1/NO2=0.0 -! -!WR_OP1/NO3=0.0 -! -!WR_OP1/N2O5=0.0 -! -!WR_OP1/HONO=0.0 -! -!WR_OP1/HNO3=0.0 -! -!WR_OP1/HNO4=0.0 -! -!WR_OP1/NH3=0.0 -! -!WR_OP1/DMS=0.0 -! -!WR_OP1/SO2=0.0 -! -!WR_OP1/SULF=0.0 -! -!WR_OP1/CO=0.0 -! -!WR_OP1/OH=0.0 -! -!WR_OP1/HO2=0.0 -! -!WR_OP1/CH4=0.0 -! -!WR_OP1/ETH=0.0 -! -!WR_OP1/ALKA=0.0 -! -!WR_OP1/ALKE=0.0 -! -!WR_OP1/BIO=0.0 -! -!WR_OP1/ARO=0.0 -! -!WR_OP1/HCHO=0.0 -! -!WR_OP1/ALD=0.0 -! -!WR_OP1/KET=0.0 -! -!WR_OP1/CARBO=0.0 -! -!WR_OP1/ONIT=0.0 -! -!WR_OP1/PAN=0.0 -! -!WR_OP1/OP1=+KTR20 - PJAC(:,87,29)=+TPK%KTR20(:) -! -!WR_OP1/OP2=0.0 -! -!WR_OP1/ORA1=0.0 -! -!WR_OP1/ORA2=0.0 -! -!WR_OP1/MO2=0.0 -! -!WR_OP1/ALKAP=0.0 -! -!WR_OP1/ALKEP=0.0 -! -!WR_OP1/BIOP=0.0 -! -!WR_OP1/PHO=0.0 -! -!WR_OP1/ADD=0.0 -! -!WR_OP1/AROP=0.0 -! -!WR_OP1/CARBOP=0.0 -! -!WR_OP1/OLN=0.0 -! -!WR_OP1/XO2=0.0 -! -!WR_OP1/WC_O3=0.0 -! -!WR_OP1/WC_H2O2=0.0 -! -!WR_OP1/WC_NO=0.0 -! -!WR_OP1/WC_NO2=0.0 -! -!WR_OP1/WC_NO3=0.0 -! -!WR_OP1/WC_N2O5=0.0 -! -!WR_OP1/WC_HONO=0.0 -! -!WR_OP1/WC_HNO3=0.0 -! -!WR_OP1/WC_HNO4=0.0 -! -!WR_OP1/WC_NH3=0.0 -! -!WR_OP1/WC_OH=0.0 -! -!WR_OP1/WC_HO2=0.0 -! -!WR_OP1/WC_CO2=0.0 -! -!WR_OP1/WC_SO2=0.0 -! -!WR_OP1/WC_SULF=0.0 -! -!WR_OP1/WC_HCHO=0.0 -! -!WR_OP1/WC_ORA1=0.0 -! -!WR_OP1/WC_ORA2=0.0 -! -!WR_OP1/WC_MO2=0.0 -! -!WR_OP1/WC_OP1=0.0 -! -!WR_OP1/WC_ASO3=0.0 -! -!WR_OP1/WC_ASO4=0.0 -! -!WR_OP1/WC_ASO5=0.0 -! -!WR_OP1/WC_AHSO5=0.0 -! -!WR_OP1/WC_AHMS=0.0 -! -!WR_OP1/WR_O3=0.0 -! -!WR_OP1/WR_H2O2=0.0 -! -!WR_OP1/WR_NO=0.0 -! -!WR_OP1/WR_NO2=0.0 -! -!WR_OP1/WR_NO3=0.0 -! -!WR_OP1/WR_N2O5=0.0 -! -!WR_OP1/WR_HONO=0.0 -! -!WR_OP1/WR_HNO3=0.0 -! -!WR_OP1/WR_HNO4=0.0 -! -!WR_OP1/WR_NH3=0.0 -! -!WR_OP1/WR_OH=0.0 -! -!WR_OP1/WR_HO2=0.0 -! -!WR_OP1/WR_CO2=0.0 -! -!WR_OP1/WR_SO2=+KR18*<WR_MO2> - PJAC(:,87,81)=+TPK%KR18(:)*PCONC(:,86) -! -!WR_OP1/WR_SULF=0.0 -! -!WR_OP1/WR_HCHO=0.0 -! -!WR_OP1/WR_ORA1=0.0 -! -!WR_OP1/WR_ORA2=0.0 -! -!WR_OP1/WR_MO2=+KR18*<WR_SO2> - PJAC(:,87,86)=+TPK%KR18(:)*PCONC(:,81) -! -!WR_OP1/WR_OP1=-KTR40 - PJAC(:,87,87)=-TPK%KTR40(:) -! -!WR_OP1/WR_ASO3=0.0 -! -!WR_OP1/WR_ASO4=0.0 -! -!WR_OP1/WR_ASO5=0.0 -! -!WR_OP1/WR_AHSO5=0.0 -! -!WR_OP1/WR_AHMS=0.0 -! -!WR_ASO3/O3=0.0 -! -!WR_ASO3/H2O2=0.0 -! -!WR_ASO3/NO=0.0 -! -!WR_ASO3/NO2=0.0 -! -!WR_ASO3/NO3=0.0 -! -!WR_ASO3/N2O5=0.0 -! -!WR_ASO3/HONO=0.0 -! -!WR_ASO3/HNO3=0.0 -! -!WR_ASO3/HNO4=0.0 -! -!WR_ASO3/NH3=0.0 -! -!WR_ASO3/DMS=0.0 -! -!WR_ASO3/SO2=0.0 -! -!WR_ASO3/SULF=0.0 -! -!WR_ASO3/CO=0.0 -! -!WR_ASO3/OH=0.0 -! -!WR_ASO3/HO2=0.0 -! -!WR_ASO3/CH4=0.0 -! -!WR_ASO3/ETH=0.0 -! -!WR_ASO3/ALKA=0.0 -! -!WR_ASO3/ALKE=0.0 -! -!WR_ASO3/BIO=0.0 -! -!WR_ASO3/ARO=0.0 -! -!WR_ASO3/HCHO=0.0 -! -!WR_ASO3/ALD=0.0 -! -!WR_ASO3/KET=0.0 -! -!WR_ASO3/CARBO=0.0 -! -!WR_ASO3/ONIT=0.0 -! -!WR_ASO3/PAN=0.0 -! -!WR_ASO3/OP1=0.0 -! -!WR_ASO3/OP2=0.0 -! -!WR_ASO3/ORA1=0.0 -! -!WR_ASO3/ORA2=0.0 -! -!WR_ASO3/MO2=0.0 -! -!WR_ASO3/ALKAP=0.0 -! -!WR_ASO3/ALKEP=0.0 -! -!WR_ASO3/BIOP=0.0 -! -!WR_ASO3/PHO=0.0 -! -!WR_ASO3/ADD=0.0 -! -!WR_ASO3/AROP=0.0 -! -!WR_ASO3/CARBOP=0.0 -! -!WR_ASO3/OLN=0.0 -! -!WR_ASO3/XO2=0.0 -! -!WR_ASO3/WC_O3=0.0 -! -!WR_ASO3/WC_H2O2=0.0 -! -!WR_ASO3/WC_NO=0.0 -! -!WR_ASO3/WC_NO2=0.0 -! -!WR_ASO3/WC_NO3=0.0 -! -!WR_ASO3/WC_N2O5=0.0 -! -!WR_ASO3/WC_HONO=0.0 -! -!WR_ASO3/WC_HNO3=0.0 -! -!WR_ASO3/WC_HNO4=0.0 -! -!WR_ASO3/WC_NH3=0.0 -! -!WR_ASO3/WC_OH=0.0 -! -!WR_ASO3/WC_HO2=0.0 -! -!WR_ASO3/WC_CO2=0.0 -! -!WR_ASO3/WC_SO2=0.0 -! -!WR_ASO3/WC_SULF=0.0 -! -!WR_ASO3/WC_HCHO=0.0 -! -!WR_ASO3/WC_ORA1=0.0 -! -!WR_ASO3/WC_ORA2=0.0 -! -!WR_ASO3/WC_MO2=0.0 -! -!WR_ASO3/WC_OP1=0.0 -! -!WR_ASO3/WC_ASO3=0.0 -! -!WR_ASO3/WC_ASO4=0.0 -! -!WR_ASO3/WC_ASO5=0.0 -! -!WR_ASO3/WC_AHSO5=0.0 -! -!WR_ASO3/WC_AHMS=0.0 -! -!WR_ASO3/WR_O3=0.0 -! -!WR_ASO3/WR_H2O2=0.0 -! -!WR_ASO3/WR_NO=0.0 -! -!WR_ASO3/WR_NO2=0.0 -! -!WR_ASO3/WR_NO3=+KR16*<WR_SO2> - PJAC(:,88,72)=+TPK%KR16(:)*PCONC(:,81) -! -!WR_ASO3/WR_N2O5=0.0 -! -!WR_ASO3/WR_HONO=0.0 -! -!WR_ASO3/WR_HNO3=0.0 -! -!WR_ASO3/WR_HNO4=0.0 -! -!WR_ASO3/WR_NH3=0.0 -! -!WR_ASO3/WR_OH=+KR7*<WR_SO2> - PJAC(:,88,78)=+TPK%KR7(:)*PCONC(:,81) -! -!WR_ASO3/WR_HO2=0.0 -! -!WR_ASO3/WR_CO2=0.0 -! -!WR_ASO3/WR_SO2=+KR7*<WR_OH>+KR16*<WR_NO3>+KR18*<WR_MO2> - PJAC(:,88,81)=+TPK%KR7(:)*PCONC(:,78)+TPK%KR16(:)*PCONC(:,72)+TPK%KR18(:)*PCON& -&C(:,86) -! -!WR_ASO3/WR_SULF=0.0 -! -!WR_ASO3/WR_HCHO=0.0 -! -!WR_ASO3/WR_ORA1=0.0 -! -!WR_ASO3/WR_ORA2=0.0 -! -!WR_ASO3/WR_MO2=+KR18*<WR_SO2> - PJAC(:,88,86)=+TPK%KR18(:)*PCONC(:,81) -! -!WR_ASO3/WR_OP1=0.0 -! -!WR_ASO3/WR_ASO3=-KR24*<W_O2> - PJAC(:,88,88)=-TPK%KR24(:)*TPK%W_O2(:) -! -!WR_ASO3/WR_ASO4=0.0 -! -!WR_ASO3/WR_ASO5=0.0 -! -!WR_ASO3/WR_AHSO5=0.0 -! -!WR_ASO3/WR_AHMS=0.0 -! -!WR_ASO4/O3=0.0 -! -!WR_ASO4/H2O2=0.0 -! -!WR_ASO4/NO=0.0 -! -!WR_ASO4/NO2=0.0 -! -!WR_ASO4/NO3=0.0 -! -!WR_ASO4/N2O5=0.0 -! -!WR_ASO4/HONO=0.0 -! -!WR_ASO4/HNO3=0.0 -! -!WR_ASO4/HNO4=0.0 -! -!WR_ASO4/NH3=0.0 -! -!WR_ASO4/DMS=0.0 -! -!WR_ASO4/SO2=0.0 -! -!WR_ASO4/SULF=0.0 -! -!WR_ASO4/CO=0.0 -! -!WR_ASO4/OH=0.0 -! -!WR_ASO4/HO2=0.0 -! -!WR_ASO4/CH4=0.0 -! -!WR_ASO4/ETH=0.0 -! -!WR_ASO4/ALKA=0.0 -! -!WR_ASO4/ALKE=0.0 -! -!WR_ASO4/BIO=0.0 -! -!WR_ASO4/ARO=0.0 -! -!WR_ASO4/HCHO=0.0 -! -!WR_ASO4/ALD=0.0 -! -!WR_ASO4/KET=0.0 -! -!WR_ASO4/CARBO=0.0 -! -!WR_ASO4/ONIT=0.0 -! -!WR_ASO4/PAN=0.0 -! -!WR_ASO4/OP1=0.0 -! -!WR_ASO4/OP2=0.0 -! -!WR_ASO4/ORA1=0.0 -! -!WR_ASO4/ORA2=0.0 -! -!WR_ASO4/MO2=0.0 -! -!WR_ASO4/ALKAP=0.0 -! -!WR_ASO4/ALKEP=0.0 -! -!WR_ASO4/BIOP=0.0 -! -!WR_ASO4/PHO=0.0 -! -!WR_ASO4/ADD=0.0 -! -!WR_ASO4/AROP=0.0 -! -!WR_ASO4/CARBOP=0.0 -! -!WR_ASO4/OLN=0.0 -! -!WR_ASO4/XO2=0.0 -! -!WR_ASO4/WC_O3=0.0 -! -!WR_ASO4/WC_H2O2=0.0 -! -!WR_ASO4/WC_NO=0.0 -! -!WR_ASO4/WC_NO2=0.0 -! -!WR_ASO4/WC_NO3=0.0 -! -!WR_ASO4/WC_N2O5=0.0 -! -!WR_ASO4/WC_HONO=0.0 -! -!WR_ASO4/WC_HNO3=0.0 -! -!WR_ASO4/WC_HNO4=0.0 -! -!WR_ASO4/WC_NH3=0.0 -! -!WR_ASO4/WC_OH=0.0 -! -!WR_ASO4/WC_HO2=0.0 -! -!WR_ASO4/WC_CO2=0.0 -! -!WR_ASO4/WC_SO2=0.0 -! -!WR_ASO4/WC_SULF=0.0 -! -!WR_ASO4/WC_HCHO=0.0 -! -!WR_ASO4/WC_ORA1=0.0 -! -!WR_ASO4/WC_ORA2=0.0 -! -!WR_ASO4/WC_MO2=0.0 -! -!WR_ASO4/WC_OP1=0.0 -! -!WR_ASO4/WC_ASO3=0.0 -! -!WR_ASO4/WC_ASO4=0.0 -! -!WR_ASO4/WC_ASO5=0.0 -! -!WR_ASO4/WC_AHSO5=0.0 -! -!WR_ASO4/WC_AHMS=0.0 -! -!WR_ASO4/WR_O3=0.0 -! -!WR_ASO4/WR_H2O2=0.0 -! -!WR_ASO4/WR_NO=0.0 -! -!WR_ASO4/WR_NO2=0.0 -! -!WR_ASO4/WR_NO3=+KR15*<WR_SULF> - PJAC(:,89,72)=+TPK%KR15(:)*PCONC(:,82) -! -!WR_ASO4/WR_N2O5=0.0 -! -!WR_ASO4/WR_HONO=0.0 -! -!WR_ASO4/WR_HNO3=0.0 -! -!WR_ASO4/WR_HNO4=0.0 -! -!WR_ASO4/WR_NH3=0.0 -! -!WR_ASO4/WR_OH=0.0 -! -!WR_ASO4/WR_HO2=0.0 -! -!WR_ASO4/WR_CO2=0.0 -! -!WR_ASO4/WR_SO2=0.0 -! -!WR_ASO4/WR_SULF=+KR15*<WR_NO3> - PJAC(:,89,82)=+TPK%KR15(:)*PCONC(:,72) -! -!WR_ASO4/WR_HCHO=0.0 -! -!WR_ASO4/WR_ORA1=0.0 -! -!WR_ASO4/WR_ORA2=0.0 -! -!WR_ASO4/WR_MO2=0.0 -! -!WR_ASO4/WR_OP1=0.0 -! -!WR_ASO4/WR_ASO3=0.0 -! -!WR_ASO4/WR_ASO4=-KR28 - PJAC(:,89,89)=-TPK%KR28(:) -! -!WR_ASO4/WR_ASO5=+KR26*<WR_ASO5>+KR26*<WR_ASO5>+KR26*<WR_ASO5>+KR26*<WR_ASO5> - PJAC(:,89,90)=+TPK%KR26(:)*PCONC(:,90)+TPK%KR26(:)*PCONC(:,90)+TPK%KR26(:)*PCO& -&NC(:,90)+TPK%KR26(:)*PCONC(:,90) -! -!WR_ASO4/WR_AHSO5=0.0 -! -!WR_ASO4/WR_AHMS=0.0 -! -!WR_ASO5/O3=0.0 -! -!WR_ASO5/H2O2=0.0 -! -!WR_ASO5/NO=0.0 -! -!WR_ASO5/NO2=0.0 -! -!WR_ASO5/NO3=0.0 -! -!WR_ASO5/N2O5=0.0 -! -!WR_ASO5/HONO=0.0 -! -!WR_ASO5/HNO3=0.0 -! -!WR_ASO5/HNO4=0.0 -! -!WR_ASO5/NH3=0.0 -! -!WR_ASO5/DMS=0.0 -! -!WR_ASO5/SO2=0.0 -! -!WR_ASO5/SULF=0.0 -! -!WR_ASO5/CO=0.0 -! -!WR_ASO5/OH=0.0 -! -!WR_ASO5/HO2=0.0 -! -!WR_ASO5/CH4=0.0 -! -!WR_ASO5/ETH=0.0 -! -!WR_ASO5/ALKA=0.0 -! -!WR_ASO5/ALKE=0.0 -! -!WR_ASO5/BIO=0.0 -! -!WR_ASO5/ARO=0.0 -! -!WR_ASO5/HCHO=0.0 -! -!WR_ASO5/ALD=0.0 -! -!WR_ASO5/KET=0.0 -! -!WR_ASO5/CARBO=0.0 -! -!WR_ASO5/ONIT=0.0 -! -!WR_ASO5/PAN=0.0 -! -!WR_ASO5/OP1=0.0 -! -!WR_ASO5/OP2=0.0 -! -!WR_ASO5/ORA1=0.0 -! -!WR_ASO5/ORA2=0.0 -! -!WR_ASO5/MO2=0.0 -! -!WR_ASO5/ALKAP=0.0 -! -!WR_ASO5/ALKEP=0.0 -! -!WR_ASO5/BIOP=0.0 -! -!WR_ASO5/PHO=0.0 -! -!WR_ASO5/ADD=0.0 -! -!WR_ASO5/AROP=0.0 -! -!WR_ASO5/CARBOP=0.0 -! -!WR_ASO5/OLN=0.0 -! -!WR_ASO5/XO2=0.0 -! -!WR_ASO5/WC_O3=0.0 -! -!WR_ASO5/WC_H2O2=0.0 -! -!WR_ASO5/WC_NO=0.0 -! -!WR_ASO5/WC_NO2=0.0 -! -!WR_ASO5/WC_NO3=0.0 -! -!WR_ASO5/WC_N2O5=0.0 -! -!WR_ASO5/WC_HONO=0.0 -! -!WR_ASO5/WC_HNO3=0.0 -! -!WR_ASO5/WC_HNO4=0.0 -! -!WR_ASO5/WC_NH3=0.0 -! -!WR_ASO5/WC_OH=0.0 -! -!WR_ASO5/WC_HO2=0.0 -! -!WR_ASO5/WC_CO2=0.0 -! -!WR_ASO5/WC_SO2=0.0 -! -!WR_ASO5/WC_SULF=0.0 -! -!WR_ASO5/WC_HCHO=0.0 -! -!WR_ASO5/WC_ORA1=0.0 -! -!WR_ASO5/WC_ORA2=0.0 -! -!WR_ASO5/WC_MO2=0.0 -! -!WR_ASO5/WC_OP1=0.0 -! -!WR_ASO5/WC_ASO3=0.0 -! -!WR_ASO5/WC_ASO4=0.0 -! -!WR_ASO5/WC_ASO5=0.0 -! -!WR_ASO5/WC_AHSO5=0.0 -! -!WR_ASO5/WC_AHMS=0.0 -! -!WR_ASO5/WR_O3=0.0 -! -!WR_ASO5/WR_H2O2=0.0 -! -!WR_ASO5/WR_NO=0.0 -! -!WR_ASO5/WR_NO2=0.0 -! -!WR_ASO5/WR_NO3=0.0 -! -!WR_ASO5/WR_N2O5=0.0 -! -!WR_ASO5/WR_HONO=0.0 -! -!WR_ASO5/WR_HNO3=0.0 -! -!WR_ASO5/WR_HNO4=0.0 -! -!WR_ASO5/WR_NH3=0.0 -! -!WR_ASO5/WR_OH=0.0 -! -!WR_ASO5/WR_HO2=-KR25*<WR_ASO5> - PJAC(:,90,79)=-TPK%KR25(:)*PCONC(:,90) -! -!WR_ASO5/WR_CO2=0.0 -! -!WR_ASO5/WR_SO2=0.0 -! -!WR_ASO5/WR_SULF=0.0 -! -!WR_ASO5/WR_HCHO=0.0 -! -!WR_ASO5/WR_ORA1=0.0 -! -!WR_ASO5/WR_ORA2=0.0 -! -!WR_ASO5/WR_MO2=0.0 -! -!WR_ASO5/WR_OP1=0.0 -! -!WR_ASO5/WR_ASO3=+KR24*<W_O2> - PJAC(:,90,88)=+TPK%KR24(:)*TPK%W_O2(:) -! -!WR_ASO5/WR_ASO4=0.0 -! -!WR_ASO5/WR_ASO5=-KR25*<WR_HO2>-KR26*<WR_ASO5>-KR26*<WR_ASO5>-KR26*<WR_ASO5>-KR -!26*<WR_ASO5> - PJAC(:,90,90)=-TPK%KR25(:)*PCONC(:,79)-TPK%KR26(:)*PCONC(:,90)-TPK%KR26(:)*PCO& -&NC(:,90)-TPK%KR26(:)*PCONC(:,90)-TPK%KR26(:)*PCONC(:,90) -! -!WR_ASO5/WR_AHSO5=0.0 -! -!WR_ASO5/WR_AHMS=0.0 -! -RETURN -END SUBROUTINE SUBJ17 -! -SUBROUTINE SUBJ18 -! -!Indices 91 a 92 -! -! -!WR_AHSO5/O3=0.0 -! -!WR_AHSO5/H2O2=0.0 -! -!WR_AHSO5/NO=0.0 -! -!WR_AHSO5/NO2=0.0 -! -!WR_AHSO5/NO3=0.0 -! -!WR_AHSO5/N2O5=0.0 -! -!WR_AHSO5/HONO=0.0 -! -!WR_AHSO5/HNO3=0.0 -! -!WR_AHSO5/HNO4=0.0 -! -!WR_AHSO5/NH3=0.0 -! -!WR_AHSO5/DMS=0.0 -! -!WR_AHSO5/SO2=0.0 -! -!WR_AHSO5/SULF=0.0 -! -!WR_AHSO5/CO=0.0 -! -!WR_AHSO5/OH=0.0 -! -!WR_AHSO5/HO2=0.0 -! -!WR_AHSO5/CH4=0.0 -! -!WR_AHSO5/ETH=0.0 -! -!WR_AHSO5/ALKA=0.0 -! -!WR_AHSO5/ALKE=0.0 -! -!WR_AHSO5/BIO=0.0 -! -!WR_AHSO5/ARO=0.0 -! -!WR_AHSO5/HCHO=0.0 -! -!WR_AHSO5/ALD=0.0 -! -!WR_AHSO5/KET=0.0 -! -!WR_AHSO5/CARBO=0.0 -! -!WR_AHSO5/ONIT=0.0 -! -!WR_AHSO5/PAN=0.0 -! -!WR_AHSO5/OP1=0.0 -! -!WR_AHSO5/OP2=0.0 -! -!WR_AHSO5/ORA1=0.0 -! -!WR_AHSO5/ORA2=0.0 -! -!WR_AHSO5/MO2=0.0 -! -!WR_AHSO5/ALKAP=0.0 -! -!WR_AHSO5/ALKEP=0.0 -! -!WR_AHSO5/BIOP=0.0 -! -!WR_AHSO5/PHO=0.0 -! -!WR_AHSO5/ADD=0.0 -! -!WR_AHSO5/AROP=0.0 -! -!WR_AHSO5/CARBOP=0.0 -! -!WR_AHSO5/OLN=0.0 -! -!WR_AHSO5/XO2=0.0 -! -!WR_AHSO5/WC_O3=0.0 -! -!WR_AHSO5/WC_H2O2=0.0 -! -!WR_AHSO5/WC_NO=0.0 -! -!WR_AHSO5/WC_NO2=0.0 -! -!WR_AHSO5/WC_NO3=0.0 -! -!WR_AHSO5/WC_N2O5=0.0 -! -!WR_AHSO5/WC_HONO=0.0 -! -!WR_AHSO5/WC_HNO3=0.0 -! -!WR_AHSO5/WC_HNO4=0.0 -! -!WR_AHSO5/WC_NH3=0.0 -! -!WR_AHSO5/WC_OH=0.0 -! -!WR_AHSO5/WC_HO2=0.0 -! -!WR_AHSO5/WC_CO2=0.0 -! -!WR_AHSO5/WC_SO2=0.0 -! -!WR_AHSO5/WC_SULF=0.0 -! -!WR_AHSO5/WC_HCHO=0.0 -! -!WR_AHSO5/WC_ORA1=0.0 -! -!WR_AHSO5/WC_ORA2=0.0 -! -!WR_AHSO5/WC_MO2=0.0 -! -!WR_AHSO5/WC_OP1=0.0 -! -!WR_AHSO5/WC_ASO3=0.0 -! -!WR_AHSO5/WC_ASO4=0.0 -! -!WR_AHSO5/WC_ASO5=0.0 -! -!WR_AHSO5/WC_AHSO5=0.0 -! -!WR_AHSO5/WC_AHMS=0.0 -! -!WR_AHSO5/WR_O3=0.0 -! -!WR_AHSO5/WR_H2O2=0.0 -! -!WR_AHSO5/WR_NO=0.0 -! -!WR_AHSO5/WR_NO2=0.0 -! -!WR_AHSO5/WR_NO3=0.0 -! -!WR_AHSO5/WR_N2O5=0.0 -! -!WR_AHSO5/WR_HONO=0.0 -! -!WR_AHSO5/WR_HNO3=0.0 -! -!WR_AHSO5/WR_HNO4=0.0 -! -!WR_AHSO5/WR_NH3=0.0 -! -!WR_AHSO5/WR_OH=0.0 -! -!WR_AHSO5/WR_HO2=+KR25*<WR_ASO5> - PJAC(:,91,79)=+TPK%KR25(:)*PCONC(:,90) -! -!WR_AHSO5/WR_CO2=0.0 -! -!WR_AHSO5/WR_SO2=-KR27*<WR_AHSO5> - PJAC(:,91,81)=-TPK%KR27(:)*PCONC(:,91) -! -!WR_AHSO5/WR_SULF=0.0 -! -!WR_AHSO5/WR_HCHO=0.0 -! -!WR_AHSO5/WR_ORA1=0.0 -! -!WR_AHSO5/WR_ORA2=0.0 -! -!WR_AHSO5/WR_MO2=0.0 -! -!WR_AHSO5/WR_OP1=0.0 -! -!WR_AHSO5/WR_ASO3=0.0 -! -!WR_AHSO5/WR_ASO4=0.0 -! -!WR_AHSO5/WR_ASO5=+KR25*<WR_HO2> - PJAC(:,91,90)=+TPK%KR25(:)*PCONC(:,79) -! -!WR_AHSO5/WR_AHSO5=-KR27*<WR_SO2> - PJAC(:,91,91)=-TPK%KR27(:)*PCONC(:,81) -! -!WR_AHSO5/WR_AHMS=0.0 -! -!WR_AHMS/O3=0.0 -! -!WR_AHMS/H2O2=0.0 -! -!WR_AHMS/NO=0.0 -! -!WR_AHMS/NO2=0.0 -! -!WR_AHMS/NO3=0.0 -! -!WR_AHMS/N2O5=0.0 -! -!WR_AHMS/HONO=0.0 -! -!WR_AHMS/HNO3=0.0 -! -!WR_AHMS/HNO4=0.0 -! -!WR_AHMS/NH3=0.0 -! -!WR_AHMS/DMS=0.0 -! -!WR_AHMS/SO2=0.0 -! -!WR_AHMS/SULF=0.0 -! -!WR_AHMS/CO=0.0 -! -!WR_AHMS/OH=0.0 -! -!WR_AHMS/HO2=0.0 -! -!WR_AHMS/CH4=0.0 -! -!WR_AHMS/ETH=0.0 -! -!WR_AHMS/ALKA=0.0 -! -!WR_AHMS/ALKE=0.0 -! -!WR_AHMS/BIO=0.0 -! -!WR_AHMS/ARO=0.0 -! -!WR_AHMS/HCHO=0.0 -! -!WR_AHMS/ALD=0.0 -! -!WR_AHMS/KET=0.0 -! -!WR_AHMS/CARBO=0.0 -! -!WR_AHMS/ONIT=0.0 -! -!WR_AHMS/PAN=0.0 -! -!WR_AHMS/OP1=0.0 -! -!WR_AHMS/OP2=0.0 -! -!WR_AHMS/ORA1=0.0 -! -!WR_AHMS/ORA2=0.0 -! -!WR_AHMS/MO2=0.0 -! -!WR_AHMS/ALKAP=0.0 -! -!WR_AHMS/ALKEP=0.0 -! -!WR_AHMS/BIOP=0.0 -! -!WR_AHMS/PHO=0.0 -! -!WR_AHMS/ADD=0.0 -! -!WR_AHMS/AROP=0.0 -! -!WR_AHMS/CARBOP=0.0 -! -!WR_AHMS/OLN=0.0 -! -!WR_AHMS/XO2=0.0 -! -!WR_AHMS/WC_O3=0.0 -! -!WR_AHMS/WC_H2O2=0.0 -! -!WR_AHMS/WC_NO=0.0 -! -!WR_AHMS/WC_NO2=0.0 -! -!WR_AHMS/WC_NO3=0.0 -! -!WR_AHMS/WC_N2O5=0.0 -! -!WR_AHMS/WC_HONO=0.0 -! -!WR_AHMS/WC_HNO3=0.0 -! -!WR_AHMS/WC_HNO4=0.0 -! -!WR_AHMS/WC_NH3=0.0 -! -!WR_AHMS/WC_OH=0.0 -! -!WR_AHMS/WC_HO2=0.0 -! -!WR_AHMS/WC_CO2=0.0 -! -!WR_AHMS/WC_SO2=0.0 -! -!WR_AHMS/WC_SULF=0.0 -! -!WR_AHMS/WC_HCHO=0.0 -! -!WR_AHMS/WC_ORA1=0.0 -! -!WR_AHMS/WC_ORA2=0.0 -! -!WR_AHMS/WC_MO2=0.0 -! -!WR_AHMS/WC_OP1=0.0 -! -!WR_AHMS/WC_ASO3=0.0 -! -!WR_AHMS/WC_ASO4=0.0 -! -!WR_AHMS/WC_ASO5=0.0 -! -!WR_AHMS/WC_AHSO5=0.0 -! -!WR_AHMS/WC_AHMS=0.0 -! -!WR_AHMS/WR_O3=0.0 -! -!WR_AHMS/WR_H2O2=0.0 -! -!WR_AHMS/WR_NO=0.0 -! -!WR_AHMS/WR_NO2=0.0 -! -!WR_AHMS/WR_NO3=0.0 -! -!WR_AHMS/WR_N2O5=0.0 -! -!WR_AHMS/WR_HONO=0.0 -! -!WR_AHMS/WR_HNO3=0.0 -! -!WR_AHMS/WR_HNO4=0.0 -! -!WR_AHMS/WR_NH3=0.0 -! -!WR_AHMS/WR_OH=-KR23*<WR_AHMS> - PJAC(:,92,78)=-TPK%KR23(:)*PCONC(:,92) -! -!WR_AHMS/WR_HO2=0.0 -! -!WR_AHMS/WR_CO2=0.0 -! -!WR_AHMS/WR_SO2=+KR21*<WR_HCHO> - PJAC(:,92,81)=+TPK%KR21(:)*PCONC(:,83) -! -!WR_AHMS/WR_SULF=0.0 -! -!WR_AHMS/WR_HCHO=+KR21*<WR_SO2> - PJAC(:,92,83)=+TPK%KR21(:)*PCONC(:,81) -! -!WR_AHMS/WR_ORA1=0.0 -! -!WR_AHMS/WR_ORA2=0.0 -! -!WR_AHMS/WR_MO2=0.0 -! -!WR_AHMS/WR_OP1=0.0 -! -!WR_AHMS/WR_ASO3=0.0 -! -!WR_AHMS/WR_ASO4=0.0 -! -!WR_AHMS/WR_ASO5=0.0 -! -!WR_AHMS/WR_AHSO5=0.0 -! -!WR_AHMS/WR_AHMS=-KR22-KR23*<WR_OH> - PJAC(:,92,92)=-TPK%KR22(:)-TPK%KR23(:)*PCONC(:,78) -! -RETURN -END SUBROUTINE SUBJ18 -! -END SUBROUTINE CH_JAC_AQ -! -! -!======================================================================== -! -!! ################## - MODULE MODI_CH_JAC_GAZ -!! ################## -INTERFACE -SUBROUTINE CH_JAC_GAZ(PTIME,PCONC,PJAC,KMI,KVECNPT,KEQ) -IMPLICIT NONE -REAL, INTENT(IN) :: PTIME -INTEGER, INTENT(IN) :: KVECNPT -INTEGER, INTENT(IN) :: KEQ -REAL, INTENT(IN), DIMENSION(KVECNPT,KEQ) :: PCONC -REAL, INTENT(OUT), DIMENSION(KVECNPT,KEQ,KEQ) :: PJAC -INTEGER, INTENT(IN) :: KMI -END SUBROUTINE CH_JAC_GAZ -END INTERFACE -END MODULE MODI_CH_JAC_GAZ -! -!======================================================================== -! -!! #################### - SUBROUTINE CH_JAC_GAZ(PTIME,PCONC,PJAC,KMI,KVECNPT,KEQ) -!! #################### -!! This code has been created automatically by preprocessor m10, -!! version: 9.7, copyright 1995-1999 by Meteo France/Universite Paul Sabatier. -!! Please report all bugs to K. Suhre (Lab. d'Aerologie UPS/CNRS). -!!*** *CH_JAC* -!! -!! PURPOSE -!! ------- -! calculation of the JACOBIAN matrix -!! -!!** METHOD -!! ------ -!! The Jacobian matrix J is calculated as defined by the chemical -!! reaction mechanism. -!! The reaction rates and other user-defined auxiliary variables are -!! transfered in the TYPE(CCSTYPE) variable TPK%. -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Karsten Suhre (LA) -!! -!! MODIFICATIONS -!! ------------- -!! Original 26/07/96 -!! Modified 05/05/98: Vectorization (Vincent Crassier & KS) -!! Modified 31/10/03: New interface for better MesoNH compilation (D. Gazen) -!! -!!---------------------------------------------------------------------- -!! -!! EXTERNAL -!! -------- -!! none -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -USE MODD_CH_M9_SCHEME -!! -!! EXPLICIT ARGUMENTS -!! ------------------ -IMPLICIT NONE -REAL, INTENT(IN) :: PTIME -INTEGER, INTENT(IN) :: KVECNPT -INTEGER, INTENT(IN) :: KEQ -REAL, INTENT(IN), DIMENSION(KVECNPT,KEQ) :: PCONC -REAL, INTENT(OUT), DIMENSION(KVECNPT,KEQ,KEQ) :: PJAC -INTEGER, INTENT(IN) :: KMI -! -TYPE(CCSTYPE), POINTER :: TPK -TPK=>TACCS(KMI) -! -! /BEGIN_CODE/ -TPK%O1D(:)=(TPK%K002(:)*PCONC(:,JP_O3))/(TPK%K020(:)*TPK%N2(:)+TPK%K021(:)*TPK%O2(:)+& - &TPK%K022(:)*TPK%H2O(:)) -TPK%O3P(:)=(TPK%K001(:)*PCONC(:,JP_NO2)+TPK%K003(:)*PCONC(:,JP_O3)+TPK%K008(:)*PCONC(:,JP_NO3)+& - &TPK%K020(:)*TPK%O1D(:)*TPK%N2(:)+TPK%K021(:)*TPK%O1D(:)*TPK%O2(:)+& - &0.00000*TPK%K079(:)*PCONC(:,JP_ALKE)*PCONC(:,JP_O3)+& - &0.09000*TPK%K080(:)*PCONC(:,JP_BIO)*PCONC(:,JP_O3))/& - &(TPK%K018(:)*TPK%O2(:)+TPK%K019(:)*PCONC(:,JP_O3)+TPK%K029(:)*PCONC(:,JP_NO)+& - &TPK%K030(:)*PCONC(:,JP_NO2)+TPK%K031(:)*PCONC(:,JP_NO2)+TPK%K054(:)*PCONC(:,JP_BIO)+& - &TPK%K055(:)*PCONC(:,JP_CARBO)+TPK%K134(:)*PCONC(:,JP_DMS)) -! /END_CODE/ -PJAC(:,:,:) = 0.0 -CALL SUBJ0 -CALL SUBJ1 -CALL SUBJ2 -CALL SUBJ3 -CALL SUBJ4 -CALL SUBJ5 -CALL SUBJ6 -CALL SUBJ7 -CALL SUBJ8 -! - -CONTAINS - -SUBROUTINE SUBJ0 -! -!Indices 1 a 5 -! -! -!O3/O3=-K002-K003-K019*<O3P>-K023*<OH>-K024*<HO2>-K042*<NO>-K043*<NO2>-K079*<AL -!KE>-K080*<BIO>-K081*<CARBO>-K082*<PAN>-K087*<ADD> - PJAC(:,1,1)=-TPK%K002(:)-TPK%K003(:)-TPK%K019(:)*TPK%O3P(:)-TPK%K023(:)*PCONC(& -&:,15)-TPK%K024(:)*PCONC(:,16)-TPK%K042(:)*PCONC(:,3)-TPK%K043(:)*PCONC(:,4)-TP& -&K%K079(:)*PCONC(:,20)-TPK%K080(:)*PCONC(:,21)-TPK%K081(:)*PCONC(:,26)-TPK%K082& -&(:)*PCONC(:,28)-TPK%K087(:)*PCONC(:,38) -! -!O3/H2O2=0.0 -! -!O3/NO=-K042*<O3> - PJAC(:,1,3)=-TPK%K042(:)*PCONC(:,1) -! -!O3/NO2=-K043*<O3> - PJAC(:,1,4)=-TPK%K043(:)*PCONC(:,1) -! -!O3/NO3=0.0 -! -!O3/N2O5=0.0 -! -!O3/HONO=0.0 -! -!O3/HNO3=0.0 -! -!O3/HNO4=0.0 -! -!O3/NH3=0.0 -! -!O3/DMS=0.0 -! -!O3/SO2=0.0 -! -!O3/SULF=0.0 -! -!O3/CO=0.0 -! -!O3/OH=-K023*<O3> - PJAC(:,1,15)=-TPK%K023(:)*PCONC(:,1) -! -!O3/HO2=-K024*<O3>+0.17307*K0102*<CARBOP> - PJAC(:,1,16)=-TPK%K024(:)*PCONC(:,1)+0.17307*TPK%K0102(:)*PCONC(:,40) -! -!O3/CH4=0.0 -! -!O3/ETH=0.0 -! -!O3/ALKA=0.0 -! -!O3/ALKE=-K079*<O3> - PJAC(:,1,20)=-TPK%K079(:)*PCONC(:,1) -! -!O3/BIO=-K080*<O3> - PJAC(:,1,21)=-TPK%K080(:)*PCONC(:,1) -! -!O3/ARO=0.0 -! -!O3/HCHO=0.0 -! -!O3/ALD=0.0 -! -!O3/KET=0.0 -! -!O3/CARBO=-K081*<O3> - PJAC(:,1,26)=-TPK%K081(:)*PCONC(:,1) -! -!O3/ONIT=0.0 -! -!O3/PAN=-K082*<O3> - PJAC(:,1,28)=-TPK%K082(:)*PCONC(:,1) -! -!O3/OP1=0.0 -! -!O3/OP2=0.0 -! -!O3/ORA1=0.0 -! -!O3/ORA2=0.0 -! -!O3/MO2=0.0 -! -!O3/ALKAP=0.0 -! -!O3/ALKEP=0.0 -! -!O3/BIOP=0.0 -! -!O3/PHO=0.0 -! -!O3/ADD=-K087*<O3> - PJAC(:,1,38)=-TPK%K087(:)*PCONC(:,1) -! -!O3/AROP=0.0 -! -!O3/CARBOP=+0.17307*K0102*<HO2> - PJAC(:,1,40)=+0.17307*TPK%K0102(:)*PCONC(:,16) -! -!O3/OLN=0.0 -! -!O3/XO2=0.0 -! -!H2O2/O3=+0.01833*K079*<ALKE>+0.00100*K080*<BIO> - PJAC(:,2,1)=+0.01833*TPK%K079(:)*PCONC(:,20)+0.00100*TPK%K080(:)*PCONC(:,21) -! -!H2O2/H2O2=-K009-K026*<OH> - PJAC(:,2,2)=-TPK%K009(:)-TPK%K026(:)*PCONC(:,15) -! -!H2O2/NO=0.0 -! -!H2O2/NO2=0.0 -! -!H2O2/NO3=0.0 -! -!H2O2/N2O5=0.0 -! -!H2O2/HONO=0.0 -! -!H2O2/HNO3=0.0 -! -!H2O2/HNO4=0.0 -! -!H2O2/NH3=0.0 -! -!H2O2/DMS=0.0 -! -!H2O2/SO2=0.0 -! -!H2O2/SULF=0.0 -! -!H2O2/CO=0.0 -! -!H2O2/OH=-K026*<H2O2> - PJAC(:,2,15)=-TPK%K026(:)*PCONC(:,2) -! -!H2O2/HO2=+K027*<HO2>+K027*<HO2>+K028*<HO2>*<H2O>+K028*<HO2>*<H2O> - PJAC(:,2,16)=+TPK%K027(:)*PCONC(:,16)+TPK%K027(:)*PCONC(:,16)+TPK%K028(:)*PCON& -&C(:,16)*TPK%H2O(:)+TPK%K028(:)*PCONC(:,16)*TPK%H2O(:) -! -!H2O2/CH4=0.0 -! -!H2O2/ETH=0.0 -! -!H2O2/ALKA=0.0 -! -!H2O2/ALKE=+0.01833*K079*<O3> - PJAC(:,2,20)=+0.01833*TPK%K079(:)*PCONC(:,1) -! -!H2O2/BIO=+0.00100*K080*<O3> - PJAC(:,2,21)=+0.00100*TPK%K080(:)*PCONC(:,1) -! -!H2O2/ARO=0.0 -! -!H2O2/HCHO=0.0 -! -!H2O2/ALD=0.0 -! -!H2O2/KET=0.0 -! -!H2O2/CARBO=0.0 -! -!H2O2/ONIT=0.0 -! -!H2O2/PAN=0.0 -! -!H2O2/OP1=0.0 -! -!H2O2/OP2=0.0 -! -!H2O2/ORA1=0.0 -! -!H2O2/ORA2=0.0 -! -!H2O2/MO2=0.0 -! -!H2O2/ALKAP=0.0 -! -!H2O2/ALKEP=0.0 -! -!H2O2/BIOP=0.0 -! -!H2O2/PHO=0.0 -! -!H2O2/ADD=0.0 -! -!H2O2/AROP=0.0 -! -!H2O2/CARBOP=0.0 -! -!H2O2/OLN=0.0 -! -!H2O2/XO2=0.0 -! -!NO/O3=-K042*<NO> - PJAC(:,3,1)=-TPK%K042(:)*PCONC(:,3) -! -!NO/H2O2=0.0 -! -!NO/NO=-K029*<O3P>-K032*<OH>-K035*<HO2>-K042*<O3>-K044*<NO>*<O2>-K044*<NO>*<O2> -!-K044*<NO>*<O2>-K044*<NO>*<O2>-K045*<NO3>-K090*<MO2>-K091*<ALKAP>-K092*<ALKEP> -!-K093*<BIOP>-K094*<AROP>-K095*<CARBOP>-K096*<OLN>-K130*<XO2> - PJAC(:,3,3)=-TPK%K029(:)*TPK%O3P(:)-TPK%K032(:)*PCONC(:,15)-TPK%K035(:)*PCONC(& -&:,16)-TPK%K042(:)*PCONC(:,1)-TPK%K044(:)*PCONC(:,3)*TPK%O2(:)-TPK%K044(:)*PCON& -&C(:,3)*TPK%O2(:)-TPK%K044(:)*PCONC(:,3)*TPK%O2(:)-TPK%K044(:)*PCONC(:,3)*TPK%O& -&2(:)-TPK%K045(:)*PCONC(:,5)-TPK%K090(:)*PCONC(:,33)-TPK%K091(:)*PCONC(:,34)-TP& -&K%K092(:)*PCONC(:,35)-TPK%K093(:)*PCONC(:,36)-TPK%K094(:)*PCONC(:,39)-TPK%K095& -&(:)*PCONC(:,40)-TPK%K096(:)*PCONC(:,41)-TPK%K130(:)*PCONC(:,42) -! -!NO/NO2=+K001+K030*<O3P>+K046*<NO3> - PJAC(:,3,4)=+TPK%K001(:)+TPK%K030(:)*TPK%O3P(:)+TPK%K046(:)*PCONC(:,5) -! -!NO/NO3=+K007-K045*<NO>+K046*<NO2> - PJAC(:,3,5)=+TPK%K007(:)-TPK%K045(:)*PCONC(:,3)+TPK%K046(:)*PCONC(:,4) -! -!NO/N2O5=0.0 -! -!NO/HONO=+K004 - PJAC(:,3,7)=+TPK%K004(:) -! -!NO/HNO3=0.0 -! -!NO/HNO4=0.0 -! -!NO/NH3=0.0 -! -!NO/DMS=0.0 -! -!NO/SO2=0.0 -! -!NO/SULF=0.0 -! -!NO/CO=0.0 -! -!NO/OH=-K032*<NO> - PJAC(:,3,15)=-TPK%K032(:)*PCONC(:,3) -! -!NO/HO2=-K035*<NO> - PJAC(:,3,16)=-TPK%K035(:)*PCONC(:,3) -! -!NO/CH4=0.0 -! -!NO/ETH=0.0 -! -!NO/ALKA=0.0 -! -!NO/ALKE=0.0 -! -!NO/BIO=0.0 -! -!NO/ARO=0.0 -! -!NO/HCHO=0.0 -! -!NO/ALD=0.0 -! -!NO/KET=0.0 -! -!NO/CARBO=0.0 -! -!NO/ONIT=0.0 -! -!NO/PAN=0.0 -! -!NO/OP1=0.0 -! -!NO/OP2=0.0 -! -!NO/ORA1=0.0 -! -!NO/ORA2=0.0 -! -!NO/MO2=-K090*<NO> - PJAC(:,3,33)=-TPK%K090(:)*PCONC(:,3) -! -!NO/ALKAP=-K091*<NO> - PJAC(:,3,34)=-TPK%K091(:)*PCONC(:,3) -! -!NO/ALKEP=-K092*<NO> - PJAC(:,3,35)=-TPK%K092(:)*PCONC(:,3) -! -!NO/BIOP=-K093*<NO> - PJAC(:,3,36)=-TPK%K093(:)*PCONC(:,3) -! -!NO/PHO=0.0 -! -!NO/ADD=0.0 -! -!NO/AROP=-K094*<NO> - PJAC(:,3,39)=-TPK%K094(:)*PCONC(:,3) -! -!NO/CARBOP=-K095*<NO> - PJAC(:,3,40)=-TPK%K095(:)*PCONC(:,3) -! -!NO/OLN=-K096*<NO> - PJAC(:,3,41)=-TPK%K096(:)*PCONC(:,3) -! -!NO/XO2=-K130*<NO> - PJAC(:,3,42)=-TPK%K130(:)*PCONC(:,3) -! -!NO2/O3=+K042*<NO>-K043*<NO2>+0.70*K082*<PAN> - PJAC(:,4,1)=+TPK%K042(:)*PCONC(:,3)-TPK%K043(:)*PCONC(:,4)+0.70*TPK%K082(:)*PC& -&ONC(:,28) -! -!NO2/H2O2=0.0 -! -!NO2/NO=+K029*<O3P>+K035*<HO2>+K042*<O3>+K044*<NO>*<O2>+K044*<NO>*<O2>+K044*<NO -!>*<O2>+K044*<NO>*<O2>+K045*<NO3>+K045*<NO3>+K090*<MO2>+0.91541*K091*<ALKAP>+K0 -!92*<ALKEP>+0.84700*K093*<BIOP>+0.95115*K094*<AROP>+K095*<CARBOP>+1.81599*K096* -!<OLN>+K130*<XO2> - PJAC(:,4,3)=+TPK%K029(:)*TPK%O3P(:)+TPK%K035(:)*PCONC(:,16)+TPK%K042(:)*PCONC(& -&:,1)+TPK%K044(:)*PCONC(:,3)*TPK%O2(:)+TPK%K044(:)*PCONC(:,3)*TPK%O2(:)+TPK%K04& -&4(:)*PCONC(:,3)*TPK%O2(:)+TPK%K044(:)*PCONC(:,3)*TPK%O2(:)+TPK%K045(:)*PCONC(:& -&,5)+TPK%K045(:)*PCONC(:,5)+TPK%K090(:)*PCONC(:,33)+0.91541*TPK%K091(:)*PCONC(:& -&,34)+TPK%K092(:)*PCONC(:,35)+0.84700*TPK%K093(:)*PCONC(:,36)+0.95115*TPK%K094(& -&:)*PCONC(:,39)+TPK%K095(:)*PCONC(:,40)+1.81599*TPK%K096(:)*PCONC(:,41)+TPK%K13& -&0(:)*PCONC(:,42) -! -!NO2/NO2=-K001-K030*<O3P>-K031*<O3P>-K033*<OH>-K036*<HO2>-K043*<O3>+K046*<NO3>- -!K046*<NO3>-K047*<NO3>-K083*<PHO>-K085*<ADD>-K088*<CARBOP> - PJAC(:,4,4)=-TPK%K001(:)-TPK%K030(:)*TPK%O3P(:)-TPK%K031(:)*TPK%O3P(:)-TPK%K03& -&3(:)*PCONC(:,15)-TPK%K036(:)*PCONC(:,16)-TPK%K043(:)*PCONC(:,1)+TPK%K046(:)*PC& -&ONC(:,5)-TPK%K046(:)*PCONC(:,5)-TPK%K047(:)*PCONC(:,5)-TPK%K083(:)*PCONC(:,37)& -&-TPK%K085(:)*PCONC(:,38)-TPK%K088(:)*PCONC(:,40) -! -!NO2/NO3=+K008+K034*<OH>+0.7*K038*<HO2>+K045*<NO>+K045*<NO>+K046*<NO2>-K046*<NO -!2>-K047*<NO2>+K049*<NO3>+K049*<NO3>+K049*<NO3>+K049*<NO3>+0.10530*K074*<CARBO> -!+0.40*K078*<PAN>+K119*<MO2>+K120*<ALKAP>+K121*<ALKEP>+K122*<BIOP>+K123*<AROP>+ -!K124*<CARBOP>+1.74072*K125*<OLN>+K131*<XO2>+K133*<DMS> - PJAC(:,4,5)=+TPK%K008(:)+TPK%K034(:)*PCONC(:,15)+0.7*TPK%K038(:)*PCONC(:,16)+T& -&PK%K045(:)*PCONC(:,3)+TPK%K045(:)*PCONC(:,3)+TPK%K046(:)*PCONC(:,4)-TPK%K046(:& -&)*PCONC(:,4)-TPK%K047(:)*PCONC(:,4)+TPK%K049(:)*PCONC(:,5)+TPK%K049(:)*PCONC(:& -&,5)+TPK%K049(:)*PCONC(:,5)+TPK%K049(:)*PCONC(:,5)+0.10530*TPK%K074(:)*PCONC(:,& -&26)+0.40*TPK%K078(:)*PCONC(:,28)+TPK%K119(:)*PCONC(:,33)+TPK%K120(:)*PCONC(:,3& -&4)+TPK%K121(:)*PCONC(:,35)+TPK%K122(:)*PCONC(:,36)+TPK%K123(:)*PCONC(:,39)+TPK& -&%K124(:)*PCONC(:,40)+1.74072*TPK%K125(:)*PCONC(:,41)+TPK%K131(:)*PCONC(:,42)+T& -&PK%K133(:)*PCONC(:,11) -! -!NO2/N2O5=+K048 - PJAC(:,4,6)=+TPK%K048(:) -! -!NO2/HONO=+K039*<OH> - PJAC(:,4,7)=+TPK%K039(:)*PCONC(:,15) -! -!NO2/HNO3=+K005 - PJAC(:,4,8)=+TPK%K005(:) -! -!NO2/HNO4=+0.65*K006+K037+K041*<OH> - PJAC(:,4,9)=+0.65*TPK%K006(:)+TPK%K037(:)+TPK%K041(:)*PCONC(:,15) -! -!NO2/NH3=0.0 -! -!NO2/DMS=+K133*<NO3> - PJAC(:,4,11)=+TPK%K133(:)*PCONC(:,5) -! -!NO2/SO2=0.0 -! -!NO2/SULF=0.0 -! -!NO2/CO=0.0 -! -!NO2/OH=-K033*<NO2>+K034*<NO3>+K039*<HONO>+K041*<HNO4>+K071*<ONIT> - PJAC(:,4,15)=-TPK%K033(:)*PCONC(:,4)+TPK%K034(:)*PCONC(:,5)+TPK%K039(:)*PCONC(& -&:,7)+TPK%K041(:)*PCONC(:,9)+TPK%K071(:)*PCONC(:,27) -! -!NO2/HO2=+K035*<NO>-K036*<NO2>+0.7*K038*<NO3> - PJAC(:,4,16)=+TPK%K035(:)*PCONC(:,3)-TPK%K036(:)*PCONC(:,4)+0.7*TPK%K038(:)*PC& -&ONC(:,5) -! -!NO2/CH4=0.0 -! -!NO2/ETH=0.0 -! -!NO2/ALKA=0.0 -! -!NO2/ALKE=0.0 -! -!NO2/BIO=0.0 -! -!NO2/ARO=0.0 -! -!NO2/HCHO=0.0 -! -!NO2/ALD=0.0 -! -!NO2/KET=0.0 -! -!NO2/CARBO=+0.10530*K074*<NO3> - PJAC(:,4,26)=+0.10530*TPK%K074(:)*PCONC(:,5) -! -!NO2/ONIT=+K017+K071*<OH> - PJAC(:,4,27)=+TPK%K017(:)+TPK%K071(:)*PCONC(:,15) -! -!NO2/PAN=+0.40*K078*<NO3>+0.70*K082*<O3>+K089 - PJAC(:,4,28)=+0.40*TPK%K078(:)*PCONC(:,5)+0.70*TPK%K082(:)*PCONC(:,1)+TPK%K089& -&(:) -! -!NO2/OP1=0.0 -! -!NO2/OP2=0.0 -! -!NO2/ORA1=0.0 -! -!NO2/ORA2=0.0 -! -!NO2/MO2=+K090*<NO>+0.32440*K110*<OLN>+K119*<NO3> - PJAC(:,4,33)=+TPK%K090(:)*PCONC(:,3)+0.32440*TPK%K110(:)*PCONC(:,41)+TPK%K119(& -&:)*PCONC(:,5) -! -!NO2/ALKAP=+0.91541*K091*<NO>+K120*<NO3> - PJAC(:,4,34)=+0.91541*TPK%K091(:)*PCONC(:,3)+TPK%K120(:)*PCONC(:,5) -! -!NO2/ALKEP=+K092*<NO>+K121*<NO3> - PJAC(:,4,35)=+TPK%K092(:)*PCONC(:,3)+TPK%K121(:)*PCONC(:,5) -! -!NO2/BIOP=+0.84700*K093*<NO>+K122*<NO3> - PJAC(:,4,36)=+0.84700*TPK%K093(:)*PCONC(:,3)+TPK%K122(:)*PCONC(:,5) -! -!NO2/PHO=-K083*<NO2> - PJAC(:,4,37)=-TPK%K083(:)*PCONC(:,4) -! -!NO2/ADD=-K085*<NO2> - PJAC(:,4,38)=-TPK%K085(:)*PCONC(:,4) -! -!NO2/AROP=+0.95115*K094*<NO>+K123*<NO3> - PJAC(:,4,39)=+0.95115*TPK%K094(:)*PCONC(:,3)+TPK%K123(:)*PCONC(:,5) -! -!NO2/CARBOP=-K088*<NO2>+K095*<NO>+0.00000*K116*<OLN>+K124*<NO3> - PJAC(:,4,40)=-TPK%K088(:)*PCONC(:,4)+TPK%K095(:)*PCONC(:,3)+0.00000*TPK%K116(:& -&)*PCONC(:,41)+TPK%K124(:)*PCONC(:,5) -! -!NO2/OLN=+1.81599*K096*<NO>+0.32440*K110*<MO2>+0.00000*K116*<CARBOP>+0.00000*K1 -!18*<OLN>+0.00000*K118*<OLN>+1.74072*K125*<NO3> - PJAC(:,4,41)=+1.81599*TPK%K096(:)*PCONC(:,3)+0.32440*TPK%K110(:)*PCONC(:,33)+0& -&.00000*TPK%K116(:)*PCONC(:,40)+0.00000*TPK%K118(:)*PCONC(:,41)+0.00000*TPK%K11& -&8(:)*PCONC(:,41)+1.74072*TPK%K125(:)*PCONC(:,5) -! -!NO2/XO2=+K130*<NO>+K131*<NO3> - PJAC(:,4,42)=+TPK%K130(:)*PCONC(:,3)+TPK%K131(:)*PCONC(:,5) -! -!NO3/O3=+K043*<NO2> - PJAC(:,5,1)=+TPK%K043(:)*PCONC(:,4) -! -!NO3/H2O2=0.0 -! -!NO3/NO=-K045*<NO3> - PJAC(:,5,3)=-TPK%K045(:)*PCONC(:,5) -! -!NO3/NO2=+K031*<O3P>+K043*<O3>-K046*<NO3>-K047*<NO3> - PJAC(:,5,4)=+TPK%K031(:)*TPK%O3P(:)+TPK%K043(:)*PCONC(:,1)-TPK%K046(:)*PCONC(:& -&,5)-TPK%K047(:)*PCONC(:,5) -! -!NO3/NO3=-K007-K008-K034*<OH>-K038*<HO2>-K045*<NO>-K046*<NO2>-K047*<NO2>-K049*< -!NO3>-K049*<NO3>-K049*<NO3>-K049*<NO3>-K072*<HCHO>-K073*<ALD>-K074*<CARBO>-K075 -!*<ARO>-K076*<ALKE>-K077*<BIO>+0.60*K078*<PAN>-K078*<PAN>-K119*<MO2>-K120*<ALKA -!P>-K121*<ALKEP>-K122*<BIOP>-K123*<AROP>-K124*<CARBOP>-K125*<OLN>-K131*<XO2>-K1 -!33*<DMS> - PJAC(:,5,5)=-TPK%K007(:)-TPK%K008(:)-TPK%K034(:)*PCONC(:,15)-TPK%K038(:)*PCONC& -&(:,16)-TPK%K045(:)*PCONC(:,3)-TPK%K046(:)*PCONC(:,4)-TPK%K047(:)*PCONC(:,4)-TP& -&K%K049(:)*PCONC(:,5)-TPK%K049(:)*PCONC(:,5)-TPK%K049(:)*PCONC(:,5)-TPK%K049(:)& -&*PCONC(:,5)-TPK%K072(:)*PCONC(:,23)-TPK%K073(:)*PCONC(:,24)-TPK%K074(:)*PCONC(& -&:,26)-TPK%K075(:)*PCONC(:,22)-TPK%K076(:)*PCONC(:,20)-TPK%K077(:)*PCONC(:,21)+& -&0.60*TPK%K078(:)*PCONC(:,28)-TPK%K078(:)*PCONC(:,28)-TPK%K119(:)*PCONC(:,33)-T& -&PK%K120(:)*PCONC(:,34)-TPK%K121(:)*PCONC(:,35)-TPK%K122(:)*PCONC(:,36)-TPK%K12& -&3(:)*PCONC(:,39)-TPK%K124(:)*PCONC(:,40)-TPK%K125(:)*PCONC(:,41)-TPK%K131(:)*P& -&CONC(:,42)-TPK%K133(:)*PCONC(:,11) -! -!NO3/N2O5=+K048 - PJAC(:,5,6)=+TPK%K048(:) -! -!NO3/HONO=0.0 -! -!NO3/HNO3=+K040*<OH> - PJAC(:,5,8)=+TPK%K040(:)*PCONC(:,15) -! -!NO3/HNO4=+0.35*K006 - PJAC(:,5,9)=+0.35*TPK%K006(:) -! -!NO3/NH3=0.0 -! -!NO3/DMS=-K133*<NO3> - PJAC(:,5,11)=-TPK%K133(:)*PCONC(:,5) -! -!NO3/SO2=0.0 -! -!NO3/SULF=0.0 -! -!NO3/CO=0.0 -! -!NO3/OH=-K034*<NO3>+K040*<HNO3>+0.71893*K070*<PAN> - PJAC(:,5,15)=-TPK%K034(:)*PCONC(:,5)+TPK%K040(:)*PCONC(:,8)+0.71893*TPK%K070(:& -&)*PCONC(:,28) -! -!NO3/HO2=-K038*<NO3> - PJAC(:,5,16)=-TPK%K038(:)*PCONC(:,5) -! -!NO3/CH4=0.0 -! -!NO3/ETH=0.0 -! -!NO3/ALKA=0.0 -! -!NO3/ALKE=-K076*<NO3> - PJAC(:,5,20)=-TPK%K076(:)*PCONC(:,5) -! -!NO3/BIO=-K077*<NO3> - PJAC(:,5,21)=-TPK%K077(:)*PCONC(:,5) -! -!NO3/ARO=-K075*<NO3> - PJAC(:,5,22)=-TPK%K075(:)*PCONC(:,5) -! -!NO3/HCHO=-K072*<NO3> - PJAC(:,5,23)=-TPK%K072(:)*PCONC(:,5) -! -!NO3/ALD=-K073*<NO3> - PJAC(:,5,24)=-TPK%K073(:)*PCONC(:,5) -! -!NO3/KET=0.0 -! -!NO3/CARBO=-K074*<NO3> - PJAC(:,5,26)=-TPK%K074(:)*PCONC(:,5) -! -!NO3/ONIT=0.0 -! -!NO3/PAN=+0.71893*K070*<OH>+0.60*K078*<NO3>-K078*<NO3> - PJAC(:,5,28)=+0.71893*TPK%K070(:)*PCONC(:,15)+0.60*TPK%K078(:)*PCONC(:,5)-TPK%& -&K078(:)*PCONC(:,5) -! -!NO3/OP1=0.0 -! -!NO3/OP2=0.0 -! -!NO3/ORA1=0.0 -! -!NO3/ORA2=0.0 -! -!NO3/MO2=-K119*<NO3> - PJAC(:,5,33)=-TPK%K119(:)*PCONC(:,5) -! -!NO3/ALKAP=-K120*<NO3> - PJAC(:,5,34)=-TPK%K120(:)*PCONC(:,5) -! -!NO3/ALKEP=-K121*<NO3> - PJAC(:,5,35)=-TPK%K121(:)*PCONC(:,5) -! -!NO3/BIOP=-K122*<NO3> - PJAC(:,5,36)=-TPK%K122(:)*PCONC(:,5) -! -!NO3/PHO=0.0 -! -!NO3/ADD=0.0 -! -!NO3/AROP=-K123*<NO3> - PJAC(:,5,39)=-TPK%K123(:)*PCONC(:,5) -! -!NO3/CARBOP=-K124*<NO3> - PJAC(:,5,40)=-TPK%K124(:)*PCONC(:,5) -! -!NO3/OLN=-K125*<NO3> - PJAC(:,5,41)=-TPK%K125(:)*PCONC(:,5) -! -!NO3/XO2=-K131*<NO3> - PJAC(:,5,42)=-TPK%K131(:)*PCONC(:,5) -! -RETURN -END SUBROUTINE SUBJ0 -! -SUBROUTINE SUBJ1 -! -!Indices 6 a 10 -! -! -!N2O5/O3=0.0 -! -!N2O5/H2O2=0.0 -! -!N2O5/NO=0.0 -! -!N2O5/NO2=+K047*<NO3> - PJAC(:,6,4)=+TPK%K047(:)*PCONC(:,5) -! -!N2O5/NO3=+K047*<NO2> - PJAC(:,6,5)=+TPK%K047(:)*PCONC(:,4) -! -!N2O5/N2O5=-K048 - PJAC(:,6,6)=-TPK%K048(:) -! -!N2O5/HONO=0.0 -! -!N2O5/HNO3=0.0 -! -!N2O5/HNO4=0.0 -! -!N2O5/NH3=0.0 -! -!N2O5/DMS=0.0 -! -!N2O5/SO2=0.0 -! -!N2O5/SULF=0.0 -! -!N2O5/CO=0.0 -! -!N2O5/OH=0.0 -! -!N2O5/HO2=0.0 -! -!N2O5/CH4=0.0 -! -!N2O5/ETH=0.0 -! -!N2O5/ALKA=0.0 -! -!N2O5/ALKE=0.0 -! -!N2O5/BIO=0.0 -! -!N2O5/ARO=0.0 -! -!N2O5/HCHO=0.0 -! -!N2O5/ALD=0.0 -! -!N2O5/KET=0.0 -! -!N2O5/CARBO=0.0 -! -!N2O5/ONIT=0.0 -! -!N2O5/PAN=0.0 -! -!N2O5/OP1=0.0 -! -!N2O5/OP2=0.0 -! -!N2O5/ORA1=0.0 -! -!N2O5/ORA2=0.0 -! -!N2O5/MO2=0.0 -! -!N2O5/ALKAP=0.0 -! -!N2O5/ALKEP=0.0 -! -!N2O5/BIOP=0.0 -! -!N2O5/PHO=0.0 -! -!N2O5/ADD=0.0 -! -!N2O5/AROP=0.0 -! -!N2O5/CARBOP=0.0 -! -!N2O5/OLN=0.0 -! -!N2O5/XO2=0.0 -! -!HONO/O3=0.0 -! -!HONO/H2O2=0.0 -! -!HONO/NO=+K032*<OH> - PJAC(:,7,3)=+TPK%K032(:)*PCONC(:,15) -! -!HONO/NO2=+K085*<ADD> - PJAC(:,7,4)=+TPK%K085(:)*PCONC(:,38) -! -!HONO/NO3=0.0 -! -!HONO/N2O5=0.0 -! -!HONO/HONO=-K004-K039*<OH> - PJAC(:,7,7)=-TPK%K004(:)-TPK%K039(:)*PCONC(:,15) -! -!HONO/HNO3=0.0 -! -!HONO/HNO4=0.0 -! -!HONO/NH3=0.0 -! -!HONO/DMS=0.0 -! -!HONO/SO2=0.0 -! -!HONO/SULF=0.0 -! -!HONO/CO=0.0 -! -!HONO/OH=+K032*<NO>-K039*<HONO> - PJAC(:,7,15)=+TPK%K032(:)*PCONC(:,3)-TPK%K039(:)*PCONC(:,7) -! -!HONO/HO2=0.0 -! -!HONO/CH4=0.0 -! -!HONO/ETH=0.0 -! -!HONO/ALKA=0.0 -! -!HONO/ALKE=0.0 -! -!HONO/BIO=0.0 -! -!HONO/ARO=0.0 -! -!HONO/HCHO=0.0 -! -!HONO/ALD=0.0 -! -!HONO/KET=0.0 -! -!HONO/CARBO=0.0 -! -!HONO/ONIT=0.0 -! -!HONO/PAN=0.0 -! -!HONO/OP1=0.0 -! -!HONO/OP2=0.0 -! -!HONO/ORA1=0.0 -! -!HONO/ORA2=0.0 -! -!HONO/MO2=0.0 -! -!HONO/ALKAP=0.0 -! -!HONO/ALKEP=0.0 -! -!HONO/BIOP=0.0 -! -!HONO/PHO=0.0 -! -!HONO/ADD=+K085*<NO2> - PJAC(:,7,38)=+TPK%K085(:)*PCONC(:,4) -! -!HONO/AROP=0.0 -! -!HONO/CARBOP=0.0 -! -!HONO/OLN=0.0 -! -!HONO/XO2=0.0 -! -!HNO3/O3=0.0 -! -!HNO3/H2O2=0.0 -! -!HNO3/NO=0.0 -! -!HNO3/NO2=+K033*<OH> - PJAC(:,8,4)=+TPK%K033(:)*PCONC(:,15) -! -!HNO3/NO3=+0.3*K038*<HO2>+K072*<HCHO>+K073*<ALD>+0.91567*K074*<CARBO>+K075*<ARO -!> - PJAC(:,8,5)=+0.3*TPK%K038(:)*PCONC(:,16)+TPK%K072(:)*PCONC(:,23)+TPK%K073(:)*P& -&CONC(:,24)+0.91567*TPK%K074(:)*PCONC(:,26)+TPK%K075(:)*PCONC(:,22) -! -!HNO3/N2O5=0.0 -! -!HNO3/HONO=0.0 -! -!HNO3/HNO3=-K005-K040*<OH> - PJAC(:,8,8)=-TPK%K005(:)-TPK%K040(:)*PCONC(:,15) -! -!HNO3/HNO4=0.0 -! -!HNO3/NH3=0.0 -! -!HNO3/DMS=0.0 -! -!HNO3/SO2=0.0 -! -!HNO3/SULF=0.0 -! -!HNO3/CO=0.0 -! -!HNO3/OH=+K033*<NO2>-K040*<HNO3> - PJAC(:,8,15)=+TPK%K033(:)*PCONC(:,4)-TPK%K040(:)*PCONC(:,8) -! -!HNO3/HO2=+0.3*K038*<NO3> - PJAC(:,8,16)=+0.3*TPK%K038(:)*PCONC(:,5) -! -!HNO3/CH4=0.0 -! -!HNO3/ETH=0.0 -! -!HNO3/ALKA=0.0 -! -!HNO3/ALKE=0.0 -! -!HNO3/BIO=0.0 -! -!HNO3/ARO=+K075*<NO3> - PJAC(:,8,22)=+TPK%K075(:)*PCONC(:,5) -! -!HNO3/HCHO=+K072*<NO3> - PJAC(:,8,23)=+TPK%K072(:)*PCONC(:,5) -! -!HNO3/ALD=+K073*<NO3> - PJAC(:,8,24)=+TPK%K073(:)*PCONC(:,5) -! -!HNO3/KET=0.0 -! -!HNO3/CARBO=+0.91567*K074*<NO3> - PJAC(:,8,26)=+0.91567*TPK%K074(:)*PCONC(:,5) -! -!HNO3/ONIT=0.0 -! -!HNO3/PAN=0.0 -! -!HNO3/OP1=0.0 -! -!HNO3/OP2=0.0 -! -!HNO3/ORA1=0.0 -! -!HNO3/ORA2=0.0 -! -!HNO3/MO2=0.0 -! -!HNO3/ALKAP=0.0 -! -!HNO3/ALKEP=0.0 -! -!HNO3/BIOP=0.0 -! -!HNO3/PHO=0.0 -! -!HNO3/ADD=0.0 -! -!HNO3/AROP=0.0 -! -!HNO3/CARBOP=0.0 -! -!HNO3/OLN=0.0 -! -!HNO3/XO2=0.0 -! -!HNO4/O3=0.0 -! -!HNO4/H2O2=0.0 -! -!HNO4/NO=0.0 -! -!HNO4/NO2=+K036*<HO2> - PJAC(:,9,4)=+TPK%K036(:)*PCONC(:,16) -! -!HNO4/NO3=0.0 -! -!HNO4/N2O5=0.0 -! -!HNO4/HONO=0.0 -! -!HNO4/HNO3=0.0 -! -!HNO4/HNO4=-K006-K037-K041*<OH> - PJAC(:,9,9)=-TPK%K006(:)-TPK%K037(:)-TPK%K041(:)*PCONC(:,15) -! -!HNO4/NH3=0.0 -! -!HNO4/DMS=0.0 -! -!HNO4/SO2=0.0 -! -!HNO4/SULF=0.0 -! -!HNO4/CO=0.0 -! -!HNO4/OH=-K041*<HNO4> - PJAC(:,9,15)=-TPK%K041(:)*PCONC(:,9) -! -!HNO4/HO2=+K036*<NO2> - PJAC(:,9,16)=+TPK%K036(:)*PCONC(:,4) -! -!HNO4/CH4=0.0 -! -!HNO4/ETH=0.0 -! -!HNO4/ALKA=0.0 -! -!HNO4/ALKE=0.0 -! -!HNO4/BIO=0.0 -! -!HNO4/ARO=0.0 -! -!HNO4/HCHO=0.0 -! -!HNO4/ALD=0.0 -! -!HNO4/KET=0.0 -! -!HNO4/CARBO=0.0 -! -!HNO4/ONIT=0.0 -! -!HNO4/PAN=0.0 -! -!HNO4/OP1=0.0 -! -!HNO4/OP2=0.0 -! -!HNO4/ORA1=0.0 -! -!HNO4/ORA2=0.0 -! -!HNO4/MO2=0.0 -! -!HNO4/ALKAP=0.0 -! -!HNO4/ALKEP=0.0 -! -!HNO4/BIOP=0.0 -! -!HNO4/PHO=0.0 -! -!HNO4/ADD=0.0 -! -!HNO4/AROP=0.0 -! -!HNO4/CARBOP=0.0 -! -!HNO4/OLN=0.0 -! -!HNO4/XO2=0.0 -! -!NH3/O3=0.0 -! -!NH3/H2O2=0.0 -! -!NH3/NO=0.0 -! -!NH3/NO2=0.0 -! -!NH3/NO3=0.0 -! -!NH3/N2O5=0.0 -! -!NH3/HONO=0.0 -! -!NH3/HNO3=0.0 -! -!NH3/HNO4=0.0 -! -!NH3/NH3=-K050*<OH> - PJAC(:,10,10)=-TPK%K050(:)*PCONC(:,15) -! -!NH3/DMS=0.0 -! -!NH3/SO2=0.0 -! -!NH3/SULF=0.0 -! -!NH3/CO=0.0 -! -!NH3/OH=-K050*<NH3> - PJAC(:,10,15)=-TPK%K050(:)*PCONC(:,10) -! -!NH3/HO2=0.0 -! -!NH3/CH4=0.0 -! -!NH3/ETH=0.0 -! -!NH3/ALKA=0.0 -! -!NH3/ALKE=0.0 -! -!NH3/BIO=0.0 -! -!NH3/ARO=0.0 -! -!NH3/HCHO=0.0 -! -!NH3/ALD=0.0 -! -!NH3/KET=0.0 -! -!NH3/CARBO=0.0 -! -!NH3/ONIT=0.0 -! -!NH3/PAN=0.0 -! -!NH3/OP1=0.0 -! -!NH3/OP2=0.0 -! -!NH3/ORA1=0.0 -! -!NH3/ORA2=0.0 -! -!NH3/MO2=0.0 -! -!NH3/ALKAP=0.0 -! -!NH3/ALKEP=0.0 -! -!NH3/BIOP=0.0 -! -!NH3/PHO=0.0 -! -!NH3/ADD=0.0 -! -!NH3/AROP=0.0 -! -!NH3/CARBOP=0.0 -! -!NH3/OLN=0.0 -! -!NH3/XO2=0.0 -! -RETURN -END SUBROUTINE SUBJ1 -! -SUBROUTINE SUBJ2 -! -!Indices 11 a 15 -! -! -!DMS/O3=0.0 -! -!DMS/H2O2=0.0 -! -!DMS/NO=0.0 -! -!DMS/NO2=0.0 -! -!DMS/NO3=-K133*<DMS> - PJAC(:,11,5)=-TPK%K133(:)*PCONC(:,11) -! -!DMS/N2O5=0.0 -! -!DMS/HONO=0.0 -! -!DMS/HNO3=0.0 -! -!DMS/HNO4=0.0 -! -!DMS/NH3=0.0 -! -!DMS/DMS=-K133*<NO3>-K134*<O3P>-K135*<OH> - PJAC(:,11,11)=-TPK%K133(:)*PCONC(:,5)-TPK%K134(:)*TPK%O3P(:)-TPK%K135(:)*PCONC& -&(:,15) -! -!DMS/SO2=0.0 -! -!DMS/SULF=0.0 -! -!DMS/CO=0.0 -! -!DMS/OH=-K135*<DMS> - PJAC(:,11,15)=-TPK%K135(:)*PCONC(:,11) -! -!DMS/HO2=0.0 -! -!DMS/CH4=0.0 -! -!DMS/ETH=0.0 -! -!DMS/ALKA=0.0 -! -!DMS/ALKE=0.0 -! -!DMS/BIO=0.0 -! -!DMS/ARO=0.0 -! -!DMS/HCHO=0.0 -! -!DMS/ALD=0.0 -! -!DMS/KET=0.0 -! -!DMS/CARBO=0.0 -! -!DMS/ONIT=0.0 -! -!DMS/PAN=0.0 -! -!DMS/OP1=0.0 -! -!DMS/OP2=0.0 -! -!DMS/ORA1=0.0 -! -!DMS/ORA2=0.0 -! -!DMS/MO2=0.0 -! -!DMS/ALKAP=0.0 -! -!DMS/ALKEP=0.0 -! -!DMS/BIOP=0.0 -! -!DMS/PHO=0.0 -! -!DMS/ADD=0.0 -! -!DMS/AROP=0.0 -! -!DMS/CARBOP=0.0 -! -!DMS/OLN=0.0 -! -!DMS/XO2=0.0 -! -!SO2/O3=0.0 -! -!SO2/H2O2=0.0 -! -!SO2/NO=0.0 -! -!SO2/NO2=0.0 -! -!SO2/NO3=+K133*<DMS> - PJAC(:,12,5)=+TPK%K133(:)*PCONC(:,11) -! -!SO2/N2O5=0.0 -! -!SO2/HONO=0.0 -! -!SO2/HNO3=0.0 -! -!SO2/HNO4=0.0 -! -!SO2/NH3=0.0 -! -!SO2/DMS=+K133*<NO3>+K134*<O3P>+0.8*K135*<OH> - PJAC(:,12,11)=+TPK%K133(:)*PCONC(:,5)+TPK%K134(:)*TPK%O3P(:)+0.8*TPK%K135(:)*P& -&CONC(:,15) -! -!SO2/SO2=-K052*<OH> - PJAC(:,12,12)=-TPK%K052(:)*PCONC(:,15) -! -!SO2/SULF=0.0 -! -!SO2/CO=0.0 -! -!SO2/OH=-K052*<SO2>+0.8*K135*<DMS> - PJAC(:,12,15)=-TPK%K052(:)*PCONC(:,12)+0.8*TPK%K135(:)*PCONC(:,11) -! -!SO2/HO2=0.0 -! -!SO2/CH4=0.0 -! -!SO2/ETH=0.0 -! -!SO2/ALKA=0.0 -! -!SO2/ALKE=0.0 -! -!SO2/BIO=0.0 -! -!SO2/ARO=0.0 -! -!SO2/HCHO=0.0 -! -!SO2/ALD=0.0 -! -!SO2/KET=0.0 -! -!SO2/CARBO=0.0 -! -!SO2/ONIT=0.0 -! -!SO2/PAN=0.0 -! -!SO2/OP1=0.0 -! -!SO2/OP2=0.0 -! -!SO2/ORA1=0.0 -! -!SO2/ORA2=0.0 -! -!SO2/MO2=0.0 -! -!SO2/ALKAP=0.0 -! -!SO2/ALKEP=0.0 -! -!SO2/BIOP=0.0 -! -!SO2/PHO=0.0 -! -!SO2/ADD=0.0 -! -!SO2/AROP=0.0 -! -!SO2/CARBOP=0.0 -! -!SO2/OLN=0.0 -! -!SO2/XO2=0.0 -! -!SULF/O3=0.0 -! -!SULF/H2O2=0.0 -! -!SULF/NO=0.0 -! -!SULF/NO2=0.0 -! -!SULF/NO3=0.0 -! -!SULF/N2O5=0.0 -! -!SULF/HONO=0.0 -! -!SULF/HNO3=0.0 -! -!SULF/HNO4=0.0 -! -!SULF/NH3=0.0 -! -!SULF/DMS=0.0 -! -!SULF/SO2=+K052*<OH> - PJAC(:,13,12)=+TPK%K052(:)*PCONC(:,15) -! -!SULF/SULF=-K132 - PJAC(:,13,13)=-TPK%K132(:) -! -!SULF/CO=0.0 -! -!SULF/OH=+K052*<SO2> - PJAC(:,13,15)=+TPK%K052(:)*PCONC(:,12) -! -!SULF/HO2=0.0 -! -!SULF/CH4=0.0 -! -!SULF/ETH=0.0 -! -!SULF/ALKA=0.0 -! -!SULF/ALKE=0.0 -! -!SULF/BIO=0.0 -! -!SULF/ARO=0.0 -! -!SULF/HCHO=0.0 -! -!SULF/ALD=0.0 -! -!SULF/KET=0.0 -! -!SULF/CARBO=0.0 -! -!SULF/ONIT=0.0 -! -!SULF/PAN=0.0 -! -!SULF/OP1=0.0 -! -!SULF/OP2=0.0 -! -!SULF/ORA1=0.0 -! -!SULF/ORA2=0.0 -! -!SULF/MO2=0.0 -! -!SULF/ALKAP=0.0 -! -!SULF/ALKEP=0.0 -! -!SULF/BIOP=0.0 -! -!SULF/PHO=0.0 -! -!SULF/ADD=0.0 -! -!SULF/AROP=0.0 -! -!SULF/CARBOP=0.0 -! -!SULF/OLN=0.0 -! -!SULF/XO2=0.0 -! -!CO/O3=+0.35120*K079*<ALKE>+0.36000*K080*<BIO>+0.64728*K081*<CARBO>+0.13*K082*< -!PAN> - PJAC(:,14,1)=+0.35120*TPK%K079(:)*PCONC(:,20)+0.36000*TPK%K080(:)*PCONC(:,21)+& -&0.64728*TPK%K081(:)*PCONC(:,26)+0.13*TPK%K082(:)*PCONC(:,28) -! -!CO/H2O2=0.0 -! -!CO/NO=0.0 -! -!CO/NO2=0.0 -! -!CO/NO3=+K072*<HCHO>+1.33723*K074*<CARBO> - PJAC(:,14,5)=+TPK%K072(:)*PCONC(:,23)+1.33723*TPK%K074(:)*PCONC(:,26) -! -!CO/N2O5=0.0 -! -!CO/HONO=0.0 -! -!CO/HNO3=0.0 -! -!CO/HNO4=0.0 -! -!CO/NH3=0.0 -! -!CO/DMS=0.0 -! -!CO/SO2=0.0 -! -!CO/SULF=0.0 -! -!CO/CO=-K053*<OH> - PJAC(:,14,14)=-TPK%K053(:)*PCONC(:,15) -! -!CO/OH=-K053*<CO>+0.00878*K058*<ALKA>+K062*<HCHO>+1.01732*K065*<CARBO> - PJAC(:,14,15)=-TPK%K053(:)*PCONC(:,14)+0.00878*TPK%K058(:)*PCONC(:,19)+TPK%K06& -&2(:)*PCONC(:,23)+1.01732*TPK%K065(:)*PCONC(:,26) -! -!CO/HO2=0.0 -! -!CO/CH4=0.0 -! -!CO/ETH=0.0 -! -!CO/ALKA=+0.00878*K058*<OH> - PJAC(:,14,19)=+0.00878*TPK%K058(:)*PCONC(:,15) -! -!CO/ALKE=+0.35120*K079*<O3> - PJAC(:,14,20)=+0.35120*TPK%K079(:)*PCONC(:,1) -! -!CO/BIO=+0.01*K054*<O3P>+0.36000*K080*<O3> - PJAC(:,14,21)=+0.01*TPK%K054(:)*TPK%O3P(:)+0.36000*TPK%K080(:)*PCONC(:,1) -! -!CO/ARO=0.0 -! -!CO/HCHO=+K010+K011+K062*<OH>+K072*<NO3> - PJAC(:,14,23)=+TPK%K010(:)+TPK%K011(:)+TPK%K062(:)*PCONC(:,15)+TPK%K072(:)*PCO& -&NC(:,5) -! -!CO/ALD=+K012 - PJAC(:,14,24)=+TPK%K012(:) -! -!CO/KET=0.0 -! -!CO/CARBO=+0.91924*K016+1.01732*K065*<OH>+1.33723*K074*<NO3>+0.64728*K081*<O3> - PJAC(:,14,26)=+0.91924*TPK%K016(:)+1.01732*TPK%K065(:)*PCONC(:,15)+1.33723*TPK& -&%K074(:)*PCONC(:,5)+0.64728*TPK%K081(:)*PCONC(:,1) -! -!CO/ONIT=0.0 -! -!CO/PAN=+0.13*K082*<O3> - PJAC(:,14,28)=+0.13*TPK%K082(:)*PCONC(:,1) -! -!CO/OP1=0.0 -! -!CO/OP2=0.0 -! -!CO/ORA1=0.0 -! -!CO/ORA2=0.0 -! -!CO/MO2=0.0 -! -!CO/ALKAP=0.0 -! -!CO/ALKEP=0.0 -! -!CO/BIOP=0.0 -! -!CO/PHO=0.0 -! -!CO/ADD=0.0 -! -!CO/AROP=0.0 -! -!CO/CARBOP=0.0 -! -!CO/OLN=0.0 -! -!CO/XO2=0.0 -! -!OH/O3=-K023*<OH>+K024*<HO2>+0.39435*K079*<ALKE>+0.28000*K080*<BIO>+0.20595*K08 -!1*<CARBO>+0.036*K082*<PAN>+K087*<ADD> - PJAC(:,15,1)=-TPK%K023(:)*PCONC(:,15)+TPK%K024(:)*PCONC(:,16)+0.39435*TPK%K079& -&(:)*PCONC(:,20)+0.28000*TPK%K080(:)*PCONC(:,21)+0.20595*TPK%K081(:)*PCONC(:,26& -&)+0.036*TPK%K082(:)*PCONC(:,28)+TPK%K087(:)*PCONC(:,38) -! -!OH/H2O2=+K009+K009-K026*<OH> - PJAC(:,15,2)=+TPK%K009(:)+TPK%K009(:)-TPK%K026(:)*PCONC(:,15) -! -!OH/NO=-K032*<OH>+K035*<HO2> - PJAC(:,15,3)=-TPK%K032(:)*PCONC(:,15)+TPK%K035(:)*PCONC(:,16) -! -!OH/NO2=-K033*<OH> - PJAC(:,15,4)=-TPK%K033(:)*PCONC(:,15) -! -!OH/NO3=-K034*<OH>+0.7*K038*<HO2> - PJAC(:,15,5)=-TPK%K034(:)*PCONC(:,15)+0.7*TPK%K038(:)*PCONC(:,16) -! -!OH/N2O5=0.0 -! -!OH/HONO=+K004-K039*<OH> - PJAC(:,15,7)=+TPK%K004(:)-TPK%K039(:)*PCONC(:,15) -! -!OH/HNO3=+K005-K040*<OH> - PJAC(:,15,8)=+TPK%K005(:)-TPK%K040(:)*PCONC(:,15) -! -!OH/HNO4=+0.35*K006-K041*<OH> - PJAC(:,15,9)=+0.35*TPK%K006(:)-TPK%K041(:)*PCONC(:,15) -! -!OH/NH3=-K050*<OH> - PJAC(:,15,10)=-TPK%K050(:)*PCONC(:,15) -! -!OH/DMS=-K135*<OH> - PJAC(:,15,11)=-TPK%K135(:)*PCONC(:,15) -! -!OH/SO2=-K052*<OH> - PJAC(:,15,12)=-TPK%K052(:)*PCONC(:,15) -! -!OH/SULF=0.0 -! -!OH/CO=-K053*<OH> - PJAC(:,15,14)=-TPK%K053(:)*PCONC(:,15) -! -!OH/OH=-K023*<O3>-K025*<HO2>-K026*<H2O2>-K032*<NO>-K033*<NO2>-K034*<NO3>-K039*< -!HONO>-K040*<HNO3>-K041*<HNO4>-K050*<NH3>-K051*<H2>-K052*<SO2>-K053*<CO>-K056*< -!CH4>-K057*<ETH>+0.00878*K058*<ALKA>-K058*<ALKA>-K059*<ALKE>-K060*<BIO>-K061*<A -!RO>-K062*<HCHO>-K063*<ALD>-K064*<KET>-K065*<CARBO>-K066*<ORA1>-K067*<ORA2>+0.3 -!5*K068*<OP1>-K068*<OP1>+0.44925*K069*<OP2>-K069*<OP2>-K070*<PAN>-K071*<ONIT>-K -!135*<DMS> - PJAC(:,15,15)=-TPK%K023(:)*PCONC(:,1)-TPK%K025(:)*PCONC(:,16)-TPK%K026(:)*PCON& -&C(:,2)-TPK%K032(:)*PCONC(:,3)-TPK%K033(:)*PCONC(:,4)-TPK%K034(:)*PCONC(:,5)-TP& -&K%K039(:)*PCONC(:,7)-TPK%K040(:)*PCONC(:,8)-TPK%K041(:)*PCONC(:,9)-TPK%K050(:)& -&*PCONC(:,10)-TPK%K051(:)*TPK%H2(:)-TPK%K052(:)*PCONC(:,12)-TPK%K053(:)*PCONC(:& -&,14)-TPK%K056(:)*PCONC(:,17)-TPK%K057(:)*PCONC(:,18)+0.00878*TPK%K058(:)*PCONC& -&(:,19)-TPK%K058(:)*PCONC(:,19)-TPK%K059(:)*PCONC(:,20)-TPK%K060(:)*PCONC(:,21)& -&-TPK%K061(:)*PCONC(:,22)-TPK%K062(:)*PCONC(:,23)-TPK%K063(:)*PCONC(:,24)-TPK%K& -&064(:)*PCONC(:,25)-TPK%K065(:)*PCONC(:,26)-TPK%K066(:)*PCONC(:,31)-TPK%K067(:)& -&*PCONC(:,32)+0.35*TPK%K068(:)*PCONC(:,29)-TPK%K068(:)*PCONC(:,29)+0.44925*TPK%& -&K069(:)*PCONC(:,30)-TPK%K069(:)*PCONC(:,30)-TPK%K070(:)*PCONC(:,28)-TPK%K071(:& -&)*PCONC(:,27)-TPK%K135(:)*PCONC(:,11) -! -!OH/HO2=+K024*<O3>-K025*<OH>+K035*<NO>+0.7*K038*<NO3> - PJAC(:,15,16)=+TPK%K024(:)*PCONC(:,1)-TPK%K025(:)*PCONC(:,15)+TPK%K035(:)*PCON& -&C(:,3)+0.7*TPK%K038(:)*PCONC(:,5) -! -!OH/CH4=-K056*<OH> - PJAC(:,15,17)=-TPK%K056(:)*PCONC(:,15) -! -!OH/ETH=-K057*<OH> - PJAC(:,15,18)=-TPK%K057(:)*PCONC(:,15) -! -!OH/ALKA=+0.00878*K058*<OH>-K058*<OH> - PJAC(:,15,19)=+0.00878*TPK%K058(:)*PCONC(:,15)-TPK%K058(:)*PCONC(:,15) -! -!OH/ALKE=-K059*<OH>+0.39435*K079*<O3> - PJAC(:,15,20)=-TPK%K059(:)*PCONC(:,15)+0.39435*TPK%K079(:)*PCONC(:,1) -! -!OH/BIO=+0.02*K054*<O3P>-K060*<OH>+0.28000*K080*<O3> - PJAC(:,15,21)=+0.02*TPK%K054(:)*TPK%O3P(:)-TPK%K060(:)*PCONC(:,15)+0.28000*TPK& -&%K080(:)*PCONC(:,1) -! -!OH/ARO=-K061*<OH> - PJAC(:,15,22)=-TPK%K061(:)*PCONC(:,15) -! -!OH/HCHO=-K062*<OH> - PJAC(:,15,23)=-TPK%K062(:)*PCONC(:,15) -! -!OH/ALD=-K063*<OH> - PJAC(:,15,24)=-TPK%K063(:)*PCONC(:,15) -! -!OH/KET=-K064*<OH> - PJAC(:,15,25)=-TPK%K064(:)*PCONC(:,15) -! -!OH/CARBO=-K065*<OH>+0.20595*K081*<O3> - PJAC(:,15,26)=-TPK%K065(:)*PCONC(:,15)+0.20595*TPK%K081(:)*PCONC(:,1) -! -!OH/ONIT=-K071*<OH> - PJAC(:,15,27)=-TPK%K071(:)*PCONC(:,15) -! -!OH/PAN=-K070*<OH>+0.036*K082*<O3> - PJAC(:,15,28)=-TPK%K070(:)*PCONC(:,15)+0.036*TPK%K082(:)*PCONC(:,1) -! -!OH/OP1=+K013+0.35*K068*<OH>-K068*<OH> - PJAC(:,15,29)=+TPK%K013(:)+0.35*TPK%K068(:)*PCONC(:,15)-TPK%K068(:)*PCONC(:,15& -&) -! -!OH/OP2=+K014+0.44925*K069*<OH>-K069*<OH> - PJAC(:,15,30)=+TPK%K014(:)+0.44925*TPK%K069(:)*PCONC(:,15)-TPK%K069(:)*PCONC(:& -&,15) -! -!OH/ORA1=-K066*<OH> - PJAC(:,15,31)=-TPK%K066(:)*PCONC(:,15) -! -!OH/ORA2=-K067*<OH> - PJAC(:,15,32)=-TPK%K067(:)*PCONC(:,15) -! -!OH/MO2=0.0 -! -!OH/ALKAP=0.0 -! -!OH/ALKEP=0.0 -! -!OH/BIOP=0.0 -! -!OH/PHO=0.0 -! -!OH/ADD=+K087*<O3> - PJAC(:,15,38)=+TPK%K087(:)*PCONC(:,1) -! -!OH/AROP=0.0 -! -!OH/CARBOP=0.0 -! -!OH/OLN=0.0 -! -!OH/XO2=0.0 -! -RETURN -END SUBROUTINE SUBJ2 -! -SUBROUTINE SUBJ3 -! -!Indices 16 a 20 -! -! -!HO2/O3=+K023*<OH>-K024*<HO2>+0.23451*K079*<ALKE>+0.30000*K080*<BIO>+0.28441*K0 -!81*<CARBO>+0.08*K082*<PAN> - PJAC(:,16,1)=+TPK%K023(:)*PCONC(:,15)-TPK%K024(:)*PCONC(:,16)+0.23451*TPK%K079& -&(:)*PCONC(:,20)+0.30000*TPK%K080(:)*PCONC(:,21)+0.28441*TPK%K081(:)*PCONC(:,26& -&)+0.08*TPK%K082(:)*PCONC(:,28) -! -!HO2/H2O2=+K026*<OH> - PJAC(:,16,2)=+TPK%K026(:)*PCONC(:,15) -! -!HO2/NO=-K035*<HO2>+K090*<MO2>+0.74265*K091*<ALKAP>+K092*<ALKEP>+0.84700*K093*< -!BIOP>+0.95115*K094*<AROP>+0.12334*K095*<CARBOP>+0.18401*K096*<OLN> - PJAC(:,16,3)=-TPK%K035(:)*PCONC(:,16)+TPK%K090(:)*PCONC(:,33)+0.74265*TPK%K091& -&(:)*PCONC(:,34)+TPK%K092(:)*PCONC(:,35)+0.84700*TPK%K093(:)*PCONC(:,36)+0.9511& -&5*TPK%K094(:)*PCONC(:,39)+0.12334*TPK%K095(:)*PCONC(:,40)+0.18401*TPK%K096(:)*& -&PCONC(:,41) -! -!HO2/NO2=-K036*<HO2> - PJAC(:,16,4)=-TPK%K036(:)*PCONC(:,16) -! -!HO2/NO3=+K034*<OH>-K038*<HO2>+K072*<HCHO>+0.63217*K074*<CARBO>+K119*<MO2>+0.81 -!290*K120*<ALKAP>+K121*<ALKEP>+K122*<BIOP>+K123*<AROP>+0.04915*K124*<CARBOP>+0. -!25928*K125*<OLN> - PJAC(:,16,5)=+TPK%K034(:)*PCONC(:,15)-TPK%K038(:)*PCONC(:,16)+TPK%K072(:)*PCON& -&C(:,23)+0.63217*TPK%K074(:)*PCONC(:,26)+TPK%K119(:)*PCONC(:,33)+0.81290*TPK%K1& -&20(:)*PCONC(:,34)+TPK%K121(:)*PCONC(:,35)+TPK%K122(:)*PCONC(:,36)+TPK%K123(:)*& -&PCONC(:,39)+0.04915*TPK%K124(:)*PCONC(:,40)+0.25928*TPK%K125(:)*PCONC(:,41) -! -!HO2/N2O5=0.0 -! -!HO2/HONO=0.0 -! -!HO2/HNO3=0.0 -! -!HO2/HNO4=+0.65*K006+K037 - PJAC(:,16,9)=+0.65*TPK%K006(:)+TPK%K037(:) -! -!HO2/NH3=0.0 -! -!HO2/DMS=0.0 -! -!HO2/SO2=+K052*<OH> - PJAC(:,16,12)=+TPK%K052(:)*PCONC(:,15) -! -!HO2/SULF=0.0 -! -!HO2/CO=+K053*<OH> - PJAC(:,16,14)=+TPK%K053(:)*PCONC(:,15) -! -!HO2/OH=+K023*<O3>-K025*<HO2>+K026*<H2O2>+K034*<NO3>+K051*<H2>+K052*<SO2>+K053* -!<CO>+0.12793*K058*<ALKA>+0.10318*K061*<ARO>+K062*<HCHO>+0.51208*K065*<CARBO>+K -!066*<ORA1>+0.02915*K069*<OP2>+0.28107*K070*<PAN> - PJAC(:,16,15)=+TPK%K023(:)*PCONC(:,1)-TPK%K025(:)*PCONC(:,16)+TPK%K026(:)*PCON& -&C(:,2)+TPK%K034(:)*PCONC(:,5)+TPK%K051(:)*TPK%H2(:)+TPK%K052(:)*PCONC(:,12)+TP& -&K%K053(:)*PCONC(:,14)+0.12793*TPK%K058(:)*PCONC(:,19)+0.10318*TPK%K061(:)*PCON& -&C(:,22)+TPK%K062(:)*PCONC(:,23)+0.51208*TPK%K065(:)*PCONC(:,26)+TPK%K066(:)*PC& -&ONC(:,31)+0.02915*TPK%K069(:)*PCONC(:,30)+0.28107*TPK%K070(:)*PCONC(:,28) -! -!HO2/HO2=-K024*<O3>-K025*<OH>-K027*<HO2>-K027*<HO2>-K027*<HO2>-K027*<HO2>-K028* -!<HO2>*<H2O>-K028*<HO2>*<H2O>-K028*<HO2>*<H2O>-K028*<HO2>*<H2O>-K035*<NO>-K036* -!<NO2>-K038*<NO3>-K084*<PHO>-K097*<MO2>-K098*<ALKAP>-K099*<ALKEP>-K0100*<BIOP>- -!K0101*<AROP>-K0102*<CARBOP>-K103*<OLN>-K126*<XO2> - PJAC(:,16,16)=-TPK%K024(:)*PCONC(:,1)-TPK%K025(:)*PCONC(:,15)-TPK%K027(:)*PCON& -&C(:,16)-TPK%K027(:)*PCONC(:,16)-TPK%K027(:)*PCONC(:,16)-TPK%K027(:)*PCONC(:,16& -&)-TPK%K028(:)*PCONC(:,16)*TPK%H2O(:)-TPK%K028(:)*PCONC(:,16)*TPK%H2O(:)-TPK%K0& -&28(:)*PCONC(:,16)*TPK%H2O(:)-TPK%K028(:)*PCONC(:,16)*TPK%H2O(:)-TPK%K035(:)*PC& -&ONC(:,3)-TPK%K036(:)*PCONC(:,4)-TPK%K038(:)*PCONC(:,5)-TPK%K084(:)*PCONC(:,37)& -&-TPK%K097(:)*PCONC(:,33)-TPK%K098(:)*PCONC(:,34)-TPK%K099(:)*PCONC(:,35)-TPK%K& -&0100(:)*PCONC(:,36)-TPK%K0101(:)*PCONC(:,39)-TPK%K0102(:)*PCONC(:,40)-TPK%K103& -&(:)*PCONC(:,41)-TPK%K126(:)*PCONC(:,42) -! -!HO2/CH4=0.0 -! -!HO2/ETH=0.0 -! -!HO2/ALKA=+0.12793*K058*<OH> - PJAC(:,16,19)=+0.12793*TPK%K058(:)*PCONC(:,15) -! -!HO2/ALKE=+0.23451*K079*<O3> - PJAC(:,16,20)=+0.23451*TPK%K079(:)*PCONC(:,1) -! -!HO2/BIO=+0.28*K054*<O3P>+0.30000*K080*<O3> - PJAC(:,16,21)=+0.28*TPK%K054(:)*TPK%O3P(:)+0.30000*TPK%K080(:)*PCONC(:,1) -! -!HO2/ARO=+0.10318*K061*<OH> - PJAC(:,16,22)=+0.10318*TPK%K061(:)*PCONC(:,15) -! -!HO2/HCHO=+K011+K011+K062*<OH>+K072*<NO3> - PJAC(:,16,23)=+TPK%K011(:)+TPK%K011(:)+TPK%K062(:)*PCONC(:,15)+TPK%K072(:)*PCO& -&NC(:,5) -! -!HO2/ALD=+K012 - PJAC(:,16,24)=+TPK%K012(:) -! -!HO2/KET=0.0 -! -!HO2/CARBO=+0.75830*K016+0.51208*K065*<OH>+0.63217*K074*<NO3>+0.28441*K081*<O3> - PJAC(:,16,26)=+0.75830*TPK%K016(:)+0.51208*TPK%K065(:)*PCONC(:,15)+0.63217*TPK& -&%K074(:)*PCONC(:,5)+0.28441*TPK%K081(:)*PCONC(:,1) -! -!HO2/ONIT=+K017 - PJAC(:,16,27)=+TPK%K017(:) -! -!HO2/PAN=+0.28107*K070*<OH>+0.08*K082*<O3> - PJAC(:,16,28)=+0.28107*TPK%K070(:)*PCONC(:,15)+0.08*TPK%K082(:)*PCONC(:,1) -! -!HO2/OP1=+K013 - PJAC(:,16,29)=+TPK%K013(:) -! -!HO2/OP2=+0.96205*K014+0.02915*K069*<OH> - PJAC(:,16,30)=+0.96205*TPK%K014(:)+0.02915*TPK%K069(:)*PCONC(:,15) -! -!HO2/ORA1=+K066*<OH> - PJAC(:,16,31)=+TPK%K066(:)*PCONC(:,15) -! -!HO2/ORA2=0.0 -! -!HO2/MO2=+K090*<NO>-K097*<HO2>+0.66*K104*<MO2>+0.66*K104*<MO2>+0.98383*K105*<AL -!KAP>+K106*<ALKEP>+1.00000*K107*<BIOP>+1.02767*K108*<AROP>+0.82998*K109*<CARBOP -!>+0.67560*K110*<OLN>+K119*<NO3>+K127*<XO2> - PJAC(:,16,33)=+TPK%K090(:)*PCONC(:,3)-TPK%K097(:)*PCONC(:,16)+0.66*TPK%K104(:)& -&*PCONC(:,33)+0.66*TPK%K104(:)*PCONC(:,33)+0.98383*TPK%K105(:)*PCONC(:,34)+TPK%& -&K106(:)*PCONC(:,35)+1.00000*TPK%K107(:)*PCONC(:,36)+1.02767*TPK%K108(:)*PCONC(& -&:,39)+0.82998*TPK%K109(:)*PCONC(:,40)+0.67560*TPK%K110(:)*PCONC(:,41)+TPK%K119& -&(:)*PCONC(:,5)+TPK%K127(:)*PCONC(:,42) -! -!HO2/ALKAP=+0.74265*K091*<NO>-K098*<HO2>+0.98383*K105*<MO2>+0.48079*K111*<CARBO -!P>+0.81290*K120*<NO3> - PJAC(:,16,34)=+0.74265*TPK%K091(:)*PCONC(:,3)-TPK%K098(:)*PCONC(:,16)+0.98383*& -&TPK%K105(:)*PCONC(:,33)+0.48079*TPK%K111(:)*PCONC(:,40)+0.81290*TPK%K120(:)*PC& -&ONC(:,5) -! -!HO2/ALKEP=+K092*<NO>-K099*<HO2>+K106*<MO2>+0.50078*K112*<CARBOP>+K121*<NO3> - PJAC(:,16,35)=+TPK%K092(:)*PCONC(:,3)-TPK%K099(:)*PCONC(:,16)+TPK%K106(:)*PCON& -&C(:,33)+0.50078*TPK%K112(:)*PCONC(:,40)+TPK%K121(:)*PCONC(:,5) -! -!HO2/BIOP=+0.84700*K093*<NO>-K0100*<HO2>+1.00000*K107*<MO2>+0.50600*K113*<CARBO -!P>+K122*<NO3> - PJAC(:,16,36)=+0.84700*TPK%K093(:)*PCONC(:,3)-TPK%K0100(:)*PCONC(:,16)+1.00000& -&*TPK%K107(:)*PCONC(:,33)+0.50600*TPK%K113(:)*PCONC(:,40)+TPK%K122(:)*PCONC(:,5& -&) -! -!HO2/PHO=-K084*<HO2> - PJAC(:,16,37)=-TPK%K084(:)*PCONC(:,16) -! -!HO2/ADD=+0.02*K086*<O2> - PJAC(:,16,38)=+0.02*TPK%K086(:)*TPK%O2(:) -! -!HO2/AROP=+0.95115*K094*<NO>-K0101*<HO2>+1.02767*K108*<MO2>+K114*<CARBOP>+K123* -!<NO3> - PJAC(:,16,39)=+0.95115*TPK%K094(:)*PCONC(:,3)-TPK%K0101(:)*PCONC(:,16)+1.02767& -&*TPK%K108(:)*PCONC(:,33)+TPK%K114(:)*PCONC(:,40)+TPK%K123(:)*PCONC(:,5) -! -!HO2/CARBOP=+0.12334*K095*<NO>-K0102*<HO2>+0.82998*K109*<MO2>+0.48079*K111*<ALK -!AP>+0.50078*K112*<ALKEP>+0.50600*K113*<BIOP>+K114*<AROP>+0.07566*K115*<CARBOP> -!+0.07566*K115*<CARBOP>+0.17599*K116*<OLN>+0.04915*K124*<NO3> - PJAC(:,16,40)=+0.12334*TPK%K095(:)*PCONC(:,3)-TPK%K0102(:)*PCONC(:,16)+0.82998& -&*TPK%K109(:)*PCONC(:,33)+0.48079*TPK%K111(:)*PCONC(:,34)+0.50078*TPK%K112(:)*P& -&CONC(:,35)+0.50600*TPK%K113(:)*PCONC(:,36)+TPK%K114(:)*PCONC(:,39)+0.07566*TPK& -&%K115(:)*PCONC(:,40)+0.07566*TPK%K115(:)*PCONC(:,40)+0.17599*TPK%K116(:)*PCONC& -&(:,41)+0.04915*TPK%K124(:)*PCONC(:,5) -! -!HO2/OLN=+0.18401*K096*<NO>-K103*<HO2>+0.67560*K110*<MO2>+0.17599*K116*<CARBOP> -!+K117*<OLN>+K117*<OLN>+0.00000*K118*<OLN>+0.00000*K118*<OLN>+0.25928*K125*<NO3 -!> - PJAC(:,16,41)=+0.18401*TPK%K096(:)*PCONC(:,3)-TPK%K103(:)*PCONC(:,16)+0.67560*& -&TPK%K110(:)*PCONC(:,33)+0.17599*TPK%K116(:)*PCONC(:,40)+TPK%K117(:)*PCONC(:,41& -&)+TPK%K117(:)*PCONC(:,41)+0.00000*TPK%K118(:)*PCONC(:,41)+0.00000*TPK%K118(:)*& -&PCONC(:,41)+0.25928*TPK%K125(:)*PCONC(:,5) -! -!HO2/XO2=-K126*<HO2>+K127*<MO2> - PJAC(:,16,42)=-TPK%K126(:)*PCONC(:,16)+TPK%K127(:)*PCONC(:,33) -! -!CH4/O3=+0.04300*K079*<ALKE> - PJAC(:,17,1)=+0.04300*TPK%K079(:)*PCONC(:,20) -! -!CH4/H2O2=0.0 -! -!CH4/NO=0.0 -! -!CH4/NO2=0.0 -! -!CH4/NO3=0.0 -! -!CH4/N2O5=0.0 -! -!CH4/HONO=0.0 -! -!CH4/HNO3=0.0 -! -!CH4/HNO4=0.0 -! -!CH4/NH3=0.0 -! -!CH4/DMS=0.0 -! -!CH4/SO2=0.0 -! -!CH4/SULF=0.0 -! -!CH4/CO=0.0 -! -!CH4/OH=-K056*<CH4> - PJAC(:,17,15)=-TPK%K056(:)*PCONC(:,17) -! -!CH4/HO2=0.0 -! -!CH4/CH4=-K056*<OH> - PJAC(:,17,17)=-TPK%K056(:)*PCONC(:,15) -! -!CH4/ETH=0.0 -! -!CH4/ALKA=0.0 -! -!CH4/ALKE=+0.04300*K079*<O3> - PJAC(:,17,20)=+0.04300*TPK%K079(:)*PCONC(:,1) -! -!CH4/BIO=0.0 -! -!CH4/ARO=0.0 -! -!CH4/HCHO=0.0 -! -!CH4/ALD=0.0 -! -!CH4/KET=0.0 -! -!CH4/CARBO=0.0 -! -!CH4/ONIT=0.0 -! -!CH4/PAN=0.0 -! -!CH4/OP1=0.0 -! -!CH4/OP2=0.0 -! -!CH4/ORA1=0.0 -! -!CH4/ORA2=0.0 -! -!CH4/MO2=0.0 -! -!CH4/ALKAP=0.0 -! -!CH4/ALKEP=0.0 -! -!CH4/BIOP=0.0 -! -!CH4/PHO=0.0 -! -!CH4/ADD=0.0 -! -!CH4/AROP=0.0 -! -!CH4/CARBOP=0.0 -! -!CH4/OLN=0.0 -! -!CH4/XO2=0.0 -! -!ETH/O3=+0.03196*K079*<ALKE> - PJAC(:,18,1)=+0.03196*TPK%K079(:)*PCONC(:,20) -! -!ETH/H2O2=0.0 -! -!ETH/NO=0.0 -! -!ETH/NO2=0.0 -! -!ETH/NO3=0.0 -! -!ETH/N2O5=0.0 -! -!ETH/HONO=0.0 -! -!ETH/HNO3=0.0 -! -!ETH/HNO4=0.0 -! -!ETH/NH3=0.0 -! -!ETH/DMS=0.0 -! -!ETH/SO2=0.0 -! -!ETH/SULF=0.0 -! -!ETH/CO=0.0 -! -!ETH/OH=-K057*<ETH> - PJAC(:,18,15)=-TPK%K057(:)*PCONC(:,18) -! -!ETH/HO2=0.0 -! -!ETH/CH4=0.0 -! -!ETH/ETH=-K057*<OH> - PJAC(:,18,18)=-TPK%K057(:)*PCONC(:,15) -! -!ETH/ALKA=0.0 -! -!ETH/ALKE=+0.03196*K079*<O3> - PJAC(:,18,20)=+0.03196*TPK%K079(:)*PCONC(:,1) -! -!ETH/BIO=0.0 -! -!ETH/ARO=0.0 -! -!ETH/HCHO=0.0 -! -!ETH/ALD=0.0 -! -!ETH/KET=0.0 -! -!ETH/CARBO=0.0 -! -!ETH/ONIT=0.0 -! -!ETH/PAN=0.0 -! -!ETH/OP1=0.0 -! -!ETH/OP2=0.0 -! -!ETH/ORA1=0.0 -! -!ETH/ORA2=0.0 -! -!ETH/MO2=0.0 -! -!ETH/ALKAP=0.0 -! -!ETH/ALKEP=0.0 -! -!ETH/BIOP=0.0 -! -!ETH/PHO=0.0 -! -!ETH/ADD=0.0 -! -!ETH/AROP=0.0 -! -!ETH/CARBOP=0.0 -! -!ETH/OLN=0.0 -! -!ETH/XO2=0.0 -! -!ALKA/O3=0.0 -! -!ALKA/H2O2=0.0 -! -!ALKA/NO=0.0 -! -!ALKA/NO2=0.0 -! -!ALKA/NO3=0.0 -! -!ALKA/N2O5=0.0 -! -!ALKA/HONO=0.0 -! -!ALKA/HNO3=0.0 -! -!ALKA/HNO4=0.0 -! -!ALKA/NH3=0.0 -! -!ALKA/DMS=0.0 -! -!ALKA/SO2=0.0 -! -!ALKA/SULF=0.0 -! -!ALKA/CO=0.0 -! -!ALKA/OH=-K058*<ALKA> - PJAC(:,19,15)=-TPK%K058(:)*PCONC(:,19) -! -!ALKA/HO2=0.0 -! -!ALKA/CH4=0.0 -! -!ALKA/ETH=0.0 -! -!ALKA/ALKA=-K058*<OH> - PJAC(:,19,19)=-TPK%K058(:)*PCONC(:,15) -! -!ALKA/ALKE=0.0 -! -!ALKA/BIO=0.0 -! -!ALKA/ARO=0.0 -! -!ALKA/HCHO=0.0 -! -!ALKA/ALD=0.0 -! -!ALKA/KET=0.0 -! -!ALKA/CARBO=0.0 -! -!ALKA/ONIT=0.0 -! -!ALKA/PAN=0.0 -! -!ALKA/OP1=0.0 -! -!ALKA/OP2=0.0 -! -!ALKA/ORA1=0.0 -! -!ALKA/ORA2=0.0 -! -!ALKA/MO2=0.0 -! -!ALKA/ALKAP=0.0 -! -!ALKA/ALKEP=0.0 -! -!ALKA/BIOP=0.0 -! -!ALKA/PHO=0.0 -! -!ALKA/ADD=0.0 -! -!ALKA/AROP=0.0 -! -!ALKA/CARBOP=0.0 -! -!ALKA/OLN=0.0 -! -!ALKA/XO2=0.0 -! -!ALKE/O3=+0.00000*K079*<ALKE>-K079*<ALKE>+0.37388*K080*<BIO> - PJAC(:,20,1)=+0.00000*TPK%K079(:)*PCONC(:,20)-TPK%K079(:)*PCONC(:,20)+0.37388*& -&TPK%K080(:)*PCONC(:,21) -! -!ALKE/H2O2=0.0 -! -!ALKE/NO=+0.37815*K093*<BIOP> - PJAC(:,20,3)=+0.37815*TPK%K093(:)*PCONC(:,36) -! -!ALKE/NO2=0.0 -! -!ALKE/NO3=-K076*<ALKE>+0.42729*K122*<BIOP> - PJAC(:,20,5)=-TPK%K076(:)*PCONC(:,20)+0.42729*TPK%K122(:)*PCONC(:,36) -! -!ALKE/N2O5=0.0 -! -!ALKE/HONO=0.0 -! -!ALKE/HNO3=0.0 -! -!ALKE/HNO4=0.0 -! -!ALKE/NH3=0.0 -! -!ALKE/DMS=0.0 -! -!ALKE/SO2=0.0 -! -!ALKE/SULF=0.0 -! -!ALKE/CO=0.0 -! -!ALKE/OH=-K059*<ALKE> - PJAC(:,20,15)=-TPK%K059(:)*PCONC(:,20) -! -!ALKE/HO2=0.0 -! -!ALKE/CH4=0.0 -! -!ALKE/ETH=0.0 -! -!ALKE/ALKA=0.0 -! -!ALKE/ALKE=-K059*<OH>-K076*<NO3>+0.00000*K079*<O3>-K079*<O3> - PJAC(:,20,20)=-TPK%K059(:)*PCONC(:,15)-TPK%K076(:)*PCONC(:,5)+0.00000*TPK%K079& -&(:)*PCONC(:,1)-TPK%K079(:)*PCONC(:,1) -! -!ALKE/BIO=+0.91868*K054*<O3P>+0.37388*K080*<O3> - PJAC(:,20,21)=+0.91868*TPK%K054(:)*TPK%O3P(:)+0.37388*TPK%K080(:)*PCONC(:,1) -! -!ALKE/ARO=0.0 -! -!ALKE/HCHO=0.0 -! -!ALKE/ALD=0.0 -! -!ALKE/KET=0.0 -! -!ALKE/CARBO=0.0 -! -!ALKE/ONIT=0.0 -! -!ALKE/PAN=0.0 -! -!ALKE/OP1=0.0 -! -!ALKE/OP2=0.0 -! -!ALKE/ORA1=0.0 -! -!ALKE/ORA2=0.0 -! -!ALKE/MO2=+0.48074*K107*<BIOP> - PJAC(:,20,33)=+0.48074*TPK%K107(:)*PCONC(:,36) -! -!ALKE/ALKAP=0.0 -! -!ALKE/ALKEP=0.0 -! -!ALKE/BIOP=+0.37815*K093*<NO>+0.48074*K107*<MO2>+0.24463*K113*<CARBOP>+0.42729* -!K122*<NO3> - PJAC(:,20,36)=+0.37815*TPK%K093(:)*PCONC(:,3)+0.48074*TPK%K107(:)*PCONC(:,33)+& -&0.24463*TPK%K113(:)*PCONC(:,40)+0.42729*TPK%K122(:)*PCONC(:,5) -! -!ALKE/PHO=0.0 -! -!ALKE/ADD=0.0 -! -!ALKE/AROP=0.0 -! -!ALKE/CARBOP=+0.24463*K113*<BIOP> - PJAC(:,20,40)=+0.24463*TPK%K113(:)*PCONC(:,36) -! -!ALKE/OLN=0.0 -! -!ALKE/XO2=0.0 -! -RETURN -END SUBROUTINE SUBJ3 -! -SUBROUTINE SUBJ4 -! -!Indices 21 a 25 -! -! -!BIO/O3=-K080*<BIO> - PJAC(:,21,1)=-TPK%K080(:)*PCONC(:,21) -! -!BIO/H2O2=0.0 -! -!BIO/NO=0.0 -! -!BIO/NO2=0.0 -! -!BIO/NO3=-K077*<BIO> - PJAC(:,21,5)=-TPK%K077(:)*PCONC(:,21) -! -!BIO/N2O5=0.0 -! -!BIO/HONO=0.0 -! -!BIO/HNO3=0.0 -! -!BIO/HNO4=0.0 -! -!BIO/NH3=0.0 -! -!BIO/DMS=0.0 -! -!BIO/SO2=0.0 -! -!BIO/SULF=0.0 -! -!BIO/CO=0.0 -! -!BIO/OH=-K060*<BIO> - PJAC(:,21,15)=-TPK%K060(:)*PCONC(:,21) -! -!BIO/HO2=0.0 -! -!BIO/CH4=0.0 -! -!BIO/ETH=0.0 -! -!BIO/ALKA=0.0 -! -!BIO/ALKE=0.0 -! -!BIO/BIO=-K054*<O3P>-K060*<OH>-K077*<NO3>-K080*<O3> - PJAC(:,21,21)=-TPK%K054(:)*TPK%O3P(:)-TPK%K060(:)*PCONC(:,15)-TPK%K077(:)*PCON& -&C(:,5)-TPK%K080(:)*PCONC(:,1) -! -!BIO/ARO=0.0 -! -!BIO/HCHO=0.0 -! -!BIO/ALD=0.0 -! -!BIO/KET=0.0 -! -!BIO/CARBO=0.0 -! -!BIO/ONIT=0.0 -! -!BIO/PAN=0.0 -! -!BIO/OP1=0.0 -! -!BIO/OP2=0.0 -! -!BIO/ORA1=0.0 -! -!BIO/ORA2=0.0 -! -!BIO/MO2=0.0 -! -!BIO/ALKAP=0.0 -! -!BIO/ALKEP=0.0 -! -!BIO/BIOP=0.0 -! -!BIO/PHO=0.0 -! -!BIO/ADD=0.0 -! -!BIO/AROP=0.0 -! -!BIO/CARBOP=0.0 -! -!BIO/OLN=0.0 -! -!BIO/XO2=0.0 -! -!ARO/O3=+K087*<ADD> - PJAC(:,22,1)=+TPK%K087(:)*PCONC(:,38) -! -!ARO/H2O2=0.0 -! -!ARO/NO=0.0 -! -!ARO/NO2=+0.10670*K083*<PHO>+K085*<ADD> - PJAC(:,22,4)=+0.10670*TPK%K083(:)*PCONC(:,37)+TPK%K085(:)*PCONC(:,38) -! -!ARO/NO3=-K075*<ARO> - PJAC(:,22,5)=-TPK%K075(:)*PCONC(:,22) -! -!ARO/N2O5=0.0 -! -!ARO/HONO=0.0 -! -!ARO/HNO3=0.0 -! -!ARO/HNO4=0.0 -! -!ARO/NH3=0.0 -! -!ARO/DMS=0.0 -! -!ARO/SO2=0.0 -! -!ARO/SULF=0.0 -! -!ARO/CO=0.0 -! -!ARO/OH=-K061*<ARO> - PJAC(:,22,15)=-TPK%K061(:)*PCONC(:,22) -! -!ARO/HO2=+1.06698*K084*<PHO> - PJAC(:,22,16)=+1.06698*TPK%K084(:)*PCONC(:,37) -! -!ARO/CH4=0.0 -! -!ARO/ETH=0.0 -! -!ARO/ALKA=0.0 -! -!ARO/ALKE=0.0 -! -!ARO/BIO=0.0 -! -!ARO/ARO=-K061*<OH>-K075*<NO3> - PJAC(:,22,22)=-TPK%K061(:)*PCONC(:,15)-TPK%K075(:)*PCONC(:,5) -! -!ARO/HCHO=0.0 -! -!ARO/ALD=0.0 -! -!ARO/KET=0.0 -! -!ARO/CARBO=0.0 -! -!ARO/ONIT=0.0 -! -!ARO/PAN=0.0 -! -!ARO/OP1=0.0 -! -!ARO/OP2=0.0 -! -!ARO/ORA1=0.0 -! -!ARO/ORA2=0.0 -! -!ARO/MO2=0.0 -! -!ARO/ALKAP=0.0 -! -!ARO/ALKEP=0.0 -! -!ARO/BIOP=0.0 -! -!ARO/PHO=+0.10670*K083*<NO2>+1.06698*K084*<HO2> - PJAC(:,22,37)=+0.10670*TPK%K083(:)*PCONC(:,4)+1.06698*TPK%K084(:)*PCONC(:,16) -! -!ARO/ADD=+K085*<NO2>+0.02*K086*<O2>+K087*<O3> - PJAC(:,22,38)=+TPK%K085(:)*PCONC(:,4)+0.02*TPK%K086(:)*TPK%O2(:)+TPK%K087(:)*P& -&CONC(:,1) -! -!ARO/AROP=0.0 -! -!ARO/CARBOP=0.0 -! -!ARO/OLN=0.0 -! -!ARO/XO2=0.0 -! -!HCHO/O3=+0.48290*K079*<ALKE>+0.90000*K080*<BIO>+0.00000*K081*<CARBO>+0.70*K082 -!*<PAN> - PJAC(:,23,1)=+0.48290*TPK%K079(:)*PCONC(:,20)+0.90000*TPK%K080(:)*PCONC(:,21)+& -&0.00000*TPK%K081(:)*PCONC(:,26)+0.70*TPK%K082(:)*PCONC(:,28) -! -!HCHO/H2O2=0.0 -! -!HCHO/NO=+K090*<MO2>+0.03002*K091*<ALKAP>+1.39870*K092*<ALKEP>+0.60600*K093*<BI -!OP>+0.05848*K095*<CARBOP>+0.23419*K096*<OLN> - PJAC(:,23,3)=+TPK%K090(:)*PCONC(:,33)+0.03002*TPK%K091(:)*PCONC(:,34)+1.39870*& -&TPK%K092(:)*PCONC(:,35)+0.60600*TPK%K093(:)*PCONC(:,36)+0.05848*TPK%K095(:)*PC& -&ONC(:,40)+0.23419*TPK%K096(:)*PCONC(:,41) -! -!HCHO/NO2=0.0 -! -!HCHO/NO3=-K072*<HCHO>+0.40*K078*<PAN>+K119*<MO2>+0.03142*K120*<ALKAP>+1.40909* -!K121*<ALKEP>+0.68600*K122*<BIOP>+0.03175*K124*<CARBOP>+0.20740*K125*<OLN> - PJAC(:,23,5)=-TPK%K072(:)*PCONC(:,23)+0.40*TPK%K078(:)*PCONC(:,28)+TPK%K119(:)& -&*PCONC(:,33)+0.03142*TPK%K120(:)*PCONC(:,34)+1.40909*TPK%K121(:)*PCONC(:,35)+0& -&.68600*TPK%K122(:)*PCONC(:,36)+0.03175*TPK%K124(:)*PCONC(:,40)+0.20740*TPK%K12& -&5(:)*PCONC(:,41) -! -!HCHO/N2O5=0.0 -! -!HCHO/HONO=0.0 -! -!HCHO/HNO3=0.0 -! -!HCHO/HNO4=0.0 -! -!HCHO/NH3=0.0 -! -!HCHO/DMS=0.0 -! -!HCHO/SO2=0.0 -! -!HCHO/SULF=0.0 -! -!HCHO/CO=0.0 -! -!HCHO/OH=+0.00140*K058*<ALKA>-K062*<HCHO>+0.00000*K065*<CARBO>+0.35*K068*<OP1>+ -!0.02915*K069*<OP2>+0.57839*K070*<PAN> - PJAC(:,23,15)=+0.00140*TPK%K058(:)*PCONC(:,19)-TPK%K062(:)*PCONC(:,23)+0.00000& -&*TPK%K065(:)*PCONC(:,26)+0.35*TPK%K068(:)*PCONC(:,29)+0.02915*TPK%K069(:)*PCON& -&C(:,30)+0.57839*TPK%K070(:)*PCONC(:,28) -! -!HCHO/HO2=0.0 -! -!HCHO/CH4=0.0 -! -!HCHO/ETH=0.0 -! -!HCHO/ALKA=+0.00140*K058*<OH> - PJAC(:,23,19)=+0.00140*TPK%K058(:)*PCONC(:,15) -! -!HCHO/ALKE=+0.48290*K079*<O3> - PJAC(:,23,20)=+0.48290*TPK%K079(:)*PCONC(:,1) -! -!HCHO/BIO=+0.05*K054*<O3P>+0.90000*K080*<O3> - PJAC(:,23,21)=+0.05*TPK%K054(:)*TPK%O3P(:)+0.90000*TPK%K080(:)*PCONC(:,1) -! -!HCHO/ARO=0.0 -! -!HCHO/HCHO=-K010-K011-K062*<OH>-K072*<NO3> - PJAC(:,23,23)=-TPK%K010(:)-TPK%K011(:)-TPK%K062(:)*PCONC(:,15)-TPK%K072(:)*PCO& -&NC(:,5) -! -!HCHO/ALD=0.0 -! -!HCHO/KET=0.0 -! -!HCHO/CARBO=+0.06517*K016+0.00000*K065*<OH>+0.00000*K081*<O3> - PJAC(:,23,26)=+0.06517*TPK%K016(:)+0.00000*TPK%K065(:)*PCONC(:,15)+0.00000*TPK& -&%K081(:)*PCONC(:,1) -! -!HCHO/ONIT=0.0 -! -!HCHO/PAN=+0.57839*K070*<OH>+0.40*K078*<NO3>+0.70*K082*<O3> - PJAC(:,23,28)=+0.57839*TPK%K070(:)*PCONC(:,15)+0.40*TPK%K078(:)*PCONC(:,5)+0.7& -&0*TPK%K082(:)*PCONC(:,1) -! -!HCHO/OP1=+K013+0.35*K068*<OH> - PJAC(:,23,29)=+TPK%K013(:)+0.35*TPK%K068(:)*PCONC(:,15) -! -!HCHO/OP2=+0.02915*K069*<OH> - PJAC(:,23,30)=+0.02915*TPK%K069(:)*PCONC(:,15) -! -!HCHO/ORA1=0.0 -! -!HCHO/ORA2=0.0 -! -!HCHO/MO2=+K090*<NO>+1.33*K104*<MO2>+1.33*K104*<MO2>+0.80556*K105*<ALKAP>+1.428 -!94*K106*<ALKEP>+1.09000*K107*<BIOP>+K108*<AROP>+0.95723*K109*<CARBOP>+0.88625* -!K110*<OLN>+K119*<NO3>+K127*<XO2> - PJAC(:,23,33)=+TPK%K090(:)*PCONC(:,3)+1.33*TPK%K104(:)*PCONC(:,33)+1.33*TPK%K1& -&04(:)*PCONC(:,33)+0.80556*TPK%K105(:)*PCONC(:,34)+1.42894*TPK%K106(:)*PCONC(:,& -&35)+1.09000*TPK%K107(:)*PCONC(:,36)+TPK%K108(:)*PCONC(:,39)+0.95723*TPK%K109(:& -&)*PCONC(:,40)+0.88625*TPK%K110(:)*PCONC(:,41)+TPK%K119(:)*PCONC(:,5)+TPK%K127(& -&:)*PCONC(:,42) -! -!HCHO/ALKAP=+0.03002*K091*<NO>+0.80556*K105*<MO2>+0.07600*K111*<CARBOP>+0.03142 -!*K120*<NO3> - PJAC(:,23,34)=+0.03002*TPK%K091(:)*PCONC(:,3)+0.80556*TPK%K105(:)*PCONC(:,33)+& -&0.07600*TPK%K111(:)*PCONC(:,40)+0.03142*TPK%K120(:)*PCONC(:,5) -! -!HCHO/ALKEP=+1.39870*K092*<NO>+1.42894*K106*<MO2>+0.68192*K112*<CARBOP>+1.40909 -!*K121*<NO3> - PJAC(:,23,35)=+1.39870*TPK%K092(:)*PCONC(:,3)+1.42894*TPK%K106(:)*PCONC(:,33)+& -&0.68192*TPK%K112(:)*PCONC(:,40)+1.40909*TPK%K121(:)*PCONC(:,5) -! -!HCHO/BIOP=+0.60600*K093*<NO>+1.09000*K107*<MO2>+0.34000*K113*<CARBOP>+0.68600* -!K122*<NO3> - PJAC(:,23,36)=+0.60600*TPK%K093(:)*PCONC(:,3)+1.09000*TPK%K107(:)*PCONC(:,33)+& -&0.34000*TPK%K113(:)*PCONC(:,40)+0.68600*TPK%K122(:)*PCONC(:,5) -! -!HCHO/PHO=0.0 -! -!HCHO/ADD=0.0 -! -!HCHO/AROP=+K108*<MO2> - PJAC(:,23,39)=+TPK%K108(:)*PCONC(:,33) -! -!HCHO/CARBOP=+0.05848*K095*<NO>+0.95723*K109*<MO2>+0.07600*K111*<ALKAP>+0.68192 -!*K112*<ALKEP>+0.34000*K113*<BIOP>+0.03432*K115*<CARBOP>+0.03432*K115*<CARBOP>+ -!0.13414*K116*<OLN>+0.03175*K124*<NO3> - PJAC(:,23,40)=+0.05848*TPK%K095(:)*PCONC(:,3)+0.95723*TPK%K109(:)*PCONC(:,33)+& -&0.07600*TPK%K111(:)*PCONC(:,34)+0.68192*TPK%K112(:)*PCONC(:,35)+0.34000*TPK%K1& -&13(:)*PCONC(:,36)+0.03432*TPK%K115(:)*PCONC(:,40)+0.03432*TPK%K115(:)*PCONC(:,& -&40)+0.13414*TPK%K116(:)*PCONC(:,41)+0.03175*TPK%K124(:)*PCONC(:,5) -! -!HCHO/OLN=+0.23419*K096*<NO>+0.88625*K110*<MO2>+0.13414*K116*<CARBOP>+0.00000*K -!118*<OLN>+0.00000*K118*<OLN>+0.20740*K125*<NO3> - PJAC(:,23,41)=+0.23419*TPK%K096(:)*PCONC(:,3)+0.88625*TPK%K110(:)*PCONC(:,33)+& -&0.13414*TPK%K116(:)*PCONC(:,40)+0.00000*TPK%K118(:)*PCONC(:,41)+0.00000*TPK%K1& -&18(:)*PCONC(:,41)+0.20740*TPK%K125(:)*PCONC(:,5) -! -!HCHO/XO2=+K127*<MO2> - PJAC(:,23,42)=+TPK%K127(:)*PCONC(:,33) -! -!ALD/O3=+0.51468*K079*<ALKE>+0.00000*K080*<BIO>+0.15692*K081*<CARBO> - PJAC(:,24,1)=+0.51468*TPK%K079(:)*PCONC(:,20)+0.00000*TPK%K080(:)*PCONC(:,21)+& -&0.15692*TPK%K081(:)*PCONC(:,26) -! -!ALD/H2O2=0.0 -! -!ALD/NO=+0.33144*K091*<ALKAP>+0.42125*K092*<ALKEP>+0.00000*K093*<BIOP>+0.07368* -!K095*<CARBOP>+1.01182*K096*<OLN> - PJAC(:,24,3)=+0.33144*TPK%K091(:)*PCONC(:,34)+0.42125*TPK%K092(:)*PCONC(:,35)+& -&0.00000*TPK%K093(:)*PCONC(:,36)+0.07368*TPK%K095(:)*PCONC(:,40)+1.01182*TPK%K0& -&96(:)*PCONC(:,41) -! -!ALD/NO2=0.0 -! -!ALD/NO3=-K073*<ALD>+0.05265*K074*<CARBO>+0.33743*K120*<ALKAP>+0.43039*K121*<AL -!KEP>+0.00000*K122*<BIOP>+0.02936*K124*<CARBOP>+0.91850*K125*<OLN> - PJAC(:,24,5)=-TPK%K073(:)*PCONC(:,24)+0.05265*TPK%K074(:)*PCONC(:,26)+0.33743*& -&TPK%K120(:)*PCONC(:,34)+0.43039*TPK%K121(:)*PCONC(:,35)+0.00000*TPK%K122(:)*PC& -&ONC(:,36)+0.02936*TPK%K124(:)*PCONC(:,40)+0.91850*TPK%K125(:)*PCONC(:,41) -! -!ALD/N2O5=0.0 -! -!ALD/HONO=0.0 -! -!ALD/HNO3=0.0 -! -!ALD/HNO4=0.0 -! -!ALD/NH3=0.0 -! -!ALD/DMS=0.0 -! -!ALD/SO2=0.0 -! -!ALD/SULF=0.0 -! -!ALD/CO=0.0 -! -!ALD/OH=+0.08173*K058*<ALKA>-K063*<ALD>+0.06253*K065*<CARBO>+0.07335*K069*<OP2> - PJAC(:,24,15)=+0.08173*TPK%K058(:)*PCONC(:,19)-TPK%K063(:)*PCONC(:,24)+0.06253& -&*TPK%K065(:)*PCONC(:,26)+0.07335*TPK%K069(:)*PCONC(:,30) -! -!ALD/HO2=0.0 -! -!ALD/CH4=0.0 -! -!ALD/ETH=0.0 -! -!ALD/ALKA=+0.08173*K058*<OH> - PJAC(:,24,19)=+0.08173*TPK%K058(:)*PCONC(:,15) -! -!ALD/ALKE=+0.51468*K079*<O3> - PJAC(:,24,20)=+0.51468*TPK%K079(:)*PCONC(:,1) -! -!ALD/BIO=+0.00000*K080*<O3> - PJAC(:,24,21)=+0.00000*TPK%K080(:)*PCONC(:,1) -! -!ALD/ARO=0.0 -! -!ALD/HCHO=0.0 -! -!ALD/ALD=-K012-K063*<OH>-K073*<NO3> - PJAC(:,24,24)=-TPK%K012(:)-TPK%K063(:)*PCONC(:,15)-TPK%K073(:)*PCONC(:,5) -! -!ALD/KET=0.0 -! -!ALD/CARBO=+K055*<O3P>+0.06253*K065*<OH>+0.05265*K074*<NO3>+0.15692*K081*<O3> - PJAC(:,24,26)=+TPK%K055(:)*TPK%O3P(:)+0.06253*TPK%K065(:)*PCONC(:,15)+0.05265*& -&TPK%K074(:)*PCONC(:,5)+0.15692*TPK%K081(:)*PCONC(:,1) -! -!ALD/ONIT=+0.20*K017 - PJAC(:,24,27)=+0.20*TPK%K017(:) -! -!ALD/PAN=0.0 -! -!ALD/OP1=0.0 -! -!ALD/OP2=+0.96205*K014+0.07335*K069*<OH> - PJAC(:,24,30)=+0.96205*TPK%K014(:)+0.07335*TPK%K069(:)*PCONC(:,15) -! -!ALD/ORA1=0.0 -! -!ALD/ORA2=0.0 -! -!ALD/MO2=+0.56070*K105*<ALKAP>+0.46413*K106*<ALKEP>+0.00000*K107*<BIOP>+0.08295 -!*K109*<CARBOP>+0.41524*K110*<OLN> - PJAC(:,24,33)=+0.56070*TPK%K105(:)*PCONC(:,34)+0.46413*TPK%K106(:)*PCONC(:,35)& -&+0.00000*TPK%K107(:)*PCONC(:,36)+0.08295*TPK%K109(:)*PCONC(:,40)+0.41524*TPK%K& -&110(:)*PCONC(:,41) -! -!ALD/ALKAP=+0.33144*K091*<NO>+0.56070*K105*<MO2>+0.71461*K111*<CARBOP>+0.33743* -!K120*<NO3> - PJAC(:,24,34)=+0.33144*TPK%K091(:)*PCONC(:,3)+0.56070*TPK%K105(:)*PCONC(:,33)+& -&0.71461*TPK%K111(:)*PCONC(:,40)+0.33743*TPK%K120(:)*PCONC(:,5) -! -!ALD/ALKEP=+0.42125*K092*<NO>+0.46413*K106*<MO2>+0.68374*K112*<CARBOP>+0.43039* -!K121*<NO3> - PJAC(:,24,35)=+0.42125*TPK%K092(:)*PCONC(:,3)+0.46413*TPK%K106(:)*PCONC(:,33)+& -&0.68374*TPK%K112(:)*PCONC(:,40)+0.43039*TPK%K121(:)*PCONC(:,5) -! -!ALD/BIOP=+0.00000*K093*<NO>+0.00000*K107*<MO2>+0.00000*K113*<CARBOP>+0.00000*K -!122*<NO3> - PJAC(:,24,36)=+0.00000*TPK%K093(:)*PCONC(:,3)+0.00000*TPK%K107(:)*PCONC(:,33)+& -&0.00000*TPK%K113(:)*PCONC(:,40)+0.00000*TPK%K122(:)*PCONC(:,5) -! -!ALD/PHO=0.0 -! -!ALD/ADD=0.0 -! -!ALD/AROP=0.0 -! -!ALD/CARBOP=+0.07368*K095*<NO>+0.08295*K109*<MO2>+0.71461*K111*<ALKAP>+0.68374* -!K112*<ALKEP>+0.00000*K113*<BIOP>+0.06969*K115*<CARBOP>+0.06969*K115*<CARBOP>+0 -!.42122*K116*<OLN>+0.02936*K124*<NO3> - PJAC(:,24,40)=+0.07368*TPK%K095(:)*PCONC(:,3)+0.08295*TPK%K109(:)*PCONC(:,33)+& -&0.71461*TPK%K111(:)*PCONC(:,34)+0.68374*TPK%K112(:)*PCONC(:,35)+0.00000*TPK%K1& -&13(:)*PCONC(:,36)+0.06969*TPK%K115(:)*PCONC(:,40)+0.06969*TPK%K115(:)*PCONC(:,& -&40)+0.42122*TPK%K116(:)*PCONC(:,41)+0.02936*TPK%K124(:)*PCONC(:,5) -! -!ALD/OLN=+1.01182*K096*<NO>+0.41524*K110*<MO2>+0.42122*K116*<CARBOP>+0.00000*K1 -!18*<OLN>+0.00000*K118*<OLN>+0.91850*K125*<NO3> - PJAC(:,24,41)=+1.01182*TPK%K096(:)*PCONC(:,3)+0.41524*TPK%K110(:)*PCONC(:,33)+& -&0.42122*TPK%K116(:)*PCONC(:,40)+0.00000*TPK%K118(:)*PCONC(:,41)+0.00000*TPK%K1& -&18(:)*PCONC(:,41)+0.91850*TPK%K125(:)*PCONC(:,5) -! -!ALD/XO2=0.0 -! -!KET/O3=+0.07377*K079*<ALKE>+0.00000*K080*<BIO> - PJAC(:,25,1)=+0.07377*TPK%K079(:)*PCONC(:,20)+0.00000*TPK%K080(:)*PCONC(:,21) -! -!KET/H2O2=0.0 -! -!KET/NO=+0.54531*K091*<ALKAP>+0.05220*K092*<ALKEP>+0.00000*K093*<BIOP>+0.37862* -!K096*<OLN> - PJAC(:,25,3)=+0.54531*TPK%K091(:)*PCONC(:,34)+0.05220*TPK%K092(:)*PCONC(:,35)+& -&0.00000*TPK%K093(:)*PCONC(:,36)+0.37862*TPK%K096(:)*PCONC(:,41) -! -!KET/NO2=0.0 -! -!KET/NO3=+0.00632*K074*<CARBO>+0.62978*K120*<ALKAP>+0.02051*K121*<ALKEP>+0.0000 -!0*K122*<BIOP>+0.34740*K125*<OLN> - PJAC(:,25,5)=+0.00632*TPK%K074(:)*PCONC(:,26)+0.62978*TPK%K120(:)*PCONC(:,34)+& -&0.02051*TPK%K121(:)*PCONC(:,35)+0.00000*TPK%K122(:)*PCONC(:,36)+0.34740*TPK%K1& -&25(:)*PCONC(:,41) -! -!KET/N2O5=0.0 -! -!KET/HONO=0.0 -! -!KET/HNO3=0.0 -! -!KET/HNO4=0.0 -! -!KET/NH3=0.0 -! -!KET/DMS=0.0 -! -!KET/SO2=0.0 -! -!KET/SULF=0.0 -! -!KET/CO=0.0 -! -!KET/OH=+0.03498*K058*<ALKA>-K064*<KET>+0.00853*K065*<CARBO>+0.37591*K069*<OP2> - PJAC(:,25,15)=+0.03498*TPK%K058(:)*PCONC(:,19)-TPK%K064(:)*PCONC(:,25)+0.00853& -&*TPK%K065(:)*PCONC(:,26)+0.37591*TPK%K069(:)*PCONC(:,30) -! -!KET/HO2=0.0 -! -!KET/CH4=0.0 -! -!KET/ETH=0.0 -! -!KET/ALKA=+0.03498*K058*<OH> - PJAC(:,25,19)=+0.03498*TPK%K058(:)*PCONC(:,15) -! -!KET/ALKE=+0.07377*K079*<O3> - PJAC(:,25,20)=+0.07377*TPK%K079(:)*PCONC(:,1) -! -!KET/BIO=+0.00000*K080*<O3> - PJAC(:,25,21)=+0.00000*TPK%K080(:)*PCONC(:,1) -! -!KET/ARO=0.0 -! -!KET/HCHO=0.0 -! -!KET/ALD=0.0 -! -!KET/KET=-K015-K064*<OH> - PJAC(:,25,25)=-TPK%K015(:)-TPK%K064(:)*PCONC(:,15) -! -!KET/CARBO=+0.00853*K065*<OH>+0.00632*K074*<NO3> - PJAC(:,25,26)=+0.00853*TPK%K065(:)*PCONC(:,15)+0.00632*TPK%K074(:)*PCONC(:,5) -! -!KET/ONIT=+0.80*K017 - PJAC(:,25,27)=+0.80*TPK%K017(:) -! -!KET/PAN=0.0 -! -!KET/OP1=0.0 -! -!KET/OP2=+0.37591*K069*<OH> - PJAC(:,25,30)=+0.37591*TPK%K069(:)*PCONC(:,15) -! -!KET/ORA1=0.0 -! -!KET/ORA2=0.0 -! -!KET/MO2=+0.09673*K105*<ALKAP>+0.03814*K106*<ALKEP>+0.00000*K107*<BIOP>+0.09667 -!*K110*<OLN> - PJAC(:,25,33)=+0.09673*TPK%K105(:)*PCONC(:,34)+0.03814*TPK%K106(:)*PCONC(:,35)& -&+0.00000*TPK%K107(:)*PCONC(:,36)+0.09667*TPK%K110(:)*PCONC(:,41) -! -!KET/ALKAP=+0.54531*K091*<NO>+0.09673*K105*<MO2>+0.18819*K111*<CARBOP>+0.62978* -!K120*<NO3> - PJAC(:,25,34)=+0.54531*TPK%K091(:)*PCONC(:,3)+0.09673*TPK%K105(:)*PCONC(:,33)+& -&0.18819*TPK%K111(:)*PCONC(:,40)+0.62978*TPK%K120(:)*PCONC(:,5) -! -!KET/ALKEP=+0.05220*K092*<NO>+0.03814*K106*<MO2>+0.06579*K112*<CARBOP>+0.02051* -!K121*<NO3> - PJAC(:,25,35)=+0.05220*TPK%K092(:)*PCONC(:,3)+0.03814*TPK%K106(:)*PCONC(:,33)+& -&0.06579*TPK%K112(:)*PCONC(:,40)+0.02051*TPK%K121(:)*PCONC(:,5) -! -!KET/BIOP=+0.00000*K093*<NO>+0.00000*K107*<MO2>+0.00000*K113*<CARBOP>+0.00000*K -!122*<NO3> - PJAC(:,25,36)=+0.00000*TPK%K093(:)*PCONC(:,3)+0.00000*TPK%K107(:)*PCONC(:,33)+& -&0.00000*TPK%K113(:)*PCONC(:,40)+0.00000*TPK%K122(:)*PCONC(:,5) -! -!KET/PHO=0.0 -! -!KET/ADD=0.0 -! -!KET/AROP=0.0 -! -!KET/CARBOP=+0.18819*K111*<ALKAP>+0.06579*K112*<ALKEP>+0.00000*K113*<BIOP>+0.02 -!190*K115*<CARBOP>+0.02190*K115*<CARBOP>+0.10822*K116*<OLN> - PJAC(:,25,40)=+0.18819*TPK%K111(:)*PCONC(:,34)+0.06579*TPK%K112(:)*PCONC(:,35)& -&+0.00000*TPK%K113(:)*PCONC(:,36)+0.02190*TPK%K115(:)*PCONC(:,40)+0.02190*TPK%K& -&115(:)*PCONC(:,40)+0.10822*TPK%K116(:)*PCONC(:,41) -! -!KET/OLN=+0.37862*K096*<NO>+0.09667*K110*<MO2>+0.10822*K116*<CARBOP>+0.00000*K1 -!18*<OLN>+0.00000*K118*<OLN>+0.34740*K125*<NO3> - PJAC(:,25,41)=+0.37862*TPK%K096(:)*PCONC(:,3)+0.09667*TPK%K110(:)*PCONC(:,33)+& -&0.10822*TPK%K116(:)*PCONC(:,40)+0.00000*TPK%K118(:)*PCONC(:,41)+0.00000*TPK%K1& -&18(:)*PCONC(:,41)+0.34740*TPK%K125(:)*PCONC(:,5) -! -!KET/XO2=0.0 -! -RETURN -END SUBROUTINE SUBJ4 -! -SUBROUTINE SUBJ5 -! -!Indices 26 a 30 -! -! -!CARBO/O3=+0.00000*K079*<ALKE>+0.39754*K080*<BIO>+1.07583*K081*<CARBO>-K081*<CA -!RBO> - PJAC(:,26,1)=+0.00000*TPK%K079(:)*PCONC(:,20)+0.39754*TPK%K080(:)*PCONC(:,21)+& -&1.07583*TPK%K081(:)*PCONC(:,26)-TPK%K081(:)*PCONC(:,26) -! -!CARBO/H2O2=0.0 -! -!CARBO/NO=+0.03407*K091*<ALKAP>+0.45463*K093*<BIOP>+2.06993*K094*<AROP>+0.08670 -!*K095*<CARBOP> - PJAC(:,26,3)=+0.03407*TPK%K091(:)*PCONC(:,34)+0.45463*TPK%K093(:)*PCONC(:,36)+& -&2.06993*TPK%K094(:)*PCONC(:,39)+0.08670*TPK%K095(:)*PCONC(:,40) -! -!CARBO/NO2=0.0 -! -!CARBO/NO3=+0.10530*K074*<CARBO>-K074*<CARBO>+0.00000*K076*<ALKE>+0.91741*K077* -!<BIO>+0.03531*K120*<ALKAP>+0.61160*K122*<BIOP>+2.81904*K123*<AROP>+0.03455*K12 -!4*<CARBOP> - PJAC(:,26,5)=+0.10530*TPK%K074(:)*PCONC(:,26)-TPK%K074(:)*PCONC(:,26)+0.00000*& -&TPK%K076(:)*PCONC(:,20)+0.91741*TPK%K077(:)*PCONC(:,21)+0.03531*TPK%K120(:)*PC& -&ONC(:,34)+0.61160*TPK%K122(:)*PCONC(:,36)+2.81904*TPK%K123(:)*PCONC(:,39)+0.03& -&455*TPK%K124(:)*PCONC(:,40) -! -!CARBO/N2O5=0.0 -! -!CARBO/HONO=0.0 -! -!CARBO/HNO3=0.0 -! -!CARBO/HNO4=0.0 -! -!CARBO/NH3=0.0 -! -!CARBO/DMS=0.0 -! -!CARBO/SO2=0.0 -! -!CARBO/SULF=0.0 -! -!CARBO/CO=0.0 -! -!CARBO/OH=+0.00835*K058*<ALKA>+0.16919*K065*<CARBO>-K065*<CARBO>+0.21863*K070*< -!PAN> - PJAC(:,26,15)=+0.00835*TPK%K058(:)*PCONC(:,19)+0.16919*TPK%K065(:)*PCONC(:,26)& -&-TPK%K065(:)*PCONC(:,26)+0.21863*TPK%K070(:)*PCONC(:,28) -! -!CARBO/HO2=0.0 -! -!CARBO/CH4=0.0 -! -!CARBO/ETH=0.0 -! -!CARBO/ALKA=+0.00835*K058*<OH> - PJAC(:,26,19)=+0.00835*TPK%K058(:)*PCONC(:,15) -! -!CARBO/ALKE=+0.00000*K076*<NO3>+0.00000*K079*<O3> - PJAC(:,26,20)=+0.00000*TPK%K076(:)*PCONC(:,5)+0.00000*TPK%K079(:)*PCONC(:,1) -! -!CARBO/BIO=+0.13255*K054*<O3P>+0.91741*K077*<NO3>+0.39754*K080*<O3> - PJAC(:,26,21)=+0.13255*TPK%K054(:)*TPK%O3P(:)+0.91741*TPK%K077(:)*PCONC(:,5)+0& -&.39754*TPK%K080(:)*PCONC(:,1) -! -!CARBO/ARO=0.0 -! -!CARBO/HCHO=0.0 -! -!CARBO/ALD=0.0 -! -!CARBO/KET=0.0 -! -!CARBO/CARBO=-K016-K055*<O3P>+0.16919*K065*<OH>-K065*<OH>+0.10530*K074*<NO3>-K0 -!74*<NO3>+1.07583*K081*<O3>-K081*<O3> - PJAC(:,26,26)=-TPK%K016(:)-TPK%K055(:)*TPK%O3P(:)+0.16919*TPK%K065(:)*PCONC(:,& -&15)-TPK%K065(:)*PCONC(:,15)+0.10530*TPK%K074(:)*PCONC(:,5)-TPK%K074(:)*PCONC(:& -&,5)+1.07583*TPK%K081(:)*PCONC(:,1)-TPK%K081(:)*PCONC(:,1) -! -!CARBO/ONIT=0.0 -! -!CARBO/PAN=+0.21863*K070*<OH> - PJAC(:,26,28)=+0.21863*TPK%K070(:)*PCONC(:,15) -! -!CARBO/OP1=0.0 -! -!CARBO/OP2=0.0 -! -!CARBO/ORA1=0.0 -! -!CARBO/ORA2=0.0 -! -!CARBO/MO2=+0.07976*K105*<ALKAP>+0.56064*K107*<BIOP>+1.99461*K108*<AROP>+0.1538 -!7*K109*<CARBOP> - PJAC(:,26,33)=+0.07976*TPK%K105(:)*PCONC(:,34)+0.56064*TPK%K107(:)*PCONC(:,36)& -&+1.99461*TPK%K108(:)*PCONC(:,39)+0.15387*TPK%K109(:)*PCONC(:,40) -! -!CARBO/ALKAP=+0.03407*K091*<NO>+0.07976*K105*<MO2>+0.06954*K111*<CARBOP>+0.0353 -!1*K120*<NO3> - PJAC(:,26,34)=+0.03407*TPK%K091(:)*PCONC(:,3)+0.07976*TPK%K105(:)*PCONC(:,33)+& -&0.06954*TPK%K111(:)*PCONC(:,40)+0.03531*TPK%K120(:)*PCONC(:,5) -! -!CARBO/ALKEP=0.0 -! -!CARBO/BIOP=+0.45463*K093*<NO>+0.56064*K107*<MO2>+0.78591*K113*<CARBOP>+0.61160 -!*K122*<NO3> - PJAC(:,26,36)=+0.45463*TPK%K093(:)*PCONC(:,3)+0.56064*TPK%K107(:)*PCONC(:,33)+& -&0.78591*TPK%K113(:)*PCONC(:,40)+0.61160*TPK%K122(:)*PCONC(:,5) -! -!CARBO/PHO=0.0 -! -!CARBO/ADD=0.0 -! -!CARBO/AROP=+2.06993*K094*<NO>+1.99461*K108*<MO2>+1.99455*K114*<CARBOP>+2.81904 -!*K123*<NO3> - PJAC(:,26,39)=+2.06993*TPK%K094(:)*PCONC(:,3)+1.99461*TPK%K108(:)*PCONC(:,33)+& -&1.99455*TPK%K114(:)*PCONC(:,40)+2.81904*TPK%K123(:)*PCONC(:,5) -! -!CARBO/CARBOP=+0.08670*K095*<NO>+0.15387*K109*<MO2>+0.06954*K111*<ALKAP>+0.7859 -!1*K113*<BIOP>+1.99455*K114*<AROP>+0.10777*K115*<CARBOP>+0.10777*K115*<CARBOP>+ -!0.03455*K124*<NO3> - PJAC(:,26,40)=+0.08670*TPK%K095(:)*PCONC(:,3)+0.15387*TPK%K109(:)*PCONC(:,33)+& -&0.06954*TPK%K111(:)*PCONC(:,34)+0.78591*TPK%K113(:)*PCONC(:,36)+1.99455*TPK%K1& -&14(:)*PCONC(:,39)+0.10777*TPK%K115(:)*PCONC(:,40)+0.10777*TPK%K115(:)*PCONC(:,& -&40)+0.03455*TPK%K124(:)*PCONC(:,5) -! -!CARBO/OLN=0.0 -! -!CARBO/XO2=0.0 -! -!ONIT/O3=0.0 -! -!ONIT/H2O2=0.0 -! -!ONIT/NO=+0.08459*K091*<ALKAP>+0.15300*K093*<BIOP>+0.04885*K094*<AROP>+0.18401* -!K096*<OLN> - PJAC(:,27,3)=+0.08459*TPK%K091(:)*PCONC(:,34)+0.15300*TPK%K093(:)*PCONC(:,36)+& -&0.04885*TPK%K094(:)*PCONC(:,39)+0.18401*TPK%K096(:)*PCONC(:,41) -! -!ONIT/NO2=+K083*<PHO> - PJAC(:,27,4)=+TPK%K083(:)*PCONC(:,37) -! -!ONIT/NO3=+0.60*K078*<PAN>+0.25928*K125*<OLN> - PJAC(:,27,5)=+0.60*TPK%K078(:)*PCONC(:,28)+0.25928*TPK%K125(:)*PCONC(:,41) -! -!ONIT/N2O5=0.0 -! -!ONIT/HONO=0.0 -! -!ONIT/HNO3=0.0 -! -!ONIT/HNO4=0.0 -! -!ONIT/NH3=0.0 -! -!ONIT/DMS=0.0 -! -!ONIT/SO2=0.0 -! -!ONIT/SULF=0.0 -! -!ONIT/CO=0.0 -! -!ONIT/OH=-K071*<ONIT> - PJAC(:,27,15)=-TPK%K071(:)*PCONC(:,27) -! -!ONIT/HO2=+K103*<OLN> - PJAC(:,27,16)=+TPK%K103(:)*PCONC(:,41) -! -!ONIT/CH4=0.0 -! -!ONIT/ETH=0.0 -! -!ONIT/ALKA=0.0 -! -!ONIT/ALKE=0.0 -! -!ONIT/BIO=0.0 -! -!ONIT/ARO=0.0 -! -!ONIT/HCHO=0.0 -! -!ONIT/ALD=0.0 -! -!ONIT/KET=0.0 -! -!ONIT/CARBO=0.0 -! -!ONIT/ONIT=-K017-K071*<OH> - PJAC(:,27,27)=-TPK%K017(:)-TPK%K071(:)*PCONC(:,15) -! -!ONIT/PAN=+0.60*K078*<NO3> - PJAC(:,27,28)=+0.60*TPK%K078(:)*PCONC(:,5) -! -!ONIT/OP1=0.0 -! -!ONIT/OP2=0.0 -! -!ONIT/ORA1=0.0 -! -!ONIT/ORA2=0.0 -! -!ONIT/MO2=+0.67560*K110*<OLN> - PJAC(:,27,33)=+0.67560*TPK%K110(:)*PCONC(:,41) -! -!ONIT/ALKAP=+0.08459*K091*<NO> - PJAC(:,27,34)=+0.08459*TPK%K091(:)*PCONC(:,3) -! -!ONIT/ALKEP=0.0 -! -!ONIT/BIOP=+0.15300*K093*<NO> - PJAC(:,27,36)=+0.15300*TPK%K093(:)*PCONC(:,3) -! -!ONIT/PHO=+K083*<NO2> - PJAC(:,27,37)=+TPK%K083(:)*PCONC(:,4) -! -!ONIT/ADD=0.0 -! -!ONIT/AROP=+0.04885*K094*<NO> - PJAC(:,27,39)=+0.04885*TPK%K094(:)*PCONC(:,3) -! -!ONIT/CARBOP=+0.66562*K116*<OLN> - PJAC(:,27,40)=+0.66562*TPK%K116(:)*PCONC(:,41) -! -!ONIT/OLN=+0.18401*K096*<NO>+K103*<HO2>+0.67560*K110*<MO2>+0.66562*K116*<CARBOP -!>+2.00*K117*<OLN>+2.00*K117*<OLN>+0.00000*K118*<OLN>+0.00000*K118*<OLN>+0.2592 -!8*K125*<NO3> - PJAC(:,27,41)=+0.18401*TPK%K096(:)*PCONC(:,3)+TPK%K103(:)*PCONC(:,16)+0.67560*& -&TPK%K110(:)*PCONC(:,33)+0.66562*TPK%K116(:)*PCONC(:,40)+2.00*TPK%K117(:)*PCONC& -&(:,41)+2.00*TPK%K117(:)*PCONC(:,41)+0.00000*TPK%K118(:)*PCONC(:,41)+0.00000*TP& -&K%K118(:)*PCONC(:,41)+0.25928*TPK%K125(:)*PCONC(:,5) -! -!ONIT/XO2=0.0 -! -!PAN/O3=+0.30000*K082*<PAN>-K082*<PAN> - PJAC(:,28,1)=+0.30000*TPK%K082(:)*PCONC(:,28)-TPK%K082(:)*PCONC(:,28) -! -!PAN/H2O2=0.0 -! -!PAN/NO=0.0 -! -!PAN/NO2=+1.00000*K088*<CARBOP> - PJAC(:,28,4)=+1.00000*TPK%K088(:)*PCONC(:,40) -! -!PAN/NO3=+0.40000*K078*<PAN>-K078*<PAN> - PJAC(:,28,5)=+0.40000*TPK%K078(:)*PCONC(:,28)-TPK%K078(:)*PCONC(:,28) -! -!PAN/N2O5=0.0 -! -!PAN/HONO=0.0 -! -!PAN/HNO3=0.0 -! -!PAN/HNO4=0.0 -! -!PAN/NH3=0.0 -! -!PAN/DMS=0.0 -! -!PAN/SO2=0.0 -! -!PAN/SULF=0.0 -! -!PAN/CO=0.0 -! -!PAN/OH=+0.28107*K070*<PAN>-K070*<PAN> - PJAC(:,28,15)=+0.28107*TPK%K070(:)*PCONC(:,28)-TPK%K070(:)*PCONC(:,28) -! -!PAN/HO2=0.0 -! -!PAN/CH4=0.0 -! -!PAN/ETH=0.0 -! -!PAN/ALKA=0.0 -! -!PAN/ALKE=0.0 -! -!PAN/BIO=0.0 -! -!PAN/ARO=0.0 -! -!PAN/HCHO=0.0 -! -!PAN/ALD=0.0 -! -!PAN/KET=0.0 -! -!PAN/CARBO=0.0 -! -!PAN/ONIT=0.0 -! -!PAN/PAN=+0.28107*K070*<OH>-K070*<OH>+0.40000*K078*<NO3>-K078*<NO3>+0.30000*K08 -!2*<O3>-K082*<O3>-K089 - PJAC(:,28,28)=+0.28107*TPK%K070(:)*PCONC(:,15)-TPK%K070(:)*PCONC(:,15)+0.40000& -&*TPK%K078(:)*PCONC(:,5)-TPK%K078(:)*PCONC(:,5)+0.30000*TPK%K082(:)*PCONC(:,1)-& -&TPK%K082(:)*PCONC(:,1)-TPK%K089(:) -! -!PAN/OP1=0.0 -! -!PAN/OP2=0.0 -! -!PAN/ORA1=0.0 -! -!PAN/ORA2=0.0 -! -!PAN/MO2=0.0 -! -!PAN/ALKAP=0.0 -! -!PAN/ALKEP=0.0 -! -!PAN/BIOP=0.0 -! -!PAN/PHO=0.0 -! -!PAN/ADD=0.0 -! -!PAN/AROP=0.0 -! -!PAN/CARBOP=+1.00000*K088*<NO2> - PJAC(:,28,40)=+1.00000*TPK%K088(:)*PCONC(:,4) -! -!PAN/OLN=0.0 -! -!PAN/XO2=0.0 -! -!OP1/O3=0.0 -! -!OP1/H2O2=0.0 -! -!OP1/NO=0.0 -! -!OP1/NO2=0.0 -! -!OP1/NO3=0.0 -! -!OP1/N2O5=0.0 -! -!OP1/HONO=0.0 -! -!OP1/HNO3=0.0 -! -!OP1/HNO4=0.0 -! -!OP1/NH3=0.0 -! -!OP1/DMS=0.0 -! -!OP1/SO2=0.0 -! -!OP1/SULF=0.0 -! -!OP1/CO=0.0 -! -!OP1/OH=-K068*<OP1> - PJAC(:,29,15)=-TPK%K068(:)*PCONC(:,29) -! -!OP1/HO2=+K097*<MO2> - PJAC(:,29,16)=+TPK%K097(:)*PCONC(:,33) -! -!OP1/CH4=0.0 -! -!OP1/ETH=0.0 -! -!OP1/ALKA=0.0 -! -!OP1/ALKE=0.0 -! -!OP1/BIO=0.0 -! -!OP1/ARO=0.0 -! -!OP1/HCHO=0.0 -! -!OP1/ALD=0.0 -! -!OP1/KET=0.0 -! -!OP1/CARBO=0.0 -! -!OP1/ONIT=0.0 -! -!OP1/PAN=0.0 -! -!OP1/OP1=-K013-K068*<OH> - PJAC(:,29,29)=-TPK%K013(:)-TPK%K068(:)*PCONC(:,15) -! -!OP1/OP2=0.0 -! -!OP1/ORA1=0.0 -! -!OP1/ORA2=0.0 -! -!OP1/MO2=+K097*<HO2> - PJAC(:,29,33)=+TPK%K097(:)*PCONC(:,16) -! -!OP1/ALKAP=0.0 -! -!OP1/ALKEP=0.0 -! -!OP1/BIOP=0.0 -! -!OP1/PHO=0.0 -! -!OP1/ADD=0.0 -! -!OP1/AROP=0.0 -! -!OP1/CARBOP=0.0 -! -!OP1/OLN=0.0 -! -!OP1/XO2=0.0 -! -!OP2/O3=+0.10149*K081*<CARBO> - PJAC(:,30,1)=+0.10149*TPK%K081(:)*PCONC(:,26) -! -!OP2/H2O2=0.0 -! -!OP2/NO=0.0 -! -!OP2/NO2=0.0 -! -!OP2/NO3=0.0 -! -!OP2/N2O5=0.0 -! -!OP2/HONO=0.0 -! -!OP2/HNO3=0.0 -! -!OP2/HNO4=0.0 -! -!OP2/NH3=0.0 -! -!OP2/DMS=0.0 -! -!OP2/SO2=0.0 -! -!OP2/SULF=0.0 -! -!OP2/CO=0.0 -! -!OP2/OH=-K069*<OP2> - PJAC(:,30,15)=-TPK%K069(:)*PCONC(:,30) -! -!OP2/HO2=+1.00524*K098*<ALKAP>+1.00524*K099*<ALKEP>+1.00524*K0100*<BIOP>+1.0052 -!4*K0101*<AROP>+0.80904*K0102*<CARBOP>+1.00524*K126*<XO2> - PJAC(:,30,16)=+1.00524*TPK%K098(:)*PCONC(:,34)+1.00524*TPK%K099(:)*PCONC(:,35)& -&+1.00524*TPK%K0100(:)*PCONC(:,36)+1.00524*TPK%K0101(:)*PCONC(:,39)+0.80904*TPK& -&%K0102(:)*PCONC(:,40)+1.00524*TPK%K126(:)*PCONC(:,42) -! -!OP2/CH4=0.0 -! -!OP2/ETH=0.0 -! -!OP2/ALKA=0.0 -! -!OP2/ALKE=0.0 -! -!OP2/BIO=0.0 -! -!OP2/ARO=0.0 -! -!OP2/HCHO=0.0 -! -!OP2/ALD=0.0 -! -!OP2/KET=0.0 -! -!OP2/CARBO=+0.10149*K081*<O3> - PJAC(:,30,26)=+0.10149*TPK%K081(:)*PCONC(:,1) -! -!OP2/ONIT=0.0 -! -!OP2/PAN=0.0 -! -!OP2/OP1=0.0 -! -!OP2/OP2=-K014-K069*<OH> - PJAC(:,30,30)=-TPK%K014(:)-TPK%K069(:)*PCONC(:,15) -! -!OP2/ORA1=0.0 -! -!OP2/ORA2=0.0 -! -!OP2/MO2=0.0 -! -!OP2/ALKAP=+1.00524*K098*<HO2> - PJAC(:,30,34)=+1.00524*TPK%K098(:)*PCONC(:,16) -! -!OP2/ALKEP=+1.00524*K099*<HO2> - PJAC(:,30,35)=+1.00524*TPK%K099(:)*PCONC(:,16) -! -!OP2/BIOP=+1.00524*K0100*<HO2> - PJAC(:,30,36)=+1.00524*TPK%K0100(:)*PCONC(:,16) -! -!OP2/PHO=0.0 -! -!OP2/ADD=0.0 -! -!OP2/AROP=+1.00524*K0101*<HO2> - PJAC(:,30,39)=+1.00524*TPK%K0101(:)*PCONC(:,16) -! -!OP2/CARBOP=+0.80904*K0102*<HO2> - PJAC(:,30,40)=+0.80904*TPK%K0102(:)*PCONC(:,16) -! -!OP2/OLN=0.0 -! -!OP2/XO2=+1.00524*K126*<HO2> - PJAC(:,30,42)=+1.00524*TPK%K126(:)*PCONC(:,16) -! -RETURN -END SUBROUTINE SUBJ5 -! -SUBROUTINE SUBJ6 -! -!Indices 31 a 35 -! -! -!ORA1/O3=+0.15343*K079*<ALKE>+0.15000*K080*<BIO>+0.10788*K081*<CARBO>+0.11*K082 -!*<PAN> - PJAC(:,31,1)=+0.15343*TPK%K079(:)*PCONC(:,20)+0.15000*TPK%K080(:)*PCONC(:,21)+& -&0.10788*TPK%K081(:)*PCONC(:,26)+0.11*TPK%K082(:)*PCONC(:,28) -! -!ORA1/H2O2=0.0 -! -!ORA1/NO=0.0 -! -!ORA1/NO2=0.0 -! -!ORA1/NO3=0.0 -! -!ORA1/N2O5=0.0 -! -!ORA1/HONO=0.0 -! -!ORA1/HNO3=0.0 -! -!ORA1/HNO4=0.0 -! -!ORA1/NH3=0.0 -! -!ORA1/DMS=0.0 -! -!ORA1/SO2=0.0 -! -!ORA1/SULF=0.0 -! -!ORA1/CO=0.0 -! -!ORA1/OH=+0.00878*K058*<ALKA>-K066*<ORA1> - PJAC(:,31,15)=+0.00878*TPK%K058(:)*PCONC(:,19)-TPK%K066(:)*PCONC(:,31) -! -!ORA1/HO2=0.0 -! -!ORA1/CH4=0.0 -! -!ORA1/ETH=0.0 -! -!ORA1/ALKA=+0.00878*K058*<OH> - PJAC(:,31,19)=+0.00878*TPK%K058(:)*PCONC(:,15) -! -!ORA1/ALKE=+0.15343*K079*<O3> - PJAC(:,31,20)=+0.15343*TPK%K079(:)*PCONC(:,1) -! -!ORA1/BIO=+0.15000*K080*<O3> - PJAC(:,31,21)=+0.15000*TPK%K080(:)*PCONC(:,1) -! -!ORA1/ARO=0.0 -! -!ORA1/HCHO=0.0 -! -!ORA1/ALD=0.0 -! -!ORA1/KET=0.0 -! -!ORA1/CARBO=+0.10788*K081*<O3> - PJAC(:,31,26)=+0.10788*TPK%K081(:)*PCONC(:,1) -! -!ORA1/ONIT=0.0 -! -!ORA1/PAN=+0.11*K082*<O3> - PJAC(:,31,28)=+0.11*TPK%K082(:)*PCONC(:,1) -! -!ORA1/OP1=0.0 -! -!ORA1/OP2=0.0 -! -!ORA1/ORA1=-K066*<OH> - PJAC(:,31,31)=-TPK%K066(:)*PCONC(:,15) -! -!ORA1/ORA2=0.0 -! -!ORA1/MO2=0.0 -! -!ORA1/ALKAP=0.0 -! -!ORA1/ALKEP=0.0 -! -!ORA1/BIOP=0.0 -! -!ORA1/PHO=0.0 -! -!ORA1/ADD=0.0 -! -!ORA1/AROP=0.0 -! -!ORA1/CARBOP=0.0 -! -!ORA1/OLN=0.0 -! -!ORA1/XO2=0.0 -! -!ORA2/O3=+0.08143*K079*<ALKE>+0.00000*K080*<BIO>+0.20595*K081*<CARBO> - PJAC(:,32,1)=+0.08143*TPK%K079(:)*PCONC(:,20)+0.00000*TPK%K080(:)*PCONC(:,21)+& -&0.20595*TPK%K081(:)*PCONC(:,26) -! -!ORA2/H2O2=0.0 -! -!ORA2/NO=0.0 -! -!ORA2/NO2=0.0 -! -!ORA2/NO3=0.0 -! -!ORA2/N2O5=0.0 -! -!ORA2/HONO=0.0 -! -!ORA2/HNO3=0.0 -! -!ORA2/HNO4=0.0 -! -!ORA2/NH3=0.0 -! -!ORA2/DMS=0.0 -! -!ORA2/SO2=0.0 -! -!ORA2/SULF=0.0 -! -!ORA2/CO=0.0 -! -!ORA2/OH=-K067*<ORA2> - PJAC(:,32,15)=-TPK%K067(:)*PCONC(:,32) -! -!ORA2/HO2=+0.17307*K0102*<CARBOP> - PJAC(:,32,16)=+0.17307*TPK%K0102(:)*PCONC(:,40) -! -!ORA2/CH4=0.0 -! -!ORA2/ETH=0.0 -! -!ORA2/ALKA=0.0 -! -!ORA2/ALKE=+0.08143*K079*<O3> - PJAC(:,32,20)=+0.08143*TPK%K079(:)*PCONC(:,1) -! -!ORA2/BIO=+0.00000*K080*<O3> - PJAC(:,32,21)=+0.00000*TPK%K080(:)*PCONC(:,1) -! -!ORA2/ARO=0.0 -! -!ORA2/HCHO=0.0 -! -!ORA2/ALD=0.0 -! -!ORA2/KET=0.0 -! -!ORA2/CARBO=+0.20595*K081*<O3> - PJAC(:,32,26)=+0.20595*TPK%K081(:)*PCONC(:,1) -! -!ORA2/ONIT=0.0 -! -!ORA2/PAN=0.0 -! -!ORA2/OP1=0.0 -! -!ORA2/OP2=0.0 -! -!ORA2/ORA1=0.0 -! -!ORA2/ORA2=-K067*<OH> - PJAC(:,32,32)=-TPK%K067(:)*PCONC(:,15) -! -!ORA2/MO2=+0.13684*K109*<CARBOP> - PJAC(:,32,33)=+0.13684*TPK%K109(:)*PCONC(:,40) -! -!ORA2/ALKAP=+0.49810*K111*<CARBOP> - PJAC(:,32,34)=+0.49810*TPK%K111(:)*PCONC(:,40) -! -!ORA2/ALKEP=+0.49922*K112*<CARBOP> - PJAC(:,32,35)=+0.49922*TPK%K112(:)*PCONC(:,40) -! -!ORA2/BIOP=+0.49400*K113*<CARBOP> - PJAC(:,32,36)=+0.49400*TPK%K113(:)*PCONC(:,40) -! -!ORA2/PHO=0.0 -! -!ORA2/ADD=0.0 -! -!ORA2/AROP=0.0 -! -!ORA2/CARBOP=+0.17307*K0102*<HO2>+0.13684*K109*<MO2>+0.49810*K111*<ALKAP>+0.499 -!22*K112*<ALKEP>+0.49400*K113*<BIOP>+0.09955*K115*<CARBOP>+0.09955*K115*<CARBOP -!>+0.48963*K116*<OLN> - PJAC(:,32,40)=+0.17307*TPK%K0102(:)*PCONC(:,16)+0.13684*TPK%K109(:)*PCONC(:,33& -&)+0.49810*TPK%K111(:)*PCONC(:,34)+0.49922*TPK%K112(:)*PCONC(:,35)+0.49400*TPK%& -&K113(:)*PCONC(:,36)+0.09955*TPK%K115(:)*PCONC(:,40)+0.09955*TPK%K115(:)*PCONC(& -&:,40)+0.48963*TPK%K116(:)*PCONC(:,41) -! -!ORA2/OLN=+0.48963*K116*<CARBOP> - PJAC(:,32,41)=+0.48963*TPK%K116(:)*PCONC(:,40) -! -!ORA2/XO2=0.0 -! -!MO2/O3=+0.13966*K079*<ALKE>+0.03000*K080*<BIO> - PJAC(:,33,1)=+0.13966*TPK%K079(:)*PCONC(:,20)+0.03000*TPK%K080(:)*PCONC(:,21) -! -!MO2/H2O2=0.0 -! -!MO2/NO=-K090*<MO2>+0.09016*K091*<ALKAP>+0.78134*K095*<CARBOP> - PJAC(:,33,3)=-TPK%K090(:)*PCONC(:,33)+0.09016*TPK%K091(:)*PCONC(:,34)+0.78134*& -&TPK%K095(:)*PCONC(:,40) -! -!MO2/NO2=0.0 -! -!MO2/NO3=-K119*<MO2>+0.09731*K120*<ALKAP>+0.91910*K124*<CARBOP> - PJAC(:,33,5)=-TPK%K119(:)*PCONC(:,33)+0.09731*TPK%K120(:)*PCONC(:,34)+0.91910*& -&TPK%K124(:)*PCONC(:,40) -! -!MO2/N2O5=0.0 -! -!MO2/HONO=0.0 -! -!MO2/HNO3=0.0 -! -!MO2/HNO4=0.0 -! -!MO2/NH3=0.0 -! -!MO2/DMS=0.0 -! -!MO2/SO2=0.0 -! -!MO2/SULF=0.0 -! -!MO2/CO=0.0 -! -!MO2/OH=+K056*<CH4>+0.65*K068*<OP1> - PJAC(:,33,15)=+TPK%K056(:)*PCONC(:,17)+0.65*TPK%K068(:)*PCONC(:,29) -! -!MO2/HO2=-K097*<MO2> - PJAC(:,33,16)=-TPK%K097(:)*PCONC(:,33) -! -!MO2/CH4=+K056*<OH> - PJAC(:,33,17)=+TPK%K056(:)*PCONC(:,15) -! -!MO2/ETH=0.0 -! -!MO2/ALKA=0.0 -! -!MO2/ALKE=+0.13966*K079*<O3> - PJAC(:,33,20)=+0.13966*TPK%K079(:)*PCONC(:,1) -! -!MO2/BIO=+0.03000*K080*<O3> - PJAC(:,33,21)=+0.03000*TPK%K080(:)*PCONC(:,1) -! -!MO2/ARO=0.0 -! -!MO2/HCHO=0.0 -! -!MO2/ALD=+K012 - PJAC(:,33,24)=+TPK%K012(:) -! -!MO2/KET=0.0 -! -!MO2/CARBO=0.0 -! -!MO2/ONIT=0.0 -! -!MO2/PAN=0.0 -! -!MO2/OP1=+0.65*K068*<OH> - PJAC(:,33,29)=+0.65*TPK%K068(:)*PCONC(:,15) -! -!MO2/OP2=+0.03795*K014 - PJAC(:,33,30)=+0.03795*TPK%K014(:) -! -!MO2/ORA1=0.0 -! -!MO2/ORA2=0.0 -! -!MO2/MO2=-K090*<NO>-K097*<HO2>-K104*<MO2>-K104*<MO2>-K104*<MO2>-K104*<MO2>+0.01 -!390*K105*<ALKAP>-K105*<ALKAP>-K106*<ALKEP>-K107*<BIOP>-K108*<AROP>+0.56031*K10 -!9*<CARBOP>-K109*<CARBOP>-K110*<OLN>-K119*<NO3>-K127*<XO2> - PJAC(:,33,33)=-TPK%K090(:)*PCONC(:,3)-TPK%K097(:)*PCONC(:,16)-TPK%K104(:)*PCON& -&C(:,33)-TPK%K104(:)*PCONC(:,33)-TPK%K104(:)*PCONC(:,33)-TPK%K104(:)*PCONC(:,33& -&)+0.01390*TPK%K105(:)*PCONC(:,34)-TPK%K105(:)*PCONC(:,34)-TPK%K106(:)*PCONC(:,& -&35)-TPK%K107(:)*PCONC(:,36)-TPK%K108(:)*PCONC(:,39)+0.56031*TPK%K109(:)*PCONC(& -&:,40)-TPK%K109(:)*PCONC(:,40)-TPK%K110(:)*PCONC(:,41)-TPK%K119(:)*PCONC(:,5)-T& -&PK%K127(:)*PCONC(:,42) -! -!MO2/ALKAP=+0.09016*K091*<NO>+0.01390*K105*<MO2>-K105*<MO2>+0.51480*K111*<CARBO -!P>+0.09731*K120*<NO3> - PJAC(:,33,34)=+0.09016*TPK%K091(:)*PCONC(:,3)+0.01390*TPK%K105(:)*PCONC(:,33)-& -&TPK%K105(:)*PCONC(:,33)+0.51480*TPK%K111(:)*PCONC(:,40)+0.09731*TPK%K120(:)*PC& -&ONC(:,5) -! -!MO2/ALKEP=-K106*<MO2>+0.50078*K112*<CARBOP> - PJAC(:,33,35)=-TPK%K106(:)*PCONC(:,33)+0.50078*TPK%K112(:)*PCONC(:,40) -! -!MO2/BIOP=-K107*<MO2>+0.50600*K113*<CARBOP> - PJAC(:,33,36)=-TPK%K107(:)*PCONC(:,33)+0.50600*TPK%K113(:)*PCONC(:,40) -! -!MO2/PHO=0.0 -! -!MO2/ADD=0.0 -! -!MO2/AROP=-K108*<MO2>+K114*<CARBOP> - PJAC(:,33,39)=-TPK%K108(:)*PCONC(:,33)+TPK%K114(:)*PCONC(:,40) -! -!MO2/CARBOP=+0.78134*K095*<NO>+0.56031*K109*<MO2>-K109*<MO2>+0.51480*K111*<ALKA -!P>+0.50078*K112*<ALKEP>+0.50600*K113*<BIOP>+K114*<AROP>+1.66702*K115*<CARBOP>+ -!1.66702*K115*<CARBOP>+0.51037*K116*<OLN>+0.91910*K124*<NO3>+K128*<XO2> - PJAC(:,33,40)=+0.78134*TPK%K095(:)*PCONC(:,3)+0.56031*TPK%K109(:)*PCONC(:,33)-& -&TPK%K109(:)*PCONC(:,33)+0.51480*TPK%K111(:)*PCONC(:,34)+0.50078*TPK%K112(:)*PC& -&ONC(:,35)+0.50600*TPK%K113(:)*PCONC(:,36)+TPK%K114(:)*PCONC(:,39)+1.66702*TPK%& -&K115(:)*PCONC(:,40)+1.66702*TPK%K115(:)*PCONC(:,40)+0.51037*TPK%K116(:)*PCONC(& -&:,41)+0.91910*TPK%K124(:)*PCONC(:,5)+TPK%K128(:)*PCONC(:,42) -! -!MO2/OLN=-K110*<MO2>+0.51037*K116*<CARBOP> - PJAC(:,33,41)=-TPK%K110(:)*PCONC(:,33)+0.51037*TPK%K116(:)*PCONC(:,40) -! -!MO2/XO2=-K127*<MO2>+K128*<CARBOP> - PJAC(:,33,42)=-TPK%K127(:)*PCONC(:,33)+TPK%K128(:)*PCONC(:,40) -! -!ALKAP/O3=+0.09815*K079*<ALKE>+0.00000*K080*<BIO> - PJAC(:,34,1)=+0.09815*TPK%K079(:)*PCONC(:,20)+0.00000*TPK%K080(:)*PCONC(:,21) -! -!ALKAP/H2O2=0.0 -! -!ALKAP/NO=+0.08187*K091*<ALKAP>-K091*<ALKAP> - PJAC(:,34,3)=+0.08187*TPK%K091(:)*PCONC(:,34)-TPK%K091(:)*PCONC(:,34) -! -!ALKAP/NO2=0.0 -! -!ALKAP/NO3=+0.08994*K120*<ALKAP>-K120*<ALKAP> - PJAC(:,34,5)=+0.08994*TPK%K120(:)*PCONC(:,34)-TPK%K120(:)*PCONC(:,34) -! -!ALKAP/N2O5=0.0 -! -!ALKAP/HONO=0.0 -! -!ALKAP/HNO3=0.0 -! -!ALKAP/HNO4=0.0 -! -!ALKAP/NH3=0.0 -! -!ALKAP/DMS=0.0 -! -!ALKAP/SO2=0.0 -! -!ALKAP/SULF=0.0 -! -!ALKAP/CO=0.0 -! -!ALKAP/OH=+K057*<ETH>+0.87811*K058*<ALKA>+0.40341*K069*<OP2>+1.00000*K071*<ONIT -!> - PJAC(:,34,15)=+TPK%K057(:)*PCONC(:,18)+0.87811*TPK%K058(:)*PCONC(:,19)+0.40341& -&*TPK%K069(:)*PCONC(:,30)+1.00000*TPK%K071(:)*PCONC(:,27) -! -!ALKAP/HO2=-K098*<ALKAP> - PJAC(:,34,16)=-TPK%K098(:)*PCONC(:,34) -! -!ALKAP/CH4=0.0 -! -!ALKAP/ETH=+K057*<OH> - PJAC(:,34,18)=+TPK%K057(:)*PCONC(:,15) -! -!ALKAP/ALKA=+0.87811*K058*<OH> - PJAC(:,34,19)=+0.87811*TPK%K058(:)*PCONC(:,15) -! -!ALKAP/ALKE=+0.09815*K079*<O3> - PJAC(:,34,20)=+0.09815*TPK%K079(:)*PCONC(:,1) -! -!ALKAP/BIO=+0.00000*K080*<O3> - PJAC(:,34,21)=+0.00000*TPK%K080(:)*PCONC(:,1) -! -!ALKAP/ARO=0.0 -! -!ALKAP/HCHO=0.0 -! -!ALKAP/ALD=0.0 -! -!ALKAP/KET=+1.00000*K015 - PJAC(:,34,25)=+1.00000*TPK%K015(:) -! -!ALKAP/CARBO=0.0 -! -!ALKAP/ONIT=+1.00000*K071*<OH> - PJAC(:,34,27)=+1.00000*TPK%K071(:)*PCONC(:,15) -! -!ALKAP/PAN=0.0 -! -!ALKAP/OP1=0.0 -! -!ALKAP/OP2=+0.40341*K069*<OH> - PJAC(:,34,30)=+0.40341*TPK%K069(:)*PCONC(:,15) -! -!ALKAP/ORA1=0.0 -! -!ALKAP/ORA2=0.0 -! -!ALKAP/MO2=+0.00385*K105*<ALKAP>-K105*<ALKAP> - PJAC(:,34,33)=+0.00385*TPK%K105(:)*PCONC(:,34)-TPK%K105(:)*PCONC(:,34) -! -!ALKAP/ALKAP=+0.08187*K091*<NO>-K091*<NO>-K098*<HO2>+0.00385*K105*<MO2>-K105*<M -!O2>+0.00828*K111*<CARBOP>-K111*<CARBOP>+0.08994*K120*<NO3>-K120*<NO3> - PJAC(:,34,34)=+0.08187*TPK%K091(:)*PCONC(:,3)-TPK%K091(:)*PCONC(:,3)-TPK%K098(& -&:)*PCONC(:,16)+0.00385*TPK%K105(:)*PCONC(:,33)-TPK%K105(:)*PCONC(:,33)+0.00828& -&*TPK%K111(:)*PCONC(:,40)-TPK%K111(:)*PCONC(:,40)+0.08994*TPK%K120(:)*PCONC(:,5& -&)-TPK%K120(:)*PCONC(:,5) -! -!ALKAP/ALKEP=0.0 -! -!ALKAP/BIOP=0.0 -! -!ALKAP/PHO=0.0 -! -!ALKAP/ADD=0.0 -! -!ALKAP/AROP=0.0 -! -!ALKAP/CARBOP=+0.00828*K111*<ALKAP>-K111*<ALKAP> - PJAC(:,34,40)=+0.00828*TPK%K111(:)*PCONC(:,34)-TPK%K111(:)*PCONC(:,34) -! -!ALKAP/OLN=0.0 -! -!ALKAP/XO2=0.0 -! -!ALKEP/O3=0.0 -! -!ALKEP/H2O2=0.0 -! -!ALKEP/NO=-K092*<ALKEP> - PJAC(:,35,3)=-TPK%K092(:)*PCONC(:,35) -! -!ALKEP/NO2=0.0 -! -!ALKEP/NO3=-K121*<ALKEP> - PJAC(:,35,5)=-TPK%K121(:)*PCONC(:,35) -! -!ALKEP/N2O5=0.0 -! -!ALKEP/HONO=0.0 -! -!ALKEP/HNO3=0.0 -! -!ALKEP/HNO4=0.0 -! -!ALKEP/NH3=0.0 -! -!ALKEP/DMS=0.0 -! -!ALKEP/SO2=0.0 -! -!ALKEP/SULF=0.0 -! -!ALKEP/CO=0.0 -! -!ALKEP/OH=+1.02529*K059*<ALKE> - PJAC(:,35,15)=+1.02529*TPK%K059(:)*PCONC(:,20) -! -!ALKEP/HO2=-K099*<ALKEP> - PJAC(:,35,16)=-TPK%K099(:)*PCONC(:,35) -! -!ALKEP/CH4=0.0 -! -!ALKEP/ETH=0.0 -! -!ALKEP/ALKA=0.0 -! -!ALKEP/ALKE=+1.02529*K059*<OH> - PJAC(:,35,20)=+1.02529*TPK%K059(:)*PCONC(:,15) -! -!ALKEP/BIO=0.0 -! -!ALKEP/ARO=0.0 -! -!ALKEP/HCHO=0.0 -! -!ALKEP/ALD=0.0 -! -!ALKEP/KET=0.0 -! -!ALKEP/CARBO=0.0 -! -!ALKEP/ONIT=0.0 -! -!ALKEP/PAN=0.0 -! -!ALKEP/OP1=0.0 -! -!ALKEP/OP2=0.0 -! -!ALKEP/ORA1=0.0 -! -!ALKEP/ORA2=0.0 -! -!ALKEP/MO2=-K106*<ALKEP> - PJAC(:,35,33)=-TPK%K106(:)*PCONC(:,35) -! -!ALKEP/ALKAP=0.0 -! -!ALKEP/ALKEP=-K092*<NO>-K099*<HO2>-K106*<MO2>-K112*<CARBOP>-K121*<NO3> - PJAC(:,35,35)=-TPK%K092(:)*PCONC(:,3)-TPK%K099(:)*PCONC(:,16)-TPK%K106(:)*PCON& -&C(:,33)-TPK%K112(:)*PCONC(:,40)-TPK%K121(:)*PCONC(:,5) -! -!ALKEP/BIOP=0.0 -! -!ALKEP/PHO=0.0 -! -!ALKEP/ADD=0.0 -! -!ALKEP/AROP=0.0 -! -!ALKEP/CARBOP=-K112*<ALKEP> - PJAC(:,35,40)=-TPK%K112(:)*PCONC(:,35) -! -!ALKEP/OLN=0.0 -! -!ALKEP/XO2=0.0 -! -RETURN -END SUBROUTINE SUBJ6 -! -SUBROUTINE SUBJ7 -! -!Indices 36 a 40 -! -! -!BIOP/O3=0.0 -! -!BIOP/H2O2=0.0 -! -!BIOP/NO=-K093*<BIOP> - PJAC(:,36,3)=-TPK%K093(:)*PCONC(:,36) -! -!BIOP/NO2=0.0 -! -!BIOP/NO3=-K122*<BIOP> - PJAC(:,36,5)=-TPK%K122(:)*PCONC(:,36) -! -!BIOP/N2O5=0.0 -! -!BIOP/HONO=0.0 -! -!BIOP/HNO3=0.0 -! -!BIOP/HNO4=0.0 -! -!BIOP/NH3=0.0 -! -!BIOP/DMS=0.0 -! -!BIOP/SO2=0.0 -! -!BIOP/SULF=0.0 -! -!BIOP/CO=0.0 -! -!BIOP/OH=+0.00000*K059*<ALKE>+1.00000*K060*<BIO> - PJAC(:,36,15)=+0.00000*TPK%K059(:)*PCONC(:,20)+1.00000*TPK%K060(:)*PCONC(:,21) -! -!BIOP/HO2=-K0100*<BIOP> - PJAC(:,36,16)=-TPK%K0100(:)*PCONC(:,36) -! -!BIOP/CH4=0.0 -! -!BIOP/ETH=0.0 -! -!BIOP/ALKA=0.0 -! -!BIOP/ALKE=+0.00000*K059*<OH> - PJAC(:,36,20)=+0.00000*TPK%K059(:)*PCONC(:,15) -! -!BIOP/BIO=+1.00000*K060*<OH> - PJAC(:,36,21)=+1.00000*TPK%K060(:)*PCONC(:,15) -! -!BIOP/ARO=0.0 -! -!BIOP/HCHO=0.0 -! -!BIOP/ALD=0.0 -! -!BIOP/KET=0.0 -! -!BIOP/CARBO=0.0 -! -!BIOP/ONIT=0.0 -! -!BIOP/PAN=0.0 -! -!BIOP/OP1=0.0 -! -!BIOP/OP2=0.0 -! -!BIOP/ORA1=0.0 -! -!BIOP/ORA2=0.0 -! -!BIOP/MO2=-K107*<BIOP> - PJAC(:,36,33)=-TPK%K107(:)*PCONC(:,36) -! -!BIOP/ALKAP=0.0 -! -!BIOP/ALKEP=0.0 -! -!BIOP/BIOP=-K093*<NO>-K0100*<HO2>-K107*<MO2>-K113*<CARBOP>-K122*<NO3> - PJAC(:,36,36)=-TPK%K093(:)*PCONC(:,3)-TPK%K0100(:)*PCONC(:,16)-TPK%K107(:)*PCO& -&NC(:,33)-TPK%K113(:)*PCONC(:,40)-TPK%K122(:)*PCONC(:,5) -! -!BIOP/PHO=0.0 -! -!BIOP/ADD=0.0 -! -!BIOP/AROP=0.0 -! -!BIOP/CARBOP=-K113*<BIOP> - PJAC(:,36,40)=-TPK%K113(:)*PCONC(:,36) -! -!BIOP/OLN=0.0 -! -!BIOP/XO2=0.0 -! -!PHO/O3=0.0 -! -!PHO/H2O2=0.0 -! -!PHO/NO=0.0 -! -!PHO/NO2=-K083*<PHO> - PJAC(:,37,4)=-TPK%K083(:)*PCONC(:,37) -! -!PHO/NO3=+K075*<ARO> - PJAC(:,37,5)=+TPK%K075(:)*PCONC(:,22) -! -!PHO/N2O5=0.0 -! -!PHO/HONO=0.0 -! -!PHO/HNO3=0.0 -! -!PHO/HNO4=0.0 -! -!PHO/NH3=0.0 -! -!PHO/DMS=0.0 -! -!PHO/SO2=0.0 -! -!PHO/SULF=0.0 -! -!PHO/CO=0.0 -! -!PHO/OH=+0.00276*K061*<ARO> - PJAC(:,37,15)=+0.00276*TPK%K061(:)*PCONC(:,22) -! -!PHO/HO2=-K084*<PHO> - PJAC(:,37,16)=-TPK%K084(:)*PCONC(:,37) -! -!PHO/CH4=0.0 -! -!PHO/ETH=0.0 -! -!PHO/ALKA=0.0 -! -!PHO/ALKE=0.0 -! -!PHO/BIO=0.0 -! -!PHO/ARO=+0.00276*K061*<OH>+K075*<NO3> - PJAC(:,37,22)=+0.00276*TPK%K061(:)*PCONC(:,15)+TPK%K075(:)*PCONC(:,5) -! -!PHO/HCHO=0.0 -! -!PHO/ALD=0.0 -! -!PHO/KET=0.0 -! -!PHO/CARBO=0.0 -! -!PHO/ONIT=0.0 -! -!PHO/PAN=0.0 -! -!PHO/OP1=0.0 -! -!PHO/OP2=0.0 -! -!PHO/ORA1=0.0 -! -!PHO/ORA2=0.0 -! -!PHO/MO2=0.0 -! -!PHO/ALKAP=0.0 -! -!PHO/ALKEP=0.0 -! -!PHO/BIOP=0.0 -! -!PHO/PHO=-K083*<NO2>-K084*<HO2> - PJAC(:,37,37)=-TPK%K083(:)*PCONC(:,4)-TPK%K084(:)*PCONC(:,16) -! -!PHO/ADD=0.0 -! -!PHO/AROP=0.0 -! -!PHO/CARBOP=0.0 -! -!PHO/OLN=0.0 -! -!PHO/XO2=0.0 -! -!ADD/O3=-K087*<ADD> - PJAC(:,38,1)=-TPK%K087(:)*PCONC(:,38) -! -!ADD/H2O2=0.0 -! -!ADD/NO=0.0 -! -!ADD/NO2=-K085*<ADD> - PJAC(:,38,4)=-TPK%K085(:)*PCONC(:,38) -! -!ADD/NO3=0.0 -! -!ADD/N2O5=0.0 -! -!ADD/HONO=0.0 -! -!ADD/HNO3=0.0 -! -!ADD/HNO4=0.0 -! -!ADD/NH3=0.0 -! -!ADD/DMS=0.0 -! -!ADD/SO2=0.0 -! -!ADD/SULF=0.0 -! -!ADD/CO=0.0 -! -!ADD/OH=+0.93968*K061*<ARO> - PJAC(:,38,15)=+0.93968*TPK%K061(:)*PCONC(:,22) -! -!ADD/HO2=0.0 -! -!ADD/CH4=0.0 -! -!ADD/ETH=0.0 -! -!ADD/ALKA=0.0 -! -!ADD/ALKE=0.0 -! -!ADD/BIO=0.0 -! -!ADD/ARO=+0.93968*K061*<OH> - PJAC(:,38,22)=+0.93968*TPK%K061(:)*PCONC(:,15) -! -!ADD/HCHO=0.0 -! -!ADD/ALD=0.0 -! -!ADD/KET=0.0 -! -!ADD/CARBO=0.0 -! -!ADD/ONIT=0.0 -! -!ADD/PAN=0.0 -! -!ADD/OP1=0.0 -! -!ADD/OP2=0.0 -! -!ADD/ORA1=0.0 -! -!ADD/ORA2=0.0 -! -!ADD/MO2=0.0 -! -!ADD/ALKAP=0.0 -! -!ADD/ALKEP=0.0 -! -!ADD/BIOP=0.0 -! -!ADD/PHO=0.0 -! -!ADD/ADD=-K085*<NO2>-K086*<O2>-K087*<O3> - PJAC(:,38,38)=-TPK%K085(:)*PCONC(:,4)-TPK%K086(:)*TPK%O2(:)-TPK%K087(:)*PCONC(& -&:,1) -! -!ADD/AROP=0.0 -! -!ADD/CARBOP=0.0 -! -!ADD/OLN=0.0 -! -!ADD/XO2=0.0 -! -!AROP/O3=0.0 -! -!AROP/H2O2=0.0 -! -!AROP/NO=-K094*<AROP> - PJAC(:,39,3)=-TPK%K094(:)*PCONC(:,39) -! -!AROP/NO2=0.0 -! -!AROP/NO3=-K123*<AROP> - PJAC(:,39,5)=-TPK%K123(:)*PCONC(:,39) -! -!AROP/N2O5=0.0 -! -!AROP/HONO=0.0 -! -!AROP/HNO3=0.0 -! -!AROP/HNO4=0.0 -! -!AROP/NH3=0.0 -! -!AROP/DMS=0.0 -! -!AROP/SO2=0.0 -! -!AROP/SULF=0.0 -! -!AROP/CO=0.0 -! -!AROP/OH=0.0 -! -!AROP/HO2=-K0101*<AROP> - PJAC(:,39,16)=-TPK%K0101(:)*PCONC(:,39) -! -!AROP/CH4=0.0 -! -!AROP/ETH=0.0 -! -!AROP/ALKA=0.0 -! -!AROP/ALKE=0.0 -! -!AROP/BIO=0.0 -! -!AROP/ARO=0.0 -! -!AROP/HCHO=0.0 -! -!AROP/ALD=0.0 -! -!AROP/KET=0.0 -! -!AROP/CARBO=0.0 -! -!AROP/ONIT=0.0 -! -!AROP/PAN=0.0 -! -!AROP/OP1=0.0 -! -!AROP/OP2=0.0 -! -!AROP/ORA1=0.0 -! -!AROP/ORA2=0.0 -! -!AROP/MO2=-K108*<AROP> - PJAC(:,39,33)=-TPK%K108(:)*PCONC(:,39) -! -!AROP/ALKAP=0.0 -! -!AROP/ALKEP=0.0 -! -!AROP/BIOP=0.0 -! -!AROP/PHO=0.0 -! -!AROP/ADD=+0.98*K086*<O2> - PJAC(:,39,38)=+0.98*TPK%K086(:)*TPK%O2(:) -! -!AROP/AROP=-K094*<NO>-K0101*<HO2>-K108*<MO2>-K114*<CARBOP>-K123*<NO3> - PJAC(:,39,39)=-TPK%K094(:)*PCONC(:,3)-TPK%K0101(:)*PCONC(:,16)-TPK%K108(:)*PCO& -&NC(:,33)-TPK%K114(:)*PCONC(:,40)-TPK%K123(:)*PCONC(:,5) -! -!AROP/CARBOP=-K114*<AROP> - PJAC(:,39,40)=-TPK%K114(:)*PCONC(:,39) -! -!AROP/OLN=0.0 -! -!AROP/XO2=0.0 -! -!CARBOP/O3=+0.05705*K079*<ALKE>+0.17000*K080*<BIO>+0.27460*K081*<CARBO>+0.70000 -!*K082*<PAN> - PJAC(:,40,1)=+0.05705*TPK%K079(:)*PCONC(:,20)+0.17000*TPK%K080(:)*PCONC(:,21)+& -&0.27460*TPK%K081(:)*PCONC(:,26)+0.70000*TPK%K082(:)*PCONC(:,28) -! -!CARBOP/H2O2=0.0 -! -!CARBOP/NO=+0.09532*K095*<CARBOP>-K095*<CARBOP> - PJAC(:,40,3)=+0.09532*TPK%K095(:)*PCONC(:,40)-TPK%K095(:)*PCONC(:,40) -! -!CARBOP/NO2=-K088*<CARBOP> - PJAC(:,40,4)=-TPK%K088(:)*PCONC(:,40) -! -!CARBOP/NO3=+1.00000*K073*<ALD>+0.38881*K074*<CARBO>+0.03175*K124*<CARBOP>-K124 -!*<CARBOP> - PJAC(:,40,5)=+1.00000*TPK%K073(:)*PCONC(:,24)+0.38881*TPK%K074(:)*PCONC(:,26)+& -&0.03175*TPK%K124(:)*PCONC(:,40)-TPK%K124(:)*PCONC(:,40) -! -!CARBOP/N2O5=0.0 -! -!CARBOP/HONO=0.0 -! -!CARBOP/HNO3=0.0 -! -!CARBOP/HNO4=0.0 -! -!CARBOP/NH3=0.0 -! -!CARBOP/DMS=0.0 -! -!CARBOP/SO2=0.0 -! -!CARBOP/SULF=0.0 -! -!CARBOP/CO=0.0 -! -!CARBOP/OH=+1.00000*K063*<ALD>+1.00000*K064*<KET>+0.51419*K065*<CARBO>+0.05413* -!K069*<OP2> - PJAC(:,40,15)=+1.00000*TPK%K063(:)*PCONC(:,24)+1.00000*TPK%K064(:)*PCONC(:,25)& -&+0.51419*TPK%K065(:)*PCONC(:,26)+0.05413*TPK%K069(:)*PCONC(:,30) -! -!CARBOP/HO2=-K0102*<CARBOP> - PJAC(:,40,16)=-TPK%K0102(:)*PCONC(:,40) -! -!CARBOP/CH4=0.0 -! -!CARBOP/ETH=0.0 -! -!CARBOP/ALKA=0.0 -! -!CARBOP/ALKE=+0.05705*K079*<O3> - PJAC(:,40,20)=+0.05705*TPK%K079(:)*PCONC(:,1) -! -!CARBOP/BIO=+0.17000*K080*<O3> - PJAC(:,40,21)=+0.17000*TPK%K080(:)*PCONC(:,1) -! -!CARBOP/ARO=0.0 -! -!CARBOP/HCHO=0.0 -! -!CARBOP/ALD=+1.00000*K063*<OH>+1.00000*K073*<NO3> - PJAC(:,40,24)=+1.00000*TPK%K063(:)*PCONC(:,15)+1.00000*TPK%K073(:)*PCONC(:,5) -! -!CARBOP/KET=+1.00000*K015+1.00000*K064*<OH> - PJAC(:,40,25)=+1.00000*TPK%K015(:)+1.00000*TPK%K064(:)*PCONC(:,15) -! -!CARBOP/CARBO=+0.69622*K016+0.51419*K065*<OH>+0.38881*K074*<NO3>+0.27460*K081*< -!O3> - PJAC(:,40,26)=+0.69622*TPK%K016(:)+0.51419*TPK%K065(:)*PCONC(:,15)+0.38881*TPK& -&%K074(:)*PCONC(:,5)+0.27460*TPK%K081(:)*PCONC(:,1) -! -!CARBOP/ONIT=0.0 -! -!CARBOP/PAN=+0.70000*K082*<O3>+1.00000*K089 - PJAC(:,40,28)=+0.70000*TPK%K082(:)*PCONC(:,1)+1.00000*TPK%K089(:) -! -!CARBOP/OP1=0.0 -! -!CARBOP/OP2=+0.05413*K069*<OH> - PJAC(:,40,30)=+0.05413*TPK%K069(:)*PCONC(:,15) -! -!CARBOP/ORA1=0.0 -! -!CARBOP/ORA2=0.0 -! -!CARBOP/MO2=+0.05954*K109*<CARBOP>-K109*<CARBOP> - PJAC(:,40,33)=+0.05954*TPK%K109(:)*PCONC(:,40)-TPK%K109(:)*PCONC(:,40) -! -!CARBOP/ALKAP=-K111*<CARBOP> - PJAC(:,40,34)=-TPK%K111(:)*PCONC(:,40) -! -!CARBOP/ALKEP=-K112*<CARBOP> - PJAC(:,40,35)=-TPK%K112(:)*PCONC(:,40) -! -!CARBOP/BIOP=-K113*<CARBOP> - PJAC(:,40,36)=-TPK%K113(:)*PCONC(:,40) -! -!CARBOP/PHO=0.0 -! -!CARBOP/ADD=0.0 -! -!CARBOP/AROP=-K114*<CARBOP> - PJAC(:,40,39)=-TPK%K114(:)*PCONC(:,40) -! -!CARBOP/CARBOP=-K088*<NO2>+0.09532*K095*<NO>-K095*<NO>-K0102*<HO2>+0.05954*K109 -!*<MO2>-K109*<MO2>-K111*<ALKAP>-K112*<ALKEP>-K113*<BIOP>-K114*<AROP>+0.05821*K1 -!15*<CARBOP>+0.05821*K115*<CARBOP>-K115*<CARBOP>-K115*<CARBOP>-K115*<CARBOP>-K1 -!15*<CARBOP>-K116*<OLN>+0.03175*K124*<NO3>-K124*<NO3>-K128*<XO2> - PJAC(:,40,40)=-TPK%K088(:)*PCONC(:,4)+0.09532*TPK%K095(:)*PCONC(:,3)-TPK%K095(& -&:)*PCONC(:,3)-TPK%K0102(:)*PCONC(:,16)+0.05954*TPK%K109(:)*PCONC(:,33)-TPK%K10& -&9(:)*PCONC(:,33)-TPK%K111(:)*PCONC(:,34)-TPK%K112(:)*PCONC(:,35)-TPK%K113(:)*P& -&CONC(:,36)-TPK%K114(:)*PCONC(:,39)+0.05821*TPK%K115(:)*PCONC(:,40)+0.05821*TPK& -&%K115(:)*PCONC(:,40)-TPK%K115(:)*PCONC(:,40)-TPK%K115(:)*PCONC(:,40)-TPK%K115(& -&:)*PCONC(:,40)-TPK%K115(:)*PCONC(:,40)-TPK%K116(:)*PCONC(:,41)+0.03175*TPK%K12& -&4(:)*PCONC(:,5)-TPK%K124(:)*PCONC(:,5)-TPK%K128(:)*PCONC(:,42) -! -!CARBOP/OLN=-K116*<CARBOP> - PJAC(:,40,41)=-TPK%K116(:)*PCONC(:,40) -! -!CARBOP/XO2=-K128*<CARBOP> - PJAC(:,40,42)=-TPK%K128(:)*PCONC(:,40) -! -RETURN -END SUBROUTINE SUBJ7 -! -SUBROUTINE SUBJ8 -! -!Indices 41 a 42 -! -! -!OLN/O3=0.0 -! -!OLN/H2O2=0.0 -! -!OLN/NO=-K096*<OLN> - PJAC(:,41,3)=-TPK%K096(:)*PCONC(:,41) -! -!OLN/NO2=0.0 -! -!OLN/NO3=+0.00000*K074*<CARBO>+0.93768*K076*<ALKE>+1.00000*K077*<BIO>-K125*<OLN -!> - PJAC(:,41,5)=+0.00000*TPK%K074(:)*PCONC(:,26)+0.93768*TPK%K076(:)*PCONC(:,20)+& -&1.00000*TPK%K077(:)*PCONC(:,21)-TPK%K125(:)*PCONC(:,41) -! -!OLN/N2O5=0.0 -! -!OLN/HONO=0.0 -! -!OLN/HNO3=0.0 -! -!OLN/HNO4=0.0 -! -!OLN/NH3=0.0 -! -!OLN/DMS=0.0 -! -!OLN/SO2=0.0 -! -!OLN/SULF=0.0 -! -!OLN/CO=0.0 -! -!OLN/OH=0.0 -! -!OLN/HO2=-K103*<OLN> - PJAC(:,41,16)=-TPK%K103(:)*PCONC(:,41) -! -!OLN/CH4=0.0 -! -!OLN/ETH=0.0 -! -!OLN/ALKA=0.0 -! -!OLN/ALKE=+0.93768*K076*<NO3> - PJAC(:,41,20)=+0.93768*TPK%K076(:)*PCONC(:,5) -! -!OLN/BIO=+1.00000*K077*<NO3> - PJAC(:,41,21)=+1.00000*TPK%K077(:)*PCONC(:,5) -! -!OLN/ARO=0.0 -! -!OLN/HCHO=0.0 -! -!OLN/ALD=0.0 -! -!OLN/KET=0.0 -! -!OLN/CARBO=+0.00000*K074*<NO3> - PJAC(:,41,26)=+0.00000*TPK%K074(:)*PCONC(:,5) -! -!OLN/ONIT=0.0 -! -!OLN/PAN=0.0 -! -!OLN/OP1=0.0 -! -!OLN/OP2=0.0 -! -!OLN/ORA1=0.0 -! -!OLN/ORA2=0.0 -! -!OLN/MO2=-K110*<OLN> - PJAC(:,41,33)=-TPK%K110(:)*PCONC(:,41) -! -!OLN/ALKAP=0.0 -! -!OLN/ALKEP=0.0 -! -!OLN/BIOP=0.0 -! -!OLN/PHO=0.0 -! -!OLN/ADD=0.0 -! -!OLN/AROP=0.0 -! -!OLN/CARBOP=-K116*<OLN> - PJAC(:,41,40)=-TPK%K116(:)*PCONC(:,41) -! -!OLN/OLN=-K096*<NO>-K103*<HO2>-K110*<MO2>-K116*<CARBOP>-K117*<OLN>-K117*<OLN>-K -!117*<OLN>-K117*<OLN>-K118*<OLN>-K118*<OLN>-K118*<OLN>-K118*<OLN>-K125*<NO3> - PJAC(:,41,41)=-TPK%K096(:)*PCONC(:,3)-TPK%K103(:)*PCONC(:,16)-TPK%K110(:)*PCON& -&C(:,33)-TPK%K116(:)*PCONC(:,40)-TPK%K117(:)*PCONC(:,41)-TPK%K117(:)*PCONC(:,41& -&)-TPK%K117(:)*PCONC(:,41)-TPK%K117(:)*PCONC(:,41)-TPK%K118(:)*PCONC(:,41)-TPK%& -&K118(:)*PCONC(:,41)-TPK%K118(:)*PCONC(:,41)-TPK%K118(:)*PCONC(:,41)-TPK%K125(:& -&)*PCONC(:,5) -! -!OLN/XO2=0.0 -! -!XO2/O3=+0.00000*K079*<ALKE>+0.13000*K080*<BIO> - PJAC(:,42,1)=+0.00000*TPK%K079(:)*PCONC(:,20)+0.13000*TPK%K080(:)*PCONC(:,21) -! -!XO2/H2O2=0.0 -! -!XO2/NO=+0.13007*K091*<ALKAP>+0.02563*K095*<CARBOP>-K130*<XO2> - PJAC(:,42,3)=+0.13007*TPK%K091(:)*PCONC(:,34)+0.02563*TPK%K095(:)*PCONC(:,40)-& -&TPK%K130(:)*PCONC(:,42) -! -!XO2/NO2=0.0 -! -!XO2/NO3=+0.10530*K074*<CARBO>+K078*<PAN>+0.16271*K120*<ALKAP>+0.01021*K124*<CA -!RBOP>-K131*<XO2> - PJAC(:,42,5)=+0.10530*TPK%K074(:)*PCONC(:,26)+TPK%K078(:)*PCONC(:,28)+0.16271*& -&TPK%K120(:)*PCONC(:,34)+0.01021*TPK%K124(:)*PCONC(:,40)-TPK%K131(:)*PCONC(:,42& -&) -! -!XO2/N2O5=0.0 -! -!XO2/HONO=0.0 -! -!XO2/HNO3=0.0 -! -!XO2/HNO4=0.0 -! -!XO2/NH3=0.0 -! -!XO2/DMS=0.0 -! -!XO2/SO2=0.0 -! -!XO2/SULF=0.0 -! -!XO2/CO=0.0 -! -!XO2/OH=+0.10318*K061*<ARO>+0.10162*K065*<CARBO>+0.09333*K069*<OP2>+K070*<PAN> - PJAC(:,42,15)=+0.10318*TPK%K061(:)*PCONC(:,22)+0.10162*TPK%K065(:)*PCONC(:,26)& -&+0.09333*TPK%K069(:)*PCONC(:,30)+TPK%K070(:)*PCONC(:,28) -! -!XO2/HO2=-K126*<XO2> - PJAC(:,42,16)=-TPK%K126(:)*PCONC(:,42) -! -!XO2/CH4=0.0 -! -!XO2/ETH=0.0 -! -!XO2/ALKA=0.0 -! -!XO2/ALKE=+0.00000*K079*<O3> - PJAC(:,42,20)=+0.00000*TPK%K079(:)*PCONC(:,1) -! -!XO2/BIO=+0.15*K054*<O3P>+0.13000*K080*<O3> - PJAC(:,42,21)=+0.15*TPK%K054(:)*TPK%O3P(:)+0.13000*TPK%K080(:)*PCONC(:,1) -! -!XO2/ARO=+0.10318*K061*<OH> - PJAC(:,42,22)=+0.10318*TPK%K061(:)*PCONC(:,15) -! -!XO2/HCHO=0.0 -! -!XO2/ALD=0.0 -! -!XO2/KET=0.0 -! -!XO2/CARBO=+0.10162*K065*<OH>+0.10530*K074*<NO3> - PJAC(:,42,26)=+0.10162*TPK%K065(:)*PCONC(:,15)+0.10530*TPK%K074(:)*PCONC(:,5) -! -!XO2/ONIT=0.0 -! -!XO2/PAN=+K070*<OH>+K078*<NO3> - PJAC(:,42,28)=+TPK%K070(:)*PCONC(:,15)+TPK%K078(:)*PCONC(:,5) -! -!XO2/OP1=0.0 -! -!XO2/OP2=+0.09333*K069*<OH> - PJAC(:,42,30)=+0.09333*TPK%K069(:)*PCONC(:,15) -! -!XO2/ORA1=0.0 -! -!XO2/ORA2=0.0 -! -!XO2/MO2=+0.13370*K105*<ALKAP>+0.02212*K109*<CARBOP>-K127*<XO2> - PJAC(:,42,33)=+0.13370*TPK%K105(:)*PCONC(:,34)+0.02212*TPK%K109(:)*PCONC(:,40)& -&-TPK%K127(:)*PCONC(:,42) -! -!XO2/ALKAP=+0.13007*K091*<NO>+0.13370*K105*<MO2>+0.11306*K111*<CARBOP>+0.16271* -!K120*<NO3> - PJAC(:,42,34)=+0.13007*TPK%K091(:)*PCONC(:,3)+0.13370*TPK%K105(:)*PCONC(:,33)+& -&0.11306*TPK%K111(:)*PCONC(:,40)+0.16271*TPK%K120(:)*PCONC(:,5) -! -!XO2/ALKEP=0.0 -! -!XO2/BIOP=0.0 -! -!XO2/PHO=0.0 -! -!XO2/ADD=0.0 -! -!XO2/AROP=0.0 -! -!XO2/CARBOP=+0.02563*K095*<NO>+0.02212*K109*<MO2>+0.11306*K111*<ALKAP>+0.01593* -!K115*<CARBOP>+0.01593*K115*<CARBOP>+0.01021*K124*<NO3>-K128*<XO2> - PJAC(:,42,40)=+0.02563*TPK%K095(:)*PCONC(:,3)+0.02212*TPK%K109(:)*PCONC(:,33)+& -&0.11306*TPK%K111(:)*PCONC(:,34)+0.01593*TPK%K115(:)*PCONC(:,40)+0.01593*TPK%K1& -&15(:)*PCONC(:,40)+0.01021*TPK%K124(:)*PCONC(:,5)-TPK%K128(:)*PCONC(:,42) -! -!XO2/OLN=0.0 -! -!XO2/XO2=-K126*<HO2>-K127*<MO2>-K128*<CARBOP>-K129*<XO2>-K129*<XO2>-K129*<XO2>- -!K129*<XO2>-K130*<NO>-K131*<NO3> - PJAC(:,42,42)=-TPK%K126(:)*PCONC(:,16)-TPK%K127(:)*PCONC(:,33)-TPK%K128(:)*PCO& -&NC(:,40)-TPK%K129(:)*PCONC(:,42)-TPK%K129(:)*PCONC(:,42)-TPK%K129(:)*PCONC(:,4& -&2)-TPK%K129(:)*PCONC(:,42)-TPK%K130(:)*PCONC(:,3)-TPK%K131(:)*PCONC(:,5) -! -RETURN -END SUBROUTINE SUBJ8 -! -END SUBROUTINE CH_JAC_GAZ -! -! -!======================================================================== -! -!! ######################## - MODULE MODI_CH_SET_RATES -!! ######################## -!! This code has been created automatically by preprocessor m10, -!! version: 9.7, copyright 1995-1999 by Meteo France/Universite Paul Sabatier. -!! Please report all bugs to K. Suhre (Lab. d'Aerologie UPS/CNRS). -INTERFACE -SUBROUTINE CH_SET_RATES(PTIME,PCONC,TPM,KMI,KOUT,KVERB,KVECNPT,KEQ,KRRL,PPH) -USE MODD_CH_M9_n, ONLY: METEOTRANSTYPE -IMPLICIT NONE -REAL, INTENT(IN) :: PTIME -INTEGER, INTENT(IN) :: KVECNPT -INTEGER, INTENT(IN) :: KEQ -REAL, INTENT(IN), DIMENSION(KVECNPT,KEQ) :: PCONC -TYPE(METEOTRANSTYPE), DIMENSION(KVECNPT), INTENT(IN):: TPM -INTEGER, INTENT(IN) :: KMI -INTEGER, INTENT(IN) :: KOUT,KVERB -INTEGER, INTENT(INOUT) :: KRRL -REAL, INTENT(INOUT), DIMENSION(:,:), OPTIONAL :: PPH -END SUBROUTINE CH_SET_RATES -END INTERFACE -END MODULE MODI_CH_SET_RATES -! -!======================================================================== -! -!! ############################################################################ - SUBROUTINE CH_SET_RATES(PTIME,PCONC,TPM,KMI,KOUT,KVERB,KVECNPT,KEQ,KRRL,PPH) -!! ############################################################################ -!! This code has been created automatically by preprocessor m10, -!! version: 9.7, copyright 1995-1999 by Meteo France/Universite Paul Sabatier. -!! Please report all bugs to K. Suhre (Lab. d'Aerologie UPS/CNRS). -!!*** *MODD_CH_SET_RATES* -!! -!! PURPOSE -!! ------- -! set or calculate reaction rates -!! -!!** METHOD -!! ------ -!! simple -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Karsten Suhre (LA) -!! -!! MODIFICATIONS -!! ------------- -!! Original 26/07/96 -!! Modified 05/05/98: Vectorization (Vincent Crassier & KS) -!! Modified 01/06/07: Add pH calculation (M. Leriche & JP Pinty) -!! Modified 01/06/08: Add reaction constant in cloud/rain (M. Leriche) -!! Modified 14/11/08: Put LWC and LWR to zero where <XRTMIN_AQ -!! -!!---------------------------------------------------------------------- -!! -!! EXTERNAL -!! -------- -!! -USE MODI_CH_ALLOCATE_TACCS -USE MODI_CH_DEALLOCATE_TACCS -USE MODI_CH_SET_PH -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -USE MODD_CH_M9_SCHEME -USE MODD_CH_M9_n, ONLY : METEOTRANSTYPE -USE MODD_CH_MNHC_n, ONLY : XRTMIN_AQ, XCH_PHINIT -! USER DEFINED FUNCTIONS -USE MODI_KT -USE MODI_TROE -USE MODI_HENRY -USE MODI_HEFFA -USE MODI_TROE_EQUIL -USE MODI_HEFFB -!! -!! EXPLICIT ARGUMENTS -!! ------------------ -IMPLICIT NONE -REAL, INTENT(IN) :: PTIME -INTEGER, INTENT(IN) :: KVECNPT -INTEGER, INTENT(IN) :: KEQ -REAL, INTENT(IN), DIMENSION(KVECNPT,KEQ) :: PCONC -TYPE(METEOTRANSTYPE), DIMENSION(KVECNPT), INTENT(IN):: TPM -INTEGER, INTENT(IN) :: KMI -INTEGER, INTENT(IN) :: KOUT,KVERB -INTEGER, INTENT(INOUT) :: KRRL -REAL, INTENT(INOUT), DIMENSION(:,:), OPTIONAL :: PPH -!! -!!---------------------------------------------------------------------- -! /BEGIN_SET_RATES/ -! -! transfer of meteo-variables into variables used by the -! chemical core system (and some unit conversion): -! -! molecular weight of air: m_mol^air = 28.8 g/mol -! molecular weight of H2O: m_mol^H2O = 18.0 g/mol -! ==> m_mol^air / m_mol^H2O = 1.6 -! density conversion factor: 1 g/cm3 = 1E+3 kg/m3 -! n_molec (moelc./cm3): M = 1E-3*RHO(kg/m3) * Navo / m_mol -! n_water: H2O = M * 1.6 * Rv -! pressure = RHO * T * R * 1E-5 (in atm) -! assuming 20.95 vol% O2 -! -TYPE(CCSTYPE), POINTER :: TPK -! -!---------------------------------------------------------------------- -! -IF (.NOT. ASSOCIATED(TACCS(KMI)%NVERB)) THEN - CALL CH_ALLOCATE_TACCS(KMI,KVECNPT) -END IF -! -IF (SIZE(TACCS(KMI)%NVERB) .NE. KVECNPT) THEN - CALL CH_DEALLOCATE_TACCS(KMI) - CALL CH_ALLOCATE_TACCS(KMI,KVECNPT) -END IF -! -TPK=>TACCS(KMI) -! -TPK%MODELLEVEL = TPM%XMETEOVAR(1) -TPK%M = 1E-3*TPM%XMETEOVAR(2) * 6.0221367E+23 / 28.9644 -TPK%T = TPM%XMETEOVAR(3) -TPK%H2O = TPK%M*1.6077*TPM%XMETEOVAR(4) -TPK%CLOUDWATER = TPM%XMETEOVAR(5) -TPK%LAT = TPM%XMETEOVAR(6) -TPK%LON = TPM%XMETEOVAR(7) -TPK%YEAR = INT(TPM%XMETEOVAR(8)) -TPK%MONTH = INT(TPM%XMETEOVAR(9)) -TPK%DAY = INT(TPM%XMETEOVAR(10)) -TPK%RAINWATER = TPM%XMETEOVAR(11) -TPK%RHODREF = TPM%XMETEOVAR(2) -! derived variables -TPK%PRESSURE = TPM%XMETEOVAR(2) * TPK%T * 288.290947 * 1E-5 -TPK%O2 = 0.2095 * TPK%M -TPK%N2 = TPK%M - TPK%O2 -TPK%H2 = 1.23e13 -! fixed concentration of CO2 -TPK%CO2 = 330. * 1.E-6 * TPK%M -! for chemistry in aqueous phase, kinetic mass transfer -! cloud lwc (vol/vol) = cloud m.r.(kg/kg) * rho_air(kg/m3) / rho_eau(kg/m3) -TPK%LWC = TPM%XMETEOVAR(5)*TPM%XMETEOVAR(2) / 1.E3 -WHERE ( TPK%LWC < XRTMIN_AQ ) !to get reaction rate for mass transfer = 0 - TPK%LWC = 0. -ENDWHERE -TPK%RADC = TPM%XMETEOVAR(12) -! conversion factor for reaction constant in cloud -! give minimum value to avoir division by zero -TPK%MOL2MOLECCLOUD = 6.023e+23*1.e-3*XRTMIN_AQ -WHERE (TPK%LWC >= XRTMIN_AQ) - TPK%MOL2MOLECCLOUD = 6.023e+23*1.e-3*TPK%LWC -END WHERE -! -TPK%LWR = TPM%XMETEOVAR(11)*TPM%XMETEOVAR(2) / 1.E3 -WHERE ( TPK%LWR < XRTMIN_AQ ) !to get reaction rate for mass transfer = 0 - TPK%LWR = 0. -ENDWHERE -TPK%RADR = TPM%XMETEOVAR(13) -! conversion factor for reaction constant in rain -! give minimum value to avoir division by zero -TPK%MOL2MOLECRAIN = 6.023e+23*1.e-3*XRTMIN_AQ -WHERE (TPK%LWR >= XRTMIN_AQ) - TPK%MOL2MOLECRAIN = 6.023e+23*1.e-3*TPK%LWR -END WHERE -!pH calculation if required -IF (PRESENT(PPH)) THEN - TPK%PHC(:)=PPH(:,1) - CALL CH_SET_PH(KOUT,KMI,KVECNPT,PCONC,TPK%PHC(:),KVERB,2) ! pH cloud water -! TPK%PHC(:) = 0.01*TPK%PHC(:) + 0.99*PPH(:,1) ! apply a strong filter - PPH(:,1) = TPK%PHC(:) - IF (KRRL>=2) THEN - TPK%PHR(:)=PPH(:,2) - CALL CH_SET_PH(KOUT,KMI,KVECNPT,PCONC,TPK%PHR(:),KVERB,3) ! pH rain water -! TPK%PHR(:) = 0.01*TPK%PHR(:) + 0.99*PPH(:,2) ! apply a strong filter - PPH(:,2) = TPK%PHR(:) - ENDIF -ELSE - IF (.NOT.TPK%LCH_PH) TPK%PHC = XCH_PHINIT - IF (KRRL>=2) THEN - IF (.NOT.TPK%LCH_PH) TPK%PHR = XCH_PHINIT - ENDIF -ENDIF -! -TPK%RCH = 0.08206 ! R in atm M-1 K-1 -TPK%W_O2 = 1.3E-3*exp(-1500.*(1./TPK%T-1./298.15))*TPK%RCH*TPK%T*TPK%O2*1.e3/6.023e+23 -! -! the following prints will be erased -IF (KVERB >= 15) THEN - WRITE(KOUT,*) "CH_SET_RATES: the following variables have been updated" - WRITE(KOUT,*) "MODELLEVEL: ", TPK%MODELLEVEL(1) - WRITE(KOUT,*) "M: ", TPK%M(1) , "molec/cm3" - WRITE(KOUT,*) "T: ", TPK%T(1) , "K" - WRITE(KOUT,*) "H2O ", TPK%H2O(1) , "molec/cm3" - WRITE(KOUT,*) "CLOUDWATER: ", TPK%CLOUDWATER(1) , "kg/kg" - WRITE(KOUT,*) "LATITUDE: ", TPK%LAT(1) , "degree" - WRITE(KOUT,*) "LONGITUDE: ", TPK%LON(1) , "degree" - WRITE(KOUT,*) "YEAR: ", TPK%YEAR(1) - WRITE(KOUT,*) "MONTH: ", TPK%MONTH(1) - WRITE(KOUT,*) "DAY: ", TPK%DAY(1) - WRITE(KOUT,*) "RAINWATER: ", TPK%RAINWATER(1) , "kg/kg" - WRITE(KOUT,*) "RHODREF: ", TPK%RHODREF(1) , "kg/m3" - WRITE(KOUT,*) "PRESSURE: ", TPK%PRESSURE(1) , "atm" - WRITE(KOUT,*) "O2: ", TPK%O2(1) , "molec/cm3" - WRITE(KOUT,*) "N2: ", TPK%N2(1) , "molec/cm3" - WRITE(KOUT,*) "H2: ", TPK%H2(1) , "molec/cm3" - WRITE(KOUT,*) "CO2: ", TPK%CO2(1) , "molec/cm3" - WRITE(KOUT,*) "LWC: ", TPK%LWC(1) , "m3/m3" - WRITE(KOUT,*) "RADC: ", TPK%RADC(1) , "m" - WRITE(KOUT,*) "PHC: ", TPK%PHC(1) - WRITE(KOUT,*) "LWR: ", TPK%LWR(1) , "m3/m3" - WRITE(KOUT,*) "RADR: ", TPK%RADR(1) , "m" - WRITE(KOUT,*) "PHR: ", TPK%PHR(1) - WRITE(KOUT,*) "W_O2: ", TPK%W_O2(1) , "M" -END IF -! -! /END_SET_RATES/ -CALL SUBSRG0 -CALL SUBSRG1 -CALL SUBSRG2 -CALL SUBSRG3 -CALL SUBSRG4 -CALL SUBSRG5 -CALL SUBSRG6 -CALL SUBSRG7 -CALL SUBSRG8 -CALL SUBSRG9 -CALL SUBSRG10 -CALL SUBSRG11 -CALL SUBSRG12 -CALL SUBSRG13 -IF (TPK%LUSECHAQ) THEN - CALL SUBSRW0 - CALL SUBSRW1 - CALL SUBSRW2 - CALL SUBSRW3 - CALL SUBSRW4 - CALL SUBSRW5 - CALL SUBSRW6 - CALL SUBSRW7 - CALL SUBSRW8 - CALL SUBSRW9 - CALL SUBSRW10 - CALL SUBSRW11 - CALL SUBSRW12 - CALL SUBSRW13 -END IF -TPK%NOUT = KOUT -TPK%NVERB(:) = KVERB -RETURN - -CONTAINS - -SUBROUTINE SUBSRG0 -! -!Indices 1 a 10 -! -! -RETURN -END SUBROUTINE SUBSRG0 -! -SUBROUTINE SUBSRG1 -! -!Indices 11 a 20 -! - TPK%K018=TPK%M*6.00E-34*(TPK%T/300)**(-2.3) - TPK%K019=8.00E-12*exp(-(2060.0/TPK%T)) - TPK%K020=1.80E-11*exp(-(-110.0/TPK%T)) -! -RETURN -END SUBROUTINE SUBSRG1 -! -SUBROUTINE SUBSRG2 -! -!Indices 21 a 30 -! - TPK%K021=3.20E-11*exp(-(-70.0/TPK%T)) - TPK%K022=2.20E-10 - TPK%K023=1.60E-12*exp(-(940.0/TPK%T)) - TPK%K024=1.10E-14*exp(-(500.0/TPK%T)) - TPK%K025=4.80E-11*exp(-(-250.0/TPK%T)) - TPK%K026=2.90E-12*exp(-(160.0/TPK%T)) - TPK%K027=2.3E-13*EXP(600./TPK%T)+1.7E-33*TPK%M*EXP(1000./TPK%T) - TPK%K028=3.22E-34*EXP(2800./TPK%T)+2.38E-54*TPK%M*EXP(3200./TPK%T) - TPK%K029=TROE(1.,9.00E-32,1.5,3.00E-11,0.0,TPK%M,TPK%T,KVECNPT) - TPK%K030=6.50E-12*exp(-(-120.0/TPK%T)) -! -RETURN -END SUBROUTINE SUBSRG2 -! -SUBROUTINE SUBSRG3 -! -!Indices 31 a 40 -! - TPK%K031=TROE(1.,9.00E-32,2.0,2.20E-11,0.0,TPK%M,TPK%T,KVECNPT) - TPK%K032=TROE(1.,7.00E-31,2.6,1.50E-11,0.5,TPK%M,TPK%T,KVECNPT) - TPK%K033=TROE(1.,2.60E-30,3.2,2.40E-11,1.3,TPK%M,TPK%T,KVECNPT) - TPK%K034=2.20E-11 - TPK%K035=3.70E-12*exp(-(-250.0/TPK%T)) - TPK%K036=TROE(1.,1.80E-31,3.2,4.70E-12,1.4,TPK%M,TPK%T,KVECNPT) - TPK%K037=TROE_EQUIL(1.80E-31,3.2,4.70E-12,1.4,4.76E+26,10900.,TPK%M,TPK%T,KVEC& -&NPT) - TPK%K038=3.50E-12 - TPK%K039=1.80E-11*exp(-(390.0/TPK%T)) - TPK%K040=(7.2E-15*EXP(785/TPK%T))+(1.9E-33*EXP(725/TPK%T)*TPK%M)/(1+(1.9E-33*E& -&XP(725/TPK%T)*TPK%M)/(4.1E-16*EXP(1440/TPK%T))) -! -RETURN -END SUBROUTINE SUBSRG3 -! -SUBROUTINE SUBSRG4 -! -!Indices 41 a 50 -! - TPK%K041=1.30E-12*exp(-(-380.0/TPK%T)) - TPK%K042=2.00E-12*exp(-(1400.0/TPK%T)) - TPK%K043=1.20E-13*exp(-(2450.0/TPK%T)) - TPK%K044=3.30E-39*exp(-(-530.0/TPK%T)) - TPK%K045=1.50E-11*exp(-(-170.0/TPK%T)) - TPK%K046=4.50E-14*exp(-(1260.0/TPK%T)) - TPK%K047=TROE(1.,2.20E-30,3.9,1.50E-12,0.7,TPK%M,TPK%T,KVECNPT) - TPK%K048=TROE_EQUIL(2.20E-30,3.9,1.50E-12,0.7,3.70E+26,11000.0,TPK%M,TPK%T,KVE& -&CNPT) - TPK%K049=8.50E-13*exp(-(2450.0/TPK%T)) - TPK%K050=3.30E-12*exp(-(900.0/TPK%T)) -! -RETURN -END SUBROUTINE SUBSRG4 -! -SUBROUTINE SUBSRG5 -! -!Indices 51 a 60 -! - TPK%K051=5.50E-12*exp(-(2000.0/TPK%T)) - TPK%K052=TROE(1.,3.00E-31,3.3,1.50E-12,0.0,TPK%M,TPK%T,KVECNPT) - TPK%K053=1.5E-13*(1.+2.439E-20*TPK%M) - TPK%K054=6.00E-11 - TPK%K055=0.00E-01*exp(-(-13.0/TPK%T)) - TPK%K056=TPK%T*TPK%T*7.44E-18*exp(-(1361./TPK%T)) - TPK%K057=1.51E-17*TPK%T*TPK%T*exp(-(492./TPK%T)) - TPK%K058=3.76E-12*exp(-(260.0/TPK%T))+1.70E-12*exp(-(155.0/TPK%T))+1.21E-12*ex& -&p(-(125.0/TPK%T)) - TPK%K059=1.78E-12*exp(-(-438.0/TPK%T))+6.07E-13*exp(-(-500.0/TPK%T))+0.00E-01*& -&exp(-(-448.0/TPK%T)) - TPK%K060=2.54E-11*exp(-(-410.0/TPK%T))+0.00E-01*exp(-(-444.0/TPK%T))+0.00E-01 -! -RETURN -END SUBROUTINE SUBSRG5 -! -SUBROUTINE SUBSRG6 -! -!Indices 61 a 70 -! - TPK%K061=3.31E-12*exp(-(-355.0/TPK%T))+3.45E-13 - TPK%K062=1.00E-11 - TPK%K063=5.55E-12*exp(-(-331.0/TPK%T)) - TPK%K064=TPK%T*TPK%T*5.68E-18*exp(-(-92.0/TPK%T)) - TPK%K065=1.32E-11+1.88E-12*exp(-(-175.0/TPK%T)) - TPK%K066=4.50E-13 - TPK%K067=6.00E-13 - TPK%K068=2.93E-12*exp(-(-190.0/TPK%T)) - TPK%K069=3.36E-12*exp(-(-190.0/TPK%T)) - TPK%K070=3.80E-14+1.59E-14*exp(-(-500.0/TPK%T)) -! -RETURN -END SUBROUTINE SUBSRG6 -! -SUBROUTINE SUBSRG7 -! -!Indices 71 a 80 -! - TPK%K071=5.31E-12*exp(-(260.0/TPK%T)) - TPK%K072=3.40E-13*exp(-(1900.0/TPK%T)) - TPK%K073=1.40E-12*exp(-(1900.0/TPK%T)) - TPK%K074=1.62E-12*exp(-(1900.0/TPK%T))+0.00E-01*exp(-(150.0/TPK%T))+1.94E-14*e& -&xp(-(1000.0/TPK%T)) - TPK%K075=4.92E-16 - TPK%K076=4.35E-18*TPK%T*TPK%T*exp(-(2282.0/TPK%T))+1.91E-14*exp(-(450.0/TPK%T)& -&)+1.08E-15*exp(-(-450.0/TPK%T))+0.00E-01 - TPK%K077=4.00E-12*exp(-(446.0/TPK%T))+0.00E-01*exp(-(-490.0/TPK%T))+0.00E-01 - TPK%K078=3.76E-16*exp(-(500.0/TPK%T)) - TPK%K079=8.17E-15*exp(-(2580.0/TPK%T))+4.32E-16*exp(-(1800.0/TPK%T))+2.87E-17*& -&exp(-(845.0/TPK%T))+0.00E-01*exp(-(2283.0/TPK%T)) - TPK%K080=7.86E-15*exp(-(1913.0/TPK%T))+0.00E-01*exp(-(732.0/TPK%T))+0.00E-01 -! -RETURN -END SUBROUTINE SUBSRG7 -! -SUBROUTINE SUBSRG8 -! -!Indices 81 a 90 -! - TPK%K081=0.00E-01*exp(-(2112.0/TPK%T))+1.38E-19 - TPK%K082=7.20E-17*exp(-(1700.0/TPK%T)) - TPK%K083=2.00E-11 - TPK%K084=1.00E-11 - TPK%K085=3.60E-11 - TPK%K086=1.66E-17*exp(-(-1044.0/TPK%T)) - TPK%K087=2.80E-11 - TPK%K088=TROE(5.86E-01,9.70E-29,5.6,9.30E-12,1.5,TPK%M,TPK%T,KVECNPT) - TPK%K089=TROE_EQUIL(9.70E-29,5.6,9.30E-12,1.5,1.16E+28,13954.,TPK%M,TPK%T,KVEC& -&NPT) - TPK%K090=4.20E-12*exp(-(-180.0/TPK%T)) -! -RETURN -END SUBROUTINE SUBSRG8 -! -SUBROUTINE SUBSRG9 -! -!Indices 91 a 100 -! - TPK%K091=4.36E-12 - TPK%K092=6.93E-12 - TPK%K093=4.00E-12 - TPK%K094=4.00E-12 - TPK%K095=1.22E-11 - TPK%K096=4.00E-12 - TPK%K097=3.80E-13*exp(-(-800.0/TPK%T)) - TPK%K098=6.16E-14*exp(-(-700.0/TPK%T))+1.52E-13*exp(-(-1300.0/TPK%T)) - TPK%K099=1.81E-13*exp(-(-1300.0/TPK%T)) - TPK%K0100=1.28E-13*exp(-(-1300.0/TPK%T))+0.00E-01 -! -RETURN -END SUBROUTINE SUBSRG9 -! -SUBROUTINE SUBSRG10 -! -!Indices 101 a 110 -! - TPK%K0101=3.75E-13*exp(-(-980.0/TPK%T)) - TPK%K0102=5.94E-13*exp(-(-550.0/TPK%T))+1.99E-16*exp(-(-2640.0/TPK%T))+5.56E-1& -&4*exp(-(-1300.0/TPK%T)) - TPK%K103=1.66E-13*exp(-(-1300.0/TPK%T)) - TPK%K104=9.10E-14*exp(-(-416.0/TPK%T)) - TPK%K105=1.03E-14*exp(-(-158.0/TPK%T))+6.24E-14*exp(-(-431.0/TPK%T))+1.53E-14*& -&exp(-(-467.0/TPK%T))+4.34E-15*exp(-(-633.0/TPK%T)) - TPK%K106=1.57E-13*exp(-(-708.0/TPK%T)) - TPK%K107=1.36E-13*exp(-(-708.0/TPK%T)) - TPK%K108=3.56E-14*exp(-(-708.0/TPK%T)) - TPK%K109=1.77E-11*exp(-(440.0/TPK%T))+1.48E-16*exp(-(-2510.0/TPK%T))+3.10E-13*& -&exp(-(-508.0/TPK%T)) - TPK%K110=1.12E-13*exp(-(-708.0/TPK%T)) -! -RETURN -END SUBROUTINE SUBSRG10 -! -SUBROUTINE SUBSRG11 -! -!Indices 111 a 120 -! - TPK%K111=4.44E-14*exp(-(-211.0/TPK%T))+2.23E-13*exp(-(-460.0/TPK%T))+4.10E-14*& -&exp(-(-522.0/TPK%T))+1.17E-14*exp(-(-683.0/TPK%T)) - TPK%K112=4.36E-13*exp(-(-765.0/TPK%T)) - TPK%K113=7.60E-13*exp(-(-765.0/TPK%T)) - TPK%K114=3.63E-13*exp(-(-765.0/TPK%T)) - TPK%K115=7.73E-13*exp(-(-530.0/TPK%T))+1.70E-13*exp(-(-565.0/TPK%T)) - TPK%K116=4.85E-13*exp(-(-765.0/TPK%T)) - TPK%K117=4.19E-15*exp(-(-1000.0/TPK%T)) - TPK%K118=2.48E-14*exp(-(-1000.0/TPK%T)) - TPK%K119=1.20E-12 - TPK%K120=1.20E-12 -! -RETURN -END SUBROUTINE SUBSRG11 -! -SUBROUTINE SUBSRG12 -! -!Indices 121 a 130 -! - TPK%K121=1.20E-12 - TPK%K122=1.20E-12 - TPK%K123=1.20E-12 - TPK%K124=3.48E-12 - TPK%K125=1.20E-12 - TPK%K126=1.66E-13*exp(-(-1300.0/TPK%T)) - TPK%K127=5.99E-15*exp(-(-1510.0/TPK%T)) - TPK%K128=1.69E-14*exp(-(-1560.0/TPK%T)) - TPK%K129=7.13E-17*exp(-(-2950.0/TPK%T)) - TPK%K130=4.00E-12 -! -RETURN -END SUBROUTINE SUBSRG12 -! -SUBROUTINE SUBSRG13 -! -!Indices 131 a 135 -! - TPK%K131=1.20E-12 - TPK%K132=1.00E-40 - TPK%K133=5.40E-13 - TPK%K134=1.30E-11*exp(-(400./TPK%T)) - TPK%K135=(TPK%T*exp(-234./TPK%T)+8.4E-10*exp(7230./TPK%T)+2.68E-10*exp(7810./T& -&PK%T))/(1.04E11*TPK%T+88.1*exp(7460./TPK%T)) -! -RETURN -END SUBROUTINE SUBSRG13 -! -SUBROUTINE SUBSRW0 -! -!Indices 136 a 145 -! - TPK%KTC1=KT(0.05,48.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC - TPK%KTC2=KT(0.11,34.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC - TPK%KTC3=KT(0.0001,30.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC - TPK%KTC4=KT(0.0015,46.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC - TPK%KTC5=KT(0.05,62.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC - TPK%KTC6=KT(0.0037,108.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC - TPK%KTC7=KT(0.05,47.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC - TPK%KTC8=KT(0.054,63.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC - TPK%KTC9=KT(0.05,79.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC - TPK%KTC10=KT(0.04,17.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC -! -RETURN -END SUBROUTINE SUBSRW0 -! -SUBROUTINE SUBSRW1 -! -!Indices 146 a 155 -! - TPK%KTC11=KT(0.05,17.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC - TPK%KTC12=KT(0.2,30.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC - TPK%KTC13=KT(0.0002,44.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC - TPK%KTC14=KT(0.11,64.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC - TPK%KTC15=KT(0.07,98.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC - TPK%KTC16=KT(0.04,30.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC - TPK%KTC17=KT(0.012,46.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC - TPK%KTC18=KT(0.03,60.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC - TPK%KTC19=KT(0.05,47.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC - TPK%KTC20=KT(0.007,48.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC -! -RETURN -END SUBROUTINE SUBSRW1 -! -SUBROUTINE SUBSRW2 -! -!Indices 156 a 165 -! - TPK%KTC21=KT(0.05,48.,TPK%T,TPK%RADC,KVECNPT)/(HENRY(1.03e-2,-2830.,TPK%T,KVEC& -&NPT)*TPK%RCH*TPK%T) - TPK%KTC22=KT(0.11,34.,TPK%T,TPK%RADC,KVECNPT)/(HENRY(8.44e4,-7600.,TPK%T,KVECN& -&PT)*TPK%RCH*TPK%T) - TPK%KTC23=KT(0.0001,30.,TPK%T,TPK%RADC,KVECNPT)/(HENRY(1.92e-3,-1790.,TPK%T,KV& -&ECNPT)*TPK%RCH*TPK%T) - TPK%KTC24=KT(0.0015,46.,TPK%T,TPK%RADC,KVECNPT)/(HENRY(1.2e-2,-2400.,TPK%T,KVE& -&CNPT)*TPK%RCH*TPK%T) - TPK%KTC25=KT(0.05,62.,TPK%T,TPK%RADC,KVECNPT)/(HENRY(3.8e-2,0.,TPK%T,KVECNPT)*& -&TPK%RCH*TPK%T) - TPK%KTC26=KT(0.0037,108.,TPK%T,TPK%RADC,KVECNPT)/(HENRY(8.8e-2,-3600.,TPK%T,KV& -&ECNPT)*TPK%RCH*TPK%T) - TPK%KTC27=KT(0.05,47.,TPK%T,TPK%RADC,KVECNPT)/(HEFFA(5.0e1,-4880.,1.6e-3,1760.& -&,0.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T) - TPK%KTC28=KT(0.054,63.,TPK%T,TPK%RADC,KVECNPT)/(HEFFA(2.1e5,-10500.,2.2e1,0.,0& -&.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T) - TPK%KTC29=KT(0.05,79.,TPK%T,TPK%RADC,KVECNPT)/(HEFFA(1.2e4,-6900.,1.26e-6,0.,0& -&.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T) - TPK%KTC30=KT(0.04,17.,TPK%T,TPK%RADC,KVECNPT)/(HEFFB(6.02e1,-4160.,1.7e-5,4350& -&.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T) -! -RETURN -END SUBROUTINE SUBSRW2 -! -SUBROUTINE SUBSRW3 -! -!Indices 166 a 175 -! - TPK%KTC31=KT(0.05,17.,TPK%T,TPK%RADC,KVECNPT)/(HENRY(3.9e1,0.,TPK%T,KVECNPT)*T& -&PK%RCH*TPK%T) - TPK%KTC32=KT(0.2,30.,TPK%T,TPK%RADC,KVECNPT)/(HEFFA(6.9e2,0.,1.6e-5,0.,0.,0.,T& -&PK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T) - TPK%KTC33=KT(0.0002,44.,TPK%T,TPK%RADC,KVECNPT)/(HEFFA(3.4e-2,-2710.,4.3e-7,92& -&0.,4.7e-11,1780.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T) - TPK%KTC34=KT(0.11,64.,TPK%T,TPK%RADC,KVECNPT)/(HEFFA(1.36,-2930.,1.3e-2,-1965.& -&,6.4e-8,-1430.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T) - TPK%KTC35=KT(0.07,98.,TPK%T,TPK%RADC,KVECNPT)/(HEFFA(2.1e5,-8700.,1.0e3,0.,1.0& -&e-2,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T) - TPK%KTC36=KT(0.04,30.,TPK%T,TPK%RADC,KVECNPT)/(HENRY(3.23e3,-7100.,TPK%T,KVECN& -&PT)*TPK%RCH*TPK%T) - TPK%KTC37=KT(0.012,46.,TPK%T,TPK%RADC,KVECNPT)/(HEFFA(8.9e3,-6100.,1.8e-4,150.& -&,0.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T) - TPK%KTC38=KT(0.03,60.,TPK%T,TPK%RADC,KVECNPT)/(HEFFA(4.1e3,-6200.,1.74e-5,0.,0& -&.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T) - TPK%KTC39=KT(0.05,47.,TPK%T,TPK%RADC,KVECNPT)/(HENRY(2.45e0,-5280.,TPK%T,KVECN& -&PT)*TPK%RCH*TPK%T) - TPK%KTC40=KT(0.007,48.,TPK%T,TPK%RADC,KVECNPT)/(HENRY(3.e2,-5280.,TPK%T,KVECNP& -&T)*TPK%RCH*TPK%T) -! -RETURN -END SUBROUTINE SUBSRW3 -! -SUBROUTINE SUBSRW4 -! -!Indices 176 a 185 -! - TPK%KTR1=KT(0.05,48.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR - TPK%KTR2=KT(0.11,34.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR - TPK%KTR3=KT(0.0001,30.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR - TPK%KTR4=KT(0.0015,46.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR - TPK%KTR5=KT(0.05,62.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR - TPK%KTR6=KT(0.0037,108.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR - TPK%KTR7=KT(0.05,47.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR - TPK%KTR8=KT(0.054,63.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR - TPK%KTR9=KT(0.05,79.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR - TPK%KTR10=KT(0.04,17.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR -! -RETURN -END SUBROUTINE SUBSRW4 -! -SUBROUTINE SUBSRW5 -! -!Indices 186 a 195 -! - TPK%KTR11=KT(0.05,17.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR - TPK%KTR12=KT(0.2,30.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR - TPK%KTR13=KT(0.0002,44.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR - TPK%KTR14=KT(0.11,64.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR - TPK%KTR15=KT(0.07,98.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR - TPK%KTR16=KT(0.04,30.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR - TPK%KTR17=KT(0.012,46.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR - TPK%KTR18=KT(0.03,60.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR - TPK%KTR19=KT(0.05,47.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR - TPK%KTR20=KT(0.007,48.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR -! -RETURN -END SUBROUTINE SUBSRW5 -! -SUBROUTINE SUBSRW6 -! -!Indices 196 a 205 -! - TPK%KTR21=KT(0.05,48.,TPK%T,TPK%RADR,KVECNPT)/(HENRY(1.03e-2,-2830.,TPK%T,KVEC& -&NPT)*TPK%RCH*TPK%T) - TPK%KTR22=KT(0.11,34.,TPK%T,TPK%RADR,KVECNPT)/(HENRY(8.44e4,-7600.,TPK%T,KVECN& -&PT)*TPK%RCH*TPK%T) - TPK%KTR23=KT(0.0001,30.,TPK%T,TPK%RADR,KVECNPT)/(HENRY(1.92e-3,-1790.,TPK%T,KV& -&ECNPT)*TPK%RCH*TPK%T) - TPK%KTR24=KT(0.0015,46.,TPK%T,TPK%RADR,KVECNPT)/(HENRY(1.2e-2,-2400.,TPK%T,KVE& -&CNPT)*TPK%RCH*TPK%T) - TPK%KTR25=KT(0.05,62.,TPK%T,TPK%RADR,KVECNPT)/(HENRY(3.8e-2,0.,TPK%T,KVECNPT)*& -&TPK%RCH*TPK%T) - TPK%KTR26=KT(0.0037,108.,TPK%T,TPK%RADR,KVECNPT)/(HENRY(8.8e-2,-3600.,TPK%T,KV& -&ECNPT)*TPK%RCH*TPK%T) - TPK%KTR27=KT(0.05,47.,TPK%T,TPK%RADR,KVECNPT)/(HEFFA(5.0e1,-4880.,1.6e-3,1760.& -&,0.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T) - TPK%KTR28=KT(0.054,63.,TPK%T,TPK%RADR,KVECNPT)/(HEFFA(2.1e5,-10500.,2.2e1,0.,0& -&.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T) - TPK%KTR29=KT(0.05,79.,TPK%T,TPK%RADR,KVECNPT)/(HEFFA(1.2e4,-6900.,1.26e-6,0.,0& -&.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T) - TPK%KTR30=KT(0.04,17.,TPK%T,TPK%RADR,KVECNPT)/(HEFFB(6.02e1,-4160.,1.7e-5,4350& -&.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T) -! -RETURN -END SUBROUTINE SUBSRW6 -! -SUBROUTINE SUBSRW7 -! -!Indices 206 a 215 -! - TPK%KTR31=KT(0.05,17.,TPK%T,TPK%RADR,KVECNPT)/(HENRY(3.9e1,0.,TPK%T,KVECNPT)*T& -&PK%RCH*TPK%T) - TPK%KTR32=KT(0.2,30.,TPK%T,TPK%RADR,KVECNPT)/(HEFFA(6.9e2,0.,1.6e-5,0.,0.,0.,T& -&PK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T) - TPK%KTR33=KT(0.0002,44.,TPK%T,TPK%RADR,KVECNPT)/(HEFFA(3.4e-2,-2710.,4.3e-7,92& -&0.,4.7e-11,1780.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T) - TPK%KTR34=KT(0.11,64.,TPK%T,TPK%RADR,KVECNPT)/(HEFFA(1.36,-2930.,1.3e-2,-1965.& -&,6.4e-8,-1430.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T) - TPK%KTR35=KT(0.07,98.,TPK%T,TPK%RADR,KVECNPT)/(HEFFA(2.1e5,-8700.,1.0e3,0.,1.0& -&e-2,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T) - TPK%KTR36=KT(0.04,30.,TPK%T,TPK%RADR,KVECNPT)/(HENRY(3.23e3,-7100.,TPK%T,KVECN& -&PT)*TPK%RCH*TPK%T) - TPK%KTR37=KT(0.012,46.,TPK%T,TPK%RADR,KVECNPT)/(HEFFA(8.9e3,-6100.,1.8e-4,150.& -&,0.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T) - TPK%KTR38=KT(0.03,60.,TPK%T,TPK%RADR,KVECNPT)/(HEFFA(4.1e3,-6200.,1.74e-5,0.,0& -&.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T) - TPK%KTR39=KT(0.05,47.,TPK%T,TPK%RADR,KVECNPT)/(HENRY(2.45e0,-5280.,TPK%T,KVECN& -&PT)*TPK%RCH*TPK%T) - TPK%KTR40=KT(0.007,48.,TPK%T,TPK%RADR,KVECNPT)/(HENRY(3.e2,-5280.,TPK%T,KVECNP& -&T)*TPK%RCH*TPK%T) -! -RETURN -END SUBROUTINE SUBSRW7 -! -SUBROUTINE SUBSRW8 -! -!Indices 216 a 225 -! - TPK%KC2=(3.6E+9*exp(-930.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLECCLOUD - TPK%KC3=((2.8E+10*10.**(-TPK%PHC)+3.5E+10*exp(-720.*(1./TPK%T-1./298.15))*1.6e& -&-5)/(1.6e-5+10.**(-TPK%PHC)))/TPK%MOL2MOLECCLOUD - TPK%KC4=(3.2E+7*exp(-1700.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLECCLOUD - TPK%KC5=((8.3E+5*exp(-2700.*(1./TPK%T-1./298.15))*(10.**(-TPK%PHC))**2.+9.6E+7& -&*exp(-910.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)*1.6e-5)/(1.6e-5+10.**(-TPK%PH& -&C))**2.)/TPK%MOL2MOLECCLOUD - TPK%KC6=(1.5E+9*exp(-1500.*(1./TPK%T-1./298.15))*1.6e-5/(1.6e-5+10.**(-TPK%PHC& -&)))/TPK%MOL2MOLECCLOUD - TPK%KC7=(2.7E+9*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)/(1.3e-2& -&*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-2& -&*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)+(10.**(-TPK%PHC))**2.))/TPK%M& -&OL2MOLECCLOUD - TPK%KC8=(1.0E+10*10.**(-TPK%PHC)/(1.6e-3*exp(-1760.*(1./TPK%T-1./298.15))+10.*& -&*(-TPK%PHC)))/TPK%MOL2MOLECCLOUD - TPK%KC9=((1.8E+9*10.**(-TPK%PHC)+4.5E+9*1.6e-5)/(1.6e-5+10.**(-TPK%PHC)))/TPK%& -&MOL2MOLECCLOUD - TPK%KC10=2.6E-2*10.**(-TPK%PHC)/(1.26e-6+10.**(-TPK%PHC)) -! -RETURN -END SUBROUTINE SUBSRW8 -! -SUBROUTINE SUBSRW9 -! -!Indices 226 a 235 -! - TPK%KC11=1.1E0*1.26e-6/(1.26e-6+10.**(-TPK%PHC)) - TPK%KC12=(3.3E+5*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*(10.**(-TPK%PHC))**2./& -&((1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15)& -&)+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)+(10.**(-TPK%PHC))**2.& -&)*(1.26e-6+10.**(-TPK%PHC))))/TPK%MOL2MOLECCLOUD - TPK%KC14=1.0E+10 - TPK%KC15=(1.0E+5*1.0e+3*1.0e-2/(1.0e+3*1.0e-2+1.0e+3*10.**(-TPK%PHC)+(10.**(-T& -&PK%PHC))**2.))/TPK%MOL2MOLECCLOUD - TPK%KC16=(1.3E+9*exp(-2200.*(1./TPK%T-1./298.15))*1.3e-2*exp(1965.*(1./TPK%T-1& -&./298.15))*10.**(-TPK%PHC)/(1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(& -&1430.*(1./TPK%T-1./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%& -&PHC)+(10.**(-TPK%PHC))**2.))/TPK%MOL2MOLECCLOUD - TPK%KC17=(1.7E+8*exp(-2200.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLECCLOUD - TPK%KC18=(5.0E+5*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)/(1.3e-& -&2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-& -&2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)+(10.**(-TPK%PHC))**2.))/TPK%& -&MOL2MOLECCLOUD - TPK%KC19=(7.8E+8*exp(-1000.*(1./TPK%T-1./298.15))*2.5e3*exp(4030.*(1./TPK%T-1.& -&/298.15))/(1.+2.5e3*exp(4030.*(1./TPK%T-1./298.15))))/TPK%MOL2MOLECCLOUD - TPK%KC20=((1.0E+8*exp(-1000.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)+3.4E+9*exp(& -&-1200.*(1./TPK%T-1./298.15))*1.8e-4*exp(150.*(1./TPK%T-1./298.15)))/(1.8e-4*ex& -&p(150.*(1./TPK%T-1./298.15))+10.**(-TPK%PHC)))/TPK%MOL2MOLECCLOUD -! -RETURN -END SUBROUTINE SUBSRW9 -! -SUBROUTINE SUBSRW10 -! -!Indices 236 a 245 -! - TPK%KC21=((7.9E+2*exp(-2900.*(1./TPK%T-1./298.15))*1.3e-2*exp(1965.*(1./TPK%T-& -&1./298.15))*10.**(-TPK%PHC)+2.5E+7*exp(-2450.*(1./TPK%T-1./298.15))*1.3e-2*exp& -&(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15)))/((1.3e-2*& -&exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-2*& -&exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)+(10.**(-TPK%PHC))**2.)*(1.+2.5& -&e3*exp(4030.*(1./TPK%T-1./298.15)))))/TPK%MOL2MOLECCLOUD - TPK%KC22=7.7E-3*exp(-9200.*(1./TPK%T-1./298.15))+3.7E+3*1.e-14*EXP(-6716*(1./T& -&PK%T-1./298.15))/10.**(-TPK%PHC) - TPK%KC23=3.0E+8/TPK%MOL2MOLECCLOUD - TPK%KC24=1.1E+9 - TPK%KC25=(1.7E+9*10.**(-TPK%PHC)/(1.6e-5+10.**(-TPK%PHC)))/TPK%MOL2MOLECCLOUD - TPK%KC26=(2.2E+8*exp(-2600.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLECCLOUD - TPK%KC27=(7.1E+6*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)*10.**(& -&-TPK%PHC)/(1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1& -&./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)+(10.**(-TPK%& -&PHC))**2.))/TPK%MOL2MOLECCLOUD - TPK%KC28=4.6E+2*exp(-1100.*(1./TPK%T-1./298.15)) - TPK%KC29=((3.7E+5*exp(-5500.*(1./TPK%T-1./298.15))*1.3e-2*exp(1965.*(1./TPK%T-& -&1./298.15))*10.**(-TPK%PHC)+1.5E+9*exp(-5300.*(1./TPK%T-1./298.15))*1.3e-2*exp& -&(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15)))/(1.3e-2*e& -&xp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-2*e& -&xp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)+(10.**(-TPK%PHC))**2.))/TPK%MOL& -&2MOLECCLOUD - TPK%KC30=(9.1E+7*exp(-3600.*(1./TPK%T-1./298.15))*1.3e-2*exp(1965.*(1./TPK%T-1& -&./298.15))*10.**(-TPK%PHC)*10.**(-TPK%PHC)/(1.3e-2*exp(1965.*(1./TPK%T-1./298.& -&15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.& -&15))*10.**(-TPK%PHC)+(10.**(-TPK%PHC))**2.))/TPK%MOL2MOLECCLOUD -! -RETURN -END SUBROUTINE SUBSRW10 -! -SUBROUTINE SUBSRW11 -! -!Indices 246 a 255 -! - TPK%KR2=(3.6E+9*exp(-930.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLECRAIN - TPK%KR3=((2.8E+10*10.**(-TPK%PHR)+3.5E+10*exp(-720.*(1./TPK%T-1./298.15))*1.6e& -&-5)/(1.6e-5+10.**(-TPK%PHR)))/TPK%MOL2MOLECRAIN - TPK%KR4=(3.2E+7*exp(-1700.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLECRAIN - TPK%KR5=((8.3E+5*exp(-2700.*(1./TPK%T-1./298.15))*(10.**(-TPK%PHR))**2.+9.6E+7& -&*exp(-910.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)*1.6e-5)/(1.6e-5+10.**(-TPK%PH& -&R))**2.)/TPK%MOL2MOLECRAIN - TPK%KR6=(1.5E+9*exp(-1500.*(1./TPK%T-1./298.15))*1.6e-5/(1.6e-5+10.**(-TPK%PHR& -&)))/TPK%MOL2MOLECRAIN - TPK%KR7=(2.7E+9*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)/(1.3e-2& -&*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-2& -&*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)+(10.**(-TPK%PHR))**2.))/TPK%M& -&OL2MOLECRAIN - TPK%KR8=(1.0E+10*10.**(-TPK%PHR)/(1.6e-3*exp(-1760.*(1./TPK%T-1./298.15))+10.*& -&*(-TPK%PHR)))/TPK%MOL2MOLECRAIN - TPK%KR9=((1.8E+9*10.**(-TPK%PHR)+4.5E+9*1.6e-5)/(1.6e-5+10.**(-TPK%PHR)))/TPK%& -&MOL2MOLECRAIN - TPK%KR10=2.6E-2*10.**(-TPK%PHR)/(1.26e-6+10.**(-TPK%PHR)) -! -RETURN -END SUBROUTINE SUBSRW11 -! -SUBROUTINE SUBSRW12 -! -!Indices 256 a 265 -! - TPK%KR11=1.1E0*1.26e-6/(1.26e-6+10.**(-TPK%PHR)) - TPK%KR12=(3.3E+5*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*(10.**(-TPK%PHR))**2./& -&((1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15)& -&)+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)+(10.**(-TPK%PHR))**2.& -&)*(1.26e-6+10.**(-TPK%PHR))))/TPK%MOL2MOLECRAIN - TPK%KR14=1.0E+10 - TPK%KR15=(1.0E+5*1.0e+3*1.0e-2/(1.0e+3*1.0e-2+1.0e+3*10.**(-TPK%PHR)+(10.**(-T& -&PK%PHR))**2.))/TPK%MOL2MOLECRAIN - TPK%KR16=(1.3E+9*exp(-2200.*(1./TPK%T-1./298.15))*1.3e-2*exp(1965.*(1./TPK%T-1& -&./298.15))*10.**(-TPK%PHR)/(1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(& -&1430.*(1./TPK%T-1./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%& -&PHR)+(10.**(-TPK%PHR))**2.))/TPK%MOL2MOLECRAIN - TPK%KR17=(1.7E+8*exp(-2200.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLECRAIN - TPK%KR18=(5.0E+5*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)/(1.3e-& -&2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-& -&2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)+(10.**(-TPK%PHR))**2.))/TPK%& -&MOL2MOLECRAIN - TPK%KR19=(7.8E+8*exp(-1000.*(1./TPK%T-1./298.15))*2.5e3*exp(4030.*(1./TPK%T-1.& -&/298.15))/(1.+2.5e3*exp(4030.*(1./TPK%T-1./298.15))))/TPK%MOL2MOLECRAIN - TPK%KR20=((1.0E+8*exp(-1000.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)+3.4E+9*exp(& -&-1200.*(1./TPK%T-1./298.15))*1.8e-4*exp(150.*(1./TPK%T-1./298.15)))/(1.8e-4*ex& -&p(150.*(1./TPK%T-1./298.15))+10.**(-TPK%PHR)))/TPK%MOL2MOLECRAIN -! -RETURN -END SUBROUTINE SUBSRW12 -! -SUBROUTINE SUBSRW13 -! -!Indices 266 a 275 -! - TPK%KR21=((7.9E+2*exp(-2900.*(1./TPK%T-1./298.15))*1.3e-2*exp(1965.*(1./TPK%T-& -&1./298.15))*10.**(-TPK%PHR)+2.5E+7*exp(-2450.*(1./TPK%T-1./298.15))*1.3e-2*exp& -&(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15)))/((1.3e-2*& -&exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-2*& -&exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)+(10.**(-TPK%PHR))**2.)*(1.+2.5& -&e3*exp(4030.*(1./TPK%T-1./298.15)))))/TPK%MOL2MOLECRAIN - TPK%KR22=7.7E-3*exp(-9200.*(1./TPK%T-1./298.15))+3.7E+3*1.e-14*EXP(-6716*(1./T& -&PK%T-1./298.15))/10.**(-TPK%PHR) - TPK%KR23=3.0E+8/TPK%MOL2MOLECRAIN - TPK%KR24=1.1E+9 - TPK%KR25=(1.7E+9*10.**(-TPK%PHR)/(1.6e-5+10.**(-TPK%PHR)))/TPK%MOL2MOLECRAIN - TPK%KR26=(2.2E+8*exp(-2600.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLECRAIN - TPK%KR27=(7.1E+6*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)*10.**(& -&-TPK%PHR)/(1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1& -&./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)+(10.**(-TPK%& -&PHR))**2.))/TPK%MOL2MOLECRAIN - TPK%KR28=4.6E+2*exp(-1100.*(1./TPK%T-1./298.15)) - TPK%KR29=((3.7E+5*exp(-5500.*(1./TPK%T-1./298.15))*1.3e-2*exp(1965.*(1./TPK%T-& -&1./298.15))*10.**(-TPK%PHR)+1.5E+9*exp(-5300.*(1./TPK%T-1./298.15))*1.3e-2*exp& -&(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15)))/(1.3e-2*e& -&xp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-2*e& -&xp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)+(10.**(-TPK%PHR))**2.))/TPK%MOL& -&2MOLECRAIN - TPK%KR30=(9.1E+7*exp(-3600.*(1./TPK%T-1./298.15))*1.3e-2*exp(1965.*(1./TPK%T-1& -&./298.15))*10.**(-TPK%PHR)*10.**(-TPK%PHR)/(1.3e-2*exp(1965.*(1./TPK%T-1./298.& -&15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.& -&15))*10.**(-TPK%PHR)+(10.**(-TPK%PHR))**2.))/TPK%MOL2MOLECRAIN -! -RETURN -END SUBROUTINE SUBSRW13 -! -END SUBROUTINE CH_SET_RATES -! -! -!======================================================================== -! -!! ############################## - MODULE MODI_CH_SET_PHOTO_RATES -!! ############################## -!! This code has been created automatically by preprocessor m10, -!! version: 9.7, copyright 1995-1999 by Meteo France/Universite Paul Sabatier. -!! Please report all bugs to K. Suhre (Lab. d'Aerologie UPS/CNRS). -INTERFACE -SUBROUTINE CH_SET_PHOTO_RATES(PTIME,PCONC,KL,TPM,KMI,KOUT,KVERB,KVECNPT,KVECMASK,KEQ,PJVALUES) -USE MODD_CH_M9_n, ONLY: METEOTRANSTYPE -IMPLICIT NONE -REAL, INTENT(IN) :: PTIME -INTEGER, INTENT(IN) :: KVECNPT,KL,KEQ,KMI -INTEGER, DIMENSION(:,:), INTENT(IN) :: KVECMASK -REAL, INTENT(IN), DIMENSION(KVECNPT,KEQ) :: PCONC -TYPE(METEOTRANSTYPE), DIMENSION(KVECNPT), INTENT(IN) :: TPM -INTEGER, INTENT(IN) :: KOUT,KVERB -REAL,DIMENSION(:,:,:,:), INTENT(IN) :: PJVALUES ! Tuv coefficient -END SUBROUTINE CH_SET_PHOTO_RATES -END INTERFACE -END MODULE MODI_CH_SET_PHOTO_RATES -! -!======================================================================== -! -!! ############################################################# - SUBROUTINE CH_SET_PHOTO_RATES(PTIME,PCONC,KL,TPM,KMI,KOUT,KVERB,KVECNPT,KVECMASK,KEQ,PJVALUES) -!! ############################################################# -!! This code has been created automatically by preprocessor m10, -!! version: 9.7, copyright 1995-1999 by Meteo France/Universite Paul Sabatier. -!! Please report all bugs to K. Suhre (Lab. d'Aerologie UPS/CNRS). -!!*** *MODD_CH_SET_PHOTO_RATES* -!! -!! PURPOSE -!! ------- -! set or calculate photolysis rates -!! -!!** METHOD -!! ------ -!! simple -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Karsten Suhre (LA) -!! -!! MODIFICATIONS -!! ------------- -!! Original 26/07/96 -!! Modified 05/05/98: Vectorization (Vincent Crassier & KS) -!! Modified 29/03/01: Vectorization + nesting (C. Mari) -!! Modified 31/10/03: New interface for better MesoNH compilation (D. Gazen) -!! -!!---------------------------------------------------------------------- -!! -!! EXTERNAL -!! -------- -!! none -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -USE MODD_CH_M9_SCHEME -USE MODD_CH_M9_n, ONLY : METEOTRANSTYPE -USE MODI_CH_ALLOCATE_TACCS -! USER DEFINED FUNCTIONS -USE MODI_KT -USE MODI_TROE -USE MODI_HENRY -USE MODI_HEFFA -USE MODI_TROE_EQUIL -USE MODI_HEFFB -!! -!! EXPLICIT ARGUMENTS -!! ------------------ -IMPLICIT NONE -REAL, INTENT(IN) :: PTIME -INTEGER, INTENT(IN) :: KVECNPT,KL,KEQ,KMI -INTEGER, DIMENSION(:,:), INTENT(IN) :: KVECMASK -REAL, INTENT(IN), DIMENSION(KVECNPT,KEQ) :: PCONC -TYPE(METEOTRANSTYPE), DIMENSION(KVECNPT), INTENT(IN) :: TPM -INTEGER, INTENT(IN) :: KOUT,KVERB -REAL,DIMENSION(:,:,:,:), INTENT(IN) :: PJVALUES ! Tuv coefficient -!! -! /BEGIN_SET_PHOTO_RATES/ -! parameter for use by subroutine JVALUES, -! contains the actual photolysis rates -REAL, DIMENSION(KVECNPT,42) :: ZRATESIO ! TUV photolysis rates at one level -REAL, DIMENSION(KVECNPT,19) :: ZRATES ! photolysis rates of ReLACS (vector) -INTEGER :: JITPK ! loop counter for J-Value transfer -INTEGER :: IDTI,IDTJ -INTEGER :: JITPKPLUS -INTEGER, DIMENSION(KVECNPT) :: ITABI, ITABJ -INTEGER, DIMENSION(KVECNPT) :: IMODELLEVEL -TYPE(CCSTYPE), POINTER :: TPK -! -! Normally allocated in CH_SET_RATES but who knows ? -IF (.NOT. ASSOCIATED(TACCS(KMI)%NVERB)) THEN - CALL CH_ALLOCATE_TACCS(KMI, KVECNPT) -END IF -! -! TPK is set for current model -TPK=>TACCS(KMI) -! -! calculation of photolysis rates and transfer into local variables -! -IDTI=KVECMASK(2,KL)-KVECMASK(1,KL)+1 -IDTJ=KVECMASK(4,KL)-KVECMASK(3,KL)+1 -DO JITPK = 0, KVECNPT-1 -! - JITPKPLUS=JITPK+1 - ITABI(JITPKPLUS)=JITPK-IDTI*(JITPK/IDTI)+KVECMASK(1,KL) - ITABJ(JITPKPLUS)=JITPK/IDTI-IDTJ*(JITPK/(IDTI*IDTJ))+KVECMASK(3,KL) -! - ZRATESIO(JITPKPLUS,:) = PJVALUES(ITABI(JITPKPLUS),ITABJ(JITPKPLUS),TPK%MODELLEVEL(JITPKPLUS),:) -! -ENDDO -! -! -DO JITPK = 0, KVECNPT-1 -! -! associate TUV J-Values to ReLACS J-Values -! -! change according to original coefficients and modified RACM -! - ZRATES(JITPK+1, 1) = ZRATESIO(JITPK+1,5) - ZRATES(JITPK+1, 2) = ZRATESIO(JITPK+1,2) - ZRATES(JITPK+1, 3) = ZRATESIO(JITPK+1,3) - ZRATES(JITPK+1, 4) = ZRATESIO(JITPK+1,8) - ZRATES(JITPK+1, 5) = ZRATESIO(JITPK+1,9) - ZRATES(JITPK+1, 6) = ZRATESIO(JITPK+1,10) - ZRATES(JITPK+1, 7) = ZRATESIO(JITPK+1,6) - ZRATES(JITPK+1, 8) = ZRATESIO(JITPK+1,7) - ZRATES(JITPK+1, 9) = ZRATESIO(JITPK+1,4) - ZRATES(JITPK+1, 10) = ZRATESIO(JITPK+1,12) - ZRATES(JITPK+1, 11) = ZRATESIO(JITPK+1,11) - ZRATES(JITPK+1, 12) = ZRATESIO(JITPK+1,13) - ZRATES(JITPK+1, 13) = ZRATESIO(JITPK+1,17) - ZRATES(JITPK+1, 14) = 0.962055 *ZRATESIO(JITPK+1,17)+& - & 3.79454E-02 *ZRATESIO(JITPK+1,38) - ZRATES(JITPK+1, 15) = ZRATESIO(JITPK+1,33) - ZRATES(JITPK+1, 16) = 0.20842 *ZRATESIO(JITPK+1,35)& - &+ 6.43207E-02 *ZRATESIO(JITPK+1,36)& - &+ 3.10372E-02 *ZRATESIO(JITPK+1,34)& - &+ 0.376 *ZRATESIO(JITPK+1,37)& - &+ 0.31937 *ZRATESIO(JITPK+1,26) - ZRATES(JITPK+1, 17) = 0.20*ZRATESIO(JITPK+1,20)& - &+ 0.80*ZRATESIO(JITPK+1,21) -! aqueous phase photolysis - ZRATES(JITPK+1, 18) = ZRATESIO(JITPK+1,41) - ZRATES(JITPK+1, 19) = ZRATESIO(JITPK+1,42) -! -END DO -! -! /END_SET_PHOTO_RATES/ - TPK%K001=ZRATES(:,001) - TPK%K002=ZRATES(:,002) - TPK%K003=ZRATES(:,003) - TPK%K004=ZRATES(:,004) - TPK%K005=ZRATES(:,005) - TPK%K006=ZRATES(:,006) - TPK%K007=ZRATES(:,007) - TPK%K008=ZRATES(:,008) - TPK%K009=ZRATES(:,009) - TPK%K010=ZRATES(:,010) - TPK%K011=ZRATES(:,011) - TPK%K012=ZRATES(:,012) - TPK%K013=ZRATES(:,013) - TPK%K014=ZRATES(:,014) - TPK%K015=ZRATES(:,015) - TPK%K016=ZRATES(:,016) - TPK%K017=ZRATES(:,017) -IF (TPK%LUSECHAQ) THEN - TPK%KC1=ZRATES(:,018) - TPK%KC13=ZRATES(:,019)*2.2e+1/(2.2e+1+10.**(-TPK%PHC)) - TPK%KR1=ZRATES(:,018) - TPK%KR13=ZRATES(:,019)*2.2e+1/(2.2e+1+10.**(-TPK%PHR)) -END IF -TPK%NOUT = KOUT -TPK%NVERB = KVERB -RETURN -END SUBROUTINE CH_SET_PHOTO_RATES -! -! -!======================================================================== -! -!! ######################## - MODULE MODI_CH_GET_RATES -!! ######################## -!! This code has been created automatically by preprocessor m10, -!! version: 9.7, copyright 1995-1999 by Meteo France/Universite Paul Sabatier. -!! Please report all bugs to K. Suhre (Lab. d'Aerologie UPS/CNRS). -INTERFACE -SUBROUTINE CH_GET_RATES(PRATE,KMI,KVECNPT,KREAC) -IMPLICIT NONE -INTEGER, INTENT(IN) :: KVECNPT -INTEGER, INTENT(IN) :: KREAC -REAL, INTENT(OUT), DIMENSION(KVECNPT,KREAC) :: PRATE -INTEGER, INTENT(IN) :: KMI -END SUBROUTINE CH_GET_RATES -END INTERFACE -END MODULE MODI_CH_GET_RATES -! -!======================================================================== -! -!! ############################################ - SUBROUTINE CH_GET_RATES(PRATE,KMI,KVECNPT,KREAC) -!! ############################################ -!! This code has been created automatically by preprocessor m10, -!! version: 9.7, copyright 1995-1999 by Meteo France/Universite Paul Sabatier. -!! Please report all bugs to K. Suhre (Lab. d'Aerologie UPS/CNRS). -!! -!!*** *MODD_CH_GETRATES* -!! -!! PURPOSE -!! ------- -! retrieve reaction rates from TPK in an array -!! -!!** METHOD -!! ------ -!! simple -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Karsten Suhre (LA) -!! -!! MODIFICATIONS -!! ------------- -!! Original 26/07/96 -!! Modified 05/05/98: Vectorization (Vincent Crassier & KS) -!! Modified 31/10/03: New interface for better MesoNH compilation (D. Gazen) -!! -!!---------------------------------------------------------------------- -!! -!! EXTERNAL -!! -------- -!! none -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -USE MODD_CH_M9_SCHEME -!! -!! EXPLICIT ARGUMENTS -!! ------------------ -IMPLICIT NONE -INTEGER, INTENT(IN) :: KVECNPT -INTEGER, INTENT(IN) :: KREAC -REAL, INTENT(OUT), DIMENSION(KVECNPT,KREAC) :: PRATE -INTEGER, INTENT(IN) :: KMI -!! -!! LOCAL VARIABLES -!! --------------- -TYPE(CCSTYPE), POINTER :: TPK -!!---------------------------------------------------------------------- -!! -!! EXECUTABLE STATEMENTS -!! --------------------- -TPK=>TACCS(KMI) -!! -PRATE(:,1) = TPK%K001(:) -PRATE(:,2) = TPK%K002(:) -PRATE(:,3) = TPK%K003(:) -PRATE(:,4) = TPK%K004(:) -PRATE(:,5) = TPK%K005(:) -PRATE(:,6) = TPK%K006(:) -PRATE(:,7) = TPK%K007(:) -PRATE(:,8) = TPK%K008(:) -PRATE(:,9) = TPK%K009(:) -PRATE(:,10) = TPK%K010(:) -PRATE(:,11) = TPK%K011(:) -PRATE(:,12) = TPK%K012(:) -PRATE(:,13) = TPK%K013(:) -PRATE(:,14) = TPK%K014(:) -PRATE(:,15) = TPK%K015(:) -PRATE(:,16) = TPK%K016(:) -PRATE(:,17) = TPK%K017(:) -PRATE(:,18) = TPK%K018(:) -PRATE(:,19) = TPK%K019(:) -PRATE(:,20) = TPK%K020(:) -PRATE(:,21) = TPK%K021(:) -PRATE(:,22) = TPK%K022(:) -PRATE(:,23) = TPK%K023(:) -PRATE(:,24) = TPK%K024(:) -PRATE(:,25) = TPK%K025(:) -PRATE(:,26) = TPK%K026(:) -PRATE(:,27) = TPK%K027(:) -PRATE(:,28) = TPK%K028(:) -PRATE(:,29) = TPK%K029(:) -PRATE(:,30) = TPK%K030(:) -PRATE(:,31) = TPK%K031(:) -PRATE(:,32) = TPK%K032(:) -PRATE(:,33) = TPK%K033(:) -PRATE(:,34) = TPK%K034(:) -PRATE(:,35) = TPK%K035(:) -PRATE(:,36) = TPK%K036(:) -PRATE(:,37) = TPK%K037(:) -PRATE(:,38) = TPK%K038(:) -PRATE(:,39) = TPK%K039(:) -PRATE(:,40) = TPK%K040(:) -PRATE(:,41) = TPK%K041(:) -PRATE(:,42) = TPK%K042(:) -PRATE(:,43) = TPK%K043(:) -PRATE(:,44) = TPK%K044(:) -PRATE(:,45) = TPK%K045(:) -PRATE(:,46) = TPK%K046(:) -PRATE(:,47) = TPK%K047(:) -PRATE(:,48) = TPK%K048(:) -PRATE(:,49) = TPK%K049(:) -PRATE(:,50) = TPK%K050(:) -PRATE(:,51) = TPK%K051(:) -PRATE(:,52) = TPK%K052(:) -PRATE(:,53) = TPK%K053(:) -PRATE(:,54) = TPK%K054(:) -PRATE(:,55) = TPK%K055(:) -PRATE(:,56) = TPK%K056(:) -PRATE(:,57) = TPK%K057(:) -PRATE(:,58) = TPK%K058(:) -PRATE(:,59) = TPK%K059(:) -PRATE(:,60) = TPK%K060(:) -PRATE(:,61) = TPK%K061(:) -PRATE(:,62) = TPK%K062(:) -PRATE(:,63) = TPK%K063(:) -PRATE(:,64) = TPK%K064(:) -PRATE(:,65) = TPK%K065(:) -PRATE(:,66) = TPK%K066(:) -PRATE(:,67) = TPK%K067(:) -PRATE(:,68) = TPK%K068(:) -PRATE(:,69) = TPK%K069(:) -PRATE(:,70) = TPK%K070(:) -PRATE(:,71) = TPK%K071(:) -PRATE(:,72) = TPK%K072(:) -PRATE(:,73) = TPK%K073(:) -PRATE(:,74) = TPK%K074(:) -PRATE(:,75) = TPK%K075(:) -PRATE(:,76) = TPK%K076(:) -PRATE(:,77) = TPK%K077(:) -PRATE(:,78) = TPK%K078(:) -PRATE(:,79) = TPK%K079(:) -PRATE(:,80) = TPK%K080(:) -PRATE(:,81) = TPK%K081(:) -PRATE(:,82) = TPK%K082(:) -PRATE(:,83) = TPK%K083(:) -PRATE(:,84) = TPK%K084(:) -PRATE(:,85) = TPK%K085(:) -PRATE(:,86) = TPK%K086(:) -PRATE(:,87) = TPK%K087(:) -PRATE(:,88) = TPK%K088(:) -PRATE(:,89) = TPK%K089(:) -PRATE(:,90) = TPK%K090(:) -PRATE(:,91) = TPK%K091(:) -PRATE(:,92) = TPK%K092(:) -PRATE(:,93) = TPK%K093(:) -PRATE(:,94) = TPK%K094(:) -PRATE(:,95) = TPK%K095(:) -PRATE(:,96) = TPK%K096(:) -PRATE(:,97) = TPK%K097(:) -PRATE(:,98) = TPK%K098(:) -PRATE(:,99) = TPK%K099(:) -PRATE(:,100) = TPK%K0100(:) -PRATE(:,101) = TPK%K0101(:) -PRATE(:,102) = TPK%K0102(:) -PRATE(:,103) = TPK%K103(:) -PRATE(:,104) = TPK%K104(:) -PRATE(:,105) = TPK%K105(:) -PRATE(:,106) = TPK%K106(:) -PRATE(:,107) = TPK%K107(:) -PRATE(:,108) = TPK%K108(:) -PRATE(:,109) = TPK%K109(:) -PRATE(:,110) = TPK%K110(:) -PRATE(:,111) = TPK%K111(:) -PRATE(:,112) = TPK%K112(:) -PRATE(:,113) = TPK%K113(:) -PRATE(:,114) = TPK%K114(:) -PRATE(:,115) = TPK%K115(:) -PRATE(:,116) = TPK%K116(:) -PRATE(:,117) = TPK%K117(:) -PRATE(:,118) = TPK%K118(:) -PRATE(:,119) = TPK%K119(:) -PRATE(:,120) = TPK%K120(:) -PRATE(:,121) = TPK%K121(:) -PRATE(:,122) = TPK%K122(:) -PRATE(:,123) = TPK%K123(:) -PRATE(:,124) = TPK%K124(:) -PRATE(:,125) = TPK%K125(:) -PRATE(:,126) = TPK%K126(:) -PRATE(:,127) = TPK%K127(:) -PRATE(:,128) = TPK%K128(:) -PRATE(:,129) = TPK%K129(:) -PRATE(:,130) = TPK%K130(:) -PRATE(:,131) = TPK%K131(:) -PRATE(:,132) = TPK%K132(:) -PRATE(:,133) = TPK%K133(:) -PRATE(:,134) = TPK%K134(:) -PRATE(:,135) = TPK%K135(:) -IF (TPK%LUSECHAQ) THEN - PRATE(:,136) = TPK%KTC1(:) - PRATE(:,137) = TPK%KTC2(:) - PRATE(:,138) = TPK%KTC3(:) - PRATE(:,139) = TPK%KTC4(:) - PRATE(:,140) = TPK%KTC5(:) - PRATE(:,141) = TPK%KTC6(:) - PRATE(:,142) = TPK%KTC7(:) - PRATE(:,143) = TPK%KTC8(:) - PRATE(:,144) = TPK%KTC9(:) - PRATE(:,145) = TPK%KTC10(:) - PRATE(:,146) = TPK%KTC11(:) - PRATE(:,147) = TPK%KTC12(:) - PRATE(:,148) = TPK%KTC13(:) - PRATE(:,149) = TPK%KTC14(:) - PRATE(:,150) = TPK%KTC15(:) - PRATE(:,151) = TPK%KTC16(:) - PRATE(:,152) = TPK%KTC17(:) - PRATE(:,153) = TPK%KTC18(:) - PRATE(:,154) = TPK%KTC19(:) - PRATE(:,155) = TPK%KTC20(:) - PRATE(:,156) = TPK%KTC21(:) - PRATE(:,157) = TPK%KTC22(:) - PRATE(:,158) = TPK%KTC23(:) - PRATE(:,159) = TPK%KTC24(:) - PRATE(:,160) = TPK%KTC25(:) - PRATE(:,161) = TPK%KTC26(:) - PRATE(:,162) = TPK%KTC27(:) - PRATE(:,163) = TPK%KTC28(:) - PRATE(:,164) = TPK%KTC29(:) - PRATE(:,165) = TPK%KTC30(:) - PRATE(:,166) = TPK%KTC31(:) - PRATE(:,167) = TPK%KTC32(:) - PRATE(:,168) = TPK%KTC33(:) - PRATE(:,169) = TPK%KTC34(:) - PRATE(:,170) = TPK%KTC35(:) - PRATE(:,171) = TPK%KTC36(:) - PRATE(:,172) = TPK%KTC37(:) - PRATE(:,173) = TPK%KTC38(:) - PRATE(:,174) = TPK%KTC39(:) - PRATE(:,175) = TPK%KTC40(:) - PRATE(:,176) = TPK%KTR1(:) - PRATE(:,177) = TPK%KTR2(:) - PRATE(:,178) = TPK%KTR3(:) - PRATE(:,179) = TPK%KTR4(:) - PRATE(:,180) = TPK%KTR5(:) - PRATE(:,181) = TPK%KTR6(:) - PRATE(:,182) = TPK%KTR7(:) - PRATE(:,183) = TPK%KTR8(:) - PRATE(:,184) = TPK%KTR9(:) - PRATE(:,185) = TPK%KTR10(:) - PRATE(:,186) = TPK%KTR11(:) - PRATE(:,187) = TPK%KTR12(:) - PRATE(:,188) = TPK%KTR13(:) - PRATE(:,189) = TPK%KTR14(:) - PRATE(:,190) = TPK%KTR15(:) - PRATE(:,191) = TPK%KTR16(:) - PRATE(:,192) = TPK%KTR17(:) - PRATE(:,193) = TPK%KTR18(:) - PRATE(:,194) = TPK%KTR19(:) - PRATE(:,195) = TPK%KTR20(:) - PRATE(:,196) = TPK%KTR21(:) - PRATE(:,197) = TPK%KTR22(:) - PRATE(:,198) = TPK%KTR23(:) - PRATE(:,199) = TPK%KTR24(:) - PRATE(:,200) = TPK%KTR25(:) - PRATE(:,201) = TPK%KTR26(:) - PRATE(:,202) = TPK%KTR27(:) - PRATE(:,203) = TPK%KTR28(:) - PRATE(:,204) = TPK%KTR29(:) - PRATE(:,205) = TPK%KTR30(:) - PRATE(:,206) = TPK%KTR31(:) - PRATE(:,207) = TPK%KTR32(:) - PRATE(:,208) = TPK%KTR33(:) - PRATE(:,209) = TPK%KTR34(:) - PRATE(:,210) = TPK%KTR35(:) - PRATE(:,211) = TPK%KTR36(:) - PRATE(:,212) = TPK%KTR37(:) - PRATE(:,213) = TPK%KTR38(:) - PRATE(:,214) = TPK%KTR39(:) - PRATE(:,215) = TPK%KTR40(:) - PRATE(:,216) = TPK%KC1(:) - PRATE(:,217) = TPK%KC2(:) - PRATE(:,218) = TPK%KC3(:) - PRATE(:,219) = TPK%KC4(:) - PRATE(:,220) = TPK%KC5(:) - PRATE(:,221) = TPK%KC6(:) - PRATE(:,222) = TPK%KC7(:) - PRATE(:,223) = TPK%KC8(:) - PRATE(:,224) = TPK%KC9(:) - PRATE(:,225) = TPK%KC10(:) - PRATE(:,226) = TPK%KC11(:) - PRATE(:,227) = TPK%KC12(:) - PRATE(:,228) = TPK%KC13(:) - PRATE(:,229) = TPK%KC14(:) - PRATE(:,230) = TPK%KC15(:) - PRATE(:,231) = TPK%KC16(:) - PRATE(:,232) = TPK%KC17(:) - PRATE(:,233) = TPK%KC18(:) - PRATE(:,234) = TPK%KC19(:) - PRATE(:,235) = TPK%KC20(:) - PRATE(:,236) = TPK%KC21(:) - PRATE(:,237) = TPK%KC22(:) - PRATE(:,238) = TPK%KC23(:) - PRATE(:,239) = TPK%KC24(:) - PRATE(:,240) = TPK%KC25(:) - PRATE(:,241) = TPK%KC26(:) - PRATE(:,242) = TPK%KC27(:) - PRATE(:,243) = TPK%KC28(:) - PRATE(:,244) = TPK%KC29(:) - PRATE(:,245) = TPK%KC30(:) - PRATE(:,246) = TPK%KR1(:) - PRATE(:,247) = TPK%KR2(:) - PRATE(:,248) = TPK%KR3(:) - PRATE(:,249) = TPK%KR4(:) - PRATE(:,250) = TPK%KR5(:) - PRATE(:,251) = TPK%KR6(:) - PRATE(:,252) = TPK%KR7(:) - PRATE(:,253) = TPK%KR8(:) - PRATE(:,254) = TPK%KR9(:) - PRATE(:,255) = TPK%KR10(:) - PRATE(:,256) = TPK%KR11(:) - PRATE(:,257) = TPK%KR12(:) - PRATE(:,258) = TPK%KR13(:) - PRATE(:,259) = TPK%KR14(:) - PRATE(:,260) = TPK%KR15(:) - PRATE(:,261) = TPK%KR16(:) - PRATE(:,262) = TPK%KR17(:) - PRATE(:,263) = TPK%KR18(:) - PRATE(:,264) = TPK%KR19(:) - PRATE(:,265) = TPK%KR20(:) - PRATE(:,266) = TPK%KR21(:) - PRATE(:,267) = TPK%KR22(:) - PRATE(:,268) = TPK%KR23(:) - PRATE(:,269) = TPK%KR24(:) - PRATE(:,270) = TPK%KR25(:) - PRATE(:,271) = TPK%KR26(:) - PRATE(:,272) = TPK%KR27(:) - PRATE(:,273) = TPK%KR28(:) - PRATE(:,274) = TPK%KR29(:) - PRATE(:,275) = TPK%KR30(:) -END IF -RETURN -END SUBROUTINE CH_GET_RATES -! -! -!======================================================================== -! -!! #################### - MODULE MODI_CH_TERMS -!! #################### -INTERFACE -SUBROUTINE CH_TERMS(PTIME,PCONC,PTERMS,KMI,KVECNPT,KEQ,KREAC) -IMPLICIT NONE -REAL, INTENT(IN) :: PTIME -INTEGER, INTENT(IN) :: KVECNPT -INTEGER, INTENT(IN) :: KEQ, KREAC -REAL, INTENT(IN), DIMENSION(KVECNPT,KEQ) :: PCONC -REAL, INTENT(OUT), DIMENSION(KVECNPT,KEQ,KREAC):: PTERMS -INTEGER, INTENT(IN) :: KMI -END SUBROUTINE CH_TERMS -END INTERFACE -END MODULE MODI_CH_TERMS -! -!======================================================================== -! -!! ############################################################# - SUBROUTINE CH_TERMS(PTIME,PCONC,PTERMS,KMI,KVECNPT,KEQ,KREAC) -!! ############################################################# -!! This code has been created automatically by preprocessor m10, -!! version: 9.7, copyright 1995-1999 by Meteo France/Universite Paul Sabatier. -!! Please report all bugs to K. Suhre (Lab. d'Aerologie UPS/CNRS). -!! -!!*** *MODD_CH_TERMS* -!! -!! PURPOSE -!! ------- -! calculation of the contribution of each term in each reaction -!! -!!** METHOD -!! ------ -!! The contribution of reaction i to the evolution of species j -!! is returned in PTERMS. -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Karsten Suhre (LA) -!! -!! MODIFICATIONS -!! ------------- -!! Original 26/07/96 -!! Modified 05/05/98: Vectorization (Vincent Crassier & KS) -!! Modified 31/10/03: New interface for better MesoNH compilation (D. Gazen) -!! -!!---------------------------------------------------------------------- -!! -!! EXTERNAL -!! -------- -!! none -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -USE MODD_CH_M9_SCHEME -USE MODI_CH_TERMS_AQ -USE MODI_CH_TERMS_GAZ -!! -!! EXPLICIT ARGUMENTS -!! ------------------ -IMPLICIT NONE -REAL, INTENT(IN) :: PTIME -INTEGER, INTENT(IN) :: KVECNPT -INTEGER, INTENT(IN) :: KEQ, KREAC -REAL, INTENT(IN), DIMENSION(KVECNPT,KEQ) :: PCONC -REAL, INTENT(OUT), DIMENSION(KVECNPT,KEQ,KREAC):: PTERMS -INTEGER, INTENT(IN) :: KMI -!! -TYPE(CCSTYPE), POINTER :: TPK -TPK=>TACCS(KMI) -IF (TPK%LUSECHAQ) THEN - CALL CH_TERMS_AQ(PTIME,PCONC,PTERMS,KMI,KVECNPT,KEQ,KREAC) -ELSE - CALL CH_TERMS_GAZ(PTIME,PCONC,PTERMS,KMI,KVECNPT,KEQ,KREAC) -END IF -END SUBROUTINE CH_TERMS -! -!======================================================================== -! -!! #################### - MODULE MODI_CH_TERMS_AQ -!! #################### -INTERFACE -SUBROUTINE CH_TERMS_AQ(PTIME,PCONC,PTERMS,KMI,KVECNPT,KEQ,KREAC) -IMPLICIT NONE -REAL, INTENT(IN) :: PTIME -INTEGER, INTENT(IN) :: KVECNPT -INTEGER, INTENT(IN) :: KEQ, KREAC -REAL, INTENT(IN), DIMENSION(KVECNPT,KEQ) :: PCONC -REAL, INTENT(OUT), DIMENSION(KVECNPT,KEQ,KREAC):: PTERMS -INTEGER, INTENT(IN) :: KMI -END SUBROUTINE CH_TERMS_AQ -END INTERFACE -END MODULE MODI_CH_TERMS_AQ -! -!======================================================================== -! -!! -!! ###################### - SUBROUTINE CH_TERMS_AQ(PTIME,PCONC,PTERMS,KMI,KVECNPT,KEQ,KREAC) -!! ###################### -!! This code has been created automatically by preprocessor m10, -!! version: 9.7, copyright 1995-1999 by Meteo France/Universite Paul Sabatier. -!! Please report all bugs to K. Suhre (Lab. d'Aerologie UPS/CNRS). -!! -!!*** *MODD_CH_TERMS* -!! -!! PURPOSE -!! ------- -! calculation of the contribution of each term in each reaction -!! -!!** METHOD -!! ------ -!! The contribution of reaction i to the evolution of species j -!! is returned in PTERMS. -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Karsten Suhre (LA) -!! -!! MODIFICATIONS -!! ------------- -!! Original 26/07/96 -!! Modified 05/05/98: Vectorization (Vincent Crassier & KS) -!! Modified 31/10/03: New interface for better MesoNH compilation (D. Gazen) -!! -!!---------------------------------------------------------------------- -!! -!! EXTERNAL -!! -------- -!! none -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -USE MODD_CH_M9_SCHEME -!! -!! EXPLICIT ARGUMENTS -!! ------------------ -IMPLICIT NONE -REAL, INTENT(IN) :: PTIME -INTEGER, INTENT(IN) :: KVECNPT -INTEGER, INTENT(IN) :: KEQ, KREAC -REAL, INTENT(IN), DIMENSION(KVECNPT,KEQ) :: PCONC -REAL, INTENT(OUT), DIMENSION(KVECNPT,KEQ,KREAC):: PTERMS -INTEGER, INTENT(IN) :: KMI -!! -TYPE(CCSTYPE), POINTER :: TPK -TPK=>TACCS(KMI) -! /BEGIN_CODE/ -TPK%O1D(:)=(TPK%K002(:)*PCONC(:,JP_O3))/(TPK%K020(:)*TPK%N2(:)+TPK%K021(:)*TPK%O2(:)+& - &TPK%K022(:)*TPK%H2O(:)) -TPK%O3P(:)=(TPK%K001(:)*PCONC(:,JP_NO2)+TPK%K003(:)*PCONC(:,JP_O3)+TPK%K008(:)*PCONC(:,JP_NO3)+& - &TPK%K020(:)*TPK%O1D(:)*TPK%N2(:)+TPK%K021(:)*TPK%O1D(:)*TPK%O2(:)+& - &0.00000*TPK%K079(:)*PCONC(:,JP_ALKE)*PCONC(:,JP_O3)+& - &0.09000*TPK%K080(:)*PCONC(:,JP_BIO)*PCONC(:,JP_O3))/& - &(TPK%K018(:)*TPK%O2(:)+TPK%K019(:)*PCONC(:,JP_O3)+TPK%K029(:)*PCONC(:,JP_NO)+& - &TPK%K030(:)*PCONC(:,JP_NO2)+TPK%K031(:)*PCONC(:,JP_NO2)+TPK%K054(:)*PCONC(:,JP_BIO)+& - &TPK%K055(:)*PCONC(:,JP_CARBO)+TPK%K134(:)*PCONC(:,JP_DMS)) -! /END_CODE/ -PTERMS(:,:,:) = 0.0 -CALL SUBT0 -CALL SUBT1 -CALL SUBT2 -CALL SUBT3 -CALL SUBT4 -CALL SUBT5 -CALL SUBT6 -CALL SUBT7 -CALL SUBT8 -CALL SUBT9 -CALL SUBT10 -CALL SUBT11 -CALL SUBT12 -CALL SUBT13 -CALL SUBT14 -CALL SUBT15 -CALL SUBT16 -CALL SUBT17 -CALL SUBT18 -CALL SUBT19 -CALL SUBT20 -CALL SUBT21 -CALL SUBT22 -CALL SUBT23 -CALL SUBT24 -CALL SUBT25 -CALL SUBT26 -CALL SUBT27 -CALL SUBT28 -CALL SUBT29 -CALL SUBT30 -CALL SUBT31 -CALL SUBT32 -CALL SUBT33 -CALL SUBT34 -CALL SUBT35 -CALL SUBT36 -CALL SUBT37 -CALL SUBT38 -CALL SUBT39 -CALL SUBT40 -CALL SUBT41 -CALL SUBT42 -CALL SUBT43 -CALL SUBT44 -CALL SUBT45 -CALL SUBT46 -CALL SUBT47 -! - -CONTAINS - -SUBROUTINE SUBT0 -! -!Indices 1 a 20 -! -!PTERMS(NO,K001) = +K001*<NO2> - PTERMS(:,3,1) = +TPK%K001(:)*PCONC(:,4) -! -!PTERMS(NO2,K001) = -K001*<NO2> - PTERMS(:,4,1) = -TPK%K001(:)*PCONC(:,4) -! -!PTERMS(O3,K002) = -K002*<O3> - PTERMS(:,1,2) = -TPK%K002(:)*PCONC(:,1) -! -!PTERMS(O3,K003) = -K003*<O3> - PTERMS(:,1,3) = -TPK%K003(:)*PCONC(:,1) -! -!PTERMS(NO,K004) = +K004*<HONO> - PTERMS(:,3,4) = +TPK%K004(:)*PCONC(:,7) -! -!PTERMS(HONO,K004) = -K004*<HONO> - PTERMS(:,7,4) = -TPK%K004(:)*PCONC(:,7) -! -!PTERMS(OH,K004) = +K004*<HONO> - PTERMS(:,15,4) = +TPK%K004(:)*PCONC(:,7) -! -!PTERMS(NO2,K005) = +K005*<HNO3> - PTERMS(:,4,5) = +TPK%K005(:)*PCONC(:,8) -! -!PTERMS(HNO3,K005) = -K005*<HNO3> - PTERMS(:,8,5) = -TPK%K005(:)*PCONC(:,8) -! -!PTERMS(OH,K005) = +K005*<HNO3> - PTERMS(:,15,5) = +TPK%K005(:)*PCONC(:,8) -! -!PTERMS(NO2,K006) = +0.65*K006*<HNO4> - PTERMS(:,4,6) = +0.65*TPK%K006(:)*PCONC(:,9) -! -!PTERMS(NO3,K006) = +0.35*K006*<HNO4> - PTERMS(:,5,6) = +0.35*TPK%K006(:)*PCONC(:,9) -! -!PTERMS(HNO4,K006) = -K006*<HNO4> - PTERMS(:,9,6) = -TPK%K006(:)*PCONC(:,9) -! -!PTERMS(OH,K006) = +0.35*K006*<HNO4> - PTERMS(:,15,6) = +0.35*TPK%K006(:)*PCONC(:,9) -! -!PTERMS(HO2,K006) = +0.65*K006*<HNO4> - PTERMS(:,16,6) = +0.65*TPK%K006(:)*PCONC(:,9) -! -!PTERMS(NO,K007) = +K007*<NO3> - PTERMS(:,3,7) = +TPK%K007(:)*PCONC(:,5) -! -!PTERMS(NO3,K007) = -K007*<NO3> - PTERMS(:,5,7) = -TPK%K007(:)*PCONC(:,5) -! -!PTERMS(NO2,K008) = +K008*<NO3> - PTERMS(:,4,8) = +TPK%K008(:)*PCONC(:,5) -! -!PTERMS(NO3,K008) = -K008*<NO3> - PTERMS(:,5,8) = -TPK%K008(:)*PCONC(:,5) -! -!PTERMS(H2O2,K009) = -K009*<H2O2> - PTERMS(:,2,9) = -TPK%K009(:)*PCONC(:,2) -! -! -RETURN -END SUBROUTINE SUBT0 -! -SUBROUTINE SUBT1 -! -!Indices 21 a 40 -! -!PTERMS(OH,K009) = +K009*<H2O2> - PTERMS(:,15,9) = +TPK%K009(:)*PCONC(:,2) -! -!PTERMS(CO,K010) = +K010*<HCHO> - PTERMS(:,14,10) = +TPK%K010(:)*PCONC(:,23) -! -!PTERMS(HCHO,K010) = -K010*<HCHO> - PTERMS(:,23,10) = -TPK%K010(:)*PCONC(:,23) -! -!PTERMS(CO,K011) = +K011*<HCHO> - PTERMS(:,14,11) = +TPK%K011(:)*PCONC(:,23) -! -!PTERMS(HO2,K011) = +K011*<HCHO> - PTERMS(:,16,11) = +TPK%K011(:)*PCONC(:,23) -! -!PTERMS(HCHO,K011) = -K011*<HCHO> - PTERMS(:,23,11) = -TPK%K011(:)*PCONC(:,23) -! -!PTERMS(CO,K012) = +K012*<ALD> - PTERMS(:,14,12) = +TPK%K012(:)*PCONC(:,24) -! -!PTERMS(HO2,K012) = +K012*<ALD> - PTERMS(:,16,12) = +TPK%K012(:)*PCONC(:,24) -! -!PTERMS(ALD,K012) = -K012*<ALD> - PTERMS(:,24,12) = -TPK%K012(:)*PCONC(:,24) -! -!PTERMS(MO2,K012) = +K012*<ALD> - PTERMS(:,33,12) = +TPK%K012(:)*PCONC(:,24) -! -!PTERMS(OH,K013) = +K013*<OP1> - PTERMS(:,15,13) = +TPK%K013(:)*PCONC(:,29) -! -!PTERMS(HO2,K013) = +K013*<OP1> - PTERMS(:,16,13) = +TPK%K013(:)*PCONC(:,29) -! -!PTERMS(HCHO,K013) = +K013*<OP1> - PTERMS(:,23,13) = +TPK%K013(:)*PCONC(:,29) -! -!PTERMS(OP1,K013) = -K013*<OP1> - PTERMS(:,29,13) = -TPK%K013(:)*PCONC(:,29) -! -!PTERMS(OH,K014) = +K014*<OP2> - PTERMS(:,15,14) = +TPK%K014(:)*PCONC(:,30) -! -!PTERMS(HO2,K014) = +0.96205*K014*<OP2> - PTERMS(:,16,14) = +0.96205*TPK%K014(:)*PCONC(:,30) -! -!PTERMS(ALD,K014) = +0.96205*K014*<OP2> - PTERMS(:,24,14) = +0.96205*TPK%K014(:)*PCONC(:,30) -! -!PTERMS(OP2,K014) = -K014*<OP2> - PTERMS(:,30,14) = -TPK%K014(:)*PCONC(:,30) -! -!PTERMS(MO2,K014) = +0.03795*K014*<OP2> - PTERMS(:,33,14) = +0.03795*TPK%K014(:)*PCONC(:,30) -! -!PTERMS(KET,K015) = -K015*<KET> - PTERMS(:,25,15) = -TPK%K015(:)*PCONC(:,25) -! -! -RETURN -END SUBROUTINE SUBT1 -! -SUBROUTINE SUBT2 -! -!Indices 41 a 60 -! -!PTERMS(ALKAP,K015) = +1.00000*K015*<KET> - PTERMS(:,34,15) = +1.00000*TPK%K015(:)*PCONC(:,25) -! -!PTERMS(CARBOP,K015) = +1.00000*K015*<KET> - PTERMS(:,40,15) = +1.00000*TPK%K015(:)*PCONC(:,25) -! -!PTERMS(CO,K016) = +0.91924*K016*<CARBO> - PTERMS(:,14,16) = +0.91924*TPK%K016(:)*PCONC(:,26) -! -!PTERMS(HO2,K016) = +0.75830*K016*<CARBO> - PTERMS(:,16,16) = +0.75830*TPK%K016(:)*PCONC(:,26) -! -!PTERMS(HCHO,K016) = +0.06517*K016*<CARBO> - PTERMS(:,23,16) = +0.06517*TPK%K016(:)*PCONC(:,26) -! -!PTERMS(CARBO,K016) = -K016*<CARBO> - PTERMS(:,26,16) = -TPK%K016(:)*PCONC(:,26) -! -!PTERMS(CARBOP,K016) = +0.69622*K016*<CARBO> - PTERMS(:,40,16) = +0.69622*TPK%K016(:)*PCONC(:,26) -! -!PTERMS(NO2,K017) = +K017*<ONIT> - PTERMS(:,4,17) = +TPK%K017(:)*PCONC(:,27) -! -!PTERMS(HO2,K017) = +K017*<ONIT> - PTERMS(:,16,17) = +TPK%K017(:)*PCONC(:,27) -! -!PTERMS(ALD,K017) = +0.20*K017*<ONIT> - PTERMS(:,24,17) = +0.20*TPK%K017(:)*PCONC(:,27) -! -!PTERMS(KET,K017) = +0.80*K017*<ONIT> - PTERMS(:,25,17) = +0.80*TPK%K017(:)*PCONC(:,27) -! -!PTERMS(ONIT,K017) = -K017*<ONIT> - PTERMS(:,27,17) = -TPK%K017(:)*PCONC(:,27) -! -!PTERMS(O3,K018) = +K018*<O3P>*<O2> - PTERMS(:,1,18) = +TPK%K018(:)*TPK%O3P(:)*TPK%O2(:) -! -!PTERMS(O3,K019) = -K019*<O3P>*<O3> - PTERMS(:,1,19) = -TPK%K019(:)*TPK%O3P(:)*PCONC(:,1) -! -!PTERMS(OH,K022) = +K022*<O1D>*<H2O> - PTERMS(:,15,22) = +TPK%K022(:)*TPK%O1D(:)*TPK%H2O(:) -! -!PTERMS(O3,K023) = -K023*<O3>*<OH> - PTERMS(:,1,23) = -TPK%K023(:)*PCONC(:,1)*PCONC(:,15) -! -!PTERMS(OH,K023) = -K023*<O3>*<OH> - PTERMS(:,15,23) = -TPK%K023(:)*PCONC(:,1)*PCONC(:,15) -! -!PTERMS(HO2,K023) = +K023*<O3>*<OH> - PTERMS(:,16,23) = +TPK%K023(:)*PCONC(:,1)*PCONC(:,15) -! -!PTERMS(O3,K024) = -K024*<O3>*<HO2> - PTERMS(:,1,24) = -TPK%K024(:)*PCONC(:,1)*PCONC(:,16) -! -!PTERMS(OH,K024) = +K024*<O3>*<HO2> - PTERMS(:,15,24) = +TPK%K024(:)*PCONC(:,1)*PCONC(:,16) -! -! -RETURN -END SUBROUTINE SUBT2 -! -SUBROUTINE SUBT3 -! -!Indices 61 a 80 -! -!PTERMS(HO2,K024) = -K024*<O3>*<HO2> - PTERMS(:,16,24) = -TPK%K024(:)*PCONC(:,1)*PCONC(:,16) -! -!PTERMS(OH,K025) = -K025*<OH>*<HO2> - PTERMS(:,15,25) = -TPK%K025(:)*PCONC(:,15)*PCONC(:,16) -! -!PTERMS(HO2,K025) = -K025*<OH>*<HO2> - PTERMS(:,16,25) = -TPK%K025(:)*PCONC(:,15)*PCONC(:,16) -! -!PTERMS(H2O2,K026) = -K026*<H2O2>*<OH> - PTERMS(:,2,26) = -TPK%K026(:)*PCONC(:,2)*PCONC(:,15) -! -!PTERMS(OH,K026) = -K026*<H2O2>*<OH> - PTERMS(:,15,26) = -TPK%K026(:)*PCONC(:,2)*PCONC(:,15) -! -!PTERMS(HO2,K026) = +K026*<H2O2>*<OH> - PTERMS(:,16,26) = +TPK%K026(:)*PCONC(:,2)*PCONC(:,15) -! -!PTERMS(H2O2,K027) = +K027*<HO2>*<HO2> - PTERMS(:,2,27) = +TPK%K027(:)*PCONC(:,16)*PCONC(:,16) -! -!PTERMS(HO2,K027) = -K027*<HO2>*<HO2> - PTERMS(:,16,27) = -TPK%K027(:)*PCONC(:,16)*PCONC(:,16) -! -!PTERMS(H2O2,K028) = +K028*<HO2>*<HO2>*<H2O> - PTERMS(:,2,28) = +TPK%K028(:)*PCONC(:,16)*PCONC(:,16)*TPK%H2O(:) -! -!PTERMS(HO2,K028) = -K028*<HO2>*<HO2>*<H2O> - PTERMS(:,16,28) = -TPK%K028(:)*PCONC(:,16)*PCONC(:,16)*TPK%H2O(:) -! -!PTERMS(NO,K029) = -K029*<O3P>*<NO> - PTERMS(:,3,29) = -TPK%K029(:)*TPK%O3P(:)*PCONC(:,3) -! -!PTERMS(NO2,K029) = +K029*<O3P>*<NO> - PTERMS(:,4,29) = +TPK%K029(:)*TPK%O3P(:)*PCONC(:,3) -! -!PTERMS(NO,K030) = +K030*<O3P>*<NO2> - PTERMS(:,3,30) = +TPK%K030(:)*TPK%O3P(:)*PCONC(:,4) -! -!PTERMS(NO2,K030) = -K030*<O3P>*<NO2> - PTERMS(:,4,30) = -TPK%K030(:)*TPK%O3P(:)*PCONC(:,4) -! -!PTERMS(NO2,K031) = -K031*<O3P>*<NO2> - PTERMS(:,4,31) = -TPK%K031(:)*TPK%O3P(:)*PCONC(:,4) -! -!PTERMS(NO3,K031) = +K031*<O3P>*<NO2> - PTERMS(:,5,31) = +TPK%K031(:)*TPK%O3P(:)*PCONC(:,4) -! -!PTERMS(NO,K032) = -K032*<OH>*<NO> - PTERMS(:,3,32) = -TPK%K032(:)*PCONC(:,15)*PCONC(:,3) -! -!PTERMS(HONO,K032) = +K032*<OH>*<NO> - PTERMS(:,7,32) = +TPK%K032(:)*PCONC(:,15)*PCONC(:,3) -! -!PTERMS(OH,K032) = -K032*<OH>*<NO> - PTERMS(:,15,32) = -TPK%K032(:)*PCONC(:,15)*PCONC(:,3) -! -!PTERMS(NO2,K033) = -K033*<OH>*<NO2> - PTERMS(:,4,33) = -TPK%K033(:)*PCONC(:,15)*PCONC(:,4) -! -! -RETURN -END SUBROUTINE SUBT3 -! -SUBROUTINE SUBT4 -! -!Indices 81 a 100 -! -!PTERMS(HNO3,K033) = +K033*<OH>*<NO2> - PTERMS(:,8,33) = +TPK%K033(:)*PCONC(:,15)*PCONC(:,4) -! -!PTERMS(OH,K033) = -K033*<OH>*<NO2> - PTERMS(:,15,33) = -TPK%K033(:)*PCONC(:,15)*PCONC(:,4) -! -!PTERMS(NO2,K034) = +K034*<OH>*<NO3> - PTERMS(:,4,34) = +TPK%K034(:)*PCONC(:,15)*PCONC(:,5) -! -!PTERMS(NO3,K034) = -K034*<OH>*<NO3> - PTERMS(:,5,34) = -TPK%K034(:)*PCONC(:,15)*PCONC(:,5) -! -!PTERMS(OH,K034) = -K034*<OH>*<NO3> - PTERMS(:,15,34) = -TPK%K034(:)*PCONC(:,15)*PCONC(:,5) -! -!PTERMS(HO2,K034) = +K034*<OH>*<NO3> - PTERMS(:,16,34) = +TPK%K034(:)*PCONC(:,15)*PCONC(:,5) -! -!PTERMS(NO,K035) = -K035*<HO2>*<NO> - PTERMS(:,3,35) = -TPK%K035(:)*PCONC(:,16)*PCONC(:,3) -! -!PTERMS(NO2,K035) = +K035*<HO2>*<NO> - PTERMS(:,4,35) = +TPK%K035(:)*PCONC(:,16)*PCONC(:,3) -! -!PTERMS(OH,K035) = +K035*<HO2>*<NO> - PTERMS(:,15,35) = +TPK%K035(:)*PCONC(:,16)*PCONC(:,3) -! -!PTERMS(HO2,K035) = -K035*<HO2>*<NO> - PTERMS(:,16,35) = -TPK%K035(:)*PCONC(:,16)*PCONC(:,3) -! -!PTERMS(NO2,K036) = -K036*<HO2>*<NO2> - PTERMS(:,4,36) = -TPK%K036(:)*PCONC(:,16)*PCONC(:,4) -! -!PTERMS(HNO4,K036) = +K036*<HO2>*<NO2> - PTERMS(:,9,36) = +TPK%K036(:)*PCONC(:,16)*PCONC(:,4) -! -!PTERMS(HO2,K036) = -K036*<HO2>*<NO2> - PTERMS(:,16,36) = -TPK%K036(:)*PCONC(:,16)*PCONC(:,4) -! -!PTERMS(NO2,K037) = +K037*<HNO4> - PTERMS(:,4,37) = +TPK%K037(:)*PCONC(:,9) -! -!PTERMS(HNO4,K037) = -K037*<HNO4> - PTERMS(:,9,37) = -TPK%K037(:)*PCONC(:,9) -! -!PTERMS(HO2,K037) = +K037*<HNO4> - PTERMS(:,16,37) = +TPK%K037(:)*PCONC(:,9) -! -!PTERMS(NO2,K038) = +0.7*K038*<HO2>*<NO3> - PTERMS(:,4,38) = +0.7*TPK%K038(:)*PCONC(:,16)*PCONC(:,5) -! -!PTERMS(NO3,K038) = -K038*<HO2>*<NO3> - PTERMS(:,5,38) = -TPK%K038(:)*PCONC(:,16)*PCONC(:,5) -! -!PTERMS(HNO3,K038) = +0.3*K038*<HO2>*<NO3> - PTERMS(:,8,38) = +0.3*TPK%K038(:)*PCONC(:,16)*PCONC(:,5) -! -!PTERMS(OH,K038) = +0.7*K038*<HO2>*<NO3> - PTERMS(:,15,38) = +0.7*TPK%K038(:)*PCONC(:,16)*PCONC(:,5) -! -! -RETURN -END SUBROUTINE SUBT4 -! -SUBROUTINE SUBT5 -! -!Indices 101 a 120 -! -!PTERMS(HO2,K038) = -K038*<HO2>*<NO3> - PTERMS(:,16,38) = -TPK%K038(:)*PCONC(:,16)*PCONC(:,5) -! -!PTERMS(NO2,K039) = +K039*<OH>*<HONO> - PTERMS(:,4,39) = +TPK%K039(:)*PCONC(:,15)*PCONC(:,7) -! -!PTERMS(HONO,K039) = -K039*<OH>*<HONO> - PTERMS(:,7,39) = -TPK%K039(:)*PCONC(:,15)*PCONC(:,7) -! -!PTERMS(OH,K039) = -K039*<OH>*<HONO> - PTERMS(:,15,39) = -TPK%K039(:)*PCONC(:,15)*PCONC(:,7) -! -!PTERMS(NO3,K040) = +K040*<OH>*<HNO3> - PTERMS(:,5,40) = +TPK%K040(:)*PCONC(:,15)*PCONC(:,8) -! -!PTERMS(HNO3,K040) = -K040*<OH>*<HNO3> - PTERMS(:,8,40) = -TPK%K040(:)*PCONC(:,15)*PCONC(:,8) -! -!PTERMS(OH,K040) = -K040*<OH>*<HNO3> - PTERMS(:,15,40) = -TPK%K040(:)*PCONC(:,15)*PCONC(:,8) -! -!PTERMS(NO2,K041) = +K041*<OH>*<HNO4> - PTERMS(:,4,41) = +TPK%K041(:)*PCONC(:,15)*PCONC(:,9) -! -!PTERMS(HNO4,K041) = -K041*<OH>*<HNO4> - PTERMS(:,9,41) = -TPK%K041(:)*PCONC(:,15)*PCONC(:,9) -! -!PTERMS(OH,K041) = -K041*<OH>*<HNO4> - PTERMS(:,15,41) = -TPK%K041(:)*PCONC(:,15)*PCONC(:,9) -! -!PTERMS(O3,K042) = -K042*<O3>*<NO> - PTERMS(:,1,42) = -TPK%K042(:)*PCONC(:,1)*PCONC(:,3) -! -!PTERMS(NO,K042) = -K042*<O3>*<NO> - PTERMS(:,3,42) = -TPK%K042(:)*PCONC(:,1)*PCONC(:,3) -! -!PTERMS(NO2,K042) = +K042*<O3>*<NO> - PTERMS(:,4,42) = +TPK%K042(:)*PCONC(:,1)*PCONC(:,3) -! -!PTERMS(O3,K043) = -K043*<O3>*<NO2> - PTERMS(:,1,43) = -TPK%K043(:)*PCONC(:,1)*PCONC(:,4) -! -!PTERMS(NO2,K043) = -K043*<O3>*<NO2> - PTERMS(:,4,43) = -TPK%K043(:)*PCONC(:,1)*PCONC(:,4) -! -!PTERMS(NO3,K043) = +K043*<O3>*<NO2> - PTERMS(:,5,43) = +TPK%K043(:)*PCONC(:,1)*PCONC(:,4) -! -!PTERMS(NO,K044) = -K044*<NO>*<NO>*<O2> - PTERMS(:,3,44) = -TPK%K044(:)*PCONC(:,3)*PCONC(:,3)*TPK%O2(:) -! -!PTERMS(NO2,K044) = +K044*<NO>*<NO>*<O2> - PTERMS(:,4,44) = +TPK%K044(:)*PCONC(:,3)*PCONC(:,3)*TPK%O2(:) -! -!PTERMS(NO,K045) = -K045*<NO3>*<NO> - PTERMS(:,3,45) = -TPK%K045(:)*PCONC(:,5)*PCONC(:,3) -! -!PTERMS(NO2,K045) = +K045*<NO3>*<NO> - PTERMS(:,4,45) = +TPK%K045(:)*PCONC(:,5)*PCONC(:,3) -! -! -RETURN -END SUBROUTINE SUBT5 -! -SUBROUTINE SUBT6 -! -!Indices 121 a 140 -! -!PTERMS(NO3,K045) = -K045*<NO3>*<NO> - PTERMS(:,5,45) = -TPK%K045(:)*PCONC(:,5)*PCONC(:,3) -! -!PTERMS(NO,K046) = +K046*<NO3>*<NO2> - PTERMS(:,3,46) = +TPK%K046(:)*PCONC(:,5)*PCONC(:,4) -! -!PTERMS(NO2,K046) = -K046*<NO3>*<NO2> - PTERMS(:,4,46) = -TPK%K046(:)*PCONC(:,5)*PCONC(:,4) -! -!PTERMS(NO3,K046) = -K046*<NO3>*<NO2> - PTERMS(:,5,46) = -TPK%K046(:)*PCONC(:,5)*PCONC(:,4) -! -!PTERMS(NO2,K047) = -K047*<NO3>*<NO2> - PTERMS(:,4,47) = -TPK%K047(:)*PCONC(:,5)*PCONC(:,4) -! -!PTERMS(NO3,K047) = -K047*<NO3>*<NO2> - PTERMS(:,5,47) = -TPK%K047(:)*PCONC(:,5)*PCONC(:,4) -! -!PTERMS(N2O5,K047) = +K047*<NO3>*<NO2> - PTERMS(:,6,47) = +TPK%K047(:)*PCONC(:,5)*PCONC(:,4) -! -!PTERMS(NO2,K048) = +K048*<N2O5> - PTERMS(:,4,48) = +TPK%K048(:)*PCONC(:,6) -! -!PTERMS(NO3,K048) = +K048*<N2O5> - PTERMS(:,5,48) = +TPK%K048(:)*PCONC(:,6) -! -!PTERMS(N2O5,K048) = -K048*<N2O5> - PTERMS(:,6,48) = -TPK%K048(:)*PCONC(:,6) -! -!PTERMS(NO2,K049) = +K049*<NO3>*<NO3> - PTERMS(:,4,49) = +TPK%K049(:)*PCONC(:,5)*PCONC(:,5) -! -!PTERMS(NO3,K049) = -K049*<NO3>*<NO3> - PTERMS(:,5,49) = -TPK%K049(:)*PCONC(:,5)*PCONC(:,5) -! -!PTERMS(NH3,K050) = -K050*<NH3>*<OH> - PTERMS(:,10,50) = -TPK%K050(:)*PCONC(:,10)*PCONC(:,15) -! -!PTERMS(OH,K050) = -K050*<NH3>*<OH> - PTERMS(:,15,50) = -TPK%K050(:)*PCONC(:,10)*PCONC(:,15) -! -!PTERMS(OH,K051) = -K051*<OH>*<H2> - PTERMS(:,15,51) = -TPK%K051(:)*PCONC(:,15)*TPK%H2(:) -! -!PTERMS(HO2,K051) = +K051*<OH>*<H2> - PTERMS(:,16,51) = +TPK%K051(:)*PCONC(:,15)*TPK%H2(:) -! -!PTERMS(SO2,K052) = -K052*<OH>*<SO2> - PTERMS(:,12,52) = -TPK%K052(:)*PCONC(:,15)*PCONC(:,12) -! -!PTERMS(SULF,K052) = +K052*<OH>*<SO2> - PTERMS(:,13,52) = +TPK%K052(:)*PCONC(:,15)*PCONC(:,12) -! -!PTERMS(OH,K052) = -K052*<OH>*<SO2> - PTERMS(:,15,52) = -TPK%K052(:)*PCONC(:,15)*PCONC(:,12) -! -!PTERMS(HO2,K052) = +K052*<OH>*<SO2> - PTERMS(:,16,52) = +TPK%K052(:)*PCONC(:,15)*PCONC(:,12) -! -! -RETURN -END SUBROUTINE SUBT6 -! -SUBROUTINE SUBT7 -! -!Indices 141 a 160 -! -!PTERMS(CO,K053) = -K053*<CO>*<OH> - PTERMS(:,14,53) = -TPK%K053(:)*PCONC(:,14)*PCONC(:,15) -! -!PTERMS(OH,K053) = -K053*<CO>*<OH> - PTERMS(:,15,53) = -TPK%K053(:)*PCONC(:,14)*PCONC(:,15) -! -!PTERMS(HO2,K053) = +K053*<CO>*<OH> - PTERMS(:,16,53) = +TPK%K053(:)*PCONC(:,14)*PCONC(:,15) -! -!PTERMS(CO,K054) = +0.01*K054*<BIO>*<O3P> - PTERMS(:,14,54) = +0.01*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:) -! -!PTERMS(OH,K054) = +0.02*K054*<BIO>*<O3P> - PTERMS(:,15,54) = +0.02*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:) -! -!PTERMS(HO2,K054) = +0.28*K054*<BIO>*<O3P> - PTERMS(:,16,54) = +0.28*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:) -! -!PTERMS(ALKE,K054) = +0.91868*K054*<BIO>*<O3P> - PTERMS(:,20,54) = +0.91868*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:) -! -!PTERMS(BIO,K054) = -K054*<BIO>*<O3P> - PTERMS(:,21,54) = -TPK%K054(:)*PCONC(:,21)*TPK%O3P(:) -! -!PTERMS(HCHO,K054) = +0.05*K054*<BIO>*<O3P> - PTERMS(:,23,54) = +0.05*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:) -! -!PTERMS(CARBO,K054) = +0.13255*K054*<BIO>*<O3P> - PTERMS(:,26,54) = +0.13255*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:) -! -!PTERMS(XO2,K054) = +0.15*K054*<BIO>*<O3P> - PTERMS(:,42,54) = +0.15*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:) -! -!PTERMS(ALD,K055) = +K055*<CARBO>*<O3P> - PTERMS(:,24,55) = +TPK%K055(:)*PCONC(:,26)*TPK%O3P(:) -! -!PTERMS(CARBO,K055) = -K055*<CARBO>*<O3P> - PTERMS(:,26,55) = -TPK%K055(:)*PCONC(:,26)*TPK%O3P(:) -! -!PTERMS(OH,K056) = -K056*<CH4>*<OH> - PTERMS(:,15,56) = -TPK%K056(:)*PCONC(:,17)*PCONC(:,15) -! -!PTERMS(CH4,K056) = -K056*<CH4>*<OH> - PTERMS(:,17,56) = -TPK%K056(:)*PCONC(:,17)*PCONC(:,15) -! -!PTERMS(MO2,K056) = +K056*<CH4>*<OH> - PTERMS(:,33,56) = +TPK%K056(:)*PCONC(:,17)*PCONC(:,15) -! -!PTERMS(OH,K057) = -K057*<ETH>*<OH> - PTERMS(:,15,57) = -TPK%K057(:)*PCONC(:,18)*PCONC(:,15) -! -!PTERMS(ETH,K057) = -K057*<ETH>*<OH> - PTERMS(:,18,57) = -TPK%K057(:)*PCONC(:,18)*PCONC(:,15) -! -!PTERMS(ALKAP,K057) = +K057*<ETH>*<OH> - PTERMS(:,34,57) = +TPK%K057(:)*PCONC(:,18)*PCONC(:,15) -! -!PTERMS(CO,K058) = +0.00878*K058*<ALKA>*<OH> - PTERMS(:,14,58) = +0.00878*TPK%K058(:)*PCONC(:,19)*PCONC(:,15) -! -! -RETURN -END SUBROUTINE SUBT7 -! -SUBROUTINE SUBT8 -! -!Indices 161 a 180 -! -!PTERMS(OH,K058) = -K058*<ALKA>*<OH> - PTERMS(:,15,58) = -TPK%K058(:)*PCONC(:,19)*PCONC(:,15) -! -!PTERMS(HO2,K058) = +0.12793*K058*<ALKA>*<OH> - PTERMS(:,16,58) = +0.12793*TPK%K058(:)*PCONC(:,19)*PCONC(:,15) -! -!PTERMS(ALKA,K058) = -K058*<ALKA>*<OH> - PTERMS(:,19,58) = -TPK%K058(:)*PCONC(:,19)*PCONC(:,15) -! -!PTERMS(HCHO,K058) = +0.00140*K058*<ALKA>*<OH> - PTERMS(:,23,58) = +0.00140*TPK%K058(:)*PCONC(:,19)*PCONC(:,15) -! -!PTERMS(ALD,K058) = +0.08173*K058*<ALKA>*<OH> - PTERMS(:,24,58) = +0.08173*TPK%K058(:)*PCONC(:,19)*PCONC(:,15) -! -!PTERMS(KET,K058) = +0.03498*K058*<ALKA>*<OH> - PTERMS(:,25,58) = +0.03498*TPK%K058(:)*PCONC(:,19)*PCONC(:,15) -! -!PTERMS(CARBO,K058) = +0.00835*K058*<ALKA>*<OH> - PTERMS(:,26,58) = +0.00835*TPK%K058(:)*PCONC(:,19)*PCONC(:,15) -! -!PTERMS(ORA1,K058) = +0.00878*K058*<ALKA>*<OH> - PTERMS(:,31,58) = +0.00878*TPK%K058(:)*PCONC(:,19)*PCONC(:,15) -! -!PTERMS(ALKAP,K058) = +0.87811*K058*<ALKA>*<OH> - PTERMS(:,34,58) = +0.87811*TPK%K058(:)*PCONC(:,19)*PCONC(:,15) -! -!PTERMS(OH,K059) = -K059*<ALKE>*<OH> - PTERMS(:,15,59) = -TPK%K059(:)*PCONC(:,20)*PCONC(:,15) -! -!PTERMS(ALKE,K059) = -K059*<ALKE>*<OH> - PTERMS(:,20,59) = -TPK%K059(:)*PCONC(:,20)*PCONC(:,15) -! -!PTERMS(ALKEP,K059) = +1.02529*K059*<ALKE>*<OH> - PTERMS(:,35,59) = +1.02529*TPK%K059(:)*PCONC(:,20)*PCONC(:,15) -! -!PTERMS(BIOP,K059) = +0.00000*K059*<ALKE>*<OH> - PTERMS(:,36,59) = +0.00000*TPK%K059(:)*PCONC(:,20)*PCONC(:,15) -! -!PTERMS(OH,K060) = -K060*<BIO>*<OH> - PTERMS(:,15,60) = -TPK%K060(:)*PCONC(:,21)*PCONC(:,15) -! -!PTERMS(BIO,K060) = -K060*<BIO>*<OH> - PTERMS(:,21,60) = -TPK%K060(:)*PCONC(:,21)*PCONC(:,15) -! -!PTERMS(BIOP,K060) = +1.00000*K060*<BIO>*<OH> - PTERMS(:,36,60) = +1.00000*TPK%K060(:)*PCONC(:,21)*PCONC(:,15) -! -!PTERMS(OH,K061) = -K061*<ARO>*<OH> - PTERMS(:,15,61) = -TPK%K061(:)*PCONC(:,22)*PCONC(:,15) -! -!PTERMS(HO2,K061) = +0.10318*K061*<ARO>*<OH> - PTERMS(:,16,61) = +0.10318*TPK%K061(:)*PCONC(:,22)*PCONC(:,15) -! -!PTERMS(ARO,K061) = -K061*<ARO>*<OH> - PTERMS(:,22,61) = -TPK%K061(:)*PCONC(:,22)*PCONC(:,15) -! -!PTERMS(PHO,K061) = +0.00276*K061*<ARO>*<OH> - PTERMS(:,37,61) = +0.00276*TPK%K061(:)*PCONC(:,22)*PCONC(:,15) -! -! -RETURN -END SUBROUTINE SUBT8 -! -SUBROUTINE SUBT9 -! -!Indices 181 a 200 -! -!PTERMS(ADD,K061) = +0.93968*K061*<ARO>*<OH> - PTERMS(:,38,61) = +0.93968*TPK%K061(:)*PCONC(:,22)*PCONC(:,15) -! -!PTERMS(XO2,K061) = +0.10318*K061*<ARO>*<OH> - PTERMS(:,42,61) = +0.10318*TPK%K061(:)*PCONC(:,22)*PCONC(:,15) -! -!PTERMS(CO,K062) = +K062*<HCHO>*<OH> - PTERMS(:,14,62) = +TPK%K062(:)*PCONC(:,23)*PCONC(:,15) -! -!PTERMS(OH,K062) = -K062*<HCHO>*<OH> - PTERMS(:,15,62) = -TPK%K062(:)*PCONC(:,23)*PCONC(:,15) -! -!PTERMS(HO2,K062) = +K062*<HCHO>*<OH> - PTERMS(:,16,62) = +TPK%K062(:)*PCONC(:,23)*PCONC(:,15) -! -!PTERMS(HCHO,K062) = -K062*<HCHO>*<OH> - PTERMS(:,23,62) = -TPK%K062(:)*PCONC(:,23)*PCONC(:,15) -! -!PTERMS(OH,K063) = -K063*<ALD>*<OH> - PTERMS(:,15,63) = -TPK%K063(:)*PCONC(:,24)*PCONC(:,15) -! -!PTERMS(ALD,K063) = -K063*<ALD>*<OH> - PTERMS(:,24,63) = -TPK%K063(:)*PCONC(:,24)*PCONC(:,15) -! -!PTERMS(CARBOP,K063) = +1.00000*K063*<ALD>*<OH> - PTERMS(:,40,63) = +1.00000*TPK%K063(:)*PCONC(:,24)*PCONC(:,15) -! -!PTERMS(OH,K064) = -K064*<KET>*<OH> - PTERMS(:,15,64) = -TPK%K064(:)*PCONC(:,25)*PCONC(:,15) -! -!PTERMS(KET,K064) = -K064*<KET>*<OH> - PTERMS(:,25,64) = -TPK%K064(:)*PCONC(:,25)*PCONC(:,15) -! -!PTERMS(CARBOP,K064) = +1.00000*K064*<KET>*<OH> - PTERMS(:,40,64) = +1.00000*TPK%K064(:)*PCONC(:,25)*PCONC(:,15) -! -!PTERMS(CO,K065) = +1.01732*K065*<CARBO>*<OH> - PTERMS(:,14,65) = +1.01732*TPK%K065(:)*PCONC(:,26)*PCONC(:,15) -! -!PTERMS(OH,K065) = -K065*<CARBO>*<OH> - PTERMS(:,15,65) = -TPK%K065(:)*PCONC(:,26)*PCONC(:,15) -! -!PTERMS(HO2,K065) = +0.51208*K065*<CARBO>*<OH> - PTERMS(:,16,65) = +0.51208*TPK%K065(:)*PCONC(:,26)*PCONC(:,15) -! -!PTERMS(HCHO,K065) = +0.00000*K065*<CARBO>*<OH> - PTERMS(:,23,65) = +0.00000*TPK%K065(:)*PCONC(:,26)*PCONC(:,15) -! -!PTERMS(ALD,K065) = +0.06253*K065*<CARBO>*<OH> - PTERMS(:,24,65) = +0.06253*TPK%K065(:)*PCONC(:,26)*PCONC(:,15) -! -!PTERMS(KET,K065) = +0.00853*K065*<CARBO>*<OH> - PTERMS(:,25,65) = +0.00853*TPK%K065(:)*PCONC(:,26)*PCONC(:,15) -! -!PTERMS(CARBO,K065) = -K065*<CARBO>*<OH> - PTERMS(:,26,65) = -TPK%K065(:)*PCONC(:,26)*PCONC(:,15) -! -!PTERMS(CARBOP,K065) = +0.51419*K065*<CARBO>*<OH> - PTERMS(:,40,65) = +0.51419*TPK%K065(:)*PCONC(:,26)*PCONC(:,15) -! -! -RETURN -END SUBROUTINE SUBT9 -! -SUBROUTINE SUBT10 -! -!Indices 201 a 220 -! -!PTERMS(XO2,K065) = +0.10162*K065*<CARBO>*<OH> - PTERMS(:,42,65) = +0.10162*TPK%K065(:)*PCONC(:,26)*PCONC(:,15) -! -!PTERMS(OH,K066) = -K066*<ORA1>*<OH> - PTERMS(:,15,66) = -TPK%K066(:)*PCONC(:,31)*PCONC(:,15) -! -!PTERMS(HO2,K066) = +K066*<ORA1>*<OH> - PTERMS(:,16,66) = +TPK%K066(:)*PCONC(:,31)*PCONC(:,15) -! -!PTERMS(ORA1,K066) = -K066*<ORA1>*<OH> - PTERMS(:,31,66) = -TPK%K066(:)*PCONC(:,31)*PCONC(:,15) -! -!PTERMS(OH,K067) = -K067*<ORA2>*<OH> - PTERMS(:,15,67) = -TPK%K067(:)*PCONC(:,32)*PCONC(:,15) -! -!PTERMS(ORA2,K067) = -K067*<ORA2>*<OH> - PTERMS(:,32,67) = -TPK%K067(:)*PCONC(:,32)*PCONC(:,15) -! -!PTERMS(OH,K068) = -K068*<OP1>*<OH> - PTERMS(:,15,68) = -TPK%K068(:)*PCONC(:,29)*PCONC(:,15) -! -!PTERMS(HCHO,K068) = +0.35*K068*<OP1>*<OH> - PTERMS(:,23,68) = +0.35*TPK%K068(:)*PCONC(:,29)*PCONC(:,15) -! -!PTERMS(OP1,K068) = -K068*<OP1>*<OH> - PTERMS(:,29,68) = -TPK%K068(:)*PCONC(:,29)*PCONC(:,15) -! -!PTERMS(MO2,K068) = +0.65*K068*<OP1>*<OH> - PTERMS(:,33,68) = +0.65*TPK%K068(:)*PCONC(:,29)*PCONC(:,15) -! -!PTERMS(OH,K069) = -K069*<OP2>*<OH> - PTERMS(:,15,69) = -TPK%K069(:)*PCONC(:,30)*PCONC(:,15) -! -!PTERMS(HO2,K069) = +0.02915*K069*<OP2>*<OH> - PTERMS(:,16,69) = +0.02915*TPK%K069(:)*PCONC(:,30)*PCONC(:,15) -! -!PTERMS(HCHO,K069) = +0.02915*K069*<OP2>*<OH> - PTERMS(:,23,69) = +0.02915*TPK%K069(:)*PCONC(:,30)*PCONC(:,15) -! -!PTERMS(ALD,K069) = +0.07335*K069*<OP2>*<OH> - PTERMS(:,24,69) = +0.07335*TPK%K069(:)*PCONC(:,30)*PCONC(:,15) -! -!PTERMS(KET,K069) = +0.37591*K069*<OP2>*<OH> - PTERMS(:,25,69) = +0.37591*TPK%K069(:)*PCONC(:,30)*PCONC(:,15) -! -!PTERMS(OP2,K069) = -K069*<OP2>*<OH> - PTERMS(:,30,69) = -TPK%K069(:)*PCONC(:,30)*PCONC(:,15) -! -!PTERMS(ALKAP,K069) = +0.40341*K069*<OP2>*<OH> - PTERMS(:,34,69) = +0.40341*TPK%K069(:)*PCONC(:,30)*PCONC(:,15) -! -!PTERMS(CARBOP,K069) = +0.05413*K069*<OP2>*<OH> - PTERMS(:,40,69) = +0.05413*TPK%K069(:)*PCONC(:,30)*PCONC(:,15) -! -!PTERMS(XO2,K069) = +0.09333*K069*<OP2>*<OH> - PTERMS(:,42,69) = +0.09333*TPK%K069(:)*PCONC(:,30)*PCONC(:,15) -! -!PTERMS(NO3,K070) = +0.71893*K070*<PAN>*<OH> - PTERMS(:,5,70) = +0.71893*TPK%K070(:)*PCONC(:,28)*PCONC(:,15) -! -! -RETURN -END SUBROUTINE SUBT10 -! -SUBROUTINE SUBT11 -! -!Indices 221 a 240 -! -!PTERMS(OH,K070) = -K070*<PAN>*<OH> - PTERMS(:,15,70) = -TPK%K070(:)*PCONC(:,28)*PCONC(:,15) -! -!PTERMS(HO2,K070) = +0.28107*K070*<PAN>*<OH> - PTERMS(:,16,70) = +0.28107*TPK%K070(:)*PCONC(:,28)*PCONC(:,15) -! -!PTERMS(HCHO,K070) = +0.57839*K070*<PAN>*<OH> - PTERMS(:,23,70) = +0.57839*TPK%K070(:)*PCONC(:,28)*PCONC(:,15) -! -!PTERMS(CARBO,K070) = +0.21863*K070*<PAN>*<OH> - PTERMS(:,26,70) = +0.21863*TPK%K070(:)*PCONC(:,28)*PCONC(:,15) -! -!PTERMS(PAN,K070) = -K070*<PAN>*<OH> - PTERMS(:,28,70) = -TPK%K070(:)*PCONC(:,28)*PCONC(:,15) -! -!PTERMS(XO2,K070) = +K070*<PAN>*<OH> - PTERMS(:,42,70) = +TPK%K070(:)*PCONC(:,28)*PCONC(:,15) -! -!PTERMS(NO2,K071) = +K071*<ONIT>*<OH> - PTERMS(:,4,71) = +TPK%K071(:)*PCONC(:,27)*PCONC(:,15) -! -!PTERMS(OH,K071) = -K071*<ONIT>*<OH> - PTERMS(:,15,71) = -TPK%K071(:)*PCONC(:,27)*PCONC(:,15) -! -!PTERMS(ONIT,K071) = -K071*<ONIT>*<OH> - PTERMS(:,27,71) = -TPK%K071(:)*PCONC(:,27)*PCONC(:,15) -! -!PTERMS(ALKAP,K071) = +1.00000*K071*<ONIT>*<OH> - PTERMS(:,34,71) = +1.00000*TPK%K071(:)*PCONC(:,27)*PCONC(:,15) -! -!PTERMS(NO3,K072) = -K072*<HCHO>*<NO3> - PTERMS(:,5,72) = -TPK%K072(:)*PCONC(:,23)*PCONC(:,5) -! -!PTERMS(HNO3,K072) = +K072*<HCHO>*<NO3> - PTERMS(:,8,72) = +TPK%K072(:)*PCONC(:,23)*PCONC(:,5) -! -!PTERMS(CO,K072) = +K072*<HCHO>*<NO3> - PTERMS(:,14,72) = +TPK%K072(:)*PCONC(:,23)*PCONC(:,5) -! -!PTERMS(HO2,K072) = +K072*<HCHO>*<NO3> - PTERMS(:,16,72) = +TPK%K072(:)*PCONC(:,23)*PCONC(:,5) -! -!PTERMS(HCHO,K072) = -K072*<HCHO>*<NO3> - PTERMS(:,23,72) = -TPK%K072(:)*PCONC(:,23)*PCONC(:,5) -! -!PTERMS(NO3,K073) = -K073*<ALD>*<NO3> - PTERMS(:,5,73) = -TPK%K073(:)*PCONC(:,24)*PCONC(:,5) -! -!PTERMS(HNO3,K073) = +K073*<ALD>*<NO3> - PTERMS(:,8,73) = +TPK%K073(:)*PCONC(:,24)*PCONC(:,5) -! -!PTERMS(ALD,K073) = -K073*<ALD>*<NO3> - PTERMS(:,24,73) = -TPK%K073(:)*PCONC(:,24)*PCONC(:,5) -! -!PTERMS(CARBOP,K073) = +1.00000*K073*<ALD>*<NO3> - PTERMS(:,40,73) = +1.00000*TPK%K073(:)*PCONC(:,24)*PCONC(:,5) -! -!PTERMS(NO2,K074) = +0.10530*K074*<CARBO>*<NO3> - PTERMS(:,4,74) = +0.10530*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) -! -! -RETURN -END SUBROUTINE SUBT11 -! -SUBROUTINE SUBT12 -! -!Indices 241 a 260 -! -!PTERMS(NO3,K074) = -K074*<CARBO>*<NO3> - PTERMS(:,5,74) = -TPK%K074(:)*PCONC(:,26)*PCONC(:,5) -! -!PTERMS(HNO3,K074) = +0.91567*K074*<CARBO>*<NO3> - PTERMS(:,8,74) = +0.91567*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) -! -!PTERMS(CO,K074) = +1.33723*K074*<CARBO>*<NO3> - PTERMS(:,14,74) = +1.33723*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) -! -!PTERMS(HO2,K074) = +0.63217*K074*<CARBO>*<NO3> - PTERMS(:,16,74) = +0.63217*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) -! -!PTERMS(ALD,K074) = +0.05265*K074*<CARBO>*<NO3> - PTERMS(:,24,74) = +0.05265*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) -! -!PTERMS(KET,K074) = +0.00632*K074*<CARBO>*<NO3> - PTERMS(:,25,74) = +0.00632*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) -! -!PTERMS(CARBO,K074) = -K074*<CARBO>*<NO3> - PTERMS(:,26,74) = -TPK%K074(:)*PCONC(:,26)*PCONC(:,5) -! -!PTERMS(CARBOP,K074) = +0.38881*K074*<CARBO>*<NO3> - PTERMS(:,40,74) = +0.38881*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) -! -!PTERMS(OLN,K074) = +0.00000*K074*<CARBO>*<NO3> - PTERMS(:,41,74) = +0.00000*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) -! -!PTERMS(XO2,K074) = +0.10530*K074*<CARBO>*<NO3> - PTERMS(:,42,74) = +0.10530*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) -! -!PTERMS(NO3,K075) = -K075*<ARO>*<NO3> - PTERMS(:,5,75) = -TPK%K075(:)*PCONC(:,22)*PCONC(:,5) -! -!PTERMS(HNO3,K075) = +K075*<ARO>*<NO3> - PTERMS(:,8,75) = +TPK%K075(:)*PCONC(:,22)*PCONC(:,5) -! -!PTERMS(ARO,K075) = -K075*<ARO>*<NO3> - PTERMS(:,22,75) = -TPK%K075(:)*PCONC(:,22)*PCONC(:,5) -! -!PTERMS(PHO,K075) = +K075*<ARO>*<NO3> - PTERMS(:,37,75) = +TPK%K075(:)*PCONC(:,22)*PCONC(:,5) -! -!PTERMS(NO3,K076) = -K076*<ALKE>*<NO3> - PTERMS(:,5,76) = -TPK%K076(:)*PCONC(:,20)*PCONC(:,5) -! -!PTERMS(ALKE,K076) = -K076*<ALKE>*<NO3> - PTERMS(:,20,76) = -TPK%K076(:)*PCONC(:,20)*PCONC(:,5) -! -!PTERMS(CARBO,K076) = +0.00000*K076*<ALKE>*<NO3> - PTERMS(:,26,76) = +0.00000*TPK%K076(:)*PCONC(:,20)*PCONC(:,5) -! -!PTERMS(OLN,K076) = +0.93768*K076*<ALKE>*<NO3> - PTERMS(:,41,76) = +0.93768*TPK%K076(:)*PCONC(:,20)*PCONC(:,5) -! -!PTERMS(NO3,K077) = -K077*<BIO>*<NO3> - PTERMS(:,5,77) = -TPK%K077(:)*PCONC(:,21)*PCONC(:,5) -! -!PTERMS(BIO,K077) = -K077*<BIO>*<NO3> - PTERMS(:,21,77) = -TPK%K077(:)*PCONC(:,21)*PCONC(:,5) -! -! -RETURN -END SUBROUTINE SUBT12 -! -SUBROUTINE SUBT13 -! -!Indices 261 a 280 -! -!PTERMS(CARBO,K077) = +0.91741*K077*<BIO>*<NO3> - PTERMS(:,26,77) = +0.91741*TPK%K077(:)*PCONC(:,21)*PCONC(:,5) -! -!PTERMS(OLN,K077) = +1.00000*K077*<BIO>*<NO3> - PTERMS(:,41,77) = +1.00000*TPK%K077(:)*PCONC(:,21)*PCONC(:,5) -! -!PTERMS(NO2,K078) = +0.40*K078*<PAN>*<NO3> - PTERMS(:,4,78) = +0.40*TPK%K078(:)*PCONC(:,28)*PCONC(:,5) -! -!PTERMS(NO3,K078) = -K078*<PAN>*<NO3> - PTERMS(:,5,78) = -TPK%K078(:)*PCONC(:,28)*PCONC(:,5) -! -!PTERMS(HCHO,K078) = +0.40*K078*<PAN>*<NO3> - PTERMS(:,23,78) = +0.40*TPK%K078(:)*PCONC(:,28)*PCONC(:,5) -! -!PTERMS(ONIT,K078) = +0.60*K078*<PAN>*<NO3> - PTERMS(:,27,78) = +0.60*TPK%K078(:)*PCONC(:,28)*PCONC(:,5) -! -!PTERMS(PAN,K078) = -K078*<PAN>*<NO3> - PTERMS(:,28,78) = -TPK%K078(:)*PCONC(:,28)*PCONC(:,5) -! -!PTERMS(XO2,K078) = +K078*<PAN>*<NO3> - PTERMS(:,42,78) = +TPK%K078(:)*PCONC(:,28)*PCONC(:,5) -! -!PTERMS(O3,K079) = -K079*<ALKE>*<O3> - PTERMS(:,1,79) = -TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(H2O2,K079) = +0.01833*K079*<ALKE>*<O3> - PTERMS(:,2,79) = +0.01833*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(CO,K079) = +0.35120*K079*<ALKE>*<O3> - PTERMS(:,14,79) = +0.35120*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(OH,K079) = +0.39435*K079*<ALKE>*<O3> - PTERMS(:,15,79) = +0.39435*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(HO2,K079) = +0.23451*K079*<ALKE>*<O3> - PTERMS(:,16,79) = +0.23451*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(CH4,K079) = +0.04300*K079*<ALKE>*<O3> - PTERMS(:,17,79) = +0.04300*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(ETH,K079) = +0.03196*K079*<ALKE>*<O3> - PTERMS(:,18,79) = +0.03196*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(ALKE,K079) = -K079*<ALKE>*<O3> - PTERMS(:,20,79) = -TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(HCHO,K079) = +0.48290*K079*<ALKE>*<O3> - PTERMS(:,23,79) = +0.48290*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(ALD,K079) = +0.51468*K079*<ALKE>*<O3> - PTERMS(:,24,79) = +0.51468*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(KET,K079) = +0.07377*K079*<ALKE>*<O3> - PTERMS(:,25,79) = +0.07377*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(CARBO,K079) = +0.00000*K079*<ALKE>*<O3> - PTERMS(:,26,79) = +0.00000*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -! -RETURN -END SUBROUTINE SUBT13 -! -SUBROUTINE SUBT14 -! -!Indices 281 a 300 -! -!PTERMS(ORA1,K079) = +0.15343*K079*<ALKE>*<O3> - PTERMS(:,31,79) = +0.15343*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(ORA2,K079) = +0.08143*K079*<ALKE>*<O3> - PTERMS(:,32,79) = +0.08143*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(MO2,K079) = +0.13966*K079*<ALKE>*<O3> - PTERMS(:,33,79) = +0.13966*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(ALKAP,K079) = +0.09815*K079*<ALKE>*<O3> - PTERMS(:,34,79) = +0.09815*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(CARBOP,K079) = +0.05705*K079*<ALKE>*<O3> - PTERMS(:,40,79) = +0.05705*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(XO2,K079) = +0.00000*K079*<ALKE>*<O3> - PTERMS(:,42,79) = +0.00000*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(O3,K080) = -K080*<BIO>*<O3> - PTERMS(:,1,80) = -TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -!PTERMS(H2O2,K080) = +0.00100*K080*<BIO>*<O3> - PTERMS(:,2,80) = +0.00100*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -!PTERMS(CO,K080) = +0.36000*K080*<BIO>*<O3> - PTERMS(:,14,80) = +0.36000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -!PTERMS(OH,K080) = +0.28000*K080*<BIO>*<O3> - PTERMS(:,15,80) = +0.28000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -!PTERMS(HO2,K080) = +0.30000*K080*<BIO>*<O3> - PTERMS(:,16,80) = +0.30000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -!PTERMS(ALKE,K080) = +0.37388*K080*<BIO>*<O3> - PTERMS(:,20,80) = +0.37388*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -!PTERMS(BIO,K080) = -K080*<BIO>*<O3> - PTERMS(:,21,80) = -TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -!PTERMS(HCHO,K080) = +0.90000*K080*<BIO>*<O3> - PTERMS(:,23,80) = +0.90000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -!PTERMS(ALD,K080) = +0.00000*K080*<BIO>*<O3> - PTERMS(:,24,80) = +0.00000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -!PTERMS(KET,K080) = +0.00000*K080*<BIO>*<O3> - PTERMS(:,25,80) = +0.00000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -!PTERMS(CARBO,K080) = +0.39754*K080*<BIO>*<O3> - PTERMS(:,26,80) = +0.39754*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -!PTERMS(ORA1,K080) = +0.15000*K080*<BIO>*<O3> - PTERMS(:,31,80) = +0.15000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -!PTERMS(ORA2,K080) = +0.00000*K080*<BIO>*<O3> - PTERMS(:,32,80) = +0.00000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -!PTERMS(MO2,K080) = +0.03000*K080*<BIO>*<O3> - PTERMS(:,33,80) = +0.03000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -! -RETURN -END SUBROUTINE SUBT14 -! -SUBROUTINE SUBT15 -! -!Indices 301 a 320 -! -!PTERMS(ALKAP,K080) = +0.00000*K080*<BIO>*<O3> - PTERMS(:,34,80) = +0.00000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -!PTERMS(CARBOP,K080) = +0.17000*K080*<BIO>*<O3> - PTERMS(:,40,80) = +0.17000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -!PTERMS(XO2,K080) = +0.13000*K080*<BIO>*<O3> - PTERMS(:,42,80) = +0.13000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -!PTERMS(O3,K081) = -K081*<CARBO>*<O3> - PTERMS(:,1,81) = -TPK%K081(:)*PCONC(:,26)*PCONC(:,1) -! -!PTERMS(CO,K081) = +0.64728*K081*<CARBO>*<O3> - PTERMS(:,14,81) = +0.64728*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) -! -!PTERMS(OH,K081) = +0.20595*K081*<CARBO>*<O3> - PTERMS(:,15,81) = +0.20595*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) -! -!PTERMS(HO2,K081) = +0.28441*K081*<CARBO>*<O3> - PTERMS(:,16,81) = +0.28441*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) -! -!PTERMS(HCHO,K081) = +0.00000*K081*<CARBO>*<O3> - PTERMS(:,23,81) = +0.00000*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) -! -!PTERMS(ALD,K081) = +0.15692*K081*<CARBO>*<O3> - PTERMS(:,24,81) = +0.15692*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) -! -!PTERMS(CARBO,K081) = -K081*<CARBO>*<O3> - PTERMS(:,26,81) = -TPK%K081(:)*PCONC(:,26)*PCONC(:,1) -! -!PTERMS(OP2,K081) = +0.10149*K081*<CARBO>*<O3> - PTERMS(:,30,81) = +0.10149*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) -! -!PTERMS(ORA1,K081) = +0.10788*K081*<CARBO>*<O3> - PTERMS(:,31,81) = +0.10788*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) -! -!PTERMS(ORA2,K081) = +0.20595*K081*<CARBO>*<O3> - PTERMS(:,32,81) = +0.20595*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) -! -!PTERMS(CARBOP,K081) = +0.27460*K081*<CARBO>*<O3> - PTERMS(:,40,81) = +0.27460*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) -! -!PTERMS(O3,K082) = -K082*<PAN>*<O3> - PTERMS(:,1,82) = -TPK%K082(:)*PCONC(:,28)*PCONC(:,1) -! -!PTERMS(NO2,K082) = +0.70*K082*<PAN>*<O3> - PTERMS(:,4,82) = +0.70*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) -! -!PTERMS(CO,K082) = +0.13*K082*<PAN>*<O3> - PTERMS(:,14,82) = +0.13*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) -! -!PTERMS(OH,K082) = +0.036*K082*<PAN>*<O3> - PTERMS(:,15,82) = +0.036*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) -! -!PTERMS(HO2,K082) = +0.08*K082*<PAN>*<O3> - PTERMS(:,16,82) = +0.08*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) -! -!PTERMS(HCHO,K082) = +0.70*K082*<PAN>*<O3> - PTERMS(:,23,82) = +0.70*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) -! -! -RETURN -END SUBROUTINE SUBT15 -! -SUBROUTINE SUBT16 -! -!Indices 321 a 340 -! -!PTERMS(PAN,K082) = -K082*<PAN>*<O3> - PTERMS(:,28,82) = -TPK%K082(:)*PCONC(:,28)*PCONC(:,1) -! -!PTERMS(ORA1,K082) = +0.11*K082*<PAN>*<O3> - PTERMS(:,31,82) = +0.11*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) -! -!PTERMS(CARBOP,K082) = +0.70000*K082*<PAN>*<O3> - PTERMS(:,40,82) = +0.70000*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) -! -!PTERMS(NO2,K083) = -K083*<PHO>*<NO2> - PTERMS(:,4,83) = -TPK%K083(:)*PCONC(:,37)*PCONC(:,4) -! -!PTERMS(ARO,K083) = +0.10670*K083*<PHO>*<NO2> - PTERMS(:,22,83) = +0.10670*TPK%K083(:)*PCONC(:,37)*PCONC(:,4) -! -!PTERMS(ONIT,K083) = +K083*<PHO>*<NO2> - PTERMS(:,27,83) = +TPK%K083(:)*PCONC(:,37)*PCONC(:,4) -! -!PTERMS(PHO,K083) = -K083*<PHO>*<NO2> - PTERMS(:,37,83) = -TPK%K083(:)*PCONC(:,37)*PCONC(:,4) -! -!PTERMS(HO2,K084) = -K084*<PHO>*<HO2> - PTERMS(:,16,84) = -TPK%K084(:)*PCONC(:,37)*PCONC(:,16) -! -!PTERMS(ARO,K084) = +1.06698*K084*<PHO>*<HO2> - PTERMS(:,22,84) = +1.06698*TPK%K084(:)*PCONC(:,37)*PCONC(:,16) -! -!PTERMS(PHO,K084) = -K084*<PHO>*<HO2> - PTERMS(:,37,84) = -TPK%K084(:)*PCONC(:,37)*PCONC(:,16) -! -!PTERMS(NO2,K085) = -K085*<ADD>*<NO2> - PTERMS(:,4,85) = -TPK%K085(:)*PCONC(:,38)*PCONC(:,4) -! -!PTERMS(HONO,K085) = +K085*<ADD>*<NO2> - PTERMS(:,7,85) = +TPK%K085(:)*PCONC(:,38)*PCONC(:,4) -! -!PTERMS(ARO,K085) = +K085*<ADD>*<NO2> - PTERMS(:,22,85) = +TPK%K085(:)*PCONC(:,38)*PCONC(:,4) -! -!PTERMS(ADD,K085) = -K085*<ADD>*<NO2> - PTERMS(:,38,85) = -TPK%K085(:)*PCONC(:,38)*PCONC(:,4) -! -!PTERMS(HO2,K086) = +0.02*K086*<ADD>*<O2> - PTERMS(:,16,86) = +0.02*TPK%K086(:)*PCONC(:,38)*TPK%O2(:) -! -!PTERMS(ARO,K086) = +0.02*K086*<ADD>*<O2> - PTERMS(:,22,86) = +0.02*TPK%K086(:)*PCONC(:,38)*TPK%O2(:) -! -!PTERMS(ADD,K086) = -K086*<ADD>*<O2> - PTERMS(:,38,86) = -TPK%K086(:)*PCONC(:,38)*TPK%O2(:) -! -!PTERMS(AROP,K086) = +0.98*K086*<ADD>*<O2> - PTERMS(:,39,86) = +0.98*TPK%K086(:)*PCONC(:,38)*TPK%O2(:) -! -!PTERMS(O3,K087) = -K087*<ADD>*<O3> - PTERMS(:,1,87) = -TPK%K087(:)*PCONC(:,38)*PCONC(:,1) -! -!PTERMS(OH,K087) = +K087*<ADD>*<O3> - PTERMS(:,15,87) = +TPK%K087(:)*PCONC(:,38)*PCONC(:,1) -! -! -RETURN -END SUBROUTINE SUBT16 -! -SUBROUTINE SUBT17 -! -!Indices 341 a 360 -! -!PTERMS(ARO,K087) = +K087*<ADD>*<O3> - PTERMS(:,22,87) = +TPK%K087(:)*PCONC(:,38)*PCONC(:,1) -! -!PTERMS(ADD,K087) = -K087*<ADD>*<O3> - PTERMS(:,38,87) = -TPK%K087(:)*PCONC(:,38)*PCONC(:,1) -! -!PTERMS(NO2,K088) = -K088*<CARBOP>*<NO2> - PTERMS(:,4,88) = -TPK%K088(:)*PCONC(:,40)*PCONC(:,4) -! -!PTERMS(PAN,K088) = +1.00000*K088*<CARBOP>*<NO2> - PTERMS(:,28,88) = +1.00000*TPK%K088(:)*PCONC(:,40)*PCONC(:,4) -! -!PTERMS(CARBOP,K088) = -K088*<CARBOP>*<NO2> - PTERMS(:,40,88) = -TPK%K088(:)*PCONC(:,40)*PCONC(:,4) -! -!PTERMS(NO2,K089) = +K089*<PAN> - PTERMS(:,4,89) = +TPK%K089(:)*PCONC(:,28) -! -!PTERMS(PAN,K089) = -K089*<PAN> - PTERMS(:,28,89) = -TPK%K089(:)*PCONC(:,28) -! -!PTERMS(CARBOP,K089) = +1.00000*K089*<PAN> - PTERMS(:,40,89) = +1.00000*TPK%K089(:)*PCONC(:,28) -! -!PTERMS(NO,K090) = -K090*<MO2>*<NO> - PTERMS(:,3,90) = -TPK%K090(:)*PCONC(:,33)*PCONC(:,3) -! -!PTERMS(NO2,K090) = +K090*<MO2>*<NO> - PTERMS(:,4,90) = +TPK%K090(:)*PCONC(:,33)*PCONC(:,3) -! -!PTERMS(HO2,K090) = +K090*<MO2>*<NO> - PTERMS(:,16,90) = +TPK%K090(:)*PCONC(:,33)*PCONC(:,3) -! -!PTERMS(HCHO,K090) = +K090*<MO2>*<NO> - PTERMS(:,23,90) = +TPK%K090(:)*PCONC(:,33)*PCONC(:,3) -! -!PTERMS(MO2,K090) = -K090*<MO2>*<NO> - PTERMS(:,33,90) = -TPK%K090(:)*PCONC(:,33)*PCONC(:,3) -! -!PTERMS(NO,K091) = -K091*<ALKAP>*<NO> - PTERMS(:,3,91) = -TPK%K091(:)*PCONC(:,34)*PCONC(:,3) -! -!PTERMS(NO2,K091) = +0.91541*K091*<ALKAP>*<NO> - PTERMS(:,4,91) = +0.91541*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) -! -!PTERMS(HO2,K091) = +0.74265*K091*<ALKAP>*<NO> - PTERMS(:,16,91) = +0.74265*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) -! -!PTERMS(HCHO,K091) = +0.03002*K091*<ALKAP>*<NO> - PTERMS(:,23,91) = +0.03002*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) -! -!PTERMS(ALD,K091) = +0.33144*K091*<ALKAP>*<NO> - PTERMS(:,24,91) = +0.33144*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) -! -!PTERMS(KET,K091) = +0.54531*K091*<ALKAP>*<NO> - PTERMS(:,25,91) = +0.54531*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) -! -!PTERMS(CARBO,K091) = +0.03407*K091*<ALKAP>*<NO> - PTERMS(:,26,91) = +0.03407*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) -! -! -RETURN -END SUBROUTINE SUBT17 -! -SUBROUTINE SUBT18 -! -!Indices 361 a 380 -! -!PTERMS(ONIT,K091) = +0.08459*K091*<ALKAP>*<NO> - PTERMS(:,27,91) = +0.08459*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) -! -!PTERMS(MO2,K091) = +0.09016*K091*<ALKAP>*<NO> - PTERMS(:,33,91) = +0.09016*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) -! -!PTERMS(ALKAP,K091) = -K091*<ALKAP>*<NO> - PTERMS(:,34,91) = -TPK%K091(:)*PCONC(:,34)*PCONC(:,3) -! -!PTERMS(XO2,K091) = +0.13007*K091*<ALKAP>*<NO> - PTERMS(:,42,91) = +0.13007*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) -! -!PTERMS(NO,K092) = -K092*<ALKEP>*<NO> - PTERMS(:,3,92) = -TPK%K092(:)*PCONC(:,35)*PCONC(:,3) -! -!PTERMS(NO2,K092) = +K092*<ALKEP>*<NO> - PTERMS(:,4,92) = +TPK%K092(:)*PCONC(:,35)*PCONC(:,3) -! -!PTERMS(HO2,K092) = +K092*<ALKEP>*<NO> - PTERMS(:,16,92) = +TPK%K092(:)*PCONC(:,35)*PCONC(:,3) -! -!PTERMS(HCHO,K092) = +1.39870*K092*<ALKEP>*<NO> - PTERMS(:,23,92) = +1.39870*TPK%K092(:)*PCONC(:,35)*PCONC(:,3) -! -!PTERMS(ALD,K092) = +0.42125*K092*<ALKEP>*<NO> - PTERMS(:,24,92) = +0.42125*TPK%K092(:)*PCONC(:,35)*PCONC(:,3) -! -!PTERMS(KET,K092) = +0.05220*K092*<ALKEP>*<NO> - PTERMS(:,25,92) = +0.05220*TPK%K092(:)*PCONC(:,35)*PCONC(:,3) -! -!PTERMS(ALKEP,K092) = -K092*<ALKEP>*<NO> - PTERMS(:,35,92) = -TPK%K092(:)*PCONC(:,35)*PCONC(:,3) -! -!PTERMS(NO,K093) = -K093*<BIOP>*<NO> - PTERMS(:,3,93) = -TPK%K093(:)*PCONC(:,36)*PCONC(:,3) -! -!PTERMS(NO2,K093) = +0.84700*K093*<BIOP>*<NO> - PTERMS(:,4,93) = +0.84700*TPK%K093(:)*PCONC(:,36)*PCONC(:,3) -! -!PTERMS(HO2,K093) = +0.84700*K093*<BIOP>*<NO> - PTERMS(:,16,93) = +0.84700*TPK%K093(:)*PCONC(:,36)*PCONC(:,3) -! -!PTERMS(ALKE,K093) = +0.37815*K093*<BIOP>*<NO> - PTERMS(:,20,93) = +0.37815*TPK%K093(:)*PCONC(:,36)*PCONC(:,3) -! -!PTERMS(HCHO,K093) = +0.60600*K093*<BIOP>*<NO> - PTERMS(:,23,93) = +0.60600*TPK%K093(:)*PCONC(:,36)*PCONC(:,3) -! -!PTERMS(ALD,K093) = +0.00000*K093*<BIOP>*<NO> - PTERMS(:,24,93) = +0.00000*TPK%K093(:)*PCONC(:,36)*PCONC(:,3) -! -!PTERMS(KET,K093) = +0.00000*K093*<BIOP>*<NO> - PTERMS(:,25,93) = +0.00000*TPK%K093(:)*PCONC(:,36)*PCONC(:,3) -! -!PTERMS(CARBO,K093) = +0.45463*K093*<BIOP>*<NO> - PTERMS(:,26,93) = +0.45463*TPK%K093(:)*PCONC(:,36)*PCONC(:,3) -! -!PTERMS(ONIT,K093) = +0.15300*K093*<BIOP>*<NO> - PTERMS(:,27,93) = +0.15300*TPK%K093(:)*PCONC(:,36)*PCONC(:,3) -! -! -RETURN -END SUBROUTINE SUBT18 -! -SUBROUTINE SUBT19 -! -!Indices 381 a 400 -! -!PTERMS(BIOP,K093) = -K093*<BIOP>*<NO> - PTERMS(:,36,93) = -TPK%K093(:)*PCONC(:,36)*PCONC(:,3) -! -!PTERMS(NO,K094) = -K094*<AROP>*<NO> - PTERMS(:,3,94) = -TPK%K094(:)*PCONC(:,39)*PCONC(:,3) -! -!PTERMS(NO2,K094) = +0.95115*K094*<AROP>*<NO> - PTERMS(:,4,94) = +0.95115*TPK%K094(:)*PCONC(:,39)*PCONC(:,3) -! -!PTERMS(HO2,K094) = +0.95115*K094*<AROP>*<NO> - PTERMS(:,16,94) = +0.95115*TPK%K094(:)*PCONC(:,39)*PCONC(:,3) -! -!PTERMS(CARBO,K094) = +2.06993*K094*<AROP>*<NO> - PTERMS(:,26,94) = +2.06993*TPK%K094(:)*PCONC(:,39)*PCONC(:,3) -! -!PTERMS(ONIT,K094) = +0.04885*K094*<AROP>*<NO> - PTERMS(:,27,94) = +0.04885*TPK%K094(:)*PCONC(:,39)*PCONC(:,3) -! -!PTERMS(AROP,K094) = -K094*<AROP>*<NO> - PTERMS(:,39,94) = -TPK%K094(:)*PCONC(:,39)*PCONC(:,3) -! -!PTERMS(NO,K095) = -K095*<CARBOP>*<NO> - PTERMS(:,3,95) = -TPK%K095(:)*PCONC(:,40)*PCONC(:,3) -! -!PTERMS(NO2,K095) = +K095*<CARBOP>*<NO> - PTERMS(:,4,95) = +TPK%K095(:)*PCONC(:,40)*PCONC(:,3) -! -!PTERMS(HO2,K095) = +0.12334*K095*<CARBOP>*<NO> - PTERMS(:,16,95) = +0.12334*TPK%K095(:)*PCONC(:,40)*PCONC(:,3) -! -!PTERMS(HCHO,K095) = +0.05848*K095*<CARBOP>*<NO> - PTERMS(:,23,95) = +0.05848*TPK%K095(:)*PCONC(:,40)*PCONC(:,3) -! -!PTERMS(ALD,K095) = +0.07368*K095*<CARBOP>*<NO> - PTERMS(:,24,95) = +0.07368*TPK%K095(:)*PCONC(:,40)*PCONC(:,3) -! -!PTERMS(CARBO,K095) = +0.08670*K095*<CARBOP>*<NO> - PTERMS(:,26,95) = +0.08670*TPK%K095(:)*PCONC(:,40)*PCONC(:,3) -! -!PTERMS(MO2,K095) = +0.78134*K095*<CARBOP>*<NO> - PTERMS(:,33,95) = +0.78134*TPK%K095(:)*PCONC(:,40)*PCONC(:,3) -! -!PTERMS(CARBOP,K095) = -K095*<CARBOP>*<NO> - PTERMS(:,40,95) = -TPK%K095(:)*PCONC(:,40)*PCONC(:,3) -! -!PTERMS(XO2,K095) = +0.02563*K095*<CARBOP>*<NO> - PTERMS(:,42,95) = +0.02563*TPK%K095(:)*PCONC(:,40)*PCONC(:,3) -! -!PTERMS(NO,K096) = -K096*<OLN>*<NO> - PTERMS(:,3,96) = -TPK%K096(:)*PCONC(:,41)*PCONC(:,3) -! -!PTERMS(NO2,K096) = +1.81599*K096*<OLN>*<NO> - PTERMS(:,4,96) = +1.81599*TPK%K096(:)*PCONC(:,41)*PCONC(:,3) -! -!PTERMS(HO2,K096) = +0.18401*K096*<OLN>*<NO> - PTERMS(:,16,96) = +0.18401*TPK%K096(:)*PCONC(:,41)*PCONC(:,3) -! -!PTERMS(HCHO,K096) = +0.23419*K096*<OLN>*<NO> - PTERMS(:,23,96) = +0.23419*TPK%K096(:)*PCONC(:,41)*PCONC(:,3) -! -! -RETURN -END SUBROUTINE SUBT19 -! -SUBROUTINE SUBT20 -! -!Indices 401 a 420 -! -!PTERMS(ALD,K096) = +1.01182*K096*<OLN>*<NO> - PTERMS(:,24,96) = +1.01182*TPK%K096(:)*PCONC(:,41)*PCONC(:,3) -! -!PTERMS(KET,K096) = +0.37862*K096*<OLN>*<NO> - PTERMS(:,25,96) = +0.37862*TPK%K096(:)*PCONC(:,41)*PCONC(:,3) -! -!PTERMS(ONIT,K096) = +0.18401*K096*<OLN>*<NO> - PTERMS(:,27,96) = +0.18401*TPK%K096(:)*PCONC(:,41)*PCONC(:,3) -! -!PTERMS(OLN,K096) = -K096*<OLN>*<NO> - PTERMS(:,41,96) = -TPK%K096(:)*PCONC(:,41)*PCONC(:,3) -! -!PTERMS(HO2,K097) = -K097*<MO2>*<HO2> - PTERMS(:,16,97) = -TPK%K097(:)*PCONC(:,33)*PCONC(:,16) -! -!PTERMS(OP1,K097) = +K097*<MO2>*<HO2> - PTERMS(:,29,97) = +TPK%K097(:)*PCONC(:,33)*PCONC(:,16) -! -!PTERMS(MO2,K097) = -K097*<MO2>*<HO2> - PTERMS(:,33,97) = -TPK%K097(:)*PCONC(:,33)*PCONC(:,16) -! -!PTERMS(HO2,K098) = -K098*<ALKAP>*<HO2> - PTERMS(:,16,98) = -TPK%K098(:)*PCONC(:,34)*PCONC(:,16) -! -!PTERMS(OP2,K098) = +1.00524*K098*<ALKAP>*<HO2> - PTERMS(:,30,98) = +1.00524*TPK%K098(:)*PCONC(:,34)*PCONC(:,16) -! -!PTERMS(ALKAP,K098) = -K098*<ALKAP>*<HO2> - PTERMS(:,34,98) = -TPK%K098(:)*PCONC(:,34)*PCONC(:,16) -! -!PTERMS(HO2,K099) = -K099*<ALKEP>*<HO2> - PTERMS(:,16,99) = -TPK%K099(:)*PCONC(:,35)*PCONC(:,16) -! -!PTERMS(OP2,K099) = +1.00524*K099*<ALKEP>*<HO2> - PTERMS(:,30,99) = +1.00524*TPK%K099(:)*PCONC(:,35)*PCONC(:,16) -! -!PTERMS(ALKEP,K099) = -K099*<ALKEP>*<HO2> - PTERMS(:,35,99) = -TPK%K099(:)*PCONC(:,35)*PCONC(:,16) -! -!PTERMS(HO2,K0100) = -K0100*<BIOP>*<HO2> - PTERMS(:,16,100) = -TPK%K0100(:)*PCONC(:,36)*PCONC(:,16) -! -!PTERMS(OP2,K0100) = +1.00524*K0100*<BIOP>*<HO2> - PTERMS(:,30,100) = +1.00524*TPK%K0100(:)*PCONC(:,36)*PCONC(:,16) -! -!PTERMS(BIOP,K0100) = -K0100*<BIOP>*<HO2> - PTERMS(:,36,100) = -TPK%K0100(:)*PCONC(:,36)*PCONC(:,16) -! -!PTERMS(HO2,K0101) = -K0101*<AROP>*<HO2> - PTERMS(:,16,101) = -TPK%K0101(:)*PCONC(:,39)*PCONC(:,16) -! -!PTERMS(OP2,K0101) = +1.00524*K0101*<AROP>*<HO2> - PTERMS(:,30,101) = +1.00524*TPK%K0101(:)*PCONC(:,39)*PCONC(:,16) -! -!PTERMS(AROP,K0101) = -K0101*<AROP>*<HO2> - PTERMS(:,39,101) = -TPK%K0101(:)*PCONC(:,39)*PCONC(:,16) -! -!PTERMS(O3,K0102) = +0.17307*K0102*<CARBOP>*<HO2> - PTERMS(:,1,102) = +0.17307*TPK%K0102(:)*PCONC(:,40)*PCONC(:,16) -! -! -RETURN -END SUBROUTINE SUBT20 -! -SUBROUTINE SUBT21 -! -!Indices 421 a 440 -! -!PTERMS(HO2,K0102) = -K0102*<CARBOP>*<HO2> - PTERMS(:,16,102) = -TPK%K0102(:)*PCONC(:,40)*PCONC(:,16) -! -!PTERMS(OP2,K0102) = +0.80904*K0102*<CARBOP>*<HO2> - PTERMS(:,30,102) = +0.80904*TPK%K0102(:)*PCONC(:,40)*PCONC(:,16) -! -!PTERMS(ORA2,K0102) = +0.17307*K0102*<CARBOP>*<HO2> - PTERMS(:,32,102) = +0.17307*TPK%K0102(:)*PCONC(:,40)*PCONC(:,16) -! -!PTERMS(CARBOP,K0102) = -K0102*<CARBOP>*<HO2> - PTERMS(:,40,102) = -TPK%K0102(:)*PCONC(:,40)*PCONC(:,16) -! -!PTERMS(HO2,K103) = -K103*<OLN>*<HO2> - PTERMS(:,16,103) = -TPK%K103(:)*PCONC(:,41)*PCONC(:,16) -! -!PTERMS(ONIT,K103) = +K103*<OLN>*<HO2> - PTERMS(:,27,103) = +TPK%K103(:)*PCONC(:,41)*PCONC(:,16) -! -!PTERMS(OLN,K103) = -K103*<OLN>*<HO2> - PTERMS(:,41,103) = -TPK%K103(:)*PCONC(:,41)*PCONC(:,16) -! -!PTERMS(HO2,K104) = +0.66*K104*<MO2>*<MO2> - PTERMS(:,16,104) = +0.66*TPK%K104(:)*PCONC(:,33)*PCONC(:,33) -! -!PTERMS(HCHO,K104) = +1.33*K104*<MO2>*<MO2> - PTERMS(:,23,104) = +1.33*TPK%K104(:)*PCONC(:,33)*PCONC(:,33) -! -!PTERMS(MO2,K104) = -K104*<MO2>*<MO2> - PTERMS(:,33,104) = -TPK%K104(:)*PCONC(:,33)*PCONC(:,33) -! -!PTERMS(HO2,K105) = +0.98383*K105*<ALKAP>*<MO2> - PTERMS(:,16,105) = +0.98383*TPK%K105(:)*PCONC(:,34)*PCONC(:,33) -! -!PTERMS(HCHO,K105) = +0.80556*K105*<ALKAP>*<MO2> - PTERMS(:,23,105) = +0.80556*TPK%K105(:)*PCONC(:,34)*PCONC(:,33) -! -!PTERMS(ALD,K105) = +0.56070*K105*<ALKAP>*<MO2> - PTERMS(:,24,105) = +0.56070*TPK%K105(:)*PCONC(:,34)*PCONC(:,33) -! -!PTERMS(KET,K105) = +0.09673*K105*<ALKAP>*<MO2> - PTERMS(:,25,105) = +0.09673*TPK%K105(:)*PCONC(:,34)*PCONC(:,33) -! -!PTERMS(CARBO,K105) = +0.07976*K105*<ALKAP>*<MO2> - PTERMS(:,26,105) = +0.07976*TPK%K105(:)*PCONC(:,34)*PCONC(:,33) -! -!PTERMS(MO2,K105) = -K105*<ALKAP>*<MO2> - PTERMS(:,33,105) = -TPK%K105(:)*PCONC(:,34)*PCONC(:,33) -! -!PTERMS(ALKAP,K105) = -K105*<ALKAP>*<MO2> - PTERMS(:,34,105) = -TPK%K105(:)*PCONC(:,34)*PCONC(:,33) -! -!PTERMS(XO2,K105) = +0.13370*K105*<ALKAP>*<MO2> - PTERMS(:,42,105) = +0.13370*TPK%K105(:)*PCONC(:,34)*PCONC(:,33) -! -!PTERMS(HO2,K106) = +K106*<ALKEP>*<MO2> - PTERMS(:,16,106) = +TPK%K106(:)*PCONC(:,35)*PCONC(:,33) -! -!PTERMS(HCHO,K106) = +1.42894*K106*<ALKEP>*<MO2> - PTERMS(:,23,106) = +1.42894*TPK%K106(:)*PCONC(:,35)*PCONC(:,33) -! -! -RETURN -END SUBROUTINE SUBT21 -! -SUBROUTINE SUBT22 -! -!Indices 441 a 460 -! -!PTERMS(ALD,K106) = +0.46413*K106*<ALKEP>*<MO2> - PTERMS(:,24,106) = +0.46413*TPK%K106(:)*PCONC(:,35)*PCONC(:,33) -! -!PTERMS(KET,K106) = +0.03814*K106*<ALKEP>*<MO2> - PTERMS(:,25,106) = +0.03814*TPK%K106(:)*PCONC(:,35)*PCONC(:,33) -! -!PTERMS(MO2,K106) = -K106*<ALKEP>*<MO2> - PTERMS(:,33,106) = -TPK%K106(:)*PCONC(:,35)*PCONC(:,33) -! -!PTERMS(ALKEP,K106) = -K106*<ALKEP>*<MO2> - PTERMS(:,35,106) = -TPK%K106(:)*PCONC(:,35)*PCONC(:,33) -! -!PTERMS(HO2,K107) = +1.00000*K107*<BIOP>*<MO2> - PTERMS(:,16,107) = +1.00000*TPK%K107(:)*PCONC(:,36)*PCONC(:,33) -! -!PTERMS(ALKE,K107) = +0.48074*K107*<BIOP>*<MO2> - PTERMS(:,20,107) = +0.48074*TPK%K107(:)*PCONC(:,36)*PCONC(:,33) -! -!PTERMS(HCHO,K107) = +1.09000*K107*<BIOP>*<MO2> - PTERMS(:,23,107) = +1.09000*TPK%K107(:)*PCONC(:,36)*PCONC(:,33) -! -!PTERMS(ALD,K107) = +0.00000*K107*<BIOP>*<MO2> - PTERMS(:,24,107) = +0.00000*TPK%K107(:)*PCONC(:,36)*PCONC(:,33) -! -!PTERMS(KET,K107) = +0.00000*K107*<BIOP>*<MO2> - PTERMS(:,25,107) = +0.00000*TPK%K107(:)*PCONC(:,36)*PCONC(:,33) -! -!PTERMS(CARBO,K107) = +0.56064*K107*<BIOP>*<MO2> - PTERMS(:,26,107) = +0.56064*TPK%K107(:)*PCONC(:,36)*PCONC(:,33) -! -!PTERMS(MO2,K107) = -K107*<BIOP>*<MO2> - PTERMS(:,33,107) = -TPK%K107(:)*PCONC(:,36)*PCONC(:,33) -! -!PTERMS(BIOP,K107) = -K107*<BIOP>*<MO2> - PTERMS(:,36,107) = -TPK%K107(:)*PCONC(:,36)*PCONC(:,33) -! -!PTERMS(HO2,K108) = +1.02767*K108*<AROP>*<MO2> - PTERMS(:,16,108) = +1.02767*TPK%K108(:)*PCONC(:,39)*PCONC(:,33) -! -!PTERMS(HCHO,K108) = +K108*<AROP>*<MO2> - PTERMS(:,23,108) = +TPK%K108(:)*PCONC(:,39)*PCONC(:,33) -! -!PTERMS(CARBO,K108) = +1.99461*K108*<AROP>*<MO2> - PTERMS(:,26,108) = +1.99461*TPK%K108(:)*PCONC(:,39)*PCONC(:,33) -! -!PTERMS(MO2,K108) = -K108*<AROP>*<MO2> - PTERMS(:,33,108) = -TPK%K108(:)*PCONC(:,39)*PCONC(:,33) -! -!PTERMS(AROP,K108) = -K108*<AROP>*<MO2> - PTERMS(:,39,108) = -TPK%K108(:)*PCONC(:,39)*PCONC(:,33) -! -!PTERMS(HO2,K109) = +0.82998*K109*<CARBOP>*<MO2> - PTERMS(:,16,109) = +0.82998*TPK%K109(:)*PCONC(:,40)*PCONC(:,33) -! -!PTERMS(HCHO,K109) = +0.95723*K109*<CARBOP>*<MO2> - PTERMS(:,23,109) = +0.95723*TPK%K109(:)*PCONC(:,40)*PCONC(:,33) -! -!PTERMS(ALD,K109) = +0.08295*K109*<CARBOP>*<MO2> - PTERMS(:,24,109) = +0.08295*TPK%K109(:)*PCONC(:,40)*PCONC(:,33) -! -! -RETURN -END SUBROUTINE SUBT22 -! -SUBROUTINE SUBT23 -! -!Indices 461 a 480 -! -!PTERMS(CARBO,K109) = +0.15387*K109*<CARBOP>*<MO2> - PTERMS(:,26,109) = +0.15387*TPK%K109(:)*PCONC(:,40)*PCONC(:,33) -! -!PTERMS(ORA2,K109) = +0.13684*K109*<CARBOP>*<MO2> - PTERMS(:,32,109) = +0.13684*TPK%K109(:)*PCONC(:,40)*PCONC(:,33) -! -!PTERMS(MO2,K109) = -K109*<CARBOP>*<MO2> - PTERMS(:,33,109) = -TPK%K109(:)*PCONC(:,40)*PCONC(:,33) -! -!PTERMS(CARBOP,K109) = -K109*<CARBOP>*<MO2> - PTERMS(:,40,109) = -TPK%K109(:)*PCONC(:,40)*PCONC(:,33) -! -!PTERMS(XO2,K109) = +0.02212*K109*<CARBOP>*<MO2> - PTERMS(:,42,109) = +0.02212*TPK%K109(:)*PCONC(:,40)*PCONC(:,33) -! -!PTERMS(NO2,K110) = +0.32440*K110*<OLN>*<MO2> - PTERMS(:,4,110) = +0.32440*TPK%K110(:)*PCONC(:,41)*PCONC(:,33) -! -!PTERMS(HO2,K110) = +0.67560*K110*<OLN>*<MO2> - PTERMS(:,16,110) = +0.67560*TPK%K110(:)*PCONC(:,41)*PCONC(:,33) -! -!PTERMS(HCHO,K110) = +0.88625*K110*<OLN>*<MO2> - PTERMS(:,23,110) = +0.88625*TPK%K110(:)*PCONC(:,41)*PCONC(:,33) -! -!PTERMS(ALD,K110) = +0.41524*K110*<OLN>*<MO2> - PTERMS(:,24,110) = +0.41524*TPK%K110(:)*PCONC(:,41)*PCONC(:,33) -! -!PTERMS(KET,K110) = +0.09667*K110*<OLN>*<MO2> - PTERMS(:,25,110) = +0.09667*TPK%K110(:)*PCONC(:,41)*PCONC(:,33) -! -!PTERMS(ONIT,K110) = +0.67560*K110*<OLN>*<MO2> - PTERMS(:,27,110) = +0.67560*TPK%K110(:)*PCONC(:,41)*PCONC(:,33) -! -!PTERMS(MO2,K110) = -K110*<OLN>*<MO2> - PTERMS(:,33,110) = -TPK%K110(:)*PCONC(:,41)*PCONC(:,33) -! -!PTERMS(OLN,K110) = -K110*<OLN>*<MO2> - PTERMS(:,41,110) = -TPK%K110(:)*PCONC(:,41)*PCONC(:,33) -! -!PTERMS(HO2,K111) = +0.48079*K111*<ALKAP>*<CARBOP> - PTERMS(:,16,111) = +0.48079*TPK%K111(:)*PCONC(:,34)*PCONC(:,40) -! -!PTERMS(HCHO,K111) = +0.07600*K111*<ALKAP>*<CARBOP> - PTERMS(:,23,111) = +0.07600*TPK%K111(:)*PCONC(:,34)*PCONC(:,40) -! -!PTERMS(ALD,K111) = +0.71461*K111*<ALKAP>*<CARBOP> - PTERMS(:,24,111) = +0.71461*TPK%K111(:)*PCONC(:,34)*PCONC(:,40) -! -!PTERMS(KET,K111) = +0.18819*K111*<ALKAP>*<CARBOP> - PTERMS(:,25,111) = +0.18819*TPK%K111(:)*PCONC(:,34)*PCONC(:,40) -! -!PTERMS(CARBO,K111) = +0.06954*K111*<ALKAP>*<CARBOP> - PTERMS(:,26,111) = +0.06954*TPK%K111(:)*PCONC(:,34)*PCONC(:,40) -! -!PTERMS(ORA2,K111) = +0.49810*K111*<ALKAP>*<CARBOP> - PTERMS(:,32,111) = +0.49810*TPK%K111(:)*PCONC(:,34)*PCONC(:,40) -! -!PTERMS(MO2,K111) = +0.51480*K111*<ALKAP>*<CARBOP> - PTERMS(:,33,111) = +0.51480*TPK%K111(:)*PCONC(:,34)*PCONC(:,40) -! -! -RETURN -END SUBROUTINE SUBT23 -! -SUBROUTINE SUBT24 -! -!Indices 481 a 500 -! -!PTERMS(ALKAP,K111) = -K111*<ALKAP>*<CARBOP> - PTERMS(:,34,111) = -TPK%K111(:)*PCONC(:,34)*PCONC(:,40) -! -!PTERMS(CARBOP,K111) = -K111*<ALKAP>*<CARBOP> - PTERMS(:,40,111) = -TPK%K111(:)*PCONC(:,34)*PCONC(:,40) -! -!PTERMS(XO2,K111) = +0.11306*K111*<ALKAP>*<CARBOP> - PTERMS(:,42,111) = +0.11306*TPK%K111(:)*PCONC(:,34)*PCONC(:,40) -! -!PTERMS(HO2,K112) = +0.50078*K112*<ALKEP>*<CARBOP> - PTERMS(:,16,112) = +0.50078*TPK%K112(:)*PCONC(:,35)*PCONC(:,40) -! -!PTERMS(HCHO,K112) = +0.68192*K112*<ALKEP>*<CARBOP> - PTERMS(:,23,112) = +0.68192*TPK%K112(:)*PCONC(:,35)*PCONC(:,40) -! -!PTERMS(ALD,K112) = +0.68374*K112*<ALKEP>*<CARBOP> - PTERMS(:,24,112) = +0.68374*TPK%K112(:)*PCONC(:,35)*PCONC(:,40) -! -!PTERMS(KET,K112) = +0.06579*K112*<ALKEP>*<CARBOP> - PTERMS(:,25,112) = +0.06579*TPK%K112(:)*PCONC(:,35)*PCONC(:,40) -! -!PTERMS(ORA2,K112) = +0.49922*K112*<ALKEP>*<CARBOP> - PTERMS(:,32,112) = +0.49922*TPK%K112(:)*PCONC(:,35)*PCONC(:,40) -! -!PTERMS(MO2,K112) = +0.50078*K112*<ALKEP>*<CARBOP> - PTERMS(:,33,112) = +0.50078*TPK%K112(:)*PCONC(:,35)*PCONC(:,40) -! -!PTERMS(ALKEP,K112) = -K112*<ALKEP>*<CARBOP> - PTERMS(:,35,112) = -TPK%K112(:)*PCONC(:,35)*PCONC(:,40) -! -!PTERMS(CARBOP,K112) = -K112*<ALKEP>*<CARBOP> - PTERMS(:,40,112) = -TPK%K112(:)*PCONC(:,35)*PCONC(:,40) -! -!PTERMS(HO2,K113) = +0.50600*K113*<BIOP>*<CARBOP> - PTERMS(:,16,113) = +0.50600*TPK%K113(:)*PCONC(:,36)*PCONC(:,40) -! -!PTERMS(ALKE,K113) = +0.24463*K113*<BIOP>*<CARBOP> - PTERMS(:,20,113) = +0.24463*TPK%K113(:)*PCONC(:,36)*PCONC(:,40) -! -!PTERMS(HCHO,K113) = +0.34000*K113*<BIOP>*<CARBOP> - PTERMS(:,23,113) = +0.34000*TPK%K113(:)*PCONC(:,36)*PCONC(:,40) -! -!PTERMS(ALD,K113) = +0.00000*K113*<BIOP>*<CARBOP> - PTERMS(:,24,113) = +0.00000*TPK%K113(:)*PCONC(:,36)*PCONC(:,40) -! -!PTERMS(KET,K113) = +0.00000*K113*<BIOP>*<CARBOP> - PTERMS(:,25,113) = +0.00000*TPK%K113(:)*PCONC(:,36)*PCONC(:,40) -! -!PTERMS(CARBO,K113) = +0.78591*K113*<BIOP>*<CARBOP> - PTERMS(:,26,113) = +0.78591*TPK%K113(:)*PCONC(:,36)*PCONC(:,40) -! -!PTERMS(ORA2,K113) = +0.49400*K113*<BIOP>*<CARBOP> - PTERMS(:,32,113) = +0.49400*TPK%K113(:)*PCONC(:,36)*PCONC(:,40) -! -!PTERMS(MO2,K113) = +0.50600*K113*<BIOP>*<CARBOP> - PTERMS(:,33,113) = +0.50600*TPK%K113(:)*PCONC(:,36)*PCONC(:,40) -! -!PTERMS(BIOP,K113) = -K113*<BIOP>*<CARBOP> - PTERMS(:,36,113) = -TPK%K113(:)*PCONC(:,36)*PCONC(:,40) -! -! -RETURN -END SUBROUTINE SUBT24 -! -SUBROUTINE SUBT25 -! -!Indices 501 a 520 -! -!PTERMS(CARBOP,K113) = -K113*<BIOP>*<CARBOP> - PTERMS(:,40,113) = -TPK%K113(:)*PCONC(:,36)*PCONC(:,40) -! -!PTERMS(HO2,K114) = +K114*<AROP>*<CARBOP> - PTERMS(:,16,114) = +TPK%K114(:)*PCONC(:,39)*PCONC(:,40) -! -!PTERMS(CARBO,K114) = +1.99455*K114*<AROP>*<CARBOP> - PTERMS(:,26,114) = +1.99455*TPK%K114(:)*PCONC(:,39)*PCONC(:,40) -! -!PTERMS(MO2,K114) = +K114*<AROP>*<CARBOP> - PTERMS(:,33,114) = +TPK%K114(:)*PCONC(:,39)*PCONC(:,40) -! -!PTERMS(AROP,K114) = -K114*<AROP>*<CARBOP> - PTERMS(:,39,114) = -TPK%K114(:)*PCONC(:,39)*PCONC(:,40) -! -!PTERMS(CARBOP,K114) = -K114*<AROP>*<CARBOP> - PTERMS(:,40,114) = -TPK%K114(:)*PCONC(:,39)*PCONC(:,40) -! -!PTERMS(HO2,K115) = +0.07566*K115*<CARBOP>*<CARBOP> - PTERMS(:,16,115) = +0.07566*TPK%K115(:)*PCONC(:,40)*PCONC(:,40) -! -!PTERMS(HCHO,K115) = +0.03432*K115*<CARBOP>*<CARBOP> - PTERMS(:,23,115) = +0.03432*TPK%K115(:)*PCONC(:,40)*PCONC(:,40) -! -!PTERMS(ALD,K115) = +0.06969*K115*<CARBOP>*<CARBOP> - PTERMS(:,24,115) = +0.06969*TPK%K115(:)*PCONC(:,40)*PCONC(:,40) -! -!PTERMS(KET,K115) = +0.02190*K115*<CARBOP>*<CARBOP> - PTERMS(:,25,115) = +0.02190*TPK%K115(:)*PCONC(:,40)*PCONC(:,40) -! -!PTERMS(CARBO,K115) = +0.10777*K115*<CARBOP>*<CARBOP> - PTERMS(:,26,115) = +0.10777*TPK%K115(:)*PCONC(:,40)*PCONC(:,40) -! -!PTERMS(ORA2,K115) = +0.09955*K115*<CARBOP>*<CARBOP> - PTERMS(:,32,115) = +0.09955*TPK%K115(:)*PCONC(:,40)*PCONC(:,40) -! -!PTERMS(MO2,K115) = +1.66702*K115*<CARBOP>*<CARBOP> - PTERMS(:,33,115) = +1.66702*TPK%K115(:)*PCONC(:,40)*PCONC(:,40) -! -!PTERMS(CARBOP,K115) = -K115*<CARBOP>*<CARBOP> - PTERMS(:,40,115) = -TPK%K115(:)*PCONC(:,40)*PCONC(:,40) -! -!PTERMS(XO2,K115) = +0.01593*K115*<CARBOP>*<CARBOP> - PTERMS(:,42,115) = +0.01593*TPK%K115(:)*PCONC(:,40)*PCONC(:,40) -! -!PTERMS(NO2,K116) = +0.00000*K116*<OLN>*<CARBOP> - PTERMS(:,4,116) = +0.00000*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) -! -!PTERMS(HO2,K116) = +0.17599*K116*<OLN>*<CARBOP> - PTERMS(:,16,116) = +0.17599*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) -! -!PTERMS(HCHO,K116) = +0.13414*K116*<OLN>*<CARBOP> - PTERMS(:,23,116) = +0.13414*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) -! -!PTERMS(ALD,K116) = +0.42122*K116*<OLN>*<CARBOP> - PTERMS(:,24,116) = +0.42122*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) -! -!PTERMS(KET,K116) = +0.10822*K116*<OLN>*<CARBOP> - PTERMS(:,25,116) = +0.10822*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) -! -! -RETURN -END SUBROUTINE SUBT25 -! -SUBROUTINE SUBT26 -! -!Indices 521 a 540 -! -!PTERMS(ONIT,K116) = +0.66562*K116*<OLN>*<CARBOP> - PTERMS(:,27,116) = +0.66562*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) -! -!PTERMS(ORA2,K116) = +0.48963*K116*<OLN>*<CARBOP> - PTERMS(:,32,116) = +0.48963*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) -! -!PTERMS(MO2,K116) = +0.51037*K116*<OLN>*<CARBOP> - PTERMS(:,33,116) = +0.51037*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) -! -!PTERMS(CARBOP,K116) = -K116*<OLN>*<CARBOP> - PTERMS(:,40,116) = -TPK%K116(:)*PCONC(:,41)*PCONC(:,40) -! -!PTERMS(OLN,K116) = -K116*<OLN>*<CARBOP> - PTERMS(:,41,116) = -TPK%K116(:)*PCONC(:,41)*PCONC(:,40) -! -!PTERMS(HO2,K117) = +K117*<OLN>*<OLN> - PTERMS(:,16,117) = +TPK%K117(:)*PCONC(:,41)*PCONC(:,41) -! -!PTERMS(ONIT,K117) = +2.00*K117*<OLN>*<OLN> - PTERMS(:,27,117) = +2.00*TPK%K117(:)*PCONC(:,41)*PCONC(:,41) -! -!PTERMS(OLN,K117) = -K117*<OLN>*<OLN> - PTERMS(:,41,117) = -TPK%K117(:)*PCONC(:,41)*PCONC(:,41) -! -!PTERMS(NO2,K118) = +0.00000*K118*<OLN>*<OLN> - PTERMS(:,4,118) = +0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,41) -! -!PTERMS(HO2,K118) = +0.00000*K118*<OLN>*<OLN> - PTERMS(:,16,118) = +0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,41) -! -!PTERMS(HCHO,K118) = +0.00000*K118*<OLN>*<OLN> - PTERMS(:,23,118) = +0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,41) -! -!PTERMS(ALD,K118) = +0.00000*K118*<OLN>*<OLN> - PTERMS(:,24,118) = +0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,41) -! -!PTERMS(KET,K118) = +0.00000*K118*<OLN>*<OLN> - PTERMS(:,25,118) = +0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,41) -! -!PTERMS(ONIT,K118) = +0.00000*K118*<OLN>*<OLN> - PTERMS(:,27,118) = +0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,41) -! -!PTERMS(OLN,K118) = -K118*<OLN>*<OLN> - PTERMS(:,41,118) = -TPK%K118(:)*PCONC(:,41)*PCONC(:,41) -! -!PTERMS(NO2,K119) = +K119*<MO2>*<NO3> - PTERMS(:,4,119) = +TPK%K119(:)*PCONC(:,33)*PCONC(:,5) -! -!PTERMS(NO3,K119) = -K119*<MO2>*<NO3> - PTERMS(:,5,119) = -TPK%K119(:)*PCONC(:,33)*PCONC(:,5) -! -!PTERMS(HO2,K119) = +K119*<MO2>*<NO3> - PTERMS(:,16,119) = +TPK%K119(:)*PCONC(:,33)*PCONC(:,5) -! -!PTERMS(HCHO,K119) = +K119*<MO2>*<NO3> - PTERMS(:,23,119) = +TPK%K119(:)*PCONC(:,33)*PCONC(:,5) -! -!PTERMS(MO2,K119) = -K119*<MO2>*<NO3> - PTERMS(:,33,119) = -TPK%K119(:)*PCONC(:,33)*PCONC(:,5) -! -! -RETURN -END SUBROUTINE SUBT26 -! -SUBROUTINE SUBT27 -! -!Indices 541 a 560 -! -!PTERMS(NO2,K120) = +K120*<ALKAP>*<NO3> - PTERMS(:,4,120) = +TPK%K120(:)*PCONC(:,34)*PCONC(:,5) -! -!PTERMS(NO3,K120) = -K120*<ALKAP>*<NO3> - PTERMS(:,5,120) = -TPK%K120(:)*PCONC(:,34)*PCONC(:,5) -! -!PTERMS(HO2,K120) = +0.81290*K120*<ALKAP>*<NO3> - PTERMS(:,16,120) = +0.81290*TPK%K120(:)*PCONC(:,34)*PCONC(:,5) -! -!PTERMS(HCHO,K120) = +0.03142*K120*<ALKAP>*<NO3> - PTERMS(:,23,120) = +0.03142*TPK%K120(:)*PCONC(:,34)*PCONC(:,5) -! -!PTERMS(ALD,K120) = +0.33743*K120*<ALKAP>*<NO3> - PTERMS(:,24,120) = +0.33743*TPK%K120(:)*PCONC(:,34)*PCONC(:,5) -! -!PTERMS(KET,K120) = +0.62978*K120*<ALKAP>*<NO3> - PTERMS(:,25,120) = +0.62978*TPK%K120(:)*PCONC(:,34)*PCONC(:,5) -! -!PTERMS(CARBO,K120) = +0.03531*K120*<ALKAP>*<NO3> - PTERMS(:,26,120) = +0.03531*TPK%K120(:)*PCONC(:,34)*PCONC(:,5) -! -!PTERMS(MO2,K120) = +0.09731*K120*<ALKAP>*<NO3> - PTERMS(:,33,120) = +0.09731*TPK%K120(:)*PCONC(:,34)*PCONC(:,5) -! -!PTERMS(ALKAP,K120) = -K120*<ALKAP>*<NO3> - PTERMS(:,34,120) = -TPK%K120(:)*PCONC(:,34)*PCONC(:,5) -! -!PTERMS(XO2,K120) = +0.16271*K120*<ALKAP>*<NO3> - PTERMS(:,42,120) = +0.16271*TPK%K120(:)*PCONC(:,34)*PCONC(:,5) -! -!PTERMS(NO2,K121) = +K121*<ALKEP>*<NO3> - PTERMS(:,4,121) = +TPK%K121(:)*PCONC(:,35)*PCONC(:,5) -! -!PTERMS(NO3,K121) = -K121*<ALKEP>*<NO3> - PTERMS(:,5,121) = -TPK%K121(:)*PCONC(:,35)*PCONC(:,5) -! -!PTERMS(HO2,K121) = +K121*<ALKEP>*<NO3> - PTERMS(:,16,121) = +TPK%K121(:)*PCONC(:,35)*PCONC(:,5) -! -!PTERMS(HCHO,K121) = +1.40909*K121*<ALKEP>*<NO3> - PTERMS(:,23,121) = +1.40909*TPK%K121(:)*PCONC(:,35)*PCONC(:,5) -! -!PTERMS(ALD,K121) = +0.43039*K121*<ALKEP>*<NO3> - PTERMS(:,24,121) = +0.43039*TPK%K121(:)*PCONC(:,35)*PCONC(:,5) -! -!PTERMS(KET,K121) = +0.02051*K121*<ALKEP>*<NO3> - PTERMS(:,25,121) = +0.02051*TPK%K121(:)*PCONC(:,35)*PCONC(:,5) -! -!PTERMS(ALKEP,K121) = -K121*<ALKEP>*<NO3> - PTERMS(:,35,121) = -TPK%K121(:)*PCONC(:,35)*PCONC(:,5) -! -!PTERMS(NO2,K122) = +K122*<BIOP>*<NO3> - PTERMS(:,4,122) = +TPK%K122(:)*PCONC(:,36)*PCONC(:,5) -! -!PTERMS(NO3,K122) = -K122*<BIOP>*<NO3> - PTERMS(:,5,122) = -TPK%K122(:)*PCONC(:,36)*PCONC(:,5) -! -!PTERMS(HO2,K122) = +K122*<BIOP>*<NO3> - PTERMS(:,16,122) = +TPK%K122(:)*PCONC(:,36)*PCONC(:,5) -! -! -RETURN -END SUBROUTINE SUBT27 -! -SUBROUTINE SUBT28 -! -!Indices 561 a 580 -! -!PTERMS(ALKE,K122) = +0.42729*K122*<BIOP>*<NO3> - PTERMS(:,20,122) = +0.42729*TPK%K122(:)*PCONC(:,36)*PCONC(:,5) -! -!PTERMS(HCHO,K122) = +0.68600*K122*<BIOP>*<NO3> - PTERMS(:,23,122) = +0.68600*TPK%K122(:)*PCONC(:,36)*PCONC(:,5) -! -!PTERMS(ALD,K122) = +0.00000*K122*<BIOP>*<NO3> - PTERMS(:,24,122) = +0.00000*TPK%K122(:)*PCONC(:,36)*PCONC(:,5) -! -!PTERMS(KET,K122) = +0.00000*K122*<BIOP>*<NO3> - PTERMS(:,25,122) = +0.00000*TPK%K122(:)*PCONC(:,36)*PCONC(:,5) -! -!PTERMS(CARBO,K122) = +0.61160*K122*<BIOP>*<NO3> - PTERMS(:,26,122) = +0.61160*TPK%K122(:)*PCONC(:,36)*PCONC(:,5) -! -!PTERMS(BIOP,K122) = -K122*<BIOP>*<NO3> - PTERMS(:,36,122) = -TPK%K122(:)*PCONC(:,36)*PCONC(:,5) -! -!PTERMS(NO2,K123) = +K123*<AROP>*<NO3> - PTERMS(:,4,123) = +TPK%K123(:)*PCONC(:,39)*PCONC(:,5) -! -!PTERMS(NO3,K123) = -K123*<AROP>*<NO3> - PTERMS(:,5,123) = -TPK%K123(:)*PCONC(:,39)*PCONC(:,5) -! -!PTERMS(HO2,K123) = +K123*<AROP>*<NO3> - PTERMS(:,16,123) = +TPK%K123(:)*PCONC(:,39)*PCONC(:,5) -! -!PTERMS(CARBO,K123) = +2.81904*K123*<AROP>*<NO3> - PTERMS(:,26,123) = +2.81904*TPK%K123(:)*PCONC(:,39)*PCONC(:,5) -! -!PTERMS(AROP,K123) = -K123*<AROP>*<NO3> - PTERMS(:,39,123) = -TPK%K123(:)*PCONC(:,39)*PCONC(:,5) -! -!PTERMS(NO2,K124) = +K124*<CARBOP>*<NO3> - PTERMS(:,4,124) = +TPK%K124(:)*PCONC(:,40)*PCONC(:,5) -! -!PTERMS(NO3,K124) = -K124*<CARBOP>*<NO3> - PTERMS(:,5,124) = -TPK%K124(:)*PCONC(:,40)*PCONC(:,5) -! -!PTERMS(HO2,K124) = +0.04915*K124*<CARBOP>*<NO3> - PTERMS(:,16,124) = +0.04915*TPK%K124(:)*PCONC(:,40)*PCONC(:,5) -! -!PTERMS(HCHO,K124) = +0.03175*K124*<CARBOP>*<NO3> - PTERMS(:,23,124) = +0.03175*TPK%K124(:)*PCONC(:,40)*PCONC(:,5) -! -!PTERMS(ALD,K124) = +0.02936*K124*<CARBOP>*<NO3> - PTERMS(:,24,124) = +0.02936*TPK%K124(:)*PCONC(:,40)*PCONC(:,5) -! -!PTERMS(CARBO,K124) = +0.03455*K124*<CARBOP>*<NO3> - PTERMS(:,26,124) = +0.03455*TPK%K124(:)*PCONC(:,40)*PCONC(:,5) -! -!PTERMS(MO2,K124) = +0.91910*K124*<CARBOP>*<NO3> - PTERMS(:,33,124) = +0.91910*TPK%K124(:)*PCONC(:,40)*PCONC(:,5) -! -!PTERMS(CARBOP,K124) = -K124*<CARBOP>*<NO3> - PTERMS(:,40,124) = -TPK%K124(:)*PCONC(:,40)*PCONC(:,5) -! -!PTERMS(XO2,K124) = +0.01021*K124*<CARBOP>*<NO3> - PTERMS(:,42,124) = +0.01021*TPK%K124(:)*PCONC(:,40)*PCONC(:,5) -! -! -RETURN -END SUBROUTINE SUBT28 -! -SUBROUTINE SUBT29 -! -!Indices 581 a 600 -! -!PTERMS(NO2,K125) = +1.74072*K125*<OLN>*<NO3> - PTERMS(:,4,125) = +1.74072*TPK%K125(:)*PCONC(:,41)*PCONC(:,5) -! -!PTERMS(NO3,K125) = -K125*<OLN>*<NO3> - PTERMS(:,5,125) = -TPK%K125(:)*PCONC(:,41)*PCONC(:,5) -! -!PTERMS(HO2,K125) = +0.25928*K125*<OLN>*<NO3> - PTERMS(:,16,125) = +0.25928*TPK%K125(:)*PCONC(:,41)*PCONC(:,5) -! -!PTERMS(HCHO,K125) = +0.20740*K125*<OLN>*<NO3> - PTERMS(:,23,125) = +0.20740*TPK%K125(:)*PCONC(:,41)*PCONC(:,5) -! -!PTERMS(ALD,K125) = +0.91850*K125*<OLN>*<NO3> - PTERMS(:,24,125) = +0.91850*TPK%K125(:)*PCONC(:,41)*PCONC(:,5) -! -!PTERMS(KET,K125) = +0.34740*K125*<OLN>*<NO3> - PTERMS(:,25,125) = +0.34740*TPK%K125(:)*PCONC(:,41)*PCONC(:,5) -! -!PTERMS(ONIT,K125) = +0.25928*K125*<OLN>*<NO3> - PTERMS(:,27,125) = +0.25928*TPK%K125(:)*PCONC(:,41)*PCONC(:,5) -! -!PTERMS(OLN,K125) = -K125*<OLN>*<NO3> - PTERMS(:,41,125) = -TPK%K125(:)*PCONC(:,41)*PCONC(:,5) -! -!PTERMS(HO2,K126) = -K126*<XO2>*<HO2> - PTERMS(:,16,126) = -TPK%K126(:)*PCONC(:,42)*PCONC(:,16) -! -!PTERMS(OP2,K126) = +1.00524*K126*<XO2>*<HO2> - PTERMS(:,30,126) = +1.00524*TPK%K126(:)*PCONC(:,42)*PCONC(:,16) -! -!PTERMS(XO2,K126) = -K126*<XO2>*<HO2> - PTERMS(:,42,126) = -TPK%K126(:)*PCONC(:,42)*PCONC(:,16) -! -!PTERMS(HO2,K127) = +K127*<XO2>*<MO2> - PTERMS(:,16,127) = +TPK%K127(:)*PCONC(:,42)*PCONC(:,33) -! -!PTERMS(HCHO,K127) = +K127*<XO2>*<MO2> - PTERMS(:,23,127) = +TPK%K127(:)*PCONC(:,42)*PCONC(:,33) -! -!PTERMS(MO2,K127) = -K127*<XO2>*<MO2> - PTERMS(:,33,127) = -TPK%K127(:)*PCONC(:,42)*PCONC(:,33) -! -!PTERMS(XO2,K127) = -K127*<XO2>*<MO2> - PTERMS(:,42,127) = -TPK%K127(:)*PCONC(:,42)*PCONC(:,33) -! -!PTERMS(MO2,K128) = +K128*<XO2>*<CARBOP> - PTERMS(:,33,128) = +TPK%K128(:)*PCONC(:,42)*PCONC(:,40) -! -!PTERMS(CARBOP,K128) = -K128*<XO2>*<CARBOP> - PTERMS(:,40,128) = -TPK%K128(:)*PCONC(:,42)*PCONC(:,40) -! -!PTERMS(XO2,K128) = -K128*<XO2>*<CARBOP> - PTERMS(:,42,128) = -TPK%K128(:)*PCONC(:,42)*PCONC(:,40) -! -!PTERMS(XO2,K129) = -K129*<XO2>*<XO2> - PTERMS(:,42,129) = -TPK%K129(:)*PCONC(:,42)*PCONC(:,42) -! -!PTERMS(NO,K130) = -K130*<XO2>*<NO> - PTERMS(:,3,130) = -TPK%K130(:)*PCONC(:,42)*PCONC(:,3) -! -! -RETURN -END SUBROUTINE SUBT29 -! -SUBROUTINE SUBT30 -! -!Indices 601 a 620 -! -!PTERMS(NO2,K130) = +K130*<XO2>*<NO> - PTERMS(:,4,130) = +TPK%K130(:)*PCONC(:,42)*PCONC(:,3) -! -!PTERMS(XO2,K130) = -K130*<XO2>*<NO> - PTERMS(:,42,130) = -TPK%K130(:)*PCONC(:,42)*PCONC(:,3) -! -!PTERMS(NO2,K131) = +K131*<XO2>*<NO3> - PTERMS(:,4,131) = +TPK%K131(:)*PCONC(:,42)*PCONC(:,5) -! -!PTERMS(NO3,K131) = -K131*<XO2>*<NO3> - PTERMS(:,5,131) = -TPK%K131(:)*PCONC(:,42)*PCONC(:,5) -! -!PTERMS(XO2,K131) = -K131*<XO2>*<NO3> - PTERMS(:,42,131) = -TPK%K131(:)*PCONC(:,42)*PCONC(:,5) -! -!PTERMS(SULF,K132) = -K132*<SULF> - PTERMS(:,13,132) = -TPK%K132(:)*PCONC(:,13) -! -!PTERMS(NO2,K133) = +K133*<DMS>*<NO3> - PTERMS(:,4,133) = +TPK%K133(:)*PCONC(:,11)*PCONC(:,5) -! -!PTERMS(NO3,K133) = -K133*<DMS>*<NO3> - PTERMS(:,5,133) = -TPK%K133(:)*PCONC(:,11)*PCONC(:,5) -! -!PTERMS(DMS,K133) = -K133*<DMS>*<NO3> - PTERMS(:,11,133) = -TPK%K133(:)*PCONC(:,11)*PCONC(:,5) -! -!PTERMS(SO2,K133) = +K133*<DMS>*<NO3> - PTERMS(:,12,133) = +TPK%K133(:)*PCONC(:,11)*PCONC(:,5) -! -!PTERMS(DMS,K134) = -K134*<DMS>*<O3P> - PTERMS(:,11,134) = -TPK%K134(:)*PCONC(:,11)*TPK%O3P(:) -! -!PTERMS(SO2,K134) = +K134*<DMS>*<O3P> - PTERMS(:,12,134) = +TPK%K134(:)*PCONC(:,11)*TPK%O3P(:) -! -!PTERMS(DMS,K135) = -K135*<DMS>*<OH> - PTERMS(:,11,135) = -TPK%K135(:)*PCONC(:,11)*PCONC(:,15) -! -!PTERMS(SO2,K135) = +0.8*K135*<DMS>*<OH> - PTERMS(:,12,135) = +0.8*TPK%K135(:)*PCONC(:,11)*PCONC(:,15) -! -!PTERMS(OH,K135) = -K135*<DMS>*<OH> - PTERMS(:,15,135) = -TPK%K135(:)*PCONC(:,11)*PCONC(:,15) -! -!PTERMS(O3,KTC1) = -KTC1*<O3> - PTERMS(:,1,136) = -TPK%KTC1(:)*PCONC(:,1) -! -!PTERMS(WC_O3,KTC1) = +KTC1*<O3> - PTERMS(:,43,136) = +TPK%KTC1(:)*PCONC(:,1) -! -!PTERMS(H2O2,KTC2) = -KTC2*<H2O2> - PTERMS(:,2,137) = -TPK%KTC2(:)*PCONC(:,2) -! -!PTERMS(WC_H2O2,KTC2) = +KTC2*<H2O2> - PTERMS(:,44,137) = +TPK%KTC2(:)*PCONC(:,2) -! -!PTERMS(NO,KTC3) = -KTC3*<NO> - PTERMS(:,3,138) = -TPK%KTC3(:)*PCONC(:,3) -! -! -RETURN -END SUBROUTINE SUBT30 -! -SUBROUTINE SUBT31 -! -!Indices 621 a 640 -! -!PTERMS(WC_NO,KTC3) = +KTC3*<NO> - PTERMS(:,45,138) = +TPK%KTC3(:)*PCONC(:,3) -! -!PTERMS(NO2,KTC4) = -KTC4*<NO2> - PTERMS(:,4,139) = -TPK%KTC4(:)*PCONC(:,4) -! -!PTERMS(WC_NO2,KTC4) = +KTC4*<NO2> - PTERMS(:,46,139) = +TPK%KTC4(:)*PCONC(:,4) -! -!PTERMS(NO3,KTC5) = -KTC5*<NO3> - PTERMS(:,5,140) = -TPK%KTC5(:)*PCONC(:,5) -! -!PTERMS(WC_NO3,KTC5) = +KTC5*<NO3> - PTERMS(:,47,140) = +TPK%KTC5(:)*PCONC(:,5) -! -!PTERMS(N2O5,KTC6) = -KTC6*<N2O5> - PTERMS(:,6,141) = -TPK%KTC6(:)*PCONC(:,6) -! -!PTERMS(WC_N2O5,KTC6) = +KTC6*<N2O5> - PTERMS(:,48,141) = +TPK%KTC6(:)*PCONC(:,6) -! -!PTERMS(HONO,KTC7) = -KTC7*<HONO> - PTERMS(:,7,142) = -TPK%KTC7(:)*PCONC(:,7) -! -!PTERMS(WC_HONO,KTC7) = +KTC7*<HONO> - PTERMS(:,49,142) = +TPK%KTC7(:)*PCONC(:,7) -! -!PTERMS(HNO3,KTC8) = -KTC8*<HNO3> - PTERMS(:,8,143) = -TPK%KTC8(:)*PCONC(:,8) -! -!PTERMS(WC_HNO3,KTC8) = +KTC8*<HNO3> - PTERMS(:,50,143) = +TPK%KTC8(:)*PCONC(:,8) -! -!PTERMS(HNO4,KTC9) = -KTC9*<HNO4> - PTERMS(:,9,144) = -TPK%KTC9(:)*PCONC(:,9) -! -!PTERMS(WC_HNO4,KTC9) = +KTC9*<HNO4> - PTERMS(:,51,144) = +TPK%KTC9(:)*PCONC(:,9) -! -!PTERMS(NH3,KTC10) = -KTC10*<NH3> - PTERMS(:,10,145) = -TPK%KTC10(:)*PCONC(:,10) -! -!PTERMS(WC_NH3,KTC10) = +KTC10*<NH3> - PTERMS(:,52,145) = +TPK%KTC10(:)*PCONC(:,10) -! -!PTERMS(OH,KTC11) = -KTC11*<OH> - PTERMS(:,15,146) = -TPK%KTC11(:)*PCONC(:,15) -! -!PTERMS(WC_OH,KTC11) = +KTC11*<OH> - PTERMS(:,53,146) = +TPK%KTC11(:)*PCONC(:,15) -! -!PTERMS(HO2,KTC12) = -KTC12*<HO2> - PTERMS(:,16,147) = -TPK%KTC12(:)*PCONC(:,16) -! -!PTERMS(WC_HO2,KTC12) = +KTC12*<HO2> - PTERMS(:,54,147) = +TPK%KTC12(:)*PCONC(:,16) -! -!PTERMS(WC_CO2,KTC13) = +KTC13*<CO2> - PTERMS(:,55,148) = +TPK%KTC13(:)*TPK%CO2(:) -! -! -RETURN -END SUBROUTINE SUBT31 -! -SUBROUTINE SUBT32 -! -!Indices 641 a 660 -! -!PTERMS(SO2,KTC14) = -KTC14*<SO2> - PTERMS(:,12,149) = -TPK%KTC14(:)*PCONC(:,12) -! -!PTERMS(WC_SO2,KTC14) = +KTC14*<SO2> - PTERMS(:,56,149) = +TPK%KTC14(:)*PCONC(:,12) -! -!PTERMS(SULF,KTC15) = -KTC15*<SULF> - PTERMS(:,13,150) = -TPK%KTC15(:)*PCONC(:,13) -! -!PTERMS(WC_SULF,KTC15) = +KTC15*<SULF> - PTERMS(:,57,150) = +TPK%KTC15(:)*PCONC(:,13) -! -!PTERMS(HCHO,KTC16) = -KTC16*<HCHO> - PTERMS(:,23,151) = -TPK%KTC16(:)*PCONC(:,23) -! -!PTERMS(WC_HCHO,KTC16) = +KTC16*<HCHO> - PTERMS(:,58,151) = +TPK%KTC16(:)*PCONC(:,23) -! -!PTERMS(ORA1,KTC17) = -KTC17*<ORA1> - PTERMS(:,31,152) = -TPK%KTC17(:)*PCONC(:,31) -! -!PTERMS(WC_ORA1,KTC17) = +KTC17*<ORA1> - PTERMS(:,59,152) = +TPK%KTC17(:)*PCONC(:,31) -! -!PTERMS(ORA2,KTC18) = -KTC18*<ORA2> - PTERMS(:,32,153) = -TPK%KTC18(:)*PCONC(:,32) -! -!PTERMS(WC_ORA2,KTC18) = +KTC18*<ORA2> - PTERMS(:,60,153) = +TPK%KTC18(:)*PCONC(:,32) -! -!PTERMS(MO2,KTC19) = -KTC19*<MO2> - PTERMS(:,33,154) = -TPK%KTC19(:)*PCONC(:,33) -! -!PTERMS(WC_MO2,KTC19) = +KTC19*<MO2> - PTERMS(:,61,154) = +TPK%KTC19(:)*PCONC(:,33) -! -!PTERMS(OP1,KTC20) = -KTC20*<OP1> - PTERMS(:,29,155) = -TPK%KTC20(:)*PCONC(:,29) -! -!PTERMS(WC_OP1,KTC20) = +KTC20*<OP1> - PTERMS(:,62,155) = +TPK%KTC20(:)*PCONC(:,29) -! -!PTERMS(O3,KTC21) = +KTC21*<WC_O3> - PTERMS(:,1,156) = +TPK%KTC21(:)*PCONC(:,43) -! -!PTERMS(WC_O3,KTC21) = -KTC21*<WC_O3> - PTERMS(:,43,156) = -TPK%KTC21(:)*PCONC(:,43) -! -!PTERMS(H2O2,KTC22) = +KTC22*<WC_H2O2> - PTERMS(:,2,157) = +TPK%KTC22(:)*PCONC(:,44) -! -!PTERMS(WC_H2O2,KTC22) = -KTC22*<WC_H2O2> - PTERMS(:,44,157) = -TPK%KTC22(:)*PCONC(:,44) -! -!PTERMS(NO,KTC23) = +KTC23*<WC_NO> - PTERMS(:,3,158) = +TPK%KTC23(:)*PCONC(:,45) -! -!PTERMS(WC_NO,KTC23) = -KTC23*<WC_NO> - PTERMS(:,45,158) = -TPK%KTC23(:)*PCONC(:,45) -! -! -RETURN -END SUBROUTINE SUBT32 -! -SUBROUTINE SUBT33 -! -!Indices 661 a 680 -! -!PTERMS(NO2,KTC24) = +KTC24*<WC_NO2> - PTERMS(:,4,159) = +TPK%KTC24(:)*PCONC(:,46) -! -!PTERMS(WC_NO2,KTC24) = -KTC24*<WC_NO2> - PTERMS(:,46,159) = -TPK%KTC24(:)*PCONC(:,46) -! -!PTERMS(NO3,KTC25) = +KTC25*<WC_NO3> - PTERMS(:,5,160) = +TPK%KTC25(:)*PCONC(:,47) -! -!PTERMS(WC_NO3,KTC25) = -KTC25*<WC_NO3> - PTERMS(:,47,160) = -TPK%KTC25(:)*PCONC(:,47) -! -!PTERMS(N2O5,KTC26) = +KTC26*<WC_N2O5> - PTERMS(:,6,161) = +TPK%KTC26(:)*PCONC(:,48) -! -!PTERMS(WC_N2O5,KTC26) = -KTC26*<WC_N2O5> - PTERMS(:,48,161) = -TPK%KTC26(:)*PCONC(:,48) -! -!PTERMS(HONO,KTC27) = +KTC27*<WC_HONO> - PTERMS(:,7,162) = +TPK%KTC27(:)*PCONC(:,49) -! -!PTERMS(WC_HONO,KTC27) = -KTC27*<WC_HONO> - PTERMS(:,49,162) = -TPK%KTC27(:)*PCONC(:,49) -! -!PTERMS(HNO3,KTC28) = +KTC28*<WC_HNO3> - PTERMS(:,8,163) = +TPK%KTC28(:)*PCONC(:,50) -! -!PTERMS(WC_HNO3,KTC28) = -KTC28*<WC_HNO3> - PTERMS(:,50,163) = -TPK%KTC28(:)*PCONC(:,50) -! -!PTERMS(HNO4,KTC29) = +KTC29*<WC_HNO4> - PTERMS(:,9,164) = +TPK%KTC29(:)*PCONC(:,51) -! -!PTERMS(WC_HNO4,KTC29) = -KTC29*<WC_HNO4> - PTERMS(:,51,164) = -TPK%KTC29(:)*PCONC(:,51) -! -!PTERMS(NH3,KTC30) = +KTC30*<WC_NH3> - PTERMS(:,10,165) = +TPK%KTC30(:)*PCONC(:,52) -! -!PTERMS(WC_NH3,KTC30) = -KTC30*<WC_NH3> - PTERMS(:,52,165) = -TPK%KTC30(:)*PCONC(:,52) -! -!PTERMS(OH,KTC31) = +KTC31*<WC_OH> - PTERMS(:,15,166) = +TPK%KTC31(:)*PCONC(:,53) -! -!PTERMS(WC_OH,KTC31) = -KTC31*<WC_OH> - PTERMS(:,53,166) = -TPK%KTC31(:)*PCONC(:,53) -! -!PTERMS(HO2,KTC32) = +KTC32*<WC_HO2> - PTERMS(:,16,167) = +TPK%KTC32(:)*PCONC(:,54) -! -!PTERMS(WC_HO2,KTC32) = -KTC32*<WC_HO2> - PTERMS(:,54,167) = -TPK%KTC32(:)*PCONC(:,54) -! -!PTERMS(WC_CO2,KTC33) = -KTC33*<WC_CO2> - PTERMS(:,55,168) = -TPK%KTC33(:)*PCONC(:,55) -! -!PTERMS(SO2,KTC34) = +KTC34*<WC_SO2> - PTERMS(:,12,169) = +TPK%KTC34(:)*PCONC(:,56) -! -! -RETURN -END SUBROUTINE SUBT33 -! -SUBROUTINE SUBT34 -! -!Indices 681 a 700 -! -!PTERMS(WC_SO2,KTC34) = -KTC34*<WC_SO2> - PTERMS(:,56,169) = -TPK%KTC34(:)*PCONC(:,56) -! -!PTERMS(SULF,KTC35) = +KTC35*<WC_SULF> - PTERMS(:,13,170) = +TPK%KTC35(:)*PCONC(:,57) -! -!PTERMS(WC_SULF,KTC35) = -KTC35*<WC_SULF> - PTERMS(:,57,170) = -TPK%KTC35(:)*PCONC(:,57) -! -!PTERMS(HCHO,KTC36) = +KTC36*<WC_HCHO> - PTERMS(:,23,171) = +TPK%KTC36(:)*PCONC(:,58) -! -!PTERMS(WC_HCHO,KTC36) = -KTC36*<WC_HCHO> - PTERMS(:,58,171) = -TPK%KTC36(:)*PCONC(:,58) -! -!PTERMS(ORA1,KTC37) = +KTC37*<WC_ORA1> - PTERMS(:,31,172) = +TPK%KTC37(:)*PCONC(:,59) -! -!PTERMS(WC_ORA1,KTC37) = -KTC37*<WC_ORA1> - PTERMS(:,59,172) = -TPK%KTC37(:)*PCONC(:,59) -! -!PTERMS(ORA2,KTC38) = +KTC38*<WC_ORA2> - PTERMS(:,32,173) = +TPK%KTC38(:)*PCONC(:,60) -! -!PTERMS(WC_ORA2,KTC38) = -KTC38*<WC_ORA2> - PTERMS(:,60,173) = -TPK%KTC38(:)*PCONC(:,60) -! -!PTERMS(MO2,KTC39) = +KTC39*<WC_MO2> - PTERMS(:,33,174) = +TPK%KTC39(:)*PCONC(:,61) -! -!PTERMS(WC_MO2,KTC39) = -KTC39*<WC_MO2> - PTERMS(:,61,174) = -TPK%KTC39(:)*PCONC(:,61) -! -!PTERMS(OP1,KTC40) = +KTC40*<WC_OP1> - PTERMS(:,29,175) = +TPK%KTC40(:)*PCONC(:,62) -! -!PTERMS(WC_OP1,KTC40) = -KTC40*<WC_OP1> - PTERMS(:,62,175) = -TPK%KTC40(:)*PCONC(:,62) -! -!PTERMS(O3,KTR1) = -KTR1*<O3> - PTERMS(:,1,176) = -TPK%KTR1(:)*PCONC(:,1) -! -!PTERMS(WR_O3,KTR1) = +KTR1*<O3> - PTERMS(:,68,176) = +TPK%KTR1(:)*PCONC(:,1) -! -!PTERMS(H2O2,KTR2) = -KTR2*<H2O2> - PTERMS(:,2,177) = -TPK%KTR2(:)*PCONC(:,2) -! -!PTERMS(WR_H2O2,KTR2) = +KTR2*<H2O2> - PTERMS(:,69,177) = +TPK%KTR2(:)*PCONC(:,2) -! -!PTERMS(NO,KTR3) = -KTR3*<NO> - PTERMS(:,3,178) = -TPK%KTR3(:)*PCONC(:,3) -! -!PTERMS(WR_NO,KTR3) = +KTR3*<NO> - PTERMS(:,70,178) = +TPK%KTR3(:)*PCONC(:,3) -! -!PTERMS(NO2,KTR4) = -KTR4*<NO2> - PTERMS(:,4,179) = -TPK%KTR4(:)*PCONC(:,4) -! -! -RETURN -END SUBROUTINE SUBT34 -! -SUBROUTINE SUBT35 -! -!Indices 701 a 720 -! -!PTERMS(WR_NO2,KTR4) = +KTR4*<NO2> - PTERMS(:,71,179) = +TPK%KTR4(:)*PCONC(:,4) -! -!PTERMS(NO3,KTR5) = -KTR5*<NO3> - PTERMS(:,5,180) = -TPK%KTR5(:)*PCONC(:,5) -! -!PTERMS(WR_NO3,KTR5) = +KTR5*<NO3> - PTERMS(:,72,180) = +TPK%KTR5(:)*PCONC(:,5) -! -!PTERMS(N2O5,KTR6) = -KTR6*<N2O5> - PTERMS(:,6,181) = -TPK%KTR6(:)*PCONC(:,6) -! -!PTERMS(WR_N2O5,KTR6) = +KTR6*<N2O5> - PTERMS(:,73,181) = +TPK%KTR6(:)*PCONC(:,6) -! -!PTERMS(HONO,KTR7) = -KTR7*<HONO> - PTERMS(:,7,182) = -TPK%KTR7(:)*PCONC(:,7) -! -!PTERMS(WR_HONO,KTR7) = +KTR7*<HONO> - PTERMS(:,74,182) = +TPK%KTR7(:)*PCONC(:,7) -! -!PTERMS(HNO3,KTR8) = -KTR8*<HNO3> - PTERMS(:,8,183) = -TPK%KTR8(:)*PCONC(:,8) -! -!PTERMS(WR_HNO3,KTR8) = +KTR8*<HNO3> - PTERMS(:,75,183) = +TPK%KTR8(:)*PCONC(:,8) -! -!PTERMS(HNO4,KTR9) = -KTR9*<HNO4> - PTERMS(:,9,184) = -TPK%KTR9(:)*PCONC(:,9) -! -!PTERMS(WR_HNO4,KTR9) = +KTR9*<HNO4> - PTERMS(:,76,184) = +TPK%KTR9(:)*PCONC(:,9) -! -!PTERMS(NH3,KTR10) = -KTR10*<NH3> - PTERMS(:,10,185) = -TPK%KTR10(:)*PCONC(:,10) -! -!PTERMS(WR_NH3,KTR10) = +KTR10*<NH3> - PTERMS(:,77,185) = +TPK%KTR10(:)*PCONC(:,10) -! -!PTERMS(OH,KTR11) = -KTR11*<OH> - PTERMS(:,15,186) = -TPK%KTR11(:)*PCONC(:,15) -! -!PTERMS(WR_OH,KTR11) = +KTR11*<OH> - PTERMS(:,78,186) = +TPK%KTR11(:)*PCONC(:,15) -! -!PTERMS(HO2,KTR12) = -KTR12*<HO2> - PTERMS(:,16,187) = -TPK%KTR12(:)*PCONC(:,16) -! -!PTERMS(WR_HO2,KTR12) = +KTR12*<HO2> - PTERMS(:,79,187) = +TPK%KTR12(:)*PCONC(:,16) -! -!PTERMS(WR_CO2,KTR13) = +KTR13*<CO2> - PTERMS(:,80,188) = +TPK%KTR13(:)*TPK%CO2(:) -! -!PTERMS(SO2,KTR14) = -KTR14*<SO2> - PTERMS(:,12,189) = -TPK%KTR14(:)*PCONC(:,12) -! -!PTERMS(WR_SO2,KTR14) = +KTR14*<SO2> - PTERMS(:,81,189) = +TPK%KTR14(:)*PCONC(:,12) -! -! -RETURN -END SUBROUTINE SUBT35 -! -SUBROUTINE SUBT36 -! -!Indices 721 a 740 -! -!PTERMS(SULF,KTR15) = -KTR15*<SULF> - PTERMS(:,13,190) = -TPK%KTR15(:)*PCONC(:,13) -! -!PTERMS(WR_SULF,KTR15) = +KTR15*<SULF> - PTERMS(:,82,190) = +TPK%KTR15(:)*PCONC(:,13) -! -!PTERMS(HCHO,KTR16) = -KTR16*<HCHO> - PTERMS(:,23,191) = -TPK%KTR16(:)*PCONC(:,23) -! -!PTERMS(WR_HCHO,KTR16) = +KTR16*<HCHO> - PTERMS(:,83,191) = +TPK%KTR16(:)*PCONC(:,23) -! -!PTERMS(ORA1,KTR17) = -KTR17*<ORA1> - PTERMS(:,31,192) = -TPK%KTR17(:)*PCONC(:,31) -! -!PTERMS(WR_ORA1,KTR17) = +KTR17*<ORA1> - PTERMS(:,84,192) = +TPK%KTR17(:)*PCONC(:,31) -! -!PTERMS(ORA2,KTR18) = -KTR18*<ORA2> - PTERMS(:,32,193) = -TPK%KTR18(:)*PCONC(:,32) -! -!PTERMS(WR_ORA2,KTR18) = +KTR18*<ORA2> - PTERMS(:,85,193) = +TPK%KTR18(:)*PCONC(:,32) -! -!PTERMS(MO2,KTR19) = -KTR19*<MO2> - PTERMS(:,33,194) = -TPK%KTR19(:)*PCONC(:,33) -! -!PTERMS(WR_MO2,KTR19) = +KTR19*<MO2> - PTERMS(:,86,194) = +TPK%KTR19(:)*PCONC(:,33) -! -!PTERMS(OP1,KTR20) = -KTR20*<OP1> - PTERMS(:,29,195) = -TPK%KTR20(:)*PCONC(:,29) -! -!PTERMS(WR_OP1,KTR20) = +KTR20*<OP1> - PTERMS(:,87,195) = +TPK%KTR20(:)*PCONC(:,29) -! -!PTERMS(O3,KTR21) = +KTR21*<WR_O3> - PTERMS(:,1,196) = +TPK%KTR21(:)*PCONC(:,68) -! -!PTERMS(WR_O3,KTR21) = -KTR21*<WR_O3> - PTERMS(:,68,196) = -TPK%KTR21(:)*PCONC(:,68) -! -!PTERMS(H2O2,KTR22) = +KTR22*<WR_H2O2> - PTERMS(:,2,197) = +TPK%KTR22(:)*PCONC(:,69) -! -!PTERMS(WR_H2O2,KTR22) = -KTR22*<WR_H2O2> - PTERMS(:,69,197) = -TPK%KTR22(:)*PCONC(:,69) -! -!PTERMS(NO,KTR23) = +KTR23*<WR_NO> - PTERMS(:,3,198) = +TPK%KTR23(:)*PCONC(:,70) -! -!PTERMS(WR_NO,KTR23) = -KTR23*<WR_NO> - PTERMS(:,70,198) = -TPK%KTR23(:)*PCONC(:,70) -! -!PTERMS(NO2,KTR24) = +KTR24*<WR_NO2> - PTERMS(:,4,199) = +TPK%KTR24(:)*PCONC(:,71) -! -!PTERMS(WR_NO2,KTR24) = -KTR24*<WR_NO2> - PTERMS(:,71,199) = -TPK%KTR24(:)*PCONC(:,71) -! -! -RETURN -END SUBROUTINE SUBT36 -! -SUBROUTINE SUBT37 -! -!Indices 741 a 760 -! -!PTERMS(NO3,KTR25) = +KTR25*<WR_NO3> - PTERMS(:,5,200) = +TPK%KTR25(:)*PCONC(:,72) -! -!PTERMS(WR_NO3,KTR25) = -KTR25*<WR_NO3> - PTERMS(:,72,200) = -TPK%KTR25(:)*PCONC(:,72) -! -!PTERMS(N2O5,KTR26) = +KTR26*<WR_N2O5> - PTERMS(:,6,201) = +TPK%KTR26(:)*PCONC(:,73) -! -!PTERMS(WR_N2O5,KTR26) = -KTR26*<WR_N2O5> - PTERMS(:,73,201) = -TPK%KTR26(:)*PCONC(:,73) -! -!PTERMS(HONO,KTR27) = +KTR27*<WR_HONO> - PTERMS(:,7,202) = +TPK%KTR27(:)*PCONC(:,74) -! -!PTERMS(WR_HONO,KTR27) = -KTR27*<WR_HONO> - PTERMS(:,74,202) = -TPK%KTR27(:)*PCONC(:,74) -! -!PTERMS(HNO3,KTR28) = +KTR28*<WR_HNO3> - PTERMS(:,8,203) = +TPK%KTR28(:)*PCONC(:,75) -! -!PTERMS(WR_HNO3,KTR28) = -KTR28*<WR_HNO3> - PTERMS(:,75,203) = -TPK%KTR28(:)*PCONC(:,75) -! -!PTERMS(HNO4,KTR29) = +KTR29*<WR_HNO4> - PTERMS(:,9,204) = +TPK%KTR29(:)*PCONC(:,76) -! -!PTERMS(WR_HNO4,KTR29) = -KTR29*<WR_HNO4> - PTERMS(:,76,204) = -TPK%KTR29(:)*PCONC(:,76) -! -!PTERMS(NH3,KTR30) = +KTR30*<WR_NH3> - PTERMS(:,10,205) = +TPK%KTR30(:)*PCONC(:,77) -! -!PTERMS(WR_NH3,KTR30) = -KTR30*<WR_NH3> - PTERMS(:,77,205) = -TPK%KTR30(:)*PCONC(:,77) -! -!PTERMS(OH,KTR31) = +KTR31*<WR_OH> - PTERMS(:,15,206) = +TPK%KTR31(:)*PCONC(:,78) -! -!PTERMS(WR_OH,KTR31) = -KTR31*<WR_OH> - PTERMS(:,78,206) = -TPK%KTR31(:)*PCONC(:,78) -! -!PTERMS(HO2,KTR32) = +KTR32*<WR_HO2> - PTERMS(:,16,207) = +TPK%KTR32(:)*PCONC(:,79) -! -!PTERMS(WR_HO2,KTR32) = -KTR32*<WR_HO2> - PTERMS(:,79,207) = -TPK%KTR32(:)*PCONC(:,79) -! -!PTERMS(WR_CO2,KTR33) = -KTR33*<WR_CO2> - PTERMS(:,80,208) = -TPK%KTR33(:)*PCONC(:,80) -! -!PTERMS(SO2,KTR34) = +KTR34*<WR_SO2> - PTERMS(:,12,209) = +TPK%KTR34(:)*PCONC(:,81) -! -!PTERMS(WR_SO2,KTR34) = -KTR34*<WR_SO2> - PTERMS(:,81,209) = -TPK%KTR34(:)*PCONC(:,81) -! -!PTERMS(SULF,KTR35) = +KTR35*<WR_SULF> - PTERMS(:,13,210) = +TPK%KTR35(:)*PCONC(:,82) -! -! -RETURN -END SUBROUTINE SUBT37 -! -SUBROUTINE SUBT38 -! -!Indices 761 a 780 -! -!PTERMS(WR_SULF,KTR35) = -KTR35*<WR_SULF> - PTERMS(:,82,210) = -TPK%KTR35(:)*PCONC(:,82) -! -!PTERMS(HCHO,KTR36) = +KTR36*<WR_HCHO> - PTERMS(:,23,211) = +TPK%KTR36(:)*PCONC(:,83) -! -!PTERMS(WR_HCHO,KTR36) = -KTR36*<WR_HCHO> - PTERMS(:,83,211) = -TPK%KTR36(:)*PCONC(:,83) -! -!PTERMS(ORA1,KTR37) = +KTR37*<WR_ORA1> - PTERMS(:,31,212) = +TPK%KTR37(:)*PCONC(:,84) -! -!PTERMS(WR_ORA1,KTR37) = -KTR37*<WR_ORA1> - PTERMS(:,84,212) = -TPK%KTR37(:)*PCONC(:,84) -! -!PTERMS(ORA2,KTR38) = +KTR38*<WR_ORA2> - PTERMS(:,32,213) = +TPK%KTR38(:)*PCONC(:,85) -! -!PTERMS(WR_ORA2,KTR38) = -KTR38*<WR_ORA2> - PTERMS(:,85,213) = -TPK%KTR38(:)*PCONC(:,85) -! -!PTERMS(MO2,KTR39) = +KTR39*<WR_MO2> - PTERMS(:,33,214) = +TPK%KTR39(:)*PCONC(:,86) -! -!PTERMS(WR_MO2,KTR39) = -KTR39*<WR_MO2> - PTERMS(:,86,214) = -TPK%KTR39(:)*PCONC(:,86) -! -!PTERMS(OP1,KTR40) = +KTR40*<WR_OP1> - PTERMS(:,29,215) = +TPK%KTR40(:)*PCONC(:,87) -! -!PTERMS(WR_OP1,KTR40) = -KTR40*<WR_OP1> - PTERMS(:,87,215) = -TPK%KTR40(:)*PCONC(:,87) -! -!PTERMS(WC_H2O2,KC1) = -KC1*<WC_H2O2> - PTERMS(:,44,216) = -TPK%KC1(:)*PCONC(:,44) -! -!PTERMS(WC_OH,KC1) = +KC1*<WC_H2O2> - PTERMS(:,53,216) = +TPK%KC1(:)*PCONC(:,44) -! -!PTERMS(WC_H2O2,KC2) = +KC2*<WC_OH>*<WC_OH> - PTERMS(:,44,217) = +TPK%KC2(:)*PCONC(:,53)*PCONC(:,53) -! -!PTERMS(WC_OH,KC2) = -KC2*<WC_OH>*<WC_OH> - PTERMS(:,53,217) = -TPK%KC2(:)*PCONC(:,53)*PCONC(:,53) -! -!PTERMS(WC_OH,KC3) = -KC3*<WC_OH>*<WC_HO2> - PTERMS(:,53,218) = -TPK%KC3(:)*PCONC(:,53)*PCONC(:,54) -! -!PTERMS(WC_HO2,KC3) = -KC3*<WC_OH>*<WC_HO2> - PTERMS(:,54,218) = -TPK%KC3(:)*PCONC(:,53)*PCONC(:,54) -! -!PTERMS(WC_H2O2,KC4) = -KC4*<WC_H2O2>*<WC_OH> - PTERMS(:,44,219) = -TPK%KC4(:)*PCONC(:,44)*PCONC(:,53) -! -!PTERMS(WC_OH,KC4) = -KC4*<WC_H2O2>*<WC_OH> - PTERMS(:,53,219) = -TPK%KC4(:)*PCONC(:,44)*PCONC(:,53) -! -!PTERMS(WC_HO2,KC4) = +KC4*<WC_H2O2>*<WC_OH> - PTERMS(:,54,219) = +TPK%KC4(:)*PCONC(:,44)*PCONC(:,53) -! -! -RETURN -END SUBROUTINE SUBT38 -! -SUBROUTINE SUBT39 -! -!Indices 781 a 800 -! -!PTERMS(WC_H2O2,KC5) = +KC5*<WC_HO2>*<WC_HO2> - PTERMS(:,44,220) = +TPK%KC5(:)*PCONC(:,54)*PCONC(:,54) -! -!PTERMS(WC_HO2,KC5) = -KC5*<WC_HO2>*<WC_HO2> - PTERMS(:,54,220) = -TPK%KC5(:)*PCONC(:,54)*PCONC(:,54) -! -!PTERMS(WC_O3,KC6) = -KC6*<WC_O3>*<WC_HO2> - PTERMS(:,43,221) = -TPK%KC6(:)*PCONC(:,43)*PCONC(:,54) -! -!PTERMS(WC_OH,KC6) = +KC6*<WC_O3>*<WC_HO2> - PTERMS(:,53,221) = +TPK%KC6(:)*PCONC(:,43)*PCONC(:,54) -! -!PTERMS(WC_HO2,KC6) = -KC6*<WC_O3>*<WC_HO2> - PTERMS(:,54,221) = -TPK%KC6(:)*PCONC(:,43)*PCONC(:,54) -! -!PTERMS(WC_OH,KC7) = -KC7*<WC_OH>*<WC_SO2> - PTERMS(:,53,222) = -TPK%KC7(:)*PCONC(:,53)*PCONC(:,56) -! -!PTERMS(WC_SO2,KC7) = -KC7*<WC_OH>*<WC_SO2> - PTERMS(:,56,222) = -TPK%KC7(:)*PCONC(:,53)*PCONC(:,56) -! -!PTERMS(WC_ASO3,KC7) = +KC7*<WC_OH>*<WC_SO2> - PTERMS(:,63,222) = +TPK%KC7(:)*PCONC(:,53)*PCONC(:,56) -! -!PTERMS(WC_NO2,KC8) = +KC8*<WC_HONO>*<WC_OH> - PTERMS(:,46,223) = +TPK%KC8(:)*PCONC(:,49)*PCONC(:,53) -! -!PTERMS(WC_HONO,KC8) = -KC8*<WC_HONO>*<WC_OH> - PTERMS(:,49,223) = -TPK%KC8(:)*PCONC(:,49)*PCONC(:,53) -! -!PTERMS(WC_OH,KC8) = -KC8*<WC_HONO>*<WC_OH> - PTERMS(:,53,223) = -TPK%KC8(:)*PCONC(:,49)*PCONC(:,53) -! -!PTERMS(WC_NO2,KC9) = -KC9*<WC_NO2>*<WC_HO2> - PTERMS(:,46,224) = -TPK%KC9(:)*PCONC(:,46)*PCONC(:,54) -! -!PTERMS(WC_HNO4,KC9) = +KC9*<WC_NO2>*<WC_HO2> - PTERMS(:,51,224) = +TPK%KC9(:)*PCONC(:,46)*PCONC(:,54) -! -!PTERMS(WC_HO2,KC9) = -KC9*<WC_NO2>*<WC_HO2> - PTERMS(:,54,224) = -TPK%KC9(:)*PCONC(:,46)*PCONC(:,54) -! -!PTERMS(WC_NO2,KC10) = +KC10*<WC_HNO4> - PTERMS(:,46,225) = +TPK%KC10(:)*PCONC(:,51) -! -!PTERMS(WC_HNO4,KC10) = -KC10*<WC_HNO4> - PTERMS(:,51,225) = -TPK%KC10(:)*PCONC(:,51) -! -!PTERMS(WC_HO2,KC10) = +KC10*<WC_HNO4> - PTERMS(:,54,225) = +TPK%KC10(:)*PCONC(:,51) -! -!PTERMS(WC_HONO,KC11) = +KC11*<WC_HNO4> - PTERMS(:,49,226) = +TPK%KC11(:)*PCONC(:,51) -! -!PTERMS(WC_HNO4,KC11) = -KC11*<WC_HNO4> - PTERMS(:,51,226) = -TPK%KC11(:)*PCONC(:,51) -! -!PTERMS(WC_HNO3,KC12) = +KC12*<WC_HNO4>*<WC_SO2> - PTERMS(:,50,227) = +TPK%KC12(:)*PCONC(:,51)*PCONC(:,56) -! -! -RETURN -END SUBROUTINE SUBT39 -! -SUBROUTINE SUBT40 -! -!Indices 801 a 820 -! -!PTERMS(WC_HNO4,KC12) = -KC12*<WC_HNO4>*<WC_SO2> - PTERMS(:,51,227) = -TPK%KC12(:)*PCONC(:,51)*PCONC(:,56) -! -!PTERMS(WC_SO2,KC12) = -KC12*<WC_HNO4>*<WC_SO2> - PTERMS(:,56,227) = -TPK%KC12(:)*PCONC(:,51)*PCONC(:,56) -! -!PTERMS(WC_SULF,KC12) = +KC12*<WC_HNO4>*<WC_SO2> - PTERMS(:,57,227) = +TPK%KC12(:)*PCONC(:,51)*PCONC(:,56) -! -!PTERMS(WC_NO2,KC13) = +KC13*<WC_HNO3> - PTERMS(:,46,228) = +TPK%KC13(:)*PCONC(:,50) -! -!PTERMS(WC_HNO3,KC13) = -KC13*<WC_HNO3> - PTERMS(:,50,228) = -TPK%KC13(:)*PCONC(:,50) -! -!PTERMS(WC_OH,KC13) = +KC13*<WC_HNO3> - PTERMS(:,53,228) = +TPK%KC13(:)*PCONC(:,50) -! -!PTERMS(WC_N2O5,KC14) = -KC14*<WC_N2O5> - PTERMS(:,48,229) = -TPK%KC14(:)*PCONC(:,48) -! -!PTERMS(WC_HNO3,KC14) = +KC14*<WC_N2O5> - PTERMS(:,50,229) = +TPK%KC14(:)*PCONC(:,48) -! -!PTERMS(WC_NO3,KC15) = -KC15*<WC_NO3>*<WC_SULF> - PTERMS(:,47,230) = -TPK%KC15(:)*PCONC(:,47)*PCONC(:,57) -! -!PTERMS(WC_HNO3,KC15) = +KC15*<WC_NO3>*<WC_SULF> - PTERMS(:,50,230) = +TPK%KC15(:)*PCONC(:,47)*PCONC(:,57) -! -!PTERMS(WC_SULF,KC15) = -KC15*<WC_NO3>*<WC_SULF> - PTERMS(:,57,230) = -TPK%KC15(:)*PCONC(:,47)*PCONC(:,57) -! -!PTERMS(WC_ASO4,KC15) = +KC15*<WC_NO3>*<WC_SULF> - PTERMS(:,64,230) = +TPK%KC15(:)*PCONC(:,47)*PCONC(:,57) -! -!PTERMS(WC_NO3,KC16) = -KC16*<WC_NO3>*<WC_SO2> - PTERMS(:,47,231) = -TPK%KC16(:)*PCONC(:,47)*PCONC(:,56) -! -!PTERMS(WC_HNO3,KC16) = +KC16*<WC_NO3>*<WC_SO2> - PTERMS(:,50,231) = +TPK%KC16(:)*PCONC(:,47)*PCONC(:,56) -! -!PTERMS(WC_SO2,KC16) = -KC16*<WC_NO3>*<WC_SO2> - PTERMS(:,56,231) = -TPK%KC16(:)*PCONC(:,47)*PCONC(:,56) -! -!PTERMS(WC_ASO3,KC16) = +KC16*<WC_NO3>*<WC_SO2> - PTERMS(:,63,231) = +TPK%KC16(:)*PCONC(:,47)*PCONC(:,56) -! -!PTERMS(WC_HO2,KC17) = +2.00*KC17*<WC_MO2>*<WC_MO2> - PTERMS(:,54,232) = +2.00*TPK%KC17(:)*PCONC(:,61)*PCONC(:,61) -! -!PTERMS(WC_HCHO,KC17) = +2.00*KC17*<WC_MO2>*<WC_MO2> - PTERMS(:,58,232) = +2.00*TPK%KC17(:)*PCONC(:,61)*PCONC(:,61) -! -!PTERMS(WC_MO2,KC17) = -KC17*<WC_MO2>*<WC_MO2> - PTERMS(:,61,232) = -TPK%KC17(:)*PCONC(:,61)*PCONC(:,61) -! -!PTERMS(WC_SO2,KC18) = -KC18*<WC_MO2>*<WC_SO2> - PTERMS(:,56,233) = -TPK%KC18(:)*PCONC(:,61)*PCONC(:,56) -! -! -RETURN -END SUBROUTINE SUBT40 -! -SUBROUTINE SUBT41 -! -!Indices 821 a 840 -! -!PTERMS(WC_MO2,KC18) = -KC18*<WC_MO2>*<WC_SO2> - PTERMS(:,61,233) = -TPK%KC18(:)*PCONC(:,61)*PCONC(:,56) -! -!PTERMS(WC_OP1,KC18) = +KC18*<WC_MO2>*<WC_SO2> - PTERMS(:,62,233) = +TPK%KC18(:)*PCONC(:,61)*PCONC(:,56) -! -!PTERMS(WC_ASO3,KC18) = +KC18*<WC_MO2>*<WC_SO2> - PTERMS(:,63,233) = +TPK%KC18(:)*PCONC(:,61)*PCONC(:,56) -! -!PTERMS(WC_OH,KC19) = -KC19*<WC_HCHO>*<WC_OH> - PTERMS(:,53,234) = -TPK%KC19(:)*PCONC(:,58)*PCONC(:,53) -! -!PTERMS(WC_HO2,KC19) = +KC19*<WC_HCHO>*<WC_OH> - PTERMS(:,54,234) = +TPK%KC19(:)*PCONC(:,58)*PCONC(:,53) -! -!PTERMS(WC_HCHO,KC19) = -KC19*<WC_HCHO>*<WC_OH> - PTERMS(:,58,234) = -TPK%KC19(:)*PCONC(:,58)*PCONC(:,53) -! -!PTERMS(WC_ORA1,KC19) = +KC19*<WC_HCHO>*<WC_OH> - PTERMS(:,59,234) = +TPK%KC19(:)*PCONC(:,58)*PCONC(:,53) -! -!PTERMS(WC_OH,KC20) = -KC20*<WC_ORA1>*<WC_OH> - PTERMS(:,53,235) = -TPK%KC20(:)*PCONC(:,59)*PCONC(:,53) -! -!PTERMS(WC_HO2,KC20) = +KC20*<WC_ORA1>*<WC_OH> - PTERMS(:,54,235) = +TPK%KC20(:)*PCONC(:,59)*PCONC(:,53) -! -!PTERMS(WC_CO2,KC20) = +KC20*<WC_ORA1>*<WC_OH> - PTERMS(:,55,235) = +TPK%KC20(:)*PCONC(:,59)*PCONC(:,53) -! -!PTERMS(WC_ORA1,KC20) = -KC20*<WC_ORA1>*<WC_OH> - PTERMS(:,59,235) = -TPK%KC20(:)*PCONC(:,59)*PCONC(:,53) -! -!PTERMS(WC_SO2,KC21) = -KC21*<WC_SO2>*<WC_HCHO> - PTERMS(:,56,236) = -TPK%KC21(:)*PCONC(:,56)*PCONC(:,58) -! -!PTERMS(WC_HCHO,KC21) = -KC21*<WC_SO2>*<WC_HCHO> - PTERMS(:,58,236) = -TPK%KC21(:)*PCONC(:,56)*PCONC(:,58) -! -!PTERMS(WC_AHMS,KC21) = +KC21*<WC_SO2>*<WC_HCHO> - PTERMS(:,67,236) = +TPK%KC21(:)*PCONC(:,56)*PCONC(:,58) -! -!PTERMS(WC_SO2,KC22) = +KC22*<WC_AHMS> - PTERMS(:,56,237) = +TPK%KC22(:)*PCONC(:,67) -! -!PTERMS(WC_HCHO,KC22) = +KC22*<WC_AHMS> - PTERMS(:,58,237) = +TPK%KC22(:)*PCONC(:,67) -! -!PTERMS(WC_AHMS,KC22) = -KC22*<WC_AHMS> - PTERMS(:,67,237) = -TPK%KC22(:)*PCONC(:,67) -! -!PTERMS(WC_OH,KC23) = -KC23*<WC_AHMS>*<WC_OH> - PTERMS(:,53,238) = -TPK%KC23(:)*PCONC(:,67)*PCONC(:,53) -! -!PTERMS(WC_HO2,KC23) = +KC23*<WC_AHMS>*<WC_OH> - PTERMS(:,54,238) = +TPK%KC23(:)*PCONC(:,67)*PCONC(:,53) -! -!PTERMS(WC_SO2,KC23) = +KC23*<WC_AHMS>*<WC_OH> - PTERMS(:,56,238) = +TPK%KC23(:)*PCONC(:,67)*PCONC(:,53) -! -! -RETURN -END SUBROUTINE SUBT41 -! -SUBROUTINE SUBT42 -! -!Indices 841 a 860 -! -!PTERMS(WC_ORA1,KC23) = +KC23*<WC_AHMS>*<WC_OH> - PTERMS(:,59,238) = +TPK%KC23(:)*PCONC(:,67)*PCONC(:,53) -! -!PTERMS(WC_AHMS,KC23) = -KC23*<WC_AHMS>*<WC_OH> - PTERMS(:,67,238) = -TPK%KC23(:)*PCONC(:,67)*PCONC(:,53) -! -!PTERMS(WC_ASO3,KC24) = -KC24*<WC_ASO3>*<W_O2> - PTERMS(:,63,239) = -TPK%KC24(:)*PCONC(:,63)*TPK%W_O2(:) -! -!PTERMS(WC_ASO5,KC24) = +KC24*<WC_ASO3>*<W_O2> - PTERMS(:,65,239) = +TPK%KC24(:)*PCONC(:,63)*TPK%W_O2(:) -! -!PTERMS(WC_HO2,KC25) = -KC25*<WC_ASO5>*<WC_HO2> - PTERMS(:,54,240) = -TPK%KC25(:)*PCONC(:,65)*PCONC(:,54) -! -!PTERMS(WC_ASO5,KC25) = -KC25*<WC_ASO5>*<WC_HO2> - PTERMS(:,65,240) = -TPK%KC25(:)*PCONC(:,65)*PCONC(:,54) -! -!PTERMS(WC_AHSO5,KC25) = +KC25*<WC_ASO5>*<WC_HO2> - PTERMS(:,66,240) = +TPK%KC25(:)*PCONC(:,65)*PCONC(:,54) -! -!PTERMS(WC_ASO4,KC26) = +KC26*<WC_ASO5>*<WC_ASO5> - PTERMS(:,64,241) = +TPK%KC26(:)*PCONC(:,65)*PCONC(:,65) -! -!PTERMS(WC_ASO5,KC26) = -KC26*<WC_ASO5>*<WC_ASO5> - PTERMS(:,65,241) = -TPK%KC26(:)*PCONC(:,65)*PCONC(:,65) -! -!PTERMS(WC_SO2,KC27) = -KC27*<WC_AHSO5>*<WC_SO2> - PTERMS(:,56,242) = -TPK%KC27(:)*PCONC(:,66)*PCONC(:,56) -! -!PTERMS(WC_SULF,KC27) = +2.00*KC27*<WC_AHSO5>*<WC_SO2> - PTERMS(:,57,242) = +2.00*TPK%KC27(:)*PCONC(:,66)*PCONC(:,56) -! -!PTERMS(WC_AHSO5,KC27) = -KC27*<WC_AHSO5>*<WC_SO2> - PTERMS(:,66,242) = -TPK%KC27(:)*PCONC(:,66)*PCONC(:,56) -! -!PTERMS(WC_OH,KC28) = +KC28*<WC_ASO4> - PTERMS(:,53,243) = +TPK%KC28(:)*PCONC(:,64) -! -!PTERMS(WC_SULF,KC28) = +KC28*<WC_ASO4> - PTERMS(:,57,243) = +TPK%KC28(:)*PCONC(:,64) -! -!PTERMS(WC_ASO4,KC28) = -KC28*<WC_ASO4> - PTERMS(:,64,243) = -TPK%KC28(:)*PCONC(:,64) -! -!PTERMS(WC_O3,KC29) = -KC29*<WC_SO2>*<WC_O3> - PTERMS(:,43,244) = -TPK%KC29(:)*PCONC(:,56)*PCONC(:,43) -! -!PTERMS(WC_SO2,KC29) = -KC29*<WC_SO2>*<WC_O3> - PTERMS(:,56,244) = -TPK%KC29(:)*PCONC(:,56)*PCONC(:,43) -! -!PTERMS(WC_SULF,KC29) = +KC29*<WC_SO2>*<WC_O3> - PTERMS(:,57,244) = +TPK%KC29(:)*PCONC(:,56)*PCONC(:,43) -! -!PTERMS(WC_H2O2,KC30) = -KC30*<WC_SO2>*<WC_H2O2> - PTERMS(:,44,245) = -TPK%KC30(:)*PCONC(:,56)*PCONC(:,44) -! -!PTERMS(WC_SO2,KC30) = -KC30*<WC_SO2>*<WC_H2O2> - PTERMS(:,56,245) = -TPK%KC30(:)*PCONC(:,56)*PCONC(:,44) -! -! -RETURN -END SUBROUTINE SUBT42 -! -SUBROUTINE SUBT43 -! -!Indices 861 a 880 -! -!PTERMS(WC_SULF,KC30) = +KC30*<WC_SO2>*<WC_H2O2> - PTERMS(:,57,245) = +TPK%KC30(:)*PCONC(:,56)*PCONC(:,44) -! -!PTERMS(WR_H2O2,KR1) = -KR1*<WR_H2O2> - PTERMS(:,69,246) = -TPK%KR1(:)*PCONC(:,69) -! -!PTERMS(WR_OH,KR1) = +KR1*<WR_H2O2> - PTERMS(:,78,246) = +TPK%KR1(:)*PCONC(:,69) -! -!PTERMS(WR_H2O2,KR2) = +KR2*<WR_OH>*<WR_OH> - PTERMS(:,69,247) = +TPK%KR2(:)*PCONC(:,78)*PCONC(:,78) -! -!PTERMS(WR_OH,KR2) = -KR2*<WR_OH>*<WR_OH> - PTERMS(:,78,247) = -TPK%KR2(:)*PCONC(:,78)*PCONC(:,78) -! -!PTERMS(WR_OH,KR3) = -KR3*<WR_OH>*<WR_HO2> - PTERMS(:,78,248) = -TPK%KR3(:)*PCONC(:,78)*PCONC(:,79) -! -!PTERMS(WR_HO2,KR3) = -KR3*<WR_OH>*<WR_HO2> - PTERMS(:,79,248) = -TPK%KR3(:)*PCONC(:,78)*PCONC(:,79) -! -!PTERMS(WR_H2O2,KR4) = -KR4*<WR_H2O2>*<WR_OH> - PTERMS(:,69,249) = -TPK%KR4(:)*PCONC(:,69)*PCONC(:,78) -! -!PTERMS(WR_OH,KR4) = -KR4*<WR_H2O2>*<WR_OH> - PTERMS(:,78,249) = -TPK%KR4(:)*PCONC(:,69)*PCONC(:,78) -! -!PTERMS(WR_HO2,KR4) = +KR4*<WR_H2O2>*<WR_OH> - PTERMS(:,79,249) = +TPK%KR4(:)*PCONC(:,69)*PCONC(:,78) -! -!PTERMS(WR_H2O2,KR5) = +KR5*<WR_HO2>*<WR_HO2> - PTERMS(:,69,250) = +TPK%KR5(:)*PCONC(:,79)*PCONC(:,79) -! -!PTERMS(WR_HO2,KR5) = -KR5*<WR_HO2>*<WR_HO2> - PTERMS(:,79,250) = -TPK%KR5(:)*PCONC(:,79)*PCONC(:,79) -! -!PTERMS(WR_O3,KR6) = -KR6*<WR_O3>*<WR_HO2> - PTERMS(:,68,251) = -TPK%KR6(:)*PCONC(:,68)*PCONC(:,79) -! -!PTERMS(WR_OH,KR6) = +KR6*<WR_O3>*<WR_HO2> - PTERMS(:,78,251) = +TPK%KR6(:)*PCONC(:,68)*PCONC(:,79) -! -!PTERMS(WR_HO2,KR6) = -KR6*<WR_O3>*<WR_HO2> - PTERMS(:,79,251) = -TPK%KR6(:)*PCONC(:,68)*PCONC(:,79) -! -!PTERMS(WR_OH,KR7) = -KR7*<WR_OH>*<WR_SO2> - PTERMS(:,78,252) = -TPK%KR7(:)*PCONC(:,78)*PCONC(:,81) -! -!PTERMS(WR_SO2,KR7) = -KR7*<WR_OH>*<WR_SO2> - PTERMS(:,81,252) = -TPK%KR7(:)*PCONC(:,78)*PCONC(:,81) -! -!PTERMS(WR_ASO3,KR7) = +KR7*<WR_OH>*<WR_SO2> - PTERMS(:,88,252) = +TPK%KR7(:)*PCONC(:,78)*PCONC(:,81) -! -!PTERMS(WR_NO2,KR8) = +KR8*<WR_HONO>*<WR_OH> - PTERMS(:,71,253) = +TPK%KR8(:)*PCONC(:,74)*PCONC(:,78) -! -!PTERMS(WR_HONO,KR8) = -KR8*<WR_HONO>*<WR_OH> - PTERMS(:,74,253) = -TPK%KR8(:)*PCONC(:,74)*PCONC(:,78) -! -! -RETURN -END SUBROUTINE SUBT43 -! -SUBROUTINE SUBT44 -! -!Indices 881 a 900 -! -!PTERMS(WR_OH,KR8) = -KR8*<WR_HONO>*<WR_OH> - PTERMS(:,78,253) = -TPK%KR8(:)*PCONC(:,74)*PCONC(:,78) -! -!PTERMS(WR_NO2,KR9) = -KR9*<WR_NO2>*<WR_HO2> - PTERMS(:,71,254) = -TPK%KR9(:)*PCONC(:,71)*PCONC(:,79) -! -!PTERMS(WR_HNO4,KR9) = +KR9*<WR_NO2>*<WR_HO2> - PTERMS(:,76,254) = +TPK%KR9(:)*PCONC(:,71)*PCONC(:,79) -! -!PTERMS(WR_HO2,KR9) = -KR9*<WR_NO2>*<WR_HO2> - PTERMS(:,79,254) = -TPK%KR9(:)*PCONC(:,71)*PCONC(:,79) -! -!PTERMS(WR_NO2,KR10) = +KR10*<WR_HNO4> - PTERMS(:,71,255) = +TPK%KR10(:)*PCONC(:,76) -! -!PTERMS(WR_HNO4,KR10) = -KR10*<WR_HNO4> - PTERMS(:,76,255) = -TPK%KR10(:)*PCONC(:,76) -! -!PTERMS(WR_HO2,KR10) = +KR10*<WR_HNO4> - PTERMS(:,79,255) = +TPK%KR10(:)*PCONC(:,76) -! -!PTERMS(WR_HONO,KR11) = +KR11*<WR_HNO4> - PTERMS(:,74,256) = +TPK%KR11(:)*PCONC(:,76) -! -!PTERMS(WR_HNO4,KR11) = -KR11*<WR_HNO4> - PTERMS(:,76,256) = -TPK%KR11(:)*PCONC(:,76) -! -!PTERMS(WR_HNO3,KR12) = +KR12*<WR_HNO4>*<WR_SO2> - PTERMS(:,75,257) = +TPK%KR12(:)*PCONC(:,76)*PCONC(:,81) -! -!PTERMS(WR_HNO4,KR12) = -KR12*<WR_HNO4>*<WR_SO2> - PTERMS(:,76,257) = -TPK%KR12(:)*PCONC(:,76)*PCONC(:,81) -! -!PTERMS(WR_SO2,KR12) = -KR12*<WR_HNO4>*<WR_SO2> - PTERMS(:,81,257) = -TPK%KR12(:)*PCONC(:,76)*PCONC(:,81) -! -!PTERMS(WR_SULF,KR12) = +KR12*<WR_HNO4>*<WR_SO2> - PTERMS(:,82,257) = +TPK%KR12(:)*PCONC(:,76)*PCONC(:,81) -! -!PTERMS(WR_NO2,KR13) = +KR13*<WR_HNO3> - PTERMS(:,71,258) = +TPK%KR13(:)*PCONC(:,75) -! -!PTERMS(WR_HNO3,KR13) = -KR13*<WR_HNO3> - PTERMS(:,75,258) = -TPK%KR13(:)*PCONC(:,75) -! -!PTERMS(WR_OH,KR13) = +KR13*<WR_HNO3> - PTERMS(:,78,258) = +TPK%KR13(:)*PCONC(:,75) -! -!PTERMS(WR_N2O5,KR14) = -KR14*<WR_N2O5> - PTERMS(:,73,259) = -TPK%KR14(:)*PCONC(:,73) -! -!PTERMS(WR_HNO3,KR14) = +KR14*<WR_N2O5> - PTERMS(:,75,259) = +TPK%KR14(:)*PCONC(:,73) -! -!PTERMS(WR_NO3,KR15) = -KR15*<WR_NO3>*<WR_SULF> - PTERMS(:,72,260) = -TPK%KR15(:)*PCONC(:,72)*PCONC(:,82) -! -!PTERMS(WR_HNO3,KR15) = +KR15*<WR_NO3>*<WR_SULF> - PTERMS(:,75,260) = +TPK%KR15(:)*PCONC(:,72)*PCONC(:,82) -! -! -RETURN -END SUBROUTINE SUBT44 -! -SUBROUTINE SUBT45 -! -!Indices 901 a 920 -! -!PTERMS(WR_SULF,KR15) = -KR15*<WR_NO3>*<WR_SULF> - PTERMS(:,82,260) = -TPK%KR15(:)*PCONC(:,72)*PCONC(:,82) -! -!PTERMS(WR_ASO4,KR15) = +KR15*<WR_NO3>*<WR_SULF> - PTERMS(:,89,260) = +TPK%KR15(:)*PCONC(:,72)*PCONC(:,82) -! -!PTERMS(WR_NO3,KR16) = -KR16*<WR_NO3>*<WR_SO2> - PTERMS(:,72,261) = -TPK%KR16(:)*PCONC(:,72)*PCONC(:,81) -! -!PTERMS(WR_HNO3,KR16) = +KR16*<WR_NO3>*<WR_SO2> - PTERMS(:,75,261) = +TPK%KR16(:)*PCONC(:,72)*PCONC(:,81) -! -!PTERMS(WR_SO2,KR16) = -KR16*<WR_NO3>*<WR_SO2> - PTERMS(:,81,261) = -TPK%KR16(:)*PCONC(:,72)*PCONC(:,81) -! -!PTERMS(WR_ASO3,KR16) = +KR16*<WR_NO3>*<WR_SO2> - PTERMS(:,88,261) = +TPK%KR16(:)*PCONC(:,72)*PCONC(:,81) -! -!PTERMS(WR_HO2,KR17) = +2.00*KR17*<WR_MO2>*<WR_MO2> - PTERMS(:,79,262) = +2.00*TPK%KR17(:)*PCONC(:,86)*PCONC(:,86) -! -!PTERMS(WR_HCHO,KR17) = +2.00*KR17*<WR_MO2>*<WR_MO2> - PTERMS(:,83,262) = +2.00*TPK%KR17(:)*PCONC(:,86)*PCONC(:,86) -! -!PTERMS(WR_MO2,KR17) = -KR17*<WR_MO2>*<WR_MO2> - PTERMS(:,86,262) = -TPK%KR17(:)*PCONC(:,86)*PCONC(:,86) -! -!PTERMS(WR_SO2,KR18) = -KR18*<WR_MO2>*<WR_SO2> - PTERMS(:,81,263) = -TPK%KR18(:)*PCONC(:,86)*PCONC(:,81) -! -!PTERMS(WR_MO2,KR18) = -KR18*<WR_MO2>*<WR_SO2> - PTERMS(:,86,263) = -TPK%KR18(:)*PCONC(:,86)*PCONC(:,81) -! -!PTERMS(WR_OP1,KR18) = +KR18*<WR_MO2>*<WR_SO2> - PTERMS(:,87,263) = +TPK%KR18(:)*PCONC(:,86)*PCONC(:,81) -! -!PTERMS(WR_ASO3,KR18) = +KR18*<WR_MO2>*<WR_SO2> - PTERMS(:,88,263) = +TPK%KR18(:)*PCONC(:,86)*PCONC(:,81) -! -!PTERMS(WR_OH,KR19) = -KR19*<WR_HCHO>*<WR_OH> - PTERMS(:,78,264) = -TPK%KR19(:)*PCONC(:,83)*PCONC(:,78) -! -!PTERMS(WR_HO2,KR19) = +KR19*<WR_HCHO>*<WR_OH> - PTERMS(:,79,264) = +TPK%KR19(:)*PCONC(:,83)*PCONC(:,78) -! -!PTERMS(WR_HCHO,KR19) = -KR19*<WR_HCHO>*<WR_OH> - PTERMS(:,83,264) = -TPK%KR19(:)*PCONC(:,83)*PCONC(:,78) -! -!PTERMS(WR_ORA1,KR19) = +KR19*<WR_HCHO>*<WR_OH> - PTERMS(:,84,264) = +TPK%KR19(:)*PCONC(:,83)*PCONC(:,78) -! -!PTERMS(WR_OH,KR20) = -KR20*<WR_ORA1>*<WR_OH> - PTERMS(:,78,265) = -TPK%KR20(:)*PCONC(:,84)*PCONC(:,78) -! -!PTERMS(WR_HO2,KR20) = +KR20*<WR_ORA1>*<WR_OH> - PTERMS(:,79,265) = +TPK%KR20(:)*PCONC(:,84)*PCONC(:,78) -! -!PTERMS(WR_CO2,KR20) = +KR20*<WR_ORA1>*<WR_OH> - PTERMS(:,80,265) = +TPK%KR20(:)*PCONC(:,84)*PCONC(:,78) -! -! -RETURN -END SUBROUTINE SUBT45 -! -SUBROUTINE SUBT46 -! -!Indices 921 a 940 -! -!PTERMS(WR_ORA1,KR20) = -KR20*<WR_ORA1>*<WR_OH> - PTERMS(:,84,265) = -TPK%KR20(:)*PCONC(:,84)*PCONC(:,78) -! -!PTERMS(WR_SO2,KR21) = -KR21*<WR_SO2>*<WR_HCHO> - PTERMS(:,81,266) = -TPK%KR21(:)*PCONC(:,81)*PCONC(:,83) -! -!PTERMS(WR_HCHO,KR21) = -KR21*<WR_SO2>*<WR_HCHO> - PTERMS(:,83,266) = -TPK%KR21(:)*PCONC(:,81)*PCONC(:,83) -! -!PTERMS(WR_AHMS,KR21) = +KR21*<WR_SO2>*<WR_HCHO> - PTERMS(:,92,266) = +TPK%KR21(:)*PCONC(:,81)*PCONC(:,83) -! -!PTERMS(WR_SO2,KR22) = +KR22*<WR_AHMS> - PTERMS(:,81,267) = +TPK%KR22(:)*PCONC(:,92) -! -!PTERMS(WR_HCHO,KR22) = +KR22*<WR_AHMS> - PTERMS(:,83,267) = +TPK%KR22(:)*PCONC(:,92) -! -!PTERMS(WR_AHMS,KR22) = -KR22*<WR_AHMS> - PTERMS(:,92,267) = -TPK%KR22(:)*PCONC(:,92) -! -!PTERMS(WR_OH,KR23) = -KR23*<WR_AHMS>*<WR_OH> - PTERMS(:,78,268) = -TPK%KR23(:)*PCONC(:,92)*PCONC(:,78) -! -!PTERMS(WR_HO2,KR23) = +KR23*<WR_AHMS>*<WR_OH> - PTERMS(:,79,268) = +TPK%KR23(:)*PCONC(:,92)*PCONC(:,78) -! -!PTERMS(WR_SO2,KR23) = +KR23*<WR_AHMS>*<WR_OH> - PTERMS(:,81,268) = +TPK%KR23(:)*PCONC(:,92)*PCONC(:,78) -! -!PTERMS(WR_ORA1,KR23) = +KR23*<WR_AHMS>*<WR_OH> - PTERMS(:,84,268) = +TPK%KR23(:)*PCONC(:,92)*PCONC(:,78) -! -!PTERMS(WR_AHMS,KR23) = -KR23*<WR_AHMS>*<WR_OH> - PTERMS(:,92,268) = -TPK%KR23(:)*PCONC(:,92)*PCONC(:,78) -! -!PTERMS(WR_ASO3,KR24) = -KR24*<WR_ASO3>*<W_O2> - PTERMS(:,88,269) = -TPK%KR24(:)*PCONC(:,88)*TPK%W_O2(:) -! -!PTERMS(WR_ASO5,KR24) = +KR24*<WR_ASO3>*<W_O2> - PTERMS(:,90,269) = +TPK%KR24(:)*PCONC(:,88)*TPK%W_O2(:) -! -!PTERMS(WR_HO2,KR25) = -KR25*<WR_ASO5>*<WR_HO2> - PTERMS(:,79,270) = -TPK%KR25(:)*PCONC(:,90)*PCONC(:,79) -! -!PTERMS(WR_ASO5,KR25) = -KR25*<WR_ASO5>*<WR_HO2> - PTERMS(:,90,270) = -TPK%KR25(:)*PCONC(:,90)*PCONC(:,79) -! -!PTERMS(WR_AHSO5,KR25) = +KR25*<WR_ASO5>*<WR_HO2> - PTERMS(:,91,270) = +TPK%KR25(:)*PCONC(:,90)*PCONC(:,79) -! -!PTERMS(WR_ASO4,KR26) = +KR26*<WR_ASO5>*<WR_ASO5> - PTERMS(:,89,271) = +TPK%KR26(:)*PCONC(:,90)*PCONC(:,90) -! -!PTERMS(WR_ASO5,KR26) = -KR26*<WR_ASO5>*<WR_ASO5> - PTERMS(:,90,271) = -TPK%KR26(:)*PCONC(:,90)*PCONC(:,90) -! -!PTERMS(WR_SO2,KR27) = -KR27*<WR_AHSO5>*<WR_SO2> - PTERMS(:,81,272) = -TPK%KR27(:)*PCONC(:,91)*PCONC(:,81) -! -! -RETURN -END SUBROUTINE SUBT46 -! -SUBROUTINE SUBT47 -! -!Indices 941 a 951 -! -!PTERMS(WR_SULF,KR27) = +2.00*KR27*<WR_AHSO5>*<WR_SO2> - PTERMS(:,82,272) = +2.00*TPK%KR27(:)*PCONC(:,91)*PCONC(:,81) -! -!PTERMS(WR_AHSO5,KR27) = -KR27*<WR_AHSO5>*<WR_SO2> - PTERMS(:,91,272) = -TPK%KR27(:)*PCONC(:,91)*PCONC(:,81) -! -!PTERMS(WR_OH,KR28) = +KR28*<WR_ASO4> - PTERMS(:,78,273) = +TPK%KR28(:)*PCONC(:,89) -! -!PTERMS(WR_SULF,KR28) = +KR28*<WR_ASO4> - PTERMS(:,82,273) = +TPK%KR28(:)*PCONC(:,89) -! -!PTERMS(WR_ASO4,KR28) = -KR28*<WR_ASO4> - PTERMS(:,89,273) = -TPK%KR28(:)*PCONC(:,89) -! -!PTERMS(WR_O3,KR29) = -KR29*<WR_SO2>*<WR_O3> - PTERMS(:,68,274) = -TPK%KR29(:)*PCONC(:,81)*PCONC(:,68) -! -!PTERMS(WR_SO2,KR29) = -KR29*<WR_SO2>*<WR_O3> - PTERMS(:,81,274) = -TPK%KR29(:)*PCONC(:,81)*PCONC(:,68) -! -!PTERMS(WR_SULF,KR29) = +KR29*<WR_SO2>*<WR_O3> - PTERMS(:,82,274) = +TPK%KR29(:)*PCONC(:,81)*PCONC(:,68) -! -!PTERMS(WR_H2O2,KR30) = -KR30*<WR_SO2>*<WR_H2O2> - PTERMS(:,69,275) = -TPK%KR30(:)*PCONC(:,81)*PCONC(:,69) -! -!PTERMS(WR_SO2,KR30) = -KR30*<WR_SO2>*<WR_H2O2> - PTERMS(:,81,275) = -TPK%KR30(:)*PCONC(:,81)*PCONC(:,69) -! -!PTERMS(WR_SULF,KR30) = +KR30*<WR_SO2>*<WR_H2O2> - PTERMS(:,82,275) = +TPK%KR30(:)*PCONC(:,81)*PCONC(:,69) -! -! -RETURN -END SUBROUTINE SUBT47 -! -END SUBROUTINE CH_TERMS_AQ -! -!======================================================================== -! -!! #################### - MODULE MODI_CH_TERMS_GAZ -!! #################### -INTERFACE -SUBROUTINE CH_TERMS_GAZ(PTIME,PCONC,PTERMS,KMI,KVECNPT,KEQ,KREAC) -IMPLICIT NONE -REAL, INTENT(IN) :: PTIME -INTEGER, INTENT(IN) :: KVECNPT -INTEGER, INTENT(IN) :: KEQ, KREAC -REAL, INTENT(IN), DIMENSION(KVECNPT,KEQ) :: PCONC -REAL, INTENT(OUT), DIMENSION(KVECNPT,KEQ,KREAC):: PTERMS -INTEGER, INTENT(IN) :: KMI -END SUBROUTINE CH_TERMS_GAZ -END INTERFACE -END MODULE MODI_CH_TERMS_GAZ -! -!======================================================================== -! -!! -!! ###################### - SUBROUTINE CH_TERMS_GAZ(PTIME,PCONC,PTERMS,KMI,KVECNPT,KEQ,KREAC) -!! ###################### -!! This code has been created automatically by preprocessor m10, -!! version: 9.7, copyright 1995-1999 by Meteo France/Universite Paul Sabatier. -!! Please report all bugs to K. Suhre (Lab. d'Aerologie UPS/CNRS). -!! -!!*** *MODD_CH_TERMS* -!! -!! PURPOSE -!! ------- -! calculation of the contribution of each term in each reaction -!! -!!** METHOD -!! ------ -!! The contribution of reaction i to the evolution of species j -!! is returned in PTERMS. -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Karsten Suhre (LA) -!! -!! MODIFICATIONS -!! ------------- -!! Original 26/07/96 -!! Modified 05/05/98: Vectorization (Vincent Crassier & KS) -!! Modified 31/10/03: New interface for better MesoNH compilation (D. Gazen) -!! -!!---------------------------------------------------------------------- -!! -!! EXTERNAL -!! -------- -!! none -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -USE MODD_CH_M9_SCHEME -!! -!! EXPLICIT ARGUMENTS -!! ------------------ -IMPLICIT NONE -REAL, INTENT(IN) :: PTIME -INTEGER, INTENT(IN) :: KVECNPT -INTEGER, INTENT(IN) :: KEQ, KREAC -REAL, INTENT(IN), DIMENSION(KVECNPT,KEQ) :: PCONC -REAL, INTENT(OUT), DIMENSION(KVECNPT,KEQ,KREAC):: PTERMS -INTEGER, INTENT(IN) :: KMI -!! -TYPE(CCSTYPE), POINTER :: TPK -TPK=>TACCS(KMI) -! /BEGIN_CODE/ -TPK%O1D(:)=(TPK%K002(:)*PCONC(:,JP_O3))/(TPK%K020(:)*TPK%N2(:)+TPK%K021(:)*TPK%O2(:)+& - &TPK%K022(:)*TPK%H2O(:)) -TPK%O3P(:)=(TPK%K001(:)*PCONC(:,JP_NO2)+TPK%K003(:)*PCONC(:,JP_O3)+TPK%K008(:)*PCONC(:,JP_NO3)+& - &TPK%K020(:)*TPK%O1D(:)*TPK%N2(:)+TPK%K021(:)*TPK%O1D(:)*TPK%O2(:)+& - &0.00000*TPK%K079(:)*PCONC(:,JP_ALKE)*PCONC(:,JP_O3)+& - &0.09000*TPK%K080(:)*PCONC(:,JP_BIO)*PCONC(:,JP_O3))/& - &(TPK%K018(:)*TPK%O2(:)+TPK%K019(:)*PCONC(:,JP_O3)+TPK%K029(:)*PCONC(:,JP_NO)+& - &TPK%K030(:)*PCONC(:,JP_NO2)+TPK%K031(:)*PCONC(:,JP_NO2)+TPK%K054(:)*PCONC(:,JP_BIO)+& - &TPK%K055(:)*PCONC(:,JP_CARBO)+TPK%K134(:)*PCONC(:,JP_DMS)) -! /END_CODE/ -PTERMS(:,:,:) = 0.0 -CALL SUBT0 -CALL SUBT1 -CALL SUBT2 -CALL SUBT3 -CALL SUBT4 -CALL SUBT5 -CALL SUBT6 -CALL SUBT7 -CALL SUBT8 -CALL SUBT9 -CALL SUBT10 -CALL SUBT11 -CALL SUBT12 -CALL SUBT13 -CALL SUBT14 -CALL SUBT15 -CALL SUBT16 -CALL SUBT17 -CALL SUBT18 -CALL SUBT19 -CALL SUBT20 -CALL SUBT21 -CALL SUBT22 -CALL SUBT23 -CALL SUBT24 -CALL SUBT25 -CALL SUBT26 -CALL SUBT27 -CALL SUBT28 -CALL SUBT29 -CALL SUBT30 -! - -CONTAINS - -SUBROUTINE SUBT0 -! -!Indices 1 a 20 -! -!PTERMS(NO,K001) = +K001*<NO2> - PTERMS(:,3,1) = +TPK%K001(:)*PCONC(:,4) -! -!PTERMS(NO2,K001) = -K001*<NO2> - PTERMS(:,4,1) = -TPK%K001(:)*PCONC(:,4) -! -!PTERMS(O3,K002) = -K002*<O3> - PTERMS(:,1,2) = -TPK%K002(:)*PCONC(:,1) -! -!PTERMS(O3,K003) = -K003*<O3> - PTERMS(:,1,3) = -TPK%K003(:)*PCONC(:,1) -! -!PTERMS(NO,K004) = +K004*<HONO> - PTERMS(:,3,4) = +TPK%K004(:)*PCONC(:,7) -! -!PTERMS(HONO,K004) = -K004*<HONO> - PTERMS(:,7,4) = -TPK%K004(:)*PCONC(:,7) -! -!PTERMS(OH,K004) = +K004*<HONO> - PTERMS(:,15,4) = +TPK%K004(:)*PCONC(:,7) -! -!PTERMS(NO2,K005) = +K005*<HNO3> - PTERMS(:,4,5) = +TPK%K005(:)*PCONC(:,8) -! -!PTERMS(HNO3,K005) = -K005*<HNO3> - PTERMS(:,8,5) = -TPK%K005(:)*PCONC(:,8) -! -!PTERMS(OH,K005) = +K005*<HNO3> - PTERMS(:,15,5) = +TPK%K005(:)*PCONC(:,8) -! -!PTERMS(NO2,K006) = +0.65*K006*<HNO4> - PTERMS(:,4,6) = +0.65*TPK%K006(:)*PCONC(:,9) -! -!PTERMS(NO3,K006) = +0.35*K006*<HNO4> - PTERMS(:,5,6) = +0.35*TPK%K006(:)*PCONC(:,9) -! -!PTERMS(HNO4,K006) = -K006*<HNO4> - PTERMS(:,9,6) = -TPK%K006(:)*PCONC(:,9) -! -!PTERMS(OH,K006) = +0.35*K006*<HNO4> - PTERMS(:,15,6) = +0.35*TPK%K006(:)*PCONC(:,9) -! -!PTERMS(HO2,K006) = +0.65*K006*<HNO4> - PTERMS(:,16,6) = +0.65*TPK%K006(:)*PCONC(:,9) -! -!PTERMS(NO,K007) = +K007*<NO3> - PTERMS(:,3,7) = +TPK%K007(:)*PCONC(:,5) -! -!PTERMS(NO3,K007) = -K007*<NO3> - PTERMS(:,5,7) = -TPK%K007(:)*PCONC(:,5) -! -!PTERMS(NO2,K008) = +K008*<NO3> - PTERMS(:,4,8) = +TPK%K008(:)*PCONC(:,5) -! -!PTERMS(NO3,K008) = -K008*<NO3> - PTERMS(:,5,8) = -TPK%K008(:)*PCONC(:,5) -! -!PTERMS(H2O2,K009) = -K009*<H2O2> - PTERMS(:,2,9) = -TPK%K009(:)*PCONC(:,2) -! -! -RETURN -END SUBROUTINE SUBT0 -! -SUBROUTINE SUBT1 -! -!Indices 21 a 40 -! -!PTERMS(OH,K009) = +K009*<H2O2> - PTERMS(:,15,9) = +TPK%K009(:)*PCONC(:,2) -! -!PTERMS(CO,K010) = +K010*<HCHO> - PTERMS(:,14,10) = +TPK%K010(:)*PCONC(:,23) -! -!PTERMS(HCHO,K010) = -K010*<HCHO> - PTERMS(:,23,10) = -TPK%K010(:)*PCONC(:,23) -! -!PTERMS(CO,K011) = +K011*<HCHO> - PTERMS(:,14,11) = +TPK%K011(:)*PCONC(:,23) -! -!PTERMS(HO2,K011) = +K011*<HCHO> - PTERMS(:,16,11) = +TPK%K011(:)*PCONC(:,23) -! -!PTERMS(HCHO,K011) = -K011*<HCHO> - PTERMS(:,23,11) = -TPK%K011(:)*PCONC(:,23) -! -!PTERMS(CO,K012) = +K012*<ALD> - PTERMS(:,14,12) = +TPK%K012(:)*PCONC(:,24) -! -!PTERMS(HO2,K012) = +K012*<ALD> - PTERMS(:,16,12) = +TPK%K012(:)*PCONC(:,24) -! -!PTERMS(ALD,K012) = -K012*<ALD> - PTERMS(:,24,12) = -TPK%K012(:)*PCONC(:,24) -! -!PTERMS(MO2,K012) = +K012*<ALD> - PTERMS(:,33,12) = +TPK%K012(:)*PCONC(:,24) -! -!PTERMS(OH,K013) = +K013*<OP1> - PTERMS(:,15,13) = +TPK%K013(:)*PCONC(:,29) -! -!PTERMS(HO2,K013) = +K013*<OP1> - PTERMS(:,16,13) = +TPK%K013(:)*PCONC(:,29) -! -!PTERMS(HCHO,K013) = +K013*<OP1> - PTERMS(:,23,13) = +TPK%K013(:)*PCONC(:,29) -! -!PTERMS(OP1,K013) = -K013*<OP1> - PTERMS(:,29,13) = -TPK%K013(:)*PCONC(:,29) -! -!PTERMS(OH,K014) = +K014*<OP2> - PTERMS(:,15,14) = +TPK%K014(:)*PCONC(:,30) -! -!PTERMS(HO2,K014) = +0.96205*K014*<OP2> - PTERMS(:,16,14) = +0.96205*TPK%K014(:)*PCONC(:,30) -! -!PTERMS(ALD,K014) = +0.96205*K014*<OP2> - PTERMS(:,24,14) = +0.96205*TPK%K014(:)*PCONC(:,30) -! -!PTERMS(OP2,K014) = -K014*<OP2> - PTERMS(:,30,14) = -TPK%K014(:)*PCONC(:,30) -! -!PTERMS(MO2,K014) = +0.03795*K014*<OP2> - PTERMS(:,33,14) = +0.03795*TPK%K014(:)*PCONC(:,30) -! -!PTERMS(KET,K015) = -K015*<KET> - PTERMS(:,25,15) = -TPK%K015(:)*PCONC(:,25) -! -! -RETURN -END SUBROUTINE SUBT1 -! -SUBROUTINE SUBT2 -! -!Indices 41 a 60 -! -!PTERMS(ALKAP,K015) = +1.00000*K015*<KET> - PTERMS(:,34,15) = +1.00000*TPK%K015(:)*PCONC(:,25) -! -!PTERMS(CARBOP,K015) = +1.00000*K015*<KET> - PTERMS(:,40,15) = +1.00000*TPK%K015(:)*PCONC(:,25) -! -!PTERMS(CO,K016) = +0.91924*K016*<CARBO> - PTERMS(:,14,16) = +0.91924*TPK%K016(:)*PCONC(:,26) -! -!PTERMS(HO2,K016) = +0.75830*K016*<CARBO> - PTERMS(:,16,16) = +0.75830*TPK%K016(:)*PCONC(:,26) -! -!PTERMS(HCHO,K016) = +0.06517*K016*<CARBO> - PTERMS(:,23,16) = +0.06517*TPK%K016(:)*PCONC(:,26) -! -!PTERMS(CARBO,K016) = -K016*<CARBO> - PTERMS(:,26,16) = -TPK%K016(:)*PCONC(:,26) -! -!PTERMS(CARBOP,K016) = +0.69622*K016*<CARBO> - PTERMS(:,40,16) = +0.69622*TPK%K016(:)*PCONC(:,26) -! -!PTERMS(NO2,K017) = +K017*<ONIT> - PTERMS(:,4,17) = +TPK%K017(:)*PCONC(:,27) -! -!PTERMS(HO2,K017) = +K017*<ONIT> - PTERMS(:,16,17) = +TPK%K017(:)*PCONC(:,27) -! -!PTERMS(ALD,K017) = +0.20*K017*<ONIT> - PTERMS(:,24,17) = +0.20*TPK%K017(:)*PCONC(:,27) -! -!PTERMS(KET,K017) = +0.80*K017*<ONIT> - PTERMS(:,25,17) = +0.80*TPK%K017(:)*PCONC(:,27) -! -!PTERMS(ONIT,K017) = -K017*<ONIT> - PTERMS(:,27,17) = -TPK%K017(:)*PCONC(:,27) -! -!PTERMS(O3,K018) = +K018*<O3P>*<O2> - PTERMS(:,1,18) = +TPK%K018(:)*TPK%O3P(:)*TPK%O2(:) -! -!PTERMS(O3,K019) = -K019*<O3P>*<O3> - PTERMS(:,1,19) = -TPK%K019(:)*TPK%O3P(:)*PCONC(:,1) -! -!PTERMS(OH,K022) = +K022*<O1D>*<H2O> - PTERMS(:,15,22) = +TPK%K022(:)*TPK%O1D(:)*TPK%H2O(:) -! -!PTERMS(O3,K023) = -K023*<O3>*<OH> - PTERMS(:,1,23) = -TPK%K023(:)*PCONC(:,1)*PCONC(:,15) -! -!PTERMS(OH,K023) = -K023*<O3>*<OH> - PTERMS(:,15,23) = -TPK%K023(:)*PCONC(:,1)*PCONC(:,15) -! -!PTERMS(HO2,K023) = +K023*<O3>*<OH> - PTERMS(:,16,23) = +TPK%K023(:)*PCONC(:,1)*PCONC(:,15) -! -!PTERMS(O3,K024) = -K024*<O3>*<HO2> - PTERMS(:,1,24) = -TPK%K024(:)*PCONC(:,1)*PCONC(:,16) -! -!PTERMS(OH,K024) = +K024*<O3>*<HO2> - PTERMS(:,15,24) = +TPK%K024(:)*PCONC(:,1)*PCONC(:,16) -! -! -RETURN -END SUBROUTINE SUBT2 -! -SUBROUTINE SUBT3 -! -!Indices 61 a 80 -! -!PTERMS(HO2,K024) = -K024*<O3>*<HO2> - PTERMS(:,16,24) = -TPK%K024(:)*PCONC(:,1)*PCONC(:,16) -! -!PTERMS(OH,K025) = -K025*<OH>*<HO2> - PTERMS(:,15,25) = -TPK%K025(:)*PCONC(:,15)*PCONC(:,16) -! -!PTERMS(HO2,K025) = -K025*<OH>*<HO2> - PTERMS(:,16,25) = -TPK%K025(:)*PCONC(:,15)*PCONC(:,16) -! -!PTERMS(H2O2,K026) = -K026*<H2O2>*<OH> - PTERMS(:,2,26) = -TPK%K026(:)*PCONC(:,2)*PCONC(:,15) -! -!PTERMS(OH,K026) = -K026*<H2O2>*<OH> - PTERMS(:,15,26) = -TPK%K026(:)*PCONC(:,2)*PCONC(:,15) -! -!PTERMS(HO2,K026) = +K026*<H2O2>*<OH> - PTERMS(:,16,26) = +TPK%K026(:)*PCONC(:,2)*PCONC(:,15) -! -!PTERMS(H2O2,K027) = +K027*<HO2>*<HO2> - PTERMS(:,2,27) = +TPK%K027(:)*PCONC(:,16)*PCONC(:,16) -! -!PTERMS(HO2,K027) = -K027*<HO2>*<HO2> - PTERMS(:,16,27) = -TPK%K027(:)*PCONC(:,16)*PCONC(:,16) -! -!PTERMS(H2O2,K028) = +K028*<HO2>*<HO2>*<H2O> - PTERMS(:,2,28) = +TPK%K028(:)*PCONC(:,16)*PCONC(:,16)*TPK%H2O(:) -! -!PTERMS(HO2,K028) = -K028*<HO2>*<HO2>*<H2O> - PTERMS(:,16,28) = -TPK%K028(:)*PCONC(:,16)*PCONC(:,16)*TPK%H2O(:) -! -!PTERMS(NO,K029) = -K029*<O3P>*<NO> - PTERMS(:,3,29) = -TPK%K029(:)*TPK%O3P(:)*PCONC(:,3) -! -!PTERMS(NO2,K029) = +K029*<O3P>*<NO> - PTERMS(:,4,29) = +TPK%K029(:)*TPK%O3P(:)*PCONC(:,3) -! -!PTERMS(NO,K030) = +K030*<O3P>*<NO2> - PTERMS(:,3,30) = +TPK%K030(:)*TPK%O3P(:)*PCONC(:,4) -! -!PTERMS(NO2,K030) = -K030*<O3P>*<NO2> - PTERMS(:,4,30) = -TPK%K030(:)*TPK%O3P(:)*PCONC(:,4) -! -!PTERMS(NO2,K031) = -K031*<O3P>*<NO2> - PTERMS(:,4,31) = -TPK%K031(:)*TPK%O3P(:)*PCONC(:,4) -! -!PTERMS(NO3,K031) = +K031*<O3P>*<NO2> - PTERMS(:,5,31) = +TPK%K031(:)*TPK%O3P(:)*PCONC(:,4) -! -!PTERMS(NO,K032) = -K032*<OH>*<NO> - PTERMS(:,3,32) = -TPK%K032(:)*PCONC(:,15)*PCONC(:,3) -! -!PTERMS(HONO,K032) = +K032*<OH>*<NO> - PTERMS(:,7,32) = +TPK%K032(:)*PCONC(:,15)*PCONC(:,3) -! -!PTERMS(OH,K032) = -K032*<OH>*<NO> - PTERMS(:,15,32) = -TPK%K032(:)*PCONC(:,15)*PCONC(:,3) -! -!PTERMS(NO2,K033) = -K033*<OH>*<NO2> - PTERMS(:,4,33) = -TPK%K033(:)*PCONC(:,15)*PCONC(:,4) -! -! -RETURN -END SUBROUTINE SUBT3 -! -SUBROUTINE SUBT4 -! -!Indices 81 a 100 -! -!PTERMS(HNO3,K033) = +K033*<OH>*<NO2> - PTERMS(:,8,33) = +TPK%K033(:)*PCONC(:,15)*PCONC(:,4) -! -!PTERMS(OH,K033) = -K033*<OH>*<NO2> - PTERMS(:,15,33) = -TPK%K033(:)*PCONC(:,15)*PCONC(:,4) -! -!PTERMS(NO2,K034) = +K034*<OH>*<NO3> - PTERMS(:,4,34) = +TPK%K034(:)*PCONC(:,15)*PCONC(:,5) -! -!PTERMS(NO3,K034) = -K034*<OH>*<NO3> - PTERMS(:,5,34) = -TPK%K034(:)*PCONC(:,15)*PCONC(:,5) -! -!PTERMS(OH,K034) = -K034*<OH>*<NO3> - PTERMS(:,15,34) = -TPK%K034(:)*PCONC(:,15)*PCONC(:,5) -! -!PTERMS(HO2,K034) = +K034*<OH>*<NO3> - PTERMS(:,16,34) = +TPK%K034(:)*PCONC(:,15)*PCONC(:,5) -! -!PTERMS(NO,K035) = -K035*<HO2>*<NO> - PTERMS(:,3,35) = -TPK%K035(:)*PCONC(:,16)*PCONC(:,3) -! -!PTERMS(NO2,K035) = +K035*<HO2>*<NO> - PTERMS(:,4,35) = +TPK%K035(:)*PCONC(:,16)*PCONC(:,3) -! -!PTERMS(OH,K035) = +K035*<HO2>*<NO> - PTERMS(:,15,35) = +TPK%K035(:)*PCONC(:,16)*PCONC(:,3) -! -!PTERMS(HO2,K035) = -K035*<HO2>*<NO> - PTERMS(:,16,35) = -TPK%K035(:)*PCONC(:,16)*PCONC(:,3) -! -!PTERMS(NO2,K036) = -K036*<HO2>*<NO2> - PTERMS(:,4,36) = -TPK%K036(:)*PCONC(:,16)*PCONC(:,4) -! -!PTERMS(HNO4,K036) = +K036*<HO2>*<NO2> - PTERMS(:,9,36) = +TPK%K036(:)*PCONC(:,16)*PCONC(:,4) -! -!PTERMS(HO2,K036) = -K036*<HO2>*<NO2> - PTERMS(:,16,36) = -TPK%K036(:)*PCONC(:,16)*PCONC(:,4) -! -!PTERMS(NO2,K037) = +K037*<HNO4> - PTERMS(:,4,37) = +TPK%K037(:)*PCONC(:,9) -! -!PTERMS(HNO4,K037) = -K037*<HNO4> - PTERMS(:,9,37) = -TPK%K037(:)*PCONC(:,9) -! -!PTERMS(HO2,K037) = +K037*<HNO4> - PTERMS(:,16,37) = +TPK%K037(:)*PCONC(:,9) -! -!PTERMS(NO2,K038) = +0.7*K038*<HO2>*<NO3> - PTERMS(:,4,38) = +0.7*TPK%K038(:)*PCONC(:,16)*PCONC(:,5) -! -!PTERMS(NO3,K038) = -K038*<HO2>*<NO3> - PTERMS(:,5,38) = -TPK%K038(:)*PCONC(:,16)*PCONC(:,5) -! -!PTERMS(HNO3,K038) = +0.3*K038*<HO2>*<NO3> - PTERMS(:,8,38) = +0.3*TPK%K038(:)*PCONC(:,16)*PCONC(:,5) -! -!PTERMS(OH,K038) = +0.7*K038*<HO2>*<NO3> - PTERMS(:,15,38) = +0.7*TPK%K038(:)*PCONC(:,16)*PCONC(:,5) -! -! -RETURN -END SUBROUTINE SUBT4 -! -SUBROUTINE SUBT5 -! -!Indices 101 a 120 -! -!PTERMS(HO2,K038) = -K038*<HO2>*<NO3> - PTERMS(:,16,38) = -TPK%K038(:)*PCONC(:,16)*PCONC(:,5) -! -!PTERMS(NO2,K039) = +K039*<OH>*<HONO> - PTERMS(:,4,39) = +TPK%K039(:)*PCONC(:,15)*PCONC(:,7) -! -!PTERMS(HONO,K039) = -K039*<OH>*<HONO> - PTERMS(:,7,39) = -TPK%K039(:)*PCONC(:,15)*PCONC(:,7) -! -!PTERMS(OH,K039) = -K039*<OH>*<HONO> - PTERMS(:,15,39) = -TPK%K039(:)*PCONC(:,15)*PCONC(:,7) -! -!PTERMS(NO3,K040) = +K040*<OH>*<HNO3> - PTERMS(:,5,40) = +TPK%K040(:)*PCONC(:,15)*PCONC(:,8) -! -!PTERMS(HNO3,K040) = -K040*<OH>*<HNO3> - PTERMS(:,8,40) = -TPK%K040(:)*PCONC(:,15)*PCONC(:,8) -! -!PTERMS(OH,K040) = -K040*<OH>*<HNO3> - PTERMS(:,15,40) = -TPK%K040(:)*PCONC(:,15)*PCONC(:,8) -! -!PTERMS(NO2,K041) = +K041*<OH>*<HNO4> - PTERMS(:,4,41) = +TPK%K041(:)*PCONC(:,15)*PCONC(:,9) -! -!PTERMS(HNO4,K041) = -K041*<OH>*<HNO4> - PTERMS(:,9,41) = -TPK%K041(:)*PCONC(:,15)*PCONC(:,9) -! -!PTERMS(OH,K041) = -K041*<OH>*<HNO4> - PTERMS(:,15,41) = -TPK%K041(:)*PCONC(:,15)*PCONC(:,9) -! -!PTERMS(O3,K042) = -K042*<O3>*<NO> - PTERMS(:,1,42) = -TPK%K042(:)*PCONC(:,1)*PCONC(:,3) -! -!PTERMS(NO,K042) = -K042*<O3>*<NO> - PTERMS(:,3,42) = -TPK%K042(:)*PCONC(:,1)*PCONC(:,3) -! -!PTERMS(NO2,K042) = +K042*<O3>*<NO> - PTERMS(:,4,42) = +TPK%K042(:)*PCONC(:,1)*PCONC(:,3) -! -!PTERMS(O3,K043) = -K043*<O3>*<NO2> - PTERMS(:,1,43) = -TPK%K043(:)*PCONC(:,1)*PCONC(:,4) -! -!PTERMS(NO2,K043) = -K043*<O3>*<NO2> - PTERMS(:,4,43) = -TPK%K043(:)*PCONC(:,1)*PCONC(:,4) -! -!PTERMS(NO3,K043) = +K043*<O3>*<NO2> - PTERMS(:,5,43) = +TPK%K043(:)*PCONC(:,1)*PCONC(:,4) -! -!PTERMS(NO,K044) = -K044*<NO>*<NO>*<O2> - PTERMS(:,3,44) = -TPK%K044(:)*PCONC(:,3)*PCONC(:,3)*TPK%O2(:) -! -!PTERMS(NO2,K044) = +K044*<NO>*<NO>*<O2> - PTERMS(:,4,44) = +TPK%K044(:)*PCONC(:,3)*PCONC(:,3)*TPK%O2(:) -! -!PTERMS(NO,K045) = -K045*<NO3>*<NO> - PTERMS(:,3,45) = -TPK%K045(:)*PCONC(:,5)*PCONC(:,3) -! -!PTERMS(NO2,K045) = +K045*<NO3>*<NO> - PTERMS(:,4,45) = +TPK%K045(:)*PCONC(:,5)*PCONC(:,3) -! -! -RETURN -END SUBROUTINE SUBT5 -! -SUBROUTINE SUBT6 -! -!Indices 121 a 140 -! -!PTERMS(NO3,K045) = -K045*<NO3>*<NO> - PTERMS(:,5,45) = -TPK%K045(:)*PCONC(:,5)*PCONC(:,3) -! -!PTERMS(NO,K046) = +K046*<NO3>*<NO2> - PTERMS(:,3,46) = +TPK%K046(:)*PCONC(:,5)*PCONC(:,4) -! -!PTERMS(NO2,K046) = -K046*<NO3>*<NO2> - PTERMS(:,4,46) = -TPK%K046(:)*PCONC(:,5)*PCONC(:,4) -! -!PTERMS(NO3,K046) = -K046*<NO3>*<NO2> - PTERMS(:,5,46) = -TPK%K046(:)*PCONC(:,5)*PCONC(:,4) -! -!PTERMS(NO2,K047) = -K047*<NO3>*<NO2> - PTERMS(:,4,47) = -TPK%K047(:)*PCONC(:,5)*PCONC(:,4) -! -!PTERMS(NO3,K047) = -K047*<NO3>*<NO2> - PTERMS(:,5,47) = -TPK%K047(:)*PCONC(:,5)*PCONC(:,4) -! -!PTERMS(N2O5,K047) = +K047*<NO3>*<NO2> - PTERMS(:,6,47) = +TPK%K047(:)*PCONC(:,5)*PCONC(:,4) -! -!PTERMS(NO2,K048) = +K048*<N2O5> - PTERMS(:,4,48) = +TPK%K048(:)*PCONC(:,6) -! -!PTERMS(NO3,K048) = +K048*<N2O5> - PTERMS(:,5,48) = +TPK%K048(:)*PCONC(:,6) -! -!PTERMS(N2O5,K048) = -K048*<N2O5> - PTERMS(:,6,48) = -TPK%K048(:)*PCONC(:,6) -! -!PTERMS(NO2,K049) = +K049*<NO3>*<NO3> - PTERMS(:,4,49) = +TPK%K049(:)*PCONC(:,5)*PCONC(:,5) -! -!PTERMS(NO3,K049) = -K049*<NO3>*<NO3> - PTERMS(:,5,49) = -TPK%K049(:)*PCONC(:,5)*PCONC(:,5) -! -!PTERMS(NH3,K050) = -K050*<NH3>*<OH> - PTERMS(:,10,50) = -TPK%K050(:)*PCONC(:,10)*PCONC(:,15) -! -!PTERMS(OH,K050) = -K050*<NH3>*<OH> - PTERMS(:,15,50) = -TPK%K050(:)*PCONC(:,10)*PCONC(:,15) -! -!PTERMS(OH,K051) = -K051*<OH>*<H2> - PTERMS(:,15,51) = -TPK%K051(:)*PCONC(:,15)*TPK%H2(:) -! -!PTERMS(HO2,K051) = +K051*<OH>*<H2> - PTERMS(:,16,51) = +TPK%K051(:)*PCONC(:,15)*TPK%H2(:) -! -!PTERMS(SO2,K052) = -K052*<OH>*<SO2> - PTERMS(:,12,52) = -TPK%K052(:)*PCONC(:,15)*PCONC(:,12) -! -!PTERMS(SULF,K052) = +K052*<OH>*<SO2> - PTERMS(:,13,52) = +TPK%K052(:)*PCONC(:,15)*PCONC(:,12) -! -!PTERMS(OH,K052) = -K052*<OH>*<SO2> - PTERMS(:,15,52) = -TPK%K052(:)*PCONC(:,15)*PCONC(:,12) -! -!PTERMS(HO2,K052) = +K052*<OH>*<SO2> - PTERMS(:,16,52) = +TPK%K052(:)*PCONC(:,15)*PCONC(:,12) -! -! -RETURN -END SUBROUTINE SUBT6 -! -SUBROUTINE SUBT7 -! -!Indices 141 a 160 -! -!PTERMS(CO,K053) = -K053*<CO>*<OH> - PTERMS(:,14,53) = -TPK%K053(:)*PCONC(:,14)*PCONC(:,15) -! -!PTERMS(OH,K053) = -K053*<CO>*<OH> - PTERMS(:,15,53) = -TPK%K053(:)*PCONC(:,14)*PCONC(:,15) -! -!PTERMS(HO2,K053) = +K053*<CO>*<OH> - PTERMS(:,16,53) = +TPK%K053(:)*PCONC(:,14)*PCONC(:,15) -! -!PTERMS(CO,K054) = +0.01*K054*<BIO>*<O3P> - PTERMS(:,14,54) = +0.01*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:) -! -!PTERMS(OH,K054) = +0.02*K054*<BIO>*<O3P> - PTERMS(:,15,54) = +0.02*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:) -! -!PTERMS(HO2,K054) = +0.28*K054*<BIO>*<O3P> - PTERMS(:,16,54) = +0.28*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:) -! -!PTERMS(ALKE,K054) = +0.91868*K054*<BIO>*<O3P> - PTERMS(:,20,54) = +0.91868*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:) -! -!PTERMS(BIO,K054) = -K054*<BIO>*<O3P> - PTERMS(:,21,54) = -TPK%K054(:)*PCONC(:,21)*TPK%O3P(:) -! -!PTERMS(HCHO,K054) = +0.05*K054*<BIO>*<O3P> - PTERMS(:,23,54) = +0.05*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:) -! -!PTERMS(CARBO,K054) = +0.13255*K054*<BIO>*<O3P> - PTERMS(:,26,54) = +0.13255*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:) -! -!PTERMS(XO2,K054) = +0.15*K054*<BIO>*<O3P> - PTERMS(:,42,54) = +0.15*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:) -! -!PTERMS(ALD,K055) = +K055*<CARBO>*<O3P> - PTERMS(:,24,55) = +TPK%K055(:)*PCONC(:,26)*TPK%O3P(:) -! -!PTERMS(CARBO,K055) = -K055*<CARBO>*<O3P> - PTERMS(:,26,55) = -TPK%K055(:)*PCONC(:,26)*TPK%O3P(:) -! -!PTERMS(OH,K056) = -K056*<CH4>*<OH> - PTERMS(:,15,56) = -TPK%K056(:)*PCONC(:,17)*PCONC(:,15) -! -!PTERMS(CH4,K056) = -K056*<CH4>*<OH> - PTERMS(:,17,56) = -TPK%K056(:)*PCONC(:,17)*PCONC(:,15) -! -!PTERMS(MO2,K056) = +K056*<CH4>*<OH> - PTERMS(:,33,56) = +TPK%K056(:)*PCONC(:,17)*PCONC(:,15) -! -!PTERMS(OH,K057) = -K057*<ETH>*<OH> - PTERMS(:,15,57) = -TPK%K057(:)*PCONC(:,18)*PCONC(:,15) -! -!PTERMS(ETH,K057) = -K057*<ETH>*<OH> - PTERMS(:,18,57) = -TPK%K057(:)*PCONC(:,18)*PCONC(:,15) -! -!PTERMS(ALKAP,K057) = +K057*<ETH>*<OH> - PTERMS(:,34,57) = +TPK%K057(:)*PCONC(:,18)*PCONC(:,15) -! -!PTERMS(CO,K058) = +0.00878*K058*<ALKA>*<OH> - PTERMS(:,14,58) = +0.00878*TPK%K058(:)*PCONC(:,19)*PCONC(:,15) -! -! -RETURN -END SUBROUTINE SUBT7 -! -SUBROUTINE SUBT8 -! -!Indices 161 a 180 -! -!PTERMS(OH,K058) = -K058*<ALKA>*<OH> - PTERMS(:,15,58) = -TPK%K058(:)*PCONC(:,19)*PCONC(:,15) -! -!PTERMS(HO2,K058) = +0.12793*K058*<ALKA>*<OH> - PTERMS(:,16,58) = +0.12793*TPK%K058(:)*PCONC(:,19)*PCONC(:,15) -! -!PTERMS(ALKA,K058) = -K058*<ALKA>*<OH> - PTERMS(:,19,58) = -TPK%K058(:)*PCONC(:,19)*PCONC(:,15) -! -!PTERMS(HCHO,K058) = +0.00140*K058*<ALKA>*<OH> - PTERMS(:,23,58) = +0.00140*TPK%K058(:)*PCONC(:,19)*PCONC(:,15) -! -!PTERMS(ALD,K058) = +0.08173*K058*<ALKA>*<OH> - PTERMS(:,24,58) = +0.08173*TPK%K058(:)*PCONC(:,19)*PCONC(:,15) -! -!PTERMS(KET,K058) = +0.03498*K058*<ALKA>*<OH> - PTERMS(:,25,58) = +0.03498*TPK%K058(:)*PCONC(:,19)*PCONC(:,15) -! -!PTERMS(CARBO,K058) = +0.00835*K058*<ALKA>*<OH> - PTERMS(:,26,58) = +0.00835*TPK%K058(:)*PCONC(:,19)*PCONC(:,15) -! -!PTERMS(ORA1,K058) = +0.00878*K058*<ALKA>*<OH> - PTERMS(:,31,58) = +0.00878*TPK%K058(:)*PCONC(:,19)*PCONC(:,15) -! -!PTERMS(ALKAP,K058) = +0.87811*K058*<ALKA>*<OH> - PTERMS(:,34,58) = +0.87811*TPK%K058(:)*PCONC(:,19)*PCONC(:,15) -! -!PTERMS(OH,K059) = -K059*<ALKE>*<OH> - PTERMS(:,15,59) = -TPK%K059(:)*PCONC(:,20)*PCONC(:,15) -! -!PTERMS(ALKE,K059) = -K059*<ALKE>*<OH> - PTERMS(:,20,59) = -TPK%K059(:)*PCONC(:,20)*PCONC(:,15) -! -!PTERMS(ALKEP,K059) = +1.02529*K059*<ALKE>*<OH> - PTERMS(:,35,59) = +1.02529*TPK%K059(:)*PCONC(:,20)*PCONC(:,15) -! -!PTERMS(BIOP,K059) = +0.00000*K059*<ALKE>*<OH> - PTERMS(:,36,59) = +0.00000*TPK%K059(:)*PCONC(:,20)*PCONC(:,15) -! -!PTERMS(OH,K060) = -K060*<BIO>*<OH> - PTERMS(:,15,60) = -TPK%K060(:)*PCONC(:,21)*PCONC(:,15) -! -!PTERMS(BIO,K060) = -K060*<BIO>*<OH> - PTERMS(:,21,60) = -TPK%K060(:)*PCONC(:,21)*PCONC(:,15) -! -!PTERMS(BIOP,K060) = +1.00000*K060*<BIO>*<OH> - PTERMS(:,36,60) = +1.00000*TPK%K060(:)*PCONC(:,21)*PCONC(:,15) -! -!PTERMS(OH,K061) = -K061*<ARO>*<OH> - PTERMS(:,15,61) = -TPK%K061(:)*PCONC(:,22)*PCONC(:,15) -! -!PTERMS(HO2,K061) = +0.10318*K061*<ARO>*<OH> - PTERMS(:,16,61) = +0.10318*TPK%K061(:)*PCONC(:,22)*PCONC(:,15) -! -!PTERMS(ARO,K061) = -K061*<ARO>*<OH> - PTERMS(:,22,61) = -TPK%K061(:)*PCONC(:,22)*PCONC(:,15) -! -!PTERMS(PHO,K061) = +0.00276*K061*<ARO>*<OH> - PTERMS(:,37,61) = +0.00276*TPK%K061(:)*PCONC(:,22)*PCONC(:,15) -! -! -RETURN -END SUBROUTINE SUBT8 -! -SUBROUTINE SUBT9 -! -!Indices 181 a 200 -! -!PTERMS(ADD,K061) = +0.93968*K061*<ARO>*<OH> - PTERMS(:,38,61) = +0.93968*TPK%K061(:)*PCONC(:,22)*PCONC(:,15) -! -!PTERMS(XO2,K061) = +0.10318*K061*<ARO>*<OH> - PTERMS(:,42,61) = +0.10318*TPK%K061(:)*PCONC(:,22)*PCONC(:,15) -! -!PTERMS(CO,K062) = +K062*<HCHO>*<OH> - PTERMS(:,14,62) = +TPK%K062(:)*PCONC(:,23)*PCONC(:,15) -! -!PTERMS(OH,K062) = -K062*<HCHO>*<OH> - PTERMS(:,15,62) = -TPK%K062(:)*PCONC(:,23)*PCONC(:,15) -! -!PTERMS(HO2,K062) = +K062*<HCHO>*<OH> - PTERMS(:,16,62) = +TPK%K062(:)*PCONC(:,23)*PCONC(:,15) -! -!PTERMS(HCHO,K062) = -K062*<HCHO>*<OH> - PTERMS(:,23,62) = -TPK%K062(:)*PCONC(:,23)*PCONC(:,15) -! -!PTERMS(OH,K063) = -K063*<ALD>*<OH> - PTERMS(:,15,63) = -TPK%K063(:)*PCONC(:,24)*PCONC(:,15) -! -!PTERMS(ALD,K063) = -K063*<ALD>*<OH> - PTERMS(:,24,63) = -TPK%K063(:)*PCONC(:,24)*PCONC(:,15) -! -!PTERMS(CARBOP,K063) = +1.00000*K063*<ALD>*<OH> - PTERMS(:,40,63) = +1.00000*TPK%K063(:)*PCONC(:,24)*PCONC(:,15) -! -!PTERMS(OH,K064) = -K064*<KET>*<OH> - PTERMS(:,15,64) = -TPK%K064(:)*PCONC(:,25)*PCONC(:,15) -! -!PTERMS(KET,K064) = -K064*<KET>*<OH> - PTERMS(:,25,64) = -TPK%K064(:)*PCONC(:,25)*PCONC(:,15) -! -!PTERMS(CARBOP,K064) = +1.00000*K064*<KET>*<OH> - PTERMS(:,40,64) = +1.00000*TPK%K064(:)*PCONC(:,25)*PCONC(:,15) -! -!PTERMS(CO,K065) = +1.01732*K065*<CARBO>*<OH> - PTERMS(:,14,65) = +1.01732*TPK%K065(:)*PCONC(:,26)*PCONC(:,15) -! -!PTERMS(OH,K065) = -K065*<CARBO>*<OH> - PTERMS(:,15,65) = -TPK%K065(:)*PCONC(:,26)*PCONC(:,15) -! -!PTERMS(HO2,K065) = +0.51208*K065*<CARBO>*<OH> - PTERMS(:,16,65) = +0.51208*TPK%K065(:)*PCONC(:,26)*PCONC(:,15) -! -!PTERMS(HCHO,K065) = +0.00000*K065*<CARBO>*<OH> - PTERMS(:,23,65) = +0.00000*TPK%K065(:)*PCONC(:,26)*PCONC(:,15) -! -!PTERMS(ALD,K065) = +0.06253*K065*<CARBO>*<OH> - PTERMS(:,24,65) = +0.06253*TPK%K065(:)*PCONC(:,26)*PCONC(:,15) -! -!PTERMS(KET,K065) = +0.00853*K065*<CARBO>*<OH> - PTERMS(:,25,65) = +0.00853*TPK%K065(:)*PCONC(:,26)*PCONC(:,15) -! -!PTERMS(CARBO,K065) = -K065*<CARBO>*<OH> - PTERMS(:,26,65) = -TPK%K065(:)*PCONC(:,26)*PCONC(:,15) -! -!PTERMS(CARBOP,K065) = +0.51419*K065*<CARBO>*<OH> - PTERMS(:,40,65) = +0.51419*TPK%K065(:)*PCONC(:,26)*PCONC(:,15) -! -! -RETURN -END SUBROUTINE SUBT9 -! -SUBROUTINE SUBT10 -! -!Indices 201 a 220 -! -!PTERMS(XO2,K065) = +0.10162*K065*<CARBO>*<OH> - PTERMS(:,42,65) = +0.10162*TPK%K065(:)*PCONC(:,26)*PCONC(:,15) -! -!PTERMS(OH,K066) = -K066*<ORA1>*<OH> - PTERMS(:,15,66) = -TPK%K066(:)*PCONC(:,31)*PCONC(:,15) -! -!PTERMS(HO2,K066) = +K066*<ORA1>*<OH> - PTERMS(:,16,66) = +TPK%K066(:)*PCONC(:,31)*PCONC(:,15) -! -!PTERMS(ORA1,K066) = -K066*<ORA1>*<OH> - PTERMS(:,31,66) = -TPK%K066(:)*PCONC(:,31)*PCONC(:,15) -! -!PTERMS(OH,K067) = -K067*<ORA2>*<OH> - PTERMS(:,15,67) = -TPK%K067(:)*PCONC(:,32)*PCONC(:,15) -! -!PTERMS(ORA2,K067) = -K067*<ORA2>*<OH> - PTERMS(:,32,67) = -TPK%K067(:)*PCONC(:,32)*PCONC(:,15) -! -!PTERMS(OH,K068) = -K068*<OP1>*<OH> - PTERMS(:,15,68) = -TPK%K068(:)*PCONC(:,29)*PCONC(:,15) -! -!PTERMS(HCHO,K068) = +0.35*K068*<OP1>*<OH> - PTERMS(:,23,68) = +0.35*TPK%K068(:)*PCONC(:,29)*PCONC(:,15) -! -!PTERMS(OP1,K068) = -K068*<OP1>*<OH> - PTERMS(:,29,68) = -TPK%K068(:)*PCONC(:,29)*PCONC(:,15) -! -!PTERMS(MO2,K068) = +0.65*K068*<OP1>*<OH> - PTERMS(:,33,68) = +0.65*TPK%K068(:)*PCONC(:,29)*PCONC(:,15) -! -!PTERMS(OH,K069) = -K069*<OP2>*<OH> - PTERMS(:,15,69) = -TPK%K069(:)*PCONC(:,30)*PCONC(:,15) -! -!PTERMS(HO2,K069) = +0.02915*K069*<OP2>*<OH> - PTERMS(:,16,69) = +0.02915*TPK%K069(:)*PCONC(:,30)*PCONC(:,15) -! -!PTERMS(HCHO,K069) = +0.02915*K069*<OP2>*<OH> - PTERMS(:,23,69) = +0.02915*TPK%K069(:)*PCONC(:,30)*PCONC(:,15) -! -!PTERMS(ALD,K069) = +0.07335*K069*<OP2>*<OH> - PTERMS(:,24,69) = +0.07335*TPK%K069(:)*PCONC(:,30)*PCONC(:,15) -! -!PTERMS(KET,K069) = +0.37591*K069*<OP2>*<OH> - PTERMS(:,25,69) = +0.37591*TPK%K069(:)*PCONC(:,30)*PCONC(:,15) -! -!PTERMS(OP2,K069) = -K069*<OP2>*<OH> - PTERMS(:,30,69) = -TPK%K069(:)*PCONC(:,30)*PCONC(:,15) -! -!PTERMS(ALKAP,K069) = +0.40341*K069*<OP2>*<OH> - PTERMS(:,34,69) = +0.40341*TPK%K069(:)*PCONC(:,30)*PCONC(:,15) -! -!PTERMS(CARBOP,K069) = +0.05413*K069*<OP2>*<OH> - PTERMS(:,40,69) = +0.05413*TPK%K069(:)*PCONC(:,30)*PCONC(:,15) -! -!PTERMS(XO2,K069) = +0.09333*K069*<OP2>*<OH> - PTERMS(:,42,69) = +0.09333*TPK%K069(:)*PCONC(:,30)*PCONC(:,15) -! -!PTERMS(NO3,K070) = +0.71893*K070*<PAN>*<OH> - PTERMS(:,5,70) = +0.71893*TPK%K070(:)*PCONC(:,28)*PCONC(:,15) -! -! -RETURN -END SUBROUTINE SUBT10 -! -SUBROUTINE SUBT11 -! -!Indices 221 a 240 -! -!PTERMS(OH,K070) = -K070*<PAN>*<OH> - PTERMS(:,15,70) = -TPK%K070(:)*PCONC(:,28)*PCONC(:,15) -! -!PTERMS(HO2,K070) = +0.28107*K070*<PAN>*<OH> - PTERMS(:,16,70) = +0.28107*TPK%K070(:)*PCONC(:,28)*PCONC(:,15) -! -!PTERMS(HCHO,K070) = +0.57839*K070*<PAN>*<OH> - PTERMS(:,23,70) = +0.57839*TPK%K070(:)*PCONC(:,28)*PCONC(:,15) -! -!PTERMS(CARBO,K070) = +0.21863*K070*<PAN>*<OH> - PTERMS(:,26,70) = +0.21863*TPK%K070(:)*PCONC(:,28)*PCONC(:,15) -! -!PTERMS(PAN,K070) = -K070*<PAN>*<OH> - PTERMS(:,28,70) = -TPK%K070(:)*PCONC(:,28)*PCONC(:,15) -! -!PTERMS(XO2,K070) = +K070*<PAN>*<OH> - PTERMS(:,42,70) = +TPK%K070(:)*PCONC(:,28)*PCONC(:,15) -! -!PTERMS(NO2,K071) = +K071*<ONIT>*<OH> - PTERMS(:,4,71) = +TPK%K071(:)*PCONC(:,27)*PCONC(:,15) -! -!PTERMS(OH,K071) = -K071*<ONIT>*<OH> - PTERMS(:,15,71) = -TPK%K071(:)*PCONC(:,27)*PCONC(:,15) -! -!PTERMS(ONIT,K071) = -K071*<ONIT>*<OH> - PTERMS(:,27,71) = -TPK%K071(:)*PCONC(:,27)*PCONC(:,15) -! -!PTERMS(ALKAP,K071) = +1.00000*K071*<ONIT>*<OH> - PTERMS(:,34,71) = +1.00000*TPK%K071(:)*PCONC(:,27)*PCONC(:,15) -! -!PTERMS(NO3,K072) = -K072*<HCHO>*<NO3> - PTERMS(:,5,72) = -TPK%K072(:)*PCONC(:,23)*PCONC(:,5) -! -!PTERMS(HNO3,K072) = +K072*<HCHO>*<NO3> - PTERMS(:,8,72) = +TPK%K072(:)*PCONC(:,23)*PCONC(:,5) -! -!PTERMS(CO,K072) = +K072*<HCHO>*<NO3> - PTERMS(:,14,72) = +TPK%K072(:)*PCONC(:,23)*PCONC(:,5) -! -!PTERMS(HO2,K072) = +K072*<HCHO>*<NO3> - PTERMS(:,16,72) = +TPK%K072(:)*PCONC(:,23)*PCONC(:,5) -! -!PTERMS(HCHO,K072) = -K072*<HCHO>*<NO3> - PTERMS(:,23,72) = -TPK%K072(:)*PCONC(:,23)*PCONC(:,5) -! -!PTERMS(NO3,K073) = -K073*<ALD>*<NO3> - PTERMS(:,5,73) = -TPK%K073(:)*PCONC(:,24)*PCONC(:,5) -! -!PTERMS(HNO3,K073) = +K073*<ALD>*<NO3> - PTERMS(:,8,73) = +TPK%K073(:)*PCONC(:,24)*PCONC(:,5) -! -!PTERMS(ALD,K073) = -K073*<ALD>*<NO3> - PTERMS(:,24,73) = -TPK%K073(:)*PCONC(:,24)*PCONC(:,5) -! -!PTERMS(CARBOP,K073) = +1.00000*K073*<ALD>*<NO3> - PTERMS(:,40,73) = +1.00000*TPK%K073(:)*PCONC(:,24)*PCONC(:,5) -! -!PTERMS(NO2,K074) = +0.10530*K074*<CARBO>*<NO3> - PTERMS(:,4,74) = +0.10530*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) -! -! -RETURN -END SUBROUTINE SUBT11 -! -SUBROUTINE SUBT12 -! -!Indices 241 a 260 -! -!PTERMS(NO3,K074) = -K074*<CARBO>*<NO3> - PTERMS(:,5,74) = -TPK%K074(:)*PCONC(:,26)*PCONC(:,5) -! -!PTERMS(HNO3,K074) = +0.91567*K074*<CARBO>*<NO3> - PTERMS(:,8,74) = +0.91567*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) -! -!PTERMS(CO,K074) = +1.33723*K074*<CARBO>*<NO3> - PTERMS(:,14,74) = +1.33723*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) -! -!PTERMS(HO2,K074) = +0.63217*K074*<CARBO>*<NO3> - PTERMS(:,16,74) = +0.63217*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) -! -!PTERMS(ALD,K074) = +0.05265*K074*<CARBO>*<NO3> - PTERMS(:,24,74) = +0.05265*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) -! -!PTERMS(KET,K074) = +0.00632*K074*<CARBO>*<NO3> - PTERMS(:,25,74) = +0.00632*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) -! -!PTERMS(CARBO,K074) = -K074*<CARBO>*<NO3> - PTERMS(:,26,74) = -TPK%K074(:)*PCONC(:,26)*PCONC(:,5) -! -!PTERMS(CARBOP,K074) = +0.38881*K074*<CARBO>*<NO3> - PTERMS(:,40,74) = +0.38881*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) -! -!PTERMS(OLN,K074) = +0.00000*K074*<CARBO>*<NO3> - PTERMS(:,41,74) = +0.00000*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) -! -!PTERMS(XO2,K074) = +0.10530*K074*<CARBO>*<NO3> - PTERMS(:,42,74) = +0.10530*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) -! -!PTERMS(NO3,K075) = -K075*<ARO>*<NO3> - PTERMS(:,5,75) = -TPK%K075(:)*PCONC(:,22)*PCONC(:,5) -! -!PTERMS(HNO3,K075) = +K075*<ARO>*<NO3> - PTERMS(:,8,75) = +TPK%K075(:)*PCONC(:,22)*PCONC(:,5) -! -!PTERMS(ARO,K075) = -K075*<ARO>*<NO3> - PTERMS(:,22,75) = -TPK%K075(:)*PCONC(:,22)*PCONC(:,5) -! -!PTERMS(PHO,K075) = +K075*<ARO>*<NO3> - PTERMS(:,37,75) = +TPK%K075(:)*PCONC(:,22)*PCONC(:,5) -! -!PTERMS(NO3,K076) = -K076*<ALKE>*<NO3> - PTERMS(:,5,76) = -TPK%K076(:)*PCONC(:,20)*PCONC(:,5) -! -!PTERMS(ALKE,K076) = -K076*<ALKE>*<NO3> - PTERMS(:,20,76) = -TPK%K076(:)*PCONC(:,20)*PCONC(:,5) -! -!PTERMS(CARBO,K076) = +0.00000*K076*<ALKE>*<NO3> - PTERMS(:,26,76) = +0.00000*TPK%K076(:)*PCONC(:,20)*PCONC(:,5) -! -!PTERMS(OLN,K076) = +0.93768*K076*<ALKE>*<NO3> - PTERMS(:,41,76) = +0.93768*TPK%K076(:)*PCONC(:,20)*PCONC(:,5) -! -!PTERMS(NO3,K077) = -K077*<BIO>*<NO3> - PTERMS(:,5,77) = -TPK%K077(:)*PCONC(:,21)*PCONC(:,5) -! -!PTERMS(BIO,K077) = -K077*<BIO>*<NO3> - PTERMS(:,21,77) = -TPK%K077(:)*PCONC(:,21)*PCONC(:,5) -! -! -RETURN -END SUBROUTINE SUBT12 -! -SUBROUTINE SUBT13 -! -!Indices 261 a 280 -! -!PTERMS(CARBO,K077) = +0.91741*K077*<BIO>*<NO3> - PTERMS(:,26,77) = +0.91741*TPK%K077(:)*PCONC(:,21)*PCONC(:,5) -! -!PTERMS(OLN,K077) = +1.00000*K077*<BIO>*<NO3> - PTERMS(:,41,77) = +1.00000*TPK%K077(:)*PCONC(:,21)*PCONC(:,5) -! -!PTERMS(NO2,K078) = +0.40*K078*<PAN>*<NO3> - PTERMS(:,4,78) = +0.40*TPK%K078(:)*PCONC(:,28)*PCONC(:,5) -! -!PTERMS(NO3,K078) = -K078*<PAN>*<NO3> - PTERMS(:,5,78) = -TPK%K078(:)*PCONC(:,28)*PCONC(:,5) -! -!PTERMS(HCHO,K078) = +0.40*K078*<PAN>*<NO3> - PTERMS(:,23,78) = +0.40*TPK%K078(:)*PCONC(:,28)*PCONC(:,5) -! -!PTERMS(ONIT,K078) = +0.60*K078*<PAN>*<NO3> - PTERMS(:,27,78) = +0.60*TPK%K078(:)*PCONC(:,28)*PCONC(:,5) -! -!PTERMS(PAN,K078) = -K078*<PAN>*<NO3> - PTERMS(:,28,78) = -TPK%K078(:)*PCONC(:,28)*PCONC(:,5) -! -!PTERMS(XO2,K078) = +K078*<PAN>*<NO3> - PTERMS(:,42,78) = +TPK%K078(:)*PCONC(:,28)*PCONC(:,5) -! -!PTERMS(O3,K079) = -K079*<ALKE>*<O3> - PTERMS(:,1,79) = -TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(H2O2,K079) = +0.01833*K079*<ALKE>*<O3> - PTERMS(:,2,79) = +0.01833*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(CO,K079) = +0.35120*K079*<ALKE>*<O3> - PTERMS(:,14,79) = +0.35120*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(OH,K079) = +0.39435*K079*<ALKE>*<O3> - PTERMS(:,15,79) = +0.39435*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(HO2,K079) = +0.23451*K079*<ALKE>*<O3> - PTERMS(:,16,79) = +0.23451*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(CH4,K079) = +0.04300*K079*<ALKE>*<O3> - PTERMS(:,17,79) = +0.04300*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(ETH,K079) = +0.03196*K079*<ALKE>*<O3> - PTERMS(:,18,79) = +0.03196*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(ALKE,K079) = -K079*<ALKE>*<O3> - PTERMS(:,20,79) = -TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(HCHO,K079) = +0.48290*K079*<ALKE>*<O3> - PTERMS(:,23,79) = +0.48290*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(ALD,K079) = +0.51468*K079*<ALKE>*<O3> - PTERMS(:,24,79) = +0.51468*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(KET,K079) = +0.07377*K079*<ALKE>*<O3> - PTERMS(:,25,79) = +0.07377*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(CARBO,K079) = +0.00000*K079*<ALKE>*<O3> - PTERMS(:,26,79) = +0.00000*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -! -RETURN -END SUBROUTINE SUBT13 -! -SUBROUTINE SUBT14 -! -!Indices 281 a 300 -! -!PTERMS(ORA1,K079) = +0.15343*K079*<ALKE>*<O3> - PTERMS(:,31,79) = +0.15343*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(ORA2,K079) = +0.08143*K079*<ALKE>*<O3> - PTERMS(:,32,79) = +0.08143*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(MO2,K079) = +0.13966*K079*<ALKE>*<O3> - PTERMS(:,33,79) = +0.13966*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(ALKAP,K079) = +0.09815*K079*<ALKE>*<O3> - PTERMS(:,34,79) = +0.09815*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(CARBOP,K079) = +0.05705*K079*<ALKE>*<O3> - PTERMS(:,40,79) = +0.05705*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(XO2,K079) = +0.00000*K079*<ALKE>*<O3> - PTERMS(:,42,79) = +0.00000*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) -! -!PTERMS(O3,K080) = -K080*<BIO>*<O3> - PTERMS(:,1,80) = -TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -!PTERMS(H2O2,K080) = +0.00100*K080*<BIO>*<O3> - PTERMS(:,2,80) = +0.00100*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -!PTERMS(CO,K080) = +0.36000*K080*<BIO>*<O3> - PTERMS(:,14,80) = +0.36000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -!PTERMS(OH,K080) = +0.28000*K080*<BIO>*<O3> - PTERMS(:,15,80) = +0.28000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -!PTERMS(HO2,K080) = +0.30000*K080*<BIO>*<O3> - PTERMS(:,16,80) = +0.30000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -!PTERMS(ALKE,K080) = +0.37388*K080*<BIO>*<O3> - PTERMS(:,20,80) = +0.37388*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -!PTERMS(BIO,K080) = -K080*<BIO>*<O3> - PTERMS(:,21,80) = -TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -!PTERMS(HCHO,K080) = +0.90000*K080*<BIO>*<O3> - PTERMS(:,23,80) = +0.90000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -!PTERMS(ALD,K080) = +0.00000*K080*<BIO>*<O3> - PTERMS(:,24,80) = +0.00000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -!PTERMS(KET,K080) = +0.00000*K080*<BIO>*<O3> - PTERMS(:,25,80) = +0.00000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -!PTERMS(CARBO,K080) = +0.39754*K080*<BIO>*<O3> - PTERMS(:,26,80) = +0.39754*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -!PTERMS(ORA1,K080) = +0.15000*K080*<BIO>*<O3> - PTERMS(:,31,80) = +0.15000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -!PTERMS(ORA2,K080) = +0.00000*K080*<BIO>*<O3> - PTERMS(:,32,80) = +0.00000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -!PTERMS(MO2,K080) = +0.03000*K080*<BIO>*<O3> - PTERMS(:,33,80) = +0.03000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -! -RETURN -END SUBROUTINE SUBT14 -! -SUBROUTINE SUBT15 -! -!Indices 301 a 320 -! -!PTERMS(ALKAP,K080) = +0.00000*K080*<BIO>*<O3> - PTERMS(:,34,80) = +0.00000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -!PTERMS(CARBOP,K080) = +0.17000*K080*<BIO>*<O3> - PTERMS(:,40,80) = +0.17000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -!PTERMS(XO2,K080) = +0.13000*K080*<BIO>*<O3> - PTERMS(:,42,80) = +0.13000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) -! -!PTERMS(O3,K081) = -K081*<CARBO>*<O3> - PTERMS(:,1,81) = -TPK%K081(:)*PCONC(:,26)*PCONC(:,1) -! -!PTERMS(CO,K081) = +0.64728*K081*<CARBO>*<O3> - PTERMS(:,14,81) = +0.64728*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) -! -!PTERMS(OH,K081) = +0.20595*K081*<CARBO>*<O3> - PTERMS(:,15,81) = +0.20595*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) -! -!PTERMS(HO2,K081) = +0.28441*K081*<CARBO>*<O3> - PTERMS(:,16,81) = +0.28441*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) -! -!PTERMS(HCHO,K081) = +0.00000*K081*<CARBO>*<O3> - PTERMS(:,23,81) = +0.00000*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) -! -!PTERMS(ALD,K081) = +0.15692*K081*<CARBO>*<O3> - PTERMS(:,24,81) = +0.15692*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) -! -!PTERMS(CARBO,K081) = -K081*<CARBO>*<O3> - PTERMS(:,26,81) = -TPK%K081(:)*PCONC(:,26)*PCONC(:,1) -! -!PTERMS(OP2,K081) = +0.10149*K081*<CARBO>*<O3> - PTERMS(:,30,81) = +0.10149*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) -! -!PTERMS(ORA1,K081) = +0.10788*K081*<CARBO>*<O3> - PTERMS(:,31,81) = +0.10788*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) -! -!PTERMS(ORA2,K081) = +0.20595*K081*<CARBO>*<O3> - PTERMS(:,32,81) = +0.20595*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) -! -!PTERMS(CARBOP,K081) = +0.27460*K081*<CARBO>*<O3> - PTERMS(:,40,81) = +0.27460*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) -! -!PTERMS(O3,K082) = -K082*<PAN>*<O3> - PTERMS(:,1,82) = -TPK%K082(:)*PCONC(:,28)*PCONC(:,1) -! -!PTERMS(NO2,K082) = +0.70*K082*<PAN>*<O3> - PTERMS(:,4,82) = +0.70*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) -! -!PTERMS(CO,K082) = +0.13*K082*<PAN>*<O3> - PTERMS(:,14,82) = +0.13*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) -! -!PTERMS(OH,K082) = +0.036*K082*<PAN>*<O3> - PTERMS(:,15,82) = +0.036*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) -! -!PTERMS(HO2,K082) = +0.08*K082*<PAN>*<O3> - PTERMS(:,16,82) = +0.08*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) -! -!PTERMS(HCHO,K082) = +0.70*K082*<PAN>*<O3> - PTERMS(:,23,82) = +0.70*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) -! -! -RETURN -END SUBROUTINE SUBT15 -! -SUBROUTINE SUBT16 -! -!Indices 321 a 340 -! -!PTERMS(PAN,K082) = -K082*<PAN>*<O3> - PTERMS(:,28,82) = -TPK%K082(:)*PCONC(:,28)*PCONC(:,1) -! -!PTERMS(ORA1,K082) = +0.11*K082*<PAN>*<O3> - PTERMS(:,31,82) = +0.11*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) -! -!PTERMS(CARBOP,K082) = +0.70000*K082*<PAN>*<O3> - PTERMS(:,40,82) = +0.70000*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) -! -!PTERMS(NO2,K083) = -K083*<PHO>*<NO2> - PTERMS(:,4,83) = -TPK%K083(:)*PCONC(:,37)*PCONC(:,4) -! -!PTERMS(ARO,K083) = +0.10670*K083*<PHO>*<NO2> - PTERMS(:,22,83) = +0.10670*TPK%K083(:)*PCONC(:,37)*PCONC(:,4) -! -!PTERMS(ONIT,K083) = +K083*<PHO>*<NO2> - PTERMS(:,27,83) = +TPK%K083(:)*PCONC(:,37)*PCONC(:,4) -! -!PTERMS(PHO,K083) = -K083*<PHO>*<NO2> - PTERMS(:,37,83) = -TPK%K083(:)*PCONC(:,37)*PCONC(:,4) -! -!PTERMS(HO2,K084) = -K084*<PHO>*<HO2> - PTERMS(:,16,84) = -TPK%K084(:)*PCONC(:,37)*PCONC(:,16) -! -!PTERMS(ARO,K084) = +1.06698*K084*<PHO>*<HO2> - PTERMS(:,22,84) = +1.06698*TPK%K084(:)*PCONC(:,37)*PCONC(:,16) -! -!PTERMS(PHO,K084) = -K084*<PHO>*<HO2> - PTERMS(:,37,84) = -TPK%K084(:)*PCONC(:,37)*PCONC(:,16) -! -!PTERMS(NO2,K085) = -K085*<ADD>*<NO2> - PTERMS(:,4,85) = -TPK%K085(:)*PCONC(:,38)*PCONC(:,4) -! -!PTERMS(HONO,K085) = +K085*<ADD>*<NO2> - PTERMS(:,7,85) = +TPK%K085(:)*PCONC(:,38)*PCONC(:,4) -! -!PTERMS(ARO,K085) = +K085*<ADD>*<NO2> - PTERMS(:,22,85) = +TPK%K085(:)*PCONC(:,38)*PCONC(:,4) -! -!PTERMS(ADD,K085) = -K085*<ADD>*<NO2> - PTERMS(:,38,85) = -TPK%K085(:)*PCONC(:,38)*PCONC(:,4) -! -!PTERMS(HO2,K086) = +0.02*K086*<ADD>*<O2> - PTERMS(:,16,86) = +0.02*TPK%K086(:)*PCONC(:,38)*TPK%O2(:) -! -!PTERMS(ARO,K086) = +0.02*K086*<ADD>*<O2> - PTERMS(:,22,86) = +0.02*TPK%K086(:)*PCONC(:,38)*TPK%O2(:) -! -!PTERMS(ADD,K086) = -K086*<ADD>*<O2> - PTERMS(:,38,86) = -TPK%K086(:)*PCONC(:,38)*TPK%O2(:) -! -!PTERMS(AROP,K086) = +0.98*K086*<ADD>*<O2> - PTERMS(:,39,86) = +0.98*TPK%K086(:)*PCONC(:,38)*TPK%O2(:) -! -!PTERMS(O3,K087) = -K087*<ADD>*<O3> - PTERMS(:,1,87) = -TPK%K087(:)*PCONC(:,38)*PCONC(:,1) -! -!PTERMS(OH,K087) = +K087*<ADD>*<O3> - PTERMS(:,15,87) = +TPK%K087(:)*PCONC(:,38)*PCONC(:,1) -! -! -RETURN -END SUBROUTINE SUBT16 -! -SUBROUTINE SUBT17 -! -!Indices 341 a 360 -! -!PTERMS(ARO,K087) = +K087*<ADD>*<O3> - PTERMS(:,22,87) = +TPK%K087(:)*PCONC(:,38)*PCONC(:,1) -! -!PTERMS(ADD,K087) = -K087*<ADD>*<O3> - PTERMS(:,38,87) = -TPK%K087(:)*PCONC(:,38)*PCONC(:,1) -! -!PTERMS(NO2,K088) = -K088*<CARBOP>*<NO2> - PTERMS(:,4,88) = -TPK%K088(:)*PCONC(:,40)*PCONC(:,4) -! -!PTERMS(PAN,K088) = +1.00000*K088*<CARBOP>*<NO2> - PTERMS(:,28,88) = +1.00000*TPK%K088(:)*PCONC(:,40)*PCONC(:,4) -! -!PTERMS(CARBOP,K088) = -K088*<CARBOP>*<NO2> - PTERMS(:,40,88) = -TPK%K088(:)*PCONC(:,40)*PCONC(:,4) -! -!PTERMS(NO2,K089) = +K089*<PAN> - PTERMS(:,4,89) = +TPK%K089(:)*PCONC(:,28) -! -!PTERMS(PAN,K089) = -K089*<PAN> - PTERMS(:,28,89) = -TPK%K089(:)*PCONC(:,28) -! -!PTERMS(CARBOP,K089) = +1.00000*K089*<PAN> - PTERMS(:,40,89) = +1.00000*TPK%K089(:)*PCONC(:,28) -! -!PTERMS(NO,K090) = -K090*<MO2>*<NO> - PTERMS(:,3,90) = -TPK%K090(:)*PCONC(:,33)*PCONC(:,3) -! -!PTERMS(NO2,K090) = +K090*<MO2>*<NO> - PTERMS(:,4,90) = +TPK%K090(:)*PCONC(:,33)*PCONC(:,3) -! -!PTERMS(HO2,K090) = +K090*<MO2>*<NO> - PTERMS(:,16,90) = +TPK%K090(:)*PCONC(:,33)*PCONC(:,3) -! -!PTERMS(HCHO,K090) = +K090*<MO2>*<NO> - PTERMS(:,23,90) = +TPK%K090(:)*PCONC(:,33)*PCONC(:,3) -! -!PTERMS(MO2,K090) = -K090*<MO2>*<NO> - PTERMS(:,33,90) = -TPK%K090(:)*PCONC(:,33)*PCONC(:,3) -! -!PTERMS(NO,K091) = -K091*<ALKAP>*<NO> - PTERMS(:,3,91) = -TPK%K091(:)*PCONC(:,34)*PCONC(:,3) -! -!PTERMS(NO2,K091) = +0.91541*K091*<ALKAP>*<NO> - PTERMS(:,4,91) = +0.91541*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) -! -!PTERMS(HO2,K091) = +0.74265*K091*<ALKAP>*<NO> - PTERMS(:,16,91) = +0.74265*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) -! -!PTERMS(HCHO,K091) = +0.03002*K091*<ALKAP>*<NO> - PTERMS(:,23,91) = +0.03002*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) -! -!PTERMS(ALD,K091) = +0.33144*K091*<ALKAP>*<NO> - PTERMS(:,24,91) = +0.33144*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) -! -!PTERMS(KET,K091) = +0.54531*K091*<ALKAP>*<NO> - PTERMS(:,25,91) = +0.54531*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) -! -!PTERMS(CARBO,K091) = +0.03407*K091*<ALKAP>*<NO> - PTERMS(:,26,91) = +0.03407*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) -! -! -RETURN -END SUBROUTINE SUBT17 -! -SUBROUTINE SUBT18 -! -!Indices 361 a 380 -! -!PTERMS(ONIT,K091) = +0.08459*K091*<ALKAP>*<NO> - PTERMS(:,27,91) = +0.08459*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) -! -!PTERMS(MO2,K091) = +0.09016*K091*<ALKAP>*<NO> - PTERMS(:,33,91) = +0.09016*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) -! -!PTERMS(ALKAP,K091) = -K091*<ALKAP>*<NO> - PTERMS(:,34,91) = -TPK%K091(:)*PCONC(:,34)*PCONC(:,3) -! -!PTERMS(XO2,K091) = +0.13007*K091*<ALKAP>*<NO> - PTERMS(:,42,91) = +0.13007*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) -! -!PTERMS(NO,K092) = -K092*<ALKEP>*<NO> - PTERMS(:,3,92) = -TPK%K092(:)*PCONC(:,35)*PCONC(:,3) -! -!PTERMS(NO2,K092) = +K092*<ALKEP>*<NO> - PTERMS(:,4,92) = +TPK%K092(:)*PCONC(:,35)*PCONC(:,3) -! -!PTERMS(HO2,K092) = +K092*<ALKEP>*<NO> - PTERMS(:,16,92) = +TPK%K092(:)*PCONC(:,35)*PCONC(:,3) -! -!PTERMS(HCHO,K092) = +1.39870*K092*<ALKEP>*<NO> - PTERMS(:,23,92) = +1.39870*TPK%K092(:)*PCONC(:,35)*PCONC(:,3) -! -!PTERMS(ALD,K092) = +0.42125*K092*<ALKEP>*<NO> - PTERMS(:,24,92) = +0.42125*TPK%K092(:)*PCONC(:,35)*PCONC(:,3) -! -!PTERMS(KET,K092) = +0.05220*K092*<ALKEP>*<NO> - PTERMS(:,25,92) = +0.05220*TPK%K092(:)*PCONC(:,35)*PCONC(:,3) -! -!PTERMS(ALKEP,K092) = -K092*<ALKEP>*<NO> - PTERMS(:,35,92) = -TPK%K092(:)*PCONC(:,35)*PCONC(:,3) -! -!PTERMS(NO,K093) = -K093*<BIOP>*<NO> - PTERMS(:,3,93) = -TPK%K093(:)*PCONC(:,36)*PCONC(:,3) -! -!PTERMS(NO2,K093) = +0.84700*K093*<BIOP>*<NO> - PTERMS(:,4,93) = +0.84700*TPK%K093(:)*PCONC(:,36)*PCONC(:,3) -! -!PTERMS(HO2,K093) = +0.84700*K093*<BIOP>*<NO> - PTERMS(:,16,93) = +0.84700*TPK%K093(:)*PCONC(:,36)*PCONC(:,3) -! -!PTERMS(ALKE,K093) = +0.37815*K093*<BIOP>*<NO> - PTERMS(:,20,93) = +0.37815*TPK%K093(:)*PCONC(:,36)*PCONC(:,3) -! -!PTERMS(HCHO,K093) = +0.60600*K093*<BIOP>*<NO> - PTERMS(:,23,93) = +0.60600*TPK%K093(:)*PCONC(:,36)*PCONC(:,3) -! -!PTERMS(ALD,K093) = +0.00000*K093*<BIOP>*<NO> - PTERMS(:,24,93) = +0.00000*TPK%K093(:)*PCONC(:,36)*PCONC(:,3) -! -!PTERMS(KET,K093) = +0.00000*K093*<BIOP>*<NO> - PTERMS(:,25,93) = +0.00000*TPK%K093(:)*PCONC(:,36)*PCONC(:,3) -! -!PTERMS(CARBO,K093) = +0.45463*K093*<BIOP>*<NO> - PTERMS(:,26,93) = +0.45463*TPK%K093(:)*PCONC(:,36)*PCONC(:,3) -! -!PTERMS(ONIT,K093) = +0.15300*K093*<BIOP>*<NO> - PTERMS(:,27,93) = +0.15300*TPK%K093(:)*PCONC(:,36)*PCONC(:,3) -! -! -RETURN -END SUBROUTINE SUBT18 -! -SUBROUTINE SUBT19 -! -!Indices 381 a 400 -! -!PTERMS(BIOP,K093) = -K093*<BIOP>*<NO> - PTERMS(:,36,93) = -TPK%K093(:)*PCONC(:,36)*PCONC(:,3) -! -!PTERMS(NO,K094) = -K094*<AROP>*<NO> - PTERMS(:,3,94) = -TPK%K094(:)*PCONC(:,39)*PCONC(:,3) -! -!PTERMS(NO2,K094) = +0.95115*K094*<AROP>*<NO> - PTERMS(:,4,94) = +0.95115*TPK%K094(:)*PCONC(:,39)*PCONC(:,3) -! -!PTERMS(HO2,K094) = +0.95115*K094*<AROP>*<NO> - PTERMS(:,16,94) = +0.95115*TPK%K094(:)*PCONC(:,39)*PCONC(:,3) -! -!PTERMS(CARBO,K094) = +2.06993*K094*<AROP>*<NO> - PTERMS(:,26,94) = +2.06993*TPK%K094(:)*PCONC(:,39)*PCONC(:,3) -! -!PTERMS(ONIT,K094) = +0.04885*K094*<AROP>*<NO> - PTERMS(:,27,94) = +0.04885*TPK%K094(:)*PCONC(:,39)*PCONC(:,3) -! -!PTERMS(AROP,K094) = -K094*<AROP>*<NO> - PTERMS(:,39,94) = -TPK%K094(:)*PCONC(:,39)*PCONC(:,3) -! -!PTERMS(NO,K095) = -K095*<CARBOP>*<NO> - PTERMS(:,3,95) = -TPK%K095(:)*PCONC(:,40)*PCONC(:,3) -! -!PTERMS(NO2,K095) = +K095*<CARBOP>*<NO> - PTERMS(:,4,95) = +TPK%K095(:)*PCONC(:,40)*PCONC(:,3) -! -!PTERMS(HO2,K095) = +0.12334*K095*<CARBOP>*<NO> - PTERMS(:,16,95) = +0.12334*TPK%K095(:)*PCONC(:,40)*PCONC(:,3) -! -!PTERMS(HCHO,K095) = +0.05848*K095*<CARBOP>*<NO> - PTERMS(:,23,95) = +0.05848*TPK%K095(:)*PCONC(:,40)*PCONC(:,3) -! -!PTERMS(ALD,K095) = +0.07368*K095*<CARBOP>*<NO> - PTERMS(:,24,95) = +0.07368*TPK%K095(:)*PCONC(:,40)*PCONC(:,3) -! -!PTERMS(CARBO,K095) = +0.08670*K095*<CARBOP>*<NO> - PTERMS(:,26,95) = +0.08670*TPK%K095(:)*PCONC(:,40)*PCONC(:,3) -! -!PTERMS(MO2,K095) = +0.78134*K095*<CARBOP>*<NO> - PTERMS(:,33,95) = +0.78134*TPK%K095(:)*PCONC(:,40)*PCONC(:,3) -! -!PTERMS(CARBOP,K095) = -K095*<CARBOP>*<NO> - PTERMS(:,40,95) = -TPK%K095(:)*PCONC(:,40)*PCONC(:,3) -! -!PTERMS(XO2,K095) = +0.02563*K095*<CARBOP>*<NO> - PTERMS(:,42,95) = +0.02563*TPK%K095(:)*PCONC(:,40)*PCONC(:,3) -! -!PTERMS(NO,K096) = -K096*<OLN>*<NO> - PTERMS(:,3,96) = -TPK%K096(:)*PCONC(:,41)*PCONC(:,3) -! -!PTERMS(NO2,K096) = +1.81599*K096*<OLN>*<NO> - PTERMS(:,4,96) = +1.81599*TPK%K096(:)*PCONC(:,41)*PCONC(:,3) -! -!PTERMS(HO2,K096) = +0.18401*K096*<OLN>*<NO> - PTERMS(:,16,96) = +0.18401*TPK%K096(:)*PCONC(:,41)*PCONC(:,3) -! -!PTERMS(HCHO,K096) = +0.23419*K096*<OLN>*<NO> - PTERMS(:,23,96) = +0.23419*TPK%K096(:)*PCONC(:,41)*PCONC(:,3) -! -! -RETURN -END SUBROUTINE SUBT19 -! -SUBROUTINE SUBT20 -! -!Indices 401 a 420 -! -!PTERMS(ALD,K096) = +1.01182*K096*<OLN>*<NO> - PTERMS(:,24,96) = +1.01182*TPK%K096(:)*PCONC(:,41)*PCONC(:,3) -! -!PTERMS(KET,K096) = +0.37862*K096*<OLN>*<NO> - PTERMS(:,25,96) = +0.37862*TPK%K096(:)*PCONC(:,41)*PCONC(:,3) -! -!PTERMS(ONIT,K096) = +0.18401*K096*<OLN>*<NO> - PTERMS(:,27,96) = +0.18401*TPK%K096(:)*PCONC(:,41)*PCONC(:,3) -! -!PTERMS(OLN,K096) = -K096*<OLN>*<NO> - PTERMS(:,41,96) = -TPK%K096(:)*PCONC(:,41)*PCONC(:,3) -! -!PTERMS(HO2,K097) = -K097*<MO2>*<HO2> - PTERMS(:,16,97) = -TPK%K097(:)*PCONC(:,33)*PCONC(:,16) -! -!PTERMS(OP1,K097) = +K097*<MO2>*<HO2> - PTERMS(:,29,97) = +TPK%K097(:)*PCONC(:,33)*PCONC(:,16) -! -!PTERMS(MO2,K097) = -K097*<MO2>*<HO2> - PTERMS(:,33,97) = -TPK%K097(:)*PCONC(:,33)*PCONC(:,16) -! -!PTERMS(HO2,K098) = -K098*<ALKAP>*<HO2> - PTERMS(:,16,98) = -TPK%K098(:)*PCONC(:,34)*PCONC(:,16) -! -!PTERMS(OP2,K098) = +1.00524*K098*<ALKAP>*<HO2> - PTERMS(:,30,98) = +1.00524*TPK%K098(:)*PCONC(:,34)*PCONC(:,16) -! -!PTERMS(ALKAP,K098) = -K098*<ALKAP>*<HO2> - PTERMS(:,34,98) = -TPK%K098(:)*PCONC(:,34)*PCONC(:,16) -! -!PTERMS(HO2,K099) = -K099*<ALKEP>*<HO2> - PTERMS(:,16,99) = -TPK%K099(:)*PCONC(:,35)*PCONC(:,16) -! -!PTERMS(OP2,K099) = +1.00524*K099*<ALKEP>*<HO2> - PTERMS(:,30,99) = +1.00524*TPK%K099(:)*PCONC(:,35)*PCONC(:,16) -! -!PTERMS(ALKEP,K099) = -K099*<ALKEP>*<HO2> - PTERMS(:,35,99) = -TPK%K099(:)*PCONC(:,35)*PCONC(:,16) -! -!PTERMS(HO2,K0100) = -K0100*<BIOP>*<HO2> - PTERMS(:,16,100) = -TPK%K0100(:)*PCONC(:,36)*PCONC(:,16) -! -!PTERMS(OP2,K0100) = +1.00524*K0100*<BIOP>*<HO2> - PTERMS(:,30,100) = +1.00524*TPK%K0100(:)*PCONC(:,36)*PCONC(:,16) -! -!PTERMS(BIOP,K0100) = -K0100*<BIOP>*<HO2> - PTERMS(:,36,100) = -TPK%K0100(:)*PCONC(:,36)*PCONC(:,16) -! -!PTERMS(HO2,K0101) = -K0101*<AROP>*<HO2> - PTERMS(:,16,101) = -TPK%K0101(:)*PCONC(:,39)*PCONC(:,16) -! -!PTERMS(OP2,K0101) = +1.00524*K0101*<AROP>*<HO2> - PTERMS(:,30,101) = +1.00524*TPK%K0101(:)*PCONC(:,39)*PCONC(:,16) -! -!PTERMS(AROP,K0101) = -K0101*<AROP>*<HO2> - PTERMS(:,39,101) = -TPK%K0101(:)*PCONC(:,39)*PCONC(:,16) -! -!PTERMS(O3,K0102) = +0.17307*K0102*<CARBOP>*<HO2> - PTERMS(:,1,102) = +0.17307*TPK%K0102(:)*PCONC(:,40)*PCONC(:,16) -! -! -RETURN -END SUBROUTINE SUBT20 -! -SUBROUTINE SUBT21 -! -!Indices 421 a 440 -! -!PTERMS(HO2,K0102) = -K0102*<CARBOP>*<HO2> - PTERMS(:,16,102) = -TPK%K0102(:)*PCONC(:,40)*PCONC(:,16) -! -!PTERMS(OP2,K0102) = +0.80904*K0102*<CARBOP>*<HO2> - PTERMS(:,30,102) = +0.80904*TPK%K0102(:)*PCONC(:,40)*PCONC(:,16) -! -!PTERMS(ORA2,K0102) = +0.17307*K0102*<CARBOP>*<HO2> - PTERMS(:,32,102) = +0.17307*TPK%K0102(:)*PCONC(:,40)*PCONC(:,16) -! -!PTERMS(CARBOP,K0102) = -K0102*<CARBOP>*<HO2> - PTERMS(:,40,102) = -TPK%K0102(:)*PCONC(:,40)*PCONC(:,16) -! -!PTERMS(HO2,K103) = -K103*<OLN>*<HO2> - PTERMS(:,16,103) = -TPK%K103(:)*PCONC(:,41)*PCONC(:,16) -! -!PTERMS(ONIT,K103) = +K103*<OLN>*<HO2> - PTERMS(:,27,103) = +TPK%K103(:)*PCONC(:,41)*PCONC(:,16) -! -!PTERMS(OLN,K103) = -K103*<OLN>*<HO2> - PTERMS(:,41,103) = -TPK%K103(:)*PCONC(:,41)*PCONC(:,16) -! -!PTERMS(HO2,K104) = +0.66*K104*<MO2>*<MO2> - PTERMS(:,16,104) = +0.66*TPK%K104(:)*PCONC(:,33)*PCONC(:,33) -! -!PTERMS(HCHO,K104) = +1.33*K104*<MO2>*<MO2> - PTERMS(:,23,104) = +1.33*TPK%K104(:)*PCONC(:,33)*PCONC(:,33) -! -!PTERMS(MO2,K104) = -K104*<MO2>*<MO2> - PTERMS(:,33,104) = -TPK%K104(:)*PCONC(:,33)*PCONC(:,33) -! -!PTERMS(HO2,K105) = +0.98383*K105*<ALKAP>*<MO2> - PTERMS(:,16,105) = +0.98383*TPK%K105(:)*PCONC(:,34)*PCONC(:,33) -! -!PTERMS(HCHO,K105) = +0.80556*K105*<ALKAP>*<MO2> - PTERMS(:,23,105) = +0.80556*TPK%K105(:)*PCONC(:,34)*PCONC(:,33) -! -!PTERMS(ALD,K105) = +0.56070*K105*<ALKAP>*<MO2> - PTERMS(:,24,105) = +0.56070*TPK%K105(:)*PCONC(:,34)*PCONC(:,33) -! -!PTERMS(KET,K105) = +0.09673*K105*<ALKAP>*<MO2> - PTERMS(:,25,105) = +0.09673*TPK%K105(:)*PCONC(:,34)*PCONC(:,33) -! -!PTERMS(CARBO,K105) = +0.07976*K105*<ALKAP>*<MO2> - PTERMS(:,26,105) = +0.07976*TPK%K105(:)*PCONC(:,34)*PCONC(:,33) -! -!PTERMS(MO2,K105) = -K105*<ALKAP>*<MO2> - PTERMS(:,33,105) = -TPK%K105(:)*PCONC(:,34)*PCONC(:,33) -! -!PTERMS(ALKAP,K105) = -K105*<ALKAP>*<MO2> - PTERMS(:,34,105) = -TPK%K105(:)*PCONC(:,34)*PCONC(:,33) -! -!PTERMS(XO2,K105) = +0.13370*K105*<ALKAP>*<MO2> - PTERMS(:,42,105) = +0.13370*TPK%K105(:)*PCONC(:,34)*PCONC(:,33) -! -!PTERMS(HO2,K106) = +K106*<ALKEP>*<MO2> - PTERMS(:,16,106) = +TPK%K106(:)*PCONC(:,35)*PCONC(:,33) -! -!PTERMS(HCHO,K106) = +1.42894*K106*<ALKEP>*<MO2> - PTERMS(:,23,106) = +1.42894*TPK%K106(:)*PCONC(:,35)*PCONC(:,33) -! -! -RETURN -END SUBROUTINE SUBT21 -! -SUBROUTINE SUBT22 -! -!Indices 441 a 460 -! -!PTERMS(ALD,K106) = +0.46413*K106*<ALKEP>*<MO2> - PTERMS(:,24,106) = +0.46413*TPK%K106(:)*PCONC(:,35)*PCONC(:,33) -! -!PTERMS(KET,K106) = +0.03814*K106*<ALKEP>*<MO2> - PTERMS(:,25,106) = +0.03814*TPK%K106(:)*PCONC(:,35)*PCONC(:,33) -! -!PTERMS(MO2,K106) = -K106*<ALKEP>*<MO2> - PTERMS(:,33,106) = -TPK%K106(:)*PCONC(:,35)*PCONC(:,33) -! -!PTERMS(ALKEP,K106) = -K106*<ALKEP>*<MO2> - PTERMS(:,35,106) = -TPK%K106(:)*PCONC(:,35)*PCONC(:,33) -! -!PTERMS(HO2,K107) = +1.00000*K107*<BIOP>*<MO2> - PTERMS(:,16,107) = +1.00000*TPK%K107(:)*PCONC(:,36)*PCONC(:,33) -! -!PTERMS(ALKE,K107) = +0.48074*K107*<BIOP>*<MO2> - PTERMS(:,20,107) = +0.48074*TPK%K107(:)*PCONC(:,36)*PCONC(:,33) -! -!PTERMS(HCHO,K107) = +1.09000*K107*<BIOP>*<MO2> - PTERMS(:,23,107) = +1.09000*TPK%K107(:)*PCONC(:,36)*PCONC(:,33) -! -!PTERMS(ALD,K107) = +0.00000*K107*<BIOP>*<MO2> - PTERMS(:,24,107) = +0.00000*TPK%K107(:)*PCONC(:,36)*PCONC(:,33) -! -!PTERMS(KET,K107) = +0.00000*K107*<BIOP>*<MO2> - PTERMS(:,25,107) = +0.00000*TPK%K107(:)*PCONC(:,36)*PCONC(:,33) -! -!PTERMS(CARBO,K107) = +0.56064*K107*<BIOP>*<MO2> - PTERMS(:,26,107) = +0.56064*TPK%K107(:)*PCONC(:,36)*PCONC(:,33) -! -!PTERMS(MO2,K107) = -K107*<BIOP>*<MO2> - PTERMS(:,33,107) = -TPK%K107(:)*PCONC(:,36)*PCONC(:,33) -! -!PTERMS(BIOP,K107) = -K107*<BIOP>*<MO2> - PTERMS(:,36,107) = -TPK%K107(:)*PCONC(:,36)*PCONC(:,33) -! -!PTERMS(HO2,K108) = +1.02767*K108*<AROP>*<MO2> - PTERMS(:,16,108) = +1.02767*TPK%K108(:)*PCONC(:,39)*PCONC(:,33) -! -!PTERMS(HCHO,K108) = +K108*<AROP>*<MO2> - PTERMS(:,23,108) = +TPK%K108(:)*PCONC(:,39)*PCONC(:,33) -! -!PTERMS(CARBO,K108) = +1.99461*K108*<AROP>*<MO2> - PTERMS(:,26,108) = +1.99461*TPK%K108(:)*PCONC(:,39)*PCONC(:,33) -! -!PTERMS(MO2,K108) = -K108*<AROP>*<MO2> - PTERMS(:,33,108) = -TPK%K108(:)*PCONC(:,39)*PCONC(:,33) -! -!PTERMS(AROP,K108) = -K108*<AROP>*<MO2> - PTERMS(:,39,108) = -TPK%K108(:)*PCONC(:,39)*PCONC(:,33) -! -!PTERMS(HO2,K109) = +0.82998*K109*<CARBOP>*<MO2> - PTERMS(:,16,109) = +0.82998*TPK%K109(:)*PCONC(:,40)*PCONC(:,33) -! -!PTERMS(HCHO,K109) = +0.95723*K109*<CARBOP>*<MO2> - PTERMS(:,23,109) = +0.95723*TPK%K109(:)*PCONC(:,40)*PCONC(:,33) -! -!PTERMS(ALD,K109) = +0.08295*K109*<CARBOP>*<MO2> - PTERMS(:,24,109) = +0.08295*TPK%K109(:)*PCONC(:,40)*PCONC(:,33) -! -! -RETURN -END SUBROUTINE SUBT22 -! -SUBROUTINE SUBT23 -! -!Indices 461 a 480 -! -!PTERMS(CARBO,K109) = +0.15387*K109*<CARBOP>*<MO2> - PTERMS(:,26,109) = +0.15387*TPK%K109(:)*PCONC(:,40)*PCONC(:,33) -! -!PTERMS(ORA2,K109) = +0.13684*K109*<CARBOP>*<MO2> - PTERMS(:,32,109) = +0.13684*TPK%K109(:)*PCONC(:,40)*PCONC(:,33) -! -!PTERMS(MO2,K109) = -K109*<CARBOP>*<MO2> - PTERMS(:,33,109) = -TPK%K109(:)*PCONC(:,40)*PCONC(:,33) -! -!PTERMS(CARBOP,K109) = -K109*<CARBOP>*<MO2> - PTERMS(:,40,109) = -TPK%K109(:)*PCONC(:,40)*PCONC(:,33) -! -!PTERMS(XO2,K109) = +0.02212*K109*<CARBOP>*<MO2> - PTERMS(:,42,109) = +0.02212*TPK%K109(:)*PCONC(:,40)*PCONC(:,33) -! -!PTERMS(NO2,K110) = +0.32440*K110*<OLN>*<MO2> - PTERMS(:,4,110) = +0.32440*TPK%K110(:)*PCONC(:,41)*PCONC(:,33) -! -!PTERMS(HO2,K110) = +0.67560*K110*<OLN>*<MO2> - PTERMS(:,16,110) = +0.67560*TPK%K110(:)*PCONC(:,41)*PCONC(:,33) -! -!PTERMS(HCHO,K110) = +0.88625*K110*<OLN>*<MO2> - PTERMS(:,23,110) = +0.88625*TPK%K110(:)*PCONC(:,41)*PCONC(:,33) -! -!PTERMS(ALD,K110) = +0.41524*K110*<OLN>*<MO2> - PTERMS(:,24,110) = +0.41524*TPK%K110(:)*PCONC(:,41)*PCONC(:,33) -! -!PTERMS(KET,K110) = +0.09667*K110*<OLN>*<MO2> - PTERMS(:,25,110) = +0.09667*TPK%K110(:)*PCONC(:,41)*PCONC(:,33) -! -!PTERMS(ONIT,K110) = +0.67560*K110*<OLN>*<MO2> - PTERMS(:,27,110) = +0.67560*TPK%K110(:)*PCONC(:,41)*PCONC(:,33) -! -!PTERMS(MO2,K110) = -K110*<OLN>*<MO2> - PTERMS(:,33,110) = -TPK%K110(:)*PCONC(:,41)*PCONC(:,33) -! -!PTERMS(OLN,K110) = -K110*<OLN>*<MO2> - PTERMS(:,41,110) = -TPK%K110(:)*PCONC(:,41)*PCONC(:,33) -! -!PTERMS(HO2,K111) = +0.48079*K111*<ALKAP>*<CARBOP> - PTERMS(:,16,111) = +0.48079*TPK%K111(:)*PCONC(:,34)*PCONC(:,40) -! -!PTERMS(HCHO,K111) = +0.07600*K111*<ALKAP>*<CARBOP> - PTERMS(:,23,111) = +0.07600*TPK%K111(:)*PCONC(:,34)*PCONC(:,40) -! -!PTERMS(ALD,K111) = +0.71461*K111*<ALKAP>*<CARBOP> - PTERMS(:,24,111) = +0.71461*TPK%K111(:)*PCONC(:,34)*PCONC(:,40) -! -!PTERMS(KET,K111) = +0.18819*K111*<ALKAP>*<CARBOP> - PTERMS(:,25,111) = +0.18819*TPK%K111(:)*PCONC(:,34)*PCONC(:,40) -! -!PTERMS(CARBO,K111) = +0.06954*K111*<ALKAP>*<CARBOP> - PTERMS(:,26,111) = +0.06954*TPK%K111(:)*PCONC(:,34)*PCONC(:,40) -! -!PTERMS(ORA2,K111) = +0.49810*K111*<ALKAP>*<CARBOP> - PTERMS(:,32,111) = +0.49810*TPK%K111(:)*PCONC(:,34)*PCONC(:,40) -! -!PTERMS(MO2,K111) = +0.51480*K111*<ALKAP>*<CARBOP> - PTERMS(:,33,111) = +0.51480*TPK%K111(:)*PCONC(:,34)*PCONC(:,40) -! -! -RETURN -END SUBROUTINE SUBT23 -! -SUBROUTINE SUBT24 -! -!Indices 481 a 500 -! -!PTERMS(ALKAP,K111) = -K111*<ALKAP>*<CARBOP> - PTERMS(:,34,111) = -TPK%K111(:)*PCONC(:,34)*PCONC(:,40) -! -!PTERMS(CARBOP,K111) = -K111*<ALKAP>*<CARBOP> - PTERMS(:,40,111) = -TPK%K111(:)*PCONC(:,34)*PCONC(:,40) -! -!PTERMS(XO2,K111) = +0.11306*K111*<ALKAP>*<CARBOP> - PTERMS(:,42,111) = +0.11306*TPK%K111(:)*PCONC(:,34)*PCONC(:,40) -! -!PTERMS(HO2,K112) = +0.50078*K112*<ALKEP>*<CARBOP> - PTERMS(:,16,112) = +0.50078*TPK%K112(:)*PCONC(:,35)*PCONC(:,40) -! -!PTERMS(HCHO,K112) = +0.68192*K112*<ALKEP>*<CARBOP> - PTERMS(:,23,112) = +0.68192*TPK%K112(:)*PCONC(:,35)*PCONC(:,40) -! -!PTERMS(ALD,K112) = +0.68374*K112*<ALKEP>*<CARBOP> - PTERMS(:,24,112) = +0.68374*TPK%K112(:)*PCONC(:,35)*PCONC(:,40) -! -!PTERMS(KET,K112) = +0.06579*K112*<ALKEP>*<CARBOP> - PTERMS(:,25,112) = +0.06579*TPK%K112(:)*PCONC(:,35)*PCONC(:,40) -! -!PTERMS(ORA2,K112) = +0.49922*K112*<ALKEP>*<CARBOP> - PTERMS(:,32,112) = +0.49922*TPK%K112(:)*PCONC(:,35)*PCONC(:,40) -! -!PTERMS(MO2,K112) = +0.50078*K112*<ALKEP>*<CARBOP> - PTERMS(:,33,112) = +0.50078*TPK%K112(:)*PCONC(:,35)*PCONC(:,40) -! -!PTERMS(ALKEP,K112) = -K112*<ALKEP>*<CARBOP> - PTERMS(:,35,112) = -TPK%K112(:)*PCONC(:,35)*PCONC(:,40) -! -!PTERMS(CARBOP,K112) = -K112*<ALKEP>*<CARBOP> - PTERMS(:,40,112) = -TPK%K112(:)*PCONC(:,35)*PCONC(:,40) -! -!PTERMS(HO2,K113) = +0.50600*K113*<BIOP>*<CARBOP> - PTERMS(:,16,113) = +0.50600*TPK%K113(:)*PCONC(:,36)*PCONC(:,40) -! -!PTERMS(ALKE,K113) = +0.24463*K113*<BIOP>*<CARBOP> - PTERMS(:,20,113) = +0.24463*TPK%K113(:)*PCONC(:,36)*PCONC(:,40) -! -!PTERMS(HCHO,K113) = +0.34000*K113*<BIOP>*<CARBOP> - PTERMS(:,23,113) = +0.34000*TPK%K113(:)*PCONC(:,36)*PCONC(:,40) -! -!PTERMS(ALD,K113) = +0.00000*K113*<BIOP>*<CARBOP> - PTERMS(:,24,113) = +0.00000*TPK%K113(:)*PCONC(:,36)*PCONC(:,40) -! -!PTERMS(KET,K113) = +0.00000*K113*<BIOP>*<CARBOP> - PTERMS(:,25,113) = +0.00000*TPK%K113(:)*PCONC(:,36)*PCONC(:,40) -! -!PTERMS(CARBO,K113) = +0.78591*K113*<BIOP>*<CARBOP> - PTERMS(:,26,113) = +0.78591*TPK%K113(:)*PCONC(:,36)*PCONC(:,40) -! -!PTERMS(ORA2,K113) = +0.49400*K113*<BIOP>*<CARBOP> - PTERMS(:,32,113) = +0.49400*TPK%K113(:)*PCONC(:,36)*PCONC(:,40) -! -!PTERMS(MO2,K113) = +0.50600*K113*<BIOP>*<CARBOP> - PTERMS(:,33,113) = +0.50600*TPK%K113(:)*PCONC(:,36)*PCONC(:,40) -! -!PTERMS(BIOP,K113) = -K113*<BIOP>*<CARBOP> - PTERMS(:,36,113) = -TPK%K113(:)*PCONC(:,36)*PCONC(:,40) -! -! -RETURN -END SUBROUTINE SUBT24 -! -SUBROUTINE SUBT25 -! -!Indices 501 a 520 -! -!PTERMS(CARBOP,K113) = -K113*<BIOP>*<CARBOP> - PTERMS(:,40,113) = -TPK%K113(:)*PCONC(:,36)*PCONC(:,40) -! -!PTERMS(HO2,K114) = +K114*<AROP>*<CARBOP> - PTERMS(:,16,114) = +TPK%K114(:)*PCONC(:,39)*PCONC(:,40) -! -!PTERMS(CARBO,K114) = +1.99455*K114*<AROP>*<CARBOP> - PTERMS(:,26,114) = +1.99455*TPK%K114(:)*PCONC(:,39)*PCONC(:,40) -! -!PTERMS(MO2,K114) = +K114*<AROP>*<CARBOP> - PTERMS(:,33,114) = +TPK%K114(:)*PCONC(:,39)*PCONC(:,40) -! -!PTERMS(AROP,K114) = -K114*<AROP>*<CARBOP> - PTERMS(:,39,114) = -TPK%K114(:)*PCONC(:,39)*PCONC(:,40) -! -!PTERMS(CARBOP,K114) = -K114*<AROP>*<CARBOP> - PTERMS(:,40,114) = -TPK%K114(:)*PCONC(:,39)*PCONC(:,40) -! -!PTERMS(HO2,K115) = +0.07566*K115*<CARBOP>*<CARBOP> - PTERMS(:,16,115) = +0.07566*TPK%K115(:)*PCONC(:,40)*PCONC(:,40) -! -!PTERMS(HCHO,K115) = +0.03432*K115*<CARBOP>*<CARBOP> - PTERMS(:,23,115) = +0.03432*TPK%K115(:)*PCONC(:,40)*PCONC(:,40) -! -!PTERMS(ALD,K115) = +0.06969*K115*<CARBOP>*<CARBOP> - PTERMS(:,24,115) = +0.06969*TPK%K115(:)*PCONC(:,40)*PCONC(:,40) -! -!PTERMS(KET,K115) = +0.02190*K115*<CARBOP>*<CARBOP> - PTERMS(:,25,115) = +0.02190*TPK%K115(:)*PCONC(:,40)*PCONC(:,40) -! -!PTERMS(CARBO,K115) = +0.10777*K115*<CARBOP>*<CARBOP> - PTERMS(:,26,115) = +0.10777*TPK%K115(:)*PCONC(:,40)*PCONC(:,40) -! -!PTERMS(ORA2,K115) = +0.09955*K115*<CARBOP>*<CARBOP> - PTERMS(:,32,115) = +0.09955*TPK%K115(:)*PCONC(:,40)*PCONC(:,40) -! -!PTERMS(MO2,K115) = +1.66702*K115*<CARBOP>*<CARBOP> - PTERMS(:,33,115) = +1.66702*TPK%K115(:)*PCONC(:,40)*PCONC(:,40) -! -!PTERMS(CARBOP,K115) = -K115*<CARBOP>*<CARBOP> - PTERMS(:,40,115) = -TPK%K115(:)*PCONC(:,40)*PCONC(:,40) -! -!PTERMS(XO2,K115) = +0.01593*K115*<CARBOP>*<CARBOP> - PTERMS(:,42,115) = +0.01593*TPK%K115(:)*PCONC(:,40)*PCONC(:,40) -! -!PTERMS(NO2,K116) = +0.00000*K116*<OLN>*<CARBOP> - PTERMS(:,4,116) = +0.00000*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) -! -!PTERMS(HO2,K116) = +0.17599*K116*<OLN>*<CARBOP> - PTERMS(:,16,116) = +0.17599*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) -! -!PTERMS(HCHO,K116) = +0.13414*K116*<OLN>*<CARBOP> - PTERMS(:,23,116) = +0.13414*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) -! -!PTERMS(ALD,K116) = +0.42122*K116*<OLN>*<CARBOP> - PTERMS(:,24,116) = +0.42122*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) -! -!PTERMS(KET,K116) = +0.10822*K116*<OLN>*<CARBOP> - PTERMS(:,25,116) = +0.10822*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) -! -! -RETURN -END SUBROUTINE SUBT25 -! -SUBROUTINE SUBT26 -! -!Indices 521 a 540 -! -!PTERMS(ONIT,K116) = +0.66562*K116*<OLN>*<CARBOP> - PTERMS(:,27,116) = +0.66562*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) -! -!PTERMS(ORA2,K116) = +0.48963*K116*<OLN>*<CARBOP> - PTERMS(:,32,116) = +0.48963*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) -! -!PTERMS(MO2,K116) = +0.51037*K116*<OLN>*<CARBOP> - PTERMS(:,33,116) = +0.51037*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) -! -!PTERMS(CARBOP,K116) = -K116*<OLN>*<CARBOP> - PTERMS(:,40,116) = -TPK%K116(:)*PCONC(:,41)*PCONC(:,40) -! -!PTERMS(OLN,K116) = -K116*<OLN>*<CARBOP> - PTERMS(:,41,116) = -TPK%K116(:)*PCONC(:,41)*PCONC(:,40) -! -!PTERMS(HO2,K117) = +K117*<OLN>*<OLN> - PTERMS(:,16,117) = +TPK%K117(:)*PCONC(:,41)*PCONC(:,41) -! -!PTERMS(ONIT,K117) = +2.00*K117*<OLN>*<OLN> - PTERMS(:,27,117) = +2.00*TPK%K117(:)*PCONC(:,41)*PCONC(:,41) -! -!PTERMS(OLN,K117) = -K117*<OLN>*<OLN> - PTERMS(:,41,117) = -TPK%K117(:)*PCONC(:,41)*PCONC(:,41) -! -!PTERMS(NO2,K118) = +0.00000*K118*<OLN>*<OLN> - PTERMS(:,4,118) = +0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,41) -! -!PTERMS(HO2,K118) = +0.00000*K118*<OLN>*<OLN> - PTERMS(:,16,118) = +0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,41) -! -!PTERMS(HCHO,K118) = +0.00000*K118*<OLN>*<OLN> - PTERMS(:,23,118) = +0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,41) -! -!PTERMS(ALD,K118) = +0.00000*K118*<OLN>*<OLN> - PTERMS(:,24,118) = +0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,41) -! -!PTERMS(KET,K118) = +0.00000*K118*<OLN>*<OLN> - PTERMS(:,25,118) = +0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,41) -! -!PTERMS(ONIT,K118) = +0.00000*K118*<OLN>*<OLN> - PTERMS(:,27,118) = +0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,41) -! -!PTERMS(OLN,K118) = -K118*<OLN>*<OLN> - PTERMS(:,41,118) = -TPK%K118(:)*PCONC(:,41)*PCONC(:,41) -! -!PTERMS(NO2,K119) = +K119*<MO2>*<NO3> - PTERMS(:,4,119) = +TPK%K119(:)*PCONC(:,33)*PCONC(:,5) -! -!PTERMS(NO3,K119) = -K119*<MO2>*<NO3> - PTERMS(:,5,119) = -TPK%K119(:)*PCONC(:,33)*PCONC(:,5) -! -!PTERMS(HO2,K119) = +K119*<MO2>*<NO3> - PTERMS(:,16,119) = +TPK%K119(:)*PCONC(:,33)*PCONC(:,5) -! -!PTERMS(HCHO,K119) = +K119*<MO2>*<NO3> - PTERMS(:,23,119) = +TPK%K119(:)*PCONC(:,33)*PCONC(:,5) -! -!PTERMS(MO2,K119) = -K119*<MO2>*<NO3> - PTERMS(:,33,119) = -TPK%K119(:)*PCONC(:,33)*PCONC(:,5) -! -! -RETURN -END SUBROUTINE SUBT26 -! -SUBROUTINE SUBT27 -! -!Indices 541 a 560 -! -!PTERMS(NO2,K120) = +K120*<ALKAP>*<NO3> - PTERMS(:,4,120) = +TPK%K120(:)*PCONC(:,34)*PCONC(:,5) -! -!PTERMS(NO3,K120) = -K120*<ALKAP>*<NO3> - PTERMS(:,5,120) = -TPK%K120(:)*PCONC(:,34)*PCONC(:,5) -! -!PTERMS(HO2,K120) = +0.81290*K120*<ALKAP>*<NO3> - PTERMS(:,16,120) = +0.81290*TPK%K120(:)*PCONC(:,34)*PCONC(:,5) -! -!PTERMS(HCHO,K120) = +0.03142*K120*<ALKAP>*<NO3> - PTERMS(:,23,120) = +0.03142*TPK%K120(:)*PCONC(:,34)*PCONC(:,5) -! -!PTERMS(ALD,K120) = +0.33743*K120*<ALKAP>*<NO3> - PTERMS(:,24,120) = +0.33743*TPK%K120(:)*PCONC(:,34)*PCONC(:,5) -! -!PTERMS(KET,K120) = +0.62978*K120*<ALKAP>*<NO3> - PTERMS(:,25,120) = +0.62978*TPK%K120(:)*PCONC(:,34)*PCONC(:,5) -! -!PTERMS(CARBO,K120) = +0.03531*K120*<ALKAP>*<NO3> - PTERMS(:,26,120) = +0.03531*TPK%K120(:)*PCONC(:,34)*PCONC(:,5) -! -!PTERMS(MO2,K120) = +0.09731*K120*<ALKAP>*<NO3> - PTERMS(:,33,120) = +0.09731*TPK%K120(:)*PCONC(:,34)*PCONC(:,5) -! -!PTERMS(ALKAP,K120) = -K120*<ALKAP>*<NO3> - PTERMS(:,34,120) = -TPK%K120(:)*PCONC(:,34)*PCONC(:,5) -! -!PTERMS(XO2,K120) = +0.16271*K120*<ALKAP>*<NO3> - PTERMS(:,42,120) = +0.16271*TPK%K120(:)*PCONC(:,34)*PCONC(:,5) -! -!PTERMS(NO2,K121) = +K121*<ALKEP>*<NO3> - PTERMS(:,4,121) = +TPK%K121(:)*PCONC(:,35)*PCONC(:,5) -! -!PTERMS(NO3,K121) = -K121*<ALKEP>*<NO3> - PTERMS(:,5,121) = -TPK%K121(:)*PCONC(:,35)*PCONC(:,5) -! -!PTERMS(HO2,K121) = +K121*<ALKEP>*<NO3> - PTERMS(:,16,121) = +TPK%K121(:)*PCONC(:,35)*PCONC(:,5) -! -!PTERMS(HCHO,K121) = +1.40909*K121*<ALKEP>*<NO3> - PTERMS(:,23,121) = +1.40909*TPK%K121(:)*PCONC(:,35)*PCONC(:,5) -! -!PTERMS(ALD,K121) = +0.43039*K121*<ALKEP>*<NO3> - PTERMS(:,24,121) = +0.43039*TPK%K121(:)*PCONC(:,35)*PCONC(:,5) -! -!PTERMS(KET,K121) = +0.02051*K121*<ALKEP>*<NO3> - PTERMS(:,25,121) = +0.02051*TPK%K121(:)*PCONC(:,35)*PCONC(:,5) -! -!PTERMS(ALKEP,K121) = -K121*<ALKEP>*<NO3> - PTERMS(:,35,121) = -TPK%K121(:)*PCONC(:,35)*PCONC(:,5) -! -!PTERMS(NO2,K122) = +K122*<BIOP>*<NO3> - PTERMS(:,4,122) = +TPK%K122(:)*PCONC(:,36)*PCONC(:,5) -! -!PTERMS(NO3,K122) = -K122*<BIOP>*<NO3> - PTERMS(:,5,122) = -TPK%K122(:)*PCONC(:,36)*PCONC(:,5) -! -!PTERMS(HO2,K122) = +K122*<BIOP>*<NO3> - PTERMS(:,16,122) = +TPK%K122(:)*PCONC(:,36)*PCONC(:,5) -! -! -RETURN -END SUBROUTINE SUBT27 -! -SUBROUTINE SUBT28 -! -!Indices 561 a 580 -! -!PTERMS(ALKE,K122) = +0.42729*K122*<BIOP>*<NO3> - PTERMS(:,20,122) = +0.42729*TPK%K122(:)*PCONC(:,36)*PCONC(:,5) -! -!PTERMS(HCHO,K122) = +0.68600*K122*<BIOP>*<NO3> - PTERMS(:,23,122) = +0.68600*TPK%K122(:)*PCONC(:,36)*PCONC(:,5) -! -!PTERMS(ALD,K122) = +0.00000*K122*<BIOP>*<NO3> - PTERMS(:,24,122) = +0.00000*TPK%K122(:)*PCONC(:,36)*PCONC(:,5) -! -!PTERMS(KET,K122) = +0.00000*K122*<BIOP>*<NO3> - PTERMS(:,25,122) = +0.00000*TPK%K122(:)*PCONC(:,36)*PCONC(:,5) -! -!PTERMS(CARBO,K122) = +0.61160*K122*<BIOP>*<NO3> - PTERMS(:,26,122) = +0.61160*TPK%K122(:)*PCONC(:,36)*PCONC(:,5) -! -!PTERMS(BIOP,K122) = -K122*<BIOP>*<NO3> - PTERMS(:,36,122) = -TPK%K122(:)*PCONC(:,36)*PCONC(:,5) -! -!PTERMS(NO2,K123) = +K123*<AROP>*<NO3> - PTERMS(:,4,123) = +TPK%K123(:)*PCONC(:,39)*PCONC(:,5) -! -!PTERMS(NO3,K123) = -K123*<AROP>*<NO3> - PTERMS(:,5,123) = -TPK%K123(:)*PCONC(:,39)*PCONC(:,5) -! -!PTERMS(HO2,K123) = +K123*<AROP>*<NO3> - PTERMS(:,16,123) = +TPK%K123(:)*PCONC(:,39)*PCONC(:,5) -! -!PTERMS(CARBO,K123) = +2.81904*K123*<AROP>*<NO3> - PTERMS(:,26,123) = +2.81904*TPK%K123(:)*PCONC(:,39)*PCONC(:,5) -! -!PTERMS(AROP,K123) = -K123*<AROP>*<NO3> - PTERMS(:,39,123) = -TPK%K123(:)*PCONC(:,39)*PCONC(:,5) -! -!PTERMS(NO2,K124) = +K124*<CARBOP>*<NO3> - PTERMS(:,4,124) = +TPK%K124(:)*PCONC(:,40)*PCONC(:,5) -! -!PTERMS(NO3,K124) = -K124*<CARBOP>*<NO3> - PTERMS(:,5,124) = -TPK%K124(:)*PCONC(:,40)*PCONC(:,5) -! -!PTERMS(HO2,K124) = +0.04915*K124*<CARBOP>*<NO3> - PTERMS(:,16,124) = +0.04915*TPK%K124(:)*PCONC(:,40)*PCONC(:,5) -! -!PTERMS(HCHO,K124) = +0.03175*K124*<CARBOP>*<NO3> - PTERMS(:,23,124) = +0.03175*TPK%K124(:)*PCONC(:,40)*PCONC(:,5) -! -!PTERMS(ALD,K124) = +0.02936*K124*<CARBOP>*<NO3> - PTERMS(:,24,124) = +0.02936*TPK%K124(:)*PCONC(:,40)*PCONC(:,5) -! -!PTERMS(CARBO,K124) = +0.03455*K124*<CARBOP>*<NO3> - PTERMS(:,26,124) = +0.03455*TPK%K124(:)*PCONC(:,40)*PCONC(:,5) -! -!PTERMS(MO2,K124) = +0.91910*K124*<CARBOP>*<NO3> - PTERMS(:,33,124) = +0.91910*TPK%K124(:)*PCONC(:,40)*PCONC(:,5) -! -!PTERMS(CARBOP,K124) = -K124*<CARBOP>*<NO3> - PTERMS(:,40,124) = -TPK%K124(:)*PCONC(:,40)*PCONC(:,5) -! -!PTERMS(XO2,K124) = +0.01021*K124*<CARBOP>*<NO3> - PTERMS(:,42,124) = +0.01021*TPK%K124(:)*PCONC(:,40)*PCONC(:,5) -! -! -RETURN -END SUBROUTINE SUBT28 -! -SUBROUTINE SUBT29 -! -!Indices 581 a 600 -! -!PTERMS(NO2,K125) = +1.74072*K125*<OLN>*<NO3> - PTERMS(:,4,125) = +1.74072*TPK%K125(:)*PCONC(:,41)*PCONC(:,5) -! -!PTERMS(NO3,K125) = -K125*<OLN>*<NO3> - PTERMS(:,5,125) = -TPK%K125(:)*PCONC(:,41)*PCONC(:,5) -! -!PTERMS(HO2,K125) = +0.25928*K125*<OLN>*<NO3> - PTERMS(:,16,125) = +0.25928*TPK%K125(:)*PCONC(:,41)*PCONC(:,5) -! -!PTERMS(HCHO,K125) = +0.20740*K125*<OLN>*<NO3> - PTERMS(:,23,125) = +0.20740*TPK%K125(:)*PCONC(:,41)*PCONC(:,5) -! -!PTERMS(ALD,K125) = +0.91850*K125*<OLN>*<NO3> - PTERMS(:,24,125) = +0.91850*TPK%K125(:)*PCONC(:,41)*PCONC(:,5) -! -!PTERMS(KET,K125) = +0.34740*K125*<OLN>*<NO3> - PTERMS(:,25,125) = +0.34740*TPK%K125(:)*PCONC(:,41)*PCONC(:,5) -! -!PTERMS(ONIT,K125) = +0.25928*K125*<OLN>*<NO3> - PTERMS(:,27,125) = +0.25928*TPK%K125(:)*PCONC(:,41)*PCONC(:,5) -! -!PTERMS(OLN,K125) = -K125*<OLN>*<NO3> - PTERMS(:,41,125) = -TPK%K125(:)*PCONC(:,41)*PCONC(:,5) -! -!PTERMS(HO2,K126) = -K126*<XO2>*<HO2> - PTERMS(:,16,126) = -TPK%K126(:)*PCONC(:,42)*PCONC(:,16) -! -!PTERMS(OP2,K126) = +1.00524*K126*<XO2>*<HO2> - PTERMS(:,30,126) = +1.00524*TPK%K126(:)*PCONC(:,42)*PCONC(:,16) -! -!PTERMS(XO2,K126) = -K126*<XO2>*<HO2> - PTERMS(:,42,126) = -TPK%K126(:)*PCONC(:,42)*PCONC(:,16) -! -!PTERMS(HO2,K127) = +K127*<XO2>*<MO2> - PTERMS(:,16,127) = +TPK%K127(:)*PCONC(:,42)*PCONC(:,33) -! -!PTERMS(HCHO,K127) = +K127*<XO2>*<MO2> - PTERMS(:,23,127) = +TPK%K127(:)*PCONC(:,42)*PCONC(:,33) -! -!PTERMS(MO2,K127) = -K127*<XO2>*<MO2> - PTERMS(:,33,127) = -TPK%K127(:)*PCONC(:,42)*PCONC(:,33) -! -!PTERMS(XO2,K127) = -K127*<XO2>*<MO2> - PTERMS(:,42,127) = -TPK%K127(:)*PCONC(:,42)*PCONC(:,33) -! -!PTERMS(MO2,K128) = +K128*<XO2>*<CARBOP> - PTERMS(:,33,128) = +TPK%K128(:)*PCONC(:,42)*PCONC(:,40) -! -!PTERMS(CARBOP,K128) = -K128*<XO2>*<CARBOP> - PTERMS(:,40,128) = -TPK%K128(:)*PCONC(:,42)*PCONC(:,40) -! -!PTERMS(XO2,K128) = -K128*<XO2>*<CARBOP> - PTERMS(:,42,128) = -TPK%K128(:)*PCONC(:,42)*PCONC(:,40) -! -!PTERMS(XO2,K129) = -K129*<XO2>*<XO2> - PTERMS(:,42,129) = -TPK%K129(:)*PCONC(:,42)*PCONC(:,42) -! -!PTERMS(NO,K130) = -K130*<XO2>*<NO> - PTERMS(:,3,130) = -TPK%K130(:)*PCONC(:,42)*PCONC(:,3) -! -! -RETURN -END SUBROUTINE SUBT29 -! -SUBROUTINE SUBT30 -! -!Indices 601 a 615 -! -!PTERMS(NO2,K130) = +K130*<XO2>*<NO> - PTERMS(:,4,130) = +TPK%K130(:)*PCONC(:,42)*PCONC(:,3) -! -!PTERMS(XO2,K130) = -K130*<XO2>*<NO> - PTERMS(:,42,130) = -TPK%K130(:)*PCONC(:,42)*PCONC(:,3) -! -!PTERMS(NO2,K131) = +K131*<XO2>*<NO3> - PTERMS(:,4,131) = +TPK%K131(:)*PCONC(:,42)*PCONC(:,5) -! -!PTERMS(NO3,K131) = -K131*<XO2>*<NO3> - PTERMS(:,5,131) = -TPK%K131(:)*PCONC(:,42)*PCONC(:,5) -! -!PTERMS(XO2,K131) = -K131*<XO2>*<NO3> - PTERMS(:,42,131) = -TPK%K131(:)*PCONC(:,42)*PCONC(:,5) -! -!PTERMS(SULF,K132) = -K132*<SULF> - PTERMS(:,13,132) = -TPK%K132(:)*PCONC(:,13) -! -!PTERMS(NO2,K133) = +K133*<DMS>*<NO3> - PTERMS(:,4,133) = +TPK%K133(:)*PCONC(:,11)*PCONC(:,5) -! -!PTERMS(NO3,K133) = -K133*<DMS>*<NO3> - PTERMS(:,5,133) = -TPK%K133(:)*PCONC(:,11)*PCONC(:,5) -! -!PTERMS(DMS,K133) = -K133*<DMS>*<NO3> - PTERMS(:,11,133) = -TPK%K133(:)*PCONC(:,11)*PCONC(:,5) -! -!PTERMS(SO2,K133) = +K133*<DMS>*<NO3> - PTERMS(:,12,133) = +TPK%K133(:)*PCONC(:,11)*PCONC(:,5) -! -!PTERMS(DMS,K134) = -K134*<DMS>*<O3P> - PTERMS(:,11,134) = -TPK%K134(:)*PCONC(:,11)*TPK%O3P(:) -! -!PTERMS(SO2,K134) = +K134*<DMS>*<O3P> - PTERMS(:,12,134) = +TPK%K134(:)*PCONC(:,11)*TPK%O3P(:) -! -!PTERMS(DMS,K135) = -K135*<DMS>*<OH> - PTERMS(:,11,135) = -TPK%K135(:)*PCONC(:,11)*PCONC(:,15) -! -!PTERMS(SO2,K135) = +0.8*K135*<DMS>*<OH> - PTERMS(:,12,135) = +0.8*TPK%K135(:)*PCONC(:,11)*PCONC(:,15) -! -!PTERMS(OH,K135) = -K135*<DMS>*<OH> - PTERMS(:,15,135) = -TPK%K135(:)*PCONC(:,11)*PCONC(:,15) -! -! -RETURN -END SUBROUTINE SUBT30 -! -END SUBROUTINE CH_TERMS_GAZ -! -!======================================================================== -! -!! ########################### - MODULE MODI_CH_NONZEROTERMS -!! ########################### -INTERFACE -SUBROUTINE CH_NONZEROTERMS(KMI, KINDEX, KINDEXDIM) -IMPLICIT NONE -INTEGER, INTENT(IN) :: KMI -INTEGER, INTENT(IN) :: KINDEXDIM -INTEGER, INTENT(OUT), DIMENSION(2,KINDEXDIM) :: KINDEX -END SUBROUTINE CH_NONZEROTERMS -END INTERFACE -END MODULE MODI_CH_NONZEROTERMS -! -!======================================================================== -! -!! ################################################## - SUBROUTINE CH_NONZEROTERMS(KMI, KINDEX, KINDEXDIM) -!! ################################################## -!! This code has been created automatically by preprocessor m10, -!! version: 9.7, copyright 1995-1999 by Meteo France/Universite Paul Sabatier. -!! Please report all bugs to K. Suhre (Lab. d'Aerologie UPS/CNRS). -!! -!!*** *MODD_CH_NONZEROTERMS* -!! -!! PURPOSE -!! ------- -! calculation of the contribution of each term in each reaction -!! -!!** METHOD -!! ------ -!! The contribution of reaction i to the evolution of species j -!! is returned in PTERMS. -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Karsten Suhre (LA) -!! -!! MODIFICATIONS -!! ------------- -!! Original 26/07/96 -!! Modified 05/05/98: Vectorization (Vincent Crassier & KS) -!! -!!---------------------------------------------------------------------- -!! -!! EXTERNAL -!! -------- -!! none -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -USE MODD_CH_M9_SCHEME, ONLY : TACCS -!! -!! EXPLICIT ARGUMENTS -!! ------------------ -IMPLICIT NONE -INTEGER, INTENT(IN) :: KMI -INTEGER, INTENT(IN) :: KINDEXDIM -INTEGER, INTENT(OUT), DIMENSION(2,KINDEXDIM) :: KINDEX -IF (TACCS(KMI)%LUSECHAQ) THEN - CALL CH_NONZEROTERMS_AQ -ELSE - CALL CH_NONZEROTERMS_GAZ -END IF -CONTAINS -!! -!! ############################# - SUBROUTINE CH_NONZEROTERMS_AQ -!! ############################# -!! This code has been created automatically by preprocessor m10, -!! version: 9.7, copyright 1995-1999 by Meteo France/Universite Paul Sabatier. -!! Please report all bugs to K. Suhre (Lab. d'Aerologie UPS/CNRS). -!! -!!*** *MODD_CH_NONZEROTERMS* -!! -!! PURPOSE -!! ------- -! calculation of the contribution of each term in each reaction -!! -!!** METHOD -!! ------ -!! The contribution of reaction i to the evolution of species j -!! is returned in PTERMS. -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Karsten Suhre (LA) -!! -!! MODIFICATIONS -!! ------------- -!! Original 26/07/96 -!! Modified 05/05/98: Vectorization (Vincent Crassier & KS) -!! -!!---------------------------------------------------------------------- -!! -!! EXTERNAL -!! -------- -!! none -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! none -!! -!! EXPLICIT ARGUMENTS -!! ------------------ -IMPLICIT NONE -! check if output array is large enough -IF (KINDEXDIM.LT.951) THEN - STOP 'CH_NONZEROTERMS ERROR: array KINDEX is too small!' -END IF - KINDEX(1, 1)=3 - KINDEX(2, 1)=1 - KINDEX(1, 2)=4 - KINDEX(2, 2)=1 - KINDEX(1, 3)=1 - KINDEX(2, 3)=2 - KINDEX(1, 4)=1 - KINDEX(2, 4)=3 - KINDEX(1, 5)=3 - KINDEX(2, 5)=4 - KINDEX(1, 6)=7 - KINDEX(2, 6)=4 - KINDEX(1, 7)=15 - KINDEX(2, 7)=4 - KINDEX(1, 8)=4 - KINDEX(2, 8)=5 - KINDEX(1, 9)=8 - KINDEX(2, 9)=5 - KINDEX(1, 10)=15 - KINDEX(2, 10)=5 - KINDEX(1, 11)=4 - KINDEX(2, 11)=6 - KINDEX(1, 12)=5 - KINDEX(2, 12)=6 - KINDEX(1, 13)=9 - KINDEX(2, 13)=6 - KINDEX(1, 14)=15 - KINDEX(2, 14)=6 - KINDEX(1, 15)=16 - KINDEX(2, 15)=6 - KINDEX(1, 16)=3 - KINDEX(2, 16)=7 - KINDEX(1, 17)=5 - KINDEX(2, 17)=7 - KINDEX(1, 18)=4 - KINDEX(2, 18)=8 - KINDEX(1, 19)=5 - KINDEX(2, 19)=8 - KINDEX(1, 20)=2 - KINDEX(2, 20)=9 - KINDEX(1, 21)=15 - KINDEX(2, 21)=9 - KINDEX(1, 22)=14 - KINDEX(2, 22)=10 - KINDEX(1, 23)=23 - KINDEX(2, 23)=10 - KINDEX(1, 24)=14 - KINDEX(2, 24)=11 - KINDEX(1, 25)=16 - KINDEX(2, 25)=11 - KINDEX(1, 26)=23 - KINDEX(2, 26)=11 - KINDEX(1, 27)=14 - KINDEX(2, 27)=12 - KINDEX(1, 28)=16 - KINDEX(2, 28)=12 - KINDEX(1, 29)=24 - KINDEX(2, 29)=12 - KINDEX(1, 30)=33 - KINDEX(2, 30)=12 - KINDEX(1, 31)=15 - KINDEX(2, 31)=13 - KINDEX(1, 32)=16 - KINDEX(2, 32)=13 - KINDEX(1, 33)=23 - KINDEX(2, 33)=13 - KINDEX(1, 34)=29 - KINDEX(2, 34)=13 - KINDEX(1, 35)=15 - KINDEX(2, 35)=14 - KINDEX(1, 36)=16 - KINDEX(2, 36)=14 - KINDEX(1, 37)=24 - KINDEX(2, 37)=14 - KINDEX(1, 38)=30 - KINDEX(2, 38)=14 - KINDEX(1, 39)=33 - KINDEX(2, 39)=14 - KINDEX(1, 40)=25 - KINDEX(2, 40)=15 - KINDEX(1, 41)=34 - KINDEX(2, 41)=15 - KINDEX(1, 42)=40 - KINDEX(2, 42)=15 - KINDEX(1, 43)=14 - KINDEX(2, 43)=16 - KINDEX(1, 44)=16 - KINDEX(2, 44)=16 - KINDEX(1, 45)=23 - KINDEX(2, 45)=16 - KINDEX(1, 46)=26 - KINDEX(2, 46)=16 - KINDEX(1, 47)=40 - KINDEX(2, 47)=16 - KINDEX(1, 48)=4 - KINDEX(2, 48)=17 - KINDEX(1, 49)=16 - KINDEX(2, 49)=17 - KINDEX(1, 50)=24 - KINDEX(2, 50)=17 - KINDEX(1, 51)=25 - KINDEX(2, 51)=17 - KINDEX(1, 52)=27 - KINDEX(2, 52)=17 - KINDEX(1, 53)=1 - KINDEX(2, 53)=18 - KINDEX(1, 54)=1 - KINDEX(2, 54)=19 - KINDEX(1, 55)=15 - KINDEX(2, 55)=22 - KINDEX(1, 56)=1 - KINDEX(2, 56)=23 - KINDEX(1, 57)=15 - KINDEX(2, 57)=23 - KINDEX(1, 58)=16 - KINDEX(2, 58)=23 - KINDEX(1, 59)=1 - KINDEX(2, 59)=24 - KINDEX(1, 60)=15 - KINDEX(2, 60)=24 - KINDEX(1, 61)=16 - KINDEX(2, 61)=24 - KINDEX(1, 62)=15 - KINDEX(2, 62)=25 - KINDEX(1, 63)=16 - KINDEX(2, 63)=25 - KINDEX(1, 64)=2 - KINDEX(2, 64)=26 - KINDEX(1, 65)=15 - KINDEX(2, 65)=26 - KINDEX(1, 66)=16 - KINDEX(2, 66)=26 - KINDEX(1, 67)=2 - KINDEX(2, 67)=27 - KINDEX(1, 68)=16 - KINDEX(2, 68)=27 - KINDEX(1, 69)=2 - KINDEX(2, 69)=28 - KINDEX(1, 70)=16 - KINDEX(2, 70)=28 - KINDEX(1, 71)=3 - KINDEX(2, 71)=29 - KINDEX(1, 72)=4 - KINDEX(2, 72)=29 - KINDEX(1, 73)=3 - KINDEX(2, 73)=30 - KINDEX(1, 74)=4 - KINDEX(2, 74)=30 - KINDEX(1, 75)=4 - KINDEX(2, 75)=31 - KINDEX(1, 76)=5 - KINDEX(2, 76)=31 - KINDEX(1, 77)=3 - KINDEX(2, 77)=32 - KINDEX(1, 78)=7 - KINDEX(2, 78)=32 - KINDEX(1, 79)=15 - KINDEX(2, 79)=32 - KINDEX(1, 80)=4 - KINDEX(2, 80)=33 - KINDEX(1, 81)=8 - KINDEX(2, 81)=33 - KINDEX(1, 82)=15 - KINDEX(2, 82)=33 - KINDEX(1, 83)=4 - KINDEX(2, 83)=34 - KINDEX(1, 84)=5 - KINDEX(2, 84)=34 - KINDEX(1, 85)=15 - KINDEX(2, 85)=34 - KINDEX(1, 86)=16 - KINDEX(2, 86)=34 - KINDEX(1, 87)=3 - KINDEX(2, 87)=35 - KINDEX(1, 88)=4 - KINDEX(2, 88)=35 - KINDEX(1, 89)=15 - KINDEX(2, 89)=35 - KINDEX(1, 90)=16 - KINDEX(2, 90)=35 - KINDEX(1, 91)=4 - KINDEX(2, 91)=36 - KINDEX(1, 92)=9 - KINDEX(2, 92)=36 - KINDEX(1, 93)=16 - KINDEX(2, 93)=36 - KINDEX(1, 94)=4 - KINDEX(2, 94)=37 - KINDEX(1, 95)=9 - KINDEX(2, 95)=37 - KINDEX(1, 96)=16 - KINDEX(2, 96)=37 - KINDEX(1, 97)=4 - KINDEX(2, 97)=38 - KINDEX(1, 98)=5 - KINDEX(2, 98)=38 - KINDEX(1, 99)=8 - KINDEX(2, 99)=38 - KINDEX(1, 100)=15 - KINDEX(2, 100)=38 - KINDEX(1, 101)=16 - KINDEX(2, 101)=38 - KINDEX(1, 102)=4 - KINDEX(2, 102)=39 - KINDEX(1, 103)=7 - KINDEX(2, 103)=39 - KINDEX(1, 104)=15 - KINDEX(2, 104)=39 - KINDEX(1, 105)=5 - KINDEX(2, 105)=40 - KINDEX(1, 106)=8 - KINDEX(2, 106)=40 - KINDEX(1, 107)=15 - KINDEX(2, 107)=40 - KINDEX(1, 108)=4 - KINDEX(2, 108)=41 - KINDEX(1, 109)=9 - KINDEX(2, 109)=41 - KINDEX(1, 110)=15 - KINDEX(2, 110)=41 - KINDEX(1, 111)=1 - KINDEX(2, 111)=42 - KINDEX(1, 112)=3 - KINDEX(2, 112)=42 - KINDEX(1, 113)=4 - KINDEX(2, 113)=42 - KINDEX(1, 114)=1 - KINDEX(2, 114)=43 - KINDEX(1, 115)=4 - KINDEX(2, 115)=43 - KINDEX(1, 116)=5 - KINDEX(2, 116)=43 - KINDEX(1, 117)=3 - KINDEX(2, 117)=44 - KINDEX(1, 118)=4 - KINDEX(2, 118)=44 - KINDEX(1, 119)=3 - KINDEX(2, 119)=45 - KINDEX(1, 120)=4 - KINDEX(2, 120)=45 - KINDEX(1, 121)=5 - KINDEX(2, 121)=45 - KINDEX(1, 122)=3 - KINDEX(2, 122)=46 - KINDEX(1, 123)=4 - KINDEX(2, 123)=46 - KINDEX(1, 124)=5 - KINDEX(2, 124)=46 - KINDEX(1, 125)=4 - KINDEX(2, 125)=47 - KINDEX(1, 126)=5 - KINDEX(2, 126)=47 - KINDEX(1, 127)=6 - KINDEX(2, 127)=47 - KINDEX(1, 128)=4 - KINDEX(2, 128)=48 - KINDEX(1, 129)=5 - KINDEX(2, 129)=48 - KINDEX(1, 130)=6 - KINDEX(2, 130)=48 - KINDEX(1, 131)=4 - KINDEX(2, 131)=49 - KINDEX(1, 132)=5 - KINDEX(2, 132)=49 - KINDEX(1, 133)=10 - KINDEX(2, 133)=50 - KINDEX(1, 134)=15 - KINDEX(2, 134)=50 - KINDEX(1, 135)=15 - KINDEX(2, 135)=51 - KINDEX(1, 136)=16 - KINDEX(2, 136)=51 - KINDEX(1, 137)=12 - KINDEX(2, 137)=52 - KINDEX(1, 138)=13 - KINDEX(2, 138)=52 - KINDEX(1, 139)=15 - KINDEX(2, 139)=52 - KINDEX(1, 140)=16 - KINDEX(2, 140)=52 - KINDEX(1, 141)=14 - KINDEX(2, 141)=53 - KINDEX(1, 142)=15 - KINDEX(2, 142)=53 - KINDEX(1, 143)=16 - KINDEX(2, 143)=53 - KINDEX(1, 144)=14 - KINDEX(2, 144)=54 - KINDEX(1, 145)=15 - KINDEX(2, 145)=54 - KINDEX(1, 146)=16 - KINDEX(2, 146)=54 - KINDEX(1, 147)=20 - KINDEX(2, 147)=54 - KINDEX(1, 148)=21 - KINDEX(2, 148)=54 - KINDEX(1, 149)=23 - KINDEX(2, 149)=54 - KINDEX(1, 150)=26 - KINDEX(2, 150)=54 - KINDEX(1, 151)=42 - KINDEX(2, 151)=54 - KINDEX(1, 152)=24 - KINDEX(2, 152)=55 - KINDEX(1, 153)=26 - KINDEX(2, 153)=55 - KINDEX(1, 154)=15 - KINDEX(2, 154)=56 - KINDEX(1, 155)=17 - KINDEX(2, 155)=56 - KINDEX(1, 156)=33 - KINDEX(2, 156)=56 - KINDEX(1, 157)=15 - KINDEX(2, 157)=57 - KINDEX(1, 158)=18 - KINDEX(2, 158)=57 - KINDEX(1, 159)=34 - KINDEX(2, 159)=57 - KINDEX(1, 160)=14 - KINDEX(2, 160)=58 - KINDEX(1, 161)=15 - KINDEX(2, 161)=58 - KINDEX(1, 162)=16 - KINDEX(2, 162)=58 - KINDEX(1, 163)=19 - KINDEX(2, 163)=58 - KINDEX(1, 164)=23 - KINDEX(2, 164)=58 - KINDEX(1, 165)=24 - KINDEX(2, 165)=58 - KINDEX(1, 166)=25 - KINDEX(2, 166)=58 - KINDEX(1, 167)=26 - KINDEX(2, 167)=58 - KINDEX(1, 168)=31 - KINDEX(2, 168)=58 - KINDEX(1, 169)=34 - KINDEX(2, 169)=58 - KINDEX(1, 170)=15 - KINDEX(2, 170)=59 - KINDEX(1, 171)=20 - KINDEX(2, 171)=59 - KINDEX(1, 172)=35 - KINDEX(2, 172)=59 - KINDEX(1, 173)=36 - KINDEX(2, 173)=59 - KINDEX(1, 174)=15 - KINDEX(2, 174)=60 - KINDEX(1, 175)=21 - KINDEX(2, 175)=60 - KINDEX(1, 176)=36 - KINDEX(2, 176)=60 - KINDEX(1, 177)=15 - KINDEX(2, 177)=61 - KINDEX(1, 178)=16 - KINDEX(2, 178)=61 - KINDEX(1, 179)=22 - KINDEX(2, 179)=61 - KINDEX(1, 180)=37 - KINDEX(2, 180)=61 - KINDEX(1, 181)=38 - KINDEX(2, 181)=61 - KINDEX(1, 182)=42 - KINDEX(2, 182)=61 - KINDEX(1, 183)=14 - KINDEX(2, 183)=62 - KINDEX(1, 184)=15 - KINDEX(2, 184)=62 - KINDEX(1, 185)=16 - KINDEX(2, 185)=62 - KINDEX(1, 186)=23 - KINDEX(2, 186)=62 - KINDEX(1, 187)=15 - KINDEX(2, 187)=63 - KINDEX(1, 188)=24 - KINDEX(2, 188)=63 - KINDEX(1, 189)=40 - KINDEX(2, 189)=63 - KINDEX(1, 190)=15 - KINDEX(2, 190)=64 - KINDEX(1, 191)=25 - KINDEX(2, 191)=64 - KINDEX(1, 192)=40 - KINDEX(2, 192)=64 - KINDEX(1, 193)=14 - KINDEX(2, 193)=65 - KINDEX(1, 194)=15 - KINDEX(2, 194)=65 - KINDEX(1, 195)=16 - KINDEX(2, 195)=65 - KINDEX(1, 196)=23 - KINDEX(2, 196)=65 - KINDEX(1, 197)=24 - KINDEX(2, 197)=65 - KINDEX(1, 198)=25 - KINDEX(2, 198)=65 - KINDEX(1, 199)=26 - KINDEX(2, 199)=65 - KINDEX(1, 200)=40 - KINDEX(2, 200)=65 - KINDEX(1, 201)=42 - KINDEX(2, 201)=65 - KINDEX(1, 202)=15 - KINDEX(2, 202)=66 - KINDEX(1, 203)=16 - KINDEX(2, 203)=66 - KINDEX(1, 204)=31 - KINDEX(2, 204)=66 - KINDEX(1, 205)=15 - KINDEX(2, 205)=67 - KINDEX(1, 206)=32 - KINDEX(2, 206)=67 - KINDEX(1, 207)=15 - KINDEX(2, 207)=68 - KINDEX(1, 208)=23 - KINDEX(2, 208)=68 - KINDEX(1, 209)=29 - KINDEX(2, 209)=68 - KINDEX(1, 210)=33 - KINDEX(2, 210)=68 - KINDEX(1, 211)=15 - KINDEX(2, 211)=69 - KINDEX(1, 212)=16 - KINDEX(2, 212)=69 - KINDEX(1, 213)=23 - KINDEX(2, 213)=69 - KINDEX(1, 214)=24 - KINDEX(2, 214)=69 - KINDEX(1, 215)=25 - KINDEX(2, 215)=69 - KINDEX(1, 216)=30 - KINDEX(2, 216)=69 - KINDEX(1, 217)=34 - KINDEX(2, 217)=69 - KINDEX(1, 218)=40 - KINDEX(2, 218)=69 - KINDEX(1, 219)=42 - KINDEX(2, 219)=69 - KINDEX(1, 220)=5 - KINDEX(2, 220)=70 - KINDEX(1, 221)=15 - KINDEX(2, 221)=70 - KINDEX(1, 222)=16 - KINDEX(2, 222)=70 - KINDEX(1, 223)=23 - KINDEX(2, 223)=70 - KINDEX(1, 224)=26 - KINDEX(2, 224)=70 - KINDEX(1, 225)=28 - KINDEX(2, 225)=70 - KINDEX(1, 226)=42 - KINDEX(2, 226)=70 - KINDEX(1, 227)=4 - KINDEX(2, 227)=71 - KINDEX(1, 228)=15 - KINDEX(2, 228)=71 - KINDEX(1, 229)=27 - KINDEX(2, 229)=71 - KINDEX(1, 230)=34 - KINDEX(2, 230)=71 - KINDEX(1, 231)=5 - KINDEX(2, 231)=72 - KINDEX(1, 232)=8 - KINDEX(2, 232)=72 - KINDEX(1, 233)=14 - KINDEX(2, 233)=72 - KINDEX(1, 234)=16 - KINDEX(2, 234)=72 - KINDEX(1, 235)=23 - KINDEX(2, 235)=72 - KINDEX(1, 236)=5 - KINDEX(2, 236)=73 - KINDEX(1, 237)=8 - KINDEX(2, 237)=73 - KINDEX(1, 238)=24 - KINDEX(2, 238)=73 - KINDEX(1, 239)=40 - KINDEX(2, 239)=73 - KINDEX(1, 240)=4 - KINDEX(2, 240)=74 - KINDEX(1, 241)=5 - KINDEX(2, 241)=74 - KINDEX(1, 242)=8 - KINDEX(2, 242)=74 - KINDEX(1, 243)=14 - KINDEX(2, 243)=74 - KINDEX(1, 244)=16 - KINDEX(2, 244)=74 - KINDEX(1, 245)=24 - KINDEX(2, 245)=74 - KINDEX(1, 246)=25 - KINDEX(2, 246)=74 - KINDEX(1, 247)=26 - KINDEX(2, 247)=74 - KINDEX(1, 248)=40 - KINDEX(2, 248)=74 - KINDEX(1, 249)=41 - KINDEX(2, 249)=74 - KINDEX(1, 250)=42 - KINDEX(2, 250)=74 - KINDEX(1, 251)=5 - KINDEX(2, 251)=75 - KINDEX(1, 252)=8 - KINDEX(2, 252)=75 - KINDEX(1, 253)=22 - KINDEX(2, 253)=75 - KINDEX(1, 254)=37 - KINDEX(2, 254)=75 - KINDEX(1, 255)=5 - KINDEX(2, 255)=76 - KINDEX(1, 256)=20 - KINDEX(2, 256)=76 - KINDEX(1, 257)=26 - KINDEX(2, 257)=76 - KINDEX(1, 258)=41 - KINDEX(2, 258)=76 - KINDEX(1, 259)=5 - KINDEX(2, 259)=77 - KINDEX(1, 260)=21 - KINDEX(2, 260)=77 - KINDEX(1, 261)=26 - KINDEX(2, 261)=77 - KINDEX(1, 262)=41 - KINDEX(2, 262)=77 - KINDEX(1, 263)=4 - KINDEX(2, 263)=78 - KINDEX(1, 264)=5 - KINDEX(2, 264)=78 - KINDEX(1, 265)=23 - KINDEX(2, 265)=78 - KINDEX(1, 266)=27 - KINDEX(2, 266)=78 - KINDEX(1, 267)=28 - KINDEX(2, 267)=78 - KINDEX(1, 268)=42 - KINDEX(2, 268)=78 - KINDEX(1, 269)=1 - KINDEX(2, 269)=79 - KINDEX(1, 270)=2 - KINDEX(2, 270)=79 - KINDEX(1, 271)=14 - KINDEX(2, 271)=79 - KINDEX(1, 272)=15 - KINDEX(2, 272)=79 - KINDEX(1, 273)=16 - KINDEX(2, 273)=79 - KINDEX(1, 274)=17 - KINDEX(2, 274)=79 - KINDEX(1, 275)=18 - KINDEX(2, 275)=79 - KINDEX(1, 276)=20 - KINDEX(2, 276)=79 - KINDEX(1, 277)=23 - KINDEX(2, 277)=79 - KINDEX(1, 278)=24 - KINDEX(2, 278)=79 - KINDEX(1, 279)=25 - KINDEX(2, 279)=79 - KINDEX(1, 280)=26 - KINDEX(2, 280)=79 - KINDEX(1, 281)=31 - KINDEX(2, 281)=79 - KINDEX(1, 282)=32 - KINDEX(2, 282)=79 - KINDEX(1, 283)=33 - KINDEX(2, 283)=79 - KINDEX(1, 284)=34 - KINDEX(2, 284)=79 - KINDEX(1, 285)=40 - KINDEX(2, 285)=79 - KINDEX(1, 286)=42 - KINDEX(2, 286)=79 - KINDEX(1, 287)=1 - KINDEX(2, 287)=80 - KINDEX(1, 288)=2 - KINDEX(2, 288)=80 - KINDEX(1, 289)=14 - KINDEX(2, 289)=80 - KINDEX(1, 290)=15 - KINDEX(2, 290)=80 - KINDEX(1, 291)=16 - KINDEX(2, 291)=80 - KINDEX(1, 292)=20 - KINDEX(2, 292)=80 - KINDEX(1, 293)=21 - KINDEX(2, 293)=80 - KINDEX(1, 294)=23 - KINDEX(2, 294)=80 - KINDEX(1, 295)=24 - KINDEX(2, 295)=80 - KINDEX(1, 296)=25 - KINDEX(2, 296)=80 - KINDEX(1, 297)=26 - KINDEX(2, 297)=80 - KINDEX(1, 298)=31 - KINDEX(2, 298)=80 - KINDEX(1, 299)=32 - KINDEX(2, 299)=80 - KINDEX(1, 300)=33 - KINDEX(2, 300)=80 - KINDEX(1, 301)=34 - KINDEX(2, 301)=80 - KINDEX(1, 302)=40 - KINDEX(2, 302)=80 - KINDEX(1, 303)=42 - KINDEX(2, 303)=80 - KINDEX(1, 304)=1 - KINDEX(2, 304)=81 - KINDEX(1, 305)=14 - KINDEX(2, 305)=81 - KINDEX(1, 306)=15 - KINDEX(2, 306)=81 - KINDEX(1, 307)=16 - KINDEX(2, 307)=81 - KINDEX(1, 308)=23 - KINDEX(2, 308)=81 - KINDEX(1, 309)=24 - KINDEX(2, 309)=81 - KINDEX(1, 310)=26 - KINDEX(2, 310)=81 - KINDEX(1, 311)=30 - KINDEX(2, 311)=81 - KINDEX(1, 312)=31 - KINDEX(2, 312)=81 - KINDEX(1, 313)=32 - KINDEX(2, 313)=81 - KINDEX(1, 314)=40 - KINDEX(2, 314)=81 - KINDEX(1, 315)=1 - KINDEX(2, 315)=82 - KINDEX(1, 316)=4 - KINDEX(2, 316)=82 - KINDEX(1, 317)=14 - KINDEX(2, 317)=82 - KINDEX(1, 318)=15 - KINDEX(2, 318)=82 - KINDEX(1, 319)=16 - KINDEX(2, 319)=82 - KINDEX(1, 320)=23 - KINDEX(2, 320)=82 - KINDEX(1, 321)=28 - KINDEX(2, 321)=82 - KINDEX(1, 322)=31 - KINDEX(2, 322)=82 - KINDEX(1, 323)=40 - KINDEX(2, 323)=82 - KINDEX(1, 324)=4 - KINDEX(2, 324)=83 - KINDEX(1, 325)=22 - KINDEX(2, 325)=83 - KINDEX(1, 326)=27 - KINDEX(2, 326)=83 - KINDEX(1, 327)=37 - KINDEX(2, 327)=83 - KINDEX(1, 328)=16 - KINDEX(2, 328)=84 - KINDEX(1, 329)=22 - KINDEX(2, 329)=84 - KINDEX(1, 330)=37 - KINDEX(2, 330)=84 - KINDEX(1, 331)=4 - KINDEX(2, 331)=85 - KINDEX(1, 332)=7 - KINDEX(2, 332)=85 - KINDEX(1, 333)=22 - KINDEX(2, 333)=85 - KINDEX(1, 334)=38 - KINDEX(2, 334)=85 - KINDEX(1, 335)=16 - KINDEX(2, 335)=86 - KINDEX(1, 336)=22 - KINDEX(2, 336)=86 - KINDEX(1, 337)=38 - KINDEX(2, 337)=86 - KINDEX(1, 338)=39 - KINDEX(2, 338)=86 - KINDEX(1, 339)=1 - KINDEX(2, 339)=87 - KINDEX(1, 340)=15 - KINDEX(2, 340)=87 - KINDEX(1, 341)=22 - KINDEX(2, 341)=87 - KINDEX(1, 342)=38 - KINDEX(2, 342)=87 - KINDEX(1, 343)=4 - KINDEX(2, 343)=88 - KINDEX(1, 344)=28 - KINDEX(2, 344)=88 - KINDEX(1, 345)=40 - KINDEX(2, 345)=88 - KINDEX(1, 346)=4 - KINDEX(2, 346)=89 - KINDEX(1, 347)=28 - KINDEX(2, 347)=89 - KINDEX(1, 348)=40 - KINDEX(2, 348)=89 - KINDEX(1, 349)=3 - KINDEX(2, 349)=90 - KINDEX(1, 350)=4 - KINDEX(2, 350)=90 - KINDEX(1, 351)=16 - KINDEX(2, 351)=90 - KINDEX(1, 352)=23 - KINDEX(2, 352)=90 - KINDEX(1, 353)=33 - KINDEX(2, 353)=90 - KINDEX(1, 354)=3 - KINDEX(2, 354)=91 - KINDEX(1, 355)=4 - KINDEX(2, 355)=91 - KINDEX(1, 356)=16 - KINDEX(2, 356)=91 - KINDEX(1, 357)=23 - KINDEX(2, 357)=91 - KINDEX(1, 358)=24 - KINDEX(2, 358)=91 - KINDEX(1, 359)=25 - KINDEX(2, 359)=91 - KINDEX(1, 360)=26 - KINDEX(2, 360)=91 - KINDEX(1, 361)=27 - KINDEX(2, 361)=91 - KINDEX(1, 362)=33 - KINDEX(2, 362)=91 - KINDEX(1, 363)=34 - KINDEX(2, 363)=91 - KINDEX(1, 364)=42 - KINDEX(2, 364)=91 - KINDEX(1, 365)=3 - KINDEX(2, 365)=92 - KINDEX(1, 366)=4 - KINDEX(2, 366)=92 - KINDEX(1, 367)=16 - KINDEX(2, 367)=92 - KINDEX(1, 368)=23 - KINDEX(2, 368)=92 - KINDEX(1, 369)=24 - KINDEX(2, 369)=92 - KINDEX(1, 370)=25 - KINDEX(2, 370)=92 - KINDEX(1, 371)=35 - KINDEX(2, 371)=92 - KINDEX(1, 372)=3 - KINDEX(2, 372)=93 - KINDEX(1, 373)=4 - KINDEX(2, 373)=93 - KINDEX(1, 374)=16 - KINDEX(2, 374)=93 - KINDEX(1, 375)=20 - KINDEX(2, 375)=93 - KINDEX(1, 376)=23 - KINDEX(2, 376)=93 - KINDEX(1, 377)=24 - KINDEX(2, 377)=93 - KINDEX(1, 378)=25 - KINDEX(2, 378)=93 - KINDEX(1, 379)=26 - KINDEX(2, 379)=93 - KINDEX(1, 380)=27 - KINDEX(2, 380)=93 - KINDEX(1, 381)=36 - KINDEX(2, 381)=93 - KINDEX(1, 382)=3 - KINDEX(2, 382)=94 - KINDEX(1, 383)=4 - KINDEX(2, 383)=94 - KINDEX(1, 384)=16 - KINDEX(2, 384)=94 - KINDEX(1, 385)=26 - KINDEX(2, 385)=94 - KINDEX(1, 386)=27 - KINDEX(2, 386)=94 - KINDEX(1, 387)=39 - KINDEX(2, 387)=94 - KINDEX(1, 388)=3 - KINDEX(2, 388)=95 - KINDEX(1, 389)=4 - KINDEX(2, 389)=95 - KINDEX(1, 390)=16 - KINDEX(2, 390)=95 - KINDEX(1, 391)=23 - KINDEX(2, 391)=95 - KINDEX(1, 392)=24 - KINDEX(2, 392)=95 - KINDEX(1, 393)=26 - KINDEX(2, 393)=95 - KINDEX(1, 394)=33 - KINDEX(2, 394)=95 - KINDEX(1, 395)=40 - KINDEX(2, 395)=95 - KINDEX(1, 396)=42 - KINDEX(2, 396)=95 - KINDEX(1, 397)=3 - KINDEX(2, 397)=96 - KINDEX(1, 398)=4 - KINDEX(2, 398)=96 - KINDEX(1, 399)=16 - KINDEX(2, 399)=96 - KINDEX(1, 400)=23 - KINDEX(2, 400)=96 - KINDEX(1, 401)=24 - KINDEX(2, 401)=96 - KINDEX(1, 402)=25 - KINDEX(2, 402)=96 - KINDEX(1, 403)=27 - KINDEX(2, 403)=96 - KINDEX(1, 404)=41 - KINDEX(2, 404)=96 - KINDEX(1, 405)=16 - KINDEX(2, 405)=97 - KINDEX(1, 406)=29 - KINDEX(2, 406)=97 - KINDEX(1, 407)=33 - KINDEX(2, 407)=97 - KINDEX(1, 408)=16 - KINDEX(2, 408)=98 - KINDEX(1, 409)=30 - KINDEX(2, 409)=98 - KINDEX(1, 410)=34 - KINDEX(2, 410)=98 - KINDEX(1, 411)=16 - KINDEX(2, 411)=99 - KINDEX(1, 412)=30 - KINDEX(2, 412)=99 - KINDEX(1, 413)=35 - KINDEX(2, 413)=99 - KINDEX(1, 414)=16 - KINDEX(2, 414)=100 - KINDEX(1, 415)=30 - KINDEX(2, 415)=100 - KINDEX(1, 416)=36 - KINDEX(2, 416)=100 - KINDEX(1, 417)=16 - KINDEX(2, 417)=101 - KINDEX(1, 418)=30 - KINDEX(2, 418)=101 - KINDEX(1, 419)=39 - KINDEX(2, 419)=101 - KINDEX(1, 420)=1 - KINDEX(2, 420)=102 - KINDEX(1, 421)=16 - KINDEX(2, 421)=102 - KINDEX(1, 422)=30 - KINDEX(2, 422)=102 - KINDEX(1, 423)=32 - KINDEX(2, 423)=102 - KINDEX(1, 424)=40 - KINDEX(2, 424)=102 - KINDEX(1, 425)=16 - KINDEX(2, 425)=103 - KINDEX(1, 426)=27 - KINDEX(2, 426)=103 - KINDEX(1, 427)=41 - KINDEX(2, 427)=103 - KINDEX(1, 428)=16 - KINDEX(2, 428)=104 - KINDEX(1, 429)=23 - KINDEX(2, 429)=104 - KINDEX(1, 430)=33 - KINDEX(2, 430)=104 - KINDEX(1, 431)=16 - KINDEX(2, 431)=105 - KINDEX(1, 432)=23 - KINDEX(2, 432)=105 - KINDEX(1, 433)=24 - KINDEX(2, 433)=105 - KINDEX(1, 434)=25 - KINDEX(2, 434)=105 - KINDEX(1, 435)=26 - KINDEX(2, 435)=105 - KINDEX(1, 436)=33 - KINDEX(2, 436)=105 - KINDEX(1, 437)=34 - KINDEX(2, 437)=105 - KINDEX(1, 438)=42 - KINDEX(2, 438)=105 - KINDEX(1, 439)=16 - KINDEX(2, 439)=106 - KINDEX(1, 440)=23 - KINDEX(2, 440)=106 - KINDEX(1, 441)=24 - KINDEX(2, 441)=106 - KINDEX(1, 442)=25 - KINDEX(2, 442)=106 - KINDEX(1, 443)=33 - KINDEX(2, 443)=106 - KINDEX(1, 444)=35 - KINDEX(2, 444)=106 - KINDEX(1, 445)=16 - KINDEX(2, 445)=107 - KINDEX(1, 446)=20 - KINDEX(2, 446)=107 - KINDEX(1, 447)=23 - KINDEX(2, 447)=107 - KINDEX(1, 448)=24 - KINDEX(2, 448)=107 - KINDEX(1, 449)=25 - KINDEX(2, 449)=107 - KINDEX(1, 450)=26 - KINDEX(2, 450)=107 - KINDEX(1, 451)=33 - KINDEX(2, 451)=107 - KINDEX(1, 452)=36 - KINDEX(2, 452)=107 - KINDEX(1, 453)=16 - KINDEX(2, 453)=108 - KINDEX(1, 454)=23 - KINDEX(2, 454)=108 - KINDEX(1, 455)=26 - KINDEX(2, 455)=108 - KINDEX(1, 456)=33 - KINDEX(2, 456)=108 - KINDEX(1, 457)=39 - KINDEX(2, 457)=108 - KINDEX(1, 458)=16 - KINDEX(2, 458)=109 - KINDEX(1, 459)=23 - KINDEX(2, 459)=109 - KINDEX(1, 460)=24 - KINDEX(2, 460)=109 - KINDEX(1, 461)=26 - KINDEX(2, 461)=109 - KINDEX(1, 462)=32 - KINDEX(2, 462)=109 - KINDEX(1, 463)=33 - KINDEX(2, 463)=109 - KINDEX(1, 464)=40 - KINDEX(2, 464)=109 - KINDEX(1, 465)=42 - KINDEX(2, 465)=109 - KINDEX(1, 466)=4 - KINDEX(2, 466)=110 - KINDEX(1, 467)=16 - KINDEX(2, 467)=110 - KINDEX(1, 468)=23 - KINDEX(2, 468)=110 - KINDEX(1, 469)=24 - KINDEX(2, 469)=110 - KINDEX(1, 470)=25 - KINDEX(2, 470)=110 - KINDEX(1, 471)=27 - KINDEX(2, 471)=110 - KINDEX(1, 472)=33 - KINDEX(2, 472)=110 - KINDEX(1, 473)=41 - KINDEX(2, 473)=110 - KINDEX(1, 474)=16 - KINDEX(2, 474)=111 - KINDEX(1, 475)=23 - KINDEX(2, 475)=111 - KINDEX(1, 476)=24 - KINDEX(2, 476)=111 - KINDEX(1, 477)=25 - KINDEX(2, 477)=111 - KINDEX(1, 478)=26 - KINDEX(2, 478)=111 - KINDEX(1, 479)=32 - KINDEX(2, 479)=111 - KINDEX(1, 480)=33 - KINDEX(2, 480)=111 - KINDEX(1, 481)=34 - KINDEX(2, 481)=111 - KINDEX(1, 482)=40 - KINDEX(2, 482)=111 - KINDEX(1, 483)=42 - KINDEX(2, 483)=111 - KINDEX(1, 484)=16 - KINDEX(2, 484)=112 - KINDEX(1, 485)=23 - KINDEX(2, 485)=112 - KINDEX(1, 486)=24 - KINDEX(2, 486)=112 - KINDEX(1, 487)=25 - KINDEX(2, 487)=112 - KINDEX(1, 488)=32 - KINDEX(2, 488)=112 - KINDEX(1, 489)=33 - KINDEX(2, 489)=112 - KINDEX(1, 490)=35 - KINDEX(2, 490)=112 - KINDEX(1, 491)=40 - KINDEX(2, 491)=112 - KINDEX(1, 492)=16 - KINDEX(2, 492)=113 - KINDEX(1, 493)=20 - KINDEX(2, 493)=113 - KINDEX(1, 494)=23 - KINDEX(2, 494)=113 - KINDEX(1, 495)=24 - KINDEX(2, 495)=113 - KINDEX(1, 496)=25 - KINDEX(2, 496)=113 - KINDEX(1, 497)=26 - KINDEX(2, 497)=113 - KINDEX(1, 498)=32 - KINDEX(2, 498)=113 - KINDEX(1, 499)=33 - KINDEX(2, 499)=113 - KINDEX(1, 500)=36 - KINDEX(2, 500)=113 - KINDEX(1, 501)=40 - KINDEX(2, 501)=113 - KINDEX(1, 502)=16 - KINDEX(2, 502)=114 - KINDEX(1, 503)=26 - KINDEX(2, 503)=114 - KINDEX(1, 504)=33 - KINDEX(2, 504)=114 - KINDEX(1, 505)=39 - KINDEX(2, 505)=114 - KINDEX(1, 506)=40 - KINDEX(2, 506)=114 - KINDEX(1, 507)=16 - KINDEX(2, 507)=115 - KINDEX(1, 508)=23 - KINDEX(2, 508)=115 - KINDEX(1, 509)=24 - KINDEX(2, 509)=115 - KINDEX(1, 510)=25 - KINDEX(2, 510)=115 - KINDEX(1, 511)=26 - KINDEX(2, 511)=115 - KINDEX(1, 512)=32 - KINDEX(2, 512)=115 - KINDEX(1, 513)=33 - KINDEX(2, 513)=115 - KINDEX(1, 514)=40 - KINDEX(2, 514)=115 - KINDEX(1, 515)=42 - KINDEX(2, 515)=115 - KINDEX(1, 516)=4 - KINDEX(2, 516)=116 - KINDEX(1, 517)=16 - KINDEX(2, 517)=116 - KINDEX(1, 518)=23 - KINDEX(2, 518)=116 - KINDEX(1, 519)=24 - KINDEX(2, 519)=116 - KINDEX(1, 520)=25 - KINDEX(2, 520)=116 - KINDEX(1, 521)=27 - KINDEX(2, 521)=116 - KINDEX(1, 522)=32 - KINDEX(2, 522)=116 - KINDEX(1, 523)=33 - KINDEX(2, 523)=116 - KINDEX(1, 524)=40 - KINDEX(2, 524)=116 - KINDEX(1, 525)=41 - KINDEX(2, 525)=116 - KINDEX(1, 526)=16 - KINDEX(2, 526)=117 - KINDEX(1, 527)=27 - KINDEX(2, 527)=117 - KINDEX(1, 528)=41 - KINDEX(2, 528)=117 - KINDEX(1, 529)=4 - KINDEX(2, 529)=118 - KINDEX(1, 530)=16 - KINDEX(2, 530)=118 - KINDEX(1, 531)=23 - KINDEX(2, 531)=118 - KINDEX(1, 532)=24 - KINDEX(2, 532)=118 - KINDEX(1, 533)=25 - KINDEX(2, 533)=118 - KINDEX(1, 534)=27 - KINDEX(2, 534)=118 - KINDEX(1, 535)=41 - KINDEX(2, 535)=118 - KINDEX(1, 536)=4 - KINDEX(2, 536)=119 - KINDEX(1, 537)=5 - KINDEX(2, 537)=119 - KINDEX(1, 538)=16 - KINDEX(2, 538)=119 - KINDEX(1, 539)=23 - KINDEX(2, 539)=119 - KINDEX(1, 540)=33 - KINDEX(2, 540)=119 - KINDEX(1, 541)=4 - KINDEX(2, 541)=120 - KINDEX(1, 542)=5 - KINDEX(2, 542)=120 - KINDEX(1, 543)=16 - KINDEX(2, 543)=120 - KINDEX(1, 544)=23 - KINDEX(2, 544)=120 - KINDEX(1, 545)=24 - KINDEX(2, 545)=120 - KINDEX(1, 546)=25 - KINDEX(2, 546)=120 - KINDEX(1, 547)=26 - KINDEX(2, 547)=120 - KINDEX(1, 548)=33 - KINDEX(2, 548)=120 - KINDEX(1, 549)=34 - KINDEX(2, 549)=120 - KINDEX(1, 550)=42 - KINDEX(2, 550)=120 - KINDEX(1, 551)=4 - KINDEX(2, 551)=121 - KINDEX(1, 552)=5 - KINDEX(2, 552)=121 - KINDEX(1, 553)=16 - KINDEX(2, 553)=121 - KINDEX(1, 554)=23 - KINDEX(2, 554)=121 - KINDEX(1, 555)=24 - KINDEX(2, 555)=121 - KINDEX(1, 556)=25 - KINDEX(2, 556)=121 - KINDEX(1, 557)=35 - KINDEX(2, 557)=121 - KINDEX(1, 558)=4 - KINDEX(2, 558)=122 - KINDEX(1, 559)=5 - KINDEX(2, 559)=122 - KINDEX(1, 560)=16 - KINDEX(2, 560)=122 - KINDEX(1, 561)=20 - KINDEX(2, 561)=122 - KINDEX(1, 562)=23 - KINDEX(2, 562)=122 - KINDEX(1, 563)=24 - KINDEX(2, 563)=122 - KINDEX(1, 564)=25 - KINDEX(2, 564)=122 - KINDEX(1, 565)=26 - KINDEX(2, 565)=122 - KINDEX(1, 566)=36 - KINDEX(2, 566)=122 - KINDEX(1, 567)=4 - KINDEX(2, 567)=123 - KINDEX(1, 568)=5 - KINDEX(2, 568)=123 - KINDEX(1, 569)=16 - KINDEX(2, 569)=123 - KINDEX(1, 570)=26 - KINDEX(2, 570)=123 - KINDEX(1, 571)=39 - KINDEX(2, 571)=123 - KINDEX(1, 572)=4 - KINDEX(2, 572)=124 - KINDEX(1, 573)=5 - KINDEX(2, 573)=124 - KINDEX(1, 574)=16 - KINDEX(2, 574)=124 - KINDEX(1, 575)=23 - KINDEX(2, 575)=124 - KINDEX(1, 576)=24 - KINDEX(2, 576)=124 - KINDEX(1, 577)=26 - KINDEX(2, 577)=124 - KINDEX(1, 578)=33 - KINDEX(2, 578)=124 - KINDEX(1, 579)=40 - KINDEX(2, 579)=124 - KINDEX(1, 580)=42 - KINDEX(2, 580)=124 - KINDEX(1, 581)=4 - KINDEX(2, 581)=125 - KINDEX(1, 582)=5 - KINDEX(2, 582)=125 - KINDEX(1, 583)=16 - KINDEX(2, 583)=125 - KINDEX(1, 584)=23 - KINDEX(2, 584)=125 - KINDEX(1, 585)=24 - KINDEX(2, 585)=125 - KINDEX(1, 586)=25 - KINDEX(2, 586)=125 - KINDEX(1, 587)=27 - KINDEX(2, 587)=125 - KINDEX(1, 588)=41 - KINDEX(2, 588)=125 - KINDEX(1, 589)=16 - KINDEX(2, 589)=126 - KINDEX(1, 590)=30 - KINDEX(2, 590)=126 - KINDEX(1, 591)=42 - KINDEX(2, 591)=126 - KINDEX(1, 592)=16 - KINDEX(2, 592)=127 - KINDEX(1, 593)=23 - KINDEX(2, 593)=127 - KINDEX(1, 594)=33 - KINDEX(2, 594)=127 - KINDEX(1, 595)=42 - KINDEX(2, 595)=127 - KINDEX(1, 596)=33 - KINDEX(2, 596)=128 - KINDEX(1, 597)=40 - KINDEX(2, 597)=128 - KINDEX(1, 598)=42 - KINDEX(2, 598)=128 - KINDEX(1, 599)=42 - KINDEX(2, 599)=129 - KINDEX(1, 600)=3 - KINDEX(2, 600)=130 - KINDEX(1, 601)=4 - KINDEX(2, 601)=130 - KINDEX(1, 602)=42 - KINDEX(2, 602)=130 - KINDEX(1, 603)=4 - KINDEX(2, 603)=131 - KINDEX(1, 604)=5 - KINDEX(2, 604)=131 - KINDEX(1, 605)=42 - KINDEX(2, 605)=131 - KINDEX(1, 606)=13 - KINDEX(2, 606)=132 - KINDEX(1, 607)=4 - KINDEX(2, 607)=133 - KINDEX(1, 608)=5 - KINDEX(2, 608)=133 - KINDEX(1, 609)=11 - KINDEX(2, 609)=133 - KINDEX(1, 610)=12 - KINDEX(2, 610)=133 - KINDEX(1, 611)=11 - KINDEX(2, 611)=134 - KINDEX(1, 612)=12 - KINDEX(2, 612)=134 - KINDEX(1, 613)=11 - KINDEX(2, 613)=135 - KINDEX(1, 614)=12 - KINDEX(2, 614)=135 - KINDEX(1, 615)=15 - KINDEX(2, 615)=135 - KINDEX(1, 616)=1 - KINDEX(2, 616)=136 - KINDEX(1, 617)=43 - KINDEX(2, 617)=136 - KINDEX(1, 618)=2 - KINDEX(2, 618)=137 - KINDEX(1, 619)=44 - KINDEX(2, 619)=137 - KINDEX(1, 620)=3 - KINDEX(2, 620)=138 - KINDEX(1, 621)=45 - KINDEX(2, 621)=138 - KINDEX(1, 622)=4 - KINDEX(2, 622)=139 - KINDEX(1, 623)=46 - KINDEX(2, 623)=139 - KINDEX(1, 624)=5 - KINDEX(2, 624)=140 - KINDEX(1, 625)=47 - KINDEX(2, 625)=140 - KINDEX(1, 626)=6 - KINDEX(2, 626)=141 - KINDEX(1, 627)=48 - KINDEX(2, 627)=141 - KINDEX(1, 628)=7 - KINDEX(2, 628)=142 - KINDEX(1, 629)=49 - KINDEX(2, 629)=142 - KINDEX(1, 630)=8 - KINDEX(2, 630)=143 - KINDEX(1, 631)=50 - KINDEX(2, 631)=143 - KINDEX(1, 632)=9 - KINDEX(2, 632)=144 - KINDEX(1, 633)=51 - KINDEX(2, 633)=144 - KINDEX(1, 634)=10 - KINDEX(2, 634)=145 - KINDEX(1, 635)=52 - KINDEX(2, 635)=145 - KINDEX(1, 636)=15 - KINDEX(2, 636)=146 - KINDEX(1, 637)=53 - KINDEX(2, 637)=146 - KINDEX(1, 638)=16 - KINDEX(2, 638)=147 - KINDEX(1, 639)=54 - KINDEX(2, 639)=147 - KINDEX(1, 640)=55 - KINDEX(2, 640)=148 - KINDEX(1, 641)=12 - KINDEX(2, 641)=149 - KINDEX(1, 642)=56 - KINDEX(2, 642)=149 - KINDEX(1, 643)=13 - KINDEX(2, 643)=150 - KINDEX(1, 644)=57 - KINDEX(2, 644)=150 - KINDEX(1, 645)=23 - KINDEX(2, 645)=151 - KINDEX(1, 646)=58 - KINDEX(2, 646)=151 - KINDEX(1, 647)=31 - KINDEX(2, 647)=152 - KINDEX(1, 648)=59 - KINDEX(2, 648)=152 - KINDEX(1, 649)=32 - KINDEX(2, 649)=153 - KINDEX(1, 650)=60 - KINDEX(2, 650)=153 - KINDEX(1, 651)=33 - KINDEX(2, 651)=154 - KINDEX(1, 652)=61 - KINDEX(2, 652)=154 - KINDEX(1, 653)=29 - KINDEX(2, 653)=155 - KINDEX(1, 654)=62 - KINDEX(2, 654)=155 - KINDEX(1, 655)=1 - KINDEX(2, 655)=156 - KINDEX(1, 656)=43 - KINDEX(2, 656)=156 - KINDEX(1, 657)=2 - KINDEX(2, 657)=157 - KINDEX(1, 658)=44 - KINDEX(2, 658)=157 - KINDEX(1, 659)=3 - KINDEX(2, 659)=158 - KINDEX(1, 660)=45 - KINDEX(2, 660)=158 - KINDEX(1, 661)=4 - KINDEX(2, 661)=159 - KINDEX(1, 662)=46 - KINDEX(2, 662)=159 - KINDEX(1, 663)=5 - KINDEX(2, 663)=160 - KINDEX(1, 664)=47 - KINDEX(2, 664)=160 - KINDEX(1, 665)=6 - KINDEX(2, 665)=161 - KINDEX(1, 666)=48 - KINDEX(2, 666)=161 - KINDEX(1, 667)=7 - KINDEX(2, 667)=162 - KINDEX(1, 668)=49 - KINDEX(2, 668)=162 - KINDEX(1, 669)=8 - KINDEX(2, 669)=163 - KINDEX(1, 670)=50 - KINDEX(2, 670)=163 - KINDEX(1, 671)=9 - KINDEX(2, 671)=164 - KINDEX(1, 672)=51 - KINDEX(2, 672)=164 - KINDEX(1, 673)=10 - KINDEX(2, 673)=165 - KINDEX(1, 674)=52 - KINDEX(2, 674)=165 - KINDEX(1, 675)=15 - KINDEX(2, 675)=166 - KINDEX(1, 676)=53 - KINDEX(2, 676)=166 - KINDEX(1, 677)=16 - KINDEX(2, 677)=167 - KINDEX(1, 678)=54 - KINDEX(2, 678)=167 - KINDEX(1, 679)=55 - KINDEX(2, 679)=168 - KINDEX(1, 680)=12 - KINDEX(2, 680)=169 - KINDEX(1, 681)=56 - KINDEX(2, 681)=169 - KINDEX(1, 682)=13 - KINDEX(2, 682)=170 - KINDEX(1, 683)=57 - KINDEX(2, 683)=170 - KINDEX(1, 684)=23 - KINDEX(2, 684)=171 - KINDEX(1, 685)=58 - KINDEX(2, 685)=171 - KINDEX(1, 686)=31 - KINDEX(2, 686)=172 - KINDEX(1, 687)=59 - KINDEX(2, 687)=172 - KINDEX(1, 688)=32 - KINDEX(2, 688)=173 - KINDEX(1, 689)=60 - KINDEX(2, 689)=173 - KINDEX(1, 690)=33 - KINDEX(2, 690)=174 - KINDEX(1, 691)=61 - KINDEX(2, 691)=174 - KINDEX(1, 692)=29 - KINDEX(2, 692)=175 - KINDEX(1, 693)=62 - KINDEX(2, 693)=175 - KINDEX(1, 694)=1 - KINDEX(2, 694)=176 - KINDEX(1, 695)=68 - KINDEX(2, 695)=176 - KINDEX(1, 696)=2 - KINDEX(2, 696)=177 - KINDEX(1, 697)=69 - KINDEX(2, 697)=177 - KINDEX(1, 698)=3 - KINDEX(2, 698)=178 - KINDEX(1, 699)=70 - KINDEX(2, 699)=178 - KINDEX(1, 700)=4 - KINDEX(2, 700)=179 - KINDEX(1, 701)=71 - KINDEX(2, 701)=179 - KINDEX(1, 702)=5 - KINDEX(2, 702)=180 - KINDEX(1, 703)=72 - KINDEX(2, 703)=180 - KINDEX(1, 704)=6 - KINDEX(2, 704)=181 - KINDEX(1, 705)=73 - KINDEX(2, 705)=181 - KINDEX(1, 706)=7 - KINDEX(2, 706)=182 - KINDEX(1, 707)=74 - KINDEX(2, 707)=182 - KINDEX(1, 708)=8 - KINDEX(2, 708)=183 - KINDEX(1, 709)=75 - KINDEX(2, 709)=183 - KINDEX(1, 710)=9 - KINDEX(2, 710)=184 - KINDEX(1, 711)=76 - KINDEX(2, 711)=184 - KINDEX(1, 712)=10 - KINDEX(2, 712)=185 - KINDEX(1, 713)=77 - KINDEX(2, 713)=185 - KINDEX(1, 714)=15 - KINDEX(2, 714)=186 - KINDEX(1, 715)=78 - KINDEX(2, 715)=186 - KINDEX(1, 716)=16 - KINDEX(2, 716)=187 - KINDEX(1, 717)=79 - KINDEX(2, 717)=187 - KINDEX(1, 718)=80 - KINDEX(2, 718)=188 - KINDEX(1, 719)=12 - KINDEX(2, 719)=189 - KINDEX(1, 720)=81 - KINDEX(2, 720)=189 - KINDEX(1, 721)=13 - KINDEX(2, 721)=190 - KINDEX(1, 722)=82 - KINDEX(2, 722)=190 - KINDEX(1, 723)=23 - KINDEX(2, 723)=191 - KINDEX(1, 724)=83 - KINDEX(2, 724)=191 - KINDEX(1, 725)=31 - KINDEX(2, 725)=192 - KINDEX(1, 726)=84 - KINDEX(2, 726)=192 - KINDEX(1, 727)=32 - KINDEX(2, 727)=193 - KINDEX(1, 728)=85 - KINDEX(2, 728)=193 - KINDEX(1, 729)=33 - KINDEX(2, 729)=194 - KINDEX(1, 730)=86 - KINDEX(2, 730)=194 - KINDEX(1, 731)=29 - KINDEX(2, 731)=195 - KINDEX(1, 732)=87 - KINDEX(2, 732)=195 - KINDEX(1, 733)=1 - KINDEX(2, 733)=196 - KINDEX(1, 734)=68 - KINDEX(2, 734)=196 - KINDEX(1, 735)=2 - KINDEX(2, 735)=197 - KINDEX(1, 736)=69 - KINDEX(2, 736)=197 - KINDEX(1, 737)=3 - KINDEX(2, 737)=198 - KINDEX(1, 738)=70 - KINDEX(2, 738)=198 - KINDEX(1, 739)=4 - KINDEX(2, 739)=199 - KINDEX(1, 740)=71 - KINDEX(2, 740)=199 - KINDEX(1, 741)=5 - KINDEX(2, 741)=200 - KINDEX(1, 742)=72 - KINDEX(2, 742)=200 - KINDEX(1, 743)=6 - KINDEX(2, 743)=201 - KINDEX(1, 744)=73 - KINDEX(2, 744)=201 - KINDEX(1, 745)=7 - KINDEX(2, 745)=202 - KINDEX(1, 746)=74 - KINDEX(2, 746)=202 - KINDEX(1, 747)=8 - KINDEX(2, 747)=203 - KINDEX(1, 748)=75 - KINDEX(2, 748)=203 - KINDEX(1, 749)=9 - KINDEX(2, 749)=204 - KINDEX(1, 750)=76 - KINDEX(2, 750)=204 - KINDEX(1, 751)=10 - KINDEX(2, 751)=205 - KINDEX(1, 752)=77 - KINDEX(2, 752)=205 - KINDEX(1, 753)=15 - KINDEX(2, 753)=206 - KINDEX(1, 754)=78 - KINDEX(2, 754)=206 - KINDEX(1, 755)=16 - KINDEX(2, 755)=207 - KINDEX(1, 756)=79 - KINDEX(2, 756)=207 - KINDEX(1, 757)=80 - KINDEX(2, 757)=208 - KINDEX(1, 758)=12 - KINDEX(2, 758)=209 - KINDEX(1, 759)=81 - KINDEX(2, 759)=209 - KINDEX(1, 760)=13 - KINDEX(2, 760)=210 - KINDEX(1, 761)=82 - KINDEX(2, 761)=210 - KINDEX(1, 762)=23 - KINDEX(2, 762)=211 - KINDEX(1, 763)=83 - KINDEX(2, 763)=211 - KINDEX(1, 764)=31 - KINDEX(2, 764)=212 - KINDEX(1, 765)=84 - KINDEX(2, 765)=212 - KINDEX(1, 766)=32 - KINDEX(2, 766)=213 - KINDEX(1, 767)=85 - KINDEX(2, 767)=213 - KINDEX(1, 768)=33 - KINDEX(2, 768)=214 - KINDEX(1, 769)=86 - KINDEX(2, 769)=214 - KINDEX(1, 770)=29 - KINDEX(2, 770)=215 - KINDEX(1, 771)=87 - KINDEX(2, 771)=215 - KINDEX(1, 772)=44 - KINDEX(2, 772)=216 - KINDEX(1, 773)=53 - KINDEX(2, 773)=216 - KINDEX(1, 774)=44 - KINDEX(2, 774)=217 - KINDEX(1, 775)=53 - KINDEX(2, 775)=217 - KINDEX(1, 776)=53 - KINDEX(2, 776)=218 - KINDEX(1, 777)=54 - KINDEX(2, 777)=218 - KINDEX(1, 778)=44 - KINDEX(2, 778)=219 - KINDEX(1, 779)=53 - KINDEX(2, 779)=219 - KINDEX(1, 780)=54 - KINDEX(2, 780)=219 - KINDEX(1, 781)=44 - KINDEX(2, 781)=220 - KINDEX(1, 782)=54 - KINDEX(2, 782)=220 - KINDEX(1, 783)=43 - KINDEX(2, 783)=221 - KINDEX(1, 784)=53 - KINDEX(2, 784)=221 - KINDEX(1, 785)=54 - KINDEX(2, 785)=221 - KINDEX(1, 786)=53 - KINDEX(2, 786)=222 - KINDEX(1, 787)=56 - KINDEX(2, 787)=222 - KINDEX(1, 788)=63 - KINDEX(2, 788)=222 - KINDEX(1, 789)=46 - KINDEX(2, 789)=223 - KINDEX(1, 790)=49 - KINDEX(2, 790)=223 - KINDEX(1, 791)=53 - KINDEX(2, 791)=223 - KINDEX(1, 792)=46 - KINDEX(2, 792)=224 - KINDEX(1, 793)=51 - KINDEX(2, 793)=224 - KINDEX(1, 794)=54 - KINDEX(2, 794)=224 - KINDEX(1, 795)=46 - KINDEX(2, 795)=225 - KINDEX(1, 796)=51 - KINDEX(2, 796)=225 - KINDEX(1, 797)=54 - KINDEX(2, 797)=225 - KINDEX(1, 798)=49 - KINDEX(2, 798)=226 - KINDEX(1, 799)=51 - KINDEX(2, 799)=226 - KINDEX(1, 800)=50 - KINDEX(2, 800)=227 - KINDEX(1, 801)=51 - KINDEX(2, 801)=227 - KINDEX(1, 802)=56 - KINDEX(2, 802)=227 - KINDEX(1, 803)=57 - KINDEX(2, 803)=227 - KINDEX(1, 804)=46 - KINDEX(2, 804)=228 - KINDEX(1, 805)=50 - KINDEX(2, 805)=228 - KINDEX(1, 806)=53 - KINDEX(2, 806)=228 - KINDEX(1, 807)=48 - KINDEX(2, 807)=229 - KINDEX(1, 808)=50 - KINDEX(2, 808)=229 - KINDEX(1, 809)=47 - KINDEX(2, 809)=230 - KINDEX(1, 810)=50 - KINDEX(2, 810)=230 - KINDEX(1, 811)=57 - KINDEX(2, 811)=230 - KINDEX(1, 812)=64 - KINDEX(2, 812)=230 - KINDEX(1, 813)=47 - KINDEX(2, 813)=231 - KINDEX(1, 814)=50 - KINDEX(2, 814)=231 - KINDEX(1, 815)=56 - KINDEX(2, 815)=231 - KINDEX(1, 816)=63 - KINDEX(2, 816)=231 - KINDEX(1, 817)=54 - KINDEX(2, 817)=232 - KINDEX(1, 818)=58 - KINDEX(2, 818)=232 - KINDEX(1, 819)=61 - KINDEX(2, 819)=232 - KINDEX(1, 820)=56 - KINDEX(2, 820)=233 - KINDEX(1, 821)=61 - KINDEX(2, 821)=233 - KINDEX(1, 822)=62 - KINDEX(2, 822)=233 - KINDEX(1, 823)=63 - KINDEX(2, 823)=233 - KINDEX(1, 824)=53 - KINDEX(2, 824)=234 - KINDEX(1, 825)=54 - KINDEX(2, 825)=234 - KINDEX(1, 826)=58 - KINDEX(2, 826)=234 - KINDEX(1, 827)=59 - KINDEX(2, 827)=234 - KINDEX(1, 828)=53 - KINDEX(2, 828)=235 - KINDEX(1, 829)=54 - KINDEX(2, 829)=235 - KINDEX(1, 830)=55 - KINDEX(2, 830)=235 - KINDEX(1, 831)=59 - KINDEX(2, 831)=235 - KINDEX(1, 832)=56 - KINDEX(2, 832)=236 - KINDEX(1, 833)=58 - KINDEX(2, 833)=236 - KINDEX(1, 834)=67 - KINDEX(2, 834)=236 - KINDEX(1, 835)=56 - KINDEX(2, 835)=237 - KINDEX(1, 836)=58 - KINDEX(2, 836)=237 - KINDEX(1, 837)=67 - KINDEX(2, 837)=237 - KINDEX(1, 838)=53 - KINDEX(2, 838)=238 - KINDEX(1, 839)=54 - KINDEX(2, 839)=238 - KINDEX(1, 840)=56 - KINDEX(2, 840)=238 - KINDEX(1, 841)=59 - KINDEX(2, 841)=238 - KINDEX(1, 842)=67 - KINDEX(2, 842)=238 - KINDEX(1, 843)=63 - KINDEX(2, 843)=239 - KINDEX(1, 844)=65 - KINDEX(2, 844)=239 - KINDEX(1, 845)=54 - KINDEX(2, 845)=240 - KINDEX(1, 846)=65 - KINDEX(2, 846)=240 - KINDEX(1, 847)=66 - KINDEX(2, 847)=240 - KINDEX(1, 848)=64 - KINDEX(2, 848)=241 - KINDEX(1, 849)=65 - KINDEX(2, 849)=241 - KINDEX(1, 850)=56 - KINDEX(2, 850)=242 - KINDEX(1, 851)=57 - KINDEX(2, 851)=242 - KINDEX(1, 852)=66 - KINDEX(2, 852)=242 - KINDEX(1, 853)=53 - KINDEX(2, 853)=243 - KINDEX(1, 854)=57 - KINDEX(2, 854)=243 - KINDEX(1, 855)=64 - KINDEX(2, 855)=243 - KINDEX(1, 856)=43 - KINDEX(2, 856)=244 - KINDEX(1, 857)=56 - KINDEX(2, 857)=244 - KINDEX(1, 858)=57 - KINDEX(2, 858)=244 - KINDEX(1, 859)=44 - KINDEX(2, 859)=245 - KINDEX(1, 860)=56 - KINDEX(2, 860)=245 - KINDEX(1, 861)=57 - KINDEX(2, 861)=245 - KINDEX(1, 862)=69 - KINDEX(2, 862)=246 - KINDEX(1, 863)=78 - KINDEX(2, 863)=246 - KINDEX(1, 864)=69 - KINDEX(2, 864)=247 - KINDEX(1, 865)=78 - KINDEX(2, 865)=247 - KINDEX(1, 866)=78 - KINDEX(2, 866)=248 - KINDEX(1, 867)=79 - KINDEX(2, 867)=248 - KINDEX(1, 868)=69 - KINDEX(2, 868)=249 - KINDEX(1, 869)=78 - KINDEX(2, 869)=249 - KINDEX(1, 870)=79 - KINDEX(2, 870)=249 - KINDEX(1, 871)=69 - KINDEX(2, 871)=250 - KINDEX(1, 872)=79 - KINDEX(2, 872)=250 - KINDEX(1, 873)=68 - KINDEX(2, 873)=251 - KINDEX(1, 874)=78 - KINDEX(2, 874)=251 - KINDEX(1, 875)=79 - KINDEX(2, 875)=251 - KINDEX(1, 876)=78 - KINDEX(2, 876)=252 - KINDEX(1, 877)=81 - KINDEX(2, 877)=252 - KINDEX(1, 878)=88 - KINDEX(2, 878)=252 - KINDEX(1, 879)=71 - KINDEX(2, 879)=253 - KINDEX(1, 880)=74 - KINDEX(2, 880)=253 - KINDEX(1, 881)=78 - KINDEX(2, 881)=253 - KINDEX(1, 882)=71 - KINDEX(2, 882)=254 - KINDEX(1, 883)=76 - KINDEX(2, 883)=254 - KINDEX(1, 884)=79 - KINDEX(2, 884)=254 - KINDEX(1, 885)=71 - KINDEX(2, 885)=255 - KINDEX(1, 886)=76 - KINDEX(2, 886)=255 - KINDEX(1, 887)=79 - KINDEX(2, 887)=255 - KINDEX(1, 888)=74 - KINDEX(2, 888)=256 - KINDEX(1, 889)=76 - KINDEX(2, 889)=256 - KINDEX(1, 890)=75 - KINDEX(2, 890)=257 - KINDEX(1, 891)=76 - KINDEX(2, 891)=257 - KINDEX(1, 892)=81 - KINDEX(2, 892)=257 - KINDEX(1, 893)=82 - KINDEX(2, 893)=257 - KINDEX(1, 894)=71 - KINDEX(2, 894)=258 - KINDEX(1, 895)=75 - KINDEX(2, 895)=258 - KINDEX(1, 896)=78 - KINDEX(2, 896)=258 - KINDEX(1, 897)=73 - KINDEX(2, 897)=259 - KINDEX(1, 898)=75 - KINDEX(2, 898)=259 - KINDEX(1, 899)=72 - KINDEX(2, 899)=260 - KINDEX(1, 900)=75 - KINDEX(2, 900)=260 - KINDEX(1, 901)=82 - KINDEX(2, 901)=260 - KINDEX(1, 902)=89 - KINDEX(2, 902)=260 - KINDEX(1, 903)=72 - KINDEX(2, 903)=261 - KINDEX(1, 904)=75 - KINDEX(2, 904)=261 - KINDEX(1, 905)=81 - KINDEX(2, 905)=261 - KINDEX(1, 906)=88 - KINDEX(2, 906)=261 - KINDEX(1, 907)=79 - KINDEX(2, 907)=262 - KINDEX(1, 908)=83 - KINDEX(2, 908)=262 - KINDEX(1, 909)=86 - KINDEX(2, 909)=262 - KINDEX(1, 910)=81 - KINDEX(2, 910)=263 - KINDEX(1, 911)=86 - KINDEX(2, 911)=263 - KINDEX(1, 912)=87 - KINDEX(2, 912)=263 - KINDEX(1, 913)=88 - KINDEX(2, 913)=263 - KINDEX(1, 914)=78 - KINDEX(2, 914)=264 - KINDEX(1, 915)=79 - KINDEX(2, 915)=264 - KINDEX(1, 916)=83 - KINDEX(2, 916)=264 - KINDEX(1, 917)=84 - KINDEX(2, 917)=264 - KINDEX(1, 918)=78 - KINDEX(2, 918)=265 - KINDEX(1, 919)=79 - KINDEX(2, 919)=265 - KINDEX(1, 920)=80 - KINDEX(2, 920)=265 - KINDEX(1, 921)=84 - KINDEX(2, 921)=265 - KINDEX(1, 922)=81 - KINDEX(2, 922)=266 - KINDEX(1, 923)=83 - KINDEX(2, 923)=266 - KINDEX(1, 924)=92 - KINDEX(2, 924)=266 - KINDEX(1, 925)=81 - KINDEX(2, 925)=267 - KINDEX(1, 926)=83 - KINDEX(2, 926)=267 - KINDEX(1, 927)=92 - KINDEX(2, 927)=267 - KINDEX(1, 928)=78 - KINDEX(2, 928)=268 - KINDEX(1, 929)=79 - KINDEX(2, 929)=268 - KINDEX(1, 930)=81 - KINDEX(2, 930)=268 - KINDEX(1, 931)=84 - KINDEX(2, 931)=268 - KINDEX(1, 932)=92 - KINDEX(2, 932)=268 - KINDEX(1, 933)=88 - KINDEX(2, 933)=269 - KINDEX(1, 934)=90 - KINDEX(2, 934)=269 - KINDEX(1, 935)=79 - KINDEX(2, 935)=270 - KINDEX(1, 936)=90 - KINDEX(2, 936)=270 - KINDEX(1, 937)=91 - KINDEX(2, 937)=270 - KINDEX(1, 938)=89 - KINDEX(2, 938)=271 - KINDEX(1, 939)=90 - KINDEX(2, 939)=271 - KINDEX(1, 940)=81 - KINDEX(2, 940)=272 - KINDEX(1, 941)=82 - KINDEX(2, 941)=272 - KINDEX(1, 942)=91 - KINDEX(2, 942)=272 - KINDEX(1, 943)=78 - KINDEX(2, 943)=273 - KINDEX(1, 944)=82 - KINDEX(2, 944)=273 - KINDEX(1, 945)=89 - KINDEX(2, 945)=273 - KINDEX(1, 946)=68 - KINDEX(2, 946)=274 - KINDEX(1, 947)=81 - KINDEX(2, 947)=274 - KINDEX(1, 948)=82 - KINDEX(2, 948)=274 - KINDEX(1, 949)=69 - KINDEX(2, 949)=275 - KINDEX(1, 950)=81 - KINDEX(2, 950)=275 - KINDEX(1, 951)=82 - KINDEX(2, 951)=275 -RETURN -END SUBROUTINE CH_NONZEROTERMS_AQ -!! -!! -!! ############################# - SUBROUTINE CH_NONZEROTERMS_GAZ -!! ############################# -!! This code has been created automatically by preprocessor m10, -!! version: 9.7, copyright 1995-1999 by Meteo France/Universite Paul Sabatier. -!! Please report all bugs to K. Suhre (Lab. d'Aerologie UPS/CNRS). -!! -!!*** *MODD_CH_NONZEROTERMS* -!! -!! PURPOSE -!! ------- -! calculation of the contribution of each term in each reaction -!! -!!** METHOD -!! ------ -!! The contribution of reaction i to the evolution of species j -!! is returned in PTERMS. -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Karsten Suhre (LA) -!! -!! MODIFICATIONS -!! ------------- -!! Original 26/07/96 -!! Modified 05/05/98: Vectorization (Vincent Crassier & KS) -!! -!!---------------------------------------------------------------------- -!! -!! EXTERNAL -!! -------- -!! none -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! none -!! -!! EXPLICIT ARGUMENTS -!! ------------------ -IMPLICIT NONE -! check if output array is large enough -IF (KINDEXDIM.LT.615) THEN - STOP 'CH_NONZEROTERMS ERROR: array KINDEX is too small!' -END IF - KINDEX(1, 1)=3 - KINDEX(2, 1)=1 - KINDEX(1, 2)=4 - KINDEX(2, 2)=1 - KINDEX(1, 3)=1 - KINDEX(2, 3)=2 - KINDEX(1, 4)=1 - KINDEX(2, 4)=3 - KINDEX(1, 5)=3 - KINDEX(2, 5)=4 - KINDEX(1, 6)=7 - KINDEX(2, 6)=4 - KINDEX(1, 7)=15 - KINDEX(2, 7)=4 - KINDEX(1, 8)=4 - KINDEX(2, 8)=5 - KINDEX(1, 9)=8 - KINDEX(2, 9)=5 - KINDEX(1, 10)=15 - KINDEX(2, 10)=5 - KINDEX(1, 11)=4 - KINDEX(2, 11)=6 - KINDEX(1, 12)=5 - KINDEX(2, 12)=6 - KINDEX(1, 13)=9 - KINDEX(2, 13)=6 - KINDEX(1, 14)=15 - KINDEX(2, 14)=6 - KINDEX(1, 15)=16 - KINDEX(2, 15)=6 - KINDEX(1, 16)=3 - KINDEX(2, 16)=7 - KINDEX(1, 17)=5 - KINDEX(2, 17)=7 - KINDEX(1, 18)=4 - KINDEX(2, 18)=8 - KINDEX(1, 19)=5 - KINDEX(2, 19)=8 - KINDEX(1, 20)=2 - KINDEX(2, 20)=9 - KINDEX(1, 21)=15 - KINDEX(2, 21)=9 - KINDEX(1, 22)=14 - KINDEX(2, 22)=10 - KINDEX(1, 23)=23 - KINDEX(2, 23)=10 - KINDEX(1, 24)=14 - KINDEX(2, 24)=11 - KINDEX(1, 25)=16 - KINDEX(2, 25)=11 - KINDEX(1, 26)=23 - KINDEX(2, 26)=11 - KINDEX(1, 27)=14 - KINDEX(2, 27)=12 - KINDEX(1, 28)=16 - KINDEX(2, 28)=12 - KINDEX(1, 29)=24 - KINDEX(2, 29)=12 - KINDEX(1, 30)=33 - KINDEX(2, 30)=12 - KINDEX(1, 31)=15 - KINDEX(2, 31)=13 - KINDEX(1, 32)=16 - KINDEX(2, 32)=13 - KINDEX(1, 33)=23 - KINDEX(2, 33)=13 - KINDEX(1, 34)=29 - KINDEX(2, 34)=13 - KINDEX(1, 35)=15 - KINDEX(2, 35)=14 - KINDEX(1, 36)=16 - KINDEX(2, 36)=14 - KINDEX(1, 37)=24 - KINDEX(2, 37)=14 - KINDEX(1, 38)=30 - KINDEX(2, 38)=14 - KINDEX(1, 39)=33 - KINDEX(2, 39)=14 - KINDEX(1, 40)=25 - KINDEX(2, 40)=15 - KINDEX(1, 41)=34 - KINDEX(2, 41)=15 - KINDEX(1, 42)=40 - KINDEX(2, 42)=15 - KINDEX(1, 43)=14 - KINDEX(2, 43)=16 - KINDEX(1, 44)=16 - KINDEX(2, 44)=16 - KINDEX(1, 45)=23 - KINDEX(2, 45)=16 - KINDEX(1, 46)=26 - KINDEX(2, 46)=16 - KINDEX(1, 47)=40 - KINDEX(2, 47)=16 - KINDEX(1, 48)=4 - KINDEX(2, 48)=17 - KINDEX(1, 49)=16 - KINDEX(2, 49)=17 - KINDEX(1, 50)=24 - KINDEX(2, 50)=17 - KINDEX(1, 51)=25 - KINDEX(2, 51)=17 - KINDEX(1, 52)=27 - KINDEX(2, 52)=17 - KINDEX(1, 53)=1 - KINDEX(2, 53)=18 - KINDEX(1, 54)=1 - KINDEX(2, 54)=19 - KINDEX(1, 55)=15 - KINDEX(2, 55)=22 - KINDEX(1, 56)=1 - KINDEX(2, 56)=23 - KINDEX(1, 57)=15 - KINDEX(2, 57)=23 - KINDEX(1, 58)=16 - KINDEX(2, 58)=23 - KINDEX(1, 59)=1 - KINDEX(2, 59)=24 - KINDEX(1, 60)=15 - KINDEX(2, 60)=24 - KINDEX(1, 61)=16 - KINDEX(2, 61)=24 - KINDEX(1, 62)=15 - KINDEX(2, 62)=25 - KINDEX(1, 63)=16 - KINDEX(2, 63)=25 - KINDEX(1, 64)=2 - KINDEX(2, 64)=26 - KINDEX(1, 65)=15 - KINDEX(2, 65)=26 - KINDEX(1, 66)=16 - KINDEX(2, 66)=26 - KINDEX(1, 67)=2 - KINDEX(2, 67)=27 - KINDEX(1, 68)=16 - KINDEX(2, 68)=27 - KINDEX(1, 69)=2 - KINDEX(2, 69)=28 - KINDEX(1, 70)=16 - KINDEX(2, 70)=28 - KINDEX(1, 71)=3 - KINDEX(2, 71)=29 - KINDEX(1, 72)=4 - KINDEX(2, 72)=29 - KINDEX(1, 73)=3 - KINDEX(2, 73)=30 - KINDEX(1, 74)=4 - KINDEX(2, 74)=30 - KINDEX(1, 75)=4 - KINDEX(2, 75)=31 - KINDEX(1, 76)=5 - KINDEX(2, 76)=31 - KINDEX(1, 77)=3 - KINDEX(2, 77)=32 - KINDEX(1, 78)=7 - KINDEX(2, 78)=32 - KINDEX(1, 79)=15 - KINDEX(2, 79)=32 - KINDEX(1, 80)=4 - KINDEX(2, 80)=33 - KINDEX(1, 81)=8 - KINDEX(2, 81)=33 - KINDEX(1, 82)=15 - KINDEX(2, 82)=33 - KINDEX(1, 83)=4 - KINDEX(2, 83)=34 - KINDEX(1, 84)=5 - KINDEX(2, 84)=34 - KINDEX(1, 85)=15 - KINDEX(2, 85)=34 - KINDEX(1, 86)=16 - KINDEX(2, 86)=34 - KINDEX(1, 87)=3 - KINDEX(2, 87)=35 - KINDEX(1, 88)=4 - KINDEX(2, 88)=35 - KINDEX(1, 89)=15 - KINDEX(2, 89)=35 - KINDEX(1, 90)=16 - KINDEX(2, 90)=35 - KINDEX(1, 91)=4 - KINDEX(2, 91)=36 - KINDEX(1, 92)=9 - KINDEX(2, 92)=36 - KINDEX(1, 93)=16 - KINDEX(2, 93)=36 - KINDEX(1, 94)=4 - KINDEX(2, 94)=37 - KINDEX(1, 95)=9 - KINDEX(2, 95)=37 - KINDEX(1, 96)=16 - KINDEX(2, 96)=37 - KINDEX(1, 97)=4 - KINDEX(2, 97)=38 - KINDEX(1, 98)=5 - KINDEX(2, 98)=38 - KINDEX(1, 99)=8 - KINDEX(2, 99)=38 - KINDEX(1, 100)=15 - KINDEX(2, 100)=38 - KINDEX(1, 101)=16 - KINDEX(2, 101)=38 - KINDEX(1, 102)=4 - KINDEX(2, 102)=39 - KINDEX(1, 103)=7 - KINDEX(2, 103)=39 - KINDEX(1, 104)=15 - KINDEX(2, 104)=39 - KINDEX(1, 105)=5 - KINDEX(2, 105)=40 - KINDEX(1, 106)=8 - KINDEX(2, 106)=40 - KINDEX(1, 107)=15 - KINDEX(2, 107)=40 - KINDEX(1, 108)=4 - KINDEX(2, 108)=41 - KINDEX(1, 109)=9 - KINDEX(2, 109)=41 - KINDEX(1, 110)=15 - KINDEX(2, 110)=41 - KINDEX(1, 111)=1 - KINDEX(2, 111)=42 - KINDEX(1, 112)=3 - KINDEX(2, 112)=42 - KINDEX(1, 113)=4 - KINDEX(2, 113)=42 - KINDEX(1, 114)=1 - KINDEX(2, 114)=43 - KINDEX(1, 115)=4 - KINDEX(2, 115)=43 - KINDEX(1, 116)=5 - KINDEX(2, 116)=43 - KINDEX(1, 117)=3 - KINDEX(2, 117)=44 - KINDEX(1, 118)=4 - KINDEX(2, 118)=44 - KINDEX(1, 119)=3 - KINDEX(2, 119)=45 - KINDEX(1, 120)=4 - KINDEX(2, 120)=45 - KINDEX(1, 121)=5 - KINDEX(2, 121)=45 - KINDEX(1, 122)=3 - KINDEX(2, 122)=46 - KINDEX(1, 123)=4 - KINDEX(2, 123)=46 - KINDEX(1, 124)=5 - KINDEX(2, 124)=46 - KINDEX(1, 125)=4 - KINDEX(2, 125)=47 - KINDEX(1, 126)=5 - KINDEX(2, 126)=47 - KINDEX(1, 127)=6 - KINDEX(2, 127)=47 - KINDEX(1, 128)=4 - KINDEX(2, 128)=48 - KINDEX(1, 129)=5 - KINDEX(2, 129)=48 - KINDEX(1, 130)=6 - KINDEX(2, 130)=48 - KINDEX(1, 131)=4 - KINDEX(2, 131)=49 - KINDEX(1, 132)=5 - KINDEX(2, 132)=49 - KINDEX(1, 133)=10 - KINDEX(2, 133)=50 - KINDEX(1, 134)=15 - KINDEX(2, 134)=50 - KINDEX(1, 135)=15 - KINDEX(2, 135)=51 - KINDEX(1, 136)=16 - KINDEX(2, 136)=51 - KINDEX(1, 137)=12 - KINDEX(2, 137)=52 - KINDEX(1, 138)=13 - KINDEX(2, 138)=52 - KINDEX(1, 139)=15 - KINDEX(2, 139)=52 - KINDEX(1, 140)=16 - KINDEX(2, 140)=52 - KINDEX(1, 141)=14 - KINDEX(2, 141)=53 - KINDEX(1, 142)=15 - KINDEX(2, 142)=53 - KINDEX(1, 143)=16 - KINDEX(2, 143)=53 - KINDEX(1, 144)=14 - KINDEX(2, 144)=54 - KINDEX(1, 145)=15 - KINDEX(2, 145)=54 - KINDEX(1, 146)=16 - KINDEX(2, 146)=54 - KINDEX(1, 147)=20 - KINDEX(2, 147)=54 - KINDEX(1, 148)=21 - KINDEX(2, 148)=54 - KINDEX(1, 149)=23 - KINDEX(2, 149)=54 - KINDEX(1, 150)=26 - KINDEX(2, 150)=54 - KINDEX(1, 151)=42 - KINDEX(2, 151)=54 - KINDEX(1, 152)=24 - KINDEX(2, 152)=55 - KINDEX(1, 153)=26 - KINDEX(2, 153)=55 - KINDEX(1, 154)=15 - KINDEX(2, 154)=56 - KINDEX(1, 155)=17 - KINDEX(2, 155)=56 - KINDEX(1, 156)=33 - KINDEX(2, 156)=56 - KINDEX(1, 157)=15 - KINDEX(2, 157)=57 - KINDEX(1, 158)=18 - KINDEX(2, 158)=57 - KINDEX(1, 159)=34 - KINDEX(2, 159)=57 - KINDEX(1, 160)=14 - KINDEX(2, 160)=58 - KINDEX(1, 161)=15 - KINDEX(2, 161)=58 - KINDEX(1, 162)=16 - KINDEX(2, 162)=58 - KINDEX(1, 163)=19 - KINDEX(2, 163)=58 - KINDEX(1, 164)=23 - KINDEX(2, 164)=58 - KINDEX(1, 165)=24 - KINDEX(2, 165)=58 - KINDEX(1, 166)=25 - KINDEX(2, 166)=58 - KINDEX(1, 167)=26 - KINDEX(2, 167)=58 - KINDEX(1, 168)=31 - KINDEX(2, 168)=58 - KINDEX(1, 169)=34 - KINDEX(2, 169)=58 - KINDEX(1, 170)=15 - KINDEX(2, 170)=59 - KINDEX(1, 171)=20 - KINDEX(2, 171)=59 - KINDEX(1, 172)=35 - KINDEX(2, 172)=59 - KINDEX(1, 173)=36 - KINDEX(2, 173)=59 - KINDEX(1, 174)=15 - KINDEX(2, 174)=60 - KINDEX(1, 175)=21 - KINDEX(2, 175)=60 - KINDEX(1, 176)=36 - KINDEX(2, 176)=60 - KINDEX(1, 177)=15 - KINDEX(2, 177)=61 - KINDEX(1, 178)=16 - KINDEX(2, 178)=61 - KINDEX(1, 179)=22 - KINDEX(2, 179)=61 - KINDEX(1, 180)=37 - KINDEX(2, 180)=61 - KINDEX(1, 181)=38 - KINDEX(2, 181)=61 - KINDEX(1, 182)=42 - KINDEX(2, 182)=61 - KINDEX(1, 183)=14 - KINDEX(2, 183)=62 - KINDEX(1, 184)=15 - KINDEX(2, 184)=62 - KINDEX(1, 185)=16 - KINDEX(2, 185)=62 - KINDEX(1, 186)=23 - KINDEX(2, 186)=62 - KINDEX(1, 187)=15 - KINDEX(2, 187)=63 - KINDEX(1, 188)=24 - KINDEX(2, 188)=63 - KINDEX(1, 189)=40 - KINDEX(2, 189)=63 - KINDEX(1, 190)=15 - KINDEX(2, 190)=64 - KINDEX(1, 191)=25 - KINDEX(2, 191)=64 - KINDEX(1, 192)=40 - KINDEX(2, 192)=64 - KINDEX(1, 193)=14 - KINDEX(2, 193)=65 - KINDEX(1, 194)=15 - KINDEX(2, 194)=65 - KINDEX(1, 195)=16 - KINDEX(2, 195)=65 - KINDEX(1, 196)=23 - KINDEX(2, 196)=65 - KINDEX(1, 197)=24 - KINDEX(2, 197)=65 - KINDEX(1, 198)=25 - KINDEX(2, 198)=65 - KINDEX(1, 199)=26 - KINDEX(2, 199)=65 - KINDEX(1, 200)=40 - KINDEX(2, 200)=65 - KINDEX(1, 201)=42 - KINDEX(2, 201)=65 - KINDEX(1, 202)=15 - KINDEX(2, 202)=66 - KINDEX(1, 203)=16 - KINDEX(2, 203)=66 - KINDEX(1, 204)=31 - KINDEX(2, 204)=66 - KINDEX(1, 205)=15 - KINDEX(2, 205)=67 - KINDEX(1, 206)=32 - KINDEX(2, 206)=67 - KINDEX(1, 207)=15 - KINDEX(2, 207)=68 - KINDEX(1, 208)=23 - KINDEX(2, 208)=68 - KINDEX(1, 209)=29 - KINDEX(2, 209)=68 - KINDEX(1, 210)=33 - KINDEX(2, 210)=68 - KINDEX(1, 211)=15 - KINDEX(2, 211)=69 - KINDEX(1, 212)=16 - KINDEX(2, 212)=69 - KINDEX(1, 213)=23 - KINDEX(2, 213)=69 - KINDEX(1, 214)=24 - KINDEX(2, 214)=69 - KINDEX(1, 215)=25 - KINDEX(2, 215)=69 - KINDEX(1, 216)=30 - KINDEX(2, 216)=69 - KINDEX(1, 217)=34 - KINDEX(2, 217)=69 - KINDEX(1, 218)=40 - KINDEX(2, 218)=69 - KINDEX(1, 219)=42 - KINDEX(2, 219)=69 - KINDEX(1, 220)=5 - KINDEX(2, 220)=70 - KINDEX(1, 221)=15 - KINDEX(2, 221)=70 - KINDEX(1, 222)=16 - KINDEX(2, 222)=70 - KINDEX(1, 223)=23 - KINDEX(2, 223)=70 - KINDEX(1, 224)=26 - KINDEX(2, 224)=70 - KINDEX(1, 225)=28 - KINDEX(2, 225)=70 - KINDEX(1, 226)=42 - KINDEX(2, 226)=70 - KINDEX(1, 227)=4 - KINDEX(2, 227)=71 - KINDEX(1, 228)=15 - KINDEX(2, 228)=71 - KINDEX(1, 229)=27 - KINDEX(2, 229)=71 - KINDEX(1, 230)=34 - KINDEX(2, 230)=71 - KINDEX(1, 231)=5 - KINDEX(2, 231)=72 - KINDEX(1, 232)=8 - KINDEX(2, 232)=72 - KINDEX(1, 233)=14 - KINDEX(2, 233)=72 - KINDEX(1, 234)=16 - KINDEX(2, 234)=72 - KINDEX(1, 235)=23 - KINDEX(2, 235)=72 - KINDEX(1, 236)=5 - KINDEX(2, 236)=73 - KINDEX(1, 237)=8 - KINDEX(2, 237)=73 - KINDEX(1, 238)=24 - KINDEX(2, 238)=73 - KINDEX(1, 239)=40 - KINDEX(2, 239)=73 - KINDEX(1, 240)=4 - KINDEX(2, 240)=74 - KINDEX(1, 241)=5 - KINDEX(2, 241)=74 - KINDEX(1, 242)=8 - KINDEX(2, 242)=74 - KINDEX(1, 243)=14 - KINDEX(2, 243)=74 - KINDEX(1, 244)=16 - KINDEX(2, 244)=74 - KINDEX(1, 245)=24 - KINDEX(2, 245)=74 - KINDEX(1, 246)=25 - KINDEX(2, 246)=74 - KINDEX(1, 247)=26 - KINDEX(2, 247)=74 - KINDEX(1, 248)=40 - KINDEX(2, 248)=74 - KINDEX(1, 249)=41 - KINDEX(2, 249)=74 - KINDEX(1, 250)=42 - KINDEX(2, 250)=74 - KINDEX(1, 251)=5 - KINDEX(2, 251)=75 - KINDEX(1, 252)=8 - KINDEX(2, 252)=75 - KINDEX(1, 253)=22 - KINDEX(2, 253)=75 - KINDEX(1, 254)=37 - KINDEX(2, 254)=75 - KINDEX(1, 255)=5 - KINDEX(2, 255)=76 - KINDEX(1, 256)=20 - KINDEX(2, 256)=76 - KINDEX(1, 257)=26 - KINDEX(2, 257)=76 - KINDEX(1, 258)=41 - KINDEX(2, 258)=76 - KINDEX(1, 259)=5 - KINDEX(2, 259)=77 - KINDEX(1, 260)=21 - KINDEX(2, 260)=77 - KINDEX(1, 261)=26 - KINDEX(2, 261)=77 - KINDEX(1, 262)=41 - KINDEX(2, 262)=77 - KINDEX(1, 263)=4 - KINDEX(2, 263)=78 - KINDEX(1, 264)=5 - KINDEX(2, 264)=78 - KINDEX(1, 265)=23 - KINDEX(2, 265)=78 - KINDEX(1, 266)=27 - KINDEX(2, 266)=78 - KINDEX(1, 267)=28 - KINDEX(2, 267)=78 - KINDEX(1, 268)=42 - KINDEX(2, 268)=78 - KINDEX(1, 269)=1 - KINDEX(2, 269)=79 - KINDEX(1, 270)=2 - KINDEX(2, 270)=79 - KINDEX(1, 271)=14 - KINDEX(2, 271)=79 - KINDEX(1, 272)=15 - KINDEX(2, 272)=79 - KINDEX(1, 273)=16 - KINDEX(2, 273)=79 - KINDEX(1, 274)=17 - KINDEX(2, 274)=79 - KINDEX(1, 275)=18 - KINDEX(2, 275)=79 - KINDEX(1, 276)=20 - KINDEX(2, 276)=79 - KINDEX(1, 277)=23 - KINDEX(2, 277)=79 - KINDEX(1, 278)=24 - KINDEX(2, 278)=79 - KINDEX(1, 279)=25 - KINDEX(2, 279)=79 - KINDEX(1, 280)=26 - KINDEX(2, 280)=79 - KINDEX(1, 281)=31 - KINDEX(2, 281)=79 - KINDEX(1, 282)=32 - KINDEX(2, 282)=79 - KINDEX(1, 283)=33 - KINDEX(2, 283)=79 - KINDEX(1, 284)=34 - KINDEX(2, 284)=79 - KINDEX(1, 285)=40 - KINDEX(2, 285)=79 - KINDEX(1, 286)=42 - KINDEX(2, 286)=79 - KINDEX(1, 287)=1 - KINDEX(2, 287)=80 - KINDEX(1, 288)=2 - KINDEX(2, 288)=80 - KINDEX(1, 289)=14 - KINDEX(2, 289)=80 - KINDEX(1, 290)=15 - KINDEX(2, 290)=80 - KINDEX(1, 291)=16 - KINDEX(2, 291)=80 - KINDEX(1, 292)=20 - KINDEX(2, 292)=80 - KINDEX(1, 293)=21 - KINDEX(2, 293)=80 - KINDEX(1, 294)=23 - KINDEX(2, 294)=80 - KINDEX(1, 295)=24 - KINDEX(2, 295)=80 - KINDEX(1, 296)=25 - KINDEX(2, 296)=80 - KINDEX(1, 297)=26 - KINDEX(2, 297)=80 - KINDEX(1, 298)=31 - KINDEX(2, 298)=80 - KINDEX(1, 299)=32 - KINDEX(2, 299)=80 - KINDEX(1, 300)=33 - KINDEX(2, 300)=80 - KINDEX(1, 301)=34 - KINDEX(2, 301)=80 - KINDEX(1, 302)=40 - KINDEX(2, 302)=80 - KINDEX(1, 303)=42 - KINDEX(2, 303)=80 - KINDEX(1, 304)=1 - KINDEX(2, 304)=81 - KINDEX(1, 305)=14 - KINDEX(2, 305)=81 - KINDEX(1, 306)=15 - KINDEX(2, 306)=81 - KINDEX(1, 307)=16 - KINDEX(2, 307)=81 - KINDEX(1, 308)=23 - KINDEX(2, 308)=81 - KINDEX(1, 309)=24 - KINDEX(2, 309)=81 - KINDEX(1, 310)=26 - KINDEX(2, 310)=81 - KINDEX(1, 311)=30 - KINDEX(2, 311)=81 - KINDEX(1, 312)=31 - KINDEX(2, 312)=81 - KINDEX(1, 313)=32 - KINDEX(2, 313)=81 - KINDEX(1, 314)=40 - KINDEX(2, 314)=81 - KINDEX(1, 315)=1 - KINDEX(2, 315)=82 - KINDEX(1, 316)=4 - KINDEX(2, 316)=82 - KINDEX(1, 317)=14 - KINDEX(2, 317)=82 - KINDEX(1, 318)=15 - KINDEX(2, 318)=82 - KINDEX(1, 319)=16 - KINDEX(2, 319)=82 - KINDEX(1, 320)=23 - KINDEX(2, 320)=82 - KINDEX(1, 321)=28 - KINDEX(2, 321)=82 - KINDEX(1, 322)=31 - KINDEX(2, 322)=82 - KINDEX(1, 323)=40 - KINDEX(2, 323)=82 - KINDEX(1, 324)=4 - KINDEX(2, 324)=83 - KINDEX(1, 325)=22 - KINDEX(2, 325)=83 - KINDEX(1, 326)=27 - KINDEX(2, 326)=83 - KINDEX(1, 327)=37 - KINDEX(2, 327)=83 - KINDEX(1, 328)=16 - KINDEX(2, 328)=84 - KINDEX(1, 329)=22 - KINDEX(2, 329)=84 - KINDEX(1, 330)=37 - KINDEX(2, 330)=84 - KINDEX(1, 331)=4 - KINDEX(2, 331)=85 - KINDEX(1, 332)=7 - KINDEX(2, 332)=85 - KINDEX(1, 333)=22 - KINDEX(2, 333)=85 - KINDEX(1, 334)=38 - KINDEX(2, 334)=85 - KINDEX(1, 335)=16 - KINDEX(2, 335)=86 - KINDEX(1, 336)=22 - KINDEX(2, 336)=86 - KINDEX(1, 337)=38 - KINDEX(2, 337)=86 - KINDEX(1, 338)=39 - KINDEX(2, 338)=86 - KINDEX(1, 339)=1 - KINDEX(2, 339)=87 - KINDEX(1, 340)=15 - KINDEX(2, 340)=87 - KINDEX(1, 341)=22 - KINDEX(2, 341)=87 - KINDEX(1, 342)=38 - KINDEX(2, 342)=87 - KINDEX(1, 343)=4 - KINDEX(2, 343)=88 - KINDEX(1, 344)=28 - KINDEX(2, 344)=88 - KINDEX(1, 345)=40 - KINDEX(2, 345)=88 - KINDEX(1, 346)=4 - KINDEX(2, 346)=89 - KINDEX(1, 347)=28 - KINDEX(2, 347)=89 - KINDEX(1, 348)=40 - KINDEX(2, 348)=89 - KINDEX(1, 349)=3 - KINDEX(2, 349)=90 - KINDEX(1, 350)=4 - KINDEX(2, 350)=90 - KINDEX(1, 351)=16 - KINDEX(2, 351)=90 - KINDEX(1, 352)=23 - KINDEX(2, 352)=90 - KINDEX(1, 353)=33 - KINDEX(2, 353)=90 - KINDEX(1, 354)=3 - KINDEX(2, 354)=91 - KINDEX(1, 355)=4 - KINDEX(2, 355)=91 - KINDEX(1, 356)=16 - KINDEX(2, 356)=91 - KINDEX(1, 357)=23 - KINDEX(2, 357)=91 - KINDEX(1, 358)=24 - KINDEX(2, 358)=91 - KINDEX(1, 359)=25 - KINDEX(2, 359)=91 - KINDEX(1, 360)=26 - KINDEX(2, 360)=91 - KINDEX(1, 361)=27 - KINDEX(2, 361)=91 - KINDEX(1, 362)=33 - KINDEX(2, 362)=91 - KINDEX(1, 363)=34 - KINDEX(2, 363)=91 - KINDEX(1, 364)=42 - KINDEX(2, 364)=91 - KINDEX(1, 365)=3 - KINDEX(2, 365)=92 - KINDEX(1, 366)=4 - KINDEX(2, 366)=92 - KINDEX(1, 367)=16 - KINDEX(2, 367)=92 - KINDEX(1, 368)=23 - KINDEX(2, 368)=92 - KINDEX(1, 369)=24 - KINDEX(2, 369)=92 - KINDEX(1, 370)=25 - KINDEX(2, 370)=92 - KINDEX(1, 371)=35 - KINDEX(2, 371)=92 - KINDEX(1, 372)=3 - KINDEX(2, 372)=93 - KINDEX(1, 373)=4 - KINDEX(2, 373)=93 - KINDEX(1, 374)=16 - KINDEX(2, 374)=93 - KINDEX(1, 375)=20 - KINDEX(2, 375)=93 - KINDEX(1, 376)=23 - KINDEX(2, 376)=93 - KINDEX(1, 377)=24 - KINDEX(2, 377)=93 - KINDEX(1, 378)=25 - KINDEX(2, 378)=93 - KINDEX(1, 379)=26 - KINDEX(2, 379)=93 - KINDEX(1, 380)=27 - KINDEX(2, 380)=93 - KINDEX(1, 381)=36 - KINDEX(2, 381)=93 - KINDEX(1, 382)=3 - KINDEX(2, 382)=94 - KINDEX(1, 383)=4 - KINDEX(2, 383)=94 - KINDEX(1, 384)=16 - KINDEX(2, 384)=94 - KINDEX(1, 385)=26 - KINDEX(2, 385)=94 - KINDEX(1, 386)=27 - KINDEX(2, 386)=94 - KINDEX(1, 387)=39 - KINDEX(2, 387)=94 - KINDEX(1, 388)=3 - KINDEX(2, 388)=95 - KINDEX(1, 389)=4 - KINDEX(2, 389)=95 - KINDEX(1, 390)=16 - KINDEX(2, 390)=95 - KINDEX(1, 391)=23 - KINDEX(2, 391)=95 - KINDEX(1, 392)=24 - KINDEX(2, 392)=95 - KINDEX(1, 393)=26 - KINDEX(2, 393)=95 - KINDEX(1, 394)=33 - KINDEX(2, 394)=95 - KINDEX(1, 395)=40 - KINDEX(2, 395)=95 - KINDEX(1, 396)=42 - KINDEX(2, 396)=95 - KINDEX(1, 397)=3 - KINDEX(2, 397)=96 - KINDEX(1, 398)=4 - KINDEX(2, 398)=96 - KINDEX(1, 399)=16 - KINDEX(2, 399)=96 - KINDEX(1, 400)=23 - KINDEX(2, 400)=96 - KINDEX(1, 401)=24 - KINDEX(2, 401)=96 - KINDEX(1, 402)=25 - KINDEX(2, 402)=96 - KINDEX(1, 403)=27 - KINDEX(2, 403)=96 - KINDEX(1, 404)=41 - KINDEX(2, 404)=96 - KINDEX(1, 405)=16 - KINDEX(2, 405)=97 - KINDEX(1, 406)=29 - KINDEX(2, 406)=97 - KINDEX(1, 407)=33 - KINDEX(2, 407)=97 - KINDEX(1, 408)=16 - KINDEX(2, 408)=98 - KINDEX(1, 409)=30 - KINDEX(2, 409)=98 - KINDEX(1, 410)=34 - KINDEX(2, 410)=98 - KINDEX(1, 411)=16 - KINDEX(2, 411)=99 - KINDEX(1, 412)=30 - KINDEX(2, 412)=99 - KINDEX(1, 413)=35 - KINDEX(2, 413)=99 - KINDEX(1, 414)=16 - KINDEX(2, 414)=100 - KINDEX(1, 415)=30 - KINDEX(2, 415)=100 - KINDEX(1, 416)=36 - KINDEX(2, 416)=100 - KINDEX(1, 417)=16 - KINDEX(2, 417)=101 - KINDEX(1, 418)=30 - KINDEX(2, 418)=101 - KINDEX(1, 419)=39 - KINDEX(2, 419)=101 - KINDEX(1, 420)=1 - KINDEX(2, 420)=102 - KINDEX(1, 421)=16 - KINDEX(2, 421)=102 - KINDEX(1, 422)=30 - KINDEX(2, 422)=102 - KINDEX(1, 423)=32 - KINDEX(2, 423)=102 - KINDEX(1, 424)=40 - KINDEX(2, 424)=102 - KINDEX(1, 425)=16 - KINDEX(2, 425)=103 - KINDEX(1, 426)=27 - KINDEX(2, 426)=103 - KINDEX(1, 427)=41 - KINDEX(2, 427)=103 - KINDEX(1, 428)=16 - KINDEX(2, 428)=104 - KINDEX(1, 429)=23 - KINDEX(2, 429)=104 - KINDEX(1, 430)=33 - KINDEX(2, 430)=104 - KINDEX(1, 431)=16 - KINDEX(2, 431)=105 - KINDEX(1, 432)=23 - KINDEX(2, 432)=105 - KINDEX(1, 433)=24 - KINDEX(2, 433)=105 - KINDEX(1, 434)=25 - KINDEX(2, 434)=105 - KINDEX(1, 435)=26 - KINDEX(2, 435)=105 - KINDEX(1, 436)=33 - KINDEX(2, 436)=105 - KINDEX(1, 437)=34 - KINDEX(2, 437)=105 - KINDEX(1, 438)=42 - KINDEX(2, 438)=105 - KINDEX(1, 439)=16 - KINDEX(2, 439)=106 - KINDEX(1, 440)=23 - KINDEX(2, 440)=106 - KINDEX(1, 441)=24 - KINDEX(2, 441)=106 - KINDEX(1, 442)=25 - KINDEX(2, 442)=106 - KINDEX(1, 443)=33 - KINDEX(2, 443)=106 - KINDEX(1, 444)=35 - KINDEX(2, 444)=106 - KINDEX(1, 445)=16 - KINDEX(2, 445)=107 - KINDEX(1, 446)=20 - KINDEX(2, 446)=107 - KINDEX(1, 447)=23 - KINDEX(2, 447)=107 - KINDEX(1, 448)=24 - KINDEX(2, 448)=107 - KINDEX(1, 449)=25 - KINDEX(2, 449)=107 - KINDEX(1, 450)=26 - KINDEX(2, 450)=107 - KINDEX(1, 451)=33 - KINDEX(2, 451)=107 - KINDEX(1, 452)=36 - KINDEX(2, 452)=107 - KINDEX(1, 453)=16 - KINDEX(2, 453)=108 - KINDEX(1, 454)=23 - KINDEX(2, 454)=108 - KINDEX(1, 455)=26 - KINDEX(2, 455)=108 - KINDEX(1, 456)=33 - KINDEX(2, 456)=108 - KINDEX(1, 457)=39 - KINDEX(2, 457)=108 - KINDEX(1, 458)=16 - KINDEX(2, 458)=109 - KINDEX(1, 459)=23 - KINDEX(2, 459)=109 - KINDEX(1, 460)=24 - KINDEX(2, 460)=109 - KINDEX(1, 461)=26 - KINDEX(2, 461)=109 - KINDEX(1, 462)=32 - KINDEX(2, 462)=109 - KINDEX(1, 463)=33 - KINDEX(2, 463)=109 - KINDEX(1, 464)=40 - KINDEX(2, 464)=109 - KINDEX(1, 465)=42 - KINDEX(2, 465)=109 - KINDEX(1, 466)=4 - KINDEX(2, 466)=110 - KINDEX(1, 467)=16 - KINDEX(2, 467)=110 - KINDEX(1, 468)=23 - KINDEX(2, 468)=110 - KINDEX(1, 469)=24 - KINDEX(2, 469)=110 - KINDEX(1, 470)=25 - KINDEX(2, 470)=110 - KINDEX(1, 471)=27 - KINDEX(2, 471)=110 - KINDEX(1, 472)=33 - KINDEX(2, 472)=110 - KINDEX(1, 473)=41 - KINDEX(2, 473)=110 - KINDEX(1, 474)=16 - KINDEX(2, 474)=111 - KINDEX(1, 475)=23 - KINDEX(2, 475)=111 - KINDEX(1, 476)=24 - KINDEX(2, 476)=111 - KINDEX(1, 477)=25 - KINDEX(2, 477)=111 - KINDEX(1, 478)=26 - KINDEX(2, 478)=111 - KINDEX(1, 479)=32 - KINDEX(2, 479)=111 - KINDEX(1, 480)=33 - KINDEX(2, 480)=111 - KINDEX(1, 481)=34 - KINDEX(2, 481)=111 - KINDEX(1, 482)=40 - KINDEX(2, 482)=111 - KINDEX(1, 483)=42 - KINDEX(2, 483)=111 - KINDEX(1, 484)=16 - KINDEX(2, 484)=112 - KINDEX(1, 485)=23 - KINDEX(2, 485)=112 - KINDEX(1, 486)=24 - KINDEX(2, 486)=112 - KINDEX(1, 487)=25 - KINDEX(2, 487)=112 - KINDEX(1, 488)=32 - KINDEX(2, 488)=112 - KINDEX(1, 489)=33 - KINDEX(2, 489)=112 - KINDEX(1, 490)=35 - KINDEX(2, 490)=112 - KINDEX(1, 491)=40 - KINDEX(2, 491)=112 - KINDEX(1, 492)=16 - KINDEX(2, 492)=113 - KINDEX(1, 493)=20 - KINDEX(2, 493)=113 - KINDEX(1, 494)=23 - KINDEX(2, 494)=113 - KINDEX(1, 495)=24 - KINDEX(2, 495)=113 - KINDEX(1, 496)=25 - KINDEX(2, 496)=113 - KINDEX(1, 497)=26 - KINDEX(2, 497)=113 - KINDEX(1, 498)=32 - KINDEX(2, 498)=113 - KINDEX(1, 499)=33 - KINDEX(2, 499)=113 - KINDEX(1, 500)=36 - KINDEX(2, 500)=113 - KINDEX(1, 501)=40 - KINDEX(2, 501)=113 - KINDEX(1, 502)=16 - KINDEX(2, 502)=114 - KINDEX(1, 503)=26 - KINDEX(2, 503)=114 - KINDEX(1, 504)=33 - KINDEX(2, 504)=114 - KINDEX(1, 505)=39 - KINDEX(2, 505)=114 - KINDEX(1, 506)=40 - KINDEX(2, 506)=114 - KINDEX(1, 507)=16 - KINDEX(2, 507)=115 - KINDEX(1, 508)=23 - KINDEX(2, 508)=115 - KINDEX(1, 509)=24 - KINDEX(2, 509)=115 - KINDEX(1, 510)=25 - KINDEX(2, 510)=115 - KINDEX(1, 511)=26 - KINDEX(2, 511)=115 - KINDEX(1, 512)=32 - KINDEX(2, 512)=115 - KINDEX(1, 513)=33 - KINDEX(2, 513)=115 - KINDEX(1, 514)=40 - KINDEX(2, 514)=115 - KINDEX(1, 515)=42 - KINDEX(2, 515)=115 - KINDEX(1, 516)=4 - KINDEX(2, 516)=116 - KINDEX(1, 517)=16 - KINDEX(2, 517)=116 - KINDEX(1, 518)=23 - KINDEX(2, 518)=116 - KINDEX(1, 519)=24 - KINDEX(2, 519)=116 - KINDEX(1, 520)=25 - KINDEX(2, 520)=116 - KINDEX(1, 521)=27 - KINDEX(2, 521)=116 - KINDEX(1, 522)=32 - KINDEX(2, 522)=116 - KINDEX(1, 523)=33 - KINDEX(2, 523)=116 - KINDEX(1, 524)=40 - KINDEX(2, 524)=116 - KINDEX(1, 525)=41 - KINDEX(2, 525)=116 - KINDEX(1, 526)=16 - KINDEX(2, 526)=117 - KINDEX(1, 527)=27 - KINDEX(2, 527)=117 - KINDEX(1, 528)=41 - KINDEX(2, 528)=117 - KINDEX(1, 529)=4 - KINDEX(2, 529)=118 - KINDEX(1, 530)=16 - KINDEX(2, 530)=118 - KINDEX(1, 531)=23 - KINDEX(2, 531)=118 - KINDEX(1, 532)=24 - KINDEX(2, 532)=118 - KINDEX(1, 533)=25 - KINDEX(2, 533)=118 - KINDEX(1, 534)=27 - KINDEX(2, 534)=118 - KINDEX(1, 535)=41 - KINDEX(2, 535)=118 - KINDEX(1, 536)=4 - KINDEX(2, 536)=119 - KINDEX(1, 537)=5 - KINDEX(2, 537)=119 - KINDEX(1, 538)=16 - KINDEX(2, 538)=119 - KINDEX(1, 539)=23 - KINDEX(2, 539)=119 - KINDEX(1, 540)=33 - KINDEX(2, 540)=119 - KINDEX(1, 541)=4 - KINDEX(2, 541)=120 - KINDEX(1, 542)=5 - KINDEX(2, 542)=120 - KINDEX(1, 543)=16 - KINDEX(2, 543)=120 - KINDEX(1, 544)=23 - KINDEX(2, 544)=120 - KINDEX(1, 545)=24 - KINDEX(2, 545)=120 - KINDEX(1, 546)=25 - KINDEX(2, 546)=120 - KINDEX(1, 547)=26 - KINDEX(2, 547)=120 - KINDEX(1, 548)=33 - KINDEX(2, 548)=120 - KINDEX(1, 549)=34 - KINDEX(2, 549)=120 - KINDEX(1, 550)=42 - KINDEX(2, 550)=120 - KINDEX(1, 551)=4 - KINDEX(2, 551)=121 - KINDEX(1, 552)=5 - KINDEX(2, 552)=121 - KINDEX(1, 553)=16 - KINDEX(2, 553)=121 - KINDEX(1, 554)=23 - KINDEX(2, 554)=121 - KINDEX(1, 555)=24 - KINDEX(2, 555)=121 - KINDEX(1, 556)=25 - KINDEX(2, 556)=121 - KINDEX(1, 557)=35 - KINDEX(2, 557)=121 - KINDEX(1, 558)=4 - KINDEX(2, 558)=122 - KINDEX(1, 559)=5 - KINDEX(2, 559)=122 - KINDEX(1, 560)=16 - KINDEX(2, 560)=122 - KINDEX(1, 561)=20 - KINDEX(2, 561)=122 - KINDEX(1, 562)=23 - KINDEX(2, 562)=122 - KINDEX(1, 563)=24 - KINDEX(2, 563)=122 - KINDEX(1, 564)=25 - KINDEX(2, 564)=122 - KINDEX(1, 565)=26 - KINDEX(2, 565)=122 - KINDEX(1, 566)=36 - KINDEX(2, 566)=122 - KINDEX(1, 567)=4 - KINDEX(2, 567)=123 - KINDEX(1, 568)=5 - KINDEX(2, 568)=123 - KINDEX(1, 569)=16 - KINDEX(2, 569)=123 - KINDEX(1, 570)=26 - KINDEX(2, 570)=123 - KINDEX(1, 571)=39 - KINDEX(2, 571)=123 - KINDEX(1, 572)=4 - KINDEX(2, 572)=124 - KINDEX(1, 573)=5 - KINDEX(2, 573)=124 - KINDEX(1, 574)=16 - KINDEX(2, 574)=124 - KINDEX(1, 575)=23 - KINDEX(2, 575)=124 - KINDEX(1, 576)=24 - KINDEX(2, 576)=124 - KINDEX(1, 577)=26 - KINDEX(2, 577)=124 - KINDEX(1, 578)=33 - KINDEX(2, 578)=124 - KINDEX(1, 579)=40 - KINDEX(2, 579)=124 - KINDEX(1, 580)=42 - KINDEX(2, 580)=124 - KINDEX(1, 581)=4 - KINDEX(2, 581)=125 - KINDEX(1, 582)=5 - KINDEX(2, 582)=125 - KINDEX(1, 583)=16 - KINDEX(2, 583)=125 - KINDEX(1, 584)=23 - KINDEX(2, 584)=125 - KINDEX(1, 585)=24 - KINDEX(2, 585)=125 - KINDEX(1, 586)=25 - KINDEX(2, 586)=125 - KINDEX(1, 587)=27 - KINDEX(2, 587)=125 - KINDEX(1, 588)=41 - KINDEX(2, 588)=125 - KINDEX(1, 589)=16 - KINDEX(2, 589)=126 - KINDEX(1, 590)=30 - KINDEX(2, 590)=126 - KINDEX(1, 591)=42 - KINDEX(2, 591)=126 - KINDEX(1, 592)=16 - KINDEX(2, 592)=127 - KINDEX(1, 593)=23 - KINDEX(2, 593)=127 - KINDEX(1, 594)=33 - KINDEX(2, 594)=127 - KINDEX(1, 595)=42 - KINDEX(2, 595)=127 - KINDEX(1, 596)=33 - KINDEX(2, 596)=128 - KINDEX(1, 597)=40 - KINDEX(2, 597)=128 - KINDEX(1, 598)=42 - KINDEX(2, 598)=128 - KINDEX(1, 599)=42 - KINDEX(2, 599)=129 - KINDEX(1, 600)=3 - KINDEX(2, 600)=130 - KINDEX(1, 601)=4 - KINDEX(2, 601)=130 - KINDEX(1, 602)=42 - KINDEX(2, 602)=130 - KINDEX(1, 603)=4 - KINDEX(2, 603)=131 - KINDEX(1, 604)=5 - KINDEX(2, 604)=131 - KINDEX(1, 605)=42 - KINDEX(2, 605)=131 - KINDEX(1, 606)=13 - KINDEX(2, 606)=132 - KINDEX(1, 607)=4 - KINDEX(2, 607)=133 - KINDEX(1, 608)=5 - KINDEX(2, 608)=133 - KINDEX(1, 609)=11 - KINDEX(2, 609)=133 - KINDEX(1, 610)=12 - KINDEX(2, 610)=133 - KINDEX(1, 611)=11 - KINDEX(2, 611)=134 - KINDEX(1, 612)=12 - KINDEX(2, 612)=134 - KINDEX(1, 613)=11 - KINDEX(2, 613)=135 - KINDEX(1, 614)=12 - KINDEX(2, 614)=135 - KINDEX(1, 615)=15 - KINDEX(2, 615)=135 -RETURN -END SUBROUTINE CH_NONZEROTERMS_GAZ -!! -END SUBROUTINE CH_NONZEROTERMS -! -!======================================================================== -! -!! ##################### - MODULE MODI_CH_SPARSE -!! ##################### -INTERFACE -SUBROUTINE CH_SPARSE(KMI, KSPARSE, KSPARSEDIM) -IMPLICIT NONE -INTEGER, INTENT(IN) :: KMI -INTEGER, INTENT(INOUT) :: KSPARSEDIM -INTEGER, INTENT(OUT), DIMENSION(2,KSPARSEDIM) :: KSPARSE -END SUBROUTINE CH_SPARSE -END INTERFACE -END MODULE MODI_CH_SPARSE -! -!======================================================================== -! -!! ############################################## - SUBROUTINE CH_SPARSE(KMI, KSPARSE, KSPARSEDIM) -!! ############################################## -!! -!!*** *MODD_CH_SPARSE* -!! -!! PURPOSE -!! ------- -! calculation of the non-zero matrix elements in the Jacobian -!! -!!** METHOD -!! ------ -!! A 2D array KSPARSE of DIMESNSION(2,*) is returned, containing -!! the indices of the non-zero matrix elements in the Jacobian. -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Karsten Suhre (LA) -!! -!! MODIFICATIONS -!! ------------- -!! Original 26/07/96 -!! Modified 05/05/98: Vectorization (Vincent Crassier & KS) -!! -!!---------------------------------------------------------------------- -!! -!! EXTERNAL -!! -------- -!! none -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -USE MODD_CH_M9_SCHEME, ONLY : TACCS -!! -!! EXPLICIT ARGUMENTS -!! ------------------ -IMPLICIT NONE -INTEGER, INTENT(IN) :: KMI -INTEGER, INTENT(INOUT) :: KSPARSEDIM -INTEGER, INTENT(OUT), DIMENSION(2,KSPARSEDIM) :: KSPARSE -!! -!! LOCAL VARIABLES -!! --------------- -!! none -!!---------------------------------------------------------------------- -!! -!! EXECUTABLE STATEMENTS -!! --------------------- -IF (TACCS(KMI)%LUSECHAQ) THEN - CALL CH_SPARSE_AQ -ELSE - CALL CH_SPARSE_GAZ -END IF -CONTAINS -!! -!! ####################### - SUBROUTINE CH_SPARSE_AQ -!! ####################### -!! -!!*** *MODD_CH_SPARSE* -!! -!! PURPOSE -!! ------- -! calculation of the non-zero matrix elements in the Jacobian -!! -!!** METHOD -!! ------ -!! A 2D array KSPARSE of DIMESNSION(2,*) is returned, containing -!! the indices of the non-zero matrix elements in the Jacobian. -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Karsten Suhre (LA) -!! -!! MODIFICATIONS -!! ------------- -!! Original 26/07/96 -!! Modified 05/05/98: Vectorization (Vincent Crassier & KS) -!! -!!---------------------------------------------------------------------- -!! -!! EXTERNAL -!! -------- -!! none -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! none -!! -!! EXPLICIT ARGUMENTS -!! ------------------ -IMPLICIT NONE -!! -!! LOCAL VARIABLES -!! --------------- -!! none -!!---------------------------------------------------------------------- -!! -!! EXECUTABLE STATEMENTS -!! --------------------- -! check if output array is large enough -IF (KSPARSEDIM.LT.753) THEN - STOP 'CH_SPARSE ERROR: array KSPARSE is too small!' -END IF -!O3/O3 - KSPARSE(1, 1)=1 - KSPARSE(2, 1)=1 -!O3/NO - KSPARSE(1, 2)=1 - KSPARSE(2, 2)=3 -!O3/NO2 - KSPARSE(1, 3)=1 - KSPARSE(2, 3)=4 -!O3/OH - KSPARSE(1, 4)=1 - KSPARSE(2, 4)=15 -!O3/HO2 - KSPARSE(1, 5)=1 - KSPARSE(2, 5)=16 -!O3/ALKE - KSPARSE(1, 6)=1 - KSPARSE(2, 6)=20 -!O3/BIO - KSPARSE(1, 7)=1 - KSPARSE(2, 7)=21 -!O3/CARBO - KSPARSE(1, 8)=1 - KSPARSE(2, 8)=26 -!O3/PAN - KSPARSE(1, 9)=1 - KSPARSE(2, 9)=28 -!O3/ADD - KSPARSE(1, 10)=1 - KSPARSE(2, 10)=38 -!O3/CARBOP - KSPARSE(1, 11)=1 - KSPARSE(2, 11)=40 -!O3/WC_O3 - KSPARSE(1, 12)=1 - KSPARSE(2, 12)=43 -!O3/WR_O3 - KSPARSE(1, 13)=1 - KSPARSE(2, 13)=68 -!H2O2/O3 - KSPARSE(1, 14)=2 - KSPARSE(2, 14)=1 -!H2O2/H2O2 - KSPARSE(1, 15)=2 - KSPARSE(2, 15)=2 -!H2O2/OH - KSPARSE(1, 16)=2 - KSPARSE(2, 16)=15 -!H2O2/HO2 - KSPARSE(1, 17)=2 - KSPARSE(2, 17)=16 -!H2O2/ALKE - KSPARSE(1, 18)=2 - KSPARSE(2, 18)=20 -!H2O2/BIO - KSPARSE(1, 19)=2 - KSPARSE(2, 19)=21 -!H2O2/WC_H2O2 - KSPARSE(1, 20)=2 - KSPARSE(2, 20)=44 -!H2O2/WR_H2O2 - KSPARSE(1, 21)=2 - KSPARSE(2, 21)=69 -!NO/O3 - KSPARSE(1, 22)=3 - KSPARSE(2, 22)=1 -!NO/NO - KSPARSE(1, 23)=3 - KSPARSE(2, 23)=3 -!NO/NO2 - KSPARSE(1, 24)=3 - KSPARSE(2, 24)=4 -!NO/NO3 - KSPARSE(1, 25)=3 - KSPARSE(2, 25)=5 -!NO/HONO - KSPARSE(1, 26)=3 - KSPARSE(2, 26)=7 -!NO/OH - KSPARSE(1, 27)=3 - KSPARSE(2, 27)=15 -!NO/HO2 - KSPARSE(1, 28)=3 - KSPARSE(2, 28)=16 -!NO/MO2 - KSPARSE(1, 29)=3 - KSPARSE(2, 29)=33 -!NO/ALKAP - KSPARSE(1, 30)=3 - KSPARSE(2, 30)=34 -!NO/ALKEP - KSPARSE(1, 31)=3 - KSPARSE(2, 31)=35 -!NO/BIOP - KSPARSE(1, 32)=3 - KSPARSE(2, 32)=36 -!NO/AROP - KSPARSE(1, 33)=3 - KSPARSE(2, 33)=39 -!NO/CARBOP - KSPARSE(1, 34)=3 - KSPARSE(2, 34)=40 -!NO/OLN - KSPARSE(1, 35)=3 - KSPARSE(2, 35)=41 -!NO/XO2 - KSPARSE(1, 36)=3 - KSPARSE(2, 36)=42 -!NO/WC_NO - KSPARSE(1, 37)=3 - KSPARSE(2, 37)=45 -!NO/WR_NO - KSPARSE(1, 38)=3 - KSPARSE(2, 38)=70 -!NO2/O3 - KSPARSE(1, 39)=4 - KSPARSE(2, 39)=1 -!NO2/NO - KSPARSE(1, 40)=4 - KSPARSE(2, 40)=3 -!NO2/NO2 - KSPARSE(1, 41)=4 - KSPARSE(2, 41)=4 -!NO2/NO3 - KSPARSE(1, 42)=4 - KSPARSE(2, 42)=5 -!NO2/N2O5 - KSPARSE(1, 43)=4 - KSPARSE(2, 43)=6 -!NO2/HONO - KSPARSE(1, 44)=4 - KSPARSE(2, 44)=7 -!NO2/HNO3 - KSPARSE(1, 45)=4 - KSPARSE(2, 45)=8 -!NO2/HNO4 - KSPARSE(1, 46)=4 - KSPARSE(2, 46)=9 -!NO2/DMS - KSPARSE(1, 47)=4 - KSPARSE(2, 47)=11 -!NO2/OH - KSPARSE(1, 48)=4 - KSPARSE(2, 48)=15 -!NO2/HO2 - KSPARSE(1, 49)=4 - KSPARSE(2, 49)=16 -!NO2/CARBO - KSPARSE(1, 50)=4 - KSPARSE(2, 50)=26 -!NO2/ONIT - KSPARSE(1, 51)=4 - KSPARSE(2, 51)=27 -!NO2/PAN - KSPARSE(1, 52)=4 - KSPARSE(2, 52)=28 -!NO2/MO2 - KSPARSE(1, 53)=4 - KSPARSE(2, 53)=33 -!NO2/ALKAP - KSPARSE(1, 54)=4 - KSPARSE(2, 54)=34 -!NO2/ALKEP - KSPARSE(1, 55)=4 - KSPARSE(2, 55)=35 -!NO2/BIOP - KSPARSE(1, 56)=4 - KSPARSE(2, 56)=36 -!NO2/PHO - KSPARSE(1, 57)=4 - KSPARSE(2, 57)=37 -!NO2/ADD - KSPARSE(1, 58)=4 - KSPARSE(2, 58)=38 -!NO2/AROP - KSPARSE(1, 59)=4 - KSPARSE(2, 59)=39 -!NO2/CARBOP - KSPARSE(1, 60)=4 - KSPARSE(2, 60)=40 -!NO2/OLN - KSPARSE(1, 61)=4 - KSPARSE(2, 61)=41 -!NO2/XO2 - KSPARSE(1, 62)=4 - KSPARSE(2, 62)=42 -!NO2/WC_NO2 - KSPARSE(1, 63)=4 - KSPARSE(2, 63)=46 -!NO2/WR_NO2 - KSPARSE(1, 64)=4 - KSPARSE(2, 64)=71 -!NO3/O3 - KSPARSE(1, 65)=5 - KSPARSE(2, 65)=1 -!NO3/NO - KSPARSE(1, 66)=5 - KSPARSE(2, 66)=3 -!NO3/NO2 - KSPARSE(1, 67)=5 - KSPARSE(2, 67)=4 -!NO3/NO3 - KSPARSE(1, 68)=5 - KSPARSE(2, 68)=5 -!NO3/N2O5 - KSPARSE(1, 69)=5 - KSPARSE(2, 69)=6 -!NO3/HNO3 - KSPARSE(1, 70)=5 - KSPARSE(2, 70)=8 -!NO3/HNO4 - KSPARSE(1, 71)=5 - KSPARSE(2, 71)=9 -!NO3/DMS - KSPARSE(1, 72)=5 - KSPARSE(2, 72)=11 -!NO3/OH - KSPARSE(1, 73)=5 - KSPARSE(2, 73)=15 -!NO3/HO2 - KSPARSE(1, 74)=5 - KSPARSE(2, 74)=16 -!NO3/ALKE - KSPARSE(1, 75)=5 - KSPARSE(2, 75)=20 -!NO3/BIO - KSPARSE(1, 76)=5 - KSPARSE(2, 76)=21 -!NO3/ARO - KSPARSE(1, 77)=5 - KSPARSE(2, 77)=22 -!NO3/HCHO - KSPARSE(1, 78)=5 - KSPARSE(2, 78)=23 -!NO3/ALD - KSPARSE(1, 79)=5 - KSPARSE(2, 79)=24 -!NO3/CARBO - KSPARSE(1, 80)=5 - KSPARSE(2, 80)=26 -!NO3/PAN - KSPARSE(1, 81)=5 - KSPARSE(2, 81)=28 -!NO3/MO2 - KSPARSE(1, 82)=5 - KSPARSE(2, 82)=33 -!NO3/ALKAP - KSPARSE(1, 83)=5 - KSPARSE(2, 83)=34 -!NO3/ALKEP - KSPARSE(1, 84)=5 - KSPARSE(2, 84)=35 -!NO3/BIOP - KSPARSE(1, 85)=5 - KSPARSE(2, 85)=36 -!NO3/AROP - KSPARSE(1, 86)=5 - KSPARSE(2, 86)=39 -!NO3/CARBOP - KSPARSE(1, 87)=5 - KSPARSE(2, 87)=40 -!NO3/OLN - KSPARSE(1, 88)=5 - KSPARSE(2, 88)=41 -!NO3/XO2 - KSPARSE(1, 89)=5 - KSPARSE(2, 89)=42 -!NO3/WC_NO3 - KSPARSE(1, 90)=5 - KSPARSE(2, 90)=47 -!NO3/WR_NO3 - KSPARSE(1, 91)=5 - KSPARSE(2, 91)=72 -!N2O5/NO2 - KSPARSE(1, 92)=6 - KSPARSE(2, 92)=4 -!N2O5/NO3 - KSPARSE(1, 93)=6 - KSPARSE(2, 93)=5 -!N2O5/N2O5 - KSPARSE(1, 94)=6 - KSPARSE(2, 94)=6 -!N2O5/WC_N2O5 - KSPARSE(1, 95)=6 - KSPARSE(2, 95)=48 -!N2O5/WR_N2O5 - KSPARSE(1, 96)=6 - KSPARSE(2, 96)=73 -!HONO/NO - KSPARSE(1, 97)=7 - KSPARSE(2, 97)=3 -!HONO/NO2 - KSPARSE(1, 98)=7 - KSPARSE(2, 98)=4 -!HONO/HONO - KSPARSE(1, 99)=7 - KSPARSE(2, 99)=7 -!HONO/OH - KSPARSE(1, 100)=7 - KSPARSE(2, 100)=15 -!HONO/ADD - KSPARSE(1, 101)=7 - KSPARSE(2, 101)=38 -!HONO/WC_HONO - KSPARSE(1, 102)=7 - KSPARSE(2, 102)=49 -!HONO/WR_HONO - KSPARSE(1, 103)=7 - KSPARSE(2, 103)=74 -!HNO3/NO2 - KSPARSE(1, 104)=8 - KSPARSE(2, 104)=4 -!HNO3/NO3 - KSPARSE(1, 105)=8 - KSPARSE(2, 105)=5 -!HNO3/HNO3 - KSPARSE(1, 106)=8 - KSPARSE(2, 106)=8 -!HNO3/OH - KSPARSE(1, 107)=8 - KSPARSE(2, 107)=15 -!HNO3/HO2 - KSPARSE(1, 108)=8 - KSPARSE(2, 108)=16 -!HNO3/ARO - KSPARSE(1, 109)=8 - KSPARSE(2, 109)=22 -!HNO3/HCHO - KSPARSE(1, 110)=8 - KSPARSE(2, 110)=23 -!HNO3/ALD - KSPARSE(1, 111)=8 - KSPARSE(2, 111)=24 -!HNO3/CARBO - KSPARSE(1, 112)=8 - KSPARSE(2, 112)=26 -!HNO3/WC_HNO3 - KSPARSE(1, 113)=8 - KSPARSE(2, 113)=50 -!HNO3/WR_HNO3 - KSPARSE(1, 114)=8 - KSPARSE(2, 114)=75 -!HNO4/NO2 - KSPARSE(1, 115)=9 - KSPARSE(2, 115)=4 -!HNO4/HNO4 - KSPARSE(1, 116)=9 - KSPARSE(2, 116)=9 -!HNO4/OH - KSPARSE(1, 117)=9 - KSPARSE(2, 117)=15 -!HNO4/HO2 - KSPARSE(1, 118)=9 - KSPARSE(2, 118)=16 -!HNO4/WC_HNO4 - KSPARSE(1, 119)=9 - KSPARSE(2, 119)=51 -!HNO4/WR_HNO4 - KSPARSE(1, 120)=9 - KSPARSE(2, 120)=76 -!NH3/NH3 - KSPARSE(1, 121)=10 - KSPARSE(2, 121)=10 -!NH3/OH - KSPARSE(1, 122)=10 - KSPARSE(2, 122)=15 -!NH3/WC_NH3 - KSPARSE(1, 123)=10 - KSPARSE(2, 123)=52 -!NH3/WR_NH3 - KSPARSE(1, 124)=10 - KSPARSE(2, 124)=77 -!DMS/NO3 - KSPARSE(1, 125)=11 - KSPARSE(2, 125)=5 -!DMS/DMS - KSPARSE(1, 126)=11 - KSPARSE(2, 126)=11 -!DMS/OH - KSPARSE(1, 127)=11 - KSPARSE(2, 127)=15 -!SO2/NO3 - KSPARSE(1, 128)=12 - KSPARSE(2, 128)=5 -!SO2/DMS - KSPARSE(1, 129)=12 - KSPARSE(2, 129)=11 -!SO2/SO2 - KSPARSE(1, 130)=12 - KSPARSE(2, 130)=12 -!SO2/OH - KSPARSE(1, 131)=12 - KSPARSE(2, 131)=15 -!SO2/WC_SO2 - KSPARSE(1, 132)=12 - KSPARSE(2, 132)=56 -!SO2/WR_SO2 - KSPARSE(1, 133)=12 - KSPARSE(2, 133)=81 -!SULF/SO2 - KSPARSE(1, 134)=13 - KSPARSE(2, 134)=12 -!SULF/SULF - KSPARSE(1, 135)=13 - KSPARSE(2, 135)=13 -!SULF/OH - KSPARSE(1, 136)=13 - KSPARSE(2, 136)=15 -!SULF/WC_SULF - KSPARSE(1, 137)=13 - KSPARSE(2, 137)=57 -!SULF/WR_SULF - KSPARSE(1, 138)=13 - KSPARSE(2, 138)=82 -!CO/O3 - KSPARSE(1, 139)=14 - KSPARSE(2, 139)=1 -!CO/NO3 - KSPARSE(1, 140)=14 - KSPARSE(2, 140)=5 -!CO/CO - KSPARSE(1, 141)=14 - KSPARSE(2, 141)=14 -!CO/OH - KSPARSE(1, 142)=14 - KSPARSE(2, 142)=15 -!CO/ALKA - KSPARSE(1, 143)=14 - KSPARSE(2, 143)=19 -!CO/ALKE - KSPARSE(1, 144)=14 - KSPARSE(2, 144)=20 -!CO/BIO - KSPARSE(1, 145)=14 - KSPARSE(2, 145)=21 -!CO/HCHO - KSPARSE(1, 146)=14 - KSPARSE(2, 146)=23 -!CO/ALD - KSPARSE(1, 147)=14 - KSPARSE(2, 147)=24 -!CO/CARBO - KSPARSE(1, 148)=14 - KSPARSE(2, 148)=26 -!CO/PAN - KSPARSE(1, 149)=14 - KSPARSE(2, 149)=28 -!OH/O3 - KSPARSE(1, 150)=15 - KSPARSE(2, 150)=1 -!OH/H2O2 - KSPARSE(1, 151)=15 - KSPARSE(2, 151)=2 -!OH/NO - KSPARSE(1, 152)=15 - KSPARSE(2, 152)=3 -!OH/NO2 - KSPARSE(1, 153)=15 - KSPARSE(2, 153)=4 -!OH/NO3 - KSPARSE(1, 154)=15 - KSPARSE(2, 154)=5 -!OH/HONO - KSPARSE(1, 155)=15 - KSPARSE(2, 155)=7 -!OH/HNO3 - KSPARSE(1, 156)=15 - KSPARSE(2, 156)=8 -!OH/HNO4 - KSPARSE(1, 157)=15 - KSPARSE(2, 157)=9 -!OH/NH3 - KSPARSE(1, 158)=15 - KSPARSE(2, 158)=10 -!OH/DMS - KSPARSE(1, 159)=15 - KSPARSE(2, 159)=11 -!OH/SO2 - KSPARSE(1, 160)=15 - KSPARSE(2, 160)=12 -!OH/CO - KSPARSE(1, 161)=15 - KSPARSE(2, 161)=14 -!OH/OH - KSPARSE(1, 162)=15 - KSPARSE(2, 162)=15 -!OH/HO2 - KSPARSE(1, 163)=15 - KSPARSE(2, 163)=16 -!OH/CH4 - KSPARSE(1, 164)=15 - KSPARSE(2, 164)=17 -!OH/ETH - KSPARSE(1, 165)=15 - KSPARSE(2, 165)=18 -!OH/ALKA - KSPARSE(1, 166)=15 - KSPARSE(2, 166)=19 -!OH/ALKE - KSPARSE(1, 167)=15 - KSPARSE(2, 167)=20 -!OH/BIO - KSPARSE(1, 168)=15 - KSPARSE(2, 168)=21 -!OH/ARO - KSPARSE(1, 169)=15 - KSPARSE(2, 169)=22 -!OH/HCHO - KSPARSE(1, 170)=15 - KSPARSE(2, 170)=23 -!OH/ALD - KSPARSE(1, 171)=15 - KSPARSE(2, 171)=24 -!OH/KET - KSPARSE(1, 172)=15 - KSPARSE(2, 172)=25 -!OH/CARBO - KSPARSE(1, 173)=15 - KSPARSE(2, 173)=26 -!OH/ONIT - KSPARSE(1, 174)=15 - KSPARSE(2, 174)=27 -!OH/PAN - KSPARSE(1, 175)=15 - KSPARSE(2, 175)=28 -!OH/OP1 - KSPARSE(1, 176)=15 - KSPARSE(2, 176)=29 -!OH/OP2 - KSPARSE(1, 177)=15 - KSPARSE(2, 177)=30 -!OH/ORA1 - KSPARSE(1, 178)=15 - KSPARSE(2, 178)=31 -!OH/ORA2 - KSPARSE(1, 179)=15 - KSPARSE(2, 179)=32 -!OH/ADD - KSPARSE(1, 180)=15 - KSPARSE(2, 180)=38 -!OH/WC_OH - KSPARSE(1, 181)=15 - KSPARSE(2, 181)=53 -!OH/WR_OH - KSPARSE(1, 182)=15 - KSPARSE(2, 182)=78 -!HO2/O3 - KSPARSE(1, 183)=16 - KSPARSE(2, 183)=1 -!HO2/H2O2 - KSPARSE(1, 184)=16 - KSPARSE(2, 184)=2 -!HO2/NO - KSPARSE(1, 185)=16 - KSPARSE(2, 185)=3 -!HO2/NO2 - KSPARSE(1, 186)=16 - KSPARSE(2, 186)=4 -!HO2/NO3 - KSPARSE(1, 187)=16 - KSPARSE(2, 187)=5 -!HO2/HNO4 - KSPARSE(1, 188)=16 - KSPARSE(2, 188)=9 -!HO2/SO2 - KSPARSE(1, 189)=16 - KSPARSE(2, 189)=12 -!HO2/CO - KSPARSE(1, 190)=16 - KSPARSE(2, 190)=14 -!HO2/OH - KSPARSE(1, 191)=16 - KSPARSE(2, 191)=15 -!HO2/HO2 - KSPARSE(1, 192)=16 - KSPARSE(2, 192)=16 -!HO2/ALKA - KSPARSE(1, 193)=16 - KSPARSE(2, 193)=19 -!HO2/ALKE - KSPARSE(1, 194)=16 - KSPARSE(2, 194)=20 -!HO2/BIO - KSPARSE(1, 195)=16 - KSPARSE(2, 195)=21 -!HO2/ARO - KSPARSE(1, 196)=16 - KSPARSE(2, 196)=22 -!HO2/HCHO - KSPARSE(1, 197)=16 - KSPARSE(2, 197)=23 -!HO2/ALD - KSPARSE(1, 198)=16 - KSPARSE(2, 198)=24 -!HO2/CARBO - KSPARSE(1, 199)=16 - KSPARSE(2, 199)=26 -!HO2/ONIT - KSPARSE(1, 200)=16 - KSPARSE(2, 200)=27 -!HO2/PAN - KSPARSE(1, 201)=16 - KSPARSE(2, 201)=28 -!HO2/OP1 - KSPARSE(1, 202)=16 - KSPARSE(2, 202)=29 -!HO2/OP2 - KSPARSE(1, 203)=16 - KSPARSE(2, 203)=30 -!HO2/ORA1 - KSPARSE(1, 204)=16 - KSPARSE(2, 204)=31 -!HO2/MO2 - KSPARSE(1, 205)=16 - KSPARSE(2, 205)=33 -!HO2/ALKAP - KSPARSE(1, 206)=16 - KSPARSE(2, 206)=34 -!HO2/ALKEP - KSPARSE(1, 207)=16 - KSPARSE(2, 207)=35 -!HO2/BIOP - KSPARSE(1, 208)=16 - KSPARSE(2, 208)=36 -!HO2/PHO - KSPARSE(1, 209)=16 - KSPARSE(2, 209)=37 -!HO2/ADD - KSPARSE(1, 210)=16 - KSPARSE(2, 210)=38 -!HO2/AROP - KSPARSE(1, 211)=16 - KSPARSE(2, 211)=39 -!HO2/CARBOP - KSPARSE(1, 212)=16 - KSPARSE(2, 212)=40 -!HO2/OLN - KSPARSE(1, 213)=16 - KSPARSE(2, 213)=41 -!HO2/XO2 - KSPARSE(1, 214)=16 - KSPARSE(2, 214)=42 -!HO2/WC_HO2 - KSPARSE(1, 215)=16 - KSPARSE(2, 215)=54 -!HO2/WR_HO2 - KSPARSE(1, 216)=16 - KSPARSE(2, 216)=79 -!CH4/O3 - KSPARSE(1, 217)=17 - KSPARSE(2, 217)=1 -!CH4/OH - KSPARSE(1, 218)=17 - KSPARSE(2, 218)=15 -!CH4/CH4 - KSPARSE(1, 219)=17 - KSPARSE(2, 219)=17 -!CH4/ALKE - KSPARSE(1, 220)=17 - KSPARSE(2, 220)=20 -!ETH/O3 - KSPARSE(1, 221)=18 - KSPARSE(2, 221)=1 -!ETH/OH - KSPARSE(1, 222)=18 - KSPARSE(2, 222)=15 -!ETH/ETH - KSPARSE(1, 223)=18 - KSPARSE(2, 223)=18 -!ETH/ALKE - KSPARSE(1, 224)=18 - KSPARSE(2, 224)=20 -!ALKA/OH - KSPARSE(1, 225)=19 - KSPARSE(2, 225)=15 -!ALKA/ALKA - KSPARSE(1, 226)=19 - KSPARSE(2, 226)=19 -!ALKE/O3 - KSPARSE(1, 227)=20 - KSPARSE(2, 227)=1 -!ALKE/NO - KSPARSE(1, 228)=20 - KSPARSE(2, 228)=3 -!ALKE/NO3 - KSPARSE(1, 229)=20 - KSPARSE(2, 229)=5 -!ALKE/OH - KSPARSE(1, 230)=20 - KSPARSE(2, 230)=15 -!ALKE/ALKE - KSPARSE(1, 231)=20 - KSPARSE(2, 231)=20 -!ALKE/BIO - KSPARSE(1, 232)=20 - KSPARSE(2, 232)=21 -!ALKE/MO2 - KSPARSE(1, 233)=20 - KSPARSE(2, 233)=33 -!ALKE/BIOP - KSPARSE(1, 234)=20 - KSPARSE(2, 234)=36 -!ALKE/CARBOP - KSPARSE(1, 235)=20 - KSPARSE(2, 235)=40 -!BIO/O3 - KSPARSE(1, 236)=21 - KSPARSE(2, 236)=1 -!BIO/NO3 - KSPARSE(1, 237)=21 - KSPARSE(2, 237)=5 -!BIO/OH - KSPARSE(1, 238)=21 - KSPARSE(2, 238)=15 -!BIO/BIO - KSPARSE(1, 239)=21 - KSPARSE(2, 239)=21 -!ARO/O3 - KSPARSE(1, 240)=22 - KSPARSE(2, 240)=1 -!ARO/NO2 - KSPARSE(1, 241)=22 - KSPARSE(2, 241)=4 -!ARO/NO3 - KSPARSE(1, 242)=22 - KSPARSE(2, 242)=5 -!ARO/OH - KSPARSE(1, 243)=22 - KSPARSE(2, 243)=15 -!ARO/HO2 - KSPARSE(1, 244)=22 - KSPARSE(2, 244)=16 -!ARO/ARO - KSPARSE(1, 245)=22 - KSPARSE(2, 245)=22 -!ARO/PHO - KSPARSE(1, 246)=22 - KSPARSE(2, 246)=37 -!ARO/ADD - KSPARSE(1, 247)=22 - KSPARSE(2, 247)=38 -!HCHO/O3 - KSPARSE(1, 248)=23 - KSPARSE(2, 248)=1 -!HCHO/NO - KSPARSE(1, 249)=23 - KSPARSE(2, 249)=3 -!HCHO/NO3 - KSPARSE(1, 250)=23 - KSPARSE(2, 250)=5 -!HCHO/OH - KSPARSE(1, 251)=23 - KSPARSE(2, 251)=15 -!HCHO/ALKA - KSPARSE(1, 252)=23 - KSPARSE(2, 252)=19 -!HCHO/ALKE - KSPARSE(1, 253)=23 - KSPARSE(2, 253)=20 -!HCHO/BIO - KSPARSE(1, 254)=23 - KSPARSE(2, 254)=21 -!HCHO/HCHO - KSPARSE(1, 255)=23 - KSPARSE(2, 255)=23 -!HCHO/CARBO - KSPARSE(1, 256)=23 - KSPARSE(2, 256)=26 -!HCHO/PAN - KSPARSE(1, 257)=23 - KSPARSE(2, 257)=28 -!HCHO/OP1 - KSPARSE(1, 258)=23 - KSPARSE(2, 258)=29 -!HCHO/OP2 - KSPARSE(1, 259)=23 - KSPARSE(2, 259)=30 -!HCHO/MO2 - KSPARSE(1, 260)=23 - KSPARSE(2, 260)=33 -!HCHO/ALKAP - KSPARSE(1, 261)=23 - KSPARSE(2, 261)=34 -!HCHO/ALKEP - KSPARSE(1, 262)=23 - KSPARSE(2, 262)=35 -!HCHO/BIOP - KSPARSE(1, 263)=23 - KSPARSE(2, 263)=36 -!HCHO/AROP - KSPARSE(1, 264)=23 - KSPARSE(2, 264)=39 -!HCHO/CARBOP - KSPARSE(1, 265)=23 - KSPARSE(2, 265)=40 -!HCHO/OLN - KSPARSE(1, 266)=23 - KSPARSE(2, 266)=41 -!HCHO/XO2 - KSPARSE(1, 267)=23 - KSPARSE(2, 267)=42 -!HCHO/WC_HCHO - KSPARSE(1, 268)=23 - KSPARSE(2, 268)=58 -!HCHO/WR_HCHO - KSPARSE(1, 269)=23 - KSPARSE(2, 269)=83 -!ALD/O3 - KSPARSE(1, 270)=24 - KSPARSE(2, 270)=1 -!ALD/NO - KSPARSE(1, 271)=24 - KSPARSE(2, 271)=3 -!ALD/NO3 - KSPARSE(1, 272)=24 - KSPARSE(2, 272)=5 -!ALD/OH - KSPARSE(1, 273)=24 - KSPARSE(2, 273)=15 -!ALD/ALKA - KSPARSE(1, 274)=24 - KSPARSE(2, 274)=19 -!ALD/ALKE - KSPARSE(1, 275)=24 - KSPARSE(2, 275)=20 -!ALD/BIO - KSPARSE(1, 276)=24 - KSPARSE(2, 276)=21 -!ALD/ALD - KSPARSE(1, 277)=24 - KSPARSE(2, 277)=24 -!ALD/CARBO - KSPARSE(1, 278)=24 - KSPARSE(2, 278)=26 -!ALD/ONIT - KSPARSE(1, 279)=24 - KSPARSE(2, 279)=27 -!ALD/OP2 - KSPARSE(1, 280)=24 - KSPARSE(2, 280)=30 -!ALD/MO2 - KSPARSE(1, 281)=24 - KSPARSE(2, 281)=33 -!ALD/ALKAP - KSPARSE(1, 282)=24 - KSPARSE(2, 282)=34 -!ALD/ALKEP - KSPARSE(1, 283)=24 - KSPARSE(2, 283)=35 -!ALD/BIOP - KSPARSE(1, 284)=24 - KSPARSE(2, 284)=36 -!ALD/CARBOP - KSPARSE(1, 285)=24 - KSPARSE(2, 285)=40 -!ALD/OLN - KSPARSE(1, 286)=24 - KSPARSE(2, 286)=41 -!KET/O3 - KSPARSE(1, 287)=25 - KSPARSE(2, 287)=1 -!KET/NO - KSPARSE(1, 288)=25 - KSPARSE(2, 288)=3 -!KET/NO3 - KSPARSE(1, 289)=25 - KSPARSE(2, 289)=5 -!KET/OH - KSPARSE(1, 290)=25 - KSPARSE(2, 290)=15 -!KET/ALKA - KSPARSE(1, 291)=25 - KSPARSE(2, 291)=19 -!KET/ALKE - KSPARSE(1, 292)=25 - KSPARSE(2, 292)=20 -!KET/BIO - KSPARSE(1, 293)=25 - KSPARSE(2, 293)=21 -!KET/KET - KSPARSE(1, 294)=25 - KSPARSE(2, 294)=25 -!KET/CARBO - KSPARSE(1, 295)=25 - KSPARSE(2, 295)=26 -!KET/ONIT - KSPARSE(1, 296)=25 - KSPARSE(2, 296)=27 -!KET/OP2 - KSPARSE(1, 297)=25 - KSPARSE(2, 297)=30 -!KET/MO2 - KSPARSE(1, 298)=25 - KSPARSE(2, 298)=33 -!KET/ALKAP - KSPARSE(1, 299)=25 - KSPARSE(2, 299)=34 -!KET/ALKEP - KSPARSE(1, 300)=25 - KSPARSE(2, 300)=35 -!KET/BIOP - KSPARSE(1, 301)=25 - KSPARSE(2, 301)=36 -!KET/CARBOP - KSPARSE(1, 302)=25 - KSPARSE(2, 302)=40 -!KET/OLN - KSPARSE(1, 303)=25 - KSPARSE(2, 303)=41 -!CARBO/O3 - KSPARSE(1, 304)=26 - KSPARSE(2, 304)=1 -!CARBO/NO - KSPARSE(1, 305)=26 - KSPARSE(2, 305)=3 -!CARBO/NO3 - KSPARSE(1, 306)=26 - KSPARSE(2, 306)=5 -!CARBO/OH - KSPARSE(1, 307)=26 - KSPARSE(2, 307)=15 -!CARBO/ALKA - KSPARSE(1, 308)=26 - KSPARSE(2, 308)=19 -!CARBO/ALKE - KSPARSE(1, 309)=26 - KSPARSE(2, 309)=20 -!CARBO/BIO - KSPARSE(1, 310)=26 - KSPARSE(2, 310)=21 -!CARBO/CARBO - KSPARSE(1, 311)=26 - KSPARSE(2, 311)=26 -!CARBO/PAN - KSPARSE(1, 312)=26 - KSPARSE(2, 312)=28 -!CARBO/MO2 - KSPARSE(1, 313)=26 - KSPARSE(2, 313)=33 -!CARBO/ALKAP - KSPARSE(1, 314)=26 - KSPARSE(2, 314)=34 -!CARBO/BIOP - KSPARSE(1, 315)=26 - KSPARSE(2, 315)=36 -!CARBO/AROP - KSPARSE(1, 316)=26 - KSPARSE(2, 316)=39 -!CARBO/CARBOP - KSPARSE(1, 317)=26 - KSPARSE(2, 317)=40 -!ONIT/NO - KSPARSE(1, 318)=27 - KSPARSE(2, 318)=3 -!ONIT/NO2 - KSPARSE(1, 319)=27 - KSPARSE(2, 319)=4 -!ONIT/NO3 - KSPARSE(1, 320)=27 - KSPARSE(2, 320)=5 -!ONIT/OH - KSPARSE(1, 321)=27 - KSPARSE(2, 321)=15 -!ONIT/HO2 - KSPARSE(1, 322)=27 - KSPARSE(2, 322)=16 -!ONIT/ONIT - KSPARSE(1, 323)=27 - KSPARSE(2, 323)=27 -!ONIT/PAN - KSPARSE(1, 324)=27 - KSPARSE(2, 324)=28 -!ONIT/MO2 - KSPARSE(1, 325)=27 - KSPARSE(2, 325)=33 -!ONIT/ALKAP - KSPARSE(1, 326)=27 - KSPARSE(2, 326)=34 -!ONIT/BIOP - KSPARSE(1, 327)=27 - KSPARSE(2, 327)=36 -!ONIT/PHO - KSPARSE(1, 328)=27 - KSPARSE(2, 328)=37 -!ONIT/AROP - KSPARSE(1, 329)=27 - KSPARSE(2, 329)=39 -!ONIT/CARBOP - KSPARSE(1, 330)=27 - KSPARSE(2, 330)=40 -!ONIT/OLN - KSPARSE(1, 331)=27 - KSPARSE(2, 331)=41 -!PAN/O3 - KSPARSE(1, 332)=28 - KSPARSE(2, 332)=1 -!PAN/NO2 - KSPARSE(1, 333)=28 - KSPARSE(2, 333)=4 -!PAN/NO3 - KSPARSE(1, 334)=28 - KSPARSE(2, 334)=5 -!PAN/OH - KSPARSE(1, 335)=28 - KSPARSE(2, 335)=15 -!PAN/PAN - KSPARSE(1, 336)=28 - KSPARSE(2, 336)=28 -!PAN/CARBOP - KSPARSE(1, 337)=28 - KSPARSE(2, 337)=40 -!OP1/OH - KSPARSE(1, 338)=29 - KSPARSE(2, 338)=15 -!OP1/HO2 - KSPARSE(1, 339)=29 - KSPARSE(2, 339)=16 -!OP1/OP1 - KSPARSE(1, 340)=29 - KSPARSE(2, 340)=29 -!OP1/MO2 - KSPARSE(1, 341)=29 - KSPARSE(2, 341)=33 -!OP1/WC_OP1 - KSPARSE(1, 342)=29 - KSPARSE(2, 342)=62 -!OP1/WR_OP1 - KSPARSE(1, 343)=29 - KSPARSE(2, 343)=87 -!OP2/O3 - KSPARSE(1, 344)=30 - KSPARSE(2, 344)=1 -!OP2/OH - KSPARSE(1, 345)=30 - KSPARSE(2, 345)=15 -!OP2/HO2 - KSPARSE(1, 346)=30 - KSPARSE(2, 346)=16 -!OP2/CARBO - KSPARSE(1, 347)=30 - KSPARSE(2, 347)=26 -!OP2/OP2 - KSPARSE(1, 348)=30 - KSPARSE(2, 348)=30 -!OP2/ALKAP - KSPARSE(1, 349)=30 - KSPARSE(2, 349)=34 -!OP2/ALKEP - KSPARSE(1, 350)=30 - KSPARSE(2, 350)=35 -!OP2/BIOP - KSPARSE(1, 351)=30 - KSPARSE(2, 351)=36 -!OP2/AROP - KSPARSE(1, 352)=30 - KSPARSE(2, 352)=39 -!OP2/CARBOP - KSPARSE(1, 353)=30 - KSPARSE(2, 353)=40 -!OP2/XO2 - KSPARSE(1, 354)=30 - KSPARSE(2, 354)=42 -!ORA1/O3 - KSPARSE(1, 355)=31 - KSPARSE(2, 355)=1 -!ORA1/OH - KSPARSE(1, 356)=31 - KSPARSE(2, 356)=15 -!ORA1/ALKA - KSPARSE(1, 357)=31 - KSPARSE(2, 357)=19 -!ORA1/ALKE - KSPARSE(1, 358)=31 - KSPARSE(2, 358)=20 -!ORA1/BIO - KSPARSE(1, 359)=31 - KSPARSE(2, 359)=21 -!ORA1/CARBO - KSPARSE(1, 360)=31 - KSPARSE(2, 360)=26 -!ORA1/PAN - KSPARSE(1, 361)=31 - KSPARSE(2, 361)=28 -!ORA1/ORA1 - KSPARSE(1, 362)=31 - KSPARSE(2, 362)=31 -!ORA1/WC_ORA1 - KSPARSE(1, 363)=31 - KSPARSE(2, 363)=59 -!ORA1/WR_ORA1 - KSPARSE(1, 364)=31 - KSPARSE(2, 364)=84 -!ORA2/O3 - KSPARSE(1, 365)=32 - KSPARSE(2, 365)=1 -!ORA2/OH - KSPARSE(1, 366)=32 - KSPARSE(2, 366)=15 -!ORA2/HO2 - KSPARSE(1, 367)=32 - KSPARSE(2, 367)=16 -!ORA2/ALKE - KSPARSE(1, 368)=32 - KSPARSE(2, 368)=20 -!ORA2/BIO - KSPARSE(1, 369)=32 - KSPARSE(2, 369)=21 -!ORA2/CARBO - KSPARSE(1, 370)=32 - KSPARSE(2, 370)=26 -!ORA2/ORA2 - KSPARSE(1, 371)=32 - KSPARSE(2, 371)=32 -!ORA2/MO2 - KSPARSE(1, 372)=32 - KSPARSE(2, 372)=33 -!ORA2/ALKAP - KSPARSE(1, 373)=32 - KSPARSE(2, 373)=34 -!ORA2/ALKEP - KSPARSE(1, 374)=32 - KSPARSE(2, 374)=35 -!ORA2/BIOP - KSPARSE(1, 375)=32 - KSPARSE(2, 375)=36 -!ORA2/CARBOP - KSPARSE(1, 376)=32 - KSPARSE(2, 376)=40 -!ORA2/OLN - KSPARSE(1, 377)=32 - KSPARSE(2, 377)=41 -!ORA2/WC_ORA2 - KSPARSE(1, 378)=32 - KSPARSE(2, 378)=60 -!ORA2/WR_ORA2 - KSPARSE(1, 379)=32 - KSPARSE(2, 379)=85 -!MO2/O3 - KSPARSE(1, 380)=33 - KSPARSE(2, 380)=1 -!MO2/NO - KSPARSE(1, 381)=33 - KSPARSE(2, 381)=3 -!MO2/NO3 - KSPARSE(1, 382)=33 - KSPARSE(2, 382)=5 -!MO2/OH - KSPARSE(1, 383)=33 - KSPARSE(2, 383)=15 -!MO2/HO2 - KSPARSE(1, 384)=33 - KSPARSE(2, 384)=16 -!MO2/CH4 - KSPARSE(1, 385)=33 - KSPARSE(2, 385)=17 -!MO2/ALKE - KSPARSE(1, 386)=33 - KSPARSE(2, 386)=20 -!MO2/BIO - KSPARSE(1, 387)=33 - KSPARSE(2, 387)=21 -!MO2/ALD - KSPARSE(1, 388)=33 - KSPARSE(2, 388)=24 -!MO2/OP1 - KSPARSE(1, 389)=33 - KSPARSE(2, 389)=29 -!MO2/OP2 - KSPARSE(1, 390)=33 - KSPARSE(2, 390)=30 -!MO2/MO2 - KSPARSE(1, 391)=33 - KSPARSE(2, 391)=33 -!MO2/ALKAP - KSPARSE(1, 392)=33 - KSPARSE(2, 392)=34 -!MO2/ALKEP - KSPARSE(1, 393)=33 - KSPARSE(2, 393)=35 -!MO2/BIOP - KSPARSE(1, 394)=33 - KSPARSE(2, 394)=36 -!MO2/AROP - KSPARSE(1, 395)=33 - KSPARSE(2, 395)=39 -!MO2/CARBOP - KSPARSE(1, 396)=33 - KSPARSE(2, 396)=40 -!MO2/OLN - KSPARSE(1, 397)=33 - KSPARSE(2, 397)=41 -!MO2/XO2 - KSPARSE(1, 398)=33 - KSPARSE(2, 398)=42 -!MO2/WC_MO2 - KSPARSE(1, 399)=33 - KSPARSE(2, 399)=61 -!MO2/WR_MO2 - KSPARSE(1, 400)=33 - KSPARSE(2, 400)=86 -!ALKAP/O3 - KSPARSE(1, 401)=34 - KSPARSE(2, 401)=1 -!ALKAP/NO - KSPARSE(1, 402)=34 - KSPARSE(2, 402)=3 -!ALKAP/NO3 - KSPARSE(1, 403)=34 - KSPARSE(2, 403)=5 -!ALKAP/OH - KSPARSE(1, 404)=34 - KSPARSE(2, 404)=15 -!ALKAP/HO2 - KSPARSE(1, 405)=34 - KSPARSE(2, 405)=16 -!ALKAP/ETH - KSPARSE(1, 406)=34 - KSPARSE(2, 406)=18 -!ALKAP/ALKA - KSPARSE(1, 407)=34 - KSPARSE(2, 407)=19 -!ALKAP/ALKE - KSPARSE(1, 408)=34 - KSPARSE(2, 408)=20 -!ALKAP/BIO - KSPARSE(1, 409)=34 - KSPARSE(2, 409)=21 -!ALKAP/KET - KSPARSE(1, 410)=34 - KSPARSE(2, 410)=25 -!ALKAP/ONIT - KSPARSE(1, 411)=34 - KSPARSE(2, 411)=27 -!ALKAP/OP2 - KSPARSE(1, 412)=34 - KSPARSE(2, 412)=30 -!ALKAP/MO2 - KSPARSE(1, 413)=34 - KSPARSE(2, 413)=33 -!ALKAP/ALKAP - KSPARSE(1, 414)=34 - KSPARSE(2, 414)=34 -!ALKAP/CARBOP - KSPARSE(1, 415)=34 - KSPARSE(2, 415)=40 -!ALKEP/NO - KSPARSE(1, 416)=35 - KSPARSE(2, 416)=3 -!ALKEP/NO3 - KSPARSE(1, 417)=35 - KSPARSE(2, 417)=5 -!ALKEP/OH - KSPARSE(1, 418)=35 - KSPARSE(2, 418)=15 -!ALKEP/HO2 - KSPARSE(1, 419)=35 - KSPARSE(2, 419)=16 -!ALKEP/ALKE - KSPARSE(1, 420)=35 - KSPARSE(2, 420)=20 -!ALKEP/MO2 - KSPARSE(1, 421)=35 - KSPARSE(2, 421)=33 -!ALKEP/ALKEP - KSPARSE(1, 422)=35 - KSPARSE(2, 422)=35 -!ALKEP/CARBOP - KSPARSE(1, 423)=35 - KSPARSE(2, 423)=40 -!BIOP/NO - KSPARSE(1, 424)=36 - KSPARSE(2, 424)=3 -!BIOP/NO3 - KSPARSE(1, 425)=36 - KSPARSE(2, 425)=5 -!BIOP/OH - KSPARSE(1, 426)=36 - KSPARSE(2, 426)=15 -!BIOP/HO2 - KSPARSE(1, 427)=36 - KSPARSE(2, 427)=16 -!BIOP/ALKE - KSPARSE(1, 428)=36 - KSPARSE(2, 428)=20 -!BIOP/BIO - KSPARSE(1, 429)=36 - KSPARSE(2, 429)=21 -!BIOP/MO2 - KSPARSE(1, 430)=36 - KSPARSE(2, 430)=33 -!BIOP/BIOP - KSPARSE(1, 431)=36 - KSPARSE(2, 431)=36 -!BIOP/CARBOP - KSPARSE(1, 432)=36 - KSPARSE(2, 432)=40 -!PHO/NO2 - KSPARSE(1, 433)=37 - KSPARSE(2, 433)=4 -!PHO/NO3 - KSPARSE(1, 434)=37 - KSPARSE(2, 434)=5 -!PHO/OH - KSPARSE(1, 435)=37 - KSPARSE(2, 435)=15 -!PHO/HO2 - KSPARSE(1, 436)=37 - KSPARSE(2, 436)=16 -!PHO/ARO - KSPARSE(1, 437)=37 - KSPARSE(2, 437)=22 -!PHO/PHO - KSPARSE(1, 438)=37 - KSPARSE(2, 438)=37 -!ADD/O3 - KSPARSE(1, 439)=38 - KSPARSE(2, 439)=1 -!ADD/NO2 - KSPARSE(1, 440)=38 - KSPARSE(2, 440)=4 -!ADD/OH - KSPARSE(1, 441)=38 - KSPARSE(2, 441)=15 -!ADD/ARO - KSPARSE(1, 442)=38 - KSPARSE(2, 442)=22 -!ADD/ADD - KSPARSE(1, 443)=38 - KSPARSE(2, 443)=38 -!AROP/NO - KSPARSE(1, 444)=39 - KSPARSE(2, 444)=3 -!AROP/NO3 - KSPARSE(1, 445)=39 - KSPARSE(2, 445)=5 -!AROP/HO2 - KSPARSE(1, 446)=39 - KSPARSE(2, 446)=16 -!AROP/MO2 - KSPARSE(1, 447)=39 - KSPARSE(2, 447)=33 -!AROP/ADD - KSPARSE(1, 448)=39 - KSPARSE(2, 448)=38 -!AROP/AROP - KSPARSE(1, 449)=39 - KSPARSE(2, 449)=39 -!AROP/CARBOP - KSPARSE(1, 450)=39 - KSPARSE(2, 450)=40 -!CARBOP/O3 - KSPARSE(1, 451)=40 - KSPARSE(2, 451)=1 -!CARBOP/NO - KSPARSE(1, 452)=40 - KSPARSE(2, 452)=3 -!CARBOP/NO2 - KSPARSE(1, 453)=40 - KSPARSE(2, 453)=4 -!CARBOP/NO3 - KSPARSE(1, 454)=40 - KSPARSE(2, 454)=5 -!CARBOP/OH - KSPARSE(1, 455)=40 - KSPARSE(2, 455)=15 -!CARBOP/HO2 - KSPARSE(1, 456)=40 - KSPARSE(2, 456)=16 -!CARBOP/ALKE - KSPARSE(1, 457)=40 - KSPARSE(2, 457)=20 -!CARBOP/BIO - KSPARSE(1, 458)=40 - KSPARSE(2, 458)=21 -!CARBOP/ALD - KSPARSE(1, 459)=40 - KSPARSE(2, 459)=24 -!CARBOP/KET - KSPARSE(1, 460)=40 - KSPARSE(2, 460)=25 -!CARBOP/CARBO - KSPARSE(1, 461)=40 - KSPARSE(2, 461)=26 -!CARBOP/PAN - KSPARSE(1, 462)=40 - KSPARSE(2, 462)=28 -!CARBOP/OP2 - KSPARSE(1, 463)=40 - KSPARSE(2, 463)=30 -!CARBOP/MO2 - KSPARSE(1, 464)=40 - KSPARSE(2, 464)=33 -!CARBOP/ALKAP - KSPARSE(1, 465)=40 - KSPARSE(2, 465)=34 -!CARBOP/ALKEP - KSPARSE(1, 466)=40 - KSPARSE(2, 466)=35 -!CARBOP/BIOP - KSPARSE(1, 467)=40 - KSPARSE(2, 467)=36 -!CARBOP/AROP - KSPARSE(1, 468)=40 - KSPARSE(2, 468)=39 -!CARBOP/CARBOP - KSPARSE(1, 469)=40 - KSPARSE(2, 469)=40 -!CARBOP/OLN - KSPARSE(1, 470)=40 - KSPARSE(2, 470)=41 -!CARBOP/XO2 - KSPARSE(1, 471)=40 - KSPARSE(2, 471)=42 -!OLN/NO - KSPARSE(1, 472)=41 - KSPARSE(2, 472)=3 -!OLN/NO3 - KSPARSE(1, 473)=41 - KSPARSE(2, 473)=5 -!OLN/HO2 - KSPARSE(1, 474)=41 - KSPARSE(2, 474)=16 -!OLN/ALKE - KSPARSE(1, 475)=41 - KSPARSE(2, 475)=20 -!OLN/BIO - KSPARSE(1, 476)=41 - KSPARSE(2, 476)=21 -!OLN/CARBO - KSPARSE(1, 477)=41 - KSPARSE(2, 477)=26 -!OLN/MO2 - KSPARSE(1, 478)=41 - KSPARSE(2, 478)=33 -!OLN/CARBOP - KSPARSE(1, 479)=41 - KSPARSE(2, 479)=40 -!OLN/OLN - KSPARSE(1, 480)=41 - KSPARSE(2, 480)=41 -!XO2/O3 - KSPARSE(1, 481)=42 - KSPARSE(2, 481)=1 -!XO2/NO - KSPARSE(1, 482)=42 - KSPARSE(2, 482)=3 -!XO2/NO3 - KSPARSE(1, 483)=42 - KSPARSE(2, 483)=5 -!XO2/OH - KSPARSE(1, 484)=42 - KSPARSE(2, 484)=15 -!XO2/HO2 - KSPARSE(1, 485)=42 - KSPARSE(2, 485)=16 -!XO2/ALKE - KSPARSE(1, 486)=42 - KSPARSE(2, 486)=20 -!XO2/BIO - KSPARSE(1, 487)=42 - KSPARSE(2, 487)=21 -!XO2/ARO - KSPARSE(1, 488)=42 - KSPARSE(2, 488)=22 -!XO2/CARBO - KSPARSE(1, 489)=42 - KSPARSE(2, 489)=26 -!XO2/PAN - KSPARSE(1, 490)=42 - KSPARSE(2, 490)=28 -!XO2/OP2 - KSPARSE(1, 491)=42 - KSPARSE(2, 491)=30 -!XO2/MO2 - KSPARSE(1, 492)=42 - KSPARSE(2, 492)=33 -!XO2/ALKAP - KSPARSE(1, 493)=42 - KSPARSE(2, 493)=34 -!XO2/CARBOP - KSPARSE(1, 494)=42 - KSPARSE(2, 494)=40 -!XO2/XO2 - KSPARSE(1, 495)=42 - KSPARSE(2, 495)=42 -!WC_O3/O3 - KSPARSE(1, 496)=43 - KSPARSE(2, 496)=1 -!WC_O3/WC_O3 - KSPARSE(1, 497)=43 - KSPARSE(2, 497)=43 -!WC_O3/WC_HO2 - KSPARSE(1, 498)=43 - KSPARSE(2, 498)=54 -!WC_O3/WC_SO2 - KSPARSE(1, 499)=43 - KSPARSE(2, 499)=56 -!WC_H2O2/H2O2 - KSPARSE(1, 500)=44 - KSPARSE(2, 500)=2 -!WC_H2O2/WC_H2O2 - KSPARSE(1, 501)=44 - KSPARSE(2, 501)=44 -!WC_H2O2/WC_OH - KSPARSE(1, 502)=44 - KSPARSE(2, 502)=53 -!WC_H2O2/WC_HO2 - KSPARSE(1, 503)=44 - KSPARSE(2, 503)=54 -!WC_H2O2/WC_SO2 - KSPARSE(1, 504)=44 - KSPARSE(2, 504)=56 -!WC_NO/NO - KSPARSE(1, 505)=45 - KSPARSE(2, 505)=3 -!WC_NO/WC_NO - KSPARSE(1, 506)=45 - KSPARSE(2, 506)=45 -!WC_NO2/NO2 - KSPARSE(1, 507)=46 - KSPARSE(2, 507)=4 -!WC_NO2/WC_NO2 - KSPARSE(1, 508)=46 - KSPARSE(2, 508)=46 -!WC_NO2/WC_HONO - KSPARSE(1, 509)=46 - KSPARSE(2, 509)=49 -!WC_NO2/WC_HNO3 - KSPARSE(1, 510)=46 - KSPARSE(2, 510)=50 -!WC_NO2/WC_HNO4 - KSPARSE(1, 511)=46 - KSPARSE(2, 511)=51 -!WC_NO2/WC_OH - KSPARSE(1, 512)=46 - KSPARSE(2, 512)=53 -!WC_NO2/WC_HO2 - KSPARSE(1, 513)=46 - KSPARSE(2, 513)=54 -!WC_NO3/NO3 - KSPARSE(1, 514)=47 - KSPARSE(2, 514)=5 -!WC_NO3/WC_NO3 - KSPARSE(1, 515)=47 - KSPARSE(2, 515)=47 -!WC_NO3/WC_SO2 - KSPARSE(1, 516)=47 - KSPARSE(2, 516)=56 -!WC_NO3/WC_SULF - KSPARSE(1, 517)=47 - KSPARSE(2, 517)=57 -!WC_N2O5/N2O5 - KSPARSE(1, 518)=48 - KSPARSE(2, 518)=6 -!WC_N2O5/WC_N2O5 - KSPARSE(1, 519)=48 - KSPARSE(2, 519)=48 -!WC_HONO/HONO - KSPARSE(1, 520)=49 - KSPARSE(2, 520)=7 -!WC_HONO/WC_HONO - KSPARSE(1, 521)=49 - KSPARSE(2, 521)=49 -!WC_HONO/WC_HNO4 - KSPARSE(1, 522)=49 - KSPARSE(2, 522)=51 -!WC_HONO/WC_OH - KSPARSE(1, 523)=49 - KSPARSE(2, 523)=53 -!WC_HNO3/HNO3 - KSPARSE(1, 524)=50 - KSPARSE(2, 524)=8 -!WC_HNO3/WC_NO3 - KSPARSE(1, 525)=50 - KSPARSE(2, 525)=47 -!WC_HNO3/WC_N2O5 - KSPARSE(1, 526)=50 - KSPARSE(2, 526)=48 -!WC_HNO3/WC_HNO3 - KSPARSE(1, 527)=50 - KSPARSE(2, 527)=50 -!WC_HNO3/WC_HNO4 - KSPARSE(1, 528)=50 - KSPARSE(2, 528)=51 -!WC_HNO3/WC_SO2 - KSPARSE(1, 529)=50 - KSPARSE(2, 529)=56 -!WC_HNO3/WC_SULF - KSPARSE(1, 530)=50 - KSPARSE(2, 530)=57 -!WC_HNO4/HNO4 - KSPARSE(1, 531)=51 - KSPARSE(2, 531)=9 -!WC_HNO4/WC_NO2 - KSPARSE(1, 532)=51 - KSPARSE(2, 532)=46 -!WC_HNO4/WC_HNO4 - KSPARSE(1, 533)=51 - KSPARSE(2, 533)=51 -!WC_HNO4/WC_HO2 - KSPARSE(1, 534)=51 - KSPARSE(2, 534)=54 -!WC_HNO4/WC_SO2 - KSPARSE(1, 535)=51 - KSPARSE(2, 535)=56 -!WC_NH3/NH3 - KSPARSE(1, 536)=52 - KSPARSE(2, 536)=10 -!WC_NH3/WC_NH3 - KSPARSE(1, 537)=52 - KSPARSE(2, 537)=52 -!WC_OH/OH - KSPARSE(1, 538)=53 - KSPARSE(2, 538)=15 -!WC_OH/WC_O3 - KSPARSE(1, 539)=53 - KSPARSE(2, 539)=43 -!WC_OH/WC_H2O2 - KSPARSE(1, 540)=53 - KSPARSE(2, 540)=44 -!WC_OH/WC_HONO - KSPARSE(1, 541)=53 - KSPARSE(2, 541)=49 -!WC_OH/WC_HNO3 - KSPARSE(1, 542)=53 - KSPARSE(2, 542)=50 -!WC_OH/WC_OH - KSPARSE(1, 543)=53 - KSPARSE(2, 543)=53 -!WC_OH/WC_HO2 - KSPARSE(1, 544)=53 - KSPARSE(2, 544)=54 -!WC_OH/WC_SO2 - KSPARSE(1, 545)=53 - KSPARSE(2, 545)=56 -!WC_OH/WC_HCHO - KSPARSE(1, 546)=53 - KSPARSE(2, 546)=58 -!WC_OH/WC_ORA1 - KSPARSE(1, 547)=53 - KSPARSE(2, 547)=59 -!WC_OH/WC_ASO4 - KSPARSE(1, 548)=53 - KSPARSE(2, 548)=64 -!WC_OH/WC_AHMS - KSPARSE(1, 549)=53 - KSPARSE(2, 549)=67 -!WC_HO2/HO2 - KSPARSE(1, 550)=54 - KSPARSE(2, 550)=16 -!WC_HO2/WC_O3 - KSPARSE(1, 551)=54 - KSPARSE(2, 551)=43 -!WC_HO2/WC_H2O2 - KSPARSE(1, 552)=54 - KSPARSE(2, 552)=44 -!WC_HO2/WC_NO2 - KSPARSE(1, 553)=54 - KSPARSE(2, 553)=46 -!WC_HO2/WC_HNO4 - KSPARSE(1, 554)=54 - KSPARSE(2, 554)=51 -!WC_HO2/WC_OH - KSPARSE(1, 555)=54 - KSPARSE(2, 555)=53 -!WC_HO2/WC_HO2 - KSPARSE(1, 556)=54 - KSPARSE(2, 556)=54 -!WC_HO2/WC_HCHO - KSPARSE(1, 557)=54 - KSPARSE(2, 557)=58 -!WC_HO2/WC_ORA1 - KSPARSE(1, 558)=54 - KSPARSE(2, 558)=59 -!WC_HO2/WC_MO2 - KSPARSE(1, 559)=54 - KSPARSE(2, 559)=61 -!WC_HO2/WC_ASO5 - KSPARSE(1, 560)=54 - KSPARSE(2, 560)=65 -!WC_HO2/WC_AHMS - KSPARSE(1, 561)=54 - KSPARSE(2, 561)=67 -!WC_CO2/WC_OH - KSPARSE(1, 562)=55 - KSPARSE(2, 562)=53 -!WC_CO2/WC_CO2 - KSPARSE(1, 563)=55 - KSPARSE(2, 563)=55 -!WC_CO2/WC_ORA1 - KSPARSE(1, 564)=55 - KSPARSE(2, 564)=59 -!WC_SO2/SO2 - KSPARSE(1, 565)=56 - KSPARSE(2, 565)=12 -!WC_SO2/WC_O3 - KSPARSE(1, 566)=56 - KSPARSE(2, 566)=43 -!WC_SO2/WC_H2O2 - KSPARSE(1, 567)=56 - KSPARSE(2, 567)=44 -!WC_SO2/WC_NO3 - KSPARSE(1, 568)=56 - KSPARSE(2, 568)=47 -!WC_SO2/WC_HNO4 - KSPARSE(1, 569)=56 - KSPARSE(2, 569)=51 -!WC_SO2/WC_OH - KSPARSE(1, 570)=56 - KSPARSE(2, 570)=53 -!WC_SO2/WC_SO2 - KSPARSE(1, 571)=56 - KSPARSE(2, 571)=56 -!WC_SO2/WC_HCHO - KSPARSE(1, 572)=56 - KSPARSE(2, 572)=58 -!WC_SO2/WC_MO2 - KSPARSE(1, 573)=56 - KSPARSE(2, 573)=61 -!WC_SO2/WC_AHSO5 - KSPARSE(1, 574)=56 - KSPARSE(2, 574)=66 -!WC_SO2/WC_AHMS - KSPARSE(1, 575)=56 - KSPARSE(2, 575)=67 -!WC_SULF/SULF - KSPARSE(1, 576)=57 - KSPARSE(2, 576)=13 -!WC_SULF/WC_O3 - KSPARSE(1, 577)=57 - KSPARSE(2, 577)=43 -!WC_SULF/WC_H2O2 - KSPARSE(1, 578)=57 - KSPARSE(2, 578)=44 -!WC_SULF/WC_NO3 - KSPARSE(1, 579)=57 - KSPARSE(2, 579)=47 -!WC_SULF/WC_HNO4 - KSPARSE(1, 580)=57 - KSPARSE(2, 580)=51 -!WC_SULF/WC_SO2 - KSPARSE(1, 581)=57 - KSPARSE(2, 581)=56 -!WC_SULF/WC_SULF - KSPARSE(1, 582)=57 - KSPARSE(2, 582)=57 -!WC_SULF/WC_ASO4 - KSPARSE(1, 583)=57 - KSPARSE(2, 583)=64 -!WC_SULF/WC_AHSO5 - KSPARSE(1, 584)=57 - KSPARSE(2, 584)=66 -!WC_HCHO/HCHO - KSPARSE(1, 585)=58 - KSPARSE(2, 585)=23 -!WC_HCHO/WC_OH - KSPARSE(1, 586)=58 - KSPARSE(2, 586)=53 -!WC_HCHO/WC_SO2 - KSPARSE(1, 587)=58 - KSPARSE(2, 587)=56 -!WC_HCHO/WC_HCHO - KSPARSE(1, 588)=58 - KSPARSE(2, 588)=58 -!WC_HCHO/WC_MO2 - KSPARSE(1, 589)=58 - KSPARSE(2, 589)=61 -!WC_HCHO/WC_AHMS - KSPARSE(1, 590)=58 - KSPARSE(2, 590)=67 -!WC_ORA1/ORA1 - KSPARSE(1, 591)=59 - KSPARSE(2, 591)=31 -!WC_ORA1/WC_OH - KSPARSE(1, 592)=59 - KSPARSE(2, 592)=53 -!WC_ORA1/WC_HCHO - KSPARSE(1, 593)=59 - KSPARSE(2, 593)=58 -!WC_ORA1/WC_ORA1 - KSPARSE(1, 594)=59 - KSPARSE(2, 594)=59 -!WC_ORA1/WC_AHMS - KSPARSE(1, 595)=59 - KSPARSE(2, 595)=67 -!WC_ORA2/ORA2 - KSPARSE(1, 596)=60 - KSPARSE(2, 596)=32 -!WC_ORA2/WC_ORA2 - KSPARSE(1, 597)=60 - KSPARSE(2, 597)=60 -!WC_MO2/MO2 - KSPARSE(1, 598)=61 - KSPARSE(2, 598)=33 -!WC_MO2/WC_SO2 - KSPARSE(1, 599)=61 - KSPARSE(2, 599)=56 -!WC_MO2/WC_MO2 - KSPARSE(1, 600)=61 - KSPARSE(2, 600)=61 -!WC_OP1/OP1 - KSPARSE(1, 601)=62 - KSPARSE(2, 601)=29 -!WC_OP1/WC_SO2 - KSPARSE(1, 602)=62 - KSPARSE(2, 602)=56 -!WC_OP1/WC_MO2 - KSPARSE(1, 603)=62 - KSPARSE(2, 603)=61 -!WC_OP1/WC_OP1 - KSPARSE(1, 604)=62 - KSPARSE(2, 604)=62 -!WC_ASO3/WC_NO3 - KSPARSE(1, 605)=63 - KSPARSE(2, 605)=47 -!WC_ASO3/WC_OH - KSPARSE(1, 606)=63 - KSPARSE(2, 606)=53 -!WC_ASO3/WC_SO2 - KSPARSE(1, 607)=63 - KSPARSE(2, 607)=56 -!WC_ASO3/WC_MO2 - KSPARSE(1, 608)=63 - KSPARSE(2, 608)=61 -!WC_ASO3/WC_ASO3 - KSPARSE(1, 609)=63 - KSPARSE(2, 609)=63 -!WC_ASO4/WC_NO3 - KSPARSE(1, 610)=64 - KSPARSE(2, 610)=47 -!WC_ASO4/WC_SULF - KSPARSE(1, 611)=64 - KSPARSE(2, 611)=57 -!WC_ASO4/WC_ASO4 - KSPARSE(1, 612)=64 - KSPARSE(2, 612)=64 -!WC_ASO4/WC_ASO5 - KSPARSE(1, 613)=64 - KSPARSE(2, 613)=65 -!WC_ASO5/WC_HO2 - KSPARSE(1, 614)=65 - KSPARSE(2, 614)=54 -!WC_ASO5/WC_ASO3 - KSPARSE(1, 615)=65 - KSPARSE(2, 615)=63 -!WC_ASO5/WC_ASO5 - KSPARSE(1, 616)=65 - KSPARSE(2, 616)=65 -!WC_AHSO5/WC_HO2 - KSPARSE(1, 617)=66 - KSPARSE(2, 617)=54 -!WC_AHSO5/WC_SO2 - KSPARSE(1, 618)=66 - KSPARSE(2, 618)=56 -!WC_AHSO5/WC_ASO5 - KSPARSE(1, 619)=66 - KSPARSE(2, 619)=65 -!WC_AHSO5/WC_AHSO5 - KSPARSE(1, 620)=66 - KSPARSE(2, 620)=66 -!WC_AHMS/WC_OH - KSPARSE(1, 621)=67 - KSPARSE(2, 621)=53 -!WC_AHMS/WC_SO2 - KSPARSE(1, 622)=67 - KSPARSE(2, 622)=56 -!WC_AHMS/WC_HCHO - KSPARSE(1, 623)=67 - KSPARSE(2, 623)=58 -!WC_AHMS/WC_AHMS - KSPARSE(1, 624)=67 - KSPARSE(2, 624)=67 -!WR_O3/O3 - KSPARSE(1, 625)=68 - KSPARSE(2, 625)=1 -!WR_O3/WR_O3 - KSPARSE(1, 626)=68 - KSPARSE(2, 626)=68 -!WR_O3/WR_HO2 - KSPARSE(1, 627)=68 - KSPARSE(2, 627)=79 -!WR_O3/WR_SO2 - KSPARSE(1, 628)=68 - KSPARSE(2, 628)=81 -!WR_H2O2/H2O2 - KSPARSE(1, 629)=69 - KSPARSE(2, 629)=2 -!WR_H2O2/WR_H2O2 - KSPARSE(1, 630)=69 - KSPARSE(2, 630)=69 -!WR_H2O2/WR_OH - KSPARSE(1, 631)=69 - KSPARSE(2, 631)=78 -!WR_H2O2/WR_HO2 - KSPARSE(1, 632)=69 - KSPARSE(2, 632)=79 -!WR_H2O2/WR_SO2 - KSPARSE(1, 633)=69 - KSPARSE(2, 633)=81 -!WR_NO/NO - KSPARSE(1, 634)=70 - KSPARSE(2, 634)=3 -!WR_NO/WR_NO - KSPARSE(1, 635)=70 - KSPARSE(2, 635)=70 -!WR_NO2/NO2 - KSPARSE(1, 636)=71 - KSPARSE(2, 636)=4 -!WR_NO2/WR_NO2 - KSPARSE(1, 637)=71 - KSPARSE(2, 637)=71 -!WR_NO2/WR_HONO - KSPARSE(1, 638)=71 - KSPARSE(2, 638)=74 -!WR_NO2/WR_HNO3 - KSPARSE(1, 639)=71 - KSPARSE(2, 639)=75 -!WR_NO2/WR_HNO4 - KSPARSE(1, 640)=71 - KSPARSE(2, 640)=76 -!WR_NO2/WR_OH - KSPARSE(1, 641)=71 - KSPARSE(2, 641)=78 -!WR_NO2/WR_HO2 - KSPARSE(1, 642)=71 - KSPARSE(2, 642)=79 -!WR_NO3/NO3 - KSPARSE(1, 643)=72 - KSPARSE(2, 643)=5 -!WR_NO3/WR_NO3 - KSPARSE(1, 644)=72 - KSPARSE(2, 644)=72 -!WR_NO3/WR_SO2 - KSPARSE(1, 645)=72 - KSPARSE(2, 645)=81 -!WR_NO3/WR_SULF - KSPARSE(1, 646)=72 - KSPARSE(2, 646)=82 -!WR_N2O5/N2O5 - KSPARSE(1, 647)=73 - KSPARSE(2, 647)=6 -!WR_N2O5/WR_N2O5 - KSPARSE(1, 648)=73 - KSPARSE(2, 648)=73 -!WR_HONO/HONO - KSPARSE(1, 649)=74 - KSPARSE(2, 649)=7 -!WR_HONO/WR_HONO - KSPARSE(1, 650)=74 - KSPARSE(2, 650)=74 -!WR_HONO/WR_HNO4 - KSPARSE(1, 651)=74 - KSPARSE(2, 651)=76 -!WR_HONO/WR_OH - KSPARSE(1, 652)=74 - KSPARSE(2, 652)=78 -!WR_HNO3/HNO3 - KSPARSE(1, 653)=75 - KSPARSE(2, 653)=8 -!WR_HNO3/WR_NO3 - KSPARSE(1, 654)=75 - KSPARSE(2, 654)=72 -!WR_HNO3/WR_N2O5 - KSPARSE(1, 655)=75 - KSPARSE(2, 655)=73 -!WR_HNO3/WR_HNO3 - KSPARSE(1, 656)=75 - KSPARSE(2, 656)=75 -!WR_HNO3/WR_HNO4 - KSPARSE(1, 657)=75 - KSPARSE(2, 657)=76 -!WR_HNO3/WR_SO2 - KSPARSE(1, 658)=75 - KSPARSE(2, 658)=81 -!WR_HNO3/WR_SULF - KSPARSE(1, 659)=75 - KSPARSE(2, 659)=82 -!WR_HNO4/HNO4 - KSPARSE(1, 660)=76 - KSPARSE(2, 660)=9 -!WR_HNO4/WR_NO2 - KSPARSE(1, 661)=76 - KSPARSE(2, 661)=71 -!WR_HNO4/WR_HNO4 - KSPARSE(1, 662)=76 - KSPARSE(2, 662)=76 -!WR_HNO4/WR_HO2 - KSPARSE(1, 663)=76 - KSPARSE(2, 663)=79 -!WR_HNO4/WR_SO2 - KSPARSE(1, 664)=76 - KSPARSE(2, 664)=81 -!WR_NH3/NH3 - KSPARSE(1, 665)=77 - KSPARSE(2, 665)=10 -!WR_NH3/WR_NH3 - KSPARSE(1, 666)=77 - KSPARSE(2, 666)=77 -!WR_OH/OH - KSPARSE(1, 667)=78 - KSPARSE(2, 667)=15 -!WR_OH/WR_O3 - KSPARSE(1, 668)=78 - KSPARSE(2, 668)=68 -!WR_OH/WR_H2O2 - KSPARSE(1, 669)=78 - KSPARSE(2, 669)=69 -!WR_OH/WR_HONO - KSPARSE(1, 670)=78 - KSPARSE(2, 670)=74 -!WR_OH/WR_HNO3 - KSPARSE(1, 671)=78 - KSPARSE(2, 671)=75 -!WR_OH/WR_OH - KSPARSE(1, 672)=78 - KSPARSE(2, 672)=78 -!WR_OH/WR_HO2 - KSPARSE(1, 673)=78 - KSPARSE(2, 673)=79 -!WR_OH/WR_SO2 - KSPARSE(1, 674)=78 - KSPARSE(2, 674)=81 -!WR_OH/WR_HCHO - KSPARSE(1, 675)=78 - KSPARSE(2, 675)=83 -!WR_OH/WR_ORA1 - KSPARSE(1, 676)=78 - KSPARSE(2, 676)=84 -!WR_OH/WR_ASO4 - KSPARSE(1, 677)=78 - KSPARSE(2, 677)=89 -!WR_OH/WR_AHMS - KSPARSE(1, 678)=78 - KSPARSE(2, 678)=92 -!WR_HO2/HO2 - KSPARSE(1, 679)=79 - KSPARSE(2, 679)=16 -!WR_HO2/WR_O3 - KSPARSE(1, 680)=79 - KSPARSE(2, 680)=68 -!WR_HO2/WR_H2O2 - KSPARSE(1, 681)=79 - KSPARSE(2, 681)=69 -!WR_HO2/WR_NO2 - KSPARSE(1, 682)=79 - KSPARSE(2, 682)=71 -!WR_HO2/WR_HNO4 - KSPARSE(1, 683)=79 - KSPARSE(2, 683)=76 -!WR_HO2/WR_OH - KSPARSE(1, 684)=79 - KSPARSE(2, 684)=78 -!WR_HO2/WR_HO2 - KSPARSE(1, 685)=79 - KSPARSE(2, 685)=79 -!WR_HO2/WR_HCHO - KSPARSE(1, 686)=79 - KSPARSE(2, 686)=83 -!WR_HO2/WR_ORA1 - KSPARSE(1, 687)=79 - KSPARSE(2, 687)=84 -!WR_HO2/WR_MO2 - KSPARSE(1, 688)=79 - KSPARSE(2, 688)=86 -!WR_HO2/WR_ASO5 - KSPARSE(1, 689)=79 - KSPARSE(2, 689)=90 -!WR_HO2/WR_AHMS - KSPARSE(1, 690)=79 - KSPARSE(2, 690)=92 -!WR_CO2/WR_OH - KSPARSE(1, 691)=80 - KSPARSE(2, 691)=78 -!WR_CO2/WR_CO2 - KSPARSE(1, 692)=80 - KSPARSE(2, 692)=80 -!WR_CO2/WR_ORA1 - KSPARSE(1, 693)=80 - KSPARSE(2, 693)=84 -!WR_SO2/SO2 - KSPARSE(1, 694)=81 - KSPARSE(2, 694)=12 -!WR_SO2/WR_O3 - KSPARSE(1, 695)=81 - KSPARSE(2, 695)=68 -!WR_SO2/WR_H2O2 - KSPARSE(1, 696)=81 - KSPARSE(2, 696)=69 -!WR_SO2/WR_NO3 - KSPARSE(1, 697)=81 - KSPARSE(2, 697)=72 -!WR_SO2/WR_HNO4 - KSPARSE(1, 698)=81 - KSPARSE(2, 698)=76 -!WR_SO2/WR_OH - KSPARSE(1, 699)=81 - KSPARSE(2, 699)=78 -!WR_SO2/WR_SO2 - KSPARSE(1, 700)=81 - KSPARSE(2, 700)=81 -!WR_SO2/WR_HCHO - KSPARSE(1, 701)=81 - KSPARSE(2, 701)=83 -!WR_SO2/WR_MO2 - KSPARSE(1, 702)=81 - KSPARSE(2, 702)=86 -!WR_SO2/WR_AHSO5 - KSPARSE(1, 703)=81 - KSPARSE(2, 703)=91 -!WR_SO2/WR_AHMS - KSPARSE(1, 704)=81 - KSPARSE(2, 704)=92 -!WR_SULF/SULF - KSPARSE(1, 705)=82 - KSPARSE(2, 705)=13 -!WR_SULF/WR_O3 - KSPARSE(1, 706)=82 - KSPARSE(2, 706)=68 -!WR_SULF/WR_H2O2 - KSPARSE(1, 707)=82 - KSPARSE(2, 707)=69 -!WR_SULF/WR_NO3 - KSPARSE(1, 708)=82 - KSPARSE(2, 708)=72 -!WR_SULF/WR_HNO4 - KSPARSE(1, 709)=82 - KSPARSE(2, 709)=76 -!WR_SULF/WR_SO2 - KSPARSE(1, 710)=82 - KSPARSE(2, 710)=81 -!WR_SULF/WR_SULF - KSPARSE(1, 711)=82 - KSPARSE(2, 711)=82 -!WR_SULF/WR_ASO4 - KSPARSE(1, 712)=82 - KSPARSE(2, 712)=89 -!WR_SULF/WR_AHSO5 - KSPARSE(1, 713)=82 - KSPARSE(2, 713)=91 -!WR_HCHO/HCHO - KSPARSE(1, 714)=83 - KSPARSE(2, 714)=23 -!WR_HCHO/WR_OH - KSPARSE(1, 715)=83 - KSPARSE(2, 715)=78 -!WR_HCHO/WR_SO2 - KSPARSE(1, 716)=83 - KSPARSE(2, 716)=81 -!WR_HCHO/WR_HCHO - KSPARSE(1, 717)=83 - KSPARSE(2, 717)=83 -!WR_HCHO/WR_MO2 - KSPARSE(1, 718)=83 - KSPARSE(2, 718)=86 -!WR_HCHO/WR_AHMS - KSPARSE(1, 719)=83 - KSPARSE(2, 719)=92 -!WR_ORA1/ORA1 - KSPARSE(1, 720)=84 - KSPARSE(2, 720)=31 -!WR_ORA1/WR_OH - KSPARSE(1, 721)=84 - KSPARSE(2, 721)=78 -!WR_ORA1/WR_HCHO - KSPARSE(1, 722)=84 - KSPARSE(2, 722)=83 -!WR_ORA1/WR_ORA1 - KSPARSE(1, 723)=84 - KSPARSE(2, 723)=84 -!WR_ORA1/WR_AHMS - KSPARSE(1, 724)=84 - KSPARSE(2, 724)=92 -!WR_ORA2/ORA2 - KSPARSE(1, 725)=85 - KSPARSE(2, 725)=32 -!WR_ORA2/WR_ORA2 - KSPARSE(1, 726)=85 - KSPARSE(2, 726)=85 -!WR_MO2/MO2 - KSPARSE(1, 727)=86 - KSPARSE(2, 727)=33 -!WR_MO2/WR_SO2 - KSPARSE(1, 728)=86 - KSPARSE(2, 728)=81 -!WR_MO2/WR_MO2 - KSPARSE(1, 729)=86 - KSPARSE(2, 729)=86 -!WR_OP1/OP1 - KSPARSE(1, 730)=87 - KSPARSE(2, 730)=29 -!WR_OP1/WR_SO2 - KSPARSE(1, 731)=87 - KSPARSE(2, 731)=81 -!WR_OP1/WR_MO2 - KSPARSE(1, 732)=87 - KSPARSE(2, 732)=86 -!WR_OP1/WR_OP1 - KSPARSE(1, 733)=87 - KSPARSE(2, 733)=87 -!WR_ASO3/WR_NO3 - KSPARSE(1, 734)=88 - KSPARSE(2, 734)=72 -!WR_ASO3/WR_OH - KSPARSE(1, 735)=88 - KSPARSE(2, 735)=78 -!WR_ASO3/WR_SO2 - KSPARSE(1, 736)=88 - KSPARSE(2, 736)=81 -!WR_ASO3/WR_MO2 - KSPARSE(1, 737)=88 - KSPARSE(2, 737)=86 -!WR_ASO3/WR_ASO3 - KSPARSE(1, 738)=88 - KSPARSE(2, 738)=88 -!WR_ASO4/WR_NO3 - KSPARSE(1, 739)=89 - KSPARSE(2, 739)=72 -!WR_ASO4/WR_SULF - KSPARSE(1, 740)=89 - KSPARSE(2, 740)=82 -!WR_ASO4/WR_ASO4 - KSPARSE(1, 741)=89 - KSPARSE(2, 741)=89 -!WR_ASO4/WR_ASO5 - KSPARSE(1, 742)=89 - KSPARSE(2, 742)=90 -!WR_ASO5/WR_HO2 - KSPARSE(1, 743)=90 - KSPARSE(2, 743)=79 -!WR_ASO5/WR_ASO3 - KSPARSE(1, 744)=90 - KSPARSE(2, 744)=88 -!WR_ASO5/WR_ASO5 - KSPARSE(1, 745)=90 - KSPARSE(2, 745)=90 -!WR_AHSO5/WR_HO2 - KSPARSE(1, 746)=91 - KSPARSE(2, 746)=79 -!WR_AHSO5/WR_SO2 - KSPARSE(1, 747)=91 - KSPARSE(2, 747)=81 -!WR_AHSO5/WR_ASO5 - KSPARSE(1, 748)=91 - KSPARSE(2, 748)=90 -!WR_AHSO5/WR_AHSO5 - KSPARSE(1, 749)=91 - KSPARSE(2, 749)=91 -!WR_AHMS/WR_OH - KSPARSE(1, 750)=92 - KSPARSE(2, 750)=78 -!WR_AHMS/WR_SO2 - KSPARSE(1, 751)=92 - KSPARSE(2, 751)=81 -!WR_AHMS/WR_HCHO - KSPARSE(1, 752)=92 - KSPARSE(2, 752)=83 -!WR_AHMS/WR_AHMS - KSPARSE(1, 753)=92 - KSPARSE(2, 753)=92 -KSPARSEDIM = 753 -RETURN -END SUBROUTINE CH_SPARSE_AQ -!! -!! ####################### - SUBROUTINE CH_SPARSE_GAZ -!! ####################### -!! -!!*** *MODD_CH_SPARSE* -!! -!! PURPOSE -!! ------- -! calculation of the non-zero matrix elements in the Jacobian -!! -!!** METHOD -!! ------ -!! A 2D array KSPARSE of DIMESNSION(2,*) is returned, containing -!! the indices of the non-zero matrix elements in the Jacobian. -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Karsten Suhre (LA) -!! -!! MODIFICATIONS -!! ------------- -!! Original 26/07/96 -!! Modified 05/05/98: Vectorization (Vincent Crassier & KS) -!! -!!---------------------------------------------------------------------- -!! -!! EXTERNAL -!! -------- -!! none -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! none -!! -!! EXPLICIT ARGUMENTS -!! ------------------ -IMPLICIT NONE -!! -!! LOCAL VARIABLES -!! --------------- -!! none -!!---------------------------------------------------------------------- -!! -!! EXECUTABLE STATEMENTS -!! --------------------- -! check if output array is large enough -IF (KSPARSEDIM.LT.457) THEN - STOP 'CH_SPARSE ERROR: array KSPARSE is too small!' -END IF -!O3/O3 - KSPARSE(1, 1)=1 - KSPARSE(2, 1)=1 -!O3/NO - KSPARSE(1, 2)=1 - KSPARSE(2, 2)=3 -!O3/NO2 - KSPARSE(1, 3)=1 - KSPARSE(2, 3)=4 -!O3/OH - KSPARSE(1, 4)=1 - KSPARSE(2, 4)=15 -!O3/HO2 - KSPARSE(1, 5)=1 - KSPARSE(2, 5)=16 -!O3/ALKE - KSPARSE(1, 6)=1 - KSPARSE(2, 6)=20 -!O3/BIO - KSPARSE(1, 7)=1 - KSPARSE(2, 7)=21 -!O3/CARBO - KSPARSE(1, 8)=1 - KSPARSE(2, 8)=26 -!O3/PAN - KSPARSE(1, 9)=1 - KSPARSE(2, 9)=28 -!O3/ADD - KSPARSE(1, 10)=1 - KSPARSE(2, 10)=38 -!O3/CARBOP - KSPARSE(1, 11)=1 - KSPARSE(2, 11)=40 -!H2O2/O3 - KSPARSE(1, 12)=2 - KSPARSE(2, 12)=1 -!H2O2/H2O2 - KSPARSE(1, 13)=2 - KSPARSE(2, 13)=2 -!H2O2/OH - KSPARSE(1, 14)=2 - KSPARSE(2, 14)=15 -!H2O2/HO2 - KSPARSE(1, 15)=2 - KSPARSE(2, 15)=16 -!H2O2/ALKE - KSPARSE(1, 16)=2 - KSPARSE(2, 16)=20 -!H2O2/BIO - KSPARSE(1, 17)=2 - KSPARSE(2, 17)=21 -!NO/O3 - KSPARSE(1, 18)=3 - KSPARSE(2, 18)=1 -!NO/NO - KSPARSE(1, 19)=3 - KSPARSE(2, 19)=3 -!NO/NO2 - KSPARSE(1, 20)=3 - KSPARSE(2, 20)=4 -!NO/NO3 - KSPARSE(1, 21)=3 - KSPARSE(2, 21)=5 -!NO/HONO - KSPARSE(1, 22)=3 - KSPARSE(2, 22)=7 -!NO/OH - KSPARSE(1, 23)=3 - KSPARSE(2, 23)=15 -!NO/HO2 - KSPARSE(1, 24)=3 - KSPARSE(2, 24)=16 -!NO/MO2 - KSPARSE(1, 25)=3 - KSPARSE(2, 25)=33 -!NO/ALKAP - KSPARSE(1, 26)=3 - KSPARSE(2, 26)=34 -!NO/ALKEP - KSPARSE(1, 27)=3 - KSPARSE(2, 27)=35 -!NO/BIOP - KSPARSE(1, 28)=3 - KSPARSE(2, 28)=36 -!NO/AROP - KSPARSE(1, 29)=3 - KSPARSE(2, 29)=39 -!NO/CARBOP - KSPARSE(1, 30)=3 - KSPARSE(2, 30)=40 -!NO/OLN - KSPARSE(1, 31)=3 - KSPARSE(2, 31)=41 -!NO/XO2 - KSPARSE(1, 32)=3 - KSPARSE(2, 32)=42 -!NO2/O3 - KSPARSE(1, 33)=4 - KSPARSE(2, 33)=1 -!NO2/NO - KSPARSE(1, 34)=4 - KSPARSE(2, 34)=3 -!NO2/NO2 - KSPARSE(1, 35)=4 - KSPARSE(2, 35)=4 -!NO2/NO3 - KSPARSE(1, 36)=4 - KSPARSE(2, 36)=5 -!NO2/N2O5 - KSPARSE(1, 37)=4 - KSPARSE(2, 37)=6 -!NO2/HONO - KSPARSE(1, 38)=4 - KSPARSE(2, 38)=7 -!NO2/HNO3 - KSPARSE(1, 39)=4 - KSPARSE(2, 39)=8 -!NO2/HNO4 - KSPARSE(1, 40)=4 - KSPARSE(2, 40)=9 -!NO2/DMS - KSPARSE(1, 41)=4 - KSPARSE(2, 41)=11 -!NO2/OH - KSPARSE(1, 42)=4 - KSPARSE(2, 42)=15 -!NO2/HO2 - KSPARSE(1, 43)=4 - KSPARSE(2, 43)=16 -!NO2/CARBO - KSPARSE(1, 44)=4 - KSPARSE(2, 44)=26 -!NO2/ONIT - KSPARSE(1, 45)=4 - KSPARSE(2, 45)=27 -!NO2/PAN - KSPARSE(1, 46)=4 - KSPARSE(2, 46)=28 -!NO2/MO2 - KSPARSE(1, 47)=4 - KSPARSE(2, 47)=33 -!NO2/ALKAP - KSPARSE(1, 48)=4 - KSPARSE(2, 48)=34 -!NO2/ALKEP - KSPARSE(1, 49)=4 - KSPARSE(2, 49)=35 -!NO2/BIOP - KSPARSE(1, 50)=4 - KSPARSE(2, 50)=36 -!NO2/PHO - KSPARSE(1, 51)=4 - KSPARSE(2, 51)=37 -!NO2/ADD - KSPARSE(1, 52)=4 - KSPARSE(2, 52)=38 -!NO2/AROP - KSPARSE(1, 53)=4 - KSPARSE(2, 53)=39 -!NO2/CARBOP - KSPARSE(1, 54)=4 - KSPARSE(2, 54)=40 -!NO2/OLN - KSPARSE(1, 55)=4 - KSPARSE(2, 55)=41 -!NO2/XO2 - KSPARSE(1, 56)=4 - KSPARSE(2, 56)=42 -!NO3/O3 - KSPARSE(1, 57)=5 - KSPARSE(2, 57)=1 -!NO3/NO - KSPARSE(1, 58)=5 - KSPARSE(2, 58)=3 -!NO3/NO2 - KSPARSE(1, 59)=5 - KSPARSE(2, 59)=4 -!NO3/NO3 - KSPARSE(1, 60)=5 - KSPARSE(2, 60)=5 -!NO3/N2O5 - KSPARSE(1, 61)=5 - KSPARSE(2, 61)=6 -!NO3/HNO3 - KSPARSE(1, 62)=5 - KSPARSE(2, 62)=8 -!NO3/HNO4 - KSPARSE(1, 63)=5 - KSPARSE(2, 63)=9 -!NO3/DMS - KSPARSE(1, 64)=5 - KSPARSE(2, 64)=11 -!NO3/OH - KSPARSE(1, 65)=5 - KSPARSE(2, 65)=15 -!NO3/HO2 - KSPARSE(1, 66)=5 - KSPARSE(2, 66)=16 -!NO3/ALKE - KSPARSE(1, 67)=5 - KSPARSE(2, 67)=20 -!NO3/BIO - KSPARSE(1, 68)=5 - KSPARSE(2, 68)=21 -!NO3/ARO - KSPARSE(1, 69)=5 - KSPARSE(2, 69)=22 -!NO3/HCHO - KSPARSE(1, 70)=5 - KSPARSE(2, 70)=23 -!NO3/ALD - KSPARSE(1, 71)=5 - KSPARSE(2, 71)=24 -!NO3/CARBO - KSPARSE(1, 72)=5 - KSPARSE(2, 72)=26 -!NO3/PAN - KSPARSE(1, 73)=5 - KSPARSE(2, 73)=28 -!NO3/MO2 - KSPARSE(1, 74)=5 - KSPARSE(2, 74)=33 -!NO3/ALKAP - KSPARSE(1, 75)=5 - KSPARSE(2, 75)=34 -!NO3/ALKEP - KSPARSE(1, 76)=5 - KSPARSE(2, 76)=35 -!NO3/BIOP - KSPARSE(1, 77)=5 - KSPARSE(2, 77)=36 -!NO3/AROP - KSPARSE(1, 78)=5 - KSPARSE(2, 78)=39 -!NO3/CARBOP - KSPARSE(1, 79)=5 - KSPARSE(2, 79)=40 -!NO3/OLN - KSPARSE(1, 80)=5 - KSPARSE(2, 80)=41 -!NO3/XO2 - KSPARSE(1, 81)=5 - KSPARSE(2, 81)=42 -!N2O5/NO2 - KSPARSE(1, 82)=6 - KSPARSE(2, 82)=4 -!N2O5/NO3 - KSPARSE(1, 83)=6 - KSPARSE(2, 83)=5 -!N2O5/N2O5 - KSPARSE(1, 84)=6 - KSPARSE(2, 84)=6 -!HONO/NO - KSPARSE(1, 85)=7 - KSPARSE(2, 85)=3 -!HONO/NO2 - KSPARSE(1, 86)=7 - KSPARSE(2, 86)=4 -!HONO/HONO - KSPARSE(1, 87)=7 - KSPARSE(2, 87)=7 -!HONO/OH - KSPARSE(1, 88)=7 - KSPARSE(2, 88)=15 -!HONO/ADD - KSPARSE(1, 89)=7 - KSPARSE(2, 89)=38 -!HNO3/NO2 - KSPARSE(1, 90)=8 - KSPARSE(2, 90)=4 -!HNO3/NO3 - KSPARSE(1, 91)=8 - KSPARSE(2, 91)=5 -!HNO3/HNO3 - KSPARSE(1, 92)=8 - KSPARSE(2, 92)=8 -!HNO3/OH - KSPARSE(1, 93)=8 - KSPARSE(2, 93)=15 -!HNO3/HO2 - KSPARSE(1, 94)=8 - KSPARSE(2, 94)=16 -!HNO3/ARO - KSPARSE(1, 95)=8 - KSPARSE(2, 95)=22 -!HNO3/HCHO - KSPARSE(1, 96)=8 - KSPARSE(2, 96)=23 -!HNO3/ALD - KSPARSE(1, 97)=8 - KSPARSE(2, 97)=24 -!HNO3/CARBO - KSPARSE(1, 98)=8 - KSPARSE(2, 98)=26 -!HNO4/NO2 - KSPARSE(1, 99)=9 - KSPARSE(2, 99)=4 -!HNO4/HNO4 - KSPARSE(1, 100)=9 - KSPARSE(2, 100)=9 -!HNO4/OH - KSPARSE(1, 101)=9 - KSPARSE(2, 101)=15 -!HNO4/HO2 - KSPARSE(1, 102)=9 - KSPARSE(2, 102)=16 -!NH3/NH3 - KSPARSE(1, 103)=10 - KSPARSE(2, 103)=10 -!NH3/OH - KSPARSE(1, 104)=10 - KSPARSE(2, 104)=15 -!DMS/NO3 - KSPARSE(1, 105)=11 - KSPARSE(2, 105)=5 -!DMS/DMS - KSPARSE(1, 106)=11 - KSPARSE(2, 106)=11 -!DMS/OH - KSPARSE(1, 107)=11 - KSPARSE(2, 107)=15 -!SO2/NO3 - KSPARSE(1, 108)=12 - KSPARSE(2, 108)=5 -!SO2/DMS - KSPARSE(1, 109)=12 - KSPARSE(2, 109)=11 -!SO2/SO2 - KSPARSE(1, 110)=12 - KSPARSE(2, 110)=12 -!SO2/OH - KSPARSE(1, 111)=12 - KSPARSE(2, 111)=15 -!SULF/SO2 - KSPARSE(1, 112)=13 - KSPARSE(2, 112)=12 -!SULF/SULF - KSPARSE(1, 113)=13 - KSPARSE(2, 113)=13 -!SULF/OH - KSPARSE(1, 114)=13 - KSPARSE(2, 114)=15 -!CO/O3 - KSPARSE(1, 115)=14 - KSPARSE(2, 115)=1 -!CO/NO3 - KSPARSE(1, 116)=14 - KSPARSE(2, 116)=5 -!CO/CO - KSPARSE(1, 117)=14 - KSPARSE(2, 117)=14 -!CO/OH - KSPARSE(1, 118)=14 - KSPARSE(2, 118)=15 -!CO/ALKA - KSPARSE(1, 119)=14 - KSPARSE(2, 119)=19 -!CO/ALKE - KSPARSE(1, 120)=14 - KSPARSE(2, 120)=20 -!CO/BIO - KSPARSE(1, 121)=14 - KSPARSE(2, 121)=21 -!CO/HCHO - KSPARSE(1, 122)=14 - KSPARSE(2, 122)=23 -!CO/ALD - KSPARSE(1, 123)=14 - KSPARSE(2, 123)=24 -!CO/CARBO - KSPARSE(1, 124)=14 - KSPARSE(2, 124)=26 -!CO/PAN - KSPARSE(1, 125)=14 - KSPARSE(2, 125)=28 -!OH/O3 - KSPARSE(1, 126)=15 - KSPARSE(2, 126)=1 -!OH/H2O2 - KSPARSE(1, 127)=15 - KSPARSE(2, 127)=2 -!OH/NO - KSPARSE(1, 128)=15 - KSPARSE(2, 128)=3 -!OH/NO2 - KSPARSE(1, 129)=15 - KSPARSE(2, 129)=4 -!OH/NO3 - KSPARSE(1, 130)=15 - KSPARSE(2, 130)=5 -!OH/HONO - KSPARSE(1, 131)=15 - KSPARSE(2, 131)=7 -!OH/HNO3 - KSPARSE(1, 132)=15 - KSPARSE(2, 132)=8 -!OH/HNO4 - KSPARSE(1, 133)=15 - KSPARSE(2, 133)=9 -!OH/NH3 - KSPARSE(1, 134)=15 - KSPARSE(2, 134)=10 -!OH/DMS - KSPARSE(1, 135)=15 - KSPARSE(2, 135)=11 -!OH/SO2 - KSPARSE(1, 136)=15 - KSPARSE(2, 136)=12 -!OH/CO - KSPARSE(1, 137)=15 - KSPARSE(2, 137)=14 -!OH/OH - KSPARSE(1, 138)=15 - KSPARSE(2, 138)=15 -!OH/HO2 - KSPARSE(1, 139)=15 - KSPARSE(2, 139)=16 -!OH/CH4 - KSPARSE(1, 140)=15 - KSPARSE(2, 140)=17 -!OH/ETH - KSPARSE(1, 141)=15 - KSPARSE(2, 141)=18 -!OH/ALKA - KSPARSE(1, 142)=15 - KSPARSE(2, 142)=19 -!OH/ALKE - KSPARSE(1, 143)=15 - KSPARSE(2, 143)=20 -!OH/BIO - KSPARSE(1, 144)=15 - KSPARSE(2, 144)=21 -!OH/ARO - KSPARSE(1, 145)=15 - KSPARSE(2, 145)=22 -!OH/HCHO - KSPARSE(1, 146)=15 - KSPARSE(2, 146)=23 -!OH/ALD - KSPARSE(1, 147)=15 - KSPARSE(2, 147)=24 -!OH/KET - KSPARSE(1, 148)=15 - KSPARSE(2, 148)=25 -!OH/CARBO - KSPARSE(1, 149)=15 - KSPARSE(2, 149)=26 -!OH/ONIT - KSPARSE(1, 150)=15 - KSPARSE(2, 150)=27 -!OH/PAN - KSPARSE(1, 151)=15 - KSPARSE(2, 151)=28 -!OH/OP1 - KSPARSE(1, 152)=15 - KSPARSE(2, 152)=29 -!OH/OP2 - KSPARSE(1, 153)=15 - KSPARSE(2, 153)=30 -!OH/ORA1 - KSPARSE(1, 154)=15 - KSPARSE(2, 154)=31 -!OH/ORA2 - KSPARSE(1, 155)=15 - KSPARSE(2, 155)=32 -!OH/ADD - KSPARSE(1, 156)=15 - KSPARSE(2, 156)=38 -!HO2/O3 - KSPARSE(1, 157)=16 - KSPARSE(2, 157)=1 -!HO2/H2O2 - KSPARSE(1, 158)=16 - KSPARSE(2, 158)=2 -!HO2/NO - KSPARSE(1, 159)=16 - KSPARSE(2, 159)=3 -!HO2/NO2 - KSPARSE(1, 160)=16 - KSPARSE(2, 160)=4 -!HO2/NO3 - KSPARSE(1, 161)=16 - KSPARSE(2, 161)=5 -!HO2/HNO4 - KSPARSE(1, 162)=16 - KSPARSE(2, 162)=9 -!HO2/SO2 - KSPARSE(1, 163)=16 - KSPARSE(2, 163)=12 -!HO2/CO - KSPARSE(1, 164)=16 - KSPARSE(2, 164)=14 -!HO2/OH - KSPARSE(1, 165)=16 - KSPARSE(2, 165)=15 -!HO2/HO2 - KSPARSE(1, 166)=16 - KSPARSE(2, 166)=16 -!HO2/ALKA - KSPARSE(1, 167)=16 - KSPARSE(2, 167)=19 -!HO2/ALKE - KSPARSE(1, 168)=16 - KSPARSE(2, 168)=20 -!HO2/BIO - KSPARSE(1, 169)=16 - KSPARSE(2, 169)=21 -!HO2/ARO - KSPARSE(1, 170)=16 - KSPARSE(2, 170)=22 -!HO2/HCHO - KSPARSE(1, 171)=16 - KSPARSE(2, 171)=23 -!HO2/ALD - KSPARSE(1, 172)=16 - KSPARSE(2, 172)=24 -!HO2/CARBO - KSPARSE(1, 173)=16 - KSPARSE(2, 173)=26 -!HO2/ONIT - KSPARSE(1, 174)=16 - KSPARSE(2, 174)=27 -!HO2/PAN - KSPARSE(1, 175)=16 - KSPARSE(2, 175)=28 -!HO2/OP1 - KSPARSE(1, 176)=16 - KSPARSE(2, 176)=29 -!HO2/OP2 - KSPARSE(1, 177)=16 - KSPARSE(2, 177)=30 -!HO2/ORA1 - KSPARSE(1, 178)=16 - KSPARSE(2, 178)=31 -!HO2/MO2 - KSPARSE(1, 179)=16 - KSPARSE(2, 179)=33 -!HO2/ALKAP - KSPARSE(1, 180)=16 - KSPARSE(2, 180)=34 -!HO2/ALKEP - KSPARSE(1, 181)=16 - KSPARSE(2, 181)=35 -!HO2/BIOP - KSPARSE(1, 182)=16 - KSPARSE(2, 182)=36 -!HO2/PHO - KSPARSE(1, 183)=16 - KSPARSE(2, 183)=37 -!HO2/ADD - KSPARSE(1, 184)=16 - KSPARSE(2, 184)=38 -!HO2/AROP - KSPARSE(1, 185)=16 - KSPARSE(2, 185)=39 -!HO2/CARBOP - KSPARSE(1, 186)=16 - KSPARSE(2, 186)=40 -!HO2/OLN - KSPARSE(1, 187)=16 - KSPARSE(2, 187)=41 -!HO2/XO2 - KSPARSE(1, 188)=16 - KSPARSE(2, 188)=42 -!CH4/O3 - KSPARSE(1, 189)=17 - KSPARSE(2, 189)=1 -!CH4/OH - KSPARSE(1, 190)=17 - KSPARSE(2, 190)=15 -!CH4/CH4 - KSPARSE(1, 191)=17 - KSPARSE(2, 191)=17 -!CH4/ALKE - KSPARSE(1, 192)=17 - KSPARSE(2, 192)=20 -!ETH/O3 - KSPARSE(1, 193)=18 - KSPARSE(2, 193)=1 -!ETH/OH - KSPARSE(1, 194)=18 - KSPARSE(2, 194)=15 -!ETH/ETH - KSPARSE(1, 195)=18 - KSPARSE(2, 195)=18 -!ETH/ALKE - KSPARSE(1, 196)=18 - KSPARSE(2, 196)=20 -!ALKA/OH - KSPARSE(1, 197)=19 - KSPARSE(2, 197)=15 -!ALKA/ALKA - KSPARSE(1, 198)=19 - KSPARSE(2, 198)=19 -!ALKE/O3 - KSPARSE(1, 199)=20 - KSPARSE(2, 199)=1 -!ALKE/NO - KSPARSE(1, 200)=20 - KSPARSE(2, 200)=3 -!ALKE/NO3 - KSPARSE(1, 201)=20 - KSPARSE(2, 201)=5 -!ALKE/OH - KSPARSE(1, 202)=20 - KSPARSE(2, 202)=15 -!ALKE/ALKE - KSPARSE(1, 203)=20 - KSPARSE(2, 203)=20 -!ALKE/BIO - KSPARSE(1, 204)=20 - KSPARSE(2, 204)=21 -!ALKE/MO2 - KSPARSE(1, 205)=20 - KSPARSE(2, 205)=33 -!ALKE/BIOP - KSPARSE(1, 206)=20 - KSPARSE(2, 206)=36 -!ALKE/CARBOP - KSPARSE(1, 207)=20 - KSPARSE(2, 207)=40 -!BIO/O3 - KSPARSE(1, 208)=21 - KSPARSE(2, 208)=1 -!BIO/NO3 - KSPARSE(1, 209)=21 - KSPARSE(2, 209)=5 -!BIO/OH - KSPARSE(1, 210)=21 - KSPARSE(2, 210)=15 -!BIO/BIO - KSPARSE(1, 211)=21 - KSPARSE(2, 211)=21 -!ARO/O3 - KSPARSE(1, 212)=22 - KSPARSE(2, 212)=1 -!ARO/NO2 - KSPARSE(1, 213)=22 - KSPARSE(2, 213)=4 -!ARO/NO3 - KSPARSE(1, 214)=22 - KSPARSE(2, 214)=5 -!ARO/OH - KSPARSE(1, 215)=22 - KSPARSE(2, 215)=15 -!ARO/HO2 - KSPARSE(1, 216)=22 - KSPARSE(2, 216)=16 -!ARO/ARO - KSPARSE(1, 217)=22 - KSPARSE(2, 217)=22 -!ARO/PHO - KSPARSE(1, 218)=22 - KSPARSE(2, 218)=37 -!ARO/ADD - KSPARSE(1, 219)=22 - KSPARSE(2, 219)=38 -!HCHO/O3 - KSPARSE(1, 220)=23 - KSPARSE(2, 220)=1 -!HCHO/NO - KSPARSE(1, 221)=23 - KSPARSE(2, 221)=3 -!HCHO/NO3 - KSPARSE(1, 222)=23 - KSPARSE(2, 222)=5 -!HCHO/OH - KSPARSE(1, 223)=23 - KSPARSE(2, 223)=15 -!HCHO/ALKA - KSPARSE(1, 224)=23 - KSPARSE(2, 224)=19 -!HCHO/ALKE - KSPARSE(1, 225)=23 - KSPARSE(2, 225)=20 -!HCHO/BIO - KSPARSE(1, 226)=23 - KSPARSE(2, 226)=21 -!HCHO/HCHO - KSPARSE(1, 227)=23 - KSPARSE(2, 227)=23 -!HCHO/CARBO - KSPARSE(1, 228)=23 - KSPARSE(2, 228)=26 -!HCHO/PAN - KSPARSE(1, 229)=23 - KSPARSE(2, 229)=28 -!HCHO/OP1 - KSPARSE(1, 230)=23 - KSPARSE(2, 230)=29 -!HCHO/OP2 - KSPARSE(1, 231)=23 - KSPARSE(2, 231)=30 -!HCHO/MO2 - KSPARSE(1, 232)=23 - KSPARSE(2, 232)=33 -!HCHO/ALKAP - KSPARSE(1, 233)=23 - KSPARSE(2, 233)=34 -!HCHO/ALKEP - KSPARSE(1, 234)=23 - KSPARSE(2, 234)=35 -!HCHO/BIOP - KSPARSE(1, 235)=23 - KSPARSE(2, 235)=36 -!HCHO/AROP - KSPARSE(1, 236)=23 - KSPARSE(2, 236)=39 -!HCHO/CARBOP - KSPARSE(1, 237)=23 - KSPARSE(2, 237)=40 -!HCHO/OLN - KSPARSE(1, 238)=23 - KSPARSE(2, 238)=41 -!HCHO/XO2 - KSPARSE(1, 239)=23 - KSPARSE(2, 239)=42 -!ALD/O3 - KSPARSE(1, 240)=24 - KSPARSE(2, 240)=1 -!ALD/NO - KSPARSE(1, 241)=24 - KSPARSE(2, 241)=3 -!ALD/NO3 - KSPARSE(1, 242)=24 - KSPARSE(2, 242)=5 -!ALD/OH - KSPARSE(1, 243)=24 - KSPARSE(2, 243)=15 -!ALD/ALKA - KSPARSE(1, 244)=24 - KSPARSE(2, 244)=19 -!ALD/ALKE - KSPARSE(1, 245)=24 - KSPARSE(2, 245)=20 -!ALD/BIO - KSPARSE(1, 246)=24 - KSPARSE(2, 246)=21 -!ALD/ALD - KSPARSE(1, 247)=24 - KSPARSE(2, 247)=24 -!ALD/CARBO - KSPARSE(1, 248)=24 - KSPARSE(2, 248)=26 -!ALD/ONIT - KSPARSE(1, 249)=24 - KSPARSE(2, 249)=27 -!ALD/OP2 - KSPARSE(1, 250)=24 - KSPARSE(2, 250)=30 -!ALD/MO2 - KSPARSE(1, 251)=24 - KSPARSE(2, 251)=33 -!ALD/ALKAP - KSPARSE(1, 252)=24 - KSPARSE(2, 252)=34 -!ALD/ALKEP - KSPARSE(1, 253)=24 - KSPARSE(2, 253)=35 -!ALD/BIOP - KSPARSE(1, 254)=24 - KSPARSE(2, 254)=36 -!ALD/CARBOP - KSPARSE(1, 255)=24 - KSPARSE(2, 255)=40 -!ALD/OLN - KSPARSE(1, 256)=24 - KSPARSE(2, 256)=41 -!KET/O3 - KSPARSE(1, 257)=25 - KSPARSE(2, 257)=1 -!KET/NO - KSPARSE(1, 258)=25 - KSPARSE(2, 258)=3 -!KET/NO3 - KSPARSE(1, 259)=25 - KSPARSE(2, 259)=5 -!KET/OH - KSPARSE(1, 260)=25 - KSPARSE(2, 260)=15 -!KET/ALKA - KSPARSE(1, 261)=25 - KSPARSE(2, 261)=19 -!KET/ALKE - KSPARSE(1, 262)=25 - KSPARSE(2, 262)=20 -!KET/BIO - KSPARSE(1, 263)=25 - KSPARSE(2, 263)=21 -!KET/KET - KSPARSE(1, 264)=25 - KSPARSE(2, 264)=25 -!KET/CARBO - KSPARSE(1, 265)=25 - KSPARSE(2, 265)=26 -!KET/ONIT - KSPARSE(1, 266)=25 - KSPARSE(2, 266)=27 -!KET/OP2 - KSPARSE(1, 267)=25 - KSPARSE(2, 267)=30 -!KET/MO2 - KSPARSE(1, 268)=25 - KSPARSE(2, 268)=33 -!KET/ALKAP - KSPARSE(1, 269)=25 - KSPARSE(2, 269)=34 -!KET/ALKEP - KSPARSE(1, 270)=25 - KSPARSE(2, 270)=35 -!KET/BIOP - KSPARSE(1, 271)=25 - KSPARSE(2, 271)=36 -!KET/CARBOP - KSPARSE(1, 272)=25 - KSPARSE(2, 272)=40 -!KET/OLN - KSPARSE(1, 273)=25 - KSPARSE(2, 273)=41 -!CARBO/O3 - KSPARSE(1, 274)=26 - KSPARSE(2, 274)=1 -!CARBO/NO - KSPARSE(1, 275)=26 - KSPARSE(2, 275)=3 -!CARBO/NO3 - KSPARSE(1, 276)=26 - KSPARSE(2, 276)=5 -!CARBO/OH - KSPARSE(1, 277)=26 - KSPARSE(2, 277)=15 -!CARBO/ALKA - KSPARSE(1, 278)=26 - KSPARSE(2, 278)=19 -!CARBO/ALKE - KSPARSE(1, 279)=26 - KSPARSE(2, 279)=20 -!CARBO/BIO - KSPARSE(1, 280)=26 - KSPARSE(2, 280)=21 -!CARBO/CARBO - KSPARSE(1, 281)=26 - KSPARSE(2, 281)=26 -!CARBO/PAN - KSPARSE(1, 282)=26 - KSPARSE(2, 282)=28 -!CARBO/MO2 - KSPARSE(1, 283)=26 - KSPARSE(2, 283)=33 -!CARBO/ALKAP - KSPARSE(1, 284)=26 - KSPARSE(2, 284)=34 -!CARBO/BIOP - KSPARSE(1, 285)=26 - KSPARSE(2, 285)=36 -!CARBO/AROP - KSPARSE(1, 286)=26 - KSPARSE(2, 286)=39 -!CARBO/CARBOP - KSPARSE(1, 287)=26 - KSPARSE(2, 287)=40 -!ONIT/NO - KSPARSE(1, 288)=27 - KSPARSE(2, 288)=3 -!ONIT/NO2 - KSPARSE(1, 289)=27 - KSPARSE(2, 289)=4 -!ONIT/NO3 - KSPARSE(1, 290)=27 - KSPARSE(2, 290)=5 -!ONIT/OH - KSPARSE(1, 291)=27 - KSPARSE(2, 291)=15 -!ONIT/HO2 - KSPARSE(1, 292)=27 - KSPARSE(2, 292)=16 -!ONIT/ONIT - KSPARSE(1, 293)=27 - KSPARSE(2, 293)=27 -!ONIT/PAN - KSPARSE(1, 294)=27 - KSPARSE(2, 294)=28 -!ONIT/MO2 - KSPARSE(1, 295)=27 - KSPARSE(2, 295)=33 -!ONIT/ALKAP - KSPARSE(1, 296)=27 - KSPARSE(2, 296)=34 -!ONIT/BIOP - KSPARSE(1, 297)=27 - KSPARSE(2, 297)=36 -!ONIT/PHO - KSPARSE(1, 298)=27 - KSPARSE(2, 298)=37 -!ONIT/AROP - KSPARSE(1, 299)=27 - KSPARSE(2, 299)=39 -!ONIT/CARBOP - KSPARSE(1, 300)=27 - KSPARSE(2, 300)=40 -!ONIT/OLN - KSPARSE(1, 301)=27 - KSPARSE(2, 301)=41 -!PAN/O3 - KSPARSE(1, 302)=28 - KSPARSE(2, 302)=1 -!PAN/NO2 - KSPARSE(1, 303)=28 - KSPARSE(2, 303)=4 -!PAN/NO3 - KSPARSE(1, 304)=28 - KSPARSE(2, 304)=5 -!PAN/OH - KSPARSE(1, 305)=28 - KSPARSE(2, 305)=15 -!PAN/PAN - KSPARSE(1, 306)=28 - KSPARSE(2, 306)=28 -!PAN/CARBOP - KSPARSE(1, 307)=28 - KSPARSE(2, 307)=40 -!OP1/OH - KSPARSE(1, 308)=29 - KSPARSE(2, 308)=15 -!OP1/HO2 - KSPARSE(1, 309)=29 - KSPARSE(2, 309)=16 -!OP1/OP1 - KSPARSE(1, 310)=29 - KSPARSE(2, 310)=29 -!OP1/MO2 - KSPARSE(1, 311)=29 - KSPARSE(2, 311)=33 -!OP2/O3 - KSPARSE(1, 312)=30 - KSPARSE(2, 312)=1 -!OP2/OH - KSPARSE(1, 313)=30 - KSPARSE(2, 313)=15 -!OP2/HO2 - KSPARSE(1, 314)=30 - KSPARSE(2, 314)=16 -!OP2/CARBO - KSPARSE(1, 315)=30 - KSPARSE(2, 315)=26 -!OP2/OP2 - KSPARSE(1, 316)=30 - KSPARSE(2, 316)=30 -!OP2/ALKAP - KSPARSE(1, 317)=30 - KSPARSE(2, 317)=34 -!OP2/ALKEP - KSPARSE(1, 318)=30 - KSPARSE(2, 318)=35 -!OP2/BIOP - KSPARSE(1, 319)=30 - KSPARSE(2, 319)=36 -!OP2/AROP - KSPARSE(1, 320)=30 - KSPARSE(2, 320)=39 -!OP2/CARBOP - KSPARSE(1, 321)=30 - KSPARSE(2, 321)=40 -!OP2/XO2 - KSPARSE(1, 322)=30 - KSPARSE(2, 322)=42 -!ORA1/O3 - KSPARSE(1, 323)=31 - KSPARSE(2, 323)=1 -!ORA1/OH - KSPARSE(1, 324)=31 - KSPARSE(2, 324)=15 -!ORA1/ALKA - KSPARSE(1, 325)=31 - KSPARSE(2, 325)=19 -!ORA1/ALKE - KSPARSE(1, 326)=31 - KSPARSE(2, 326)=20 -!ORA1/BIO - KSPARSE(1, 327)=31 - KSPARSE(2, 327)=21 -!ORA1/CARBO - KSPARSE(1, 328)=31 - KSPARSE(2, 328)=26 -!ORA1/PAN - KSPARSE(1, 329)=31 - KSPARSE(2, 329)=28 -!ORA1/ORA1 - KSPARSE(1, 330)=31 - KSPARSE(2, 330)=31 -!ORA2/O3 - KSPARSE(1, 331)=32 - KSPARSE(2, 331)=1 -!ORA2/OH - KSPARSE(1, 332)=32 - KSPARSE(2, 332)=15 -!ORA2/HO2 - KSPARSE(1, 333)=32 - KSPARSE(2, 333)=16 -!ORA2/ALKE - KSPARSE(1, 334)=32 - KSPARSE(2, 334)=20 -!ORA2/BIO - KSPARSE(1, 335)=32 - KSPARSE(2, 335)=21 -!ORA2/CARBO - KSPARSE(1, 336)=32 - KSPARSE(2, 336)=26 -!ORA2/ORA2 - KSPARSE(1, 337)=32 - KSPARSE(2, 337)=32 -!ORA2/MO2 - KSPARSE(1, 338)=32 - KSPARSE(2, 338)=33 -!ORA2/ALKAP - KSPARSE(1, 339)=32 - KSPARSE(2, 339)=34 -!ORA2/ALKEP - KSPARSE(1, 340)=32 - KSPARSE(2, 340)=35 -!ORA2/BIOP - KSPARSE(1, 341)=32 - KSPARSE(2, 341)=36 -!ORA2/CARBOP - KSPARSE(1, 342)=32 - KSPARSE(2, 342)=40 -!ORA2/OLN - KSPARSE(1, 343)=32 - KSPARSE(2, 343)=41 -!MO2/O3 - KSPARSE(1, 344)=33 - KSPARSE(2, 344)=1 -!MO2/NO - KSPARSE(1, 345)=33 - KSPARSE(2, 345)=3 -!MO2/NO3 - KSPARSE(1, 346)=33 - KSPARSE(2, 346)=5 -!MO2/OH - KSPARSE(1, 347)=33 - KSPARSE(2, 347)=15 -!MO2/HO2 - KSPARSE(1, 348)=33 - KSPARSE(2, 348)=16 -!MO2/CH4 - KSPARSE(1, 349)=33 - KSPARSE(2, 349)=17 -!MO2/ALKE - KSPARSE(1, 350)=33 - KSPARSE(2, 350)=20 -!MO2/BIO - KSPARSE(1, 351)=33 - KSPARSE(2, 351)=21 -!MO2/ALD - KSPARSE(1, 352)=33 - KSPARSE(2, 352)=24 -!MO2/OP1 - KSPARSE(1, 353)=33 - KSPARSE(2, 353)=29 -!MO2/OP2 - KSPARSE(1, 354)=33 - KSPARSE(2, 354)=30 -!MO2/MO2 - KSPARSE(1, 355)=33 - KSPARSE(2, 355)=33 -!MO2/ALKAP - KSPARSE(1, 356)=33 - KSPARSE(2, 356)=34 -!MO2/ALKEP - KSPARSE(1, 357)=33 - KSPARSE(2, 357)=35 -!MO2/BIOP - KSPARSE(1, 358)=33 - KSPARSE(2, 358)=36 -!MO2/AROP - KSPARSE(1, 359)=33 - KSPARSE(2, 359)=39 -!MO2/CARBOP - KSPARSE(1, 360)=33 - KSPARSE(2, 360)=40 -!MO2/OLN - KSPARSE(1, 361)=33 - KSPARSE(2, 361)=41 -!MO2/XO2 - KSPARSE(1, 362)=33 - KSPARSE(2, 362)=42 -!ALKAP/O3 - KSPARSE(1, 363)=34 - KSPARSE(2, 363)=1 -!ALKAP/NO - KSPARSE(1, 364)=34 - KSPARSE(2, 364)=3 -!ALKAP/NO3 - KSPARSE(1, 365)=34 - KSPARSE(2, 365)=5 -!ALKAP/OH - KSPARSE(1, 366)=34 - KSPARSE(2, 366)=15 -!ALKAP/HO2 - KSPARSE(1, 367)=34 - KSPARSE(2, 367)=16 -!ALKAP/ETH - KSPARSE(1, 368)=34 - KSPARSE(2, 368)=18 -!ALKAP/ALKA - KSPARSE(1, 369)=34 - KSPARSE(2, 369)=19 -!ALKAP/ALKE - KSPARSE(1, 370)=34 - KSPARSE(2, 370)=20 -!ALKAP/BIO - KSPARSE(1, 371)=34 - KSPARSE(2, 371)=21 -!ALKAP/KET - KSPARSE(1, 372)=34 - KSPARSE(2, 372)=25 -!ALKAP/ONIT - KSPARSE(1, 373)=34 - KSPARSE(2, 373)=27 -!ALKAP/OP2 - KSPARSE(1, 374)=34 - KSPARSE(2, 374)=30 -!ALKAP/MO2 - KSPARSE(1, 375)=34 - KSPARSE(2, 375)=33 -!ALKAP/ALKAP - KSPARSE(1, 376)=34 - KSPARSE(2, 376)=34 -!ALKAP/CARBOP - KSPARSE(1, 377)=34 - KSPARSE(2, 377)=40 -!ALKEP/NO - KSPARSE(1, 378)=35 - KSPARSE(2, 378)=3 -!ALKEP/NO3 - KSPARSE(1, 379)=35 - KSPARSE(2, 379)=5 -!ALKEP/OH - KSPARSE(1, 380)=35 - KSPARSE(2, 380)=15 -!ALKEP/HO2 - KSPARSE(1, 381)=35 - KSPARSE(2, 381)=16 -!ALKEP/ALKE - KSPARSE(1, 382)=35 - KSPARSE(2, 382)=20 -!ALKEP/MO2 - KSPARSE(1, 383)=35 - KSPARSE(2, 383)=33 -!ALKEP/ALKEP - KSPARSE(1, 384)=35 - KSPARSE(2, 384)=35 -!ALKEP/CARBOP - KSPARSE(1, 385)=35 - KSPARSE(2, 385)=40 -!BIOP/NO - KSPARSE(1, 386)=36 - KSPARSE(2, 386)=3 -!BIOP/NO3 - KSPARSE(1, 387)=36 - KSPARSE(2, 387)=5 -!BIOP/OH - KSPARSE(1, 388)=36 - KSPARSE(2, 388)=15 -!BIOP/HO2 - KSPARSE(1, 389)=36 - KSPARSE(2, 389)=16 -!BIOP/ALKE - KSPARSE(1, 390)=36 - KSPARSE(2, 390)=20 -!BIOP/BIO - KSPARSE(1, 391)=36 - KSPARSE(2, 391)=21 -!BIOP/MO2 - KSPARSE(1, 392)=36 - KSPARSE(2, 392)=33 -!BIOP/BIOP - KSPARSE(1, 393)=36 - KSPARSE(2, 393)=36 -!BIOP/CARBOP - KSPARSE(1, 394)=36 - KSPARSE(2, 394)=40 -!PHO/NO2 - KSPARSE(1, 395)=37 - KSPARSE(2, 395)=4 -!PHO/NO3 - KSPARSE(1, 396)=37 - KSPARSE(2, 396)=5 -!PHO/OH - KSPARSE(1, 397)=37 - KSPARSE(2, 397)=15 -!PHO/HO2 - KSPARSE(1, 398)=37 - KSPARSE(2, 398)=16 -!PHO/ARO - KSPARSE(1, 399)=37 - KSPARSE(2, 399)=22 -!PHO/PHO - KSPARSE(1, 400)=37 - KSPARSE(2, 400)=37 -!ADD/O3 - KSPARSE(1, 401)=38 - KSPARSE(2, 401)=1 -!ADD/NO2 - KSPARSE(1, 402)=38 - KSPARSE(2, 402)=4 -!ADD/OH - KSPARSE(1, 403)=38 - KSPARSE(2, 403)=15 -!ADD/ARO - KSPARSE(1, 404)=38 - KSPARSE(2, 404)=22 -!ADD/ADD - KSPARSE(1, 405)=38 - KSPARSE(2, 405)=38 -!AROP/NO - KSPARSE(1, 406)=39 - KSPARSE(2, 406)=3 -!AROP/NO3 - KSPARSE(1, 407)=39 - KSPARSE(2, 407)=5 -!AROP/HO2 - KSPARSE(1, 408)=39 - KSPARSE(2, 408)=16 -!AROP/MO2 - KSPARSE(1, 409)=39 - KSPARSE(2, 409)=33 -!AROP/ADD - KSPARSE(1, 410)=39 - KSPARSE(2, 410)=38 -!AROP/AROP - KSPARSE(1, 411)=39 - KSPARSE(2, 411)=39 -!AROP/CARBOP - KSPARSE(1, 412)=39 - KSPARSE(2, 412)=40 -!CARBOP/O3 - KSPARSE(1, 413)=40 - KSPARSE(2, 413)=1 -!CARBOP/NO - KSPARSE(1, 414)=40 - KSPARSE(2, 414)=3 -!CARBOP/NO2 - KSPARSE(1, 415)=40 - KSPARSE(2, 415)=4 -!CARBOP/NO3 - KSPARSE(1, 416)=40 - KSPARSE(2, 416)=5 -!CARBOP/OH - KSPARSE(1, 417)=40 - KSPARSE(2, 417)=15 -!CARBOP/HO2 - KSPARSE(1, 418)=40 - KSPARSE(2, 418)=16 -!CARBOP/ALKE - KSPARSE(1, 419)=40 - KSPARSE(2, 419)=20 -!CARBOP/BIO - KSPARSE(1, 420)=40 - KSPARSE(2, 420)=21 -!CARBOP/ALD - KSPARSE(1, 421)=40 - KSPARSE(2, 421)=24 -!CARBOP/KET - KSPARSE(1, 422)=40 - KSPARSE(2, 422)=25 -!CARBOP/CARBO - KSPARSE(1, 423)=40 - KSPARSE(2, 423)=26 -!CARBOP/PAN - KSPARSE(1, 424)=40 - KSPARSE(2, 424)=28 -!CARBOP/OP2 - KSPARSE(1, 425)=40 - KSPARSE(2, 425)=30 -!CARBOP/MO2 - KSPARSE(1, 426)=40 - KSPARSE(2, 426)=33 -!CARBOP/ALKAP - KSPARSE(1, 427)=40 - KSPARSE(2, 427)=34 -!CARBOP/ALKEP - KSPARSE(1, 428)=40 - KSPARSE(2, 428)=35 -!CARBOP/BIOP - KSPARSE(1, 429)=40 - KSPARSE(2, 429)=36 -!CARBOP/AROP - KSPARSE(1, 430)=40 - KSPARSE(2, 430)=39 -!CARBOP/CARBOP - KSPARSE(1, 431)=40 - KSPARSE(2, 431)=40 -!CARBOP/OLN - KSPARSE(1, 432)=40 - KSPARSE(2, 432)=41 -!CARBOP/XO2 - KSPARSE(1, 433)=40 - KSPARSE(2, 433)=42 -!OLN/NO - KSPARSE(1, 434)=41 - KSPARSE(2, 434)=3 -!OLN/NO3 - KSPARSE(1, 435)=41 - KSPARSE(2, 435)=5 -!OLN/HO2 - KSPARSE(1, 436)=41 - KSPARSE(2, 436)=16 -!OLN/ALKE - KSPARSE(1, 437)=41 - KSPARSE(2, 437)=20 -!OLN/BIO - KSPARSE(1, 438)=41 - KSPARSE(2, 438)=21 -!OLN/CARBO - KSPARSE(1, 439)=41 - KSPARSE(2, 439)=26 -!OLN/MO2 - KSPARSE(1, 440)=41 - KSPARSE(2, 440)=33 -!OLN/CARBOP - KSPARSE(1, 441)=41 - KSPARSE(2, 441)=40 -!OLN/OLN - KSPARSE(1, 442)=41 - KSPARSE(2, 442)=41 -!XO2/O3 - KSPARSE(1, 443)=42 - KSPARSE(2, 443)=1 -!XO2/NO - KSPARSE(1, 444)=42 - KSPARSE(2, 444)=3 -!XO2/NO3 - KSPARSE(1, 445)=42 - KSPARSE(2, 445)=5 -!XO2/OH - KSPARSE(1, 446)=42 - KSPARSE(2, 446)=15 -!XO2/HO2 - KSPARSE(1, 447)=42 - KSPARSE(2, 447)=16 -!XO2/ALKE - KSPARSE(1, 448)=42 - KSPARSE(2, 448)=20 -!XO2/BIO - KSPARSE(1, 449)=42 - KSPARSE(2, 449)=21 -!XO2/ARO - KSPARSE(1, 450)=42 - KSPARSE(2, 450)=22 -!XO2/CARBO - KSPARSE(1, 451)=42 - KSPARSE(2, 451)=26 -!XO2/PAN - KSPARSE(1, 452)=42 - KSPARSE(2, 452)=28 -!XO2/OP2 - KSPARSE(1, 453)=42 - KSPARSE(2, 453)=30 -!XO2/MO2 - KSPARSE(1, 454)=42 - KSPARSE(2, 454)=33 -!XO2/ALKAP - KSPARSE(1, 455)=42 - KSPARSE(2, 455)=34 -!XO2/CARBOP - KSPARSE(1, 456)=42 - KSPARSE(2, 456)=40 -!XO2/XO2 - KSPARSE(1, 457)=42 - KSPARSE(2, 457)=42 -KSPARSEDIM = 457 -RETURN -END SUBROUTINE CH_SPARSE_GAZ -! -END SUBROUTINE CH_SPARSE -! diff --git a/src/ICCARE_BASE/aer2lima.f90 b/src/ICCARE_BASE/aer2lima.f90 deleted file mode 100644 index 885dc0dc0..000000000 --- a/src/ICCARE_BASE/aer2lima.f90 +++ /dev/null @@ -1,375 +0,0 @@ -!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!----------------------------------------------------------------- -! ######################## - MODULE MODI_AER2LIMA -! ######################## -! -INTERFACE - SUBROUTINE AER2LIMA(PSVT, PRHODREF,PRV, PPABST, PTHT, PZZ) -! -USE MODD_CH_AEROSOL -USE MODD_DUST -USE MODD_SALT -USE MODD_NSV -USE MODD_CST -USE MODD_CONF, ONLY : CPROGRAM -USE MODD_PARAM_n, ONLY : CACTCCN -USE MODD_PARAM_LIMA -USE MODE_AERO_PSD -USE MODE_SALT_PSD -USE MODE_DUST_PSD -USE MODI_CH_AER_EQSAM -USE MODI_DUSTLFI_n -USE MODI_SALTLFI_n -! -REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF, PRV, PPABST, PTHT, PZZ -! -END SUBROUTINE AER2LIMA -! -END INTERFACE -! -END MODULE MODI_AER2LIMA - -! ############################################ - SUBROUTINE AER2LIMA(PSVT, PRHODREF, PRV, PPABST, PTHT, PZZ) -! ############################################ -! -! -!!**** *AER2LIMA* lima CCN and IFN fields in case of orilam aerosols -!! -!! PURPOSE -!! ------- -!! -!! EXTERNAL -!! -------- -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! REFERENCE -!! --------- -!! -!! AUTHOR -!! ------ -!! P. Tulet -!! -!! MODIFICATIONS -!! ------------- -!! Original 20/01/22 -!! -------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_CH_AEROSOL -USE MODD_DUST -USE MODD_SALT -USE MODD_NSV -USE MODD_CST -USE MODD_CONF, ONLY : CPROGRAM -USE MODD_PARAM_n, ONLY : CACTCCN -USE MODD_PARAM_LIMA -USE MODD_CH_M9_n, ONLY : CNAMES -USE MODE_AERO_PSD -USE MODE_SALT_PSD -USE MODE_DUST_PSD -USE MODI_CH_AER_EQSAM -USE MODI_DUSTLFI_n -USE MODI_SALTLFI_n -! -! -IMPLICIT NONE -! -!* 0.1 Declarations of dummy arguments : - -REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF, PRV, PPABST, PTHT, PZZ - -! 0.2 declaration of local variables - -REAL, DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3), NSP+NCARB+NSOA,JPMODE) :: ZCTOTA -REAL, DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3)) :: ZSUM, ZSUM2, ZRATH2O, ZRATSO4, ZRATDST -REAL, DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3),JPMODE) :: ZSIG_AER, ZRG_AER, ZN0_AER -REAL, DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3),NMODE_SLT) :: ZSIG_SLT, ZRG_SLT, ZN0_SLT -REAL, DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3),NMODE_DST) :: ZSIG_DST, ZRG_DST, ZN0_DST -REAL, DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3),NMOD_CCN) :: ZCCN_SUM -REAL, DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3),NMOD_IFN) :: ZIFN_SUM -REAL, DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3)) :: ZPKM, ZPKH2O, ZTEMP, ZSAT, ZRH -REAL, DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3),6) :: ZAER -REAL, DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3),NSV) :: ZTOT -REAL, DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3),JPMODE) :: ZOM -REAL, DIMENSION(NSV) :: ZMI -INTEGER :: JSV, JJ, JI, II, IJ, IK, JK -REAL :: ZCCNRADIUS, ZRATMASSH2O - -ZCCNRADIUS = 0.04 ! to suppress the aitken mode (µm) - -IF ((CPROGRAM=="REAL ").OR.(CPROGRAM=="IDEAL ")) CMINERAL = "EQSAM" -IF (CMINERAL /= 'NONE') THEN - ZRATMASSH2O = 0.05 -ELSE - ZRATMASSH2O = 0. -END IF -ZMI(:) = 250. -ZMI(JP_AER_SO4) = 98. -ZMI(JP_AER_NO3) = 63. -ZMI(JP_AER_NH3) = 17. -ZMI(JP_AER_H2O) = 18. -ZCCN_SUM(:,:,:,:) = 0. -ZIFN_SUM(:,:,:,:) = 0. - -! Anthopogenic part (orilam scheme) -! -IF (LORILAM) THEN - -! moments (PSVT;ppp) --> concentration (PN3D;#/m3) -CALL PPP2AERO(PSVT(:,:,:,NSV_AERBEG:NSV_AEREND),PRHODREF,& - PSIG3D=ZSIG_AER,PRG3D=ZRG_AER,PN3D=ZN0_AER,PCTOTA=ZCTOTA) - -ZCTOTA=MAX(ZCTOTA,XMNH_TINY) - - IF ((CPROGRAM=="REAL ").OR.(CPROGRAM=="IDEAL ")) THEN - JP_CH_HNO3 = 0 - JP_CH_NH3 = 0 - DO JJ=1,SIZE(CNAMES) - IF (CNAMES(JJ) == "HNO3") JP_CH_HNO3 = JJ - IF (CNAMES(JJ) == "NH3") JP_CH_NH3 = JJ - END DO - ZPKM(:,:,:) = 1E-3*PRHODREF(:,:,:) * 6.0221367E+23 / 28.9644 - ZPKH2O(:,:,:) = ZPKM(:,:,:)*1.6077*PRV(:,:,:) -! -! compute air temperature - ZTEMP(:,:,:) = PTHT(:,:,:)*((PPABST(:,:,:)/XP00)**(XRD/XCPD)) - -! compute relative humidity - ZSAT(:,:,:)=0.611*EXP(17.2694*(ZTEMP(:,:,:)-273.16)/(ZTEMP(:,:,:)-35.86)) - ZSAT(:,:,:)=ZSAT(:,:,:)*1000. - ZRH(:,:,:)=(ZPKH2O(:,:,:)/(ZPKM(:,:,:)*1.6077))*PPABST(:,:,:)/& - &(0.622+(ZPKH2O(:,:,:)/(ZPKM(:,:,:)*1.6077)))/ZSAT(:,:,:) - ZRH(:,:,:) = MIN(0.95, MAX(ZRH(:,:,:), .01)) ! until 0.95 thermodynamic code is not valid - -! Gas-particles equilibrium => H2O, SO4 aerosol mass - DO JI=1,NSP - ZTOT(:,:,:,JI)=ZCTOTA(:,:,:,JI,1)+ZCTOTA(:,:,:,JI,2) - ZTOT(:,:,:,JI) = MAX(ZTOT(:,:,:,JI),XMNH_TINY) - ENDDO -! - ZAER(:,:,:,:) = 0. - ZAER(:,:,:,1)=ZTOT(:,:,:,JP_AER_SO4) - -! conversion ppp to µg/m3 - IF (JP_CH_NH3 .NE. 0) ZAER(:,:,:,2)=PSVT(:,:,:,NSV_CHEMBEG-1+JP_CH_NH3)*XNH3*1E-3*PRHODREF(:,:,:)/XMD -! conversion ppp to µg/m3 - IF (JP_CH_HNO3 .NE. 0) ZAER(:,:,:,3)=PSVT(:,:,:,NSV_CHEMBEG-1+JP_CH_HNO3)*XHNO3*1E-3*PRHODREF(:,:,:)/XMD - ZAER(:,:,:,4)=ZTOT(:,:,:,JP_AER_H2O) - ZAER(:,:,:,5)=ZTOT(:,:,:,JP_AER_NO3) - ZAER(:,:,:,6)=ZTOT(:,:,:,JP_AER_NH3) - ZAER(:,:,:,:)=MAX(ZAER(:,:,:,:),0.) - - DO IK=1,SIZE(PSVT,3) - DO IJ=1,SIZE(PSVT,2) - CALL CH_AER_EQSAM(ZAER(:,IJ,IK,:),ZRH(:,IJ,IK),PPABST(:,IJ,IK),ZTEMP(:,IJ,IK)) - END DO - END DO - ZTOT(:,:,:,JP_AER_SO4) = ZAER(:,:,:,1) - ZTOT(:,:,:,JP_AER_H2O) = ZAER(:,:,:,4) - ZTOT(:,:,:,JP_AER_NO3) = ZAER(:,:,:,5) - ZTOT(:,:,:,JP_AER_NH3) = ZAER(:,:,:,6) - -! Balance the mass according to size - ZSUM(:,:,:) = 0. - ZOM(:,:,:,:) = 0. - DO JSV=1,JPMODE - DO JJ=1,NSP - ZSUM(:,:,:) = ZSUM(:,:,:) + ZCTOTA(:,:,:,JJ,JSV) - ZOM(:,:,:,JSV) = ZOM(:,:,:,JSV) + ZCTOTA(:,:,:,JJ,JSV) - ENDDO - ENDDO - - DO JSV=1,JPMODE - ZOM(:,:,:,JSV) = ZOM(:,:,:,JSV) / ZSUM(:,:,:) - ENDDO - - DO JSV=1,JPMODE - DO JJ=1,NSP - ZCTOTA(:,:,:,JJ,JSV)=MAX(XMNH_TINY,ZTOT(:,:,:,JJ)*ZOM(:,:,:,JSV)) - END DO - END DO - -END IF !end part of init in case of IDEAL or REAL - -! Compute mass ratio of sulfates, water and dusts -DO JSV=1,JPMODE - ZRATH2O(:,:,:) = 0. - ZRATSO4(:,:,:) = 0. - ZRATDST(:,:,:) = 0. - ZSUM(:,:,:) = 0. - ZSUM2(:,:,:) = 0. - - DO II=1,NSP+NCARB+NSOA - ZSUM(:,:,:) = ZSUM(:,:,:) + ZCTOTA(:,:,:,II,JSV) - END DO - - ZSUM2(:,:,:) = ZSUM(:,:,:) - ZCTOTA(:,:,:,JP_AER_H2O,JSV) - - WHERE (ZSUM(:,:,:) .GT. 0.) - ZRATH2O(:,:,:) = ZCTOTA(:,:,:,JP_AER_H2O,JSV) / ZSUM(:,:,:) - END WHERE - - WHERE (ZSUM2(:,:,:) .GT. 0.) - ZRATSO4(:,:,:) = ZCTOTA(:,:,:,JP_AER_SO4,JSV) / ZSUM2(:,:,:) - END WHERE - - WHERE (ZSUM2(:,:,:) .GT. 0.) - ZRATDST(:,:,:) = ZCTOTA(:,:,:,JP_AER_DST,JSV) / ZSUM2(:,:,:) - END WHERE - -! #/m3 --> #/kg - ZN0_AER(:,:,:,JSV) = ZN0_AER(:,:,:,JSV) / PRHODREF(:,:,:) - -! CCN_FREE initialization -! aerosol radius greater than ZCCNRADIUS µm to be considers as CCN -! water mass greater than ZRATMASSH2O % - - IF (CACTCCN=="ABRK") THEN -! only one CCN_FREE mode (activation is not performed upon aerosol class but by physical paramters) -! - WHERE (ZRG_AER(:,:,:,JSV) .GT. ZCCNRADIUS) - !WHERE ((ZRG_AER(:,:,:,JSV) .GT. ZCCNRADIUS).AND.(ZRATH2O(:,:,:).GT.ZRATMASSH2O)) - ZCCN_SUM(:,:,:,1) = ZCCN_SUM(:,:,:,1) + ZN0_AER(:,:,:,JSV) - END WHERE - - ELSE - ! Sulfates - IF (NMOD_CCN .GE. 2) THEN - WHERE ((ZRG_AER(:,:,:,JSV) .GT. ZCCNRADIUS).AND.(ZRATH2O(:,:,:).GT.ZRATMASSH2O)) - ZCCN_SUM(:,:,:,2) = ZCCN_SUM(:,:,:,2) + ZN0_AER(:,:,:,JSV) * ZRATSO4(:,:,:) - END WHERE - END IF - - ! Hyrdophylic aerosols - IF (NMOD_CCN .GE. 3) THEN - WHERE ((ZRG_AER(:,:,:,JSV) .GT. ZCCNRADIUS).AND.(ZRATH2O(:,:,:).GT.ZRATMASSH2O)) - ZCCN_SUM(:,:,:,3) = ZCCN_SUM(:,:,:,3) + ZN0_AER(:,:,:,JSV) * (1.-ZRATSO4(:,:,:)) - END WHERE - END IF - -END IF - -! IFN_FREE initialization - WHERE (ZRATH2O(:,:,:) .LE. ZRATMASSH2O) ! fraction of dust if low water - ZIFN_SUM(:,:,:,1) = ZIFN_SUM(:,:,:,1) + ZN0_AER(:,:,:,JSV) * ZRATDST(:,:,:) - END WHERE - -! hydrophobic aerosols water mass less than 20% - IF (NMOD_IFN .GE. 2) THEN - WHERE (ZRATH2O(:,:,:) .LE. ZRATMASSH2O) ! hydrophobic aerosols can act as IFN - ZIFN_SUM(:,:,:,2) = ZIFN_SUM(:,:,:,2) + ZN0_AER(:,:,:,JSV) * (1.- ZRATSO4(:,:,:)) - END WHERE - END IF - -END DO - - -ELSE ! keep lima class intiatialization - IF (CACTCCN=="ABRK") THEN -! only one CCN_FREE mode (activation is not performed upon aerosol class but by physical paramters) - IF (NMOD_CCN .GE. 2) & - ZCCN_SUM(:,:,:,1) = ZCCN_SUM(:,:,:,1) + & - PSVT(:,:,:,NSV_LIMA_CCN_FREE+1) + PSVT(:,:,:,NSV_LIMA_CCN_ACTI+1) - IF (NMOD_CCN .GE. 3) & - ZCCN_SUM(:,:,:,1) = ZCCN_SUM(:,:,:,1) + & - PSVT(:,:,:,NSV_LIMA_CCN_FREE+2) + PSVT(:,:,:,NSV_LIMA_CCN_ACTI+2) - - ELSE - IF (NMOD_CCN .GE. 2) & - ZCCN_SUM(:,:,:,2) = PSVT(:,:,:,NSV_LIMA_CCN_FREE+1) + PSVT(:,:,:,NSV_LIMA_CCN_ACTI+1) - - IF (NMOD_CCN .GE. 3) & - ZCCN_SUM(:,:,:,3) = PSVT(:,:,:,NSV_LIMA_CCN_FREE+2) + PSVT(:,:,:,NSV_LIMA_CCN_ACTI+2) - END IF - - IF (.NOT.(LDUST)) & - ZIFN_SUM(:,:,:,1) = PSVT(:,:,:,NSV_LIMA_IFN_FREE) + PSVT(:,:,:,NSV_LIMA_IFN_NUCL) - - IF (NMOD_IFN .GE. 2) & - ZIFN_SUM(:,:,:,2) = PSVT(:,:,:,NSV_LIMA_IFN_FREE+1) + PSVT(:,:,:,NSV_LIMA_IFN_NUCL+1) - -END IF ! end if sur LORILAM - -! Sea Salt part -IF (LSALT) THEN -! - IF (((CPROGRAM=="REAL ").AND.(LSLTINIT).AND.(.NOT.LSLTCAMS)).OR.(CPROGRAM=="IDEAL ")) THEN - CALL SALTLFI_n(PSVT(:,:,:,NSV_SLTBEG:NSV_SLTEND), PRHODREF, PZZ) - END IF - -! moments (PSVT;ppp) --> concentration (PN3D;#/m3) - CALL PPP2SALT(PSVT(:,:,:,NSV_SLTBEG:NSV_SLTEND),PRHODREF,& - PSIG3D=ZSIG_SLT,PRG3D=ZRG_SLT,PN3D=ZN0_SLT) -! - DO JSV=1,NMODE_SLT -! #/m3 --> #/kg - ZN0_SLT(:,:,:,JSV) = ZN0_SLT(:,:,:,JSV) / PRHODREF(:,:,:) - -! CCN_FREE initialization -! - WHERE (ZRG_SLT(:,:,:,JSV) .GT. ZCCNRADIUS) - ZCCN_SUM(:,:,:,1) = ZCCN_SUM(:,:,:,1) + ZN0_SLT(:,:,:,JSV) - END WHERE - END DO - -ELSE ! keep lima class intiatialization for sea salt + ccn from orilam - - -ZCCN_SUM(:,:,:,1) = PSVT(:,:,:,NSV_LIMA_CCN_FREE) + PSVT(:,:,:,NSV_LIMA_CCN_ACTI) - -END IF ! end if sur LSALT - -! Dust part -IF (LDUST) THEN - ! initatialization of dust if not macc - IF (((CPROGRAM=="REAL ").AND.(LDSTINIT).AND.(.NOT.LDSTCAMS)).OR.(CPROGRAM=="IDEAL ")) THEN - CALL DUSTLFI_n(PSVT(:,:,:,NSV_DSTBEG:NSV_DSTEND), PRHODREF) - END IF - -! moments (PSVT;ppp) --> concentration (PN3D;#/m3) - CALL PPP2DUST(PSVT(:,:,:,NSV_DSTBEG:NSV_DSTEND),PRHODREF,& - PSIG3D=ZSIG_DST,PRG3D=ZRG_DST,PN3D=ZN0_DST) -! - DO JSV=1,NMODE_DST - -! #/m3 --> #/kg - ZN0_DST(:,:,:,JSV) = ZN0_DST(:,:,:,JSV) / PRHODREF(:,:,:) - -! IFN_FREE initialization (all dusts) - ZIFN_SUM(:,:,:,1) = ZIFN_SUM(:,:,:,1) + ZN0_DST(:,:,:,JSV) - - END DO - -ELSE ! keep lima class intiatialization - - ZIFN_SUM(:,:,:,1) = PSVT(:,:,:,NSV_LIMA_IFN_FREE) + PSVT(:,:,:,NSV_LIMA_IFN_NUCL) - -END IF ! endif sur LDUST - -PSVT(:,:,:,NSV_LIMA_CCN_FREE) = MAX(ZCCN_SUM(:,:,:,1) - PSVT(:,:,:,NSV_LIMA_CCN_ACTI), 0.) - -IF (NMOD_CCN .GE. 2) & -PSVT(:,:,:,NSV_LIMA_CCN_FREE+1) = MAX(ZCCN_SUM(:,:,:,2) - PSVT(:,:,:,NSV_LIMA_CCN_ACTI+1), 0.) - - -IF (NMOD_CCN .GE. 3) & -PSVT(:,:,:,NSV_LIMA_CCN_FREE+2) = MAX(ZCCN_SUM(:,:,:,3) - PSVT(:,:,:,NSV_LIMA_CCN_ACTI+2), 0.) - -PSVT(:,:,:,NSV_LIMA_IFN_FREE) = MAX(ZIFN_SUM(:,:,:,1) - PSVT(:,:,:,NSV_LIMA_IFN_NUCL), 0.) -IF (NMOD_IFN .GE. 2) & -PSVT(:,:,:,NSV_LIMA_IFN_FREE+1) = MAX(ZIFN_SUM(:,:,:,2) - PSVT(:,:,:,NSV_LIMA_IFN_NUCL+1), 0.) - -! -! -END SUBROUTINE AER2LIMA diff --git a/src/ICCARE_BASE/aerocamsn.f90 b/src/ICCARE_BASE/aerocamsn.f90 deleted file mode 100644 index b3ceb1d48..000000000 --- a/src/ICCARE_BASE/aerocamsn.f90 +++ /dev/null @@ -1,82 +0,0 @@ -!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence -!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!ORILAM_LIC for details. -!----------------------------------------------------------------- -!--------------- special set of characters for RCS information -!----------------------------------------------------------------- -! $Source$ $Revision$ -! MASDEV4_7 chimie 2006/06/16 13:28:57 -!----------------------------------------------------------------- -!! ######################## - MODULE MODI_AEROCAMS_n -!! ######################## -!! -INTERFACE -!! -SUBROUTINE AEROCAMS_n(PSV, PRHODREF) -IMPLICIT NONE -REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSV -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF -END SUBROUTINE AEROCAMS_n -!! -END INTERFACE -!! -END MODULE MODI_AEROCAMS_n -!! -!! -!! ############################################################ - SUBROUTINE AEROCAMS_n(PSV, PRHODREF) -!! ############################################################ -!! -!! PURPOSE -!! ------- -!! Converti les masses aerosols issues de CMAS (kg/kg) en variables aerosols (ppv) -!! Realise l'équilibre des moments à partir du sigma et du diametre moyen -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Pierre TULET (LA) -!! -!! MODIFICATIONS -!! ------------- -!! -!! -!! EXTERNAL -!! -------- -!! None -!! - -USE MODE_AERO_PSD -!! -IMPLICIT NONE -!! -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -!* 0.1 declarations of arguments -! -REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSV -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF -! -! -INTEGER :: JN -! -! SV conversion from kg.kg-3 --> µg/m3 ) - -DO JN =1,SIZE(PSV, 4) - PSV(:,:,:,JN) = PSV(:,:,:,JN) * 1E9 / PRHODREF(:,:,:) -ENDDO - -! Compute moment from aerosol mass and conversion SV aerosols variables into ppv - -CALL CON2MIX (PSV, PRHODREF) -! -! -END SUBROUTINE AEROCAMS_n diff --git a/src/ICCARE_BASE/allocate_physio.F90 b/src/ICCARE_BASE/allocate_physio.F90 deleted file mode 100644 index 371a45d76..000000000 --- a/src/ICCARE_BASE/allocate_physio.F90 +++ /dev/null @@ -1,175 +0,0 @@ -!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -! ######### - SUBROUTINE ALLOCATE_PHYSIO (IO, KK, PK, PEK, KVEGTYPE ) -! ########################################################################## -! -!!**** *ALLOCATE_PHYSIO* - -!! -!! PURPOSE -!! ------- -!! -!!** METHOD -!! ------ -!! -!! EXTERNAL -!! -------- -!! -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! REFERENCE -!! --------- -!! -!! -!! AUTHOR -!! ------ -!! -!! -!! MODIFICATIONS -!! ------------- -!! Original xx/xxxx -!! Modified 10/2014 P. Samuelsson MEB -! -! -USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t -USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_P_t, ISBA_PE_t -! -USE MODD_TYPE_DATE_SURF -! -USE MODD_AGRI, ONLY : LAGRIP -! -USE MODD_TREEDRAG, ONLY : LTREEDRAG -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -IMPLICIT NONE -! -! -TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO -TYPE(ISBA_K_t), INTENT(INOUT) :: KK -TYPE(ISBA_P_t), INTENT(INOUT) :: PK -TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK -! -INTEGER, INTENT(IN) :: KVEGTYPE -! -INTEGER :: ISIZE -INTEGER :: ISIZE_LMEB_PATCH ! Number of patches with MEB=true -! -! -REAL(KIND=JPRB) :: ZHOOK_HANDLE -! -!------------------------------------------------------------------------------- -! -! Mask and number of grid elements containing patches/tiles: -! -IF (LHOOK) CALL DR_HOOK('ALLOCATE_PHYSIO',0,ZHOOK_HANDLE) -! -ISIZE = PK%NSIZE_P -! -ISIZE_LMEB_PATCH=COUNT(IO%LMEB_PATCH(:)) -! -ALLOCATE(PK%XDG (ISIZE,IO%NGROUND_LAYER)) -ALLOCATE(PK%XD_ICE (ISIZE )) -! -ALLOCATE(PEK%XLAI (ISIZE )) -ALLOCATE(PEK%XLAIp (ISIZE )) -ALLOCATE(PEK%XVEG (ISIZE )) -ALLOCATE(PEK%XZ0 (ISIZE )) -ALLOCATE(PEK%XEMIS (ISIZE )) -! -ALLOCATE(PEK%XRSMIN (ISIZE )) -ALLOCATE(PEK%XGAMMA (ISIZE )) -ALLOCATE(PEK%XWRMAX_CF (ISIZE )) -ALLOCATE(PEK%XRGL (ISIZE )) -ALLOCATE(PEK%XCV (ISIZE )) -ALLOCATE(PEK%XALBNIR_VEG (ISIZE )) -ALLOCATE(PEK%XALBVIS_VEG (ISIZE )) -ALLOCATE(PEK%XALBUV_VEG (ISIZE )) -! -ALLOCATE(PK%XZ0_O_Z0H (ISIZE )) -! -IF (ISIZE_LMEB_PATCH>0 .OR. IO%CPHOTO/='NON') THEN - ALLOCATE(PEK%XBSLAI (ISIZE )) -ELSE - ALLOCATE(PEK%XBSLAI (0)) -ENDIF -! - vegetation: Ags parameters ('AGS', 'LAI', 'AST', 'LST', 'NIT' options) -! -IF (IO%CPHOTO/='NON'.OR.LTREEDRAG) THEN - ALLOCATE(PK%XH_TREE (ISIZE )) -ELSE - ALLOCATE(PK%XH_TREE (0 )) -ENDIF -! -IF (IO%CPHOTO/='NON') THEN - ALLOCATE(PK%XRE25 (ISIZE )) - ALLOCATE(PK%XDMAX (ISIZE )) - ALLOCATE(PEK%XLAIMIN (ISIZE )) - ALLOCATE(PEK%XSEFOLD (ISIZE )) - ALLOCATE(PEK%XGMES (ISIZE )) - ALLOCATE(PEK%XGC (ISIZE )) - ALLOCATE(PEK%XF2I (ISIZE )) - ALLOCATE(PEK%LSTRESS (ISIZE )) - IF (IO%CPHOTO=='NIT' .OR. IO%CPHOTO=='NCB') THEN - ALLOCATE(PEK%XCE_NITRO (ISIZE )) - ALLOCATE(PEK%XCF_NITRO (ISIZE )) - ALLOCATE(PEK%XCNA_NITRO (ISIZE )) - ELSE - ALLOCATE(PEK%XCE_NITRO (0)) - ALLOCATE(PEK%XCF_NITRO (0)) - ALLOCATE(PEK%XCNA_NITRO (0)) - ENDIF -ELSE - ALLOCATE(PK%XRE25 (0)) - ALLOCATE(PK%XDMAX (0)) - ALLOCATE(PEK%XLAIMIN (0)) - ALLOCATE(PEK%XSEFOLD (0)) - ALLOCATE(PEK%XGMES (0)) - ALLOCATE(PEK%XGC (0)) - ALLOCATE(PEK%XF2I (0)) - ALLOCATE(PEK%LSTRESS (0)) - ALLOCATE(PEK%XCE_NITRO (0)) - ALLOCATE(PEK%XCF_NITRO (0)) - ALLOCATE(PEK%XCNA_NITRO(0)) -ENDIF -! -! - Irrigation, seeding and reaping -! -IF (LAGRIP .AND. (IO%CPHOTO == 'NIT' .OR. IO%CPHOTO == 'NCB')) THEN - ALLOCATE(PEK%TSEED (ISIZE )) - ALLOCATE(PEK%TREAP (ISIZE )) - ALLOCATE(PEK%XWATSUP (ISIZE )) - ALLOCATE(PEK%XIRRIG (ISIZE )) -ELSE - ALLOCATE(PEK%TSEED (0)) - ALLOCATE(PEK%TREAP (0)) - ALLOCATE(PEK%XWATSUP (0)) - ALLOCATE(PEK%XIRRIG (0)) -ENDIF -! -! - ISBA-DF scheme -! -IF(IO%CISBA=='DIF')THEN - ALLOCATE(PK%XROOTFRAC (ISIZE,IO%NGROUND_LAYER)) - ALLOCATE(PK%NWG_LAYER (ISIZE)) - ALLOCATE(PK%XDROOT (ISIZE)) - ALLOCATE(PK%XDG2 (ISIZE)) -ELSE - ALLOCATE(PK%XROOTFRAC (0,0)) - ALLOCATE(PK%NWG_LAYER (0) ) - ALLOCATE(PK%XDROOT (0) ) - ALLOCATE(PK%XDG2 (0) ) -ENDIF -! -ALLOCATE(PEK%XGNDLITTER (ISIZE)) -ALLOCATE(PEK%XZ0LITTER (ISIZE)) -ALLOCATE(PEK%XH_VEG (ISIZE)) -! -IF (LHOOK) CALL DR_HOOK('ALLOCATE_PHYSIO',1,ZHOOK_HANDLE) -! -END SUBROUTINE ALLOCATE_PHYSIO diff --git a/src/ICCARE_BASE/allocate_teb_veg_pgd.F90 b/src/ICCARE_BASE/allocate_teb_veg_pgd.F90 deleted file mode 100644 index 32bbfd37d..000000000 --- a/src/ICCARE_BASE/allocate_teb_veg_pgd.F90 +++ /dev/null @@ -1,139 +0,0 @@ -!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -! ######### - SUBROUTINE ALLOCATE_TEB_VEG_PGD (PEK, S, K, P, OALLOC, KLU, KVEGTYPE, KGROUND_LAYER) -! ########################################################################## -! -! -USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_PE_t, ISBA_P_t, ISBA_K_t -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -IMPLICIT NONE -! -TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK -TYPE(ISBA_S_t), INTENT(INOUT) :: S -TYPE(ISBA_P_t), INTENT(INOUT) :: P -TYPE(ISBA_K_t), INTENT(INOUT) :: K -! -LOGICAL, INTENT(IN) :: OALLOC ! True if constant PGD fields must be allocated -INTEGER, INTENT(IN) :: KLU -INTEGER, INTENT(IN) :: KVEGTYPE -INTEGER, INTENT(IN) :: KGROUND_LAYER -REAL(KIND=JPRB) :: ZHOOK_HANDLE -! -!------------------------------------------------------------------------------- -! -IF (LHOOK) CALL DR_HOOK('ALLOCATE_TEB_VEG_PGD',0,ZHOOK_HANDLE) -! -!------------------------------------------------------------------------------- -! -! - Physiographic field that can evolve prognostically -! -ALLOCATE(PEK%XLAI (KLU)) -ALLOCATE(PEK%XLAIp (KLU)) -ALLOCATE(PEK%XVEG (KLU)) -ALLOCATE(PEK%XEMIS (KLU)) -ALLOCATE(PEK%XZ0 (KLU)) -! -! - vegetation: default option (Jarvis) and general parameters: -! -ALLOCATE(PEK%XRSMIN (KLU)) -ALLOCATE(PEK%XGAMMA (KLU)) -ALLOCATE(PEK%XWRMAX_CF (KLU)) -ALLOCATE(PEK%XRGL (KLU)) -ALLOCATE(PEK%XCV (KLU)) -! -ALLOCATE(PEK%XLAIMIN (KLU)) -ALLOCATE(PEK%XSEFOLD (KLU)) -ALLOCATE(PEK%XGMES (KLU)) -ALLOCATE(PEK%XGC (KLU)) -ALLOCATE(PEK%XF2I (KLU)) -ALLOCATE(PEK%XBSLAI (KLU)) -! -! - vegetation: -! -ALLOCATE(PEK%XALBNIR_VEG (KLU)) -ALLOCATE(PEK%XALBVIS_VEG (KLU)) -ALLOCATE(PEK%XALBUV_VEG (KLU)) -! -ALLOCATE(PEK%LSTRESS (KLU)) -! -!------------------------------------------------------------------------------- -! -! - vegetation: Ags Nitrogen-model parameters ('NIT' option) -! -ALLOCATE(PEK%XCE_NITRO (KLU)) -ALLOCATE(PEK%XCF_NITRO (KLU)) -ALLOCATE(PEK%XCNA_NITRO (KLU)) -! -IF (.NOT. OALLOC) THEN - IF (LHOOK) CALL DR_HOOK('ALLOCATE_TEB_VEG_PGD',1,ZHOOK_HANDLE) - RETURN -END IF -!------------------------------------------------------------------------------- -! -! Input Parameters: -! -! - vegetation + bare soil: -! -ALLOCATE(P%XZ0_O_Z0H (KLU)) -! -ALLOCATE(P%XROOTFRAC (KLU,KGROUND_LAYER )) -ALLOCATE(P%NWG_LAYER (KLU)) -ALLOCATE(P%XDROOT (KLU)) -ALLOCATE(P%XDG2 (KLU)) -! -!------------------------------------------------------------------------------- -! -! - vegetation: Ags parameters ('AGS', 'LAI', 'AST', 'LST', 'NIT' options) -! -! -ALLOCATE(P%XH_TREE (KLU)) -! -! -ALLOCATE(P%XRE25 (KLU)) -! -!------------------------------------------------------------------------------- -! -! - vegetation: Ags Stress parameters ('AST', 'LST', 'NIT' options) -! -! -ALLOCATE(P%XAH (KLU)) -ALLOCATE(P%XBH (KLU)) -! -ALLOCATE(P%XDMAX (KLU)) -! -!------------------------------------------------------------------------------- -! -! - soil: primary parameters -! -ALLOCATE(S%XSOC (KLU,KGROUND_LAYER )) -! -ALLOCATE(K%XSAND (KLU,KGROUND_LAYER )) -ALLOCATE(K%XCLAY (KLU,KGROUND_LAYER )) -ALLOCATE(K%XRUNOFFB (KLU )) -ALLOCATE(K%XWDRAIN (KLU )) -! -ALLOCATE(P%XTAUICE (KLU )) -! -ALLOCATE(P%XDG (KLU,KGROUND_LAYER)) -! -ALLOCATE(P%XRUNOFFD (KLU)) -! -!------------------------------------------------------------------------------- -! -! - SGH scheme -! -ALLOCATE(P%XD_ICE (KLU)) -! -ALLOCATE(K%XGAMMAT (KLU )) -! -!------------------------------------------------------------------------------- -! -IF (LHOOK) CALL DR_HOOK('ALLOCATE_TEB_VEG_PGD',1,ZHOOK_HANDLE) -! -END SUBROUTINE ALLOCATE_TEB_VEG_PGD diff --git a/src/ICCARE_BASE/ch_aer_cond.f90 b/src/ICCARE_BASE/ch_aer_cond.f90 deleted file mode 100644 index 2424b153b..000000000 --- a/src/ICCARE_BASE/ch_aer_cond.f90 +++ /dev/null @@ -1,124 +0,0 @@ -!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence -!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!ORILAM_LIC for details. -!----------------------------------------------------------------- -!--------------- special set of characters for RCS information -!----------------------------------------------------------------- -! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/ch_aer_growth.f90,v $ $Revision: 1.1.4.1.2.1 $ -! MASDEV4_7 chimie 2006/05/18 13:07:25 -!----------------------------------------------------------------- -!! ######################### - MODULE MODI_CH_AER_COND -!! ######################### -!! -INTERFACE -!! -SUBROUTINE CH_AER_COND(PM, PLNSIG, PRG, PPRESSURE, PTEMP, & - PDM3CDT, PDM6CDT ) -IMPLICIT NONE -REAL, DIMENSION(:,:), INTENT(IN) :: PM, PLNSIG, PRG -REAL, DIMENSION(:), INTENT(IN) :: PPRESSURE, PTEMP -REAL, DIMENSION(:,:), INTENT(INOUT) :: PDM3CDT, PDM6CDT -END SUBROUTINE CH_AER_COND -!! -END INTERFACE -!! -END MODULE MODI_CH_AER_COND -!! -!! ################################################################# - SUBROUTINE CH_AER_COND(PM, PLNSIG, PRG, PPRESSURE, PTEMP, & - PDM3CDT, PDM6CDT ) -!! ################################################################# -!! -!! PURPOSE -!! ------- -!! -!! This routine computes the condensated mass and tendencies. -!! Note that dM0_cond/dt = 0 : The condensation doesn't create particles. -!! Only moments 3 and 6 are computed. -!! -!! REFERENCE -!! --------- -!! -!! Method from CMAQ model: -!! -!! Binkowski, F.S. and U. Shankar, The regional particulate matter -!! model 1. Model description and preliminary results, J. Geophys. -!! Res., Vol 100, No D12, 26101-26209, 1995. -!! -!! -!! AUTHOR -!! ------ -!! Joris Pianezze (2018) * LACy * -!! -!! MODIFICATIONS -!! ------------- -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_CH_AEROSOL -USE MODD_CST, ONLY : XPI, XBOLTZ, XAVOGADRO -USE MODD_CONF, ONLY : NVERB -!! -IMPLICIT NONE -! -!* 0.1 Declarations of arguments -! -REAL, DIMENSION(:,:), INTENT(IN) :: PM, PLNSIG, PRG -REAL, DIMENSION(:), INTENT(IN) :: PPRESSURE, PTEMP -REAL, DIMENSION(:,:), INTENT(INOUT) :: PDM3CDT, PDM6CDT -! -!* 0.2 Declarations of local variables -! -INTEGER :: JI,JK -REAL :: ZALPHA -REAL, DIMENSION(SIZE(PM,1)) :: ZDIFFSULF, ZDIFFCORR, ZDV -REAL, DIMENSION(SIZE(PM,1)) :: ZCBAR -REAL, DIMENSION(SIZE(PM,1)) :: ZGNC3, ZGNC6, ZGFM3, ZGFM6 -REAL, DIMENSION(SIZE(PM,1),6,JPMODE) :: ZMOM -! -! -!------------------------------------------------------------------------------- -! -!* 1. INITIALIZATION -! -------------- -! -ZALPHA = 0.1 -ZDIFFSULF = 9.36E-6 ! molecular diffusivity of sulfuric acid -ZDIFFCORR = (101325.0/PPRESSURE) * (PTEMP/273.15)**(1.75) ! correction factor for atmospheric conditions -ZDV = ZDIFFSULF * ZDIFFCORR ! corrected molecural diffusivity of sulfuric acid -ZCBAR = SQRT(8.0*XBOLTZ*XAVOGADRO*PTEMP/(XPI*XH2SO4*1E-3)) ! molecular velocitie (temperature dependent) -! -! -!------------------------------------------------------------------------------- -! -!* 2. COMPUTE CONDENSATED MASS AND TENDENCIES -! --------------------------------------- -! -DO JI=1,JPMODE - ! - ! ZMOM = Equation (after integration) for every moment (JK order): Tulet 2005 - ! ZMOM = m**k.m**-3 - DO JK=1,6 - ZMOM(:,JK,JI) = PM(:,NM0(JI))*((PRG(:,JI)*1E-6)**JK)* & - EXP(((REAL(JK)**2)/2.)*(PLNSIG(:,JI)**2.0)) - ENDDO - ! - ZGNC3 = 2 * XPI * ZDV * ZMOM(:,1,JI) ! 3rd moment, near-continuum - ZGNC6 = 2 * XPI * ZDV * ZMOM(:,4,JI) ! 6th moment, near-continuum - ZGFM3 = (XPI / 4.0) * ZALPHA * ZCBAR * ZMOM(:,2,JI) ! 3rd moment, free-molecular - ZGFM6 = (XPI / 4.0) * ZALPHA * ZCBAR * ZMOM(:,5,JI) ! 6th moment, free-molecular - ! - PDM3CDT(:,JI) = ZGNC3 * ZGFM3 / ( ZGNC3 + ZGFM3 ) ! 3rd moment : m**3 / m**3 s - PDM6CDT(:,JI) = ZGNC6 * ZGFM6 / ( ZGNC6 + ZGFM6 ) ! 6th moment : m**6 / m**3 s - ! -END DO -! -END SUBROUTINE CH_AER_COND diff --git a/src/ICCARE_BASE/ch_aer_driver.f90 b/src/ICCARE_BASE/ch_aer_driver.f90 deleted file mode 100644 index 2b0537ab7..000000000 --- a/src/ICCARE_BASE/ch_aer_driver.f90 +++ /dev/null @@ -1,357 +0,0 @@ -!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence -!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!ORILAM_LIC for details. -! ######################### - MODULE MODI_CH_AER_DRIVER -! ######################### -! -INTERFACE -! -SUBROUTINE CH_AER_DRIVER(PM, PLNSIG, PRG, PN, PCTOTG, PCTOTA, & - PCCTOT, PDTACT, PSEDA, & - PRHOP, PSO4RAT, & - PRV, PDENAIR, PPRESSURE, PTEMP, PRC, PMASK, & - PTIME, PSOLORG, & - PJNUC, PJ2RAT, PMBEG, PMINT, PMEND, & - PDMINTRA, PDMINTER, PDMCOND, PDMNUCL, PDMMERG, & - PCONC_MASS, PCOND_MASS_I, PCOND_MASS_J, PNUCL_MASS) -IMPLICIT NONE -REAL, INTENT(IN) :: PDTACT, PTIME -REAL, DIMENSION(:,:), INTENT(INOUT) :: PRHOP -REAL, DIMENSION(:), INTENT(INOUT) :: PSO4RAT -REAL, DIMENSION(:,:), INTENT(INOUT) :: PM -REAL, DIMENSION(:,:), INTENT(INOUT) :: PLNSIG, PRG, PN -REAL, DIMENSION(:,:), INTENT(INOUT) :: PCTOTG -REAL, DIMENSION(:,:), INTENT(INOUT) :: PSOLORG -REAL, DIMENSION(:,:), INTENT(INOUT) :: PSEDA -REAL, DIMENSION(:,:), INTENT(INOUT) :: PMASK -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCTOTA, PCCTOT -REAL, DIMENSION(:), INTENT(IN) :: PRV, PDENAIR, PPRESSURE, PTEMP, PRC -REAL, DIMENSION(:), INTENT(INOUT) :: PJNUC, PJ2RAT -REAL, DIMENSION(:,:), INTENT(INOUT) :: PMBEG,PMINT,PMEND -REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMINTRA,PDMINTER,PDMCOND,PDMNUCL,PDMMERG -REAL, DIMENSION(:), INTENT(INOUT) :: PCONC_MASS,PCOND_MASS_I,PCOND_MASS_J,PNUCL_MASS -END SUBROUTINE CH_AER_DRIVER -! -END INTERFACE -! -END MODULE MODI_CH_AER_DRIVER -! -!##################################################################################### -SUBROUTINE CH_AER_DRIVER(PM, PLNSIG, PRG, PN, PCTOTG, PCTOTA, & - PCCTOT, PDTACT, PSEDA, & - PRHOP, PSO4RAT, & - PRV, PDENAIR, PPRESSURE, PTEMP, PRC, PMASK, & - PTIME, PSOLORG, & - PJNUC,PJ2RAT,PMBEG,PMINT,PMEND, & - PDMINTRA,PDMINTER,PDMCOND,PDMNUCL,PDMMERG, & - PCONC_MASS,PCOND_MASS_I,PCOND_MASS_J,PNUCL_MASS) -!##################################################################################### -!! -!! PURPOSE -!! ------- -!! Compute the right hand side of the moment equations and solve the moment equations -!! -!! EXTERNAL -!! -------- -!! Subroutine CH_AER_COAG : compute coagulation moment tendency terms -!! Subroutine CH_AER_COND : compute condensation from CMAQ model -!! Subroutine CH_AER_NUCL : compute nucleation rate -!! Subroutine CH_AER_MODE_MERGING : adjust tendency terms in case of mode i > mode j -!! Subroutine CH_AER_SOLV : solve moment equations -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! MODD_CH_AEROSOL -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Vincent Crassier (LA) -!! -!! MODIFICATIONS -!! ------------- -!! Original -!! M. Leriche (??/2015) Calcul de la fraction massique entre les modes -!! M. Leriche (08/2016) Suppress moments index declaration already in modd_aerosol -!! J. Pianezze (06/2018) ... -!------------------------------------------------------------------------------- -! -! * 0. DECLARATIONS -! ------------ -! -USE MODI_CH_AER_COAG -USE MODI_CH_AER_COND -USE MODI_CH_AER_NUCL -USE MODI_CH_AER_MODE_MERGING -USE MODI_CH_AER_SOLV -! -USE MODD_CH_AEROSOL -USE MODD_CONF, ONLY : NVERB -USE MODD_CST, ONLY : XAVOGADRO -! -IMPLICIT NONE -! -! * 0.1 declarations of arguments -! -REAL, INTENT(IN) :: PDTACT, PTIME -REAL, DIMENSION(:,:), INTENT(INOUT) :: PRHOP -REAL, DIMENSION(:), INTENT(INOUT) :: PSO4RAT -REAL, DIMENSION(:,:), INTENT(INOUT) :: PM -REAL, DIMENSION(:,:), INTENT(INOUT) :: PLNSIG, PRG, PN -REAL, DIMENSION(:,:), INTENT(INOUT) :: PCTOTG -REAL, DIMENSION(:,:), INTENT(INOUT) :: PSOLORG -REAL, DIMENSION(:,:), INTENT(INOUT) :: PSEDA -REAL, DIMENSION(:,:), INTENT(INOUT) :: PMASK -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCTOTA, PCCTOT -REAL, DIMENSION(:), INTENT(IN) :: PRV, PDENAIR, PPRESSURE, PTEMP, PRC -REAL, DIMENSION(:), INTENT(INOUT) :: PJNUC, PJ2RAT -REAL, DIMENSION(:,:), INTENT(INOUT) :: PMBEG,PMINT,PMEND -REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMINTRA,PDMINTER,PDMCOND,PDMNUCL,PDMMERG -REAL, DIMENSION(:), INTENT(INOUT) :: PCONC_MASS,PCOND_MASS_I,PCOND_MASS_J,PNUCL_MASS -! -! * 0.2 declarations of local variables -! -INTEGER :: JI, JJ -! -REAL :: ZGASMW ! Molecular weight of background gas (g/mol) -REAL, DIMENSION(SIZE(PM,1)) :: ZRH,ZPSAT ! Relative humidity, ? -REAL, DIMENSION(SIZE(PM,1)) :: ZPKM, ZPKH2O -REAL, DIMENSION(SIZE(PM,1)) :: ZMU, ZLAMBDA -! -REAL, DIMENSION(SIZE(PM,1)) :: ZDMNDT, ZDM3DT, ZDM6DT, ZDMN3DT, ZDMN6DT -REAL, DIMENSION(SIZE(PM,1),JPMODE) :: ZDMC0DT, ZDMC3DT, ZDMC6DT -REAL, DIMENSION(SIZE(PM,1),3*JPMODE) :: ZDMGROW -REAL, DIMENSION(SIZE(PM,1)) :: ZSULF -! -!------------------------------------------------------------------------------- -! -! * 1. INITIALIZATION -! -------------- -! -PDMINTRA(:,:) = 0.0 -PDMINTER(:,:) = 0.0 -PDMCOND(:,:) = 0.0 -PDMNUCL(:,:) = 0.0 -PDMMERG(:,:) = 0.0 -! -ZDMGROW(:,:) = 0.0 -! -ZDMC0DT(:,:) = 0.0 -ZDMC3DT(:,:) = 0.0 -ZDMC6DT(:,:) = 0.0 -! -ZDMN3DT(:) = 0.0 -ZDMN6DT(:) = 0.0 -! -! * Compute relative humidity -! -ZPKM (:) = 1E-3*PDENAIR(:) * XAVOGADRO / 28.9644 -ZPKH2O(:) = ZPKM(:)*1.6077*PRV(:) -ZPSAT (:) = 0.611*EXP(17.2694*(PTEMP(:)-273.16)/(PTEMP(:)-35.86)) -ZPSAT (:) = ZPSAT(:)*1000. -ZRH (:) = (ZPKH2O(:)/(ZPKM(:)*1.6077))*PPRESSURE(:)/& - & (0.622+(ZPKH2O(:)/(ZPKM(:)*1.6077)))/ZPSAT(:) -ZGASMW = 29.0 -! -! * gas viscosity -ZMU(:) = 0.003661*PTEMP(:) -ZMU(:) = 0.0066164*ZMU(:)*sqrt(ZMU(:))/(PTEMP(:)+114.d0) -! * mean free path -ZLAMBDA(:)=ZMU(:)/PDENAIR(:)*sqrt(1.89d-4*ZGASMW/PTEMP(:))*1.e6 -! -! -! [ug.m-3.s-1] = [molec.cm-3.s-1] * *XH2SO4 / (XAVOGADRO*1.E-12) -PSO4RAT(:) = PSO4RAT(:) * XH2SO4 / (XAVOGADRO*1.E-12) -! -! ZSULF [ug.m-3.s-1] = production rate of sulfuric acid -ZSULF(:) = PSO4RAT(:) -! -! Stock value for diag -PCONC_MASS(:) = ZSULF(:) * PDTACT -! -!------------------------------------------------------- -! -! * 2. COMPUTE COAGULATION TERMS -! ------------------------------------------ -! -IF (LCOAGULATION) THEN - CALL CH_AER_COAG(PM, PLNSIG, PRG, PN, PDMINTRA, PDMINTER, & - PTEMP, ZMU, ZLAMBDA, PRHOP ) -ELSE - PDMINTRA(:,:) = 0.0 - PDMINTER(:,:) = 0.0 -ENDIF -! -!------------------------------------------------------- -! -! * 3. COMPUTE NUCLEATION -! -------------------------------------------- -! -! -! * 2.0 Compute sulfuric acid concentration available for nucleation -! ----------------------------------------------------------- -! -! dC / dt = P - Cs / time -! -CALL CH_AER_COND(PM, PLNSIG, PRG, PPRESSURE, PTEMP, & - ZDMC3DT, ZDMC6DT ) -! -ZSULF(:) = ZSULF(:) / (ZDMC3DT(:,1)+ZDMC3DT(:,2)) -! -! -!* 2.1 NUCLEATION -! ---------- -! -! -IF (CNUCLEATION == 'NONE') THEN - PJNUC = 0.0 -ELSE - CALL CH_AER_NUCL(ZRH,PTEMP,ZSULF,PJNUC,PJ2RAT) -END IF -! -! Convert nucleation rate -! [ug.m-3.s-1] = [molec.cm-3.s-1] * XH2SO4 / (XAVOGADRO*1.E-12) -! -ZDMNDT(:) = PJNUC(:) * XH2SO4 / (XAVOGADRO*1.E-12) -! -! H2SO4 final [ug.m-3] = H2SO4 initial [ug.m-3] -! - H2SO4 rate consumed by nucleation [ug.m-3.s-1] * Time step [s] -! -DO JI=1, SIZE(PM(:,1)) - ! - IF ( ZDMNDT(JI) .GT. PSO4RAT(JI) ) THEN - ! - ZDMNDT(JI) = PSO4RAT(JI) - PJNUC (JI) = ZDMNDT (JI) / XH2SO4 * (XAVOGADRO*1.E-12) - ! - END IF -ENDDO -! -ZSULF(:) = (PSO4RAT(:)-ZDMNDT(:)) * PDTACT -! -PNUCL_MASS(:) = ZDMNDT(:) * PDTACT -! -! -! Update moment tendencies for nucleation -! -PDMNUCL(:,NM0(1)) = ZDMNDT(:)/(XFAC(JP_AER_SO4)*( (XRADIUS_NUCL)**3)*EXP(4.5 * LOG(XSIGMA_NUCL)**2)) -PDMNUCL(:,NM3(1)) = ZDMNDT(:)/XFAC(JP_AER_SO4) -PDMNUCL(:,NM6(1)) = PDMNUCL(:,NM0(1))*( (XRADIUS_NUCL)**6*EXP(18.*LOG(XSIGMA_NUCL)**2)) -PDMNUCL(:,NM0(2)) = 0.0 -PDMNUCL(:,NM3(2)) = 0.0 -PDMNUCL(:,NM6(2)) = 0.0 -! -!------------------------------------------------------- -! -! * 3. COMPUTE CONDENSATION -! -------------------- -! -! -IF (LCONDENSATION) THEN - ! - ! Update dM0_cond / dt - PDMCOND(:,NM0(1)) = 0.0 - PDMCOND(:,NM0(2)) = 0.0 - ! - ! Update of dM3_cond/dt from new dMass_cond/dt - ! - PDMCOND(:,NM3(1)) = (ZSULF(:)/PDTACT) / XFAC(JP_AER_SO4) * (ZDMC3DT(:,1) / (ZDMC3DT(:,1)+ZDMC3DT(:,2) )) - PDMCOND(:,NM3(2)) = (ZSULF(:)/PDTACT) / XFAC(JP_AER_SO4) * (ZDMC3DT(:,2) / (ZDMC3DT(:,1)+ZDMC3DT(:,2) )) - ! - ! Compute dM0_cond/dt --> usefull for calculation of dM6_cond/dt - ! - ZDMC0DT(:,1) = PDMCOND(:,NM3(1)) / (( (PRG(:,1))**3 ) * EXP(4.5 * PLNSIG(:,1)**2)) - ZDMC0DT(:,2) = PDMCOND(:,NM3(2)) / (( (PRG(:,2))**3 ) * EXP(4.5 * PLNSIG(:,2)**2)) - ! - PDMCOND(:,NM6(1)) = ZDMC0DT(:,1) * (( (PRG(:,1))**6 ) * EXP(18. * PLNSIG(:,1)**2)) - PDMCOND(:,NM6(2)) = ZDMC0DT(:,2) * (( (PRG(:,2))**6 ) * EXP(18. * PLNSIG(:,2)**2)) - ! -ELSE - ! - ZDMC0DT(:,:) = 0.0 - ZDMC3DT(:,:) = 0.0 - ZDMC6DT(:,:) = 0.0 - PDMCOND(:,:) = 0.0 - ! -ENDIF -! -! Stock new values of condensated mass for diagnostic -! -! [ug.m-3] = [um3.m-3.s-1]*[s]*XFAC -PCOND_MASS_I(:) = PDMCOND(:,NM3(1)) * PDTACT * XFAC(JP_AER_SO4) -PCOND_MASS_J(:) = PDMCOND(:,NM3(2)) * PDTACT * XFAC(JP_AER_SO4) -! -!------------------------------------------------------------------------------- -! -! * 4. MODE MERGING -! ------------ -! -! This code implements Section 1.5 of Binkowski and Roselle (2003). -! If the Aitken mode mass is growing faster than accumulation mode -! mass and the Aitken mode number concentration exceeds the -! accumulation mode number concentration, then moments tendency -! are adjusted. -! -IF (LMODE_MERGING) THEN - ZDMGROW(:,NM0(1)) = PDMCOND(:,NM0(1)) + PDMINTER(:,NM0(1)) + PDMINTRA(:,NM0(1)) - ZDMGROW(:,NM3(1)) = PDMCOND(:,NM3(1)) + PDMINTER(:,NM3(1)) + PDMINTRA(:,NM3(1)) - ZDMGROW(:,NM6(1)) = PDMCOND(:,NM6(1)) + PDMINTER(:,NM6(1)) + PDMINTRA(:,NM6(1)) - ZDMGROW(:,NM0(2)) = PDMCOND(:,NM0(2)) + PDMINTER(:,NM0(2)) + PDMINTRA(:,NM0(2)) - ZDMGROW(:,NM3(2)) = PDMCOND(:,NM3(2)) + PDMINTER(:,NM3(2)) + PDMINTRA(:,NM3(2)) - ZDMGROW(:,NM6(2)) = PDMCOND(:,NM6(2)) + PDMINTER(:,NM6(2)) + PDMINTRA(:,NM6(2)) - CALL CH_AER_MODE_MERGING(PM, PLNSIG, PRG, ZDMGROW, PDMMERG) -ELSE - PDMMERG(:,:)=0.0 -ENDIF -! -!------------------------------------------------------------------------------- -! -! * 5. UPDATE OF SULFURIC ACID CONCENTRATION -! ------------------------------------- -! -PCTOTG(:,JP_AER_SO4g)=PCTOTG(:,JP_AER_SO4g)-PCOND_MASS_I(:)-PCOND_MASS_J(:)-PNUCL_MASS(:) -! -!------------------------------------------------------- -! -! * 6. MASK DIFFERENT TERMS -! -------------------- -! -! DIRE A QUOI SERVENT CES MASKS.... ? -! -DO JI=1,JPMODE - PDMINTRA(:,NM0(JI)) = PDMINTRA(:,NM0(JI)) * PMASK(:,JI) - PDMINTRA(:,NM3(JI)) = PDMINTRA(:,NM3(JI)) * PMASK(:,JI) - PDMINTRA(:,NM6(JI)) = PDMINTRA(:,NM6(JI)) * PMASK(:,JI) - PDMINTER(:,NM0(JI)) = PDMINTER(:,NM0(JI)) * PMASK(:,JI) - PDMINTER(:,NM3(JI)) = PDMINTER(:,NM3(JI)) * PMASK(:,JI) - PDMINTER(:,NM6(JI)) = PDMINTER(:,NM6(JI)) * PMASK(:,JI) - PDMCOND (:,NM0(JI)) = PDMCOND (:,NM0(JI)) * PMASK(:,JI) - PDMCOND (:,NM3(JI)) = PDMCOND (:,NM3(JI)) * PMASK(:,JI) - PDMCOND (:,NM6(JI)) = PDMCOND (:,NM6(JI)) * PMASK(:,JI) - PDMNUCL (:,NM0(JI)) = PDMNUCL (:,NM0(JI)) * PMASK(:,JI) - PDMNUCL (:,NM3(JI)) = PDMNUCL (:,NM3(JI)) * PMASK(:,JI) - PDMNUCL (:,NM6(JI)) = PDMNUCL (:,NM6(JI)) * PMASK(:,JI) - PDMMERG (:,NM0(JI)) = PDMMERG (:,NM0(JI)) * PMASK(:,JI) - PDMMERG (:,NM3(JI)) = PDMMERG (:,NM3(JI)) * PMASK(:,JI) - PDMMERG (:,NM6(JI)) = PDMMERG (:,NM6(JI)) * PMASK(:,JI) - PSEDA (:,NM0(JI)) = PSEDA (:,NM0(JI)) * PMASK(:,JI) - PSEDA (:,NM3(JI)) = PSEDA (:,NM3(JI)) * PMASK(:,JI) - PSEDA (:,NM6(JI)) = PSEDA (:,NM6(JI)) * PMASK(:,JI) -END DO -! -!------------------------------------------------------- -! -! * 7. SOLVE MOMENT EQUATIONS -! ---------------------- -! -CALL CH_AER_SOLV(PM, PLNSIG, PRG, PN, PCTOTG, PCTOTA, PCCTOT, & - PDMINTRA, PDMINTER, PDMCOND, PDMNUCL, PDMMERG, PSEDA, & - PDTACT, PRV, PDENAIR, PPRESSURE, PTEMP, PRC, PTIME, & - PSOLORG, PMBEG, PMINT, PMEND) -! -END SUBROUTINE CH_AER_DRIVER diff --git a/src/ICCARE_BASE/ch_aer_eqm_initn.f90 b/src/ICCARE_BASE/ch_aer_eqm_initn.f90 deleted file mode 100644 index 0759d63ce..000000000 --- a/src/ICCARE_BASE/ch_aer_eqm_initn.f90 +++ /dev/null @@ -1,421 +0,0 @@ -!ORILAM_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier -!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence -!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!ORILAM_LIC for details. -!----------------------------------------------------------------- -!! ######################## - MODULE MODI_CH_AER_EQM_INIT_n -!! ######################## -!! -INTERFACE -!! -SUBROUTINE CH_AER_EQM_INIT_n(PCHEM, PAERO, PM3D, PRHOP3D, PSIG3D, PRG3D, & - PN3D, PRHODREF, PCTOTA) -IMPLICIT NONE -REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PCHEM, PAERO -REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PM3D, PRHOP3D, PSIG3D, PRG3D, PN3D -REAL, DIMENSION(:,:,:,:,:),INTENT(INOUT) :: PCTOTA -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF -END SUBROUTINE CH_AER_EQM_INIT_n -!! -END INTERFACE -!! -END MODULE MODI_CH_AER_EQM_INIT_n -!! -!! -!! ############################################################ - SUBROUTINE CH_AER_EQM_INIT_n(PCHEM,PAERO, PM3D, PRHOP3D, PSIG3D, PRG3D, & - PN3D, PRHODREF, PCTOTA) -!! ############################################################ -!! -!! PURPOSE -!! ------- -!! Realise l'equilibre entre les moments via la masse contenue -!! dans les aerosols, les diametres moyens et la dispersion. -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Pierre TULET (LA) -!! -!! MODIFICATIONS -!! ------------- -!! M.Leriche 2015 : masse molaire Black carbon à 12 g/mol -! P. Wautelet 05/03/2019: modify allocation procedure for XMI and XSOLORG -!! -!! EXTERNAL -!! -------- -!! None -!! -USE MODD_CH_AEROSOL -USE MODD_CSTS_DUST, ONLY : XDENSITY_DUST -USE MODD_CH_AERO_n -USE MODD_CH_M9_n, ONLY : CNAMES, NEQ -USE MODD_CH_MNHC_n, ONLY : LCH_INIT_FIELD -USE MODD_NSV -USE MODD_CONF -USE MODE_ll -USE MODD_PARAMETERS, ONLY : JPVEXT -USE MODD_CST, ONLY : & - XMNH_TINY & - ,XAVOGADRO & ![molec/mol] avogadros number - ,XMD ![kg/mol] molar weight of air -!! -IMPLICIT NONE -!! -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -!* 0.1 declarations of arguments -! -REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PCHEM, PAERO -REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PM3D, PRHOP3D, PSIG3D, PRG3D, PN3D -REAL, DIMENSION(:,:,:,:,:), INTENT(INOUT) :: PCTOTA -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF - - -! -! -!* 0.2 declarations local variables -! -REAL,DIMENSION(SIZE(PCHEM,1),SIZE(PCHEM,2),SIZE(PCHEM,3),NSP+NCARB+NSOA,JPMODE) :: ZCCTOT -REAL,DIMENSION(SIZE(PCHEM,1),SIZE(PCHEM,2),SIZE(PCHEM,3)) :: ZSUM -REAL,DIMENSION(SIZE(PCHEM,1),SIZE(PCHEM,2),SIZE(PCHEM,3)) :: ZSIGMA -REAL,DIMENSION(SIZE(PCHEM,1),SIZE(PCHEM,2),SIZE(PCHEM,3)) :: ZBCMINI, ZBCMINJ, ZOCMINI, ZOCMINJ, ZDSTMINI, ZDSTMINJ -REAL,DIMENSION(SIZE(PCHEM,1),SIZE(PCHEM,2),SIZE(PCHEM,3),JPMODE*3) :: ZPM -REAL,DIMENSION(SIZE(PCHEM,1),SIZE(PCHEM,2),SIZE(PCHEM,3)) :: ZPOIDS, ZWORK -REAL :: ZMASS, ZM6MIN -INTEGER :: JN, JJ, JK ! loop counter -INTEGER :: IINFO_ll -REAL :: ZDEN2MOL, ZRHODREFMIN, ZCOEFAEROBC, ZCOEFAEROOC, ZCOEFAERODST -REAL :: ZVALBC, ZVALOC, ZMINRGI, ZMINRGJ, ZVALDST -REAL :: ZSUMAEROCO, ZSUMRHOD -REAL :: ZINIRADIUSI, ZINIRADIUSJ -! -!------------------------------------------------------------------------------- -! - -!* 1. TRANSFER FROM GAS TO AEROSOL MODULE -! ------------------------------------ -! 1.1 initialisation -! Index gas scheme <=> Index Orilam - -DO JJ=1,SIZE(CNAMES) -IF (CNAMES(JJ) == "CO") JP_CH_CO = JJ -END DO - -ZDEN2MOL = 1E-6 * XAVOGADRO / XMD - -IF ( ASSOCIATED(XMI) ) THEN - IF ( SIZE(XMI) == 0 ) THEN - DEALLOCATE( XMI ) - XMI => NULL() - END IF -END IF -IF (.NOT.(ASSOCIATED(XMI))) THEN - ALLOCATE(XMI(SIZE(PCHEM,1),SIZE(PCHEM,2),SIZE(PCHEM,3),NSP+NCARB+NSOA)) -END IF - -IF ( ASSOCIATED(XSOLORG) ) THEN - IF ( SIZE(XSOLORG) == 0 ) THEN - DEALLOCATE( XSOLORG ) - XSOLORG => NULL() - END IF -END IF -IF (.NOT.(ASSOCIATED(XSOLORG))) THEN - ALLOCATE(XSOLORG(SIZE(PCHEM,1),SIZE(PCHEM,2),SIZE(PCHEM,3),10)) - XSOLORG(:,:,:,:) = 0. -END IF -IF (.NOT.(ALLOCATED(XFAC))) ALLOCATE(XFAC(NSP+NSOA+NCARB)) -IF (.NOT.(ALLOCATED(XRHOI))) ALLOCATE(XRHOI(NSP+NSOA+NCARB)) -IF (.NOT.(ASSOCIATED(XFRAC))) ALLOCATE(XFRAC(SIZE(PCHEM,1),SIZE(PCHEM,2),SIZE(PCHEM,3),NEQ)) -IF (.NOT.(ASSOCIATED(XSEDA))) ALLOCATE(XSEDA(SIZE(PCHEM,1),SIZE(PCHEM,2),SIZE(PCHEM,3),JPMODE*3)) -! -! Default values of molar mass - -XMI(:,:,:,:) = 250. -XMI(:,:,:,JP_AER_SO4) = 98. -XMI(:,:,:,JP_AER_NO3) = 63. -XMI(:,:,:,JP_AER_NH3) = 17. -XMI(:,:,:,JP_AER_H2O) = 18. -XMI(:,:,:,JP_AER_BC) = 12. -XMI(:,:,:,JP_AER_DST) = 100. -IF (NSOA .EQ. 10) THEN -XMI(:,:,:,JP_AER_SOA1) = 88. -XMI(:,:,:,JP_AER_SOA2) = 180. -XMI(:,:,:,JP_AER_SOA3) = 1.5374857E+02 -XMI(:,:,:,JP_AER_SOA4) = 1.9586780E+02 -XMI(:,:,:,JP_AER_SOA5) = 195. -XMI(:,:,:,JP_AER_SOA6) = 195. -XMI(:,:,:,JP_AER_SOA7) = 165. -XMI(:,:,:,JP_AER_SOA8) = 195. -XMI(:,:,:,JP_AER_SOA9) = 270. -XMI(:,:,:,JP_AER_SOA10) = 210. -END IF - - -! Moments index -NM0(1) = 1 -NM3(1) = 2 -NM6(1) = 3 -NM0(2) = 4 -NM3(2) = 5 -NM6(2) = 6 - -IF (CRGUNIT=="MASS") THEN - ZINIRADIUSI = XINIRADIUSI * EXP(-3.*(LOG(XINISIGI))**2) - ZINIRADIUSJ = XINIRADIUSJ * EXP(-3.*(LOG(XINISIGJ))**2) -ELSE - ZINIRADIUSI = XINIRADIUSI - ZINIRADIUSJ = XINIRADIUSJ -END IF -ZMINRGI = ZINIRADIUSI ! * XCOEFRADIMIN -ZMINRGJ = ZINIRADIUSJ ! * XCOEFRADJMIN - - -! Aerosol Density -! Cf Ackermann (all to black carbon except water) -XRHOI(:) = 1.8e3 -XRHOI(JP_AER_H2O) = 1.0e3 ! water -XRHOI(JP_AER_DST) = XDENSITY_DUST ! dusts - -PCHEM(:,:,:,:) = MAX(PCHEM(:,:,:,:), 0.) -PAERO(:,:,:,:) = MAX(PAERO(:,:,:,:), XMNH_TINY ) -! - -DO JJ=1,NSP+NCARB+NSOA - XFAC(JJ)=(4./3.)*3.14292654*XRHOI(JJ)*1.e-9 -ENDDO -! -! -!* 1.n transfer aerosol mass from gas to aerosol variables -! (and conversion of part/part --> microgram/m3) -! -DO JJ=1,NSV_AER - PAERO(:,:,:,JJ) = PAERO(:,:,:,JJ) * ZDEN2MOL * PRHODREF(:,:,:) -ENDDO - -! -PCTOTA(:,:,:,:,:) =0. -! mineral phase - PCTOTA(:,:,:,JP_AER_SO4,1) = PAERO(:,:,:,JP_CH_SO4i)*XMI(:,:,:,JP_AER_SO4)/6.0221367E+11 - PCTOTA(:,:,:,JP_AER_SO4,2) = PAERO(:,:,:,JP_CH_SO4j)*XMI(:,:,:,JP_AER_SO4)/6.0221367E+11 - - PCTOTA(:,:,:,JP_AER_NO3,1) = PAERO(:,:,:,JP_CH_NO3i)*XMI(:,:,:,JP_AER_NO3)/6.0221367E+11 - PCTOTA(:,:,:,JP_AER_NO3,2) = PAERO(:,:,:,JP_CH_NO3j)*XMI(:,:,:,JP_AER_NO3)/6.0221367E+11 - - PCTOTA(:,:,:,JP_AER_NH3,1) = PAERO(:,:,:,JP_CH_NH3i)*XMI(:,:,:,JP_AER_NH3)/6.0221367E+11 - PCTOTA(:,:,:,JP_AER_NH3,2) = PAERO(:,:,:,JP_CH_NH3j)*XMI(:,:,:,JP_AER_NH3)/6.0221367E+11 - -! water - PCTOTA(:,:,:,JP_AER_H2O,1) = PAERO(:,:,:,JP_CH_H2Oi)*XMI(:,:,:,JP_AER_H2O)/6.0221367E+11 - PCTOTA(:,:,:,JP_AER_H2O,2) = PAERO(:,:,:,JP_CH_H2Oj)*XMI(:,:,:,JP_AER_H2O)/6.0221367E+11 - -! -! primary organic carbon - PCTOTA(:,:,:,JP_AER_OC,1) = PAERO(:,:,:,JP_CH_OCi)*XMI(:,:,:,JP_AER_OC)/6.0221367E+11 - PCTOTA(:,:,:,JP_AER_OC,2) = PAERO(:,:,:,JP_CH_OCj)*XMI(:,:,:,JP_AER_OC)/6.0221367E+11 - -! primary black carbon - PCTOTA(:,:,:,JP_AER_BC,1) = PAERO(:,:,:,JP_CH_BCi)*XMI(:,:,:,JP_AER_BC)/6.0221367E+11 - PCTOTA(:,:,:,JP_AER_BC,2) = PAERO(:,:,:,JP_CH_BCj)*XMI(:,:,:,JP_AER_BC)/6.0221367E+11 - -!dust - PCTOTA(:,:,:,JP_AER_DST,1) = PAERO(:,:,:,JP_CH_DSTi)*XMI(:,:,:,JP_AER_DST)/6.0221367E+11 - PCTOTA(:,:,:,JP_AER_DST,2) = PAERO(:,:,:,JP_CH_DSTj)*XMI(:,:,:,JP_AER_DST)/6.0221367E+11 - - -! -IF (NSOA .EQ. 10) THEN - PCTOTA(:,:,:,JP_AER_SOA1,1) = PAERO(:,:,:,JP_CH_SOA1i)*XMI(:,:,:,JP_AER_SOA1)/6.0221367E+11 - PCTOTA(:,:,:,JP_AER_SOA1,2) = PAERO(:,:,:,JP_CH_SOA1j)*XMI(:,:,:,JP_AER_SOA1)/6.0221367E+11 - PCTOTA(:,:,:,JP_AER_SOA2,1) = PAERO(:,:,:,JP_CH_SOA2i)*XMI(:,:,:,JP_AER_SOA2)/6.0221367E+11 - PCTOTA(:,:,:,JP_AER_SOA2,2) = PAERO(:,:,:,JP_CH_SOA2j)*XMI(:,:,:,JP_AER_SOA2)/6.0221367E+11 - PCTOTA(:,:,:,JP_AER_SOA3,1) = PAERO(:,:,:,JP_CH_SOA3i)*XMI(:,:,:,JP_AER_SOA3)/6.0221367E+11 - PCTOTA(:,:,:,JP_AER_SOA3,2) = PAERO(:,:,:,JP_CH_SOA3j)*XMI(:,:,:,JP_AER_SOA3)/6.0221367E+11 - PCTOTA(:,:,:,JP_AER_SOA4,1) = PAERO(:,:,:,JP_CH_SOA4i)*XMI(:,:,:,JP_AER_SOA4)/6.0221367E+11 - PCTOTA(:,:,:,JP_AER_SOA4,2) = PAERO(:,:,:,JP_CH_SOA4j)*XMI(:,:,:,JP_AER_SOA4)/6.0221367E+11 - PCTOTA(:,:,:,JP_AER_SOA5,1) = PAERO(:,:,:,JP_CH_SOA5i)*XMI(:,:,:,JP_AER_SOA5)/6.0221367E+11 - PCTOTA(:,:,:,JP_AER_SOA5,2) = PAERO(:,:,:,JP_CH_SOA5j)*XMI(:,:,:,JP_AER_SOA5)/6.0221367E+11 - - PCTOTA(:,:,:,JP_AER_SOA6,1) = PAERO(:,:,:,JP_CH_SOA6i)*XMI(:,:,:,JP_AER_SOA6)/6.0221367E+11 - PCTOTA(:,:,:,JP_AER_SOA6,2) = PAERO(:,:,:,JP_CH_SOA6j)*XMI(:,:,:,JP_AER_SOA6)/6.0221367E+11 - PCTOTA(:,:,:,JP_AER_SOA7,1) = PAERO(:,:,:,JP_CH_SOA7i)*XMI(:,:,:,JP_AER_SOA7)/6.0221367E+11 - PCTOTA(:,:,:,JP_AER_SOA7,2) = PAERO(:,:,:,JP_CH_SOA7j)*XMI(:,:,:,JP_AER_SOA7)/6.0221367E+11 - PCTOTA(:,:,:,JP_AER_SOA8,1) = PAERO(:,:,:,JP_CH_SOA8i)*XMI(:,:,:,JP_AER_SOA8)/6.0221367E+11 - PCTOTA(:,:,:,JP_AER_SOA8,2) = PAERO(:,:,:,JP_CH_SOA8j)*XMI(:,:,:,JP_AER_SOA8)/6.0221367E+11 - PCTOTA(:,:,:,JP_AER_SOA9,1) = PAERO(:,:,:,JP_CH_SOA9i)*XMI(:,:,:,JP_AER_SOA9)/6.0221367E+11 - PCTOTA(:,:,:,JP_AER_SOA9,2) = PAERO(:,:,:,JP_CH_SOA9j)*XMI(:,:,:,JP_AER_SOA9)/6.0221367E+11 - PCTOTA(:,:,:,JP_AER_SOA10,1) = PAERO(:,:,:,JP_CH_SOA10i)*XMI(:,:,:,JP_AER_SOA10)/6.0221367E+11 - PCTOTA(:,:,:,JP_AER_SOA10,2) = PAERO(:,:,:,JP_CH_SOA10j)*XMI(:,:,:,JP_AER_SOA10)/6.0221367E+11 -END IF - - -!* 1.1 calculate moment 3 from mass - -PM3D(:,:,:,2) = 0. -PM3D(:,:,:,5) = 0. -PCTOTA(:,:,:,:,:) = MAX(PCTOTA(:,:,:,:,:), 0.) -DO JJ = 1,NSP+NCARB+NSOA - PM3D(:,:,:,2) = PM3D(:,:,:,2)+PCTOTA(:,:,:,JJ,1)/XFAC(JJ) - PM3D(:,:,:,5) = PM3D(:,:,:,5)+PCTOTA(:,:,:,JJ,2)/XFAC(JJ) -ENDDO -! -! -! -IF ((CCONF=="START").AND.(CPROGRAM/='DIAG ')) THEN -!* 1.2 calculate moment 0 from dispersion and mean radius - PM3D(:,:,:,1)= PM3D(:,:,:,2) / & - ((ZINIRADIUSI**3)*EXP(4.5 * (LOG(XINISIGI))**2)) - - PM3D(:,:,:,4)= PM3D(:,:,:,5) / & - ((ZINIRADIUSJ**3)*EXP(4.5 * (LOG(XINISIGJ))**2)) - -!* 1.3 calculate moment 6 from dispersion and mean radius - PM3D(:,:,:,3) = PM3D(:,:,:,1) * (ZINIRADIUSI**6) *EXP(18 *(LOG(XINISIGI))**2) - PM3D(:,:,:,6) = PM3D(:,:,:,4) * (ZINIRADIUSJ**6) *EXP(18 *(LOG(XINISIGJ))**2) - -ELSE -!* 1.2 give moment 0 - PM3D(:,:,:,1)= MAX(PAERO(:,:,:,JP_CH_M0i) * 1E+6 , 0.) - PM3D(:,:,:,4)= MAX(PAERO(:,:,:,JP_CH_M0j) * 1E+6 , 0.) -! -!* 1.3 give moment 6 - -IF (LVARSIGI) THEN ! set M6 variable standard deviation - PM3D(:,:,:,3) = MAX(PAERO(:,:,:,JP_CH_M6i), XMNH_TINY) -ELSE ! fixed standard deviation - PM3D(:,:,:,3) = PM3D(:,:,:,1) & - * ( (PM3D(:,:,:,2)/PM3D(:,:,:,1))**(1./3.) & - * exp(-(3./2.)*log(XINISIGI)**2))**6 & - * exp(18.*log(XINISIGI)**2) -END IF - -IF (LVARSIGJ) THEN ! set M6 variable standard deviation - PM3D(:,:,:,6) = MAX(PAERO(:,:,:,JP_CH_M6j), XMNH_TINY) -ELSE ! fixed standard deviation - PM3D(:,:,:,6) = PM3D(:,:,:,4) & - * ( (PM3D(:,:,:,5)/PM3D(:,:,:,4))**(1./3.) & - * exp(-(3./2.)*log(XINISIGJ)**2))**6 & - * exp(18.*log(XINISIGJ)**2) -END IF - -! -! -ENDIF -! -!********************************************** -! Calcul de XRHOP3D -!********************************************** - -PRHOP3D(:,:,:,:)=0. -DO JN=1,JPMODE - ZSUM(:,:,:)=0. - DO JJ=1,NSP+NCARB+NSOA - ZSUM(:,:,:)=ZSUM(:,:,:)+PCTOTA(:,:,:,JJ,JN)/XRHOI(JJ) - ENDDO - DO JJ=1,NSP+NCARB+NSOA - ZCCTOT(:,:,:,JJ,JN)=PCTOTA(:,:,:,JJ,JN)/XRHOI(JJ)/ZSUM(:,:,:) - PRHOP3D(:,:,:,JN)=PRHOP3D(:,:,:,JN)+ZCCTOT(:,:,:,JJ,JN)*XRHOI(JJ) - ENDDO -ENDDO - - -DO JN=1,JPMODE - IF (JN .EQ. 1) THEN - - IF (LVARSIGI) THEN ! variable dispersion for mode 1 - - ZSIGMA(:,:,:)=PM3D(:,:,:,NM3(JN))**2/(PM3D(:,:,:,NM0(JN))*PM3D(:,:,:,NM6(JN))) - ZSIGMA(:,:,:)=MIN(1-1E-10,ZSIGMA(:,:,:)) - ZSIGMA(:,:,:)=MAX(1E-10,ZSIGMA(:,:,:)) - ZSIGMA(:,:,:)= LOG(ZSIGMA(:,:,:)) - ZSIGMA(:,:,:)= EXP(1./3.*SQRT(-ZSIGMA(:,:,:))) - WHERE (ZSIGMA(:,:,:) > XSIGIMAX) - ZSIGMA(:,:,:) = XSIGIMAX - END WHERE - WHERE (ZSIGMA(:,:,:) < XSIGIMIN) - ZSIGMA(:,:,:) = XSIGIMIN - END WHERE - - ELSE ! fixed dispersion for mode 1 - ZSIGMA(:,:,:) = XINISIGI - END IF - END IF - -! - IF (JN .EQ. 2) THEN - - IF (LVARSIGJ) THEN ! variable dispersion for mode 2 - - ZSIGMA(:,:,:)=PM3D(:,:,:,NM3(JN))**2/(PM3D(:,:,:,NM0(JN))*PM3D(:,:,:,NM6(JN))) - ZSIGMA(:,:,:)=MIN(1-1E-10,ZSIGMA(:,:,:)) - ZSIGMA(:,:,:)=MAX(1E-10,ZSIGMA(:,:,:)) - ZSIGMA(:,:,:)= LOG(ZSIGMA(:,:,:)) - ZSIGMA(:,:,:)= EXP(1./3.*SQRT(-ZSIGMA(:,:,:))) - WHERE (ZSIGMA(:,:,:) > XSIGJMAX) - ZSIGMA(:,:,:) = XSIGJMAX - END WHERE - WHERE (ZSIGMA(:,:,:) < XSIGJMIN) - ZSIGMA(:,:,:) = XSIGJMIN - END WHERE - - ELSE ! fixed dispersion for mode 2 - ZSIGMA(:,:,:) = XINISIGJ - END IF - END IF -! - - -!* 1.4 calculate modal parameters from moments -PSIG3D(:,:,:,JN) = ZSIGMA(:,:,:) -PN3D(:,:,:,JN) = PM3D(:,:,:,NM0(JN)) - -ZSIGMA(:,:,:)=LOG(PSIG3D(:,:,:,JN))**2 - -PRG3D(:,:,:,JN)=(PM3D(:,:,:,NM3(JN))/PN3D(:,:,:,JN))**(1./3.)*EXP(-1.5*ZSIGMA(:,:,:)) - -PM3D(:,:,:,NM6(JN))=PN3D(:,:,:,JN)*PRG3D(:,:,:,JN)**6*EXP(18.*ZSIGMA(:,:,:)) -! -ENDDO -! -! -PAERO(:,:,:,JP_CH_M0i) = PM3D(:,:,:,1) * 1E-6 -PAERO(:,:,:,JP_CH_M0j) = PM3D(:,:,:,4) * 1E-6 -IF (LVARSIGI) PAERO(:,:,:,JP_CH_M6i) = PM3D(:,:,:,3) -IF (LVARSIGJ) PAERO(:,:,:,JP_CH_M6j) = PM3D(:,:,:,6) - -! - DO JJ=1,NSV_AER - PAERO(:,:,:,JJ) = PAERO(:,:,:,JJ) / (ZDEN2MOL * PRHODREF(:,:,:)) - ENDDO - -XSEDA(:,:,:,:)=0. ! no sedimentation for the first time step - -!* 0.3 définition of minimum values -!Minimum values for gaseous (interact with aerosol phase) -XSVMIN(NSV_AERBEG:NSV_AEREND) = XMNH_TINY -XSVMIN(NSV_CHEMBEG-1+JP_CH_CO) = 1E-10 -! For i mode -ZRHODREFMIN = MAX_ll( PRHODREF(:,:,:), IINFO_ll) -ZMASS = XN0IMIN * ((ZMINRGI**3)*EXP(4.5 * (LOG(XSIGIMIN))**2)) -ZM6MIN = XN0IMIN * ((ZMINRGI**6)*EXP(18. * (LOG(XSIGIMIN))**2)) -XSVMIN(NSV_AERBEG-1+JP_CH_BCi) = 0.5*ZMASS * XFAC(JP_AER_BC) * 6.0221367E+11/(ZDEN2MOL*12.*ZRHODREFMIN) -XSVMIN(NSV_AERBEG-1+JP_CH_OCi) = 0.5*ZMASS * XFAC(JP_AER_OC) * 6.0221367E+11/(ZDEN2MOL*12.*ZRHODREFMIN) -XSVMIN(NSV_AERBEG-1+JP_CH_M0i) = XN0IMIN * 1E-6 / (ZDEN2MOL*ZRHODREFMIN) -IF (LVARSIGI) XSVMIN(NSV_AERBEG-1+JP_CH_M6i) = ZM6MIN / (ZDEN2MOL*ZRHODREFMIN) -! -! For j mode -ZMASS = XN0JMIN * ((ZMINRGJ**3)*EXP(4.5 * (LOG(XSIGJMIN))**2)) -ZM6MIN = XN0JMIN * ((ZMINRGJ**6)*EXP(18. * (LOG(XSIGJMIN))**2)) -XSVMIN(NSV_AERBEG-1+JP_CH_BCj) = 0.5*ZMASS * XFAC(JP_AER_BC) * 6.0221367E+11/(ZDEN2MOL*12.*ZRHODREFMIN) -XSVMIN(NSV_AERBEG-1+JP_CH_OCj) = 0.5*ZMASS * XFAC(JP_AER_OC) * 6.0221367E+11/(ZDEN2MOL*12.*ZRHODREFMIN) -XSVMIN(NSV_AERBEG-1+JP_CH_M0j) = XN0JMIN * 1E-6 / (ZDEN2MOL*ZRHODREFMIN) -IF (LVARSIGJ) XSVMIN(NSV_AERBEG-1+JP_CH_M6j) = ZM6MIN / (ZDEN2MOL*ZRHODREFMIN) -! -END SUBROUTINE CH_AER_EQM_INIT_n diff --git a/src/ICCARE_BASE/ch_aer_growth.f90 b/src/ICCARE_BASE/ch_aer_growth.f90 deleted file mode 100644 index 2417a53af..000000000 --- a/src/ICCARE_BASE/ch_aer_growth.f90 +++ /dev/null @@ -1,26 +0,0 @@ -!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence -!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!ORILAM_LIC for details. -!----------------------------------------------------------------- -!--------------- special set of characters for RCS information -!----------------------------------------------------------------- -! $Source$ $Revision$ -! MASDEV4_7 chimie 2006/05/18 13:07:25 -!----------------------------------------------------------------- -!! ######################### - MODULE MODI_CH_AER_GROWTH -!! ######################### -!! -!! -END MODULE MODI_CH_AER_GROWTH -!! -!! ############################################## - SUBROUTINE CH_AER_GROWTH() -!! ############################################## -!! -!! PURPOSE -!! ------- -!! -END SUBROUTINE CH_AER_GROWTH - diff --git a/src/ICCARE_BASE/ch_aer_kulmala.f90 b/src/ICCARE_BASE/ch_aer_kulmala.f90 deleted file mode 100644 index 78da267c0..000000000 --- a/src/ICCARE_BASE/ch_aer_kulmala.f90 +++ /dev/null @@ -1,178 +0,0 @@ -!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence -!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!ORILAM_LIC for details. -!----------------------------------------------------------------- -!--------------- special set of characters for RCS information -!----------------------------------------------------------------- -! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/ch_aer_nucl.f90,v $ $Revision: 1.1.4.1.18.1 $ -! MASDEV4_7 chimie 2006/05/18 13:07:25 -!----------------------------------------------------------------- -!! ################################ -MODULE MODI_CH_AER_KULMALA -!! ################################ -!! -INTERFACE - !! - SUBROUTINE CH_AER_KULMALA(PRH,PTEMP,PSULF,PJNUC,PRC) - IMPLICIT NONE - !! - REAL, DIMENSION(:), INTENT(IN) :: PRH, PTEMP, PSULF - REAL, DIMENSION(:), INTENT(INOUT) :: PJNUC, PRC - !! - END SUBROUTINE CH_AER_KULMALA - !! -END INTERFACE -! -END MODULE MODI_CH_AER_KULMALA -!! -!! ######################################################################### -SUBROUTINE CH_AER_KULMALA(PRH,PTEMP,PSULF,PJNUC,PRC) -!########################################################### -!! -!! PURPOSE -!! ------- -!! -!! Compute nucleation rate for binary sulfate/H2O -!! This is the Kulmala parametrization (1998) -!! -!! Valid for : -!! 233.15 < T < 298.15 (K) -!! 10 < RH < 100 (%) -!! 1.10¹Ⱐ< [H2SO4]gas < 3.10¹Ⱐ(molec/cm3) -!! -!! AUTHOR -!! ------ -!! B. Foucart * LACy * -!! -!! MODIFICATIONS -!! ------------- -!! B. Foucart (18/06/2018) * LACy * -!! -!---------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_CH_AEROSOL -USE MODD_CST, ONLY : XAVOGADRO -! -IMPLICIT NONE -! -!* 0.1 Declarations of dummy arguments : -! -REAL, DIMENSION(:), INTENT(IN) :: PRH, PTEMP ! Relative humidity (%), Temp (kelvin) -REAL, DIMENSION(:), INTENT(IN) :: PSULF ! Available acid mass (ug./m3) -REAL, DIMENSION(:), INTENT(INOUT) :: PJNUC ! Nucleation rate (#/cm3/s) -REAL, DIMENSION(:), INTENT(INOUT) :: PRC ! Rayon du cluster critique en nm définit pour ch_aer_nucl -INTEGER :: II -! -!* 0.2 Declarations of local variables : -! -REAL, DIMENSION(SIZE(PSULF,1)) :: ZSULF ! Sulfuric acid concentration (molec/cm3) -REAL, DIMENSION(SIZE(PSULF,1)) :: ZAL ! Mole fraction of H2SO4 in the critical cluster -REAL, DIMENSION(SIZE(PSULF,1)) :: ZRA ! Relative acidity -REAL, DIMENSION(SIZE(PSULF,1)) :: ZH2O ! Water concentration (molec/cm3) -REAL, DIMENSION(SIZE(PSULF,1)) :: ZPVH2O ! Saturation vapor pressure for water (N/m2, T in K) -REAL, DIMENSION(SIZE(PSULF,1)) :: ZPVH2SO4 ! Saturation vapor pressure for sulfuric acid (N/m2, T in K) -REAL, DIMENSION(SIZE(PSULF,1)) :: ZKHI,ZSIG,ZNSULFC,ZNSULF ! Terms for nucleation rate calculation -! -REAL, PARAMETER :: ZKB=1.381E-23 ! Boltzman cste (m2 kg s-2 K-1) -! -PJNUC(:)=0. -ZAL(:)=1E-5 -ZRA(:)=0. -ZSULF(:)=0. -ZPVH2SO4(:)=0. -ZH2O(:)=0. -ZRA(:)=0. -ZSIG(:)=0. -ZNSULFC(:)=0. -ZKHI(:)=0. -! -! a. Sulfuric acid concentration definition: ZSULF from ug/m3 to molec/cm3 -! -ZSULF(:) = PSULF(:) -ZSULF(:) = ZSULF(:)*(XAVOGADRO*1.E-12) / XH2SO4 -! -! b. Conditions on sulfuric acid concentration to use Kulmala -! - ZSULF(:) = MAX(MIN(ZSULF(:), 3.E11), 0.) -! -! c. Restrictions for parametrization -! - WHERE(((PTEMP(:)>=223.).OR.(PTEMP(:)<=298)).AND.(PRH(:)>=0.1)) - ! - ! 1. Saturation vapor pressure for H2SO4 over a flat surface (N/m-2, T in K) - ! - ! a. Ayers et al., 1980 - ! - ZPVH2SO4(:)=EXP(27.78492066-10156.0/PTEMP(:)) - ! - ! b. Kulmala and Laaksonen., 1990 - ! - ! ZPVH2SO4(:)=EXP(-10156./ZT0+16.259+10156.*(-1./PTGAS(:)+1./ZT0+0.38/(ZTC-ZT0)*& - ! (1.+LOG(ZT0/PTGAS(:))-ZT0/PTGAS(:))))*101325. - ! - ! c. Noppel et al., 2002 - ! - ! ZPVH2SO4(:)=EXP(-11.94+10156*((1/360.15)-(1/PTGAS(:))+(0.38/545)*& - ! (1+LOG((360.15/PTGAS(:))-(360.15/PTGAS(:)))))) - ! - ! 2. Saturation vapor pressure for water over a flat surface (N/m2, T in K) - ! (Preining et al, 1981) - ! - ZPVH2O(:) = EXP(77.344913-7235.4247/PTEMP(:)-8.2*LOG(PTEMP(:))+0.0057113*PTEMP(:)) - ! - ! 3. Water concentration (molec/cm3) - ! - ZH2O(:) = PRH(:)*ZPVH2O(:)/(ZKB*PTEMP(:))/1.E6 - ! - ! 4. Relative Acidity - ! - ZRA(:)=ZSULF(:)*1.E6*(ZKB*PTEMP(:))/ZPVH2SO4(:) - ! - END WHERE -! -! 5. H2SO4 mole fraction in the critical nucleous (no unity) -! - WHERE ((ZSULF(:)>0.).AND.(ZH2O(:)>0.).AND.(ZRA(:)/=0.)) - ! - ZAL(:)=1.2233-(0.0154*ZRA(:))/(ZRA(:)+PRH(:))+0.0102*& ! (eq 17) - LOG(ZSULF(:))-0.0415*LOG(ZH2O(:))+0.0016*PTEMP(:) - ! - END WHERE -! - WHERE (((PTEMP(:)>=223.).OR.(PTEMP(:)<=298)).AND.(PRH(:)>=0.1).AND.ZAL(:)>1E-5) - ! - ! 6. Sulfuric nucleation rate (molec/cm3/s) - ! - ! a. Sulfuric acid vapor needed to produce jnuc = 1 cm-3.s-1 - ! - ZNSULFC(:)=EXP(-14.5125+0.1335*PTEMP(:)-10.5462*PRH(:)+1958.4*PRH(:)/PTEMP(:)) ! (eq 18) - ! - ! b. Sigma term - ! - ZSIG(:) = 1.+(PTEMP(:)-273.15)/273.15 ! (eq 22) - ! - ! c. Sulfuric acid vapor ratio term - ! - ZNSULF(:)=LOG(ZSULF(:)/ZNSULFC(:)) ! (eq 21) - ! - ! - ! d. Exponential term - ! - ZKHI(:)=25.1289*ZNSULF(:)-4890.8*ZNSULF(:)/PTEMP(:)-1743.3/PTEMP(:)-2.2479*ZSIG(:)*ZNSULF(:)*PRH(:)+& - 7643.4*ZAL(:)/PTEMP(:)-1.9712*ZAL(:)*ZSIG(:)/PRH(:) ! (eq 20) - ! - ! e. Nucleation rate - ! - PJNUC(:)=EXP(ZKHI(:)) ! (eq 19) - ! - END WHERE -! -PRC(:) = 0.5 ! The critical radius (nm) calculation is not given in Kulmala so we fix the values as 0.5 -! -RETURN -! -END SUBROUTINE CH_AER_KULMALA diff --git a/src/ICCARE_BASE/ch_aer_maattanen_ionind.f90 b/src/ICCARE_BASE/ch_aer_maattanen_ionind.f90 deleted file mode 100644 index f29afa3c4..000000000 --- a/src/ICCARE_BASE/ch_aer_maattanen_ionind.f90 +++ /dev/null @@ -1,644 +0,0 @@ -!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence -!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!ORILAM_LIC for details. -!----------------------------------------------------------------- -!--------------- special set of characters for RCS information -!----------------------------------------------------------------- -! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/ch_aer_nucl.f90,v $ $Revision: 1.1.4.1.18.1 $ -! MASDEV4_7 chimie 2006/05/18 13:07:25 -!----------------------------------------------------------------- -!! ################################ -MODULE MODI_CH_AER_MAATTANEN_IONIND -!! ################################ -!! -INTERFACE - !! - SUBROUTINE CH_AER_MAATTANEN_IONIND(PRH,PTEMP,PSULF,PJNUCI,PRCI) - IMPLICIT NONE - !! - REAL, DIMENSION(:), INTENT(IN) :: PRH,PTEMP,PSULF - REAL, DIMENSION(:), INTENT(INOUT) :: PJNUCI, PRCI - !! - !! - END SUBROUTINE CH_AER_MAATTANEN_IONIND - !! -END INTERFACE -!! -END MODULE MODI_CH_AER_MAATTANEN_IONIND -!! -!! ######################################################################### -SUBROUTINE CH_AER_MAATTANEN_IONIND(PRH,PTEMP,PSULF,PJNUCI,PRCI) -!########################################################### -! -!! -!! PURPOSE -!! ------- -!! -!! Compute nucleation rate for binary H2SO4/H2O -!! This is the Määttänen parametrization (2018) -!! This is the ion-induced particle formation part -!! -!! Valid for : -!! 195 < T < 400 (K) -!! 10â»âµ < RH < 100 (%) -!! 10â´ < [H2SO4]gas < 10¹ⶠ(molec/cm3) -!! -!! -!! AUTHOR -!! ------ -!! B. Foucart * LACy * -!! -!! MODIFICATIONS -!! ------------- -!! B. Foucart (18/06/2018) * LACy * -!! -!---------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_CST, ONLY : XAVOGADRO -USE MODD_CONF, ONLY : NVERB -USE MODD_CH_AEROSOL -! -IMPLICIT NONE -! -!* 0.1 Declarations of dummy arguments : -! -REAL, DIMENSION(:), INTENT(IN) :: PRH, PTEMP, PSULF ! Relative humidity (%), Temp (kelvin) -REAL, DIMENSION(:), INTENT(INOUT) :: PJNUCI, PRCI ! Nucleation rate (#/cm3/s) , Critical cluster radius (nm) -! -!* 0.2 Declarations of local variables : -! -REAL, DIMENSION(SIZE(PSULF,1)) :: ZSULF ! Sulfuric acid concentration (molec/cm3) -REAL, DIMENSION(SIZE(PSULF,1)) :: ZAL ! Mole fraction of H2SO4 in the critical cluster -REAL, DIMENSION(SIZE(PSULF,1)) :: ZNTOTI ! Total number of molec in the critical cluster -REAL, DIMENSION(SIZE(PSULF,1)) :: ZKINTRI ! Threshold sulfuric acid for charged kinetic nucleation -REAL, DIMENSION(SIZE(PSULF,1)) :: ZNACI ! Sulfuric acid molecules in the charged critical cluster -REAL, DIMENSION(SIZE(PSULF,1)) :: ZIPR ! Ion pair production rate (cm-3 .s-1) -REAL, DIMENSION(SIZE(PSULF,1)) :: ZXLOSS ! Ion loss rate -REAL, DIMENSION(SIZE(PSULF,1)) :: ZCSI ! Ion condensation sink (s-1) -REAL, DIMENSION(SIZE(PSULF,1)) :: ZAIRN ! Air molecule concentration in (cm-3) -REAL, DIMENSION(SIZE(PSULF,1)) :: ZRECOMB ! Ion-ion recombination rate -REAL, DIMENSION(SIZE(PSULF,1)) :: ZNIPAIR ! Number of ion pairs in air (cm-3) -! -LOGICAL :: GKINETICI ! True if kinetic neutral nucleation -! -INTEGER :: II, ITEST ! Tests -! -IF (NVERB .GE. 10) WRITE(*,*) '~~~~ CH_AER_MAATT_ION : PSULF =',MINVAL(PSULF), MAXVAL(PSULF) -IF (NVERB .GE. 10) WRITE(*,*) '~~~~ CH_AER_MAATT_ION : (XAVOGADRO*1.E-12) =',(XAVOGADRO*1.E-12) -IF (NVERB .GE. 10) WRITE(*,*) '~~~~ CH_AER_MAATT_ION : XH2SO4=', XH2SO4 -IF (NVERB .GE. 10) WRITE(*,*) '~~~~ CH_AER_MAATT_ION : PTEMP =',MINVAL(PTEMP), MAXVAL(PTEMP) -IF (NVERB .GE. 10) WRITE(*,*) '~~~~ CH_AER_MAATT_ION : PRH =',MINVAL(PRH), MAXVAL(PRH) -! -!---------------------------------------------------------------------------- -! -! Parameters initialization -! -ZAL(:) = 0.17 ! must vary between 0 and 1 -PJNUCI(:) = 1E-7 ! must vary between 10E-7 and 10E10 cm3.s-1 -PRCI(:) = 2.8E-10 ! (meters) must vary between 0.28 and 1.2 nm -ZNACI(:) = 0. -ZNTOTI(:) = 10. ! must vary between 1 and 200 molecules -ZKINTRI(:) = 0. -ZIPR(:) = 20. -GKINETICI = .FALSE. ! Logical: if kinetic ion-induced nucleation (FALSE by default) -ZCSI(:) = 1.0/480. ! Inverse lifetime of ions -! -! a. Air molecule concentration calculation -! -ZAIRN(:) = 6.023E23 * 1.013E5 / 8.31 / PTEMP(:) / 1.E6 ! Air molecule concentration in (cm-3) -! -! b. Sulfuric acid concentration definition: ZSULF from ug/m3 to molec/cm3 -! -ZSULF(:) = PSULF(:)*(XAVOGADRO*1.E-12) / XH2SO4 -! -! c. Restrictions for parametrization -! -ITEST = 0. -! -DO II = 1, SIZE(PSULF,1) - IF ((PRH(II) > 1E-5).AND.(PTEMP(II)>195.).AND.(ZSULF(II)>1E4)) THEN - ITEST = ITEST+1 - END IF -END DO -! -IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_ION (deb): ZSULF',MINVAL(ZSULF(:)), MAXVAL(ZSULF(:)) -IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_ION (deb): PSULF',MINVAL(PSULF(:)), MAXVAL(PSULF(:)) - -! - -DO II = 1, SIZE(PSULF,1) - ! - IF ((PRH(II) > 1E-5).AND.(PTEMP(II)>195.).AND.(ZSULF(II)>1E4)) THEN - ! - ! 1. Mole fraction of H2SO4 in the critical cluster (eq 1): composition - ! - ZAL(II) = 7.9036365428891719E-1-2.8414059650092153E-3*PTEMP(II)+& - 1.4976802556584141E-2*LOG(PRH(II))-2.4511581740839115E-4*PTEMP(II)*LOG(PRH(II))+& - 3.4319869471066424E-3*(LOG(PRH(II)))**2-2.8799393617748428E-5*PTEMP(II)*(LOG(PRH(II)))**2+& - 3.0174314126331765E-4*(LOG(PRH(II)))**3-2.2673492408841294E-6*PTEMP(II)*(LOG(PRH(II)))**3-& - 4.3948464567032377E-3*LOG(ZSULF(II))+5.3305314722492146E-5*PTEMP(II)*LOG(ZSULF(II)) - ! - IF (ZIPR(II).GT.0.0) THEN ! if the ion production rate is above zero - ! - ! Calculate the ion induced nucleation rate wrt. concentration of 1 ion/cm3 - ! - ZKINTRI(II) = 5.3742280876674478e1 - & - & 6.6837931590012266e-3 *log(PRH(II))**(-2) & - & - 1.0142598385422842e-01 * log(PRH(II))**(-1) - & - & 6.4170597272606873e+00 * log(PRH(II)) & - & - 6.4315798914824518e-01 * log(PRH(II))**2 - & - & 2.4428391714772721e-02 * log(PRH(II))**3 & - & - 3.5356658734539019e-04 * log(PRH(II))**4 + & - & 2.5400015099140506e-05 * PTEMP(II) * log(PRH(II))**(-2) & - & - 2.7928900816637790e-04 * PTEMP(II) * log(PRH(II))**(-1) + & - & 4.4108573484923690e-02 * PTEMP(II) * log(PRH(II)) & - & + 6.3943789012475532e-03 * PTEMP(II) * log(PRH(II))**(2) + & - & 2.3164296174966580e-04 * PTEMP(II) * log(PRH(II))**(3) & - & + 3.0372070669934950e-06 * PTEMP(II) * log(PRH(II))**4 + & - & 3.8255873977423475e-06 * PTEMP(II)**2 * log(PRH(II))**(-1) & - & - 1.2344793083561629e-04 * PTEMP(II)**2 * log(PRH(II)) - & - & 1.7959048869810192e-05 * PTEMP(II)**2 * log(PRH(II))**(2) & - & - 3.2165622558722767e-07 * PTEMP(II)**2 * log(PRH(II))**3 - & - & 4.7136923780988659e-09 * PTEMP(II)**3 * log(PRH(II))**(-1) & - & + 1.1873317184482216e-07 * PTEMP(II)**3 * log(PRH(II)) + & - & 1.5685860354866621e-08 * PTEMP(II)**3 * log(PRH(II))**2 & - & - 1.4329645891059557e+04 * PTEMP(II)**(-1) + & - & 1.3842599842575321e-01 * PTEMP(II) & - & - 4.1376265912842938e-04 * PTEMP(II)**(2) + & - & 3.9147639775826004e-07 * PTEMP(II)**3 - ! - ZKINTRI(II)=exp(ZKINTRI(II)) !1/cm3 - ! - IF( ZKINTRI(II).LT.ZSULF(II)) GKINETICI=.TRUE. - ! - IF (GKINETICI) THEN - ! - ! - PJNUCI(II) = 1.0E6 * (0.3E-9 + 0.487E-9)**2. * sqrt(8. * 3.141593*1.38E-23 * & - & (1. / (1.661e-27 * 98.07)+1. / (1.661e-27*98.07))) * & - & sqrt(PTEMP(II))*ZSULF(II) !1/cm3s - ! - ZNTOTI(II) = 1. !set to 1 - ! - ZNACI(II) = 1. - ! - ZAL(II) = ZNACI(II) / ZNTOTI(II) ! so also set this to 1 - ! - PRCI(II) = 0.487E-9 - ! - ELSE - ! - PJNUCI(II) = 3.0108954259038608e+01 + PTEMP(II) * & - 6.1176722090512577e+01 + PTEMP(II)**2 * & - 8.7240333618891663e-01 + PTEMP(II)**3* & - (-4.6191788649375719e-03) + PTEMP(II)**(-1) * & - 8.3537059107024481e-01 - PJNUCI(II) = PJNUCI(II) + & - (1.5028549216690628e+01 + PTEMP(II) * & - (-1.9310989753720623e-01) + PTEMP(II)**2 * & - 8.0155514634860480e-04 + PTEMP(II)**3 * & - (-1.0832730707799128e-06) + PTEMP(II)**(-1) * & - 1.7577660457989019) * (LOG(PRH(II))**(-2)) - PJNUCI(II) = PJNUCI(II) + & - (-2.0487870170216488e-01 + PTEMP(II) * & - 1.3263949252910405e-03 + PTEMP(II)**2 * & - (-8.4195688402450274e-06) + PTEMP(II)**3 * & - 1.6154895940993287e-08 + PTEMP(II)**(-1) * & - 3.8734212545203874e+01) * (LOG(PRH(II))**(-2) * LOG(ZSULF(II))) - PJNUCI(II) = PJNUCI(II) + & - (1.4955918863858371 + PTEMP(II) * & - 9.2290004245522454e+01 + PTEMP(II)**2 * & - (-8.9006965195392618e-01) + PTEMP(II)**3 * & - 2.2319123411013099e-03 + PTEMP(II)**(-1) * & - 4.0180079996840852e-03) * (LOG(PRH(II))**(-1) * LOG(ZSULF(II))**(-1)) - PJNUCI(II) = PJNUCI(II) + & - (7.9018031228561085 + PTEMP(II) * & - (-1.1649433968658949e+01) + PTEMP(II)**2 * & - 1.1400827854910951e-01 + PTEMP(II)**3 * & - (-3.1941526492127755e-04) + PTEMP(II)**(-1) * & - (-3.7662115740271446e-01)) * (LOG(PRH(II))**(-1)) - PJNUCI(II) = PJNUCI(II) + & - (1.5725237111225979e+02 + PTEMP(II) * & - (-1.0051649979836277) + PTEMP(II)**2 * & - 1.1866484014507624e-03 + PTEMP(II)**3 * & - 7.3557614998540389e-06 + PTEMP(II)**(-1) * & - 2.6270197023115189) * (LOG(PRH(II))**(-1) * LOG(ZSULF(II))) - PJNUCI(II) = PJNUCI(II) + & - (-1.6973840122470968e+01 + PTEMP(II) * & - 1.1258423691432135e-01 + PTEMP(II)**2 * & - (-2.9850139351463793e-04) + PTEMP(II)**3 * & - 1.4301286324827064e-07 + PTEMP(II)**(-1) * & - 1.3163389235253725e+01) * (LOG(PRH(II))**(-1) * LOG(ZSULF(II))**2) - PJNUCI(II) = PJNUCI(II) + & - (-1.0399591631839757 + PTEMP(II) * & - 2.7022055588257691e-03 + PTEMP(II)**2 * & - (-2.1507467231330936e-06) + PTEMP(II)**3 * & - 3.8059489037584171e-10 + PTEMP(II)**(-1) * & - 1.5000492788553410e+02) * (LOG(PRH(II))**(-1) * LOG(ZSULF(II))**3) - PJNUCI(II) = PJNUCI(II) + & - (1.2250990965305315 + PTEMP(II) * & - 3.0495946490079444e+01 + PTEMP(II)**2 * & - 2.1051563135187106e+01 + PTEMP(II)**3 * & - (-8.2200682916580878e-02) + PTEMP(II)**(-1) * & - 2.9965871386685029e-02) * (LOG(ZSULF(II))**(-2)) - PJNUCI(II) = PJNUCI(II) + & - (4.8281605955680433 + PTEMP(II) * & - 1.7346551710836445e+02 + PTEMP(II)**2 * & - (-1.0113602140796010e+01) + PTEMP(II)**3 * & - 3.7482518458685089e-02 + PTEMP(II)**(-1) * & - (-1.4449998158558205e-01)) * (LOG(ZSULF(II))**(-1)) - PJNUCI(II) = PJNUCI(II) + & - (2.3399230964451237e+02 + PTEMP(II) * & - (-2.3099267235261948e+01) + PTEMP(II)**2 * & - 8.0122962140916354e-02 + PTEMP(II)**3 * & - 6.1542576994557088e-05 + PTEMP(II)**(-1) * & - 5.3718413254843007) * (LOG(ZSULF(II))) - PJNUCI(II) = PJNUCI(II) + & - (1.0299715519499360e+02 + PTEMP(II) * & - (-6.4663357203364136e-02) + PTEMP(II)**2 * & - (-2.0487150565050316e-03) + PTEMP(II)**3 * & - 8.7935289055530897e-07 + PTEMP(II)**(-1) * & - 3.6013204601215229e+01) * (LOG(ZSULF(II))**2) - PJNUCI(II) = PJNUCI(II) + & - (-3.5452115439584042 + PTEMP(II) * & - 1.7083445731159330e-02 + PTEMP(II)**2 * & - (-1.2552625290862626e-05) + PTEMP(II)**3 * & - 1.2968447449182847e-09 + PTEMP(II)**(-1) * & - 1.5748687512056560e+02) * (LOG(ZSULF(II))**3) - PJNUCI(II) = PJNUCI(II) + & - (2.2338490119517975 + PTEMP(II) * & - 1.0229410216045540e+02 + PTEMP(II)**2 * & - (-3.2103611955174052) + PTEMP(II)**3 * & - 1.3397152304977591e-02 + PTEMP(II)**(-1) * & - (-2.4155187776460030e-02)) * (LOG(PRH(II))* LOG(ZSULF(II))**(-2)) - PJNUCI(II) = PJNUCI(II) + & - (3.7592282990713963 + PTEMP(II) * & - (-1.5257988769009816e+02) + PTEMP(II)**2 * & - 2.6113805420558802 + PTEMP(II)**3 * & - (-9.0380721653694363e-03) + PTEMP(II)**(-1) * & - (-1.3974197138171082e-01)) * (LOG(PRH(II))* LOG(ZSULF(II))**(-1)) - PJNUCI(II) = PJNUCI(II) + & - (1.8293600730573988e+01 + PTEMP(II) * & - 1.8344728606002992e+01 + PTEMP(II)**2 * & - (-4.0063363221106751e-01) + PTEMP(II)**3 * & - 1.4842749371258522e-03 + PTEMP(II)**(-1) * & - 1.1848846003282287) * (LOG(PRH(II))) - PJNUCI(II) = PJNUCI(II) + & - (-1.7634531623032314e+02 + PTEMP(II) * & - 4.9011762441271278 + PTEMP(II)**2 * & - (-1.3195821562746339e-02) + PTEMP(II)**3 * & - (-2.8668619526430859e-05) + PTEMP(II)**(-1) * & - (-2.9823396976393551e-01)) * (LOG(PRH(II))* LOG(ZSULF(II))) - PJNUCI(II) = PJNUCI(II) + & - (-3.2944043694275727e+01 + PTEMP(II) * & - 1.2517571921051887e-01 + PTEMP(II)**2 * & - 8.3239769771186714e-05 + PTEMP(II)**3 * & - 2.8191859341519507e-07 + PTEMP(II)**(-1) * & - (-2.7352880736682319e+01)) * (LOG(PRH(II))* LOG(ZSULF(II))**2) - PJNUCI(II) = PJNUCI(II) + & - (-1.1451811137553243 + PTEMP(II) * & - 2.0625997485732494e-03 + PTEMP(II)**2 * & - (-3.4225389469233624e-06) + PTEMP(II)**3 * & - 4.4437613496984567e-10 + PTEMP(II)**(-1) * & - 1.8666644332606754e+02) * (LOG(PRH(II))* LOG(ZSULF(II))**3) - PJNUCI(II) = PJNUCI(II) + & - (3.2270897099493567e+01 + PTEMP(II) * & - 7.7898447327513687e-01 + PTEMP(II)**2 * & - (-6.5662738484679626e-03) + PTEMP(II)**3 * & - 3.7899330796456790e-06 + PTEMP(II)**(-1) * & - 7.1106427501756542e-01) * (LOG(PRH(II))**2 * LOG(ZSULF(II))**(-1)) - PJNUCI(II) = PJNUCI(II) + & - (-2.8901906781697811e+01 + PTEMP(II) * & - (-1.5356398793054860) + PTEMP(II)**2 * & - 1.9267271774384788e-02 + PTEMP(II)**3 * & - (-5.3886270475516162e-05) + PTEMP(II)**(-1) * & - 5.0490415975693426e-01) * (LOG(PRH(II))**2) - PJNUCI(II) = PJNUCI(II) + & - (3.3365683645733924e+01 + PTEMP(II) * & - (-3.6114561564894537e-01) + PTEMP(II)**2 * & - 9.2977354471929262e-04 + PTEMP(II)**3 * & - 1.9549769069511355e-07 + PTEMP(II)**(-1) * & - (-8.8865930095112855)) * (LOG(PRH(II))**2 * LOG(ZSULF(II))) - PJNUCI(II) = PJNUCI(II) + & - (2.4592563042806375 + PTEMP(II) * & - (-8.3227071743101084e-03) + PTEMP(II)**2 * & - 8.2563338043447783e-06 + PTEMP(II)**3 * & - (-8.4374976698593496e-09) + PTEMP(II)**(-1) * & - (-2.0938173949893473e+02)) * (LOG(PRH(II))**2 * LOG(ZSULF(II))**2) - PJNUCI(II) = PJNUCI(II) + & - (4.4099823444352317e+01 + PTEMP(II) * & - 2.5915665826835252 + PTEMP(II)**2 * & - (-1.6449091819482634e-02) + PTEMP(II)**3 * & - 2.6797249816144721e-05 + PTEMP(II)**(-1) * & - 5.5045672663909995e-01) * PRH(II) - ! - PJNUCI(II) = EXP(PJNUCI(II)) - ! - ZNTOTI(II) = (-4.8324296064013375e+04 + PTEMP(II) * & - 5.0469120697428906e+02 + PTEMP(II)**2 * & - (-1.1528940488496042e+00) + PTEMP(II)**(-1) * & - (-8.6892744676239192e+02) + (PTEMP(II)**(3)) * & - 4.0030302028120469e-04) - ZNTOTI(II) = ZNTOTI(II) + & - (-6.7259105232039847e+03 + PTEMP(II) * & - 1.9197488157452008e+02 + PTEMP(II)**2 * & - (-1.3602976930126354e+00) + PTEMP(II)**(-1) * & - (-1.1212637938360332e+02) + (PTEMP(II)**(3)) * & - 2.8515597265933207e-03) * LOG(PRH(II))**(-2) * LOG(ZSULF(II))**(-2) - ZNTOTI(II) = ZNTOTI(II) + & - (2.6216455217763342e+02 + PTEMP(II) * & - (-2.3687553252750821e+00) + PTEMP(II)**2 * & - 7.4074554767517521e-03 + PTEMP(II)**(-1) * & - (-1.9213956820114927e+03) + (PTEMP(II)**(3)) * & - (-9.3839114856129453e-06)) * LOG(PRH(II))**(-2) - ZNTOTI(II) = ZNTOTI(II) + & - (3.9652478944137344e+00 + PTEMP(II) * & - 1.2469375098256536e-02 + PTEMP(II)**2 * & - (-9.9837754694045633e-05) + PTEMP(II)**(-1) * & - (-5.1919499210175138e+02) + (PTEMP(II)**(3)) * & - 1.6489001324583862e-07) * LOG(PRH(II))**(-2) * LOG(ZSULF(II)) - ZNTOTI(II) = ZNTOTI(II) + & - (2.4975714429096206e+02 + PTEMP(II) * & - 1.7107594562445172e+02 + PTEMP(II)**2 * & - (-7.8988711365135289e-01) + PTEMP(II)**(-1) * & - (-2.2243599782483177e+01) + (PTEMP(II)**(3)) * & - (-1.6291523004095427e-04)) * LOG(PRH(II))**(-1) * LOG(ZSULF(II))**(-2) - ZNTOTI(II) = ZNTOTI(II) + & - (-8.9270715592533611e+02 + PTEMP(II) * & - 1.2053538883338946e+02 + PTEMP(II)**2 * & - (-1.5490408828541018e+00) + PTEMP(II)**(-1) * & - (-1.1243275579419826e+01) + (PTEMP(II)**(3)) * & - 4.8053105606904655e-03) * LOG(PRH(II))**(-1) * LOG(ZSULF(II))**(-1) - ZNTOTI(II) = ZNTOTI(II) + & - (7.6426441642091631e+03 + PTEMP(II) * & - (-7.1785462414656578e+01) + PTEMP(II)**2 * & - 2.3851864923199523e-01 + PTEMP(II)**(-1) * & - 8.5591775688708395e+01 + (PTEMP(II)**(3)) * & - (-3.7000473243342858e-04)) * LOG(PRH(II))**(-1) - ZNTOTI(II) = ZNTOTI(II) + & - (-5.1516826398607911e+01 + PTEMP(II) * & - 9.1385720811460558e-01 + PTEMP(II)**2 * & - (-3.5477100262158974e-03) + PTEMP(II)**(-1) * & - 2.7545544507625586e+03 + (PTEMP(II)**(3)) * & - 5.4708262093640928e-06) * LOG(PRH(II))**(-1) * LOG(ZSULF(II)) - ZNTOTI(II) = ZNTOTI(II) + & - (-3.0386767129196176e+02 + PTEMP(II) * & - (-1.1033438883583569e+04) + PTEMP(II)**2 * & - 8.1296859732896067e+01 + PTEMP(II)**(-1) * & - 1.2625883141097162e+01 + (PTEMP(II)**(3)) * & - (-1.2728497822219101e-01)) * LOG(ZSULF(II))**(-2) - ZNTOTI(II) = ZNTOTI(II) + & - (-3.3763494256461472e+03 + PTEMP(II) * & - 3.1916579136391006e+03 + PTEMP(II)**2 * & - (-2.7234339474441143e+01) + PTEMP(II)**(-1) * & - (-2.1897653262707397e+01) + (PTEMP(II)**(3)) * & - 5.1788505812259071e-02) * LOG(ZSULF(II))**(-1) - ZNTOTI(II) = ZNTOTI(II) + & - (-1.8817843873687068e+03 + PTEMP(II) * & - 4.3038072285882070e+00 + PTEMP(II)**2 * & - 6.6244087689671860e-03 + PTEMP(II)**(-1) * & - (-2.7133073605696295e+03) + (PTEMP(II)**(3)) * & - (-1.7951557394285043e-05)) * LOG(ZSULF(II)) - ZNTOTI(II) = ZNTOTI(II) + & - (-1.7668827539244447e+02 + PTEMP(II) * & - 4.8160932330629913e-01 + PTEMP(II)**2 * & - (-6.3133007671100293e-04) + PTEMP(II)**(-1) * & - 2.5631774669873157e+04 + (PTEMP(II)**(3)) * & - 4.1534484127873519e-07) * LOG(ZSULF(II))**(2) - ZNTOTI(II) = ZNTOTI(II) + & - (-1.6661835889222382e+03 + PTEMP(II) * & - 1.3708900504682877e+03 + PTEMP(II)**2 * & - (-1.7919060052198969e+01) + PTEMP(II)**(-1) * & - (-3.5145029804436405e+01) + (PTEMP(II)**(3)) * & - 5.1047240947371224e-02) * LOG(PRH(II))* LOG(ZSULF(II))**(-2) - ZNTOTI(II) = ZNTOTI(II) + & - (1.0843549363030939e+04 + PTEMP(II) * & - (-7.3557073636139577e+01) + PTEMP(II)**2 * & - 1.2054625131778862e+00 + PTEMP(II)**(-1) * & - 1.9358737917864391e+02 + (PTEMP(II)**(3)) * & - (-4.2871620775911338e-03)) * LOG(PRH(II))* LOG(ZSULF(II))**(-1) - ZNTOTI(II) = ZNTOTI(II) + & - (-2.4269802549752835e+03 + PTEMP(II) * & - 1.1348265061941714e+01 + PTEMP(II)**2 * & - (-5.0430423939495157e-02) + PTEMP(II)**(-1) * & - 2.3709874548950634e+03 + (PTEMP(II)**(3)) * & - 1.4091851828620244e-04) * LOG(PRH(II)) - ZNTOTI(II) = ZNTOTI(II) + & - (5.2745372575251588e+02 + PTEMP(II) * & - (-2.6080675912627314e+00) + PTEMP(II)**2 * & - 5.6902218056670145e-03 + PTEMP(II)**(-1) * & - (-3.2149319482897838e+04) + (PTEMP(II)**(3)) * & - (-5.4121996056745853e-06)) * LOG(PRH(II))* LOG(ZSULF(II)) - ZNTOTI(II) = ZNTOTI(II) + & - (-1.6401959518360403e+01 + PTEMP(II) * & - 2.4322962162439640e-01 + PTEMP(II)**2 * & - 1.1744366627725344e-03 + PTEMP(II)**(-1) * & - (-8.2694427518413195e+03) + (PTEMP(II)**(3)) * & - (-5.0028379203873102e-06)) * LOG(PRH(II))**(2) - ZNTOTI(II) = ZNTOTI(II) + & - (-2.7556572017167782e+03 + PTEMP(II) * & - 4.9293344495058264e+01 + PTEMP(II)**2 * & - (-2.6503456520676050e-01) + PTEMP(II)**(-1) * & - 1.2130698030982167e+03 + (PTEMP(II)**(3)) * & - 4.3530610668042957e-04) * LOG(PRH(II))**2 * LOG(ZSULF(II))**(-1) - ZNTOTI(II) = ZNTOTI(II) + & - (-6.3419182228959192e+00 + PTEMP(II) * & - 4.0636212834605827e-02 + PTEMP(II)**2 * & - (-1.0450112687842742e-04) + PTEMP(II)**(-1) * & - 3.1035882189759656e+02 +(PTEMP(II)**(3)) * & - 9.4328418657873500e-08) * LOG(PRH(II))**(-3) - ZNTOTI(II) = ZNTOTI(II) + & - (3.0189213304689042e+03 + PTEMP(II) * & - (-2.3804654203861684e+01) + PTEMP(II)**2 * & - 6.8113013411972942e-02 + PTEMP(II)**(-1) * & - 6.3112071081188913e+02 + (PTEMP(II)**(3)) * & - (-9.4460854261685723e-05)) * (PRH(II)) * LOG(ZSULF(II)) - ZNTOTI(II) = ZNTOTI(II) + & - (1.1924791930673702e+04 + PTEMP(II) * & - (-1.1973824959206000e+02) + PTEMP(II)**2 * & - 1.6888713097971020e-01 + PTEMP(II)**(-1) * & - 1.8735938211539585e+02 + (PTEMP(II)**(3)) * & - 5.0974564680442852e-04) * (PRH(II)) - ZNTOTI(II) = ZNTOTI(II) + & - (3.6409071302482083e+01 + PTEMP(II) * & - 1.7919859306449623e-01 + PTEMP(II)**2 * & - (-1.0020116255895206e-03) + PTEMP(II)**(-1) * & - (-8.3521083354432303e+03) + (PTEMP(II)**(3)) * & - 1.5879900546795635e-06) * PRH(II) * LOG(ZSULF(II))**(2) - ! - ZNTOTI(II) = abs(ZNTOTI(II)) - ! - PRCI(II) = (-3.6318550637865524e-08 + PTEMP(II) * & - 2.1740704135789128e-09 + PTEMP(II)**2 * & - (-8.5521429066506161e-12) + PTEMP(II)**3 * & - (-9.3538647454573390e-15)) - PRCI(II) = PRCI(II) + & - (2.1366936839394922e-08 + PTEMP(II) * & - (-2.4087168827395623e-10) + PTEMP(II)**2 * & - 8.7969869277074319e-13 + PTEMP(II)**3 * & - (-1.0294466881303291e-15)) * LOG(PRH(II))**(-2) * LOG(ZSULF(II))**(-1) - PRCI(II) = PRCI(II) + & - (-7.7804007761164303e-10 + PTEMP(II) * & - 1.0327058173517932e-11 + PTEMP(II)**2 * & - (-4.2557697639692428e-14) + PTEMP(II)**3 * & - 5.4082507061618662e-17) * LOG(PRH(II))**(-2) - PRCI(II) = PRCI(II) + & - (3.2628927397420860e-12 + PTEMP(II) * & - (-7.6475692919751066e-14) + PTEMP(II)**2 * & - 4.1985816845259788e-16 + PTEMP(II)**3 * & - (-6.2281395889592719e-19)) * LOG(PRH(II))**(-2) * LOG(ZSULF(II)) - PRCI(II) = PRCI(II) + & - (2.0442205540818555e-09 + PTEMP(II) * & - 4.0441858911249830e-08 + PTEMP(II)**2 * & - (-3.3423487629482825e-10) + PTEMP(II)**3 * & - 6.8000404742985678e-13) * LOG(PRH(II))**(-1) * LOG(ZSULF(II))**(-2) - PRCI(II) = PRCI(II) + & - (1.8381489183824627e-08 + PTEMP(II) * & - (-8.9853322951518919e-09) + PTEMP(II)**2 * & - 7.5888799566036185e-11 + PTEMP(II)**3 * & - (-1.5823457864755549e-13)) * LOG(PRH(II))**(-1) * LOG(ZSULF(II))**(-1) - PRCI(II) = PRCI(II) + & - (1.1795760639695057e-07 + PTEMP(II) * & - (-8.1046722896375875e-10) + PTEMP(II)**2 * & - 9.1868604369041857e-14 + PTEMP(II)**3 * & - 4.7882428237444610e-15) * LOG(PRH(II))**(-1) - PRCI(II) = PRCI(II) + & - (-4.4028846582545952e-09 + PTEMP(II) * & - 4.6541269232626618e-11 + PTEMP(II)**2 * & - (-1.1939929984285194e-13) + PTEMP(II)**3 * & - 2.3602037016614437e-17) * LOG(PRH(II))**(-1) * LOG(ZSULF(II)) - PRCI(II) = PRCI(II) + & - (2.7885056884209128e-11 + PTEMP(II) * & - (-4.5167129624119121e-13) + PTEMP(II)**2 * & - 1.6558404997394422e-15 + PTEMP(II)**3 * & - (-1.2037336621218054e-18)) * LOG(PRH(II))**(-1) * LOG(ZSULF(II))**2 - PRCI(II) = PRCI(II) + & - (-2.3719627171699983e-09 + PTEMP(II) * & - (-1.5260127909292053e-07) + PTEMP(II)**2 * & - 1.7177017944754134e-09 + PTEMP(II)**3 * & - (-4.7031737537526395e-12)) * LOG(ZSULF(II))**(-2) - PRCI(II) = PRCI(II) + & - (-5.6946433724699646e-09 + PTEMP(II) * & - 8.4629788237081735e-09 + PTEMP(II)**2 * & - (-1.7674135187061521e-10) + PTEMP(II)**3 * & - 6.6236547903091862e-13) * LOG(ZSULF(II))**(-1) - PRCI(II) = PRCI(II) + & - (-2.2808617930606012e-08 + PTEMP(II) * & - 1.4773376696847775e-10 + PTEMP(II)**2 * & - (-1.3076953119957355e-13) + PTEMP(II)**3 * & - 2.3625301497914000e-16) * LOG(ZSULF(II)) - PRCI(II) = PRCI(II) + & - (1.4014269939947841e-10 + PTEMP(II) * & - (-2.3675117757377632e-12) + PTEMP(II)**2 * & - 5.1514033966707879e-15 + PTEMP(II)**3 * & - (-4.8864233454747856e-18)) * LOG(ZSULF(II))**2 - PRCI(II) = PRCI(II) + & - (6.5464943868885886e-11 + PTEMP(II) * & - 1.6494354816942769e-08 + PTEMP(II)**2 * & - (-1.7480097393483653e-10) + PTEMP(II)**3 * & - 4.7460075628523984e-13) * LOG(PRH(II))* LOG(ZSULF(II))**(-2) - PRCI(II) = PRCI(II) + & - (8.4737893183927871e-09 + PTEMP(II) * & - (-6.0243327445597118e-09) + PTEMP(II)**2 * & - 5.8766070529814883e-11 + PTEMP(II)**3 * & - (-1.4926748560042018e-13)) * LOG(PRH(II))* LOG(ZSULF(II))**(-1) - PRCI(II) = PRCI(II) + & - (1.0761964135701397e-07 + PTEMP(II) * & - (-1.0142496009071148e-09) + PTEMP(II)**2 * & - 2.1337312466519190e-12 + PTEMP(II)**3 * & - 1.6376014957685404e-15) * LOG(PRH(II)) - PRCI(II) = PRCI(II) + & - (-3.5621571395968670e-09 + PTEMP(II) * & - 4.1175339587760905e-11 + PTEMP(II)**2 * & - (-1.3535372357998504e-13) + PTEMP(II)**3 * & - 8.9334219536920720e-17) * LOG(PRH(II))* LOG(ZSULF(II)) - PRCI(II) = PRCI(II) + & - (2.0700482083136289e-11 + PTEMP(II) * & - (-3.9238944562717421e-13) + PTEMP(II)**2 * & - 1.5850961422040196e-15 + PTEMP(II)**3 * & - (-1.5336775610911665e-18)) * LOG(PRH(II))* LOG(ZSULF(II))**2 - PRCI(II) = PRCI(II) + & - (1.8524255464416206e-09 + PTEMP(II) * & - (-2.1959816152743264e-11) + PTEMP(II)**2 * & - (-6.4478119501677012e-14) + PTEMP(II)**3 * & - 5.5135243833766056e-16)* LOG(PRH(II))**2 * LOG(ZSULF(II))**(-1) - PRCI(II) = PRCI(II) + & - (1.9349488650922679e-09 + PTEMP(II) * & - (-2.2647295919976428e-11) + PTEMP(II)**2 * & - 9.2917479748268751e-14 + PTEMP(II)**3 * & - (-1.2741959892173170e-16))* LOG(PRH(II))**2 - PRCI(II) = PRCI(II) + & - (2.1484978031650972e-11 + PTEMP(II) * & - (-9.3976642475838013e-14) + PTEMP(II)**2 * & - (-4.8892738002751923e-16) + PTEMP(II)**3 * & - 1.4676120441783832e-18)* LOG(PRH(II))**2 * LOG(ZSULF(II)) - PRCI(II) = PRCI(II) + & - (6.7565715216420310e-13 + PTEMP(II) * & - (-3.5421162549480807e-15) + PTEMP(II)**2 * & - (-3.4201196868693569e-18) + PTEMP(II)**3 * & - 2.2260187650412392e-20)* LOG(PRH(II))**3 * LOG(ZSULF(II)) - ! - ZNACI(II) = ZAL(II) * ZNTOTI(II) - ! - IF (ZNACI(II) .LT. 1.) THEN - ! - ! - ZNACI(II)=1.0 - ! - END IF - ! - END IF - ! - ! Ion loss rate (1/s) - ! - ZXLOSS(II) = ZCSI(II) + PJNUCI(II) - ! - ! Recombination (here following Brasseur and Chatel, 1983) - ! - ZRECOMB(II) = 6.0e-8 * sqrt(300./PTEMP(II)) + & - 6.0e-26 * ZAIRN(II) * (300./PTEMP(II))**4 - ! - ! Small ion concentration in air (1/cm3) (following Dunne et al., 2016) - ! max function is to avoid n_i to go practically zero at very high J_ion - ! - ZNIPAIR(II) = max(0.01,(sqrt(ZXLOSS(II)**2.0 + & - 4.0 * ZRECOMB(II) * ZIPR(II)) - ZXLOSS(II)) / (2.0 * ZRECOMB(II))) - ! - ! Ion-induced nucleation rate - ! Min function is to ensure that max function above does not cause J_ion to overshoot - ! - PJNUCI(II) = min(ZIPR(II),ZNIPAIR(II)*PJNUCI(II)) - ! - IF (PJNUCI(II).LT.1.E-7) THEN - ! - PJNUCI(II) = 0.0 - ! - END IF - ! - END IF - ! - END IF - ! -END DO -! -! -IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_ION (fin): PRH =',MINVAL(PRH), MAXVAL(PRH) -IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_ION (fin): PTEMP =',MINVAL(PTEMP), MAXVAL(PTEMP) -IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_ION (fin): ZSULF =',MINVAL(ZSULF), MAXVAL(ZSULF) -IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_ION (fin): PJNUCI =',MINVAL(PJNUCI), MAXVAL(PJNUCI) -IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_ION (fin): ZKINTRI =',MINVAL(ZKINTRI), MAXVAL(ZKINTRI) -IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_ION (fin): ZAL =',MINVAL(ZAL), MAXVAL(ZAL) -IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_ION (fin): ZNTOTI =',MINVAL(ZNTOTI), MAXVAL(ZNTOTI) -IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_ION (fin): PRCI =',MINVAL(PRCI), MAXVAL(PRCI) -IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_ION (fin): ZXLOSS =',MINVAL(ZXLOSS), MAXVAL(ZXLOSS) -IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_ION (fin): ZRECOMB =',MINVAL(ZRECOMB), MAXVAL(ZRECOMB) -IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_ION (fin): ZNIPAIR =',MINVAL(ZNIPAIR), MAXVAL(ZNIPAIR) -! -RETURN -! -END SUBROUTINE CH_AER_MAATTANEN_IONIND - diff --git a/src/ICCARE_BASE/ch_aer_maattanen_neutral.f90 b/src/ICCARE_BASE/ch_aer_maattanen_neutral.f90 deleted file mode 100644 index 8a9c8b5d3..000000000 --- a/src/ICCARE_BASE/ch_aer_maattanen_neutral.f90 +++ /dev/null @@ -1,335 +0,0 @@ -!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence -!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!ORILAM_LIC for details. -!----------------------------------------------------------------- -!--------------- special set of characters for RCS information -!----------------------------------------------------------------- -! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/ch_aer_nucl.f90,v $ $Revision: 1.1.4.1.18.1 $ -! MASDEV4_7 chimie 2006/05/18 13:07:25 -!----------------------------------------------------------------- -!! ################################ -MODULE MODI_CH_AER_MAATTANEN_NEUTRAL -!! ################################ -!! -INTERFACE - !! - SUBROUTINE CH_AER_MAATTANEN_NEUTRAL(PRH,PTEMP,PSULF,PJNUCN,PRCN) - IMPLICIT NONE - !! - REAL, DIMENSION(:), INTENT(IN) :: PRH,PTEMP,PSULF - REAL, DIMENSION(:), INTENT(INOUT) :: PJNUCN, PRCN - !! - !! - END SUBROUTINE CH_AER_MAATTANEN_NEUTRAL - !! -END INTERFACE -!! -END MODULE MODI_CH_AER_MAATTANEN_NEUTRAL -!! -!! ######################################################################### -SUBROUTINE CH_AER_MAATTANEN_NEUTRAL(PRH,PTEMP,PSULF,PJNUCN,PRCN) -!########################################################### -! -!! -!! PURPOSE -!! ------- -!! -!! Compute nucleation rate for binary H2SO4/H2O -!! This is the Määttänen parametrization (2018) -!! This is the neutral particle formation part -!! -!! Valid for : -!! 165 < T < 400 (K) -!! 0.001 < RH < 100 (%) -!! 10â´ < [H2SO4]gas < 10¹³ (molec/cm3) -!! -!! -!! AUTHOR -!! ------ -!! B. Foucart * LACy * -!! -!! MODIFICATIONS -!! ------------- -!! B. Foucart (18/06/2018) * LACy * -!! -!---------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_CST, ONLY : XAVOGADRO -USE MODD_CONF, ONLY : NVERB -USE MODD_CH_AEROSOL -! -IMPLICIT NONE -! -!* 0.1 Declarations of dummy arguments : -! -REAL, DIMENSION(:), INTENT(IN) :: PRH, PTEMP, PSULF ! Relative humidity (%), Temp (kelvin) -REAL, DIMENSION(:), INTENT(INOUT) :: PJNUCN, PRCN ! Nucleation rate (#/cm3/s) , Critical cluster radius (nm) -! -!* 0.2 Declarations of local variables : -! -REAL, DIMENSION(SIZE(PSULF,1)) :: ZSULF ! Sulfuric acid concentration (molec/cm3) -REAL, DIMENSION(SIZE(PSULF,1)) :: ZAL ! Mole fraction of H2SO4 in the critical cluster -REAL, DIMENSION(SIZE(PSULF,1)) :: ZNTOTN ! Total number of molec in the neutral critical cluster -REAL, DIMENSION(SIZE(PSULF,1)) :: ZKINTRN ! Threshold sulfuric acid for neutral kinetic nucleation -REAL, DIMENSION(SIZE(PSULF,1)) :: ZNACN ! Sulfuric acid molecules in the neutral critical cluster -! -LOGICAL :: GKINETICN ! True if kinetic neutral nucleation -! -INTEGER :: II, ITEST ! Tests -! -IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_NEUT (deb): PSULF =',MINVAL(PSULF), MAXVAL(PSULF) -IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_NEUT (deb): (XAVOGADRO*1.E-12) =',(XAVOGADRO*1.E-12) -IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_NEUT (deb): XH2SO4=', XH2SO4 -IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_NEUT (deb): PTEMP =',MINVAL(PTEMP), MAXVAL(PTEMP) -IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_NEUT (deb): PRH =',MINVAL(PRH), MAXVAL(PRH) -! -!---------------------------------------------------------------------------- -! -! Parameters initialization -! -ZAL(:) = 0.17 ! must vary between 0 and 1 -PJNUCN(:) = 1E-7 ! must vary between 10E-7 and 10E10 cm3.s-1 -PRCN(:) = 2.8E-10 ! (meters) must vary between 0.28 and 1.2 nm -ZNACN(:) = 0. -ZNTOTN(:) = 10. ! must vary between 1 and 200 molecules -ZKINTRN(:) = 0. -GKINETICN = .FALSE. -! -! a. Sulfuric acid concentration definition: ZSULF from ug/m3 to molec/cm3 -! -ZSULF(:) = PSULF(:)*(XAVOGADRO*1.E-12) / XH2SO4 -! -! b. Restrictions for parametrization -! -! -ITEST = 0. -! -DO II = 1, SIZE(PSULF,1) - IF ((PRH(II) > 0.001).AND.(PTEMP(II)>165.).AND.(ZSULF(II)>1E4)) THEN - ITEST = ITEST+1 - END IF -END DO -! -DO II = 1, SIZE(PSULF,1) - ! - IF ( (PRH(II)>0.001) .AND. (PTEMP(II)>165.) .AND. (ZSULF(II)>1E4) ) THEN - ! - ! 1. Mole fraction of H2SO4 in the critical cluster (eq 1): composition - ! - ZAL(II) = 7.9036365428891719E-1-2.8414059650092153E-3*PTEMP(II)+& - 1.4976802556584141E-2*LOG(PRH(II))-2.4511581740839115E-4*PTEMP(II)*LOG(PRH(II))+& - 3.4319869471066424E-3*(LOG(PRH(II)))**2-2.8799393617748428E-5*PTEMP(II)*(LOG(PRH(II)))**2+& - 3.0174314126331765E-4*(LOG(PRH(II)))**3-2.2673492408841294E-6*PTEMP(II)*(LOG(PRH(II)))**3-& - 4.3948464567032377E-3*LOG(ZSULF(II))+5.3305314722492146E-5*PTEMP(II)*LOG(ZSULF(II)) - ! - ! 2. Nucleation rate calculation in part.cm-3.s-1 (eq 2) - ! - ! a) Kinetic limit check - ! - IF (PRH(II) .GE. 1.e-2 .AND. PRH(II) .LE. 1.) THEN - ! - ZKINTRN(II) = exp(7.8920778706888086e+1 + 7.3665492897447082*PRH(II) - 1.2420166571163805e+4/PTEMP(II) & - & + (-6.1831234251470971e+2*PRH(II))/PTEMP(II) - 2.4501159970109945e-2*PTEMP(II) & - & -1.3463066443605762e-2*PRH(II)*PTEMP(II) + 8.3736373989909194e-06*PTEMP(II)**2 & - & -1.4673887785408892*Log(PRH(II)) + (-3.2141890006517094e+1*Log(PRH(II)))/PTEMP(II) & - & + 2.7137429081917556e-3*PTEMP(II)*Log(PRH(II))) !1/cm3 - ! - IF (ZKINTRN(II).LT.ZSULF(II)) GKINETICN = .TRUE. - ! - END IF - ! - IF (PRH(II) .GE. 1.e-4 .AND. PRH(II) .LT. 1.e-2) THEN - ! - ZKINTRN(II) = exp(7.9074383049843647e+1 - 2.8746005462158347e+1*PRH(II) - 1.2070272068458380e+4/PTEMP(II) & - & + (-5.9205040320056632e+3*PRH(II))/PTEMP(II) - 2.4800372593452726e-2*PTEMP(II) & - & -4.3983007681295948e-2*PRH(II)*PTEMP(II) + 2.5943854791342071e-5*PTEMP(II)**2 & - & -2.3141363245211317*Log(PRH(II)) + (9.9186787997857735e+1*Log(PRH(II)))/PTEMP(II) & - & + 5.6819382556144681e-3*PTEMP(II)*Log(PRH(II))) !1/cm3 - ! - IF (ZKINTRN(II).LT.ZSULF(II)) GKINETICN = .TRUE. - ! - END IF - ! - IF (PRH(II) .GE. 5.e-6 .AND. PRH(II) .LT. 1.e-4) THEN - ! - ZKINTRN(II) = exp(8.5599712000361677e+1 + 2.7335119660796581e+3*PRH(II) - 1.1842350246291651e+4/PTEMP(II) & - & + (-1.2439843468881438e+6*PRH(II))/PTEMP(II) - 5.4536964974944230e-2*PTEMP(II) & - & + 5.0886987425326087*PRH(II)*PTEMP(II) + 7.1964722655507067e-5*PTEMP(II)**2 & - & -2.4472627526306372*Log(PRH(II)) + (1.7561478001423779e+2*Log(PRH(II)))/PTEMP(II) & - & + 6.2640132818141811e-3*PTEMP(II)*Log(PRH(II))) !1/cm3 - ! - IF(ZKINTRN(II).LT.ZSULF(II)) GKINETICN = .TRUE. - ! - END IF - ! - IF (GKINETICN) THEN - ! - ! Nucleation rate calculation if dimer - ! - PJNUCN(II) = 1.E6*(2.*0.3E-9)**2.*sqrt(8.*3.141593*1.38E-23*(1./(1.661e-27*98.07)+1./(1.661e-27*98.07))) & - & /2.*sqrt(PTEMP(II))*ZSULF(II)**2. - ! - ZNTOTN(II) = 1. !set to 1 - ! - ZNACN(II) = 1. ! The critical cluster contains one molecule, but the produced cluster contains 2 molecules - ! - ZAL(II) = ZNACN(II) / ZNTOTN(II) ! so also set this to 1 - ! - PRCN(II) = 0.3E-9 - ! - ELSE - ! - ! c) Nucleation rate calculation if not dimer - ! - PJNUCN(II) = 2.1361182605986115e-1 + & - & 3.3827029855551838 * PTEMP(II) - & - & 3.2423555796175563e-2 * PTEMP(II)**2 + & - & 7.0120069477221989e-5 * PTEMP(II)**3 + & - & 8.0286874752695141 / ZAL(II) + & - & -2.6939840579762231e-1 * LOG(PRH(II)) + & - & 1.6079879299099518 * PTEMP(II) * LOG(PRH(II)) + & - & -1.9667486968141933e-2 * PTEMP(II)**2 * LOG(PRH(II)) + & - & 5.5244755979770844e-5 * PTEMP(II)**3 * LOG(PRH(II)) + & - & (7.8884704837892468 * LOG(PRH(II))) / ZAL(II) + & - & 4.6374659198909596 * LOG(PRH(II))**2 - & - & 8.2002809894792153e-2 * PTEMP(II) * LOG(PRH(II))**2 + & - & 8.5077424451172196e-4 * PTEMP(II)**2 * LOG(PRH(II))**2 + & - & -2.6518510168987462e-6 * PTEMP(II)**3 * LOG(PRH(II))**2 + & - & (-1.4625482500575278 * LOG(PRH(II))**2)/ZAL(II) - & - & 5.2413002989192037e-1 * LOG(PRH(II))**3 + & - & 5.2755117653715865e-3 * PTEMP(II) * LOG(PRH(II))**3 + & - & -2.9491061332113830e-6 * PTEMP(II)**2 * LOG(PRH(II))**3 + & - & -2.4815454194486752e-8 * PTEMP(II)**3 * LOG(PRH(II))**3 + & - & (-5.2663760117394626e-2 * LOG(PRH(II))**3) / ZAL(II) + & - & 1.6496664658266762 * LOG(ZSULF(II)) + & - & -8.0809397859218401e-1 * PTEMP(II) * LOG(ZSULF(II)) + & - & 8.9302927091946642e-3 * PTEMP(II)**2 * LOG(ZSULF(II)) + & - & -1.9583649496497497e-5 * PTEMP(II)**3 * LOG(ZSULF(II)) + & - & (-8.9505572676891685 * LOG(ZSULF(II))) / ZAL(II) + & - & -3.0025283601622881e+1 * LOG(PRH(II)) * LOG(ZSULF(II)) + & - & 3.0783365644763633e-1 * PTEMP(II) * LOG(PRH(II)) * LOG(ZSULF(II)) + & - & -7.4521756337984706e-4 * PTEMP(II)**2 * LOG(PRH(II)) * LOG(ZSULF(II)) + & - & -5.7651433870681853e-7 * PTEMP(II)**3 * LOG(PRH(II)) * LOG(ZSULF(II)) + & - & (1.2872868529673207 * LOG(PRH(II)) * LOG(ZSULF(II))) / ZAL(II) + & - & -6.1739867501526535e-1 * LOG(PRH(II))**2 * LOG(ZSULF(II)) + & - & 7.2347385705333975e-3 * PTEMP(II) * LOG(PRH(II))**2 * LOG(ZSULF(II)) + & - & -3.0640494530822439e-5 * PTEMP(II)**2 * LOG(PRH(II))**2 * LOG(ZSULF(II)) + & - & 6.5944609194346214e-8 * PTEMP(II)**3 * LOG(PRH(II))**2 * LOG(ZSULF(II)) + & - & (-2.8681650332461055e-2 * LOG(PRH(II))**2 * LOG(ZSULF(II))) / ZAL(II) + & - & 6.5213802375160306 * LOG(ZSULF(II))**2 + & - & -4.7907162004793016e-2 * PTEMP(II) * LOG(ZSULF(II))**2 + & - & -1.0727890114215117e-4 * PTEMP(II)**2 * LOG(ZSULF(II))**2 + & - & 5.6401818280534507e-7 * PTEMP(II)**3 * LOG(ZSULF(II))**2 + & - & (5.4113070888923009e-1 * LOG(ZSULF(II))**2) / ZAL(II) + & - & 5.2062808476476330e-1 * LOG(PRH(II)) * LOG(ZSULF(II))**2 + & - & -6.0696882500824584e-3 * PTEMP(II) * LOG(PRH(II)) * LOG(ZSULF(II))**2 + & - & 2.3851383302608477e-5 * PTEMP(II)**2 * LOG(PRH(II)) * LOG(ZSULF(II))**2 + & - & -1.5243837103067096e-8 * PTEMP(II)**3 * LOG(PRH(II)) * LOG(ZSULF(II))**2 + & - & (-5.6543192378015687e-2 * LOG(PRH(II)) * LOG(ZSULF(II))**2) / ZAL(II) + & - & -1.1630806410696815e-1 * LOG(ZSULF(II))**3 + & - & 1.3806404273119610e-3 * PTEMP(II) * LOG(ZSULF(II))**3 + & - & -2.0199865087650833e-6 * PTEMP(II)**2 * LOG(ZSULF(II))**3 + & - & -3.0200284885763192e-9 * PTEMP(II)**3 * LOG(ZSULF(II))**3 + & - & (-6.9425267104126316e-3 * LOG(ZSULF(II))**3) / ZAL(II) - ! - PJNUCN(II)=MIN(5.0E1,PJNUCN(II)) - PJNUCN(II)=EXP(PJNUCN(II)) - ! - ! 3. Molecules number in the cluster calculation - ! - ZNTOTN(II) = -3.5863435141979573e-3 - & - & 1.0098670235841110e-1*PTEMP(II) + & - & 8.9741268319259721e-4*PTEMP(II)**2 - & - & 1.4855098605195757e-6*PTEMP(II)**3 & - & - 1.2080330016937095e-1/ZAL(II) + & - & 1.1902674923928015e-3*LOG(PRH(II)) - & - & 1.9211358507172177e-2*PTEMP(II)*LOG(PRH(II)) + & - & 2.4648094311204255e-4*PTEMP(II)**2*LOG(PRH(II))- & - & 7.5641448594711666e-7*PTEMP(II)**3*LOG(PRH(II)) + & - & (-2.0668639384228818e-02*LOG(PRH(II)))/ZAL(II) - & - & 3.7593072011595188e-2*LOG(PRH(II))**2 + & - & 8.0993182774415718e-4*PTEMP(II)*LOG(PRH(II))**2 + & - & -9.5698412164297149e-6*PTEMP(II)**2*LOG(PRH(II))**2 + & - & 3.7163166416110421e-8*PTEMP(II)**3*LOG(PRH(II))**2 + & - & (1.1026579525210847e-2*LOG(PRH(II))**2)/ZAL(II) + & - & 1.1530844115561925e-2*LOG(PRH(II))**3 + & - & - 1.8083253906466668e-4*PTEMP(II)*LOG(PRH(II))**3 +& - & 8.0213604053330654e-7*PTEMP(II)**2*LOG(PRH(II))**3 + & - & -8.5797885383051337e-10*PTEMP(II)**3*LOG(PRH(II))**3 + & - & (1.0243693899717402e-3*LOG(PRH(II))**3)/ZAL(II) + & - & -1.7248695296299649e-2*LOG(ZSULF(II)) + & - & 1.1294004162437157e-2*PTEMP(II)*LOG(ZSULF(II)) + & - & -1.2283640163189278e-4*PTEMP(II)**2*LOG(ZSULF(II)) + & - & 2.7391732258259009e-7*PTEMP(II)**3*LOG(ZSULF(II)) + & - & (6.8505583974029602e-2*LOG(ZSULF(II)))/ZAL(II) + & - & 2.9750968179523635e-1*LOG(PRH(II))*LOG(ZSULF(II)) + & - & -3.6681154503992296e-3*PTEMP(II)*LOG(PRH(II))*LOG(ZSULF(II)) + & - & 1.0636473034653114e-5*PTEMP(II)**2*LOG(PRH(II))*LOG(ZSULF(II)) + & - & 5.8687098466515866e-9*PTEMP(II)**3*LOG(PRH(II))*LOG(ZSULF(II)) + & - & (-5.2028866094191509e-3*LOG(PRH(II))*LOG(ZSULF(II)))/ZAL(II) + & - & 7.6971988880587231e-4*LOG(PRH(II))**2*LOG(ZSULF(II)) - & - & 2.4605575820433763e-5*PTEMP(II)*LOG(PRH(II))**2*LOG(ZSULF(II)) + & - & 2.3818484400893008e-7*PTEMP(II)**2*LOG(PRH(II))**2*LOG(ZSULF(II)) + & - & -8.8474102392445200e-10*PTEMP(II)**3*LOG(PRH(II))**2*LOG(ZSULF(II)) + & - & (-1.6640566678168968e-4*LOG(PRH(II))**2*LOG(ZSULF(II)))/ZAL(II) - & - & 7.7390093776705471e-2*LOG(ZSULF(II))**2 + & - & 5.8220163188828482e-4*PTEMP(II)*LOG(ZSULF(II))**2 + & - & 1.2291679321523287e-6*PTEMP(II)**2*LOG(ZSULF(II))**2 + & - & -7.4690997508075749e-9*PTEMP(II)**3*LOG(ZSULF(II))**2 + & - & (-5.6357941220497648e-3*LOG(ZSULF(II))**2)/ZAL(II) + & - & -4.7170109625089768e-3*LOG(PRH(II))*LOG(ZSULF(II))**2 + & - & 6.9828868534370193e-5*PTEMP(II)*LOG(PRH(II))*LOG(ZSULF(II))**2 + & - & -3.1738912157036403e-7*PTEMP(II)**2*LOG(PRH(II))*LOG(ZSULF(II))**2 + & - & 2.3975538706787416e-10*PTEMP(II)**3*LOG(PRH(II))*LOG(ZSULF(II))**2 + & - & (4.2304213386288567e-4*LOG(PRH(II))*LOG(ZSULF(II))**2)/ZAL(II) + & - & 1.3696520973423231e-3*LOG(ZSULF(II))**3 + & - & -1.6863387574788199e-5*PTEMP(II)*LOG(ZSULF(II))**3 + & - & 2.7959499278844516e-8*PTEMP(II)**2*LOG(ZSULF(II))**3 + & - & 3.9423927013227455e-11*PTEMP(II)**3*LOG(ZSULF(II))**3 + & - & (8.6136359966337272e-5*LOG(ZSULF(II))**3)/ZAL(II) - ! - ZNTOTN(II)=EXP(ZNTOTN(II)) - ! - ! 4. Critical cluster size calculation (in meters) - ! - PRCN(II) = EXP(-22.378268374023630 + 0.44462953606125100 *ZAL(II) + 0.33499495707849131 * LOG(ZNTOTN(II))) - ! - ! 5. Acid molecules in nucleation regime - ! - ZNACN(II) = ZAL(II) * ZNTOTN(II) - ! - IF (ZNACN(II) .lt. 1.) THEN - ! - ! print *, 'Warning: number of acid molecules < 1 in nucleation regime, setting na_n=1' - ! - ZNACN(II)=1.0 - ! - END IF - ! - END IF - ! - ! 3. Restrictions for nucleation rates - ! - IF (PJNUCN(II) .LT. 1.0E-7) PJNUCN(II) = 0.0 - ! - ! - END IF -END DO -! -! -IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_NEUT (fin): PRH =',MINVAL(PRH), MAXVAL(PRH) -IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_NEUT (fin): PTEMP =',MINVAL(PRH), MAXVAL(PRH) -IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_NEUT (fin): ZSULF =',MINVAL(ZSULF), MAXVAL(ZSULF) -IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_NEUT (fin): PJNUCN =',MINVAL(PJNUCN), MAXVAL(PJNUCN) -IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_NEUT (fin): ZAL =',MINVAL(ZAL), MAXVAL(ZAL) -IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_NEUT (fin): ZNTOTN =',MINVAL(ZNTOTN), MAXVAL(ZNTOTN) -IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_NEUT (fin): PRCN =',MINVAL(PRCN), MAXVAL(PRCN) -! -RETURN -! -END SUBROUTINE CH_AER_MAATTANEN_NEUTRAL - diff --git a/src/ICCARE_BASE/ch_aer_mineral.f90 b/src/ICCARE_BASE/ch_aer_mineral.f90 deleted file mode 100644 index 646453544..000000000 --- a/src/ICCARE_BASE/ch_aer_mineral.f90 +++ /dev/null @@ -1,229 +0,0 @@ -!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence -!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!ORILAM_LIC for details. -!! ########################## - MODULE MODI_CH_AER_MINERAL -!! ########################## -!! -INTERFACE -!! -SUBROUTINE CH_AER_MINERAL(PCTOTG, PCTOTA, PRV, PDENAIR, PPRESSURE, PTEMP, PRC, POM,& - PCCTOT) -IMPLICIT NONE -REAL, DIMENSION(:,:), INTENT(INOUT) :: PCTOTG, POM -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCTOTA, PCCTOT -REAL, DIMENSION(:), INTENT(IN) :: PRV, PDENAIR, PPRESSURE, PTEMP, PRC -!! -END SUBROUTINE CH_AER_MINERAL -!! -END INTERFACE -!! -END MODULE MODI_CH_AER_MINERAL -!! -!! -!! ##################################################################################### - SUBROUTINE CH_AER_MINERAL(PCTOTG, PCTOTA, PRV, PDENAIR, PPRESSURE, PTEMP, PRC, POM, & - PCCTOT) -!! ##################################################################################### -!! -!! PURPOSE -!! ------- -!! solve the mineral thermodynamic balance -!! -!! REFERENCE -!! --------- -!! None -!! -!! AUTHOR -!! ------ -!! P. Tulet (GMEI) -!! -!! MODIFICATIONS -!! ------------- -!! -!! EXTERNAL -!! -------- -!! None -!! -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_CH_AEROSOL -USE MODI_CH_NNARES -USE MODI_CH_ARES -USE MODI_CH_ISOROPIA -USE MODI_CH_AER_THERMO -USE MODI_CH_AER_EQSAM -USE MODD_CST, ONLY : XMNH_TINY -USE MODD_CONF, ONLY : NVERB -! -IMPLICIT NONE -! -!* 0.1 Declarations of arguments -! -REAL, DIMENSION(:,:), INTENT(INOUT) :: PCTOTG, POM -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCTOTA, PCCTOT -REAL, DIMENSION(:), INTENT(IN) :: PRV, PDENAIR, PPRESSURE, PTEMP, PRC -! -!* 0.2 Declarations of local variables -! -INTEGER :: JI,JJ -REAL, DIMENSION(SIZE(PCTOTA,1),NSP,JPMODE) :: ZFRAC -REAL, DIMENSION(SIZE(PCTOTA,1),NSP) :: ZTOT,ZTOTNEW, ZTOTGNEW -REAL, DIMENSION(SIZE(PCTOTA,1),NSP+NCARB+NSOA) :: ZDEL -REAL, DIMENSION(SIZE(PCTOTA,1),6) :: ZAER -REAL, DIMENSION(SIZE(PCTOTA,1)) :: ZPKM, ZPKH2O, ZSAT, ZRH -! -!------------------------------------------------------------------------------- -! -!* 1. INITIALIZATION -! -------------- -! -ZPKM (:) = 1E-3 * PDENAIR(:) * 6.0221367E+23 / 28.9644 -ZPKH2O(:) = ZPKM(:) * 1.6077 * PRV(:) -! -! compute relative humidity -ZSAT(:) = 0.611*EXP(17.2694*(PTEMP(:)-273.16)/(PTEMP(:)-35.86)) -ZSAT(:) = ZSAT(:)*1000. -ZRH (:) = (ZPKH2O(:)/(ZPKM(:)*1.6077))*PPRESSURE(:)/& - & (0.622+(ZPKH2O(:)/(ZPKM(:)*1.6077)))/ZSAT(:) -ZRH(:) = MIN(0.95, MAX(ZRH(:), .1)) ! until 0.95 thermodynamic code is not valid -! -! Mass need to be positive -PCTOTA(:,:,:) = MAX(PCTOTA(:,:,:),0.) -PCTOTG(:,:) = MAX(PCTOTG(:,:), 0.) -ZTOTGNEW(:,:) = 0. -! -!------------------------------------------------------------------------------- -! -!* 2. COMPUTE MINERAL CHEMICAL EQUILIBRIUM -! ------------------------------------ -! -!****************************************************************** -! Calcul de la repartition des differentes especes entre les modes -! pour pouvoir conserver celle ci apres l'equilibre chimique -!****************************************************************** -DO JI=1,NSP - ZTOTNEW(:,JI)=0. - ZTOT(:,JI)=PCTOTA(:,JI,1)+PCTOTA(:,JI,2) - ZTOT(:,JI) = MAX(ZTOT(:,JI),1.E-40) - ZFRAC(:,JI,1)=PCTOTA(:,JI,1)/(ZTOT(:,JI)+1E-25) - ZFRAC(:,JI,2)=1.-ZFRAC(:,JI,1) - ! use SO4 fraction for all species (clean this up later) - ZFRAC(:,JI,1)=ZFRAC(:,1,1) - ZFRAC(:,JI,2)=1.-ZFRAC(:,JI,1) -ENDDO -! -ZTOTNEW(:,:) = ZTOT(:,:) -! -ZAER(:,1)=ZTOT(:,JP_AER_SO4) -ZAER(:,2)=PCTOTG(:,JP_AER_NH3g) -ZAER(:,3)=PCTOTG(:,JP_AER_NO3g) -ZAER(:,4)=ZTOT(:,JP_AER_H2O) -!ZAER(:,4)=0. -ZAER(:,5)=ZTOT(:,JP_AER_NO3) -ZAER(:,6)=ZTOT(:,JP_AER_NH3) -ZAER(:,:)=MAX(ZAER(:,:),0.) - -! switch here for ARES (ARES), Neuronal ARES (NARES), ISOROPIA (ISPIA) -IF (CMINERAL == 'NARES') THEN - CALL CH_NNARES(ZAER,ZRH, PDENAIR, PPRESSURE, PTEMP, PRC) - ZAER(:,:)=MAX(ZAER(:,:),0.) - ZTOTNEW(:,JP_AER_SO4)=ZAER(:,1) - ZTOTGNEW(:,JP_AER_NH3g)=ZAER(:,2) - ZTOTGNEW(:,JP_AER_NO3g)=ZAER(:,3) - ZTOTNEW(:,JP_AER_H2O)=ZAER(:,4) - ZTOTNEW(:,JP_AER_NO3)=ZAER(:,5) - ZTOTNEW(:,JP_AER_NH3)=ZAER(:,6) - -! Especes phase gazeuse -!PCTOTG(:,JP_AER_SO4g)=0. !H2SO4(g) -ELSE IF (CMINERAL == 'ARES') THEN -! test of stability -!DO III=1, 5 - CALL CH_ARES(ZAER,ZRH, PDENAIR, PPRESSURE, PTEMP, PRC) - ZAER(:,:) = MAX(ZAER(:,:),0.) - ZTOTNEW(:,JP_AER_SO4)=ZAER(:,1) - ZTOTGNEW(:,JP_AER_NH3g)=ZAER(:,2) - ZTOTGNEW(:,JP_AER_NO3g)=ZAER(:,3) - ZTOTNEW(:,JP_AER_H2O)=ZAER(:,4) - ZTOTNEW(:,JP_AER_NO3)=ZAER(:,5) - ZTOTNEW(:,JP_AER_NH3)=ZAER(:,6) -!ENDDO -! -ELSE IF (CMINERAL == 'ISPIA') THEN -! - CALL CH_ISOROPIA(ZAER,ZRH, PDENAIR, PPRESSURE, PTEMP, PRC) - - ZAER(:,:)=MAX(ZAER(:,:),0.) - ZTOTNEW(:,JP_AER_SO4)=ZAER(:,1) - ZTOTGNEW(:,JP_AER_NH3g)=ZAER(:,2) - ZTOTGNEW(:,JP_AER_NO3g)=ZAER(:,3) - ZTOTNEW(:,JP_AER_H2O)=ZAER(:,4) - ZTOTNEW(:,JP_AER_NO3)=ZAER(:,5) - ZTOTNEW(:,JP_AER_NH3)=ZAER(:,6) -! - -ELSE IF (CMINERAL == 'TABUL') THEN - - CALL CH_AER_THERMO(ZAER,ZRH, PDENAIR, PPRESSURE, PTEMP, PRC) - - ZAER(:,:)=MAX(ZAER(:,:),0.) - ZTOTNEW(:,JP_AER_SO4)=ZAER(:,1) - ZTOTGNEW(:,JP_AER_NH3g)=ZAER(:,2) - ZTOTGNEW(:,JP_AER_NO3g)=ZAER(:,3) - ZTOTNEW(:,JP_AER_H2O)=ZAER(:,4) - ZTOTNEW(:,JP_AER_NO3)=ZAER(:,5) - ZTOTNEW(:,JP_AER_NH3)=ZAER(:,6) - -ELSE IF (CMINERAL == 'EQSAM') THEN - - CALL CH_AER_EQSAM(ZAER,ZRH, PPRESSURE, PTEMP) - - ZAER(:,:)=MAX(ZAER(:,:),0.) - ZTOTNEW(:,JP_AER_SO4)=ZAER(:,1) - ZTOTGNEW(:,JP_AER_NH3g)=ZAER(:,2) - ZTOTGNEW(:,JP_AER_NO3g)=ZAER(:,3) - ZTOTNEW(:,JP_AER_H2O)=ZAER(:,4) - ZTOTNEW(:,JP_AER_NO3)=ZAER(:,5) - ZTOTNEW(:,JP_AER_NH3)=ZAER(:,6) -! -ELSE - -IF (NVERB==10) PRINT *,' WARNING WARNING WARNING WARNING WARNING WARNING' -IF (NVERB==10) PRINT *,' PAS D EQUILIBRE THERMODYNAMIQUE ENTRE LES MINERAUX' -IF (NVERB==10) PRINT *,' WARNING WARNING WARNING WARNING WARNING WARNING' - ZTOTNEW(:,:) = MAX(0.,ZTOT(:,:)) - -ENDIF -! Especes phase gazeuse -ZTOTGNEW(:,JP_AER_SO4g)=0. !H2SO4(g) -ZTOTNEW(:,:) = MAX(0.,ZTOTNEW(:,:)) -! -ZDEL(:,:)=0. -! Concentration des especes 'totales' presentes dans l'aerosol -ZDEL(:,1:NSP)=ZTOTNEW(:,1:NSP)-ZTOT(:,1:NSP) -! -! Calcul de la nouvelle composition chimique -! de chacun des modes apres equilibre chimique -! -DO JI=1,JPMODE - DO JJ=1,NSP - - PCTOTA(:,JJ,JI)=MAX(XMNH_TINY,PCTOTA(:,JJ,JI)+ZFRAC(:,JJ,JI)*ZDEL(:,JJ)) - ! répartition entre les modes en fonction de la surface des aerosols (facteur - ! omega) - ! PCTOTA(:,JJ,JI)=MAX(XMNH_TINY,PCTOTA(:,JJ,JI)+ZDEL(:,JJ)*POM(:,JI)) - ! PCTOTA(:,JJ,JI)=MAX(XMNH_TINY,ZTOTNEW(:,JJ)*POM(:,JI)) - ENDDO - !PCTOTA(:,JP_AER_SO4,JI) = ZCTOTA(:,JP_AER_SO4,JI) -ENDDO -! -DO JJ=1,NSP - PCTOTG(:,JJ)=MAX(XMNH_TINY,PCTOTG(:,JJ)-ZDEL(:,JJ)) -ENDDO -! -END SUBROUTINE CH_AER_MINERAL diff --git a/src/ICCARE_BASE/ch_aer_mod_init.f90 b/src/ICCARE_BASE/ch_aer_mod_init.f90 deleted file mode 100644 index 6c22e5443..000000000 --- a/src/ICCARE_BASE/ch_aer_mod_init.f90 +++ /dev/null @@ -1,311 +0,0 @@ -!ORILAM_LIC Copyright 2006-2019 CNRS, Meteo-France and Universite Paul Sabatier -!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence -!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!ORILAM_LIC for details. -!----------------------------------------------------------------- -!! ############################ - MODULE MODI_CH_AER_MOD_INIT -!! ############################ -!! -INTERFACE -SUBROUTINE CH_AER_MOD_INIT -END SUBROUTINE CH_AER_MOD_INIT -END INTERFACE -!! -END MODULE MODI_CH_AER_MOD_INIT -!! -!! -!! #################################### - SUBROUTINE CH_AER_MOD_INIT -!! #################################### -!! -!! PURPOSE -!! ------- -!! initialize the aerosol module (to be called only once) -!! -!! METHOD -!! ------ -!! -!! allocate all arrays and initialize the basic variables (i.e. densities -!! and molar weights) -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Vincent Crassier (LA) -!! -!! MODIFICATIONS -!! ------------- -!! 20/03/03 P . Tulet (CNRM/GMEI) add initialization tabulation -!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O -! P. Wautelet: 07/06/2019: allocate weights only when needed -!! -!! EXTERNAL -!! -------- -!! none -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -USE MODD_CH_AEROSOL -USE MODD_GLO -USE MODD_IO, ONLY: TFILEDATA -USE MODD_UNIFACPARAM -! -USE MODE_IO_FILE, ONLY: IO_File_open,IO_File_close -USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list -USE MODE_UNIFAC -! -! -!* 0. DECLARATIONS -! ------------ -! -IMPLICIT NONE -! -!* 0.1 Declarations of arguments -! -!* 0.2 Declarations of local variables -! -INTEGER, PARAMETER :: nc=22, nh=16, nt=11 ! inorganic interpolation -INTEGER :: JI, JJ, JK, JL, JM ! loop counter -INTEGER :: IRESP ! return code in FM routines -INTEGER :: ILU ! logical unit -TYPE(TFILEDATA),POINTER :: TZFILE -! -!--------------------------------------------------------------------------- -! -! -! -! 1.1 initialisation -! -TZFILE => NULL() -! -! Initialize the mineral tabulation -IF (CMINERAL == 'NARES') THEN - ALLOCATE( W1IJA(100,100), W1JKA(100,100), W2IJA(100,100), W2JKA(100,100) ) - ALLOCATE( W1IJB(100,100), W1JKB(100,100), W2IJB(100,100), W2JKB(100,100) ) - ALLOCATE( W1IJC(100,100), W1JKC(100,100), W2IJC(100,100), W2JKC(100,100) ) - ALLOCATE( X1MINA(2,100), X1MAXA(2,100), X1MODA(2,100), X2MINA(2,100), X2MAXA(2,100), X2MODA(2,100) ) - ALLOCATE( X1MINB(2,100), X1MAXB(2,100), X1MODB(2,100), X2MINB(2,100), X2MAXB(2,100), X2MODB(2,100) ) - ALLOCATE( X1MINC(2,100), X1MAXC(2,100), X1MODC(2,100), X2MINC(2,100), X2MAXC(2,100), X2MODC(2,100) ) -! .. the file ares.w contains the weights of the model - CALL IO_File_add2list(TZFILE,'ares1A.w','CHEMTAB','READ') - CALL IO_File_open(TZFILE) - ILU = TZFILE%NLU - READ(ILU,*) I1IA,J1JA,K1KA - DO JI=1,I1IA - READ(ILU,*) X1MAXA(1,JI),X1MINA(1,JI),X1MODA(1,JI) - ENDDO - DO JI=1,K1KA - READ(ILU,*) X1MAXA(2,JI),X1MINA(2,JI),X1MODA(2,JI) - ENDDO - DO JI=1,I1IA+1 - READ(ILU,*) (W1IJA(JI,JJ),JJ=1,J1JA) - ENDDO - DO JJ=1,J1JA+1 - READ(ILU,*) (W1JKA(JJ,JK),JK=1,K1KA) - ENDDO - CALL IO_File_close(TZFILE) - TZFILE => NULL() - ! - CALL IO_File_add2list(TZFILE,'ares1C.w','CHEMTAB','READ') - CALL IO_File_open(TZFILE) - ILU = TZFILE%NLU - READ(ILU,*) I1IC,J1JC,K1KC - DO JI=1,I1IC - READ(ILU,*) X1MAXC(1,JI),X1MINC(1,JI),X1MODC(1,JI) - ENDDO - DO JI=1,K1KC - READ(ILU,*) X1MAXC(2,JI),X1MINC(2,JI),X1MODC(2,JI) - ENDDO - DO JI=1,I1IC+1 - READ(ILU,*) (W1IJC(JI,JJ),JJ=1,J1JC) - ENDDO - DO JJ=1,J1JC+1 - READ(ILU,*) (W1JKC(JJ,JK),JK=1,K1KC) - ENDDO - CALL IO_File_close(TZFILE) - TZFILE => NULL() - ! - CALL IO_File_add2list(TZFILE,'ares2A.w','CHEMTAB','READ') - CALL IO_File_open(TZFILE) - ILU = TZFILE%NLU - READ(ILU,*) I2IA,J2JA,K2KA - DO JI=1,I2IA - READ(ILU,*) X2MAXA(1,JI),X2MINA(1,JI),X2MODA(1,JI) - ENDDO - DO JI=1,K2KA - READ(ILU,*) X2MAXA(2,JI),X2MINA(2,JI),X2MODA(2,JI) - ENDDO - DO JI=1,I2IA+1 - READ(ILU,*) (W2IJA(JI,JJ),JJ=1,J2JA) - ENDDO - DO JJ=1,J2JA+1 - READ(ILU,*) (W2JKA(JJ,JK),JK=1,K2KA) - ENDDO - CALL IO_File_close(TZFILE) - TZFILE => NULL() - ! - CALL IO_File_add2list(TZFILE,'ares2B.w','CHEMTAB','READ') - CALL IO_File_open(TZFILE) - ILU = TZFILE%NLU - READ(ILU,*) I2IB,J2JB,K2KB - DO JI=1,I2IB - READ(ILU,*) X2MAXB(1,JI),X2MINB(1,JI),X2MODB(1,JI) - ENDDO - DO JI=1,K2KB - READ(ILU,*) X2MAXB(2,JI),X2MINB(2,JI),X2MODB(2,JI) - ENDDO - DO JI=1,I2IB+1 - READ(ILU,*) (W2IJB(JI,JJ),JJ=1,J2JB) - ENDDO - DO JJ=1,J2JB+1 - READ(ILU,*) (W2JKB(JJ,JK),JK=1,K2KB) - ENDDO - CALL IO_File_close(TZFILE) - TZFILE => NULL() - ! - CALL IO_File_add2list(TZFILE,'ares2C.w','CHEMTAB','READ') - CALL IO_File_open(TZFILE) - ILU = TZFILE%NLU - READ(ILU,*) I2IC,J2JC,K2KC - DO JI=1,I2IC - READ(ILU,*) X2MAXC(1,JI),X2MINC(1,JI),X2MODC(1,JI) - ENDDO - DO JI=1,K2KC - READ(ILU,*) X2MAXC(2,JI),X2MINC(2,JI),X2MODC(2,JI) - ENDDO - DO JI=1,I2IC+1 - READ(ILU,*) (W2IJC(JI,JJ),JJ=1,J2JC) - ENDDO - DO JJ=1,J2JC+1 - READ(ILU,*) (W2JKC(JJ,JK),JK=1,K2KC) - ENDDO - CALL IO_File_close(TZFILE) - TZFILE => NULL() - ! -END IF -! -IF (CMINERAL == 'TABUL') THEN - IF(.NOT.ALLOCATED(rhi)) ALLOCATE(rhi(16)) - IF(.NOT.ALLOCATED(tempi)) ALLOCATE(tempi(11)) - IF(.NOT.ALLOCATED(zsu)) ALLOCATE(zsu(22)) - IF(.NOT.ALLOCATED(znh)) ALLOCATE(znh(22)) - IF(.NOT.ALLOCATED(zni)) ALLOCATE(zni(22)) - IF(.NOT.ALLOCATED(zf)) ALLOCATE(zf(16,11,22,22,22,3)) - CALL IO_File_add2list(TZFILE,'AEROMIN_NEW','CHEMTAB','READ') - CALL IO_File_open(TZFILE) - ILU = TZFILE%NLU - - WRITE(*,*) 'LOADING MINERAL AEROSOL DATA ...' - DO JI=1,nh - READ(ILU,*) rhi(JI) - ENDDO - DO JI=1,nt - READ(ILU,*) tempi(JI) - ENDDO - DO JI=1,nc - READ(ILU,*) zsu(JI) - ENDDO - DO JI=1,nc - READ(ILU,*) znh(JI) - ENDDO - DO JI=1,nc - READ(ILU,*) zni(JI) - ENDDO - DO JI=1,nh - DO JJ=1,nt - DO JK=1,nc - DO JL=1,nc - DO JM=1,nc - READ (ILU,*) zf(JI,JJ,JK,JL,JM,1:3) - ENDDO - ENDDO - ENDDO - ENDDO - ENDDO - WRITE(*,*) 'END LOADING' - CALL IO_File_close(TZFILE) - TZFILE => NULL() -ENDIF - -IF(TRIM(CORGANIC).eq."MPMPO")THEN - !Set unifac coefficients for group a - CALL AQ_UNIFAC_INI() - - !Set unifac coefficients for group b - CALL ORG_UNIFAC_INI() - - !Calculate non time varying unifac stuff for aquous phase - CALL UNIFAC_INI( & - QG_AQ & !I [m2] surface of functional groups - ,RG_AQ & !I [m3] volume of functional groups - ,NU_AQ & !I [nbr] number of functional groups in molec - ,THTAGP_AQ & !O [frc] surface fraction of group (j) in molecule (i) - ,Q_AQ & !O [m2] surface of molecule - ,R_AQ & !O [m3] volume of molecule - ,L_AQ & !O [?] UNIFAC parameter for molecule - ,NMOL_AQ & !I [nbr] number of molecules used - ,NFUNC_AQ & !I [nbr] number of functional groups used - ) - - !Calculate non time varying unifac stuff for group organic phase - CALL UNIFAC_INI( & - QG_ORG & !I [m2] surface of functional groups - ,RG_ORG & !I [m3] volume of functional groups - ,NU_ORG & !I [nbr] number of functional groups in molec - ,THTAGP_ORG & !O [frc] surface fraction of group (j) in molecule (i) - ,Q_ORG & !O [m2] surface of molecule - ,R_ORG & !O [m3] volume of molecule - ,L_ORG & !O [?] UNIFAC parameter for molecule - ,NMOL_ORG & !I [nbr] number of molecules used - ,NFUNC_ORG & !I [nbr] number of functional groups used - ) - - !Set molality of solvent in binary mix with water at several RH - CALL ZSR_INI_MPMPO() - -ELSEIF(TRIM(CORGANIC).eq."PUN")THEN - - !Set Unifac coefficients for Pun's group A - CALL AUNIFAC_INI - - !Set Unifac coefficients for Pun's group B - CALL BUNIFAC_INI - - !Calculate non time varying unifac stuff for aquous phase - CALL UNIFAC_INI( & - QG_A & !I [m2] surface of functional groups - ,RG_A & !I [m3] volume of functional groups - ,NU_A & !I [nbr] number of functional groups in molec - ,THTAGP_A & !O [frc] surface fraction of group (j) in molecule (i) - ,Q_A & !O [m2] surface of molecule - ,R_A & !O [m3] volume of molecule - ,L_A & !O [?] UNIFAC parameter for molecule - ,NMOL_A & !I [nbr] number of molecules used - ,NFUNC_A & !I [nbr] number of functional groups used - ) - - !Calculate non time varying unifac stuff for group organic phase - CALL UNIFAC_INI( & - QG_B & !I [m2] surface of functional groups - ,RG_B & !I [m3] volume of functional groups - ,NU_B & !I [nbr] number of functional groups in molec - ,THTAGP_B & !O [frc] surface fraction of group (j) in molecule (i) - ,Q_B & !O [m2] surface of molecule - ,R_B & !O [m3] volume of molecule - ,L_B & !O [?] UNIFAC parameter for molecule - ,NMOL_B & !I [nbr] number of molecules used - ,NFUNC_B & !I [nbr] number of functional groups used - ) - - !Get zsr coefficients for pun's code - CALL ZSR_INI_PUN() - - -ENDIF -! -! -END SUBROUTINE CH_AER_MOD_INIT diff --git a/src/ICCARE_BASE/ch_aer_mode_merging.f90 b/src/ICCARE_BASE/ch_aer_mode_merging.f90 deleted file mode 100644 index 25ef16b27..000000000 --- a/src/ICCARE_BASE/ch_aer_mode_merging.f90 +++ /dev/null @@ -1,176 +0,0 @@ -!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence -!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!ORILAM_LIC for details. -!! ######################### - MODULE MODI_CH_AER_MODE_MERGING -!! ######################### -!! -INTERFACE -!! - SUBROUTINE CH_AER_MODE_MERGING(PM, PLNSIG, PRG, PDMGROW, PDMMERG) - !! - IMPLICIT NONE - REAL, DIMENSION(:,:), INTENT(IN) :: PM, PLNSIG, PRG - REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMGROW - REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMMERG - !! - END SUBROUTINE CH_AER_MODE_MERGING -!! -END INTERFACE -!! -END MODULE MODI_CH_AER_MODE_MERGING -!! -!! ############################################## - SUBROUTINE CH_AER_MODE_MERGING(PM, PLNSIG, PRG, PDMGROW, PDMMERG) -!! ############################################## -!! -!! PURPOSE -!! ------- -!! If the Aitken mode mass is growing faster than accumulation mode -!! mass and the Aitken mode number concentration exceeds the -!! accumulation mode number concentration, then moments tendency -!! are adjusted. In the present developpement only moments 3 and 6 -!! based on the condensated moments are modified. -!! -!! METHOD -!! ------ -!! -!! EXTERNAL -!! -------- -!! none -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! USE MODD_CH_AEROSOL -!! -!! REFERENCE -!! --------- -!! implementation adapted from -!! -!! Binkowski and Roselle (2003). Models-3 Community Multiscale Air Quality (CMAQ) model -!! aerosol component: 1, Model description. J. Geophys. Res., 108(D6), 4183. -!! doi:10.1029/2001JD001409 -!! -!! for M3 and M6 tendencies. -!! -!! AUTHOR -!! ------ -!! Joris Pianezze (LACy) -!! -!! MODIFICATIONS -!! ------------- -!! Original 06/2018 -!! -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_CH_AEROSOL -USE MODD_CONF, ONLY : NVERB -! -IMPLICIT NONE -! -!* 0.1 Declarations of arguments -! -REAL, DIMENSION(:,:), INTENT(IN) :: PM, PLNSIG, PRG -REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMGROW -REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMMERG -! -!* 0.2 Declarations of local variables -! -INTEGER :: JI,JJ -REAL :: ZA, ZB, ZC, ZDELTA -REAL :: ZC3, ZC2, ZC1, ZQ -REAL :: ZXNUM -REAL :: ZXM0, ZXM6, ZXM3 -REAL :: ZFNUM, ZFM0, ZFM3, ZFM6 -REAL :: ZPHNUM, ZPHM0, ZPHM3, ZPHM6 -! -!------------------------------------------------------------------------------- -! -!* 1. MODE MERGING -! ------------ -! -DO JI=1,SIZE(PM,1) - ! -! IF ( PDMGROW( JI , NM3(1) ) .GT. PDMGROW( JI , NM3(2) ) ) THEN - ! - ! - !* 1.1 CALCULATE XNUM - ! -------------- - ! - ! Solve equation of Ackermann et al. 1998 - ! with xnum = ln (d/d_i) / (sqrt(2)*ln(sig_i)) - ! - ZC1 = PLNSIG(JI,1) / PLNSIG(JI,2) - ZC2 = LOG( PRG(JI,2) / PRG(JI,1) ) / ( SQRT(2.0) * PLNSIG(JI,1) ) - ZC3 = LOG( ZC1 * PM(JI,NM0(2)) / PM(JI,NM0(1)) ) - ! - ! Calculate quadratic equation coefficients & discriminant - ! Resolution with Press et al. algorithm : page 208 - ZA = 1.0 - ZC1 * ZC1 - ZB = 2.0 * ZC2 * ZC1 * ZC1 - ZC = ZC3 - ZC2 * ZC2 * ZC1 * ZC1 - ZDELTA = ZB * ZB - 4.0 * ZA * ZC - ! - ! If roots are imaginary, no mode merging takes place. - ! - IF ( ZDELTA .LT. 0.0 ) THEN - ZQ = - 5.0 - ZXNUM = 0.0 - ELSE - ZQ = - 0.5 * ( ZB + SIGN( 1.0, ZB ) * SQRT( ZDELTA ) ) - ZXNUM = ZC / ZQ - END IF - ! - !----------------------------------------------------------------------- - ! Ensure that Xnum is large enough so that no more than half of - ! the Aitken mode mass is merged into the accumulation mode during - ! any given time step. This criterion is described in Paragraph 26 - ! of Binkowski and Roselle (2003). - ! - ZXNUM = MAX( ZXNUM, 3.0 * PLNSIG(JI,1) / SQRT(2.0) ) - ! - ! - !* 1.2 MODIFCATION OF MOMENTS TENDENCY - ! ------------------------------- - ! - ZXM0 = ZXNUM - ZXM3 = ZXNUM - 3.0 * PLNSIG(JI,1) / SQRT(2.0) - ZXM6 = ZXNUM - 6.0 * PLNSIG(JI,1) / SQRT(2.0) - ! - ! Calculate the fractions of the moments 0, 3 and 6 - ! distributions with diameter greater than the intersection diameter - ! - ZFM0 = 0.5 * ERFC( ZXM0 ) ! Eq 10a of B&R 2003 - ZFM3 = 0.5 * ERFC( ZXM3 ) ! Eq 10b of B&R 2003 - ZFM6 = 0.5 * ERFC( ZXM6 ) ! Adapted to 6th moment - ! - ! Calculate the fractions of the moments 0, 3 and 6 - ! distributions with diameters less than the intersection diameter. - ! - ZPHM0 = 0.5 * ( 1.0 + ERF( ZXM0 ) ) ! Eq 10c of B&R 2003 - ZPHM3 = 0.5 * ( 1.0 + ERF( ZXM3 ) ) ! Eq 10d of B&R 2003 - ZPHM6 = 0.5 * ( 1.0 + ERF( ZXM6 ) ) ! Adapted to 6th moment - ! - ! Update accumulation-mode moment tendencies using - ! Equations 11a - 11c of Binkowski and Roselle (2003). - ! - PDMMERG(JI,NM0(2)) = PDMGROW(JI,NM0(1)) * ZFM0 - PDMMERG(JI,NM3(2)) = PDMGROW(JI,NM3(1)) * ZFM3 - PDMMERG(JI,NM6(2)) = PDMGROW(JI,NM6(1)) * ZFM6 - ! - ! Update Aitken-mode moment tendencies using - ! Equations 11d - 11f of Binkowski and Roselle (2003). - ! - PDMMERG(JI,NM0(1)) = PDMGROW(JI,NM0(1)) * (ZPHM0 - 1.0) - PDMMERG(JI,NM3(1)) = PDMGROW(JI,NM3(1)) * (ZPHM3 - 1.0) - PDMMERG(JI,NM6(1)) = PDMGROW(JI,NM6(1)) * (ZPHM3 - 1.0) - ! -! END IF - ! -END DO -! -END SUBROUTINE CH_AER_MODE_MERGING diff --git a/src/ICCARE_BASE/ch_aer_nucl.f90 b/src/ICCARE_BASE/ch_aer_nucl.f90 deleted file mode 100644 index 9f566ed1d..000000000 --- a/src/ICCARE_BASE/ch_aer_nucl.f90 +++ /dev/null @@ -1,249 +0,0 @@ -!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence -!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!ORILAM_LIC for details. -!! ######################### - MODULE MODI_CH_AER_NUCL -!! ######################### -!! -INTERFACE - !! - SUBROUTINE CH_AER_NUCL(PRH,PTEMP,PSULF,PJNUC,PJ2RAT) - IMPLICIT NONE - !! - REAL, DIMENSION(:), INTENT(IN) :: PRH,PTEMP - REAL, DIMENSION(:), INTENT(INOUT) :: PSULF - REAL, DIMENSION(:), INTENT(INOUT) :: PJNUC - REAL, DIMENSION(:), INTENT(INOUT) :: PJ2RAT - !! - END SUBROUTINE CH_AER_NUCL - !! -END INTERFACE -!! -END MODULE MODI_CH_AER_NUCL -!! -!! ############################################## - SUBROUTINE CH_AER_NUCL(PRH,PTEMP,PSULF,PJNUC,PJ2RAT) -!! ############################################## -!! -!! PURPOSE -!! ------- -!! -!! METHOD -!! ------ -!! -!! EXTERNAL -!! -------- -!! Subroutine CH_AER_KULMALA : compute nucleation rate from Kulmala et al. 1998 parametrization -!! Subroutine CH_AER_VEHKAMAKI : compute nucleation rate from Vehkamaki et al. 2002 parametrization -!! Subroutine CH_AER_MAATTANEN_NEUTRAL : compute nucleation rate from Neural Maattanen et al. 2018 parametrization -!! Subroutine CH_AER_MAATTANEN_IONIND : compute nucleation rate from Ion-induced Maattanen et al. 2018 parametrization -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! USE MODD_CH_AEROSOL -!! -!! REFERENCE -!! --------- -!! -!! AUTHOR -!! ------ -!! Brice Foucart & Joris Pianezze (LACy) -!! -!! MODIFICATIONS -!! ------------- -!! Original 06/2018 -!! -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_CST, ONLY : XAVOGADRO -USE MODI_CH_AER_KULMALA -USE MODI_CH_AER_VEHKAMAKI -USE MODI_CH_AER_MAATTANEN_NEUTRAL -USE MODI_CH_AER_MAATTANEN_IONIND -USE MODI_CH_AER_MODE_MERGING -! -USE MODD_CH_AEROSOL -USE MODD_CONF, ONLY : NVERB -! -IMPLICIT NONE -! -!* 0.1 Declarations of arguments -! -REAL, DIMENSION(:), INTENT(IN) :: PRH,PTEMP -REAL, DIMENSION(:), INTENT(INOUT) :: PSULF -REAL, DIMENSION(:), INTENT(INOUT) :: PJNUC -REAL, DIMENSION(:), INTENT(INOUT) :: PJ2RAT -! -!* 0.2 Declarations of local variables -! -REAL, DIMENSION(SIZE(PSULF,1)) :: ZRCN, ZRCI ! Critical cluster in m (neutral and ion-ind) -REAL, DIMENSION(SIZE(PSULF,1)) :: ZRCN2, ZRCI2 ! Diameter of critical cluster in nm (neutral and ion-ind) -REAL, DIMENSION(SIZE(PSULF,1)) :: ZLKKN, ZLKKI ! Final scaling factor from Lehtinen et al., 2007 (neutral and ion-ind) -REAL, DIMENSION(SIZE(PSULF,1)) :: ZJNUCN, ZJNUCI ! Nucleation rate in part.cm-3.s-1 (neutral and ion-ind) -REAL, DIMENSION(SIZE(PSULF,1)) :: ZJ2RATN, ZJ2RATI ! Nucleation rate for 2 nm in part.cm-3.s-1 (neutral and ion-ind) -REAL, DIMENSION(SIZE(PSULF,1)) :: ZSULF ! Sulfuric acid concentration in molec.cm-3 -REAL, DIMENSION(SIZE(PSULF,1)) :: ZGR ! Particle Growth Rate according to Nieminen et al., 2010 (nm.h-1) -REAL, DIMENSION(SIZE(PSULF,1)) :: ZGAMMA ! Gamma -REAL :: ZCS ! Typical CS value in atmosphere in 1/h -REAL :: ZMAV ! Average m-value according to Lehtinen et al., 2007 -REAL :: ZTSIZE ! Target size (in geometric diameter = mobility diameter -0.3nm). -! -!------------------------------------------------------------------------------- -! -!* 1. DEFINE VARIABLES FOR J2 (particle formation rate) -! ----------------------------------------------- -! -! [ Please, note that these calculations can fe found in the supplementary Fortran code of Maattanen et al., 2018 ] -! -! a) H2SO4 conversion from ug.m-3 to molec.cm-3 -! -!ZSULF(:) = PSULF(:)*(XAVOGADRO*1.E-12) / XH2SO4 -! -! b) Growth rate calculation -! -!ZMAV = -1.6 ! It can also be calculated -! -! -!ZGR(:) = ZSULF(:) / (661.1 * (PRH(:) * 100)**2 - 1.129E5 * (PRH(:)*100) + 1.549E7) -! -! -! c) Condensation sink imposition -! -!ZCS = 22. ! It can also be calculated -! -! d) Target size (here 2 so 2 - 0.3 = 1.7) -! -!ZTSIZE = 1.7 ! We want a J2nm so 2nm -0.3 = 1.7 nm -! -! -!* 2. NUCLEATION PARAMETRIZATIONS -! --------------------------- -! -! [ Please, note that Kulmala et al., 1998 and Vehkamaki et al., 2002 are neutral parametrizations ] -! -! -!IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_NUCL PSULF (deb) =',PSULF -! -IF (CNUCLEATION == 'KULMALA') THEN - ! - CALL CH_AER_KULMALA(PRH, PTEMP, PSULF, PJNUC, ZRCN) - ! - ! J2 (J2RAT) calculation for Kulmala: - ! - !ZRCN2(:) = 2. * ZRCN(:) * 1.E9 - ! - !ZGAMMA(:) = max( 0.0, 1.0 / (ZMAV+1) * ((ZTSIZE /(ZRCN2(:)))**(ZMAV+1) -1) ) - ! - !ZLKKN(:) = exp(-ZGAMMA(:) * ZRCN2(:) * ZCS / ZGR(:)) ! Final scaling factor - ! - !PJ2RAT(:) = PJNUC(:) * ZLKKN(:) - ! -ELSE IF (CNUCLEATION == 'VEHKAMAKI') THEN - ! - CALL CH_AER_VEHKAMAKI(PRH, PTEMP, PSULF, PJNUC, ZRCN) - ! - ! J2 (J2RAT) calculation for Vehkamaki: - ! - !ZRCN2(:) = 2. * ZRCN(:) * 1.E9 - ! - !ZGAMMA(:) = max( 0.0, 1.0 / (ZMAV+1) * ((ZTSIZE /(ZRCN2(:)))**(ZMAV+1) -1) ) - ! - !ZLKKN(:) = exp(-ZGAMMA(:) * ZRCN2(:) * ZCS / ZGR(:)) ! Final scaling factor - ! - !PJ2RAT(:) = PJNUC(:) * ZLKKN(:) - ! -ELSE IF (CNUCLEATION == 'MAATTANEN_NEUTRAL') THEN - ! - ! Define ZJNUCN - ! - ZJNUCN(:) = PJNUC(:) - ! - CALL CH_AER_MAATTANEN_NEUTRAL(PRH, PTEMP, PSULF, ZJNUCN, ZRCN) - ! - PJNUC(:) = ZJNUCN(:) - ! - ! J2 (J2RAT) calculation for Maattanen neutral: - ! - !ZRCN2(:) = 2. * ZRCN(:) * 1.E9 - ! - !ZGAMMA(:) = max( 0.0, 1.0 / (ZMAV+1) * ((ZTSIZE /(ZRCN2(:)))**(ZMAV+1) -1) ) - ! - !ZLKKN(:) = exp(-ZGAMMA(:) * ZRCN2(:) * ZCS / ZGR(:)) ! Final scaling factor - ! - !PJ2RAT(:) = PJNUC(:) * ZLKKN(:) - ! -ELSE IF (CNUCLEATION == 'MAATTANEN_IONIND') THEN - ! - ! Define ZJNUCI - ! - ZJNUCI(:) = PJNUC(:) - ! - CALL CH_AER_MAATTANEN_IONIND(PRH, PTEMP, PSULF, ZJNUCI, ZRCI) - ! - PJNUC(:) = ZJNUCI(:) - ! - ! J2 (J2RAT) calculation for Maattanen ion-ind: - ! - !ZRCI2(:) = 2. * ZRCI(:) * 1.E9 - ! - !ZGAMMA(:) = max( 0.0, 1.0 / (ZMAV+1) * ((ZTSIZE /(ZRCI2(:)))**(ZMAV+1) -1) ) - ! - !ZLKKI(:) = exp(-ZGAMMA(:) * ZRCI2(:) * ZCS / ZGR(:)) ! Final scaling factor - ! - !PJ2RAT(:) = PJNUC(:) * ZLKKI(:) - ! -ELSE IF (CNUCLEATION == 'MAATTANEN_BOTH') THEN - ! - ! Define ZJNUCN - ! - ZJNUCN(:) = PJNUC(:) - ! - CALL CH_AER_MAATTANEN_NEUTRAL(PRH, PTEMP, PSULF, ZJNUCN, ZRCN) - ! - ! J2 (J2RAT) calculation for Maattanen neutral: - ! - !ZRCN2(:) = 2. * ZRCN(:) * 1.E9 - ! - !ZGAMMA(:) = max( 0.0, 1.0 / (ZMAV+1) * ((ZTSIZE /(ZRCN2(:)))**(ZMAV+1) -1) ) - ! - !ZLKKN(:) = exp(-ZGAMMA(:) * ZRCN2(:) * ZCS / ZGR(:)) ! Final scaling factor - ! - !ZJ2RATN(:) = ZJNUCN(:) * ZLKKN(:) - ! - ! Define ZJNUCI - ! - ZJNUCI(:) = PJNUC(:) - ! - CALL CH_AER_MAATTANEN_IONIND(PRH, PTEMP, PSULF, ZJNUCI, ZRCI) - ! - ! J2 (J2RAT) calculation for Maattanen ion-ind: - ! - !ZRCI2(:) = 2. * ZRCI(:) * 1.E9 - ! - !ZGAMMA(:) = max( 0.0, 1.0 / (ZMAV+1) * ((ZTSIZE /(ZRCI2(:)))**(ZMAV+1) -1) ) - ! - !ZLKKI(:) = exp(-ZGAMMA(:) * ZRCI2(:) * ZCS / ZGR(:)) ! Final scaling factor - ! - !ZJ2RATI(:) = ZJNUCI(:) * ZLKKI(:) - ! - ! New particle formation rates addition - ! - PJNUC(:) = ZJNUCN(:) + ZJNUCI(:) - ! - !PJ2RAT(:) = ZJ2RATN(:) + ZJ2RATI(:) - ! -END IF -! -PJ2RAT(:) = 1E-7 -! -IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_NUCL PJNUC =',PJNUC -IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_NUCL PSULF (fin) =',PSULF -IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_NUCL ZJNUCI =',ZJNUCI -IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_NUCL ZJNUCN =',ZJNUCN - -! -END SUBROUTINE CH_AER_NUCL diff --git a/src/ICCARE_BASE/ch_aer_solv.f90 b/src/ICCARE_BASE/ch_aer_solv.f90 deleted file mode 100644 index e64c026e9..000000000 --- a/src/ICCARE_BASE/ch_aer_solv.f90 +++ /dev/null @@ -1,434 +0,0 @@ -!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence -!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!ORILAM_LIC for details. -!----------------------------------------------------------------- -!--------------- special set of characters for RCS information -!----------------------------------------------------------------- -! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/ch_aer_solv.f90,v $ $Revision: 1.1.2.1.2.1.16.2.2.1.2.1 $ $Date: 2015/12/01 15:26:23 $ -!----------------------------------------------------------------- -!----------------------------------------------------------------- -!! ####################### - MODULE MODI_CH_AER_SOLV -!! ####################### -!! -INTERFACE -!! -SUBROUTINE CH_AER_SOLV(PM, PLNSIG, PRG, PN,PCTOTG, PCTOTA, PCCTOT, & - PDMINTRA,PDMINTER,PDMCOND, PDMNUCL, PDMMERG, PSEDA,PDT, & - PRV, PDENAIR, PPRESSURE, PTEMP, PRC, PTIME,PSOLORG, & - PMBEG,PMINT,PMEND) -IMPLICIT NONE -REAL, DIMENSION(:,:), INTENT(INOUT) :: PM -REAL, DIMENSION(:,:), INTENT(INOUT) :: PSEDA -REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMINTRA -REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMINTER -REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMCOND -REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMNUCL -REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMMERG -REAL, DIMENSION(:,:), INTENT(INOUT) :: PLNSIG, PRG, PN -REAL, DIMENSION(:,:), INTENT(INOUT) :: PCTOTG -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCTOTA, PCCTOT -REAL, DIMENSION(:,:), INTENT(INOUT) :: PSOLORG -REAL, INTENT(IN) :: PDT, PTIME -REAL, DIMENSION(:), INTENT(IN) :: PRV, PDENAIR, PPRESSURE, PTEMP, PRC -REAL, DIMENSION(:,:), INTENT(INOUT) :: PMBEG,PMINT,PMEND -END SUBROUTINE CH_AER_SOLV -!! -END INTERFACE -!! -END MODULE MODI_CH_AER_SOLV -!! -!! ############################################################################## - SUBROUTINE CH_AER_SOLV(PM, PLNSIG, PRG, PN,PCTOTG, PCTOTA, PCCTOT, & - PDMINTRA,PDMINTER,PDMCOND,PDMNUCL,PDMMERG,PSEDA, PDT, & - PRV, PDENAIR, PPRESSURE, PTEMP, PRC, PTIME,PSOLORG, & - PMBEG,PMINT,PMEND) -!! ############################################################################## -!! -!! PURPOSE -!! ------- -!! Time variable solver of the modal aerosol equations -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Vincent Crassier (LA) -!! -!! MODIFICATIONS -!! ------------- -!! P. Tulet for nesting -!! P. Tulet organic condensation -!! P. Tulet thermodynamic equilibrium for each mode -!! P. Tulet add third mode -!! M. Leriche 2015 correction bug -!! M. Leriche 08/16 suppress moments index declaration already in modd_aerosol -!! M. Leriche 08/16 add an other particular case for the M0 resolution to -!! avoid a division by zero (when ZK = 1) -!! J. Pianezze : 10/2018 add comments and simplification -!! -!! EXTERNAL -!! -------- -!! -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_CH_AEROSOL -USE MODD_CST, ONLY : XMNH_TINY -USE MODD_CONF, ONLY : NVERB -USE MODI_CH_AER_MINERAL -USE MODI_CH_AER_ORGANIC -USE MODI_CH_AER_MPMPO -! -IMPLICIT NONE -! -!* 0.1 declarations of arguments -! -REAL, DIMENSION(:,:), INTENT(INOUT) :: PM -REAL, DIMENSION(:,:), INTENT(INOUT) :: PSEDA -REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMINTRA -REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMINTER -REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMCOND -REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMNUCL -REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMMERG -REAL, DIMENSION(:,:), INTENT(INOUT) :: PLNSIG, PRG, PN -REAL, DIMENSION(:,:), INTENT(INOUT) :: PCTOTG -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCTOTA, PCCTOT -REAL, INTENT(IN) :: PDT, PTIME -REAL, DIMENSION(:), INTENT(IN) :: PRV, PDENAIR, PPRESSURE, PTEMP, PRC -REAL, DIMENSION(:,:), INTENT(INOUT) :: PSOLORG -REAL, DIMENSION(:,:), INTENT(INOUT) :: PMBEG,PMINT,PMEND -! -!* 0.2 declarations of local variables -! -INTEGER :: JI,JJ,JK, JN, IDT -REAL, DIMENSION(SIZE(PM,1)) :: ZSUM -REAL, DIMENSION(SIZE(PM,1),JPMODE) :: ZOM,ZMASK -REAL, DIMENSION(SIZE(PM,1)) :: ZSIGMA -! -REAL, DIMENSION(SIZE(PM,1)) :: ZA,ZB,ZC,ZD -REAL, DIMENSION(SIZE(PM,1)) :: ZCONST1,ZCONST2 -REAL, DIMENSION(SIZE(PM,1)) :: Z0,ZK,ZKEXP -! -REAL, SAVE, DIMENSION(JPMODE*3) :: ZPMIN -REAL, SAVE, DIMENSION(JPMODE) :: ZRATIOBC, ZRATIOOC -REAL :: ZINIRADIUSI, ZINIRADIUSJ -! -!------------------------------------------------------------------------------- -! -!* 1. INITIALIZATION -! -------------- -! -PMBEG(:,:)=PM(:,:) -! -IF (CRGUNIT=="MASS") THEN - ZINIRADIUSI = XINIRADIUSI * EXP(-3.*(LOG(XINISIGI))**2) - ZINIRADIUSJ = XINIRADIUSJ * EXP(-3.*(LOG(XINISIGJ))**2) -ELSE - ZINIRADIUSI = XINIRADIUSI - ZINIRADIUSJ = XINIRADIUSJ -END IF -! -ZPMIN(1) = XN0IMIN -ZPMIN(2) = ZPMIN(1) * (ZINIRADIUSI**3)*EXP(4.5 * LOG(XINISIGI)**2) -ZPMIN(3) = ZPMIN(1) * (ZINIRADIUSI**6)*EXP(18. * LOG(XINISIGI)**2) -! -ZPMIN(4) = XN0JMIN -ZPMIN(5) = ZPMIN(4) * (ZINIRADIUSJ**3)*EXP(4.5 * LOG(XINISIGJ)**2) -ZPMIN(6) = ZPMIN(4) * (ZINIRADIUSJ**6)*EXP(18. * LOG(XINISIGJ)**2) -! -!------------------------------------------------------------------------------- -! -!* 2. SOLVE MOMENT DYNAMIC EQUATIONS -! ------------------------------ -! -DO JI=1,JPMODE - ! - !* 2.1 MOMENT 0 - ! - !************************************************************* - ! Resolution du moment d'ordre 0: pour cela il faut resoudre - ! une equation differentielle du type dY/dt=-AY^2-BY+C - ! these Crassier page 42 - !************************************************************* - ! - ! Pour la resolution plusieurs cas particuliers seront traites - ZA(:) = 0.0 - ZB(:) = 0.0 - ZC(:) = 0.0 - ZA(:) = -PDMINTRA(:,NM0(JI)) / (PM(:,NM0(JI))**2.0) - ZB(:) = -PDMINTER(:,NM0(JI)) / PM(:,NM0(JI)) - ZC(:) = PDMCOND (:,NM0(JI)) + PDMNUCL(:,NM0(JI)) - ! - DO JK=1,SIZE(PM,1) - IF ( (ZA(JK) == 0.) .AND. (ZB(JK) == 0.) ) THEN - IF (NVERB .GE. 10) WRITE(*,*) '~~~ CH_AER_SOLV 1.1 : IF 2' - PM(JK,NM0(JI)) = PM(JK,NM0(JI)) + ZC(JK) * PDT - ELSE IF ((ZB(JK) == 0. .AND. ZC(JK)/PM(JK,NM0(JI)) <= 1.e-10).OR. & - (ZC(JK) <= 1.e-10 .AND. ZB(JK)/ZA(JK) <= 1.e-3)) THEN - IF (NVERB .GE. 10) WRITE(*,*) '~~~ CH_AER_SOLV 1.1 : IF 1' - ! type dY/dt=-AY^2 - Z0(JK)=PM(JK,NM0(JI)) - PM(JK,NM0(JI))=Z0(JK)/(1.+ZA(JK)*Z0(JK)*PDT) - ELSE - IF (NVERB .GE. 10) WRITE(*,*) '~~~ CH_AER_SOLV 1.1 : IF 3' - ZCONST1(JK)=ZB(JK)/(2.*ZA(JK)) - Z0(JK)=PM(JK,NM0(JI))+ZCONST1(JK) - IF (((ZB(JK)**2+4.*ZA(JK)*ZC(JK))) < 0.) THEN - ZD(JK)=SQRT(ABS(ZB(JK)**2+4.*ZA(JK)*ZC(JK))) - PM(JK,NM0(JI))=-ZCONST1(JK)+ZD(JK)*TAN(ATAN(Z0(JK)/ZD(JK))-ZA(JK)*ZD(JK)*PDT) - ELSE - ZD(JK)=SQRT(ZB(JK)**2+4.*ZA(JK)*ZC(JK)) - ZCONST2(JK)=ZD(JK)/(2.*ABS(ZA(JK))) - ZKEXP(JK)=EXP(-2.*ZA(JK)*ZCONST2(JK)*PDT) - ZK(JK)=(Z0(JK)-ZCONST2(JK))/(Z0(JK)+ZCONST2(JK))*ZKEXP(JK) - PM(JK,NM0(JI))=-ZCONST1(JK)+ZCONST2(JK)*(1.+ZK(JK))/(1.-ZK(JK)) - ENDIF - ENDIF - ENDDO - ! - PM(:,NM0(JI)) = PM(:,NM0(JI)) + (PDMMERG(:,NM0(JI)) + PSEDA(:,NM0(JI))) * PDT - PM(:,NM0(JI))= MAX(PM(:,NM0(JI)), XMNH_TINY ) - ! - !************************************************************* - ! Resolution du moment d'ordre 3 - ! eq. diff. de type dY/dt = K - !************************************************************* - ! - PM(:,NM3(JI))=PM(:,NM3(JI))+ & - (PDMINTRA(:,NM3(JI))+PDMINTER(:,NM3(JI))+PDMCOND(:,NM3(JI))+& - PDMNUCL(:,NM3(JI))+PDMMERG(:,NM3(JI))+PSEDA(:,NM3(JI)))*PDT - ! - PM(:,NM3(JI))= MAX(PM(:,NM3(JI)), XMNH_TINY) - ! - !************************************************************* - ! Resolution du moment d'ordre 6 - ! eq. diff. de type dY/dt = K - !************************************************************* - ! - PM(:,NM6(JI))=PM(:,NM6(JI))+ & - (PDMINTRA(:,NM6(JI))+PDMINTER(:,NM6(JI))+PDMCOND(:,NM6(JI))+& - PDMNUCL(:,NM6(JI))+PDMMERG(:,NM6(JI))+PSEDA(:,NM6(JI)) )*PDT - ! - PM(:,NM6(JI))= MAX(PM(:,NM6(JI)), XMNH_TINY) - ! -ENDDO -! -!------------------------------------------------------------------------------- -! -!* 3. CHEMICAL EQUILIBRIUM -! -------------------- -! -!****************************************************************** -! Calcul de la variation de concentration des differents -! composes pour trouver le nouveau moment d'ordre 3 -!****************************************************************** -! -DO JI=1,JPMODE - ! - ! Coagulation intermodale - !------------------------- - ! - DO JJ=1,NSP+NCARB+NSOA - ! - PCTOTA(:,JJ,JI)=PCTOTA(:,JJ,JI) & - +(PCCTOT(:,JJ,1)*PDMINTER(:,NM3(JI)) + PCCTOT(:,JJ,JI)* PDMINTRA(:,NM3(JI))) & - *XFAC(JJ)*PDT - ! - ! Sedimentation - !-------------- - PCTOTA(:,JJ,JI)= PCTOTA(:,JJ,JI) + PCCTOT(:,JJ,JI)*PSEDA(:,NM3(JI))*XFAC(JJ)*PDT - PCTOTA(:,JJ,JI)= MAX(PCTOTA(:,JJ,JI), XMNH_TINY) - ! - ENDDO - ! -ENDDO -! -! H2SO4 Condensation + Nucleation -!--------------------------------- -! -PCTOTA(:,JP_AER_SO4,1)=PCTOTA(:,JP_AER_SO4,1) & - +(PDMCOND(:,NM3(1))+PDMNUCL(:,NM3(1))+PDMMERG(:,NM3(1)))*XFAC(JP_AER_SO4)*PDT -PCTOTA(:,JP_AER_SO4,2)=PCTOTA(:,JP_AER_SO4,2) & - +(PDMCOND(:,NM3(2))+PDMNUCL(:,NM3(2))+PDMMERG(:,NM3(2)))*XFAC(JP_AER_SO4)*PDT -! -!************************************************************* -! Calcul de la fraction massique entre les modes -!************************************************************* -ZSUM (:) = 0. -DO JI=1,JPMODE - DO JJ=1,NSP+NCARB+NSOA - ZSUM (:) = ZSUM (:) + PCTOTA(:,JJ,JI) - ENDDO -ENDDO -ZOM(:,:) = 0. -DO JI=1,JPMODE - DO JJ=1,NSP+NCARB+NSOA - ZOM(:,JI) = ZOM(:,JI) + PCTOTA(:,JJ,JI) / ZSUM (:) - ENDDO -ENDDO -! -! Equilibre mineraux -!------------------- -! -IDT = INT(MAX(5.*PDT,1.)) -! -IF ((PDT .GT. 0.).AND.( MOD(INT(PTIME) , IDT) .EQ. 0)) THEN - CALL CH_AER_MINERAL(PCTOTG, PCTOTA,PRV, PDENAIR, PPRESSURE, PTEMP, PRC, ZOM,& - PCCTOT) - ! - ! Equilibre Organiques - !--------------------- - ! - IF (NSOA .EQ. 10) CALL CH_AER_ORGANIC(PCTOTG, PCTOTA,PRV, PDENAIR, & - PPRESSURE, PTEMP,& - PRC, ZOM, PCCTOT,PLNSIG, PRG, PDT, PSOLORG) - ! -END IF -! -! Forced mass need to be positive -PCTOTA(:,:,:) = MAX(PCTOTA(:,:,:), 0.0) -PCTOTG(:,:) = MAX(PCTOTG(:,:) , 0.0) -! -DO JI=1,JPMODE - ZSUM(:)=0. - DO JJ=1,NSP+NCARB+NSOA - ZSUM(:)=ZSUM(:)+PCTOTA(:,JJ,JI)/XRHOI(JJ) - ENDDO - ! - DO JJ=1,NSP+NCARB+NSOA - PCCTOT(:,JJ,JI)=PCTOTA(:,JJ,JI)/XRHOI(JJ)/ZSUM(:) - ENDDO -ENDDO -! -PMINT(:,:)=PM(:,:) -! -! -!------------------------------------------------------------------------------- -! -!* 4. ADJUSTEMENT OF AEROSOL DISTRIBUTION AFTER CHEMICAL EQUILIBRIUM -! -------------------------------------------------------------- -! -! -!****************************************************************************** -! Calcul des nouveaux moments d'ordre 3 et 6 -! Le moment d'ordre 3 est recalcule a partir de la composition de chaque mode -! Le moment d'ordre 6 est calcule pour garder sigma constant pendant l'equilibre chimique -!****************************************************************************** -! -! 4.1 COMPUTATION OF THE NEW SIGMA -! ---------------------------- -! -DO JN=1,JPMODE - ! - IF (JN .EQ. 1) THEN - ! - IF (LVARSIGI) THEN ! variable dispersion for mode 1 - ! - ZSIGMA(:) = PM(:,NM3(JN))**2./(PM(:,NM0(JN))*PM(:,NM6(JN))) - ZSIGMA(:) = MIN(1-1E-10,ZSIGMA(:)) - ZSIGMA(:) = MAX(1E-10,ZSIGMA(:)) - ZSIGMA(:) = LOG(ZSIGMA(:)) - ZSIGMA(:) = EXP(1./3.*SQRT(-ZSIGMA(:))) - ! - WHERE (ZSIGMA(:) > XSIGIMAX) - ZSIGMA(:) = XSIGIMAX - END WHERE - ! - WHERE (ZSIGMA(:) < XSIGIMIN) - ZSIGMA(:) = XSIGIMIN - END WHERE - ! - ELSE ! fixed dispersion for mode 1 - ZSIGMA(:) = XINISIGI - END IF - END IF - ! - IF (JN .EQ. 2) THEN - ! - IF (LVARSIGJ) THEN ! variable dispersion for mode 2 - ! - ZSIGMA(:) = PM(:,NM3(JN))**2./(PM(:,NM0(JN))*PM(:,NM6(JN))) - ZSIGMA(:) = MIN(1-1E-10,ZSIGMA(:)) - ZSIGMA(:) = MAX(1E-10,ZSIGMA(:)) - ZSIGMA(:) = LOG(ZSIGMA(:)) - ZSIGMA(:) = EXP(1./3.*SQRT(-ZSIGMA(:))) - ! - WHERE (ZSIGMA(:) > XSIGJMAX) - ZSIGMA(:) = XSIGJMAX - END WHERE - ! - WHERE (ZSIGMA(:) < XSIGJMIN) - ZSIGMA(:) = XSIGJMIN - END WHERE - ! - ELSE ! fixed dispersion for mode 2 - ZSIGMA(:) = XINISIGJ - END IF - END IF - ! - PLNSIG(:,JN) = LOG(ZSIGMA(:)) - ! -END DO -! -! -! 4.2 COMPUTATION OF THE MOMENT 3 AFTER CHEMICAL EQUILIBRIUM -! ------------------------------------------------------ -! -DO JN=1,JPMODE - ZSUM(:)=0.0 - DO JJ=1,NSP+NCARB+NSOA - ZSUM(:) = ZSUM(:)+PCTOTA(:,JJ,JN)/XFAC(JJ) - ENDDO - PM(:,NM3(JN))=ZSUM(:) -END DO -! -! -! 4.2 COMPUTATION OF THE MOMENT 6 AFTER CHEMICAL EQUILIBRIUM -! ------------------------------------------------------ -! -DO JN=1,JPMODE - PM(:,NM6(JN)) = PM(:,NM0(JN)) & - * ( (PM(:,NM3(JN))/PM(:,NM0(JN)))**(1./3.) * EXP(-(3./2.)*PLNSIG(:,JN)**2))**6 & - * EXP(18.*PLNSIG(:,JN)**2) -ENDDO -! -!------------------------------------------------------------------------------- -! -!* 5. TO AVOID VALUES BELOW MINIMUM REQUIRED -! -------------------------------------- -! -!************************************************************* -! Blindages pour valeurs inferieurs au mininmum accepte -!************************************************************* -! -DO JN=1,JPMODE - ZMASK(:,JN) = 1. - WHERE ((PM(:,NM0(JN)) .LT. ZPMIN(NM0(JN))).OR.& - (PM(:,NM3(JN)) .LT. ZPMIN(NM3(JN))).OR.& - (PM(:,NM6(JN)) .LT. ZPMIN(NM6(JN)))) - - PM(:,NM0(JN)) = ZPMIN(NM0(JN)) - PM(:,NM3(JN)) = ZPMIN(NM3(JN)) - PM(:,NM6(JN)) = ZPMIN(NM6(JN)) - - ZMASK(:,JN) = 0. - END WHERE - DO JJ=1,NSP+NCARB+NSOA - PCTOTA(:,JJ,JN) = PCTOTA(:,JJ,JN) * ZMASK(:,JN) - ENDDO - WHERE (ZMASK(:,JN) == 0.) - PCTOTA(:,JP_AER_BC,JN) = 0.5 * ZPMIN(NM3(JN)) * XFAC(JP_AER_BC) - PCTOTA(:,JP_AER_OC,JN) = 0.5 * ZPMIN(NM3(JN)) * XFAC(JP_AER_OC) - END WHERE - ! -ENDDO -! -PMEND(:,:)=PM(:,:) -! -END SUBROUTINE CH_AER_SOLV diff --git a/src/ICCARE_BASE/ch_aer_vehkamaki.f90 b/src/ICCARE_BASE/ch_aer_vehkamaki.f90 deleted file mode 100644 index 1ffc4e276..000000000 --- a/src/ICCARE_BASE/ch_aer_vehkamaki.f90 +++ /dev/null @@ -1,216 +0,0 @@ -!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence -!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!ORILAM_LIC for details. -!----------------------------------------------------------------- -!--------------- special set of characters for RCS information -!----------------------------------------------------------------- -! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/ch_aer_nucl.f90,v $ $Revision: 1.1.4.1.18.1 $ -! MASDEV4_7 chimie 2006/05/18 13:07:25 -!----------------------------------------------------------------- -!! ################################ -MODULE MODI_CH_AER_VEHKAMAKI -!! ################################ -!! -INTERFACE - !! - SUBROUTINE CH_AER_VEHKAMAKI(PRH,PTEMP,PSULF,PJNUC,PRC) - IMPLICIT NONE - !! - REAL, DIMENSION(:), INTENT(IN) :: PRH, PTEMP, PSULF - REAL, DIMENSION(:), INTENT(INOUT) :: PJNUC, PRC - !! - END SUBROUTINE CH_AER_VEHKAMAKI - !! -END INTERFACE -!! -END MODULE MODI_CH_AER_VEHKAMAKI -!! -!! ######################################################################### -SUBROUTINE CH_AER_VEHKAMAKI(PRH,PTEMP,PSULF,PJNUC,PRC) -!! ######################################################################### -!! -!! PURPOSE -!! ------- -!! -!! Compute nucleation rate for binary sulfate/H2O -!! This is the Vhekamaki parametrization (2002) -!! -!! Valid for : -!! 230.15 < T < 305.15 (K) -!! 0.01 < RH < 100 (%) -!! 10â´ < [H2SO4]gas < 10¹¹ (molec/cm3) -!! -!! -!! AUTHOR -!! ------ -!! B. Foucart (18/06/2018) -!! -!! MODIFICATIONS -!! ------------- -!! -!---------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_CONF , ONLY : NVERB -USE MODD_CH_AEROSOL -! -! -IMPLICIT NONE -! -!* 0.1 Declarations of arguments : -! -REAL, DIMENSION(:), INTENT(IN) :: PRH,PTEMP, PSULF -REAL, DIMENSION(:), INTENT(INOUT) :: PJNUC, PRC ! Nucleation rate (#/cm3/s) , Radius of the critical cluster (nm) -! -!* 0.2 Declarations of local variables : -! -REAL, DIMENSION(SIZE(PSULF,1)) :: ZCOJA,ZCOJB,ZCOJC,ZCOJD,ZCOJE,ZCOJF,ZCOJG,ZCOJH,ZCOJI,ZCOJJ -REAL, DIMENSION(SIZE(PSULF,1)) :: ZCOENA,ZCOENB,ZCOENC,ZCOEND,ZCOENE,ZCOENF,ZCOENG,ZCOENH,ZCOENI,ZCOENJ -REAL, DIMENSION(SIZE(PSULF,1)) :: ZSULF -REAL, DIMENSION(SIZE(PSULF,1)) :: ZNTOT,ZRC,ZAL -REAL, PARAMETER :: ZCSTAVOG = 6.0221367E+11 ! Avogadro number -INTEGER :: II, ITEST -! -!---------------------------------------------------------------------------- -! -! Parameters initialization -! -ZSULF(:) = 1.E4 ! must vary between 10E4 and 10E11 -ZAL(:) = 0.17 ! must vary between 0.17 and 0.62 -PJNUC(:) = 1E-7 ! must vary between 10E-7 and 10E9 cm3.s-1 -PRC(:) = 0.35 ! must vary between 0.35 and 0.92 nm -ZNTOT(:) = 10. ! must vary between 4 and 70 molecules -ZCOJA(:) = 0. -ZCOJB(:) = 0. -ZCOJC(:) = 0. -ZCOJD(:) = 0. -ZCOJE(:) = 0. -ZCOJF(:) = 0. -ZCOJG(:) = 0. -ZCOJH(:) = 0. -ZCOJI(:) = 0. -ZCOJJ(:) = 0. -ZCOENA(:) = 0. -ZCOENB(:) = 0. -ZCOENC(:) = 0. -ZCOEND(:) = 0. -ZCOENE(:) = 0. -ZCOENF(:) = 0. -ZCOENG(:) = 0. -ZCOENH(:) = 0. -ZCOENI(:) = 0. -ZCOENJ(:) = 0. -! -! **** Define a local variable for PSUFL that we convert in to molec/cm3 for calculations **** -! -! a. Restrictions for nucleation - -! -! ZSULF(:) = MAX(MIN(PSULF(:),1.E11), 0.) -! - ZSULF(:) = PSULF(:) -! -! b. ZSULF from ug/m3 to molec/cm3 -! - ZSULF(:) = ZSULF(:)*ZCSTAVOG / XH2SO4 -! -!---------------------------------------------------------------------------- -! -!! **** START Vehkamaki calculations **** -! -ITEST = 0. -! -! Conditions -! -WHERE ((ZSULF(:) > 1.E4 .AND. ZSULF(:) < 1.E11).AND.(PRH(:) > 0.01).AND.(PTEMP(:)>230.15)) -! -! 1) Mole fraction of H2SO4 in the critical cluster (no unity) -! -ZAL(:) = 0.740997-0.00266379*PTEMP(:)-& - 0.00349998*LOG(ZSULF(:))+0.0000504022*PTEMP(:)*LOG(ZSULF(:))+& - 0.00201048*LOG(PRH(:))-0.000183289*PTEMP(:)*LOG(PRH(:))+& - 0.00157407*(LOG(PRH(:)))**2-0.0000179059*PTEMP(:)*(LOG(PRH(:)))**2+& - 0.000184403*(LOG(PRH(:)))**3-1.50345E-6*PTEMP(:)*LOG(PRH(:))**3 -! -! 2) Coefficient calculations for the NUCLEATION RATE (function of temperature and mole fraction) -! -ZCOJA(:) = 0.14309+2.21956*PTEMP(:)-0.0273911*(PTEMP(:))**2+& - 0.0000722811*(PTEMP(:))**3+(5.91822/ZAL(:)) -! -ZCOJB(:) = 0.117489+0.462532*PTEMP(:)-0.0118059*(PTEMP(:))**2+& - 0.0000404196*(PTEMP(:))**3+(15.7963/ZAL(:)) -! -ZCOJC(:) = -0.21554-0.0810269*PTEMP(:)+0.001143581*(PTEMP(:))**2-& - 4.7758E-6*(PTEMP(:))**3-(2.91297/ZAL(:)) -! -ZCOJD(:) = -3.58856+0.049508*PTEMP(:)-0.00021382*(PTEMP(:))**2+& - 3.10801E-7*(PTEMP(:))**3-(0.0293333/ZAL(:)) -! -ZCOJE(:) = 1.14598-0.600796*PTEMP(:)+0.00864245*(PTEMP(:))**2-& - 0.0000228947*(PTEMP(:))**3-(8.44985/ZAL(:)) -! -ZCOJF(:) = 2.15855+0.0808121*PTEMP(:)-0.000407382*(PTEMP(:))**2-& - 4.01957E-7*(PTEMP(:))**3+(0.721326/ZAL(:)) -! -ZCOJG(:) = 1.6241-0.0160106*PTEMP(:)+0.0000377124*(PTEMP(:))**2+& - 3.21794E-8*(PTEMP(:))**3-(0.0113255/ZAL(:)) -! -ZCOJH(:) = 9.71682-0.115048*PTEMP(:)+0.000157098*(PTEMP(:))**2+& - 4.00914E-7*(PTEMP(:))**3+(0.71186/ZAL(:)) -! -ZCOJI(:) = -1.05611+0.00903378*PTEMP(:)-0.0000198417*(PTEMP(:))**2+& - 2.46048E-8*(PTEMP(:))**3-(0.0579087/ZAL(:)) -! -ZCOJJ(:) = -0.148712+0.00283508*PTEMP(:)-9.24619E-6*(PTEMP(:))**2+& - 5.00427E-9*(PTEMP(:))**3-(0.0127081/ZAL(:)) -! -! 3) NUCLEATION RATE calculation (part.cm-3.s-1) -! -PJNUC(:) = EXP(ZCOJA(:)+ZCOJB(:)*LOG(PRH(:))+& - ZCOJC(:)*(LOG(PRH(:)))**2+ZCOJD(:)*(LOG(PRH(:)))**3+& - ZCOJE(:)*LOG(ZSULF(:))+ZCOJF(:)*LOG(PRH(:))*LOG(ZSULF(:))+& - ZCOJG(:)*(LOG(PRH(:)))**2*LOG(ZSULF(:))+ZCOJH(:)*(LOG(ZSULF(:)))**2+& - ZCOJI(:)*LOG(PRH(:))*(LOG(ZSULF(:)))**2+ZCOJJ(:)*(LOG(ZSULF(:)))**3) -! -! 4) Coefficient calculations for the MOLECULE NUMBER in the critical cluster (function of temperature and mole fraction) -! -ZCOENA(:) = -0.00295413-0.0976834*PTEMP(:)+0.00102485*(PTEMP(:))**2-2.18646E-6*(PTEMP(:))**3-(0.101717/ZAL(:)) -! -ZCOENB(:) = -0.00205064-0.00758504*PTEMP(:)+0.000192654*(PTEMP(:))**2-6.7043E-7*(PTEMP(:))**3-(0.255774/ZAL(:)) -! -ZCOENC(:) = 0.00322308+0.000852637*PTEMP(:)-0.0000154757*(PTEMP(:))**2+5.66661E-8*(PTEMP(:))**3+(0.0338444/ZAL(:)) -! -ZCOEND(:) = 0.0474323-0.000625104*PTEMP(:)+2.65066E-6*(PTEMP(:))**2-3.67471E-9*(PTEMP(:))**3-(0.000267251/ZAL(:)) -! -ZCOENE(:) = -0.0125211+0.00580655*PTEMP(:)-0.000101674*(PTEMP(:))**2+2.88195E-7*(PTEMP(:))**3+(0.0942243/ZAL(:)) -! -ZCOENF(:) = -0.038546-0.000672316*PTEMP(:)+2.60288E-6*(PTEMP(:))**2+1.19416E-8*(PTEMP(:))**3-(0.00851515/ZAL(:)) -! -ZCOENG(:) = -0.0183749+0.000172072*PTEMP(:)-3.71766E-7*(PTEMP(:))**2-5.14875E-10*(PTEMP(:))**3+(0.00026866/ZAL(:)) -! -ZCOENH(:) = -0.0619974+0.000906958*PTEMP(:)-9.11728E-7*(PTEMP(:))**2-5.36796E-9*(PTEMP(:))**3-(0.00774234/ZAL(:)) -! -ZCOENI(:) = 0.0121827-0.00010665*PTEMP(:)+2.5346E-7*(PTEMP(:))**2-3.63519E-10*(PTEMP(:))**3+(0.000610065/ZAL(:)) -! -ZCOENJ(:) = 0.000320184-0.0000174762*PTEMP(:)+6.06504E-8*(PTEMP(:))**2-1.42177E-11*(PTEMP(:))**3+(0.000135751/ZAL(:)) -! -! 5) MOLECULE NUMBER in the critical cluster calculation (should be between 4 -! and 70) -! -ZNTOT(:) = EXP(ZCOENA(:)+ZCOENB(:)*LOG(PRH(:))+ZCOENC(:)*(LOG(PRH(:)))**2+ZCOEND(:)*(LOG(PRH(:)))**3+& - ZCOENE(:)*LOG(ZSULF(:))+ZCOENF(:)*LOG(PRH(:))*LOG(ZSULF(:))+ZCOENG(:)*(LOG(PRH(:)))**2*LOG(ZSULF(:))+& - ZCOENH(:)*(LOG(ZSULF(:)))**2+ZCOENI(:)*LOG(PRH(:))*(LOG(ZSULF(:)))**2+ZCOENJ(:)*(LOG(ZSULF(:)))**3) -! -! 6) Cluster's radius in nm (should be between 0.35 and 0.92) -! -PRC(:) = EXP(-1.6524245 + 0.42316402 * ZAL(:) + 0.3346648 * LOG(ZNTOT(:))) -! -END WHERE - -! -! -RETURN -END SUBROUTINE CH_AER_VEHKAMAKI diff --git a/src/ICCARE_BASE/ch_ini_orilam.f90 b/src/ICCARE_BASE/ch_ini_orilam.f90 deleted file mode 100644 index 38a1f31f7..000000000 --- a/src/ICCARE_BASE/ch_ini_orilam.f90 +++ /dev/null @@ -1,287 +0,0 @@ -!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence -!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!ORILAM_LIC for details. -!! ######################### - MODULE MODI_CH_INI_ORILAM -!! ######################### -!! -INTERFACE -!! -SUBROUTINE CH_INI_ORILAM(PM, PSIG0, PRG0, PN0,PCTOTG, PCTOTA, PCCTOT, & - PSEDA, PRHOP0, PAERO,PCHEM,PRV, PDENAIR, & - PPRESSURE, PTEMP, PRC, PFRAC, PMI, GSCHEME ) -IMPLICIT NONE -REAL, DIMENSION(:,:), INTENT(INOUT) :: PM -REAL, DIMENSION(:,:), INTENT(INOUT) :: PSEDA -REAL, DIMENSION(:,:), INTENT(INOUT) :: PSIG0, PRG0, PN0 -REAL, DIMENSION(:,:), INTENT(INOUT) :: PCTOTG -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCTOTA, PCCTOT -REAL, DIMENSION(:,:), INTENT(INOUT) :: PRHOP0 -REAL, DIMENSION(:,:), INTENT(INOUT) :: PCHEM, PAERO -REAL, DIMENSION(:,:), INTENT(INOUT) :: PFRAC -REAL, DIMENSION(:,:), INTENT(INOUT) :: PMI -REAL, DIMENSION(:), INTENT(IN) :: PRV, PDENAIR, PPRESSURE, PTEMP, PRC -CHARACTER(LEN=10), INTENT(IN) :: GSCHEME -END SUBROUTINE CH_INI_ORILAM -!! -END INTERFACE -!! -END MODULE MODI_CH_INI_ORILAM -!! -!! ####################################################################### - SUBROUTINE CH_INI_ORILAM(PM, PSIG0, PRG0, PN0,PCTOTG, PCTOTA, PCCTOT, & - PSEDA, PRHOP0, PAERO, PCHEM, PRV, PDENAIR, & - PPRESSURE, PTEMP, PRC, PFRAC, PMI, GSCHEME ) -!! ####################################################################### -!! -!! PURPOSE -!! ------- -!! initialize the aerosol variables (vectorwise) by calling NNARES -!! -!! METHOD -!! ------- -!! call the solver with zero coag/growth/cond terms -!! then only ares should be active and we won't need to recode everyting -!! here ;-) -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Pierre Tulet (GMEI) -!! -!! MODIFICATIONS -!! ------------- -!! Original -!! -!! EXTERNAL -!! -------- -!! -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODI_CH_AER_SOLV -USE MODI_CH_AER_TRANS -USE MODD_CH_AEROSOL -USE MODD_CSTS_DUST, ONLY : XDENSITY_DUST -USE MODD_CH_M9_n, ONLY : CNAMES -USE MODD_CST, ONLY : & - XPI & ! Definition of pi - ,XBOLTZ & ! Boltzman constant - ,XAVOGADRO & ! [molec/mol] avogadros number - ,XG & ! Gravity constant - ,XP00 & ! Reference pressure - ,XMD & ! [kg/mol] molar weight of air - ,XRD & ! Gaz constant for dry air - ,XCPD ! Cpd (dry air) -USE MODD_CONF, ONLY : NVERB -! -IMPLICIT NONE -! -!* 0.1 declarations of arguments -! -REAL, DIMENSION(:,:), INTENT(INOUT) :: PM -REAL, DIMENSION(:,:), INTENT(INOUT) :: PSEDA -REAL, DIMENSION(:,:), INTENT(INOUT) :: PSIG0, PRG0, PN0 -REAL, DIMENSION(:,:), INTENT(INOUT) :: PCTOTG -REAL, DIMENSION(:,:), INTENT(INOUT) :: PFRAC -REAL, DIMENSION(:,:), INTENT(INOUT) :: PMI -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCTOTA, PCCTOT -REAL, DIMENSION(:,:), INTENT(INOUT) :: PRHOP0 -REAL, DIMENSION(:,:), INTENT(INOUT) :: PCHEM, PAERO -REAL, DIMENSION(:), INTENT(IN) :: PRV, PDENAIR, PPRESSURE, PTEMP, PRC -CHARACTER(LEN=10), INTENT(IN) :: GSCHEME -! -!* 0.2 declarations of local variables -! -REAL, DIMENSION(SIZE(PM,1),(JPMODE)*3) :: ZDMINTRA, ZDMINTER, ZDMCOND, ZDMNUCL, ZDMMERG -REAL, DIMENSION(SIZE(PM,1),JPMODE) :: ZMASK, ZSOLORG -REAL, DIMENSION(SIZE(PM,1),(JPMODE)*3) :: ZMBEG, ZMINT, ZMEND -! -INTEGER :: JJ, JI -! -!------------------------------------------------------------------------------- -! -!* 1. INITIALIZATION -! -------------- -! -PFRAC(:,:) = 0. -PSEDA(:,:) = 0. -ZDMINTRA(:,:) = 0. -ZDMINTER(:,:) = 0. -ZDMCOND(:,:) = 0. -ZDMNUCL(:,:) = 0. -ZDMMERG(:,:) = 0. -ZSOLORG(:,:) = 0. -ZMASK(:,:) = 1. -ZMBEG(:,:) = 0. -ZMINT(:,:) = 0. -ZMEND(:,:) = 0. -! -! Initialization of constants -! -XPI = 2.*ASIN(1.) -XBOLTZ = 1.380658E-23 -XAVOGADRO = 6.0221367E+23 -XG = 9.80665 -XP00 = 1.E5 -XMD = 28.9644E-3 -XRD = XAVOGADRO * XBOLTZ / XMD -XCPD = 7.* XRD /2. -! -! Moments index -! -NM0(1) = 1 -NM3(1) = 2 -NM6(1) = 3 -NM0(2) = 4 -NM3(2) = 5 -NM6(2) = 6 -! -! Aerosol Density -! Cf Ackermann (all to black carbon except water) -XRHOI(:) = 1.8e3 -XRHOI(JP_AER_H2O) = 1.0e3 ! water -XRHOI(JP_AER_DST) = XDENSITY_DUST ! water -! -! Facteur de conversion : -! [um3_aer/m3_air] = [ug_aer/m3_air] / XFAC -DO JJ=1,NSP+NCARB+NSOA - XFAC(JJ)=(4./3.)*XPI*XRHOI(JJ)*1.E-9 -ENDDO -! -! verify that all array elements are defined -DO JI = 1, SIZE(XRHOI) - IF (XRHOI(JI) .LE. 0.0) THEN - PRINT *, 'CH_AER_MOD_INIT ERROR: density for species ', JI, ' not defined' - ! callabortstop - CALL ABORT - STOP 'CH_AER_MOD_INIT ERROR: density not defined' - END IF -ENDDO -! -! Index gas scheme <=> Index Orilam -! -JP_CH_SO42M = 0 ! unuse in many schemes -! -DO JJ=1,SIZE(CNAMES) - ! - ! for heterogeneous chemistry - ! - IF (CNAMES(JJ) == "O3") JP_CH_O3 = JJ - IF (CNAMES(JJ) == "SO2") JP_CH_SO2 = JJ - IF (CNAMES(JJ) == "SO42M") JP_CH_SO42M = JJ - IF (CNAMES(JJ) == "H2O2") JP_CH_H2O2 = JJ - ! - ! Inorganics - ! - IF (CNAMES(JJ) == "HNO3") JP_CH_HNO3 = JJ - IF (CNAMES(JJ) == "NH3") JP_CH_NH3 = JJ - IF ((CNAMES(JJ) == "H2SO4").OR.(CNAMES(JJ) == "SULF")) JP_CH_H2SO4 = JJ - ! - ! SOA group 1 - ! - IF (CNAMES(JJ) == "URG1") JP_CH_URG1 = JJ - IF (CNAMES(JJ) == "UR21") JP_CH_UR21 = JJ - IF (CNAMES(JJ) == "UR28") JP_CH_UR28 = JJ - ! - ! SOA group 2 - ! - IF (CNAMES(JJ) == "URG2") JP_CH_URG2 = JJ - IF (CNAMES(JJ) == "RPG2") JP_CH_RPG2 = JJ - IF (CNAMES(JJ) == "RP18") JP_CH_RP18 = JJ - IF (CNAMES(JJ) == "UR29") JP_CH_UR29 = JJ - IF (CNAMES(JJ) == "UR30") JP_CH_UR30 = JJ - IF (CNAMES(JJ) == "RP13") JP_CH_RP13 = JJ - IF (CNAMES(JJ) == "RP17") JP_CH_RP17 = JJ - ! - ! SOA group 3 - ! - IF (CNAMES(JJ) == "RPG3") JP_CH_RPG3 = JJ - IF (CNAMES(JJ) == "RPR9") JP_CH_RPR9 = JJ - IF (CNAMES(JJ) == "RP12") JP_CH_RP12 = JJ - ! - ! SOA group 4 - ! - IF (CNAMES(JJ) == "URG4") JP_CH_URG4 = JJ - IF (CNAMES(JJ) == "UR8") JP_CH_UR8 = JJ ! only for MPMPO (for PUN it is group 10) - IF (CNAMES(JJ) == "UR3") JP_CH_UR3 = JJ - IF (CNAMES(JJ) == "UR23") JP_CH_UR23 = JJ - ! - ! SOA group 5 - ! - IF (CNAMES(JJ) == "UR17") JP_CH_UR17 = JJ - IF (CNAMES(JJ) == "AP7") JP_CH_AP7 = JJ - IF (CNAMES(JJ) == "UR7") JP_CH_UR7 = JJ ! only for MPMPO (for PUN it is group 10) - IF (CNAMES(JJ) == "RPR3") JP_CH_RPR3 = JJ ! only for PUN (for MPMPO it is not a SOA precursor) - ! - ! SOA group 6 - ! - IF (CNAMES(JJ) == "URG6") JP_CH_URG6 = JJ - IF (CNAMES(JJ) == "ARAC") JP_CH_ARAC = JJ - IF (CNAMES(JJ) == "UR22") JP_CH_UR22 = JJ ! only for PUN (for MPMPO it is not a SOA precursor) - IF (CNAMES(JJ) == "UR31") JP_CH_UR31 = JJ - IF (CNAMES(JJ) == "AP1") JP_CH_AP1 = JJ - IF (CNAMES(JJ) == "AP6") JP_CH_AP6 = JJ - ! - ! SOA group 7 - ! - IF (CNAMES(JJ) == "URG7") JP_CH_URG7 = JJ - IF (CNAMES(JJ) == "RPG7") JP_CH_RPG7 = JJ - IF (CNAMES(JJ) == "RPR7") JP_CH_RPR7 = JJ - IF (CNAMES(JJ) == "RPR4") JP_CH_RPR4 = JJ ! only for PUN (for MPMPO it is not a SOA precursor) - IF (CNAMES(JJ) == "RP14") JP_CH_RP14 = JJ ! only for PUN (for MPMPO it is not a SOA precursor) - IF (CNAMES(JJ) == "RP19") JP_CH_RP19 = JJ ! only for PUN (for MPMPO it is not a SOA precursor) - IF (CNAMES(JJ) == "ADAC") JP_CH_ADAC = JJ - IF (CNAMES(JJ) == "UR2") JP_CH_UR2 = JJ - IF (CNAMES(JJ) == "UR14") JP_CH_UR14 = JJ - IF (CNAMES(JJ) == "UR27") JP_CH_UR27 = JJ - ! - ! SOA group 8 - ! - IF (CNAMES(JJ) == "URG8") JP_CH_URG8 = JJ - IF (CNAMES(JJ) == "UR19") JP_CH_UR19 = JJ ! only for MPMPO (for PUN it is not a SOA precursor) - IF (CNAMES(JJ) == "UR11") JP_CH_UR11 = JJ - IF (CNAMES(JJ) == "UR15") JP_CH_UR15 = JJ - IF (CNAMES(JJ) == "AP10") JP_CH_AP10 = JJ - ! - ! SOA group 9 - ! - IF (CNAMES(JJ) == "URG9") JP_CH_URG9 = JJ - IF (CNAMES(JJ) == "UR20") JP_CH_UR20 = JJ - IF (CNAMES(JJ) == "UR34") JP_CH_UR34 = JJ - IF (CNAMES(JJ) == "AP11") JP_CH_AP11 = JJ - IF (CNAMES(JJ) == "AP12") JP_CH_AP12 = JJ - IF (CNAMES(JJ) == "UR26") JP_CH_UR26 = JJ - ! - ! SOA group 10 - ! - IF (CNAMES(JJ) == "URG10") JP_CH_URG10 = JJ - IF (CNAMES(JJ) == "PAN8") JP_CH_PAN8 = JJ ! only for PUN (for MPMPO it is not a SOA precursor) - IF (CNAMES(JJ) == "UR5") JP_CH_UR5 = JJ - IF (CNAMES(JJ) == "UR6") JP_CH_UR6 = JJ - IF (CNAMES(JJ) == "UR7") JP_CH_UR7 = JJ - IF (CNAMES(JJ) == "UR8") JP_CH_UR8 = JJ - IF (CNAMES(JJ) == "AP8") JP_CH_AP8 = JJ - ! -END DO -! -!* 0.4 initialization aerosol solveur -! -CALL CH_AER_TRANS(0, PM, PSIG0, PRG0, PN0, PRHOP0, PAERO, & - PCHEM, PCTOTG, PCTOTA, PCCTOT, PFRAC, PMI, ZMASK, GSCHEME ) -! -CALL CH_AER_SOLV(PM,PSIG0, PRG0, PN0, PCTOTG, PCTOTA, PCCTOT, & - ZDMINTRA,ZDMINTER,ZDMCOND,ZDMNUCL,ZDMMERG,PSEDA,0., & - PRV, PDENAIR, PPRESSURE, PTEMP, PRC, 0., ZSOLORG, & - ZMBEG,ZMINT,ZMEND ) -! -CALL CH_AER_TRANS(1, PM, PSIG0, PRG0, PN0, PRHOP0, PAERO, & - PCHEM, PCTOTG, PCTOTA, PCCTOT, PFRAC, PMI, ZMASK, GSCHEME) -! -END SUBROUTINE CH_INI_ORILAM diff --git a/src/ICCARE_BASE/ch_init_fieldn.f90 b/src/ICCARE_BASE/ch_init_fieldn.f90 deleted file mode 100644 index 4c9853b05..000000000 --- a/src/ICCARE_BASE/ch_init_fieldn.f90 +++ /dev/null @@ -1,447 +0,0 @@ -!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!----------------------------------------------------------------- -!! ########################### - MODULE MODI_CH_INIT_FIELD_n -!! ########################### -!! -INTERFACE -!! -SUBROUTINE CH_INIT_FIELD_n(KMI, KLUOUT, KVERB) -!! -IMPLICIT NONE -!! -INTEGER, INTENT(IN) :: KMI ! model index -INTEGER, INTENT(IN) :: KLUOUT ! output listing channel -INTEGER, INTENT(IN) :: KVERB ! verbosity level -!! -!! -END SUBROUTINE CH_INIT_FIELD_n -!! -END INTERFACE -!! -END MODULE MODI_CH_INIT_FIELD_n -!! -!! ############################################## - SUBROUTINE CH_INIT_FIELD_n(KMI, KLUOUT, KVERB) -!! ############################################## -!! -!!*** *CH_INIT_FIELD_n* -!! -!! PURPOSE -!! ------- -! initialize MesoNH scalar variables -!! -!!** METHOD -!! ------ -!! The subroutine CH_FIELD_VALUE_n returns for each grid-point -!! (LAT,LON,ZZ) and each species a corresponding initial value, either -!! in part/part or in molec/cm3. If necessary, that initial value is -!! then converted to mixing ratio (part/part). -!! The variables at time t and t-dt are given identic values. -!! Presently, there is only a 1D initialization (homogeneous in x-y) -!! available. For more sophisticated initializations, the subroutine -!! CH_FIELD_VALUE_n may be modified by the user. The character parameter -!! CCH_INIT_FIELD_OPT may be used in order to pass user specific information -!! on to that subroutine. These subroutines have been duplicated in order -!! to allow future inclusion of model dependant parameters (like an -!! initialization that depends on variables stored in MODD_FIELD_n) -!! -!! REFERENCE -!! --------- -!! book 2 of MesoNH -!! -!! AUTHOR -!! ------ -!! K. Suhre *Laboratoire d'Aerologie* -!! -!! MODIFICATIONS -!! ------------- -!! Original 02/11/95 -!! 05/08/96 (K. Suhre) restructured -!! 11/08/98 (N. Asencio) add parallel code -!! 09/03/99 (V. Crassier) speed up 1-D initialization by reducing a 3-D -!! loop to a 1-D loop with 10m precision -!! 09/12/99 (K. Suhre) add missing update halo and a fix for MAXVAL pbs. -!! 09/01/01 (P. Tulet) initialize chemical constant (molar mass, henry -!! specific constant and biological reactivity -!! 22/01/01 (D. Gazen) add NSV_CHEMBEG and NSV_CHEMEND indices to handle SV -!! 04/06/07 (M. Leriche & JP Pinty) add pH initialization -!! 20/04/10 (M. Leriche) remove pH initialization to ini_modeln -! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine -! P. Tulet 20/05/2021: correction for CON to MIX transformation unit (aerosols only) -!! -!! EXTERNAL -!! -------- -!! GET_DIM_EXT_ll : get extended sub-domain sizes -!! GET_INDICE_ll : get physical sub-domain bounds -!! -!!------------------------------------------------------------------------------ -!! -USE MODI_CH_FIELD_VALUE_n ! returns value of chemical species at each grid point -USE MODI_CH_INIT_CONST_n -USE MODI_CH_AER_EQM_INIT_n -USE MODE_ll -USE MODE_AERO_PSD -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -USE MODD_GRID_n, ONLY : XZZ, &! height z - XLAT,XLON ! latitude and longitude -USE MODD_REF_n, ONLY : XRHODREF, &! dry density of ref. state - XRHODJ ! ( rhod J ) = dry density -USE MODD_LBC_n -USE MODD_NSV, ONLY : NSV_CHEM, NSV_CHEMBEG,NSV_CHEMEND, & - NSV_AER, NSV_AERBEG,NSV_AEREND -USE MODD_CST, ONLY : XMD, XAVOGADRO - -USE MODD_FIELD_n, ONLY : XSVT ! scalar variable at t -USE MODD_PARAMETERS, ONLY : JPVEXT, JPHEXT ! number of External points -USE MODD_ARGSLIST_ll, ONLY : LIST_ll ! for update_halo -USE MODD_CH_CONST_n ! for Chemical constants -USE MODD_CONF, ONLY : CPROGRAM, L1D, L2D -USE MODD_CONF_n, ONLY : NRRL -USE MODD_CH_MNHC_n -USE MODD_CH_M9_n, ONLY : CNAMES, NEQ -USE MODD_CH_AEROSOL -USE MODD_CH_AERO_n -USE MODD_LSFIELD_n, ONLY : XLBXSVM, XLBYSVM -USE MODD_DYN_n, ONLY : NRIMX,NRIMY -!! -!! -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -IMPLICIT NONE -! -!* 0.1 declarations of arguments -! -INTEGER, INTENT(IN) :: KMI ! model index -INTEGER, INTENT(IN) :: KLUOUT ! output listing channel -INTEGER, INTENT(IN) :: KVERB ! verbosity level -! -!* 0.2 declarations local variables -! -INTEGER :: JI, JJ, JK, JN ! loop control variables -CHARACTER(LEN=3) :: YUNIT ! units of returned initial values - ! "CON" = molec./cm3 - ! "MIX" = mixing ratio -REAL :: ZDEN2MOL - ! ZDEN2MOL = 6.0221367E+23 * 1E-6 / 28.9644E-3 - ! conversion factor density to mol/cm3 - ! n_molec (moelc./cm3): M = 1E-6*RHO(kg/m3) * XAVOGADRO / XMD - -REAL, ALLOCATABLE, DIMENSION(:) :: ZHEIGHT !Height lookup table -REAL, ALLOCATABLE, DIMENSION(:,:) :: ZSVINIT !Species concentration lookup table -REAL, ALLOCATABLE, DIMENSION(:,:) :: ZSVINITA !Aerosols species concentration lookup table - -INTEGER :: ILEVMAX !Maximum height level -INTEGER :: JLEV !Current height level - -INTEGER :: IIU ! Upper dimension in x direction -INTEGER :: IJU ! Upper dimension in y direction -INTEGER :: IKU ! Upper dimension in z direction -INTEGER :: IIB ! indice I Beginning in x direction -INTEGER :: IJB ! indice J Beginning in y direction -INTEGER :: IKB ! indice K Beginning in z direction -INTEGER :: IIE ! indice I End in x direction -INTEGER :: IJE ! indice J End in y direction -INTEGER :: IKE ! indice K End in z direction -! -TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! pointer for the list of 3D fields -INTEGER :: IINFO_ll ! Return code of //routines -INTEGER :: IOR, JOR, IEND, JEND, KINFO, NIU,NJU, ILBX, ILBY, IRIMX, IRIMY -! -!------------------------------------------------------------------------------- -! -!* 0. PROLOGUE -! -------- -! -NULLIFY(TZFIELDS_ll) -! -!* 1. PREPARE INITIALIZATION -! ---------------------- - -IF (CORGANIC == TRIM("MPMPO") .OR. CORGANIC == TRIM("PUN") .OR. CORGANIC == TRIM("EQSAM2")) THEN - IF ((CCH_SCHEME .EQ. TRIM("NONE")) .OR. (CCH_SCHEME .EQ. TRIM("RELACS"))& - .OR. (CCH_SCHEME .EQ. TRIM("RACM"))) THEN - WRITE(KLUOUT,FMT=*) '**********************************************' - WRITE(KLUOUT,FMT=*) 'WARNING : NO SOA !!!!' - WRITE(KLUOUT,FMT=*) 'YOU WANT TO USE SOA GAS PARTICLE BALANCE' - WRITE(KLUOUT,FMT=*) 'BUT THE SCHEME NEED TO BE CACM or RELACS 2' - WRITE(KLUOUT,FMT=*) 'CORGANIC HAS BEEN SET TO NONE' - WRITE(KLUOUT,FMT=*) 'OTHERWISE COMPILE THE CORRECT SCHEME BEFORE' - WRITE(KLUOUT,FMT=*) '**********************************************' - CORGANIC = "NONE" - END IF -END IF -! -!* 1.1 compute dimensions of arrays -! - -CALL GET_INDICE_ll (IIB,IJB,IIE,IJE) -CALL GET_GLOBALDIMS_ll(IIE,IJE) -IIU = IIE + 2 * JPHEXT -IJU = IJE + 2 * JPHEXT -CALL GET_INTERSECTION_ll(1+JPHEXT, 1+JPHEXT, IIU-JPHEXT , IJU-JPHEXT, IOR, JOR, IEND, JEND, "EXTE", KINFO) -IKB = 1 + JPVEXT -IKU = SIZE(XSVT,3) -IKE = IKU - JPVEXT -CALL GET_DIM_EXT_ll('B',NIU,NJU) -! -! 1.1.1 find maximum height level -ILEVMAX=INT(MAXVAL(XZZ(:,:,IKE)/10.))+1 -! the following print serves to break compiler optimization with MAXVAL -! (pb. on OS2000 with option -O3 for example, Peter Bechtold had -! similar surprises with MAXVAL on Fuji VPP700 in the convection scheme) -WRITE(KLUOUT,*) "CH_INIT_FIELD_n: ILEVMAX =",ILEVMAX -ALLOCATE(ZHEIGHT(ILEVMAX)) -ALLOCATE(ZSVINIT(ILEVMAX,NEQ)) -ALLOCATE(ZSVINITA(ILEVMAX,NSV_AER)) -! -!* 1.2 compute conversion factor kg/m3 --> molec/cm3 -! -ZDEN2MOL = 1E-6 * XAVOGADRO / XMD -! -! -!------------------------------------------------------------------------------- -! -!* 2. INITIALIZE T FIELDS AND CONVERT CONC. TO MIXING RATIO -! ----------------------- -! - -YUNIT="MIX" - -IF (LORILAM) THEN - IF (.NOT.(ASSOCIATED(XN3D))) ALLOCATE(XN3D(SIZE(XSVT,1),SIZE(XSVT,2),IKU,JPMODE)) - IF (.NOT.(ASSOCIATED(XRG3D))) ALLOCATE(XRG3D(SIZE(XSVT,1),SIZE(XSVT,2),IKU,JPMODE)) - IF (.NOT.(ASSOCIATED(XSIG3D))) ALLOCATE(XSIG3D(SIZE(XSVT,1),SIZE(XSVT,2),IKU,JPMODE)) - IF (.NOT.(ASSOCIATED(XRHOP3D))) ALLOCATE(XRHOP3D(SIZE(XSVT,1),SIZE(XSVT,2),IKU,JPMODE)) - IF (.NOT.(ASSOCIATED(XM3D))) ALLOCATE(XM3D(SIZE(XSVT,1),SIZE(XSVT,2),IKU,JPMODE*3)) - IF (.NOT.(ASSOCIATED(XSEDA))) ALLOCATE(XSEDA(SIZE(XSVT,1),SIZE(XSVT,2),IKU,JPMODE*3)) - IF (.NOT.(ASSOCIATED(XCTOTA3D))) & - ALLOCATE(XCTOTA3D(SIZE(XSVT,1),SIZE(XSVT,2),IKU,NSP+NCARB+NSOA,JPMODE)) - IF (.NOT.(ASSOCIATED(XVDEPAERO))) ALLOCATE(XVDEPAERO(SIZE(XSVT,1),SIZE(XSVT,2),JPIN)) - IF (.NOT.(ALLOCATED(XFAC))) ALLOCATE(XFAC(NSP+NSOA+NCARB)) - IF (.NOT.(ALLOCATED(XRHOI))) ALLOCATE(XRHOI(NSP+NSOA+NCARB)) - IF (.NOT.(ASSOCIATED(XFRAC))) THEN - ALLOCATE(XFRAC(SIZE(XSVT,1),SIZE(XSVT,2),IKU,NEQ)) - XFRAC(:,:,:,:) = 0. - END IF - IF (.NOT.(ASSOCIATED(XMI))) THEN - ALLOCATE(XMI(SIZE(XSVT,1),SIZE(XSVT,2),IKU,NSP+NCARB+NSOA)) - END IF - IF (.NOT.(ASSOCIATED(XJNUC))) ALLOCATE(XJNUC(SIZE(XSVT,1),SIZE(XSVT,2),IKU)) - IF (.NOT.(ASSOCIATED(XJ2RAT))) ALLOCATE(XJ2RAT(SIZE(XSVT,1),SIZE(XSVT,2),IKU)) - IF (.NOT.(ASSOCIATED(XCONC_MASS))) ALLOCATE(XCONC_MASS(SIZE(XSVT,1),SIZE(XSVT,2),IKU)) - IF (.NOT.(ASSOCIATED(XCOND_MASS_I))) ALLOCATE(XCOND_MASS_I(SIZE(XSVT,1),SIZE(XSVT,2),IKU)) - IF (.NOT.(ASSOCIATED(XCOND_MASS_J))) ALLOCATE(XCOND_MASS_J(SIZE(XSVT,1),SIZE(XSVT,2),IKU)) - IF (.NOT.(ASSOCIATED(XNUCL_MASS))) ALLOCATE(XNUCL_MASS(SIZE(XSVT,1),SIZE(XSVT,2),IKU)) - - IF (.NOT.(ASSOCIATED(XMBEG))) ALLOCATE(XMBEG(SIZE(XSVT,1),SIZE(XSVT,2),IKU,JPIN)) - IF (.NOT.(ASSOCIATED(XMINT))) ALLOCATE(XMINT(SIZE(XSVT,1),SIZE(XSVT,2),IKU,JPIN)) - IF (.NOT.(ASSOCIATED(XMEND))) ALLOCATE(XMEND(SIZE(XSVT,1),SIZE(XSVT,2),IKU,JPIN)) - - IF (.NOT.(ASSOCIATED(XDMINTRA))) ALLOCATE(XDMINTRA(SIZE(XSVT,1),SIZE(XSVT,2),IKU,JPIN)) - IF (.NOT.(ASSOCIATED(XDMINTER))) ALLOCATE(XDMINTER(SIZE(XSVT,1),SIZE(XSVT,2),IKU,JPIN)) - IF (.NOT.(ASSOCIATED(XDMCOND))) ALLOCATE(XDMCOND(SIZE(XSVT,1),SIZE(XSVT,2),IKU,JPIN)) - IF (.NOT.(ASSOCIATED(XDMNUCL))) ALLOCATE(XDMNUCL(SIZE(XSVT,1),SIZE(XSVT,2),IKU,JPIN)) - IF (.NOT.(ASSOCIATED(XDMMERG))) ALLOCATE(XDMMERG(SIZE(XSVT,1),SIZE(XSVT,2),IKU,JPIN)) - ! - XJNUC(:,:,:) = 1.0E-7 - XJ2RAT(:,:,:) = 0. - XCONC_MASS(:,:,:) = 0. - XCOND_MASS_I(:,:,:) = 0. - XCOND_MASS_J(:,:,:) = 0. - XNUCL_MASS(:,:,:) = 0. - ! - XMBEG(:,:,:,:) = 0. - XMINT(:,:,:,:) = 0. - XMEND(:,:,:,:) = 0. - ! - XDMINTRA(:,:,:,:) = 0. - XDMINTER(:,:,:,:) = 0. - XDMCOND(:,:,:,:) = 0. - XDMNUCL(:,:,:,:) = 0. - XDMMERG(:,:,:,:) = 0. - -END IF -! -!* print info for user -IF ((LCH_INIT_FIELD).AND.(CPROGRAM/='DIAG ')) THEN -! - WRITE(KLUOUT,*) "CH_INIT_FIELD_n will now initialize XSVT fields" -! -! - jlev_loop : DO JLEV=1,ILEVMAX - ZHEIGHT=REAL(JLEV-1)*10. - jn_loop : DO JN = 1, NEQ - ZSVINIT(JLEV,JN) = & - CH_FIELD_VALUE_n(ZHEIGHT(JLEV), "LLZ", & - CNAMES(JN), YUNIT, KLUOUT, KVERB) - ! "LLZ" identifies the type of x-y-z values passed on to - ! CH_FIELD_VALUE_n ("LLZ"=lon-lat-Z) - ! in future developpements, "IJK" may be used in order - ! to pass the grid indices rather than coordinates - END DO jn_loop - END DO jlev_loop - - XSVT(:,:,:,NSV_CHEMBEG:NSV_CHEMEND) = 0. - jk_loop : DO JK = IKB, IKE - jj_loop : DO JJ = JOR, JEND - ji_loop : DO JI = IOR, IEND - - JLEV=INT(MAX(XZZ(JI,JJ,JK),0.)/10.)+1 - XSVT(JI,JJ,JK,NSV_CHEMBEG:NSV_CHEMEND) = ZSVINIT(JLEV,:) - - END DO ji_loop - END DO jj_loop - END DO jk_loop - DO JN = NSV_CHEMBEG,NSV_CHEMEND - DO JK=1,JPVEXT - XSVT(:,:,IKB-JPVEXT,JN) = XSVT(:,:,IKB,JN) - XSVT(:,:,IKE+JPVEXT,JN) = XSVT(:,:,IKE,JN) - - XSVT(IIB-JPHEXT,:,:,JN) = XSVT(IIB,:,:,JN) - XSVT(IIU,:,:,JN) = XSVT(IIU-JPHEXT,:,:,JN) - - XSVT(:,IJB-JPHEXT,:,JN) = XSVT(:,IJB,:,JN) - XSVT(:,IJU,:,JN) = XSVT(:,IJU-JPHEXT,:,JN) - END DO - END DO - ! - IF (YUNIT .EQ. "CON") THEN - WRITE(KLUOUT,*) "CH_INIT_FIELD_n: converting initial values to mixing ratio" - DO JN = NSV_CHEMBEG,NSV_CHEMEND - XSVT(:,:,:,JN) = XSVT(:,:,:,JN)/(XRHODREF(:,:,:)*ZDEN2MOL) - ENDDO - ELSE - WRITE(KLUOUT,*)"CH_INIT_FIELD_n: initial values are used as is (mixing ratio)" - ENDIF -! -! - IF (LORILAM) THEN - jlev_loop2 : DO JLEV=1,ILEVMAX - ZHEIGHT=REAL(JLEV-1)*10. - jn_loop2 : DO JN = 1, NSV_AER - ZSVINITA(JLEV,JN) = & - CH_FIELD_VALUE_n(ZHEIGHT(JLEV), "LLZ", & - CAERONAMES(JN), YUNIT, KLUOUT, KVERB) - ! "LLZ" identifies the type of x-y-z values passed on to - ! CH_FIELD_VALUE_n ("LLZ"=lon-lat-Z) - ! in future developpements, "IJK" may be used in order - ! to pass the grid indices rather than coordinates - END DO jn_loop2 - END DO jlev_loop2 - ! - XSVT(:,:,:,NSV_AERBEG:NSV_AEREND) = 0. - jk_loop2 : DO JK = IKB, IKE - jj_loop2 : DO JJ = JOR, JEND - ji_loop2 : DO JI = IOR, IEND - - JLEV=INT(MAX(XZZ(JI,JJ,JK),0.)/10.)+1 - XSVT(JI,JJ,JK,NSV_AERBEG:NSV_AEREND) = ZSVINITA(JLEV,:) - - END DO ji_loop2 - END DO jj_loop2 - END DO jk_loop2 - DO JN = NSV_AERBEG,NSV_AEREND - DO JK=1,JPVEXT - XSVT(:,:,IKB-JPVEXT,JN) = XSVT(:,:,IKB,JN) - XSVT(:,:,IKE+JPVEXT,JN) = XSVT(:,:,IKE,JN) - - XSVT(IIB-JPHEXT,:,:,JN) = XSVT(IIB,:,:,JN) - XSVT(IIU,:,:,JN) = XSVT(IIU-JPHEXT,:,:,JN) - - XSVT(:,IJB-JPHEXT,:,JN) = XSVT(:,IJB,:,JN) - XSVT(:,IJU,:,JN) = XSVT(:,IJU-JPHEXT,:,JN) - END DO - END DO - ! - IF (YUNIT .EQ. "CON") THEN - WRITE(KLUOUT,*) "CH_INIT_FIELD_n (ORILAM): converting initial values µg/m3 to mixing ratio" - CALL CON2MIX (XSVT(:,:,:,NSV_AERBEG:NSV_AEREND), XRHODREF) - ELSE - WRITE(KLUOUT,*)"CH_INIT_FIELD_n (ORILAM): initial values are used as is (mixing ratio)" - ENDIF - - ! - ENDIF !LORILAM - ! -ENDIF -! -! -CALL ADD4DFIELD_ll(TZFIELDS_ll, XSVT(:,:,:,NSV_CHEMBEG:NSV_CHEMEND), 'CH_INIT_FIELD_n::XSVT(:,:,:,NSV_CHEMBEG:NSV_CHEMEND)' ) -CALL ADD4DFIELD_ll(TZFIELDS_ll, XSVT(:,:,:,NSV_AERBEG:NSV_AEREND), 'CH_INIT_FIELD_n::XSVT(:,:,:,NSV_AERBEG:NSV_AEREND)' ) -! -CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll) -CALL CLEANLIST_ll(TZFIELDS_ll) -! -!------------------------------------------------------------------------------- -! -!* 3. INITIALIZE CHEMICAL CONSTANTS -! -CALL CH_INIT_CONST_n(KLUOUT, KVERB) -! -!------------------------------------------------------------------------------- -! -!* 4. INITIALIZE AEROSOLS -! ------------------- -! -IF (LORILAM) THEN - CALL CH_AER_EQM_INIT_n(XSVT(:,:,:,NSV_CHEMBEG:NSV_CHEMEND),& - XSVT(:,:,:,NSV_AERBEG:NSV_AEREND),& - XM3D,XRHOP3D,XSIG3D,& - XRG3D,XN3D, XRHODREF, XCTOTA3D) - DO JN = 1,JPIN - XM3D(:,:,IKB-JPVEXT,JN) = XM3D(:,:,IKB,JN) - XM3D(:,:,IKE+JPVEXT,JN) = XM3D(:,:,IKE,JN) - END DO - ! - CALL ADD4DFIELD_ll(TZFIELDS_ll, XSVT(:,:,:,NSV_CHEMBEG:NSV_CHEMEND), 'CH_INIT_FIELD_n::XSVT(:,:,:,NSV_CHEMBEG,NSV_CHEMEND)' ) - CALL ADD4DFIELD_ll(TZFIELDS_ll, XSVT(:,:,:,NSV_AERBEG:NSV_AEREND), 'CH_INIT_FIELD_n::XSVT(:,:,:,NSV_AERBEG:NSV_AEREND)' ) - CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll) - CALL CLEANLIST_ll(TZFIELDS_ll) -END IF -! -! -!------------------------------------------------------------------------------- -! -!* 5. INITIALIZE LB IN CASE OF LCH_INIT_FIELD -! --------------------------------------- -! -IF ((LCH_INIT_FIELD).AND.(CPROGRAM/='DIAG ').AND.(KMI .EQ. 1)) THEN - ILBX=SIZE(XLBXSVM,1) - ILBY=SIZE(XLBYSVM,2) - IRIMX = INT(ILBX/2) - IRIMY = INT(ILBY/2) - DO JN = NSV_CHEMBEG,NSV_CHEMEND - IF(LWEST_ll() .AND. .NOT. L1D) & - XLBXSVM(1:IRIMX+1, :,:,JN) = XSVT(1:IRIMX+1, :,:,JN) - IF(LEAST_ll() .AND. .NOT. L1D) & - XLBXSVM(ILBX-IRIMX:ILBX,:,:,JN) = XSVT(NIU-IRIMX:NIU, :,:,JN) - IF(LSOUTH_ll() .AND. .NOT. L1D .AND. .NOT. L2D) & - XLBYSVM(:,1:IRIMY+1, :,JN) = XSVT(:,1:IRIMY+1, :,JN) - IF(LNORTH_ll() .AND. .NOT. L1D .AND. .NOT. L2D) & - XLBYSVM(:,ILBY-IRIMY:ILBY,:,JN) = XSVT(:,NJU-IRIMY:NJU, :,JN) - END DO - IF (LORILAM) THEN - DO JN = NSV_AERBEG,NSV_AEREND - IF(LWEST_ll() .AND. .NOT. L1D) & - XLBXSVM(1:IRIMX+1, :,:,JN) = XSVT(1:IRIMX+1, :,:,JN) - IF(LEAST_ll() .AND. .NOT. L1D) & - XLBXSVM(ILBX-IRIMX:ILBX,:,:,JN) = XSVT(NIU-IRIMX:NIU, :,:,JN) - IF(LSOUTH_ll() .AND. .NOT. L1D .AND. .NOT. L2D) & - XLBYSVM(:,1:IRIMY+1, :,JN) = XSVT(:,1:IRIMY+1, :,JN) - IF(LNORTH_ll() .AND. .NOT. L1D .AND. .NOT. L2D) & - XLBYSVM(:,ILBY-IRIMY:ILBY,:,JN) = XSVT(:,NJU-IRIMY:NJU, :,JN) - END DO - ENDIF -! -ENDIF -! -! -END SUBROUTINE CH_INIT_FIELD_n diff --git a/src/ICCARE_BASE/ch_meteo_trans_lima.f90 b/src/ICCARE_BASE/ch_meteo_trans_lima.f90 deleted file mode 100644 index 42e2a5006..000000000 --- a/src/ICCARE_BASE/ch_meteo_trans_lima.f90 +++ /dev/null @@ -1,348 +0,0 @@ -!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!----------------------------------------------------------------- -!--------------- special set of characters for RCS information -!----------------------------------------------------------------- -! $Source$ $Revision$ $Date$ -!----------------------------------------------------------------- -!! ############################### - MODULE MODI_CH_METEO_TRANS_LIMA -!! ############################### -!! -! -INTERFACE -!! -SUBROUTINE CH_METEO_TRANS_LIMA(KL, PRHODJ, PRHODREF, PRTSM, PCCTSM, PCRTSM, & - PTHT, PABST, KVECNPT, KVECMASK, TPM, KDAY, & - KMONTH, KYEAR, PLAT, PLON, PLAT0, PLON0, & - OUSERV, OUSERC, OUSERR, KLUOUT, HCLOUD, PTSTEP ) -! -USE MODD_CH_M9_n, ONLY: METEOTRANSTYPE -! -IMPLICIT NONE -REAL, INTENT(IN), OPTIONAL :: PTSTEP ! Double timestep -CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Cloud parameterization -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! air density -REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRTSM ! moist variables at t or t-dt or water m.r. source -REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCTSM ! Cloud water C. at t or t-dt or water m.r. -REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRTSM ! Rain water C. at t or t-dt or water m.r. -REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PABST ! theta and pressure at t -INTEGER, DIMENSION(:,:), INTENT(IN) :: KVECMASK -! -TYPE(METEOTRANSTYPE), DIMENSION(:), INTENT(INOUT) :: TPM - ! meteo variable for CCS -INTEGER, INTENT(IN) :: KYEAR ! Current Year -INTEGER, INTENT(IN) :: KMONTH ! Current Month -INTEGER, INTENT(IN) :: KDAY ! Current Day -INTEGER, INTENT(IN) :: KLUOUT ! channel for output listing -INTEGER, INTENT(IN) :: KL, KVECNPT -REAL, DIMENSION(:,:), INTENT(IN) :: PLAT, PLON -REAL, INTENT(IN) :: PLAT0, PLON0 -LOGICAL, INTENT(IN) :: OUSERV, OUSERC, OUSERR -END SUBROUTINE CH_METEO_TRANS_LIMA -!! -END INTERFACE -!! -END MODULE MODI_CH_METEO_TRANS_LIMA -!! -!! ######################################################################### -SUBROUTINE CH_METEO_TRANS_LIMA(KL, PRHODJ, PRHODREF, PRTSM, PCCTSM, PCRTSM, & - PTHT, PABST, KVECNPT, KVECMASK, TPM, KDAY, & - KMONTH, KYEAR, PLAT, PLON, PLAT0, PLON0, & - OUSERV, OUSERC, OUSERR, KLUOUT, HCLOUD, PTSTEP ) -!! ######################################################################### -!! -!!*** *CH_METEO_TRANS* -!! -!! PURPOSE -!! ------- -! Transfer of meteorological data, such as temperature, pressure -! and water vapor mixing ratio for one point into the variable TPM(JM+1) -! here LWC, LWR and mean radius computed from LIMA or KHKO schemes -!! -!! METHOD -!! ------ -!! For the given grid-point KI,KJ,KK, the meteorological parameters -!! will be transfered for use by CH_SET_RATES and CH_SET_PHOTO_RATES. -!! Presently, the variables altitude, air density, temperature, -!! water vapor mixing ratio, cloud water, longitude, latitude and date -!! will be transfered. In the chemical definition file (.chf) -!! these variables have to be transfered into variables like O2, H2O etc. -!! Also, consistency is checked between the number of -!! variables expected by the CCS (as defined in the .chf file) and -!! the number of variables to be transfered here. If you change -!! the meaning of XMETEOVARS in your .chf file, make sure to modify -!! this subroutine accordingly. -!! If the model is run in 1D mode, the model level instead of altitude -!! is passed. In 2D and 3D, altitude is passed with a negative sign -!! so that the radiation scheme TUV can make the difference between -!! model levels and altitude. -!! -!! AUTHOR -!! ------ -!! K. Suhre *Laboratoire d'Aerologie* -!! -!! MODIFICATIONS -!! ------------- -!! Original 24/05/95 -!! 04/08/96 (K. Suhre) restructured -!! 21/02/97 (K. Suhre) add XLAT0 and XLON0 for LCARTESIAN=T case -!! 27/08/98 (P. Tulet) add temperature at t for kinetic coefficient -!! 09/03/99 (V. Crassier & K. Suhre) vectorization -!! 09/03/99 (K. Suhre) modification for TUV -!! 09/03/99 (C. Mari & J. Escobar) Code optimization -!! 01/12/03 (D. Gazen) change Chemical scheme interface -!! 01/12/03 (D. Gazen) change Chemical scheme interface -!! 01/12/04 (P. Tulet) update ch_meteo_transn.f90 for Arome -!! 01/12/07 (M. Leriche) include rain -!! 14/05/08 (M. Leriche) include raindrops and cloud droplets mean radius -!! 05/06/08 (M. Leriche) calculate LWC and LWR in coherence with time spliting scheme -!! 05/11/08 (M. Leriche) split in two routines for 1-moment and 2-moment cloud schemes -!! -!! EXTERNAL -!! -------- -!! GAMMA : gamma function -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! -USE MODD_CH_M9_n, ONLY: NMETEOVARS, &! number of meteorological variables - METEOTRANSTYPE !type for meteo . transfer -!! -USE MODD_CST, ONLY: XP00, &! Surface pressure - XRD, &! R gas constant - XCPD !specific heat for dry air -!! -USE MODD_CONF, ONLY: LCARTESIAN ! Logical for cartesian geometry -!! -USE MODD_PARAM_LIMA, ONLY: XNUC, XALPHAC, & ! Cloud droplets distrib. param. - XNUR, XALPHAR, & ! Raindrops distrib. param. - XRTMIN, & ! min values of the water m. r. - XCTMIN ! min values of the drop C. -USE MODD_PARAM_LIMA_WARM, ONLY: XLBC, XLBEXC, & !shape param. of the cloud droplets - XLBR, XLBEXR !shape param. of the raindrops -!! -USE MODI_GAMMA -! -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -IMPLICIT NONE -! -!* 0.1 declarations of arguments -! -REAL, INTENT(IN), OPTIONAL :: PTSTEP ! Double timestep -CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Cloud parameterization -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! air density -REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRTSM ! moist variables at t or t-dt or water m.r. source -REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCTSM ! Cloud water C. at t or t-dt or water m.r. -REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRTSM ! Rain water C. at t or t-dt or water m.r. -REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PABST ! theta and pressure at t -INTEGER, DIMENSION(:,:), INTENT(IN) :: KVECMASK -! -TYPE(METEOTRANSTYPE), DIMENSION(:), INTENT(INOUT) :: TPM - ! meteo variable for CCS -INTEGER, INTENT(IN) :: KYEAR ! Current Year -INTEGER, INTENT(IN) :: KMONTH ! Current Month -INTEGER, INTENT(IN) :: KDAY ! Current Day -INTEGER, INTENT(IN) :: KLUOUT ! channel for output listing -INTEGER, INTENT(IN) :: KL, KVECNPT -REAL, DIMENSION(:,:), INTENT(IN) :: PLAT, PLON -REAL, INTENT(IN) :: PLAT0, PLON0 -LOGICAL, INTENT(IN) :: OUSERV, OUSERC, OUSERR -! -!* 0.2 declarations of local variables -! -REAL,DIMENSION(SIZE(PRTSM,1),SIZE(PRTSM,2),SIZE(PRTSM,3),3) :: ZRTSM -REAL,DIMENSION(SIZE(PRTSM,1),SIZE(PRTSM,2)) :: ZLAT, ZLON -REAL,DIMENSION(SIZE(PRTSM,1),SIZE(PRTSM,2),SIZE(PRTSM,3)) :: ZCCTSM, ZCRTSM -REAL,DIMENSION(SIZE(PRTSM,1),SIZE(PRTSM,2),SIZE(PRTSM,3)) :: ZRAYC, ZWLBDC, ZWLBDC3 -REAL,DIMENSION(SIZE(PRTSM,1),SIZE(PRTSM,2),SIZE(PRTSM,3)) :: ZRAYR, ZWLBDR, ZWLBDR3 -LOGICAL, SAVE :: GSFIRSTCALL = .TRUE. -INTEGER :: JI,JJ,JK,JM -INTEGER :: IDTI,IDTJ,IDTK -! -! -!------------------------------------------------------------------------------- -! -!* 1. INITIALIZE METEO VARIABLE TRANSFER -! ---------------------------------- -! -firstcall : IF (GSFIRSTCALL) THEN -! - GSFIRSTCALL = .FALSE. -! -!* 1.1 check if number of variables NMETEOVARS -! corresponds to what the CCS expects -! - IF (NMETEOVARS /= 13) THEN - WRITE(KLUOUT,*) "CH_METEO_TRANS ERROR: number of meteovars to transfer" - WRITE(KLUOUT,*) "does not correspond to the number expected by the CCS:" - WRITE(KLUOUT,*) " meteovars to transfer: ", 13 - WRITE(KLUOUT,*) " NMETEOVARS expected: ", NMETEOVARS - WRITE(KLUOUT,*) "Check the definition of NMETEOVARS in your .chf file." - WRITE(KLUOUT,*) "The program will be stopped now!" - STOP 1 - END IF -! -!* 1.2 initialize names of meteo vars -! - TPM(:)%CMETEOVAR(1) = "Model level" - TPM(:)%CMETEOVAR(2) = "Air density (kg/m3)" - TPM(:)%CMETEOVAR(3) = "Temperature (K)" - TPM(:)%CMETEOVAR(4) = "Water vapor (kg/kg)" - TPM(:)%CMETEOVAR(5) = "Cloud water (kg/kg)" - TPM(:)%CMETEOVAR(6) = "Latitude (rad)" - TPM(:)%CMETEOVAR(7) = "Longitude (rad)" - TPM(:)%CMETEOVAR(8) = "Current date (year)" - TPM(:)%CMETEOVAR(9) = "Current date (month)" - TPM(:)%CMETEOVAR(10)= "Current date (day)" - TPM(:)%CMETEOVAR(11)= "Rain water (kg/kg)" - TPM(:)%CMETEOVAR(12)= "Mean cloud droplets radius (m)" - TPM(:)%CMETEOVAR(13)= "Mean raindrops radius (m)" -! -ENDIF firstcall -! -! "Water vapor (kg/kg)" -! -IF (OUSERV) THEN -! if split option, use tendency - IF (PRESENT(PTSTEP)) THEN - ZRTSM(:,:,:,1) = (PRTSM(:,:,:, 1)/ PRHODJ(:,:,:))*PTSTEP - ELSE - ZRTSM(:,:,:,1) = PRTSM(:,:,:, 1) - ENDIF -ELSE - ZRTSM(:,:,:,1) = 0.0 -ENDIF -! -! "Cloud water (kg/kg)" and "Mean cloud droplets radius (m)" -! -IF (OUSERC) THEN - IF (PRESENT(PTSTEP)) THEN - ZRTSM(:,:,:,2) = (PRTSM(:,:,:, 2)/ PRHODJ(:,:,:))*PTSTEP - ZCCTSM(:,:,:) = (PCCTSM(:,:,:)/ PRHODJ(:,:,:))*PTSTEP - ELSE - ZRTSM(:,:,:,2) = PRTSM(:,:,:, 2) - ZCCTSM(:,:,:) = PCCTSM(:,:,:) - ENDIF - ZWLBDC3(:,:,:) = 1.E30 - ZWLBDC(:,:,:) = 1.E10 - ZRAYC(:,:,:) = 10.e-6 ! avoid division by zero - WHERE (ZRTSM(:,:,:, 2)>XRTMIN(2) .AND. ZCCTSM(:,:,:)>XCTMIN(2)) - ZWLBDC3(:,:,:) = XLBC * ZCCTSM(:,:,:) / (PRHODREF(:,:,:) * ZRTSM(:,:,:, 2)) - ZWLBDC(:,:,:) = ZWLBDC3(:,:,:)**XLBEXC - ZRAYC(:,:,:) = 0.5*GAMMA(XNUC+1./XALPHAC)/(GAMMA(XNUC)*ZWLBDC(:,:,:)) - END WHERE -ELSE - ZRTSM(:,:,:,2) = 0.0 - ZCCTSM(:,:,:) = 0.0 - ZRAYC(:,:,:) = 10.e-6 ! avoid division by zero -ENDIF -! -! "Rain water (kg/kg)" and "Mean raindrops radius (m)" -! -IF (OUSERR) THEN - IF (PRESENT(PTSTEP)) THEN - ZRTSM(:,:,:,3) = (PRTSM(:,:,:, 3)/ PRHODJ(:,:,:))*PTSTEP - ZCRTSM(:,:,:) = (PCRTSM(:,:,:)/ PRHODJ(:,:,:))*PTSTEP - ELSE - ZRTSM(:,:,:,3) = PRTSM(:,:,:, 3) - ZCRTSM(:,:,:) = PCRTSM(:,:,:) - ENDIF - ZWLBDR3(:,:,:) = 1.E30 - ZWLBDR(:,:,:) = 1.E10 - ZRAYR(:,:,:) = 500.e-6 ! avoid division by zero - WHERE (ZRTSM(:,:,:, 3)>XRTMIN(3) .AND. ZCRTSM(:,:,:)>XCTMIN(3)) - ZWLBDR3(:,:,:) = XLBR * ZCRTSM(:,:,:) / (PRHODREF(:,:,:) * ZRTSM(:,:,:, 3)) - ZWLBDR(:,:,:) = ZWLBDR3(:,:,:)**XLBEXR - ZRAYR(:,:,:) = 0.5*GAMMA(XNUR+1./XALPHAR)/(GAMMA(XNUR)*ZWLBDR(:,:,:)) - END WHERE -ELSE - ZRTSM(:,:,:,3) = 0.0 - ZCRTSM(:,:,:) = 0.0 - ZRAYR(:,:,:) = 500.e-6 ! avoid division by zero -ENDIF - -IF(LCARTESIAN) THEN -! "Latitude (rad)" - ZLAT(:,:) = PLAT0 -! "Longitude (rad)" - ZLON(:,:) = PLON0 -ELSE -! "Latitude (rad)" - ZLAT(:,:) = PLAT(:,:) -! "Longitude (rad)" - ZLON(:,:) = PLON(:,:) -END IF -!! -!* 2. TRANSFER METEO VARIABLES -! ------------------------ -! -IDTI=KVECMASK(2,KL)-KVECMASK(1,KL)+1 -IDTJ=KVECMASK(4,KL)-KVECMASK(3,KL)+1 -IDTK=KVECMASK(6,KL)-KVECMASK(5,KL)+1 -!Vectorization: -!ocl novrec -!cdir nodep -DO JM=0,KVECNPT-1 - JI=JM-IDTI*(JM/IDTI)+KVECMASK(1,KL) - JJ=JM/IDTI-IDTJ*(JM/(IDTI*IDTJ))+KVECMASK(3,KL) - JK=JM/(IDTI*IDTJ)-IDTK*(JM/(IDTI*IDTJ*IDTK))+KVECMASK(5,KL) -! -!"Model Altitude" -! - TPM(JM+1)%XMETEOVAR(1) = JK-1 ! assuming first model level is level 2 -! TPM(JM+1)%XMETEOVAR(1) = JK ! assuming first model level is level 1 -! -! "Air density (kg/m3)" -! - TPM(JM+1)%XMETEOVAR(2) = PRHODREF(JI, JJ, JK) -! -! "Temperature (K)" -! - TPM(JM+1)%XMETEOVAR(3) = PTHT(JI,JJ,JK)*((PABST(JI,JJ,JK)/XP00)**(XRD/XCPD)) -! -! "Water vapor (kg/kg)" -! - TPM(JM+1)%XMETEOVAR(4) = ZRTSM(JI, JJ, JK, 1) -! -! "Cloud water (kg/kg)" -! - TPM(JM+1)%XMETEOVAR(5) = ZRTSM(JI, JJ, JK, 2) -! -! "Latitude (rad)" -! - TPM(JM+1)%XMETEOVAR(6) = ZLAT(JI, JJ) -! -! "Longitude (rad)" -! - TPM(JM+1)%XMETEOVAR(7) = ZLON(JI, JJ) -! -! "Current date" -! - TPM(JM+1)%XMETEOVAR(8) = FLOAT(KYEAR) - TPM(JM+1)%XMETEOVAR(9) = FLOAT(KMONTH) - TPM(JM+1)%XMETEOVAR(10)= FLOAT(KDAY) -! -! "Rain water (kg/kg)" -! - TPM(JM+1)%XMETEOVAR(11) = ZRTSM(JI, JJ, JK, 3) -! -! "Mean cloud droplets radius (m)" -! - TPM(JM+1)%XMETEOVAR(12) = ZRAYC(JI, JJ, JK) -! -! "Mean raindrops radius (m)" -! - TPM(JM+1)%XMETEOVAR(13) = ZRAYR(JI, JJ, JK) -! -ENDDO -! -END SUBROUTINE CH_METEO_TRANS_LIMA diff --git a/src/ICCARE_BASE/ch_monitorn.f90 b/src/ICCARE_BASE/ch_monitorn.f90 deleted file mode 100644 index be5f6033e..000000000 --- a/src/ICCARE_BASE/ch_monitorn.f90 +++ /dev/null @@ -1,1628 +0,0 @@ -!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!! ######################## - MODULE MODI_CH_MONITOR_n -!! ######################## -!! -!! -INTERFACE -!! -SUBROUTINE CH_MONITOR_n(PWETDEPAER, KTCOUNT,PTSTEP, KLUOUT, KVERB) -IMPLICIT NONE -REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PWETDEPAER ! tendency of aerosol wet depostion -INTEGER, INTENT(IN) :: KTCOUNT ! iteration count -REAL, INTENT(IN) :: PTSTEP ! Double timestep except - ! for the first time step (single one) -INTEGER, INTENT(IN) :: KLUOUT ! unit for output listing count -INTEGER, INTENT(IN) :: KVERB ! verbosity level -END SUBROUTINE CH_MONITOR_n -!! -END INTERFACE -!! -END MODULE MODI_CH_MONITOR_n -!! -!! ####################################################### - SUBROUTINE CH_MONITOR_n(PWETDEPAER, KTCOUNT,PTSTEP, KLUOUT, KVERB) -!! ####################################################### -!! -!! PURPOSE -!! ------- -!! The purpose of this subroutine is to control the chemical module -!! i.e. to pass the meteorological parameters from MesoNH to its chemical -!! part and to call the different subroutines (calculation of rate constants, -!! photolysis rates, stiff solver,..) -!! -!! METHOD -!! ------ -!! The calculation of the chemical terms is performed using a loop -!! over all spatial dimensions. -!! -!! For each single grid point, all necessary meteorological parameters are -!! passed into the chemical core system (variable TZM). This variable is -!! then passed on to the subroutines that calculate the reaction and -!! photolysis rates. Then the chemical solver is called. As the chemistry -!! part works with different units than MesoNH (MesoNH uses mixing ratio, -!! the chemisty part uses molec/cm3) some unit conversion is also performed. -!! -!! Temporal integration is performed over a double timestep 2*XTSTEP -!! (except in the case of a cold start). If the timestep of MesoNH -!! is too large for the chemical solver, several smaller steps can -!! be taken using the NCH_SUBSTEPS parameter. -!! Three options of temporal discretization are implemented: -!! "SPLIT" : from XRSVS the scalar variable at t+dt is calculated and -!! given as input to the solver; the result is rewritten -!! into XRSVS; this corresponds to applying first only dynamics -!! and then only chemistry; this option assures positivity, but -!! degrades the order of the temporal integration. -!! In fact, an overhead of a factor two is produced here. -!! A future solution will be to calculate the dynamics -!! of the scalar variables not using leapfrog, but forward -!! temporal integration. -!! "CENTER" : the scalar variables at t (XSVT) are taken in order to -!! calculate the tendencies for chemistry, that are then applied -!! together with all other terms in parallel; this option -!! is consistent with the MesoNH leapfrog scheme, but -!! unfortunately it tends to be unstable due to the stiffness -!! of the chemical system; thus this option is not recommended. -!! "LAGGED" : the scalar variables at t-dt (XSVM) are taken in order to -!! calculate the tendencies for chemistry, that are then applied -!! together with all other terms in parallel; this option -!! does not garantee positivity, but seems to be stable. -!! The options "CENTER" and "LAGGED" are implemented more for test than -!! for production purposes. -!! -!! REFERENCE -!! --------- -!! Book 1, 2, 3 of MesoNH-chemistry -!! -!! AUTHOR -!! ------ -!! K. Suhre *Laboratoire d'Aerologie* -!! -!! MODIFICATIONS -!! ------------- -!! Original 24/05/95 -!! 26/10/95 KS: add conversion mixing ratio -> concentration -!! and use first guess variable as input (split) -!! 27/10/95 KS: change parameterlist -!! 04/08/96 (K. Suhre) restructered in order to run with grid-nesting -!! 09/03/99 (V. Crassier & K. Suhre) vectorization -!! 09/03/99 (K. Suhre) TUV online -!! 06/06/00 (C. Mari) add 1-D timeseries for chemistry -!! 21/03/01 (C. Mari & J. Escobar) Code optimization -!! 01/08/01 (C. Mari) change CH_SOLVER to $n -!! 01/12/03 (D. Gazen) change Chemical scheme interface -!! 01/01/04 (P. Tulet) Bugs in conversion for CENTER and LAGGED options -!! 01/01/06 (P. Tulet) ORILAM aerosol scheme -!! 04/06/07 (M. Leriche) add pH -!! 30/07/07 (JP Pinty) add Rosenbrock solver -!! 26/03/08 (M Leriche) add microphysical transfert from collision/coalescence -!! 10/11/08 (M Leriche) add microphysical transfert from rain sedimentation -!! 24/04/14 (M Leriche) Bugs in orilam transfert zsvt in xrsvs -!! + supress line transfer H2SO4 from AP to gas phase -!! imply transfer H2SO4 AP in aqueous phase if aq.chem. -!! 04/2014 (C.Lac) Remove GCENTER with FIT temporal scheme -!! 06/11/14 (M Leriche) Bug in pH computing -!! 11/12/15 (M. Leriche & P. Tulet) add ch_init_ice initialise index for ice chem. -!! 18/01/16 (M Leriche) for sedimentation fusion C2R2 and khko -!! 15/02/16 (M Leriche) call ch_init_rosenbrock only one time -!! 01/10/17 (C.Lac) add correction of negativity -! P. Wautelet 12/02/2019: bugfix: ZINPRR was not initialized all the time -! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg -! P. Wautelet 02/2020: use the new data structures and subroutines for budgets -!! -!! EXTERNAL -!! -------- -USE MODI_CH_METEO_TRANS_KESS -USE MODI_CH_METEO_TRANS_C2R2 -USE MODI_CH_METEO_TRANS_LIMA -USE MODI_CH_SET_RATES -USE MODI_CH_SET_PHOTO_RATES -USE MODI_CH_SOLVER_n -USE MODI_CH_UPDATE_JVALUES -use modd_budget, only: lbudget_sv, NBUDGET_SV1, tbudgets -USE MODI_CH_INIT_ICE -USE MODI_CH_AQUEOUS_TMICICE -USE MODI_CH_AQUEOUS_TMICKESS -USE MODI_CH_AQUEOUS_TMICC2R2 -USE MODI_CH_AQUEOUS_TMICKHKO -USE MODI_CH_AQUEOUS_SEDIM1MOM -USE MODI_CH_AQUEOUS_SEDIM2MOM -USE MODI_CH_AQUEOUS_CHECK -USE MODI_CH_AER_SEDIM_n -USE MODI_CH_AER_WETDEP_n -USE MODI_CH_ORILAM -USE MODI_CH_INI_ORILAM -USE MODI_CH_AER_EQM_CORMASS -USE MODI_CH_AER_SURF -USE MODI_CH_AER_DEPOS -! -use mode_budget, only: Budget_store_end, Budget_store_init -USE MODE_ll -USE MODE_MODELN_HANDLER -use mode_msg -USE MODE_SUM_ll -! -USE MODI_WRITE_TS1D -USE MODD_CST, ONLY : XMNH_TINY -! -USE MODI_CH_PRODLOSS -! IMPLICIT ARGUMENTS -! ------------------ -! -use modd_budget, only: lbudget_sv, NBUDGET_SV1, tbudgets -USE MODD_LUNIT_n -USE MODD_NSV, ONLY : NSV_CHEMBEG,NSV_CHEMEND,NSV_CHEM,& ! index for chemical SV - NSV_CHACBEG,NSV_CHACEND,NSV_CHAC,& ! index for aqueous SV - NSV_CHGSBEG,NSV_CHGSEND, & ! index for gas phase SV - NSV_CHICBEG,NSV_CHICEND, & ! index for ice phase SV - NSV_C2R2BEG,NSV_LIMA_NC,NSV_LIMA_NR, & ! index for number concentration - NSV_AERBEG, NSV_AEREND, NSV_AER, & ! index for aerosols SV - XSVMIN -! -USE MODD_CH_M9_n, ONLY: NEQ, &! number of prognostic chem. species - NEQAQ, &! number of aqueous chem. species - NMETEOVARS, &! number of meteorological variables - CNAMES, &! names of the chem. species - CICNAMES, &! names of the ice chem. species - METEOTRANSTYPE, &! type for meteo . transfer - NREAC, & - NNONZEROTERMS, & - CREACS -! -USE MODI_CH_TERMS -USE MODI_CH_NONZEROTERMS -USE MODI_CH_GET_RATES -! -USE MODD_CH_MNHC_n, ONLY: CCH_TDISCRETIZATION - ! temporal discretization: - ! "SPLIT" : use time-splitting, input fields for solver are - ! scalar variables at t+dt (derived from XRSVS) - ! "CENTER" : input fields for solver are - ! scalar variables at t (XSVT) - ! "LAGGED" : input fields for solver are - ! scalar variables at t-dt (XSVM) -USE MODD_CH_MNHC_n, ONLY: NCH_SUBSTEPS - ! number of chemical timesteps to be taken during one - ! double timestep of MesoNH (MesoNH integrates with timesteps - ! of lenght 2*XTSTEP using leapfrog), the timestep of the - ! solver will be calculated as - ! ZDTSOLVER = 2*XTSTEP/NCH_SUBSTEPS -USE MODD_CH_MNHC_n, ONLY: LCH_TUV_ONLINE, CCH_TUV_LOOKUP, CCH_TUV_CLOUDS, & - XCH_TUV_ALBNEW, XCH_TUV_DOBNEW, XCH_TUV_TUPDATE, & - CCH_VEC_METHOD, NCH_VEC_LENGTH - ! used for vectorization and photolysis rates -USE MODD_CH_MNHC_n, ONLY: LUSECHAQ, LUSECHIC, LCH_PH, LCH_RET_ICE, XRTMIN_AQ - ! aqueous chemistry and pH -USE MODD_CH_SOLVER_n -! -USE MODD_CH_PH_n ! pH value in 3D -! -USE MODD_FIELD_n, ONLY: XSVT, &! scalar variable at t - XRSVS, &! source of scalar variable - XRT, &! water mixing ratio at t - XCIT, &! pristine conc. at t - XRRS, &! source of water mixing ratio - XPABST, &! pressure - XTHT ! potential temperature -! -USE MODD_REF_n, ONLY: XRHODREF, &! dry density for ref. state - XRHODJ ! ( rhod J ) = dry density -! -USE MODD_TIME, ONLY: TDTEXP -! -USE MODD_TIME_n, ONLY: TDTCUR ! Current Time and Date -! -USE MODD_CONF, ONLY: CPROGRAM, L1D, NVERB -USE MODD_PARAM_n, ONLY: CCLOUD -! -USE MODD_PARAMETERS,ONLY: JPHEXT, &! number of horizontal External points - JPVEXT ! number of vertical External points -! -USE MODD_CST, ONLY: XAVOGADRO, &! Avogadro number - XMD, &! Molar mass of dry air - XP00, XRD, XCPD -! -USE MODD_CH_PRODLOSSTOT_n ! Total production/loss for chemical - ! species -USE MODD_CH_BUDGET_n ! Extended production/loss terms for - ! chemical species -! -USE MODD_DIAG_FLAG, ONLY: CSPEC_BU_DIAG,CSPEC_DIAG -! variables used by TUV -! -USE MODD_GRID_n, ONLY: XZZ,& ! height z - XZS,& ! orography - XLAT, XLON -USE MODD_GRID, ONLY: XLAT0,XLON0 ! Reference longitude and latitude -USE MODD_CONF_n, ONLY: LUSERV,& ! Logical to use wapor water - LUSERC,& ! Logical to use cloud water - LUSERR,& ! Logical to use rain water - NRR, & ! Total number of water variables - NRRL ! Number of liquid water variables -USE MODD_SUB_CH_MONITOR_n -USE MODD_DYN_n, ONLY: XTSTEP ! time step of MesoNH -! -! variables used by ORILAM -! -USE MODD_PRECIP_n, ONLY: XEVAP3D -USE MODD_CLOUDPAR_n, ONLY: NSPLITR ! Nb of required small time step integration -! -!variables used by microphysical mass transfer - sedimentation -! -USE MODD_CLOUDPAR_n, ONLY: NSPLITR -! -!variables used by rosenbrock solver -! -USE MODD_CH_ROSENBROCK_n, ONLY: NSPARSEDIM, & ! Dim of NSPARSE_xxx vectors - NSPARSE_IROW, & ! row index - NSPARSE_ICOL, & ! col index - NSPARSE_CROW, & ! first row element index - NSPARSE_DIAG, & ! diag index - NEQ_NAQ, & ! number of Non-AQueous species - NSPARSEDIM_NAQ, & ! Dim of NSPARSE_xxx vectors - NSPARSE_IROW_NAQ, & ! row index - NSPARSE_ICOL_NAQ, & ! col index - NSPARSE_CROW_NAQ, & ! first row element index - NSPARSE_DIAG_NAQ ! diag index - ! of the gridpoint sparse JACobian matrix -! -USE MODD_RBK90_JacobianSP_n ! vectorized form of the sparse indexes -USE MODD_RBK90_Parameters_n, ONLY: NVAR, LU_NONZERO -! -! parameters of the namelist to come -! -USE MODD_VAR_ll -USE MODD_CH_AEROSOL -USE MODD_CH_AERO_n - -USE MODD_CH_INIT_JVALUES, ONLY: JPJVMAX ! number of photolysis reactions in TUV -USE MODD_CH_JVALUES_n, ONLY: XJVALUES -USE MODD_CH_MNHC_n, ONLY: CCH_SCHEME , LCH_CONV_SCAV -USE MODD_RADIATIONS_n, ONLY: XZENITH, XALBUV -! -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -IMPLICIT NONE -! -!* 0.1 declarations of arguments -! -REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PWETDEPAER ! tendency of aerosol wet depostion -INTEGER, INTENT(IN) :: KTCOUNT ! iteration count -REAL, INTENT(IN) :: PTSTEP ! Double timestep except - ! for the first time step (single one) -INTEGER, INTENT(IN) :: KLUOUT ! unit for output listing count -INTEGER, INTENT(IN) :: KVERB ! verbosity level -! -!* 0.2 declarations of local variables -! -INTEGER :: JI,JJ,JK,JL,JM,JN ! loop counters -REAL :: ZDTSOLVER ! timestep for the solver -! -REAL, DIMENSION(:,:), ALLOCATABLE :: ZCHEM, ZOLDCHEM, ZNEWCHEM -REAL, DIMENSION(:,:), ALLOCATABLE :: ZAERO, ZOLDAERO, ZNEWAERO - ! arrays for parameter passage to solver -! -REAL, DIMENSION(:), ALLOCATABLE :: ZCONV - ! conversion factor mixing ratio * RhoDJ ! to molec./cm3 -! -REAL, DIMENSION(:,:), ALLOCATABLE :: ZPH -! -!Varibales for integrated prod/loss for given species -REAL, DIMENSION(:,:), ALLOCATABLE :: ZPRODTOT ! Production/loss tables -REAL, DIMENSION(:,:), ALLOCATABLE :: ZLOSSTOT ! for all species -REAL, DIMENSION(:,:), ALLOCATABLE :: ZPROD ! Production/loss tables -REAL, DIMENSION(:,:), ALLOCATABLE :: ZLOSS ! for selected species -! -!Variables for detailed production/destruction terms for given species -REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTCHEMTOT ! detailed production/loss terms -INTEGER, DIMENSION(:,:),ALLOCATABLE :: IINDEX ! indices of non-zero terms -INTEGER :: IREAC ! indices of reaction -INTEGER, DIMENSION(:),ALLOCATABLE :: IIND -TYPE REAC - INTEGER, DIMENSION(:), POINTER :: IB_REAC - REAL , DIMENSION(:,:), POINTER :: ZB_REAC -END TYPE -TYPE (REAC), ALLOCATABLE, DIMENSION(:) :: ZTCHEM -! -INTEGER :: JO -INTEGER :: JR -INTEGER :: JS -! -! -REAL :: ZDEN2MOL - ! ZDEN2MOL = 6.0221367E+23 * 1E-6 / 28.9644E-3 - ! conversion factor density to mol/cm3 - ! n_molec (moelc./cm3): M = 1E-6*RHO(kg/m3) * XAVOGADRO / XMD -! -TYPE(METEOTRANSTYPE), DIMENSION(:), ALLOCATABLE :: TZM - ! meteo variables to be transferred into CCS -! -! -LOGICAL :: GSPLIT ! use timesplitting as temporal discretization -! -INTEGER :: IIU ! Upper dimension in x direction -INTEGER :: IJU ! Upper dimension in y direction -INTEGER :: IKU ! Upper dimension in z direction -INTEGER :: IIB ! indice I Beginning in x direction -INTEGER :: IJB ! indice J Beginning in y direction -INTEGER :: IKB ! indice K Beginning in z direction -INTEGER :: IIE ! indice I End in x direction -INTEGER :: IJE ! indice J End in y direction -INTEGER :: IKE ! indice K End in z direction -! -!--------------------------------------------------------------------------- -! variables for the vectorization -! -INTEGER :: ITOT,IMAX,IDUM -LOGICAL :: GEND,GENDTOT -! -INTEGER :: IDTI,IDTJ,IDTK -INTEGER :: IDT1,IDT2,IDT3 -INTEGER :: IDUMI,IDUMJ,IDUMK -INTEGER :: ITOTI,ITOTJ,ITOTK -! -!------------------------------------------------------------------------------- -! variables for TUV -! -REAL :: ZRATIO, ZMASSTOT, ZMASSPOS -INTEGER :: IINFO_ll ! return code of parallel routine -INTEGER :: JSV ! loop index for SV -INTEGER :: IMI ! model index -! -!------------------------------------------------------------------------------- -! variables for the aerosol module -! -REAL :: ZTIME ! current time -REAL, ALLOCATABLE, DIMENSION(:,:) :: ZM, ZLNSIG, ZN, ZRG, & ! work array - ZCTOTG, ZSEDA, ZFRAC, ZMI, & ! for aerosols - ZMBEG,ZMINT,ZMEND,& - ZDMINTRA,ZDMINTER,ZDMCOND,ZDMNUCL,ZDMMERG -REAL, ALLOCATABLE, DIMENSION(:,:,:) :: ZCTOTA, ZCCTOT - ! first dimension is vectorization, - ! second dim. are the modes*moments -REAL, ALLOCATABLE, DIMENSION(:) :: ZCONC_MASS,ZCOND_MASS_I,ZCOND_MASS_J,ZNUCL_MASS -REAL, DIMENSION(:), ALLOCATABLE :: ZRV, ZDENAIR, ZPRESSURE, ZTEMP, ZRC -REAL, DIMENSION(:,:), ALLOCATABLE :: ZRHOP, ZSOLORG -REAL, DIMENSION(:), ALLOCATABLE :: ZSO4RAT -REAL, DIMENSION(:), ALLOCATABLE :: ZJNUC, ZJ2RAT - -REAL,DIMENSION(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),SIZE(XSVT,4)) :: ZSVT -REAL,DIMENSION(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),NSV_AER) :: ZCWETAERO -! -!------------------------------------------------------------------------------- -! variables for AQueous/NAQueous cases -! -INTEGER :: JRR ! Loop index for the moist variables -REAL,DIMENSION(SIZE(XRT,1),SIZE(XRT,2),SIZE(XRT,3),SIZE(XRT,4)) :: ZRT_VOL - ! liquid content in vol/vol -REAL, DIMENSION(SIZE(XRT,1), SIZE(XRT,2)) :: ZINPRR! Rain instant precip -! -!------------------------------------------------------------------------------- -! -! get model index -IMI = GET_CURRENT_MODEL_INDEX() -! -if ( lbudget_sv ) then - do jsv = nsv_chembeg, nsv_chemend - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jsv), 'CHEM', xrsvs(:, :, :, jsv) ) - enddo - do jsv = nsv_aerbeg, nsv_aerend - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jsv), 'AER', xrsvs(:, :, :, jsv) ) - enddo -endif - -!* 1. PREPARE MONITOR -! --------------- -! -!* 1.1 compute dimensions of arrays -! -CALL GET_DIM_EXT_ll ('B',IIU,IJU) -CALL GET_INDICE_ll (IIB,IJB,IIE,IJE) -IKU = SIZE(XRSVS,3) -IKB = 1 + JPVEXT -IKE = IKU - JPVEXT -! -! Correction of negativity -! -DO JSV = 1, SIZE(XSVT,4) - XRSVS(:,:,:,JSV) = MAX((XRSVS(:,:,:,JSV)),XSVMIN(JSV)) -END DO -! -! -IF (KTCOUNT == 1) THEN -! -! 1.1.1 determine mask to use for vectorisation at first step -! - IDTI=(IIE-IIB+1) - IDTJ=(IJE-IJB+1) - IDTK=(IKE-IKB+1) - ITOT=IDTI*IDTJ*IDTK -! -! the mask option will become a namelist parameter -! - SELECT CASE (CCH_VEC_METHOD) -! -!*************************************************** -! No mask (local) -!*************************************************** - CASE('LOC') -! - ISVECNPT=1 - ISVECNMASK=ITOT - IDT1=1 - IDT2=1 - IDT3=1 -! -!*************************************************** -! Horizontal mask -!*************************************************** - CASE('HOR') -! - ISVECNPT=IDTI*IDTJ - ISVECNMASK=IDTK - IDT1=IDTI - IDT2=IDTJ - IDT3=1 -! -!*************************************************** -! Vertical mask -!*************************************************** - CASE('VER') -! - ISVECNPT=IDTJ*IDTK - ISVECNMASK=IDTI - IDT1=1 - IDT2=IDTJ - IDT3=IDTK -! -!*************************************************** -! 1 mask with all grid points -! (no parallelisation) -!*************************************************** - CASE('TOT') -! - ISVECNPT=IDTI*IDTJ*IDTK - ISVECNMASK=1 - IDT1=IDTI - IDT2=IDTJ - IDT3=IDTK -! -!**************************************************** -! Choice of a maximum number of points -!**************************************************** - CASE('MAX') -! - GEND=.FALSE. - GENDTOT=.FALSE. -! - IMAX=MIN(NCH_VEC_LENGTH,ITOT) -! - DO WHILE (.NOT.(GENDTOT)) -! - IDUM=IMAX - DO WHILE (.NOT.(GEND)) - IF ((ITOT-IDUM*(ITOT/IDUM)) == 0) THEN - GEND=.TRUE. - ISVECNMASK=ITOT/IDUM - ISVECNPT=IDUM - ELSE - IDUM=IDUM-1 - END IF - END DO -! - GEND=.FALSE. - ITOTI=ISVECNPT - IDUMI=IDTI - DO WHILE (.NOT.(GEND) .AND. IDUMI >= 1) - IF ( (ITOTI-IDUMI*(ITOTI/IDUMI)) == 0 & - .AND. (IDTI-IDUMI*(IDTI/IDUMI)) == 0) THEN - IDT1=IDUMI - ITOTJ=ITOTI/IDUMI - IDUMJ=IDTJ - DO WHILE (.NOT.(GEND) .AND. IDUMJ >= 1) - IF ( (ITOTJ-IDUMJ*(ITOTJ/IDUMJ)) == 0 & - .AND. (IDTJ-IDUMJ*(IDTJ/IDUMJ)) == 0) THEN - IDT2=IDUMJ - ITOTK=ITOTJ/IDUMJ - IDUMK=IDTK - DO WHILE (.NOT.(GEND) .AND. IDUMK >= 1) - IF ( (ITOTK-IDUMK*(ITOTK/IDUMK)) == 0 & - .AND. (IDTK-IDUMK*(IDTK/IDUMK)) == 0) THEN - IDT3=IDUMK - GEND=.TRUE. - ELSE - IDUMK=IDUMK-1 - END IF - END DO - ELSE - IDUMJ=IDUMJ-1 - END IF - END DO - ELSE - IDUMI=IDUMI-1 - END IF - END DO -! - GENDTOT=GEND -! - END DO -! - END SELECT -! - ALLOCATE (ISVECMASK(6,ISVECNMASK)) -! -!********************************** -! Compute mask boundaries -!********************************** -! - ISVECMASK(1,1)=IIB - ISVECMASK(2,1)=IIB+IDT1-1 - ISVECMASK(3,1)=IJB - ISVECMASK(4,1)=IJB+IDT2-1 - ISVECMASK(5,1)=IKB - ISVECMASK(6,1)=IKB+IDT3-1 -! - IF (ISVECNMASK .GE. 2) THEN - DO JI=2,ISVECNMASK - ISVECMASK(1,JI)=ISVECMASK(1,JI-1)+IDT1-IIB - ISVECMASK(3,JI)=ISVECMASK(3,JI-1) - ISVECMASK(5,JI)=ISVECMASK(5,JI-1) -! - ISVECMASK(3,JI)=ISVECMASK(3,JI)+(ISVECMASK(1,JI)/IDTI)*IDT2-IJB - ISVECMASK(5,JI)=ISVECMASK(5,JI)+(ISVECMASK(3,JI)/IDTJ)*IDT3-IKB -! - ISVECMASK(1,JI)=ISVECMASK(1,JI)-IDTI*(ISVECMASK(1,JI)/IDTI)+IIB - ISVECMASK(3,JI)=ISVECMASK(3,JI)-IDTJ*(ISVECMASK(3,JI)/IDTJ)+IJB - ISVECMASK(5,JI)=ISVECMASK(5,JI)-IDTK*(ISVECMASK(5,JI)/IDTK)+IKB -! - ISVECMASK(2,JI)=ISVECMASK(1,JI)+IDT1-1 - ISVECMASK(4,JI)=ISVECMASK(3,JI)+IDT2-1 - ISVECMASK(6,JI)=ISVECMASK(5,JI)+IDT3-1 - END DO - END IF -! -! 1.1.2 determine sparse indexes to describe the jacobian matrix -! with vectorisation in a Rosenbrock solver without aqueous -! chemistry -! - IF (CSOLVER(1:2)=="RO" .AND. NEQAQ==0) THEN ! only for gaseous chemistry rosenbrock solver - CALL PREPARE_LU_ROSENBROCK - END IF -! - ALLOCATE(LU_DIM_SPECIES(ISVECNPT)) - LU_DIM_SPECIES(:) = NEQ -! -! 1.1.3 determine index for ice phase chemistry or degassing with ICE3/4 - IF ((LUSECHAQ).AND.((CCLOUD=='ICE3' .OR. CCLOUD=='ICE4'))) THEN - CALL CH_INIT_ICE(LUSECHIC,LCH_RET_ICE,CNAMES,CICNAMES,NEQ,NEQAQ) - ENDIF -! -ENDIF ! first time step -! -!* 1.2 calculate timestep variables -! -ZDTSOLVER = PTSTEP / NCH_SUBSTEPS -! -!* 1.3 give minimum value and conserve mass for aerosols -! -! -IF (LORILAM) THEN - - IF (CPROGRAM/='DIAG ') THEN - DO JSV = 1, SIZE(XSVT,4) - ZSVT(:,:,:,JSV) = XRSVS(:,:,:,JSV) *PTSTEP / XRHODJ(:,:,:) - END DO - ELSE - DO JSV = 1, SIZE(XSVT,4) - ZSVT(:,:,:,JSV) = XSVT(:,:,:,JSV) - END DO - END IF - ZSVT(:,:,:,NSV_CHEMBEG:NSV_CHEMEND) = MAX(ZSVT(:,:,:,NSV_CHEMBEG:NSV_CHEMEND), XMNH_TINY) - ZSVT(:,:,:,NSV_AERBEG:NSV_AEREND) = MAX(ZSVT(:,:,:,NSV_AERBEG:NSV_AEREND), XMNH_TINY) -! -END IF -! -!* 1.4 compute conversion factor ppp/m3 --> molec/cm3 -! -ZDEN2MOL = 1E-6 * XAVOGADRO / XMD -! -!* 1.5 set logical variables for temporal discretization -! -SELECT CASE (CCH_TDISCRETIZATION) - CASE ("SPLIT") - GSPLIT = .TRUE. - IF (KVERB >= 10) WRITE(KLUOUT,*) "CH_MONITOR_n: using SPLIT option" - CASE ("CENTER") - GSPLIT = .FALSE. - IF (KVERB >= 10) WRITE(KLUOUT,*) "CH_MONITOR_n: using CENTER option" - CASE ("LAGGED") - GSPLIT = .FALSE. - IF (KVERB >= 10) WRITE(KLUOUT,*) "CH_MONITOR_n: using LAGGED option" - CASE DEFAULT - ! the following line should never be reached: - ! callabortstop - CALL ABORT - STOP "CH_MONITOR_n: CCH_TDISCRETIZATION option not valid" -END SELECT -! -! -IF (LEN_TRIM(CSPEC_BU_DIAG)/=0.OR.LEN_TRIM(CSPEC_DIAG)/=0) GSPLIT=.FALSE. ! Modif. for DIAG -IF (CPROGRAM=='DIAG ') GSPLIT=.FALSE. ! Modif. for DIAG -! -! -!* 1.6 allocate tables -! -ALLOCATE(TZM(ISVECNPT)) -ALLOCATE(ZCHEM(ISVECNPT,NEQ)) !dimension of the 2nd row NEQ is provisional -ALLOCATE(ZNEWCHEM(ISVECNPT,NEQ)) !dimension of the 2nd row NEQ is provisional -ALLOCATE(ZOLDCHEM(ISVECNPT,NEQ)) !dimension of the 2nd row NEQ is provisional -ALLOCATE(ZCONV(ISVECNPT)) -IF (LUSECHAQ.AND.LCH_PH) ALLOCATE(ZPH(ISVECNPT,NRRL)) -IF (NEQ_PLT>0) THEN - ALLOCATE(ZPRODTOT(ISVECNPT,NEQ)) - ALLOCATE(ZLOSSTOT(ISVECNPT,NEQ)) - ALLOCATE(ZPROD(ISVECNPT,NEQ_PLT)) - ALLOCATE(ZLOSS(ISVECNPT,NEQ_PLT)) -END IF -IF (NEQ_BUDGET>0) THEN - ALLOCATE(ZTCHEMTOT(ISVECNPT,NEQ,NREAC)) - ALLOCATE(ZTCHEM(NEQ_BUDGET)) - ALLOCATE(IIND(NEQ_BUDGET)) - ALLOCATE(IINDEX(2,NNONZEROTERMS)) - CALL CH_NONZEROTERMS(IMI,IINDEX,NNONZEROTERMS) - DO JM=1,NEQ_BUDGET - IIND(JM)=COUNT((IINDEX(1,:))==NSPEC_BUDGET(JM)) - ALLOCATE(ZTCHEM(JM)%IB_REAC(IIND(JM))) - ALLOCATE(ZTCHEM(JM)%ZB_REAC(ISVECNPT,IIND(JM))) - END DO -END IF -IF (LORILAM) THEN - ALLOCATE(ZAERO(ISVECNPT,NSV_AER)) - ALLOCATE(ZNEWAERO(ISVECNPT,NSV_AER)) - ALLOCATE(ZOLDAERO(ISVECNPT,NSV_AER)) - ALLOCATE(ZM(ISVECNPT,JPIN)) - ALLOCATE(ZSEDA(ISVECNPT,JPIN)) - ALLOCATE(ZMBEG(ISVECNPT,JPIN)) - ALLOCATE(ZMINT(ISVECNPT,JPIN)) - ALLOCATE(ZMEND(ISVECNPT,JPIN)) - ALLOCATE(ZDMINTRA(ISVECNPT,JPIN)) - ALLOCATE(ZDMINTER(ISVECNPT,JPIN)) - ALLOCATE(ZDMCOND(ISVECNPT,JPIN)) - ALLOCATE(ZDMNUCL(ISVECNPT,JPIN)) - ALLOCATE(ZDMMERG(ISVECNPT,JPIN)) - ALLOCATE(ZRHOP(ISVECNPT,JPMODE)) - ALLOCATE(ZLNSIG(ISVECNPT,JPMODE)) - ALLOCATE(ZRG(ISVECNPT,JPMODE)) - ALLOCATE(ZN(ISVECNPT,JPMODE)) - ALLOCATE(ZCTOTA(ISVECNPT,NSP+NCARB+NSOA,JPMODE)) - ALLOCATE(ZCCTOT(ISVECNPT,NSP+NCARB+NSOA,JPMODE)) - ALLOCATE(ZCTOTG(ISVECNPT,NSP+NCARB+NSOA)) - ALLOCATE(ZSO4RAT(ISVECNPT)) - ALLOCATE(ZRV(ISVECNPT)) - ALLOCATE(ZRC(ISVECNPT)) - ALLOCATE(ZPRESSURE(ISVECNPT)) - ALLOCATE(ZTEMP(ISVECNPT)) - ALLOCATE(ZDENAIR(ISVECNPT)) - ALLOCATE(ZFRAC(ISVECNPT,NEQ)) - ALLOCATE(ZMI(ISVECNPT,NSP+NCARB+NSOA)) - ALLOCATE(ZSOLORG(ISVECNPT,NSOA)) - ALLOCATE(XSURF(ISVECNPT,JPMODE)) - ALLOCATE(XDP(ISVECNPT,JPMODE)) - ALLOCATE(ZJNUC(ISVECNPT)) - ALLOCATE(ZJ2RAT(ISVECNPT)) - ALLOCATE(ZCONC_MASS(ISVECNPT)) - ALLOCATE(ZCOND_MASS_I(ISVECNPT)) - ALLOCATE(ZCOND_MASS_J(ISVECNPT)) - ALLOCATE(ZNUCL_MASS(ISVECNPT)) -END IF -! -!------------------------------------------------------------------------------- -! -!* 2. UPDATE PHOTOLYSIS RATES -! ----------------------- -! -IF (KTCOUNT==1 .OR. & - (MOD(ISTCOUNT, MAX(1, INT(XCH_TUV_TUPDATE/XTSTEP)) ) .EQ. 0)) THEN -! - WRITE(KLUOUT,*)"TIME call update jvalue: ",TDTCUR%xtime -! - IF (.NOT.ASSOCIATED(XJVALUES)) & - ALLOCATE(XJVALUES(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPJVMAX)) - XJVALUES(:,:,:,:) = 0. - - IF (NVERB .GE. 20) THEN - WRITE(*,*) 'min max XALBUV =', MINVAL(XALBUV), MAXVAL(XALBUV) - ENDIF - - CALL CH_UPDATE_JVALUES(KLUOUT, XZENITH, XRT, & - XALBUV, XZS, XZZ, XLAT0, XLON0, & - SIZE(XZZ,1), SIZE(XZZ,2), SIZE(XZZ,3), NRR, & - TDTCUR%nday, TDTCUR%nmonth, TDTCUR%nyear, TDTCUR%xtime, & - LCH_TUV_ONLINE, CCH_TUV_CLOUDS, & - XCH_TUV_ALBNEW, XCH_TUV_DOBNEW, XRHODREF, XJVALUES, & - IIB,IIE,IJB,IJE,IIU,IJU, KVERB ) -ENDIF -! -ISTCOUNT = ISTCOUNT + 1 -! -!------------------------------------------------------------------------------- -! -!* 3. MICROPHYSICS TERM FOR AEROSOL AND AQUEOUS CHEMISTRY -! --------------------------------------------------- -! -!* 3.1 sedimentation term and wet deposition for aerosols tendency (XSEDA) -! -IF (LORILAM) THEN - ZTIME = TDTCUR%xtime ! need for ch_orilam - XSEDA(:,:,:,:) = 0.0 - ZSEDA(:,:) = 0.0 - ZMBEG(:,:) = 0.0 - ZMINT(:,:) = 0.0 - ZMEND(:,:) = 0.0 - ZDMINTRA(:,:) = 0.0 - ZDMINTER(:,:) = 0.0 - ZDMCOND(:,:) = 0.0 - ZDMNUCL(:,:) = 0.0 - ZDMMERG(:,:) = 0.0 - ! - ! dry sedimentation - ! - IF ((LSEDIMAERO).AND.(CPROGRAM/='DIAG ')) THEN - CALL CH_AER_SEDIM_n(PTSTEP, & - ZSVT(IIB:IIE,IJB:IJE,IKB:IKE,NSV_AERBEG:NSV_AEREND), & - XTHT(IIB:IIE,IJB:IJE,IKB:IKE), XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), & - XPABST(IIB:IIE,IJB:IJE,IKB:IKE), XVDEPAERO(IIB:IIE,IJB:IJE,:), & - XZZ(IIB:IIE,IJB:IJE,IKB:IKE), XSEDA(IIB:IIE,IJB:IJE,IKB:IKE,:)) - ENDIF -! implicit wet deposition - IF ((LCH_CONV_SCAV).AND.(CPROGRAM/='DIAG ')) THEN - DO JN=1,NSV_AER - ZCWETAERO(:,:,:,JN) = (XRSVS(:,:,:,JN+NSV_AERBEG-1)+PWETDEPAER(:,:,:,JN))*PTSTEP / XRHODJ(:,:,:) - END DO - ZCWETAERO(:,:,:,:)= MAX(ZCWETAERO(:,:,:,:), XMNH_TINY) - - CALL CH_AER_WETDEP_n(PTSTEP, ZSVT(IIB:IIE,IJB:IJE,IKB:IKE,NSV_AERBEG:NSV_AEREND), & - ZCWETAERO(IIB:IIE,IJB:IJE,IKB:IKE,:), XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), & - XSEDA(IIB:IIE,IJB:IJE,IKB:IKE,:)) - ENDIF -! explicit wet deposition - IF ((LDEPOS_AER(IMI)).AND.(CPROGRAM/='DIAG ')) THEN - CALL CH_AER_DEPOS(NSPLITR, PTSTEP, & - XZZ(IIB:IIE,IJB:IJE,IKB:IKE), & - XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), & - XRT(IIB:IIE,IJB:IJE,IKB:IKE,:), & - XRRS(IIB:IIE,IJB:IJE,IKB:IKE,:), & - XRHODJ(IIB:IIE,IJB:IJE,IKB:IKE), & - ZSVT(IIB:IIE,IJB:IJE,IKB:IKE,:), & - XMI(IIB:IIE,IJB:IJE,IKB:IKE,:), & - XTHT(IIB:IIE,IJB:IJE,IKB:IKE), & - XPABST(IIB:IIE,IJB:IJE,IKB:IKE), & - XEVAP3D(IIB:IIE,IJB:IJE,IKB:IKE), & - XSEDA(IIB:IIE,IJB:IJE,IKB:IKE,:)) - - ENDIF -! Update aerosol tendency before aerosol solver - DO JSV = 1, SIZE(XSVT,4) - XRSVS(:,:,:,JSV) = ZSVT(:,:,:,JSV) * XRHODJ(:,:,:) / PTSTEP - END DO -ENDIF -! -!* 3.2 check where aqueous concentration>0 + micropÄ¥ysics term -! sedimentation, autoconversion and accretion -! -IF (LUSECHAQ.AND.(NRRL>=2) ) THEN - DO JRR = 2, 3 - ZRT_VOL(:,:,:,JRR) = XRT(:,:,:,JRR)*XRHODREF(:,:,:)/1.e3 - END DO - CALL CH_AQUEOUS_CHECK (PTSTEP, XRHODREF, XRHODJ, XRRS, XRSVS, NRRL, & - NRR, NEQ, NEQAQ, CNAMES, XRTMIN_AQ, LUSECHIC ) - IF (MAXVAL(ZRT_VOL(:,:,:,2))>XRTMIN_AQ) THEN - SELECT CASE ( CCLOUD ) - CASE ('KESS') - CALL CH_AQUEOUS_TMICKESS(PTSTEP, XRHODREF, XRHODJ, XRTMIN_AQ, & - XRT(:,:,:,2), XRT(:,:,:,3), & - XRRS(:,:,:,2), XRRS(:,:,:,3), & - XSVT(:,:,:,NSV_CHACBEG:NSV_CHACBEG-1+NEQAQ/2), & - XRSVS(:,:,:,NSV_CHACBEG:NSV_CHACBEG-1+NEQAQ/2), & - XSVT(:,:,:,NSV_CHACBEG+NEQAQ/2:NSV_CHACEND), & - XRSVS(:,:,:,NSV_CHACBEG+NEQAQ/2:NSV_CHACEND) ) - - CASE ('ICE3','ICE4') - CALL CH_AQUEOUS_TMICICE(PTSTEP, XRHODREF, XRHODJ, XTHT, XPABST, & - XRTMIN_AQ, LUSECHIC, LCH_RET_ICE, CNAMES, & - CICNAMES, NEQ, NEQAQ, & - XRT(:,:,:,1), XRT(:,:,:,2), XRT(:,:,:,3), & - XRT(:,:,:,4), XRT(:,:,:,5), XRT(:,:,:,6), & - XCIT(:,:,:), XRRS(:,:,:,2), XRRS(:,:,:,3), & - XRRS(:,:,:,4), XRRS(:,:,:,5),XRRS(:,:,:,6), & - XSVT(:,:,:,NSV_CHGSBEG:NSV_CHGSEND), & - XRSVS(:,:,:,NSV_CHGSBEG:NSV_CHGSEND), & - XSVT(:,:,:,NSV_CHACBEG:NSV_CHACBEG-1+NEQAQ/2), & - XRSVS(:,:,:,NSV_CHACBEG:NSV_CHACBEG-1+NEQAQ/2), & - XSVT(:,:,:,NSV_CHACBEG+NEQAQ/2:NSV_CHACEND), & - XRSVS(:,:,:,NSV_CHACBEG+NEQAQ/2:NSV_CHACEND), & - XSVT(:,:,:,NSV_CHICBEG:NSV_CHICEND), & - XRSVS(:,:,:,NSV_CHICBEG:NSV_CHICEND) ) - - CASE ('C2R2','C3R5') - CALL CH_AQUEOUS_TMICC2R2(PTSTEP, XRTMIN_AQ, XRHODREF, XRHODJ, & - XRT(:,:,:,2), XRT(:,:,:,3), & - XRRS(:,:,:,2), XRRS(:,:,:,3), & - XSVT(:,:,:,NSV_C2R2BEG+1), XSVT(:,:,:,NSV_C2R2BEG+2),& - XSVT(:,:,:,NSV_CHACBEG:NSV_CHACBEG-1+NEQAQ/2), & - XRSVS(:,:,:,NSV_CHACBEG:NSV_CHACBEG-1+NEQAQ/2), & - XSVT(:,:,:,NSV_CHACBEG+NEQAQ/2:NSV_CHACEND), & - XRSVS(:,:,:,NSV_CHACBEG+NEQAQ/2:NSV_CHACEND) ) - CASE ('KHKO') - CALL CH_AQUEOUS_TMICKHKO(PTSTEP, XRTMIN_AQ, XRHODREF, XRHODJ, & - XRT(:,:,:,2), XRT(:,:,:,3), & - XRRS(:,:,:,2), XRRS(:,:,:,3), & - XRSVS( :,:,:,NSV_C2R2BEG+1), & - XSVT(:,:,:,NSV_C2R2BEG+1), XSVT(:,:,:,NSV_C2R2BEG+2),& - XSVT(:,:,:,NSV_CHACBEG:NSV_CHACBEG-1+NEQAQ/2), & - XRSVS(:,:,:,NSV_CHACBEG:NSV_CHACBEG-1+NEQAQ/2), & - XSVT(:,:,:,NSV_CHACBEG+NEQAQ/2:NSV_CHACEND), & - XRSVS(:,:,:,NSV_CHACBEG+NEQAQ/2:NSV_CHACEND) ) - END SELECT - ENDIF - IF (MAXVAL(ZRT_VOL(:,:,:,3))>XRTMIN_AQ) THEN - SELECT CASE ( CCLOUD ) - CASE ('KESS','ICE3','ICE4') - CALL CH_AQUEOUS_SEDIM1MOM(NSPLITR, CCLOUD, LUSECHIC, & - PTSTEP , XZZ, XRHODREF, & - XRHODJ, XRRS(:,:,:,3), XRRS(:,:,:,5), & - XRRS(:,:,:,6), & - XRSVS(:,:,:,NSV_CHACBEG+NEQAQ/2:NSV_CHACEND), & - XRSVS(:,:,:,NSV_CHICBEG:NSV_CHICEND), & - ZINPRR(:,:) ) - - CASE ('C2R2','C3R5','KHKO') - CALL CH_AQUEOUS_SEDIM2MOM(NSPLITR, CCLOUD, PTSTEP, XRTMIN_AQ, & - XZZ, XRHODREF, XRHODJ, & - XRT(:,:,:,3),XRRS(:,:,:,3), & - XSVT(:,:,:,NSV_C2R2BEG+2), & - XRSVS(:,:,:,NSV_C2R2BEG+2), & - XSVT(:,:,:,NSV_CHACBEG+NEQAQ/2:NSV_CHACEND), & - XRSVS(:,:,:,NSV_CHACBEG+NEQAQ/2:NSV_CHACEND),& - ZINPRR(:,:) ) - - END SELECT - END IF -ELSE IF (LUSECHAQ.AND.(NRRL==1) ) THEN - CALL CH_AQUEOUS_CHECK (PTSTEP, XRHODREF, XRHODJ, XRRS, XRSVS, NRRL, & - NRR, NEQ, NEQAQ, CNAMES, XRTMIN_AQ, LUSECHIC ) -END IF -! -!------------------------------------------------------------------------------- -! -!* 4. INTEGRATE OVER ALL GRID POINTS -! ------------------------------- -! -DO JL=1,ISVECNMASK -! -!* 4.1 transfer chemical species from 4D into 1D array for solver -! and convert from part/part to molec./cm3 -! - IDTI=ISVECMASK(2,JL)-ISVECMASK(1,JL)+1 - IDTJ=ISVECMASK(4,JL)-ISVECMASK(3,JL)+1 - IDTK=ISVECMASK(6,JL)-ISVECMASK(5,JL)+1 - IF (CSOLVER(1:2)=="RO" .AND. NEQAQ>0) THEN ! aqueous chemistry case rosenbrock solver - CALL PREPARE_LU_AQUEOUS_ROSENBROCK !size of the jacobian matrix depending on - !the presence of cloud and/or rain - END IF -! - IF (LORILAM) THEN - ZRV(:) = 0. - ZRC(:) = 0. - ZJNUC(:) = 0. - ZJ2RAT(:) = 0. - ZCONC_MASS = 0. - ZCOND_MASS_I = 0. - ZCOND_MASS_J = 0. - ZNUCL_MASS = 0. -!ocl novrec -!cdir nodep - DO JM=0,ISVECNPT-1 - JI=JM-IDTI*(JM/IDTI)+ISVECMASK(1,JL) - JJ=JM/IDTI-IDTJ*(JM/(IDTI*IDTJ))+ISVECMASK(3,JL) - JK=JM/(IDTI*IDTJ)-IDTK*(JM/(IDTI*IDTJ*IDTK))+ISVECMASK(5,JL) - ZSEDA(JM+1,:) = XSEDA(JI,JJ,JK,:) - !Pressure (Pa) - ZPRESSURE(JM+1) = XPABST(JI,JJ,JK) - !Air density (kg/m3) - ZDENAIR(JM+1) = XRHODREF(JI, JJ, JK) - !Temperature (K) - ZTEMP(JM+1) = XTHT(JI,JJ,JK)*((XPABST(JI,JJ,JK)/XP00)**(XRD/XCPD)) - !Water vapor (kg/kg) - IF (SIZE(XRT,4) .GE. 1) ZRV(JM+1) = XRT(JI, JJ, JK, 1) - !Cloud vapor (kg/kg) - IF (SIZE(XRT,4) .GE. 2) ZRC(JM+1) = XRT(JI, JJ, JK, 2) - !Molar mass (kg/kg) - ZMI(JM+1,:) = XMI(JI, JJ, JK, :) - !Moments (ppp) - ZM(JM+1,:) = XM3D(JI,JJ,JK,:) - ZLNSIG(JM+1,:) = LOG(XSIG3D(JI,JJ,JK,:)) - ZRG(JM+1,:) = XRG3D(JI,JJ,JK,:) - ZN(JM+1,:) = XN3D(JI,JJ,JK,:) - IF (NSOA > 0) ZSOLORG(JM+1,:) = XSOLORG(JI,JJ,JK,:) - ENDDO - DO JN = 1, NSV_AER -!Vectorization: -!ocl novrec -!cdir nodep - DO JM=0,ISVECNPT-1 - JI=JM-IDTI*(JM/IDTI)+ISVECMASK(1,JL) - JJ=JM/IDTI-IDTJ*(JM/(IDTI*IDTJ))+ISVECMASK(3,JL) - JK=JM/(IDTI*IDTJ)-IDTK*(JM/(IDTI*IDTJ*IDTK))+ISVECMASK(5,JL) -! - ZCONV(JM+1) = (XRHODREF(JI,JJ,JK)/XRHODJ(JI,JJ,JK))*ZDEN2MOL - IF (GSPLIT) THEN - ZAERO(JM+1,JN) = XRSVS(JI,JJ,JK,NSV_AERBEG+JN-1)*PTSTEP*ZCONV(JM+1) - ELSE - ZAERO(JM+1,JN) = XSVT(JI,JJ,JK,NSV_AERBEG+JN-1)*ZDEN2MOL*XRHODREF(JI,JJ,JK) - END IF - END DO - END DO -! -!* initialize aerosol surface and aerosol diameter -! - CALL CH_AER_SURF(ZM, ZRG, ZLNSIG, XSURF) ! Compute aerosol surface (m2/cc) - XDP(:,:) = 2.E-6 * ZRG(:,:) ! Mean diameter in meter - END IF -! -! - IF (GSPLIT) THEN - DO JM = 0, ISVECNPT-1 -!Vectorization: -!ocl novrec -!cdir nodep - JI=JM-IDTI*(JM/IDTI)+ISVECMASK(1,JL) - JJ=JM/IDTI-IDTJ*(JM/(IDTI*IDTJ))+ISVECMASK(3,JL) - JK=JM/(IDTI*IDTJ)-IDTK*(JM/(IDTI*IDTJ*IDTK))+ISVECMASK(5,JL) -! - ZCONV(JM+1) = (XRHODREF(JI,JJ,JK)/XRHODJ(JI,JJ,JK))*ZDEN2MOL - DO JN = 1, LU_DIM_SPECIES(JM+1) - ZCHEM(JM+1,JN) = XRSVS(JI,JJ,JK,NSV_CHEMBEG+JN-1) * PTSTEP & - * ZCONV(JM+1) - END DO - DO JN = 1, NEQAQ/2 ! set aqueous concentrations to zero where LW<XRTMIN_AQ - IF (((((XRRS(JI,JJ,JK,2)/XRHODJ(JI,JJ,JK))*PTSTEP)*XRHODREF(JI,JJ,JK))/1.e3) & - < XRTMIN_AQ) THEN ! cloud - ZCHEM(JM+1,NEQ-NEQAQ+JN) = 0. - ENDIF - IF (((((XRRS(JI,JJ,JK,3)/XRHODJ(JI,JJ,JK))*PTSTEP)*XRHODREF(JI,JJ,JK))/1.e3) & - < XRTMIN_AQ) THEN ! rain - ZCHEM(JM+1,NEQ-NEQAQ/2+JN) = 0. - ENDIF - END DO - END DO - ELSE - DO JM = 0, ISVECNPT-1 -!Vectorization: -!ocl novrec -!cdir nodep - JI=JM-IDTI*(JM/IDTI)+ISVECMASK(1,JL) - JJ=JM/IDTI-IDTJ*(JM/(IDTI*IDTJ))+ISVECMASK(3,JL) - JK=JM/(IDTI*IDTJ)-IDTK*(JM/(IDTI*IDTJ*IDTK))+ISVECMASK(5,JL) -! - ZCONV(JM+1) = (XRHODREF(JI,JJ,JK)/XRHODJ(JI,JJ,JK))*ZDEN2MOL - DO JN = 1, LU_DIM_SPECIES(JM+1) - ZCHEM(JM+1,JN) = XSVT(JI,JJ,JK,NSV_CHEMBEG+JN-1) * ZDEN2MOL & - * XRHODREF(JI,JJ,JK) - END DO - DO JN = 1, NEQAQ/2 ! set aqueous concentrations to zero where LW<XRTMIN_AQ - IF (((XRT(JI,JJ,JK,2)*XRHODREF(JI,JJ,JK))/1.e3) < XRTMIN_AQ) THEN ! cloud - ZCHEM(JM+1,NEQ-NEQAQ+JN) = 0. - ENDIF - IF (((XRT(JI,JJ,JK,3)*XRHODREF(JI,JJ,JK))/1.e3) < XRTMIN_AQ) THEN ! rain - ZCHEM(JM+1,NEQ-NEQAQ/2+JN) = 0. - ENDIF - END DO - END DO - END IF -! -!* 4.2 transfer meteo data into chemical core system -! - SELECT CASE ( CCLOUD ) - CASE ('NONE','KESS','ICE3','ICE4') - IF (GSPLIT) THEN ! LWC and LWR computed from tendencies - CALL CH_METEO_TRANS_KESS(JL, XRHODJ, XRHODREF, XRRS, XTHT, XPABST, & - ISVECNPT, ISVECMASK, TZM, TDTCUR%nday, & - TDTCUR%nmonth, TDTCUR%nyear, & - XLAT, XLON, XLAT0, XLON0, LUSERV, LUSERC, & - LUSERR, KLUOUT, CCLOUD, PTSTEP ) - ELSE - CALL CH_METEO_TRANS_KESS(JL, XRHODJ, XRHODREF, XRT, XTHT, XPABST, & - ISVECNPT, ISVECMASK, TZM, TDTCUR%nday, & - TDTCUR%nmonth, TDTCUR%nyear, & - XLAT, XLON, XLAT0, XLON0, LUSERV, LUSERC, & - LUSERR, KLUOUT, CCLOUD ) - ENDIF - - CASE ('C2R2','KHKO','C3R5') !add cloud and rain C. for mean radius - IF (GSPLIT) THEN ! LWC and LWR computed from tendencies - CALL CH_METEO_TRANS_C2R2(JL, XRHODJ, XRHODREF, XRRS, XRSVS(:,:,:,NSV_C2R2BEG+1), & - XRSVS(:,:,:,NSV_C2R2BEG+2), XTHT, XPABST, ISVECNPT, & - ISVECMASK, TZM, TDTCUR%nday, TDTCUR%nmonth, & - TDTCUR%nyear, XLAT,XLON, XLAT0, XLON0, LUSERV, & - LUSERC, LUSERR, KLUOUT, CCLOUD, PTSTEP ) - ELSE - CALL CH_METEO_TRANS_C2R2(JL, XRHODJ, XRHODREF, XRT, XSVT(:,:,:,NSV_C2R2BEG+1), & - XSVT(:,:,:,NSV_C2R2BEG+2), XTHT, XPABST, ISVECNPT, & - ISVECMASK, TZM, TDTCUR%nday, TDTCUR%nmonth, & - TDTCUR%nyear, XLAT,XLON, XLAT0, XLON0, LUSERV, & - LUSERC, LUSERR, KLUOUT, CCLOUD ) - ENDIF - CASE ('LIMA') !add cloud and rain C. for mean radius - IF (GSPLIT) THEN ! LWC and LWR computed from tendencies - CALL CH_METEO_TRANS_LIMA(JL, XRHODJ, XRHODREF, XRRS, XRSVS(:,:,:,NSV_LIMA_NC), & - XRSVS(:,:,:,NSV_LIMA_NR), XTHT, XPABST, ISVECNPT, & - ISVECMASK, TZM, TDTCUR%nday, TDTCUR%nmonth, & - TDTCUR%nyear, XLAT,XLON, XLAT0, XLON0, LUSERV, & - LUSERC, LUSERR, KLUOUT, CCLOUD, PTSTEP ) - ELSE - CALL CH_METEO_TRANS_LIMA(JL, XRHODJ, XRHODREF, XRT, XSVT(:,:,:,NSV_LIMA_NC), & - XSVT(:,:,:,NSV_LIMA_NR), XTHT, XPABST, ISVECNPT, & - ISVECMASK, TZM, TDTCUR%nday, TDTCUR%nmonth, & - TDTCUR%nyear, XLAT,XLON, XLAT0, XLON0, LUSERV, & - LUSERC, LUSERR, KLUOUT, CCLOUD ) - ENDIF - END SELECT -! -!* 4.3 calculate reaction and photolysis rates and current pH value -! - IF (LUSECHAQ.AND.LCH_PH) THEN - SELECT CASE(NRRL) - CASE(1) - DO JM=0,ISVECNPT-1 - JI=JM-IDTI*(JM/IDTI)+ISVECMASK(1,JL) - JJ=JM/IDTI-IDTJ*(JM/(IDTI*IDTJ))+ISVECMASK(3,JL) - JK=JM/(IDTI*IDTJ)-IDTK*(JM/(IDTI*IDTJ*IDTK))+ISVECMASK(5,JL) - ZPH(JM+1,1) = XPHC(JI,JJ,JK) - END DO - CASE(2) - DO JM=0,ISVECNPT-1 - JI=JM-IDTI*(JM/IDTI)+ISVECMASK(1,JL) - JJ=JM/IDTI-IDTJ*(JM/(IDTI*IDTJ))+ISVECMASK(3,JL) - JK=JM/(IDTI*IDTJ)-IDTK*(JM/(IDTI*IDTJ*IDTK))+ISVECMASK(5,JL) - ZPH(JM+1,1) = XPHC(JI,JJ,JK) - ZPH(JM+1,2) = XPHR(JI,JJ,JK) - END DO - END SELECT - CALL CH_SET_RATES & - (TDTCUR%xtime, ZCHEM, TZM, IMI, KLUOUT, KVERB, ISVECNPT, NEQ, NRRL, ZPH) - ELSE - CALL CH_SET_RATES & - (TDTCUR%xtime, ZCHEM, TZM, IMI, KLUOUT, KVERB, ISVECNPT, NEQ, NRRL) - ENDIF -! - CALL CH_SET_PHOTO_RATES( TDTCUR%xtime, ZCHEM, JL, TZM, IMI, KLUOUT, KVERB, & - ISVECNPT, ISVECMASK, NEQ, XJVALUES) -! -!* 4.4 initialize aerosol parameters and moments of 0th, -! 6th, aerosol surface and aerosol diameter order -! - IF (LORILAM) THEN - IF (KTCOUNT == 1) THEN - CALL CH_INI_ORILAM(ZM, ZLNSIG, ZRG, ZN, ZCTOTG, ZCTOTA, ZCCTOT, & - ZSEDA, ZRHOP, ZAERO, ZCHEM, ZRV, ZDENAIR, & - ZPRESSURE, ZTEMP, ZRC, ZFRAC, ZMI,CCH_SCHEME) - END IF -! transfer non-volatile species from aerosol to gas-phase variables -! this line seems to be useless and transfer all H2SO4 from AP to cloud -! droplets is LUSECHAQ and LORILAM set to true -! ZCHEM(:,JP_CH_H2SO4) = ZAERO(:,JP_CH_SO4i) + ZAERO(:,JP_CH_SO4j) - END IF -! -!* 4.5 solve chemical system for the timestep of the monitor -! - ZOLDCHEM(:,:) = ZCHEM(:,:) - DO JM = 1, NCH_SUBSTEPS - CALL CH_SOLVER_n & - (TDTCUR%xtime, ZDTSOLVER, ZCHEM, ZNEWCHEM, NEQ, ISVECNPT, IMI) - ZCHEM(:,:) = MAX(0.0,ZNEWCHEM(:,:)) - END DO - IF (CSOLVER(1:2)=="RO" .AND. NEQAQ>0) THEN ! aqueous chemistry case rosenbrock solver - DEALLOCATE(LU_IROW) - DEALLOCATE(LU_ICOL) - DEALLOCATE(LU_CROW) - DEALLOCATE(LU_DIAG) - END IF -! -!* 4.6 solve aerosol system -! - IF (LORILAM) THEN - !ZSO4RAT(:) = (ZNEWCHEM(:,JP_CH_H2SO4)-ZOLDCHEM(:,JP_CH_H2SO4)) / PTSTEP - ZSO4RAT(:) = (ZNEWCHEM(:,JP_CH_H2SO4)) / PTSTEP - ZOLDAERO(:,:) = ZAERO(:,:) - CALL CH_ORILAM(ZAERO,ZNEWCHEM, ZM, ZLNSIG, ZRG, ZN, ZCTOTG, & - ZCTOTA, ZCCTOT, PTSTEP, ZSEDA, & - ZRHOP, ZSO4RAT, & - ZRV, ZDENAIR,ZPRESSURE, ZTEMP, ZRC, ZFRAC, ZMI, & - ZTIME,CCH_SCHEME,ZSOLORG, ZJNUC, ZJ2RAT, ZMBEG,ZMINT,ZMEND,& - ZDMINTRA,ZDMINTER,ZDMCOND,ZDMNUCL,ZDMMERG,& - ZCONC_MASS,ZCOND_MASS_I,ZCOND_MASS_J,ZNUCL_MASS) - ZNEWAERO(:,:) = ZAERO(:,:) -! -!* 4.7 return results to MesoNH scalar variables - aerosols -! -!Vectorization: -!ocl novrec -!cdir nodep - DO JM=0,ISVECNPT-1 - JI=JM-IDTI*(JM/IDTI)+ISVECMASK(1,JL) - JJ=JM/IDTI-IDTJ*(JM/(IDTI*IDTJ))+ISVECMASK(3,JL) - JK=JM/(IDTI*IDTJ)-IDTK*(JM/(IDTI*IDTJ*IDTK))+ISVECMASK(5,JL) -! - XSIG3D(JI,JJ,JK,:) = EXP(ZLNSIG(JM+1,:)) - XRG3D(JI,JJ,JK,:) = ZRG(JM+1,:) - XN3D(JI,JJ,JK,:) = ZN(JM+1,:) - XRHOP3D(JI,JJ,JK,:) = ZRHOP(JM+1,:) - XCTOTA3D(JI,JJ,JK,:,:) = ZCTOTA(JM+1,:,:) - XM3D(JI,JJ,JK,:) = ZM(JM+1,:) - XFRAC(JI,JJ,JK,:) = ZFRAC(JM+1,:) - XMI(JI,JJ,JK,:) = ZMI(JM+1,:) - ! - XJNUC(JI,JJ,JK) = ZJNUC(JM+1) - XJ2RAT(JI,JJ,JK) = ZJ2RAT(JM+1) - XCONC_MASS(JI,JJ,JK) = ZCONC_MASS(JM+1) - XCOND_MASS_I(JI,JJ,JK) = ZCOND_MASS_I(JM+1) - XCOND_MASS_J(JI,JJ,JK) = ZCOND_MASS_J(JM+1) - XNUCL_MASS(JI,JJ,JK) = ZNUCL_MASS(JM+1) - XMBEG(JI,JJ,JK,:) = ZMBEG(JM+1,:) - XMINT(JI,JJ,JK,:) = ZMINT(JM+1,:) - XMEND(JI,JJ,JK,:) = ZMEND(JM+1,:) - XDMINTRA(JI,JJ,JK,:) = ZDMINTRA(JM+1,:) - XDMINTER(JI,JJ,JK,:) = ZDMINTER(JM+1,:) - XDMCOND(JI,JJ,JK,:) = ZDMCOND(JM+1,:) - XDMNUCL(JI,JJ,JK,:) = ZDMNUCL(JM+1,:) - XDMMERG(JI,JJ,JK,:) = ZDMMERG(JM+1,:) - END DO - DO JN = 1, NSV_AER -!Vectorization: -!ocl novrec -!cdir nodep - DO JM=0,ISVECNPT-1 - JI=JM-IDTI*(JM/IDTI)+ISVECMASK(1,JL) - JJ=JM/IDTI-IDTJ*(JM/(IDTI*IDTJ))+ISVECMASK(3,JL) - JK=JM/(IDTI*IDTJ)-IDTK*(JM/(IDTI*IDTJ*IDTK))+ISVECMASK(5,JL) -! - IF (GSPLIT) THEN - XRSVS(JI,JJ,JK,NSV_AERBEG+JN-1)=ZNEWAERO(JM+1,JN)/(PTSTEP*ZCONV(JM+1)) - ELSE - XRSVS(JI,JJ,JK,NSV_AERBEG+JN-1) = XRSVS(JI,JJ,JK,NSV_AERBEG+JN-1) & - + (ZNEWAERO(JM+1,JN) - ZOLDAERO(JM+1,JN)) & - / (PTSTEP * ZCONV(JM+1)) - END IF - END DO - END DO - END IF -! -! -!* 4.8.1 read production/loss terms for chemical species and filter -! selected species -! - IF (NEQ_PLT>0) THEN - CALL CH_PRODLOSS(TDTCUR%xtime,ZCHEM,ZPRODTOT,ZLOSSTOT,IMI,ISVECNPT,NEQ) - DO JM=1, NEQ_PLT - DO JN=1,ISVECNPT - ZPROD(JN,JM)=ZPRODTOT(JN,NIND_SPEC(JM)) - ZLOSS(JN,JM)=ZLOSSTOT(JN,NIND_SPEC(JM))*ZCHEM(JN,NIND_SPEC(JM)) - END DO - END DO - END IF -! -! -!* 4.8.2 read extended production/loss terms for chemical species and -! filter selected species -! - IF (NEQ_BUDGET>0) THEN - CALL CH_TERMS(TDTCUR%xtime,ZCHEM,ZTCHEMTOT,IMI,ISVECNPT,NEQ,NREAC) - DO JM=1,NEQ_BUDGET - DO JN=1,ISVECNPT - JS=1 - DO JO=1,NNONZEROTERMS - IF(NSPEC_BUDGET(JM).EQ.IINDEX(1,JO)) THEN - ZTCHEM(JM)%ZB_REAC(JN,JS)=ZTCHEMTOT(JN,IINDEX(1,JO),IINDEX(2,JO)) - ZTCHEM(JM)%IB_REAC(JS)=IINDEX(2,JO) - JS=JS+1 - END IF - END DO - END DO - END DO - END IF -! -!* 4.9 return result to MesoNH scalar variables - chemical species -! - IF (GSPLIT) THEN - DO JM = 0, ISVECNPT-1 -!Vectorization: -!ocl novrec -!cdir nodep - JI=JM-IDTI*(JM/IDTI)+ISVECMASK(1,JL) - JJ=JM/IDTI-IDTJ*(JM/(IDTI*IDTJ))+ISVECMASK(3,JL) - JK=JM/(IDTI*IDTJ)-IDTK*(JM/(IDTI*IDTJ*IDTK))+ISVECMASK(5,JL) -! - DO JN = 1, LU_DIM_SPECIES(JM+1) - XRSVS(JI,JJ,JK,NSV_CHEMBEG+JN-1) = ZNEWCHEM(JM+1,JN) & - / (PTSTEP * ZCONV(JM+1)) - END DO - END DO - ELSE - DO JM = 0, ISVECNPT-1 -!Vectorization: -!ocl novrec -!cdir nodep - JI=JM-IDTI*(JM/IDTI)+ISVECMASK(1,JL) - JJ=JM/IDTI-IDTJ*(JM/(IDTI*IDTJ))+ISVECMASK(3,JL) - JK=JM/(IDTI*IDTJ)-IDTK*(JM/(IDTI*IDTJ*IDTK))+ISVECMASK(5,JL) -! - DO JN = 1, LU_DIM_SPECIES(JM+1) - XRSVS(JI,JJ,JK,NSV_CHEMBEG+JN-1) = XRSVS(JI,JJ,JK,NSV_CHEMBEG+JN-1) & - + (ZNEWCHEM(JM+1,JN) - ZOLDCHEM(JM+1,JN)) & - / (PTSTEP * ZCONV(JM+1)) - END DO - END DO - END IF - IF (CSOLVER(1:2)=="RO" .AND. NEQAQ>0) THEN ! aqueous chemistry case rosenbrock solver - DEALLOCATE(LU_DIM_SPECIES) - END IF -! -!* 4.10 return result to MesoNH scalar variables - pH values -! - IF (LUSECHAQ.AND.LCH_PH) THEN - SELECT CASE(NRRL) - CASE(1) - DO JM=0,ISVECNPT-1 - JI=JM-IDTI*(JM/IDTI)+ISVECMASK(1,JL) - JJ=JM/IDTI-IDTJ*(JM/(IDTI*IDTJ))+ISVECMASK(3,JL) - JK=JM/(IDTI*IDTJ)-IDTK*(JM/(IDTI*IDTJ*IDTK))+ISVECMASK(5,JL) - XPHC(JI,JJ,JK) = ZPH(JM+1,1) - END DO - CASE(2) - DO JM=0,ISVECNPT-1 - JI=JM-IDTI*(JM/IDTI)+ISVECMASK(1,JL) - JJ=JM/IDTI-IDTJ*(JM/(IDTI*IDTJ))+ISVECMASK(3,JL) - JK=JM/(IDTI*IDTJ)-IDTK*(JM/(IDTI*IDTJ*IDTK))+ISVECMASK(5,JL) - XPHC(JI,JJ,JK) = ZPH(JM+1,1) - XPHR(JI,JJ,JK) = ZPH(JM+1,2) - END DO - END SELECT - ENDIF -! -! -!* 4.11 return result to MesoNH scalar variables - prod/loss terms -! - IF (NEQ_PLT>0) THEN - DO JM=0,ISVECNPT-1 - JI=JM-IDTI*(JM/IDTI)+ISVECMASK(1,JL) - JJ=JM/IDTI-IDTJ*(JM/(IDTI*IDTJ))+ISVECMASK(3,JL) - JK=JM/(IDTI*IDTJ)-IDTK*(JM/(IDTI*IDTJ*IDTK))+ISVECMASK(5,JL) - DO JN=1,NEQ_PLT - XPROD(JI,JJ,JK,JN) = ZPROD(JM+1,JN)/(ZDEN2MOL*XRHODREF(JI,JJ,JK)) - XLOSS(JI,JJ,JK,JN) = ZLOSS(JM+1,JN)/(ZDEN2MOL*XRHODREF(JI,JJ,JK)) - END DO - END DO - END IF -! -! -!* 4.12 return result to MesoNH scalar variables - extended prod/loss terms -! - IF (NEQ_BUDGET>0) THEN - DO JM=0,ISVECNPT-1 - JI=JM-IDTI*(JM/IDTI)+ISVECMASK(1,JL) - JJ=JM/IDTI-IDTJ*(JM/(IDTI*IDTJ))+ISVECMASK(3,JL) - JK=JM/(IDTI*IDTJ)-IDTK*(JM/(IDTI*IDTJ*IDTK))+ISVECMASK(5,JL) - DO JN=1,NEQ_BUDGET - DO JS=1,IIND(JN) - XTCHEM(JN)%XB_REAC(JI,JJ,JK,JS)=(ZTCHEM(JN)%ZB_REAC(JM+1,JS))/(ZDEN2MOL*XRHODREF(JI,JJ,JK)) - XTCHEM(JN)%NB_REAC(JS)=ZTCHEM(JN)%IB_REAC(JS) - END DO - END DO - END DO - END IF -! -! -END DO -! -!* 4.13 compute accumalated concentrations in rain at the surface -! -IF (CCLOUD /= 'REVE' ) THEN - IF (LUSECHAQ) THEN - DO JSV=1,NSV_CHAC/2 - WHERE((XRRS(:,:,IKB,3) .GT. 0.).AND.(XRSVS(:,:,IKB,JSV+NSV_CHACBEG+NSV_CHAC/2-1).GT.0.)) - XACPRAQ(:,:,JSV) = XACPRAQ(:,:,JSV) + & - (XRSVS(:,:,IKB,JSV+NSV_CHACBEG+NSV_CHAC/2-1))/ (XMD*XRRS(:,:,IKB,3))*& ! moles i / kg eau - 1E3*ZINPRR(:,:) * XTSTEP ! moles i / m2 - END WHERE - ENDDO - IF (LCH_PH) THEN - WHERE ((ZINPRR(:,:)>0.).AND.(XPHR(:,:,IKB)>0.)) - ! moles of H+ / m2 - XACPHR(:,:) = XACPHR(:,:) + 1E3*ZINPRR(:,:) * XTSTEP * & - 10**(-XPHR(:,:,IKB)) - END WHERE - END IF - END IF -END IF - -! Correction of negativity -! -DO JSV = 1, SIZE(XSVT,4) - XRSVS(:,:,:,JSV) = MAX((XRSVS(:,:,:,JSV)),XSVMIN(JSV)) -END DO -! -if ( lbudget_sv ) then - do jsv = nsv_chembeg, nsv_chemend - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jsv), 'CHEM', xrsvs(:, :, :, jsv) ) - enddo - do jsv = nsv_aerbeg, nsv_aerend - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jsv), 'AER', xrsvs(:, :, :, jsv) ) - enddo -endif - -! -!---------------------------------------------------------------------- -! -IF ((CPROGRAM =='DIAG ').OR.(L1D)) THEN - CALL WRITE_TS1D -END IF -! -DEALLOCATE(TZM) -DEALLOCATE(ZCHEM) -DEALLOCATE(ZNEWCHEM) -DEALLOCATE(ZOLDCHEM) -DEALLOCATE(ZCONV) -IF (LUSECHAQ.AND.LCH_PH) DEALLOCATE(ZPH) -! -IF (NEQ_PLT>0) THEN - DEALLOCATE(ZPRODTOT) - DEALLOCATE(ZLOSSTOT) - DEALLOCATE(ZPROD) - DEALLOCATE(ZLOSS) -END IF -IF (NEQ_BUDGET>0) THEN - DEALLOCATE(ZTCHEMTOT) - DEALLOCATE(ZTCHEM) - DEALLOCATE(IIND) - DEALLOCATE(IINDEX) -END IF -IF (LORILAM) THEN - DEALLOCATE(ZAERO) - DEALLOCATE(ZNEWAERO) - DEALLOCATE(ZOLDAERO) - DEALLOCATE(ZM) - DEALLOCATE(ZSEDA) - DEALLOCATE(ZN) - DEALLOCATE(ZRG) - DEALLOCATE(ZLNSIG) - DEALLOCATE(ZRHOP) - DEALLOCATE(ZCTOTA) - DEALLOCATE(ZCCTOT) - DEALLOCATE(ZCTOTG) - DEALLOCATE(ZSO4RAT) - DEALLOCATE(ZRV) - DEALLOCATE(ZRC) - DEALLOCATE(ZPRESSURE) - DEALLOCATE(ZTEMP) - DEALLOCATE(ZDENAIR) - DEALLOCATE(ZFRAC) - DEALLOCATE(ZMI) - DEALLOCATE(ZSOLORG) - DEALLOCATE(XDP) - DEALLOCATE(XSURF) - DEALLOCATE(ZMBEG) - DEALLOCATE(ZMINT) - DEALLOCATE(ZMEND) - DEALLOCATE(ZDMINTRA) - DEALLOCATE(ZDMINTER) - DEALLOCATE(ZDMCOND) - DEALLOCATE(ZDMNUCL) - DEALLOCATE(ZDMMERG) -END IF -!------------------------------------------------------------------------------- -! -CONTAINS -! - SUBROUTINE PREPARE_LU_ROSENBROCK -! -USE MODI_CH_INIT_ROSENBROCK -! -! local variables -! -INTEGER :: JISHIFT ! shift index in a loop -INTEGER :: JILOCAL ! shift index in a loop -INTEGER :: ILAST ! last elemnt of NSPARSE_DIAG vector -! -!------------------------------------------------------------------------------- -! - CALL CH_INIT_ROSENBROCK(IMI,KLUOUT) -! -! add vectorization of the LU_arrays created by CH_INIT_ROSENBROCK -! - LU_NONZERO = NSPARSEDIM*ISVECNPT - ALLOCATE(LU_IROW(LU_NONZERO)) - ALLOCATE(LU_ICOL(LU_NONZERO)) - DO JI = 1, ISVECNPT - JISHIFT = NSPARSEDIM*(JI-1) - JILOCAL = NEQ*(JI-1) - LU_IROW(JISHIFT+1:JISHIFT+NSPARSEDIM) = NSPARSE_IROW(1:NSPARSEDIM)+JILOCAL - LU_ICOL(JISHIFT+1:JISHIFT+NSPARSEDIM) = NSPARSE_ICOL(1:NSPARSEDIM)+JILOCAL - END DO -! - NVAR = NEQ*ISVECNPT - ALLOCATE(LU_CROW(NVAR+1)) - ALLOCATE(LU_DIAG(NVAR+1)) - ILAST = NSPARSE_DIAG(NEQ) - DO JI = 1, ISVECNPT - JISHIFT = NEQ*(JI-1) - JILOCAL = ILAST*(JI-1) - LU_CROW(JISHIFT+1:JISHIFT+NEQ) = NSPARSE_CROW(1:NEQ)+JILOCAL - LU_DIAG(JISHIFT+1:JISHIFT+NEQ) = NSPARSE_DIAG(1:NEQ)+JILOCAL - END DO - LU_CROW(NVAR+1) = LU_NONZERO+1 - LU_DIAG(NVAR+1) = LU_NONZERO+1 - RETURN -! -!------------------------------------------------------------------------------- -! -END SUBROUTINE PREPARE_LU_ROSENBROCK -! -! - SUBROUTINE PREPARE_LU_AQUEOUS_ROSENBROCK -! -USE MODI_CH_INIT_ROSENBROCK -USE MODD_CH_MNHC_n, ONLY : XRTMIN_AQ -! -! local variables -! -INTEGER :: JISHIFT ! shift index in a loop -INTEGER :: JILOCAL ! shift index in a loop -INTEGER :: ILAST ! last elemnt of NSPARSE_DIAG vector -REAL, DIMENSION(SIZE(XRRS,1),SIZE(XRRS,2),SIZE(XRRS,3),SIZE(XRRS,4)) & - :: ZRRS ! work array -LOGICAL, DIMENSION(:), ALLOCATABLE :: GWATER -INTEGER, DIMENSION(:), ALLOCATABLE :: IMASKAQ -INTEGER :: IWATER -INTEGER :: ISPARSEDIM -INTEGER :: IEQ -INTEGER :: ILAST_NAQ -INTEGER :: JRR ! Loop index for the moist variables -REAL :: ZRTMIN_AQ -! -!------------------------------------------------------------------------------- -! -DO JRR = 2, NRRL+1 - ZRRS(:,:,:,JRR) = XRRS(:,:,:,JRR) / XRHODJ(:,:,:) -END DO -! -!------------------------------------------------------------------------------- -! -! Same as in PREPARE_LU_ROSENBROCK but in the case of non-homogeneous -! chemical systems with are put together, here a mixture of NEQ and NEQ_NAQ -! system dimensions. -! - IF (KTCOUNT == 1) THEN - IF (JL==1) CALL CH_INIT_ROSENBROCK(IMI,KLUOUT) - IF( ASSOCIATED(LU_DIM_SPECIES) ) THEN - DEALLOCATE(LU_DIM_SPECIES) - END IF - END IF -! -! Create the GWATER mask -! - ALLOCATE(GWATER(ISVECNPT)) - GWATER(:) = .FALSE. - IF (GSPLIT) THEN - ZRTMIN_AQ = XRTMIN_AQ/PTSTEP - SELECT CASE ( CCLOUD ) - CASE('REVE') - DO JM=0,ISVECNPT-1 - JI=JM-IDTI*(JM/IDTI)+ISVECMASK(1,JL) - JJ=JM/IDTI-IDTJ*(JM/(IDTI*IDTJ))+ISVECMASK(3,JL) - JK=JM/(IDTI*IDTJ)-IDTK*(JM/(IDTI*IDTJ*IDTK))+ISVECMASK(5,JL) - GWATER(JM+1) = XRRS(JI,JJ,JK,2)>(ZRTMIN_AQ*1.e3/XRHODREF(JI,JJ,JK)) - END DO - CASE('KESS','ICE3','ICE4','C2R2','C3R5','KHKO') - DO JM=0,ISVECNPT-1 - JI=JM-IDTI*(JM/IDTI)+ISVECMASK(1,JL) - JJ=JM/IDTI-IDTJ*(JM/(IDTI*IDTJ))+ISVECMASK(3,JL) - JK=JM/(IDTI*IDTJ)-IDTK*(JM/(IDTI*IDTJ*IDTK))+ISVECMASK(5,JL) - GWATER(JM+1) = XRRS(JI,JJ,JK,2)>(ZRTMIN_AQ*1.e3/XRHODREF(JI,JJ,JK)) & - .OR. XRRS(JI,JJ,JK,3)>(ZRTMIN_AQ*1.e3/XRHODREF(JI,JJ,JK)) - END DO - END SELECT - ELSE - SELECT CASE ( CCLOUD ) - CASE('REVE') - DO JM=0,ISVECNPT-1 - JI=JM-IDTI*(JM/IDTI)+ISVECMASK(1,JL) - JJ=JM/IDTI-IDTJ*(JM/(IDTI*IDTJ))+ISVECMASK(3,JL) - JK=JM/(IDTI*IDTJ)-IDTK*(JM/(IDTI*IDTJ*IDTK))+ISVECMASK(5,JL) - GWATER(JM+1) = XRT(JI,JJ,JK,2)>(XRTMIN_AQ*1.e3/XRHODREF(JI,JJ,JK)) - END DO - CASE('KESS','ICE3','ICE4','C2R2','C3R5','KHKO') - DO JM=0,ISVECNPT-1 - JI=JM-IDTI*(JM/IDTI)+ISVECMASK(1,JL) - JJ=JM/IDTI-IDTJ*(JM/(IDTI*IDTJ))+ISVECMASK(3,JL) - JK=JM/(IDTI*IDTJ)-IDTK*(JM/(IDTI*IDTJ*IDTK))+ISVECMASK(5,JL) - GWATER(JM+1) = XRT(JI,JJ,JK,2)>(XRTMIN_AQ*1.e3/XRHODREF(JI,JJ,JK)) & - .OR. XRT(JI,JJ,JK,3)>(XRTMIN_AQ*1.e3/XRHODREF(JI,JJ,JK)) - END DO - END SELECT - END IF - IWATER = COUNT(GWATER(:)) - ALLOCATE(IMASKAQ(ISVECNPT)); IMASKAQ(:) = 0 - IF( IWATER>=1 ) THEN - WHERE( GWATER(:) ) - IMASKAQ(:) = 1 - END WHERE - END IF - DEALLOCATE(GWATER) -! -! add vectorization of the LU_arrays created by CH_INIT_ROSENBROCK -! but now taking into account a full system to solve with NEQ species -! (gazeous+aqueous species) and a reduced system with NEQ_NAQ<NEQ -! species (pure gazeous case) -! - ALLOCATE(LU_DIM_SPECIES(ISVECNPT)) - LU_DIM_SPECIES(:) = NEQ*IMASKAQ(:) + NEQ_NAQ*(1-IMASKAQ(:)) -! - LU_NONZERO = NSPARSEDIM*IWATER + NSPARSEDIM_NAQ*(ISVECNPT-IWATER) - ALLOCATE(LU_IROW(LU_NONZERO)) - ALLOCATE(LU_ICOL(LU_NONZERO)) - JISHIFT = 0 - JILOCAL = 0 - DO JI = 1, ISVECNPT - ISPARSEDIM = NSPARSEDIM*IMASKAQ(JI) + NSPARSEDIM_NAQ*(1-IMASKAQ(JI)) - IF( ISPARSEDIM==NSPARSEDIM ) THEN - LU_IROW(JISHIFT+1:JISHIFT+ISPARSEDIM)=NSPARSE_IROW(1:ISPARSEDIM)+JILOCAL - LU_ICOL(JISHIFT+1:JISHIFT+ISPARSEDIM)=NSPARSE_ICOL(1:ISPARSEDIM)+JILOCAL - ELSE - LU_IROW(JISHIFT+1:JISHIFT+ISPARSEDIM)=NSPARSE_IROW_NAQ(1:ISPARSEDIM)+ & - JILOCAL - LU_ICOL(JISHIFT+1:JISHIFT+ISPARSEDIM)=NSPARSE_ICOL_NAQ(1:ISPARSEDIM)+ & - JILOCAL - END IF - JISHIFT = JISHIFT + ISPARSEDIM - JILOCAL = JILOCAL + NEQ*IMASKAQ(JI) + NEQ_NAQ*(1-IMASKAQ(JI)) - END DO -! - NVAR = NEQ*IWATER + NEQ_NAQ*(ISVECNPT-IWATER) - ALLOCATE(LU_CROW(NVAR+1)) - ALLOCATE(LU_DIAG(NVAR+1)) - JISHIFT = 0 - JILOCAL = 0 - ILAST = NSPARSE_DIAG(NEQ) - ILAST_NAQ = NSPARSE_DIAG_NAQ(NEQ_NAQ) - DO JI = 1, ISVECNPT - IEQ = LU_DIM_SPECIES(JI) - IF( IEQ==NEQ ) THEN - LU_CROW(JISHIFT+1:JISHIFT+IEQ) = NSPARSE_CROW(1:IEQ)+JILOCAL - LU_DIAG(JISHIFT+1:JISHIFT+IEQ) = NSPARSE_DIAG(1:IEQ)+JILOCAL - ELSE - LU_CROW(JISHIFT+1:JISHIFT+IEQ) = NSPARSE_CROW_NAQ(1:IEQ)+JILOCAL - LU_DIAG(JISHIFT+1:JISHIFT+IEQ) = NSPARSE_DIAG_NAQ(1:IEQ)+JILOCAL - END IF - JISHIFT = JISHIFT + IEQ - JILOCAL = JILOCAL + ILAST*IMASKAQ(JI) + ILAST_NAQ*(1-IMASKAQ(JI)) - END DO - LU_CROW(NVAR+1) = LU_NONZERO+1 - LU_DIAG(NVAR+1) = LU_NONZERO+1 -! - DEALLOCATE(IMASKAQ) - RETURN -! -!------------------------------------------------------------------------------- -! -END SUBROUTINE PREPARE_LU_AQUEOUS_ROSENBROCK -! -!------------------------------------------------------------------------------- -! -END SUBROUTINE CH_MONITOR_n - diff --git a/src/ICCARE_BASE/ch_orilam.f90 b/src/ICCARE_BASE/ch_orilam.f90 deleted file mode 100644 index 22c7764e7..000000000 --- a/src/ICCARE_BASE/ch_orilam.f90 +++ /dev/null @@ -1,155 +0,0 @@ -!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence -!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!ORILAM_LIC for details. -!----------------------------------------------------------------- -!! ##################### - MODULE MODI_CH_ORILAM -!! ##################### -!! -INTERFACE -!! -SUBROUTINE CH_ORILAM(PAERO, PCHEM, PM, PLNSIG, PRG, PN, PCTOTG, PCTOTA, & - PCCTOT, PDTACT, PSEDA, & - PRHOP, PSO4RAT, & - PRV, PDENAIR, PPRESSURE, PTEMP, PRC, PFRAC, PMI, & - PTIME, GSCHEME, PSOLORG, & - PJNUC,PJ2RAT,PMBEG,PMINT,PMEND,PDMINTRA, & - PDMINTER,PDMCOND,PDMNUCL,PDMMERG, & - PCONC_MASS,PCOND_MASS_I,PCOND_MASS_J,PNUCL_MASS) -!! -IMPLICIT NONE -REAL, INTENT(IN) :: PDTACT, PTIME -REAL, DIMENSION(:,:), INTENT(INOUT) :: PRHOP -REAL, DIMENSION(:), INTENT(INOUT) :: PSO4RAT -REAL, DIMENSION(:), INTENT(INOUT) :: PJNUC, PJ2RAT -REAL, DIMENSION(:,:), INTENT(INOUT) :: PM -REAL, DIMENSION(:,:), INTENT(INOUT) :: PLNSIG, PRG, PN -REAL, DIMENSION(:,:), INTENT(INOUT) :: PCTOTG -REAL, DIMENSION(:,:), INTENT(INOUT) :: PSEDA -REAL, DIMENSION(:,:), INTENT(INOUT) :: PCHEM -REAL, DIMENSION(:,:), INTENT(INOUT) :: PAERO -REAL, DIMENSION(:,:), INTENT(INOUT) :: PFRAC -REAL, DIMENSION(:,:), INTENT(INOUT) :: PMI -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCTOTA, PCCTOT -REAL, DIMENSION(:,:), INTENT(INOUT) :: PSOLORG -REAL, DIMENSION(:), INTENT(IN) :: PRV, PDENAIR, PPRESSURE, PTEMP, PRC -CHARACTER(LEN=10), INTENT(IN) :: GSCHEME -REAL, DIMENSION(:,:), INTENT(INOUT) :: PMBEG,PMINT,PMEND -REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMINTRA,PDMINTER,PDMCOND,PDMNUCL,PDMMERG -REAL, DIMENSION(:), INTENT(INOUT) :: PCONC_MASS,PCOND_MASS_I,PCOND_MASS_J,PNUCL_MASS -!! -END SUBROUTINE CH_ORILAM -!! -END INTERFACE -!! -END MODULE MODI_CH_ORILAM -!! -!! ####################################################################### -SUBROUTINE CH_ORILAM(PAERO, PCHEM, PM, PLNSIG, PRG, PN, PCTOTG, PCTOTA, & - PCCTOT, PDTACT, PSEDA, & - PRHOP, PSO4RAT, & - PRV, PDENAIR, PPRESSURE, PTEMP, PRC, PFRAC, PMI, & - PTIME, GSCHEME, PSOLORG, & - PJNUC, PJ2RAT, PMBEG, PMINT, PMEND, PDMINTRA, & - PDMINTER, PDMCOND, PDMNUCL, PDMMERG, & - PCONC_MASS, PCOND_MASS_I, PCOND_MASS_J, PNUCL_MASS) -!! ####################################################################### -!! -!! PURPOSE -!! ------- -!! ORILAM aerosol Code -!! -!! REFERENCE -!! --------- -!! P. Tulet, V. Crassier, F. Cousin, K. Suhre, R. Rosset, jgr -!! ORILAM, A three moment lognormal aerosol scheme for mesoscale atmospheric -!! model. -!! On-line coupling into the Meso-NH-C model and validation on the Escompte -!! campaign. -!! -!! AUTHOR -!! ------ -!! Pierre Tulet (GMEI) and Vincent Crassier (LA) -!! -!! MODIFICATIONS -!! ------------- -!! Original -!! M. Leriche (08/16) add initialization of ZMASK -!! -!! EXTERNAL -!! -------- -!! MODI_CH_AER_TRANS -!! MODI_CH_AER_DRIVER -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! MODD_CH_AEROSOL -!! -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODI_CH_AER_TRANS -USE MODI_CH_AER_DRIVER -! -USE MODD_CH_AEROSOL -! -IMPLICIT NONE -! -! -!* 0.1 declarations of arguments -! -REAL, INTENT(IN) :: PDTACT, PTIME -REAL, DIMENSION(:,:), INTENT(INOUT) :: PM -REAL, DIMENSION(:,:), INTENT(INOUT) :: PRHOP -REAL, DIMENSION(:), INTENT(INOUT) :: PSO4RAT -REAL, DIMENSION(:), INTENT(INOUT) :: PJNUC, PJ2RAT -REAL, DIMENSION(:,:), INTENT(INOUT) :: PSEDA -REAL, DIMENSION(:,:), INTENT(INOUT) :: PCHEM -REAL, DIMENSION(:,:), INTENT(INOUT) :: PAERO -REAL, DIMENSION(:,:), INTENT(INOUT) :: PFRAC -REAL, DIMENSION(:,:), INTENT(INOUT) :: PMI -REAL, DIMENSION(:,:), INTENT(INOUT) :: PLNSIG, PRG, PN -REAL, DIMENSION(:,:), INTENT(INOUT) :: PCTOTG -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCTOTA, PCCTOT -REAL, DIMENSION(:,:), INTENT(INOUT) :: PSOLORG -REAL, DIMENSION(:), INTENT(IN) :: PRV, PDENAIR, PPRESSURE, PTEMP, PRC -CHARACTER(LEN=10), INTENT(IN) :: GSCHEME -REAL, DIMENSION(:,:), INTENT(INOUT) :: PMBEG,PMINT,PMEND -REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMINTRA,PDMINTER,PDMCOND,PDMNUCL,PDMMERG -REAL, DIMENSION(:), INTENT(INOUT) :: PCONC_MASS,PCOND_MASS_I,PCOND_MASS_J,PNUCL_MASS -! -!* 0.2 declarations of local variables -! -REAL, DIMENSION(SIZE(PAERO,1),JPMODE) :: ZMASK -REAL, DIMENSION(SIZE(PAERO,1)) :: ZSULF -! -!------------------------------------------------------------------------------- -! -!* 1. COMPUTATION -! ----------- -! -ZMASK(:,:) = 1. -! -!* 1.1 transfer gas phase variables into aerosol variables -! -CALL CH_AER_TRANS(0, PM, PLNSIG, PRG, PN, PRHOP,PAERO, PCHEM, PCTOTG, PCTOTA, PCCTOT, & - PFRAC, PMI, ZMASK, GSCHEME) -! -!* 1.2 integrate aerosol variables -! -CALL CH_AER_DRIVER(PM,PLNSIG, PRG, PN, PCTOTG, PCTOTA, PCCTOT, & - PDTACT, PSEDA, PRHOP, PSO4RAT, & - PRV, PDENAIR, PPRESSURE, PTEMP, PRC, ZMASK, PTIME, & - PSOLORG,PJNUC,PJ2RAT,PMBEG,PMINT,PMEND,PDMINTRA, & - PDMINTER,PDMCOND,PDMNUCL,PDMMERG, & - PCONC_MASS,PCOND_MASS_I,PCOND_MASS_J,PNUCL_MASS ) -! -!* 1.3 transfer aerosol variables back into gas phase variables -! -CALL CH_AER_TRANS(1, PM, PLNSIG, PRG, PN, PRHOP, PAERO, PCHEM, PCTOTG, PCTOTA, PCCTOT, & - PFRAC, PMI, ZMASK,GSCHEME) -! -END SUBROUTINE CH_ORILAM diff --git a/src/ICCARE_BASE/compute_isba_parameters.F90 b/src/ICCARE_BASE/compute_isba_parameters.F90 deleted file mode 100644 index f0a61e85b..000000000 --- a/src/ICCARE_BASE/compute_isba_parameters.F90 +++ /dev/null @@ -1,1135 +0,0 @@ -!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -!############################################################# -SUBROUTINE COMPUTE_ISBA_PARAMETERS (DTCO, OREAD_BUDGETC, UG, U, & - IO, DTI, SB, S, IG, K, NK, NIG, NP, NPE, & - NAG, NISS, ISS, NCHI, CHI, MGN, MSF, ID, & - GB, NGB, NDST, SLT,BLOWSNW, SV, HPROGRAM,HINIT, & - OLAND_USE,KI,KSV,KSW,HSV,PCO2,PRHOA, & - PZENITH,PSW_BANDS,PDIR_ALB,PSCA_ALB, & - PEMIS,PTSRAD,PTSURF, PMEGAN_FIELDS, HTEST ) -!############################################################# -! -!!**** *COMPUTE_ISBA_PARAMETERS_n* - routine to initialize ISBA -!! -!! PURPOSE -!! ------- -!! -!!** METHOD -!! ------ -!! -!! EXTERNAL -!! -------- -!! -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! REFERENCE -!! --------- -!! -!! -!! AUTHOR -!! ------ -!! V. Masson *Meteo France* -!! -!! MODIFICATIONS -!! ------------- -!! Original 01/2004 -!! Modified by P. Le Moigne (11/2004): miscellaneous diagnostics -!! Modified by P. Le Moigne (06/2006): seeding and irrigation -!! Modified by B. Decharme (2008) : SGH and Flooding scheme -!! Modified by B. Decharme (01/2009): optional deep soil temperature as in Arpege -!! Modified by R. Hamdi (01/2009): Cp and L -!! Modified by B. Decharme (06/2009): read topographic index statistics -!! Modified by P. Le Moigne (01/2009): Beljaars sso -!! Modified by B. Decharme (08/2009): Active Trip coupling variable if Earth System Model -!! A.L. Gibelin 04/09 : change BSLAI_NITRO initialisation -!! A.L. Gibelin 04/09 : modifications for CENTURY model -!! A.L. Gibelin 06/09 : soil carbon initialisation -!! Modified by B. Decharme (09/2012): Bug in exponential profile calculation with DIF -!! F. Bouttier 08/13 : apply random perturbation patterns for ensembles -!! B. Vincendon 03/14 : bug correction for CISBA=3L and CKSAT=EXP (TOPD coupling) -!! Modified by B. Decharme (04/2013): Subsurface runoff if SGH (DIF option only) -!! Delete CTOPREG (never used) -!! Delete NWG_LAYER_TOT, NWG_SIZE -!! water table / Surface coupling -!! P. Samuelsson 02/14 : MEB -!! B. Decharme 01/16 : Bug when vegetation veg, z0 and emis are imposed whith interactive vegetation -!! B. Decharme 10/2016 bug surface/groundwater coupling -!! P. Tulet 06/2016 : call init_megan for coupling megan with surfex -!! -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t -USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_P_t, ISBA_PE_t, ISBA_K_t, ISBA_NK_t, & - ISBA_NP_t, ISBA_NPE_t -USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t -USE MODD_SFX_GRID_n, ONLY : GRID_t, GRID_NP_t -USE MODD_AGRI_n, ONLY : AGRI_t, AGRI_NP_t -USE MODD_SSO_n, ONLY : SSO_t, SSO_NP_t -USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t, CH_ISBA_NP_t -USE MODD_CANOPY_n, ONLY : CANOPY_t -USE MODD_GR_BIOG_n, ONLY : GR_BIOG_t, GR_BIOG_NP_t -USE MODD_SURFEX_n, ONLY : ISBA_DIAG_t -! -USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t -USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t -USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t -USE MODD_DST_n, ONLY : DST_NP_t, DST_t -USE MODD_SLT_n, ONLY : SLT_t -USE MODD_SV_n, ONLY : SV_t -USE MODD_BLOWSNW_n, ONLY : BLOWSNW_t -! -USE MODD_MEGAN_n, ONLY : MEGAN_t -USE MODD_MEGAN_SURF_FIELDS_n, ONLY : MEGAN_SURF_FIELDS_t -! -USE MODD_SFX_OASIS, ONLY : LCPL_LAND, LCPL_FLOOD, LCPL_GW, LCPL_CALVING -! -! -#ifdef TOPD -USE MODD_DUMMY_EXP_PROFILE,ONLY : XC_DEPTH_RATIO -#endif -! -USE MODD_ASSIM, ONLY : CASSIM_ISBA, LASSIM -! -USE MODD_DEEPSOIL, ONLY : LPHYSDOMC, LDEEPSOIL, XTDEEP_CLI, XGAMMAT_CLI -USE MODD_AGRI, ONLY : LAGRIP, XTHRESHOLD -! -! -USE MODD_SGH_PAR, ONLY : NDIMTAB, XICE_DEPH_MAX, XF_DECAY -! -USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE -USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF -USE MODD_SNOW_PAR, ONLY : XEMISSN -! -USE MODD_TOPD_PAR, ONLY : NUNIT -USE MODD_TOPODYN, ONLY : NNCAT, NMESHT -! -USE MODE_RANDOM -USE MODE_BLOWSNW_SEDIM_LKT1D -! -USE MODI_GET_1D_MASK -USE MODI_GET_Z0REL -USE MODI_GET_LUOUT -USE MODI_ABOR1_SFX -USE MODI_INIT_IO_SURF_n -USE MODI_ALLOCATE_PHYSIO -USE MODI_INIT_ISBA_MIXPAR -USE MODI_CONVERT_PATCH_ISBA -USE MODI_INIT_VEG_PGD_n -USE MODI_INIT_TOP -USE MODI_EXP_DECAY_SOIL_FR -USE MODI_CARBON_INIT -USE MODI_SOILTEMP_ARP_PAR -USE MODI_END_IO_SURF_n -! -USE MODI_MAKE_CHOICE_ARRAY -USE MODI_READ_SURF -USE MODI_READ_ISBA_n -USE MODI_INIT_ISBA_LANDUSE -USE MODI_READ_SBL_n -USE MODI_INIT_VEG_n -USE MODI_INIT_CHEMICAL_n -USE MODI_OPEN_NAMELIST -USE MODI_CH_INIT_DEP_ISBA_n -USE MODI_CLOSE_NAMELIST -USE MODI_INIT_DST -USE MODI_INIT_SLT -USE MODI_AVERAGED_ALBEDO_EMIS_ISBA -USE MODI_DIAG_ISBA_INIT_n -USE MODI_INIT_SURF_TOPD -USE MODI_ISBA_SOC_PARAMETERS -USE MODI_PACK_SAME_RANK -! -USE MODI_READ_AND_SEND_MPI -USE MODI_ISBA_TO_TOPD -USE MODI_OPEN_FILE -USE MODI_CLOSE_FILE -USE MODI_FIX_MEB_VEG -USE MODI_AV_PGD -USE MODI_SURF_PATCH -! -USE MODI_INIT_MEGAN_n -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -IMPLICIT NONE -! -!* 0.1 Declarations of arguments -! ------------------------- -! -TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO -LOGICAL, INTENT(IN) :: OREAD_BUDGETC -TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG -TYPE(SURF_ATM_t), INTENT(INOUT) :: U -! -TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO -TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI -TYPE(CANOPY_t), INTENT(INOUT) :: SB -TYPE(ISBA_S_t), INTENT(INOUT) :: S -TYPE(GRID_t), INTENT(INOUT) :: IG -TYPE(ISBA_K_t), INTENT(INOUT) :: K -TYPE(ISBA_NK_t), INTENT(INOUT) :: NK -TYPE(GRID_NP_t), INTENT(INOUT) :: NIG -TYPE(ISBA_NP_t), INTENT(INOUT) :: NP -TYPE(ISBA_NPE_t), INTENT(INOUT) :: NPE -TYPE(AGRI_NP_t), INTENT(INOUT) :: NAG -TYPE(SSO_NP_t), INTENT(INOUT) :: NISS -TYPE(SSO_t), INTENT(INOUT) :: ISS -TYPE(CH_ISBA_NP_t), INTENT(INOUT) :: NCHI -TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI -TYPE(MEGAN_t), INTENT(INOUT) :: MGN -TYPE(MEGAN_SURF_FIELDS_t), INTENT(INOUT) :: MSF -TYPE(ISBA_DIAG_t), INTENT(INOUT) :: ID -TYPE(GR_BIOG_t), INTENT(INOUT) :: GB -TYPE(GR_BIOG_NP_t), INTENT(INOUT) :: NGB -! -TYPE(DST_NP_t), INTENT(INOUT) :: NDST -TYPE(SLT_t), INTENT(INOUT) :: SLT -TYPE(SV_t), INTENT(INOUT) :: SV -TYPE(BLOWSNW_t), INTENT(INOUT) :: BLOWSNW -! - CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes - CHARACTER(LEN=3), INTENT(IN) :: HINIT ! choice of fields to initialize -LOGICAL, INTENT(IN) :: OLAND_USE ! -INTEGER, INTENT(IN) :: KI ! number of points -INTEGER, INTENT(IN) :: KSV ! number of scalars -INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands - CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN) :: HSV ! name of all scalar variables -REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration (kg/m3) -REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density -REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! solar zenithal angle -REAL, DIMENSION(KSW), INTENT(IN) :: PSW_BANDS ! middle wavelength of each band -REAL, DIMENSION(KI,KSW),INTENT(OUT) :: PDIR_ALB ! direct albedo for each band -REAL, DIMENSION(KI,KSW),INTENT(OUT) :: PSCA_ALB ! diffuse albedo for each band -REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS ! emissivity -REAL, DIMENSION(KI), INTENT(OUT) :: PTSRAD ! radiative temperature -REAL, DIMENSION(KI), INTENT(OUT) :: PTSURF ! surface effective temperature (K) -REAL, DIMENSION(KI,MSF%NMEGAN_NBR),INTENT(IN) :: PMEGAN_FIELDS -! - CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK' -! -! -!* 0.2 Declarations of local variables -! ------------------------------- -! -TYPE(GRID_t), POINTER :: GK -TYPE(ISBA_P_t), POINTER :: PK -TYPE(ISBA_K_t), POINTER :: KK -TYPE(ISBA_PE_t), POINTER :: PEK -TYPE(AGRI_t), POINTER :: AGK -TYPE(SSO_t), POINTER :: ISSK -TYPE(DST_t), POINTER :: DSTK -! -REAL, DIMENSION(U%NDIM_FULL) :: ZF_PARAM, ZC_DEPTH_RATIO -! -REAL, DIMENSION(KI) :: ZTSRAD_NAT !radiative temperature -REAL, DIMENSION(KI) :: ZTSURF_NAT !effective temperature -REAL, DIMENSION(KI) :: ZM -! -REAL, DIMENSION(KI) :: ZWG1 ! work array for surface water content -REAL, DIMENSION(KI,IO%NPATCH) :: ZTG1 ! work array for surface temperature -REAL, DIMENSION(KI,IO%NPATCH) :: ZF -! -REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK -REAL, DIMENSION(:,:), ALLOCATABLE :: ZDG_SOIL, ZDG_SOIL_P -REAL, DIMENSION(:), ALLOCATABLE :: ZSUM_PATCH -! -INTEGER :: ICH ! unit of input chemistry file -INTEGER :: JI, JL ! loop increment -INTEGER :: ILUOUT ! unit of output listing file -INTEGER :: IRESP ! return code -INTEGER :: IDECADE, IDECADE2 ! decade of simulation -INTEGER :: JP ! loop counter on tiles -INTEGER :: ISIZE_LMEB_PATCH ! Number of patches with MEB=true -! -LOGICAL :: GDIM, GCAS1, GCAS2, GCAS3 -INTEGER :: JVEG, IVERSION, IBUGFIX, IMASK, JMAXLOC -! - CHARACTER(LEN=4) :: YLVL - CHARACTER(LEN=LEN_HREC) :: YRECFM -! -REAL(KIND=JPRB) :: ZHOOK_HANDLE -! -!------------------------------------------------------------------------------- -! -! Initialisation for IO -! -IF (LHOOK) CALL DR_HOOK('COMPUTE_ISBA_PARAMETERS',0,ZHOOK_HANDLE) - CALL GET_LUOUT(HPROGRAM,ILUOUT) -! -IF (HTEST/='OK') THEN - CALL ABOR1_SFX('COMPUTE_ISBA_PARAMETERS: FATAL ERROR DURING ARGUMENT TRANSFER') -END IF -! -!---------------------------------------------------------------------------------- -!---------------------------------------------------------------------------------- -! -! PART 1 : Arrays of vegtypes & patches -! ------------------------------------- -! -! We need XVEGTYPE, XPATCH and XVEGTYPE_PATCH with dimension "PATCH" for some -! cases: initialized here -! -! Vegtypes first -ALLOCATE(S%XVEGTYPE(KI,NVEGTYPE)) -IF (DTI%LDATA_VEGTYPE) THEN - S%XVEGTYPE = DTI%XPAR_VEGTYPE -ELSE - !classical ecoclimap case - DO JVEG=1,NVEGTYPE - CALL AV_PGD(DTCO, S%XVEGTYPE(:,JVEG),S%XCOVER ,DTCO%XDATA_VEGTYPE(:,JVEG),'NAT','ARI',S%LCOVER) - END DO -ENDIF -! -! patches come from vegtypes -ALLOCATE(S%XPATCH(KI,IO%NPATCH)) -ALLOCATE(S%XVEGTYPE_PATCH(KI,NVEGTYPE,IO%NPATCH)) - CALL SURF_PATCH(IO%NPATCH,S%XVEGTYPE,S%XPATCH,S%XVEGTYPE_PATCH) -! -! removing little fractions of patches must be done of the XPATCH with dimension -! "PATCH" -IF (IO%XRM_PATCH/=0.) THEN - ! - WRITE(ILUOUT,*) " REMOVE PATCH below 5 % add to dominant patch " - ! remove small fraction of PATCHES and add to MAIN PATCH - DO JI = 1,KI - !1) find most present patch maximum value - JMAXLOC = MAXVAL(MAXLOC(S%XPATCH(JI,:))) - !2) FIND small value of cover - DO JP = 1,IO%NPATCH - IF ( S%XPATCH(JI,JP)<IO%XRM_PATCH ) THEN - S%XPATCH(JI,JMAXLOC) = S%XPATCH(JI,JMAXLOC) + S%XPATCH(JI,JP) - S%XPATCH(JI,JP) = 0.0 - ENDIF - ENDDO - ENDDO - ! -ENDIF -! -!---------------------------------------------------------------------------------- -!---------------------------------------------------------------------------------- -! -! PART 2 : Things depending only on options and / or needed first -! -------------------------------------------------------------- - -!* Physiographic data fields from land cover: -! ----------------------------------------- -! -IF (S%TTIME%TDATE%MONTH /= NUNDEF) THEN - IDECADE = 3 * ( S%TTIME%TDATE%MONTH - 1 ) + MIN(S%TTIME%TDATE%DAY-1,29) / 10 + 1 -ELSE - IDECADE = 1 -END IF -! -IDECADE2 = IDECADE -! -! concern DATA_ISBA, so no dependence on patches - CALL INIT_ISBA_MIXPAR(DTCO, DTI, IG%NDIM, IO, IDECADE, IDECADE2, S%XCOVER, S%LCOVER, 'NAT') -! -ISIZE_LMEB_PATCH=COUNT(IO%LMEB_PATCH(:)) -IF (ISIZE_LMEB_PATCH>0) THEN - CALL FIX_MEB_VEG(DTI, IG%NDIM, IO%LMEB_PATCH, IO%NPATCH) -ENDIF -! -! -!* Soil carbon -! ----------- -! -IF (HINIT == 'ALL' .AND. IO%CRESPSL=='CNT' .AND. IO%CPHOTO == 'NCB') CALL CARBON_INIT -! -!---------------------------------------------------------------------------------- -!---------------------------------------------------------------------------------- -! -! PART 3 : Loop on patches for general initialization -! -------------------------------------------------- -! -! loop on patches -DO JP = 1, IO%NPATCH - ! - KK => NK%AL(JP) - PK => NP%AL(JP) - PEK => NPE%AL(JP) - AGK => NAG%AL(JP) - ISSK => NISS%AL(JP) - ! - ! dimension of the patch - PK%NSIZE_P = COUNT(S%XPATCH(:,JP) > 0.0) - ! - ! mask of the patch in tile nature - ALLOCATE(PK%NR_P (PK%NSIZE_P)) - CALL GET_1D_MASK(PK%NSIZE_P, KI, S%XPATCH(:,JP), PK%NR_P) - ! - ! the array of vegtypes, patches and vegtypes by patches reduced on this patches - ALLOCATE(KK%XVEGTYPE(PK%NSIZE_P,NVEGTYPE)) - CALL PACK_SAME_RANK(PK%NR_P,S%XVEGTYPE,KK%XVEGTYPE) - ! - ALLOCATE(PK%XPATCH(PK%NSIZE_P)) - ALLOCATE(PK%XVEGTYPE_PATCH (PK%NSIZE_P,NVEGTYPE)) - CALL PACK_SAME_RANK(PK%NR_P,S%XPATCH(:,JP),PK%XPATCH) - CALL PACK_SAME_RANK(PK%NR_P,S%XVEGTYPE_PATCH(:,:,JP),PK%XVEGTYPE_PATCH) - ! - ! - ! soon needed packed fields - ! - IF (IO%LPERM) THEN - ALLOCATE(KK%XPERM(PK%NSIZE_P)) - CALL PACK_SAME_RANK(PK%NR_P, K%XPERM, KK%XPERM) - ELSE - ALLOCATE(KK%XPERM(0)) - ENDIF - ! - ! - ALLOCATE(KK%XSAND(PK%NSIZE_P,IO%NGROUND_LAYER)) - ALLOCATE(KK%XCLAY(PK%NSIZE_P,IO%NGROUND_LAYER)) - ! - ALLOCATE(ISSK%XAOSIP(PK%NSIZE_P)) - ALLOCATE(ISSK%XAOSIM(PK%NSIZE_P)) - ALLOCATE(ISSK%XAOSJP(PK%NSIZE_P)) - ALLOCATE(ISSK%XAOSJM(PK%NSIZE_P)) - ALLOCATE(ISSK%XHO2IP(PK%NSIZE_P)) - ALLOCATE(ISSK%XHO2IM(PK%NSIZE_P)) - ALLOCATE(ISSK%XHO2JP(PK%NSIZE_P)) - ALLOCATE(ISSK%XHO2JM(PK%NSIZE_P)) - ! - ! - CALL PACK_SAME_RANK(PK%NR_P, K%XSAND, KK%XSAND) - CALL PACK_SAME_RANK(PK%NR_P, K%XCLAY, KK%XCLAY) - ! - CALL PACK_SAME_RANK(PK%NR_P,ISS%XAOSIP,ISSK%XAOSIP) - CALL PACK_SAME_RANK(PK%NR_P,ISS%XAOSIM,ISSK%XAOSIM) - CALL PACK_SAME_RANK(PK%NR_P,ISS%XAOSJP,ISSK%XAOSJP) - CALL PACK_SAME_RANK(PK%NR_P,ISS%XAOSJM,ISSK%XAOSJM) - CALL PACK_SAME_RANK(PK%NR_P,ISS%XHO2IP,ISSK%XHO2IP) - CALL PACK_SAME_RANK(PK%NR_P,ISS%XHO2IM,ISSK%XHO2IM) - CALL PACK_SAME_RANK(PK%NR_P,ISS%XHO2JP,ISSK%XHO2JP) - CALL PACK_SAME_RANK(PK%NR_P,ISS%XHO2JM,ISSK%XHO2JM) - ! - ! - !* 2.5 Physiographic fields - ! -------------------- - ! - CALL ALLOCATE_PHYSIO(IO, KK, PK, PEK, NVEGTYPE ) - ! - CALL CONVERT_PATCH_ISBA(DTCO, DTI, IO, IDECADE, IDECADE2, S%XCOVER, S%LCOVER, & - LAGRIP, 'NAT', JP, KK, PK, PEK, & - .TRUE., .TRUE., .TRUE., .TRUE., .FALSE., .FALSE., & - PSOILGRID=IO%XSOILGRID, PPERM=KK%XPERM ) - ! - !------------------------------------------------------------------------------- - ! - ! in init_veg_pgd_n, things needed also by garden and greenroof - CALL INIT_VEG_PGD_n(ISSK, DTI, IO, S, K, KK, PK, PEK, AGK, KI, & - HPROGRAM, 'NATURE', ILUOUT, PK%NSIZE_P, S%TTIME%TDATE%MONTH, & - LDEEPSOIL, LPHYSDOMC, XTDEEP_CLI, XGAMMAT_CLI, & - LAGRIP, XTHRESHOLD, HINIT, PCO2, PRHOA ) - ! - !------------------------------------------------------------------------------- - ! - ! Other fields needed to be initialized for isba only - ! - !Rainfall spatial distribution - !CRAIN used in HYDRO_VEG and HYDRO_SGH and VEG_SGH_UPDATE - IF(IO%CRAIN=='SGH')THEN - ALLOCATE(KK%XMUF(PK%NSIZE_P)) - KK%XMUF(:)=0.0 - ELSE - ALLOCATE(KK%XMUF(0)) - ENDIF - ! - ALLOCATE(KK%XFSAT(PK%NSIZE_P)) - KK%XFSAT(:) = 0.0 - ! - ! * Initialize flood scheme : - ! - ALLOCATE(KK%XFFLOOD (PK%NSIZE_P)) - ALLOCATE(KK%XPIFLOOD(PK%NSIZE_P)) - ALLOCATE(KK%XFF (PK%NSIZE_P)) - ALLOCATE(KK%XFFG (PK%NSIZE_P)) - ALLOCATE(KK%XFFV (PK%NSIZE_P)) - ALLOCATE(KK%XFFROZEN(PK%NSIZE_P)) - ALLOCATE(KK%XALBF (PK%NSIZE_P)) - ALLOCATE(KK%XEMISF (PK%NSIZE_P)) - KK%XFFLOOD = 0.0 - KK%XPIFLOOD = 0.0 - KK%XFF = 0.0 - KK%XFFG = 0.0 - KK%XFFV = 0.0 - KK%XFFROZEN = 0.0 - KK%XALBF = 0.0 - KK%XEMISF = 0.0 - ! -ENDDO -! -IF (DTI%LDATA_CONDSAT) DEALLOCATE(DTI%XPAR_CONDSAT) -! -!---------------------------------------------------------------------------------- -!---------------------------------------------------------------------------------- -! -! PART 4 : Initialization not depending on patches -! ------------------------------------------------ -! -! Fields needed also unpacked -! -IF(IO%CRAIN=='SGH')THEN - ALLOCATE(K%XMUF(KI)) - K%XMUF(:)=0.0 -ENDIF -! -! -ALLOCATE(ISS%XZ0REL(KI)) - CALL GET_Z0REL(ISS) -! -!------------------------------------------------------------------------------- -! -! PART 5: Initialize Chemical Deposition -! ----------------------------------- -! -! 3.1 Chemical gazes -! -------------- -! - !* for the time being, chemistry on vegetation works only for - ! ISBA on nature tile (not for gardens), because subroutine INIT_CHEMICAL_n - ! contains explicitely modules from ISBAn. It should be cleaned in a future - ! version. - CALL INIT_CHEMICAL_n(ILUOUT, KSV, HSV, CHI%SVI, CHI%CCH_NAMES, CHI%CAER_NAMES, & - HDSTNAMES=CHI%CDSTNAMES, HSLTNAMES=CHI%CSLTNAMES, & - HSNWNAMES=CHI%CSNWNAMES ) -! -IF (KSV /= 0) THEN - ! - IF (CHI%SVI%NBEQ > 0) THEN - !* for the time being, chemistry deposition on vegetation works only for - ! ISBA on nature tile (not for gardens), because subroutine CH_INIT_DEP_ISBA_n - ! contains explicitely modules from ISBAn. It should be cleaned in a future - ! version. - CALL OPEN_NAMELIST(HPROGRAM, ICH, HFILE=CHI%CCHEM_SURF_FILE) - CALL CH_INIT_DEP_ISBA_n(CHI, NCHI, NP, DTCO, IO%NPATCH, S%LCOVER, S%XCOVER, ICH, ILUOUT, KI) - CALL CLOSE_NAMELIST(HPROGRAM, ICH) - END IF - ! - DO JP = 1,IO%NPATCH - ! - DSTK => NDST%AL(JP) - PK => NP%AL(JP) - ! - IF (CHI%SVI%NDSTEQ >=1) THEN - ! - ALLOCATE (DSTK%XSFDST (PK%NSIZE_P, CHI%SVI%NDSTEQ)) !Output array - ALLOCATE (DSTK%XSFDSTM(PK%NSIZE_P, CHI%SVI%NDSTEQ)) !Output array - DSTK%XSFDST (:,:) = 0. - DSTK%XSFDSTM(:,:) = 0. - CALL INIT_DST(DSTK, U, HPROGRAM, PK%NSIZE_P, PK%NR_P, PK%XVEGTYPE_PATCH) - ELSE - ALLOCATE(DSTK%XSFDST (0,0)) - ALLOCATE(DSTK%XSFDSTM(0,0)) - END IF - ! - ENDDO - ! - IF (CHI%SVI%NSLTEQ >=1) THEN - CALL INIT_SLT(SLT, HPROGRAM) - END IF - ! - IF (CHI%SVI%NSNWEQ >=1) THEN - ALLOCATE (BLOWSNW%XSNW_FSED(KI,CHI%SVI%NSNWEQ+1)) !Output array - ALLOCATE (BLOWSNW%XSNW_FTURB(KI,CHI%SVI%NSNWEQ+1)) !Output array - ALLOCATE (BLOWSNW%XSNW_FNET(KI,CHI%SVI%NSNWEQ+1)) !Output array - ALLOCATE (BLOWSNW%XSNW_FSALT(KI,CHI%SVI%NSNWEQ+1)) !Output array - ALLOCATE (BLOWSNW%XSFSNW(KI,CHI%SVI%NSNWEQ+1)) !Output array - ALLOCATE (BLOWSNW%XSNW_SUBL(KI,CHI%SVI%NSNWEQ+1)) !Output array - BLOWSNW%XSNW_FSED (:,:) = 0. - BLOWSNW%XSNW_FTURB(:,:) = 0. - BLOWSNW%XSNW_FNET (:,:) = 0. - BLOWSNW%XSNW_FSALT(:,:) = 0. - BLOWSNW%XSNW_SUBL (:,:) = 0. - BLOWSNW%XSFSNW (:,:) = 0. - !Read in look up tables of snow particles properties - !No arguments, all look up tables are defined in module - !mode_snowdrift_sedim_lkt - CALL BLOWSNW_SEDIM_LKT1D_SET - ELSE - ALLOCATE(BLOWSNW%XSNW_FSED(0,0)) - ALLOCATE(BLOWSNW%XSNW_FTURB(0,0)) - ALLOCATE(BLOWSNW%XSNW_FSALT(0,0)) - ALLOCATE(BLOWSNW%XSNW_FNET(0,0)) - ALLOCATE(BLOWSNW%XSNW_SUBL(0,0)) - ALLOCATE(BLOWSNW%XSFSNW(0,0)) - END IF - -ENDIF -! -!------------------------------------------------------------------------------- -! -! PART 6: Specific options -! -------------------------- - -!6.A. DIF option : -!--------------- -! Anisotropy coeficient for hydraulic conductivity for topmodel drainage (Fan et al. 2006) -! Soil organic matter effect and/or Exponential decay for DIF option -! Must be call before INIT_TOP -! -! -IF(IO%CISBA=='DIF' .AND. IO%CKSAT=='SGH') THEN - ! - WRITE(ILUOUT,*)'THE KSAT EXP PROFILE WITH ISBA-DF IS NOT PHYSIC AND HAS BEEN REMOVED FOR NOW' - WRITE(ILUOUT,*)'A NEW PHYSICAL APPROACH WILL BE DEVELLOPED ACCOUNTING FOR COMPACTION IN ALL ' - WRITE(ILUOUT,*)'HYDRODYNAMIC PARAMETERS (WSAT, PSISAT, KSAT, B) AND NOT ONLY IN KSAT ' - CALL ABOR1_SFX('CKSAT=SGH is not physic with ISBA-DF and has been removed for now') - ! -ENDIF -! -IF(IO%CISBA=='DIF' .AND. IO%LSOC)THEN - ! - IF(.NOT.IO%LSOCP)THEN - WRITE(ILUOUT,*)'LSOC = T can be activated only if SOC data given in PGD fields' - CALL ABOR1_SFX('LSOC = T can be activated only if SOC data given in PGD fields') - ENDIF - ! - ALLOCATE(S%XFRACSOC(KI,IO%NGROUND_LAYER)) - CALL ISBA_SOC_PARAMETERS(IO%CRUNOFF, S%XSOC, K, NP, S%XFRACSOC, & - K%XWSAT, K%XWFC, K%XWWILT, IO%NPATCH ) - ! -ELSE - ALLOCATE(S%XFRACSOC(0,0)) -ENDIF -! -! -!6.B. Topmodel -!-------------- -! -ZF (:,:) = XUNDEF -ZM (:) = XUNDEF -! -!CRUNOFF used in hydro_sgh and isba_sgh_update -IF( IO%CRUNOFF=='SGH '.AND. HINIT/='PRE' .AND. .NOT.LASSIM ) THEN - ! - ! Subsurface flow by layer (m/s) - DO JP = 1,IO%NPATCH - PK => NP%AL(JP) - IF(IO%CISBA=='DIF') THEN - ALLOCATE(PK%XTOPQS(PK%NSIZE_P,IO%NGROUND_LAYER)) - PK%XTOPQS(:,:) = 0.0 - ELSE - ALLOCATE(PK%XTOPQS(0,0)) - ENDIF - ENDDO - ! - ALLOCATE(S%XTAB_FSAT(KI,NDIMTAB)) - ALLOCATE(S%XTAB_WTOP(KI,NDIMTAB)) - ALLOCATE(S%XTAB_QTOP(KI,NDIMTAB)) - S%XTAB_FSAT(:,:) = 0.0 - S%XTAB_WTOP(:,:) = 0.0 - S%XTAB_QTOP(:,:) = 0.0 - ! - WHERE(K%XCLAY(:,1)==XUNDEF.AND.S%XTI_MEAN(:)/=XUNDEF) S%XTI_MEAN(:)=XUNDEF - CALL INIT_TOP(IO, S, K, NK, NP, ILUOUT, ZM ) - ! -ELSE - ! - DO JP = 1,IO%NPATCH - PK => NP%AL(JP) - ALLOCATE(PK%XTOPQS(0,0)) - ENDDO - ! - ALLOCATE(S%XTAB_FSAT(0,0)) - ALLOCATE(S%XTAB_WTOP(0,0)) - ALLOCATE(S%XTAB_QTOP(0,0)) - ! -ENDIF -! -! -!Exponential decay for ISBA-FR option -!CKSAT used in hydro_soil.F90 and soil.F90 -IF ( IO%CISBA/='DIF' .AND. HINIT/='PRE' .AND. .NOT.LASSIM ) THEN - ! - GCAS1 = (IO%CKSAT=='EXP' .AND. IO%CISBA=='3-L') - GCAS2 = (IO%CKSAT=='SGH') - GCAS3 = (HPROGRAM/='AROME ' .AND. HPROGRAM/='MESONH ') - ! - IF ( GCAS1 .OR. GCAS2 ) THEN - ! - ALLOCATE(S%XF_PARAM (KI)) - S%XF_PARAM(:) = XUNDEF - ! - IF ( GCAS1 .AND. GCAS3 ) THEN - ! - !reading of XF_PARAM in external file - CALL OPEN_FILE('ASCII ',NUNIT,HFILE='carte_f_dc.txt',HFORM='FORMATTED',HACTION='READ ') - DO JI = 1,U%NDIM_FULL - READ(NUNIT,*) ZF_PARAM(JI), ZC_DEPTH_RATIO(JI) - ENDDO - CALL CLOSE_FILE('ASCII ',NUNIT) - CALL READ_AND_SEND_MPI(ZF_PARAM,S%XF_PARAM,U%NR_NATURE) -#ifdef TOPD - IF (.NOT.ALLOCATED(XC_DEPTH_RATIO)) ALLOCATE(XC_DEPTH_RATIO (KI)) - XC_DEPTH_RATIO(:) = XUNDEF - CALL READ_AND_SEND_MPI(ZC_DEPTH_RATIO,XC_DEPTH_RATIO,U%NR_NATURE) -#endif - ! - ELSEIF ( GCAS1 ) THEN - WRITE(ILUOUT,*) "COMPUTE_ISBA_PARAMETERS: WITH CKSAT=EXP, IN NOT OFFLINE "//& - "MODE, TOPMODEL FILE FOR F_PARAM IS NOT READ " - ENDIF - ! - ! definition of ZF functions of options - ! - ! Exponential decay factor calculate using soil properties - ! (eq. 11, Decharme et al., J. Hydrometeor, 2006) - DO JP = 1,IO%NPATCH - PK => NP%AL(JP) - ! - DO JI = 1,PK%NSIZE_P - IMASK = PK%NR_P(JI) - - IF ( GCAS2 .AND. IO%CRUNOFF=='SGH' .AND. ZM(IMASK)/=XUNDEF ) THEN - ZF(JI,JP) = (K%XWSAT(IMASK,1)-K%XWD0(IMASK,1)) / ZM(IMASK) - ELSEIF ( GCAS1 ) THEN - ZF(JI,JP) = S%XF_PARAM(IMASK) - ENDIF - ENDDO - ENDDO - ! - DO JP = 1,IO%NPATCH - PK => NP%AL(JP) - ! - WHERE ( ZF(1:PK%NSIZE_P,JP)==XUNDEF.AND.PK%XDG(:,2)/=XUNDEF ) - ZF(1:PK%NSIZE_P,JP) = 4.0/PK%XDG(:,2) - ENDWHERE - ZF(1:PK%NSIZE_P,JP) = MIN(ZF(1:PK%NSIZE_P,JP),XF_DECAY) - ! - ZC_DEPTH_RATIO(1:PK%NSIZE_P) = 1. -#ifdef TOPD - IF (ALLOCATED(XC_DEPTH_RATIO)) THEN - CALL PACK_SAME_RANK(PK%NR_P,XC_DEPTH_RATIO,ZC_DEPTH_RATIO(1:PK%NSIZE_P)) - ENDIF -#endif - CALL EXP_DECAY_SOIL_FR(IO%CISBA, ZF(1:PK%NSIZE_P,JP), PK, ZC_DEPTH_RATIO(1:PK%NSIZE_P)) - ENDDO - ! - IF ( GCAS2 ) THEN - ! - DO JI = 1,NP%AL(1)%NSIZE_P - IMASK = NP%AL(1)%NR_P(JI) - S%XF_PARAM(IMASK) = ZF(JI,1) - ENDDO - ! - ENDIF - ! - ENDIF - ! -ENDIF -! -! -! 6.C. Initialize required coupling fields : -!------------------------------------------- -! -IO%LCPL_RRM = .FALSE. -IO%LFLOOD = .FALSE. -IO%LWTD = .FALSE. -! -IF(LCPL_LAND)THEN -! - IO%LCPL_RRM = .TRUE. -! - IF(LCPL_GW)THEN - IO%LWTD = .TRUE. - ENDIF -! - ALLOCATE(S%XCPL_DRAIN (KI)) - ALLOCATE(S%XCPL_RUNOFF(KI)) - S%XCPL_DRAIN (:) = 0.0 - S%XCPL_RUNOFF(:) = 0.0 -! - IF(IO%LGLACIER)THEN - ALLOCATE(S%XCPL_ICEFLUX(KI)) - S%XCPL_ICEFLUX(:) = 0.0 - ELSE - ALLOCATE(S%XCPL_ICEFLUX(0)) - ENDIF -! - IF(LCPL_FLOOD)THEN - IO%LFLOOD = .TRUE. - ALLOCATE(S%XCPL_EFLOOD(KI)) - ALLOCATE(S%XCPL_PFLOOD(KI)) - ALLOCATE(S%XCPL_IFLOOD(KI)) - S%XCPL_EFLOOD(:)= 0.0 - S%XCPL_PFLOOD(:)= 0.0 - S%XCPL_IFLOOD(:)= 0.0 - ELSE - ALLOCATE(S%XCPL_EFLOOD(0)) - ALLOCATE(S%XCPL_PFLOOD(0)) - ALLOCATE(S%XCPL_IFLOOD(0)) - ENDIF -! -ELSE -! - ALLOCATE(S%XCPL_RUNOFF (0)) - ALLOCATE(S%XCPL_DRAIN (0)) - ALLOCATE(S%XCPL_ICEFLUX (0)) - ALLOCATE(S%XCPL_EFLOOD (0)) - ALLOCATE(S%XCPL_PFLOOD (0)) - ALLOCATE(S%XCPL_IFLOOD (0)) -! -ENDIF -! -! -IF (LCPL_LAND) THEN - ! - ALLOCATE(K%XFWTD(KI)) - ALLOCATE(K%XWTD (KI)) - K%XFWTD(:) = 0.0 - K%XWTD (:) = XUNDEF - ! - IF(LCPL_FLOOD)THEN - ALLOCATE(K%XFFLOOD (KI)) - ALLOCATE(K%XPIFLOOD(KI)) - K%XFFLOOD (:) = 0.0 - K%XPIFLOOD(:) = 0.0 - ! - ELSE - ! - ALLOCATE(K%XFFLOOD (0)) - ALLOCATE(K%XPIFLOOD(0)) - ! - ENDIF - ! -ELSE - ! - ALLOCATE(K%XFWTD(0)) - ALLOCATE(K%XWTD (0)) - ALLOCATE(K%XFFLOOD (0)) - ALLOCATE(K%XPIFLOOD(0)) - ! -ENDIF -! -! * Check some key : -! -IF(LCPL_CALVING)THEN - IF(.NOT.IO%LGLACIER)THEN - CALL ABOR1_SFX('COMPUTE_ISBA_PARAMETERS: LGLACIER MUST BE ACTIVATED IF LCPL_CALVING') - ENDIF -ENDIF -! -!------------------------------------------------------------------------------- -! -!* 6.D. ISBA time-varying deep force-restore temperature initialization -! -------------------------------------------------------------------- -! - CALL SOILTEMP_ARP_PAR(IO, HPROGRAM) -! -!------------------------------------------------------------------------------- -!------------------------------------------------------------------------------- -! -! PART 7: We packed needed fields and free unless ones -! ----------------------------------------------------- -! -! -DO JP = 1,IO%NPATCH - ! - KK => NK%AL(JP) - PK => NP%AL(JP) - ISSK => NISS%AL(JP) - GK => NIG%AL(JP) - ! - ALLOCATE(KK%XMPOTSAT(PK%NSIZE_P,IO%NGROUND_LAYER)) - ALLOCATE(KK%XBCOEF (PK%NSIZE_P,IO%NGROUND_LAYER)) - ! needed to be written as diagnostics, so not free - ALLOCATE(KK%XWWILT (PK%NSIZE_P,IO%NGROUND_LAYER)) - ALLOCATE(KK%XWFC (PK%NSIZE_P,IO%NGROUND_LAYER)) - ALLOCATE(KK%XWSAT (PK%NSIZE_P,IO%NGROUND_LAYER)) - ! - CALL PACK_SAME_RANK(PK%NR_P,K%XMPOTSAT,KK%XMPOTSAT) - CALL PACK_SAME_RANK(PK%NR_P,K%XBCOEF,KK%XBCOEF) - ! - CALL PACK_SAME_RANK(PK%NR_P,K%XWWILT,KK%XWWILT) - CALL PACK_SAME_RANK(PK%NR_P,K%XWFC,KK%XWFC) - CALL PACK_SAME_RANK(PK%NR_P,K%XWSAT,KK%XWSAT) - ! - IF (IO%CISBA=='2-L' .OR. IO%CISBA=='3-L') THEN - ALLOCATE(KK%XCGSAT(PK%NSIZE_P)) - ALLOCATE(KK%XC4B (PK%NSIZE_P)) - ALLOCATE(KK%XACOEF(PK%NSIZE_P)) - ALLOCATE(KK%XPCOEF(PK%NSIZE_P)) - CALL PACK_SAME_RANK(PK%NR_P,K%XCGSAT,KK%XCGSAT) - CALL PACK_SAME_RANK(PK%NR_P,K%XC4B, KK%XC4B) - CALL PACK_SAME_RANK(PK%NR_P,K%XACOEF,KK%XACOEF) - CALL PACK_SAME_RANK(PK%NR_P,K%XPCOEF,KK%XPCOEF) - ENDIF - ! - IF (IO%CSCOND=='PL98'.OR.IO%CISBA=='DIF') THEN - ALLOCATE(KK%XHCAPSOIL(PK%NSIZE_P,IO%NGROUND_LAYER)) - ALLOCATE(KK%XCONDDRY (PK%NSIZE_P,IO%NGROUND_LAYER)) - ALLOCATE(KK%XCONDSLD (PK%NSIZE_P,IO%NGROUND_LAYER)) - CALL PACK_SAME_RANK(PK%NR_P,K%XHCAPSOIL,KK%XHCAPSOIL) - CALL PACK_SAME_RANK(PK%NR_P,K%XCONDDRY ,KK%XCONDDRY) - CALL PACK_SAME_RANK(PK%NR_P,K%XCONDSLD ,KK%XCONDSLD) - ENDIF - ! - ALLOCATE(KK%XWDRAIN (PK%NSIZE_P)) - ALLOCATE(KK%XRUNOFFB(PK%NSIZE_P)) - CALL PACK_SAME_RANK(PK%NR_P,K%XWDRAIN,KK%XWDRAIN) - CALL PACK_SAME_RANK(PK%NR_P,K%XRUNOFFB,KK%XRUNOFFB) - ! - ! needed to be written as diagnostics, so not free - ALLOCATE(ISSK%XZ0REL (PK%NSIZE_P)) - ALLOCATE(ISSK%XSSO_SLOPE(PK%NSIZE_P)) - ! - CALL PACK_SAME_RANK(PK%NR_P,ISS%XZ0REL,ISSK%XZ0REL) - CALL PACK_SAME_RANK(PK%NR_P,ISS%XSSO_SLOPE,ISSK%XSSO_SLOPE) - ! - ALLOCATE(GK%XLAT(PK%NSIZE_P)) - ALLOCATE(GK%XLON(PK%NSIZE_P)) - ! - CALL PACK_SAME_RANK(PK%NR_P,IG%XLAT,GK%XLAT) - CALL PACK_SAME_RANK(PK%NR_P,IG%XLON,GK%XLON) - ! -ENDDO -! -! Useledd fields from now on -ISS%XAOSIP => NULL() -ISS%XAOSIM => NULL() -ISS%XAOSJP => NULL() -ISS%XAOSJM => NULL() -ISS%XHO2IP => NULL() -ISS%XHO2IM => NULL() -ISS%XHO2JP => NULL() -ISS%XHO2JM => NULL() -! -K%XMPOTSAT => NULL() -K%XBCOEF => NULL() -! -K%XCGSAT => NULL() -K%XC4B => NULL() -K%XACOEF => NULL() -K%XPCOEF => NULL() -! -K%XHCAPSOIL => NULL() -K%XCONDDRY => NULL() -K%XCONDSLD => NULL() -! -K%XWDRAIN => NULL() -K%XRUNOFFB => NULL() -! -!------------------------------------------------------------------------------- -! -!* if only physiographic fields are to be initialized, stop here. -! -IF (HINIT/='ALL' .AND. HINIT/='SOD') THEN - IF (LHOOK) CALL DR_HOOK('COMPUTE_ISBA_PARAMETERS',1,ZHOOK_HANDLE) - RETURN -END IF -! -!------------------------------------------------------------------------------- -!------------------------------------------------------------------------------- -! -! PART 8: Reading of prognostic variables -! ---------------------------------------- -! -IF (CASSIM_ISBA=="ENKF ") CALL INIT_RANDOM_SEED() -! -! -CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'NATURE','ISBA ','READ ') -! -!* 10. Prognostic and semi-prognostic fields -! ------------------------------------- -! - CALL READ_ISBA_n(DTCO, IO, S, NP, NPE, K%XCLAY, U, HPROGRAM) -! -IF (HINIT/='ALL') THEN - CALL END_IO_SURF_n(HPROGRAM) - IF (LHOOK) CALL DR_HOOK('COMPUTE_ISBA_PARAMETERS',1,ZHOOK_HANDLE) - RETURN -END IF -! -IF (HINIT=='PRE' .AND. NPE%AL(1)%TSNOW%SCHEME.NE.'3-L' .AND. & - NPE%AL(1)%TSNOW%SCHEME.NE.'CRO' .AND. IO%CISBA=='DIF') & - CALL ABOR1_SFX("INIT_ISBAN: WITH CISBA = DIF, CSNOW MUST BE 3-L OR CRO") -! -! -!* Extrapolation of the prognostic and semi-prognostic fields -! LAND USE case -! ------------------------------------- -! -IF (OLAND_USE) THEN - ! - CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP) - CALL READ_SURF(HPROGRAM,'BUG',IBUGFIX,IRESP) - GDIM = (IVERSION>8 .OR. IVERSION==8 .AND. IBUGFIX>0) - IF (GDIM) CALL READ_SURF(HPROGRAM,'SPLIT_PATCH',GDIM,IRESP) - ! - ALLOCATE(ZWORK(KI,IO%NPATCH)) - ! - !* read old patch fraction - ! - DO JP = 1,IO%NPATCH - ALLOCATE(NP%AL(JP)%XPATCH_OLD(NP%AL(JP)%NSIZE_P)) - ENDDO - ! - CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, 'PATCH', ZWORK) - DO JP = 1,IO%NPATCH - CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NP%AL(JP)%XPATCH_OLD(:)) - ENDDO - ! - !* read old soil layer thicknesses (m) - ! - DO JP = 1,IO%NPATCH - ALLOCATE(NP%AL(JP)%XDG_OLD(NP%AL(JP)%NSIZE_P,IO%NGROUND_LAYER)) - ENDDO - ! - DO JL=1,IO%NGROUND_LAYER - WRITE(YLVL,'(I4)') JL - YRECFM='OLD_DG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) - CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YRECFM, ZWORK) - DO JP = 1,IO%NPATCH - CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NP%AL(JP)%XDG_OLD(:,JL)) - ENDDO - END DO - DEALLOCATE(ZWORK) - ! - CALL INIT_ISBA_LANDUSE(DTCO, UG, U, IO, NK, NP, NPE, IG%XMESH_SIZE, & - HPROGRAM) -END IF -! -! -!* 12. Canopy air fields: -! ----------------- -! - CALL READ_SBL_n(DTCO, U, SB, IO%LCANOPY,HPROGRAM, "NATURE", SV=CHI%SVI,BLOWSNW=BLOWSNW) -! -!------------------------------------------------------------------------------- -!------------------------------------------------------------------------------- -! -! PART 9: initialize radiative and physical properties -! ---------------------------------------------------- -! -DO JP=1,IO%NPATCH - PK => NP%AL(JP) - KK => NK%AL(JP) - PEK => NPE%AL(JP) - ! - ALLOCATE(KK%XDIR_ALB_WITH_SNOW(PK%NSIZE_P,KSW)) - ALLOCATE(KK%XSCA_ALB_WITH_SNOW(PK%NSIZE_P,KSW)) - KK%XDIR_ALB_WITH_SNOW = 0.0 - KK%XSCA_ALB_WITH_SNOW = 0.0 - ! - CALL INIT_VEG_n(IO, KK, PK, PEK, DTI, ID%DM%LSURF_DIAG_ALBEDO, PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD ) - ! - ZWG1(1:PK%NSIZE_P) = PEK%XWG(:,1) - ZTG1(1:PK%NSIZE_P,JP) = PEK%XTG(:,1) - ! - CALL CONVERT_PATCH_ISBA(DTCO, DTI, IO, IDECADE, IDECADE2, S%XCOVER, S%LCOVER,& - LAGRIP, 'NAT', JP, KK, PK, PEK, & - .FALSE., .FALSE., .FALSE., .FALSE., .TRUE., .FALSE., & - PWG1=ZWG1(1:PK%NSIZE_P), PWSAT=KK%XWSAT) - ! -ENDDO -! -! -! Load randomly perturbed fields. Perturbation ratios are saved in case fields are reset later. -IF(IO%LPERTSURF) THEN - ! - CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP) - CALL READ_SURF(HPROGRAM,'BUG',IBUGFIX,IRESP) - GDIM = (IVERSION>8 .OR. IVERSION==8 .AND. IBUGFIX>0) - ! - ALLOCATE(ZWORK(KI,IO%NPATCH)) - ! - CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, 'VEG', ZWORK) - ALLOCATE(S%XPERTVEG(KI)) - S%XPERTVEG(:)=ZWORK(:,1) -! - CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, 'LAI', ZWORK) - ALLOCATE(S%XPERTLAI(KI)) - S%XPERTLAI(:)=ZWORK(:,1) -! - CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, 'CV', ZWORK) - ALLOCATE(S%XPERTCV(KI)) - S%XPERTCV(:)=ZWORK(:,1) -! - CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, 'PERTALB', ZWORK) - ALLOCATE(S%XPERTALB(KI)) - S%XPERTALB(:)=ZWORK(:,1) - - PEK => NPE%AL(1) - ISSK => NISS%AL(1) - - WHERE(PEK%XALBNIR_VEG (:)/=XUNDEF) PEK%XALBNIR_VEG(:) = PEK%XALBNIR_VEG (:) *( 1.+ S%XPERTALB(:) ) - WHERE(PEK%XALBVIS_VEG (:)/=XUNDEF) PEK%XALBVIS_VEG(:) = PEK%XALBVIS_VEG (:) *( 1.+ S%XPERTALB(:) ) - WHERE(PEK%XALBUV_VEG (:)/=XUNDEF) PEK%XALBUV_VEG (:) = PEK%XALBUV_VEG (:) *( 1.+ S%XPERTALB(:) ) - WHERE(PEK%XALBNIR_SOIL(:)/=XUNDEF) PEK%XALBNIR_SOIL(:) = PEK%XALBNIR_SOIL(:) *( 1.+ S%XPERTALB(:) ) - WHERE(PEK%XALBVIS_SOIL(:)/=XUNDEF) PEK%XALBVIS_SOIL(:) = PEK%XALBVIS_SOIL(:) *( 1.+ S%XPERTALB(:) ) - WHERE(PEK%XALBUV_SOIL (:)/=XUNDEF) PEK%XALBUV_SOIL (:) = PEK%XALBUV_SOIL (:) *( 1.+ S%XPERTALB(:) ) -! - CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, 'PERTZ0LAND', ZWORK) - ALLOCATE(S%XPERTZ0(KI)) - S%XPERTZ0(:)=ZWORK(:,1) - WHERE(PEK%XZ0(:)/=XUNDEF) PEK%XZ0(:) = PEK%XZ0(:) *( 1.+ S%XPERTZ0(:) ) - WHERE(ISSK%XZ0EFFIP(:)/=XUNDEF) ISSK%XZ0EFFIP(:) = ISSK%XZ0EFFIP(:)*( 1.+ S%XPERTZ0(:) ) - WHERE(ISSK%XZ0EFFIM(:)/=XUNDEF) ISSK%XZ0EFFIM(:) = ISSK%XZ0EFFIM(:)*( 1.+ S%XPERTZ0(:) ) - WHERE(ISSK%XZ0EFFJP(:)/=XUNDEF) ISSK%XZ0EFFJP(:) = ISSK%XZ0EFFJP(:)*( 1.+ S%XPERTZ0(:) ) - WHERE(ISSK%XZ0EFFJM(:)/=XUNDEF) ISSK%XZ0EFFJM(:) = ISSK%XZ0EFFJM(:)*( 1.+ S%XPERTZ0(:) ) -! -ENDIF -! -!------------------------------------------------------------------------------- -! -!* 14. Output radiative fields -! ----------------------- -! -ALLOCATE(S%XEMIS_NAT (KI)) -S%XEMIS_NAT (:) = XUNDEF -! - CALL AVERAGED_ALBEDO_EMIS_ISBA(IO, S, NK, NP, NPE, & - PZENITH, ZTG1, PSW_BANDS, PDIR_ALB, PSCA_ALB, & - S%XEMIS_NAT, ZTSRAD_NAT, ZTSURF_NAT ) -! -PEMIS = S%XEMIS_NAT -PTSRAD = ZTSRAD_NAT -PTSURF = ZTSURF_NAT -! -IF (CHI%LCH_BIO_FLUX .AND. TRIM(CHI%CPARAMBVOC) == 'MEGAN') THEN - IF (IO%CPHOTO/='NON') THEN - CALL INIT_MEGAN_n(IO, S, K, NP, MSF, MGN, & - IG%XLAT, CHI%SVI%CSV(CHI%SVI%NSV_CHSBEG:CHI%SVI%NSV_CHSEND), & - PMEGAN_FIELDS) - ELSE - CALL ABOR1_SFX("INIT_MEGAN: CPHOTO need to be 'AGS', 'LAI', 'AST', 'LST', 'NIT' options ") - END IF -END IF -! -!------------------------------------------------------------------------------- -! -!* 15. ISBA diagnostics initialization -! ------------------------------- -! -IF(IO%NPATCH<=1) ID%O%LPATCH_BUDGET=.FALSE. -! - CALL DIAG_ISBA_INIT_n(CHI, ID%DE, ID%DEC, ID%NDE, ID%NDEC, ID%O, & - ID%D, ID%DC, ID%ND, ID%NDC, ID%DM, ID%NDM, & - OREAD_BUDGETC, NGB, GB, IO, NP, NPE%AL(1)%TSNOW%SCHEME, & - NPE%AL(1)%TSNOW%NLAYER, SIZE(S%XABC), HPROGRAM,KI,KSW) -! -!------------------------------------------------------------------------------- -! - CALL INIT_SURF_TOPD(ID%DEC, IO, S, K, NP, NPE, UG, U, HPROGRAM, U%NDIM_FULL) -! -!------------------------------------------------------------------------------- -! -! End of IO -! - CALL END_IO_SURF_n(HPROGRAM) -! -IF (LHOOK) CALL DR_HOOK('COMPUTE_ISBA_PARAMETERS',1,ZHOOK_HANDLE) -! -END SUBROUTINE COMPUTE_ISBA_PARAMETERS - - diff --git a/src/ICCARE_BASE/convert_patch_isba.F90 b/src/ICCARE_BASE/convert_patch_isba.F90 deleted file mode 100644 index a70257224..000000000 --- a/src/ICCARE_BASE/convert_patch_isba.F90 +++ /dev/null @@ -1,1012 +0,0 @@ -!SFX_LIC Copyright 2010-2019 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -! ######### - SUBROUTINE CONVERT_PATCH_ISBA (DTCO, DTV, IO, KDEC, KDEC2, PCOVER, OCOVER,& - OAGRIP, HSFTYPE, KPATCH, KK, PK, PEK, OFIX, OTIME, & - OMEB, OIRR, OALB, OUPDATE_ALB, PSOILGRID, PWG1, PWSAT, PPERM ) -! ############################################################## -! -!!**** *CONVERT_PATCH_ISBA* -!! -!! PURPOSE -!! ------- -!! -!! METHOD -!! ------ -!! -! -!! EXTERNAL -!! -------- -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! REFERENCE -!! --------- -!! -!! AUTHOR -!! ------ -!! -!! S. Faroux Meteo-France -!! -!! MODIFICATION -!! ------------ -!! -!! Original 16/11/10 -!! V. Masson 04/14 Garden and Greenroofs can only be initialized by ecoclimap -!! in this routine (not from user specified parameters from -!! the nature tile, as the number of points is not the same) -!! B. Decharme 04/2013 Add CDGAVG (method to average depth) -!! Soil depth = Root depth with ISBA-DF -!! except for bare soil pft (but limited to 1m) -!! With TR_ML (new radiative transfert) and modis -!! albedo, UV albedo not defined (conserv nrj when -!! coupled to atmosphere) -!! P Samuelsson 10/2014 MEB -! P. Wautelet 15/02/2019: bugfix: allocate ZSTRESS only when its size has a meaning -!! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree -! -!---------------------------------------------------------------------------- -! -!* 0. DECLARATION -! ----------- -! -! -USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t -USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t -USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t -! -USE MODD_ISBA_n, ONLY : ISBA_P_t, ISBA_PE_t, ISBA_K_t -! -USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE, NVT_NO, NVT_ROCK, NVT_SNOW -! -USE MODD_TYPE_DATE_SURF -! -! -USE MODD_DATA_COVER, ONLY : XDATA_LAI, XDATA_H_TREE, & - XDATA_VEG, XDATA_Z0, XDATA_Z0_O_Z0H, & - XDATA_EMIS_ECO, XDATA_GAMMA, XDATA_CV, & - XDATA_RGL, XDATA_RSMIN, & - XDATA_ALBNIR_VEG, XDATA_ALBVIS_VEG, & - XDATA_ALBUV_VEG, & - XDATA_ALB_VEG_NIR, XDATA_ALB_VEG_VIS, & - XDATA_ALB_SOIL_NIR, XDATA_ALB_SOIL_VIS, & - XDATA_GMES, XDATA_BSLAI, XDATA_LAIMIN, & - XDATA_SEFOLD, XDATA_GC, XDATA_WRMAX_CF, & - XDATA_STRESS, & - XDATA_DMAX, XDATA_F2I, XDATA_RE25, & - XDATA_CE_NITRO, XDATA_CF_NITRO, & - XDATA_CNA_NITRO, XDATA_DICE, & - XDATA_GMES_ST, XDATA_BSLAI_ST, & - XDATA_SEFOLD_ST, XDATA_GC_ST, & - XDATA_DMAX_ST, XDATA_WATSUP, & - XDATA_GNDLITTER, XDATA_Z0LITTER, XDATA_H_VEG, & - TDATA_SEED, TDATA_REAP,XDATA_IRRIG, & - XDATA_ROOT_DEPTH, XDATA_GROUND_DEPTH, & - XDATA_ROOT_EXTINCTION, XDATA_ROOT_LIN -! -! -USE MODD_TREEDRAG, ONLY : LTREEDRAG -! -USE MODI_AV_PGD_PARAM -USE MODI_AV_PGD_1P -USE MODI_SOIL_ALBEDO -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -IMPLICIT NONE -! -!* 0.1 Declaration of arguments -! ------------------------ -! -! -TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO -TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV -TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO -! -INTEGER, INTENT(IN) :: KDEC -INTEGER, INTENT(IN) :: KDEC2 -REAL, DIMENSION(:,:), INTENT(IN) :: PCOVER -LOGICAL, DIMENSION(:), INTENT(IN) :: OCOVER -LOGICAL, INTENT(IN) :: OAGRIP -CHARACTER(LEN=*), INTENT(IN) :: HSFTYPE ! nature / garden -INTEGER, INTENT(IN) :: KPATCH -! -TYPE(ISBA_K_t), INTENT(INOUT) :: KK -TYPE(ISBA_P_t), INTENT(INOUT) :: PK -TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK -! -LOGICAL, INTENT(IN) :: OFIX -LOGICAL, INTENT(IN) :: OTIME -LOGICAL, INTENT(IN) :: OMEB -LOGICAL, INTENT(IN) :: OIRR -LOGICAL, INTENT(IN) :: OALB -LOGICAL, INTENT(IN) :: OUPDATE_ALB -! -REAL, DIMENSION(:), OPTIONAL, INTENT(IN) :: PWG1 -REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PWSAT -REAL, DIMENSION(:), OPTIONAL, INTENT(IN) :: PPERM -! -REAL, DIMENSION(:) , OPTIONAL, INTENT(IN) :: PSOILGRID -! -!* 0.2 Declaration of local variables -! ------------------------------ -! -REAL, DIMENSION(:), ALLOCATABLE :: ZWORKI - CHARACTER(LEN=3) :: YTREE, YNAT, YLAI, YVEG, YBAR, YDIF -! -INTEGER :: JLAYER ! loop counter on layers -INTEGER :: JVEG ! loop counter on vegtypes -! -LOGICAL :: GDATA ! Flag where initialization can be done -! ! either with ecoclimap of data fields specified -! ! by user on the natural points (GDTA=T) -! ! For fields in town, only ecoclimap option -! ! is treated in this routine (GDATA=F) -INTEGER :: JJ ! loop counter -! -INTEGER :: ISIZE_LMEB_PATCH ! Number of patches with MEB=true -! -REAL, ALLOCATABLE, DIMENSION(:) :: ZH_VEG -! -! -!* 0.3 Declaration of namelists -! ------------------------ -! -REAL(KIND=JPRB) :: ZHOOK_HANDLE -!------------------------------------------------------------------------------- -! -!* 1. Initializations -! --------------- -! -IF (LHOOK) CALL DR_HOOK('CONVERT_PATCH_ISBA',0,ZHOOK_HANDLE) -! -IF (ASSOCIATED(DTCO%XDATA_WEIGHT)) DEALLOCATE(DTCO%XDATA_WEIGHT) -! -IF (HSFTYPE=='NAT') THEN - YNAT='NAT' - YTREE='TRE' - YLAI='LAI' - YVEG='VEG' - YBAR='BAR' - YDIF='DVG' - GDATA=.TRUE. - ISIZE_LMEB_PATCH = COUNT(IO%LMEB_PATCH(:)) -ELSEIF (HSFTYPE=='GRD') THEN - YNAT='GRD' - YTREE='GRT' - YLAI='GRL' - YVEG='GRV' - YBAR='GRB' - YDIF='GDV' - GDATA=.FALSE. - ISIZE_LMEB_PATCH = 0 -ENDIF -! -IF (OFIX) THEN - ! - !* soil layers and root fraction -! ----------------------------- - ! - ! compute soil layers (and root fraction if DIF) - ! - CALL SET_GRID_PARAM(SIZE(PK%XDG,1),SIZE(PK%XDG,2)) -! -! D ICE -! ----- -! - IF (IO%CISBA/='DIF') THEN - IF (GDATA .AND. ANY(DTV%LDATA_DICE)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PK%XD_ICE,DTV%XPAR_VEGTYPE,DTV%XPAR_DICE,YNAT,'ARI',PK%NR_P,IO%NPATCH,KPATCH) - ELSE - CALL AV_PGD_1P(DTCO, PK%XD_ICE,PCOVER,XDATA_DICE(:,:),YNAT,'ARI',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF - ENDIF -! - IF (GDATA .AND. ANY(DTV%LDATA_Z0_O_Z0H)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PK%XZ0_O_Z0H,DTV%XPAR_VEGTYPE,DTV%XPAR_Z0_O_Z0H,YNAT,'ARI',PK%NR_P,IO%NPATCH,KPATCH) - ELSE - CALL AV_PGD_1P(DTCO, PK%XZ0_O_Z0H,PCOVER,XDATA_Z0_O_Z0H,YNAT,'ARI',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF -! - IF (IO%CPHOTO/='NON'.OR.LTREEDRAG) THEN - IF (GDATA .AND. ANY(DTV%LDATA_H_TREE)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PK%XH_TREE,DTV%XPAR_VEGTYPE,DTV%XPAR_H_TREE,YTREE,'ARI',PK%NR_P,IO%NPATCH,KPATCH) - ELSE - CALL AV_PGD_1P(DTCO, PK%XH_TREE,PCOVER,XDATA_H_TREE(:,:),YTREE,'ARI',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF - ENDIF -! - IF (GDATA .AND. ANY(DTV%LDATA_H_TREE)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PK%XH_TREE,DTV%XPAR_VEGTYPE,DTV%XPAR_H_TREE,YTREE,'ARI',PK%NR_P,IO%NPATCH,KPATCH) - ELSE - CALL AV_PGD_1P(DTCO, PK%XH_TREE,PCOVER,XDATA_H_TREE(:,:),YTREE,'ARI',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF -! - IF (IO%CPHOTO/='NON') THEN - ! - IF (SIZE(PK%XRE25)>0) THEN - IF (GDATA .AND. ANY(DTV%LDATA_RE25)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PK%XRE25,DTV%XPAR_VEGTYPE,DTV%XPAR_RE25,YNAT,'ARI',PK%NR_P,IO%NPATCH,KPATCH) - ELSE - CALL AV_PGD_1P(DTCO, PK%XRE25,PCOVER,XDATA_RE25,YNAT,'ARI',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF - ENDIF - ! - IF (SIZE(PK%XDMAX)>0) THEN - IF (GDATA .AND. ANY(DTV%LDATA_DMAX)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PK%XDMAX,DTV%XPAR_VEGTYPE,DTV%XPAR_DMAX,YTREE,'ARI',PK%NR_P,IO%NPATCH,KPATCH) - ELSE - CALL AV_PGD_1P(DTCO, PK%XDMAX,PCOVER,XDATA_DMAX_ST,YTREE,'ARI',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF - ENDIF - ! - ENDIF -! -ENDIF -! -IF (OTIME) THEN -! - IF (.NOT.OUPDATE_ALB) THEN -! VEG -! ---- - IF (GDATA .AND. ANY(DTV%LDATA_VEG)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, PEK%XVEG,DTV%XPAR_VEGTYPE,DTV%XPAR_VEG(:,KDEC2,:),& - YNAT,'ARI',PK%NR_P,IO%NPATCH,KPATCH) - ELSE - CALL AV_PGD_1P(DTCO, PEK%XVEG,PCOVER,XDATA_VEG(:,KDEC,:),YNAT,'ARI',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF -! -! LAI -! ---- - IF (GDATA .AND. ANY(DTV%LDATA_LAI)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PEK%XLAI,DTV%XPAR_VEGTYPE,DTV%XPAR_LAI(:,KDEC2,:),YVEG,'ARI',& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2) - ELSE - CALL AV_PGD_1P(DTCO, PEK%XLAI,PCOVER,XDATA_LAI(:,KDEC,:),YVEG,'ARI',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF -! -! EMIS -! ---- -!emis needs VEG by vegtypes is changed at this step - IF (GDATA .AND. ANY(DTV%LDATA_EMIS)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PEK%XEMIS ,DTV%XPAR_VEGTYPE,DTV%XPAR_EMIS(:,KDEC2,:),YNAT,'ARI',& - PK%NR_P,IO%NPATCH,KPATCH) - ELSE - CALL AV_PGD_1P(DTCO, PEK%XEMIS ,PCOVER ,XDATA_EMIS_ECO (:,KDEC,:),YNAT,'ARI',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF -! -! Z0V -! ---- - IF (GDATA .AND. ANY(DTV%LDATA_Z0)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PEK%XZ0,DTV%XPAR_VEGTYPE,DTV%XPAR_Z0(:,KDEC2,:),YNAT,'CDN',& - PK%NR_P,IO%NPATCH,KPATCH) - ELSE - CALL AV_PGD_1P(DTCO, PEK%XZ0 ,PCOVER ,XDATA_Z0 (:,KDEC,:),YNAT,'CDN',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF -! - ENDIF - - IF (GDATA .AND. ANY(DTV%LDATA_ALBNIR_VEG)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PEK%XALBNIR_VEG,DTV%XPAR_VEGTYPE,DTV%XPAR_ALBNIR_VEG(:,KDEC2,:),YVEG,'ARI',& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2) - ELSEIF (IO%CALBEDO=='CM13') THEN - CALL AV_PGD_1P(DTCO, PEK%XALBNIR_VEG,PCOVER,XDATA_ALB_VEG_NIR(:,KDEC,:),YVEG,'ARI', OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ELSE - CALL AV_PGD_1P(DTCO, PEK%XALBNIR_VEG,PCOVER,XDATA_ALBNIR_VEG,YVEG,'ARI',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF -! - IF (GDATA .AND. ANY(DTV%LDATA_ALBVIS_VEG)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PEK%XALBVIS_VEG,DTV%XPAR_VEGTYPE,DTV%XPAR_ALBVIS_VEG(:,KDEC2,:),YVEG,'ARI',& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2) - ELSEIF (IO%CALBEDO=='CM13') THEN - CALL AV_PGD_1P(DTCO, PEK%XALBVIS_VEG,PCOVER,XDATA_ALB_VEG_VIS(:,KDEC,:),YVEG,'ARI',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ELSE - CALL AV_PGD_1P(DTCO, PEK%XALBVIS_VEG,PCOVER,XDATA_ALBVIS_VEG,YVEG,'ARI',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF -! - IF ((IO%CALBEDO=='CM13'.OR.IO%LTR_ML)) THEN - PEK%XALBUV_VEG(:)=PEK%XALBVIS_VEG(:) - ELSEIF (GDATA .AND. ANY(DTV%LDATA_ALBUV_VEG)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PEK%XALBUV_VEG,DTV%XPAR_VEGTYPE,DTV%XPAR_ALBUV_VEG(:,KDEC2,:),YVEG,'ARI',& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2) - ELSE - CALL AV_PGD_1P(DTCO, PEK%XALBUV_VEG,PCOVER,XDATA_ALBUV_VEG,YVEG,'ARI',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF -! - IF (.NOT.OUPDATE_ALB) THEN -! Other parameters -! ---------------- - IF( SIZE(PEK%XRSMIN)>0) THEN - IF (GDATA .AND. ANY(DTV%LDATA_RSMIN)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PEK%XRSMIN,DTV%XPAR_VEGTYPE,DTV%XPAR_RSMIN,YLAI,'INV',& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2) - ELSE - CALL AV_PGD_1P(DTCO, PEK%XRSMIN,PCOVER,XDATA_RSMIN,YLAI,'INV',& - OCOVER,PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF - ENDIF -! - IF (GDATA .AND. ANY(DTV%LDATA_GAMMA)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PEK%XGAMMA,DTV%XPAR_VEGTYPE,DTV%XPAR_GAMMA,YVEG,'ARI',& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2) - ELSE - CALL AV_PGD_1P(DTCO, PEK%XGAMMA,PCOVER,XDATA_GAMMA,YVEG,'ARI',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF -! - IF (GDATA .AND. ANY(DTV%LDATA_WRMAX_CF)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PEK%XWRMAX_CF,DTV%XPAR_VEGTYPE,DTV%XPAR_WRMAX_CF,YVEG,'ARI',& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2) - ELSE - CALL AV_PGD_1P(DTCO, PEK%XWRMAX_CF,PCOVER,XDATA_WRMAX_CF,YVEG,'ARI',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF -! - IF (GDATA .AND. ANY(DTV%LDATA_RGL)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PEK%XRGL,DTV%XPAR_VEGTYPE,DTV%XPAR_RGL,YVEG,'ARI',& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2) - ELSE - CALL AV_PGD_1P(DTCO, PEK%XRGL,PCOVER,XDATA_RGL,YVEG,'ARI',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF -! - IF (GDATA .AND. ANY(DTV%LDATA_CV)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PEK%XCV,DTV%XPAR_VEGTYPE,DTV%XPAR_CV,YVEG,'INV',& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2) - ELSE - CALL AV_PGD_1P(DTCO, PEK%XCV,PCOVER,XDATA_CV,YVEG,'INV',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF -! - IF (ISIZE_LMEB_PATCH>0 .OR. IO%CPHOTO/='NON') THEN - - IF( SIZE(PEK%XBSLAI)>0) THEN - IF (GDATA .AND. ANY(DTV%LDATA_BSLAI)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PEK%XBSLAI,DTV%XPAR_VEGTYPE,DTV%XPAR_BSLAI,YVEG,'ARI',& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2) - ELSE - CALL AV_PGD_1P(DTCO, PEK%XBSLAI,PCOVER,XDATA_BSLAI_ST,YVEG,'ARI',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF - ENDIF - ENDIF -! - IF (IO%CPHOTO/='NON') THEN - ! - IF (SIZE(PEK%XLAIMIN)>0) THEN - IF (GDATA .AND. ANY(DTV%LDATA_LAIMIN)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PEK%XLAIMIN,DTV%XPAR_VEGTYPE,DTV%XPAR_LAIMIN,YVEG,'ARI',& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2) - ELSE - CALL AV_PGD_1P(DTCO, PEK%XLAIMIN,PCOVER,XDATA_LAIMIN,YVEG,'ARI',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF - ENDIF - ! - IF (SIZE(PEK%XSEFOLD)>0) THEN - IF (GDATA .AND. ANY(DTV%LDATA_SEFOLD)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PEK%XSEFOLD,DTV%XPAR_VEGTYPE,DTV%XPAR_SEFOLD,YVEG,'ARI',& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2) - ELSE - CALL AV_PGD_1P(DTCO, PEK%XSEFOLD,PCOVER,XDATA_SEFOLD_ST,YVEG,'ARI',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF - ENDIF - ! - IF ( SIZE(PEK%XGMES)>0) THEN - IF (GDATA .AND. ANY(DTV%LDATA_GMES)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PEK%XGMES,DTV%XPAR_VEGTYPE,DTV%XPAR_GMES,YVEG,'ARI',& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2) - ELSE - CALL AV_PGD_1P(DTCO, PEK%XGMES,PCOVER,XDATA_GMES_ST,YVEG,'ARI',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF - ENDIF - ! - IF ( SIZE(PEK%XGC)>0) THEN - IF (GDATA .AND. ANY(DTV%LDATA_GC)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PEK%XGC,DTV%XPAR_VEGTYPE,DTV%XPAR_GC,YVEG,'ARI',& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2) - ELSE - CALL AV_PGD_1P(DTCO, PEK%XGC,PCOVER,XDATA_GC_ST,YVEG,'ARI',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF - ENDIF - ! - IF (SIZE(PEK%XF2I)>0) THEN - IF (GDATA .AND. ANY(DTV%LDATA_F2I)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PEK%XF2I,DTV%XPAR_VEGTYPE,DTV%XPAR_F2I,YVEG,'ARI',& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2) - ELSE - CALL AV_PGD_1P(DTCO, PEK%XF2I,PCOVER,XDATA_F2I,YVEG,'ARI',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF - ENDIF - ! - IF (IO%CPHOTO=='NIT' .OR. IO%CPHOTO=='NCB') THEN - ! - IF (SIZE(PEK%XCE_NITRO)>0) THEN - IF (GDATA .AND. ANY(DTV%LDATA_CE_NITRO)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PEK%XCE_NITRO,DTV%XPAR_VEGTYPE,DTV%XPAR_CE_NITRO,YVEG,'ARI',& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2) - ELSE - CALL AV_PGD_1P(DTCO, PEK%XCE_NITRO,PCOVER,XDATA_CE_NITRO,YVEG,'ARI',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF - ENDIF - ! - IF (SIZE(PEK%XCF_NITRO)>0) THEN - IF (GDATA .AND. ANY(DTV%LDATA_CF_NITRO)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PEK%XCF_NITRO,DTV%XPAR_VEGTYPE,DTV%XPAR_CF_NITRO,YVEG,'ARI',& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2) - ELSE - CALL AV_PGD_1P(DTCO, PEK%XCF_NITRO,PCOVER,XDATA_CF_NITRO,YVEG,'ARI',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF - ENDIF - ! - IF (SIZE(PEK%XCNA_NITRO)>0) THEN - IF (GDATA .AND. ANY(DTV%LDATA_CNA_NITRO)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PEK%XCNA_NITRO,DTV%XPAR_VEGTYPE,DTV%XPAR_CNA_NITRO,YVEG,'ARI',& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2) - ELSE - CALL AV_PGD_1P(DTCO, PEK%XCNA_NITRO,PCOVER,XDATA_CNA_NITRO,YVEG,'ARI',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF - ENDIF - ! - ENDIF - ! - ENDIF -! -! STRESS -! -------- - IF (SIZE(PEK%LSTRESS)>0) THEN - CALL SET_STRESS - ENDIF -! - ENDIF -! -ENDIF -! -IF (OMEB .AND. .NOT.OUPDATE_ALB) THEN - ! -! GNDLITTER -! --------- - IF (GDATA .AND. ANY(DTV%LDATA_GNDLITTER)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, PEK%XGNDLITTER,DTV%XPAR_VEGTYPE,& - DTV%XPAR_GNDLITTER(:,KDEC2,:),YNAT,'ARI',PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2) - ELSE - CALL AV_PGD_1P(DTCO, PEK%XGNDLITTER,PCOVER,XDATA_GNDLITTER(:,KDEC,:),YNAT,'ARI',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF -! -! H_VEG -! ----- - IF (GDATA .AND. ANY(DTV%LDATA_H_VEG)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PEK%XH_VEG,DTV%XPAR_VEGTYPE,DTV%XPAR_H_VEG(:,KDEC2,:),YVEG,'ARI',& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2) - ELSE - CALL AV_PGD_1P(DTCO, PEK%XH_VEG,PCOVER,XDATA_H_VEG(:,KDEC,:),YVEG,'ARI',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF -! In case of MEB, force 0<PH_VEG<XUNDEF for those patches where LMEB_PATCH=.T. - IF(IO%LMEB_PATCH(KPATCH))THEN - ALLOCATE(ZH_VEG(SIZE(PEK%XH_VEG))) - ZH_VEG=PEK%XH_VEG(:) - WHERE(ZH_VEG>1000.) ZH_VEG=0. - ZH_VEG=MAX(ZH_VEG,1.0E-3) - PEK%XH_VEG(:)=ZH_VEG - DEALLOCATE(ZH_VEG) - ENDIF -! -! Z0LITTER -! -------- - IF (GDATA .AND. ANY(DTV%LDATA_Z0LITTER)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PEK%XZ0LITTER,DTV%XPAR_VEGTYPE,DTV%XPAR_Z0LITTER(:,KDEC2,:),YNAT,'CDN',& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2) - ELSE - CALL AV_PGD_1P(DTCO, PEK%XZ0LITTER ,PCOVER ,XDATA_Z0LITTER (:,KDEC,:),YNAT,'CDN',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF -! -ENDIF -! -IF (OIRR .AND. .NOT.OUPDATE_ALB) THEN -! - IF ((IO%CPHOTO == 'NIT' .OR. IO%CPHOTO=='NCB') .AND. OAGRIP) THEN - ! - ! date of seeding - ! --------------- - ! - ALLOCATE(ZWORKI(SIZE(PEK%TSEED,1))) - ! - IF(SIZE(PEK%TSEED)>0) THEN - IF (GDATA .AND. ANY(DTV%LDATA_SEED_M) .AND. ANY(DTV%LDATA_SEED_D)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - ZWORKI,DTV%XPAR_VEGTYPE,DTV%XPAR_SEED_M(:,:),YVEG,'MAJ',& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2) - PEK%TSEED(:)%TDATE%MONTH = NINT(ZWORKI(:)) - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - ZWORKI,DTV%XPAR_VEGTYPE,DTV%XPAR_SEED_D(:,:),YVEG,'MAJ',& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2) - PEK%TSEED(:)%TDATE%DAY = NINT(ZWORKI(:)) - ELSE - CALL AV_PGD_1P (PEK%TSEED,PCOVER,TDATA_SEED(:,:),YVEG,'MAJ',OCOVER,& - PK%NR_P,IO%NPATCH, KPATCH, KDECADE=KDEC) - ENDIF - ENDIF - ! - ! date of reaping - ! --------------- - ! - IF (SIZE(PEK%TREAP)>0) THEN - IF (GDATA .AND. ANY(DTV%LDATA_REAP_M) .AND. ANY(DTV%LDATA_REAP_D)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - ZWORKI,DTV%XPAR_VEGTYPE,DTV%XPAR_REAP_M(:,:),YVEG,'MAJ',& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2) - PEK%TREAP(:)%TDATE%MONTH = NINT(ZWORKI(:)) - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - ZWORKI,DTV%XPAR_VEGTYPE,DTV%XPAR_REAP_D(:,:),YVEG,'MAJ',& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2) - PEK%TREAP(:)%TDATE%DAY = NINT(ZWORKI(:)) - ELSE - CALL AV_PGD_1P (PEK%TREAP ,PCOVER,TDATA_REAP(:,:),YVEG,'MAJ',OCOVER,& - PK%NR_P,IO%NPATCH, KPATCH, KDECADE=KDEC) - ENDIF - ENDIF - ! - DEALLOCATE(ZWORKI) - ! - IF (SIZE(PEK%XIRRIG)>0) THEN - IF (GDATA .AND. ANY(DTV%LDATA_IRRIG)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PEK%XIRRIG,DTV%XPAR_VEGTYPE,DTV%XPAR_IRRIG(:,KDEC2,:),YVEG,'ARI',& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2) - ELSE - CALL AV_PGD_1P(DTCO, PEK%XIRRIG,PCOVER,XDATA_IRRIG,YVEG,'ARI',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF - ENDIF -! - IF (SIZE(PEK%XWATSUP)>0) THEN - IF (GDATA .AND. ANY(DTV%LDATA_WATSUP)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PEK%XWATSUP,DTV%XPAR_VEGTYPE,DTV%XPAR_WATSUP(:,KDEC2,:),YVEG,'ARI',& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2) - ELSE - CALL AV_PGD_1P(DTCO, PEK%XWATSUP,PCOVER,XDATA_WATSUP,YVEG,'ARI',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF - ENDIF - ! - ENDIF -! -ENDIF -! -IF (OALB) THEN -! - IF (GDATA .AND. ANY(DTV%LDATA_ALBNIR_SOIL)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PEK%XALBNIR_SOIL,DTV%XPAR_VEGTYPE,DTV%XPAR_ALBNIR_SOIL(:,KDEC2,:),YBAR,'ARI',& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2) - ELSEIF (IO%CALBEDO=='CM13') THEN - CALL AV_PGD_1P(DTCO, PEK%XALBNIR_SOIL,PCOVER,XDATA_ALB_SOIL_NIR(:,KDEC,:),YBAR,'ARI',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ELSE - CALL SOIL_ALBEDO (IO%CALBEDO, PWSAT(:,1), PWG1, KK, PEK, "NIR" ) - ENDIF -! - IF (GDATA .AND. ANY(DTV%LDATA_ALBVIS_SOIL)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PEK%XALBVIS_SOIL,DTV%XPAR_VEGTYPE,DTV%XPAR_ALBVIS_SOIL(:,KDEC2,:),YBAR,'ARI',& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2) - ELSEIF (IO%CALBEDO=='CM13') THEN - CALL AV_PGD_1P(DTCO, PEK%XALBVIS_SOIL,PCOVER,XDATA_ALB_SOIL_VIS(:,KDEC,:),YBAR,'ARI',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ELSE - CALL SOIL_ALBEDO (IO%CALBEDO, PWSAT(:,1), PWG1, KK, PEK, "VIS" ) - ENDIF -! - - IF (IO%CALBEDO=='CM13'.OR.IO%LTR_ML) THEN - PEK%XALBUV_SOIL(:)=PEK%XALBVIS_SOIL(:) - ELSEIF (GDATA .AND. ANY(DTV%LDATA_ALBUV_SOIL)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PEK%XALBUV_SOIL,DTV%XPAR_VEGTYPE,DTV%XPAR_ALBUV_SOIL(:,KDEC2,:),YNAT,'ARI',& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2) - ELSE - CALL SOIL_ALBEDO (IO%CALBEDO, PWSAT(:,1), PWG1, KK, PEK, "UV" ) - ENDIF -! -ENDIF -! -IF (ASSOCIATED(DTCO%XDATA_WEIGHT)) DEALLOCATE(DTCO%XDATA_WEIGHT) -! -IF (LHOOK) CALL DR_HOOK('CONVERT_PATCH_ISBA',1,ZHOOK_HANDLE) -! -!------------------------------------------------------------------------------- -CONTAINS -!------------------------------------------------------------------------------- -! -SUBROUTINE SET_STRESS -! -IMPLICIT NONE -! -REAL, DIMENSION(PK%NSIZE_P) :: ZWORK -REAL, DIMENSION(:,:), ALLOCATABLE :: ZSTRESS -INTEGER :: JI -REAL(KIND=JPRB) :: ZHOOK_HANDLE -! -IF (LHOOK) CALL DR_HOOK('CONVERT_PATCH_ISBA:SET_STRESS',0,ZHOOK_HANDLE) -! -IF (GDATA .AND. ANY(DTV%LDATA_STRESS)) THEN - ALLOCATE( ZSTRESS( SIZE(DTV%LPAR_STRESS,1),NVEGTYPE ) ) - ZSTRESS(:,:)=0. - DO JVEG=1,NVEGTYPE - DO JI = 1,PK%NSIZE_P - IF (DTV%LPAR_STRESS(JI,JVEG)) ZSTRESS(PK%NR_P(JI),JVEG) = 1. - ENDDO - ENDDO - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - ZWORK,DTV%XPAR_VEGTYPE,ZSTRESS,YVEG,'ARI',PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2) - DEALLOCATE( ZSTRESS ) -ELSE - CALL AV_PGD_1P(DTCO, ZWORK,PCOVER,XDATA_STRESS(:,:),YVEG,'ARI',OCOVER,PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) -ENDIF -! -WHERE (ZWORK(:)<0.5) - PEK%LSTRESS(:) = .FALSE. -ELSEWHERE - PEK%LSTRESS(:) = .TRUE. -END WHERE -! -IF (LHOOK) CALL DR_HOOK('CONVERT_PATCH_ISBA:SET_STRESS',1,ZHOOK_HANDLE) -END SUBROUTINE SET_STRESS -! -!------------------------------------------------------------------------------- -SUBROUTINE SET_GRID_PARAM(KNI,KGROUND) -! -USE MODD_PGDWORK, ONLY : XPREC -! -USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF -USE MODD_ISBA_PAR, ONLY : XPERMFRAC -! -USE MODD_REPROD_OPER, ONLY : CDGAVG, CDGDIF -! -USE MODI_INI_DATA_ROOTFRAC -USE MODI_INI_DATA_SOIL -USE MODI_PERMAFROST_DEPTH -USE MODI_ABOR1_SFX -! -IMPLICIT NONE -! -INTEGER, INTENT(IN) :: KNI -INTEGER, INTENT(IN) :: KGROUND -! -REAL, DIMENSION (SIZE(XDATA_GROUND_DEPTH,1),NVEGTYPE) :: ZDATA_GROUND_DEPTH -! -REAL, DIMENSION (KNI) :: ZDTOT, ZDG2, ZROOT_EXT, ZROOT_LIN -! -INTEGER :: JJ, JL -! -! flags taking general surface type flag into account -LOGICAL :: GDATA_DG, GDATA_GROUND_DEPTH, GDATA_ROOT_DEPTH, GDATA_ROOTFRAC, & - GNOECO, GMEB -!-------------------------------------------------------------------------! -REAL(KIND=JPRB) :: ZHOOK_HANDLE -! -IF (LHOOK) CALL DR_HOOK('CONVERT_PATCH_ISBA:SET_GRID_PARAM',0,ZHOOK_HANDLE) -! -IF(IO%CISBA=='DIF')THEN - IF(.NOT.OFIX) CALL ABOR1_SFX('CONVERT_PATCH_ISBA: SET_GRID_PARAM: KWG_LAYER, PDROOT and PGD2 must be present with DIF') - -ENDIF -! -GMEB = (OMEB .AND. (ISIZE_LMEB_PATCH>0)) -! -ZDTOT (:) = XUNDEF -ZDG2 (:) = XUNDEF -! -PK%NWG_LAYER(:) = NUNDEF -PK%XROOTFRAC(:,:) = XUNDEF -! -ZDATA_GROUND_DEPTH(:,:) = XDATA_GROUND_DEPTH(:,:) -! -GDATA_DG = GDATA .AND. ANY(DTV%LDATA_DG) -GDATA_GROUND_DEPTH = GDATA .AND. ANY(DTV%LDATA_GROUND_DEPTH) -GDATA_ROOT_DEPTH = GDATA .AND. ANY(DTV%LDATA_ROOT_DEPTH) -GDATA_ROOTFRAC = GDATA .AND. ANY(DTV%LDATA_ROOTFRAC) -! -!#################################################################################### -! -!CDGAVG : old for reprod = 'ARI' Arithmetic average for all depth -! recommended = 'INV' Harmonic average for all depth (default) -! -!CDGDIF : old for reprod = 'SOIL' d3 soil depth from ecoclimap for isba-df -! recommended = 'ROOT' d2 soil depth from ecoclimap for isba-df (default) -! -!#################################################################################### -!n -!DG IN NAMELIST => GROUND_DEPTH KNOWN, ROOT_DEPTH UNKNOWN -IF (GDATA_DG) THEN - ! - DO JLAYER=1,KGROUND - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PK%XDG(:,JLAYER),DTV%XPAR_VEGTYPE,DTV%XPAR_DG(:,JLAYER,:),YNAT,CDGAVG,& - PK%NR_P,IO%NPATCH,KPATCH) - ENDDO - ! -ENDIF -! -IF(.NOT.GDATA_GROUND_DEPTH.AND.IO%CISBA=='DIF'.AND.CDGDIF=='ROOT')THEN - ! - DO JVEG=1,NVEGTYPE - IF(JVEG==NVT_NO)THEN - WHERE(XDATA_GROUND_DEPTH(:,JVEG)/=XUNDEF) - ZDATA_GROUND_DEPTH(:,JVEG) = MIN(1.0,XDATA_GROUND_DEPTH(:,JVEG)) - ENDWHERE - ELSEIF(JVEG/=NVT_ROCK.AND.JVEG/=NVT_SNOW)THEN - ZDATA_GROUND_DEPTH(:,JVEG) = MAX(1.0,XDATA_ROOT_DEPTH(:,JVEG)) - ELSE - ZDATA_GROUND_DEPTH(:,JVEG) = XDATA_ROOT_DEPTH(:,JVEG) - ENDIF - ENDDO - ! -ENDIF -! -!CALCULATION OF GROUND_DEPTH IN ZDTOT : ECOCLMAP OR LDATA_GROUND_DEPTH -IF (IO%CISBA/='2-L') THEN - ! - IF (GDATA_GROUND_DEPTH .AND. (IO%CISBA=='DIF' .OR. .NOT.GDATA_DG)) THEN - !GROUND DEPTH IN NAMELIST - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - ZDTOT(:),DTV%XPAR_VEGTYPE,DTV%XPAR_GROUND_DEPTH(:,:),YNAT,CDGAVG,& - PK%NR_P,IO%NPATCH,KPATCH) - !Error Due to machine precision - WHERE(ZDTOT(:)/=XUNDEF) ZDTOT(:)=NINT(ZDTOT(:)*XPREC)/XPREC - !CONSISTENCY CHECK - IF (GDATA_DG) ZDTOT(:) = MIN(ZDTOT(:),PK%XDG(:,KGROUND)) - ELSEIF (GDATA_DG) THEN - !GROUND DEPTH FROM NAMELIST DG - ZDTOT(:) = PK%XDG(:,KGROUND) - ELSE - !GROUND DEPTH FROM ECOCLMAP - CALL AV_PGD_1P(DTCO, ZDTOT(:),PCOVER,ZDATA_GROUND_DEPTH(:,:),YNAT,CDGAVG,OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - IF(IO%CISBA=='DIF'.AND.CDGDIF=='ROOT')ZDG2(:)=ZDTOT(:) - ENDIF - ! -ENDIF -! -!CALCULATION OF GROUND_DEPTH : Permafrost depth put to 12m -IF(IO%CISBA=='DIF'.AND.IO%LPERM) CALL PERMAFROST_DEPTH(PK%NSIZE_P,KPATCH,PPERM,ZDTOT) -! -!IN BOTH CASES, ROOT_DEPTH IS NEEDED: PUT IN DG2 -IF (IO%CISBA=='DIF' .OR. .NOT.GDATA_DG) THEN - ! - GNOECO=(GDATA_ROOT_DEPTH .AND. .NOT.GDATA_ROOTFRAC) - IF (GNOECO) THEN - !ROOT_DEPTH IN NAMELIST - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - ZDG2(:),DTV%XPAR_VEGTYPE,DTV%XPAR_ROOT_DEPTH(:,:),YNAT,CDGAVG,& - PK%NR_P,IO%NPATCH,KPATCH) - !Error Due to machine precision - WHERE(ZDG2(:)/=XUNDEF) ZDG2(:)=NINT(ZDG2(:)*XPREC)/XPREC - !CONSISTENCY CHECKS - IF (ANY(DTV%LDATA_DG)) ZDG2(:) = MIN(ZDG2(:),PK%XDG(:,KGROUND)) - ZDTOT(:) = MAX(ZDG2(:),ZDTOT(:)) - IF (IO%CISBA=='DIF') THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PK%XDROOT(:),DTV%XPAR_VEGTYPE,DTV%XPAR_ROOT_DEPTH(:,:),YDIF,CDGAVG,& - PK%NR_P,IO%NPATCH,KPATCH) - !Error Due to machine precision - WHERE(PK%XDROOT(:)/=XUNDEF) - PK%XDROOT(:)=NINT(PK%XDROOT(:)*XPREC)/XPREC - ENDWHERE - IF(CDGDIF=='ROOT')THEN - WHERE(PK%XDROOT(:).NE.XUNDEF) ZDTOT(:) = MAX(PK%XDROOT(:),ZDTOT(:)) - WHERE(PK%XDROOT(:).NE.XUNDEF) ZDG2 (:) = MAX(PK%XDROOT(:),ZDG2 (:)) - ELSE - CALL AV_PGD_1P(DTCO, ZDG2(:),PCOVER,XDATA_ROOT_DEPTH(:,:),YNAT,CDGAVG,OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF - !CONSISTENCY CHECKS - IF (GDATA_DG) WHERE (PK%XDROOT(:).NE.XUNDEF) PK%XDROOT(:) = MIN(PK%XDROOT(:),PK%XDG(:,KGROUND)) - ENDIF - ELSE - !ROOT_DEPTH FROM ECOCLMAP - IF (IO%CISBA=='DIF')THEN - CALL AV_PGD_1P(DTCO, PK%XDROOT(:),PCOVER,XDATA_ROOT_DEPTH(:,:),YDIF,CDGAVG,OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - IF(CDGDIF=='ROOT')THEN - WHERE(PK%XDROOT(:).NE.XUNDEF) ZDTOT(:) = MAX(PK%XDROOT(:),ZDTOT(:)) - WHERE(PK%XDROOT(:).NE.XUNDEF) ZDG2 (:) = MAX(PK%XDROOT(:),ZDG2 (:)) - ELSE - CALL AV_PGD_1P(DTCO, ZDG2(:),PCOVER,XDATA_ROOT_DEPTH(:,:),YNAT,CDGAVG,OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF - ELSE - CALL AV_PGD_1P(DTCO, ZDG2(:),PCOVER,XDATA_ROOT_DEPTH(:,:),YNAT,CDGAVG,OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF - IF ( GDATA_GROUND_DEPTH .OR. GDATA_DG ) THEN - ZDG2 (:) = MIN(ZDG2 (:),ZDTOT(:)) - IF (IO%CISBA=='DIF') WHERE (PK%XDROOT(:).NE.XUNDEF) PK%XDROOT(:) = MIN(PK%XDROOT(:),ZDTOT(:)) - ENDIF - ENDIF - ! - !CALCULATION OF DG IF NOT IN NAMELIST - IF (.NOT.GDATA_DG) THEN - ! - IF (IO%CISBA=='DIF') THEN - IF( MAXVAL(ZDTOT,ZDTOT/=XUNDEF)>PSOILGRID(KGROUND) ) THEN - CALL ABOR1_SFX('CONVERT_PATCH_ISBA: not enough soil layer with optimized grid') - ENDIF - ENDIF - ! - WHERE(ZDG2(:)==XUNDEF.AND.ZDTOT(:)/=XUNDEF) ZDG2(:)=0.0 !No vegetation - ! - !IF CISBA=DIF CALCULATES ALSO KWG_LAYER WITH USE OF SOILGRID $ - CALL INI_DATA_SOIL(IO%CISBA, PK%XDG,PROOTDEPTH=ZDG2, PSOILDEPTH=ZDTOT,& - PSOILGRID=PSOILGRID, KWG_LAYER=PK%NWG_LAYER ) - IF (IO%CISBA=='DIF'.AND.CDGDIF=='ROOT')THEN - DO JJ=1,KNI - IF(IO%LPERM.AND.PK%NWG_LAYER(JJ)/=NUNDEF)THEN - IF(PPERM(JJ)<XPERMFRAC) ZDG2(JJ)=PK%XDG(JJ,PK%NWG_LAYER(JJ)) - ELSEIF(PK%NWG_LAYER(JJ)/=NUNDEF)THEN - ZDG2(JJ)=PK%XDG(JJ,PK%NWG_LAYER(JJ)) - ELSE - ZDG2(JJ)=XUNDEF - ENDIF - ENDDO - ENDIF - - ! - ELSEIF ( IO%CISBA=='DIF') THEN - ! - !CALCULATION OF KWG_LAYER IF DG IN NAMELIST - IF(GDATA_GROUND_DEPTH)THEN - DO JJ=1,KNI - DO JL=1,KGROUND - IF( PK%XDG(JJ,JL) <= ZDTOT(JJ) .AND. ZDTOT(JJ) < XUNDEF ) & - PK%NWG_LAYER(JJ) = JL - ENDDO - ENDDO - ELSE - PK%NWG_LAYER(:) = KGROUND - ENDIF - ! - ENDIF - ! - ! DROOT AND DG2 LMITED BY KWG_LAYER - IF (IO%CISBA=='DIF' .AND. .NOT.ANY(DTV%LDATA_ROOTFRAC)) THEN - ! - DO JJ=1,KNI - IF(PK%NWG_LAYER(JJ)/=NUNDEF) THEN - JL = PK%NWG_LAYER(JJ) - ZDG2 (JJ)=MIN(ZDG2 (JJ),PK%XDG(JJ,JL)) - IF (PK%XDROOT(JJ)/=XUNDEF) PK%XDROOT(JJ)=MIN(PK%XDROOT(JJ),PK%XDG(JJ,JL)) - ENDIF - ENDDO - ! - ENDIF - ! -ENDIF -! -!CALCULATION OF ROOTFRAC -IF (IO%CISBA=='DIF') THEN - ! - IF (GDATA_ROOTFRAC) THEN - ! - !ROOTFRAC IN NAMELIST - DO JL=1,KGROUND - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - PK%XROOTFRAC(:,JL),DTV%XPAR_VEGTYPE,DTV%XPAR_ROOTFRAC(:,JL,:),YNAT,'ARI',& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDDO - ! - ZDG2 (:)=0.0 - PK%XDROOT(:)=0.0 - DO JJ=1,KNI - ! - !DROOT DEPENDS ON ROOTFRAC - DO JL=KGROUND,1,-1 - IF( PK%XROOTFRAC(JJ,JL)>=1.0 )THEN - ZDG2 (JJ) = PK%XDG(JJ,JL) - PK%XDROOT(JJ) = PK%XDG(JJ,JL) - ELSEIF (JL<KGROUND.AND.PK%XROOTFRAC(JJ,JL)>0.0) THEN - IF (PK%NWG_LAYER(JJ)<=JL) PK%NWG_LAYER(JJ) = JL+1 - EXIT - ENDIF - ENDDO - ! - IF(PK%XDROOT(JJ)==0.0.AND.ZDG2(JJ)==0.0)THEN - JL=PK%NWG_LAYER(JJ) - ZDG2(JJ)=MIN(0.6,PK%XDG(JJ,JL)) - ENDIF - ! - ENDDO - ! - ELSE - ! - !DEPENDS ON DROOT - IF (GDATA .AND. ANY(DTV%LDATA_ROOT_LIN)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - ZROOT_LIN(:),DTV%XPAR_VEGTYPE,DTV%XPAR_ROOT_LIN(:,:),YDIF,'ARI',& - PK%NR_P,IO%NPATCH,KPATCH) - ELSE - CALL AV_PGD_1P(DTCO, ZROOT_LIN(:),PCOVER,XDATA_ROOT_LIN(:,:),YDIF,'ARI',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF - ! - IF (GDATA .AND. ANY(DTV%LDATA_ROOT_EXTINCTION)) THEN - CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & - ZROOT_EXT(:),DTV%XPAR_VEGTYPE,DTV%XPAR_ROOT_EXTINCTION(:,:),YDIF,'ARI',& - PK%NR_P,IO%NPATCH,KPATCH) - ELSE - CALL AV_PGD_1P(DTCO, ZROOT_EXT(:),PCOVER,XDATA_ROOT_EXTINCTION(:,:),YDIF,'ARI',OCOVER,& - PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) - ENDIF - ! - CALL INI_DATA_ROOTFRAC(PK%XDG,PK%XDROOT,ZROOT_EXT,ZROOT_LIN,PK%XROOTFRAC) - ENDIF - ! - WHERE(PK%XROOTFRAC(:,:)/=XUNDEF) PK%XROOTFRAC(:,:)=NINT(PK%XROOTFRAC(:,:)*XPREC)/XPREC - ! - PK%XDG2(:) = ZDG2(:) - ! -ENDIF -! -IF (LHOOK) CALL DR_HOOK('CONVERT_PATCH_ISBA:SET_GRID_PARAM',1,ZHOOK_HANDLE) -! -END SUBROUTINE SET_GRID_PARAM -!------------------------------------------------------------------------------- -END SUBROUTINE CONVERT_PATCH_ISBA diff --git a/src/ICCARE_BASE/coupling_dmsn.F90 b/src/ICCARE_BASE/coupling_dmsn.F90 deleted file mode 100644 index f9804bd58..000000000 --- a/src/ICCARE_BASE/coupling_dmsn.F90 +++ /dev/null @@ -1,58 +0,0 @@ -SUBROUTINE COUPLING_DMS_n(KI,& !! number of sea points - PWIND, & !! wind (m s-1) - PSST,& !! sea surface temperature (K) - DMS_OCEANIC,& !! DMS oceanic content (mol m-3) - PSFDMS) !! DMS emssion flux (mol m-2 s-1) -! - implicit none - -integer, intent(in) :: KI !! number of sea points -real,dimension(KI), intent(in) :: PWIND !! wind (m s-1) -real, dimension(KI), intent(in) :: PSST !! sea surface temperature (K) -real, dimension(KI), intent(in) :: DMS_OCEANIC !! DMS ocenanic content (mol m-3) -real,dimension(KI), intent(out) :: PSFDMS !! DMS emission flux (mol m-2 s-1) - -!!! local variables - -real,dimension(KI) :: sc_dms !! Schmidt number for DMS -real,parameter :: sc_co2 = 600. !! Schmidt number for CO2 -real,dimension(KI) :: zsst !! sea surface temperature (°C) -real,dimension(KI) :: k600 !! standard air-sea exchange coefficient for CO2 (m s-1) -real,dimension(KI) :: k_dms !! air-sea exchange coefficient for DMS (m s-1) - -! sea surface temperature (in °C) must be comprised between 5 and 30 °C - -ZSST(:) = PSST(:) - 273.15 -where (ZSST(:) < 5.) - ZSST(:) = 5. -endwhere - -where (ZSST(:) > 30.) - ZSST(:) = 30. -endwhere - - -! Schmidt number for DMS, using the sst in celsius, from -! Saltzman et al., 1993 (without unit) - -sc_dms(:) = 2674.0 - (147.12*ZSST(:)) + (3.726*(ZSST(:)**2.0)) - (0.038*(ZSST(:)**3.0)) - -! k600: Sea - air exchange coefficient from Nightingale et al. 2000 (in cm/hour) -! k600 is the standard air-sea exchange coefficient for CO2 gas, related to -! a Schmidt number of 600 - -k600(:) = 0.222*(PWIND(:)**2.0) + 0.333*PWIND(:) -! conversion into m s-1 -k600(:) = k600(:) *1.0e-2/3600. - - -! k_dms : air-sea exchange coefficient for DMS in m s-1 - -k_dms(:) = k600(:)*(sc_dms(:)/sc_co2)**(-0.5) - -! DMS emsission flux in mol m-2 s-1 - -PSFDMS(:) = k_dms(:) * DMS_OCEANIC(:) - -END SUBROUTINE COUPLING_DMS_n - diff --git a/src/ICCARE_BASE/coupling_isban.F90 b/src/ICCARE_BASE/coupling_isban.F90 deleted file mode 100644 index 044da5c75..000000000 --- a/src/ICCARE_BASE/coupling_isban.F90 +++ /dev/null @@ -1,1443 +0,0 @@ -!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -! ############################################################################### -SUBROUTINE COUPLING_ISBA_n (DTCO, UG, U, USS, NAG, CHI, NCHI, MGN, MSF, DTI, ID, NGB, & - GB, ISS, NISS, IG, NIG, IO, S, K, NK, NP, NPE, NDST, SLT, & - HPROGRAM, HCOUPLING, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, & - KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PZREF, PUREF, PZS, & - PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, & - PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, & - PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, & - PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, PPEW_B_COEF, & - PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, HTEST ) -! ############################################################################### -! -!!**** *COUPLING_ISBA_n * - Driver for ISBA time step -!! -!! PURPOSE -!! ------- -! -!!** METHOD -!! ------ -!! -!! First, all actions dependant on each patch is donbe independantly -!! (loop on patches) -!! Second, actions common to all patches (e.g. prescription of new vegetation) -!! Third, energy fluxes are averaged -!! -!! Nota that chemical fluxes are also treated. -!! -!! REFERENCE -!! --------- -!! -!! -!! AUTHOR -!! ------ -!! V. Masson -!! -!! MODIFICATIONS -!! ------------- -!! Original 01/2004 -!! P Le Moigne 11/2004 add new diagnostics for isba -!! A.Bogatchev 09/2005 EBA snow option -!! P Le Moigne 09/2005 AGS modifs of L. Jarlan -!! P Le Moigne 02/2006 z0h with snow -!! P.Le Moigne 06/2006 seeding and irrigation -!! B. Decharme 2008 reset the subgrid topographic effect on the forcing -!! PSNV allways <= PSNG -!! News diag -!! Flooding scheme and allows TRIP variables coupling -!! A.L. Gibelin 04/2009 : Add respiration diagnostics -!! A.L. Gibelin 04/2009 : BIOMASS and RESP_BIOMASS arrays -!! A.L. Gibelin 04/2009 : TAU_WOOD for NCB option -!! A.L. Gibelin 05/2009 : Add carbon spinup -!! A.L. Gibelin 06/2009 : Soil carbon variables for CNT option -!! A.L. Gibelin 07/2009 : Suppress RDK and transform GPP as a diagnostic -!! A.L. Gibelin 07/2009 : Suppress PPST and PPSTF as outputs -!! S.Lafont 01/2011 : add PTSTEP as arg of diag_misc -!! B.Decharme 09/2012 : Bug in hydro_glacier calculation with ES or Crocus -!! New wind implicitation -!! New soil carbon spinup and diag -!! Isba budget -!! F. Bouttier 01/2013 : Apply random perturbations for ensembles -!! B. Decharme 04/2013 new coupling variables -!! Subsurface runoff if SGH (DIF option only) -!! 07/2013 Surface / Water table depth coupling -!! P Samuelsson 10/2014 : MEB -!! P. LeMoigne 12/2014 EBA scheme update -!! R. Seferian 05/2015 : Add coupling fiels to vegetation_evol call -!! P. Tulet 06/2016 : call coupling_megan add RN leaves for MEGAN -!! J. Pianezzej 02/2019 : correction for use of MEGAN -!!------------------------------------------------------------------- -! -USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t -USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t -USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t -! -USE MODD_AGRI_n, ONLY : AGRI_NP_t -USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t, CH_ISBA_NP_t -USE MODD_MEGAN_n, ONLY : MEGAN_t -USE MODD_MEGAN_SURF_FIELDS_n, ONLY : MEGAN_SURF_FIELDS_t -USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t -USE MODD_SURFEX_n, ONLY : ISBA_DIAG_t -USE MODD_GR_BIOG_n, ONLY : GR_BIOG_t, GR_BIOG_NP_t -USE MODD_SSO_n, ONLY : SSO_t, SSO_NP_t -USE MODD_SFX_GRID_n, ONLY : GRID_t, GRID_NP_t -USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t -USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t, ISBA_P_t, ISBA_PE_t, ISBA_NK_t, ISBA_NP_t, ISBA_NPE_t -! -USE MODD_DST_n, ONLY : DST_NP_t -USE MODD_SLT_n, ONLY : SLT_t -! -USE MODD_REPROD_OPER, ONLY : CIMPLICIT_WIND -! -USE MODD_CSTS, ONLY : XRD, XRV, XP00, XCPD, XPI, XAVOGADRO, XMD -USE MODD_CO2V_PAR, ONLY : XMCO2, XSPIN_CO2 -! -USE MODD_SURF_PAR, ONLY : XUNDEF -USE MODD_SNOW_PAR, ONLY : XZ0SN -USE MODD_TYPE_DATE_SURF -! -USE MODD_SURF_ATM, ONLY : LNOSOF -! -USE MODD_DST_SURF -USE MODD_SLT_SURF -USE MODE_DSLT_SURF -USE MODE_MEB -! -USE MODD_AGRI, ONLY : LAGRIP -USE MODD_DEEPSOIL, ONLY : LDEEPSOIL -! -#ifdef TOPD -USE MODD_COUPLING_TOPD, ONLY : LCOUPL_TOPD, NMASKT_PATCH -#endif -! -USE MODI_IRRIGATION_UPDATE -USE MODI_ADD_FORECAST_TO_DATE_SURF -USE MODI_Z0EFF -USE MODI_ISBA -USE MODI_AVERAGE_FLUX -USE MODI_AVERAGE_PHY -USE MODI_AVERAGE_RAD -USE MODI_AVERAGE_DIAG_ISBA_n -USE MODI_VEGETATION_EVOL -USE MODI_VEGETATION_UPDATE -USE MODI_CARBON_EVOL -USE MODI_SUBSCALE_Z0EFF -USE MODI_SOIL_ALBEDO -USE MODI_ALBEDO -USE MODI_DIAG_INLINE_ISBA_n -USE MODI_DIAG_EVAP_CUMUL_ISBA_n -USE MODI_DIAG_MISC_ISBA_n -USE MODI_REPROJ_DIAG_ISBA_n -! -USE MODI_UPDATE_RAD_ISBA_n -USE MODI_DEEPSOIL_UPDATE -USE MODI_ISBA_SGH_UPDATE -USE MODI_ISBA_FLOOD_PROPERTIES -USE MODI_DIAG_CPL_ESM_ISBA -USE MODI_HYDRO_GLACIER -USE MODI_ISBA_ALBEDO -USE MODI_CARBON_SPINUP -USE MODI_CH_AER_DEP -USE MODI_ABOR1_SFX -USE MODI_AVERAGE_DIAG_EVAP_ISBA_n -USE MODI_AVERAGE_DIAG_MISC_ISBA_n -USE MODI_CH_BVOCEM_n -USE MODI_SOILEMISNO_n -USE MODI_CH_DEP_ISBA -USE MODI_DSLT_DEP -USE MODI_COUPLING_DST_n -USE MODI_COUPLING_SURF_TOPD -USE MODI_ISBA_BUDGET_INIT -USE MODI_ISBA_BUDGET -USE MODI_UNPACK_DIAG_PATCH_n -! -USE MODI_COUPLING_MEGAN_n -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -IMPLICIT NONE -! -!* 0.1 declarations of arguments -! -TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO -TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG -TYPE(SURF_ATM_t), INTENT(INOUT) :: U -TYPE(SSO_t), INTENT(INOUT) :: USS -! -TYPE(AGRI_NP_t), INTENT(INOUT) :: NAG -TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI -TYPE(CH_ISBA_NP_t), INTENT(INOUT) :: NCHI -TYPE(MEGAN_t), INTENT(INOUT) :: MGN -TYPE(MEGAN_SURF_FIELDS_t), INTENT(INOUT) :: MSF -TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI -TYPE(ISBA_DIAG_t), INTENT(INOUT) :: ID -TYPE(GR_BIOG_NP_t), INTENT(INOUT) :: NGB -TYPE(GR_BIOG_t), INTENT(INOUT) :: GB -TYPE(SSO_t), INTENT(INOUT) :: ISS -TYPE(SSO_NP_t), INTENT(INOUT) :: NISS -TYPE(GRID_t), INTENT(INOUT) :: IG -TYPE(GRID_NP_t), INTENT(INOUT) :: NIG -TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO -TYPE(ISBA_S_t), INTENT(INOUT) :: S -TYPE(ISBA_K_t), INTENT(INOUT) :: K -TYPE(ISBA_NK_t), INTENT(INOUT) :: NK -TYPE(ISBA_NP_t), INTENT(INOUT) :: NP -TYPE(ISBA_NPE_t), INTENT(INOUT) ::NPE -! -TYPE(DST_NP_t), INTENT(INOUT) :: NDST -TYPE(SLT_t), INTENT(INOUT) :: SLT -! - CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes - CHARACTER(LEN=1), INTENT(IN) :: HCOUPLING ! type of coupling - ! 'E' : explicit - ! 'I' : implicit -INTEGER, INTENT(IN) :: KYEAR ! current year (UTC) -INTEGER, INTENT(IN) :: KMONTH ! current month (UTC) -INTEGER, INTENT(IN) :: KDAY ! current day (UTC) -REAL, INTENT(IN) :: PTIME ! current time since midnight (UTC, s) -INTEGER, INTENT(IN) :: KI ! number of points -INTEGER, INTENT(IN) :: KSV ! number of scalars -INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands -REAL, DIMENSION(KI), INTENT(IN) :: PTSUN ! solar time (s from midnight) -REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step (s) -REAL, DIMENSION(KI), INTENT(IN) :: PZREF ! height of T,q forcing (m) -REAL, DIMENSION(KI), INTENT(IN) :: PUREF ! height of wind forcing (m) -! -REAL, DIMENSION(KI), INTENT(IN) :: PTA ! air temperature forcing (K) -REAL, DIMENSION(KI), INTENT(IN) :: PQA ! air humidity forcing (kg/m3) -REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density (kg/m3) -REAL, DIMENSION(KI,KSV),INTENT(IN) :: PSV ! scalar variables -! ! chemistry: first char. in HSV: '#' (molecule/m3) -! - CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: HSV ! name of all scalar variables! -REAL, DIMENSION(KI), INTENT(IN) :: PU ! zonal wind (m/s) -REAL, DIMENSION(KI), INTENT(IN) :: PV ! meridian wind (m/s) -REAL, DIMENSION(KI,KSW),INTENT(IN) :: PDIR_SW ! direct solar radiation (on horizontal surf.) -! ! (W/m2) -REAL, DIMENSION(KI,KSW),INTENT(IN) :: PSCA_SW ! diffuse solar radiation (on horizontal surf.) -! ! (W/m2) -REAL, DIMENSION(KSW),INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m) -REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! zenithal angle at t (radian from the vertical) -REAL, DIMENSION(KI), INTENT(IN) :: PZENITH2 ! zenithal angle at t+1(radian from the vertical) -REAL, DIMENSION(KI), INTENT(IN) :: PLW ! longwave radiation (on horizontal surf.) -! ! (W/m2) -REAL, DIMENSION(KI), INTENT(IN) :: PPS ! pressure at atmospheric model surface (Pa) -REAL, DIMENSION(KI), INTENT(IN) :: PPA ! pressure at forcing level (Pa) -REAL, DIMENSION(KI), INTENT(IN) :: PZS ! atmospheric model orography (m) -REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration in the air (kg_CO2/m3) -REAL, DIMENSION(KI), INTENT(IN) :: PSNOW ! snow precipitation (kg/m2/s) -REAL, DIMENSION(KI), INTENT(IN) :: PRAIN ! liquid precipitation (kg/m2/s) -! -! -REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH ! flux of heat (W/m2) -REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ ! flux of water vapor (kg/m2/s) -REAL, DIMENSION(KI), INTENT(OUT) :: PSFU ! zonal momentum flux (Pa) -REAL, DIMENSION(KI), INTENT(OUT) :: PSFV ! meridian momentum flux (Pa) -REAL, DIMENSION(KI), INTENT(OUT) :: PSFCO2 ! flux of CO2 positive toward the atmosphere (m/s*kg_CO2/kg_air) -REAL, DIMENSION(KI,KSV),INTENT(OUT):: PSFTS ! flux of scalar var. (kg/m2/s) -! -REAL, DIMENSION(KI), INTENT(OUT) :: PTRAD ! radiative temperature (K) -REAL, DIMENSION(KI,KSW),INTENT(OUT):: PDIR_ALB! direct albedo for each spectral band (-) -REAL, DIMENSION(KI,KSW),INTENT(OUT):: PSCA_ALB! diffuse albedo for each spectral band (-) -REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS ! emissivity (-) -! -REAL, DIMENSION(KI), INTENT(OUT) :: PTSURF ! surface effective temperature (K) -REAL, DIMENSION(KI), INTENT(OUT) :: PZ0 ! roughness length for momentum (m) -REAL, DIMENSION(KI), INTENT(OUT) :: PZ0H ! roughness length for heat (m) -REAL, DIMENSION(KI), INTENT(OUT) :: PQSURF ! specific humidity at surface (kg/kg) -! -REAL, DIMENSION(KI), INTENT(IN) :: PPEW_A_COEF! implicit coefficients -REAL, DIMENSION(KI), INTENT(IN) :: PPEW_B_COEF! needed if HCOUPLING='I' -REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF -REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF -REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF -REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF -CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK' - -! -! -!* 0.2 declarations of local variables -! -!* forcing variables -! -TYPE(ISBA_K_t), POINTER :: KK -TYPE(ISBA_P_t), POINTER :: PK -TYPE(ISBA_PE_t), POINTER :: PEK -TYPE(SSO_t), POINTER :: ISSK -! -REAL, DIMENSION(KI) :: ZWIND ! lowest atmospheric level wind speed (m/s) -REAL, DIMENSION(KI) :: ZDIR ! wind direction (rad from N clockwise) -REAL, DIMENSION(KI) :: ZEXNA ! Exner function at lowest atmospheric level (-) -REAL, DIMENSION(KI) :: ZEXNS ! Exner function at surface (-) -REAL, DIMENSION(KI) :: ZALFA ! Wind direction (-) -REAL, DIMENSION(KI) :: ZQA ! specific humidity (kg/kg) -REAL, DIMENSION(KI) :: ZCO2 ! CO2 concentration (kg/kg) -REAL :: ZSPINCO2 ! CO2 concentration (ppmv) -REAL, DIMENSION(KI) :: ZPEQ_A_COEF ! specific humidity implicit -REAL, DIMENSION(KI) :: ZPEQ_B_COEF ! coefficients (hum. in kg/kg) -! -INTEGER ::ISPINEND -! -! Patch outputs: -! -REAL, DIMENSION(KI,IO%NPATCH) :: ZSFTH_TILE ! surface heat flux (W/m2) -REAL, DIMENSION(KI,IO%NPATCH) :: ZSFTQ_TILE ! surface vapor flux (kg/m2/s) -REAL, DIMENSION(KI,IO%NPATCH) :: ZSFCO2_TILE ! surface CO2 flux positive toward the atmosphere (m/s*kg_CO2/kg_air) -REAL, DIMENSION(KI,IO%NPATCH) :: ZSFU_TILE ! zonal momentum flux -REAL, DIMENSION(KI,IO%NPATCH) :: ZSFV_TILE ! meridian momentum flux -REAL, DIMENSION(KI,IO%NPATCH) :: ZTRAD_TILE ! radiative surface temperature -REAL, DIMENSION(KI,IO%NPATCH) :: ZEMIS_TILE ! emissivity -REAL, DIMENSION(KI,IO%NPATCH) :: ZTSURF_TILE ! surface effective temperature -REAL, DIMENSION(KI,IO%NPATCH) :: ZZ0_TILE ! roughness length for momentum -REAL, DIMENSION(KI,IO%NPATCH) :: ZZ0H_TILE ! roughness length for heat -REAL, DIMENSION(KI,IO%NPATCH) :: ZQSURF_TILE ! specific humidity at surface -REAL, DIMENSION(KI,KSW,IO%NPATCH) :: ZDIR_ALB_TILE ! direct albedo -REAL, DIMENSION(KI,KSW,IO%NPATCH) :: ZSCA_ALB_TILE ! diffuse albedo -REAL, DIMENSION(KI,KSV,IO%NPATCH) :: ZSFTS_TILE ! scalar surface flux -! -REAL, DIMENSION(KI, IO%NPATCH) :: ZCPL_DRAIN ! For the coupling with TRIP -REAL, DIMENSION(KI, IO%NPATCH) :: ZCPL_RUNOFF ! For the coupling with TRIP -REAL, DIMENSION(KI, IO%NPATCH) :: ZCPL_EFLOOD ! For the coupling with TRIP -REAL, DIMENSION(KI, IO%NPATCH) :: ZCPL_PFLOOD ! For the coupling with TRIP -REAL, DIMENSION(KI, IO%NPATCH) :: ZCPL_IFLOOD ! For the coupling with TRIP -REAL, DIMENSION(KI, IO%NPATCH) :: ZCPL_ICEFLUX -! -! for chemical computations -! -REAL, DIMENSION(KI, IO%NPATCH) :: ZSW_FORBIO -! -REAL, DIMENSION(KI) :: ZRNSHADE -REAL, DIMENSION(KI) :: ZRNSUNLIT -! -REAL :: ZCONVERTFACM0_SLT, ZCONVERTFACM0_DST -REAL :: ZCONVERTFACM3_SLT, ZCONVERTFACM3_DST -REAL :: ZCONVERTFACM6_SLT, ZCONVERTFACM6_DST -! -! for blowing snow scheme -! -REAL, DIMENSION(KI,CHI%SVI%N2DSNWEQ) :: ZP_BLOWSNW_FLUX ! blowing snow fluxes -REAL, DIMENSION(KI,CHI%SVI%NSNWEQ) :: ZP_BLOWSNW_CONC ! blowing snow concentration -! -! dimensions and loop counters -! -INTEGER :: ISWB ! number of spectral shortwave bands -INTEGER :: JSWB ! loop on number of spectral shortwave bands -INTEGER :: JP ! loop on patches -INTEGER :: JSV, IDST, IMOMENT, II, IMASK, JI -INTEGER :: JLAYER, JMODE, JSV_IDX -! -! logical units -! -INTEGER :: JJ, IBEG, IEND, ISIZE -LOGICAL :: GUPDATED, GALB ! T if VEGETATION_UPDATE has reset fields -! -REAL(KIND=JPRB) :: ZHOOK_HANDLE -! -! -------------------------------------------------------------------------------------- -IF (LHOOK) CALL DR_HOOK('COUPLING_ISBA_N',0,ZHOOK_HANDLE) -IF (HTEST/='OK') THEN - CALL ABOR1_SFX('COUPLING_ISBAN: FATAL ERROR DURING ARGUMENT TRANSFER') -END IF -! -------------------------------------------------------------------------------------- -! -!* 1. Initializations -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Allocations: -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! -ZSFTH_TILE (:,:) = XUNDEF -ZSFTQ_TILE (:,:) = XUNDEF -ZSFCO2_TILE (:,:) = XUNDEF -ZSFU_TILE (:,:) = XUNDEF -ZSFV_TILE (:,:) = XUNDEF -ZTRAD_TILE (:,:) = XUNDEF -ZEMIS_TILE (:,:) = XUNDEF -ZDIR_ALB_TILE(:,:,:) = XUNDEF -ZSCA_ALB_TILE(:,:,:) = XUNDEF -ZTSURF_TILE (:,:) = XUNDEF -ZZ0_TILE (:,:) = XUNDEF -ZZ0H_TILE (:,:) = XUNDEF -ZQSURF_TILE (:,:) = XUNDEF -! -ZSFTS_TILE(:,:,:) = 0. -! -ZCPL_DRAIN(:,:) = 0.0 -ZCPL_RUNOFF(:,:) = 0.0 -ZCPL_EFLOOD(:,:) = 0.0 -ZCPL_PFLOOD(:,:) = 0.0 -ZCPL_IFLOOD(:,:) = 0.0 -ZCPL_ICEFLUX(:,:) = 0.0 -! -ZSW_FORBIO(:,:) = XUNDEF -! -ZRNSHADE(:) = 0.0 -ZRNSUNLIT(:) = 0.0 -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Forcing Modifications: -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! -ZDIR=0. -! -DO JJ=1,SIZE(PQA) -! specific humidity (conversion from kg/m3 to kg/kg) -! - ZQA(JJ) = PQA(JJ) / PRHOA(JJ) - ZPEQ_A_COEF(JJ) = PPEQ_A_COEF(JJ) / PRHOA(JJ) - ZPEQ_B_COEF(JJ) = PPEQ_B_COEF(JJ) / PRHOA(JJ) -! - ZCO2(JJ) = PCO2(JJ) / PRHOA(JJ) -! -! Other forcing variables depending on incoming forcing (argument list)JJ -! - ZEXNS(JJ) = (PPS(JJ)/XP00)**(XRD/XCPD) - ZEXNA(JJ) = (PPA(JJ)/XP00)**(XRD/XCPD) -! -!* wind strength -! - ZWIND(JJ) = SQRT(PU(JJ)**2+PV(JJ)**2) -! -!* wind direction -! - IF (ZWIND(JJ)>0.) ZDIR(JJ)=ATAN2(PU(JJ),PV(JJ)) -! -!* angle between z0eff J axis and wind direction (rad., clockwise) -! - ZALFA(JJ) = ZDIR(JJ) - ISS%XZ0EFFJPDIR(JJ) * XPI/180. - - IF (ZALFA(JJ)<-XPI) ZALFA(JJ) = ZALFA(JJ) + 2.*XPI - IF (ZALFA(JJ)>=XPI) ZALFA(JJ) = ZALFA(JJ) - 2.*XPI -! -ENDDO -! -!* number of shortwave spectral bands -! -ISWB = KSW -! -!* irrigation -! -IF (LAGRIP .AND. (IO%CPHOTO=='NIT'.OR. IO%CPHOTO=='NCB') ) THEN - CALL IRRIGATION_UPDATE(NAG, NPE, IO%NPATCH, PTSTEP, KMONTH, KDAY, PTIME ) -ENDIF -! -!* Actualization of the SGH variable (Fmu, Fsat) -! - CALL ISBA_SGH_UPDATE(IG%XMESH_SIZE, IO, S, K, NK, NP, NPE, PRAIN ) -! -! -!* Actualization of deep soil characteristics -! -IF (LDEEPSOIL) THEN - DO JP = 1,IO%NPATCH - KK => NK%AL(JP) - CALL DEEPSOIL_UPDATE(KK%XTDEEP, KK%XGAMMAT, S%TTIME%TDATE%MONTH) - ENDDO -ENDIF -! -!* Actualization of soil and wood carbon spinup -! -! During soil carbon spinup with ISBA-CC: -! (1) Atmospheric CO2 concentration fixed to Pre-industrial CO2 consentration XCO2_START -! (2) Atmospheric CO2 concentration rampin up from XCO2_START to XCO2_END -! -IF(IO%LSPINUPCARBS.OR.IO%LSPINUPCARBW)THEN -! - ISPINEND = IO%NNBYEARSPINS-NINT(IO%NNBYEARSPINS*XSPIN_CO2) -! - IO%LAGRI_TO_GRASS = .FALSE. -! - IF ( IO%LSPINUPCARBS .AND. (IO%NNBYEARSOLD <= ISPINEND) ) THEN -! - IO%LAGRI_TO_GRASS = .TRUE. -! - ZCO2(:) = IO%XCO2_START * 1.E-6 * XMCO2 / XMD -! - ELSEIF(IO%LSPINUPCARBS .AND. (IO%NNBYEARSOLD > ISPINEND) .AND. (IO%NNBYEARSOLD <= IO%NNBYEARSPINS) )THEN -! - ZSPINCO2 = IO%XCO2_START + (IO%XCO2_END-IO%XCO2_START) * & - REAL(IO%NNBYEARSOLD - ISPINEND) / REAL(IO%NNBYEARSPINS - ISPINEND) -! - ZCO2 (:) = ZSPINCO2 * 1.E-6 * XMCO2 / XMD -! - ENDIF -! - CALL CARBON_SPINUP( S%TTIME, IO ) -! -ENDIF -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Time evolution -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! -S%TTIME%TIME = S%TTIME%TIME + PTSTEP - CALL ADD_FORECAST_TO_DATE_SURF(S%TTIME%TDATE%YEAR,S%TTIME%TDATE%MONTH,S%TTIME%TDATE%DAY,S%TTIME%TIME) -! -! -------------------------------------------------------------------------------------- -! -!* 2. Physical evolution -! -! -------------------------------------------------------------------------------------- -! Patch Dependent Calculations -! -------------------------------------------------------------------------------------- -! -PATCH_LOOP: DO JP=1,IO%NPATCH - - IF (NP%AL(JP)%NSIZE_P == 0 ) CYCLE -! -! Pack dummy arguments for each patch: -! -#ifdef TOPD - IF (LCOUPL_TOPD) THEN - NMASKT_PATCH(:) = 0 - NMASKT_PATCH(1:NP%AL(JP)%NSIZE_P) = NP%AL(JP)%NR_P(:) - ENDIF -#endif - CALL TREAT_PATCH(NK%AL(JP), NP%AL(JP), NPE%AL(JP), NISS%AL(JP), NAG%AL(JP), & - NIG%AL(JP), NCHI%AL(JP), NDST%AL(JP), ID%ND%AL(JP), ID%NDC%AL(JP), & - ID%NDE%AL(JP), ID%NDEC%AL(JP), ID%NDM%AL(JP), NGB%AL(JP) ) -! -ENDDO PATCH_LOOP -! -! -------------------------------------------------------------------------------------- -! SFX - RRM coupling update if used : -! -------------------------------------------------------------------------------------- -! -IF(IO%LCPL_RRM)THEN - CALL DIAG_CPL_ESM_ISBA(IO, S, NK, NP, PTSTEP, ZCPL_DRAIN, ZCPL_RUNOFF, & - ZCPL_EFLOOD, ZCPL_PFLOOD, ZCPL_IFLOOD, ZCPL_ICEFLUX ) -ENDIF -! -! -------------------------------------------------------------------------------------- -! Vegetation update (in case of non-interactive vegetation): -! Or -! Vegetation albedo only update (in case of interactive vegetation): -! -------------------------------------------------------------------------------------- -! -GUPDATED=.FALSE. -! -IF (IO%LVEGUPD) THEN - GALB = .FALSE. - IF (IO%CPHOTO=='NIT'.OR.IO%CPHOTO=='NCB') GALB = .TRUE. - DO JP = 1,IO%NPATCH - CALL VEGETATION_UPDATE(DTCO, DTI, IG%NDIM, IO, NK%AL(JP), NP%AL(JP), NPE%AL(JP), JP, & - PTSTEP, S%TTIME, S%XCOVER, S%LCOVER, LAGRIP, & - 'NAT', GALB, NISS%AL(JP), GUPDATED ) - ENDDO -! -ENDIF -! -IF(IO%LPERTSURF.AND.GUPDATED) THEN - DO JP = 1,IO%NPATCH - PK => NP%AL(JP) - PEK => NPE%AL(JP) - ISSK => NISS%AL(JP) - - DO JI = 1,PK%NSIZE_P - IMASK = PK%NR_P(JI) - ! - ! random perturbation for ensembles: - ! reset these fields to their original values, as in compute_isba_parameters - PEK%XVEG(JI) = S%XPERTVEG(IMASK) - PEK%XLAI(JI) = S%XPERTLAI(IMASK) - PEK%XCV (JI) = S%XPERTCV (IMASK) - ! reapply original perturbation patterns - IF(PEK%XALBNIR(JI)/=XUNDEF) PEK%XALBNIR(JI) = PEK%XALBNIR(JI) *( 1.+ S%XPERTALB(IMASK) ) - IF(PEK%XALBVIS(JI)/=XUNDEF) PEK%XALBVIS(JI) = PEK%XALBVIS(JI) *( 1.+ S%XPERTALB(IMASK) ) - IF(PEK%XALBUV(JI)/=XUNDEF) PEK%XALBUV (JI) = PEK%XALBUV (JI) *( 1.+ S%XPERTALB(IMASK) ) - IF(PEK%XZ0(JI)/=XUNDEF) PEK%XZ0(JI) = PEK%XZ0(JI) *( 1.+ S%XPERTZ0(IMASK) ) - IF(ISSK%XZ0EFFIP(JI)/=XUNDEF) ISSK%XZ0EFFIP(JI) = ISSK%XZ0EFFIP(JI)*( 1.+ S%XPERTZ0(IMASK) ) - IF(ISSK%XZ0EFFIM(JI)/=XUNDEF) ISSK%XZ0EFFIM(JI) = ISSK%XZ0EFFIM(JI)*( 1.+ S%XPERTZ0(IMASK) ) - IF(ISSK%XZ0EFFJP(JI)/=XUNDEF) ISSK%XZ0EFFJP(JI) = ISSK%XZ0EFFJP(JI)*( 1.+ S%XPERTZ0(IMASK) ) - IF(ISSK%XZ0EFFJM(JI)/=XUNDEF) ISSK%XZ0EFFJM(JI) = ISSK%XZ0EFFJM(JI)*( 1.+ S%XPERTZ0(IMASK) ) - ENDDO - ENDDO -ENDIF -! -! -------------------------------------------------------------------------------------- -! Outputs for the atmospheric model or update the snow/flood fraction at time t+1 -! -------------------------------------------------------------------------------------- -! Grid box average fluxes/properties: Arguments and standard diagnostics at time t+1 -! - CALL AVERAGE_FLUX(S%XPATCH, ZSFTH_TILE, ZSFTQ_TILE, ZSFTS_TILE, & - ZSFCO2_TILE, ZSFU_TILE, ZSFV_TILE, PSFTH, PSFTQ,& - PSFTS, PSFCO2, PSFU, PSFV ) -! -! Get output megan flux if megan is activated - - -IF (CHI%SVI%NBEQ>0 .AND. CHI%LCH_BIO_FLUX) THEN - IF (TRIM(CHI%CPARAMBVOC) == 'MEGAN') THEN - ! Get output Isoprene flux - DO II=1,SIZE(MGN%XBIOFLX,1) - IF ((S%XPATCH(II,1) + S%XPATCH(II,2) + S%XPATCH(II,3)) .LT. 1.) THEN - MGN%XBIOFLX(II) = PSFTS(II,MGN%NBIO)/(1. - S%XPATCH(II,1) - S%XPATCH(II,2) - S%XPATCH(II,3)) - ELSE - MGN%XBIOFLX(:) = PSFTS(:,MGN%NBIO) - ENDIF - ENDDO - ENDIF -ENDIF - -! -!------------------------------------------------------------------------------- -!Physical properties see by the atmosphere in order to close the energy budget -!between surfex and the atmosphere. All variables should be at t+1 but very -!difficult to do. Maybe it will be done later. However, Ts is at time t+1 -!------------------------------------------------------------------------------- -! - CALL AVERAGE_PHY(S%XPATCH, ZTSURF_TILE, ZZ0_TILE, ZZ0H_TILE, & - ZQSURF_TILE, PUREF, PZREF, PTSURF, PZ0, PZ0H, PQSURF ) -! -!------------------------------------------------------------------------------------- -!Radiative properties at time t+1 (see by the atmosphere) in order to close -!the energy budget between surfex and the atmosphere -!------------------------------------------------------------------------------------- -! -DO JP = 1,IO%NPATCH - CALL UPDATE_RAD_ISBA_n(IO, S, NK%AL(JP), NP%AL(JP), NPE%AL(JP), JP, PZENITH2, PSW_BANDS, & - ZDIR_ALB_TILE(:,:,JP), ZSCA_ALB_TILE(:,:,JP), & - ZEMIS_TILE(:,JP), ZRNSHADE, ZRNSUNLIT, PDIR_SW, PSCA_SW ) -ENDDO -! - CALL AVERAGE_RAD(S%XPATCH, ZDIR_ALB_TILE, ZSCA_ALB_TILE, ZEMIS_TILE, & - ZTRAD_TILE, PDIR_ALB, PSCA_ALB, S%XEMIS_NAT, S%XTSRAD_NAT ) -! -PEMIS = S%XEMIS_NAT -PTRAD = S%XTSRAD_NAT -! -!------------------------------------------------------------------------------------- -! -! Any additional diagnostics (stored in MODD_DIAG_ISBA_n) -! - CALL AVERAGE_DIAG_ISBA_n(ID%O, ID%D, ID%DC, ID%ND, ID%NDC, NP, IO%NPATCH, & - ID%O%LSURF_BUDGETC, IO%LCANOPY, PUREF, PZREF, PSFCO2, PTRAD) -! -! Cumulated diagnostics (stored in MODD_DIAG_EVAP_ISBA_n) -! - CALL AVERAGE_DIAG_EVAP_ISBA_n(ID%O%LSURF_BUDGETC, ID%DE, ID%DEC, ID%NDE, ID%NDEC, NP, & - IO%NPATCH, IO%LGLACIER, IO%LMEB_PATCH, PTSTEP, PRAIN, PSNOW) -! -! Miscellaneous diagnostics (stored in MODD_DIAG_MISC_ISBA_n) -! - CALL AVERAGE_DIAG_MISC_ISBA_n(ID%DM, ID%NDM, IO, NP, NPE) -! -!-------------------------------------------------------------------------------------- -! - CALL COUPLING_SURF_TOPD(ID%DE, ID%DEC, ID%DC, ID%DM, IG, & - IO, S, K, NK, NP, NPE, UG, U, HPROGRAM, U%NDIM_FULL) -! -! -------------------------------------------------------------------------------------- -! Snow/Flood fractions, albedo and emissivity update : -! -------------------------------------------------------------------------------------- -! -! -------------------------------------------------------------------------------------- -! Chemical fluxes : -! -------------------------------------------------------------------------------------- -! -IF (CHI%SVI%NBEQ>0 .AND. CHI%LCH_BIO_FLUX) THEN - IF (TRIM(CHI%CPARAMBVOC)=='SOLMON') & - CALL CH_BVOCEM_n(CHI%SVI, NGB, GB, IO, S, NP, NPE, ZSW_FORBIO, PRHOA, PSFTS) -ENDIF -! -!SOILNOX -IF (CHI%LCH_NO_FLUX) THEN - CALL SOILEMISNO_n(GB, S, K, NP, NPE, PU, PV) -ENDIF -! -!========================================================================================== -! -IF (LHOOK) CALL DR_HOOK('COUPLING_ISBA_N',1,ZHOOK_HANDLE) -CONTAINS -! -!======================================================================================= -SUBROUTINE TREAT_PATCH(KK, PK, PEK, ISSK, AGK, GK, CHIK, DSTK, DK, DCK, DEK, DECK, DMK, GBK ) -! -USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_P_t, ISBA_PE_t -USE MODD_SFX_GRID_n, ONLY : GRID_t -USE MODD_SSO_n, ONLY : SSO_t -USE MODD_AGRI_n, ONLY : AGRI_t -USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t -USE MODD_DST_n, ONLY : DST_t -USE MODD_DIAG_n, ONLY : DIAG_t -USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t -USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t -USE MODD_GR_BIOG_n, ONLY : GR_BIOG_t -! -IMPLICIT NONE -! -TYPE(ISBA_K_t), INTENT(INOUT) :: KK -TYPE(ISBA_P_t), INTENT(INOUT) :: PK -TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK -TYPE(SSO_t), INTENT(INOUT) :: ISSK -TYPE(AGRI_t), INTENT(INOUT) :: AGK -TYPE(GRID_t), INTENT(INOUT) :: GK -TYPE(CH_ISBA_t), INTENT(INOUT) :: CHIK -TYPE(DST_t), INTENT(INOUT) :: DSTK -TYPE(DIAG_t), INTENT(INOUT) :: DK -TYPE(DIAG_t), INTENT(INOUT) :: DCK -TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DEK -TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DECK -TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMK -TYPE(GR_BIOG_t), INTENT(INOUT) :: GBK -! -REAL, DIMENSION(PK%NSIZE_P) :: ZP_ZREF ! height of T,q forcing (m) -REAL, DIMENSION(PK%NSIZE_P) :: ZP_UREF ! height of wind forcing (m) -REAL, DIMENSION(PK%NSIZE_P) :: ZP_U ! zonal wind (m/s) -REAL, DIMENSION(PK%NSIZE_P) :: ZP_V ! meridian wind (m/s) -REAL, DIMENSION(PK%NSIZE_P) :: ZP_WIND ! wind (m/s) -REAL, DIMENSION(PK%NSIZE_P) :: ZP_DIR ! wind direction (rad from N clockwise) -REAL, DIMENSION(PK%NSIZE_P) :: ZP_QA ! air specific humidity forcing (kg/kg) -REAL, DIMENSION(PK%NSIZE_P) :: ZP_TA ! air temperature forcing (K) -REAL, DIMENSION(PK%NSIZE_P) :: ZP_CO2 ! CO2 concentration in the air (kg/kg) -REAL, DIMENSION(PK%NSIZE_P,KSV) :: ZP_SV ! scalar concentration in the air (kg/kg) -REAL, DIMENSION(PK%NSIZE_P) :: ZP_ZENITH ! zenithal angle radian from the vertical) -REAL, DIMENSION(PK%NSIZE_P) :: ZP_PEW_A_COEF ! implicit coefficients -REAL, DIMENSION(PK%NSIZE_P) :: ZP_PEW_B_COEF ! needed if HCOUPLING='I' -REAL, DIMENSION(PK%NSIZE_P) :: ZP_PET_A_COEF -REAL, DIMENSION(PK%NSIZE_P) :: ZP_PET_B_COEF -REAL, DIMENSION(PK%NSIZE_P) :: ZP_PEQ_A_COEF -REAL, DIMENSION(PK%NSIZE_P) :: ZP_PEQ_B_COEF -REAL, DIMENSION(PK%NSIZE_P) :: ZP_RAIN ! liquid precipitation (kg/m2/s) -REAL, DIMENSION(PK%NSIZE_P) :: ZP_SNOW ! snow precipitation (kg/m2/s) -REAL, DIMENSION(PK%NSIZE_P) :: ZP_LW ! longwave radiation (W/m2) -REAL, DIMENSION(PK%NSIZE_P,ISWB) :: ZP_DIR_SW ! direct solar radiation (W/m2) -REAL, DIMENSION(PK%NSIZE_P,ISWB) :: ZP_SCA_SW ! diffuse solar radiation (W/m2) -REAL, DIMENSION(PK%NSIZE_P) :: ZP_PS ! pressure at atmospheric model surface (Pa) -REAL, DIMENSION(PK%NSIZE_P) :: ZP_PA ! pressure at forcing level (Pa) -REAL, DIMENSION(PK%NSIZE_P) :: ZP_ZS ! atmospheric model orography (m) -REAL, DIMENSION(PK%NSIZE_P) :: ZP_SFTQ ! flux of water vapor <w'q'> (kg.m-2.s-1) -REAL, DIMENSION(PK%NSIZE_P) :: ZP_SFTH ! flux of temperature <w'T'> (W/m2) -REAL, DIMENSION(PK%NSIZE_P,KSV) :: ZP_SFTS ! flux of scalar <w'sv'> (mkg/kg/s) -REAL, DIMENSION(PK%NSIZE_P) :: ZP_SFCO2 ! flux of CO2 positive toward the atmosphere (m/s*kg_CO2/kg_air) -REAL, DIMENSION(PK%NSIZE_P) :: ZP_USTAR ! friction velocity (m/s) -REAL, DIMENSION(PK%NSIZE_P) :: ZP_SFU ! zonal momentum flux (pa) -REAL, DIMENSION(PK%NSIZE_P) :: ZP_SFV ! meridian momentum flux (pa) -REAL, DIMENSION(PK%NSIZE_P) :: ZP_TRAD ! radiative temperature (K) -REAL, DIMENSION(PK%NSIZE_P) :: ZP_TSURF ! surface effective temperature (K) -REAL, DIMENSION(PK%NSIZE_P) :: ZP_Z0 ! roughness length for momentum (m) -REAL, DIMENSION(PK%NSIZE_P) :: ZP_Z0H ! roughness length for heat (m) -REAL, DIMENSION(PK%NSIZE_P):: ZP_QSURF ! specific humidity at surface (kg/kg) -REAL, DIMENSION(PK%NSIZE_P) :: ZP_TEMP, ZP_PAR -! -!* other forcing variables (packed for each patch) -! -REAL, DIMENSION(PK%NSIZE_P) :: ZP_RHOA ! lowest atmospheric level air density (kg/m3) -REAL, DIMENSION(PK%NSIZE_P) :: ZP_EXNA ! Exner function at lowest atmospheric level (-) -REAL, DIMENSION(PK%NSIZE_P) :: ZP_EXNS ! Exner function at surface (-) -REAL, DIMENSION(PK%NSIZE_P) :: ZP_ALFA ! Wind direction (-) -! -!* working variables (packed for each patch) -! -REAL, DIMENSION(PK%NSIZE_P) :: ZP_ALBNIR_TVEG ! total vegetation albedo in ir -REAL, DIMENSION(PK%NSIZE_P) :: ZP_ALBNIR_TSOIL ! total soil albedo in ir -REAL, DIMENSION(PK%NSIZE_P) :: ZP_ALBVIS_TVEG ! total vegetation albedo in vis -REAL, DIMENSION(PK%NSIZE_P) :: ZP_ALBVIS_TSOIL ! total soil albedo in vis -REAL, DIMENSION(PK%NSIZE_P) :: ZP_EMIS ! emissivity -REAL, DIMENSION(PK%NSIZE_P) :: ZP_GLOBAL_SW ! global incoming SW rad. -REAL, DIMENSION(PK%NSIZE_P) :: ZP_SLOPE_COS ! typical slope in the grid cosine -! -REAL, DIMENSION(PK%NSIZE_P) :: ZP_Z0FLOOD !Floodplain -REAL, DIMENSION(PK%NSIZE_P) :: ZP_FFGNOS !Floodplain fraction over the ground without snow -REAL, DIMENSION(PK%NSIZE_P) :: ZP_FFVNOS !Floodplain fraction over vegetation without snow -! -REAL, DIMENSION(:,:),ALLOCATABLE :: ZP_PFT -REAL, DIMENSION(:,:),ALLOCATABLE :: ZP_EF -REAL, DIMENSION(:), ALLOCATABLE :: ZP_T24, ZP_PFD24 -INTEGER, DIMENSION(PK%NSIZE_P) :: IP_SLTYP -! -REAL, DIMENSION(PK%NSIZE_P,IO%NNBIOMASS) :: ZP_RESP_BIOMASS_INST ! instantaneous biomass respiration (kgCO2/kgair m/s) -! -!* Aggregated coeffs for evaporative flux calculations -! -REAL, DIMENSION(PK%NSIZE_P) :: ZP_AC_AGG ! aggregated aerodynamic resistance -REAL, DIMENSION(PK%NSIZE_P) :: ZP_HU_AGG ! aggregated relative humidity -! -!* For multi-energy balance -! -REAL, DIMENSION(PK%NSIZE_P) :: ZPALPHAN ! snow/canopy transition coefficient -REAL, DIMENSION(PK%NSIZE_P) :: ZSNOWDEPTH ! total snow depth -REAL, DIMENSION(PK%NSIZE_P) :: ZZ0G_WITHOUT_SNOW ! roughness length for momentum at snow-free canopy floor -REAL, DIMENSION(PK%NSIZE_P) :: ZZ0_MEBV ! roughness length for momentum over MEB vegetation part of patch -REAL, DIMENSION(PK%NSIZE_P) :: ZZ0H_MEBV ! roughness length for heat over MEB vegetation part of path -REAL, DIMENSION(PK%NSIZE_P) :: ZZ0EFF_MEBV ! roughness length for momentum over MEB vegetation part of patch -REAL, DIMENSION(PK%NSIZE_P) :: ZZ0_MEBN ! roughness length for momentum over MEB snow part of patch -REAL, DIMENSION(PK%NSIZE_P) :: ZZ0H_MEBN ! roughness length for heat over MEB snow part of path -REAL, DIMENSION(PK%NSIZE_P) :: ZZ0EFF_MEBN ! roughness length for momentum over MEB snow part of patch -! Temporary -REAL, DIMENSION(PK%NSIZE_P) :: ZP_MEB_SCA_SW ! diffuse incoming SW rad. -! -!* ISBA water and energy budget -! -REAL, DIMENSION(PK%NSIZE_P) :: ZP_WG_INI -REAL, DIMENSION(PK%NSIZE_P) :: ZP_WGI_INI -REAL, DIMENSION(PK%NSIZE_P) :: ZP_WR_INI -REAL, DIMENSION(PK%NSIZE_P) :: ZP_SWE_INI -! -REAL, DIMENSION(PK%NSIZE_P) :: ZP_RNSHADE -REAL, DIMENSION(PK%NSIZE_P) :: ZP_RNSUNLIT -! -! miscellaneous -! -REAL, DIMENSION(PK%NSIZE_P) :: ZP_DEEP_FLUX ! Flux at the bottom of the soil -REAL, DIMENSION(PK%NSIZE_P) :: ZP_TDEEP_A ! coefficient for implicitation of Tdeep -REAL, DIMENSION(PK%NSIZE_P) :: ZIRRIG_GR ! green roof ground irrigation rate -! -! For multi-energy balance -LOGICAL :: GMEB ! True if multi-energy balance should be used for the specific patch -! -INTEGER :: JJ, JI, JK -REAL(KIND=JPRB) :: ZHOOK_HANDLE -! -IF (LHOOK) CALL DR_HOOK('COUPLING_ISBA_n:TREAT_PATCH',0,ZHOOK_HANDLE) -! -IF (ASSOCIATED(MGN%XPFT)) THEN - ALLOCATE(ZP_PFT(SIZE(MGN%XPFT,1),PK%NSIZE_P)) -ELSE - ALLOCATE(ZP_PFT(0,0)) -ENDIF -IF (ASSOCIATED(MGN%XEF)) THEN - ALLOCATE(ZP_EF(SIZE(MGN%XEF,1),PK%NSIZE_P)) -ELSE - ALLOCATE(ZP_EF(0,0)) -ENDIF -IF (ASSOCIATED(MGN%XPPFD24)) THEN - ALLOCATE(ZP_PFD24(PK%NSIZE_P)) -ELSE - ALLOCATE(ZP_PFD24(0)) -ENDIF -IF (ASSOCIATED(MGN%XT24)) THEN - ALLOCATE(ZP_T24(PK%NSIZE_P)) -ELSE - ALLOCATE(ZP_T24(0)) -ENDIF -!-------------------------------------------------------------------------------------- -! -! Pack isba forcing outputs -! -IF (IO%NPATCH==1) THEN - ZP_ZENITH(:) = PZENITH (:) - ZP_ZREF(:) = PZREF (:) - ZP_UREF(:) = PUREF (:) - ZP_WIND(:) = ZWIND (:) - ZP_U(:) = PU (:) - ZP_V(:) = PV (:) - ZP_DIR(:) = ZDIR (:) - ZP_QA(:) = ZQA (:) - ZP_TA(:) = PTA (:) - ZP_CO2(:) = ZCO2 (:) - ZP_SV(:,:) = PSV (:,:) - ZP_PEW_A_COEF(:) = PPEW_A_COEF (:) - ZP_PEW_B_COEF(:) = PPEW_B_COEF (:) - ZP_PET_A_COEF(:) = PPET_A_COEF (:) - ZP_PET_B_COEF(:) = PPET_B_COEF (:) - ZP_PEQ_A_COEF(:) = ZPEQ_A_COEF (:) - ZP_PEQ_B_COEF(:) = ZPEQ_B_COEF (:) - ZP_RAIN(:) = PRAIN (:) - ZP_SNOW(:) = PSNOW (:) - ZP_LW(:) = PLW (:) - ZP_DIR_SW(:,:) = PDIR_SW (:,:) - ZP_SCA_SW(:,:) = PSCA_SW (:,:) - ZP_PS(:) = PPS (:) - ZP_PA(:) = PPA (:) - ZP_ZS(:) = PZS (:) -! - ZP_RHOA(:) = PRHOA (:) - ZP_EXNA(:) = ZEXNA (:) - ZP_EXNS(:) = ZEXNS (:) - ZP_ALFA(:) = ZALFA (:) - - IF ((TRIM(CHI%CPARAMBVOC) == 'MEGAN') .AND. CHI%LCH_BIO_FLUX) THEN - ZP_PFT(:,:) = MGN%XPFT (:,:) - ZP_EF(:,:) = MGN%XEF (:,:) - IP_SLTYP(:) = MGN%NSLTYP (:) - ZP_PFD24(:) = MGN%XPPFD24 (:) - ZP_T24(:) = MGN%XT24 (:) - END IF - - ZP_RNSHADE(:) = ZRNSHADE (:) - ZP_RNSUNLIT(:) = ZRNSUNLIT (:) - -ELSE -!cdir nodep -!cdir unroll=8 - DO JJ=1,PK%NSIZE_P - JI = PK%NR_P(JJ) - ZP_ZENITH(JJ) = PZENITH (JI) - ZP_ZREF(JJ) = PZREF (JI) - ZP_UREF(JJ) = PUREF (JI) - ZP_WIND(JJ) = ZWIND (JI) - ZP_U(JJ) = PU (JI) - ZP_V(JJ) = PV (JI) - ZP_DIR(JJ) = ZDIR (JI) - ZP_QA(JJ) = ZQA (JI) - ZP_TA(JJ) = PTA (JI) - ZP_CO2(JJ) = ZCO2 (JI) - ZP_PEW_A_COEF(JJ) = PPEW_A_COEF (JI) - ZP_PEW_B_COEF(JJ) = PPEW_B_COEF (JI) - ZP_PET_A_COEF(JJ) = PPET_A_COEF (JI) - ZP_PET_B_COEF(JJ) = PPET_B_COEF (JI) - ZP_PEQ_A_COEF(JJ) = ZPEQ_A_COEF (JI) - ZP_PEQ_B_COEF(JJ) = ZPEQ_B_COEF (JI) - ZP_RAIN(JJ) = PRAIN (JI) - ZP_SNOW(JJ) = PSNOW (JI) - ZP_LW(JJ) = PLW (JI) - ZP_PS(JJ) = PPS (JI) - ZP_PA(JJ) = PPA (JI) - ZP_ZS(JJ) = PZS (JI) -! - ZP_RHOA(JJ) = PRHOA (JI) - ZP_EXNA(JJ) = ZEXNA (JI) - ZP_EXNS(JJ) = ZEXNS (JI) - ZP_ALFA(JJ) = ZALFA (JI) - ENDDO -! - DO JK=1,KSV -!cdir nodep -!cdir unroll=8 - DO JJ=1,PK%NSIZE_P - JI=PK%NR_P(JJ) - ZP_SV(JJ,JK) = PSV(JI,JK) - ENDDO - ENDDO -! - DO JK=1,SIZE(PDIR_SW,2) -!cdir nodep -!cdir unroll=8 - DO JJ=1,PK%NSIZE_P - JI=PK%NR_P(JJ) - ZP_DIR_SW(JJ,JK) = PDIR_SW (JI,JK) - ZP_SCA_SW(JJ,JK) = PSCA_SW (JI,JK) - ENDDO - ENDDO -! - IF ((TRIM(CHI%CPARAMBVOC) == 'MEGAN') .AND. CHI%LCH_BIO_FLUX) THEN - DO JJ=1,PK%NSIZE_P - JI=PK%NR_P(JJ) - ZP_PFT(:,JJ) = MGN%XPFT (:,JI) - ZP_EF(:,JJ) = MGN%XEF (:,JI) - IP_SLTYP(JJ) = MGN%NSLTYP (JI) - ZP_PFD24(JJ) = MGN%XPPFD24 (JI) - ZP_T24(JJ) = MGN%XT24 (JI) - ENDDO - END IF - DO JJ=1,PK%NSIZE_P - JI=PK%NR_P(JJ) - ZP_RNSHADE(JJ) = ZRNSHADE (JI) - ZP_RNSUNLIT(JJ) = ZRNSUNLIT(JI) - ENDDO - -ENDIF -! -!-------------------------------------------------------------------------------------- -! -! For multi-energy balance -GMEB = IO%LMEB_PATCH(JP) -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Cosine of the slope typically encoutered in the grid mesh (including subgrid orography) -! and orientation of this slope -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! -ZP_SLOPE_COS(:) = 1./SQRT(1.+ISSK%XSSO_SLOPE(:)**2) -IF(LNOSOF) ZP_SLOPE_COS(:) = 1.0 -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Snow fractions -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! now caculated at the initialization and at the end of the time step -! (see update_frac_alb_emis_isban.f90) in order to close the energy budget -! between surfex and the atmosphere. This fact do not change the offline runs. -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Blowing snow scheme -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -IF(CHI%SVI%NSNWEQ>0.) THEN - ZP_BLOWSNW_CONC(:,:) = ZP_SV(:,CHI%SVI%NSV_SNWBEG:CHI%SVI%NSV_SNWEND) - ZP_BLOWSNW_FLUX(:,:) = ZP_SV(:,CHI%SVI%N2D_SNWBEG:CHI%SVI%N2D_SNWEND) -! ZP_BLOWSNW_FLUX IN : fluxes sent from Canopy: -! [1] number sedim. flux (#/m2/s) -! [2] mass sedim flux (kg{snow}/m2/s) -! [3] contrib. saltation (kg{snow}/m2/s) -! OUT : fluxes towards Canopy: -! [1] number turbulent flux (#/m2/s) -! [2] mass turbulent flux (kg{snow}/m2/s) -! [3] updated streamwise saltation flux (kg{snow}/m2/s) -ELSE - ZP_BLOWSNW_CONC(:,:) = XUNDEF - ZP_BLOWSNW_FLUX(:,:) = XUNDEF -END IF -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! No implicitation of Tdeep -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -ZP_TDEEP_A = 0. -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Flood properties -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! -IF(IO%LFLOOD)THEN - CALL ISBA_FLOOD_PROPERTIES(PEK%XLAI, KK%XFFLOOD, KK%XFFROZEN, ZP_Z0FLOOD, ZP_FFGNOS, ZP_FFVNOS) -ELSE - ZP_Z0FLOOD = XUNDEF - ZP_FFGNOS = 0.0 - ZP_FFVNOS = 0.0 -ENDIF -! -! For multi-energy balance - IF(GMEB)THEN - ZSNOWDEPTH(:) = SUM(PEK%TSNOW%WSNOW(:,:)/PEK%TSNOW%RHO(:,:),2) - ZPALPHAN (:) =MEBPALPHAN(ZSNOWDEPTH,PEK%XH_VEG(:)) - ENDIF -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Surface Roughness lengths (m): -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! -!* effective roughness -! - CALL Z0EFF(PEK%TSNOW%SCHEME, GMEB, ZP_ALFA, ZP_ZREF, ZP_UREF, & - PEK%XZ0, ISSK%XZ0REL, PEK%XPSN, ZPALPHAN, PEK%XZ0LITTER, & - PEK%TSNOW%WSNOW(:,1), ISSK, KK%XFF, ZP_Z0FLOOD, PK%XZ0_O_Z0H, & - DK%XZ0, DK%XZ0H, DK%XZ0EFF, ZZ0G_WITHOUT_SNOW, & - ZZ0_MEBV, ZZ0H_MEBV, ZZ0EFF_MEBV, ZZ0_MEBN, ZZ0H_MEBN, ZZ0EFF_MEBN ) -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Shortwave computations for outputs (albedo for radiative scheme) -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! now caculated at the initialization and at the end of the time step -! (see update_frac_alb_emis_isban.f90) in order to close the energy budget -! between surfex and the atmosphere. This fact do not change the offline runs. -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Shortwave computations for ISBA inputs (global snow-free albedo) -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! -! ISBA needs global incoming solar radiation: it currently does -! not distinguish between the scattered and direct components, -! or between different wavelengths. -! -! -!* Snow-free surface albedo for each wavelength -! - CALL ISBA_ALBEDO(PEK, IO%LTR_ML, GMEB, ZP_DIR_SW, ZP_SCA_SW, & - PSW_BANDS, ISWB, KK%XALBF, KK%XFFV, KK%XFFG, ZP_GLOBAL_SW, & - ZP_MEB_SCA_SW, ZP_ALBNIR_TVEG, ZP_ALBVIS_TVEG, & - ZP_ALBNIR_TSOIL, ZP_ALBVIS_TSOIL ) -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Intialize computation of ISBA water and energy budget -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! - CALL ISBA_BUDGET_INIT(ID%DE%LWATER_BUDGET, IO%CISBA, PEK, PK%XDG, PK%XDZG, & - ZP_WG_INI, ZP_WGI_INI, ZP_WR_INI, ZP_SWE_INI ) -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Over Natural Land Surfaces: -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -ZIRRIG_GR(:)= 0. -! - CALL ISBA(IO, KK, PK, PEK, GK, AGK, DK, DEK, DMK, & - S%TTIME, S%XPOI, S%XABC, GBK%XIACAN, GMEB, PTSTEP, CIMPLICIT_WIND, & - ZP_ZREF, ZP_UREF, ZP_SLOPE_COS, ZP_TA, ZP_QA, ZP_EXNA, ZP_RHOA, & - ZP_PS, ZP_EXNS, ZP_RAIN, ZP_SNOW, ZP_ZENITH, ZP_MEB_SCA_SW, ZP_GLOBAL_SW, ZP_LW, & - ZP_WIND, ZP_PEW_A_COEF, ZP_PEW_B_COEF, ZP_PET_A_COEF, ZP_PEQ_A_COEF, & - ZP_PET_B_COEF, ZP_PEQ_B_COEF, ZP_ALBNIR_TVEG, ZP_ALBVIS_TVEG, ZP_ALBNIR_TSOIL, & - ZP_ALBVIS_TSOIL, ZPALPHAN, ZZ0G_WITHOUT_SNOW, ZZ0_MEBV, ZZ0H_MEBV, ZZ0EFF_MEBV, & - ZZ0_MEBN, ZZ0H_MEBN, ZZ0EFF_MEBN, ZP_TDEEP_A, ZP_CO2, ZP_FFGNOS, ZP_FFVNOS, & - ZP_EMIS, ZP_USTAR, ZP_AC_AGG, ZP_HU_AGG, ZP_RESP_BIOMASS_INST, ZP_DEEP_FLUX, & - ZIRRIG_GR, ZP_RNSHADE, ZP_RNSUNLIT, ZP_BLOWSNW_FLUX, ZP_BLOWSNW_CONC ) -! -ZP_TRAD = DK%XTSRAD -DK%XLE = PEK%XLE -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Glacier : ice runoff flux (especally for Earth System Model) -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! -IF(IO%LGLACIER) CALL HYDRO_GLACIER(PTSTEP, ZP_SNOW, PEK, DEK%XICEFLUX) -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Calculation of ISBA water and energy budget (and time tendencies of each reservoir) -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! -CALL ISBA_BUDGET(IO, PK, PEK, DEK, ID%DE%LWATER_BUDGET, PTSTEP, ZP_WG_INI, ZP_WGI_INI, & - ZP_WR_INI, ZP_SWE_INI, ZP_RAIN, ZP_SNOW, DK%XEVAP ) -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Evolution of soil albedo, when depending on surface soil wetness: -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! -IF (IO%CALBEDO=='EVOL' .AND. IO%LECOCLIMAP) THEN - CALL SOIL_ALBEDO(IO%CALBEDO, KK%XWSAT(:,1),PEK%XWG(:,1), KK, PEK, "ALL") - ! - CALL ALBEDO(IO%CALBEDO, PEK ) -END IF -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Vegetation evolution for interactive LAI -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! -IF (IO%CPHOTO=='NIT' .OR. IO%CPHOTO=='NCB') THEN - CALL VEGETATION_EVOL(IO, DTI, PK, PEK, LAGRIP, PTSTEP, KMONTH, KDAY, PTIME, GK%XLAT, & - ZP_RHOA, ZP_CO2, ISSK, ZP_RESP_BIOMASS_INST, & - ! add optional for accurate dependency to nitrogen - ! limitation - PSWDIR=ZP_GLOBAL_SW ) -END IF -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Diagnostic of respiration carbon fluxes and soil carbon evolution -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -!ii -ZP_SFCO2 (:) = 0. -DEK%XRESP_ECO (:) = 0. -DEK%XRESP_AUTO(:) = 0. -! -IF ( IO%CPHOTO/='NON' .AND. IO%CRESPSL/='NON' .AND. ANY(PEK%XLAI(:)/=XUNDEF) ) THEN - CALL CARBON_EVOL(IO, KK, PK, PEK, DEK, PTSTEP, ZP_RHOA, ZP_RESP_BIOMASS_INST ) - ! calculation of vegetation CO2 flux - ! Positive toward the atmosphere - ZP_SFCO2(:) = DEK%XRESP_ECO(:) - DEK%XGPP(:) -END IF -! -IF ( IO%CPHOTO/='NON') THEN - DEK%XGPP(:) = DEK%XGPP(:) * ZP_RHOA(:) - DEK%XRESP_ECO(:) = DEK%XRESP_ECO(:) * ZP_RHOA(:) - DEK%XRESP_AUTO(:) = DEK%XRESP_AUTO(:) * ZP_RHOA(:) -ENDIF -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Reset effecitve roughness lentgh to its nominal value when snow has just disappeared -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! - CALL SUBSCALE_Z0EFF(ISSK,PEK%XZ0(:),.FALSE.,OMASK=(PEK%TSNOW%WSNOW(:,1)==0. .AND. PEK%XPSN(:)>0.) ) -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Turbulent fluxes -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! -ZP_SFTH(:) = DK%XH(:) -ZP_SFTQ(:) = DK%XEVAP(:) - -ZP_SFU (:) = 0. -ZP_SFV (:) = 0. -WHERE (ZP_WIND>0.) - ZP_SFU (:) = - ZP_U(:)/ZP_WIND(:) * ZP_USTAR(:)**2 * ZP_RHOA(:) - ZP_SFV (:) = - ZP_V(:)/ZP_WIND(:) * ZP_USTAR(:)**2 * ZP_RHOA(:) -END WHERE -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Scalar fluxes -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! -ZP_SFTS(:,:) = 0. -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Blowing snow scheme -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -IF(CHI%SVI%NSNWEQ>0) THEN -! Store emitted turbulent flux 1: number (#/m2/s); 2: mass (kg/m2/s) - ZP_SFTS(:,CHI%SVI%NSV_SNWBEG:CHI%SVI%NSV_SNWEND) = ZP_BLOWSNW_FLUX(:,1:CHI%SVI%NSNWEQ) -! Store streamwise saltation flux (kg/m/s) - ZP_SFTS(:,CHI%SVI%N2D_SNWEND) = ZP_BLOWSNW_FLUX(:,CHI%SVI%NSNWEQ+1) -END IF -! -------------------------------------------------------------------------------------- -! Chemical dry deposition : -! -------------------------------------------------------------------------------------- -IF (CHI%SVI%NBEQ>0) THEN - ZP_SFTS(:,CHI%SVI%NSV_CHSBEG:CHI%SVI%NSV_CHSEND) = 0. - ZP_SFTS(:,CHI%SVI%NSV_AERBEG:CHI%SVI%NSV_AEREND) = 0. - IF( CHI%CCH_DRY_DEP == "WES89") THEN - - IBEG = CHI%SVI%NSV_CHSBEG - IEND = CHI%SVI%NSV_CHSEND - ISIZE = IEND - IBEG + 1 - - IF (ANY(PEK%XLAI(:)/=XUNDEF) ) THEN - CALL CH_DEP_ISBA(KK, PK, PEK, DK, DMK, CHIK, & - ZP_USTAR, ZP_TA, ZP_PA, ZP_TRAD(:), ISIZE ) - - ZP_SFTS(:,IBEG:IEND) = - ZP_SV(:,IBEG:IEND) * CHIK%XDEP(:,1:CHI%SVI%NBEQ) - - IF (CHI%SVI%NAEREQ > 0 ) THEN - - IBEG = CHI%SVI%NSV_AERBEG - IEND = CHI%SVI%NSV_AEREND - CALL CH_AER_DEP(ZP_SV(:,IBEG:IEND), ZP_SFTS(:,IBEG:IEND), ZP_USTAR, PEK%XRESA, ZP_TA, ZP_RHOA) - END IF - ENDIF - - ELSE - - IBEG = CHI%SVI%NSV_AERBEG - IEND = CHI%SVI%NSV_AEREND - ZP_SFTS(:,IBEG:IEND) = 0. - ZP_SFTS(:,IBEG:IEND) = 0. - - ENDIF -ENDIF -! -! -------------------------------------------------------------------------------------- -! Chemical natural flux (BVOC, NOx) from MEGAN: -! -------------------------------------------------------------------------------------- -IF (CHI%SVI%NBEQ>0 .AND. CHI%LCH_BIO_FLUX) THEN - IF ((TRIM(CHI%CPARAMBVOC) == 'MEGAN').AND.(ANY(PEK%XLAI(:)/=XUNDEF))) THEN - -!UPG*PT - WHERE (GBK%XIACAN > 2000.) ! non physical values - GBK%XIACAN = 0. - END WHERE -!UPG*PT - IBEG = CHI%SVI%NSV_CHSBEG - IEND = CHI%SVI%NSV_CHSEND - - CALL COUPLING_MEGAN_n(MGN, CHI, GK, PEK, PTSTEP, & - KYEAR, KMONTH, KDAY, PTIME, S%TTIME%TIME, IO%LTR_ML, & - IP_SLTYP, ZP_PFT, ZP_EF, ZP_PFD24, ZP_T24, & - ZP_TA, GBK%XIACAN, ZP_TRAD, ZP_RNSUNLIT, ZP_RNSHADE, & - ZP_WIND, ZP_PA, ZP_QA, ZP_SFTS(:,IBEG:IEND)) - - END IF -ENDIF -! -------------------------------------------------------------------------------------- -! Dust deposition and emission: -! -------------------------------------------------------------------------------------- -! -IF(CHI%SVI%NDSTEQ>0)THEN - - IBEG = CHI%SVI%NSV_DSTBEG - IEND = CHI%SVI%NSV_DSTEND - IDST = IEND - IBEG + 1 - - CALL COUPLING_DST_n(DSTK, KK, PK, PEK, DK, & - HPROGRAM, &!I [char] Name of program - PK%NSIZE_P, &!I [nbr] number of points in patch - IDST, &!I [nbr] number of dust emissions variables - ZP_PS, &!I [Pa] surface pressure - ZP_QA, &!I [kg/kg] specific humidity - ZP_RHOA, &!I [kg/m3] atmospheric density - ZP_PA, &!I [K] Atmospheric pressure - ZP_TA, &!I [K] Atmospheric temperature - ZP_U, &!I [m/s] zonal wind at atmospheric height - ZP_UREF, &!I [m] reference height of wind - ZP_V, &!I [m/s] meridional wind at atmospheric height - ZP_ZREF, &!I [m] reference height of wind - ZP_SFTS(:,IBEG:IEND) &!O [kg/m2/sec] flux of dust - ) -! - IF (CHI%SVI%NSV_AEREND > 0) THEN ! case of dust/ anthropogenic aerosols coupling - - DO JMODE=1,NDSTMDE - ! - !Make index which is 0 for first mode, 3 for second, 6 for third etc - IF (LVARSIG_DST) THEN - JSV_IDX = (JMODE-1)*3 - ELSE IF (LRGFIX_DST) THEN - JSV_IDX = JMODE-2 - ELSE - JSV_IDX = (JMODE-1)*2 - END IF - ! - DO JSV=1, size(HSV) - IF ((TRIM(HSV(JSV)) == "@DSTI").AND.(JMODE==3)) THEN - ! add dust flux and conversion kg/m2/s into molec.m2/s - ZP_SFTS(:,JSV) = ZP_SFTS(:,JSV) + ZP_SFTS(:,IBEG-1+JSV_IDX+2)*XAVOGADRO/XMOLARWEIGHT_DST - END IF - IF ( (TRIM(HSV(JSV)) == "@DSTJ").AND.(JMODE==2)) THEN - ! add dust flux and conversion kg/m2/sec into molec.m2/s - ZP_SFTS(:,JSV) = ZP_SFTS(:,JSV) + ZP_SFTS(:,IBEG-1+JSV_IDX+2)*XAVOGADRO/XMOLARWEIGHT_DST - END IF - END DO - ! - END DO - END IF -! -!Modify fluxes due to dry deposition, we introduce a negative flux where dust is lost - CALL DSLT_DEP(ZP_SV(:,IBEG:IEND), ZP_SFTS(:,IBEG:IEND), ZP_USTAR, PEK%XRESA, & - ZP_TA, ZP_RHOA, DSTK%XEMISSIG_DST, DSTK%XEMISRADIUS_DST, JPMODE_DST, & - XDENSITY_DST, XMOLARWEIGHT_DST, ZCONVERTFACM0_DST, ZCONVERTFACM6_DST, & - ZCONVERTFACM3_DST, LVARSIG_DST, LRGFIX_DST, CVERMOD ) -! -!Transfer these fluxes to fluxes understandable by all moments - CALL MASSFLUX2MOMENTFLUX( & - ZP_SFTS(:,IBEG:IEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments - ZP_RHOA, & !I [kg/m3] air density - DSTK%XEMISRADIUS_DST, & !I [um] emitted radius for the modes (max 3) - DSTK%XEMISSIG_DST, & !I [-] emitted sigma for the different modes (max 3) - NDSTMDE, & - ZCONVERTFACM0_DST, & - ZCONVERTFACM6_DST, & - ZCONVERTFACM3_DST, & - LVARSIG_DST, LRGFIX_DST ) -! -ENDIF !Check on CDSTYN -! -! -------------------------------------------------------------------------------------- -! Sea Salt deposition -! -------------------------------------------------------------------------------------- -! -IF (CHI%SVI%NSLTEQ>0) THEN - ! - IBEG = CHI%SVI%NSV_SLTBEG - IEND = CHI%SVI%NSV_SLTEND - ! - CALL DSLT_DEP(ZP_SV(:,IBEG:IEND), ZP_SFTS(:,IBEG:IEND), ZP_USTAR, PEK%XRESA, & - ZP_TA, ZP_RHOA, SLT%XEMISSIG_SLT, SLT%XEMISRADIUS_SLT, JPMODE_SLT, & - XDENSITY_SLT, XMOLARWEIGHT_SLT, ZCONVERTFACM0_SLT, ZCONVERTFACM6_SLT, & - ZCONVERTFACM3_SLT, LVARSIG_SLT, LRGFIX_SLT, CVERMOD ) - - CALL MASSFLUX2MOMENTFLUX( & - ZP_SFTS(:,IBEG:IEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments - ZP_RHOA, & !I [kg/m3] air density - SLT%XEMISRADIUS_SLT, & !I [um] emitted radius for the modes (max 3) - SLT%XEMISSIG_SLT, & !I [-] emitted sigma for the different modes (max 3) - NSLTMDE, & - ZCONVERTFACM0_SLT, & - ZCONVERTFACM6_SLT, & - ZCONVERTFACM3_SLT, & - LVARSIG_SLT, LRGFIX_SLT ) -ENDIF !Check on CSLTYN -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Inline diagnostics -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! - CALL DIAG_INLINE_ISBA_n(ID%O, KK, DK, IO%LCANOPY, ZP_TA, ZP_QA, ZP_PA, & - ZP_PS, ZP_RHOA, ZP_U, ZP_V, ZP_ZREF, ZP_UREF, ZP_SFTH, & - ZP_SFTQ, ZP_SFU, ZP_SFV, ZP_DIR_SW, ZP_SCA_SW, ZP_LW ) -! -! -!------------------------------------------------------------------------------- -!Physical properties see by the atmosphere in order to close the energy budget -!between surfex and the atmosphere. All variables should be at t+1 but very -!difficult to do. Maybe it will be done later. However, Ts can be at time t+1 -!------------------------------------------------------------------------------- -! -ZP_TSURF (:) = DK%XTS (:) -ZP_Z0 (:) = DK%XZ0 (:) -ZP_Z0H (:) = DK%XZ0H(:) -ZP_QSURF (:) = DK%XQS (:) -! -!------------------------------------------------------------------------------- -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Isba offline diagnostics for each patch -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! - CALL DIAG_EVAP_CUMUL_ISBA_n(ID%O%LSURF_BUDGETC, ID%DE, DECK, DCK, DEK, DK, PEK, & - IO, PTSTEP, PK%NSIZE_P, JP, ZP_RHOA) -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Isba offline diagnostics for miscellaneous terms over each patch -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! - CALL DIAG_MISC_ISBA_n(DMK, KK, PK, PEK, AGK, IO, ID%DM%LSURF_MISC_BUDGET, & - ID%DM%LVOLUMETRIC_SNOWLIQ, PTSTEP, LAGRIP, PTIME, PK%NSIZE_P ) -! - CALL REPROJ_DIAG_ISBA_n(DK, DEK, DMK, PEK, ID%O%LSURF_BUDGET, ID%DE%LSURF_EVAP_BUDGET, & - ID%DE%LWATER_BUDGET, ID%DM%LSURF_MISC_BUDGET, ID%DM%LPROSNOW, & - IO%LMEB_PATCH(JP), ZP_SLOPE_COS) -! -! Unpack ISBA diagnostics (modd_diag_isban) for each patch:ISIZE_MAX = MAXVAL(NSIZE_NATURE_P) - -! (MUST be done BEFORE UNPACK_ISBA_PATCH, because of XP_LE) -! -IF (PEK%TSNOW%SCHEME=='3-L'.OR.PEK%TSNOW%SCHEME=='CRO') THEN - PEK%TSNOW%TEMP(:,:) = DMK%XSNOWTEMP(:,:) - PEK%TSNOW%TS (:) = DMK%XSNOWTEMP(:,1) -ENDIF -! - - CALL UNPACK_DIAG_PATCH_n(IO, DEK, PK, PK%NR_P, PK%NSIZE_P, IO%NPATCH, JP, & - ZCPL_DRAIN, ZCPL_RUNOFF, ZCPL_EFLOOD, ZCPL_PFLOOD, & - ZCPL_IFLOOD, ZCPL_ICEFLUX) -! -!---------------------------------------------------------------------- -! -! for further chemical biogenic emissions -! -IF (CHI%SVI%NBEQ>0 .AND. CHI%LCH_BIO_FLUX) THEN - ! - DO JJ=1,PK%NSIZE_P - ZSW_FORBIO(PK%NR_P(JJ),JP) = 0. - ENDDO - ! - DO JSWB=1,ISWB -!cdir nodep -!cdir unroll=8 - DO JJ=1,PK%NSIZE_P - ZSW_FORBIO(PK%NR_P(JJ),JP) = ZSW_FORBIO(PK%NR_P(JJ),JP) + ZP_DIR_SW(JJ,JSWB) + ZP_SCA_SW(JJ,JSWB) - ENDDO - ENDDO - ! -ENDIF -!---------------------------------------------------------------------- -! -! Unpack output dummy arguments for each patch: -! -IF (IO%NPATCH==1) THEN - ZSFTQ_TILE (:,JP) = ZP_SFTQ (:) - ZSFTH_TILE (:,JP) = ZP_SFTH (:) - ZSFTS_TILE (:,:,JP)= ZP_SFTS (:,:) - ZSFCO2_TILE (:,JP) = ZP_SFCO2 (:) - ZSFU_TILE (:,JP) = ZP_SFU (:) - ZSFV_TILE (:,JP) = ZP_SFV (:) - ZTRAD_TILE (:,JP) = ZP_TRAD (:) - ZTSURF_TILE (:,JP) = ZP_TSURF (:) - ZZ0_TILE (:,JP) = ZP_Z0 (:) - ZZ0H_TILE (:,JP) = ZP_Z0H (:) - ZQSURF_TILE (:,JP) = ZP_QSURF (:) -ELSE -!cdir nodep -!cdir unroll=8 - DO JJ=1,PK%NSIZE_P - JI = PK%NR_P(JJ) - ZSFTQ_TILE (JI,JP) = ZP_SFTQ (JJ) - ZSFTH_TILE (JI,JP) = ZP_SFTH (JJ) - ZSFCO2_TILE (JI,JP) = ZP_SFCO2 (JJ) - ZSFU_TILE (JI,JP) = ZP_SFU (JJ) - ZSFV_TILE (JI,JP) = ZP_SFV (JJ) - ZTRAD_TILE (JI,JP) = ZP_TRAD (JJ) - ZTSURF_TILE (JI,JP) = ZP_TSURF (JJ) - ZZ0_TILE (JI,JP) = ZP_Z0 (JJ) - ZZ0H_TILE (JI,JP) = ZP_Z0H (JJ) - ZQSURF_TILE (JI,JP) = ZP_QSURF (JJ) - ENDDO -! -!cdir nodep -!cdir unroll=8 - DO JK=1,SIZE(ZP_SFTS,2) - DO JJ=1,PK%NSIZE_P - JI=PK%NR_P(JJ) - ZSFTS_TILE (JI,JK,JP)= ZP_SFTS (JJ,JK) - ENDDO - ENDDO -ENDIF -! -!---------------------------------------------------------------------- -! -! Get output dust flux if we are calculating dust -IF (NDSTMDE .GE. 1) IMOMENT = INT(IDST / NDSTMDE) -IF (CHI%SVI%NDSTEQ>0) THEN - DO JSV = 1,NDSTMDE - IF (IMOMENT == 1) THEN - DSTK%XSFDST(:,JSV) = ZSFTS_TILE(:,NDST_MDEBEG+JSV-1,JP) - ELSE - DSTK%XSFDST(:,JSV) = ZSFTS_TILE(PK%NR_P,NDST_MDEBEG+(JSV-1)*IMOMENT+1,JP) - END IF - - DSTK%XSFDSTM(:,JSV) = DSTK%XSFDSTM(:,JSV) + DSTK%XSFDST(:,JSV) * PTSTEP - ENDDO -ENDIF -! -IF (LHOOK) CALL DR_HOOK('COUPLING_ISBA_n:TREAT_PATCH',1,ZHOOK_HANDLE) -! -END SUBROUTINE TREAT_PATCH -!========================================================================================== -END SUBROUTINE COUPLING_ISBA_n diff --git a/src/ICCARE_BASE/coupling_megann.F90 b/src/ICCARE_BASE/coupling_megann.F90 deleted file mode 100644 index 11b5991bb..000000000 --- a/src/ICCARE_BASE/coupling_megann.F90 +++ /dev/null @@ -1,247 +0,0 @@ -!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -! ############################### - SUBROUTINE COUPLING_MEGAN_n(MGN, CHI, GK, PEK, PTSTEP, & - KYEAR, KMONTH, KDAY, PTIME, PTIME2, OTR_ML, & - KSLTYP, PPFT, PEF, PPFD24, PT24, & - PTEMP, PIACAN, PLEAFT, PRN_SUNLIT, PRN_SHADE, & - PWIND, PPRES, PQV, PSFTS) -! ############################### -!! -!!*** *BVOCEM* -!! -!! PURPOSE -!! ------- -!! Calculate the biogenic emission fluxes upon the MEGAN code -!! http://lar.wsu.edu/megan/ -!! -!! METHOD -!! ------ -!! -!! -!! AUTHOR -!! ------ -!! P. Tulet (LACy) -!! -!! MODIFICATIONS -!! ------------- -!! Original: 25/10/2014 -!! Modified: 06/07/2017, J. Pianezze, adaptation for SurfEx v8.0 -!! Modified: 06/07/2018, P. Tulet, correction for T leaf -!! Modified: 06/02/2021, S. Oumami, off-line & daily averages use -!! -!! EXTERNAL -!! -------- -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -! -USE MODD_MEGAN_n, ONLY : MEGAN_t -USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t -USE MODD_ISBA_n, ONLY: ISBA_PE_t -USE MODD_SFX_GRID_n, ONLY: GRID_t -! -USE MODD_CSTS, ONLY : XAVOGADRO, XDAY -! -#ifdef MNH_MEGAN -USE MODD_MEGAN -USE MODI_JULIAN -USE MODI_EMPROC -USE MODI_MGN2MECH -#endif -! -!------------------------------------------------------------------------------ -! -!* 0. DECLARATIONS -! ----------------- -! -IMPLICIT NONE -! -TYPE(MEGAN_t), INTENT(INOUT) :: MGN -TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI -TYPE(GRID_t), INTENT(INOUT) :: GK -TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK -! -!* 0.1 declaration of arguments -! -INTEGER, INTENT(IN) :: KYEAR ! I current year (UTC) -INTEGER, INTENT(IN) :: KMONTH ! I current month (UTC) -INTEGER, INTENT(IN) :: KDAY ! I current day (UTC) -REAL, INTENT(IN) :: PTIME ! I current time since midnight (UTC, s) -REAL, INTENT(IN) :: PTIME2 ! Time since simulation begin (s) -LOGICAL, INTENT(IN) :: OTR_ML ! new radiation for leaves temperatures -REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step (s) -! -REAL, DIMENSION(:), INTENT(IN) :: PTEMP ! I Air temperature (K) -REAL, DIMENSION(:,:),INTENT(IN) :: PIACAN ! I PAR (W/m2) -REAL, DIMENSION(:), INTENT(IN) :: PLEAFT ! I Leaf temperature (K) -REAL, DIMENSION(:), INTENT(IN) :: PRN_SUNLIT! I Leaf RN -REAL, DIMENSION(:), INTENT(IN) :: PRN_SHADE ! I Leaf RN -REAL, DIMENSION(:), INTENT(INOUT) :: PPFD24 -REAL, DIMENSION(:), INTENT(INOUT) :: PT24 -REAL, DIMENSION(:), INTENT(IN) :: PWIND -REAL, DIMENSION(:), INTENT(IN) :: PPRES ! I Atmospheric pressure (Pa) -REAL, DIMENSION(:), INTENT(IN) :: PQV ! I Air humidity (kg/kg) -REAL, DIMENSION(:,:),INTENT(IN) :: PPFT, PEF -INTEGER, DIMENSION(:), INTENT(IN) :: KSLTYP -REAL, DIMENSION(:,:),INTENT(INOUT) :: PSFTS ! O Scalar flux in molecules/m2/s -#ifdef MNH_MEGAN -!* 0.1 Declaration of local variables -! -INTEGER, PARAMETER :: NROWS = 1 -INTEGER :: ITIME ! Time of the day HHMMSS -INTEGER :: IDATE ! Date YYYYDDD -INTEGER :: IDAY ! julian day -REAL :: ZHOUR, ZMIN, ZSEC ! conversion ptime to itime format -REAL, DIMENSION(SIZE(PTEMP)) :: ZLAIC ! Current monthly LAI -REAL, DIMENSION(SIZE(PTEMP)) :: ZPFD ! Calculated PAR (umol/m2.s) -REAL, DIMENSION(SIZE(PTEMP)) :: ZLSUT ! Leaf on sun temperature (K) -REAL, DIMENSION(SIZE(PTEMP)) :: ZLSHT ! Leaf on shade temperature (K) -REAL, DIMENSION(SIZE(PTEMP)) :: ZRN -REAL, DIMENSION(SIZE(PTEMP)) :: ZCFNO ! NO correction factor -REAL, DIMENSION(SIZE(PTEMP)) :: ZCFNOG ! NO correction factor for grass -REAL, DIMENSION(N_MGN_SPC,SIZE(PTEMP)) :: ZCFSPEC ! Output emission buffer -REAL, DIMENSION(MGN%NVARS3D,SIZE(PTEMP)) :: ZFLUX ! Output emission megan flux -REAL, DIMENSION(SIZE(PTEMP)) :: ZD_TEMP, ZTSUM ! Daily temperature (K) and daily sum temperature - -! -REAL :: ZDI ! Drought Index (0 normal, -2 moderate drought, -3 severe drought, -4 extreme drought) -REAL :: ZREC_ADJ ! Rain adjustment factor -! -INTEGER,DIMENSION(SIZE(PTEMP)) :: ISLTYP !Soil category (function of silt, clay and sand)) -INTEGER :: JSV, JSM -INTEGER, SAVE :: ICOUNTNEW, ICOUNT, INB_COUNT -LOGICAL, SAVE :: GFIRSTCALL = .TRUE. - -! -! Input parameters -ZHOUR = FLOAT(INT(PTIME/3600.)) -ZMIN = FLOAT(INT((PTIME - ZHOUR*3600) / 60.)) -ZSEC = FLOAT(INT(PTIME - ZHOUR*3600. - ZMIN * 60.)) -ITIME = INT(ZHOUR)*10000 + INT(ZMIN)*100 + ZSEC -IDAY = JULIAN(KYEAR, KMONTH, KDAY) -IDATE = KYEAR*1000 + IDAY -! -! current = previous pour le LAI, a modifier si CPHOTO=LAI (evolutif) -ZLAIC(:) = MIN(MAX(0.001,PEK%XLAI(:)),8.) -! -ZDI = MGN%XDROUGHT -ZREC_ADJ = MGN%XMODPREC -ZCFNO = 0. -ZCFNOG = 0. -ZCFSPEC = 0. - -! Compute PAR from the entire canopy and conversion W/m2 in micromol/m²/s -ZPFD(:) = 0. -DO JSM = 1,SIZE(PIACAN,2) - ZPFD(:) = ZPFD(:) + PIACAN(:, JSM) * 4.6 -END DO - - -!INB_COUNT=INB_COUNT+1 -!ICOUNTNEW = INT(INB_COUNT*PTSTEP/XDAY) - -PT24(:) = PT24(:)*XDAY / (XDAY + PTSTEP) + PTEMP(:)* PTSTEP / (XDAY + PTSTEP) -PPFD24(:) = PPFD24(:)*XDAY / (XDAY + PTSTEP) + ZPFD(:)*PTSTEP / (XDAY + PTSTEP) - -! UPG*PT en attendat un calcul propre. Temperature des feuilles à l'ombre egale a la -! température de l'air. La temparature des feuilles au soleil egale a la valeur -! max entre la temperature de l'air et la temperaure radiative. -ZLSUT(:) = MAX(PLEAFT(:),PTEMP(:)) -ZLSHT(:) = PTEMP(:) -!UPG*PT - -! -! MEGAN : calcul des facteurs d'ajustement et de perte dans la canopée. -! ZCFSPEC: classe de sorties MEGAN (voir SPC_NOCONVER.EXT) -! 1: ISOP isoprene -! 2: MYRC myrcene -! 3: SABI sabinene -! 4: LIMO limonene -! 5: A_3CAR carene_3 -! 6: OCIM ocimene_t_b -! 7: BPIN pinene_b -! 8: APIN pinene_a -! 9: OMTP A_2met_styrene + cymene_p + cymene_o + phellandrene_a + thujene_a + terpinene_a -! + terpinene_g + terpinolene + phellandrene_b + camphene + bornene + fenchene_a -! + ocimene_al + .... -! 10: FARN -! 11: BCAR -! 12: OSQT -! 13: MBO -! 14: MEOH -! 15: ACTO -! 16: CO -! 17: NO -! 18: BIDER -! 19: STRESS -! 20: OTHER -! - -CALL EMPROC(ITIME, IDATE, PPFD24, PT24, ZDI, ZREC_ADJ, & - GK%XLAT, GK%XLON, ZLAIC, ZLAIC, PTEMP, & - ZPFD, PWIND, PPRES, PQV, KSLTYP, & - PEK%XWG(:,1), PEK%XTG(:,1), PPFT, & - CHI%LSOILNOX, ZCFNO, ZCFNOG, ZCFSPEC) -! -! MEGAN : calcul des flux d'émission -! Dans cette partie du programme les sorties des 20 catégories obtenues à l'issu de la partie -!EMPROC sont multipliées par les valeurs des facteurs d'émissions correspondants, puis converties -!en 150 espèces, et associées en différentes catégories chimiques en fonction du schéma de chimie -!atmosphérique choisi parmi RADM2, RACM, SAPRCII, SAPRC99, CBMZ, SAPRC99X, -!SAPRC99Q, CB05, CB6, SOAX . -! -CALL MGN2MECH(IDATE, GK%XLAT, PEF, PPFT, ZCFNO, ZCFNOG, ZCFSPEC, & - MGN%NSPMH_MAP, MGN%NMECH_MAP, MGN%XCONV_FAC, & - MGN%LCONVERSION, ZFLUX) -! -! Conversion ZFLUX from MEGAN mole/m2/s into molec/m2/s -ZFLUX(:,:) = ZFLUX(:,:) * XAVOGADRO -! -! Case of the same species between megan and mesonh -DO JSV=1, SIZE(CHI%SVI%CSV) - DO JSM=1, MGN%NVARS3D - IF (TRIM(CHI%SVI%CSV(JSV)) == TRIM(MGN%CVNAME3D(JSM))) THEN - PSFTS(:,JSV) = PSFTS(:,JSV) + ZFLUX(JSM,:) - END IF - END DO -END DO -! -! Case of special treatment : ReLACS 1, 2, 3 scheme or CACM scheme -! Megan conversion is upon SOAX species -IF ( TRIM(MGN%CMECHANISM)=="RELACS" ) THEN - PSFTS(:,MGN%NBIO ) = PSFTS(:,MGN%NBIO ) + ZFLUX(MGN%NISOPRENE,:) + ZFLUX(MGN%NTRP1,:) -ENDIF -! -IF ( TRIM(MGN%CMECHANISM)=="RELACS2") THEN - PSFTS(:,MGN%NORA1) = PSFTS(:,MGN%NORA1) + ZFLUX(MGN%NHCOOH,:) - PSFTS(:,MGN%NORA2) = PSFTS(:,MGN%NORA2) + ZFLUX(MGN%NCCO_OH,:) - PSFTS(:,MGN%NACID) = PSFTS(:,MGN%NACID) + ZFLUX(MGN%NRCO_OH,:) -END IF -! -IF ( TRIM(MGN%CMECHANISM)=="CACM" ) THEN - PSFTS(:,MGN%NACID) = PSFTS(:,MGN%NACID) + ZFLUX(MGN%NHCOOH,:) + ZFLUX(MGN%NCCO_OH,:) + ZFLUX(MGN%NRCO_OH,:) -ENDIF - -IF ( TRIM(MGN%CMECHANISM)=="CACM".OR.TRIM(MGN%CMECHANISM)=="RELACS2" ) THEN - PSFTS(:,MGN%NISOP) = PSFTS(:,MGN%NISOP) + ZFLUX(MGN%NISOPRENE,:) - PSFTS(:,MGN%NBIOH) = PSFTS(:,MGN%NBIOH) + 0.75*ZFLUX(MGN%NTRP1,:) - PSFTS(:,MGN%NBIOL) = PSFTS(:,MGN%NBIOL) + 0.25*ZFLUX(MGN%NTRP1,:) - PSFTS(:,MGN%NKETL) = PSFTS(:,MGN%NKETL) + ZFLUX(MGN%NACET,:) + ZFLUX(MGN%NMEK,:) - PSFTS(:,MGN%NARAL) = PSFTS(:,MGN%NARAL) + ZFLUX(MGN%NBALD,:) - PSFTS(:,MGN%NETHE) = PSFTS(:,MGN%NETHE) + ZFLUX(MGN%NETHENE,:) - PSFTS(:,MGN%NALKL) = PSFTS(:,MGN%NALKL) + ZFLUX(MGN%NALK4,:) - PSFTS(:,MGN%NALKM) = PSFTS(:,MGN%NALKM) + 0.5*ZFLUX(MGN%NALK5,:) - PSFTS(:,MGN%NALKH) = PSFTS(:,MGN%NALKH) + 0.5*ZFLUX(MGN%NALK5,:) - PSFTS(:,MGN%NAROH) = PSFTS(:,MGN%NAROH) + 0.5*ZFLUX(MGN%NARO1,:) - PSFTS(:,MGN%NAROL) = PSFTS(:,MGN%NAROL) + 0.5*ZFLUX(MGN%NARO1,:) - PSFTS(:,MGN%NAROO) = PSFTS(:,MGN%NAROO) + ZFLUX(MGN%NARO2,:) - PSFTS(:,MGN%NOLEL) = PSFTS(:,MGN%NOLEL) + 0.5*ZFLUX(MGN%NOLE1,:) - PSFTS(:,MGN%NOLEH) = PSFTS(:,MGN%NOLEH) + 0.5*ZFLUX(MGN%NOLE1,:) -END IF -! -! -#endif -END SUBROUTINE COUPLING_MEGAN_n diff --git a/src/ICCARE_BASE/coupling_seaflux_orogn.F90 b/src/ICCARE_BASE/coupling_seaflux_orogn.F90 deleted file mode 100644 index 5a2bbe3b4..000000000 --- a/src/ICCARE_BASE/coupling_seaflux_orogn.F90 +++ /dev/null @@ -1,215 +0,0 @@ -!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -! ############################################################################### -SUBROUTINE COUPLING_SEAFLUX_OROG_n (SM, DST, SLT, HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, & - KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, & - PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PZS, PU, PV, & - PQA, PTA, PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, & - PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, & - PSFTS, PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB,& - PEMIS, PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, & - PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, & - PPEQ_B_COEF, PZWS, HTEST ) -! ############################################################################### -! -!!**** *COUPLING_SEAFLUX_OROG_n * - Modifies the input forcing if not -!! initially at sea level -!! -!! PURPOSE -!! ------- -! -!!** METHOD -!! ------ -!! -!! REFERENCE -!! --------- -!! -!! -!! AUTHOR -!! ------ -!! V. Masson -!! -!! MODIFICATIONS -!! ------------- -!! Original 01/2004 -!! B. Decharme 2008 reset the subgrid topographic effect on the forcing -!! J. Escobar 09/2012 SIZE(PTA) not allowed without-interface , replace by KI -!! B. Decharme 04/2013 new coupling variables -!! improve forcing vertical shift -!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes -!!------------------------------------------------------------- -! -! -USE MODD_SURFEX_n, ONLY : SEAFLUX_MODEL_t, SURFEX_t -! -USE MODD_DST_n, ONLY : DST_t -USE MODD_SLT_n, ONLY : SLT_t -USE MODD_DMS_n, ONLY : DMS_t -! -! -USE MODD_SURF_PAR, ONLY : XUNDEF -USE MODD_CSTS, ONLY : XCPD, XRD, XP00 -! -USE MODD_SURF_ATM, ONLY : LVERTSHIFT -! -USE MODI_FORCING_VERT_SHIFT -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -USE MODI_COUPLING_SEAFLUX_SBL_n -! -IMPLICIT NONE -! -!* 0.1 declarations of arguments -! -! -TYPE(SEAFLUX_MODEL_t), INTENT(INOUT) :: SM -TYPE(DST_t), INTENT(INOUT) :: DST -TYPE(SLT_t), INTENT(INOUT) :: SLT -! - CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes - CHARACTER(LEN=1), INTENT(IN) :: HCOUPLING ! type of coupling - ! 'E' : explicit - ! 'I' : implicit -REAL, INTENT(IN) :: PTIMEC ! current duration since start of the run (s) -INTEGER, INTENT(IN) :: KYEAR ! current year (UTC) -INTEGER, INTENT(IN) :: KMONTH ! current month (UTC) -INTEGER, INTENT(IN) :: KDAY ! current day (UTC) -REAL, INTENT(IN) :: PTIME ! current time since midnight (UTC, s) -INTEGER, INTENT(IN) :: KI ! number of points -INTEGER, INTENT(IN) :: KSV ! number of scalars -INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands -REAL, DIMENSION(KI), INTENT(IN) :: PTSUN ! solar time (s from midnight) -REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step (s) -REAL, DIMENSION(KI), INTENT(IN) :: PZREF ! height of T,q forcing (m) -REAL, DIMENSION(KI), INTENT(IN) :: PUREF ! height of wind forcing (m) -! -REAL, DIMENSION(KI), INTENT(IN) :: PTA ! air temperature forcing (K) -REAL, DIMENSION(KI), INTENT(IN) :: PQA ! air humidity forcing (kg/m3) -REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density (kg/m3) -REAL, DIMENSION(KI,KSV),INTENT(IN) :: PSV ! scalar variables -! ! chemistry: first char. in HSV: '#' (molecule/m3) -! ! - CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: HSV ! name of all scalar variables -REAL, DIMENSION(KI), INTENT(IN) :: PU ! zonal wind (m/s) -REAL, DIMENSION(KI), INTENT(IN) :: PV ! meridian wind (m/s) -REAL, DIMENSION(KI,KSW),INTENT(IN) :: PDIR_SW ! direct solar radiation (on horizontal surf.) -! ! (W/m2) -REAL, DIMENSION(KI,KSW),INTENT(IN) :: PSCA_SW ! diffuse solar radiation (on horizontal surf.) -! ! (W/m2) -REAL, DIMENSION(KSW),INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m) -REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! zenithal angle at t (radian from the vertical) -REAL, DIMENSION(KI), INTENT(IN) :: PZENITH2 ! zenithal angle at t+1(radian from the vertical) -REAL, DIMENSION(KI), INTENT(IN) :: PAZIM ! azimuthal angle (radian from North, clockwise) -REAL, DIMENSION(KI), INTENT(IN) :: PLW ! longwave radiation (on horizontal surf.) -! ! (W/m2) -REAL, DIMENSION(KI), INTENT(IN) :: PPS ! pressure at atmospheric model surface (Pa) -REAL, DIMENSION(KI), INTENT(IN) :: PPA ! pressure at forcing level (Pa) -REAL, DIMENSION(KI), INTENT(IN) :: PZWS ! significant sea wave (m) -REAL, DIMENSION(KI), INTENT(IN) :: PZS ! atmospheric model orography (m) -REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration in the air (kg/m3) -REAL, DIMENSION(KI), INTENT(IN) :: PSNOW ! snow precipitation (kg/m2/s) -REAL, DIMENSION(KI), INTENT(IN) :: PRAIN ! liquid precipitation (kg/m2/s) -! -! -REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH ! flux of heat (W/m2) -REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ ! flux of water vapor (kg/m2/s) -REAL, DIMENSION(KI), INTENT(OUT) :: PSFU ! zonal momentum flux (Pa) -REAL, DIMENSION(KI), INTENT(OUT) :: PSFV ! meridian momentum flux (Pa) -REAL, DIMENSION(KI), INTENT(OUT) :: PSFCO2 ! flux of CO2 (m/s*kg_CO2/kg_air) -REAL, DIMENSION(KI,KSV),INTENT(OUT):: PSFTS ! flux of scalar var. (kg/m2/s) -! -REAL, DIMENSION(KI), INTENT(OUT) :: PTRAD ! radiative temperature (K) -REAL, DIMENSION(KI,KSW),INTENT(OUT):: PDIR_ALB! direct albedo for each spectral band (-) -REAL, DIMENSION(KI,KSW),INTENT(OUT):: PSCA_ALB! diffuse albedo for each spectral band (-) -REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS ! emissivity (-) -! -REAL, DIMENSION(KI), INTENT(OUT) :: PTSURF ! surface effective temperature (K) -REAL, DIMENSION(KI), INTENT(OUT) :: PZ0 ! roughness length for momentum (m) -REAL, DIMENSION(KI), INTENT(OUT) :: PZ0H ! roughness length for heat (m) -REAL, DIMENSION(KI), INTENT(OUT) :: PQSURF ! specific humidity at surface (kg/kg) -! -REAL, DIMENSION(KI), INTENT(IN) :: PPEW_A_COEF! implicit coefficients -REAL, DIMENSION(KI), INTENT(IN) :: PPEW_B_COEF! needed if HCOUPLING='I' -REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF -REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF -REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF -REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF - CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK' -! -!* 0.2 declarations of local variables -! -REAL, DIMENSION(KI) :: ZPEQ_B_COEF ! 1st explicit coefficient -REAL, DIMENSION(KI) :: ZPET_B_COEF ! 2nd explicit coefficient -! -REAL, DIMENSION(KI) :: ZTA ! Temperature at forcing height above surface orography -REAL, DIMENSION(KI) :: ZPA ! Pressure at forcing height above surface orography -REAL, DIMENSION(KI) :: ZPS ! Pressure at surface orography -REAL, DIMENSION(KI) :: ZQA ! Humidity at forcing height above surface orography -REAL, DIMENSION(KI) :: ZRHOA ! Density at forcing height above surface orography -REAL, DIMENSION(KI) :: ZLW ! LW rad at forcing height above surface orography -REAL, DIMENSION(KI) :: ZRAIN ! Rainfall at forcing height above surface orography -REAL, DIMENSION(KI) :: ZSNOW ! Snowfall at forcing height above surface orography -! -REAL(KIND=JPRB) :: ZHOOK_HANDLE -!------------------------------------------------------------------------------------- -! Preliminaries: -!------------------------------------------------------------------------------------- -! -IF (LHOOK) CALL DR_HOOK('COUPLING_SEAFLUX_OROG_N',0,ZHOOK_HANDLE) -! -ZPEQ_B_COEF(:) = PPEQ_B_COEF(:) -ZPET_B_COEF(:) = PPET_B_COEF(:) -! -IF(LVERTSHIFT)THEN -! - ZTA (:) = XUNDEF - ZQA (:) = XUNDEF - ZPS (:) = XUNDEF - ZPA (:) = XUNDEF - ZRHOA(:) = XUNDEF - ZLW (:) = XUNDEF - ZRAIN(:) = XUNDEF - ZSNOW(:) = XUNDEF -! - CALL FORCING_VERT_SHIFT(PZS,SM%S%XZS,PTA,PQA,PPA,PRHOA,PLW,PRAIN,PSNOW,& - ZTA,ZQA,ZPA,ZRHOA,ZLW,ZRAIN,ZSNOW ) -! - ZPS(:) = ZPA(:) + (PPS(:) - PPA(:)) -! - IF (HCOUPLING=='I') THEN - ZPEQ_B_COEF = PPEQ_B_COEF + ZQA - PQA - ZPET_B_COEF = PPET_B_COEF + ZTA/(ZPA/XP00)**(XRD/XCPD) - PTA/(PPA/XP00)**(XRD/XCPD) - ENDIF -! -ELSE -! - ZTA (:) = PTA (:) - ZQA (:) = PQA (:) - ZPS (:) = PPS (:) - ZPA (:) = PPA (:) - ZRHOA(:) = PRHOA(:) - ZLW (:) = PLW (:) - ZRAIN(:) = PRAIN(:) - ZSNOW(:) = PSNOW(:) -! -ENDIF -! - CALL COUPLING_SEAFLUX_SBL_n(SM%CHS, SM%DTS, SM%SD, SM%O, SM%OR, SM%G, SM%S, SM%SB, & - DST, SLT, SM%DMS, HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, & - KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, & - PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PU, PV, & - ZQA, ZTA, ZRHOA, PSV, PCO2, HSV, ZRAIN, ZSNOW, ZLW, & - PDIR_SW, PSCA_SW, PSW_BANDS, ZPS, ZPA, PSFTQ, PSFTH, & - PSFTS, PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, & - PEMIS, PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, & - PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, ZPET_B_COEF, & - ZPEQ_B_COEF, PZWS, HTEST ) -! -IF (LHOOK) CALL DR_HOOK('COUPLING_SEAFLUX_OROG_N',1,ZHOOK_HANDLE) -!------------------------------------------------------------------------------------- -! -END SUBROUTINE COUPLING_SEAFLUX_OROG_n diff --git a/src/ICCARE_BASE/coupling_seaflux_sbln.F90 b/src/ICCARE_BASE/coupling_seaflux_sbln.F90 deleted file mode 100644 index 2d4148ff3..000000000 --- a/src/ICCARE_BASE/coupling_seaflux_sbln.F90 +++ /dev/null @@ -1,359 +0,0 @@ -!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -! ############################################################################### -SUBROUTINE COUPLING_SEAFLUX_SBL_n (CHS, DTS, DGS, O, OR, G, S, SB, DST, SLT, DMS, & - HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, & - KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, & - PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, & - PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, & - PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, & - PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, & - PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, & - PPEQ_B_COEF, PZWS, HTEST ) -! ############################################################################### -! -!!**** *COUPLING_SEAFLUX_SBL_n * - Adds a SBL into SEAFLUX -!! -!! PURPOSE -!! ------- -! -!!** METHOD -!! ------ -!! -!! REFERENCE -!! --------- -!! -!! -!! AUTHOR -!! ------ -!! V. Masson -!! -!! MODIFICATIONS -!! ------------- -!! Original 09/2007 -!! V. Masson 05/2009 Implicitation of momentum fluxes -!! S. Riette 06/2009 Initialisation of XT, PQ, XU and XTKE on canopy levels -!! S. Riette 10/2009 Iterative computation of XZ0 -!! S. Riette 01/2010 Use of interpol_sbl to compute 10m wind diagnostic -!! B. Decharme 04/2013 new coupling variables -!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes -!---------------------------------------------------------------- -! -! -USE MODD_CH_SEAFLUX_n, ONLY : CH_SEAFLUX_t -USE MODD_DATA_SEAFLUX_n, ONLY : DATA_SEAFLUX_t -USE MODD_SURFEX_n, ONLY : SEAFLUX_DIAG_t -USE MODD_OCEAN_n, ONLY : OCEAN_t -USE MODD_OCEAN_REL_n, ONLY : OCEAN_REL_t -USE MODD_SFX_GRID_n, ONLY : GRID_t -USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t -USE MODD_CANOPY_n, ONLY : CANOPY_t -! -USE MODD_DST_n, ONLY : DST_t -USE MODD_SLT_n, ONLY : SLT_t -USE MODD_DMS_n, ONLY : DMS_t -! -USE MODD_SURF_PAR, ONLY : XUNDEF -USE MODD_CSTS, ONLY : XCPD -! -USE MODE_COUPLING_CANOPY -! -USE MODI_INIT_WATER_SBL -! -USE MODI_CANOPY_EVOL -USE MODI_CANOPY_GRID_UPDATE -! -USE MODI_COUPLING_SEAFLUX_n -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -IMPLICIT NONE -! -!* 0.1 declarations of arguments -! -! -TYPE(CH_SEAFLUX_t), INTENT(INOUT) :: CHS -TYPE(DATA_SEAFLUX_t), INTENT(INOUT) :: DTS -TYPE(SEAFLUX_DIAG_t), INTENT(INOUT) :: DGS -TYPE(OCEAN_t), INTENT(INOUT) :: O -TYPE(OCEAN_REL_t), INTENT(INOUT) :: OR -TYPE(GRID_t), INTENT(INOUT) :: G -TYPE(SEAFLUX_t), INTENT(INOUT) :: S -TYPE(CANOPY_t), INTENT(INOUT) :: SB -TYPE(DST_t), INTENT(INOUT) :: DST -TYPE(SLT_t), INTENT(INOUT) :: SLT -TYPE(DMS_t), INTENT(INOUT) :: DMS -! - CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes - CHARACTER(LEN=1), INTENT(IN) :: HCOUPLING ! type of coupling - ! 'E' : explicit - ! 'I' : implicit - REAL, INTENT(IN) :: PTIMEC ! cumulated time since beginning of simulation -INTEGER, INTENT(IN) :: KYEAR ! current year (UTC) -INTEGER, INTENT(IN) :: KMONTH ! current month (UTC) -INTEGER, INTENT(IN) :: KDAY ! current day (UTC) -REAL, INTENT(IN) :: PTIME ! current time since midnight (UTC, s) -INTEGER, INTENT(IN) :: KI ! number of points -INTEGER, INTENT(IN) :: KSV ! number of scalars -INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands -REAL, DIMENSION(KI), INTENT(IN) :: PTSUN ! solar time (s from midnight) -REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step (s) -REAL, DIMENSION(KI), INTENT(IN) :: PZREF ! height of T,q forcing (m) -REAL, DIMENSION(KI), INTENT(IN) :: PUREF ! height of wind forcing (m) -! -REAL, DIMENSION(KI), INTENT(IN) :: PTA ! air temperature forcing (K) -REAL, DIMENSION(KI), INTENT(IN) :: PQA ! air humidity forcing (kg/m3) -REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density (kg/m3) -REAL, DIMENSION(KI,KSV),INTENT(IN) :: PSV ! scalar variables -! ! chemistry: first char. in HSV: '#' (molecule/m3) -! ! - CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: HSV ! name of all scalar variables -REAL, DIMENSION(KI), INTENT(IN) :: PU ! zonal wind (m/s) -REAL, DIMENSION(KI), INTENT(IN) :: PV ! meridian wind (m/s) -REAL, DIMENSION(KI,KSW),INTENT(IN) :: PDIR_SW ! direct solar radiation (on horizontal surf.) -! ! (W/m2) -REAL, DIMENSION(KI,KSW),INTENT(IN) :: PSCA_SW ! diffuse solar radiation (on horizontal surf.) -! ! (W/m2) -REAL, DIMENSION(KSW),INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m) -REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! zenithal angle at t (radian from the vertical) -REAL, DIMENSION(KI), INTENT(IN) :: PZENITH2 ! zenithal angle at t+1(radian from the vertical) -REAL, DIMENSION(KI), INTENT(IN) :: PAZIM ! azimuthal angle (radian from North, clockwise) -REAL, DIMENSION(KI), INTENT(IN) :: PLW ! longwave radiation (on horizontal surf.) -! ! (W/m2) -REAL, DIMENSION(KI), INTENT(IN) :: PPS ! pressure at atmospheric model surface (Pa) -REAL, DIMENSION(KI), INTENT(IN) :: PPA ! pressure at forcing level (Pa) -REAL, DIMENSION(KI), INTENT(IN) :: PZWS ! significant sea wave (m) -REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration in the air (kg/m3) -REAL, DIMENSION(KI), INTENT(IN) :: PSNOW ! snow precipitation (kg/m2/s) -REAL, DIMENSION(KI), INTENT(IN) :: PRAIN ! liquid precipitation (kg/m2/s) -! -! -REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH ! flux of heat (W/m2) -REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ ! flux of water vapor (kg/m2/s) -REAL, DIMENSION(KI), INTENT(OUT) :: PSFU ! zonal momentum flux (Pa) -REAL, DIMENSION(KI), INTENT(OUT) :: PSFV ! meridian momentum flux (Pa) -REAL, DIMENSION(KI), INTENT(OUT) :: PSFCO2 ! flux of CO2 (m/s*kg_CO2/kg_air) -REAL, DIMENSION(KI,KSV),INTENT(OUT):: PSFTS ! flux of scalar var. (kg/m2/s) -! -REAL, DIMENSION(KI), INTENT(OUT) :: PTRAD ! radiative temperature (K) -REAL, DIMENSION(KI,KSW),INTENT(OUT):: PDIR_ALB! direct albedo for each spectral band (-) -REAL, DIMENSION(KI,KSW),INTENT(OUT):: PSCA_ALB! diffuse albedo for each spectral band (-) -REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS ! emissivity (-) -! -REAL, DIMENSION(KI), INTENT(OUT) :: PTSURF ! surface effective temperature (K) -REAL, DIMENSION(KI), INTENT(OUT) :: PZ0 ! roughness length for momentum (m) -REAL, DIMENSION(KI), INTENT(OUT) :: PZ0H ! roughness length for heat (m) -REAL, DIMENSION(KI), INTENT(OUT) :: PQSURF ! specific humidity at surface (kg/kg) -! -REAL, DIMENSION(KI), INTENT(IN) :: PPEW_A_COEF! implicit coefficients -REAL, DIMENSION(KI), INTENT(IN) :: PPEW_B_COEF! needed if HCOUPLING='I' -REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF -REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF -REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF -REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF - CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK' -! -!* 0.2 declarations of local variables -! -!* forcing variables -! -REAL, DIMENSION(KI) :: ZWIND ! lowest atmospheric level wind speed (m/s) -REAL, DIMENSION(KI) :: ZEXNA ! Exner function at lowest SBL scheme level (-) -REAL, DIMENSION(KI) :: ZTA ! temperature (K) -REAL, DIMENSION(KI) :: ZPA ! pressure (Pa) -REAL, DIMENSION(KI) :: ZZREF ! temperature forcing level (m) -REAL, DIMENSION(KI) :: ZUREF ! wind forcing level (m) -REAL, DIMENSION(KI) :: ZU ! zonal wind (m/s) -REAL, DIMENSION(KI) :: ZV ! meridian wind (m/s) -REAL, DIMENSION(KI) :: ZQA ! specific humidity (kg/m3) -REAL, DIMENSION(KI) :: ZPEQ_A_COEF ! specific humidity implicit -REAL, DIMENSION(KI) :: ZPEQ_B_COEF ! coefficients (hum. in kg/kg) -! -! -! SBL turbulence scheme -! -REAL, DIMENSION(KI) :: ZSFLUX_U ! Surface flux u'w' (m2/s2) -REAL, DIMENSION(KI) :: ZSFLUX_T ! Surface flux w'T' (mK/s) -REAL, DIMENSION(KI) :: ZSFLUX_Q ! Surface flux w'q' (kgm2/s) -REAL, DIMENSION(KI,SB%NLVL) :: ZFORC_U ! tendency due to drag force for wind -REAL, DIMENSION(KI,SB%NLVL) :: ZDFORC_UDU! formal derivative of -! ! tendency due to drag force for wind -REAL, DIMENSION(KI,SB%NLVL) :: ZFORC_E ! tendency due to drag force for TKE -REAL, DIMENSION(KI,SB%NLVL) :: ZDFORC_EDE! formal derivative of -! ! tendency due to drag force for TKE -REAL, DIMENSION(KI,SB%NLVL) :: ZFORC_T ! tendency due to drag force for Temp -REAL, DIMENSION(KI,SB%NLVL) :: ZDFORC_TDT! formal derivative of -! ! tendency due to drag force for Temp -REAL, DIMENSION(KI,SB%NLVL) :: ZFORC_Q ! tendency due to drag force for Temp -REAL, DIMENSION(KI,SB%NLVL) :: ZDFORC_QDQ! formal derivative of -! ! tendency due to drag force for hum. -REAL, DIMENSION(KI,SB%NLVL) :: ZLM ! mixing length -REAL, DIMENSION(KI,SB%NLVL) :: ZLEPS ! dissipative length -REAL, DIMENSION(KI) :: ZH ! canopy height (m) -REAL, DIMENSION(KI) :: ZUSTAR ! friction velocity (m/s) -! -REAL, DIMENSION(KI) :: ZPET_A_COEF ! temperature implicit -REAL, DIMENSION(KI) :: ZPET_B_COEF ! coefficients (K) -REAL, DIMENSION(KI) :: ZPEW_A_COEF ! wind implicit -REAL, DIMENSION(KI) :: ZPEW_B_COEF ! coefficients (m/s) - -REAL, DIMENSION(KI) :: ZALFAU ! V+(1) = - alfa rho u'w'(1) + beta -REAL, DIMENSION(KI) :: ZBETAU ! V+(1) = - alfa rho u'w'(1) + beta -REAL, DIMENSION(KI) :: ZALFATH ! Th+(1) = - alfa rho w'th'(1) + beta -REAL, DIMENSION(KI) :: ZBETATH ! Th+(1) = - alfa rho w'th'(1) + beta -REAL, DIMENSION(KI) :: ZALFAQ ! Q+(1) = - alfa rho w'q'(1) + beta -REAL, DIMENSION(KI) :: ZBETAQ ! Q+(1) = - alfa rho w'q'(1) + beta -! -INTEGER :: JLAYER - CHARACTER(LEN=1) :: GCOUPLING -REAL(KIND=JPRB) :: ZHOOK_HANDLE -!------------------------------------------------------------------------------------- -! -! -!* 1. Preliminary computations of the SBL scheme -! ------------------------------------------ -! -IF (LHOOK) CALL DR_HOOK('COUPLING_SEAFLUX_SBL_N',0,ZHOOK_HANDLE) -IF (S%LSBL) THEN -! -!* 1.1 Updates SBL vertical grid as a function of forcing height -! --------------------------------------------------------- -! -!* determines where is the forcing level and modifies the upper levels of the canopy grid -! - ZH = 0. - CALL CANOPY_GRID_UPDATE(KI,ZH,PUREF,SB) -! -! -! -!* 1.2 Initialisation at first time step -! --------------------------------- -! - IF(ANY(SB%XT(:,:) == XUNDEF)) THEN - CALL INIT_WATER_SBL(SB, PPA, PPS, PTA, PQA, PRHOA, PU, PV, PRAIN, PSNOW, & - PSFTH, PSFTQ, PZREF, PUREF, S%XSST, S%XZ0 ) - ENDIF -! -! -!* 1.3 Allocations -! ----------- -! - CALL INIT_FORC(ZFORC_U, ZDFORC_UDU, ZFORC_E, ZDFORC_EDE, & - ZFORC_T, ZDFORC_TDT, ZFORC_Q, ZDFORC_QDQ ) -! - ZSFLUX_U = 0. - ZSFLUX_T = 0. - ZSFLUX_Q = 0. -! -!* 1.3 Computes coefficients for implicitation -! --------------------------------------- -! - ZWIND = SQRT(PU**2+PV**2) - CALL CANOPY_EVOL(SB, KI, PTSTEP,1, SB%XZ, ZWIND, PTA, PQA, PPA, PRHOA, & - ZSFLUX_U, ZSFLUX_T, ZSFLUX_Q, ZFORC_U, ZDFORC_UDU, & - ZFORC_E, ZDFORC_EDE, ZFORC_T, ZDFORC_TDT, & - ZFORC_Q, ZDFORC_QDQ, ZLM, ZLEPS, ZUSTAR, & - ZALFAU, ZBETAU, ZALFATH, ZBETATH, ZALFAQ ,ZBETAQ ) - -! -!* 1.5 Goes from atmospheric forcing to canopy forcing height -! ------------------------------------------------------ -! - GCOUPLING = 'I' -! - CALL INIT_COUPLING_CANOPY(SB, PPA, PU, PV, PRHOA, & - ZALFAU, ZBETAU, ZALFATH, ZBETATH,& - ZALFAQ, ZBETAQ, ZPA, ZTA, ZQA, & - ZU, ZV, ZUREF, ZZREF, ZEXNA, & - ZPEW_A_COEF, ZPEW_B_COEF, & - ZPET_A_COEF, ZPET_B_COEF, & - ZPEQ_A_COEF, ZPEQ_B_COEF ) -! -!------------------------------------------------------------------------------------- -ELSE -!------------------------------------------------------------------------------------- -! -!* 2. If no SBL scheme is used, forcing is not modified -! ------------------------------------------------- -! - GCOUPLING = HCOUPLING -! - CALL INIT_COUPLING( HCOUPLING, & - PPS, PPA, PTA, PQA, PU, PV, & - PUREF, PZREF, & - PPEW_A_COEF, PPEW_B_COEF, & - PPET_A_COEF, PPET_B_COEF, & - PPEQ_A_COEF, PPEQ_B_COEF, & - ZPA, ZTA, ZQA, ZU, ZV, & - ZUREF, ZZREF, & - ZPEW_A_COEF, ZPEW_B_COEF, & - ZPET_A_COEF, ZPET_B_COEF, & - ZPEQ_A_COEF, ZPEQ_B_COEF ) -! -END IF -! -!------------------------------------------------------------------------------------- -! -!* 2. Call of SEAFLUX -! ------------ -! - CALL COUPLING_SEAFLUX_n(CHS, DTS, DGS, O, OR, G, S, DST, SLT, DMS, HPROGRAM, GCOUPLING, & - PTIMEC, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, & - PTSUN, PZENITH, PZENITH2, PAZIM, ZZREF, ZUREF, ZU, ZV, ZQA, ZTA, PRHOA, & - PSV, PCO2, HSV, PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, ZPA,& - PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, & - PEMIS, PTSURF, PZ0, PZ0H, PQSURF, ZPEW_A_COEF, ZPEW_B_COEF, & - ZPET_A_COEF, ZPEQ_A_COEF, ZPET_B_COEF, ZPEQ_B_COEF, PZWS, HTEST) -! -!------------------------------------------------------------------------------------- -! -!* 3. End if no SBL is used -! --------------------- -! -IF (.NOT. S%LSBL .AND. LHOOK) CALL DR_HOOK('COUPLING_SEAFLUX_SBL_N',1,ZHOOK_HANDLE) -IF (.NOT. S%LSBL) RETURN -! -!------------------------------------------------------------------------------------- -! -!* 4. Computes the impact of canopy and surfaces on air -! ------------------------------------------------- -! - CALL INIT_FORC( ZFORC_U, ZDFORC_UDU, ZFORC_E, ZDFORC_EDE, & - ZFORC_T, ZDFORC_TDT, ZFORC_Q, ZDFORC_QDQ ) -! -ZSFLUX_U = - SQRT(PSFU(:)**2+PSFV(:)**2) / PRHOA(:) -ZSFLUX_T(:) = PSFTH(:) / XCPD * ZEXNA(:) / PRHOA(:) -ZSFLUX_Q(:) = PSFTQ(:) -! -!------------------------------------------------------------------------------------- -! -!* 6. Evolution of canopy air due to these impacts -! -------------------------------------------- -! -ZWIND = SQRT(PU**2+PV**2) - CALL CANOPY_EVOL(SB,KI,PTSTEP,2,SB%XZ,ZWIND,PTA,PQA,PPA,PRHOA, & - ZSFLUX_U,ZSFLUX_T,ZSFLUX_Q, & - ZFORC_U,ZDFORC_UDU,ZFORC_E,ZDFORC_EDE, & - ZFORC_T,ZDFORC_TDT,ZFORC_Q,ZDFORC_QDQ, & - ZLM,ZLEPS,ZUSTAR, & - ZALFAU,ZBETAU,ZALFATH,ZBETATH,ZALFAQ,ZBETAQ ) -! -DO JLAYER=1,SB%NLVL-1 - SB%XLMO(:,JLAYER) = SB%XLMO(:,SB%NLVL) -ENDDO -! -!------------------------------------------------------------------------------------- -! -!* 7. 2m and 10m diagnostics if canopy is used -! ---------------------------------------- -! -IF (S%LSBL .AND. DGS%O%N2M>=1) CALL INIT_2M_10M( SB, DGS%D, PU, PV, ZWIND, PRHOA ) -! -IF (LHOOK) CALL DR_HOOK('COUPLING_SEAFLUX_SBL_N',1,ZHOOK_HANDLE) -! -!------------------------------------------------------------------------------------- -! -END SUBROUTINE COUPLING_SEAFLUX_SBL_n diff --git a/src/ICCARE_BASE/coupling_seafluxn.F90 b/src/ICCARE_BASE/coupling_seafluxn.F90 deleted file mode 100644 index ff9a36c6a..000000000 --- a/src/ICCARE_BASE/coupling_seafluxn.F90 +++ /dev/null @@ -1,867 +0,0 @@ -!SFX_LIC Copyright 2004-2019 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -! ############################################################################### -SUBROUTINE COUPLING_SEAFLUX_n (CHS, DTS, DGS, O, OR, G, S, DST, SLT, DMS, & - HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, & - KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, & - PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, & - PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, & - PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, & - PZ0, PZ0H, PQSURF, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, & - PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, PZWS, HTEST ) -! ############################################################################### -! -!!**** *COUPLING_SEAFLUX_n * - Driver of the WATER_FLUX scheme for sea -!! -!! PURPOSE -!! ------- -! -!!** METHOD -!! ------ -!! -!! REFERENCE -!! --------- -!! -!! -!! AUTHOR -!! ------ -!! V. Masson -!! -!! MODIFICATIONS -!! ------------- -!! Original 01/2004 -!! Modified 01/2006 : sea flux parameterization. -!! Modified 09/2006 : P. Tulet Introduce Sea salt aerosol Emission/Deposition -!! Modified 03/2009 : B. Decharme SST could change during a run => ALB and EMIS -!! Modified 05/2009 : V. Masson : implicitation of momentum fluxes -!! Modified 09/2009 : B. Decharme Radiative properties at time t+1 -!! Modified 01/2010 : B. Decharme Add XTTS -!! Modified 09/2012 : B. Decharme New wind implicitation -!! Modified 10/2012 : P. Le Moigne CMO1D update -!! Modified 04/2013 : P. Le Moigne Wind implicitation and SST update displaced -!! Modified 04/2013 : B. Decharme new coupling variables -!! Modified 01/2014 : S. Senesi : handle sea-ice cover, sea-ice model interface, -!! and apply to Gelato -!! Modified 01/2014 : S. Belamari Remove MODE_THERMOS and XLVTT -!! Modified 05/2014 : S. Belamari New ECUME : Include salinity & atm. pressure impact -!! Modified 01/2015 : R. Séférian interactive ocaen surface albedo -!! Modified 03/2014 : M.N. Bouin possibility of wave parameters from external source -!! Modified 11/2014 : J. Pianezze : add currents for wave coupling -!! Modified 02/2019 : S. Bielli Sea salt : significant sea wave height influences salt emission; 5 salt modes -!! Modified 03/2019 : P. Wautelet: correct ZWS when variable not present in file -!! Modified 03/2019 : P. Wautelet: missing use MODI_GET_LUOUT -!!--------------------------------------------------------------------- -! -! -USE MODD_CH_SEAFLUX_n, ONLY : CH_SEAFLUX_t -USE MODD_DATA_SEAFLUX_n, ONLY : DATA_SEAFLUX_t -USE MODD_SURFEX_n, ONLY : SEAFLUX_DIAG_t -USE MODD_OCEAN_n, ONLY : OCEAN_t -USE MODD_OCEAN_REL_n, ONLY : OCEAN_REL_t -USE MODD_SFX_GRID_n, ONLY : GRID_t -USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t -! -USE MODD_DST_n, ONLY : DST_t -USE MODD_SLT_n, ONLY : SLT_t -USE MODD_DMS_n, ONLY : DMS_t -! -USE MODD_REPROD_OPER, ONLY : CIMPLICIT_WIND -! -USE MODD_CSTS, ONLY : XRD, XCPD, XP00, XTT, XTTS, XTTSI, XDAY, XAVOGADRO -USE MODD_SURF_PAR, ONLY : XUNDEF -USE MODD_SFX_OASIS, ONLY : LCPL_WAVE, LCPL_SEA, LCPL_SEAICE -USE MODD_WATER_PAR, ONLY : XEMISWAT, XEMISWATICE -! -USE MODD_WATER_PAR, ONLY : XALBSEAICE -! -#ifdef SFX_MNH -USE MODD_FIELD_n, only: XZWS_DEFAULT -#endif -! -! -USE MODI_WATER_FLUX -USE MODI_MR98 -USE MODI_ECUME_SEAFLUX -USE MODI_COARE30_SEAFLUX -USE MODI_ADD_FORECAST_TO_DATE_SURF -USE MODI_MOD1D_n -USE MODI_DIAG_INLINE_SEAFLUX_n -USE MODI_CH_AER_DEP -USE MODI_CH_DEP_WATER -USE MODI_DSLT_DEP -USE MODI_SST_UPDATE -USE MODI_INTERPOL_SST_MTH -USE MODI_UPDATE_RAD_SEA -! -USE MODE_DSLT_SURF -USE MODD_DST_SURF -USE MODD_SLT_SURF -! -USE MODD_OCEAN_GRID, ONLY : NOCKMIN -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -USE MODI_ABOR1_SFX -! -USE MODI_COUPLING_ICEFLUX_n -USE MODI_SEAICE_GELATO1D_n -! -USE MODI_COUPLING_SLT_n -USE MODI_GET_LUOUT -! -IMPLICIT NONE -! -!* 0.1 declarations of arguments -! -! -TYPE(CH_SEAFLUX_t), INTENT(INOUT) :: CHS -TYPE(DATA_SEAFLUX_t), INTENT(INOUT) :: DTS -TYPE(SEAFLUX_DIAG_t), INTENT(INOUT) :: DGS -TYPE(OCEAN_t), INTENT(INOUT) :: O -TYPE(OCEAN_REL_t), INTENT(INOUT) :: OR -TYPE(GRID_t), INTENT(INOUT) :: G -TYPE(SEAFLUX_t), INTENT(INOUT) :: S -TYPE(DST_t), INTENT(INOUT) :: DST -TYPE(SLT_t), INTENT(INOUT) :: SLT -TYPE(DMS_t), INTENT(INOUT) :: DMS -! -CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes -CHARACTER(LEN=1), INTENT(IN) :: HCOUPLING ! type of coupling - ! 'E' : explicit - ! 'I' : implicit -REAL, INTENT(IN) :: PTIMEC ! current duration since start of the run (s) -INTEGER, INTENT(IN) :: KYEAR ! current year (UTC) -INTEGER, INTENT(IN) :: KMONTH ! current month (UTC) -INTEGER, INTENT(IN) :: KDAY ! current day (UTC) -REAL, INTENT(IN) :: PTIME ! current time since midnight (UTC, s) -INTEGER, INTENT(IN) :: KI ! number of points -INTEGER, INTENT(IN) :: KSV ! number of scalars -INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands -REAL, DIMENSION(KI), INTENT(IN) :: PTSUN ! solar time (s from midnight) -REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step (s) -REAL, DIMENSION(KI), INTENT(IN) :: PZREF ! height of T,q forcing (m) -REAL, DIMENSION(KI), INTENT(IN) :: PUREF ! height of wind forcing (m) -! -REAL, DIMENSION(KI), INTENT(IN) :: PTA ! air temperature forcing (K) -REAL, DIMENSION(KI), INTENT(IN) :: PQA ! air humidity forcing (kg/m3) -REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density (kg/m3) -REAL, DIMENSION(KI,KSV),INTENT(IN) :: PSV ! scalar variables -! ! chemistry: first char. in HSV: '#' (molecule/m3) -! ! -CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: HSV ! name of all scalar variables -REAL, DIMENSION(KI), INTENT(IN) :: PU ! zonal wind (m/s) -REAL, DIMENSION(KI), INTENT(IN) :: PV ! meridian wind (m/s) -REAL, DIMENSION(KI,KSW),INTENT(IN) :: PDIR_SW ! direct solar radiation (on horizontal surf.) -! ! (W/m2) -REAL, DIMENSION(KI,KSW),INTENT(IN) :: PSCA_SW ! diffuse solar radiation (on horizontal surf.) -! ! (W/m2) -REAL, DIMENSION(KSW),INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m) -REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! zenithal angle at t (radian from the vertical) -REAL, DIMENSION(KI), INTENT(IN) :: PZENITH2 ! zenithal angle at t+1(radian from the vertical) -REAL, DIMENSION(KI), INTENT(IN) :: PAZIM ! azimuthal angle (radian from North, clockwise) -REAL, DIMENSION(KI), INTENT(IN) :: PLW ! longwave radiation (on horizontal surf.) -! ! (W/m2) -REAL, DIMENSION(KI), INTENT(IN) :: PPS ! pressure at atmospheric model surface (Pa) -REAL, DIMENSION(KI), INTENT(IN) :: PPA ! pressure at forcing level (Pa) -REAL, DIMENSION(KI), INTENT(IN) :: PZWS ! significant sea wave (m) -REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration in the air (kg/m3) -REAL, DIMENSION(KI), INTENT(IN) :: PSNOW ! snow precipitation (kg/m2/s) -REAL, DIMENSION(KI), INTENT(IN) :: PRAIN ! liquid precipitation (kg/m2/s) -! -REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH ! flux of heat (W/m2) -REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ ! flux of water vapor (kg/m2/s) -REAL, DIMENSION(KI), INTENT(OUT) :: PSFU ! zonal momentum flux (Pa) -REAL, DIMENSION(KI), INTENT(OUT) :: PSFV ! meridian momentum flux (Pa) -REAL, DIMENSION(KI), INTENT(OUT) :: PSFCO2 ! flux of CO2 (m/s*kg_CO2/kg_air) -REAL, DIMENSION(KI,KSV),INTENT(OUT):: PSFTS ! flux of scalar var. (kg/m2/s) -! -REAL, DIMENSION(KI), INTENT(OUT) :: PTRAD ! radiative temperature (K) -REAL, DIMENSION(KI,KSW),INTENT(OUT):: PDIR_ALB! direct albedo for each spectral band (-) -REAL, DIMENSION(KI,KSW),INTENT(OUT):: PSCA_ALB! diffuse albedo for each spectral band (-) -REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS ! emissivity (-) -! -REAL, DIMENSION(KI), INTENT(OUT) :: PTSURF ! surface effective temperature (K) -REAL, DIMENSION(KI), INTENT(OUT) :: PZ0 ! roughness length for momentum (m) -REAL, DIMENSION(KI), INTENT(OUT) :: PZ0H ! roughness length for heat (m) -REAL, DIMENSION(KI), INTENT(OUT) :: PQSURF ! specific humidity at surface (kg/kg) -! -REAL, DIMENSION(KI), INTENT(IN) :: PPEW_A_COEF! implicit coefficients (m2s/kg) -REAL, DIMENSION(KI), INTENT(IN) :: PPEW_B_COEF! needed if HCOUPLING='I' (m/s) -REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF -REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF -REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF -REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF -CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK' -! -!* 0.2 declarations of local variables -! -REAL, DIMENSION(KI,KSW) :: ZDIR_ALB ! Direct albedo at time t -REAL, DIMENSION(KI,KSW) :: ZSCA_ALB ! Diffuse albedo at time t -! -REAL, DIMENSION(KI) :: ZEXNA ! Exner function at forcing level -REAL, DIMENSION(KI) :: ZEXNS ! Exner function at surface level -REAL, DIMENSION(KI) :: ZU ! zonal wind -REAL, DIMENSION(KI) :: ZV ! meridian wind -REAL, DIMENSION(KI) :: ZWIND ! Wind -REAL, DIMENSION(KI) :: ZCD ! Drag coefficient on open sea -REAL, DIMENSION(KI) :: ZCD_ICE ! " " on seaice -REAL, DIMENSION(KI) :: ZCDN ! Neutral Drag coefficient on open sea -REAL, DIMENSION(KI) :: ZCDN_ICE ! " " on seaice -REAL, DIMENSION(KI) :: ZCH ! Heat transfer coefficient on open sea -REAL, DIMENSION(KI) :: ZCH_ICE ! " " on seaice -REAL, DIMENSION(KI) :: ZCE ! Vaporization heat transfer coefficient on open sea -REAL, DIMENSION(KI) :: ZCE_ICE ! " " on seaice -REAL, DIMENSION(KI) :: ZRI ! Richardson number on open sea -REAL, DIMENSION(KI) :: ZRI_ICE ! " " on seaice -REAL, DIMENSION(KI) :: ZRESA_SEA ! aerodynamical resistance on open sea -REAL, DIMENSION(KI) :: ZRESA_SEA_ICE ! " " on seaice -REAL, DIMENSION(KI) :: ZUSTAR ! friction velocity (m/s) on open sea -REAL, DIMENSION(KI) :: ZUSTAR_ICE ! " " on seaice -REAL, DIMENSION(KI) :: ZZ0 ! roughness length over open sea -REAL, DIMENSION(KI) :: ZZ0_ICE ! roughness length over seaice -REAL, DIMENSION(KI) :: ZZ0H ! heat roughness length over open sea -REAL, DIMENSION(KI) :: ZZ0H_ICE ! heat roughness length over seaice -REAL, DIMENSION(KI) :: ZZ0W ! Work array for Z0 and Z0H computation -REAL, DIMENSION(KI) :: ZQSAT ! humidity at saturation on open sea -REAL, DIMENSION(KI) :: ZQSAT_ICE ! " " on seaice -! -REAL, DIMENSION(KI) :: ZSFTH ! Heat flux for open sea (and for sea-ice points if merged) -REAL, DIMENSION(KI) :: ZSFTQ ! Water vapor flux on open sea (and for sea-ice points if merged) -REAL, DIMENSION(KI) :: ZSFU ! zonal momentum flux on open sea (and for sea-ice points if merged)(Pa) -REAL, DIMENSION(KI) :: ZSFV ! meridional momentum flux on open sea (and for sea-ice points if merged)(Pa) -! -REAL, DIMENSION(KI) :: ZSFTH_ICE ! Heat flux on sea ice -REAL, DIMENSION(KI) :: ZSFTQ_ICE ! Sea-ice sublimation flux -REAL, DIMENSION(KI) :: ZSFU_ICE ! zonal momentum flux on seaice (Pa) -REAL, DIMENSION(KI) :: ZSFV_ICE ! meridional momentum flux on seaice (Pa) - -REAL, DIMENSION(KI) :: ZHU ! Near surface relative humidity -REAL, DIMENSION(KI) :: ZQA ! specific humidity (kg/kg) -REAL, DIMENSION(KI) :: ZEMIS ! Emissivity at time t -REAL, DIMENSION(KI) :: ZTRAD ! Radiative temperature at time t -REAL, DIMENSION(KI) :: ZHS ! significant wave height -REAL, DIMENSION(KI) :: ZTP ! peak period -! -REAL, DIMENSION(KI) :: ZSST ! XSST corrected for anomalously low values (which actually are sea-ice temp) -REAL, DIMENSION(KI) :: ZMASK ! A mask for diagnosing where seaice exists (or, for coupling_iceflux, may appear) -REAL, DIMENSION(KI) :: DMS_WATER ! DMS oceanic content (mol m-3) based on Lana et al. 2011 database -REAL, DIMENSION(KI) :: ZFLUX_DMS ! DMS flux -! -REAL :: ZCONVERTFACM0_SLT, ZCONVERTFACM0_DST -REAL :: ZCONVERTFACM3_SLT, ZCONVERTFACM3_DST -REAL :: ZCONVERTFACM6_SLT, ZCONVERTFACM6_DST -! -INTEGER :: ISIZE_WATER ! number of points with some sea water -INTEGER :: ISIZE_ICE ! number of points with some sea ice -! -INTEGER :: ISWB ! number of shortwave spectral bands -INTEGER :: JSWB ! loop counter on shortwave spectral bands -! -INTEGER :: IBEG, IEND -INTEGER :: ISLT, IDST, JSV, IMOMENT ! number of sea salt, dust variables -! -INTEGER :: ILUOUT -INTEGER :: JP_DMS -! -REAL(KIND=JPRB) :: ZHOOK_HANDLE - -!------------------------------------------------------------------------------------- -! Preliminaries: -!------------------------------------------------------------------------------------- -CALL GET_LUOUT(HPROGRAM,ILUOUT) -IF (LHOOK) CALL DR_HOOK('COUPLING_SEAFLUX_N',0,ZHOOK_HANDLE) -IF (HTEST/='OK') THEN - CALL ABOR1_SFX('COUPLING_SEAFLUXN: FATAL ERROR DURING ARGUMENT TRANSFER') -END IF -!------------------------------------------------------------------------------------- -! -ZEXNA (:) = XUNDEF -ZEXNS (:) = XUNDEF -ZU (:) = XUNDEF -ZV (:) = XUNDEF -ZWIND (:) = XUNDEF -ZSFTQ (:) = XUNDEF -ZSFTH (:) = XUNDEF -ZCD (:) = XUNDEF -ZCDN (:) = XUNDEF -ZCH (:) = XUNDEF -ZCE (:) = XUNDEF -ZRI (:) = XUNDEF -ZHU (:) = XUNDEF -ZRESA_SEA(:) = XUNDEF -ZUSTAR (:) = XUNDEF -ZZ0 (:) = XUNDEF -ZZ0H (:) = XUNDEF -ZQSAT (:) = XUNDEF -ZHS (:) = XUNDEF -ZTP (:) = XUNDEF -! -ZSFTQ_ICE(:) = XUNDEF -ZSFTH_ICE(:) = XUNDEF -ZCD_ICE (:) = XUNDEF -ZCDN_ICE (:) = XUNDEF -ZCH_ICE (:) = XUNDEF -ZCE_ICE (:) = XUNDEF -ZRI_ICE (:) = XUNDEF -ZRESA_SEA_ICE= XUNDEF -ZUSTAR_ICE(:) = XUNDEF -ZZ0_ICE (:) = XUNDEF -ZZ0H_ICE (:) = XUNDEF -ZQSAT_ICE(:) = XUNDEF -! -ZEMIS (:) = XUNDEF -ZTRAD (:) = XUNDEF -ZDIR_ALB (:,:) = XUNDEF -ZSCA_ALB (:,:) = XUNDEF -! -!------------------------------------------------------------------------------------- -! -ZEXNS(:) = (PPS(:)/XP00)**(XRD/XCPD) -ZEXNA(:) = (PPA(:)/XP00)**(XRD/XCPD) -! -IF(LCPL_SEA .OR. LCPL_WAVE)THEN - !Sea currents are taken into account - ZU(:)=PU(:)-S%XUMER(:) - ZV(:)=PV(:)-S%XVMER(:) -ELSE - ZU(:)=PU(:) - ZV(:)=PV(:) -ENDIF -! -ZWIND(:) = SQRT(ZU(:)**2+ZV(:)**2) -! -PSFTS(:,:) = 0. -! -ZHU = 1. -! -ZQA(:) = PQA(:) / PRHOA(:) - -! HS value from ECMWF file -ZHS(:) = PZWS(:) -#ifdef CPLOASIS -! HS value from WW3 if activated -IF (LCPL_WAVE) THEN - ZHS(:)=S%XHS(:) - ZTP(:)=S%XTP(:) -ELSE - ZHS(:)=PZWS(:) - ZTP(:)=S%XTP(:) -END IF -#endif -! if HS value is undef : constant value and alert message -IF (ALL(ZHS==XUNDEF)) THEN -#ifdef SFX_MNH - ZHS(:) = XZWS_DEFAULT - WRITE (ILUOUT,*) 'WARNING : no HS values from ECMWF or WW3, then it is initialized to a constant value of XZWS_DEFAULT m' -#else - ZHS(:)=2. - WRITE (ILUOUT,*) 'WARNING : no HS values from ECMWF or WW3, then it is initialized to a constant value of 2 m' -#endif -END IF -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Time evolution -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! -S%TTIME%TIME = S%TTIME%TIME + PTSTEP - CALL ADD_FORECAST_TO_DATE_SURF(S%TTIME%TDATE%YEAR,S%TTIME%TDATE%MONTH,S%TTIME%TDATE%DAY,S%TTIME%TIME) -! -!-------------------------------------------------------------------------------------- -! Fluxes over water according to Charnock formulae -!-------------------------------------------------------------------------------------- -! -IF (S%LHANDLE_SIC) THEN - ! Flux for sea are computed everywhere - ISIZE_WATER = SIZE(ZMASK) - ! Ensure freezing SST values where XSST actually has very low (sea-ice) values (old habits) - ZSST(:)=MAX(S%XSST(:), XTTSI) - ! Flux over sea-ice will not be computed by next calls, but by coupling_iceflux. Hence : - ISIZE_ICE = 0 - ! Flux over sea-ice will be computed by coupling_iceflux anywhere sea-ice could form in one - ! time-step (incl. under forcing). ZMASK value is set to 1. on these points - ZMASK(:)=0. - WHERE ( S%XSIC(:) > 0. ) ZMASK(:)=1. - ! To be large, assume that seaice may form where SST is < 10C - WHERE ( S%XSST(:) - XTTS <= 10. ) ZMASK(:)=1. - IF (S%LINTERPOL_SIC) WHERE (S%XFSIC(:) > 0. ) ZMASK(:)=1. - IF (S%LINTERPOL_SIT) WHERE (S%XFSIT(:) > 0. ) ZMASK(:)=1. -ELSE - ZSST (:) = S%XSST(:) - ZMASK(:) = S%XSST(:) - XTTS - ISIZE_WATER = COUNT(ZMASK(:)>=0.) - ISIZE_ICE = SIZE(S%XSST) - ISIZE_WATER -ENDIF -! -SELECT CASE (S%CSEA_FLUX) -CASE ('DIRECT') -CALL WATER_FLUX(S%XZ0, PTA, ZEXNA, PRHOA, ZSST, ZEXNS, ZQA, & - PRAIN, PSNOW, XTTS, ZWIND, PZREF, PUREF, & - PPS, S%LHANDLE_SIC, ZQSAT, ZSFTH, ZSFTQ, & - ZUSTAR, ZCD, ZCDN, ZCH, ZRI, ZRESA_SEA, ZZ0H ) -CASE ('ITERAT') -CALL MR98 (S%XZ0, PTA, ZEXNA, PRHOA, S%XSST, ZEXNS, ZQA, & - XTTS, ZWIND, PZREF, PUREF, PPS, ZQSAT, & - ZSFTH, ZSFTQ, ZUSTAR, & - ZCD, ZCDN, ZCH, ZRI, ZRESA_SEA, ZZ0H ) - -CASE ('ECUME ','ECUME6') -CALL ECUME_SEAFLUX(S, ZMASK, ISIZE_WATER, ISIZE_ICE, & - PTA, ZEXNA ,PRHOA, ZSST, ZEXNS, ZQA, & - PRAIN, PSNOW, ZWIND, PZREF, PUREF, PPS, PPA, & - ZQSAT, ZSFTH, ZSFTQ, ZUSTAR, & - ZCD, ZCDN, ZCH, ZCE, ZRI, ZRESA_SEA, ZZ0H ) -CASE ('COARE3') -CALL COARE30_SEAFLUX(S, ZMASK, ISIZE_WATER, ISIZE_ICE, & - PTA, ZEXNA ,PRHOA, ZSST, ZEXNS, ZQA, PRAIN, & - PSNOW, ZWIND, PZREF, PUREF, PPS, ZQSAT, & - ZSFTH, ZSFTQ, ZUSTAR, & - ZCD, ZCDN, ZCH, ZCE, ZRI, ZRESA_SEA, ZZ0H ) -END SELECT - -#ifdef CPLOASIS -IF (.NOT. LCPL_WAVE) THEN - S%XHS(:)=ZHS(:) - S%XTP(:)=ZTP(:) -END IF -#endif - -! -!------------------------------------------------------------------------------------- -!radiative properties at time t -!------------------------------------------------------------------------------------- -! -ISWB = SIZE(PSW_BANDS) -! -DO JSWB=1,ISWB -ZDIR_ALB(:,JSWB) = S%XDIR_ALB(:) -ZSCA_ALB(:,JSWB) = S%XSCA_ALB(:) -END DO -! -IF (S%LHANDLE_SIC) THEN -ZEMIS(:) = (1 - S%XSIC(:)) * XEMISWAT + S%XSIC(:) * XEMISWATICE -ZTRAD(:) = (((1 - S%XSIC(:)) * XEMISWAT * S%XSST (:)**4 + & - S%XSIC(:) * XEMISWATICE * S%XTICE(:)**4)/ ZEMIS(:)) ** 0.25 -ELSE -ZTRAD(:) = S%XSST (:) -ZEMIS(:) = S%XEMIS(:) -END IF -! -!------------------------------------------------------------------------------------- -!Specific fields for seaice model (when using earth system model or embedded -!seaice scheme) -!------------------------------------------------------------------------------------- -! -IF(LCPL_SEAICE.OR.S%LHANDLE_SIC)THEN -CALL COUPLING_ICEFLUX_n(KI, PTA, ZEXNA, PRHOA, S%XTICE, ZEXNS, & - ZQA, PRAIN, PSNOW, ZWIND, PZREF, PUREF, & - PPS, S%XSST, XTTS, ZSFTH_ICE, ZSFTQ_ICE, & - S%LHANDLE_SIC, ZMASK, ZQSAT_ICE, ZZ0_ICE, & - ZUSTAR_ICE, ZCD_ICE, ZCDN_ICE, ZCH_ICE, & - ZRI_ICE, ZRESA_SEA_ICE, ZZ0H_ICE ) -ENDIF -! -IF (S%LHANDLE_SIC) CALL COMPLEMENT_EACH_OTHER_FLUX -! -!------------------------------------------------------------------------------------- -! Momentum fluxes over sea or se-ice -!------------------------------------------------------------------------------------- -! -CALL SEA_MOMENTUM_FLUXES(ZCD, ZSFU, ZSFV) -! -! Momentum fluxes over sea-ice if embedded seaice scheme is used -! -IF (S%LHANDLE_SIC) CALL SEA_MOMENTUM_FLUXES(ZCD_ICE, ZSFU_ICE, ZSFV_ICE) -! -! CO2 flux -! -PSFCO2(:) = 0.0 -! -!IF(LCPL_SEA.AND.CSEACO2=='NONE')THEN -! PSFCO2(:) = XSEACO2(:) -!ELSEIF(CSEACO2=='CST ')THEN -! PSFCO2 = E * deltapCO2 -! According to Wanninkhof (medium hypothesis) : -! E = 1.13.10^-3 * WIND^2 CO2mol.m-2.yr-1.uatm-1 -! = 1.13.10^-3 * WIND^2 * Mco2.10^-3 * (1/365*24*3600) -! deltapCO2 = -8.7 uatm (Table 1 half hypothesis) -PSFCO2(:) = - ZWIND(:)**2 * 1.13E-3 * 8.7 * 44.E-3 / ( 365*24*3600 ) -!ENDIF -! -!------------------------------------------------------------------------------------- -! Scalar fluxes: -!------------------------------------------------------------------------------------- -! -IF (CHS%SVS%NBEQ>0.AND.(KI.GT.0)) THEN -! - - IF (CHS%CCH_DRY_DEP == "WES89") THEN - ! - IBEG = CHS%SVS%NSV_CHSBEG - IEND = CHS%SVS%NSV_CHSEND - ! - CALL CH_DEP_WATER (ZRESA_SEA, ZUSTAR, PTA, ZTRAD,PSV(:,IBEG:IEND), & - CHS%SVS%CSV(IBEG:IEND), CHS%XDEP(:,1:CHS%SVS%NBEQ) ) - ! - PSFTS(:,IBEG:IEND) = - PSV(:,IBEG:IEND) * CHS%XDEP(:,1:CHS%SVS%NBEQ) - ! - IF (CHS%SVS%NAEREQ > 0 ) THEN - ! - IBEG = CHS%SVS%NSV_AERBEG - IEND = CHS%SVS%NSV_AEREND - ! - CALL CH_AER_DEP(PSV(:,IBEG:IEND),PSFTS(:,IBEG:IEND),ZUSTAR,ZRESA_SEA,PTA,PRHOA) - ! - END IF - - ! - ELSE - ! - IBEG = CHS%SVS%NSV_AERBEG - IEND = CHS%SVS%NSV_AEREND - ! - PSFTS(:,IBEG:IEND) =0. - IF (IEND.GT.IBEG) PSFTS(:,IBEG:IEND) =0. - ! - ENDIF - ! -! DMS flux -DMS_WATER(:) = DMS%XDMS(:) ! nmol.dm-3 -DMS_WATER(:) = DMS_WATER(:) *1E-6*XAVOGADRO ! molec. m-3 -JP_DMS = 0 -DO JSV=CHS%SVS%NSV_CHSBEG,CHS%SVS%NSV_CHSEND - IF (TRIM(CHS%SVS%CSV(JSV)) == "DMS") JP_DMS=JSV -ENDDO - -IF (JP_DMS .GT. 0) THEN - ZFLUX_DMS(:) = 0. - CALL COUPLING_DMS_n(SIZE(ZUSTAR,1),& !! number of sea points - ZWIND,& !! wind velocity (m s-1) - S%XSST,& !! sea surface temperature (K) - DMS_WATER,& !! DMS oceanic content (mol m-3) - ZFLUX_DMS) !! DMS emission flux (mol m-2 s-1) - PSFTS(:,JP_DMS) = PSFTS(:,JP_DMS) + ZFLUX_DMS(:) - -ENDIF ! DMS - -ENDIF -! -IF (CHS%SVS%NDSTEQ>0.AND.(KI.GT.0)) THEN - ! - IBEG = CHS%SVS%NSV_DSTBEG - IEND = CHS%SVS%NSV_DSTEND - ! - CALL DSLT_DEP(PSV(:,IBEG:IEND), PSFTS(:,IBEG:IEND), ZUSTAR, ZRESA_SEA, PTA, & - PRHOA, DST%XEMISSIG_DST, DST%XEMISRADIUS_DST, JPMODE_DST, & - XDENSITY_DST, XMOLARWEIGHT_DST, ZCONVERTFACM0_DST, ZCONVERTFACM6_DST, & - ZCONVERTFACM3_DST, LVARSIG_DST, LRGFIX_DST, CVERMOD ) - ! - CALL MASSFLUX2MOMENTFLUX( & - PSFTS(:,IBEG:IEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments - PRHOA, & !I [kg/m3] air density - DST%XEMISRADIUS_DST, &!I [um] emitted radius for the modes (max 3) - DST%XEMISSIG_DST, &!I [-] emitted sigma for the different modes (max 3) - NDSTMDE, & - ZCONVERTFACM0_DST, & - ZCONVERTFACM6_DST, & - ZCONVERTFACM3_DST, & - LVARSIG_DST, LRGFIX_DST ) - ! -ENDIF - -! -IF (CHS%SVS%NSLTEQ>0.AND.(KI.GT.0)) THEN - ! - IBEG = CHS%SVS%NSV_SLTBEG - IEND = CHS%SVS%NSV_SLTEND - - ! - ISLT = IEND - IBEG + 1 - ! - CALL COUPLING_SLT_n(SLT, & - SIZE(ZUSTAR,1), & !I [nbr] number of sea point - ISLT, & !I [nbr] number of sea salt variables - ZWIND, & !I [m/s] wind velocity - ZHS, & !I [m] significant sea wave - S%XSST, & - ZUSTAR, & - PSFTS(:,IBEG:IEND) ) - - ! - CALL DSLT_DEP(PSV(:,IBEG:IEND), PSFTS(:,IBEG:IEND), ZUSTAR, ZRESA_SEA, PTA, & - PRHOA, SLT%XEMISSIG_SLT, SLT%XEMISRADIUS_SLT, JPMODE_SLT, & - XDENSITY_SLT, XMOLARWEIGHT_SLT, ZCONVERTFACM0_SLT, ZCONVERTFACM6_SLT, & - ZCONVERTFACM3_SLT, LVARSIG_SLT, LRGFIX_SLT, CVERMOD ) - ! - CALL MASSFLUX2MOMENTFLUX( & - PSFTS(:,IBEG:IEND), & !I/O [kg/m2/sec] In: flux of only mass, out: flux of moments - PRHOA, & !I [kg/m3] air density - SLT%XEMISRADIUS_SLT, & !I [um] emitted radius for the modes (max 3) - SLT%XEMISSIG_SLT, & !I [-] emitted sigma for the different modes (max 3) - NSLTMDE, & - ZCONVERTFACM0_SLT, & - ZCONVERTFACM6_SLT, & - ZCONVERTFACM3_SLT, & - LVARSIG_SLT, LRGFIX_SLT ) - ! -ENDIF -! -!------------------------------------------------------------------------------- -! Inline diagnostics at time t for SST and TRAD -!------------------------------------------------------------------------------- -! -CALL DIAG_INLINE_SEAFLUX_n(DGS%O, DGS%D, DGS%DC, DGS%DI, DGS%DIC, DGS%DMI, & - S, PTSTEP, PTA, ZQA, PPA, PPS, PRHOA, PU, & - PV, PZREF, PUREF, ZCD, ZCDN, ZCH, ZCE, ZRI, ZHU,& - ZZ0H, ZQSAT, ZSFTH, ZSFTQ, ZSFU, ZSFV, & - PDIR_SW, PSCA_SW, PLW, ZDIR_ALB, ZSCA_ALB, & - ZEMIS, ZTRAD, PRAIN, PSNOW, & - ZCD_ICE, ZCDN_ICE, ZCH_ICE, ZCE_ICE, ZRI_ICE, & - ZZ0_ICE, ZZ0H_ICE, ZQSAT_ICE, ZSFTH_ICE, & - ZSFTQ_ICE, ZSFU_ICE, ZSFV_ICE) -! -!------------------------------------------------------------------------------- -! A kind of "average_flux" -!------------------------------------------------------------------------------- -! -IF (S%LHANDLE_SIC) THEN - PSFTH (:) = ZSFTH (:) * ( 1 - S%XSIC (:)) + ZSFTH_ICE(:) * S%XSIC(:) - PSFTQ (:) = ZSFTQ (:) * ( 1 - S%XSIC (:)) + ZSFTQ_ICE(:) * S%XSIC(:) - PSFU (:) = ZSFU (:) * ( 1 - S%XSIC (:)) + ZSFU_ICE(:) * S%XSIC(:) - PSFV (:) = ZSFV (:) * ( 1 - S%XSIC (:)) + ZSFV_ICE(:) * S%XSIC(:) -ELSE - PSFTH (:) = ZSFTH (:) - PSFTQ (:) = ZSFTQ (:) - PSFU (:) = ZSFU (:) - PSFV (:) = ZSFV (:) -ENDIF -! -!------------------------------------------------------------------------------- -! IMPOSED SSS OR INTERPOLATED SSS AT TIME t+1 -!------------------------------------------------------------------------------- -! -! Daily update Sea surface salinity from monthly data -! -IF (S%LINTERPOL_SSS .AND. MOD(S%TTIME%TIME,XDAY) == 0.) THEN - CALL INTERPOL_SST_MTH(S,'S') - IF (ANY(S%XSSS(:)<0.0)) THEN - CALL ABOR1_SFX('COUPLING_SEAFLUX_N: XSSS should be >=0') - ENDIF -ENDIF -! -!------------------------------------------------------------------------------- -! SEA-ICE coupling at time t+1 -!------------------------------------------------------------------------------- -! -IF (S%LHANDLE_SIC) THEN - ! - IF (S%LINTERPOL_SIC) THEN - IF ((MOD(S%TTIME%TIME,XDAY) == 0.) .OR. (PTIMEC <= PTSTEP )) THEN - ! Daily update Sea Ice Cover constraint from monthly data - CALL INTERPOL_SST_MTH(S,'C') - IF (ANY(S%XFSIC(:)>1.0).OR.ANY(S%XFSIC(:)<0.0)) THEN - CALL ABOR1_SFX('COUPLING_SEAFLUX_N: FSIC should be >=0 and <=1') - ENDIF - ENDIF - ENDIF - ! - IF (S%LINTERPOL_SIT) THEN - IF ((MOD(S%TTIME%TIME,XDAY) == 0.) .OR. (PTIMEC <= PTSTEP )) THEN - ! Daily update Sea Ice Thickness constraint from monthly data - CALL INTERPOL_SST_MTH(S,'H') - IF (ANY(S%XFSIT(:)<0.0)) THEN - CALL ABOR1_SFX('COUPLING_SEAFLUX_N: XFSIT should be >=0') - ENDIF - ENDIF - ENDIF - ! - IF (S%CSEAICE_SCHEME=='GELATO') THEN - CALL SEAICE_GELATO1D_n(S, HPROGRAM,PTIMEC, PTSTEP) - ENDIF - ! Update of cell-averaged albedo, emissivity and radiative - ! temperature is done later -ENDIF -! -!------------------------------------------------------------------------------- -! OCEANIC COUPLING, IMPOSED SST OR INTERPOLATED SST AT TIME t+1 -!------------------------------------------------------------------------------- -! -IF (O%LMERCATOR) THEN - ! - ! Update SST reference profile for relaxation purpose - IF (DTS%LSST_DATA) THEN - CALL SST_UPDATE(DTS, S, OR%XSEAT_REL(:,NOCKMIN+1)) - ! - ! Convert to degree C for ocean model - OR%XSEAT_REL(:,NOCKMIN+1) = OR%XSEAT_REL(:,NOCKMIN+1) - XTT - ENDIF - ! - CALL MOD1D_n(DGS%GO, O, OR, G%XLAT, S, & - HPROGRAM,PTIME,ZEMIS(:),ZDIR_ALB(:,1:KSW),ZSCA_ALB(:,1:KSW),& - PLW(:),PSCA_SW(:,1:KSW),PDIR_SW(:,1:KSW),PSFTH(:), & - PSFTQ(:),PSFU(:),PSFV(:),PRAIN(:)) - ! -ELSEIF(DTS%LSST_DATA) THEN - ! - ! Imposed SST - ! - CALL SST_UPDATE(DTS, S, S%XSST) - ! -ELSEIF (S%LINTERPOL_SST.AND.MOD(S%TTIME%TIME,XDAY) == 0.) THEN - ! - ! Imposed monthly SST - ! - CALL INTERPOL_SST_MTH(S,'T') - ! -ENDIF -! -!------------------------------------------------------------------------------- -!Physical properties see by the atmosphere in order to close the energy budget -!between surfex and the atmosphere. All variables should be at t+1 but very -!difficult to do. Maybe it will be done later. However, Ts is at time t+1 -!------------------------------------------------------------------------------- -! -IF (S%LHANDLE_SIC) THEN - IF (S%CSEAICE_SCHEME/='GELATO') THEN - S%XTICE = S%XSST - S%XSIC = S%XFSIC - S%XICE_ALB = XALBSEAICE - ENDIF - PTSURF (:) = S%XSST(:) * ( 1 - S%XSIC (:)) + S%XTICE(:) * S%XSIC(:) - PQSURF (:) = ZQSAT (:) * ( 1 - S%XSIC (:)) + ZQSAT_ICE(:) * S%XSIC(:) - ZZ0W (:) = ( 1 - S%XSIC(:) ) * 1.0/(LOG(PUREF(:)/ZZ0(:)) **2) + & - S%XSIC(:) * 1.0/(LOG(PUREF(:)/ZZ0_ICE(:))**2) - PZ0 (:) = PUREF (:) * EXP ( - SQRT ( 1./ ZZ0W(:) )) - ZZ0W (:) = ( 1 - S%XSIC(:) ) * 1.0/(LOG(PZREF(:)/ZZ0H(:)) **2) + & - S%XSIC(:) * 1.0/(LOG(PZREF(:)/ZZ0H_ICE(:))**2) - PZ0H (:) = PZREF (:) * EXP ( - SQRT ( 1./ ZZ0W(:) )) -ELSE - PTSURF (:) = S%XSST(:) - PQSURF (:) = ZQSAT (:) - PZ0 (:) = S%XZ0 (:) - PZ0H (:) = ZZ0H (:) -ENDIF -! -!------------------------------------------------------------------------------- -!Radiative properties at time t+1 (see by the atmosphere) in order to close -!the energy budget between surfex and the atmosphere -!------------------------------------------------------------------------------- -! - CALL UPDATE_RAD_SEA(S,PZENITH2,XTTS,PDIR_ALB,PSCA_ALB,PEMIS,PTRAD,PU,PV) -! -!======================================================================================= -! -IF (LHOOK) CALL DR_HOOK('COUPLING_SEAFLUX_N',1,ZHOOK_HANDLE) -! -!======================================================================================= -! -CONTAINS -! -SUBROUTINE SEA_MOMENTUM_FLUXES(PCD, PSFU, PSFV) -! -IMPLICIT NONE -! -REAL, DIMENSION(KI), INTENT(IN) :: PCD ! Drag coefficient (on open sea or seaice) -REAL, DIMENSION(KI), INTENT(OUT) :: PSFU ! zonal momentum flux (Pa) -REAL, DIMENSION(KI), INTENT(OUT) :: PSFV ! meridian momentum flux (Pa) -! -REAL, DIMENSION(KI) :: ZUSTAR2 ! square of friction velocity (m2/s2) -REAL, DIMENSION(KI) :: ZWORK ! Work array -! -REAL, DIMENSION(KI) :: ZPEW_A_COEF -REAL, DIMENSION(KI) :: ZPEW_B_COEF -! -REAL(KIND=JPRB) :: ZHOOK_HANDLE -! -IF (LHOOK) CALL DR_HOOK('COUPLING_SEAFLUX_N: SEA_MOMENTUM_FLUXES',0,ZHOOK_HANDLE) -! -IF( (LCPL_SEA .OR. LCPL_WAVE) .AND. HCOUPLING .EQ. 'E')THEN - ZPEW_A_COEF(:)=0.0 - ZPEW_B_COEF(:)=ZWIND(:) -ELSE - ZPEW_A_COEF(:)=PPEW_A_COEF(:) - ZPEW_B_COEF(:)=PPEW_B_COEF(:) -ENDIF -! -ZWORK (:) = XUNDEF -ZUSTAR2(:) = XUNDEF -! -IF(CIMPLICIT_WIND=='OLD')THEN -! old implicitation (m2/s2) - ZUSTAR2(:) = (PCD(:)*ZWIND(:)*ZPEW_B_COEF(:)) / & - (1.0-PRHOA(:)*PCD(:)*ZWIND(:)*ZPEW_A_COEF(:)) -ELSE -! new implicitation (m2/s2) - ZUSTAR2(:) = (PCD(:)*ZWIND(:)*(2.*ZPEW_B_COEF(:)-ZWIND(:))) /& - (1.0-2.0*PRHOA(:)*PCD(:)*ZWIND(:)*ZPEW_A_COEF(:)) -! - ZWORK(:) = PRHOA(:)*PPEW_A_COEF(:)*ZUSTAR2(:) + ZPEW_B_COEF(:) - ZWORK(:) = MAX(ZWORK(:),0.) -! - WHERE(ZPEW_A_COEF(:)/= 0.) - ZUSTAR2(:) = MAX( ( ZWORK(:) - PPEW_B_COEF(:) ) / (PRHOA(:)*ZPEW_A_COEF(:)), 0.) - ENDWHERE -! -ENDIF -! -PSFU = 0. -PSFV = 0. -WHERE (ZWIND(:)>0.) - PSFU(:) = - PRHOA(:) * ZUSTAR2(:) * ZU(:) / ZWIND(:) - PSFV(:) = - PRHOA(:) * ZUSTAR2(:) * ZV(:) / ZWIND(:) -END WHERE -! -IF (LHOOK) CALL DR_HOOK('COUPLING_SEAFLUX_N: SEA_MOMENTUM_FLUXES',1,ZHOOK_HANDLE) -! -END SUBROUTINE SEA_MOMENTUM_FLUXES -! -!======================================================================================= -! -SUBROUTINE COMPLEMENT_EACH_OTHER_FLUX -! -! Provide dummy fluxes on places with no open-sea or no sea-ice -! Allows a smooth computing of CLS parameters in all cases while avoiding -! having to pack arrays (in routines PARAM_CLS and CLS_TQ) -! -IMPLICIT NONE -! -REAL(KIND=JPRB) :: ZHOOK_HANDLE -! -IF (LHOOK) CALL DR_HOOK('COUPLING_SEAFLUX_N: COMPLEMENT_EACH_OTHER_FLUX',0,ZHOOK_HANDLE) -! - WHERE (S%XSIC(:) == 1.) - ZSFTH=ZSFTH_ICE - ZSFTQ=ZSFTQ_ICE - ZSFU=ZSFU_ICE - ZSFV=ZSFV_ICE - ZQSAT=ZQSAT_ICE - ZCD=ZCD_ICE - ZCDN=ZCDN_ICE - ZCH=ZCH_ICE - ZCE=ZCE_ICE - ZRI=ZRI_ICE - ZZ0H=ZZ0H_ICE - END WHERE - WHERE (S%XSIC(:) == 0.) - ZSFTH_ICE=ZSFTH - ZSFTQ_ICE=ZSFTQ - ZSFU_ICE=ZSFU - ZSFV_ICE=ZSFV - ZQSAT_ICE=ZQSAT - ZCD_ICE=ZCD - ZCDN_ICE=ZCDN - ZCH_ICE=ZCH - ZCE_ICE=ZCE - ZRI_ICE=ZRI - ZZ0H_ICE=ZZ0H - END WHERE -! -IF (LHOOK) CALL DR_HOOK('COUPLING_SEAFLUX_N: COMPLEMENT_EACH_OTHER_FLUX',1,ZHOOK_HANDLE) -! -END SUBROUTINE COMPLEMENT_EACH_OTHER_FLUX -! -!======================================================================================= -! -END SUBROUTINE COUPLING_SEAFLUX_n diff --git a/src/ICCARE_BASE/coupling_sltn.F90 b/src/ICCARE_BASE/coupling_sltn.F90 deleted file mode 100644 index 3db0c7b1a..000000000 --- a/src/ICCARE_BASE/coupling_sltn.F90 +++ /dev/null @@ -1,303 +0,0 @@ -!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -SUBROUTINE COUPLING_SLT_n (SLT, & - KI, &!I [nbr] number of sea points - KSLT, &!I [nbr] number of sea salt variables - PWIND, &!I Wind velocity -! ++ PIERRE / MARINE SSA - MODIF ++ - PWHEIGHT, &! Significant height of wind-generated waves (in ECMWF analyses) - ! local pour l'instant, PWHEIGHT plus tard - PSST, &! Sea water temperature (C) - PUSTAR, &! Friction velocity (ecmwf?) Calcule dans coupling_seafluxn.F90 -! -- PIERRE / MARINE SSA - MODIF -- - PSFSLT &!O [kg/m2/sec] production flux of sea salt - ) - -!PURPOSE -!------- -! Compute sea salt emission upon Vignatti et al, 2001 -! Compute sea salt emission upon Ovadnevaite et al, 2014 -! Compute sea salt emission upon Ovadnevaite et al, 2014 and Bruch et al. 2021 -! -!AUTHOR -!------- -! P. Tulet -! -! -USE MODD_SLT_n, ONLY : SLT_t -! -USE MODD_CSTS, ONLY : XAVOGADRO, XPI -USE MODD_SLT_SURF -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -IMPLICIT NONE -! -!INPUT -! -TYPE(SLT_t), INTENT(INOUT) :: SLT -! -INTEGER, INTENT(IN) :: KI !I Number of sea points -INTEGER, INTENT(IN) :: KSLT !I Number of sea salt emission variables -REAL, DIMENSION(KI), INTENT(IN) :: PWIND !I wind velocity -REAL, DIMENSION(KI,KSLT), INTENT(OUT) :: PSFSLT !Out: kg/m2/s (index #2) -! ++ PIERRE / MARINE SSA - MODIF ++ -REAL, DIMENSION(KI), INTENT(INOUT) :: PWHEIGHT !Significant height of wind-generated waves (in ECMWF analyses) -REAL, DIMENSION(KI), INTENT(IN) :: PUSTAR !Friction velocity (ecmwf?) : Unite: m.s^(-2)? -REAL, DIMENSION(KI), INTENT(IN) :: PSST ! Sea surface temperature (K) -REAL, DIMENSION(KI) :: MSS ! Variance de Pente de vague -REAL, DIMENSION(KI) :: PWIND12 ! Vent 12m -! -- PIERRE / MARINE SSA - MODIF -- - -!LOCAL VARIABLES -REAL,DIMENSION(KI,JPMODE_SLT) :: ZSFSLT_MDE ! sea salt flux from modes -INTEGER :: JN, JI, II !Counter for sea salt modes -REAL, DIMENSION(KI) :: DZSPEED -INTEGER, DIMENSION(KI) :: WCL -REAL :: ZCONVERTFACM0_SLT ![kg/mole*mole/molec] conversion factor - !for moment fluxes and used fluxes -REAL :: ZCONVERTFACM3_SLT -REAL :: ZCONVERTFACM6_SLT -! -! ++ PIERRE / MARINE SSA - MODIF ++ - -REAL, DIMENSION(5) :: ZNUWATER ! Temperature-dependant kinematic viscosity of - ! sea-water (table of data to interpolate) (m².s-¹) -REAL, DIMENSION(5) :: ZWT ! Sea water temperature in table -REAL, DIMENSION(KI) :: ZREYNOLDS ! Reynolds Number -REAL, DIMENSION(KI) :: ZHVAGUE ! sea wave height from wind if ZWS is unknown. -REAL, DIMENSION(KI) :: ZVISCO ! Temperature-dependant kinematic viscosity - ! of sea-water interpolated -! -- PIERRE / MARINE SSA - MODIF -- -! -!REAL, PARAMETER :: mass1flux(0:40) = (/ & -! 0.000E+00, 2.483E-15, 2.591E-14, 1.022E-13, 2.707E-13, 5.761E-13, & -! 1.068E-12, 1.800E-12, 2.829E-12, 4.215E-12, 6.023E-12, 8.317E-12, & -! 1.117E-11, 1.464E-11, 1.882E-11, 2.378E-11, 2.959E-11, 3.633E-11, & -! 4.409E-11, 5.296E-11, 6.301E-11, 7.433E-11, 8.693E-11, 1.012E-10, & -! 1.168E-10, 1.342E-10, 1.532E-10, 1.741E-10, 1.970E-10, 2.219E-10, & -! 2.489E-10, 2.781E-10, 3.097E-10, 3.437E-10, 3.803E-10, 4.195E-10, & -! 4.616E-10, 5.065E-10, 5.544E-10, 6.054E-10, 6.711E-10 /) - -!REAL, PARAMETER :: mass2flux(0:40) = (/ & -! 0.000E+00, 2.319E-13, 2.411E-12, 9.481E-12, 2.505E-11, 5.321E-11, & -! 9.850E-11, 1.658E-10, 2.602E-10, 3.874E-10, 5.529E-10, 7.628E-10, & -! 1.023E-09, 1.341E-09, 1.722E-09, 2.175E-09, 2.704E-09, 3.319E-09, & -! 4.026E-09, 4.832E-09, 5.746E-09, 6.776E-09, 7.925E-09, 9.214E-09, & -! 1.064E-08, 1.221E-08, 1.394E-08, 1.584E-08, 1.791E-08, 2.016E-08, & -! 2.261E-08, 2.526E-08, 2.812E-08, 3.120E-08, 3.451E-08, 3.806E-08, & -! 4.186E-08, 4.592E-08, 5.025E-08, 5.486E-08, 6.014E-08 /) - -!REAL, PARAMETER :: mass3flux(0:40) = (/ 0.0, & -! 1.783E-12, 1.579E-11, 5.852E-11, 1.501E-10, 3.134E-10, 5.740E-10, & -! 9.597E-10, 1.500E-09, 2.227E-09, 3.175E-09, 4.378E-09, 5.872E-09, & -! 7.698E-09, 9.897E-09, 1.250E-08, 1.556E-08, 1.912E-08, 2.323E-08, & -! 2.792E-08, 3.325E-08, 3.927E-08, 4.608E-08, 5.356E-08, 6.194E-08, & -! 7.121E-08, 8.143E-08, 9.266E-08, 1.049E-07, 1.183E-07, 1.329E-07, & -! 1.487E-07, 1.658E-07, 1.843E-07, 2.041E-07, 2.255E-07, 2.484E-07, & -! 2.729E-07, 2.991E-07, 3.270E-07, 3.517E-07 /) - -REAL, PARAMETER :: HVAGUE(1:9) = (/ 0., 0.1, 0.5, 1.25, 2.5, 4., 6., 9., 14. /) -REAL, PARAMETER :: VVENT(1:9) = (/ 1., 2.7, 4.1, 6.3, 8.3, 11.1, 13.8, & - 16.6, 19.4/) - -REAL, PARAMETER :: NUMB1FLUX(0:40) = (/ & - 0.000E+00, 3.004E+01, 3.245E+02, 1.306E+03, 3.505E+03, 7.542E+03, & - 1.410E+04, 2.394E+04, 3.787E+04, 5.674E+04, 8.147E+04, 1.130E+05, & - 1.523E+05, 2.005E+05, 2.586E+05, 3.278E+05, 4.091E+05, 5.037E+05, & - 6.129E+05, 7.379E+05, 8.800E+05, 1.041E+06, 1.220E+06, 1.422E+06, & - 1.646E+06, 1.893E+06, 2.166E+06, 2.466E+06, 2.794E+06, 3.152E+06, & - 3.541E+06, 3.962E+06, 4.419E+06, 4.911E+06, 5.441E+06, 6.011E+06, & - 6.621E+06, 7.274E+06, 7.972E+06, 8.716E+06, 8.801E+06 /) - -REAL, PARAMETER :: NUMB2FLUX(0:40) = (/ & - 0.000E+00, 1.934E+01, 2.068E+02, 8.271E+02, 2.211E+03, 4.741E+03, & - 8.841E+03, 1.497E+04, 2.363E+04, 3.534E+04, 5.066E+04, 7.017E+04, & - 9.447E+04, 1.242E+05, 1.600E+05, 2.025E+05, 2.525E+05, 3.106E+05, & - 3.776E+05, 4.542E+05, 5.413E+05, 6.395E+05, 7.501E+05, 8.726E+05, & - 1.009E+06, 1.160E+06, 1.327E+06, 1.509E+06, 1.709E+06, 1.927E+06, & - 2.163E+06, 2.420E+06, 2.697E+06, 2.996E+06, 3.318E+06, 3.664E+06, & - 4.034E+06, 4.430E+06, 4.852E+06, 5.303E+06, 5.740E+06 /) - -REAL, PARAMETER :: NUMB3FLUX(0:40) = (/ 0.0, & - 4.340E-01, 5.217E+00, 2.241E+01, 6.301E+01, 1.404E+02, 2.703E+02, & - 4.699E+02, 7.584E+02, 1.157E+03, 1.687E+03, 2.373E+03, 3.240E+03, & - 4.314E+03, 5.625E+03, 7.197E+03, 9.063E+03, 1.126E+04, 1.380E+04, & - 1.674E+04, 2.011E+04, 2.393E+04, 2.827E+04, 3.311E+04, 3.853E+04, & - 4.457E+04, 5.126E+04, 5.864E+04, 6.675E+04, 7.564E+04, 8.535E+04, & - 9.592E+04, 1.074E+05, 1.198E+05, 1.333E+05, 1.478E+05, 1.633E+05, & - 1.801E+05, 1.980E+05, 2.172E+05, 2.353E+05 /) -REAL(KIND=JPRB) :: ZHOOK_HANDLE -!! -!! MESONH carries the following units during transport: -!! M0=#/molec_{air} -!! M6=um6/molec_{air}*1.d6 -!! The surface model should have (for sea salt) -!! M0=#/m3*[kg_{slt}/mole_{slt}/XAVOGADRO] -!! M3=kg/m3 -!! M6=um6/m3 -!! REFERENCE -!! --------- -!! Tulet et al, ORILAM manuscript for transformation of modal parameters -!! J. Geophys. Res., 110, D18201, doi:10.1029/2004JD005716 -! -!Initialize output which is total flux of sea salt (kg/m2/sec). -IF (LHOOK) CALL DR_HOOK('COUPLING_SLT_N',0,ZHOOK_HANDLE) -! -!Factor which is needed so that all gains normal units when leaving ground paramn -ZCONVERTFACM0_SLT = XMOLARWEIGHT_SLT / XAVOGADRO !(kg_slt/mol_slt)/(molec/mol) -!Factor which is needed for moment 6, there is a factor 1.d6 transported around in M6 in MESONH -ZCONVERTFACM6_SLT = XMOLARWEIGHT_SLT / XAVOGADRO*1.d6 -ZCONVERTFACM3_SLT = 4./3.*XPI*XDENSITY_SLT / 1.d18 -! -PSFSLT(:,:)=0.d0 -! -!+ Marine -IF ((CEMISPARAM_SLT .eq. "Ova14").OR.(CEMISPARAM_SLT .eq. "OvB21a").OR.(CEMISPARAM_SLT .eq. "OvB21b")) THEN ! Rajouter Ova14 dans fichier initialisation - ZHVAGUE(:) = 0. - DO II = 1, 8 - WHERE ((PWIND(:) .GT. VVENT(II)).AND.(PWIND(:) .LT. VVENT(II+1))) - ZHVAGUE(:) = HVAGUE(II) + (PWIND(:) - VVENT(II+1)) * & - (HVAGUE(II+1) - HVAGUE(II)) / & - (VVENT(II+1) - VVENT(II)) - ENDWHERE - ENDDO - - WHERE (PWIND(:) .GE. VVENT(9)) - ZHVAGUE(:) = HVAGUE(9) - END WHERE - - WHERE (PWHEIGHT(:) .EQ. -1.) - PWHEIGHT(:) = ZHVAGUE(:) - END WHERE - - ZWT = (/ 273.15, 283.15, 293.15, 303.15, 313.15 /) ! Unite : K - ZNUWATER = (/ 1.854E-6, 1.36E-6, 1.051E-6, 0.843E-6, 0.695E-6 /) -! Unite : m².s^(-1) Pour une salinite = 35g/kg. -! En mer Mediterranee = 38.5g/kg (Lewis and Schwartz) - -! Initialisation des valeurs de ZVISCO, ZREYNOLDS Variance de pente vague vent -! 12m - ZVISCO(:) = 0. - ZREYNOLDS(:) = 0. - MSS(:) = 0. - PWIND12(:) = 0. - PWIND12(:)=PWIND(:)+(PUSTAR(:)/0.4)*LOG(12.5/10.0) - MSS(:)=(0.003+(0.00512*PWIND12(:)))*(0.666) ! Correction factor - ! to convert tunnel to - ! Cox and munk MSS - - ! Tableau d'interpolation pour calculer ZNUWATER en fonction de la SST - ! Cas ou 0 < SST < 10 C - WHERE ((PSST(:) >= 273.15).AND.(PSST(:) < 283.15)) - ZVISCO(:) = ZNUWATER(1) + (PSST(:) - ZWT(1)) * (ZNUWATER(2)-ZNUWATER(1)) / & - (ZWT(2) - ZWT(1)) - ENDWHERE - - ! Cas ou 10 < SST < 20 C - WHERE ((PSST(:) >= 283.15).AND.(PSST(:) < 293.15)) - ZVISCO(:) = ZNUWATER(2) + (PSST(:) - ZWT(2)) * (ZNUWATER(3)-ZNUWATER(2)) / & - (ZWT(3) - ZWT(2)) - ENDWHERE - - ! Cas ou 20 < SST < 30 C - WHERE ((PSST(:) >= 293.15).AND.(PSST(:) < 303.15)) - ZVISCO(:) = ZNUWATER(3) + (PSST(:) - ZWT(3)) * (ZNUWATER(4)-ZNUWATER(3)) / & - (ZWT(4) - ZWT(3)) - ENDWHERE - - ! Cas ou 30 < SST < 40 C - WHERE ((PSST(:) >= 303.15).AND.(PSST(:) < 313.15)) - ZVISCO(:) = ZNUWATER(4) + (PSST(:) - ZWT(4)) * (ZNUWATER(5)-ZNUWATER(4)) / & - (ZWT(5) - ZWT(4)) - ENDWHERE - -! Calcul du nombre de Reynolds - ZREYNOLDS(:) = (PUSTAR(:) * PWHEIGHT(:)) / ZVISCO(:) -! Calcul du flux en nombre pour chaque mode - -! Ovadnevaite et al. 2014 -!!!!! Total number flux, Unite ZSDSLT_MDE ne correspond pas au total number -!flux mais au size dependent SSA production flux -!Condition d'emission : ZREYNOLDS > 1E5 - - ZSFSLT_MDE(:,:) = 0. - WHERE (ZREYNOLDS(:) > 1.E5) - ZSFSLT_MDE(:,1) = 104.51 * ( ZREYNOLDS(:) - 1.E5)**0.556 - ZSFSLT_MDE(:,2) = 0.044 * ( ZREYNOLDS(:) - 1.E5)**1.08 - ZSFSLT_MDE(:,3) = 149.64 * ( ZREYNOLDS(:) - 1.E5)**0.545 - ZSFSLT_MDE(:,4) = 2.96 * ( ZREYNOLDS(:) - 1.E5)**0.79 - ENDWHERE - WHERE (ZREYNOLDS(:) > 2.E5) - ZSFSLT_MDE(:,5) = 0.52 * ( ZREYNOLDS(:) - 2.E5)**0.87 - ENDWHERE - - WHERE (ZREYNOLDS(:) <= 1.E5) - ZSFSLT_MDE(:,1) = 1.E-10 - ZSFSLT_MDE(:,2) = 1.E-10 - ZSFSLT_MDE(:,3) = 1.E-10 - ZSFSLT_MDE(:,4) = 1.E-10 - ZSFSLT_MDE(:,5) = 1.E-10 - ENDWHERE - - ! Wave slope variance dependent SSGF (Bruch et al., 2021) - In #/m2/um/s - IF ((CEMISPARAM_SLT .eq. "OvB21a").AND.(JPMODE_SLT >= 6)) ZSFSLT_MDE(:,6)=(5.3824*10**6) * (MSS(:))**2.45 - IF ((CEMISPARAM_SLT .eq. "OvB21a").AND.(JPMODE_SLT >= 7)) ZSFSLT_MDE(:,7)=(1.9424*10**6) * (MSS(:))**2.30 - IF ((CEMISPARAM_SLT .eq. "OvB21a").AND.(JPMODE_SLT == 8)) ZSFSLT_MDE(:,8)=(1.3153*10**5) * (MSS(:))**2.39 - - ! Wave slope variance, wave age, and Rb dependent SSGF, (Bruch et al. 2021) - In #/m2/um/s - IF ((CEMISPARAM_SLT .eq. "OvB21b").AND.(JPMODE_SLT >= 6)) ZSFSLT_MDE(:,6)=(47.6139) * & - (((MSS(:)*PUSTAR(:)**3)*(1/(9.8*1.8*1e-5))))**0.92 - IF ((CEMISPARAM_SLT .eq. "OvB21b").AND.(JPMODE_SLT >= 7)) ZSFSLT_MDE(:,7)=(1.6849) * & - (((MSS(:)*PUSTAR(:)**3)*(1/(9.8*1.8*1e-5))))**1.41 - IF ((CEMISPARAM_SLT .eq. "OvB21b").AND.(JPMODE_SLT == 8)) ZSFSLT_MDE(:,8)=(0.4481) * & - (((MSS(:)*PUSTAR(:)**3)*(1/(9.8*1.8*1e-5))))**1.11 - - -ELSEIF (CEMISPARAM_SLT .eq. "Vig01") THEN -! Vignatti et al. 2001 (in particles.cm-2.s-1) - ZSFSLT_MDE(:,1) = 10.**(0.09 *PWIND(:) + 0.283) ! fine mode - ZSFSLT_MDE(:,2) = 10.**(0.0422*PWIND(:) + 0.288) ! median mode - ZSFSLT_MDE(:,3) = 10.**(0.069 *PWIND(:) - 3.5) ! coarse mode - -! convert into particles.m-2.s-1) - ZSFSLT_MDE(:,1) = MAX(ZSFSLT_MDE(:,1) * 1.E4, 1.E-10) - ZSFSLT_MDE(:,2) = MAX(ZSFSLT_MDE(:,2) * 1.E4, 1.E-10) - ZSFSLT_MDE(:,3) = MAX(ZSFSLT_MDE(:,3) * 1.E4, 1.E-10) -! -END IF -! -DO JN = 1, JPMODE_SLT - -! convert particles.m-2 s-1 into kg.m-2.s-1 -! N'est calculé que pour le moment 3 (en masse), la conversion pour les autres -! flux de moments se fait plus tard (mode_dslt_surf.F90 MASSFLUX2MOMENTFLUX) - ! - IF (LVARSIG_SLT) THEN ! cas 3 moment - - PSFSLT(:,2+(JN-1)*3) = ZSFSLT_MDE(:,JORDER_SLT(JN)) & - * ((SLT%XEMISRADIUS_SLT(JN)**3) & - * EXP(4.5 * LOG(SLT%XEMISSIG_SLT(JN))**2)) & - * ZCONVERTFACM3_SLT - - ELSEIF (LRGFIX_SLT) THEN ! cas 1 moment - PSFSLT(:,JN) = ZSFSLT_MDE(:,JORDER_SLT(JN)) & - * (SLT%XEMISRADIUS_SLT(JN)**3) & - * EXP(4.5 * LOG(SLT%XEMISSIG_SLT(JN))**2) & - * ZCONVERTFACM3_SLT - - ELSE ! cas 2 moments - - PSFSLT(:,2+(JN-1)*2) = ZSFSLT_MDE(:,JORDER_SLT(JN)) & - * ((SLT%XEMISRADIUS_SLT(JN)**3) & - * EXP(4.5 * LOG(SLT%XEMISSIG_SLT(JN))**2)) & - * ZCONVERTFACM3_SLT - END IF -END DO - - -IF (LHOOK) CALL DR_HOOK('COUPLING_SLT_N',1,ZHOOK_HANDLE) -END SUBROUTINE COUPLING_SLT_n diff --git a/src/ICCARE_BASE/coupling_surf_atmn.F90 b/src/ICCARE_BASE/coupling_surf_atmn.F90 deleted file mode 100644 index 9a52eed46..000000000 --- a/src/ICCARE_BASE/coupling_surf_atmn.F90 +++ /dev/null @@ -1,677 +0,0 @@ -!SFX_LIC Copyright 2004-2019 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -! ################################################################################# -SUBROUTINE COUPLING_SURF_ATM_n (YSC, HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, & - KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, & - PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, & - PCO2, HSV, PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS,& - PPS, PPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, PTRAD, & - PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, & - PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, & - PPET_B_COEF, PPEQ_B_COEF, PZWS, HTEST ) -! ################################################################################# -! -!!**** *COUPLING_INLAND_WATER_n * - Driver to call the schemes for the -!! four surface types (SEA, WATER, NATURE, TOWN) -!! -!! PURPOSE -!! ------- -! -!!** METHOD -!! ------ -!! -!! REFERENCE -!! --------- -!! -!! -!! AUTHOR -!! ------ -!! V. Masson -!! -!! MODIFICATIONS -!! ------------- -!! Original 01/2004 -!! Modified 09/2011 by S.Queguiner: Add total CO2 surface flux (anthropo+biogenic) as diagnostic -!! Modified 11/2011 by S.Queguiner: Add total Chemical surface flux (anthropo) as diagnostic -!! B. Decharme 04/2013 new coupling variables and replace RW_PRECIP_n by CPL_GCM_n -!! Modified 06/2013 by J.Escobar : replace DOUBLE PRECISION by REAL to handle problem for promotion of real on IBM SP -!! R. Séférian 03/2014 Adding decoupling between CO2 seen by photosynthesis and radiative CO2 -!! P. Wautelet 02/2019 bug correction KI->KSIZE for size of KMASK argument in TREAT_SURF -!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes -!!------------------------------------------------------------- -! -! -USE MODD_SURFEX_n, ONLY : SURFEX_t -! -USE MODD_SURF_CONF, ONLY : CPROGNAME -USE MODD_SURF_PAR, ONLY : XUNDEF -USE MODD_CSTS, ONLY : XP00, XCPD, XRD, XAVOGADRO, XMD -USE MODD_CO2V_PAR, ONLY : XMCO2 -USE MODD_SURF_ATM, ONLY : LCPL_GCM, XCO2UNCPL -USE MODD_DATA_COVER_PAR, ONLY : NTILESFC -! -! -USE MODD_SURFEX_MPI, ONLY : XTIME_SEA, XTIME_WATER, XTIME_NATURE, XTIME_TOWN -! -USE MODI_ADD_FORECAST_TO_DATE_SURF -USE MODI_AVERAGE_FLUX -USE MODI_AVERAGE_PHY -USE MODI_AVERAGE_RAD -USE MODI_DIAG_INLINE_SURF_ATM_n -USE MODI_CH_EMISSION_FLUX_n -USE MODI_CH_EMISSION_SNAP_n -USE MODI_CH_EMISSION_TO_ATM_n -USE MODI_SSO_Z0_FRICTION_n -USE MODI_SSO_BE04_FRICTION_n -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -USE MODI_ABOR1_SFX -! -USE MODI_COUPLING_INLAND_WATER_n -! -USE MODI_COUPLING_NATURE_n -! -USE MODI_COUPLING_SEA_n -! -USE MODI_COUPLING_TOWN_n -! -USE MODI_CPL_GCM_n -! -IMPLICIT NONE -! -#ifdef SFX_MPI -INCLUDE 'mpif.h' -#endif -! -!* 0.1 declarations of arguments -! -TYPE(SURFEX_t), INTENT(INOUT) :: YSC -! - CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes - CHARACTER(LEN=1), INTENT(IN) :: HCOUPLING ! type of coupling - ! 'E' : explicit - ! 'I' : implicit -REAL, INTENT(IN) :: PTIMEC ! cumulated time since beginning of simulation -INTEGER, INTENT(IN) :: KYEAR ! current year (UTC) -INTEGER, INTENT(IN) :: KMONTH ! current month (UTC) -INTEGER, INTENT(IN) :: KDAY ! current day (UTC) -REAL, INTENT(IN) :: PTIME ! current time since midnight (UTC, s) -INTEGER, INTENT(IN) :: KI ! number of points -INTEGER, INTENT(IN) :: KSV ! number of scalars -INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands -REAL, DIMENSION(KI), INTENT(IN) :: PTSUN ! solar time (s from midnight) -REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step (s) -REAL, DIMENSION(KI), INTENT(IN) :: PZREF ! height of T,q forcing (m) -REAL, DIMENSION(KI), INTENT(IN) :: PUREF ! height of wind forcing (m) -! -REAL, DIMENSION(KI), INTENT(IN) :: PTA ! air temperature forcing (K) -REAL, DIMENSION(KI), INTENT(IN) :: PQA ! air humidity forcing (kg/m3) -REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density (kg/m3) -REAL, DIMENSION(KI,KSV),INTENT(IN) :: PSV ! scalar variables -! ! chemistry: first char. in HSV: '#' (molecule/m3) -! ! - CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: HSV ! name of all scalar variables -REAL, DIMENSION(KI), INTENT(IN) :: PU ! zonal wind (m/s) -REAL, DIMENSION(KI), INTENT(IN) :: PV ! meridian wind (m/s) -REAL, DIMENSION(KI,KSW),INTENT(IN) :: PDIR_SW ! direct solar radiation (on horizontal surf.) -! ! (W/m2) -REAL, DIMENSION(KI,KSW),INTENT(IN) :: PSCA_SW ! diffuse solar radiation (on horizontal surf.) -! ! (W/m2) -REAL, DIMENSION(KSW),INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m) -REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! zenithal angle at t (radian from the vertical) -REAL, DIMENSION(KI), INTENT(IN) :: PZENITH2 ! zenithal angle at t+1(radian from the vertical) -REAL, DIMENSION(KI), INTENT(IN) :: PAZIM ! azimuthal angle (radian from North, clockwise) -REAL, DIMENSION(KI), INTENT(IN) :: PLW ! longwave radiation (on horizontal surf.) -! ! (W/m2) -REAL, DIMENSION(KI), INTENT(IN) :: PPS ! pressure at atmospheric model surface (Pa) -REAL, DIMENSION(KI), INTENT(IN) :: PPA ! pressure at forcing level (Pa) -REAL, DIMENSION(KI), INTENT(IN) :: PZWS ! significant sea wave (m) -REAL, DIMENSION(KI), INTENT(IN) :: PZS ! atmospheric model orography (m) -REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration in the air (kg/m3) -REAL, DIMENSION(KI), INTENT(IN) :: PSNOW ! snow precipitation (kg/m2/s) -REAL, DIMENSION(KI), INTENT(IN) :: PRAIN ! liquid precipitation (kg/m2/s) -! -! -REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH ! flux of heat (W/m2) -REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ ! flux of water vapor (kg/m2/s) -REAL, DIMENSION(KI), INTENT(OUT) :: PSFU ! zonal momentum flux (Pa) -REAL, DIMENSION(KI), INTENT(OUT) :: PSFV ! meridian momentum flux (Pa) -REAL, DIMENSION(KI), INTENT(OUT) :: PSFCO2 ! flux of CO2 (m/s*kg_CO2/kg_air) -REAL, DIMENSION(KI,KSV),INTENT(OUT):: PSFTS ! flux of scalar var. (kg/m2/s) -! -REAL, DIMENSION(KI), INTENT(INOUT) :: PTRAD ! radiative temperature (K) -REAL, DIMENSION(KI,KSW),INTENT(OUT):: PDIR_ALB ! direct albedo for each spectral band (-) -REAL, DIMENSION(KI,KSW),INTENT(OUT):: PSCA_ALB ! diffuse albedo for each spectral band (-) -REAL, DIMENSION(KI), INTENT(INOUT) :: PEMIS ! emissivity (-) -! -REAL, DIMENSION(KI), INTENT(OUT) :: PTSURF ! surface effective temperature (K) -REAL, DIMENSION(KI), INTENT(INOUT) :: PZ0 ! roughness length for momentum (m) -REAL, DIMENSION(KI), INTENT(INOUT) :: PZ0H ! roughness length for heat (m) -REAL, DIMENSION(KI), INTENT(INOUT) :: PQSURF ! specific humidity at surface (kg/kg) -! -REAL, DIMENSION(KI), INTENT(IN) :: PPEW_A_COEF! implicit coefficients -REAL, DIMENSION(KI), INTENT(IN) :: PPEW_B_COEF! needed if HCOUPLING='I' -REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF -REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF -REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF -REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF -CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK' -! -! -!* 0.2 declarations of local variables -! -INTEGER :: JTILE ! loop on type of surface -LOGICAL :: GNATURE, GTOWN, GWATER, GSEA ! .T. if the corresponding surface is represented -INTEGER :: ISWB ! number of shortwave spectral bands -! -REAL, DIMENSION(KI) :: ZPEW_A_COEF ! implicit coefficients -REAL, DIMENSION(KI) :: ZPEW_B_COEF ! needed if HCOUPLING='I' -REAL, DIMENSION(KI) :: ZPET_A_COEF -REAL, DIMENSION(KI) :: ZPEQ_A_COEF -REAL, DIMENSION(KI) :: ZPET_B_COEF -REAL, DIMENSION(KI) :: ZPEQ_B_COEF -! -! Tile outputs: -! -REAL, DIMENSION(KI,NTILESFC) :: ZSFTH_TILE ! surface heat flux (Km/s) -REAL, DIMENSION(KI,NTILESFC) :: ZSFTQ_TILE ! surface vapor flux (kgm/kg/s) -REAL, DIMENSION(KI,KSV,NTILESFC) :: ZSFTS_TILE ! scalar surface flux -REAL, DIMENSION(KI,NTILESFC) :: ZSFCO2_TILE ! surface CO2 flux -REAL, DIMENSION(KI,NTILESFC) :: ZSFU_TILE ! zonal momentum flux -REAL, DIMENSION(KI,NTILESFC) :: ZSFV_TILE ! meridian momentum flux -REAL, DIMENSION(KI,NTILESFC) :: ZTRAD_TILE ! radiative surface temperature -REAL, DIMENSION(KI,NTILESFC) :: ZEMIS_TILE ! emissivity -REAL, DIMENSION(KI,NTILESFC) :: ZFRAC_TILE ! fraction of each surface type -REAL, DIMENSION(KI,NTILESFC) :: ZTSURF_TILE ! surface effective temperature -REAL, DIMENSION(KI,NTILESFC) :: ZZ0_TILE ! roughness length for momentum -REAL, DIMENSION(KI,NTILESFC) :: ZZ0H_TILE ! roughness length for heat -REAL, DIMENSION(KI,NTILESFC) :: ZQSURF_TILE ! specific humidity at surface -! -REAL, DIMENSION(KI,KSW,NTILESFC) :: ZDIR_ALB_TILE ! direct albedo -REAL, DIMENSION(KI,KSW,NTILESFC) :: ZSCA_ALB_TILE ! diffuse albedo -! -REAL :: XTIME0 -! -INTEGER :: IINDEXEND -INTEGER :: INBTS, JI -REAL(KIND=JPRB) :: ZHOOK_HANDLE -! -!------------------------------------------------------------------------------------- -IF (LHOOK) CALL DR_HOOK('COUPLING_SURF_ATM_N',0,ZHOOK_HANDLE) -CPROGNAME=HPROGRAM -! -IF (HTEST/='OK') THEN - CALL ABOR1_SFX('COUPLING_SURF_ATMN: FATAL ERROR DURING ARGUMENT TRANSFER') -END IF -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Time evolution -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! -YSC%U%TTIME%TIME = YSC%U%TTIME%TIME + PTSTEP - CALL ADD_FORECAST_TO_DATE_SURF(YSC%U%TTIME%TDATE%YEAR,YSC%U%TTIME%TDATE%MONTH,& - YSC%U%TTIME%TDATE%DAY,YSC%U%TTIME%TIME) -! -!------------------------------------------------------------------------------------- -! Preliminaries: Tile related operations -!------------------------------------------------------------------------------------- -! FLAGS for the various surfaces: -! -GSEA = YSC%U%NDIM_SEA >0 -GWATER = YSC%U%NDIM_WATER >0 -GTOWN = YSC%U%NDIM_TOWN >0 -GNATURE = YSC%U%NDIM_NATURE >0 - -! -! Tile counter: -! -JTILE = 0 -! -! Number of shortwave spectral bands -! -ISWB = SIZE(PSW_BANDS) -! -! Initialization: Outputs to atmosphere over each tile: -! -ZSFTH_TILE(:,:) = XUNDEF -ZTRAD_TILE(:,:) = XUNDEF -ZDIR_ALB_TILE(:,:,:) = XUNDEF -ZSCA_ALB_TILE(:,:,:) = XUNDEF -ZEMIS_TILE(:,:) = XUNDEF -ZSFTQ_TILE(:,:) = XUNDEF -ZSFTS_TILE(:,:,:) = 0. -ZSFCO2_TILE(:,:) = 0. -ZSFU_TILE(:,:) = XUNDEF -ZSFV_TILE(:,:) = XUNDEF -ZTSURF_TILE(:,:) = XUNDEF -ZZ0_TILE(:,:) = XUNDEF -ZZ0H_TILE(:,:) = XUNDEF -ZQSURF_TILE(:,:) = XUNDEF -! -! Fractions for each tile: -! -ZFRAC_TILE(:,:) = 0.0 -! -! initialization of implicit coefficients: -! -IF (HCOUPLING=='I') THEN - ZPEW_A_COEF = PPEW_A_COEF - ZPEW_B_COEF = PPEW_B_COEF - ZPET_A_COEF = PPET_A_COEF - ZPEQ_A_COEF = PPEQ_A_COEF - ZPET_B_COEF = PPET_B_COEF - ZPEQ_B_COEF = PPEQ_B_COEF -ELSE - ZPEW_A_COEF = 0. - ZPEW_B_COEF = SQRT(PU**2+PV**2) - ZPET_A_COEF = XUNDEF - ZPET_B_COEF = XUNDEF - ZPEQ_A_COEF = XUNDEF - ZPEQ_B_COEF = XUNDEF -END IF -! -!-------------------------------------------------------------------------------------- -! Call ALMA interfaces for sea, water, nature and town here... -!-------------------------------------------------------------------------------------- -! -#ifdef SFX_MPI -XTIME0 = MPI_WTIME() -#endif -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! SEA Tile calculations: -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! -! first, pack vector...then call ALMA routine -! -JTILE = JTILE + 1 -! -IF(GSEA)THEN -! - ZFRAC_TILE(:,JTILE) = YSC%U%XSEA(:) -! - CALL TREAT_SURF(JTILE,YSC%U%NSIZE_SEA,YSC%U%NR_SEA) -! -ENDIF -! -#ifdef SFX_MPI -XTIME_SEA = XTIME_SEA + (MPI_WTIME() - XTIME0)*100./MAX(1,YSC%U%NSIZE_SEA) -XTIME0 = MPI_WTIME() -#endif -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! INLAND WATER Tile calculations: -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! -JTILE = JTILE + 1 -! -IF(GWATER)THEN -! - ZFRAC_TILE(:,JTILE) = YSC%U%XWATER(:) -! - CALL TREAT_SURF(JTILE,YSC%U%NSIZE_WATER,YSC%U%NR_WATER) -! -ENDIF -! -#ifdef SFX_MPI -XTIME_WATER = XTIME_WATER + (MPI_WTIME() - XTIME0)*100./MAX(1,YSC%U%NSIZE_WATER) -XTIME0 = MPI_WTIME() -#endif -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! NATURAL SURFACE Tile calculations: -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! -JTILE = JTILE + 1 -! -IF(GNATURE)THEN -! - ZFRAC_TILE(:,JTILE) = YSC%U%XNATURE(:) -! - CALL TREAT_SURF(JTILE,YSC%U%NSIZE_NATURE,YSC%U%NR_NATURE) -! -ENDIF -! -#ifdef SFX_MPI -XTIME_NATURE = XTIME_NATURE + (MPI_WTIME() - XTIME0)*100./MAX(1,YSC%U%NSIZE_NATURE) -XTIME0 = MPI_WTIME() -#endif -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! URBAN Tile calculations: -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! -JTILE = JTILE + 1 -! -IF(GTOWN)THEN -! - ZFRAC_TILE(:,JTILE) = YSC%U%XTOWN(:) -! - CALL TREAT_SURF(JTILE,YSC%U%NSIZE_TOWN,YSC%U%NR_TOWN) -! -ENDIF -! -#ifdef SFX_MPI -XTIME_TOWN = XTIME_TOWN + (MPI_WTIME() - XTIME0)*100./MAX(1,YSC%U%NSIZE_TOWN) -#endif -! -! - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Grid box average fluxes/properties: -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! - CALL AVERAGE_FLUX(ZFRAC_TILE, ZSFTH_TILE, ZSFTQ_TILE, ZSFTS_TILE, ZSFCO2_TILE, & - ZSFU_TILE, ZSFV_TILE, PSFTH, PSFTQ, PSFTS, PSFCO2, PSFU, PSFV ) -! -! - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Chemical Emissions: -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! -IF ((YSC%SV%NBEQ > 0).AND.(YSC%CHU%LCH_SURF_EMIS)) THEN - IF (YSC%CHU%CCH_EMIS=='AGGR') THEN - IF (YSC%SV%NSV_AEREND < 0) THEN - IINDEXEND = YSC%SV%NSV_CHSEND ! case only gas chemistry - ELSE - IINDEXEND = YSC%SV%NSV_AEREND ! case aerosol + gas chemistry - ENDIF - INBTS=0 - DO JI=1,SIZE(YSC%CHE%TSEMISS) - IF (SIZE(YSC%CHE%TSEMISS(JI)%NETIMES).GT.INBTS) INBTS=SIZE(YSC%CHE%TSEMISS(JI)%NETIMES) - ENDDO - CALL CH_EMISSION_FLUX_n(YSC%DTCO, YSC%U, YSC%CHE, YSC%SV, YSC%CHU, & - HPROGRAM,PTIME,PSFTS(:,YSC%SV%NSV_CHSBEG:IINDEXEND),PRHOA,PTSTEP,INBTS) - ELSE IF (YSC%CHU%CCH_EMIS=='SNAP') THEN - CALL CH_EMISSION_SNAP_n(YSC%CHN, HPROGRAM,YSC%U%NSIZE_FULL,PTIME,PTSUN,KYEAR,KMONTH,KDAY,PRHOA,YSC%UG%G%XLON) - CALL CH_EMISSION_TO_ATM_n(YSC%CHN, YSC%SV, PSFTS,PRHOA) - END IF -END IF -! -WHERE(PSFTS(:,:)==XUNDEF) PSFTS(:,:)=0. -! - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! CO2 Flux : adds biogenic and anthropogenic emissions -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! CO2 FLUXES : PSFTS in molecules/m2/s -! PSFCO2 in kgCO2/kgair*m/s = *PRHOA kgCO2/m2/s -! PSFCO2 in kgCO2/m2/s = *Navogadro*1E3/Mco2(44g/mol) molecules/m2/s -! -DO JI=1,SIZE(PSV,2) - IF(TRIM(ADJUSTL(YSC%SV%CSV(JI)))=="CO2") THEN - ! CO2 Flux (Antrop + biog) (molec*m2/s) - PSFTS(:,JI) = PSFTS(:,JI) + PSFCO2(:)*PRHOA(:)*(XAVOGADRO/44.)*1E3 - ! CO2 Flux (Antrop + biog) (kgCO2/kgair*m/s) - PSFCO2(:) = PSFTS(:,JI)/(PRHOA(:)*(XAVOGADRO/44.)*1E3) - END IF -END DO -! -! - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Radiative fluxes -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - CALL AVERAGE_RAD(ZFRAC_TILE, ZDIR_ALB_TILE, ZSCA_ALB_TILE, & - ZEMIS_TILE, ZTRAD_TILE, PDIR_ALB, PSCA_ALB,& - PEMIS, PTRAD) -! -! - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Physical properties -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - CALL AVERAGE_PHY(ZFRAC_TILE, ZTSURF_TILE, ZZ0_TILE, & - ZZ0H_TILE, ZQSURF_TILE, & - PUREF, PZREF, PTSURF, PZ0, PZ0H, PQSURF ) -! -! store these field to write in restart file (important for AGCM) -! -IF(LCPL_GCM) CALL CPL_GCM_n(YSC%U, KI,PZ0=PZ0,PZ0H=PZ0H,PQSURF=PQSURF) -! -! - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Orographic friction -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! -!* adds friction due to subscale orography to momentum fluxes -! but only over continental area -! -IF (YSC%USS%CROUGH=="Z01D" .OR. YSC%USS%CROUGH=="Z04D") THEN - CALL SSO_Z0_FRICTION_n(YSC%USS, YSC%U%XSEA,PUREF,PRHOA,PU,PV,ZPEW_A_COEF,ZPEW_B_COEF,PSFU,PSFV) -ELSE IF (YSC%USS%CROUGH=="BE04") THEN - CALL SSO_BE04_FRICTION_n(YSC%SB, YSC%USS, PTSTEP,YSC%U%XSEA,PUREF,PRHOA,PU,PV,PSFU,PSFV) -END IF -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Inline diagnostics for full surface -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! - CALL DIAG_INLINE_SURF_ATM_n(YSC%DUO, YSC%DU, & - PUREF, PZREF, PPS, PRHOA, PTRAD, PEMIS, PSFU, PSFV, PSFCO2) -! -IF (LHOOK) CALL DR_HOOK('COUPLING_SURF_ATM_N',1,ZHOOK_HANDLE) -! -!======================================================================================= -CONTAINS -!======================================================================================= -SUBROUTINE TREAT_SURF(KTILE,KSIZE,KMASK) -! -IMPLICIT NONE -! -INTEGER, INTENT(IN) :: KTILE -INTEGER, INTENT(IN) :: KSIZE -INTEGER, INTENT(IN), DIMENSION(KSIZE) :: KMASK -! -REAL, DIMENSION(KSIZE) :: ZP_TSUN ! solar time (s from midnight) -REAL, DIMENSION(KSIZE) :: ZP_ZREF ! height of T,q forcing (m) -REAL, DIMENSION(KSIZE) :: ZP_UREF ! height of wind forcing (m) -! -REAL, DIMENSION(KSIZE) :: ZP_TA ! air temperature forcing (K) -REAL, DIMENSION(KSIZE) :: ZP_QA ! air specific humidity forcing (kg/m3) -REAL, DIMENSION(KSIZE) :: ZP_RHOA ! air density (kg/m3) -REAL, DIMENSION(KSIZE) :: ZP_U ! zonal wind (m/s) -REAL, DIMENSION(KSIZE) :: ZP_V ! meridian wind (m/s) -REAL, DIMENSION(KSIZE,ISWB) :: ZP_DIR_SW ! direct solar radiation (on horizontal surf.) -! ! (W/m2) -REAL, DIMENSION(KSIZE,ISWB) :: ZP_SCA_SW ! diffuse solar radiation (on horizontal surf.) -! ! (W/m2) -REAL, DIMENSION(KSIZE) :: ZP_ZENITH ! zenithal angle at t (radian from the vertical) -REAL, DIMENSION(KSIZE) :: ZP_ZENITH2 ! zenithal angle at t+1(radian from the vertical) -REAL, DIMENSION(KSIZE) :: ZP_AZIM ! azimuthal angle (radian from North, clockwise) -REAL, DIMENSION(KSIZE) :: ZP_LW ! longwave radiation (on horizontal surf.) -! ! (W/m2) -REAL, DIMENSION(KSIZE) :: ZP_PS ! pressure at atmospheric model surface (Pa) -REAL, DIMENSION(KSIZE) :: ZP_PA ! pressure at forcing level (Pa) -REAL, DIMENSION(KSIZE) :: ZP_ZWS ! significant sea wave (m) -REAL, DIMENSION(KSIZE) :: ZP_ZS ! atmospheric model orography (m) -REAL, DIMENSION(KSIZE) :: ZP_CO2 ! CO2 concentration in the air (kg/m3) -REAL, DIMENSION(KSIZE,KSV) :: ZP_SV ! scalar concentration in the air -REAL, DIMENSION(KSIZE) :: ZP_SNOW ! snow precipitation (kg/m2/s) -REAL, DIMENSION(KSIZE) :: ZP_RAIN ! liquid precipitation (kg/m2/s) -! -REAL, DIMENSION(KSIZE) :: ZP_SFTH ! flux of heat (W/m2) -REAL, DIMENSION(KSIZE) :: ZP_SFTQ ! flux of water vapor (kg/m2/s) -REAL, DIMENSION(KSIZE) :: ZP_SFU ! zonal momentum flux (m/s) -REAL, DIMENSION(KSIZE) :: ZP_SFV ! meridian momentum flux (m/s) -REAL, DIMENSION(KSIZE) :: ZP_SFCO2 ! flux of CO2 (kg/m2/s) -REAL, DIMENSION(KSIZE,KSV) :: ZP_SFTS ! flux of scalar -! -REAL, DIMENSION(KSIZE) :: ZP_TRAD ! radiative temperature (K) -REAL, DIMENSION(KSIZE,ISWB) :: ZP_DIR_ALB ! direct albedo for each spectral band (-) -REAL, DIMENSION(KSIZE,ISWB) :: ZP_SCA_ALB ! diffuse albedo for each spectral band (-) -REAL, DIMENSION(KSIZE) :: ZP_EMIS ! emissivity -! -REAL, DIMENSION(KSIZE) :: ZP_TSURF ! surface effective temperature (K) -REAL, DIMENSION(KSIZE) :: ZP_Z0 ! roughness length for momentum (m) -REAL, DIMENSION(KSIZE) :: ZP_Z0H ! roughness length for heat (m) -REAL, DIMENSION(KSIZE) :: ZP_QSURF ! specific humidity at surface (kg/kg) -! -REAL, DIMENSION(KSIZE) :: ZP_PEW_A_COEF ! implicit coefficients -REAL, DIMENSION(KSIZE) :: ZP_PEW_B_COEF ! needed if HCOUPLING='I' -REAL, DIMENSION(KSIZE) :: ZP_PET_A_COEF -REAL, DIMENSION(KSIZE) :: ZP_PEQ_A_COEF -REAL, DIMENSION(KSIZE) :: ZP_PET_B_COEF -REAL, DIMENSION(KSIZE) :: ZP_PEQ_B_COEF -INTEGER :: JJ, JK -REAL(KIND=JPRB) :: ZHOOK_HANDLE -! -IF (LHOOK) CALL DR_HOOK('COUPLING_SURF_ATM_n:TREAT_SURF',0,ZHOOK_HANDLE) -! -!-------------------------------------------------------------------------------------------- -! -!cdir nodep -!cdir unroll=8 -DO JJ=1,KSIZE - JI = KMASK(JJ) - ZP_TSUN(JJ) = PTSUN (JI) - ZP_ZENITH(JJ) = PZENITH (JI) - ZP_ZENITH2(JJ) = PZENITH2 (JI) - ZP_AZIM (JJ) = PAZIM (JI) - ZP_ZREF(JJ) = PZREF (JI) - ZP_UREF(JJ) = PUREF (JI) - ZP_U(JJ) = PU (JI) - ZP_V(JJ) = PV (JI) - ZP_QA(JJ) = PQA (JI) - ZP_TA(JJ) = PTA (JI) - ZP_RHOA(JJ) = PRHOA (JI) - ZP_CO2(JJ) = PCO2 (JI) - ZP_RAIN(JJ) = PRAIN (JI) - ZP_SNOW(JJ) = PSNOW (JI) - ZP_LW(JJ) = PLW (JI) - ZP_PS(JJ) = PPS (JI) - ZP_PA(JJ) = PPA (JI) - ZP_ZWS(JJ) = PZWS (JI) - ZP_ZS(JJ) = PZS (JI) -ENDDO -! -!consider decoupling between CO2 emploied for photosynthesis and radiative CO2 -!recommended as C4MIP option (XCO2UNCPL in ppmv) -IF(XCO2UNCPL/=XUNDEF)THEN - ZP_CO2(:) = ZP_RHOA(:) * XCO2UNCPL * 1.E-6 * XMCO2 / XMD -ENDIF -! -DO JK=1,SIZE(PSV,2) -!cdir nodep -!cdir unroll=8 - DO JJ=1,KSIZE - JI = KMASK(JJ) - ZP_SV(JJ,JK) = PSV (JI,JK) - ENDDO -ENDDO -! -DO JK=1,ISWB -!cdir nodep -!cdir unroll=8 - DO JJ=1,KSIZE - JI = KMASK(JJ) - ZP_DIR_SW(JJ,JK) = PDIR_SW (JI,JK) - ZP_SCA_SW(JJ,JK) = PSCA_SW (JI,JK) - ENDDO -ENDDO -! -!cdir nodep -!cdir unroll=8 -DO JJ=1,KSIZE - JI = KMASK(JJ) - ZP_PEW_A_COEF(JJ) = ZPEW_A_COEF (JI) - ZP_PEW_B_COEF(JJ) = ZPEW_B_COEF (JI) - ZP_PET_A_COEF(JJ) = ZPET_A_COEF (JI) - ZP_PET_B_COEF(JJ) = ZPET_B_COEF (JI) - ZP_PEQ_A_COEF(JJ) = ZPEQ_A_COEF (JI) - ZP_PEQ_B_COEF(JJ) = ZPEQ_B_COEF (JI) -ENDDO -! -!-------------------------------------------------------------------------------------------- -! -IF (KTILE==1) THEN - ! - CALL COUPLING_SEA_n(YSC%SM, YSC%DLO, YSC%DL, YSC%DLC, YSC%U, YSC%NDST%AL(1), YSC%SLT, & - HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, & - YSC%U%NSIZE_SEA, KSV, KSW, ZP_TSUN, ZP_ZENITH, ZP_ZENITH2,ZP_AZIM, & - ZP_ZREF, ZP_UREF, ZP_ZS, ZP_U, ZP_V, ZP_QA, ZP_TA, ZP_RHOA, ZP_SV, & - ZP_CO2, HSV, ZP_RAIN, ZP_SNOW, ZP_LW, ZP_DIR_SW, ZP_SCA_SW, PSW_BANDS, & - ZP_PS, ZP_PA, ZP_SFTQ, ZP_SFTH, ZP_SFTS, ZP_SFCO2, ZP_SFU, ZP_SFV, & - ZP_TRAD, ZP_DIR_ALB, ZP_SCA_ALB, ZP_EMIS, ZP_TSURF, ZP_Z0, ZP_Z0H, & - ZP_QSURF, ZP_PEW_A_COEF, ZP_PEW_B_COEF, ZP_PET_A_COEF, ZP_PEQ_A_COEF, & - ZP_PET_B_COEF, ZP_PEQ_B_COEF, ZP_ZWS, 'OK' ) - ! -ELSEIF (KTILE==2) THEN - ! - CALL COUPLING_INLAND_WATER_n(YSC%FM, YSC%WM, YSC%DLO, YSC%DL, YSC%DLC, YSC%U, & - YSC%NDST%AL(1), YSC%SLT, HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, & - KYEAR, KMONTH, KDAY, PTIME, YSC%U%NSIZE_WATER, KSV, KSW, & - ZP_TSUN, ZP_ZENITH, ZP_ZENITH2, ZP_AZIM, ZP_ZREF, ZP_UREF, & - ZP_ZS, ZP_U, ZP_V, ZP_QA, ZP_TA, ZP_RHOA, ZP_SV, ZP_CO2, HSV, & - ZP_RAIN, ZP_SNOW, ZP_LW, ZP_DIR_SW, ZP_SCA_SW, PSW_BANDS, & - ZP_PS, ZP_PA, ZP_SFTQ, ZP_SFTH, ZP_SFTS, ZP_SFCO2, ZP_SFU, & - ZP_SFV, ZP_TRAD, ZP_DIR_ALB, ZP_SCA_ALB, ZP_EMIS, ZP_TSURF, & - ZP_Z0, ZP_Z0H, ZP_QSURF, ZP_PEW_A_COEF, ZP_PEW_B_COEF, & - ZP_PET_A_COEF, ZP_PEQ_A_COEF, ZP_PET_B_COEF, ZP_PEQ_B_COEF, & - 'OK' ) - ! -ELSEIF (KTILE==3) THEN - ! - CALL COUPLING_NATURE_n(YSC%DTCO, YSC%UG, YSC%U, YSC%USS, YSC%IM, YSC%DTZ, YSC%DLO, YSC%DL, & - YSC%DLC, YSC%NDST, YSC%SLT, YSC%BLOWSNW, & - HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, & - KYEAR, KMONTH, KDAY, PTIME, YSC%U%NSIZE_NATURE, KSV, KSW, ZP_TSUN, & - ZP_ZENITH, ZP_ZENITH2, ZP_AZIM, ZP_ZREF, ZP_UREF, ZP_ZS, ZP_U, ZP_V, & - ZP_QA, ZP_TA, ZP_RHOA, ZP_SV, ZP_CO2, HSV, ZP_RAIN, ZP_SNOW, ZP_LW, & - ZP_DIR_SW, ZP_SCA_SW, PSW_BANDS, ZP_PS, ZP_PA, ZP_SFTQ, ZP_SFTH, & - ZP_SFTS, ZP_SFCO2, ZP_SFU, ZP_SFV, ZP_TRAD, ZP_DIR_ALB, ZP_SCA_ALB, & - ZP_EMIS, ZP_TSURF, ZP_Z0, ZP_Z0H, ZP_QSURF, ZP_PEW_A_COEF, & - ZP_PEW_B_COEF, ZP_PET_A_COEF, ZP_PEQ_A_COEF, ZP_PET_B_COEF, & - ZP_PEQ_B_COEF, 'OK' ) - ! -ELSEIF (KTILE==4) THEN - ! - CALL COUPLING_TOWN_n(YSC%DTCO, YSC%U, YSC%DLO, YSC%DL, YSC%DLC, YSC%NDST%AL(1), YSC%SLT, YSC%TM, & - YSC%GDM, YSC%GRM, HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, & - KDAY, PTIME, YSC%U%NSIZE_TOWN, KSV, KSW, ZP_TSUN, ZP_ZENITH, ZP_AZIM, & - ZP_ZREF, ZP_UREF, ZP_ZS, ZP_U, ZP_V, ZP_QA, ZP_TA, ZP_RHOA, ZP_SV, & - ZP_CO2, HSV, ZP_RAIN, ZP_SNOW, ZP_LW, ZP_DIR_SW, ZP_SCA_SW, PSW_BANDS, & - ZP_PS, ZP_PA, ZP_SFTQ, ZP_SFTH, ZP_SFTS, ZP_SFCO2, ZP_SFU, ZP_SFV, & - ZP_TRAD, ZP_DIR_ALB, ZP_SCA_ALB, ZP_EMIS, ZP_TSURF, ZP_Z0, ZP_Z0H, & - ZP_QSURF, ZP_PEW_A_COEF, ZP_PEW_B_COEF, ZP_PET_A_COEF, ZP_PEQ_A_COEF, & - ZP_PET_B_COEF, ZP_PEQ_B_COEF, 'OK' ) - ! -ENDIF -! -!---------------------------------------------------------------------------------------------- -! -!cdir nodep -!cdir unroll=8 -DO JJ=1,KSIZE - JI=KMASK(JJ) - ZSFTQ_TILE (JI,KTILE) = ZP_SFTQ (JJ) - ZSFTH_TILE (JI,KTILE) = ZP_SFTH (JJ) - ZSFCO2_TILE (JI,KTILE) = ZP_SFCO2 (JJ) - ZSFU_TILE (JI,KTILE) = ZP_SFU (JJ) - ZSFV_TILE (JI,KTILE) = ZP_SFV (JJ) - ZTRAD_TILE (JI,KTILE) = ZP_TRAD (JJ) - ZEMIS_TILE (JI,KTILE) = ZP_EMIS (JJ) - ZTSURF_TILE (JI,KTILE) = ZP_TSURF (JJ) - ZZ0_TILE (JI,KTILE) = ZP_Z0 (JJ) - ZZ0H_TILE (JI,KTILE) = ZP_Z0H (JJ) - ZQSURF_TILE (JI,KTILE) = ZP_QSURF (JJ) -ENDDO -! -DO JI=1,SIZE(ZP_SFTS,2) -!cdir nodep -!cdir unroll=8 - DO JJ=1,KSIZE - ZSFTS_TILE (KMASK(JJ),JI,KTILE)= ZP_SFTS (JJ,JI) - ENDDO -ENDDO -! -DO JI=1,SIZE(ZP_DIR_ALB,2) -!cdir nodep -!cdir unroll=8 - DO JJ=1,KSIZE - ZDIR_ALB_TILE (KMASK(JJ),JI,KTILE)= ZP_DIR_ALB (JJ,JI) - ZSCA_ALB_TILE (KMASK(JJ),JI,KTILE)= ZP_SCA_ALB (JJ,JI) - ENDDO -ENDDO -! -!---------------------------------------------------------------------------------------------- -! -IF (LHOOK) CALL DR_HOOK('COUPLING_SURF_ATM_n:TREAT_SURF',1,ZHOOK_HANDLE) -! -END SUBROUTINE TREAT_SURF -!======================================================================================= -END SUBROUTINE COUPLING_SURF_ATM_n diff --git a/src/ICCARE_BASE/coupling_tebn.F90 b/src/ICCARE_BASE/coupling_tebn.F90 deleted file mode 100644 index 0a28e679e..000000000 --- a/src/ICCARE_BASE/coupling_tebn.F90 +++ /dev/null @@ -1,1065 +0,0 @@ -!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -! ############################################################################### -SUBROUTINE COUPLING_TEB_n (DTCO, DST, SLT, TOP, SB, G, CHT, NT, TPN, TIR, BOP, NB, TD, GDM, GRM, & - HPROGRAM, HCOUPLING, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV,& - KSW, PTSUN, PZENITH, PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, & - PRHOA, PSV, PCO2, HSV, PRAIN, PSN, PLW, PDIR_SW, PSCA_SW, & - PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, & - PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, & - PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, & - PPEQ_B_COEF, HTEST ) -! ############################################################################### -! -!!**** *COUPLING_TEB_n * - Driver for TEB -!! -!! PURPOSE -!! ------- -! -!!** METHOD -!! ------ -!! -!! REFERENCE -!! --------- -!! -!! -!! AUTHOR -!! ------ -!! V. Masson -!! -!! MODIFICATIONS -!! ------------- -!! Original 01/2004 -!! 10/2005 (G.Pigeon) transfer of domestic heating -!! S. Riette 06/2009 Initialisation of XT, XQ, XU and XTKE on canopy levels -!! S. Riette 01/2010 Use of interpol_sbl to compute 10m wind diagnostic -!! G. Pigeon 09/2012 CCH_BEM, ROUGH_WALL, ROUGH_ROOF for building conv. coef -!! G. Pigeon 10/2012 XF_WIN_WIN as arg. of TEB_GARDEN -!! B. Decharme 09/2012 New wind implicitation -!! J. Escobar 09/2012 KI not allowed without-interface , replace by KI -!! V. Masson 08/2013 adds solar panels & occupation calendar -!! B. Decharme 04/2013 new coupling variables -!!--------------------------------------------------------------- -! -USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t -USE MODD_DST_n, ONLY : DST_t -USE MODD_SLT_n, ONLY : SLT_t -! -USE MODD_CH_TEB_n, ONLY : CH_TEB_t -USE MODD_CANOPY_n, ONLY: CANOPY_t -USE MODD_SFX_GRID_n, ONLY : GRID_t -USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t -USE MODD_TEB_PANEL_n, ONLY : TEB_PANEL_t -USE MODD_TEB_IRRIG_n, ONLY : TEB_IRRIG_t -USE MODD_TEB_n, ONLY : TEB_NP_t -USE MODD_SURFEX_n, ONLY : TEB_DIAG_t -USE MODD_BEM_OPTION_n, ONLY : BEM_OPTIONS_t -USE MODD_BEM_n, ONLY : BEM_NP_t -! -USE MODD_SURFEX_n, ONLY : TEB_GARDEN_MODEL_t -USE MODD_SURFEX_n, ONLY : TEB_GREENROOF_MODEL_t -! -USE MODD_REPROD_OPER, ONLY : CIMPLICIT_WIND -! -USE MODD_CSTS, ONLY : XRD, XCPD, XP00, XLVTT, XPI, XKARMAN, XG -USE MODD_SURF_PAR, ONLY : XUNDEF -! -USE MODD_DST_SURF -USE MODD_SLT_SURF -! -USE MODE_DSLT_SURF -USE MODE_THERMOS -USE MODE_SBLS -! -USE MODI_AVERAGE_RAD -USE MODI_SM10 -USE MODI_ADD_FORECAST_TO_DATE_SURF -USE MODI_DIAG_INLINE_TEB_n -USE MODI_CUMUL_DIAG_TEB_n -USE MODI_CH_AER_DEP -USE MODI_CH_DEP_TOWN -USE MODI_DSLT_DEP -USE MODI_TEB_GARDEN -USE MODI_TEB_CANOPY -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -USE MODI_ABOR1_SFX -USE MODI_CANOPY_EVOL -USE MODI_CANOPY_GRID_UPDATE -USE MODI_UTCI_TEB -USE MODI_UTCIC_STRESS -USE MODI_CIRCUMSOLAR_RAD -! -IMPLICIT NONE -! -!* 0.1 declarations of arguments -! -! -! -TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO -TYPE(DST_t), INTENT(INOUT) :: DST -TYPE(SLT_t), INTENT(INOUT) :: SLT -! -TYPE(CH_TEB_t), INTENT(INOUT) :: CHT -TYPE(CANOPY_t), INTENT(INOUT) :: SB -TYPE(GRID_t), INTENT(INOUT) :: G -TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP -TYPE(TEB_PANEL_t), INTENT(INOUT) :: TPN -TYPE(TEB_IRRIG_t), INTENT(INOUT) :: TIR -TYPE(TEB_NP_t), INTENT(INOUT) :: NT -! -TYPE(TEB_DIAG_t), INTENT(INOUT) :: TD -! -TYPE(BEM_OPTIONS_t), INTENT(INOUT) :: BOP -TYPE(BEM_NP_t), INTENT(INOUT) :: NB -! -TYPE(TEB_GARDEN_MODEL_t), INTENT(INOUT) :: GDM -TYPE(TEB_GREENROOF_MODEL_t), INTENT(INOUT) :: GRM -! - CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes - CHARACTER(LEN=1), INTENT(IN) :: HCOUPLING ! type of coupling - ! 'E' : explicit - ! 'I' : implicit -INTEGER, INTENT(IN) :: KYEAR ! current year (UTC) -INTEGER, INTENT(IN) :: KMONTH ! current month (UTC) -INTEGER, INTENT(IN) :: KDAY ! current day (UTC) -REAL, INTENT(IN) :: PTIME ! current time since midnight (UTC, s) -INTEGER, INTENT(IN) :: KI ! number of points -INTEGER, INTENT(IN) :: KSV ! number of scalars -INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands -REAL, DIMENSION(KI), INTENT(IN) :: PTSUN ! solar time (s from midnight) -REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step (s) -REAL, DIMENSION(KI), INTENT(IN) :: PZREF ! height of T,q forcing (m) -REAL, DIMENSION(KI), INTENT(IN) :: PUREF ! height of wind forcing (m) -! -REAL, DIMENSION(KI), INTENT(IN) :: PTA ! air temperature forcing (K) -REAL, DIMENSION(KI), INTENT(IN) :: PQA ! air humidity forcing (kg/m3) -REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density (kg/m3) -REAL, DIMENSION(KI,KSV),INTENT(IN) :: PSV ! scalar variables -! ! chemistry: first char. in HSV: '#' (molecule/m3) -! ! - CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: HSV ! name of all scalar variables -REAL, DIMENSION(KI), INTENT(IN) :: PU ! zonal wind (m/s) -REAL, DIMENSION(KI), INTENT(IN) :: PV ! meridian wind (m/s) -REAL, DIMENSION(KI,KSW),INTENT(IN) :: PDIR_SW ! direct solar radiation (on horizontal surf.) -! ! (W/m2) -REAL, DIMENSION(KI,KSW),INTENT(IN) :: PSCA_SW ! diffuse solar radiation (on horizontal surf.) -! ! (W/m2) -REAL, DIMENSION(KSW),INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m) -REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! zenithal angle (radian from the vertical) -REAL, DIMENSION(KI), INTENT(IN) :: PAZIM ! azimuthal angle (radian from North, clockwise) -REAL, DIMENSION(KI), INTENT(IN) :: PLW ! longwave radiation (on horizontal surf.) -! ! (W/m2) -REAL, DIMENSION(KI), INTENT(IN) :: PPS ! pressure at atmospheric model surface (Pa) -REAL, DIMENSION(KI), INTENT(IN) :: PPA ! pressure at forcing level (Pa) -REAL, DIMENSION(KI), INTENT(IN) :: PZS ! atmospheric model orography (m) -REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration in the air (kg/m3) -REAL, DIMENSION(KI), INTENT(IN) :: PSN ! snow precipitation (kg/m2/s) -REAL, DIMENSION(KI), INTENT(IN) :: PRAIN ! liquid precipitation (kg/m2/s) -! -! -REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH ! flux of heat (W/m2) -REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ ! flux of water vapor (kg/m2/s) -REAL, DIMENSION(KI), INTENT(OUT) :: PSFU ! zonal momentum flux (Pa) -REAL, DIMENSION(KI), INTENT(OUT) :: PSFV ! meridian momentum flux (Pa) -REAL, DIMENSION(KI), INTENT(OUT) :: PSFCO2 ! flux of CO2 (kg/m2/s) -REAL, DIMENSION(KI,KSV),INTENT(OUT):: PSFTS ! flux of scalar var. (kg/m2/s) -! -REAL, DIMENSION(KI), INTENT(OUT) :: PTRAD ! radiative temperature (K) -REAL, DIMENSION(KI,KSW),INTENT(OUT):: PDIR_ALB! direct albedo for each spectral band (-) -REAL, DIMENSION(KI,KSW),INTENT(OUT):: PSCA_ALB! diffuse albedo for each spectral band (-) -REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS ! emissivity (-) -! -REAL, DIMENSION(KI), INTENT(OUT) :: PTSURF ! surface effective temperature (K) -REAL, DIMENSION(KI), INTENT(OUT) :: PZ0 ! roughness length for momentum (m) -REAL, DIMENSION(KI), INTENT(OUT) :: PZ0H ! roughness length for heat (m) -REAL, DIMENSION(KI), INTENT(OUT) :: PQSURF ! specific humidity at surface (kg/kg) -! -REAL, DIMENSION(KI), INTENT(IN) :: PPEW_A_COEF! implicit coefficients -REAL, DIMENSION(KI), INTENT(IN) :: PPEW_B_COEF! needed if HCOUPLING='I' -REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF -REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF -REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF -REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF - CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK' -! -! -!* 0.2 declarations of local variables -! -INTEGER :: JSWB ! loop counter on shortwave spectral bands -! -REAL, DIMENSION(KI) :: ZQA ! specific humidity (kg/kg) -REAL, DIMENSION(KI) :: ZEXNA ! Exner function at forcing level -REAL, DIMENSION(KI) :: ZEXNS ! Exner function at surface level -REAL, DIMENSION(KI) :: ZWIND ! wind -! -! Ouput Diagnostics: -! -REAL, DIMENSION(KI) :: ZU_CANYON ! wind in canyon -REAL, DIMENSION(KI) :: ZT_CANYON ! temperature in canyon -REAL, DIMENSION(KI) :: ZQ_CANYON ! specific humidity in canyon -REAL, DIMENSION(KI) :: ZAVG_T_CANYON ! temperature in canyon for town -REAL, DIMENSION(KI) :: ZAVG_Q_CANYON ! specific humidity in canyon for town -REAL, DIMENSION(KI) :: ZT_CAN ! temperature in canyon (evolving in TEB) -REAL, DIMENSION(KI) :: ZQ_CAN ! specific humidity in canyon (evolving in TEB) -! -REAL, DIMENSION(KI) :: ZPEW_A_COEF ! implicit coefficients -REAL, DIMENSION(KI) :: ZPEW_B_COEF ! needed if HCOUPLING='I' -! -REAL, DIMENSION(KI) :: ZT_LOWCAN ! temperature at lowest canyon level (K) -REAL, DIMENSION(KI) :: ZQ_LOWCAN ! humidity at lowest canyon level (kg/kg) -REAL, DIMENSION(KI) :: ZU_LOWCAN ! wind at lowest canyon level (m/s) -REAL, DIMENSION(KI) :: ZZ_LOWCAN ! height of lowest canyon level (m) -! -REAL, DIMENSION(KI) :: ZPEW_A_COEF_LOWCAN ! implicit coefficients for wind coupling -REAL, DIMENSION(KI) :: ZPEW_B_COEF_LOWCAN ! between first canopy level and road -! -REAL, DIMENSION(KI) :: ZTA ! temperature at canyon level just above roof (K) -REAL, DIMENSION(KI) :: ZPA ! pressure at canyon level just above roof (K) -REAL, DIMENSION(KI) :: ZUA ! wind at canyon level just above roof (m/s) -REAL, DIMENSION(KI) :: ZUREF ! height of canyon level just above roof (m) -REAL, DIMENSION(KI) :: ZZREF ! height of canyon level just above roof (m) -! -REAL, DIMENSION(KI) :: ZDIR_SW ! total direct SW -REAL, DIMENSION(KI) :: ZSCA_SW ! total diffuse SW -REAL, DIMENSION(KI) :: ZAVG_SCA_SW -REAL, DIMENSION(KI) :: ZAVG_DIR_SW -REAL, DIMENSION(KI,SIZE(PDIR_SW,2)) :: ZDIR_SWB ! total direct SW per band -REAL, DIMENSION(KI,SIZE(PSCA_SW,2)) :: ZSCA_SWB ! total diffuse SW per band -! -! -REAL, DIMENSION(KI) :: ZLE_WL_A ! latent heat flux on walls -REAL, DIMENSION(KI) :: ZLE_WL_B ! latent heat flux on walls -REAL, DIMENSION(KI) :: ZAVG_H_WL -! -REAL, DIMENSION(KI) :: ZPROD_BLD ! averaged energy production from solar panel (W/m2 bld) -REAL, DIMENSION(KI) :: ZHU_BLD -REAL, DIMENSION(KI) :: ZAVG_TI_BLD -REAL, DIMENSION(KI) :: ZAVG_QI_BLD -! -REAL, DIMENSION(KI) :: ZRN_GRND ! net radiation on ground built surf -REAL, DIMENSION(KI) :: ZH_GRND ! sensible heat flux on ground built surf -REAL, DIMENSION(KI) :: ZLE_GRND ! latent heat flux on ground built surf -REAL, DIMENSION(KI) :: ZGFLX_GRND ! storage flux in ground built surf -REAL, DIMENSION(KI) :: ZUW_GRND ! momentum flux for ground built surf -REAL, DIMENSION(KI) :: ZDUWDU_GRND ! -REAL, DIMENSION(KI) :: ZAC_GRND ! ground built surf aerodynamical conductance -REAL, DIMENSION(KI) :: ZAC_GRND_WAT ! ground built surf water aerodynamical conductance -REAL, DIMENSION(KI) :: ZEMIT_LW_GRND -REAL, DIMENSION(KI) :: ZREF_SW_GRND ! total solar rad reflected from ground -REAL, DIMENSION(KI) :: ZAVG_UW_GRND -REAL, DIMENSION(KI) :: ZAVG_DUWDU_GRND -REAL, DIMENSION(KI) :: ZAVG_H_GRND -REAL, DIMENSION(KI) :: ZAVG_AC_GRND -REAL, DIMENSION(KI) :: ZAVG_AC_GRND_WAT -REAL, DIMENSION(KI) :: ZAVG_E_GRND -REAL, DIMENSION(KI) :: ZAVG_REF_SW_GRND -REAL, DIMENSION(KI) :: ZAVG_EMIT_LW_GRND -! -REAL, DIMENSION(KI) :: ZLEW_RF ! latent heat flux on snowfree roof -REAL, DIMENSION(KI) :: ZRNSN_RF ! net radiation over snow -REAL, DIMENSION(KI) :: ZHSN_RF ! sensible heat flux over snow -REAL, DIMENSION(KI) :: ZLESN_RF ! latent heat flux over snow -REAL, DIMENSION(KI) :: ZGSN_RF ! flux under the snow -REAL, DIMENSION(KI) :: ZMELT_RF ! snow melt -REAL, DIMENSION(KI) :: ZUW_RF ! momentum flux for roofs -REAL, DIMENSION(KI) :: ZDUWDU_RF ! -REAL, DIMENSION(KI) :: ZAVG_UW_RF -REAL, DIMENSION(KI) :: ZAVG_DUWDU_RF -REAL, DIMENSION(KI) :: ZAVG_H_RF -REAL, DIMENSION(KI) :: ZAVG_E_RF -! -REAL, DIMENSION(KI) :: ZLEW_RD ! latent heat flux on snowfree road -REAL, DIMENSION(KI) :: ZRNSN_RD ! net radiation over snow -REAL, DIMENSION(KI) :: ZHSN_RD ! sensible heat flux over snow -REAL, DIMENSION(KI) :: ZLESN_RD ! latent heat flux over snow -REAL, DIMENSION(KI) :: ZGSN_RD ! flux under the snow -REAL, DIMENSION(KI) :: ZMELT_RD ! snow melt -REAL, DIMENSION(KI) :: ZAC_RD ! road aerodynamical conductance -REAL, DIMENSION(KI) :: ZAC_RD_WAT ! road water aerodynamical conductance -! -REAL, DIMENSION(KI) :: ZAC_GD ! green area aerodynamical conductance -REAL, DIMENSION(KI) :: ZAC_GD_WAT! green area water aerodynamical conductance -REAL, DIMENSION(KI,1):: ZESN_GD ! green area snow emissivity -! -REAL, DIMENSION(KI) :: ZAC_GRF ! green roof aerodynamical conductance -REAL, DIMENSION(KI) :: ZAC_GRF_WAT! green roof water aerodynamical conductance -! -REAL, DIMENSION(KI) :: ZTRAD ! radiative temperature for current patch -REAL, DIMENSION(KI) :: ZEMIS ! emissivity for current patch -REAL, DIMENSION(KI,TOP%NTEB_PATCH) :: ZTRAD_PATCH ! radiative temperature for each patch -REAL, DIMENSION(KI,TOP%NTEB_PATCH) :: ZEMIS_PATCH ! emissivity for each patch -! -REAL, DIMENSION(KI) :: ZDIR_ALB ! direct albedo of town -REAL, DIMENSION(KI) :: ZSCA_ALB ! diffuse albedo of town -REAL, DIMENSION(KI,KSW,TOP%NTEB_PATCH) :: ZDIR_ALB_PATCH ! direct albedo per wavelength and patch -REAL, DIMENSION(KI,KSW,TOP%NTEB_PATCH) :: ZSCA_ALB_PATCH ! diffuse albedo per wavelength and patch -REAL, DIMENSION(KI) :: ZAVG_DIR_ALB ! direct albedo of town -REAL, DIMENSION(KI) :: ZAVG_SCA_ALB ! diffuse albedo of town -! -REAL, DIMENSION(KI) :: ZSFCO2 ! CO2 flux over town -! -REAL, DIMENSION(KI) :: ZRI ! Richardson number -REAL, DIMENSION(KI) :: ZCD ! drag coefficient -REAL, DIMENSION(KI) :: ZCDN ! neutral drag coefficient -REAL, DIMENSION(KI) :: ZCH ! heat drag -REAL, DIMENSION(KI) :: ZRN ! net radiation over town -REAL, DIMENSION(KI) :: ZH ! sensible heat flux over town -REAL, DIMENSION(KI) :: ZLE ! latent heat flux over town -REAL, DIMENSION(KI) :: ZGFLX ! flux through the ground -REAL, DIMENSION(KI) :: ZEVAP ! evaporation (km/m2/s) -! -REAL, DIMENSION(KI) :: ZAVG_CD ! aggregated drag coefficient -REAL, DIMENSION(KI) :: ZAVG_CDN ! aggregated neutral drag coefficient -REAL, DIMENSION(KI) :: ZAVG_RI ! aggregated Richardson number -REAL, DIMENSION(KI) :: ZAVG_CH ! aggregated Heat transfer coefficient -! -REAL, DIMENSION(KI) :: ZUSTAR ! friction velocity -REAL, DIMENSION(KI) :: ZSFU ! momentum flux for patch (U direction) -REAL, DIMENSION(KI) :: ZSFV ! momentum flux for patch (V direction) -! -REAL, DIMENSION(KI) :: ZH_TRAFFIC ! anthropogenic sensible -! ! heat fluxes due to traffic -REAL, DIMENSION(KI) :: ZLE_TRAFFIC ! anthropogenic latent -! ! heat fluxes due to traffic -! -REAL :: ZBEGIN_TRAFFIC_TIME ! start traffic time (solar time, s) -REAL :: ZEND_TRAFFIC_TIME ! end traffic time (solar time, s) -! -REAL, DIMENSION(KI) :: ZRESA ! aerodynamical resistance -! -REAL, DIMENSION(KI) :: ZEMIT_LW_FAC -REAL, DIMENSION(KI) :: ZT_RAD_IND ! Indoor mean radiant temperature [K] -REAL, DIMENSION(KI) :: ZREF_SW_FAC ! total solar rad reflected from facade -! -REAL, DIMENSION(KI) :: ZAVG_Z0 -REAL, DIMENSION(KI) :: ZAVG_RESA -REAL, DIMENSION(KI) :: ZAVG_USTAR ! town avegared Ustar -REAL, DIMENSION(KI) :: ZAVG_BLD ! town averaged building fraction -REAL, DIMENSION(KI) :: ZAVG_BLD_HEIGHT ! town averaged building height -REAL, DIMENSION(KI) :: ZAVG_WL_O_HOR ! town averaged Wall/hor ratio -REAL, DIMENSION(KI) :: ZAVG_CAN_HW_RATIO ! town averaged road aspect ratio -REAL, DIMENSION(KI) :: ZAVG_H -REAL, DIMENSION(KI) :: ZAVG_LE -REAL, DIMENSION(KI) :: ZAVG_RN -REAL, DIMENSION(KI) :: ZAVG_GFLX -REAL, DIMENSION(KI) :: ZAVG_REF_SW_FAC -REAL, DIMENSION(KI) :: ZAVG_EMIT_LW_FAC -REAL, DIMENSION(KI) :: ZAVG_T_RAD_IND -! -! absorbed solar and infra-red radiation by road, wall and roof -! -REAL, DIMENSION(KI) :: ZU_UTCI ! wind speed for the UTCI calculation (m/s) - -REAL, DIMENSION(KI) :: ZALFAU ! V+(1) = alfa u'w'(1) + beta -REAL, DIMENSION(KI) :: ZBETAU ! V+(1) = alfa u'w'(1) + beta -REAL, DIMENSION(KI) :: ZALFAT ! Th+(1) = alfa w'th'(1) + beta -REAL, DIMENSION(KI) :: ZBETAT ! Th+(1) = alfa w'th'(1) + beta -REAL, DIMENSION(KI) :: ZALFAQ ! Q+(1) = alfa w'q'(1) + beta -REAL, DIMENSION(KI) :: ZBETAQ ! Q+(1) = alfa w'q'(1) + beta -!***** CANOPY ***** -REAL, DIMENSION(KI) :: ZWAKE ! reduction of average wind speed -! ! in canyon due to direction average. - -!new local variables for UTCI calculation -REAL, DIMENSION(KI) :: ZF1_o_B -! -!***** CANOPY ***** -REAL, DIMENSION(KI) :: ZSFLUX_U ! Surface flux u'w' (m2/s2) -REAL, DIMENSION(KI) :: ZSFLUX_T ! Surface flux w'T' (mK/s) -REAL, DIMENSION(KI) :: ZSFLUX_Q ! Surface flux w'q' (kgm2/s) -REAL, DIMENSION(KI,SB%NLVL) :: ZFORC_U ! tendency due to drag force for wind -REAL, DIMENSION(KI,SB%NLVL) :: ZDFORC_UDU! formal derivative of -! ! tendency due to drag force for wind -REAL, DIMENSION(KI,SB%NLVL) :: ZFORC_E ! tendency due to drag force for TKE -REAL, DIMENSION(KI,SB%NLVL) :: ZDFORC_EDE! formal derivative of -! ! tendency due to drag force for TKE -REAL, DIMENSION(KI,SB%NLVL) :: ZFORC_T ! tendency due to drag force for Temp -REAL, DIMENSION(KI,SB%NLVL) :: ZDFORC_TDT! formal derivative of -! ! tendency due to drag force for Temp -REAL, DIMENSION(KI,SB%NLVL) :: ZFORC_Q ! tendency due to drag force for hum -REAL, DIMENSION(KI,SB%NLVL) :: ZDFORC_QDQ! formal derivative of -! ! tendency due to drag force for hum. -REAL, DIMENSION(KI) :: ZLAMBDA_F ! frontal density (-) -REAL, DIMENSION(KI) :: ZLMO ! Monin-Obukhov length at canopy height (m) -REAL, DIMENSION(KI,SB%NLVL) :: ZL ! Mixing length generic profile at mid levels -! -REAL, DIMENSION(KI) :: ZCOEF -! -REAL :: ZCONVERTFACM0_SLT, ZCONVERTFACM0_DST -REAL :: ZCONVERTFACM3_SLT, ZCONVERTFACM3_DST -REAL :: ZCONVERTFACM6_SLT, ZCONVERTFACM6_DST -! -INTEGER :: JI -INTEGER :: JLAYER -INTEGER :: JJ -! -! number of TEB patches -! -INTEGER :: JP, IBEG, IEND ! loop counter -! -REAL(KIND=JPRB) :: ZHOOK_HANDLE -! -!------------------------------------------------------------------------------------- -! Preliminaries: -!------------------------------------------------------------------------------------- -IF (LHOOK) CALL DR_HOOK('COUPLING_TEB_N',0,ZHOOK_HANDLE) -IF (HTEST/='OK') THEN - CALL ABOR1_SFX('COUPLING_TEBN: FATAL ERROR DURING ARGUMENT TRANSFER') -END IF - -!------------------------------------------------------------------------------------- -! -! scalar fluxes -! -PSFTS(:,:) = 0. -! -! broadband radiative fluxes -! -ZDIR_SW(:) = 0. -ZSCA_SW(:) = 0. -DO JSWB=1,KSW - !add directionnal contrib from scattered radiation - CALL CIRCUMSOLAR_RAD(PDIR_SW(:,JSWB), PSCA_SW(:,JSWB), PZENITH, ZF1_o_B) - ZDIR_SWB(:,JSWB) = PDIR_SW(:,JSWB) + PSCA_SW(:,JSWB) * ZF1_o_B - ZSCA_SWB(:,JSWB) = PSCA_SW(:,JSWB) * (1. - ZF1_o_B) - !add directionnal contrib from scattered radiation - DO JJ=1,SIZE(PDIR_SW,1) - ZDIR_SW(JJ) = ZDIR_SW(JJ) + ZDIR_SWB(JJ,JSWB) - ZSCA_SW(JJ) = ZSCA_SW(JJ) + ZSCA_SWB(JJ,JSWB) - ENDDO -END DO -! -DO JJ=1,KI -! specific humidity (conversion from kg/m3 to kg/kg) -! - ZQA(JJ) = PQA(JJ) / PRHOA(JJ) -! -! wind -! - ZWIND(JJ) = SQRT(PU(JJ)**2+PV(JJ)**2) -! -ENDDO -! method of wind coupling -! -IF (HCOUPLING=='I') THEN - ZPEW_A_COEF = PPEW_A_COEF - ZPEW_B_COEF = PPEW_B_COEF -ELSE - ZPEW_A_COEF = 0. - ZPEW_B_COEF = ZWIND -END IF -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Time evolution -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! -TOP%TTIME%TIME = TOP%TTIME%TIME + PTSTEP - CALL ADD_FORECAST_TO_DATE_SURF(TOP%TTIME%TDATE%YEAR, TOP%TTIME%TDATE%MONTH,& - TOP%TTIME%TDATE%DAY, TOP%TTIME%TIME) -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Anthropogenic fluxes (except building heating) -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! -ZBEGIN_TRAFFIC_TIME = 21600. -ZEND_TRAFFIC_TIME = 64800. -! -WHERE( PTSUN>ZBEGIN_TRAFFIC_TIME .AND. PTSUN<ZEND_TRAFFIC_TIME ) - ZH_TRAFFIC (:) = NT%AL(1)%XH_TRAFFIC (:) - ZLE_TRAFFIC (:) = NT%AL(1)%XLE_TRAFFIC (:) -ELSEWHERE - ZH_TRAFFIC (:) = 0. - ZLE_TRAFFIC (:) = 0. -END WHERE -! -!-------------------------------------------------------------------------------------- -! Canyon forcing for TEB -!-------------------------------------------------------------------------------------- -!------------------------------------------------------------------------------------- -! Town averaged quantities to force canopy atmospheric layers -!------------------------------------------------------------------------------------- - -DO JP=1,TOP%NTEB_PATCH - CALL ADD_PATCH_CONTRIB(JP,ZAVG_BLD, NT%AL(JP)%XBLD ) - CALL ADD_PATCH_CONTRIB(JP,ZAVG_BLD_HEIGHT, NT%AL(JP)%XBLD_HEIGHT ) - CALL ADD_PATCH_CONTRIB(JP,ZAVG_WL_O_HOR, NT%AL(JP)%XWALL_O_HOR ) - CALL ADD_PATCH_CONTRIB(JP,ZAVG_CAN_HW_RATIO,NT%AL(JP)%XCAN_HW_RATIO) - CALL ADD_PATCH_CONTRIB(JP,ZAVG_Z0, NT%AL(JP)%XZ0_TOWN ) -END DO -! -IF (TOP%LCANOPY) THEN - !------------------------------------------------------------------------------------- - ! Updates canopy vertical grid as a function of forcing height - !------------------------------------------------------------------------------------- - ! - !* determines where is the forcing level and modifies the upper levels of the canopy grid - ! - CALL CANOPY_GRID_UPDATE(KI, ZAVG_BLD_HEIGHT, ZAVG_BLD_HEIGHT+PUREF, SB) - ! - !* Initialisations of T, Q, TKE and wind at first time step - ! - IF(ANY(SB%XT(:,:) == XUNDEF)) THEN - DO JLAYER=1,SB%NLVL - SB%XT(:,JLAYER) = PTA(:) - SB%XQ(:,JLAYER) = PQA(:) - SB%XU(:,JLAYER) = 2./XPI * ZWIND(:) & - * LOG( ( 2.* NT%AL(1)%XBLD_HEIGHT(:)/3.) / NT%AL(1)%XZ0_TOWN(:)) & - / LOG( (PUREF(:)+ 2.* NT%AL(1)%XBLD_HEIGHT(:)/3.) / NT%AL(1)%XZ0_TOWN(:)) - END DO - SB%XTKE(:,:) = 1. - ENDIF - ! - !* default forcing above roof: forcing level - ZUREF(:) = PUREF(:) - ZZREF(:) = PZREF(:) - ZUA(:) = SB%XU(:,SB%NLVL) - ZTA(:) = SB%XT(:,SB%NLVL) - ZQA(:) = SB%XQ(:,SB%NLVL)/PRHOA(:) - ZPA(:) = SB%XP(:,SB%NLVL) - !* for the time being, only one value is kept for wall in-canyon forcing, in the middle of the canyon - ZU_CANYON(:) = ZUA(:) - ZT_CANYON(:) = ZTA(:) - ZQ_CANYON(:) = ZQA(:) - DO JLAYER=1,SB%NLVL-1 - DO JI=1,KI - !* finds middle canyon layer - IF (SB%XZ(JI,JLAYER)<ZAVG_BLD_HEIGHT(JI)/2. .AND. SB%XZ(JI,JLAYER+1)>=ZAVG_BLD_HEIGHT(JI)/2.) THEN - ZCOEF(JI) = (ZAVG_BLD_HEIGHT(JI)/2.-SB%XZ(JI,JLAYER))/(SB%XZ(JI,JLAYER+1)-SB%XZ(JI,JLAYER)) - ZU_CANYON(JI) = SB%XU(JI,JLAYER) + ZCOEF(JI) * (SB%XU(JI,JLAYER+1)-SB%XU(JI,JLAYER)) - ZT_CANYON(JI) = SB%XT(JI,JLAYER) + ZCOEF(JI) * (SB%XT(JI,JLAYER+1)-SB%XT(JI,JLAYER)) - ZQ_CANYON(JI) =(SB%XQ(JI,JLAYER) + ZCOEF(JI) * (SB%XQ(JI,JLAYER+1)-SB%XQ(JI,JLAYER)))/PRHOA(JI) - END IF - !* finds layer just above roof (at least 1m above roof) - IF (SB%XZ(JI,JLAYER)<ZAVG_BLD_HEIGHT(JI)+1. .AND. SB%XZ(JI,JLAYER+1)>=ZAVG_BLD_HEIGHT(JI)+1.) THEN - ZUREF(JI) = SB%XZ(JI,JLAYER+1) - ZAVG_BLD_HEIGHT(JI) - ZZREF(JI) = SB%XZ(JI,JLAYER+1) - ZAVG_BLD_HEIGHT(JI) - ZTA (JI) = SB%XT(JI,JLAYER+1) - ZQA (JI) = SB%XQ(JI,JLAYER+1)/PRHOA(JI) - !ZUA (JI) = XU(JI,JLAYER+1) - ZUA (JI) = MAX(SB%XU(JI,JLAYER+1) - 2.*SQRT(SB%XTKE(JI,JLAYER+1)) , SB%XU(JI,JLAYER+1)/3.) - ZPA (JI) = SB%XP(JI,JLAYER+1) - ZLMO (JI) = SB%XLMO(JI,JLAYER+1) - END IF - END DO - END DO - ZU_CANYON= MAX(ZU_CANYON,0.2) - ZU_LOWCAN=SB%XU(:,1) - ZT_LOWCAN=SB%XT(:,1) - ZQ_LOWCAN=SB%XQ(:,1) / PRHOA(:) - ZZ_LOWCAN=SB%XZ(:,1) - WHERE(ZPA==XUNDEF) ZPA = PPA ! security for first time step - ! - !------------------------------------------------------------------------------------- - ! determine the vertical profile for mixing and dissipative lengths (at full levels) - !------------------------------------------------------------------------------------- - ! - ! frontal density - ZLAMBDA_F(:) = ZAVG_CAN_HW_RATIO*ZAVG_BLD / (0.5*XPI) - ! - CALL SM10(SB%XZ, ZAVG_BLD_HEIGHT, ZLAMBDA_F, ZL) - ! - !------------------------------------------------------------------------------------- - ! computes coefficients for implicitation - !------------------------------------------------------------------------------------- - ! - ZAVG_UW_GRND(:) = 0. - ZAVG_DUWDU_GRND(:) = 0. - ZAVG_UW_RF(:) = 0. - ZAVG_DUWDU_RF(:) = 0. - ZAVG_H_GRND(:) = 0. - ZAVG_H_WL(:) = 0. - ZAVG_H_RF(:) = 0. - ZAVG_E_GRND(:) = 0. - ZAVG_E_RF(:) = 0. - ZAVG_AC_GRND(:) = 0. - ZAVG_AC_GRND_WAT(:)= 0. - ZSFLUX_U(:) = 0. - ZSFLUX_T(:) = 0. - ZSFLUX_Q(:) = 0. - ! - DO JLAYER=1,SB%NLVL-1 - !* Monin-Obuhkov theory not used inside the urban canopy - ! => neutral mixing if layer is below : (roof level +1 meter) - WHERE (SB%XZ(:,JLAYER)<=ZAVG_BLD_HEIGHT(:)+1.) SB%XLMO(:,JLAYER) = XUNDEF - ENDDO - ! - !* computes tendencies on wind and Tke due to canopy - CALL TEB_CANOPY(KI, SB, ZAVG_BLD, ZAVG_BLD_HEIGHT, ZAVG_WL_O_HOR, PPA, PRHOA, & - ZAVG_DUWDU_GRND, ZAVG_UW_RF, ZAVG_DUWDU_RF, ZAVG_H_WL, & - ZAVG_H_RF, ZAVG_E_RF, ZAVG_AC_GRND, ZAVG_AC_GRND_WAT, ZFORC_U, & - ZDFORC_UDU, ZFORC_E, ZDFORC_EDE, ZFORC_T, ZDFORC_TDT, ZFORC_Q, & - ZDFORC_QDQ ) - ! - !* computes coefficients for implicitation - CALL CANOPY_EVOL(SB, KI, PTSTEP, 1, ZL, ZWIND, PTA, PQA, PPA, PRHOA, & - ZSFLUX_U, ZSFLUX_T, ZSFLUX_Q, ZFORC_U, ZDFORC_UDU, & - ZFORC_E, ZDFORC_EDE, ZFORC_T, ZDFORC_TDT, ZFORC_Q, & - ZDFORC_QDQ, SB%XLM, SB%XLEPS, ZAVG_USTAR, ZALFAU, & - ZBETAU, ZALFAT, ZBETAT, ZALFAQ, ZBETAQ) - ! - ZPEW_A_COEF_LOWCAN = - ZALFAU / PRHOA - ZPEW_B_COEF_LOWCAN = ZBETAU - ! - !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -ELSE ! no canopy case - !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - DO JI=1,KI - !* skimming flow for h/w>1 (maximum effect of direction on wind in the canyon); - !* isolated flow for h/w<0.5 (wind is the same in large streets for all dir.) - !* wake flow between. - ! - ZWAKE(JI)= 1. + (2./XPI-1.) * 2. * (ZAVG_CAN_HW_RATIO(JI)-0.5) - ZWAKE(JI)= MAX(MIN(ZWAKE(JI),1.),2./XPI) - ! - !* Estimation of canyon wind speed from wind just above roof level - ! (at 1.33h). Wind at 1.33h is estimated using the log law. - ! - IF (ZAVG_BLD_HEIGHT(JI) .GT. 0.) THEN - ZU_CANYON(JI) = ZWAKE(JI) * EXP(-ZAVG_CAN_HW_RATIO(JI)/4.) * ZWIND(JI) & - * LOG( ( 2.* ZAVG_BLD_HEIGHT(JI)/3.) / ZAVG_Z0(JI)) & - / LOG( (PUREF(JI)+ 2.* ZAVG_BLD_HEIGHT(JI)/3.) / ZAVG_Z0(JI)) - ZZ_LOWCAN(JI) = ZAVG_BLD_HEIGHT(JI) / 2. - ELSE - ZU_CANYON(JI) = ZWIND(JI) - ZZ_LOWCAN(JI) = PZREF(JI) - ENDIF - END DO - ! - !* Without SBL scheme, canyon air is assumed at mid height - ZU_LOWCAN = ZU_CANYON - - ZT_LOWCAN = NT%AL(1)%XT_CANYON - ZQ_LOWCAN = NT%AL(1)%XQ_CANYON - ZT_CANYON = NT%AL(1)%XT_CANYON - ZQ_CANYON = NT%AL(1)%XQ_CANYON - - ZUREF = PUREF - ZZREF = PZREF - ZTA = PTA - ZUA = ZWIND - ZPA = PPA - ZPEW_A_COEF_LOWCAN = 0. - ZPEW_B_COEF_LOWCAN = ZU_CANYON - -END IF -! -! Exner functions -! -ZEXNS (:) = (PPS(:)/XP00)**(XRD/XCPD) -ZEXNA (:) = (ZPA(:)/XP00)**(XRD/XCPD) - -!-------------------------------------------------------------------------------------- -! Over Urban surfaces/towns: -!-------------------------------------------------------------------------------------- -! -DO JP = 1,TOP%NTEB_PATCH - ! - ZT_CAN = ZT_CANYON - ZQ_CAN = ZQ_CANYON - ! - IF (TOP%LCANOPY) THEN - NT%AL(JP)%XT_CANYON(:) = ZT_CANYON(:) - NT%AL(JP)%XQ_CANYON(:) = ZQ_CANYON(:) - END IF - ! - ZLESN_RF(:) = 0. - ZLESN_RD(:) = 0. - TD%NDMT%AL(JP)%XG_GREENROOF_ROOF(:) = 0. - ! - ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! Call the physical routines of TEB (including gardens & greenroofs) - ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! - CALL TEB_GARDEN(DTCO, G, TOP, NT%AL(JP), BOP, NB%AL(JP), TPN, TIR, TD%NDMT%AL(JP), GDM, GRM, JP, & - CIMPLICIT_WIND, PTSUN, ZT_CAN, ZQ_CAN, ZU_CANYON, ZT_LOWCAN, ZQ_LOWCAN, & - ZU_LOWCAN, ZZ_LOWCAN, ZPEW_A_COEF, ZPEW_B_COEF, ZPEW_A_COEF_LOWCAN, & - ZPEW_B_COEF_LOWCAN, PPS, ZPA, ZEXNS, ZEXNA, ZTA, ZQA, PRHOA, PCO2, PLW, & - ZDIR_SWB, ZSCA_SWB, PSW_BANDS, KSW, PZENITH, PAZIM, PRAIN, PSN, ZZREF, & - ZUREF, ZUA, ZH_TRAFFIC, ZLE_TRAFFIC, PTSTEP, ZLEW_RF, ZLEW_RD, ZLE_WL_A,& - ZLE_WL_B, ZRNSN_RF, ZHSN_RF, ZLESN_RF, ZGSN_RF, ZMELT_RF, ZRNSN_RD, & - ZHSN_RD, ZLESN_RD, ZGSN_RD, ZMELT_RD, ZRN_GRND, ZH_GRND, ZLE_GRND, & - ZGFLX_GRND, ZRN, ZH, ZLE, ZGFLX, ZEVAP, ZSFCO2, ZUW_GRND, & - ZUW_RF, ZDUWDU_GRND, ZDUWDU_RF, ZUSTAR, ZCD, ZCDN, ZCH, ZRI, ZTRAD, & - ZEMIS, ZDIR_ALB, ZSCA_ALB, ZRESA, ZAC_RD, ZAC_GD, ZAC_GRF, ZAC_RD_WAT, & - ZAC_GD_WAT, ZAC_GRF_WAT, KDAY, ZEMIT_LW_FAC, ZEMIT_LW_GRND, ZT_RAD_IND, & - ZREF_SW_GRND, ZREF_SW_FAC, ZHU_BLD, PTIME, ZPROD_BLD ) - - - ! - IF (.NOT. TOP%LCANOPY) THEN - - CALL ADD_PATCH_CONTRIB(JP,ZAVG_T_CANYON,ZT_CAN) - CALL ADD_PATCH_CONTRIB(JP,ZAVG_Q_CANYON,ZQ_CAN) - ! - ! Momentum fluxes - ! - ZSFU = 0. - ZSFV = 0. - DO JJ=1,SIZE(PU) - IF (ZWIND(JJ)>0.) THEN - ZCOEF(JJ) = - PRHOA(JJ) * ZUSTAR(JJ)**2 / ZWIND(JJ) - ZSFU(JJ) = ZCOEF(JJ) * PU(JJ) - ZSFV(JJ) = ZCOEF(JJ) * PV(JJ) - ENDIF - ENDDO - CALL ADD_PATCH_CONTRIB(JP,PSFU,ZSFU) - CALL ADD_PATCH_CONTRIB(JP,PSFV,ZSFV) - ! - ENDIF - ! - !------------------------------------------------------------------------------------- - ! Outputs: - !------------------------------------------------------------------------------------- - ! - ! Grid box average fluxes/properties: Arguments and standard diagnostics - ! - CALL ADD_PATCH_CONTRIB(JP,PSFTH,ZH) - CALL ADD_PATCH_CONTRIB(JP,PSFTQ,ZEVAP) - CALL ADD_PATCH_CONTRIB(JP,PSFCO2,ZSFCO2) - ! - ! - ! Albedo for each wavelength and patch - ! - DO JSWB=1,SIZE(PSW_BANDS) - DO JJ=1,SIZE(ZDIR_ALB) - ZDIR_ALB_PATCH(JJ,JSWB,JP) = ZDIR_ALB(JJ) - ZSCA_ALB_PATCH(JJ,JSWB,JP) = ZSCA_ALB(JJ) - ENDDO - END DO - ! - ! emissivity and radiative temperature - ! - ZEMIS_PATCH(:,JP) = ZEMIS - ZTRAD_PATCH(:,JP) = ZTRAD - ! - ! computes some aggregated diagnostics - ! - CALL ADD_PATCH_CONTRIB(JP,ZAVG_CD ,ZCD ) - CALL ADD_PATCH_CONTRIB(JP,ZAVG_CDN,ZCDN) - CALL ADD_PATCH_CONTRIB(JP,ZAVG_RI ,ZRI ) - CALL ADD_PATCH_CONTRIB(JP,ZAVG_CH ,ZCH ) - CALL ADD_PATCH_CONTRIB(JP,ZAVG_RN ,ZRN ) - CALL ADD_PATCH_CONTRIB(JP,ZAVG_H ,ZH ) - CALL ADD_PATCH_CONTRIB(JP,ZAVG_LE ,ZLE ) - CALL ADD_PATCH_CONTRIB(JP,ZAVG_GFLX ,ZGFLX ) - ! - !* warning: aerodynamical resistance does not yet take into account gardens - CALL ADD_PATCH_CONTRIB(JP,ZAVG_RESA,1./ZRESA) - IF (JP==TOP%NTEB_PATCH) ZAVG_RESA = 1./ZAVG_RESA - ! - !------------------------------------------------------------------------------------- - ! Diagnostics on each patch - !------------------------------------------------------------------------------------- - ! - IF (TD%MTO%LSURF_MISC_BUDGET) THEN - ! - ! cumulated diagnostics - ! --------------------- - ! - CALL CUMUL_DIAG_TEB_n(TD%NDMTC%AL(JP), TD%NDMT%AL(JP), GDM%VD%NDEC%AL(JP), GDM%VD%NDE%AL(JP), & - GRM%VD%NDEC%AL(JP), GRM%VD%NDE%AL(JP), TOP, PTSTEP) - ! - END IF - ! - ! - !------------------------------------------------------------------------------------- - ! Computes averaged parameters necessary for UTCI - !------------------------------------------------------------------------------------- - ! - IF (TD%O%N2M >0 .AND. TD%DUT%LUTCI) THEN - CALL ADD_PATCH_CONTRIB(JP,ZAVG_REF_SW_GRND ,ZREF_SW_GRND ) - CALL ADD_PATCH_CONTRIB(JP,ZAVG_REF_SW_FAC ,ZREF_SW_FAC ) - CALL ADD_PATCH_CONTRIB(JP,ZAVG_SCA_SW ,ZSCA_SW ) - CALL ADD_PATCH_CONTRIB(JP,ZAVG_DIR_SW ,ZDIR_SW ) - CALL ADD_PATCH_CONTRIB(JP,ZAVG_EMIT_LW_FAC ,ZEMIT_LW_FAC ) - CALL ADD_PATCH_CONTRIB(JP,ZAVG_EMIT_LW_GRND,ZEMIT_LW_GRND) - CALL ADD_PATCH_CONTRIB(JP,ZAVG_T_RAD_IND ,ZT_RAD_IND ) - CALL ADD_PATCH_CONTRIB(JP,ZAVG_TI_BLD ,NB%AL(JP)%XTI_BLD) - CALL ADD_PATCH_CONTRIB(JP,ZAVG_QI_BLD ,NB%AL(JP)%XQI_BLD) - END IF - ! - !------------------------------------------------------------------------------------- - ! Use of the canopy version of TEB - !------------------------------------------------------------------------------------- - ! - IF (TOP%LCANOPY) THEN - !------------------------------------------------------------------------------------- - ! Town averaged quantities to force canopy atmospheric layers - !------------------------------------------------------------------------------------- - - CALL ADD_PATCH_CONTRIB(JP,ZAVG_DUWDU_GRND, ZDUWDU_GRND ) - CALL ADD_PATCH_CONTRIB(JP,ZAVG_UW_RF , ZUW_RF) - CALL ADD_PATCH_CONTRIB(JP,ZAVG_DUWDU_RF , ZDUWDU_RF) - CALL ADD_PATCH_CONTRIB(JP,ZAVG_H_WL , 0.5*(TD%NDMT%AL(JP)%XH_WALL_A+TD%NDMT%AL(JP)%XH_WALL_B)) - CALL ADD_PATCH_CONTRIB(JP,ZAVG_H_RF , (TD%NDMT%AL(JP)%XH_ROOF + NT%AL(JP)%XH_INDUSTRY)) - CALL ADD_PATCH_CONTRIB(JP,ZAVG_E_RF , (TD%NDMT%AL(JP)%XLE_ROOF+ NT%AL(JP)%XLE_INDUSTRY)/XLVTT) - ! - !------------------------------------------------------------------------------------- - ! Computes the impact of canopy and surfaces on air - !------------------------------------------------------------------------------------- - ! - ZAC_GRND (:) = (NT%AL(JP)%XROAD(:)*ZAC_RD (:) + NT%AL(JP)%XGARDEN(:)*ZAC_GD (:)) / & - (NT%AL(JP)%XROAD(:)+NT%AL(JP)%XGARDEN(:)) - ZAC_GRND_WAT(:) = (NT%AL(JP)%XROAD(:)*ZAC_RD_WAT(:) + NT%AL(JP)%XGARDEN(:)*ZAC_GD_WAT(:)) / & - (NT%AL(JP)%XROAD(:)+NT%AL(JP)%XGARDEN(:)) - ! - CALL ADD_PATCH_CONTRIB(JP,ZAVG_AC_GRND , ZAC_GRND ) - CALL ADD_PATCH_CONTRIB(JP,ZAVG_AC_GRND_WAT, ZAC_GRND_WAT) - CALL ADD_PATCH_CONTRIB(JP,ZSFLUX_U , ZUW_GRND * (1.-NT%AL(JP)%XBLD)) - CALL ADD_PATCH_CONTRIB(JP,ZSFLUX_T , ZH_GRND * (1.-NT%AL(JP)%XBLD)/XCPD/PRHOA) - CALL ADD_PATCH_CONTRIB(JP,ZSFLUX_Q , ZLE_GRND * (1.-NT%AL(JP)%XBLD)/XLVTT) - ! - END IF - ! - !------------------------------------------------------------------------------------- - ! end of loop on TEB patches -END DO -!------------------------------------------------------------------------------------- -! -!------------------------------------------------------------------------------------- -!* Evolution of canopy air if canopy option is active -!------------------------------------------------------------------------------------- -! -IF (TOP%LCANOPY) THEN - ! - !------------------------------------------------------------------------------------- - !* Impact of TEB fluxes on the air - !------------------------------------------------------------------------------------- - ! - CALL TEB_CANOPY(KI, SB, ZAVG_BLD, ZAVG_BLD_HEIGHT, ZAVG_WL_O_HOR, PPA, PRHOA, & - ZAVG_DUWDU_GRND, ZAVG_UW_RF, ZAVG_DUWDU_RF, ZAVG_H_WL, & - ZAVG_H_RF, ZAVG_E_RF, ZAVG_AC_GRND, ZAVG_AC_GRND_WAT, ZFORC_U, & - ZDFORC_UDU, ZFORC_E, ZDFORC_EDE, ZFORC_T, ZDFORC_TDT, ZFORC_Q, & - ZDFORC_QDQ ) - ! - !------------------------------------------------------------------------------------- - !* Evolution of canopy air due to these impacts - !------------------------------------------------------------------------------------- - ! - CALL CANOPY_EVOL(SB, KI, PTSTEP, 2, ZL, ZWIND, PTA, PQA, PPA, PRHOA, & - ZSFLUX_U, ZSFLUX_T, ZSFLUX_Q, ZFORC_U, ZDFORC_UDU, & - ZFORC_E, ZDFORC_EDE, ZFORC_T, ZDFORC_TDT, ZFORC_Q, & - ZDFORC_QDQ, SB%XLM, SB%XLEPS, ZAVG_USTAR, ZALFAU, & - ZBETAU, ZALFAT, ZBETAT, ZALFAQ, ZBETAQ ) - ! - !------------------------------------------------------------------------------------- - ! Momentum fluxes in the case canopy is active - !------------------------------------------------------------------------------------- - ! - PSFU=0. - PSFV=0. - ZAVG_Z0(:) = MIN(ZAVG_Z0(:),PUREF(:)*0.5) - ZAVG_CDN=(XKARMAN/LOG(PUREF(:)/ZAVG_Z0(:)))**2 - ZAVG_CD = ZAVG_CDN - ZAVG_RI = 0. - DO JJ=1,SIZE(PU) - IF (ZWIND(JJ)>0.) THEN - ZCOEF(JJ) = - PRHOA(JJ) * ZAVG_USTAR(JJ)**2 / ZWIND(JJ) - PSFU(JJ) = ZCOEF(JJ) * PU(JJ) - PSFV(JJ) = ZCOEF(JJ) * PV(JJ) - ZAVG_CD(JJ) = ZAVG_USTAR(JJ)**2 / ZWIND(JJ)**2 - ZAVG_RI(JJ) = -XG/PTA(JJ)*ZSFLUX_T(JJ)/ZAVG_USTAR(JJ)**4 - ENDIF - ENDDO - ! - !------------------------------------------------------------------------------------- - ! End of specific case with canopy option - !------------------------------------------------------------------------------------- - ! -END IF -! -!------------------------------------------------------------------------------------- -! Outputs: -!------------------------------------------------------------------------------------- -! -!------------------------------------------------------------------------------------- -!Radiative properties should be at time t+1 (see by the atmosphere) in order to close -!the energy budget between surfex and the atmosphere. It is not the case here -!for ALB and EMIS -!------------------------------------------------------------------------------------- -! - CALL AVERAGE_RAD(TOP%XTEB_PATCH, ZDIR_ALB_PATCH, ZSCA_ALB_PATCH, ZEMIS_PATCH, & - ZTRAD_PATCH, PDIR_ALB, PSCA_ALB, PEMIS, PTRAD ) -! -!------------------------------------------------------------------------------- -!Physical properties see by the atmosphere in order to close the energy budget -!between surfex and the atmosphere. All variables should be at t+1 but very -!difficult to do. Maybe it will be done later. However, Ts can be at time t+1 -!------------------------------------------------------------------------------- -! -PTSURF (:) = PTRAD (:) ! Should be the surface effective temperature; not radative -PZ0 (:) = ZAVG_Z0 (:) ! Should account for ISBA (greenroof and garden) Z0 -PZ0H (:) = PZ0 (:) / 200. ! Should account for ISBA (greenroof and garden) Z0 -PQSURF (:) = NT%AL(1)%XQ_CANYON(:) ! Should account for ISBA (greenroof and garden) Qs -! -!------------------------------------------------------------------------------------- -! Scalar fluxes: -!------------------------------------------------------------------------------------- -! -ZAVG_USTAR (:) = SQRT(SQRT(PSFU**2+PSFV**2)) -! -! -IF (CHT%SVT%NBEQ>0) THEN - - IBEG = CHT%SVT%NSV_CHSBEG - IEND = CHT%SVT%NSV_CHSEND - - IF (CHT%CCH_DRY_DEP == "WES89") THEN - CALL CH_DEP_TOWN(ZAVG_RESA, ZAVG_USTAR, PTA, PTRAD, ZAVG_WL_O_HOR,& - PSV(:,IBEG:IEND), CHT%SVT%CSV(IBEG:IEND), CHT%XDEP(:,1:CHT%SVT%NBEQ) ) - - DO JI=IBEG,IEND -!cdir nodep - DO JJ=1,SIZE(PSFTS,1) - PSFTS(JJ,JI) = - PSV(JJ,JI) * CHT%XDEP(JJ,JI-IBEG+1) - ENDDO - ENDDO - - IF (CHT%SVT%NAEREQ > 0 ) THEN - - IBEG = CHT%SVT%NSV_AERBEG - IEND = CHT%SVT%NSV_AEREND - - CALL CH_AER_DEP(PSV(:,IBEG:IEND), PSFTS(:,IBEG:IEND), & - ZAVG_USTAR, ZAVG_RESA, PTA, PRHOA) - END IF - - ELSE - - IBEG = CHT%SVT%NSV_CHSBEG - IEND = CHT%SVT%NSV_CHSEND - - DO JI=IBEG,IEND - PSFTS(:,JI) =0. - ENDDO - - IBEG = CHT%SVT%NSV_AERBEG - IEND = CHT%SVT%NSV_AEREND - - IF(IBEG.LT.IEND) THEN - DO JI=IBEG,IEND - PSFTS(:,JI) =0. - ENDDO - ENDIF - ENDIF - -ENDIF - -IF (CHT%SVT%NDSTEQ>0) THEN - ! - IBEG = CHT%SVT%NSV_DSTBEG - IEND = CHT%SVT%NSV_DSTEND - ! - CALL DSLT_DEP(PSV(:,IBEG:IEND), PSFTS(:,IBEG:IEND), ZAVG_USTAR, ZAVG_RESA, PTA, PRHOA, & - DST%XEMISSIG_DST, DST%XEMISRADIUS_DST, JPMODE_DST, XDENSITY_DST, & - XMOLARWEIGHT_DST, ZCONVERTFACM0_DST, ZCONVERTFACM6_DST, & - ZCONVERTFACM3_DST, LVARSIG_DST, LRGFIX_DST, CVERMOD ) - - CALL MASSFLUX2MOMENTFLUX( & - PSFTS(:,IBEG:IEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments - PRHOA, & !I [kg/m3] air density - DST%XEMISRADIUS_DST, &!I [um] emitted radius for the modes (max 3) - DST%XEMISSIG_DST, &!I [-] emitted sigma for the different modes (max 3) - NDSTMDE, & - ZCONVERTFACM0_DST, & - ZCONVERTFACM6_DST, & - ZCONVERTFACM3_DST, & - LVARSIG_DST, LRGFIX_DST ) -ENDIF -IF (CHT%SVT%NSLTEQ>0) THEN - ! - IBEG = CHT%SVT%NSV_SLTBEG - IEND = CHT%SVT%NSV_SLTEND - ! - CALL DSLT_DEP(PSV(:,IBEG:IEND), PSFTS(:,IBEG:IEND), ZAVG_USTAR, ZAVG_RESA, PTA, PRHOA, & - SLT%XEMISSIG_SLT, SLT%XEMISRADIUS_SLT, JPMODE_SLT, XDENSITY_SLT, & - XMOLARWEIGHT_SLT, ZCONVERTFACM0_SLT, ZCONVERTFACM6_SLT, & - ZCONVERTFACM3_SLT, LVARSIG_SLT, LRGFIX_SLT, CVERMOD ) - - CALL MASSFLUX2MOMENTFLUX( & - PSFTS(:,IBEG:IEND), & !I/O ![kg/m2/sec] In: flux of only mass, out: flux of moments - PRHOA, & !I [kg/m3] air density - SLT%XEMISRADIUS_SLT, &!I [um] emitted radius for the modes (max 3) - SLT%XEMISSIG_SLT, &!I [-] emitted sigma for the different modes (max 3) - NSLTMDE, & - ZCONVERTFACM0_SLT, & - ZCONVERTFACM6_SLT, & - ZCONVERTFACM3_SLT, & - LVARSIG_SLT, LRGFIX_SLT ) - -ENDIF -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Inline diagnostics -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! - CALL DIAG_INLINE_TEB_n(TD%O, TD%D, SB, NT%AL(1), TOP%LCANOPY, & - PTA, PTRAD, ZQA, PPA, PPS, PRHOA, PU, PV, ZWIND, PZREF, PUREF, & - ZAVG_CD, ZAVG_CDN, ZAVG_RI, ZAVG_CH, ZAVG_Z0, PTRAD, PEMIS, & - PDIR_ALB, PSCA_ALB, PLW, ZDIR_SWB, ZSCA_SWB, PSFTH, PSFTQ, & - PSFU, PSFV, PSFCO2, ZAVG_RN, ZAVG_H, ZAVG_LE, ZAVG_GFLX ) -! -!------------------------------------------------------------------------------------- -! Stores Canyon air and humidity if historical option of TEB is active -!------------------------------------------------------------------------------------- -! -IF (.NOT. TOP%LCANOPY) THEN - DO JP=1,TOP%NTEB_PATCH - NT%AL(JP)%XT_CANYON(:) = ZAVG_T_CANYON(:) - NT%AL(JP)%XQ_CANYON(:) = ZAVG_Q_CANYON(:) - END DO -END IF -! -!------------------------------------------------------------------------------------- -! Thermal confort index -!------------------------------------------------------------------------------------- -! -IF (TD%DUT%LUTCI .AND. TD%O%N2M >0) THEN - DO JJ=1,KI - IF (TD%D%XZON10M(JJ)/=XUNDEF) THEN - ZU_UTCI(JJ) = SQRT(TD%D%XZON10M(JJ)**2+TD%D%XMER10M(JJ)**2) - ELSE - ZU_UTCI(JJ) = ZWIND(JJ) - ENDIF - ENDDO - CALL UTCI_TEB(NT%AL(1), TD%DUT, ZAVG_TI_BLD, ZAVG_QI_BLD, ZU_UTCI, PPS, ZAVG_REF_SW_GRND, & - ZAVG_REF_SW_FAC, ZAVG_SCA_SW, ZAVG_DIR_SW, PZENITH, ZAVG_EMIT_LW_FAC, & - ZAVG_EMIT_LW_GRND, PLW, ZAVG_T_RAD_IND ) - CALL UTCIC_STRESS(PTSTEP,TD%DUT%XUTCI_IN ,TD%DUT%XUTCIC_IN ) - CALL UTCIC_STRESS(PTSTEP,TD%DUT%XUTCI_OUTSUN ,TD%DUT%XUTCIC_OUTSUN ) - CALL UTCIC_STRESS(PTSTEP,TD%DUT%XUTCI_OUTSHADE,TD%DUT%XUTCIC_OUTSHADE) -ELSE IF (TD%DUT%LUTCI) THEN - TD%DUT%XUTCI_IN (:) = XUNDEF - TD%DUT%XUTCI_OUTSUN (:) = XUNDEF - TD%DUT%XUTCI_OUTSHADE (:) = XUNDEF - TD%DUT%XTRAD_SUN (:) = XUNDEF - TD%DUT%XTRAD_SHADE (:) = XUNDEF - TD%DUT%XUTCIC_IN (:,:) = XUNDEF - TD%DUT%XUTCIC_OUTSUN (:,:) = XUNDEF - TD%DUT%XUTCIC_OUTSHADE(:,:) = XUNDEF -ENDIF - -! -IF (LHOOK) CALL DR_HOOK('COUPLING_TEB_N',1,ZHOOK_HANDLE) -! -!------------------------------------------------------------------------------------- -CONTAINS -SUBROUTINE ADD_PATCH_CONTRIB(JP,PAVG,PFIELD) -INTEGER, INTENT(IN) :: JP -REAL, DIMENSION(:), INTENT(INOUT) :: PAVG -REAL, DIMENSION(:), INTENT(IN) :: PFIELD -! -IF (JP==1) PAVG = 0. -PAVG = PAVG + TOP%XTEB_PATCH(:,JP) * PFIELD(:) -! -END SUBROUTINE ADD_PATCH_CONTRIB -!------------------------------------------------------------------------------------- -! -END SUBROUTINE COUPLING_TEB_n - - diff --git a/src/ICCARE_BASE/default_desfmn.f90 b/src/ICCARE_BASE/default_desfmn.f90 deleted file mode 100644 index 8324b19c6..000000000 --- a/src/ICCARE_BASE/default_desfmn.f90 +++ /dev/null @@ -1,1409 +0,0 @@ -!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!----------------------------------------------------------------- -! ########################### - MODULE MODI_DEFAULT_DESFM_n -! ########################### -! -INTERFACE -! -SUBROUTINE DEFAULT_DESFM_n(KMI) -INTEGER, INTENT(IN) :: KMI ! Model index -END SUBROUTINE DEFAULT_DESFM_n -! -END INTERFACE -! -END MODULE MODI_DEFAULT_DESFM_n -! -! -! -! ############################### - SUBROUTINE DEFAULT_DESFM_n(KMI) -! ############################### -! -!!**** *DEFAULT_DESFM_n * - set default values for descriptive variables of -!! model KMI -!! -!! PURPOSE -!! ------- -! The purpose of this routine is to set default values for the variables -! in descriptor files by filling the corresponding variables which -! are stored in modules. -! -! -!!** METHOD -!! ------ -!! Each variable in modules, which can be initialized by reading its -!! value in the descriptor file is set to a default value. -!! When this routine is used during INIT, the modules of the first model -!! are used to temporarily store the variables associated with a nested -!! model. -!! When this routine is used during SPAWNING, the modules of a second -!! model must be initialized. -!! Default values for variables common to all models are set only -!! at the first call of DEFAULT_DESFM_n (i.e. when KMI=1) -!! -!! -!! EXTERNAL -!! -------- -!! NONE -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! Module MODD_PARAMETERS : JPHEXT,JPVEXT -!! -!! Module MODD_CONF : CCONF,L2D,L1D,LFLAT,NMODEL,NVERB -!! -!! Module MODD_DYN : XSEGLEN,XASSELIN,LCORIO,LNUMDIFF -!! XALKTOP,XALZBOT -!! -!! Module MODD_BAKOUT -!! -!! Module MODD_NESTING : NDAD(m),NDTRATIO(m),XWAY(m) -!! -!! Module MODD_CONF_n : LUSERV,LUSERC,LUSERR,LUSERI,LUSERS -!! LUSERG,LUSERH,CSEG,CEXP -!! -!! Module MODD_LUNIT_n : CINIFILE,CCPLFILE -!! -!! -!! Module MODD_DYN_n : XTSTEP,CPRESOPT,NITR,XRELAX,LHO_RELAX -!! LVE_RELAX,XRIMKMAX,NRIMX,NRIMY -!! -!! Module MODD_ADV_n : CUVW_ADV_SCHEME,CMET_ADV_SCHEME,CSV_ADV_SCHEME,NLITER -!! -!! Module MODD_PARAM_n : CTURB,CRAD,CDCONV,CSCONV -!! -!! Module MODD_LBC_n : CLBCX, CLBCY,NLBLX,NLBLY,XCPHASE,XCPHASE_PBL,XPOND -!! -!! Module MODD_TURB_n : XIMPL,CTURBLEN,CTURBDIM,LTURB_FLX,LTURB_DIAG,LSUBG_COND -!! LTGT_FLX -!! -!! -!! Module MODD_PARAM_RAD_n: -!! XDTRAD,XDTRAD_CLONLY,LCLEAR_SKY,NRAD_COLNBR, NRAD_DIAG -!! -!! Module MODD_BUDGET : CBUTYPE,NBUMOD,XBULEN,NBUKL, NBUKH,LBU_KCP,XBUWRI -!! NBUIL, NBUIH,NBUJL, NBUJH,LBU_ICP,LBU_JCP,NBUMASK -!! -!! Module MODD_BLANK_n: -!! -!! XDUMMYi, NDUMMYi, LDUMMYi, CDUMMYi -!! -!! Module MODD_FRC : -!! -!! LGEOST_UV_FRC,LGEOST_TH_FRC,LTEND_THRV_FRC -!! LVERT_MOTION_FRC,LRELAX_THRV_FRC,LRELAX_UV_FRC,LRELAX_UVMEAN_FRC, -!! XRELAX_TIME_FRC -!! XRELAX_HEIGHT_FRC,CRELAX_HEIGHT_TYPE,LTRANS,XUTRANS,XVTRANS, -!! LPGROUND_FRC -!! -!! Module MODD_PARAM_ICE : -!! -!! LWARM,CPRISTINE_ICE -!! -!! Module MODD_PARAM_KAFR_n : -!! -!! XDTCONV,LREFRESH_ALL,LDOWN,NICE,LCHTRANS -!! -!! Module MODD_PARAM_MFSHALL_n : -!! -!! CMF_UPDRAFT,LMIXUV,CMF_CLOUD,XIMPL_MF,LMF_FLX -!! -!! -!! -!! -!! REFERENCE -!! --------- -!! Book2 of the documentation (routine DEFAULT_DESFM_n) -!! -!! -!! AUTHOR -!! ------ -!! V. Ducrocq * Meteo France * -!! -!! MODIFICATIONS -!! ------------- -!! Original 02/06/94 -!! Modifications 17/10/94 (Stein) For LCORIO -!! Modifications 06/12/94 (Stein) remove LBOUSS+add LABSLAYER, LNUMDIFF -!! ,LSTEADYLS -!! Modifications 06/12/94 (Stein) remove LABSLAYER, add LHO_RELAX, -!! LVE_RELAX, NRIMX, NRIMY, XRIMKMAX -!! Modifications 09/01/95 (Lafore) add LSTEADY_DMASS -!! Modifications 09/01/95 (Stein) add the turbulence scheme namelist -!! Modifications 09/01/95 (Stein) add the 1D switch -!! Modifications 10/03/95 (Mallet) add the coupling files -!! 29/06/95 ( Stein, Nicolau, Hereil) add the budgets -!! Modifications 25/09/95 ( Stein )add the LES tools -!! Modifications 25/10/95 ( Stein )add the radiations -!! Modifications 23/10/95 (Vila, lafore) new scalar advection scheme -!! Modifications 24/02/96 (Stein) change the default value for CCPLFILE -!! Modifications 12/02/96 (Lafore) transformation to DEFAULT_DESFM_n for -!! spawning -!! Modifications 25/04/96 (Suhre) add the blank module -!! Modifications 29/07/96 (Pinty&Suhre) add module MODD_FRC -!! Modifications 11/04/96 (Pinty) add the rain-ice scheme and modify -!! the split arrays in MODD_PARAM_RAD_n -!! Modifications 11/01/97 (Pinty) add the deep convection scheme -!! Modifications 24/11/96 (Masson) add LREFRESH_ALL in deep convection -!! Modifications 12/02/96 (Lafore) transformation to DEFAULT_DESFM_n for spawning -!! Modifications 22/07/96 (Lafore) gridnesting implementation -!! Modifications 29/07/96 (Lafore) add the module MODD_FMOUT (renamed MODD_BAKOUT) -!! Modifications 23/06/97 (Stein) add the equation system name -!! Modifications 10/07/97 (Masson) add MODD_PARAM_GROUNDn : CROUGH -!! Modifications 28/07/97 (Masson) remove LREFRESH_ALL and LSTEADY_DMASS -!! Modifications 08/10/97 (Stein) switch (_n=1) to initialize the -!! parameters common to all models -!! Modifications 24/01/98 (Bechtold) add LREFRESH_ALL, LCHTRANS, -!! LTEND_THRV_FR and LSST_FRC -!! Modifications 18/07/99 (Stein) add LRAD_DIAG -!! Modification 15/03/99 (Masson) use of XUNDEF -!! Modification 11/12/00 (Tomasini) Add CSEA_FLUX to MODD_PARAMn -!! Modification 22/01/01 (Gazen) delete NSV and add LHORELAX_SVC2R2 -!! LHORELAX_SVCHEM,LHORELAX_SVLG -!! Modification 15/03/02 (Solmon) radiation scheme: remove NSPOT and add -!! default for aerosol and cloud rad. prop. control -!! Modification 22/05/02 (Jabouille) put chimical default here -!! Modification 01/2004 (Masson) removes surface (externalization) -!! 09/04 (M. Tomasini) New namelist to modify the -!! Cloud mixing length -!! 07/05 (P.Tulet) New namelists for dust and aerosol -!! Modification 01/2007 (Malardel, Pergaud) Add MODD_PARAM_MFSHALL_n -!! Modification 10/2009 (Aumond) Add user multimasks for LES -!! Modification 10/2009 (Aumond) Add MEAN_FIELD -!! Modification 12/04/07 (Leriche) add LUSECHAQ for aqueous chemistry -!! Modification 30/05/07 (Leriche) add LCH_PH and XCH_PHINIT for pH -!! Modification 25/04/08 (Leriche) add XRTMIN_AQ LWC threshold for aq. chemistry -!! 16/07/10 add LHORELAX_SVIC -!! 16/09/10 add LUSECHIC -!! 13/01/11 add LCH_RET_ICE -!! 01/07/11 (F.Couvreux) Add CONDSAMP -!! 01/07/11 (B.Aouizerats) Add CAOP -!! 07/2013 (C.Lac) add WENO, LCHECK -!! 07/2013 (Bosseur & Filippi) adds Forefire -!! 08/2015 (Redelsperger & Pianezze) add XPOND coefficient for LBC -!! Modification 24/03/16 (Leriche) remove LCH_SURFACE_FLUX -!! put NCH_VEC_LENGTH = 50 instead of 1000 -!! -!! 04/2016 (C.LAC) negative contribution to the budget split between advection, turbulence and microphysics for KHKO/C2R2 -!! Modification 01/2016 (JP Pinty) Add LIMA -!! Modification 24/03/16 (Leriche) remove LCH_SURFACE_FLUX -!! put NCH_VEC_LENGTH = 50 instead of 1000 -!! 10/2016 (C.Lac) VSIGQSAT change from 0 to 0.02 for coherence with AROME -!! 10/2016 (C.Lac) Add droplet deposition -!! 10/2016 (R.Honnert and S.Riette) : Improvement of EDKF and adaptation to the grey zone -!! 10/2016 (F Brosse) add prod/loss terms computation for chemistry -!! 07/2017 (V. Masson) adds time step for output files writing. -!! 09/2017 Q.Rodier add LTEND_UV_FRC -!! 02/2018 Q.Libois ECRAD -! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O -!! 01/2018 (S. Riette) new budgets and variables for ICE3/ICE4 -!! 01/2018 (J.Colin) add VISC and DRAG -!! 07/2017 (V. Vionnet) add blowing snow variables -!! 01/2019 (R. Honnert) add reduction of the mass-flux surface closure with the resolution -!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes -!! 05/2019 F.Brient add tracer emission from the top of the boundary-layer -!! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree -! P. Wautelet 17/04/2020: move budgets switch values into modd_budget -! P. Wautelet 30/06/2020: add NNETURSV, NNEADVSV and NNECONSV variables -! F. Auguste, T. Nagel 02/2021: add IBM defaults parameters -! T. Nagel 02/2021: add turbulence recycling defaults parameters -! P-A Joulin 21/05/2021: add Wind turbines -! S. Riette 21/05/2021: add options to PDF subgrid scheme -! D. Ricard 05/2021: add the contribution of Leonard terms in the turbulence scheme -! JL Redelsperger 06/2021: add parameters allowing to active idealized oceanic convection -! B. Vie 06/2021: add prognostic supersaturation for LIMA -! Q. Rodier 06/2021: modify default value to LGZ=F (grey-zone corr.), LSEDI and OSEDC=T (LIMA sedimentation) -! F. Couvreux 06/2021: add LRELAX_UVMEAN_FRC -! Q. Rodier 07/2021: modify XPOND=1 -! C. Barthe 03/2022: add CIBU and RDSF options in LIMA -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -USE MODD_PARAMETERS -USE MODD_CONF ! For INIT only DEFAULT_DESFM1 -USE MODD_CONFZ -USE MODD_DYN -USE MODD_NESTING -USE MODD_BAKOUT -USE MODD_SERIES -USE MODD_CONF_n ! modules used to set the default values is only -USE MODD_LUNIT_n ! the one corresponding to model 1. These memory -USE MODD_DIM_n ! addresses will then be filled by the values read in -USE MODD_DYN_n ! the DESFM corresponding to model n which may have -USE MODD_ADV_n ! missing values. This is why we affect default values. -USE MODD_PARAM_n ! For SPAWNING DEFAULT_DESFM2 is also used -USE MODD_LBC_n -USE MODD_OUT_n -USE MODD_TURB_n -USE MODD_BUDGET -USE MODD_LES -USE MODD_PARAM_RAD_n -#ifdef MNH_ECRAD -USE MODD_PARAM_ECRAD_n -#if ( VER_ECRAD == 140 ) -USE MODD_RADIATIONS_n , ONLY : NSWB_MNH, NLWB_MNH -#endif -#endif -USE MODD_BLANK_n -USE MODD_FRC -USE MODD_PARAM_ICE -USE MODD_PARAM_C2R2 -USE MODD_TURB_CLOUD -USE MODD_PARAM_KAFR_n -USE MODD_PARAM_MFSHALL_n -USE MODD_CH_MNHC_n -USE MODD_SERIES_n -USE MODD_NUDGING_n -USE MODD_CH_AEROSOL -USE MODD_DUST -USE MODD_SALT -USE MODD_PASPOL -USE MODD_CONDSAMP -USE MODD_MEAN_FIELD -USE MODD_DRAGTREE_n -USE MODD_DRAGBLDG_n -USE MODD_EOL_MAIN -USE MODD_EOL_ADNR -USE MODD_EOL_ALM -USE MODD_EOL_SHARED_IO -USE MODD_ALLSTATION_n -! -! -USE MODD_PARAM_LIMA, ONLY : LCOLD, LNUCL, LSEDI, LHHONI, LSNOW, LHAIL, LMEYERS, & - NMOD_IFN, XIFN_CONC, LIFN_HOM, CIFN_SPECIES, & - CINT_MIXING, NMOD_IMM, NIND_SPECIE, & - CPRISTINE_ICE_LIMA, CHEVRIMED_ICE_LIMA, & - XFACTNUC_DEP, XFACTNUC_CON, & - OWARM=>LWARM, LACTI, ORAIN=>LRAIN, OSEDC=>LSEDC, & - OACTIT=>LACTIT, LBOUND, LSPRO, LADJ, & - NMOD_CCN, XCCN_CONC, & - LCCN_HOM, CCCN_MODES, & - YALPHAR=>XALPHAR, YNUR=>XNUR, & - YALPHAC=>XALPHAC, YNUC=>XNUC, CINI_CCN=>HINI_CCN, & - CTYPE_CCN=>HTYPE_CCN, YFSOLUB_CCN=>XFSOLUB_CCN, & - YACTEMP_CCN=>XACTEMP_CCN, YAERDIFF=>XAERDIFF, & - YAERHEIGHT=>XAERHEIGHT, & - LSCAV, LAERO_MASS, NPHILLIPS, & - LCIBU, XNDEBRIS_CIBU, LRDSF, & - ODEPOC=>LDEPOC, OVDEPOC=>XVDEPOC, OACTTKE=>LACTTKE, & - LPTSPLIT, L_LFEEDBACKT=>LFEEDBACKT, L_NMAXITER=>NMAXITER, & - L_XMRSTEP=>XMRSTEP, L_XTSTEP_TS=>XTSTEP_TS -! -USE MODD_LATZ_EDFLX -USE MODD_2D_FRC -USE MODD_BLOWSNOW -USE MODD_BLOWSNOW_n -USE MODD_DRAG_n -USE MODD_VISCOSITY -USE MODD_RECYCL_PARAM_n -USE MODD_IBM_PARAM_n -USE MODD_IBM_LSF -#ifdef MNH_FOREFIRE -USE MODD_FOREFIRE -#endif -! -IMPLICIT NONE -! -!* 0.1 declarations of arguments -! -INTEGER, INTENT(IN) :: KMI ! Model index -! -!* 0.2 declaration of local variables -! -INTEGER :: JM ! loop index -! -!------------------------------------------------------------------------------- -! -!* 1. SET DEFAULT VALUES FOR MODD_LUNIT_n : -! ---------------------------------- -! -! CINIFILE='INIFILE' -CINIFILEPGD='' !Necessary to keep this line to prevent problems with spawning -CCPLFILE(:)=' ' -! -!------------------------------------------------------------------------------- -! -!* 2. SET DEFAULT VALUES FOR MODD_CONF AND MODD_CONF_n : -! ------------------------------------------------ -! -IF (KMI == 1) THEN - CCONF ='START' - LTHINSHELL = .FALSE. - L2D = .FALSE. - L1D = .FALSE. - LFLAT = .FALSE. - NMODEL = 1 - CEQNSYS = 'DUR' - NVERB = 5 - CEXP = 'EXP01' - CSEG = 'SEG01' - LFORCING = .FALSE. - L2D_ADV_FRC= .FALSE. - L2D_REL_FRC= .FALSE. - XRELAX_HEIGHT_BOT = 0. - XRELAX_HEIGHT_TOP = 30000. - XRELAX_TIME = 864000. - LPACK = .TRUE. - NHALO = 1 -#ifdef MNH_SX5 - CSPLIT ='YSPLITTING' ! NEC vectoriel architecture , low number of PROC -#else - CSPLIT ='BSPLITTING' ! Scalaire architecture , high number of PROC -#endif - NZ_PROC = 0 !JUAN Z_SPLITTING :: number of proc in Z splitting - NZ_SPLITTING = 10 !JUAN Z_SPLITTING :: for debug NZ=1=flat_inv; NZ=10=flat_invz; NZ=1+2 the two - LLG = .FALSE. - LINIT_LG = .FALSE. - CINIT_LG = 'FMOUT' - LNOMIXLG = .FALSE. - LCHECK = .FALSE. -END IF -! -CCLOUD = 'NONE' -LUSERV = .TRUE. -LUSERC = .FALSE. -LUSERR = .FALSE. -LUSERI = .FALSE. -LUSERS = .FALSE. -LUSERG = .FALSE. -LUSERH = .FALSE. -LOCEAN = .FALSE. -!NSV = 0 -!NSV_USER = 0 -LUSECI = .FALSE. -! -!------------------------------------------------------------------------------- -! -!* 3. SET DEFAULT VALUES FOR MODD_DYN AND MODD_DYN_n : -! ----------------------------------------------- -! -IF (KMI == 1) THEN - XSEGLEN = 43200. - XASSELIN = 0.2 - XASSELIN_SV = 0.02 - LCORIO = .TRUE. - LNUMDIFU = .TRUE. - LNUMDIFTH = .FALSE. - LNUMDIFSV = .FALSE. - XALZBOT = 4000. - XALKTOP = 0.01 - XALKGRD = 0.01 - XALZBAS = 0.01 -END IF -! -XTSTEP = 60. -CPRESOPT = 'CRESI' -NITR = 4 -LITRADJ = .TRUE. -LRES = .FALSE. -XRES = 1.E-07 -XRELAX = 1. -LVE_RELAX = .FALSE. -LVE_RELAX_GRD = .FALSE. -XRIMKMAX = 0.01 / XTSTEP -XT4DIFU = 1800. -XT4DIFTH = 1800. -XT4DIFSV = 1800. -! -IF (KMI == 1) THEN ! for model 1 we have a Large scale information - NRIMX = JPRIMMAX ! for U,V,W,TH,Rv used for the hor. relaxation - NRIMY = JPRIMMAX -ELSE - NRIMX = 0 ! for inner models we use only surfacic fields to - NRIMY = 0 ! give the lbc and no hor. relaxation is used -END IF -! -LHORELAX_UVWTH = .FALSE. -LHORELAX_RV = .FALSE. -LHORELAX_RC = .FALSE. ! for all these fields, no large scale is usally available -LHORELAX_RR = .FALSE. ! for model 1 and for inner models, we only use surfacic -LHORELAX_RS = .FALSE. ! fiels ( no hor. relax. ) -LHORELAX_RI = .FALSE. -LHORELAX_RG = .FALSE. -LHORELAX_RH = .FALSE. -LHORELAX_TKE = .FALSE. -LHORELAX_SV(:) = .FALSE. -LHORELAX_SVC2R2 = .FALSE. -LHORELAX_SVC1R3 = .FALSE. -LHORELAX_SVELEC = .FALSE. -LHORELAX_SVLG = .FALSE. -LHORELAX_SVCHEM = .FALSE. -LHORELAX_SVCHIC = .FALSE. -LHORELAX_SVDST = .FALSE. -LHORELAX_SVSLT = .FALSE. -LHORELAX_SVPP = .FALSE. -LHORELAX_SVCS = .FALSE. -LHORELAX_SVAER = .FALSE. -! -LHORELAX_SVLIMA = .FALSE. -! -#ifdef MNH_FOREFIRE -LHORELAX_SVFF = .FALSE. -#endif -LHORELAX_SVSNW = .FALSE. -! -! -!------------------------------------------------------------------------------- -! -!* 4. SET DEFAULT VALUES FOR MODD_NESTING : -! ----------------------------------- -! -IF (KMI == 1) THEN - NDAD(1)=1 - DO JM=2,JPMODELMAX - NDAD(JM) = JM - 1 - END DO - NDTRATIO(:) = 1 - XWAY(:) = 2. ! two-way interactive gridnesting - XWAY(1) = 0. ! except for model 1 -END IF -! -!------------------------------------------------------------------------------- -! -!* 5. SET DEFAULT VALUES FOR MODD_ADV_n : -! ---------------------------------- -! -CUVW_ADV_SCHEME = 'CEN4TH' -CMET_ADV_SCHEME = 'PPM_01' -CSV_ADV_SCHEME = 'PPM_01' -CTEMP_SCHEME = 'RKC4' -NWENO_ORDER = 3 -NSPLIT = 1 -LSPLIT_CFL = .TRUE. -LSPLIT_WENO = .TRUE. -XSPLIT_CFL = 0.8 -LCFL_WRIT = .FALSE. -! -!------------------------------------------------------------------------------- -! -!* 6. SET DEFAULT VALUES FOR MODD_PARAM_n : -! ----------------------------------- -! -CTURB = 'NONE' -CRAD = 'NONE' -CDCONV = 'NONE' -CSCONV = 'NONE' -CELEC = 'NONE' -CACTCCN = 'NONE' -! -!------------------------------------------------------------------------------- -! -!* 7. SET DEFAULT VALUES FOR MODD_LBC_n : -! --------------------------------- -! -CLBCX(1) ='CYCL' -CLBCX(2) ='CYCL' -CLBCY(1) ='CYCL' -CLBCY(2) ='CYCL' -NLBLX(:) = 1 -NLBLY(:) = 1 -XCPHASE = 20. -XCPHASE_PBL = 0. -XCARPKMAX = XUNDEF -XPOND = 1.0 -! -!------------------------------------------------------------------------------- -! -!* 8. SET DEFAULT VALUES FOR MODD_NUDGING_n : -! --------------------------------- -! -LNUDGING = .FALSE. -XTNUDGING = 21600. -! -!------------------------------------------------------------------------------- -! -!* 9. SET DEFAULT VALUES FOR MODD_BAKOUT and MODD_OUT_n : -! ------------------------------------------------ -! -! -! -!------------------------------------------------------------------------------- -! -!* 10. SET DEFAULT VALUES FOR MODD_TURB_n : -! ---------------------------------- -! -XIMPL = 1. -XKEMIN = 0.01 -XCEDIS = 0.84 -XCADAP = 0.5 -CTURBLEN = 'BL89' -CTURBDIM = '1DIM' -LTURB_FLX =.FALSE. -LTURB_DIAG=.FALSE. -LSUBG_COND=.FALSE. -CSUBG_AUCV='NONE' -CSUBG_AUCV_RI='NONE' -LSIGMAS =.TRUE. -LSIG_CONV =.FALSE. -LRMC01 =.FALSE. -CTOM ='NONE' -VSIGQSAT = 0.02 -CCONDENS='CB02' -CLAMBDA3='CB' -CSUBG_MF_PDF='TRIANGLE' -LHGRAD =.FALSE. -XCOEFHGRADTHL = 1.0 -XCOEFHGRADRM = 1.0 -XALTHGRAD = 2000.0 -XCLDTHOLD = -1.0 - -!------------------------------------------------------------------------------- -! -!* 10b. SET DEFAULT VALUES FOR MODD_DRAGTREE : -! ---------------------------------- -! -LDRAGTREE = .FALSE. -LDEPOTREE = .FALSE. -XVDEPOTREE = 0.02 ! 2 cm/s -!------------------------------------------------------------------------------ -! -!* 10c. SET DEFAULT VALUES FOR MODD_DRAGB -! ---------------------------------- -! -LDRAGBLDG = .FALSE. -! -!* 10d. SET DEFAULT VALUES FOR MODD_EOL* : -! ---------------------------------- -! -! 10d.i) MODD_EOL_MAIN -! -LMAIN_EOL = .FALSE. -CMETH_EOL = 'ADNR' -CSMEAR = '3LIN' -NMODEL_EOL = 1 -! -! 10d.ii) MODD_EOL_SHARED_IO -! -CFARM_CSVDATA = 'data_farm.csv' -CTURBINE_CSVDATA = 'data_turbine.csv' -CBLADE_CSVDATA = 'data_blade.csv' -CAIRFOIL_CSVDATA = 'data_airfoil.csv' -! -CINTERP = 'CLS' -! -! 10d.iii) MODD_EOL_ALM -! -NNB_BLAELT = 42 -LTIMESPLIT = .FALSE. -LTIPLOSSG = .TRUE. -LTECOUTPTS = .FALSE. -! -!------------------------------------------------------------------------------ -!* 10.e SET DEFAULT VALUES FOR MODD_ALLSTATION_n : -! ---------------------------------- -! -NNUMB_STAT = 0 -XSTEP_STAT = 60.0 -XX_STAT(:) = XUNDEF -XY_STAT(:) = XUNDEF -XZ_STAT(:) = XUNDEF -XLAT_STAT(:) = XUNDEF -XLON_STAT(:) = XUNDEF -CNAME_STAT(:) = '' -CTYPE_STAT(:) = '' -CFILE_STAT = 'NO_INPUT_CSV' -LDIAG_SURFRAD = .TRUE. -! -!------------------------------------------------------------------------------- -! -!* 11. SET DEFAULT VALUES FOR MODD_BUDGET : -! ------------------------------------ -! -! 11.1 General budget variables -! -IF (KMI == 1) THEN - CBUTYPE = 'NONE' - NBUMOD = 1 - XBULEN = XSEGLEN - XBUWRI = XSEGLEN - NBUKL = 1 - NBUKH = 0 - LBU_KCP = .TRUE. -! -! 11.2 Variables for the cartesian box -! - NBUIL = 1 - NBUIH = 0 - NBUJL = 1 - NBUJH = 0 - LBU_ICP = .TRUE. - LBU_JCP = .TRUE. -! -! 11.3 Variables for the mask -! - NBUMASK = 1 -END IF -! -!------------------------------------------------------------------------------- -! -!* 12. SET DEFAULT VALUES FOR MODD_LES : -! --------------------------------- -! -IF (KMI == 1) THEN - LLES_MEAN = .FALSE. - LLES_RESOLVED = .FALSE. - LLES_SUBGRID = .FALSE. - LLES_UPDRAFT = .FALSE. - LLES_DOWNDRAFT = .FALSE. - LLES_SPECTRA = .FALSE. -! - NLES_LEVELS = NUNDEF - XLES_ALTITUDES = XUNDEF - NSPECTRA_LEVELS = NUNDEF - XSPECTRA_ALTITUDES = XUNDEF - NLES_TEMP_SERIE_I = NUNDEF - NLES_TEMP_SERIE_J = NUNDEF - NLES_TEMP_SERIE_Z = NUNDEF - CLES_NORM_TYPE = 'NONE' - CBL_HEIGHT_DEF = 'KE' - XLES_TEMP_SAMPLING = XUNDEF - XLES_TEMP_MEAN_START = XUNDEF - XLES_TEMP_MEAN_END = XUNDEF - XLES_TEMP_MEAN_STEP = 3600. - LLES_CART_MASK = .FALSE. - NLES_IINF = NUNDEF - NLES_ISUP = NUNDEF - NLES_JINF = NUNDEF - NLES_JSUP = NUNDEF - LLES_NEB_MASK = .FALSE. - LLES_CORE_MASK = .FALSE. - LLES_MY_MASK = .FALSE. - NLES_MASKS_USER = NUNDEF - LLES_CS_MASK = .FALSE. - - LLES_PDF = .FALSE. - NPDF = 1 - XTH_PDF_MIN = 270. - XTH_PDF_MAX = 350. - XW_PDF_MIN = -10. - XW_PDF_MAX = 10. - XTHV_PDF_MIN = 270. - XTHV_PDF_MAX = 350. - XRV_PDF_MIN = 0. - XRV_PDF_MAX = 20. - XRC_PDF_MIN = 0. - XRC_PDF_MAX = 1. - XRR_PDF_MIN = 0. - XRR_PDF_MAX = 1. - XRI_PDF_MIN = 0. - XRI_PDF_MAX = 1. - XRS_PDF_MIN = 0. - XRS_PDF_MAX = 1. - XRG_PDF_MIN = 0. - XRG_PDF_MAX = 1. - XRT_PDF_MIN = 0. - XRT_PDF_MAX = 20. - XTHL_PDF_MIN = 270. - XTHL_PDF_MAX = 350. -END IF -! -!------------------------------------------------------------------------------- -! -!* 13. SET DEFAULT VALUES FOR MODD_PARAM_RAD_n : -! --------------------------------------- -! -XDTRAD = XTSTEP -XDTRAD_CLONLY = XTSTEP -LCLEAR_SKY =.FALSE. -NRAD_COLNBR = 1000 -NRAD_DIAG = 0 -CLW ='RRTM' -CAER='SURF' -CAOP='CLIM' -CEFRADL='MART' -CEFRADI='LIOU' -COPWSW = 'FOUQ' -COPISW = 'EBCU' -COPWLW = 'SMSH' -COPILW = 'EBCU' -XFUDG = 1. -LAERO_FT=.FALSE. -LFIX_DAT=.FALSE. -! -#ifdef MNH_ECRAD -!* 13bis. SET DEFAULT VALUES FOR MODD_PARAM_ECRAD_n : -! --------------------------------------- -! -#if ( VER_ECRAD == 101 ) -NSWSOLVER = 0 ! 0: 'McICA 1: 'SPARTACUS' 2: 'SPARTACUS' + 3D effect -NLWSOLVER = 0 ! 0: 'McICA 1: 'SPARTACUS' 2: 'SPARTACUS' + 3D effect -#endif -#if ( VER_ECRAD == 140 ) -LSPEC_ALB = .FALSE. -LSPEC_EMISS = .FALSE. - - -!ALLOCATE(USER_ALB_DIFF(NSWB_MNH)) -!ALLOCATE(USER_ALB_DIR(NSWB_MNH)) -!ALLOCATE(USER_EMISS(NLWB_MNH)) -!PRINT*,USER_ALB_DIFF -!USER_ALB_DIFF = (/0,0,0,0,0,0,0,0,0,0,0,0,0,0/) -!USER_ALB_DIR = (/0,0,0,0,0,0,0,0,0,0,0,0,0,0/) -!USER_EMISS = (/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0/) -SURF_TYPE="SNOW" - -NLWSOLVER = 1 ! 0: 'McICA 1: 'SPARTACUS' 2: 'SPARTACUS' + 3D effect -NSWSOLVER = 1 ! 0: 'McICA 1: 'SPARTACUS' 2: 'SPARTACUS' + 3D effect -#endif -! LEFF3D = .TRUE. -! LSIDEM = .TRUE. -NREG = 3 ! Number of cloudy regions (3=TripleClouds) -! LLWCSCA = .TRUE. ! LW cloud scattering -! LLWASCA = .TRUE. ! LW aerosols scattering -NLWSCATTERING = 2 -NAERMACC = 0 -! CGAS = 'RRTMG-IFS' ! Gas optics model -NOVLP = 1 ! overlap assumption ; 0= 'Max-Ran' ; 1= 'Exp-Ran'; 2 = 'Exp-Exp' -NLIQOPT = 3 ! 1: 'Monochromatic', 2: 'HuStamnes', 3: 'SOCRATES', 4: 'Slingo' -NICEOPT = 3 ! 1: 'Monochromatic', 2: 'Fu-PSRAD', 3: 'Fu-IFS', 4: 'Baran', 5: 'Baran2016', 6: 'Baran2017' -! LSW_ML_E = .FALSE. -! LLW_ML_E = .FALSE. -! LPSRAD = .FALSE. -! -NRADLP = 1 ! 0: ERA-15, 1: Zhang and Rossow, 2: Martin (1994) et Woods (2000) -NRADIP = 1 ! 0: 40 mum, 1: Liou and Ou (1994), 2: Liou and Ou (1994) improved, 3: Sun and Rikus (1999) -XCLOUD_FRAC_STD = 1.0_JPRB ! change to 0.75 for more realistic distribution -#endif -!------------------------------------------------------------------------------- -! -!* 14. SET DEFAULT VALUES FOR MODD_BLANK_n : -! ----------------------------------- -! -XDUMMY1 = 0. -XDUMMY2 = 0. -XDUMMY3 = 0. -XDUMMY4 = 0. -XDUMMY5 = 0. -XDUMMY6 = 0. -XDUMMY7 = 0. -XDUMMY8 = 0. -! -NDUMMY1 = 0 -NDUMMY2 = 0 -NDUMMY3 = 0 -NDUMMY4 = 0 -NDUMMY5 = 0 -NDUMMY6 = 0 -NDUMMY7 = 0 -NDUMMY8 = 0 -! -LDUMMY1 = .TRUE. -LDUMMY2 = .TRUE. -LDUMMY3 = .TRUE. -LDUMMY4 = .TRUE. -LDUMMY5 = .TRUE. -LDUMMY6 = .TRUE. -LDUMMY7 = .TRUE. -LDUMMY8 = .TRUE. -! -CDUMMY1 = ' ' -CDUMMY2 = ' ' -CDUMMY3 = ' ' -CDUMMY4 = ' ' -CDUMMY5 = ' ' -CDUMMY6 = ' ' -CDUMMY7 = ' ' -CDUMMY8 = ' ' -! -!------------------------------------------------------------------------------ -! -!* 15. SET DEFAULT VALUES FOR MODD_FRC : -! --------------------------------- -! -IF (KMI == 1) THEN - LGEOST_UV_FRC = .FALSE. - LGEOST_TH_FRC = .FALSE. - LTEND_THRV_FRC = .FALSE. - LTEND_UV_FRC = .FALSE. - LVERT_MOTION_FRC = .FALSE. - LRELAX_THRV_FRC = .FALSE. - LRELAX_UV_FRC = .FALSE. - LRELAX_UVMEAN_FRC = .FALSE. - XRELAX_TIME_FRC = 10800. - XRELAX_HEIGHT_FRC = 0. - CRELAX_HEIGHT_TYPE = "FIXE" - LTRANS = .FALSE. - XUTRANS = 0.0 - XVTRANS = 0.0 - LPGROUND_FRC = .FALSE. - LDEEPOC = .FALSE. - XCENTX_OC = 16000. - XCENTY_OC = 16000. - XRADX_OC = 8000. - XRADY_OC = 8000. -END IF -! -!------------------------------------------------------------------------------- -! -! -!* 16. SET DEFAULT VALUES FOR MODD_PARAM_ICE : -! --------------------------------------- -! -IF (KMI == 1) THEN - LRED = .TRUE. - LWARM = .TRUE. - CPRISTINE_ICE = 'PLAT' - LSEDIC = .TRUE. - LCONVHG = .FALSE. - CSEDIM = 'SPLI' - LFEEDBACKT = .TRUE. - LEVLIMIT = .TRUE. - LNULLWETG = .TRUE. - LWETGPOST = .TRUE. - LNULLWETH = .TRUE. - LWETHPOST = .TRUE. - CSNOWRIMING = 'M90 ' - CSUBG_RC_RR_ACCR = 'NONE' - CSUBG_RR_EVAP = 'NONE' - CSUBG_PR_PDF = 'SIGM' - XFRACM90 = 0.1 - LCRFLIMIT = .TRUE. - NMAXITER = 5 - XMRSTEP = 0.00005 - XTSTEP_TS = 0. - LADJ_BEFORE = .TRUE. - LADJ_AFTER = .TRUE. - CFRAC_ICE_ADJUST = 'S' - XSPLIT_MAXCFL = 0.8 - CFRAC_ICE_SHALLOW_MF = 'S' - LSEDIM_AFTER = .FALSE. - LDEPOSC = .FALSE. - XVDEPOSC= 0.02 ! 2 cm/s -END IF -! -!------------------------------------------------------------------------------- -! -! -!* 17. SET DEFAULT VALUES FOR MODD_PARAM_KAFR_n : -! -------------------------------------------- -! -XDTCONV = MAX( 300.0,XTSTEP ) -NICE = 1 -LREFRESH_ALL = .TRUE. -LCHTRANS = .FALSE. -LDOWN = .TRUE. -LSETTADJ = .FALSE. -XTADJD = 3600. -XTADJS = 10800. -LDIAGCONV = .FALSE. -NENSM = 0 -! -!------------------------------------------------------------------------------- -! -! -!* 18. SET DEFAULT VALUES FOR MODD_PARAM_MFSHALL_n : -! -------------------------------------------- -! -XIMPL_MF = 1. -CMF_UPDRAFT = 'EDKF' -CMF_CLOUD = 'DIRE' -LMIXUV = .TRUE. -LMF_FLX = .FALSE. -! -XALP_PERT = 0.3 -XABUO = 1. -XBENTR = 1. -XBDETR = 0. -XCMF = 0.065 -XENTR_MF = 0.035 -XCRAD_MF = 50. -XENTR_DRY = 0.55 -XDETR_DRY = 10. -XDETR_LUP = 1. -XKCF_MF = 2.75 -XKRC_MF = 1. -XTAUSIGMF = 600. -XPRES_UV = 0.5 -XFRAC_UP_MAX= 0.33 -XALPHA_MF = 2. -XSIGMA_MF = 20. -! -XA1 = 2./3. -XB = 0.002 -XC = 0.012 -XBETA1 = 0.9 -XR = 2. -XLAMBDA_MF= 0. -LGZ = .FALSE. -XGZ = 1.83 ! between 1.83 and 1.33 -! -!------------------------------------------------------------------------------- -! -!* 19. SET DEFAULT VALUES FOR MODD_PARAM_C2R2 : -! ---------------------------------------- -! -IF (KMI == 1) THEN - XNUC = 1.0 - XALPHAC = 3.0 - XNUR = 2.0 - XALPHAR = 1.0 -! - LRAIN = .TRUE. - LSEDC = .TRUE. - LACTIT = .FALSE. - LSUPSAT = .FALSE. - LDEPOC = .FALSE. - XVDEPOC = 0.02 ! 2 cm/s - LACTTKE = .TRUE. -! - HPARAM_CCN = 'XXX' - HINI_CCN = 'XXX' - HTYPE_CCN = 'X' -! - XCHEN = 0.0 - XKHEN = 0.0 - XMUHEN = 0.0 - XBETAHEN = 0.0 -! - XCONC_CCN = 0.0 - XAERDIFF = 0.0 - XAERHEIGHT = 2000 - XR_MEAN_CCN = 0.0 - XLOGSIG_CCN = 0.0 - XFSOLUB_CCN = 1.0 - XACTEMP_CCN = 280. -ENDIF -! -!------------------------------------------------------------------------------- -! -!* 19.BIS SET DEFAULT VALUES FOR MODD_PARAM_LIMA : -! ---------------------------------------- -! -LPTSPLIT = .FALSE. -L_LFEEDBACKT = .TRUE. -L_NMAXITER = 1 -L_XMRSTEP = 0. -L_XTSTEP_TS = 0. -! -IF (KMI == 1) THEN - YNUC = 1.0 - YALPHAC = 3.0 - YNUR = 2.0 - YALPHAR = 1.0 -! - OWARM = .TRUE. - LACTI = .TRUE. - ORAIN = .TRUE. - OSEDC = .TRUE. - OACTIT = .FALSE. - LADJ = .TRUE. - LSPRO = .FALSE. - ODEPOC = .FALSE. - LBOUND = .FALSE. - OACTTKE = .TRUE. -! - OVDEPOC = 0.02 ! 2 cm/s -! - CINI_CCN = 'AER' - CTYPE_CCN(:) = 'M' -! - YAERDIFF = 0.0 - YAERHEIGHT = 2000. -! YR_MEAN_CCN = 0.0 ! In case of 'CCN' initialization -! YLOGSIG_CCN = 0.0 - YFSOLUB_CCN = 1.0 - YACTEMP_CCN = 280. -! - NMOD_CCN = 1 -! -!* AP Scavenging -! - LSCAV = .FALSE. - LAERO_MASS = .FALSE. -! - LCCN_HOM = .TRUE. - CCCN_MODES = 'COPT' - XCCN_CONC(:)=300. -ENDIF -! -IF (KMI == 1) THEN - LHHONI = .FALSE. - LCOLD = .TRUE. - LNUCL = .TRUE. - LSEDI = .TRUE. - LSNOW = .TRUE. - LHAIL = .FALSE. - CPRISTINE_ICE_LIMA = 'PLAT' - CHEVRIMED_ICE_LIMA = 'GRAU' - XFACTNUC_DEP = 1.0 - XFACTNUC_CON = 1.0 - NMOD_IFN = 1 - NIND_SPECIE = 1 - LMEYERS = .FALSE. - LIFN_HOM = .TRUE. - CIFN_SPECIES = 'PHILLIPS' - CINT_MIXING = 'DM2' - XIFN_CONC(:) = 100. - NMOD_IMM = 0 - NPHILLIPS=8 - LCIBU = .FALSE. - XNDEBRIS_CIBU = 50.0 - LRDSF = .FALSE. -ENDIF -! -!------------------------------------------------------------------------------- -! -!* 20. SET DEFAULT VALUES FOR MODD_CH_MNHC_n -! ------------------------------------- -! -LUSECHEM = .FALSE. -LUSECHAQ = .FALSE. -LUSECHIC = .FALSE. -LCH_INIT_FIELD = .FALSE. -LCH_CONV_SCAV = .FALSE. -LCH_CONV_LINOX = .FALSE. -LCH_PH = .FALSE. -LCH_RET_ICE = .FALSE. -XCH_PHINIT = 5.2 -XRTMIN_AQ = 5.e-8 -CCHEM_INPUT_FILE = 'EXSEG1.nam' -CCH_TDISCRETIZATION = 'SPLIT' -NCH_SUBSTEPS = 1 -LCH_TUV_ONLINE = .FALSE. -CCH_TUV_LOOKUP = 'PHOTO.TUV39' -CCH_TUV_CLOUDS = 'NONE' -XCH_TUV_ALBNEW = -1. -XCH_TUV_DOBNEW = -1. -XCH_TUV_TUPDATE = 600. -CCH_VEC_METHOD = 'MAX' -NCH_VEC_LENGTH = 50 -XCH_TS1D_TSTEP = 600. -CCH_TS1D_COMMENT = 'no comment' -CCH_TS1D_FILENAME = 'IO1D' -CSPEC_PRODLOSS = '' -CSPEC_BUDGET = '' -! -!------------------------------------------------------------------------------- -! -!* 21. SET DEFAULT VALUES FOR MODD_SERIES AND MODD_SERIE_n -! --------------------------------------------------- -! -IF (KMI == 1) THEN - LSERIES = .FALSE. - LMASKLANDSEA = .FALSE. - LWMINMAX = .FALSE. - LSURF = .FALSE. -ENDIF -! -NIBOXL = 1 !+ JPHEXT -NIBOXH = 1 !+ 2*JPHEXT -NJBOXL = 1 !+ JPHEXT -NJBOXH = 1 !+ 2*JPHEXT -NKCLS = 1 !+ JPVEXT -NKLOW = 1 !+ JPVEXT -NKMID = 1 !+ JPVEXT -NKUP = 1 !+ JPVEXT -NKCLA = 1 !+ JPVEXT -NBJSLICE = 1 -NJSLICEL(:) = 1 !+ JPHEXT -NJSLICEH(:) = 1 !+ 2*JPHEXT -NFREQSERIES = INT(XSEGLEN /(100.*XTSTEP) ) -NFREQSERIES = MAX(NFREQSERIES,1) -! -!------------------------------------------------------------------------------- -! -!* 22. SET DEFAULT VALUES FOR MODD_TURB_CLOUD -! -------------------------------------- -! -IF (KMI == 1) THEN - NMODEL_CLOUD = NUNDEF - CTURBLEN_CLOUD = 'DELT' - XCOEF_AMPL_SAT = 5. - XCEI_MIN = 0.001E-06 - XCEI_MAX = 0.01E-06 -ENDIF -!------------------------------------------------------------------------------- -! -!* 22. SET DEFAULT VALUES FOR MODD_MEAN_FIELD -! -------------------------------------- -! -IF (KMI == 1) THEN - LMEAN_FIELD = .FALSE. -ENDIF -! -!------------------------------------------------------------------------------- -! -!* 22. SET DEFAULT VALUES FOR MODD_AEROSOL -! ----------------------------------- -IF (KMI == 1) THEN ! other values are defined in modd_ch_aerosol -! -! aerosol lognormal parameterization - -LVARSIGI = .FALSE. ! switch to active pronostic dispersion for I mode -LVARSIGJ = .FALSE. ! switch to active pronostic dispersion for J mode -LHETEROSO4 = .FALSE. ! switch to active sulfates heteronegeous - ! production -LSEDIMAERO = .FALSE. ! switch to active aerosol sedimentation -LAERINIT = .FALSE. ! switch to initialize aerosol in arome -CMINERAL = "NONE" ! mineral equilibrium scheme -CORGANIC = "NONE" ! mineral equilibrium scheme -CNUCLEATION = "NONE" ! sulfates nucleation scheme -LDEPOS_AER(:) = .FALSE. - -ENDIF - -!* 23. SET DEFAULT VALUES FOR MODD_DUST and MODD_SALT -! ---------------------------------------------- -! -IF (KMI == 1) THEN ! other values initialized in modd_dust - LDUST = .FALSE. - NMODE_DST = 3 - LVARSIG = .FALSE. - LSEDIMDUST = .FALSE. - LDEPOS_DST(:) = .FALSE. - - LSALT = .FALSE. - LVARSIG_SLT= .FALSE. - LSEDIMSALT = .FALSE. - LDEPOS_SLT(:) = .FALSE. -ENDIF -! -!------------------------------------------------------------------------------- -! -! -!* 24. SET DEFAULT VALUES FOR MODD_PASPOL -! ---------------------------------- -! -! other values initialized in modd_paspol -! -IF (KMI == 1) THEN - LPASPOL = .FALSE. - NRELEASE = 0 - CPPINIT(:) ='1PT' - XPPLAT(:) = 0. - XPPLON (:) = 0. - XPPMASS(:) = 0. - XPPBOT(:) = 0. - XPPTOP(:) = 0. - CPPT1(:) = "20010921090000" - CPPT2(:) = "20010921090000" - CPPT3(:) = "20010921091500" - CPPT4(:) = "20010921091500" -ENDIF -! -!------------------------------------------------------------------------------- -! -! -!* 25. SET DEFAULT VALUES FOR MODD_CONDSAMP -! ---------------------------------- -! -! other values initialized in modd_condsamp -! -IF (KMI == 1) THEN - LCONDSAMP = .FALSE. - NCONDSAMP = 3 - XRADIO(:) = 900. - XSCAL(:) = 1. - XHEIGHT_BASE = 100. - XDEPTH_BASE = 100. - XHEIGHT_TOP = 100. - XDEPTH_TOP = 100. - NFINDTOP = 0 - XTHVP = 0.25 - LTPLUS = .TRUE. -ENDIF -!------------------------------------------------------------------------------- -! -! -!* 26. SET DEFAULT VALUES FOR MODD_LATZ_EDFLX -! ---------------------------------- -! -IF (KMI == 1) THEN - LUV_FLX=.FALSE. - XUV_FLX1=3.E+14 - XUV_FLX2=0. - LTH_FLX=.FALSE. - XTH_FLX=0.75 -ENDIF -#ifdef MNH_FOREFIRE -!------------------------------------------------------------------------------- -! -!* 27. SET DEFAULT VALUES FOR MODD_FOREFIRE -! ---------------------------------- -! -! other values initialized in modd_forefire -! -IF (KMI == 1) THEN - LFOREFIRE = .FALSE. - LFFCHEM = .FALSE. - COUPLINGRES = 100. - NFFSCALARS = 0 -ENDIF -#endif -!------------------------------------------------------------------------------- -! -!* 28. SET DEFAULT VALUES FOR MODD_BLOWSNOW AND MODD_BLOWSNOW_n -! ---------------------------------------- -! -IF (KMI == 1) THEN - LBLOWSNOW = .FALSE. - XALPHA_SNOW = 3. - XRSNOW = 4. - CSNOWSEDIM = 'TABC' -END IF -LSNOWSUBL = .FALSE. -! -! -!------------------------------------------------------------------------------- -! -!* 29. SET DEFAULT VALUES FOR MODD_VISC -! ---------------------------------- -! -! other values initialized in modd_VISC -! -IF (KMI == 1) THEN - LVISC = .FALSE. - LVISC_UVW = .FALSE. - LVISC_TH = .FALSE. - LVISC_SV = .FALSE. - LVISC_R = .FALSE. - XMU_V = 0. - XPRANDTL = 0. -ENDIF -! -!------------------------------------------------------------------------------- -! -! -!* 30. SET DEFAULT VALUES FOR MODD_DRAG -! ---------------------------------- -! -! other values initialized in modd_DRAG -! -IF (KMI == 1) THEN - LDRAG = .FALSE. - LMOUNT = .FALSE. - NSTART = 1 - XHSTART = 0. -ENDIF -! -!------------------------------------------------------------------------------- -! -!* 31. SET DEFAULT VALUES FOR MODD_IBM_PARAMn -! -------------------------------------- -! - LIBM = .FALSE. - LIBM_TROUBLE = .FALSE. - CIBM_ADV = 'NOTHIN' - XIBM_EPSI = 1.E-9 - XIBM_IEPS = 1.E+9 - NIBM_ITR = 8 - XIBM_RUG = 0.01 ! (m^1.s^-0) - XIBM_VISC = 1.56e-5 ! (m^2.s^-1) - XIBM_CNU = 0.06 ! (m^0.s^-0) - - NIBM_LAYER_P = 2 - NIBM_LAYER_Q = 2 - NIBM_LAYER_R = 2 - NIBM_LAYER_S = 2 - NIBM_LAYER_T = 2 - NIBM_LAYER_E = 2 - NIBM_LAYER_V = 2 - - XIBM_RADIUS_P = 2. - XIBM_RADIUS_Q = 2. - XIBM_RADIUS_R = 2. - XIBM_RADIUS_S = 2. - XIBM_RADIUS_T = 2. - XIBM_RADIUS_E = 2. - XIBM_RADIUS_V = 2. - - XIBM_POWERS_P = 1. - XIBM_POWERS_Q = 1. - XIBM_POWERS_R = 1. - XIBM_POWERS_S = 1. - XIBM_POWERS_T = 1. - XIBM_POWERS_E = 1. - XIBM_POWERS_V = 1. - - CIBM_MODE_INTE3_P = 'LAI' - CIBM_MODE_INTE3_Q = 'LAI' - CIBM_MODE_INTE3_R = 'LAI' - CIBM_MODE_INTE3_S = 'LAI' - CIBM_MODE_INTE3_T = 'LAI' - CIBM_MODE_INTE3_E = 'LAI' - CIBM_MODE_INTE3_V = 'LAI' - - CIBM_MODE_INTE1_P = 'CL2' - CIBM_MODE_INTE1_Q = 'CL2' - CIBM_MODE_INTE1_R = 'CL2' - CIBM_MODE_INTE1_S = 'CL2' - CIBM_MODE_INTE1_T = 'CL2' - CIBM_MODE_INTE1_E = 'CL2' - CIBM_MODE_INTE1NV = 'CL2' - CIBM_MODE_INTE1TV = 'CL2' - CIBM_MODE_INTE1CV = 'CL2' - - CIBM_MODE_BOUND_P = 'SYM' - CIBM_MODE_BOUND_Q = 'SYM' - CIBM_MODE_BOUND_R = 'SYM' - CIBM_MODE_BOUND_S = 'SYM' - CIBM_MODE_BOUND_T = 'SYM' - CIBM_MODE_BOUND_E = 'SYM' - CIBM_MODE_BOUNT_V = 'ASY' - CIBM_MODE_BOUNN_V = 'ASY' - CIBM_MODE_BOUNC_V = 'ASY' - - XIBM_FORC_BOUND_P = 0. - XIBM_FORC_BOUND_Q = 0. - XIBM_FORC_BOUND_R = 0. - XIBM_FORC_BOUND_S = 0. - XIBM_FORC_BOUND_T = 0. - XIBM_FORC_BOUND_E = 0. - XIBM_FORC_BOUNN_V = 0. - XIBM_FORC_BOUNT_V = 0. - XIBM_FORC_BOUNC_V = 0. - - CIBM_TYPE_BOUND_P = 'NEU' - CIBM_TYPE_BOUND_Q = 'NEU' - CIBM_TYPE_BOUND_R = 'NEU' - CIBM_TYPE_BOUND_S = 'NEU' - CIBM_TYPE_BOUND_T = 'NEU' - CIBM_TYPE_BOUND_E = 'NEU' - CIBM_TYPE_BOUNT_V = 'DIR' - CIBM_TYPE_BOUNN_V = 'DIR' - CIBM_TYPE_BOUNC_V = 'DIR' - - CIBM_FORC_BOUND_P = 'CST' - CIBM_FORC_BOUND_Q = 'CST' - CIBM_FORC_BOUND_R = 'CST' - CIBM_FORC_BOUND_S = 'CST' - CIBM_FORC_BOUND_T = 'CST' - CIBM_FORC_BOUND_E = 'CST' - CIBM_FORC_BOUNN_V = 'CST' - CIBM_FORC_BOUNT_V = 'CST' - CIBM_FORC_BOUNC_V = 'CST' - CIBM_FORC_BOUNR_V = 'CST' - -! -!------------------------------------------------------------------------------- -! -!* 32. SET DEFAULT VALUES FOR MODD_RECYCL_PARAMn -! -------------------------------------- -! - LRECYCL = .FALSE. - LRECYCLN = .FALSE. - LRECYCLW = .FALSE. - LRECYCLE = .FALSE. - LRECYCLS = .FALSE. - XDRECYCLN = 0. - XARECYCLN = 0. - XDRECYCLW = 0. - XARECYCLW = 0. - XDRECYCLS = 0. - XARECYCLS = 0. - XDRECYCLE = 0. - XARECYCLE = 0. - XTMOY = 0. - XTMOYCOUNT = 0. - XNUMBELT = 28. - XRCOEFF = 0.2 - XTBVTOP = 500. - XTBVBOT = 300. -! -! -END SUBROUTINE DEFAULT_DESFM_n diff --git a/src/ICCARE_BASE/dustcamsn.f90 b/src/ICCARE_BASE/dustcamsn.f90 deleted file mode 100644 index 33966adfd..000000000 --- a/src/ICCARE_BASE/dustcamsn.f90 +++ /dev/null @@ -1,214 +0,0 @@ - -!--------------- special set of characters for RCS information -!----------------------------------------------------------------- -! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/dustlfin.f90,v $ $Revision: 1.1.2.2.2.1.2.1 $ -! MASDEV4_7 newsrc 2007/01/25 13:13:15 -!----------------------------------------------------------------- -! ######################## - MODULE MODI_DUSTCAMS_n -! ######################## -! -INTERFACE -! -SUBROUTINE DUSTCAMS_n(PSV, PMASSCAMS, PRHODREF) -IMPLICIT NONE -REAL, DIMENSION(:,:,:,:),INTENT(INOUT) :: PSV -REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PMASSCAMS -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF -END SUBROUTINE DUSTCAMS_n -! -END INTERFACE -! -END MODULE MODI_DUSTCAMS_n -! -! -! ############################################################ - SUBROUTINE DUSTCAMS_n(PSV, PMASSCAMS,PRHODREF) -! ############################################################ -! -!! PURPOSE -!! ------- -!! Initialise le champs de dusts à partir des analyses CAMS -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Pierre TULET (LACy) -!! -!! MODIFICATIONS -!! ------------- -!! none -!! -!! EXTERNAL -!! -------- -!! None -!! -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_DUST -USE MODD_NSV -USE MODD_CSTS_DUST -USE MODE_DUST_PSD -! -IMPLICIT NONE -! -!* 0.1 declarations of arguments -! -REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSV -REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PMASSCAMS -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF -! -! -!* 0.2 declarations local variables -! -REAL :: ZDEN2MOL, ZRHOI, ZMI, ZFAC, ZRGMIN -REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZCTOTA -REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZM -REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZSIGMA -REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZMASS -INTEGER,DIMENSION(:), ALLOCATABLE :: IM0, IM3, IM6 -REAL,DIMENSION(:), ALLOCATABLE :: ZMMIN -REAL,DIMENSION(:), ALLOCATABLE :: ZINIRADIUS, ZINISIGMA -REAL :: ZRHOMIN -INTEGER :: IKU, IMOMENTS -INTEGER :: JJ, JN, JK ! loop counter -INTEGER :: IMODEIDX ! index mode -! -!------------------------------------------------------------------------------- -! -!* 1. TRANSFER FROM GAS TO AEROSOL MODULE -! ----------------------------------- -! -! 1.1 initialisation -! -IKU = SIZE(PSV,3) -ZRHOMIN=MINVAL(PRHODREF) -! -ALLOCATE (IM0(NMODE_DST)) -ALLOCATE (IM3(NMODE_DST)) -ALLOCATE (IM6(NMODE_DST)) -ALLOCATE (ZCTOTA(SIZE(PSV,1), SIZE(PSV,2), SIZE(PSV,3), NMODE_DST)) -ALLOCATE (ZM(SIZE(PSV,1), SIZE(PSV,2), SIZE(PSV,3), NMODE_DST*3)) -ALLOCATE (ZSIGMA(SIZE(PSV,1), SIZE(PSV,2), SIZE(PSV,3))) -ALLOCATE (ZINIRADIUS(NMODE_DST)) -ALLOCATE (ZINISIGMA(NMODE_DST)) -ALLOCATE (ZMMIN(NMODE_DST*3)) -ALLOCATE (ZMASS(SIZE(PSV,1), SIZE(PSV,2), SIZE(PSV,3),NMODE_DST)) -! -! -DO JN = 1, NMODE_DST - IM0(JN) = 1 + (JN - 1) * 3 - IM3(JN) = 2 + (JN - 1) * 3 - IM6(JN) = 3 + (JN - 1) * 3 - ! - !Get the dust mode we are talking about, MODE 2 is treated first, then mode 3, then 1 - !This index is only needed to get the right radius out of the XINIRADIUS array and the - !right XINISIG out of the XINISIG-array - IMODEIDX = JPDUSTORDER(JN) - ! - !Convert initial mass median radius to number median radius - IF (CRGUNITD=="MASS") THEN - ZINIRADIUS(JN) = XINIRADIUS(IMODEIDX) * EXP(-3.*(LOG(XINISIG(IMODEIDX)))**2) - ELSE - ZINIRADIUS(JN) = XINIRADIUS(IMODEIDX) - END IF - ZINISIGMA(JN) = XINISIG(IMODEIDX) - ! - ZMMIN(IM0(JN)) = XN0MIN(IMODEIDX) - ZRGMIN = ZINIRADIUS(JN) - ZMMIN(IM3(JN)) = XN0MIN(IMODEIDX) * (ZRGMIN**3)*EXP(4.5 * LOG(ZINISIGMA(JN))**2) - ZMMIN(IM6(JN)) = XN0MIN(IMODEIDX) * (ZRGMIN**6)*EXP(18. * LOG(ZINISIGMA(JN))**2) - - IF (JPDUSTORDER(JN) == 1) ZMASS(:,:,:,JN) = PMASSCAMS(:,:,:,1) ! fin mode - IF (JPDUSTORDER(JN) == 2) ZMASS(:,:,:,JN) = PMASSCAMS(:,:,:,2) ! median mode - IF (JPDUSTORDER(JN) == 3) ZMASS(:,:,:,JN) = PMASSCAMS(:,:,:,3) ! large mode - -ENDDO - -ZMASS(:,:,:,:) = MAX(ZMASS(:,:,:,:), 1E-40) -! -! -ZRHOI = XDENSITY_DUST !1.8e3 !++changed alfgr -ZMI = XMOLARWEIGHT_DUST -ZDEN2MOL = 1E-6 * XAVOGADRO / XMD -ZFAC = (4. / 3.) * XPI * ZRHOI * 1.e-9 - -! -DO JN = 1, NMODE_DST - -!* 1.1 calculate moment 0 from ZMASS -! - ZM(:,:,:,IM0(JN)) = ZMASS(:,:,:,JN) &![kg_{dust}/kg_{air} - / XDENSITY_DUST &![kg__{dust}/m3_{dust}==>m3_{dust}/m3{air} - * (6.d0 / XPI) & - / (2.d0 * ZINIRADIUS(JN) * 1.d-6)**3 &![particle/m_dust^{-3}]==> particle/m3 - * EXP(-4.5*(LOG(ZINISIGMA(JN)))**2) !Take into account distribution -! - ZM(:,:,:,IM0(JN)) = MAX(ZMMIN(IM0(JN)), ZM(:,:,:,IM0(JN))) -! -!* 1.2 calculate moment 3 from m0, RG and SIG -! - ZM(:,:,:,IM3(JN)) = ZM(:,:,:,IM0(JN)) * & - (ZINIRADIUS(JN)**3) * & - EXP(4.5*LOG(ZINISIGMA(JN))**2) - - ZM(:,:,:,IM3(JN)) = MAX(ZMMIN(IM3(JN)), ZM(:,:,:,IM3(JN))) -! -!* 1.3 calculate moment 6 from m0, RG and SIG -! - ZM(:,:,:,IM6(JN))= ZM(:,:,:,IM0(JN)) * ((ZINIRADIUS(JN)**6) * & - EXP(18.*(LOG(ZINISIGMA(JN)))**2)) -! - ZM(:,:,:,IM6(JN)) = MAX(ZMMIN(IM6(JN)), ZM(:,:,:,IM6(JN))) -! -!* 1.4 output concentration -! - IMOMENTS = INT(NSV_DSTEND - NSV_DSTBEG+1) / NMODE_DST - IF (IMOMENTS == 3) THEN - PSV(:,:,:,1+(JN-1)*3) = ZM(:,:,:,IM0(JN)) * XMD / (XAVOGADRO*PRHODREF(:,:,:)) - XSVMIN(NSV_DSTBEG-1+1+(JN-1)*3) = ZMMIN(IM0(JN)) * XMD / (XAVOGADRO*ZRHOMIN) - - PSV(:,:,:,2+(JN-1)*3) = ZM(:,:,:,IM3(JN)) * XMD*XPI * 4./3. * ZRHOI / & - (ZMI*XM3TOUM3*PRHODREF(:,:,:)) - XSVMIN(NSV_DSTBEG-1+2+(JN-1)*3) = ZMMIN(IM3(JN)) * XMD * XPI * 4. / 3. * ZRHOI / & - (ZMI*XM3TOUM3**ZRHOMIN) - - PSV(:,:,:,3+(JN-1)*3) = ZM(:,:,:,IM6(JN)) * XMD / (XAVOGADRO*1.d-6*PRHODREF(:,:,:)) - XSVMIN(NSV_DSTBEG-1+3+(JN-1)*3) = ZMMIN(IM6(JN)) * XMD / (XAVOGADRO*1.d-6* ZRHOMIN) - - ELSE IF (IMOMENTS == 2) THEN - PSV(:,:,:,1+(JN-1)*2) = ZM(:,:,:,IM0(JN)) * XMD / (XAVOGADRO*PRHODREF(:,:,:)) - XSVMIN(NSV_DSTBEG-1+1+(JN-1)*2) = ZMMIN(IM0(JN)) * XMD / (XAVOGADRO*ZRHOMIN) - - PSV(:,:,:,2+(JN-1)*2) = ZM(:,:,:,IM3(JN)) * XMD*XPI * 4./3. * ZRHOI / & - (ZMI*XM3TOUM3*PRHODREF(:,:,:)) - XSVMIN(NSV_DSTBEG-1+2+(JN-1)*2) = ZMMIN(IM3(JN)) * XMD * XPI * 4. / 3. * ZRHOI / & - (ZMI*XM3TOUM3**ZRHOMIN) - ELSE - PSV(:,:,:,JN) = ZM(:,:,:,IM3(JN)) * XMD*XPI * 4./3. * ZRHOI / & - (ZMI*XM3TOUM3*PRHODREF(:,:,:)) - XSVMIN(NSV_DSTBEG-1+JN) = ZMMIN(IM3(JN)) * XMD * XPI * 4. / 3. * ZRHOI / & - (ZMI*XM3TOUM3**ZRHOMIN) - - END IF -END DO - -! -DEALLOCATE(ZMMIN) -DEALLOCATE(ZINISIGMA) -DEALLOCATE(ZINIRADIUS) -DEALLOCATE(ZSIGMA) -DEALLOCATE(ZM) -DEALLOCATE(ZCTOTA) -DEALLOCATE(IM6) -DEALLOCATE(IM3) -DEALLOCATE(IM0) -DEALLOCATE(ZMASS) -! -END SUBROUTINE DUSTCAMS_n diff --git a/src/ICCARE_BASE/emproc.F90 b/src/ICCARE_BASE/emproc.F90 deleted file mode 100644 index 7cb60b64f..000000000 --- a/src/ICCARE_BASE/emproc.F90 +++ /dev/null @@ -1,292 +0,0 @@ - -SUBROUTINE EMPROC(KTIME, KDATE, PPFD24, T24, PDI, PRECADJ, & - PLAT, PLONG, PLAIP, PLAIC, PTEMP, PPFD, & - PWIND, PRES, PQV, KSLTYP, PSOILM, PSOILT, & - PFTF, OSOIL, PCFNO, PCFNOG, PCFSPEC ) - -!*********************************************************************** -! THIS PROGRAM COMPUTES BIOGENIC EMISSION USING INPUT EMISSION -! CAPACITY MAPS AND MCIP OUTPUT VARIABLES. -! THE EMISSION CAPACITY MAP (INPNAME) ARE GRIDDED IN NETCDF-IOAPI FORMAT -! WITH ALL THE DAILY AVERAGE PPFD AND DAILY AVERAGE TEMPERATURE. -! -! NOTE: THE PROJECTION AND INPUT GRIDS OF THE TWO FILES MUST BE -! IDENTICAL. -! -! -! CALL: -! CHECKMEM -! MODULE GAMMA_ETC -! GAMMA_LAI -! GAMMA_P -! GAMMA_TLD -! GAMMA_TLI -! GAMMA_A -! GAMMA_S -! -! HISTORY: -! CREATED BY JACK CHEN 11/04 -! MODIFIED BY TAN 11/21/06 FOR MEGAN V2.0 -! MODIFIED BY XUEMEI WANG 11/04/2007 FOR MEGAN2.1 -! MODIFIED BY JULIA LEE-TAYLOR 03/18/2008 FOR MEGAN2.1 -! MODIFIED BY XUEMEI WANG 09/30/2008 FOR MEGAN2.1 -! MODIFIED BY TAN 07/28/2011 FOR MEGAN2.1 -! MODIFIED BY P. TULET 01/11/2014 FOR COUPLING WITH ISBA (MESONH) -! MODIFIED BY J. PIANEZZEJ 13/02/2019 BUG in FARCE case -! -!*********************************************************************** -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! -! SCIENTIFIC ALGORITHM -! -! EMISSION = [EF][GAMMA][RHO] -! WHERE [EF] = EMISSION FACTOR (UG/M2H) -! [GAMMA] = EMISSION ACTIVITY FACTOR (NON-DIMENSION) -! [RHO] = PRODUCTION AND LOSS WITHIN PLANT CANOPIES -! (NON-DIMENSIONAL) -! ASSUMPTION: [RHO] = 1 (11/27/06) (SEE PDT_LOT_CP.EXT) -! -! GAMMA = [GAMMA_CE][GAMMA_AGE][GAMMA_SM] -! WHERE [GAMMA_CE] = CANOPY CORRECTION FACTOR -! [GAMMA_AGE] = LEAF AGE CORRECTION FACTOR -! [GAMMA_SM] = SOIL MOISTURE CORRECTION FACTOR -! ASSUMPTION: [GAMMA_SM] = 1 (11/27/06) - -! GAMMA_CE = [GAMMA_LAI][GAMMA_P][GAMMA_T] -! WHERE [GAMMA_LAI] = LEAF AREA INDEX FACTOR -! [GAMMA_P] = PPFD EMISSION ACTIVITY FACTOR -! [GAMMA_T] = TEMPERATURE RESPONSE FACTOR -! -! EMISSION = [EF][GAMMA_LAI][GAMMA_P][GAMMA_T][GAMMA_AGE] -! DERIVATION: -! EMISSION = [EF][GAMMA](1-LDF) + [EF][GAMMA][LDF][GAMMA_P] -! EMISSION = [EF][GAMMA]{ (1-LDF) + [LDF][GAMMA_P] } -! EMISSION = [EF][GAMMA]{ (1-LDF) + [LDF][GAMMA_P] } -! WHERE LDF = LIGHT DEPENDENT FUNCTION (NON-DIMENSION) -! (SEE LD_FCT.EXT) -! -! FINAL EQUATION -! EMISSION = [EF][GAMMA_LAI][GAMMA_AGE]* -! { (1-LDF)[GAMMA_TLI] + [LDF][GAMMA_P][GAMMA_TLD] } !FOR MEGAN2.1 ZER(:) = ZGAM_AGE * ZGAM_SMT * ZRHO * ((1.-ZLDF) * ZGAM_TLI * ZGAM_LHT + ZLDF * ZGAM_TLD) -! WHERE GAMMA_TLI IS LIGHT INDEPENDENT -! GAMMA_TLD IS LIGHT DEPENDENT -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -USE MODD_MEGAN - -USE MODI_INDEX1 -USE MODI_SOILNOX -! -USE MODE_MEGAN -USE MODE_GAMMA_ETC ! MODULE CONTAINING GAMMA FUNCTIONS -! -IMPLICIT NONE - -INTEGER, INTENT(IN) :: KTIME !I TIME OF THE DAY HHMMSS -INTEGER, INTENT(IN) :: KDATE !I DATE YYYYDDD -! -!REAL, INTENT(IN) :: PPFD_D !I DAILY PAR (UMOL/M2.S) -REAL, DIMENSION(:), INTENT(IN) :: T24, PPFD24 !I DAILY TEMPERATURE (K) -REAL, INTENT(IN) :: PDI !I DROUGHT INDEX (0 NORMAL, -2 MODERATE DROUGHT, -3 SEVERE DROUGHT, -4 EXTREME DROUGHT) -REAL, INTENT(IN) :: PRECADJ !I RAIN ADJUSTMENT FACTOR -! -REAL, DIMENSION(:), INTENT(IN) :: PLAT !I LATITUDE OF GRID CELL -REAL, DIMENSION(:), INTENT(IN) :: PLONG !I LONGITUDE OF GRID CELL -REAL, DIMENSION(:), INTENT(IN) :: PLAIP !I PREVIOUS MONTHLY LAI -REAL, DIMENSION(:), INTENT(IN) :: PLAIC !I CURRENT MONTHLY LAI -REAL, DIMENSION(:), INTENT(IN) :: PTEMP !I TEMPERATURE (K) -REAL, DIMENSION(:), INTENT(INOUT) :: PPFD !I CALCULATED PAR (UMOL/M2.S) -REAL, DIMENSION(:), INTENT(IN) :: PWIND !I WIND VELOCITY (M/S) -REAL, DIMENSION(:), INTENT(IN) :: PRES !I ATMOSPHERIC PRESSURE (PA) -REAL, DIMENSION(:), INTENT(IN) :: PQV !I AIR HUMIDITY (KG/KG) -INTEGER,DIMENSION(:),INTENT(IN) :: KSLTYP !I SOIL CATEGORY (FUNCTION OF SILT, CLAY AND SAND)) -REAL, DIMENSION(:), INTENT(IN) :: PSOILM !I SOIL MOISTURE (M3/M3) -REAL, DIMENSION(:), INTENT(IN) :: PSOILT !I SOIL TEMPERATURE (K) -REAL, DIMENSION(:,:),INTENT(IN) :: PFTF ! PFT FACTOR ARRAY (NRTYP 1-16 IN THE FIRST DIM) -LOGICAL, INTENT(IN) :: OSOIL !I LOGICAL FOR ACTIVE NO CORRECTION FACTOR -REAL, DIMENSION(:), INTENT(INOUT) :: PCFNO !O NO CORRECTION FACTOR -REAL, DIMENSION(:), INTENT(INOUT) :: PCFNOG !O NO CORRECTION FACTOR FOR GRASS -REAL, DIMENSION(:,:),INTENT(INOUT) :: PCFSPEC !O OUTPUT EMISSION BUFFER - -! LOCAL VARIABLES AND THEIR DESCRIPTIONS: -REAL, DIMENSION(SIZE(PSOILM)) :: ZGAM_LHT ! LAI CORRECTION FACTOR -REAL, DIMENSION(SIZE(PSOILM)) :: ZGAM_AGE ! LEAF AGE CORRECTION FACTOR -REAL, DIMENSION(SIZE(PSOILM)) :: ZGAM_SMT ! SOIL MOISTURE CORRECTION FACTOR -REAL, DIMENSION(SIZE(PSOILM)) :: ZER ! EMISSION BUFFER -! NUMBER OF LAT, LONG, AND PFT FACTOR VARIABLES -REAL, DIMENSION(SIZE(PSOILM)) :: ZGAM_TLD -REAL, DIMENSION(SIZE(PSOILM)) :: ZGAM_TLI -! -CHARACTER(LEN=100), DIMENSION(N_MGN_SPC+7) :: YVNAME3D -! -REAL, DIMENSION(SIZE(PSOILM)) :: ZADJUST_FACTOR_LD, ZADJUST_FACTOR_LI -REAL, DIMENSION(SIZE(PSOILM)) :: ZGAMMA_TD, ZGAMMA_TI, ZTOTALPFT - -REAL :: ZLDF ! LIGHT DEPENDENT FACTOR -REAL :: ZRHO ! PRODUCTION AND LOSS WITHIN CANOPY -!REAL :: ZPFD_D -! -INTEGER :: I_PFT -INTEGER :: ILAIP_DY, ILAIP_HR, ILAIC_DY, ILAIC_HR -INTEGER :: IMXPFT, IMXLAI - -! LOOP INDICES -INTEGER :: JT, JS, JI, JJ , JK, JN, INP, JL ! COUNTERS -INTEGER :: INMAP ! INDEX -INTEGER :: INVARS3D - -!*********************************************************************** - -!--===================================================================== -!... BEGIN PROGRAM -!--===================================================================== - -!----------------------------------------------------------------------- -!.....1) INITIALIZATION -!----------------------------------------------------------------------- -! - -INVARS3D = N_MGN_SPC + 7 -! -DO JS = 1,N_MGN_SPC - YVNAME3D(JS) = TRIM( CMGN_SPC(JS) ) -! VDESC3D(S) = 'ENVIRONMENTAL ACTIVITY FACTOR FOR '// -! & TRIM( MGN_SPC(S) ) -! UNITS3D(S) = 'NON-DIMENSION ' -! VTYPE3D(S) = M3REAL -ENDDO - -YVNAME3D(N_MGN_SPC+1) = 'D_TEMP' -! UNITS3D(N_MGN_SPC+1) = 'K' -! VTYPE3D(N_MGN_SPC+1) = M3REAL -! VDESC3D(N_MGN_SPC+1) = 'VARIABLE '//'K' - -YVNAME3D(N_MGN_SPC+2) = 'D_PPFD' -! UNITS3D(N_MGN_SPC+2) = 'UMOL/M2.S' -! VTYPE3D(N_MGN_SPC+2) = M3REAL -! VDESC3D(N_MGN_SPC+2) = 'VARIABLE '//'UMOL/M2.S' - -YVNAME3D(N_MGN_SPC+3) = 'LAT' -! UNITS3D(N_MGN_SPC+3) = ' ' -! VTYPE3D(N_MGN_SPC+3) = M3REAL -! VDESC3D(N_MGN_SPC+3) = ' ' - -YVNAME3D(N_MGN_SPC+4) = 'LONG' -! UNITS3D(N_MGN_SPC+4) = ' ' -! VTYPE3D(N_MGN_SPC+4) = M3REAL -! VDESC3D(N_MGN_SPC+4) = ' ' - -YVNAME3D(N_MGN_SPC+5) = 'CFNO' -! UNITS3D(N_MGN_SPC+5) = ' ' -! VTYPE3D(N_MGN_SPC+5) = M3REAL -! VDESC3D(N_MGN_SPC+5) = ' ' - -YVNAME3D(N_MGN_SPC+6) = 'CFNOG' -! UNITS3D(N_MGN_SPC+6) = ' ' -! VTYPE3D(N_MGN_SPC+6) = M3REAL -! VDESC3D(N_MGN_SPC+6) = ' ' - -YVNAME3D(N_MGN_SPC+7) = 'SLTYP' -! UNITS3D(N_MGN_SPC+7) = ' ' -! VTYPE3D(N_MGN_SPC+7) = M3INT -! VDESC3D(N_MGN_SPC+7) = ' ' - -!----------------------------------------------------------------------- -!.....2) PROCESS EMISSION RATES -!----------------------------------------------------------------------- -! -INP = SIZE(PLAT) -! -! ************************************************************************************************ - -! PPFD: SRAD - SHORT WAVE FROM SUN (W/M2) -! ASSUMING 4.766 (UMOL M-2 S-1) PER (W M-2) -! ASSUME 1/2 OF SRAD IS IN 400-700NM BAND -!D_PPFD = D_PPFD * 4.766 * 0.5 -! UPG PT bug: SURFEX give PAR in UMOL M-2 S-1 : comment the lines above -!ZPFD_D = PPFD_D * 4.5 * 0.5 - -!ZPFD_D = PPFD24 - -!PPFD = PPFD * 4.5 -!UPG PT end bug -! ***************************************************************************************** - -! GO OVER ALL THE CHEMICAL SPECIES -DO JS = 1, N_MGN_SPC - - ! INITIALIZE VARIABLES - ZER = 0. - ZGAM_LHT = 1. - ZGAM_AGE = 1. - ZGAM_SMT = 1. - ZGAM_TLD = 1. - ZGAM_TLI = 1. - - PCFNO = 1. - PCFNOG = 1. - - CALL GAMMA_LAI(PLAIC, ZGAM_LHT) - -! IF (JS == 1) print*, "ZGAM_LHT", ZGAM_LHT - - CALL GAMMA_A(KDATE, KTIME, NTSTLEN, YVNAME3D(JS), T24, PLAIP, PLAIC, ZGAM_AGE) - -! IF (JS == 1) print*, "ZGAM_AGE", ZGAM_AGE - - CALL GAMMA_S(ZGAM_SMT) - - ZADJUST_FACTOR_LD(:) = 0.0 - ZADJUST_FACTOR_LI(:) = 0.0 - ZGAMMA_TD(:) = 0.0 - ZGAMMA_TI(:) = 0.0 - ZTOTALPFT(:) = 0.0 - - DO I_PFT = 1,N_MGN_PFT !CANOPY TYPES - ZTOTALPFT(:) = ZTOTALPFT(:) + PFTF(I_PFT,:) * 0.01 !!la division par 100 ZTOTALPFT(:) = ZTOTALPFT(:) + PFTF(I_PFT,:) * 0.01 - ENDDO ! ENDDO I_PFT - - DO I_PFT = 1,N_MGN_PFT !CANOPY TYPES - - CALL GAMME_CE(KDATE, KTIME, XCANOPYCHAR, I_PFT, YVNAME3D(JS), & - PPFD24, PPFD24, T24, T24, PDI, & - PPFD, PLAT, PLONG, PTEMP, PWIND, PQV, PLAIC, & - PRES, ZGAMMA_TD, ZGAMMA_TI) - - ZADJUST_FACTOR_LD(:) = ZADJUST_FACTOR_LD(:) + 0.01 * PFTF(I_PFT,:) * ZGAMMA_TD(:) !!ZADJUST_FACTOR_LD(:) = ZADJUST_FACTOR_LD(:) + 0.01 * PFTF(I_PFT,:) * ZGAMMA_TD(:) - ZADJUST_FACTOR_LI(:) = ZADJUST_FACTOR_LI(:) + 0.01 * PFTF(I_PFT,:) * ZGAMMA_TI(:) !! attention le 0.01 ZADJUST_FACTOR_LI(:) = ZADJUST_FACTOR_LI(:) + 0.01 * PFTF(I_PFT,:) * ZGAMMA_TI(:) - ENDDO ! ENDDO I_PFT - - WHERE (ZTOTALPFT(:).GT.0.) - ZGAM_TLD(:) = ZADJUST_FACTOR_LD(:) / ZTOTALPFT(:) - ZGAM_TLI(:) = ZADJUST_FACTOR_LI(:) / ZTOTALPFT(:) - ELSEWHERE - ZGAM_TLD(:) = 1. - ZGAM_TLI(:) = 1. - END WHERE - - !IF (JS == 1) print*, "ZGAM_TLD(:)", ZGAM_TLD(:) - - INMAP = INDEX1(YVNAME3D(JS), CMGN_SPC) - ZLDF = XLDF_FCT(INMAP) - INMAP = INDEX1(YVNAME3D(JS), CMGN_SPC) - ZRHO = XMGN_MWT(INMAP) - - -!... CALCULATE EMISSION - ZER(:) = ZGAM_AGE * ZGAM_SMT * ZRHO * ((1.-ZLDF) * ZGAM_TLI * ZGAM_LHT + ZLDF * ZGAM_TLD) - WHERE( ZER(:).GT.0. ) - PCFSPEC(JS,:) = ZER(:) - ELSEWHERE - PCFSPEC(JS,:) = 0.0 - END WHERE - -ENDDO - -!... ESTIATE CFNO AND CFNOG -CALL SOILNOX(KDATE, KTIME, OSOIL, KSLTYP, PRECADJ, & - PLAT, PTEMP, PSOILM, PSOILT, PLAIC, PCFNO, PCFNOG ) - -!--===================================================================== -END SUBROUTINE EMPROC - diff --git a/src/ICCARE_BASE/endstep.f90 b/src/ICCARE_BASE/endstep.f90 deleted file mode 100644 index e5e616fed..000000000 --- a/src/ICCARE_BASE/endstep.f90 +++ /dev/null @@ -1,668 +0,0 @@ -!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!----------------------------------------------------------------- -! ################### - MODULE MODI_ENDSTEP -! ################### -! -INTERFACE -! - SUBROUTINE ENDSTEP (PTSTEP,KRR,KSV,KTCOUNT,KMI, & - HUVW_ADV_SCHEME,HTEMP_SCHEME, PRHODJ, & - PUS,PVS,PWS,PDRYMASSS, & - PTHS,PRS,PTKES,PSVS, & - PLSUS,PLSVS,PLSWS, & - PLSTHS,PLSRVS,PLSZWSS, & - PLBXUS,PLBXVS,PLBXWS, & - PLBXTHS,PLBXRS,PLBXTKES,PLBXSVS, & - PLBYUS,PLBYVS,PLBYWS, & - PLBYTHS,PLBYRS,PLBYTKES,PLBYSVS, & - PUM,PVM,PWM,PZWS, & - PUT,PVT,PWT,PPABST,PDRYMASST, & - PTHT,PRT,PTHM,PRCM,PPABSM,PTKET,PSVT, & - PLSUM,PLSVM,PLSWM, & - PLSTHM,PLSRVM,PLSZWSM, & - PLBXUM,PLBXVM,PLBXWM, & - PLBXTHM,PLBXRM,PLBXTKEM,PLBXSVM, & - PLBYUM,PLBYVM,PLBYWM, & - PLBYTHM,PLBYRM,PLBYTKEM,PLBYSVM ) -! -REAL, INTENT(IN) :: PTSTEP ! Time step -INTEGER, INTENT(IN) :: KRR ! Number of water var. -INTEGER, INTENT(IN) :: KSV ! Number of scal. var. -INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop COUNTer -INTEGER, INTENT(IN) :: KMI ! Model index -CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME ! advection scheme for wind -CHARACTER(LEN=4), INTENT(IN) :: HTEMP_SCHEME ! Temporal scheme -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (Rho) dry * Jacobian -! -REAL, DIMENSION(:,:,:), INTENT(IN) :: PUS,PVS,PWS, & ! - PTHS,PTKES ! variables at -REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRS,PSVS ! t+dt -! -REAL, INTENT(IN) :: PDRYMASSS ! Md source -! -REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSUS,PLSVS,PLSWS,& ! Large Scale - PLSTHS,PLSRVS ! fields tendencies -! -REAL, DIMENSION(:,:), INTENT(IN) :: PLSZWSS ! Large Scale fields tendencies -REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUS,PLBXVS,PLBXWS, & ! - PLBXTHS,PLBXTKES ! LBX tendancy -REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBXRS,PLBXSVS ! -! -REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYUS,PLBYVS,PLBYWS,& ! - PLBYTHS,PLBYTKES ! LBY tendancy -REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRS,PLBYSVS ! -! -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUM,PVM,PWM! Variables at t-dt -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT,PPABST,PTHT,&! - PTKET ! Variables at -REAL, DIMENSION(:,:,:,:),INTENT(INOUT):: PRT,PSVT ! t -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHM, PRCM,PPABSM ! Variables at t-Dt -REAL, INTENT(INOUT):: PDRYMASST ! -! -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLSUM,PLSVM,PLSWM,& ! Large Scale fields - PLSTHM,PLSRVM ! at t-dt -REAL, DIMENSION(:,:), INTENT(INOUT) :: PLSZWSM ! Large Scale fields at t-dt -! -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLBXUM,PLBXVM,PLBXWM, & ! - PLBXTHM,PLBXTKEM ! LBX fields -REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PLBXRM,PLBXSVM ! -! -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLBYUM,PLBYVM,PLBYWM, & ! - PLBYTHM,PLBYTKEM ! LBY fields -REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PLBYRM,PLBYSVM ! -REAL, DIMENSION(:,:), INTENT(INOUT) :: PZWS ! significant wave height -! -END SUBROUTINE ENDSTEP -! -END INTERFACE -! -END MODULE MODI_ENDSTEP -! -! -! -! ###################################################################### - SUBROUTINE ENDSTEP (PTSTEP,KRR,KSV,KTCOUNT,KMI, & - HUVW_ADV_SCHEME,HTEMP_SCHEME, PRHODJ, & - PUS,PVS,PWS,PDRYMASSS, & - PTHS,PRS,PTKES,PSVS, & - PLSUS,PLSVS,PLSWS, & - PLSTHS,PLSRVS,PLSZWSS, & - PLBXUS,PLBXVS,PLBXWS, & - PLBXTHS,PLBXRS,PLBXTKES,PLBXSVS, & - PLBYUS,PLBYVS,PLBYWS, & - PLBYTHS,PLBYRS,PLBYTKES,PLBYSVS, & - PUM,PVM,PWM,PZWS, & - PUT,PVT,PWT,PPABST,PDRYMASST, & - PTHT,PRT,PTHM,PRCM,PPABSM,PTKET,PSVT, & - PLSUM,PLSVM,PLSWM, & - PLSTHM,PLSRVM,PLSZWSM, & - PLBXUM,PLBXVM,PLBXWM, & - PLBXTHM,PLBXRM,PLBXTKEM,PLBXSVM, & - PLBYUM,PLBYVM,PLBYWM, & - PLBYTHM,PLBYRM,PLBYTKEM,PLBYSVM ) -! ###################################################################### -! -!!**** *ENDSTEP* - temporal advance and asselin filter for all variables -!! (replaces the previous endstep_dyn and endstep_scalar subroutines) -!! -!! PURPOSE -!! ------- -!! -!! The purpose of ENDSTEP is to apply the asselin filter, perform -!! the time advance and thereby finalize the time step. -! -! -!!** METHOD -!! ------ -!! -!! The filtered values of the prognostic variables at t is obtained -!! by linear combination of variables at t-dt, t, and t+dt. -!! This value is put into the array containing the t-dt value. -!! To perform the time swapping, the t+dt values are put into the arrays -!! containing the t values. -!! -!! In case of cold start (first time step), indicated by the value 'START' -!! of CCONF in module MODD_CONF, a simple time advance is performed. -!! -!! The swapping for the absolute pressure function is only a copy of time t in -!! time (t-dt). -!! -!! Temporal advances of large scale, lateral boundarie and SST fields -!! are also made in this subroutine. -!! -!! The different sources terms are stored for the budget computations. -!! -!! EXTERNAL -!! -------- -!! BUDGET : Stores the different budget components -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! MODULE MODD_DYN containing XASSELIN -!! MODULE MODD_CONF containing CCONF -!! MODULE MODD_CTURB containing XTKEMIN, XEPSMIN -!! MODULE MODD_BUDGET: -!! NBUMOD : model in which budget is calculated -!! NBUTSHIFT : temporal shift for budgets writing -!! -!! REFERENCE -!! --------- -!! Book2 of documentation -!! -!! AUTHOR -!! ------ -!! P. Bougeault Meteo France -!! -!! MODIFICATIONS -!! ------------- -!! -!! original 22/06/94 -!! corrections 01/09/94 (J. P. Lafore) -!! " 07/11/94 (J.Stein) pressure function swapping -!! update 03/01/94 (J. P. Lafore) Total mass of dry air Md evolution -!! 20/03/95 (J.Stein ) remove R from the historical variables -!! + switch for TKE unused -!! 01/04/95 (Ph. Hereil J. Nicolau) add the budget computation -!! 30/08/95 (J.Stein) remove the positivity control and -!! correct the bug for PRM and PSVM for the cold start -!! 16/10/95 (J. Stein) change the budget calls -!! 12/10/96 (J. Stein) add the SRC temporal evolution -!! 20/12/96 (J.-P. Pinty) update the CALL BUDGET -!! 03/09/96 (J. P. Lafore) temporal advance of LS scalar fields -!! 22/06/97 (J. Stein) add the absolute pressure -!! 13/03/97 (J. P. Lafore) add "surfacic" LS fields -!! 24/09/97 (V. Masson) positive values for ls fields -!! 10/01/98 (J. Stein) use the LB fields -!! 20/04/98 (P. Josse) temporal evolution of SST -!! 18/09/98 (P. Jabouille) merge endstep_dyn and endstep_scalar -!! 08/12/00 (P. Jabouille) minimum values for hydrometeors -!! 22/06/01 (P. Jabouille) use XSVMIN -!! 06/11/02 (V. Masson) update the budget calls -!! 01/2004 (V. Masson) surface externalization -!! 05/2006 Remove KEPS -!! 10/2006 (Maric, Lac) modification for PPM schemes -!! 10/2009 (C.Lac) Correction on FIT temporal scheme for variables -!! advected with PPM -!! 04/2013 (C.Lac) FIT for all the variables -!! 04/2014 (C.Lac) Check on the positivity of PSVT -!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1 -!! 02/2019 (S. Bielli) Sea salt : significant sea wave height influences salt emission; 5 salt modes -! P. Wautelet 02/2020: use the new data structures and subroutines for budgets -! P. Wautelet 02/2022: add sea salt -!------------------------------------------------------------------------------ -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_BLOWSNOW -USE MODD_BLOWSNOW_n -use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, lbudget_tke, lbudget_rv, lbudget_rc, & - lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, lbu_enable, & - NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_TH, NBUDGET_TKE, NBUDGET_RV, NBUDGET_RC, & - NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, & - nbustep, tbudgets -USE MODD_CH_AEROSOL, ONLY: LORILAM -USE MODD_CONF -USE MODD_CTURB -USE MODD_DUST, ONLY: LDUST -USE MODD_SALT, ONLY: LSALT -USE MODD_DYN -USE MODD_GRID_n -USE MODD_LBC_n, ONLY: CLBCX, CLBCY -USE MODD_NSV, ONLY: XSVMIN, NSV_CHEMBEG, NSV_CHEMEND, & - NSV_AERBEG, NSV_AEREND,& - NSV_DSTBEG, NSV_DSTEND,& - NSV_SLTBEG, NSV_SLTEND,& - NSV_SNWBEG, NSV_SNWEND -USE MODD_PARAM_C2R2, ONLY: LACTIT -USE MODD_PARAM_LIMA, ONLY: LACTIT_LIMA=>LACTIT - -use mode_budget, only: Budget_store_end, Budget_store_init - -USE MODI_SHUMAN -! -USE MODE_ll -! -IMPLICIT NONE -! -!* 0.1 DECLARATIONS OF ARGUMENTS -! -! -REAL, INTENT(IN) :: PTSTEP ! Time step -INTEGER, INTENT(IN) :: KRR ! Number of water var. -INTEGER, INTENT(IN) :: KSV ! Number of scal. var. -INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop COUNTer -INTEGER, INTENT(IN) :: KMI ! Model index -CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME ! advection scheme for wind -CHARACTER(LEN=4), INTENT(IN) :: HTEMP_SCHEME ! Temporal scheme -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (Rho) dry * Jacobian -! -REAL, DIMENSION(:,:,:), INTENT(IN) :: PUS,PVS,PWS, & ! - PTHS,PTKES ! variables at -REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRS,PSVS ! t+dt -! -REAL, INTENT(IN) :: PDRYMASSS ! Md source -! -REAL, DIMENSION(:,:,:), INTENT(IN) :: PLSUS,PLSVS,PLSWS,& ! Large Scale - PLSTHS,PLSRVS ! fields tendencies -REAL, DIMENSION(:,:), INTENT(IN) :: PLSZWSS ! Large Scale fields tendencies -! -REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUS,PLBXVS,PLBXWS, & ! - PLBXTHS,PLBXTKES ! LBX tendancy -REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBXRS,PLBXSVS ! -! -REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBYUS,PLBYVS,PLBYWS,& ! - PLBYTHS,PLBYTKES ! LBY tendancy -REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRS,PLBYSVS ! -! -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUM,PVM,PWM! Variables at t-dt -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT,PPABST,PTHT,&! - PTKET ! Variables at -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHM, PRCM, PPABSM ! Variables at t-Dt -REAL, DIMENSION(:,:,:,:),INTENT(INOUT):: PRT,PSVT ! t -REAL, INTENT(INOUT):: PDRYMASST ! -! -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLSUM,PLSVM,PLSWM,& ! Large Scale fields - PLSTHM,PLSRVM ! at t-dt -! -REAL, DIMENSION(:,:), INTENT(INOUT) :: PLSZWSM ! Large Scale fields at t-dt -! -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLBXUM,PLBXVM,PLBXWM, & ! - PLBXTHM,PLBXTKEM ! LBX fields -REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PLBXRM,PLBXSVM ! -! -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLBYUM,PLBYVM,PLBYWM, & ! - PLBYTHM,PLBYTKEM ! LBY fields -REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PLBYRM,PLBYSVM ! -! -REAL, DIMENSION(:,:), INTENT(INOUT) :: PZWS ! significant wave height -! -!* 0.2 DECLARATIONS OF LOCAL VARIABLES -! -INTEGER:: JSV ! loop counters -INTEGER :: IIB, IIE ! index of first and last inner mass points along x -INTEGER :: IJB, IJE ! index of first and last inner mass points along y -real, dimension(:,:,:), allocatable :: zrhodjontime -real, dimension(:,:,:), allocatable :: zwork -! -!------------------------------------------------------------------------------ -! -CALL GET_INDICE_ll (IIB,IJB,IIE,IJE) -! -!* 1. ASSELIN FILTER -! -IF ((HUVW_ADV_SCHEME(1:3)=='CEN').AND. (HTEMP_SCHEME == 'LEFR')) THEN - IF( KTCOUNT /= 1 .OR. CCONF /= 'START' ) THEN - PUM(:,:,:)=(1.-XASSELIN)*PUT(:,:,:)+0.5*XASSELIN*(PUM(:,:,:)+PUS(:,:,:)) - PVM(:,:,:)=(1.-XASSELIN)*PVT(:,:,:)+0.5*XASSELIN*(PVM(:,:,:)+PVS(:,:,:)) - PWM(:,:,:)=(1.-XASSELIN)*PWT(:,:,:)+0.5*XASSELIN*(PWM(:,:,:)+PWS(:,:,:)) - END IF -END IF - -!* 1. TEMPORAL ADVANCE OF PROGNOSTIC VARIABLES -! -PPABSM(:,:,:) = PPABST(:,:,:) -! -IF (LACTIT .OR. LACTIT_LIMA) THEN - PTHM(:,:,:) = PTHT(:,:,:) - PRCM(:,:,:) = PRT(:,:,:,2) -END IF - -PUT(:,:,:)=PUS(:,:,:) -PVT(:,:,:)=PVS(:,:,:) -PWT(:,:,:)=PWS(:,:,:) -! -PDRYMASST = PDRYMASST + PTSTEP * PDRYMASSS -! -PTHT(:,:,:)=PTHS(:,:,:) -! -! Moisture -! -PRT(:,:,:,1:KRR)=PRS(:,:,:,1:KRR) -! -! Turbulence -! -IF (SIZE(PTKET,1) /= 0) PTKET(:,:,:)=PTKES(:,:,:) -! -! Other scalars -! -PSVT(:,:,:,1:KSV)=PSVS(:,:,:,1:KSV) -! -IF(LBLOWSNOW) THEN - DO JSV=1,(NBLOWSNOW_2D) - XSNWCANO(:,:,JSV) = XRSNWCANOS(:,:,JSV) - END DO -!* MINIMUM VALUE FOR BLOWING SNOW -! - WHERE(XSNWCANO(:,:,:)<1.E-20) - XSNWCANO(:,:,:)=0. - END WHERE - - IF (SIZE(PSVT,4) > 1) THEN - WHERE(PSVT(:,:,:,NSV_SNWBEG:NSV_SNWEND)<1.E-20) - PSVT(:,:,:,NSV_SNWBEG:NSV_SNWEND)=0. - END WHERE - END IF -! -END IF -! -IF (LWEST_ll( ) .AND. CLBCX(1)=='OPEN') THEN - DO JSV=1,KSV - PSVT(IIB,:,:,JSV)=MAX(PSVT(IIB,:,:,JSV),XSVMIN(JSV)) - PSVT(IIB-1,:,:,JSV)=MAX(PSVT(IIB-1,:,:,JSV),XSVMIN(JSV)) - END DO -END IF -! -IF (LEAST_ll( ) .AND. CLBCX(2)=='OPEN') THEN - DO JSV=1,KSV - PSVT(IIE,:,:,JSV)=MAX(PSVT(IIE,:,:,JSV),XSVMIN(JSV)) - PSVT(IIE+1,:,:,JSV)=MAX(PSVT(IIE+1,:,:,JSV),XSVMIN(JSV)) - END DO -END IF -! -IF (LSOUTH_ll( ) .AND. CLBCY(1)=='OPEN') THEN - DO JSV=1,KSV - PSVT(:,IJB,:,JSV)=MAX(PSVT(:,IJB,:,JSV),XSVMIN(JSV)) - PSVT(:,IJB-1,:,JSV)=MAX(PSVT(:,IJB-1,:,JSV),XSVMIN(JSV)) - END DO -END IF -! -IF (LNORTH_ll( ) .AND. CLBCY(2)=='OPEN') THEN - DO JSV=1,KSV - PSVT(:,IJE,:,JSV)=MAX(PSVT(:,IJE,:,JSV),XSVMIN(JSV)) - PSVT(:,IJE+1,:,JSV)=MAX(PSVT(:,IJE+1,:,JSV),XSVMIN(JSV)) - END DO -END IF -!------------------------------------------------------------------------------ -! -!* 4. TEMPORAL ADVANCE OF THE LARGE SCALE FIELDS -! -! -IF (SIZE(PLSUS,1) /= 0) THEN - PLSUM(:,:,:) = PLSUM(:,:,:) + PTSTEP * PLSUS(:,:,:) - PLSVM(:,:,:) = PLSVM(:,:,:) + PTSTEP * PLSVS(:,:,:) - PLSWM(:,:,:) = PLSWM(:,:,:) + PTSTEP * PLSWS(:,:,:) -END IF -! -IF (SIZE(PLSTHS,1) /= 0) THEN - PLSTHM(:,:,:) = PLSTHM(:,:,:) + PTSTEP * PLSTHS(:,:,:) -ENDIF -! -IF (SIZE(PLSRVS,1) /= 0) THEN - PLSRVM(:,:,:) = MAX( PLSRVM(:,:,:) + PTSTEP * PLSRVS(:,:,:) , 0.) -ENDIF - -IF (SIZE(PLSZWSS,1) /= 0) THEN - PLSZWSM(:,:) = MAX( PLSZWSM(:,:) + PTSTEP * PLSZWSS(:,:) , 0.) - PZWS(:,:) = PLSZWSM(:,:) -ENDIF -! -!------------------------------------------------------------------------------ -! -!* 5. TEMPORAL ADVANCE OF THE LATERAL BOUNDARIES FIELDS -! -IF (SIZE(PLBXUS,1) /= 0) THEN - PLBXUM(:,:,:) = PLBXUM(:,:,:) + PTSTEP * PLBXUS(:,:,:) - PLBXVM(:,:,:) = PLBXVM(:,:,:) + PTSTEP * PLBXVS(:,:,:) - PLBXWM(:,:,:) = PLBXWM(:,:,:) + PTSTEP * PLBXWS(:,:,:) -ENDIF -IF (SIZE(PLBYUS,1) /= 0) THEN - PLBYUM(:,:,:) = PLBYUM(:,:,:) + PTSTEP * PLBYUS(:,:,:) - PLBYVM(:,:,:) = PLBYVM(:,:,:) + PTSTEP * PLBYVS(:,:,:) - PLBYWM(:,:,:) = PLBYWM(:,:,:) + PTSTEP * PLBYWS(:,:,:) -ENDIF -! -IF (SIZE(PLBXTHS,1) /= 0) THEN - PLBXTHM(:,:,:) = PLBXTHM(:,:,:) + PTSTEP * PLBXTHS(:,:,:) -END IF -IF (SIZE(PLBYTHS,1) /= 0) THEN - PLBYTHM(:,:,:) = PLBYTHM(:,:,:) + PTSTEP * PLBYTHS(:,:,:) -END IF -! -IF (SIZE(PLBXTKES,1) /= 0) THEN - PLBXTKEM(:,:,:) = MAX( PLBXTKEM(:,:,:) + PTSTEP * PLBXTKES(:,:,:), XTKEMIN) -END IF -IF (SIZE(PLBYTKES,1) /= 0) THEN - PLBYTKEM(:,:,:) = MAX( PLBYTKEM(:,:,:) + PTSTEP * PLBYTKES(:,:,:), XTKEMIN) -END IF -! -IF (SIZE(PLBXRS,1) /= 0) THEN - PLBXRM(:,:,:,:) = MAX( PLBXRM(:,:,:,:) + PTSTEP * PLBXRS(:,:,:,:), 0.) -END IF -IF (SIZE(PLBYRS,1) /= 0) THEN - PLBYRM(:,:,:,:) = MAX( PLBYRM(:,:,:,:) + PTSTEP * PLBYRS(:,:,:,:), 0.) -END IF -! -IF (SIZE(PLBXSVS,1) /= 0) THEN - DO JSV = 1,KSV - PLBXSVM(:,:,:,JSV) = MAX( PLBXSVM(:,:,:,JSV) + PTSTEP * PLBXSVS(:,:,:,JSV),XSVMIN(JSV)) - ENDDO -ENDIF -IF (SIZE(PLBYSVS,1) /= 0) THEN - DO JSV = 1,KSV - PLBYSVM(:,:,:,JSV) = MAX( PLBYSVM(:,:,:,JSV) + PTSTEP * PLBYSVS(:,:,:,JSV),XSVMIN(JSV)) - ENDDO -END IF -! -!------------------------------------------------------------------------------ -! -!* 6. MINIMUM VALUE FOR HYDROMETEORS -! -IF (SIZE(PRT,4) > 1) THEN - WHERE(PRT(:,:,:,2:)<1.E-20) - PRT(:,:,:,2:)=0. - END WHERE -END IF -IF (SIZE(PLBXRM,4) > 1) THEN - WHERE(PLBXRM(:,:,:,2:)<1.E-20) - PLBXRM(:,:,:,2:)=0. - END WHERE -END IF -IF (SIZE(PLBYRM,4) > 1) THEN - WHERE(PLBYRM(:,:,:,2:)<1.E-20) - PLBYRM(:,:,:,2:)=0. - END WHERE -END IF -! -!------------------------------------------------------------------------------ -! -!* 7. MINIMUM VALUE FOR CHEMISTRY -! -IF ((SIZE(PLBXSVM,4) > NSV_CHEMEND-1).AND.(SIZE(PLBXSVM,1) /= 0)) THEN - DO JSV=NSV_CHEMBEG, NSV_CHEMEND - PLBXSVM(:,:,:,JSV) = MAX(PLBXSVM(:,:,:,JSV), XSVMIN(JSV)) - END DO -END IF -IF ((SIZE(PLBYSVM,4) > NSV_CHEMEND-1).AND.(SIZE(PLBYSVM,1) /= 0)) THEN - DO JSV=NSV_CHEMBEG, NSV_CHEMEND - PLBYSVM(:,:,:,JSV) = MAX(PLBYSVM(:,:,:,JSV), XSVMIN(JSV)) - END DO -END IF -! -!------------------------------------------------------------------------------ -! -!* 8. MINIMUM VALUE FOR AEROSOLS -! -IF (LORILAM) THEN - IF ((SIZE(PLBXSVM,4) > NSV_AEREND-1).AND.(SIZE(PLBXSVM,1) /= 0)) THEN - DO JSV=NSV_AERBEG, NSV_AEREND - PLBXSVM(:,:,:,JSV) = MAX(PLBXSVM(:,:,:,JSV), XSVMIN(JSV)) - END DO - END IF - IF ((SIZE(PLBYSVM,4) > NSV_AEREND-1).AND.(SIZE(PLBYSVM,1) /= 0)) THEN - DO JSV=NSV_AERBEG, NSV_AEREND - PLBYSVM(:,:,:,JSV) = MAX(PLBYSVM(:,:,:,JSV), XSVMIN(JSV)) - END DO - END IF -END IF -! -!------------------------------------------------------------------------------ -! -!* 9. MINIMUM VALUE FOR DUSTS -! -IF (LDUST) THEN - IF ((SIZE(PLBXSVM,4) > NSV_DSTEND-1).AND.(SIZE(PLBXSVM,1) /= 0)) THEN - DO JSV=NSV_DSTBEG, NSV_DSTEND - PLBXSVM(:,:,:,JSV) = MAX(PLBXSVM(:,:,:,JSV), XSVMIN(JSV)) - END DO - END IF - IF ((SIZE(PLBYSVM,4) > NSV_DSTEND-1).AND.(SIZE(PLBYSVM,1) /= 0)) THEN - DO JSV=NSV_DSTBEG, NSV_DSTEND - PLBYSVM(:,:,:,JSV) = MAX(PLBYSVM(:,:,:,JSV), XSVMIN(JSV)) - END DO - END IF -END IF -! -!------------------------------------------------------------------------------ -! -!* 9. MINIMUM VALUE FOR SEA SALTS -! -IF (LSALT) THEN - IF ((SIZE(PLBXSVM,4) > NSV_SLTEND-1).AND.(SIZE(PLBXSVM,1) /= 0)) THEN - DO JSV=NSV_SLTBEG, NSV_SLTEND - PLBXSVM(:,:,:,JSV) = MAX(PLBXSVM(:,:,:,JSV), XSVMIN(JSV)) - END DO - END IF - IF ((SIZE(PLBYSVM,4) > NSV_SLTEND-1).AND.(SIZE(PLBYSVM,1) /= 0)) THEN - DO JSV=NSV_SLTBEG, NSV_SLTEND - PLBYSVM(:,:,:,JSV) = MAX(PLBYSVM(:,:,:,JSV), XSVMIN(JSV)) - END DO - END IF -END IF -! -!------------------------------------------------------------------------------ -! -!* 11. STORAGE IN BUDGET ARRAYS -! -IF (LBU_ENABLE) THEN - !Division by nbustep to compute average on the selected time period - if ( lbudget_u .or. lbudget_v .or. lbudget_w .or. lbudget_th & - .or. lbudget_tke .or. lbudget_rv .or. lbudget_rc .or. lbudget_rr .or. lbudget_ri & - .or. lbudget_rs .or. lbudget_rg .or. lbudget_rh .or. lbudget_sv ) then - Allocate( zrhodjontime, mold = prhodj ) - Allocate( zwork, mold = prhodj ) - zrhodjontime(:, :, :) = prhodj(:, :, :) / ( ptstep * nbustep ) - end if - - if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U ), 'AVEF', put (:, :, :) * zrhodjontime(:, :, :) ) - if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V ), 'AVEF', pvt (:, :, :) * zrhodjontime(:, :, :) ) - if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W ), 'AVEF', pwt (:, :, :) * zrhodjontime(:, :, :) ) - if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH ), 'AVEF', ptht (:, :, :) * zrhodjontime(:, :, :) ) - if ( lbudget_tke ) call Budget_store_end( tbudgets(NBUDGET_TKE), 'AVEF', ptket(:, :, :) * zrhodjontime(:, :, :) ) - if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV ), 'AVEF', prt (:, :, :, 1) * zrhodjontime(:, :, :) ) - if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC ), 'AVEF', prt (:, :, :, 2) * zrhodjontime(:, :, :) ) - if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR ), 'AVEF', prt (:, :, :, 3) * zrhodjontime(:, :, :) ) - if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI ), 'AVEF', prt (:, :, :, 4) * zrhodjontime(:, :, :) ) - if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS ), 'AVEF', prt (:, :, :, 5) * zrhodjontime(:, :, :) ) - if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG ), 'AVEF', prt (:, :, :, 6) * zrhodjontime(:, :, :) ) - if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH ), 'AVEF', prt (:, :, :, 7) * zrhodjontime(:, :, :) ) - if ( lbudget_sv ) then - do jsv = 1, ksv - call Budget_store_end( tbudgets(jsv + NBUDGET_SV1 - 1), 'AVEF', psvt(:, :, :, jsv) * zrhodjontime(:, :, :) ) - end do - end if - - if ( lbudget_u ) then - zwork(:, :, :) = pus (:, :, :) * Mxm( prhodj(:, :, :) ) / ptstep - call Budget_store_end( tbudgets(NBUDGET_U ), 'ENDF', zwork ) - call Budget_store_init( tbudgets(NBUDGET_U ), 'ASSE', zwork ) - end if - - if ( lbudget_v ) then - zwork(:, :, :) = pvs (:, :, :) * Mym( prhodj(:, :, :) ) / ptstep - call Budget_store_end( tbudgets(NBUDGET_V ), 'ENDF', zwork ) - call Budget_store_init( tbudgets(NBUDGET_V ), 'ASSE', zwork ) - end if - - if ( lbudget_w ) then - zwork(:, :, :) = pws (:, :, :) * Mzm( prhodj(:, :, :) ) / ptstep - call Budget_store_end( tbudgets(NBUDGET_W ), 'ENDF', zwork ) - call Budget_store_init( tbudgets(NBUDGET_W ), 'ASSE', zwork ) - end if - - if ( lbudget_th .or. lbudget_tke .or. lbudget_rv .or. lbudget_rc .or. lbudget_rr & - .or. lbudget_ri .or. lbudget_rs .or. lbudget_rg .or. lbudget_rh .or. lbudget_sv ) then - zrhodjontime(:, :, :) = prhodj(:, :, :) / ptstep - end if - - if ( lbudget_th ) then - zwork(:, :, :) = pths (:, :, :) * zrhodjontime(:, :, :) - call Budget_store_end( tbudgets(NBUDGET_TH ), 'ENDF', zwork ) - call Budget_store_init( tbudgets(NBUDGET_TH ), 'ASSE', zwork ) - end if - - if ( lbudget_tke ) then - zwork(:, :, :) = ptkes(:, :, :) * zrhodjontime(:, :, :) - call Budget_store_end( tbudgets(NBUDGET_TKE), 'ENDF', zwork ) - call Budget_store_init( tbudgets(NBUDGET_TKE), 'ASSE', zwork ) - end if - - if ( lbudget_rv ) then - zwork(:, :, :) = prs (:, :, :, 1) * zrhodjontime(:, :, :) - call Budget_store_end( tbudgets(NBUDGET_RV ), 'ENDF', zwork ) - call Budget_store_init( tbudgets(NBUDGET_RV ), 'ASSE', zwork ) - end if - - if ( lbudget_rc ) then - zwork(:, :, :) = prs (:, :, :, 2) * zrhodjontime(:, :, :) - call Budget_store_end( tbudgets(NBUDGET_RC ), 'ENDF', zwork ) - call Budget_store_init( tbudgets(NBUDGET_RC ), 'ASSE', zwork ) - end if - - if ( lbudget_rr ) then - zwork(:, :, :) = prs (:, :, :, 3) * zrhodjontime(:, :, :) - call Budget_store_end( tbudgets(NBUDGET_RR ), 'ENDF', zwork ) - call Budget_store_init( tbudgets(NBUDGET_RR ), 'ASSE', zwork ) - end if - - if ( lbudget_ri ) then - zwork(:, :, :) = prs (:, :, :, 4) * zrhodjontime(:, :, :) - call Budget_store_end( tbudgets(NBUDGET_RI ), 'ENDF', zwork ) - call Budget_store_init( tbudgets(NBUDGET_RI ), 'ASSE', zwork ) - end if - - if ( lbudget_rs ) then - zwork(:, :, :) = prs (:, :, :, 5) * zrhodjontime(:, :, :) - call Budget_store_end( tbudgets(NBUDGET_RS ), 'ENDF', zwork ) - call Budget_store_init( tbudgets(NBUDGET_RS ), 'ASSE', zwork ) - end if - - if ( lbudget_rg ) then - zwork(:, :, :) = prs (:, :, :, 6) * zrhodjontime(:, :, :) - call Budget_store_end( tbudgets(NBUDGET_RG ), 'ENDF', zwork ) - call Budget_store_init( tbudgets(NBUDGET_RG ), 'ASSE', zwork ) - end if - - if ( lbudget_rh ) then - zwork(:, :, :) = prs (:, :, :, 7) * zrhodjontime(:, :, :) - call Budget_store_end( tbudgets(NBUDGET_RH ), 'ENDF', zwork ) - call Budget_store_init( tbudgets(NBUDGET_RH ), 'ASSE', zwork ) - end if - - if ( lbudget_sv ) then - do jsv = 1, ksv - zwork(:, :, :) = psvs(:, :, :, jsv) * zrhodjontime(:, :, :) - call Budget_store_end( tbudgets(jsv + NBUDGET_SV1 - 1), 'ENDF', zwork ) - call Budget_store_init( tbudgets(jsv + NBUDGET_SV1 - 1), 'ASSE', zwork ) - end do - end if - - if ( Allocated( zwork ) ) Deallocate( zwork ) - if ( Allocated( zrhodjontime ) ) Deallocate( zrhodjontime ) -END IF -! -!------------------------------------------------------------------------------ -! -!* 12. COMPUTATION OF PHASE VELOCITY -! ----------------------------- -! -! It is temporarily set to a constant value -! -!------------------------------------------------------------------------------ -! -! -END SUBROUTINE ENDSTEP diff --git a/src/ICCARE_BASE/get_vegtype_2_patch_mask.F90 b/src/ICCARE_BASE/get_vegtype_2_patch_mask.F90 deleted file mode 100644 index 3c15e31c4..000000000 --- a/src/ICCARE_BASE/get_vegtype_2_patch_mask.F90 +++ /dev/null @@ -1,84 +0,0 @@ -!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -SUBROUTINE GET_VEGTYPE_2_PATCH_MASK( & - KLUOUT, &! output listing logical unit - KSIZE_VEG, &!I Size of a vegetation vector within a patch vector - KSIZE_PATCH, &!I Size of a patch within a nature vector - KMASK_PATCH_NATURE, &!I Mask to transform from patch vector to nature vector - PVEGTYPE_PATCH, &!I Fraction of a nature point #i with vegetation #j which is packed to patch #k - KMASK, &!O Mask from vegtype vector to patch vector - KVEGTYPE &!I Index of vegtype in question - ) -! -! -!! PURPOSE -!! ------- -! Create a patch-->vegtype mask -! So that later, a patch can be packed into vegtype vectors -!! -!! AUTHOR -!! ------ -!! Alf Grini <alf.grini@cnrm.meteo.fr> -!! -!! MODIFICATIONS -!! ------------- -!! Original 01/2005 -USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE ! Number of possible vegtypes -!!------------------------------------------------------------------ -! -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -USE MODI_ABOR1_SFX -! -IMPLICIT NONE -!* 0.1 declarations of arguments -! -INTEGER, INTENT(IN) :: KLUOUT !Output listing logical unit -INTEGER, INTENT(IN) :: KSIZE_VEG !Size of vegetation vector in question -INTEGER, INTENT(IN) :: KSIZE_PATCH !Size of patch vector in question -INTEGER, INTENT(IN),DIMENSION(:) :: KMASK_PATCH_NATURE !PATCH -->NATURE mask -! -INTEGER, INTENT(IN) :: KVEGTYPE !Vegtype in quesition - -REAL, DIMENSION(:,:), INTENT(IN) :: PVEGTYPE_PATCH !Fraction of nature point in npatch with nveg vegetation -! -!OUTPUT -INTEGER, DIMENSION(KSIZE_VEG), INTENT(OUT) :: KMASK !vegetation type to patch - -! -!LOCAL -! -INTEGER :: KK ! Counter for points in vegetation vector -INTEGER :: JJ ! Counter for points in patch vector -INTEGER :: II ! Point in nature vector corresponding to JJ -REAL(KIND=JPRB) :: ZHOOK_HANDLE -! -!------------------------------------------------------------------------------- -! -IF (LHOOK) CALL DR_HOOK('GET_VEGTYPE_2_PATCH_MASK',0,ZHOOK_HANDLE) -KMASK(:) = 0 - -KK=1 !First point of vegetation-vector - -DO JJ=1,KSIZE_PATCH !Number of points in the patch in question - II=JJ !KMASK_PATCH_NATURE(JJ) !Nature-index corresponding to the point in question - IF(PVEGTYPE_PATCH(II,KVEGTYPE)>0.)THEN - KMASK(KK)=JJ - KK=KK+1 - ENDIF -ENDDO !Loop on points in patch vector - -IF(KK-1.ne.KSIZE_VEG) THEN - WRITE(KLUOUT,*) "ERROR in routine GET_VEGTYPE_2_PATCH_MASK" - WRITE(KLUOUT,*) "problem in number of vegetation types" - WRITE(KLUOUT,*) "KK-1 =", KK-1 - WRITE(KLUOUT,*) "KSIZE_VEG=", KSIZE_VEG - CALL ABOR1_SFX('GET_VEGTYPE_2_PATCH_MASK: WRONG NUMBER OF VEGETATION TYPES') -END IF -IF (LHOOK) CALL DR_HOOK('GET_VEGTYPE_2_PATCH_MASK',1,ZHOOK_HANDLE) - -END SUBROUTINE GET_VEGTYPE_2_PATCH_MASK diff --git a/src/ICCARE_BASE/ground_paramn.f90 b/src/ICCARE_BASE/ground_paramn.f90 deleted file mode 100644 index 876a976d4..000000000 --- a/src/ICCARE_BASE/ground_paramn.f90 +++ /dev/null @@ -1,1034 +0,0 @@ -!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!----------------------------------------------------------------- -! ########## -MODULE MODI_GROUND_PARAM_n -! ########## -! -INTERFACE -! - SUBROUTINE GROUND_PARAM_n( PSFTH, PSFRV, PSFSV, PSFCO2, PSFU, PSFV, & - PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD ) -! -!* surface fluxes -! -------------- -! -REAL, DIMENSION(:,:), INTENT(OUT) :: PSFTH ! surface flux of potential temperature (Km/s) -REAL, DIMENSION(:,:), INTENT(OUT) :: PSFRV ! surface flux of water vapor (m/s*kg/kg) -REAL, DIMENSION(:,:,:),INTENT(OUT):: PSFSV ! surface flux of scalar (m/s*kg/kg) - ! flux of chemical var. (ppp.m/s) -REAL, DIMENSION(:,:), INTENT(OUT) :: PSFCO2! surface flux of CO2 (m/s*kg/kg) -REAL, DIMENSION(:,:), INTENT(OUT) :: PSFU ! surface fluxes of horizontal -REAL, DIMENSION(:,:), INTENT(OUT) :: PSFV ! momentum in x and y directions (m2/s2) -! -!* Radiative parameters -! -------------------- -! -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDIR_ALB ! direct albedo for each spectral band (-) -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSCA_ALB ! diffuse albedo for each spectral band (-) -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEMIS ! surface emissivity (-) -REAL, DIMENSION(:,:), INTENT(OUT) :: PTSRAD ! surface radiative temperature (K) -! -END SUBROUTINE GROUND_PARAM_n -! -END INTERFACE -! -END MODULE MODI_GROUND_PARAM_n -! -! ###################################################################### - SUBROUTINE GROUND_PARAM_n( PSFTH, PSFRV, PSFSV, PSFCO2, PSFU, PSFV, & - PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD ) -! ####################################################################### -! -! -!!**** *GROUND_PARAM* -!! -!! PURPOSE -!! ------- -! Monitor to call the externalized surface -! -!!** METHOD -!! ------ -! -!! EXTERNAL -!! -------- -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! -!! REFERENCE -!! --------- -!! -!! Noilhan and Planton (1989) -!! -!! AUTHOR -!! ------ -!! S. Belair * Meteo-France * -!! -!! MODIFICATIONS -!! ------------- -!! Original 10/03/95 -!! (J.Stein) 25/10/95 add the rain flux computation at the ground -!! and the lbc -!! (J.Stein) 15/11/95 include the strong slopes cases -!! (J.Stein) 06/02/96 bug correction for the precipitation flux writing -!! (J.Stein) 20/05/96 set the right IGRID value for the rain rate -!! (J.Viviand) 04/02/97 add cold and convective precipitation rate -!! (J.Stein) 22/06/97 use the absolute pressure -!! (V.Masson) 09/07/97 add directional z0 computations and RESA correction -!! (V.Masson) 13/02/98 merge the ISBA and TSZ0 routines, -!! rename the routine as a monitor, called by PHYS_PARAMn -!! add the town parameterization -!! recomputes z0 where snow is. -!! pack and unpack of 2D fields into 1D fields -!! (V.Masson) 04/01/00 removes the TSZ0 case -! (F.Solmon/V.Masson) adapatation for patch approach -! modification of internal subroutine pack/ allocation in function -! of patch indices -! calling of isba for each defined patch -! averaging of patch fluxes to get nat fluxes -! (P. Tulet/G.Guenais) 04/02/01 separation of vegetatives class -! for friction velocity and -! aerodynamical resistance -! (S Donnier) 09/12/02 add specific humidity at 2m for diagnostic -! (V.Masson) 01/03/03 externalisation of the surface schemes! -! (P.Tulet ) 01/11/03 externalisation of the surface chemistry! -!! (D.Gazen) 01/12/03 change emissions handling for surf. externalization -!! (J.escobar) 18/10/2012 missing USE MODI_COUPLING_SURF_ATM_n & MODI_DIAG_SURF_ATM_n -! (J.escobar) 02/2014 add Forefire coupling -!! (G.Delautier) 06/2016 phasage surfex 8 -!! (B.Vie) 2016 LIMA -!! (J.Pianezze) 08/2016 add send/recv oasis functions -!! (M.Leriche) 24/03/16 remove flag for chemical surface fluxes -!! (M.Leriche) 01/07/2017 Add DIAG chimical surface fluxes -!! 01/2018 (G.Delautier) SURFEX 8.1 -!! 02/2018 Q.Libois ECRAD -!! (P.Wautelet) 28/03/2018 replace TEMPORAL_DIST by DATETIME_DISTANCE - -!! (V. Vionnet) 18/07/2017 add coupling for blowing snow module -!! (Bielli S.) 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes -! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -! -#ifdef CPLOASIS -USE MODI_GET_HALO -USE MODI_MNH_OASIS_RECV -USE MODI_MNH_OASIS_SEND -USE MODD_SFX_OASIS, ONLY : LOASIS -USE MODD_DYN, ONLY : XSEGLEN -#endif -! -USE MODD_LUNIT_n, ONLY: TLUOUT -USE MODD_CST, ONLY : XP00, XCPD, XRD, XRV,XRHOLW, XDAY, XPI, XLVTT, XMD, XAVOGADRO -USE MODD_PARAMETERS, ONLY : JPVEXT, XUNDEF -USE MODD_DYN_n, ONLY : XTSTEP -USE MODD_CH_MNHC_n, ONLY : LUSECHEM -USE MODD_CH_M9_n, ONLY : CNAMES -USE MODD_FIELD_n, ONLY : XUT, XVT, XWT, XTHT, XRT, XPABST, XSVT, XTKET, XZWS -USE MODD_METRICS_n, ONLY : XDXX, XDYY, XDZZ -USE MODD_DIM_n, ONLY : NKMAX -USE MODD_GRID_n, ONLY : XLON, XZZ, XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, & - XCOSSLOPE, XSINSLOPE, XZS -USE MODD_REF_n, ONLY : XRHODREF,XRHODJ -USE MODD_CONF_n, ONLY : NRR -USE MODD_PARAM_n, ONLY : CDCONV,CCLOUD, CRAD -USE MODD_PRECIP_n, ONLY : XINPRC, XINPRR, XINPRS, XINPRG, XINPRH -USE MODD_DEEP_CONVECTION_n, ONLY : XPRCONV, XPRSCONV -USE MODD_CONF, ONLY : LCARTESIAN, CPROGRAM -USE MODD_TIME_n, ONLY : TDTCUR -USE MODD_RADIATIONS_n, ONLY : XFLALWD, XCCO2, XTSIDER, & - XSW_BANDS, XDIRSRFSWD, XSCAFLASWD, & - XZENITH, XAZIM, XAER, XSWU, XLWU -USE MODD_NSV -USE MODD_GRID, ONLY : XLON0, XRPK, XBETA -USE MODD_PARAM_ICE, ONLY : LSEDIC -USE MODD_PARAM_C2R2, ONLY : LSEDC -USE MODD_DIAG_IN_RUN -USE MODD_DUST, ONLY : LDUST -USE MODD_SALT, ONLY : LSALT -USE MODD_BLOWSNOW -USE MODD_BLOWSNOW_n -USE MODD_CH_AEROSOL, ONLY : LORILAM -USE MODD_CSTS_DUST, ONLY : XMOLARWEIGHT_DUST -USE MODD_CSTS_SALT, ONLY : XMOLARWEIGHT_SALT -USE MODD_CH_FLX_n, ONLY : XCHFLX -USE MODD_DIAG_FLAG, ONLY : LCHEMDIAG -! -USE MODI_NORMAL_INTERPOL -USE MODI_ROTATE_WIND -USE MODI_SHUMAN -USE MODI_MNHGET_SURF_PARAM_n -USE MODI_COUPLING_SURF_ATM_n -USE MODI_DIAG_SURF_ATM_n -USE MODD_MNH_SURFEX_n -! -USE MODE_DATETIME -USE MODE_ll -USE MODD_ARGSLIST_ll, ONLY : LIST_ll -#ifdef MNH_FOREFIRE -!** MODULES FOR FOREFIRE **! -USE MODD_FOREFIRE -USE MODD_FOREFIRE_n -USE MODI_COUPLING_FOREFIRE_n -#endif -! -USE MODD_TIME_n -USE MODD_TIME -! -USE MODD_PARAM_LIMA, ONLY : MSEDC=>LSEDC -! -IMPLICIT NONE -! -! -! -!* 0.1 declarations of arguments -! -!* surface fluxes -! -------------- -! -REAL, DIMENSION(:,:), INTENT(OUT) :: PSFTH ! surface flux of potential temperature (Km/s) -REAL, DIMENSION(:,:), INTENT(OUT) :: PSFRV ! surface flux of water vapor (m/s*kg/kg) -REAL, DIMENSION(:,:,:),INTENT(OUT):: PSFSV ! surface flux of scalar (m/s*kg/kg) - ! flux of chemical var. (ppp.m/s) -REAL, DIMENSION(:,:), INTENT(OUT) :: PSFCO2! surface flux of CO2 (m/s*kg/kg) -REAL, DIMENSION(:,:), INTENT(OUT) :: PSFU ! surface fluxes of horizontal -REAL, DIMENSION(:,:), INTENT(OUT) :: PSFV ! momentum in x and y directions (m2/s2) -! -!* Radiative parameters -! -------------------- -! -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDIR_ALB ! direct albedo for each spectral band (-) -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSCA_ALB ! diffuse albedo for each spectral band (-) -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEMIS ! surface emissivity (-) -REAL, DIMENSION(:,:), INTENT(OUT) :: PTSRAD ! surface radiative temperature (K) -! -! -!------------------------------------------------------------------------------- -! -! -! -!* 0.2 declarations of local variables -! ------------------------------- -! -! -!* Atmospheric variables -! --------------------- -! -REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRV ! vapor mixing ratio -! -! suffix 'A' stands for atmospheric variable at first model level -! -REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZZREF ! Forcing height -REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZTA ! Temperature -REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZRVA ! vapor mixing ratio -REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZQA ! humidity (kg/m3) -REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZPA ! Pressure -REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZPS ! Pressure -REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZEXNA ! Exner function -REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZEXNS ! Exner function -REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZTHA ! potential temperature -REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZRAIN ! liquid precipitation (kg/m2/s) -REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSNOW ! solid precipitation (kg/m2/s) -REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZTSUN ! solar time (s since midnight) -! -REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZUA ! u component of the wind -! ! parallel to the orography -REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZVA ! v component of the wind -! ! parallel to the orography -REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZU ! zonal wind -REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZV ! meridian wind -REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZWIND ! wind parallel to the orography -REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZRHOA ! air density -REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZDIR ! wind direction (rad from N clockwise) -REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFU ! zonal momentum flux -REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFV ! meridian momentum flux -REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZCO2 ! CO2 concentration (kg/kg) -REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZALFA ! angle between the wind -! ! and the x axis -REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2),1):: ZU2D ! u and v component of the -REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2),1):: ZV2D ! wind at mass point -REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTH ! Turbulent flux of heat -REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFTQ ! Turbulent flux of water -REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2)) :: ZSFCO2 ! Turbulent flux of CO2 -REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2),NSV):: ZSFTS! Turbulent flux of scalar -! -REAL, DIMENSION(SIZE(PSFTH,1),SIZE(PSFTH,2),NBLOWSNOW_2D) :: ZBLOWSNOW_2D ! 2D blowing snow variables - ! after advection - ! They refer to the 2D fields advected by MNH including: - ! - total number concentration in Canopy - ! - total mass concentration in Canopy - ! - equivalent concentration in the saltation layer -! -!* Dimensions -! ---------- -! -INTEGER :: IIB ! physical boundary -INTEGER :: IIE ! physical boundary -INTEGER :: IJB ! physical boundary -INTEGER :: IJE ! physical boundary -INTEGER :: IKB ! physical boundary -INTEGER :: IKE ! physical boundary -INTEGER :: IKU ! vertical array sizes -! -INTEGER :: JLAYER ! loop counter -INTEGER :: JSV ! loop counter -INTEGER :: JI,JJ,JK ! loop index -! -INTEGER :: IDIM1 ! X physical dimension -INTEGER :: IDIM2 ! Y physical dimension -INTEGER :: IDIM1D! total physical dimension -INTEGER :: IKRAD -! -INTEGER :: KSV_SURF ! Number of scalar variables sent to SURFEX -! -!* Arrays put in 1D vectors -! ------------------------ -! -REAL, DIMENSION(:), ALLOCATABLE :: ZP_TSUN ! solar time -REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZENITH ! zenithal angle -REAL, DIMENSION(:), ALLOCATABLE :: ZP_AZIM ! azimuthal angle -REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZREF ! forcing height -REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZS ! orography -REAL, DIMENSION(:), ALLOCATABLE :: ZP_U ! zonal wind -REAL, DIMENSION(:), ALLOCATABLE :: ZP_V ! meridian wind -REAL, DIMENSION(:), ALLOCATABLE :: ZP_QA ! air humidity (kg/m3) -REAL, DIMENSION(:), ALLOCATABLE :: ZP_TA ! air temperature -REAL, DIMENSION(:), ALLOCATABLE :: ZP_RHOA ! air density -REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_SV ! scalar at first atmospheric level -REAL, DIMENSION(:), ALLOCATABLE :: ZP_CO2 ! air CO2 concentration -REAL, DIMENSION(:), ALLOCATABLE :: ZP_RAIN ! liquid precipitation -REAL, DIMENSION(:), ALLOCATABLE :: ZP_SNOW ! solid precipitation -REAL, DIMENSION(:), ALLOCATABLE :: ZP_LW ! incoming longwave -REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_DIR_SW ! direct incoming shortwave -REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_SCA_SW ! diffuse incoming shortwave -REAL, DIMENSION(:), ALLOCATABLE :: ZP_PS ! surface pressure -REAL, DIMENSION(:), ALLOCATABLE :: ZP_PA ! pressure at first atmospheric level -REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZWS ! significant wave height (m) - -REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTQ ! water vapor flux -REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFTH ! potential temperature flux -REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_SFTS ! scalar flux -REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFCO2 ! CO2 flux -REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFU ! zonal momentum flux -REAL, DIMENSION(:), ALLOCATABLE :: ZP_SFV ! meridian momentum flux -REAL, DIMENSION(:), ALLOCATABLE :: ZP_TSRAD ! radiative surface temperature -REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_DIR_ALB ! direct albedo -REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_SCA_ALB ! diffuse albedo -REAL, DIMENSION(:), ALLOCATABLE :: ZP_EMIS ! emissivity - -REAL, DIMENSION(:), ALLOCATABLE :: ZP_TSURF -REAL, DIMENSION(:), ALLOCATABLE :: ZP_Z0 -REAL, DIMENSION(:), ALLOCATABLE :: ZP_Z0H -REAL, DIMENSION(:), ALLOCATABLE :: ZP_QSURF - -REAL, DIMENSION(:), ALLOCATABLE :: ZP_PEW_A_COEF ! coefficients for -REAL, DIMENSION(:), ALLOCATABLE :: ZP_PEW_B_COEF ! implicit coupling -REAL, DIMENSION(:), ALLOCATABLE :: ZP_PET_A_COEF -REAL, DIMENSION(:), ALLOCATABLE :: ZP_PEQ_A_COEF -REAL, DIMENSION(:), ALLOCATABLE :: ZP_PET_B_COEF -REAL, DIMENSION(:), ALLOCATABLE :: ZP_PEQ_B_COEF -REAL, DIMENSION(:), ALLOCATABLE :: ZP_RN ! net radiation (W/m2) -REAL, DIMENSION(:), ALLOCATABLE :: ZP_H ! sensible heat flux (W/m2) -REAL, DIMENSION(:), ALLOCATABLE :: ZP_LE ! latent heat flux (W/m2) -REAL, DIMENSION(:), ALLOCATABLE :: ZP_GFLUX ! ground flux (W/m2) -REAL, DIMENSION(:), ALLOCATABLE :: ZP_T2M ! Air temperature at 2 meters (K) -REAL, DIMENSION(:), ALLOCATABLE :: ZP_Q2M ! Air humidity at 2 meters (kg/kg) -REAL, DIMENSION(:), ALLOCATABLE :: ZP_HU2M ! Air relative humidity at 2 meters (-) -REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZON10M ! zonal Wind at 10 meters (m/s) -REAL, DIMENSION(:), ALLOCATABLE :: ZP_MER10M ! meridian Wind at 10 meters (m/s) -TYPE(LIST_ll), POINTER :: TZFIELDSURF_ll ! list of fields to exchange -INTEGER :: IINFO_ll ! return code of parallel routine -! -! -CHARACTER(LEN=6), DIMENSION(:), ALLOCATABLE :: YSV_SURF ! name of the scalar variables - ! sent to SURFEX -! -REAL :: ZTIMEC -INTEGER :: ILUOUT ! logical unit -! -!------------------------------------------------------------------------------- -! -! -ILUOUT=TLUOUT%NLU -IKB= 1+JPVEXT -IKU=NKMAX + 2* JPVEXT -IKE=IKU-JPVEXT -! -CALL GET_INDICE_ll (IIB,IJB,IIE,IJE) -! -PSFTH = XUNDEF -PSFRV = XUNDEF -PSFSV = XUNDEF -PSFCO2 = XUNDEF -PSFU = XUNDEF -PSFV = XUNDEF -PDIR_ALB = XUNDEF -PSCA_ALB = XUNDEF -PEMIS = XUNDEF -PTSRAD = XUNDEF -! -! -!------------------------------------------------------------------------------- -! -!* 1. CONVERSION OF THE ATMOSPHERIC VARIABLES -! --------------------------------------- -! -! 1.1 water vapor -! ----------- - -! -ALLOCATE(ZRV(SIZE(PSFTH,1),SIZE(PSFTH,2),IKU)) -! -IF(NRR>0) THEN - ZRV(:,:,:)=XRT(:,:,:,1) -ELSE - ZRV(:,:,:)=0. -END IF -! -! 1.2 Horizontal wind direction (rad from N clockwise) -! ------------------------- -! -ZU2D(:,:,:)=MXF(XUT(:,:,IKB:IKB)) -ZV2D(:,:,:)=MYF(XVT(:,:,IKB:IKB)) -! -!* angle between Y axis and wind (rad., clockwise) -! -ZALFA = 0. -WHERE(ZU2D(:,:,1)/=0. .OR. ZV2D(:,:,1)/=0.) - ZALFA(:,:)=ATAN2(ZU2D(:,:,1),ZV2D(:,:,1)) -END WHERE -WHERE(ZALFA(:,:)<0.) ZALFA(:,:) = ZALFA(:,:) + 2. * XPI -! -!* angle between North and wind (rad., clockwise) -! -IF (.NOT. LCARTESIAN) THEN - ZDIR = ( (XRPK*(XLON(:,:)-XLON0)) - XBETA ) * XPI/180. + ZALFA -ELSE - ZDIR = - XBETA * XPI/180. + ZALFA -END IF -! -! -! 1.3 Rotate the wind -! --------------- -! -CALL ROTATE_WIND(XUT,XVT,XWT, & - XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, & - XCOSSLOPE,XSINSLOPE, & - XDXX,XDYY,XDZZ, & - ZUA,ZVA ) - -! -! 1.4 zonal and meridian components of the wind parallel to the slope -! --------------------------------------------------------------- -! -ZWIND(:,:) = SQRT( ZUA**2 + ZVA**2 ) -! -ZU(:,:) = ZWIND(:,:) * SIN(ZDIR) -ZV(:,:) = ZWIND(:,:) * COS(ZDIR) -! -! 1.5 Horizontal interpolation the thermodynamic fields -! ------------------------------------------------- -! -CALL NORMAL_INTERPOL(XTHT,ZRV,XPABST, & - XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, & - XCOSSLOPE,XSINSLOPE, & - XDXX,XDYY,XDZZ, & - ZTHA,ZRVA,ZEXNA ) -! -DEALLOCATE(ZRV) -! -! -! 1.6 Pressure and Exner function -! --------------------------- -! -! -ZPA(:,:) = XP00 * ZEXNA(:,:) **(XCPD/XRD) -! -ZEXNS(:,:) = 0.5 * ( (XPABST(:,:,IKB-1)/XP00)**(XRD/XCPD) & - +(XPABST(:,:,IKB )/XP00)**(XRD/XCPD) & - ) -ZPS(:,:) = XP00 * ZEXNS(:,:) **(XCPD/XRD) -! -! 1.7 humidity in kg/m3 from the mixing ratio -! --------------------------------------- -! -! -ZQA(:,:) = ZRVA(:,:) * XRHODREF(:,:,IKB) -! -! -! 1.8 Temperature from the potential temperature -! ------------------------------------------ -! -! -ZTA(:,:) = ZTHA(:,:) * ZEXNA(:,:) -! -! -! 1.9 Air density -! ----------- -! -ZRHOA(:,:) = ZPA(:,:)/(XRD * ZTA(:,:) * ((1. + (XRD/XRV)*ZRVA(:,:))/ & - (1. + ZRVA(:,:)))) -! -! -! 1.10 Precipitations -! -------------- -! -ZRAIN=0. -ZSNOW=0. -IF (NRR>2 .AND. SIZE(XINPRR)>0 ) THEN - IF (( CCLOUD(1:3) == 'ICE' .AND. LSEDIC) .OR. & - ((CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO') .AND. LSEDC) .OR. & - ( CCLOUD=='LIMA' .AND. MSEDC)) THEN - ZRAIN = ZRAIN + XINPRR * XRHOLW + XINPRC * XRHOLW - ELSE - ZRAIN = ZRAIN + XINPRR * XRHOLW - END IF -END IF -IF (CDCONV == 'KAFR') THEN - ZRAIN = ZRAIN + (XPRCONV - XPRSCONV) * XRHOLW - ZSNOW = ZSNOW + XPRSCONV * XRHOLW -END IF -IF( NRR >= 5 .AND. SIZE(XINPRS)>0 ) ZSNOW = ZSNOW + XINPRS * XRHOLW -IF( NRR >= 6 .AND. SIZE(XINPRG)>0 ) ZSNOW = ZSNOW + XINPRG * XRHOLW -IF( NRR >= 7 .AND. SIZE(XINPRH)>0 ) ZSNOW = ZSNOW + XINPRH * XRHOLW -! -! -! 1.11 Solar time -! ---------- -! -IF (.NOT. LCARTESIAN) THEN - ZTSUN(:,:) = MOD(TDTCUR%xtime -XTSIDER*3600. +XLON(:,:)*240., XDAY) -ELSE - ZTSUN(:,:) = MOD(TDTCUR%xtime -XTSIDER*3600. +XLON0 *240., XDAY) -END IF -! -! 1.12 Forcing level -! ------------- -! -ZZREF(:,:) = 0.5*( XZZ(:,:,IKB+1)-XZZ(:,:,IKB) )*XDIRCOSZW(:,:) -! -! -! 1.13 CO2 concentration (kg/m3) -! ----------------- -! -ZCO2(:,:) = XCCO2 * XRHODREF(:,:,IKB) -! -! -! -! 1.14 Blowing snow scheme (optional) -! ----------------- -! -ZBLOWSNOW_2D=0. - -IF(LBLOWSNOW) THEN - KSV_SURF = NSV+NBLOWSNOW_2D ! When blowing snow scheme is used - ! NBLOWSN0W_2D variables are sent to SURFEX through ZP_SV. - ! They refer to the 2D fields advected by MNH including: - ! - total number concentration in Canopy - ! - total mass concentration in Canopy - ! - equivalent concentration in the saltation layer - ! Initialize array of scalar to be sent to SURFEX including 2D blowing snow fields - ALLOCATE(YSV_SURF(KSV_SURF)) - YSV_SURF(1:NSV) = CSV(:) - YSV_SURF(NSV+1:KSV_SURF) = YPBLOWSNOW_2D(:) - - - DO JSV=1,NBLOWSNOW_2D - ZBLOWSNOW_2D(:,:,JSV) = XRSNWCANOS(:,:,JSV)*XTSTEP/XRHODJ(:,:,IKB) - END DO - -ELSE - KSV_SURF = NSV - ALLOCATE(YSV_SURF(KSV_SURF)) - YSV_SURF(:) = CSV(:) -ENDIF -! -!------------------------------------------------------------------------------- -! -!* 2. Call to surface monitor with 2D variables -! ----------------------------------------- -! -! -! initial values: -! -IDIM1 = IIE-IIB+1 -IDIM2 = IJE-IJB+1 -IDIM1D = IDIM1*IDIM2 -! -! -! Transform 2D input fields into 1D: -! -CALL RESHAPE_SURF(IDIM1D) -! -! call to have the cumulated time since beginning of simulation -! -CALL DATETIME_DISTANCE(TDTSEG,TDTCUR,ZTIMEC) - -#ifdef CPLOASIS -IF (LOASIS) THEN - IF ( MOD(ZTIMEC,1.0) .LE. 1E-2 .OR. (1.0 - MOD(ZTIMEC,1.0)) .LE. 1E-2 ) THEN - IF ( NINT(ZTIMEC-(XSEGLEN-XTSTEP)) .LT. 0 ) THEN - WRITE(ILUOUT,*) '----------------------------' - WRITE(ILUOUT,*) ' Reception des champs avec OASIS' - WRITE(ILUOUT,*) 'NINT(ZTIMEC)=', NINT(ZTIMEC) - CALL MNH_OASIS_RECV(CPROGRAM,IDIM1D,SIZE(XSW_BANDS),ZTIMEC+XTSTEP,XTSTEP, & - ZP_ZENITH,XSW_BANDS , & - ZP_TSRAD,ZP_DIR_ALB,ZP_SCA_ALB,ZP_EMIS,ZP_TSURF) - WRITE(ILUOUT,*) '----------------------------' - END IF - END IF -END IF -#endif -! -! Call to surface schemes -! - -CALL COUPLING_SURF_ATM_n(YSURF_CUR,'MESONH', 'E',ZTIMEC, & - XTSTEP, TDTCUR%nyear, TDTCUR%nmonth, TDTCUR%nday, TDTCUR%xtime, & - IDIM1D,KSV_SURF,SIZE(XSW_BANDS), & - ZP_TSUN, ZP_ZENITH,ZP_ZENITH, ZP_AZIM, & - ZP_ZREF, ZP_ZREF, ZP_ZS, ZP_U, ZP_V, ZP_QA, ZP_TA, ZP_RHOA, ZP_SV, ZP_CO2, YSV_SURF, & - ZP_RAIN, ZP_SNOW, ZP_LW, ZP_DIR_SW, ZP_SCA_SW, XSW_BANDS, ZP_PS, ZP_PA, & - ZP_SFTQ, ZP_SFTH, ZP_SFTS, ZP_SFCO2, ZP_SFU, ZP_SFV, & - ZP_TSRAD, ZP_DIR_ALB, ZP_SCA_ALB, ZP_EMIS, ZP_TSURF, ZP_Z0, ZP_Z0H, ZP_QSURF, & - ZP_PEW_A_COEF, ZP_PEW_B_COEF, & - ZP_PET_A_COEF, ZP_PEQ_A_COEF, ZP_PET_B_COEF, ZP_PEQ_B_COEF,ZP_ZWS, & - 'OK' ) -! -#ifdef CPLOASIS -IF (LOASIS) THEN - IF ( MOD(ZTIMEC,1.0) .LE. 1E-2 .OR. (1.0 - MOD(ZTIMEC,1.0)) .LE. 1E-2 ) THEN - IF (NINT(ZTIMEC-(XSEGLEN-XTSTEP)) .LT. 0) THEN - WRITE(ILUOUT,*) '----------------------------' - WRITE(ILUOUT,*) ' Envoi des champs avec OASIS' - WRITE(ILUOUT,*) 'NINT(ZTIMEC)=', NINT(ZTIMEC) - CALL MNH_OASIS_SEND(CPROGRAM,IDIM1D,ZTIMEC+XTSTEP,XTSTEP) - WRITE(ILUOUT,*) '----------------------------' - END IF - END IF -END IF -#endif -! -IF (CPROGRAM=='DIAG ' .OR. LDIAG_IN_RUN) THEN - CALL DIAG_SURF_ATM_n(YSURF_CUR,'MESONH') - CALL MNHGET_SURF_PARAM_n(PRN=ZP_RN,PH=ZP_H,PLE=ZP_LE,PGFLUX=ZP_GFLUX, & - PT2M=ZP_T2M,PQ2M=ZP_Q2M,PHU2M=ZP_HU2M, & - PZON10M=ZP_ZON10M,PMER10M=ZP_MER10M ) -END IF -! -! Transform 1D output fields into 2D: -! -CALL UNSHAPE_SURF(IDIM1,IDIM2) -#ifdef MNH_FOREFIRE -!------------------------! -! COUPLING WITH FOREFIRE ! -!------------------------! - -IF ( LFOREFIRE ) THEN - CALL FOREFIRE_DUMP_FIELDS_n(XUT, XVT, XWT, XSVT& - , XTHT, XRT(:,:,:,1), XPABST, XTKET& - , IDIM1+2, IDIM2+2, NKMAX+2) -END IF - -IF ( FFCOUPLING ) THEN - - CALL SEND_GROUND_WIND_n(XUT, XVT, IKB, IINFO_ll) - - CALL FOREFIRE_RECEIVE_PARAL_n() - - CALL COUPLING_FOREFIRE_n(XTSTEP, ZSFTH, ZSFTQ, ZSFTS) - - CALL FOREFIRE_SEND_PARAL_n(IINFO_ll) - -END IF - -FF_TIME = FF_TIME + XTSTEP -#endif -! -! Friction of components along slope axes (U: largest local slope axis, V: zero slope axis) -! -! -PSFU(:,:) = 0. -PSFV(:,:) = 0. -! -WHERE (ZSFU(:,:)/=XUNDEF .AND. ZWIND(:,:)>0.) - PSFU(:,:) = - SQRT(ZSFU**2+ZSFV**2) * ZUA(:,:) / ZWIND(:,:) / XRHODREF(:,:,IKB) - PSFV(:,:) = - SQRT(ZSFU**2+ZSFV**2) * ZVA(:,:) / ZWIND(:,:) / XRHODREF(:,:,IKB) -END WHERE -! -!* conversion from H (W/m2) to w'Theta' -! -PSFTH(:,:) = ZSFTH(:,:) / XCPD / XRHODREF(:,:,IKB) -! -! -!* conversion from water flux (kg/m2/s) to w'rv' -! -PSFRV(:,:) = ZSFTQ(:,:) / XRHODREF(:,:,IKB) -! -! -!* conversion from scalar flux (kg/m2/s) to w'rsv' -! -IF(NSV .GT. 0) THEN - DO JSV=1,NSV - PSFSV(:,:,JSV) = ZSFTS(:,:,JSV) / XRHODREF(:,:,IKB) - END DO -END IF -! -!* conversion from chemistry flux (molec/m2/s) to (ppp.m.s-1) -! -IF (LUSECHEM) THEN - DO JSV=NSV_CHEMBEG,NSV_CHEMEND - PSFSV(:,:,JSV) = ZSFTS(:,:,JSV) * XMD / ( XAVOGADRO * XRHODREF(:,:,IKB)) - IF ((LCHEMDIAG).AND.(CPROGRAM == 'DIAG ')) XCHFLX(:,:,JSV-NSV_CHEMBEG+1) = PSFSV(:,:,JSV) - END DO -ELSE - PSFSV(:,:,NSV_CHEMBEG:NSV_CHEMEND) = 0. -END IF -! -!* conversion from dust flux (kg/m2/s) to (ppp.m.s-1) -! -IF (LDUST) THEN - DO JSV=NSV_DSTBEG,NSV_DSTEND - PSFSV(:,:,JSV) = ZSFTS(:,:,JSV) * XMD / (XMOLARWEIGHT_DUST * XRHODREF(:,:,IKB)) - END DO -ELSE - PSFSV(:,:,NSV_DSTBEG:NSV_DSTEND) = 0. -END IF -! -!* conversion from sea salt flux (kg/m2/s) to (ppp.m.s-1) -! -IF (LSALT) THEN - DO JSV=NSV_SLTBEG,NSV_SLTEND - PSFSV(:,:,JSV) = ZSFTS(:,:,JSV) * XMD / (XMOLARWEIGHT_SALT * XRHODREF(:,:,IKB)) - END DO -ELSE - PSFSV(:,:,NSV_SLTBEG:NSV_SLTEND) = 0. -END IF -! -!* conversion from aerosol flux (molec/m2/s) to (ppp.m.s-1) -! -IF (LORILAM) THEN - DO JSV=NSV_AERBEG,NSV_AEREND - PSFSV(:,:,JSV) = ZSFTS(:,:,JSV) * XMD / ( XAVOGADRO * XRHODREF(:,:,IKB)) - END DO -ELSE - PSFSV(:,:,NSV_AERBEG:NSV_AEREND) = 0. -END IF -! -!* conversion from blowing snow flux (kg/m2/s) to [kg(snow)/kg(dry air).m.s-1] -! -IF (LBLOWSNOW) THEN - DO JSV=NSV_SNWBEG,NSV_SNWEND - PSFSV(:,:,JSV) = ZSFTS(:,:,JSV)/ (ZRHOA(:,:)) - END DO - !* Update tendency for blowing snow 2D fields - DO JSV=1,(NBLOWSNOW_2D) - XRSNWCANOS(:,:,JSV) = ZBLOWSNOW_2D(:,:,JSV)*XRHODJ(:,:,IKB)/(XTSTEP*ZRHOA(:,:)) - END DO - -ELSE - PSFSV(:,:,NSV_SNWBEG:NSV_SNWEND) = 0. -END IF -! -!* conversion from CO2 flux (kg/m2/s) to w'CO2' -! -PSFCO2(:,:) = ZSFCO2(:,:) / XRHODREF(:,:,IKB) -! -! -!* Diagnostics -! ----------- -! -! -IF (LDIAG_IN_RUN) THEN - ! - XCURRENT_SFCO2(:,:) = ZSFCO2(:,:) - XCURRENT_DSTAOD(:,:)=0.0 - XCURRENT_SLTAOD(:,:)=0.0 - IF (CRAD=='ECMW') THEN - XCURRENT_LWD (:,:) = XFLALWD(:,:) - XCURRENT_SWD (:,:) = SUM(XDIRSRFSWD(:,:,:)+XSCAFLASWD(:,:,:),DIM=3) - XCURRENT_LWU (:,:) = XLWU(:,:,IKB) - XCURRENT_SWU (:,:) = XSWU(:,:,IKB) - XCURRENT_SWDIR(:,:) = SUM(XDIRSRFSWD,DIM=3) - XCURRENT_SWDIFF(:,:) = SUM(XSCAFLASWD(:,:,:),DIM=3) - DO JK=IKB,IKE - IKRAD = JK - 1 - DO JJ=IJB,IJE - DO JI=IIB,IIE - XCURRENT_DSTAOD(JI,JJ)=XCURRENT_DSTAOD(JI,JJ)+XAER(JI,JJ,IKRAD,3) - XCURRENT_SLTAOD(JI,JJ)=XCURRENT_SLTAOD(JI,JJ)+XAER(JI,JJ,IKRAD,2) - ENDDO - ENDDO - ENDDO - END IF -! - NULLIFY(TZFIELDSURF_ll) - CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_RN, 'GROUND_PARAM_n::XCURRENT_RN' ) - CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_H, 'GROUND_PARAM_n::XCURRENT_H' ) - CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_LE, 'GROUND_PARAM_n::XCURRENT_LE' ) - CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_GFLUX, 'GROUND_PARAM_n::XCURRENT_GFLUX' ) - CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SWD, 'GROUND_PARAM_n::XCURRENT_SWD' ) - CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SWU, 'GROUND_PARAM_n::XCURRENT_SWU' ) - CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_LWD, 'GROUND_PARAM_n::XCURRENT_LWD' ) - CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_LWU, 'GROUND_PARAM_n::XCURRENT_LWU' ) - CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_T2M, 'GROUND_PARAM_n::XCURRENT_T2M' ) - CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_Q2M, 'GROUND_PARAM_n::XCURRENT_Q2M' ) - CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_HU2M, 'GROUND_PARAM_n::XCURRENT_HU2M' ) - CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_ZON10M, 'GROUND_PARAM_n::XCURRENT_ZON10M' ) - CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_MER10M, 'GROUND_PARAM_n::XCURRENT_MER10M' ) - CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_DSTAOD, 'GROUND_PARAM_n::XCURRENT_DSTAOD' ) - CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SLTAOD, 'GROUND_PARAM_n::XCURRENT_SLTAOD' ) - CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_ZWS, 'GROUND_PARAM_n::XCURRENT_ZWS' ) - CALL ADD2DFIELD_ll( TZFIELDSURF_ll,XCURRENT_SFCO2, 'GROUND_PARAM_n::XCURRENT_SFCO2' ) - - CALL UPDATE_HALO_ll(TZFIELDSURF_ll,IINFO_ll) - CALL CLEANLIST_ll(TZFIELDSURF_ll) -END IF -! -!================================================================================== -! -CONTAINS -! -!================================================================================== -! -SUBROUTINE RESHAPE_SURF(KDIM1D) -! -INTEGER, INTENT(IN) :: KDIM1D -INTEGER, DIMENSION(1) :: ISHAPE_1 -! -ISHAPE_1 = (/KDIM1D/) -! -ALLOCATE(ZP_TSUN (KDIM1D)) -ALLOCATE(ZP_ZENITH (KDIM1D)) -ALLOCATE(ZP_AZIM (KDIM1D)) -ALLOCATE(ZP_ZREF (KDIM1D)) -ALLOCATE(ZP_ZS (KDIM1D)) -ALLOCATE(ZP_U (KDIM1D)) -ALLOCATE(ZP_V (KDIM1D)) -ALLOCATE(ZP_QA (KDIM1D)) -ALLOCATE(ZP_TA (KDIM1D)) -ALLOCATE(ZP_RHOA (KDIM1D)) -ALLOCATE(ZP_SV (KDIM1D,KSV_SURF)) -ALLOCATE(ZP_CO2 (KDIM1D)) -ALLOCATE(ZP_RAIN (KDIM1D)) -ALLOCATE(ZP_SNOW (KDIM1D)) -ALLOCATE(ZP_LW (KDIM1D)) -ALLOCATE(ZP_DIR_SW (KDIM1D,SIZE(XDIRSRFSWD,3))) -ALLOCATE(ZP_SCA_SW (KDIM1D,SIZE(XSCAFLASWD,3))) -ALLOCATE(ZP_PS (KDIM1D)) -ALLOCATE(ZP_PA (KDIM1D)) -ALLOCATE(ZP_ZWS (KDIM1D)) - -ALLOCATE(ZP_SFTQ (KDIM1D)) -ALLOCATE(ZP_SFTH (KDIM1D)) -ALLOCATE(ZP_SFU (KDIM1D)) -ALLOCATE(ZP_SFV (KDIM1D)) -ALLOCATE(ZP_SFTS (KDIM1D,KSV_SURF)) -ALLOCATE(ZP_SFCO2 (KDIM1D)) -ALLOCATE(ZP_TSRAD (KDIM1D)) -ALLOCATE(ZP_DIR_ALB (KDIM1D,SIZE(PDIR_ALB,3))) -ALLOCATE(ZP_SCA_ALB (KDIM1D,SIZE(PSCA_ALB,3))) -ALLOCATE(ZP_EMIS (KDIM1D)) -ALLOCATE(ZP_TSURF (KDIM1D)) -ALLOCATE(ZP_Z0 (KDIM1D)) -ALLOCATE(ZP_Z0H (KDIM1D)) -ALLOCATE(ZP_QSURF (KDIM1D)) -ALLOCATE(ZP_RN (KDIM1D)) -ALLOCATE(ZP_H (KDIM1D)) -ALLOCATE(ZP_LE (KDIM1D)) -ALLOCATE(ZP_GFLUX (KDIM1D)) -ALLOCATE(ZP_T2M (KDIM1D)) -ALLOCATE(ZP_Q2M (KDIM1D)) -ALLOCATE(ZP_HU2M (KDIM1D)) -ALLOCATE(ZP_ZON10M (KDIM1D)) -ALLOCATE(ZP_MER10M (KDIM1D)) - -!* explicit coupling only -ALLOCATE(ZP_PEW_A_COEF (KDIM1D)) -ALLOCATE(ZP_PEW_B_COEF (KDIM1D)) -ALLOCATE(ZP_PET_A_COEF (KDIM1D)) -ALLOCATE(ZP_PEQ_A_COEF (KDIM1D)) -ALLOCATE(ZP_PET_B_COEF (KDIM1D)) -ALLOCATE(ZP_PEQ_B_COEF (KDIM1D)) - -ZP_TSUN(:) = RESHAPE(ZTSUN(IIB:IIE,IJB:IJE), ISHAPE_1) -ZP_TA(:) = RESHAPE(ZTA(IIB:IIE,IJB:IJE), ISHAPE_1) -ZP_QA(:) = RESHAPE(ZQA(IIB:IIE,IJB:IJE), ISHAPE_1) -ZP_RHOA(:) = RESHAPE(ZRHOA(IIB:IIE,IJB:IJE), ISHAPE_1) -ZP_U(:) = RESHAPE(ZU(IIB:IIE,IJB:IJE), ISHAPE_1) -ZP_V(:) = RESHAPE(ZV(IIB:IIE,IJB:IJE), ISHAPE_1) -ZP_PS(:) = RESHAPE(ZPS(IIB:IIE,IJB:IJE), ISHAPE_1) -ZP_PA(:) = RESHAPE(ZPA(IIB:IIE,IJB:IJE), ISHAPE_1) -ZP_ZS(:) = RESHAPE(XZS(IIB:IIE,IJB:IJE), ISHAPE_1) -ZP_CO2(:) = RESHAPE(ZCO2(IIB:IIE,IJB:IJE), ISHAPE_1) -ZP_SNOW(:) = RESHAPE(ZSNOW(IIB:IIE,IJB:IJE), ISHAPE_1) -ZP_RAIN(:) = RESHAPE(ZRAIN(IIB:IIE,IJB:IJE), ISHAPE_1) -ZP_ZREF(:) = RESHAPE(ZZREF(IIB:IIE,IJB:IJE), ISHAPE_1) -ZP_ZWS(:) = RESHAPE(XZWS(IIB:IIE,IJB:IJE), ISHAPE_1) - -DO JLAYER=1,NSV - ZP_SV(:,JLAYER) = RESHAPE(XSVT(IIB:IIE,IJB:IJE,IKB,JLAYER), ISHAPE_1) -END DO -! -IF(LBLOWSNOW) THEN - DO JLAYER=1,NBLOWSNOW_2D - ZP_SV(:,NSV+JLAYER) = RESHAPE(ZBLOWSNOW_2D(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1) - END DO -END IF -! -!chemical conversion : from part/part to molec./m3 -DO JLAYER=NSV_CHEMBEG,NSV_CHEMEND - ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * XAVOGADRO * ZP_RHOA(:) / XMD -END DO -DO JLAYER=NSV_AERBEG,NSV_AEREND - ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * XAVOGADRO * ZP_RHOA(:) / XMD -END DO -!dust conversion : from part/part to kg/m3 -DO JLAYER=NSV_DSTBEG,NSV_DSTEND - ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * XMOLARWEIGHT_DUST* ZP_RHOA(:) / XMD -END DO -!sea salt conversion : from part/part to kg/m3 -DO JLAYER=NSV_SLTBEG,NSV_SLTEND - ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * XMOLARWEIGHT_SALT* ZP_RHOA(:) / XMD -END DO -! -!blowing snow conversion : from kg(snow)/kg(dry air) to kg(snow)/m3 -DO JLAYER=NSV_SNWBEG,NSV_SNWEND - ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * ZP_RHOA(:) -END DO - -IF(LBLOWSNOW) THEN ! Convert 2D blowing snow fields - ! from kg(snow)/kg(dry air) to kg(snow)/m3 - DO JLAYER=(NSV+1),KSV_SURF - ZP_SV(:,JLAYER) = ZP_SV(:,JLAYER) * ZP_RHOA(:) - END DO -END IF -! -ZP_ZENITH(:) = RESHAPE(XZENITH(IIB:IIE,IJB:IJE), ISHAPE_1) -ZP_AZIM (:) = RESHAPE(XAZIM (IIB:IIE,IJB:IJE), ISHAPE_1) -ZP_LW(:) = RESHAPE(XFLALWD(IIB:IIE,IJB:IJE), ISHAPE_1) -DO JLAYER=1,SIZE(XDIRSRFSWD,3) - ZP_DIR_SW(:,JLAYER) = RESHAPE(XDIRSRFSWD(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1) - ZP_SCA_SW(:,JLAYER) = RESHAPE(XSCAFLASWD(IIB:IIE,IJB:IJE,JLAYER), ISHAPE_1) -END DO -! -ZP_PEW_A_COEF = 0. -ZP_PEW_B_COEF = 0. -ZP_PET_A_COEF = 0. -ZP_PEQ_A_COEF = 0. -ZP_PET_B_COEF = 0. -ZP_PEQ_B_COEF = 0. -! -END SUBROUTINE RESHAPE_SURF -!================================================i================================= -SUBROUTINE UNSHAPE_SURF(KDIM1,KDIM2) -! -INTEGER, INTENT(IN) :: KDIM1, KDIM2 -INTEGER, DIMENSION(2) :: ISHAPE_2 -! -ISHAPE_2 = (/KDIM1,KDIM2/) -! -! Arguments in call to surface: -! -ZSFTH = XUNDEF -ZSFTQ = XUNDEF -IF (NSV>0) ZSFTS = XUNDEF -ZSFCO2 = XUNDEF -ZSFU = XUNDEF -ZSFV = XUNDEF -! -ZSFTH (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTH(:), ISHAPE_2) -ZSFTQ (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFTQ(:), ISHAPE_2) -DO JLAYER=1,SIZE(PSFSV,3) - ZSFTS (IIB:IIE,IJB:IJE,JLAYER) = RESHAPE(ZP_SFTS(:,JLAYER), ISHAPE_2) -END DO -ZSFCO2 (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFCO2(:), ISHAPE_2) -ZSFU (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFU(:), ISHAPE_2) -ZSFV (IIB:IIE,IJB:IJE) = RESHAPE(ZP_SFV(:), ISHAPE_2) -DO JLAYER=1,SIZE(PEMIS,3) - PEMIS (IIB:IIE,IJB:IJE,JLAYER) = RESHAPE(ZP_EMIS(:), ISHAPE_2) -END DO -PTSRAD (IIB:IIE,IJB:IJE) = RESHAPE(ZP_TSRAD(:), ISHAPE_2) -IF(LBLOWSNOW) THEN - DO JLAYER=1,NBLOWSNOW_2D - ZBLOWSNOW_2D(IIB:IIE,IJB:IJE,JLAYER) = RESHAPE(ZP_SFTS(:,NSV+JLAYER), ISHAPE_2) - END DO -END IF -! -IF (LDIAG_IN_RUN) THEN - XCURRENT_RN (IIB:IIE,IJB:IJE) = RESHAPE(ZP_RN(:), ISHAPE_2) - XCURRENT_H (IIB:IIE,IJB:IJE) = RESHAPE(ZP_H (:), ISHAPE_2) - XCURRENT_LE (IIB:IIE,IJB:IJE) = RESHAPE(ZP_LE(:), ISHAPE_2) - XCURRENT_GFLUX (IIB:IIE,IJB:IJE) = RESHAPE(ZP_GFLUX(:), ISHAPE_2) - XCURRENT_T2M (IIB:IIE,IJB:IJE) = RESHAPE(ZP_T2M(:), ISHAPE_2) - XCURRENT_Q2M (IIB:IIE,IJB:IJE) = RESHAPE(ZP_Q2M(:), ISHAPE_2) - XCURRENT_HU2M (IIB:IIE,IJB:IJE) = RESHAPE(ZP_HU2M(:), ISHAPE_2) - XCURRENT_ZON10M (IIB:IIE,IJB:IJE) = RESHAPE(ZP_ZON10M(:), ISHAPE_2) - XCURRENT_MER10M (IIB:IIE,IJB:IJE) = RESHAPE(ZP_MER10M(:), ISHAPE_2) - XCURRENT_ZWS (IIB:IIE,IJB:IJE) = RESHAPE(ZP_ZWS(:), ISHAPE_2) -ENDIF -! -DO JLAYER=1,SIZE(PDIR_ALB,3) - PDIR_ALB(IIB:IIE,IJB:IJE,JLAYER) = RESHAPE(ZP_DIR_ALB(:,JLAYER), ISHAPE_2) - PSCA_ALB(IIB:IIE,IJB:IJE,JLAYER) = RESHAPE(ZP_SCA_ALB(:,JLAYER), ISHAPE_2) -END DO -! -DEALLOCATE(ZP_TSUN ) -DEALLOCATE(ZP_ZENITH ) -DEALLOCATE(ZP_AZIM ) -DEALLOCATE(ZP_ZREF ) -DEALLOCATE(ZP_ZS ) -DEALLOCATE(ZP_U ) -DEALLOCATE(ZP_V ) -DEALLOCATE(ZP_QA ) -DEALLOCATE(ZP_TA ) -DEALLOCATE(ZP_RHOA ) -DEALLOCATE(ZP_SV ) -DEALLOCATE(ZP_CO2 ) -DEALLOCATE(ZP_RAIN ) -DEALLOCATE(ZP_SNOW ) -DEALLOCATE(ZP_LW ) -DEALLOCATE(ZP_DIR_SW ) -DEALLOCATE(ZP_SCA_SW ) -DEALLOCATE(ZP_PS ) -DEALLOCATE(ZP_PA ) -DEALLOCATE(ZP_ZWS ) - -DEALLOCATE(ZP_SFTQ ) -DEALLOCATE(ZP_SFTH ) -DEALLOCATE(ZP_SFTS ) -DEALLOCATE(ZP_SFCO2 ) -DEALLOCATE(ZP_SFU ) -DEALLOCATE(ZP_SFV ) -DEALLOCATE(ZP_TSRAD ) -DEALLOCATE(ZP_DIR_ALB ) -DEALLOCATE(ZP_SCA_ALB ) -DEALLOCATE(ZP_EMIS ) -DEALLOCATE(ZP_RN ) -DEALLOCATE(ZP_H ) -DEALLOCATE(ZP_LE ) -DEALLOCATE(ZP_GFLUX ) -DEALLOCATE(ZP_T2M ) -DEALLOCATE(ZP_Q2M ) -DEALLOCATE(ZP_HU2M ) -DEALLOCATE(ZP_ZON10M ) -DEALLOCATE(ZP_MER10M ) - -DEALLOCATE(ZP_PEW_A_COEF ) -DEALLOCATE(ZP_PEW_B_COEF ) -DEALLOCATE(ZP_PET_A_COEF ) -DEALLOCATE(ZP_PEQ_A_COEF ) -DEALLOCATE(ZP_PET_B_COEF ) -DEALLOCATE(ZP_PEQ_B_COEF ) -! -END SUBROUTINE UNSHAPE_SURF -!================================================================================== -! -END SUBROUTINE GROUND_PARAM_n diff --git a/src/ICCARE_BASE/ini_budget.f90 b/src/ICCARE_BASE/ini_budget.f90 deleted file mode 100644 index 20cdbb4a4..000000000 --- a/src/ICCARE_BASE/ini_budget.f90 +++ /dev/null @@ -1,4727 +0,0 @@ -!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!----------------------------------------------------------------- -! Modifications: -! P. Wautelet 17/08/2020: add Budget_preallocate subroutine -!----------------------------------------------------------------- -module mode_ini_budget - - use mode_msg - - implicit none - - private - - public :: Budget_preallocate, Ini_budget - - integer, parameter :: NSOURCESMAX = 60 !Maximum number of sources in a budget - -contains - -subroutine Budget_preallocate() - -use modd_budget, only: nbudgets, tbudgets, & - NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_TH, NBUDGET_TKE, & - NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, & - NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1 -use modd_nsv, only: csvnames, nsv - -integer :: ibudget -integer :: jsv - -call Print_msg( NVERB_DEBUG, 'BUD', 'Budget_preallocate', 'called' ) - -if ( allocated( tbudgets ) ) then - call Print_msg( NVERB_WARNING, 'BUD', 'Budget_preallocate', 'tbudgets already allocated' ) - return -end if - -nbudgets = NBUDGET_SV1 - 1 + nsv -allocate( tbudgets( nbudgets ) ) - -tbudgets(NBUDGET_U)%cname = "UU" -tbudgets(NBUDGET_U)%ccomment = "Budget for U" -tbudgets(NBUDGET_U)%nid = NBUDGET_U - -tbudgets(NBUDGET_V)%cname = "VV" -tbudgets(NBUDGET_V)%ccomment = "Budget for V" -tbudgets(NBUDGET_V)%nid = NBUDGET_V - -tbudgets(NBUDGET_W)%cname = "WW" -tbudgets(NBUDGET_W)%ccomment = "Budget for W" -tbudgets(NBUDGET_W)%nid = NBUDGET_W - -tbudgets(NBUDGET_TH)%cname = "TH" -tbudgets(NBUDGET_TH)%ccomment = "Budget for potential temperature" -tbudgets(NBUDGET_TH)%nid = NBUDGET_TH - -tbudgets(NBUDGET_TKE)%cname = "TK" -tbudgets(NBUDGET_TKE)%ccomment = "Budget for turbulent kinetic energy" -tbudgets(NBUDGET_TKE)%nid = NBUDGET_TKE - -tbudgets(NBUDGET_RV)%cname = "RV" -tbudgets(NBUDGET_RV)%ccomment = "Budget for water vapor mixing ratio" -tbudgets(NBUDGET_RV)%nid = NBUDGET_RV - -tbudgets(NBUDGET_RC)%cname = "RC" -tbudgets(NBUDGET_RC)%ccomment = "Budget for cloud water mixing ratio" -tbudgets(NBUDGET_RC)%nid = NBUDGET_RC - -tbudgets(NBUDGET_RR)%cname = "RR" -tbudgets(NBUDGET_RR)%ccomment = "Budget for rain water mixing ratio" -tbudgets(NBUDGET_RR)%nid = NBUDGET_RR - -tbudgets(NBUDGET_RI)%cname = "RI" -tbudgets(NBUDGET_RI)%ccomment = "Budget for cloud ice mixing ratio" -tbudgets(NBUDGET_RI)%nid = NBUDGET_RI - -tbudgets(NBUDGET_RS)%cname = "RS" -tbudgets(NBUDGET_RS)%ccomment = "Budget for snow/aggregate mixing ratio" -tbudgets(NBUDGET_RS)%nid = NBUDGET_RS - -tbudgets(NBUDGET_RG)%cname = "RG" -tbudgets(NBUDGET_RG)%ccomment = "Budget for graupel mixing ratio" -tbudgets(NBUDGET_RG)%nid = NBUDGET_RG - -tbudgets(NBUDGET_RH)%cname = "RH" -tbudgets(NBUDGET_RH)%ccomment = "Budget for hail mixing ratio" -tbudgets(NBUDGET_RH)%nid = NBUDGET_RH - -do jsv = 1, nsv - ibudget = NBUDGET_SV1 - 1 + jsv - tbudgets(ibudget)%cname = Trim( csvnames(jsv) ) - tbudgets(ibudget)%ccomment = 'Budget for scalar variable ' // Trim( csvnames(jsv) ) - tbudgets(ibudget)%nid = ibudget -end do - - -end subroutine Budget_preallocate - - -! ################################################################# - SUBROUTINE Ini_budget(KLUOUT,PTSTEP,KSV,KRR, & - ONUMDIFU,ONUMDIFTH,ONUMDIFSV, & - OHORELAX_UVWTH,OHORELAX_RV,OHORELAX_RC,OHORELAX_RR, & - OHORELAX_RI,OHORELAX_RS, OHORELAX_RG, OHORELAX_RH,OHORELAX_TKE, & - OHORELAX_SV, OVE_RELAX, ove_relax_grd, OCHTRANS, & - ONUDGING,ODRAGTREE,ODEPOTREE, OAERO_EOL, & - HRAD,HDCONV,HSCONV,HTURB,HTURBDIM,HCLOUD ) -! ################################################################# -! -!!**** *INI_BUDGET* - routine to initialize the parameters for the budgets -!! -!! PURPOSE -!! ------- -! The purpose of this routine is to set or compute the parameters used -! by the MESONH budgets. Names of files for budget recording are processed -! and storage arrays are initialized. -! -!!** METHOD -!! ------ -!! The essential of information is passed by modules. The choice of budgets -!! and processes set by the user as integers is converted in "actions" -!! readable by the subroutine BUDGET under the form of string characters. -!! For each complete process composed of several elementary processes, names -!! of elementary processes are concatenated in order to have an explicit name -!! in the comment of the recording file for budget. -!! -!! -!! EXTERNAL -!! -------- -!! None -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! Modules MODD_* -!! -!! REFERENCE -!! --------- -!! Book2 of documentation (routine INI_BUDGET) -!! -!! -!! AUTHOR -!! ------ -!! P. Hereil * Meteo France * -!! -!! MODIFICATIONS -!! ------------- -!! Original 01/03/95 -!! J. Stein 25/06/95 put the sources in phase with the code -!! J. Stein 20/07/95 reset to FALSE of all the switches when -!! CBUTYPE /= MASK or CART -!! J. Stein 26/06/96 add the new sources + add the increment between -!! 2 active processes -!! J.-P. Pinty 13/12/96 Allowance of multiple SVs -!! J.-P. Pinty 11/01/97 Includes deep convection ice and forcing processes -!! J.-P. Lafore 10/02/98 Allocation of the RHODJs for budget -!! V. Ducrocq 04/06/99 // -!! N. Asencio 18/06/99 // MASK case : delete KIMAX and KJMAX arguments, -!! GET_DIM_EXT_ll initializes the dimensions of the -!! extended local domain. -!! LBU_MASK and NBUSURF are allocated on the extended -!! local domain. -!! add 3 local variables IBUDIM1,IBUDIM2,IBUDIM3 -!! to define the dimensions of the budget arrays -!! in the different cases CART and MASK -!! J.-P. Pinty 23/09/00 add budget for C2R2 -!! V. Masson 18/11/02 add budget for 2way nesting -!! O.Geoffroy 03/2006 Add KHKO scheme -!! J.-P. Pinty 22/04/97 add the explicit hail processes -!! C.Lac 10/08/07 Add ADV for PPM without contribution -!! of each direction -!! C. Barthe 19/11/09 Add atmospheric electricity -!! C.Lac 01/07/11 Add vegetation drag -!! P. Peyrille, M. Tomasini : include in the forcing term the 2D forcing -!! terms in term 2DFRC search for modif PP . but Not very clean! -!! C .Lac 27/05/14 add negativity corrections for chemical species -!! C.Lac 29/01/15 Correction for NSV_USER -!! J.Escobar 02/10/2015 modif for JPHEXT(JPVEXT) variable -!! C.Lac 04/12/15 Correction for LSUPSAT -! C. Lac 04/2016: negative contribution to the budget split between advection, turbulence and microphysics for KHKO/C2R2 -! C. Barthe 01/2016: add budget for LIMA -! C. Lac 10/2016: add budget for droplet deposition -! S. Riette 11/2016: new budgets for ICE3/ICE4 -! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O -! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg -! P. Wautelet 15/11/2019: remove unused CBURECORD variable -! P. Wautelet 24/02/2020: bugfix: corrected condition for budget NCDEPITH -! P. Wautelet 26/02/2020: bugfix: rename CEVA->REVA for budget for raindrop evaporation in C2R2 (necessary after commit 4ed805fc) -! P. Wautelet 26/02/2020: bugfix: add missing condition on OCOLD for NSEDIRH budget in LIMA case -! P. Wautelet 02-03/2020: use the new data structures and subroutines for budgets -! B. Vie 02/03/2020: LIMA negativity checks after turbulence, advection and microphysics budgets -! P .Wautelet 09/03/2020: add missing budgets for electricity -! P. Wautelet 25/03/2020: add missing ove_relax_grd -! P. Wautelet 23/04/2020: add nid in tbudgetdata datatype -! P. Wautelet + Benoit Vié 11/06/2020: improve removal of negative scalar variables + adapt the corresponding budgets -! P. Wautelet 30/06/2020: use NADVSV when possible -! P. Wautelet 30/06/2020: add NNETURSV, NNEADVSV and NNECONSV variables -! P. Wautelet 06/07/2020: bugfix: add condition on HTURB for NETUR sources for SV budgets -! P. Wautelet 08/12/2020: add nbusubwrite and nbutotwrite -! P. Wautelet 11/01/2021: ignore xbuwri for cartesian boxes (write at every xbulen interval) -! P. Wautelet 01/02/2021: bugfix: add missing CEDS source terms for SV budgets -! P. Wautelet 02/02/2021: budgets: add missing source terms for SV budgets in LIMA -! P. Wautelet 03/02/2021: budgets: add new source if LIMA splitting: CORR2 -! P. Wautelet 10/02/2021: budgets: add missing sources for NSV_C2R2BEG+3 budget -! P. Wautelet 11/02/2021: budgets: add missing term SCAV for NSV_LIMA_SCAVMASS budget -! P. Wautelet 02/03/2021: budgets: add terms for blowing snow -! P. Wautelet 04/03/2021: budgets: add terms for drag due to buildings -! P. Wautelet 17/03/2021: choose source terms for budgets with character strings instead of multiple integer variables -! C. Barthe 14/03/2022: budgets: add terms for CIBU and RDSF in LIMA -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -use modd_2d_frc, only: l2d_adv_frc, l2d_rel_frc -use modd_blowsnow, only: lblowsnow -use modd_blowsnow_n, only: lsnowsubl -use modd_budget -use modd_ch_aerosol, only: lorilam -use modd_conf, only: l1d, lcartesian, lforcing, lthinshell, nmodel -use modd_dim_n, only: nimax_ll, njmax_ll, nkmax -use modd_dragbldg_n, only: ldragbldg -use modd_dust, only: ldust -use modd_dyn, only: lcorio, xseglen -use modd_dyn_n, only: xtstep, locean -use modd_elec_descr, only: linductive, lrelax2fw_ion -use modd_field, only: TYPEREAL -use modd_nsv, only: csvnames, & - nsv_aerbeg, nsv_aerend, nsv_aerdepbeg, nsv_aerdepend, nsv_c2r2beg, nsv_c2r2end, & - nsv_chembeg, nsv_chemend, nsv_chicbeg, nsv_chicend, nsv_csbeg, nsv_csend, & - nsv_dstbeg, nsv_dstend, nsv_dstdepbeg, nsv_dstdepend, nsv_elecbeg, nsv_elecend, & -#ifdef MNH_FOREFIRE - nsv_ffbeg, nsv_ffend, & -#endif - nsv_lgbeg, nsv_lgend, & - nsv_lima_beg, nsv_lima_end, nsv_lima_ccn_acti, nsv_lima_ccn_free, nsv_lima_hom_haze, & - nsv_lima_ifn_free, nsv_lima_ifn_nucl, nsv_lima_imm_nucl, & - nsv_lima_nc, nsv_lima_nr, nsv_lima_ni, nsv_lima_scavmass, nsv_lima_spro, & - nsv_lnoxbeg, nsv_lnoxend, nsv_ppbeg, nsv_ppend, & - nsv_sltbeg, nsv_sltend, nsv_sltdepbeg, nsv_sltdepend, nsv_snwbeg, nsv_snwend, & - nsv_user -use modd_parameters, only: jphext -use modd_param_c2r2, only: ldepoc_c2r2 => ldepoc, lrain_c2r2 => lrain, lsedc_c2r2 => lsedc, lsupsat_c2r2 => lsupsat -use modd_param_ice, only: ladj_after, ladj_before, ldeposc_ice => ldeposc, lred, lsedic_ice => lsedic, lwarm_ice => lwarm -use modd_param_n, only: cactccn, celec -use modd_param_lima, only: laero_mass_lima => laero_mass, lacti_lima => lacti, lcold_lima => lcold, ldepoc_lima => ldepoc, & - lhail_lima => lhail, lhhoni_lima => lhhoni, lmeyers_lima => lmeyers, lnucl_lima => lnucl, & - lptsplit, & - lrain_lima => lrain, lscav_lima => lscav, lsedc_lima => lsedc, lsedi_lima => lsedi, & - lsnow_lima => lsnow, lspro_lima => lspro, lwarm_lima => lwarm, lcibu, lrdsf, & - nmod_ccn, nmod_ifn, nmod_imm -use modd_ref, only: lcouples -use modd_salt, only: lsalt -use modd_turb_n, only: lsubg_cond -use modd_viscosity, only: lvisc, lvisc_r, lvisc_sv, lvisc_th, lvisc_uvw - -USE MODE_ll - -IMPLICIT NONE -! -!* 0.1 declarations of argument -! -! -INTEGER, INTENT(IN) :: KLUOUT ! Logical unit number for prints -REAL, INTENT(IN) :: PTSTEP ! time step -INTEGER, INTENT(IN) :: KSV ! number of scalar variables -INTEGER, INTENT(IN) :: KRR ! number of moist variables -LOGICAL, INTENT(IN) :: ONUMDIFU ! switch to activate the numerical - ! diffusion for momentum -LOGICAL, INTENT(IN) :: ONUMDIFTH ! for meteorological scalar variables -LOGICAL, INTENT(IN) :: ONUMDIFSV ! for tracer scalar variables -LOGICAL, INTENT(IN) :: OHORELAX_UVWTH ! switch for the - ! horizontal relaxation for U,V,W,TH -LOGICAL, INTENT(IN) :: OHORELAX_RV ! switch for the - ! horizontal relaxation for Rv -LOGICAL, INTENT(IN) :: OHORELAX_RC ! switch for the - ! horizontal relaxation for Rc -LOGICAL, INTENT(IN) :: OHORELAX_RR ! switch for the - ! horizontal relaxation for Rr -LOGICAL, INTENT(IN) :: OHORELAX_RI ! switch for the - ! horizontal relaxation for Ri -LOGICAL, INTENT(IN) :: OHORELAX_RS ! switch for the - ! horizontal relaxation for Rs -LOGICAL, INTENT(IN) :: OHORELAX_RG ! switch for the - ! horizontal relaxation for Rg -LOGICAL, INTENT(IN) :: OHORELAX_RH ! switch for the - ! horizontal relaxation for Rh -LOGICAL, INTENT(IN) :: OHORELAX_TKE ! switch for the - ! horizontal relaxation for tke -LOGICAL,DIMENSION(:),INTENT(IN):: OHORELAX_SV ! switch for the - ! horizontal relaxation for scalar variables -LOGICAL, INTENT(IN) :: OVE_RELAX ! switch to activate the vertical - ! relaxation -logical, intent(in) :: ove_relax_grd ! switch to activate the vertical - ! relaxation to the lowest verticals -LOGICAL, INTENT(IN) :: OCHTRANS ! switch to activate convective - !transport for SV -LOGICAL, INTENT(IN) :: ONUDGING ! switch to activate nudging -LOGICAL, INTENT(IN) :: ODRAGTREE ! switch to activate vegetation drag -LOGICAL, INTENT(IN) :: ODEPOTREE ! switch to activate droplet deposition on tree -LOGICAL, INTENT(IN) :: OAERO_EOL ! switch to activate wind turbine wake -CHARACTER (LEN=*), INTENT(IN) :: HRAD ! type of the radiation scheme -CHARACTER (LEN=*), INTENT(IN) :: HDCONV ! type of the deep convection scheme -CHARACTER (LEN=*), INTENT(IN) :: HSCONV ! type of the shallow convection scheme -CHARACTER (LEN=*), INTENT(IN) :: HTURB ! type of the turbulence scheme -CHARACTER (LEN=*), INTENT(IN) :: HTURBDIM! dimensionnality of the turbulence - ! scheme -CHARACTER (LEN=*), INTENT(IN) :: HCLOUD ! type of microphysical scheme -! -!* 0.2 declarations of local variables -! -real, parameter :: ITOL = 1e-6 - -INTEGER :: JI, JJ ! loop indices -INTEGER :: IIMAX_ll, IJMAX_ll ! size of the physical global domain -INTEGER :: IIU, IJU ! size along x and y directions - ! of the extended subdomain -INTEGER :: IBUDIM1 ! first dimension of the budget arrays - ! = NBUIMAX in CART case - ! = NBUKMAX in MASK case -INTEGER :: IBUDIM2 ! second dimension of the budget arrays - ! = NBUJMAX in CART case - ! = nbusubwrite in MASK case -INTEGER :: IBUDIM3 ! third dimension of the budget arrays - ! = NBUKMAX in CART case - ! = NBUMASK in MASK case -INTEGER :: JSV ! loop indice for the SVs -INTEGER :: IINFO_ll ! return status of the interface routine -integer :: ibudget -logical :: gtmp -type(tbusourcedata) :: tzsource ! Used to prepare metadate of source terms - -call Print_msg( NVERB_DEBUG, 'BUD', 'Ini_budget', 'called' ) -! -!* 1. COMPUTE BUDGET VARIABLES -! ------------------------ -! -NBUSTEP = NINT (XBULEN / PTSTEP) -NBUTSHIFT=0 -! -! common dimension for all CBUTYPE values -! -IF (LBU_KCP) THEN - NBUKMAX = 1 -ELSE - NBUKMAX = NBUKH - NBUKL +1 -END IF -! -if ( cbutype == 'CART' .or. cbutype == 'MASK' ) then - !Check if xbulen is a multiple of xtstep (within tolerance) - if ( Abs( Nint( xbulen / xtstep ) * xtstep - xbulen ) > ( ITOL * xtstep ) ) & - call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'xbulen is not a multiple of xtstep' ) - - if ( cbutype == 'CART' ) then - !Check if xseglen is a multiple of xbulen (within tolerance) - if ( Abs( Nint( xseglen / xbulen ) * xbulen - xseglen ) > ( ITOL * xseglen ) ) & - call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'xseglen is not a multiple of xbulen' ) - - !Write cartesian budgets every xbulen time period (do not take xbuwri into account) - xbuwri = xbulen - - nbusubwrite = 1 !Number of budget time average periods for each write - nbutotwrite = nbusubwrite * Nint( xseglen / xbulen ) !Total number of budget time average periods - else if ( cbutype == 'MASK' ) then - !Check if xbuwri is a multiple of xtstep (within tolerance) - if ( Abs( Nint( xbuwri / xtstep ) * xtstep - xbuwri ) > ( ITOL * xtstep ) ) & - call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'xbuwri is not a multiple of xtstep' ) - - !Check if xbuwri is a multiple of xbulen (within tolerance) - if ( Abs( Nint( xbuwri / xbulen ) * xbulen - xbuwri ) > ( ITOL * xbulen ) ) & - call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'xbuwri is not a multiple of xbulen' ) - - !Check if xseglen is a multiple of xbuwri (within tolerance) - if ( Abs( Nint( xseglen / xbuwri ) * xbuwri - xseglen ) > ( ITOL * xseglen ) ) & - call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'xseglen is not a multiple of xbuwri' ) - - nbusubwrite = Nint ( xbuwri / xbulen ) !Number of budget time average periods for each write - nbutotwrite = nbusubwrite * Nint( xseglen / xbuwri ) !Total number of budget time average periods - end if -end if - -IF (CBUTYPE=='CART') THEN ! cartesian case only -! - IF ( NBUIL < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUIL too small (<1)' ) - IF ( NBUIL > NIMAX_ll ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUIL too large (>NIMAX)' ) - IF ( NBUIH < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUIH too small (<1)' ) - IF ( NBUIH > NIMAX_ll ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUIH too large (>NIMAX)' ) - IF ( NBUIH < NBUIL ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUIH < NBUIL' ) - IF (LBU_ICP) THEN - NBUIMAX_ll = 1 - ELSE - NBUIMAX_ll = NBUIH - NBUIL +1 - END IF - - IF ( NBUJL < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUJL too small (<1)' ) - IF ( NBUJL > NJMAX_ll ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUJL too large (>NJMAX)' ) - IF ( NBUJH < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUJH too small (<1)' ) - IF ( NBUJH > NJMAX_ll ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUJH too large (>NJMAX)' ) - IF ( NBUJH < NBUJL ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUJH < NBUJL' ) - IF (LBU_JCP) THEN - NBUJMAX_ll = 1 - ELSE - NBUJMAX_ll = NBUJH - NBUJL +1 - END IF - - IF ( NBUKL < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUKL too small (<1)' ) - IF ( NBUKL > NKMAX ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUKL too large (>NKMAX)' ) - IF ( NBUKH < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUKH too small (<1)' ) - IF ( NBUKH > NKMAX ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUKH too large (>NKMAX)' ) - IF ( NBUKH < NBUKL ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUKH < NBUKL' ) - - CALL GET_INTERSECTION_ll(NBUIL+JPHEXT,NBUJL+JPHEXT,NBUIH+JPHEXT,NBUJH+JPHEXT, & - NBUSIL,NBUSJL,NBUSIH,NBUSJH,"PHYS",IINFO_ll) - IF ( IINFO_ll /= 1 ) THEN ! - IF (LBU_ICP) THEN - NBUIMAX = 1 - ELSE - NBUIMAX = NBUSIH - NBUSIL +1 - END IF - IF (LBU_JCP) THEN - NBUJMAX = 1 - ELSE - NBUJMAX = NBUSJH - NBUSJL +1 - END IF - ELSE ! the intersection is void - CBUTYPE='SKIP' ! no budget on this processor - NBUIMAX = 0 ! in order to allocate void arrays - NBUJMAX = 0 - ENDIF -! three first dimensions of budget arrays in cart and skip cases - IBUDIM1=NBUIMAX - IBUDIM2=NBUJMAX - IBUDIM3=NBUKMAX -! these variables are not be used - NBUMASK=-1 -! -ELSEIF (CBUTYPE=='MASK') THEN ! mask case only -! - LBU_ENABLE=.TRUE. - ! result on the FM_FILE - NBUTIME = 1 - - CALL GET_DIM_EXT_ll ('B', IIU,IJU) - ALLOCATE( LBU_MASK( IIU ,IJU, NBUMASK) ) - LBU_MASK(:,:,:)=.FALSE. - ALLOCATE( NBUSURF( IIU, IJU, NBUMASK, nbusubwrite) ) - NBUSURF(:,:,:,:) = 0 -! -! three first dimensions of budget arrays in mask case -! the order of the dimensions are the order expected in WRITE_DIACHRO routine: -! x,y,z,time,mask,processus and in this case x and y are missing -! first dimension of the arrays : dimension along K -! second dimension of the arrays : number of the budget time period -! third dimension of the arrays : number of the budget masks zones - IBUDIM1=NBUKMAX - IBUDIM2=nbusubwrite - IBUDIM3=NBUMASK -! these variables are not used in this case - NBUIMAX=-1 - NBUJMAX=-1 -! the beginning and the end along x and y direction : global extended domain - ! get dimensions of the physical global domain - CALL GET_GLOBALDIMS_ll (IIMAX_ll,IJMAX_ll) - NBUIL=1 - NBUIH=IIMAX_ll + 2 * JPHEXT - NBUJL=1 - NBUJH=IJMAX_ll + 2 * JPHEXT -! -ELSE ! default case -! - LBU_ENABLE=.FALSE. - NBUIMAX = -1 - NBUJMAX = -1 - LBU_RU = .FALSE. - LBU_RV = .FALSE. - LBU_RW = .FALSE. - LBU_RTH= .FALSE. - LBU_RTKE= .FALSE. - LBU_RRV= .FALSE. - LBU_RRC= .FALSE. - LBU_RRR= .FALSE. - LBU_RRI= .FALSE. - LBU_RRS= .FALSE. - LBU_RRG= .FALSE. - LBU_RRH= .FALSE. - LBU_RSV= .FALSE. -! -! three first dimensions of budget arrays in default case - IBUDIM1=0 - IBUDIM2=0 - IBUDIM3=0 -! -END IF -! -! -!------------------------------------------------------------------------------- -! -!* 2. ALLOCATE MEMORY FOR BUDGET ARRAYS AND INITIALIZE -! ------------------------------------------------ -! -LBU_BEG =.TRUE. -! -!------------------------------------------------------------------------------- -! -!* 3. INITALIZE VARIABLES -! ------------------- -! -!Create intermediate variable to store rhodj for scalar variables -if ( lbu_rth .or. lbu_rtke .or. lbu_rrv .or. lbu_rrc .or. lbu_rrr .or. & - lbu_rri .or. lbu_rrs .or. lbu_rrg .or. lbu_rrh .or. lbu_rsv ) then - allocate( tburhodj ) - - tburhodj%cmnhname = 'RhodJS' - tburhodj%cstdname = '' - tburhodj%clongname = 'RhodJS' - tburhodj%cunits = 'kg' - tburhodj%ccomment = 'RhodJ for Scalars variables' - tburhodj%ngrid = 1 - tburhodj%ntype = TYPEREAL - tburhodj%ndims = 3 - - allocate( tburhodj%xdata(ibudim1, ibudim2, ibudim3) ) - tburhodj%xdata(:, :, :) = 0. -end if - - -tzsource%ntype = TYPEREAL -tzsource%ndims = 3 - -! Budget of RU -tbudgets(NBUDGET_U)%lenabled = lbu_ru - -if ( lbu_ru ) then - allocate( tbudgets(NBUDGET_U)%trhodj ) - - tbudgets(NBUDGET_U)%trhodj%cmnhname = 'RhodJX' - tbudgets(NBUDGET_U)%trhodj%cstdname = '' - tbudgets(NBUDGET_U)%trhodj%clongname = 'RhodJX' - tbudgets(NBUDGET_U)%trhodj%cunits = 'kg' - tbudgets(NBUDGET_U)%trhodj%ccomment = 'RhodJ for momentum along X axis' - tbudgets(NBUDGET_U)%trhodj%ngrid = 2 - tbudgets(NBUDGET_U)%trhodj%ntype = TYPEREAL - tbudgets(NBUDGET_U)%trhodj%ndims = 3 - - allocate( tbudgets(NBUDGET_U)%trhodj%xdata(ibudim1, ibudim2, ibudim3) ) - tbudgets(NBUDGET_U)%trhodj%xdata(:, :, :) = 0. - - !Allocate all basic source terms (used or not) - !The size should be large enough (bigger than necessary is OK) - tbudgets(NBUDGET_U)%nsourcesmax = NSOURCESMAX - allocate( tbudgets(NBUDGET_U)%tsources(NSOURCESMAX) ) - - allocate( tbudgets(NBUDGET_U)%xtmpstore(ibudim1, ibudim2, ibudim3) ) - - tbudgets(NBUDGET_U)%tsources(:)%ngroup = 0 - - tzsource%ccomment = 'Budget of momentum along X axis' - tzsource%ngrid = 2 - - tzsource%cunits = 'm s-1' - - tzsource%cmnhname = 'INIF' - tzsource%clongname = 'initial state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_U), tzsource, odonotinit = .true., ooverwrite = .true. ) - - tzsource%cmnhname = 'ENDF' - tzsource%clongname = 'final state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_U), tzsource, odonotinit = .true., ooverwrite = .true. ) - - tzsource%cmnhname = 'AVEF' - tzsource%clongname = 'averaged state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_U), tzsource, odonotinit = .true., ooverwrite = .false. ) - - tzsource%cunits = 'm s-2' - - tzsource%cmnhname = 'ASSE' - tzsource%clongname = 'time filter (Asselin)' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_U), tzsource ) - - tzsource%cmnhname = 'NEST' - tzsource%clongname = 'nesting' - tzsource%lavailable = nmodel > 1 - call Budget_source_add( tbudgets(NBUDGET_U), tzsource ) - - tzsource%cmnhname = 'FRC' - tzsource%clongname = 'forcing' - tzsource%lavailable = lforcing - call Budget_source_add( tbudgets(NBUDGET_U), tzsource ) - - tzsource%cmnhname = 'NUD' - tzsource%clongname = 'nudging' - tzsource%lavailable = onudging - call Budget_source_add( tbudgets(NBUDGET_U), tzsource ) - - tzsource%cmnhname = 'CURV' - tzsource%clongname = 'curvature' - tzsource%lavailable = .not.l1d .and. .not.lcartesian - call Budget_source_add( tbudgets(NBUDGET_U), tzsource ) - - tzsource%cmnhname = 'COR' - tzsource%clongname = 'Coriolis' - tzsource%lavailable = lcorio - call Budget_source_add( tbudgets(NBUDGET_U), tzsource ) - - tzsource%cmnhname = 'DIF' - tzsource%clongname = 'numerical diffusion' - tzsource%lavailable = onumdifu - call Budget_source_add( tbudgets(NBUDGET_U), tzsource ) - - tzsource%cmnhname = 'REL' - tzsource%clongname = 'relaxation' - tzsource%lavailable = ohorelax_uvwth .or. ove_relax .or. ove_relax_grd - call Budget_source_add( tbudgets(NBUDGET_U), tzsource ) - - tzsource%cmnhname = 'DRAG' - tzsource%clongname = 'drag force due to trees' - tzsource%lavailable = odragtree - call Budget_source_add( tbudgets(NBUDGET_U), tzsource ) - - tzsource%cmnhname = 'DRAGEOL' - tzsource%clongname = 'drag force due to wind turbine' - tzsource%lavailable = OAERO_EOL - call Budget_source_add( tbudgets(NBUDGET_U), tzsource ) - - tzsource%cmnhname = 'DRAGB' - tzsource%clongname = 'drag force due to buildings' - tzsource%lavailable = ldragbldg - call Budget_source_add( tbudgets(NBUDGET_U), tzsource ) - - tzsource%cmnhname = 'VTURB' - tzsource%clongname = 'vertical turbulent diffusion' - tzsource%lavailable = hturb == 'TKEL' - call Budget_source_add( tbudgets(NBUDGET_U), tzsource ) - - tzsource%cmnhname = 'HTURB' - tzsource%clongname = 'horizontal turbulent diffusion' - tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM' - call Budget_source_add( tbudgets(NBUDGET_U), tzsource ) - - tzsource%cmnhname = 'MAFL' - tzsource%clongname = 'mass flux' - tzsource%lavailable = hsconv == 'EDKF' - call Budget_source_add( tbudgets(NBUDGET_U), tzsource ) - - tzsource%cmnhname = 'VISC' - tzsource%clongname = 'viscosity' - tzsource%lavailable = lvisc .and. lvisc_uvw - call Budget_source_add( tbudgets(NBUDGET_U), tzsource ) - - tzsource%cmnhname = 'ADV' - tzsource%clongname = 'advection' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_U), tzsource ) - - tzsource%cmnhname = 'PRES' - tzsource%clongname = 'pressure' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_U), tzsource ) - - - call Sourcelist_sort_compact( tbudgets(NBUDGET_U) ) - - call Sourcelist_scan( tbudgets(NBUDGET_U), cbulist_ru ) -end if - -! Budget of RV -tbudgets(NBUDGET_V)%lenabled = lbu_rv - -if ( lbu_rv ) then - allocate( tbudgets(NBUDGET_V)%trhodj ) - - tbudgets(NBUDGET_V)%trhodj%cmnhname = 'RhodJY' - tbudgets(NBUDGET_V)%trhodj%cstdname = '' - tbudgets(NBUDGET_V)%trhodj%clongname = 'RhodJY' - tbudgets(NBUDGET_V)%trhodj%cunits = 'kg' - tbudgets(NBUDGET_V)%trhodj%ccomment = 'RhodJ for momentum along Y axis' - tbudgets(NBUDGET_V)%trhodj%ngrid = 3 - tbudgets(NBUDGET_V)%trhodj%ntype = TYPEREAL - tbudgets(NBUDGET_V)%trhodj%ndims = 3 - - allocate( tbudgets(NBUDGET_V)%trhodj%xdata(ibudim1, ibudim2, ibudim3) ) - tbudgets(NBUDGET_V)%trhodj%xdata(:, :, :) = 0. - - !Allocate all basic source terms (used or not) - !The size should be large enough (bigger than necessary is OK) - tbudgets(NBUDGET_V)%nsourcesmax = NSOURCESMAX - allocate( tbudgets(NBUDGET_V)%tsources(NSOURCESMAX) ) - - allocate( tbudgets(NBUDGET_V)%xtmpstore(ibudim1, ibudim2, ibudim3) ) - - tbudgets(NBUDGET_V)%tsources(:)%ngroup = 0 - - tzsource%ccomment = 'Budget of momentum along Y axis' - tzsource%ngrid = 3 - - tzsource%cunits = 'm s-1' - - tzsource%cmnhname = 'INIF' - tzsource%clongname = 'initial state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_V), tzsource, odonotinit = .true., ooverwrite = .true. ) - - tzsource%cmnhname = 'ENDF' - tzsource%clongname = 'final state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_V), tzsource, odonotinit = .true., ooverwrite = .true. ) - - tzsource%cmnhname = 'AVEF' - tzsource%clongname = 'averaged state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_V), tzsource, odonotinit = .true., ooverwrite = .false. ) - - tzsource%cunits = 'm s-2' - - tzsource%cmnhname = 'ASSE' - tzsource%clongname = 'time filter (Asselin)' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_V), tzsource ) - - tzsource%cmnhname = 'NEST' - tzsource%clongname = 'nesting' - tzsource%lavailable = nmodel > 1 - call Budget_source_add( tbudgets(NBUDGET_V), tzsource ) - - tzsource%cmnhname = 'FRC' - tzsource%clongname = 'forcing' - tzsource%lavailable = lforcing - call Budget_source_add( tbudgets(NBUDGET_V), tzsource ) - - tzsource%cmnhname = 'NUD' - tzsource%clongname = 'nudging' - tzsource%lavailable = onudging - call Budget_source_add( tbudgets(NBUDGET_V), tzsource ) - - tzsource%cmnhname = 'CURV' - tzsource%clongname = 'curvature' - tzsource%lavailable = .not.l1d .and. .not.lcartesian - call Budget_source_add( tbudgets(NBUDGET_V), tzsource ) - - tzsource%cmnhname = 'COR' - tzsource%clongname = 'Coriolis' - tzsource%lavailable = lcorio - call Budget_source_add( tbudgets(NBUDGET_V), tzsource ) - - tzsource%cmnhname = 'DIF' - tzsource%clongname = 'numerical diffusion' - tzsource%lavailable = onumdifu - call Budget_source_add( tbudgets(NBUDGET_V), tzsource ) - - tzsource%cmnhname = 'REL' - tzsource%clongname = 'relaxation' - tzsource%lavailable = ohorelax_uvwth .or. ove_relax .or. ove_relax_grd - call Budget_source_add( tbudgets(NBUDGET_V), tzsource ) - - tzsource%cmnhname = 'DRAG' - tzsource%clongname = 'drag force due to trees' - tzsource%lavailable = odragtree - call Budget_source_add( tbudgets(NBUDGET_V), tzsource ) - - tzsource%cmnhname = 'DRAGEOL' - tzsource%clongname = 'drag force due to wind turbine' - tzsource%lavailable = OAERO_EOL - call Budget_source_add( tbudgets(NBUDGET_V), tzsource ) - - tzsource%cmnhname = 'DRAGB' - tzsource%clongname = 'drag force due to buildings' - tzsource%lavailable = ldragbldg - call Budget_source_add( tbudgets(NBUDGET_V), tzsource ) - - tzsource%cmnhname = 'VTURB' - tzsource%clongname = 'vertical turbulent diffusion' - tzsource%lavailable = hturb == 'TKEL' - call Budget_source_add( tbudgets(NBUDGET_V), tzsource ) - - tzsource%cmnhname = 'HTURB' - tzsource%clongname = 'horizontal turbulent diffusion' - tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM' - call Budget_source_add( tbudgets(NBUDGET_V), tzsource ) - - tzsource%cmnhname = 'MAFL' - tzsource%clongname = 'mass flux' - tzsource%lavailable = hsconv == 'EDKF' - call Budget_source_add( tbudgets(NBUDGET_V), tzsource ) - - tzsource%cmnhname = 'VISC' - tzsource%clongname = 'viscosity' - tzsource%lavailable = lvisc .and. lvisc_uvw - call Budget_source_add( tbudgets(NBUDGET_V), tzsource ) - - tzsource%cmnhname = 'ADV' - tzsource%clongname = 'advection' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_V), tzsource ) - - tzsource%cmnhname = 'PRES' - tzsource%clongname = 'pressure' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_V), tzsource ) - - - call Sourcelist_sort_compact( tbudgets(NBUDGET_V) ) - - call Sourcelist_scan( tbudgets(NBUDGET_V), cbulist_rv ) -end if - -! Budget of RW -tbudgets(NBUDGET_W)%lenabled = lbu_rw - -if ( lbu_rw ) then - allocate( tbudgets(NBUDGET_W)%trhodj ) - - tbudgets(NBUDGET_W)%trhodj%cmnhname = 'RhodJZ' - tbudgets(NBUDGET_W)%trhodj%cstdname = '' - tbudgets(NBUDGET_W)%trhodj%clongname = 'RhodJZ' - tbudgets(NBUDGET_W)%trhodj%cunits = 'kg' - tbudgets(NBUDGET_W)%trhodj%ccomment = 'RhodJ for momentum along Z axis' - tbudgets(NBUDGET_W)%trhodj%ngrid = 4 - tbudgets(NBUDGET_W)%trhodj%ntype = TYPEREAL - tbudgets(NBUDGET_W)%trhodj%ndims = 3 - - allocate( tbudgets(NBUDGET_W)%trhodj%xdata(ibudim1, ibudim2, ibudim3) ) - tbudgets(NBUDGET_W)%trhodj%xdata(:, :, :) = 0. - - !Allocate all basic source terms (used or not) - !The size should be large enough (bigger than necessary is OK) - tbudgets(NBUDGET_W)%nsourcesmax = NSOURCESMAX - allocate( tbudgets(NBUDGET_W)%tsources(NSOURCESMAX) ) - - allocate( tbudgets(NBUDGET_W)%xtmpstore(ibudim1, ibudim2, ibudim3) ) - - tbudgets(NBUDGET_W)%tsources(:)%ngroup = 0 - - tzsource%ccomment = 'Budget of momentum along Z axis' - tzsource%ngrid = 4 - - tzsource%cunits = 'm s-1' - - tzsource%cmnhname = 'INIF' - tzsource%clongname = 'initial state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_W), tzsource, odonotinit = .true., ooverwrite = .true. ) - - tzsource%cmnhname = 'ENDF' - tzsource%clongname = 'final state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_W), tzsource, odonotinit = .true., ooverwrite = .true. ) - - tzsource%cmnhname = 'AVEF' - tzsource%clongname = 'averaged state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_W), tzsource, odonotinit = .true., ooverwrite = .false. ) - - tzsource%cunits = 'm s-2' - - tzsource%cmnhname = 'ASSE' - tzsource%clongname = 'time filter (Asselin)' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_W), tzsource ) - - tzsource%cmnhname = 'NEST' - tzsource%clongname = 'nesting' - tzsource%lavailable = nmodel > 1 - call Budget_source_add( tbudgets(NBUDGET_W), tzsource ) - - tzsource%cmnhname = 'FRC' - tzsource%clongname = 'forcing' - tzsource%lavailable = lforcing - call Budget_source_add( tbudgets(NBUDGET_W), tzsource ) - - tzsource%cmnhname = 'NUD' - tzsource%clongname = 'nudging' - tzsource%lavailable = onudging - call Budget_source_add( tbudgets(NBUDGET_W), tzsource ) - - tzsource%cmnhname = 'CURV' - tzsource%clongname = 'curvature' - tzsource%lavailable = .not.l1d .and. .not.lcartesian .and. .not.lthinshell - call Budget_source_add( tbudgets(NBUDGET_W), tzsource ) - - tzsource%cmnhname = 'COR' - tzsource%clongname = 'Coriolis' - tzsource%lavailable = lcorio .and. .not.l1d .and. .not.lthinshell - call Budget_source_add( tbudgets(NBUDGET_W), tzsource ) - - tzsource%cmnhname = 'DIF' - tzsource%clongname = 'numerical diffusion' - tzsource%lavailable = onumdifu - call Budget_source_add( tbudgets(NBUDGET_W), tzsource ) - - tzsource%cmnhname = 'REL' - tzsource%clongname = 'relaxation' - tzsource%lavailable = ohorelax_uvwth .or. ove_relax .or. ove_relax_grd - call Budget_source_add( tbudgets(NBUDGET_W), tzsource ) - - tzsource%cmnhname = 'VTURB' - tzsource%clongname = 'vertical turbulent diffusion' - tzsource%lavailable = hturb == 'TKEL' - call Budget_source_add( tbudgets(NBUDGET_W), tzsource ) - - tzsource%cmnhname = 'HTURB' - tzsource%clongname = 'horizontal turbulent diffusion' - tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM' - call Budget_source_add( tbudgets(NBUDGET_W), tzsource ) - - tzsource%cmnhname = 'VISC' - tzsource%clongname = 'viscosity' - tzsource%lavailable = lvisc .and. lvisc_uvw - call Budget_source_add( tbudgets(NBUDGET_W), tzsource ) - - tzsource%cmnhname = 'GRAV' - tzsource%clongname = 'gravity' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_W), tzsource ) - - tzsource%cmnhname = 'ADV' - tzsource%clongname = 'advection' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_W), tzsource ) - - tzsource%cmnhname = 'PRES' - tzsource%clongname = 'pressure' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_W), tzsource ) - - tzsource%cmnhname = 'DRAGEOL' - tzsource%clongname = 'drag force due to wind turbine' - tzsource%lavailable = OAERO_EOL - call Budget_source_add( tbudgets(NBUDGET_W), tzsource ) - - call Sourcelist_sort_compact( tbudgets(NBUDGET_W) ) - - call Sourcelist_scan( tbudgets(NBUDGET_W), cbulist_rw ) -end if - -! Budget of RTH -tbudgets(NBUDGET_TH)%lenabled = lbu_rth - -if ( lbu_rth ) then - tbudgets(NBUDGET_TH)%trhodj => tburhodj - - !Allocate all basic source terms (used or not) - !The size should be large enough (bigger than necessary is OK) - tbudgets(NBUDGET_TH)%nsourcesmax = NSOURCESMAX - allocate( tbudgets(NBUDGET_TH)%tsources(NSOURCESMAX) ) - - allocate( tbudgets(NBUDGET_TH)%xtmpstore(ibudim1, ibudim2, ibudim3) ) - - tbudgets(NBUDGET_TH)%tsources(:)%ngroup = 0 - - tzsource%ccomment = 'Budget of potential temperature' - tzsource%ngrid = 1 - - tzsource%cunits = 'K' - - tzsource%cmnhname = 'INIF' - tzsource%clongname = 'initial state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource, odonotinit = .true., ooverwrite = .true. ) - - tzsource%cmnhname = 'ENDF' - tzsource%clongname = 'final state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource, odonotinit = .true., ooverwrite = .true. ) - - tzsource%cmnhname = 'AVEF' - tzsource%clongname = 'averaged state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource, odonotinit = .true., ooverwrite = .false. ) - - tzsource%cunits = 'K s-1' - - tzsource%cmnhname = 'ASSE' - tzsource%clongname = 'time filter (Asselin)' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'NEST' - tzsource%clongname = 'nesting' - tzsource%lavailable = nmodel > 1 - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'FRC' - tzsource%clongname = 'forcing' - tzsource%lavailable = lforcing - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = '2DADV' - tzsource%clongname = 'advective forcing' - tzsource%lavailable = l2d_adv_frc - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = '2DREL' - tzsource%clongname = 'relaxation forcing' - tzsource%lavailable = l2d_rel_frc - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'NUD' - tzsource%clongname = 'nudging' - tzsource%lavailable = onudging - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'PREF' - tzsource%clongname = 'reference pressure' - tzsource%lavailable = krr > 0 .and. .not.l1d - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'DIF' - tzsource%clongname = 'numerical diffusion' - tzsource%lavailable = onumdifth - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'REL' - tzsource%clongname = 'relaxation' - tzsource%lavailable = ohorelax_uvwth .or. ove_relax .or. ove_relax_grd - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'RAD' - tzsource%clongname = 'radiation' - tzsource%lavailable = hrad /= 'NONE' - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'DCONV' - tzsource%clongname = 'KAFR convection' - tzsource%lavailable = hdconv == 'KAFR' .OR. hsconv == 'KAFR' - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'VTURB' - tzsource%clongname = 'vertical turbulent diffusion' - tzsource%lavailable = hturb == 'TKEL' - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'HTURB' - tzsource%clongname = 'horizontal turbulent diffusion' - tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM' - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'DISSH' - tzsource%clongname = 'dissipation' - tzsource%lavailable = hturb == 'TKEL' - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'NETUR' - tzsource%clongname = 'negativity correction induced by turbulence' - tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' & - .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'MAFL' - tzsource%clongname = 'mass flux' - tzsource%lavailable = hsconv == 'EDKF' - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'SNSUB' - tzsource%clongname = 'blowing snow sublimation' - tzsource%lavailable = lblowsnow .and. lsnowsubl - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'VISC' - tzsource%clongname = 'viscosity' - tzsource%lavailable = lvisc .and. lvisc_th - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'OCEAN' - tzsource%clongname = 'radiative tendency due to SW penetrating ocean' - tzsource%lavailable = locean .and. (.not. lcouples) - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'ADV' - tzsource%clongname = 'total advection' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'NEADV' - tzsource%clongname = 'negativity correction induced by advection' - tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' & - .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'NEGA' - tzsource%clongname = 'negativity correction' - tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' & - .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'SEDI' - tzsource%clongname = 'heat transport by hydrometeors sedimentation' - tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'HENU' - tzsource%clongname = 'heterogeneous nucleation' - gtmp = cactccn == 'ABRK' .and. (lorilam .or. ldust .or. lsalt ) - tzsource%lavailable = ( hcloud == 'LIMA' .and. lwarm_lima .and. lacti_lima .and. nmod_ccn >= 1 & - .and. ( .not.lptsplit .or. .not.lsubg_cond ) ) & - .or. hcloud(1:3) == 'ICE' & - .or. ( hcloud == 'C2R2' .and. ( gtmp .or. .not.lsupsat_c2r2 ) ) & - .or. ( hcloud == 'KHKO' .and. ( gtmp .or. .not.lsupsat_c2r2 ) ) - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'REVA' - tzsource%clongname = 'rain evaporation' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( ( .not. lptsplit .and. lwarm_lima .and. lrain_lima ) .or. lptsplit ) ) & - .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) & - .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) & - .or. ( hcloud == 'KHKO' .and. lrain_c2r2 ) & - .or. hcloud == 'KESS' - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'HIND' - tzsource%clongname = 'heterogeneous nucleation by deposition' - tzsource%lavailable = hcloud == 'LIMA' .and. lcold_lima .and. lnucl_lima - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'HINC' - tzsource%clongname = 'heterogeneous nucleation by contact' - tzsource%lavailable = hcloud == 'LIMA' .and. lcold_lima .and. lnucl_lima - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'HON' - tzsource%clongname = 'homogeneous nucleation' - tzsource%lavailable = hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'HONH' - tzsource%clongname = 'haze homogeneous nucleation' - tzsource%lavailable = hcloud == 'LIMA' .and. lcold_lima .and. lnucl_lima .and. lhhoni_lima .and. nmod_ccn >= 1 - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'HONC' - tzsource%clongname = 'droplet homogeneous freezing' - tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lnucl_lima ) ) - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'HONR' - tzsource%clongname = 'raindrop homogeneous freezing' - tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lnucl_lima .and. lrain_lima ) ) - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'SFR' - tzsource%clongname = 'spontaneous freezing' - tzsource%lavailable = hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'DEPS' - tzsource%clongname = 'deposition on snow' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lsnow_lima ) ) ) .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'DEPG' - tzsource%clongname = 'deposition on graupel' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'IMLT' - tzsource%clongname = 'melting of ice' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima ) ) ) .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'BERFI' - tzsource%clongname = 'Bergeron-Findeisen' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima ) ) ) .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'RIM' - tzsource%clongname = 'riming of cloud water' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'ACC' - tzsource%clongname = 'accretion of rain on aggregates' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit & - .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima .and. lrain_lima ) ) ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'CFRZ' - tzsource%clongname = 'conversion freezing of rain' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'WETG' - tzsource%clongname = 'wet growth of graupel' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'DRYG' - tzsource%clongname = 'dry growth of graupel' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'GMLT' - tzsource%clongname = 'graupel melting' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'WETH' - tzsource%clongname = 'wet growth of hail' - tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lhail_lima .and. lcold_lima & - .and. lwarm_lima .and. lsnow_lima ) & - .or. hcloud == 'ICE4' - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'DRYH' - tzsource%clongname = 'dry growth of hail' - tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE' - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'HMLT' - tzsource%clongname = 'melting of hail' - tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lhail_lima .and. lcold_lima & - .and. lwarm_lima .and. lsnow_lima ) & - .or. hcloud == 'ICE4' - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'CORR' - tzsource%clongname = 'correction' - tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'CEDS' - tzsource%clongname = 'adjustment to saturation' - tzsource%lavailable = hcloud == 'LIMA' - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'ADJU' - tzsource%clongname = 'adjustment to saturation' - tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before .and. celec == 'NONE' - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'DEPI' - tzsource%clongname = 'deposition on ice' - tzsource%lavailable = ( hcloud(1:3) == 'ICE' .and. ( .not. lred .or. ( lred .and. ladj_after ) .or. celec /= 'NONE') ) & - .or. ( hcloud == 'LIMA' .and. lptsplit ) - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'COND' - tzsource%clongname = 'vapor condensation or cloud water evaporation' - tzsource%lavailable = hcloud == 'C2R2' .or. hcloud == 'KHKO' .or. hcloud == 'KESS' .or. hcloud == 'REVE' - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - tzsource%cmnhname = 'NECON' - tzsource%clongname = 'negativity correction induced by condensation' - tzsource%lavailable = ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' & - .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) & - .and. celec == 'NONE' - call Budget_source_add( tbudgets(NBUDGET_TH), tzsource ) - - - call Sourcelist_sort_compact( tbudgets(NBUDGET_TH) ) - - call Sourcelist_scan( tbudgets(NBUDGET_TH), cbulist_rth ) -end if - -! Budget of RTKE -tbudgets(NBUDGET_TKE)%lenabled = lbu_rtke - -if ( lbu_rtke ) then - tbudgets(NBUDGET_TKE)%trhodj => tburhodj - - !Allocate all basic source terms (used or not) - !The size should be large enough (bigger than necessary is OK) - tbudgets(NBUDGET_TKE)%nsourcesmax = NSOURCESMAX - allocate( tbudgets(NBUDGET_TKE)%tsources(NSOURCESMAX) ) - - allocate( tbudgets(NBUDGET_TKE)%xtmpstore(ibudim1, ibudim2, ibudim3) ) - - tbudgets(NBUDGET_TKE)%tsources(:)%ngroup = 0 - - tzsource%ccomment = 'Budget of turbulent kinetic energy' - tzsource%ngrid = 1 - - tzsource%cunits = 'm2 s-1' - - tzsource%cmnhname = 'INIF' - tzsource%clongname = 'initial state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource, odonotinit = .true., ooverwrite = .true. ) - - tzsource%cmnhname = 'ENDF' - tzsource%clongname = 'final state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource, odonotinit = .true., ooverwrite = .true. ) - - tzsource%cmnhname = 'AVEF' - tzsource%clongname = 'averaged state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource, odonotinit = .true., ooverwrite = .false. ) - - tzsource%cunits = 'm2 s-3' - - tzsource%cmnhname = 'ASSE' - tzsource%clongname = 'time filter (Asselin)' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource ) - - tzsource%cmnhname = 'FRC' - tzsource%clongname = 'forcing' - tzsource%lavailable = lforcing - call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource ) - - tzsource%cmnhname = 'DIF' - tzsource%clongname = 'numerical diffusion' - tzsource%lavailable = onumdifth - call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource ) - - tzsource%cmnhname = 'REL' - tzsource%clongname = 'relaxation' - tzsource%lavailable = ohorelax_tke - call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource ) - - tzsource%cmnhname = 'DRAG' - tzsource%clongname = 'drag force' - tzsource%lavailable = odragtree - call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource ) - - tzsource%cmnhname = 'DRAGB' - tzsource%clongname = 'drag force due to buildings' - tzsource%lavailable = ldragbldg - call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource ) - - tzsource%cmnhname = 'DP' - tzsource%clongname = 'dynamic production' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource ) - - tzsource%cmnhname = 'TP' - tzsource%clongname = 'thermal production' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource ) - - tzsource%cmnhname = 'DISS' - tzsource%clongname = 'dissipation of TKE' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource ) - - tzsource%cmnhname = 'TR' - tzsource%clongname = 'turbulent transport' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource ) - - tzsource%cmnhname = 'ADV' - tzsource%clongname = 'total advection' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource ) - - - call Sourcelist_sort_compact( tbudgets(NBUDGET_TKE) ) - - call Sourcelist_scan( tbudgets(NBUDGET_TKE), cbulist_rtke ) -end if - -! Budget of RRV -tbudgets(NBUDGET_RV)%lenabled = lbu_rrv .and. krr >= 1 - -if ( tbudgets(NBUDGET_RV)%lenabled ) then - tbudgets(NBUDGET_RV)%trhodj => tburhodj - - !Allocate all basic source terms (used or not) - !The size should be large enough (bigger than necessary is OK) - tbudgets(NBUDGET_RV)%nsourcesmax = NSOURCESMAX - allocate( tbudgets(NBUDGET_RV)%tsources(NSOURCESMAX) ) - - allocate( tbudgets(NBUDGET_RV)%xtmpstore(ibudim1, ibudim2, ibudim3) ) - - tbudgets(NBUDGET_RV)%tsources(:)%ngroup = 0 - - tzsource%ccomment = 'Budget of water vapor mixing ratio' - tzsource%ngrid = 1 - - tzsource%cunits = 'kg kg-1' - - tzsource%cmnhname = 'INIF' - tzsource%clongname = 'initial state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource, odonotinit = .true., ooverwrite = .true. ) - - tzsource%cmnhname = 'ENDF' - tzsource%clongname = 'final state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource, odonotinit = .true., ooverwrite = .true. ) - - tzsource%cmnhname = 'AVEF' - tzsource%clongname = 'averaged state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource, odonotinit = .true., ooverwrite = .false. ) - - tzsource%cunits = 's-1' - - tzsource%cmnhname = 'ASSE' - tzsource%clongname = 'time filter (Asselin)' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource ) - - tzsource%cmnhname = 'NEST' - tzsource%clongname = 'nesting' - tzsource%lavailable = nmodel > 1 - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource ) - - tzsource%cmnhname = 'FRC' - tzsource%clongname = 'forcing' - tzsource%lavailable = lforcing - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource ) - - tzsource%cmnhname = '2DADV' - tzsource%clongname = 'advective forcing' - tzsource%lavailable = l2d_adv_frc - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource ) - - tzsource%cmnhname = '2DREL' - tzsource%clongname = 'relaxation forcing' - tzsource%lavailable = l2d_rel_frc - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource ) - - tzsource%cmnhname = 'NUD' - tzsource%clongname = 'nudging' - tzsource%lavailable = onudging - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource ) - - tzsource%cmnhname = 'DIF' - tzsource%clongname = 'numerical diffusion' - tzsource%lavailable = onumdifth - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource ) - - tzsource%cmnhname = 'REL' - tzsource%clongname = 'relaxation' - tzsource%lavailable = ohorelax_rv - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource ) - - tzsource%cmnhname = 'DCONV' - tzsource%clongname = 'KAFR convection' - tzsource%lavailable = hdconv == 'KAFR' .OR. hsconv == 'KAFR' - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource ) - - tzsource%cmnhname = 'VTURB' - tzsource%clongname = 'vertical turbulent diffusion' - tzsource%lavailable = hturb == 'TKEL' - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource ) - - tzsource%cmnhname = 'HTURB' - tzsource%clongname = 'horizontal turbulent diffusion' - tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM' - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource ) - - tzsource%cmnhname = 'NETUR' - tzsource%clongname = 'negativity correction induced by turbulence' - tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' & - .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource ) - - tzsource%cmnhname = 'MAFL' - tzsource%clongname = 'mass flux' - tzsource%lavailable = hsconv == 'EDKF' - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource ) - - tzsource%cmnhname = 'SNSUB' - tzsource%clongname = 'blowing snow sublimation' - tzsource%lavailable = lblowsnow .and. lsnowsubl - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource ) - - tzsource%cmnhname = 'VISC' - tzsource%clongname = 'viscosity' - tzsource%lavailable = lvisc .and. lvisc_r - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource ) - - tzsource%cmnhname = 'ADV' - tzsource%clongname = 'total advection' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource ) - - tzsource%cmnhname = 'NEADV' - tzsource%clongname = 'negativity correction induced by advection' - tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' & - .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource ) - - tzsource%cmnhname = 'NEGA' - tzsource%clongname = 'negativity correction' - tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' & - .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource ) - - tzsource%cmnhname = 'HENU' - tzsource%clongname = 'heterogeneous nucleation' - gtmp = cactccn == 'ABRK' .and. (lorilam .or. ldust .or. lsalt ) - tzsource%lavailable = ( hcloud == 'LIMA' .and. lwarm_lima .and. lacti_lima .and. nmod_ccn >= 1 & - .and. ( .not.lptsplit .or. .not.lsubg_cond ) ) & - .or. hcloud(1:3) == 'ICE' & - .or. ( hcloud == 'C2R2' .and. ( gtmp .or. .not.lsupsat_c2r2 ) ) & - .or. ( hcloud == 'KHKO' .and. ( gtmp .or. .not.lsupsat_c2r2 ) ) - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource ) - - tzsource%cmnhname = 'REVA' - tzsource%clongname = 'rain evaporation' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( ( .not. lptsplit .and. lwarm_lima .and. lrain_lima ) & - .or. lptsplit ) ) & - .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) & - .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) & - .or. ( hcloud == 'KHKO' .and. lrain_c2r2 ) & - .or. hcloud == 'KESS' - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource ) - - tzsource%cmnhname = 'HIND' - tzsource%clongname = 'heterogeneous nucleation by deposition' - tzsource%lavailable = hcloud == 'LIMA' .and. lcold_lima .and. lnucl_lima - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource ) - - tzsource%cmnhname = 'HONH' - tzsource%clongname = 'haze homogeneous nucleation' - tzsource%lavailable = hcloud == 'LIMA' .and. lcold_lima .and. lnucl_lima .and. lhhoni_lima .and. nmod_ccn >= 1 - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource ) - - tzsource%cmnhname = 'DEPS' - tzsource%clongname = 'deposition on snow' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lsnow_lima ) ) ) .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource ) - - tzsource%cmnhname = 'DEPG' - tzsource%clongname = 'deposition on graupel' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource ) - - tzsource%cmnhname = 'CEDS' - tzsource%clongname = 'adjustment to saturation' - tzsource%lavailable = hcloud == 'LIMA' - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource ) - - tzsource%cmnhname = 'ADJU' - tzsource%clongname = 'adjustment to saturation' - tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before .and. celec == 'NONE' - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource ) - - tzsource%cmnhname = 'COND' - tzsource%clongname = 'vapor condensation or cloud water evaporation' - tzsource%lavailable = hcloud == 'C2R2' .or. hcloud == 'KHKO' .or. hcloud == 'KESS' .or. hcloud == 'REVE' - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource ) - - tzsource%cmnhname = 'CORR' - tzsource%clongname = 'correction' - tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource ) - - tzsource%cmnhname = 'DEPI' - tzsource%clongname = 'deposition on ice' - tzsource%lavailable = ( hcloud(1:3) == 'ICE' .and. ( .not. lred .or. ( lred .and. ladj_after ) .or. celec /= 'NONE') ) & - .or. ( hcloud == 'LIMA' .and. lptsplit ) - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource ) - - tzsource%cmnhname = 'CORR2' - tzsource%clongname = 'supplementary correction inside LIMA splitting' - tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource ) - - tzsource%cmnhname = 'NECON' - tzsource%clongname = 'negativity correction induced by condensation' - tzsource%lavailable = ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' & - .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) & - .and. celec == 'NONE' - call Budget_source_add( tbudgets(NBUDGET_RV), tzsource ) - - - call Sourcelist_sort_compact( tbudgets(NBUDGET_RV) ) - - call Sourcelist_scan( tbudgets(NBUDGET_RV), cbulist_rrv ) -end if - -! Budget of RRC -tbudgets(NBUDGET_RC)%lenabled = lbu_rrc .and. krr >= 2 - -if ( tbudgets(NBUDGET_RC)%lenabled ) then - if ( hcloud(1:3) == 'ICE' .and. lred .and. lsedic_ice .and. ldeposc_ice ) & - call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'lred=T + lsedic=T + ldeposc=T:'// & - 'DEPO and SEDI source terms are mixed and stored in SEDI' ) - - tbudgets(NBUDGET_RC)%trhodj => tburhodj - - !Allocate all basic source terms (used or not) - !The size should be large enough (bigger than necessary is OK) - tbudgets(NBUDGET_RC)%nsourcesmax = NSOURCESMAX - allocate( tbudgets(NBUDGET_RC)%tsources(NSOURCESMAX) ) - - allocate( tbudgets(NBUDGET_RC)%xtmpstore(ibudim1, ibudim2, ibudim3) ) - - tbudgets(NBUDGET_RC)%tsources(:)%ngroup = 0 - - tzsource%ccomment = 'Budget of cloud water mixing ratio' - tzsource%ngrid = 1 - - tzsource%cunits = 'kg kg-1' - - tzsource%cmnhname = 'INIF' - tzsource%clongname = 'initial state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource, odonotinit = .true., ooverwrite = .true. ) - - tzsource%cmnhname = 'ENDF' - tzsource%clongname = 'final state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource, odonotinit = .true., ooverwrite = .true. ) - - tzsource%cmnhname = 'AVEF' - tzsource%clongname = 'averaged state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource, odonotinit = .true., ooverwrite = .false. ) - - tzsource%cunits = 's-1' - - tzsource%cmnhname = 'ASSE' - tzsource%clongname = 'time filter (Asselin)' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'NEST' - tzsource%clongname = 'nesting' - tzsource%lavailable = nmodel > 1 - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'FRC' - tzsource%clongname = 'forcing' - tzsource%lavailable = lforcing - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'DIF' - tzsource%clongname = 'numerical diffusion' - tzsource%lavailable = onumdifth - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'REL' - tzsource%clongname = 'relaxation' - tzsource%lavailable = ohorelax_rc - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'DCONV' - tzsource%clongname = 'KAFR convection' - tzsource%lavailable = hdconv == 'KAFR' .OR. hsconv == 'KAFR' - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'DEPOTR' - tzsource%clongname = 'tree droplet deposition' - tzsource%lavailable = odragtree .and. odepotree - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'VTURB' - tzsource%clongname = 'vertical turbulent diffusion' - tzsource%lavailable = hturb == 'TKEL' - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'HTURB' - tzsource%clongname = 'horizontal turbulent diffusion' - tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM' - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'NETUR' - tzsource%clongname = 'negativity correction induced by turbulence' - tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' & - .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'VISC' - tzsource%clongname = 'viscosity' - tzsource%lavailable = lvisc .and. lvisc_r - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'ADV' - tzsource%clongname = 'total advection' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'NEADV' - tzsource%clongname = 'negativity correction induced by advection' - tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' & - .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'NEGA' - tzsource%clongname = 'negativity correction' - tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' & - .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'CORR' - tzsource%clongname = 'correction' -! tzsource%lavailable = ( hcloud == 'LIMA' .and. lptsplit .and. lwarm_lima .and. lrain_lima ) & -! .or. ( hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' ) - tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'SEDI' - tzsource%clongname = 'sedimentation of cloud' - tzsource%lavailable = ( hcloud == 'LIMA' .and. lwarm_lima .and. lsedc_lima ) & - .or. ( hcloud(1:3) == 'ICE' .and. lsedic_ice ) & - .or. ( hcloud == 'C2R2' .and. lsedc_c2r2 ) & - .or. ( hcloud == 'KHKO' .and. lsedc_c2r2 ) - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'DEPO' - tzsource%clongname = 'surface droplet deposition' - tzsource%lavailable = ( hcloud == 'LIMA' .and. lwarm_lima .and. ldepoc_lima ) & - .or. ( hcloud == 'C2R2' .and. ldepoc_c2r2 ) & - .or. ( hcloud == 'KHKO' .and. ldepoc_c2r2 ) & - .or. ( hcloud(1:3) == 'ICE' .and. ldeposc_ice .and. celec == 'NONE' ) - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'R2C1' - tzsource%clongname = 'rain to cloud change after sedimentation' - tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit .and. lwarm_lima .and. lrain_lima - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'HENU' - tzsource%clongname = 'CCN activation' - gtmp = cactccn == 'ABRK' .and. (lorilam .or. ldust .or. lsalt ) - tzsource%lavailable = ( hcloud == 'LIMA' .and. lwarm_lima .and. lacti_lima .and. nmod_ccn >= 1 & - .and. ( .not.lptsplit .or. .not.lsubg_cond ) ) & - .or. ( hcloud == 'C2R2' .and. ( gtmp .or. .not.lsupsat_c2r2 ) ) & - .or. ( hcloud == 'KHKO' .and. ( gtmp .or. .not.lsupsat_c2r2 ) ) - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'HINC' - tzsource%clongname = 'heterogeneous nucleation by contact' - tzsource%lavailable = hcloud == 'LIMA' .and. lcold_lima .and. lnucl_lima - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'ADJU' - tzsource%clongname = 'adjustment to saturation' - tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before .and. celec == 'NONE' - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'HON' - tzsource%clongname = 'homogeneous nucleation' - tzsource%lavailable = hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'AUTO' - tzsource%clongname = 'autoconversion into rain' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lwarm_lima .and. lrain_lima ) ) ) & - .or. hcloud == 'KESS' & - .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) & - .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) & - .or. ( hcloud == 'KHKO' .and. lrain_c2r2 ) - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'ACCR' - tzsource%clongname = 'accretion of cloud droplets' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lwarm_lima .and. lrain_lima ) ) ) & - .or. hcloud == 'KESS' & - .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) & - .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) & - .or. ( hcloud == 'KHKO' .and. lrain_c2r2 ) - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'REVA' - tzsource%clongname = 'rain evaporation' - tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lwarm_lima .and. lrain_lima ) ) - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'HONC' - tzsource%clongname = 'droplet homogeneous freezing' - tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lnucl_lima ) ) - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'IMLT' - tzsource%clongname = 'melting of ice' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima ) ) ) .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'BERFI' - tzsource%clongname = 'Bergeron-Findeisen' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (lcold_lima .and. lwarm_lima) ) ) .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'RIM' - tzsource%clongname = 'riming of cloud water' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'CMEL' - tzsource%clongname = 'collection by snow and conversion into rain with T>XTT on ice' - tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'WETG' - tzsource%clongname = 'wet growth of graupel' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (lcold_lima .and. lwarm_lima .and. lsnow_lima) ) ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'DRYG' - tzsource%clongname = 'dry growth of graupel' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (lcold_lima .and. lwarm_lima .and. lsnow_lima) ) ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'CVRC' - tzsource%clongname = 'rain to cloud change after other microphysical processes' - tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'WETH' - tzsource%clongname = 'wet growth of hail' - tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lhail_lima .and. lcold_lima & - .and. lwarm_lima .and. lsnow_lima ) & - .or. hcloud == 'ICE4' - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'DRYH' - tzsource%clongname = 'dry growth of hail' - tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE' - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'CEDS' - tzsource%clongname = 'adjustment to saturation' - tzsource%lavailable = hcloud == 'LIMA' - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'DEPI' - tzsource%clongname = 'condensation/deposition on ice' - tzsource%lavailable = hcloud(1:3) == 'ICE' .and. ( .not. lred .or. ( lred .and. ladj_after ) .or. celec /= 'NONE' ) - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'COND' - tzsource%clongname = 'vapor condensation or cloud water evaporation' - tzsource%lavailable = hcloud == 'C2R2' .or. hcloud == 'KHKO' .or. hcloud == 'KESS' .or. hcloud == 'REVE' - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'CORR2' - tzsource%clongname = 'supplementary correction inside LIMA splitting' - tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - tzsource%cmnhname = 'NECON' - tzsource%clongname = 'negativity correction induced by condensation' - tzsource%lavailable = ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' & - .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) & - .and. celec == 'NONE' - call Budget_source_add( tbudgets(NBUDGET_RC), tzsource ) - - - call Sourcelist_sort_compact( tbudgets(NBUDGET_RC) ) - - call Sourcelist_scan( tbudgets(NBUDGET_RC), cbulist_rrc ) -end if - -! Budget of RRR -tbudgets(NBUDGET_RR)%lenabled = lbu_rrr .and. krr >= 3 - -if ( tbudgets(NBUDGET_RR)%lenabled ) then - tbudgets(NBUDGET_RR)%trhodj => tburhodj - - !Allocate all basic source terms (used or not) - !The size should be large enough (bigger than necessary is OK) - tbudgets(NBUDGET_RR)%nsourcesmax = NSOURCESMAX - allocate( tbudgets(NBUDGET_RR)%tsources(NSOURCESMAX) ) - - allocate( tbudgets(NBUDGET_RR)%xtmpstore(ibudim1, ibudim2, ibudim3) ) - - tbudgets(NBUDGET_RR)%tsources(:)%ngroup = 0 - - tzsource%ccomment = 'Budget of rain water mixing ratio' - tzsource%ngrid = 1 - - tzsource%cunits = 'kg kg-1' - - tzsource%cmnhname = 'INIF' - tzsource%clongname = 'initial state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RR), tzsource, odonotinit = .true., ooverwrite = .true. ) - - tzsource%cmnhname = 'ENDF' - tzsource%clongname = 'final state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RR), tzsource, odonotinit = .true., ooverwrite = .true. ) - - tzsource%cmnhname = 'AVEF' - tzsource%clongname = 'averaged state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RR), tzsource, odonotinit = .true., ooverwrite = .false. ) - - tzsource%cunits = 's-1' - - tzsource%cmnhname = 'ASSE' - tzsource%clongname = 'time filter (Asselin)' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RR), tzsource ) - - tzsource%cmnhname = 'NEST' - tzsource%clongname = 'nesting' - tzsource%lavailable = nmodel > 1 - call Budget_source_add( tbudgets(NBUDGET_RR), tzsource ) - - tzsource%cmnhname = 'FRC' - tzsource%clongname = 'forcing' - tzsource%lavailable = lforcing - call Budget_source_add( tbudgets(NBUDGET_RR), tzsource ) - - tzsource%cmnhname = 'DIF' - tzsource%clongname = 'numerical diffusion' - tzsource%lavailable = onumdifth - call Budget_source_add( tbudgets(NBUDGET_RR), tzsource ) - - tzsource%cmnhname = 'REL' - tzsource%clongname = 'relaxation' - tzsource%lavailable = ohorelax_rr - call Budget_source_add( tbudgets(NBUDGET_RR), tzsource ) - - tzsource%cmnhname = 'NETUR' - tzsource%clongname = 'negativity correction induced by turbulence' - tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) - call Budget_source_add( tbudgets(NBUDGET_RR), tzsource ) - - tzsource%cmnhname = 'VISC' - tzsource%clongname = 'viscosity' - tzsource%lavailable = lvisc .and. lvisc_r - call Budget_source_add( tbudgets(NBUDGET_RR), tzsource ) - - tzsource%cmnhname = 'ADV' - tzsource%clongname = 'total advection' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RR), tzsource ) - - tzsource%cmnhname = 'NEADV' - tzsource%clongname = 'negativity correction induced by advection' - tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' & - .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' - call Budget_source_add( tbudgets(NBUDGET_RR), tzsource ) - - tzsource%cmnhname = 'NEGA' - tzsource%clongname = 'negativity correction' - tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' & - .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' - call Budget_source_add( tbudgets(NBUDGET_RR), tzsource ) - - tzsource%cmnhname = 'CORR' - tzsource%clongname = 'correction' -! tzsource%lavailable = ( hcloud == 'LIMA' .and. lptsplit .and. lwarm_lima .and. lrain_lima ) & -! .or. ( hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' ) - tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' - call Budget_source_add( tbudgets(NBUDGET_RR), tzsource ) - - tzsource%cmnhname = 'SEDI' - tzsource%clongname = 'sedimentation of rain drops' - tzsource%lavailable = ( hcloud == 'LIMA' .and. lwarm_lima .and. lrain_lima ) & - .or. hcloud == 'KESS' & - .or. hcloud(1:3) == 'ICE' & - .or. hcloud == 'C2R2' & - .or. hcloud == 'KHKO' - call Budget_source_add( tbudgets(NBUDGET_RR), tzsource ) - - tzsource%cmnhname = 'R2C1' - tzsource%clongname = 'rain to cloud change after sedimentation' - tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit .and. lwarm_lima .and. lrain_lima - call Budget_source_add( tbudgets(NBUDGET_RR), tzsource ) - - tzsource%cmnhname = 'AUTO' - tzsource%clongname = 'autoconversion into rain' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lwarm_lima .and. lrain_lima ) ) ) & - .or. hcloud == 'KESS' & - .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) & - .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) & - .or. ( hcloud == 'KHKO' .and. lrain_c2r2 ) - call Budget_source_add( tbudgets(NBUDGET_RR), tzsource ) - - tzsource%cmnhname = 'ACCR' - tzsource%clongname = 'accretion of cloud droplets' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lwarm_lima .and. lrain_lima ) ) ) & - .or. hcloud == 'KESS' & - .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) & - .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) & - .or. ( hcloud == 'KHKO' .and. lrain_c2r2 ) - call Budget_source_add( tbudgets(NBUDGET_RR), tzsource ) - - tzsource%cmnhname = 'REVA' - tzsource%clongname = 'rain evaporation' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lwarm_lima .and. lrain_lima ) ) ) & - .or. hcloud == 'KESS' & - .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) & - .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) & - .or. ( hcloud == 'KHKO' .and. lrain_c2r2 ) - call Budget_source_add( tbudgets(NBUDGET_RR), tzsource ) - - tzsource%cmnhname = 'HONR' - tzsource%clongname = 'rain homogeneous freezing' - tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lnucl_lima .and. lrain_lima ) ) - call Budget_source_add( tbudgets(NBUDGET_RR), tzsource ) - - - tzsource%cmnhname = 'ACC' - tzsource%clongname = 'accretion of rain on aggregates' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima & - .and. lsnow_lima .and. lrain_lima) ) ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RR), tzsource ) - - tzsource%cmnhname = 'CMEL' - tzsource%clongname = 'collection of droplets by snow and conversion into rain' - tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' - call Budget_source_add( tbudgets(NBUDGET_RR), tzsource ) - - tzsource%cmnhname = 'CFRZ' - tzsource%clongname = 'conversion freezing of rain' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (lcold_lima .and. lwarm_lima .and. lsnow_lima) ) ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RR), tzsource ) - - tzsource%cmnhname = 'WETG' - tzsource%clongname = 'wet growth of graupel' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (lcold_lima .and. lwarm_lima .and. lsnow_lima) ) ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RR), tzsource ) - - tzsource%cmnhname = 'DRYG' - tzsource%clongname = 'dry growth of graupel' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (lcold_lima .and. lwarm_lima .and. lsnow_lima) ) ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RR), tzsource ) - - tzsource%cmnhname = 'GMLT' - tzsource%clongname = 'graupel melting' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (lcold_lima .and. lwarm_lima .and. lsnow_lima) ) ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RR), tzsource ) - - tzsource%cmnhname = 'CVRC' - tzsource%clongname = 'rain to cloud change after other microphysical processes' - tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit - call Budget_source_add( tbudgets(NBUDGET_RR), tzsource ) - - tzsource%cmnhname = 'WETH' - tzsource%clongname = 'wet growth of hail' - tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lhail_lima .and. lcold_lima & - .and. lwarm_lima .and. lsnow_lima ) & - .or. hcloud == 'ICE4' - call Budget_source_add( tbudgets(NBUDGET_RR), tzsource ) - - tzsource%cmnhname = 'DRYH' - tzsource%clongname = 'dry growth of hail' - tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE' - call Budget_source_add( tbudgets(NBUDGET_RR), tzsource ) - - tzsource%cmnhname = 'HMLT' - tzsource%clongname = 'melting of hail' - tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lhail_lima .and. lcold_lima & - .and. lwarm_lima .and. lsnow_lima ) & - .or. hcloud == 'ICE4' - call Budget_source_add( tbudgets(NBUDGET_RR), tzsource ) - - tzsource%cmnhname = 'SFR' - tzsource%clongname = 'spontaneous freezing' - tzsource%lavailable = hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RR), tzsource ) - -!PW: a documenter - tzsource%cmnhname = 'CORR2' - tzsource%clongname = 'supplementary correction inside LIMA splitting' - tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit - call Budget_source_add( tbudgets(NBUDGET_RR), tzsource ) - - tzsource%cmnhname = 'NECON' - tzsource%clongname = 'negativity correction induced by condensation' - tzsource%lavailable = ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' & - .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) & - .and. celec == 'NONE' - call Budget_source_add( tbudgets(NBUDGET_RR), tzsource ) - - - call Sourcelist_sort_compact( tbudgets(NBUDGET_RR) ) - - call Sourcelist_scan( tbudgets(NBUDGET_RR), cbulist_rrr ) -end if - -! Budget of RRI -tbudgets(NBUDGET_RI)%lenabled = lbu_rri .and. krr >= 4 - -if ( tbudgets(NBUDGET_RI)%lenabled ) then - tbudgets(NBUDGET_RI)%trhodj => tburhodj - - !Allocate all basic source terms (used or not) - !The size should be large enough (bigger than necessary is OK) - tbudgets(NBUDGET_RI)%nsourcesmax = NSOURCESMAX - allocate( tbudgets(NBUDGET_RI)%tsources(NSOURCESMAX) ) - - allocate( tbudgets(NBUDGET_RI)%xtmpstore(ibudim1, ibudim2, ibudim3) ) - - tbudgets(NBUDGET_RI)%tsources(:)%ngroup = 0 - - tzsource%ccomment = 'Budget of cloud ice mixing ratio' - tzsource%ngrid = 1 - - tzsource%cunits = 'kg kg-1' - - tzsource%cmnhname = 'INIF' - tzsource%clongname = 'initial state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource, odonotinit = .true., ooverwrite = .true. ) - - tzsource%cmnhname = 'ENDF' - tzsource%clongname = 'final state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource, odonotinit = .true., ooverwrite = .true. ) - - tzsource%cmnhname = 'AVEF' - tzsource%clongname = 'averaged state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource, odonotinit = .true., ooverwrite = .false. ) - - tzsource%cunits = 's-1' - - tzsource%cmnhname = 'ASSE' - tzsource%clongname = 'time filter (Asselin)' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'NEST' - tzsource%clongname = 'nesting' - tzsource%lavailable = nmodel > 1 - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'FRC' - tzsource%clongname = 'forcing' - tzsource%lavailable = lforcing - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'DIF' - tzsource%clongname = 'numerical diffusion' - tzsource%lavailable = onumdifth - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'REL' - tzsource%clongname = 'relaxation' - tzsource%lavailable = ohorelax_ri - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'DCONV' - tzsource%clongname = 'KAFR convection' - tzsource%lavailable = hdconv == 'KAFR' .OR. hsconv == 'KAFR' - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'VTURB' - tzsource%clongname = 'vertical turbulent diffusion' - tzsource%lavailable = hturb == 'TKEL' - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'HTURB' - tzsource%clongname = 'horizontal turbulent diffusion' - tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM' - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'NETUR' - tzsource%clongname = 'negativity correction induced by turbulence' - tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'LIMA' ) - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'VISC' - tzsource%clongname = 'viscosity' - tzsource%lavailable = lvisc .and. lvisc_r - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'ADV' - tzsource%clongname = 'total advection' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'NEADV' - tzsource%clongname = 'negativity correction induced by advection' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'NEGA' - tzsource%clongname = 'negativity correction' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'CORR' - tzsource%clongname = 'correction' -! tzsource%lavailable = ( hcloud == 'LIMA' .and. lptsplit .and. lcold_lima .and. lsnow_lima ) & -! .or. ( hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' ) - tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'ADJU' - tzsource%clongname = 'adjustment to saturation' - tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before .and. celec == 'NONE' - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'SEDI' - tzsource%clongname = 'sedimentation of rain drops' - tzsource%lavailable = ( hcloud == 'LIMA' .and. lcold_lima .and. lsedi_lima ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'HENU' - tzsource%clongname = 'heterogeneous nucleation' - tzsource%lavailable = hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'HIND' - tzsource%clongname = 'heterogeneous nucleation by deposition' - tzsource%lavailable = hcloud == 'LIMA' .and. lcold_lima .and. lnucl_lima - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'HINC' - tzsource%clongname = 'heterogeneous nucleation by contact' - tzsource%lavailable = hcloud == 'LIMA' .and. lcold_lima .and. lnucl_lima - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'HON' - tzsource%clongname = 'homogeneous nucleation' - tzsource%lavailable = hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'HONH' - tzsource%clongname = 'haze homogeneous nucleation' - tzsource%lavailable = hcloud == 'LIMA' .and. lcold_lima .and. lnucl_lima .and. lhhoni_lima .and. nmod_ccn >= 1 - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'HONC' - tzsource%clongname = 'droplet homogeneous freezing' - tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lnucl_lima ) ) - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'CNVI' - tzsource%clongname = 'conversion of snow to cloud ice' - tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lsnow_lima ) ) - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'CNVS' - tzsource%clongname = 'conversion of pristine ice to snow' - tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lsnow_lima ) ) - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'AGGS' - tzsource%clongname = 'aggregation of snow' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lsnow_lima ) ) ) .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'AUTS' - tzsource%clongname = 'autoconversion of ice' - tzsource%lavailable = hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'IMLT' - tzsource%clongname = 'melting of ice' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima ) ) ) .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'BERFI' - tzsource%clongname = 'Bergeron-Findeisen' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima ) ) ) .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'HMS' - tzsource%clongname = 'Hallett-Mossop ice multiplication process due to snow riming' - tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'CIBU' - tzsource%clongname = 'ice multiplication process due to ice collisional breakup' - tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lcold_lima .and. lwarm_lima .and. lsnow_lima .and. lcibu ) - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'CFRZ' - tzsource%clongname = 'conversion freezing of rain' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'RDSF' - tzsource%clongname = 'ice multiplication process following rain contact freezing' - tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lcold_lima .and. lwarm_lima .and. lsnow_lima .and. lrdsf ) - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'WETG' - tzsource%clongname = 'wet growth of graupel' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'DRYG' - tzsource%clongname = 'dry growth of graupel' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'HMG' - tzsource%clongname = 'Hallett-Mossop ice multiplication process due to graupel riming' - tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'WETH' - tzsource%clongname = 'wet growth of hail' - tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lhail_lima .and. lcold_lima & - .and. lwarm_lima .and. lsnow_lima ) & - .or. hcloud == 'ICE4' - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'DRYH' - tzsource%clongname = 'dry growth of hail' - tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE' - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'CEDS' - tzsource%clongname = 'adjustment to saturation' - tzsource%lavailable = hcloud == 'LIMA' - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'DEPI' - tzsource%clongname = 'condensation/deposition on ice' - tzsource%lavailable = ( hcloud(1:3) == 'ICE' .and. ( .not. lred .or. ( lred .and. ladj_after ) .or. celec /= 'NONE') ) & - .or. ( hcloud == 'LIMA' .and. lptsplit ) - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'CORR2' - tzsource%clongname = 'supplementary correction inside LIMA splitting' - tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - tzsource%cmnhname = 'NECON' - tzsource%clongname = 'negativity correction induced by condensation' - tzsource%lavailable = celec == 'NONE' - call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) - - - call Sourcelist_sort_compact( tbudgets(NBUDGET_RI) ) - - call Sourcelist_scan( tbudgets(NBUDGET_RI), cbulist_rri ) -end if - -! Budget of RRS -tbudgets(NBUDGET_RS)%lenabled = lbu_rrs .and. krr >= 5 - -if ( tbudgets(NBUDGET_RS)%lenabled ) then - tbudgets(NBUDGET_RS)%trhodj => tburhodj - - !Allocate all basic source terms (used or not) - !The size should be large enough (bigger than necessary is OK) - tbudgets(NBUDGET_RS)%nsourcesmax = NSOURCESMAX - allocate( tbudgets(NBUDGET_RS)%tsources(NSOURCESMAX) ) - - allocate( tbudgets(NBUDGET_RS)%xtmpstore(ibudim1, ibudim2, ibudim3) ) - - tbudgets(NBUDGET_RS)%tsources(:)%ngroup = 0 - - tzsource%ccomment = 'Budget of snow/aggregate mixing ratio' - tzsource%ngrid = 1 - - tzsource%cunits = 'kg kg-1' - - tzsource%cmnhname = 'INIF' - tzsource%clongname = 'initial state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RS), tzsource, odonotinit = .true., ooverwrite = .true. ) - - tzsource%cmnhname = 'ENDF' - tzsource%clongname = 'final state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RS), tzsource, odonotinit = .true., ooverwrite = .true. ) - - tzsource%cmnhname = 'AVEF' - tzsource%clongname = 'averaged state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RS), tzsource, odonotinit = .true., ooverwrite = .false. ) - - tzsource%cunits = 's-1' - - tzsource%cmnhname = 'ASSE' - tzsource%clongname = 'time filter (Asselin)' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RS), tzsource ) - - tzsource%cmnhname = 'NEST' - tzsource%clongname = 'nesting' - tzsource%lavailable = nmodel > 1 - call Budget_source_add( tbudgets(NBUDGET_RS), tzsource ) - - tzsource%cmnhname = 'FRC' - tzsource%clongname = 'forcing' - tzsource%lavailable = lforcing - call Budget_source_add( tbudgets(NBUDGET_RS), tzsource ) - - tzsource%cmnhname = 'DIF' - tzsource%clongname = 'numerical diffusion' - tzsource%lavailable = onumdifth - call Budget_source_add( tbudgets(NBUDGET_RS), tzsource ) - - tzsource%cmnhname = 'REL' - tzsource%clongname = 'relaxation' - tzsource%lavailable = ohorelax_rs - call Budget_source_add( tbudgets(NBUDGET_RS), tzsource ) - -! tzsource%cmnhname = 'NETUR' -! tzsource%clongname = 'negativity correction induced by turbulence' -! tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' & -! .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) -! call Budget_source_add( tbudgets(NBUDGET_RS), tzsource nneturrs ) - - tzsource%cmnhname = 'VISC' - tzsource%clongname = 'viscosity' - tzsource%lavailable = lvisc .and. lvisc_r - call Budget_source_add( tbudgets(NBUDGET_RS), tzsource ) - - tzsource%cmnhname = 'ADV' - tzsource%clongname = 'total advection' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RS), tzsource ) - - tzsource%cmnhname = 'NEADV' - tzsource%clongname = 'negativity correction induced by advection' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RS), tzsource ) - - tzsource%cmnhname = 'NEGA' - tzsource%clongname = 'negativity correction' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RS), tzsource ) - - tzsource%cmnhname = 'CORR' - tzsource%clongname = 'correction' -! tzsource%lavailable = ( hcloud == 'LIMA' .and. lptsplit .and. lcold_lima .and. lsnow_lima ) & -! .or. ( hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' ) - tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' - call Budget_source_add( tbudgets(NBUDGET_RS), tzsource ) - - tzsource%cmnhname = 'SEDI' - tzsource%clongname = 'sedimentation' - tzsource%lavailable = ( hcloud == 'LIMA' .and. lcold_lima .and. lsnow_lima ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RS), tzsource ) - - tzsource%cmnhname = 'CNVI' - tzsource%clongname = 'conversion of snow to cloud ice' - tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lsnow_lima ) ) - call Budget_source_add( tbudgets(NBUDGET_RS), tzsource ) - - tzsource%cmnhname = 'DEPS' - tzsource%clongname = 'deposition on snow' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lsnow_lima ) ) ) .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RS), tzsource ) - - tzsource%cmnhname = 'CNVS' - tzsource%clongname = 'conversion of pristine ice to snow' - tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lsnow_lima ) ) - call Budget_source_add( tbudgets(NBUDGET_RS), tzsource ) - - tzsource%cmnhname = 'AGGS' - tzsource%clongname = 'aggregation of snow' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lsnow_lima ) ) ) .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RS), tzsource ) - - tzsource%cmnhname = 'AUTS' - tzsource%clongname = 'autoconversion of ice' - tzsource%lavailable = hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RS), tzsource ) - - tzsource%cmnhname = 'RIM' - tzsource%clongname = 'riming of cloud water' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RS), tzsource ) - - tzsource%cmnhname = 'HMS' - tzsource%clongname = 'Hallett-Mossop ice multiplication process due to snow riming' - tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. (lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) - call Budget_source_add( tbudgets(NBUDGET_RS), tzsource ) - - tzsource%cmnhname = 'CIBU' - tzsource%clongname = 'ice multiplication process due to ice collisional breakup' - tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lcold_lima .and. lwarm_lima .and. lsnow_lima .and. lcibu ) - call Budget_source_add( tbudgets(NBUDGET_RS), tzsource ) - - tzsource%cmnhname = 'ACC' - tzsource%clongname = 'accretion of rain on snow' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima & - .and. lsnow_lima .and. lrain_lima) ) ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RS), tzsource ) - - tzsource%cmnhname = 'CMEL' - tzsource%clongname = 'conversion melting' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RS), tzsource ) - - tzsource%cmnhname = 'WETG' - tzsource%clongname = 'wet growth of graupel' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RS), tzsource ) - - tzsource%cmnhname = 'DRYG' - tzsource%clongname = 'dry growth of graupel' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RS), tzsource ) - - tzsource%cmnhname = 'WETH' - tzsource%clongname = 'wet growth of hail' - tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lhail_lima .and. lcold_lima & - .and. lwarm_lima .and. lsnow_lima ) & - .or. hcloud == 'ICE4' - call Budget_source_add( tbudgets(NBUDGET_RS), tzsource ) - - tzsource%cmnhname = 'DRYH' - tzsource%clongname = 'dry growth of hail' - tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE' - call Budget_source_add( tbudgets(NBUDGET_RS), tzsource ) - - tzsource%cmnhname = 'NECON' - tzsource%clongname = 'negativity correction induced by condensation' - tzsource%lavailable = celec == 'NONE' - call Budget_source_add( tbudgets(NBUDGET_RS), tzsource ) - - - call Sourcelist_sort_compact( tbudgets(NBUDGET_RS) ) - - call Sourcelist_scan( tbudgets(NBUDGET_RS), cbulist_rrs ) -end if - -! Budget of RRG -tbudgets(NBUDGET_RG)%lenabled = lbu_rrg .and. krr >= 6 - -if ( tbudgets(NBUDGET_RG)%lenabled ) then - tbudgets(NBUDGET_RG)%trhodj => tburhodj - - !Allocate all basic source terms (used or not) - !The size should be large enough (bigger than necessary is OK) - tbudgets(NBUDGET_RG)%nsourcesmax = NSOURCESMAX - allocate( tbudgets(NBUDGET_RG)%tsources(NSOURCESMAX) ) - - allocate( tbudgets(NBUDGET_RG)%xtmpstore(ibudim1, ibudim2, ibudim3) ) - - tbudgets(NBUDGET_RG)%tsources(:)%ngroup = 0 - - tzsource%ccomment = 'Budget of graupel mixing ratio' - tzsource%ngrid = 1 - - tzsource%cunits = 'kg kg-1' - - tzsource%cmnhname = 'INIF' - tzsource%clongname = 'initial state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RG), tzsource, odonotinit = .true., ooverwrite = .true. ) - - tzsource%cmnhname = 'ENDF' - tzsource%clongname = 'final state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RG), tzsource, odonotinit = .true., ooverwrite = .true. ) - - tzsource%cmnhname = 'AVEF' - tzsource%clongname = 'averaged state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RG), tzsource, odonotinit = .true., ooverwrite = .false. ) - - tzsource%cunits = 's-1' - - tzsource%cmnhname = 'ASSE' - tzsource%clongname = 'time filter (Asselin)' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RG), tzsource ) - - tzsource%cmnhname = 'NEST' - tzsource%clongname = 'nesting' - tzsource%lavailable = nmodel > 1 - call Budget_source_add( tbudgets(NBUDGET_RG), tzsource ) - - tzsource%cmnhname = 'FRC' - tzsource%clongname = 'forcing' - tzsource%lavailable = lforcing - call Budget_source_add( tbudgets(NBUDGET_RG), tzsource ) - - tzsource%cmnhname = 'DIF' - tzsource%clongname = 'numerical diffusion' - tzsource%lavailable = onumdifth - call Budget_source_add( tbudgets(NBUDGET_RG), tzsource ) - - tzsource%cmnhname = 'REL' - tzsource%clongname = 'relaxation' - tzsource%lavailable = ohorelax_rg - call Budget_source_add( tbudgets(NBUDGET_RG), tzsource ) - -! tzsource%cmnhname = 'NETUR' -! tzsource%clongname = 'negativity correction induced by turbulence' -! tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' & -! .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) -! call Budget_source_add( tbudgets(NBUDGET_RG), tzsource nneturrg ) - - tzsource%cmnhname = 'VISC' - tzsource%clongname = 'viscosity' - tzsource%lavailable = lvisc .and. lvisc_r - call Budget_source_add( tbudgets(NBUDGET_RG), tzsource ) - - tzsource%cmnhname = 'ADV' - tzsource%clongname = 'total advection' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RG), tzsource ) - - tzsource%cmnhname = 'NEADV' - tzsource%clongname = 'negativity correction induced by advection' - tzsource%lavailable = hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'LIMA' - call Budget_source_add( tbudgets(NBUDGET_RG), tzsource ) - - tzsource%cmnhname = 'NEGA' - tzsource%clongname = 'negativity correction' - tzsource%lavailable = hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'LIMA' - call Budget_source_add( tbudgets(NBUDGET_RG), tzsource ) - - tzsource%cmnhname = 'CORR' - tzsource%clongname = 'correction' - tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' - call Budget_source_add( tbudgets(NBUDGET_RG), tzsource ) - - tzsource%cmnhname = 'SEDI' - tzsource%clongname = 'sedimentation' - tzsource%lavailable = ( hcloud == 'LIMA' .and. lcold_lima .and. lsnow_lima ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RG), tzsource ) - - tzsource%cmnhname = 'HONR' - tzsource%clongname = 'rain homogeneous freezing' - tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lnucl_lima .and. lrain_lima ) ) - call Budget_source_add( tbudgets(NBUDGET_RG), tzsource ) - - tzsource%cmnhname = 'SFR' - tzsource%clongname = 'spontaneous freezing' - tzsource%lavailable = hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RG), tzsource ) - - tzsource%cmnhname = 'DEPG' - tzsource%clongname = 'deposition on graupel' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RG), tzsource ) - - tzsource%cmnhname = 'RIM' - tzsource%clongname = 'riming of cloud water' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RG), tzsource ) - - tzsource%cmnhname = 'ACC' - tzsource%clongname = 'accretion of rain on graupel' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima & - .and. lsnow_lima .and. lrain_lima) ) ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RG), tzsource ) - - tzsource%cmnhname = 'CMEL' - tzsource%clongname = 'conversion melting of snow' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (lcold_lima .and. lwarm_lima .and. lsnow_lima) ) ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RG), tzsource ) - - tzsource%cmnhname = 'CFRZ' - tzsource%clongname = 'conversion freezing of rain' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (lcold_lima .and. lwarm_lima .and. lsnow_lima) ) ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RG), tzsource ) - - tzsource%cmnhname = 'RDSF' - tzsource%clongname = 'ice multiplication process following rain contact freezing' - tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lcold_lima .and. lwarm_lima .and. lsnow_lima .and. lrdsf ) - call Budget_source_add( tbudgets(NBUDGET_RG), tzsource ) - - tzsource%cmnhname = 'WETG' - tzsource%clongname = 'wet growth of graupel' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (lcold_lima .and. lwarm_lima .and. lsnow_lima) ) ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RG), tzsource ) - - tzsource%cmnhname = 'GHCV' - tzsource%clongname = 'graupel to hail conversion' - tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE' - call Budget_source_add( tbudgets(NBUDGET_RG), tzsource ) - - tzsource%cmnhname = 'DRYG' - tzsource%clongname = 'dry growth of graupel' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (lcold_lima .and. lwarm_lima .and. lsnow_lima) ) ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RG), tzsource ) - - tzsource%cmnhname = 'HMG' - tzsource%clongname = 'Hallett-Mossop ice multiplication process due to graupel riming' - tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. (lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) - call Budget_source_add( tbudgets(NBUDGET_RG), tzsource ) - - tzsource%cmnhname = 'GMLT' - tzsource%clongname = 'graupel melting' - tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (lcold_lima .and. lwarm_lima .and. lsnow_lima) ) ) & - .or. hcloud(1:3) == 'ICE' - call Budget_source_add( tbudgets(NBUDGET_RG), tzsource ) - - tzsource%cmnhname = 'WETH' - tzsource%clongname = 'wet growth of hail' - tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lhail_lima .and. lcold_lima & - .and. lwarm_lima .and. lsnow_lima ) & - .or. hcloud == 'ICE4' - call Budget_source_add( tbudgets(NBUDGET_RG), tzsource ) - - tzsource%cmnhname = 'COHG' - tzsource%clongname = 'conversion of hail to graupel' - tzsource%lavailable = hcloud == 'LIMA' .and. .not.lptsplit .and. lhail_lima .and. lcold_lima .and. lwarm_lima .and. lsnow_lima - call Budget_source_add( tbudgets(NBUDGET_RG), tzsource ) - - tzsource%cmnhname = 'HGCV' - tzsource%clongname = 'hail to graupel conversion' - tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE' - call Budget_source_add( tbudgets(NBUDGET_RG), tzsource ) - - tzsource%cmnhname = 'DRYH' - tzsource%clongname = 'dry growth of hail' - tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE' - call Budget_source_add( tbudgets(NBUDGET_RG), tzsource ) - - tzsource%cmnhname = 'NECON' - tzsource%clongname = 'negativity correction induced by condensation' - tzsource%lavailable = ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' & - .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) & - .and. celec == 'NONE' - call Budget_source_add( tbudgets(NBUDGET_RG), tzsource ) - - - call Sourcelist_sort_compact( tbudgets(NBUDGET_RG) ) - - call Sourcelist_scan( tbudgets(NBUDGET_RG), cbulist_rrg ) -end if - -! Budget of RRH -tbudgets(NBUDGET_RH)%lenabled = lbu_rrh .and. krr >= 7 - -if ( tbudgets(NBUDGET_RH)%lenabled ) then - tbudgets(NBUDGET_RH)%trhodj => tburhodj - - !Allocate all basic source terms (used or not) - !The size should be large enough (bigger than necessary is OK) - tbudgets(NBUDGET_RH)%nsourcesmax = NSOURCESMAX - allocate( tbudgets(NBUDGET_RH)%tsources(NSOURCESMAX) ) - - allocate( tbudgets(NBUDGET_RH)%xtmpstore(ibudim1, ibudim2, ibudim3) ) - - tbudgets(NBUDGET_RH)%tsources(:)%ngroup = 0 - - tzsource%ccomment = 'Budget of hail mixing ratio' - tzsource%ngrid = 1 - - tzsource%cunits = 'kg kg-1' - - tzsource%cmnhname = 'INIF' - tzsource%clongname = 'initial state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RH), tzsource, odonotinit = .true., ooverwrite = .true. ) - - tzsource%cmnhname = 'ENDF' - tzsource%clongname = 'final state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RH), tzsource, odonotinit = .true., ooverwrite = .true. ) - - tzsource%cmnhname = 'AVEF' - tzsource%clongname = 'averaged state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RH), tzsource, odonotinit = .true., ooverwrite = .false. ) - - tzsource%cunits = 's-1' - - tzsource%cmnhname = 'ASSE' - tzsource%clongname = 'time filter (Asselin)' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RH), tzsource ) - - tzsource%cmnhname = 'NEST' - tzsource%clongname = 'nesting' - tzsource%lavailable = nmodel > 1 - call Budget_source_add( tbudgets(NBUDGET_RH), tzsource ) - - tzsource%cmnhname = 'FRC' - tzsource%clongname = 'forcing' - tzsource%lavailable = lforcing - call Budget_source_add( tbudgets(NBUDGET_RH), tzsource ) - - tzsource%cmnhname = 'DIF' - tzsource%clongname = 'numerical diffusion' - tzsource%lavailable = onumdifth - call Budget_source_add( tbudgets(NBUDGET_RH), tzsource ) - - tzsource%cmnhname = 'REL' - tzsource%clongname = 'relaxation' - tzsource%lavailable = ohorelax_rh - call Budget_source_add( tbudgets(NBUDGET_RH), tzsource ) - -! tzsource%cmnhname = 'NETUR' -! tzsource%clongname = 'negativity correction induced by turbulence' -! tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' & -! .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) -! call Budget_source_add( tbudgets(NBUDGET_RH), tzsource nneturrh ) - - tzsource%cmnhname = 'VISC' - tzsource%clongname = 'viscosity' - tzsource%lavailable = lvisc .and. lvisc_r - call Budget_source_add( tbudgets(NBUDGET_RH), tzsource ) - - tzsource%cmnhname = 'ADV' - tzsource%clongname = 'total advection' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RH), tzsource ) - - tzsource%cmnhname = 'NEADV' - tzsource%clongname = 'negativity correction induced by advection' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RH), tzsource ) - - tzsource%cmnhname = 'NEGA' - tzsource%clongname = 'negativity correction' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(NBUDGET_RH), tzsource ) - - tzsource%cmnhname = 'SEDI' - tzsource%clongname = 'sedimentation' - tzsource%lavailable = ( hcloud == 'LIMA' .and. lcold_lima .and. lhail_lima ) & - .or. hcloud == 'ICE4' - call Budget_source_add( tbudgets(NBUDGET_RH), tzsource ) - - tzsource%cmnhname = 'GHCV' - tzsource%clongname = 'graupel to hail conversion' - tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE' - call Budget_source_add( tbudgets(NBUDGET_RH), tzsource ) - - tzsource%cmnhname = 'WETG' - tzsource%clongname = 'wet growth of graupel' - tzsource%lavailable = ( hcloud == 'LIMA' .and. lhail_lima & - .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) & - .or. ( hcloud == 'ICE4' .and. ( .not. lred .or. celec /= 'NONE' ) ) - call Budget_source_add( tbudgets(NBUDGET_RH), tzsource ) - - tzsource%cmnhname = 'WETH' - tzsource%clongname = 'wet growth of hail' - tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lhail_lima .and. lcold_lima & - .and. lwarm_lima .and. lsnow_lima ) & - .or. hcloud == 'ICE4' - call Budget_source_add( tbudgets(NBUDGET_RH), tzsource ) - - tzsource%cmnhname = 'COHG' - tzsource%clongname = 'conversion from hail to graupel' - tzsource%lavailable = hcloud == 'LIMA' .and. .not.lptsplit .and. lhail_lima .and. lcold_lima & - .and. lwarm_lima .and. lsnow_lima - call Budget_source_add( tbudgets(NBUDGET_RH), tzsource ) - - tzsource%cmnhname = 'HGCV' - tzsource%clongname = 'hail to graupel conversion' - tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE' - call Budget_source_add( tbudgets(NBUDGET_RH), tzsource ) - - tzsource%cmnhname = 'DRYH' - tzsource%clongname = 'dry growth of hail' - tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE' - call Budget_source_add( tbudgets(NBUDGET_RH), tzsource ) - - tzsource%cmnhname = 'HMLT' - tzsource%clongname = 'melting of hail' - tzsource%lavailable = ( hcloud == 'LIMA' .and. .not. lptsplit .and. lhail_lima .and. lcold_lima & - .and. lwarm_lima .and. lsnow_lima ) & - .or. hcloud == 'ICE4' - call Budget_source_add( tbudgets(NBUDGET_RH), tzsource ) - - tzsource%cmnhname = 'CORR' - tzsource%clongname = 'correction' - tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE' - call Budget_source_add( tbudgets(NBUDGET_RH), tzsource ) - - tzsource%cmnhname = 'NECON' - tzsource%clongname = 'negativity correction induced by condensation' - tzsource%lavailable = celec == 'NONE' - call Budget_source_add( tbudgets(NBUDGET_RH), tzsource ) - - - call Sourcelist_sort_compact( tbudgets(NBUDGET_RH) ) - - call Sourcelist_scan( tbudgets(NBUDGET_RH), cbulist_rrh ) -end if - -! Budgets of RSV (scalar variables) - -if ( ksv > 999 ) call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', 'number of scalar variables > 999' ) - -SV_BUDGETS: do jsv = 1, ksv - ibudget = NBUDGET_SV1 - 1 + jsv - - tbudgets(ibudget)%lenabled = lbu_rsv - - if ( lbu_rsv ) then - tbudgets(ibudget)%trhodj => tburhodj - - !Allocate all basic source terms (used or not) - !The size should be large enough (bigger than necessary is OK) - tbudgets(ibudget)%nsourcesmax = NSOURCESMAX - allocate( tbudgets(ibudget)%tsources(NSOURCESMAX) ) - - allocate( tbudgets(ibudget)%xtmpstore(ibudim1, ibudim2, ibudim3) ) - - tbudgets(ibudget)%tsources(:)%ngroup = 0 - - tzsource%ccomment = 'Budget of scalar variable ' // csvnames(jsv) - tzsource%ngrid = 1 - - tzsource%cunits = '1' - - tzsource%cmnhname = 'INIF' - tzsource%clongname = 'initial state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource, odonotinit = .true., ooverwrite = .true. ) - - tzsource%cmnhname = 'ENDF' - tzsource%clongname = 'final state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource, odonotinit = .true., ooverwrite = .true. ) - - tzsource%cmnhname = 'AVEF' - tzsource%clongname = 'averaged state' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource, odonotinit = .true., ooverwrite = .false. ) - - tzsource%cunits = 's-1' - - tzsource%cmnhname = 'ASSE' - tzsource%clongname = 'time filter (Asselin)' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'NEST' - tzsource%clongname = 'nesting' - tzsource%lavailable = nmodel > 1 - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'FRC' - tzsource%clongname = 'forcing' - tzsource%lavailable = lforcing - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'DIF' - tzsource%clongname = 'numerical diffusion' - tzsource%lavailable = onumdifsv - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'REL' - tzsource%clongname = 'relaxation' - tzsource%lavailable = ohorelax_sv( jsv ) .or. ( celec /= 'NONE' .and. lrelax2fw_ion & - .and. (jsv == nsv_elecbeg .or. jsv == nsv_elecend ) ) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'DCONV' - tzsource%clongname = 'KAFR convection' - tzsource%lavailable = ( hdconv == 'KAFR' .or. hsconv == 'KAFR' ) .and. ochtrans - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'VTURB' - tzsource%clongname = 'vertical turbulent diffusion' - tzsource%lavailable = hturb == 'TKEL' - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'HTURB' - tzsource%clongname = 'horizontal turbulent diffusion' - tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM' - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'MAFL' - tzsource%clongname = 'mass flux' - tzsource%lavailable = hsconv == 'EDKF' - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'VISC' - tzsource%clongname = 'viscosity' - tzsource%lavailable = lvisc .and. lvisc_sv - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'ADV' - tzsource%clongname = 'total advection' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'NEGA2' - tzsource%clongname = 'negativity correction' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - ! Add specific source terms to different scalar variables - SV_VAR: if ( jsv <= nsv_user ) then - ! nsv_user case - ! Nothing to do - - else if ( jsv >= nsv_c2r2beg .and. jsv <= nsv_c2r2end ) then SV_VAR - ! C2R2 or KHKO Case - - ! Source terms in common for all C2R2/KHKO budgets - tzsource%cmnhname = 'NETUR' - tzsource%clongname = 'negativity correction induced by turbulence' - tzsource%lavailable = hturb == 'TKEL' - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'NEADV' - tzsource%clongname = 'negativity correction induced by advection' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'NEGA' - tzsource%clongname = 'negativity correction' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'NECON' - tzsource%clongname = 'negativity correction induced by condensation' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - ! Source terms specific to each budget - SV_C2R2: select case( jsv - nsv_c2r2beg + 1 ) - case ( 1 ) SV_C2R2 - ! Concentration of activated nuclei - tzsource%cmnhname = 'HENU' - tzsource%clongname = 'CCN activation' - gtmp = cactccn == 'ABRK' .and. (lorilam .or. ldust .or. lsalt ) - tzsource%lavailable = gtmp .or. ( .not.gtmp .and. .not.lsupsat_c2r2 ) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'CEVA' - tzsource%clongname = 'evaporation' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - - case ( 2 ) SV_C2R2 - ! Concentration of cloud droplets - tzsource%cmnhname = 'DEPOTR' - tzsource%clongname = 'tree droplet deposition' - tzsource%lavailable = odragtree .and. odepotree - call Budget_source_add( tbudgets(ibudget), tzsource) - - tzsource%cmnhname = 'HENU' - tzsource%clongname = 'CCN activation' - gtmp = cactccn == 'ABRK' .and. (lorilam .or. ldust .or. lsalt ) - tzsource%lavailable = gtmp .or. ( .not.gtmp .and. .not.lsupsat_c2r2 ) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'SELF' - tzsource%clongname = 'self-collection of cloud droplets' - tzsource%lavailable = lrain_c2r2 - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'ACCR' - tzsource%clongname = 'accretion of cloud droplets' - tzsource%lavailable = lrain_c2r2 - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'SEDI' - tzsource%clongname = 'sedimentation' - tzsource%lavailable = lsedc_c2r2 - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'DEPO' - tzsource%clongname = 'surface droplet deposition' - tzsource%lavailable = ldepoc_c2r2 - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'CEVA' - tzsource%clongname = 'evaporation' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - - case ( 3 ) SV_C2R2 - ! Concentration of raindrops - tzsource%cmnhname = 'AUTO' - tzsource%clongname = 'autoconversion into rain' - tzsource%lavailable = lrain_c2r2 - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'SCBU' - tzsource%clongname = 'self collection - coalescence/break-up' - tzsource%lavailable = hcloud /= 'KHKO' - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'REVA' - tzsource%clongname = 'rain evaporation' - tzsource%lavailable = lrain_c2r2 - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'BRKU' - tzsource%clongname = 'spontaneous break-up' - tzsource%lavailable = lrain_c2r2 - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'SEDI' - tzsource%clongname = 'sedimentation' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - - case ( 4 ) SV_C2R2 - ! Supersaturation - tzsource%cmnhname = 'CEVA' - tzsource%clongname = 'evaporation' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - end select SV_C2R2 - - - else if ( jsv >= nsv_lima_beg .and. jsv <= nsv_lima_end ) then SV_VAR - ! LIMA case - - ! Source terms in common for all LIMA budgets (except supersaturation) - if ( jsv /= nsv_lima_spro ) then - tzsource%cmnhname = 'NETUR' - tzsource%clongname = 'negativity correction induced by turbulence' - tzsource%lavailable = hturb == 'TKEL' - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'NEADV' - tzsource%clongname = 'negativity correction induced by advection' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'NEGA' - tzsource%clongname = 'negativity correction' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'NECON' - tzsource%clongname = 'negativity correction induced by condensation' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - end if - - - ! Source terms specific to each budget - SV_LIMA: if ( jsv == nsv_lima_nc ) then - ! Cloud droplets concentration - tzsource%cmnhname = 'DEPOTR' - tzsource%clongname = 'tree droplet deposition' - tzsource%lavailable = odragtree .and. odepotree - call Budget_source_add( tbudgets(ibudget), tzsource ) - -! tzsource%cmnhname = 'CORR' -! tzsource%clongname = 'correction' -! tzsource%lavailable = lptsplit .and. lwarm_lima .and. lrain_lima -! call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'SEDI' - tzsource%clongname = 'sedimentation' - tzsource%lavailable = lwarm_lima .and. lsedc_lima - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'DEPO' - tzsource%clongname = 'surface droplet deposition' - tzsource%lavailable = lwarm_lima .and. ldepoc_lima - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'R2C1' - tzsource%clongname = 'rain to cloud change after sedimentation' - tzsource%lavailable = lptsplit .and. lwarm_lima .and. lrain_lima - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'HENU' - tzsource%clongname = 'CCN activation' - tzsource%lavailable = lwarm_lima .and. lacti_lima .and. nmod_ccn >= 1 .and. ( .not.lptsplit .or. .not.lsubg_cond ) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'HINC' - tzsource%clongname = 'heterogeneous nucleation by contact' - tzsource%lavailable = lcold_lima .and. lnucl_lima - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'SELF' - tzsource%clongname = 'self-collection of cloud droplets' - tzsource%lavailable = lptsplit .or. (lwarm_lima .and. lrain_lima) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'AUTO' - tzsource%clongname = 'autoconversion into rain' - tzsource%lavailable = lptsplit .or. ( lwarm_lima .and. lrain_lima ) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'ACCR' - tzsource%clongname = 'accretion of cloud droplets' - tzsource%lavailable = lptsplit .or. ( lwarm_lima .and. lrain_lima ) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'REVA' - tzsource%clongname = 'rain evaporation' - tzsource%lavailable = lptsplit .or. ( lwarm_lima .and. lrain_lima ) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'HONC' - tzsource%clongname = 'droplet homogeneous freezing' - tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lnucl_lima ) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'IMLT' - tzsource%clongname = 'melting of ice' - tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima ) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'RIM' - tzsource%clongname = 'riming of cloud water' - tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'WETG' - tzsource%clongname = 'wet growth of graupel' - tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'DRYG' - tzsource%clongname = 'dry growth of graupel' - tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'CVRC' - tzsource%clongname = 'rain to cloud change after other microphysical processes' - tzsource%lavailable = lptsplit - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'WETH' - tzsource%clongname = 'wet growth of hail' - tzsource%lavailable = .not.lptsplit .and. lhail_lima .and. lcold_lima .and. lwarm_lima .and. lsnow_lima - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'CORR2' - tzsource%clongname = 'supplementary correction inside LIMA splitting' - tzsource%lavailable = lptsplit - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'CEDS' - tzsource%clongname = 'adjustment to saturation' - tzsource%lavailable = lwarm_lima - call Budget_source_add( tbudgets(ibudget), tzsource ) - - - else if ( jsv == nsv_lima_nr ) then SV_LIMA - ! Rain drops concentration -! tzsource%cmnhname = 'CORR' -! tzsource%clongname = 'correction' -! tzsource%lavailable = lptsplit .and. lwarm_lima .and. lrain_lima -! call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'SEDI' - tzsource%clongname = 'sedimentation' - tzsource%lavailable = lwarm_lima .and. lrain_lima - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'R2C1' - tzsource%clongname = 'rain to cloud change after sedimentation' - tzsource%lavailable = lptsplit .and. lwarm_lima .and. lrain_lima - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'AUTO' - tzsource%clongname = 'autoconversion into rain' - tzsource%lavailable = lptsplit .or. (lwarm_lima .and. lrain_lima) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'SCBU' - tzsource%clongname = 'self collection - coalescence/break-up' - tzsource%lavailable = lptsplit .or. (lwarm_lima .and. lrain_lima) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'REVA' - tzsource%clongname = 'rain evaporation' - tzsource%lavailable = lptsplit .or. (lwarm_lima .and. lrain_lima) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'BRKU' - tzsource%clongname = 'spontaneous break-up' - tzsource%lavailable = lptsplit .or. (lwarm_lima .and. lrain_lima) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'HONR' - tzsource%clongname = 'rain homogeneous freezing' - tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lrain_lima .and. lnucl_lima ) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'ACC' - tzsource%clongname = 'accretion of rain on aggregates' - tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima .and. lrain_lima ) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'CFRZ' - tzsource%clongname = 'conversion freezing of rain' - tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'WETG' - tzsource%clongname = 'wet growth of graupel' - tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'DRYG' - tzsource%clongname = 'dry growth of graupel' - tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'GMLT' - tzsource%clongname = 'graupel melting' - tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'CVRC' - tzsource%clongname = 'rain to cloud change after other microphysical processes' - tzsource%lavailable = lptsplit - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'WETH' - tzsource%clongname = 'wet growth of hail' - tzsource%lavailable = .not.lptsplit .and. lhail_lima .and. lcold_lima .and. lwarm_lima .and. lsnow_lima - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'HMLT' - tzsource%clongname = 'melting of hail' - tzsource%lavailable = .not.lptsplit .and. lhail_lima .and. lcold_lima .and. lwarm_lima .and. lsnow_lima - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'CORR2' - tzsource%clongname = 'supplementary correction inside LIMA splitting' - tzsource%lavailable = lptsplit - call Budget_source_add( tbudgets(ibudget), tzsource ) - - - else if ( jsv >= nsv_lima_ccn_free .and. jsv <= nsv_lima_ccn_free + nmod_ccn - 1 ) then SV_LIMA - ! Free CCN concentration - tzsource%cmnhname = 'HENU' - tzsource%clongname = 'CCN activation' - tzsource%lavailable = lwarm_lima .and. lacti_lima .and. nmod_ccn >= 1 .and. ( .not.lptsplit .or. .not.lsubg_cond ) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'HONH' - tzsource%clongname = 'haze homogeneous nucleation' - tzsource%lavailable = lcold_lima .and. lnucl_lima .and. lhhoni_lima .and. nmod_ccn >= 1 - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'CEDS' - tzsource%clongname = 'adjustment to saturation' - tzsource%lavailable = lwarm_lima - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'SCAV' - tzsource%clongname = 'scavenging' - tzsource%lavailable = lscav_lima - call Budget_source_add( tbudgets(ibudget), tzsource ) - - - else if ( jsv >= nsv_lima_ccn_acti .and. jsv <= nsv_lima_ccn_acti + nmod_ccn - 1 ) then SV_LIMA - ! Activated CCN concentration - tzsource%cmnhname = 'HENU' - tzsource%clongname = 'CCN activation' - tzsource%lavailable = lwarm_lima .and. lacti_lima .and. nmod_ccn >= 1 .and. ( .not.lptsplit .or. .not.lsubg_cond ) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'HINC' - tzsource%clongname = 'heterogeneous nucleation by contact' - tzsource%lavailable = lcold_lima .and. lnucl_lima .and. .not. lmeyers_lima - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'CEDS' - tzsource%clongname = 'adjustment to saturation' - tzsource%lavailable = lwarm_lima - call Budget_source_add( tbudgets(ibudget), tzsource ) - - - else if ( jsv == nsv_lima_scavmass ) then SV_LIMA - ! Scavenged mass variable - tzsource%cmnhname = 'SCAV' - tzsource%clongname = 'scavenging' - tzsource%lavailable = lscav_lima .and. laero_mass_lima - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'CEDS' - tzsource%clongname = 'adjustment to saturation' - tzsource%lavailable = lscav_lima .and. laero_mass_lima .and. .not.lspro_lima - call Budget_source_add( tbudgets(ibudget), tzsource ) - - - else if ( jsv == nsv_lima_ni ) then SV_LIMA - ! Pristine ice crystals concentration -! tzsource%cmnhname = 'CORR' -! tzsource%clongname = 'correction' -! tzsource%lavailable = lptsplit .and. lcold_lima .and. lsnow_lima -! call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'SEDI' - tzsource%clongname = 'sedimentation' - tzsource%lavailable = lcold_lima .and. lsedi_lima - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'HIND' - tzsource%clongname = 'heterogeneous nucleation by deposition' - tzsource%lavailable = lcold_lima .and. lnucl_lima - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'HINC' - tzsource%clongname = 'heterogeneous nucleation by contact' - tzsource%lavailable = lcold_lima .and. lnucl_lima - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'HONH' - tzsource%clongname = 'haze homogeneous nucleation' - tzsource%lavailable = lcold_lima .and. lnucl_lima .and. lhhoni_lima .and. nmod_ccn >= 1 - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'HONC' - tzsource%clongname = 'droplet homogeneous freezing' - tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lnucl_lima ) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'CNVI' - tzsource%clongname = 'conversion of snow to cloud ice' - tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lsnow_lima ) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'CNVS' - tzsource%clongname = 'conversion of pristine ice to snow' - tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lsnow_lima ) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'AGGS' - tzsource%clongname = 'aggregation of snow' - tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lsnow_lima ) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'IMLT' - tzsource%clongname = 'melting of ice' - tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima ) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'HMS' - tzsource%clongname = 'Hallett-Mossop ice multiplication process due to snow riming' - tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'CIBU' - tzsource%clongname = 'ice multiplication process due to ice collisional breakup' - tzsource%lavailable = .not.lptsplit .and. lcold_lima .and. lwarm_lima .and. lsnow_lima .and. lcibu - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'CFRZ' - tzsource%clongname = 'conversion freezing of rain' - tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'RDSF' - tzsource%clongname = 'ice multiplication process following rain contact freezing' - tzsource%lavailable = .not.lptsplit .and. lcold_lima .and. lwarm_lima .and. lsnow_lima .and. lrdsf - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'WETG' - tzsource%clongname = 'wet growth of graupel' - tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'DRYG' - tzsource%clongname = 'dry growth of graupel' - tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'HMG' - tzsource%clongname = 'Hallett-Mossop ice multiplication process due to graupel riming' - tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'WETH' - tzsource%clongname = 'wet growth of hail' - tzsource%lavailable = .not.lptsplit .and. lhail_lima .and. lcold_lima .and. lwarm_lima .and. lsnow_lima - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'CEDS' - tzsource%clongname = 'adjustment to saturation' - tzsource%lavailable = lcold_lima .and. .not.lptsplit .and. .not.lspro_lima - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'CORR2' - tzsource%clongname = 'supplementary correction inside LIMA splitting' - tzsource%lavailable = lptsplit - call Budget_source_add( tbudgets(ibudget), tzsource ) - - - else if ( jsv >= nsv_lima_ifn_free .and. jsv <= nsv_lima_ifn_free + nmod_ifn - 1 ) then SV_LIMA - ! Free IFN concentration - tzsource%cmnhname = 'HIND' - tzsource%clongname = 'heterogeneous nucleation by deposition' - tzsource%lavailable = lcold_lima .and. lnucl_lima .and. .not. lmeyers_lima - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'CEDS' - tzsource%clongname = 'adjustment to saturation' - tzsource%lavailable = lcold_lima .and. .not.lptsplit .and. .not.lspro_lima - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'SCAV' - tzsource%clongname = 'scavenging' - tzsource%lavailable = lscav_lima - call Budget_source_add( tbudgets(ibudget), tzsource ) - - - else if ( jsv >= nsv_lima_ifn_nucl .and. jsv <= nsv_lima_ifn_nucl + nmod_ifn - 1 ) then SV_LIMA - ! Nucleated IFN concentration - tzsource%cmnhname = 'HIND' - tzsource%clongname = 'heterogeneous nucleation by deposition' - tzsource%lavailable = lcold_lima .and. lnucl_lima & - .and. ( ( lmeyers_lima .and. jsv == nsv_lima_ifn_nucl ) .or. .not. lmeyers_lima ) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'HINC' - tzsource%clongname = 'heterogeneous nucleation by contact' - tzsource%lavailable = lcold_lima .and. lnucl_lima .and. lmeyers_lima .and. jsv == nsv_lima_ifn_nucl - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'IMLT' - tzsource%clongname = 'melting of ice' - tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima ) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'CEDS' - tzsource%clongname = 'adjustment to saturation' - tzsource%lavailable = lcold_lima .and. .not.lptsplit .and. .not.lspro_lima - call Budget_source_add( tbudgets(ibudget), tzsource ) - - - else if ( jsv >= nsv_lima_imm_nucl .and. jsv <= nsv_lima_imm_nucl + nmod_imm - 1 ) then SV_LIMA - ! Nucleated IMM concentration - tzsource%cmnhname = 'HINC' - tzsource%clongname = 'heterogeneous nucleation by contact' - tzsource%lavailable = lcold_lima .and. lnucl_lima .and. .not. lmeyers_lima - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'CEDS' - tzsource%clongname = 'adjustment to saturation' - tzsource%lavailable = lcold_lima .and. .not.lptsplit .and. .not.lspro_lima - call Budget_source_add( tbudgets(ibudget), tzsource ) - - - else if ( jsv == nsv_lima_hom_haze ) then SV_LIMA - ! Homogeneous freezing of CCN - tzsource%cmnhname = 'HONH' - tzsource%clongname = 'haze homogeneous nucleation' - tzsource%lavailable = lcold_lima .and. lnucl_lima .and. & - ( ( lhhoni_lima .and. nmod_ccn >= 1 ) .or. ( .not.lptsplit .and. lwarm_lima ) ) - call Budget_source_add( tbudgets(ibudget), tzsource ) - - - else if ( jsv == nsv_lima_spro ) then SV_LIMA - ! Supersaturation - tzsource%cmnhname = 'CEDS' - tzsource%clongname = 'adjustment to saturation' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - end if SV_LIMA - - - else if ( jsv >= nsv_elecbeg .and. jsv <= nsv_elecend ) then SV_VAR - ! Electricity case - tzsource%cmnhname = 'NEGA' - tzsource%clongname = 'negativity correction' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - SV_ELEC: select case( jsv - nsv_elecbeg + 1 ) - case ( 1 ) SV_ELEC - ! volumetric charge of water vapor - tzsource%cmnhname = 'DRIFT' - tzsource%clongname = 'ion drift motion' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'CORAY' - tzsource%clongname = 'cosmic ray source' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'DEPS' - tzsource%clongname = 'deposition on snow' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'DEPG' - tzsource%clongname = 'deposition on graupel' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'REVA' - tzsource%clongname = 'rain evaporation' - tzsource%lavailable = lwarm_ice - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'DEPI' - tzsource%clongname = 'condensation/deposition on ice' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'NEUT' - tzsource%clongname = 'neutralization' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - - case ( 2 ) SV_ELEC - ! volumetric charge of cloud droplets - tzsource%cmnhname = 'HON' - tzsource%clongname = 'homogeneous nucleation' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'AUTO' - tzsource%clongname = 'autoconversion into rain' - tzsource%lavailable = lwarm_ice - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'ACCR' - tzsource%clongname = 'accretion of cloud droplets' - tzsource%lavailable = lwarm_ice - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'RIM' - tzsource%clongname = 'riming of cloud water' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'WETG' - tzsource%clongname = 'wet growth of graupel' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'DRYG' - tzsource%clongname = 'dry growth of graupel' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'INCG' - tzsource%clongname = 'inductive charge transfer between cloud droplets and graupel' - tzsource%lavailable = linductive - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'WETH' - tzsource%clongname = 'wet growth of hail' - tzsource%lavailable = hcloud == 'ICE4' - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'IMLT' - tzsource%clongname = 'melting of ice' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'BERFI' - tzsource%clongname = 'Bergeron-Findeisen' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'SEDI' - tzsource%clongname = 'sedimentation' - tzsource%lavailable = lsedic_ice - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'DEPI' - tzsource%clongname = 'condensation/deposition on ice' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'NEUT' - tzsource%clongname = 'neutralization' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - - case ( 3 ) SV_ELEC - ! volumetric charge of rain drops - tzsource%cmnhname = 'SFR' - tzsource%clongname = 'spontaneous freezing' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'AUTO' - tzsource%clongname = 'autoconversion into rain' - tzsource%lavailable = lwarm_ice - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'ACCR' - tzsource%clongname = 'accretion of cloud droplets' - tzsource%lavailable = lwarm_ice - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'REVA' - tzsource%clongname = 'rain evaporation' - tzsource%lavailable = lwarm_ice - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'ACC' - tzsource%clongname = 'accretion of rain on aggregates' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'CFRZ' - tzsource%clongname = 'conversion freezing of rain' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'WETG' - tzsource%clongname = 'wet growth of graupel' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'DRYG' - tzsource%clongname = 'dry growth of graupel' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'GMLT' - tzsource%clongname = 'graupel melting' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'WETH' - tzsource%clongname = 'wet growth of hail' - tzsource%lavailable = hcloud == 'ICE4' - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'HMLT' - tzsource%clongname = 'melting of hail' - tzsource%lavailable = hcloud == 'ICE4' - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'SEDI' - tzsource%clongname = 'sedimentation' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'NEUT' - tzsource%clongname = 'neutralization' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - case ( 4 ) SV_ELEC - ! volumetric charge of ice crystals - tzsource%cmnhname = 'HON' - tzsource%clongname = 'homogeneous nucleation' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'AGGS' - tzsource%clongname = 'aggregation of snow' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'AUTS' - tzsource%clongname = 'autoconversion of ice' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'CFRZ' - tzsource%clongname = 'conversion freezing of rain' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'WETG' - tzsource%clongname = 'wet growth of graupel' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'DRYG' - tzsource%clongname = 'dry growth of graupel' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'WETH' - tzsource%clongname = 'wet growth of hail' - tzsource%lavailable = hcloud == 'ICE4' - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'IMLT' - tzsource%clongname = 'melting of ice' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'BERFI' - tzsource%clongname = 'Bergeron-Findeisen' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'NIIS' - tzsource%clongname = 'non-inductive charge separation due to ice-snow collisions' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'SEDI' - tzsource%clongname = 'sedimentation' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'DEPI' - tzsource%clongname = 'condensation/deposition on ice' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'NEUT' - tzsource%clongname = 'neutralization' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - - case ( 5 ) SV_ELEC - ! volumetric charge of snow - tzsource%cmnhname = 'DEPS' - tzsource%clongname = 'deposition on snow' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'AGGS' - tzsource%clongname = 'aggregation of snow' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'AUTS' - tzsource%clongname = 'autoconversion of ice' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'RIM' - tzsource%clongname = 'riming of cloud water' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'ACC' - tzsource%clongname = 'accretion of rain on snow' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'CMEL' - tzsource%clongname = 'conversion melting' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'WETG' - tzsource%clongname = 'wet growth of graupel' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'DRYG' - tzsource%clongname = 'dry growth of graupel' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'NIIS' - tzsource%clongname = 'non-inductive charge separation due to ice-snow collisions' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'WETH' - tzsource%clongname = 'wet growth of hail' - tzsource%lavailable = hcloud == 'ICE4' - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'SEDI' - tzsource%clongname = 'sedimentation' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'NEUT' - tzsource%clongname = 'neutralization' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - - case ( 6 ) SV_ELEC - ! volumetric charge of graupel - tzsource%cmnhname = 'SFR' - tzsource%clongname = 'spontaneous freezing' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'DEPG' - tzsource%clongname = 'deposition on graupel' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'RIM' - tzsource%clongname = 'riming of cloud water' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'ACC' - tzsource%clongname = 'accretion of rain on graupel' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'CMEL' - tzsource%clongname = 'conversion melting' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'CFRZ' - tzsource%clongname = 'conversion freezing of rain' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'WETG' - tzsource%clongname = 'wet growth of graupel' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'DRYG' - tzsource%clongname = 'dry growth of graupel' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'INCG' - tzsource%clongname = 'inductive charge transfer between cloud droplets and graupel' - tzsource%lavailable = linductive - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'GMLT' - tzsource%clongname = 'graupel melting' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'WETH' - tzsource%clongname = 'wet growth of hail' - tzsource%lavailable = hcloud == 'ICE4' - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'SEDI' - tzsource%clongname = 'sedimentation' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'NEUT' - tzsource%clongname = 'neutralization' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - - case ( 7: ) SV_ELEC - if ( ( hcloud == 'ICE4' .and. ( jsv - nsv_elecbeg + 1 ) == 7 ) ) then - ! volumetric charge of hail - tzsource%cmnhname = 'WETG' - tzsource%clongname = 'wet growth of graupel' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'WETH' - tzsource%clongname = 'wet growth of hail' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'HMLT' - tzsource%clongname = 'melting of hail' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'SEDI' - tzsource%clongname = 'sedimentation' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'NEUT' - tzsource%clongname = 'neutralization' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - else if ( ( hcloud == 'ICE3' .and. ( jsv - nsv_elecbeg + 1 ) == 7 ) & - .or. ( hcloud == 'ICE4' .and. ( jsv - nsv_elecbeg + 1 ) == 8 ) ) then - ! Negative ions (NSV_ELECEND case) - tzsource%cmnhname = 'DRIFT' - tzsource%clongname = 'ion drift motion' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'CORAY' - tzsource%clongname = 'cosmic ray source' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'DEPS' - tzsource%clongname = 'deposition on snow' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'DEPG' - tzsource%clongname = 'deposition on graupel' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'REVA' - tzsource%clongname = 'rain evaporation' - tzsource%lavailable = lwarm_ice - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'DEPI' - tzsource%clongname = 'condensation/deposition on ice' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'NEUT' - tzsource%clongname = 'neutralization' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - else - call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', 'unknown electricity budget' ) - end if - - end select SV_ELEC - - - else if ( jsv >= nsv_lgbeg .and. jsv <= nsv_lgend ) then SV_VAR - !Lagrangian variables - - - else if ( jsv >= nsv_ppbeg .and. jsv <= nsv_ppend ) then SV_VAR - !Passive pollutants - - -#ifdef MNH_FOREFIRE - else if ( jsv >= nsv_ffbeg .and. jsv <= nsv_ffend ) then SV_VAR - !Forefire - -#endif - else if ( jsv >= nsv_csbeg .and. jsv <= nsv_csend ) then SV_VAR - !Conditional sampling - - - else if ( jsv >= nsv_chembeg .and. jsv <= nsv_chemend ) then SV_VAR - !Chemical case - tzsource%cmnhname = 'CHEM' - tzsource%clongname = 'chemistry activity' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'NEGA' - tzsource%clongname = 'negativity correction' - tzsource%lavailable = .true. - call Budget_source_add( tbudgets(ibudget), tzsource ) - - - else if ( jsv >= nsv_chicbeg .and. jsv <= nsv_chicend ) then SV_VAR - !Ice phase chemistry - - - else if ( jsv >= nsv_aerbeg .and. jsv <= nsv_aerend ) then SV_VAR - !Chemical aerosol case - tzsource%cmnhname = 'NEGA' - tzsource%clongname = 'negativity correction' - tzsource%lavailable = lorilam - call Budget_source_add( tbudgets(ibudget), tzsource ) - - else if ( jsv >= nsv_aerdepbeg .and. jsv <= nsv_aerdepend ) then SV_VAR - !Aerosol wet deposition - - else if ( jsv >= nsv_dstbeg .and. jsv <= nsv_dstend ) then SV_VAR - !Dust - - else if ( jsv >= nsv_dstdepbeg .and. jsv <= nsv_dstdepend ) then SV_VAR - !Dust wet deposition - - else if ( jsv >= nsv_sltbeg .and. jsv <= nsv_sltend ) then SV_VAR - !Salt - - else if ( jsv >= nsv_sltdepbeg .and. jsv <= nsv_sltdepend ) then SV_VAR - !Salt wet deposition - - else if ( jsv >= nsv_snwbeg .and. jsv <= nsv_snwend ) then SV_VAR - !Snow - tzsource%cmnhname = 'SNSUB' - tzsource%clongname = 'blowing snow sublimation' - tzsource%lavailable = lblowsnow .and. lsnowsubl - call Budget_source_add( tbudgets(ibudget), tzsource ) - - tzsource%cmnhname = 'SNSED' - tzsource%clongname = 'blowing snow sedimentation' - tzsource%lavailable = lblowsnow - call Budget_source_add( tbudgets(ibudget), tzsource ) - - - else if ( jsv >= nsv_lnoxbeg .and. jsv <= nsv_lnoxend ) then SV_VAR - !LiNOX passive tracer - - else SV_VAR - call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', 'unknown scalar variable' ) - end if SV_VAR - - - call Sourcelist_sort_compact( tbudgets(ibudget) ) - - call Sourcelist_scan( tbudgets(ibudget), cbulist_rsv ) - end if -end do SV_BUDGETS - -IF (CBUTYPE=='CART') THEN - WRITE(UNIT=KLUOUT, FMT= '(2/,"DESCRIPTION OF THE BUDGET BOX")' ) - WRITE(UNIT=KLUOUT, FMT= '("BUIL = ",I4.4)' ) NBUIL - WRITE(UNIT=KLUOUT, FMT= '("BUIH = ",I4.4)' ) NBUIH - WRITE(UNIT=KLUOUT, FMT= '("BUJL = ",I4.4)' ) NBUJL - WRITE(UNIT=KLUOUT, FMT= '("BUJH = ",I4.4)' ) NBUJH - WRITE(UNIT=KLUOUT, FMT= '("BUKL = ",I4.4)' ) NBUKL - WRITE(UNIT=KLUOUT, FMT= '("BUKH = ",I4.4)' ) NBUKH - WRITE(UNIT=KLUOUT, FMT= '("BUIMAX = ",I4.4)' ) NBUIMAX - WRITE(UNIT=KLUOUT, FMT= '("BUJMAX = ",I4.4)' ) NBUJMAX - WRITE(UNIT=KLUOUT, FMT= '("BUKMAX = ",I4.4)' ) NBUKMAX -END IF -IF (CBUTYPE=='MASK') THEN - WRITE(UNIT=KLUOUT, FMT= '(2/,"DESCRIPTION OF THE BUDGET MASK")' ) - WRITE(UNIT=KLUOUT, FMT= '("BUIL = ",I4.4)' ) NBUIL - WRITE(UNIT=KLUOUT, FMT= '("BUIH = ",I4.4)' ) NBUIH - WRITE(UNIT=KLUOUT, FMT= '("BUJL = ",I4.4)' ) NBUJL - WRITE(UNIT=KLUOUT, FMT= '("BUJH = ",I4.4)' ) NBUJH - WRITE(UNIT=KLUOUT, FMT= '("BUKL = ",I4.4)' ) NBUKL - WRITE(UNIT=KLUOUT, FMT= '("BUKH = ",I4.4)' ) NBUKH - WRITE(UNIT=KLUOUT, FMT= '("BUKMAX = ",I4.4)' ) NBUKMAX - WRITE(UNIT=KLUOUT, FMT= '("BUSUBWRITE = ",I4.4)' ) NBUSUBWRITE - WRITE(UNIT=KLUOUT, FMT= '("BUMASK = ",I4.4)' ) NBUMASK -END IF - -call Ini_budget_groups( tbudgets, ibudim1, ibudim2, ibudim3 ) - -if ( tbudgets(NBUDGET_U) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_U), cbulist_ru ) -if ( tbudgets(NBUDGET_V) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_V), cbulist_rv ) -if ( tbudgets(NBUDGET_W) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_W), cbulist_rw ) -if ( tbudgets(NBUDGET_TH) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_TH), cbulist_rth ) -if ( tbudgets(NBUDGET_TKE)%lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_TKE), cbulist_rtke ) -if ( tbudgets(NBUDGET_RV) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RV), cbulist_rrv ) -if ( tbudgets(NBUDGET_RC) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RC), cbulist_rrc ) -if ( tbudgets(NBUDGET_RR) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RR), cbulist_rrr ) -if ( tbudgets(NBUDGET_RI) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RI), cbulist_rri ) -if ( tbudgets(NBUDGET_RS) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RS), cbulist_rrs ) -if ( tbudgets(NBUDGET_RG) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RG), cbulist_rrg ) -if ( tbudgets(NBUDGET_RH) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RH), cbulist_rrh ) -if ( lbu_rsv ) call Sourcelist_sv_nml_compact( cbulist_rsv ) -end subroutine Ini_budget - - -subroutine Budget_source_add( tpbudget, tpsource, odonotinit, ooverwrite ) - use modd_budget, only: tbudgetdata, tbusourcedata - - type(tbudgetdata), intent(inout) :: tpbudget - type(tbusourcedata), intent(in) :: tpsource ! Metadata basis - logical, optional, intent(in) :: odonotinit - logical, optional, intent(in) :: ooverwrite - - character(len=4) :: ynum - integer :: isourcenumber - - call Print_msg( NVERB_DEBUG, 'BUD', 'Budget_source_add', 'called for ' // Trim( tpbudget%cname ) & - // ': ' // Trim( tpsource%cmnhname ) ) - - isourcenumber = tpbudget%nsources + 1 - if ( isourcenumber > tpbudget%nsourcesmax ) then - Write( ynum, '( i4 )' ) tpbudget%nsourcesmax - cmnhmsg(1) = 'Insufficient max number of source terms (' // Trim(ynum) // ') for budget ' // Trim( tpbudget%cname ) - cmnhmsg(2) = 'Please increaze value of parameter NSOURCESMAX' - call Print_msg( NVERB_FATAL, 'BUD', 'Budget_source_add' ) - else - tpbudget%nsources = tpbudget%nsources + 1 - end if - - ! Copy metadata from provided tpsource - ! Modifications to source term metadata done with the other dummy arguments - tpbudget%tsources(isourcenumber) = tpsource - - if ( present( odonotinit ) ) tpbudget%tsources(isourcenumber)%ldonotinit = odonotinit - - if ( present( ooverwrite ) ) tpbudget%tsources(isourcenumber)%loverwrite = ooverwrite -end subroutine Budget_source_add - - -subroutine Ini_budget_groups( tpbudgets, kbudim1, kbudim2, kbudim3 ) - use modd_budget, only: tbudgetdata - use modd_field, only: TYPEINT, TYPEREAL - use modd_parameters, only: NMNHNAMELGTMAX, NSTDNAMELGTMAX - - use mode_tools, only: Quicksort - - type(tbudgetdata), dimension(:), intent(inout) :: tpbudgets - integer, intent(in) :: kbudim1 - integer, intent(in) :: kbudim2 - integer, intent(in) :: kbudim3 - - character(len=NMNHNAMELGTMAX) :: ymnhname - character(len=NSTDNAMELGTMAX) :: ystdname - character(len=32) :: ylongname - character(len=40) :: yunits - character(len=100) :: ycomment - integer :: ji, jj, jk - integer :: isources ! Number of source terms in a budget - integer :: inbgroups ! Number of budget groups - integer :: ival - integer :: icount - integer :: ivalmax, ivalmin - integer :: igrid - integer :: itype - integer :: idims - integer, dimension(:), allocatable :: igroups ! Temporary array to store sorted group numbers - integer, dimension(:), allocatable :: ipos ! Temporary array to store initial position of group numbers - real :: zval - real :: zvalmax, zvalmin - - call Print_msg( NVERB_DEBUG, 'BUD', 'Ini_budget_groups', 'called' ) - - BUDGETS: do ji = 1, size( tpbudgets ) - ENABLED: if ( tpbudgets(ji)%lenabled ) then - isources = size( tpbudgets(ji)%tsources ) - do jj = 1, isources - ! Check if ngroup is an allowed value - if ( tpbudgets(ji)%tsources(jj)%ngroup < 0 ) then - call Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'negative group value is not allowed' ) - tpbudgets(ji)%tsources(jj)%ngroup = 0 - end if - - if ( tpbudgets(ji)%tsources(jj)%ngroup > 0 ) tpbudgets(ji)%tsources(jj)%lenabled = .true. - end do - - !Count the number of groups of source terms - !ngroup=1 is for individual entries, >1 values are groups - allocate( igroups(isources ) ) - allocate( ipos (isources ) ) - igroups(:) = tpbudgets(ji)%tsources(:)%ngroup - ipos(:) = [ ( jj, jj = 1, isources ) ] - - !Sort the group list number - call Quicksort( igroups, 1, isources, ipos ) - - !Count the number of different groups - !and renumber the entries (from 1 to inbgroups) - inbgroups = 0 - ival = igroups(1) - if ( igroups(1) /= 0 ) then - inbgroups = 1 - igroups(1) = inbgroups - end if - do jj = 2, isources - if ( igroups(jj) == 1 ) then - inbgroups = inbgroups + 1 - igroups(jj) = inbgroups - else if ( igroups(jj) > 0 ) then - if ( igroups(jj) /= ival ) then - ival = igroups(jj) - inbgroups = inbgroups + 1 - end if - igroups(jj) = inbgroups - end if - end do - - !Write the igroups values to the budget structure - do jj = 1, isources - tpbudgets(ji)%tsources(ipos(jj))%ngroup = igroups(jj) - end do - - !Allocate the group structure + populate it - tpbudgets(ji)%ngroups = inbgroups - allocate( tpbudgets(ji)%tgroups(inbgroups) ) - - do jj = 1, inbgroups - !Search the list of sources for each group - !not the most efficient algorithm but do the job - icount = 0 - do jk = 1, isources - if ( tpbudgets(ji)%tsources(jk)%ngroup == jj ) then - icount = icount + 1 - ipos(icount) = jk !ipos is reused as a temporary work array - end if - end do - tpbudgets(ji)%tgroups(jj)%nsources = icount - - allocate( tpbudgets(ji)%tgroups(jj)%nsourcelist(icount) ) - tpbudgets(ji)%tgroups(jj)%nsourcelist(:) = ipos(1 : icount) - - ! Set the name of the field - ymnhname = tpbudgets(ji)%tsources(ipos(1))%cmnhname - do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources - ymnhname = trim( ymnhname ) // '_' // trim( tpbudgets(ji)%tsources(ipos(jk))%cmnhname ) - end do - tpbudgets(ji)%tgroups(jj)%cmnhname = ymnhname - - ! Set the standard name (CF convention) - if ( tpbudgets(ji)%tgroups(jj)%nsources == 1 ) then - ystdname = tpbudgets(ji)%tsources(ipos(1))%cstdname - else - ! The CF standard name is probably wrong if combining several source terms => set to '' - ystdname = '' - end if - tpbudgets(ji)%tgroups(jj)%cstdname = ystdname - - ! Set the long name (CF convention) - ylongname = tpbudgets(ji)%tsources(ipos(1))%clongname - do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources - ylongname = trim( ylongname ) // ' + ' // tpbudgets(ji)%tsources(ipos(jk))%clongname - end do - tpbudgets(ji)%tgroups(jj)%clongname = ylongname - - ! Set the units - yunits = tpbudgets(ji)%tsources(ipos(1))%cunits - do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources - if ( trim( yunits ) /= trim( tpbudgets(ji)%tsources(ipos(jk))%cunits ) ) then - call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', & - 'incompatible units for the different source terms of the group ' & - //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) ) - yunits = 'unknown' - end if - end do - tpbudgets(ji)%tgroups(jj)%cunits = yunits - - ! Set the comment - ! It is composed of the source comment followed by the clongnames of the different sources - ycomment = trim( tpbudgets(ji)%tsources(ipos(1))%ccomment ) // ': '// trim( tpbudgets(ji)%tsources(ipos(1))%clongname ) - do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources - ycomment = trim( ycomment ) // ', ' // trim( tpbudgets(ji)%tsources(ipos(jk))%clongname ) - end do - ycomment = trim( ycomment ) // ' source term' - if ( tpbudgets(ji)%tgroups(jj)%nsources > 1 ) ycomment = trim( ycomment ) // 's' - tpbudgets(ji)%tgroups(jj)%ccomment = ycomment - - ! Set the Arakawa grid - igrid = tpbudgets(ji)%tsources(ipos(1))%ngrid - do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources - if ( igrid /= tpbudgets(ji)%tsources(ipos(jk))%ngrid ) then - call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', & - 'different Arakawa grid positions for the different source terms of the group ' & - //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) ) - end if - end do - tpbudgets(ji)%tgroups(jj)%ngrid = igrid - - ! Set the data type - itype = tpbudgets(ji)%tsources(ipos(1))%ntype - do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources - if ( itype /= tpbudgets(ji)%tsources(ipos(jk))%ntype ) then - call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', & - 'incompatible data types for the different source terms of the group ' & - //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) ) - end if - end do - tpbudgets(ji)%tgroups(jj)%ntype = itype - - ! Set the number of dimensions - idims = tpbudgets(ji)%tsources(ipos(1))%ndims - do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources - if ( idims /= tpbudgets(ji)%tsources(ipos(jk))%ndims ) then - call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', & - 'incompatible number of dimensions for the different source terms of the group ' & - //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) ) - end if - end do - tpbudgets(ji)%tgroups(jj)%ndims = idims - - ! Set the fill values - if ( tpbudgets(ji)%tgroups(jj)%ntype == TYPEINT ) then - ival = tpbudgets(ji)%tsources(ipos(1))%nfillvalue - do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources - if ( ival /= tpbudgets(ji)%tsources(ipos(jk))%nfillvalue ) then - call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', & - 'different (integer) fill values for the different source terms of the group ' & - //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) ) - end if - end do - tpbudgets(ji)%tgroups(jj)%nfillvalue = ival - end if - - if ( tpbudgets(ji)%tgroups(jj)%ntype == TYPEREAL ) then - zval = tpbudgets(ji)%tsources(ipos(1))%xfillvalue - do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources - if ( zval /= tpbudgets(ji)%tsources(ipos(jk))%xfillvalue ) then - call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', & - 'different (real) fill values for the different source terms of the group ' & - //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) ) - end if - end do - tpbudgets(ji)%tgroups(jj)%xfillvalue = zval - end if - - ! Set the valid min/max values - ! Take the min or max of all the sources - ! Maybe, it would be better to take the sum? (if same sign, if not already the maximum allowed value for this type) - if ( tpbudgets(ji)%tgroups(jj)%ntype == TYPEINT ) then - ivalmin = tpbudgets(ji)%tsources(ipos(1))%nvalidmin - ivalmax = tpbudgets(ji)%tsources(ipos(1))%nvalidmax - do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources - ivalmin = min( ivalmin, tpbudgets(ji)%tsources(ipos(jk))%nvalidmin ) - ivalmax = max( ivalmax, tpbudgets(ji)%tsources(ipos(jk))%nvalidmax ) - end do - tpbudgets(ji)%tgroups(jj)%nvalidmin = ivalmin - tpbudgets(ji)%tgroups(jj)%nvalidmax = ivalmax - end if - - if ( tpbudgets(ji)%tgroups(jj)%ntype == TYPEREAL ) then - zvalmin = tpbudgets(ji)%tsources(ipos(1))%xvalidmin - zvalmax = tpbudgets(ji)%tsources(ipos(1))%xvalidmax - do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources - zvalmin = min( zvalmin, tpbudgets(ji)%tsources(ipos(jk))%xvalidmin ) - zvalmax = max( zvalmax, tpbudgets(ji)%tsources(ipos(jk))%xvalidmax ) - end do - tpbudgets(ji)%tgroups(jj)%xvalidmin = zvalmin - tpbudgets(ji)%tgroups(jj)%xvalidmax = zvalmax - end if - - allocate( tpbudgets(ji)%tgroups(jj)%xdata(kbudim1, kbudim2, kbudim3 ) ) - tpbudgets(ji)%tgroups(jj)%xdata(:, :, :) = 0. - end do - - deallocate( igroups ) - deallocate( ipos ) - - !Check that a group does not contain more than 1 source term with ldonotinit=.true. - do jj = 1, inbgroups - if ( tpbudgets(ji)%tgroups(jj)%nsources > 1 ) then - do jk = 1, tpbudgets(ji)%tgroups(jj)%nsources - if ( tpbudgets(ji)%tsources(tpbudgets(ji)%tgroups(jj)%nsourcelist(jk) )%ldonotinit ) & - call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', & - 'a group with more than 1 source term may not contain sources with ldonotinit=true' ) - if ( tpbudgets(ji)%tsources(tpbudgets(ji)%tgroups(jj)%nsourcelist(jk) )%loverwrite ) & - call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', & - 'a group with more than 1 source term may not contain sources with loverwrite=true' ) - end do - end if - end do - - end if ENABLED - end do BUDGETS - -end subroutine Ini_budget_groups - - -subroutine Sourcelist_sort_compact( tpbudget ) - !Sort the list of sources to put the non-available source terms at the end of the list - !and compact the list - use modd_budget, only: tbudgetdata, tbusourcedata - - type(tbudgetdata), intent(inout) :: tpbudget - - integer :: ji - integer :: isrc_avail, isrc_notavail - type(tbusourcedata), dimension(:), allocatable :: tzsources_avail - type(tbusourcedata), dimension(:), allocatable :: tzsources_notavail - - isrc_avail = 0 - isrc_notavail = 0 - - Allocate( tzsources_avail (tpbudget%nsources) ) - Allocate( tzsources_notavail(tpbudget%nsources) ) - - !Separate source terms available or not during the execution - !(based on the criteria provided to Budget_source_add and stored in lavailable field) - do ji = 1, tpbudget%nsources - if ( tpbudget%tsources(ji)%lavailable ) then - isrc_avail = isrc_avail + 1 - tzsources_avail(isrc_avail) = tpbudget%tsources(ji) - else - isrc_notavail = isrc_notavail + 1 - tzsources_notavail(isrc_notavail) = tpbudget%tsources(ji) - end if - end do - - !Reallocate/compact the source list - if ( Allocated( tpbudget%tsources ) ) Deallocate( tpbudget%tsources ) - Allocate( tpbudget%tsources( tpbudget%nsources ) ) - - tpbudget%nsourcesmax = tpbudget%nsources - !Limit the number of sources to the available list - tpbudget%nsources = isrc_avail - - !Fill the source list beginning with the available sources and finishing with the non-available ones - do ji = 1, isrc_avail - tpbudget%tsources(ji) = tzsources_avail(ji) - end do - - do ji = 1, isrc_notavail - tpbudget%tsources(isrc_avail + ji) = tzsources_notavail(ji) - end do - -end subroutine Sourcelist_sort_compact - - -subroutine Sourcelist_scan( tpbudget, hbulist ) - use modd_budget, only: tbudgetdata - - type(tbudgetdata), intent(inout) :: tpbudget - character(len=*), dimension(:), intent(in) :: hbulist - - character(len=:), allocatable :: yline - character(len=:), allocatable :: ysrc - character(len=:), dimension(:), allocatable :: ymsg - integer :: idx - integer :: igroup - integer :: igroup_idx - integer :: ipos - integer :: istart - integer :: ji - - istart = 1 - - ! Case 'LIST_AVAIL': list all the available source terms - if ( Size( hbulist ) > 0 ) then - if ( Trim( hbulist(1) ) == 'LIST_AVAIL' ) then - Allocate( character(len=65) :: ymsg(tpbudget%nsources + 1) ) - ymsg(1) = '---------------------------------------------------------------------' - ymsg(2) = 'Available source terms for budget ' // Trim( tpbudget%cname ) - Write( ymsg(3), '( A32, " ", A32 )' ) 'Name', 'Long name' - idx = 3 - do ji = 1, tpbudget%nsources - if ( All( tpbudget%tsources(ji)%cmnhname /= [ 'INIF' , 'ENDF', 'AVEF' ] ) ) then - idx = idx + 1 - Write( ymsg(idx), '( A32, " ", A32 )' ) tpbudget%tsources(ji)%cmnhname, tpbudget%tsources(ji)%clongname - end if - end do - ymsg(tpbudget%nsources + 1 ) = '---------------------------------------------------------------------' - call Print_msg_multi( NVERB_WARNING, 'BUD', 'Sourcelist_scan', ymsg ) - !To not read the 1st line again - istart = 2 - end if - end if - - ! Case 'LIST_ALL': list all the source terms - if ( Size( hbulist ) > 0 ) then - if ( Trim( hbulist(1) ) == 'LIST_ALL' ) then - Allocate( character(len=65) :: ymsg(tpbudget%nsourcesmax + 1) ) - ymsg(1) = '---------------------------------------------------------------------' - ymsg(2) = 'Source terms for budget ' // Trim( tpbudget%cname ) - Write( ymsg(3), '( A32, " ", A32 )' ) 'Name', 'Long name' - idx = 3 - do ji = 1, tpbudget%nsourcesmax - if ( All( tpbudget%tsources(ji)%cmnhname /= [ 'INIF' , 'ENDF', 'AVEF' ] ) ) then - idx = idx + 1 - Write( ymsg(idx), '( A32, " ", A32 )' ) tpbudget%tsources(ji)%cmnhname, tpbudget%tsources(ji)%clongname - end if - end do - ymsg(tpbudget%nsourcesmax + 1 ) = '---------------------------------------------------------------------' - call Print_msg_multi( NVERB_WARNING, 'BUD', 'Sourcelist_scan', ymsg ) - !To not read the 1st line again - istart = 2 - end if - end if - - ! Case 'ALL': enable all available source terms - if ( Size( hbulist ) > 0 ) then - if ( Trim( hbulist(1) ) == 'ALL' ) then - do ji = 1, tpbudget%nsources - tpbudget%tsources(ji)%ngroup = 1 - end do - return - end if - end if - - !Always enable INIF, ENDF and AVEF terms - ipos = Source_find( tpbudget, 'INIF' ) - if ( ipos < 1 ) call Print_msg( NVERB_FATAL, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) & - // ': INIF not found' ) - tpbudget%tsources(ipos)%ngroup = 1 - - ipos = Source_find( tpbudget, 'ENDF' ) - if ( ipos < 1 ) call Print_msg( NVERB_FATAL, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) & - // ': ENDF not found' ) - tpbudget%tsources(ipos)%ngroup = 1 - - ipos = Source_find( tpbudget, 'AVEF' ) - if ( ipos < 1 ) call Print_msg( NVERB_FATAL, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) & - // ': AVEF not found' ) - tpbudget%tsources(ipos)%ngroup = 1 - - !igroup_idx start at 2 because 1 is reserved for individually stored source terms - igroup_idx = 2 - - do ji = istart, Size( hbulist ) - if ( Len_trim( hbulist(ji) ) > 0 ) then - ! Scan the line and separate the different sources (separated by + signs) - yline = Trim(hbulist(ji)) - - idx = Index( yline, '+' ) - if ( idx < 1 ) then - igroup = 1 - else - igroup = igroup_idx - igroup_idx = igroup_idx + 1 - end if - - do - idx = Index( yline, '+' ) - if ( idx < 1 ) then - ysrc = yline - else - ysrc = yline(1 : idx - 1) - yline = yline(idx + 1 :) - end if - - !Check if the source is known - if ( Len_trim( ysrc ) > 0 ) then - ipos = Source_find( tpbudget, ysrc ) - - if ( ipos > 0 ) then - call Print_msg( NVERB_DEBUG, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) & - // ': ' // ysrc // ' found' ) - - if ( .not. tpbudget%tsources(ipos)%lavailable ) then - call Print_msg( NVERB_WARNING, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) & - // ': ' // ysrc // ' not available' ) - tpbudget%tsources(ipos)%ngroup = 0 - else - tpbudget%tsources(ipos)%ngroup = igroup - end if - else - call Print_msg( NVERB_ERROR, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) & - // ': ' // ysrc // ' not found' ) - end if - end if - - if ( idx < 1 ) exit - end do - end if - end do -end subroutine Sourcelist_scan - - -subroutine Sourcelist_nml_compact( tpbudget, hbulist ) - !This subroutine reduce the size of the hbulist to the minimum - !The list is generated from the group list - use modd_budget, only: NBULISTMAXLEN, tbudgetdata - - type(tbudgetdata), intent(in) :: tpbudget - character(len=NBULISTMAXLEN), dimension(:), allocatable, intent(inout) :: hbulist - - integer :: idx - integer :: isource - integer :: jg - integer :: js - - if ( Allocated( hbulist ) ) Deallocate( hbulist ) - - if ( tpbudget%ngroups < 3 ) then - call Print_msg( NVERB_ERROR, 'BUD', 'Sourcelist_nml_compact', 'ngroups is too small' ) - return - end if - - Allocate( character(len=NBULISTMAXLEN) :: hbulist(tpbudget%ngroups - 3) ) - hbulist(:) = '' - - idx = 0 - do jg = 1, tpbudget%ngroups - if ( tpbudget%tgroups(jg)%nsources < 1 ) then - call Print_msg( NVERB_ERROR, 'BUD', 'Sourcelist_nml_compact', 'no source for group' ) - cycle - end if - - !Do not put 'INIF', 'ENDF', 'AVEF' in hbulist because their presence is automatic if the corresponding budget is enabled - isource = tpbudget%tgroups(jg)%nsourcelist(1) - if ( Any( tpbudget%tsources(isource)%cmnhname == [ 'INIF', 'ENDF', 'AVEF' ] ) ) cycle - - idx = idx + 1 -#if 0 - !Do not do this way because the group cmnhname may be truncated (NMNHNAMELGTMAX is smaller than NBULISTMAXLEN) - !and the name separator is different ('_') - hbulist(idx) = Trim( tpbudget%tgroups(jg)%cmnhname ) -#else - do js = 1, tpbudget%tgroups(jg)%nsources - isource = tpbudget%tgroups(jg)%nsourcelist(js) - hbulist(idx) = Trim( hbulist(idx) ) // Trim( tpbudget%tsources(isource)%cmnhname ) - if ( js < tpbudget%tgroups(jg)%nsources ) hbulist(idx) = Trim( hbulist(idx) ) // '+' - end do -#endif - end do -end subroutine Sourcelist_nml_compact - - -subroutine Sourcelist_sv_nml_compact( hbulist ) - !This subroutine reduce the size of the hbulist - !For SV variables the reduction is simpler than for other variables - !because it is too complex to do this cleanly (the enabled source terms are different for each scalar variable) - use modd_budget, only: NBULISTMAXLEN, tbudgetdata - - character(len=*), dimension(:), allocatable, intent(inout) :: hbulist - - character(len=NBULISTMAXLEN), dimension(:), allocatable :: ybulist_new - integer :: ilines - integer :: ji - - ilines = 0 - do ji = 1, Size( hbulist ) - if ( Len_trim(hbulist(ji)) > 0 ) ilines = ilines + 1 - end do - - Allocate( ybulist_new(ilines) ) - - ilines = 0 - do ji = 1, Size( hbulist ) - if ( Len_trim(hbulist(ji)) > 0 ) then - ilines = ilines + 1 - ybulist_new(ilines) = Trim( hbulist(ji) ) - end if - end do - - call Move_alloc( from = ybulist_new, to = hbulist ) -end subroutine Sourcelist_sv_nml_compact - - -pure function Source_find( tpbudget, hsource ) result( ipos ) - use modd_budget, only: tbudgetdata - - type(tbudgetdata), intent(in) :: tpbudget - character(len=*), intent(in) :: hsource - integer :: ipos - - integer :: ji - logical :: gfound - - ipos = -1 - gfound = .false. - do ji = 1, tpbudget%nsourcesmax - if ( Trim( hsource ) == Trim ( tpbudget%tsources(ji)%cmnhname ) ) then - gfound = .true. - ipos = ji - exit - end if - end do - -end function Source_find - -end module mode_ini_budget diff --git a/src/ICCARE_BASE/ini_lb.f90 b/src/ICCARE_BASE/ini_lb.f90 deleted file mode 100644 index e72201af0..000000000 --- a/src/ICCARE_BASE/ini_lb.f90 +++ /dev/null @@ -1,1672 +0,0 @@ -!MNH_LIC Copyright 1998-2021 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!----------------------------------------------------------------- -! ###################### - MODULE MODI_INI_LB -! ###################### -! -INTERFACE -! -SUBROUTINE INI_LB(TPINIFILE,OLSOURCE,KSV, & - KSIZELBX_ll,KSIZELBXU_ll,KSIZELBY_ll,KSIZELBYV_ll, & - KSIZELBXTKE_ll,KSIZELBYTKE_ll, & - KSIZELBXR_ll,KSIZELBYR_ll,KSIZELBXSV_ll,KSIZELBYSV_ll, & - HGETTKEM,HGETRVM,HGETRCM,HGETRRM,HGETRIM,HGETRSM, & - HGETRGM,HGETRHM,HGETSVM, & - PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, & - PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, & - PLBXUMM,PLBXVMM,PLBXWMM,PLBXTHMM,PLBXTKEMM,PLBXRMM,PLBXSVMM, & - PLBYUMM,PLBYVMM,PLBYWMM,PLBYTHMM,PLBYTKEMM,PLBYRMM,PLBYSVMM, & - PLENG ) -! -USE MODD_IO, ONLY: TFILEDATA -! -TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file -LOGICAL, INTENT(IN) :: OLSOURCE ! switch for the source term -! Larger Scale fields (source if OLSOURCE=T, fields at time t-dt if OLSOURCE=F) : -INTEGER, INTENT(IN) :: KSV ! number of passive variables -! sizes of the West-east total LB area -INTEGER, INTENT(IN) :: KSIZELBX_ll,KSIZELBXU_ll ! for T,V,W and u -INTEGER, INTENT(IN) :: KSIZELBXTKE_ll ! for TKE -INTEGER, INTENT(IN) :: KSIZELBXR_ll,KSIZELBXSV_ll ! for Rx and SV -! sizes of the North-south total LB area -INTEGER, INTENT(IN) :: KSIZELBY_ll,KSIZELBYV_ll ! for T,U,W and v -INTEGER, INTENT(IN) :: KSIZELBYTKE_ll ! for TKE -INTEGER, INTENT(IN) :: KSIZELBYR_ll,KSIZELBYSV_ll ! for Rx and SV -! Get indicators -CHARACTER (LEN=*), INTENT(IN) :: HGETTKEM, & - HGETRVM,HGETRCM,HGETRRM, & - HGETRIM,HGETRSM,HGETRGM,HGETRHM -CHARACTER (LEN=*), DIMENSION(:),INTENT(IN) :: HGETSVM -! LB fields (source if OLSOURCE=T, fields at time t-dt if OLSOURCE=F) : -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXUM,PLBXVM,PLBXWM ! Wind -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXTHM ! Mass -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYUM,PLBYVM,PLBYWM ! Wind -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYTHM ! Mass -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXTKEM ! TKE -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYTKEM -REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PLBXRM ,PLBXSVM ! Moisture and SV -REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PLBYRM ,PLBYSVM ! in x and y-dir. -! LB arrays at time t-dt (if OLSOURCE=T) : -REAL, DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PLBXUMM,PLBXVMM,PLBXWMM ! Wind -REAL, DIMENSION(:,:,:),INTENT(IN), OPTIONAL :: PLBXTHMM ! Mass -REAL, DIMENSION(:,:,:),INTENT(IN), OPTIONAL :: PLBYUMM,PLBYVMM,PLBYWMM ! Wind -REAL, DIMENSION(:,:,:),INTENT(IN), OPTIONAL :: PLBYTHMM ! Mass -REAL, DIMENSION(:,:,:),INTENT(IN), OPTIONAL :: PLBXTKEMM ! TKE -REAL, DIMENSION(:,:,:),INTENT(IN), OPTIONAL :: PLBYTKEMM -REAL, DIMENSION(:,:,:,:),INTENT(IN), OPTIONAL :: PLBXRMM ,PLBXSVMM ! Moisture and SV -REAL, DIMENSION(:,:,:,:),INTENT(IN), OPTIONAL :: PLBYRMM ,PLBYSVMM ! in x and y-dir. -REAL, INTENT(IN), OPTIONAL :: PLENG ! Interpolation length -! -END SUBROUTINE INI_LB -! -END INTERFACE -! -END MODULE MODI_INI_LB -! ############################################################ -SUBROUTINE INI_LB(TPINIFILE,OLSOURCE,KSV, & - KSIZELBX_ll,KSIZELBXU_ll,KSIZELBY_ll,KSIZELBYV_ll, & - KSIZELBXTKE_ll,KSIZELBYTKE_ll, & - KSIZELBXR_ll,KSIZELBYR_ll,KSIZELBXSV_ll,KSIZELBYSV_ll, & - HGETTKEM,HGETRVM,HGETRCM,HGETRRM,HGETRIM,HGETRSM, & - HGETRGM,HGETRHM,HGETSVM, & - PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, & - PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, & - PLBXUMM,PLBXVMM,PLBXWMM,PLBXTHMM,PLBXTKEMM,PLBXRMM,PLBXSVMM, & - PLBYUMM,PLBYVMM,PLBYWMM,PLBYTHMM,PLBYTKEMM,PLBYRMM,PLBYSVMM, & - PLENG ) -! ############################################################ -! -!!**** *INI_LB* - routine to initialize LB fields -!! -!! PURPOSE -!! ------- -! The purpose of this routine is to read the LB fields and to distribute -! on subdomain which have a non-nul intersection with the LB areas. -! In case of OLSOURCE=T, it initializes the LB sources instead of the -! LB fields at time t-dt -! -!!** METHOD -!! ------ -!! The LB fields are read in file and distributed by FMREAD_LB -!! -!! In case of OLSOURCE=T (INI_LB called by INI_CPL or LS_COUPLING), the LB sources -!! are computed -!! -!! -!! EXTERNAL -!! -------- -!! FMREAD : to read data in LFIFM file -!! FMREAD_LB : to read LB data in LFIFM file -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! Module MODD_CONF : NVERB -!! -!! REFERENCE -!! --------- -!! Book2 of the documentation (routine INI_LB) -!! -!! -!! AUTHOR -!! ------ -!! V. Ducrocq * Meteo France * -!! D. Gazen L.A. -!! -!! MODIFICATIONS -!! ------------- -!! Original 22/09/98 FMREAD_LB handle LBs fields -!! J. Stein 18/09/99 problem with the dry case -!! D. Gazen 22/01/01 treat NSV_* with floating indices -!! F Gheusi 29/10/03 bug in LB sources for NSV -!! J.-P. Pinty 06/05/04 treat NSV_* for C1R3 and ELEC -!! 20/05/06 Remove KEPS -!! C.Lac 20/03/08 Add passive pollutants -!! M.Leriche 16/07/10 Add ice phase chemical species -!! Pialat/tulet 15/02/12 Add ForeFire scalars -!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1 -!! M.Leriche 09/02/16 Treat gas and aq. chemicals separately -!! J.Escobar : 27/04/2016 : bug , test only on ANY(HGETSVM({{1:KSV}})=='READ' -!! J.-P. Pinty 09/02/16 Add LIMA that is LBC for CCN and IFN -!! M.Leriche 09/02/16 Treat gas and aq. chemicals separately -!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O -! P. Wautelet 13/02/2019: initialize PLBXSVM and PLBYSVM in all cases -! P. Wautelet 14/02/2019: move UPCASE function to tools.f90 -!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! -USE MODD_CH_AEROSOL -USE MODD_CH_M9_n, ONLY: CNAMES, CICNAMES -USE MODD_CTURB -USE MODD_CONF -USE MODD_DUST -USE MODD_ELEC_DESCR, ONLY: CELECNAMES -use modd_field, only: tfielddata, TYPELOG, TYPEREAL -USE MODD_ICE_C1R3_DESCR, ONLY: C1R3NAMES -USE MODD_IO, ONLY: TFILEDATA -USE MODD_LG, ONLY: CLGNAMES -USE MODD_LUNIT_n, ONLY: TLUOUT -USE MODD_NSV -USE MODD_PARAMETERS, ONLY: JPHEXT,NMNHNAMELGTMAX -USE MODD_PARAM_LIMA -USE MODD_PARAM_LIMA_COLD, ONLY: CLIMA_COLD_NAMES -USE MODD_PARAM_LIMA_WARM, ONLY: CLIMA_WARM_NAMES -USE MODD_PARAM_n -USE MODD_RAIN_C2R2_DESCR, ONLY: C2R2NAMES -USE MODD_SALT -! -USE MODE_IO_FIELD_READ, only: IO_Field_read, IO_Field_read_lb -USE MODE_MSG -USE MODE_TOOLS, ONLY: UPCASE -! -IMPLICIT NONE -! -!* 0.1 declarations of arguments -! -! -! -TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file -LOGICAL, INTENT(IN) :: OLSOURCE ! switch for the source term -! Larger Scale fields (source if OLSOURCE=T, fields at time t-dt if OLSOURCE=F) : -INTEGER, INTENT(IN) :: KSV ! number of passive variables -! sizes of the West-east total LB area -INTEGER, INTENT(IN) :: KSIZELBX_ll,KSIZELBXU_ll ! for T,V,W and u -INTEGER, INTENT(IN) :: KSIZELBXTKE_ll ! for TKE -INTEGER, INTENT(IN) :: KSIZELBXR_ll,KSIZELBXSV_ll ! for Rx and SV -! sizes of the North-south total LB area -INTEGER, INTENT(IN) :: KSIZELBY_ll,KSIZELBYV_ll ! for T,U,W and v -INTEGER, INTENT(IN) :: KSIZELBYTKE_ll ! for TKE -INTEGER, INTENT(IN) :: KSIZELBYR_ll,KSIZELBYSV_ll ! for Rx and SV -! Get indicators -CHARACTER (LEN=*), INTENT(IN) :: HGETTKEM, & - HGETRVM,HGETRCM,HGETRRM, & - HGETRIM,HGETRSM,HGETRGM,HGETRHM -CHARACTER (LEN=*), DIMENSION(:),INTENT(IN) :: HGETSVM -! LB fields (source if OLSOURCE=T, fields at time t-dt if OLSOURCE=F) : -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXUM,PLBXVM,PLBXWM ! Wind -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXTHM ! Mass -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYUM,PLBYVM,PLBYWM ! Wind -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYTHM ! Mass -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXTKEM ! TKE -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYTKEM ! -REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PLBXRM ,PLBXSVM ! Moisture and SV -REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PLBYRM ,PLBYSVM ! in x and y-dir. -! LB arrays at time t-dt (if OLSOURCE=T) : -REAL, DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PLBXUMM,PLBXVMM,PLBXWMM ! Wind -REAL, DIMENSION(:,:,:),INTENT(IN), OPTIONAL :: PLBXTHMM ! Mass -REAL, DIMENSION(:,:,:),INTENT(IN), OPTIONAL :: PLBYUMM,PLBYVMM,PLBYWMM ! Wind -REAL, DIMENSION(:,:,:),INTENT(IN), OPTIONAL :: PLBYTHMM ! Mass -REAL, DIMENSION(:,:,:),INTENT(IN), OPTIONAL :: PLBXTKEMM ! TKE -REAL, DIMENSION(:,:,:),INTENT(IN), OPTIONAL :: PLBYTKEMM -REAL, DIMENSION(:,:,:,:),INTENT(IN), OPTIONAL :: PLBXRMM ,PLBXSVMM ! Moisture and SV -REAL, DIMENSION(:,:,:,:),INTENT(IN), OPTIONAL :: PLBYRMM ,PLBYSVMM ! in x and y-dir. -REAL, INTENT(IN), OPTIONAL :: PLENG ! Interpolation length -! -! -!* 0.2 declarations of local variables -! -INTEGER :: ILBSIZEX,ILBSIZEY ! depth of the LB area in the RIM direction - ! written in FM file -INTEGER :: IL3DX,IL3DY ! Size of the LB arrays in FM file - ! in the RIM direction -INTEGER :: IL3DXU,IL3DYV ! Size of the LB arrays in FM file - ! in the RIM direction for the normal wind -INTEGER :: IRIMX,IRIMY ! Total size of the LB area (for the RIM direction) -INTEGER :: IRIMXU,IRIMYV ! Total size of the LB area (for the RIM direction) - ! for the normal wind (spatial gradient needed) - -INTEGER :: JSV,JRR ! Loop index for MOIST AND - ! additional scalar variables -INTEGER :: IRR ! counter for moist variables -INTEGER :: IRESP -INTEGER :: ILUOUT ! Logical unit number associated with TLUOUT -LOGICAL :: GHORELAX_UVWTH ! switch for the horizontal relaxation for U,V,W,TH in the FM file -LOGICAL :: GHORELAX_TKE ! switch for the horizontal relaxation for tke in the FM file -LOGICAL :: GHORELAX_R, GHORELAX_SV ! switch for the horizontal relaxation - ! for moist and scalar variables -CHARACTER (LEN= LEN(HGETRVM)), DIMENSION (7) :: YGETRXM ! Arrays with the get indicators - ! for the moist variables -CHARACTER (LEN=1), DIMENSION (7) :: YC ! array with the prefix of the moist variables -CHARACTER(LEN=2) :: INDICE ! to index CCN and IFN fields of LIMA scheme -TYPE(TFIELDDATA) :: TZFIELD -!------------------------------------------------------------------------------- -! -! -!* 0. READ CPL_AROME to know which LB_fileds there are to read -! -------------------- -IF ((TPINIFILE%NMNHVERSION(1)==4 .AND. TPINIFILE%NMNHVERSION(2)>8) .OR. TPINIFILE%NMNHVERSION(1)>4) THEN - CALL IO_Field_read(TPINIFILE,'CPL_AROME',LCPL_AROME) -ELSE - LCPL_AROME=.FALSE. -ENDIF -! -! -!* 1. SOME INITIALIZATIONS -! -------------------- -! -ILUOUT = TLUOUT%NLU -! -! -!------------------------------------------------------------------------------- -! -!* 2. READ 2D "surfacic" LB fields -! ---------------------------- -! -!* 2.1 read the number of available points for the horizontal relaxation -! for basic variables -CALL IO_Field_read(TPINIFILE,'RIMX',ILBSIZEX) -CALL IO_Field_read(TPINIFILE,'RIMY',ILBSIZEY) -! -!* 2.2 Basic variables -! -CALL IO_Field_read(TPINIFILE,'HORELAX_UVWTH',GHORELAX_UVWTH) - ! -IF (GHORELAX_UVWTH) THEN - IRIMX =(KSIZELBX_ll-2*JPHEXT)/2 - IRIMXU=(KSIZELBXU_ll-2*JPHEXT)/2 - IRIMY =(KSIZELBY_ll-2*JPHEXT)/2 - IRIMYV=(KSIZELBYV_ll-2*JPHEXT)/2 - IL3DX=2*ILBSIZEX+2*JPHEXT - IL3DXU=IL3DX - IL3DY=2*ILBSIZEY+2*JPHEXT - IL3DYV=IL3DY -ELSE - IRIMX=0 - IRIMXU=1 - IRIMY=0 - IRIMYV=1 - IL3DX=2*JPHEXT ! 2 - IL3DY=2*JPHEXT ! 2 - IL3DXU=2 + 2*JPHEXT ! 4 - IL3DYV=2 + 2*JPHEXT ! 4 -ENDIF -! -IF (KSIZELBXU_ll/= 0) THEN - CALL IO_Field_read_lb(TPINIFILE,'LBXUM',IL3DXU,IRIMXU,PLBXUM) -END IF - -IF ( KSIZELBX_ll /= 0) THEN - CALL IO_Field_read_lb(TPINIFILE,'LBXVM',IL3DX,IRIMX,PLBXVM) -ENDIF - -IF ( KSIZELBX_ll /= 0) THEN - CALL IO_Field_read_lb(TPINIFILE,'LBXWM',IL3DX,IRIMX,PLBXWM) -END IF - -IF ( KSIZELBY_ll /= 0) THEN - CALL IO_Field_read_lb(TPINIFILE,'LBYUM',IL3DY,IRIMY,PLBYUM) -END IF - -IF ( KSIZELBYV_ll /= 0) THEN - CALL IO_Field_read_lb(TPINIFILE,'LBYVM',IL3DYV,IRIMYV,PLBYVM) -END IF - -IF (KSIZELBY_ll /= 0) THEN - CALL IO_Field_read_lb(TPINIFILE,'LBYWM',IL3DY,IRIMY,PLBYWM) -END IF - -IF (KSIZELBX_ll /= 0) THEN - CALL IO_Field_read_lb(TPINIFILE,'LBXTHM',IL3DX,IRIMX,PLBXTHM) -END IF - -IF ( KSIZELBY_ll /= 0) THEN - CALL IO_Field_read_lb(TPINIFILE,'LBYTHM',IL3DY,IRIMY,PLBYTHM) -END IF -! -!* 2.3 LB-TKE -! -SELECT CASE(HGETTKEM) -CASE('READ') - IF (.NOT. LCPL_AROME .AND. OLSOURCE) THEN - IF (PRESENT(PLBXTKEMM).AND.PRESENT(PLBYTKEMM)) THEN - WRITE ( ILUOUT,*) 'LBXTKES AND LBYTKES WILL BE INITIALIZED TO 0' - PLBXTKEM(:,:,:) = PLBXTKEMM(:,:,:) - PLBYTKEM(:,:,:) = PLBYTKEMM(:,:,:) - ELSE -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize LBXTKES and LBYTKES') - ENDIF - ELSE - CALL IO_Field_read(TPINIFILE,'HORELAX_TKE',GHORELAX_TKE) - IF (GHORELAX_TKE) THEN - IRIMX=(KSIZELBXTKE_ll-2*JPHEXT)/2 - IRIMY=(KSIZELBYTKE_ll-2*JPHEXT)/2 - IL3DX=2*ILBSIZEX+2*JPHEXT - IL3DY=2*ILBSIZEY+2*JPHEXT - ELSE - IRIMX=0 - IRIMY=0 - IL3DX=2*JPHEXT ! 2 - IL3DY=2*JPHEXT ! 2 - ENDIF -! - IF (KSIZELBXTKE_ll /= 0) THEN - CALL IO_Field_read_lb(TPINIFILE,'LBXTKEM',IL3DX,IRIMX,PLBXTKEM) - END IF -! - IF (KSIZELBYTKE_ll /= 0) THEN - CALL IO_Field_read_lb(TPINIFILE,'LBYTKEM',IL3DY,IRIMY,PLBYTKEM) - END IF - ENDIF -CASE('INIT') - IF (SIZE(PLBXTKEM,1) /= 0) PLBXTKEM(:,:,:) = XTKEMIN - IF (SIZE(PLBYTKEM,1) /= 0) PLBYTKEM(:,:,:) = XTKEMIN -END SELECT -! -! -!* 2.5 LB-Rx -! -IF(KSIZELBXR_ll > 0 ) THEN - TZFIELD%CMNHNAME = 'HORELAX_R' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'HORELAX_R' - TZFIELD%CUNITS = '' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Switch to activate the HOrizontal RELAXation' - TZFIELD%CLBTYPE = 'NONE' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPELOG - TZFIELD%NDIMS = 0 - TZFIELD%LTIMEDEP = .FALSE. - ! - CALL IO_Field_read(TPINIFILE,TZFIELD,GHORELAX_R) - ! - YGETRXM(:)=(/HGETRVM,HGETRCM,HGETRRM,HGETRIM,HGETRSM,HGETRGM,HGETRHM/) - YC(:)=(/"V","C","R","I","S","G","H"/) - IF (GHORELAX_R) THEN - IRIMX=(KSIZELBXR_ll-2*JPHEXT)/2 - IRIMY= (KSIZELBYR_ll-2*JPHEXT)/2 - IL3DX=2*ILBSIZEX+2*JPHEXT - IL3DY=2*ILBSIZEY+2*JPHEXT - ELSE - IRIMX=0 - IRIMY=0 - IL3DX=2*JPHEXT ! 2 - IL3DY=2*JPHEXT ! 2 - END IF - ! - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'kg kg-1' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - IRR=0 - JRR=1 - SELECT CASE(YGETRXM(1)) - CASE('READ') - IRR=IRR+1 - IF ( KSIZELBXR_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBXR'//YC(JRR)//'M' - TZFIELD%CLONGNAME = 'LBXR'//YC(JRR)//'M' - TZFIELD%CLBTYPE = 'LBX' - TZFIELD%CCOMMENT = '2_Y_Z_LBXR'//YC(JRR)//'M' - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXRM(:,:,:,IRR)) - END IF - ! - IF ( KSIZELBYR_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBYR'//YC(JRR)//'M' - TZFIELD%CLONGNAME = 'LBYR'//YC(JRR)//'M' - TZFIELD%CLBTYPE = 'LBY' - TZFIELD%CCOMMENT = '2_Y_Z_LBYR'//YC(JRR)//'M' - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYRM(:,:,:,IRR)) - END IF - CASE('INIT') - IRR=IRR+1 - IF ( SIZE(PLBXRM,1) /= 0 ) PLBXRM(:,:,:,IRR) = 0. - IF ( SIZE(PLBYRM,1) /= 0 ) PLBYRM(:,:,:,IRR) = 0. - END SELECT - ! - ! - DO JRR=2,7 - SELECT CASE(YGETRXM(JRR)) - CASE('READ') - IRR=IRR+1 - IF ( KSIZELBXR_ll /= 0 ) THEN - IF (.NOT. LCPL_AROME .AND. OLSOURCE) THEN - IF (PRESENT(PLBXRMM)) THEN - PLBXRM(:,:,:,IRR)=PLBXRMM(:,:,:,IRR) - WRITE(ILUOUT,*) 'PLBXRS will be initialized to 0 for LBXR'//YC(JRR)//'M' - ELSE - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize PLBXRM for LBXR'//YC(JRR)//'M') - ENDIF - ELSE - TZFIELD%CMNHNAME = 'LBXR'//YC(JRR)//'M' - TZFIELD%CLONGNAME = 'LBXR'//YC(JRR)//'M' - TZFIELD%CLBTYPE = 'LBX' - TZFIELD%CCOMMENT = '2_Y_Z_LBXR'//YC(JRR)//'M' - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXRM(:,:,:,IRR)) - ENDIF - END IF - ! - IF ( KSIZELBYR_ll /= 0 ) THEN - IF (.NOT. LCPL_AROME .AND. OLSOURCE) THEN - IF (PRESENT(PLBYRMM)) THEN - PLBYRM(:,:,:,IRR)=PLBYRMM(:,:,:,IRR) - WRITE(ILUOUT,*) 'PLBYRS will be initialized to 0 for LBYR'//YC(JRR)//'M' - ELSE - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize PLBYRM for LBYR'//YC(JRR)//'M') - ENDIF - ELSE - TZFIELD%CMNHNAME = 'LBYR'//YC(JRR)//'M' - TZFIELD%CLONGNAME = 'LBYR'//YC(JRR)//'M' - TZFIELD%CLBTYPE = 'LBY' - TZFIELD%CCOMMENT = '2_Y_Z_LBYR'//YC(JRR)//'M' - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYRM(:,:,:,IRR)) - ENDIF - END IF - CASE('INIT') - IRR=IRR+1 - IF ( SIZE(PLBXRM,1) /= 0 ) PLBXRM(:,:,:,IRR) = 0. - IF ( SIZE(PLBYRM,1) /= 0 ) PLBYRM(:,:,:,IRR) = 0. - END SELECT - END DO -END IF -! -!* 2.6 LB-Scalar Variables -! -PLBXSVM(:,:,:,:) = 0. -PLBYSVM(:,:,:,:) = 0. -! -IF (KSV > 0) THEN - IF (ANY(HGETSVM(1:KSV)=='READ')) THEN - TZFIELD%CMNHNAME = 'HORELAX_SV' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'HORELAX_SV' - TZFIELD%CUNITS = '' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = '' - TZFIELD%CLBTYPE = 'NONE' - TZFIELD%NGRID = 0 - TZFIELD%NTYPE = TYPELOG - TZFIELD%NDIMS = 0 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_read(TPINIFILE,TZFIELD,GHORELAX_SV) - IF ( GHORELAX_SV ) THEN - IRIMX=(KSIZELBXSV_ll-2*JPHEXT)/2 - IRIMY=(KSIZELBYSV_ll-2*JPHEXT)/2 - IL3DX=2*ILBSIZEX+2*JPHEXT - IL3DY=2*ILBSIZEY+2*JPHEXT - ELSE - IRIMX=0 - IRIMY=0 - IL3DX=2*JPHEXT !2 - IL3DY=2*JPHEXT !2 - END IF - END IF -END IF -! User scalar variables -IF (NSV_USER>0) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'kg kg-1' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = 1, NSV_USER - SELECT CASE(HGETSVM(JSV)) - CASE ('READ') - IF ( KSIZELBXSV_ll /= 0 ) THEN - WRITE(TZFIELD%CMNHNAME,'(A6,I3.3)')'LBXSVM',JSV - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3,A8)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBXSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBXSVMM)) THEN - PLBXSVM(:,:,:,JSV)=PLBXSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'PLXYSVM will be initialized to 0' - ELSE -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize PLBXSVM') - ENDIF - END IF - END IF - END IF - ! - IF (KSIZELBYSV_ll /= 0 ) THEN - WRITE(TZFIELD%CMNHNAME,'(A6,I3.3)')'LBYSVM',JSV - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3,A8)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBYSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBYSVMM)) THEN - PLBYSVM(:,:,:,JSV)=PLBYSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'PLBYSVM will be initialized to 0' - ELSE -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize PLBYSVM') - ENDIF - END IF - END IF - END IF - CASE('INIT') - IF ( SIZE(PLBXSVM,1) /= 0 ) PLBXSVM(:,:,:,JSV) = 0. - IF ( SIZE(PLBYSVM,1) /= 0 ) PLBYSVM(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -! C2R2 scalar variables -IF (NSV_C2R2END>=NSV_C2R2BEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm-3' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_C2R2BEG, NSV_C2R2END - SELECT CASE(HGETSVM(JSV)) - CASE ('READ') - IF ( KSIZELBXSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBX_'//TRIM(C2R2NAMES(JSV-NSV_C2R2BEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBXSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBXSVMM)) THEN - PLBXSVM(:,:,:,JSV)=PLBXSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'C2R2 PLBXSVM will be initialized to 0' - ELSE -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize C2R2 PLBXSVM') - ENDIF - END IF - END IF - END IF - ! - IF (KSIZELBYSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBY_'//TRIM(C2R2NAMES(JSV-NSV_C2R2BEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBYSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBYSVMM)) THEN - PLBYSVM(:,:,:,JSV)=PLBYSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'C2R2 PLBYSVM will be initialized to 0' - ELSE -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize C2R2 PLBYSVM') - ENDIF - END IF - END IF - END IF - CASE('INIT') - IF ( SIZE(PLBXSVM,1) /= 0 ) PLBXSVM(:,:,:,JSV) = 0. - IF ( SIZE(PLBYSVM,1) /= 0 ) PLBYSVM(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -! C1R3 scalar variables -IF (NSV_C1R3END>=NSV_C1R3BEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm-3' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_C1R3BEG, NSV_C1R3END - SELECT CASE(HGETSVM(JSV)) - CASE ('READ') - IF ( KSIZELBXSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBX_'//TRIM(C1R3NAMES(JSV-NSV_C1R3BEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBXSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBXSVMM)) THEN - PLBXSVM(:,:,:,JSV)=PLBXSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'C1R3 PLBXSVM will be initialized to 0' - ELSE -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize C1R3 PLBXSVM') - ENDIF - END IF - END IF - END IF - ! - IF (KSIZELBYSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBY_'//TRIM(C1R3NAMES(JSV-NSV_C1R3BEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBYSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBYSVMM)) THEN - PLBYSVM(:,:,:,JSV)=PLBYSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'C1R3 PLBYSVM will be initialized to 0' - ELSE -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize C1R3 PLBYSVM') - ENDIF - END IF - END IF - END IF - CASE('INIT') - IF ( SIZE(PLBXSVM,1) /= 0 ) PLBXSVM(:,:,:,JSV) = 0. - IF ( SIZE(PLBYSVM,1) /= 0 ) PLBYSVM(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -! -! LIMA: CCN and IFN scalar variables -! -IF (CCLOUD=='LIMA' ) THEN - IF (NSV_LIMA_CCN_FREE+NMOD_CCN-1 >= NSV_LIMA_CCN_FREE) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'kg-1' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_LIMA_CCN_FREE,NSV_LIMA_CCN_FREE+NMOD_CCN-1 - - SELECT CASE(HGETSVM(JSV)) - CASE ('READ') - WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_CCN_FREE + 1) - IF ( KSIZELBXSV_ll /= 0 ) THEN - IF ( TPINIFILE%NMNHVERSION(1) < 5 & - .OR. ( TPINIFILE%NMNHVERSION(1) == 5 .AND. TPINIFILE%NMNHVERSION(2) < 5 ) & - .OR. ( TPINIFILE%NMNHVERSION(1) == 5 .AND. TPINIFILE%NMNHVERSION(2) == 5 & - .AND. TPINIFILE%NMNHVERSION(3) < 1 ) ) THEN - !TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CLIMA_WARM_NAMES(3))//INDICE) - TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CLIMA_WARM_NAMES(3)))//INDICE - ELSE - TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CLIMA_WARM_NAMES(3)))//INDICE - END IF - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBXSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBXSVMM)) THEN - PLBXSVM(:,:,:,JSV)=PLBXSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'CCN PLBXSVM will be initialized to 0' - ELSE -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize CCN PLBXSVM') - ENDIF - END IF - END IF - END IF - - - ! - IF (KSIZELBYSV_ll /= 0 ) THEN - IF ( TPINIFILE%NMNHVERSION(1) < 5 & - .OR. ( TPINIFILE%NMNHVERSION(1) == 5 .AND. TPINIFILE%NMNHVERSION(2) < 5 ) & - .OR. ( TPINIFILE%NMNHVERSION(1) == 5 .AND. TPINIFILE%NMNHVERSION(2) == 5 & - .AND. TPINIFILE%NMNHVERSION(3) < 1 ) ) THEN - ! TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CLIMA_WARM_NAMES(3))//INDICE) - TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CLIMA_WARM_NAMES(3)))//INDICE - ELSE - TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CLIMA_WARM_NAMES(3)))//INDICE - END IF - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBYSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBYSVMM)) THEN - PLBYSVM(:,:,:,JSV)=PLBYSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'CCN PLBYSVM will be initialized to 0' - ELSE -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize CCN PLBYSVM') - ENDIF - END IF - END IF - END IF - CASE('INIT') - IF ( SIZE(PLBXSVM,1) /= 0 ) PLBXSVM(:,:,:,JSV) = 0. - IF ( SIZE(PLBYSVM,1) /= 0 ) PLBYSVM(:,:,:,JSV) = 0. - END SELECT - END DO - END IF - ! - IF (NSV_LIMA_IFN_FREE+NMOD_IFN-1 >= NSV_LIMA_IFN_FREE) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'kg-1' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_LIMA_IFN_FREE,NSV_LIMA_IFN_FREE+NMOD_IFN-1 - SELECT CASE(HGETSVM(JSV)) - CASE ('READ') - WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_IFN_FREE + 1) - IF ( KSIZELBXSV_ll /= 0 ) THEN - IF ( TPINIFILE%NMNHVERSION(1) < 5 & - .OR. ( TPINIFILE%NMNHVERSION(1) == 5 .AND. TPINIFILE%NMNHVERSION(2) < 5 ) & - .OR. ( TPINIFILE%NMNHVERSION(1) == 5 .AND. TPINIFILE%NMNHVERSION(2) == 5 & - .AND. TPINIFILE%NMNHVERSION(3) < 1 ) ) THEN - !TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CLIMA_COLD_NAMES(2))//INDICE) - TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CLIMA_COLD_NAMES(2)))//INDICE - ELSE - TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CLIMA_COLD_NAMES(2)))//INDICE - END IF - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBXSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBXSVMM)) THEN - PLBXSVM(:,:,:,JSV)=PLBXSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'IFN PLBXSVM will be initialized to 0' - ELSE -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize IFN') - ENDIF - END IF - END IF - END IF - ! - IF (KSIZELBYSV_ll /= 0 ) THEN - IF ( TPINIFILE%NMNHVERSION(1) < 5 & - .OR. ( TPINIFILE%NMNHVERSION(1) == 5 .AND. TPINIFILE%NMNHVERSION(2) < 5 ) & - .OR. ( TPINIFILE%NMNHVERSION(1) == 5 .AND. TPINIFILE%NMNHVERSION(2) == 5 & - .AND. TPINIFILE%NMNHVERSION(3) < 1 ) ) THEN - !TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CLIMA_COLD_NAMES(2))//INDICE) - TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CLIMA_COLD_NAMES(2)))//INDICE - ELSE - TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CLIMA_COLD_NAMES(2)))//INDICE - END IF - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBYSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBYSVMM)) THEN - PLBYSVM(:,:,:,JSV)=PLBYSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'IFN PLBYSVM will be initialized to 0' - ELSE -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize IFN') - ENDIF - END IF - END IF - END IF - CASE('INIT') - IF ( SIZE(PLBXSVM,1) /= 0 ) PLBXSVM(:,:,:,JSV) = 0. - IF ( SIZE(PLBYSVM,1) /= 0 ) PLBYSVM(:,:,:,JSV) = 0. - END SELECT - END DO - END IF -ENDIF -! ELEC scalar variables -IF (NSV_ELECEND>=NSV_ELECBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'kg kg-1' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_ELECBEG, NSV_ELECEND - SELECT CASE(HGETSVM(JSV)) - CASE ('READ') - IF ( KSIZELBXSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBX_'//TRIM(CELECNAMES(JSV-NSV_ELECBEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBXSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBXSVMM)) THEN - PLBXSVM(:,:,:,JSV)=PLBXSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'ELEC PLBXSVM will be initialized to 0' - ELSE -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize ELEC PLBXSVM') - ENDIF - END IF - END IF - END IF - ! - IF (KSIZELBYSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBY_'//TRIM(CELECNAMES(JSV-NSV_ELECBEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBYSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBYSVMM)) THEN - PLBYSVM(:,:,:,JSV)=PLBYSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'ELEC PLBYSVM will be initialized to 0' - ELSE -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize ELEC PLBYSVM') - ENDIF - END IF - END IF - END IF - CASE('INIT') - IF ( SIZE(PLBXSVM,1) /= 0 ) PLBXSVM(:,:,:,JSV) = 0. - IF ( SIZE(PLBYSVM,1) /= 0 ) PLBYSVM(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -! Chemical gas phase scalar variables -IF (NSV_CHGSEND>=NSV_CHGSBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'kg-1' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_CHGSBEG, NSV_CHGSEND - SELECT CASE(HGETSVM(JSV)) - CASE ('READ') - IF ( KSIZELBXSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CNAMES(JSV-NSV_CHGSBEG+1))) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBXSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBXSVMM)) THEN - PLBXSVM(:,:,:,JSV)=PLBXSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'Chemical PLBXSVM will be initialized to 0' - ELSE -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize gas phase chemical PLBXSVM') - ENDIF - END IF - END IF - END IF - ! - IF (KSIZELBYSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CNAMES(JSV-NSV_CHGSBEG+1))) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBYSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBYSVMM)) THEN - PLBYSVM(:,:,:,JSV)=PLBYSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'Chemical PLBYSVM will be initialized to 0' - ELSE -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize gas phase chemical PLBYSVM') - ENDIF - END IF - END IF - END IF - CASE('INIT') - IF ( SIZE(PLBXSVM,1) /= 0 ) PLBXSVM(:,:,:,JSV) = 0. - IF ( SIZE(PLBYSVM,1) /= 0 ) PLBYSVM(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -! Chemical aqueous phase scalar variables -IF (NSV_CHACEND>=NSV_CHACBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppp' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_CHACBEG, NSV_CHACEND - SELECT CASE(HGETSVM(JSV)) - CASE ('READ') - IF ( KSIZELBXSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CNAMES(JSV-NSV_CHACBEG+NSV_CHGS+1))) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBXSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBXSVMM)) THEN - PLBXSVM(:,:,:,JSV)=PLBXSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'Chemical PLBXSVM will be initialized to 0' - ELSE -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize aqueous phase chemical PLBXSVM') - ENDIF - END IF - END IF - END IF - ! - IF (KSIZELBYSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CNAMES(JSV-NSV_CHACBEG+NSV_CHGS+1))) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBYSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBYSVMM)) THEN - PLBYSVM(:,:,:,JSV)=PLBYSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'Chemical PLBYSVM will be initialized to 0' - ELSE -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize aqueous phase chemical PLBYSVM') - ENDIF - END IF - END IF - END IF - CASE('INIT') - IF ( SIZE(PLBXSVM,1) /= 0 ) PLBXSVM(:,:,:,JSV) = 0. - IF ( SIZE(PLBYSVM,1) /= 0 ) PLBYSVM(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -! Chemical ice phase scalar variables -IF (NSV_CHICEND>=NSV_CHICBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppp' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_CHICBEG, NSV_CHICEND - SELECT CASE(HGETSVM(JSV)) - CASE ('READ') - IF ( KSIZELBXSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CICNAMES(JSV-NSV_CHICBEG+1))) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBXSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBXSVMM)) THEN - PLBXSVM(:,:,:,JSV)=PLBXSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'Ice phase chemical PLBXSVM will be initialized to 0' - ELSE -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize ice phase chemical PLBXSVM') - ENDIF - END IF - END IF - END IF - ! - IF (KSIZELBYSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CICNAMES(JSV-NSV_CHICBEG+1))) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBYSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBYSVMM)) THEN - PLBYSVM(:,:,:,JSV)=PLBYSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'Ice phase chemical PLBYSVM will be initialized to 0' - ELSE -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize ice phase chemical PLBYSVM') - ENDIF - END IF - END IF - END IF - CASE('INIT') - IF ( SIZE(PLBXSVM,1) /= 0 ) PLBXSVM(:,:,:,JSV) = 0. - IF ( SIZE(PLBYSVM,1) /= 0 ) PLBYSVM(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -! Orilam aerosol scalar variables -IF (NSV_AEREND>=NSV_AERBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppp' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_AERBEG, NSV_AEREND - SELECT CASE(HGETSVM(JSV)) - CASE ('READ') - IF ( KSIZELBXSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CAERONAMES(JSV-NSV_AERBEG+1))) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBXSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBXSVMM)) THEN - PLBXSVM(:,:,:,JSV)=PLBXSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'Aerosol PLBXSVM will be initialized to 0' - ELSE -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize aerosol PLBXSVM') - ENDIF - END IF - END IF - END IF - ! - IF (KSIZELBYSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CAERONAMES(JSV-NSV_AERBEG+1))) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBYSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBYSVMM)) THEN - PLBYSVM(:,:,:,JSV)=PLBYSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'Aerosol PLBYSVM will be initialized to 0' - ELSE -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize aerosol PLBYSVM') - ENDIF - END IF - END IF - END IF - CASE('INIT') - IF ( SIZE(PLBXSVM,1) /= 0 ) PLBXSVM(:,:,:,JSV) = 0. - IF ( SIZE(PLBYSVM,1) /= 0 ) PLBYSVM(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -! Orilam aerosols moist scalar variables -IF (NSV_AERDEPEND>=NSV_AERDEPBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppp' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_AERDEPBEG, NSV_AERDEPEND - SELECT CASE(HGETSVM(JSV)) - CASE ('READ') - IF ( KSIZELBXSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CDEAERNAMES(JSV-NSV_AERDEPBEG+1))) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBXSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBXSVMM)) THEN - PLBXSVM(:,:,:,JSV)=PLBXSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'Aerosol PLBXSVM will be initialized to 0' - ELSE -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize aerosol PLBXSVM') - ENDIF - END IF - END IF - END IF - ! - IF (KSIZELBYSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBY_'//TRIM(CDEAERNAMES(JSV-NSV_AERDEPBEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBYSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBYSVMM)) THEN - PLBYSVM(:,:,:,JSV)=PLBYSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'Aerosol PLBYSVM will be initialized to 0' - ELSE -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize aerosol PLBYSVM') - ENDIF - END IF - END IF - END IF - CASE('INIT') - IF ( SIZE(PLBXSVM,1) /= 0 ) PLBXSVM(:,:,:,JSV) = 0. - IF ( SIZE(PLBYSVM,1) /= 0 ) PLBYSVM(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -! Dust scalar variables -IF (NSV_DSTEND>=NSV_DSTBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppp' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_DSTBEG, NSV_DSTEND - SELECT CASE(HGETSVM(JSV)) - CASE ('READ') - IF ( KSIZELBXSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CDUSTNAMES(JSV-NSV_DSTBEG+1))) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBXSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBXSVMM)) THEN - PLBXSVM(:,:,:,JSV)=PLBXSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'Dust PLBXSVM will be initialized to 0' - ELSE -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize dust PLBXSVM') - ENDIF - END IF - END IF - END IF - ! - IF (KSIZELBYSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CDUSTNAMES(JSV-NSV_DSTBEG+1))) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBYSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBYSVMM)) THEN - PLBYSVM(:,:,:,JSV)=PLBYSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'Dust PLBYSVM will be initialized to 0' - ELSE -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize dust PLBYSVM') - ENDIF - END IF - END IF - END IF - CASE('INIT') - IF ( SIZE(PLBXSVM,1) /= 0 ) PLBXSVM(:,:,:,JSV) = 0. - IF ( SIZE(PLBYSVM,1) /= 0 ) PLBYSVM(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -! -IF (NSV_DSTDEPEND>=NSV_DSTDEPBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppp' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_DSTDEPBEG, NSV_DSTDEPEND - SELECT CASE(HGETSVM(JSV)) - CASE ('READ') - IF ( KSIZELBXSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CDEDSTNAMES(JSV-NSV_DSTDEPBEG+1))) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBXSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBXSVMM)) THEN - PLBXSVM(:,:,:,JSV)=PLBXSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'Dust Desposition PLBXSVM will be initialized to 0' - ELSE -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize dust PLBXSVM') - ENDIF - END IF - END IF - END IF - ! - IF (KSIZELBYSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CDEDSTNAMES(JSV-NSV_DSTDEPBEG+1))) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBYSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBYSVMM)) THEN - PLBYSVM(:,:,:,JSV)=PLBYSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'Dust Depoistion PLBYSVM will be initialized to 0' - ELSE - WRITE(ILUOUT,*) 'Pb to initialize dust PLBYSVM ' -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize dust PLBYSVM') - ENDIF - END IF - END IF - END IF - CASE('INIT') - IF ( SIZE(PLBXSVM,1) /= 0 ) PLBXSVM(:,:,:,JSV) = 0. - IF ( SIZE(PLBYSVM,1) /= 0 ) PLBYSVM(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -! Sea salt scalar variables -IF (NSV_SLTEND>=NSV_SLTBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppp' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_SLTBEG, NSV_SLTEND - SELECT CASE(HGETSVM(JSV)) - CASE ('READ') - IF ( KSIZELBXSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CSALTNAMES(JSV-NSV_SLTBEG+1))) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBXSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBXSVMM)) THEN - PLBXSVM(:,:,:,JSV)=PLBXSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'Sea Salt PLBXSVM will be initialized to 0' - ELSE -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize sea salt PLBXSVM') - ENDIF - END IF - END IF - END IF - ! - IF (KSIZELBYSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBY_'//TRIM(CSALTNAMES(JSV-NSV_SLTBEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBYSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBYSVMM)) THEN - PLBYSVM(:,:,:,JSV)=PLBYSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'Sea Salt PLBYSVM will be initialized to 0' - ELSE -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize sea salt PLBYSVM') - ENDIF - END IF - END IF - END IF - CASE('INIT') - IF ( SIZE(PLBXSVM,1) /= 0 ) PLBXSVM(:,:,:,JSV) = 0. - IF ( SIZE(PLBYSVM,1) /= 0 ) PLBYSVM(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -! Passive pollutant variables -IF (NSV_PPEND>=NSV_PPBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'kg kg-1' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_PPBEG, NSV_PPEND - SELECT CASE(HGETSVM(JSV)) - CASE ('READ') - IF ( KSIZELBXSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBX_PP' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBXSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBXSVMM)) THEN - PLBXSVM(:,:,:,JSV)=PLBXSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'Passive pollutant PLBXSVM will be initialized to 0' - ELSE - PLBXSVM(:,:,:,JSV)=0. - WRITE(ILUOUT,*) 'Passive pollutant PLBXSVM will be initialized to 0' - ENDIF - END IF - END IF - END IF - ! - IF (KSIZELBYSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBY_PP' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBYSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBYSVMM)) THEN - PLBYSVM(:,:,:,JSV)=PLBYSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'Passive pollutant PLBYSVM will be initialized to 0' - ELSE - PLBYSVM(:,:,:,JSV)=0. - WRITE(ILUOUT,*) 'Passive pollutant PLBYSVM will be initialized to 0' - ENDIF - END IF - END IF - END IF - CASE('INIT') - IF ( SIZE(PLBXSVM,1) /= 0 ) PLBXSVM(:,:,:,JSV) = 0. - IF ( SIZE(PLBYSVM,1) /= 0 ) PLBYSVM(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -#ifdef MNH_FOREFIRE -! ForeFire scalar variables -IF (NSV_FFEND>=NSV_FFBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'kg kg-1' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_FFBEG, NSV_FFEND - SELECT CASE(HGETSVM(JSV)) - CASE ('READ') - IF ( KSIZELBXSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBX_FF' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP) - WRITE(ILUOUT,*) 'ForeFire LBX_FF ', IRESP - IF ( SIZE(PLBXSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBXSVMM)) THEN - PLBXSVM(:,:,:,JSV)=PLBXSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'ForeFire pollutant PLBXSVM will be initialized to 0' - ELSE - PLBXSVM(:,:,:,JSV)=0. - WRITE(ILUOUT,*) 'ForeFire pollutant PLBXSVM will be initialized to 0' - ENDIF - END IF - END IF - END IF - ! - IF (KSIZELBYSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBY_FF' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBYSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBYSVMM)) THEN - PLBYSVM(:,:,:,JSV)=PLBYSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'ForeFire scalar variable PLBYSVM will be initialized to 0' - ELSE - PLBYSVM(:,:,:,JSV)=0. - WRITE(ILUOUT,*) 'ForeFire scalar variable PLBYSVM will be initialized to 0' - ENDIF - END IF - END IF - END IF - CASE('INIT') - IF ( SIZE(PLBXSVM,1) /= 0 ) PLBXSVM(:,:,:,JSV) = 0. - IF ( SIZE(PLBYSVM,1) /= 0 ) PLBYSVM(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -#endif -! Conditional sampling variables -IF (NSV_CSEND>=NSV_CSBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'kg kg-1' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_CSBEG, NSV_CSEND - SELECT CASE(HGETSVM(JSV)) - CASE ('READ') - IF ( KSIZELBXSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBX_CS' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBXSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBXSVMM)) THEN - PLBXSVM(:,:,:,JSV)=PLBXSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'Conditional sampling LBXSVM will be initialized to 0' - ELSE - PLBXSVM(:,:,:,JSV)=0. - WRITE(ILUOUT,*) 'Conditional sampling PLBXSVM will be initialized to 0' - ENDIF - END IF - END IF - END IF - ! - IF (KSIZELBYSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBY_CS' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBYSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBYSVMM)) THEN - PLBYSVM(:,:,:,JSV)=PLBYSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'Conditional sampling PLBYSVM will be initialized to 0' - ELSE - PLBYSVM(:,:,:,JSV)=0. - WRITE(ILUOUT,*) 'Conditional sampling PLBYSVM will be initialized to 0' - ENDIF - END IF - END IF - END IF - CASE('INIT') - IF ( SIZE(PLBXSVM,1) /= 0 ) PLBXSVM(:,:,:,JSV) = 0. - IF ( SIZE(PLBYSVM,1) /= 0 ) PLBYSVM(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -! Linox scalar variables -IF (NSV_LNOXEND>=NSV_LNOXBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'kg kg-1' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_LNOXBEG, NSV_LNOXEND - SELECT CASE(HGETSVM(JSV)) - CASE ('READ') - IF ( KSIZELBXSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBX_LINOX' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBXSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBXSVMM)) THEN - PLBXSVM(:,:,:,JSV)=PLBXSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'Linox PLBXSVM will be initialized to 0' - ELSE -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize linox PLBXSVM') - ENDIF - END IF - END IF - END IF - ! - IF (KSIZELBYSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBY_LINOX' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBYSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBYSVMM)) THEN - PLBYSVM(:,:,:,JSV)=PLBYSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'Linox PLBYSVM will be initialized to 0' - ELSE -!calla bortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize linox PLBYSVM') - ENDIF - END IF - END IF - END IF - CASE('INIT') - IF ( SIZE(PLBXSVM,1) /= 0 ) PLBXSVM(:,:,:,JSV) = 0. - IF ( SIZE(PLBYSVM,1) /= 0 ) PLBYSVM(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -! Lagrangian variables -IF (NSV_LGEND>=NSV_LGBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_LGBEG, NSV_LGEND - SELECT CASE(HGETSVM(JSV)) - CASE ('READ') - IF ( KSIZELBXSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBX_'//TRIM(CLGNAMES(JSV-NSV_LGBEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DX,IRIMX,PLBXSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBXSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBXSVMM)) THEN - PLBXSVM(:,:,:,JSV)=PLBXSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'lagrangian PLBXSVM will be initialized to 0' - ELSE -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize lagrangian PLBXSVM') - ENDIF - END IF - END IF - END IF - ! - IF (KSIZELBYSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBY_'//TRIM(CLGNAMES(JSV-NSV_LGBEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_read_lb(TPINIFILE,TZFIELD,IL3DY,IRIMY,PLBYSVM(:,:,:,JSV),IRESP) - IF ( SIZE(PLBYSVM,1) /= 0 ) THEN - IF (IRESP/=0) THEN - IF (PRESENT(PLBYSVMM)) THEN - PLBYSVM(:,:,:,JSV)=PLBYSVMM(:,:,:,JSV) - WRITE(ILUOUT,*) 'lagrangian PLBYSVM will be initialized to 0' - ELSE -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_LB','problem to initialize lagrangian PLBYSVM') - ENDIF - END IF - END IF - END IF - ! - CASE('INIT') - IF ( SIZE(PLBXSVM,1) /= 0 ) PLBXSVM(:,:,:,JSV) = 0. - IF ( SIZE(PLBYSVM,1) /= 0 ) PLBYSVM(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -!------------------------------------------------------------------------------- -! -!* 3. COMPUTE THE LB SOURCES -! ----------------------- -! -! IN case of initialization of LB source terms (OLSOURCE=T) : -! xxxM are LB source terms -! xxxMM are LB fields at time t -dt -IF (OLSOURCE) THEN - IF (PRESENT(PLBXUMM).AND.PRESENT(PLBYUMM)) THEN - PLBXUM(:,:,:) = (PLBXUM(:,:,:) - PLBXUMM(:,:,:)) / PLENG - PLBYUM(:,:,:) = (PLBYUM(:,:,:) - PLBYUMM(:,:,:)) / PLENG - ENDIF - IF (PRESENT(PLBXVMM).AND.PRESENT(PLBYVMM)) THEN - PLBXVM(:,:,:) = (PLBXVM(:,:,:) - PLBXVMM(:,:,:)) / PLENG - PLBYVM(:,:,:) = (PLBYVM(:,:,:) - PLBYVMM(:,:,:)) / PLENG - ENDIF - IF (PRESENT(PLBXWMM).AND.PRESENT(PLBYWMM)) THEN - PLBXWM(:,:,:) = (PLBXWM(:,:,:) - PLBXWMM(:,:,:)) / PLENG - PLBYWM(:,:,:) = (PLBYWM(:,:,:) - PLBYWMM(:,:,:)) / PLENG - ENDIF - IF (PRESENT(PLBXTHMM).AND.PRESENT(PLBYTHMM)) THEN - PLBXTHM(:,:,:) = (PLBXTHM(:,:,:) - PLBXTHMM(:,:,:)) / PLENG - PLBYTHM(:,:,:) = (PLBYTHM(:,:,:) - PLBYTHMM(:,:,:)) / PLENG - ENDIF - IF (HGETTKEM =='READ') THEN - IF (PRESENT(PLBXTKEMM).AND.PRESENT(PLBYTKEMM)) THEN - PLBXTKEM(:,:,:) = (PLBXTKEM(:,:,:) - PLBXTKEMM(:,:,:)) / PLENG - PLBYTKEM(:,:,:) = (PLBYTKEM(:,:,:) - PLBYTKEMM(:,:,:)) / PLENG - ENDIF - ENDIF - IF (HGETTKEM =='INIT') THEN - PLBXTKEM(:,:,:) = 0. - PLBYTKEM(:,:,:) = 0. - ENDIF -! LB moist variables - IRR=0 - IF (PRESENT(PLBXRMM).AND.PRESENT(PLBYRMM)) THEN - DO JRR=1,7 - IF (YGETRXM(JRR) == 'READ') THEN - IRR=IRR+1 - PLBXRM(:,:,:,IRR) = (PLBXRM(:,:,:,IRR) - PLBXRMM(:,:,:,IRR)) / PLENG - PLBYRM(:,:,:,IRR) = (PLBYRM(:,:,:,IRR) - PLBYRMM(:,:,:,IRR)) / PLENG - ENDIF - END DO - ENDIF -! LB-scalar variables - DO JSV=1,KSV - IF (HGETSVM(JSV) == 'READ') THEN - PLBXSVM(:,:,:,JSV) = (PLBXSVM(:,:,:,JSV) - PLBXSVMM(:,:,:,JSV)) / PLENG - PLBYSVM(:,:,:,JSV) = (PLBYSVM(:,:,:,JSV) - PLBYSVMM(:,:,:,JSV)) / PLENG - ENDIF - END DO -! -ENDIF - -! -END SUBROUTINE INI_LB diff --git a/src/ICCARE_BASE/ini_lima_cold_mixed.f90 b/src/ICCARE_BASE/ini_lima_cold_mixed.f90 deleted file mode 100644 index bd43aa295..000000000 --- a/src/ICCARE_BASE/ini_lima_cold_mixed.f90 +++ /dev/null @@ -1,1464 +0,0 @@ -!MNH_LIC Copyright 2013-2019 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!----------------------------------------------------------------- -! ############################### - MODULE MODI_INI_LIMA_COLD_MIXED -! ############################### -! -INTERFACE - SUBROUTINE INI_LIMA_COLD_MIXED (PTSTEP, PDZMIN) -! -REAL, INTENT(IN) :: PTSTEP ! Effective Time step -REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size -! -END SUBROUTINE INI_LIMA_COLD_MIXED -! -END INTERFACE -! -END MODULE MODI_INI_LIMA_COLD_MIXED -! ############################################### - SUBROUTINE INI_LIMA_COLD_MIXED (PTSTEP, PDZMIN) -! ############################################### -! -!! PURPOSE -!! ------- -!! The purpose of this routine is to initialize the constants used in the -!! microphysical scheme LIMA for the cold and mixed phase variables -!! and processes. -!! -!! AUTHOR -!! ------ -!! J.-M. Cohard * Laboratoire d'Aerologie* -!! J.-P. Pinty * Laboratoire d'Aerologie* -!! S. Berthet * Laboratoire d'Aerologie* -!! B. Vié * Laboratoire d'Aerologie* -!! -!! MODIFICATIONS -!! ------------- -!! Original ??/??/13 -!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O -! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg -! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function -! C. Barthe 14/03/2022: add CIBU and RDSF -! -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_CST -USE MODD_LUNIT, ONLY: TLUOUT0 -USE MODD_PARAMETERS -USE MODD_PARAM_LIMA -USE MODD_PARAM_LIMA_WARM -USE MODD_PARAM_LIMA_COLD -USE MODD_PARAM_LIMA_MIXED -USE MODD_REF -! -use mode_msg -! -USE MODI_LIMA_FUNCTIONS -USE MODI_GAMMA -USE MODI_GAMMA_INC -USE MODI_RRCOLSS -USE MODI_RZCOLX -USE MODI_RSCOLRG -USE MODI_LIMA_READ_XKER_RACCS -USE MODI_LIMA_READ_XKER_SDRYG -USE MODI_LIMA_READ_XKER_RDRYG -USE MODI_LIMA_READ_XKER_SWETH -USE MODI_LIMA_READ_XKER_GWETH -! -IMPLICIT NONE -! -!* 0.1 Declarations of dummy arguments : -! -REAL, INTENT(IN) :: PTSTEP ! Effective Time step -REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size -! -!* 0.2 Declarations of local variables : -! -character(len=13) :: yval ! String for error message -INTEGER :: IKB ! Coordinates of the first physical - ! points along z -INTEGER :: J1,J2 ! Internal loop indexes -! -REAL, DIMENSION(8) :: ZGAMI ! parameters involving various moments -REAL, DIMENSION(2) :: ZGAMS ! of the generalized gamma law -! -REAL :: ZT ! Work variable -REAL :: ZVTRMAX ! Raindrop maximal fall velocity -REAL :: ZRHO00 ! Surface reference air density -REAL :: ZRATE ! Geometrical growth of Lbda in the tabulated - ! functions and kernels -REAL :: ZBOUND ! XDCSLIM*Lbda_s: upper bound for the partial - ! integration of the riming rate of the aggregates -REAL :: ZEGS, ZEGR, ZEHS, ZEHG! Bulk collection efficiencies -! -INTEGER :: IND ! Number of interval to integrate the kernels -REAL :: ZESR ! Mean efficiency of rain-aggregate collection -REAL :: ZFDINFTY ! Factor used to define the "infinite" diameter -! -! -INTEGER :: ILUOUT0 ! Logical unit number for output-listing -LOGICAL :: GFLAG ! Logical flag for printing the constatnts on the output - ! listing -REAL :: ZCONC_MAX ! Maximal concentration for snow -REAL :: ZFACT_NUCL! Amplification factor for the minimal ice concentration -! -INTEGER :: KND -INTEGER :: KACCLBDAS,KACCLBDAR,KDRYLBDAG,KDRYLBDAS,KDRYLBDAR -REAL :: PALPHAR,PALPHAS,PALPHAG,PALPHAH -REAL :: PNUR,PNUS,PNUG,PNUH -REAL :: PBR,PBS,PBG,PBH -REAL :: PCR,PCS,PCG,PCH -REAL :: PDR,PDS,PDG,PDH -REAL :: PESR,PEGS,PEGR,PEHS,PEHG -REAL :: PFDINFTY -REAL :: PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN -REAL :: PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN -REAL :: PDRYLBDAR_MAX,PDRYLBDAR_MIN -REAL :: PWETLBDAS_MAX,PWETLBDAG_MAX,PWETLBDAS_MIN,PWETLBDAG_MIN -REAL :: PWETLBDAH_MAX,PWETLBDAH_MIN -INTEGER :: KWETLBDAS,KWETLBDAG,KWETLBDAH -! -REAL :: ZFAC_ZRNIC ! Zrnic factor used to decrease Long Kernels -! -REAL :: ZBOUND_CIBU_SMIN ! XDCSLIM*Lbda_s : lower & upper bound used -REAL :: ZBOUND_CIBU_SMAX ! in the tabulated function -REAL :: ZBOUND_CIBU_GMIN ! XDCGLIM*Lbda_g : lower & upper bound used -REAL :: ZBOUND_CIBU_GMAX ! in the tabulated function -REAL :: ZRATE_S ! Geometrical growth of Lbda_s in the tabulated function -REAL :: ZRATE_G ! Geometrical growth of Lbda_g in the tabulated function -! -REAL :: ZBOUND_RDSF_RMIN ! XDCRLIM*Lbda_r : lower & upper bound used -REAL :: ZBOUND_RDSF_RMAX ! in the tabulated function -REAL :: ZRATE_R ! Geometrical growth of Lbda_r in the tabulated function -REAL :: ZKHI_LWM ! Coefficient of Lawson et al. (2015) -! -REAL :: ZRHOIW ! ice density -! -!------------------------------------------------------------------------------- -! -! -ILUOUT0 = TLUOUT0%NLU -! -! -!* 1. CHARACTERISTICS OF THE SPECIES -! ------------------------------ -! -! -!* 1.2 Ice crystal characteristics -! -SELECT CASE (CPRISTINE_ICE_LIMA) - CASE('PLAT') - XAI = 0.82 ! Plates - XBI = 2.5 ! Plates - XC_I = 747. ! Plates - XDI = 1.0 ! Plates - XC1I = 1./XPI ! Plates - CASE('COLU') - XAI = 2.14E-3 ! Columns - XBI = 1.7 ! Columns - XC_I = 1.96E5 ! Columns - XDI = 1.585 ! Columns - XC1I = 0.8 ! Columns - CASE('BURO') - XAI = 44.0 ! Bullet rosettes - XBI = 3.0 ! Bullet rosettes - XC_I = 4.E5 ! Bullet rosettes - XDI = 1.663 ! Bullet rosettes - XC1I = 0.5 ! Bullet rosettes -END SELECT -! -! Note that XCCI=N_i (a locally predicted value) and XCXI=0.0, implicitly -! -XF0I = 1.00 -! Correction BVIE XF2I from Pruppacher 1997 eq 13-88 -!XF2I = 0.103 -XF2I = 0.14 -XF0IS = 0.86 -XF1IS = 0.28 -! -!* 1.3 Snowflakes/aggregates characteristics -! -XAS = 0.02 -XBS = 1.9 -XCS = 5. -XDS = 0.27 -! -XCCS = 5.0 -XCXS = 1.0 -! -XF0S = 0.86 -XF1S = 0.28 -! -XC1S = 1./XPI -! -!* 1.4 Graupel characteristics -! -XAG = 19.6 ! Lump graupel case -XBG = 2.8 ! Lump graupel case -XCG = 122. ! Lump graupel case -XDG = 0.66 ! Lump graupel case -! -XCCG = 5.E5 -XCXG = -0.5 -! XCCG = 4.E4 ! Test of Ziegler (1988) -! XCXG = -1.0 ! Test of Ziegler (1988) -! -XF0G = 0.86 -XF1G = 0.28 -! -XC1G = 1./2. -! -!* 2.5 Hailstone characteristics -! -! -XAH = 470. -XBH = 3.0 -XCH = 201. -XDH = 0.64 -! -!XCCH = 5.E-4 -!XCXH = 2.0 -!!!!!!!!!!!! - XCCH = 4.E4 ! Test of Ziegler (1988) - XCXH = -1.0 ! Test of Ziegler (1988) -!!! XCCH = 5.E5 ! Graupel_like -!!! XCXH = -0.5 ! Graupel_like -!!!!!!!!!!!! -! -XF0H = 0.86 -XF1H = 0.28 -! -XC1H = 1./2. -! -!------------------------------------------------------------------------------- -! -! -!* 2. DIMENSIONAL DISTRIBUTIONS OF THE SPECIES -! ---------------------------------------- -! -! -!* 2.1 Ice, snow, graupel and hail distribution -! -! -XALPHAI = 3.0 ! Gamma law for the ice crystal volume -XNUI = 3.0 ! Gamma law with little dispersion -! -XALPHAS = 1.0 ! Exponential law -XNUS = 1.0 ! Exponential law -! -XALPHAG = 1.0 ! Exponential law -XNUG = 1.0 ! Exponential law -! -XALPHAH = 1.0 ! Gamma law -XNUH = 8.0 ! Gamma law with little dispersion -! -!* 2.2 Constants for shape parameter -! -XLBEXI = 1.0/XBI -XLBI = XAI*MOMG(XALPHAI,XNUI,XBI) -! -XLBEXS = 1.0/(XCXS-XBS) -XLBS = ( XAS*XCCS*MOMG(XALPHAS,XNUS,XBS) )**(-XLBEXS) -! -XLBEXG = 1.0/(XCXG-XBG) -XLBG = ( XAG*XCCG*MOMG(XALPHAG,XNUG,XBG))**(-XLBEXG) -! -XLBEXH = 1.0/(XCXH-XBH) -XLBH = ( XAH*XCCH*MOMG(XALPHAH,XNUH,XBH) )**(-XLBEXH) -! -GFLAG = .TRUE. -IF (GFLAG) THEN - WRITE(UNIT=ILUOUT0,FMT='(" Shape Parameters")') - WRITE(UNIT=ILUOUT0,FMT='(" XLBEXI =",E13.6," XLBI =",E13.6)') XLBEXI,XLBI - WRITE(UNIT=ILUOUT0,FMT='(" XLBEXS =",E13.6," XLBS =",E13.6)') XLBEXS,XLBS - WRITE(UNIT=ILUOUT0,FMT='(" XLBEXG =",E13.6," XLBG =",E13.6)') XLBEXG,XLBG - WRITE(UNIT=ILUOUT0,FMT='(" XLBEXH =",E13.6," XLBH =",E13.6)') XLBEXH,XLBH -END IF -! -XLBDAS_MAX = 500000 -XLBDAG_MAX = 100000.0 -! -ZCONC_MAX = 1.E6 ! Maximal concentration for falling particules set to 1 per cc -!XLBDAS_MAX = ( ZCONC_MAX/XCCS )**(1./XCXS) -!XLBDAG_MAX = ( ZCONC_MAX/XCCG )**(1./XCXG) -!XLBDAH_MAX = ( ZCONC_MAX/XCCH )**(1./XCXH) -! -!------------------------------------------------------------------------------- -! -! -!* 3. CONSTANTS FOR THE SEDIMENTATION -! ------------------------------- -! -! -!* 3.1 Exponent of the fall-speed air density correction -! -IKB = 1 + JPVEXT -! Correction -! ZRHO00 = XP00/(XRD*XTHVREFZ(IKB)) -ZRHO00 = 1.2041 ! at P=1013.25hPa and T=20°C -! -!* 3.2 Constants for sedimentation -! -!! XEXRSEDI = (XBI+XDI)/XBI -!! XEXCSEDI = 1.0-XEXRSEDI -!! XFSEDI = (4.*XPI*900.)**(-XEXCSEDI) * & -!! XC_I*XAI*MOMG(XALPHAI,XNUI,XBI+XDI) * & -!! ((XAI*MOMG(XALPHAI,XNUI,XBI)))**(-XEXRSEDI) * & -!! (ZRHO00)**XCEXVT -!! ! -!! ! Computations made for Columns -!! ! -!! XEXRSEDI = 1.9324 -!! XEXCSEDI =-0.9324 -!! XFSEDI = 3.89745E11*MOMG(XALPHAI,XNUI,3.285)* & -!! MOMG(XALPHAI,XNUI,1.7)**(-XEXRSEDI)*(ZRHO00)**XCEXVT -!! XEXCSEDI =-0.9324*3.0 -!! WRITE (ILUOUT0,FMT=*)' PRISTINE ICE SEDIMENTATION for columns XFSEDI=',XFSEDI -! -! -XFSEDRI = XC_I*GAMMA_X0D(XNUI+(XDI+XBI)/XALPHAI)/GAMMA_X0D(XNUI+XBI/XALPHAI)* & - (ZRHO00)**XCEXVT -XFSEDCI = XC_I*GAMMA_X0D(XNUI+XDI/XALPHAI)/GAMMA_X0D(XNUI)* & - (ZRHO00)**XCEXVT -! -XEXSEDS = (XBS+XDS-XCXS)/(XBS-XCXS) -XFSEDS = XCS*XAS*XCCS*MOMG(XALPHAS,XNUS,XBS+XDS)* & - (XAS*XCCS*MOMG(XALPHAS,XNUS,XBS))**(-XEXSEDS)*(ZRHO00)**XCEXVT -! -XEXSEDG = (XBG+XDG-XCXG)/(XBG-XCXG) -XFSEDG = XCG*XAG*XCCG*MOMG(XALPHAG,XNUG,XBG+XDG)* & - (XAG*XCCG*MOMG(XALPHAG,XNUG,XBG))**(-XEXSEDG)*(ZRHO00)**XCEXVT -! -XEXSEDH = (XBH+XDH-XCXH)/(XBH-XCXH) -XFSEDH = XCH*XAH*XCCH*MOMG(XALPHAH,XNUH,XBH+XDH)* & - (XAH*XCCH*MOMG(XALPHAH,XNUH,XBH))**(-XEXSEDH)*(ZRHO00)**XCEXVT -! -! -! -XLB(4) = XLBI -XLBEX(4) = XLBEXI -XD(4) = XDI -XFSEDR(4) = XFSEDRI -XFSEDC(4) = XFSEDCI -! -XLB(5) = XLBS -XLBEX(5) = XLBEXS -XD(5) = XDS -XFSEDR(5) = XCS*GAMMA_X0D(XNUS+(XDS+XBS)/XALPHAS)/GAMMA_X0D(XNUS+XBS/XALPHAS)* & - (ZRHO00)**XCEXVT -! -XLB(6) = XLBG -XLBEX(6) = XLBEXG -XD(6) = XDG -XFSEDR(6) = XCG*GAMMA_X0D(XNUG+(XDG+XBG)/XALPHAG)/GAMMA_X0D(XNUG+XBG/XALPHAG)* & - (ZRHO00)**XCEXVT -! -XLB(7) = XLBH -XLBEX(7) = XLBEXH -XD(7) = XDH -XFSEDR(7) = XCH*GAMMA_X0D(XNUH+(XDH+XBH)/XALPHAH)/GAMMA_X0D(XNUH+XBH/XALPHAH)* & - (ZRHO00)**XCEXVT -! -!------------------------------------------------------------------------------- -! -! -!* 4. CONSTANTS FOR HETEROGENEOUS NUCLEATION -! -------------------------------------- -! -! -! *************** -!* 4.1 LIMA_NUCLEATION -! *************** -!* 4.1.1 Constants for the computation of the number concentration -! of active IN -! -XRHO_CFDC = 0.76 -! -XGAMMA = 2. -! -IF (NPHILLIPS == 13) THEN - XAREA1(1) = 2.0E-6 !DM1 - XAREA1(2) = XAREA1(1) !DM2 - XAREA1(3) = 1.0E-7 !BC - XAREA1(4) = 8.9E-7 !BIO -ELSE IF (NPHILLIPS == 8) THEN - XAREA1(1) = 2.0E-6 !DM1 - XAREA1(2) = XAREA1(1) !DM2 - XAREA1(3) = 2.7E-7 !BC - XAREA1(4) = 9.1E-7 !BIO -ELSE - call Print_msg( NVERB_FATAL, 'GEN', 'INI_LIMA_COLD_MIXED', 'NPHILLIPS should be equal to 8 or 13' ) -END IF -! -!* 4.1.2 Constants for the computation of H_X (the fraction-redu- -! cing IN activity at low S_i and warm T) for X={DM1,DM2,BC,BIO} -! -! -IF (NPHILLIPS == 13) THEN - XDT0(1) = 5. +273.15 !DM1 - XDT0(2) = 5. +273.15 !DM2 - XDT0(3) = 10. +273.15 !BC - XDT0(4) = 5. +273.15 !BIOO -! - XT0(1) = -40. +273.15 !DM1 - XT0(2) = XT0(1) !DM2 - XT0(3) = -50. +273.15 !BC - XT0(4) = -20. +273.15 !BIO -! - XSW0 = 0.97 -! - XDSI0(1) = 0.1 !DM1 - XDSI0(2) = 0.1 !DM2 - XDSI0(3) = 0.1 !BC - XDSI0(4) = 0.2 !BIO -! - XH(1) = 0.15 !DM1 - XH(2) = 0.15 !DM2 - XH(3) = 0. !BC - XH(4) = 0. !O -! - XTX1(1) = -30. +273.15 !DM1 - XTX1(2) = XTX1(1) !DM2 - XTX1(3) = -25. +273.15 !BC - XTX1(4) = -5. +273.15 !BIO -! - XTX2(1) = -10. +273.15 !DM1 - XTX2(2) = XTX2(1) !DM2 - XTX2(3) = -15. +273.15 !BC - XTX2(4) = -2. +273.15 !BIO -ELSE IF (NPHILLIPS == 8) THEN - XDT0(1) = 5. +273.15 !DM1 - XDT0(2) = 5. +273.15 !DM2 - XDT0(3) = 5. +273.15 !BC - XDT0(4) = 5. +273.15 !O -! - XT0(1) = -40. +273.15 !DM1 - XT0(2) = XT0(1) !DM2 - XT0(3) = -50. +273.15 !BC - XT0(4) = -50. +273.15 !BIO -! - XSW0 = 0.97 -! - XDSI0(1) = 0.1 !DM1 - XDSI0(2) = 0.1 !DM2 - XDSI0(3) = 0.1 !BC - XDSI0(4) = 0.1 !BIO -! - XH(1) = 0.15 !DM1 - XH(2) = 0.15 !DM2 - XH(3) = 0. !BC - XH(4) = 0. !O -! - XTX1(1) = -5. +273.15 !DM1 - XTX1(2) = XTX1(1) !DM2 - XTX1(3) = -5. +273.15 !BC - XTX1(4) = -5. +273.15 !BIO -! - XTX2(1) = -2. +273.15 !DM1 - XTX2(2) = XTX2(1) !DM2 - XTX2(3) = -2. +273.15 !BC - XTX2(4) = -2. +273.15 !BIO -END IF -! -!* 4.1.3 Constants for the computation of the Gauss Hermitte -! quadrature method used for the integration of the total -! crystal number over T>-35°C -! -NDIAM = 70 -! -ALLOCATE(XABSCISS(NDIAM)) -ALLOCATE(XWEIGHT (NDIAM)) -! -CALL GAUHER(XABSCISS, XWEIGHT, NDIAM) -! -! ***************** -!* 4.2 MEYERS NUCLEATION -! ***************** -! -ZFACT_NUCL = 1.0 ! Plates, Columns and Bullet rosettes -! -!* 5.2.1 Constants for nucleation from ice nuclei -! -XNUC_DEP = XFACTNUC_DEP*1000.*ZFACT_NUCL -XEXSI_DEP = 12.96E-2 -XEX_DEP = -0.639 -! -XNUC_CON = XFACTNUC_CON*1000.*ZFACT_NUCL -XEXTT_CON = -0.262 -XEX_CON = -2.8 -! -XMNU0 = 6.88E-13 -! -IF (LMEYERS) THEN - WRITE(UNIT=ILUOUT0,FMT='(" Heterogeneous nucleation")') - WRITE(UNIT=ILUOUT0,FMT='(" XNUC_DEP=",E13.6," XEXSI=",E13.6," XEX=",E13.6)') & - XNUC_DEP,XEXSI_DEP,XEX_DEP - WRITE(UNIT=ILUOUT0,FMT='(" XNUC_CON=",E13.6," XEXTT=",E13.6," XEX=",E13.6)') & - XNUC_CON,XEXTT_CON,XEX_CON - WRITE(UNIT=ILUOUT0,FMT='(" mass of embryo XMNU0=",E13.6)') XMNU0 -END IF -! -!------------------------------------------------------------------------------- -! -! -!* 5. CONSTANTS FOR THE SLOW COLD PROCESSES -! ------------------------------------- -! -! -!* 5.1.2 Constants for homogeneous nucleation from haze particules -! -XRHOI_HONH = 925.0 -XCEXP_DIFVAP_HONH = 1.94 -XCOEF_DIFVAP_HONH = (2.0*XPI)*0.211E-4*XP00/XTT**XCEXP_DIFVAP_HONH -XCRITSAT1_HONH = 2.583 -XCRITSAT2_HONH = 207.83 -XTMIN_HONH = 180.0 -XTMAX_HONH = 240.0 -XDLNJODT1_HONH = 4.37 -XDLNJODT2_HONH = 0.03 -XC1_HONH = 100.0 -XC2_HONH = 22.6 -XC3_HONH = 0.1 -XRCOEF_HONH = (XPI/6.0)*XRHOI_HONH -! -! -!* 5.1.3 Constants for homogeneous nucleation from cloud droplets -! -XTEXP1_HONC = -606.3952*LOG(10.0) -XTEXP2_HONC = -52.6611*LOG(10.0) -XTEXP3_HONC = -1.7439*LOG(10.0) -XTEXP4_HONC = -0.0265*LOG(10.0) -XTEXP5_HONC = -1.536E-4*LOG(10.0) -IF (XALPHAC == 3.0) THEN - XC_HONC = XPI/6.0 - XR_HONC = XPI/6.0 -ELSE - write ( yval, '( E13.6 )' ) xalphac - call Print_msg( NVERB_FATAL, 'GEN', 'INI_LIMA_COLD_MIXED', 'homogeneous nucleation: XALPHAC='//trim(yval)// & - '/= 3. No algorithm developed for this case' ) -END IF -! -GFLAG = .TRUE. -IF (GFLAG) THEN - WRITE(UNIT=ILUOUT0,FMT='(" Homogeneous nucleation")') - WRITE(UNIT=ILUOUT0,FMT='(" XTEXP1_HONC=",E13.6)') XTEXP1_HONC - WRITE(UNIT=ILUOUT0,FMT='(" XTEXP2_HONC=",E13.6)') XTEXP2_HONC - WRITE(UNIT=ILUOUT0,FMT='(" XTEXP3_HONC=",E13.6)') XTEXP3_HONC - WRITE(UNIT=ILUOUT0,FMT='(" XTEXP4_HONC=",E13.6)') XTEXP4_HONC - WRITE(UNIT=ILUOUT0,FMT='(" XTEXP5_HONC=",E13.6)') XTEXP5_HONC - WRITE(UNIT=ILUOUT0,FMT='("XC_HONC=",E13.6," XR_HONC=",E13.6)') XC_HONC,XR_HONC -END IF -! -! -!* 5.2 Constants for vapor deposition on ice -! -XSCFAC = (0.63**(1./3.))*SQRT((ZRHO00)**XCEXVT) ! One assumes Sc=0.63 -! -X0DEPI = (4.0*XPI)*XC1I*XF0I*MOMG(XALPHAI,XNUI,1.) -X2DEPI = (4.0*XPI)*XC1I*XF2I*XC_I*MOMG(XALPHAI,XNUI,XDI+2.0) -! -! Harrington parameterization for ice to snow conversion -! -XDICNVS_LIM = 125.E-6 ! size in microns -XLBDAICNVS_LIM = (50.0**(1.0/(XALPHAI)))/XDICNVS_LIM ! ZLBDAI Limitation -XC0DEPIS = ((4.0*XPI)/(XAI*XBI))*XC1I*XF0IS* & - (XALPHAI/GAMMA_X0D(XNUI))*XDICNVS_LIM**(1.0-XBI) -XC1DEPIS = ((4.0*XPI)/(XAI*XBI))*XC1I*XF1IS*SQRT(XC_I)* & - (XALPHAI/GAMMA_X0D(XNUI))*XDICNVS_LIM**(1.0-XBI+(XDI+1.0)/2.0) -XR0DEPIS = XC0DEPIS *(XAI*XDICNVS_LIM**XBI) -XR1DEPIS = XC1DEPIS *(XAI*XDICNVS_LIM**XBI) -! -! Harrington parameterization for snow to ice conversion -! -XLBDASCNVI_MAX = 6000. ! lbdas max after Field (1999) -! -XDSCNVI_LIM = 125.E-6 ! size in microns -XLBDASCNVI_LIM = (50.0**(1.0/(XALPHAS)))/XDSCNVI_LIM ! ZLBDAS Limitation -XC0DEPSI = ((4.0*XPI)/(XAS*XBS))*XC1S*XF0IS* & - (XALPHAS/GAMMA_X0D(XNUS))*XDSCNVI_LIM**(1.0-XBS) -XC1DEPSI = ((4.0*XPI)/(XAS*XBS))*XC1S*XF1IS*SQRT(XCS)* & - (XALPHAS/GAMMA_X0D(XNUS))*XDSCNVI_LIM**(1.0-XBS+(XDS+1.0)/2.0) -XR0DEPSI = XC0DEPSI *(XAS*XDSCNVI_LIM**XBS) -XR1DEPSI = XC1DEPSI *(XAS*XDSCNVI_LIM**XBS) -! -! Vapor deposition on snow and graupel and hail -! -X0DEPS = (4.0*XPI)*XCCS*XC1S*XF0S*MOMG(XALPHAS,XNUS,1.) -X1DEPS = (4.0*XPI)*XCCS*XC1S*XF1S*SQRT(XCS)*MOMG(XALPHAS,XNUS,0.5*XDS+1.5) -XEX0DEPS = XCXS-1.0 -XEX1DEPS = XCXS-0.5*(XDS+3.0) -! -X0DEPG = (4.0*XPI)*XCCG*XC1G*XF0G*MOMG(XALPHAG,XNUG,1.) -X1DEPG = (4.0*XPI)*XCCG*XC1G*XF1G*SQRT(XCG)*MOMG(XALPHAG,XNUG,0.5*XDG+1.5) -XEX0DEPG = XCXG-1.0 -XEX1DEPG = XCXG-0.5*(XDG+3.0) -! -X0DEPH = (4.0*XPI)*XCCH*XC1H*XF0H*MOMG(XALPHAH,XNUH,1.) -X1DEPH = (4.0*XPI)*XCCH*XC1H*XF1H*SQRT(XCH)*MOMG(XALPHAH,XNUH,0.5*XDH+1.5) -XEX0DEPH = XCXH-1.0 -XEX1DEPH = XCXH-0.5*(XDH+3.0) -! -!------------------------------------------------------------------------------- -! -! -!* 6. CONSTANTS FOR THE COALESCENCE PROCESSES -! --------------------------------------- -! -! -!* 6.0 Precalculation of the gamma function momentum -! -ZGAMI(1) = GAMMA_X0D(XNUI) -ZGAMI(2) = MOMG(XALPHAI,XNUI,3.) -ZGAMI(3) = MOMG(XALPHAI,XNUI,6.) -ZGAMI(4) = ZGAMI(3)-ZGAMI(2)**2 ! useful for Sig_I -ZGAMI(5) = MOMG(XALPHAI,XNUI,9.) -ZGAMI(6) = MOMG(XALPHAI,XNUI,3.+XBI) -ZGAMI(7) = MOMG(XALPHAI,XNUI,XBI) -ZGAMI(8) = MOMG(XALPHAI,XNUI,3.)/MOMG(XALPHAI,XNUI,2.) -! -ZGAMS(1) = GAMMA_X0D(XNUS) -ZGAMS(2) = MOMG(XALPHAS,XNUS,3.) -! -! -!* 6.1 Csts for the coalescence processes -! -ZFAC_ZRNIC = 0.1 -XKER_ZRNIC_A1 = 2.59E15*ZFAC_ZRNIC**2! From Long a1=9.44E9 cm-3 - ! so XKERA1= 9.44E9*1E6*(PI/6)**2 -XKER_ZRNIC_A2 = 3.03E3*ZFAC_ZRNIC ! From Long a2=5.78E3 - ! so XKERA2= 5.78E3* (PI/6) -! -! -!* 6.2 Csts for the pristine ice selfcollection process -! -XSELFI = XKER_ZRNIC_A1*ZGAMI(3) -XCOLEXII = 0.025 ! Temperature factor of the I+I collection efficiency -! -! -!* 6.3 Constants for pristine ice autoconversion -! -XTEXAUTI = 0.025 ! Temperature factor of the I+I collection efficiency -! -GFLAG = .TRUE. -IF (GFLAG) THEN - WRITE(UNIT=ILUOUT0,FMT='(" pristine ice autoconversion")') - WRITE(UNIT=ILUOUT0,FMT='(" Temp. factor XTEXAUTI=",E13.6)') XTEXAUTI -END IF -! -XAUTO3 = 6.25E18*(ZGAMI(2))**(1./3.)*SQRT(ZGAMI(4)) -XAUTO4 = 0.5E6*(ZGAMI(4))**(1./6.) -XLAUTS = 2.7E-2 -XLAUTS_THRESHOLD = 0.4 -XITAUTS= 0.27 ! (Notice that T2 of BR74 is uncorrect and that 0.27=1./3.7 -XITAUTS_THRESHOLD = 7.5 -! -! -!* 6.4 Constants for snow aggregation -! -XCOLEXIS = 0.05 ! Temperature factor of the I+S collection efficiency -XAGGS_CLARGE1 = XKER_ZRNIC_A2*ZGAMI(2) -XAGGS_CLARGE2 = XKER_ZRNIC_A2*ZGAMS(2) -XAGGS_RLARGE1 = XKER_ZRNIC_A2*ZGAMI(6)*XAI -XAGGS_RLARGE2 = XKER_ZRNIC_A2*ZGAMI(7)*ZGAMS(2)*XAI -! -GFLAG = .TRUE. -IF (GFLAG) THEN - WRITE(UNIT=ILUOUT0,FMT='(" snow aggregation")') - WRITE(UNIT=ILUOUT0,FMT='(" Temp. factor XCOLEXIS=",E13.6)') XCOLEXIS -END IF -! -!------------------------------------------------------------------------------- -! -! -!* 7. CONSTANTS FOR THE FAST COLD PROCESSES FOR THE AGGREGATES -! -------------------------------------------------------- -! -! -!* 7.1 Constants for the riming of the aggregates -! -XDCSLIM = 0.007 ! D_cs^lim = 7 mm as suggested by Farley et al. (1989) -XCOLCS = 1.0 -XEXCRIMSS= XCXS-XDS-2.0 -XCRIMSS = (XPI/4.0)*XCOLCS*XCCS*XCS*(ZRHO00**XCEXVT)*MOMG(XALPHAS,XNUS,XDS+2.0) -XEXCRIMSG= XEXCRIMSS -XCRIMSG = XCRIMSS -XSRIMCG = XCCS*XAS*MOMG(XALPHAS,XNUS,XBS) -XEXSRIMCG= XCXS-XBS -! -GFLAG = .TRUE. -IF (GFLAG) THEN - WRITE(UNIT=ILUOUT0,FMT='(" riming of the aggregates")') - WRITE(UNIT=ILUOUT0,FMT='(" D_cs^lim (Farley et al.) XDCSLIM=",E13.6)') XDCSLIM - WRITE(UNIT=ILUOUT0,FMT='(" Coll. efficiency XCOLCS=",E13.6)') XCOLCS -END IF -! -NGAMINC = 80 -XGAMINC_BOUND_MIN = 1.0E-1 ! Minimal value of (Lbda * D_cs^lim)**alpha -XGAMINC_BOUND_MAX = 1.0E7 ! Maximal value of (Lbda * D_cs^lim)**alpha -ZRATE = EXP(LOG(XGAMINC_BOUND_MAX/XGAMINC_BOUND_MIN)/REAL(NGAMINC-1)) -! -ALLOCATE( XGAMINC_RIM1(NGAMINC) ) -ALLOCATE( XGAMINC_RIM2(NGAMINC) ) -! -DO J1=1,NGAMINC - ZBOUND = XGAMINC_BOUND_MIN*ZRATE**(J1-1) - XGAMINC_RIM1(J1) = GAMMA_INC(XNUS+(2.0+XDS)/XALPHAS,ZBOUND) - XGAMINC_RIM2(J1) = GAMMA_INC(XNUS+XBS/XALPHAS ,ZBOUND) -END DO -! -XRIMINTP1 = XALPHAS / LOG(ZRATE) -XRIMINTP2 = 1.0 + XRIMINTP1*LOG( XDCSLIM/(XGAMINC_BOUND_MIN)**(1.0/XALPHAS) ) -! -!* 7.1.1 Defining the constants for the Hallett-Mossop -! secondary ice nucleation process -! -XHMTMIN = XTT - 8.0 -XHMTMAX = XTT - 3.0 -XHM1 = 9.3E-3 ! Obsolete parameterization -XHM2 = 1.5E-3/LOG(10.0) ! from Ferrier (1995) -XHM_YIELD = 5.E-3 ! A splinter is produced after the riming of 200 droplets -XHM_COLLCS= 1.0 ! Collision efficiency snow/droplet (with Dc>25 microns) -XHM_FACTS = XHM_YIELD*(XHM_COLLCS/XCOLCS) -! -! Notice: One magnitude of lambda discretized over 10 points for the droplets -! -XGAMINC_HMC_BOUND_MIN = 1.0E-3 ! Min value of (Lbda * (12,25) microns)**alpha -XGAMINC_HMC_BOUND_MAX = 1.0E5 ! Max value of (Lbda * (12,25) microns)**alpha -ZRATE = EXP(LOG(XGAMINC_HMC_BOUND_MAX/XGAMINC_HMC_BOUND_MIN)/REAL(NGAMINC-1)) -! -ALLOCATE( XGAMINC_HMC(NGAMINC) ) -! -DO J1=1,NGAMINC - ZBOUND = XGAMINC_HMC_BOUND_MIN*ZRATE**(J1-1) - XGAMINC_HMC(J1) = GAMMA_INC(XNUC,ZBOUND) -END DO -! -XHMSINTP1 = XALPHAC / LOG(ZRATE) -XHMSINTP2 = 1.0 + XHMSINTP1*LOG( 12.E-6/(XGAMINC_HMC_BOUND_MIN)**(1.0/XALPHAC) ) -XHMLINTP1 = XALPHAC / LOG(ZRATE) -XHMLINTP2 = 1.0 + XHMLINTP1*LOG( 25.E-6/(XGAMINC_HMC_BOUND_MIN)**(1.0/XALPHAC) ) -! -! -!* 7.2 Constants for the accretion of raindrops onto aggregates -! -XFRACCSS = ((XPI**2)/24.0)*XCCS*XRHOLW*(ZRHO00**XCEXVT) -! -XLBRACCS1 = MOMG(XALPHAS,XNUS,2.)*MOMG(XALPHAR,XNUR,3.) -XLBRACCS2 = 2.*MOMG(XALPHAS,XNUS,1.)*MOMG(XALPHAR,XNUR,4.) -XLBRACCS3 = MOMG(XALPHAR,XNUR,5.) -! -XFSACCRG = (XPI/4.0)*XAS*XCCS*(ZRHO00**XCEXVT) -! -XLBSACCR1 = MOMG(XALPHAR,XNUR,2.)*MOMG(XALPHAS,XNUS,XBS) -XLBSACCR2 = 2.*MOMG(XALPHAR,XNUR,1.)*MOMG(XALPHAS,XNUS,XBS+1.) -XLBSACCR3 = MOMG(XALPHAS,XNUS,XBS+2.) -! -!* 7.2.1 Defining the ranges for the computation of the kernels -! -! Notice: One magnitude of lambda discretized over 10 points for rain -! Notice: One magnitude of lambda discretized over 10 points for snow -! -NACCLBDAS = 40 -XACCLBDAS_MIN = 5.0E1 ! Minimal value of Lbda_s to tabulate XKER_RACCS -XACCLBDAS_MAX = 5.0E5 ! Maximal value of Lbda_s to tabulate XKER_RACCS -ZRATE = LOG(XACCLBDAS_MAX/XACCLBDAS_MIN)/REAL(NACCLBDAS-1) -XACCINTP1S = 1.0 / ZRATE -XACCINTP2S = 1.0 - LOG( XACCLBDAS_MIN ) / ZRATE -NACCLBDAR = 40 -XACCLBDAR_MIN = 1.0E3 ! Minimal value of Lbda_r to tabulate XKER_RACCS -XACCLBDAR_MAX = 1.0E7 ! Maximal value of Lbda_r to tabulate XKER_RACCS -ZRATE = LOG(XACCLBDAR_MAX/XACCLBDAR_MIN)/REAL(NACCLBDAR-1) -XACCINTP1R = 1.0 / ZRATE -XACCINTP2R = 1.0 - LOG( XACCLBDAR_MIN ) / ZRATE -! -!* 7.2.2 Computations of the tabulated normalized kernels -! -IND = 50 ! Interval number, collection efficiency and infinite diameter -ZESR = 1.0 ! factor used to integrate the dimensional distributions when -ZFDINFTY = 20.0 ! computing the kernels XKER_RACCSS, XKER_RACCS and XKER_SACCRG -! -ALLOCATE( XKER_RACCSS(NACCLBDAS,NACCLBDAR) ) -ALLOCATE( XKER_RACCS (NACCLBDAS,NACCLBDAR) ) -ALLOCATE( XKER_SACCRG(NACCLBDAR,NACCLBDAS) ) -! -CALL LIMA_READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, & - PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,PCR,PDR, & - PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN,& - PFDINFTY ) -IF( (KACCLBDAS/=NACCLBDAS) .OR. (KACCLBDAR/=NACCLBDAR) .OR. (KND/=IND) .OR. & - (PALPHAS/=XALPHAS) .OR. (PNUS/=XNUS) .OR. & - (PALPHAR/=XALPHAR) .OR. (PNUR/=XNUR) .OR. & - (PESR/=ZESR) .OR. (PBS/=XBS) .OR. (PBR/=XBR) .OR. & - (PCS/=XCS) .OR. (PDS/=XDS) .OR. (PCR/=XCR) .OR. (PDR/=XDR) .OR. & - (PACCLBDAS_MAX/=XACCLBDAS_MAX) .OR. (PACCLBDAR_MAX/=XACCLBDAR_MAX) .OR. & - (PACCLBDAS_MIN/=XACCLBDAS_MIN) .OR. (PACCLBDAR_MIN/=XACCLBDAR_MIN) .OR. & - (PFDINFTY/=ZFDINFTY) ) THEN - CALL RRCOLSS ( IND, XALPHAS, XNUS, XALPHAR, XNUR, & - ZESR, XBR, XCS, XDS, XCR, XDR, & - XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, & - ZFDINFTY, XKER_RACCSS, XAG, XBS, XAS ) - CALL RZCOLX ( IND, XALPHAS, XNUS, XALPHAR, XNUR, & - ZESR, XBR, XCS, XDS, XCR, XDR, & - XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, & - ZFDINFTY, XKER_RACCS ) - CALL RSCOLRG ( IND, XALPHAS, XNUS, XALPHAR, XNUR, & - ZESR, XBS, XCS, XDS, XCR, XDR, & - XACCLBDAS_MAX, XACCLBDAR_MAX, XACCLBDAS_MIN, XACCLBDAR_MIN, & - ZFDINFTY, XKER_SACCRG,XAG, XBS, XAS ) - WRITE(UNIT=ILUOUT0,FMT='("*****************************************")') - WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF RACSS KERNELS ****")') - WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF RACS KERNELS ****")') - WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF SACRG KERNELS ****")') - WRITE(UNIT=ILUOUT0,FMT='("*****************************************")') - WRITE(UNIT=ILUOUT0,FMT='("!")') - WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND - WRITE(UNIT=ILUOUT0,FMT='("KACCLBDAS=",I3)') NACCLBDAS - WRITE(UNIT=ILUOUT0,FMT='("KACCLBDAR=",I3)') NACCLBDAR - WRITE(UNIT=ILUOUT0,FMT='("PALPHAS=",E13.6)') XALPHAS - WRITE(UNIT=ILUOUT0,FMT='("PNUS=",E13.6)') XNUS - WRITE(UNIT=ILUOUT0,FMT='("PALPHAR=",E13.6)') XALPHAR - WRITE(UNIT=ILUOUT0,FMT='("PNUR=",E13.6)') XNUR - WRITE(UNIT=ILUOUT0,FMT='("PESR=",E13.6)') ZESR - WRITE(UNIT=ILUOUT0,FMT='("PBS=",E13.6)') XBS - WRITE(UNIT=ILUOUT0,FMT='("PBR=",E13.6)') XBR - WRITE(UNIT=ILUOUT0,FMT='("PCS=",E13.6)') XCS - WRITE(UNIT=ILUOUT0,FMT='("PDS=",E13.6)') XDS - WRITE(UNIT=ILUOUT0,FMT='("PCR=",E13.6)') XCR - WRITE(UNIT=ILUOUT0,FMT='("PDR=",E13.6)') XDR - WRITE(UNIT=ILUOUT0,FMT='("PACCLBDAS_MAX=",E13.6)') & - XACCLBDAS_MAX - WRITE(UNIT=ILUOUT0,FMT='("PACCLBDAR_MAX=",E13.6)') & - XACCLBDAR_MAX - WRITE(UNIT=ILUOUT0,FMT='("PACCLBDAS_MIN=",E13.6)') & - XACCLBDAS_MIN - WRITE(UNIT=ILUOUT0,FMT='("PACCLBDAR_MIN=",E13.6)') & - XACCLBDAR_MIN - WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY - WRITE(UNIT=ILUOUT0,FMT='("!")') - WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_RACCSS) ) THEN")') - DO J1 = 1 , NACCLBDAS - DO J2 = 1 , NACCLBDAR - WRITE(UNIT=ILUOUT0,FMT='(" PKER_RACCSS(",I3,",",I3,") = ",E13.6)') & - J1,J2,XKER_RACCSS(J1,J2) - END DO - END DO - WRITE(UNIT=ILUOUT0,FMT='("END IF")') - WRITE(UNIT=ILUOUT0,FMT='("!")') - WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_RACCS ) ) THEN")') - DO J1 = 1 , NACCLBDAS - DO J2 = 1 , NACCLBDAR - WRITE(UNIT=ILUOUT0,FMT='(" PKER_RACCS (",I3,",",I3,") = ",E13.6)') & - J1,J2,XKER_RACCS (J1,J2) - END DO - END DO - WRITE(UNIT=ILUOUT0,FMT='("END IF")') - WRITE(UNIT=ILUOUT0,FMT='("!")') - WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_SACCRG) ) THEN")') - DO J1 = 1 , NACCLBDAR - DO J2 = 1 , NACCLBDAS - WRITE(UNIT=ILUOUT0,FMT='(" PKER_SACCRG(",I3,",",I3,") = ",E13.6)') & - J1,J2,XKER_SACCRG(J1,J2) - END DO - END DO - WRITE(UNIT=ILUOUT0,FMT='("END IF")') - ELSE - CALL LIMA_READ_XKER_RACCS (KACCLBDAS,KACCLBDAR,KND, & - PALPHAS,PNUS,PALPHAR,PNUR,PESR,PBS,PBR,PCS,PDS,PCR,PDR, & - PACCLBDAS_MAX,PACCLBDAR_MAX,PACCLBDAS_MIN,PACCLBDAR_MIN,& - PFDINFTY,XKER_RACCSS,XKER_RACCS,XKER_SACCRG ) - WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_RACCSS")') - WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_RACCS ")') - WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_SACCRG")') -END IF -! -! -!* 7.3 Constant for the conversion-melting rate -! -XFSCVMG = 2.0 -! -GFLAG = .TRUE. -IF (GFLAG) THEN - WRITE(UNIT=ILUOUT0,FMT='(" conversion-melting of the aggregates")') - WRITE(UNIT=ILUOUT0,FMT='(" Conv. factor XFSCVMG=",E13.6)') XFSCVMG -END IF -! -! -!* 7.4 Constants for Ice-Ice collision process (CIBU) -! -XDCSLIM_CIBU_MIN = 2.0E-4 ! D_cs lim min -XDCSLIM_CIBU_MAX = 1.0E-3 ! D_cs lim max -XDCGLIM_CIBU_MIN = 2.0E-3 ! D_cg lim min -! -GFLAG = .TRUE. -IF (GFLAG) THEN - WRITE(UNIT=ILUOUT0,FMT='(" Ice-ice collision process")') - WRITE(UNIT=ILUOUT0,FMT='(" D_cs^lim min-max =",E13.6)') XDCSLIM_CIBU_MIN,XDCSLIM_CIBU_MAX - WRITE(UNIT=ILUOUT0,FMT='(" D_cg^lim min =",E13.6)') XDCGLIM_CIBU_MIN -END IF -! -NGAMINC = 80 -! -!Note : Boundaries are rounded at 5.0 or 1.0 (down for Bound_min and up for Bound_max) -XGAMINC_BOUND_CIBU_SMIN = 1.0E-5 ! Minimal value of (Lbda_s * D_cs^lim)**alpha) 0.2 mm -XGAMINC_BOUND_CIBU_SMAX = 5.0E-3 ! Maximal value of (Lbda_s * D_cs^lim)**alpha) 1 mm -XGAMINC_BOUND_CIBU_SMIN = 1.0E-5 ! Minimal value of (Lbda_s * D_cs^lim)**alpha) 0.2 mm -XGAMINC_BOUND_CIBU_SMAX = 5.0E+2 ! Maximal value of (Lbda_s * D_cs^lim)**alpha) 1 mm -ZRATE_S = EXP(LOG(XGAMINC_BOUND_CIBU_SMAX/XGAMINC_BOUND_CIBU_SMIN)/FLOAT(NGAMINC-1)) -! -XGAMINC_BOUND_CIBU_GMIN = 1.0E-1 ! Minimal value of (Lbda_g * D_cg^lim)**alpha) 2 mm -XGAMINC_BOUND_CIBU_GMAX = 1.0E0 ! Maximal value of (Lbda_g * D_cg^lim)**alpha) 2 mm -XGAMINC_BOUND_CIBU_GMIN = 1.0E-1 ! Minimal value of (Lbda_g * D_cg^lim)**alpha) 2 mm -XGAMINC_BOUND_CIBU_GMAX = 5.0E+1 ! Maximal value of (Lbda_g * D_cg^lim)**alpha) 2 mm -ZRATE_G = EXP(LOG(XGAMINC_BOUND_CIBU_GMAX/XGAMINC_BOUND_CIBU_GMIN)/FLOAT(NGAMINC-1)) -! -ALLOCATE( XGAMINC_CIBU_S(4,NGAMINC) ) -ALLOCATE( XGAMINC_CIBU_G(2,NGAMINC) ) -! -DO J1 = 1, NGAMINC - ZBOUND_CIBU_SMIN = XGAMINC_BOUND_CIBU_SMIN * ZRATE_S**(J1-1) - ZBOUND_CIBU_GMIN = XGAMINC_BOUND_CIBU_GMIN * ZRATE_G**(J1-1) -! -! For ZNI_CIBU - XGAMINC_CIBU_S(1,J1) = GAMMA_INC(XNUS,ZBOUND_CIBU_SMIN) - XGAMINC_CIBU_S(2,J1) = GAMMA_INC(XNUS+(XDS/XALPHAS),ZBOUND_CIBU_SMIN) -! - XGAMINC_CIBU_G(1,J1) = GAMMA_INC(XNUG+((2.0+XDG)/XALPHAG),ZBOUND_CIBU_GMIN) - XGAMINC_CIBU_G(2,J1) = GAMMA_INC(XNUG+(2.0/XALPHAG),ZBOUND_CIBU_GMIN) -! -! For ZRI_CIBU - XGAMINC_CIBU_S(3,J1) = GAMMA_INC(XNUS+(XBS/XALPHAS),ZBOUND_CIBU_SMIN) - XGAMINC_CIBU_S(4,J1) = GAMMA_INC(XNUS+((XBS+XDS)/XALPHAS),ZBOUND_CIBU_SMIN) -END DO -! -XCIBUINTP_S = XALPHAS / LOG(ZRATE_S) -XCIBUINTP1_S = 1.0 + XCIBUINTP_S * LOG(XDCSLIM_CIBU_MIN/(XGAMINC_BOUND_CIBU_SMIN)**(1.0/XALPHAS)) -XCIBUINTP2_S = 1.0 + XCIBUINTP_S * LOG(XDCSLIM_CIBU_MAX/(XGAMINC_BOUND_CIBU_SMIN)**(1.0/XALPHAS)) -! -XCIBUINTP_G = XALPHAG / LOG(ZRATE_G) -XCIBUINTP1_G = 1.0 + XCIBUINTP_G * LOG(XDCGLIM_CIBU_MIN/(XGAMINC_BOUND_CIBU_GMIN)**(1.0/XALPHAG)) -! -! For ZNI_CIBU -XFACTOR_CIBU_NI = (XPI / 4.0) * XCCG * XCCS * (ZRHO00**XCEXVT) -XMOMGG_CIBU_1 = MOMG(XALPHAG,XNUG,2.0+XDG) -XMOMGG_CIBU_2 = MOMG(XALPHAG,XNUG,2.0) -XMOMGS_CIBU_1 = MOMG(XALPHAS,XNUS,XDS) -! -! For ZRI_CIBU -XFACTOR_CIBU_RI = XAS * (XPI / 4.0) * XCCG * XCCS * (ZRHO00**XCEXVT) -XMOMGS_CIBU_2 = MOMG(XALPHAS,XNUS,XBS) -XMOMGS_CIBU_3 = MOMG(XALPHAS,XNUS,XBS+XDS) -! -! -!* 7.5 Constants for raindrop shattering by freezing process (RDSF) -! -XDCRLIM_RDSF_MIN = 0.1E-3 ! D_cr lim min -! -GFLAG = .TRUE. -IF (GFLAG) THEN - WRITE(UNIT=ILUOUT0,FMT='(" Ice-rain collision process")') - WRITE(UNIT=ILUOUT0,FMT='(" D_cr^lim min =",E13.6)') XDCRLIM_RDSF_MIN -END IF -! -NGAMINC = 80 -! -XGAMINC_BOUND_RDSF_RMIN = 1.0E-5 ! Minimal value of (Lbda_r * D_cr^lim)**alpha) 0.1 mm -XGAMINC_BOUND_RDSF_RMAX = 5.0E-3 ! Maximal value of (Lbda_r * D_cr^lim)**alpha) 1 mm -ZRATE_R = EXP(LOG(XGAMINC_BOUND_RDSF_RMAX/XGAMINC_BOUND_RDSF_RMIN)/FLOAT(NGAMINC-1)) -! -ALLOCATE( XGAMINC_RDSF_R(NGAMINC) ) -! -DO J1 = 1, NGAMINC - ZBOUND_RDSF_RMIN = XGAMINC_BOUND_RDSF_RMIN * ZRATE_R**(J1-1) -! -! For ZNI_RDSF - XGAMINC_RDSF_R(J1) = GAMMA_INC(XNUR+((6.0+XDR)/XALPHAR),ZBOUND_RDSF_RMIN) -END DO -! -XRDSFINTP_R = XALPHAR / LOG(ZRATE_R) -XRDSFINTP1_R = 1.0 + XRDSFINTP_R * LOG( XDCRLIM_RDSF_MIN/(XGAMINC_BOUND_RDSF_RMIN)**(1.0/XALPHAR) ) -! -! For ZNI_RDSF -ZKHI_LWM = 2.5E13 ! Coeff. in Lawson-Woods-Morrison for the number of splinters - ! N_DF = XKHI_LWM * D_R**4 -XFACTOR_RDSF_NI = ZKHI_LWM * (XPI / 4.0) * XCR * (ZRHO00**XCEXVT) -XMOMGR_RDSF = MOMG(XALPHAR,XNUR,6.0+XDR) -! -!------------------------------------------------------------------------------- -! -! -!* 8. CONSTANTS FOR THE FAST COLD PROCESSES FOR THE GRAUPELN -! -------------------------------------------------------- -! -! -!* 8.1 Constants for the rain contact freezing -! -XCOLIR = 1.0 -! -! values of these coeficients differ from the single-momemt rain_ice case -! -XEXRCFRI = -XDR-5.0 -XRCFRI = ((XPI**2)/24.0)*XRHOLW*XCOLIR*XCR*(ZRHO00**XCEXVT) & - *MOMG(XALPHAR,XNUR,XDR+5.0) -XEXICFRR = -XDR-2.0 -XICFRR = (XPI/4.0)*XCOLIR*XCR*(ZRHO00**XCEXVT) & - *MOMG(XALPHAR,XNUR,XDR+2.0) -! -GFLAG = .TRUE. -IF (GFLAG) THEN - WRITE(UNIT=ILUOUT0,FMT='(" rain contact freezing")') - WRITE(UNIT=ILUOUT0,FMT='(" Coll. efficiency XCOLIR=",E13.6)') XCOLIR -END IF -! -! -!* 8.2 Constants for the dry growth of the graupeln -! -!* 8.2.1 Constants for the cloud droplet collection by the graupeln -! and for the Hallett-Mossop process -! -XCOLCG = 0.6 ! Estimated from Cober and List (1993) -XFCDRYG = (XPI/4.0)*XCOLCG*XCCG*XCG*(ZRHO00**XCEXVT)*MOMG(XALPHAG,XNUG,XDG+2.0) -! -XHM_COLLCG= 0.9 ! Collision efficiency graupel/droplet (with Dc>25 microns) -XHM_FACTG = XHM_YIELD*(XHM_COLLCG/XCOLCG) -! -!* 8.2.2 Constants for the cloud ice collection by the graupeln -! -XCOLIG = 0.25 ! Collection efficiency of I+G -XCOLEXIG = 0.05 ! Temperature factor of the I+G collection efficiency -XCOLIG = 0.01 ! Collection efficiency of I+G -XCOLEXIG = 0.1 ! Temperature factor of the I+G collection efficiency -WRITE (ILUOUT0, FMT=*) ' NEW Constants for the cloud ice collection by the graupeln' -WRITE (ILUOUT0, FMT=*) ' XCOLIG, XCOLEXIG = ',XCOLIG,XCOLEXIG -XFIDRYG = (XPI/4.0)*XCOLIG*XCCG*XCG*(ZRHO00**XCEXVT)*MOMG(XALPHAG,XNUG,XDG+2.0) -! -GFLAG = .TRUE. -IF (GFLAG) THEN - WRITE(UNIT=ILUOUT0,FMT='(" cloud ice collection by the graupeln")') - WRITE(UNIT=ILUOUT0,FMT='(" Coll. efficiency XCOLIG=",E13.6)') XCOLIG - WRITE(UNIT=ILUOUT0,FMT='(" Temp. factor XCOLEXIG=",E13.6)') XCOLEXIG -END IF -! -!* 8.2.3 Constants for the aggregate collection by the graupeln -! -XCOLSG = 0.25 ! Collection efficiency of S+G -XCOLEXSG = 0.05 ! Temperature factor of the S+G collection efficiency -XCOLSG = 0.01 ! Collection efficiency of S+G -XCOLEXSG = 0.1 ! Temperature factor of the S+G collection efficiency -WRITE (ILUOUT0, FMT=*) ' NEW Constants for the aggregate collection by the graupeln' -WRITE (ILUOUT0, FMT=*) ' XCOLSG, XCOLEXSG = ',XCOLSG,XCOLEXSG -XFSDRYG = (XPI/4.0)*XCOLSG*XCCG*XCCS*XAS*(ZRHO00**XCEXVT) -! -XLBSDRYG1 = MOMG(XALPHAG,XNUG,2.)*MOMG(XALPHAS,XNUS,XBS) -XLBSDRYG2 = 2.*MOMG(XALPHAG,XNUG,1.)*MOMG(XALPHAS,XNUS,XBS+1.) -XLBSDRYG3 = MOMG(XALPHAS,XNUS,XBS+2.) -! -GFLAG = .TRUE. -IF (GFLAG) THEN - WRITE(UNIT=ILUOUT0,FMT='(" aggregate collection by the graupeln")') - WRITE(UNIT=ILUOUT0,FMT='(" Coll. efficiency XCOLSG=",E13.6)') XCOLSG - WRITE(UNIT=ILUOUT0,FMT='(" Temp. factor XCOLEXSG=",E13.6)') XCOLEXSG -END IF -! -!* 8.2.4 Constants for the raindrop collection by the graupeln -! -XFRDRYG = ((XPI**2)/24.0)*XCCG*XRHOLW*(ZRHO00**XCEXVT) -! -XLBRDRYG1 = MOMG(XALPHAG,XNUG,2.)*MOMG(XALPHAR,XNUR,3.) -XLBRDRYG2 = 2.*MOMG(XALPHAG,XNUG,1.)*MOMG(XALPHAR,XNUR,4.) -XLBRDRYG3 = MOMG(XALPHAR,XNUR,5.) -! -! Notice: One magnitude of lambda discretized over 10 points -! -NDRYLBDAR = 40 -XDRYLBDAR_MIN = 1.0E3 ! Minimal value of Lbda_r to tabulate XKER_RDRYG -XDRYLBDAR_MAX = 1.0E7 ! Maximal value of Lbda_r to tabulate XKER_RDRYG -ZRATE = LOG(XDRYLBDAR_MAX/XDRYLBDAR_MIN)/REAL(NDRYLBDAR-1) -XDRYINTP1R = 1.0 / ZRATE -XDRYINTP2R = 1.0 - LOG( XDRYLBDAR_MIN ) / ZRATE -NDRYLBDAS = 80 -XDRYLBDAS_MIN = 2.5E1 ! Minimal value of Lbda_s to tabulate XKER_SDRYG -XDRYLBDAS_MAX = 2.5E9 ! Maximal value of Lbda_s to tabulate XKER_SDRYG -ZRATE = LOG(XDRYLBDAS_MAX/XDRYLBDAS_MIN)/REAL(NDRYLBDAS-1) -XDRYINTP1S = 1.0 / ZRATE -XDRYINTP2S = 1.0 - LOG( XDRYLBDAS_MIN ) / ZRATE -NDRYLBDAG = 40 -XDRYLBDAG_MIN = 1.0E3 ! Min value of Lbda_g to tabulate XKER_SDRYG,XKER_RDRYG -XDRYLBDAG_MAX = 1.0E7 ! Max value of Lbda_g to tabulate XKER_SDRYG,XKER_RDRYG -ZRATE = LOG(XDRYLBDAG_MAX/XDRYLBDAG_MIN)/REAL(NDRYLBDAG-1) -XDRYINTP1G = 1.0 / ZRATE -XDRYINTP2G = 1.0 - LOG( XDRYLBDAG_MIN ) / ZRATE -! -!* 8.2.5 Computations of the tabulated normalized kernels -! -IND = 50 ! Interval number, collection efficiency and infinite diameter -ZEGS = 1.0 ! factor used to integrate the dimensional distributions when -ZFDINFTY = 20.0 ! computing the kernels XKER_SDRYG -! -ALLOCATE( XKER_SDRYG(NDRYLBDAG,NDRYLBDAS) ) -! -CALL LIMA_READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, & - PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS, & - PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN, & - PFDINFTY ) -IF( (KDRYLBDAG/=NDRYLBDAG) .OR. (KDRYLBDAS/=NDRYLBDAS) .OR. (KND/=IND) .OR. & - (PALPHAG/=XALPHAG) .OR. (PNUG/=XNUG) .OR. & - (PALPHAS/=XALPHAS) .OR. (PNUS/=XNUS) .OR. & - (PEGS/=ZEGS) .OR. (PBS/=XBS) .OR. & - (PCG/=XCG) .OR. (PDG/=XDG) .OR. (PCS/=XCS) .OR. (PDS/=XDS) .OR. & - (PDRYLBDAG_MAX/=XDRYLBDAG_MAX) .OR. (PDRYLBDAS_MAX/=XDRYLBDAS_MAX) .OR. & - (PDRYLBDAG_MIN/=XDRYLBDAG_MIN) .OR. (PDRYLBDAS_MIN/=XDRYLBDAS_MIN) .OR. & - (PFDINFTY/=ZFDINFTY) ) THEN - CALL RZCOLX ( IND, XALPHAG, XNUG, XALPHAS, XNUS, & - ZEGS, XBS, XCG, XDG, XCS, XDS, & - XDRYLBDAG_MAX, XDRYLBDAS_MAX, XDRYLBDAG_MIN, XDRYLBDAS_MIN, & - ZFDINFTY, XKER_SDRYG ) - WRITE(UNIT=ILUOUT0,FMT='("*****************************************")') - WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF SDRYG KERNELS ****")') - WRITE(UNIT=ILUOUT0,FMT='("*****************************************")') - WRITE(UNIT=ILUOUT0,FMT='("!")') - WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND - WRITE(UNIT=ILUOUT0,FMT='("KDRYLBDAG=",I3)') NDRYLBDAG - WRITE(UNIT=ILUOUT0,FMT='("KDRYLBDAS=",I3)') NDRYLBDAS - WRITE(UNIT=ILUOUT0,FMT='("PALPHAG=",E13.6)') XALPHAG - WRITE(UNIT=ILUOUT0,FMT='("PNUG=",E13.6)') XNUG - WRITE(UNIT=ILUOUT0,FMT='("PALPHAS=",E13.6)') XALPHAS - WRITE(UNIT=ILUOUT0,FMT='("PNUS=",E13.6)') XNUS - WRITE(UNIT=ILUOUT0,FMT='("PEGS=",E13.6)') ZEGS - WRITE(UNIT=ILUOUT0,FMT='("PBS=",E13.6)') XBS - WRITE(UNIT=ILUOUT0,FMT='("PCG=",E13.6)') XCG - WRITE(UNIT=ILUOUT0,FMT='("PDG=",E13.6)') XDG - WRITE(UNIT=ILUOUT0,FMT='("PCS=",E13.6)') XCS - WRITE(UNIT=ILUOUT0,FMT='("PDS=",E13.6)') XDS - WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAG_MAX=",E13.6)') & - XDRYLBDAG_MAX - WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAS_MAX=",E13.6)') & - XDRYLBDAS_MAX - WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAG_MIN=",E13.6)') & - XDRYLBDAG_MIN - WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAS_MIN=",E13.6)') & - XDRYLBDAS_MIN - WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY - WRITE(UNIT=ILUOUT0,FMT='("!")') - WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_SDRYG) ) THEN")') - DO J1 = 1 , NDRYLBDAG - DO J2 = 1 , NDRYLBDAS - WRITE(UNIT=ILUOUT0,FMT='("PKER_SDRYG(",I3,",",I3,") = ",E13.6)') & - J1,J2,XKER_SDRYG(J1,J2) - END DO - END DO - WRITE(UNIT=ILUOUT0,FMT='("END IF")') - ELSE - CALL LIMA_READ_XKER_SDRYG (KDRYLBDAG,KDRYLBDAS,KND, & - PALPHAG,PNUG,PALPHAS,PNUS,PEGS,PBS,PCG,PDG,PCS,PDS, & - PDRYLBDAG_MAX,PDRYLBDAS_MAX,PDRYLBDAG_MIN,PDRYLBDAS_MIN, & - PFDINFTY,XKER_SDRYG ) - WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_SDRYG")') -END IF -! -! -IND = 50 ! Number of interval used to integrate the dimensional -ZEGR = 1.0 ! distributions when computing the kernel XKER_RDRYG -ZFDINFTY = 20.0 -! -ALLOCATE( XKER_RDRYG(NDRYLBDAG,NDRYLBDAR) ) -! -CALL LIMA_READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, & - PALPHAG,PNUG,PALPHAR,PNUR,PEGR,PBR,PCG,PDG,PCR,PDR, & - PDRYLBDAG_MAX,PDRYLBDAR_MAX,PDRYLBDAG_MIN,PDRYLBDAR_MIN, & - PFDINFTY ) -IF( (KDRYLBDAG/=NDRYLBDAG) .OR. (KDRYLBDAR/=NDRYLBDAR) .OR. (KND/=IND) .OR. & - (PALPHAG/=XALPHAG) .OR. (PNUG/=XNUG) .OR. & - (PALPHAR/=XALPHAR) .OR. (PNUR/=XNUR) .OR. & - (PEGR/=ZEGR) .OR. (PBR/=XBR) .OR. & - (PCG/=XCG) .OR. (PDG/=XDG) .OR. (PCR/=XCR) .OR. (PDR/=XDR) .OR. & - (PDRYLBDAG_MAX/=XDRYLBDAG_MAX) .OR. (PDRYLBDAR_MAX/=XDRYLBDAR_MAX) .OR. & - (PDRYLBDAG_MIN/=XDRYLBDAG_MIN) .OR. (PDRYLBDAR_MIN/=XDRYLBDAR_MIN) .OR. & - (PFDINFTY/=ZFDINFTY) ) THEN - CALL RZCOLX ( IND, XALPHAG, XNUG, XALPHAR, XNUR, & - ZEGR, XBR, XCG, XDG, XCR, XDR, & - XDRYLBDAG_MAX, XDRYLBDAR_MAX, XDRYLBDAG_MIN, XDRYLBDAR_MIN, & - ZFDINFTY, XKER_RDRYG ) - WRITE(UNIT=ILUOUT0,FMT='("*****************************************")') - WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF RDRYG KERNELS ****")') - WRITE(UNIT=ILUOUT0,FMT='("*****************************************")') - WRITE(UNIT=ILUOUT0,FMT='("!")') - WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND - WRITE(UNIT=ILUOUT0,FMT='("KDRYLBDAG=",I3)') NDRYLBDAG - WRITE(UNIT=ILUOUT0,FMT='("KDRYLBDAR=",I3)') NDRYLBDAR - WRITE(UNIT=ILUOUT0,FMT='("PALPHAG=",E13.6)') XALPHAG - WRITE(UNIT=ILUOUT0,FMT='("PNUG=",E13.6)') XNUG - WRITE(UNIT=ILUOUT0,FMT='("PALPHAR=",E13.6)') XALPHAR - WRITE(UNIT=ILUOUT0,FMT='("PNUR=",E13.6)') XNUR - WRITE(UNIT=ILUOUT0,FMT='("PEGR=",E13.6)') ZEGR - WRITE(UNIT=ILUOUT0,FMT='("PBR=",E13.6)') XBR - WRITE(UNIT=ILUOUT0,FMT='("PCG=",E13.6)') XCG - WRITE(UNIT=ILUOUT0,FMT='("PDG=",E13.6)') XDG - WRITE(UNIT=ILUOUT0,FMT='("PCR=",E13.6)') XCR - WRITE(UNIT=ILUOUT0,FMT='("PDR=",E13.6)') XDR - WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAG_MAX=",E13.6)') & - XDRYLBDAG_MAX - WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAR_MAX=",E13.6)') & - XDRYLBDAR_MAX - WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAG_MIN=",E13.6)') & - XDRYLBDAG_MIN - WRITE(UNIT=ILUOUT0,FMT='("PDRYLBDAR_MIN=",E13.6)') & - XDRYLBDAR_MIN - WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY - WRITE(UNIT=ILUOUT0,FMT='("!")') - WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_RDRYG) ) THEN")') - DO J1 = 1 , NDRYLBDAG - DO J2 = 1 , NDRYLBDAR - WRITE(UNIT=ILUOUT0,FMT='("PKER_RDRYG(",I3,",",I3,") = ",E13.6)') & - J1,J2,XKER_RDRYG(J1,J2) - END DO - END DO - WRITE(UNIT=ILUOUT0,FMT='("END IF")') - ELSE - CALL LIMA_READ_XKER_RDRYG (KDRYLBDAG,KDRYLBDAR,KND, & - PALPHAG,PNUG,PALPHAR,PNUR,PEGR,PBR,PCG,PDG,PCR,PDR, & - PDRYLBDAG_MAX,PDRYLBDAR_MAX,PDRYLBDAG_MIN,PDRYLBDAR_MIN, & - PFDINFTY,XKER_RDRYG ) - WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_RDRYG")') -END IF -! -!------------------------------------------------------------------------------- -! -!* 9. CONSTANTS FOR THE FAST COLD PROCESSES FOR THE HAILSTONES -! -------------------------------------------------------- -! -!* 9.2 Constants for the wet growth of the hailstones -! -! -!* 9.2.1 Constant for the cloud droplet and cloud ice collection -! by the hailstones -! -XFWETH = (XPI/4.0)*XCCH*XCH*(ZRHO00**XCEXVT)*MOMG(XALPHAH,XNUH,XDH+2.0) -! -!* 9.2.2 Constants for the aggregate collection by the hailstones -! -XFSWETH = (XPI/4.0)*XCCH*XCCS*XAS*(ZRHO00**XCEXVT) -! -XLBSWETH1 = MOMG(XALPHAH,XNUH,2.)*MOMG(XALPHAS,XNUS,XBS) -XLBSWETH2 = 2.*MOMG(XALPHAH,XNUH,1.)*MOMG(XALPHAS,XNUS,XBS+1.) -XLBSWETH3 = MOMG(XALPHAS,XNUS,XBS+2.) -! -!* 9.2.3 Constants for the graupel collection by the hailstones -! -XFGWETH = (XPI/4.0)*XCCH*XCCG*XAG*(ZRHO00**XCEXVT) -! -XLBGWETH1 = MOMG(XALPHAH,XNUH,2.)*MOMG(XALPHAG,XNUG,XBG) -XLBGWETH2 = 2.*MOMG(XALPHAH,XNUH,1.)*MOMG(XALPHAG,XNUG,XBG+1.) -XLBGWETH3 = MOMG(XALPHAG,XNUG,XBG+2.) -! -! Notice: One magnitude of lambda discretized over 10 points -! -NWETLBDAS = 80 -XWETLBDAS_MIN = 2.5E1 ! Minimal value of Lbda_s to tabulate XKER_SWETH -XWETLBDAS_MAX = 2.5E9 ! Maximal value of Lbda_s to tabulate XKER_SWETH -ZRATE = LOG(XWETLBDAS_MAX/XWETLBDAS_MIN)/REAL(NWETLBDAS-1) -XWETINTP1S = 1.0 / ZRATE -XWETINTP2S = 1.0 - LOG( XWETLBDAS_MIN ) / ZRATE -NWETLBDAG = 40 -XWETLBDAG_MIN = 1.0E3 ! Min value of Lbda_g to tabulate XKER_GWETH -XWETLBDAG_MAX = 1.0E7 ! Max value of Lbda_g to tabulate XKER_GWETH -ZRATE = LOG(XWETLBDAG_MAX/XWETLBDAG_MIN)/REAL(NWETLBDAG-1) -XWETINTP1G = 1.0 / ZRATE -XWETINTP2G = 1.0 - LOG( XWETLBDAG_MIN ) / ZRATE -NWETLBDAH = 40 -XWETLBDAH_MIN = 1.0E3 ! Min value of Lbda_h to tabulate XKER_SWETH,XKER_GWETH -XWETLBDAH_MAX = 1.0E7 ! Max value of Lbda_h to tabulate XKER_SWETH,XKER_GWETH -ZRATE = LOG(XWETLBDAH_MAX/XWETLBDAH_MIN)/REAL(NWETLBDAH-1) -XWETINTP1H = 1.0 / ZRATE -XWETINTP2H = 1.0 - LOG( XWETLBDAH_MIN ) / ZRATE -! -!* 9.2.4 Computations of the tabulated normalized kernels -! -IND = 50 ! Interval number, collection efficiency and infinite diameter -ZEHS = 1.0 ! factor used to integrate the dimensional distributions when -ZFDINFTY = 20.0 ! computing the kernels XKER_SWETH -! -IF( .NOT.ALLOCATED(XKER_SWETH) ) ALLOCATE( XKER_SWETH(NWETLBDAH,NWETLBDAS) ) -! -CALL LIMA_READ_XKER_SWETH (KWETLBDAH,KWETLBDAS,KND, & - PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS, & - PWETLBDAH_MAX,PWETLBDAS_MAX,PWETLBDAH_MIN,PWETLBDAS_MIN, & - PFDINFTY ) -IF( (KWETLBDAH/=NWETLBDAH) .OR. (KWETLBDAS/=NWETLBDAS) .OR. (KND/=IND) .OR. & - (PALPHAH/=XALPHAH) .OR. (PNUH/=XNUH) .OR. & - (PALPHAS/=XALPHAS) .OR. (PNUS/=XNUS) .OR. & - (PEHS/=ZEHS) .OR. (PBS/=XBS) .OR. & - (PCH/=XCH) .OR. (PDH/=XDH) .OR. (PCS/=XCS) .OR. (PDS/=XDS) .OR. & - (PWETLBDAH_MAX/=XWETLBDAH_MAX) .OR. (PWETLBDAS_MAX/=XWETLBDAS_MAX) .OR. & - (PWETLBDAH_MIN/=XWETLBDAH_MIN) .OR. (PWETLBDAS_MIN/=XWETLBDAS_MIN) .OR. & - (PFDINFTY/=ZFDINFTY) ) THEN - CALL RZCOLX ( IND, XALPHAH, XNUH, XALPHAS, XNUS, & - ZEHS, XBS, XCH, XDH, XCS, XDS, & - XWETLBDAH_MAX, XWETLBDAS_MAX, XWETLBDAH_MIN, XWETLBDAS_MIN, & - ZFDINFTY, XKER_SWETH ) - WRITE(UNIT=ILUOUT0,FMT='("*****************************************")') - WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF SWETH KERNELS ****")') - WRITE(UNIT=ILUOUT0,FMT='("*****************************************")') - WRITE(UNIT=ILUOUT0,FMT='("!")') - WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND - WRITE(UNIT=ILUOUT0,FMT='("KWETLBDAH=",I3)') NWETLBDAH - WRITE(UNIT=ILUOUT0,FMT='("KWETLBDAS=",I3)') NWETLBDAS - WRITE(UNIT=ILUOUT0,FMT='("PALPHAH=",E13.6)') XALPHAH - WRITE(UNIT=ILUOUT0,FMT='("PNUH=",E13.6)') XNUH - WRITE(UNIT=ILUOUT0,FMT='("PALPHAS=",E13.6)') XALPHAS - WRITE(UNIT=ILUOUT0,FMT='("PNUS=",E13.6)') XNUS - WRITE(UNIT=ILUOUT0,FMT='("PEHS=",E13.6)') ZEHS - WRITE(UNIT=ILUOUT0,FMT='("PBS=",E13.6)') XBS - WRITE(UNIT=ILUOUT0,FMT='("PCH=",E13.6)') XCH - WRITE(UNIT=ILUOUT0,FMT='("PDH=",E13.6)') XDH - WRITE(UNIT=ILUOUT0,FMT='("PCS=",E13.6)') XCS - WRITE(UNIT=ILUOUT0,FMT='("PDS=",E13.6)') XDS - WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAH_MAX=",E13.6)') & - XWETLBDAH_MAX - WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAS_MAX=",E13.6)') & - XWETLBDAS_MAX - WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAH_MIN=",E13.6)') & - XWETLBDAH_MIN - WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAS_MIN=",E13.6)') & - XWETLBDAS_MIN - WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY - WRITE(UNIT=ILUOUT0,FMT='("!")') - WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_SWETH) ) THEN")') - DO J1 = 1 , NWETLBDAH - DO J2 = 1 , NWETLBDAS - WRITE(UNIT=ILUOUT0,FMT='("PKER_SWETH(",I3,",",I3,") = ",E13.6)') & - J1,J2,XKER_SWETH(J1,J2) - END DO - END DO - WRITE(UNIT=ILUOUT0,FMT='("END IF")') - ELSE - CALL LIMA_READ_XKER_SWETH (KWETLBDAH,KWETLBDAS,KND, & - PALPHAH,PNUH,PALPHAS,PNUS,PEHS,PBS,PCH,PDH,PCS,PDS, & - PWETLBDAH_MAX,PWETLBDAS_MAX,PWETLBDAH_MIN,PWETLBDAS_MIN, & - PFDINFTY,XKER_SWETH ) - WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_SWETH")') -END IF -! -! -IND = 50 ! Number of interval used to integrate the dimensional -ZEHG = 1.0 ! distributions when computing the kernel XKER_GWETH -ZFDINFTY = 20.0 -! -IF( .NOT.ALLOCATED(XKER_GWETH) ) ALLOCATE( XKER_GWETH(NWETLBDAH,NWETLBDAG) ) -! -CALL LIMA_READ_XKER_GWETH (KWETLBDAH,KWETLBDAG,KND, & - PALPHAH,PNUH,PALPHAG,PNUG,PEHG,PBG,PCH,PDH,PCG,PDG, & - PWETLBDAH_MAX,PWETLBDAG_MAX,PWETLBDAH_MIN,PWETLBDAG_MIN, & - PFDINFTY ) -IF( (KWETLBDAH/=NWETLBDAH) .OR. (KWETLBDAG/=NWETLBDAG) .OR. (KND/=IND) .OR. & - (PALPHAH/=XALPHAH) .OR. (PNUH/=XNUH) .OR. & - (PALPHAG/=XALPHAG) .OR. (PNUG/=XNUG) .OR. & - (PEHG/=ZEHG) .OR. (PBG/=XBG) .OR. & - (PCH/=XCH) .OR. (PDH/=XDH) .OR. (PCG/=XCG) .OR. (PDG/=XDG) .OR. & - (PWETLBDAH_MAX/=XWETLBDAH_MAX) .OR. (PWETLBDAG_MAX/=XWETLBDAG_MAX) .OR. & - (PWETLBDAH_MIN/=XWETLBDAH_MIN) .OR. (PWETLBDAG_MIN/=XWETLBDAG_MIN) .OR. & - (PFDINFTY/=ZFDINFTY) ) THEN - CALL RZCOLX ( IND, XALPHAH, XNUH, XALPHAG, XNUG, & - ZEHG, XBG, XCH, XDH, XCG, XDG, & - XWETLBDAH_MAX, XWETLBDAG_MAX, XWETLBDAH_MIN, XWETLBDAG_MIN, & - ZFDINFTY, XKER_GWETH ) - WRITE(UNIT=ILUOUT0,FMT='("*****************************************")') - WRITE(UNIT=ILUOUT0,FMT='("**** UPDATE NEW SET OF GWETH KERNELS ****")') - WRITE(UNIT=ILUOUT0,FMT='("*****************************************")') - WRITE(UNIT=ILUOUT0,FMT='("!")') - WRITE(UNIT=ILUOUT0,FMT='("KND=",I3)') IND - WRITE(UNIT=ILUOUT0,FMT='("KWETLBDAH=",I3)') NWETLBDAH - WRITE(UNIT=ILUOUT0,FMT='("KWETLBDAG=",I3)') NWETLBDAG - WRITE(UNIT=ILUOUT0,FMT='("PALPHAH=",E13.6)') XALPHAH - WRITE(UNIT=ILUOUT0,FMT='("PNUH=",E13.6)') XNUH - WRITE(UNIT=ILUOUT0,FMT='("PALPHAG=",E13.6)') XALPHAG - WRITE(UNIT=ILUOUT0,FMT='("PNUG=",E13.6)') XNUG - WRITE(UNIT=ILUOUT0,FMT='("PEHG=",E13.6)') ZEHG - WRITE(UNIT=ILUOUT0,FMT='("PBG=",E13.6)') XBG - WRITE(UNIT=ILUOUT0,FMT='("PCH=",E13.6)') XCH - WRITE(UNIT=ILUOUT0,FMT='("PDH=",E13.6)') XDH - WRITE(UNIT=ILUOUT0,FMT='("PCG=",E13.6)') XCG - WRITE(UNIT=ILUOUT0,FMT='("PDG=",E13.6)') XDG - WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAH_MAX=",E13.6)') & - XWETLBDAH_MAX - WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAG_MAX=",E13.6)') & - XWETLBDAG_MAX - WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAH_MIN=",E13.6)') & - XWETLBDAH_MIN - WRITE(UNIT=ILUOUT0,FMT='("PWETLBDAG_MIN=",E13.6)') & - XWETLBDAG_MIN - WRITE(UNIT=ILUOUT0,FMT='("PFDINFTY=",E13.6)') ZFDINFTY - WRITE(UNIT=ILUOUT0,FMT='("!")') - WRITE(UNIT=ILUOUT0,FMT='("IF( PRESENT(PKER_GWETH) ) THEN")') - DO J1 = 1 , NWETLBDAH - DO J2 = 1 , NWETLBDAG - WRITE(UNIT=ILUOUT0,FMT='("PKER_GWETH(",I3,",",I3,") = ",E13.6)') & - J1,J2,XKER_GWETH(J1,J2) - END DO - END DO - WRITE(UNIT=ILUOUT0,FMT='("END IF")') - ELSE - CALL LIMA_READ_XKER_GWETH (KWETLBDAH,KWETLBDAG,KND, & - PALPHAH,PNUH,PALPHAG,PNUG,PEHG,PBG,PCH,PDH,PCG,PDG, & - PWETLBDAH_MAX,PWETLBDAG_MAX,PWETLBDAH_MIN,PWETLBDAG_MIN, & - PFDINFTY,XKER_GWETH ) - WRITE(UNIT=ILUOUT0,FMT='(" Read XKER_GWETH")') -END IF -! -! -! -!------------------------------------------------------------------------------- -! -!* 10. SET-UP RADIATIVE PARAMETERS -! --------------------------- -! -! -! R_eff_i = XFREFFI * (rho*r_i/N_i)**(1/3) -! -XFREFFI = 0.5 * ZGAMI(8) * (1.0/XLBI)**XLBEXI -! -!------------------------------------------------------------------------------- -! -! -!* 11. SOME PRINTS FOR CONTROL -! ----------------------- -! -! -GFLAG = .TRUE. -IF (GFLAG) THEN - WRITE(UNIT=ILUOUT0,FMT='(" Summary of the ice particule characteristics")') - WRITE(UNIT=ILUOUT0,FMT='(" PRISTINE ICE")') - WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') & - XAI,XBI - WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') & - XC_I,XDI - WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') & - XALPHAI,XNUI - WRITE(UNIT=ILUOUT0,FMT='(" SNOW")') - WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') & - XAS,XBS - WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') & - XCS,XDS - WRITE(UNIT=ILUOUT0,FMT='(" concentration:CC=",E13.6," x=",E13.6)') & - XCCS,XCXS - WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') & - XALPHAS,XNUS - WRITE(UNIT=ILUOUT0,FMT='(" GRAUPEL")') - WRITE(UNIT=ILUOUT0,FMT='(" masse: A=",E13.6," B=",E13.6)') & - XAG,XBG - WRITE(UNIT=ILUOUT0,FMT='(" vitesse: C=",E13.6," D=",E13.6)') & - XCG,XDG - WRITE(UNIT=ILUOUT0,FMT='(" concentration:CC=",E13.6," x=",E13.6)') & - XCCG,XCXG - WRITE(UNIT=ILUOUT0,FMT='(" distribution:AL=",E13.6,"NU=",E13.6)') & - XALPHAG,XNUG -END IF -! -!------------------------------------------------------------------------------ -! -END SUBROUTINE INI_LIMA_COLD_MIXED diff --git a/src/ICCARE_BASE/ini_modeln.f90 b/src/ICCARE_BASE/ini_modeln.f90 deleted file mode 100644 index d7f99b15d..000000000 --- a/src/ICCARE_BASE/ini_modeln.f90 +++ /dev/null @@ -1,2696 +0,0 @@ -!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!----------------------------------------------------------------- -! ####################### - MODULE MODI_INI_MODEL_n -! ####################### -! -INTERFACE -! - SUBROUTINE INI_MODEL_n(KMI,TPINIFILE) -! -USE MODD_IO, ONLY: TFILEDATA -! -INTEGER, INTENT(IN) :: KMI ! Model Index -TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file -! -END SUBROUTINE INI_MODEL_n -! -END INTERFACE -! -END MODULE MODI_INI_MODEL_n -! ############################################ - SUBROUTINE INI_MODEL_n(KMI,TPINIFILE) -! ############################################ -! -!!**** *INI_MODEL_n* - routine to initialize the nested model _n -!! -!! PURPOSE -!! ------- -! The purpose of this routine is to initialize the variables -! of the nested model _n. -! -!!** METHOD -!! ------ -!! The initialization of the model _n is performed as follows : -!! - Memory for arrays are then allocated : -!! * If turbulence kinetic energy variable is not needed -!! (CTURB='NONE'), XTKET, XTKEM and XTKES are zero-size arrays. -!! * If dissipation of TKE variable is not needed -!! (CTURBLEN /='KEPS'), XEPST, XEPSM and XREPSS are zero-size arrays. -!! * Memory for mixing ratio arrays is allocated according to the -!! value of logicals LUSERn (the number NRR of moist variables is deduced). -!! * The latitude (XLAT), longitude (XLON) and map factor (XMAP) -!! arrays are zero-size arrays if Cartesian geometry (LCARTESIAN=.TRUE.) -!! * Memory for reference state without orography ( XRHODREFZ and -!! XTHVREFZ) is only allocated in INI_MODEL1 -!! * The horizontal Coriolis parameters (XCORIOX and XCORIOY) arrays -!! are zero-size arrays if thinshell approximation (LTHINSHELL=.TRUE.) -!! * The Curvature coefficients (XCURVX and XCURVY) arrays -!! are zero-size arrays if Cartesian geometry (LCARTESIAN=.TRUE.) -!! * Memory for the Jacobian (ZJ) local array is allocated -!! (This variable is computed in SET_GRID and used in SET_REF). -!! - The spatial and temporal grid variables are initialized by SET_GRID. -!! - The metric coefficients are computed by METRICS (they are using in -!! the SET-REF call). -!! - The prognostic variables and are read in initial -!! LFIFM file (in READ_FIELD) -!! - The reference state variables are initialized by SET_REF. -!! - The temporal indexes of the outputs are computed by SET_OUTPUT_TIMES -!! - The large scale sources are computed in case of coupling case by -!! INI_CPL. -!! - The initialization of the parameters needed for the dynamics -!! of the model n is realized in INI_DYNAMICS. -!! - Then the initial file (DESFM+LFIFM files) is closed by IO_File_close. -!! - The initialization of the parameters needed for the ECMWF radiation -!! code is realized in INI_RADIATIONS. -!! - The contents of the scalar variables are overwritten by -!! the chemistry initialization subroutine CH_INIT_FIELDn when -!! the flags LUSECHEM and LCH_INIT_FIELD are set to TRUE. -!! This allows easy initialization of the chemical fields at a -!! restart of the model. -!! -!! EXTERNAL -!! -------- -!! SET_DIM : to initialize dimensions -!! SET_GRID : to initialize grid -!! METRICS : to compute metric coefficients -!! READ_FIELD : to initialize field -!! FMCLOS : to close a FM-file -!! SET_REF : to initialize reference state for anelastic approximation -!! INI_DYNAMICS: to initialize parameters for the dynamics -!! INI_TKE_EPS : to initialize the TKE -!! SET_DIRCOS : to compute the director cosinus of the orography -!! INI_RADIATIONS : to initialize radiation computations -!! CH_INIT_CCS: to initialize the chemical core system -!! CH_INIT_FIELDn: to (re)initialize the scalar variables -!! INI_DEEP_CONVECTION : to initialize the deep convection scheme -!! CLEANLIST_ll : deaalocate a list -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! Module MODD_PARAMETERS : contains declaration of parameter variables -!! JPHEXT : Horizontal external points number -!! JPVEXT : Vertical external points number -!! -!! Module MODD_MODD_DYN : contains declaration of parameters -!! for the dynamics -!! Module MODD_CONF : contains declaration of configuration variables -!! for all models -!! NMODEL : Number of nested models -!! NVERB : Level of informations on output-listing -!! 0 for minimum prints -!! 5 for intermediate level of prints -!! 10 for maximum prints -!! -!! Module MODD_REF : contains declaration of reference state -!! variables for all models -!! Module MODD_FIELD_n : contains declaration of prognostic fields -!! Module MODD_LSFIELD_n : contains declaration of Larger Scale fields -!! Module MODD_GRID_n : contains declaration of spatial grid variables -!! Module MODD_TIME_n : contains declaration of temporal grid variables -!! Module MODD_REF_n : contains declaration of reference state -!! variables -!! Module MODD_CURVCOR_n : contains declaration of curvature and Coriolis -!! variables -!! Module MODD_BUDGET : contains declarations of the budget parameters -!! Module MODD_RADIATIONS_n:contains declaration of the variables of the -!! radiation interface scheme -!! Module MODD_STAND_ATM : contains declaration of the 5 standard -!! atmospheres used for the ECMWF-radiation code -!! Module MODD_FRC : contains declaration of the control variables -!! and of the forcing fields -!! Module MODD_CH_MNHC_n : contains the control parameters for chemistry -!! Module MODD_DEEP_CONVECTION_n: contains declaration of the variables of -!! the deep convection scheme -!! -!! -!! -!! -!! Module MODN_CONF_n : contains declaration of namelist NAM_CONFn and -!! uses module MODD_CONF_n (configuration variables) -!! Module MODN_LUNIT_n : contains declaration of namelist NAM_LUNITn and -!! uses module MODD_LUNIT_n (Logical units) -!! Module MODN_DYN_n : contains declaration of namelist NAM_DYNn and -!! uses module MODD_DYN_n (control of dynamics) -!! Module MODN_PARAM_n : contains declaration of namelist NAM_PARAMn and -!! uses module MODD_PARAM_n (control of physical -!! parameterization) -!! Module MODN_LBC_n : contains declaration of namelist NAM_LBCn and -!! uses module MODD_LBC_n (lateral boundaries) -!! Module MODN_TURB_n : contains declaration of namelist NAM_TURBn and -!! uses module MODD_TURB_n (turbulence scheme) -!! Module MODN_PARAM_RAD_n: contains declaration of namelist NAM_PARAM_RADn -!! -!! REFERENCE -!! --------- -!! Book2 of documentation (routine INI_MODEL_n) -!! -!! -!! AUTHOR -!! ------ -!! V. Ducrocq * Meteo France * -!! -!! MODIFICATIONS -!! ------------- -!! Original 10/06/94 -!! Modification 17/10/94 (Stein) For LCORIO -!! Modification 20/10/94 (Stein) For SET_GRID and NAMOUTN -!! Modification 26/10/94 (Stein) Modifications of the namelist names -!! Modification 10/11/94 (Lafore) allocatation of tke fields -!! Modification 22/11/94 (Stein) change the READ_FIELDS call ( add -!! pressure function -!! Modification 06/12/94 (Stein) add the LS fields -!! 12/12/94 (Stein) rename END_INI in INI_DYNAMICS -!! Modification 09/01/95 (Stein) add the turbulence scheme -!! Modification Jan 19, 1995 (J. Cuxart) add the TKE initialization -!! Jan 23, 1995 (J. Stein ) remove the condition -!! LTHINSHELL=T LCARTESIAN=T => stop -!! Modification Feb 16, 1995 (I.Mallet) add the METRICS call and -!! change the SET_REF call (add -!! the lineic mass) -!! Modification Mar 10, 1995 (I. Mallet) add the COUPLING initialization -!! June 29,1995 (Ph. Hereil, J. Stein) add the budget init. -!! Modification Sept. 1, 1995 (S. Belair) Reading of the surface variables -!! and parameters for ISBA (i.e., add a -!! CALL READ_GR_FIELD) -!! Modification 18/08/95 (J.P.Lafore) time step change case -!! 25/09/95 (J. Cuxart and J.Stein) add LES variables -!! and the diachronic file initialization -!! Modification Sept 20,1995 (Lafore) coupling for the dry mass Md -!! Modification Sept. 12, 1995 (J.-P. Pinty) add the initialization of -!! the ECMWF radiation code -!! Modification Sept. 13, 1995 (J.-P. Pinty) control the allocation of the -!! arrays of MODD_GR_FIELD_n -!! Modification Nove. 17, 1995 (J.Stein) control of the control !! -!! March 01, 1996 (J. Stein) add the cloud fraction -!! April 03, 1996 (J. Stein) unify the ISBA and TSZ0 cases -!! Modification 13/12/95 (M. Georgelin) add the forcing variables in -!! the call read_field, and their -!! allocation. -!! Mai 23, 1996 (J. Stein) allocate XSEA in the TSZ0 case -!! June 11, 1996 (V. Masson) add XSILT and XLAKE of -!! MODD_GR_FIELD_n -!! August 7, 1996 (K. Suhre) add (re)initialization of -!! chemistry -!! Octo. 11, 1996 (J. Stein ) add XSRCT and XSRCM -!! October 8, 1996 (J. Cuxart, E. Sanchez) Moist LES diagnostics -!! and control on TKE initialization. -!! Modification 19/12/96 (J.-P. Pinty) add the ice parameterization and -!! the precipitation fields -!! Modification 11/01/97 (J.-P. Pinty) add the deep convection -!! Nov. 1, 1996 (V. Masson) Read the vertical grid kind -!! Nov. 20, 1996 (V. Masson) control of convection calling time -!! July 16, 1996 (J.P.Lafore) update of EXSEG file reading -!! Oct. 08, 1996 (J.P.Lafore, V.Masson) -!! MY_NAME and DAD_NAME reading and check -!! Oct. 30, 1996 (J.P.Lafore) resolution ratio reading for nesting -!! and Bikhardt interpolation coef. initialization -!! Nov. 22, 1996 (J.P.Lafore) allocation of LS sources for nesting -!! Feb. 26, 1997 (J.P.Lafore) allocation of "surfacic" LS fields -!! March 10, 1997 (J.P.Lafore) forcing only for model 1 -!! June 22, 1997 (J. Stein) add the absolute pressure -!! July 09, 1997 (V. Masson) add directional z0 and SSO -!! Aug. 18, 1997 (V. Masson) consistency between storage -!! type and CCONF -!! Dec. 22, 1997 (J. Stein) add the LS field spawning -!! Jan. 24, 1998 (P.Bechtold) change MODD_FRC and MODD_DEEP_CONVECTION -!! Dec. 24, 1997 (V.Masson) directional z0 parameters -!! Aug. 13, 1998 (V. Ducrocq P Jabouille) // -!! Mai. 26, 1998 (J. Stein) remove NXEND,NYEND -!! Feb. 1, 1999 (J. Stein) compute the Bikhardt -!! interpolation coeff. before the call to set_grid -!! April 5, 1999 (V. Ducrocq) change the DXRATIO_ALL init. -!! April 12, 1999 (J. Stein) cleaning + INI_SPAWN_LS -!! Apr. 7, 1999 (P Jabouille) store the metric coefficients -!! in modd_metrics_n -!! Jui. 15,1999 (P Jabouille) split the routines in two parts -!! Jan. 04,2000 (V. Masson) removes the TSZ0 case -!! Apr. 15,2000 (P Jabouille) parallelization of grid nesting -!! Aug. 20,2000 (J Stein ) tranpose XBFY -!! Jui 01,2000 (F.solmon ) adapatation for patch approach -!! Jun. 15,2000 (J.-P. Pinty) add C2R2 initialization -!! Nov. 15,2000 (V.Masson) use of ini_modeln in prep_real_case -!! Nov. 15,2000 (V.Masson) call of LES routines -!! Nov. 15,2000 (V.Masson) aircraft and balloon initialization routines -!! Jan. 22,2001 (D.Gazen) update_nsv set NSV_* var. for current model -!! Mar. 04,2002 (V.Ducrocq) initialization to temporal series -!! Mar. 15,2002 (F.Solmon) modification of ini_radiation interface -!! Nov. 29,2002 (JP Pinty) add C3R5, ICE2, ICE4, ELEC -!! Jan. 2004 (V.Masson) externalization of surface -!! May 2006 Remove KEPS -!! Apr. 2010 (M. Leriche) add pH for aqueous phase chemistry -!! Jul. 2010 (M. Leriche) add Ice phase chemistry -!! Oct. 2010 (J.Escobar) check if local domain not to small for NRIMX NRIMY -!! Nov. 2010 (J.Escobar) PGI BUG , add SIZE(CSV) to init_ground routine -!! Nov. 2009 (C. Barthe) add call to INI_ELEC_n -!! Mar. 2010 (M. Chong) add small ions -!! Apr. 2011 (M. Chong) correction of RESTART (ELEC) -!! June 2011 (B.Aouizerats) Prognostic aerosols -!! June 2011 (P.Aumond) Drag of the vegetation -!! + Mean fields -!! July 2013 (Bosseur & Filippi) Adds Forefire -!! P. Tulet Nov 2014 accumulated moles of aqueous species that fall at the surface -!! JAn. 2015 (F. Brosse) bug in allocate XACPRAQ -!! Dec 2014 (C.Lac) : For reproducibility START/RESTA -!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1 -!! V. Masson Feb 2015 replaces, for aerosols, cover fractions by sea, town, bare soil fractions -!! J.Escobar : 19/04/2016 : Pb IOZ/NETCDF , missing OPARALLELIO=.FALSE. for PGD files -!! J.Escobar : 01/06/2016 : correct check limit of NRIM versus local subdomain size IDIM -!! 06/2016 (G.Delautier) phasage surfex 8 -!! Modification 01/2016 (JP Pinty) Add LIMA -!! Aug. 2016 (J.Pianezze) Add SFX_OASIS_READ_NAM function from SurfEx -!! M.Leriche 2016 Chemistry -!! 10/2016 M.Mazoyer New KHKO output fields -!! 10/2016 (C.Lac) Add max values -!! F. Brosse Oct. 2016 add prod/loss terms computation for chemistry -!! M.Leriche 2016 Chemistry -!! M.Leriche 10/02/17 prevent negative values in LBX(Y)SVS -!! M.Leriche 01/07/2017 Add DIAG chimical surface fluxes -!! 09/2017 Q.Rodier add LTEND_UV_FRC -!! 02/2018 Q.Libois ECRAD -!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O -!! V. Vionnet : 18/07/2017 : add blowing snow scheme -!! 01/18 J.Colin Add DRAG -! P. Wautelet 29/01/2019: bug: add missing zero-size allocations -! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list -! P. Wautelet 13/02/2019: initialize XALBUV even if no radiation (needed in CH_INTERP_JVALUES) -! P. Wautelet 13/02/2019: removed PPABSM and PTSTEP dummy arguments of READ_FIELD -! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables -! P. Wautelet 14/02/2019: remove HINIFILE dummy argument from INI_RADIATIONS_ECMWF/ECRAD -!! 02/2019 C.Lac add rain fraction as an output field -!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes -! P. Wautelet 14/03/2019: correct ZWS when variable not present in file (set to XZWS_DEFAULT) -! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg -! P. Wautelet 19/04/2019: removed unused dummy arguments and variables -! P. Wautelet 07/06/2019: allocate lookup tables for optical properties only when needed -! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management -! C. Lac 11/2019: correction in the drag formula and application to building in addition to tree -! S. Riette 04/2020: XHL* fields -! F. Auguste 02/2021: add IBM -! T.Nigel 02/2021: add turbulence recycling -! J.L.Redelsperger 06/2011: OCEAN case -!--------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -#ifdef MNH_ECRAD -USE YOERDI, only: RCCO2 -#endif - -USE MODD_2D_FRC -USE MODD_ADVFRC_n -USE MODD_ADV_n -use MODD_AEROSET, only: POLYTAU, POLYSSA, POLYG -USE MODD_ARGSLIST_ll, only: LIST_ll -USE MODD_BIKHARDT_n -USE MODD_BLOWSNOW -USE MODD_BLOWSNOW_n -USE MODD_BUDGET -USE MODD_CH_AERO_n, only: XSOLORG,XMI -USE MODD_CH_AEROSOL, only: LORILAM -USE MODD_CH_BUDGET_n -USE MODD_CH_FLX_n, only: XCHFLX -USE MODD_CH_M9_n, only:NNONZEROTERMS -USE MODD_CH_MNHC_n, only: LUSECHEM, LUSECHAQ, LUSECHIC, LCH_INIT_FIELD, & - LCH_CONV_LINOX, XCH_TUV_DOBNEW, LCH_PH -USE MODD_CH_PH_n -USE MODD_CH_PRODLOSSTOT_n -USE MODD_CLOUD_MF_n -USE MODD_CONF -USE MODD_CONF_n -USE MODD_CST -USE MODD_CTURB -USE MODD_CURVCOR_n -USE MODD_DEEP_CONVECTION_n -USE MODD_DEF_EDDY_FLUX_n ! for VT and WT fluxes -USE MODD_DEF_EDDYUV_FLUX_n ! FOR UV -USE MODD_DIAG_FLAG, only: LCHEMDIAG, CSPEC_BU_DIAG -USE MODD_DIM_n -USE MODD_DRAG_n -USE MODD_DRAGTREE_n -USE MODD_DUST -use MODD_DUST_OPT_LKT, only: NMAX_RADIUS_LKT_DUST=>NMAX_RADIUS_LKT, NMAX_SIGMA_LKT_DUST=>NMAX_SIGMA_LKT, & - NMAX_WVL_SW_DUST=>NMAX_WVL_SW, & - XEXT_COEFF_WVL_LKT_DUST=>XEXT_COEFF_WVL_LKT, XEXT_COEFF_550_LKT_DUST=>XEXT_COEFF_550_LKT, & - XPIZA_LKT_DUST=>XPIZA_LKT, XCGA_LKT_DUST=>XCGA_LKT -USE MODD_DYN -USE MODD_DYN_n -USE MODD_DYNZD -USE MODD_DYNZD_n -USE MODD_ELEC_n, only: XCION_POS_FW, XCION_NEG_FW -USE MODD_EOL_MAIN -USE MODD_FIELD_n -#ifdef MNH_FOREFIRE -USE MODD_FOREFIRE -USE MODD_FOREFIRE_n -#endif -USE MODD_FRC -USE MODD_FRC_n -USE MODD_GET_n -USE MODD_GRID_n -USE MODD_GRID, only: XLONORI,XLATORI -USE MODD_IBM_PARAM_n, only: LIBM, XIBM_IEPS, XIBM_LS, XIBM_XMUT -USE MODD_IO, only: CIO_DIR, TFILEDATA, TFILE_DUMMY -USE MODD_IO_SURF_MNH, only: IO_SURF_MNH_MODEL -USE MODD_LATZ_EDFLX -USE MODD_LBC_n, only: CLBCX, CLBCY -use modd_les -USE MODD_LSFIELD_n -USE MODD_LUNIT_n -USE MODD_MEAN_FIELD -USE MODD_MEAN_FIELD_n -USE MODD_METRICS_n -USE MODD_MNH_SURFEX_n -USE MODD_NESTING, only: CDAD_NAME, NDAD, NDT_2_WAY, NDTRATIO, NDXRATIO_ALL, NDYRATIO_ALL -USE MODD_NSV -USE MODD_NSV -USE MODD_NUDGING_n, only: LNUDGING -USE MODD_OCEANH -USE MODD_OUT_n -USE MODD_PARAMETERS -USE MODD_PARAM_KAFR_n -USE MODD_PARAM_MFSHALL_n -USE MODD_PARAM_n -USE MODD_PARAM_RAD_n, only: CAER, CAOP, CLW -USE MODD_PASPOL -USE MODD_PASPOL_n -USE MODD_PAST_FIELD_n -use modd_precision, only: LFIINT -USE MODD_RADIATIONS_n -USE MODD_RECYCL_PARAM_n -USE MODD_REF -USE MODD_REF_n -USE MODD_RELFRC_n -use MODD_SALT, only: LSALT -use MODD_SALT_OPT_LKT, only: NMAX_RADIUS_LKT_SALT=>NMAX_RADIUS_LKT, NMAX_SIGMA_LKT_SALT=>NMAX_SIGMA_LKT, & - NMAX_WVL_SW_SALT=>NMAX_WVL_SW, & - XEXT_COEFF_WVL_LKT_SALT=>XEXT_COEFF_WVL_LKT, XEXT_COEFF_550_LKT_SALT=>XEXT_COEFF_550_LKT, & - XPIZA_LKT_SALT=>XPIZA_LKT, XCGA_LKT_SALT=>XCGA_LKT -USE MODD_SERIES, only: LSERIES -USE MODD_SHADOWS_n -USE MODD_STAND_ATM, only: XSTROATM, XSMLSATM, XSMLWATM, XSPOSATM, XSPOWATM -USE MODD_TIME -USE MODD_TIME_n -USE MODD_TURB_CLOUD, only: NMODEL_CLOUD, CTURBLEN_CLOUD,XCEI -USE MODD_TURB_n -USE MODD_VAR_ll, only: IP - -USE MODE_GATHER_ll -use mode_ini_budget, only: Budget_preallocate, Ini_budget -USE MODE_INI_ONE_WAY_n -USE MODE_IO -USE MODE_IO_FIELD_READ, only: IO_Field_read -USE MODE_IO_FILE, only: IO_File_open -USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list -USE MODE_ll -USE MODE_MODELN_HANDLER -USE MODE_MPPDB -USE MODE_MSG -USE MODE_SPLITTINGZ_ll, only: GET_DIM_EXTZ_ll -USE MODE_TYPE_ZDIFFU - -USE MODI_CH_AER_MOD_INIT -USE MODI_CH_INIT_BUDGET_n -USE MODI_CH_INIT_FIELD_n -USE MODI_CH_INIT_JVALUES -USE MODI_CH_INIT_PRODLOSSTOT_n -USE MODI_GET_SIZEX_LB -USE MODI_GET_SIZEY_LB -USE MODI_INI_AEROSET1 -USE MODI_INI_AEROSET2 -USE MODI_INI_AEROSET3 -USE MODI_INI_AEROSET4 -USE MODI_INI_AEROSET5 -USE MODI_INI_AEROSET6 -USE MODI_INI_AIRCRAFT_BALLOON -USE MODI_INI_AIRCRAFT_BALLOON -USE MODI_INI_BIKHARDT_n -USE MODI_INI_CPL -USE MODI_INI_DEEP_CONVECTION -USE MODI_INI_DRAG -USE MODI_INI_DYNAMICS -USE MODI_INI_ELEC_n -USE MODI_INI_EOL_ADNR -USE MODI_INI_EOL_ALM -USE MODI_INI_LES_N -USE MODI_INI_LG -USE MODI_INI_LW_SETUP -USE MODI_INI_MICRO_n -USE MODI_INI_POSPROFILER_n -USE MODI_INI_RADIATIONS -USE MODI_INI_RADIATIONS_ECMWF -USE MODI_INI_RADIATIONS_ECRAD -USE MODI_INI_SERIES_N -USE MODI_INI_SPAWN_LS_n -USE MODI_INI_SURF_RAD -USE MODI_INI_SURFSTATION_n -USE MODI_INI_SW_SETUP -USE MODI_INIT_AEROSOL_PROPERTIES -#ifdef MNH_FOREFIRE -USE MODI_INIT_FOREFIRE_n -#endif -USE MODI_INIT_GROUND_PARAM_n -USE MODI_INI_TKE_EPS -USE MODI_METRICS -USE MODI_MNHGET_SURF_PARAM_n -USE MODI_MNHREAD_ZS_DUMMY_n -USE MODI_READ_FIELD -USE MODI_SET_DIRCOS -USE MODI_SET_GRID -USE MODI_SET_REF -#ifdef CPLOASIS -USE MODI_SFX_OASIS_READ_NAM -#endif -USE MODI_SUNPOS_n -USE MODI_SURF_SOLAR_GEOM -USE MODI_UPDATE_METRICS -USE MODI_UPDATE_NSV -#ifdef MNH_ECRAD -#if ( VER_ECRAD == 140 ) -USE YOERDI , ONLY :RCCO2 -#endif -#endif -! -IMPLICIT NONE -! -!* 0.1 declarations of arguments -! -! -INTEGER, INTENT(IN) :: KMI ! Model Index -TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! Initial file -! -!* 0.2 declarations of local variables -! -REAL, PARAMETER :: NALBUV_DEFAULT = 0.01 ! Arbitrary low value for XALBUV -! -INTEGER :: JSV ! Loop index -INTEGER :: IRESP ! Return code of FM routines -INTEGER :: ILUOUT ! Logical unit number of output-listing -CHARACTER(LEN=28) :: YNAME -INTEGER :: IIU ! Upper dimension in x direction (local) -INTEGER :: IJU ! Upper dimension in y direction (local) -INTEGER :: IIU_ll ! Upper dimension in x direction (global) -INTEGER :: IJU_ll ! Upper dimension in y direction (global) -INTEGER :: IKU ! Upper dimension in z direction -REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZJ ! Jacobian -LOGICAL :: GINIDCONV ! logical switch for the deep convection - ! initialization -LOGICAL :: GINIRAD ! logical switch for the radiation - ! initialization -logical :: gles ! Logical to determine if LES diagnostics are enabled -! -! -TYPE(LIST_ll), POINTER :: TZINITHALO2D_ll ! pointer for the list of 2D fields - ! which must be communicated in INIT -TYPE(LIST_ll), POINTER :: TZINITHALO3D_ll ! pointer for the list of 3D fields - ! which must be communicated in INIT -! -INTEGER :: IISIZEXF,IJSIZEXF,IISIZEXFU,IJSIZEXFU ! dimensions of the -INTEGER :: IISIZEX4,IJSIZEX4,IISIZEX2,IJSIZEX2 ! West-east LB arrays -INTEGER :: IISIZEYF,IJSIZEYF,IISIZEYFV,IJSIZEYFV ! dimensions of the -INTEGER :: IISIZEY4,IJSIZEY4,IISIZEY2,IJSIZEY2 ! North-south LB arrays -INTEGER :: IINFO_ll ! Return code of //routines -INTEGER :: IIY,IJY -INTEGER :: IIU_B,IJU_B -INTEGER :: IIU_SXP2_YP1_Z_ll,IJU_SXP2_YP1_Z_ll,IKU_SXP2_YP1_Z_ll -! -REAL, DIMENSION(:,:), ALLOCATABLE :: ZCO2 ! CO2 concentration near the surface -REAL, DIMENSION(:,:), ALLOCATABLE :: ZSEA ! sea fraction -REAL, DIMENSION(:,:), ALLOCATABLE :: ZTOWN ! town fraction -REAL, DIMENSION(:,:), ALLOCATABLE :: ZBARE ! bare soil fraction -! -REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDIR_ALB ! direct albedo -REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSCA_ALB ! diffuse albedo -REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEMIS ! emissivity -REAL, DIMENSION(:,:), ALLOCATABLE :: ZTSRAD ! surface temperature -REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZIBM_LS ! LevelSet IBM -! -! -INTEGER, DIMENSION(:,:),ALLOCATABLE :: IINDEX ! indices of non-zero terms -INTEGER, DIMENSION(:),ALLOCATABLE :: IIND -INTEGER :: JM, JT -! -!------------------------------------------ -! Dummy pointers needed to correct an ifort Bug -REAL, DIMENSION(:), POINTER :: DPTR_XZHAT -REAL, DIMENSION(:), POINTER :: DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4 -REAL, DIMENSION(:), POINTER :: DPTR_XBMY1,DPTR_XBMY2,DPTR_XBMY3,DPTR_XBMY4 -REAL, DIMENSION(:), POINTER :: DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4 -REAL, DIMENSION(:), POINTER :: DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4 -CHARACTER(LEN=4), DIMENSION(:), POINTER :: DPTR_CLBCX,DPTR_CLBCY -INTEGER, DIMENSION(:,:,:), POINTER :: DPTR_NKLIN_LBXU,DPTR_NKLIN_LBYU,DPTR_NKLIN_LBXV,DPTR_NKLIN_LBYV -INTEGER, DIMENSION(:,:,:), POINTER :: DPTR_NKLIN_LBXW,DPTR_NKLIN_LBYW,DPTR_NKLIN_LBXM,DPTR_NKLIN_LBYM -REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXU,DPTR_XCOEFLIN_LBYU -REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXV,DPTR_XCOEFLIN_LBYV -REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXW,DPTR_XCOEFLIN_LBYW -REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXM,DPTR_XCOEFLIN_LBYM -REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXUM,DPTR_XLBYUM,DPTR_XLBXVM,DPTR_XLBYVM -REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXWM,DPTR_XLBYWM,DPTR_XLBXTHM,DPTR_XLBYTHM -REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXTKEM,DPTR_XLBYTKEM -REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XLBXSVM,DPTR_XLBYSVM -REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XLBXRM,DPTR_XLBYRM -REAL, DIMENSION(:,:,:), POINTER :: DPTR_XZZ -REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLSUM,DPTR_XLSVM,DPTR_XLSWM,DPTR_XLSTHM,DPTR_XLSRVM -REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLSUS,DPTR_XLSVS,DPTR_XLSWS,DPTR_XLSTHS,DPTR_XLSRVS -REAL, DIMENSION(:,:), POINTER :: DPTR_XLSZWSM,DPTR_XLSZWSS -! -INTEGER :: IIB,IJB,IIE,IJE,IDIMX,IDIMY,IMI -! -!------------------------------------------------------------------------------- -! -!* 0. PROLOGUE -! -------- -! Compute relaxation coefficients without changing INI_DYNAMICS nor RELAXDEF -! -IF (CCLOUD == 'LIMA') THEN - LHORELAX_SVC1R3=LHORELAX_SVLIMA -END IF -! -! UPDATE CONSTANTS FOR OCEAN MODEL -IF (LOCEAN) THEN - XP00=XP00OCEAN - XTH00=XTH00OCEAN -END IF -! -! -NULLIFY(TZINITHALO2D_ll) -NULLIFY(TZINITHALO3D_ll) -! -!* 1. RETRIEVE LOGICAL UNIT NUMBER -! ---------------------------- -! -ILUOUT = TLUOUT%NLU -! -!------------------------------------------------------------------------------- -! -!* 2. END OF READING -! -------------- -!* 2.1 Read number of forcing fields -! -IF (LFORCING) THEN ! Retrieve the number of time-dependent forcings. - CALL IO_Field_read(TPINIFILE,'FRC',NFRC,IRESP) - IF ( (IRESP /= 0) .OR. (NFRC <=0) ) THEN - WRITE(ILUOUT,'(A/A)') & - "INI_MODEL_n ERROR: you want to read forcing variables from FMfile", & - " but no fields have been found by IO_Field_read" -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_MODEL_n','') - END IF -END IF -! -! Modif PP for time evolving adv forcing - IF ( L2D_ADV_FRC ) THEN ! Retrieve the number of time-dependent forcings. - WRITE(ILUOUT,FMT=*) "INI_MODEL_n ENTER ADV_FORCING" - CALL IO_Field_read(TPINIFILE,'NADVFRC1',NADVFRC,IRESP) - IF ( (IRESP /= 0) .OR. (NADVFRC <=0) ) THEN - WRITE(ILUOUT,'(A/A)') & - "INI_MODELn ERROR: you want to read forcing ADV variables from FMfile", & - " but no fields have been found by IO_Field_read" - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_MODEL_n','') - END IF - WRITE(ILUOUT,*) 'NADVFRC = ', NADVFRC -END IF -! -IF ( L2D_REL_FRC ) THEN ! Retrieve the number of time-dependent forcings. - WRITE(ILUOUT,FMT=*) "INI_MODEL_n ENTER REL_FORCING" - CALL IO_Field_read(TPINIFILE,'NRELFRC1',NRELFRC,IRESP) - IF ( (IRESP /= 0) .OR. (NRELFRC <=0) ) THEN - WRITE(ILUOUT,'(A/A)') & - "INI_MODELn ERROR: you want to read forcing REL variables from FMfile", & - " but no fields have been found by IO_Field_read" - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_MODEL_n','') - END IF - WRITE(ILUOUT,*) 'NRELFRC = ', NRELFRC -END IF -!* 2.2 Checks the position of vertical absorbing layer -! -IKU=NKMAX+2*JPVEXT -! -ALLOCATE(XZHAT(IKU)) -CALL IO_Field_read(TPINIFILE,'ZHAT',XZHAT) -CALL IO_Field_read(TPINIFILE,'ZTOP',XZTOP) -IF (XALZBOT>=XZHAT(IKU) .AND. LVE_RELAX) THEN - WRITE(ILUOUT,FMT=*) "INI_MODEL_n ERROR: you want to use vertical relaxation" - WRITE(ILUOUT,FMT=*) " but bottom of layer XALZBOT(",XALZBOT,")" - WRITE(ILUOUT,FMT=*) " is upper than model top (",XZHAT(IKU),")" -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_MODEL_n','') -END IF -IF (LVE_RELAX) THEN - IF (XALZBOT>=XZHAT(IKU-4) ) THEN - WRITE(ILUOUT,FMT=*) "INI_MODEL_n WARNING: you want to use vertical relaxation" - WRITE(ILUOUT,FMT=*) " but the layer defined by XALZBOT(",XALZBOT,")" - WRITE(ILUOUT,FMT=*) " contains less than 5 model levels" - END IF -END IF -DEALLOCATE(XZHAT) -! -!* 2.3 Compute sizes of arrays of the extended sub-domain -! -CALL GET_DIM_EXT_ll('B',IIU,IJU) -IIU_ll=NIMAX_ll + 2 * JPHEXT -IJU_ll=NJMAX_ll + 2 * JPHEXT -! initialize NIMAX and NJMAX for not updated versions regarding the parallelism -! spawning,... -CALL GET_DIM_PHYS_ll('B',NIMAX,NJMAX) -! -CALL GET_INDICE_ll( IIB,IJB,IIE,IJE) -IDIMX = IIE - IIB + 1 -IDIMY = IJE - IJB + 1 -! -NRR=0 -NRRL=0 -NRRI=0 -IF (CGETRVT /= 'SKIP' ) THEN - NRR = NRR+1 - IDX_RVT = NRR -END IF -IF (CGETRCT /= 'SKIP' ) THEN - NRR = NRR+1 - NRRL = NRRL+1 - IDX_RCT = NRR -END IF -IF (CGETRRT /= 'SKIP' ) THEN - NRR = NRR+1 - NRRL = NRRL+1 - IDX_RRT = NRR -END IF -IF (CGETRIT /= 'SKIP' ) THEN - NRR = NRR+1 - NRRI = NRRI+1 - IDX_RIT = NRR -END IF -IF (CGETRST /= 'SKIP' ) THEN - NRR = NRR+1 - NRRI = NRRI+1 - IDX_RST = NRR -END IF -IF (CGETRGT /= 'SKIP' ) THEN - NRR = NRR+1 - NRRI = NRRI+1 - IDX_RGT = NRR -END IF -IF (CGETRHT /= 'SKIP' ) THEN - NRR = NRR+1 - NRRI = NRRI+1 - IDX_RHT = NRR -END IF -IF (NVERB >= 5) THEN - WRITE (UNIT=ILUOUT,FMT='("THERE ARE ",I2," WATER VARIABLES")') NRR - WRITE (UNIT=ILUOUT,FMT='("THERE ARE ",I2," LIQUID VARIABLES")') NRRL - WRITE (UNIT=ILUOUT,FMT='("THERE ARE ",I2," SOLID VARIABLES")') NRRI -END IF -! -!* 2.4 Update NSV and floating indices for the current model -! -! -CALL UPDATE_NSV(KMI) -!------------------------------------------------------------------------------- -! -!* 3. ALLOCATE MEMORY -! ----------------- -! * Module RECYCL -! -IF (LRECYCL) THEN -! - NR_COUNT = 0 -! - ALLOCATE(XUMEANW(IJU,IKU,INT(XNUMBELT))) ; XUMEANW = 0.0 - ALLOCATE(XVMEANW(IJU,IKU,INT(XNUMBELT))) ; XVMEANW = 0.0 - ALLOCATE(XWMEANW(IJU,IKU,INT(XNUMBELT))) ; XWMEANW = 0.0 - ALLOCATE(XUMEANN(IIU,IKU,INT(XNUMBELT))) ; XUMEANN = 0.0 - ALLOCATE(XVMEANN(IIU,IKU,INT(XNUMBELT))) ; XVMEANN = 0.0 - ALLOCATE(XWMEANN(IIU,IKU,INT(XNUMBELT))) ; XWMEANN = 0.0 - ALLOCATE(XUMEANE(IJU,IKU,INT(XNUMBELT))) ; XUMEANE = 0.0 - ALLOCATE(XVMEANE(IJU,IKU,INT(XNUMBELT))) ; XVMEANE = 0.0 - ALLOCATE(XWMEANE(IJU,IKU,INT(XNUMBELT))) ; XWMEANE = 0.0 - ALLOCATE(XUMEANS(IIU,IKU,INT(XNUMBELT))) ; XUMEANS = 0.0 - ALLOCATE(XVMEANS(IIU,IKU,INT(XNUMBELT))) ; XVMEANS = 0.0 - ALLOCATE(XWMEANS(IIU,IKU,INT(XNUMBELT))) ; XWMEANS = 0.0 - ALLOCATE(XTBV(IIU,IJU,IKU)) ; XTBV = 0.0 -ELSE - ALLOCATE(XUMEANW(0,0,0)) - ALLOCATE(XVMEANW(0,0,0)) - ALLOCATE(XWMEANW(0,0,0)) - ALLOCATE(XUMEANN(0,0,0)) - ALLOCATE(XVMEANN(0,0,0)) - ALLOCATE(XWMEANN(0,0,0)) - ALLOCATE(XUMEANE(0,0,0)) - ALLOCATE(XVMEANE(0,0,0)) - ALLOCATE(XWMEANE(0,0,0)) - ALLOCATE(XUMEANS(0,0,0)) - ALLOCATE(XVMEANS(0,0,0)) - ALLOCATE(XWMEANS(0,0,0)) - ALLOCATE(XTBV (0,0,0)) -END IF -! -! -!* 3.1 Module MODD_FIELD_n -! -IF (LMEAN_FIELD) THEN -! - MEAN_COUNT = 0 -! - ALLOCATE(XUM_MEAN(IIU,IJU,IKU)) ; XUM_MEAN = 0.0 - ALLOCATE(XVM_MEAN(IIU,IJU,IKU)) ; XVM_MEAN = 0.0 - ALLOCATE(XWM_MEAN(IIU,IJU,IKU)) ; XWM_MEAN = 0.0 - ALLOCATE(XTHM_MEAN(IIU,IJU,IKU)) ; XTHM_MEAN = 0.0 - ALLOCATE(XTEMPM_MEAN(IIU,IJU,IKU)) ; XTEMPM_MEAN = 0.0 - ALLOCATE(XSVT_MEAN(IIU,IJU,IKU)) ; XSVT_MEAN = 0.0 - IF (CTURB/='NONE') THEN - ALLOCATE(XTKEM_MEAN(IIU,IJU,IKU)) - XTKEM_MEAN = 0.0 - ELSE - ALLOCATE(XTKEM_MEAN(0,0,0)) - END IF - ALLOCATE(XPABSM_MEAN(IIU,IJU,IKU)) ; XPABSM_MEAN = 0.0 -! - ALLOCATE(XU2_MEAN(IIU,IJU,IKU)) ; XU2_MEAN = 0.0 - ALLOCATE(XV2_MEAN(IIU,IJU,IKU)) ; XV2_MEAN = 0.0 - ALLOCATE(XW2_MEAN(IIU,IJU,IKU)) ; XW2_MEAN = 0.0 - ALLOCATE(XUW_MEAN(IIU,IJU,IKU)) ; XUW_MEAN = 0.0 - ALLOCATE(XTH2_MEAN(IIU,IJU,IKU)) ; XTH2_MEAN = 0.0 - ALLOCATE(XTEMP2_MEAN(IIU,IJU,IKU)) ; XTEMP2_MEAN = 0.0 - ALLOCATE(XPABS2_MEAN(IIU,IJU,IKU)) ; XPABS2_MEAN = 0.0 -! - ALLOCATE(XUM_MAX(IIU,IJU,IKU)) ; XUM_MAX = -1.E20 - ALLOCATE(XVM_MAX(IIU,IJU,IKU)) ; XVM_MAX = -1.E20 - ALLOCATE(XWM_MAX(IIU,IJU,IKU)) ; XWM_MAX = -1.E20 - ALLOCATE(XTHM_MAX(IIU,IJU,IKU)) ; XTHM_MAX = 0.0 - ALLOCATE(XTEMPM_MAX(IIU,IJU,IKU)) ; XTEMPM_MAX = 0.0 - IF (CTURB/='NONE') THEN - ALLOCATE(XTKEM_MAX(IIU,IJU,IKU)) - XTKEM_MAX = 0.0 - ELSE - ALLOCATE(XTKEM_MAX(0,0,0)) - END IF - ALLOCATE(XPABSM_MAX(IIU,IJU,IKU)) ; XPABSM_MAX = 0.0 -ELSE - ALLOCATE(XUM_MEAN(0,0,0)) - ALLOCATE(XVM_MEAN(0,0,0)) - ALLOCATE(XWM_MEAN(0,0,0)) - ALLOCATE(XTHM_MEAN(0,0,0)) - ALLOCATE(XTEMPM_MEAN(0,0,0)) - ALLOCATE(XSVT_MEAN(0,0,0)) - ALLOCATE(XTKEM_MEAN(0,0,0)) - ALLOCATE(XPABSM_MEAN(0,0,0)) -! - ALLOCATE(XU2_MEAN(0,0,0)) - ALLOCATE(XV2_MEAN(0,0,0)) - ALLOCATE(XW2_MEAN(0,0,0)) - ALLOCATE(XUW_MEAN(0,0,0)) - ALLOCATE(XTH2_MEAN(0,0,0)) - ALLOCATE(XTEMP2_MEAN(0,0,0)) - ALLOCATE(XPABS2_MEAN(0,0,0)) -! - ALLOCATE(XUM_MAX(0,0,0)) - ALLOCATE(XVM_MAX(0,0,0)) - ALLOCATE(XWM_MAX(0,0,0)) - ALLOCATE(XTHM_MAX(0,0,0)) - ALLOCATE(XTEMPM_MAX(0,0,0)) - ALLOCATE(XTKEM_MAX(0,0,0)) - ALLOCATE(XPABSM_MAX(0,0,0)) -END IF -! -IF ((CUVW_ADV_SCHEME(1:3)=='CEN') .AND. (CTEMP_SCHEME == 'LEFR') ) THEN - ALLOCATE(XUM(IIU,IJU,IKU)) - ALLOCATE(XVM(IIU,IJU,IKU)) - ALLOCATE(XWM(IIU,IJU,IKU)) - ALLOCATE(XDUM(IIU,IJU,IKU)) - ALLOCATE(XDVM(IIU,IJU,IKU)) - ALLOCATE(XDWM(IIU,IJU,IKU)) - IF (CCONF == 'START') THEN - XUM = 0.0 - XVM = 0.0 - XWM = 0.0 - XDUM = 0.0 - XDVM = 0.0 - XDWM = 0.0 - END IF -ELSE - ALLOCATE(XUM(0,0,0)) - ALLOCATE(XVM(0,0,0)) - ALLOCATE(XWM(0,0,0)) - ALLOCATE(XDUM(0,0,0)) - ALLOCATE(XDVM(0,0,0)) - ALLOCATE(XDWM(0,0,0)) -END IF -! -ALLOCATE(XUT(IIU,IJU,IKU)) ; XUT = 0.0 -ALLOCATE(XVT(IIU,IJU,IKU)) ; XVT = 0.0 -ALLOCATE(XWT(IIU,IJU,IKU)) ; XWT = 0.0 -ALLOCATE(XTHT(IIU,IJU,IKU)) ; XTHT = 0.0 -ALLOCATE(XRUS(IIU,IJU,IKU)) ; XRUS = 0.0 -ALLOCATE(XRVS(IIU,IJU,IKU)) ; XRVS = 0.0 -ALLOCATE(XRWS(IIU,IJU,IKU)) ; XRWS = 0.0 -ALLOCATE(XRUS_PRES(IIU,IJU,IKU)); XRUS_PRES = 0.0 -ALLOCATE(XRVS_PRES(IIU,IJU,IKU)); XRVS_PRES = 0.0 -ALLOCATE(XRWS_PRES(IIU,IJU,IKU)); XRWS_PRES = 0.0 -ALLOCATE(XRTHS(IIU,IJU,IKU)) ; XRTHS = 0.0 -ALLOCATE(XRTHS_CLD(IIU,IJU,IKU)); XRTHS_CLD = 0.0 - -IF ( LIBM ) THEN - ALLOCATE(ZIBM_LS(IIU,IJU,IKU)) ; ZIBM_LS = 0.0 - ALLOCATE(XIBM_XMUT(IIU,IJU,IKU)); XIBM_XMUT = 0.0 -ELSE - ALLOCATE(ZIBM_LS (0,0,0)) - ALLOCATE(XIBM_XMUT(0,0,0)) -END IF - -IF ( LRECYCL ) THEN - ALLOCATE(XFLUCTUNW(IJU,IKU)) ; XFLUCTUNW = 0.0 - ALLOCATE(XFLUCTVNN(IIU,IKU)) ; XFLUCTVNN = 0.0 - ALLOCATE(XFLUCTUTN(IIU,IKU)) ; XFLUCTUTN = 0.0 - ALLOCATE(XFLUCTVTW(IJU,IKU)) ; XFLUCTVTW = 0.0 - ALLOCATE(XFLUCTUNE(IJU,IKU)) ; XFLUCTUNE = 0.0 - ALLOCATE(XFLUCTVNS(IIU,IKU)) ; XFLUCTVNS = 0.0 - ALLOCATE(XFLUCTUTS(IIU,IKU)) ; XFLUCTUTS = 0.0 - ALLOCATE(XFLUCTVTE(IJU,IKU)) ; XFLUCTVTE = 0.0 - ALLOCATE(XFLUCTWTW(IJU,IKU)) ; XFLUCTWTW = 0.0 - ALLOCATE(XFLUCTWTN(IIU,IKU)) ; XFLUCTWTN = 0.0 - ALLOCATE(XFLUCTWTE(IJU,IKU)) ; XFLUCTWTE = 0.0 - ALLOCATE(XFLUCTWTS(IIU,IKU)) ; XFLUCTWTS = 0.0 -ELSE - ALLOCATE(XFLUCTUNW(0,0)) - ALLOCATE(XFLUCTVNN(0,0)) - ALLOCATE(XFLUCTUTN(0,0)) - ALLOCATE(XFLUCTVTW(0,0)) - ALLOCATE(XFLUCTUNE(0,0)) - ALLOCATE(XFLUCTVNS(0,0)) - ALLOCATE(XFLUCTUTS(0,0)) - ALLOCATE(XFLUCTVTE(0,0)) - ALLOCATE(XFLUCTWTW(0,0)) - ALLOCATE(XFLUCTWTN(0,0)) - ALLOCATE(XFLUCTWTE(0,0)) - ALLOCATE(XFLUCTWTS(0,0)) -END IF -! -IF (CTURB /= 'NONE') THEN - ALLOCATE(XTKET(IIU,IJU,IKU)) - ALLOCATE(XRTKES(IIU,IJU,IKU)) - ALLOCATE(XRTKEMS(IIU,IJU,IKU)); XRTKEMS = 0.0 - ALLOCATE(XWTHVMF(IIU,IJU,IKU)) - ALLOCATE(XDYP(IIU,IJU,IKU)) - ALLOCATE(XTHP(IIU,IJU,IKU)) - ALLOCATE(XTR(IIU,IJU,IKU)) - ALLOCATE(XDISS(IIU,IJU,IKU)) - ALLOCATE(XLEM(IIU,IJU,IKU)) - XTKEMIN=XKEMIN - XCED =XCEDIS -ELSE - ALLOCATE(XTKET(0,0,0)) - ALLOCATE(XRTKES(0,0,0)) - ALLOCATE(XRTKEMS(0,0,0)) - ALLOCATE(XWTHVMF(0,0,0)) - ALLOCATE(XDYP(0,0,0)) - ALLOCATE(XTHP(0,0,0)) - ALLOCATE(XTR(0,0,0)) - ALLOCATE(XDISS(0,0,0)) - ALLOCATE(XLEM(0,0,0)) -END IF -IF (CTOM == 'TM06') THEN - ALLOCATE(XBL_DEPTH(IIU,IJU)) -ELSE - ALLOCATE(XBL_DEPTH(0,0)) -END IF -IF (LRMC01) THEN - ALLOCATE(XSBL_DEPTH(IIU,IJU)) -ELSE - ALLOCATE(XSBL_DEPTH(0,0)) -END IF -! -ALLOCATE(XPABSM(IIU,IJU,IKU)) ; XPABSM = 0.0 -ALLOCATE(XPABST(IIU,IJU,IKU)) ; XPABST = 0.0 -! -ALLOCATE(XRT(IIU,IJU,IKU,NRR)) ; XRT = 0.0 -ALLOCATE(XRRS(IIU,IJU,IKU,NRR)) ; XRRS = 0.0 -ALLOCATE(XRRS_CLD(IIU,IJU,IKU,NRR)); XRRS_CLD = 0.0 -! -IF (CTURB /= 'NONE' .AND. NRR>1) THEN - ALLOCATE(XSRCT(IIU,IJU,IKU)) - ALLOCATE(XSIGS(IIU,IJU,IKU)) -ELSE - ALLOCATE(XSRCT(0,0,0)) - ALLOCATE(XSIGS(0,0,0)) -END IF -IF (CCLOUD == 'ICE3'.OR.CCLOUD == 'ICE4') THEN - ALLOCATE(XHLC_HRC(IIU,IJU,IKU)) - ALLOCATE(XHLC_HCF(IIU,IJU,IKU)) - ALLOCATE(XHLI_HRI(IIU,IJU,IKU)) - ALLOCATE(XHLI_HCF(IIU,IJU,IKU)) - XHLC_HRC(:,:,:)=0. - XHLC_HCF(:,:,:)=0. - XHLI_HRI(:,:,:)=0. - XHLI_HCF(:,:,:)=0. -ELSE - ALLOCATE(XHLC_HRC(0,0,0)) - ALLOCATE(XHLC_HCF(0,0,0)) - ALLOCATE(XHLI_HRI(0,0,0)) - ALLOCATE(XHLI_HCF(0,0,0)) -END IF -! -IF (NRR>1) THEN - ALLOCATE(XCLDFR(IIU,IJU,IKU)); XCLDFR (:, :, :) = 0. - ALLOCATE(XRAINFR(IIU,IJU,IKU)); XRAINFR(:, :, :) = 0. -ELSE - ALLOCATE(XCLDFR(0,0,0)) - ALLOCATE(XRAINFR(0,0,0)) -END IF -! -ALLOCATE(XSVT(IIU,IJU,IKU,NSV)) ; XSVT = 0. -ALLOCATE(XRSVS(IIU,IJU,IKU,NSV)); XRSVS = 0. -ALLOCATE(XRSVS_CLD(IIU,IJU,IKU,NSV)); XRSVS_CLD = 0.0 -ALLOCATE(XZWS(IIU,IJU)) ; XZWS(:,:) = XZWS_DEFAULT -! -IF (LPASPOL) THEN - ALLOCATE( XATC(IIU,IJU,IKU,NSV_PP) ) - XATC = 0. -ELSE - ALLOCATE( XATC(0,0,0,0)) -END IF -! -IF(LBLOWSNOW) THEN - ALLOCATE(XSNWCANO(IIU,IJU,NBLOWSNOW_2D)) - ALLOCATE(XRSNWCANOS(IIU,IJU,NBLOWSNOW_2D)) - XSNWCANO(:,:,:) = 0.0 - XRSNWCANOS(:,:,:) = 0.0 -ELSE - ALLOCATE(XSNWCANO(0,0,0)) - ALLOCATE(XRSNWCANOS(0,0,0)) -END IF -! -!* 3.2 Module MODD_GRID_n and MODD_METRICS_n -! -IF (LCARTESIAN) THEN - ALLOCATE(XLON(0,0)) - ALLOCATE(XLAT(0,0)) - ALLOCATE(XMAP(0,0)) -ELSE - ALLOCATE(XLON(IIU,IJU)) - ALLOCATE(XLAT(IIU,IJU)) - ALLOCATE(XMAP(IIU,IJU)) -END IF -ALLOCATE(XXHAT(IIU)) -ALLOCATE(XDXHAT(IIU)) -ALLOCATE(XYHAT(IJU)) -ALLOCATE(XDYHAT(IJU)) -ALLOCATE(XZS(IIU,IJU)) -ALLOCATE(XZSMT(IIU,IJU)) -ALLOCATE(XZZ(IIU,IJU,IKU)) -ALLOCATE(XZHAT(IKU)) -ALLOCATE(XDIRCOSZW(IIU,IJU)) -ALLOCATE(XDIRCOSXW(IIU,IJU)) -ALLOCATE(XDIRCOSYW(IIU,IJU)) -ALLOCATE(XCOSSLOPE(IIU,IJU)) -ALLOCATE(XSINSLOPE(IIU,IJU)) -! -ALLOCATE(XDXX(IIU,IJU,IKU)) -ALLOCATE(XDYY(IIU,IJU,IKU)) -ALLOCATE(XDZX(IIU,IJU,IKU)) -ALLOCATE(XDZY(IIU,IJU,IKU)) -ALLOCATE(XDZZ(IIU,IJU,IKU)) -! -!* 3.3 Modules MODD_REF and MODD_REF_n -! -! Different reference states for Ocean and Atmosphere models -! For the moment, same reference states for O and A -!IF ((KMI == 1).OR.LCOUPLES) THEN -IF (KMI==1) THEN - ALLOCATE(XRHODREFZ(IKU),XTHVREFZ(IKU)) -ELSE IF (LCOUPLES) THEN -! in coupled O-A case, need different variables for ocean - ALLOCATE(XRHODREFZO(IKU),XTHVREFZO(IKU)) -ELSE - !Do not allocate XRHODREFZ and XTHVREFZ because they are the same on all grids (not 'n' variables) -END IF -! -ALLOCATE(XPHIT(IIU,IJU,IKU)) -ALLOCATE(XRHODREF(IIU,IJU,IKU)) -ALLOCATE(XTHVREF(IIU,IJU,IKU)) -ALLOCATE(XEXNREF(IIU,IJU,IKU)) -ALLOCATE(XRHODJ(IIU,IJU,IKU)) -IF (CEQNSYS=='DUR' .AND. LUSERV) THEN - ALLOCATE(XRVREF(IIU,IJU,IKU)) -ELSE - ALLOCATE(XRVREF(0,0,0)) -END IF -! -!* 3.4 Module MODD_CURVCOR_n -! -IF (LTHINSHELL) THEN - ALLOCATE(XCORIOX(0,0)) - ALLOCATE(XCORIOY(0,0)) -ELSE - ALLOCATE(XCORIOX(IIU,IJU)) - ALLOCATE(XCORIOY(IIU,IJU)) -END IF - ALLOCATE(XCORIOZ(IIU,IJU)) -IF (LCARTESIAN) THEN - ALLOCATE(XCURVX(0,0)) - ALLOCATE(XCURVY(0,0)) -ELSE - ALLOCATE(XCURVX(IIU,IJU)) - ALLOCATE(XCURVY(IIU,IJU)) -END IF -! -!* 3.5 Module MODD_DYN_n -! -CALL GET_DIM_EXT_ll('Y',IIY,IJY) -IF (L2D) THEN - ALLOCATE(XBFY(IIY,IJY,IKU)) -ELSE - ALLOCATE(XBFY(IJY,IIY,IKU)) ! transposition needed by the optimisation of the - ! FFT solver -END IF -CALL GET_DIM_EXT_ll('B',IIU_B,IJU_B) -ALLOCATE(XBFB(IIU_B,IJU_B,IKU)) -CALL GET_DIM_EXTZ_ll('SXP2_YP1_Z',IIU_SXP2_YP1_Z_ll,IJU_SXP2_YP1_Z_ll,IKU_SXP2_YP1_Z_ll) -ALLOCATE(XBF_SXP2_YP1_Z(IIU_SXP2_YP1_Z_ll,IJU_SXP2_YP1_Z_ll,IKU_SXP2_YP1_Z_ll)) -ALLOCATE(XAF(IKU),XCF(IKU)) -ALLOCATE(XTRIGSX(3*IIU_ll)) -ALLOCATE(XTRIGSY(3*IJU_ll)) -ALLOCATE(XRHOM(IKU)) -ALLOCATE(XALK(IKU)) -ALLOCATE(XALKW(IKU)) -ALLOCATE(XALKBAS(IKU)) -ALLOCATE(XALKWBAS(IKU)) -! -IF ( LHORELAX_UVWTH .OR. LHORELAX_RV .OR. & - LHORELAX_RC .OR. LHORELAX_RR .OR. LHORELAX_RI .OR. LHORELAX_RS .OR. & - LHORELAX_RG .OR. LHORELAX_RH .OR. LHORELAX_TKE .OR. & - ANY(LHORELAX_SV) ) THEN - ALLOCATE(XKURELAX(IIU,IJU)) - ALLOCATE(XKVRELAX(IIU,IJU)) - ALLOCATE(XKWRELAX(IIU,IJU)) - ALLOCATE(LMASK_RELAX(IIU,IJU)) -ELSE - ALLOCATE(XKURELAX(0,0)) - ALLOCATE(XKVRELAX(0,0)) - ALLOCATE(XKWRELAX(0,0)) - ALLOCATE(LMASK_RELAX(0,0)) -END IF -! -! Additional fields for truly horizontal diffusion (Module MODD_DYNZD$n) -IF (LZDIFFU) THEN - CALL INIT_TYPE_ZDIFFU_HALO2(XZDIFFU_HALO2) -ELSE - CALL INIT_TYPE_ZDIFFU_HALO2(XZDIFFU_HALO2,0) -ENDIF -! -!* 3.6 Larger Scale variables (Module MODD_LSFIELD$n) -! -! -! upper relaxation part -! -ALLOCATE(XLSUM(IIU,IJU,IKU)) ; XLSUM = 0.0 -ALLOCATE(XLSVM(IIU,IJU,IKU)) ; XLSVM = 0.0 -ALLOCATE(XLSWM(IIU,IJU,IKU)) ; XLSWM = 0.0 -ALLOCATE(XLSTHM(IIU,IJU,IKU)) ; XLSTHM = 0.0 -IF ( NRR > 0 ) THEN - ALLOCATE(XLSRVM(IIU,IJU,IKU)) ; XLSRVM = 0.0 -ELSE - ALLOCATE(XLSRVM(0,0,0)) -END IF -ALLOCATE(XLSZWSM(IIU,IJU)) ; XLSZWSM = -1. -! -! lbc part -! -IF ( L1D) THEN ! 1D case -! - NSIZELBX_ll=0 - NSIZELBXU_ll=0 - NSIZELBY_ll=0 - NSIZELBYV_ll=0 - NSIZELBXTKE_ll=0 - NSIZELBXR_ll=0 - NSIZELBXSV_ll=0 - NSIZELBYTKE_ll=0 - NSIZELBYR_ll=0 - NSIZELBYSV_ll=0 - ALLOCATE(XLBXUM(0,0,0)) - ALLOCATE(XLBYUM(0,0,0)) - ALLOCATE(XLBXVM(0,0,0)) - ALLOCATE(XLBYVM(0,0,0)) - ALLOCATE(XLBXWM(0,0,0)) - ALLOCATE(XLBYWM(0,0,0)) - ALLOCATE(XLBXTHM(0,0,0)) - ALLOCATE(XLBYTHM(0,0,0)) - ALLOCATE(XLBXTKEM(0,0,0)) - ALLOCATE(XLBYTKEM(0,0,0)) - ALLOCATE(XLBXRM(0,0,0,0)) - ALLOCATE(XLBYRM(0,0,0,0)) - ALLOCATE(XLBXSVM(0,0,0,0)) - ALLOCATE(XLBYSVM(0,0,0,0)) -! -ELSEIF( L2D ) THEN ! 2D case -! - NSIZELBY_ll=0 - NSIZELBYV_ll=0 - NSIZELBYTKE_ll=0 - NSIZELBYR_ll=0 - NSIZELBYSV_ll=0 - ALLOCATE(XLBYUM(0,0,0)) - ALLOCATE(XLBYVM(0,0,0)) - ALLOCATE(XLBYWM(0,0,0)) - ALLOCATE(XLBYTHM(0,0,0)) - ALLOCATE(XLBYTKEM(0,0,0)) - ALLOCATE(XLBYRM(0,0,0,0)) - ALLOCATE(XLBYSVM(0,0,0,0)) -! - CALL GET_SIZEX_LB(NIMAX_ll,NJMAX_ll,NRIMX, & - IISIZEXF,IJSIZEXF,IISIZEXFU,IJSIZEXFU, & - IISIZEX4,IJSIZEX4,IISIZEX2,IJSIZEX2) -! - IF ( LHORELAX_UVWTH ) THEN - NSIZELBX_ll=2*NRIMX+2*JPHEXT - NSIZELBXU_ll=2*NRIMX+2*JPHEXT - ALLOCATE(XLBXUM(IISIZEXFU,IJSIZEXFU,IKU)) - ALLOCATE(XLBXVM(IISIZEXF,IJSIZEXF,IKU)) - ALLOCATE(XLBXWM(IISIZEXF,IJSIZEXF,IKU)) - ALLOCATE(XLBXTHM(IISIZEXF,IJSIZEXF,IKU)) - ELSE - NSIZELBX_ll=2*JPHEXT ! 2 - NSIZELBXU_ll=2*(JPHEXT+1) ! 4 - ALLOCATE(XLBXUM(IISIZEX4,IJSIZEX4,IKU)) - ALLOCATE(XLBXVM(IISIZEX2,IJSIZEX2,IKU)) - ALLOCATE(XLBXWM(IISIZEX2,IJSIZEX2,IKU)) - ALLOCATE(XLBXTHM(IISIZEX2,IJSIZEX2,IKU)) - END IF -! - IF (CTURB /= 'NONE') THEN - IF ( LHORELAX_TKE) THEN - NSIZELBXTKE_ll=2* NRIMX+2*JPHEXT - ALLOCATE(XLBXTKEM(IISIZEXF,IJSIZEXF,IKU)) - ELSE - NSIZELBXTKE_ll=2*JPHEXT ! 2 - ALLOCATE(XLBXTKEM(IISIZEX2,IJSIZEX2,IKU)) - END IF - ELSE - NSIZELBXTKE_ll=0 - ALLOCATE(XLBXTKEM(0,0,0)) - END IF - ! - IF ( NRR > 0 ) THEN - IF (LHORELAX_RV .OR. LHORELAX_RC .OR. LHORELAX_RR .OR. LHORELAX_RI & - .OR. LHORELAX_RS .OR. LHORELAX_RG .OR. LHORELAX_RH & - ) THEN - NSIZELBXR_ll=2* NRIMX+2*JPHEXT - ALLOCATE(XLBXRM(IISIZEXF,IJSIZEXF,IKU,NRR)) - ELSE - NSIZELBXR_ll=2*JPHEXT ! 2 - ALLOCATE(XLBXRM(IISIZEX2,IJSIZEX2,IKU,NRR)) - ENDIF - ELSE - NSIZELBXR_ll=0 - ALLOCATE(XLBXRM(0,0,0,0)) - END IF - ! - IF ( NSV > 0 ) THEN - IF ( ANY( LHORELAX_SV(:)) ) THEN - NSIZELBXSV_ll=2* NRIMX+2*JPHEXT - ALLOCATE(XLBXSVM(IISIZEXF,IJSIZEXF,IKU,NSV)) - ELSE - NSIZELBXSV_ll=2*JPHEXT ! 2 - ALLOCATE(XLBXSVM(IISIZEX2,IJSIZEX2,IKU,NSV)) - END IF - ELSE - NSIZELBXSV_ll=0 - ALLOCATE(XLBXSVM(0,0,0,0)) - END IF -! -ELSE ! 3D case -! -! - CALL GET_SIZEX_LB(NIMAX_ll,NJMAX_ll,NRIMX, & - IISIZEXF,IJSIZEXF,IISIZEXFU,IJSIZEXFU, & - IISIZEX4,IJSIZEX4,IISIZEX2,IJSIZEX2) - CALL GET_SIZEY_LB(NIMAX_ll,NJMAX_ll,NRIMY, & - IISIZEYF,IJSIZEYF,IISIZEYFV,IJSIZEYFV, & - IISIZEY4,IJSIZEY4,IISIZEY2,IJSIZEY2) -! -! check if local domain not to small for NRIMX NRIMY -! - IF ( CLBCX(1) /= 'CYCL' ) THEN - IF ( NRIMX .GT. IDIMX ) THEN - WRITE(*,'(A,I8,A/A,2I8,/A)') "Processor=", IP-1, & - " :: INI_MODEL_n ERROR: ( NRIMX > IDIMX ) ", & - " Local domain to small for relaxation NRIMX,IDIMX ", & - NRIMX,IDIMX ,& - " change relaxation parameters or number of processors " - call Print_msg(NVERB_FATAL,'GEN','INI_MODEL_n','') - END IF - END IF - IF ( CLBCY(1) /= 'CYCL' ) THEN - IF ( NRIMY .GT. IDIMY ) THEN - WRITE(*,'(A,I8,A/A,2I8,/A)') "Processor=", IP-1, & - " :: INI_MODEL_n ERROR: ( NRIMY > IDIMY ) ", & - " Local domain to small for relaxation NRIMY,IDIMY ", & - NRIMY,IDIMY ,& - " change relaxation parameters or number of processors " - call Print_msg(NVERB_FATAL,'GEN','INI_MODEL_n','') - END IF - END IF -IF ( LHORELAX_UVWTH ) THEN - NSIZELBX_ll=2*NRIMX+2*JPHEXT - NSIZELBXU_ll=2*NRIMX+2*JPHEXT - NSIZELBY_ll=2*NRIMY+2*JPHEXT - NSIZELBYV_ll=2*NRIMY+2*JPHEXT - ALLOCATE(XLBXUM(IISIZEXFU,IJSIZEXFU,IKU)) - ALLOCATE(XLBYUM(IISIZEYF,IJSIZEYF,IKU)) - ALLOCATE(XLBXVM(IISIZEXF,IJSIZEXF,IKU)) - ALLOCATE(XLBYVM(IISIZEYFV,IJSIZEYFV,IKU)) - ALLOCATE(XLBXWM(IISIZEXF,IJSIZEXF,IKU)) - ALLOCATE(XLBYWM(IISIZEYF,IJSIZEYF,IKU)) - ALLOCATE(XLBXTHM(IISIZEXF,IJSIZEXF,IKU)) - ALLOCATE(XLBYTHM(IISIZEYF,IJSIZEYF,IKU)) - ELSE - NSIZELBX_ll=2*JPHEXT ! 2 - NSIZELBXU_ll=2*(JPHEXT+1) ! 4 - NSIZELBY_ll=2*JPHEXT ! 2 - NSIZELBYV_ll=2*(JPHEXT+1) ! 4 - ALLOCATE(XLBXUM(IISIZEX4,IJSIZEX4,IKU)) - ALLOCATE(XLBYUM(IISIZEY2,IJSIZEY2,IKU)) - ALLOCATE(XLBXVM(IISIZEX2,IJSIZEX2,IKU)) - ALLOCATE(XLBYVM(IISIZEY4,IJSIZEY4,IKU)) - ALLOCATE(XLBXWM(IISIZEX2,IJSIZEX2,IKU)) - ALLOCATE(XLBYWM(IISIZEY2,IJSIZEY2,IKU)) - ALLOCATE(XLBXTHM(IISIZEX2,IJSIZEX2,IKU)) - ALLOCATE(XLBYTHM(IISIZEY2,IJSIZEY2,IKU)) - END IF - ! - IF (CTURB /= 'NONE') THEN - IF ( LHORELAX_TKE) THEN - NSIZELBXTKE_ll=2*NRIMX+2*JPHEXT - NSIZELBYTKE_ll=2*NRIMY+2*JPHEXT - ALLOCATE(XLBXTKEM(IISIZEXF,IJSIZEXF,IKU)) - ALLOCATE(XLBYTKEM(IISIZEYF,IJSIZEYF,IKU)) - ELSE - NSIZELBXTKE_ll=2*JPHEXT ! 2 - NSIZELBYTKE_ll=2*JPHEXT ! 2 - ALLOCATE(XLBXTKEM(IISIZEX2,IJSIZEX2,IKU)) - ALLOCATE(XLBYTKEM(IISIZEY2,IJSIZEY2,IKU)) - END IF - ELSE - NSIZELBXTKE_ll=0 - NSIZELBYTKE_ll=0 - ALLOCATE(XLBXTKEM(0,0,0)) - ALLOCATE(XLBYTKEM(0,0,0)) - END IF - ! - IF ( NRR > 0 ) THEN - IF (LHORELAX_RV .OR. LHORELAX_RC .OR. LHORELAX_RR .OR. LHORELAX_RI & - .OR. LHORELAX_RS .OR. LHORELAX_RG .OR. LHORELAX_RH & - ) THEN - NSIZELBXR_ll=2*NRIMX+2*JPHEXT - NSIZELBYR_ll=2*NRIMY+2*JPHEXT - ALLOCATE(XLBXRM(IISIZEXF,IJSIZEXF,IKU,NRR)) - ALLOCATE(XLBYRM(IISIZEYF,IJSIZEYF,IKU,NRR)) - ELSE - NSIZELBXR_ll=2*JPHEXT ! 2 - NSIZELBYR_ll=2*JPHEXT ! 2 - ALLOCATE(XLBXRM(IISIZEX2,IJSIZEX2,IKU,NRR)) - ALLOCATE(XLBYRM(IISIZEY2,IJSIZEY2,IKU,NRR)) - ENDIF - ELSE - NSIZELBXR_ll=0 - NSIZELBYR_ll=0 - ALLOCATE(XLBXRM(0,0,0,0)) - ALLOCATE(XLBYRM(0,0,0,0)) - END IF - ! - IF ( NSV > 0 ) THEN - IF ( ANY( LHORELAX_SV(:)) ) THEN - NSIZELBXSV_ll=2*NRIMX+2*JPHEXT - NSIZELBYSV_ll=2*NRIMY+2*JPHEXT - ALLOCATE(XLBXSVM(IISIZEXF,IJSIZEXF,IKU,NSV)) - ALLOCATE(XLBYSVM(IISIZEYF,IJSIZEYF,IKU,NSV)) - ELSE - NSIZELBXSV_ll=2*JPHEXT ! 2 - NSIZELBYSV_ll=2*JPHEXT ! 2 - ALLOCATE(XLBXSVM(IISIZEX2,IJSIZEX2,IKU,NSV)) - ALLOCATE(XLBYSVM(IISIZEY2,IJSIZEY2,IKU,NSV)) - END IF - ELSE - NSIZELBXSV_ll=0 - NSIZELBYSV_ll=0 - ALLOCATE(XLBXSVM(0,0,0,0)) - ALLOCATE(XLBYSVM(0,0,0,0)) - END IF -END IF ! END OF THE IF STRUCTURE ON THE MODEL DIMENSION -! -! -IF ( KMI > 1 ) THEN - ! it has been assumed that the THeta field used the largest rim area compared - ! to the others prognostic variables, if it is not the case, you must change - ! these lines - ALLOCATE(XCOEFLIN_LBXM(SIZE(XLBXTHM,1),SIZE(XLBXTHM,2),SIZE(XLBXTHM,3))) - ALLOCATE( NKLIN_LBXM(SIZE(XLBXTHM,1),SIZE(XLBXTHM,2),SIZE(XLBXTHM,3))) - ALLOCATE(XCOEFLIN_LBYM(SIZE(XLBYTHM,1),SIZE(XLBYTHM,2),SIZE(XLBYTHM,3))) - ALLOCATE( NKLIN_LBYM(SIZE(XLBYTHM,1),SIZE(XLBYTHM,2),SIZE(XLBYTHM,3))) - ALLOCATE(XCOEFLIN_LBXU(SIZE(XLBXUM,1),SIZE(XLBXUM,2),SIZE(XLBXUM,3))) - ALLOCATE( NKLIN_LBXU(SIZE(XLBXUM,1),SIZE(XLBXUM,2),SIZE(XLBXUM,3))) - ALLOCATE(XCOEFLIN_LBYU(SIZE(XLBYUM,1),SIZE(XLBYUM,2),SIZE(XLBYUM,3))) - ALLOCATE( NKLIN_LBYU(SIZE(XLBYUM,1),SIZE(XLBYUM,2),SIZE(XLBYUM,3))) - ALLOCATE(XCOEFLIN_LBXV(SIZE(XLBXVM,1),SIZE(XLBXVM,2),SIZE(XLBXVM,3))) - ALLOCATE( NKLIN_LBXV(SIZE(XLBXVM,1),SIZE(XLBXVM,2),SIZE(XLBXVM,3))) - ALLOCATE(XCOEFLIN_LBYV(SIZE(XLBYVM,1),SIZE(XLBYVM,2),SIZE(XLBYVM,3))) - ALLOCATE( NKLIN_LBYV(SIZE(XLBYVM,1),SIZE(XLBYVM,2),SIZE(XLBYVM,3))) - ALLOCATE(XCOEFLIN_LBXW(SIZE(XLBXWM,1),SIZE(XLBXWM,2),SIZE(XLBXWM,3))) - ALLOCATE( NKLIN_LBXW(SIZE(XLBXWM,1),SIZE(XLBXWM,2),SIZE(XLBXWM,3))) - ALLOCATE(XCOEFLIN_LBYW(SIZE(XLBYWM,1),SIZE(XLBYWM,2),SIZE(XLBYWM,3))) - ALLOCATE( NKLIN_LBYW(SIZE(XLBYWM,1),SIZE(XLBYWM,2),SIZE(XLBYWM,3))) -ELSE - ALLOCATE(XCOEFLIN_LBXM(0,0,0)) - ALLOCATE( NKLIN_LBXM(0,0,0)) - ALLOCATE(XCOEFLIN_LBYM(0,0,0)) - ALLOCATE( NKLIN_LBYM(0,0,0)) - ALLOCATE(XCOEFLIN_LBXU(0,0,0)) - ALLOCATE( NKLIN_LBXU(0,0,0)) - ALLOCATE(XCOEFLIN_LBYU(0,0,0)) - ALLOCATE( NKLIN_LBYU(0,0,0)) - ALLOCATE(XCOEFLIN_LBXV(0,0,0)) - ALLOCATE( NKLIN_LBXV(0,0,0)) - ALLOCATE(XCOEFLIN_LBYV(0,0,0)) - ALLOCATE( NKLIN_LBYV(0,0,0)) - ALLOCATE(XCOEFLIN_LBXW(0,0,0)) - ALLOCATE( NKLIN_LBXW(0,0,0)) - ALLOCATE(XCOEFLIN_LBYW(0,0,0)) - ALLOCATE( NKLIN_LBYW(0,0,0)) -END IF -! -! allocation of the LS fields for vertical relaxation and numerical diffusion -IF( .NOT. LSTEADYLS ) THEN -! - ALLOCATE(XLSUS(SIZE(XLSUM,1),SIZE(XLSUM,2),SIZE(XLSUM,3))) - ALLOCATE(XLSVS(SIZE(XLSVM,1),SIZE(XLSVM,2),SIZE(XLSVM,3))) - ALLOCATE(XLSWS(SIZE(XLSWM,1),SIZE(XLSWM,2),SIZE(XLSWM,3))) - ALLOCATE(XLSTHS(SIZE(XLSTHM,1),SIZE(XLSTHM,2),SIZE(XLSTHM,3))) - ALLOCATE(XLSRVS(SIZE(XLSRVM,1),SIZE(XLSRVM,2),SIZE(XLSRVM,3))) - ALLOCATE(XLSZWSS(SIZE(XLSZWSM,1),SIZE(XLSZWSM,2))) -! -ELSE -! - ALLOCATE(XLSUS(0,0,0)) - ALLOCATE(XLSVS(0,0,0)) - ALLOCATE(XLSWS(0,0,0)) - ALLOCATE(XLSTHS(0,0,0)) - ALLOCATE(XLSRVS(0,0,0)) - ALLOCATE(XLSZWSS(0,0)) -! -END IF -! allocation of the LB fields for horizontal relaxation and Lateral Boundaries -IF( .NOT. ( LSTEADYLS .AND. KMI==1 ) ) THEN -! - ALLOCATE(XLBXTKES(SIZE(XLBXTKEM,1),SIZE(XLBXTKEM,2),SIZE(XLBXTKEM,3))) - ALLOCATE(XLBYTKES(SIZE(XLBYTKEM,1),SIZE(XLBYTKEM,2),SIZE(XLBYTKEM,3))) - ALLOCATE(XLBXUS(SIZE(XLBXUM,1),SIZE(XLBXUM,2),SIZE(XLBXUM,3))) - ALLOCATE(XLBYUS(SIZE(XLBYUM,1),SIZE(XLBYUM,2),SIZE(XLBYUM,3))) - ALLOCATE(XLBXVS(SIZE(XLBXVM,1),SIZE(XLBXVM,2),SIZE(XLBXVM,3))) - ALLOCATE(XLBYVS(SIZE(XLBYVM,1),SIZE(XLBYVM,2),SIZE(XLBYVM,3))) - ALLOCATE(XLBXWS(SIZE(XLBXWM,1),SIZE(XLBXWM,2),SIZE(XLBXWM,3))) - ALLOCATE(XLBYWS(SIZE(XLBYWM,1),SIZE(XLBYWM,2),SIZE(XLBYWM,3))) - ALLOCATE(XLBXTHS(SIZE(XLBXTHM,1),SIZE(XLBXTHM,2),SIZE(XLBXTHM,3))) - ALLOCATE(XLBYTHS(SIZE(XLBYTHM,1),SIZE(XLBYTHM,2),SIZE(XLBYTHM,3))) - ALLOCATE(XLBXRS(SIZE(XLBXRM,1),SIZE(XLBXRM,2),SIZE(XLBXRM,3),SIZE(XLBXRM,4))) - ALLOCATE(XLBYRS(SIZE(XLBYRM,1),SIZE(XLBYRM,2),SIZE(XLBYRM,3),SIZE(XLBYRM,4))) - ALLOCATE(XLBXSVS(SIZE(XLBXSVM,1),SIZE(XLBXSVM,2),SIZE(XLBXSVM,3),SIZE(XLBXSVM,4))) - ALLOCATE(XLBYSVS(SIZE(XLBYSVM,1),SIZE(XLBYSVM,2),SIZE(XLBYSVM,3),SIZE(XLBYSVM,4))) -! -ELSE -! - ALLOCATE(XLBXTKES(0,0,0)) - ALLOCATE(XLBYTKES(0,0,0)) - ALLOCATE(XLBXUS(0,0,0)) - ALLOCATE(XLBYUS(0,0,0)) - ALLOCATE(XLBXVS(0,0,0)) - ALLOCATE(XLBYVS(0,0,0)) - ALLOCATE(XLBXWS(0,0,0)) - ALLOCATE(XLBYWS(0,0,0)) - ALLOCATE(XLBXTHS(0,0,0)) - ALLOCATE(XLBYTHS(0,0,0)) - ALLOCATE(XLBXRS(0,0,0,0)) - ALLOCATE(XLBYRS(0,0,0,0)) - ALLOCATE(XLBXSVS(0,0,0,0)) - ALLOCATE(XLBYSVS(0,0,0,0)) -! -END IF -! -! -!* 3.7 Module MODD_RADIATIONS_n (except XOZON and XAER) -! -! Initialization of SW bands -NSWB_OLD = 6 ! Number of bands in ECMWF original scheme (from Fouquart et Bonnel (1980)) - ! then modified through INI_RADIATIONS_ECMWF but remains equal to 6 practically - -#ifdef MNH_ECRAD -#if ( VER_ECRAD == 140 ) -NLWB_OLD = 16 ! For XEMIS initialization (should be spectral in the future) -#endif -#endif - -NLWB_MNH = 16 ! For XEMIS initialization (should be spectral in the future) - -IF (CRAD == 'ECRA') THEN - NSWB_MNH = 14 -#ifdef MNH_ECRAD -#if ( VER_ECRAD == 140 ) - NLWB_MNH = 16 -#endif -#endif -ELSE - NSWB_MNH = NSWB_OLD -#ifdef MNH_ECRAD -#if ( VER_ECRAD == 140 ) - NLWB_MNH = NLWB_OLD -#endif -#endif -END IF - -ALLOCATE(XSW_BANDS (NSWB_MNH)) -ALLOCATE(XLW_BANDS (NLWB_MNH)) -ALLOCATE(XZENITH (IIU,IJU)) -ALLOCATE(XAZIM (IIU,IJU)) -ALLOCATE(XALBUV (IIU,IJU)) -XALBUV(:,:) = NALBUV_DEFAULT !Set to an arbitrary low value (XALBUV is needed in CH_INTERP_JVALUES even if no radiation) -ALLOCATE(XDIRSRFSWD(IIU,IJU,NSWB_MNH)) -ALLOCATE(XSCAFLASWD(IIU,IJU,NSWB_MNH)) -ALLOCATE(XFLALWD (IIU,IJU)) -! -IF (CRAD /= 'NONE') THEN - ALLOCATE(XSLOPANG(IIU,IJU)) - ALLOCATE(XSLOPAZI(IIU,IJU)) - ALLOCATE(XDTHRAD(IIU,IJU,IKU)) - ALLOCATE(XDIRFLASWD(IIU,IJU,NSWB_MNH)) - ALLOCATE(XDIR_ALB(IIU,IJU,NSWB_MNH)) - ALLOCATE(XSCA_ALB(IIU,IJU,NSWB_MNH)) - ALLOCATE(XEMIS (IIU,IJU,NLWB_MNH)) - ALLOCATE(XTSRAD (IIU,IJU)) ; XTSRAD = 0.0 - ALLOCATE(XSEA (IIU,IJU)) - ALLOCATE(XZS_XY (IIU,IJU)) - ALLOCATE(NCLEARCOL_TM1(IIU,IJU)) - ALLOCATE(XSWU(IIU,IJU,IKU)) - ALLOCATE(XSWD(IIU,IJU,IKU)) - ALLOCATE(XLWU(IIU,IJU,IKU)) - ALLOCATE(XLWD(IIU,IJU,IKU)) - ALLOCATE(XDTHRADSW(IIU,IJU,IKU)) - ALLOCATE(XDTHRADLW(IIU,IJU,IKU)) - ALLOCATE(XRADEFF(IIU,IJU,IKU)) -ELSE - ALLOCATE(XSLOPANG(0,0)) - ALLOCATE(XSLOPAZI(0,0)) - ALLOCATE(XDTHRAD(0,0,0)) - ALLOCATE(XDIRFLASWD(0,0,0)) - ALLOCATE(XDIR_ALB(0,0,0)) - ALLOCATE(XSCA_ALB(0,0,0)) - ALLOCATE(XEMIS (0,0,0)) - ALLOCATE(XTSRAD (0,0)) - ALLOCATE(XSEA (0,0)) - ALLOCATE(XZS_XY (0,0)) - ALLOCATE(NCLEARCOL_TM1(0,0)) - ALLOCATE(XSWU(0,0,0)) - ALLOCATE(XSWD(0,0,0)) - ALLOCATE(XLWU(0,0,0)) - ALLOCATE(XLWD(0,0,0)) - ALLOCATE(XDTHRADSW(0,0,0)) - ALLOCATE(XDTHRADLW(0,0,0)) - ALLOCATE(XRADEFF(0,0,0)) -END IF - -IF (CRAD == 'ECMW' .OR. CRAD == 'ECRA') THEN - ALLOCATE(XSTROATM(31,6)) - ALLOCATE(XSMLSATM(31,6)) - ALLOCATE(XSMLWATM(31,6)) - ALLOCATE(XSPOSATM(31,6)) - ALLOCATE(XSPOWATM(31,6)) - ALLOCATE(XSTATM(31,6)) -ELSE - ALLOCATE(XSTROATM(0,0)) - ALLOCATE(XSMLSATM(0,0)) - ALLOCATE(XSMLWATM(0,0)) - ALLOCATE(XSPOSATM(0,0)) - ALLOCATE(XSPOWATM(0,0)) - ALLOCATE(XSTATM(0,0)) -END IF -! -!* 3.8 Module MODD_DEEP_CONVECTION_n -! -IF (CDCONV /= 'NONE' .OR. CSCONV == 'KAFR') THEN - ALLOCATE(NCOUNTCONV(IIU,IJU)) - ALLOCATE(XDTHCONV(IIU,IJU,IKU)) - ALLOCATE(XDRVCONV(IIU,IJU,IKU)) - ALLOCATE(XDRCCONV(IIU,IJU,IKU)) - ALLOCATE(XDRICONV(IIU,IJU,IKU)) - ALLOCATE(XPRCONV(IIU,IJU)) - ALLOCATE(XPACCONV(IIU,IJU)) - ALLOCATE(XPRSCONV(IIU,IJU)) - ! diagnostics - IF (LCH_CONV_LINOX) THEN - ALLOCATE(XIC_RATE(IIU,IJU)) - ALLOCATE(XCG_RATE(IIU,IJU)) - ALLOCATE(XIC_TOTAL_NUMBER(IIU,IJU)) - ALLOCATE(XCG_TOTAL_NUMBER(IIU,IJU)) - ELSE - ALLOCATE(XIC_RATE(0,0)) - ALLOCATE(XCG_RATE(0,0)) - ALLOCATE(XIC_TOTAL_NUMBER(0,0)) - ALLOCATE(XCG_TOTAL_NUMBER(0,0)) - END IF - IF ( LDIAGCONV ) THEN - ALLOCATE(XUMFCONV(IIU,IJU,IKU)) - ALLOCATE(XDMFCONV(IIU,IJU,IKU)) - ALLOCATE(XPRLFLXCONV(IIU,IJU,IKU)) - ALLOCATE(XPRSFLXCONV(IIU,IJU,IKU)) - ALLOCATE(XCAPE(IIU,IJU)) - ALLOCATE(NCLTOPCONV(IIU,IJU)) - ALLOCATE(NCLBASCONV(IIU,IJU)) - ELSE - ALLOCATE(XUMFCONV(0,0,0)) - ALLOCATE(XDMFCONV(0,0,0)) - ALLOCATE(XPRLFLXCONV(0,0,0)) - ALLOCATE(XPRSFLXCONV(0,0,0)) - ALLOCATE(XCAPE(0,0)) - ALLOCATE(NCLTOPCONV(0,0)) - ALLOCATE(NCLBASCONV(0,0)) - END IF -ELSE - ALLOCATE(NCOUNTCONV(0,0)) - ALLOCATE(XDTHCONV(0,0,0)) - ALLOCATE(XDRVCONV(0,0,0)) - ALLOCATE(XDRCCONV(0,0,0)) - ALLOCATE(XDRICONV(0,0,0)) - ALLOCATE(XPRCONV(0,0)) - ALLOCATE(XPACCONV(0,0)) - ALLOCATE(XPRSCONV(0,0)) - ALLOCATE(XIC_RATE(0,0)) - ALLOCATE(XCG_RATE(0,0)) - ALLOCATE(XIC_TOTAL_NUMBER(0,0)) - ALLOCATE(XCG_TOTAL_NUMBER(0,0)) - ALLOCATE(XUMFCONV(0,0,0)) - ALLOCATE(XDMFCONV(0,0,0)) - ALLOCATE(XPRLFLXCONV(0,0,0)) - ALLOCATE(XPRSFLXCONV(0,0,0)) - ALLOCATE(XCAPE(0,0)) - ALLOCATE(NCLTOPCONV(0,0)) - ALLOCATE(NCLBASCONV(0,0)) -END IF -! -IF ((CDCONV == 'KAFR' .OR. CSCONV == 'KAFR') & - .AND. LSUBG_COND .AND. LSIG_CONV) THEN - ALLOCATE(XMFCONV(IIU,IJU,IKU)) -ELSE - ALLOCATE(XMFCONV(0,0,0)) -ENDIF -! -IF ((CDCONV == 'KAFR' .OR. CSCONV == 'KAFR') & - .AND. LCHTRANS .AND. NSV > 0 ) THEN - ALLOCATE(XDSVCONV(IIU,IJU,IKU,NSV)) -ELSE - ALLOCATE(XDSVCONV(0,0,0,0)) -END IF -! -ALLOCATE(XCF_MF(IIU,IJU,IKU)) ; XCF_MF=0.0 -ALLOCATE(XRC_MF(IIU,IJU,IKU)) ; XRC_MF=0.0 -ALLOCATE(XRI_MF(IIU,IJU,IKU)) ; XRI_MF=0.0 -! -!* 3.9 Local variables -! -ALLOCATE(ZJ(IIU,IJU,IKU)) -! -!* 3.10 Forcing variables (Module MODD_FRC and MODD_FRCn) -! -IF ( LFORCING ) THEN - ALLOCATE(XWTFRC(IIU,IJU,IKU)) ; XWTFRC = XUNDEF - ALLOCATE(XUFRC_PAST(IIU,IJU,IKU)) ; XUFRC_PAST = XUNDEF - ALLOCATE(XVFRC_PAST(IIU,IJU,IKU)) ; XVFRC_PAST = XUNDEF -ELSE - ALLOCATE(XWTFRC(0,0,0)) - ALLOCATE(XUFRC_PAST(0,0,0)) - ALLOCATE(XVFRC_PAST(0,0,0)) -END IF -! -IF (KMI == 1) THEN - IF ( LFORCING ) THEN - ALLOCATE(TDTFRC(NFRC)) - ALLOCATE(XUFRC(IKU,NFRC)) - ALLOCATE(XVFRC(IKU,NFRC)) - ALLOCATE(XWFRC(IKU,NFRC)) - ALLOCATE(XTHFRC(IKU,NFRC)) - ALLOCATE(XRVFRC(IKU,NFRC)) - ALLOCATE(XTENDTHFRC(IKU,NFRC)) - ALLOCATE(XTENDRVFRC(IKU,NFRC)) - ALLOCATE(XGXTHFRC(IKU,NFRC)) - ALLOCATE(XGYTHFRC(IKU,NFRC)) - ALLOCATE(XPGROUNDFRC(NFRC)) - ALLOCATE(XTENDUFRC(IKU,NFRC)) - ALLOCATE(XTENDVFRC(IKU,NFRC)) - ELSE - ALLOCATE(TDTFRC(0)) - ALLOCATE(XUFRC(0,0)) - ALLOCATE(XVFRC(0,0)) - ALLOCATE(XWFRC(0,0)) - ALLOCATE(XTHFRC(0,0)) - ALLOCATE(XRVFRC(0,0)) - ALLOCATE(XTENDTHFRC(0,0)) - ALLOCATE(XTENDRVFRC(0,0)) - ALLOCATE(XGXTHFRC(0,0)) - ALLOCATE(XGYTHFRC(0,0)) - ALLOCATE(XPGROUNDFRC(0)) - ALLOCATE(XTENDUFRC(0,0)) - ALLOCATE(XTENDVFRC(0,0)) - END IF -ELSE - !Do not allocate because they are the same on all grids (not 'n' variables) -END IF -! ---------------------------------------------------------------------- -! -IF (L2D_ADV_FRC) THEN - WRITE(ILUOUT,*) 'L2D_ADV_FRC IS SET TO', L2D_ADV_FRC - WRITE(ILUOUT,*) 'ADV FRC WILL BE SET' - ALLOCATE(TDTADVFRC(NADVFRC)) - ALLOCATE(XDTHFRC(IIU,IJU,IKU,NADVFRC)) ; XDTHFRC=0. - ALLOCATE(XDRVFRC(IIU,IJU,IKU,NADVFRC)) ; XDRVFRC=0. -ELSE - ALLOCATE(TDTADVFRC(0)) - ALLOCATE(XDTHFRC(0,0,0,0)) - ALLOCATE(XDRVFRC(0,0,0,0)) -ENDIF - -IF (L2D_REL_FRC) THEN - WRITE(ILUOUT,*) 'L2D_REL_FRC IS SET TO', L2D_REL_FRC - WRITE(ILUOUT,*) 'REL FRC WILL BE SET' - ALLOCATE(TDTRELFRC(NRELFRC)) - ALLOCATE(XTHREL(IIU,IJU,IKU,NRELFRC)) ; XTHREL=0. - ALLOCATE(XRVREL(IIU,IJU,IKU,NRELFRC)) ; XRVREL=0. -ELSE - ALLOCATE(TDTRELFRC(0)) - ALLOCATE(XTHREL(0,0,0,0)) - ALLOCATE(XRVREL(0,0,0,0)) -ENDIF -! -!* 4.11 BIS: Eddy fluxes allocation -! -IF ( LTH_FLX ) THEN - ALLOCATE(XVTH_FLUX_M(IIU,IJU,IKU)) ; XVTH_FLUX_M = 0. - ALLOCATE(XWTH_FLUX_M(IIU,IJU,IKU)) ; XWTH_FLUX_M = 0. - IF (KMI /= 1) THEN - ALLOCATE(XRTHS_EDDY_FLUX(IIU,IJU,IKU)) - XRTHS_EDDY_FLUX = 0. - ELSE - ALLOCATE(XRTHS_EDDY_FLUX(0,0,0)) - ENDIF -ELSE - ALLOCATE(XVTH_FLUX_M(0,0,0)) - ALLOCATE(XWTH_FLUX_M(0,0,0)) - ALLOCATE(XRTHS_EDDY_FLUX(0,0,0)) -END IF -! -IF ( LUV_FLX) THEN - ALLOCATE(XVU_FLUX_M(IIU,IJU,IKU)) ; XVU_FLUX_M = 0. - IF (KMI /= 1) THEN - ALLOCATE(XRVS_EDDY_FLUX(IIU,IJU,IKU)) - XRVS_EDDY_FLUX = 0. - ELSE - ALLOCATE(XRVS_EDDY_FLUX(0,0,0)) - ENDIF -ELSE - ALLOCATE(XVU_FLUX_M(0,0,0)) - ALLOCATE(XRVS_EDDY_FLUX(0,0,0)) -END IF -! -!* 3.11 Module MODD_ICE_CONC_n -! -IF ( (CCLOUD == 'ICE3'.OR.CCLOUD == 'ICE4') .AND. & - (CPROGRAM == 'DIAG '.OR.CPROGRAM == 'MESONH')) THEN - ALLOCATE(XCIT(IIU,IJU,IKU)) -ELSE - ALLOCATE(XCIT(0,0,0)) -END IF -! -IF ( CCLOUD == 'KHKO' .OR. CCLOUD == 'C2R2') THEN - ALLOCATE(XSUPSAT(IIU,IJU,IKU)) - ALLOCATE(XNACT(IIU,IJU,IKU)) - ALLOCATE(XNPRO(IIU,IJU,IKU)) - ALLOCATE(XSSPRO(IIU,IJU,IKU)) -ELSE - ALLOCATE(XSUPSAT(0,0,0)) - ALLOCATE(XNACT(0,0,0)) - ALLOCATE(XNPRO(0,0,0)) - ALLOCATE(XSSPRO(0,0,0)) -END IF -! -!* 3.12 Module MODD_TURB_CLOUD -! -IF (.NOT.(ALLOCATED(XCEI))) ALLOCATE(XCEI(0,0,0)) -IF (KMI == NMODEL_CLOUD .AND. CTURBLEN_CLOUD/='NONE' ) THEN - DEALLOCATE(XCEI) - ALLOCATE(XCEI(IIU,IJU,IKU)) -ENDIF -! -!* 3.13 Module MODD_CH_PH_n -! -IF (LUSECHAQ.AND.(CPROGRAM == 'DIAG '.OR.CPROGRAM == 'MESONH')) THEN - IF (LCH_PH) THEN - ALLOCATE(XPHC(IIU,IJU,IKU)) - IF (NRRL==2) THEN - ALLOCATE(XPHR(IIU,IJU,IKU)) - ALLOCATE(XACPHR(IIU,IJU)) - XACPHR(:,:) = 0. - ENDIF - ENDIF - IF (NRRL==2) THEN - ALLOCATE(XACPRAQ(IIU,IJU,NSV_CHAC/2)) - XACPRAQ(:,:,:) = 0. - ENDIF -ENDIF -IF (.NOT.(ASSOCIATED(XPHC))) ALLOCATE(XPHC(0,0,0)) -IF (.NOT.(ASSOCIATED(XPHR))) ALLOCATE(XPHR(0,0,0)) -IF (.NOT.(ASSOCIATED(XACPHR))) ALLOCATE(XACPHR(0,0)) -IF (.NOT.(ASSOCIATED(XACPRAQ))) ALLOCATE(XACPRAQ(0,0,0)) -IF ((LUSECHEM).AND.(CPROGRAM == 'DIAG ')) THEN - ALLOCATE(XCHFLX(IIU,IJU,NSV_CHEM)) - XCHFLX(:,:,:) = 0. -ELSE - ALLOCATE(XCHFLX(0,0,0)) -END IF -! -!* 3.14 Module MODD_DRAG -! -IF (LDRAG) THEN - ALLOCATE(XDRAG(IIU,IJU)) -ELSE - ALLOCATE(XDRAG(0,0)) -ENDIF -! -!------------------------------------------------------------------------------- -! -!* 4. INITIALIZE BUDGET VARIABLES -! --------------------------- -! -gles = lles_mean .or. lles_resolved .or. lles_subgrid .or. lles_updraft & - .or. lles_downdraft .or. lles_spectra -!Called if budgets are enabled via NAM_BUDGET -!or if LES budgets are enabled via NAM_LES (condition on kmi==1 to call it max once) -if ( ( cbutype /= "NONE" .and. nbumod == kmi ) .or. ( gles .and. kmi == 1 ) ) THEN - call Budget_preallocate() -end if - -IF ( CBUTYPE /= "NONE" .AND. NBUMOD == KMI ) THEN - CALL Ini_budget(ILUOUT,XTSTEP,NSV,NRR, & - LNUMDIFU,LNUMDIFTH,LNUMDIFSV, & - LHORELAX_UVWTH,LHORELAX_RV, LHORELAX_RC,LHORELAX_RR, & - LHORELAX_RI,LHORELAX_RS,LHORELAX_RG, LHORELAX_RH,LHORELAX_TKE, & - LHORELAX_SV, LVE_RELAX, LVE_RELAX_GRD, & - LCHTRANS,LNUDGING,LDRAGTREE,LDEPOTREE,LMAIN_EOL, & - CRAD,CDCONV,CSCONV,CTURB,CTURBDIM,CCLOUD ) -END IF -! -!------------------------------------------------------------------------------- -! -! -!* 5. INITIALIZE INTERPOLATION COEFFICIENTS -! -CALL INI_BIKHARDT_n (NDXRATIO_ALL(KMI),NDYRATIO_ALL(KMI),KMI) -! -!------------------------------------------------------------------------------- -! -!* 6. BUILT THE GENERIC OUTPUT NAME -! ---------------------------- -! -IF (KMI == 1) THEN - DO IMI = 1 , NMODEL - WRITE(IO_SURF_MNH_MODEL(IMI)%COUTFILE,'(A,".",I1,".",A)') CEXP,IMI,TRIM(ADJUSTL(CSEG)) - WRITE(YNAME, '(A,".",I1,".",A)') CEXP,IMI,TRIM(ADJUSTL(CSEG))//'.000' - CALL IO_File_add2list(LUNIT_MODEL(IMI)%TDIAFILE,YNAME,'MNHDIACHRONIC','WRITE', & - HDIRNAME=CIO_DIR, & - KLFINPRAR=INT(50,KIND=LFIINT),KLFITYPE=1,KLFIVERB=NVERB, & - TPDADFILE=LUNIT_MODEL(NDAD(IMI))%TDIAFILE ) - END DO - ! - TDIAFILE => LUNIT_MODEL(KMI)%TDIAFILE !Necessary because no call to GOTO_MODEL before needing it - ! - IF (CPROGRAM=='MESONH') THEN - IF ( NDAD(KMI) == 1) CDAD_NAME(KMI) = CEXP//'.1.'//CSEG - IF ( NDAD(KMI) == 2) CDAD_NAME(KMI) = CEXP//'.2.'//CSEG - IF ( NDAD(KMI) == 3) CDAD_NAME(KMI) = CEXP//'.3.'//CSEG - IF ( NDAD(KMI) == 4) CDAD_NAME(KMI) = CEXP//'.4.'//CSEG - IF ( NDAD(KMI) == 5) CDAD_NAME(KMI) = CEXP//'.5.'//CSEG - IF ( NDAD(KMI) == 6) CDAD_NAME(KMI) = CEXP//'.6.'//CSEG - IF ( NDAD(KMI) == 7) CDAD_NAME(KMI) = CEXP//'.7.'//CSEG - IF ( NDAD(KMI) == 8) CDAD_NAME(KMI) = CEXP//'.8.'//CSEG - END IF -END IF -! -!------------------------------------------------------------------------------- -! -!* 7. INITIALIZE GRIDS AND METRIC COEFFICIENTS -! ---------------------------------------- -! -CALL SET_GRID(KMI,TPINIFILE,IKU,NIMAX_ll,NJMAX_ll, & - XTSTEP,XSEGLEN, & - XLONORI,XLATORI,XLON,XLAT, & - XXHAT,XYHAT,XDXHAT,XDYHAT, XMAP, & - XZS,XZZ,XZHAT,XZTOP,LSLEVE,XLEN1,XLEN2,XZSMT, & - ZJ, & - TDTMOD,TDTCUR,NSTOP,NBAK_NUMB,NOUT_NUMB,TBACKUPN,TOUTPUTN) -! -CALL METRICS(XMAP,XDXHAT,XDYHAT,XZZ,XDXX,XDYY,XDZX,XDZY,XDZZ) -! -!* update halos of metric coefficients -! -! -CALL UPDATE_METRICS(CLBCX,CLBCY,XDXX,XDYY,XDZX,XDZY,XDZZ) -! -! -CALL SET_DIRCOS(CLBCX,CLBCY,XDXX,XDYY,XDZX,XDZY,TZINITHALO2D_ll, & - XDIRCOSXW,XDIRCOSYW,XDIRCOSZW,XCOSSLOPE,XSINSLOPE ) -! -! grid nesting initializations -IF ( KMI == 1 ) THEN - XTSTEP_MODEL1=XTSTEP -END IF -! -NDT_2_WAY(KMI)=4 -! -!------------------------------------------------------------------------------- -! -!* 8. INITIALIZE DATA FOR JVALUES AND AEROSOLS -! -IF ( LUSECHEM .OR. LCHEMDIAG ) THEN - IF ((KMI==1).AND.(CPROGRAM == "MESONH".OR.CPROGRAM == "DIAG ")) & - CALL CH_INIT_JVALUES(TDTCUR%nday, TDTCUR%nmonth, & - TDTCUR%nyear, ILUOUT, XCH_TUV_DOBNEW) -! - IF (LORILAM) THEN - CALL CH_AER_MOD_INIT - ENDIF -END IF -IF (.NOT.(ASSOCIATED(XMI))) ALLOCATE(XMI(0,0,0,0)) -IF (.NOT.(ASSOCIATED(XSOLORG))) ALLOCATE(XSOLORG(0,0,0,0)) -! -IF (CCLOUD=='LIMA') CALL INIT_AEROSOL_PROPERTIES -! -!------------------------------------------------------------------------------- -! -!* 9. INITIALIZE THE PROGNOSTIC FIELDS -! -------------------------------- -! -CALL MPPDB_CHECK3D(XUT,"INI_MODEL_N-before read_field::XUT",PRECISION) -CALL READ_FIELD(KMI,TPINIFILE,IIU,IJU,IKU, & - CGETTKET,CGETRVT,CGETRCT,CGETRRT,CGETRIT,CGETCIT,CGETZWS, & - CGETRST,CGETRGT,CGETRHT,CGETSVT,CGETSRCT,CGETSIGS,CGETCLDFR, & - CGETBL_DEPTH,CGETSBL_DEPTH,CGETPHC,CGETPHR, & - CUVW_ADV_SCHEME, CTEMP_SCHEME, & - NSIZELBX_ll, NSIZELBXU_ll, NSIZELBY_ll, NSIZELBYV_ll, & - NSIZELBXTKE_ll,NSIZELBYTKE_ll, & - NSIZELBXR_ll,NSIZELBYR_ll,NSIZELBXSV_ll,NSIZELBYSV_ll, & - XUM,XVM,XWM,XDUM,XDVM,XDWM, & - XUT,XVT,XWT,XTHT,XPABST,XTKET,XRTKEMS, & - XRT,XSVT,XZWS,XCIT,XDRYMASST, XDRYMASSS, & - XSIGS,XSRCT,XCLDFR,XBL_DEPTH,XSBL_DEPTH,XWTHVMF,XPHC,XPHR, & - XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM,XLSZWSM, & - XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM, & - XLBXRM,XLBXSVM, & - XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM, & - XLBYRM,XLBYSVM, & - NFRC,TDTFRC,XUFRC,XVFRC,XWFRC,XTHFRC,XRVFRC, & - XTENDTHFRC,XTENDRVFRC,XGXTHFRC,XGYTHFRC, & - XPGROUNDFRC, XATC, & - XTENDUFRC, XTENDVFRC, & - NADVFRC,TDTADVFRC,XDTHFRC,XDRVFRC, & - NRELFRC,TDTRELFRC,XTHREL,XRVREL, & - XVTH_FLUX_M,XWTH_FLUX_M,XVU_FLUX_M, & - XRUS_PRES,XRVS_PRES,XRWS_PRES,XRTHS_CLD,XRRS_CLD,XRSVS_CLD, & - ZIBM_LS,XIBM_XMUT,XUMEANW,XVMEANW,XWMEANW,XUMEANN,XVMEANN, & - XWMEANN,XUMEANE,XVMEANE,XWMEANE,XUMEANS,XVMEANS,XWMEANS ) - -! -!------------------------------------------------------------------------------- -! -! -!* 10. INITIALIZE REFERENCE STATE -! --------------------------- -! -! -CALL SET_REF(KMI,TPINIFILE, & - XZZ,XZHAT,ZJ,XDXX,XDYY,CLBCX,CLBCY, & - XREFMASS,XMASS_O_PHI0,XLINMASS, & - XRHODREF,XTHVREF,XRVREF,XEXNREF,XRHODJ ) -! -!------------------------------------------------------------------------------- -! -!* 10.1 INITIALIZE THE TURBULENCE VARIABLES -! ----------------------------------- -! -IF ((CTURB == 'TKEL').AND.(CCONF=='START')) THEN - CALL MPPDB_CHECK3D(XUT,"INI_MODEL_N-before ini_tke_eps::XUT",PRECISION) - CALL INI_TKE_EPS(CGETTKET,XTHVREF,XZZ, & - XUT,XVT,XTHT, & - XTKET,TZINITHALO3D_ll ) - CALL MPPDB_CHECK3D(XUT,"INI_MODEL_N-after ini_tke_eps::XUT",PRECISION) -END IF -! -! -!* 10.2 INITIALIZE THE LES VARIABLES -! ---------------------------- -! -CALL INI_LES_n -! -!------------------------------------------------------------------------------- -! -!* 11. INITIALIZE THE SOURCE OF TOTAL DRY MASS Md -! ------------------------------------------ -! -IF((KMI==1).AND.LSTEADYLS) THEN - XDRYMASSS = 0. -END IF -! -!------------------------------------------------------------------------------- -! -!* 12. INITIALIZE THE MICROPHYSICS -! ---------------------------- -! -IF (CELEC == 'NONE') THEN - CALL INI_MICRO_n(TPINIFILE,ILUOUT) -! -!------------------------------------------------------------------------------- -! -!* 13. INITIALIZE THE ATMOSPHERIC ELECTRICITY -! -------------------------------------- -! -ELSE - CALL INI_ELEC_n(ILUOUT, CELEC, CCLOUD, TPINIFILE, & - XTSTEP, XZZ, & - XDXX, XDYY, XDZZ, XDZX, XDZY ) -! - WRITE (UNIT=ILUOUT,& - FMT='(/,"ELECTRIC VARIABLES ARE BETWEEN INDEX",I2," AND ",I2)')& - NSV_ELECBEG, NSV_ELECEND -! - IF( CGETSVT(NSV_ELECBEG)=='INIT' ) THEN - XSVT(:,:,:,NSV_ELECBEG) = XCION_POS_FW(:,:,:) ! Nb/kg - XSVT(:,:,:,NSV_ELECEND) = XCION_NEG_FW(:,:,:) -! - XSVT(:,:,:,NSV_ELECBEG+1:NSV_ELECEND-1) = 0.0 - ELSE ! Convert elec_variables per m3 into elec_variables per kg of air - DO JSV = NSV_ELECBEG, NSV_ELECEND - XSVT(:,:,:,JSV) = XSVT(:,:,:,JSV) / XRHODREF(:,:,:) - ENDDO - END IF -END IF -! -!------------------------------------------------------------------------------- -! -!* 14. INITIALIZE THE LARGE SCALE SOURCES -! ---------------------------------- -! -IF ((KMI==1).AND.(.NOT. LSTEADYLS)) THEN - CALL MPPDB_CHECK3D(XUT,"INI_MODEL_N-before ini_cpl::XUT",PRECISION) - CALL INI_CPL(NSTOP,XTSTEP,LSTEADYLS,CCONF, & - CGETTKET, & - CGETRVT,CGETRCT,CGETRRT,CGETRIT, & - CGETRST,CGETRGT,CGETRHT,CGETSVT,LCH_INIT_FIELD, & - NSV,NIMAX_ll,NJMAX_ll, & - NSIZELBX_ll,NSIZELBXU_ll,NSIZELBY_ll,NSIZELBYV_ll, & - NSIZELBXTKE_ll,NSIZELBYTKE_ll, & - NSIZELBXR_ll,NSIZELBYR_ll,NSIZELBXSV_ll,NSIZELBYSV_ll, & - XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM,XLSZWSM,XDRYMASST, & - XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM, & - XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, & - XLSUS,XLSVS,XLSWS,XLSTHS,XLSRVS,XLSZWSS,XDRYMASSS, & - XLBXUS,XLBXVS,XLBXWS,XLBXTHS,XLBXTKES,XLBXRS,XLBXSVS, & - XLBYUS,XLBYVS,XLBYWS,XLBYTHS,XLBYTKES,XLBYRS,XLBYSVS ) - CALL MPPDB_CHECK3D(XUT,"INI_MODEL_N-after ini_cpl::XUT",PRECISION) -! - DO JSV=NSV_CHEMBEG,NSV_CHEMEND - XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.) - XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.) - ENDDO - ! - DO JSV=NSV_LNOXBEG,NSV_LNOXEND - XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.) - XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.) - ENDDO - ! - DO JSV=NSV_AERBEG,NSV_AEREND - XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.) - XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.) - ENDDO - ! - DO JSV=NSV_DSTBEG,NSV_DSTEND - XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.) - XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.) - ENDDO - ! - DO JSV=NSV_DSTDEPBEG,NSV_DSTDEPEND - XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.) - XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.) - ENDDO - ! - DO JSV=NSV_SLTBEG,NSV_SLTEND - XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.) - XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.) - ENDDO - ! - DO JSV=NSV_SLTDEPBEG,NSV_SLTDEPEND - XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.) - XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.) - ENDDO - ! - DO JSV=NSV_PPBEG,NSV_PPEND - XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.) - XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.) - ENDDO - ! -#ifdef MNH_FOREFIRE - DO JSV=NSV_FFBEG,NSV_FFEND - XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.) - XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.) - ENDDO - ! -#endif - DO JSV=NSV_CSBEG,NSV_CSEND - XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.) - XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.) - ENDDO -! -END IF -! -IF ( KMI > 1) THEN - ! Use dummy pointers to correct an ifort BUG - DPTR_XBMX1=>XBMX1 - DPTR_XBMX2=>XBMX2 - DPTR_XBMX3=>XBMX3 - DPTR_XBMX4=>XBMX4 - DPTR_XBMY1=>XBMY1 - DPTR_XBMY2=>XBMY2 - DPTR_XBMY3=>XBMY3 - DPTR_XBMY4=>XBMY4 - DPTR_XBFX1=>XBFX1 - DPTR_XBFX2=>XBFX2 - DPTR_XBFX3=>XBFX3 - DPTR_XBFX4=>XBFX4 - DPTR_XBFY1=>XBFY1 - DPTR_XBFY2=>XBFY2 - DPTR_XBFY3=>XBFY3 - DPTR_XBFY4=>XBFY4 - DPTR_CLBCX=>CLBCX - DPTR_CLBCY=>CLBCY - ! - DPTR_XZZ=>XZZ - DPTR_XZHAT=>XZHAT - DPTR_XLSUM=>XLSUM - DPTR_XLSVM=>XLSVM - DPTR_XLSWM=>XLSWM - DPTR_XLSTHM=>XLSTHM - DPTR_XLSRVM=>XLSRVM - DPTR_XLSZWSM=>XLSZWSM - DPTR_XLSUS=>XLSUS - DPTR_XLSVS=>XLSVS - DPTR_XLSWS=>XLSWS - DPTR_XLSTHS=>XLSTHS - DPTR_XLSRVS=>XLSRVS - DPTR_XLSZWSS=>XLSZWSS - ! - DPTR_NKLIN_LBXU=>NKLIN_LBXU - DPTR_XCOEFLIN_LBXU=>XCOEFLIN_LBXU - DPTR_NKLIN_LBYU=>NKLIN_LBYU - DPTR_XCOEFLIN_LBYU=>XCOEFLIN_LBYU - DPTR_NKLIN_LBXV=>NKLIN_LBXV - DPTR_XCOEFLIN_LBXV=>XCOEFLIN_LBXV - DPTR_NKLIN_LBYV=>NKLIN_LBYV - DPTR_XCOEFLIN_LBYV=>XCOEFLIN_LBYV - DPTR_NKLIN_LBXW=>NKLIN_LBXW - DPTR_XCOEFLIN_LBXW=>XCOEFLIN_LBXW - DPTR_NKLIN_LBYW=>NKLIN_LBYW - DPTR_XCOEFLIN_LBYW=>XCOEFLIN_LBYW - DPTR_NKLIN_LBXM=>NKLIN_LBXM - DPTR_XCOEFLIN_LBXM=>XCOEFLIN_LBXM - DPTR_NKLIN_LBYM=>NKLIN_LBYM - DPTR_XCOEFLIN_LBYM=>XCOEFLIN_LBYM - ! - CALL INI_SPAWN_LS_n(NDAD(KMI),XTSTEP,KMI, & - DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4,DPTR_XBMY1,DPTR_XBMY2,DPTR_XBMY3,DPTR_XBMY4, & - DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4,DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4, & - NDXRATIO_ALL(KMI),NDYRATIO_ALL(KMI), & - DPTR_CLBCX,DPTR_CLBCY,DPTR_XZZ,DPTR_XZHAT, & - LSLEVE,XLEN1,XLEN2, & - DPTR_XLSUM,DPTR_XLSVM,DPTR_XLSWM,DPTR_XLSTHM,DPTR_XLSRVM,DPTR_XLSZWSM, & - DPTR_XLSUS,DPTR_XLSVS,DPTR_XLSWS,DPTR_XLSTHS,DPTR_XLSRVS,DPTR_XLSZWSS, & - DPTR_NKLIN_LBXU,DPTR_XCOEFLIN_LBXU,DPTR_NKLIN_LBYU,DPTR_XCOEFLIN_LBYU, & - DPTR_NKLIN_LBXV,DPTR_XCOEFLIN_LBXV,DPTR_NKLIN_LBYV,DPTR_XCOEFLIN_LBYV, & - DPTR_NKLIN_LBXW,DPTR_XCOEFLIN_LBXW,DPTR_NKLIN_LBYW,DPTR_XCOEFLIN_LBYW, & - DPTR_NKLIN_LBXM,DPTR_XCOEFLIN_LBXM,DPTR_NKLIN_LBYM,DPTR_XCOEFLIN_LBYM ) - ! - DPTR_XLBXUM=>XLBXUM - DPTR_XLBYUM=>XLBYUM - DPTR_XLBXVM=>XLBXVM - DPTR_XLBYVM=>XLBYVM - DPTR_XLBXWM=>XLBXWM - DPTR_XLBYWM=>XLBYWM - DPTR_XLBXTHM=>XLBXTHM - DPTR_XLBYTHM=>XLBYTHM - DPTR_XLBXTKEM=>XLBXTKEM - DPTR_XLBYTKEM=>XLBYTKEM - DPTR_XLBXRM=>XLBXRM - DPTR_XLBYRM=>XLBYRM - DPTR_XLBXSVM=>XLBXSVM - DPTR_XLBYSVM=>XLBYSVM - CALL INI_ONE_WAY_n(NDAD(KMI),KMI, & - DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4,DPTR_XBMY1,DPTR_XBMY2,DPTR_XBMY3,DPTR_XBMY4, & - DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4,DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4, & - NDXRATIO_ALL(KMI),NDYRATIO_ALL(KMI), & - DPTR_CLBCX,DPTR_CLBCY,NRIMX,NRIMY, & - DPTR_NKLIN_LBXU,DPTR_XCOEFLIN_LBXU,DPTR_NKLIN_LBYU,DPTR_XCOEFLIN_LBYU, & - DPTR_NKLIN_LBXV,DPTR_XCOEFLIN_LBXV,DPTR_NKLIN_LBYV,DPTR_XCOEFLIN_LBYV, & - DPTR_NKLIN_LBXW,DPTR_XCOEFLIN_LBXW,DPTR_NKLIN_LBYW,DPTR_XCOEFLIN_LBYW, & - DPTR_NKLIN_LBXM,DPTR_XCOEFLIN_LBXM,DPTR_NKLIN_LBYM,DPTR_XCOEFLIN_LBYM, & - CCLOUD, LUSECHAQ, LUSECHIC, & - DPTR_XLBXUM,DPTR_XLBYUM,DPTR_XLBXVM,DPTR_XLBYVM,DPTR_XLBXWM,DPTR_XLBYWM, & - DPTR_XLBXTHM,DPTR_XLBYTHM, & - DPTR_XLBXTKEM,DPTR_XLBYTKEM, & - DPTR_XLBXRM,DPTR_XLBYRM,DPTR_XLBXSVM,DPTR_XLBYSVM ) -END IF -! -! -!------------------------------------------------------------------------------- -! -!* 15. INITIALIZE THE SCALAR VARIABLES -! ------------------------------- -! -IF (LLG .AND. LINIT_LG .AND. CPROGRAM=='MESONH') & - CALL INI_LG(XXHAT,XYHAT,XZZ,XSVT,XLBXSVM,XLBYSVM) - -! -!------------------------------------------------------------------------------- -! -!* 16. INITIALIZE THE PARAMETERS FOR THE DYNAMICS -! ------------------------------------------ -! -CALL INI_DYNAMICS(XLON,XLAT,XRHODJ,XTHVREF,XMAP,XZZ,XDXHAT,XDYHAT, & - XZHAT,CLBCX,CLBCY,XTSTEP, & - LVE_RELAX,LVE_RELAX_GRD,LHORELAX_UVWTH,LHORELAX_RV, & - LHORELAX_RC,LHORELAX_RR,LHORELAX_RI,LHORELAX_RS,LHORELAX_RG, & - LHORELAX_RH,LHORELAX_TKE,LHORELAX_SV, & - LHORELAX_SVC2R2,LHORELAX_SVC1R3,LHORELAX_SVELEC,LHORELAX_SVLG, & - LHORELAX_SVCHEM,LHORELAX_SVAER,LHORELAX_SVDST,LHORELAX_SVSLT, & - LHORELAX_SVPP,LHORELAX_SVCS,LHORELAX_SVCHIC,LHORELAX_SVSNW, & -#ifdef MNH_FOREFIRE - LHORELAX_SVFF, & -#endif - XRIMKMAX,NRIMX,NRIMY, & - XALKTOP,XALKGRD,XALZBOT,XALZBAS, & - XT4DIFU,XT4DIFTH,XT4DIFSV, & - XCORIOX,XCORIOY,XCORIOZ,XCURVX,XCURVY, & - XDXHATM,XDYHATM,XRHOM,XAF,XBFY,XCF,XTRIGSX,XTRIGSY,NIFAXX,NIFAXY,& - XALK,XALKW,NALBOT,XALKBAS,XALKWBAS,NALBAS, & - LMASK_RELAX,XKURELAX,XKVRELAX,XKWRELAX, & - XDK2U,XDK4U,XDK2TH,XDK4TH,XDK2SV,XDK4SV, & - LZDIFFU,XZDIFFU_HALO2, & - XBFB,XBF_SXP2_YP1_Z ) -! -! -!* 16.1 Initialize the XDRAG array -! ------------- -IF (LDRAG) THEN - CALL INI_DRAG(LMOUNT,XZS,XHSTART,NSTART,XDRAG) -ENDIF -!* 16.2 Initialize the LevelSet function -! ------------- -IF (LIBM) THEN - ALLOCATE(XIBM_LS(IIU,IJU,IKU,4)) ; XIBM_LS = -XIBM_IEPS - XIBM_LS(:,:,:,1)=ZIBM_LS(:,:,:) - DEALLOCATE(ZIBM_LS) -ENDIF -!------------------------------------------------------------------------------- -! -!* 17. SURFACE FIELDS -! -------------- -! -!* 17.1 Radiative setup -! --------------- -! -IF (CRAD /= 'NONE') THEN - IF (CGETRAD =='INIT') THEN - GINIRAD =.TRUE. - ELSE - GINIRAD =.FALSE. - END IF - CALL INI_RADIATIONS(TPINIFILE,GINIRAD,TDTCUR,TDTEXP,XZZ, & - XDXX, XDYY, & - XSINDEL,XCOSDEL,XTSIDER,XCORSOL, & - XSLOPANG,XSLOPAZI, & - XDTHRAD,XDIRFLASWD,XSCAFLASWD, & - XFLALWD,XDIRSRFSWD,NCLEARCOL_TM1, & - XZENITH,XAZIM, & - TDTRAD_FULL,TDTRAD_CLONLY, & - TZINITHALO2D_ll, & - XRADEFF,XSWU,XSWD,XLWU, & - XLWD,XDTHRADSW,XDTHRADLW ) - ! - IF (GINIRAD) CALL SUNPOS_n(XZENITH,PAZIMSOL=XAZIM) - CALL SURF_SOLAR_GEOM (XZS, XZS_XY) - ! - ALLOCATE(XXHAT_ll (IIU_ll)) - ALLOCATE(XYHAT_ll (IJU_ll)) - ALLOCATE(XZS_ll (IIU_ll,IJU_ll)) - ALLOCATE(XZS_XY_ll (IIU_ll,IJU_ll)) - ! - CALL GATHERALL_FIELD_ll('XY',XZS,XZS_ll,IRESP) - CALL GATHERALL_FIELD_ll('XY',XZS_XY,XZS_XY_ll,IRESP) - CALL GATHERALL_FIELD_ll('XX',XXHAT,XXHAT_ll,IRESP) - CALL GATHERALL_FIELD_ll('YY',XYHAT,XYHAT_ll,IRESP) - XZS_MAX_ll=MAXVAL(XZS_ll) -ELSE - XAZIM = XPI - XZENITH = XPI/2. - XDIRSRFSWD = 0. - XSCAFLASWD = 0. - XFLALWD = 300. ! W/m2 - XTSIDER = 0. -END IF -! -! -CALL INI_SW_SETUP (CRAD,NSWB_MNH,XSW_BANDS) -CALL INI_LW_SETUP (CRAD,NLWB_MNH,XLW_BANDS) -! -! -! 17.1.1 Special initialisation for CO2 content -! CO2 (molar mass=44) horizontally and vertically homogeneous at 360 ppm -! -XCCO2 = 360.0E-06 * 44.0E-03 / XMD -#ifdef MNH_ECRAD -RCCO2 = 360.0E-06 * 44.0E-03 / XMD -#endif -! -! -!* 17.2 Externalized surface fields -! --------------------------- -! -ALLOCATE(ZCO2(IIU,IJU)) -ZCO2(:,:) = XCCO2 -! - -ALLOCATE(ZDIR_ALB(IIU,IJU,NSWB_MNH)) -ALLOCATE(ZSCA_ALB(IIU,IJU,NSWB_MNH)) -ALLOCATE(ZEMIS (IIU,IJU,NLWB_MNH)) -ALLOCATE(ZTSRAD (IIU,IJU)) -! -IF (LCOUPLES.AND.(KMI>1))THEN - CSURF ="NONE" -ELSE - IF ((TPINIFILE%NMNHVERSION(1)==4 .AND. TPINIFILE%NMNHVERSION(2)>=6) .OR. TPINIFILE%NMNHVERSION(1)>4) THEN - CALL IO_Field_read(TPINIFILE,'SURF',CSURF) - ELSE - CSURF = "EXTE" - END IF -END IF -! -! -IF (CSURF=='EXTE' .AND. (CPROGRAM=='MESONH' .OR. CPROGRAM=='DIAG ')) THEN - ! ouverture du fichier PGD - IF ( LEN_TRIM(CINIFILEPGD) > 0 ) THEN - CALL IO_File_add2list(TINIFILEPGD,TRIM(CINIFILEPGD),'PGD','READ',KLFITYPE=2,KLFIVERB=NVERB) - CALL IO_File_open(TINIFILEPGD,KRESP=IRESP) - LUNIT_MODEL(KMI)%TINIFILEPGD => TINIFILEPGD - IF (IRESP/=0) THEN - WRITE(ILUOUT,FMT=*) "INI_MODEL_n ERROR TO OPEN THE FILE CINIFILEPGD=",CINIFILEPGD - WRITE(ILUOUT,FMT=*) "CHECK YOUR NAMELIST NAM_LUNITn" - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_MODEL_n','') - ENDIF - ELSE - ! case after a spawning - CINIFILEPGD = TPINIFILE%CNAME - END IF - ! - CALL GOTO_SURFEX(KMI) -#ifdef CPLOASIS - CALL SFX_OASIS_READ_NAM(CPROGRAM,XTSTEP) - WRITE(*,*) 'SFX-OASIS: READ NAM_SFX_SEA_CPL OK' -#endif - !* initialization of surface - CALL INIT_GROUND_PARAM_n ('ALL',SIZE(CSV),CSV,ZCO2, & - XZENITH,XAZIM,XSW_BANDS,XLW_BANDS,ZDIR_ALB,ZSCA_ALB, & - ZEMIS,ZTSRAD ) - ! - IF (SIZE(XEMIS)>0) THEN - XDIR_ALB = ZDIR_ALB - XSCA_ALB = ZSCA_ALB - XEMIS = ZEMIS - XTSRAD = ZTSRAD - CALL MNHGET_SURF_PARAM_n (PSEA=XSEA) - END IF -ELSE - !* fields not physically necessary, but must be initialized - IF (SIZE(XEMIS)>0) THEN - XDIR_ALB = 0. - XSCA_ALB = 0. - XEMIS = 1. - XTSRAD = XTT - XSEA = 1. - END IF -END IF -IF (CSURF=='EXTE' .AND. (CPROGRAM=='SPAWN ')) THEN - ! ouverture du fichier PGD - CALL IO_File_add2list(TINIFILEPGD,TRIM(CINIFILEPGD),'PGD','READ',KLFITYPE=2,KLFIVERB=NVERB) - CALL IO_File_open(TINIFILEPGD,KRESP=IRESP) - LUNIT_MODEL(KMI)%TINIFILEPGD => TINIFILEPGD - IF (IRESP/=0) THEN - WRITE(ILUOUT,FMT=*) "INI_MODEL_n ERROR TO OPEN THE FILE CINIFILEPGD=",CINIFILEPGD - WRITE(ILUOUT,FMT=*) "CHECK YOUR NAMELIST NAM_LUNIT2_SPA" - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_MODEL_n','') - ENDIF -ENDIF -! -IF (.NOT.ASSOCIATED(TINIFILEPGD)) TINIFILEPGD => TFILE_DUMMY -! - !* special case after spawning in prep_real_case -IF (CSURF=='EXRM' .AND. CPROGRAM=='REAL ') CSURF = 'EXTE' -! -DEALLOCATE(ZDIR_ALB) -DEALLOCATE(ZSCA_ALB) -DEALLOCATE(ZEMIS ) -DEALLOCATE(ZTSRAD ) -! -DEALLOCATE(ZCO2) -! -! -!* in a RESTART case, reads surface radiative quantities in the MESONH file -! -IF ((CRAD == 'ECMW' .OR. CRAD == 'ECRA') .AND. CGETRAD=='READ') THEN - CALL INI_SURF_RAD(TPINIFILE, XDIR_ALB, XSCA_ALB, XEMIS, XTSRAD) -END IF -! -! -!* 17.3 Mesonh fields -! ------------- -! -IF (CPROGRAM/='REAL ') CALL MNHREAD_ZS_DUMMY_n(TINIFILEPGD) -! -!------------------------------------------------------------------------------- -! -!* 18. INITIALIZE THE PARAMETERS FOR THE PHYSICS -! ----------------------------------------- -! -IF (CRAD == 'ECMW') THEN -! -!* get cover mask for aerosols -! - IF (CPROGRAM=='MESONH' .OR. CPROGRAM=='DIAG ') THEN - ALLOCATE(ZSEA(IIU,IJU)) - ALLOCATE(ZTOWN(IIU,IJU)) - ALLOCATE(ZBARE(IIU,IJU)) - IF (CSURF=='EXTE') THEN - CALL GOTO_SURFEX(KMI) - CALL MNHGET_SURF_PARAM_n(PSEA=ZSEA,PTOWN=ZTOWN,PBARE=ZBARE) - ELSE - ZSEA (:,:) = 1. - ZTOWN(:,:) = 0. - ZBARE(:,:) = 0. - END IF -! - IF ( CAOP=='EXPL' .AND. LDUST .AND. KMI==1) THEN - ALLOCATE( XEXT_COEFF_WVL_LKT_DUST( NMAX_RADIUS_LKT_DUST, NMAX_SIGMA_LKT_DUST, NMAX_WVL_SW_DUST ) ) - ALLOCATE( XEXT_COEFF_550_LKT_DUST( NMAX_RADIUS_LKT_DUST, NMAX_SIGMA_LKT_DUST ) ) - ALLOCATE( XPIZA_LKT_DUST ( NMAX_RADIUS_LKT_DUST, NMAX_SIGMA_LKT_DUST, NMAX_WVL_SW_DUST ) ) - ALLOCATE( XCGA_LKT_DUST ( NMAX_RADIUS_LKT_DUST, NMAX_SIGMA_LKT_DUST, NMAX_WVL_SW_DUST ) ) - END IF -! - IF ( CAOP=='EXPL' .AND. LSALT .AND. KMI==1) THEN - ALLOCATE( XEXT_COEFF_WVL_LKT_SALT( NMAX_RADIUS_LKT_SALT, NMAX_SIGMA_LKT_SALT, NMAX_WVL_SW_SALT ) ) - ALLOCATE( XEXT_COEFF_550_LKT_SALT( NMAX_RADIUS_LKT_SALT, NMAX_SIGMA_LKT_SALT ) ) - ALLOCATE( XPIZA_LKT_SALT ( NMAX_RADIUS_LKT_SALT, NMAX_SIGMA_LKT_SALT, NMAX_WVL_SW_SALT ) ) - ALLOCATE( XCGA_LKT_SALT ( NMAX_RADIUS_LKT_SALT, NMAX_SIGMA_LKT_SALT, NMAX_WVL_SW_SALT ) ) - END IF -! - CALL INI_RADIATIONS_ECMWF (XZHAT,XPABST,XTHT,XTSRAD,XLAT,XLON,TDTCUR,TDTEXP, & - CLW,NDLON,NFLEV,NFLUX,NRAD,NSWB_OLD,CAER,NAER,NSTATM, & - XSTATM,ZSEA,ZTOWN,ZBARE,XOZON, XAER,XDST_WL, LSUBG_COND ) -! - DEALLOCATE(ZSEA,ZTOWN,ZBARE) - ALLOCATE (XAER_CLIM(SIZE(XAER,1),SIZE(XAER,2),SIZE(XAER,3),SIZE(XAER,4))) - XAER_CLIM(:,:,:,:) =XAER(:,:,:,:) -! - END IF - -ELSE IF (CRAD == 'ECRA') THEN -#ifdef MNH_ECRAD -!* get cover mask for aerosols -! - IF (CPROGRAM=='MESONH' .OR. CPROGRAM=='DIAG ') THEN - ALLOCATE(ZSEA(IIU,IJU)) - ALLOCATE(ZTOWN(IIU,IJU)) - ALLOCATE(ZBARE(IIU,IJU)) - IF (CSURF=='EXTE') THEN - CALL GOTO_SURFEX(KMI) - CALL MNHGET_SURF_PARAM_n(PSEA=ZSEA,PTOWN=ZTOWN,PBARE=ZBARE) - ELSE - ZSEA (:,:) = 1. - ZTOWN(:,:) = 0. - ZBARE(:,:) = 0. - END IF -! - CALL INI_RADIATIONS_ECRAD (XZHAT,XPABST,XTHT,XTSRAD,XLAT,XLON,TDTCUR,TDTEXP, & - CLW,NDLON,NFLEV,NFLUX,NRAD,NSWB_OLD,CAER,NAER,NSTATM, & - XSTATM,ZSEA,ZTOWN,ZBARE,XOZON, XAER,XDST_WL, LSUBG_COND ) - - DEALLOCATE(ZSEA,ZTOWN,ZBARE) - ALLOCATE (XAER_CLIM(SIZE(XAER,1),SIZE(XAER,2),SIZE(XAER,3),SIZE(XAER,4))) - XAER_CLIM(:,:,:,:) = XAER(:,:,:,:) -! - END IF -#endif -ELSE - ALLOCATE (XOZON(0,0,0)) - ALLOCATE (XAER(0,0,0,0)) - ALLOCATE (XDST_WL(0,0,0,0)) - ALLOCATE (XAER_CLIM(0,0,0,0)) -END IF -! -! -! -IF (CDCONV /= 'NONE' .OR. CSCONV == 'KAFR') THEN - IF (CGETCONV=='INIT') THEN - GINIDCONV=.TRUE. - ELSE - GINIDCONV=.FALSE. - END IF -! -! commensurability between convection calling time and time step -! - XDTCONV=XTSTEP*REAL( INT( (MIN(XDTCONV,1800.)+1.E-10)/XTSTEP ) ) - XDTCONV=MAX( XDTCONV, XTSTEP ) - IF (NVERB>=10) THEN - WRITE(ILUOUT,*) 'XDTCONV has been set to : ',XDTCONV - END IF - CALL INI_DEEP_CONVECTION (TPINIFILE,GINIDCONV,TDTCUR, & - NCOUNTCONV,XDTHCONV,XDRVCONV,XDRCCONV, & - XDRICONV,XPRCONV,XPRSCONV,XPACCONV, & - XUMFCONV,XDMFCONV,XMFCONV,XPRLFLXCONV,XPRSFLXCONV,& - XCAPE,NCLTOPCONV,NCLBASCONV, & - TDTDCONV, CGETSVCONV, XDSVCONV, & - LCH_CONV_LINOX, XIC_RATE, XCG_RATE, & - XIC_TOTAL_NUMBER, XCG_TOTAL_NUMBER ) - -END IF -! -!------------------------------------------------------------------------------- -! -! -!* 19. ALLOCATION OF THE TEMPORAL SERIES -! --------------------------------- -! -IF (LSERIES .AND. CPROGRAM/='DIAG ') CALL INI_SERIES_n -! -!------------------------------------------------------------------------------- -! -! -!* 20. (re)initialize scalar variables -! ------------------------------- -! -! -IF ( LUSECHEM .OR. LCHEMDIAG ) THEN - IF (CPROGRAM=='MESONH'.AND.CCONF=='RESTA') LCH_INIT_FIELD =.FALSE. - IF (CPROGRAM=='MESONH'.OR. CPROGRAM=='DIAG ' .OR. CPROGRAM=='IDEAL ') & - CALL CH_INIT_FIELD_n(KMI, ILUOUT, NVERB) -END IF -! -!------------------------------------------------------------------------------- -! -!* 21. UPDATE HALO -! ----------- -! -! -CALL UPDATE_HALO_ll(TZINITHALO3D_ll,IINFO_ll) -CALL UPDATE_HALO_ll(TZINITHALO2D_ll,IINFO_ll) -CALL CLEANLIST_ll(TZINITHALO3D_ll) -CALL CLEANLIST_ll(TZINITHALO2D_ll) -! -! -!------------------------------------------------------------------------------- -! -!* 22. DEALLOCATION -! ------------- -! -DEALLOCATE(ZJ) -! -DEALLOCATE(XSTROATM) -DEALLOCATE(XSMLSATM) -DEALLOCATE(XSMLWATM) -DEALLOCATE(XSPOSATM) -DEALLOCATE(XSPOWATM) -! -!------------------------------------------------------------------------------- -! -!* 23. BALLOON and AIRCRAFT initializations -! ------------------------------------ -! -CALL INI_AIRCRAFT_BALLOON(TPINIFILE,XTSTEP, TDTSEG, XSEGLEN, NRR, NSV, & - IKU,CTURB=="TKEL" , & - XLATORI, XLONORI ) -! -!------------------------------------------------------------------------------- -! -!* 24. STATION initializations -! ----------------------- -! -CALL INI_SURFSTATION_n(XTSTEP, XSEGLEN, NRR, NSV, & - CTURB=="TKEL" , KMI, & - XLATORI, XLONORI ) -! -!------------------------------------------------------------------------------- -! -!* 25. PROFILER initializations -! ------------------------ -! -CALL INI_POSPROFILER_n(XTSTEP, XSEGLEN, NRR, NSV, & - CTURB=="TKEL", & - XLATORI, XLONORI ) -! -!------------------------------------------------------------------------------- -! -!* 26. Prognostic aerosols -! ------------------------ -! -IF ( ( CRAD=='ECMW' .OR. CRAD=='ECRA' ) .AND. CAOP=='EXPL' .AND. LORILAM ) THEN - ALLOCATE(POLYTAU(6,10,8,6,13)) - ALLOCATE(POLYSSA(6,10,8,6,13)) - ALLOCATE(POLYG (6,10,8,6,13)) - CALL INI_AEROSET1 - CALL INI_AEROSET2 - CALL INI_AEROSET3 - CALL INI_AEROSET4 - CALL INI_AEROSET5 - CALL INI_AEROSET6 -END IF -#ifdef MNH_FOREFIRE -! -!------------------------------------------------------------------------------- -! -!* 27. FOREFIRE initializations -! ------------------------ -! - -! Coupling with ForeFire if resolution is low enough -!--------------------------------------------------- -IF ( LFOREFIRE .AND. 0.5*(XXHAT(2)-XXHAT(1)+XYHAT(2)-XYHAT(1)) < COUPLINGRES ) THEN - FFCOUPLING = .TRUE. -ELSE - FFCOUPLING = .FALSE. -ENDIF - -! Initializing the ForeFire variables -!------------------------------------ -IF ( LFOREFIRE ) THEN - CALL INIT_FOREFIRE_n(KMI, ILUOUT, IP & - , TDTCUR%nyear, TDTCUR%nmonth, TDTCUR%nday, TDTCUR%xtime, XTSTEP) -END IF -#endif - -!------------------------------------------------------------------------------- -! -!* 30. Total production/Loss for chemical species -! -IF (LCHEMDIAG) THEN - CALL CH_INIT_PRODLOSSTOT_n(ILUOUT) - IF (NEQ_PLT>0) THEN - ALLOCATE(XPROD(IIU,IJU,IKU,NEQ_PLT)) - ALLOCATE(XLOSS(IIU,IJU,IKU,NEQ_PLT)) - XPROD=0.0 - XLOSS=0.0 - ELSE - ALLOCATE(XPROD(0,0,0,0)) - ALLOCATE(XLOSS(0,0,0,0)) - END IF -ELSE - ALLOCATE(XPROD(0,0,0,0)) - ALLOCATE(XLOSS(0,0,0,0)) -END IF -! -!------------------------------------------------------------------------------- -! -!* 31. Extended production/loss terms for chemical species -! -IF (LCHEMDIAG) THEN - CALL CH_INIT_BUDGET_n(ILUOUT) - IF (NEQ_BUDGET>0) THEN - ALLOCATE(IINDEX(2,NNONZEROTERMS)) - ALLOCATE(IIND(NEQ_BUDGET)) - CALL CH_NONZEROTERMS(KMI,IINDEX,NNONZEROTERMS) - ALLOCATE(XTCHEM(NEQ_BUDGET)) - DO JM=1,NEQ_BUDGET - IIND(JM)=COUNT((IINDEX(1,:))==NSPEC_BUDGET(JM)) - ALLOCATE(XTCHEM(JM)%NB_REAC(IIND(JM))) - ALLOCATE(XTCHEM(JM)%XB_REAC(IIU,IJU,IKU,IIND(JM))) - END DO - DEALLOCATE(IIND) - DEALLOCATE(IINDEX) - ELSE - ALLOCATE(XTCHEM(0)) - END IF -ELSE - ALLOCATE(XTCHEM(0)) -END IF -!------------------------------------------------------------------------------- -! -!* 32. Wind turbine -! -IF (LMAIN_EOL .AND. KMI == NMODEL_EOL) THEN - ALLOCATE(XFX_RG(IIU,IJU,IKU)) - ALLOCATE(XFY_RG(IIU,IJU,IKU)) - ALLOCATE(XFZ_RG(IIU,IJU,IKU)) - ALLOCATE(XFX_SMR_RG(IIU,IJU,IKU)) - ALLOCATE(XFY_SMR_RG(IIU,IJU,IKU)) - ALLOCATE(XFZ_SMR_RG(IIU,IJU,IKU)) - SELECT CASE(CMETH_EOL) - CASE('ADNR') - CALL INI_EOL_ADNR - CASE('ALM') - CALL INI_EOL_ALM(XDXX,XDYY) - END SELECT -END IF -! -!* 33. Auto-coupling Atmos-Ocean LES NH -! -IF (LCOUPLES) THEN - ALLOCATE(XSSUFL_C(IIU,IJU,1)); XSSUFL_C=0.0 - ALLOCATE(XSSVFL_C(IIU,IJU,1)); XSSVFL_C=0.0 - ALLOCATE(XSSTFL_C(IIU,IJU,1)); XSSTFL_C=0.0 - ALLOCATE(XSSRFL_C(IIU,IJU,1)); XSSRFL_C=0. -ELSE - ALLOCATE(XSSUFL_C(0,0,0)) - ALLOCATE(XSSVFL_C(0,0,0)) - ALLOCATE(XSSTFL_C(0,0,0)) - ALLOCATE(XSSRFL_C(0,0,0)) -END IF -! -END SUBROUTINE INI_MODEL_n - diff --git a/src/ICCARE_BASE/ini_nsv.f90 b/src/ICCARE_BASE/ini_nsv.f90 deleted file mode 100644 index 9ea8633fc..000000000 --- a/src/ICCARE_BASE/ini_nsv.f90 +++ /dev/null @@ -1,893 +0,0 @@ -!MNH_LIC Copyright 2001-2021 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!----------------------------------------------------------------- -! ################### - MODULE MODI_INI_NSV -! ################### -INTERFACE -! - SUBROUTINE INI_NSV(KMI) - INTEGER, INTENT(IN) :: KMI ! model index - END SUBROUTINE INI_NSV -! -END INTERFACE -! -END MODULE MODI_INI_NSV -! -! -! ########################### - SUBROUTINE INI_NSV(KMI) -! ########################### -! -!!**** *INI_NSV* - compute NSV_* values and indices for model KMI -!! -!! PURPOSE -!! ------- -! -! -! -!!** METHOD -!! ------ -!! -!! This routine is called from any routine which stores values in -!! the first model module (for example READ_EXSEG). -!! -!! EXTERNAL -!! -------- -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! Module MODD_NSV : contains NSV_A array variable -!! -!! REFERENCE -!! --------- -!! -!! -!! AUTHOR -!! ------ -!! D. Gazen * LA * -!! -!! MODIFICATIONS -!! ------------- -!! Original 01/02/01 -!! Modification 29/11/02 (Pinty) add SV for C3R5 and ELEC -!! Modification 01/2004 (Masson) add scalar names -!! Modification 03/2006 (O.Geoffroy) add KHKO scheme -!! Modification 04/2007 (Leriche) add SV for aqueous chemistry -!! M. Chong 26/01/10 Add Small ions -!! Modification 07/2010 (Leriche) add SV for ice chemistry -!! X.Pialat & J.Escobar 11/2012 remove deprecated line NSV_A(KMI) = ISV -!! Modification 15/02/12 (Pialat/Tulet) Add SV for ForeFire scalars -!! 03/2013 (C.Lac) add supersaturation as -!! the 4th C2R2 scalar variable -!! J.escobar 04/08/2015 suit Pb with writ_lfin JSA increment , modif in ini_nsv to have good order initialization -!! Modification 01/2016 (JP Pinty) Add LIMA and LUSECHEM condition -!! Modification 07/2017 (V. Vionnet) Add blowing snow condition -! P. Wautelet 09/03/2021: move some chemistry initializations to ini_nsv -! P. Wautelet 10/03/2021: move scalar variable name initializations to ini_nsv -! P. Wautelet 10/03/2021: add CSVNAMES and CSVNAMES_A to store the name of all the scalar variables -! P. Wautelet 30/03/2021: move NINDICE_CCN_IMM and NIMM initializations from init_aerosol_properties to ini_nsv -! B. Vie 06/2021: add prognostic supersaturation for LIMA -!! -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_BLOWSNOW, ONLY: CSNOWNAMES, LBLOWSNOW, NBLOWSNOW3D, YPSNOW_INI -USE MODD_CH_AEROSOL, ONLY: CAERONAMES, CDEAERNAMES, JPMODE, LAERINIT, LDEPOS_AER, LORILAM, & - LVARSIGI, LVARSIGJ, NCARB, NM6_AER, NSOA, NSP -USE MODD_CH_M9_n, ONLY: CICNAMES, CNAMES, NEQ, NEQAQ -USE MODD_CH_MNHC_n, ONLY: LCH_PH, LUSECHEM, LUSECHAQ, LUSECHIC, CCH_SCHEME, LCH_CONV_LINOX -USE MODD_CONDSAMP, ONLY: LCONDSAMP, NCONDSAMP -USE MODD_CONF, ONLY: LLG, CPROGRAM, NVERB -USE MODD_CST, ONLY: XMNH_TINY -USE MODD_DIAG_FLAG, ONLY: LCHEMDIAG, LCHAQDIAG -USE MODD_DUST, ONLY: CDEDSTNAMES, CDUSTNAMES, JPDUSTORDER, LDEPOS_DST, LDSTINIT, LDSTPRES, LDUST, & - LRGFIX_DST, LVARSIG, NMODE_DST, YPDEDST_INI, YPDUST_INI -USE MODD_DYN_n, ONLY: LHORELAX_SV,LHORELAX_SVC2R2,LHORELAX_SVC1R3, & - LHORELAX_SVLIMA, & - LHORELAX_SVELEC,LHORELAX_SVCHEM,LHORELAX_SVLG, & - LHORELAX_SVDST,LHORELAX_SVAER, LHORELAX_SVSLT, & - LHORELAX_SVPP,LHORELAX_SVCS, LHORELAX_SVCHIC, & - LHORELAX_SVSNW -#ifdef MNH_FOREFIRE -USE MODD_DYN_n, ONLY: LHORELAX_SVFF -#endif -USE MODD_ELEC_DESCR, ONLY: LLNOX_EXPLICIT -USE MODD_ELEC_DESCR, ONLY: CELECNAMES -#ifdef MNH_FOREFIRE -USE MODD_FOREFIRE -#endif -USE MODD_ICE_C1R3_DESCR, ONLY: C1R3NAMES -USE MODD_LG, ONLY: CLGNAMES, XLG1MIN, XLG2MIN, XLG3MIN -USE MODD_LUNIT_n, ONLY: TLUOUT -USE MODD_NSV -USE MODD_PARAM_C2R2, ONLY: LSUPSAT -USE MODD_PARAM_LIMA, ONLY: NINDICE_CCN_IMM, NIMM, NMOD_CCN, LSCAV, LAERO_MASS, & - NMOD_IFN, NMOD_IMM, LHHONI, & - LWARM, LCOLD, LRAIN, LSPRO -USE MODD_PARAM_LIMA_COLD, ONLY: CLIMA_COLD_NAMES -USE MODD_PARAM_LIMA_WARM, ONLY: CAERO_MASS, CLIMA_WARM_NAMES -USE MODD_PARAM_n, ONLY: CCLOUD, CELEC -USE MODD_PASPOL, ONLY: LPASPOL, NRELEASE -USE MODD_PREP_REAL, ONLY: XT_LS -USE MODD_RAIN_C2R2_DESCR, ONLY: C2R2NAMES -USE MODD_SALT, ONLY: CSALTNAMES, CDESLTNAMES, JPSALTORDER, & - LRGFIX_SLT, LSALT, LSLTINIT, LSLTPRES, LDEPOS_SLT, LVARSIG_SLT, NMODE_SLT, YPDESLT_INI, YPSALT_INI - -USE MODE_MSG - -USE MODI_CH_AER_INIT_SOA, ONLY: CH_AER_INIT_SOA -USE MODI_CH_INIT_SCHEME_n, ONLY: CH_INIT_SCHEME_n -USE MODI_UPDATE_NSV, ONLY: UPDATE_NSV -! -IMPLICIT NONE -! -!------------------------------------------------------------------------------- -! -!* 0.1 Declarations of arguments -! -INTEGER, INTENT(IN) :: KMI ! model index -! -!* 0.2 Declarations of local variables -! -CHARACTER(LEN=2) :: YNUM2 -CHARACTER(LEN=3) :: YNUM3 -INTEGER :: ILUOUT -INTEGER :: ISV ! total number of scalar variables -INTEGER :: IMODEIDX, IMOMENTS -INTEGER :: JI, JJ, JSV -INTEGER :: JMODE, JMOM, JSV_NAME -! -!------------------------------------------------------------------------------- -! -LINI_NSV = .TRUE. - -ILUOUT = TLUOUT%NLU -! -! Users scalar variables are first considered -! -NSV_USER_A(KMI) = NSV_USER -ISV = NSV_USER -! -! scalar variables used in microphysical schemes C2R2,KHKO and C3R5 -! -IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO' ) THEN - IF ((CCLOUD == 'C2R2' .AND. LSUPSAT) .OR. (CCLOUD == 'KHKO'.AND. LSUPSAT)) THEN - ! 4th scalar field = supersaturation - NSV_C2R2_A(KMI) = 4 - ELSE - NSV_C2R2_A(KMI) = 3 - END IF - NSV_C2R2BEG_A(KMI) = ISV+1 - NSV_C2R2END_A(KMI) = ISV+NSV_C2R2_A(KMI) - ISV = NSV_C2R2END_A(KMI) - IF (CCLOUD == 'C3R5') THEN ! the SVs for C2R2 and C1R3 must be contiguous - NSV_C1R3_A(KMI) = 2 - NSV_C1R3BEG_A(KMI) = ISV+1 - NSV_C1R3END_A(KMI) = ISV+NSV_C1R3_A(KMI) - ISV = NSV_C1R3END_A(KMI) - ELSE - NSV_C1R3_A(KMI) = 0 - ! force First index to be superior to last index - ! in order to create a null section - NSV_C1R3BEG_A(KMI) = 1 - NSV_C1R3END_A(KMI) = 0 - END IF -ELSE - NSV_C2R2_A(KMI) = 0 - NSV_C1R3_A(KMI) = 0 -! force First index to be superior to last index -! in order to create a null section - NSV_C2R2BEG_A(KMI) = 1 - NSV_C2R2END_A(KMI) = 0 - NSV_C1R3BEG_A(KMI) = 1 - NSV_C1R3END_A(KMI) = 0 -END IF -! -! scalar variables used in the LIMA microphysical scheme -! -IF (CCLOUD == 'LIMA' ) THEN - ISV = ISV+1 - NSV_LIMA_BEG_A(KMI) = ISV - IF (LWARM) THEN -! Nc - NSV_LIMA_NC_A(KMI) = ISV - ISV = ISV+1 -! Nr - IF (LRAIN) THEN - NSV_LIMA_NR_A(KMI) = ISV - ISV = ISV+1 - END IF - END IF ! LWARM -! CCN - IF (NMOD_CCN .GT. 0) THEN - NSV_LIMA_CCN_FREE_A(KMI) = ISV - ISV = ISV + NMOD_CCN - NSV_LIMA_CCN_ACTI_A(KMI) = ISV - ISV = ISV + NMOD_CCN - END IF -! Scavenging - IF (LSCAV .AND. LAERO_MASS) THEN - NSV_LIMA_SCAVMASS_A(KMI) = ISV - ISV = ISV+1 - END IF ! LSCAV -! - IF (LCOLD) THEN -! Ni - NSV_LIMA_NI_A(KMI) = ISV - ISV = ISV+1 - END IF ! LCOLD -! IFN - IF (NMOD_IFN .GT. 0) THEN - NSV_LIMA_IFN_FREE_A(KMI) = ISV - ISV = ISV + NMOD_IFN - NSV_LIMA_IFN_NUCL_A(KMI) = ISV - ISV = ISV + NMOD_IFN - END IF -! IMM - IF (NMOD_IMM .GT. 0) THEN - NSV_LIMA_IMM_NUCL_A(KMI) = ISV - ISV = ISV + MAX(1,NMOD_IMM) - END IF - - IF ( NMOD_IFN > 0 ) THEN - IF ( .NOT. ALLOCATED( NIMM ) ) ALLOCATE( NIMM(NMOD_CCN) ) - NIMM(:) = 0 - IF ( ALLOCATED( NINDICE_CCN_IMM ) ) DEALLOCATE( NINDICE_CCN_IMM ) - ALLOCATE( NINDICE_CCN_IMM(MAX( 1, NMOD_IMM )) ) - IF (NMOD_IMM > 0 ) THEN - DO JI = 0, NMOD_IMM - 1 - NIMM(NMOD_CCN - JI) = 1 - NINDICE_CCN_IMM(NMOD_IMM - JI) = NMOD_CCN - JI - END DO -! ELSE IF (NMOD_IMM == 0) THEN ! PNIS exists but is 0 for the call to resolved_cloud -! NMOD_IMM = 1 -! NINDICE_CCN_IMM(1) = 0 - END IF - END IF - -! Homogeneous freezing of CCN - IF (LCOLD .AND. LHHONI) THEN - NSV_LIMA_HOM_HAZE_A(KMI) = ISV - ISV = ISV + 1 - END IF -! Supersaturation - IF (LSPRO) THEN - NSV_LIMA_SPRO_A(KMI) = ISV - ISV = ISV + 1 - END IF -! -! End and total variables -! - ISV = ISV - 1 - NSV_LIMA_END_A(KMI) = ISV - NSV_LIMA_A(KMI) = NSV_LIMA_END_A(KMI) - NSV_LIMA_BEG_A(KMI) + 1 -ELSE - NSV_LIMA_A(KMI) = 0 -! -! force First index to be superior to last index -! in order to create a null section -! - NSV_LIMA_BEG_A(KMI) = 1 - NSV_LIMA_END_A(KMI) = 0 -END IF ! CCLOUD = LIMA -! -! -! Add one scalar for negative ion -! First variable: positive ion (NSV_ELECBEG_A index number) -! Last --------: negative ion (NSV_ELECEND_A index number) -! Correspondence for ICE3: -! Relative index 1 2 3 4 5 6 7 -! Charge for ion+ cloud rain ice snow graupel ion- -! -! Correspondence for ICE4: -! Relative index 1 2 3 4 5 6 7 8 -! Charge for ion+ cloud rain ice snow graupel hail ion- -! -IF (CELEC /= 'NONE') THEN - IF (CCLOUD == 'ICE3') THEN - NSV_ELEC_A(KMI) = 7 - NSV_ELECBEG_A(KMI)= ISV+1 - NSV_ELECEND_A(KMI)= ISV+NSV_ELEC_A(KMI) - ISV = NSV_ELECEND_A(KMI) - CELECNAMES(7) = CELECNAMES(8) - ELSE IF (CCLOUD == 'ICE4') THEN - NSV_ELEC_A(KMI) = 8 - NSV_ELECBEG_A(KMI)= ISV+1 - NSV_ELECEND_A(KMI)= ISV+NSV_ELEC_A(KMI) - ISV = NSV_ELECEND_A(KMI) - END IF -ELSE - NSV_ELEC_A(KMI) = 0 -! force First index to be superior to last index -! in order to create a null section - NSV_ELECBEG_A(KMI) = 1 - NSV_ELECEND_A(KMI) = 0 -END IF -! -! scalar variables used as lagragian variables -! -IF (LLG) THEN - NSV_LG_A(KMI) = 3 - NSV_LGBEG_A(KMI) = ISV+1 - NSV_LGEND_A(KMI) = ISV+NSV_LG_A(KMI) - ISV = NSV_LGEND_A(KMI) -ELSE - NSV_LG_A(KMI) = 0 -! force First index to be superior to last index -! in order to create a null section - NSV_LGBEG_A(KMI) = 1 - NSV_LGEND_A(KMI) = 0 -END IF -! -! scalar variables used as LiNOX passive tracer -! -! In case without chemistry -IF (LPASPOL) THEN - NSV_PP_A(KMI) = NRELEASE - NSV_PPBEG_A(KMI)= ISV+1 - NSV_PPEND_A(KMI)= ISV+NSV_PP_A(KMI) - ISV = NSV_PPEND_A(KMI) -ELSE - NSV_PP_A(KMI) = 0 -! force First index to be superior to last index -! in order to create a null section - NSV_PPBEG_A(KMI)= 1 - NSV_PPEND_A(KMI)= 0 -END IF -! -#ifdef MNH_FOREFIRE - -! ForeFire tracers -IF (LFOREFIRE .AND. NFFSCALARS .GT. 0) THEN - NSV_FF_A(KMI) = NFFSCALARS - NSV_FFBEG_A(KMI) = ISV+1 - NSV_FFEND_A(KMI) = ISV+NSV_FF_A(KMI) - ISV = NSV_FFEND_A(KMI) -ELSE - NSV_FF_A(KMI) = 0 -! force First index to be superior to last index -! in order to create a null section - NSV_FFBEG_A(KMI)= 1 - NSV_FFEND_A(KMI)= 0 -END IF -#endif -! Conditional sampling variables -IF (LCONDSAMP) THEN - NSV_CS_A(KMI) = NCONDSAMP - NSV_CSBEG_A(KMI)= ISV+1 - NSV_CSEND_A(KMI)= ISV+NSV_CS_A(KMI) - ISV = NSV_CSEND_A(KMI) -ELSE - NSV_CS_A(KMI) = 0 -! force First index to be superior to last index -! in order to create a null section - NSV_CSBEG_A(KMI)= 1 - NSV_CSEND_A(KMI)= 0 -END IF -! -! scalar variables used in chemical core system -! -IF (LUSECHEM) THEN - CALL CH_INIT_SCHEME_n(KMI,LUSECHAQ,LUSECHIC,LCH_PH,ILUOUT,NVERB) - IF (LORILAM) CALL CH_AER_INIT_SOA(ILUOUT, NVERB) -END IF - -IF (LUSECHEM .AND.(NEQ .GT. 0)) THEN - NSV_CHEM_A(KMI) = NEQ - NSV_CHEMBEG_A(KMI)= ISV+1 - NSV_CHEMEND_A(KMI)= ISV+NSV_CHEM_A(KMI) - ISV = NSV_CHEMEND_A(KMI) -ELSE - NSV_CHEM_A(KMI) = 0 -! force First index to be superior to last index -! in order to create a null section - NSV_CHEMBEG_A(KMI)= 1 - NSV_CHEMEND_A(KMI)= 0 -END IF -! -! aqueous chemistry (part of the "chem" variables) -! -IF ((LUSECHAQ .OR. LCHAQDIAG).AND.(NEQ .GT. 0)) THEN - NSV_CHGS_A(KMI) = NEQ-NEQAQ - NSV_CHGSBEG_A(KMI)= NSV_CHEMBEG_A(KMI) - NSV_CHGSEND_A(KMI)= NSV_CHEMBEG_A(KMI)+(NEQ-NEQAQ)-1 - NSV_CHAC_A(KMI) = NEQAQ - NSV_CHACBEG_A(KMI)= NSV_CHGSEND_A(KMI)+1 - NSV_CHACEND_A(KMI)= NSV_CHEMEND_A(KMI) -! ice phase chemistry - IF (LUSECHIC) THEN - NSV_CHIC_A(KMI) = NEQAQ/2. -1. - NSV_CHICBEG_A(KMI)= ISV+1 - NSV_CHICEND_A(KMI)= ISV+NSV_CHIC_A(KMI) - ISV = NSV_CHICEND_A(KMI) - ELSE - NSV_CHIC_A(KMI) = 0 - NSV_CHICBEG_A(KMI)= 1 - NSV_CHICEND_A(KMI)= 0 - ENDIF -ELSE - IF (NEQ .GT. 0) THEN - NSV_CHGS_A(KMI) = NEQ-NEQAQ - NSV_CHGSBEG_A(KMI)= NSV_CHEMBEG_A(KMI) - NSV_CHGSEND_A(KMI)= NSV_CHEMBEG_A(KMI)+(NEQ-NEQAQ)-1 - NSV_CHAC_A(KMI) = 0 - NSV_CHACBEG_A(KMI)= 1 - NSV_CHACEND_A(KMI)= 0 - NSV_CHIC_A(KMI) = 0 - NSV_CHICBEG_A(KMI)= 1 - NSV_CHICEND_A(KMI)= 0 - ELSE - NSV_CHGS_A(KMI) = 0 - NSV_CHGSBEG_A(KMI)= 1 - NSV_CHGSEND_A(KMI)= 0 - NSV_CHAC_A(KMI) = 0 - NSV_CHACBEG_A(KMI)= 1 - NSV_CHACEND_A(KMI)= 0 - NSV_CHIC_A(KMI) = 0 - NSV_CHICBEG_A(KMI)= 1 - NSV_CHICEND_A(KMI)= 0 - ENDIF -END IF -! aerosol variables -IF (LORILAM.AND.(NEQ .GT. 0)) THEN - IF (ALLOCATED(XT_LS)) LAERINIT=.TRUE. - NM6_AER = 0 - IF (LVARSIGI) NM6_AER = 1 - IF (LVARSIGJ) NM6_AER = NM6_AER + 1 - NSV_AER_A(KMI) = (NSP+NCARB+NSOA+1)*JPMODE + NM6_AER - NSV_AERBEG_A(KMI)= ISV+1 - NSV_AEREND_A(KMI)= ISV+NSV_AER_A(KMI) - ISV = NSV_AEREND_A(KMI) -ELSE - NSV_AER_A(KMI) = 0 -! force First index to be superior to last index -! in order to create a null section - NSV_AERBEG_A(KMI)= 1 - NSV_AEREND_A(KMI)= 0 -END IF -IF (LORILAM .AND. LDEPOS_AER(KMI)) THEN - NSV_AERDEP_A(KMI) = JPMODE*2 - NSV_AERDEPBEG_A(KMI)= ISV+1 - NSV_AERDEPEND_A(KMI)= ISV+NSV_AERDEP_A(KMI) - ISV = NSV_AERDEPEND_A(KMI) -ELSE - NSV_AERDEP_A(KMI) = 0 -! force First index to be superior to last index -! in order to create a null section - NSV_AERDEPBEG_A(KMI)= 1 - NSV_AERDEPEND_A(KMI)= 0 -! force First index to be superior to last index -! in order to create a null section -END IF -! -! scalar variables used in dust model -! -IF (LDUST) THEN - IF (ALLOCATED(XT_LS).AND. .NOT.(LDSTPRES)) LDSTINIT=.TRUE. - IF (CPROGRAM == 'IDEAL ') LVARSIG = .TRUE. - IF ((CPROGRAM == 'REAL ').AND.LDSTINIT) LVARSIG = .TRUE. - NSV_DST_A(KMI) = NMODE_DST*2 - IF (LRGFIX_DST) THEN - NSV_DST_A(KMI) = NMODE_DST - LVARSIG = .FALSE. - END IF - IF (LVARSIG) NSV_DST_A(KMI) = NSV_DST_A(KMI) + NMODE_DST - NSV_DSTBEG_A(KMI)= ISV+1 - NSV_DSTEND_A(KMI)= ISV+NSV_DST_A(KMI) - ISV = NSV_DSTEND_A(KMI) -ELSE - NSV_DST_A(KMI) = 0 -! force First index to be superior to last index -! in order to create a null section - NSV_DSTBEG_A(KMI)= 1 - NSV_DSTEND_A(KMI)= 0 -END IF -IF ( LDUST .AND. LDEPOS_DST(KMI) ) THEN - NSV_DSTDEP_A(KMI) = NMODE_DST*2 - NSV_DSTDEPBEG_A(KMI)= ISV+1 - NSV_DSTDEPEND_A(KMI)= ISV+NSV_DSTDEP_A(KMI) - ISV = NSV_DSTDEPEND_A(KMI) -ELSE - NSV_DSTDEP_A(KMI) = 0 -! force First index to be superior to last index -! in order to create a null section - NSV_DSTDEPBEG_A(KMI)= 1 - NSV_DSTDEPEND_A(KMI)= 0 -! force First index to be superior to last index -! in order to create a null section - - END IF -! scalar variables used in sea salt model -! -IF (LSALT) THEN - IF (ALLOCATED(XT_LS).AND. .NOT.(LSLTPRES)) LSLTINIT=.TRUE. - IF (CPROGRAM == 'IDEAL ') LVARSIG_SLT = .TRUE. - IF ((CPROGRAM == 'REAL ').AND. LSLTINIT ) LVARSIG_SLT = .TRUE. - NSV_SLT_A(KMI) = NMODE_SLT*2 - IF (LRGFIX_SLT) THEN - NSV_SLT_A(KMI) = NMODE_SLT - LVARSIG_SLT = .FALSE. - END IF - IF (LVARSIG_SLT) NSV_SLT_A(KMI) = NSV_SLT_A(KMI) + NMODE_SLT - NSV_SLTBEG_A(KMI)= ISV+1 - NSV_SLTEND_A(KMI)= ISV+NSV_SLT_A(KMI) - ISV = NSV_SLTEND_A(KMI) -ELSE - NSV_SLT_A(KMI) = 0 -! force First index to be superior to last index -! in order to create a null section - NSV_SLTBEG_A(KMI)= 1 - NSV_SLTEND_A(KMI)= 0 -END IF -IF ( LSALT .AND. LDEPOS_SLT(KMI) ) THEN - NSV_SLTDEP_A(KMI) = NMODE_SLT*2 - NSV_SLTDEPBEG_A(KMI)= ISV+1 - NSV_SLTDEPEND_A(KMI)= ISV+NSV_SLTDEP_A(KMI) - ISV = NSV_SLTDEPEND_A(KMI) -ELSE - NSV_SLTDEP_A(KMI) = 0 -! force First index to be superior to last index -! in order to create a null section - NSV_SLTDEPBEG_A(KMI)= 1 - NSV_SLTDEPEND_A(KMI)= 0 -! force First index to be superior to last index -! in order to create a null section -END IF -! -! scalar variables used in blowing snow model -! -IF (LBLOWSNOW) THEN - NSV_SNW_A(KMI) = NBLOWSNOW3D - NSV_SNWBEG_A(KMI)= ISV+1 - NSV_SNWEND_A(KMI)= ISV+NSV_SNW_A(KMI) - ISV = NSV_SNWEND_A(KMI) -ELSE - NSV_SNW_A(KMI) = 0 -! force First index to be superior to last index -! in order to create a null section - NSV_SNWBEG_A(KMI)= 1 - NSV_SNWEND_A(KMI)= 0 -END IF -! -! scalar variables used as LiNOX passive tracer -! -! In case without chemistry -IF (.NOT.(LUSECHEM.OR.LCHEMDIAG) .AND. (LCH_CONV_LINOX.OR.LLNOX_EXPLICIT)) THEN - NSV_LNOX_A(KMI) = 1 - NSV_LNOXBEG_A(KMI)= ISV+1 - NSV_LNOXEND_A(KMI)= ISV+NSV_LNOX_A(KMI) - ISV = NSV_LNOXEND_A(KMI) -ELSE - NSV_LNOX_A(KMI) = 0 -! force First index to be superior to last index -! in order to create a null section - NSV_LNOXBEG_A(KMI)= 1 - NSV_LNOXEND_A(KMI)= 0 -END IF -! -! finale number of NSV variable -! -NSV_A(KMI) = ISV -! -! -!* Update LHORELAX_SV,CGETSVM,CGETSVT for NON USER SV -! -! C2R2 or KHKO SV case -!*BUG*JPC*MAR2006 -! IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO' ) & -IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO' ) & -!*BUG*JPC*MAR2006 -LHORELAX_SV(NSV_C2R2BEG_A(KMI):NSV_C2R2END_A(KMI))=LHORELAX_SVC2R2 -! C3R5 SV case -IF (CCLOUD == 'C3R5') & -LHORELAX_SV(NSV_C1R3BEG_A(KMI):NSV_C1R3END_A(KMI))=LHORELAX_SVC1R3 -! LIMA SV case -IF (CCLOUD == 'LIMA') & -LHORELAX_SV(NSV_LIMA_BEG_A(KMI):NSV_LIMA_END_A(KMI))=LHORELAX_SVLIMA -! Electrical SV case -IF (CELEC /= 'NONE') & -LHORELAX_SV(NSV_ELECBEG_A(KMI):NSV_ELECEND_A(KMI))=LHORELAX_SVELEC -! Chemical SV case -IF (LUSECHEM .OR. LCHEMDIAG) & -LHORELAX_SV(NSV_CHEMBEG_A(KMI):NSV_CHEMEND_A(KMI))=LHORELAX_SVCHEM -! Ice phase Chemical SV case -IF (LUSECHIC) & -LHORELAX_SV(NSV_CHICBEG_A(KMI):NSV_CHICEND_A(KMI))=LHORELAX_SVCHIC -! LINOX SV case -IF (.NOT.(LUSECHEM .OR. LCHEMDIAG) .AND. LCH_CONV_LINOX) & -LHORELAX_SV(NSV_LNOXBEG_A(KMI):NSV_LNOXEND_A(KMI))=LHORELAX_SVCHEM -! Dust SV case -IF (LDUST) & -LHORELAX_SV(NSV_DSTBEG_A(KMI):NSV_DSTEND_A(KMI))=LHORELAX_SVDST -! Sea Salt SV case -IF (LSALT) & -LHORELAX_SV(NSV_SLTBEG_A(KMI):NSV_SLTEND_A(KMI))=LHORELAX_SVSLT -! Aerosols SV case -IF (LORILAM) & -LHORELAX_SV(NSV_AERBEG_A(KMI):NSV_AEREND_A(KMI))=LHORELAX_SVAER -! Lagrangian variables -IF (LLG) & -LHORELAX_SV(NSV_LGBEG_A(KMI):NSV_LGEND_A(KMI))=LHORELAX_SVLG -! Passive pollutants -IF (LPASPOL) & -LHORELAX_SV(NSV_PPBEG_A(KMI):NSV_PPEND_A(KMI))=LHORELAX_SVPP -#ifdef MNH_FOREFIRE -! Fire pollutants -IF (LFOREFIRE) & -LHORELAX_SV(NSV_FFBEG_A(KMI):NSV_FFEND_A(KMI))=LHORELAX_SVFF -#endif -! Conditional sampling -IF (LCONDSAMP) & -LHORELAX_SV(NSV_CSBEG_A(KMI):NSV_CSEND_A(KMI))=LHORELAX_SVCS -! Blowing snow case -IF (LBLOWSNOW) & -LHORELAX_SV(NSV_SNWBEG_A(KMI):NSV_SNWEND_A(KMI))=LHORELAX_SVSNW -! Update NSV* variables for model KMI -CALL UPDATE_NSV(KMI) -! -! SET MINIMUN VALUE FOR DIFFERENT SV GROUPS -! -XSVMIN(1:NSV_USER_A(KMI))=0. -IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO' ) & -XSVMIN(NSV_C2R2BEG_A(KMI):NSV_C2R2END_A(KMI))=0. -IF (CCLOUD == 'C3R5') & -XSVMIN(NSV_C1R3BEG_A(KMI):NSV_C1R3END_A(KMI))=0. -IF (CCLOUD == 'LIMA') & -XSVMIN(NSV_LIMA_BEG_A(KMI):NSV_LIMA_END_A(KMI))=0. -IF (CELEC /= 'NONE') & -XSVMIN(NSV_ELECBEG_A(KMI):NSV_ELECEND_A(KMI))=0. -IF (LUSECHEM .OR. LCHEMDIAG) & -XSVMIN(NSV_CHEMBEG_A(KMI):NSV_CHEMEND_A(KMI))=0. -IF (LUSECHIC) & -XSVMIN(NSV_CHICBEG_A(KMI):NSV_CHICEND_A(KMI))=0. -IF (.NOT.(LUSECHEM .OR. LCHEMDIAG) .AND. LCH_CONV_LINOX) & -XSVMIN(NSV_LNOXBEG_A(KMI):NSV_LNOXEND_A(KMI))=0. -IF (LORILAM .OR. LCHEMDIAG) & -XSVMIN(NSV_AERBEG_A(KMI):NSV_AEREND_A(KMI))=0. -IF (LDUST) XSVMIN(NSV_DSTBEG_A(KMI):NSV_DSTEND_A(KMI))=XMNH_TINY -IF ((LDUST).AND.(LDEPOS_DST(KMI))) & -XSVMIN(NSV_DSTDEPBEG_A(KMI):NSV_DSTDEPEND_A(KMI))=XMNH_TINY -IF (LSALT) XSVMIN(NSV_SLTBEG_A(KMI):NSV_SLTEND_A(KMI))=XMNH_TINY -IF (LLG) THEN - XSVMIN(NSV_LGBEG_A(KMI)) =XLG1MIN - XSVMIN(NSV_LGBEG_A(KMI)+1)=XLG2MIN - XSVMIN(NSV_LGEND_A(KMI)) =XLG3MIN -ENDIF -IF ((LSALT).AND.(LDEPOS_SLT(KMI))) & -XSVMIN(NSV_SLTDEPBEG_A(KMI):NSV_SLTDEPEND_A(KMI))=XMNH_TINY -IF ((LORILAM).AND.(LDEPOS_AER(KMI))) & -XSVMIN(NSV_AERDEPBEG_A(KMI):NSV_AERDEPEND_A(KMI))=XMNH_TINY -IF (LPASPOL) XSVMIN(NSV_PPBEG_A(KMI):NSV_PPEND_A(KMI))=0. -#ifdef MNH_FOREFIRE -IF (LFOREFIRE) XSVMIN(NSV_FFBEG_A(KMI):NSV_FFEND_A(KMI))=0. -#endif -IF (LCONDSAMP) XSVMIN(NSV_CSBEG_A(KMI):NSV_CSEND_A(KMI))=0. -IF (LBLOWSNOW) XSVMIN(NSV_SNWBEG_A(KMI):NSV_SNWEND_A(KMI))=XMNH_TINY -! -! NAME OF THE SCALAR VARIABLES IN THE DIFFERENT SV GROUPS -! -IF (ALLOCATED(CSV)) DEALLOCATE(CSV) -ALLOCATE(CSV(NSV)) -CSV(:) = ' ' -IF (LLG) THEN - CSV(NSV_LGBEG_A(KMI) ) = 'X0 ' - CSV(NSV_LGBEG_A(KMI)+1) = 'Y0 ' - CSV(NSV_LGEND_A(KMI) ) = 'Z0 ' -ENDIF - -! Initialize scalar variable names for dust -IF ( LDUST ) THEN - IF ( NMODE_DST < 1 .OR. NMODE_DST > 3 ) CALL Print_msg( NVERB_FATAL, 'GEN', 'INI_NSV', 'NMODE_DST must in the 1 to 3 interval' ) - - ! Initialization of dust names - IF( .NOT. ALLOCATED( CDUSTNAMES ) ) THEN - IMOMENTS = ( NSV_DSTEND_A(KMI) - NSV_DSTBEG_A(KMI) + 1 ) / NMODE_DST - ALLOCATE( CDUSTNAMES(IMOMENTS * NMODE_DST) ) - !Loop on all dust modes - IF ( IMOMENTS == 1 ) THEN - DO JMODE = 1, NMODE_DST - IMODEIDX = JPDUSTORDER(JMODE) - JSV_NAME = ( IMODEIDX - 1 ) * 3 + 2 - CDUSTNAMES(JMODE) = YPDUST_INI(JSV_NAME) - END DO - ELSE - DO JMODE = 1,NMODE_DST - !Find which mode we are dealing with - IMODEIDX = JPDUSTORDER(JMODE) - DO JMOM = 1, IMOMENTS - !Find which number this is of the list of scalars - JSV = ( JMODE - 1 ) * IMOMENTS + JMOM - !Find what name this corresponds to, always 3 moments assumed in YPDUST_INI - JSV_NAME = ( IMODEIDX - 1) * 3 + JMOM - !Get the right CDUSTNAMES which should follow the list of scalars transported in XSVM/XSVT - CDUSTNAMES(JSV) = YPDUST_INI(JSV_NAME) - ENDDO ! Loop on moments - ENDDO ! Loop on dust modes - END IF - END IF - - ! Initialization of deposition scheme names - IF ( LDEPOS_DST(KMI) ) THEN - IF( .NOT. ALLOCATED( CDEDSTNAMES ) ) THEN - ALLOCATE( CDEDSTNAMES(NMODE_DST * 2) ) - DO JMODE = 1, NMODE_DST - IMODEIDX = JPDUSTORDER(JMODE) - CDEDSTNAMES(JMODE) = YPDEDST_INI(IMODEIDX) - CDEDSTNAMES(NMODE_DST + JMODE) = YPDEDST_INI(NMODE_DST + IMODEIDX) - ENDDO - END IF - END IF -END IF - -! Initialize scalar variable names for salt -IF ( LSALT ) THEN - IF ( NMODE_SLT < 1 .OR. NMODE_SLT > 8 ) CALL Print_msg( NVERB_FATAL, 'GEN', 'INI_NSV', 'NMODE_SLT must in the 1 to 8 interval' ) - - IF( .NOT. ALLOCATED( CSALTNAMES ) ) THEN - IMOMENTS = ( NSV_SLTEND_A(KMI) - NSV_SLTBEG_A(KMI) + 1 ) / NMODE_SLT - ALLOCATE( CSALTNAMES(IMOMENTS * NMODE_SLT) ) - !Loop on all dust modes - IF ( IMOMENTS == 1 ) THEN - DO JMODE = 1, NMODE_SLT - IMODEIDX = JPSALTORDER(JMODE) - JSV_NAME = ( IMODEIDX - 1 ) * 3 + 2 - CSALTNAMES(JMODE) = YPSALT_INI(JSV_NAME) - END DO - ELSE - DO JMODE = 1, NMODE_SLT - !Find which mode we are dealing with - IMODEIDX = JPSALTORDER(JMODE) - DO JMOM = 1, IMOMENTS - !Find which number this is of the list of scalars - JSV = ( JMODE - 1 ) * IMOMENTS + JMOM - !Find what name this corresponds to, always 3 moments assumed in YPSALT_INI - JSV_NAME = ( IMODEIDX - 1 ) * 3 + JMOM - !Get the right CSALTNAMES which should follow the list of scalars transported in XSVM/XSVT - CSALTNAMES(JSV) = YPSALT_INI(JSV_NAME) - ENDDO ! Loop on moments - ENDDO ! Loop on dust modes - END IF - END IF - ! Initialization of deposition scheme - IF ( LDEPOS_SLT(KMI) ) THEN - IF( .NOT. ALLOCATED( CDESLTNAMES ) ) THEN - ALLOCATE( CDESLTNAMES(NMODE_SLT * 2) ) - DO JMODE = 1, NMODE_SLT - IMODEIDX = JPSALTORDER(JMODE) - CDESLTNAMES(JMODE) = YPDESLT_INI(IMODEIDX) - CDESLTNAMES(NMODE_SLT + JMODE) = YPDESLT_INI(NMODE_SLT + IMODEIDX) - ENDDO - ENDIF - ENDIF -END IF - -! Initialize scalar variable names for snow -IF ( LBLOWSNOW ) THEN - IF( .NOT. ALLOCATED( CSNOWNAMES ) ) THEN - IMOMENTS = ( NSV_SNWEND_A(KMI) - NSV_SNWBEG_A(KMI) + 1 ) - ALLOCATE( CSNOWNAMES(IMOMENTS) ) - DO JMOM = 1, IMOMENTS - CSNOWNAMES(JMOM) = YPSNOW_INI(JMOM) - ENDDO ! Loop on moments - END IF -END IF - -!Fill CSVNAMES_A for model KMI -DO JSV = 1, NSV_USER_A(KMI) - WRITE( YNUM3, '( I3.3 )' ) JSV - CSVNAMES_A(JSV,KMI) = 'SVUSER'//YNUM3 -END DO - -DO JSV = NSV_C2R2BEG_A(KMI), NSV_C2R2END_A(KMI) - CSVNAMES_A(JSV,KMI) = TRIM( C2R2NAMES(JSV-NSV_C2R2BEG_A(KMI)+1) ) -END DO - -DO JSV = NSV_C1R3BEG_A(KMI), NSV_C1R3END_A(KMI) - CSVNAMES_A(JSV,KMI) = TRIM( C1R3NAMES(JSV-NSV_C1R3BEG_A(KMI)+1) ) -END DO - -DO JSV = NSV_LIMA_BEG_A(KMI), NSV_LIMA_END_A(KMI) - IF ( JSV == NSV_LIMA_NC_A(KMI) ) THEN - CSVNAMES_A(JSV,KMI) = TRIM( CLIMA_WARM_NAMES(1) ) - ELSE IF ( JSV == NSV_LIMA_NR_A(KMI) ) THEN - CSVNAMES_A(JSV,KMI) = TRIM( CLIMA_WARM_NAMES(2) ) - ELSE IF ( JSV >= NSV_LIMA_CCN_FREE_A(KMI) .AND. JSV < NSV_LIMA_CCN_ACTI_A(KMI) ) THEN - WRITE( YNUM2, '( I2.2 )' ) JSV - NSV_LIMA_CCN_FREE_A(KMI) + 1 - CSVNAMES_A(JSV,KMI) = TRIM( CLIMA_WARM_NAMES(3) ) // YNUM2 - ELSE IF (JSV >= NSV_LIMA_CCN_ACTI_A(KMI) .AND. JSV < ( NSV_LIMA_CCN_ACTI_A(KMI) + NMOD_CCN ) ) THEN - WRITE( YNUM2, '( I2.2 )' ) JSV - NSV_LIMA_CCN_ACTI_A(KMI) + 1 - CSVNAMES_A(JSV,KMI) = TRIM( CLIMA_WARM_NAMES(4) ) // YNUM2 - ELSE IF ( JSV == NSV_LIMA_SCAVMASS_A(KMI) ) THEN - CSVNAMES_A(JSV,KMI) = TRIM( CAERO_MASS(1) ) - ELSE IF ( JSV == NSV_LIMA_NI_A(KMI) ) THEN - CSVNAMES_A(JSV,KMI) = TRIM( CLIMA_COLD_NAMES(1) ) - ELSE IF ( JSV >= NSV_LIMA_IFN_FREE_A(KMI) .AND. JSV < NSV_LIMA_IFN_NUCL_A(KMI) ) THEN - WRITE( YNUM2, '( I2.2 )' ) JSV - NSV_LIMA_IFN_FREE_A(KMI) + 1 - CSVNAMES_A(JSV,KMI) = TRIM( CLIMA_COLD_NAMES(2) ) // YNUM2 - ELSE IF ( JSV >= NSV_LIMA_IFN_NUCL_A(KMI) .AND. JSV < ( NSV_LIMA_IFN_NUCL_A(KMI) + NMOD_IFN ) ) THEN - WRITE( YNUM2, '( I2.2 )' ) JSV - NSV_LIMA_IFN_NUCL_A(KMI) + 1 - CSVNAMES_A(JSV,KMI) = TRIM( CLIMA_COLD_NAMES(3) ) // YNUM2 - ELSE IF ( JSV >= NSV_LIMA_IMM_NUCL_A(KMI) .AND. JSV < ( NSV_LIMA_IMM_NUCL_A(KMI) + NMOD_IMM ) ) THEN - WRITE( YNUM2, '( I2.2 )' ) NINDICE_CCN_IMM(JSV-NSV_LIMA_IMM_NUCL_A(KMI)+1) - CSVNAMES_A(JSV,KMI) = TRIM( CLIMA_COLD_NAMES(4) ) // YNUM2 - ELSE IF ( JSV == NSV_LIMA_HOM_HAZE_A(KMI) ) THEN - CSVNAMES_A(JSV,KMI) = TRIM( CLIMA_COLD_NAMES(5) ) - ELSE IF ( JSV == NSV_LIMA_SPRO_A(KMI) ) THEN - CSVNAMES_A(JSV,KMI) = TRIM( CLIMA_WARM_NAMES(5) ) - ELSE - CALL Print_msg( NVERB_FATAL, 'GEN', 'INI_NSV', 'invalid index for LIMA' ) - END IF -END DO - -DO JSV = NSV_ELECBEG_A(KMI), NSV_ELECEND_A(KMI) - CSVNAMES_A(JSV,KMI) = TRIM( CELECNAMES(JSV-NSV_ELECBEG_A(KMI)+1) ) -END DO - -DO JSV = NSV_LGBEG_A(KMI), NSV_LGEND_A(KMI) - CSVNAMES_A(JSV,KMI) = TRIM( CLGNAMES(JSV-NSV_LGBEG_A(KMI)+1) ) -END DO - -DO JSV = NSV_PPBEG_A(KMI), NSV_PPEND_A(KMI) - WRITE( YNUM3, '( I3.3 )' ) JSV-NSV_PPBEG_A(KMI)+1 - CSVNAMES_A(JSV,KMI) = 'SVPP'//YNUM3 -END DO - -#ifdef MNH_FOREFIRE -DO JSV = NSV_FFBEG_A(KMI), NSV_FFEND_A(KMI) - WRITE( YNUM3, '( I3.3 )' ) JSV-NSV_FFBEG_A(KMI)+1 - CSVNAMES_A(JSV,KMI) = 'SVFF'//YNUM3 -END DO -#endif - -DO JSV = NSV_CSBEG_A(KMI), NSV_CSEND_A(KMI) - WRITE( YNUM3, '( I3.3 )' ) JSV-NSV_CSBEG_A(KMI) - CSVNAMES_A(JSV,KMI) = 'SVCS'//YNUM3 -END DO - -DO JSV = NSV_CHEMBEG_A(KMI), NSV_CHEMEND_A(KMI) - CSVNAMES_A(JSV,KMI) = TRIM( CNAMES(JSV-NSV_CHEMBEG_A(KMI)+1) ) -END DO - -DO JSV = NSV_CHICBEG_A(KMI), NSV_CHICEND_A(KMI) - CSVNAMES_A(JSV,KMI) = TRIM( CICNAMES(JSV-NSV_CHICBEG_A(KMI)+1) ) -END DO - -DO JSV = NSV_AERBEG_A(KMI), NSV_AEREND_A(KMI) - CSVNAMES_A(JSV,KMI) = TRIM( CAERONAMES(JSV-NSV_AERBEG_A(KMI)+1) ) -END DO - -DO JSV = NSV_AERDEPBEG_A(KMI), NSV_AERDEPEND_A(KMI) - CSVNAMES_A(JSV,KMI) = TRIM( CDEAERNAMES(JSV-NSV_AERDEPBEG_A(KMI)+1) ) -END DO - -DO JSV = NSV_DSTBEG_A(KMI), NSV_DSTEND_A(KMI) - CSVNAMES_A(JSV,KMI) = TRIM( CDUSTNAMES(JSV-NSV_DSTBEG_A(KMI)+1) ) -END DO - -DO JSV = NSV_DSTDEPBEG_A(KMI), NSV_DSTDEPEND_A(KMI) - CSVNAMES_A(JSV,KMI) = TRIM( CDEDSTNAMES(JSV-NSV_DSTDEPBEG_A(KMI)+1) ) -END DO - -DO JSV = NSV_SLTBEG_A(KMI), NSV_SLTEND_A(KMI) - CSVNAMES_A(JSV,KMI) = TRIM( CSALTNAMES(JSV-NSV_SLTBEG_A(KMI)+1) ) -END DO - -DO JSV = NSV_SLTDEPBEG_A(KMI), NSV_SLTDEPEND_A(KMI) - CSVNAMES_A(JSV,KMI) = TRIM( CDESLTNAMES(JSV-NSV_SLTDEPBEG_A(KMI)+1) ) -END DO - -DO JSV = NSV_SNWBEG_A(KMI), NSV_SNWEND_A(KMI) - CSVNAMES_A(JSV,KMI) = TRIM( CSNOWNAMES(JSV-NSV_SNWBEG_A(KMI)+1) ) -END DO - -DO JSV = NSV_LNOXBEG_A(KMI), NSV_LNOXEND_A(KMI) - WRITE( YNUM3, '( I3.3 )' ) JSV-NSV_LNOXBEG_A(KMI)+1 - CSVNAMES_A(JSV,KMI) = 'SVLNOX'//YNUM3 -END DO - -END SUBROUTINE INI_NSV diff --git a/src/ICCARE_BASE/ini_prog_var.f90 b/src/ICCARE_BASE/ini_prog_var.f90 deleted file mode 100644 index 24a1b3c83..000000000 --- a/src/ICCARE_BASE/ini_prog_var.f90 +++ /dev/null @@ -1,499 +0,0 @@ -!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!----------------------------------------------------------------- -! ######################## - MODULE MODI_INI_PROG_VAR -! ######################## -INTERFACE - SUBROUTINE INI_PROG_VAR(PTKE_MX, PSV_MX, HCHEMFILE) -! -REAL,DIMENSION(:,:,:), INTENT(IN) :: PTKE_MX -REAL,DIMENSION(:,:,:,:),INTENT(IN) :: PSV_MX -CHARACTER(LEN=*), INTENT(IN),OPTIONAL :: HCHEMFILE ! Name of the chem file -END SUBROUTINE INI_PROG_VAR -END INTERFACE -END MODULE MODI_INI_PROG_VAR -! -! ################################################### - SUBROUTINE INI_PROG_VAR(PTKE_MX, PSV_MX, HCHEMFILE) -! ################################################### -! -!!**** *INI_PROG_VAR* - initialization the prognostic variables not yet -!! initialized -!! -!! PURPOSE -!! ------- -!! -!! This routine initializes the scalar variables to zero. -!! This routine duplicates the values of a variable at t in MODD_FIELD1 -!! or MODD_LSFIELD1 in the variables at t. -!! -!!** METHOD -!! ------ -!! -!! EXTERNAL -!! -------- -!! -!! Routine PGDFILTER : to filter a 2D field. -!! Module MODI_PGDFILTER -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! Module MODD_CONF : contains configuration variables for all models. -!! NVERB : verbosity level for output-listing -!! Module MODD_LUNIT_n : contains logical unit names for all models -!! TLUOUT : name of output-listing -!! Module MODD_FIELD1 : contains the prognostic fields of model1 -!! XUM -!! XVM -!! XWM -!! XTHM -!! XRM -!! Module MODD_LSFIELD1 -!! XLSUM -!! XLSVM -!! XLSWM -!! XLSTHM -!! XLSRVM -!! Module MODD_DYN1 -!! NRIMX,NRIMY -!! -!! REFERENCE -!! --------- -!! -!! Book 2 -!! -!! AUTHOR -!! ------ -!! -!! V.Masson Meteo-France -!! -!! MODIFICATIONS -!! ------------- -!! Original 21/12/94 -!! 14/05/96 (V. Masson) filtering of LS fields -!! 08/01/97 (V. Masson) no filtering for boundaries on XLSWM -!! 10/07/97 (V. Masson) add tke and epsilon -!! 11/07/97 (V. Masson) add scalar variables -!! 20/01/98 (J. Stein ) add the lB fields + remove the 2Dx filter -!! 20/08/90 (J. Stein and P. Jabouille) add the SIZE of the LB -!! fields -!! 01/02/01 (D. Gazen) add module MODD_NSV for NSV variable -!! May 2006 Remove KEPS -!! 02/11/09 (M. Leriche) add aqueous phase chemistry -!! Oct 2010 (P. Tulet) input of chemical gas, dusts -!! and sea salts concentration from -!! another MesoNH simulation -!! Aug 2012 (J.-P. Chaboureau) read the chem-file descriptor -!! Fev 2015 (J.-P. Chaboureau) read instant T insteed of M -!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1 -!! Mai 2017 (M. Leriche) read aerosol namelists before call ini_nsv -!! Mai 2017 (M. Leriche) Get wet dep. sv in Meso-NH init file -!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O -! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list -! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables -! P. Wautelet 09/03/2021: simplify allocation of scalar variable names -! P. Wautelet 09/03/2021: move some chemistry initializations to ini_nsv -! P. Wautelet 10/03/2021: move scalar variable name initializations to ini_nsv -! P. Wautelet 10/03/2021: use scalar variable names for dust and salt -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -! -USE MODD_CH_AEROSOL -USE MODD_CH_M9_n, ONLY: NEQ, CNAMES -USE MODD_CH_MNHC_n, ONLY: LUSECHEM, LUSECHAQ, LUSECHIC, LCH_PH -USE MODD_CONF -USE MODD_CONF_n -USE MODD_DIM_n -USE MODD_DUST -USE MODD_DYN_n -use modd_field, only: TFIELDDATA, TYPEREAL -USE MODD_FIELD_n -USE MODD_IO, ONLY: TFILEDATA -USE MODD_LSFIELD_n -USE MODD_LUNIT -USE MODD_LUNIT_n, ONLY: TLUOUT -USE MODD_NSV -USE MODD_PARAM_n -USE MODD_PARAMETERS -USE MODD_SALT -USE MODD_TURB_n -!UPG*PT -USE MODD_REF_n, ONLY : XRHODREF -USE MODD_CH_AERO_n -!UPG*PT -! -USE MODE_IO_FIELD_READ, only: IO_Field_read -USE MODE_IO_FILE, ONLY: IO_File_close, IO_File_open -USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list -USE MODE_MODELN_HANDLER -USE MODE_MSG -USE MODE_POS -!UPG*PT -USE MODE_DUST_PSD -USE MODE_SALT_PSD -!UPG*PT -use mode_tools_ll, only: GET_INDICE_ll -! -USE MODI_PGDFILTER -! -USE MODN_CH_ORILAM -USE MODN_DUST -USE MODN_SALT -! -IMPLICIT NONE -! -!* 0.1 declaration of arguments -! -REAL,DIMENSION(:,:,:), INTENT(IN) :: PTKE_MX -REAL,DIMENSION(:,:,:,:),INTENT(IN) :: PSV_MX -CHARACTER(LEN=*), INTENT(IN),OPTIONAL :: HCHEMFILE ! Name of the chem file -! -!* 0.2 declaration of local variables -! -INTEGER :: ILUOUT -INTEGER :: IRESP -! -INTEGER :: IIMAX,IJMAX,IKMAX ! Dimensions of the chem file -INTEGER :: IMI ! model number -INTEGER :: IIB,IIE,IIU -INTEGER :: IJB,IJE,IJU -INTEGER :: IIU_ll, IJU_ll -INTEGER :: IKU -INTEGER :: ILBX,ILBY -INTEGER :: JSV ! Loop index -INTEGER :: JMOM, IMOMENTS, JMODE, ISV_NAME_IDX, IMODEIDX ! dust and salt modes -INTEGER :: ILUDES ! logical unit numbers of DESFM file -LOGICAL :: GFOUND ! Return code when searching namelist -TYPE(TFIELDDATA) :: TZFIELD -TYPE(TFILEDATA),POINTER :: TZCHEMFILE => NULL() -!------------------------------------------------------------------------------- -! -! get model index -IMI = GET_CURRENT_MODEL_INDEX() -! -ILUOUT = TLUOUT%NLU -! -CALL GET_INDICE_ll (IIB,IJB,IIE,IJE) -IIU=SIZE(XWT,1) -IJU=SIZE(XWT,2) -IKU=SIZE(XWT,3) -IIU_ll=NIMAX_ll + 2 * JPHEXT -IJU_ll=NJMAX_ll + 2 * JPHEXT -!------------------------------------------------------------------------------- -! -!* 1. TURBULENCE FIELDS -! ----------------- -! -ALLOCATE(XTKET(0,0,0)) -ALLOCATE(XSRCT(0,0,0)) -IF (CTURB=='TKEL' ) THEN - ALLOCATE(XTKET(IIU,IJU,IKU)) - XTKET(:,:,:)=PTKE_MX(:,:,:) - IF (NRR>1) THEN - ALLOCATE(XSRCT(IIU,IJU,IKU)) - ALLOCATE(XSIGS(IIU,IJU,IKU)) - WHERE (XRT(:,:,:,2)>1.E-10) - XSRCT(:,:,:)=1. - ELSEWHERE - XSRCT(:,:,:)=0. - END WHERE - XSIGS(:,:,:)=0. - ELSE - ALLOCATE(XSRCT(0,0,0)) - ALLOCATE(XSIGS(0,0,0)) - END IF -ELSE - ALLOCATE(XTKET(0,0,0)) - ALLOCATE(XSRCT(0,0,0)) - ALLOCATE(XSIGS(0,0,0)) -END IF -! -! -!------------------------------------------------------------------------------- -! -!* 3. PASSIVE SCALAR -! -------------- -! -ALLOCATE(XSVT(0,0,0,0)) -IF(PRESENT(HCHEMFILE)) THEN - WRITE(ILUOUT,*) 'Routine INI_PROG_VAR: CHEMical species read in ',TRIM(HCHEMFILE) - ! Read dimensions in chem file and checks with output file - CALL IO_File_add2list(TZCHEMFILE,TRIM(HCHEMFILE),'MNH','READ',KLFITYPE=2,KLFIVERB=NVERB) - CALL IO_File_open(TZCHEMFILE) - ! - ILUDES = TZCHEMFILE%TDESFILE%NLU - ! - CALL IO_Field_read(TZCHEMFILE,'IMAX',IIMAX,IRESP) - IF (IRESP/=0) THEN - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_PROG_VAR','IMAX not found in the CHEM file '//TRIM(HCHEMFILE)) - END IF !IRESP - ! - CALL IO_Field_read(TZCHEMFILE,'JMAX',IJMAX,IRESP) - IF (IRESP/=0) THEN -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_PROG_VAR','JMAX not found in the CHEM file '//TRIM(HCHEMFILE)) - END IF !IRESP - ! - CALL IO_Field_read(TZCHEMFILE,'KMAX',IKMAX,IRESP) - IF (IRESP/=0) THEN -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_PROG_VAR','KMAX not found in the CHEM file '//TRIM(HCHEMFILE)) - END IF !IRESP - IF ( (IIMAX/=(IIU_ll-2*JPHEXT)) .OR. (IJMAX/=(IJU_ll-2*JPHEXT)) & - .OR. (IKMAX/=(IKU-2*JPVEXT)) ) THEN - WRITE(ILUOUT,*) 'THE GRIDS ARE DIFFERENT IN THE OUTPUT FILE :' - WRITE(ILUOUT,*) IIU_ll-2*JPHEXT,'*',IJU_ll-2*JPHEXT,'*',IKU-2*JPVEXT - WRITE(ILUOUT,*) 'AND IN THE CHEM FILE :',HCHEMFILE - WRITE(ILUOUT,*) IIMAX,'*',IJMAX,'*',IKMAX - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_PROG_VAR','') - END IF ! IIMAX -!! UPG*PT pourquoi LDUST intervient ici ?? -!! IF (.NOT.LDUST) THEN - LUSECHEM = .TRUE. -!! END IF - IF (LORILAM) THEN - CALL POSNAM(ILUDES,'NAM_CH_ORILAM',GFOUND,ILUOUT) - IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_CH_ORILAM) - ENDIF - IF (LDUST) THEN - LDSTINIT=.TRUE. - LDSTPRES=.FALSE. - CALL POSNAM(ILUDES,'NAM_DUST',GFOUND,ILUOUT) - IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_DUST) - ENDIF - IF (LSALT) THEN - LSLTINIT=.TRUE. - LSLTPRES=.FALSE. - CALL POSNAM(ILUDES,'NAM_SALT',GFOUND,ILUOUT) - IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_SALT) - ! initialise NSV_* variables - ENDIF - CALL INI_NSV(IMI) - ALLOCATE(XSVT(IIU,IJU,IKU,NSV)) - - ! Read scalars in chem file -!! UPG*PT ??? -!! IF (.NOT.LDUST) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppp' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_CHEMBEG,NSV_CHEMEND - TZFIELD%CMNHNAME = TRIM(CNAMES(JSV-NSV_CHEMBEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - CALL IO_Field_read(TZCHEMFILE,TZFIELD,XSVT(:,:,:,JSV),IRESP) - IF (IRESP/=0) THEN - WRITE(ILUOUT,*) TRIM(TZFIELD%CMNHNAME),' NOT FOUND IN THE CHEM FILE ',HCHEMFILE - XSVT(:,:,:,JSV) = 0. - END IF !IRESP - END DO ! JSV - IF (ALL(XSVT(:,:,:,NSV_CHEMBEG:NSV_CHEMEND) == 0.)) THEN - LUSECHEM=.FALSE. - NEQ = 0 - END IF -!! END IF - - IF (LORILAM) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppp' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_AERBEG,NSV_AEREND - TZFIELD%CMNHNAME = TRIM(CAERONAMES(JSV-NSV_AERBEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - CALL IO_Field_read(TZCHEMFILE,TZFIELD,XSVT(:,:,:,JSV),IRESP) - IF (IRESP/=0) THEN - WRITE(ILUOUT,*) TRIM(TZFIELD%CMNHNAME),'NOT FOUND IN THE CHEM FILE ',HCHEMFILE - LORILAM=.FALSE. - END IF !IRESP - END DO ! JSV - ! - IF (LDEPOS_AER(IMI)) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppp' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_AERDEPBEG,NSV_AERDEPEND - TZFIELD%CMNHNAME = TRIM(CDEAERNAMES(JSV-NSV_AERDEPBEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - CALL IO_Field_read(TZCHEMFILE,TZFIELD,XSVT(:,:,:,JSV),IRESP) - IF (IRESP/=0) THEN - WRITE(ILUOUT,*) TRIM(TZFIELD%CMNHNAME),'NOT FOUND IN THE CHEM FILE ',HCHEMFILE - LDEPOS_AER(IMI)=.FALSE. - END IF !IRESP - END DO ! JSV - END IF ! ldepos_aer - - END IF ! lorilam - - IF (LDUST) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppp' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_DSTBEG, NSV_DSTEND - TZFIELD%CMNHNAME = TRIM(CDUSTNAMES(JSV-NSV_DSTBEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - CALL IO_Field_read(TZCHEMFILE,TZFIELD,XSVT(:,:,:,JSV),IRESP) - IF (IRESP/=0) THEN - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_PROG_VAR',TRIM(TZFIELD%CMNHNAME)//' not found in the CHEM file '//TRIM(HCHEMFILE)) - END IF !IRESP - END DO ! JSV - - IF (LDEPOS_DST(IMI)) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppp' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_DSTDEPBEG,NSV_DSTDEPEND - TZFIELD%CMNHNAME = TRIM(CDEDSTNAMES(JSV-NSV_DSTDEPBEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - CALL IO_Field_read(TZCHEMFILE,TZFIELD,XSVT(:,:,:,JSV),IRESP) - IF (IRESP/=0) THEN - WRITE(ILUOUT,*) TRIM(TZFIELD%CMNHNAME),'NOT FOUND IN THE CHEM FILE ',HCHEMFILE - LDEPOS_DST(IMI)=.FALSE. - END IF !IRESP - END DO ! JSV - END IF ! ldepos_dst - END IF ! LDUST - - IF (LSALT) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppp' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_SLTBEG, NSV_SLTEND - TZFIELD%CMNHNAME = TRIM(CSALTNAMES(JSV-NSV_SLTBEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - CALL IO_Field_read(TZCHEMFILE,TZFIELD,XSVT(:,:,:,JSV),IRESP) - IF (IRESP/=0) THEN - CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_PROG_VAR',TRIM(TZFIELD%CMNHNAME)//' not found in the CHEM file '//TRIM(HCHEMFILE)) - END IF !IRESP - END DO ! JSV - ! - IF (LDEPOS_SLT(IMI)) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppp' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_SLTDEPBEG,NSV_SLTDEPEND - TZFIELD%CMNHNAME = TRIM(CDESLTNAMES(JSV-NSV_SLTDEPBEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - CALL IO_Field_read(TZCHEMFILE,TZFIELD,XSVT(:,:,:,JSV),IRESP) - IF (IRESP/=0) THEN - WRITE(ILUOUT,*) TRIM(TZFIELD%CMNHNAME),'NOT FOUND IN THE CHEM FILE ',HCHEMFILE - LDEPOS_SLT(IMI)=.FALSE. - END IF !IRESP - END DO ! JSV - ENDIF ! ldepos_slt - END IF ! LSALT - ! - CALL IO_File_close(TZCHEMFILE) - ! -ELSE ! HCHEMFILE - IF (NSV >=1) THEN - ALLOCATE(XSVT(IIU,IJU,IKU,NSV)) - XSVT(:,:,:,:)=PSV_MX(:,:,:,:) - ELSE !NSV - ALLOCATE(XSVT(0,0,0,0)) - END IF ! NSV -ENDIF ! HCHEMFILE -!------------------------------------------------------------------------------- -! -!* 4. 2D LARGE SCALE FIELDS FOR LBC -! ----------------------------- -! -! -IF (CTURB /= 'NONE') THEN - IF ( LHORELAX_TKE) THEN - ALLOCATE(XLBXTKEM(2*NRIMX+2*JPHEXT,IJU,IKU)) - ALLOCATE(XLBYTKEM(IIU,2*NRIMY+2*JPHEXT,IKU)) - ELSE - ALLOCATE(XLBXTKEM(2*JPHEXT,IJU,IKU)) - ALLOCATE(XLBYTKEM(IIU,2*JPHEXT,IKU)) - END IF - ! - ILBX=SIZE(XLBXTKEM,1)/2-JPHEXT - XLBXTKEM(1:ILBX+JPHEXT,:,:) = XTKET(1:ILBX+JPHEXT,:,:) - XLBXTKEM(ILBX+JPHEXT+1:2*ILBX+2*JPHEXT,:,:) = XTKET(IIE+1-ILBX:IIE+JPHEXT,:,:) - ILBY=SIZE(XLBYTKEM,2)/2-JPHEXT - XLBYTKEM(:,1:ILBY+JPHEXT,:) = XTKET(:,1:ILBY+JPHEXT,:) - XLBYTKEM(:,ILBY+JPHEXT+1:2*ILBY+2*JPHEXT,:) = XTKET(:,IJE+1-ILBY:IJE+JPHEXT,:) -ELSE - ALLOCATE(XLBXTKEM(0,0,0)) - ALLOCATE(XLBYTKEM(0,0,0)) -END IF -! -IF ( NSV > 0 ) THEN - IF ( ANY( LHORELAX_SV(:)) ) THEN - ALLOCATE(XLBXSVM(2*NRIMX+2*JPHEXT,IJU,IKU,NSV)) - ALLOCATE(XLBYSVM(IIU,2*NRIMY+2*JPHEXT,IKU,NSV)) - ELSE - ALLOCATE(XLBXSVM(2*JPHEXT,IJU,IKU,NSV)) - ALLOCATE(XLBYSVM(IIU,2*JPHEXT,IKU,NSV)) - END IF - ! - ILBX=SIZE(XLBXSVM,1)/2-JPHEXT - XLBXSVM(1:ILBX+JPHEXT,:,:,:) = XSVT(1:ILBX+JPHEXT,:,:,:) - XLBXSVM(ILBX+JPHEXT+1:2*ILBX+2*JPHEXT,:,:,:) = XSVT(IIE+1-ILBX:IIE+JPHEXT,:,:,:) - ILBY=SIZE(XLBYSVM,2)/2-JPHEXT - XLBYSVM(:,1:ILBY+JPHEXT,:,:) = XSVT(:,1:ILBY+JPHEXT,:,:) - XLBYSVM(:,ILBY+JPHEXT+1:2*ILBY+2*JPHEXT,:,:) = XSVT(:,IJE+1-ILBY:IJE+JPHEXT,:,:) -ELSE - ALLOCATE(XLBXSVM(0,0,0,0)) - ALLOCATE(XLBYSVM(0,0,0,0)) -END IF -! -! -NSIZELBXTKE_ll=SIZE(XLBXTKEM,1) -NSIZELBYTKE_ll=SIZE(XLBYTKEM,2) -NSIZELBXSV_ll =SIZE(XLBXSVM,1) -NSIZELBYSV_ll =SIZE(XLBYSVM,2) -! -!------------------------------------------------------------------------------- -! -END SUBROUTINE INI_PROG_VAR diff --git a/src/ICCARE_BASE/init_megann.F90 b/src/ICCARE_BASE/init_megann.F90 deleted file mode 100644 index 6996a37b1..000000000 --- a/src/ICCARE_BASE/init_megann.F90 +++ /dev/null @@ -1,486 +0,0 @@ -!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -! ############################### -SUBROUTINE INIT_MEGAN_n(IO, S, K, NP, MSF, MGN, PLAT, HSV, PMEGAN_FIELDS) -! ############################### -!! -!!*** *BVOCEM* -!! -!! PURPOSE -!! ------- -!! Calculate the biogenic emission fluxes upon the MEGAN code -!! http://lar.wsu.edu/megan/ -!! -!! METHOD -!! ------ -!! -!! -!! AUTHOR -!! ------ -!! P. Tulet (LACy) -!! -!! MODIFICATIONS -!! ------------- -!! Original: 25/10/14 -!! Modified: 06/2017, J. Pianezze, adaptation for SurfEx v8.0 -!! Modified: 06/2018, P. Tulet, add PFT and LAI -!! -!! -!! EXTERNAL -!! -------- -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -! -USE MODD_MEGAN_SURF_FIELDS_n, ONLY : MEGAN_SURF_FIELDS_t -USE MODD_MEGAN_n, ONLY : MEGAN_t -! -USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t -USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_P_t, ISBA_K_t, ISBA_NP_t -! -USE MODD_DATA_COVER_PAR -! -USE MODD_SURF_PAR, ONLY : XUNDEF -USE MODD_DATA_COVER, ONLY : XDATA_LAI -! -USE MODI_VEGTYPE_TO_PATCH -#ifdef MNH_MEGAN -USE MODD_MEGAN -USE MODI_INIT_MGN2MECH -#endif -USE MODI_ABOR1_SFX -! -! -!------------------------------------------------------------------------------ -! -!* 0. DECLARATIONS -! ----------------- -! -IMPLICIT NONE -! -TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO -TYPE(ISBA_S_t), INTENT(INOUT) :: S -TYPE(ISBA_K_t), INTENT(INOUT) :: K -TYPE(ISBA_NP_t), INTENT(INOUT) :: NP -TYPE(MEGAN_SURF_FIELDS_t), INTENT(INOUT) :: MSF -TYPE(MEGAN_t), INTENT(INOUT) :: MGN -! -!* 0.1 declaration of arguments -! -REAL, DIMENSION(:), INTENT(IN) :: PLAT ! Lat of the grid cell -CHARACTER(LEN=6), DIMENSION(:),INTENT(IN) :: HSV ! name of all scalar variables -REAL, DIMENSION(:,:),INTENT(IN) :: PMEGAN_FIELDS ! EF factors -! -!* 0.1 Declaration of local variables -#ifdef MNH_MEGAN -! -INTEGER :: JI, JSV, JP -! -INTEGER:: IP_TRBE, IP_TRBD, IP_TEBE, IP_TEBD, IP_TENE, & - IP_BOBD, IP_BONE, IP_BOND, IP_SHRB -! -REAL, DIMENSION(SIZE(K%XCLAY,1),IO%NPATCH) :: ZH_TREE -REAL,DIMENSION(SIZE(K%XCLAY,1)) :: ZSILT -REAL,DIMENSION(SIZE(K%XCLAY,1)) :: ZLAI -! -!IF (.NOT.IO%LTR_ML) THEN -! CALL ABOR1_SFX('INIT_MEGANN: FATAL ERROR PUT LTR_ML = T in NAM_ISBA (PREP_PGD step)') -!END IF -! -ALLOCATE(MGN%XPFT (N_MGN_PFT,SIZE(K%XCLAY,1))) -ALLOCATE(MGN%XEF (N_MGN_SPC,SIZE(K%XCLAY,1))) -ALLOCATE(MGN%XLAI (SIZE(K%XCLAY,1))) -ALLOCATE(MGN%NSLTYP (SIZE(K%XCLAY,1))) -ALLOCATE(MGN%XBIOFLX(SIZE(K%XCLAY,1))) -ALLOCATE(MGN%XT24(SIZE(K%XCLAY,1))) -ALLOCATE(MGN%XPPFD24(SIZE(K%XCLAY,1))) -MGN%XBIOFLX(:) = 0. -MGN%XT24(:) = MGN%XDAILYTEMP -MGN%XPPFD24(:) = MGN%XDAILYPAR - -! -! Prepare the mechanism conversion between Megan and MesoNH -MGN%CMECHANISM = "RELACS2" ! scheme default in MesoNH -! -DO JSV=1,SIZE(HSV) - IF (TRIM(HSV(JSV))=="DIEN") MGN%CMECHANISM = "RACM" - IF (TRIM(HSV(JSV))=="ALKA") MGN%CMECHANISM = "RELACS" - IF (TRIM(HSV(JSV))=="ALKA") MGN%CMECHANISM = "RELACS" - IF (TRIM(HSV(JSV))=="OLEH") MGN%CMECHANISM = "CACM" - IF (TRIM(HSV(JSV))=="URG7") MGN%CMECHANISM = "RELACS2" -END DO -! -IF (TRIM(MGN%CMECHANISM)=="RACM" .OR.TRIM(MGN%CMECHANISM)=="RADM2".OR.TRIM(MGN%CMECHANISM)=="SAPRCII" .OR.& - TRIM(MGN%CMECHANISM)=="SAPRC99" .OR.TRIM(MGN%CMECHANISM)=="CBMZ" .OR.TRIM(MGN%CMECHANISM)=="SAPRC99X".OR.& - TRIM(MGN%CMECHANISM)=="SAPRC99Q".OR.TRIM(MGN%CMECHANISM)=="CB05" .OR.TRIM(MGN%CMECHANISM)=="CB6" .OR.& - TRIM(MGN%CMECHANISM)=="SOAX") THEN - MGN%CMECHANISM2 = MGN%CMECHANISM -ELSE - MGN%CMECHANISM2 = "SAPRC99" ! megan default -END IF -! -MGN%LCONVERSION = .TRUE. -! -CALL INIT_MGN2MECH(MGN%CMECHANISM2, MGN%LCONVERSION, MGN%CVNAME3D, MGN%CMECH_SPC, MGN%NSPMH_MAP, & - MGN%NMECH_MAP, MGN%XCONV_FAC, MGN%XMECH_MWT, MGN%NVARS3D, MGN%N_SCON_SPC ) -! -DO JSV=1,SIZE(HSV) - IF (TRIM(HSV(JSV)) == "NO") MGN%NNO = JSV ! ReLACS - IF (TRIM(HSV(JSV)) == "ALD") MGN%NALD = JSV ! ReLACS - IF (TRIM(HSV(JSV)) == "BIO") MGN%NBIO = JSV ! ReLACS - IF (TRIM(HSV(JSV)) == "ALKA") MGN%NALKA = JSV ! ReLACS - IF (TRIM(HSV(JSV)) == "ALKE") MGN%NALKE = JSV ! ReLACS - IF (TRIM(HSV(JSV)) == "ARO") MGN%NARO = JSV ! ReLACS - IF (TRIM(HSV(JSV)) == "CARBO") MGN%NCARBO = JSV ! ReLACS - ! - IF (TRIM(HSV(JSV)) == "ETHE") MGN%NETHE = JSV ! ReLACS2 or CACM - IF (TRIM(HSV(JSV)) == "OLEL") MGN%NOLEL = JSV ! ReLACS2 or CACM - IF (TRIM(HSV(JSV)) == "OLEH") MGN%NOLEH = JSV ! ReLACS2 or CACM - IF (TRIM(HSV(JSV)) == "ALKL") MGN%NALKL = JSV ! ReLACS2 or CACM - IF (TRIM(HSV(JSV)) == "ALKM") MGN%NALKM = JSV ! ReLACS2 or CACM - IF (TRIM(HSV(JSV)) == "ALKH") MGN%NALKH = JSV ! ReLACS2 or CACM - IF (TRIM(HSV(JSV)) == "AROH") MGN%NAROH = JSV ! ReLACS2 or CACM - IF (TRIM(HSV(JSV)) == "AROL") MGN%NAROL = JSV ! ReLACS2 or CACM - IF (TRIM(HSV(JSV)) == "AROO") MGN%NAROO = JSV ! ReLACS2 or CACM - IF (TRIM(HSV(JSV)) == "AROL") MGN%NAROL = JSV ! ReLACS2 or CACM - IF (TRIM(HSV(JSV)) == "ARAL") MGN%NARAL = JSV ! ReLACS2 or CACM - IF (TRIM(HSV(JSV)) == "ARAC") MGN%NARAC = JSV ! ReLACS2 or CACM - IF (TRIM(HSV(JSV)) == "PAH") MGN%NPAH = JSV ! ReLACS2 or CACM - IF (TRIM(HSV(JSV)) == "ALD2") MGN%NALD2 = JSV ! ReLACS2 or CACM - IF (TRIM(HSV(JSV)) == "KETL") MGN%NKETL = JSV ! ReLACS2 or CACM - IF (TRIM(HSV(JSV)) == "KETH") MGN%NKETH = JSV ! ReLACS2 or CACM - IF (TRIM(HSV(JSV)) == "MEOH") MGN%NMEOH = JSV ! ReLACS2 or CACM - IF (TRIM(HSV(JSV)) == "ETOH") MGN%NETOH = JSV ! ReLACS2 or CACM - IF (TRIM(HSV(JSV)) == "ALCH") MGN%NALCH = JSV ! ReLACS2 or CACM - IF (TRIM(HSV(JSV)) == "ISOP") MGN%NISOP = JSV ! ReLACS2 or CACM - IF (TRIM(HSV(JSV)) == "BIOL") MGN%NBIOL = JSV ! ReLACS2 or CACM - IF (TRIM(HSV(JSV)) == "BIOH") MGN%NBIOH = JSV ! ReLACS2 or CACM - IF (TRIM(HSV(JSV)) == "MTBE") MGN%NMTBE = JSV ! ReLACS2 or CACM - IF (TRIM(HSV(JSV)) == "MVK") MGN%NMVK = JSV ! ReLACS2 or CACM - IF (TRIM(HSV(JSV)) == "MCR") MGN%NMCR = JSV ! ReLACS2 or CACM - IF (TRIM(HSV(JSV)) == "MGLY") MGN%NMGLY = JSV ! ReLACS2 or CACM - IF (TRIM(HSV(JSV)) == "ACID") MGN%NACID = JSV ! ReLACS2 or CACM - IF (TRIM(HSV(JSV)) == "ORA1") MGN%NORA1 = JSV ! ReLACS2 or CACM - IF (TRIM(HSV(JSV)) == "ORA2") MGN%NORA2 = JSV ! ReLACS2 or CACM -END DO -! -DO JSV=1,SIZE(MGN%CVNAME3D) ! megan species (racm family) - IF (TRIM(MGN%CVNAME3D(JSV)) == "ISO") MGN%NISO = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "CH4") MGN%NCH4 = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "ETH") MGN%NETH = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "HC3") MGN%NHC3 = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "HC5") MGN%NHC5 = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "HC8") MGN%NHC8 = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "OL2") MGN%NOL2 = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "OLI") MGN%NOLI = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "OLT") MGN%NOLT = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "ALD") MGN%NALD = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "KET") MGN%NKET = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "TOL") MGN%NTOL = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "HCHO") MGN%NHCHO = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "ORA1") MGN%NORA1 = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "ORA2") MGN%NORA2 = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "API") MGN%NAPI = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "LIM") MGN%NLIM = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "CO") MGN%NCO = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "SO2") MGN%NSO2 = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "NO") MGN%NNO = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "HNO3") MGN%NHNO3 = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "NO2") MGN%NNO2 = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "NR") MGN%NNR = JSV -END DO -! -DO JSV=1,SIZE(MGN%CVNAME3D) ! megan species (soax family) - IF (TRIM(MGN%CVNAME3D(JSV)) == "ISP") MGN%NISP = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "TRP") MGN%NTRP = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "XYLA") MGN%NXYLA = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "CG5") MGN%NCG5 = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "SQT") MGN%NSQT = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "TOLA") MGN%NTOLA = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "CG6") MGN%NCG6 = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "CG4") MGN%NCG4 = JSV -END DO -! -DO JSV=1,SIZE(MGN%CVNAME3D) !megan species (saprc family) - IF (TRIM(MGN%CVNAME3D(JSV)) == "ISOPRENE") MGN%NISOPRENE = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "TRP1") MGN%NTRP1 = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "ACET") MGN%NACET = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "MEK") MGN%NMEK = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "HCOOH") MGN%NHCOOH = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "CCO_OH") MGN%NCCO_OH = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "CCHO") MGN%NCCHO = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "RCHO") MGN%NRCHO = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "RCO_OH") MGN%NRCO_OH = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "BALD") MGN%NBALD = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "ETHENE") MGN%NETHENE = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "ALK4") MGN%NALK4 = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "ALK5") MGN%NALK5 = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "ARO1") MGN%NARO1 = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "ARO2") MGN%NARO2 = JSV - IF (TRIM(MGN%CVNAME3D(JSV)) == "OLE1") MGN%NOLE1 = JSV -END DO -! -! Compute soil USDA type -! -! CLAY : CLAY >= 0.40 SILT < 0.40 SAND < 0.45 -! SANDY CLAY : CLAY >= 0.36 SAND >= 0.45 -! SILTY CLAY : CLAY >= 0.40 SILT >= 0.40 -! SILT : SILT >= 0.8 CLAY < 0.12 -! SAND : SAND >= 0.3*CLAY + 0.87 -! SANDY CLAY LOAM : CLAY >= 0.28 CLAY < 0.36 SAND >= 0.45 | CLAY >= 0.20 CLAY < 0.28 SILT < 0.28 -! SILTY CLAY LOAM : CLAY >= 0.28 CLAY < 0.40 SAND < 0.20 -! CLAY LOAM : CLAY >= 0.28 CLAY < 0.40 SAND >= 0.20 SAND < 0.45 -! SILT LOAM : SILT >= 0.8 CLAY >= 0.12 | SILT >= 0.5 SILT < 0.8 CLAY < 0.28 -! LOAMY SAND : SAND >= CLAY + 0.7 SAND < 0.3*CLAY + 0.87 -! SANDY LOAM : SAND >= 0.52 CLAY < 0.20 | SAND >= (0.5 - CLAY) CLAY < 0.07 -! LOAM : CLAY >= 0.20 CLAY < 0.28 SILT >= 0.28 SILT < 0.5 | SAND >= (0.5 - CLAY) CLAY < 0.20 -! -ZSILT(:) = 1. - K%XCLAY(:,1) - K%XSAND(:,1) -! -WHERE (ZSILT(:) <= 0.) ZSILT(:) = 0.0 -! -DO JI = 1, SIZE(K%XCLAY,1) - - IF ( K%XCLAY(JI,1)>=0.28 ) THEN - IF ( K%XSAND(JI,1)>=0.45 ) THEN - IF (K%XCLAY(JI,1)>=0.36 ) THEN ! Sandy Clay - MGN%NSLTYP(JI) = 9 - ELSE ! Sandy Clay Loam - MGN%NSLTYP(JI) = 6 - ENDIF - ELSEIF ( K%XCLAY(JI,1)>=0.40 ) THEN - IF ( ZSILT(JI)>=0.40 ) THEN ! Silty Clay - MGN%NSLTYP(JI) = 10 - ELSE ! Clay - MGN%NSLTYP(JI) = 11 - ENDIF - ELSEIF (K%XSAND(JI,1)>=0.20 ) THEN ! Clay Loam - MGN%NSLTYP(JI) = 8 - ELSE ! Silty Clay Loam - MGN%NSLTYP(JI) = 7 - ENDIF - ENDIF - ! - IF ( ZSILT(JI)>=0.8 .AND. K%XCLAY(JI,1)<0.12 ) THEN ! Silt - MGN%NSLTYP(JI) = 12 - ELSEIF ( K%XCLAY(JI,1)<0.28 ) THEN ! ( clay est forcément < 0.28 ) - IF ( ZSILT(JI) >= 0.5 ) THEN ! Silt Loam - MGN%NSLTYP(JI) = 4 - ELSEIF ( K%XCLAY(JI,1)>=0.20 ) THEN - IF ( ZSILT(JI)>=0.28 ) THEN ! Loam - MGN%NSLTYP(JI) = 5 - ELSE ! Sandy Clay Loam - MGN%NSLTYP(JI) = 6 - ENDIF - ENDIF - ENDIF - ! - IF ( K%XSAND(JI,1)>=(0.3*K%XCLAY(JI,1) + 0.87) ) THEN ! Sand - MGN%NSLTYP(JI) = 1 - ELSEIF ( K%XSAND(JI,1)>=(K%XCLAY(JI,1) + 0.7) ) THEN ! Loamy Sand - MGN%NSLTYP(JI) = 2 - ELSEIF ( K%XSAND(JI,1)>=0.52 .AND. K%XCLAY(JI,1)<0.20 ) THEN ! Sandy Loam - MGN%NSLTYP(JI) = 3 - ELSEIF ( K%XSAND(JI,1)>=(0.5 - K%XCLAY(JI,1)) ) THEN - IF ( K%XCLAY(JI,1)<0.07 ) THEN ! Sandy Loam - MGN%NSLTYP(JI) = 3 - ELSEIF ( K%XCLAY(JI,1)<0.20 ) THEN ! Loam - MGN%NSLTYP(JI) = 5 - ENDIF - ENDIF - ! -ENDDO -! -! Passage des type de végétation isba/vegtype avec ceux de Megan -! -IP_TRBE = VEGTYPE_TO_PATCH(NVT_TRBE, IO%NPATCH) -IP_TRBD = VEGTYPE_TO_PATCH(NVT_TRBD, IO%NPATCH) -IP_TEBE = VEGTYPE_TO_PATCH(NVT_TEBE, IO%NPATCH) -IP_TEBD = VEGTYPE_TO_PATCH(NVT_TEBD, IO%NPATCH) -IP_TENE = VEGTYPE_TO_PATCH(NVT_TENE, IO%NPATCH) -IP_BOBD = VEGTYPE_TO_PATCH(NVT_BOBD, IO%NPATCH) -IP_BONE = VEGTYPE_TO_PATCH(NVT_BONE, IO%NPATCH) -IP_BOND = VEGTYPE_TO_PATCH(NVT_BOND, IO%NPATCH) -IP_SHRB = VEGTYPE_TO_PATCH(NVT_SHRB, IO%NPATCH) -! -MGN%XPFT(:,:) = 0. -! -ZH_TREE(:,:) = XUNDEF -DO JP = 1,IO%NPATCH - DO JI = 1,NP%AL(JP)%NSIZE_P - ZH_TREE(NP%AL(JP)%NR_P(JI),JP) = NP%AL(JP)%XH_TREE(JI) - ENDDO -ENDDO -! -! 1 Needleleaf evergreen temperate tree -! ------------------------------------- -! utilisation de la classe NVT_TENE -MGN%XPFT(1,:) = S%XVEGTYPE(:,NVT_TENE) -! -! 2 Needleleaf evergreen boreal tree -! ------------------------------------- -!utilisation de la classe NVT_BONE -MGN%XPFT(2,:) = S%XVEGTYPE(:,NVT_BONE) -! -!3 Needleleaf deciduous boreal tree -! ------------------------------------- -!utilisation de la classe NVT_BOND -MGN%XPFT(3,:) = S%XVEGTYPE(:,NVT_BOND) -! -!4 Broadleaf evergreen tropical tree -! ------------------------------------- -!utilisation de la classe NVT_TRBE -MGN%XPFT(4,:) = S%XVEGTYPE(:,NVT_TRBE) -! -!5 Broadleaf evergreen temperate tree -! ------------------------------------- -MGN%XPFT(5,:) = S%XVEGTYPE(:,NVT_TEBE) -! -!6 Broadleaf deciduous tropical tree -! ------------------------------------- -MGN%XPFT(6,:) = S%XVEGTYPE(:,NVT_TRBD) -! -!7 Broadleaf deciduous temperate tree -! ------------------------------------- -MGN%XPFT(7,:) = S%XVEGTYPE(:,NVT_TEBD) -! -!8 Broadleaf deciduous boreal tree -! ------------------------------------- -MGN%XPFT(8,:) = S%XVEGTYPE(:,NVT_BOBD) -! -!9 Broadleaf evergreen shrub -! ------------------------------------- -!utilisation de la classe NVT_SHBR pour -30 < LAT < 30 -WHERE (((PLAT(:) .GE. -30.) .AND. (PLAT(:) .LE. 30.))) -MGN%XPFT(9,:) = S%XVEGTYPE(:,NVT_SHRB) -ELSE WHERE -MGN%XPFT(9,:) = 0. -END WHERE -! -!10 Broadleaf deciduous temperate shrub -! ------------------------------------- -!utilisation de la classe NVT_SHBR pour 30 < LAT < 60 -WHERE (((PLAT(:) .GE. 30.) .AND. (PLAT(:) .LT. 60.)).OR.& - ((PLAT(:) .LE. -30.) .AND. (PLAT(:) .GT. -60.))) -MGN%XPFT(10,:) = S%XVEGTYPE(:,NVT_SHRB) -ELSE WHERE -MGN%XPFT(10,:) = 0. -END WHERE -! -!11 Broadleaf deciduous boreal_shrub -! ------------------------------------- -!utilisation de la classe NVT_SHBR pour LAT > 60 -WHERE (((PLAT(:) .GE. 60.) .OR. (PLAT(:) .LE. -60.))) -MGN%XPFT(11,:) = S%XVEGTYPE(:,NVT_SHRB) -ELSE WHERE -MGN%XPFT(11,:) = 0. -END WHERE -! -!12 C3 arctic grass -! ------------------------------------- -MGN%XPFT(12,:) = S%XVEGTYPE(:,NVT_BOGR) -! -!13 C3 non-arctic grass -! ------------------------------------- -MGN%XPFT(13,:) = S%XVEGTYPE(:,NVT_GRAS) -! -!14 C4 grass -! ------------------------------------- -MGN%XPFT(14,:) = S%XVEGTYPE(:,NVT_TROG) -! -!15 Corn -! ------------------------------------- -MGN%XPFT(15,:) = S%XVEGTYPE(:,NVT_C4) -! -!16 Wheat -! ------------------------------------- -IF (NVT_C3W .NE. 0 ) THEN ! use ecoclimap_sg -MGN%XPFT(16,:) = S%XVEGTYPE(:,NVT_C3W) + S%XVEGTYPE(:,NVT_C3S) -ELSE ! use ecaclimap2.0 -MGN%XPFT(16,:) = S%XVEGTYPE(:,NVT_C3) -END IF -! -! Emission factor -MGN%XEF(:,:) = 0. -! -! Default values -! 1: ISOP isoprene -MGN%XEF(1,:) = 6000. -! 2: MYRC myrcene -MGN%XEF(2,:) = 20. -! 3: SABI sabinene -MGN%XEF(3,:) = 300. -! 4: LIMO limonene -MGN%XEF(4,:) = 80. -! 5: A_3CAR carene_3 -MGN%XEF(5,:) = 40. -! 6: OCIM ocimene_t_b -MGN%XEF(6,:) = 40. -! 7: BPIN pinene_b -MGN%XEF(7,:) = 125. -! 8: APIN pinene_a -MGN%XEF(8,:) = 300. -! 9: OMTP A_2met_styrene + cymene_p + cymene_o + phellandrene_a + thujene_a + terpinene_a -! + terpinene_g + terpinolene + phellandrene_b + camphene + bornene + fenchene_a -! + ocimene_al + .... -! 10: FARN -! 11: BCAR -! 12: OSQT -! 13: MBO -! 14: MEOH -! 15: ACTO -! 16: CO -! 17: NO -!MGN%XEF(17,:,1) = 30. -! 18: BIDER -! 19: STRESS -! 20: OTHER -! Values from the megan maps fields (to be introduced at the PREP_PGD step - nameliste PRE_PGD1.nam) -DO JSV=1, MSF%NMEGAN_NBR - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "EFISOP") MGN%XEF(1,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "EFMYRC") MGN%XEF(2,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "EFSABI") MGN%XEF(3,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "EFLIMO") MGN%XEF(4,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "EFCARE") MGN%XEF(5,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "EFOCIM") MGN%XEF(6,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "EFBPIN") MGN%XEF(7,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "EFAPIN") MGN%XEF(8,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "EFOMTP") MGN%XEF(9,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "EFFARN") MGN%XEF(10,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "EFBCAR") MGN%XEF(11,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "EFOSQT") MGN%XEF(12,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "EFMBO") MGN%XEF(13,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "EFMEOH") MGN%XEF(14,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "EFACTO") MGN%XEF(15,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "EFCO") MGN%XEF(16,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "EFNO") MGN%XEF(17,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "EFBIDER") MGN%XEF(18,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "EFSTRESS") MGN%XEF(19,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "EFOTHER") MGN%XEF(20,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT1") MGN%XPFT(1,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT2") MGN%XPFT(2,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT3") MGN%XPFT(3,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT4") MGN%XPFT(4,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT5") MGN%XPFT(5,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT6") MGN%XPFT(6,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT7") MGN%XPFT(7,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT8") MGN%XPFT(8,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT9") MGN%XPFT(9,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT10") MGN%XPFT(10,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT11") MGN%XPFT(11,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT12") MGN%XPFT(12,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT13") MGN%XPFT(13,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT14") MGN%XPFT(14,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT15") MGN%XPFT(15,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT16") MGN%XPFT(16,:) = PMEGAN_FIELDS(:,JSV) - IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "LAI") MGN%XLAI(:) = PMEGAN_FIELDS(:,JSV) -END DO - -#endif -! -!--------------------------------------------------------------------------- -! -END SUBROUTINE INIT_MEGAN_n - diff --git a/src/ICCARE_BASE/init_salt.f90 b/src/ICCARE_BASE/init_salt.f90 deleted file mode 100644 index ab14998b3..000000000 --- a/src/ICCARE_BASE/init_salt.f90 +++ /dev/null @@ -1,68 +0,0 @@ -!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence -!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!ORILAM_LIC for details. -!----------------------------------------------------------------- - -!! ###################### - SUBROUTINE INIT_SALT -!! ###################### -! PURPOSE -!! ------- -!! -!! initialization of variables for the sea salt scheme -!! -!! METHOD -!! ------ -!! -!! -!! REFERENCE -!! --------- -!! none -!! -!! -!! AUTHOR -!! ------ -!! Marine Claeys (CNRM) - - -USE MODD_SALT -! -IMPLICIT NONE - -! Default NMODE_SLT == 5 -!Initial dry number median radius (um) from Ova et al., 2014 -XINIRADIUS_SLT= (/0.009, 0.021, 0.045, 0.115, 0.415,0.0,0.0,0.0/) -!Initial, standard deviation from Ova et al., 2014 -XINISIG_SLT = (/ 1.37, 1.5, 1.42, 1.53, 1.85, 0.0, 0.0, 0.0 /) -!Minimum allowed number concentration for any mode (#/m3) -XN0MIN_SLT = (/1.e1 , 1.e1, 1.e1, 1., 1.e-4, 0.0, 0.0, 0.0 /) - -IF ( NMODE_SLT == 8) THEN -!JPSALTORDER = (/5, 4, 3, 2, 1 /) -!Initial dry number median radius (um) from Ova et al., 2014 + MB21 (Bruch et al., 2022). -XINIRADIUS_SLT= (/0.009, 0.021, 0.045, 0.115, 0.415,2.5, 7.0, 25.0/) -!Initial, standard deviation from Ova et al., 2014 -XINISIG_SLT = (/ 1.37, 1.5, 1.42, 1.53, 1.85,1.7, 1.8, 2.1 /) -!Minimum allowed number concentration for any mode (#/m3) -XN0MIN_SLT = (/1.e1 , 1.e1, 1.e1, 1., 1.e-4,1.e-20 , 1.e-20, 1.e-20 /) - -ELSE IF ( NMODE_SLT == 3) THEN - -! Set the order of the loops sorted by importance -!This means that if a user choses 1 mode it will have characteristics of mode 2 -!2 modes will be mode 2 & 3, whereas 3 modes will modes 1, 2 and 3 -!JPSALTORDER = (/3, 2, 1, 4, 5/) -! -!Initial dry number median radius (um) from Schultz et al., 2004 - XINIRADIUS_SLT= 0.5*(/0.28, 2.25, 15.32, 0., 0.,0.,0.,0. /) -!Initial, standard deviation from Schultz et al., 2004 - XINISIG_SLT = (/1.9, 2., 2., 0., 0.,0.,0.,0./) -!Minimum allowed number concentration for any mode (#/m3) - XN0MIN_SLT = (/1.e1 , 1. , 1.e-4, 0., 0.,0.,0.,0. /) -! - -END IF - - -END SUBROUTINE INIT_SALT diff --git a/src/ICCARE_BASE/init_slt.F90 b/src/ICCARE_BASE/init_slt.F90 deleted file mode 100644 index 2182cbeb8..000000000 --- a/src/ICCARE_BASE/init_slt.F90 +++ /dev/null @@ -1,79 +0,0 @@ -!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -SUBROUTINE INIT_SLT (SLT, & - HPROGRAM &! Program calling unit - ) - -! -USE MODD_SLT_n, ONLY : SLT_t -! -USE MODD_SLT_SURF -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -IMPLICIT NONE - -!PASSED VARIABLES -! -TYPE(SLT_t), INTENT(INOUT) :: SLT -! - CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM !Passing unit -! -!LOCAL VARIABLES - CHARACTER(LEN=4) :: CRGUNITS ! type of log-normal geometric mean radius -INTEGER :: JMODE ! Counter for sea salt modes -INTEGER :: JMODE_IDX ! Index for sea salt modes -REAL(KIND=JPRB) :: ZHOOK_HANDLE - - -!get output listing unit -IF (LHOOK) CALL DR_HOOK('INIT_SLT',0,ZHOOK_HANDLE) -! -!Allocate memory for the real values which will be used by the model -! -!Get initial size distributions. This is cut and pasted -!from dead routine dstpsd.F90 -!Check for different source parameterizations -! Default : CEMISPARAM_SLT.eq."Ova14" - - NSLTMDE = 5 - CRGUNITS = 'NUMB' - XEMISRADIUS_INI_SLT = (/0.009, 0.021, 0.045, 0.115, 0.415, 0.0, 0.0, 0.0/) - XEMISSIG_INI_SLT = (/1.37, 1.5, 1.42, 1.53, 1.85,0.,0.,0./) - -IF ((CEMISPARAM_SLT.eq."OvB21a").OR.(CEMISPARAM_SLT.eq."OvB21b")) THEN - NSLTMDE = 8 - CRGUNITS = 'NUMB' - XEMISRADIUS_INI_SLT = (/0.009, 0.021, 0.045, 0.115, 0.415, 2.5, 7.0, 25.0/) - XEMISSIG_INI_SLT = (/1.37, 1.5, 1.42, 1.53,1.70,1.80, 1.85, 2.1/) - - -ELSE IF (CEMISPARAM_SLT.eq."Vig01") THEN - NSLTMDE = 5 -! JORDER_SLT = (/3,2,1,4,5/) !Salt modes in order of importance, only three modes - CRGUNITS = 'NUMB' - XEMISRADIUS_INI_SLT = (/ 0.2, 2.0, 12.,0.,0.,0.,0.,0. /) ! [um] Number median radius Viganati et al., 2001 - XEMISSIG_INI_SLT = (/ 1.9, 2.0, 3.00,0.,0.,0.,0.,0. /) ! [frc] Geometric standard deviation Viganati et al., 2001 -ENDIF - -ALLOCATE(SLT%XEMISRADIUS_SLT(NSLTMDE)) -ALLOCATE(SLT%XEMISSIG_SLT (NSLTMDE)) -! -DO JMODE=1,NSLTMDE - ! - JMODE_IDX = JORDER_SLT(JMODE) - ! - SLT%XEMISSIG_SLT (JMODE) = XEMISSIG_INI_SLT (JMODE_IDX) - SLT%XEMISRADIUS_SLT(JMODE) = XEMISRADIUS_INI_SLT(JMODE_IDX) - ! - IF (CRGUNITS=="MASS") & - SLT%XEMISRADIUS_SLT(JMODE) = SLT%XEMISRADIUS_SLT(JMODE) * EXP(-3.d0 * (LOG(SLT%XEMISSIG_SLT(JMODE)))**2) - ! -ENDDO -! -IF (LHOOK) CALL DR_HOOK('INIT_SLT',1,ZHOOK_HANDLE) -! -END SUBROUTINE INIT_SLT diff --git a/src/ICCARE_BASE/init_surf_atmn.F90 b/src/ICCARE_BASE/init_surf_atmn.F90 deleted file mode 100644 index 79f682052..000000000 --- a/src/ICCARE_BASE/init_surf_atmn.F90 +++ /dev/null @@ -1,859 +0,0 @@ -!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -!############################################################# -SUBROUTINE INIT_SURF_ATM_n (YSC, HPROGRAM,HINIT, OLAND_USE, & - KI,KSV,KSW, HSV,PCO2,PRHOA, & - PZENITH,PAZIM,PSW_BANDS,PDIR_ALB,PSCA_ALB, & - PEMIS,PTSRAD,PTSURF, & - KYEAR, KMONTH,KDAY, PTIME, TPDATE_END, & - HATMFILE,HATMFILETYPE, HTEST ) -!############################################################# -! -!!**** *INIT_SURF_ATM_n* - routine to initialize GROUND -!! -!! PURPOSE -!! ------- -!! -!!** METHOD -!! ------ -!! -!! EXTERNAL -!! -------- -!! -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! REFERENCE -!! --------- -!! -!! -!! AUTHOR -!! ------ -!! V. Masson *Meteo France* -!! -!! MODIFICATIONS -!! ------------- -!! Original 01/2003 -! (P.Tulet ) 01/11/03 initialisation of the surface chemistry! -!! (D.Gazen) 01/12/03 change emissions handling for surf. externalization -!! (P.LeMoigne) 18/07/05 get 1d mask only if associated tile exists -!! (B.Decharme) 03/2009 New keys read for arrange cover by user -!! (B.Decharme) 04/2009 Read precipitation forcing from the restart file for ARPEGE/ALADIN run -!! (A. Lemonsu) 2009 New key read for urban green areas -!! (B.Decharme) 07/2011 Read pgd+prep -!! (S. Queguiner) 2011 Modif chemistry (2.4) -!! (B. Decharme) 2013 Read grid only once in AROME case -!! (G. Tanguy) 2013 Add IF(ALLOCATED(NMASK_FULL)) before deallocate -!! B. Decharme 04/2013 new coupling variables -!! Delete LPROVAR_TO_DIAG check -!! Delete NWG_LAYER_TOT -!! (J.Escobar) 10/06/2013: replace DOUBLE PRECISION by REAL to handle problem for promotion of real on IBM SP -!! (J.Durand) 2014 add activation of chemical deposition if LCH_EMIS=F -!! R. Séférian 03/2014 Adding decoupling between CO2 seen by photosynthesis and radiative CO2 -!! M.Leriche & V. Masson 05/16 bug in write emis fields for nest -!! (P.Tulet & M.Leriche) 06/2016 add MEGAN coupling -!! J.Escoabr 01/2019 integrate bypass fo albedo pb > 1.0 from Florian Pantillon (Sep 2011) -!! (P.Tulet) 06/2021 add DMS chemical fluxes - -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_TYPE_DATE_SURF, ONLY : DATE -! -USE MODD_SURFEX_n, ONLY : SURFEX_t -USE MODD_DMS_n, ONLY : DMS_t - -! -USE MODD_SURF_ATM, ONLY : XCO2UNCPL -! -USE MODD_READ_NAMELIST, ONLY : LNAM_READ -USE MODD_SURF_CONF, ONLY : CPROGNAME -USE MODD_DST_SURF, ONLY : NDSTMDE, NDST_MDEBEG, LVARSIG_DST, LRGFIX_DST -USE MODD_SLT_SURF, ONLY : NSLTMDE, NSLT_MDEBEG, LVARSIG_SLT, LRGFIX_SLT - -USE MODD_DATA_COVER_PAR, ONLY : NTILESFC -USE MODD_DATA_COVER, ONLY : LCLIM_LAI, XDATA_LAI_ALL_YEARS, XDATA_LAI, & - NECO2_START_YEAR, NECO2_END_YEAR -! -USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF -USE MODD_CHS_AEROSOL, ONLY : LVARSIGI, LVARSIGJ -USE MODD_WRITE_SURF_ATM, ONLY : LNOWRITE_CANOPY, LNOWRITE_TEXFILE -! -USE MODD_SURFEX_MPI, ONLY : XTIME_INIT_SEA, XTIME_INIT_WATER, XTIME_INIT_NATURE, XTIME_INIT_TOWN, & - NRANK, NPIO, NSIZE -USE MODD_SURFEX_OMP, ONLY : NBLOCKTOT -! -USE MODD_MASK, ONLY: NMASK_FULL -USE MODN_PREP_SURF_ATM, ONLY : LWRITE_EXTERN -! -USE MODI_INIT_IO_SURF_n -USE MODI_DEFAULT_SSO -USE MODI_DEFAULT_CH_SURF_ATM -USE MODI_DEFAULT_DIAG_SURF_ATM -USE MODI_READ_DEFAULT_SURF_ATM_n -USE MODI_READ_SURF_ATM_CONF_n -USE MODI_READ_SURF_ATM_DATE -USE MODI_READ_NAM_PREP_SURF_n -USE MODI_READ_SURF -USE MODI_SUNPOS -USE MODI_GET_SIZE_FULL_n -USE MODI_READ_COVER_n -USE MODI_READ_SSO_n -USE MODI_SUBSCALE_Z0EFF -USE MODI_READ_SSO_CANOPY_n -USE MODI_READ_DUMMY_n -USE MODI_READ_GRID -USE MODI_READ_GRIDTYPE -USE MODI_END_IO_SURF_n -USE MODI_PREP_CTRL_SURF_ATM -USE MODI_AVERAGE_RAD -USE MODI_AVERAGE_TSURF -USE MODI_INIT_CHEMICAL_n -USE MODI_CH_INIT_DEPCONST -USE MODI_CH_INIT_EMISSION_n -USE MODI_CH_INIT_SNAP_n -USE MODI_ABOR1_SFX -USE MODI_ALLOC_DIAG_SURF_ATM_n -USE MODI_GET_1D_MASK -USE MODI_INI_DATA_COVER -USE MODI_INIT_INLAND_WATER_n -USE MODI_INIT_NATURE_n -USE MODI_INIT_SEA_n -USE MODI_INIT_TOWN_n -USE MODI_READ_ARRANGE_COVER -USE MODI_READ_COVER_GARDEN -USE MODI_READ_ECO2_IRRIG -USE MODI_READ_LCLIM_LAI -USE MODI_READ_LECOCLIMAP -USE MODI_SURF_VERSION -USE MODI_GET_LUOUT -USE MODI_SET_SURFEX_FILEIN -!UPG*PT -USE MODI_INIT_SLT -USE MODI_READ_DMS_n -!UPG*PT -! -USE MODI_INIT_CPL_GCM_n -USE MODI_READ_MEGAN_n -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -IMPLICIT NONE -! -#ifdef SFX_MPI -INCLUDE 'mpif.h' -#endif -! -!* 0.1 Declarations of arguments -! ------------------------- -! -! -TYPE(SURFEX_t), INTENT(INOUT) :: YSC -! - CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes - CHARACTER(LEN=3), INTENT(IN) :: HINIT ! choice of fields to initialize -LOGICAL, INTENT(IN) :: OLAND_USE ! -INTEGER, INTENT(IN) :: KI ! number of points -INTEGER, INTENT(IN) :: KSV ! number of scalars -INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands - CHARACTER(LEN=6), DIMENSION(KSV), INTENT(IN) :: HSV ! name of all scalar variables -REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration (kg/m3) -REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density -REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! solar zenithal angle -REAL, DIMENSION(KI), INTENT(IN) :: PAZIM ! solar azimuthal angle (rad from N, clock) -REAL, DIMENSION(KSW), INTENT(IN) :: PSW_BANDS ! middle wavelength of each band -REAL, DIMENSION(KI,KSW),INTENT(OUT) :: PDIR_ALB ! direct albedo for each band -REAL, DIMENSION(KI,KSW),INTENT(OUT) :: PSCA_ALB ! diffuse albedo for each band -REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS ! emissivity -REAL, DIMENSION(KI), INTENT(OUT) :: PTSRAD ! radiative temperature -REAL, DIMENSION(KI), INTENT(OUT) :: PTSURF ! surface effective temperature (K) -! -INTEGER, INTENT(IN) :: KYEAR ! current year (UTC) -INTEGER, INTENT(IN) :: KMONTH ! current month (UTC) -INTEGER, INTENT(IN) :: KDAY ! current day (UTC) -REAL, INTENT(IN) :: PTIME ! current time since - ! midnight (UTC, s) -TYPE(DATE), INTENT(INOUT) :: TPDATE_END -! - CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! atmospheric file name - CHARACTER(LEN=6), INTENT(IN) :: HATMFILETYPE! atmospheric file type - CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK' -! -!* 0.2 Declarations of local variables -! ------------------------------- -! - CHARACTER(LEN=3) :: YREAD -! -INTEGER :: ISWB ! number of shortwave bands -INTEGER :: JTILE ! loop counter on tiles -INTEGER :: IRESP ! error return code -INTEGER :: ILUOUT ! unit of output listing file -INTEGER :: IVERSION, IBUGFIX ! surface version -! -INTEGER, DIMENSION(:), ALLOCATABLE :: ISIZE_OMP -! -LOGICAL :: LZENITH ! is the PZENITH field initialized ? -! -REAL, DIMENSION(:,:), ALLOCATABLE :: ZFRAC_TILE ! fraction of each surface type -REAL, DIMENSION(KI,KSW,NTILESFC) :: ZDIR_ALB_TILE ! direct albedo -REAL, DIMENSION(KI,KSW,NTILESFC) :: ZSCA_ALB_TILE ! diffuse albedo -REAL, DIMENSION(KI,NTILESFC) :: ZEMIS_TILE ! emissivity -REAL, DIMENSION(KI,NTILESFC) :: ZTSRAD_TILE ! radiative temperature -REAL, DIMENSION(KI,NTILESFC) :: ZTSURF_TILE ! effective temperature -REAL, DIMENSION(KI) :: ZZENITH ! zenith angle -REAL, DIMENSION(KI) :: ZAZIM ! azimuth angle -REAL, DIMENSION(KI) :: ZTSUN ! solar time since midnight -! -REAL, DIMENSION(:), ALLOCATABLE :: ZP_ZENITH ! zenithal angle -REAL, DIMENSION(:), ALLOCATABLE :: ZP_AZIM ! azimuthal angle -REAL, DIMENSION(:), ALLOCATABLE :: ZP_CO2 ! air CO2 concentration -REAL, DIMENSION(:), ALLOCATABLE :: ZP_RHOA ! air density -REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_DIR_ALB ! direct albedo -REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_SCA_ALB ! diffuse albedo -REAL, DIMENSION(:), ALLOCATABLE :: ZP_EMIS ! emissivity -REAL, DIMENSION(:), ALLOCATABLE :: ZP_TSRAD ! radiative temperature -REAL, DIMENSION(:), ALLOCATABLE :: ZP_TSURF ! surface effective temperature -! -REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_MEGAN_FIELDS -REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_DMS_FIELDS -! -REAL, DIMENSION(:), ALLOCATABLE :: ZZ0VEG -REAL :: XTIME0 -! -INTEGER :: ISIZE_FULL -! -REAL(KIND=JPRB) :: ZHOOK_HANDLE -! -INTEGER :: JJ -CHARACTER(LEN=6), DIMENSION(:),POINTER :: CNAMES -!------------------------------------------------------------------------------- -! -IF (LHOOK) CALL DR_HOOK('INIT_SURF_ATM_N',0,ZHOOK_HANDLE) -! -! - CPROGNAME=HPROGRAM -! -IF (HTEST/='OK') THEN - CALL ABOR1_SFX('INIT_SURF_ATMN: FATAL ERROR DURING ARGUMENT TRANSFER') -END IF -! -!------------------------------------------------------------------------------- -! - CALL SURF_VERSION -! -!------------------------------------------------------------------------------- -! - CALL GET_LUOUT(HPROGRAM,ILUOUT) -! -IF (LNAM_READ) THEN - ! - !* 0. Defaults - ! -------- - ! - ! 0.1. Hard defaults - ! - CALL DEFAULT_SSO(YSC%USS%CROUGH, YSC%USS%XFRACZ0, YSC%USS%XCOEFBE) - CALL DEFAULT_CH_SURF_ATM(YSC%CHU%CCHEM_SURF_FILE, YSC%CHU%LCH_EMIS) - CALL DEFAULT_DIAG_SURF_ATM(YSC%DUO%N2M, YSC%DUO%LT2MMW, YSC%DUO%LSURF_BUDGET,& - YSC%DUO%L2M_MIN_ZS, YSC%DUO%LRAD_BUDGET, YSC%DUO%LCOEF,& - YSC%DUO%LSURF_VARS, YSC%DUO%LSURF_BUDGETC, & - YSC%DUO%LRESET_BUDGETC, YSC%DUO%LSELECT, & - YSC%DUO%LPROVAR_TO_DIAG, YSC%DUO%LDIAG_GRID, & - YSC%DUO%LFRAC, YSC%DUO%XDIAG_TSTEP, & - YSC%DUO%LSNOWDIMNC, YSC%DUO%LRESETCUMUL ) - ! -ENDIF -! -! 0.2. Defaults from file header -! - CALL READ_DEFAULT_SURF_ATM_n(YSC%CHU, YSC%DUO, YSC%USS, HPROGRAM) -! -!* 1. Reading of configuration -! ------------------------ -! -! 1.1. general options (diagnostics, etc...) -! - CALL READ_SURF_ATM_CONF_n(YSC%CHU, YSC%DUO, YSC%USS, HPROGRAM) -! -IF(XCO2UNCPL/=XUNDEF)THEN - WRITE(ILUOUT,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' - WRITE(ILUOUT,*)'!!! !!!' - WRITE(ILUOUT,*)'!!! WARNING WARNING !!!' - WRITE(ILUOUT,*)'!!! !!!' - WRITE(ILUOUT,*)'!!! Decoupling between CO2 for photosynthesis !!!' - WRITE(ILUOUT,*)'!!! and atmospheric CO2 activated !!!' - WRITE(ILUOUT,*)'!!! In NAM_SURF_ATM XCO2UNCPL =',XCO2UNCPL,' !!!' - WRITE(ILUOUT,*)'!!! !!!' - WRITE(ILUOUT,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' -ENDIF -! -! 1.2. Date -! -SELECT CASE (HINIT) - CASE ('PGD') - YSC%U%TTIME%TDATE%YEAR = NUNDEF - YSC%U%TTIME%TDATE%MONTH= NUNDEF - YSC%U%TTIME%TDATE%DAY = NUNDEF - YSC%U%TTIME%TIME = XUNDEF - - CASE ('PRE') - ! check that diagnostics are off if hinit=='pre' - CALL PREP_CTRL_SURF_ATM(YSC%DUO, LNOWRITE_TEXFILE, ILUOUT) - ! preparation of fields (date not present in PGD file) - IF (LNAM_READ) CALL READ_NAM_PREP_SURF_n(HPROGRAM) - CALL READ_SURF_ATM_DATE(HPROGRAM,HINIT,ILUOUT,HATMFILE,HATMFILETYPE,KYEAR,KMONTH,KDAY,PTIME,YSC%U%TTIME) - - CASE DEFAULT - CALL INIT_IO_SURF_n(YSC%DTCO, YSC%U, HPROGRAM,'FULL ','SURF ','READ ') - CALL READ_SURF(HPROGRAM,'DTCUR',YSC%U%TTIME,IRESP) - CALL END_IO_SURF_n(HPROGRAM) - LWRITE_EXTERN = .FALSE. - -END SELECT -! -!----------------------------------------------------------------------------------------------------- -! READ PGD FILE -!----------------------------------------------------------------------------------------------------- -! -! 1.3. Schemes used -! -! Initialisation for IO -! - CALL SET_SURFEX_FILEIN(HPROGRAM,'PGD ') ! change input file name to pgd name - CALL INIT_IO_SURF_n(YSC%DTCO, YSC%U, HPROGRAM,'FULL ','SURF ','READ ') - CALL READ_SURF(HPROGRAM,'DIM_FULL ',YSC%U%NDIM_FULL, IRESP) - CALL END_IO_SURF_n(HPROGRAM) - CALL INIT_IO_SURF_n(YSC%DTCO, YSC%U, HPROGRAM,'FULL ','SURF ','READ ') - -! - CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP) - CALL READ_SURF(HPROGRAM,'BUG',IBUGFIX,IRESP) -! -IF (IVERSION>7 .OR. IVERSION==7 .AND.IBUGFIX>=2) THEN - CALL READ_SURF(HPROGRAM,'STORAGETYPE',YREAD,IRESP) -ENDIF -! reading -! - CALL READ_SURF(HPROGRAM,'SEA ',YSC%U%CSEA ,IRESP) - CALL READ_SURF(HPROGRAM,'WATER ',YSC%U%CWATER ,IRESP) - CALL READ_SURF(HPROGRAM,'NATURE',YSC%U%CNATURE,IRESP) - CALL READ_SURF(HPROGRAM,'TOWN ',YSC%U%CTOWN ,IRESP) -! -! - CALL READ_SURF(HPROGRAM,'DIM_SEA ',YSC%U%NDIM_SEA, IRESP) - CALL READ_SURF(HPROGRAM,'DIM_NATURE',YSC%U%NDIM_NATURE,IRESP) - CALL READ_SURF(HPROGRAM,'DIM_WATER ',YSC%U%NDIM_WATER, IRESP) - CALL READ_SURF(HPROGRAM,'DIM_TOWN ',YSC%U%NDIM_TOWN, IRESP) -! - CALL READ_LECOCLIMAP(HPROGRAM,YSC%U%LECOCLIMAP,YSC%U%LECOSG) - CALL READ_ARRANGE_COVER(HPROGRAM,YSC%U%LWATER_TO_NATURE,YSC%U%LTOWN_TO_ROCK) - CALL READ_COVER_GARDEN(HPROGRAM,YSC%U%LGARDEN) -! -!* reads if climatological LAI is used or not for ecoclimap2. If not, looks for year to be used. - CALL READ_LCLIM_LAI(HPROGRAM,LCLIM_LAI) -IF (.NOT. LCLIM_LAI .AND. YSC%U%TTIME%TDATE%YEAR >= NECO2_START_YEAR & - .AND. YSC%U%TTIME%TDATE%YEAR <= NECO2_END_YEAR ) YSC%DTCO%NYEAR=YSC%U%TTIME%TDATE%YEAR - CALL INI_DATA_COVER(YSC%DTCO, YSC%U) - CALL READ_ECO2_IRRIG(YSC%DTCO, HPROGRAM) -! -!* 2. Cover fields and grid: -! --------------------- -! -! 2.0. Get number of points on this proc -! - CALL GET_SIZE_FULL_n(HPROGRAM,YSC%U%NDIM_FULL,YSC%U%NSIZE_FULL,ISIZE_FULL) - YSC%U%NSIZE_FULL = ISIZE_FULL -! -! 2.1. Read cover -! - CALL READ_COVER_n(YSC%DTCO, YSC%U, HPROGRAM) -! -! 2.2. Read grid -! -ALLOCATE(YSC%UG%G%XLAT (YSC%U%NSIZE_FULL)) -ALLOCATE(YSC%UG%G%XLON (YSC%U%NSIZE_FULL)) -ALLOCATE(YSC%UG%G%XMESH_SIZE(YSC%U%NSIZE_FULL)) -ALLOCATE(YSC%USS%XZ0EFFJPDIR(YSC%U%NSIZE_FULL)) - CALL READ_GRID(HPROGRAM,YSC%UG%G,IRESP,YSC%USS%XZ0EFFJPDIR) -! -! 2.3. Initialize zenith and azimuth angles if not done yet -! -LZENITH = ALL(PZENITH /= XUNDEF) -IF (.NOT. LZENITH) CALL SUNPOS(KYEAR, KMONTH, KDAY, PTIME, YSC%UG%G%XLON, YSC%UG%G%XLAT, ZTSUN, ZZENITH, ZAZIM) -! -IF (HPROGRAM/='AROME '.AND.NRANK==NPIO) THEN - ! - IF (.NOT.ASSOCIATED(YSC%UG%XGRID_FULL_PAR)) THEN -#ifdef MNH_PARALLEL - CALL READ_GRIDTYPE(HPROGRAM,YSC%UG%G%CGRID,YSC%UG%G%NGRID_PAR,YSC%U%NSIZE_FULL,.FALSE.,HDIR='H') - ALLOCATE(YSC%UG%XGRID_FULL_PAR(YSC%UG%G%NGRID_PAR)) - CALL READ_GRIDTYPE(HPROGRAM,YSC%UG%G%CGRID,YSC%UG%G%NGRID_PAR,YSC%U%NSIZE_FULL,.TRUE.,& - YSC%UG%XGRID_FULL_PAR,IRESP,HDIR='H') -#else - CALL READ_GRIDTYPE(HPROGRAM,YSC%UG%G%CGRID,YSC%UG%NGRID_FULL_PAR,YSC%U%NDIM_FULL,.FALSE.,HDIR='A') - ALLOCATE(YSC%UG%XGRID_FULL_PAR(YSC%UG%NGRID_FULL_PAR)) - CALL READ_GRIDTYPE(HPROGRAM,YSC%UG%G%CGRID,YSC%UG%NGRID_FULL_PAR,YSC%U%NDIM_FULL,.TRUE.,& - YSC%UG%XGRID_FULL_PAR,IRESP,HDIR='A') -#endif - ENDIF - ! -ENDIF -! -!* 2.4 Allocation of chemical species name, chemical index of HSV array -! - CALL INIT_CHEMICAL_n(ILUOUT, KSV, HSV, YSC%SV, & - YSC%CHU%CCH_NAMES, YSC%CHU%CAER_NAMES ) -! -! 2.4.1 Initialize Chemical Emissions -! -CALL READ_SURF(HPROGRAM,'CH_EMIS',YSC%CHU%LCH_EMIS,IRESP) -! - -IF (YSC%CHU%LCH_EMIS) THEN - ! - IF ( IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3 ) THEN - YSC%CHU%CCH_EMIS='AGGR' - ELSE - CALL READ_SURF(HPROGRAM,'CH_EMIS_OPT',YSC%CHU%CCH_EMIS,IRESP) - END IF - IF (KSV == 0) THEN ! case prep_nest_pgd - CNAMES => YSC%SV%CSV - ELSE IF (YSC%SV%NSV_AEREND < 0) THEN ! case gas chemistry without aerosols - CNAMES => YSC%SV%CSV(YSC%SV%NSV_CHSBEG:YSC%SV%NSV_CHSEND) - ELSE IF (YSC%SV%NSV_AEREND > YSC%SV%NSV_CHSEND) THEN ! case gas and aerosols chemistry - CNAMES => YSC%SV%CSV(YSC%SV%NSV_CHSBEG:YSC%SV%NSV_AEREND) - ELSE - END IF - - IF (YSC%CHU%CCH_EMIS=='AGGR') THEN - CALL CH_INIT_EMISSION_n(YSC%CHE, YSC%CHU%XCONVERSION, CNAMES, & - HPROGRAM,YSC%U%NSIZE_FULL,HINIT,PRHOA,YSC%CHU%CCHEM_SURF_FILE) - ELSE IF (YSC%CHU%CCH_EMIS=='SNAP') THEN - CALL CH_INIT_SNAP_n(YSC%CHN, CNAMES, & - HPROGRAM,YSC%U%NSIZE_FULL,HINIT,PRHOA,YSC%CHU%CCHEM_SURF_FILE) - END IF - ! -ENDIF -! -! 2.4.2 Initialize sea salt aerosols distribution -! - -IF (YSC%SV%NSLTEQ >=1) THEN - CALL INIT_SLT(YSC%SLT, HPROGRAM) -END IF - -! -!* 2.5 Initialization of dry deposition scheme (chemistry) -! -IF (YSC%SV%NBEQ .GT. 0) THEN -! - IF (HINIT=='ALL') CALL CH_INIT_DEPCONST(HPROGRAM,YSC%CHU%CCHEM_SURF_FILE,ILUOUT,YSC%SV%CSV(YSC%SV%NSV_CHSBEG:YSC%SV%NSV_CHSEND)) -! -END IF -! -!* 2.5 Subgrid orography -! - CALL READ_SSO_n(YSC%U%NSIZE_FULL, YSC%U%XSEA, YSC%USS, HPROGRAM) -! -!* 2.6 Orographic roughness length -! -ALLOCATE(YSC%USS%XZ0EFFIP(YSC%U%NSIZE_FULL)) -ALLOCATE(YSC%USS%XZ0EFFIM(YSC%U%NSIZE_FULL)) -ALLOCATE(YSC%USS%XZ0EFFJP(YSC%U%NSIZE_FULL)) -ALLOCATE(YSC%USS%XZ0EFFJM(YSC%U%NSIZE_FULL)) -ALLOCATE(YSC%USS%XZ0REL (YSC%U%NSIZE_FULL)) -! -ALLOCATE(ZZ0VEG(YSC%U%NSIZE_FULL)) -ZZ0VEG(:) = 0. -! - CALL SUBSCALE_Z0EFF(YSC%USS,ZZ0VEG,.TRUE.) -! -DEALLOCATE(ZZ0VEG) -! -!* 2.7 Dummy fields -! - CALL READ_DUMMY_n(YSC%DUU,YSC%U%NSIZE_FULL, HPROGRAM) -! -!* 2.8 MEGAN fields -! - CALL READ_SURF (HPROGRAM,'CH_BIOEMIS',YSC%CHU%LCH_BIOEMIS,IRESP) -! -IF (YSC%CHU%LCH_BIOEMIS) THEN - CALL READ_MEGAN_n(YSC%IM%MSF, YSC%U, HPROGRAM) -ENDIF - - -!* 2.9 DMS fields -! - CALL READ_SURF (HPROGRAM,'CH_DMSEMIS',YSC%CHU%LCH_DMSEMIS,IRESP) -! -IF (YSC%CHU%LCH_DMSEMIS) THEN - CALL READ_DMS_n(YSC%SM%DSF, YSC%U, HPROGRAM) -ENDIF -! - -! -! End of IO -! - CALL END_IO_SURF_n(HPROGRAM) -! - CALL SET_SURFEX_FILEIN(HPROGRAM,'PREP') ! restore input file name -! -!----------------------------------------------------------------------------------------------------- -! END READ PGD FILE -!----------------------------------------------------------------------------------------------------- -! -! -! Initialisation for IO -! - CALL INIT_IO_SURF_n(YSC%DTCO, YSC%U, HPROGRAM,'FULL ','SURF ','READ ') -! -!* 2.8 Allocations and Initialization of diagnostics -! -IF (HINIT=='ALL') THEN - CALL ALLOC_DIAG_SURF_ATM_n(YSC%DUO, YSC%DU, YSC%DUC, YSC%DUP, YSC%DUPC, & - YSC%U%NSIZE_FULL, YSC%U%TTIME, HPROGRAM,KSW) -ENDIF -! -!* Canopy fields if Beljaars et al 2004 parameterization is used -! -IF (YSC%USS%CROUGH=='BE04') THEN - CALL READ_SSO_CANOPY_n(YSC%DTCO, YSC%SB, YSC%U, HPROGRAM, HINIT) -ENDIF -! -!* Physical fields need for ARPEGE/ALADIN climate run -! - CALL INIT_CPL_GCM_n(YSC%U, HPROGRAM,HINIT) -! -! End of IO -! - CALL END_IO_SURF_n(HPROGRAM) -! -!----------------------------------------------------------------------------------------------------- -! -!* 4. Initialization of masks for each surface -! ---------------------------------------- -! -!* number of geographical points -YSC%U%NSIZE_NATURE = COUNT(YSC%U%XNATURE(:) > 0.0) -YSC%U%NSIZE_TOWN = COUNT(YSC%U%XTOWN(:) > 0.0) -YSC%U%NSIZE_WATER = COUNT(YSC%U%XWATER(:) > 0.0) -YSC%U%NSIZE_SEA = COUNT(YSC%U%XSEA(:) > 0.0) -! -ALLOCATE(YSC%U%NR_NATURE (YSC%U%NSIZE_NATURE)) -ALLOCATE(YSC%U%NR_TOWN (YSC%U%NSIZE_TOWN )) -ALLOCATE(YSC%U%NR_WATER (YSC%U%NSIZE_WATER )) -ALLOCATE(YSC%U%NR_SEA (YSC%U%NSIZE_SEA )) -! -IF (YSC%U%NSIZE_SEA >0)CALL GET_1D_MASK( YSC%U%NSIZE_SEA, YSC%U%NSIZE_FULL, YSC%U%XSEA , YSC%U%NR_SEA ) -IF (YSC%U%NSIZE_WATER >0)CALL GET_1D_MASK( YSC%U%NSIZE_WATER, YSC%U%NSIZE_FULL, YSC%U%XWATER , YSC%U%NR_WATER ) -IF (YSC%U%NSIZE_TOWN >0)CALL GET_1D_MASK( YSC%U%NSIZE_TOWN, YSC%U%NSIZE_FULL, YSC%U%XTOWN , YSC%U%NR_TOWN ) -IF (YSC%U%NSIZE_NATURE>0)CALL GET_1D_MASK( YSC%U%NSIZE_NATURE, YSC%U%NSIZE_FULL, YSC%U%XNATURE, YSC%U%NR_NATURE) -! -!* number of shortwave spectral bands -ISWB=SIZE(PSW_BANDS) -! -!* tile number -ALLOCATE(ZFRAC_TILE(YSC%U%NSIZE_FULL,NTILESFC)) -JTILE = 0 -! -! -!* 5. Default values -! -------------- -! -ZDIR_ALB_TILE = XUNDEF -ZSCA_ALB_TILE = XUNDEF -ZEMIS_TILE = XUNDEF -ZTSRAD_TILE = XUNDEF -ZTSURF_TILE = XUNDEF -! -#ifdef SFX_MPI -XTIME0 = MPI_WTIME() -#endif -! -!* 6. Initialization of sea -! --------------------- -! -JTILE = JTILE + 1 -ZFRAC_TILE(:,JTILE) = YSC%U%XSEA(:) -! -! pack variables which are arguments to this routine - CALL PACK_SURF_INIT_ARG(YSC%U%NSIZE_SEA,YSC%U%NR_SEA) -! -! initialization -IF (YSC%U%NDIM_SEA>0) & - CALL INIT_SEA_n(YSC%DTCO, YSC%DUO%LREAD_BUDGETC, YSC%UG, YSC%U, YSC%GCP, & - YSC%SM, YSC%DLO, YSC%DL, YSC%DLC, & - HPROGRAM,HINIT,YSC%U%NSIZE_SEA,KSV,KSW, & - HSV,ZP_CO2,ZP_RHOA, & - ZP_ZENITH,ZP_AZIM,PSW_BANDS,ZP_DIR_ALB,ZP_SCA_ALB, & - ZP_EMIS,ZP_TSRAD,ZP_TSURF, & - KYEAR,KMONTH,KDAY,PTIME, HATMFILE,HATMFILETYPE, & - 'OK' ) -! -! -IF (KMONTH <= 12) THEN -ALLOCATE(YSC%SM%DMS%XDMS(SIZE(ZP_DMS_FIELDS,1)) ) -IF (SIZE(ZP_DMS_FIELDS,2)==12) THEN - YSC%SM%DMS%XDMS(:) = ZP_DMS_FIELDS(:,KMONTH) -ELSE IF (SIZE(ZP_DMS_FIELDS,2)==1) THEN - YSC%SM%DMS%XDMS(:) = ZP_DMS_FIELDS(:,1) -ELSE - YSC%SM%DMS%XDMS(:) = 0. -END IF -END IF -! - CALL UNPACK_SURF_INIT_ARG(JTILE,YSC%U%NSIZE_SEA,YSC%U%NR_SEA) -! -#ifdef SFX_MPI -XTIME_INIT_SEA = XTIME_INIT_SEA + (MPI_WTIME() - XTIME0)*100./MAX(1,YSC%U%NSIZE_SEA) -XTIME0 = MPI_WTIME() -#endif -! -!* 7. Initialization of lakes -! ----------------------- -! -! -JTILE = JTILE + 1 -ZFRAC_TILE(:,JTILE) = YSC%U%XWATER(:) -! -! pack variables which are arguments to this routine - CALL PACK_SURF_INIT_ARG(YSC%U%NSIZE_WATER,YSC%U%NR_WATER) -! -! initialization -IF (YSC%U%NDIM_WATER>0) & - CALL INIT_INLAND_WATER_n(YSC%DTCO, YSC%DUO%LREAD_BUDGETC, YSC%UG, & - YSC%U, YSC%WM, YSC%FM, YSC%DLO, YSC%DL, YSC%DLC, & - HPROGRAM,HINIT,YSC%U%NSIZE_WATER,KSV,KSW, & - HSV,ZP_CO2,ZP_RHOA, & - ZP_ZENITH,ZP_AZIM,PSW_BANDS,ZP_DIR_ALB,ZP_SCA_ALB, & - ZP_EMIS,ZP_TSRAD,ZP_TSURF, & - KYEAR,KMONTH,KDAY,PTIME, HATMFILE,HATMFILETYPE, & - 'OK' ) -! - CALL UNPACK_SURF_INIT_ARG(JTILE,YSC%U%NSIZE_WATER,YSC%U%NR_WATER) -! -#ifdef SFX_MPI -XTIME_INIT_WATER = XTIME_INIT_WATER + (MPI_WTIME() - XTIME0)*100./MAX(1,YSC%U%NSIZE_WATER) -XTIME0 = MPI_WTIME() -#endif -! -!* 8. Initialization of vegetation scheme -! ----------------------------------- -! -! -JTILE = JTILE + 1 -ZFRAC_TILE(:,JTILE) = YSC%U%XNATURE(:) -! -! pack variables which are arguments to this routine - CALL PACK_SURF_INIT_ARG(YSC%U%NSIZE_NATURE,YSC%U%NR_NATURE) -! -! initialization -IF (YSC%U%NDIM_NATURE>0) & - CALL INIT_NATURE_n(YSC%DTCO, YSC%DUO%LREAD_BUDGETC, YSC%UG, YSC%U, & - YSC%USS, YSC%GCP, YSC%IM, YSC%DTZ, YSC%DLO, YSC%DL,& - YSC%DLC, YSC%NDST, YSC%SLT,YSC%BLOWSNW, YSC%SV, & - HPROGRAM,HINIT,OLAND_USE,YSC%U%NSIZE_NATURE, & - KSV,KSW, HSV,ZP_CO2,ZP_RHOA, & - ZP_ZENITH,ZP_AZIM,PSW_BANDS,ZP_DIR_ALB,ZP_SCA_ALB, & - ZP_EMIS,ZP_TSRAD,ZP_TSURF,ZP_MEGAN_FIELDS, & - KYEAR,KMONTH,KDAY,PTIME,TPDATE_END, & - HATMFILE,HATMFILETYPE,'OK' ) -! -! - CALL UNPACK_SURF_INIT_ARG(JTILE,YSC%U%NSIZE_NATURE,YSC%U%NR_NATURE) -! -#ifdef SFX_MPI -XTIME_INIT_NATURE = XTIME_INIT_NATURE + (MPI_WTIME() - XTIME0)*100./MAX(1,YSC%U%NSIZE_NATURE) -XTIME0 = MPI_WTIME() -#endif -! -!* 9. Initialization of urban scheme -! ------------------------------ -! -JTILE = JTILE + 1 -ZFRAC_TILE(:,JTILE) = YSC%U%XTOWN(:) -! -! pack variables which are arguments to this routine - CALL PACK_SURF_INIT_ARG(YSC%U%NSIZE_TOWN,YSC%U%NR_TOWN) -! -! initialization -IF (YSC%U%NDIM_TOWN>0) & - CALL INIT_TOWN_n(YSC%DTCO, YSC%DUO%LREAD_BUDGETC, YSC%UG, YSC%U, YSC%GCP, & - YSC%TM, YSC%GDM, YSC%GRM, YSC%DLO, YSC%DL, YSC%DLC, & - HPROGRAM,HINIT,YSC%U%NSIZE_TOWN,KSV,KSW, & - HSV,ZP_CO2,ZP_RHOA, & - ZP_ZENITH,ZP_AZIM,PSW_BANDS,ZP_DIR_ALB,ZP_SCA_ALB, & - ZP_EMIS,ZP_TSRAD,ZP_TSURF, & - KYEAR,KMONTH,KDAY,PTIME, HATMFILE,HATMFILETYPE, & - 'OK' ) -! -! - CALL UNPACK_SURF_INIT_ARG(JTILE,YSC%U%NSIZE_TOWN,YSC%U%NR_TOWN) -! -#ifdef SFX_MPI -XTIME_INIT_TOWN = XTIME_INIT_TOWN + (MPI_WTIME() - XTIME0)*100./MAX(1,YSC%U%NSIZE_TOWN) -#endif -! -! -!* 10. Output radiative and physical fields -! ------------------------------------ -! -IF (SIZE(PDIR_ALB)>0) & - CALL AVERAGE_RAD(ZFRAC_TILE, & - ZDIR_ALB_TILE, ZSCA_ALB_TILE, ZEMIS_TILE, ZTSRAD_TILE, & - PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD ) -! -IF (SIZE(PTSURF)>0) & - CALL AVERAGE_TSURF(ZFRAC_TILE, ZTSURF_TILE, PTSURF) -! -DEALLOCATE(ZFRAC_TILE) -! -! MODIF FP SEP 2011 -DO JJ=1,KI - IF (PDIR_ALB(JJ,1)>1.) THEN - WRITE (*,*) 'JJ', JJ - WRITE (*,*) 'PDIR_ALB', PDIR_ALB(JJ,:) - WRITE (*,*) 'PSCA_ALB', PSCA_ALB(JJ,:) - WRITE (*,*) 'PEMIS', PEMIS(JJ) - WRITE (*,*) 'PTSRAD', PTSRAD(JJ) - PDIR_ALB(JJ,:) = 0.5 - PSCA_ALB(JJ,:) = 0.5 - END IF -END DO -! END MODIF FP SEP 2011 -!------------------------------------------------------------------------------- -!============================================================================== -IF (LHOOK) CALL DR_HOOK('INIT_SURF_ATM_N',1,ZHOOK_HANDLE) - CONTAINS -!============================================================================== -SUBROUTINE PACK_SURF_INIT_ARG(KSIZE,KMASK) -! -INTEGER, INTENT(IN) :: KSIZE -INTEGER, INTENT(IN), DIMENSION(:) :: KMASK -INTEGER :: JJ -REAL(KIND=JPRB) :: ZHOOK_HANDLE -! -! input arguments: -! -IF (LHOOK) CALL DR_HOOK('PACK_SURF_INIT_ARG',0,ZHOOK_HANDLE) -ALLOCATE(ZP_CO2 (KSIZE)) -ALLOCATE(ZP_RHOA (KSIZE)) -ALLOCATE(ZP_ZENITH (KSIZE)) -ALLOCATE(ZP_AZIM (KSIZE)) -! -ALLOCATE(ZP_MEGAN_FIELDS (KSIZE,YSC%IM%MSF%NMEGAN_NBR)) -ALLOCATE(ZP_DMS_FIELDS (KSIZE,YSC%SM%DSF%NDMS_NBR)) -! -! output arguments: -! -ALLOCATE(ZP_DIR_ALB(KSIZE,ISWB)) -ALLOCATE(ZP_SCA_ALB(KSIZE,ISWB)) -ALLOCATE(ZP_EMIS (KSIZE)) -ALLOCATE(ZP_TSRAD (KSIZE)) -ALLOCATE(ZP_TSURF (KSIZE)) -! -IF (KSIZE>0) THEN - ZP_CO2 = 6.E-4 - ZP_RHOA = 1.2 - ZP_ZENITH = 0. - ZP_AZIM = 0. - ZP_DIR_ALB = XUNDEF - ZP_SCA_ALB = XUNDEF - ZP_EMIS = XUNDEF - ZP_TSRAD = XUNDEF - ZP_TSURF = XUNDEF - ZP_MEGAN_FIELDS = 0. - ZP_DMS_FIELDS = 0. -END IF -! -DO JJ=1,KSIZE - IF (SIZE(PCO2)>0) & - ZP_CO2 (JJ) = PCO2 (KMASK(JJ)) - IF (SIZE(PRHOA)>0) & - ZP_RHOA (JJ) = PRHOA (KMASK(JJ)) - IF (SIZE(PZENITH)>0) THEN - IF (LZENITH) THEN - ZP_ZENITH(JJ) = PZENITH (KMASK(JJ)) - ELSE - ZP_ZENITH(JJ) = ZZENITH (KMASK(JJ)) - ENDIF - ENDIF - IF (SIZE(PAZIM )>0) THEN - IF (LZENITH) THEN - ZP_AZIM (JJ) = PAZIM (KMASK(JJ)) - ELSE - ZP_AZIM (JJ) = ZAZIM (KMASK(JJ)) - ENDIF - ENDIF -! IF (SIZE(YSC%IM%MSF%XMEGAN_FIELDS,1)>0 .AND. YSC%IM%MSF%NMEGAN_NBR>0 ) & -! ZP_MEGAN_FIELDS (JJ,:) = YSC%IM%MSF%XMEGAN_FIELDS(KMASK(JJ),:) - IF ( YSC%IM%MSF%NMEGAN_NBR>0 ) THEN - IF ( ASSOCIATED(YSC%IM%MSF%XMEGAN_FIELDS)) THEN - IF ( SIZE(YSC%IM%MSF%XMEGAN_FIELDS,1)>0 ) THEN - ZP_MEGAN_FIELDS (JJ,:) = YSC%IM%MSF%XMEGAN_FIELDS(KMASK(JJ),:) - END IF - END IF - END IF - IF ( YSC%SM%DSF%NDMS_NBR>0 ) THEN - IF ( ASSOCIATED(YSC%SM%DSF%XDMS_FIELDS)) THEN - IF ( SIZE(YSC%SM%DSF%XDMS_FIELDS,1)>0 ) THEN - ZP_DMS_FIELDS (JJ,:) = YSC%SM%DSF%XDMS_FIELDS(KMASK(JJ),:) - END IF - END IF - END IF - -ENDDO -IF (LHOOK) CALL DR_HOOK('PACK_SURF_INIT_ARG',1,ZHOOK_HANDLE) -! -END SUBROUTINE PACK_SURF_INIT_ARG -!============================================================================== -SUBROUTINE UNPACK_SURF_INIT_ARG(KTILE,KSIZE,KMASK) -! -INTEGER, INTENT(IN) :: KTILE, KSIZE -! -INTEGER, INTENT(IN), DIMENSION(:) :: KMASK -! -INTEGER :: JJ ! loop counter -REAL(KIND=JPRB) :: ZHOOK_HANDLE -! -! -IF (LHOOK) CALL DR_HOOK('UNPACK_SURF_INIT_ARG',0,ZHOOK_HANDLE) -DO JJ=1,KSIZE -IF (SIZE(ZTSRAD_TILE)>0) & - ZTSRAD_TILE (KMASK(JJ),KTILE) = ZP_TSRAD (JJ) -IF (SIZE(ZDIR_ALB_TILE)>0) & - ZDIR_ALB_TILE(KMASK(JJ),:,KTILE)= ZP_DIR_ALB (JJ,:) -IF (SIZE(ZSCA_ALB_TILE)>0) & - ZSCA_ALB_TILE(KMASK(JJ),:,KTILE)= ZP_SCA_ALB (JJ,:) -IF (SIZE(ZEMIS_TILE)>0) & - ZEMIS_TILE (KMASK(JJ),KTILE) = ZP_EMIS (JJ) -IF (SIZE(ZTSURF_TILE)>0) & - ZTSURF_TILE (KMASK(JJ),KTILE) = ZP_TSURF (JJ) -ENDDO -! -DEALLOCATE(ZP_CO2 ) -DEALLOCATE(ZP_RHOA ) -DEALLOCATE(ZP_ZENITH ) -DEALLOCATE(ZP_AZIM ) -DEALLOCATE(ZP_DIR_ALB) -DEALLOCATE(ZP_SCA_ALB) -DEALLOCATE(ZP_EMIS ) -DEALLOCATE(ZP_TSRAD ) -DEALLOCATE(ZP_TSURF ) -DEALLOCATE(ZP_MEGAN_FIELDS ) -DEALLOCATE(ZP_DMS_FIELDS ) -IF (LHOOK) CALL DR_HOOK('UNPACK_SURF_INIT_ARG',1,ZHOOK_HANDLE) -! -END SUBROUTINE UNPACK_SURF_INIT_ARG -!============================================================================== -! -END SUBROUTINE INIT_SURF_ATM_n - - diff --git a/src/ICCARE_BASE/lima_mixed_fast_processes.f90 b/src/ICCARE_BASE/lima_mixed_fast_processes.f90 deleted file mode 100644 index 525ea3dfb..000000000 --- a/src/ICCARE_BASE/lima_mixed_fast_processes.f90 +++ /dev/null @@ -1,1863 +0,0 @@ -!MNH_LIC Copyright 2013-2020 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!----------------------------------------------------------------- -! ##################################### - MODULE MODI_LIMA_MIXED_FAST_PROCESSES -! ##################################### -! -INTERFACE - SUBROUTINE LIMA_MIXED_FAST_PROCESSES (PRHODREF, PZT, PPRES, PTSTEP, & - PLSFACT, PLVFACT, PKA, PDV, PCJ, & - PRVT1D, PRCT1D, PRRT1D, PRIT1D, PRST1D, & - PRGT1D, PRTH1D, PCCT1D, PCRT1D, PCIT1D, & - PRCS1D, PRRS1D, PRIS1D, PRSS1D, PRGS1D, & - PRHS1D, PTHS1D, PCCS1D, PCRS1D, PCIS1D, & - PLBDAC, PLBDAR, PLBDAS, PLBDAG, PLBDAH, & - PRHODJ1D, GMICRO, PRHODJ, KMI, PTHS, & - PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, & - PCCS, PCRS, PCIS ) -! -REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! RHO Dry REFerence -REAL, DIMENSION(:), INTENT(IN) :: PZT ! Temperature -REAL, DIMENSION(:), INTENT(IN) :: PPRES ! Pressure -REAL, INTENT(IN) :: PTSTEP ! Time step -! -REAL, DIMENSION(:), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph) -REAL, DIMENSION(:), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph) -REAL, DIMENSION(:), INTENT(IN) :: PKA ! Thermal conductivity of the air -REAL, DIMENSION(:), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air -REAL, DIMENSION(:), INTENT(IN) :: PCJ ! Ventilation coefficient ? -! -REAL, DIMENSION(:), INTENT(IN) :: PRVT1D ! Water vapor m.r. at t -REAL, DIMENSION(:), INTENT(IN) :: PRCT1D ! Cloud water m.r. at t -REAL, DIMENSION(:), INTENT(IN) :: PRRT1D ! Rain water m.r. at t -REAL, DIMENSION(:), INTENT(IN) :: PRIT1D ! Pristine ice m.r. at t -REAL, DIMENSION(:), INTENT(IN) :: PRST1D ! Snow/aggregate m.r. at t -REAL, DIMENSION(:), INTENT(IN) :: PRGT1D ! Graupel m.r. at t -REAL, DIMENSION(:), INTENT(IN) :: PRTH1D ! Hail m.r. at t -! -REAL, DIMENSION(:), INTENT(IN) :: PCCT1D ! Cloud water conc. at t -REAL, DIMENSION(:), INTENT(IN) :: PCRT1D ! Rain water conc. at t -REAL, DIMENSION(:), INTENT(IN) :: PCIT1D ! Pristine ice conc. at t -! -REAL, DIMENSION(:), INTENT(INOUT) :: PRCS1D ! Cloud water m.r. source -REAL, DIMENSION(:), INTENT(INOUT) :: PRRS1D ! Rain water m.r. source -REAL, DIMENSION(:), INTENT(INOUT) :: PRIS1D ! Pristine ice m.r. source -REAL, DIMENSION(:), INTENT(INOUT) :: PRSS1D ! Snow/aggregate m.r. source -REAL, DIMENSION(:), INTENT(INOUT) :: PRGS1D ! Graupel/hail m.r. source -REAL, DIMENSION(:), INTENT(INOUT) :: PRHS1D ! Hail m.r. source -! -REAL, DIMENSION(:), INTENT(INOUT) :: PTHS1D ! Theta source -! -REAL, DIMENSION(:), INTENT(INOUT) :: PCCS1D ! Cloud water conc. source -REAL, DIMENSION(:), INTENT(INOUT) :: PCRS1D ! Rain water conc. source -REAL, DIMENSION(:), INTENT(INOUT) :: PCIS1D ! Pristine ice conc. source -! -REAL, DIMENSION(:), INTENT(IN) :: PLBDAC ! Slope param of the cloud droplet distr. -REAL, DIMENSION(:), INTENT(IN) :: PLBDAR ! Slope param of the raindrop distr -REAL, DIMENSION(:), INTENT(IN) :: PLBDAS ! Slope param of the aggregate distr. -REAL, DIMENSION(:), INTENT(IN) :: PLBDAG ! Slope param of the graupel distr. -REAL, DIMENSION(:), INTENT(IN) :: PLBDAH ! Slope param of the hail distr. -! -! used for budget storage -REAL, DIMENSION(:), INTENT(IN) :: PRHODJ1D -LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: GMICRO -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ -INTEGER, INTENT(IN) :: KMI -REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHS -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCS -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIS -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRSS -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGS -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHS -REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCS -REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRS -REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIS -! -END SUBROUTINE LIMA_MIXED_FAST_PROCESSES -END INTERFACE -END MODULE MODI_LIMA_MIXED_FAST_PROCESSES -! -! ############################################################################### - SUBROUTINE LIMA_MIXED_FAST_PROCESSES (PRHODREF, PZT, PPRES, PTSTEP, & - PLSFACT, PLVFACT, PKA, PDV, PCJ, & - PRVT1D, PRCT1D, PRRT1D, PRIT1D, PRST1D, & - PRGT1D, PRTH1D, PCCT1D, PCRT1D, PCIT1D, & - PRCS1D, PRRS1D, PRIS1D, PRSS1D, PRGS1D, & - PRHS1D, PTHS1D, PCCS1D, PCRS1D, PCIS1D, & - PLBDAC, PLBDAR, PLBDAS, PLBDAG, PLBDAH, & - PRHODJ1D, GMICRO, PRHODJ, KMI, PTHS, & - PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, & - PCCS, PCRS, PCIS ) -! ############################################################################### -! -!! -!! PURPOSE -!! ------- -!! The purpose of this routine is to compute the mixed-phase -!! fast processes : -!! -!! - Fast RS processes : -!! - Cloud droplet riming of the aggregates -!! - Hallett-Mossop ice multiplication process due to snow riming -!! - Rain accretion onto the aggregates -!! - Conversion-Melting of the aggregates -!! -!! - Fast RG processes : -!! - Rain contact freezing -!! - Wet/Dry growth of the graupel -!! - Hallett-Mossop ice multiplication process due to graupel riming -!! - Melting of the graupeln -!! -!! -!!** METHOD -!! ------ -!! -!! -!! REFERENCE -!! --------- -!! -!! Most of the parameterizations come from the ICE3 scheme, described in -!! the MESO-NH scientific documentation. -!! -!! Cohard, J.-M. and J.-P. Pinty, 2000: A comprehensive two-moment warm -!! microphysical bulk scheme. -!! Part I: Description and tests -!! Part II: 2D experiments with a non-hydrostatic model -!! Accepted for publication in Quart. J. Roy. Meteor. Soc. -!! -!! AUTHOR -!! ------ -!! J.-M. Cohard * Laboratoire d'Aerologie* -!! J.-P. Pinty * Laboratoire d'Aerologie* -!! S. Berthet * Laboratoire d'Aerologie* -!! B. Vié * Laboratoire d'Aerologie* -!! -!! MODIFICATIONS -!! ------------- -!! Original ??/??/13 -!! C. Barthe * LACy * jan. 2014 add budgets -! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function -! P. Wautelet 03/2020: use the new data structures and subroutines for budgets -! C. Barthe 14/03/2022: - add CIBU (from T. Hoarau's work) and RDSF (from J.P. Pinty's work) -! - change the name of some arguments to match the DOCTOR norm -! - change conditions for HMG to occur -! -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -use modd_budget, only: lbu_enable, nbumod, & - lbudget_th, lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, & - NBUDGET_TH, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, & - tbudgets -USE MODD_CST -USE MODD_NSV -USE MODD_PARAM_LIMA -USE MODD_PARAM_LIMA_COLD -USE MODD_PARAM_LIMA_MIXED -USE MODD_PARAM_LIMA_WARM, ONLY : XDR - -use mode_budget, only: Budget_store_init, Budget_store_end - -IMPLICIT NONE -! -!* 0.1 Declarations of dummy arguments : -! -REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! RHO Dry REFerence -REAL, DIMENSION(:), INTENT(IN) :: PZT ! Temperature -REAL, DIMENSION(:), INTENT(IN) :: PPRES ! Pressure -REAL, INTENT(IN) :: PTSTEP ! Time step -! -REAL, DIMENSION(:), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph) -REAL, DIMENSION(:), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph) -REAL, DIMENSION(:), INTENT(IN) :: PKA ! Thermal conductivity of the air -REAL, DIMENSION(:), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air -REAL, DIMENSION(:), INTENT(IN) :: PCJ ! Ventilation coefficient ? -! -REAL, DIMENSION(:), INTENT(IN) :: PRVT1D ! Water vapor m.r. at t -REAL, DIMENSION(:), INTENT(IN) :: PRCT1D ! Cloud water m.r. at t -REAL, DIMENSION(:), INTENT(IN) :: PRRT1D ! Rain water m.r. at t -REAL, DIMENSION(:), INTENT(IN) :: PRIT1D ! Pristine ice m.r. at t -REAL, DIMENSION(:), INTENT(IN) :: PRST1D ! Snow/aggregate m.r. at t -REAL, DIMENSION(:), INTENT(IN) :: PRGT1D ! Graupel/hail m.r. at t -REAL, DIMENSION(:), INTENT(IN) :: PRTH1D ! Hail m.r. at t -! -REAL, DIMENSION(:), INTENT(IN) :: PCCT1D ! Cloud water conc. at t -REAL, DIMENSION(:), INTENT(IN) :: PCRT1D ! Rain water conc. at t -REAL, DIMENSION(:), INTENT(IN) :: PCIT1D ! Pristine ice conc. at t -! -REAL, DIMENSION(:), INTENT(INOUT) :: PRCS1D ! Cloud water m.r. source -REAL, DIMENSION(:), INTENT(INOUT) :: PRRS1D ! Rain water m.r. source -REAL, DIMENSION(:), INTENT(INOUT) :: PRIS1D ! Pristine ice m.r. source -REAL, DIMENSION(:), INTENT(INOUT) :: PRSS1D ! Snow/aggregate m.r. source -REAL, DIMENSION(:), INTENT(INOUT) :: PRGS1D ! Graupel/hail m.r. source -REAL, DIMENSION(:), INTENT(INOUT) :: PRHS1D ! Hail m.r. source -! -REAL, DIMENSION(:), INTENT(INOUT) :: PTHS1D ! Theta source -! -REAL, DIMENSION(:), INTENT(INOUT) :: PCCS1D ! Cloud water conc. source -REAL, DIMENSION(:), INTENT(INOUT) :: PCRS1D ! Rain water conc. source -REAL, DIMENSION(:), INTENT(INOUT) :: PCIS1D ! Pristine ice conc. source -! -REAL, DIMENSION(:), INTENT(IN) :: PLBDAC ! Slope param of the cloud droplet distr. -REAL, DIMENSION(:), INTENT(IN) :: PLBDAR ! Slope param of the raindrop distr -REAL, DIMENSION(:), INTENT(IN) :: PLBDAS ! Slope param of the aggregate distr. -REAL, DIMENSION(:), INTENT(IN) :: PLBDAG ! Slope param of the graupel distr. -REAL, DIMENSION(:), INTENT(IN) :: PLBDAH ! Slope param of the hail distr. -! -! used for budget storage -REAL, DIMENSION(:), INTENT(IN) :: PRHODJ1D -LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: GMICRO -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ -INTEGER, INTENT(IN) :: KMI -REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHS -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCS -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIS -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRSS -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGS -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHS -REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCS -REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRS -REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIS - -! -!* 0.2 Declarations of local variables : -! -LOGICAL, DIMENSION(SIZE(PZT)) :: GRIM, GACC, GDRY, GWET, GHAIL ! Test where to compute -INTEGER :: IGRIM, IGACC, IGDRY, IGWET, IHAIL -INTEGER :: JJ -INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1,IVEC2 ! Vectors of indices -REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1,ZVEC2, ZVEC3 ! Work vectors -REAL, DIMENSION(SIZE(PZT)) :: ZZW, ZZX -REAL, DIMENSION(SIZE(PZT)) :: ZRDRYG, ZRWETG -REAL, DIMENSION(SIZE(PZT),7) :: ZZW1 -REAL :: NHAIL -REAL :: ZTHRH, ZTHRC -! -! Variables for CIBU -LOGICAL, DIMENSION(SIZE(PZT)) :: GCIBU ! Test where to compute collision process -LOGICAL, SAVE :: GFIRSTCALL = .TRUE. ! control switch for the first call -! -INTEGER :: ICIBU -INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC2_S1,IVEC2_S2 ! Snow indice vector -INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC2_G ! Graupel indice vector -INTEGER, PARAMETER :: I_SEED_PARAM = 26032012 -INTEGER, DIMENSION(:), ALLOCATABLE :: I_SEED -INTEGER :: NI_SEED -! -REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1_S, ZVEC1_S1, ZVEC1_S2, & ! Work vectors - ZVEC1_S3, ZVEC1_S4, & - ZVEC1_S11, ZVEC1_S12, & ! for snow - ZVEC1_S21, ZVEC1_S22, & - ZVEC1_S31, ZVEC1_S32, & - ZVEC1_S41, ZVEC1_S42, & - ZVEC2_S1, ZVEC2_S2 -REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1_G, ZVEC1_G1, ZVEC1_G2, & ! Work vectors - ZVEC2_G ! for graupel -REAL, DIMENSION(:), ALLOCATABLE :: ZINTG_SNOW_1, & ! incomplete gamma function - ZINTG_SNOW_2, & ! for snow - ZINTG_SNOW_3, & - ZINTG_SNOW_4 -REAL, DIMENSION(:), ALLOCATABLE :: ZINTG_GRAUPEL_1, & ! incomplete gamma - ZINTG_GRAUPEL_2 ! function for graupel -REAL, DIMENSION(:), ALLOCATABLE :: ZNI_CIBU, ZRI_CIBU ! CIBU rates -REAL, DIMENSION(:), ALLOCATABLE :: ZFRAGMENTS, ZHARVEST, ZFRAG_CIBU -REAL :: ZFACT1_XNDEBRIS, ZFACT2_XNDEBRIS -! -LOGICAL, DIMENSION(SIZE(PZT)) :: GRDSF ! Test where to compute collision process -INTEGER :: IRDSF -REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1_R ! Work vectors for rain -REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1_R1 ! Work vectors for rain -REAL, DIMENSION(:), ALLOCATABLE :: ZVEC2_R ! Work vectors for rain -INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC2_R ! Rain indice vector -REAL, DIMENSION(:), ALLOCATABLE :: ZINTG_RAIN ! incomplete gamma function for rain -REAL, DIMENSION(:), ALLOCATABLE :: ZNI_RDSF,ZRI_RDSF ! RDSF rates -! -REAL, DIMENSION(:), ALLOCATABLE :: ZAUX ! used to distribute -REAL, DIMENSION(:,:), ALLOCATABLE :: ZFACT ! the total concentration in each shape -REAL, DIMENSION(:), ALLOCATABLE :: ZONEOVER_VAR ! for optimization -! -! -!------------------------------------------------------------------------------- -! -! ################# -! FAST RS PROCESSES -! ################# -! -SNOW: IF (LSNOW) THEN -! -! -!* 1.1 Cloud droplet riming of the aggregates -! ------------------------------------------- -! -ZZW1(:,:) = 0.0 -! -GRIM(:) = (PRCT1D(:)>XRTMIN(2)) .AND. (PRST1D(:)>XRTMIN(5)) .AND. (PRCS1D(:)>XRTMIN(2)/PTSTEP) .AND. (PZT(:)<XTT) -IGRIM = COUNT( GRIM(:) ) -! -IF( IGRIM>0 ) THEN - if ( nbumod == kmi .and. lbu_enable ) then - if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'RIM', & - Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'RIM', & - Unpack( prcs1d(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'RIM', & - Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'RIM', & - Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'RIM', & - Unpack( pccs1d(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) ) - end if -! -! 1.1.0 allocations -! - ALLOCATE(ZVEC1(IGRIM)) - ALLOCATE(ZVEC2(IGRIM)) - ALLOCATE(IVEC1(IGRIM)) - ALLOCATE(IVEC2(IGRIM)) -! -! 1.1.1 select the PLBDAS -! - ZVEC1(:) = PACK( PLBDAS(:),MASK=GRIM(:) ) -! -! 1.1.2 find the next lower indice for the PLBDAS in the geometrical -! set of Lbda_s used to tabulate some moments of the incomplete -! gamma function -! - ZVEC2(1:IGRIM) = MAX( 1.0001, MIN( REAL(NGAMINC)-0.0001, & - XRIMINTP1 * LOG( ZVEC1(1:IGRIM) ) + XRIMINTP2 ) ) - IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) ) - ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - REAL( IVEC2(1:IGRIM) ) -! -! 1.1.3 perform the linear interpolation of the normalized -! "2+XDS"-moment of the incomplete gamma function -! - ZVEC1(1:IGRIM) = XGAMINC_RIM1( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) & - - XGAMINC_RIM1( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0) - ZZW(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GRIM,FIELD=0.0 ) -! -! 1.1.4 riming of the small sized aggregates -! - WHERE ( GRIM(:) ) - ZZW1(:,1) = MIN( PRCS1D(:), & - XCRIMSS * ZZW(:) * PRCT1D(:) & ! RCRIMSS - * PLBDAS(:)**XEXCRIMSS & - * PRHODREF(:)**(-XCEXVT) ) - PRCS1D(:) = PRCS1D(:) - ZZW1(:,1) - PRSS1D(:) = PRSS1D(:) + ZZW1(:,1) - PTHS1D(:) = PTHS1D(:) + ZZW1(:,1) * (PLSFACT(:) - PLVFACT(:)) ! f(L_f*(RCRIMSS)) -! - PCCS1D(:) = MAX( PCCS1D(:)-ZZW1(:,1)*(PCCT1D(:)/PRCT1D(:)),0.0 ) ! Lambda_c**3 - END WHERE -! -! 1.1.5 perform the linear interpolation of the normalized -! "XBS"-moment of the incomplete gamma function -! - ZVEC1(1:IGRIM) = XGAMINC_RIM2( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) & - - XGAMINC_RIM2( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0) - ZZW(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GRIM,FIELD=0.0 ) -! -! 1.1.6 riming-conversion of the large sized aggregates into graupeln -! - WHERE ( GRIM(:) .AND. (PRSS1D(:)>XRTMIN(5)/PTSTEP) ) - ZZW1(:,2) = MIN( PRCS1D(:), & - XCRIMSG * PRCT1D(:) & ! RCRIMSG - * PLBDAS(:)**XEXCRIMSG & - * PRHODREF(:)**(-XCEXVT) & - - ZZW1(:,1) ) - ZZW1(:,3) = MIN( PRSS1D(:), & - XSRIMCG * PLBDAS(:)**XEXSRIMCG & ! RSRIMCG - * (1.0 - ZZW(:) )/(PTSTEP*PRHODREF(:))) - PRCS1D(:) = PRCS1D(:) - ZZW1(:,2) - PRSS1D(:) = PRSS1D(:) - ZZW1(:,3) - PRGS1D(:) = PRGS1D(:) + ZZW1(:,2) + ZZW1(:,3) - PTHS1D(:) = PTHS1D(:) + ZZW1(:,2) * (PLSFACT(:) - PLVFACT(:)) ! f(L_f*(RCRIMSG)) - ! - PCCS1D(:) = MAX( PCCS1D(:)-ZZW1(:,2)*(PCCT1D(:)/PRCT1D(:)),0.0 ) ! Lambda_c**3 - END WHERE - DEALLOCATE(IVEC2) - DEALLOCATE(IVEC1) - DEALLOCATE(ZVEC2) - DEALLOCATE(ZVEC1) - ! - ! Budget storage - if ( nbumod == kmi .and. lbu_enable ) then - if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'RIM', & - Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'RIM', & - Unpack( prcs1d(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'RIM', & - Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'RIM', & - Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'RIM', & - Unpack( pccs1d(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) ) - end if -END IF -! -! -!* 1.2 Hallett-Mossop ice multiplication process due to snow riming -! ----------------------------------------------------------------- -! -GRIM(:) = (PZT(:)<XHMTMAX) .AND. (PZT(:)>XHMTMIN) & - .AND. (PRST1D(:)>XRTMIN(5)) .AND. (PRCT1D(:)>XRTMIN(2)) -IGRIM = COUNT( GRIM(:) ) -IF( IGRIM>0 ) THEN - ! Budget storage - if ( nbumod == kmi .and. lbu_enable ) then - if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HMS', & - Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'HMS', & - Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HMS', & - Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) - end if - - ALLOCATE(ZVEC1(IGRIM)) - ALLOCATE(ZVEC2(IGRIM)) - ALLOCATE(IVEC2(IGRIM)) -! - ZVEC1(:) = PACK( PLBDAC(:),MASK=GRIM(:) ) - ZVEC2(1:IGRIM) = MAX( 1.0001, MIN( REAL(NGAMINC)-0.0001, & - XHMLINTP1 * LOG( ZVEC1(1:IGRIM) ) + XHMLINTP2 ) ) - IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) ) - ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - REAL( IVEC2(1:IGRIM) ) - ZVEC1(1:IGRIM) = XGAMINC_HMC( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) & - - XGAMINC_HMC( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0) - ZZX(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GRIM,FIELD=0.0 ) ! Large droplets -! - WHERE ( GRIM(:) .AND. ZZX(:)<0.99 ) - ZZW1(:,5) = (ZZW1(:,1)+ZZW1(:,2))*(PCCT1D(:)/PRCT1D(:))*(1.0-ZZX(:))* & - XHM_FACTS* & - MAX( 0.0, MIN( (PZT(:)-XHMTMIN)/3.0,(XHMTMAX-PZT(:))/2.0 ) ) ! CCHMSI - PCIS1D(:) = PCIS1D(:) + ZZW1(:,5) -! - ZZW1(:,6) = ZZW1(:,5) * XMNU0 ! RCHMSI - PRIS1D(:) = PRIS1D(:) + ZZW1(:,6) - PRSS1D(:) = PRSS1D(:) - ZZW1(:,6) - END WHERE - DEALLOCATE(IVEC2) - DEALLOCATE(ZVEC2) - DEALLOCATE(ZVEC1) - ! - ! Budget storage - if ( nbumod == kmi .and. lbu_enable ) then - if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HMS', & - Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'HMS', & - Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HMS', & - Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) - end if -END IF -! -! -!* 1.3 Ice multiplication process due to ice-ice collisions -! --------------------------------------------------------- -! -GCIBU(:) = LCIBU .AND. (PRST1D(:)>XRTMIN(5)) .AND. (PRGT1D(:)>XRTMIN(6)) -ICIBU = COUNT( GCIBU(:) ) -! -IF (ICIBU > 0) THEN -! - ! Budget storage - if ( nbumod == kmi .and. lbu_enable ) then - if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CIBU', & - Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'CIBU', & - Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CIBU', & - Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) - end if -! -! 1.3.0 randomization of XNDEBRIS_CIBU values -! - IF (GFIRSTCALL) THEN - CALL RANDOM_SEED(SIZE=NI_SEED) ! get size of seed - ALLOCATE(I_SEED(NI_SEED)) - I_SEED(:) = I_SEED_PARAM ! - CALL RANDOM_SEED(PUT=I_SEED) - GFIRSTCALL = .FALSE. - END IF -! - ALLOCATE(ZFRAGMENTS(ICIBU)) -! - IF (XNDEBRIS_CIBU >= 0.0) THEN - ZFRAGMENTS(:) = XNDEBRIS_CIBU - ELSE -! -! Mantissa gives the mean value (randomization around 10**MANTISSA) -! First digit after the comma provides the full range around 10**MANTISSA -! - ALLOCATE(ZHARVEST(ICIBU)) -! - ZFACT1_XNDEBRIS = AINT(XNDEBRIS_CIBU) - ZFACT2_XNDEBRIS = ABS(ANINT(10.0*(XNDEBRIS_CIBU - ZFACT1_XNDEBRIS))) -! - CALL RANDOM_NUMBER(ZHARVEST(:)) -! - ZFRAGMENTS(:) = 10.0**(ZFACT2_XNDEBRIS*ZHARVEST(:) + ZFACT1_XNDEBRIS) -! - DEALLOCATE(ZHARVEST) -! -! ZFRAGMENTS is a random variable containing the number of fragments per collision -! For XNDEBRIS_CIBU=-1.2345 => ZFRAGMENTS(:) = 10.0**(2.0*RANDOM_NUMBER(ZHARVEST(:)) - 1.0) -! and ZFRAGMENTS=[0.1, 10.0] centered around 1.0 -! - END IF -! -! -! 1.3.1 To compute the partial integration of snow gamma function -! -! 1.3.1.0 allocations -! - ALLOCATE(ZVEC1_S(ICIBU)) - ALLOCATE(ZVEC1_S1(ICIBU)) - ALLOCATE(ZVEC1_S2(ICIBU)) - ALLOCATE(ZVEC1_S3(ICIBU)) - ALLOCATE(ZVEC1_S4(ICIBU)) - ALLOCATE(ZVEC1_S11(ICIBU)) - ALLOCATE(ZVEC1_S12(ICIBU)) - ALLOCATE(ZVEC1_S21(ICIBU)) - ALLOCATE(ZVEC1_S22(ICIBU)) - ALLOCATE(ZVEC1_S31(ICIBU)) - ALLOCATE(ZVEC1_S32(ICIBU)) - ALLOCATE(ZVEC1_S41(ICIBU)) - ALLOCATE(ZVEC1_S42(ICIBU)) - ALLOCATE(ZVEC2_S1(ICIBU)) - ALLOCATE(IVEC2_S1(ICIBU)) - ALLOCATE(ZVEC2_S2(ICIBU)) - ALLOCATE(IVEC2_S2(ICIBU)) -! -! -! 1.3.1.1 select the PLBDAS -! - ZVEC1_S(:) = PACK( PLBDAS(:),MASK=GCIBU(:) ) -! -! -! 1.3.1.2 find the next lower indice for the PLBDAS in the -! geometrical set of Lbda_s used to tabulate some moments of the -! incomplete gamma function, for boundary 1 (0.2 mm) -! - ZVEC2_S1(1:ICIBU) = MAX( 1.0001, MIN( FLOAT(NGAMINC)-0.0001,XCIBUINTP_S & - * LOG( ZVEC1_S(1:ICIBU) ) + XCIBUINTP1_S ) ) - IVEC2_S1(1:ICIBU) = INT( ZVEC2_S1(1:ICIBU) ) - ZVEC2_S1(1:ICIBU) = ZVEC2_S1(1:ICIBU) - FLOAT( IVEC2_S1(1:ICIBU) ) -! -! -! 1.3.1.3 find the next lower indice for the PLBDAS in the -! geometrical set of Lbda_s used to tabulate some moments of the -! incomplete gamma function, for boundary 2 (1 mm) -! - ZVEC2_S2(1:ICIBU) = MAX( 1.0001, MIN( FLOAT(NGAMINC)-0.0001,XCIBUINTP_S & - * LOG( ZVEC1_S(1:ICIBU) ) + XCIBUINTP2_S ) ) - IVEC2_S2(1:ICIBU) = INT( ZVEC2_S2(1:ICIBU) ) - ZVEC2_S2(1:ICIBU) = ZVEC2_S2(1:ICIBU) - FLOAT( IVEC2_S2(1:ICIBU) ) -! -! -! 1.3.1.4 perform the linear interpolation of the -! normalized "0"-moment of the incomplete gamma function -! -! For lower boundary (0.2 mm) - ZVEC1_S11(1:ICIBU) = XGAMINC_CIBU_S(1,IVEC2_S1(1:ICIBU)+1) * ZVEC2_S1(1:ICIBU) & - - XGAMINC_CIBU_S(1,IVEC2_S1(1:ICIBU)) * (ZVEC2_S1(1:ICIBU)-1.0) -! -! For upper boundary (1 mm) - ZVEC1_S12(1:ICIBU) = XGAMINC_CIBU_S(1,IVEC2_S2(1:ICIBU)+1) * ZVEC2_S2(1:ICIBU) & - - XGAMINC_CIBU_S(1,IVEC2_S2(1:ICIBU)) * (ZVEC2_S2(1:ICIBU)-1.0) -! -! Computation of spectrum from 0.2 mm to 1 mm - ZVEC1_S1(1:ICIBU) = ZVEC1_S12(1:ICIBU) - ZVEC1_S11(1:ICIBU) -! -! -! 1.3.1.5 perform the linear interpolation of the -! normalized "XDS"-moment of the incomplete gamma function -! -! For lower boundary (0.2 mm) - ZVEC1_S21(1:ICIBU) = XGAMINC_CIBU_S(2,IVEC2_S1(1:ICIBU)+1) * ZVEC2_S1(1:ICIBU) & - - XGAMINC_CIBU_S(2,IVEC2_S1(1:ICIBU)) * (ZVEC2_S1(1:ICIBU)-1.0) -! -! For upper boundary (1 mm) - ZVEC1_S22(1:ICIBU) = XGAMINC_CIBU_S(2,IVEC2_S2(1:ICIBU)+1) * ZVEC2_S2(1:ICIBU) & - - XGAMINC_CIBU_S(2,IVEC2_S2(1:ICIBU)) * (ZVEC2_S2(1:ICIBU)-1.0) -! -! From 0.2 mm to 1 mm we need - ZVEC1_S2(1:ICIBU) = XMOMGS_CIBU_1 * (ZVEC1_S22(1:ICIBU) - ZVEC1_S21(1:ICIBU)) -! -! For lower boundary (0.2 mm) - ZVEC1_S31(1:ICIBU) = XGAMINC_CIBU_S(3,IVEC2_S1(1:ICIBU)+1) * ZVEC2_S1(1:ICIBU) & - - XGAMINC_CIBU_S(3,IVEC2_S1(1:ICIBU)) * (ZVEC2_S1(1:ICIBU)-1.0) -! -! For upper boundary (1 mm) - ZVEC1_S32(1:ICIBU) = XGAMINC_CIBU_S(3,IVEC2_S2(1:ICIBU)+1) * ZVEC2_S2(1:ICIBU) & - - XGAMINC_CIBU_S(3,IVEC2_S2(1:ICIBU)) * (ZVEC2_S2(1:ICIBU)-1.0) -! -! From 0.2 mm to 1 mm we need - ZVEC1_S3(1:ICIBU) = XMOMGS_CIBU_2 * (ZVEC1_S32(1:ICIBU) - ZVEC1_S31(1:ICIBU)) -! -! -! 1.3.1.6 perform the linear interpolation of the -! normalized "XBS+XDS"-moment of the incomplete gamma function -! -! For lower boundary (0.2 mm) - ZVEC1_S41(1:ICIBU) = XGAMINC_CIBU_S(4,IVEC2_S1(1:ICIBU)+1) * ZVEC2_S1(1:ICIBU) & - - XGAMINC_CIBU_S(4,IVEC2_S1(1:ICIBU)) * (ZVEC2_S1(1:ICIBU)-1.0) -! -! For upper boundary (1 mm) - ZVEC1_S42(1:ICIBU) = XGAMINC_CIBU_S(4,IVEC2_S2(1:ICIBU)+1) * ZVEC2_S2(1:ICIBU) & - - XGAMINC_CIBU_S(4,IVEC2_S2(1:ICIBU)) * (ZVEC2_S2(1:ICIBU)-1.0) -! -! From 0.2 mm to 1 mm we need - ZVEC1_S4(1:ICIBU) = XMOMGS_CIBU_3 * (ZVEC1_S42(1:ICIBU) - ZVEC1_S41(1:ICIBU)) -! - ALLOCATE(ZINTG_SNOW_1(SIZE(PZT))) - ALLOCATE(ZINTG_SNOW_2(SIZE(PZT))) - ALLOCATE(ZINTG_SNOW_3(SIZE(PZT))) - ALLOCATE(ZINTG_SNOW_4(SIZE(PZT))) -! - ZINTG_SNOW_1(:) = UNPACK ( VECTOR=ZVEC1_S1(:),MASK=GCIBU,FIELD=0.0 ) - ZINTG_SNOW_2(:) = UNPACK ( VECTOR=ZVEC1_S2(:),MASK=GCIBU,FIELD=0.0 ) - ZINTG_SNOW_3(:) = UNPACK ( VECTOR=ZVEC1_S3(:),MASK=GCIBU,FIELD=0.0 ) - ZINTG_SNOW_4(:) = UNPACK ( VECTOR=ZVEC1_S4(:),MASK=GCIBU,FIELD=0.0 ) -! -! -! 1.3.2 Compute the partial integration of graupel gamma function -! -! 1.3.2.0 allocations -! - ALLOCATE(ZVEC1_G(ICIBU)) - ALLOCATE(ZVEC1_G1(ICIBU)) - ALLOCATE(ZVEC1_G2(ICIBU)) - ALLOCATE(ZVEC2_G(ICIBU)) - ALLOCATE(IVEC2_G(ICIBU)) -! -! -! 1.3.2.1 select the PLBDAG -! - ZVEC1_G(:) = PACK( PLBDAG(:),MASK=GCIBU(:) ) -! -! -! 1.3.2.2 find the next lower indice for the PLBDAG in the -! geometrical set of Lbda_g used to tabulate some moments of the -! incomplete gamma function, for the "2mm" boundary -! - ZVEC2_G(1:ICIBU) = MAX( 1.0001, MIN( FLOAT(NGAMINC)-0.0001,XCIBUINTP_G & - * LOG( ZVEC1_G(1:ICIBU) ) + XCIBUINTP1_G ) ) - IVEC2_G(1:ICIBU) = INT( ZVEC2_G(1:ICIBU) ) - ZVEC2_G(1:ICIBU) = ZVEC2_G(1:ICIBU) - FLOAT( IVEC2_G(1:ICIBU) ) -! -! -! 1.3.2.3 perform the linear interpolation of the -! normalized "2+XDG"-moment of the incomplete gamma function -! - ZVEC1_G1(1:ICIBU) = XGAMINC_CIBU_G(1,IVEC2_G(1:ICIBU)+1) * ZVEC2_G(1:ICIBU) & - - XGAMINC_CIBU_G(1,IVEC2_G(1:ICIBU)) * (ZVEC2_G(1:ICIBU)-1.0) -! -! From 2 mm to infinity we need - ZVEC1_G1(1:ICIBU) = XMOMGG_CIBU_1 * (1.0 - ZVEC1_G1(1:ICIBU)) -! -! -! 1.3.2.4 perform the linear interpolation of the -! normalized "2.0"-moment of the incomplete gamma function -! - ZVEC1_G2(1:ICIBU) = XGAMINC_CIBU_G(2,IVEC2_G(1:ICIBU)+1) * ZVEC2_G(1:ICIBU) & - - XGAMINC_CIBU_G(2,IVEC2_G(1:ICIBU)) * (ZVEC2_G(1:ICIBU)-1.0) -! -! From 2 mm to infinity we need - ZVEC1_G2(1:ICIBU) = XMOMGG_CIBU_2 * (1.0 - ZVEC1_G2(1:ICIBU)) -! -! - ALLOCATE(ZINTG_GRAUPEL_1(SIZE(PZT))) - ALLOCATE(ZINTG_GRAUPEL_2(SIZE(PZT))) -! - ZINTG_GRAUPEL_1(:) = UNPACK ( VECTOR=ZVEC1_G1(:),MASK=GCIBU,FIELD=0.0 ) - ZINTG_GRAUPEL_2(:) = UNPACK ( VECTOR=ZVEC1_G2(:),MASK=GCIBU,FIELD=0.0 ) -! -! -! 1.3.3 To compute final "CIBU" contributions -! - ALLOCATE(ZNI_CIBU(SIZE(PZT))) - ALLOCATE(ZFRAG_CIBU(SIZE(PZT))) -! - ZFRAG_CIBU(:) = UNPACK ( VECTOR=ZFRAGMENTS(:),MASK=GCIBU,FIELD=0.0 ) - ZNI_CIBU(:) = ZFRAG_CIBU(:) * (XFACTOR_CIBU_NI / (PRHODREF(:)**(XCEXVT-1.0))) * & - (XCG * ZINTG_GRAUPEL_1(:) * ZINTG_SNOW_1(:) * & - PLBDAS(:)**(XCXS) * PLBDAG(:)**(XCXG-(XDG+2.0)) & - - XCS * ZINTG_GRAUPEL_2(:) * ZINTG_SNOW_2(:) * & - PLBDAS(:)**(XCXS-XDS) * PLBDAG(:)**(XCXG-2.0) ) - PCIS1D(:) = PCIS1D(:) + MAX(ZNI_CIBU(:), 0.) -! - DEALLOCATE(ZFRAG_CIBU) - DEALLOCATE(ZFRAGMENTS) -! -! Max value of rs removed by CIBU - ALLOCATE(ZRI_CIBU(SIZE(PZT))) - ZRI_CIBU(:) = (XFACTOR_CIBU_RI / (PRHODREF(:)**(XCEXVT+1.0))) * & - (XCG * ZINTG_GRAUPEL_1(:) * ZINTG_SNOW_3(:) * & - PLBDAS(:)**(XCXS-XBS) * PLBDAG(:)**(XCXG-(XDG+2.0)) & - - XCS * ZINTG_GRAUPEL_2(:) * ZINTG_SNOW_4(:) * & - PLBDAS(:)**(XCXS-(XBS+XDS)) * PLBDAG(:)**(XCXG-2.0)) -! -! The value of rs removed by CIBU is determined by the mean mass of pristine ice - WHERE( PRIT1D(:)>XRTMIN(4) .AND. PCIT1D(:)>XCTMIN(4) ) - ZRI_CIBU(:) = MIN( ZRI_CIBU(:), PRSS1D(:), ZNI_CIBU(:)*PRIT1D(:)/PCIT1D(:) ) - ELSE WHERE - ZRI_CIBU(:) = MIN( ZRI_CIBU(:), PRSS1D(:), MAX( ZNI_CIBU(:)*XMNU0,XRTMIN(4) ) ) - END WHERE -! - PRIS1D(:) = PRIS1D(:) + MAX(ZRI_CIBU(:), 0.) ! - PRSS1D(:) = PRSS1D(:) - MAX(ZRI_CIBU(:), 0.) ! -! - DEALLOCATE(ZVEC1_S) - DEALLOCATE(ZVEC1_S1) - DEALLOCATE(ZVEC1_S2) - DEALLOCATE(ZVEC1_S3) - DEALLOCATE(ZVEC1_S4) - DEALLOCATE(ZVEC1_S11) - DEALLOCATE(ZVEC1_S12) - DEALLOCATE(ZVEC1_S21) - DEALLOCATE(ZVEC1_S22) - DEALLOCATE(ZVEC1_S31) - DEALLOCATE(ZVEC1_S32) - DEALLOCATE(ZVEC1_S41) - DEALLOCATE(ZVEC1_S42) - DEALLOCATE(ZVEC2_S1) - DEALLOCATE(IVEC2_S1) - DEALLOCATE(ZVEC2_S2) - DEALLOCATE(IVEC2_S2) - DEALLOCATE(ZVEC1_G) - DEALLOCATE(ZVEC1_G1) - DEALLOCATE(ZVEC1_G2) - DEALLOCATE(ZVEC2_G) - DEALLOCATE(IVEC2_G) - DEALLOCATE(ZINTG_SNOW_1) - DEALLOCATE(ZINTG_SNOW_2) - DEALLOCATE(ZINTG_SNOW_3) - DEALLOCATE(ZINTG_SNOW_4) - DEALLOCATE(ZINTG_GRAUPEL_1) - DEALLOCATE(ZINTG_GRAUPEL_2) - DEALLOCATE(ZNI_CIBU) - DEALLOCATE(ZRI_CIBU) - ! - ! Budget storage - if ( nbumod == kmi .and. lbu_enable ) then - if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CIBU', & - Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'CIBU', & - Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CIBU', & - Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) - end if -END IF -! -! -!* 1.4 Rain accretion onto the aggregates -! --------------------------------------- -! -! -ZZW1(:,2:3) = 0.0 -GACC(:) = (PRRT1D(:)>XRTMIN(3)) .AND. (PRST1D(:)>XRTMIN(5)) .AND. (PRRS1D(:)>XRTMIN(3)/PTSTEP) .AND. (PZT(:)<XTT) -IGACC = COUNT( GACC(:) ) -! -IF( IGACC>0 .AND. LRAIN) THEN - ! Budget storage - if ( nbumod == kmi .and. lbu_enable ) then - if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'ACC', & - Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'ACC', & - Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'ACC', & - Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'ACC', & - Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'ACC', & - Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) - end if -! -! 1.4.0 allocations -! - ALLOCATE(ZVEC1(IGACC)) - ALLOCATE(ZVEC2(IGACC)) - ALLOCATE(ZVEC3(IGACC)) - ALLOCATE(IVEC1(IGACC)) - ALLOCATE(IVEC2(IGACC)) -! -! 1.4.1 select the (PLBDAS,PLBDAR) couplet -! - ZVEC1(:) = PACK( PLBDAS(:),MASK=GACC(:) ) - ZVEC2(:) = PACK( PLBDAR(:),MASK=GACC(:) ) -! -! 1.4.2 find the next lower indice for the PLBDAS and for the PLBDAR -! in the geometrical set of (Lbda_s,Lbda_r) couplet use to -! tabulate the RACCSS-kernel -! - ZVEC1(1:IGACC) = MAX( 1.0001, MIN( REAL(NACCLBDAS)-0.0001, & - XACCINTP1S * LOG( ZVEC1(1:IGACC) ) + XACCINTP2S ) ) - IVEC1(1:IGACC) = INT( ZVEC1(1:IGACC) ) - ZVEC1(1:IGACC) = ZVEC1(1:IGACC) - REAL( IVEC1(1:IGACC) ) -! - ZVEC2(1:IGACC) = MAX( 1.0001, MIN( REAL(NACCLBDAR)-0.0001, & - XACCINTP1R * LOG( ZVEC2(1:IGACC) ) + XACCINTP2R ) ) - IVEC2(1:IGACC) = INT( ZVEC2(1:IGACC) ) - ZVEC2(1:IGACC) = ZVEC2(1:IGACC) - REAL( IVEC2(1:IGACC) ) -! -! 1.4.3 perform the bilinear interpolation of the normalized -! RACCSS-kernel -! - DO JJ = 1,IGACC - ZVEC3(JJ) = ( XKER_RACCSS(IVEC1(JJ)+1,IVEC2(JJ)+1) * ZVEC2(JJ) & - - XKER_RACCSS(IVEC1(JJ)+1,IVEC2(JJ) ) * (ZVEC2(JJ) - 1.0) ) & - * ZVEC1(JJ) & - - ( XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ)+1) * ZVEC2(JJ) & - - XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ) ) * (ZVEC2(JJ) - 1.0) ) & - * (ZVEC1(JJ) - 1.0) - END DO - ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GACC,FIELD=0.0 ) -! -! 1.4.4 raindrop accretion on the small sized aggregates -! - WHERE ( GACC(:) ) - ZZW1(:,2) = PCRT1D(:) * & !! coef of RRACCS - XFRACCSS*( PLBDAS(:)**XCXS )*( PRHODREF(:)**(-XCEXVT-1.) ) & - *( XLBRACCS1/((PLBDAS(:)**2) ) + & - XLBRACCS2/( PLBDAS(:) * PLBDAR(:) ) + & - XLBRACCS3/( (PLBDAR(:)**2)) )/PLBDAR(:)**3 - ZZW1(:,4) = MIN( PRRS1D(:),ZZW1(:,2)*ZZW(:) ) ! RRACCSS - PRRS1D(:) = PRRS1D(:) - ZZW1(:,4) - PRSS1D(:) = PRSS1D(:) + ZZW1(:,4) - PTHS1D(:) = PTHS1D(:) + ZZW1(:,4) * (PLSFACT(:) - PLVFACT(:)) ! f(L_f*(RRACCSS)) -! - PCRS1D(:) = MAX( PCRS1D(:)-ZZW1(:,4)*(PCRT1D(:)/PRRT1D(:)),0.0 ) ! Lambda_r**3 - END WHERE -! -! 1.4.4b perform the bilinear interpolation of the normalized -! RACCS-kernel -! - DO JJ = 1,IGACC - ZVEC3(JJ) = ( XKER_RACCS(IVEC1(JJ)+1,IVEC2(JJ)+1) * ZVEC2(JJ) & - - XKER_RACCS(IVEC1(JJ)+1,IVEC2(JJ) ) * (ZVEC2(JJ) - 1.0) ) & - * ZVEC1(JJ) & - - ( XKER_RACCS(IVEC1(JJ) ,IVEC2(JJ)+1) * ZVEC2(JJ) & - - XKER_RACCS(IVEC1(JJ) ,IVEC2(JJ) ) * (ZVEC2(JJ) - 1.0) ) & - * (ZVEC1(JJ) - 1.0) - END DO - ZZW1(:,2) = ZZW1(:,2)*UNPACK( VECTOR=ZVEC3(:),MASK=GACC(:),FIELD=0.0 ) !! RRACCS -! -! 1.4.5 perform the bilinear interpolation of the normalized -! SACCRG-kernel -! - DO JJ = 1,IGACC - ZVEC3(JJ) = ( XKER_SACCRG(IVEC2(JJ)+1,IVEC1(JJ)+1) * ZVEC1(JJ) & - - XKER_SACCRG(IVEC2(JJ)+1,IVEC1(JJ) ) * (ZVEC1(JJ) - 1.0) ) & - * ZVEC2(JJ) & - - ( XKER_SACCRG(IVEC2(JJ) ,IVEC1(JJ)+1) * ZVEC1(JJ) & - - XKER_SACCRG(IVEC2(JJ) ,IVEC1(JJ) ) * (ZVEC1(JJ) - 1.0) ) & - * (ZVEC2(JJ) - 1.0) - END DO - ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GACC,FIELD=0.0 ) -! -! 1.4.6 raindrop accretion-conversion of the large sized aggregates -! into graupeln -! - WHERE ( GACC(:) .AND. (PRSS1D(:)>XRTMIN(5)/PTSTEP) ) - ZZW1(:,2) = MAX( MIN( PRRS1D(:),ZZW1(:,2)-ZZW1(:,4) ) , 0. ) ! RRACCSG - ZZW1(:,3) = MIN( PRSS1D(:),XFSACCRG*ZZW(:)* & ! RSACCRG - ( PLBDAS(:)**(XCXS-XBS) )*( PRHODREF(:)**(-XCEXVT-1.) ) & - *( XLBSACCR1/((PLBDAR(:)**2) ) + & - XLBSACCR2/( PLBDAR(:) * PLBDAS(:) ) + & - XLBSACCR3/( (PLBDAS(:)**2)) ) ) - PRRS1D(:) = PRRS1D(:) - ZZW1(:,2) - PRSS1D(:) = PRSS1D(:) - ZZW1(:,3) - PRGS1D(:) = PRGS1D(:) + ZZW1(:,2) + ZZW1(:,3) - PTHS1D(:) = PTHS1D(:) + ZZW1(:,2) * (PLSFACT(:) - PLVFACT(:)) ! f(L_f*(RRACCSG)) -! - PCRS1D(:) = MAX( PCRS1D(:)-ZZW1(:,2)*(PCRT1D(:)/PRRT1D(:)),0.0 ) ! Lambda_r**3 - END WHERE - DEALLOCATE(IVEC2) - DEALLOCATE(IVEC1) - DEALLOCATE(ZVEC3) - DEALLOCATE(ZVEC2) - DEALLOCATE(ZVEC1) - ! - ! Budget storage - if ( nbumod == kmi .and. lbu_enable ) then - if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'ACC', & - Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'ACC', & - Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'ACC', & - Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'ACC', & - Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'ACC', & - Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) - end if -END IF -! -! -!* 1.5 Conversion-Melting of the aggregates -! ----------------------------------------- -! -if ( nbumod == kmi .and. lbu_enable ) then - if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'CMEL', & - Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'CMEL', & - Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) -end if -! -ZZW(:) = 0.0 -WHERE( (PRST1D(:)>XRTMIN(5)) .AND. (PRSS1D(:)>XRTMIN(5)/PTSTEP) .AND. (PZT(:)>XTT) ) - ZZW(:) = PRVT1D(:) * PPRES(:) / ((XMV / XMD) + PRVT1D(:)) ! Vapor pressure - ZZW(:) = PKA(:) * (XTT - PZT(:)) + & - ( PDV(:) * (XLVTT + ( XCPV - XCL ) * ( PZT(:) - XTT )) & - * (XESTT-ZZW(:))/(XRV*PZT(:)) ) -! -! compute RSMLT -! - ZZW(:) = MIN( PRSS1D(:), XFSCVMG*MAX( 0.0,( -ZZW(:) * & - ( X0DEPS* PLBDAS(:)**XEX0DEPS + & - X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS ) - & - ( ZZW1(:,1)+ZZW1(:,4) ) * & - ( PRHODREF(:)*XCL*(XTT-PZT(:))) ) / & - ( PRHODREF(:)*XLMTT ) ) ) -! -! note that RSCVMG = RSMLT*XFSCVMG but no heat is exchanged (at the rate RSMLT) -! because the graupeln produced by this process are still icy!!! -! - PRSS1D(:) = PRSS1D(:) - ZZW(:) - PRGS1D(:) = PRGS1D(:) + ZZW(:) -END WHERE -! -! Budget storage -if ( nbumod == kmi .and. lbu_enable ) then - if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'CMEL', & - Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'CMEL', & - Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) -end if - -END IF SNOW -! -!------------------------------------------------------------------------------ -! -! ################# -! FAST RG PROCESSES -! ################# -! -! -!* 2.1 Rain contact freezing -! -------------------------- -! -if ( nbumod == kmi .and. lbu_enable ) then - if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'CFRZ', & - Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'CFRZ', & - Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CFRZ', & - Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'CFRZ', & - Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'CFRZ', & - Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CFRZ', & - Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) -end if - -ZZW1(:,3:4) = 0.0 -WHERE( (PRIT1D(:)>XRTMIN(4)) .AND. (PRRT1D(:)>XRTMIN(3)) .AND. (PRIS1D(:)>XRTMIN(4)/PTSTEP) .AND. (PRRS1D(:)>XRTMIN(3)/PTSTEP) ) - ZZW1(:,3) = MIN( PRIS1D(:),XICFRR * PRIT1D(:) * PCRT1D(:) & ! RICFRRG - * PLBDAR(:)**XEXICFRR & - * PRHODREF(:)**(-XCEXVT-1.0) ) -! - ZZW1(:,4) = MIN( PRRS1D(:),XRCFRI * PCIT1D(:) * PCRT1D(:) & ! RRCFRIG - * PLBDAR(:)**XEXRCFRI & - * PRHODREF(:)**(-XCEXVT-2.0) ) - PRIS1D(:) = PRIS1D(:) - ZZW1(:,3) - PRRS1D(:) = PRRS1D(:) - ZZW1(:,4) - PRGS1D(:) = PRGS1D(:) + ZZW1(:,3) + ZZW1(:,4) - PTHS1D(:) = PTHS1D(:) + ZZW1(:,4) * (PLSFACT(:) - PLVFACT(:)) ! f(L_f*RRCFRIG) -! - PCIS1D(:) = MAX( PCIS1D(:)-ZZW1(:,3)*(PCIT1D(:)/PRIT1D(:)),0.0 ) ! CICFRRG - PCRS1D(:) = MAX( PCRS1D(:)-ZZW1(:,4)*(PCRT1D(:)/PRRT1D(:)),0.0 ) ! CRCFRIG -END WHERE -! -if ( nbumod == kmi .and. lbu_enable ) then - if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'CFRZ', & - Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'CFRZ', & - Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CFRZ', & - Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'CFRZ', & - Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'CFRZ', & - Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CFRZ', & - Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) -end if -! -! -!* 2.2 Ice multiplication process following rain contact freezing -! --------------------------------------------------------------- -! -GRDSF(:) = LRDSF .AND. (PRIT1D(:)>0.0) .AND. (PRRT1D(:)>0.0) .AND. & - (PRIS1D(:)>0.0) .AND. (PRRS1D(:)>0.0) -IRDSF = COUNT( GRDSF(:) ) -! -IF (IRDSF > 0) THEN -! - ! Budget storage - if ( nbumod == kmi .and. lbu_enable ) then - if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'RDSF', & - Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'RDSF', & - Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'RDSF', & - Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) - end if -! - ALLOCATE(ZVEC1_R(IRDSF)) - ALLOCATE(ZVEC1_R1(IRDSF)) - ALLOCATE(ZVEC2_R(IRDSF)) - ALLOCATE(IVEC2_R(IRDSF)) -! -!* 2.2.1 select the ZLBDAR -! - ZVEC1_R(:) = PACK( PLBDAR(:),MASK=GRDSF(:) ) -! -!* 2.2.2 find the next lower indice for the ZLBDAR in the -! geometrical set of Lbda_r used to tabulate some moments of the -! incomplete gamma function, for the lower boundary (0.1 mm) -! - ZVEC2_R(1:IRDSF) = MAX( 1.00001, MIN( FLOAT(NGAMINC)-0.00001,XRDSFINTP_R & - * LOG( ZVEC1_R(1:IRDSF) ) + XRDSFINTP1_R ) ) - IVEC2_R(1:IRDSF) = INT( ZVEC2_R(1:IRDSF) ) - ZVEC2_R(1:IRDSF) = ZVEC2_R(1:IRDSF) - FLOAT( IVEC2_R(1:IRDSF) ) -! -!* 2.2.3 perform the linear interpolation of the -! normalized "2+XDR"-moment of the incomplete gamma function -! - ZVEC1_R1(1:IRDSF) = XGAMINC_RDSF_R(IVEC2_R(1:IRDSF)+1) * ZVEC2_R(1:IRDSF) & - - XGAMINC_RDSF_R(IVEC2_R(1:IRDSF)) * (ZVEC2_R(1:IRDSF) - 1.0) -! -! From 0.1 mm to infinity we need - ZVEC1_R1(1:IRDSF) = XMOMGR_RDSF * (1.0 - ZVEC1_R1(1:IRDSF)) -! - ALLOCATE(ZINTG_RAIN(SIZE(PZT))) - ZINTG_RAIN(:) = UNPACK ( VECTOR=ZVEC1_R1(:),MASK=GRDSF,FIELD=0.0 ) -! -!* 2.2.4 To compute final "RDSF" contributions -! - ALLOCATE(ZNI_RDSF(SIZE(PZT))) - ZNI_RDSF(:) = (XFACTOR_RDSF_NI / (PRHODREF(:)**(XCEXVT-1.0))) * ( & - PCIT1D(:) * PCRT1D(:) * ZINTG_RAIN(:) * PLBDAR(:)**(-(XDR+6.0)) ) -! - PCIS1D(:) = PCIS1D(:) + ZNI_RDSF(:) -! -! The value of rg removed by RDSF is determined by the mean mass of pristine ice - ALLOCATE(ZRI_RDSF(SIZE(PZT))) - ZRI_RDSF(:) = MIN( PRGS1D(:), MAX( ZNI_RDSF(:)*XMNU0,XRTMIN(5) ) ) -! - PRIS1D(:) = PRIS1D(:) + ZRI_RDSF(:) - PRGS1D(:) = PRGS1D(:) - ZRI_RDSF(:) -! - DEALLOCATE(ZINTG_RAIN) - DEALLOCATE(ZVEC1_R) - DEALLOCATE(ZVEC1_R1) - DEALLOCATE(ZVEC2_R) - DEALLOCATE(IVEC2_R) - DEALLOCATE(ZNI_RDSF) - DEALLOCATE(ZRI_RDSF) - ! - ! Budget storage - if ( nbumod == kmi .and. lbu_enable ) then - if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'RDSF', & - Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RG), 'RDSF', & - Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'RDSF', & - Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) - end if -ENDIF -! -! -!* 2.3 Compute the Dry growth case -! -------------------------------- -! -if ( nbumod == kmi .and. lbu_enable ) then - if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'WETG', & - Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'WETG', & - Unpack( prcs1d(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'WETG', & - Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'WETG', & - Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'WETG', & - Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'WETG', & - Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'WETG', & - Unpack( prhs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_sv ) then - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'WETG', & - Unpack( pccs1d(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'WETG', & - Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'WETG', & - Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) - end if -end if -! -ZZW1(:,:) = 0.0 -WHERE( ((PRCT1D(:)>XRTMIN(2)) .AND. (PRGT1D(:)>XRTMIN(6)) .AND. (PRCS1D(:)>XRTMIN(2)/PTSTEP)) .OR. & - ((PRIT1D(:)>XRTMIN(4)) .AND. (PRGT1D(:)>XRTMIN(6)) .AND. (PRIS1D(:)>XRTMIN(4)/PTSTEP)) ) - ZZW(:) = PLBDAG(:)**(XCXG-XDG-2.0) * PRHODREF(:)**(-XCEXVT) - ZZW1(:,1) = MIN( PRCS1D(:),XFCDRYG * PRCT1D(:) * ZZW(:) ) ! RCDRYG - ZZW1(:,2) = MIN( PRIS1D(:),XFIDRYG * EXP( XCOLEXIG*(PZT(:)-XTT) ) & - * PRIT1D(:) * ZZW(:) ) ! RIDRYG -END WHERE -! -!* 2.3.1 accretion of aggregates on the graupeln -! ---------------------------------------------- -! -GDRY(:) = (PRST1D(:)>XRTMIN(5)) .AND. (PRGT1D(:)>XRTMIN(6)) .AND. (PRSS1D(:)>XRTMIN(5)/PTSTEP) -IGDRY = COUNT( GDRY(:) ) -! -IF( IGDRY>0 ) THEN -! -!* 2.3.2 allocations -! - ALLOCATE(ZVEC1(IGDRY)) - ALLOCATE(ZVEC2(IGDRY)) - ALLOCATE(ZVEC3(IGDRY)) - ALLOCATE(IVEC1(IGDRY)) - ALLOCATE(IVEC2(IGDRY)) -! -!* 2.3.3 select the (PLBDAG,PLBDAS) couplet -! - ZVEC1(:) = PACK( PLBDAG(:),MASK=GDRY(:) ) - ZVEC2(:) = PACK( PLBDAS(:),MASK=GDRY(:) ) -! -!* 2.3.4 find the next lower indice for the PLBDAG and for the PLBDAS -! in the geometrical set of (Lbda_g,Lbda_s) couplet use to -! tabulate the SDRYG-kernel -! - ZVEC1(1:IGDRY) = MAX( 1.0001, MIN( REAL(NDRYLBDAG)-0.0001, & - XDRYINTP1G * LOG( ZVEC1(1:IGDRY) ) + XDRYINTP2G ) ) - IVEC1(1:IGDRY) = INT( ZVEC1(1:IGDRY) ) - ZVEC1(1:IGDRY) = ZVEC1(1:IGDRY) - REAL( IVEC1(1:IGDRY) ) -! - ZVEC2(1:IGDRY) = MAX( 1.0001, MIN( REAL(NDRYLBDAS)-0.0001, & - XDRYINTP1S * LOG( ZVEC2(1:IGDRY) ) + XDRYINTP2S ) ) - IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) ) - ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - REAL( IVEC2(1:IGDRY) ) -! -!* 2.3.5 perform the bilinear interpolation of the normalized -! SDRYG-kernel -! - DO JJ = 1,IGDRY - ZVEC3(JJ) = ( XKER_SDRYG(IVEC1(JJ)+1,IVEC2(JJ)+1) * ZVEC2(JJ) & - - XKER_SDRYG(IVEC1(JJ)+1,IVEC2(JJ) ) * (ZVEC2(JJ) - 1.0) ) & - * ZVEC1(JJ) & - - ( XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ)+1) * ZVEC2(JJ) & - - XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ) ) * (ZVEC2(JJ) - 1.0) ) & - * (ZVEC1(JJ) - 1.0) - END DO - ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GDRY,FIELD=0.0 ) -! - WHERE( GDRY(:) ) - ZZW1(:,3) = MIN( PRSS1D(:),XFSDRYG*ZZW(:) & ! RSDRYG - * EXP( XCOLEXSG*(PZT(:)-XTT) ) & - *( PLBDAS(:)**(XCXS-XBS) )*( PLBDAG(:)**XCXG ) & - *( PRHODREF(:)**(-XCEXVT-1.) ) & - *( XLBSDRYG1/( PLBDAG(:)**2 ) + & - XLBSDRYG2/( PLBDAG(:) * PLBDAS(:) ) + & - XLBSDRYG3/( PLBDAS(:)**2) ) ) - END WHERE - DEALLOCATE(IVEC2) - DEALLOCATE(IVEC1) - DEALLOCATE(ZVEC3) - DEALLOCATE(ZVEC2) - DEALLOCATE(ZVEC1) -END IF -! -!* 2.3.6 accretion of raindrops on the graupeln -! --------------------------------------------- -! -GDRY(:) = (PRRT1D(:)>XRTMIN(3)) .AND. (PRGT1D(:)>XRTMIN(6)) .AND. (PRRS1D(:)>XRTMIN(3)) -IGDRY = COUNT( GDRY(:) ) -! -IF( IGDRY>0 ) THEN -! -!* 2.3.7 allocations -! - ALLOCATE(ZVEC1(IGDRY)) - ALLOCATE(ZVEC2(IGDRY)) - ALLOCATE(ZVEC3(IGDRY)) - ALLOCATE(IVEC1(IGDRY)) - ALLOCATE(IVEC2(IGDRY)) -! -!* 2.3.8 select the (PLBDAG,PLBDAR) couplet -! - ZVEC1(:) = PACK( PLBDAG(:),MASK=GDRY(:) ) - ZVEC2(:) = PACK( PLBDAR(:),MASK=GDRY(:) ) -! -!* 2.3.9 find the next lower indice for the PLBDAG and for the PLBDAR -! in the geometrical set of (Lbda_g,Lbda_r) couplet use to -! tabulate the RDRYG-kernel -! - ZVEC1(1:IGDRY) = MAX( 1.0001, MIN( REAL(NDRYLBDAG)-0.0001, & - XDRYINTP1G * LOG( ZVEC1(1:IGDRY) ) + XDRYINTP2G ) ) - IVEC1(1:IGDRY) = INT( ZVEC1(1:IGDRY) ) - ZVEC1(1:IGDRY) = ZVEC1(1:IGDRY) - REAL( IVEC1(1:IGDRY) ) -! - ZVEC2(1:IGDRY) = MAX( 1.0001, MIN( REAL(NDRYLBDAR)-0.0001, & - XDRYINTP1R * LOG( ZVEC2(1:IGDRY) ) + XDRYINTP2R ) ) - IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) ) - ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - REAL( IVEC2(1:IGDRY) ) -! -!* 2.3.10 perform the bilinear interpolation of the normalized -! RDRYG-kernel -! - DO JJ = 1,IGDRY - ZVEC3(JJ) = ( XKER_RDRYG(IVEC1(JJ)+1,IVEC2(JJ)+1) * ZVEC2(JJ) & - - XKER_RDRYG(IVEC1(JJ)+1,IVEC2(JJ) ) * (ZVEC2(JJ) - 1.0) ) & - * ZVEC1(JJ) & - - ( XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ)+1) * ZVEC2(JJ) & - - XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ) ) * (ZVEC2(JJ) - 1.0) ) & - * (ZVEC1(JJ) - 1.0) - END DO - ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GDRY,FIELD=0.0 ) -! - WHERE( GDRY(:) ) - ZZW1(:,4) = MIN( PRRS1D(:),XFRDRYG*ZZW(:) * PCRT1D(:) & ! RRDRYG - *( PLBDAR(:)**(-3) )*( PLBDAG(:)**XCXG ) & - *( PRHODREF(:)**(-XCEXVT-1.) ) & - *( XLBRDRYG1/( PLBDAG(:)**2 ) + & - XLBRDRYG2/( PLBDAG(:) * PLBDAR(:) ) + & - XLBRDRYG3/( PLBDAR(:)**2) ) ) - END WHERE - DEALLOCATE(IVEC2) - DEALLOCATE(IVEC1) - DEALLOCATE(ZVEC3) - DEALLOCATE(ZVEC2) - DEALLOCATE(ZVEC1) -END IF -! -ZRDRYG(:) = ZZW1(:,1) + ZZW1(:,2) + ZZW1(:,3) + ZZW1(:,4) -! -! -!* 2.4 Compute the Wet growth case -! -------------------------------- -! -ZZW(:) = 0.0 -ZRWETG(:) = 0.0 -WHERE( PRGT1D(:)>XRTMIN(6) ) - ZZW1(:,5) = MIN( PRIS1D(:), & - ZZW1(:,2) / (XCOLIG*EXP(XCOLEXIG*(PZT(:)-XTT)) ) ) ! RIWETG - ZZW1(:,6) = MIN( PRSS1D(:), & - ZZW1(:,3) / (XCOLSG*EXP(XCOLEXSG*(PZT(:)-XTT)) ) ) ! RSWETG -! - ZZW(:) = PRVT1D(:)*PPRES(:)/((XMV/XMD)+PRVT1D(:)) ! Vapor pressure - ZZW(:) = PKA(:)*(XTT-PZT(:)) + & - ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PZT(:) - XTT )) & - *(XESTT-ZZW(:))/(XRV*PZT(:)) ) -! -! compute RWETG -! - ZRWETG(:) = MAX( 0.0, & - ( ZZW(:) * ( X0DEPG* PLBDAG(:)**XEX0DEPG + & - X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG ) + & - ( ZZW1(:,5)+ZZW1(:,6) ) * & - ( PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PZT(:))) ) ) / & - ( PRHODREF(:)*(XLMTT-XCL*(XTT-PZT(:))) ) ) -END WHERE -! -! -!* 2.5 Select Wet or Dry case -! --------------------------- -! -! Wet case and partial conversion to hail -! -ZZW(:) = 0.0 -NHAIL = 0. -IF (LHAIL) NHAIL = 1. -WHERE( PRGT1D(:)>XRTMIN(6) .AND. PZT(:)<XTT & - .AND. ZRDRYG(:)>=ZRWETG(:) .AND. ZRWETG(:)>0.0 ) -! - ZZW(:) = ZRWETG(:) - ZZW1(:,5) - ZZW1(:,6) ! RCWETG+RRWETG -! -! limitation of the available rainwater mixing ratio (RRWETH < RRS !) -! - ZZW1(:,7) = MAX( 0.0,MIN( ZZW(:),PRRS1D(:)+ZZW1(:,1) ) ) - ZZX(:) = ZZW1(:,7) / ZZW(:) - ZZW1(:,5) = ZZW1(:,5)*ZZX(:) - ZZW1(:,6) = ZZW1(:,6)*ZZX(:) - ZRWETG(:) = ZZW1(:,7) + ZZW1(:,5) + ZZW1(:,6) -! - PRCS1D(:) = PRCS1D(:) - ZZW1(:,1) - PRIS1D(:) = PRIS1D(:) - ZZW1(:,5) - PRSS1D(:) = PRSS1D(:) - ZZW1(:,6) -! -! assume a linear percent of conversion of graupel into hail -! - PRGS1D(:) = PRGS1D(:) + ZRWETG(:) - ZZW(:) = PRGS1D(:)*ZRDRYG(:)*NHAIL/(ZRWETG(:)+ZRDRYG(:)) - PRGS1D(:) = PRGS1D(:) - ZZW(:) - PRHS1D(:) = PRHS1D(:) + ZZW(:) - PRRS1D(:) = MAX( 0.0,PRRS1D(:) - ZZW1(:,7) + ZZW1(:,1) ) - PTHS1D(:) = PTHS1D(:) + ZZW1(:,7) * (PLSFACT(:) - PLVFACT(:)) - ! f(L_f*(RCWETG+RRWETG)) -! - PCCS1D(:) = MAX( PCCS1D(:)-ZZW1(:,1)*(PCCT1D(:)/MAX(PRCT1D(:),XRTMIN(2))),0.0 ) - PCIS1D(:) = MAX( PCIS1D(:)-ZZW1(:,5)*(PCIT1D(:)/MAX(PRIT1D(:),XRTMIN(4))),0.0 ) - PCRS1D(:) = MAX( PCRS1D(:)-MAX( ZZW1(:,7)-ZZW1(:,1),0.0 ) & - *(PCRT1D(:)/MAX(PRRT1D(:),XRTMIN(3))),0.0 ) -END WHERE -! -! Budget storage -if ( nbumod == kmi .and. lbu_enable ) then - if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'WETG', & - Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'WETG', & - Unpack( prcs1d(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'WETG', & - Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'WETG', & - Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'WETG', & - Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'WETG', & - Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'WETG', & - Unpack( prhs1d(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_sv ) then - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'WETG', & - Unpack( pccs1d(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'WETG', & - Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'WETG', & - Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) - end if -end if -! -! Dry case -! -if ( nbumod == kmi .and. lbu_enable ) then - if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'DRYG', & - Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DRYG', & - Unpack( prcs1d(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'DRYG', & - Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'DRYG', & - Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'DRYG', & - Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'DRYG', & - Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_sv ) then - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'DRYG', & - Unpack( pccs1d(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'DRYG', & - Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'DRYG', & - Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) - end if -end if -! -WHERE( PRGT1D(:)>XRTMIN(6) .AND. PZT(:)<XTT & - .AND. ZRDRYG(:)<ZRWETG(:) .AND. ZRDRYG(:)>0.0 ) ! case - PRCS1D(:) = PRCS1D(:) - ZZW1(:,1) - PRIS1D(:) = PRIS1D(:) - ZZW1(:,2) - PRSS1D(:) = PRSS1D(:) - ZZW1(:,3) - PRRS1D(:) = PRRS1D(:) - ZZW1(:,4) - PRGS1D(:) = PRGS1D(:) + ZRDRYG(:) - PTHS1D(:) = PTHS1D(:) + (ZZW1(:,1)+ZZW1(:,4)) * (PLSFACT(:) - PLVFACT(:)) ! - ! f(L_f*(RCDRYG+RRDRYG)) -! - PCCS1D(:) = MAX( PCCS1D(:)-ZZW1(:,1)*(PCCT1D(:)/MAX(PRCT1D(:),XRTMIN(2))),0.0 ) - PCIS1D(:) = MAX( PCIS1D(:)-ZZW1(:,2)*(PCIT1D(:)/MAX(PRIT1D(:),XRTMIN(4))),0.0 ) - PCRS1D(:) = MAX( PCRS1D(:)-ZZW1(:,4)*(PCRT1D(:)/MAX(PRRT1D(:),XRTMIN(3))),0.0 ) - ! Approximate rates -END WHERE -! -! Budget storage -if ( nbumod == kmi .and. lbu_enable ) then - if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'DRYG', & - Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DRYG', & - Unpack( prcs1d(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'DRYG', & - Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'DRYG', & - Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'DRYG', & - Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'DRYG', & - Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_sv ) then - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'DRYG', & - Unpack( pccs1d(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'DRYG', & - Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'DRYG', & - Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) - end if -end if -! -! -!* 2.6 Hallett-Mossop ice multiplication process due to graupel riming -! -------------------------------------------------------------------- -! -if ( nbumod == kmi .and. lbu_enable ) then - if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HMG', & - Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'HMG', & - Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HMG', & - Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) -end if - -!GDRY(:) = (PZT(:)<XHMTMAX) .AND. (PZT(:)>XHMTMIN) .AND. (ZRDRYG(:)<ZZW(:))& -! .AND. (PRGT1D(:)>XRTMIN(6)) .AND. (PRCT1D(:)>XRTMIN(2)) -GDRY(:) = (PZT(:)<XHMTMAX) .AND. (PZT(:)>XHMTMIN) .AND. (ZRDRYG(:)<ZRWETG(:))& - .AND. (PRGT1D(:)>XRTMIN(6)) .AND. (PRCT1D(:)>XRTMIN(2)) -! -IGDRY = COUNT( GDRY(:) ) -IF( IGDRY>0 ) THEN - ALLOCATE(ZVEC1(IGDRY)) - ALLOCATE(ZVEC2(IGDRY)) - ALLOCATE(IVEC2(IGDRY)) -! - ZVEC1(:) = PACK( PLBDAC(:),MASK=GDRY(:) ) - ZVEC2(1:IGDRY) = MAX( 1.0001, MIN( REAL(NGAMINC)-0.0001, & - XHMLINTP1 * LOG( ZVEC1(1:IGDRY) ) + XHMLINTP2 ) ) - IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) ) - ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - REAL( IVEC2(1:IGDRY) ) - ZVEC1(1:IGDRY) = XGAMINC_HMC( IVEC2(1:IGDRY)+1 )* ZVEC2(1:IGDRY) & - - XGAMINC_HMC( IVEC2(1:IGDRY) )*(ZVEC2(1:IGDRY) - 1.0) - ZZX(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GDRY,FIELD=0.0 ) ! Large droplets -! - WHERE ( GDRY(:) .AND. ZZX(:)<0.99 ) ! Dry case - ZZW1(:,5) = ZZW1(:,1)*(PCCT1D(:)/PRCT1D(:))*(1.0-ZZX(:))*XHM_FACTG* & - MAX( 0.0, MIN( (PZT(:)-XHMTMIN)/3.0,(XHMTMAX-PZT(:))/2.0 ) ) ! CCHMGI - PCIS1D(:) = PCIS1D(:) + ZZW1(:,5) -! - ZZW1(:,6) = ZZW1(:,5) * XMNU0 ! RCHMGI - PRIS1D(:) = PRIS1D(:) + ZZW1(:,6) - PRGS1D(:) = PRGS1D(:) - ZZW1(:,6) - END WHERE - DEALLOCATE(IVEC2) - DEALLOCATE(ZVEC2) - DEALLOCATE(ZVEC1) -END IF -! -! Budget storage -if ( nbumod == kmi .and. lbu_enable ) then - if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HMG', & - Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'HMG', & - Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HMG', & - Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) -end if -! -!* 2.7 Melting of the graupeln -! ---------------------------- -! -if ( nbumod == kmi .and. lbu_enable ) then - if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'GMLT', & - Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'GMLT', & - Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'GMLT', & - Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'GMLT', & - Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) -end if - -ZZW(:) = 0.0 -WHERE( (PRGT1D(:)>XRTMIN(6)) .AND. (PRGS1D(:)>XRTMIN(6)/PTSTEP) .AND. (PZT(:)>XTT) ) - ZZW(:) = PRVT1D(:)*PPRES(:)/((XMV/XMD)+PRVT1D(:)) ! Vapor pressure - ZZW(:) = PKA(:)*(XTT-PZT(:)) + & - ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PZT(:) - XTT )) & - *(XESTT-ZZW(:))/(XRV*PZT(:)) ) -! -! compute RGMLTR -! - ZZW(:) = MIN( PRGS1D(:), MAX( 0.0,( -ZZW(:) * & - ( X0DEPG* PLBDAG(:)**XEX0DEPG + & - X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG ) - & - ( ZZW1(:,1)+ZZW1(:,4) ) * & - ( PRHODREF(:)*XCL*(XTT-PZT(:))) ) / & - ( PRHODREF(:)*XLMTT ) ) ) - PRRS1D(:) = PRRS1D(:) + ZZW(:) - PRGS1D(:) = PRGS1D(:) - ZZW(:) - PTHS1D(:) = PTHS1D(:) - ZZW(:) * (PLSFACT(:) - PLVFACT(:)) ! f(L_f*(-RGMLTR)) -! -! PCRS1D(:) = MAX( PCRS1D(:) + ZZW(:)*(XCCG*PLBDAG(:)**XCXG/PRGT1D(:)),0.0 ) - PCRS1D(:) = PCRS1D(:) + ZZW(:)*5.0E6 ! obtained after averaging - ! Dshed=1mm and 500 microns -END WHERE -! -if ( nbumod == kmi .and. lbu_enable ) then - if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'GMLT', & - Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'GMLT', & - Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'GMLT', & - Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'GMLT', & - Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) -end if -! -! -!------------------------------------------------------------------------------ -! -! ################# -! FAST RH PROCESSES -! ################# -! -! -HAIL: IF (LHAIL) THEN -! -GHAIL(:) = PRTH1D(:)>XRTMIN(7) -IHAIL = COUNT(GHAIL(:)) -! -IF( IHAIL>0 ) THEN -! -!* 3.1 Wet growth of hail -! ---------------------------- -! - if ( nbumod == kmi .and. lbu_enable ) then - if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'WETH', & - Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'WETH', & - Unpack( prcs1d(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'WETH', & - Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'WETH', & - Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'WETH', & - Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'WETH', & - Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'WETH', & - Unpack( prhs1d(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_sv ) then - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'WETH', & - Unpack( pccs1d(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'WETH', & - Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'WETH', & - Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) - end if - end if - - ZZW1(:,:) = 0.0 - WHERE( GHAIL(:) .AND. ( (PRCT1D(:)>XRTMIN(2) .AND. PRCS1D(:)>XRTMIN(2)/PTSTEP) .OR. & - (PRIT1D(:)>XRTMIN(4) .AND. PRIS1D(:)>XRTMIN(4)/PTSTEP) ) ) - ZZW(:) = PLBDAH(:)**(XCXH-XDH-2.0) * PRHODREF(:)**(-XCEXVT) - ZZW1(:,1) = MIN( PRCS1D(:),XFWETH * PRCT1D(:) * ZZW(:) ) ! RCWETH - ZZW1(:,2) = MIN( PRIS1D(:),XFWETH * PRIT1D(:) * ZZW(:) ) ! RIWETH - END WHERE -! -!* 3.1.1 accretion of aggregates on the hailstones -! ------------------------------------------------ -! - GWET(:) = GHAIL(:) .AND. (PRST1D(:)>XRTMIN(5) .AND. PRSS1D(:)>XRTMIN(5)/PTSTEP) - IGWET = COUNT( GWET(:) ) -! - IF( IGWET>0 ) THEN -! -!* 3.1.2 allocations -! - ALLOCATE(ZVEC1(IGWET)) - ALLOCATE(ZVEC2(IGWET)) - ALLOCATE(ZVEC3(IGWET)) - ALLOCATE(IVEC1(IGWET)) - ALLOCATE(IVEC2(IGWET)) -! -!* 3.1.3 select the (PLBDAH,PLBDAS) couplet -! - ZVEC1(:) = PACK( PLBDAH(:),MASK=GWET(:) ) - ZVEC2(:) = PACK( PLBDAS(:),MASK=GWET(:) ) -! -!* 3.1.4 find the next lower indice for the PLBDAG and for the PLBDAS -! in the geometrical set of (Lbda_h,Lbda_s) couplet use to -! tabulate the SWETH-kernel -! - ZVEC1(1:IGWET) = MAX( 1.0001, MIN( REAL(NWETLBDAH)-0.0001, & - XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) ) - IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) ) - ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) ) -! - ZVEC2(1:IGWET) = MAX( 1.0001, MIN( REAL(NWETLBDAS)-0.0001, & - XWETINTP1S * LOG( ZVEC2(1:IGWET) ) + XWETINTP2S ) ) - IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) ) - ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( IVEC2(1:IGWET) ) -! -!* 3.1.5 perform the bilinear interpolation of the normalized -! SWETH-kernel -! - DO JJ = 1,IGWET - ZVEC3(JJ) = ( XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ)+1) * ZVEC2(JJ) & - - XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ) ) * (ZVEC2(JJ) - 1.0) ) & - * ZVEC1(JJ) & - - ( XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ)+1) * ZVEC2(JJ) & - - XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ) ) * (ZVEC2(JJ) - 1.0) ) & - * (ZVEC1(JJ) - 1.0) - END DO - ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GWET,FIELD=0.0 ) -! - WHERE( GWET(:) ) - ZZW1(:,3) = MIN( PRSS1D(:),XFSWETH*ZZW(:) & ! RSWETH - *( PLBDAS(:)**(XCXS-XBS) )*( PLBDAH(:)**XCXH ) & - *( PRHODREF(:)**(-XCEXVT-1.) ) & - *( XLBSWETH1/( PLBDAH(:)**2 ) + & - XLBSWETH2/( PLBDAH(:) * PLBDAS(:) ) + & - XLBSWETH3/( PLBDAS(:)**2) ) ) - END WHERE - DEALLOCATE(IVEC2) - DEALLOCATE(IVEC1) - DEALLOCATE(ZVEC3) - DEALLOCATE(ZVEC2) - DEALLOCATE(ZVEC1) - END IF -! -!* 3.1.6 accretion of graupeln on the hailstones -! ---------------------------------------------- -! - GWET(:) = GHAIL(:) .AND. (PRGT1D(:)>XRTMIN(6) .AND. PRGS1D(:)>XRTMIN(6)/PTSTEP) - IGWET = COUNT( GWET(:) ) -! - IF( IGWET>0 ) THEN -! -!* 3.1.7 allocations -! - ALLOCATE(ZVEC1(IGWET)) - ALLOCATE(ZVEC2(IGWET)) - ALLOCATE(ZVEC3(IGWET)) - ALLOCATE(IVEC1(IGWET)) - ALLOCATE(IVEC2(IGWET)) -! -!* 3.1.8 select the (PLBDAH,PLBDAG) couplet -! - ZVEC1(:) = PACK( PLBDAH(:),MASK=GWET(:) ) - ZVEC2(:) = PACK( PLBDAG(:),MASK=GWET(:) ) -! -!* 3.1.9 find the next lower indice for the PLBDAH and for the PLBDAG -! in the geometrical set of (Lbda_h,Lbda_g) couplet use to -! tabulate the GWETH-kernel -! - ZVEC1(1:IGWET) = MAX( 1.0001, MIN( REAL(NWETLBDAG)-0.0001, & - XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) ) - IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) ) - ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) ) -! - ZVEC2(1:IGWET) = MAX( 1.0001, MIN( REAL(NWETLBDAG)-0.0001, & - XWETINTP1G * LOG( ZVEC2(1:IGWET) ) + XWETINTP2G ) ) - IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) ) - ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( IVEC2(1:IGWET) ) -! -!* 3.1.10 perform the bilinear interpolation of the normalized -! GWETH-kernel -! - DO JJ = 1,IGWET - ZVEC3(JJ) = ( XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ)+1) * ZVEC2(JJ) & - - XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ) ) * (ZVEC2(JJ) - 1.0) ) & - * ZVEC1(JJ) & - - ( XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ)+1) * ZVEC2(JJ) & - - XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ) ) * (ZVEC2(JJ) - 1.0) ) & - * (ZVEC1(JJ) - 1.0) - END DO - ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GWET,FIELD=0.0 ) -! - WHERE( GWET(:) ) - ZZW1(:,5) = MAX(MIN( PRGS1D(:),XFGWETH*ZZW(:) & ! RGWETH - *( PLBDAG(:)**(XCXG-XBG) )*( PLBDAH(:)**XCXH ) & - *( PRHODREF(:)**(-XCEXVT-1.) ) & - *( XLBGWETH1/( PLBDAH(:)**2 ) + & - XLBGWETH2/( PLBDAH(:) * PLBDAG(:) ) + & - XLBGWETH3/( PLBDAG(:)**2) ) ),0. ) - END WHERE - DEALLOCATE(IVEC2) - DEALLOCATE(IVEC1) - DEALLOCATE(ZVEC3) - DEALLOCATE(ZVEC2) - DEALLOCATE(ZVEC1) - END IF -! -! -!* 3.2 compute the Wet growth of hail -! ------------------------------------- -! - ZZW(:) = 0.0 - WHERE( GHAIL(:) .AND. PZT(:)<XTT ) - ZZW(:) = PRVT1D(:) * PPRES(:) / ((XMV / XMD) + PRVT1D(:)) ! Vapor pressure - ZZW(:) = PKA(:) * (XTT - PZT(:)) + & - ( PDV(:) * (XLVTT + ( XCPV - XCL ) * ( PZT(:) - XTT )) & - * (XESTT-ZZW(:))/(XRV*PZT(:)) ) -! -! compute RWETH -! - ZZW(:) = MAX(0., ( ZZW(:) * ( X0DEPH* PLBDAH(:)**XEX0DEPH + & - X1DEPH*PCJ(:)*PLBDAH(:)**XEX1DEPH ) + & - ( ZZW1(:,2)+ZZW1(:,3)+ZZW1(:,5) ) * & - ( PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PZT(:))) ) ) / & - ( PRHODREF(:)*(XLMTT-XCL*(XTT-PZT(:))) ) ) -! - ZZW1(:,6) = MAX( ZZW(:) - ZZW1(:,2) - ZZW1(:,3) - ZZW1(:,5),0.) ! RCWETH+RRWETH - END WHERE - ! - WHERE ( GHAIL(:) .AND. PZT(:)<XTT .AND. ZZW1(:,6)/=0.) -! -! limitation of the available rainwater mixing ratio (RRWETH < RRS !) -! - ZZW1(:,4) = MAX( 0.0,MIN( ZZW1(:,6),PRRS1D(:)+ZZW1(:,1) ) ) - ZZX(:) = ZZW1(:,4) / ZZW1(:,6) - ZZW1(:,2) = ZZW1(:,2) * ZZX(:) - ZZW1(:,3) = ZZW1(:,3) * ZZX(:) - ZZW1(:,5) = ZZW1(:,5) * ZZX(:) - ZZW(:) = ZZW1(:,4) + ZZW1(:,2) + ZZW1(:,3) + ZZW1(:,5) -! -!* 3.2.1 integrate the Wet growth of hail -! - PRCS1D(:) = PRCS1D(:) - ZZW1(:,1) - PRIS1D(:) = PRIS1D(:) - ZZW1(:,2) - PRSS1D(:) = PRSS1D(:) - ZZW1(:,3) - PRGS1D(:) = PRGS1D(:) - ZZW1(:,5) - PRHS1D(:) = PRHS1D(:) + ZZW(:) - PRRS1D(:) = MAX( 0.0,PRRS1D(:) - ZZW1(:,4) + ZZW1(:,1) ) - PTHS1D(:) = PTHS1D(:) + ZZW1(:,4) * (PLSFACT(:) - PLVFACT(:)) - ! f(L_f*(RCWETH+RRWETH)) -! - PCCS1D(:) = MAX( PCCS1D(:)-ZZW1(:,1)*(PCCT1D(:)/MAX(PRCT1D(:),XRTMIN(2))),0.0 ) - PCIS1D(:) = MAX( PCIS1D(:)-ZZW1(:,2)*(PCIT1D(:)/MAX(PRIT1D(:),XRTMIN(4))),0.0 ) - PCRS1D(:) = MAX( PCRS1D(:)-MAX( ZZW1(:,4)-ZZW1(:,1),0.0 ) & - *(PCRT1D(:)/MAX(PRRT1D(:),XRTMIN(3))),0.0 ) - END WHERE -! - if ( nbumod == kmi .and. lbu_enable ) then - if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'WETH', & - Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'WETH', & - Unpack( prcs1d(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'WETH', & - Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'WETH', & - Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'WETH', & - Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'WETH', & - Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'WETH', & - Unpack( prhs1d(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_sv ) then - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'WETH', & - Unpack( pccs1d(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'WETH', & - Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'WETH', & - Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) - end if - end if -END IF ! IHAIL>0 -! -! Partial reconversion of hail to graupel when rc and rh are small -! -! -!* 3.3 Conversion of the hailstones into graupel -! ----------------------------------------------- -! -IF ( IHAIL>0 ) THEN - if ( nbumod == kmi .and. lbu_enable ) then - if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'COHG', & - Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'COHG', & - Unpack( prhs1d(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) ) - end if -! - ZTHRH = 0.01E-3 - ZTHRC = 0.001E-3 - ZZW(:) = 0.0 -! - WHERE( PRTH1D(:)<ZTHRH .AND. PRCT1D(:)<ZTHRC .AND. PZT(:)<XTT ) - ZZW(:) = MIN( 1.0,MAX( 0.0,1.0-(PRCT1D(:)/ZTHRC) ) ) -! -! assume a linear percent conversion rate of hail into graupel -! - ZZW(:) = PRHS1D(:) * ZZW(:) - PRGS1D(:) = PRGS1D(:) + ZZW(:) ! partial conversion - PRHS1D(:) = PRHS1D(:) - ZZW(:) ! of hail into graupel - END WHERE -! - if ( nbumod == kmi .and. lbu_enable ) then - if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'COHG', & - Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'COHG', & - Unpack( prhs1d(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) ) - end if -END IF -! -! -!* 3.4 Melting of the hailstones -! -IF ( IHAIL>0 ) THEN - if ( nbumod == kmi .and. lbu_enable ) then - if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HMLT', & - Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'HMLT', & - Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'HMLT', & - Unpack( prhs1d(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'HMLT', & - Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) - end if -! - ZZW(:) = 0.0 - WHERE( GHAIL(:) .AND. (PRHS1D(:)>XRTMIN(7)/PTSTEP) .AND. (PRTH1D(:)>XRTMIN(7)) .AND. (PZT(:)>XTT) ) - ZZW(:) = PRVT1D(:) * PPRES(:) / ((XMV / XMD) + PRVT1D(:)) ! Vapor pressure - ZZW(:) = PKA(:) * (XTT - PZT(:)) + & - ( PDV(:) * (XLVTT + ( XCPV - XCL ) * ( PZT(:) - XTT )) & - * (XESTT - ZZW(:)) / (XRV * PZT(:)) ) -! -! compute RHMLTR -! - ZZW(:) = MIN( PRHS1D(:), MAX( 0.0,( -ZZW(:) * & - ( X0DEPH* PLBDAH(:)**XEX0DEPH + & - X1DEPH*PCJ(:)*PLBDAH(:)**XEX1DEPH ) - & - ZZW1(:,6)*( PRHODREF(:)*XCL*(XTT-PZT(:))) ) / & - ( PRHODREF(:)*XLMTT ) ) ) - PRRS1D(:) = PRRS1D(:) + ZZW(:) - PRHS1D(:) = PRHS1D(:) - ZZW(:) - PTHS1D(:) = PTHS1D(:) - ZZW(:) * (PLSFACT(:) - PLVFACT(:)) ! f(L_f*(-RHMLTR)) -! - PCRS1D(:) = MAX( PCRS1D(:) + ZZW(:)*(XCCH*PLBDAH(:)**XCXH/PRTH1D(:)),0.0 ) - END WHERE -! - if ( nbumod == kmi .and. lbu_enable ) then - if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HMLT', & - Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'HMLT', & - Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'HMLT', & - Unpack( prhs1d(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) ) - if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'HMLT', & - Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) - end if -END IF -! -END IF HAIL -! -!------------------------------------------------------------------------------ -! -END SUBROUTINE LIMA_MIXED_FAST_PROCESSES diff --git a/src/ICCARE_BASE/mgn2mech.F90 b/src/ICCARE_BASE/mgn2mech.F90 deleted file mode 100644 index f6c19ec07..000000000 --- a/src/ICCARE_BASE/mgn2mech.F90 +++ /dev/null @@ -1,323 +0,0 @@ -SUBROUTINE MGN2MECH(KDATE, PLAT, PEF, PPFT, PCFNO, PCFNOG, PCFSPEC, & - KSPMH_MAP, KMECH_MAP, PCONV_FAC, OCONVERSION, PFLUX) - -!*********************************************************************** -! THIS PROGRAM DOES CHEMICAL SPECIATION AND MECHANISM CONVERSION. -! THE OUTPUT FROM MEGAN.F IS CONVERTED FROM 20 TO 150 SPECIES WHICH -! ARE THEN LUMPED ACCORDING TO THE MECHANISM ASSIGNED IN THE RUN SCRIPT. -! THE PROGRAM LOOPS THROUGH ALL TIMESTEPS OF THE INPUT FILE. -! -! PROCEDURE -! 1) FILE SET UP AND ASSIGN I/O PARAMETERS -! 2) CONVERSION FROM MGN 20 TO SPECIATED 150 -! 3) CONVERSION FROM SPECIATED SPECIES TO MECHANISM SPECIES -! 4) CONVERT TO TONNE/HOUR IF NEEDED -! -! THE INPUT FILE GIVES VARIABLES IN UNITS OF G-SPECIES/SEC. -! ALL OUTPUTS ARE IN MOLE/SEC OR TONNE/HR DEPENDING ON ASSIGNMENT. -! -! -! INPUT: -! 1) MEGAN OUTPUT (NETCDF-IOAPI) -! -! OUTPUT: -! 1) MEGAN SPECIATION OR MECHANISM SPECIES (NETCDF-IOAPI) -! -! REQUIREMENT: -! REQUIRES LIBNETCDF.A AND LIBIOAPI.A TO COMPILE -! -! SETENV MGERFILE <DEFANGED_INPUT MEGAN OUTPUT FOR EMISSION ACTIVITY FACTORS> -! SETENV OUTPFILE <OUTPUT SPECIATED EMISSION> -! -! CALLS: CHECKMEM -! -! ORIGINALLY CREATED BY JACK CHEN 11/04 FOR MEGAN V.0 -! FOR MEGAN V2.0 CREATED BY TAN 12/01/06 -! FOR MEGAN V2.1 CREATED BY XUEMEI WANG 11/04/07 -! FOR MEGAN V2.1 TO USE 150 SPECIES CREATED BY XUEMEI WANG 09/30/09 -! -! HISTORY: -! 08/14/07 TAN - MOVE TO MEGANV2.02 WITH NO UPDATE -! 08/29/07 MODIFIED BY A. GUENTHER TO CORRECT ERROR IN ASSIGNING -! EMISSION FACTOR. THIS VERSION IS CALLED MEGANV2.03 -! 10/29/07 MODIFIED BY A. GUENTHER TO CORRECT OMISSION OF DIURNAL VARIATION -! FACTOR. THIS VERSION IS CALLED MEGANV2.04 -! 11/04/07 MODIFIED BY XUEMEI WANG TO GIVE TWO OPTIONS FOR MAP OR LOOKUP TABLE FOR -! THE EMISSION FACTORS. ALSO GIVES OPTIONS FOR DIFFERENT CHEMICAL MECHANISMS -! IN THE CODE: USER MODIFIES THE EXTERNAL SCRIPT TO ASSIGN MECHANISM. -! THIS VERSION IS CALLED MEGANV2.1.0 -! 06/04/08 MODIFIED BY J. LEE-TAYLOR TO ACCEPT VEGETATION-DEPENDENT SPECIATION FACTORS -! IN TABLE FORMAT (RESHAPE TABLES) RATHER THAN FROM DATA STATEMENTS. -! 09/30/08 MODIFIED BY XUEMEI WANG TO GIVE OPTIONS FOR INPUT FILE AND TEST DIFFERENT MECHANISMS -! 09/27/11 TAN&XUEMEI MEGANV2.10 INCLUDES SOIL NOX ADJUSTMENT AND A LOT OF UPDATES -! 20/12/14 P. TULET - ON-LINE COUPLING IN THE ISBA/SURFEX SCHEME. ALL INIT VARIABLES HAS BEEN -! MOVED IN INIT_MEGANN.F90. -!*********************************************************************** - -USE MODD_MGN2MECH -USE MODD_MEGAN - -USE MODE_SOILNOX - -USE MODI_INDEX1 - -IMPLICIT NONE - -INTEGER, INTENT(IN) :: KDATE ! DATE YYYYDDD -REAL, DIMENSION(:), INTENT(IN) :: PLAT !I LATITUDE OF GRID CELL -REAL, DIMENSION(:,:),INTENT(IN) :: PPFT !I PFT FACTOR ARRAY (NRTYP 1-16 IN THE FIRST DIM) -REAL, DIMENSION(:,:),INTENT(IN) :: PEF !I PFT FACTOR ARRAY (NRTYP 1-16 IN THE FIRST DIM) -REAL, DIMENSION(:), INTENT(IN) :: PCFNO !I NO CORRECTION FACTOR -REAL, DIMENSION(:), INTENT(IN) :: PCFNOG !I NO CORRECTION FACTOR FOR GRASS -REAL, DIMENSION(:,:), INTENT(IN) :: PCFSPEC -LOGICAL, INTENT(IN) :: OCONVERSION -INTEGER, DIMENSION(:), INTENT(IN) :: KSPMH_MAP -INTEGER, DIMENSION(:), INTENT(IN) :: KMECH_MAP -REAL, DIMENSION(:), INTENT(IN) :: PCONV_FAC -REAL, DIMENSION(:,:),INTENT(INOUT) :: PFLUX !IO EMISSION FLUX IN MOL/M2/S - -!*********************************************************************** -! THIS PROGRAM DOES CHEMICAL SPECIATION AND MECHANISM CONVERSION. -!... PROGRAM I/O FILES -! PROGRAM NAME -! INPUT MEGAN ER FILE -! CHARACTER*16 :: MGNERS = 'MGNERS' ! INPUT MEGAN ER FILE LOGICAL NAME -! NETCDF FILE -! CHARACTER*16 :: EFMAPS = 'EFMAPS' ! EFMAP INPUT FILE NAME -! CHARACTER*16 :: PFTS16 = 'PFTS16' ! INPUT PFT FILE LOGICAL -! OUTPUT FILE -! CHARACTER*16 :: MGNOUT = 'MGNOUT' ! OUTPUT FILE LOGICAL NAME -! PARAMETERS FOR FILE UNITS -! INTEGER :: LOGDEV ! LOGFILE UNIT NUMBER - -!... PROGRAM I/O PARAMETERS -!... EXTERNAL PARAMETERS - -REAL, DIMENSION(N_SPCA_SPC,SIZE(PFLUX,2)) :: ZTMPER ! TEMP EMISSION BUFFER -REAL, DIMENSION(SIZE(PFLUX,1),SIZE(PFLUX,2)) :: ZOUTER ! OUTPUT EMISSION BUFFER -REAL, DIMENSION(SIZE(PLAT)) :: ZTMP1, ZTMP2, ZTMP3, ZTMP4 -REAL :: ZTMO1, ZTMO2, ZTMO3 -REAL :: Z2CRATIO - -!... INTERNAL PARAMETERS -! INTERNAL PARAMTERS (STATUS AND BUFFER) -INTEGER, DIMENSION(SIZE(PLAT)) :: ILEN, IDAY -INTEGER :: JS, JJ, JI, JM, JN ! COUNTERS -INTEGER :: JMPMG, JMPSP, JMPMC ! COUNTERS -INTEGER :: INO -INTEGER :: INP, IN_SCON_SPC - -!*********************************************************************** - -!======================================================================= -!... BEGIN PROGRAM -!======================================================================= - -INP = SIZE(PLAT) -IN_SCON_SPC = SIZE(KSPMH_MAP) - -! CHANGE THE UNIT ACCORDING TO TONPHR FLAG -! IF ( TONPHR ) THEN -! UNITS3D(1:NVARS3D) = 'TONS/HR' -! ELSE -! UNITS3D(1:NVARS3D) = 'MG/M*M/H' -! ENDIF -! -! DO S = 1, NVARS3D -! PRINT*,'OUTPUT VARIABLE:',VNAME3D(S),UNITS3D(S) -! ENDDO - -! CALL NAMEVAL ( MGNERS , MESG ) ! GET INPUT FILE NAME AND PATH -! FDESC3D( 2 ) = 'INPUT MEGAN FILE: '//TRIM(MESG) - -!... ALLOCATE MEMORY - -!.....2) CONVERSION FROM MGN 20 TO SPECIATED 150 -!----------------------------------------------------------------------- -ZTMPER = 0. -ZOUTER = 0. - -INO = INDEX1('NO',CMGN_SPC) - -!... LOOP THROUGH TIME -DO JS = 1, N_SMAP_SPC - - JMPMG = NMG20_MAP(JS) - JMPSP = NSPCA_MAP(JS) -! PRINT*,'CONVERT '//MGN_SPC(NMPMG)//' TO '//SPCA_SPC(NMPSP) - - IF ( JMPMG.NE.INO ) THEN - - !... NOT NO - IF ( XEF_ALL(1,JMPMG).LT.0. ) THEN - - !... USE EFMAPS - ZTMP1(:) = 0. - ZTMP2(:) = 0. - DO JM = 1,N_MGN_PFT - ZTMP1 = ZTMP1 + PPFT(JM,:) - ZTMP2 = ZTMP2 + XEFFS_ALL(JM,JMPSP) * PPFT(JM,:) - ENDDO - WHERE( ZTMP1(:).EQ.0. ) - ZTMPER(JMPSP,:) = 0. - ELSEWHERE - ZTMPER(JMPSP,:) = PCFSPEC(JMPMG,:) * PEF(JMPMG,:) * ZTMP2(:)/ZTMP1(:) - ENDWHERE - - ELSE - - !... USE PFT-EF - ZTMP3(:) = 0.0 - ZTMP4(:) = 0.0 - DO JM = 1,N_MGN_PFT - !ZTMP3 = ZTMP3 + XEF_ALL(JM,JMPMG) * XEFFS_ALL(JM,JMPSP) * PPFT(JM,:)/100. - ZTMP4(:) = ZTMP4(:) + PPFT(JM,:) - ZTMP3(:) = ZTMP3(:) + XEF_ALL(JM,JMPMG) * XEFFS_ALL(JM,JMPSP) * PPFT(JM,:) ! bug S. Oumami - ENDDO - WHERE( ZTMP4(:).EQ.0. ) - ZTMPER(JMPSP,:) = 0. - ELSEWHERE - ZTMPER(JMPSP,:) = PCFSPEC(JMPMG,:) * ZTMP3(:) / ZTMP4(:) - ENDWHERE - - - ENDIF - - ELSE IF ( JMPMG.EQ.INO ) THEN - -!!-----------------NO STUFF----------------------- - - CALL GROWSEASON(KDATE, PLAT, IDAY, ILEN) - - DO JJ = 1,SIZE(PPFT,2) - - ! CHECK FOR GROWING SEASON - IF ( IDAY(JJ).EQ.0 ) THEN - - ! NON GROWING SEASON - ! CFNOG FOR EVERYWHERE - ! OVERRIDE CROP WITH GRASS WARM = 14 - IF ( XEF_ALL(1,INO).LT.0. ) THEN - - ! WITH EFMAPS - ZTMO1 = 0. - ZTMO2 = 0. - DO JM = 1,14 - ZTMO1 = ZTMO1 + PPFT(JM,JJ) - ZTMO2 = ZTMO2 + XEFFS_ALL(JM,JMPSP) * PPFT(JM,JJ) - ENDDO - DO JM = 15,N_MGN_PFT - ZTMO1 = ZTMO1 + PPFT(JM,JJ) - Z2CRATIO = XEF_ALL(14,INO)/XEF_ALL(JM,INO) - ZTMO2 = ZTMO2 + XEFFS_ALL(JM,JMPSP) * PPFT(JM,JJ) * Z2CRATIO - ENDDO - IF ( ZTMO1.EQ.0. ) THEN - ZTMPER(JMPSP,JJ) = 0. - ELSE - !ZTMPER(JMPSP,JJ) = & - ! PCFSPEC(INO,JJ) * PEF(INO,JJ) * PCFNOG(JJ) * ZTMO2/ZTMO1 - ZTMPER(JMPSP,JJ) = & - PCFSPEC(INO,JJ) * PEF(INO,JJ) * PCFNOG(JJ) * ZTMO2/ZTMO1 * XN2NO - ENDIF - - ELSE - - ! WITHOUT EFMAPS - ZTMO3 = 0.0 - DO JM = 1,14 - ZTMO3 = ZTMO3 + XEF_ALL(JM,INO) * XEFFS_ALL(JM,JMPSP) * PPFT(JM,JJ)/100. - ENDDO - DO JM = 15,N_MGN_PFT - ZTMO3 = ZTMO3 + XEF_ALL(14,INO) * XEFFS_ALL(JM,JMPSP) * PPFT(JM,JJ)/100. - ENDDO - !ZTMPER(JMPSP,JJ) = PCFSPEC(INO,JJ) * PCFNOG(JJ) * ZTMO3 - ZTMPER(JMPSP,JJ) = PCFSPEC(INO,JJ) * PCFNOG(JJ) * ZTMO3 * XN2NO - - ENDIF - - ELSE IF ( IDAY(JJ).GT.0 .AND. IDAY(JJ).LE.366 ) THEN - - ! GROWING SEASON - ! CFNOG FOR EVERYWHERE EXCEPT CROPS - ! CFNO FOR CROP AND CORN - IF ( XEF_ALL(1,INO).LT.0. ) THEN - - ! WITH EFMAPS - ZTMO1 = 0. - ZTMO2 = 0. - DO JM = 1,14 - ZTMO1 = ZTMO1 + PPFT(JM,JJ) - ZTMO2 = ZTMO2 + XEFFS_ALL(JM,JMPSP) * PPFT(JM,JJ) * PCFNOG(JJ) - ENDDO - DO JM = 15,N_MGN_PFT - ZTMO1 = ZTMO1 + PPFT(JM,JJ) - ZTMO2 = ZTMO2 + XEFFS_ALL(JM,JMPSP) * PPFT(JM,JJ) * PCFNO(JJ) - ENDDO - IF ( ZTMO1.EQ.0. ) THEN - ZTMPER(JMPSP,JJ) = 0. - ELSE - !ZTMPER(JMPSP,JJ) = PCFSPEC(INO,JJ) * PEF(INO,JJ) * ZTMO2/ZTMO1 - ZTMPER(JMPSP,JJ) = PCFSPEC(INO,JJ) * PEF(INO,JJ) * ZTMO2/ZTMO1 * XN2NO - ENDIF - - ELSE - - ! WITHOUT EFMAPS - ZTMO3 = 0.0 - DO JM = 1,14 - ZTMO3 = ZTMO3 + & - XEF_ALL(JM,INO) * XEFFS_ALL(JM,JMPSP) * PPFT(JM,JJ)/100. * PCFNOG(JJ) - ENDDO - DO JM = 15,N_MGN_PFT - ZTMO3 = ZTMO3 + & - XEF_ALL(JM,INO) * XEFFS_ALL(JM,JMPSP) * PPFT(JM,JJ)/100. * PCFNO(JJ) - ENDDO - !ZTMPER(JMPSP,JJ) = PCFSPEC(INO,JJ) * ZTMO3 - ZTMPER(JMPSP,JJ) = PCFSPEC(INO,JJ) * ZTMO3 * XN2NO - ENDIF - - ELSE - - WRITE(*,*) "MGN2MECH: BAD IDAY" - STOP - - ENDIF - - ENDDO !DO R = 1,NROWS - -!-----------------END OF NO---------------------- - ENDIF !IF ( NMPMG .NE. INO ) THEN - -ENDDO ! END SPECIES LOOP - -!----------------------------------------------------------------------- -!.....3) CONVERSION FROM SPECIATED SPECIES TO MECHANISM SPECIES -!----------------------------------------------------------------------- -! ! CONVERT FROM UG/M^2/HR TO MOL/M^2/S USING THEIR MW - -DO JS = 1, N_SPCA_SPC - ZTMPER(JS,:) = ZTMPER(JS,:) / XSPCA_MWT(JS) * XUG2G / XHR2SEC -ENDDO -! - ! LUMPING TO MECHANISM SPECIES -! -IF ( OCONVERSION ) THEN - - DO JS = 1, IN_SCON_SPC - - JMPSP = KSPMH_MAP(JS) ! MAPPING VALUE FOR SPCA - JMPMC = KMECH_MAP(JS) ! MAPPING VALUE FOR MECHANISM - ZOUTER(JMPMC,:) = ZOUTER(JMPMC,:) + ( ZTMPER(JMPSP,:) * PCONV_FAC(JS) ) -! ! UNITS OF THESE SPECIES ARE IN MOLE/S ------> MOLE/M²/S - - ENDDO ! END SPECIES LOOP - -ELSE - ! ! GET ALL 150 SPECIES INTO THE OUTPUT ARRAY - ZOUTER(:,:) = ZTMPER(:,:) - ! ! UNITS OF THESE SPECIES ARE IN MOLE/M2/S - -ENDIF -PFLUX(:,:) = ZOUTER(:,:) - -END SUBROUTINE MGN2MECH diff --git a/src/ICCARE_BASE/mnh_oasis_recv.F90 b/src/ICCARE_BASE/mnh_oasis_recv.F90 deleted file mode 100644 index 0295401a5..000000000 --- a/src/ICCARE_BASE/mnh_oasis_recv.F90 +++ /dev/null @@ -1,253 +0,0 @@ -!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -! ########## -MODULE MODI_MNH_OASIS_RECV -! ########## -! -INTERFACE -! - SUBROUTINE MNH_OASIS_RECV(HPROGRAM,KI,KSW,PTIMEC,PTSTEP_SURF, & - PZENITH,PSW_BANDS, & - PTSRAD,PDIR_ALB,PSCA_ALB,PEMIS,PTSURF) -! - CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes -! - INTEGER, INTENT(IN) :: KI ! number of points on this proc - INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands - REAL, INTENT(IN) :: PTIMEC ! Cumulated run time step (s) - REAL, INTENT(IN) :: PTSTEP_SURF ! Surfex time step -! - REAL, DIMENSION(:), INTENT(IN) :: PZENITH ! zenithal angle (radian from the vertical) - REAL, DIMENSION(:), INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m) -! - REAL, DIMENSION(:), INTENT(OUT) :: PTSRAD ! radiative temperature (K) - REAL, DIMENSION(:,:), INTENT(OUT) :: PDIR_ALB ! direct albedo for each spectral band (-) - REAL, DIMENSION(:,:), INTENT(OUT) :: PSCA_ALB ! diffuse albedo for each spectral band (-) - REAL, DIMENSION(:), INTENT(OUT) :: PEMIS ! emissivity (-) - REAL, DIMENSION(:), INTENT(OUT) :: PTSURF ! surface effective temperature (K) -! - END SUBROUTINE MNH_OASIS_RECV -! -END INTERFACE -! -END MODULE MODI_MNH_OASIS_RECV -! -! #################################################################### -SUBROUTINE MNH_OASIS_RECV (HPROGRAM,KI,KSW,PTIMEC,PTSTEP_SURF, & - PZENITH,PSW_BANDS, & - PTSRAD,PDIR_ALB,PSCA_ALB,PEMIS,PTSURF ) -!############################################# -! -!!**** *MNH_OASIS_RECV* -!! -!! PURPOSE -!! ------- -!! Meso-NH driver that receive coupling fields from oasis -!! -!!** METHOD -!! ------ -!! -!! EXTERNAL -!! -------- -!! -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! REFERENCE -!! --------- -!! -!! -!! AUTHOR -!! ------ -!! J. Pianezze *LPO* -!! -!! MODIFICATIONS -!! ------------- -!! Original 09/2014 -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODN_SFX_OASIS, ONLY : XTSTEP_CPL_LAND, & - XTSTEP_CPL_SEA, & - XTSTEP_CPL_WAVE, & - LWATER -! -USE MODD_SFX_OASIS, ONLY : LCPL_LAND, & - LCPL_GW,LCPL_FLOOD,& - LCPL_SEA, & - LCPL_SEAICE, & - LCPL_WAVE -! -USE MODD_SURF_PAR, ONLY : XUNDEF -USE MODD_MNH_SURFEX_n -! -USE MODI_GET_LUOUT -USE MODI_SFX_OASIS_RECV -USE MODI_PUT_SFX_LAND -USE MODI_PUT_SFX_SEA -USE MODI_PUT_SFX_WAVE -USE MODI_UPDATE_ESM_SURF_ATM_n -! -IMPLICIT NONE -! -!* 0.1 Declarations of arguments -! ------------------------- -! -CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes -! -INTEGER, INTENT(IN) :: KI ! number of points on this proc -INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands -REAL, INTENT(IN) :: PTIMEC ! Cumulated run time step (s) -REAL, INTENT(IN) :: PTSTEP_SURF ! Surfex time step -! -REAL, DIMENSION(:), INTENT(IN) :: PZENITH ! zenithal angle (radian from the vertical) -REAL, DIMENSION(:), INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m) -! -REAL, DIMENSION(:), INTENT(OUT) :: PTSRAD ! radiative temperature (K) -REAL, DIMENSION(:,:), INTENT(OUT) :: PDIR_ALB ! direct albedo for each spectral band (-) -REAL, DIMENSION(:,:), INTENT(OUT) :: PSCA_ALB ! diffuse albedo for each spectral band (-) -REAL, DIMENSION(:), INTENT(OUT) :: PEMIS ! emissivity (-) -REAL, DIMENSION(:), INTENT(OUT) :: PTSURF ! surface effective temperature (K) -! -! -!* 0.2 Declarations of local variables -! ------------------------------- -! -REAL, DIMENSION(KI) :: ZLAND_WTD ! Land water table depth (m) -REAL, DIMENSION(KI) :: ZLAND_FWTD ! Land grid-cell fraction of water table rise (-) -REAL, DIMENSION(KI) :: ZLAND_FFLOOD ! Land Floodplains fraction (-) -REAL, DIMENSION(KI) :: ZLAND_PIFLOOD ! Land Potential flood infiltration(kg/m2/s) -REAL, DIMENSION(KI) :: ZSEA_SST ! Sea surface temperature (K) -REAL, DIMENSION(KI) :: ZSEA_UCU ! Sea u-current stress (Pa) -REAL, DIMENSION(KI) :: ZSEA_VCU ! Sea v-current stress (Pa) -REAL, DIMENSION(KI) :: ZSEAICE_SIT ! Sea-ice Temperature (K) -REAL, DIMENSION(KI) :: ZSEAICE_CVR ! Sea-ice cover (-) -REAL, DIMENSION(KI) :: ZSEAICE_ALB ! Sea-ice albedo (-) -REAL, DIMENSION(KI) :: ZWAVE_CHA ! Charnock coefficient (-) -REAL, DIMENSION(KI) :: ZWAVE_UCU ! u-current velocity (m/s) -REAL, DIMENSION(KI) :: ZWAVE_VCU ! v-current velocity (m/s) -REAL, DIMENSION(KI) :: ZWAVE_HS ! Significant wave height (m) -REAL, DIMENSION(KI) :: ZWAVE_TP ! Peak period (s) -! -INTEGER :: ILUOUT -REAL :: ZTIME_CPL -! -LOGICAL :: GRECV_LAND -LOGICAL :: GRECV_FLOOD -LOGICAL :: GRECV_SEA -LOGICAL :: GRECV_WAVE -! -CALL GET_LUOUT(HPROGRAM,ILUOUT) -! -!------------------------------------------------------------------------------- -! -!* 1. init coupling fields: -! ---------------------------------- -! -ZTIME_CPL = PTIMEC-PTSTEP_SURF -! -GRECV_LAND =(LCPL_LAND .AND. MOD(ZTIME_CPL,XTSTEP_CPL_LAND)==0.0) -GRECV_SEA =(LCPL_SEA .AND. MOD(ZTIME_CPL,XTSTEP_CPL_SEA )==0.0) -GRECV_WAVE =(LCPL_WAVE .AND. MOD(ZTIME_CPL,XTSTEP_CPL_WAVE)==0.0) -! -IF(GRECV_LAND)THEN - ZLAND_WTD (:) = XUNDEF - ZLAND_FWTD (:) = XUNDEF - ZLAND_FFLOOD (:) = XUNDEF - ZLAND_PIFLOOD(:) = XUNDEF -ENDIF -! -IF(GRECV_SEA)THEN - ZSEA_SST (:) = XUNDEF - ZSEA_UCU (:) = XUNDEF - ZSEA_VCU (:) = XUNDEF - ZSEAICE_SIT(:) = XUNDEF - ZSEAICE_CVR(:) = XUNDEF - ZSEAICE_ALB(:) = XUNDEF -ENDIF -! -IF(GRECV_WAVE)THEN - ZWAVE_CHA(:) = XUNDEF - ZWAVE_UCU(:) = XUNDEF - ZWAVE_VCU(:) = XUNDEF - ZWAVE_HS(:) = XUNDEF - ZWAVE_TP(:) = XUNDEF -ENDIF -! -! -!* 2. Receive fields to other models proc by proc: -! -------------------------------------------- -! -CALL SFX_OASIS_RECV(HPROGRAM,KI,KSW,ZTIME_CPL, & - GRECV_LAND, GRECV_SEA, GRECV_WAVE, & - ZLAND_WTD (:),ZLAND_FWTD (:), & - ZLAND_FFLOOD (:),ZLAND_PIFLOOD(:), & - ZSEA_SST (:),ZSEA_UCU (:), & - ZSEA_VCU (:),ZSEAICE_SIT (:), & - ZSEAICE_CVR (:),ZSEAICE_ALB (:), & - ZWAVE_CHA (:),ZWAVE_UCU (:), & - ZWAVE_VCU (:),ZWAVE_HS (:), & - ZWAVE_TP (:) ) -! -! -!* 3. Put definitions for exchange of coupling fields : -! ------------------------------------------------- -! -!------------------------------------------------------------------------------- -! Put variable over land tile -!------------------------------------------------------------------------------- -! -IF(GRECV_LAND)THEN - CALL PUT_SFX_LAND(YSURF_CUR%IM%O, YSURF_CUR%IM%S, YSURF_CUR%IM%K, & - YSURF_CUR%IM%NK, YSURF_CUR%IM%NP, YSURF_CUR%U, & - ILUOUT,LCPL_GW,LCPL_FLOOD, & - ZLAND_WTD (:),ZLAND_FWTD (:), & - ZLAND_FFLOOD(:),ZLAND_PIFLOOD(:) ) -ENDIF -! -!------------------------------------------------------------------------------- -! Put variable over sea and/or water tile -!------------------------------------------------------------------------------- -! -IF(GRECV_SEA)THEN - CALL PUT_SFX_SEA(YSURF_CUR%SM%S, YSURF_CUR%U, YSURF_CUR%WM%W, & - ILUOUT,LCPL_SEAICE,LWATER, & - ZSEA_SST (:),ZSEA_UCU (:), & - ZSEA_VCU (:),ZSEAICE_SIT(:), & - ZSEAICE_CVR(:),ZSEAICE_ALB(:) ) -ENDIF -! -!------------------------------------------------------------------------------- -! Put variable over sea and/or water tile for waves -!------------------------------------------------------------------------------- -! -IF(GRECV_WAVE)THEN - CALL PUT_SFX_WAVE(YSURF_CUR%SM%S, YSURF_CUR%U, & - ILUOUT,ZWAVE_CHA(:),ZWAVE_UCU(:), & - ZWAVE_VCU(:),ZWAVE_HS(:),ZWAVE_TP(:) ) -ENDIF -! -!------------------------------------------------------------------------------- -! Update radiative properties at time t+1 for radiative scheme -!------------------------------------------------------------------------------- -! -GRECV_FLOOD=(GRECV_LAND.AND.LCPL_FLOOD) -! -IF(GRECV_SEA.OR.GRECV_FLOOD)THEN - CALL UPDATE_ESM_SURF_ATM_n(YSURF_CUR%FM%F, YSURF_CUR%IM, YSURF_CUR%SM%S, & - YSURF_CUR%U, YSURF_CUR%WM%W, & - YSURF_CUR%TM, YSURF_CUR%GDM, YSURF_CUR%GRM, & - HPROGRAM, KI, KSW, PZENITH(:), PSW_BANDS, & - PTSRAD(:), PDIR_ALB(:,:), & - PSCA_ALB(:,:), PEMIS(:), & - PTSURF(:) ) -ENDIF -! -!------------------------------------------------------------------------------- -! -END SUBROUTINE MNH_OASIS_RECV diff --git a/src/ICCARE_BASE/modd_ch_aeron.f90 b/src/ICCARE_BASE/modd_ch_aeron.f90 deleted file mode 100644 index 121c2373d..000000000 --- a/src/ICCARE_BASE/modd_ch_aeron.f90 +++ /dev/null @@ -1,225 +0,0 @@ -!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence -!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!ORILAM_LIC for details. -!! ##################### - MODULE MODD_CH_AERO_n -!! ##################### -!! -!! PURPOSE -!! ------- -!! declaration of variables and types for the aerosol system -!! -!! METHOD -!! ------ -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! P. Tulet (LA) -!! -!! MODIFICATIONS -!! ------------- -!! (30-01-01) P.Tulet (LA) * modifications for secondary biogenics aerosols -!! -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_PARAMETERS, ONLY: JPMODELMAX -! -IMPLICIT NONE -! -TYPE CH_AERO_t - ! - !* normalisation parameters - ! - REAL, DIMENSION(:,:), POINTER :: XN0=>NULL() ! Number concentration - REAL, DIMENSION(:,:), POINTER :: XRG0=>NULL() ! Geometric mean size - REAL, DIMENSION(:,:), POINTER :: XSIG0=>NULL() ! Dispersion ln(sigma) - REAL, DIMENSION(:,:,:,:), POINTER :: XN3D=>NULL() ! Number concentration - REAL, DIMENSION(:,:,:,:), POINTER :: XRG3D=>NULL() ! Geometric mean size - REAL, DIMENSION(:,:,:,:), POINTER :: XSIG3D=>NULL() ! dispersion (sigma) - REAL, DIMENSION(:,:,:,:), POINTER :: XM3D=>NULL() ! moments - REAL, DIMENSION(:,:,:,:), POINTER :: XSEDA=>NULL() ! sedimentation - REAL, DIMENSION(:,:,:), POINTER :: XVDEPAERO=>NULL() ! aerosol dry deposition - REAL, DIMENSION(:,:,:,:,:), POINTER :: XCTOTA3D=>NULL() ! Total concentration of species - ! - REAL, DIMENSION(:,:,:), POINTER :: XFTEST=>NULL() - REAL, DIMENSION(:,:,:), POINTER :: XCTOTA=>NULL() ! Total concentration of species - ! (HNO3, ! H2SO4, NH3) present in - ! each of the aerosol mode (ug/m3) - REAL, DIMENSION(:,:,:), POINTER :: XCCTOT=>NULL() ! Composition of 3rd Moment (%) - REAL, DIMENSION(:,:), POINTER :: XCTOTG=>NULL() ! Total concentration of volatile - ! species (HNO3, NH3) (ug/m3) in - ! the air - REAL, DIMENSION(:,:,:,:), POINTER :: XFRAC=>NULL() ! Gas fraction into organic species - REAL, DIMENSION(:,:,:,:), POINTER :: XMI=>NULL() ! Molar mass of aerosol species (g/mol) - REAL, DIMENSION(:,:,:,:), POINTER :: XSOLORG=>NULL() ! Solubility fraction of SOA (%) - REAL, DIMENSION(:,:), POINTER :: XRHOP0=>NULL() ! Condensed phase density (kg/m3) - REAL, DIMENSION(:,:,:,:), POINTER :: XRHOP3D=>NULL() ! Condensed phase density (kg/m3) - REAL, DIMENSION(:), POINTER :: XLAMBDA=>NULL() ! Mean free path of background - ! gas molecules - REAL, DIMENSION(:), POINTER :: XMU=>NULL() ! gas viscosity (kg/(ms)) - REAL, DIMENSION(:,:,:), POINTER :: XJNUC=>NULL() ! nucleation rate (molec.cm-3.s-1) - REAL, DIMENSION(:,:,:), POINTER :: XJ2RAT=>NULL() ! particle formation rate for 2 nm - REAL, DIMENSION(:,:,:), POINTER :: XCONC_MASS=>NULL() ! available mass (ug.m-3) - REAL, DIMENSION(:,:,:), POINTER :: XCOND_MASS_I=>NULL() ! condensated mass mode i (ug.m-3) - REAL, DIMENSION(:,:,:), POINTER :: XCOND_MASS_J=>NULL() ! condensated mass mode j (ug.m-3) - REAL, DIMENSION(:,:,:), POINTER :: XNUCL_MASS=>NULL() ! nucleation mass (ug.m-3) - ! - REAL, DIMENSION(:,:,:,:), POINTER :: XMBEG=>NULL() - REAL, DIMENSION(:,:,:,:), POINTER :: XMINT=>NULL() - REAL, DIMENSION(:,:,:,:), POINTER :: XMEND=>NULL() - ! - REAL, DIMENSION(:,:,:,:), POINTER :: XDMINTRA=>NULL() - REAL, DIMENSION(:,:,:,:), POINTER :: XDMINTER=>NULL() - REAL, DIMENSION(:,:,:,:), POINTER :: XDMCOND=>NULL() - REAL, DIMENSION(:,:,:,:), POINTER :: XDMNUCL=>NULL() - REAL, DIMENSION(:,:,:,:), POINTER :: XDMMERG=>NULL() - ! - !* Growth parameters - ! - REAL, DIMENSION(:,:), POINTER :: XOM=>NULL() - ! - !* Nucleation/cond. growth parameters - ! - REAL, DIMENSION(:), POINTER :: XSO4RAT=>NULL() - ! Rate of gas phase production of - ! sulfuric acid (molec./cm3/s) - ! - LOGICAL :: GSEDFIX = .TRUE. ! flag used in CH_AER_SEDIM_n routine - ! -END TYPE CH_AERO_t -! -TYPE(CH_AERO_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: CH_AERO_MODEL -! -REAL, DIMENSION(:,:), POINTER :: XN0=>NULL() -REAL, DIMENSION(:,:), POINTER :: XRG0=>NULL() -REAL, DIMENSION(:,:), POINTER :: XSIG0=>NULL() -REAL, DIMENSION(:,:,:,:), POINTER :: XN3D=>NULL() -REAL, DIMENSION(:,:,:,:), POINTER :: XRG3D=>NULL() -REAL, DIMENSION(:,:,:,:), POINTER :: XSIG3D=>NULL() -REAL, DIMENSION(:,:,:,:), POINTER :: XM3D=>NULL() -REAL, DIMENSION(:,:,:,:), POINTER :: XSEDA=>NULL() -REAL, DIMENSION(:,:,:), POINTER :: XVDEPAERO=>NULL() -REAL, DIMENSION(:,:,:,:,:), POINTER :: XCTOTA3D=>NULL() -REAL, DIMENSION(:,:,:), POINTER :: XFTEST=>NULL() -REAL, DIMENSION(:,:,:), POINTER :: XCTOTA=>NULL() -REAL, DIMENSION(:,:,:), POINTER :: XCCTOT=>NULL() -REAL, DIMENSION(:,:), POINTER :: XCTOTG=>NULL() -REAL, DIMENSION(:,:,:,:), POINTER :: XFRAC=>NULL() -REAL, DIMENSION(:,:,:,:), POINTER :: XMI=>NULL() -REAL, DIMENSION(:,:,:,:), POINTER :: XSOLORG=>NULL() -REAL, DIMENSION(:,:), POINTER :: XRHOP0=>NULL() -REAL, DIMENSION(:,:,:,:), POINTER :: XRHOP3D=>NULL() -REAL, DIMENSION(:), POINTER :: XLAMBDA=>NULL() -REAL, DIMENSION(:), POINTER :: XMU=>NULL() -REAL, DIMENSION(:,:), POINTER :: XOM=>NULL() -REAL, DIMENSION(:), POINTER :: XSO4RAT=>NULL() -LOGICAL, POINTER :: GSEDFIX=>NULL() -REAL, DIMENSION(:,:,:), POINTER :: XJNUC=>NULL() -REAL, DIMENSION(:,:,:), POINTER :: XJ2RAT=>NULL() -REAL, DIMENSION(:,:,:), POINTER :: XCONC_MASS=>NULL() ! Available mass (ug.m-3) -REAL, DIMENSION(:,:,:), POINTER :: XCOND_MASS_I=>NULL() ! Condensated mass mode i (ug.m-3) -REAL, DIMENSION(:,:,:), POINTER :: XCOND_MASS_J=>NULL() ! Condensated mass mode j (ug.m-3) -REAL, DIMENSION(:,:,:), POINTER :: XNUCL_MASS=>NULL() ! Nucleation mass (ug.m-3) -REAL, DIMENSION(:,:,:,:), POINTER :: XMBEG=>NULL() -REAL, DIMENSION(:,:,:,:), POINTER :: XMINT=>NULL() -REAL, DIMENSION(:,:,:,:), POINTER :: XMEND=>NULL() -REAL, DIMENSION(:,:,:,:), POINTER :: XDMINTRA=>NULL() -REAL, DIMENSION(:,:,:,:), POINTER :: XDMINTER=>NULL() -REAL, DIMENSION(:,:,:,:), POINTER :: XDMCOND=>NULL() -REAL, DIMENSION(:,:,:,:), POINTER :: XDMNUCL=>NULL() -REAL, DIMENSION(:,:,:,:), POINTER :: XDMMERG=>NULL() -! -CONTAINS -! -SUBROUTINE CH_AERO_GOTO_MODEL(KFROM, KTO) -INTEGER, INTENT(IN) :: KFROM, KTO -! -! Save current state for allocated arrays -CH_AERO_MODEL(KFROM)%XN0=>XN0 -CH_AERO_MODEL(KFROM)%XRG0=>XRG0 -CH_AERO_MODEL(KFROM)%XSIG0=>XSIG0 -CH_AERO_MODEL(KFROM)%XN3D=>XN3D -CH_AERO_MODEL(KFROM)%XRG3D=>XRG3D -CH_AERO_MODEL(KFROM)%XSIG3D=>XSIG3D -CH_AERO_MODEL(KFROM)%XM3D=>XM3D -CH_AERO_MODEL(KFROM)%XSEDA=>XSEDA -CH_AERO_MODEL(KFROM)%XVDEPAERO=>XVDEPAERO -CH_AERO_MODEL(KFROM)%XCTOTA3D=>XCTOTA3D -CH_AERO_MODEL(KFROM)%XFTEST=>XFTEST -CH_AERO_MODEL(KFROM)%XCTOTA=>XCTOTA -CH_AERO_MODEL(KFROM)%XCCTOT=>XCCTOT -CH_AERO_MODEL(KFROM)%XCTOTG=>XCTOTG -CH_AERO_MODEL(KFROM)%XFRAC=>XFRAC -CH_AERO_MODEL(KFROM)%XMI=>XMI -CH_AERO_MODEL(KFROM)%XSOLORG=>XSOLORG -CH_AERO_MODEL(KFROM)%XRHOP0=>XRHOP0 -CH_AERO_MODEL(KFROM)%XRHOP3D=>XRHOP3D -CH_AERO_MODEL(KFROM)%XLAMBDA=>XLAMBDA -CH_AERO_MODEL(KFROM)%XMU=>XMU -CH_AERO_MODEL(KFROM)%XOM=>XOM -CH_AERO_MODEL(KFROM)%XSO4RAT=>XSO4RAT -CH_AERO_MODEL(KFROM)%XJNUC=>XJNUC -CH_AERO_MODEL(KFROM)%XJ2RAT=>XJ2RAT -CH_AERO_MODEL(KFROM)%XCONC_MASS=>XCONC_MASS -CH_AERO_MODEL(KFROM)%XCOND_MASS_I=>XCOND_MASS_I -CH_AERO_MODEL(KFROM)%XCOND_MASS_J=>XCOND_MASS_J -CH_AERO_MODEL(KFROM)%XNUCL_MASS=>XNUCL_MASS -CH_AERO_MODEL(KFROM)%XMBEG=>XMBEG -CH_AERO_MODEL(KFROM)%XMINT=>XMINT -CH_AERO_MODEL(KFROM)%XMEND=>XMEND -CH_AERO_MODEL(KFROM)%XDMINTRA=>XDMINTRA -CH_AERO_MODEL(KFROM)%XDMINTER=>XDMINTER -CH_AERO_MODEL(KFROM)%XDMCOND=>XDMCOND -CH_AERO_MODEL(KFROM)%XDMNUCL=>XDMNUCL -CH_AERO_MODEL(KFROM)%XDMMERG=>XDMMERG -! -! Current model is set to model KTO -XN0=>CH_AERO_MODEL(KTO)%XN0 -XRG0=>CH_AERO_MODEL(KTO)%XRG0 -XSIG0=>CH_AERO_MODEL(KTO)%XSIG0 -XN3D=>CH_AERO_MODEL(KTO)%XN3D -XRG3D=>CH_AERO_MODEL(KTO)%XRG3D -XSIG3D=>CH_AERO_MODEL(KTO)%XSIG3D -XM3D=>CH_AERO_MODEL(KTO)%XM3D -XSEDA=>CH_AERO_MODEL(KTO)%XSEDA -XVDEPAERO=>CH_AERO_MODEL(KTO)%XVDEPAERO -XCTOTA3D=>CH_AERO_MODEL(KTO)%XCTOTA3D -XFTEST=>CH_AERO_MODEL(KTO)%XFTEST -XCTOTA=>CH_AERO_MODEL(KTO)%XCTOTA -XCCTOT=>CH_AERO_MODEL(KTO)%XCCTOT -XCTOTG=>CH_AERO_MODEL(KTO)%XCTOTG -XFRAC=>CH_AERO_MODEL(KTO)%XFRAC -XMI=>CH_AERO_MODEL(KTO)%XMI -XSOLORG=>CH_AERO_MODEL(KTO)%XSOLORG -XRHOP0=>CH_AERO_MODEL(KTO)%XRHOP0 -XRHOP3D=>CH_AERO_MODEL(KTO)%XRHOP3D -XLAMBDA=>CH_AERO_MODEL(KTO)%XLAMBDA -XMU=>CH_AERO_MODEL(KTO)%XMU -XOM=>CH_AERO_MODEL(KTO)%XOM -XSO4RAT=>CH_AERO_MODEL(KTO)%XSO4RAT -GSEDFIX=>CH_AERO_MODEL(KTO)%GSEDFIX -XJNUC=>CH_AERO_MODEL(KTO)%XJNUC -XJ2RAT=>CH_AERO_MODEL(KTO)%XJ2RAT -XCONC_MASS=>CH_AERO_MODEL(KTO)%XCONC_MASS -XCOND_MASS_I=>CH_AERO_MODEL(KTO)%XCOND_MASS_I -XCOND_MASS_J=>CH_AERO_MODEL(KTO)%XCOND_MASS_J -XNUCL_MASS=>CH_AERO_MODEL(KTO)%XNUCL_MASS -XMBEG=>CH_AERO_MODEL(KTO)%XMBEG -XMINT=>CH_AERO_MODEL(KTO)%XMINT -XMEND=>CH_AERO_MODEL(KTO)%XMEND -XDMINTRA=>CH_AERO_MODEL(KTO)%XDMINTRA -XDMINTER=>CH_AERO_MODEL(KTO)%XDMINTER -XDMCOND=>CH_AERO_MODEL(KTO)%XDMCOND -XDMNUCL=>CH_AERO_MODEL(KTO)%XDMNUCL -XDMMERG=>CH_AERO_MODEL(KTO)%XDMMERG -END SUBROUTINE CH_AERO_GOTO_MODEL -! -END MODULE MODD_CH_AERO_n diff --git a/src/ICCARE_BASE/modd_ch_aerosol.f90 b/src/ICCARE_BASE/modd_ch_aerosol.f90 deleted file mode 100644 index 78e61cb5f..000000000 --- a/src/ICCARE_BASE/modd_ch_aerosol.f90 +++ /dev/null @@ -1,278 +0,0 @@ -!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence -!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!ORILAM_LIC for details. -!! ###################### - MODULE MODD_CH_AEROSOL -!! ###################### -!! -!! PURPOSE -!! ------- -!! -!! declaration of variables and types for the aerosol system -!! -!! METHOD -!! ------ -!! -!! -!! REFERENCE -!! --------- -!! none -!! -!! -!! AUTHOR -!! ------ -!! Vincent Crassier (LA) -!! -!! -!! MODIFICATIONS -!! ------------- -!! (30-01-01) P.Tulet (LA) * modifications for secondary biogenics aerosols -!! (25-08-16) M.Leriche (LA) * NM6_AER is now in SAVE and assign in ini_nsv -!! -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_PARAMETERS, ONLY: JPMODELMAX, JPSVNAMELGTMAX -! -IMPLICIT NONE -! -! aerosol mode parameters - ! and OC from CO concentration (real_case) -INTEGER, PARAMETER :: JPMODE=2 ! number of modes -INTEGER, PARAMETER :: JPIN=JPMODE*3 ! number of differential equations -INTEGER, SAVE, DIMENSION(JPMODE) :: NM0,NM3,NM6 ! index of the moments in arrays - -CHARACTER(LEN=JPSVNAMELGTMAX), DIMENSION(JPMODE*2), PARAMETER :: CDEAERNAMES = & - (/'DEAERM31C','DEAERM32C' & - ,'DEAERM31R','DEAERM32R' /) -! - -LOGICAL :: LORILAM = .FALSE. ! switch to active aerosols fluxes -LOGICAL :: LINITPM = .TRUE. ! switch to initialize BC -LOGICAL :: LAERINIT = .FALSE. ! switch to initialize aerosols -! -LOGICAL,DIMENSION(JPMODELMAX) :: LDEPOS_AER = .FALSE. ! switch to AER wet depositon - ! and OC from CO concentration (real_case) -! -!* indices of Aerosol chemical parameters -! -INTEGER, PARAMETER :: NSP=4 ! number of chemical species - ! for ARES or isorropia NSP=4 these are -INTEGER, PARAMETER :: JP_AER_SO4 = 1 -INTEGER, PARAMETER :: JP_AER_NO3 = 2 -INTEGER, PARAMETER :: JP_AER_NH3 = 3 -INTEGER, PARAMETER :: JP_AER_H2O = 4 -! -INTEGER, PARAMETER :: JP_AER_SO4g = JP_AER_SO4 -INTEGER, PARAMETER :: JP_AER_NO3g = JP_AER_NO3 -INTEGER, PARAMETER :: JP_AER_NH3g = JP_AER_NH3 -! -INTEGER, PARAMETER :: NCARB=3 ! number of chemically inert species - ! (like black carbon) -INTEGER, PARAMETER :: JP_AER_OC = 5 -INTEGER, PARAMETER :: JP_AER_BC = 6 -INTEGER, PARAMETER :: JP_AER_DST = 7 -! -INTEGER :: NSOA = 10 ! number of condensable species that may form - ! secondary aerosols -INTEGER, SAVE :: NM6_AER ! number of mode for which M6 is computed define in ini_sv - ! secondary aerosols -INTEGER :: JP_AER_SOA1 = 8 -INTEGER :: JP_AER_SOA2 = 9 -INTEGER :: JP_AER_SOA3 = 10 -INTEGER :: JP_AER_SOA4 = 11 -INTEGER :: JP_AER_SOA5 = 12 -INTEGER :: JP_AER_SOA6 = 13 -INTEGER :: JP_AER_SOA7 = 14 -INTEGER :: JP_AER_SOA8 = 15 -INTEGER :: JP_AER_SOA9 = 16 -INTEGER :: JP_AER_SOA10 = 17 -! -CHARACTER(LEN=32),DIMENSION(:), ALLOCATABLE :: CAERONAMES -! -INTEGER :: JP_CH_SO4I = 1 -INTEGER :: JP_CH_SO4J = 2 -INTEGER :: JP_CH_NO3I = 3 -INTEGER :: JP_CH_NO3J = 4 -INTEGER :: JP_CH_NH3I = 5 -INTEGER :: JP_CH_NH3J = 6 -INTEGER :: JP_CH_H2OI = 7 -INTEGER :: JP_CH_H2OJ = 8 -INTEGER :: JP_CH_OCI = 9 -INTEGER :: JP_CH_OCJ = 10 -INTEGER :: JP_CH_BCI = 11 -INTEGER :: JP_CH_BCJ = 12 -INTEGER :: JP_CH_DSTI = 13 -INTEGER :: JP_CH_DSTJ = 14 -INTEGER :: JP_CH_SOA1I = 15 -INTEGER :: JP_CH_SOA1J = 16 -INTEGER :: JP_CH_SOA2I = 17 -INTEGER :: JP_CH_SOA2J = 18 -INTEGER :: JP_CH_SOA3I = 19 -INTEGER :: JP_CH_SOA3J = 20 -INTEGER :: JP_CH_SOA4I = 21 -INTEGER :: JP_CH_SOA4J = 22 -INTEGER :: JP_CH_SOA5I = 23 -INTEGER :: JP_CH_SOA5J = 24 -INTEGER :: JP_CH_SOA6I = 25 -INTEGER :: JP_CH_SOA6J = 26 -INTEGER :: JP_CH_SOA7I = 27 -INTEGER :: JP_CH_SOA7J = 28 -INTEGER :: JP_CH_SOA8I = 29 -INTEGER :: JP_CH_SOA8J = 30 -INTEGER :: JP_CH_SOA9I = 31 -INTEGER :: JP_CH_SOA9J = 32 -INTEGER :: JP_CH_SOA10I = 33 -INTEGER :: JP_CH_SOA10J = 34 -INTEGER :: JP_CH_M0I = 35 -INTEGER :: JP_CH_M0J = 36 -INTEGER :: JP_CH_M6I = 37 -INTEGER :: JP_CH_M6J = 38 -! -! Index for gas species which interact with aerosols -INTEGER :: JP_CH_HNO3, JP_CH_H2SO4, JP_CH_NH3, JP_CH_O3, JP_CH_CO, & - JP_CH_URG1, JP_CH_URG2, JP_CH_RPG2, JP_CH_RP18, JP_CH_UR26, & - JP_CH_RPG3, JP_CH_URG4, JP_CH_UR8, JP_CH_UR17, JP_CH_UR7, JP_CH_URG6, & - JP_CH_ARAC, JP_CH_URG7, JP_CH_RPG7, JP_CH_RPR7, JP_CH_URG8, JP_CH_UR19, & - JP_CH_URG9, JP_CH_URG10, JP_CH_PAN8, JP_CH_UR22, JP_CH_RPR4, JP_CH_AP7, & - JP_CH_RPR3, JP_CH_UR21, JP_CH_UR28, JP_CH_UR29, JP_CH_UR30, & - JP_CH_RPR9, JP_CH_RP12, JP_CH_UR3, JP_CH_UR23, JP_CH_UR31, JP_CH_AP1, & - JP_CH_AP6, JP_CH_ADAC, JP_CH_UR2, JP_CH_UR14, JP_CH_UR27, JP_CH_RP14, & - JP_CH_RP19, JP_CH_UR11, JP_CH_UR15, JP_CH_AP10, JP_CH_UR20, JP_CH_UR34, & - JP_CH_AP11, JP_CH_AP12, JP_CH_UR5, JP_CH_UR6, JP_CH_AP8, JP_CH_RP17, & - JP_CH_RP13 -! -INTEGER :: JP_CH_H2O2, JP_CH_SO2, JP_CH_SO42M -! -! volumar mass of species i [kg/m3] -REAL, SAVE, DIMENSION(:), ALLOCATABLE :: XRHOI -! -! conversion factor : -! ------------------- -! moment3 [um3_aer/m3_air] = conc[ug_aer/m3_air]/XFAC -! -REAL, SAVE, DIMENSION(:), ALLOCATABLE :: XFAC -! -! Molar mass of each aerosols parents [g/mol] -REAL, PARAMETER :: XHNO3 = 63.01287 -REAL, PARAMETER :: XH2SO4 = 98.079 -REAL, PARAMETER :: XNH3 = 17.03061 -REAL, PARAMETER :: XURG1 = 88. -REAL, PARAMETER :: XURG2 = 1.76981E+02 -REAL, PARAMETER :: XRPG2 = 1.68000E+02 -REAL, PARAMETER :: XRP18 = 1.84000E+02 -REAL, PARAMETER :: XRPG3 = 1.53772E+02 -REAL, PARAMETER :: XURG4 = 1.95867E+02 -REAL, PARAMETER :: XUR17 = 1.72000E+02 -REAL, PARAMETER :: XRPR3 = 1.86000E+02 -REAL, PARAMETER :: XAP7 = 2.33000E+02 -REAL, PARAMETER :: XURG6 = 1.89153E+02 -REAL, PARAMETER :: XUR22 = 2.12000E+02 -REAL, PARAMETER :: XURG7 = 1.56781E+02 -REAL, PARAMETER :: XADAC = 1.56781E+02 -REAL, PARAMETER :: XRPR4 = 1.67000E+02 -REAL, PARAMETER :: XRPR7 = 1.50000E+02 -REAL, PARAMETER :: XRPG7 = 1.96059E+02 -REAL, PARAMETER :: XURG8 = 1.73777E+02 -REAL, PARAMETER :: XURG9 = 2.61676E+02 -REAL, PARAMETER :: XUR26 = 1.68000E+02 -REAL, PARAMETER :: XURG10 = 2.14834E+02 -REAL, PARAMETER :: XUR7 = 1.68000E+02 -REAL, PARAMETER :: XUR8 = 1.84000E+02 -REAL, PARAMETER :: XPAN8 = 2.63000E+02 -REAL, PARAMETER :: XARAC = 1.66000E+02 -REAL, PARAMETER :: XUR19 = 1.70000E+02 -REAL, PARAMETER :: XUR21 = 88. -REAL, PARAMETER :: XUR28 = 90. -REAL, PARAMETER :: XUR29 = 186.0 -REAL, PARAMETER :: XUR30 = 200.0 -REAL, PARAMETER :: XRP13 = 168. -REAL, PARAMETER :: XRP17 = 170.0 -REAL, PARAMETER :: XRPR9 = 154.0 -REAL, PARAMETER :: XRP12 = 152.0 -REAL, PARAMETER :: XUR3 = 202.0 -REAL, PARAMETER :: XUR23 = 144.0 -REAL, PARAMETER :: XUR31 = 220.0 -REAL, PARAMETER :: XAP1 = 183.0 -REAL, PARAMETER :: XAP6 = 197.0 -REAL, PARAMETER :: XRP14 = 188.0 -REAL, PARAMETER :: XRP19 = 204.0 -REAL, PARAMETER :: XUR2 = 152.0 -REAL, PARAMETER :: XUR14 = 181.0 -REAL, PARAMETER :: XUR27 = 164.0 -REAL, PARAMETER :: XUR11 = 172.0 -REAL, PARAMETER :: XUR15 = 201.0 -REAL, PARAMETER :: XAP10 = 217.0 -REAL, PARAMETER :: XUR20 = 256.0 -REAL, PARAMETER :: XUR34 = 240.0 -REAL, PARAMETER :: XAP11 = 287.0 -REAL, PARAMETER :: XAP12 = 303.0 -REAL, PARAMETER :: XUR5 = 170.0 -REAL, PARAMETER :: XUR6 = 170.0 -REAL, PARAMETER :: XAP8 = 215.0 -! -!---------------------------------------------------------------------------- -! -REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: XSURF -REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: XDP -! -! Declaration for the Bessagnet tabulation -REAL, SAVE, DIMENSION(:), ALLOCATABLE :: rhi -REAL, SAVE, DIMENSION(:), ALLOCATABLE :: tempi -REAL, SAVE, DIMENSION(:), ALLOCATABLE :: zsu, znh, zni -REAL, SAVE, DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: zf -! -! Declaration of the neuronal coefficients -! -! .. weights -REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: W1IJA,W1JKA,W2IJA,W2JKA -REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: W1IJB,W1JKB,W2IJB,W2JKB -REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: W1IJC,W1JKC,W2IJC,W2JKC -REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: X1MINA,X1MAXA,X1MODA,X2MINA,X2MAXA,X2MODA -REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: X1MINB,X1MAXB,X1MODB,X2MINB,X2MAXB,X2MODB -REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: X1MINC,X1MAXC,X1MODC,X2MINC,X2MAXC,X2MODC - -! -! .. counters and indices -INTEGER, SAVE :: I1IA,J1JA,K1KA,I2IA,J2JA,K2KA -INTEGER, SAVE :: I1IB,J1JB,K1KB,I2IB,J2JB,K2KB -INTEGER, SAVE :: I1IC,J1JC,K1KC,I2IC,J2JC,K2KC -! -!---------------------------------------------------------------------------- -! aerosol lognormal parameterizations -! -CHARACTER(LEN=4) :: CRGUNIT = 'NUMB' ! type of log-normal geometric mean radius -! ! given in namelist (mass on number) -LOGICAL :: LVARSIGI = .FALSE. ! switch to active pronostic dispersion for I mode -LOGICAL :: LVARSIGJ = .FALSE. ! switch to active pronostic dispersion for J mode -LOGICAL :: LVARSIGK = .FALSE. ! switch to active pronostic dispersion for K mode, not used -LOGICAL :: LHETEROSO4 = .FALSE. ! switch to active sulfates heteronegeous production -LOGICAL :: LRGFIX = .FALSE. ! switch to active aerosol sedimentation -LOGICAL :: LSEDIMAERO = .FALSE. ! switch to active aerosol sedimentation -REAL :: XN0IMIN = 1.E4 ! minimum particule number value for I mode / m3 -REAL :: XN0JMIN = 0.01E4 ! minimum particule number value for J mode / m3 -REAL :: XINIRADIUSI = 0.030 ! mean radius initialization for I mode (um) -REAL :: XINIRADIUSJ = 0.200 ! mean radius initialization for J mode (um) -REAL :: XINISIGI = 1.75 ! dispersion initialization for I mode -REAL :: XINISIGJ = 1.76 ! dispersion initialization for J mode -REAL :: XSIGIMIN = 1.10 ! minimum dispersion value for I mode -REAL :: XSIGJMIN = 1.10 ! minimum dispersion value for J mode -REAL :: XSIGIMAX = 3.60 ! maximum dispersion value for I mode -REAL :: XSIGJMAX = 3.60 ! maximum dispersion value for J mode -REAL :: XCOEFRADIMAX = 30. ! maximum increasement for Rg mode I -REAL :: XCOEFRADIMIN = 10. ! maximum decreasement for Rg mode I -REAL :: XCOEFRADJMAX = 30. ! maximum increasement for Rg mode J -REAL :: XCOEFRADJMIN = 10. ! maximum decreasement for Rg mode J -REAL :: XRADIUS_NUCL = 2E-3 ! Radius of new particles created by nucleation [um] -REAL :: XSIGMA_NUCL = 1.5 ! Sigma of new particles created by nucleation [um] -CHARACTER(LEN=5) :: CMINERAL = "NONE" ! mineral equilibrium scheme -CHARACTER(LEN=5) :: CORGANIC = "NONE" ! organic equilibrium scheme -CHARACTER(LEN=80) :: CNUCLEATION = "NONE" ! sulfates nucleation scheme -LOGICAL :: LCONDENSATION = .TRUE. ! sulfates condensation scheme -LOGICAL :: LCOAGULATION = .TRUE. ! coagulation scheme -LOGICAL :: LMODE_MERGING = .TRUE. ! mode merging -! -END MODULE MODD_CH_AEROSOL diff --git a/src/ICCARE_BASE/modd_ch_surfn.F90 b/src/ICCARE_BASE/modd_ch_surfn.F90 deleted file mode 100644 index 6114c9132..000000000 --- a/src/ICCARE_BASE/modd_ch_surfn.F90 +++ /dev/null @@ -1,97 +0,0 @@ -!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -! ##################### - MODULE MODD_CH_SURF_n -! ##################### -! -!! -!! PURPOSE -!! ------- -! -! -! -!! -!!** IMPLICIT ARGUMENTS -!! ------------------ -!! None -!! -!! -!! AUTHOR -!! ------ -!! P. Tulet *Meteo France* -!! -!! MODIFICATIONS -!! ------------- -!! 16/07/03 (P. Tulet) restructured for externalization -!! 10/2011 (S. Queguiner) Add CCH_EMIS -!! 06/2017 (M. Leriche) add CCH_BIOEMIS and LCH_BIOEMIS for MEGAN coupling activation -!------------------------------------------------------------------------------ -! -!* 0. DECLARATIONS -! ------------ -! -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -IMPLICIT NONE - -TYPE CH_SURF_t -! - CHARACTER(LEN=4) :: CCH_EMIS ! Option for chemical emissions - ! 'NONE' : no emission - ! 'AGGR' : one aggregated value - ! for each specie and hour - ! 'SNAP' : from SNAP data using - ! potential emission & temporal profiles - CHARACTER(LEN=4) :: CCH_BIOEMIS ! Option for MEGAN coupling activation - ! 'NONE' : no coupling with MEGAN - ! 'MEGA' : activate MEGAN coupling - CHARACTER(LEN=4) :: CCH_DMSEMIS ! Option for DMS fluxes activation - ! 'NONE' : no coupling with MEGAN - ! 'DMSDATA' : activate DMS fluxes - CHARACTER(LEN=6), DIMENSION(:), POINTER :: CCH_NAMES ! NAME OF CHEMICAL - CHARACTER(LEN=6), DIMENSION(:), POINTER :: CAER_NAMES ! NAME OF AEROSOL SPECIES - ! SPECIES (FOR DIAG ONLY) - CHARACTER(LEN=28) :: CCHEM_SURF_FILE ! name of general - ! (chemical) purpose - ! ASCII input file - REAL, DIMENSION(:), POINTER :: XCONVERSION ! emission unit - ! conversion factor - LOGICAL :: LCH_SURF_EMIS ! T : chemical emissions - ! are used - LOGICAL :: LCH_EMIS ! T : chemical emissions - ! are present in the file - LOGICAL :: LCH_BIOEMIS ! T : megan emissions - ! are present in the file - LOGICAL :: LCH_DMSEMIS ! T : dms data - ! are present in the file -! -END TYPE CH_SURF_t - - - -CONTAINS -! -SUBROUTINE CH_SURF_INIT(YCH_SURF) -TYPE(CH_SURF_t), INTENT(INOUT) :: YCH_SURF -REAL(KIND=JPRB) :: ZHOOK_HANDLE -IF (LHOOK) CALL DR_HOOK("MODD_CH_SURF_N:CH_SURF_INIT",0,ZHOOK_HANDLE) - NULLIFY(YCH_SURF%CCH_NAMES) - NULLIFY(YCH_SURF%CAER_NAMES) - NULLIFY(YCH_SURF%XCONVERSION) -YCH_SURF%CCH_EMIS='NONE' -YCH_SURF%CCH_BIOEMIS='NONE' -YCH_SURF%CCH_DMSEMIS='NONE' -YCH_SURF%CCHEM_SURF_FILE='EXSEG1.nam' -YCH_SURF%LCH_SURF_EMIS=.FALSE. -YCH_SURF%LCH_EMIS=.FALSE. -YCH_SURF%LCH_BIOEMIS=.FALSE. -YCH_SURF%LCH_DMSEMIS=.FALSE. -IF (LHOOK) CALL DR_HOOK("MODD_CH_SURF_N:CH_SURF_INIT",1,ZHOOK_HANDLE) -END SUBROUTINE CH_SURF_INIT - - -END MODULE MODD_CH_SURF_n diff --git a/src/ICCARE_BASE/modd_csts_salt.f90 b/src/ICCARE_BASE/modd_csts_salt.f90 deleted file mode 100644 index 7e8cbfe45..000000000 --- a/src/ICCARE_BASE/modd_csts_salt.f90 +++ /dev/null @@ -1,55 +0,0 @@ -!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence -!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!ORILAM_LIC for details. -!----------------------------------------------------------------- -!--------------- special set of characters for RCS information -!----------------------------------------------------------------- -! $Source$ $Revision$ -! MASDEV4_7 modd 2006/09/15 12:11:19 -!----------------------------------------------------------------- -! ###################### - MODULE MODD_CSTS_SALT -! ###################### -!! -!! PURPOSE -!! ------- -!! -!! Declaration of dust constants -!! -!! METHOD -!! ------ -!! -!! -!! REFERENCE -!! --------- -!! none -!! -!! -!! AUTHOR -!! ------ -!! P.Tulet (GMEI) -!! -!! -!! MODIFICATIONS -!! ------------- -!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes -!! -!!-------------------------------------------------------------------- -!! DECLARATIONS -!! ------------ -! -! -IMPLICIT NONE -! -!densité salt a introduire -! ++ PIERRE / MARINE SSA DUST - MODIF ++ -REAL, PARAMETER :: XDENSITY_DRYSALT = 2.160e3 ![kg/m3] density of sea salt (dry NaCl 2.160E3) -REAL, PARAMETER :: XDENSITY_SALT = 1.173e3 ![kg/m3] density of wet sea salt (Saltwater at RH80: 1.17e3) -! -- PIERRE / MARINE SSA DUST - MODIF -- -REAL, PARAMETER :: XMOLARWEIGHT_SALT = 58.e-3 ![kg/mol] molar weight dust -REAL, PARAMETER :: XM3TOUM3_SALT = 1.d18 ![um3/m3] conversion factor -REAL, PARAMETER :: XUM3TOM3_SALT = 1.d-18 ![m3/um3] conversion factor -REAL, PARAMETER :: XSIXTH_SALT = 1./6. ![-] one sixth -! -END MODULE MODD_CSTS_SALT diff --git a/src/ICCARE_BASE/modd_dms_surf_fieldsn.F90 b/src/ICCARE_BASE/modd_dms_surf_fieldsn.F90 deleted file mode 100644 index 524a1d0d0..000000000 --- a/src/ICCARE_BASE/modd_dms_surf_fieldsn.F90 +++ /dev/null @@ -1,74 +0,0 @@ -!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -! #################### - MODULE MODD_DMS_SURF_FIELDS_n -! #################### -! -!!**** *MODD_DMS_SURF_FIELDS* - declaration of megan physiographic data arrays -!! -!! PURPOSE -!! ------- -! The purpose of this declarative module is to specify the -! megan physiographic data arrays. -! -!! -!! AUTHOR -!! ------ -!! P. Tulet & M. Leriche *LACy & LA* -!! -!! MODIFICATIONS -!! ------------- -!! Original 06/2017 -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -IMPLICIT NONE - -TYPE DMS_SURF_FIELDS_t -! - INTEGER :: NDMS_NBR -! ! number of megan pgd fields chosen by user - CHARACTER(LEN=3) , DIMENSION(:), POINTER :: CDMS_AREA -! ! areas where megan pgd fields are defined -! ! 'ALL' : everywhere -! ! 'SEA' : where sea exists -! ! 'LAN' : where land exists -! ! 'WAT' : where inland water exists -! ! 'NAT' : where natural or agricultural areas exist -! ! 'TWN' : where town areas exist -! ! 'STR' : where streets are present -! ! 'BLD' : where buildings are present -! ! - CHARACTER(LEN=20), DIMENSION(:), POINTER :: CDMS_NAME -! ! name of the megan pgd fields (for information) - REAL, DIMENSION(:,:), POINTER :: XDMS_FIELDS -! ! megan pgd fields themselves -! -!------------------------------------------------------------------------------- -! -END TYPE DMS_SURF_FIELDS_t - - CONTAINS -! -! -SUBROUTINE DMS_SURF_FIELDS_INIT(YDMS_SURF_FIELDS) -TYPE(DMS_SURF_FIELDS_t), INTENT(INOUT) :: YDMS_SURF_FIELDS -REAL(KIND=JPRB) :: ZHOOK_HANDLE -IF (LHOOK) CALL DR_HOOK("MODD_DMS_SURF_FIELDS_N:DMS_SURF_FIELDS_INIT",0,ZHOOK_HANDLE) -NULLIFY(YDMS_SURF_FIELDS%CDMS_NAME) -NULLIFY(YDMS_SURF_FIELDS%CDMS_AREA) -NULLIFY(YDMS_SURF_FIELDS%XDMS_FIELDS) -YDMS_SURF_FIELDS%NDMS_NBR=0 -IF (LHOOK) CALL DR_HOOK("MODD_DMS_SURF_FIELDS_N:DMS_SURF_FIELDS_INIT",1,ZHOOK_HANDLE) -END SUBROUTINE DMS_SURF_FIELDS_INIT - - -END MODULE MODD_DMS_SURF_FIELDS_n diff --git a/src/ICCARE_BASE/modd_dmsn.F90 b/src/ICCARE_BASE/modd_dmsn.F90 deleted file mode 100644 index 2dbb65266..000000000 --- a/src/ICCARE_BASE/modd_dmsn.F90 +++ /dev/null @@ -1,55 +0,0 @@ -!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -! ##################### - MODULE MODD_DMS_n -! ###################### -! -!! -!! PURPOSE -!! ------- -! -! -! -!! -!!** IMPLICIT ARGUMENTS -!! ------------------ -!! None -!! -! -!! AUTHOR -!! ------ -!! P. Tulet *LAERO -!! -!! MODIFICATIONS -!! ------------- -!------------------------------------------------------------------------------ -! -!* 0. DECLARATIONS -! ------------ -! -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -IMPLICIT NONE -! -TYPE DMS_t -! - REAL, POINTER, DIMENSION(:) :: XDMS ! contenu en DMS marin (nmole.dm-3) -! -END TYPE DMS_t - - CONTAINS -! -SUBROUTINE DMS_INIT(YDMS) -TYPE(DMS_t), INTENT(INOUT) :: YDMS -REAL(KIND=JPRB) :: ZHOOK_HANDLE -IF (LHOOK) CALL DR_HOOK("MODD_DMS_n:DMS_INIT",0,ZHOOK_HANDLE) -NULLIFY(YDMS%XDMS) -IF (LHOOK) CALL DR_HOOK("MODD_DMS_n:DMS_INIT",1,ZHOOK_HANDLE) -END SUBROUTINE DMS_INIT - - -END MODULE MODD_DMS_n diff --git a/src/ICCARE_BASE/modd_dust.f90 b/src/ICCARE_BASE/modd_dust.f90 deleted file mode 100644 index 540de108e..000000000 --- a/src/ICCARE_BASE/modd_dust.f90 +++ /dev/null @@ -1,109 +0,0 @@ -!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence -!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!ORILAM_LIC for details. -!----------------------------------------------------------------- -!--------------- special set of characters for RCS information -!----------------------------------------------------------------- -! $Source$ $Revision$ -! MASDEV4_7 modd 2007/02/22 10:05:39 -!----------------------------------------------------------------- -!! ###################### - MODULE MODD_DUST -!! ###################### -!! -!! PURPOSE -!! ------- -!! -!! declaration of variables and types for the dust scheme -!! -!! METHOD -!! ------ -!! -!! -!! REFERENCE -!! --------- -!! none -!! -!! -!! AUTHOR -!! ------ -!! Pierre Tulet (CNRM) -!! -!! -!! MODIFICATIONS -!! ------------- -!! T. Hoarau 03/2019 add a switch for initialisation from MACC -!!-------------------------------------------------------------------- -!! DECLARATIONS -!! ------------ -USE MODD_PARAMETERS, ONLY: JPMODELMAX -! -IMPLICIT NONE -! -LOGICAL :: LDUST = .FALSE. ! switch to active pronostic dusts -LOGICAL :: LDSTCAMS = .FALSE. ! switch to active pronostic dusts from MACC -LOGICAL :: LDSTINIT = .FALSE. ! switch to initialize pronostic dusts -LOGICAL :: LDSTPRES = .FALSE. ! switch to know if pronostic dusts exist -LOGICAL,DIMENSION(JPMODELMAX) :: LDEPOS_DST = .FALSE. ! switch to DST wet deposition -INTEGER :: NMODE_DST= 3 ! number of dust modes (max 3; default = 3) -! -CHARACTER(LEN=6),DIMENSION(:),ALLOCATABLE :: CDUSTNAMES - -CHARACTER(LEN=6),DIMENSION(9), PARAMETER :: YPDUST_INI = & - (/'DSTM01','DSTM31','DSTM61' & - ,'DSTM02','DSTM32','DSTM62' & - ,'DSTM03','DSTM33','DSTM63' /) -! Set the order of the loops sorted by importance -!This means that if a user choses 1 mode it will have characteristics of mode 2 -!2 modes will be mode 2 & 3, whereas 3 modes will modes 1, 2 and 3 -INTEGER, DIMENSION(3),PARAMETER :: JPDUSTORDER = (/3, 2, 1/) -REAL :: XRADMIN = 0.001 ! minimum reasonable value for median radius -! -REAL, ALLOCATABLE :: XDSTMSS(:,:,:) ! [kg/m3] total mass concentration of dust -! -! aerosol lognormal parameterization -CHARACTER(LEN=4) :: CRGUNITD = 'NUMB' ! type of log-normal geometric mean radius -! !given in namelist (mass on number) -! -LOGICAL :: LRGFIX_DST = .FALSE. ! switch to fix RG (sedimentation) -LOGICAL :: LVARSIG = .FALSE. ! switch to active pronostic dispersion for all modes -LOGICAL :: LSEDIMDUST = .FALSE. ! switch to active aerosol sedimentation -REAL :: XSIGMIN = 1.20 ! minimum dispersion value for dust mode -REAL :: XSIGMAX = 3.60 ! maximum dispersion value for dust mode -REAL :: XCOEFRADMAX = 10. ! maximum increasement for Rg mode dust -REAL :: XCOEFRADMIN = 0.1 ! maximum decreasement for Rg mode dust -! -! Alf considers it is better to use initial values as Schultz et al 1998 -! whereas Pierre consider to keep as close as possible initialization -! values close to default emissions; so as you want !!! -!Initial dry mass median radius (um) from Schultz et al 1998 -!REAL, DIMENSION(3) :: XINIRADIUS= (/ 0.0055, 1.26, 21.65 /) -!Initial, standard deviation from Schultz et al 1998 -!REAL, DIMENSION(3) :: XINISIG = (/2.13, 2.00, 1.89 /) -!Initial dry mass median radius (um) from D'Almeida, 1987 emission fluxes -!REAL, DIMENSION(3) :: XINIRADIUS= 0.5*(/ 0.832 , 4.82 , 19.38 /) -!Initial, standard deviation from from D'Almeida, 1987 emission fluxes -!REAL, DIMENSION(3) :: XINISIG = (/2.10 , 1.90 , 1.60 /) -!Minimum allowed number concentration for any mode (#/m3) -!REAL, DIMENSION(3) :: XN0MIN = (/1.e4 , 1.e3 , 1.e-1 /) -!Initial dry mass median radius (um) from Alfaro et al 1998 -!REAL, DIMENSION(3) :: XINIRADIUS= 0.5*(/1.5, 6.7, 14.2/) -!Initial, standard deviation from Alfaro et al 1998 -!REAL, DIMENSION(3) :: XINISIG = (/1.70, 1.60, 1.50/) -!Minimum allowed number concentration for any mode (#/m3) -!REAL, DIMENSION(3) :: XN0MIN = (/1.e2 , 1.e1 , 1.e-2 /) -! -! NEW PARAMETERIZATION FROM AMMA, defalut -!Initial dry number median radius (um) -REAL, DIMENSION(3) :: XINIRADIUS= 0.5*(/0.078, 0.641, 5.00 /) -!Initial, standard deviation from Alfaro et al 1998 -REAL, DIMENSION(3) :: XINISIG = (/1.75, 1.76, 1.70/) -!Minimum allowed number concentration for any mode (#/m3) -REAL, DIMENSION(3) :: XN0MIN = (/1.e3 , 1.e1 , 1.e-2 /) -CHARACTER(LEN=9),DIMENSION(:),ALLOCATABLE :: CDEDSTNAMES -CHARACTER(LEN=9),DIMENSION(6), PARAMETER :: YPDEDST_INI = & - (/'DEDSTM31C','DEDSTM32C','DEDSTM33C' & - ,'DEDSTM31R','DEDSTM32R','DEDSTM33R' /) -! -END MODULE MODD_DUST diff --git a/src/ICCARE_BASE/modd_isban.F90 b/src/ICCARE_BASE/modd_isban.F90 deleted file mode 100644 index 3c996c9c9..000000000 --- a/src/ICCARE_BASE/modd_isban.F90 +++ /dev/null @@ -1,820 +0,0 @@ -!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -!################## -MODULE MODD_ISBA_n -!################## -! -!!**** *MODD_ISBA - declaration of packed surface parameters for ISBA scheme -!! -!! PURPOSE -!! ------- -! -!! -!!** IMPLICIT ARGUMENTS -!! ------------------ -!! None -!! -!! REFERENCE -!! --------- -!! -!! AUTHOR -!! ------ -!! A. Boone *Meteo France* -!! -!! MODIFICATIONS -!! ------------- -!! Original 20/09/02 -!! A.L. Gibelin 04/2009 : BIOMASS and RESP_BIOMASS arrays -!! A.L. Gibelin 04/2009 : TAU_WOOD for NCB option -!! A.L. Gibelin 05/2009 : Add carbon spinup -!! A.L. Gibelin 06/2009 : Soil carbon variables for CNT option -!! A.L. Gibelin 07/2009 : Suppress RDK and transform GPP as a diagnostic -!! A.L. Gibelin 07/2009 : Suppress PPST and PPSTF as outputs -!! P. Samuelsson 02/2012 : MEB -!! B. Decharme 10/2016 bug surface/groundwater coupling -!! -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_TYPE_SNOW -USE MODD_TYPE_DATE_SURF -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -IMPLICIT NONE -! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! -TYPE ISBA_S_t -! -! General surface parameters: -! -REAL, POINTER, DIMENSION(:) :: XZS ! relief (m) -REAL, POINTER, DIMENSION(:,:) :: XCOVER ! fraction of each ecosystem (-) -LOGICAL, POINTER, DIMENSION(:):: LCOVER ! GCOVER(i)=T --> ith cover field is not 0. -! -! Topmodel statistics -! -REAL, POINTER, DIMENSION(:) :: XTI_MIN,XTI_MAX,XTI_MEAN,XTI_STD,XTI_SKEW -! -REAL, POINTER, DIMENSION(:,:) :: XSOC ! soil organic carbon content (kg/m2) -REAL, POINTER, DIMENSION(:) :: XPH ! soil pH -REAL, POINTER, DIMENSION(:) :: XFERT ! soil fertilisation rate (kgN/ha/h) -! -! -REAL, POINTER, DIMENSION(:) :: XABC ! abscissa needed for integration -! ! of net assimilation and stomatal -! ! conductance over canopy depth (-) -REAL, POINTER, DIMENSION(:) :: XPOI ! Gaussian weights for integration -! ! of net assimilation and stomatal -! ! conductance over canopy depth (-) -! -TYPE (DATE_TIME) :: TTIME -! -REAL, POINTER, DIMENSION(:,:) :: XTAB_FSAT !Satured fraction array -REAL, POINTER, DIMENSION(:,:) :: XTAB_WTOP !Active TOPMODEL-layer array -REAL, POINTER, DIMENSION(:,:) :: XTAB_QTOP !Subsurface flow TOPMODEL array -! -REAL, POINTER, DIMENSION(:) :: XF_PARAM -REAL, POINTER, DIMENSION(:) :: XC_DEPTH_RATIO -! -! - Coupling with river routing model -! -REAL, POINTER, DIMENSION(:) :: XCPL_DRAIN ! Surface runoff -REAL, POINTER, DIMENSION(:) :: XCPL_RUNOFF ! Deep drainage or gourdwater recharge -REAL, POINTER, DIMENSION(:) :: XCPL_ICEFLUX ! Calving flux -REAL, POINTER, DIMENSION(:) :: XCPL_EFLOOD ! floodplains evaporation -REAL, POINTER, DIMENSION(:) :: XCPL_PFLOOD ! floodplains precipitation interception -REAL, POINTER, DIMENSION(:) :: XCPL_IFLOOD ! floodplains infiltration -! -! - Random perturbations -! -REAL, POINTER, DIMENSION(:) :: XPERTVEG -REAL, POINTER, DIMENSION(:) :: XPERTLAI -REAL, POINTER, DIMENSION(:) :: XPERTCV -REAL, POINTER, DIMENSION(:) :: XPERTALB -REAL, POINTER, DIMENSION(:) :: XPERTZ0 -! -REAL, POINTER, DIMENSION(:) :: XTSRAD_NAT ! patch averaged radiative temperature (K) -! -REAL, POINTER, DIMENSION(:) :: XEMIS_NAT ! patch averaged emissivity (-) -! -! - Assimilation: ENKF -! -REAL, POINTER, DIMENSION(:,:) :: XFRACSOC ! Fraction of organic carbon in each soil layer -! -REAL, POINTER, DIMENSION(:,:) :: XVEGTYPE -! -REAL, POINTER, DIMENSION(:,:) :: XPATCH ! fraction of each tile/patch (-) -! -! Mask and number of grid elements containing patches/tiles: -! -REAL, POINTER, DIMENSION(:,:,:) :: XVEGTYPE_PATCH ! fraction of each vegetation type for -! -REAL, POINTER, DIMENSION(:,:) :: XINNOV -REAL, POINTER, DIMENSION(:,:) :: XRESID -! -REAL, POINTER, DIMENSION(:,:) :: XWORK_WR -! -REAL, POINTER, DIMENSION(:,:,:) :: XWSN_WR -REAL, POINTER, DIMENSION(:,:,:) :: XRHO_WR -REAL, POINTER, DIMENSION(:,:,:) :: XHEA_WR -REAL, POINTER, DIMENSION(:,:,:) :: XAGE_WR -REAL, POINTER, DIMENSION(:,:,:) :: XSG1_WR -REAL, POINTER, DIMENSION(:,:,:) :: XSG2_WR -REAL, POINTER, DIMENSION(:,:,:) :: XHIS_WR -REAL, POINTER, DIMENSION(:,:,:) :: XT_WR -REAL, POINTER, DIMENSION(:,:) :: XALB_WR -! -TYPE(DATE_TIME), POINTER, DIMENSION(:,:) :: TDATE_WR -! -END TYPE ISBA_S_t -! -! -TYPE ISBA_K_t -! -REAL, POINTER, DIMENSION(:,:) :: XSAND ! sand fraction (-) -REAL, POINTER, DIMENSION(:,:) :: XCLAY ! clay fraction (-) -! -REAL, POINTER, DIMENSION(:) :: XPERM ! permafrost distribution (-) -! -REAL, POINTER, DIMENSION(:) :: XRUNOFFB ! sub-grid dt92 surface runoff slope parameter (-) -REAL, POINTER, DIMENSION(:) :: XWDRAIN ! continuous drainage parameter (-) -! -! -REAL, POINTER, DIMENSION(:) :: XTDEEP ! prescribed deep soil temperature -! ! (optional) -REAL, POINTER, DIMENSION(:) :: XGAMMAT ! 'Force-Restore' timescale when using a -! ! prescribed lower boundary temperature (1/days) -! -REAL, POINTER, DIMENSION(:,:) :: XMPOTSAT ! matric potential at saturation (m) -REAL, POINTER, DIMENSION(:,:) :: XBCOEF ! soil water CH78 b-parameter (-) -REAL, POINTER, DIMENSION(:,:) :: XWWILT ! wilting point volumetric water content -! ! profile (m3/m3) -REAL, POINTER, DIMENSION(:,:) :: XWFC ! field capacity volumetric water content -! ! profile (m3/m3) -REAL, POINTER, DIMENSION(:,:) :: XWSAT ! porosity profile (m3/m3) -! -REAL, POINTER, DIMENSION(:) :: XCGSAT ! soil thermal inertia coefficient at -! ! saturation -REAL, POINTER, DIMENSION(:) :: XC4B ! 'Force-Restore' sub-surface vertical -! ! diffusion coefficient (slope parameter) (-) -REAL, POINTER, DIMENSION(:) :: XACOEF ! 'Force-Restore' surface vertical -! ! diffusion coefficient (-) -REAL, POINTER, DIMENSION(:) :: XPCOEF ! 'Force-Restore' surface vertical -! ! diffusion coefficient (-) -REAL, POINTER, DIMENSION(:,:) :: XHCAPSOIL ! soil heat capacity (J/K/m3) -REAL, POINTER, DIMENSION(:,:) :: XCONDDRY ! soil dry thermal conductivity (W/m/K) -REAL, POINTER, DIMENSION(:,:) :: XCONDSLD ! soil solids thermal conductivity (W/m/K) -! -! - Water table depth coupling -! -REAL, POINTER, DIMENSION(:) :: XFWTD ! grid-cell fraction of water table rise -REAL, POINTER, DIMENSION(:) :: XWTD ! water table depth (negative below soil surface) (m) -! -! * Physiographic radiative fields -! -REAL, POINTER, DIMENSION(:) :: XALBNIR_DRY ! dry soil near-infra-red albedo (-) -REAL, POINTER, DIMENSION(:) :: XALBVIS_DRY ! dry soil visible albedo (-) -REAL, POINTER, DIMENSION(:) :: XALBUV_DRY ! dry soil UV albedo (-) -REAL, POINTER, DIMENSION(:) :: XALBNIR_WET ! wet soil near-infra-red albedo (-) -REAL, POINTER, DIMENSION(:) :: XALBVIS_WET ! wet soil visible albedo (-) -REAL, POINTER, DIMENSION(:) :: XALBUV_WET ! wet soil UV albedo (-) -! -! * SGH initializations -! -REAL, POINTER, DIMENSION(:,:) :: XWD0 ! water content equivalent to TOPMODEL maximum deficit -REAL, POINTER, DIMENSION(:,:) :: XKANISO ! Anisotropy coeficient for hydraulic conductivity -! -REAL, POINTER, DIMENSION(:) :: XMUF ! fraction of the grid cell reached by the rainfall -REAL, POINTER, DIMENSION(:) :: XFSAT ! Topmodel or dt92 saturated fracti -! -REAL, POINTER, DIMENSION(:) :: XFFLOOD ! Grid-cell flood fraction -REAL, POINTER, DIMENSION(:) :: XPIFLOOD ! flood potential infiltration (kg/m2/s) -! -! - Flood scheme -! -REAL, POINTER, DIMENSION(:) :: XFF ! Total Flood fraction -REAL, POINTER, DIMENSION(:) :: XFFG ! Flood fraction over ground -REAL, POINTER, DIMENSION(:) :: XFFV ! Flood fraction over vegetation -REAL, POINTER, DIMENSION(:) :: XFFROZEN ! Fraction of frozen floodplains -REAL, POINTER, DIMENSION(:) :: XALBF ! Flood albedo -REAL, POINTER, DIMENSION(:) :: XEMISF ! Flood emissivity -! -! - Snow and flood fractions and total albedo at time t: (-) -! -REAL, POINTER, DIMENSION(:,:) :: XDIR_ALB_WITH_SNOW ! total direct albedo by bands -REAL, POINTER, DIMENSION(:,:) :: XSCA_ALB_WITH_SNOW ! total diffuse albedo by bands -! -REAL, POINTER, DIMENSION(:,:) :: XVEGTYPE -! -END TYPE ISBA_K_t -! -! -TYPE ISBA_P_t -! -INTEGER :: NSIZE_P ! number of sub-patchs/tiles (-) -! -REAL, POINTER, DIMENSION(:) :: XPATCH ! fraction of each tile/patch (-) -! -! Mask and number of grid elements containing patches/tiles: -! -REAL, POINTER, DIMENSION(:,:) :: XVEGTYPE_PATCH ! fraction of each vegetation type for -! -INTEGER, POINTER, DIMENSION(:) :: NR_P ! patch/tile mask -! -REAL, POINTER, DIMENSION(:) :: XPATCH_OLD ! fraction of each tile/patchfor land use (-) -! -! -REAL, POINTER, DIMENSION(:) :: XANMAX ! maximum photosynthesis rate ( -REAL, POINTER, DIMENSION(:) :: XFZERO ! ideal value of F, no photo- -! ! respiration or saturation deficit -REAL, POINTER, DIMENSION(:) :: XEPSO ! maximum initial quantum use -! ! efficiency (mg J-1 PAR) -REAL, POINTER, DIMENSION(:) :: XGAMM ! CO2 conpensation concentration (ppm) -REAL, POINTER, DIMENSION(:) :: XQDGAMM ! Log of Q10 function for CO2 conpensation -! ! concentration (-) -REAL, POINTER, DIMENSION(:) :: XQDGMES ! Log of Q10 function for mesophyll conductance (-) -REAL, POINTER, DIMENSION(:) :: XT1GMES ! reference temperature for computing -! ! compensation concentration function for -! ! mesophyll conductance: minimum -! ! temperature (K) -REAL, POINTER, DIMENSION(:) :: XT2GMES ! reference temperature for computing -! ! compensation concentration function for -! ! mesophyll conductance: maximum -! ! temperature (K) -REAL, POINTER, DIMENSION(:) :: XAMAX ! leaf photosynthetic capacity (mg m-2 s-1) -REAL, POINTER, DIMENSION(:) :: XQDAMAX ! Log of Q10 function for leaf photosynthetic -! ! capacity (-) -REAL, POINTER, DIMENSION(:) :: XT1AMAX ! reference temperature for computing -! ! compensation concentration function for -! ! leaf photosynthetic capacity: minimum -! ! temperature (K) -REAL, POINTER, DIMENSION(:) :: XT2AMAX ! reference temperature for computing -! ! compensation concentration function for -! ! leaf photosynthetic capacity: maximum -! ! temperature (K) -REAL, POINTER, DIMENSION(:) :: XAH ! coefficients for herbaceous water stress -! ! response (offensive or defensive) (log(mm/s)) -REAL, POINTER, DIMENSION(:) :: XBH ! coefficients for herbaceous water stress -! ! response (offensive or defensive) -REAL, POINTER, DIMENSION(:) :: XTAU_WOOD ! residence time in woody biomass (s) -REAL, POINTER, DIMENSION(:,:) :: XINCREASE ! biomass increase (kg/m2/day) -REAL, POINTER, DIMENSION(:,:) :: XTURNOVER ! turnover rates from biomass to litter (gC/m2/s) -! -! *Soil hydraulic characteristics -! -REAL, POINTER, DIMENSION(:,:) :: XCONDSAT ! hydraulic conductivity at saturation (m/s) -! -REAL, POINTER, DIMENSION(:) :: XTAUICE ! soil freezing characteristic timescale (s) -! -REAL, POINTER, DIMENSION(:) :: XC1SAT ! 'Force-Restore' C1 coefficient at -! ! saturation (-) -REAL, POINTER, DIMENSION(:) :: XC2REF ! 'Force-Restore' reference value of C2 (-) -REAL, POINTER, DIMENSION(:,:) :: XC3 ! 'Force-Restore' C3 drainage coefficient (m) -REAL, POINTER, DIMENSION(:) :: XC4REF ! 'Force-Restore' sub-surface vertical -! ! for lateral drainage ('DIF' option) -! -REAL, POINTER, DIMENSION(:) :: XBSLAI_NITRO ! biomass/LAI ratio from nitrogen -! ! decline theory (kg/m2) -! * Soil thermal characteristics -! -REAL, POINTER, DIMENSION(:) :: XCPS -REAL, POINTER, DIMENSION(:) :: XLVTT -REAL, POINTER, DIMENSION(:) :: XLSTT -! -! * Initialize hydrology -! - REAL, POINTER, DIMENSION(:) :: XRUNOFFD ! depth over which sub-grid runoff is -! ! computed: in Force-Restore this is the -! ! total soil column ('2-L'), or root zone -! ! ('3-L'). For the 'DIF' option, it can -! ! be any depth within soil column (m) -! -REAL, POINTER, DIMENSION(:,:) :: XDZG ! soil layers thicknesses (DIF option) -REAL, POINTER, DIMENSION(:,:) :: XDZDIF ! distance between consecuative layer mid-points (DIF option) -REAL, POINTER, DIMENSION(:,:) :: XSOILWGHT ! VEG-DIF: weights for vertical -! ! integration of soil water and properties -! -REAL, POINTER, DIMENSION(:) :: XKSAT_ICE ! hydraulic conductivity at saturation -! over frozen area (m s-1) -! -REAL, POINTER, DIMENSION(:,:) :: XTOPQS ! Topmodel subsurface flow by layer (m/s) -! -REAL, POINTER, DIMENSION(:,:) :: XDG ! soil layer depth (m) -! ! NOTE: in Force-Restore mode, the -! ! uppermost layer depth is superficial -! ! and is only explicitly used for soil -! ! water phase changes (m) -! -REAL, POINTER, DIMENSION(:,:) :: XDG_OLD ! For land use -REAL, POINTER, DIMENSION(:) :: XDG2 -INTEGER, POINTER, DIMENSION(:) :: NWG_LAYER ! Number of soil moisture layers for DIF -REAL, POINTER, DIMENSION(:) :: XDROOT ! effective root depth for DIF (m) -REAL, POINTER, DIMENSION(:,:) :: XROOTFRAC ! root fraction profile ('DIF' option) -! -REAL, POINTER, DIMENSION(:) :: XD_ICE ! depth of the soil column for the calculation -! of the frozen soil fraction (m) -! -REAL, POINTER, DIMENSION(:) :: XH_TREE ! height of trees (m) -! -REAL, POINTER, DIMENSION(:) :: XZ0_O_Z0H ! ratio of surface roughness lengths -! ! (momentum to heat) (-) -! -REAL, POINTER, DIMENSION(:) :: XRE25 ! Ecosystem respiration parameter (kg/kg.m.s-1) -! -REAL, POINTER, DIMENSION(:) :: XDMAX ! maximum air saturation deficit -! ! tolerate by vegetation -! (kg/kg) -! -REAL, POINTER, DIMENSION(:,:) :: XRED_NOISE -REAL, POINTER, DIMENSION(:,:) :: XINCR -REAL, POINTER, DIMENSION(:,:,:) :: XHO -! -END TYPE ISBA_P_t -! -TYPE ISBA_PE_t -! -! Prognostic variables: -! -! - Soil and vegetation heat and water: -! -REAL, POINTER, DIMENSION(:,:) :: XWG ! soil volumetric water content profile (m3/m3) -REAL, POINTER, DIMENSION(:,:) :: XWGI ! soil liquid water equivalent volumetric -! ! ice content profile (m3/m3) -REAL, POINTER, DIMENSION(:) :: XWR ! liquid water retained on the -! ! foliage of the vegetation -! ! canopy (kg/m2) -REAL, POINTER, DIMENSION(:,:) :: XTG ! surface and sub-surface soil -! ! temperature profile (K) -! -! - Snow Cover: -! -TYPE(SURF_SNOW) :: TSNOW ! snow state: -! ! scheme type/option (-) -! ! number of layers (-) -! ! snow (& liq. water) content (kg/m2) -! ! heat content (J/m2) -! ! temperature (K) -! ! density (kg m-3) -! -REAL, POINTER, DIMENSION(:) :: XICE_STO ! Glacier ice storage reservoir -! -! - For multi-energy balance: -! -REAL, POINTER, DIMENSION(:) :: XWRL ! liquid water retained on litter (kg/m2) -REAL, POINTER, DIMENSION(:) :: XWRLI ! ice retained on litter (kg/m2) -REAL, POINTER, DIMENSION(:) :: XWRVN ! snow retained on the foliage -! ! of the canopy vegetation (kg/m2) -REAL, POINTER, DIMENSION(:) :: XTV ! canopy vegetation temperature (K) -REAL, POINTER, DIMENSION(:) :: XTL ! litter temperature (K) -REAL, POINTER, DIMENSION(:) :: XTC ! canopy air temperature (K) -REAL, POINTER, DIMENSION(:) :: XQC ! canopy air specific humidity (kg/kg) -! -! * Half prognostic fields -! -REAL, POINTER, DIMENSION(:) :: XRESA ! aerodynamic resistance (s/m) -! -! - Vegetation: Ags Prognostic (YPHOTO = 'AST', 'NIT', 'NCB') -! -REAL, POINTER, DIMENSION(:) :: XAN ! net CO2 assimilation (mg/m2/s) -REAL, POINTER, DIMENSION(:) :: XANDAY ! daily net CO2 assimilation (mg/m2) -REAL, POINTER, DIMENSION(:) :: XANFM ! maximum leaf assimilation (mg/m2/s) -REAL, POINTER, DIMENSION(:) :: XLE ! evapotranspiration (W/m2) -! -REAL, POINTER, DIMENSION(:) :: XFAPARC ! Fapar of vegetation (cumul) -REAL, POINTER, DIMENSION(:) :: XFAPIRC ! Fapir of vegetation (cumul) -REAL, POINTER, DIMENSION(:) :: XLAI_EFFC ! Effective LAI (cumul) -REAL, POINTER, DIMENSION(:) :: XMUS ! cos zenithal angle (cumul) -! -REAL, POINTER, DIMENSION(:,:) :: XRESP_BIOMASS ! daily cumulated respiration of -! ! biomass (kg/m2/s) -REAL, POINTER, DIMENSION(:,:) :: XBIOMASS ! biomass of previous day (kg/m2) -! -! - Soil carbon (ISBA-CC, YRESPSL = 'CNT') -! -REAL, POINTER, DIMENSION(:,:,:) :: XLITTER ! litter pools (gC/m2) -REAL, POINTER, DIMENSION(:,:) :: XSOILCARB ! soil carbon pools (gC/m2) -REAL, POINTER, DIMENSION(:,:) :: XLIGNIN_STRUC ! ratio Lignin/Carbon in structural -! litter (gC/m2) -! -REAL, POINTER, DIMENSION(:) :: XPSNG ! Snow fraction over ground -REAL, POINTER, DIMENSION(:) :: XPSNV ! Snow fraction over vegetation -REAL, POINTER, DIMENSION(:) :: XPSNV_A ! Snow fraction over vegetation -REAL, POINTER, DIMENSION(:) :: XPSN -! -REAL, POINTER, DIMENSION(:) :: XSNOWFREE_ALB ! snow free albedo (-) -REAL, POINTER, DIMENSION(:) :: XSNOWFREE_ALB_VEG ! snow free albedo for vegetation (-) -REAL, POINTER, DIMENSION(:) :: XSNOWFREE_ALB_SOIL! snow free albedo for soil -! -REAL, POINTER, DIMENSION(:) :: XVEG ! vegetation cover fraction (-) -! -REAL, POINTER, DIMENSION(:) :: XLAI ! Leaf Area Index (m2/m2) -REAL, POINTER, DIMENSION(:) :: XLAIp ! Leaf Area Index previous (m2/m2) -! -REAL, POINTER, DIMENSION(:) :: XEMIS ! surface emissivity (-) -REAL, POINTER, DIMENSION(:) :: XZ0 ! surface roughness length (m) -! -REAL, POINTER, DIMENSION(:) :: XRSMIN ! minimum stomatal resistance (s/m) -REAL, POINTER, DIMENSION(:) :: XGAMMA ! coefficient for the calculation -! ! of the surface stomatal -! ! resistance -REAL, POINTER, DIMENSION(:) :: XWRMAX_CF ! coefficient for maximum water -! ! interception -! ! storage capacity on the vegetation (-) -REAL, POINTER, DIMENSION(:) :: XRGL ! maximum solar radiation -! ! usable in photosynthesis -REAL, POINTER, DIMENSION(:) :: XCV ! vegetation thermal inertia coefficient (K m2/J) -REAL, POINTER, DIMENSION(:) :: XLAIMIN ! minimum LAI (Leaf Area Index) (m2/m2) -REAL, POINTER, DIMENSION(:) :: XSEFOLD ! e-folding time for senescence (s) -REAL, POINTER, DIMENSION(:) :: XGMES ! mesophyll conductance (m s-1) -REAL, POINTER, DIMENSION(:) :: XGC ! cuticular conductance (m s-1) -REAL, POINTER, DIMENSION(:) :: XF2I ! critical normilized soil water -! ! content for stress parameterisation -REAL, POINTER, DIMENSION(:) :: XBSLAI ! ratio d(biomass)/d(lai) (kg/m2) -! -REAL, POINTER, DIMENSION(:) :: XCE_NITRO ! leaf aera ratio sensitivity to -! ! nitrogen concentration (m2/kg) -REAL, POINTER, DIMENSION(:) :: XCF_NITRO ! lethal minimum value of leaf area -! ! ratio (m2/kg) -REAL, POINTER, DIMENSION(:) :: XCNA_NITRO ! nitrogen concentration of active -! ! biomass -LOGICAL, POINTER, DIMENSION(:) :: LSTRESS ! vegetation response type to water -! ! stress (true:defensive false:offensive) (-) -! -REAL, POINTER, DIMENSION(:) :: XALBNIR_VEG ! vegetation near-infra-red albedo (-) -REAL, POINTER, DIMENSION(:) :: XALBVIS_VEG ! vegetation visible albedo (-) -REAL, POINTER, DIMENSION(:) :: XALBUV_VEG ! vegetation UV albedo (-) -! -REAL, POINTER, DIMENSION(:) :: XALBNIR ! near-infra-red albedo (-) -REAL, POINTER, DIMENSION(:) :: XALBVIS ! visible albedo (-) -REAL, POINTER, DIMENSION(:) :: XALBUV ! UV albedo -! -REAL, POINTER, DIMENSION(:) :: XGNDLITTER ! ground litter fraction (-) -REAL, POINTER, DIMENSION(:) :: XH_VEG ! height of vegetation (m) -REAL, POINTER, DIMENSION(:) :: XZ0LITTER ! ground litter roughness length (m) -! -REAL, POINTER, DIMENSION(:) :: XALBNIR_SOIL ! soil near-infra-red albedo (-) -REAL, POINTER, DIMENSION(:) :: XALBVIS_SOIL ! soil visible albedo (-) -REAL, POINTER, DIMENSION(:) :: XALBUV_SOIL ! soil UV albedo -! -TYPE (DATE_TIME), POINTER, DIMENSION(:) :: TSEED ! date of seeding -TYPE (DATE_TIME), POINTER, DIMENSION(:) :: TREAP ! date of reaping -REAL, POINTER, DIMENSION(:) :: XWATSUP ! water supply during irrigation process (mm) -REAL, POINTER, DIMENSION(:) :: XIRRIG ! flag for irrigation (irrigation if >0.) -! -! -END TYPE ISBA_PE_t -! -TYPE ISBA_NK_t -! -TYPE(ISBA_K_t), DIMENSION(:), POINTER :: AL=>NULL() -! -END TYPE ISBA_NK_t -! -TYPE ISBA_NP_t -! -TYPE(ISBA_P_t), DIMENSION(:), POINTER :: AL=>NULL() -! -END TYPE ISBA_NP_t -! -TYPE ISBA_NPE_t -! -TYPE(ISBA_PE_t), DIMENSION(:), POINTER :: AL=>NULL() -! -END TYPE ISBA_NPE_t -! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! -CONTAINS -! -SUBROUTINE ISBA_S_INIT(YISBA_S) -TYPE(ISBA_S_t), INTENT(INOUT) :: YISBA_S -REAL(KIND=JPRB) :: ZHOOK_HANDLE -IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_S_INIT",0,ZHOOK_HANDLE) -! -NULLIFY(YISBA_S%XZS) -NULLIFY(YISBA_S%XCOVER) -NULLIFY(YISBA_S%LCOVER) -! -NULLIFY(YISBA_S%XTI_MIN) -NULLIFY(YISBA_S%XTI_MAX) -NULLIFY(YISBA_S%XTI_MEAN) -NULLIFY(YISBA_S%XTI_STD) -NULLIFY(YISBA_S%XTI_SKEW) -! -NULLIFY(YISBA_S%XSOC) -NULLIFY(YISBA_S%XPH) -NULLIFY(YISBA_S%XFERT) -! -NULLIFY(YISBA_S%XABC) -NULLIFY(YISBA_S%XPOI) -! -NULLIFY(YISBA_S%XFRACSOC) -NULLIFY(YISBA_S%XTAB_FSAT) -NULLIFY(YISBA_S%XTAB_WTOP) -NULLIFY(YISBA_S%XTAB_QTOP) -NULLIFY(YISBA_S%XF_PARAM) -NULLIFY(YISBA_S%XC_DEPTH_RATIO) -NULLIFY(YISBA_S%XCPL_DRAIN) -NULLIFY(YISBA_S%XCPL_RUNOFF) -NULLIFY(YISBA_S%XCPL_ICEFLUX) -NULLIFY(YISBA_S%XCPL_EFLOOD) -NULLIFY(YISBA_S%XCPL_PFLOOD) -NULLIFY(YISBA_S%XCPL_IFLOOD) -NULLIFY(YISBA_S%XPERTVEG) -NULLIFY(YISBA_S%XPERTLAI) -NULLIFY(YISBA_S%XPERTCV) -NULLIFY(YISBA_S%XPERTALB) -NULLIFY(YISBA_S%XPERTZ0) -NULLIFY(YISBA_S%XEMIS_NAT) -! -NULLIFY(YISBA_S%XTSRAD_NAT) -! -NULLIFY(YISBA_S%XINNOV) -NULLIFY(YISBA_S%XRESID) -! -NULLIFY(YISBA_S%XWORK_WR) -! -NULLIFY(YISBA_S%XWSN_WR) -NULLIFY(YISBA_S%XRHO_WR) -NULLIFY(YISBA_S%XALB_WR) -NULLIFY(YISBA_S%XHEA_WR) -NULLIFY(YISBA_S%XAGE_WR) -NULLIFY(YISBA_S%XSG1_WR) -NULLIFY(YISBA_S%XSG2_WR) -NULLIFY(YISBA_S%XHIS_WR) -! -NULLIFY(YISBA_S%TDATE_WR) -! -IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_S_INIT",1,ZHOOK_HANDLE) -END SUBROUTINE ISBA_S_INIT -! -SUBROUTINE ISBA_K_INIT(YISBA_K) -TYPE(ISBA_K_t), INTENT(INOUT) :: YISBA_K -REAL(KIND=JPRB) :: ZHOOK_HANDLE -IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_K_INIT",0,ZHOOK_HANDLE) -! -NULLIFY(YISBA_K%XSAND) -NULLIFY(YISBA_K%XCLAY) -NULLIFY(YISBA_K%XPERM) -NULLIFY(YISBA_K%XRUNOFFB) -NULLIFY(YISBA_K%XWDRAIN) -! -NULLIFY(YISBA_K%XTDEEP) -NULLIFY(YISBA_K%XGAMMAT) -NULLIFY(YISBA_K%XMPOTSAT) -NULLIFY(YISBA_K%XBCOEF) -NULLIFY(YISBA_K%XWWILT) -NULLIFY(YISBA_K%XWFC) -NULLIFY(YISBA_K%XWSAT) -NULLIFY(YISBA_K%XCGSAT) -NULLIFY(YISBA_K%XC4B) -NULLIFY(YISBA_K%XACOEF) -NULLIFY(YISBA_K%XPCOEF) -NULLIFY(YISBA_K%XHCAPSOIL) -NULLIFY(YISBA_K%XCONDDRY) -NULLIFY(YISBA_K%XCONDSLD) -NULLIFY(YISBA_K%XFWTD) -NULLIFY(YISBA_K%XWTD) -NULLIFY(YISBA_K%XALBNIR_DRY) -NULLIFY(YISBA_K%XALBVIS_DRY) -NULLIFY(YISBA_K%XALBUV_DRY) -NULLIFY(YISBA_K%XALBNIR_WET) -NULLIFY(YISBA_K%XALBVIS_WET) -NULLIFY(YISBA_K%XALBUV_WET) -NULLIFY(YISBA_K%XWD0) -NULLIFY(YISBA_K%XKANISO) -NULLIFY(YISBA_K%XMUF) -NULLIFY(YISBA_K%XFSAT) -NULLIFY(YISBA_K%XFFLOOD) -NULLIFY(YISBA_K%XPIFLOOD) -NULLIFY(YISBA_K%XFF) -NULLIFY(YISBA_K%XFFG) -NULLIFY(YISBA_K%XFFV) -NULLIFY(YISBA_K%XFFROZEN) -NULLIFY(YISBA_K%XALBF) -NULLIFY(YISBA_K%XEMISF) -NULLIFY(YISBA_K%XDIR_ALB_WITH_SNOW) -NULLIFY(YISBA_K%XSCA_ALB_WITH_SNOW) -! -NULLIFY(YISBA_K%XVEGTYPE) -! -IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_K_INIT",1,ZHOOK_HANDLE) -END SUBROUTINE ISBA_K_INIT -! -SUBROUTINE ISBA_P_INIT(YISBA_P) -TYPE(ISBA_P_t), INTENT(INOUT) :: YISBA_P -REAL(KIND=JPRB) :: ZHOOK_HANDLE -IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_P_INIT",0,ZHOOK_HANDLE) -! -YISBA_P%NSIZE_P = 0 -NULLIFY(YISBA_P%XPATCH) -NULLIFY(YISBA_P%XVEGTYPE_PATCH) -NULLIFY(YISBA_P%NR_P) -NULLIFY(YISBA_P%XPATCH_OLD) -NULLIFY(YISBA_P%XANMAX) -NULLIFY(YISBA_P%XFZERO) -NULLIFY(YISBA_P%XEPSO) -NULLIFY(YISBA_P%XGAMM) -NULLIFY(YISBA_P%XQDGAMM) -NULLIFY(YISBA_P%XQDGMES) -NULLIFY(YISBA_P%XT1GMES) -NULLIFY(YISBA_P%XT2GMES) -NULLIFY(YISBA_P%XAMAX) -NULLIFY(YISBA_P%XQDAMAX) -NULLIFY(YISBA_P%XT1AMAX) -NULLIFY(YISBA_P%XT2AMAX) -NULLIFY(YISBA_P%XAH) -NULLIFY(YISBA_P%XBH) -NULLIFY(YISBA_P%XTAU_WOOD) -NULLIFY(YISBA_P%XINCREASE) -NULLIFY(YISBA_P%XTURNOVER) -NULLIFY(YISBA_P%XCONDSAT) -NULLIFY(YISBA_P%XTAUICE) -NULLIFY(YISBA_P%XC1SAT) -NULLIFY(YISBA_P%XC2REF) -NULLIFY(YISBA_P%XC3) -NULLIFY(YISBA_P%XC4REF) -NULLIFY(YISBA_P%XCPS) -NULLIFY(YISBA_P%XLVTT) -NULLIFY(YISBA_P%XLSTT) -NULLIFY(YISBA_P%XRUNOFFD) -NULLIFY(YISBA_P%XDZG) -NULLIFY(YISBA_P%XDZDIF) -NULLIFY(YISBA_P%XSOILWGHT) -NULLIFY(YISBA_P%XKSAT_ICE) -NULLIFY(YISBA_P%XBSLAI_NITRO) -NULLIFY(YISBA_P%XTOPQS) -! -NULLIFY(YISBA_P%XDG) -NULLIFY(YISBA_P%XDG_OLD) -NULLIFY(YISBA_P%NWG_LAYER) -NULLIFY(YISBA_P%XDROOT) -NULLIFY(YISBA_P%XDG2) -NULLIFY(YISBA_P%XROOTFRAC) -NULLIFY(YISBA_P%XD_ICE) -NULLIFY(YISBA_P%XH_TREE) -NULLIFY(YISBA_P%XZ0_O_Z0H) -NULLIFY(YISBA_P%XRE25) -NULLIFY(YISBA_P%XDMAX) -! -NULLIFY(YISBA_P%XRED_NOISE) -NULLIFY(YISBA_P%XINCR) -NULLIFY(YISBA_P%XHO) -! -IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_P_INIT",1,ZHOOK_HANDLE) -END SUBROUTINE ISBA_P_INIT -! -SUBROUTINE ISBA_PE_INIT(YISBA_PE) -TYPE(ISBA_PE_t), INTENT(INOUT) :: YISBA_PE -REAL(KIND=JPRB) :: ZHOOK_HANDLE -IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_PE_INIT",0,ZHOOK_HANDLE) -! -NULLIFY(YISBA_PE%XLAI) -NULLIFY(YISBA_PE%XLAIp) -NULLIFY(YISBA_PE%XVEG) -NULLIFY(YISBA_PE%XEMIS) -NULLIFY(YISBA_PE%XZ0) -NULLIFY(YISBA_PE%XRSMIN) -NULLIFY(YISBA_PE%XGAMMA) -NULLIFY(YISBA_PE%XWRMAX_CF) -NULLIFY(YISBA_PE%XRGL) -NULLIFY(YISBA_PE%XCV) -NULLIFY(YISBA_PE%XLAIMIN) -NULLIFY(YISBA_PE%XSEFOLD) -NULLIFY(YISBA_PE%XGMES) -NULLIFY(YISBA_PE%XGC) -NULLIFY(YISBA_PE%XF2I) -NULLIFY(YISBA_PE%XBSLAI) -NULLIFY(YISBA_PE%XCE_NITRO) -NULLIFY(YISBA_PE%XCF_NITRO) -NULLIFY(YISBA_PE%XCNA_NITRO) -NULLIFY(YISBA_PE%LSTRESS) -NULLIFY(YISBA_PE%XALBNIR_VEG) -NULLIFY(YISBA_PE%XALBVIS_VEG) -NULLIFY(YISBA_PE%XALBUV_VEG) -NULLIFY(YISBA_PE%XALBNIR) -NULLIFY(YISBA_PE%XALBVIS) -NULLIFY(YISBA_PE%XALBUV) -! -NULLIFY(YISBA_PE%XGNDLITTER) -NULLIFY(YISBA_PE%XH_VEG) -NULLIFY(YISBA_PE%XZ0LITTER) -! -NULLIFY(YISBA_PE%XALBNIR_SOIL) -NULLIFY(YISBA_PE%XALBVIS_SOIL) -NULLIFY(YISBA_PE%XALBUV_SOIL) -! -NULLIFY(YISBA_PE%XWATSUP) -NULLIFY(YISBA_PE%XIRRIG) -! -NULLIFY(YISBA_PE%XWG) -NULLIFY(YISBA_PE%XWGI) -NULLIFY(YISBA_PE%XWR) -NULLIFY(YISBA_PE%XTG) -NULLIFY(YISBA_PE%XICE_STO) -NULLIFY(YISBA_PE%XWRL) -NULLIFY(YISBA_PE%XWRLI) -NULLIFY(YISBA_PE%XWRVN) -NULLIFY(YISBA_PE%XTV) -NULLIFY(YISBA_PE%XTL) -NULLIFY(YISBA_PE%XTC) -NULLIFY(YISBA_PE%XQC) -NULLIFY(YISBA_PE%XRESA) -NULLIFY(YISBA_PE%XAN) -NULLIFY(YISBA_PE%XANDAY) -NULLIFY(YISBA_PE%XANFM) -NULLIFY(YISBA_PE%XLE) -NULLIFY(YISBA_PE%XFAPARC) -NULLIFY(YISBA_PE%XFAPIRC) -NULLIFY(YISBA_PE%XLAI_EFFC) -NULLIFY(YISBA_PE%XMUS) -NULLIFY(YISBA_PE%XRESP_BIOMASS) -NULLIFY(YISBA_PE%XBIOMASS) -NULLIFY(YISBA_PE%XLITTER) -NULLIFY(YISBA_PE%XSOILCARB) -NULLIFY(YISBA_PE%XLIGNIN_STRUC) -NULLIFY(YISBA_PE%XPSNG) -NULLIFY(YISBA_PE%XPSNV) -NULLIFY(YISBA_PE%XPSNV_A) -NULLIFY(YISBA_PE%XSNOWFREE_ALB) -NULLIFY(YISBA_PE%XSNOWFREE_ALB_VEG) -NULLIFY(YISBA_PE%XSNOWFREE_ALB_SOIL) -NULLIFY(YISBA_PE%XPSN) -! -IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_PE_INIT",1,ZHOOK_HANDLE) -END SUBROUTINE ISBA_PE_INIT -! -SUBROUTINE ISBA_NK_INIT(YISBA_NK,KPATCH) -TYPE(ISBA_NK_t), INTENT(INOUT) :: YISBA_NK -INTEGER, INTENT(IN) :: KPATCH -INTEGER :: JP -REAL(KIND=JPRB) :: ZHOOK_HANDLE -IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_NK_INIT",0,ZHOOK_HANDLE) -! -IF (ASSOCIATED(YISBA_NK%AL)) THEN - DO JP = 1,KPATCH - CALL ISBA_K_INIT(YISBA_NK%AL(JP)) - ENDDO - DEALLOCATE(YISBA_NK%AL) -ELSE - ALLOCATE(YISBA_NK%AL(KPATCH)) - DO JP = 1,KPATCH - CALL ISBA_K_INIT(YISBA_NK%AL(JP)) - ENDDO -ENDIF -! -IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_NK_INIT",1,ZHOOK_HANDLE) -END SUBROUTINE ISBA_NK_INIT -! -SUBROUTINE ISBA_NP_INIT(YISBA_NP,KPATCH) -TYPE(ISBA_NP_t), INTENT(INOUT) :: YISBA_NP -INTEGER, INTENT(IN) :: KPATCH -INTEGER :: JP -REAL(KIND=JPRB) :: ZHOOK_HANDLE -IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_NP_INIT",0,ZHOOK_HANDLE) -! -IF (ASSOCIATED(YISBA_NP%AL)) THEN - DO JP = 1,KPATCH - CALL ISBA_P_INIT(YISBA_NP%AL(JP)) - ENDDO - DEALLOCATE(YISBA_NP%AL) -ELSE - ALLOCATE(YISBA_NP%AL(KPATCH)) - DO JP = 1,KPATCH - CALL ISBA_P_INIT(YISBA_NP%AL(JP)) - ENDDO -ENDIF -! -IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_NP_INIT",1,ZHOOK_HANDLE) -END SUBROUTINE ISBA_NP_INIT -! -SUBROUTINE ISBA_NPE_INIT(YISBA_NPE,KPATCH) -TYPE(ISBA_NPE_t), INTENT(INOUT) :: YISBA_NPE -INTEGER, INTENT(IN) :: KPATCH -INTEGER :: JP -REAL(KIND=JPRB) :: ZHOOK_HANDLE -IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_NPE_INIT",0,ZHOOK_HANDLE) -! -IF (ASSOCIATED(YISBA_NPE%AL)) THEN - DO JP = 1,KPATCH - CALL ISBA_PE_INIT(YISBA_NPE%AL(JP)) - ENDDO - DEALLOCATE(YISBA_NPE%AL) -ELSE - ALLOCATE(YISBA_NPE%AL(KPATCH)) - DO JP = 1,KPATCH - CALL ISBA_PE_INIT(YISBA_NPE%AL(JP)) - ENDDO -ENDIF -! -IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_NPE_INIT",1,ZHOOK_HANDLE) -END SUBROUTINE ISBA_NPE_INIT - -END MODULE MODD_ISBA_n diff --git a/src/ICCARE_BASE/modd_megann.F90 b/src/ICCARE_BASE/modd_megann.F90 deleted file mode 100644 index b862c93b7..000000000 --- a/src/ICCARE_BASE/modd_megann.F90 +++ /dev/null @@ -1,207 +0,0 @@ -!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -! ##################### - MODULE MODD_MEGAN_n -! ###################### -! -!! -!! PURPOSE -!! ------- -! -! -! -!! -!!** IMPLICIT ARGUMENTS -!! ------------------ -!! None -!! -! -!! AUTHOR -!! ------ -!! P. Tulet *LACy -!! -!! MODIFICATIONS -!! ------------- -!! 16/07/2003 (P. Tulet) restructured for externalization -!! 24/05/2017 (J. Pianezze) adaptation for SurfEx v8.0 -!! 13/02/2019 (J. Pianezze) correction for use of MEGAN -!------------------------------------------------------------------------------ -! -!* 0. DECLARATIONS -! ------------ -! -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -IMPLICIT NONE -! -TYPE MEGAN_t -! - INTEGER :: NBIO, NALKA, NALKE, NARO, NCARBO, NETHE, NOLEL, NOLEH, & - NALKL, NALKM, NALKH, NAROH, NAROO, NAROL, NARAL, NSO, & - NARAC, NPAH, NALD2, NKETL, NKETH, NMEOH, NETOH, NALCH, & - NISOP, NBIOL, NBIOH, NMTBE, NMVK, NMCR, NMGLY, NISO, & - NCH4, NETH, NHC3, NHC5, NHC8, NOL2, NOLI, NOLT, NALD, & - NKET, NTOL, NHCHO, NORA1, NORA2, NAPI, NLIM, NCO, & - NSO2, NNO, NHNO3, NNO2, NNR, N3CAR, NACTA, NACTO, & - NAPIN, NFORM, NBPIN, NMYRC, NOCIM, NOMTP, NSABI, & - NISP, NTRP, NXYLA, NCG5, NSQT, NTOLA, NCG6, NCG4, & - NISOPRENE, NTRP1, NACET, NMEK, NHCOOH, NCCO_OH, & - NCCHO, NRCHO, NRCO_OH, NBALD, NETHENE, NALK4, NALK5, & - NARO1, NARO2, NOLE1, NACID -! - CHARACTER(LEN=16) :: CMECHANISM ! name of the MesoNH chemical scheme - CHARACTER(LEN=16) :: CMECHANISM2 ! name of the MEGAN scheme used for conversion - LOGICAL :: LCONVERSION ! flag for the MEGAN output species (speciation on scheme or not) - INTEGER :: NVARS3D, N_SCON_SPC ! number of megan and chemical scheme species - REAL :: XDROUGHT ! Drought Index - REAL :: XDAILYPAR ! Mean daily PAR - REAL :: XDAILYTEMP ! Mean daily temperature (K) - REAL :: XMODPREC ! Precipitation correction factor (megan) - REAL, POINTER, DIMENSION(:,:) :: XEF ! efficiency factor - REAL, POINTER, DIMENSION(:,:) :: XPFT ! PFT factor (veg type) - REAL, POINTER, DIMENSION(:) :: XLAI ! Total LAI for MEGAN - INTEGER, POINTER, DIMENSION(:) :: NSLTYP ! USDA soil number category - CHARACTER(LEN=16), POINTER, DIMENSION(:) :: CVNAME3D ! name of the scheme species - CHARACTER(LEN=16), POINTER, DIMENSION(:) :: CMECH_SPC ! name of the scheme species - INTEGER, POINTER, DIMENSION(:) :: NSPMH_MAP ! index map of the scheme species - INTEGER, POINTER, DIMENSION(:) :: NMECH_MAP ! index map the mecanisum species - REAL, POINTER, DIMENSION(:) :: XCONV_FAC ! conversion factor of species - REAL, POINTER, DIMENSION(:) :: XMECH_MWT ! molecular weight of species - REAL, POINTER, DIMENSION(:) :: XBIOFLX ! molecular weight of species - REAL, POINTER, DIMENSION(:) :: XT24 !! average T over the past 24h - REAL, POINTER, DIMENSION(:) :: XPPFD24 !! average PAR over the past 24h - REAL, POINTER, DIMENSION(:) :: XPPFD !! par - -! -END TYPE MEGAN_t - - CONTAINS -! - -SUBROUTINE MEGAN_INIT(YMEGAN) -TYPE(MEGAN_t), INTENT(INOUT) :: YMEGAN -REAL(KIND=JPRB) :: ZHOOK_HANDLE -IF (LHOOK) CALL DR_HOOK("MODD_MEGAN_n:MEGAN_INIT",0,ZHOOK_HANDLE) -NULLIFY(YMEGAN%XEF) -NULLIFY(YMEGAN%XPFT) -NULLIFY(YMEGAN%XLAI) -NULLIFY(YMEGAN%NSLTYP) -NULLIFY(YMEGAN%CVNAME3D) -NULLIFY(YMEGAN%CMECH_SPC) -NULLIFY(YMEGAN%NSPMH_MAP) -NULLIFY(YMEGAN%NMECH_MAP) -NULLIFY(YMEGAN%XCONV_FAC) -NULLIFY(YMEGAN%XMECH_MWT) -NULLIFY(YMEGAN%XBIOFLX) -NULLIFY(YMEGAN%XPPFD24) -NULLIFY(YMEGAN%XT24) -NULLIFY(YMEGAN%XPPFD) -YMEGAN%NBIO=0 -YMEGAN%NALKA=0 -YMEGAN%NALKE=0 -YMEGAN%NARO=0 -YMEGAN%NCARBO=0 -YMEGAN%NETHE=0 -YMEGAN%NOLEL=0 -YMEGAN%NOLEH=0 -YMEGAN%NALKL=0 -YMEGAN%NALKM=0 -YMEGAN%NALKH=0 -YMEGAN%NAROH=0 -YMEGAN%NAROO=0 -YMEGAN%NAROL=0 -YMEGAN%NARAL=0 -YMEGAN%NSO=0 -YMEGAN%NARAC=0 -YMEGAN%NPAH=0 -YMEGAN%NALD2=0 -YMEGAN%NKETL=0 -YMEGAN%NKETH=0 -YMEGAN%NMEOH=0 -YMEGAN%NETOH=0 -YMEGAN%NALCH=0 -YMEGAN%NISOP=0 -YMEGAN%NBIOL=0 -YMEGAN%NBIOH=0 -YMEGAN%NMTBE=0 -YMEGAN%NMVK=0 -YMEGAN%NMCR=0 -YMEGAN%NMGLY=0 -YMEGAN%NISO=0 -YMEGAN%NCH4=0 -YMEGAN%NETH=0 -YMEGAN%NHC3=0 -YMEGAN%NHC5=0 -YMEGAN%NHC8=0 -YMEGAN%NOL2=0 -YMEGAN%NOLI=0 -YMEGAN%NOLT=0 -YMEGAN%NALD=0 -YMEGAN%NKET=0 -YMEGAN%NTOL=0 -YMEGAN%NHCHO=0 -YMEGAN%NORA1=0 -YMEGAN%NORA2=0 -YMEGAN%NAPI=0 -YMEGAN%NLIM=0 -YMEGAN%NCO=0 -YMEGAN%NSO2=0 -YMEGAN%NNO=0 -YMEGAN%NHNO3=0 -YMEGAN%NNO2=0 -YMEGAN%NNR=0 -YMEGAN%N3CAR=0 -YMEGAN%NACTA=0 -YMEGAN%NACTO=0 -YMEGAN%NAPIN=0 -YMEGAN%NFORM=0 -YMEGAN%NBPIN=0 -YMEGAN%NMYRC=0 -YMEGAN%NOCIM=0 -YMEGAN%NOMTP=0 -YMEGAN%NSABI=0 -YMEGAN%NISP=0 -YMEGAN%NTRP=0 -YMEGAN%NXYLA=0 -YMEGAN%NCG5=0 -YMEGAN%NSQT=0 -YMEGAN%NTOLA=0 -YMEGAN%NCG6=0 -YMEGAN%NCG4=0 -YMEGAN%NISOPRENE=0 -YMEGAN%NTRP1=0 -YMEGAN%NACET=0 -YMEGAN%NMEK=0 -YMEGAN%NHCOOH=0 -YMEGAN%NCCO_OH=0 -YMEGAN%NCCHO=0 -YMEGAN%NRCHO=0 -YMEGAN%NRCO_OH=0 -YMEGAN%NBALD=0 -YMEGAN%NETHENE=0 -YMEGAN%NALK4=0 -YMEGAN%NALK5=0 -YMEGAN%NARO1=0 -YMEGAN%NARO2=0 -YMEGAN%NOLE1=0 -YMEGAN%NACID=0 -! -YMEGAN%CMECHANISM=' ' -YMEGAN%CMECHANISM2=' ' -YMEGAN%LCONVERSION=.FALSE. -YMEGAN%NVARS3D=0 -YMEGAN%N_SCON_SPC=0 -YMEGAN%XDROUGHT=0. -YMEGAN%XDAILYPAR=150. -YMEGAN%XDAILYTEMP=293. -YMEGAN%XMODPREC=0. - -IF (LHOOK) CALL DR_HOOK("MODD_MEGAN_n:MEGAN_INIT",1,ZHOOK_HANDLE) -END SUBROUTINE MEGAN_INIT - - -END MODULE MODD_MEGAN_n diff --git a/src/ICCARE_BASE/modd_param_lima.f90 b/src/ICCARE_BASE/modd_param_lima.f90 deleted file mode 100644 index 8e9c1c428..000000000 --- a/src/ICCARE_BASE/modd_param_lima.f90 +++ /dev/null @@ -1,224 +0,0 @@ -!MNH_LIC Copyright 2013-2021 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!------------------------------------------------------------------------------- -! ###################### - MODULE MODD_PARAM_LIMA -! ###################### -! -!!**** *MODD_PARAM_LIMA* - declaration of the control parameters -!! for use in the LIMA scheme. -!! -!! PURPOSE -!! ------- -!! The purpose of this declarative module is to declare the microphysical -!! constants. This includes the descriptive parameters for the raindrop -!! and the parameters relevant of the dimensional distributions. -!! -!! -!! -!!** IMPLICIT ARGUMENTS -!! ------------------ -!! None -!! -!! AUTHOR -!! ------ -!! J.-P. Pinty *Laboratoire d'Aerologie* -!! S. Berthet * Laboratoire d'Aerologie* -!! B. Vié * Laboratoire d'Aerologie* -!! -!! MODIFICATIONS -!! ------------- -!! Original ??/??/13 -!! C. Barthe 14/03/2022 add CIBU and RDSF -!! -!------------------------------------------------------------------------------- -! -USE MODD_PARAMETERS, ONLY : JPLIMACCNMAX, JPLIMAIFNMAX -! -IMPLICIT NONE -! -LOGICAL, SAVE :: LLIMA_DIAG ! Compute diagnostics for concentration /m3 -! -LOGICAL, SAVE :: LPTSPLIT ! activate time-splitting technique by S. Riette -LOGICAL, SAVE :: LFEEDBACKT ! recompute tendencies if T changes sign -INTEGER, SAVE :: NMAXITER ! maximum number of iterations -REAL, SAVE :: XMRSTEP ! maximum change in mixing ratio allowed before recomputing tedencies -REAL, SAVE :: XTSTEP_TS ! maximum time for the sub-time-step -! -!* 1. COLD SCHEME -! ----------- -! -! 1.1 Cold scheme configuration -! -LOGICAL, SAVE :: LCOLD ! TRUE to enable the cold scheme -LOGICAL, SAVE :: LNUCL ! TRUE to enable ice nucleation -LOGICAL, SAVE :: LSEDI ! TRUE to enable pristine ice sedimentation -LOGICAL, SAVE :: LHHONI ! TRUE to enable freezing of haze particules -LOGICAL, SAVE :: LSNOW ! TRUE to enable snow and graupel -LOGICAL, SAVE :: LHAIL ! TRUE to enable hail -LOGICAL, SAVE :: LMEYERS ! TRUE to use Meyers nucleation -LOGICAL, SAVE :: LCIBU ! TRUE to use collisional ice breakup -LOGICAL, SAVE :: LRDSF ! TRUE to use rain drop shattering by freezing -! -! 1.2 IFN initialisation -! -INTEGER, SAVE :: NMOD_IFN ! Number of IFN modes -REAL, DIMENSION(JPLIMAIFNMAX), SAVE :: XIFN_CONC ! Ref. concentration of IFN(#/L) -LOGICAL, SAVE :: LIFN_HOM ! True for z-homogeneous IFN concentrations -CHARACTER(LEN=8), SAVE :: CIFN_SPECIES ! Internal mixing species definitions -CHARACTER(LEN=8), SAVE :: CINT_MIXING ! Internal mixing type selection (pure DM1 ...) -INTEGER, SAVE :: NMOD_IMM ! Number of CCN modes acting by immersion -INTEGER, SAVE :: NIND_SPECIE ! CCN acting by immersion are considered pure - ! IFN of either DM = 1, BC = 2 or O = 3 -INTEGER, DIMENSION(:), SAVE, ALLOCATABLE :: NIMM ! Link between CCN and IMM modes -INTEGER, DIMENSION(:), SAVE, ALLOCATABLE :: NINDICE_CCN_IMM ! ?????????? -INTEGER, SAVE :: NSPECIE ! Internal mixing number of species -REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XMDIAM_IFN ! Mean diameter of IFN modes -REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XSIGMA_IFN ! Sigma of IFN modes -REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XRHO_IFN ! Density of IFN modes -REAL, DIMENSION(:,:), SAVE, ALLOCATABLE :: XFRAC ! Composition of each IFN mode -REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XFRAC_REF ! AP compostion in Phillips 08 -! -! 1.3 Ice characteristics -! -CHARACTER(LEN=4), SAVE :: CPRISTINE_ICE_LIMA ! Pristine type PLAT, COLU or BURO -CHARACTER(LEN=4), SAVE :: CHEVRIMED_ICE_LIMA ! Heavily rimed type GRAU or HAIL -REAL,SAVE :: XALPHAI,XNUI, & ! Pristine ice distribution parameters - XALPHAS,XNUS, & ! Snow/aggregate distribution parameters - XALPHAG,XNUG ! Graupel distribution parameters -! -! 1.4 Phillips (2013) nucleation parameterization -! -INTEGER, SAVE :: NPHILLIPS ! =8 for Phillips08, =13 for Phillips13 -! -REAL, DIMENSION(4), SAVE :: XT0 ! Threshold of T in H_X for X={DM1,DM2,BC,O} [K] -REAL, DIMENSION(4), SAVE :: XDT0 ! Range in T for transition of H_X near XT0 [K] -REAL, DIMENSION(4), SAVE :: XDSI0 ! Range in Si for transition of H_X near XSI0 -REAL, SAVE :: XSW0 ! Threshold of Sw in H_X -REAL, SAVE :: XRHO_CFDC ! Air density at which CFDC data were reported [kg m**3] -REAL, DIMENSION(4), SAVE :: XH ! Fraction<<1 of aerosol for X={DM,BC,O} -REAL, DIMENSION(4), SAVE :: XAREA1 ! Total surface of all aerosols in group X with - ! diameters between 0.1 and 1 µm, for X={DM1,DM2,BC,O} [m**2 kg**-1] -REAL, SAVE :: XGAMMA ! Factor boosting IN concentration due to - ! bulk-liquid modes -! -REAL, DIMENSION(4), SAVE :: XTX1 ! Threshold of T in Xi for X={DM1,DM2,BC,O} [K] -REAL, DIMENSION(4), SAVE :: XTX2 ! Threshold of T in Xi for X={DM1,DM2,BC,O} [K] -! -REAL,DIMENSION(:), SAVE, ALLOCATABLE :: XABSCISS, XWEIGHT ! Gauss quadrature method -INTEGER, SAVE :: NDIAM ! Gauss quadrature accuracy -! -! 1.5 Meyers (1992) nucleation parameterization -! -REAL,SAVE :: XFACTNUC_DEP,XFACTNUC_CON ! Amplification factor for IN conc. - ! DEP refers to DEPosition mode - ! CON refers to CONtact mode -! -! 1.6 Collisional Ice Break Up parameterization -! -REAL,SAVE :: XNDEBRIS_CIBU ! Number of ice crystal debris produced - ! by the break up of aggregate particles -! -!------------------------------------------------------------------------------- -! -! -!* 2. WARM SCHEME -! ----------- -! -! 2.1 Warm scheme configuration -! -LOGICAL, SAVE :: LWARM ! TRUE to enable the warm scheme -LOGICAL, SAVE :: LACTI ! TRUE to enable CCN activation -LOGICAL, SAVE :: LRAIN ! TRUE to enable the formation of rain -LOGICAL, SAVE :: LSEDC ! TRUE to enable the droplet sedimentation -LOGICAL, SAVE :: LACTIT ! TRUE to enable the usage of dT/dt in CCN activation -LOGICAL, SAVE :: LBOUND ! TRUE to enable the continuously replenishing - ! aerosol concentrations through the open - ! lateral boundaries -> boundaries.f90 -LOGICAL, SAVE :: LDEPOC ! Deposition of rc at 1st level above ground -LOGICAL, SAVE :: LACTTKE ! TRUE to take into account TKE in W for activation -LOGICAL, SAVE :: LADJ ! TRUE for adjustment procedure + Smax (false for diagnostic supersaturation) -LOGICAL, SAVE :: LSPRO ! TRUE for prognostic supersaturation -! -! 2.2 CCN initialisation -! -INTEGER, SAVE :: NMOD_CCN ! Number of CCN modes -REAL, DIMENSION(JPLIMACCNMAX), SAVE :: XCCN_CONC ! CCN conc. (#/cm3) -LOGICAL, SAVE :: LCCN_HOM ! True for z-homogeneous CCN concentrations -CHARACTER(LEN=8),SAVE :: CCCN_MODES ! CCN modes characteristics (Jungfraujoch ...) -REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XR_MEAN_CCN, & ! Mean radius of CCN modes - XLOGSIG_CCN, & ! Log of geometric dispersion of the CCN modes - XRHO_CCN ! Density of the CCN modes -REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XKHEN_MULTI, & ! Parameters defining the CCN activation - XMUHEN_MULTI, & ! spectra for a multimodal aerosol distribution - XBETAHEN_MULTI ! -REAL, DIMENSION(:,:,:) ,SAVE, ALLOCATABLE :: XCONC_CCN_TOT ! Total aerosol number concentration -REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XLIMIT_FACTOR ! compute CHEN ???????????? -! -! 2.3 Water particles characteristics -! -REAL,SAVE :: XALPHAR,XNUR, & ! Raindrop distribution parameters - XALPHAC,XNUC ! Cloud droplet distribution parameters -! -! 2.4 CCN activation -! -CHARACTER(LEN=3),SAVE :: HPARAM_CCN = 'CPB' ! Parameterization of the CCN activation -CHARACTER(LEN=3),SAVE :: HINI_CCN ! Initialization type of CCN activation -CHARACTER(LEN=10),DIMENSION(JPLIMACCNMAX),SAVE :: HTYPE_CCN ! 'M' or 'C' CCN type -REAL,SAVE :: XFSOLUB_CCN, & ! Fractionnal solubility of the CCN - XACTEMP_CCN, & ! Expected temperature of CCN activation - XAERDIFF, XAERHEIGHT ! For the vertical gradient of aerosol distribution -! -! Cloud droplet deposition -! -REAL, SAVE :: XVDEPOC -! -!------------------------------------------------------------------------------- -! -! -!* 3. BELOW CLOUD SCAVENGING -! ---------------------- -! -LOGICAL, SAVE :: LSCAV ! TRUE for aerosol scavenging by precipitations -LOGICAL, SAVE :: LAERO_MASS ! TRUE to compute the total aerosol mass scavenging rate -! -INTEGER :: NDIAMR = 20 ! Max Number of droplet for quadrature method -INTEGER :: NDIAMP = 20 ! Max Number of aerosol particle for quadrature method -! -REAL, SAVE :: XT0SCAV = 293.15 ! [K] -REAL, SAVE :: XTREF = 273.15 ! [K] -REAL, SAVE :: XNDO = 8.*1.0E6 ! [/m**4] -! -!------------------------------------------------------------------------------- -! -! -!* 4. ATMOSPHERIC & OTHER PARAMETERS -! ------------------------------ -! -REAL, SAVE :: XMUA0 = 1.711E-05 ![Pa.s] Air Viscosity at T=273.15K -REAL, SAVE :: XT_SUTH_A = 110.4 ![K] Sutherland Temperature for Air -REAL, SAVE :: XMFPA0 = 6.6E-08 ![m] Mean Free Path of Air under standard conditions -! -REAL, SAVE :: XVISCW = 1.0E-3 ![Pa.s] water viscosity at 20°C -! Correction -!REAL, SAVE :: XRHO00 = 1.292 !rho on the floor [Kg/m**3] -REAL, SAVE :: XRHO00 = 1.2041 !rho at P=1013.25 and T=20°C -! -REAL,SAVE :: XCEXVT ! air density fall speed correction -! -REAL,DIMENSION(:),SAVE,ALLOCATABLE :: XRTMIN ! Min values of the mixing ratios -REAL,DIMENSION(:),SAVE,ALLOCATABLE :: XCTMIN ! Min values of the drop concentrations -! -! -! Sedimentation variables -! -INTEGER,DIMENSION(7),SAVE :: NSPLITSED -REAL,DIMENSION(7),SAVE :: XLB -REAL,DIMENSION(7),SAVE :: XLBEX -REAL,DIMENSION(7),SAVE :: XD -REAL,DIMENSION(7),SAVE :: XFSEDR -REAL,DIMENSION(7),SAVE :: XFSEDC -! -END MODULE MODD_PARAM_LIMA diff --git a/src/ICCARE_BASE/modd_param_lima_cold.f90 b/src/ICCARE_BASE/modd_param_lima_cold.f90 deleted file mode 100644 index 9db92526b..000000000 --- a/src/ICCARE_BASE/modd_param_lima_cold.f90 +++ /dev/null @@ -1,163 +0,0 @@ -!MNH_LIC Copyright 2013-2021 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!----------------------------------------------------------------- -! ########################### - MODULE MODD_PARAM_LIMA_COLD -! ########################### -! -!!**** *MODD_PARAM_LIMA_COLD* - declaration of some descriptive parameters and -!! microphysical factors extensively used in -!! the LIMA cold scheme. -!! AUTHOR -!! ------ -!! J.-P. Pinty *Laboratoire d'Aerologie* -!! S. Berthet * Laboratoire d'Aerologie* -!! B. Vié * Laboratoire d'Aerologie* -!! -!! MODIFICATIONS -!! ------------- -!! Original ??/??/13 -!! C. Barthe 14/03/2022 add CIBU and RDSF -!! -!------------------------------------------------------------------------------- -USE MODD_PARAMETERS, ONLY: JPSVNAMELGTMAX -! -IMPLICIT NONE -! -!* 1. DESCRIPTIVE PARAMETERS -! ---------------------- -! -! Declaration of microphysical constants, including the descriptive -! parameters for the raindrop and the ice crystal habits, and the -! parameters relevant of the dimensional distributions. -! -! m(D) = XAx * D**XBx : Mass-MaxDim relationship -! v(D) = XCx * D**XDx : Fallspeed-MaxDim relationship -! N(Lbda) = XCCx * Lbda**XCXx : NumberConc-Slopeparam relationship -! XF0x, XF1x, XF2x : Ventilation factors -! XC1x : Shape parameter for deposition -! -! and -! -! XALPHAx, XNUx : Generalized GAMMA law -! Lbda = XLBx * (r_x*rho_dref)**XLBEXx : Slope parameter of the -! distribution law -! -REAL,SAVE :: XLBEXI,XLBI ! Prist. ice distribution parameters -REAL,SAVE :: XLBEXS,XLBS ! Snow/agg. distribution parameters -! -REAL,SAVE :: XAI,XBI,XC_I,XDI ,XF0I,XF2I,XC1I ! Cloud ice charact. -REAL,SAVE :: XF0IS,XF1IS ! (large Di vent. coef.) -REAL,SAVE :: XAS,XBS,XCS,XDS,XCCS,XCXS,XF0S,XF1S,XC1S ! Snow/agg. charact. -! -REAL,SAVE :: XLBDAS_MAX ! Max values allowed for the shape - ! parameter of snow -! -CHARACTER(LEN=JPSVNAMELGTMAX),DIMENSION(5),PARAMETER & - :: CLIMA_COLD_NAMES=(/'CICE ','CIFNFREE','CIFNNUCL', & - 'CCNINIMM','CCCNNUCL'/) - ! basenames of the SV articles stored - ! in the binary files - !with IF:Ice-nuclei Free (nonactivated IFN by Dep/Cond) - ! IN:Ice-nuclei Nucleated (activated IFN by Dep/Cond) - ! NI:Nuclei Immersed (activated IFN by Imm) - ! HF:Homogeneous Freezing -CHARACTER(LEN=JPSVNAMELGTMAX),DIMENSION(5),PARAMETER & - :: CLIMA_COLD_CONC=(/'NI ','NIF','NIN','NNI','NNH'/)!for DIAG -! -!------------------------------------------------------------------------------- -! -!* 2. MICROPHYSICAL FACTORS -! --------------------- -! -REAL,SAVE :: XFSEDRI,XFSEDCI, & ! Constants for sedimentation - XFSEDS, XEXSEDS ! fluxes of ice and snow -! -REAL,SAVE :: XNUC_DEP,XEXSI_DEP,XEX_DEP, & ! Constants for heterogeneous - XNUC_CON,XEXTT_CON,XEX_CON, & ! ice nucleation : DEP et CON - XMNU0 ! mass of nucleated ice crystal -! -REAL,SAVE :: XRHOI_HONH,XCEXP_DIFVAP_HONH, & ! Constants for homogeneous - XCOEF_DIFVAP_HONH,XRCOEF_HONH, & ! haze freezing : HHONI - XCRITSAT1_HONH,XCRITSAT2_HONH, & - XTMIN_HONH,XTMAX_HONH, & - XDLNJODT1_HONH,XDLNJODT2_HONH, & - XC1_HONH,XC2_HONH,XC3_HONH -! -REAL,SAVE :: XC_HONC,XR_HONC, & ! Constants for homogeneous - XTEXP1_HONC,XTEXP2_HONC, & ! droplet freezing : CHONI - XTEXP3_HONC,XTEXP4_HONC, & - XTEXP5_HONC -! -REAL,SAVE :: XCSCNVI_MAX, XLBDASCNVI_MAX, & - XRHORSMIN, & - XDSCNVI_LIM, XLBDASCNVI_LIM, & ! Constants for snow - XC0DEPSI,XC1DEPSI, & ! sublimation conversion to - XR0DEPSI,XR1DEPSI ! pristine ice : SCNVI -! -REAL,SAVE :: XSCFAC, & ! Constants for the Bergeron - X0DEPI,X2DEPI, & ! Findeisen process and - X0DEPS,X1DEPS,XEX0DEPS,XEX1DEPS ! deposition -! -REAL,SAVE :: XDICNVS_LIM, XLBDAICNVS_LIM, & ! Constants for pristine ice - XC0DEPIS,XC1DEPIS, & ! deposition conversion to - XR0DEPIS,XR1DEPIS ! snow : ICNVS -! -REAL,SAVE :: XCOLEXIS, & ! Constants for snow - XAGGS_CLARGE1,XAGGS_CLARGE2, & ! aggregation : AGG - XAGGS_RLARGE1,XAGGS_RLARGE2 -! -!?????????????????? -REAL,SAVE :: XKER_ZRNIC_A1,XKER_ZRNIC_A2 ! Long-Zrnic Kernels (ini_ice_coma) -! -REAL,SAVE :: XSELFI,XCOLEXII ! Constants for pristine ice - ! self-collection (ini_ice_coma) -! -REAL,SAVE :: XAUTO3, XAUTO4, & ! Constants for pristine ice - XLAUTS, XLAUTS_THRESHOLD, & ! autoconversion : AUT - XITAUTS, XITAUTS_THRESHOLD, & ! (ini_ice_com) - XTEXAUTI -! -REAL,SAVE :: XCONCI_MAX ! Limitation of the pristine - ! ice concentration (init and grid-nesting) -REAL,SAVE :: XFREFFI ! Factor to compute the cloud ice effective radius -! -! -! Constants for ice-ice collision : CIBU -! -REAL, SAVE :: XDCSLIM_CIBU_MIN, & ! aggregates min diam. : 0.2 mm - XDCSLIM_CIBU_MAX, & ! aggregates max diam. : 1.0 mm - XDCGLIM_CIBU_MIN, & ! graupel min diam. : 2 mm - XGAMINC_BOUND_CIBU_SMIN, & ! Min val. of Lbda_s*dlim - XGAMINC_BOUND_CIBU_SMAX, & ! Max val. of Lbda_s*dlim - XGAMINC_BOUND_CIBU_GMIN, & ! Min val. of Lbda_g*dlim - XGAMINC_BOUND_CIBU_GMAX, & ! Max val. of Lbda_g*dlim - XCIBUINTP_S,XCIBUINTP1_S, & ! - XCIBUINTP2_S, & ! - XCIBUINTP_G,XCIBUINTP1_G, & ! - XFACTOR_CIBU_NI,XFACTOR_CIBU_RI, & ! Factor for final CIBU Eq. - XMOMGG_CIBU_1,XMOMGG_CIBU_2, & ! Moment computation - XMOMGS_CIBU_1,XMOMGS_CIBU_2, & - XMOMGS_CIBU_3 -! -REAL, DIMENSION(:,:), SAVE, ALLOCATABLE & - :: XGAMINC_CIBU_S, & ! Tab.incomplete Gamma function - XGAMINC_CIBU_G ! Tab.incomplete Gamma function -! -! Constants for raindrop shattering : RDSF -! -REAL, SAVE :: XDCRLIM_RDSF_MIN, & ! Raindrops min diam. : 0.2 mm - XGAMINC_BOUND_RDSF_RMIN, & ! Min val. of Lbda_r*dlim - XGAMINC_BOUND_RDSF_RMAX, & ! Max val. of Lbda_r*dlim - XRDSFINTP_R,XRDSFINTP1_R, & ! - XFACTOR_RDSF_NI, & ! Factor for final RDSF Eq. - XMOMGR_RDSF -! -REAL, DIMENSION(:), SAVE, ALLOCATABLE & - :: XGAMINC_RDSF_R ! Tab.incomplete Gamma function -! -!------------------------------------------------------------------------------- -! -END MODULE MODD_PARAM_LIMA_COLD diff --git a/src/ICCARE_BASE/modd_prep_real.f90 b/src/ICCARE_BASE/modd_prep_real.f90 deleted file mode 100644 index 8fdd4cebd..000000000 --- a/src/ICCARE_BASE/modd_prep_real.f90 +++ /dev/null @@ -1,120 +0,0 @@ -!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -! ############### - MODULE MODD_PREP_REAL -! ############### -! -!!**** *MODD_PREP_REAL* - declaration of work arrays in PREP_REAL_CASE -!! -!! PURPOSE -!! ------- -! -!! -!!** IMPLICIT ARGUMENTS -!! ------------------ -!! None -!! -!! REFERENCE -!! --------- -!! -!! AUTHOR -!! ------ -!! V. Masson *Meteo France* -!! -!! MODIFICATIONS -!! ------------- -!! Original 05/05 -!! 05/06 (I.Mallet) add *_SV_* variables to allow chemical -!! initialization from HCHEMFILE -!! 09/20 (Q. Rodier) add geopotential height for GFS GRIB read -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -IMPLICIT NONE -! -!* variables allocated in case of Gribex input file -! -REAL :: XP00_LS ! reference pressure in eta -REAL,DIMENSION(:), ALLOCATABLE :: XA_LS ! function A in definition of eta -REAL,DIMENSION(:), ALLOCATABLE :: XB_LS ! function B in definition of eta -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XT_LS ! temperature -REAL,DIMENSION(:,:,:,:),ALLOCATABLE:: XQ_LS ! specific ratio of humidity and - !other hydrometeors -REAL :: XP00_SV_LS ! reference pressure in eta -REAL,DIMENSION(:), ALLOCATABLE :: XA_SV_LS ! function A in definition of eta -REAL,DIMENSION(:), ALLOCATABLE :: XB_SV_LS ! function B in definition of eta -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XT_SV_LS ! temperature -REAL,DIMENSION(:,:,:,:),ALLOCATABLE:: XQ_SV_LS ! specific humidity -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XDUMMY_2D ! 2D dummy fields read in -CHARACTER(LEN=16),DIMENSION(:), ALLOCATABLE :: CDUMMY_2D !GRIBex file -! -!* variables allocated in case of Mesonh input file -! -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XTH_LS ! potential temperature -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XLSU_LS ! large scale pseudo zonal wind component -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XLSV_LS ! large scale pseudo meridian wind component -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XLSW_LS ! large scale vertical wind speed -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XLSTH_LS ! large scale potential temperature -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XLSRV_LS ! large scale vapor mixing ratios -REAL,DIMENSION(:), ALLOCATABLE :: XZHAT_LS ! altitude coordinate -! -LOGICAL :: LSLEVE_LS! flag for sleve coordinate -REAL :: XLEN1_LS ! Decay scale for smooth topography -REAL :: XLEN2_LS ! Decay scale for small-scale topography deviation -! -!* variables allocated in both cases -! -REAL,DIMENSION(:,:), ALLOCATABLE :: XPS_LS ! surface pressure -REAL,DIMENSION(:,:), ALLOCATABLE :: XZS_LS ! orography -REAL,DIMENSION(:,:), ALLOCATABLE :: XZSMT_LS ! smooth orography -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XGH_LS ! geopotential height -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XZFLUX_LS! altitude of pressure points -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XZMASS_LS! altitude of mass points -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XPMHP_LS ! pressure minus hyd. pressure -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XTHV_LS ! virtual potential temperature -REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: XR_LS ! water mixing ratios -REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: XSV_LS ! scalar mixing ratios -!UPG*PT -REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: XSV_LS_LIMA ! scalar mixing ratios for lima -!UPG*PT -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XHU_LS ! relative humidity -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XTKE_LS ! turbulence kinetic energy -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XU_LS ! pseudo zonal wind component -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XV_LS ! pseudo meridian wind component -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XW_LS ! vertical wind speed -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XPMASS_LS! pressure of mass points -REAL,DIMENSION(:,:), ALLOCATABLE :: XPS_SV_LS ! surface pressure -REAL,DIMENSION(:,:), ALLOCATABLE :: XZS_SV_LS ! orography -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XZFLUX_SV_LS! altitude of pressure points -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XZMASS_SV_LS! altitude of mass points -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XPMASS_SV_LS! pressure of mass points -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XTHV_SV_LS ! virtual potential temperature -REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: XR_SV_LS ! water mixing ratios -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XHU_SV_LS ! relative humidity -! -!* variables on MiXed grid -! -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XTHV_MX ! thetav -REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: XR_MX ! water mixing ratios -REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: XSV_MX ! scalar mixing ratios -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XTKE_MX ! turbulence kinetic energy -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XPMHP_MX ! pressure minus hyd. pressure -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XU_MX ! pseudo zonal wind component -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XV_MX ! pseudo meridian wind component -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XW_MX ! vertical wind speed -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XLSTH_MX ! Large scale pot. temperature -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XLSRV_MX ! Large scale vapor mixing ratio -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XLSU_MX ! Large scale U component -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XLSV_MX ! Large scale V component -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XLSW_MX ! Large scale W component -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XZFLUX_MX! altitude of the pressure levels -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XZMASS_MX! altitude of the mass levels -REAL,DIMENSION(:,:,:), ALLOCATABLE :: XRHOD_MX ! rho dry -REAL,DIMENSION(:,:), ALLOCATABLE :: XEXNTOP2D ! local top Exner function -REAL,DIMENSION(:,:), ALLOCATABLE :: XPSURF ! Surface pressure -! -END MODULE MODD_PREP_REAL diff --git a/src/ICCARE_BASE/modd_salt.f90 b/src/ICCARE_BASE/modd_salt.f90 deleted file mode 100644 index e111b15db..000000000 --- a/src/ICCARE_BASE/modd_salt.f90 +++ /dev/null @@ -1,108 +0,0 @@ -!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence -!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!ORILAM_LIC for details. -!----------------------------------------------------------------- -!--------------- special set of characters for RCS information -!----------------------------------------------------------------- -! $Source$ $Revision$ -! MASDEV4_7 modd 2007/01/12 14:42:16 -!----------------------------------------------------------------- -!! ###################### - MODULE MODD_SALT -!! ###################### -!! -!! PURPOSE -!! ------- -!! -!! declaration of variables and types for the sea salt scheme -!! -!! METHOD -!! ------ -!! -!! -!! REFERENCE -!! --------- -!! none -!! -!! -!! AUTHOR -!! ------ -!! Pierre Tulet (CNRM) -!! -!! -!! MODIFICATIONS -!! ------------- -!! -!! 2014 P.Tulet modif XINIRADIUS_SLT and XN0MIN_SLT -!! -USE MODD_PARAMETERS, ONLY: JPMODELMAX -!USE MODD_SLT_n, ONLY : SLT_t -!!-------------------------------------------------------------------- -!! DECLARATIONS -!! ------------ -IMPLICIT NONE -! -! ++ PIERRE / MARINE SSA DUST - MODIF ++ -LOGICAL :: LSLTCAMS = .FALSE. ! switch to active pronostic sea salts from CAMS -LOGICAL :: LSALT = .FALSE. ! switch to active pronostic sea salts -LOGICAL :: LONLY = .FALSE. -LOGICAL :: LREAD_ONLY_HS_MACC = .FALSE. -LOGICAL :: LSLTINIT = .FALSE. ! switch to initialize pronostic sea salts -LOGICAL :: LSLTPRES = .FALSE. ! switch to know if pronostic salts exist -LOGICAL,DIMENSION(JPMODELMAX) :: LDEPOS_SLT = .FALSE. ! switch to SLT wet depositon - -CHARACTER(LEN=9),DIMENSION(:),ALLOCATABLE :: CDESLTNAMES -CHARACTER(LEN=6),DIMENSION(:), ALLOCATABLE :: CSALTNAMES -CHARACTER(LEN=9),DIMENSION(16), PARAMETER :: YPDESLT_INI = & - (/'DESLTM31C','DESLTM32C','DESLTM33C','DESLTM34C', 'DESLTM35C','DESLTM36C', & - 'DESLTM37C','DESLTM38C',& - 'DESLTM31R','DESLTM32R','DESLTM33R', 'DESLTM34R','DESLTM35R','DESLTM36R','DESLTM37R','DESLTM38R' /) - -CHARACTER(LEN=6),DIMENSION(24), PARAMETER :: YPSALT_INI = & - (/'SLTM01','SLTM31','SLTM61',& - 'SLTM02','SLTM32','SLTM62',& - 'SLTM03','SLTM33','SLTM63',& - 'SLTM04','SLTM34','SLTM64',& - 'SLTM05','SLTM35','SLTM65',& - 'SLTM06','SLTM36','SLTM66',& - 'SLTM07','SLTM37','SLTM67',& - 'SLTM08','SLTM38','SLTM68'/) - - -INTEGER, DIMENSION(8),PARAMETER :: JPSALTORDER = (/1,2,3,4,5,6,7,8/) -INTEGER :: NMODE_SLT= 8 ! number of sea salt modes (default = 8) - -!Test Thomas (definir rayons et sigma ici si on veut desactiver initialisation MACC) - -!REAL, DIMENSION(5) :: XINIRADIUS_SLT,XINISIG_SLT,XN0MIN_SLT - -!Initial dry number median radius (um) from Ova et al., 2014 -REAL,DIMENSION(8) :: XINIRADIUS_SLT= (/0.009, 0.021, 0.045, 0.115,0.415,2.5, 7.0, 20.0/) -!Initial, standard deviation from Ova et al., 2014 -REAL,DIMENSION(8) :: XINISIG_SLT = (/ 1.37, 1.5, 1.42, 1.53, 1.85,1.7,1.8, 2.9 /) - -!Minimum allowed number concentration for any mode (#/m3) -REAL,DIMENSION(8) :: XN0MIN_SLT = (/1.e1 , 1.e1, 1.e1, 1., 1.e-4,1.e-20, 1.e-20,1.e-20 /) -!Test Thomas -REAL, DIMENSION(:,:,:), ALLOCATABLE :: XSLTMSS ! [kg/m3] total mass concentration of sea salt -! -! aerosol lognormal parameterization -CHARACTER(LEN=4) :: CRGUNITS = 'NUMB' ! type of log-normal geometric mean radius -! !given in namelist (mass on number) -! -LOGICAL :: LRGFIX_SLT = .FALSE. ! switch to fix RG (sedimentation) -LOGICAL :: LVARSIG_SLT = .FALSE. ! switch to active pronostic dispersion for all modes -LOGICAL :: LSEDIMSALT = .FALSE. ! switch to active aerosol sedimentation -REAL :: XSIGMIN_SLT = 1.20 ! minimum dispersion value for sea salt mode -!REAL :: XSIGMIN_SLT = 0. ! minimum dispersion value for sea salt mode -REAL :: XSIGMAX_SLT = 3.60 ! maximum dispersion value for sea salt mode -REAL :: XCOEFRADMAX_SLT = 10. ! maximum increasement for Rg mode sea salt -REAL :: XCOEFRADMIN_SLT = 0.1 ! minimum decreasement for Rg mode sea salt -!REAL :: XCOEFRADMIN_SLT = 0. ! minimum decreasement for Rg mode sea salt - - -! -! -- PIERRE / MARINE SSA DUST - MODIF -- -! -END MODULE MODD_SALT diff --git a/src/ICCARE_BASE/modd_slt_surf.F90 b/src/ICCARE_BASE/modd_slt_surf.F90 deleted file mode 100644 index 73b5afe64..000000000 --- a/src/ICCARE_BASE/modd_slt_surf.F90 +++ /dev/null @@ -1,32 +0,0 @@ -!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -MODULE MODD_SLT_SURF -! -! MODIFICATIONS -! -!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes - - -IMPLICIT NONE -! -REAL, PARAMETER :: XDENSITY_DRYSLT = 2.16e3 ! [kg/m3] density of dry sea salt -REAL, PARAMETER :: XDENSITY_SLT = 1.17e3 ! [kg/m3] density of wet sea salt -REAL, PARAMETER :: XMOLARWEIGHT_SLT = 58.e-3 ! [kg/mol] molar weight sea salt -! -INTEGER, PARAMETER :: NEMISMODES_MAX=8 -INTEGER, DIMENSION(NEMISMODES_MAX), PARAMETER :: JORDER_SLT=(/1,2,3,4,5,6,7,8/) !Dust modes in order of importance -!Set emission related parameters -REAL,DIMENSION(NEMISMODES_MAX) :: XEMISRADIUS_INI_SLT ! number madian radius initialization for sea salt mode (um) -REAL,DIMENSION(NEMISMODES_MAX) :: XEMISSIG_INI_SLT ! dispersion initialization for sea salt mode -! -CHARACTER(LEN=6) :: CEMISPARAM_SLT ! Reference to paper where emission parameterization is proposed -INTEGER :: JPMODE_SLT ! number of sea salt modes (max 3; default = 1) -LOGICAL :: LVARSIG_SLT ! switch to active pronostic dispersion for all modes -LOGICAL :: LRGFIX_SLT ! switch to active pronostic mean radius for all modes -! -INTEGER :: NSLT_MDEBEG ! Index of mass flux in first sea salt mode in scalar list -INTEGER :: NSLTMDE ! Number of sea salt modes emitted -! -END MODULE MODD_SLT_SURF diff --git a/src/ICCARE_BASE/modd_surfexn.F90 b/src/ICCARE_BASE/modd_surfexn.F90 deleted file mode 100644 index 34ee38cf9..000000000 --- a/src/ICCARE_BASE/modd_surfexn.F90 +++ /dev/null @@ -1,285 +0,0 @@ -!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -MODULE MODD_SURFEX_n -! -USE MODD_AGRI_n, ONLY : AGRI_NP_t -USE MODD_BEM_OPTION_n, ONLY : BEM_OPTIONS_t -USE MODD_BLD_DESCRIPTION_n, ONLY : BLD_DESC_t -USE MODD_BLOWSNW_n, ONLY : BLOWSNW_t -USE MODD_CH_EMIS_FIELD_n, ONLY : CH_EMIS_FIELD_t -USE MODD_CH_FLAKE_n, ONLY : CH_FLAKE_t -USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t, CH_ISBA_NP_t -USE MODD_CH_SEAFLUX_n, ONLY : CH_SEAFLUX_t -USE MODD_CH_SNAP_n, ONLY : CH_EMIS_SNAP_t -USE MODD_CH_SURF_n, ONLY : CH_SURF_t -USE MODD_CH_TEB_n, ONLY : CH_TEB_t -USE MODD_CH_WATFLUX_n, ONLY : CH_WATFLUX_t -USE MODD_DATA_BEM_n, ONLY : DATA_BEM_t -USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t -USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t -USE MODD_DATA_SEAFLUX_n, ONLY : DATA_SEAFLUX_t -USE MODD_DATA_TEB_n, ONLY : DATA_TEB_t -USE MODD_DATA_TSZ0_n, ONLY : DATA_TSZ0_t -USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t, DIAG_EVAP_ISBA_NP_t -USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_NP_t, DIAG_OPTIONS_t -USE MODD_DIAG_MISC_FLAKE_n, ONLY : DIAG_MISC_FLAKE_t -USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t, DIAG_MISC_ISBA_NP_t -USE MODD_DIAG_MISC_TEB_OPTIONS_n, ONLY : DIAG_MISC_TEB_OPTIONS_t -USE MODD_DIAG_OCEAN_n, ONLY : DIAG_OCEAN_t -USE MODD_DIAG_MISC_SEAICE_n, ONLY : DIAG_MISC_SEAICE_t -USE MODD_DIAG_UTCI_TEB_n, ONLY : DIAG_UTCI_TEB_t -USE MODD_DST_n, ONLY : DST_NP_t -USE MODD_DUMMY_SURF_FIELDS_n, ONLY : DUMMY_SURF_FIELDS_t -USE MODD_EMIS_GR_FIELD_n, ONLY : EMIS_GR_FIELD_t -USE MODD_SFX_GRID_n, ONLY : GRID_t, GRID_NP_t -USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_t -USE MODD_FLAKE_n, ONLY : FLAKE_t -USE MODD_GR_BIOG_n, ONLY : GR_BIOG_t, GR_BIOG_NP_t -USE MODD_IDEAL_n, ONLY : IDEAL_t -USE MODD_CANOPY_n, ONLY : CANOPY_t -USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t -USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t, ISBA_NK_t, ISBA_P_t, ISBA_NP_t, & - ISBA_PE_t, ISBA_NPE_t -USE MODD_OCEAN_n, ONLY : OCEAN_t -USE MODD_OCEAN_REL_n, ONLY : OCEAN_REL_t -USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t -USE MODD_SLT_n, ONLY : SLT_t -USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t -USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t -USE MODD_SSO_n, ONLY : SSO_t, SSO_NP_t -USE MODD_SV_n, ONLY : SV_t -USE MODD_TEB_IRRIG_n, ONLY : TEB_IRRIG_t -USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t -USE MODD_TEB_PANEL_n, ONLY : TEB_PANEL_t -USE MODD_WATFLUX_n, ONLY : WATFLUX_t -! -USE MODD_BEM_n, ONLY : BEM_NP_t -USE MODD_DIAG_MISC_TEB_n, ONLY : DIAG_MISC_TEB_NP_t -USE MODD_TEB_n, ONLY : TEB_NP_t -! -USE MODD_MEGAN_n, ONLY : MEGAN_t -USE MODD_MEGAN_SURF_FIELDS_n, ONLY : MEGAN_SURF_FIELDS_t -! -USE MODD_DMS_n, ONLY : DMS_t -USE MODD_DMS_SURF_FIELDS_n, ONLY : DMS_SURF_FIELDS_t -!--------------------------------------------------------------------------- -! -TYPE FLAKE_MODEL_t -! -TYPE(DIAG_OPTIONS_t) :: DFO -TYPE(DIAG_t) :: DF -TYPE(DIAG_t) :: DFC -TYPE(DIAG_MISC_FLAKE_t) :: DMF -! -TYPE(GRID_t) :: G -TYPE(CANOPY_t) :: SB -TYPE(CH_FLAKE_t) :: CHF -TYPE(FLAKE_t) :: F -! -END TYPE FLAKE_MODEL_t -! -! -TYPE WATFLUX_MODEL_t -! -TYPE(DIAG_OPTIONS_t) :: DWO -TYPE(DIAG_t) :: DW -TYPE(DIAG_t) :: DWC -! -TYPE(GRID_t) :: G -TYPE(CANOPY_t) :: SB -TYPE(CH_WATFLUX_t) :: CHW -TYPE(WATFLUX_t) :: W -! -END TYPE WATFLUX_MODEL_t -! -!------------------------------------------------------ -! -TYPE SEAFLUX_DIAG_t -! -TYPE(DIAG_OPTIONS_t) :: O -TYPE(DIAG_t) :: D -TYPE(DIAG_t) :: DC -TYPE(DIAG_t) :: DI -TYPE(DIAG_t) :: DIC -TYPE(DIAG_OCEAN_t) :: GO -TYPE(DIAG_MISC_SEAICE_t) :: DMI -! -END TYPE SEAFLUX_DIAG_t -! -! -TYPE SEAFLUX_MODEL_t -! -TYPE(SEAFLUX_DIAG_t) :: SD -! -TYPE(DATA_SEAFLUX_t) :: DTS -TYPE(GRID_t) :: G -TYPE(CANOPY_t) :: SB -TYPE(CH_SEAFLUX_t) :: CHS -TYPE(SEAFLUX_t) :: S -! -TYPE(OCEAN_t) :: O -TYPE(OCEAN_REL_t) :: OR -! -TYPE(DMS_t) :: DMS -TYPE(DMS_SURF_FIELDS_t) :: DSF - -END TYPE SEAFLUX_MODEL_t -! -!-------------------------------------------------- -! -TYPE ISBA_DIAG_t -! -TYPE(DIAG_OPTIONS_t) :: O -TYPE(DIAG_t) :: D -TYPE(DIAG_t) :: DC -TYPE(DIAG_NP_t) :: ND -TYPE(DIAG_NP_t) :: NDC -TYPE(DIAG_EVAP_ISBA_t) :: DE -TYPE(DIAG_EVAP_ISBA_t) :: DEC -TYPE(DIAG_EVAP_ISBA_NP_t) :: NDE -TYPE(DIAG_EVAP_ISBA_NP_t) :: NDEC -TYPE(DIAG_MISC_ISBA_t) :: DM -TYPE(DIAG_MISC_ISBA_NP_t) :: NDM -! -END TYPE ISBA_DIAG_t -! -TYPE ISBA_MODEL_t -! -TYPE(ISBA_DIAG_t) :: ID -TYPE(DATA_ISBA_t) :: DTV -TYPE(CANOPY_t) :: SB -TYPE(ISBA_OPTIONS_t) :: O -TYPE(ISBA_S_t) :: S -TYPE(CH_ISBA_t) :: CHI -TYPE(CH_ISBA_NP_t) :: NCHI -TYPE(GR_BIOG_t) :: GB -TYPE(GR_BIOG_NP_t) :: NGB -TYPE(SSO_t) :: ISS -TYPE(SSO_NP_t) :: NISS -TYPE(GRID_t) :: G -TYPE(GRID_NP_t) :: NG -TYPE(ISBA_K_t) :: K -TYPE(ISBA_NK_t) :: NK -TYPE(ISBA_NP_t) :: NP -TYPE(ISBA_NPE_t) :: NPE -TYPE(AGRI_NP_t) :: NAG -! -TYPE(MEGAN_t) :: MGN -TYPE(MEGAN_SURF_FIELDS_t) :: MSF -! -END TYPE ISBA_MODEL_t -! -!--------------------------------------- -! -TYPE TEB_VEG_DIAG_t -! -TYPE(DIAG_NP_t) :: ND -TYPE(DIAG_EVAP_ISBA_NP_t) :: NDE -TYPE(DIAG_EVAP_ISBA_NP_t) :: NDEC -TYPE(DIAG_MISC_ISBA_NP_t) :: NDM -! -END TYPE TEB_VEG_DIAG_t -! -TYPE TEB_GARDEN_MODEL_t -! -TYPE(TEB_VEG_DIAG_t) :: VD -TYPE(DATA_ISBA_t) :: DTV -TYPE(ISBA_OPTIONS_t) :: O -TYPE(ISBA_S_t) :: S -TYPE(GR_BIOG_t) :: GB -TYPE(ISBA_K_t) :: K -TYPE(ISBA_P_t) :: P -TYPE(ISBA_NPE_t) :: NPE -! -END TYPE TEB_GARDEN_MODEL_t -! -TYPE TEB_GREENROOF_MODEL_t -! -TYPE(TEB_VEG_DIAG_t) :: VD -TYPE(DATA_ISBA_t) :: DTV -TYPE(ISBA_OPTIONS_t) :: O -TYPE(ISBA_S_t) :: S -TYPE(GR_BIOG_t) :: GB -TYPE(ISBA_K_t) :: K -TYPE(ISBA_P_t) :: P -TYPE(ISBA_NPE_t) :: NPE -! -END TYPE TEB_GREENROOF_MODEL_t -! -TYPE TEB_DIAG_t -! -TYPE(DIAG_OPTIONS_t) :: O -TYPE(DIAG_t) :: D -TYPE(DIAG_MISC_TEB_OPTIONS_t) :: MTO -TYPE(DIAG_MISC_TEB_NP_t) :: NDMT -TYPE(DIAG_MISC_TEB_NP_t) :: NDMTC -TYPE(DIAG_UTCI_TEB_t) :: DUT -! -END TYPE TEB_DIAG_t -! -TYPE TEB_MODEL_t -! -TYPE(DATA_TEB_t) :: DTT -TYPE(TEB_OPTIONS_t) :: TOP -TYPE(CANOPY_t) :: SB -TYPE(GRID_t) :: G -TYPE(CH_TEB_t) :: CHT -TYPE(TEB_PANEL_t) :: TPN -TYPE(TEB_IRRIG_t) :: TIR -TYPE(TEB_NP_t) :: NT -! -TYPE(TEB_DIAG_t) :: TD -! -TYPE(DATA_BEM_t) :: DTB -TYPE(BEM_OPTIONS_t) :: BOP -TYPE(BLD_DESC_t) :: BDD -TYPE(BEM_NP_t) :: NB -! -END TYPE TEB_MODEL_t -! -!---------------------------------------------------------- -! -TYPE SURFEX_t -! -TYPE(DATA_COVER_t) :: DTCO -TYPE(DATA_TSZ0_t) :: DTZ -TYPE(DUMMY_SURF_FIELDS_t) :: DUU -! -TYPE(GRID_CONF_PROJ_t) :: GCP -TYPE(SURF_ATM_GRID_t) :: UG -TYPE(SURF_ATM_t) :: U -TYPE(DIAG_OPTIONS_t) :: DUO -TYPE(DIAG_t) :: DU -TYPE(DIAG_t) :: DUC -TYPE(DIAG_NP_t) :: DUP -TYPE(DIAG_NP_t) :: DUPC -TYPE(SSO_t) :: USS -TYPE(CANOPY_t) :: SB -! -TYPE(DIAG_OPTIONS_t) :: DLO -TYPE(DIAG_t) :: DL -TYPE(DIAG_t) :: DLC -TYPE(IDEAL_t) :: L -! -TYPE(SV_t) :: SV -TYPE(CH_SURF_t) :: CHU -TYPE(CH_EMIS_FIELD_t) :: CHE -TYPE(CH_EMIS_SNAP_t) :: CHN -TYPE(EMIS_GR_FIELD_t) :: EGF -TYPE(DST_NP_t) :: NDST -TYPE(SLT_t) :: SLT -TYPE(BLOWSNW_t) :: BLOWSNW -! -TYPE(FLAKE_MODEL_t) :: FM -TYPE(WATFLUX_MODEL_t) :: WM -TYPE(SEAFLUX_MODEL_t) :: SM -TYPE(ISBA_MODEL_t) :: IM -TYPE(TEB_MODEL_t) :: TM -TYPE(TEB_GARDEN_MODEL_t) :: GDM -TYPE(TEB_GREENROOF_MODEL_t) :: GRM -! -END TYPE SURFEX_t -! -END MODULE MODD_SURFEX_n diff --git a/src/ICCARE_BASE/mode_aero_psd.f90 b/src/ICCARE_BASE/mode_aero_psd.f90 deleted file mode 100644 index 7a18e4515..000000000 --- a/src/ICCARE_BASE/mode_aero_psd.f90 +++ /dev/null @@ -1,1089 +0,0 @@ -!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence -!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!ORILAM_LIC for details. -!----------------------------------------------------------------- -!----------------------------------------------------------------- -!--------------- special set of characters for RCS information -!----------------------------------------------------------------- -! $Source$ $Revision$ $Date$ -!----------------------------------------------------------------- -!! ######################## -MODULE MODE_AERO_PSD -!! ######################## -!! -!! MODULE DUST PSD (Particle Size Distribution) -!! Purpose: Contains subroutines to convert from transported variables (ppp) -!! to understandable aerosol variables, e.g. #/m3, kg/m3, sigma, R_{n} - -USE MODD_CH_AEROSOL -USE MODD_CONF, ONLY : CPROGRAM -USE MODD_CH_MNHC_n, ONLY : LCH_INIT_FIELD -USE MODD_CST, ONLY : & - XPI & !Definition of pi - ,XAVOGADRO & ![molec/mol] avogadros number - ,XMD ![kg/mol] molar weight of air -USE MODD_CST, ONLY : XMNH_TINY -USE MODD_CSTS_DUST, ONLY : XDENSITY_DUST -! -IMPLICIT NONE -! -CONTAINS -! -! ############################################################ - SUBROUTINE PPP2AERO( & - PSVT & !I [ppp] input scalar variables (moment of distribution) - , PRHODREF & !I [kg/m3] density of air - , PSIG3D & !O [-] standard deviation of aerosol distribution - , PRG3D & !O [um] number median diameter of aerosol distribution - , PN3D & !O [#/m3] number concentration of aerosols - , PCTOTA & !O [ug/m3] mass of each aerosol compounds - , PM3D & !O moments 0, 3 and 6 - , PMI & !O [g/mol] molecular weight - ) -! ############################################################ -! -!! -!! PURPOSE -!! ------- -!! Translate the three moments M0, M3 and M6 given in ppp into -!! Values which can be understood more easily (R, sigma, N, M) -!! -!! CALLING STRUCTURE NOTE: OPTIONAL VARIABLES -!! ------- -!! CALL PPP2AEROS(PSVT, PRHODREF, PSIG3D=SIGVAR, & -!! PRG3D=RVAR, PN3D=NVAR, PM3D=ZM) -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Pierre TULET (LA) -!! -!! MODIFICATIONS -!! ------------- -!! Alf Grini (CNRM) -!! M.Leriche 2015 : masse molaire Black carbon à 12 g/mol -!! -!! EXTERNAL -!! -------- -!! - IMPLICIT NONE -!! -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -!* 0.1 declarations of arguments -! -REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT !I [#/molec_{air}] first moment - !I [molec_{aer}/molec_{air} 3rd moment - !I [um6/molec_{air}*(cm3/m3)] 6th moment -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF !I [kg/m3] density of air - -REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PSIG3D !O [-] standard deviation -REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PRG3D !O [um] number median diameter -REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PN3D !O [#/m3] number concentration -REAL, DIMENSION(:,:,:,:,:),OPTIONAL, INTENT(OUT) :: PCTOTA !O [ug/m3] mass of each component -REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PM3D !O moments 0,3 and 6 -REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(IN) :: PMI ! molecular weight -! -!* 0.2 declarations local variables -! -REAL, DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3),NSP+NCARB+NSOA):: ZMI ! [g/mol] molar weight of aerosol -REAL,DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3),SIZE(PSVT,4)) :: ZSV ! [aerosol concentration] -REAL,DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3)) :: ZSIGMA ! [-] standard deviation -REAL,DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),NSP+NCARB+NSOA,JPMODE):: ZCTOTA -REAL,DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),JPMODE*3) :: ZM -REAL,DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),JPMODE) :: ZMASK, ZRG - -REAL,DIMENSION(NSP+NCARB+NSOA) :: ZFAC ! M3 / mass conversion factor -REAL,DIMENSION(NSP+NCARB+NSOA) :: ZRHOI ! aerosol density -REAL :: ZDEN2MOL -REAL,DIMENSION(JPMODE*3) :: ZPMIN ! [aerosol units] minimum values for N, sigma, M -INTEGER :: JI,JJ,JK,JSV, JN ! [idx] loop counters -REAL :: ZINIRADIUSI, ZINIRADIUSJ -! -!------------------------------------------------------------------------------- -! -! 1. initialisation - -IF (CRGUNIT=="MASS") THEN - ZINIRADIUSI = XINIRADIUSI * EXP(-3.*(LOG(XINISIGI))**2) - ZINIRADIUSJ = XINIRADIUSJ * EXP(-3.*(LOG(XINISIGJ))**2) -ELSE - ZINIRADIUSI = XINIRADIUSI - ZINIRADIUSJ = XINIRADIUSJ -END IF -! Moments index -NM0(1) = 1 -NM3(1) = 2 -NM6(1) = 3 -NM0(2) = 4 -NM3(2) = 5 -NM6(2) = 6 - - !Get minimum values possible - ZPMIN(1) = XN0IMIN - ZPMIN(2) = ZPMIN(1) * (ZINIRADIUSI**3)*EXP(4.5 * LOG(XINISIGI)**2) - ZPMIN(3) = ZPMIN(1) * (ZINIRADIUSI**6)*EXP(18. * LOG(XINISIGI)**2) - - ZPMIN(4) = XN0JMIN - ZPMIN(5) = ZPMIN(4) * (ZINIRADIUSJ**3)*EXP(4.5 * LOG(XINISIGJ)**2) - ZPMIN(6) = ZPMIN(4) * (ZINIRADIUSJ**6)*EXP(18. * LOG(XINISIGJ)**2) - -! Cf Ackermann (all to black carbon except water) -!Set molecular weightn g/mol -ZRHOI(:) = 1.8e3 -ZRHOI(JP_AER_H2O) = 1.0e3 ! water -ZRHOI(JP_AER_DST) = XDENSITY_DUST ! dusts - -IF(PRESENT(PMI)) THEN - ZMI(:,:,:,:) = PMI(:,:,:,:) -ELSE - ZMI(:,:,:,:) = 250. - ZMI(:,:,:,JP_AER_SO4) = 98. - ZMI(:,:,:,JP_AER_NO3) = 63. - ZMI(:,:,:,JP_AER_NH3) = 17. - ZMI(:,:,:,JP_AER_H2O) = 18. - ZMI(:,:,:,JP_AER_BC) = 12. - ZMI(:,:,:,JP_AER_DST) = 100. - IF (NSOA .EQ. 10) THEN - ZMI(:,:,:,JP_AER_SOA1) = 88. - ZMI(:,:,:,JP_AER_SOA2) = 180. - ZMI(:,:,:,JP_AER_SOA3) = 1.5374857E2 - ZMI(:,:,:,JP_AER_SOA4) = 1.9586780E2 - ZMI(:,:,:,JP_AER_SOA5) = 195. - ZMI(:,:,:,JP_AER_SOA6) = 195. - ZMI(:,:,:,JP_AER_SOA7) = 165. - ZMI(:,:,:,JP_AER_SOA8) = 195. - ZMI(:,:,:,JP_AER_SOA9) = 270. - ZMI(:,:,:,JP_AER_SOA10) = 210. - END IF -ENDIF -! conversion into mol.cm-3 -ZDEN2MOL = 1E-6 * XAVOGADRO / XMD -! -DO JJ=1, SIZE(PSVT,4) - ZSV(:,:,:,JJ) = PSVT(:,:,:,JJ) * ZDEN2MOL * PRHODREF(:,:,:) -ENDDO -ZSV(:,:,:,:) = MAX(ZSV(:,:,:,:), XMNH_TINY) -! -DO JJ=1,NSP+NCARB+NSOA - ZFAC(JJ)=(4./3.)*XPI*ZRHOI(JJ)*1.e-9 -ENDDO -! -!------------------------------------------------------------------------------- -! -!* 2 transfer aerosol mass from gas to aerosol variables -! (and conversion of mol.cm-3 --> microgram/m3) -! -ZCTOTA(:,:,:,:,:) = 0. -! aerosol phase - ZCTOTA(:,:,:,JP_AER_SO4,1) = ZSV(:,:,:,JP_CH_SO4i)*ZMI(:,:,:,JP_AER_SO4)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SO4,2) = ZSV(:,:,:,JP_CH_SO4j)*ZMI(:,:,:,JP_AER_SO4)/6.0221367E+11 - - ZCTOTA(:,:,:,JP_AER_NO3,1) = ZSV(:,:,:,JP_CH_NO3i)*ZMI(:,:,:,JP_AER_NO3)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_NO3,2) = ZSV(:,:,:,JP_CH_NO3j)*ZMI(:,:,:,JP_AER_NO3)/6.0221367E+11 - - ZCTOTA(:,:,:,JP_AER_NH3,1) = ZSV(:,:,:,JP_CH_NH3i)*ZMI(:,:,:,JP_AER_NH3)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_NH3,2) = ZSV(:,:,:,JP_CH_NH3j)*ZMI(:,:,:,JP_AER_NH3)/6.0221367E+11 -! -! water - ZCTOTA(:,:,:,JP_AER_H2O,1) = ZSV(:,:,:,JP_CH_H2Oi)*ZMI(:,:,:,JP_AER_H2O)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_H2O,2) = ZSV(:,:,:,JP_CH_H2Oj)*ZMI(:,:,:,JP_AER_H2O)/6.0221367E+11 -! -! primary organic carbon - ZCTOTA(:,:,:,JP_AER_OC,1) = ZSV(:,:,:,JP_CH_OCi)*ZMI(:,:,:,JP_AER_OC)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_OC,2) = ZSV(:,:,:,JP_CH_OCj)*ZMI(:,:,:,JP_AER_OC)/6.0221367E+11 -! -! primary black carbon - ZCTOTA(:,:,:,JP_AER_BC,1) = ZSV(:,:,:,JP_CH_BCi)*ZMI(:,:,:,JP_AER_BC)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_BC,2) = ZSV(:,:,:,JP_CH_BCj)*ZMI(:,:,:,JP_AER_BC)/6.0221367E+11 -!dust - ZCTOTA(:,:,:,JP_AER_DST,1) = ZSV(:,:,:,JP_CH_DSTi)*ZMI(:,:,:,JP_AER_DST)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_DST,2) = ZSV(:,:,:,JP_CH_DSTj)*ZMI(:,:,:,JP_AER_DST)/6.0221367E+11 -! -IF (NSOA .EQ. 10) THEN - ZCTOTA(:,:,:,JP_AER_SOA1,1) = ZSV(:,:,:,JP_CH_SOA1i)*ZMI(:,:,:,JP_AER_SOA1)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA1,2) = ZSV(:,:,:,JP_CH_SOA1j)*ZMI(:,:,:,JP_AER_SOA1)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA2,1) = ZSV(:,:,:,JP_CH_SOA2i)*ZMI(:,:,:,JP_AER_SOA2)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA2,2) = ZSV(:,:,:,JP_CH_SOA2j)*ZMI(:,:,:,JP_AER_SOA2)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA3,1) = ZSV(:,:,:,JP_CH_SOA3i)*ZMI(:,:,:,JP_AER_SOA3)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA3,2) = ZSV(:,:,:,JP_CH_SOA3j)*ZMI(:,:,:,JP_AER_SOA3)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA4,1) = ZSV(:,:,:,JP_CH_SOA4i)*ZMI(:,:,:,JP_AER_SOA4)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA4,2) = ZSV(:,:,:,JP_CH_SOA4j)*ZMI(:,:,:,JP_AER_SOA4)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA5,1) = ZSV(:,:,:,JP_CH_SOA5i)*ZMI(:,:,:,JP_AER_SOA5)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA5,2) = ZSV(:,:,:,JP_CH_SOA5j)*ZMI(:,:,:,JP_AER_SOA5)/6.0221367E+11 - - ZCTOTA(:,:,:,JP_AER_SOA6,1) = ZSV(:,:,:,JP_CH_SOA6i)*ZMI(:,:,:,JP_AER_SOA6)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA6,2) = ZSV(:,:,:,JP_CH_SOA6j)*ZMI(:,:,:,JP_AER_SOA6)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA7,1) = ZSV(:,:,:,JP_CH_SOA7i)*ZMI(:,:,:,JP_AER_SOA7)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA7,2) = ZSV(:,:,:,JP_CH_SOA7j)*ZMI(:,:,:,JP_AER_SOA7)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA8,1) = ZSV(:,:,:,JP_CH_SOA8i)*ZMI(:,:,:,JP_AER_SOA8)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA8,2) = ZSV(:,:,:,JP_CH_SOA8j)*ZMI(:,:,:,JP_AER_SOA8)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA9,1) = ZSV(:,:,:,JP_CH_SOA9i)*ZMI(:,:,:,JP_AER_SOA9)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA9,2) = ZSV(:,:,:,JP_CH_SOA9j)*ZMI(:,:,:,JP_AER_SOA9)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA10,1) = ZSV(:,:,:,JP_CH_SOA10i)*ZMI(:,:,:,JP_AER_SOA10)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA10,2) = ZSV(:,:,:,JP_CH_SOA10j)*ZMI(:,:,:,JP_AER_SOA10)/6.0221367E+11 -END IF -! -!------------------------------------------------------------------------------- -! -!* 3 calculate moment 3 from total aerosol mass -! -ZM(:,:,:,2) = 0. -ZM(:,:,:,5) = 0. -DO JJ = 1,NSP+NCARB+NSOA - ZM(:,:,:,2) = ZM(:,:,:,2)+ZCTOTA(:,:,:,JJ,1)/ZFAC(JJ) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment) - ZM(:,:,:,5) = ZM(:,:,:,5)+ZCTOTA(:,:,:,JJ,2)/ZFAC(JJ) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment) -ENDDO -! -!------------------------------------------------------------------------------- -! -!* 4 set moment 0 -! -IF ((CPROGRAM=="REAL ").OR.(CPROGRAM=="IDEAL ")) THEN - ZM(:,:,:,1)= ZM(:,:,:,2) / ((ZINIRADIUSI**3)*EXP(4.5 * LOG(XINISIGI)**2)) - ZM(:,:,:,4)= ZM(:,:,:,5) / ((ZINIRADIUSJ**3)*EXP(4.5 * LOG(XINISIGJ)**2)) -ELSE - ZM(:,:,:,1)= MAX(ZSV(:,:,:,JP_CH_M0i) * 1E+6, XMNH_TINY) ! molec_{aer}/m3_{air} - ZM(:,:,:,4)= MAX(ZSV(:,:,:,JP_CH_M0j) * 1E+6, XMNH_TINY) ! molec_{aer}/m3_{air} -END IF -! -!------------------------------------------------------------------------------- -! -!* 5 set moment 6 ==> um6_{aer}/m3_{air} -! -IF (LVARSIGI) THEN ! set M6 variable standard deviation - IF ((CPROGRAM=="REAL ").OR.(CPROGRAM=="IDEAL ")) THEN - ZM(:,:,:,3)= ZM(:,:,:,1) * (ZINIRADIUSJ**6)*EXP(18. * LOG(XINISIGJ)**2) - ELSE - ZM(:,:,:,3) = MAX(ZSV(:,:,:,JP_CH_M6i), XMNH_TINY) - - ZSIGMA(:,:,:)=ZM(:,:,:,2)**2/(ZM(:,:,:,1)*ZM(:,:,:,3)) - ZSIGMA(:,:,:)=MIN(1-1E-10,ZSIGMA(:,:,:)) - ZSIGMA(:,:,:)=MAX(1E-10,ZSIGMA(:,:,:)) - ZSIGMA(:,:,:)= LOG(ZSIGMA(:,:,:)) - ZSIGMA(:,:,:)= EXP(1./3.*SQRT(-ZSIGMA(:,:,:))) - - ZM(:,:,:,3) = ZM(:,:,:,1) & - * ( (ZM(:,:,:,2)/ZM(:,:,:,1))**(1./3.) & - * exp(-(3./2.)*log(ZSIGMA(:,:,:))**2))**6 & - * exp(18.*log(ZSIGMA(:,:,:))**2) - - END IF - IF(PRESENT(PSIG3D)) PSIG3D(:,:,:,1) = ZSIGMA(:,:,:) - -ELSE ! fixed standard deviation - ZM(:,:,:,3) = ZM(:,:,:,1) & - * ( (ZM(:,:,:,2)/ZM(:,:,:,1))**(1./3.) & - * exp(-(3./2.)*log(XINISIGI)**2))**6 & - * exp(18.*log(XINISIGI)**2) - - IF(PRESENT(PSIG3D)) PSIG3D(:,:,:,1) = XINISIGI -END IF - -IF (LVARSIGJ) THEN ! set M6 variable standard deviation - IF ((CPROGRAM=="REAL ").OR.(CPROGRAM=="IDEAL ")) THEN - ZM(:,:,:,6)= ZM(:,:,:,4) * (ZINIRADIUSJ**6)*EXP(18. * LOG(XINISIGJ)**2) - ELSE - ZM(:,:,:,6) = MAX(ZSV(:,:,:,JP_CH_M6j), XMNH_TINY) - - ZSIGMA(:,:,:)=ZM(:,:,:,5)**2/(ZM(:,:,:,4)*ZM(:,:,:,6)) - ZSIGMA(:,:,:)=MIN(1-1E-10,ZSIGMA(:,:,:)) - ZSIGMA(:,:,:)=MAX(1E-10,ZSIGMA(:,:,:)) - ZSIGMA(:,:,:)= LOG(ZSIGMA(:,:,:)) - ZSIGMA(:,:,:)= EXP(1./3.*SQRT(-ZSIGMA(:,:,:))) - - ZM(:,:,:,6) = ZM(:,:,:,4) & - * ( (ZM(:,:,:,5)/ZM(:,:,:,4))**(1./3.) & - * exp(-(3./2.)*log(ZSIGMA(:,:,:))**2))**6 & - * exp(18.*log(ZSIGMA(:,:,:))**2) - END IF - - IF(PRESENT(PSIG3D)) PSIG3D(:,:,:,2) = ZSIGMA(:,:,:) - -ELSE ! fixed standard deviation - ZM(:,:,:,6) = ZM(:,:,:,4) & - * ( (ZM(:,:,:,5)/ZM(:,:,:,4))**(1./3.) & - * exp(-(3./2.)*log(XINISIGJ)**2))**6 & - * exp(18.*log(XINISIGJ)**2) - - IF(PRESENT(PSIG3D)) PSIG3D(:,:,:,2) = XINISIGJ -END IF - - -!------------------------------------------------------------------------------- -! -!* 6 calculate modal parameters from moments -! -DO JN=1,JPMODE - IF(PRESENT(PN3D)) PN3D(:,:,:,JN) = ZM(:,:,:,NM0(JN)) - - ZRG(:,:,:,JN) = (ZM(:,:,:,NM3(JN))**4. & - / (ZM(:,:,:,NM6(JN))*ZM(:,:,:,NM0(JN))**3.))**(1./6.) - - - IF(PRESENT(PRG3D)) PRG3D(:,:,:,JN)=(ZM(:,:,:,NM3(JN))**4. & - / (ZM(:,:,:,NM6(JN))*ZM(:,:,:,NM0(JN))**3.))**(1./6.) - -ENDDO -! -IF(PRESENT(PCTOTA)) PCTOTA(:,:,:,:,:) = ZCTOTA(:,:,:,:,:) -IF(PRESENT(PM3D)) PM3D(:,:,:,:) = ZM(:,:,:,:) -! -! -END SUBROUTINE PPP2AERO -! -! ############################################################ - SUBROUTINE CON2MIX (PSVT & !I [µg/m3] O [ppp] input scalar variables (moment of distribution) - ,PRHODREF ) !I [kg/m3] density of air - -! -!! PURPOSE -!! ------- -!! conversion from µg/m3 to moments (ppp) to init aerosol profile (ch_init_field) -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Pierre TULET (LA) -!! -!! EXTERNAL -!! -------- -!! - IMPLICIT NONE -!! -REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT !I [#/molec_{air}] first moment - !I [molec_{aer}/molec_{air} 3rd moment - !I [um6/molec_{air}*(cm3/m3)] 6th moment -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF !I [kg/m3] density of air - -!* 0.2 declarations local variables -! -REAL,DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3), JPMODE*3) :: ZM ! aerosols moments -REAL,DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),NSP+NCARB+NSOA,JPMODE):: ZCTOTA - -REAL,DIMENSION(NSP+NCARB+NSOA) :: ZFAC ! M3 / mass conversion factor -REAL,DIMENSION(NSP+NCARB+NSOA) :: ZRHOI ! aerosol density -REAL,DIMENSION(NSP+NCARB+NSOA) :: ZMI ! molecular weight -INTEGER :: JJ ! [idx] loop counters -REAL :: ZDEN2MOL -REAL :: ZINIRADIUSI, ZINIRADIUSJ -! -!------------------------------------------------------------------------------- -! -! 1. initialisation - -ZRHOI(:) = 1.8e3 -ZRHOI(JP_AER_H2O) = 1.0e3 ! water -ZRHOI(JP_AER_DST) = XDENSITY_DUST ! dusts -ZMI(:) = 250. -ZMI(JP_AER_SO4) = 98. -ZMI(JP_AER_NO3) = 63. -ZMI(JP_AER_NH3) = 17. -ZMI(JP_AER_H2O) = 18. -ZMI(JP_AER_BC) = 12. -ZMI(JP_AER_DST) = 100. -IF (NSOA .EQ. 10) THEN - ZMI(JP_AER_SOA1) = 88. - ZMI(JP_AER_SOA2) = 180. - ZMI(JP_AER_SOA3) = 1.5374857E2 - ZMI(JP_AER_SOA4) = 1.9586780E2 - ZMI(JP_AER_SOA5) = 195. - ZMI(JP_AER_SOA6) = 195. - ZMI(JP_AER_SOA7) = 165. - ZMI(JP_AER_SOA8) = 195. - ZMI(JP_AER_SOA9) = 270. - ZMI(JP_AER_SOA10) = 210. -END IF - - -IF (CRGUNIT=="MASS") THEN - ZINIRADIUSI = XINIRADIUSI * EXP(-3.*(LOG(XINISIGI))**2) - ZINIRADIUSJ = XINIRADIUSJ * EXP(-3.*(LOG(XINISIGJ))**2) -ELSE - ZINIRADIUSI = XINIRADIUSI - ZINIRADIUSJ = XINIRADIUSJ -END IF - -! conversion into mol.cm-3 -ZDEN2MOL = 1E-6 * XAVOGADRO / XMD - - -DO JJ=1,NSP+NCARB+NSOA - ZFAC(JJ)=(4./3.)*XPI*ZRHOI(JJ)*1.e-9 -ENDDO -! -! inorganic phase - ZCTOTA(:,:,:,JP_AER_SO4,1) = PSVT(:,:,:,JP_CH_SO4i) - ZCTOTA(:,:,:,JP_AER_SO4,2) = PSVT(:,:,:,JP_CH_SO4j) - ZCTOTA(:,:,:,JP_AER_NO3,1) = PSVT(:,:,:,JP_CH_NO3i) - ZCTOTA(:,:,:,JP_AER_NO3,2) = PSVT(:,:,:,JP_CH_NO3j) - ZCTOTA(:,:,:,JP_AER_NH3,1) = PSVT(:,:,:,JP_CH_NH3i) - ZCTOTA(:,:,:,JP_AER_NH3,2) = PSVT(:,:,:,JP_CH_NH3j) -! -! water - ZCTOTA(:,:,:,JP_AER_H2O,1) = PSVT(:,:,:,JP_CH_H2Oi) - ZCTOTA(:,:,:,JP_AER_H2O,2) = PSVT(:,:,:,JP_CH_H2Oj) -! -! primary organic carbon - ZCTOTA(:,:,:,JP_AER_OC,1) = PSVT(:,:,:,JP_CH_OCi) - ZCTOTA(:,:,:,JP_AER_OC,2) = PSVT(:,:,:,JP_CH_OCj) -! -! primary black carbon - ZCTOTA(:,:,:,JP_AER_BC,1) = PSVT(:,:,:,JP_CH_BCi) - ZCTOTA(:,:,:,JP_AER_BC,2) = PSVT(:,:,:,JP_CH_BCj) -!dust - ZCTOTA(:,:,:,JP_AER_DST,1) = PSVT(:,:,:,JP_CH_DSTi) - ZCTOTA(:,:,:,JP_AER_DST,2) = PSVT(:,:,:,JP_CH_DSTj) -! - IF (NSOA .EQ. 10) THEN - ZCTOTA(:,:,:,JP_AER_SOA1,1) = PSVT(:,:,:,JP_CH_SOA1i) - ZCTOTA(:,:,:,JP_AER_SOA1,2) = PSVT(:,:,:,JP_CH_SOA1j) - ZCTOTA(:,:,:,JP_AER_SOA2,1) = PSVT(:,:,:,JP_CH_SOA2i) - ZCTOTA(:,:,:,JP_AER_SOA2,2) = PSVT(:,:,:,JP_CH_SOA2j) - ZCTOTA(:,:,:,JP_AER_SOA3,1) = PSVT(:,:,:,JP_CH_SOA3i) - ZCTOTA(:,:,:,JP_AER_SOA3,2) = PSVT(:,:,:,JP_CH_SOA3j) - ZCTOTA(:,:,:,JP_AER_SOA4,1) = PSVT(:,:,:,JP_CH_SOA4i) - ZCTOTA(:,:,:,JP_AER_SOA4,2) = PSVT(:,:,:,JP_CH_SOA4j) - ZCTOTA(:,:,:,JP_AER_SOA5,1) = PSVT(:,:,:,JP_CH_SOA5i) - ZCTOTA(:,:,:,JP_AER_SOA5,2) = PSVT(:,:,:,JP_CH_SOA5j) - - ZCTOTA(:,:,:,JP_AER_SOA6,1) = PSVT(:,:,:,JP_CH_SOA6i) - ZCTOTA(:,:,:,JP_AER_SOA6,2) = PSVT(:,:,:,JP_CH_SOA6j) - ZCTOTA(:,:,:,JP_AER_SOA7,1) = PSVT(:,:,:,JP_CH_SOA7i) - ZCTOTA(:,:,:,JP_AER_SOA7,2) = PSVT(:,:,:,JP_CH_SOA7j) - ZCTOTA(:,:,:,JP_AER_SOA8,1) = PSVT(:,:,:,JP_CH_SOA8i) - ZCTOTA(:,:,:,JP_AER_SOA8,2) = PSVT(:,:,:,JP_CH_SOA8j) - ZCTOTA(:,:,:,JP_AER_SOA9,1) = PSVT(:,:,:,JP_CH_SOA9i) - ZCTOTA(:,:,:,JP_AER_SOA9,2) = PSVT(:,:,:,JP_CH_SOA9j) - ZCTOTA(:,:,:,JP_AER_SOA10,1) = PSVT(:,:,:,JP_CH_SOA10i) - ZCTOTA(:,:,:,JP_AER_SOA10,2) = PSVT(:,:,:,JP_CH_SOA10j) - END IF - ZCTOTA(:,:,:,:,:) = MAX(ZCTOTA(:,:,:,:,:),XMNH_TINY) - -! -!* 3 calculate moment 3 from total aerosol mass -! -ZM(:,:,:,2) = 0. -ZM(:,:,:,5) = 0. - DO JJ = 1,NSP+NCARB+NSOA - ZM(:,:,:,2) = ZM(:,:,:,2)+ZCTOTA(:,:,:,JJ,1)/ZFAC(JJ) - ZM(:,:,:,5) = ZM(:,:,:,5)+ZCTOTA(:,:,:,JJ,2)/ZFAC(JJ) - ENDDO -! -! -!* 4 calculate moment 0 from dispersion and mean radius -! -ZM(:,:,:,1)= ZM(:,:,:,2)/ & - ( (ZINIRADIUSI**3)*EXP(4.5 * LOG(XINISIGI)**2) ) - -ZM(:,:,:,4)= ZM(:,:,:,5)/ & - ( (ZINIRADIUSJ**3)*EXP(4.5 * LOG(XINISIGJ)**2) ) -! - -!* 5 calculate moment 6 from dispersion and mean radius -! -ZM(:,:,:,3) = ZM(:,:,:,1)*(ZINIRADIUSI**6) * EXP(18 *(LOG(XINISIGI))**2) -ZM(:,:,:,6) = ZM(:,:,:,4)*(ZINIRADIUSJ**6) * EXP(18 *(LOG(XINISIGJ))**2) - -!* 6 return to ppp -! inorganic phase - PSVT(:,:,:,JP_CH_SO4i) = ZCTOTA(:,:,:,JP_AER_SO4,1)*6.0221367E+11/ZMI(JP_AER_SO4) - PSVT(:,:,:,JP_CH_SO4j) = ZCTOTA(:,:,:,JP_AER_SO4,2)*6.0221367E+11/ZMI(JP_AER_SO4) - PSVT(:,:,:,JP_CH_NO3i) = ZCTOTA(:,:,:,JP_AER_NO3,1)*6.0221367E+11/ZMI(JP_AER_NO3) - PSVT(:,:,:,JP_CH_NO3j) = ZCTOTA(:,:,:,JP_AER_NO3,2)*6.0221367E+11/ZMI(JP_AER_NO3) - PSVT(:,:,:,JP_CH_NH3i) = ZCTOTA(:,:,:,JP_AER_NH3,1)*6.0221367E+11/ZMI(JP_AER_NH3) - PSVT(:,:,:,JP_CH_NH3j) = ZCTOTA(:,:,:,JP_AER_NH3,2)*6.0221367E+11/ZMI(JP_AER_NH3) -! -! water - PSVT(:,:,:,JP_CH_H2Oi) = ZCTOTA(:,:,:,JP_AER_H2O,1)*6.0221367E+11/ZMI(JP_AER_H2O) - PSVT(:,:,:,JP_CH_H2Oj) = ZCTOTA(:,:,:,JP_AER_H2O,2)*6.0221367E+11/ZMI(JP_AER_H2O) -! -! primary organic carbon - PSVT(:,:,:,JP_CH_OCi) = ZCTOTA(:,:,:,JP_AER_OC,1)*6.0221367E+11/ZMI(JP_AER_OC) - PSVT(:,:,:,JP_CH_OCj) = ZCTOTA(:,:,:,JP_AER_OC,2)*6.0221367E+11/ZMI(JP_AER_OC) -! -! primary black carbon - PSVT(:,:,:,JP_CH_BCi) = ZCTOTA(:,:,:,JP_AER_BC,1)*6.0221367E+11/ZMI(JP_AER_BC) - PSVT(:,:,:,JP_CH_BCj) = ZCTOTA(:,:,:,JP_AER_BC,2)*6.0221367E+11/ZMI(JP_AER_BC) -!dust - PSVT(:,:,:,JP_CH_DSTi) = ZCTOTA(:,:,:,JP_AER_DST,1)*6.0221367E+11/ZMI(JP_AER_DST) - PSVT(:,:,:,JP_CH_DSTj) = ZCTOTA(:,:,:,JP_AER_DST,2)*6.0221367E+11/ZMI(JP_AER_DST) -! - IF (NSOA .EQ. 10) THEN - PSVT(:,:,:,JP_CH_SOA1i) = ZCTOTA(:,:,:,JP_AER_SOA1,1)*6.0221367E+11/ZMI(JP_AER_SOA1) - PSVT(:,:,:,JP_CH_SOA1j) = ZCTOTA(:,:,:,JP_AER_SOA1,2)*6.0221367E+11/ZMI(JP_AER_SOA1) - PSVT(:,:,:,JP_CH_SOA2i) = ZCTOTA(:,:,:,JP_AER_SOA2,1)*6.0221367E+11/ZMI(JP_AER_SOA2) - PSVT(:,:,:,JP_CH_SOA2j) = ZCTOTA(:,:,:,JP_AER_SOA2,2)*6.0221367E+11/ZMI(JP_AER_SOA2) - PSVT(:,:,:,JP_CH_SOA3i) = ZCTOTA(:,:,:,JP_AER_SOA3,1)*6.0221367E+11/ZMI(JP_AER_SOA3) - PSVT(:,:,:,JP_CH_SOA3j) = ZCTOTA(:,:,:,JP_AER_SOA3,2)*6.0221367E+11/ZMI(JP_AER_SOA3) - PSVT(:,:,:,JP_CH_SOA4i) = ZCTOTA(:,:,:,JP_AER_SOA4,1)*6.0221367E+11/ZMI(JP_AER_SOA4) - PSVT(:,:,:,JP_CH_SOA4j) = ZCTOTA(:,:,:,JP_AER_SOA4,2)*6.0221367E+11/ZMI(JP_AER_SOA4) - PSVT(:,:,:,JP_CH_SOA5i) = ZCTOTA(:,:,:,JP_AER_SOA5,1)*6.0221367E+11/ZMI(JP_AER_SOA5) - PSVT(:,:,:,JP_CH_SOA5j) = ZCTOTA(:,:,:,JP_AER_SOA5,2)*6.0221367E+11/ZMI(JP_AER_SOA5) - PSVT(:,:,:,JP_CH_SOA6i) = ZCTOTA(:,:,:,JP_AER_SOA6,1)*6.0221367E+11/ZMI(JP_AER_SOA6) - PSVT(:,:,:,JP_CH_SOA6j) = ZCTOTA(:,:,:,JP_AER_SOA6,2)*6.0221367E+11/ZMI(JP_AER_SOA6) - PSVT(:,:,:,JP_CH_SOA7i) = ZCTOTA(:,:,:,JP_AER_SOA7,1)*6.0221367E+11/ZMI(JP_AER_SOA7) - PSVT(:,:,:,JP_CH_SOA7j) = ZCTOTA(:,:,:,JP_AER_SOA7,2)*6.0221367E+11/ZMI(JP_AER_SOA7) - PSVT(:,:,:,JP_CH_SOA8i) = ZCTOTA(:,:,:,JP_AER_SOA8,1)*6.0221367E+11/ZMI(JP_AER_SOA8) - PSVT(:,:,:,JP_CH_SOA8j) = ZCTOTA(:,:,:,JP_AER_SOA8,2)*6.0221367E+11/ZMI(JP_AER_SOA8) - PSVT(:,:,:,JP_CH_SOA9i) = ZCTOTA(:,:,:,JP_AER_SOA9,1)*6.0221367E+11/ZMI(JP_AER_SOA9) - PSVT(:,:,:,JP_CH_SOA9j) = ZCTOTA(:,:,:,JP_AER_SOA9,2)*6.0221367E+11/ZMI(JP_AER_SOA9) - PSVT(:,:,:,JP_CH_SOA10i) = ZCTOTA(:,:,:,JP_AER_SOA10,1)*6.0221367E+11/ZMI(JP_AER_SOA10) - PSVT(:,:,:,JP_CH_SOA10j) = ZCTOTA(:,:,:,JP_AER_SOA10,2)*6.0221367E+11/ZMI(JP_AER_SOA10) - END IF - -! -PSVT(:,:,:,JP_CH_M0i) = ZM(:,:,:,1) * 1E-6 -PSVT(:,:,:,JP_CH_M0j) = ZM(:,:,:,4) * 1E-6 - -IF (LVARSIGI) PSVT(:,:,:,JP_CH_M6i) = ZM(:,:,:,3) -IF (LVARSIGJ) PSVT(:,:,:,JP_CH_M6j) = ZM(:,:,:,6) - -DO JJ=1,SIZE(PSVT,4) - PSVT(:,:,:,JJ) = PSVT(:,:,:,JJ) / (ZDEN2MOL * PRHODREF(:,:,:)) -ENDDO - - -END SUBROUTINE CON2MIX - -! ############################################################ - SUBROUTINE AERO2PPP( & - PSVT & !IO [ppp] input scalar variables (moment of distribution) - , PRHODREF & !I [kg/m3] density of air - , PSIG3D & !I [-] standard deviation of aerosol distribution - , PRG3D & !I [um] number median diameter of aerosol distribution - , PMI & !O [g/mol] molecular weight - ) -!! ############################################################ -! -!! -!! PURPOSE -!! ------- -!! Translate the aerosol Mass, RG and SIGMA in the three moments M0, M3 and M6 given in ppp -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Pierre TULET (LA) -!! -!! MODIFICATIONS -!! ------------- -!! Alf Grini (CNRM) -!! -!! EXTERNAL -!! -------- -!! - IMPLICIT NONE -!! -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -!* 0.1 declarations of arguments -! -REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT !I [#/molec_{air}] first moment - !I [molec_{aer}/molec_{air} 3rd moment - !I [um6/molec_{air}*(cm3/m3)] 6th moment -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF !I [kg/m3] density of air - -REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSIG3D !O [-] standard deviation -REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRG3D !O [um] number median diameter -REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(IN) :: PMI !O molecular weight -! -! -!* 0.2 declarations local variables -! -REAL,DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),NSP+NCARB+NSOA) :: ZMI ! [g/mol] molar weight of aerosol -REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZM ! [aerosol units] local array which goes to output later -REAL,DIMENSION(JPMODE*3) :: ZPMIN ! [aerosol units] minimum values for N, sigma, M -REAL,DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),NSP+NCARB+NSOA,JPMODE):: ZCTOTA - -REAL,DIMENSION(NSP+NCARB+NSOA) :: ZFAC ! M3 / mass conversion factor -REAL,DIMENSION(NSP+NCARB+NSOA) :: ZRHOI ! aerosol density -INTEGER :: JJ ! [idx] loop counters -REAL :: ZDEN2MOL -REAL :: ZINIRADIUSI, ZINIRADIUSJ -! -!------------------------------------------------------------------------------- -! -! 1. initialisation - -!Calculations here are for one mode only -IF (CRGUNIT=="MASS") THEN - ZINIRADIUSI = XINIRADIUSI * EXP(-3.*(LOG(XINISIGI))**2) - ZINIRADIUSJ = XINIRADIUSJ * EXP(-3.*(LOG(XINISIGJ))**2) -ELSE - ZINIRADIUSI = XINIRADIUSI - ZINIRADIUSJ = XINIRADIUSJ -END IF - - -!Get minimum values possible -ZPMIN(1) = XN0IMIN -ZPMIN(2) = ZPMIN(1) * (ZINIRADIUSI**3)*EXP(4.5 * LOG(XINISIGI)**2) -ZPMIN(3) = ZPMIN(1) * (ZINIRADIUSI**6)*EXP(18. * LOG(XINISIGI)**2) -ZPMIN(4) = XN0JMIN -ZPMIN(5) = ZPMIN(4) * (ZINIRADIUSJ**3)*EXP(4.5 * LOG(XINISIGJ)**2) -ZPMIN(6) = ZPMIN(4) * (ZINIRADIUSJ**6)*EXP(18. * LOG(XINISIGJ)**2) - -ALLOCATE (ZM(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3), JPMODE*3)) - -!Set molecular weightn g/mol -IF(PRESENT(PMI)) THEN - ZMI(:,:,:,:) = PMI(:,:,:,:) -ELSE - ZMI(:,:,:,:) = 250. - ZMI(:,:,:,JP_AER_SO4) = 98. - ZMI(:,:,:,JP_AER_NO3) = 63. - ZMI(:,:,:,JP_AER_NH3) = 17. - ZMI(:,:,:,JP_AER_H2O) = 18. - ZMI(:,:,:,JP_AER_BC) = 12. - ZMI(:,:,:,JP_AER_DST) = 100. - IF (NSOA .EQ. 10) THEN - ZMI(:,:,:,JP_AER_SOA1) = 88. - ZMI(:,:,:,JP_AER_SOA2) = 180. - ZMI(:,:,:,JP_AER_SOA3) = 1.5374857E2 - ZMI(:,:,:,JP_AER_SOA4) = 1.9586780E2 - ZMI(:,:,:,JP_AER_SOA5) = 195. - ZMI(:,:,:,JP_AER_SOA6) = 195. - ZMI(:,:,:,JP_AER_SOA7) = 165. - ZMI(:,:,:,JP_AER_SOA8) = 195. - ZMI(:,:,:,JP_AER_SOA9) = 270. - ZMI(:,:,:,JP_AER_SOA10) = 210. - END IF -ENDIF - -! conversion into mol.cm-3 -ZDEN2MOL = 1E-6 * XAVOGADRO / XMD -DO JJ=1, SIZE(PSVT, 4) - PSVT(:,:,:,JJ) = PSVT(:,:,:,JJ) * ZDEN2MOL * PRHODREF(:,:,:) -ENDDO -! -DO JJ=1,NSP+NCARB+NSOA - ZFAC(JJ)=(4./3.)*XPI*ZRHOI(JJ)*1.e-9 -ENDDO -! -! -!* 2 transfer aerosol mass from gas to aerosol variables -! (and conversion of mol.cm-3 --> microgram/m3) -! -ZCTOTA(:,:,:,:,:) = 0. -! aerosol phase - ZCTOTA(:,:,:,JP_AER_SO4,1) = PSVT(:,:,:,JP_CH_SO4i)*ZMI(:,:,:,JP_AER_SO4)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SO4,2) = PSVT(:,:,:,JP_CH_SO4j)*ZMI(:,:,:,JP_AER_SO4)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_NO3,1) = PSVT(:,:,:,JP_CH_NO3i)*ZMI(:,:,:,JP_AER_NO3)/6.0221367E+11 - - ZCTOTA(:,:,:,JP_AER_NO3,2) = PSVT(:,:,:,JP_CH_NO3j)*ZMI(:,:,:,JP_AER_NO3)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_NH3,1) = PSVT(:,:,:,JP_CH_NH3i)*ZMI(:,:,:,JP_AER_NH3)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_NH3,2) = PSVT(:,:,:,JP_CH_NH3j)*ZMI(:,:,:,JP_AER_NH3)/6.0221367E+11 -! -! water - ZCTOTA(:,:,:,JP_AER_H2O,1) = PSVT(:,:,:,JP_CH_H2Oi)*ZMI(:,:,:,JP_AER_H2O)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_H2O,2) = PSVT(:,:,:,JP_CH_H2Oj)*ZMI(:,:,:,JP_AER_H2O)/6.0221367E+11 -! -! primary organic carbon - ZCTOTA(:,:,:,JP_AER_OC,1) = PSVT(:,:,:,JP_CH_OCi)*ZMI(:,:,:,JP_AER_OC)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_OC,2) = PSVT(:,:,:,JP_CH_OCj)*ZMI(:,:,:,JP_AER_OC)/6.0221367E+11 -! -! primary black carbon - ZCTOTA(:,:,:,JP_AER_BC,1) = PSVT(:,:,:,JP_CH_BCi)*ZMI(:,:,:,JP_AER_BC)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_BC,2) = PSVT(:,:,:,JP_CH_BCj)*ZMI(:,:,:,JP_AER_BC)/6.0221367E+11 -!dust - ZCTOTA(:,:,:,JP_AER_DST,1) = PSVT(:,:,:,JP_CH_DSTi)*ZMI(:,:,:,JP_AER_DST)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_DST,2) = PSVT(:,:,:,JP_CH_DSTj)*ZMI(:,:,:,JP_AER_DST)/6.0221367E+11 -! - IF (NSOA .EQ. 10) THEN - ZCTOTA(:,:,:,JP_AER_SOA1,1) = PSVT(:,:,:,JP_CH_SOA1i)*ZMI(:,:,:,JP_AER_SOA1)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA1,2) = PSVT(:,:,:,JP_CH_SOA1j)*ZMI(:,:,:,JP_AER_SOA1)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA2,1) = PSVT(:,:,:,JP_CH_SOA2i)*ZMI(:,:,:,JP_AER_SOA2)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA2,2) = PSVT(:,:,:,JP_CH_SOA2j)*ZMI(:,:,:,JP_AER_SOA2)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA3,1) = PSVT(:,:,:,JP_CH_SOA3i)*ZMI(:,:,:,JP_AER_SOA3)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA3,2) = PSVT(:,:,:,JP_CH_SOA3j)*ZMI(:,:,:,JP_AER_SOA3)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA4,1) = PSVT(:,:,:,JP_CH_SOA4i)*ZMI(:,:,:,JP_AER_SOA4)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA4,2) = PSVT(:,:,:,JP_CH_SOA4j)*ZMI(:,:,:,JP_AER_SOA4)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA5,1) = PSVT(:,:,:,JP_CH_SOA5i)*ZMI(:,:,:,JP_AER_SOA5)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA5,2) = PSVT(:,:,:,JP_CH_SOA5j)*ZMI(:,:,:,JP_AER_SOA5)/6.0221367E+11 - - ZCTOTA(:,:,:,JP_AER_SOA6,1) = PSVT(:,:,:,JP_CH_SOA6i)*ZMI(:,:,:,JP_AER_SOA6)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA6,2) = PSVT(:,:,:,JP_CH_SOA6j)*ZMI(:,:,:,JP_AER_SOA6)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA7,1) = PSVT(:,:,:,JP_CH_SOA7i)*ZMI(:,:,:,JP_AER_SOA7)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA7,2) = PSVT(:,:,:,JP_CH_SOA7j)*ZMI(:,:,:,JP_AER_SOA7)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA8,1) = PSVT(:,:,:,JP_CH_SOA8i)*ZMI(:,:,:,JP_AER_SOA8)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA8,2) = PSVT(:,:,:,JP_CH_SOA8j)*ZMI(:,:,:,JP_AER_SOA8)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA9,1) = PSVT(:,:,:,JP_CH_SOA9i)*ZMI(:,:,:,JP_AER_SOA9)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA9,2) = PSVT(:,:,:,JP_CH_SOA9j)*ZMI(:,:,:,JP_AER_SOA9)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA10,1) = PSVT(:,:,:,JP_CH_SOA10i)*ZMI(:,:,:,JP_AER_SOA10)/6.0221367E+11 - ZCTOTA(:,:,:,JP_AER_SOA10,2) = PSVT(:,:,:,JP_CH_SOA10j)*ZMI(:,:,:,JP_AER_SOA10)/6.0221367E+11 - END IF - -! -!* 3 calculate moment 3 from total aerosol mass -! - ZM(:,:,:,2) = 0. - ZM(:,:,:,5) = 0. - DO JJ = 1,NSP+NCARB+NSOA - ZM(:,:,:,2) = ZM(:,:,:,2)+ZCTOTA(:,:,:,JJ,1)/ZFAC(JJ) - ZM(:,:,:,5) = ZM(:,:,:,5)+ZCTOTA(:,:,:,JJ,2)/ZFAC(JJ) - ENDDO -! ZM(:,:,:,2) = MAX(ZM(:,:,:,2), ZPMIN(2)) -! ZM(:,:,:,5) = MAX(ZM(:,:,:,5), ZPMIN(5)) -! -! -!* 4 calculate moment 0 from dispersion and mean radius -! - ZM(:,:,:,1)= ZM(:,:,:,2)/ & - ( (PRG3D(:,:,:,1)**3)*EXP(4.5 * LOG(PSIG3D(:,:,:,1))**2) ) - ZM(:,:,:,4)= ZM(:,:,:,5)/ & - ( (PRG3D(:,:,:,2)**3)*EXP(4.5 * LOG(PSIG3D(:,:,:,2))**2) ) -! - -!* 5 calculate moment 6 from dispersion and mean radius -! - ZM(:,:,:,3) = ZM(:,:,:,1)*(PRG3D(:,:,:,1)**6) * & - EXP(18 *(LOG(PSIG3D(:,:,:,1)))**2) - ZM(:,:,:,6) = ZM(:,:,:,4)*(PRG3D(:,:,:,2)**6) * & - EXP(18 *(LOG(PSIG3D(:,:,:,2)))**2) - -!* 6 return to ppp -! -PSVT(:,:,:,JP_CH_M0i) = ZM(:,:,:,1) * 1E-6 -PSVT(:,:,:,JP_CH_M0j) = ZM(:,:,:,4) * 1E-6 - -IF (LVARSIGI) PSVT(:,:,:,JP_CH_M6i) = ZM(:,:,:,3) -IF (LVARSIGJ) PSVT(:,:,:,JP_CH_M6j) = ZM(:,:,:,6) - -DO JJ=1,SIZE(PSVT,4) - PSVT(:,:,:,JJ) = PSVT(:,:,:,JJ) / (ZDEN2MOL * PRHODREF(:,:,:)) -ENDDO - -DEALLOCATE(ZM) -! -END SUBROUTINE AERO2PPP -! -! ############################################################ - SUBROUTINE PPP2AERO1D( & - PSVT & !I [ppp] input scalar variables (moment of distribution) - , PRHODREF & !I [kg/m3] density of air - , PMI & !O molecular weight - , PSIG1D & !O [-] standard deviation of aerosol distribution - , PRG1D & !O [um] number median diameter of aerosol distribution - , PN1D & !O [#/m3] number concentration of aerosols - , PCTOTA & !O [ug/m3] mass of each aerosol compounds - , PM1D & !moments 0, 3 and 6 - ) -! ############################################################ -! -!! -!! PURPOSE -!! ------- -!! Translate the three moments M0, M3 and M6 given in ppp into -!! Values which can be understood more easily (R, sigma, N, M) -!! -!! CALLING STRUCTURE NOTE: OPTIONAL VARIABLES -!! ------- -!! CALL PPP2AERO1D(PSVT, PRHODREF, PSIG1D=SIGVAR, & -!! PRG1D=RVAR, PN1D=NVAR, PM1D=ZM) -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Pierre TULET (LA) -!! -!! MODIFICATIONS -!! ------------- -!! Alf Grini (CNRM) -!! -!! EXTERNAL -!! -------- -!! - IMPLICIT NONE -!! -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -!* 0.1 declarations of arguments -! -REAL, DIMENSION(:,:), INTENT(IN) :: PSVT !I [#/molec_{air}] first moment - !I [molec_{aer}/molec_{air} 3rd moment - !I [um6/molec_{air}*(cm3/m3)] 6th moment -REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !I [kg/m3] density of air - -REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PMI ! molecular weight g/mol -REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PSIG1D !O [-] standard deviation -REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PRG1D !O [um] number median diameter -REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PN1D !O [#/m3] number concentration -REAL, DIMENSION(:,:,:),OPTIONAL, INTENT(OUT) :: PCTOTA !O [ug/m3] mass of each component -REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PM1D !O moments 0,3 and 6 -! -!* 0.2 declarations local variables -! -REAL, DIMENSION(SIZE(PSVT,1),NSP+NCARB+NSOA) :: ZMI ! [kg/mol] molar weight of aerosol -REAL,DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2)) :: ZSV ! [aerosol concentration] -REAL,DIMENSION(SIZE(PSVT,1)) :: ZSIGMA ! [-] standard deviation -REAL,DIMENSION(SIZE(PSVT,1),JPMODE) :: ZMASK -REAL,DIMENSION(SIZE(PSVT,1),NSP+NCARB+NSOA,JPMODE):: ZCTOTA -REAL,DIMENSION(SIZE(PSVT,1),JPMODE*3) :: ZM - -REAL,DIMENSION(NSP+NCARB+NSOA) :: ZFAC ! M3 / mass conversion factor -REAL,DIMENSION(NSP+NCARB+NSOA) :: ZRHOI ! aerosol density -REAL :: ZDEN2MOL -REAL,DIMENSION(JPMODE*3) :: ZPMIN ! [aerosol units] minimum values for N, sigma, M -REAL,DIMENSION(JPMODE) :: ZRATIOBC, ZRATIOOC -INTEGER :: JJ, JN ! [idx] loop counters -REAL :: ZINIRADIUSI, ZINIRADIUSJ -! -!------------------------------------------------------------------------------- -! -! 1. initialisation - -IF (CRGUNIT=="MASS") THEN - ZINIRADIUSI = XINIRADIUSI * EXP(-3.*(LOG(XINISIGI))**2) - ZINIRADIUSJ = XINIRADIUSJ * EXP(-3.*(LOG(XINISIGJ))**2) -ELSE - ZINIRADIUSI = XINIRADIUSI - ZINIRADIUSJ = XINIRADIUSJ -END IF - - - - !Get minimum values possible - ZPMIN(1) = XN0IMIN - ZPMIN(2) = ZPMIN(1) * (ZINIRADIUSI**3)*EXP(4.5 * LOG(XINISIGI)**2) - ZPMIN(3) = ZPMIN(1) * (ZINIRADIUSI**6)*EXP(18. * LOG(XINISIGI)**2) - - ZPMIN(4) = XN0JMIN - ZPMIN(5) = ZPMIN(4) * (ZINIRADIUSJ**3)*EXP(4.5 * LOG(XINISIGJ)**2) - ZPMIN(6) = ZPMIN(4) * (ZINIRADIUSJ**6)*EXP(18. * LOG(XINISIGJ)**2) - -!Set molecular weightn g/mol -IF(PRESENT(PMI)) THEN - ZMI(:,:) = PMI(:,:) -ELSE - ZMI(:,:) = 250. - ZMI(:,JP_AER_SO4) = 98. - ZMI(:,JP_AER_NO3) = 63. - ZMI(:,JP_AER_NH3) = 17. - ZMI(:,JP_AER_H2O) = 18. - ZMI(:,JP_AER_BC) = 12. - IF (NSOA .EQ. 10) THEN - ZMI(:,JP_AER_SOA1) = 88. - ZMI(:,JP_AER_SOA2) = 180. - ZMI(:,JP_AER_SOA3) = 1.5374857E2 - ZMI(:,JP_AER_SOA4) = 1.9586780E2 - ZMI(:,JP_AER_SOA5) = 195. - ZMI(:,JP_AER_SOA6) = 195. - ZMI(:,JP_AER_SOA7) = 165. - ZMI(:,JP_AER_SOA8) = 195. - ZMI(:,JP_AER_SOA9) = 270. - ZMI(:,JP_AER_SOA10) = 210. - END IF -ENDIF - -! conversion into mol.cm-3 -ZDEN2MOL = 1E-6 * XAVOGADRO / XMD -! -DO JJ=1, SIZE(PSVT,2) - ZSV(:,JJ) = PSVT(:,JJ) * ZDEN2MOL * PRHODREF(:) -ENDDO -! -DO JJ=1,NSP+NCARB+NSOA - ZFAC(JJ)=(4./3.)*XPI*ZRHOI(JJ)*1.e-9 -ENDDO -! -!------------------------------------------------------------------------------- -! -!* 2 transfer aerosol mass from gas to aerosol variables -! (and conversion of mol.cm-3 --> microgram/m3) -! -ZCTOTA(:,:,:) = 0. -! aerosol phase - ZCTOTA(:,JP_AER_SO4,1) = ZSV(:,JP_CH_SO4i)*ZMI(:,JP_AER_SO4)/6.0221367E+11 - ZCTOTA(:,JP_AER_SO4,2) = ZSV(:,JP_CH_SO4j)*ZMI(:,JP_AER_SO4)/6.0221367E+11 - - ZCTOTA(:,JP_AER_NO3,1) = ZSV(:,JP_CH_NO3i)*ZMI(:,JP_AER_NO3)/6.0221367E+11 - ZCTOTA(:,JP_AER_NO3,2) = ZSV(:,JP_CH_NO3j)*ZMI(:,JP_AER_NO3)/6.0221367E+11 - - ZCTOTA(:,JP_AER_NH3,1) = ZSV(:,JP_CH_NH3i)*ZMI(:,JP_AER_NH3)/6.0221367E+11 - ZCTOTA(:,JP_AER_NH3,2) = ZSV(:,JP_CH_NH3j)*ZMI(:,JP_AER_NH3)/6.0221367E+11 -! -! water - ZCTOTA(:,JP_AER_H2O,1) = ZSV(:,JP_CH_H2Oi)*ZMI(:,JP_AER_H2O)/6.0221367E+11 - ZCTOTA(:,JP_AER_H2O,2) = ZSV(:,JP_CH_H2Oj)*ZMI(:,JP_AER_H2O)/6.0221367E+11 -! -! primary organic carbon - ZCTOTA(:,JP_AER_OC,1) = ZSV(:,JP_CH_OCi)*ZMI(:,JP_AER_OC)/6.0221367E+11 - ZCTOTA(:,JP_AER_OC,2) = ZSV(:,JP_CH_OCj)*ZMI(:,JP_AER_OC)/6.0221367E+11 -! -! primary black carbon - ZCTOTA(:,JP_AER_BC,1) = ZSV(:,JP_CH_BCi)*ZMI(:,JP_AER_BC)/6.0221367E+11 - ZCTOTA(:,JP_AER_BC,2) = ZSV(:,JP_CH_BCj)*ZMI(:,JP_AER_BC)/6.0221367E+11 -! -IF (NSOA .EQ. 10) THEN - ZCTOTA(:,JP_AER_SOA1,1) = ZSV(:,JP_CH_SOA1i)*ZMI(:,JP_AER_SOA1)/6.0221367E+11 - ZCTOTA(:,JP_AER_SOA1,2) = ZSV(:,JP_CH_SOA1j)*ZMI(:,JP_AER_SOA1)/6.0221367E+11 - ZCTOTA(:,JP_AER_SOA2,1) = ZSV(:,JP_CH_SOA2i)*ZMI(:,JP_AER_SOA2)/6.0221367E+11 - ZCTOTA(:,JP_AER_SOA2,2) = ZSV(:,JP_CH_SOA2j)*ZMI(:,JP_AER_SOA2)/6.0221367E+11 - ZCTOTA(:,JP_AER_SOA3,1) = ZSV(:,JP_CH_SOA3i)*ZMI(:,JP_AER_SOA3)/6.0221367E+11 - ZCTOTA(:,JP_AER_SOA3,2) = ZSV(:,JP_CH_SOA3j)*ZMI(:,JP_AER_SOA3)/6.0221367E+11 - ZCTOTA(:,JP_AER_SOA4,1) = ZSV(:,JP_CH_SOA4i)*ZMI(:,JP_AER_SOA4)/6.0221367E+11 - ZCTOTA(:,JP_AER_SOA4,2) = ZSV(:,JP_CH_SOA4j)*ZMI(:,JP_AER_SOA4)/6.0221367E+11 - ZCTOTA(:,JP_AER_SOA5,1) = ZSV(:,JP_CH_SOA5i)*ZMI(:,JP_AER_SOA5)/6.0221367E+11 - ZCTOTA(:,JP_AER_SOA5,2) = ZSV(:,JP_CH_SOA5j)*ZMI(:,JP_AER_SOA5)/6.0221367E+11 - - ZCTOTA(:,JP_AER_SOA6,1) = ZSV(:,JP_CH_SOA6i)*ZMI(:,JP_AER_SOA6)/6.0221367E+11 - ZCTOTA(:,JP_AER_SOA6,2) = ZSV(:,JP_CH_SOA6j)*ZMI(:,JP_AER_SOA6)/6.0221367E+11 - ZCTOTA(:,JP_AER_SOA7,1) = ZSV(:,JP_CH_SOA7i)*ZMI(:,JP_AER_SOA7)/6.0221367E+11 - ZCTOTA(:,JP_AER_SOA7,2) = ZSV(:,JP_CH_SOA7j)*ZMI(:,JP_AER_SOA7)/6.0221367E+11 - ZCTOTA(:,JP_AER_SOA8,1) = ZSV(:,JP_CH_SOA8i)*ZMI(:,JP_AER_SOA8)/6.0221367E+11 - ZCTOTA(:,JP_AER_SOA8,2) = ZSV(:,JP_CH_SOA8j)*ZMI(:,JP_AER_SOA8)/6.0221367E+11 - ZCTOTA(:,JP_AER_SOA9,1) = ZSV(:,JP_CH_SOA9i)*ZMI(:,JP_AER_SOA9)/6.0221367E+11 - ZCTOTA(:,JP_AER_SOA9,2) = ZSV(:,JP_CH_SOA9j)*ZMI(:,JP_AER_SOA9)/6.0221367E+11 - ZCTOTA(:,JP_AER_SOA10,1) = ZSV(:,JP_CH_SOA10i)*ZMI(:,JP_AER_SOA10)/6.0221367E+11 - ZCTOTA(:,JP_AER_SOA10,2) = ZSV(:,JP_CH_SOA10j)*ZMI(:,JP_AER_SOA10)/6.0221367E+11 -END IF -! -!------------------------------------------------------------------------------- -! -!* 3 calculate moment 3 from total aerosol mass -! -ZM(:,2) = 0. -ZM(:,5) = 0. -DO JJ = 1,NSP+NCARB+NSOA - ZM(:,2) = ZM(:,2)+ZCTOTA(:,JJ,1)/ZFAC(JJ) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment) - ZM(:,5) = ZM(:,5)+ZCTOTA(:,JJ,2)/ZFAC(JJ) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment) -ENDDO -! -!------------------------------------------------------------------------------- -! -!* 4 set moment 0 -! - ZM(:,1)= MAX(ZSV(:,JP_CH_M0i) * 1E+6, XMNH_TINY) ! molec_{aer}/m3_{air} - ZM(:,4)= MAX(ZSV(:,JP_CH_M0j) * 1E+6, XMNH_TINY) ! molec_{aer}/m3_{air} -! -!------------------------------------------------------------------------------- -! -!* 5 set moment 6 ==> um6_{aer}/m3_{air} -! -IF (LVARSIGI) THEN ! set M6 variable standard deviation - ZM(:,3) = MAX(ZSV(:,JP_CH_M6i), XMNH_TINY) - - ZSIGMA(:)=ZM(:,2)**2/(ZM(:,1)*ZM(:,3)) - ZSIGMA(:)=MIN(1-1E-10,ZSIGMA(:)) - ZSIGMA(:)=MAX(1E-10,ZSIGMA(:)) - ZSIGMA(:)= LOG(ZSIGMA(:)) - ZSIGMA(:)= EXP(1./3.*SQRT(-ZSIGMA(:))) - WHERE (ZSIGMA(:) > XSIGIMAX) - ZSIGMA(:) = XSIGIMAX - END WHERE - WHERE (ZSIGMA(:) < XSIGIMIN) - ZSIGMA(:) = XSIGIMIN - END WHERE - ZM(:,3) = ZM(:,1) & - * ( (ZM(:,2)/ZM(:,1))**(1./3.) & - * exp(-(3./2.)*log(ZSIGMA(:))**2))**6 & - * exp(18.*log(ZSIGMA(:))**2) - - IF(PRESENT(PSIG1D)) PSIG1D(:,1) = ZSIGMA(:) - -ELSE ! fixed standard deviation - ZM(:,3) = ZM(:,1) & - * ( (ZM(:,2)/ZM(:,1))**(1./3.) & - * exp(-(3./2.)*log(XINISIGI)**2))**6 & - * exp(18.*log(XINISIGI)**2) - - IF(PRESENT(PSIG1D)) PSIG1D(:,1) = XINISIGI -END IF - -IF (LVARSIGJ) THEN ! set M6 variable standard deviation - ZM(:,6) = MAX(ZSV(:,JP_CH_M6j), XMNH_TINY) - - ZSIGMA(:)=ZM(:,5)**2/(ZM(:,4)*ZM(:,6)) - ZSIGMA(:)=MIN(1-1E-10,ZSIGMA(:)) - ZSIGMA(:)=MAX(1E-10,ZSIGMA(:)) - ZSIGMA(:)= LOG(ZSIGMA(:)) - ZSIGMA(:)= EXP(1./3.*SQRT(-ZSIGMA(:))) - WHERE (ZSIGMA(:) > XSIGJMAX) - ZSIGMA(:) = XSIGJMAX - END WHERE - WHERE (ZSIGMA(:) < XSIGJMIN) - ZSIGMA(:) = XSIGJMIN - END WHERE - - ZM(:,6) = ZM(:,4) & - * ( (ZM(:,5)/ZM(:,4))**(1./3.) & - * exp(-(3./2.)*log(ZSIGMA(:))**2))**6 & - * exp(18.*log(ZSIGMA(:))**2) - - IF(PRESENT(PSIG1D)) PSIG1D(:,2) = ZSIGMA(:) - -ELSE ! fixed standard deviation - ZM(:,6) = ZM(:,4) & - * ( (ZM(:,5)/ZM(:,4))**(1./3.) & - * exp(-(3./2.)*log(XINISIGJ)**2))**6 & - * exp(18.*log(XINISIGJ)**2) - - IF(PRESENT(PSIG1D)) PSIG1D(:,2) = XINISIGJ -END IF - - -!------------------------------------------------------------------------------- -! -!* 6 calculate modal parameters from moments -! -DO JN=1,JPMODE -!************************************************************* -! Blindages pour valeurs inferieurs au mininmum accepte -!************************************************************* - ZMASK(:,JN) = 1. - WHERE ((ZM(:,NM0(JN)) .LT. ZPMIN(NM0(JN))).OR.& - (ZM(:,NM3(JN)) .LT. ZPMIN(NM3(JN))).OR.& - (ZM(:,NM6(JN)) .LT. ZPMIN(NM6(JN)))) - - ZM(:,NM0(JN)) = ZPMIN(NM0(JN)) - ZM(:,NM3(JN)) = ZPMIN(NM3(JN)) - ZM(:,NM6(JN)) = ZPMIN(NM6(JN)) - - ZMASK(:,JN) = 0. - END WHERE - DO JJ=1,NSP+NCARB+NSOA - ZCTOTA(:,JJ,JN) = ZCTOTA(:,JJ,JN) * ZMASK(:,JN) - ENDDO - WHERE (ZMASK(:,JN) == 0.) - ZCTOTA(:,JP_AER_BC,JN) = 0.5 * ZPMIN(NM3(JN)) * ZFAC(JP_AER_BC) - ZCTOTA(:,JP_AER_OC,JN) = 0.5 * ZPMIN(NM3(JN)) * ZFAC(JP_AER_OC) - END WHERE - ! - IF(PRESENT(PN1D)) PN1D(:,JN) = ZM(:,NM0(JN)) - - IF(PRESENT(PRG1D)) PRG1D(:,JN)=(ZM(:,NM3(JN))**4. & - / (ZM(:,NM6(JN))*ZM(:,NM0(JN))**3.))**(1./6.) - -ENDDO -! -IF(PRESENT(PCTOTA)) PCTOTA(:,:,:) = ZCTOTA(:,:,:) -IF(PRESENT(PM1D)) PM1D(:,:) = ZM(:,:) -! -! -END SUBROUTINE PPP2AERO1D -! -! -END MODULE MODE_AERO_PSD diff --git a/src/ICCARE_BASE/mode_dust_psd.f90 b/src/ICCARE_BASE/mode_dust_psd.f90 deleted file mode 100644 index 016abf4f5..000000000 --- a/src/ICCARE_BASE/mode_dust_psd.f90 +++ /dev/null @@ -1,826 +0,0 @@ -!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence -!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!ORILAM_LIC for details. -!----------------------------------------------------------------- -!--------------- special set of characters for RCS information -!----------------------------------------------------------------- -! $Source$ $Revision$ $Date$ -!----------------------------------------------------------------- -!! ######################## - MODULE MODE_DUST_PSD -!! ######################## -!! -!! PURPOSE -!! ------- -!! MODULE DUST PSD (Particle Size Distribution) -!! Purpose: Contains subroutines to convert from transported variables (ppp) -!! to understandable aerosol variables, e.g. #/m3, kg/m3, sigma, R_{n} -!! -!! AUTHOR -!! ------ -!! Alf Grini (CNRM/GMEI) -!! -!! MODIFICATIONS -!! ------------- -!! -!------------------------------------------------------------------------------- -! -USE MODD_CSTS_DUST !Constants which are important for dust calculations -USE MODD_DUST !Dust module which contains even more constants -USE MODD_CST, ONLY : & - XPI & !Definition of pi - ,XBOLTZ & ! Boltzman constant - ,XAVOGADRO & ![molec/mol] avogadros number - ,XG & ! Gravity constant - ,XP00 & ! Reference pressure - ,XMD & ![kg/mol] molar weight of air - ,XRD & ! Gaz constant for dry air - ,XCPD ! Cpd (dry air) -USE MODD_CST, ONLY : XMNH_TINY -! -IMPLICIT NONE -! -CONTAINS -! -!! ############################################################ - SUBROUTINE PPP2DUST( & - PSVT & !I [ppp] input scalar variables (moment of distribution) - , PRHODREF & !I [kg/m3] density of air - , PSIG3D & !O [-] standard deviation of aerosol distribution - , PRG3D & !O [um] number median diameter of aerosol distribution - , PN3D & !O [#/m3] number concentration of aerosols - , PMASS3D & !O [kg/m3] mass concentration of aerosol - , PM3D & !O aerosols moments 0, 3 and 6 - ) -!! ############################################################ -! -!! -!! PURPOSE -!! ------- -!! Translate the three moments M0, M3 and M6 given in ppp into -!! Values which can be understood more easily (R, sigma, N, M) -!! -!! CALLING STRUCTURE NOTE: OPTIONAL VARIABLES -!! ------- -!! CALL PPP2AEROS(PSVT, PRHODREF, PSIG3D=SIGVAR, & -!! PRG3D=RVAR, PN3D=NVAR, PM3D=MASSVAR) -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Pierre TULET (LA) -!! -!! MODIFICATIONS -!! ------------- -!! 2005 Alf Grini (CNRM) -!! 2006 Jean-Pierre Chaboureau (LA) -!! -!! EXTERNAL -!! -------- -!! None -!! - IMPLICIT NONE -!! -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -!* 0.1 declarations of arguments -! -REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT !I [ppp] first moment -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF !I [kg/m3] density of air - -REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PSIG3D !O [-] standard deviation -REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PRG3D !O [um] number median diameter -REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PN3D !O [#/m3] number concentration -REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PMASS3D !O [kg_{aer}/m3] mass concentration -REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PM3D !O aerosols moments -! -! -!* 0.2 declarations local variables -! -REAL :: ZRHOI ! [kg/m3] density of aerosol -REAL :: ZMI ! [kg/mol] molar weight of aerosol -REAL :: ZRGMIN ! [um] minimum radius accepted -REAL :: ZSIGMIN ! minimum standard deviation accepted -REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZM ! [aerosol units] local array which goes to output later -REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZSV ! [dusts moment concentration] -REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZSIGMA ! [-] standard deviation -REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZRG ! [um] number median diameter -REAL,DIMENSION(:), ALLOCATABLE :: ZMMIN ! [aerosol units] minimum values for N, sigma, M -INTEGER,DIMENSION(:), ALLOCATABLE :: NM0 ! [idx] index for Mode 0 in passed variables -INTEGER,DIMENSION(:), ALLOCATABLE :: NM3 ! [idx] indexes for Mode 3 in passed variables -INTEGER,DIMENSION(:), ALLOCATABLE :: NM6 ! [idx] indexes for Mode 6 in passed variables -REAL,DIMENSION(:), ALLOCATABLE :: ZINIRADIUS ! initial mean radius -INTEGER :: JN,IMODEIDX,JJ ! [idx] loop counters -! -!------------------------------------------------------------------------------- -! -! 1.1 initialisation -! -!Calculations here are for one mode only -! -ALLOCATE (NM0(NMODE_DST)) -ALLOCATE (NM3(NMODE_DST)) -ALLOCATE (NM6(NMODE_DST)) -ALLOCATE (ZM(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3), NMODE_DST*3)) -ALLOCATE (ZMMIN(NMODE_DST*3)) -ALLOCATE (ZSIGMA(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3))) -ALLOCATE (ZRG(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3))) -ALLOCATE (ZSV(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3), SIZE(PSVT,4))) -ALLOCATE (ZINIRADIUS(NMODE_DST)) - -!ZSV(:,:,:,:) = MAX(PSVT(:,:,:,:), XMNH_TINY) -ZSV(:,:,:,:) = PSVT(:,:,:,:) - -DO JN=1,NMODE_DST - IMODEIDX = JPDUSTORDER(JN) - !Calculations here are for one mode only - IF (CRGUNITD=="MASS") THEN - ZINIRADIUS(JN) = XINIRADIUS(IMODEIDX) * EXP(-3.*(LOG(XINISIG(IMODEIDX)))**2) - ELSE - ZINIRADIUS(JN) = XINIRADIUS(IMODEIDX) - END IF - - !Set counter for number, M3 and M6 - NM0(JN) = 1+(JN-1)*3 - NM3(JN) = 2+(JN-1)*3 - NM6(JN) = 3+(JN-1)*3 - !Get minimum values possible - ZMMIN(NM0(JN)) = XN0MIN(IMODEIDX) - ZRGMIN = ZINIRADIUS(JN) - IF (LVARSIG) THEN -! ZSIGMIN = XSIGMIN - ZSIGMIN = XINISIG(IMODEIDX) - ELSE - ZSIGMIN = XINISIG(IMODEIDX) - ENDIF - ZMMIN(NM3(JN)) = ZMMIN(NM0(JN)) * (ZRGMIN**3)*EXP(4.5 * LOG(ZSIGMIN)**2) - ZMMIN(NM6(JN)) = ZMMIN(NM0(JN)) * (ZRGMIN**6)*EXP(18. * LOG(ZSIGMIN)**2) -END DO -! -!Set density of aerosol, here dust (kg/m3) -ZRHOI = XDENSITY_DUST -!Set molecular weight of dust !NOTE THAT THIS IS NOW IN KG -ZMI = XMOLARWEIGHT_DUST -! -! -DO JN=1,NMODE_DST - ! - IF (LVARSIG) THEN ! give M6 (case of variable standard deviation) - ! - !Get number concentration (#/molec_{air}==>#/m3) - ZM(:,:,:,NM0(JN))= & - ZSV(:,:,:,1+(JN-1)*3) & !#/molec_{air} - * XAVOGADRO & !==>#/mole - / XMD & !==>#/kg_{air} - * PRHODREF(:,:,:) !==>#/m3 - ! - !calculate moment 3 from total aerosol mass (molec_{aer}/molec_{air} ==> - ZM(:,:,:,NM3(JN)) = & - ZSV(:,:,:,2+(JN-1)*3) & !molec_{aer}/molec_{aer} - * (ZMI/XMD) & !==>kg_{aer}/kg_{aer} - * PRHODREF(:,:,:) & !==>kg_{aer}/m3_{air} - * (1.d0/ZRHOI) & !==>m3_{aer}/m3_{air} - * XM3TOUM3 & !==>um3_{aer}/m3_{air} - / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment) - !Limit mass concentration to minimum value -! ZM(:,:,:,NM3(JN)) = MAX(ZM(:,:,:,NM3(JN)), ZMMIN(NM3(JN))) - ! - ZM(:,:,:,NM6(JN)) = ZSV(:,:,:,3+(JN-1)*3) & !um6/molec_{air}*(cm3/m3) - * 1.d-6 & !==> um6/molec_{air} - * XAVOGADRO & !==> um6/mole_{air} - / XMD & !==> um6/kg_{air} - * PRHODREF(:,:,:) !==> um6/m3_{air} - !Limit m6 concentration to minimum value -! ZM(:,:,:,NM6(JN)) = MAX(ZM(:,:,:,NM6(JN)), ZMMIN(NM6(JN))) - ! - !Get sigma (only if sigma is allowed to vary) - !Get intermediate values for sigma M3^2/(M0*M6) (ORILAM paper, eqn 8) - ZSIGMA(:,:,:)=ZM(:,:,:,NM3(JN))**2/(ZM(:,:,:,NM0(JN))*ZM(:,:,:,NM6(JN))) - !Limit the intermediate value, can not be larger than 1 - ZSIGMA(:,:,:)=MIN(1-1E-10,ZSIGMA(:,:,:)) - !Limit the value for intermediate, can not be smaller than 0 - ZSIGMA(:,:,:)=MAX(1E-10,ZSIGMA(:,:,:)) - !Calculate log(sigma) - ZSIGMA(:,:,:)= LOG(ZSIGMA(:,:,:)) - !Finally get the real sigma the negative sign is because of - !The way the equation is written (M3^2/(M0*M6)) instead of (M0*M6)/M3^3 - ZSIGMA(:,:,:)= EXP(1./3.*SQRT(-ZSIGMA(:,:,:))) - !Limit the value to reasonable ones - ZSIGMA(:,:,:) = MAX( XSIGMIN, MIN( XSIGMAX, ZSIGMA(:,:,:) ) ) - - ! - !Put back M6 so that it fits the sigma which is possibly modified above - !The following makes M6 consistent with N, R, SIGMA - ZM(:,:,:,NM6(JN)) = ZM(:,:,:,NM0(JN)) & - * ( (ZM(:,:,:,NM3(JN))/ZM(:,:,:,NM0(JN)))**(1./3.) & - * exp(-(3./2.)*log(ZSIGMA(:,:,:))**2))**6 & - * exp(18.*log(ZSIGMA(:,:,:))**2) - - ELSE ! compute M6 from M0, M3 and SIGMA - ! - ZSIGMA(:,:,:) = XINISIG(JPDUSTORDER(JN)) - - IF (LRGFIX_DST) THEN - !calculate moment 3 from total aerosol mass (molec_{aer}/molec_{air} ==> - ZM(:,:,:,NM3(JN)) = & - ZSV(:,:,:,JN) & !molec_{aer}/molec_{aer} - * (ZMI/XMD) & !==>kg_{aer}/kg_{aer} - * PRHODREF(:,:,:) & !==>kg_{aer}/m3_{air} - * (1.d0/ZRHOI) & !==>m3_{aer}/m3_{air} - * XM3TOUM3 & !==>um3_{aer}/m3_{air} - / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment) - -! ZM(:,:,:,NM3(JN)) = MAX(ZM(:,:,:,NM3(JN)), ZMMIN(NM3(JN))) - - ZM(:,:,:,NM0(JN))= ZM(:,:,:,NM3(JN))/& - ((ZINIRADIUS(JN)**3)*EXP(4.5 * LOG(XINISIG(JPDUSTORDER(JN)))**2)) - - ELSE - !calculate moment 3 from total aerosol mass (molec_{aer}/molec_{air} ==> - ZM(:,:,:,NM3(JN)) = & - ZSV(:,:,:,2+(JN-1)*2) & !molec_{aer}/molec_{aer} - * (ZMI/XMD) & !==>kg_{aer}/kg_{aer} - * PRHODREF(:,:,:) & !==>kg_{aer}/m3_{air} - * (1.d0/ZRHOI) & !==>m3_{aer}/m3_{air} - * XM3TOUM3 & !==>um3_{aer}/m3_{air} - / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment) - - !Get number concentration (#/molec_{air}==>#/m3) - ZM(:,:,:,NM0(JN))= & - ZSV(:,:,:,1+(JN-1)*2) & !#/molec_{air} - * XAVOGADRO & !==>#/mole - / XMD & !==>#/kg_{air} - * PRHODREF(:,:,:) !==>#/m3 - - ! Limit concentration to minimum values -! WHERE ((ZM(:,:,:,NM0(JN)) < ZMMIN(NM0(JN)) ).OR. & -! (ZM(:,:,:,NM3(JN)) < ZMMIN(NM3(JN)) )) -! ZM(:,:,:,NM0(JN)) = ZMMIN(NM0(JN)) -! ZM(:,:,:,NM3(JN)) = ZMMIN(NM3(JN)) -! PSVT(:,:,:,1+(JN-1)*2) = ZM(:,:,:,NM0(JN)) * XMD / & -! (XAVOGADRO * PRHODREF(:,:,:) ) -! PSVT(:,:,:,2+(JN-1)*2) = ZM(:,:,:,NM3(JN)) * XMD * XPI * 4./3. * ZRHOI / & -! (ZMI*PRHODREF(:,:,:)*XM3TOUM3) -! ENDWHERE - END IF - - ! - - ZM(:,:,:,NM6(JN)) = ZM(:,:,:,NM0(JN)) & - * ( (ZM(:,:,:,NM3(JN))/ZM(:,:,:,NM0(JN)))**(1./3.) & - * exp(-(3./2.)*log(ZSIGMA(:,:,:))**2))**6 & - * exp(18.*log(ZSIGMA(:,:,:))**2) - - ! - END IF - ! - !Get number median radius (eqn. 7 in Orilam manuscript) - ZRG(:,:,:)= & - ( & - ZM(:,:,:,NM3(JN))*ZM(:,:,:,NM3(JN))*ZM(:,:,:,NM3(JN))*ZM(:,:,:,NM3(JN)) & - /(ZM(:,:,:,NM6(JN))*ZM(:,:,:,NM0(JN))*ZM(:,:,:,NM0(JN))*ZM(:,:,:,NM0(JN))) & - ) & - ** XSIXTH - !Give the sigma-values to the passed array - IF(PRESENT(PSIG3D)) PSIG3D(:,:,:,JN) = ZSIGMA(:,:,:) - ! - !Set the number concentrations in the passed array - IF(PRESENT(PN3D)) PN3D(:,:,:,JN) = ZM(:,:,:,NM0(JN)) - ! - !Get the number median radius - IF(PRESENT(PRG3D)) PRG3D(:,:,:,JN)= ZRG(:,:,:) - ! - IF(PRESENT(PMASS3D))THEN - PMASS3D(:,:,:,JN)= & - ZM(:,:,:,NM0(JN)) & !#/m^3_{air} - * XPI*4./3. & - * ZRHOI & !==>kg/m^3_{aeros}/m^3_{air} - * ZRG(:,:,:) * ZRG(:,:,:) * ZRG(:,:,:) & - * XUM3TOM3 & !==>kg/m^3_{air} - * exp(4.5*log(ZSIGMA(:,:,:))*log(ZSIGMA(:,:,:))) - ENDIF -! -END DO !Loop on modes -! -IF(PRESENT(PM3D)) PM3D(:,:,:,:) = ZM(:,:,:,:) -! -DEALLOCATE(ZINIRADIUS) -DEALLOCATE(ZSV) -DEALLOCATE(ZRG) -DEALLOCATE(ZSIGMA) -DEALLOCATE(ZMMIN) -DEALLOCATE(ZM) -DEALLOCATE(NM6) -DEALLOCATE(NM3) -DEALLOCATE(NM0) -! -! -END SUBROUTINE PPP2DUST - -!! ############################################################ - SUBROUTINE DUST2PPP( & - PSVT & !IO [ppp] input scalar variables (moment of distribution) - , PRHODREF & !I [kg/m3] density of air - , PSIG3D & !I [-] standard deviation of aerosol distribution - , PRG3D & !I [um] number median diameter of aerosol distribution - ) -!! ############################################################ -! -!! -!! PURPOSE -!! ------- -!! Translate the dust Mass, RG and SIGMA in the three moments M0, M3 and M6 given in ppp -!! -!! CALLING STRUCTURE NOTE: OPTIONAL VARIABLES -!! ------- -!! CALL PPP2AEROS(PSVT, PRHODREF, PSIG3D=SIGVAR, & -!! PRG3D=RVAR, PN3D=NVAR) -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Pierre TULET (LA) -!! -!! MODIFICATIONS -!! ------------- -!! Alf Grini (CNRM) -!! -!! EXTERNAL -!! -------- -!! None -!! - IMPLICIT NONE -!! -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -!* 0.1 declarations of arguments -! - !INPUT - REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF !I [kg/m3] density of air - REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSIG3D !O [-] standard deviation - REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRG3D !O [um] number median diameter - - !OUTPUT - REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT !IO [#/molec_{air}] first moment - !IO [molec_{aer}/molec_{air} 3rd moment - !IO [um6/molec_{air}*(cm3/m3)] 6th moment -! -! -!* 0.2 declarations local variables -! - REAL :: ZRHOI ! [kg/m3] density of aerosol - REAL :: ZMI ! [kg/mol] molar weight of aerosol - REAL :: ZRGMIN ! [um] minimum radius accepted - REAL :: ZSIGMIN ! minimum standard deviation accepted - REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZM ! [aerosol units] local array which goes to output later - REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZSIGMA ! aersol standard deviation - REAL,DIMENSION(:), ALLOCATABLE :: ZMMIN ! [aerosol units] minimum values for N, sigma, M - REAL,DIMENSION(:), ALLOCATABLE :: ZINIRADIUS ! initial mean radius - INTEGER,DIMENSION(:), ALLOCATABLE :: NM0 ! [idx] index for Mode 0 in passed variables - INTEGER,DIMENSION(:), ALLOCATABLE :: NM3 ! [idx] indexes for Mode 3 in passed variables - INTEGER,DIMENSION(:), ALLOCATABLE :: NM6 ! [idx] indexes for Mode 6 in passed variables - INTEGER :: JJ, JN ! [idx] loop counters - INTEGER :: IMODEIDX -! -!------------------------------------------------------------------------------- -! -! 1.1 initialisation - - - ALLOCATE (NM0(NMODE_DST)) - ALLOCATE (NM3(NMODE_DST)) - ALLOCATE (NM6(NMODE_DST)) - ALLOCATE (ZINIRADIUS(NMODE_DST)) - ALLOCATE (ZMMIN(NMODE_DST*3)) - ALLOCATE (ZM(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3), NMODE_DST*3)) - ALLOCATE (ZSIGMA(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3))) - - !Set density of aerosol, here dust (kg/m3) - ZRHOI = XDENSITY_DUST - !Set molecular weight of dust !NOTE THAT THIS IS NOW IN KG - ZMI = XMOLARWEIGHT_DUST -! - - ! PSVT need to be positive -! PSVT(:,:,:,:) = MAX(PSVT(:,:,:,:), XMNH_TINY) - - DO JN=1,NMODE_DST - IMODEIDX = JPDUSTORDER(JN) - !Calculations here are for one mode only - IF (CRGUNITD=="MASS") THEN - ZINIRADIUS(JN) = XINIRADIUS(IMODEIDX) * EXP(-3.*(LOG(XINISIG(IMODEIDX)))**2) - ELSE - ZINIRADIUS(JN) = XINIRADIUS(IMODEIDX) - END IF - - !Set counter for number, M3 and M6 - NM0(JN) = 1+(JN-1)*3 - NM3(JN) = 2+(JN-1)*3 - NM6(JN) = 3+(JN-1)*3 - - !Get minimum values possible - ZMMIN(NM0(JN)) = XN0MIN(IMODEIDX) - ZRGMIN = ZINIRADIUS(JN) - IF (LVARSIG) THEN - ZSIGMIN = XINISIG(IMODEIDX) - ! ZSIGMIN = XSIGMIN - ELSE - ZSIGMIN = XINISIG(IMODEIDX) - ENDIF - ZMMIN(NM3(JN)) = ZMMIN(NM0(JN)) * (ZRGMIN**3)*EXP(4.5 * LOG(ZSIGMIN)**2) - ZMMIN(NM6(JN)) = ZMMIN(NM0(JN)) * (ZRGMIN**6)*EXP(18. * LOG(ZSIGMIN)**2) - END DO - - !Set density of aerosol, here dust (kg/m3) - ZRHOI = XDENSITY_DUST - !Set molecular weight of dust !NOTE THAT THIS IS NOW IN KG - ZMI = XMOLARWEIGHT_DUST -! - DO JN=1,NMODE_DST - !calculate moment 3 from total aerosol mass (molec_{aer}/molec_{air} ==> - IF (LVARSIG) THEN - ZM(:,:,:,NM3(JN)) = & - PSVT(:,:,:,2+(JN-1)*3) & !molec_{aer}/molec_{aer} - * (ZMI/XMD) & !==>kg_{aer}/kg_{aer} - * PRHODREF(:,:,:) & !==>kg_{aer}/m3_{air} - * (1.d0/ZRHOI) & !==>m3_{aer}/m3_{air} - * XM3TOUM3 & !==>um3_{aer}/m3_{air} - / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment) - ELSE - IF ((LRGFIX_DST)) THEN - ZM(:,:,:,NM3(JN)) = & - PSVT(:,:,:,JN) & !molec_{aer}/molec_{aer} - * (ZMI/XMD) & !==>kg_{aer}/kg_{aer} - * PRHODREF(:,:,:) & !==>kg_{aer}/m3_{air} - * (1.d0/ZRHOI) & !==>m3_{aer}/m3_{air} - * XM3TOUM3 & !==>um3_{aer}/m3_{air} - / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment) - ! ZM(:,:,:,NM3(JN)) = MAX(ZM(:,:,:,NM3(JN)), ZMMIN(NM3(JN))) - ELSE - ZM(:,:,:,NM3(JN)) = & - PSVT(:,:,:,2+(JN-1)*2) & !molec_{aer}/molec_{aer} - * (ZMI/XMD) & !==>kg_{aer}/kg_{aer} - * PRHODREF(:,:,:) & !==>kg_{aer}/m3_{air} - * (1.d0/ZRHOI) & !==>m3_{aer}/m3_{air} - * XM3TOUM3 & !==>um3_{aer}/m3_{air} - / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment) - END IF - END IF -! calculate moment 0 from dispersion and mean radius - ZM(:,:,:,NM0(JN))= ZM(:,:,:,NM3(JN))/& - ((PRG3D(:,:,:,JN)**3)*EXP(4.5 * LOG(PSIG3D(:,:,:,JN))**2)) - - -! calculate moment 6 from dispersion and mean radius - ZM(:,:,:,NM6(JN)) = ZM(:,:,:,NM0(JN)) * (PRG3D(:,:,:,JN)**6) * & - EXP(18 *(LOG(PSIG3D(:,:,:,JN)))**2) - -! IF (LVARSIG) THEN -! WHERE ((ZM(:,:,:,NM0(JN)) .LT. ZMMIN(NM0(JN))).OR.& -! (ZM(:,:,:,NM3(JN)) .LT. ZMMIN(NM3(JN))).OR.& -! (ZM(:,:,:,NM6(JN)) .LT. ZMMIN(NM6(JN)))) -! ZM(:,:,:,NM0(JN)) = ZMMIN(NM0(JN)) -! ZM(:,:,:,NM3(JN)) = ZMMIN(NM3(JN)) -! ZM(:,:,:,NM6(JN)) = ZMMIN(NM6(JN)) -! END WHERE -! -! ELSE IF (.NOT.(LRGFIX_DST)) THEN -! -! WHERE ((ZM(:,:,:,NM0(JN)) .LT. ZMMIN(NM0(JN))).OR.& -! (ZM(:,:,:,NM3(JN)) .LT. ZMMIN(NM3(JN)))) -! ZM(:,:,:,NM0(JN)) = ZMMIN(NM0(JN)) -! ZM(:,:,:,NM3(JN)) = ZMMIN(NM3(JN)) -! END WHERE -! ENDIF - - - ! return to concentration #/m3 => (#/molec_{air} - IF (LVARSIG) THEN - PSVT(:,:,:,1+(JN-1)*3) = ZM(:,:,:,NM0(JN)) * XMD / & - (XAVOGADRO*PRHODREF(:,:,:)) - - PSVT(:,:,:,2+(JN-1)*3) = ZM(:,:,:,NM3(JN)) * XMD * XPI * 4./3 * ZRHOI / & - (ZMI*PRHODREF(:,:,:)*XM3TOUM3) - - PSVT(:,:,:,3+(JN-1)*3) = ZM(:,:,:,NM6(JN)) * XMD / & - ( XAVOGADRO*PRHODREF(:,:,:) * 1.d-6) - ELSE IF (LRGFIX_DST) THEN - PSVT(:,:,:,JN) = ZM(:,:,:,NM3(JN)) * XMD * XPI * 4./3. * ZRHOI / & - (ZMI*PRHODREF(:,:,:)*XM3TOUM3) - ELSE - PSVT(:,:,:,1+(JN-1)*2) = ZM(:,:,:,NM0(JN)) * XMD / & - (XAVOGADRO*PRHODREF(:,:,:)) - - PSVT(:,:,:,2+(JN-1)*2) = ZM(:,:,:,NM3(JN)) * XMD * XPI * 4./3. * ZRHOI / & - (ZMI*PRHODREF(:,:,:)*XM3TOUM3) - END IF - -! - END DO !Loop on modes - -DEALLOCATE(ZINIRADIUS) -DEALLOCATE(ZMMIN) -DEALLOCATE(ZSIGMA) -DEALLOCATE(ZM) -DEALLOCATE(NM6) -DEALLOCATE(NM3) -DEALLOCATE(NM0) -! -END SUBROUTINE DUST2PPP -!! ############################################################ - SUBROUTINE PPP2DUST1D( & - PSVT & !I [ppp] input scalar variables (moment of distribution) - , PRHODREF & !I [kg/m3] density of air - , PSIG1D & !O [-] standard deviation of aerosol distribution - , PRG1D & !O [um] number median diameter of aerosol distribution - , PN1D & !O [#/m3] number concentration of aerosols - , PMASS1D & !O [kg/m3] mass concentration of aerosol - , PM1D & !O aerosols moments 0, 3 and 6 - ) -!! ############################################################ -! -!! -!! PURPOSE -!! ------- -!! Translate the three moments M0, M3 and M6 given in ppp into -!! Values which can be understood more easily (R, sigma, N, M) -!! -!! CALLING STRUCTURE NOTE: OPTIONAL VARIABLES -!! ------- -!! CALL PPP2AEROS(PSVT, PRHODREF, PSIG1D=SIGVAR, & -!! PRG1D=RVAR, PN1D=NVAR, PM1D=MASSVAR) -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Pierre TULET (LA) -!! -!! MODIFICATIONS -!! ------------- -!! 2005 Alf Grini (CNRM) -!! 2006 Jean-Pierre Chaboureau (LA) -!! -!! EXTERNAL -!! -------- -!! None -!! - IMPLICIT NONE -!! -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -!* 0.1 declarations of arguments -! -REAL, DIMENSION(:,:), INTENT(INOUT) :: PSVT !I [ppp] first moment -REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !I [kg/m3] density of air - -REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PSIG1D !O [-] standard deviation -REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PRG1D !O [um] number median diameter -REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PN1D !O [#/m3] number concentration -REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PMASS1D !O [kg_{aer}/m3] mass concentration -REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PM1D !O aerosols moments -! -! -!* 0.2 declarations local variables -! -REAL :: ZRHOI ! [kg/m3] density of aerosol -REAL :: ZMI ! [kg/mol] molar weight of aerosol -REAL :: ZRGMIN ! [um] minimum radius accepted -REAL :: ZSIGMIN ! minimum standard deviation accepted -REAL,DIMENSION(:,:), ALLOCATABLE :: ZM ! [aerosol units] local array which goes to output later -REAL,DIMENSION(:,:), ALLOCATABLE :: ZSV ! [dusts moment concentration] -REAL,DIMENSION(:), ALLOCATABLE :: ZSIGMA ! [-] standard deviation -REAL,DIMENSION(:), ALLOCATABLE :: ZRG ! [um] number median diameter -REAL,DIMENSION(:), ALLOCATABLE :: ZMMIN ! [aerosol units] minimum values for N, sigma, M -INTEGER,DIMENSION(:),ALLOCATABLE :: NM0 ! [idx] index for Mode 0 in passed variables -INTEGER,DIMENSION(:),ALLOCATABLE :: NM3 ! [idx] indexes for Mode 3 in passed variables -INTEGER,DIMENSION(:),ALLOCATABLE :: NM6 ! [idx] indexes for Mode 6 in passed variables -REAL,DIMENSION(:), ALLOCATABLE :: ZINIRADIUS ! initial mean radius -INTEGER :: JN,IMODEIDX,JJ ! [idx] loop counters -! -!------------------------------------------------------------------------------- -! -! 1.1 initialisation -! -!Calculations here are for one mode only -! -ALLOCATE (NM0(NMODE_DST)) -ALLOCATE (NM3(NMODE_DST)) -ALLOCATE (NM6(NMODE_DST)) -ALLOCATE (ZM(SIZE(PSVT,1), NMODE_DST*3)) -ALLOCATE (ZMMIN(NMODE_DST*3)) -ALLOCATE (ZSIGMA(SIZE(PSVT,1))) -ALLOCATE (ZRG(SIZE(PSVT,1))) -ALLOCATE (ZSV(SIZE(PSVT,1),SIZE(PSVT,2))) -ALLOCATE (ZINIRADIUS(NMODE_DST)) - -!ZSV(:,:) = MAX(PSVT(:,:), XMNH_TINY) -ZSV(:,:) = PSVT(:,:) - -DO JN=1,NMODE_DST - IMODEIDX = JPDUSTORDER(JN) - !Calculations here are for one mode only - IF (CRGUNITD=="MASS") THEN - ZINIRADIUS(JN) = XINIRADIUS(IMODEIDX) * EXP(-3.*(LOG(XINISIG(IMODEIDX)))**2) - ELSE - ZINIRADIUS(JN) = XINIRADIUS(IMODEIDX) - END IF - - !Set counter for number, M3 and M6 - NM0(JN) = 1+(JN-1)*3 - NM3(JN) = 2+(JN-1)*3 - NM6(JN) = 3+(JN-1)*3 - !Get minimum values possible - ZMMIN(NM0(JN)) = XN0MIN(IMODEIDX) - ZRGMIN = ZINIRADIUS(JN) - IF (LVARSIG) THEN - !ZSIGMIN = XSIGMIN - ZSIGMIN = XINISIG(IMODEIDX) - ELSE - ZSIGMIN = XINISIG(IMODEIDX) - ENDIF - ZMMIN(NM3(JN)) = ZMMIN(NM0(JN)) * (ZRGMIN**3)*EXP(4.5 * LOG(ZSIGMIN)**2) - ZMMIN(NM6(JN)) = ZMMIN(NM0(JN)) * (ZRGMIN**6)*EXP(18. * LOG(ZSIGMIN)**2) -END DO -! -!Set density of aerosol, here dust (kg/m3) -ZRHOI = XDENSITY_DUST -!Set molecular weight of dust !NOTE THAT THIS IS NOW IN KG -ZMI = XMOLARWEIGHT_DUST -! -! -DO JN=1,NMODE_DST - ! - IF (LVARSIG) THEN ! give M6 (case of variable standard deviation) - ! - !Get number concentration (#/molec_{air}==>#/m3) - ZM(:,NM0(JN))= & - ZSV(:,1+(JN-1)*3) & !#/molec_{air} - * XAVOGADRO & !==>#/mole - / XMD & !==>#/kg_{air} - * PRHODREF(:) !==>#/m3 - ! - !calculate moment 3 from total aerosol mass (molec_{aer}/molec_{air} ==> - ZM(:,NM3(JN)) = & - ZSV(:,2+(JN-1)*3) & !molec_{aer}/molec_{aer} - * (ZMI/XMD) & !==>kg_{aer}/kg_{aer} - * PRHODREF(:) & !==>kg_{aer}/m3_{air} - * (1.d0/ZRHOI) & !==>m3_{aer}/m3_{air} - * XM3TOUM3 & !==>um3_{aer}/m3_{air} - / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment) - !Limit mass concentration to minimum value -! ZM(:,NM3(JN)) = MAX(ZM(:,NM3(JN)), ZMMIN(NM3(JN))) - ! - ZM(:,NM6(JN)) = ZSV(:,3+(JN-1)*3) & !um6/molec_{air}*(cm3/m3) - * 1.d-6 & !==> um6/molec_{air} - * XAVOGADRO & !==> um6/mole_{air} - / XMD & !==> um6/kg_{air} - * PRHODREF(:) !==> um6/m3_{air} - !Limit m6 concentration to minimum value -! ZM(:,NM6(JN)) = MAX(ZM(:,NM6(JN)), ZMMIN(NM6(JN))) - ! - !Get sigma (only if sigma is allowed to vary) - !Get intermediate values for sigma M3^2/(M0*M6) (ORILAM paper, eqn 8) - ZSIGMA(:)=ZM(:,NM3(JN))**2/(ZM(:,NM0(JN))*ZM(:,NM6(JN))) - !Limit the intermediate value, can not be larger than 1 - ZSIGMA(:)=MIN(1-1E-10,ZSIGMA(:)) - !Limit the value for intermediate, can not be smaller than 0 - ZSIGMA(:)=MAX(1E-10,ZSIGMA(:)) - !Calculate log(sigma) - ZSIGMA(:)= LOG(ZSIGMA(:)) - !Finally get the real sigma the negative sign is because of - !The way the equation is written (M3^2/(M0*M6)) instead of (M0*M6)/M3^3 - ZSIGMA(:)= EXP(1./3.*SQRT(-ZSIGMA(:))) - !Limit the value to reasonable ones - ZSIGMA(:) = MAX( XSIGMIN, MIN( XSIGMAX, ZSIGMA(:) ) ) - - ! - !Put back M6 so that it fits the sigma which is possibly modified above - !The following makes M6 consistent with N, R, SIGMA - ZM(:,NM6(JN)) = ZM(:,NM0(JN)) & - * ( (ZM(:,NM3(JN))/ZM(:,NM0(JN)))**(1./3.) & - * exp(-(3./2.)*log(ZSIGMA(:))**2))**6 & - * exp(18.*log(ZSIGMA(:))**2) - - ELSE ! compute M6 from M0, M3 and SIGMA - ! - ZSIGMA(:) = XINISIG(JPDUSTORDER(JN)) - - IF (LRGFIX_DST) THEN - !calculate moment 3 from total aerosol mass (molec_{aer}/molec_{air} ==> - ZM(:,NM3(JN)) = & - ZSV(:,JN) & !molec_{aer}/molec_{aer} - * (ZMI/XMD) & !==>kg_{aer}/kg_{aer} - * PRHODREF(:) & !==>kg_{aer}/m3_{air} - * (1.d0/ZRHOI) & !==>m3_{aer}/m3_{air} - * XM3TOUM3 & !==>um3_{aer}/m3_{air} - / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment) - -! ZM(:,NM3(JN)) = MAX(ZM(:,NM3(JN)), ZMMIN(NM3(JN))) - - ZM(:,NM0(JN))= ZM(:,NM3(JN))/& - ((ZINIRADIUS(JN)**3)*EXP(4.5 * LOG(XINISIG(JPDUSTORDER(JN)))**2)) - - ELSE - !calculate moment 3 from total aerosol mass (molec_{aer}/molec_{air} ==> - ZM(:,NM3(JN)) = & - ZSV(:,2+(JN-1)*2) & !molec_{aer}/molec_{aer} - * (ZMI/XMD) & !==>kg_{aer}/kg_{aer} - * PRHODREF(:) & !==>kg_{aer}/m3_{air} - * (1.d0/ZRHOI) & !==>m3_{aer}/m3_{air} - * XM3TOUM3 & !==>um3_{aer}/m3_{air} - / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment) - - !Get number concentration (#/molec_{air}==>#/m3) - ZM(:,NM0(JN))= & - ZSV(:,1+(JN-1)*2) & !#/molec_{air} - * XAVOGADRO & !==>#/mole - / XMD & !==>#/kg_{air} - * PRHODREF(:) !==>#/m3 - - ! Limit concentration to minimum values -! WHERE ((ZM(:,NM0(JN)) < ZMMIN(NM0(JN)) ).OR. & -! (ZM(:,NM3(JN)) < ZMMIN(NM3(JN)) )) -! ZM(:,NM0(JN)) = ZMMIN(NM0(JN)) -! ZM(:,NM3(JN)) = ZMMIN(NM3(JN)) -! PSVT(:,1+(JN-1)*2) = ZM(:,NM0(JN)) * XMD / & -! (XAVOGADRO * PRHODREF(:) ) -! PSVT(:,2+(JN-1)*2) = ZM(:,NM3(JN)) * XMD * XPI * 4./3. * ZRHOI / & -! (ZMI*PRHODREF(:)*XM3TOUM3) -! ENDWHERE - END IF - - ! - - ZM(:,NM6(JN)) = ZM(:,NM0(JN)) & - * ( (ZM(:,NM3(JN))/ZM(:,NM0(JN)))**(1./3.) & - * exp(-(3./2.)*log(ZSIGMA(:))**2))**6 & - * exp(18.*log(ZSIGMA(:))**2) - - ! - END IF - ! - !Get number median radius (eqn. 7 in Orilam manuscript) - ZRG(:)= & - ( & - ZM(:,NM3(JN))*ZM(:,NM3(JN))*ZM(:,NM3(JN))*ZM(:,NM3(JN)) & - /(ZM(:,NM6(JN))*ZM(:,NM0(JN))*ZM(:,NM0(JN))*ZM(:,NM0(JN))) & - ) & - ** XSIXTH - !ZRG(:)=MIN(ZRG(:),ZINIRADIUS(JN)) - !Give the sigma-values to the passed array - IF(PRESENT(PSIG1D)) PSIG1D(:,JN) = ZSIGMA(:) - ! - !Set the number concentrations in the passed array - IF(PRESENT(PN1D)) PN1D(:,JN) = ZM(:,NM0(JN)) - ! - !Get the number median radius - IF(PRESENT(PRG1D)) PRG1D(:,JN)= ZRG(:) - ! - IF(PRESENT(PMASS1D))THEN - PMASS1D(:,JN)= & - ZM(:,NM0(JN)) & !#/m^3_{air} - * XPI*4./3. & - * ZRHOI & !==>kg/m^3_{aeros}/m^3_{air} - * ZRG(:) * ZRG(:) * ZRG(:) & - * XUM3TOM3 & !==>kg/m^3_{air} - * exp(4.5*log(ZSIGMA(:))*log(ZSIGMA(:))) - ENDIF -! -END DO !Loop on modes -! -IF(PRESENT(PM1D)) PM1D(:,:) = ZM(:,:) -! -DEALLOCATE(ZINIRADIUS) -DEALLOCATE(ZSV) -DEALLOCATE(ZRG) -DEALLOCATE(ZSIGMA) -DEALLOCATE(ZMMIN) -DEALLOCATE(ZM) -DEALLOCATE(NM6) -DEALLOCATE(NM3) -DEALLOCATE(NM0) -! -! -END SUBROUTINE PPP2DUST1D - -! -END MODULE MODE_DUST_PSD diff --git a/src/ICCARE_BASE/mode_gamma_etc.F90 b/src/ICCARE_BASE/mode_gamma_etc.F90 deleted file mode 100644 index 04a1b2091..000000000 --- a/src/ICCARE_BASE/mode_gamma_etc.F90 +++ /dev/null @@ -1,554 +0,0 @@ -!======================================================================= -! MODULE GAMMA -! -! THIS MODULE CONTAIN FUNCTIONS TO CALCULATE -! GAMMA_P, GAMMA_T, GAMMA_L, GAMMA_A FOR BVOCS. -! -! CONTAINS: 1)GAMMA_LAI -! 2)GAMMA_P -! 3)GAMMA_TLD -! 4)GAMMA_TLI -! 5)GAMMA_A -! 6)GAMMA_S -! 7)GAMMA_CO2 -! 8)GAMMA_LAIBIDIR -! -! NOTE: -! -! REQUIREMENT: -! -! CALLS: SOLARANGLE -! -! CREATED BY TAN 11/21/06 FOR MEGAN V2.0 -! -! HISTORY: -! 08/01/07 GUENTHER A. - MOVE TO MEGANV2.02 WITH MODIFICATION TO -! CORRECT CALCULATION OF GAMMA_P -! -!======================================================================= - -MODULE MODE_GAMMA_ETC -! -USE MODD_MEGAN -! -!USE MODI_SOLARANGLE -USE MODI_INDEX1 -! -IMPLICIT NONE - -!... PROGRAM I/O PARAMETERS - -!... EXTERNAL PARAMETERS - -CONTAINS -!*********************************************************************** - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! -! SCIENTIFIC ALGORITHM -! -! EMISSION = [EF][GAMMA][RHO] -! WHERE [EF] = EMISSION FACTOR (UG/M2H) -! [GAMMA] = EMISSION ACTIVITY FACTOR (NON-DIMENSION) -! [RHO] = PRODUCTION AND LOSS WITHIN PLANT CANOPIES -! (NON-DIMENSINO) -! ASSUMPTION: [RHO] = 1 (11/27/06) (SEE PDT_LOT_CP.EXT) -! -! GAMMA = [GAMMA_CE][GAMMA_AGE][GAMMA_SM] -! WHERE [GAMMA_CE] = CANOPY CORRECTION FACTOR -! [GAMMA_AGE] = LEAF AGE CORRECTION FACTOR -! [GAMMA_SM] = SOIL MOISTURE CORRECTION FACTOR -! ASSUMPTION: [GAMMA_SM] = 1 (11/27/06) -! -! GAMMA_CE = [GAMMA_LAI][GAMMA_P][GAMMA_T] -! WHERE [GAMMA_LAI] = LEAF AREA INDEX FACTOR -! [GAMMA_P] = PPFD EMISSION ACTIVITY FACTOR -! [GAMMA_T] = TEMPERATURE RESPONSE FACTOR -! -! EMISSION = [EF][GAMMA_LAI][GAMMA_P][GAMMA_T][GAMMA_AGE][GAMMA_SM] -! DERIVATION: -! EMISSION = [EF][GAMMA_ETC](1-LDF) + [EF][GAMMA_ETC][LDF][GAMMA_P] -! EMISSION = [EF][GAMMA_ETC]{ (1-LDF) + [LDF][GAMMA_P] } -! EMISSION = [EF][GAMMA_ECT]{ (1-LDF) + [LDF][GAMMA_P] } -! WHERE LDF = LIGHT DEPENDENT FUNCTION (NON-DIMENSION) -! -! FOR ISOPRENE -! ASSUMPTION: LDF = 1 FOR ISOPRENE (11/27/06) -! -! FINAL EQUATION -! EMISSION = [EF][GAMMA_LAI][GAMMA_P][GAMMA_T][GAMMA_AGE][GAMMA_SM] -! -! FOR NON-ISOPRENE -! FINAL EQUATION -! EMISSION = [EF][GAMMA_LAI][GAMMA_T][GAMMA_AGE][GAMMA_SM]* -! { (1-LDF) + [LDF][GAMMA_P] } -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -!======================================================================= -!... BEGIN MODULE -!======================================================================= - - -!----------------------------------------------------------------------- -!.....1) CALCULATE GAM_L (GAMMA_LAI) -!----------------------------------------------------------------------- -! 0.49[LAI] -! GAMMA_LAI = ---------------- (NON-DIMENSION) -! (1+0.2LAI^2)^0.5 -! -! SUBROUTINE GAMMA_LAI RETURNS THE GAMMA_LAI VALUES -!----------------------------------------------------------------------- -SUBROUTINE GAMMA_LAI(PLAI, PGAM_L) - -IMPLICIT NONE -! INPUT -REAL,DIMENSION(:),INTENT(IN) :: PLAI -! OUTPUT -REAL,DIMENSION(:),INTENT(OUT) :: PGAM_L - -PGAM_L(:) = (0.49*PLAI(:)) / ( (1.+0.2*(PLAI(:)**2))**0.5 ) - -END SUBROUTINE GAMMA_LAI -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -!.....5) CALCULATE GAM_A (GAMMA_AGE) -!----------------------------------------------------------------------- -! -! GAMMA_AGE = FNEW*ANEW + FGRO*AGRO + FMAT*AMAT + FOLD*AOLD -! WHERE FNEW = NEW FOLIAGE FRACTION -! FGRO = GROWING FOLIAGE FRACTION -! FMAT = MATURE FOLIAGE FRACTION -! FOLD = OLD FOLIAGE FRACTION -! ANEW = RELATIVE EMISSION ACTIVITY FOR NEW FOLIAGE -! AGRO = RELATIVE EMISSION ACTIVITY FOR GROWING FOLIAGE -! AMAT = RELATIVE EMISSION ACTIVITY FOR MATURE FOLIAGE -! AOLD = RELATIVE EMISSION ACTIVITY FOR OLD FOLIAGE -! -! -! FOR FOLIAGE FRACTION -! CASE 1) LAIC = LAIP -! FNEW = 0.0 , FGRO = 0.1 , FMAT = 0.8 , FOLD = 0.1 -! -! CASE 2) LAIP > LAIC -! FNEW = 0.0 , FGRO = 0.0 -! FMAT = 1-FOLD -! FOLD = (LAIP-LAIC)/LAIP -! -! CASE 3) LAIP < LAIC -! FNEW = 1-(LAIP/LAIC) T <= TI -! = (TI/T) * ( 1-(LAIP/LAIC) ) T > TI -! -! FMAT = LAIP/LAIC T <= TM -! = (LAIP/LAIC) + -! ( (T-TM)/T ) * ( 1-(LAIP/LAIC) ) T > TM -! -! FGRO = 1 - FNEW - FMAT -! FOLD = 0.0 -! -! WHERE -! TI = 5 + (0.7*(300-TT)) TT <= 303 -! = 2.9 TT > 303 -! TM = 2.3*TI -! -! T = LENGTH OF THE TIME STEP (DAYS) -! TI = NUMBER OF DAYS BETWEEN BUDBREAK AND THE INDUCTION OF -! EMISSION -! TM = NUMBER OF DAYS BETWEEN BUDBREAK AND THE INITIATION OF -! PEAK EMISSIONS RATES -! TT = AVERAGE TEMPERATURE (K) NEAR TOP OF THE CANOPY DURING -! CURRENT TIME PERIOD (DAILY AVE TEMP FOR THIS CASE) -! -! -! FOR RELATIVE EMISSION ACTIVITY -! CASE 1) CONSTANT -! ANEW = 1.0 , AGRO = 1.0 , AMAT = 1.0 , AOLD = 1.0 -! -! CASE 2) MONOTERPENES -! ANEW = 2.0 , AGRO = 1.8 , AMAT = 0.95 , AOLD = 1.0 -! -! CASE 3) SESQUITERPENES -! ANEW = 0.4 , AGRO = 0.6 , AMAT = 1.075, AOLD = 1.0 -! -! CASE 4) METHANOL -! ANEW = 3.0 , AGRO = 2.6 , AMAT = 0.85 , AOLD = 1.0 -! -! CASE 5) ISOPRENE -! ANEW = 0.05 , AGRO = 0.6 , AMAT = 1.125, AOLD = 1.0 -! -! SUBROUTINE GAMMA_A RETURNS GAMMA_A -!----------------------------------------------------------------------- -SUBROUTINE GAMMA_A(KDATE, KTIME, KTSTLEN, HSPC_NAME, PTEMP_D, PLAIARP, PLAIARC, PGAM_A) - -IMPLICIT NONE - -! INPUT -INTEGER, INTENT(IN) :: KDATE, KTIME, KTSTLEN -CHARACTER(LEN=16), INTENT(IN) :: HSPC_NAME -REAL, DIMENSION(:), INTENT(IN) :: PTEMP_D -REAL, DIMENSION(:), INTENT(IN) :: PLAIARP, PLAIARC -! OUTPUT -REAL,DIMENSION(:),INTENT(OUT) :: PGAM_A - -! LOCAL PARAMETERS -REAL :: ZFNEW, ZFGRO, ZFMAT, ZFOLD -REAL :: ZTI, ZTM ! NUMBER OF DAYS BETWEEN BUDBREAK - ! AND INDUCTION OF EMISSION, - ! INITIATION OF PEAK EMISSIONS RATES -INTEGER :: IAINDX ! RELATIVE EMISSION ACITIVITY INDEX -INTEGER :: ISPCNUM -INTEGER :: JJ - -!... CHOOSE RELATIVE EMISSION ACTIVITY -!--------CODE BY XUEMEI WANG 11/04/2007---------------- -! -ISPCNUM = INDEX1(HSPC_NAME, CMGN_SPC) -IAINDX = NREA_INDEX(ISPCNUM) -! -!--------------------------------------------------- -! LOCAL PARAMETER ARRAYS -DO JJ = 1,SIZE(PLAIARP) - IF ( PTEMP_D(JJ).LE.303. ) THEN - ZTI = 5.0 + 0.7*(300.-PTEMP_D(JJ)) - ELSE - ZTI = 2.9 - ENDIF - ZTM = 2.3 * ZTI -! - - -!... CALCULATE FOLIAGE FRACTION - -! PRINT*,'LAIP,LAIC, TT=',MINVAL(LAIP), MAXVAL(LAIP), -! S MINVAL(LAIC), MAXVAL(LAIC), MINVAL(TT), MAXVAL(TT) - -! WHERE (LAIP .LT. LAIC) - -! CALCULATE TI AND TM - IF ( PLAIARP(JJ).EQ.PLAIARC(JJ) ) THEN - - ZFNEW = 0.0 - ZFGRO = 0.1 - ZFMAT = 0.8 - ZFOLD = 0.1 - - ELSEIF ( PLAIARP(JJ).GT.PLAIARC(JJ) ) THEN - - ZFNEW = 0.0 - ZFGRO = 0.0 - ZFOLD = ( PLAIARP(JJ)-PLAIARC(JJ) ) / PLAIARP(JJ) - ZFMAT = 1. - ZFOLD - - ELSE - - ZFMAT = PLAIARP(JJ)/PLAIARC(JJ) - ! CALCULATE FNEW AND FMAT, THEN FGRO AND FOLD - ! FNEW - IF ( ZTI.GE.KTSTLEN ) THEN - ZFNEW = 1.0 - ZFMAT - ELSE - ZFNEW = (ZTI/KTSTLEN) * ( 1. - ZFMAT ) - ENDIF -! FMAT - IF ( ZTM.LT.KTSTLEN ) THEN - ZFMAT = ZFMAT + ( (KTSTLEN-ZTM)/KTSTLEN ) * ( 1.-ZFMAT ) - ENDIF - - ZFGRO = 1.0 - ZFNEW - ZFMAT - ZFOLD = 0.0 - - ENDIF - - !... CALCULATE GAMMA_A - PGAM_A(JJ) = ZFNEW * XANEW(IAINDX) + ZFGRO * XAGRO(IAINDX) + & - ZFMAT * XAMAT(IAINDX) + ZFOLD * XAOLD(IAINDX) - -ENDDO - -END SUBROUTINE GAMMA_A - -!----------------------------------------------------------------------- -!.....6) CALCULATE GAM_SMT (GAMMA_SM) -!----------------------------------------------------------------------- -! -! GAMMA_SM = 1.0 (NON-DIMENSION) -! -! -! SUBROUTINE GAMMA_S RETURNS THE GAMMA_SM VALUES -!----------------------------------------------------------------------- -SUBROUTINE GAMMA_S( PGAM_S ) - -IMPLICIT NONE - -REAL,DIMENSION(:) :: PGAM_S - -PGAM_S = 1.0 - -END SUBROUTINE GAMMA_S - -!----------------------------------------------------------------------- -!.....2) CALCULATE GAM_P (GAMMA_P) -!----------------------------------------------------------------------- -! GAMMA_P = 0.0 A<=0, A>=180, SIN(A) <= 0.0 -! -! GAMMA_P = SIN(A)[ 2.46*(1+0.0005(PDAILY-400))*PHI - 0.9*PHI^2 ] -! 0<A<180, SIN(A) > 0.0 -! WHERE PHI = ABOVE CANOPY PPFD TRANSMISSION (NON-DIMENSION) -! PDAILY = DAILY AVERAGE ABOVE CANOPY PPFD (UMOL/M2S) -! A = SOLAR ANGLE (DEGREE) -! -! NOTE: AAA = 2.46*BBB*PHI - 0.9*PHI^2 -! BBB = (1+0.0005(PDAILY-400)) -! GAMMA_P = SIN(A)*AAA -! -! PAC -! PHI = ----------- -! SIN(A)*PTOA -! WHERE PAC = ABOVE CANOPY PPFD (UMOL/M2S) -! PTOA = PPFD AT THE TOP OF ATMOSPHERE (UMOL/M2S) -! -! PAC = SRAD * 4.766 MMMOL/M2-S * 0.5 -! -! PTOA = 3000 + 99*COS[2*3.14-( DOY-10)/365 )] -! WHERE DOY = DAY OF YEAR -! -! SUBROUTINE GAMMA_P RETURNS THE GAMMA_P VALUES -!----------------------------------------------------------------------- -!SUBROUTINE GAMMA_P( KDATE, KTIME, PLAT, PLONG, PPFD, PPFD_D, PGAM_P ) -! -!IMPLICIT NONE -! -!! INPUT -!INTEGER,INTENT(IN) :: KDATE, KTIME -! -!REAL,DIMENSION(:),INTENT(IN) :: PLAT, PLONG -!! PHOTOSYNTHETIC PHOTON FLUX DENSITY: INSTANTANEOUS, DAILY -!REAL,DIMENSION(:),INTENT(IN) :: PPFD, PPFD_D -!! OUTPUT -!REAL,DIMENSION(:),INTENT(OUT) :: PGAM_P ! GAMMA_P -! -!! LOCAL PARAMETERS -!REAL, DIMENSION(SIZE(PLAT)) :: ZHOUR, ZSINBETA ! HOUR IS SOLAR HOUR -!INTEGER, DIMENSION(SIZE(PLAT)) :: IDAY ! DAY IS DOY (JDATE) -! -!REAL :: ZPTOA, ZPHI -!REAL :: ZAAA, ZBBB -!REAL :: ZBETA ! SOLAR ZENITH ANGLE -!INTEGER :: JJ -! -!!... BEGIN ESTIMATING GAMMA_P -! -!!... CONVERT DATE AND TIME FORMAT TO LOCAL TIME -!! DAY IS JULIAN DAY -!IDAY(:) = MOD(KDATE,1000) -! -!! CONVERT FROM XXXXXX FORMAT TO XX.XX (SOLAR HOUR) -!! HOUR = 0 -> 23.XX -!! SOLAR HOUR -!ZHOUR(:) = KTIME/10000. + PLONG(:)/15. -! -!WHERE ( ZHOUR(:).LT.0. ) -! ZHOUR(:) = ZHOUR(:) + 24.0 -! IDAY(:) = IDAY(:) - 1. -!ENDWHERE -! -!! GET SOLAR ELEVATION ANGLE -!CALL SOLARANGLE(IDAY, ZHOUR, PLAT, ZSINBETA) -! -!DO JJ = 1,SIZE(ZSINBETA) -! -! IF ( ZSINBETA(JJ).LE.0. ) THEN -! -! PGAM_P(JJ) = 0. -! -! ELSE IF ( ZSINBETA(JJ).GT.0. ) THEN -! -! ZPTOA = 3000.0 + 99.0 *COS(2. * 3.14 * (IDAY(JJ)-10.)/365.) -! -! ZPHI = PPFD(JJ) / (ZSINBETA(JJ) * ZPTOA) -! -! ZBBB = 1. + 0.0005 * (PPFD_D(JJ)-400. ) -! ZAAA = ( 2.46 * ZBBB * ZPHI ) - ( 0.9 * ZPHI**2 ) -! -! PGAM_P(JJ) = ZSINBETA(JJ) * ZAAA -! -! ZBETA = ASIN(ZSINBETA(JJ)) * XRPI180 ! DEGREE -! -! ! SCREENING THE UNFORCED ERRORS -! ! IF SOLAR ELEVATION ANGLE IS LESS THAN 1 THEN -! ! GAMMA_P CAN NOT BE GREATER THAN 0.1. -! IF ( ZBETA.LT.1.0 .AND. PGAM_P(JJ).GT.0.1 ) THEN -! PGAM_P(JJ) = 0.0 -! ENDIF -! -! ELSE -! -! WRITE(*,*) "ERROR: SOLAR ANGLE IS INVALID - FATAL ERROR GAMMA_P, STOP" -! STOP -! -! ENDIF -! ! END LOOP FOR NROWS -!ENDDO ! END LOOP FOR NCOLS -! -!END SUBROUTINE GAMMA_P -!!----------------------------------------------------------------------- -! -! -!!----------------------------------------------------------------------- -!!.....3) CALCULATE GAM_T (GAMMA_T) FOR ISOPRENE -!!----------------------------------------------------------------------- -!! EOPT*CT2*EXP(CT1*X) -!! GAMMA_T = ------------------------ -!! [CT2-CT1*(1-EXP(CT2*X))] -!! WHERE X = [ (1/TOPT)-(1/THR) ] / 0.00831 -!! EOPT = 1.75*EXP(0.08(TDAILY-297) -!! CT1 = 80 -!! CT2 = 200 -!! THR = HOURLY AVERAGE AIR TEMPERATURE (K) -!! TDAILY = DAILY AVERAGE AIR TEMPERATURE (K) -!! TOPT = 313 + 0.6(TDAILY-297) -!! -!! NOTE: AAA = EOPT*CT2*EXP(CT1*X) -!! BBB = [CT2-CT1*(1-EXP(CT2*X))] -!! GAMMA_T = AAA/BBB -!! -!! SUBROUTINE GAMMA_TLD RETURNS THE GAMMA_T VALUE FOR ISOPRENE -!!----------------------------------------------------------------------- -!SUBROUTINE GAMMA_TLD( PTEMP, PTEMP_D, PGAM_T, HSPC_NAME ) -! -!IMPLICIT NONE -! -!! INPUT -!REAL,DIMENSION(:),INTENT(IN) :: PTEMP, PTEMP_D ! DAILY, HOURLY SURFACE TEMPERATURE -!! OUTPUT -!REAL,DIMENSION(:),INTENT(OUT) :: PGAM_T ! GAMMA_T -!CHARACTER(LEN=16),INTENT(IN) :: HSPC_NAME -!! -!! LOCAL PARAMETERS -!REAL :: ZEOPT, ZTOPT, ZX, ZAAA, ZBBB -!INTEGER :: ISPCNUM, JJ -! -!ISPCNUM = INDEX1(HSPC_NAME, CMGN_SPC) -! -!DO JJ = 1,SIZE(PTEMP) -! -! ZEOPT = XCLEO(ISPCNUM) * EXP(0.08*(PTEMP_D(JJ)-297.)) -! ZTOPT = 313.0 + ( 0.6*(PTEMP_D(JJ)-297.) ) -! ZX = ( (1/ZTOPT)-(1/PTEMP(JJ)) ) / 0.00831 -! -! ZAAA = ZEOPT * XCT2 * EXP(XCTM1(ISPCNUM)*ZX) -! ZBBB = ( XCT2- XCTM1(ISPCNUM)*( 1.-EXP(XCT2*ZX) ) ) -! PGAM_T(JJ) = ZAAA/ZBBB -! -!ENDDO -! -!END SUBROUTINE GAMMA_TLD -!!----------------------------------------------------------------------- -! -! -!!----------------------------------------------------------------------- -!!.....4) CALCULATE GAM_T (GAMMA_T) FOR NON-ISOPRENE -!!----------------------------------------------------------------------- -!! -!! GAMMA_T = EXP[TDP_FCT*(T-TS)] -!! WHERE TDP_FCT = TEMPERATURE DEPENDENT PARAMETER ('BETA') -!! TS = STANDARD TEMPERATURE (NORMALLY 303K, 30C) -!! -!! SUBROUTINE GAMMA_TLI RETURNS THE GAMMA_T VALUE FOR NON-ISOPRENE -!!----------------------------------------------------------------------- -!SUBROUTINE GAMMA_TLI(HSPCNAM, PTEMP, PGAM_T) -! -!IMPLICIT NONE -! -!CHARACTER(LEN=16), INTENT(IN) :: HSPCNAM -!REAL,DIMENSION(:), INTENT(IN):: PTEMP -!REAL, DIMENSION(:), INTENT(OUT) :: PGAM_T -!! -!INTEGER :: ISPCNUM ! SPECIES NUMBER -! -!!--END OF DECLARATIONS-- -! -!ISPCNUM = INDEX1(HSPCNAM, CMGN_SPC) -!! -!PGAM_T = EXP( XTDF_PRM(ISPCNUM) * (PTEMP-XTS) ) -! -!END SUBROUTINE GAMMA_TLI -!!----------------------------------------------------------------------- -! -!!======================================================================= -!!----------------------------------------------------------------------- -!!.....7) CALCULATE GAM_CO2(GAMMA_CO2) -!!----------------------------------------------------------------------- -!! -!! GAMMA_CO2 = 1.0 (NON-DIMENSION) -!! WHEN CO2 =400PPM -!! -!! SUBROUTINE GAM_CO2 RETURNS THE GAMMA_CO2 VALUES -!! XUEMEI WANG-2009-06-22 -!!----------------------------------------------------------------------- -!SUBROUTINE GAMMA_CO2(PCO2, PGAM_CO2) -! -!IMPLICIT NONE -! -!REAL, DIMENSION(:), INTENT(IN) :: PCO2 -!REAL, DIMENSION(:), INTENT(OUT) :: PGAM_CO2 -! -!REAL :: ZCI -!INTEGER :: JJ -! -!DO JJ = 1,SIZE(PCO2) -! -! IF ( PCO2(JJ).EQ.400. ) THEN -! PGAM_CO2(JJ) = 1.0 -! ELSE -! ZCI = 0.7* PCO2(JJ) -! PGAM_CO2(JJ) = XISMAX - ((XISMAX*ZCI**XH) /(XCSTAR**XH+ZCI**XH)) -! ENDIF -! -!ENDDO -! -!END SUBROUTINE GAMMA_CO2 -! -!!======================================================================= -!!======================================================================= -!!----------------------------------------------------------------------- -!!.....8) CALCULATE GAMMA_LAIBIDIR(GAM_LAIBIDIR,LAI) -!!----------------------------------------------------------------------- -!!FROM ALEX GUENTHER 2010-01-26 -!!IF LAI < 2 THEN -!!GAMMALAIBIDIR= 0.5 * LAI -!!ELSEIF LAI <= 6 THEN -!!GAMMALAIBIDIR= 1 - 0.0625 * (LAI - 2) -!!ELSE -!!GAMMALAIBIDIR= 0.75 -!!END IF -!! -!! SUBROUTINE GAMMA_LAIBIDIR RETURNS THE GAM_LAIBIDIR VALUES -!! XUEMEI WANG-2010-01-28 -!! -!!----------------------------------------------------------------------- -!SUBROUTINE GAMMA_LAIBIDIR(PLAI, PGAM_LAIBIDIR) -! -!IMPLICIT NONE -! -!REAL,DIMENSION(:),INTENT(IN) :: PLAI -!REAL,DIMENSION(:),INTENT(OUT) :: PGAM_LAIBIDIR -! -!INTEGER :: JJ -!! -!DO JJ = 1,SIZE(PLAI) -! -! IF ( PLAI(JJ)<2. ) THEN -! PGAM_LAIBIDIR(JJ) = 0.5 * PLAI(JJ) -! ELSEIF ( PLAI(JJ).GE.2. .AND. PLAI(JJ).LE.6. ) THEN -! PGAM_LAIBIDIR(JJ) = 1. - 0.0625 * ( PLAI(JJ)-2. ) -! ELSE -! PGAM_LAIBIDIR(JJ) = 0.75 -! ENDIF -! -!ENDDO -! -!END SUBROUTINE GAMMA_LAIBIDIR -!!======================================================================= -! -END MODULE MODE_GAMMA_ETC diff --git a/src/ICCARE_BASE/mode_megan.F90 b/src/ICCARE_BASE/mode_megan.F90 deleted file mode 100644 index 584fda604..000000000 --- a/src/ICCARE_BASE/mode_megan.F90 +++ /dev/null @@ -1,1235 +0,0 @@ -MODULE MODE_MEGAN -! -USE MODD_MEGAN -! -USE MODI_SOLARANGLE -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -IMPLICIT NONE -! -!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX -! -! INPUT AND OUTPUT FILES MUST BE SELECTED BEFORE STARTING THE PROGRAM -! -!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX -!! -! INPUT VARIBLES -! -! DAY JULIAN DAY -! LAT LATITUDE -! HOUR HOUR OF THE DAY -! TC TEMPERATURE [C] -! PPFD INCOMING PHOTOSYNTHETIC ACTIVE RADIATION [UMOL/M2/S1] -! WIND WIND SPEED [M S-1] -! HUMIDITY RELATIVE HUMIDITY [%] -! CANTYPYE DEFINES SET OF CANOPY CHARACTERISTICS -! LAI LEAF AREA INDEX [M2 PER M2 GROUND AREA] -! DI ??? -! PRES PRESSURE [PA] -! -! USED VARIABLES: -! -! PPFDFRAC FRACTION OF TOTAL SOLAR RADIATION THAT IS PPFD -! SOLAR SOLAR RADIATION [W/M2] -! MAXSOLAR MAXIMUM OF SOLAR RADIATION -! BETA SIN OF SOLAR ANGLE ABOVE HORIZON -! SINBETA SOLAR ANGLE ABOVE HORIZON -! TAIRK0 ABOVE CANOPY AIR TEMPERATURE [K] -! TAIRK ARRAY OF CANOPY AIR TEMPERATURE [K] -! WS0 ABOVE CANOPY WIND SPEED [M/S] -! WS ARRAY OF CANOPY WIND SPEED [M/S] -! HUMIDAIRPA0 ABOVE CANOPY AMBIENT HUMIDITY [PA] -! HUMIDAIRPA ARRAY OF CANOPY AMBIENT HUMIDITY IN [PA] -! STOMATADI INDEX FOR WATER STATUS OF LEAVES. USED TO MODIFY STOMATAL CONDUCTANCE -! TRANSMIS TRANSMISSION OF PPFD THAT IS DIFFUSE -! DIFFFRAC FRACTION OF PPFD THAT IS DIFFUSE -! PPFDFRAC FRACTION OF SOLAR RAD THAT IS PPFD -! TRATE STABILITY OF BOUNDARY ??? -! SH SENSIBLE HEAT FLUX ??? -! VPGAUSWT ARRAY OF GAUSSIAN WEIGHTING FACTORS -! VPGAUSDIS ARRAY OF GAUSSIAN WEIGHTING FACTORS -! VPSLWWT ARRAY OF GAUSSIAN WEIGHTING FACTORS -! SUNFRAC ARRAY OF THE FRACTION OF SUN LEAVES. I = 1 IS THE TOP CANOPY LAYER, 2 IS THE NEXT LAYER, ETC. -! SUNPPFD ARRAY OF INCOMING (NOT ABSORBED) PPFD ON A SUN LEAF [UMOL/M2/S] -! SHADEPPFD ARRAY OF INCOMING (NOT ABSORBED) PPFD ON A SHADE LEAF [UMOL/M2/S] -! SUNQV ARRAY OF VISIBLE RADIATION (IN AND OUT) FLUXES ON SUN LEAVES -! SHADEQV ARRAY OF ABSORBED VISIBLE RADIATION (IN AND OUT) FLUXES ON SHADE LEAVES -! SUNQN ARRAY OF ABSORBED NEAR IR RADIATION (IN AND OUT) FLUXES ON SUN LEAVES -! SHADEQN ARRAY OF ABSORBED NEAR IR RADIATION (IN AND OUT) FLUXES ON SHADE LEAVES -! SUNLEAFTK ARRAY OF LEAF TEMPERATURE FOR SUN LEAVES [K] -! SUNLEAFSH ARRAY OF SENSIBLE HEAT FLUX FOR SUN LEAVES [W/M2] -! SUNLEAFLH ARRAY OF LATENT HEAT FLUX FOR SUN LEAVES [W/M2] -! SUNLEAFIR ARRAY OF INFRARED FLUX FOR SUN LEAVES [W/M2] -! SHADELEAFTK ARRAY OF LEAF TEMPERATURE FOR SHADE LEAVES [K] -! SHADELEAFSH ARRAY OF SENSIBLE HEAT FLUX FOR SHADE LEAVES [W/M2] -! SHADELEAFLH ARRAY OF LATENT HEAT FLUX FOR SHADE LEAVES [W/M2] -! SHADELEAFIR ARRAY OF INFRARED FLUX FOR SHADE LEAVES [W/M2] -! QBABSV, QBABSN ABSORBED DIRECT BEAM LIGHT FOR VISIBLE AND NEAR INFRA RED -! QDABSV, QDABSN ARRAY OF ABSORBED DIFFUSE LIGHT FOR VISIBLE AND NEAR INFRA RED -! QSABSV, QSABSN ARRAY OF ABSORBED SCATTERED LIGHT FOR VISIBLE AND NEAR INFRA RED -! QBEAMV, QBEAMN ABOVE CANOPY BEAM (DIRECT) LIGHT FOR VISIBLE AND NEAR INFRA RED -! QDIFFV, QDIFFN ABOVE CANOPY DIFFUSE LIGHT FOR VISIBLE AND NEAR INFRA RED -! EA1PLAYER ARRAY OF EMISSION ACTIVITY OF LIGHT PER LAYER -! EA1TLAYER ARRAY OF EMISSION ACTIVITY OF TEMPERATURE PER LAYER -! EA1LAYER ARRAY OF COMPANIED EMISSION ACTIVITY -! EA1PCANOPY TOTAL EMISSION ACTIVITY OF LIGHT -! EATILAYER ARRAY OF EMISSION ACTIVITY OF TEMPERATURE INDENDENT PER LAYER -! EA1TCANOPY TOTAL EMISSION ACTIVITY OF TEMPERATURE DEPEDENT FACTOR -! PEA1CANOPY TOTAL COMPANIED EMISSION ACTIVITY -! PEATICANOPY TOTAL EMISSION ACTIVITY OF TEMPERATURE INDEPEDENT FACTOR -! CALCBETA FUNCTION: CALCULATION OF SOLAR ZENITH ANGLE -! WATERVAPPRES FUNCTION: CONVERT WATER MIXING RATIO (KG/KG) TO WATER VAPOR PRESSURE -! STABILITY FUNCTION: TEMPERATURE LAPSE RATE -! EA1T99 FUNCTION: TEMPERATURE DEPENDENCE ACTIVITY FACTOR FOR EMISSION TYPE 1 -! EA1P99 FUNCTION: LIGHT DEPENDENCE ACTIVITY FACTOR FOR EMISSION -! EALTI FUNCTION: TEMPERATURE INDEPENDENCE ACTIVITY FACTOR FOR EMISSION -! DISTOMATA FUNCTION: -! CALCECCENTRICITY FUNCTION: -! -!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX -! -CONTAINS -! -SUBROUTINE GAMME_CE(KDATE, KTIME, PCANOPYCHAR, KCANTYPE, HSPCNAME, & - PPFD24, PPFD240, PT24, PT240, PDI, & - PPFD0, PLAT, PLONG, PTC, PWIND, PHUMIDITY, & - PLAI, PRES, PEA1CANOPY, PEATICANOPY) !! -! -IMPLICIT NONE -! INPUT -INTEGER,INTENT(IN) :: KDATE, KTIME, KCANTYPE -REAL,DIMENSION(:,:),INTENT(IN) :: PCANOPYCHAR -CHARACTER(LEN=16), INTENT(IN) :: HSPCNAME -! -REAL, DIMENSION(:), INTENT(IN) :: PT24, PT240, PPFD24, PPFD240 -REAL, INTENT(IN) :: PDI -! -REAL, DIMENSION(:), INTENT(IN) :: PPFD0 -REAL, DIMENSION(:), INTENT(IN) :: PLONG, PLAT -REAL, DIMENSION(:), INTENT(IN) :: PTC, PRES, PWIND, PHUMIDITY, PLAI -! ARRAY OF CANOPY CHARACTERISTICS FOR KRTYP OF CANOPY TYPE -! OUTPUT -REAL, DIMENSION(:), INTENT(OUT) :: PEA1CANOPY, PEATICANOPY -! -! LOCAL VARIABLES -REAL, DIMENSION(NLAYERS) :: ZVPGAUSWT, ZVPGAUSDIS2, ZVPGAUSDIS -! -REAL, DIMENSION(SIZE(PLONG),NLAYERS) :: ZEA1LAYER, ZEATILAYER, ZVPSLWWT -REAL, DIMENSION(SIZE(PLONG),NLAYERS) :: ZSUNFRAC, ZSUNQV, ZSHADEQV, ZSUNQN, ZSHADEQN, & - ZSUNPPFD, ZSHADEPPFD, ZSUNLEAFTK, ZSHADELEAFTK, & - ZSUNLEAFSH, ZSHADELEAFSH, Z_PPFD, Z_ALPHAP -! -REAL, DIMENSION(SIZE(PLONG)) :: ZHOUR, ZSINBETA, ZSOLAR, & - ZMAXSOLAR, ZQDIFFV, ZQBEAMV, ZQDIFFN, ZQBEAMN, & - ZHUMIDAIRPA0, ZTRATE -! -REAL :: ZSTOMATADI -INTEGER, DIMENSION(SIZE(PLONG)) :: IDAY -INTEGER :: JI, JJ -! -!---------------------------HEADER OVER-------------------------------- -! -IDAY(:) = MOD(KDATE,1000) -! CONVERT FROM XXXXXX FORMAT TO XX.XX (SOLAR HOUR) -! HOUR = 0 -> 23.XX -! SOLAR HOUR -ZHOUR(:) = KTIME/10000. + PLONG(:)/15. -! -WHERE ( ZHOUR(:).LT.0. ) - ZHOUR(:) = ZHOUR(:) + 24. - IDAY (:) = IDAY (:) - 1 -ELSEWHERE ( ZHOUR.GT.24. ) - ZHOUR(:) = ZHOUR(:) - 24. - IDAY (:) = IDAY (:) + 1 -END WHERE -! -CALL SOLARANGLE(IDAY, ZHOUR, PLAT, ZSINBETA) - -! -ZSOLAR (:) = PPFD0(:)/2.25 -ZMAXSOLAR(:) = ZSINBETA(:) * XSOLARCONSTANT * CALCECCENTRICITY(IDAY(:)) -CALL SOLARFRACTIONS(ZSOLAR, ZMAXSOLAR, ZQDIFFV, ZQBEAMV, ZQDIFFN, ZQBEAMN) -! -CALL GAUSSIANINTEGRATION(ZVPGAUSWT, ZVPGAUSDIS, ZVPGAUSDIS2) -! -CALL CANOPYRAD(KCANTYPE, PCANOPYCHAR, ZVPGAUSDIS, & - PLAI, ZSINBETA, ZQBEAMV, ZQDIFFV, ZQBEAMN, ZQDIFFN, & - ZSUNFRAC, ZSUNQV, ZSHADEQV, ZSUNQN, ZSHADEQN, & - ZSUNPPFD, ZSHADEPPFD) -! -ZTRATE (:) = STABILITY(PCANOPYCHAR, KCANTYPE, ZSOLAR) -! -ZSTOMATADI = DISTOMATA(PDI) -! -ZHUMIDAIRPA0(:) = WATERVAPPRES(XWATERAIRRATIO, PHUMIDITY, PRES) -! -CALL CANOPYEB(KCANTYPE, PCANOPYCHAR, ZVPGAUSDIS, ZSTOMATADI, & - PTC, PWIND, ZTRATE, ZHUMIDAIRPA0, & - ZSUNQV, ZSHADEQV, ZSUNQN, ZSHADEQN, ZSUNPPFD, ZSHADEPPFD, & - ZSUNLEAFTK, ZSHADELEAFTK, ZSUNLEAFSH, ZSHADELEAFSH) - -!ZEA1TCANOPY(:) = 0. -!ZEA1PCANOPY(:) = 0. -PEA1CANOPY (:) = 0. -PEATICANOPY(:) = 0. - -DO JI = 1,SIZE(ZEA1LAYER,2) - - - !ZEA1TLAYER(:,JI) = EA1T99(ZSUNLEAFTK (:,JI), PT24, PT240, HSPCNAME) * ZSUNFRAC(:,JI) + & - ! EA1T99(ZSHADELEAFTK(:,JI), PT24, PT240, HSPCNAME) *(1.-ZSUNFRAC(:,JI)) - -! PSTD = 200 FOR SUN LEAVES -! PSTD = 50 FOR SHADE LEAVES - !ZEA1PLAYER(:,JI) = EA1P99(ZSUNPPFD(:,JI), PPFD24*0.5, PPFD240*0.5, XPSTD_SUN) * ZSUNFRAC(:,JI) + & - ! EA1P99(ZSHADEPPFD(:,JI), PPFD24*0.16, PPFD240*0.16, XPSTD_SHADE) * (1.-ZSUNFRAC(:,JI)) - - ZEA1LAYER(:,JI) = EA1T99(HSPCNAME , PT24 , PT240 , ZSUNLEAFTK (:,JI)) * & - EA1P99(XPSTD_SUN , PPFD24*0.5 , PPFD240*0.5 , ZSUNPPFD (:,JI)) * ZSUNFRAC(:,JI) + & - EA1T99(HSPCNAME , PT24 , PT240 , ZSHADELEAFTK(:,JI)) * & - EA1P99(XPSTD_SHADE, PPFD24*0.16, PPFD240*0.16, ZSHADEPPFD (:,JI) ) * (1.-ZSUNFRAC(:,JI)) - - ZEATILAYER(:,JI) = EALTI99(HSPCNAME, ZSUNLEAFTK (:,JI)) * ZSUNFRAC(:,JI) + & - EALTI99(HSPCNAME, ZSHADELEAFTK(:,JI)) * (1-ZSUNFRAC(:,JI)) - - Z_PPFD(:,JI) = ZSUNPPFD(:,JI) * ZSUNFRAC(:,JI) + ZSHADEPPFD(:,JI) * (1.-ZSUNFRAC(:,JI)) - - Z_ALPHAP(:,JI) = EA1P99(XPSTD_SUN , PPFD24*0.5 , PPFD240*0.5 , ZSUNPPFD (:,JI)) * ZSUNFRAC(:,JI) + & - EA1P99(XPSTD_SHADE, PPFD24*0.16, PPFD240*0.16, ZSHADEPPFD (:,JI) ) * (1.-ZSUNFRAC(:,JI)) !! - ! IF (KCANTYPE == 15) THEN - ! PRINT*, JI, ZSUNPPFD(:,JI) - !ENDIF - -ENDDO - -CALL WEIGHTSLW(ZVPGAUSDIS, PLAI, ZVPSLWWT) -! -DO JJ = 1,SIZE(PEA1CANOPY) -! ZEA1PCANOPY(JJ) = SUM(ZEA1PLAYER(JJ,:) * ZVPSLWWT(JJ,:) * ZVPGAUSWT(:) ) -! ZEA1TCANOPY(JJ) = SUM(ZEA1TLAYER(JJ,:) * ZVPSLWWT(JJ,:) * ZVPGAUSWT(:) ) - PEA1CANOPY (JJ) = SUM(ZEA1LAYER (JJ,:) * ZVPSLWWT(JJ,:) * ZVPGAUSWT(:) ) - PEATICANOPY(JJ) = SUM(ZEATILAYER(JJ,:) * ZVPSLWWT(JJ,:) * ZVPGAUSWT(:) ) -! THIS QUANTITY IS APPARENTLY NOT PASSED OUT OF THE SUBROUTINE -! ZSH(JJ) = SUM( ( ZSUNLEAFSH (JJ,:) * ZSUNFRAC(:,JJ) + & -! ZSHADELEAFSH(JJ,:) * (1 - ZSUNFRAC(:,JJ))) * PLAI(:) * ZVPGAUSWT(:) ) -ENDDO - - -PEA1CANOPY(:) = PEA1CANOPY(:) * XCCE * PLAI(:) - - -END SUBROUTINE GAMME_CE - -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO -! -! SUBROUTINE GAUSSIANINTEGRATION -! -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO - -SUBROUTINE GAUSSIANINTEGRATION(PWEIGHTGAUSS, PDISTGAUSS, PDISTGAUSS2) -! -IMPLICIT NONE -! -REAL,DIMENSION(:),INTENT(OUT) :: PWEIGHTGAUSS, PDISTGAUSS, PDISTGAUSS2 -! -! LOCAL VARIABLES -INTEGER :: JI -!-------------------------------------------------------------------- -! -IF ( NLAYERS.EQ.1 ) THEN - PWEIGHTGAUSS(1) = 1 - PDISTGAUSS (1) = 0.5 - PDISTGAUSS2 (1) = 1 -ELSEIF ( NLAYERS.EQ.3 ) THEN - PWEIGHTGAUSS(1) = 0.277778 - PWEIGHTGAUSS(2) = 0.444444 - PWEIGHTGAUSS(3) = 0.277778 - PDISTGAUSS(1) = 0.112702 - PDISTGAUSS(2) = 0.5 - PDISTGAUSS(3) = 0.887298 - PDISTGAUSS2(1) = 0.277778 - PDISTGAUSS2(2) = 0.722222 - PDISTGAUSS2(3) = 1 -ELSEIF ( NLAYERS.EQ.5 ) THEN - PWEIGHTGAUSS(1) = 0.1184635 - PWEIGHTGAUSS(2) = 0.2393144 - PWEIGHTGAUSS(3) = 0.284444444 - PWEIGHTGAUSS(4) = 0.2393144 - PWEIGHTGAUSS(5) = 0.1184635 - PDISTGAUSS(1) = 0.0469101 - PDISTGAUSS(2) = 0.2307534 - PDISTGAUSS(3) = 0.5 - PDISTGAUSS(4) = 0.7692465 - PDISTGAUSS(5) = 0.9530899 - PDISTGAUSS2(1) = 0.1184635 - PDISTGAUSS2(2) = 0.3577778 - PDISTGAUSS2(3) = 0.6422222 - PDISTGAUSS2(4) = 0.881536 - PDISTGAUSS2(5) = 1.0 -ELSE - DO JI = 1,NLAYERS - PWEIGHTGAUSS(JI) = 1. / NLAYERS - PDISTGAUSS (JI) = (JI - 0.5) / NLAYERS - PDISTGAUSS2 (JI) = JI / NLAYERS - ENDDO -ENDIF - -END SUBROUTINE GAUSSIANINTEGRATION - -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO -! -! SUBROUTINE WEIGHTSLW -! -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO - -SUBROUTINE WEIGHTSLW(PDISTGAUSS, PLAI, PSLW) - -IMPLICIT NONE - -REAL, DIMENSION(:), INTENT(IN) :: PLAI -REAL, DIMENSION(:), INTENT(IN) :: PDISTGAUSS - -REAL, DIMENSION(:,:), INTENT(OUT) :: PSLW - -! LOCAL VARIABLES -INTEGER :: JI -!-------------------------------------------------- - -DO JI = 1,NLAYERS - PSLW(:,JI) = 0.63 + 0.37 * EXP(-((PLAI(:) * PDISTGAUSS(JI)) - 1.)) -ENDDO - -END SUBROUTINE WEIGHTSLW - -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO -! -! SUBROUTINE SOLARFRACTIONS -! TRANSMISSION, FRACTION OF PPFD THAT IS DIFFUSE, -! FRACTION OF SOLAR RAD THAT IS PPFD -! -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO - -SUBROUTINE SOLARFRACTIONS(PSOLAR, PMAXSOLAR, PQDIFFV, PQBEAMV, PQDIFFN, PQBEAMN) -! -IMPLICIT NONE -! -! INTEGER,INTENT(IN) :: TIMEPERIOD -REAL, DIMENSION(:), INTENT(IN) :: PSOLAR, PMAXSOLAR -! -REAL, DIMENSION(:), INTENT(OUT) :: PQDIFFV, PQBEAMV, PQDIFFN, PQBEAMN -! -! INTERNAL VARIABLES -REAL :: ZFRACDIFF, ZPPFDFRAC, ZPPFDDIFFRAC, ZQV, ZQN -REAL :: ZTRANSMIS -INTEGER :: JJ -!----------------------------------------------------- -! IF (TIMEPERIOD .EQ. 1) THEN ! DAILY TRANSMISSION -! TRANSMIN = 0.26 -! TRANSSLOPE= 1.655 -! ELSE ! HOURLY TRANSMISSION -! TRANSMIN = 0.26 -! TRANSSLOPE = 1.655 -! ENDIF -DO JJ = 1,SIZE(PSOLAR) - - IF (PMAXSOLAR(JJ)<=0) THEN - ZTRANSMIS = 0.5 - ELSEIF (PMAXSOLAR(JJ)<PSOLAR(JJ)) THEN - ZTRANSMIS = 1.0 - ELSE - ZTRANSMIS = PSOLAR(JJ) / PMAXSOLAR(JJ) - ENDIF - -! ESTIMATE DIFFUSE FRACTION BASED ON DAILY TRANSMISSION (RODERICK 1999, GOUDRIANN AND VAN LAAR 1994- P.33) - -! IF (TRANSMIS > 0.81) THEN -! FRACDIFF = 0.05 -! ELSEIF (TRANSMIS > TRANSMIN) THEN -! FRACDIFF = 0.96-TRANSSLOPE * (TRANSMIS - TRANSMIN) -! ELSE -! FRACDIFF = 0.96 -! ENDIF - -! THE FRACTION OF TOTAL SOLAR RADIATION THAT IS PPFD (43% TO 55%) -! G. AND L. 84 -! PPFDFRAC = 0.43 + FRACDIFF * 0.12 - -!FRACDIFF IS BASED ON LIZASO 2005 -!MODIFIED BY XUEMEI 2010-01-26 ACCORDING TO ALEX'S DOCUMENT - ZFRACDIFF = 0.156 + 0.86/(1 + EXP(11.1*(ZTRANSMIS -0.53))) - -!PPFDFRAC IS BASED ON G.L. 84 -!MODIFIED BY XUEMEI 2010-01-26 ACCORDING TO ALEX'S DOCUMENT - ZPPFDFRAC = 0.55 -ZTRANSMIS*0.12 - -!PPFDDIFFRAC IS BASED ON DATA IN JACOVIDES 2007 -!MODIFIED BY XUEMEI 2010-01-26 ACCORDING TO ALEX'S DOCUMENT - ZPPFDDIFFRAC = ZFRACDIFF * (1.06 + ZTRANSMIS*0.4) - -! CALCULTE QDIFFV,QBEAMV, QDIFFN, QBEAMN IN THE SUBROUTINE -! MODIFIED BY XUEMEI 2010-01-26 ACCORDING TO ALEX'S DOCUMENT - IF (ZPPFDDIFFRAC > 1.0) ZPPFDDIFFRAC = 1.0 - - ZQV = ZPPFDFRAC * PSOLAR(JJ) - PQDIFFV(JJ) = ZQV * ZPPFDDIFFRAC - PQBEAMV(JJ) = ZQV - PQDIFFV(JJ) - ZQN = PSOLAR(JJ) - ZQV - PQDIFFN(JJ) = ZQN * ZFRACDIFF - PQBEAMN(JJ) = ZQN - PQDIFFN(JJ) - -ENDDO - -END SUBROUTINE SOLARFRACTIONS - -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO -! -! SUBROUTINE CANOPYRAD -! -! CANOPY LIGHT ENVIRONMENT MODEL -! CODE DEVELOPED BY ALEX GUENTHER, BASED ON SPITTERS ET AL. (1986), -! GOUDRIAN AND LAAR (1994), LEUNING (1997) -! INITIAL CODE 8-99, MODIFIED 7-2000 AND 12-2001 -! -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO -SUBROUTINE CANOPYRAD(KCANTYPE, PCANOPYCHAR, PDISTGAUSS, & - PLAI, PSINBETA, PQBEAMV, PQDIFFV, PQBEAMN, PQDIFFN, & - PSUNFRAC, PSUNQV, PSHADEQV, PSUNQN, PSHADEQN, & - PSUNPPFD, PSHADEPPFD, & - PQDABSV, PQDABSN, PQSABSV, PQSABSN, PQBABSV, PQBABSN) - -IMPLICIT NONE - -! INPUT -INTEGER, INTENT(IN) :: KCANTYPE -REAL, DIMENSION(:,:), INTENT(IN) :: PCANOPYCHAR -REAL, DIMENSION(:), INTENT(IN) :: PDISTGAUSS -! -REAL, DIMENSION(:), INTENT(IN) :: PLAI, PSINBETA, PQBEAMV, PQDIFFV, PQBEAMN, PQDIFFN -! OUTPUT -REAL, DIMENSION(:,:), INTENT(OUT) :: PSUNFRAC, PSUNQV, PSHADEQV, & - PSUNQN, PSHADEQN, PSHADEPPFD, PSUNPPFD -REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PQDABSV, PQDABSN, PQSABSV, PQSABSN -REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PQBABSV, PQBABSN - -! INTERNAL VARIABLES -REAL, DIMENSION(SIZE(PQBEAMV)) :: ZKB, ZLAIDEPTH, ZQDABSVL, ZQSABSVL, ZQDABSNL, ZQSABSNL, & - ZREFLBV, ZREFLBN, ZKBPV, ZKBPN, ZKDPV, ZKDPN -REAL, DIMENSION(SIZE(PQBEAMV)) :: ZQBABSV, ZQBABSN -REAL :: ZSCATV, ZSCATN, ZREFLDV, ZREFLDN, ZKD, ZCLUSTER -! -INTEGER :: JI, JJ -! -!--------------------------------------------------------------------- - - -! SCATTERING COEFFICIENTS (SCATV,SCATN), DIFFUSE AND BEAM REFLECTION -! COEFFICIENTS (REF..) FOR VISIBLE OR NEAR IR -ZSCATV = PCANOPYCHAR(5,KCANTYPE) -ZSCATN = PCANOPYCHAR(6,KCANTYPE) -ZREFLDV = PCANOPYCHAR(7,KCANTYPE) -ZREFLDN = PCANOPYCHAR(8,KCANTYPE) -ZCLUSTER = PCANOPYCHAR(9,KCANTYPE) -! -! EXTINCTION COEFFICIENTS FOR BLACK LEAVES FOR BEAM (KB) OR DIFFUSE (KD) -ZKB(:) = ZCLUSTER * 0.5 / MAX(0.00002,PSINBETA(:)) -! (0.5 ASSUMES A SPHERICAL LEAF ANGLE DISTRIBUTION (0.5 = COS (60 DEG)) -ZKD = 0.8 * ZCLUSTER -! (0.8 ASSUMES A SPHERICAL LEAF ANGLE DISTRIBUTION) - -CALL CALCEXTCOEFF(ZSCATV,ZKD,PQBEAMV,ZKB,ZREFLBV,ZKBPV,ZKDPV,ZQBABSV) -CALL CALCEXTCOEFF(ZSCATN,ZKD,PQBEAMN,ZKB,ZREFLBN,ZKBPN,ZKDPN,ZQBABSN) - -PSUNFRAC(:,:) = 0. -DO JI = 1,NLAYERS - -! PLAI DEPTH AT THIS LAYER - ZLAIDEPTH(:) = PLAI(:) * PDISTGAUSS(JI) -!FRACTION OF LEAVES THAT ARE SUNLIT - PSUNFRAC(:,JI) = EXP(-ZKB(:) * ZLAIDEPTH(:)) - - - CALL CALCRADCOMPONENTS(ZSCATV, ZREFLDV, PQDIFFV, PQBEAMV, ZKDPV, ZKBPV, ZKB, & - ZREFLBV, ZLAIDEPTH, ZQDABSVL, ZQSABSVL) - - CALL CALCRADCOMPONENTS(ZSCATN, ZREFLDN, PQDIFFN, PQBEAMN, ZKDPN, ZKBPN, ZKB, & - ZREFLBN, ZLAIDEPTH, ZQDABSNL, ZQSABSNL) - - - PSHADEPPFD(:,JI) = (ZQDABSVL(:) + ZQSABSVL(:)) * XCONVERTSHADEPPFD / (1. - ZSCATV) - PSUNPPFD (:,JI) = PSHADEPPFD(:,JI) + (ZQBABSV(:) * XCONVERTSUNPPFD / (1. - ZSCATV)) - PSHADEQV (:,JI) = ZQDABSVL(:) + ZQSABSVL(:) - PSUNQV (:,JI) = PSHADEQV(:,JI) + ZQBABSV(:) - PSHADEQN (:,JI) = ZQDABSNL(:) + ZQSABSNL(:) - PSUNQN (:,JI) = PSHADEQN(:,JI) + ZQBABSN(:) - IF (PRESENT(PQDABSV)) PQDABSV (:,JI) = ZQDABSVL(:) - IF (PRESENT(PQSABSV)) PQSABSV (:,JI) = ZQSABSVL(:) - IF (PRESENT(PQDABSN)) PQDABSN (:,JI) = ZQDABSNL(:) - IF (PRESENT(PQSABSN)) PQSABSN (:,JI) = ZQSABSNL(:) -! - -ENDDO - - -DO JJ = 1,SIZE(PQBEAMV) - - IF ( (PQBEAMV(JJ)+PQDIFFV(JJ))<=0.001 .OR. PSINBETA(JJ)<=0.00002 .OR. PLAI(JJ)<=0.001 ) THEN - ! NIGHT TIME - ZQBABSV(JJ) = 0. - ZQBABSN(JJ) = 0. - - PSUNFRAC (JJ,:) = 0.2 - PSUNQN (JJ,:) = 0. - PSHADEQN (JJ,:) = 0. - PSUNQV (JJ,:) = 0. - PSHADEQV (JJ,:) = 0. - PSUNPPFD (JJ,:) = 0. - PSHADEPPFD(JJ,:) = 0. - IF (PRESENT(PQDABSV)) PQDABSV(JJ,:) = 0. - IF (PRESENT(PQSABSV)) PQSABSV(JJ,:) = 0. - IF (PRESENT(PQDABSN)) PQDABSN(JJ,:) = 0. - IF (PRESENT(PQSABSN)) PQSABSN(JJ,:) = 0. - - ENDIF - -END DO - -IF (PRESENT(PQBABSV)) PQBABSV(:) = ZQBABSV(:) -IF (PRESENT(PQBABSN)) PQBABSN(:) = ZQBABSN(:) - -END SUBROUTINE CANOPYRAD - -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO -! -! SUBROUTINE CALCEXTCOEFF -! -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO - -SUBROUTINE CALCEXTCOEFF(PSCAT, PKD, PQBEAM, PKB, PREFLB, PKBP, PKDP, PQBEAMABSORB) -! -IMPLICIT NONE -! -REAL, INTENT(IN) :: PSCAT, PKD -REAL, DIMENSION(:), INTENT(IN) :: PQBEAM, PKB -REAL, DIMENSION(:), INTENT(OUT) :: PREFLB, PKBP, PKDP, PQBEAMABSORB - -! LOCAL VARIABLES -REAL :: ZP -INTEGER :: JJ -!------------------------------------------------------------------- - -ZP = (1.-PSCAT)**0.5 - -DO JJ = 1,SIZE(PKB) - - PREFLB(JJ) = 1. - EXP((-2. * ((1.-ZP)/(1.+ZP)) * PKB(JJ)) / (1. + PKB(JJ))) - - ! EXTINCTION COEFFICIENTS - PKBP(JJ) = PKB(JJ) * ZP - PKDP(JJ) = PKD * ZP - ! ABSORBED BEAM RADIATION - PQBEAMABSORB(JJ) = PKB(JJ) * PQBEAM(JJ) * (1 - PSCAT) - -ENDDO - -END SUBROUTINE CALCEXTCOEFF - -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO -! -! SUBROUTINE CALCRADCOMPONENTS -! -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO - -SUBROUTINE CALCRADCOMPONENTS(PSCAT, PREFLD, PQDIFF, PQBEAM, PKDP, PKBP, PKB, & - PREFLB, PLAIDEPTH, PQDABS, PQSABS) - -IMPLICIT NONE - -REAL, INTENT(IN) :: PSCAT, PREFLD -REAL, DIMENSION(:), INTENT(IN) :: PQDIFF, PQBEAM, PKDP, PKBP, PKB, PREFLB, PLAIDEPTH -REAL, DIMENSION(:), INTENT(OUT) :: PQDABS, PQSABS -!------------------------------------------------------------------- - -PQDABS(:) = PQDIFF(:) * PKDP(:) * (1. - PREFLD) * EXP(-PKDP(:) * PLAIDEPTH(:)) - -PQSABS(:) = PQBEAM(:) * ((PKBP(:) * (1. - PREFLB(:)) * EXP(-PKBP(:) * PLAIDEPTH(:))) & - - (PKB(:) * (1. - PSCAT) * EXP(-PKB (:) * PLAIDEPTH(:)))) - -END SUBROUTINE CALCRADCOMPONENTS - -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO -! -! SUBROUTINE CANOPYEB -! -! CANOPY ENERGY BALANCE MODEL FOR ESTIMATING LEAF TEMPERATURE -! CODE DEVELOPED BY ALEX GUENTHER, BASED ON GOUDRIAN AND LAAR (1994), -! LEUNING (1997) -! INITIAL CODE 8-99, MODIFIED 7-2000 AND 12-2001 -! -! NOTE: I DENOTES AN ARRAY CONTAINING A VERTICAL PROFILE THROUGH THE -! CANOPY WITH 0 -! (ABOVE CANOPY CONDITIONS) PLUS 1 TO NUMBER OF CANOPY LAYERS -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO - -SUBROUTINE CANOPYEB(KCANTYPE, PCANOPYCHAR, PDISTGAUSS, PSTOMATADI, & - PTAIRK0, PWS0, PTRATE, PHUMIDAIRPA0, & - PSUNQV, PSHADEQV, PSUNQN, PSHADEQN, PSUNPPFD, PSHADEPPFD, & - PSUNLEAFTK, PSHADELEAFTK, PSUNLEAFSH, PSHADELEAFSH, & - PTAIRK, PHUMIDAIRPA, PWS, & - PSUNLEAFLH, PSUNLEAFIR, PSHADELEAFLH, PSHADELEAFIR) - -IMPLICIT NONE - -! INPUTS -INTEGER, INTENT(IN) :: KCANTYPE -REAL, DIMENSION(:,:), INTENT(IN) :: PCANOPYCHAR -REAL, DIMENSION(:), INTENT(IN) :: PDISTGAUSS -REAL, INTENT(IN) :: PSTOMATADI -! -REAL, DIMENSION(:), INTENT(IN) :: PTRATE, PTAIRK0, PWS0, PHUMIDAIRPA0 -REAL, DIMENSION(:,:), INTENT(IN) :: PSUNQV, PSHADEQV, & - PSUNQN, PSHADEQN, PSUNPPFD, PSHADEPPFD - -! OUTPUTS -REAL, DIMENSION(:,:), INTENT(OUT) :: PSUNLEAFTK, PSHADELEAFTK, PSUNLEAFSH, PSHADELEAFSH -! -REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PTAIRK, PHUMIDAIRPA, PWS, & - PSUNLEAFLH, PSHADELEAFLH,& - PSUNLEAFIR, PSHADELEAFIR -! LOCAL VARIABLES -REAL :: ZLDEPTH, ZWSH -REAL, DIMENSION(SIZE(PTRATE)) :: ZTAIRK, ZHUMIDAIRPA, ZWS, & - ZSUNLEAFLH, ZSHADELEAFLH, ZSUNLEAFIR, ZSHADELEAFIR -! -REAL, DIMENSION(SIZE(PTRATE)) :: ZDELTAH, ZIRIN, ZIROUT -REAL :: ZCDEPTH, ZLWIDTH, ZLLENGTH, ZCHEIGHT, ZEPS, ZTRANSPIRETYPE -INTEGER :: JI -! -!----------------------------------------------------------------------- - -ZCDEPTH = PCANOPYCHAR(1, KCANTYPE) -!ZLWIDTH = PCANOPYCHAR(2, KCANTYPE) -ZLLENGTH = PCANOPYCHAR(3, KCANTYPE) -ZCHEIGHT = PCANOPYCHAR(4, KCANTYPE) -ZEPS = PCANOPYCHAR(10,KCANTYPE) -ZTRANSPIRETYPE = PCANOPYCHAR(11,KCANTYPE) - -WHERE ( PTAIRK0(:) >288. ) -! PA M-1 (PHUMIDITY PROFILE FOR T < 288) - ZDELTAH(:) = PCANOPYCHAR(14,KCANTYPE) / ZCHEIGHT -ELSEWHERE ( PTAIRK0(:)>278. ) - ZDELTAH(:) = ( PCANOPYCHAR(14,KCANTYPE) - ( (288.-PTAIRK0(:))/10.) * & - ( PCANOPYCHAR(14,KCANTYPE) - PCANOPYCHAR(15,KCANTYPE)) ) / ZCHEIGHT -ELSEWHERE -! PA M-1 (PHUMIDITY PROFILE FOR T <278) - ZDELTAH(:) = PCANOPYCHAR(15,KCANTYPE) / ZCHEIGHT -END WHERE - -DO JI = 1,SIZE(PDISTGAUSS) - - ZLDEPTH = ZCDEPTH * PDISTGAUSS(JI) - ZWSH = ( ZCHEIGHT - ZLDEPTH ) - ( PCANOPYCHAR(16,KCANTYPE) * ZCHEIGHT ) - - ZTAIRK (:) = PTAIRK0 (:) + (PTRATE (:) * ZLDEPTH) ! CHECK THIS - ZHUMIDAIRPA(:) = PHUMIDAIRPA0(:) + (ZDELTAH(:) * ZLDEPTH) - IF ( ZWSH.GT.1E-3 ) THEN - ZWS(:) = ( PWS0(:) * LOG(ZWSH) / LOG(ZCHEIGHT-PCANOPYCHAR(16,KCANTYPE)*ZCHEIGHT) ) - ELSE - ZWS(:) = 0.05 - END IF - - ZIRIN(:) = UNEXPOSEDLEAFIRIN(ZEPS, ZTAIRK) - - ZSUNLEAFIR(:) = 0.5 * EXPOSEDLEAFIRIN(PHUMIDAIRPA0,PTAIRK0) + 1.5*ZIRIN(:) - -! SUN - CALL LEAFEB(ZEPS, ZTRANSPIRETYPE, ZLLENGTH, PSTOMATADI, & - PSUNPPFD(:,JI), PSUNQV(:,JI)+PSUNQN(:,JI), & - ZSUNLEAFIR, ZTAIRK, ZHUMIDAIRPA, ZWS, & - PSUNLEAFTK(:,JI), PSUNLEAFSH(:,JI), ZSUNLEAFLH, & - ZIROUT ) -! - IF (PRESENT(PSUNLEAFIR)) PSUNLEAFIR(:,JI) = ZSUNLEAFIR(:) - ZIROUT(:) - -! SHADE - ZSHADELEAFIR(:) = 2. * ZIRIN(:) - - CALL LEAFEB(ZEPS, ZTRANSPIRETYPE, ZLLENGTH, PSTOMATADI, & - PSHADEPPFD(:,JI), PSHADEQV(:,JI)+PSHADEQN(:,JI), & - ZSHADELEAFIR, ZTAIRK, ZHUMIDAIRPA, ZWS, & - PSHADELEAFTK(:,JI), PSHADELEAFSH(:,JI), ZSHADELEAFLH, & - ZIROUT ) -! - IF (PRESENT(PSHADELEAFIR)) PSHADELEAFIR(:,JI) = ZSHADELEAFIR(:) - ZIROUT(:) - - IF (PRESENT(PTAIRK)) PTAIRK (:,JI) = ZTAIRK (:) - IF (PRESENT(PHUMIDAIRPA)) PHUMIDAIRPA (:,JI) = ZHUMIDAIRPA (:) - IF (PRESENT(PWS)) PWS (:,JI) = ZWS (:) - IF (PRESENT(PSUNLEAFLH)) PSUNLEAFLH (:,JI) = ZSUNLEAFLH (:) - IF (PRESENT(PSHADELEAFLH)) PSHADELEAFLH(:,JI) = ZSHADELEAFLH(:) - -ENDDO -! -END SUBROUTINE CANOPYEB - -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO -! -! SUBROUTINE LEAFEB -! -! LEAF ENERGY BALANCE -! -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO - -SUBROUTINE LEAFEB(PEPS, PTRANSPIRETYPE, PLLENGTH, PSTOMATADI, & - PPFD, PQ, PIRIN, PTAIRK, PHUMIDAIRPA, PWS, & - PTLEAF, PSH, PLH, PIROUT) - -IMPLICIT NONE - -REAL, INTENT(IN) :: PEPS, PTRANSPIRETYPE, PLLENGTH, PSTOMATADI -REAL, DIMENSION(:), INTENT(IN) :: PPFD, PQ, PIRIN, PTAIRK, PHUMIDAIRPA, PWS -REAL, DIMENSION(:), INTENT(OUT) :: PTLEAF, PSH, PLH, PIROUT - -! LOCAL VARIABLES -REAL, DIMENSION(SIZE(PPFD)) :: ZHUMIDAIRKGM3, ZGHFORCED, ZSTOMRES, ZIROUTAIRT, ZLATHV, & - ZLHAIRT, ZTDELT, ZBALANCE, ZGH1, ZSH1, ZLH1, ZE1, ZIROUT1, ZGH, & - ZTAIRK, ZVAPDEFICIT -INTEGER :: JI -!---------------------------------------------------- - -! AIR VAPOR DENSITY KG M-3 -ZHUMIDAIRKGM3(:) = CONVERTHUMIDITYPA2KGM3(PHUMIDAIRPA, PTAIRK) - -! LATENT HEAT OF VAPORIZATION (J KG-1) -ZLATHV(:) = LHV(PTAIRK) -! -! HEAT CONVECTION COEFFICIENT (W M-2 K-1) FOR FORCED CONVECTION. -! NOBEL PAGE 366 -ZGHFORCED(:) = 0.0259 / (0.004 * ((PLLENGTH / PWS(:))**0.5)) -! -! STOMATAL RESISTENCE S M-1 -ZSTOMRES (:) = RESSC(PSTOMATADI, PPFD) -! -! LATENT HEAT FLUX -ZVAPDEFICIT(:) = SVDTK(PTAIRK(:)) - ZHUMIDAIRKGM3(:) -ZLHAIRT(:) = LEAFLE(PTRANSPIRETYPE, ZVAPDEFICIT, ZLATHV, ZGHFORCED, ZSTOMRES) -! -ZIROUTAIRT(:) = LEAFIROUT(PEPS, PTAIRK) -ZE1(:) = (PQ(:) + PIRIN(:) - ZIROUTAIRT(:) - ZLHAIRT(:)) -WHERE ( ZE1(:).EQ.0. ) ZE1(:) = -1. -! -ZTDELT (:) = 1. -ZBALANCE(:) = 10. -DO JI = 1, 10 - ! - WHERE ( ABS(ZBALANCE(:))>2. ) - ! - ZTAIRK (:) = PTAIRK(:) + ZTDELT(:) - ! - ! LATENT HEAT OF VAPORIZATION (J KG-1) - ZLATHV(:) = LHV(ZTAIRK) - ! BOUNDARY LAYER CONDUCTANCE - ZGH1 (:) = LEAFBLC(PLLENGTH, ZGHFORCED, ZTDELT) - ! - ZVAPDEFICIT(:) = SVDTK(ZTAIRK(:)) - ZHUMIDAIRKGM3(:) - PLH (:) = LEAFLE(PTRANSPIRETYPE, ZVAPDEFICIT, ZLATHV, ZGH1, ZSTOMRES) - ! - PIROUT (:) = LEAFIROUT(PEPS, PTAIRK+ZTDELT) - ZIROUT1(:) = PIROUT(:) - ZIROUTAIRT(:) - ! - ! CONVECTIVE HEAT FLUX - ZSH1(:) = LEAFH(ZTDELT, ZGH1) - ZLH1(:) = PLH(:) - ZLHAIRT(:) - ! - ZTDELT (:) = ZE1(:) / ((ZSH1(:) + ZLH1(:) + ZIROUT1(:)) / ZTDELT(:)) - ZBALANCE(:) = PQ(:) + PIRIN(:) - PIROUT(:) - ZSH1(:) - PLH(:) - END WHERE - ! - IF (ALL(ZBALANCE(:)<=2.)) EXIT - ! -ENDDO -! -ZTDELT(:) = MAX(-10.,MIN(ZTDELT(:),10.)) -! -PTLEAF(:) = PTAIRK(:) + ZTDELT(:) -! -ZGH(:) = LEAFBLC(PLLENGTH, ZGHFORCED, ZTDELT) -PSH(:) = LEAFH (ZTDELT, ZGH) -! -ZVAPDEFICIT(:) = SVDTK(PTLEAF(:)) - ZHUMIDAIRKGM3(:) -PLH(:) = LEAFLE (PTRANSPIRETYPE, ZVAPDEFICIT, ZLATHV, ZGH, ZSTOMRES) -PIROUT(:) = LEAFIROUT(PEPS, PTLEAF) -! -END SUBROUTINE LEAFEB - -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO -! -! FUNCTION DISTOMATA -! -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO - -FUNCTION DISTOMATA(PDI) RESULT(PDISTOMATA) - -IMPLICIT NONE - -REAL, INTENT(IN) :: PDI -REAL :: PDISTOMATA -INTEGER :: JJ -! > -.5 INCIPIENT, MILD OR NO DROUGHT; < -4 EXTREME DROUGHT -!-------------------------------------------------------------------- - -IF ( PDI>XDIHIGH ) THEN - PDISTOMATA = 1. ! NO DROUGHT -ELSEIF ( PDI>XDILOW ) THEN - ! INTERPOLATE - PDISTOMATA = 1. - (0.9 * ((PDI - XDIHIGH) / (XDILOW - XDIHIGH))) -ELSE - PDISTOMATA = 0. ! MAXIMUM DROUGHT, MAXIMUM STOMATAL RESISTANCE -ENDIF - -END FUNCTION DISTOMATA - -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO -! -! FUNCTION CALCECCENTRICITY -! -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO - -FUNCTION CALCECCENTRICITY(KDAY) RESULT(PCALCECCENTRICITY) - -IMPLICIT NONE - -INTEGER, DIMENSION(:), INTENT(IN) :: KDAY -! -REAL, DIMENSION(SIZE(KDAY)) :: PCALCECCENTRICITY -! -!-------------------------------------------------------------------- - -PCALCECCENTRICITY(:) = 1. + 0.033 * COS(2*3.14*(KDAY(:)-10)/365) - -END FUNCTION CALCECCENTRICITY - -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO -! -! FUNCTION UNEXPOSEDLEAFIRIN -! -! CALCULATE IR INTO LEAF THAT IS NOT EXPOSED TO THE SKY -! -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO - -FUNCTION UNEXPOSEDLEAFIRIN(PEPS, PTK) RESULT(PUNEXPOSEDLEAFIRIN) - -IMPLICIT NONE - -REAL, INTENT(IN) :: PEPS -REAL, DIMENSION(:), INTENT(IN) :: PTK -REAL, DIMENSION(SIZE(PTK)) :: PUNEXPOSEDLEAFIRIN -!-------------------------------------------------------------------- - -PUNEXPOSEDLEAFIRIN(:) = PEPS * XSB * (PTK(:)**4.) - -END FUNCTION UNEXPOSEDLEAFIRIN - -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO -! -! FUNCTION EXPOSEDLEAFIRIN -! -! CALCULATE IR INTO LEAF THAT IS EXPOSED TO THE SKY -! -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO - -FUNCTION EXPOSEDLEAFIRIN(PHUMIDPA, PTK) RESULT(PEXPOSEDLEAFIRIN) - -IMPLICIT NONE - -REAL, DIMENSION(:), INTENT(IN) :: PTK, PHUMIDPA -REAL, DIMENSION(SIZE(PTK)) :: PEXPOSEDLEAFIRIN -REAL :: ZEMISSATM -INTEGER :: JJ -!-------------------------------------------------------------------- - -! APPARENT ATMOSPHERIC EMISSIVITY FOR CLEAR SKIES: -! FUNCTION OF WATER VAPOR PRESSURE (PA) -! AND AMBIENT TEMPERATURE (K) BASED ON BRUTSAERT(1975) -! REFERENCED IN LEUNING (1997) - -DO JJ = 1,SIZE(PTK) - ZEMISSATM = 0.642 * (PHUMIDPA(JJ) / PTK(JJ))**(1./7.) - PEXPOSEDLEAFIRIN(JJ) = ZEMISSATM * XSB * (PTK(JJ)**4.) -ENDDO - -END FUNCTION EXPOSEDLEAFIRIN - -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO -! -! FUNCTION WATERVAPPRES -! -! CONVERT WATER MIXING RATIO (KG/KG) TO WATER VAPOR PRESSURE -! (PA OR KPA DEPENDING ON UNITS OF INPUT ) -! MIXING RATIO (KG/KG), TEMP (C), PRESSURE (KPA) -! -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO - -FUNCTION WATERVAPPRES(PWATERAIRRATIO, PDENS, PRES) RESULT(PWATERVAPPRES) - -IMPLICIT NONE - -REAL, INTENT(IN) :: PWATERAIRRATIO -REAL, DIMENSION(:), INTENT(IN) :: PDENS, PRES -REAL, DIMENSION(SIZE(PDENS)) :: PWATERVAPPRES -!-------------------------------------------------------------------- - -PWATERVAPPRES(:) = (PDENS(:) / (PDENS(:) + PWATERAIRRATIO)) * PRES(:) - -END FUNCTION WATERVAPPRES - -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO -! -! FUNCTION STABILITY -! -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO - -FUNCTION STABILITY(PCANOPYCHAR, KCANTYPE, PSOLAR) RESULT(PSTABILITY) - -IMPLICIT NONE -! -REAL, DIMENSION(:,:), INTENT(IN) :: PCANOPYCHAR -INTEGER, INTENT(IN) :: KCANTYPE -REAL, DIMENSION(:), INTENT(IN) :: PSOLAR -REAL, DIMENSION(SIZE(PSOLAR)) :: PSTABILITY -REAL :: ZTRATEBOUNDARY -INTEGER :: JJ -!-------------------------------------------------------------------- - -ZTRATEBOUNDARY = 500 - -DO JJ = 1,SIZE(PSOLAR) - IF ( PSOLAR(JJ)>ZTRATEBOUNDARY ) THEN - ! DAYTIME TEMPERATURE LAPSE RATE - PSTABILITY(JJ) = PCANOPYCHAR(12,KCANTYPE) - ELSEIF ( PSOLAR(JJ)>0. ) THEN - PSTABILITY(JJ) = PCANOPYCHAR(12,KCANTYPE) - & - ( (ZTRATEBOUNDARY - PSOLAR(JJ)) / ZTRATEBOUNDARY ) * & - (PCANOPYCHAR(12,KCANTYPE) - PCANOPYCHAR(13,KCANTYPE)) - ELSE - ! NIGHTIME TEMPERATURE LAPSE RATE - PSTABILITY = PCANOPYCHAR(13,KCANTYPE) - ENDIF -ENDDO - -END FUNCTION STABILITY - -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO -! -! FUNCTION CONVERTHUMIDITYPA2KGM3 -! -! SATURATION VAPOR DENSITY (KG/M3) -! -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO - -FUNCTION CONVERTHUMIDITYPA2KGM3(PA, PTK) RESULT(PCONVERTHUMIDITYPA2KGM3) - -IMPLICIT NONE - -REAL, DIMENSION(:), INTENT(IN) :: PA, PTK -REAL, DIMENSION(SIZE(PA)) :: PCONVERTHUMIDITYPA2KGM3 -!-------------------------------------------------------------------- - -PCONVERTHUMIDITYPA2KGM3(:) = 0.002165 * PA(:) / PTK(:) - -END FUNCTION CONVERTHUMIDITYPA2KGM3 - -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO -! -! FUNCTION RESSC -! -! LEAF STOMATAL COND. RESISTANCE S M-1 -! -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO - -FUNCTION RESSC(PSTOMATADI, PAR) RESULT(PRESSC) - -IMPLICIT NONE - -REAL, INTENT(IN) :: PSTOMATADI -REAL, DIMENSION(:), INTENT(IN) :: PAR -REAL, DIMENSION(SIZE(PAR)) :: PRESSC -REAL, DIMENSION(SIZE(PAR)) :: ZSCADJ -INTEGER :: JJ -!-------------------------------------------------------------------- - -ZSCADJ(:) = PSTOMATADI * & - ( (0.0027*1.066*PAR(:)) / ((1 + 0.0027*0.0027*PAR(:)**2.)**0.5) ) -! -WHERE (ZSCADJ(:)<0.1) - PRESSC(:) = 2000. -ELSE WHERE - PRESSC(:) = 200./ZSCADJ(:) -END WHERE - -END FUNCTION RESSC - -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO -! -! FUNCTION LEAFIROUT -! -! IR THERMAL RADIATION ENERGY OUTPUT BY LEAF -! -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO - -FUNCTION LEAFIROUT(PEPS, PTLEAF) RESULT(PLEAFIROUT) - -IMPLICIT NONE - -REAL, INTENT(IN) :: PEPS -REAL, DIMENSION(:), INTENT(IN) :: PTLEAF -REAL, DIMENSION(SIZE(PTLEAF)) :: PLEAFIROUT -!-------------------------------------------------------------------- - -! PRINT*,'EPS, SB, TLEAF =', EPS, SB, TLEAF -PLEAFIROUT(:) = PEPS * XSB * (2 * (PTLEAF(:)**4.)) - -END FUNCTION LEAFIROUT - -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO -! -! FUNCTION LHV -! -! LATENT HEAT OF VAPORIZATION(J KG-1) FROM STULL P641 -! -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO - -FUNCTION LHV(PTK) RESULT(PLHV) - -IMPLICIT NONE - -REAL, DIMENSION(:), INTENT(IN) :: PTK -REAL, DIMENSION(SIZE(PTK)) :: PLHV -!-------------------------------------------------------------------- - -PLHV(:) = 2501000. - (2370. * (PTK(:) - 273.)) - -END FUNCTION LHV - -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO -! -! FUNCTION LEAFLE -! -! LATENT ENERGY TERM IN ENERGY BALANCE -! -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO - -FUNCTION LEAFLE(PTRANSPIRETYPE, PVAPDEFICIT, PLATHV, PGH, PSTOMRES) RESULT(PLEAFLE) - -IMPLICIT NONE - -REAL, INTENT(IN) :: PTRANSPIRETYPE -REAL, DIMENSION(:), INTENT(IN) :: PVAPDEFICIT, PLATHV, PGH, PSTOMRES -REAL, DIMENSION(SIZE(PLATHV)) :: PLEAFLE -REAL, DIMENSION(SIZE(PLATHV)) :: ZLEAFRES -!INTEGER :: JJ -!-------------------------------------------------------------------- - -ZLEAFRES(:) = (1. / (1.075 * (PGH(:) / 1231.))) + PSTOMRES(:) - -! LATENT HEAT OF VAP (J KG-1) * VAP DEFICIT(KG M-3) / -! LEAF RESISTENCE (S M-1) -PLEAFLE(:) = PTRANSPIRETYPE * (1./ZLEAFRES(:)) * PLATHV(:) * PVAPDEFICIT(:) -! -PLEAFLE(:) = MAX(PLEAFLE(:),0.) -! -END FUNCTION LEAFLE - -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO -! -! FUNCTION LEAFBLC -! -! BOUNDARY LAYER CONDUCTANCE -! -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO - -FUNCTION LEAFBLC(PLLENGTH, PGHFORCED, PTDELTA) RESULT(PLEAFBLC) - -IMPLICIT NONE - -REAL, INTENT(IN) :: PLLENGTH -REAL, DIMENSION(:), INTENT(IN) :: PGHFORCED, PTDELTA -REAL, DIMENSION(SIZE(PTDELTA)) :: PLEAFBLC -REAL, DIMENSION(SIZE(PTDELTA)) :: ZGHFREE -REAL :: ZLLENGTH3 -INTEGER :: JJ -!-------------------------------------------------------------------- - -! THIS IS BASED ON LEUNING 1995 P.1198 EXCEPT USING MOLECULAR -! CONDUCTIVITY (.00253 W M-1 K-1 STULL P 640) INSTEAD OF MOLECULAR -! DIFFUSIVITY SO THAT YOU END UP WITH A HEAT CONVECTION COEFFICIENT -! (W M-2 K-1) INSTEAD OF A CONDUCTANCE FOR FREE CONVECTION -! -ZLLENGTH3 = PLLENGTH**3 -! -WHERE (PTDELTA(:)>=0.) - ZGHFREE (:) = 0.5 * 0.00253 * ((160000000. * PTDELTA(:) / (ZLLENGTH3))**0.25) / PLLENGTH - PLEAFBLC(:) = PGHFORCED(:) + ZGHFREE(:) -ELSE WHERE - PLEAFBLC(:) = PGHFORCED(:) -END WHERE -! -END FUNCTION LEAFBLC - -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO -! -! FUNCTION LEAFH -! -! CONVECTIVE ENERGY TERM IN ENERGY BALANCE (W M-2 HEAT FLUX FROM -! BOTH SIDES OF LEAF) -! -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO - -FUNCTION LEAFH(PTDELTA, PGH) RESULT(PLEAFH) - -IMPLICIT NONE - -REAL, DIMENSION(:), INTENT(IN) :: PTDELTA, PGH -REAL, DIMENSION(SIZE(PGH)) :: PLEAFH -!-------------------------------------------------------------------- - -! 2 SIDES X CONDUCTANCE X TEMPERATURE GRADIENT -PLEAFH(:) = 2. * PGH(:) * PTDELTA(:) - -END FUNCTION LEAFH - -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO -! -! FUNCTION SVDTK -! -! SATURATION VAPOR DENSITY (KG/M3) -! -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO - -FUNCTION SVDTK(PTK) RESULT(PSVDTK) - -IMPLICIT NONE - -REAL, DIMENSION(:), INTENT(IN) :: PTK -REAL, DIMENSION(SIZE(PTK)) :: PSVDTK -REAL, DIMENSION(SIZE(PTK)) :: ZSVP -INTEGER :: JJ -!-------------------------------------------------------------------- - -! SATURATION VAPOR PRESSURE (MILLIBARS) -ZSVP (:) = 10.**((-2937.4 / PTK(:)) - (4.9283 * LOG10(PTK(:))) + 23.5518) -PSVDTK(:) = 0.2165 * ZSVP(:) / PTK(:) - -END FUNCTION SVDTK - -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO -! -! FUNCTION EA1T99 -! -! TEMPERATURE DEPENDENCE ACTIVITY FACTOR FOR EMISSION TYPE 1 -! (E.G. ISOPRENE, MBO) -! -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO - -FUNCTION EA1T99(HSPC_NAME, PT24, PT240, PT1) RESULT(PEA1T99) - -USE MODI_INDEX1 - -IMPLICIT NONE - -CHARACTER(LEN=16),INTENT(IN) :: HSPC_NAME -REAL, DIMENSION(:), INTENT(IN) :: PT1, PT24, PT240 -REAL, DIMENSION(SIZE(PT1)) :: PEA1T99 -REAL :: ZTOPT, ZX, ZEOPT -INTEGER :: ISPCNUM -INTEGER :: JJ -!-------------------------------------------------------------------- - -ISPCNUM = INDEX1(HSPC_NAME, CMGN_SPC) -! -DO JJ = 1,SIZE(PT1) - IF ( PT1(JJ)<260. ) THEN - PEA1T99(JJ) = 0. - ELSE - ! ENERGY OF ACTIVATION AND DEACTIVATION - ! TEMPERATURE AT WHICH MAXIMUM EMISSION OCCURS - ZTOPT = 312.5 + 0.6 * (PT240(JJ) - 297) - ZX = ((1 / ZTOPT) - (1 / PT1(JJ))) / 0.00831 - - ! MAXIMUM EMISSION (RELATIVE TO EMISSION AT 30 C) - ZEOPT = XCLEO(ISPCNUM) * EXP(0.05 * (PT24(JJ) - 297)) * EXP(0.05*(PT240(JJ)-297)) - - PEA1T99(JJ) = ZEOPT * XCTM2 * EXP(XCTM1(ISPCNUM)*ZX) / & - (XCTM2 - XCTM1(ISPCNUM) * (1.-EXP(XCTM2*ZX))) - ENDIF - -ENDDO - -END FUNCTION EA1T99 - -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO -! -! FUNCTION EA1PP -! -! PSTD = 200 FOR SUN LEAVES AND 50 FOR SHADE LEAVES -! -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO - -FUNCTION EA1P99(PSTD, PPFD24, PPFD240, PPFD1) RESULT(PEA1P99) - -IMPLICIT NONE - -REAL, INTENT(IN) :: PSTD -REAL, DIMENSION(:), INTENT(IN) :: PPFD1, PPFD24, PPFD240 -REAL, DIMENSION(SIZE(PPFD1)) :: PEA1P99 -REAL :: ZALPHA, ZC1 -INTEGER :: JJ -!-------------------------------------------------------------------- - -DO JJ = 1,SIZE(PPFD1) - - IF ( PPFD240(JJ)<0.01 ) THEN - PEA1P99(JJ) = 0. - ELSE - ZALPHA = 0.004 - 0.0005 * LOG(PPFD240(JJ)) - ZC1 = 0.0468 * EXP(0.0005 * (PPFD24(JJ) - PSTD)) * (PPFD240(JJ)**0.6) - PEA1P99(JJ) = (ZALPHA * ZC1 * PPFD1(JJ)) / ((1 + ZALPHA**2. * PPFD1(JJ)**2.)**0.5) - ENDIF - -ENDDO - -END FUNCTION EA1P99 - -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO -! -! FUNCTION EALTI99 -! -! CALCULATE LIGHT INDEPENT ALGORITHMS -! CODED BY XUEMEI WANG 05 NOV. 2007 -!-- GAMMA_TLI = EXP[BETA*(T-TS)] -! WHERE BETA = TEMPERATURE DEPENDENT PARAMETER -! TS = STANDARD TEMPERATURE (NORMALLY 303K, 30C) -! -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO - -FUNCTION EALTI99(HSPCNAM, PTEMP) RESULT(PEALTI99) - -USE MODI_INDEX1 - -IMPLICIT NONE - -CHARACTER(LEN=16), INTENT(IN) :: HSPCNAM -REAL, DIMENSION(:), INTENT(IN) :: PTEMP -REAL, DIMENSION(SIZE(PTEMP)) :: PEALTI99 -! -INTEGER :: ISPCNUM ! SPECIES NUMBER -!-------------------------------------------------------------------- -ISPCNUM = INDEX1(HSPCNAM, CMGN_SPC) -PEALTI99(:) = EXP( XTDF_PRM(ISPCNUM)*(PTEMP(:)-XTS) ) - -END FUNCTION EALTI99 -! -!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO -! -END MODULE MODE_MEGAN diff --git a/src/ICCARE_BASE/mode_salt_psd.f90 b/src/ICCARE_BASE/mode_salt_psd.f90 deleted file mode 100644 index 1a4a9e799..000000000 --- a/src/ICCARE_BASE/mode_salt_psd.f90 +++ /dev/null @@ -1,836 +0,0 @@ -!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence -!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!ORILAM_LIC for details. -!----------------------------------------------------------------- -!--------------- special set of characters for RCS information -!----------------------------------------------------------------- -! $Source$ $Revision$ $Date$ -!----------------------------------------------------------------- -!! ######################## - MODULE MODE_SALT_PSD -!! ######################## -!! -!! PURPOSE -!! ------- -!! MODULE SALT PSD (Particle Size Distribution) -!! Purpose: Contains subroutines to convert from transported variables (ppp) -!! to understandable aerosol variables, e.g. #/m3, kg/m3, sigma, R_{n} -!! -!! AUTHOR -!! ------ -!! Alf Grini (CNRM/GMEI) -!! -!! MODIFICATIONS -!! ------------- -!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes -!! -!------------------------------------------------------------------------------- -! -! ++ JORIS DEBUG ++ -USE MODD_CONF, ONLY : NVERB -! -- JORIS DEBUG -- -! -USE MODD_CSTS_SALT !Constants which are important for sea salt calculations -USE MODD_SALT !Dust module which contains even more constants -USE MODD_CST, ONLY : & - XPI & !Definition of pi - ,XBOLTZ & ! Boltzman constant - ,XAVOGADRO & ![molec/mol] avogadros number - ,XG & ! Gravity constant - ,XP00 & ! Reference pressure - ,XMD & ![kg/mol] molar weight of air - ,XRD & ! Gaz constant for dry air - ,XCPD ! Cpd (dry air) -USE MODD_CST, ONLY : XMNH_TINY -! -IMPLICIT NONE -! -CONTAINS -! -!! ############################################################ - SUBROUTINE PPP2SALT( & - PSVT & !I [ppp] input scalar variables (moment of distribution) - , PRHODREF & !I [kg/m3] density of air - , PSIG3D & !O [-] standard deviation of aerosol distribution - , PRG3D & !O [um] number median diameter of aerosol distribution - , PN3D & !O [#/m3] number concentration of aerosols - , PMASS3D & !O [kg/m3] mass concentration of aerosol - , PM3D & !O aerosols moments 0, 3 and 6 - ) -!! ############################################################ -! -!! -!! PURPOSE -!! ------- -!! Translate the three moments M0, M3 and M6 given in ppp into -!! Values which can be understood more easily (R, sigma, N, M) -!! -!! CALLING STRUCTURE NOTE: OPTIONAL VARIABLES -!! ------- -!! CALL PPP2AEROS(PSVT, PRHODREF, PSIG3D=SIGVAR, & -!! PRG3D=RVAR, PN3D=NVAR, PM3D=MASSVAR) -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Pierre TULET (LA) -!! -!! MODIFICATIONS -!! ------------- -!! 2005 Alf Grini (CNRM) -!! 2006 Jean-Pierre Chaboureau (LA) -!! -!! EXTERNAL -!! -------- -!! None -!! - IMPLICIT NONE -!! -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -!* 0.1 declarations of arguments -! -REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT !I [ppp] first moment -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF !I [kg/m3] density of air - -REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PSIG3D !O [-] standard deviation -REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PRG3D !O [um] number median diameter -REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PN3D !O [#/m3] number concentration -REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PMASS3D !O [kg_{aer}/m3] mass concentration -REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PM3D !O aerosols moments -! -! -!* 0.2 declarations local variables -! -REAL :: ZRHOI ! [kg/m3] density of aerosol -REAL :: ZMI ! [kg/mol] molar weight of aerosol -REAL :: ZRGMIN ! [um] minimum radius accepted -REAL :: ZSIGMIN ! minimum standard deviation accepted -REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZM ! [aerosol units] local array which goes to output later -REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZSV ! [sea salts moment concentration] -REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZSIGMA ! [-] standard deviation -REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZRG ! [um] number median diameter -REAL,DIMENSION(:), ALLOCATABLE :: ZMMIN ! [aerosol units] minimum values for N, sigma, M -INTEGER,DIMENSION(:), ALLOCATABLE :: NM0 ! [idx] index for Mode 0 in passed variables -INTEGER,DIMENSION(:), ALLOCATABLE :: NM3 ! [idx] indexes for Mode 3 in passed variables -INTEGER,DIMENSION(:), ALLOCATABLE :: NM6 ! [idx] indexes for Mode 6 in passed variables -REAL,DIMENSION(:), ALLOCATABLE :: ZINIRADIUS ! initial mean radius -INTEGER :: JN,IMODEIDX,JJ ! [idx] loop counters -! -!------------------------------------------------------------------------------- -! -! 1.1 initialisation -! -!Calculations here are for one mode only -! -ALLOCATE (NM0(NMODE_SLT)) -ALLOCATE (NM3(NMODE_SLT)) -ALLOCATE (NM6(NMODE_SLT)) -ALLOCATE (ZM(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3), NMODE_SLT*3)) -ALLOCATE (ZMMIN(NMODE_SLT*3)) -ALLOCATE (ZSIGMA(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3))) -ALLOCATE (ZRG(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3))) -ALLOCATE (ZSV(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3), SIZE(PSVT,4))) -ALLOCATE (ZINIRADIUS(NMODE_SLT)) - -ZSV(:,:,:,:) = PSVT(:,:,:,:) -ZRG(:,:,:)= XMNH_TINY -ZM(:,:,:,:)= XMNH_TINY - -DO JN=1,NMODE_SLT - IMODEIDX = JPSALTORDER(JN) - !Calculations here are for one mode only - IF (CRGUNITS=="MASS") THEN - ZINIRADIUS(JN) = XINIRADIUS_SLT(IMODEIDX) * EXP(-3.*(LOG(XINISIG_SLT(IMODEIDX)))**2) - ELSE - ZINIRADIUS(JN) = XINIRADIUS_SLT(IMODEIDX) - END IF - - !Set counter for number, M3 and M6 - NM0(JN) = 1+(JN-1)*3 - NM3(JN) = 2+(JN-1)*3 - NM6(JN) = 3+(JN-1)*3 - !Get minimum values possible - ZMMIN(NM0(JN)) = XN0MIN_SLT(IMODEIDX) - ZRGMIN = ZINIRADIUS(JN) - IF (LVARSIG_SLT) THEN - ZSIGMIN = XINISIG_SLT(IMODEIDX) - ! ZSIGMIN = XSIGMIN_SLT - ELSE - ZSIGMIN = XINISIG_SLT(IMODEIDX) - ENDIF - ZMMIN(NM3(JN)) = ZMMIN(NM0(JN)) * (ZRGMIN**3)*EXP(4.5 * LOG(ZSIGMIN)**2) - ZMMIN(NM6(JN)) = ZMMIN(NM0(JN)) * (ZRGMIN**6)*EXP(18. * LOG(ZSIGMIN)**2) -END DO -! -!Set density of aerosol, here sea salt (kg/m3) -ZRHOI = XDENSITY_SALT -!Set molecular weight of sea salt !NOTE THAT THIS IS NOW IN KG -ZMI = XMOLARWEIGHT_SALT -! -! -DO JN=1,NMODE_SLT - ! - IF (LVARSIG_SLT) THEN ! give M6 (case of variable standard deviation) - ! - !Get number concentration (#/molec_{air}==>#/m3) - ZM(:,:,:,NM0(JN))= & - ZSV(:,:,:,1+(JN-1)*3) & !#/molec_{air} - * XAVOGADRO & !==>#/mole - / XMD & !==>#/kg_{air} - * PRHODREF(:,:,:) !==>#/m3 - ! - !calculate moment 3 from total aerosol mass (molec_{aer}/molec_{air} ==> - ZM(:,:,:,NM3(JN)) = & - ZSV(:,:,:,2+(JN-1)*3) & !molec_{aer}/molec_{aer} - * (ZMI/XMD) & !==>kg_{aer}/kg_{aer} - * PRHODREF(:,:,:) & !==>kg_{aer}/m3_{air} - * (1.d0/ZRHOI) & !==>m3_{aer}/m3_{air} - * XM3TOUM3_SALT & !==>um3_{aer}/m3_{air} - / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment) - ! - ZM(:,:,:,NM6(JN)) = ZSV(:,:,:,3+(JN-1)*3) & !um6/molec_{air}*(cm3/m3) - * 1.d-6 & !==> um6/molec_{air} - * XAVOGADRO & !==> um6/mole_{air} - / XMD & !==> um6/kg_{air} - * PRHODREF(:,:,:) !==> um6/m3_{air} - !Limit m6 concentration to minimum value -! ZM(:,:,:,NM6(JN)) = MAX(ZM(:,:,:,NM6(JN)), ZMMIN(NM6(JN))) - ! - !Get sigma (only if sigma is allowed to vary) - !Get intermediate values for sigma M3^2/(M0*M6) (ORILAM paper, eqn 8) - ZSIGMA(:,:,:)=ZM(:,:,:,NM3(JN))**2/(ZM(:,:,:,NM0(JN))*ZM(:,:,:,NM6(JN))) - !Limit the intermediate value, can not be larger than 1 - ZSIGMA(:,:,:)=MIN(1-1E-10,ZSIGMA(:,:,:)) - !Limit the value for intermediate, can not be smaller than 0 - ZSIGMA(:,:,:)=MAX(1E-10,ZSIGMA(:,:,:)) - !Calculate log(sigma) - ZSIGMA(:,:,:)= LOG(ZSIGMA(:,:,:)) - !Finally get the real sigma the negative sign is because of - !The way the equation is written (M3^2/(M0*M6)) instead of (M0*M6)/M3^3 - ZSIGMA(:,:,:)= EXP(1./3.*SQRT(-ZSIGMA(:,:,:))) - !Limit the value to reasonable ones - ZSIGMA(:,:,:) = MAX( XSIGMIN_SLT, MIN( XSIGMAX_SLT, ZSIGMA(:,:,:) ) ) - - ! - !Put back M6 so that it fits the sigma which is possibly modified above - !The following makes M6 consistent with N, R, SIGMA - ZM(:,:,:,NM6(JN)) = ZM(:,:,:,NM0(JN)) & - * ( (ZM(:,:,:,NM3(JN))/ZM(:,:,:,NM0(JN)))**(1./3.) & - * exp(-(3./2.)*log(ZSIGMA(:,:,:))**2))**6 & - * exp(18.*log(ZSIGMA(:,:,:))**2) - - ELSE ! compute M6 from M0, M3 and SIGMA - ! - ZSIGMA(:,:,:) = XINISIG_SLT(JPSALTORDER(JN)) - IF (LRGFIX_SLT) THEN - - !calculate moment 3 from total aerosol mass (molec_{aer}/molec_{air} ==> - ZM(:,:,:,NM3(JN)) = & - ZSV(:,:,:,JN) & !molec_{aer}/molec_{aer} - * (ZMI/XMD) & !==>kg_{aer}/kg_{aer} - * PRHODREF(:,:,:) & !==>kg_{aer}/m3_{air} - * (1.d0/ZRHOI) & !==>m3_{aer}/m3_{air} - * XM3TOUM3_SALT & !==>um3_{aer}/m3_{air} - / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment) -! ZM(:,:,:,NM3(JN)) = MAX(ZM(:,:,:,NM3(JN)), ZMMIN(NM3(JN))) -!Modif salt/dust 5.1. beg - PSVT(:,:,:,JN) = ZM(:,:,:,NM3(JN)) * XMD * XPI * 4./3. * ZRHOI / & - (ZMI*PRHODREF(:,:,:)*XM3TOUM3_SALT) -!Modif salt/dust 5.1. end - - ZM(:,:,:,NM0(JN))= ZM(:,:,:,NM3(JN))/& - ((ZINIRADIUS(JN)**3)*EXP(4.5 * LOG(XINISIG_SLT(JPSALTORDER(JN)))**2)) - - ELSE - - !calculate moment 3 from total aerosol mass (molec_{aer}/molec_{air} ==> - ZM(:,:,:,NM3(JN)) = & - ZSV(:,:,:,2+(JN-1)*2) & !molec_{aer}/molec_{aer} - * (ZMI/XMD) & !==>kg_{aer}/kg_{aer} - * PRHODREF(:,:,:) & !==>kg_{aer}/m3_{air} - * (1.d0/ZRHOI) & !==>m3_{aer}/m3_{air} - * XM3TOUM3_SALT & !==>um3_{aer}/m3_{air} - / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment) - - - - !Get number concentration (#/molec_{air}==>#/m3) - ZM(:,:,:,NM0(JN))= & - ZSV(:,:,:,1+(JN-1)*2) & !#/molec_{air} - * XAVOGADRO & !==>#/mole - / XMD & !==>#/kg_{air} - * PRHODREF(:,:,:) !==>#/m3 - - END IF - - ZM(:,:,:,NM6(JN)) = ZM(:,:,:,NM0(JN)) & - * ( (ZM(:,:,:,NM3(JN))/ZM(:,:,:,NM0(JN)))**(1./3.) & - * exp(-(3./2.)*log(ZSIGMA(:,:,:))**2))**6 & - * exp(18.*log(ZSIGMA(:,:,:))**2) - - ! - END IF - ! - !Get number median radius (eqn. 7 in Orilam manuscript) - ! ++ JORIS DBG ++ - IF (NVERB ==15) THEN - WRITE(*,*) 'SHAPE(ZM) =', SHAPE(ZM) - WRITE(*,*) 'MINVAL(ZM), MAXVAL(ZM) =', MINVAL(ZM), MAXVAL(ZM) - WRITE(*,*) 'MINLOC(ZM), MAXLOC(ZM) =', MINLOC(ZM), MAXLOC(ZM) - WRITE(*,*) 'SHAPE(ZRG) =', SHAPE(ZRG) - WRITE(*,*) 'MINVAL(ZRG), MAXVAL(ZRG) =', MINVAL(ZRG), MAXVAL(ZRG) - WRITE(*,*) 'MINLOC(ZRG), MAXLOC(ZRG) =', MINLOC(ZRG), MAXLOC(ZRG) - WRITE(*,*) 'XSIXTH_SALT =', XSIXTH_SALT - WRITE(*,*) 'JN =', JN - WRITE(*,*) 'NM0 =', NM0 - WRITE(*,*) 'NM3 =', NM3 - WRITE(*,*) 'NM6 =', NM6 - ENDIF - ! -- JORIS DBG -- - ZRG(:,:,:)= & - ( & - ZM(:,:,:,NM3(JN))*ZM(:,:,:,NM3(JN))*ZM(:,:,:,NM3(JN))*ZM(:,:,:,NM3(JN)) & - /(ZM(:,:,:,NM6(JN))*ZM(:,:,:,NM0(JN))*ZM(:,:,:,NM0(JN))*ZM(:,:,:,NM0(JN))) & - ) & - ** XSIXTH_SALT - - !Give the sigma-values to the passed array - IF(PRESENT(PSIG3D)) PSIG3D(:,:,:,JN) = ZSIGMA(:,:,:) - ! - !Set the number concentrations in the passed array - IF(PRESENT(PN3D)) PN3D(:,:,:,JN) = ZM(:,:,:,NM0(JN)) - ! - !Get the number median radius - IF(PRESENT(PRG3D)) PRG3D(:,:,:,JN)= ZRG(:,:,:) - ! - IF(PRESENT(PMASS3D))THEN - PMASS3D(:,:,:,JN)= & - ZM(:,:,:,NM0(JN)) & !#/m^3_{air} - * XPI*4./3. & - * ZRHOI & !==>kg/m^3_{aeros}/m^3_{air} - * ZRG(:,:,:) * ZRG(:,:,:) * ZRG(:,:,:) & - * XUM3TOM3_SALT & !==>kg/m^3_{air} - * exp(4.5*log(ZSIGMA(:,:,:))*log(ZSIGMA(:,:,:))) - ENDIF -! -END DO !Loop on modes -! -IF(PRESENT(PM3D)) PM3D(:,:,:,:) = ZM(:,:,:,:) -! -DEALLOCATE(ZINIRADIUS) -DEALLOCATE(ZSV) -DEALLOCATE(ZRG) -DEALLOCATE(ZSIGMA) -DEALLOCATE(ZMMIN) -DEALLOCATE(ZM) -DEALLOCATE(NM6) -DEALLOCATE(NM3) -DEALLOCATE(NM0) -! -! -END SUBROUTINE PPP2SALT - -!! ############################################################ - SUBROUTINE SALT2PPP( & - PSVT & !IO [ppp] input scalar variables (moment of distribution) - , PRHODREF & !I [kg/m3] density of air - , PSIG3D & !I [-] standard deviation of aerosol distribution - , PRG3D & !I [um] number median diameter of aerosol distribution - ) -!! ############################################################ -! -!! -!! PURPOSE -!! ------- -!! Translate the sea salt Mass, RG and SIGMA in the three moments M0, M3 and M6 given in ppp -!! -!! CALLING STRUCTURE NOTE: OPTIONAL VARIABLES -!! ------- -!! CALL PPP2AEROS(PSVT, PRHODREF, PSIG3D=SIGVAR, & -!! PRG3D=RVAR, PN3D=NVAR) -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Pierre TULET (LA) -!! -!! MODIFICATIONS -!! ------------- -!! Alf Grini (CNRM) -!! -!! EXTERNAL -!! -------- -!! None -!! - IMPLICIT NONE -!! -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -!* 0.1 declarations of arguments -! - !INPUT - REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF !I [kg/m3] density of air - REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSIG3D !O [-] standard deviation - REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRG3D !O [um] number median diameter - - !OUTPUT - REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT !IO [#/molec_{air}] first moment - !IO [molec_{aer}/molec_{air} 3rd moment - !IO [um6/molec_{air}*(cm3/m3)] 6th moment -! -! -!* 0.2 declarations local variables -! - REAL :: ZRHOI ! [kg/m3] density of aerosol - REAL :: ZMI ! [kg/mol] molar weight of aerosol - REAL :: ZRGMIN ! [um] minimum radius accepted - REAL :: ZSIGMIN ! minimum standard deviation accepted - REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZM ! [aerosol units] local array which goes to output later - REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZSIGMA ! aersol standard deviation - REAL,DIMENSION(:), ALLOCATABLE :: ZMMIN ! [aerosol units] minimum values for N, sigma, M - REAL,DIMENSION(:), ALLOCATABLE :: ZINIRADIUS ! initial mean radius - INTEGER,DIMENSION(:), ALLOCATABLE :: NM0 ! [idx] index for Mode 0 in passed variables - INTEGER,DIMENSION(:), ALLOCATABLE :: NM3 ! [idx] indexes for Mode 3 in passed variables - INTEGER,DIMENSION(:), ALLOCATABLE :: NM6 ! [idx] indexes for Mode 6 in passed variables - INTEGER :: JJ, JN ! [idx] loop counters - INTEGER :: IMODEIDX -! -!------------------------------------------------------------------------------- -! -! 1.1 initialisation - - - ALLOCATE (NM0(NMODE_SLT)) - ALLOCATE (NM3(NMODE_SLT)) - ALLOCATE (NM6(NMODE_SLT)) - ALLOCATE (ZINIRADIUS(NMODE_SLT)) - ALLOCATE (ZMMIN(NMODE_SLT*3)) - ALLOCATE (ZM(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3), NMODE_SLT*3)) - ALLOCATE (ZSIGMA(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3))) - - !Set density of aerosol, here sea salt (kg/m3) - ZRHOI = XDENSITY_SALT - !Set molecular weight of sea salt !NOTE THAT THIS IS NOW IN KG - ZMI = XMOLARWEIGHT_SALT -! - DO JN=1,NMODE_SLT - IMODEIDX = JPSALTORDER(JN) - !Calculations here are for one mode only - IF (CRGUNITS=="MASS") THEN - ZINIRADIUS(JN) = XINIRADIUS_SLT(IMODEIDX) * EXP(-3.*(LOG(XINISIG_SLT(IMODEIDX)))**2) - ELSE - ZINIRADIUS(JN) = XINIRADIUS_SLT(IMODEIDX) - END IF - - !Set counter for number, M3 and M6 - NM0(JN) = 1+(JN-1)*3 - NM3(JN) = 2+(JN-1)*3 - NM6(JN) = 3+(JN-1)*3 - - !Get minimum values possible - ZMMIN(NM0(JN)) = XN0MIN_SLT(IMODEIDX) - ZRGMIN = ZINIRADIUS(JN) - IF (LVARSIG_SLT) THEN - ZSIGMIN = XINISIG_SLT(IMODEIDX) -! ZSIGMIN = XSIGMIN_SLT - ELSE - ZSIGMIN = XINISIG_SLT(IMODEIDX) - ENDIF - ZMMIN(NM3(JN)) = ZMMIN(NM0(JN)) * (ZRGMIN**3)*EXP(4.5 * LOG(ZSIGMIN)**2) - ZMMIN(NM6(JN)) = ZMMIN(NM0(JN)) * (ZRGMIN**6)*EXP(18. * LOG(ZSIGMIN)**2) - END DO - - !Set density of aerosol, here sea salt (kg/m3) - ZRHOI = XDENSITY_SALT - !Set molecular weight of sea salt !NOTE THAT THIS IS NOW IN KG - ZMI = XMOLARWEIGHT_SALT -! - DO JN=1,NMODE_SLT - !calculate moment 3 from total aerosol mass (molec_{aer}/molec_{air} ==> - IF (LVARSIG_SLT) THEN - ZM(:,:,:,NM3(JN)) = & - PSVT(:,:,:,2+(JN-1)*3) & !molec_{aer}/molec_{aer} - * (ZMI/XMD) & !==>kg_{aer}/kg_{aer} - * PRHODREF(:,:,:) & !==>kg_{aer}/m3_{air} - * (1.d0/ZRHOI) & !==>m3_{aer}/m3_{air} - * XM3TOUM3_SALT & !==>um3_{aer}/m3_{air} - / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment) - ELSE - IF ((LRGFIX_SLT)) THEN - ZM(:,:,:,NM3(JN)) = & - PSVT(:,:,:,JN) & !molec_{aer}/molec_{aer} - * (ZMI/XMD) & !==>kg_{aer}/kg_{aer} - * PRHODREF(:,:,:) & !==>kg_{aer}/m3_{air} - * (1.d0/ZRHOI) & !==>m3_{aer}/m3_{air} - * XM3TOUM3_SALT & !==>um3_{aer}/m3_{air} - / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment) - ZM(:,:,:,NM3(JN)) = MAX(ZM(:,:,:,NM3(JN)), ZMMIN(NM3(JN))) - ELSE - ZM(:,:,:,NM3(JN)) = & - PSVT(:,:,:,2+(JN-1)*2) & !molec_{aer}/molec_{aer} - * (ZMI/XMD) & !==>kg_{aer}/kg_{aer} - * PRHODREF(:,:,:) & !==>kg_{aer}/m3_{air} - * (1.d0/ZRHOI) & !==>m3_{aer}/m3_{air} - * XM3TOUM3_SALT & !==>um3_{aer}/m3_{air} - / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment) - END IF - END IF -! calculate moment 0 from dispersion and mean radius - ZM(:,:,:,NM0(JN))= ZM(:,:,:,NM3(JN))/& - ((PRG3D(:,:,:,JN)**3)*EXP(4.5 * LOG(PSIG3D(:,:,:,JN))**2)) - - -! calculate moment 6 from dispersion and mean radius - ZM(:,:,:,NM6(JN)) = ZM(:,:,:,NM0(JN)) * (PRG3D(:,:,:,JN)**6) * & - EXP(18 *(LOG(PSIG3D(:,:,:,JN)))**2) - -! IF (LVARSIG_SLT) THEN -! WHERE ((ZM(:,:,:,NM0(JN)) .LT. ZMMIN(NM0(JN))).OR.& -! (ZM(:,:,:,NM3(JN)) .LT. ZMMIN(NM3(JN))).OR.& -! (ZM(:,:,:,NM6(JN)) .LT. ZMMIN(NM6(JN)))) -! ZM(:,:,:,NM0(JN)) = ZMMIN(NM0(JN)) -! ZM(:,:,:,NM3(JN)) = ZMMIN(NM3(JN)) -! ZM(:,:,:,NM6(JN)) = ZMMIN(NM6(JN)) -! END WHERE -! ELSE IF (.NOT.(LRGFIX_SLT)) THEN - -! WHERE ((ZM(:,:,:,NM0(JN)) .LT. ZMMIN(NM0(JN))).OR.& -! (ZM(:,:,:,NM3(JN)) .LT. ZMMIN(NM3(JN)))) -! ZM(:,:,:,NM0(JN)) = ZMMIN(NM0(JN)) -! ZM(:,:,:,NM3(JN)) = ZMMIN(NM3(JN)) -! END WHERE -! ENDIF - - - ! return to concentration #/m3 => (#/molec_{air} - IF (LVARSIG_SLT) THEN - PSVT(:,:,:,1+(JN-1)*3) = ZM(:,:,:,NM0(JN)) * XMD / & - (XAVOGADRO*PRHODREF(:,:,:)) - - PSVT(:,:,:,2+(JN-1)*3) = ZM(:,:,:,NM3(JN)) * XMD * XPI * 4./3 * ZRHOI / & - (ZMI*PRHODREF(:,:,:)*XM3TOUM3_SALT) - - PSVT(:,:,:,3+(JN-1)*3) = ZM(:,:,:,NM6(JN)) * XMD / & - ( XAVOGADRO*PRHODREF(:,:,:) * 1.d-6) - ELSE IF (LRGFIX_SLT) THEN - PSVT(:,:,:,JN) = ZM(:,:,:,NM3(JN)) * XMD * XPI * 4./3. * ZRHOI / & - (ZMI*PRHODREF(:,:,:)*XM3TOUM3_SALT) - ELSE - PSVT(:,:,:,1+(JN-1)*2) = ZM(:,:,:,NM0(JN)) * XMD / & - (XAVOGADRO*PRHODREF(:,:,:)) - - PSVT(:,:,:,2+(JN-1)*2) = ZM(:,:,:,NM3(JN)) * XMD * XPI * 4./3. * ZRHOI / & - (ZMI*PRHODREF(:,:,:)*XM3TOUM3_SALT) - END IF - -! - END DO !Loop on modes - -DEALLOCATE(ZINIRADIUS) -DEALLOCATE(ZMMIN) -DEALLOCATE(ZSIGMA) -DEALLOCATE(ZM) -DEALLOCATE(NM6) -DEALLOCATE(NM3) -DEALLOCATE(NM0) -! -END SUBROUTINE SALT2PPP -! -!! ############################################################ - SUBROUTINE PPP2SALT1D( & - PSVT & !I [ppp] input scalar variables (moment of distribution) - , PRHODREF & !I [kg/m3] density of air - , PSIG1D & !O [-] standard deviation of aerosol distribution - , PRG1D & !O [um] number median diameter of aerosol distribution - , PN1D & !O [#/m3] number concentration of aerosols - , PMASS1D & !O [kg/m3] mass concentration of aerosol - , PM1D & !O aerosols moments 0, 3 and 6 - ) -!! ############################################################ -! -!! -!! PURPOSE -!! ------- -!! Translate the three moments M0, M3 and M6 given in ppp into -!! Values which can be understood more easily (R, sigma, N, M) -!! -!! CALLING STRUCTURE NOTE: OPTIONAL VARIABLES -!! ------- -!! CALL PPP2AEROS(PSVT, PRHODREF, PSIG3D=SIGVAR, & -!! PRG3D=RVAR, PN3D=NVAR, PM3D=MASSVAR) -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Pierre TULET (LA) -!! -!! MODIFICATIONS -!! ------------- -!! 2005 Alf Grini (CNRM) -!! 2006 Jean-Pierre Chaboureau (LA) -!! -!! EXTERNAL -!! -------- -!! None -!! - IMPLICIT NONE -!! -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -!* 0.1 declarations of arguments -! -REAL, DIMENSION(:,:), INTENT(INOUT) :: PSVT !I [ppp] first moment -REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !I [kg/m3] density of air - -REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PSIG1D !O [-] standard deviation -REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PRG1D !O [um] number median diameter -REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PN1D !O [#/m3] number concentration -REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PMASS1D !O [kg_{aer}/m3] mass concentration -REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PM1D !O aerosols moments -! -! -!* 0.2 declarations local variables -! -REAL :: ZRHOI ! [kg/m3] density of aerosol -REAL :: ZMI ! [kg/mol] molar weight of aerosol -REAL :: ZRGMIN ! [um] minimum radius accepted -REAL :: ZSIGMIN ! minimum standard deviation accepted -REAL,DIMENSION(:,:), ALLOCATABLE :: ZM ! [aerosol units] local array which goes to output later -REAL,DIMENSION(:,:), ALLOCATABLE :: ZSV ! [sea salts moment concentration] -REAL,DIMENSION(:), ALLOCATABLE :: ZSIGMA ! [-] standard deviation -REAL,DIMENSION(:), ALLOCATABLE :: ZRG ! [um] number median diameter -REAL,DIMENSION(:), ALLOCATABLE :: ZMMIN ! [aerosol units] minimum values for N, sigma, M -INTEGER,DIMENSION(:), ALLOCATABLE :: NM0 ! [idx] index for Mode 0 in passed variables -INTEGER,DIMENSION(:), ALLOCATABLE :: NM3 ! [idx] indexes for Mode 3 in passed variables -INTEGER,DIMENSION(:), ALLOCATABLE :: NM6 ! [idx] indexes for Mode 6 in passed variables -REAL,DIMENSION(:), ALLOCATABLE :: ZINIRADIUS ! initial mean radius -INTEGER :: JN,IMODEIDX,JJ ! [idx] loop counters -! -!------------------------------------------------------------------------------- -! -! 1.1 initialisation -! -!Calculations here are for one mode only -! -ALLOCATE (NM0(NMODE_SLT)) -ALLOCATE (NM3(NMODE_SLT)) -ALLOCATE (NM6(NMODE_SLT)) -ALLOCATE (ZM(SIZE(PSVT,1), NMODE_SLT*3)) -ALLOCATE (ZMMIN(NMODE_SLT*3)) -ALLOCATE (ZSIGMA(SIZE(PSVT,1))) -ALLOCATE (ZRG(SIZE(PSVT,1))) -ALLOCATE (ZSV(SIZE(PSVT,1), SIZE(PSVT,2))) -ALLOCATE (ZINIRADIUS(NMODE_SLT)) - -!Modif salt/dust 5.1. beg -ZSV(:,:) = MAX(PSVT(:,:), XMNH_TINY) -!Modif salt/dust 5.1. end - -DO JN=1,NMODE_SLT - IMODEIDX = JPSALTORDER(JN) - !Calculations here are for one mode only - IF (CRGUNITS=="MASS") THEN - ZINIRADIUS(JN) = XINIRADIUS_SLT(IMODEIDX) * EXP(-3.*(LOG(XINISIG_SLT(IMODEIDX)))**2) - ELSE - ZINIRADIUS(JN) = XINIRADIUS_SLT(IMODEIDX) - END IF - - !Set counter for number, M3 and M6 - NM0(JN) = 1+(JN-1)*3 - NM3(JN) = 2+(JN-1)*3 - NM6(JN) = 3+(JN-1)*3 - !Get minimum values possible - ZMMIN(NM0(JN)) = XN0MIN_SLT(IMODEIDX) - ZRGMIN = ZINIRADIUS(JN) - IF (LVARSIG_SLT) THEN - ZSIGMIN = XSIGMIN_SLT - ELSE - ZSIGMIN = XINISIG_SLT(IMODEIDX) - ENDIF - ZMMIN(NM3(JN)) = ZMMIN(NM0(JN)) * (ZRGMIN**3)*EXP(4.5 * LOG(ZSIGMIN)**2) - ZMMIN(NM6(JN)) = ZMMIN(NM0(JN)) * (ZRGMIN**6)*EXP(18. * LOG(ZSIGMIN)**2) -END DO -! -!Set density of aerosol, here sea salt (kg/m3) -ZRHOI = XDENSITY_SALT -!Set molecular weight of sea salt !NOTE THAT THIS IS NOW IN KG -ZMI = XMOLARWEIGHT_SALT -! -! -DO JN=1,NMODE_SLT - ! - IF (LVARSIG_SLT) THEN ! give M6 (case of variable standard deviation) - ! - !Get number concentration (#/molec_{air}==>#/m3) - ZM(:,NM0(JN))= & - ZSV(:,1+(JN-1)*3) & !#/molec_{air} - * XAVOGADRO & !==>#/mole - / XMD & !==>#/kg_{air} - * PRHODREF(:) !==>#/m3 - ! - !calculate moment 3 from total aerosol mass (molec_{aer}/molec_{air} ==> - ZM(:,NM3(JN)) = & - ZSV(:,2+(JN-1)*3) & !molec_{aer}/molec_{aer} - * (ZMI/XMD) & !==>kg_{aer}/kg_{aer} - * PRHODREF(:) & !==>kg_{aer}/m3_{air} - * (1.d0/ZRHOI) & !==>m3_{aer}/m3_{air} - * XM3TOUM3_SALT & !==>um3_{aer}/m3_{air} - / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment) - !Limit mass concentration to minimum value - ZM(:,NM3(JN)) = MAX(ZM(:,NM3(JN)), ZMMIN(NM3(JN))) - ! - ZM(:,NM6(JN)) = ZSV(:,3+(JN-1)*3) & !um6/molec_{air}*(cm3/m3) - * 1.d-6 & !==> um6/molec_{air} - * XAVOGADRO & !==> um6/mole_{air} - / XMD & !==> um6/kg_{air} - * PRHODREF(:) !==> um6/m3_{air} - !Limit m6 concentration to minimum value - ZM(:,NM6(JN)) = MAX(ZM(:,NM6(JN)), ZMMIN(NM6(JN))) - ! - !Get sigma (only if sigma is allowed to vary) - !Get intermediate values for sigma M3^2/(M0*M6) (ORILAM paper, eqn 8) - ZSIGMA(:)=ZM(:,NM3(JN))**2/(ZM(:,NM0(JN))*ZM(:,NM6(JN))) - !Limit the intermediate value, can not be larger than 1 - ZSIGMA(:)=MIN(1-1E-10,ZSIGMA(:)) - !Limit the value for intermediate, can not be smaller than 0 - ZSIGMA(:)=MAX(1E-10,ZSIGMA(:)) - !Calculate log(sigma) - ZSIGMA(:)= LOG(ZSIGMA(:)) - !Finally get the real sigma the negative sign is because of - !The way the equation is written (M3^2/(M0*M6)) instead of (M0*M6)/M3^3 - ZSIGMA(:)= EXP(1./3.*SQRT(-ZSIGMA(:))) - !Limit the value to reasonable ones - ZSIGMA(:) = MAX( XSIGMIN_SLT, MIN( XSIGMAX_SLT, ZSIGMA(:) ) ) - - ! - !Put back M6 so that it fits the sigma which is possibly modified above - !The following makes M6 consistent with N, R, SIGMA - ZM(:,NM6(JN)) = ZM(:,NM0(JN)) & - * ( (ZM(:,NM3(JN))/ZM(:,NM0(JN)))**(1./3.) & - * exp(-(3./2.)*log(ZSIGMA(:))**2))**6 & - * exp(18.*log(ZSIGMA(:))**2) - - ELSE ! compute M6 from M0, M3 and SIGMA - ! - ZSIGMA(:) = XINISIG_SLT(JPSALTORDER(JN)) - IF (LRGFIX_SLT) THEN - - !calculate moment 3 from total aerosol mass (molec_{aer}/molec_{air} ==> - ZM(:,NM3(JN)) = & - ZSV(:,JN) & !molec_{aer}/molec_{aer} - * (ZMI/XMD) & !==>kg_{aer}/kg_{aer} - * PRHODREF(:) & !==>kg_{aer}/m3_{air} - * (1.d0/ZRHOI) & !==>m3_{aer}/m3_{air} - * XM3TOUM3_SALT & !==>um3_{aer}/m3_{air} - / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment) - ZM(:,NM3(JN)) = MAX(ZM(:,NM3(JN)), ZMMIN(NM3(JN))) - - ZM(:,NM0(JN))= ZM(:,NM3(JN))/& - ((ZINIRADIUS(JN)**3)*EXP(4.5 * LOG(XINISIG_SLT(JPSALTORDER(JN)))**2)) - - ELSE - - !calculate moment 3 from total aerosol mass (molec_{aer}/molec_{air} ==> - ZM(:,NM3(JN)) = & - ZSV(:,2+(JN-1)*2) & !molec_{aer}/molec_{aer} - * (ZMI/XMD) & !==>kg_{aer}/kg_{aer} - * PRHODREF(:) & !==>kg_{aer}/m3_{air} - * (1.d0/ZRHOI) & !==>m3_{aer}/m3_{air} - * XM3TOUM3_SALT & !==>um3_{aer}/m3_{air} - / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment) - - - !Get number concentration (#/molec_{air}==>#/m3) - ZM(:,NM0(JN))= & - ZSV(:,1+(JN-1)*2) & !#/molec_{air} - * XAVOGADRO & !==>#/mole - / XMD & !==>#/kg_{air} - * PRHODREF(:) !==>#/m3 - - ! Limit concentration to minimum values - WHERE ((ZM(:,NM0(JN)) < ZMMIN(NM0(JN)) ).OR. & - (ZM(:,NM3(JN)) < ZMMIN(NM3(JN)) )) - ZM(:,NM0(JN)) = ZMMIN(NM0(JN)) - ZM(:,NM3(JN)) = ZMMIN(NM3(JN)) - PSVT(:,1+(JN-1)*2) = ZM(:,NM0(JN)) * XMD / & - (XAVOGADRO * PRHODREF(:) ) - PSVT(:,2+(JN-1)*2) = ZM(:,NM3(JN)) * XMD * XPI * 4./3. * ZRHOI / & - (ZMI*PRHODREF(:)*XM3TOUM3_SALT) - ENDWHERE - - END IF - - ZM(:,NM6(JN)) = ZM(:,NM0(JN)) & - * ( (ZM(:,NM3(JN))/ZM(:,NM0(JN)))**(1./3.) & - * exp(-(3./2.)*log(ZSIGMA(:))**2))**6 & - * exp(18.*log(ZSIGMA(:))**2) - - ! - END IF - ! - !Get number median radius (eqn. 7 in Orilam manuscript) - ZRG(:)= & - ( & - ZM(:,NM3(JN))*ZM(:,NM3(JN))*ZM(:,NM3(JN))*ZM(:,NM3(JN)) & - /(ZM(:,NM6(JN))*ZM(:,NM0(JN))*ZM(:,NM0(JN))*ZM(:,NM0(JN))) & - ) & - ** XSIXTH_SALT - !ZRG(:)=MIN(ZRG(:),ZINIRADIUS(JN)) - !Give the sigma-values to the passed array - IF(PRESENT(PSIG1D)) PSIG1D(:,JN) = ZSIGMA(:) - ! - !Set the number concentrations in the passed array - IF(PRESENT(PN1D)) PN1D(:,JN) = ZM(:,NM0(JN)) - ! - !Get the number median radius - IF(PRESENT(PRG1D)) PRG1D(:,JN)= ZRG(:) - ! - IF(PRESENT(PMASS1D))THEN - PMASS1D(:,JN)= & - ZM(:,NM0(JN)) & !#/m^3_{air} - * XPI*4./3. & - * ZRHOI & !==>kg/m^3_{aeros}/m^3_{air} - * ZRG(:) * ZRG(:) * ZRG(:) & - * XUM3TOM3_SALT & !==>kg/m^3_{air} - * exp(4.5*log(ZSIGMA(:))*log(ZSIGMA(:))) - ENDIF -! -END DO !Loop on modes -! -IF(PRESENT(PM1D)) PM1D(:,:) = ZM(:,:) -! -DEALLOCATE(ZINIRADIUS) -DEALLOCATE(ZSV) -DEALLOCATE(ZRG) -DEALLOCATE(ZSIGMA) -DEALLOCATE(ZMMIN) -DEALLOCATE(ZM) -DEALLOCATE(NM6) -DEALLOCATE(NM3) -DEALLOCATE(NM0) -! -! -END SUBROUTINE PPP2SALT1D - -!! ############################################################ -END MODULE MODE_SALT_PSD diff --git a/src/ICCARE_BASE/modeln.f90 b/src/ICCARE_BASE/modeln.f90 deleted file mode 100644 index a7a507828..000000000 --- a/src/ICCARE_BASE/modeln.f90 +++ /dev/null @@ -1,2323 +0,0 @@ -!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!----------------------------------------------------------------- -! ################### - MODULE MODI_MODEL_n -! ################### -! -INTERFACE -! - SUBROUTINE MODEL_n(KTCOUNT,OEXIT) -! -INTEGER, INTENT(IN) :: KTCOUNT ! temporal loop index of model KMODEL -LOGICAL, INTENT(INOUT):: OEXIT ! switch for the end of the temporal loop -! -END SUBROUTINE MODEL_n -! -END INTERFACE -! -END MODULE MODI_MODEL_n - -! ################################### - SUBROUTINE MODEL_n(KTCOUNT, OEXIT) -! ################################### -! -!!**** *MODEL_n * -monitor of the model version _n -!! -!! PURPOSE -!! ------- -! The purpose of this routine is to build up a typical model version -! by sequentially calling the specialized routines. -! -!!** METHOD -!! ------ -!! Some preliminary initializations are performed in the first section. -!! Then, specialized routines are called to update the guess of the future -!! instant XRxxS of the variable xx by adding the effects of all the -!! different sources of evolution. -!! -!! (guess of xx at t+dt) * Rhod_ref * Jacobian -!! XRxxS = ------------------------------------------- -!! 2 dt -!! -!! At this level, the informations are transferred with a USE association -!! from the INIT step, where the modules have been previously filled. The -!! transfer to the subroutines computing each source term is performed by -!! argument in order to avoid repeated compilations of these subroutines. -!! This monitor model_n, must therefore be duplicated for each model, -!! model1 corresponds in this case to the outermost model, model2 is used -!! for the first level of gridnesting,.... -!! The effect of all parameterizations is computed in PHYS_PARAM_n, which -!! is itself a monitor. This is due to a possible large number of -!! parameterizations, which can be activated and therefore, will require a -!! very large list of arguments. To circumvent this problem, we transfer by -!! a USE association, the necessary informations in this monitor, which will -!! dispatch the pertinent information to every parametrization. -!! Some elaborated diagnostics, LES tools, budget storages are also called -!! at this level because they require informations about the fields at every -!! timestep. -!! -!! -!! EXTERNAL -!! -------- -!! Subroutine IO_File_open: to open a file -!! Subroutine WRITE_DESFM: to write the descriptive part of a FMfile -!! Subroutine WRITE_LFIFM: to write the binary part of a FMfile -!! Subroutine SET_MASK : to compute all the masks selected for budget -!! computations -!! Subroutine BOUNDARIES : set the fields at the marginal points in every -!! directions according the selected boundary conditions -!! Subroutine INITIAL_GUESS: initializes the guess of the future instant -!! Subroutine LES_FLX_SPECTRA: computes the resolved fluxes and the -!! spectra of some quantities when running in LES mode. -!! Subroutine ADVECTION: computes the advection terms. -!! Subroutine DYN_SOURCES: computes the curvature, Coriolis, gravity terms. -!! Subroutine NUM_DIFF: applies the fourth order numerical diffusion. -!! Subroutine RELAXATION: performs the relaxation to Larger Scale fields -!! in the upper levels and outermost vertical planes -!! Subroutine PHYS_PARAM_n : computes the parameterized physical terms -!! Subroutine RAD_BOUND: prepares the velocity normal components for the bc. -!! Subroutine RESOLVED_CLOUD : computes the sources terms for water in any -!! form -!! Subroutine PRESSURE : computes the pressure gradient term and the -!! absolute pressure -!! Subroutine EXCHANGE : updates the halo of each subdomains -!! Subroutine ENDSTEP : advances in time the fields. -!! Subroutines UVW_LS_COUPLING and SCALAR_LS_COUPLING: -!! compute the large scale fields, used to -!! couple Model_n with outer informations. -!! Subroutine ENDSTEP_BUDGET: writes the budget informations. -!! Subroutine IO_File_close: closes a file -!! Subroutine DATETIME_CORRECTDATE: transform the current time in GMT -!! Subroutine FORCING : computes forcing terms -!! Subroutine ADD3DFIELD_ll : add a field to 3D-list -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! MODD_DYN -!! MODD_CONF -!! MODD_NESTING -!! MODD_BUDGET -!! MODD_PARAMETERS -!! MODD_CONF_n -!! MODD_CURVCOR_n -!! MODD_DYN_n -!! MODD_DIM_n -!! MODD_ADV_n -!! MODD_FIELD_n -!! MODD_LSFIELD_n -!! MODD_GRID_n -!! MODD_METRICS_n -!! MODD_LBC_n -!! MODD_PARAM_n -!! MODD_REF_n -!! MODD_LUNIT_n -!! MODD_OUT_n -!! MODD_TIME_n -!! MODD_TURB_n -!! MODD_CLOUDPAR_n -!! MODD_TIME -!! -!! REFERENCE -!! --------- -!! -!! AUTHOR -!! ------ -!! J.-P. Pinty * LA * -!! -!! MODIFICATIONS -!! ------------- -!! Original 15/09/94 -!! Modification 20/10/94 (J.Stein) for the outputs and abs_layers routines -!! Modification 10/11/94 (J.Stein) change ABS_LAYER_FIELDS call -!! Modification 16/11/94 (J.Stein) add call to the renormalization -!! Modification 17/11/94 (J.-P. Lafore and J.-P. Pinty) call NUM_DIFF -!! Modification 08/12/94 (J.Stein) cleaning + remove (RENORM + ABS_LAYER.. -!! ..) + add RELAXATION + LS fiels in the arguments -!! Modification 19/12/94 (J.Stein) switch for the num diff -!! Modification 22/12/94 (J.Stein) update tdtcur + change dyn_source call -!! Modification 05/01/95 (J.Stein) add the parameterization monitor -!! Modification 09/01/95 (J.Stein) add the 1D switch -!! Modification 10/01/95 (J.Stein) displace the TDTCUR computation -!! Modification 03/01/95 (J.-P. Lafore) Absolute pressure diagnosis -!! Modification Jan 19, 1995 (J. Cuxart) Shunt the DYN_SOURCES in 1D cases. -!! Modification Jan 24, 1995 (J. Stein) Interchange Boundaries and -!! Initial_guess to correct a bug in 2D configuration -!! Modification Feb 02, 1995 (I.Mallet) update BOUNDARIES and RAD_BOUND -!! calls -!! Modification Mar 10, 1995 (I.Mallet) add call to SET_COUPLING -!! March,21, 1995 (J. Stein) remove R from the historical var. -!! March,26, 1995 (J. Stein) add the EPS variable -!! April 18, 1995 (J. Cuxart) add the LES call -!! Sept 20,1995 (Lafore) coupling for the dry mass Md -!! Nov 2,1995 (Stein) displace the temporal counter increase -!! Jan 2,1996 (Stein) rm the test on the temporal counter -!! Modification Feb 5,1996 (J. Vila) implementation new advection -!! schemes for scalars -!! Modification Feb 20,1996 (J.Stein) doctor norm -!! Dec95 - Jul96 (Georgelin, Pinty, Mari, Suhre) FORCING -!! June 17,1996 (Vincent, Lafore, Jabouille) -!! statistics of computing time -!! Aug 8, 1996 (K. Suhre) add chemistry -!! October 12, 1996 (J. Stein) save the PSRC value -!! Sept 05,1996 (V.Masson) print of loop index for debugging -!! purposes -!! July 22,1996 (Lafore) improve write of computing time statistics -!! July 29,1996 (Lafore) nesting introduction -!! Aug. 1,1996 (Lafore) synchronization between models -!! Sept. 4,1996 (Lafore) modification of call to routine SET_COUPLING -!! now split in 2 routines -!! (UVW_LS_COUPLING and SCALAR_LS_COUPLING) -!! Sept 5,1996 (V.Masson) print of loop index for debugging -!! purposes -!! Sept 25,1996 (V.Masson) test for coupling performed here -!! Oct. 29,1996 (Lafore) one-way nesting implementation -!! Oct. 12,1996 (J. Stein) save the PSRC value -!! Dec. 12,1996 (Lafore) change call to RAD_BOUND -!! Dec. 21,1996 (Lafore) two-way nesting implementation -!! Mar. 12,1997 (Lafore) introduction of "surfacic" LS fields -!! Nov 18, 1996 (J.-P. Pinty) FORCING revisited (translation) -!! Dec 04, 1996 (J.-P. Pinty) include mixed-phase clouds -!! Dec 20, 1996 (J.-P. Pinty) update the budgets -!! Dec 23, 1996 (J.-P. Pinty) add the diachronic file control -!! Jan 11, 1997 (J.-P. Pinty) add the deep convection control -!! Dec 20,1996 (V.Masson) call boundaries before the writing -!! Fev 25, 1997 (P.Jabouille) modify the LES tools -!! April 3,1997 (Lafore) merging of the nesting -!! developments on MASTER3 -!! Jul. 8,1997 (Lafore) print control for nesting (NVERB>=7) -!! Jul. 28,1997 (Masson) supress LSTEADY_DMASS -!! Aug. 19,1997 (Lafore) full Clark's formulation introduction -!! Sept 26,1997 (Lafore) LS source calculation at restart -!! (temporarily test to have LS at instant t) -!! Jan. 28,1998 (Bechtold) add SST forcing -!! fev. 10,1998 (Lafore) RHODJ computation and storage for budget -!! Jul. 10,1998 (Stein ) sequentiel loop for nesting -!! Apr. 07,1999 (Stein ) cleaning of the nesting subroutines -!! oct. 20,1998 (Jabouille) // -!! oct. 20,2000 (J.-P. Pinty) add the C2R2 scheme -!! fev. 01,2001 (D.Gazen) add module MODD_NSV for NSV variables -!! mar, 4,2002 (V.Ducrocq) call to temporal series -!! mar, 8, 2001 (V. Masson) advection of perturbation of theta in neutral cases. -!! Nov, 6, 2002 (V. Masson) time counters for budgets & LES -!! mars 20,2001 (Pinty) add ICE4 and C3R5 options -!! jan. 2004 (Masson) surface externalization -!! sept 2004 (M. Tomasini) Cloud mixing length modification -!! june 2005 (P. Tulet) add aerosols / dusts -!! Jul. 2005 (N. Asencio) two_way and phys_param calls: -!! Add the surface parameters : precipitating -!! hydrometeors, Short and Long Wave , MASKkids array -!! Fev. 2006 (M. Leriche) add aqueous phase chemistry -!! april 2006 (T.Maric) Add halo related to 4th order advection scheme -!! May 2006 Remove KEPS -!! Oct 2008 (C.Lac) FIT for variables advected with PPM -!! July 2009 : Displacement of surface diagnostics call to be -!! coherent with surface diagnostics obtained with DIAG -!! 10/11/2009 (P. Aumond) Add mean moments -!! Nov, 12, 2009 (C. Barthe) add cloud electrification and lightning flashes -!! July 2010 (M. Leriche) add ice phase chemical species -!! April 2011 (C.Lac) : Remove instant M -!! April 2011 (C.Lac, V.Masson) : Time splitting for advection -!! J.Escobar 21/03/2013: for HALOK comment all NHALO=1 test -!! P. Tulet Nov 2014 accumulated moles of aqueous species that fall at the surface -!! Dec 2014 (C.Lac) : For reproducibility START/RESTA -!! J.Escobar 20/04/2015: missing UPDATE_HALO before UPDATE_HALO2 -!! July, 2015 (O.Nuissier/F.Duffourg) Add microphysics diagnostic for -!! aircraft, ballon and profiler -!! C.Lac 11/09/2015: correction of the budget due to FIT temporal scheme -!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1 -!! Sep 2015 (S. Bielli) : Remove YDADFILE from argument call -! of write_phys_param -!! J.Escobar : 19/04/2016 : Pb IOZ/NETCDF , missing OPARALLELIO=.FALSE. for PGD files -!! M.Mazoyer : 04/2016 DTHRAD used for radiative cooling when LACTIT -!!! Modification 01/2016 (JP Pinty) Add LIMA -!! 06/2016 (G.Delautier) phasage surfex 8 -!! M.Leriche : 03/2016 Move computation of accumulated chem. in rain to ch_monitor -!! 09/2016 Add filter on negative values on AERDEP SV before relaxation -!! 10/2016 (C.Lac) _ Correction on the flag for Strang splitting -!! to insure reproducibility between START and RESTA -!! _ Add OSPLIT_WENO -!! _ Add droplet deposition -!! 10/2016 (M.Mazoyer) New KHKO output fields -!! P.Wautelet : 11/07/2016 : removed MNH_NCWRIT define -!! 09/2017 Q.Rodier add LTEND_UV_FRC -!! 10/2017 (C.Lac) Necessity to have chemistry processes as -!! the las process modifying XRSVS -!! 01/2018 (G.Delautier) SURFEX 8.1 -!! 03/2018 (P.Wautelet) replace ADD_FORECAST_TO_DATE by DATETIME_CORRECTDATE -!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O -!! 07/2017 (V. Vionnet) : Add blowing snow scheme -!! S. Riette : 11/2016 Add ZPABST to keep pressure constant during timestep -!! 01/2018 (C.Lac) Add VISCOSITY -!! Philippe Wautelet: 21/01/2019: add LIO_ALLOW_NO_BACKUP and LIO_NO_WRITE to modd_io_ll -! to allow to disable writes (for bench purposes) -! P. Wautelet 07/02/2019: remove OPARALLELIO argument from open and close files subroutines -! (nsubfiles_ioz is now determined in IO_File_add2list) -!! 02/2019 C.Lac add rain fraction as an output field -!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes -! P. Wautelet 28/03/2019: use MNHTIME for time measurement variables -! P. Wautelet 28/03/2019: use TFILE instead of unit number for set_iluout_timing -! P. Wautelet 19/04/2019: removed unused dummy arguments and variables -! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function -! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine -! J. Escobar 09/07/2019: norme Doctor -> Rename Module Type variable TZ -> T -! J. Escobar 09/07/2019: for bug in management of XLSZWSM variable, add/use specific 2D TLSFIELD2D_ll pointer -! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management -! J. Escobar 27/09/2019: add missing report timing of RESOLVED_ELEC -! P. Wautelet 02-03/2020: use the new data structures and subroutines for budgets -! P. Wautelet 12/10/2020: Write_les_n: remove HLES_AVG dummy argument and group all 4 calls -! F. Auguste 01/02/2021: add IBM -! T. Nagel 01/02/2021: add turbulence recycling -! P. Wautelet 19/02/2021: add NEGA2 term for SV budgets -! J.L. Redelsperger 03/2021: add Call NHOA_COUPLN (coupling O & A LES version) -! C. Barthe 07/04/2022: deallocation of ZSEA -!!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_2D_FRC -USE MODD_ADV_n -USE MODD_AIRCRAFT_BALLOON -USE MODD_ARGSLIST_ll, ONLY : LIST_ll -USE MODD_BAKOUT -USE MODD_BIKHARDT_n -USE MODD_BLANK_n -USE MODD_BLOWSNOW -USE MODD_BLOWSNOW_n -use modd_budget, only: cbutype, lbu_ru, lbu_rv, lbu_rw, lbudget_u, lbudget_v, lbudget_w, lbudget_sv, lbu_enable, & - NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_SV1, nbumod, nbutime, & - tbudgets, tburhodj, & - xtime_bu, xtime_bu_process -USE MODD_CH_AERO_n, ONLY: XSOLORG, XMI -USE MODD_CH_MNHC_n, ONLY: LUSECHEM,LCH_CONV_LINOX,LUSECHAQ,LUSECHIC, & - LCH_INIT_FIELD -USE MODD_CLOUD_MF_n -USE MODD_CLOUDPAR_n -USE MODD_CONF -USE MODD_CONF_n -USE MODD_CURVCOR_n -USE MODD_DEEP_CONVECTION_n -USE MODD_DIM_n -USE MODD_DRAG_n -USE MODD_DUST, ONLY: LDUST -USE MODD_DYN -USE MODD_DYN_n -USE MODD_DYNZD -USE MODD_DYNZD_n -USE MODD_ELEC_DESCR -USE MODD_EOL_MAIN -USE MODD_FIELD_n -USE MODD_FRC -USE MODD_FRC_n -USE MODD_GET_n -USE MODD_GRID, ONLY: XLONORI,XLATORI -USE MODD_GRID_n -USE MODD_IBM_PARAM_n, ONLY: CIBM_ADV, LIBM, LIBM_TROUBLE, XIBM_LS -USE MODD_ICE_C1R3_DESCR, ONLY: XRTMIN_C1R3=>XRTMIN -USE MODD_IO, ONLY: LIO_NO_WRITE, TFILEDATA, TFILE_SURFEX, TFILE_DUMMY -USE MODD_LBC_n -USE MODD_LES -USE MODD_LES_BUDGET -USE MODD_LIMA_PRECIP_SCAVENGING_n -USE MODD_LSFIELD_n -USE MODD_LUNIT, ONLY: TOUTDATAFILE -USE MODD_LUNIT_n, ONLY: TDIAFILE,TINIFILE,TINIFILEPGD,TLUOUT -USE MODD_MEAN_FIELD -USE MODD_MEAN_FIELD_n -USE MODD_METRICS_n -USE MODD_MNH_SURFEX_n -USE MODD_NESTING -USE MODD_NSV -USE MODD_NUDGING_n -USE MODD_OUT_n -USE MODD_PARAM_C1R3, ONLY: NSEDI => LSEDI, NHHONI => LHHONI -USE MODD_PARAM_C2R2, ONLY: NSEDC => LSEDC, NRAIN => LRAIN, NACTIT => LACTIT,LACTTKE,LDEPOC -USE MODD_PARAMETERS -USE MODD_PARAM_ICE, ONLY: LWARM,LSEDIC,LCONVHG,LDEPOSC -USE MODD_PARAM_LIMA, ONLY: MSEDC => LSEDC, MWARM => LWARM, MRAIN => LRAIN, & - MACTIT => LACTIT, LSCAV, LCOLD, & - MSEDI => LSEDI, MHHONI => LHHONI, LHAIL, & - XRTMIN_LIMA=>XRTMIN, MACTTKE=>LACTTKE -USE MODD_PARAM_MFSHALL_n -USE MODD_PARAM_n -USE MODD_PAST_FIELD_n -USE MODD_PRECIP_n -use modd_precision, only: MNHTIME -USE MODD_PROFILER_n -USE MODD_RADIATIONS_n, ONLY: XTSRAD,XSCAFLASWD,XDIRFLASWD,XDIRSRFSWD, XAER, XDTHRAD -USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN -USE MODD_RECYCL_PARAM_n, ONLY: LRECYCL -USE MODD_REF, ONLY: LCOUPLES -USE MODD_REF_n -USE MODD_SALT, ONLY: LSALT -USE MODD_SERIES, ONLY: LSERIES -USE MODD_SERIES_n, ONLY: NFREQSERIES -USE MODD_STATION_n -USE MODD_SUB_MODEL_n -USE MODD_TIME -USE MODD_TIME_n -USE MODD_TIMEZ -USE MODD_TURB_CLOUD, ONLY: NMODEL_CLOUD,CTURBLEN_CLOUD,XCEI -USE MODD_TURB_n -USE MODD_VISCOSITY -! -use mode_budget, only: Budget_store_init, Budget_store_end -USE MODE_DATETIME -USE MODE_ELEC_ll -USE MODE_GRIDCART -USE MODE_GRIDPROJ -USE MODE_IO_FIELD_WRITE, only: IO_Field_user_write, IO_Fieldlist_write, IO_Header_write -USE MODE_IO_FILE, only: IO_File_close, IO_File_open -USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list -USE MODE_ll -#ifdef MNH_IOLFI -use mode_menu_diachro, only: MENU_DIACHRO -#endif -USE MODE_MNH_TIMING -USE MODE_MODELN_HANDLER -USE MODE_MPPDB -USE MODE_MSG -USE MODE_ONE_WAY_n -use mode_write_les_n, only: Write_les_n -use mode_write_lfifmn_fordiachro_n, only: WRITE_LFIFMN_FORDIACHRO_n -USE MODE_WRITE_PROFILER_n, ONLY: WRITE_PROFILER_n -! -USE MODI_ADDFLUCTUATIONS -USE MODI_ADVECTION_METSV -USE MODI_ADVECTION_UVW -USE MODI_ADVECTION_UVW_CEN -USE MODI_ADV_FORCING_n -USE MODI_AER_MONITOR_n -USE MODI_AIRCRAFT_BALLOON -USE MODI_BLOWSNOW -USE MODI_BOUNDARIES -USE MODI_BUDGET_FLAGS -USE MODI_CART_COMPRESS -USE MODI_CH_MONITOR_n -USE MODI_DIAG_SURF_ATM_N -USE MODI_DYN_SOURCES -USE MODI_END_DIAG_IN_RUN -USE MODI_ENDSTEP -USE MODI_ENDSTEP_BUDGET -USE MODI_EXCHANGE -USE MODI_FORCING -USE MODI_FORC_SQUALL_LINE -USE MODI_FORC_WIND -USE MODI_GET_HALO -USE MODI_GRAVITY_IMPL -USE MODI_IBM_INIT -USE MODI_IBM_FORCING -USE MODI_IBM_FORCING_TR -USE MODI_IBM_FORCING_ADV -USE MODI_INI_DIAG_IN_RUN -USE MODI_INI_LG -USE MODI_INI_MEAN_FIELD -USE MODI_INITIAL_GUESS -USE MODI_LES_INI_TIMESTEP_n -USE MODI_LES_N -USE MODI_LIMA_PRECIP_SCAVENGING -USE MODI_LS_COUPLING -USE MODI_MASK_COMPRESS -USE MODI_MEAN_FIELD -USE MODI_MNHGET_SURF_PARAM_n -USE MODI_MNHWRITE_ZS_DUMMY_n -USE MODI_NUDGING -USE MODI_NUM_DIFF -USE MODI_PHYS_PARAM_n -USE MODI_PRESSUREZ -USE MODI_PROFILER_n -USE MODI_RAD_BOUND -USE MODI_RECYCLING -USE MODI_RELAX2FW_ION -USE MODI_RELAXATION -USE MODI_REL_FORCING_n -USE MODI_RESOLVED_CLOUD -USE MODI_RESOLVED_ELEC_n -USE MODI_SERIES_N -USE MODI_SETLB_LG -USE MODI_SET_MASK -USE MODI_SHUMAN -USE MODI_SPAWN_LS_n -USE MODI_STATION_n -USE MODI_TURB_CLOUD_INDEX -USE MODI_TWO_WAY -USE MODI_UPDATE_NSV -USE MODI_VISCOSITY -USE MODI_WRITE_AIRCRAFT_BALLOON -USE MODI_WRITE_DESFM_n -USE MODI_WRITE_DIAG_SURF_ATM_N -USE MODI_WRITE_LFIFM_n -USE MODI_WRITE_SERIES_n -USE MODI_WRITE_STATION_n -USE MODI_WRITE_SURF_ATM_N -! -IMPLICIT NONE -! -!* 0.1 declarations of arguments -! -! -! -INTEGER, INTENT(IN) :: KTCOUNT -LOGICAL, INTENT(INOUT):: OEXIT -! -!* 0.2 declarations of local variables -! -INTEGER :: ILUOUT ! Logical unit number for the output listing -INTEGER :: IIU,IJU,IKU ! array size in first, second and third dimensions -INTEGER :: IIB,IIE,IJB,IJE ! index values for the physical subdomain -INTEGER :: JSV,JRR ! Loop index for scalar and moist variables -INTEGER :: INBVAR ! number of HALO2_lls to allocate -INTEGER :: IINFO_ll ! return code of parallel routine -INTEGER :: IVERB ! LFI verbosity level -LOGICAL :: GSTEADY_DMASS ! conditional call to mass computation -! - ! for computing time analysis -REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME, ZTIME1, ZTIME2, ZEND, ZTOT, ZALL, ZTOT_PT -REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME_STEP,ZTIME_STEP_PTS -CHARACTER :: YMI -INTEGER :: IPOINTS -CHARACTER(len=16) :: YTCOUNT,YPOINTS -! -INTEGER :: ISYNCHRO ! model synchronic index relative to its father - ! = 1 for the first time step in phase with DAD - ! = 0 for the last time step (out of phase) -INTEGER :: IMI ! Current model index -REAL, DIMENSION(:,:),ALLOCATABLE :: ZSEA -REAL, DIMENSION(:,:),ALLOCATABLE :: ZTOWN -! Dummy pointers needed to correct an ifort Bug -REAL, DIMENSION(:), POINTER :: DPTR_XZHAT -REAL, DIMENSION(:), POINTER :: DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4 -REAL, DIMENSION(:), POINTER :: DPTR_XBMY1,DPTR_XBMY2,DPTR_XBMY3,DPTR_XBMY4 -REAL, DIMENSION(:), POINTER :: DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4 -REAL, DIMENSION(:), POINTER :: DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4 -CHARACTER(LEN=4), DIMENSION(:), POINTER :: DPTR_CLBCX,DPTR_CLBCY -INTEGER, DIMENSION(:,:,:), POINTER :: DPTR_NKLIN_LBXU,DPTR_NKLIN_LBYU,DPTR_NKLIN_LBXV,DPTR_NKLIN_LBYV -INTEGER, DIMENSION(:,:,:), POINTER :: DPTR_NKLIN_LBXW,DPTR_NKLIN_LBYW,DPTR_NKLIN_LBXM,DPTR_NKLIN_LBYM -REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXU,DPTR_XCOEFLIN_LBYU -REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXV,DPTR_XCOEFLIN_LBYV -REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXW,DPTR_XCOEFLIN_LBYW -REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXM,DPTR_XCOEFLIN_LBYM -REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXUM,DPTR_XLBYUM,DPTR_XLBXVM,DPTR_XLBYVM -REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXWM,DPTR_XLBYWM,DPTR_XLBXTHM,DPTR_XLBYTHM -REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXTKEM,DPTR_XLBYTKEM -REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XLBXSVM,DPTR_XLBYSVM -REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XLBXRM,DPTR_XLBYRM -REAL, DIMENSION(:,:,:), POINTER :: DPTR_XZZ -REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLSUM,DPTR_XLSVM,DPTR_XLSWM,DPTR_XLSTHM,DPTR_XLSRVM -REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLSUS,DPTR_XLSVS,DPTR_XLSWS,DPTR_XLSTHS,DPTR_XLSRVS -REAL, DIMENSION(:,:), POINTER :: DPTR_XLSZWSM,DPTR_XLSZWSS -REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXUS,DPTR_XLBYUS,DPTR_XLBXVS,DPTR_XLBYVS -REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXWS,DPTR_XLBYWS,DPTR_XLBXTHS,DPTR_XLBYTHS -REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXTKES,DPTR_XLBYTKES -REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XLBXRS,DPTR_XLBYRS,DPTR_XLBXSVS,DPTR_XLBYSVS -! -REAL, DIMENSION(:,:,:), POINTER :: DPTR_XRHODJ,DPTR_XUM,DPTR_XVM,DPTR_XWM,DPTR_XTHM -REAL, DIMENSION(:,:,:), POINTER :: DPTR_XTKEM,DPTR_XRUS,DPTR_XRVS,DPTR_XRWS,DPTR_XRTHS -REAL, DIMENSION(:,:,:), POINTER :: DPTR_XRTKES,DPTR_XDIRFLASWD,DPTR_XSCAFLASWD,DPTR_XDIRSRFSWD -REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XRM,DPTR_XSVM,DPTR_XRRS,DPTR_XRSVS -REAL, DIMENSION(:,:), POINTER :: DPTR_XINPRC,DPTR_XINPRR,DPTR_XINPRS,DPTR_XINPRG -REAL, DIMENSION(:,:), POINTER :: DPTR_XINPRH,DPTR_XPRCONV,DPTR_XPRSCONV -LOGICAL, DIMENSION(:,:),POINTER :: DPTR_GMASKkids -! -REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZSPEEDC -REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZSPEEDR -REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZSPEEDS -REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZSPEEDG -REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZSPEEDH -REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZINPRC3D -REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZINPRS3D -REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZINPRG3D -REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZINPRH3D -! -LOGICAL :: KWARM -LOGICAL :: KRAIN -LOGICAL :: KSEDC -LOGICAL :: KACTIT -LOGICAL :: KSEDI -LOGICAL :: KHHONI -! -REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZRUS,ZRVS,ZRWS -REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZPABST !To give pressure at t - ! (and not t+1) to resolved_cloud -REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZJ -! -TYPE(LIST_ll), POINTER :: TZFIELDC_ll ! list of fields to exchange -TYPE(HALO2LIST_ll), POINTER :: TZHALO2C_ll ! list of fields to exchange -LOGICAL :: GCLD ! conditionnal call for dust wet deposition -LOGICAL :: GCLOUD_ONLY ! conditionnal radiation computations for - ! the only cloudy columns -REAL, DIMENSION(SIZE(XRSVS,1), SIZE(XRSVS,2), SIZE(XRSVS,3), NSV_AER) :: ZWETDEPAER - - -! -TYPE(TFILEDATA),POINTER :: TZBAKFILE, TZOUTFILE -! TYPE(TFILEDATA),SAVE :: TZDIACFILE -!------------------------------------------------------------------------------- -! -TZBAKFILE=> NULL() -TZOUTFILE=> NULL() -! -!* 0. MICROPHYSICAL SCHEME -! ------------------- -SELECT CASE(CCLOUD) -CASE('C2R2','KHKO','C3R5') - KWARM = .TRUE. - KRAIN = NRAIN - KSEDC = NSEDC - KACTIT = NACTIT -! - KSEDI = NSEDI - KHHONI = NHHONI -CASE('LIMA') - KWARM = MWARM - KRAIN = MRAIN - KSEDC = MSEDC - KACTIT = MACTIT -! - KSEDI = MSEDI - KHHONI = MHHONI -CASE('ICE3','ICE4') !default values - KWARM = LWARM - KRAIN = .TRUE. - KSEDC = .TRUE. - KACTIT = .FALSE. -! - KSEDI = .TRUE. - KHHONI = .FALSE. -END SELECT -! -! -!* 1 PRELIMINARY -! ------------ -IMI = GET_CURRENT_MODEL_INDEX() -! -!* 1.0 update NSV_* variables for current model -! ---------------------------------------- -! -CALL UPDATE_NSV(IMI) -! -!* 1.1 RECOVER THE LOGICAL UNIT NUMBER FOR THE OUTPUT PRINTS -! -ILUOUT = TLUOUT%NLU -! -!* 1.2 SET ARRAY SIZE -! -CALL GET_DIM_EXT_ll('B',IIU,IJU) -IKU=NKMAX+2*JPVEXT -CALL GET_INDICE_ll (IIB,IJB,IIE,IJE) -! -IF (IMI==1) THEN - GSTEADY_DMASS=LSTEADYLS -ELSE - GSTEADY_DMASS=.FALSE. -END IF -! -!* 1.3 OPEN THE DIACHRONIC FILE -! -IF (KTCOUNT == 1) THEN -! - NULLIFY(TFIELDS_ll,TLSFIELD_ll,TFIELDT_ll) - NULLIFY(TLSFIELD2D_ll) - NULLIFY(THALO2T_ll) - NULLIFY(TLSHALO2_ll) - NULLIFY(TFIELDSC_ll) -! - ALLOCATE(XWT_ACT_NUC(SIZE(XWT,1),SIZE(XWT,2),SIZE(XWT,3))) - ALLOCATE(GMASKkids(SIZE(XWT,1),SIZE(XWT,2))) -! - IF ( .NOT. LIO_NO_WRITE ) THEN - CALL IO_File_open(TDIAFILE) -! - CALL IO_Header_write(TDIAFILE) - CALL WRITE_DESFM_n(IMI,TDIAFILE) - CALL WRITE_LFIFMN_FORDIACHRO_n(TDIAFILE) - END IF -! -!* 1.4 Initialization of the list of fields for the halo updates -! -! a) Sources terms -! - CALL ADD3DFIELD_ll( TFIELDS_ll, XRUS, 'MODEL_n::XRUS' ) - CALL ADD3DFIELD_ll( TFIELDS_ll, XRVS, 'MODEL_n::XRVS' ) - CALL ADD3DFIELD_ll( TFIELDS_ll, XRWS, 'MODEL_n::XRWS' ) - CALL ADD3DFIELD_ll( TFIELDS_ll, XRTHS, 'MODEL_n::XRTHS' ) - CALL ADD3DFIELD_ll( TFIELDS_ll, XRUS_PRES, 'MODEL_n::XRUS_PRES' ) - CALL ADD3DFIELD_ll( TFIELDS_ll, XRVS_PRES, 'MODEL_n::XRVS_PRES' ) - CALL ADD3DFIELD_ll( TFIELDS_ll, XRWS_PRES, 'MODEL_n::XRWS_PRES' ) - CALL ADD3DFIELD_ll( TFIELDS_ll, XRTHS_CLD, 'MODEL_n::XRTHS_CLD' ) - IF (SIZE(XRTKES,1) /= 0) CALL ADD3DFIELD_ll( TFIELDS_ll, XRTKES, 'MODEL_n::XRTKES' ) - CALL ADD4DFIELD_ll( TFIELDS_ll, XRRS (:,:,:,1:NRR), 'MODEL_n::XRRS' ) - CALL ADD4DFIELD_ll( TFIELDS_ll, XRRS_CLD (:,:,:,1:NRR), 'MODEL_n::XRRS_CLD' ) - CALL ADD4DFIELD_ll( TFIELDS_ll, XRSVS (:,:,:,1:NSV), 'MODEL_n::XRSVS') - CALL ADD4DFIELD_ll( TFIELDS_ll, XRSVS_CLD(:,:,:,1:NSV), 'MODEL_n::XRSVS_CLD') - IF (SIZE(XSRCT,1) /= 0) CALL ADD3DFIELD_ll( TFIELDS_ll, XSRCT, 'MODEL_n::XSRCT' ) - ! - IF ((LNUMDIFU .OR. LNUMDIFTH .OR. LNUMDIFSV) ) THEN - ! - ! b) LS fields - ! - CALL ADD3DFIELD_ll( TLSFIELD_ll, XLSUM, 'MODEL_n::XLSUM' ) - CALL ADD3DFIELD_ll( TLSFIELD_ll, XLSVM, 'MODEL_n::XLSVM' ) - CALL ADD3DFIELD_ll( TLSFIELD_ll, XLSWM, 'MODEL_n::XLSWM' ) - CALL ADD3DFIELD_ll( TLSFIELD_ll, XLSTHM, 'MODEL_n::XLSTHM' ) - CALL ADD2DFIELD_ll( TLSFIELD2D_ll, XLSZWSM, 'MODEL_n::XLSZWSM' ) - IF (NRR >= 1) THEN - CALL ADD3DFIELD_ll( TLSFIELD_ll, XLSRVM, 'MODEL_n::XLSRVM' ) - ENDIF - ! - ! c) Fields at t - ! - CALL ADD3DFIELD_ll( TFIELDT_ll, XUT, 'MODEL_n::XUT' ) - CALL ADD3DFIELD_ll( TFIELDT_ll, XVT, 'MODEL_n::XVT' ) - CALL ADD3DFIELD_ll( TFIELDT_ll, XWT, 'MODEL_n::XWT' ) - CALL ADD3DFIELD_ll( TFIELDT_ll, XTHT, 'MODEL_n::XTHT' ) - IF (SIZE(XRTKES,1) /= 0) CALL ADD3DFIELD_ll( TFIELDT_ll, XTKET, 'MODEL_n::XTKET' ) - CALL ADD4DFIELD_ll(TFIELDT_ll, XRT (:,:,:,1:NRR), 'MODEL_n::XSV' ) - CALL ADD4DFIELD_ll(TFIELDT_ll, XSVT(:,:,:,1:NSV), 'MODEL_n::XSVT' ) - ! - !* 1.5 Initialize the list of fields for the halo updates (2nd layer) - ! - INBVAR = 4+NRR+NSV - IF (SIZE(XRTKES,1) /= 0) INBVAR=INBVAR+1 - CALL INIT_HALO2_ll(THALO2T_ll,INBVAR,IIU,IJU,IKU) - CALL INIT_HALO2_ll(TLSHALO2_ll,4+MIN(1,NRR),IIU,IJU,IKU) - ! - !* 1.6 Initialise the 2nd layer of the halo of the LS fields - ! - IF ( LSTEADYLS ) THEN - CALL UPDATE_HALO_ll(TLSFIELD_ll, IINFO_ll) - CALL UPDATE_HALO_ll(TLSFIELD2D_ll,IINFO_ll) - CALL UPDATE_HALO2_ll(TLSFIELD_ll, TLSHALO2_ll, IINFO_ll) - END IF - END IF - ! -! - ! - XT_START = 0.0_MNHTIME - ! - XT_STORE = 0.0_MNHTIME - XT_BOUND = 0.0_MNHTIME - XT_GUESS = 0.0_MNHTIME - XT_FORCING = 0.0_MNHTIME - XT_NUDGING = 0.0_MNHTIME - XT_ADV = 0.0_MNHTIME - XT_ADVUVW = 0.0_MNHTIME - XT_GRAV = 0.0_MNHTIME - XT_SOURCES = 0.0_MNHTIME - ! - XT_DIFF = 0.0_MNHTIME - XT_RELAX = 0.0_MNHTIME - XT_PARAM = 0.0_MNHTIME - XT_SPECTRA = 0.0_MNHTIME - XT_HALO = 0.0_MNHTIME - XT_VISC = 0.0_MNHTIME - XT_RAD_BOUND = 0.0_MNHTIME - XT_PRESS = 0.0_MNHTIME - ! - XT_CLOUD = 0.0_MNHTIME - XT_STEP_SWA = 0.0_MNHTIME - XT_STEP_MISC = 0.0_MNHTIME - XT_COUPL = 0.0_MNHTIME - XT_1WAY = 0.0_MNHTIME - XT_STEP_BUD = 0.0_MNHTIME - ! - XT_RAD = 0.0_MNHTIME - XT_DCONV = 0.0_MNHTIME - XT_GROUND = 0.0_MNHTIME - XT_TURB = 0.0_MNHTIME - XT_MAFL = 0.0_MNHTIME - XT_DRAG = 0.0_MNHTIME - XT_EOL = 0.0_MNHTIME - XT_TRACER = 0.0_MNHTIME - XT_SHADOWS = 0.0_MNHTIME - XT_ELEC = 0.0_MNHTIME - XT_CHEM = 0.0_MNHTIME - XT_2WAY = 0.0_MNHTIME - ! - XT_IBM_FORC = 0.0_MNHTIME - ! -END IF -! -!* 1.7 Allocation of arrays for observation diagnostics -! -CALL INI_DIAG_IN_RUN(IIU,IJU,IKU,LFLYER,LSTATION,LPROFILER) -! -! -CALL SECOND_MNH2(ZEND) -! -!------------------------------------------------------------------------------- -! -!* 2. ONE-WAY NESTING AND LARGE SCALE FIELD REFRESH -! --------------------------------------------- -! -! -CALL SECOND_MNH2(ZTIME1) -! -ISYNCHRO = MODULO (KTCOUNT, NDTRATIO(IMI) ) ! test of synchronisation -! -! -IF (LCOUPLES.AND.LOCEAN) THEN - CALL NHOA_COUPL_n(NDAD(IMI),XTSTEP,IMI,KTCOUNT,IKU) -END IF -! No Gridnest in coupled OA LES for now -IF (.NOT. LCOUPLES .AND. IMI/=1 .AND. NDAD(IMI)/=IMI .AND. (ISYNCHRO==1 .OR. NDTRATIO(IMI) == 1) ) THEN -! -! Use dummy pointers to correct an ifort BUG - DPTR_XBMX1=>XBMX1 - DPTR_XBMX2=>XBMX2 - DPTR_XBMX3=>XBMX3 - DPTR_XBMX4=>XBMX4 - DPTR_XBMY1=>XBMY1 - DPTR_XBMY2=>XBMY2 - DPTR_XBMY3=>XBMY3 - DPTR_XBMY4=>XBMY4 - DPTR_XBFX1=>XBFX1 - DPTR_XBFX2=>XBFX2 - DPTR_XBFX3=>XBFX3 - DPTR_XBFX4=>XBFX4 - DPTR_XBFY1=>XBFY1 - DPTR_XBFY2=>XBFY2 - DPTR_XBFY3=>XBFY3 - DPTR_XBFY4=>XBFY4 - DPTR_CLBCX=>CLBCX - DPTR_CLBCY=>CLBCY - ! - DPTR_XZZ=>XZZ - DPTR_XZHAT=>XZHAT - DPTR_XCOEFLIN_LBXM=>XCOEFLIN_LBXM - DPTR_XLSTHM=>XLSTHM - DPTR_XLSRVM=>XLSRVM - DPTR_XLSUM=>XLSUM - DPTR_XLSVM=>XLSVM - DPTR_XLSWM=>XLSWM - DPTR_XLSZWSM=>XLSZWSM - DPTR_XLSTHS=>XLSTHS - DPTR_XLSRVS=>XLSRVS - DPTR_XLSUS=>XLSUS - DPTR_XLSVS=>XLSVS - DPTR_XLSWS=>XLSWS - DPTR_XLSZWSS=>XLSZWSS - ! - IF ( LSTEADYLS ) THEN - NCPL_CUR=0 - ELSE - IF (NCPL_CUR/=1) THEN - IF ( KTCOUNT+1 == NCPL_TIMES(NCPL_CUR-1,IMI) ) THEN - ! - ! LS sources are interpolated from the LS field - ! values of model DAD(IMI) - CALL SPAWN_LS_n(NDAD(IMI),XTSTEP,IMI, & - DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4,DPTR_XBMY1,DPTR_XBMY2,DPTR_XBMY3,DPTR_XBMY4, & - DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4,DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4, & - NDXRATIO_ALL(IMI),NDYRATIO_ALL(IMI), & - DPTR_CLBCX,DPTR_CLBCY,DPTR_XZZ,DPTR_XZHAT,LSLEVE,XLEN1,XLEN2,DPTR_XCOEFLIN_LBXM, & - DPTR_XLSTHM,DPTR_XLSRVM,DPTR_XLSUM,DPTR_XLSVM,DPTR_XLSWM,DPTR_XLSZWSM, & - DPTR_XLSTHS,DPTR_XLSRVS,DPTR_XLSUS,DPTR_XLSVS,DPTR_XLSWS, DPTR_XLSZWSS ) - END IF - END IF - ! - END IF - ! - DPTR_NKLIN_LBXU=>NKLIN_LBXU - DPTR_XCOEFLIN_LBXU=>XCOEFLIN_LBXU - DPTR_NKLIN_LBYU=>NKLIN_LBYU - DPTR_XCOEFLIN_LBYU=>XCOEFLIN_LBYU - DPTR_NKLIN_LBXV=>NKLIN_LBXV - DPTR_XCOEFLIN_LBXV=>XCOEFLIN_LBXV - DPTR_NKLIN_LBYV=>NKLIN_LBYV - DPTR_XCOEFLIN_LBYV=>XCOEFLIN_LBYV - DPTR_NKLIN_LBXW=>NKLIN_LBXW - DPTR_XCOEFLIN_LBXW=>XCOEFLIN_LBXW - DPTR_NKLIN_LBYW=>NKLIN_LBYW - DPTR_XCOEFLIN_LBYW=>XCOEFLIN_LBYW - ! - DPTR_NKLIN_LBXM=>NKLIN_LBXM - DPTR_XCOEFLIN_LBXM=>XCOEFLIN_LBXM - DPTR_NKLIN_LBYM=>NKLIN_LBYM - DPTR_XCOEFLIN_LBYM=>XCOEFLIN_LBYM - ! - DPTR_XLBXUM=>XLBXUM - DPTR_XLBYUM=>XLBYUM - DPTR_XLBXVM=>XLBXVM - DPTR_XLBYVM=>XLBYVM - DPTR_XLBXWM=>XLBXWM - DPTR_XLBYWM=>XLBYWM - DPTR_XLBXTHM=>XLBXTHM - DPTR_XLBYTHM=>XLBYTHM - DPTR_XLBXTKEM=>XLBXTKEM - DPTR_XLBYTKEM=>XLBYTKEM - DPTR_XLBXRM=>XLBXRM - DPTR_XLBYRM=>XLBYRM - DPTR_XLBXSVM=>XLBXSVM - DPTR_XLBYSVM=>XLBYSVM - ! - DPTR_XLBXUS=>XLBXUS - DPTR_XLBYUS=>XLBYUS - DPTR_XLBXVS=>XLBXVS - DPTR_XLBYVS=>XLBYVS - DPTR_XLBXWS=>XLBXWS - DPTR_XLBYWS=>XLBYWS - DPTR_XLBXTHS=>XLBXTHS - DPTR_XLBYTHS=>XLBYTHS - DPTR_XLBXTKES=>XLBXTKES - DPTR_XLBYTKES=>XLBYTKES - DPTR_XLBXRS=>XLBXRS - DPTR_XLBYRS=>XLBYRS - DPTR_XLBXSVS=>XLBXSVS - DPTR_XLBYSVS=>XLBYSVS - ! - CALL ONE_WAY_n(NDAD(IMI),XTSTEP,IMI,KTCOUNT, & - DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4,DPTR_XBMY1,DPTR_XBMY2,DPTR_XBMY3,DPTR_XBMY4, & - DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4,DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4, & - NDXRATIO_ALL(IMI),NDYRATIO_ALL(IMI),NDTRATIO(IMI), & - DPTR_CLBCX,DPTR_CLBCY,NRIMX,NRIMY, & - DPTR_NKLIN_LBXU,DPTR_XCOEFLIN_LBXU,DPTR_NKLIN_LBYU,DPTR_XCOEFLIN_LBYU, & - DPTR_NKLIN_LBXV,DPTR_XCOEFLIN_LBXV,DPTR_NKLIN_LBYV,DPTR_XCOEFLIN_LBYV, & - DPTR_NKLIN_LBXW,DPTR_XCOEFLIN_LBXW,DPTR_NKLIN_LBYW,DPTR_XCOEFLIN_LBYW, & - DPTR_NKLIN_LBXM,DPTR_XCOEFLIN_LBXM,DPTR_NKLIN_LBYM,DPTR_XCOEFLIN_LBYM, & - GSTEADY_DMASS,CCLOUD,LUSECHAQ,LUSECHIC, & - DPTR_XLBXUM,DPTR_XLBYUM,DPTR_XLBXVM,DPTR_XLBYVM,DPTR_XLBXWM,DPTR_XLBYWM, & - DPTR_XLBXTHM,DPTR_XLBYTHM, & - DPTR_XLBXTKEM,DPTR_XLBYTKEM, & - DPTR_XLBXRM,DPTR_XLBYRM,DPTR_XLBXSVM,DPTR_XLBYSVM, & - XDRYMASST,XDRYMASSS, & - DPTR_XLBXUS,DPTR_XLBYUS,DPTR_XLBXVS,DPTR_XLBYVS,DPTR_XLBXWS,DPTR_XLBYWS, & - DPTR_XLBXTHS,DPTR_XLBYTHS, & - DPTR_XLBXTKES,DPTR_XLBYTKES, & - DPTR_XLBXRS,DPTR_XLBYRS,DPTR_XLBXSVS,DPTR_XLBYSVS ) - ! -END IF -! -CALL SECOND_MNH2(ZTIME2) -XT_1WAY = XT_1WAY + ZTIME2 - ZTIME1 -! -!* 2.1 RECYCLING TURBULENCE -! ---- -IF (CTURB /= 'NONE' .AND. LRECYCL) THEN - CALL RECYCLING(XFLUCTUNW,XFLUCTVNN,XFLUCTUTN,XFLUCTVTW,XFLUCTWTW,XFLUCTWTN, & - XFLUCTUNE,XFLUCTVNS,XFLUCTUTS,XFLUCTVTE,XFLUCTWTE,XFLUCTWTS, & - KTCOUNT) -ENDIF -! -!* 2.2 IBM -! ---- -! -IF (LIBM .AND. KTCOUNT==1) THEN - ! - IF (.NOT.LCARTESIAN) THEN - CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'MODELN', 'IBM can only be used in combination with cartesian coordinates') - ENDIF - ! - CALL IBM_INIT(XIBM_LS) - ! -ENDIF -! -!------------------------------------------------------------------------------- -! -!* 3. LATERAL BOUNDARY CONDITIONS EXCEPT FOR NORMAL VELOCITY -! ------------------------------------------------------ -! -ZTIME1=ZTIME2 -! -!* 3.1 Set the lagragian variables values at the LB -! -IF( LLG .AND. IMI==1 ) CALL SETLB_LG -! -IF (CCONF == "START" .OR. (CCONF == "RESTA" .AND. KTCOUNT /= 1 )) THEN -CALL MPPDB_CHECK3DM("before BOUNDARIES:XUT, XVT, XWT, XTHT, XTKET",PRECISION,& - & XUT, XVT, XWT, XTHT, XTKET) -CALL BOUNDARIES ( & - XTSTEP,CLBCX,CLBCY,NRR,NSV,KTCOUNT, & - XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM, & - XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, & - XLBXUS,XLBXVS,XLBXWS,XLBXTHS,XLBXTKES,XLBXRS,XLBXSVS, & - XLBYUS,XLBYVS,XLBYWS,XLBYTHS,XLBYTKES,XLBYRS,XLBYSVS, & - XRHODJ,XRHODREF, & - XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT ) -CALL MPPDB_CHECK3DM("after BOUNDARIES:XUT, XVT, XWT, XTHT, XTKET",PRECISION,& - & XUT, XVT, XWT, XTHT, XTKET) -END IF -! -CALL SECOND_MNH2(ZTIME2) -! -XT_BOUND = XT_BOUND + ZTIME2 - ZTIME1 -! -!------------------------------------------------------------------------------- -!* initializes surface number -IF (CSURF=='EXTE') CALL GOTO_SURFEX(IMI) -!------------------------------------------------------------------------------- -! -!* 4. STORAGE IN A SYNCHRONOUS FILE -! ----------------------------- -! -ZTIME1 = ZTIME2 -! -IF ( nfile_backup_current < NBAK_NUMB ) THEN - IF ( KTCOUNT == TBACKUPN(nfile_backup_current + 1)%NSTEP ) THEN - nfile_backup_current = nfile_backup_current + 1 - ! - TZBAKFILE => TBACKUPN(nfile_backup_current)%TFILE - IVERB = TZBAKFILE%NLFIVERB - ! - CALL IO_File_open(TZBAKFILE) - ! - CALL WRITE_DESFM_n(IMI,TZBAKFILE) - CALL IO_Header_write( TBACKUPN(nfile_backup_current)%TFILE ) - CALL WRITE_LFIFM_n( TBACKUPN(nfile_backup_current)%TFILE, TBACKUPN(nfile_backup_current)%TFILE%TDADFILE%CNAME ) - TOUTDATAFILE => TZBAKFILE - CALL MNHWRITE_ZS_DUMMY_n(TZBAKFILE) - IF (CSURF=='EXTE') THEN - TFILE_SURFEX => TZBAKFILE - CALL GOTO_SURFEX(IMI) - CALL WRITE_SURF_ATM_n(YSURF_CUR,'MESONH','ALL',.FALSE.) - NULLIFY(TFILE_SURFEX) - END IF - ! - ! Reinitialize Lagragian variables at every model backup - IF (LLG .AND. LINIT_LG .AND. CINIT_LG=='FMOUT') THEN - CALL INI_LG(XXHAT,XYHAT,XZZ,XSVT,XLBXSVM,XLBYSVM) - IF (IVERB>=5) THEN - WRITE(UNIT=ILUOUT,FMT=*) '************************************' - WRITE(UNIT=ILUOUT,FMT=*) '*** Lagrangian variables refreshed after ',TRIM(TZBAKFILE%CNAME),' backup' - WRITE(UNIT=ILUOUT,FMT=*) '************************************' - END IF - END IF - ! Reinitialise mean variables - IF (LMEAN_FIELD) THEN - CALL INI_MEAN_FIELD - END IF -! - ELSE - !Necessary to have a 'valid' CNAME when calling some subroutines - TZBAKFILE => TFILE_DUMMY - END IF -ELSE - !Necessary to have a 'valid' CNAME when calling some subroutines - TZBAKFILE => TFILE_DUMMY -END IF -! -IF ( nfile_output_current < NOUT_NUMB ) THEN - IF ( KTCOUNT == TOUTPUTN(nfile_output_current + 1)%NSTEP ) THEN - nfile_output_current = nfile_output_current + 1 - ! - TZOUTFILE => TOUTPUTN(nfile_output_current)%TFILE - ! - CALL IO_File_open(TZOUTFILE) - ! - CALL IO_Header_write(TZOUTFILE) - CALL IO_Fieldlist_write( TOUTPUTN(nfile_output_current) ) - CALL IO_Field_user_write( TOUTPUTN(nfile_output_current) ) - ! - CALL IO_File_close(TZOUTFILE) - ! - END IF -END IF -! -CALL SECOND_MNH2(ZTIME2) -! -XT_STORE = XT_STORE + ZTIME2 - ZTIME1 -! -!------------------------------------------------------------------------------- -! -!* 4.BIS IBM and Fluctuations application -! ----------------------------- -! -!* 4.B1 Add fluctuations at the domain boundaries -! -IF (LRECYCL) THEN - CALL ADDFLUCTUATIONS ( & - CLBCX,CLBCY, & - XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT, & - XFLUCTUTN,XFLUCTVTW,XFLUCTUTS,XFLUCTVTE, & - XFLUCTWTW,XFLUCTWTN,XFLUCTWTS,XFLUCTWTE ) -ENDIF -! -!* 4.B2 Immersed boundaries -! -IF (LIBM) THEN - ! - ZTIME1=ZTIME2 - ! - IF (.NOT.LCARTESIAN) THEN - CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'MODELN', 'IBM can only be used in combination with cartesian coordinates') - ENDIF - ! - CALL IBM_FORCING(XUT,XVT,XWT,XTHT,XRT,XSVT,XTKET) - ! - IF (LIBM_TROUBLE) THEN - CALL IBM_FORCING_TR(XUT,XVT,XWT,XTHT,XRT,XSVT,XTKET) - ENDIF - ! - CALL SECOND_MNH2(ZTIME2) - ! - XT_IBM_FORC = XT_IBM_FORC + ZTIME2 - ZTIME1 - ! -ENDIF -!------------------------------------------------------------------------------- -! -!* 5. INITIALIZATION OF THE BUDGET VARIABLES -! -------------------------------------- -! -IF (NBUMOD==IMI) THEN - LBU_ENABLE = CBUTYPE /='NONE'.AND. CBUTYPE /='SKIP' -ELSE - LBU_ENABLE = .FALSE. -END IF -! -IF (NBUMOD==IMI .AND. CBUTYPE=='MASK' ) THEN - CALL SET_MASK() - if ( lbu_ru ) then - tbudgets(NBUDGET_U)%trhodj%xdata(:, nbutime, :) = tbudgets(NBUDGET_U)%trhodj%xdata(:, nbutime, :) & - + Mask_compress( Mxm( xrhodj(:, :, :) ) ) - end if - if ( lbu_rv ) then - tbudgets(NBUDGET_V)%trhodj%xdata(:, nbutime, :) = tbudgets(NBUDGET_V)%trhodj%xdata(:, nbutime, :) & - + Mask_compress( Mym( xrhodj(:, :, :) ) ) - end if - if ( lbu_rw ) then - tbudgets(NBUDGET_W)%trhodj%xdata(:, nbutime, :) = tbudgets(NBUDGET_W)%trhodj%xdata(:, nbutime, :) & - + Mask_compress( Mzm( xrhodj(:, :, :) ) ) - end if - if ( associated( tburhodj ) ) tburhodj%xdata(:, nbutime, :) = tburhodj%xdata(:, nbutime, :) + Mask_compress( xrhodj(:, :, :) ) -END IF -! -IF (NBUMOD==IMI .AND. CBUTYPE=='CART' ) THEN - if ( lbu_ru ) then - tbudgets(NBUDGET_U)%trhodj%xdata(:, :, :) = tbudgets(NBUDGET_U)%trhodj%xdata(:, :, :) + Cart_compress( Mxm( xrhodj(:, :, :) ) ) - end if - if ( lbu_rv ) then - tbudgets(NBUDGET_V)%trhodj%xdata(:, :, :) = tbudgets(NBUDGET_V)%trhodj%xdata(:, :, :) + Cart_compress( Mym( xrhodj(:, :, :) ) ) - end if - if ( lbu_rw ) then - tbudgets(NBUDGET_W)%trhodj%xdata(:, :, :) = tbudgets(NBUDGET_W)%trhodj%xdata(:, :, :) & - + Cart_compress( Mzm( xrhodj(:, :, :) ) ) - end if - if ( associated( tburhodj ) ) tburhodj%xdata(:, :, :) = tburhodj%xdata(:, :, :) + Cart_compress( xrhodj(:, :, :) ) -END IF -! -CALL BUDGET_FLAGS(LUSERV, LUSERC, LUSERR, & - LUSERI, LUSERS, LUSERG, LUSERH ) -! -XTIME_BU = 0.0 -! -!------------------------------------------------------------------------------- -! -!* 6. INITIALIZATION OF THE FIELD TENDENCIES -! -------------------------------------- -! -ZTIME1 = ZTIME2 -XTIME_BU_PROCESS = 0. -! -CALL INITIAL_GUESS ( NRR, NSV, KTCOUNT, XRHODJ,IMI, XTSTEP, & - XRUS, XRVS, XRWS, XRTHS, XRRS, XRTKES, XRSVS, & - XUT, XVT, XWT, XTHT, XRT, XTKET, XSVT ) -! -CALL SECOND_MNH2(ZTIME2) -! -XT_GUESS = XT_GUESS + ZTIME2 - ZTIME1 - XTIME_BU_PROCESS -! -!------------------------------------------------------------------------------- -! -!* 7. INITIALIZATION OF THE LES FOR CURRENT TIME-STEP -! ----------------------------------------------- -! -XTIME_LES_BU = 0.0 -XTIME_LES = 0.0 -IF (LLES) CALL LES_INI_TIMESTEP_n(KTCOUNT) -! -!------------------------------------------------------------------------------- -! -!* 8. TWO-WAY INTERACTIVE GRID-NESTING -! -------------------------------- -! -! -CALL SECOND_MNH2(ZTIME1) -XTIME_BU_PROCESS = 0. -XTIME_LES_BU_PROCESS = 0. -! -GMASKkids(:,:)=.FALSE. -! -IF (NMODEL>1) THEN - ! correct an ifort bug - DPTR_XRHODJ=>XRHODJ - DPTR_XUM=>XUT - DPTR_XVM=>XVT - DPTR_XWM=>XWT - DPTR_XTHM=>XTHT - DPTR_XRM=>XRT - DPTR_XTKEM=>XTKET - DPTR_XSVM=>XSVT - DPTR_XRUS=>XRUS - DPTR_XRVS=>XRVS - DPTR_XRWS=>XRWS - DPTR_XRTHS=>XRTHS - DPTR_XRRS=>XRRS - DPTR_XRTKES=>XRTKES - DPTR_XRSVS=>XRSVS - DPTR_XINPRC=>XINPRC - DPTR_XINPRR=>XINPRR - DPTR_XINPRS=>XINPRS - DPTR_XINPRG=>XINPRG - DPTR_XINPRH=>XINPRH - DPTR_XPRCONV=>XPRCONV - DPTR_XPRSCONV=>XPRSCONV - DPTR_XDIRFLASWD=>XDIRFLASWD - DPTR_XSCAFLASWD=>XSCAFLASWD - DPTR_XDIRSRFSWD=>XDIRSRFSWD - DPTR_GMASKkids=>GMASKkids - ! - CALL TWO_WAY( NRR,NSV,KTCOUNT,DPTR_XRHODJ,IMI,XTSTEP, & - DPTR_XUM ,DPTR_XVM ,DPTR_XWM , DPTR_XTHM, DPTR_XRM,DPTR_XSVM, & - DPTR_XRUS,DPTR_XRVS,DPTR_XRWS,DPTR_XRTHS,DPTR_XRRS,DPTR_XRSVS, & - DPTR_XINPRC,DPTR_XINPRR,DPTR_XINPRS,DPTR_XINPRG,DPTR_XINPRH,DPTR_XPRCONV,DPTR_XPRSCONV, & - DPTR_XDIRFLASWD,DPTR_XSCAFLASWD,DPTR_XDIRSRFSWD,DPTR_GMASKkids ) -END IF -! -CALL SECOND_MNH2(ZTIME2) -XT_2WAY = XT_2WAY + ZTIME2 - ZTIME1 - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS -! -!------------------------------------------------------------------------------- -!------------------------------------------------------------------------------- -! -!* 10. FORCING -! ------- -! -! -ZTIME1 = ZTIME2 -XTIME_BU_PROCESS = 0. -XTIME_LES_BU_PROCESS = 0. -IF (LCARTESIAN) THEN - CALL SM_GRIDCART(XXHAT,XYHAT,XZHAT,XZS,LSLEVE,XLEN1,XLEN2,XZSMT,XDXHAT,XDYHAT,XZZ,ZJ) - XMAP=1. -ELSE - CALL SM_GRIDPROJ(XXHAT,XYHAT,XZHAT,XZS,LSLEVE,XLEN1,XLEN2,XZSMT,XLATORI,XLONORI, & - XMAP,XLAT,XLON,XDXHAT,XDYHAT,XZZ,ZJ) -END IF -! -IF ( LFORCING ) THEN - CALL FORCING(XTSTEP,LUSERV,XRHODJ,XCORIOZ,XZHAT,XZZ,TDTCUR,& - XUFRC_PAST, XVFRC_PAST,XWTFRC, & - XUT,XVT,XWT,XTHT,XTKET,XRT,XSVT, & - XRUS,XRVS,XRWS,XRTHS,XRTKES,XRRS,XRSVS,IMI,ZJ) -END IF -! -IF ( L2D_ADV_FRC ) THEN - CALL ADV_FORCING_n(XRHODJ,TDTCUR,XTHT,XRT,XZZ,XRTHS,XRRS) -END IF -IF ( L2D_REL_FRC ) THEN - CALL REL_FORCING_n(XRHODJ,TDTCUR,XTHT,XRT,XZZ,XRTHS,XRRS) -END IF -! -CALL SECOND_MNH2(ZTIME2) -! -XT_FORCING = XT_FORCING + ZTIME2 - ZTIME1 & - - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS -! -!------------------------------------------------------------------------------- -! -!* 11. NUDGING -! ------- -! -! -ZTIME1 = ZTIME2 -XTIME_BU_PROCESS = 0. -XTIME_LES_BU_PROCESS = 0. -! -IF ( LNUDGING ) THEN - CALL NUDGING(LUSERV,XRHODJ,XTNUDGING, & - XUT,XVT,XWT,XTHT,XRT, & - XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM, & - XRUS,XRVS,XRWS,XRTHS,XRRS) - -END IF -! -CALL SECOND_MNH2(ZTIME2) -! -XT_NUDGING = XT_NUDGING + ZTIME2 - ZTIME1 & - - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS -! -!------------------------------------------------------------------------------- -! -!* 12. DYNAMICAL SOURCES -! ----------------- -! -ZTIME1 = ZTIME2 -XTIME_BU_PROCESS = 0. -XTIME_LES_BU_PROCESS = 0. -! -IF( LTRANS ) THEN - XUT(:,:,:) = XUT(:,:,:) + XUTRANS - XVT(:,:,:) = XVT(:,:,:) + XVTRANS -END IF -! -CALL DYN_SOURCES( NRR,NRRL, NRRI, & - XUT, XVT, XWT, XTHT, XRT, & - XCORIOX, XCORIOY, XCORIOZ, XCURVX, XCURVY, & - XRHODJ, XZZ, XTHVREF, XEXNREF, & - XRUS, XRVS, XRWS, XRTHS ) -! -IF( LTRANS ) THEN - XUT(:,:,:) = XUT(:,:,:) - XUTRANS - XVT(:,:,:) = XVT(:,:,:) - XVTRANS -END IF -! -CALL SECOND_MNH2(ZTIME2) -! -XT_SOURCES = XT_SOURCES + ZTIME2 - ZTIME1 & - - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS -! -!------------------------------------------------------------------------------- -! -!* 13. NUMERICAL DIFFUSION -! ------------------- -! -ZTIME1 = ZTIME2 -XTIME_BU_PROCESS = 0. -XTIME_LES_BU_PROCESS = 0. -! -IF ( LNUMDIFU .OR. LNUMDIFTH .OR. LNUMDIFSV ) THEN -! - CALL UPDATE_HALO_ll(TFIELDT_ll, IINFO_ll) - CALL UPDATE_HALO2_ll(TFIELDT_ll, THALO2T_ll, IINFO_ll) - IF ( .NOT. LSTEADYLS ) THEN - CALL UPDATE_HALO_ll(TLSFIELD_ll, IINFO_ll) - CALL UPDATE_HALO_ll(TLSFIELD2D_ll,IINFO_ll) - CALL UPDATE_HALO2_ll(TLSFIELD_ll, TLSHALO2_ll, IINFO_ll) - END IF - CALL NUM_DIFF ( CLBCX, CLBCY, NRR, NSV, & - XDK2U, XDK4U, XDK2TH, XDK4TH, XDK2SV, XDK4SV, IMI, & - XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, & - XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM,XRHODJ, & - XRUS, XRVS, XRWS, XRTHS, XRTKES, XRRS, XRSVS, & - LZDIFFU,LNUMDIFU, LNUMDIFTH, LNUMDIFSV, & - THALO2T_ll, TLSHALO2_ll,XZDIFFU_HALO2 ) -END IF - -if ( lbudget_sv ) then - do jsv = 1, nsv - call Budget_store_init( tbudgets(jsv + NBUDGET_SV1 - 1), 'NEGA2', xrsvs(:, :, :, jsv) ) - end do -end if - -DO JSV = NSV_CHEMBEG,NSV_CHEMEND - XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.) -END DO -DO JSV = NSV_CHICBEG,NSV_CHICEND - XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.) -END DO -DO JSV = NSV_AERBEG,NSV_AEREND - XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.) -END DO -DO JSV = NSV_LNOXBEG,NSV_LNOXEND - XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.) -END DO -DO JSV = NSV_DSTBEG,NSV_DSTEND - XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.) -END DO -DO JSV = NSV_SLTBEG,NSV_SLTEND - XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.) -END DO -DO JSV = NSV_PPBEG,NSV_PPEND - XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.) -END DO -#ifdef MNH_FOREFIRE -DO JSV = NSV_FFBEG,NSV_FFEND - XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.) -END DO -#endif -DO JSV = NSV_CSBEG,NSV_CSEND - XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.) -END DO -DO JSV = NSV_DSTDEPBEG,NSV_DSTDEPEND - XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.) -END DO -DO JSV = NSV_SLTDEPBEG,NSV_SLTDEPEND - XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.) -END DO -DO JSV = NSV_AERDEPBEG,NSV_AERDEPEND - XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.) -END DO -DO JSV = NSV_SNWBEG,NSV_SNWEND - XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.) -END DO -IF (CELEC .NE. 'NONE') THEN - XRSVS(:,:,:,NSV_ELECBEG) = MAX(XRSVS(:,:,:,NSV_ELECBEG),0.) - XRSVS(:,:,:,NSV_ELECEND) = MAX(XRSVS(:,:,:,NSV_ELECEND),0.) -END IF - -if ( lbudget_sv ) then - do jsv = 1, nsv - call Budget_store_end( tbudgets(jsv + NBUDGET_SV1 - 1), 'NEGA2', xrsvs(:, :, :, jsv) ) - end do -end if -! -CALL SECOND_MNH2(ZTIME2) -! -XT_DIFF = XT_DIFF + ZTIME2 - ZTIME1 & - - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS -! -!------------------------------------------------------------------------------- -! -!* 14. UPPER AND LATERAL RELAXATION -! ---------------------------- -! -ZTIME1 = ZTIME2 -XTIME_BU_PROCESS = 0. -XTIME_LES_BU_PROCESS = 0. -! -IF(LVE_RELAX .OR. LVE_RELAX_GRD .OR. LHORELAX_UVWTH .OR. LHORELAX_RV .OR.& - LHORELAX_RC .OR. LHORELAX_RR .OR. LHORELAX_RI .OR. LHORELAX_RS .OR. & - LHORELAX_RG .OR. LHORELAX_RH .OR. LHORELAX_TKE .OR. & - ANY(LHORELAX_SV)) THEN - CALL RELAXATION (LVE_RELAX,LVE_RELAX_GRD,LHORELAX_UVWTH,LHORELAX_RV,LHORELAX_RC, & - LHORELAX_RR,LHORELAX_RI,LHORELAX_RS,LHORELAX_RG, & - LHORELAX_RH,LHORELAX_TKE,LHORELAX_SV, & - LHORELAX_SVC2R2,LHORELAX_SVC1R3, & - LHORELAX_SVELEC,LHORELAX_SVLG, & - LHORELAX_SVCHEM,LHORELAX_SVCHIC,LHORELAX_SVAER, & - LHORELAX_SVDST,LHORELAX_SVSLT,LHORELAX_SVPP, & - LHORELAX_SVCS,LHORELAX_SVSNW, & -#ifdef MNH_FOREFIRE - LHORELAX_SVFF, & -#endif - KTCOUNT,NRR,NSV,XTSTEP,XRHODJ, & - XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, & - XLSUM, XLSVM, XLSWM, XLSTHM, & - XLBXUM, XLBXVM, XLBXWM, XLBXTHM, & - XLBXRM, XLBXSVM, XLBXTKEM, & - XLBYUM, XLBYVM, XLBYWM, XLBYTHM, & - XLBYRM, XLBYSVM, XLBYTKEM, & - NALBOT, XALK, XALKW, & - NALBAS, XALKBAS, XALKWBAS, & - LMASK_RELAX,XKURELAX, XKVRELAX, XKWRELAX, & - NRIMX,NRIMY, & - XRUS, XRVS, XRWS, XRTHS, XRRS, XRSVS, XRTKES ) -END IF - -IF (CELEC.NE.'NONE' .AND. LRELAX2FW_ION) THEN - CALL RELAX2FW_ION (KTCOUNT, IMI, XTSTEP, XRHODJ, XSVT, NALBOT, & - XALK, LMASK_RELAX, XKWRELAX, XRSVS ) -END IF -! -CALL SECOND_MNH2(ZTIME2) -! -XT_RELAX = XT_RELAX + ZTIME2 - ZTIME1 & - - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS -! -!------------------------------------------------------------------------------- -! -!* 15. PARAMETRIZATIONS' MONITOR -! ------------------------- -! -ZTIME1 = ZTIME2 -! -CALL PHYS_PARAM_n( KTCOUNT, TZBAKFILE, & - XT_RAD, XT_SHADOWS, XT_DCONV, XT_GROUND, & - XT_MAFL, XT_DRAG, XT_EOL, XT_TURB, XT_TRACER, & - ZTIME, ZWETDEPAER, GMASKkids, GCLOUD_ONLY ) -! -IF (CDCONV/='NONE') THEN - XPACCONV = XPACCONV + XPRCONV * XTSTEP - IF (LCH_CONV_LINOX) THEN - XIC_TOTAL_NUMBER = XIC_TOTAL_NUMBER + XIC_RATE * XTSTEP - XCG_TOTAL_NUMBER = XCG_TOTAL_NUMBER + XCG_RATE * XTSTEP - END IF -END IF -! -IF ( nfile_backup_current > 0 .AND. nfile_backup_current <= NBAK_NUMB ) THEN - IF ( KTCOUNT == TBACKUPN(nfile_backup_current)%NSTEP ) THEN - IF (CSURF=='EXTE') THEN - CALL GOTO_SURFEX(IMI) - CALL DIAG_SURF_ATM_n(YSURF_CUR,'MESONH') - TFILE_SURFEX => TZBAKFILE - CALL WRITE_DIAG_SURF_ATM_n(YSURF_CUR,'MESONH','ALL') - NULLIFY(TFILE_SURFEX) - END IF - END IF -END IF -! -CALL SECOND_MNH2(ZTIME2) -! -XT_PARAM = XT_PARAM + ZTIME2 - ZTIME1 - XTIME_LES - ZTIME -! -!------------------------------------------------------------------------------- -! -!* 16. TEMPORAL SERIES -! --------------- -! -ZTIME1 = ZTIME2 -! -IF (LSERIES) THEN - IF ( MOD (KTCOUNT-1,NFREQSERIES) == 0 ) CALL SERIES_n -END IF -! -CALL SECOND_MNH2(ZTIME2) -! -XT_STEP_MISC = XT_STEP_MISC + ZTIME2 - ZTIME1 -! -!------------------------------------------------------------------------------- -! -!* 17. LARGE SCALE FIELD REFRESH -! ------------------------- -! -ZTIME1 = ZTIME2 -! -IF (.NOT. LSTEADYLS) THEN - IF ( IMI==1 .AND. & - NCPL_CUR < NCPL_NBR ) THEN - IF (KTCOUNT+1 == NCPL_TIMES(NCPL_CUR,1) ) THEN - ! The next current time reachs a - NCPL_CUR=NCPL_CUR+1 ! coupling one, LS sources are refreshed - ! - CALL LS_COUPLING(XTSTEP,GSTEADY_DMASS,CCONF, & - CGETTKET, & - CGETRVT,CGETRCT,CGETRRT,CGETRIT, & - CGETRST,CGETRGT,CGETRHT,CGETSVT,LCH_INIT_FIELD, NSV, & - NIMAX_ll,NJMAX_ll, & - NSIZELBX_ll,NSIZELBXU_ll,NSIZELBY_ll,NSIZELBYV_ll, & - NSIZELBXTKE_ll,NSIZELBYTKE_ll, & - NSIZELBXR_ll,NSIZELBYR_ll,NSIZELBXSV_ll,NSIZELBYSV_ll, & - XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM,XLSZWSM,XDRYMASST, & - XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM, & - XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, & - XLSUS,XLSVS,XLSWS,XLSTHS,XLSRVS,XLSZWSS,XDRYMASSS, & - XLBXUS,XLBXVS,XLBXWS,XLBXTHS,XLBXTKES,XLBXRS,XLBXSVS, & - XLBYUS,XLBYVS,XLBYWS,XLBYTHS,XLBYTKES,XLBYRS,XLBYSVS ) - ! - DO JSV=NSV_CHEMBEG,NSV_CHEMEND - XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.) - XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.) - ENDDO - ! - DO JSV=NSV_LNOXBEG,NSV_LNOXEND - XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.) - XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.) - ENDDO - ! - DO JSV=NSV_AERBEG,NSV_AEREND - XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.) - XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.) - ENDDO - ! - DO JSV=NSV_DSTBEG,NSV_DSTEND - XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.) - XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.) - ENDDO - ! - DO JSV=NSV_DSTDEPBEG,NSV_DSTDEPEND - XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.) - XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.) - ENDDO - ! - DO JSV=NSV_SLTBEG,NSV_SLTEND - XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.) - XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.) - ENDDO - ! - DO JSV=NSV_SLTDEPBEG,NSV_SLTDEPEND - XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.) - XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.) - ENDDO - ! - DO JSV=NSV_PPBEG,NSV_PPEND - XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.) - XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.) - ENDDO - ! -#ifdef MNH_FOREFIRE - DO JSV=NSV_FFBEG,NSV_FFEND - XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.) - XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.) - ENDDO - ! -#endif - DO JSV=NSV_CSBEG,NSV_CSEND - XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.) - XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.) - ENDDO - ! - DO JSV=NSV_SNWBEG,NSV_SNWEND - XLBXSVS(:,:,:,JSV)=MAX(XLBXSVS(:,:,:,JSV),0.) - XLBYSVS(:,:,:,JSV)=MAX(XLBYSVS(:,:,:,JSV),0.) - ENDDO - ! - END IF - END IF -END IF -! -CALL SECOND_MNH2(ZTIME2) -! -XT_COUPL = XT_COUPL + ZTIME2 - ZTIME1 -! -!------------------------------------------------------------------------------- -! -! -! -!* 8 Bis . Blowing snow scheme -! --------- -! -IF ( LBLOWSNOW ) THEN - CALL BLOWSNOW( XTSTEP, NRR, XPABST, XTHT, XRT, XZZ, XRHODREF, & - XRHODJ, XEXNREF, XRRS, XRTHS, XSVT, XRSVS, XSNWSUBL3D ) -ENDIF -! -!----------------------------------------------------------------------- -! -!* 8 Ter VISCOSITY (no-slip condition inside) -! --------- -! -! -IF ( LVISC ) THEN -! -ZTIME1 = ZTIME2 -! - CALL VISCOSITY(CLBCX, CLBCY, NRR, NSV, XMU_V,XPRANDTL, & - LVISC_UVW,LVISC_TH,LVISC_SV,LVISC_R, & - LDRAG, & - XUT, XVT, XWT, XTHT, XRT, XSVT, & - XRHODJ, XDXX, XDYY, XDZZ, XDZX, XDZY, & - XRUS, XRVS, XRWS, XRTHS, XRRS, XRSVS,XDRAG ) -! -ENDIF -! -CALL SECOND_MNH2(ZTIME2) -! -XT_VISC = XT_VISC + ZTIME2 - ZTIME1 -!! -!------------------------------------------------------------------------------- -! -!* 9. ADVECTION -! --------- -! -ZTIME1 = ZTIME2 -XTIME_BU_PROCESS = 0. -XTIME_LES_BU_PROCESS = 0. -! -! -! -CALL MPPDB_CHECK3DM("before ADVEC_METSV:XU/V/W/TH/TKE/T,XRHODJ",PRECISION,& - & XUT, XVT, XWT, XTHT, XTKET,XRHODJ) - CALL ADVECTION_METSV ( TZBAKFILE, CUVW_ADV_SCHEME, & - CMET_ADV_SCHEME, CSV_ADV_SCHEME, CCLOUD, NSPLIT, & - LSPLIT_CFL, XSPLIT_CFL, LCFL_WRIT, & - CLBCX, CLBCY, NRR, NSV, TDTCUR, XTSTEP, & - XUT, XVT, XWT, XTHT, XRT, XTKET, XSVT, XPABST, & - XTHVREF, XRHODJ, XDXX, XDYY, XDZZ, XDZX, XDZY, & - XRTHS, XRRS, XRTKES, XRSVS, & - XRTHS_CLD, XRRS_CLD, XRSVS_CLD, XRTKEMS ) -CALL MPPDB_CHECK3DM("after ADVEC_METSV:XU/V/W/TH/TKE/T,XRHODJ ",PRECISION,& - & XUT, XVT, XWT, XTHT, XTKET,XRHODJ) -! -CALL SECOND_MNH2(ZTIME2) -! -XT_ADV = XT_ADV + ZTIME2 - ZTIME1 - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS -! -!------------------------------------------------------------------------------- -ZTIME1 = ZTIME2 -XTIME_BU_PROCESS = 0. -XTIME_LES_BU_PROCESS = 0. -! -ZRWS = XRWS -! -CALL GRAVITY_IMPL ( CLBCX, CLBCY, NRR, NRRL, NRRI,XTSTEP, & - XTHT, XRT, XTHVREF, XRHODJ, XRWS, XRTHS, XRRS, & - XRTHS_CLD, XRRS_CLD ) -! -! At the initial instant the difference with the ref state creates a -! vertical velocity production that must not be advected as it is -! compensated by the pressure gradient -! -IF (KTCOUNT == 1 .AND. CCONF=='START') XRWS_PRES = - (XRWS - ZRWS) -! -CALL SECOND_MNH2(ZTIME2) -! -XT_GRAV = XT_GRAV + ZTIME2 - ZTIME1 - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS -! -IF ( LIBM .AND. CIBM_ADV=='FORCIN' ) THEN - ! - ZTIME1=ZTIME2 - ! - CALL IBM_FORCING_ADV (XRUS,XRVS,XRWS) - ! - CALL SECOND_MNH2(ZTIME2) - ! - XT_IBM_FORC = XT_IBM_FORC + ZTIME2 - ZTIME1 - ! -ENDIF -! -ZTIME1 = ZTIME2 -XTIME_BU_PROCESS = 0. -XTIME_LES_BU_PROCESS = 0. -! -!MPPDB_CHECK_LB=.TRUE. -CALL MPPDB_CHECK3DM("before ADVEC_UVW:XU/V/W/TH/TKE/T,XRHODJ,XRU/V/Ws",PRECISION,& - & XUT, XVT, XWT, XTHT, XTKET,XRHODJ,XRUS,XRVS,XRWS) -IF ((CUVW_ADV_SCHEME(1:3)=='CEN') .AND. (CTEMP_SCHEME == 'LEFR')) THEN - IF (CUVW_ADV_SCHEME=='CEN4TH') THEN - NULLIFY(TZFIELDC_ll) - NULLIFY(TZHALO2C_ll) - CALL ADD3DFIELD_ll( TZFIELDC_ll, XUT, 'MODEL_n::XUT' ) - CALL ADD3DFIELD_ll( TZFIELDC_ll, XVT, 'MODEL_n::XVT' ) - CALL ADD3DFIELD_ll( TZFIELDC_ll, XWT, 'MODEL_n::XWT' ) - CALL INIT_HALO2_ll(TZHALO2C_ll,3,IIU,IJU,IKU) - CALL UPDATE_HALO_ll(TZFIELDC_ll,IINFO_ll) - CALL UPDATE_HALO2_ll(TZFIELDC_ll, TZHALO2C_ll, IINFO_ll) - END IF - CALL ADVECTION_UVW_CEN(CUVW_ADV_SCHEME, & - CLBCX, CLBCY, & - XTSTEP, KTCOUNT, & - XUM, XVM, XWM, XDUM, XDVM, XDWM, & - XUT, XVT, XWT, & - XRHODJ, XDXX, XDYY, XDZZ, XDZX, XDZY, & - XRUS,XRVS, XRWS, & - TZHALO2C_ll ) - IF (CUVW_ADV_SCHEME=='CEN4TH') THEN - CALL CLEANLIST_ll(TZFIELDC_ll) - NULLIFY(TZFIELDC_ll) - CALL DEL_HALO2_ll(TZHALO2C_ll) - NULLIFY(TZHALO2C_ll) - END IF -ELSE - - CALL ADVECTION_UVW(CUVW_ADV_SCHEME, CTEMP_SCHEME, & - NWENO_ORDER, LSPLIT_WENO, & - CLBCX, CLBCY, XTSTEP, & - XUT, XVT, XWT, & - XRHODJ, XDXX, XDYY, XDZZ, XDZX, XDZY, & - XRUS, XRVS, XRWS, & - XRUS_PRES, XRVS_PRES, XRWS_PRES ) -END IF -! -CALL MPPDB_CHECK3DM("after ADVEC_UVW:XU/V/W/TH/TKE/T,XRHODJ,XRU/V/Ws",PRECISION,& - & XUT, XVT, XWT, XTHT, XTKET,XRHODJ,XRUS,XRVS,XRWS) -!MPPDB_CHECK_LB=.FALSE. -! -CALL SECOND_MNH2(ZTIME2) -! -XT_ADVUVW = XT_ADVUVW + ZTIME2 - ZTIME1 - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS -! -!------------------------------------------------------------------------------- -! -IF (NMODEL_CLOUD==IMI .AND. CTURBLEN_CLOUD/='NONE') THEN - CALL TURB_CLOUD_INDEX( XTSTEP, TZBAKFILE, & - LTURB_DIAG, NRRI, & - XRRS, XRT, XRHODJ, XDXX, XDYY, XDZZ, XDZX, XDZY, & - XCEI ) -END IF -! -!------------------------------------------------------------------------------- -! -!* 18. LATERAL BOUNDARY CONDITION FOR THE NORMAL VELOCITY -! -------------------------------------------------- -! -ZTIME1 = ZTIME2 -! -CALL MPPDB_CHECK3DM("before RAD_BOUND :XRU/V/WS",PRECISION,XRUS,XRVS,XRWS) -ZRUS=XRUS -ZRVS=XRVS -ZRWS=XRWS - -if ( .not. l1d ) then - if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'PRES', xrus(:, :, :) ) - if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V), 'PRES', xrvs(:, :, :) ) - if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W), 'PRES', xrws(:, :, :) ) -end if - -CALL RAD_BOUND (CLBCX,CLBCY,CTURB,XCARPKMAX, & - XTSTEP, & - XDXHAT, XDYHAT, XZHAT, & - XUT, XVT, & - XLBXUM, XLBYVM, XLBXUS, XLBYVS, & - XFLUCTUNW,XFLUCTVNN,XFLUCTUNE,XFLUCTVNS, & - XCPHASE, XCPHASE_PBL, XRHODJ, & - XTKET,XRUS, XRVS, XRWS ) -ZRUS=XRUS-ZRUS -ZRVS=XRVS-ZRVS -ZRWS=XRWS-ZRWS -! -CALL SECOND_MNH2(ZTIME2) -! -XT_RAD_BOUND = XT_RAD_BOUND + ZTIME2 - ZTIME1 -! -!------------------------------------------------------------------------------- -! -!* 19. PRESSURE COMPUTATION -! -------------------- -! -ZTIME1 = ZTIME2 -XTIME_BU_PROCESS = 0. -XTIME_LES_BU_PROCESS = 0. -! -ZPABST = XPABST -! -IF(.NOT. L1D) THEN -! -CALL MPPDB_CHECK3DM("before pressurez:XRU/V/WS",PRECISION,XRUS,XRVS,XRWS) - XRUS_PRES = XRUS - XRVS_PRES = XRVS - XRWS_PRES = XRWS -! - CALL PRESSUREZ( CLBCX,CLBCY,CPRESOPT,NITR,LITRADJ,KTCOUNT, XRELAX,IMI, & - XRHODJ,XDXX,XDYY,XDZZ,XDZX,XDZY,XDXHATM,XDYHATM,XRHOM, & - XAF,XBFY,XCF,XTRIGSX,XTRIGSY,NIFAXX,NIFAXY, & - NRR,NRRL,NRRI,XDRYMASST,XREFMASS,XMASS_O_PHI0, & - XTHT,XRT,XRHODREF,XTHVREF,XRVREF,XEXNREF, XLINMASS, & - XRUS, XRVS, XRWS, XPABST, & - XBFB,& - XBF_SXP2_YP1_Z) !JUAN Z_SPLITING -! - XRUS_PRES = XRUS - XRUS_PRES + ZRUS - XRVS_PRES = XRVS - XRVS_PRES + ZRVS - XRWS_PRES = XRWS - XRWS_PRES + ZRWS -! -END IF -! -CALL SECOND_MNH2(ZTIME2) -! -XT_PRESS = XT_PRESS + ZTIME2 - ZTIME1 & - - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS -! -!------------------------------------------------------------------------------- -! -!* 20. CHEMISTRY/AEROSOLS -! ------------------ -! -ZTIME1 = ZTIME2 -XTIME_BU_PROCESS = 0. -XTIME_LES_BU_PROCESS = 0. -! -IF (LUSECHEM) THEN - CALL CH_MONITOR_n(ZWETDEPAER,KTCOUNT,XTSTEP, ILUOUT, NVERB) -END IF -! -! For inert aerosol (dust and sea salt) => aer_monitor_n -IF ((LDUST).OR.(LSALT)) THEN -! -! tests to see if any cloud exists -! - GCLD=.TRUE. - IF (GCLD .AND. NRR.LE.3 ) THEN - IF( MAXVAL(XCLDFR(:,:,:)).LE. 1.E-10 .AND. GCLOUD_ONLY ) THEN - GCLD = .FALSE. ! only the cloudy verticals would be - ! refreshed but there is no clouds - END IF - END IF -! - IF (GCLD .AND. NRR.GE.4 ) THEN - IF( CCLOUD(1:3)=='ICE' )THEN - IF( MAXVAL(XRT(:,:,:,2)).LE.XRTMIN(2) .AND. & - MAXVAL(XRT(:,:,:,4)).LE.XRTMIN(4) .AND. GCLOUD_ONLY ) THEN - GCLD = .FALSE. ! only the cloudy verticals would be - ! refreshed but there is no cloudwater and ice - END IF - END IF - IF( CCLOUD=='C3R5' )THEN - IF( MAXVAL(XRT(:,:,:,2)).LE.XRTMIN_C1R3(2) .AND. & - MAXVAL(XRT(:,:,:,4)).LE.XRTMIN_C1R3(4) .AND. GCLOUD_ONLY ) THEN - GCLD = .FALSE. ! only the cloudy verticals would be - ! refreshed but there is no cloudwater and ice - END IF - END IF - IF( CCLOUD=='LIMA' )THEN - IF( MAXVAL(XRT(:,:,:,2)).LE.XRTMIN_LIMA(2) .AND. & - MAXVAL(XRT(:,:,:,4)).LE.XRTMIN_LIMA(4) .AND. GCLOUD_ONLY ) THEN - GCLD = .FALSE. ! only the cloudy verticals would be - ! refreshed but there is no cloudwater and ice - END IF - END IF - END IF - -! - CALL AER_MONITOR_n(KTCOUNT,XTSTEP, ILUOUT, NVERB, GCLD) -END IF -! -! -CALL SECOND_MNH2(ZTIME2) -! -XT_CHEM = XT_CHEM + ZTIME2 - ZTIME1 & - - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS -! -ZTIME = ZTIME + XTIME_LES_BU_PROCESS + XTIME_BU_PROCESS - -!------------------------------------------------------------------------------- -! -!* 20. WATER MICROPHYSICS -! ------------------ -! -ZTIME1 = ZTIME2 -XTIME_BU_PROCESS = 0. -XTIME_LES_BU_PROCESS = 0. -! -IF (CCLOUD /= 'NONE' .AND. CELEC == 'NONE') THEN -! - IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'KHKO' .OR. CCLOUD == 'C3R5' & - .OR. CCLOUD == "LIMA" ) THEN - IF ( LFORCING ) THEN - XWT_ACT_NUC(:,:,:) = XWT(:,:,:) + XWTFRC(:,:,:) - ELSE - XWT_ACT_NUC(:,:,:) = XWT(:,:,:) - END IF - IF (CTURB /= 'NONE' ) THEN - IF ( ((CCLOUD=='C2R2'.OR.CCLOUD=='KHKO').AND.LACTTKE) .OR. (CCLOUD=='LIMA'.AND.MACTTKE) ) THEN - XWT_ACT_NUC(:,:,:) = XWT_ACT_NUC(:,:,:) + (2./3. * XTKET(:,:,:))**0.5 - ELSE - XWT_ACT_NUC(:,:,:) = XWT_ACT_NUC(:,:,:) - ENDIF - ENDIF - ELSE - XWT_ACT_NUC(:,:,:) = 0. - END IF -! - XRTHS_CLD = XRTHS - XRRS_CLD = XRRS - XRSVS_CLD = XRSVS - IF (CSURF=='EXTE') THEN - ALLOCATE (ZSEA(SIZE(XRHODJ,1),SIZE(XRHODJ,2))) - ALLOCATE (ZTOWN(SIZE(XRHODJ,1),SIZE(XRHODJ,2))) - ZSEA(:,:) = 0. - ZTOWN(:,:)= 0. - CALL MNHGET_SURF_PARAM_n (PSEA=ZSEA(:,:),PTOWN=ZTOWN(:,:)) - CALL RESOLVED_CLOUD ( CCLOUD, CACTCCN, CSCONV, CMF_CLOUD, NRR, NSPLITR, & - NSPLITG, IMI, KTCOUNT, & - CLBCX,CLBCY,TZBAKFILE, CRAD, CTURBDIM, & - LSUBG_COND,LSIGMAS,CSUBG_AUCV,XTSTEP, & - XZZ, XRHODJ, XRHODREF, XEXNREF, & - ZPABST, XTHT,XRT,XSIGS,VSIGQSAT,XMFCONV,XTHM,XRCM, & - XPABSM, XWT_ACT_NUC,XDTHRAD, XRTHS, XRRS, & - XSVT, XRSVS, & - XSRCT, XCLDFR,XCIT, & - LSEDIC,KACTIT, KSEDC, KSEDI, KRAIN, KWARM, KHHONI, & - LCONVHG, XCF_MF,XRC_MF, XRI_MF, & - XINPRC,ZINPRC3D,XINPRR, XINPRR3D, XEVAP3D, & - XINPRS,ZINPRS3D, XINPRG,ZINPRG3D, XINPRH,ZINPRH3D, & - XSOLORG, XMI,ZSPEEDC, ZSPEEDR, ZSPEEDS, ZSPEEDG, ZSPEEDH, & - XINDEP, XSUPSAT, XNACT, XNPRO,XSSPRO, XRAINFR, & - XHLC_HRC, XHLC_HCF, XHLI_HRI, XHLI_HCF, & - ZSEA, ZTOWN ) - DEALLOCATE(ZTOWN) - ELSE - CALL RESOLVED_CLOUD ( CCLOUD, CACTCCN, CSCONV, CMF_CLOUD, NRR, NSPLITR, & - NSPLITG, IMI, KTCOUNT, & - CLBCX,CLBCY,TZBAKFILE, CRAD, CTURBDIM, & - LSUBG_COND,LSIGMAS,CSUBG_AUCV, & - XTSTEP,XZZ, XRHODJ, XRHODREF, XEXNREF, & - ZPABST, XTHT,XRT,XSIGS,VSIGQSAT,XMFCONV,XTHM,XRCM, & - XPABSM, XWT_ACT_NUC,XDTHRAD, XRTHS, XRRS, & - XSVT, XRSVS, & - XSRCT, XCLDFR,XCIT, & - LSEDIC,KACTIT, KSEDC, KSEDI, KRAIN, KWARM, KHHONI, & - LCONVHG, XCF_MF,XRC_MF, XRI_MF, & - XINPRC,ZINPRC3D,XINPRR, XINPRR3D, XEVAP3D, & - XINPRS,ZINPRS3D, XINPRG,ZINPRG3D, XINPRH,ZINPRH3D, & - XSOLORG, XMI,ZSPEEDC, ZSPEEDR, ZSPEEDS, ZSPEEDG, ZSPEEDH, & - XINDEP, XSUPSAT, XNACT, XNPRO,XSSPRO, XRAINFR, & - XHLC_HRC, XHLC_HCF, XHLI_HRI, XHLI_HCF ) - END IF - XRTHS_CLD = XRTHS - XRTHS_CLD - XRRS_CLD = XRRS - XRRS_CLD - XRSVS_CLD = XRSVS - XRSVS_CLD -! - IF (CCLOUD /= 'REVE' ) THEN - XACPRR = XACPRR + XINPRR * XTSTEP - IF ( (CCLOUD(1:3) == 'ICE' .AND. LSEDIC ) .OR. & - ((CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO' & - .OR. CCLOUD == 'LIMA' ) .AND. KSEDC ) ) THEN - XACPRC = XACPRC + XINPRC * XTSTEP - IF (LDEPOSC .OR. LDEPOC) XACDEP = XACDEP + XINDEP * XTSTEP - END IF - IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'C3R5' .OR. & - (CCLOUD == 'LIMA' .AND. LCOLD ) ) THEN - XACPRS = XACPRS + XINPRS * XTSTEP - XACPRG = XACPRG + XINPRG * XTSTEP - IF (CCLOUD == 'ICE4' .OR. (CCLOUD == 'LIMA' .AND. LHAIL)) XACPRH = XACPRH + XINPRH * XTSTEP - END IF -! -! Lessivage des CCN et IFN nucléables par Slinn -! - IF (LSCAV .AND. (CCLOUD == 'LIMA')) THEN - CALL LIMA_PRECIP_SCAVENGING(CCLOUD, ILUOUT, KTCOUNT,XTSTEP,XRT(:,:,:,3), & - XRHODREF, XRHODJ, XZZ, XPABST, XTHT, & - XSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), & - XRSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), XINPAP ) -! - XACPAP(:,:) = XACPAP(:,:) + XINPAP(:,:) * XTSTEP - END IF - END IF -! -! It is necessary that SV_C2R2 and SV_C1R3 are contiguous in the preceeding CALL -! -END IF -! -CALL SECOND_MNH2(ZTIME2) -! -XT_CLOUD = XT_CLOUD + ZTIME2 - ZTIME1 & - - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS -! -!------------------------------------------------------------------------------- -! -!* 21. CLOUD ELECTRIFICATION AND LIGHTNING FLASHES -! ------------------------------------------- -! -ZTIME1 = ZTIME2 -XTIME_BU_PROCESS = 0. -XTIME_LES_BU_PROCESS = 0. -! -IF (CELEC /= 'NONE' .AND. (CCLOUD(1:3) == 'ICE')) THEN - XWT_ACT_NUC(:,:,:) = 0. -! - XRTHS_CLD = XRTHS - XRRS_CLD = XRRS - XRSVS_CLD = XRSVS - IF (CSURF=='EXTE') THEN - ALLOCATE (ZSEA(SIZE(XRHODJ,1),SIZE(XRHODJ,2))) - ALLOCATE (ZTOWN(SIZE(XRHODJ,1),SIZE(XRHODJ,2))) - ZSEA(:,:) = 0. - ZTOWN(:,:)= 0. - CALL MNHGET_SURF_PARAM_n (PSEA=ZSEA(:,:),PTOWN=ZTOWN(:,:)) - CALL RESOLVED_ELEC_n (CCLOUD, CSCONV, CMF_CLOUD, & - NRR, NSPLITR, IMI, KTCOUNT, OEXIT, & - CLBCX, CLBCY, CRAD, CTURBDIM, & - LSUBG_COND, LSIGMAS,VSIGQSAT,CSUBG_AUCV, & - XTSTEP, XZZ, XRHODJ, XRHODREF, XEXNREF, & - ZPABST, XTHT, XRTHS, XWT, XRT, XRRS, & - XSVT, XRSVS, XCIT, & - XSIGS, XSRCT, XCLDFR, XMFCONV, XCF_MF, XRC_MF, & - XRI_MF, LSEDIC, LWARM, & - XINPRC, XINPRR, XINPRR3D, XEVAP3D, & - XINPRS, XINPRG, XINPRH, & - ZSEA, ZTOWN ) - DEALLOCATE(ZTOWN) - ELSE - CALL RESOLVED_ELEC_n (CCLOUD, CSCONV, CMF_CLOUD, & - NRR, NSPLITR, IMI, KTCOUNT, OEXIT, & - CLBCX, CLBCY, CRAD, CTURBDIM, & - LSUBG_COND, LSIGMAS,VSIGQSAT, CSUBG_AUCV, & - XTSTEP, XZZ, XRHODJ, XRHODREF, XEXNREF, & - ZPABST, XTHT, XRTHS, XWT, & - XRT, XRRS, XSVT, XRSVS, XCIT, & - XSIGS, XSRCT, XCLDFR, XMFCONV, XCF_MF, XRC_MF, & - XRI_MF, LSEDIC, LWARM, & - XINPRC, XINPRR, XINPRR3D, XEVAP3D, & - XINPRS, XINPRG, XINPRH ) - END IF - XRTHS_CLD = XRTHS - XRTHS_CLD - XRRS_CLD = XRRS - XRRS_CLD - XRSVS_CLD = XRSVS - XRSVS_CLD -! - XACPRR = XACPRR + XINPRR * XTSTEP - IF ((CCLOUD(1:3) == 'ICE' .AND. LSEDIC)) & - XACPRC = XACPRC + XINPRC * XTSTEP - IF (CCLOUD(1:3) == 'ICE') THEN - XACPRS = XACPRS + XINPRS * XTSTEP - XACPRG = XACPRG + XINPRG * XTSTEP - IF (CCLOUD == 'ICE4') XACPRH = XACPRH + XINPRH * XTSTEP - END IF -END IF -! -CALL SECOND_MNH2(ZTIME2) -! -XT_ELEC = XT_ELEC + ZTIME2 - ZTIME1 & - - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS -! -!------------------------------------------------------------------------------- -! -!* 21. L.E.S. COMPUTATIONS -! ------------------- -! -ZTIME1 = ZTIME2 -! -CALL LES_n -! -CALL SECOND_MNH2(ZTIME2) -! -XT_SPECTRA = XT_SPECTRA + ZTIME2 - ZTIME1 + XTIME_LES_BU + XTIME_LES -! -!------------------------------------------------------------------------------- -! -!* 21. bis MEAN_UM -! -------------------- -! -IF (LMEAN_FIELD) THEN - CALL MEAN_FIELD(XUT, XVT, XWT, XTHT, XTKET, XPABST, XSVT(:,:,:,1)) -END IF -! -!------------------------------------------------------------------------------- -! -!* 22. UPDATE HALO OF EACH SUBDOMAINS FOR TIME T+DT -! -------------------------------------------- -! -ZTIME1 = ZTIME2 -! -CALL EXCHANGE (XTSTEP,NRR,NSV,XRHODJ,TFIELDS_ll, & - XRUS, XRVS,XRWS,XRTHS,XRRS,XRTKES,XRSVS) -! -CALL SECOND_MNH2(ZTIME2) -! -XT_HALO = XT_HALO + ZTIME2 - ZTIME1 -! -!------------------------------------------------------------------------------- -! -!* 23. TEMPORAL SWAPPING -! ----------------- -! -ZTIME1 = ZTIME2 -XTIME_BU_PROCESS = 0. -! -CALL ENDSTEP ( XTSTEP,NRR,NSV,KTCOUNT,IMI, & - CUVW_ADV_SCHEME,CTEMP_SCHEME,XRHODJ, & - XRUS,XRVS,XRWS,XDRYMASSS, & - XRTHS,XRRS,XRTKES,XRSVS, & - XLSUS,XLSVS,XLSWS, & - XLSTHS,XLSRVS,XLSZWSS, & - XLBXUS,XLBXVS,XLBXWS, & - XLBXTHS,XLBXRS,XLBXTKES,XLBXSVS, & - XLBYUS,XLBYVS,XLBYWS, & - XLBYTHS,XLBYRS,XLBYTKES,XLBYSVS, & - XUM,XVM,XWM,XZWS, & - XUT,XVT,XWT,XPABST,XDRYMASST, & - XTHT, XRT, XTHM, XRCM, XPABSM,XTKET, XSVT,& - XLSUM,XLSVM,XLSWM, & - XLSTHM,XLSRVM,XLSZWSM, & - XLBXUM,XLBXVM,XLBXWM, & - XLBXTHM,XLBXRM,XLBXTKEM,XLBXSVM, & - XLBYUM,XLBYVM,XLBYWM, & - XLBYTHM,XLBYRM,XLBYTKEM,XLBYSVM ) -! -CALL SECOND_MNH2(ZTIME2) -! -XT_STEP_SWA = XT_STEP_SWA + ZTIME2 - ZTIME1 - XTIME_BU_PROCESS -! -!------------------------------------------------------------------------------- -! -!* 24.1 BALLOON and AIRCRAFT -! -------------------- -! -ZTIME1 = ZTIME2 -! -IF (LFLYER) & - CALL AIRCRAFT_BALLOON(XTSTEP, & - XXHAT, XYHAT, XZZ, XMAP, XLONORI, XLATORI, & - XUT, XVT, XWT, XPABST, XTHT, XRT, XSVT, XTKET, XTSRAD, & - XRHODREF,XCIT,PSEA=ZSEA(:,:)) - - -!------------------------------------------------------------------------------- -! -!* 24.2 STATION (observation diagnostic) -! -------------------------------- -! -IF (LSTATION) & - CALL STATION_n(XTSTEP, & - XXHAT, XYHAT, XZZ, & - XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, XTSRAD, XPABST ) -! -!--------------------------------------------------------- -! -!* 24.3 PROFILER (observation diagnostic) -! --------------------------------- -! -IF (LPROFILER) & - CALL PROFILER_n(XTSTEP, & - XXHAT, XYHAT, XZZ,XRHODREF, & - XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, XTSRAD, XPABST, & - XAER, XCLDFR, XCIT,PSEA=ZSEA(:,:)) -! -IF (ALLOCATED(ZSEA)) DEALLOCATE (ZSEA) -! -CALL SECOND_MNH2(ZTIME2) -! -XT_STEP_MISC = XT_STEP_MISC + ZTIME2 - ZTIME1 -! -!------------------------------------------------------------------------------- -! -!* 24.4 deallocation of observation diagnostics -! --------------------------------------- -! -CALL END_DIAG_IN_RUN -! -!------------------------------------------------------------------------------- -! -! -!* 25. STORAGE OF BUDGET FIELDS -! ------------------------ -! -ZTIME1 = ZTIME2 -! -IF ( .NOT. LIO_NO_WRITE ) THEN - IF (NBUMOD==IMI .AND. CBUTYPE/='NONE') THEN - CALL ENDSTEP_BUDGET(TDIAFILE,KTCOUNT,TDTCUR,XTSTEP,NSV) - END IF -END IF -! -CALL SECOND_MNH2(ZTIME2) -! -XT_STEP_BUD = XT_STEP_BUD + ZTIME2 - ZTIME1 + XTIME_BU -! -!------------------------------------------------------------------------------- -! -!* 26. FM FILE CLOSURE -! --------------- -! -IF ( tzbakfile%lopened ) THEN - CALL IO_File_close(TZBAKFILE) -END IF -! -!------------------------------------------------------------------------------- -! -!* 27. CURRENT TIME REFRESH -! -------------------- -! -TDTCUR%xtime=TDTCUR%xtime + XTSTEP -CALL DATETIME_CORRECTDATE(TDTCUR) -! -!------------------------------------------------------------------------------- -! -!* 28. CPU ANALYSIS -! ------------ -! -CALL SECOND_MNH2(ZTIME2) -XT_START=XT_START+ZTIME2-ZEND -! -! -IF ( KTCOUNT == NSTOP .AND. IMI==1) THEN - OEXIT=.TRUE. -END IF -! -IF (OEXIT) THEN -! - IF ( .NOT. LIO_NO_WRITE ) THEN - IF (LSERIES) CALL WRITE_SERIES_n(TDIAFILE) - CALL WRITE_AIRCRAFT_BALLOON(TDIAFILE) - CALL WRITE_STATION_n(TDIAFILE) - CALL WRITE_PROFILER_n(TDIAFILE) - call Write_les_n( tdiafile ) -#ifdef MNH_IOLFI - CALL MENU_DIACHRO(TDIAFILE,'END') -#endif - CALL IO_File_close(TDIAFILE) - END IF - ! - CALL IO_File_close(TINIFILE) - IF (CSURF=="EXTE") CALL IO_File_close(TINIFILEPGD) -! -!* 28.1 print statistics! -! - ! Set File Timing OUTPUT - ! - CALL SET_ILUOUT_TIMING(TLUOUT) - ! - ! Compute global time - ! - CALL TIME_STAT_ll(XT_START,ZTOT) - ! - CALL TIME_HEADER_ll(IMI) - ! - CALL TIME_STAT_ll(XT_1WAY,ZTOT, ' ONE WAY','=') - CALL TIME_STAT_ll(XT_BOUND,ZTOT, ' BOUNDARIES','=') - CALL TIME_STAT_ll(XT_STORE,ZTOT, ' STORE-FIELDS','=') - CALL TIME_STAT_ll(TIMEZ%T_WRIT3D_SEND,ZTOT, ' W3D_SEND ','-') - CALL TIME_STAT_ll(TIMEZ%T_WRIT3D_RECV,ZTOT, ' W3D_RECV ','-') - CALL TIME_STAT_ll(TIMEZ%T_WRIT3D_WRIT,ZTOT, ' W3D_WRIT ','-') - CALL TIME_STAT_ll(TIMEZ%T_WRIT3D_WAIT,ZTOT, ' W3D_WAIT ','-') - CALL TIME_STAT_ll(TIMEZ%T_WRIT3D_ALL ,ZTOT, ' W3D_ALL ','-') - CALL TIME_STAT_ll(TIMEZ%T_WRIT2D_GATH,ZTOT, ' W2D_GATH ','-') - CALL TIME_STAT_ll(TIMEZ%T_WRIT2D_WRIT,ZTOT, ' W2D_WRIT ','-') - CALL TIME_STAT_ll(TIMEZ%T_WRIT2D_ALL ,ZTOT, ' W2D_ALL ','-') - CALL TIME_STAT_ll(XT_GUESS,ZTOT, ' INITIAL_GUESS','=') - CALL TIME_STAT_ll(XT_2WAY,ZTOT, ' TWO WAY','=') - CALL TIME_STAT_ll(XT_ADV,ZTOT, ' ADVECTION MET','=') - CALL TIME_STAT_ll(XT_ADVUVW,ZTOT, ' ADVECTION UVW','=') - CALL TIME_STAT_ll(XT_GRAV,ZTOT, ' GRAVITY','=') - CALL TIME_STAT_ll(XT_FORCING,ZTOT, ' FORCING','=') - CALL TIME_STAT_ll(XT_IBM_FORC,ZTOT, ' IBM','=') - CALL TIME_STAT_ll(XT_NUDGING,ZTOT, ' NUDGING','=') - CALL TIME_STAT_ll(XT_SOURCES,ZTOT, ' DYN_SOURCES','=') - CALL TIME_STAT_ll(XT_DIFF,ZTOT, ' NUM_DIFF','=') - CALL TIME_STAT_ll(XT_RELAX,ZTOT, ' RELAXATION','=') - ! - CALL TIMING_LEGEND() - ! - CALL TIME_STAT_ll(XT_PARAM,ZTOT, ' PHYS_PARAM','=') - CALL TIME_STAT_ll(XT_RAD,ZTOT, ' RAD = '//CRAD ,'-') - CALL TIME_STAT_ll(XT_SHADOWS,ZTOT, ' SHADOWS' ,'-') - CALL TIME_STAT_ll(XT_DCONV,ZTOT, ' DEEP CONV = '//CDCONV,'-') - CALL TIME_STAT_ll(XT_GROUND,ZTOT, ' GROUND' ,'-') - CALL TIME_STAT_ll(XT_TURB,ZTOT, ' TURB = '//CTURB ,'-') - CALL TIME_STAT_ll(XT_MAFL,ZTOT, ' MAFL = '//CSCONV,'-') - CALL TIME_STAT_ll(XT_CHEM,ZTOT, ' CHIMIE' ,'-') - CALL TIME_STAT_ll(XT_EOL,ZTOT, ' WIND TURBINE' ,'-') - CALL TIMING_LEGEND() - CALL TIME_STAT_ll(XT_COUPL,ZTOT, ' SET_COUPLING','=') - CALL TIME_STAT_ll(XT_RAD_BOUND,ZTOT, ' RAD_BOUND','=') - ! - CALL TIMING_LEGEND() - ! - CALL TIME_STAT_ll(XT_PRESS,ZTOT, ' PRESSURE ','=','F') - !JUAN Z_SPLITTING - CALL TIME_STAT_ll(TIMEZ%T_MAP_B_SX_YP2_ZP1,ZTOT, ' REMAP B=>FFTXZ' ,'-','F') - CALL TIME_STAT_ll(TIMEZ%T_MAP_SX_YP2_ZP1_SXP2_Y_ZP1,ZTOT, ' REMAP FFTXZ=>FFTYZ' ,'-','F') - CALL TIME_STAT_ll(TIMEZ%T_MAP_SXP2_Y_ZP1_B,ZTOT, ' REMAP FTTYZ=>B' ,'-','F') - CALL TIME_STAT_ll(TIMEZ%T_MAP_SXP2_Y_ZP1_SXP2_YP1_Z,ZTOT, ' REMAP FFTYZ=>SUBZ' ,'-','F') - CALL TIME_STAT_ll(TIMEZ%T_MAP_B_SXP2_Y_ZP1,ZTOT, ' REMAP B=>FFTYZ-1','-','F') - CALL TIME_STAT_ll(TIMEZ%T_MAP_SXP2_YP1_Z_SXP2_Y_ZP1,ZTOT, ' REMAP SUBZ=>FFTYZ-1','-','F') - CALL TIME_STAT_ll(TIMEZ%T_MAP_SXP2_Y_ZP1_SX_YP2_ZP1,ZTOT, ' REMAP FFTYZ-1=>FFTXZ-1','-','F') - CALL TIME_STAT_ll(TIMEZ%T_MAP_SX_YP2_ZP1_B,ZTOT, ' REMAP FFTXZ-1=>B ' ,'-','F') - ! JUAN P1/P2 - CALL TIME_STAT_ll(XT_CLOUD,ZTOT, ' RESOLVED_CLOUD','=') - CALL TIME_STAT_ll(XT_ELEC,ZTOT, ' RESOLVED_ELEC','=') - CALL TIME_STAT_ll(XT_HALO,ZTOT, ' EXCHANGE_HALO','=') - CALL TIME_STAT_ll(XT_STEP_SWA,ZTOT, ' ENDSTEP','=') - CALL TIME_STAT_ll(XT_STEP_BUD,ZTOT, ' BUDGETS','=') - CALL TIME_STAT_ll(XT_SPECTRA,ZTOT, ' LES','=') - CALL TIME_STAT_ll(XT_STEP_MISC,ZTOT, ' MISCELLANEOUS','=') - IF (LIBM) CALL TIME_STAT_ll(XT_IBM_FORC,ZTOT,' IBM FORCING','=') - ! - ! sum of call subroutine - ! - ZALL = XT_1WAY + XT_BOUND + XT_STORE + XT_GUESS + XT_2WAY + & - XT_ADV + XT_FORCING + XT_NUDGING + XT_SOURCES + XT_DIFF + & - XT_ADVUVW + XT_GRAV + XT_IBM_FORC + & - XT_RELAX+ XT_PARAM + XT_COUPL + XT_RAD_BOUND+XT_PRESS + & - XT_CLOUD+ XT_ELEC + XT_HALO + XT_SPECTRA + XT_STEP_SWA + & - XT_STEP_MISC+ XT_STEP_BUD - CALL TIME_STAT_ll(ZALL,ZTOT, ' SUM(CALL)','=') - CALL TIMING_SEPARATOR('=') - ! - ! Gobale Stat - ! - WRITE(ILUOUT,FMT=*) - WRITE(ILUOUT,FMT=*) - CALL TIMING_LEGEND() - ! - ! MODELN all included - ! - CALL TIMING_SEPARATOR('+') - CALL TIMING_SEPARATOR('+') - WRITE(YMI,FMT="(I0)") IMI - CALL TIME_STAT_ll(XT_START,ZTOT, ' MODEL'//YMI,'+') - CALL TIMING_SEPARATOR('+') - CALL TIMING_SEPARATOR('+') - CALL TIMING_SEPARATOR('+') - ! - ! Timing/ Steps - ! - ZTIME_STEP = XT_START / REAL(KTCOUNT) - WRITE(YTCOUNT,FMT="(I0)") KTCOUNT - CALL TIME_STAT_ll(ZTIME_STEP,ZTOT, ' SECOND/STEP='//YTCOUNT,'=') - ! - ! Timing/Step/Points - ! - IPOINTS = NIMAX_ll*NJMAX_ll*NKMAX - WRITE(YPOINTS,FMT="(I0)") IPOINTS - ZTIME_STEP_PTS = ZTIME_STEP / REAL(IPOINTS) * 1e6 - CALL TIME_STAT_ll(ZTIME_STEP_PTS,ZTOT_PT) - CALL TIME_STAT_ll(ZTIME_STEP_PTS,ZTOT_PT, ' MICROSEC/STP/PT='//YPOINTS,'-') - ! - CALL TIMING_SEPARATOR('=') - ! -END IF -! -END SUBROUTINE MODEL_n diff --git a/src/ICCARE_BASE/modn_ch_orilam.f90 b/src/ICCARE_BASE/modn_ch_orilam.f90 deleted file mode 100644 index 5fad03c52..000000000 --- a/src/ICCARE_BASE/modn_ch_orilam.f90 +++ /dev/null @@ -1,55 +0,0 @@ -!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence -!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!ORILAM_LIC for details. -!----------------------------------------------------------------- -!--------------- special set of characters for RCS information -!----------------------------------------------------------------- -! $Source$ $Revision$ -! MASDEV4_7 modn 2006/10/18 12:10:16 -!----------------------------------------------------------------- -!! ##################### - MODULE MODN_CH_ORILAM -!! ##################### -!! -!! PURPOSE -!! ------- -!! Namelist for ORILAM aerosol scheme parameters -!! -!! AUTHOR -!! ------ -!! P. Tulet *CNRM* -!! -!! MODIFICATIONS -!! ------------- -!! Original 24/02/2005 -!! -!----------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ----------------- -! -USE MODD_CH_AEROSOL, ONLY: LORILAM, XN0IMIN, XN0JMIN, LSEDIMAERO, LAERINIT, & - LHETEROSO4, CNUCLEATION, LCONDENSATION, LMODE_MERGING, & - XRADIUS_NUCL, XSIGMA_NUCL, & - LCOAGULATION, XINISIGI, XINISIGJ, & - XINIRADIUSI, XINIRADIUSJ, LVARSIGI, & - LVARSIGJ, CMINERAL, CORGANIC, & - XSIGIMIN, XSIGIMAX,XSIGJMIN, XSIGJMAX, & - XCOEFRADIMAX, XCOEFRADIMIN, XCOEFRADJMAX, XCOEFRADJMIN, & - CRGUNIT, LRGFIX, LDEPOS_AER -! -IMPLICIT NONE -! -NAMELIST /NAM_CH_ORILAM/ LORILAM, XN0IMIN, XN0JMIN, LSEDIMAERO, LAERINIT, & - LHETEROSO4, CNUCLEATION, LCONDENSATION, LMODE_MERGING, & - XRADIUS_NUCL, XSIGMA_NUCL, & - LCOAGULATION, XINISIGI, XINISIGJ, & - XINIRADIUSI, XINIRADIUSJ, LVARSIGI, & - LVARSIGJ, CMINERAL, CORGANIC, & - XSIGIMIN, XSIGIMAX,XSIGJMIN, XSIGJMAX, & - XCOEFRADIMAX, XCOEFRADIMIN, XCOEFRADJMAX, XCOEFRADJMIN, & - CRGUNIT, LRGFIX, LDEPOS_AER - -! -END MODULE MODN_CH_ORILAM diff --git a/src/ICCARE_BASE/modn_param_lima.f90 b/src/ICCARE_BASE/modn_param_lima.f90 deleted file mode 100644 index c42f00675..000000000 --- a/src/ICCARE_BASE/modn_param_lima.f90 +++ /dev/null @@ -1,36 +0,0 @@ -!MNH_LIC Copyright 2001-2021 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!------------------------------------------------------------------------------- -! ###################### - MODULE MODN_PARAM_LIMA -! ###################### -! -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_PARAM_LIMA -! -IMPLICIT NONE -! -! -NAMELIST/NAM_PARAM_LIMA/LCOLD, LNUCL, LSEDI, LSNOW, LHAIL, LHHONI, LMEYERS,& - NMOD_IFN, XIFN_CONC, LIFN_HOM, & - CIFN_SPECIES, CINT_MIXING, NMOD_IMM, NIND_SPECIE, & - CPRISTINE_ICE_LIMA, CHEVRIMED_ICE_LIMA, & - XALPHAI, XNUI, XALPHAS, XNUS, XALPHAG, XNUG, & - XFACTNUC_DEP, XFACTNUC_CON, NPHILLIPS, & - LCIBU, XNDEBRIS_CIBU, LRDSF, & - LWARM, LACTI, LRAIN, LSEDC, LACTIT, LBOUND, LSPRO, & - LADJ, & - NMOD_CCN, XCCN_CONC, & - LCCN_HOM, CCCN_MODES, HINI_CCN, HTYPE_CCN, & - XALPHAC, XNUC, XALPHAR, XNUR, & - XFSOLUB_CCN, XACTEMP_CCN, XAERDIFF, XAERHEIGHT, & - LSCAV, LAERO_MASS, LDEPOC, XVDEPOC, LACTTKE, & - LPTSPLIT, LFEEDBACKT, NMAXITER, XMRSTEP, XTSTEP_TS -! -END MODULE MODN_PARAM_LIMA diff --git a/src/ICCARE_BASE/modn_surf_atmn.F90 b/src/ICCARE_BASE/modn_surf_atmn.F90 deleted file mode 100644 index f5e3ff9ab..000000000 --- a/src/ICCARE_BASE/modn_surf_atmn.F90 +++ /dev/null @@ -1,270 +0,0 @@ -!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -! ######spl - MODULE MODN_SURF_ATM_n -! ###################### -! -!!**** *MODN_SURF_ATM_n* - declaration of namelist NAM_SURF_ATMn -!! -!! PURPOSE -!! ------- -! The purpose of this module is to specify the namelist NAM_SURF_ATMn -! -!! -!!** IMPLICIT ARGUMENTS -!! ------------------ -!! -!! REFERENCE -!! --------- -!! -!! -!! AUTHOR -!! ------ -!! V. Masson *Meteo France* -!! -!! MODIFICATIONS -!! ------------- -!! P. Tulet flag namelist for emission 02/2004 -!! B. Decharme Cumulative diag for all Tile 08/2009 -!! B. Decharme Key to allow (or not) writting diag 10/2009 -!! S.Senesi Additional write selection mechanism 12/2009 -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! - -! -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -IMPLICIT NONE -! -CHARACTER(LEN=28), SAVE :: CCHEM_SURF_FILE -LOGICAL, SAVE :: LCH_EMIS, LCH_DMSEMIS, LCH_SURF_EMIS -LOGICAL :: LFRAC -REAL :: XDIAG_TSTEP -INTEGER :: N2M -LOGICAL :: LT2MMW -LOGICAL :: L2M_MIN_ZS -LOGICAL :: LSURF_BUDGET -LOGICAL :: LRAD_BUDGET -LOGICAL :: LSURF_BUDGETC -LOGICAL :: LRESET_BUDGETC -LOGICAL :: LCOEF -LOGICAL :: LSURF_VARS -LOGICAL :: LDIAG_GRID -LOGICAL :: LPROVAR_TO_DIAG -LOGICAL :: LSELECT -LOGICAL :: LSNOWDIMNC -LOGICAL :: LRESETCUMUL -CHARACTER(LEN=LEN_HREC), DIMENSION(4000) :: CSELECT -! -NAMELIST/NAM_CH_CONTROLn/CCHEM_SURF_FILE -NAMELIST/NAM_CH_SURFn/LCH_EMIS, LCH_DMSEMIS, LCH_SURF_EMIS -NAMELIST/NAM_DIAG_SURF_ATMn/LFRAC, LDIAG_GRID, LT2MMW -NAMELIST/NAM_DIAG_SURFn/N2M, L2M_MIN_ZS, LSURF_BUDGET, LRAD_BUDGET, LSURF_BUDGETC, & - LRESET_BUDGETC, LCOEF, LSURF_VARS -! -NAMELIST/NAM_WRITE_DIAG_SURFn/LPROVAR_TO_DIAG,LSNOWDIMNC,LRESETCUMUL,LSELECT,CSELECT -! -CONTAINS -! -SUBROUTINE INIT_NAM_CH_CONTROLn (CHU) -! - USE MODD_CH_SURF_n, ONLY : CH_SURF_t -! - IMPLICIT NONE - -! - TYPE(CH_SURF_t), INTENT(INOUT) :: CHU - REAL(KIND=JPRB) :: ZHOOK_HANDLE - - IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:INIT_NAM_CH_CONTROLN',0,ZHOOK_HANDLE) - CCHEM_SURF_FILE = CHU%CCHEM_SURF_FILE -IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:INIT_NAM_CH_CONTROLN',1,ZHOOK_HANDLE) -END SUBROUTINE INIT_NAM_CH_CONTROLn - -SUBROUTINE UPDATE_NAM_CH_CONTROLn (CHU) -! - USE MODD_CH_SURF_n, ONLY : CH_SURF_t -! - IMPLICIT NONE - -! - TYPE(CH_SURF_t), INTENT(INOUT) :: CHU - REAL(KIND=JPRB) :: ZHOOK_HANDLE - - IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:UPDATE_NAM_CH_CONTROLN',0,ZHOOK_HANDLE) - CHU%CCHEM_SURF_FILE = CCHEM_SURF_FILE -IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:UPDATE_NAM_CH_CONTROLN',1,ZHOOK_HANDLE) -END SUBROUTINE UPDATE_NAM_CH_CONTROLn - -SUBROUTINE INIT_NAM_CH_SURFn (CHU) -! - USE MODD_CH_SURF_n, ONLY : CH_SURF_t -! - IMPLICIT NONE - -! - TYPE(CH_SURF_t), INTENT(INOUT) :: CHU - REAL(KIND=JPRB) :: ZHOOK_HANDLE - - IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:INIT_NAM_CH_SURFN',0,ZHOOK_HANDLE) - LCH_EMIS = CHU%LCH_EMIS - LCH_SURF_EMIS = CHU%LCH_SURF_EMIS - LCH_DMSEMIS = CHU%LCH_DMSEMIS -IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:INIT_NAM_CH_SURFN',1,ZHOOK_HANDLE) -END SUBROUTINE INIT_NAM_CH_SURFn - -SUBROUTINE UPDATE_NAM_CH_SURFn (CHU) -! - USE MODD_CH_SURF_n, ONLY : CH_SURF_t -! - IMPLICIT NONE - -! - TYPE(CH_SURF_t), INTENT(INOUT) :: CHU - REAL(KIND=JPRB) :: ZHOOK_HANDLE - - IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:UPDATE_NAM_CH_SURFN',0,ZHOOK_HANDLE) - CHU%LCH_EMIS = LCH_EMIS - CHU%LCH_SURF_EMIS = LCH_SURF_EMIS - CHU%LCH_DMSEMIS = LCH_DMSEMIS -IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:UPDATE_NAM_CH_SURFN',1,ZHOOK_HANDLE) -END SUBROUTINE UPDATE_NAM_CH_SURFn - -SUBROUTINE INIT_NAM_DIAG_SURF_ATMn (DGO) -! - USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t -! - IMPLICIT NONE - -! - TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO - REAL(KIND=JPRB) :: ZHOOK_HANDLE - - IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:INIT_NAM_DIAG_SURF_ATMN',0,ZHOOK_HANDLE) - LFRAC = DGO%LFRAC - LT2MMW = DGO%LT2MMW -IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:INIT_NAM_DIAG_SURF_ATMN',1,ZHOOK_HANDLE) -END SUBROUTINE INIT_NAM_DIAG_SURF_ATMn - -SUBROUTINE UPDATE_NAM_DIAG_SURF_ATMn (DGO) -! - USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t -! - IMPLICIT NONE - -! - TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO - REAL(KIND=JPRB) :: ZHOOK_HANDLE - - IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:UPDATE_NAM_DIAG_SURF_ATMN',0,ZHOOK_HANDLE) - DGO%LFRAC = LFRAC - DGO%LT2MMW = LT2MMW -IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:UPDATE_NAM_DIAG_SURF_ATMN',1,ZHOOK_HANDLE) -END SUBROUTINE UPDATE_NAM_DIAG_SURF_ATMn - -SUBROUTINE INIT_NAM_DIAG_SURFn (DGO) -! - USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t -! - IMPLICIT NONE - -! - TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO - REAL(KIND=JPRB) :: ZHOOK_HANDLE - - IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:INIT_NAM_DIAG_SURFN',0,ZHOOK_HANDLE) - XDIAG_TSTEP = DGO%XDIAG_TSTEP - N2M = DGO%N2M - L2M_MIN_ZS = DGO%L2M_MIN_ZS - LSURF_BUDGET = DGO%LSURF_BUDGET - LRAD_BUDGET = DGO%LRAD_BUDGET - LSURF_BUDGETC = DGO%LSURF_BUDGETC - LRESET_BUDGETC = DGO%LRESET_BUDGETC - LCOEF = DGO%LCOEF - LSURF_VARS = DGO%LSURF_VARS - LDIAG_GRID = DGO%LDIAG_GRID -IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:INIT_NAM_DIAG_SURFN',1,ZHOOK_HANDLE) -END SUBROUTINE INIT_NAM_DIAG_SURFn - -SUBROUTINE UPDATE_NAM_DIAG_SURFn (DGO) -! - USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t -! - IMPLICIT NONE - -! - TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO - REAL(KIND=JPRB) :: ZHOOK_HANDLE - - IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:UPDATE_NAM_DIAG_SURFN',0,ZHOOK_HANDLE) - DGO%XDIAG_TSTEP = XDIAG_TSTEP - DGO%N2M = N2M - DGO%L2M_MIN_ZS = L2M_MIN_ZS - DGO%LSURF_BUDGET = LSURF_BUDGET - DGO%LRAD_BUDGET = LRAD_BUDGET - DGO%LSURF_BUDGETC = LSURF_BUDGETC - DGO%LRESET_BUDGETC = LRESET_BUDGETC - DGO%LCOEF = LCOEF - DGO%LSURF_VARS = LSURF_VARS - DGO%LDIAG_GRID = LDIAG_GRID -IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:UPDATE_NAM_DIAG_SURFN',1,ZHOOK_HANDLE) -END SUBROUTINE UPDATE_NAM_DIAG_SURFn - - -SUBROUTINE INIT_NAM_WRITE_DIAG_SURFn (DGO) -! - USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t -! - IMPLICIT NONE - - -! - TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO - REAL(KIND=JPRB) :: ZHOOK_HANDLE - - IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:INIT_NAM_WRITE_DIAG_SURFN',0,ZHOOK_HANDLE) - LPROVAR_TO_DIAG = DGO%LPROVAR_TO_DIAG - LSNOWDIMNC = DGO%LSNOWDIMNC - LRESETCUMUL = DGO%LRESETCUMUL - LSELECT = DGO%LSELECT - CSELECT(:) = ' ' -IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:INIT_NAM_WRITE_DIAG_SURFN',1,ZHOOK_HANDLE) -END SUBROUTINE INIT_NAM_WRITE_DIAG_SURFn - -SUBROUTINE UPDATE_NAM_WRITE_DIAG_SURFn (DGO) -! - USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t -! - IMPLICIT NONE -! - TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO - INTEGER :: ICOUNT - REAL(KIND=JPRB) :: ZHOOK_HANDLE - - IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:UPDATE_NAM_WRITE_DIAG_SURFN',0,ZHOOK_HANDLE) - DGO%LPROVAR_TO_DIAG = LPROVAR_TO_DIAG - DGO%LSNOWDIMNC = LSNOWDIMNC - DGO%LRESETCUMUL = LRESETCUMUL -! - DGO%LSELECT = LSELECT - IF (LSELECT) THEN - ICOUNT = COUNT(CSELECT /= ' ') - IF(.NOT.ASSOCIATED(DGO%CSELECT))THEN - ALLOCATE(DGO%CSELECT(ICOUNT+1)) - DGO%CSELECT(:) = ' ' - ENDIF - DGO%CSELECT(1:ICOUNT) = CSELECT(1:ICOUNT) - ELSE - IF (.NOT.ASSOCIATED(DGO%CSELECT)) ALLOCATE(DGO%CSELECT(0)) - ENDIF -IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:UPDATE_NAM_WRITE_DIAG_SURFN',1,ZHOOK_HANDLE) -END SUBROUTINE UPDATE_NAM_WRITE_DIAG_SURFn - -END MODULE MODN_SURF_ATM_n diff --git a/src/ICCARE_BASE/pgd_dms.F90 b/src/ICCARE_BASE/pgd_dms.F90 deleted file mode 100644 index e9f1dd56d..000000000 --- a/src/ICCARE_BASE/pgd_dms.F90 +++ /dev/null @@ -1,197 +0,0 @@ -!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -! ######### - SUBROUTINE PGD_DMS(DTCO, UG, U, USS, DSF, HPROGRAM, OCH_DMSEMIS) -! ############################################################## -! -!!**** *PGD_DMS* monitor for averaging and interpolations of physiographic fields -!! -!! PURPOSE -!! ------- -!! -!! METHOD -!! ------ -!! -! -!! EXTERNAL -!! -------- -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! REFERENCE -!! --------- -!! -!! AUTHOR -!! ------ -!! -!! P. Tulet *LAERO* -!! -!! MODIFICATION -!! ------------ -!! -!! -!---------------------------------------------------------------------------- -! -!* 0. DECLARATION -! ----------- -! -USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t -USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t -USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t -USE MODD_SSO_n, ONLY : SSO_t -USE MODD_DMS_SURF_FIELDS_n,ONLY : DMS_SURF_FIELDS_t -! -USE MODD_PGD_GRID, ONLY : NL -USE MODD_PGDWORK, ONLY : CATYPE -USE MODD_SURF_PAR, ONLY : XUNDEF -! -USE MODI_GET_LUOUT -USE MODI_PGD_FIELD -USE MODI_READ_NAM_PGD_DMS -USE MODI_UNPACK_SAME_RANK -USE MODI_GET_SURF_SIZE_n -USE MODI_GET_SURF_MASK_n -! -USE MODE_POS_SURF -! -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -IMPLICIT NONE -! -!* 0.1 Declaration of arguments -! ------------------------ -! -TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO -TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG -TYPE(SURF_ATM_t), INTENT(INOUT) :: U -TYPE(SSO_t), INTENT(INOUT) :: USS -TYPE(DMS_SURF_FIELDS_t), INTENT(INOUT) :: DSF -! -CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program -LOGICAL, INTENT(OUT) :: OCH_DMSEMIS ! emission flag - -! -! -!* 0.2 Declaration of local variables -! ------------------------------ -! -INTEGER :: ILUOUT ! output listing logical unit -INTEGER :: JNBR ! loop counter on dummy fields -INTEGER :: ILU, IL_SEA, IL_LAND, IL -! -!* 0.3 Declaration of namelists -! ------------------------ -! -INTEGER :: IDMS_NBR -CHARACTER(LEN=20), DIMENSION(1000) :: YDMS_NAME -CHARACTER(LEN=3), DIMENSION(1000) :: YDMS_AREA -CHARACTER(LEN=3), DIMENSION(1000) :: CDMS_ATYPE ! avg type for dummy pgd fields -! ! 'ARI' , 'INV' -CHARACTER(LEN=28), DIMENSION(1000) :: CDMS_FILE ! data files -CHARACTER(LEN=6), DIMENSION(1000) :: CDMS_FILETYPE ! type of these files -REAL, DIMENSION(:), ALLOCATABLE :: ZDMS_FIELD, ZDMS_FIELDS -INTEGER, DIMENSION(:), ALLOCATABLE :: IMASK -CHARACTER(LEN=6) :: YMASK -REAL(KIND=JPRB) :: ZHOOK_HANDLE -! -!------------------------------------------------------------------------------- -! -!* 1. Initializations of defaults -! --------------------------- -! -IF (LHOOK) CALL DR_HOOK('PGD_DMS',0,ZHOOK_HANDLE) - CALL GET_LUOUT(HPROGRAM,ILUOUT) -! -!------------------------------------------------------------------------------- -! -!* 2. Reading of namelist -! ------------------- -! - CALL READ_NAM_PGD_DMS(HPROGRAM, IDMS_NBR, YDMS_NAME, YDMS_AREA, & - CDMS_ATYPE, CDMS_FILE, CDMS_FILETYPE ) -! -DSF%NDMS_NBR = IDMS_NBR -! -ALLOCATE(DSF%CDMS_NAME(DSF%NDMS_NBR)) -ALLOCATE(DSF%CDMS_AREA(DSF%NDMS_NBR)) -DSF%CDMS_NAME(:) = YDMS_NAME(1:DSF%NDMS_NBR) -DSF%CDMS_AREA(:) = YDMS_AREA(1:DSF%NDMS_NBR) -! -!------------------------------------------------------------------------------- -! -!* 3. Allocation -! ---------- -! -ALLOCATE(DSF%XDMS_FIELDS(NL,DSF%NDMS_NBR)) - CALL GET_SURF_SIZE_n(DTCO, U,'LAND', IL_LAND) - CALL GET_SURF_SIZE_n(DTCO, U,'SEA ',IL_SEA) -! -ALLOCATE(ZDMS_FIELDS (NL)) -! -!------------------------------------------------------------------------------- -OCH_DMSEMIS = DSF%NDMS_NBR > 0 -!------------------------------------------------------------------------------- -! -! -!* 4. Computations -! ------------ -! -DO JNBR=1,DSF%NDMS_NBR - - CATYPE = CDMS_ATYPE(JNBR) - SELECT CASE (DSF%CDMS_AREA(JNBR)) - CASE ('LAN') - IL = IL_LAND - YMASK='LAND ' - CASE ('SEA') - IL = IL_SEA - YMASK='SEA ' - CASE ('ALL') - IL = NL - YMASK='FULL ' - CASE DEFAULT - CALL ABOR1_SFX('PGD_DMS (1): DMS AREA NOT SUPPORTED') - END SELECT - ALLOCATE(ZDMS_FIELD (IL)) - ALLOCATE(IMASK(IL)) -! - CALL PGD_FIELD(DTCO, UG, U, USS, & - HPROGRAM,DSF%CDMS_NAME(JNBR),DSF%CDMS_AREA(JNBR),CDMS_FILE(JNBR), & - CDMS_FILETYPE(JNBR),XUNDEF,ZDMS_FIELD(:) ) - CATYPE = 'ARI' -! -!* 4.2 Expends field on all surface points - ILU=0 - CALL GET_SURF_MASK_n(DTCO, U, & - YMASK,IL,IMASK,ILU,ILUOUT) - CALL UNPACK_SAME_RANK(IMASK,ZDMS_FIELD(:),ZDMS_FIELDS(:)) - DEALLOCATE(ZDMS_FIELD) - DEALLOCATE(IMASK) -! -!* 4.3 Weights field on all surface points -! (zero weight where field is not defined) - SELECT CASE (DSF%CDMS_AREA(JNBR)) - CASE ('LAN') - DSF%XDMS_FIELDS(:,JNBR) = (U%XNATURE(:)+U%XTOWN(:))*ZDMS_FIELDS(:) - CASE ('SEA') - DSF%XDMS_FIELDS(:,JNBR) = U%XSEA*ZDMS_FIELDS(:) - CASE ('ALL') - DSF%XDMS_FIELDS(:,JNBR) = ZDMS_FIELDS(:) - CASE DEFAULT - CALL ABOR1_SFX('PGD_DMS (2): DMS AREA NOT SUPPORTED') - END SELECT - -END DO - -DEALLOCATE(ZDMS_FIELDS) - -IF (LHOOK) CALL DR_HOOK('PGD_DMS',1,ZHOOK_HANDLE) -! -!------------------------------------------------------------------------------- -! -END SUBROUTINE PGD_DMS diff --git a/src/ICCARE_BASE/pgd_surf_atm.F90 b/src/ICCARE_BASE/pgd_surf_atm.F90 deleted file mode 100644 index 98539d816..000000000 --- a/src/ICCARE_BASE/pgd_surf_atm.F90 +++ /dev/null @@ -1,257 +0,0 @@ -!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -! ########################################################### - SUBROUTINE PGD_SURF_ATM (YSC,HPROGRAM,HFILE,HFILETYPE,OZS) -! ########################################################### -!! -!! PURPOSE -!! ------- -!! This program prepares the physiographic data fields. -!! -!! METHOD -!! ------ -!! -!! EXTERNAL -!! -------- -!! -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! -!! REFERENCE -!! --------- -!! -!! AUTHOR -!! ------ -!! -!! V. Masson Meteo-France -!! -!! MODIFICATION -!! ------------ -!! -!! Original 13/10/03 -!! A. Lemonsu 05/2009 Ajout de la clef LGARDEN pour TEB -!! J. Escobar 11/2013 Add USE MODI_READ_NAM_PGD_CHEMISTRY -!! B. Decharme 02/2014 Add LRM_RIVER -!! M. Leriche 06/2017 Add MEGAN coupling -!---------------------------------------------------------------------------- -! -!* 0. DECLARATION -! ----------- -! -! -USE MODD_SURFEX_n, ONLY : SURFEX_t -! -USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO, NSIZE, NINDEX, NNUM -! -USE MODD_SURF_CONF, ONLY : CPROGNAME -USE MODD_PGD_GRID, ONLY : NL, LLATLONMASK, NGRID_PAR -! -USE MODI_GET_SIZE_FULL_n -USE MODI_GET_LUOUT -USE MODI_READ_PGD_ARRANGE_COVER -USE MODI_READ_PGD_COVER_GARDEN -USE MODI_INI_DATA_COVER -USE MODI_READ_PGD_SCHEMES -USE MODI_READ_NAM_PGD_CHEMISTRY -USE MODI_READ_NAM_WRITE_COVER_TEX -USE MODI_WRITE_COVER_TEX_START -USE MODI_WRITE_COVER_TEX_COVER -USE MODI_LATLON_GRID -USE MODI_PUT_PGD_GRID -USE MODI_LATLONMASK -USE MODI_PGD_FRAC -USE MODI_PGD_COVER -USE MODI_PGD_OROGRAPHY -USE MODI_PGD_NATURE -USE MODI_PGD_TOWN -USE MODI_PGD_INLAND_WATER -USE MODI_PGD_SEA -USE MODI_PGD_DUMMY -USE MODI_PGD_CHEMISTRY -USE MODI_PGD_CHEMISTRY_SNAP -USE MODI_WRITE_COVER_TEX_END -USE MODI_INIT_READ_DATA_COVER -USE MODI_PGD_MEGAN -USE MODI_PGD_DMS -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -IMPLICIT NONE -! -!* 0.1 Declaration of dummy arguments -! ------------------------------ -! -! -TYPE(SURFEX_t), INTENT(INOUT) :: YSC -! -CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling -CHARACTER(LEN=28), INTENT(IN) :: HFILE ! atmospheric file name -CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE! atmospheric file type -LOGICAL, INTENT(IN) :: OZS ! .true. if orography is imposed by atm. model -! -!* 0.2 Declaration of local variables -! ------------------------------ -! -LOGICAL :: LRM_RIVER !delete inland river coverage. Default is false -! -INTEGER :: ISIZE_FULL, JI, IDIM_FULL -INTEGER :: ILUOUT ! logical unit of output listing file -! -REAL(KIND=JPRB) :: ZHOOK_HANDLE -! -!------------------------------------------------------------------------------ -IF (LHOOK) CALL DR_HOOK('PGD_SURF_ATM',0,ZHOOK_HANDLE) -! -LRM_RIVER = .FALSE. -! -CPROGNAME=HPROGRAM -! - CALL GET_LUOUT(HPROGRAM,ILUOUT) -! -!* 1. Set default constant values -! --------------------------- -! -!* 1.2 surface schemes - CALL READ_PGD_SCHEMES(HPROGRAM, YSC%U%CNATURE, YSC%U%CSEA, YSC%U%CTOWN, YSC%U%CWATER) -! - CALL READ_NAM_WRITE_COVER_TEX(HPROGRAM) -! -!------------------------------------------------------------------------------- -! -!* 2. Grid -! ---- -! -ALLOCATE(YSC%UG%G%XLAT (YSC%U%NSIZE_FULL)) -ALLOCATE(YSC%UG%G%XLON (YSC%U%NSIZE_FULL)) -ALLOCATE(YSC%UG%G%XMESH_SIZE(YSC%U%NSIZE_FULL)) -ALLOCATE(YSC%UG%XJPDIR (YSC%U%NSIZE_FULL)) - CALL LATLON_GRID(YSC%UG%G, YSC%U%NSIZE_FULL, YSC%UG%XJPDIR) -! -! -!* 2.3 Stores the grid in the module MODD_PGD_GRID -! - CALL PUT_PGD_GRID(YSC%UG%G%CGRID, YSC%U%NSIZE_FULL,YSC%UG%G%NGRID_PAR, YSC%UG%G%XGRID_PAR) -! -IF (HPROGRAM=='MESONH') THEN - IDIM_FULL = YSC%U%NDIM_FULL - YSC%U%NDIM_FULL = NL - NSIZE = NL - ALLOCATE(NINDEX(NL)) - NINDEX(:) = 0 - ALLOCATE(NNUM(NL)) - DO JI = 1,NL - NNUM(JI) = JI - ENDDO -ENDIF -! -IF (.NOT.ASSOCIATED(YSC%UG%XGRID_FULL_PAR)) THEN - ALLOCATE(YSC%UG%XGRID_FULL_PAR(SIZE(YSC%UG%G%XGRID_PAR))) - YSC%UG%XGRID_FULL_PAR(:) = YSC%UG%G%XGRID_PAR(:) - YSC%UG%NGRID_FULL_PAR = NGRID_PAR -ENDIF -! -!* 2.4 mask to limit the number of input data to read - CALL LATLONMASK(YSC%UG%G%CGRID, YSC%UG%NGRID_FULL_PAR, YSC%UG%XGRID_FULL_PAR, LLATLONMASK) -! -!------------------------------------------------------------------------------- -! -!* 3. surface cover -! ------------- -! - CALL PGD_FRAC(YSC%DTCO, YSC%UG, YSC%U, YSC%USS, HPROGRAM) -! - CALL READ_PGD_ARRANGE_COVER(HPROGRAM, YSC%U%LWATER_TO_NATURE, YSC%U%LTOWN_TO_ROCK) -! - CALL READ_PGD_COVER_GARDEN(HPROGRAM, YSC%U%LGARDEN) -! - CALL INIT_READ_DATA_COVER(HPROGRAM) -! - CALL INI_DATA_COVER(YSC%DTCO, YSC%U) -IF (YSC%U%LECOCLIMAP) CALL PGD_COVER(YSC%DTCO, YSC%UG, YSC%U, YSC%USS, HPROGRAM,LRM_RIVER) -! -IF (NRANK==NPIO) THEN - CALL WRITE_COVER_TEX_START(HPROGRAM) - CALL WRITE_COVER_TEX_COVER -ENDIF -! -!------------------------------------------------------------------------------- -! -!* 4. Orography -! --------- -! - CALL PGD_OROGRAPHY(YSC%DTCO, YSC%UG, YSC%U, YSC%USS, HPROGRAM, HFILE, HFILETYPE, OZS) -! -!_______________________________________________________________________________ -! -!* 5. Additionnal fields for nature scheme -! ------------------------------------ -! -IF (YSC%U%NDIM_NATURE>0) CALL PGD_NATURE(YSC%DTCO, YSC%DTZ, YSC%IM, YSC%UG, YSC%U, YSC%USS, HPROGRAM) -!_______________________________________________________________________________ -! -!* 6. Additionnal fields for town scheme -! ---------------------------------- -! -IF (YSC%U%NDIM_TOWN>0) CALL PGD_TOWN(YSC%DTCO, YSC%UG, YSC%U, YSC%USS, & - YSC%IM%DTV, YSC%TM, YSC%GDM, YSC%GRM, HPROGRAM) -!_______________________________________________________________________________ -! -!* 7. Additionnal fields for inland water scheme -! ------------------------------------------ -! -IF (YSC%U%NDIM_WATER>0) CALL PGD_INLAND_WATER(YSC%DTCO, YSC%FM%G, YSC%FM%F, YSC%UG, YSC%U, & - YSC%USS, YSC%WM%G, YSC%WM%W, HPROGRAM,LRM_RIVER) -!_______________________________________________________________________________ -! -!* 8. Additionnal fields for sea scheme -! --------------------------------- -! -IF (YSC%U%NDIM_SEA>0) CALL PGD_SEA(YSC%DTCO, YSC%SM%DTS, YSC%SM%G, YSC%SM%S, & - YSC%UG, YSC%U, YSC%USS, HPROGRAM) -!_______________________________________________________________________________ -! -!* 9. Dummy fields -! ------------ -! - CALL PGD_DUMMY(YSC%DTCO, YSC%DUU, YSC%UG, YSC%U, YSC%USS, HPROGRAM) -!_______________________________________________________________________________ -! -!* 10. Chemical Emission fields -! ------------------------ -! - CALL READ_NAM_PGD_CHEMISTRY(HPROGRAM,YSC%CHU%CCH_EMIS,YSC%CHU%CCH_BIOEMIS,YSC%CHU%CCH_DMSEMIS) -IF (YSC%CHU%CCH_EMIS=='SNAP') THEN - CALL PGD_CHEMISTRY_SNAP(YSC%CHN, YSC%DTCO, YSC%UG, YSC%U, YSC%USS, & - HPROGRAM,YSC%CHU%LCH_EMIS) -ELSE IF (YSC%CHU%CCH_EMIS=='AGGR') THEN - CALL PGD_CHEMISTRY(YSC%CHE, YSC%DTCO, YSC%UG, YSC%U, YSC%USS, & - HPROGRAM,YSC%CHU%LCH_EMIS) -ENDIF -IF (YSC%CHU%CCH_BIOEMIS=='MEGA') THEN - CALL PGD_MEGAN(YSC%DTCO, YSC%UG, YSC%U, YSC%USS, YSC%IM%MSF, & - HPROGRAM,YSC%CHU%LCH_BIOEMIS) -ENDIF -IF (YSC%CHU%CCH_DMSEMIS=='DMSD') THEN - CALL PGD_DMS(YSC%DTCO, YSC%UG, YSC%U, YSC%USS, YSC%SM%DSF, & - HPROGRAM,YSC%CHU%LCH_DMSEMIS) -ENDIF -!_______________________________________________________________________________ -! -!* 11. Writing in cover latex file -! --------------------------- -! -IF (NRANK==NPIO) CALL WRITE_COVER_TEX_END(HPROGRAM) -! -IF (HPROGRAM=='MESONH') THEN - YSC%U%NDIM_FULL = IDIM_FULL -ENDIF -! -IF (LHOOK) CALL DR_HOOK('PGD_SURF_ATM',1,ZHOOK_HANDLE) -!_______________________________________________________________________________ -! -END SUBROUTINE PGD_SURF_ATM diff --git a/src/ICCARE_BASE/prep_ideal_case.f90 b/src/ICCARE_BASE/prep_ideal_case.f90 deleted file mode 100644 index 016f888a5..000000000 --- a/src/ICCARE_BASE/prep_ideal_case.f90 +++ /dev/null @@ -1,1948 +0,0 @@ -!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!----------------------------------------------------------------- -! ####################### - PROGRAM PREP_IDEAL_CASE -! ####################### -! -!!**** *PREP_IDEAL_CASE* - program to write an initial FM-file -!! -!! PURPOSE -!! ------- -! The purpose of this program is to prepare an initial meso-NH file -! (LFIFM and DESFM files) filled with some idealized fields. -! -! ---- The present version can provide two types of fields: -! -! 1) CIDEAL = 'CSTN' : 3D fields derived from a vertical profile with -! --------------- n levels of constant moist Brunt Vaisala frequency -! The vertical profile is read in EXPRE file. -! These fields can be used for model runs -! -! 2) CIDEAL = 'RSOU' : 3D fields derived from a radiosounding. -! --------------- -! The radiosounding is read in EXPRE file. -! The following kind of data is permitted : -! YKIND = 'STANDARD' : Zsol, Psol, Tsol, TDsol -! (Pressure, dd, ff) , -! (Pressure, T, Td) -! YKIND = 'PUVTHVMR' : zsol, Psol, Thvsol, Rsol -! (Pressure, U, V) , -! (Pressure, THv, R) -! YKIND = 'PUVTHVHU' : zsol, Psol, Thvsol, Husol -! (Pressure, U, V) , -! (Pressure, THv, Hu) -! YKIND = 'ZUVTHVHU' : zsol, Psol, Thvsol, Husol -! (height, U, V) , -! (height, THv, Hu) -! YKIND = 'ZUVTHVMR' : zsol, Psol, Thvsol, Rsol -! (height, U, V) , -! (height, THv, R) -! YKIND = 'PUVTHDMR' : zsol, Psol, Thdsol, Rsol -! (Pressure, U, V) , -! (Pressure, THd, R) -! YKIND = 'PUVTHDHU' : zsol, Psol, Thdsol, Husol -! (Pressure, U, V) , -! (Pressure, THd, Hu) -! YKIND = 'ZUVTHDMR' : zsol, Psol, Thdsol, Rsol -! (height, U, V) , -! (height, THd, R) -! YKIND = 'ZUVTHLMR' : zsol, Psol, Thdsol, Rsol -! (height, U, V) , -! (height, THl, Rt) -! -! These fields can be used for model runs -! -! Cases (1) and (2) can be balanced -! (geostrophic, hydrostatic and anelastic balances) if desired. -! -! ---- The orography can be flat (YZS='FLAT'), but also -! sine-shaped (YZS='SINE') or bell-shaped (YZS='BELL') -! -! ---- The U(z) profile given in the RSOU and CSTN cases can -! be multiplied (CUFUN="Y*Z") by a function of y (function FUNUY) -! The V(z) profile given in the RSOU and CSTN cases can -! be multiplied (CVFUN="X*Z") by a function of x (function FUNVX). -! If it is not the case, i.e. U(y,z)=U(z) then CUFUN="ZZZ" and -! CVFUN="ZZZ" for V(y,z)=V(z). Instead of these separable forms, -! non-separables functions FUNUYZ (CUFUN="Y,Z") and FUNVXZ (CVFUN="X,Z") -! can be used to specify the wind components. -! -!!** METHOD -!! ------ -!! The directives and data to perform the preparation of the initial FM -!! file are stored in EXPRE file. This file is composed of two parts : -!! - a namelists-format part which is present in all cases -!! - a free-format part which contains data in cases -!! of discretised orography (CZS='DATA') -!! of radiosounding (CIDEAL='RSOU') or Nv=cste profile (CIDEAL='CSTN') -!! of forced version (LFORCING=.TRUE.) -!! -!! -!! The following PREP_IDEAL_CASE program : -!! -!! - initializes physical constants by calling INI_CST -!! -!! - sets default values for global variables which will be -!! written in DESFM file and for variables in EXPRE file (namelists part) -!! which will be written in LFIFM file. -!! -!! - reads the namelists part of EXPRE file which gives -!! informations about the preinitialization to perform, -!! -!! - allocates memory for arrays, -!! -!! - initializes fields depending on the -!! directives (CIDEAL in namelist NAM_CONF_PRE) : -!! -!! * grid variables : -!! The gridpoints are regularly spaced by XDELTAX, XDELTAY. -!! The grid is stretched along the z direction, the mesh varies -!! from XDZGRD near the ground to XDZTOP near the top and the -!! weigthing function is a TANH function characterized by its -!! center and width above and under this center -!! The orography is initialized following the kind of orography -!! (YZS in namelist NAM_CONF_PRE) and the degrees of freedom : -!! sine-shape ---> ZHMAX, IEXPX,IEXPY -!! bell-shape ---> ZHMAX, ZAX,ZAY,IIZS,IJZS -!! The horizontal grid variables are initialized following -!! the kind of geometry (LCARTESIAN in namelist NAM_CONF_PRE) -!! and the grid parameters XLAT0,XLON0,XBETA in both geometries -!! and XRPK,XLONORI,XLATORI in conformal projection. -!! In the case of initialization from a radiosounding, the -!! date and time is read in free-part of the EXPRE file. In other -!! cases year, month and day are set to NUNDEF and time to 0. -!! -!! * prognostic fields : -!! -!! U,V,W, Theta and r. are first determined. They are -!! multiplied by rhoj after the anelastic reference state -!! computation. -!! For the CSTN and RSOU cases, the determination of -!! Theta and rv is performed respectively by SET_RSOU -!! and by SET_CSTN which call the common routine SET_MASS. -!! These three routines have the following actions : -!! --- The input vertical profile is converted in -!! variables (U,V,thetav,r) and interpolated -!! on a mixed grid (with VERT_COORD) as in PREP_REAL_CASE -!! --- A variation of the u-wind component( x-model axis component) -!! is possible in y direction, a variation of the v-wind component -!! (y-model axis component) is possible in x direction. -!! --- Thetav could be computed with thermal wind balance -!! (LGEOSBAL=.TRUE. with call of SET_GEOSBAL) -!! --- The mass fields (theta and r ) and the wind components are -!! then interpolated on the model grid with orography as in -!! PREP_REAL_CASE with the option LSHIFT -!! --- An anelastic correction is applied in PRESSURE_IN_PREP in -!! the case of non-vanishing orography. -!! -!! * anelastic reference state variables : -!! -!! 1D reference state : -!! RSOU and CSTN cases : rhorefz and thvrefz are computed -!! by SET_REFZ (called by SET_MASS). -!! They are deduced from thetav and r on the model grid -!! without orography. -!! The 3D reference state is computed by SET_REF -!! -!! * The total mass of dry air is computed by TOTAL_DMASS -!! -!! - writes the DESFM file, -!! -!! - writes the LFIFM file . -!! -!! EXTERNAL -!! -------- -!! DEFAULT_DESFM : to set default values for variables which can be -!! contained in DESFM file -!! DEFAULT_EXPRE : to set default values for other global variables -!! which can be contained in namelist-part of EXPRE file -!! Module MODE_GRIDPROJ : contains conformal projection routines -!! SM_GRIDPROJ : to compute some grid variables, in -!! case of conformal projection. -!! Module MODE_GRIDCART : contains cartesian geometry routines -!! SM_GRIDCART : to compute some grid variables, in -!! case of cartesian geometry. -!! SET_RSOU : to initialize mass fields from a radiosounding -!! SET_CSTN : to initialize mass fields from a vertical profile of -!! n layers of Nv=cste -!! SET_REF : to compute rhoJ -!! RESSURE_IN_PREP : to apply an anelastic correction in the case of -!! non-vanishing orography -!! IO_File_open : to open a FM-file (DESFM + LFIFM) -!! WRITE_DESFM : to write the DESFM file -!! WRI_LFIFM : to write the LFIFM file -!! IO_File_close : to close a FM-file (DESFM + LFIFM) -!! -!! MXM,MYM,MZM : Shuman operators -!! WGUESS : to compute W with the continuity equation from -!! the U,V values -!! -!! -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! Module MODD_PARAMETERS : contains parameters -!! Module MODD_DIM1 : contains dimensions -!! Module MODD_CONF : contains configuration variables for -!! all models -!! Module MODD_CST : contains physical constants -!! Module MODD_GRID : contains grid variables for all models -!! Module MODD_GRID1 : contains grid variables -!! Module MODD_TIME : contains time variables for all models -!! Module MODD_TIME1 : contains time variables -!! Module MODD_REF : contains reference state variables for -!! all models -!! Module MODD_REF1 : contains reference state variables -!! Module MODD_LUNIT : contains variables which concern names -!! and logical unit numbers of files for all models -!! Module MODD_FIELD1 : contains prognostics variables -!! Module MODD_GR_FIELD1 : contains the surface prognostic variables -!! Module MODD_LSFIELD1 : contains Larger Scale fields -!! Module MODD_DYN1 : contains dynamic control variables for model 1 -!! Module MODD_LBC1 : contains lbc control variables for model 1 -!! -!! -!! Module MODN_CONF1 : contains configuration variables for model 1 -!! and the NAMELIST list -!! Module MODN_LUNIT1 : contains variables which concern names -!! and logical unit numbers of files and -!! the NAMELIST list -!! -!! -!! REFERENCE -!! --------- -!! Book2 of MESO-NH documentation (program PREP_IDEAL_CASE) -!! -!! AUTHOR -!! ------ -!! V. Ducrocq *Meteo France* -!! -!! MODIFICATIONS -!! ------------- -!! Original 05/05/94 -!! updated V. Ducrocq 27/06/94 -!! updated P.M. 27/07/94 -!! updated V. Ducrocq 23/08/94 -!! updated V. Ducrocq 01/09/94 -!! namelist changes J. Stein 26/10/94 -!! namelist changes J. Stein 04/11/94 -!! remove the second step of the geostrophic balance 14/11/94 (J.Stein) -!! add grid stretching in the z direction + Larger scale fields + -!! cleaning 6/12/94 (J.Stein) -!! periodize the orography and the grid sizes in the periodic case -!! 19/12/94 (J.Stein) -!! correct a bug in the Larger Scale Fields initialization -!! 19/12/94 (J.Stein) -!! add the vertical grid stretching 02/01/95 (J. Stein) -!! Total mass of dry air computation 02/01/95 (J.P.Lafore) -!! add the 1D switch 13/01/95 (J. Stein) -!! enforce a regular vertical grid if desired 18/01/95 (J. Stein) -!! add the tdtcur initialization 26/01/95 (J. Stein) -!! bug in the test of the type of RS localization 25/02/95 (J. Stein) -!! remove R from the historical variables 16/03/95 (J. Stein) -!! error on the grid stretching 30/06/95 (J. Stein) -!! add the soil fields 01/09/95 (S.Belair) -!! change the streching function and the wind guess -!! (J. Stein and V.Masson) 21/09/95 -!! reset to FALSE LUSERC,..,LUSERH 12/12/95 (J. Stein) -!! enforce the RS localization in 1D and 2D config. -!! + add the 'TSZ0' option for the soil variables 28/01/96 (J. Stein) -!! initialization of domain from center point 31/01/96 (V. Masson) -!! add the constant file reading 05/02/96 (J. Stein) -!! enter vertical model levels values 20/10/95 (T.Montmerle) -!! add LFORCING option 19/02/96 (K. Suhre) -!! modify structure of NAM_CONF_PRE 20/02/96 (J.-P. Pinty) -!! default of the domain center when use of pgd file 12/03/96 (V. Masson) -!! change the surface initialization 20/03/96 ( Stein, -!! Bougeault, Kastendeutsch ) -!! change the DEFAULT_DESFMN CALL 17/04/96 ( Lafore ) -!! set the STORAGE_TYPE to 'TT' (a single instant) 30/04/96 (Stein, -!! Jabouille) -!! new wguess to spread the divergence 15/05/96 (Stein) -!! set LTHINSHELL to TRUE + return to the old wguess 29/08/96 (Stein) -!! MY_NAME and DAD_NAME writing for nesting 30/07/96 (Lafore) -!! MY_NAME and DAD_NAME reading in pgd file 26/09/96 (Masson) -!! and reading of pgd grid in a new routine -!! XXHAT and XYHAT are set to 0. at origine point 02/10/96 (Masson) -!! add LTHINSHELL in namelist NAM_CONF_PRE 08/10/96 (Masson) -!! restores use of TS and T2 26/11/96 (Masson) -!! value XUNDEF for soil and vegetation fields on sea 27/11/96 (Masson) -!! use of HUG and HU2 in both ISBA and TSZ0 cases 04/12/96 (Masson) -!! add initialization of chemical variables 06/08/96 (K. Suhre) -!! add MANUAL option for the terrain elevation 12/12/96 (J.-P. Pinty) -!! set DATA instead of MANUAL for the terrain -!! elevation option -!! add new anelastic equations' systems 29/06/97 (Stein) -!! split mode_lfifm_pgd 29/07/97 (Masson) -!! add directional z0 and subgrid scale orography 31/07/97 (Masson) -!! separates surface treatment in PREP_IDEAL_SURF 15/03/99 (Masson) -!! new PGD fields allocations 15/03/99 (Masson) -!! iterative call to pressure solver 15/03/99 (Masson) -!! removes TSZ0 case 04/01/00 (Masson) -!! parallelization 18/06/00 (Pinty) -!! adaptation for patch approach 02/07/00 (Solmon/Masson) -!! bug in W LB field on Y direction 05/03/01 (Stein) -!! add module MODD_NSV for NSV variable 01/02/01 (D. Gazen) -!! allow namelists in different orders 15/10/01 (I. Mallet) -!! allow LUSERC and LUSERI in 1D configuration 05/06/02 (P. Jabouille) -!! add ZUVTHLMR case (move in set_rsou latter) 05/12/02 Jabouille/Masson -!! move LHORELAX_SV (after INI_NSV) 30/04/04 (Pinty) -!! Correction Parallel bug IBEG & IDEND evalution 13/11/08 J.Escobar -!! add the option LSHIFT for interpolation of 26/10/10 (G.Tanguy) -!! correction for XHAT & parallelizarion of ZSDATA 23/09/11 J.Escobar -!! the vertical profile (as in PREP_REAL_CASE) -!! add use MODI of SURFEX routines 10/10/111 J.Escobar -!! -!! For 2D modeling: -!! Initialization of ADVFRC profiles (SET_ADVFRC) 06/2010 (P.Peyrille) -!! when LDUMMY(2)=T in PRE_IDEA1.nam -!! USE MODDB_ADVFRC_n for grid-nesting 02*2012 (M. Tomasini) -!! LBOUSS in MODD_REF 07/2013 (C.Lac) -!! Correction for ZS in PGD file 04/2014 (G. TANGUY) -!! Bug : remove NC WRITE_HGRID 05/2014 (S. Bielli via J.Escobar ) -!! BUG if ZFRC and ZFRC_ADV or ZFRC_REL are used together 11/2014 (G. Delautier) -!! Bug : detected with cray compiler , -!! missing '&' in continuation string 3/12/2014 J.Escobar -!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1 -!! 06/2016 (G.Delautier) phasage surfex 8 -!! P.Wautelet : 08/07/2016 : removed MNH_NCWRIT define -!! 01/2018 (G.Delautier) SURFEX 8.1 -! P. Wautelet: 05/2016-04/2018: new data structures and calls for I/O -! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list -! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables -! P. Wautelet 28/03/2019: use MNHTIME for time measurement variables -! P. Wautelet 28/03/2019: use TFILE instead of unit number for set_iluout_timing -! P. Wautelet 19/04/2019: removed unused dummy arguments and variables -! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function -! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine -! F. Auguste 02/2021: add IBM -! P. Wautelet 09/03/2021: move some chemistry initializations to ini_nsv -! Jean-Luc Redelsperger 03/2021: ocean LES case -! P. Wautelet 06/07/2021: use FINALIZE_MNH -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_PARAMETERS ! Declarative modules -USE MODD_ARGSLIST_ll, ONLY : LIST_ll -USE MODD_DIM_n -USE MODD_CONF -USE MODD_CST -USE MODD_GRID -USE MODD_GRID_n -USE MODD_IBM_LSF, ONLY: CIBM_TYPE, LIBM_LSF, NIBM_SMOOTH, XIBM_SMOOTH -USE MODD_IBM_PARAM_n, ONLY: XIBM_LS -USE MODD_METRICS_n -USE MODD_PGDDIM -USE MODD_PGDGRID -USE MODD_TIME -USE MODD_TIME_n -USE MODD_REF -USE MODD_REF_n -USE MODD_LUNIT -USE MODD_FIELD_n -USE MODD_DYN_n -USE MODD_LBC_n -USE MODD_LSFIELD_n -USE MODD_PARAM_n -USE MODD_CH_MNHC_n, ONLY: LUSECHEM, LUSECHAQ, LUSECHIC, LCH_PH, LCH_INIT_FIELD -USE MODD_CH_AEROSOL,ONLY: LORILAM, CORGANIC, LVARSIGI, LVARSIGJ, LINITPM, XINIRADIUSI, & - XINIRADIUSJ, XINISIGI, XINISIGJ, XN0IMIN, XN0JMIN, CRGUNIT -USE MODD_DUST, ONLY: LDUST, NMODE_DST, CRGUNITD, XINISIG, XINIRADIUS, XN0MIN -USE MODD_SALT, ONLY: LSALT, NMODE_SLT, CRGUNITS, XINISIG_SLT, XINIRADIUS_SLT, XN0MIN_SLT -USE MODD_VAR_ll, ONLY: NPROC -USE MODD_LUNIT, ONLY: TLUOUT0, TOUTDATAFILE -USE MODD_LUNIT_n -USE MODD_IO, ONLY: TFILE_DUMMY, TFILE_OUTPUTLISTING -USE MODD_CONF_n -USE MODD_NSV, ONLY: NSV -use modd_precision, only: LFIINT, MNHREAL_MPI, MNHTIME -! -USE MODN_BLANK_n -! -USE MODE_FINALIZE_MNH, only: FINALIZE_MNH -USE MODE_THERMO -USE MODE_POS -USE MODE_GRIDCART ! Executive modules -USE MODE_GRIDPROJ -USE MODE_GATHER_ll -USE MODE_IO, only: IO_Config_set, IO_Init, IO_Pack_set -USE MODE_IO_FIELD_READ, only: IO_Field_read -USE MODE_IO_FIELD_WRITE, only: IO_Field_write, IO_Header_write -USE MODE_IO_FILE, only: IO_File_close, IO_File_open -USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list -USE MODE_ll -USE MODE_MODELN_HANDLER -use mode_field, only: Alloc_field_scalars, Ini_field_list, Ini_field_scalars -USE MODE_MSG -! -USE MODI_DEFAULT_DESFM_n ! Interface modules -USE MODI_DEFAULT_EXPRE -USE MODI_IBM_INIT_LS -USE MODI_READ_HGRID -USE MODI_SHUMAN -USE MODI_SET_RSOU -USE MODI_SET_CSTN -USE MODI_SET_FRC -USE MODI_PRESSURE_IN_PREP -USE MODI_WRITE_DESFM_n -USE MODI_WRITE_LFIFM_n -USE MODI_METRICS -USE MODI_UPDATE_METRICS -USE MODI_SET_REF -USE MODI_SET_PERTURB -USE MODI_TOTAL_DMASS -USE MODI_CH_INIT_FIELD_n -USE MODI_INI_NSV -USE MODI_READ_PRE_IDEA_NAM_n -USE MODI_ZSMT_PIC -USE MODI_ZSMT_PGD -USE MODI_READ_VER_GRID -USE MODI_READ_ALL_NAMELISTS -USE MODI_PGD_GRID_SURF_ATM -USE MODI_SPLIT_GRID -USE MODI_PGD_SURF_ATM -USE MODI_ICE_ADJUST_BIS -USE MODI_WRITE_PGD_SURF_ATM_n -USE MODI_PREP_SURF_MNH -!UPG*PT -USE MODI_INIT_SALT -USE MODI_AER2LIMA -USE MODD_PARAM_LIMA -!UPG*PT -! -!JUAN -USE MODE_SPLITTINGZ_ll -USE MODD_SUB_MODEL_n -USE MODE_MNH_TIMING -USE MODN_CONFZ -!JUAN -USE MODI_TH_R_FROM_THL_RT_3D -! -USE MODI_VERSION -USE MODI_INIT_PGD_SURF_ATM -USE MODI_WRITE_SURF_ATM_N -USE MODD_MNH_SURFEX_n -! Modif ADVFRC -USE MODD_2D_FRC -USE MODD_ADVFRC_n ! Modif for grid-nesting -USE MODI_SETADVFRC -USE MODD_RELFRC_n ! Modif for grid-nesting -USE MODI_SET_RELFRC -! -USE MODI_INI_CST -USE MODI_INI_NEB -USE MODI_WRITE_HGRID -USE MODD_MPIF -USE MODD_VAR_ll -USE MODD_IO, ONLY: TFILEDATA,TFILE_SURFEX -! -USE MODE_MPPDB -! -USE MODD_GET_n -! -USE MODN_CONFIO, ONLY : NAM_CONFIO -! -IMPLICIT NONE -! -!* 0.1 Declarations of global variables not declared in the modules -! -REAL, DIMENSION(:,:,:), ALLOCATABLE :: XJ ! Jacobian -REAL :: XLATCEN=XUNDEF, XLONCEN=XUNDEF ! latitude and longitude of the center of - ! the domain for initialization. This - ! point is vertical vorticity point - ! ------------------------ -REAL :: XDELTAX=0.5E4, XDELTAY=0.5E4 ! horizontal mesh lengths - ! used to determine XXHAT,XYHAT -! -INTEGER :: NLUPRE,NLUOUT ! Logical unit numbers for EXPRE file - ! and for output_listing file -INTEGER :: NRESP ! return code in FM routines -INTEGER :: NTYPE ! type of file (cpio or not) -INTEGER(KIND=LFIINT) :: NNPRAR ! number of articles predicted in the LFIFM file -LOGICAL :: GFOUND ! Return code when searching namelist -! -INTEGER :: JLOOP,JILOOP,JJLOOP ! Loop indexes -! -INTEGER :: NIB,NJB,NKB ! Begining useful area in x,y,z directions -INTEGER :: NIE,NJE ! Ending useful area in x,y directions -INTEGER :: NIU,NJU,NKU ! Upper bounds in x,y,z directions -CHARACTER(LEN=4) :: CIDEAL ='CSTN' ! kind of idealized fields - ! 'CSTN' : Nv=cste case - ! 'RSOU' : radiosounding case -CHARACTER(LEN=4) :: CZS ='FLAT' ! orography selector - ! 'FLAT' : zero orography - ! 'SINE' : sine-shaped orography - ! 'BELL' : bell-shaped orography -REAL :: XHMAX=XUNDEF ! Maximum height for orography -REAL :: NEXPX=3,NEXPY=1 ! Exponents for orography in case of CZS='SINE' -REAL :: XAX= 1.E4, XAY=1.E4 ! Widths for orography in case CZS='BELL' - ! along x and y -INTEGER :: NIZS = 5, NJZS = 5 ! Localization of the center in - ! case CZS ='BELL' -! -!* 0.1.1 Declarations of local variables for N=cste and -! radiosounding cases : -! -INTEGER :: NYEAR,NMONTH,NDAY ! year, month and day in EXPRE file -REAL :: XTIME ! time in EXPRE file -LOGICAL :: LPERTURB =.FALSE. ! Logical to add a perturbation to - ! a basic state -LOGICAL :: LGEOSBAL =.FALSE. ! Logical to satisfy the geostrophic - ! balance - ! .TRUE. for geostrophic balance - ! .FALSE. to ignore this balance -LOGICAL :: LSHIFT =.FALSE. ! flag to perform vertical shift or not. -CHARACTER(LEN=3) :: CFUNU ='ZZZ' ! CHARACTER STRING for variation of - ! U in y direction - ! 'ZZZ' : U = U(Z) - ! 'Y*Z' : U = F(Y) * U(Z) - ! 'Y,Z' : U = G(Y,Z) -CHARACTER(LEN=3) :: CFUNV ='ZZZ' ! CHARACTER STRING for variation of - ! V in x direction - ! 'ZZZ' : V = V(Z) - ! 'Y*Z' : V = F(X) * V(Z) - ! 'Y,Z' : V = G(X,Z) -CHARACTER(LEN=6) :: CTYPELOC='IJGRID' ! Type of informations used to give the - ! localization of vertical profile - ! 'IJGRID' for (i,j) point on index space - ! 'XYHATM' for (x,y) coordinates on - ! conformal or cartesian plane - ! 'LATLON' for (latitude,longitude) on - ! spherical earth -REAL :: XLATLOC= 45., XLONLOC=0. - ! Latitude and longitude of the vertical - ! profile localization (used in case - ! CTYPELOC='LATLON') -REAL :: XXHATLOC=2.E4, XYHATLOC=2.E4 - ! (x,y) of the vertical profile - ! localization (used in cases - ! CTYPELOC='LATLON' and 'XYHATM') -INTEGER, DIMENSION(1) :: NILOC=4, NJLOC=4 - ! (i,j) of the vertical profile - ! localization -! -! -REAL,DIMENSION(:,:,:),ALLOCATABLE :: XCORIOZ ! Coriolis parameter (this - ! is exceptionnaly a 3D array - ! for computing needs) -! -! -!* 0.1.2 Declarations of local variables used when a PhysioGraphic Data -! file is used : -! -INTEGER :: JSV ! loop index on scalar var. -CHARACTER(LEN=28) :: CPGD_FILE=' ' ! Physio-Graphic Data file name -LOGICAL :: LREAD_ZS = .TRUE., & ! switch to use orography - ! coming from the PGD file - LREAD_GROUND_PARAM = .TRUE. ! switch to use soil parameters - ! useful for the soil scheme - ! coming from the PGD file - -INTEGER :: NSLEVE =12 ! number of iteration for smooth orography -REAL :: XSMOOTH_ZS = XUNDEF ! optional uniform smooth orography for SLEVE coordinate -CHARACTER(LEN=28) :: YPGD_NAME, YPGD_DAD_NAME ! general information -CHARACTER(LEN=2) :: YPGD_TYPE -! -INTEGER :: IINFO_ll ! return code of // routines -TYPE(LIST_ll), POINTER :: TZ_FIELDS_ll ! list of metric coefficient fields -! -INTEGER :: IISIZEXF,IJSIZEXF,IISIZEXFU,IJSIZEXFU ! dimensions of the -INTEGER :: IISIZEX4,IJSIZEX4,IISIZEX2,IJSIZEX2 ! West-east LB arrays -INTEGER :: IISIZEYF,IJSIZEYF,IISIZEYFV,IJSIZEYFV ! dimensions of the -INTEGER :: IISIZEY4,IJSIZEY4,IISIZEY2,IJSIZEY2 ! North-south LB arrays -INTEGER :: IBEG,IEND,IXOR,IXDIM,IYOR,IYDIM,ILBX,ILBY -REAL, DIMENSION(:), ALLOCATABLE :: ZXHAT_ll, ZYHAT_ll -! -REAL, DIMENSION(:,:,:), ALLOCATABLE ::ZTHL,ZT,ZRT,ZFRAC_ICE,& - ZEXN,ZLVOCPEXN,ZLSOCPEXN,ZCPH, & - ZRSATW, ZRSATI - ! variables for adjustement -REAL :: ZDIST -! -!JUAN TIMING -REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME1, ZTIME2, ZEND, ZTOT -CHARACTER :: YMI -INTEGER :: IMI -!JUAN TIMING -! -REAL, DIMENSION(:), ALLOCATABLE :: ZZS_ll -INTEGER :: IJ -! -REAL :: ZZS_MAX, ZZS_MAX_ll -INTEGER :: IJPHEXT -! -TYPE(TFILEDATA),POINTER :: TZEXPREFILE => NULL() -! -! -!* 0.2 Namelist declarations -! -NAMELIST/NAM_CONF_PRE/ LTHINSHELL,LCARTESIAN, &! Declarations in MODD_CONF - LPACK, &! - NVERB,CIDEAL,CZS, &!+global variables initialized - LBOUSS,LOCEAN,LPERTURB, &! at their declarations - LFORCING,CEQNSYS, &! at their declarations - LSHIFT,L2D_ADV_FRC,L2D_REL_FRC, & - NHALO , JPHEXT -NAMELIST/NAM_GRID_PRE/ XLON0,XLAT0, & ! Declarations in MODD_GRID - XBETA,XRPK, & - XLONORI,XLATORI -NAMELIST/NAM_GRIDH_PRE/ XLATCEN,XLONCEN, & ! local variables initialized - XDELTAX,XDELTAY, & ! at their declarations - XHMAX,NEXPX,NEXPY, & - XAX,XAY,NIZS,NJZS -NAMELIST/NAM_VPROF_PRE/LGEOSBAL, CFUNU,CFUNV, &! global variables initialized - CTYPELOC,XLATLOC,XLONLOC, &! at their declarations - XXHATLOC,XYHATLOC,NILOC,NJLOC -NAMELIST/NAM_REAL_PGD/CPGD_FILE, & ! Physio-Graphic Data file - ! name - LREAD_ZS, & ! switch to use orography - ! coming from the PGD file - LREAD_GROUND_PARAM -NAMELIST/NAM_SLEVE/NSLEVE, XSMOOTH_ZS -! -!* 0.3 Auxillary Namelist declarations -! -NAMELIST/NAM_AERO_PRE/ LORILAM, LINITPM, XINIRADIUSI, XINIRADIUSJ, & - XINISIGI, XINISIGJ, XN0IMIN, XN0JMIN, CRGUNIT, & - LDUST, LSALT, CRGUNITD, CRGUNITS,& - NMODE_DST, XINISIG, XINIRADIUS, XN0MIN,& - XINISIG_SLT, XINIRADIUS_SLT, XN0MIN_SLT, & - NMODE_SLT -! -NAMELIST/NAM_IBM_LSF/ LIBM_LSF, CIBM_TYPE, NIBM_SMOOTH, XIBM_SMOOTH -! -!------------------------------------------------------------------------------- -! -!* 0. PROLOGUE -! -------- -CALL MPPDB_INIT() -! -CALL GOTO_MODEL(1) -! -CALL IO_Init() -NULLIFY(TZ_FIELDS_ll) -CALL VERSION -CPROGRAM='IDEAL ' -! -!JUAN TIMING - XT_START = 0.0_MNHTIME - XT_STORE = 0.0_MNHTIME -! - CALL SECOND_MNH2(ZEND) -! -!JUAN TIMING -! -!* 1. INITIALIZE PHYSICAL CONSTANTS : -! ------------------------------ -! -NVERB = 5 -CALL INI_CST -CALL INI_NEB -! -!------------------------------------------------------------------------------- -! -! -!* 2. SET DEFAULT VALUES : -! -------------------- -! -! -!* 2.1 For variables in DESFM file -! -CALL ALLOC_FIELD_SCALARS() -! -CALL DEFAULT_DESFM_n(1) -! -CSURF = "NONE" -! -! -!* 2.2 For other global variables in EXPRE file -! -CALL DEFAULT_EXPRE -!------------------------------------------------------------------------------- -! -!* 3. READ THE EXPRE FILE : -! -------------------- -! -!* 3.1 initialize logical unit numbers (EXPRE and output-listing files) -! and open these files : -! -! -CALL IO_File_add2list(TLUOUT0,'OUTPUT_LISTING1','OUTPUTLISTING','WRITE') -CALL IO_File_open(TLUOUT0) -NLUOUT = TLUOUT0%NLU -!Set output files for PRINT_MSG -TLUOUT => TLUOUT0 -TFILE_OUTPUTLISTING => TLUOUT0 -! -CALL IO_File_add2list(TZEXPREFILE,'PRE_IDEA1.nam','NML','READ') -CALL IO_File_open(TZEXPREFILE) -NLUPRE=TZEXPREFILE%NLU -! -!* 3.2 read in NLUPRE the namelist informations -! -WRITE(NLUOUT,FMT=*) 'attempt to read ',TRIM(TZEXPREFILE%CNAME),' file' -CALL POSNAM(NLUPRE,'NAM_REAL_PGD',GFOUND,NLUOUT) -IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_REAL_PGD) -! -! -CALL POSNAM(NLUPRE,'NAM_CONF_PRE',GFOUND,NLUOUT) -IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_CONF_PRE) -!JUANZ -CALL POSNAM(NLUPRE,'NAM_CONFZ',GFOUND,NLUOUT) -IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_CONFZ) -!JUANZ -CALL POSNAM(NLUPRE,'NAM_CONFIO',GFOUND,NLUOUT) -IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_CONFIO) -CALL IO_Config_set() -CALL POSNAM(NLUPRE,'NAM_GRID_PRE',GFOUND,NLUOUT) -IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_GRID_PRE) -CALL POSNAM(NLUPRE,'NAM_GRIDH_PRE',GFOUND,NLUOUT) -IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_GRIDH_PRE) -CALL POSNAM(NLUPRE,'NAM_VPROF_PRE',GFOUND,NLUOUT) -IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_VPROF_PRE) -CALL POSNAM(NLUPRE,'NAM_BLANKN',GFOUND,NLUOUT) -CALL INIT_NAM_BLANKn -IF (GFOUND) THEN - READ(UNIT=NLUPRE,NML=NAM_BLANKn) - CALL UPDATE_NAM_BLANKn -END IF -CALL READ_PRE_IDEA_NAM_n(NLUPRE,NLUOUT) -CALL POSNAM(NLUPRE,'NAM_AERO_PRE',GFOUND,NLUOUT) -IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_AERO_PRE) -CALL POSNAM(NLUPRE,'NAM_IBM_LSF' ,GFOUND,NLUOUT) -IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_IBM_LSF ) -! -CALL INI_FIELD_LIST(1) -! -CALL INI_FIELD_SCALARS() -!UPG*PT -! Sea salt -CALL INIT_SALT -!UPG*PT - -! -IF( LEN_TRIM(CPGD_FILE) /= 0 ) THEN - ! open the PGD_FILE - CALL IO_File_add2list(TPGDFILE,TRIM(CPGD_FILE),'PGD','READ',KLFINPRAR=NNPRAR,KLFITYPE=2,KLFIVERB=NVERB) - CALL IO_File_open(TPGDFILE) - - ! read the grid in the PGD file - CALL IO_Field_read(TPGDFILE,'IMAX', NIMAX) - CALL IO_Field_read(TPGDFILE,'JMAX', NJMAX) - CALL IO_Field_read(TPGDFILE,'JPHEXT',IJPHEXT) - - IF ( CPGD_FILE /= CINIFILEPGD) THEN - WRITE(NLUOUT,FMT=*) ' WARNING : in PRE_IDEA1.nam, in NAM_LUNITn you& - & have CINIFILEPGD= ',CINIFILEPGD - WRITE(NLUOUT,FMT=*) ' whereas in NAM_REAL_PGD you have CPGD_FILE = '& - ,CPGD_FILE - WRITE(NLUOUT,FMT=*) ' ' - WRITE(NLUOUT,FMT=*) ' CINIFILEPGD HAS BEEN SET TO ',CPGD_FILE - CINIFILEPGD=CPGD_FILE - END IF - IF ( IJPHEXT .NE. JPHEXT ) THEN - WRITE(NLUOUT,FMT=*) ' PREP_IDEAL_CASE : JPHEXT in PRE_IDEA1.nam/NAM_CONF_PRE ( or default value )& - & JPHEXT=',JPHEXT - WRITE(NLUOUT,FMT=*) ' different from PGD files=', CINIFILEPGD,' value JPHEXT=',IJPHEXT - WRITE(NLUOUT,FMT=*) '-> JOB ABORTED' - CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','') - !WRITE(NLUOUT,FMT=*) ' JPHEXT HAS BEEN SET TO ', IJPHEXT - !IJPHEXT = JPHEXT - END IF -END IF -! -NIMAX_ll=NIMAX !! _ll variables are global variables -NJMAX_ll=NJMAX !! but the old names are kept in PRE_IDEA1.nam file -! -!* 3.3 check some parameters: -! -L1D=.FALSE. ; L2D=.FALSE. -! -IF ((NIMAX == 1).OR.(NJMAX == 1)) THEN - L2D=.TRUE. - NJMAX_ll=1 - NIMAX_ll=MAX(NIMAX,NJMAX) - WRITE(NLUOUT,FMT=*) ' NJMAX HAS BEEN SET TO 1 SINCE 2D INITIAL FILE IS REQUIRED & - & (L2D=TRUE) )' -END IF -! -IF ((NIMAX == 1).AND.(NJMAX == 1)) THEN - L1D=.TRUE. - NIMAX_ll = 1 - NJMAX_ll = 1 - WRITE(NLUOUT,FMT=*) ' 1D INITIAL FILE IS REQUIRED (L1D=TRUE) ' -END IF -! -IF(.NOT. L1D) THEN - LHORELAX_UVWTH=.TRUE. - LHORELAX_RV=.TRUE. -ENDIF -! -NRIMX= MIN(JPRIMMAX,NIMAX_ll/2) -! -IF (L2D) THEN - NRIMY=0 -ELSE - NRIMY= MIN(JPRIMMAX,NJMAX_ll/2) -END IF -! -IF (L1D) THEN - NRIMX=0 - NRIMY=0 -END IF -! -IF (L1D .AND. ( LPERTURB .OR. LGEOSBAL .OR. & - (.NOT. LCARTESIAN ) .OR. (.NOT. LTHINSHELL) ))THEN - LGEOSBAL = .FALSE. - LPERTURB = .FALSE. - LCARTESIAN = .TRUE. - LTHINSHELL = .TRUE. - WRITE(NLUOUT,FMT=*) ' LGEOSBAL AND LPERTURB HAVE BEEN SET TO FALSE & - & AND LCARTESIAN AND LTHINSHELL TO TRUE & - & SINCE 1D INITIAL FILE IS REQUIRED (L1D=TRUE)' -END IF -! -IF (LGEOSBAL .AND. LSHIFT ) THEN - LSHIFT=.FALSE. - WRITE(NLUOUT,FMT=*) ' LSHIFT HAS BEEN SET TO FALSE SINCE & - & LGEOSBAL=.TRUE. IS REQUIRED ' -END IF -! -!* 3.4 compute the number of moist variables : -! -IF (.NOT.LUSERV) THEN - LUSERV = .TRUE. - WRITE(NLUOUT,FMT=*) ' LUSERV HAS BEEN RESET TO TRUE, SINCE A MOIST VARIABLE & - & IS PRESENT IN EXPRE FILE (CIDEAL = RSOU OR CSTN)' -END IF -! -IF((LUSERI .OR. LUSERC).AND. (CIDEAL /= 'RSOU')) THEN - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','use of hydrometeors is only allowed in RSOU case') -ENDIF -IF (LUSERI) THEN - LUSERC =.TRUE. - LUSERR =.TRUE. - LUSERI =.TRUE. - LUSERS =.TRUE. - LUSERG =.TRUE. - LUSERH =.FALSE. - CCLOUD='ICE3' -ELSEIF(LUSERC) THEN - LUSERR =.FALSE. - LUSERI =.FALSE. - LUSERS =.FALSE. - LUSERG =.FALSE. - LUSERH =.FALSE. - CCLOUD='REVE' -ELSE - LUSERC =.FALSE. - LUSERR =.FALSE. - LUSERI =.FALSE. - LUSERS =.FALSE. - LUSERG =.FALSE. - LUSERH =.FALSE. - LHORELAX_RC=.FALSE. - LHORELAX_RR=.FALSE. - LHORELAX_RI=.FALSE. - LHORELAX_RS=.FALSE. - LHORELAX_RG=.FALSE. - LHORELAX_RH=.FALSE. - CCLOUD='NONE' -! -END IF -! -NRR=0 -IF (LUSERV) THEN - NRR=NRR+1 - IDX_RVT = NRR -END IF -IF (LUSERC) THEN - NRR=NRR+1 - IDX_RCT = NRR -END IF -IF (LUSERR) THEN - NRR=NRR+1 - IDX_RRT = NRR -END IF -IF (LUSERI) THEN - NRR=NRR+1 - IDX_RIT = NRR -END IF -IF (LUSERS) THEN - NRR=NRR+1 - IDX_RST = NRR -END IF -IF (LUSERG) THEN - NRR=NRR+1 - IDX_RGT = NRR -END IF -IF (LUSERH) THEN - NRR=NRR+1 - IDX_RHT = NRR -END IF -! -! NRR=4 for RSOU case because RI and Rc always computed -IF (CIDEAL == 'RSOU' .AND. NRR < 4 ) NRR=4 -! -! -!* 3.5 Chemistry -! -IF (LORILAM .OR. LCH_INIT_FIELD) THEN - LUSECHEM = .TRUE. - IF (LORILAM) THEN - CORGANIC = "MPMPO" - LVARSIGI = .TRUE. - LVARSIGJ = .TRUE. - END IF -END IF -! initialise NSV_* variables -CALL INI_NSV(1) -LHORELAX_SV(:)=.FALSE. -IF(.NOT. L1D) LHORELAX_SV(1:NSV)=.TRUE. -! -!------------------------------------------------------------------------------- -! -!* 4. ALLOCATE MEMORY FOR ARRAYS : -! ---------------------------- -! -!* 4.1 Vertical Spatial grid -! -CALL READ_VER_GRID(TZEXPREFILE) -! -!* 4.2 Initialize parallel variables and compute array's dimensions -! -! -IF(LGEOSBAL) THEN - CALL SET_SPLITTING_ll('XSPLITTING') ! required for integration of thermal wind balance -ELSE - CALL SET_SPLITTING_ll('BSPLITTING') -ENDIF -CALL SET_JP_ll(1,JPHEXT,JPVEXT,JPHEXT) -CALL SET_DAD0_ll() -CALL SET_DIM_ll(NIMAX_ll, NJMAX_ll, NKMAX) -CALL IO_Pack_set(L1D,L2D,LPACK) -CALL SET_LBX_ll(CLBCX(1), 1) -CALL SET_LBY_ll(CLBCY(1), 1) -CALL SET_XRATIO_ll(1, 1) -CALL SET_YRATIO_ll(1, 1) -CALL SET_XOR_ll(1, 1) -CALL SET_XEND_ll(NIMAX_ll+2*JPHEXT, 1) -CALL SET_YOR_ll(1, 1) -CALL SET_YEND_ll(NJMAX_ll+2*JPHEXT, 1) -CALL SET_DAD_ll(0, 1) -CALL INI_PARAZ_ll(IINFO_ll) -! -! sizes of arrays of the extended sub-domain -! -CALL GET_DIM_EXT_ll('B',NIU,NJU) -CALL GET_DIM_PHYS_ll('B',NIMAX,NJMAX) -CALL GET_INDICE_ll(NIB,NJB,NIE,NJE) -CALL GET_OR_ll('B',IXOR,IYOR) -NKB=1+JPVEXT -NKU=NKMAX+2*JPVEXT -! -!* 4.3 Global variables absent from the modules : -! -ALLOCATE(XJ(NIU,NJU,NKU)) -SELECT CASE(CIDEAL) - CASE('RSOU','CSTN') - IF (LGEOSBAL) ALLOCATE(XCORIOZ(NIU,NJU,NKU)) ! exceptionally a 3D array - CASE DEFAULT ! undefined preinitialization - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','CIDEAL is not correctly defined') -END SELECT -! -!* 4.4 Prognostic variables at M instant (module MODD_FIELD1): -! -ALLOCATE(XUT(NIU,NJU,NKU)) -ALLOCATE(XVT(NIU,NJU,NKU)) -ALLOCATE(XWT(NIU,NJU,NKU)) -ALLOCATE(XTHT(NIU,NJU,NKU)) -ALLOCATE(XPABST(NIU,NJU,NKU)) -ALLOCATE(XRT(NIU,NJU,NKU,NRR)) -ALLOCATE(XSVT(NIU,NJU,NKU,NSV)) -! -!* 4.5 Grid variables (module MODD_GRID1 and MODD_METRICS1): -! -ALLOCATE(XMAP(NIU,NJU)) -ALLOCATE(XLAT(NIU,NJU)) -ALLOCATE(XLON(NIU,NJU)) -ALLOCATE(XDXHAT(NIU),XDYHAT(NJU)) -IF (LEN_TRIM(CPGD_FILE)==0) ALLOCATE(XZS(NIU,NJU)) -IF (LEN_TRIM(CPGD_FILE)==0) ALLOCATE(ZZS_ll(NIMAX_ll)) -IF (LEN_TRIM(CPGD_FILE)==0) ALLOCATE(XZSMT(NIU,NJU)) -ALLOCATE(XZZ(NIU,NJU,NKU)) -! -ALLOCATE(XDXX(NIU,NJU,NKU)) -ALLOCATE(XDYY(NIU,NJU,NKU)) -ALLOCATE(XDZX(NIU,NJU,NKU)) -ALLOCATE(XDZY(NIU,NJU,NKU)) -ALLOCATE(XDZZ(NIU,NJU,NKU)) -! -!* 4.6 Reference state variables (modules MODD_REF and MODD_REF1): -! -ALLOCATE(XRHODREFZ(NKU),XTHVREFZ(NKU)) -XTHVREFZ(:)=0.0 -IF (LCOUPLES) THEN - ! Arrays for reference state different in ocean and atmosphere - ALLOCATE(XRHODREFZO(NKU),XTHVREFZO(NKU)) - XTHVREFZO(:)=0.0 -END IF -IF(CEQNSYS == 'DUR') THEN - ALLOCATE(XRVREF(NIU,NJU,NKU)) -ELSE - ALLOCATE(XRVREF(0,0,0)) -END IF -ALLOCATE(XRHODREF(NIU,NJU,NKU),XTHVREF(NIU,NJU,NKU),XEXNREF(NIU,NJU,NKU)) -ALLOCATE(XRHODJ(NIU,NJU,NKU)) -! -!* 4.7 Larger Scale fields (modules MODD_LSFIELD1): -! -ALLOCATE(XLSUM(NIU,NJU,NKU)) -ALLOCATE(XLSVM(NIU,NJU,NKU)) -ALLOCATE(XLSWM(NIU,NJU,NKU)) -ALLOCATE(XLSTHM(NIU,NJU,NKU)) -IF ( NRR >= 1) THEN - ALLOCATE(XLSRVM(NIU,NJU,NKU)) -ELSE - ALLOCATE(XLSRVM(0,0,0)) -ENDIF -! -! allocate lateral boundary field used for coupling -! -IF ( L1D) THEN ! 1D case -! - NSIZELBX_ll=0 - NSIZELBXU_ll=0 - NSIZELBY_ll=0 - NSIZELBYV_ll=0 - NSIZELBXTKE_ll=0 - NSIZELBXR_ll=0 - NSIZELBXSV_ll=0 - NSIZELBYTKE_ll=0 - NSIZELBYR_ll=0 - NSIZELBYSV_ll=0 - ALLOCATE(XLBXUM(0,0,0)) - ALLOCATE(XLBYUM(0,0,0)) - ALLOCATE(XLBXVM(0,0,0)) - ALLOCATE(XLBYVM(0,0,0)) - ALLOCATE(XLBXWM(0,0,0)) - ALLOCATE(XLBYWM(0,0,0)) - ALLOCATE(XLBXTHM(0,0,0)) - ALLOCATE(XLBYTHM(0,0,0)) - ALLOCATE(XLBXTKEM(0,0,0)) - ALLOCATE(XLBYTKEM(0,0,0)) - ALLOCATE(XLBXRM(0,0,0,0)) - ALLOCATE(XLBYRM(0,0,0,0)) - ALLOCATE(XLBXSVM(0,0,0,0)) - ALLOCATE(XLBYSVM(0,0,0,0)) -! -ELSEIF( L2D ) THEN ! 2D case (not yet parallelized) -! - CALL GET_SIZEX_LB(NIMAX_ll,NJMAX_ll,NRIMX, & - IISIZEXF,IJSIZEXF,IISIZEXFU,IJSIZEXFU, & - IISIZEX4,IJSIZEX4,IISIZEX2,IJSIZEX2) - NSIZELBY_ll=0 - NSIZELBYV_ll=0 - NSIZELBYTKE_ll=0 - NSIZELBYR_ll=0 - NSIZELBYSV_ll=0 - ALLOCATE(XLBYUM(0,0,0)) - ALLOCATE(XLBYVM(0,0,0)) - ALLOCATE(XLBYWM(0,0,0)) - ALLOCATE(XLBYTHM(0,0,0)) - ALLOCATE(XLBYTKEM(0,0,0)) - ALLOCATE(XLBYRM(0,0,0,0)) - ALLOCATE(XLBYSVM(0,0,0,0)) - ! - IF ( LHORELAX_UVWTH ) THEN -!JUAN A REVOIR TODO_JPHEXT -! <<<<<<< prep_ideal_case.f90 - ! NSIZELBX_ll=2*NRIMX+2 - ! NSIZELBXU_ll=2*NRIMX+2 - ALLOCATE(XLBXUM(IISIZEXFU,NJU,NKU)) - ALLOCATE(XLBXVM(IISIZEXF,NJU,NKU)) - ALLOCATE(XLBXWM(IISIZEXF,NJU,NKU)) - ALLOCATE(XLBXTHM(IISIZEXF,NJU,NKU)) -! ======= - NSIZELBX_ll=2*NRIMX+2*JPHEXT - NSIZELBXU_ll=2*NRIMX+2*JPHEXT - ! ALLOCATE(XLBXUM(2*NRIMX+2*JPHEXT,NJU,NKU)) - ! ALLOCATE(XLBXVM(2*NRIMX+2*JPHEXT,NJU,NKU)) - ! ALLOCATE(XLBXWM(2*NRIMX+2*JPHEXT,NJU,NKU)) - ! ALLOCATE(XLBXTHM(2*NRIMX+2*JPHEXT,NJU,NKU)) -! >>>>>>> 1.3.2.4.2.3.2.14.2.8.2.11.2.2 - ELSE - NSIZELBX_ll= 2*JPHEXT ! 2 - NSIZELBXU_ll=2*(JPHEXT+1) ! 4 - ALLOCATE(XLBXUM(NSIZELBXU_ll,NJU,NKU)) - ALLOCATE(XLBXVM(NSIZELBX_ll,NJU,NKU)) - ALLOCATE(XLBXWM(NSIZELBX_ll,NJU,NKU)) - ALLOCATE(XLBXTHM(NSIZELBX_ll,NJU,NKU)) - END IF - ! - IF ( NRR > 0 ) THEN - IF ( LHORELAX_RV .OR. LHORELAX_RC .OR. LHORELAX_RR .OR. LHORELAX_RI & - .OR. LHORELAX_RS .OR. LHORELAX_RG .OR. LHORELAX_RH & - ) THEN -!JUAN A REVOIR TODO_JPHEXT -! <<<<<<< prep_ideal_case.f90 - ! NSIZELBXR_ll=2* NRIMX+2 - ALLOCATE(XLBXRM(IISIZEXF,NJU,NKU,NRR)) -! ======= - NSIZELBXR_ll=2*NRIMX+2*JPHEXT - ! ALLOCATE(XLBXRM(2*NRIMX+2*JPHEXT,NJU,NKU,NRR)) -! >>>>>>> 1.3.2.4.2.3.2.14.2.8.2.11.2.2 - ELSE - NSIZELBXR_ll=2*JPHEXT ! 2 - ALLOCATE(XLBXRM(NSIZELBXR_ll,NJU,NKU,NRR)) - ENDIF - ELSE - NSIZELBXR_ll=0 - ALLOCATE(XLBXRM(0,0,0,0)) - END IF - ! - IF ( NSV > 0 ) THEN - IF ( ANY( LHORELAX_SV(:)) ) THEN -!JUAN A REVOIR TODO_JPHEXT -! <<<<<<< prep_ideal_case.f90 - ! NSIZELBXSV_ll=2* NRIMX+2 - ALLOCATE(XLBXSVM(IISIZEXF,NJU,NKU,NSV)) -! ======= - NSIZELBXSV_ll=2*NRIMX+2*JPHEXT - ! ALLOCATE(XLBXSVM(2*NRIMX+2*JPHEXT,NJU,NKU,NSV)) -! >>>>>>> 1.3.2.4.2.3.2.14.2.8.2.11.2.2 - ELSE - NSIZELBXSV_ll=2*JPHEXT ! 2 - ALLOCATE(XLBXSVM(NSIZELBXSV_ll,NJU,NKU,NSV)) - END IF - ELSE - NSIZELBXSV_ll=0 - ALLOCATE(XLBXSVM(0,0,0,0)) - END IF -! -ELSE ! 3D case -! - CALL GET_SIZEX_LB(NIMAX_ll,NJMAX_ll,NRIMX, & - IISIZEXF,IJSIZEXF,IISIZEXFU,IJSIZEXFU, & - IISIZEX4,IJSIZEX4,IISIZEX2,IJSIZEX2) - CALL GET_SIZEY_LB(NIMAX_ll,NJMAX_ll,NRIMY, & - IISIZEYF,IJSIZEYF,IISIZEYFV,IJSIZEYFV, & - IISIZEY4,IJSIZEY4,IISIZEY2,IJSIZEY2) -! - IF ( LHORELAX_UVWTH ) THEN - NSIZELBX_ll=2*NRIMX+2*JPHEXT - NSIZELBXU_ll=2*NRIMX+2*JPHEXT - NSIZELBY_ll=2*NRIMY+2*JPHEXT - NSIZELBYV_ll=2*NRIMY+2*JPHEXT - ALLOCATE(XLBXUM(IISIZEXFU,IJSIZEXFU,NKU)) - ALLOCATE(XLBYUM(IISIZEYF,IJSIZEYF,NKU)) - ALLOCATE(XLBXVM(IISIZEXF,IJSIZEXF,NKU)) - ALLOCATE(XLBYVM(IISIZEYFV,IJSIZEYFV,NKU)) - ALLOCATE(XLBXWM(IISIZEXF,IJSIZEXF,NKU)) - ALLOCATE(XLBYWM(IISIZEYF,IJSIZEYF,NKU)) - ALLOCATE(XLBXTHM(IISIZEXF,IJSIZEXF,NKU)) - ALLOCATE(XLBYTHM(IISIZEYF,IJSIZEYF,NKU)) - ELSE - NSIZELBX_ll=2*JPHEXT ! 2 - NSIZELBXU_ll=2*(JPHEXT+1) ! 4 - NSIZELBY_ll=2*JPHEXT ! 2 - NSIZELBYV_ll=2*(JPHEXT+1) ! 4 - ALLOCATE(XLBXUM(IISIZEX4,IJSIZEX4,NKU)) - ALLOCATE(XLBYUM(IISIZEY2,IJSIZEY2,NKU)) - ALLOCATE(XLBXVM(IISIZEX2,IJSIZEX2,NKU)) - ALLOCATE(XLBYVM(IISIZEY4,IJSIZEY4,NKU)) - ALLOCATE(XLBXWM(IISIZEX2,IJSIZEX2,NKU)) - ALLOCATE(XLBYWM(IISIZEY2,IJSIZEY2,NKU)) - ALLOCATE(XLBXTHM(IISIZEX2,IJSIZEX2,NKU)) - ALLOCATE(XLBYTHM(IISIZEY2,IJSIZEY2,NKU)) - END IF - ! - IF ( NRR > 0 ) THEN - IF ( LHORELAX_RV .OR. LHORELAX_RC .OR. LHORELAX_RR .OR. LHORELAX_RI & - .OR. LHORELAX_RS .OR. LHORELAX_RG .OR. LHORELAX_RH & - ) THEN - NSIZELBXR_ll=2*NRIMX+2*JPHEXT - NSIZELBYR_ll=2*NRIMY+2*JPHEXT - ALLOCATE(XLBXRM(IISIZEXF,IJSIZEXF,NKU,NRR)) - ALLOCATE(XLBYRM(IISIZEYF,IJSIZEYF,NKU,NRR)) - ELSE - NSIZELBXR_ll=2*JPHEXT ! 2 - NSIZELBYR_ll=2*JPHEXT ! 2 - ALLOCATE(XLBXRM(IISIZEX2,IJSIZEX2,NKU,NRR)) - ALLOCATE(XLBYRM(IISIZEY2,IJSIZEY2,NKU,NRR)) - ENDIF - ELSE - NSIZELBXR_ll=0 - NSIZELBYR_ll=0 - ALLOCATE(XLBXRM(0,0,0,0)) - ALLOCATE(XLBYRM(0,0,0,0)) - END IF - ! - IF ( NSV > 0 ) THEN - IF ( ANY( LHORELAX_SV(:)) ) THEN - NSIZELBXSV_ll=2*NRIMX+2*JPHEXT - NSIZELBYSV_ll=2*NRIMY+2*JPHEXT - ALLOCATE(XLBXSVM(IISIZEXF,IJSIZEXF,NKU,NSV)) - ALLOCATE(XLBYSVM(IISIZEYF,IJSIZEYF,NKU,NSV)) - ELSE - NSIZELBXSV_ll=2*JPHEXT ! 2 - NSIZELBYSV_ll=2*JPHEXT ! 2 - ALLOCATE(XLBXSVM(IISIZEX2,IJSIZEX2,NKU,NSV)) - ALLOCATE(XLBYSVM(IISIZEY2,IJSIZEY2,NKU,NSV)) - END IF - ELSE - NSIZELBXSV_ll=0 - NSIZELBYSV_ll=0 - ALLOCATE(XLBXSVM(0,0,0,0)) - ALLOCATE(XLBYSVM(0,0,0,0)) - END IF -END IF -! -! -!------------------------------------------------------------------------------- -! -!* 5. INITIALIZE ALL THE MODEL VARIABLES -! ---------------------------------- -! -! -!* 5.1 Grid variables and RS localization: -! -!* 5.1.1 Horizontal Spatial grid : -! -IF( LEN_TRIM(CPGD_FILE) /= 0 ) THEN -!-------------------------------------------------------- -! the MESONH horizontal grid will be read in the PGD_FILE -!-------------------------------------------------------- - CALL READ_HGRID(1,TPGDFILE,YPGD_NAME,YPGD_DAD_NAME,YPGD_TYPE) -! control the cartesian option - IF( LCARTESIAN ) THEN - WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE : IN GENERAL, THE USE OF A PGD_FILE & - & IMPLIES THAT YOU MUST TAKE INTO ACCOUNT THE EARTH SPHERICITY' - WRITE(NLUOUT,FMT=*) 'NEVERTHELESS, LCARTESIAN HAS BEEN KEPT TO TRUE' - END IF -! -!* use of the externalized surface -! - CSURF = "EXTE" -! -! determine whether the model is flat or no -! - ZZS_MAX = ABS( MAXVAL(XZS(NIB:NIU-JPHEXT,NJB:NJU-JPHEXT))) - CALL MPI_ALLREDUCE(ZZS_MAX, ZZS_MAX_ll, 1, MNHREAL_MPI, MPI_MAX, & - NMNH_COMM_WORLD,IINFO_ll) - IF( ABS(ZZS_MAX_ll) < 1.E-10 ) THEN - LFLAT=.TRUE. - ELSE - LFLAT=.FALSE. - END IF -! - -ELSE -!------------------------------------------------------------------------ -! the MESONH horizontal grid is built from the PRE_IDEA1.nam informations -!------------------------------------------------------------------------ -! - ALLOCATE(XXHAT(NIU),XYHAT(NJU)) -! -! define the grid localization at the earth surface by the central point -! coordinates -! - IF (XLONCEN/=XUNDEF .OR. XLATCEN/=XUNDEF) THEN - IF (XLONCEN/=XUNDEF .AND. XLATCEN/=XUNDEF) THEN -! -! it should be noted that XLATCEN and XLONCEN refer to a vertical -! vorticity point and (XLATORI, XLONORI) refer to the mass point of -! conformal coordinates (0,0). This is to allow the centering of the model in -! a non-cyclic configuration regarding to XLATCEN or XLONCEN. -! - ALLOCATE(ZXHAT_ll(NIMAX_ll+2*JPHEXT),ZYHAT_ll(NJMAX_ll+2*JPHEXT)) - ZXHAT_ll=0. - ZYHAT_ll=0. - CALL SM_LATLON(XLATCEN,XLONCEN, & - -XDELTAX*(NIMAX_ll/2-0.5+JPHEXT), & - -XDELTAY*(NJMAX_ll/2-0.5+JPHEXT), & - XLATORI,XLONORI) - DEALLOCATE(ZXHAT_ll,ZYHAT_ll) -! - WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE : XLATORI=' , XLATORI, & - ' XLONORI= ', XLONORI - ELSE - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE',& - 'latitude and longitude of the center point must be initialized alltogether or not') - END IF - END IF -! - IF (NPROC > 1) THEN - CALL GET_DIM_EXT_ll('B',IXDIM,IYDIM) - IBEG = IXOR-JPHEXT-1 - IEND = IBEG+IXDIM-1 - XXHAT(:) = (/ (REAL(JLOOP)*XDELTAX, JLOOP=IBEG,IEND) /) - IBEG = IYOR-JPHEXT-1 - IEND = IBEG+IYDIM-1 - XYHAT(:) = (/ (REAL(JLOOP)*XDELTAY, JLOOP=IBEG,IEND) /) -! - ELSE - XXHAT(:) = (/ (REAL(JLOOP-NIB)*XDELTAX, JLOOP=1,NIU) /) - XYHAT(:) = (/ (REAL(JLOOP-NJB)*XDELTAY, JLOOP=1,NJU) /) - END IF -END IF -! -!* 5.1.2 Orography and Gal-Chen Sommerville transformation : -! -IF ( LEN_TRIM(CPGD_FILE) == 0 .OR. .NOT. LREAD_ZS) THEN - SELECT CASE(CZS) ! 'FLAT' or 'SINE' or 'BELL' - CASE('FLAT') - LFLAT = .TRUE. - IF (XHMAX==XUNDEF) THEN - XZS(:,:) = 0. - ELSE - XZS(:,:) = XHMAX - END IF - CASE('SINE') ! sinus-shaped orography - IF (XHMAX==XUNDEF) XHMAX=300. - LFLAT =.FALSE. - XZS(:,:) = XHMAX & ! three-dimensional case - *SPREAD((/((SIN((XPI/(NIMAX_ll+2*JPHEXT-1))*JLOOP)**2)**NEXPX,JLOOP=IXOR-1,IXOR+NIU-2)/),2,NJU) & - *SPREAD((/((SIN((XPI/(NJMAX_ll+2*JPHEXT-1))*JLOOP)**2)**NEXPY,JLOOP=IYOR-1,IYOR+NJU-2)/),1,NIU) - IF(L1D) THEN ! one-dimensional case - XZS(:,:) = XHMAX - END IF - CASE('BELL') ! bell-shaped orography - IF (XHMAX==XUNDEF) XHMAX=300. - LFLAT = .FALSE. - IF(.NOT.L2D) THEN ! three-dimensional case - XZS(:,:) = XHMAX / ( 1. & - + ( (SPREAD(XXHAT(1:NIU),2,NJU) - REAL(NIZS) * XDELTAX) /XAX ) **2 & - + ( (SPREAD(XYHAT(1:NJU),1,NIU) - REAL(NJZS) * XDELTAY) /XAY ) **2 ) **1.5 - ELSE ! two-dimensional case - XZS(:,:) = XHMAX / ( 1. & - + ( (SPREAD(XXHAT(1:NIU),2,NJU) - REAL(NIZS) * XDELTAX) /XAX ) **2 ) - ENDIF - IF(L1D) THEN ! one-dimensional case - XZS(:,:) = XHMAX - END IF - CASE('COSI') ! (1+cosine)**4 shape - IF (XHMAX==XUNDEF) XHMAX=800. - LFLAT = .FALSE. - IF(L2D) THEN ! two-dimensional case - DO JILOOP = 1, NIU - ZDIST = XXHAT(JILOOP)-REAL(NIZS)*XDELTAX - IF( ABS(ZDIST)<(4.0*XAX) ) THEN - XZS(JILOOP,:) = (XHMAX/16.0)*( 1.0 + COS((XPI*ZDIST)/(4.0*XAX)) )**4 - ELSE - XZS(JILOOP,:) = 0.0 - ENDIF - END DO - ENDIF - CASE('SCHA') ! exp(-(x/a)**2)*cosine(pi*x/lambda)**2 shape - IF (XHMAX==XUNDEF) XHMAX=800. - LFLAT = .FALSE. - IF(L2D) THEN ! two-dimensional case - DO JILOOP = 1, NIU - ZDIST = XXHAT(JILOOP)-REAL(NIZS)*XDELTAX - IF( ABS(ZDIST)<(4.0*XAX) ) THEN - XZS(JILOOP,:) = XHMAX*EXP(-(ZDIST/XAY)**2)*COS((XPI*ZDIST)/XAX)**2 - ELSE - XZS(JILOOP,:) = 0.0 - ENDIF - END DO - ENDIF - CASE('AGNE') ! h*a**2/(x**2+a**2) shape - LFLAT = .FALSE. - IF(L2D) THEN ! two-dimensional case - DO JILOOP = 1, NIU - ZDIST = XXHAT(JILOOP)-REAL(NIZS)*XDELTAX - XZS(JILOOP,:) = XHMAX*(XAX**2)/(XAX**2+ZDIST**2) - END DO - ELSE ! three dimensionnal case - infinite profile in y direction - DO JILOOP = 1, NIU - ZDIST = XXHAT(JILOOP)-REAL(NIZS)*XDELTAX - XZS(JILOOP,:) = XHMAX*(XAX**2)/(XAX**2+ZDIST**2) - END DO - ENDIF - - CASE('DATA') ! discretized orography - LFLAT =.FALSE. - WRITE(NLUOUT,FMT=*) 'CZS="DATA", ATTEMPT TO READ ARRAY & - &XZS(NIB:NIU-JPHEXT:1,NJU-JPHEXT:NJB:-1) & - &starting from the first index' - CALL POSKEY(NLUPRE,NLUOUT,'ZSDATA') - DO JJLOOP = NJMAX_ll+2*JPHEXT-1,JPHEXT+1,-1 ! input like a map prior the sounding - READ(NLUPRE,FMT=*) ZZS_ll - IF ( ( JJLOOP <= ( NJU-JPHEXT + IYOR-1 ) ) .AND. ( JJLOOP >= ( NJB + IYOR-1 ) ) ) THEN - IJ = JJLOOP - ( IYOR-1 ) - XZS(NIB:NIU-JPHEXT,IJ) = ZZS_ll(IXOR:IXOR + NIU-JPHEXT - NIB ) - END IF - END DO -! - CASE DEFAULT ! undefined shape of orography - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','erroneous ground type') - END SELECT -! - CALL ADD2DFIELD_ll( TZ_FIELDS_ll, XZS, 'PREP_IDEAL_CASE::XZS' ) - CALL UPDATE_HALO_ll(TZ_FIELDS_ll,IINFO_ll) - CALL CLEANLIST_ll(TZ_FIELDS_ll) -! -END IF -! -!IF( ( LEN_TRIM(CPGD_FILE) /= 0 ) .AND. .NOT.LFLAT .AND. & -! ((CLBCX(1) /= "OPEN" ) .OR. & -! (CLBCX(2) /= "OPEN" ) .OR. (CLBCY(1) /= "OPEN" ) .OR. & -! (CLBCY(2) /= "OPEN" )) ) THEN -! !callabortstop -! CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','with a PGD file, you cannot be in a cyclic LBC') -!END IF -! -IF (LWEST_ll()) THEN - DO JILOOP = 1,JPHEXT - XZS(JILOOP,:) = XZS(NIB,:) - END DO -END IF -IF (LEAST_ll()) THEN - DO JILOOP = NIU-JPHEXT+1,NIU - XZS(JILOOP,:)=XZS(NIU-JPHEXT,:) - END DO -END IF -IF (LSOUTH_ll()) THEN - DO JJLOOP = 1,JPHEXT - XZS(:,JJLOOP)=XZS(:,NJB) - END DO -END IF -IF (LNORTH_ll()) THEN - DO JJLOOP =NJU-JPHEXT+1,NJU - XZS(:,JJLOOP)=XZS(:,NJU-JPHEXT) - END DO -END IF -! -IF ( LEN_TRIM(CPGD_FILE) == 0 .OR. .NOT. LREAD_ZS) THEN - IF (LSLEVE) THEN - CALL ZSMT_PIC(NSLEVE,XSMOOTH_ZS) - ELSE - XZSMT(:,:) = 0. - END IF -END IF -! -IF (LCARTESIAN) THEN - CALL SM_GRIDCART(XXHAT,XYHAT,XZHAT,XZS,LSLEVE,XLEN1,XLEN2,XZSMT,XDXHAT,XDYHAT,XZZ,XJ) - XMAP=1. -ELSE - CALL SM_GRIDPROJ(XXHAT,XYHAT,XZHAT,XZS,LSLEVE,XLEN1,XLEN2,XZSMT,XLATORI,XLONORI, & - XMAP,XLAT,XLON,XDXHAT,XDYHAT,XZZ,XJ) -END IF -!* 5.4.1 metrics coefficients and update halos: -! -CALL METRICS(XMAP,XDXHAT,XDYHAT,XZZ,XDXX,XDYY,XDZX,XDZY,XDZZ) -! -CALL UPDATE_METRICS(CLBCX,CLBCY,XDXX,XDYY,XDZX,XDZY,XDZZ) -! -!* 5.1.3 Compute the localization in index space of the vertical profile -! in CSTN and RSOU cases : -! -IF (CTYPELOC =='LATLON' ) THEN - IF (.NOT.LCARTESIAN) THEN ! compute (x,y) if - CALL SM_XYHAT(XLATORI,XLONORI, & ! the localization - XLATLOC,XLONLOC,XXHATLOC,XYHATLOC) ! is given in latitude - ELSE ! and longitude - WRITE(NLUOUT,FMT=*) 'CTYPELOC CANNOT BE LATLON IN CARTESIAN GEOMETRY' - WRITE(NLUOUT,FMT=*) '-> JOB ABORTED' - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','CTYPELOC cannot be LATLON in cartesian geometry') - END IF -END IF -! -ALLOCATE(ZXHAT_ll(NIMAX_ll+ 2 * JPHEXT),ZYHAT_ll(NJMAX_ll+2 * JPHEXT)) -CALL GATHERALL_FIELD_ll('XX',XXHAT,ZXHAT_ll,NRESP) !// -CALL GATHERALL_FIELD_ll('YY',XYHAT,ZYHAT_ll,NRESP) !// -IF (CTYPELOC /= 'IJGRID') THEN - NILOC = MINLOC(ABS(XXHATLOC-ZXHAT_ll(:))) - NJLOC = MINLOC(ABS(XYHATLOC-ZYHAT_ll(:))) -END IF -! -IF ( L1D .AND. ( NILOC(1) /= 1 .OR. NJLOC(1) /= 1 ) ) THEN - NILOC = 1 - NJLOC = 1 - WRITE(NLUOUT,FMT=*) 'FOR 1D CONFIGURATION, THE RS INFORMATIONS ARE TAKEN AT & - & I=1 AND J=1 (CENTRAL VERTICAL WITHOUT HALO)' -END IF -! -IF ( L2D .AND. ( NJLOC(1) /= 1 ) ) THEN - NJLOC = 1 - WRITE(NLUOUT,FMT=*) 'FOR 2D CONFIGURATION, THE RS INFORMATIONS ARE TAKEN AT & - & J=1 (CENTRAL PLANE WITHOUT HALO)' -END IF -! -!* 5.2 Prognostic variables (not multiplied by rhoJ) : u,v,w,theta,r -! and 1D anelastic reference state -! -! -!* 5.2.1 Use a Radiosounding : CIDEAL='RSOU'' -! -IF (CIDEAL == 'RSOU') THEN - WRITE(NLUOUT,FMT=*) 'CIDEAL="RSOU", attempt to read DATE' - CALL POSKEY(NLUPRE,NLUOUT,'RSOU') - READ(NLUPRE,FMT=*) NYEAR,NMONTH,NDAY,XTIME - TDTCUR = DATE_TIME(DATE(NYEAR,NMONTH,NDAY),XTIME) - TDTEXP = TDTCUR - TDTSEG = TDTCUR - TDTMOD = TDTCUR - WRITE(NLUOUT,FMT=*) 'CIDEAL="RSOU", ATTEMPT TO PROCESS THE SOUNDING DATA' - IF (LGEOSBAL) THEN - CALL SET_RSOU(TFILE_DUMMY,TZEXPREFILE,CFUNU,CFUNV,NILOC(1),NJLOC(1),LBOUSS, & - XJ,LSHIFT,XCORIOZ) - ELSE - CALL SET_RSOU(TFILE_DUMMY,TZEXPREFILE,CFUNU,CFUNV,NILOC(1),NJLOC(1),LBOUSS, & - XJ,LSHIFT) - END IF -! -!* 5.2.2 N=cste and U(z) : CIDEAL='CSTN' -! -ELSE IF (CIDEAL == 'CSTN') THEN - WRITE(NLUOUT,FMT=*) 'CIDEAL="CSTN", attempt to read DATE' - CALL POSKEY(NLUPRE,NLUOUT,'CSTN') - READ(NLUPRE,FMT=*) NYEAR,NMONTH,NDAY,XTIME - TDTCUR = DATE_TIME(DATE(NYEAR,NMONTH,NDAY),XTIME) - TDTEXP = TDTCUR - TDTSEG = TDTCUR - TDTMOD = TDTCUR - WRITE(NLUOUT,FMT=*) 'CIDEAL="CSTN", ATTEMPT TO PROCESS THE SOUNDING DATA' - IF (LGEOSBAL) THEN - CALL SET_CSTN(TFILE_DUMMY,TZEXPREFILE,CFUNU,CFUNV,NILOC(1),NJLOC(1),LBOUSS, & - XJ,LSHIFT,XCORIOZ) - ELSE - CALL SET_CSTN(TFILE_DUMMY,TZEXPREFILE,CFUNU,CFUNV,NILOC(1),NJLOC(1),LBOUSS, & - XJ,LSHIFT) - END IF -! -END IF -! -!* 5.3 Forcing variables -! -IF (LFORCING) THEN - WRITE(NLUOUT,FMT=*) 'FORCING IS ENABLED, ATTEMPT TO SET FORCING FIELDS' - CALL POSKEY(NLUPRE,NLUOUT,'ZFRC ','PFRC') - CALL SET_FRC(TZEXPREFILE) -END IF -! -!! --------------------------------------------------------------------- -! Modif PP ADV FRC -! 5.4.2 initialize profiles for adv forcings -IF (L2D_ADV_FRC) THEN - WRITE(NLUOUT,FMT=*) 'L2D_ADV_FRC IS SET TO TRUE' - WRITE(NLUOUT,FMT=*) 'ADVECTING FORCING USED IS USER MADE, NOT STANDARD ONE ' - WRITE(NLUOUT,FMT=*) 'IT IS FOR 2D IDEALIZED WAM STUDY ONLY ' - CALL POSKEY(NLUPRE,NLUOUT,'ZFRC_ADV') - CALL SET_ADVFRC(TZEXPREFILE) -ENDIF -IF (L2D_REL_FRC) THEN - WRITE(NLUOUT,FMT=*) 'L2D_REL_FRC IS SET TO TRUE' - WRITE(NLUOUT,FMT=*) 'RELAXATION FORCING USED IS USER MADE, NOT STANDARD ONE ' - WRITE(NLUOUT,FMT=*) 'IT IS FOR 2D IDEALIZED WAM STUDY ONLY ' - CALL POSKEY(NLUPRE,NLUOUT,'ZFRC_REL') - CALL SET_RELFRC(TZEXPREFILE) -ENDIF -!* 5.4 3D Reference state variables : -! -! -!* 5.4.1 metrics coefficients and update halos: -! -CALL METRICS(XMAP,XDXHAT,XDYHAT,XZZ,XDXX,XDYY,XDZX,XDZY,XDZZ) -! -CALL UPDATE_METRICS(CLBCX,CLBCY,XDXX,XDYY,XDZX,XDZY,XDZZ) -! -!* 5.4.2 3D reference state : -! -CALL SET_REF(0,TFILE_DUMMY, & - XZZ,XZHAT,XJ,XDXX,XDYY,CLBCX,CLBCY, & - XREFMASS,XMASS_O_PHI0,XLINMASS, & - XRHODREF,XTHVREF,XRVREF,XEXNREF,XRHODJ) -! -! -!* 5.5.1 Absolute pressure : -! -! -!* 5.5.2 Total mass of dry air Md computation : -! -CALL TOTAL_DMASS(XJ,XRHODREF,XDRYMASST) -! -! -!* 5.6 Complete prognostic variables (multipliy by rhoJ) at time t : -! -! U grid : gridpoint 2 -IF (LWEST_ll()) XUT(1,:,:) = 2.*XUT(2,:,:) - XUT(3,:,:) -! V grid : gridpoint 3 -IF (LSOUTH_ll()) XVT(:,1,:) = 2.*XVT(:,2,:) - XVT(:,3,:) -! SV : gridpoint 1 -XSVT(:,:,:,:) = 0. -! -! -!* 5.7 Larger scale fields initialization : -! -XLSUM(:,:,:) = XUT(:,:,:) ! these fields do not satisfy the -XLSVM(:,:,:) = XVT(:,:,:) ! lower boundary condition but are -XLSWM(:,:,:) = XWT(:,:,:) ! in equilibrium -XLSTHM(:,:,:)= XTHT(:,:,:) -XLSRVM(:,:,:)= XRT(:,:,:,1) -! -! enforce the vertical homogeneity under the ground and above the top of -! the model for the LS fields -! -XLSUM(:,:,NKB-1)=XLSUM(:,:,NKB) -XLSUM(:,:,NKU)=XLSUM(:,:,NKU-1) -XLSVM(:,:,NKB-1)=XLSVM(:,:,NKB) -XLSVM(:,:,NKU)=XLSVM(:,:,NKU-1) -XLSWM(:,:,NKB-1)=XLSWM(:,:,NKB) -XLSWM(:,:,NKU)=XLSWM(:,:,NKU-1) -XLSTHM(:,:,NKB-1)=XLSTHM(:,:,NKB) -XLSTHM(:,:,NKU)=XLSTHM(:,:,NKU-1) -IF ( NRR > 0 ) THEN - XLSRVM(:,:,NKB-1)=XLSRVM(:,:,NKB) - XLSRVM(:,:,NKU)=XLSRVM(:,:,NKU-1) -END IF -! -ILBX=SIZE(XLBXUM,1) -ILBY=SIZE(XLBYUM,2) -IF(LWEST_ll() .AND. .NOT. L1D) THEN - XLBXUM(1:NRIMX+JPHEXT, :,:) = XUT(2:NRIMX+JPHEXT+1, :,:) - XLBXVM(1:NRIMX+JPHEXT, :,:) = XVT(1:NRIMX+JPHEXT, :,:) - XLBXWM(1:NRIMX+JPHEXT, :,:) = XWT(1:NRIMX+JPHEXT, :,:) - XLBXTHM(1:NRIMX+JPHEXT, :,:) = XTHT(1:NRIMX+JPHEXT, :,:) - XLBXRM(1:NRIMX+JPHEXT, :,:,:) = XRT(1:NRIMX+JPHEXT, :,:,:) -ENDIF -IF(LEAST_ll() .AND. .NOT. L1D) THEN - XLBXUM(ILBX-NRIMX-JPHEXT+1:ILBX,:,:) = XUT(NIU-NRIMX-JPHEXT+1:NIU, :,:) - XLBXVM(ILBX-NRIMX-JPHEXT+1:ILBX,:,:) = XVT(NIU-NRIMX-JPHEXT+1:NIU, :,:) - XLBXWM(ILBX-NRIMX-JPHEXT+1:ILBX,:,:) = XWT(NIU-NRIMX-JPHEXT+1:NIU, :,:) - XLBXTHM(ILBX-NRIMX-JPHEXT+1:ILBX,:,:) = XTHT(NIU-NRIMX-JPHEXT+1:NIU, :,:) - XLBXRM(ILBX-NRIMX-JPHEXT+1:ILBX,:,:,:) = XRT(NIU-NRIMX-JPHEXT+1:NIU, :,:,:) -ENDIF -IF(LSOUTH_ll() .AND. .NOT. L1D .AND. .NOT. L2D) THEN - XLBYUM(:,1:NRIMY+JPHEXT, :) = XUT(:,1:NRIMY+JPHEXT, :) - XLBYVM(:,1:NRIMY+JPHEXT, :) = XVT(:,2:NRIMY+JPHEXT+1, :) - XLBYWM(:,1:NRIMY+JPHEXT, :) = XWT(:,1:NRIMY+JPHEXT, :) - XLBYTHM(:,1:NRIMY+JPHEXT, :) = XTHT(:,1:NRIMY+JPHEXT, :) - XLBYRM(:,1:NRIMY+JPHEXT, :,:) = XRT(:,1:NRIMY+JPHEXT, :,:) -ENDIF -IF(LNORTH_ll().AND. .NOT. L1D .AND. .NOT. L2D) THEN - XLBYUM(:,ILBY-NRIMY-JPHEXT+1:ILBY,:) = XUT(:,NJU-NRIMY-JPHEXT+1:NJU, :) - XLBYVM(:,ILBY-NRIMY-JPHEXT+1:ILBY,:) = XVT(:,NJU-NRIMY-JPHEXT+1:NJU, :) - XLBYWM(:,ILBY-NRIMY-JPHEXT+1:ILBY,:) = XWT(:,NJU-NRIMY-JPHEXT+1:NJU, :) - XLBYTHM(:,ILBY-NRIMY-JPHEXT+1:ILBY,:) = XTHT(:,NJU-NRIMY-JPHEXT+1:NJU, :) - XLBYRM(:,ILBY-NRIMY-JPHEXT+1:ILBY,:,:) = XRT(:,NJU-NRIMY-JPHEXT+1:NJU, :,:) -ENDIF -DO JSV = 1, NSV - IF(LWEST_ll() .AND. .NOT. L1D) & - XLBXSVM(1:NRIMX+JPHEXT, :,:,JSV) = XSVT(1:NRIMX+JPHEXT, :,:,JSV) - IF(LEAST_ll() .AND. .NOT. L1D) & - XLBXSVM(ILBX-NRIMX-JPHEXT+1:ILBX,:,:,JSV) = XSVT(NIU-NRIMX-JPHEXT+1:NIU, :,:,JSV) - IF(LSOUTH_ll() .AND. .NOT. L1D .AND. .NOT. L2D) & - XLBYSVM(:,1:NRIMY+JPHEXT, :,JSV) = XSVT(:,1:NRIMY+JPHEXT, :,JSV) - IF(LNORTH_ll() .AND. .NOT. L1D .AND. .NOT. L2D) & - XLBYSVM(:,ILBY-NRIMY-JPHEXT+1:ILBY,:,JSV) = XSVT(:,NJU-NRIMY-JPHEXT+1:NJU, :,JSV) -END DO -! -! -!* 5.8 Add a perturbation to a basic state : -! -IF(LPERTURB) CALL SET_PERTURB(TZEXPREFILE) -! -! -!* 5.9 Anelastic correction and pressure: -! -IF (.NOT.LOCEAN) THEN - CALL ICE_ADJUST_BIS(XPABST,XTHT,XRT) - IF ( .NOT. L1D ) CALL PRESSURE_IN_PREP(XDXX,XDYY,XDZX,XDZY,XDZZ) - CALL ICE_ADJUST_BIS(XPABST,XTHT,XRT) -END IF -! -! -!* 5.10 Compute THETA, vapor and cloud mixing ratio -! -IF (CIDEAL == 'RSOU') THEN - ALLOCATE(ZEXN(NIU,NJU,NKU)) - ALLOCATE(ZT(NIU,NJU,NKU)) - ALLOCATE(ZTHL(NIU,NJU,NKU)) - ALLOCATE(ZRT(NIU,NJU,NKU)) - ALLOCATE(ZCPH(NIU,NJU,NKU)) - ALLOCATE(ZLVOCPEXN(NIU,NJU,NKU)) - ALLOCATE(ZLSOCPEXN(NIU,NJU,NKU)) - ALLOCATE(ZFRAC_ICE(NIU,NJU,NKU)) - ALLOCATE(ZRSATW(NIU,NJU,NKU)) - ALLOCATE(ZRSATI(NIU,NJU,NKU)) - ZRT=XRT(:,:,:,1)+XRT(:,:,:,2)+XRT(:,:,:,4) -IF (LOCEAN) THEN - ZEXN(:,:,:)= 1. - ZT=XTHT - ZTHL=XTHT - ZCPH=XCPD+ XCPV * XRT(:,:,:,1) - ZLVOCPEXN = XLVTT - ZLSOCPEXN = XLSTT -ELSE - ZEXN=(XPABST/XP00) ** (XRD/XCPD) - ZT=XTHT*(XPABST/XP00)**(XRD/XCPD) - ZCPH=XCPD+ XCPV * XRT(:,:,:,1)+ XCL *XRT(:,:,:,2) + XCI * XRT(:,:,:,4) - ZLVOCPEXN = (XLVTT + (XCPV-XCL) * (ZT-XTT))/(ZCPH*ZEXN) - ZLSOCPEXN = (XLSTT + (XCPV-XCI) * (ZT-XTT))/(ZCPH*ZEXN) - ZTHL=XTHT-ZLVOCPEXN*XRT(:,:,:,2)-ZLSOCPEXN*XRT(:,:,:,4) - CALL TH_R_FROM_THL_RT_3D('T',ZFRAC_ICE,XPABST,ZTHL,ZRT,XTHT,XRT(:,:,:,1), & - XRT(:,:,:,2),XRT(:,:,:,4),ZRSATW, ZRSATI) -END IF - DEALLOCATE(ZEXN) - DEALLOCATE(ZT) - DEALLOCATE(ZCPH) - DEALLOCATE(ZLVOCPEXN) - DEALLOCATE(ZLSOCPEXN) - DEALLOCATE(ZTHL) - DEALLOCATE(ZRT) -! Coherence test - IF ((.NOT. LUSERI) ) THEN - IF (MAXVAL(XRT(:,:,:,4))/= 0) THEN - WRITE(NLUOUT,FMT=*) "*********************************" - WRITE(NLUOUT,FMT=*) 'WARNING' - WRITE(NLUOUT,FMT=*) 'YOU HAVE LUSERI=FALSE ' - WRITE(NLUOUT,FMT=*) ' BUT WITH YOUR RADIOSOUNDING Ri/=0' - WRITE(NLUOUT,FMT=*) MINVAL(XRT(:,:,:,4)),MAXVAL(XRT(:,:,:,4)) - WRITE(NLUOUT,FMT=*) "*********************************" - ENDIF - ENDIF - IF ((.NOT. LUSERC)) THEN - IF (MAXVAL(XRT(:,:,:,2))/= 0) THEN - WRITE(NLUOUT,FMT=*) "*********************************" - WRITE(NLUOUT,FMT=*) 'WARNING' - WRITE(NLUOUT,FMT=*) 'YOU HAVE LUSERC=FALSE ' - WRITE(NLUOUT,FMT=*) 'BUT WITH YOUR RADIOSOUNDING RC/=0' - WRITE(NLUOUT,FMT=*) MINVAL(XRT(:,:,:,2)),MAXVAL(XRT(:,:,:,2)) - WRITE(NLUOUT,FMT=*) "*********************************" - ENDIF - ENDIF - ! on remet les bonnes valeurs pour NRR - IF(CCLOUD=='NONE') NRR=1 - IF(CCLOUD=='REVE') NRR=2 -END IF -! -!------------------------------------------------------------------------------- -! -!* 6. INITIALIZE SCALAR VARIABLES FOR CHEMISTRY -! ----------------------------------------- -! -! before calling chemistry -CCONF = 'START' -CSTORAGE_TYPE='TT' -CALL IO_File_close(TZEXPREFILE) ! Close the EXPRE file -! -IF ( LCH_INIT_FIELD ) CALL CH_INIT_FIELD_n(1, NLUOUT, NVERB) -! -!UPG*PT -! Initialization LIMA variables by ORILAM -IF (CCLOUD == 'LIMA' .AND. ((LORILAM).OR.(LDUST).OR.(LSALT))) & - CALL AER2LIMA(XSVT, XRHODREF, XRT(:,:,:,1), XPABST, XTHT, XZZ) -!UPG*PT -!------------------------------------------------------------------------------- -! -!* 7. INITIALIZE LEVELSET FOR IBM -! --------------------------- -! -IF (LIBM_LSF) THEN - ! - ! In their current state, the IBM can only be used in - ! combination with cartesian coordinates and flat orography. - ! - IF ((CZS.NE."FLAT").OR.(.NOT.LCARTESIAN)) THEN - CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','IBM can only be used with flat ground') - ENDIF - ! - ALLOCATE(XIBM_LS(NIU,NJU,NKU,4)) - ! - CALL IBM_INIT_LS(XIBM_LS) - ! -ENDIF -! -!------------------------------------------------------------------------------- -! -!* 8. WRITE THE FMFILE -! ---------------- -! -CALL SECOND_MNH2(ZTIME1) -! -NNPRAR = 22 + 2*(NRR+NSV) & ! 22 = number of grid variables + reference - + 8 + 17 ! state variables + dimension variables - ! 2*(8+NRR+NSV) + 1 = number of prognostic - ! variables at time t and t-dt -NTYPE=1 -! -CALL IO_File_add2list(TINIFILE,TRIM(CINIFILE),'MNH','WRITE',KLFINPRAR=NNPRAR,KLFITYPE=NTYPE,KLFIVERB=NVERB) -! -CALL IO_File_open(TINIFILE) -! -CALL IO_Header_write(TINIFILE) -! -CALL WRITE_DESFM_n(1,TINIFILE) -! -CALL WRITE_LFIFM_n(TINIFILE,'') ! There is no DAD model for PREP_IDEAL_CASE -! -CALL SECOND_MNH2(ZTIME2) -! -XT_STORE = XT_STORE + ZTIME2 - ZTIME1 -! -!------------------------------------------------------------------------------- -! -!* 9. EXTERNALIZED SURFACE -! -------------------- -! -! -IF (CSURF =='EXTE') THEN - IF (LEN_TRIM(CINIFILEPGD)==0) THEN - IF (LEN_TRIM(CPGD_FILE)/=0) THEN - CINIFILEPGD=CPGD_FILE - ELSE - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','CINIFILEPGD needed in NAM_LUNITn') - ENDIF - ENDIF - CALL SURFEX_ALLOC_LIST(1) - YSURF_CUR => YSURF_LIST(1) - CALL READ_ALL_NAMELISTS(YSURF_CUR,'MESONH','PRE',.FALSE.) - ! Switch to model 1 surface variables - CALL GOTO_SURFEX(1) - !* definition of physiographic fields - ! computed ... - IF (LEN_TRIM(CPGD_FILE)==0 .OR. .NOT. LREAD_GROUND_PARAM) THEN - TPGDFILE => TINIFILE - CALL PGD_GRID_SURF_ATM(YSURF_CUR%UG, YSURF_CUR%U,YSURF_CUR%GCP,'MESONH',TINIFILE%CNAME,'MESONH',.TRUE.,HDIR='-') - CALL PGD_SURF_ATM (YSURF_CUR,'MESONH',TINIFILE%CNAME,'MESONH',.TRUE.) - CALL IO_File_add2list(TINIFILEPGD,TRIM(CINIFILEPGD),'PGD','WRITE',KLFINPRAR=NNPRAR,KLFITYPE=NTYPE,KLFIVERB=NVERB) - CALL IO_File_open (TINIFILEPGD) - TPGDFILE => TINIFILEPGD - ELSE - ! ... or read from file. - CALL INIT_PGD_SURF_ATM( YSURF_CUR, 'MESONH', 'PGD', & - ' ', ' ', & - TDTCUR%nyear, TDTCUR%nmonth, & - TDTCUR%nday, TDTCUR%xtime ) -! - END IF - ! - !* forces orography from atmospheric file - IF (.NOT. LREAD_ZS) CALL MNHPUT_ZS_n - ! - ! on ecrit un nouveau fichier PGD que s'il n'existe pas - IF (LEN_TRIM(CPGD_FILE)==0 .OR. .NOT. LREAD_GROUND_PARAM) THEN - !* writing of physiographic fields in the file - CSTORAGE_TYPE='PG' - ! - CALL IO_Header_write(TINIFILEPGD) - CALL IO_Field_write(TINIFILEPGD,'JPHEXT', JPHEXT) - CALL IO_Field_write(TINIFILEPGD,'SURF','EXTE') - CALL IO_Field_write(TINIFILEPGD,'L1D', L1D) - CALL IO_Field_write(TINIFILEPGD,'L2D', L2D) - CALL IO_Field_write(TINIFILEPGD,'PACK',LPACK) - CALL WRITE_HGRID(1,TINIFILEPGD) - ! - TOUTDATAFILE => TINIFILEPGD - ! - TFILE_SURFEX => TINIFILEPGD - ALLOCATE(YSURF_CUR%DUO%CSELECT(0)) - CALL WRITE_PGD_SURF_ATM_n(YSURF_CUR,'MESONH') - NULLIFY(TFILE_SURFEX) - CSTORAGE_TYPE='TT' - ENDIF - ! - ! - !* rereading of physiographic fields and definition of prognostic fields - !* writing of all surface fields - TOUTDATAFILE => TINIFILE - TFILE_SURFEX => TINIFILE - CALL PREP_SURF_MNH(' ',' ') - NULLIFY(TFILE_SURFEX) -ELSE - CSURF = "NONE" -END IF -! -!------------------------------------------------------------------------------- -! -!* 10. CLOSES THE FILE -! --------------- -! -IF (CSURF =='EXTE' .AND. (LEN_TRIM(CPGD_FILE)==0 .OR. .NOT. LREAD_GROUND_PARAM)) THEN - CALL IO_File_close(TINIFILEPGD) -ENDIF -CALL IO_File_close(TINIFILE) -IF( LEN_TRIM(CPGD_FILE) /= 0 ) THEN - CALL IO_File_close(TPGDFILE) -ENDIF -! -! -!------------------------------------------------------------------------------- -! -!* 11. PRINTS ON OUTPUT-LISTING -! ------------------------ -! -IF (NVERB >= 5) THEN - WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: LCARTESIAN,CIDEAL,CZS=', & - LCARTESIAN,CIDEAL,CZS - WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: LUSERV=',LUSERV - WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: XLON0,XLAT0,XBETA,XRPK,XLONORI,XLATORI=', & - XLON0,XLAT0,XBETA,XRPK,XLONORI,XLATORI - WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: XDELTAX,XDELTAY=',XDELTAX,XDELTAY - WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: NVERB=',NVERB - IF(LCARTESIAN) THEN - WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: No map projection used.' - ELSE - IF (XRPK == 1.) THEN - WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: Polar stereo used.' - ELSE IF (XRPK == 0.) THEN - WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: Mercator used.' - ELSE - WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: Lambert used, cone factor=',XRPK - END IF - END IF -END IF -! -IF (NVERB >= 5) THEN - WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: IIB, IJB, IKB=',NIB,NJB,NKB - WRITE(NLUOUT,FMT=*) 'PREP_IDEAL_CASE: IIU, IJU, IKU=',NIU,NJU,NKU -END IF -! -! -!* 28.1 print statistics! -! - ! - CALL SECOND_MNH2(ZTIME2) - XT_START=XT_START+ZTIME2-ZEND - ! - ! Set File Timing OUTPUT - ! - CALL SET_ILUOUT_TIMING(TLUOUT0) - ! - ! Compute global time - ! - CALL TIME_STAT_ll(XT_START,ZTOT) - ! - ! - IMI = 1 - CALL TIME_HEADER_ll(IMI) - ! - CALL TIME_STAT_ll(XT_STORE,ZTOT, ' STORE-FIELDS','=') - CALL TIMING_SEPARATOR('+') - CALL TIMING_SEPARATOR('+') - WRITE(YMI,FMT="(I0)") IMI - CALL TIME_STAT_ll(XT_START,ZTOT, ' MODEL'//YMI,'+') - CALL TIMING_SEPARATOR('+') - CALL TIMING_SEPARATOR('+') - CALL TIMING_SEPARATOR('+') -WRITE(NLUOUT,FMT=*) ' ' -WRITE(NLUOUT,FMT=*) '****************************************************' -WRITE(NLUOUT,FMT=*) '* PREP_IDEAL_CASE: PREP_IDEAL_CASE ENDS CORRECTLY. *' -WRITE(NLUOUT,FMT=*) '****************************************************' -! -CALL FINALIZE_MNH() -! -END PROGRAM PREP_IDEAL_CASE diff --git a/src/ICCARE_BASE/prep_real_case.f90 b/src/ICCARE_BASE/prep_real_case.f90 deleted file mode 100644 index 7d8dc30d5..000000000 --- a/src/ICCARE_BASE/prep_real_case.f90 +++ /dev/null @@ -1,1420 +0,0 @@ -!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!----------------------------------------------------------------- -! ###################### - PROGRAM PREP_REAL_CASE -! ###################### -! -!!**** *PREP_REAL_CASE* - program to write an initial FM file from real case -!! situation. -!! -!! PURPOSE -!! ------- -!! -!! The purpose of this program is to prepare an initial meso-NH file -!! (LFIFM and DESFM files) filled by some fields of a real situation. -!! General data are given by the MESO-NH user in the namelist file -!! 'PRE_REAL1.nam'. The fields are obtained from three sources: -!! - an atmospheric input file, which can be: -!! * an Aladin file, itself obtained from an Arpege file with -!! the Aladin routine "FULLPOS". -!! * a grib file (ECMWF, Grib Arpege or Grib Aladin) -!! * a MESONH file -!! - an physiographic data file. -!! -!! 1) Fields obtained from the Atmospheric file: -!! ----------------------------------------- -!! -!! - the projection parameters (checked with PGD file): -!! reference latitude and longitude -!! parameter of projection -!! angle of rotation of the domain -!! -!! - the horizontal grid definition (checked with PGD file): -!! grid mesh -!! latitude and longitude of the reference point -!! (with data from PRE_REAL1.nam) -!! -!! - thermodynamical 3D and 2D fields: -!! potential temperature -!! vapor mixing ratio -!! -!! - dynamical fields: -!! three components of the wind -!! -!! - reference anelastic state variables: -!! profile of virtual potential temperature -!! profile of dry density -!! Exner function at model top -!! -!! - total dry air mass -!! -!! -!! 2) Fields obtained from the physiographic data file: -!! ------------------------------------------------ -!! -!! - the projection parameters: -!! reference latitude and longitude -!! parameter of projection -!! angle of rotation of the domain -!! -!! - the horizontal grid definition: -!! grid mesh -!! latitude and longitude of the reference point -!! (with data from PRE_REAL1.nam) -!! - physiografic fields: (orographic, vegetation, soil and radiation fields) -!! -!! -!! 3) Data obtained from the namelist file PRE_REAL1.nam: -!! -------------------------------------------------- -!! -!! - type of equations system -!! - vertical grid definition -!! - number of points in x and y directions -!! - level of verbosity -!! - name of the different files -!! -!! -!!** METHOD -!! ------ -!! In this program, once the MESO-NH domain is calculated, all the -!! 2D or 3D fields are computed on the MESO-NH horizontal domain WITH -!! the external points. This is particularly important for the large -!! scale fields during the MESO-NH run. -!! -!! 1) The following PREP_REAL_CASE program: -!! -!! - set default values for global variables which will be written in -!! DESFM file (by calling DEFAULT_DESFM1); lateral boundary conditions -!! are open. -!! -!! - opens the different files (by calling OPEN_PRC_FILES). -!! -!! - initializes physical constants (by calling INI_CST). -!! -!! - initializes the horizontal domain from the data read in the -!! descriptive part of the Aladin file and the directives read in the -!! namelist file (routines READ_GENERAL and SET_SUBDOMAIN in -!! READ_ALL_DATA). This MESO-NH domain is a part of the Aladin domain. -!! -!! - initializes global variables from namelists and the MESO-NH -!! vertical grid definition variables in the namelist file -!! (routine READ_VER_GRID). -!! -!! - initializes the physiographic 2D fields from the physiographic data -!! file, in particular the MESO-NH orography. -!! -!! - reads the 3D and 2D variable fields in the Grib file -!! (routine READ_ALL_DATA_GRIB_CASE), -!! if HATMFILETYPE='GRIBEX': -!! absolute temperature -!! specific humidity -!! horizontal contravariant wind -!! surface pressure -!! large scale orography -!! -!! - reads the 3D and 2D variable fields in the input MESONH file -!! (routine READ_ALL_DATA_MESONH_CASE), if HATMFILETYPE='MESONH': -!! potential temperature -!! vapor mixing ratio -!! horizontal wind -!! other mixing ratios -!! turbulence prognostic and semi-prognostic variables -!! large scale orography -!! -!! - computes some geometric variables (routines SM_GRIDPROJ and METRICS), -!! in particular: -!! * altitude 3D array -!! * metric coefficients -!! * jacobian -!! -!! - initializes MESO-NH thermodynamical fields: -!! * changes of variables (routine VER_PREP_mmmmmm_CASE): -!! absolute temperature --> virtual potential temperature -!! specific humidity --> vapor mixing ratio -!! * interpolates/extrapolates the fields from the large scale -!! orography to the MESO-NH one (routine VER_INT_THERMO in -!! VER_THERMO, by using a shifting function method). -!! in water vapor case, the interpolations are always performed -!! on relative humidity. -!! * the pressure is computed on each grid by integration of the -!! hydrostatic equation from bottom or top. When input atmospheric -!! file is a MESO-NH one, information about the difference between -!! hydrostatic pressure and total pressure is kept and interpolated -!! during the entire PREP_REAL_CASE process. -!! * interpolates the fields to the MESO-NH vertical grid -!! (also by routine VER_INT_THERMO in VER_THERMO). -!! * computes the potential temperature (routine VER_THERMO). -!! * sets to zero the mixing ratios, except the vapor mixing ratio -!! (VER_THERMO). -!! -!! - initializes the reference anelastic state variables (routine SET_REFZ -!! in VER_THERMO). -!! -!! - computes the total dry air mass (routine DRY_MASS in VER_THERMO). -!! -!! - initializes MESO-NH dynamical variables: -!! * changes Aladin contravariant wind into true horizontal wind -!! (in subroutine VER_PREP). -!! * interpolates/extrapolates the momentum from the large scale -!! orography to the MESO-NH one (routine VER_INT_DYN in -!! VER_DYN, by using a shifting function method). -!! * interpolates the fields to the MESO-NH vertical grid -!! (also by routine VER_INT_DYN in VER_DYN). The fields -!! are located on a horizontal Arakawa A-grid, as the Aladin fields. -!! * The momentum is interpolated to the Arakawa C-grid -!! (routine VER_DYN). -!! * A first guess of the vertical momentum, verifying the -!! uncompressible continuity equation and the material lower boundary -!! condition against the ground, is computed (routine WGUESS). -!! * computes the final non-divergent wind field (routine -!! ANEL_BALANCE). -!! -!! - copies the interpolated fields also at t-dt and in the large scale -!! fields (routine INI_PROG_VAR). -!! -!! - writes the DESFM and LFIFM files (routines WRITE_DESFM1 and -!! WRITE_LFIFM1). -!! -!! -!! 2) Some conventions are used in this program and its subroutines because -!! of the number of different grids and fields: -!! -!! - subscripts: -!! * the subscripts I and J are used for all the horizontal grid. -!! * the subcript K is used for the MESO-NH vertical grid (increasing -!! from bottom to top). -!! * the subscript L is used for the Aladin or input Mesonh grids -!! (increasing from bottom to top). -!! -!! - suffixes: -!! * _LS: -!! If used for a geographic or horizontal grid definition variable, -!! this variable is connected to the large horizontal domain. -!! If used for a surface variable, this variable corresponds to -!! the large scale orography, and therefore will be modified. -!! If used for another variable, this variable is discretized -!! on the Aladin or input MESONH file vertical grid -!! (large-scale orography with input vertical discretization, -!! either coming from eta levels or input Gal-Chen grid). -!! * _MX: -!! Such a variable is discretized on the mixed grid. -!! (large-scale orography with output Gal-Chen vertical grid -!! discretization) -!! * _SH: -!! Such a variable is discretized on the shifted grid. -!! (fine orography with a shifted vertical grid, NOT Gal-Chen) -!! * no suffix: -!! The variable is discretized on the MESO-NH grid. -!! (fine orography with output Gal-Chen vertical grid discretization) -!! -!! - additional pre-suffixes: (for pressure, Exner and altitude fields) -!! * MASS: -!! The variable is discretized on a mass point -!! * FLUX: -!! The variable is discretized on a flux point -!! -!! -!! - names of variables: for a physical variable VAR: -!! * pVARs is the variable itself. -!! * pRHODVARs is the variable multiplied by the dry density rhod. -!! * pRHODJVARs is the variable multiplied by the dry density rhod -!! and the Jacobian. -!! * pRVARs is the variable multiplied by rhod_ref, the anelastic -!! reference state dry density and the Jacobian. -!! where p and s are the appropriate prefix and suffix. -!! -!! - allocation of arrays: the arrays are allocated -!! * just before their initialization for the general arrays stored in -!! modules. -!! * in the subroutine in which they are declared for the local arrays -!! in a subroutine. -!! * in the routine in which they are initialized for the arrays -!! defined in the monitor PREP_REAL_CASE. In this case they are in -!! fact passed as pointer to the subroutines to allow their -!! dynamical allocation (exception which confirms the rule: ZJ). -!! -!! -!! EXTERNAL -!! -------- -!! -!! Routine DEFAULT_DESFM1 : to set default values for variables which can be -!! contained in DESFM file. -!! Routine OPEN_PRC_FILES: to open all files. -!! Routine INI_CST : to initialize physical constants. -!! Routine READ_ALL_DATA_GRIB_CASE : to read all input data. -!! Routine READ_ALL_DATA_MESONH_CASE : to read all input data. -!! Routine SM_GRIDPROJ : to compute some grid variables, in case of -!! conformal projection. -!! Routine METRICS : to compute metric coefficients. -!! Routine VER_PREP_GRIBEX_CASE : to prepare the interpolations. -!! Routine VER_PREP_MESONH_CASE : to prepare the interpolations. -!! Routine VER_THERMO : to perform the interpolation of thermodynamical -!! variables. -!! Routine VER_DYN : to perform the interpolation of dynamical -!! variables. -!! Routine INI_PROG_VAR : to initialize the prognostic varaibles not yet -!! initialized -!! Routine WRITE_DESFM1 : to write a DESFM file. -!! Routine WRITE_LFIFM1 : to write a LFIFM file. -!! Routine IO_File_close : to close a FM-file (DESFM + LFIFM). -!! -!! Module MODE_GRIDPROJ : contains conformal projection routines -!! -!! Module MODI_DEFAULT_DESFM1 : interface module for routine DEFAULT_DESFM1 -!! Module MODI_OPEN_PRC_FILES : interface module for routine OPEN_PRC_FILES -!! Module MODI_READ_ALL_DATA_MESONH_CASE : interface module for routine -!! READ_ALL_DATA_MESONH_CASE -!! Module MODI_METRICS : interface module for routine METRICS -!! Module MODI_VER_PREP_GRIBEX_CASE : interface module for routine -!! VER_PREP_GRIBEX_CASE -!! Module MODI_VER_PREP_MESONH_CASE : interface module for routine -!! VER_PREP_MESONH_CASE -!! Module MODI_VER_THERMO : interface module for routine VER_THERMO -!! Module MODI_VER_DYN : interface module for routine VER_DYN -!! Module MODI_INI_PROG_VAR : interface module for routine INI_PROG_VAR -!! Module MODI_WRITE_DESFM1 : interface module for routine WRITE_DESFM1 -!! Module MODI_WRITE_LFIFM1 : interface module for routine WRITE_LFIFM1 -!! -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! Module MODD_CONF : contains configuration variables for all models. -!! NVERB : verbosity level for output-listing -!! Module MODD_CONF1 : contains configuration variables for model 1. -!! NRR : number of moist variables -!! Module MODD_LUNIT : contains logical unit and names of files. -!! Module MODD_LUNIT : contains logical unit and names of files (model1). -!! CINIFILE: name of the FM file which will be used for the MESO-NH run. -!! Module MODD_GRID1 : contains grid variables. -!! XLAT : latitude of the grid points -!! XLON : longitudeof the grid points -!! XXHAT : position xhat in the conformal plane -!! XYHAT : position yhat in the conformal plane -!! XDXHAT : horizontal local meshlength on the conformal plane -!! XDYHAT : horizontal local meshlength on the conformal plane -!! XZS : MESO-NH orography -!! XZZ : altitude -!! XZHAT : height zhat -!! XMAP : map factor -!! Module MODD_LBC1 : contains declaration of lateral boundary conditions -!! CLBCX : X-direction LBC type at left(1) and right(2) boundaries -!! CLBCY : Y-direction LBC type at left(1) and right(2) boundaries -!! Module MODD_PARAM1 : contains declaration of the parameterizations' names -!! -!! REFERENCE -!! --------- -!! -!! Book 2 -!! -!! AUTHOR -!! ------ -!! -!! V.Masson Meteo-France -!! -!! MODIFICATIONS -!! ------------- -!! Original 01/01/95 -!! Sept. 21, 1995 (J.Stein and V.Masson) surface pressure -!! Jan. 09, 1996 (V. Masson) pressure function deduced from -!! hydrostatic pressure -!! Jan. 31, 1996 (V. Masson) possibility to initialize -!! atmospheric fields from MESONH file -!! Mar. 18, 1996 (V. Masson) new vertical extrapolation of Ts -!! in case of initialization with MESONH file -!! Apr 17, 1996 (J. Stein ) change the DEFAULT_DESFM CALL -!! May 25, 1996 (V. Masson) Variable CSTORAGE_TYPE -!! Aug 26, 1996 (V. Masson) Only thinshell approximation is -!! currently available. -!! Sept 24, 1996 (V. Masson) add writing of varaibles for -!! nesting ('DAD_NAME', 'DXRATIO', 'DYRATIO') -!! Oct 11, 1996 (V. Masson) L1D and L2D configurations -!! Oct 28, 1996 (V. Masson) add deallocations and NVERB -!! default set to 1 -!! Dec 02, 1996 (V. Masson) vertical interpolation of -!! surface fields in aladin case -!! Dec 12, 1996 (V. Masson) add LS vertical velocity -!! Jan 16, 1997 (J. Stein) Durran's anelastic system -!! May 07, 1997 (V. Masson) add LS tke -!! Jun 27, 1997 (V. Masson) add absolute pressure -!! Jul 09, 1997 (V. Masson) add namelist NAM_REAL_CONF -!! Jul 10, 1997 (V. Masson) add LS epsilon -!! Aug 25, 1997 (V. Masson) add computing time analysis -!! Jan 20, 1998 (J. Stein) add LB and LS fields -!! Apr, 30, 1998 (V. Masson) Large scale VEG and LAI -!! Jun, 04, 1998 (V. Masson) Large scale D2 and Aladin ISBA -!! files -!! Jun, 04, 1998 (V. Masson) Add new soil interface var. -!! Jan 20, 1999 (J. Stein) add a Boundaries call -!! March 15 1999 (J. Pettre, V. Bousquet and V. Masson) -!! initialization from GRIB files -!! Jul 2000 (F.solmon/V.Masson) Adaptation for patch -!! according to GRIB or MESONH case -!! Nov 22, 2000 (P.Tulet, I. Mallet) initialization -!! from GRIB MOCAGE file -!! Fev 01, 2001 (D.Gazen) add module MODD_NSV for NSV variable -!! Jul 02, 2001 (J.Stein) add LCARTESIAN case -!! Oct 15, 2001 (I.Mallet) allow namelists in different orders -!! Dec 2003 (V.Masson) removes surface calls -!! Jun 01, 2002 (O.Nuissier) filtering of tropical cyclone -!! Aou 09, 2005 (D.Barbary) add CDADATMFILE CDADBOGFILE -!! May 2006 Remove KEPS -!! Feb 02, 2012 (C. Mari) interpolation from MOZART -!! add call to READ_CHEM_NETCDF_CASE & -!! VER_PREP_NETCDF_CASE -!! Mar 2012 Add NAM_NCOUT for netcdf output -!! July 2013 (Bosseur & Filippi) Adds Forefire -!! Mars 2014 (J.Escobar) Missing 'full' UPDATE_METRICS for arp2lfi // run -!! April 2014 (G.TANGUY) Add LCOUPLING -!! 2014 (M.Faivre) -!! Fevr 2015 (M.Moge) Cleaning up -!! Aug 2015 (M.Moge) removing EXTRAPOL on XDXX and XDYY in part 8 -!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1 -!! M.Leriche 2015 : add LUSECHEM dans NAM_CH_CONF -!! Feb 02, 2012 (C. Mari & BV) interpolation from CAMS -!! add call to READ_CAMS_NETCDF_CASE & -!! VER_PREP_NETCDF_CASE -!! Modification 01/2016 (JP Pinty) Add LIMA -!! Modification 02/2016 (JP Pinty) Convert CAMS mix ratio to nbr conc -! -!! 06/2016 (G.Delautier) phasage surfex 8 -!! P.Wautelet : 08/07/2016 : removed MNH_NCWRIT define -!! B.VIE 2016 : LIMA -!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O -! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list -! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables -! S. Bielli 02/2019: sea salt: significant sea wave height influences salt emission; 5 salt modes -! P. Wautelet 20/03/2019: missing use MODI_INIT_SALT -! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine -! T.Nagel 02/2021: add IBM -! P. Wautelet 06/07/2021: use FINALIZE_MNH -!! M. Leriche 26/01/2022: add reading of CAMS reanalysis for chemistry -!! and/or for LIMA -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_CH_M9_n -USE MODD_CH_MNHC_n, ONLY: LUSECHAQ_n=>LUSECHAQ,LUSECHIC_n=>LUSECHIC, LUSECHEM_n=>LUSECHEM -USE MODD_CONF -USE MODD_CONF_n -USE MODD_CST -USE MODD_DIM_n -!UPG*PT -USE MODD_CH_AEROSOL -USE MODD_DUST, ONLY: LDUST, NMODE_DST, CRGUNITD, XINISIG, XINIRADIUS, XN0MIN,& - LDSTCAMS -!UPG*PT - -USE MODD_DYN_n, CPRESOPT_n=>CPRESOPT, LRES_n=>LRES, XRES_n=>XRES , NITR_n=>NITR -USE MODD_FIELD_n -USE MODD_GR_FIELD_n -USE MODD_GRID -USE MODD_GRID_n -USE MODD_HURR_CONF -USE MODD_IBM_LSF, ONLY: CIBM_TYPE, LIBM_LSF, NIBM_SMOOTH, XIBM_SMOOTH -USE MODD_IBM_PARAM_n, ONLY: XIBM_LS -USE MODD_IO, ONLY: TFILEDATA, TFILE_SURFEX -USE MODD_LBC_n -USE MODD_LSFIELD_n -USE MODD_LUNIT, ONLY: TPGDFILE,TLUOUT0,TOUTDATAFILE -USE MODD_LUNIT_n, ONLY: CINIFILE,TINIFILE,TLUOUT -USE MODD_METRICS_n -USE MODD_MNH_SURFEX_n -USE MODD_NESTING -USE MODD_NSV -USE MODD_PARAMETERS -USE MODD_PARAM_n -USE MODD_PREP_REAL -USE MODD_REF_n -!UPG*PT -USE MODD_SALT, ONLY: LSALT, NMODE_SLT, CRGUNITS, XINISIG_SLT, XINIRADIUS_SLT, XN0MIN_SLT,& - LSLTCAMS -USE MODD_CH_AERO_n, ONLY: XM3D, XRHOP3D, XSIG3D, XRG3D, XN3D, XCTOTA3D -!UPG*PT -USE MODD_TURB_n -! -USE MODE_EXTRAPOL -use mode_field, only: Alloc_field_scalars, Ini_field_list, Ini_field_scalars -USE MODE_FINALIZE_MNH, only: FINALIZE_MNH -USE MODE_GRIDCART -USE MODE_GRIDPROJ -USE MODE_IO, only: IO_Init -USE MODE_IO_FIELD_READ, only: IO_Field_read -USE MODE_IO_FIELD_WRITE, only: IO_Header_write -USE MODE_IO_FILE, only: IO_File_close, IO_File_open -USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list, IO_File_find_byname -USE MODE_ll -USE MODE_MODELN_HANDLER -USE MODE_MPPDB -USE MODE_MSG -USE MODE_POS -USE MODE_SPLITTINGZ_ll -! -USE MODI_BOUNDARIES -USE MODI_COMPARE_DAD -USE MODI_DEALLOCATE_MODEL1 -USE MODI_DEALLOC_PARA_LL -USE MODI_DEFAULT_DESFM_n -USE MODI_ERROR_ON_TEMPERATURE -USE MODI_IBM_INIT_LS -USE MODI_INI_PROG_VAR -USE MODI_INIT_SALT -USE MODI_LIMA_MIXRAT_TO_NCONC -USE MODI_METRICS -USE MODI_MNHREAD_ZS_DUMMY_n -USE MODI_MNHWRITE_ZS_DUMMY_n -USE MODI_OPEN_PRC_FILES -USE MODI_PREP_SURF_MNH -USE MODI_PRESSURE_IN_PREP -USE MODI_READ_ALL_DATA_GRIB_CASE -USE MODI_READ_ALL_DATA_MESONH_CASE -USE MODI_READ_ALL_NAMELISTS -!UPG*PT -!USE MODI_READ_CAMS_DATA_NETCDF_CASE -!USE MODI_READ_CHEM_DATA_NETCDF_CASE -USE MODI_READ_CHEM_DATA_MOZART_CASE -USE MODI_READ_CHEM_DATA_CAMS_CASE -USE MODI_READ_LIMA_DATA_NETCDF_CASE -USE MODI_AER2LIMA -USE MODI_CH_AER_EQM_INIT_n -!UPG*PT -USE MODI_READ_VER_GRID -USE MODI_SECOND_MNH -USE MODI_SET_REF -USE MODI_UPDATE_METRICS -USE MODI_VER_DYN -USE MODI_VER_PREP_GRIBEX_CASE -USE MODI_VER_PREP_MESONH_CASE -USE MODI_VER_PREP_NETCDF_CASE -USE MODI_VERSION -USE MODI_VER_THERMO -USE MODI_WRITE_DESFM_n -USE MODI_WRITE_LFIFM_n -! -USE MODN_CONF, ONLY: JPHEXT , NHALO -USE MODN_CONFZ -USE MODN_PARAM_LIMA -! -IMPLICIT NONE -! -!* 0.1 Declaration of local variables -! ------------------------------ -! -CHARACTER(LEN=28) :: YATMFILE ! name of the Atmospheric file -CHARACTER(LEN=6) :: YATMFILETYPE! type of the Atmospheric file -CHARACTER(LEN=28) :: YCHEMFILE ! name of the Chemical file -CHARACTER(LEN=6) :: YCHEMFILETYPE! type of the Chemical file -!UP*PT -!CHARACTER(LEN=28) :: YCAMSFILE ! name of the input CAMS file -!CHARACTER(LEN=6) :: YCAMSFILETYPE! type of the input CAMS file -CHARACTER(LEN=28) :: YLIMAFILE ! name of the input MACC file -CHARACTER(LEN=6) :: YLIMAFILETYPE! type of the input MACC file -!UP*PT -CHARACTER(LEN=28) :: YSURFFILE ! name of the Surface file -CHARACTER(LEN=6) :: YSURFFILETYPE! type of the Surface file -CHARACTER(LEN=28) :: YPGDFILE ! name of the physiographic data -! ! file -! -CHARACTER(LEN=28) :: YDAD_NAME ! true name of the atmospheric file -! -!* other variables -! -REAL,DIMENSION(:,:,:), ALLOCATABLE:: ZJ ! Jacobian -! -!* file management variables and counters -! -INTEGER :: ILUOUT0 ! logical unit for listing file -INTEGER :: IPRE_REAL1 ! logical unit for namelist file -INTEGER :: IRESP ! return code in FM routines -LOGICAL :: GFOUND ! Return code when searching namelist -INTEGER :: NIU,NJU,NKU ! Upper bounds in x,y,z directions -! -REAL :: ZSTART, ZEND, ZTIME1, ZTIME2, ZTOT, ZALL ! for computing time analysis -REAL :: ZMISC, ZREAD, ZHORI, ZPREP, ZSURF, ZTHERMO, ZDYN, ZDIAG, ZWRITE -REAL :: ZDG ! diagnostics time in routines -INTEGER :: IINFO_ll ! return code of // routines -! Namelist model variables -CHARACTER(LEN=5) :: CPRESOPT -INTEGER :: NITR -LOGICAL :: LRES -REAL :: XRES -LOGICAL :: LSHIFT ! flag to perform vertical shift or not. -LOGICAL :: LDUMMY_REAL ! flag to read and interpolate - !dummy fields from GRIBex file -INTEGER :: JRR ! loop counter for moist var. -LOGICAL :: LUSECHAQ -LOGICAL :: LUSECHIC -LOGICAL :: LUSECHEM -INTEGER :: JN -! -TYPE(TFILEDATA),POINTER :: TZATMFILE => NULL() -TYPE(TFILEDATA),POINTER :: TZPRE_REAL1FILE => NULL() -! -! -!* 0.3 Declaration of namelists -! ------------------------ -! -NAMELIST/NAM_REAL_CONF/ NVERB, CEQNSYS, CPRESOPT, LSHIFT, LDUMMY_REAL, & - LRES, XRES, NITR,LCOUPLING, NHALO , JPHEXT -! Filtering and balancing of the large-scale and radar tropical cyclone -NAMELIST/NAM_HURR_CONF/ LFILTERING, CFILTERING, & -XLAMBDA, NK, XLATGUESS, XLONGUESS, XBOXWIND, XRADGUESS, NPHIL, NDIAG_FILT, & -NLEVELR0,LBOGUSSING, & -XLATBOG, XLONBOG, XVTMAXSURF, XRADWINDSURF, & -XMAX, XC, XRHO_Z, XRHO_ZZ, XB_0, XBETA_Z, XBETA_ZZ,& -XANGCONV0, XANGCONV1000, XANGCONV2000, & - CDADATMFILE, CDADBOGFILE - NAMELIST/NAM_AERO_CONF/ LORILAM, LINITPM, LDUST, XINIRADIUSI, XINIRADIUSJ,& - XINISIGI, XINISIGJ, XN0IMIN, XN0JMIN, CRGUNIT, CRGUNITD,& - LSALT, CRGUNITS, NMODE_DST, XINISIG, XINIRADIUS, XN0MIN,& -!UPG*PT - XINISIG_SLT, XINIRADIUS_SLT, XN0MIN_SLT, NMODE_SLT, & - LDSTCAMS, LSLTCAMS,CACTCCN,CCLOUD, NMOD_IFN, NMOD_CCN -!UPG*PT - -NAMELIST/NAM_CH_CONF/ LUSECHAQ,LUSECHIC,LUSECHEM -! -NAMELIST/NAM_IBM_LSF/ LIBM_LSF, CIBM_TYPE, NIBM_SMOOTH, XIBM_SMOOTH -! -! name of dad of input FM file -INTEGER :: II, IJ, IGRID, ILENGTH -CHARACTER (LEN=100) :: HCOMMENT -TYPE(LIST_ll), POINTER :: TZFIELDS_ll=>NULL() ! list of fields to exchange -!UPG*PT -REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBXRHO, ZLBYRHO -REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBXZZ, ZLBYZZ -REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBXPABST, ZLBYPABST -INTEGER :: ILBX,ILBY,IIB,IJB,IIE,IJE -!UPG*PT - -!------------------------------------------------------------------------------- -! -CALL MPPDB_INIT() -! -CALL GOTO_MODEL(1,ONOFIELDLIST=.TRUE.) -! -ZDIAG = 0. -CALL SECOND_MNH (ZSTART) -! -ZHORI = 0. -ZSURF = 0. -ZTIME1 = ZSTART -! -!* 1. SET DEFAULT VALUES -! ------------------ -! -CALL VERSION -CPROGRAM='REAL ' -! -CALL ALLOC_FIELD_SCALARS() -! -CALL DEFAULT_DESFM_n(1) -NRR=1 -IDX_RVT = 1 -! -!------------------------------------------------------------------------------- -! -!* 2. OPENNING OF THE FILES -! --------------------- -CALL IO_Init() -! -CALL OPEN_PRC_FILES(TZPRE_REAL1FILE,YATMFILE, YATMFILETYPE,TZATMFILE & - ,YCHEMFILE,YCHEMFILETYPE & - ,YSURFFILE,YSURFFILETYPE & - ,YPGDFILE,TPGDFILE & -!UPG*PT -! ,YCAMSFILE,YCAMSFILETYPE) - ,YLIMAFILE,YLIMAFILETYPE) -!UPG*PT -ILUOUT0 = TLUOUT0%NLU -TLUOUT => TLUOUT0 -! -IF (YATMFILETYPE=='MESONH') THEN - LSHIFT = .FALSE. -ELSE IF (YATMFILETYPE=='GRIBEX') THEN - LSHIFT = .TRUE. -ELSE - LSHIFT = .TRUE. - WRITE(ILUOUT0,FMT=*) 'HATMFILETYPE WAS SET TO: '//TRIM(YATMFILETYPE) - WRITE(ILUOUT0,FMT=*) 'ONLY TWO VALUES POSSIBLE FOR HATMFILETYPE:' - WRITE(ILUOUT0,FMT=*) 'EITHER MESONH OR GRIBEX' - WRITE(ILUOUT0,FMT=*) '-> JOB ABORTED' - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_REAL_CASE','') -END IF -! -LCPL_AROME=.FALSE. -LCOUPLING=.FALSE. -! -!------------------------------------------------------------------------------- -! -!* 3. INITIALIZATION OF PHYSICAL CONSTANTS -! ------------------------------------ -! -CALL INI_CST -! -!------------------------------------------------------------------------------- -! -!* 4. READING OF NAMELIST -! ------------------- -! -!* 4.1 reading of configuration variables -! -IPRE_REAL1 = TZPRE_REAL1FILE%NLU -! -CALL INIT_NMLVAR -CALL POSNAM(IPRE_REAL1,'NAM_REAL_CONF',GFOUND,ILUOUT0) -IF (GFOUND) READ(IPRE_REAL1,NAM_REAL_CONF) -CALL POSNAM(IPRE_REAL1,'NAM_PARAM_LIMA',GFOUND,ILUOUT0) -IF (GFOUND) READ(IPRE_REAL1,NAM_PARAM_LIMA) -! -CALL INI_FIELD_LIST(1) -! -CALL INI_FIELD_SCALARS() -! -!* 4.2 reading of values of some configuration variables in namelist -! -! -!JUAN REALZ from prep_surfex -! -IF (YATMFILETYPE == 'GRIBEX') THEN -! -!* 4.1 Vertical Spatial grid -! -CALL INIT_NMLVAR() -CALL READ_VER_GRID(TZPRE_REAL1FILE) -! -CALL IO_Field_read(TPGDFILE,'IMAX',NIMAX) -CALL IO_Field_read(TPGDFILE,'JMAX',NJMAX) -! -NIMAX_ll=NIMAX !! _ll variables are global variables -NJMAX_ll=NJMAX !! but the old names are kept in PRE_IDEA1.nam file -! -CALL SET_JP_ll(JPMODELMAX,JPHEXT,JPVEXT,JPHEXT) -CALL SET_DAD0_ll() -!JUAN 4/04/2014 correction for PREP_REAL_CASE on Gribex files -!CALL SET_DIM_ll(NIMAX_ll, NJMAX_ll, 128) -CALL SET_DIM_ll(NIMAX_ll, NJMAX_ll, NKMAX) -CALL SET_LBX_ll('OPEN',1) -CALL SET_LBY_ll('OPEN', 1) -CALL SET_XRATIO_ll(1, 1) -CALL SET_YRATIO_ll(1, 1) -CALL SET_XOR_ll(1, 1) -CALL SET_XEND_ll(NIMAX_ll+2*JPHEXT, 1) -CALL SET_YOR_ll(1, 1) -CALL SET_YEND_ll(NJMAX_ll+2*JPHEXT, 1) -CALL SET_DAD_ll(0, 1) -!JUANZ -!CALL INI_PARA_ll(IINFO_ll) -CALL INI_PARAZ_ll(IINFO_ll) -!JUANZ - -! -! sizes of arrays of the extended sub-domain -! -CALL GET_DIM_PHYS_ll('B',NIMAX,NJMAX) -!!$CALL GET_DIM_EXT_ll('B',NIU,NJU) -!!$CALL GET_INDICE_ll(NIB,NJB,NIE,NJE) -!!$CALL GET_OR_ll('B',IXOR,IYOR) -ENDIF -!JUAN REALZ -! -LDUMMY_REAL= .FALSE. -LFILTERING= .FALSE. -CFILTERING= 'UVT ' -XLATGUESS= XUNDEF ; XLONGUESS= XUNDEF ; XBOXWIND=XUNDEF; XRADGUESS= XUNDEF -NK=50 ; XLAMBDA=0.2 ; NPHIL=24 -NLEVELR0=15 -NDIAG_FILT=-1 -LBOGUSSING= .FALSE. -XLATBOG= XUNDEF ; XLONBOG= XUNDEF -XVTMAXSURF= XUNDEF ; XRADWINDSURF= XUNDEF -XMAX=16000. ; XC=0.7 ; XRHO_Z=-0.3 ; XRHO_ZZ=0.9 -XB_0=1.65 ; XBETA_Z=-0.5 ; XBETA_ZZ=0.35 -XANGCONV0=0. ; XANGCONV1000=0. ; XANGCONV2000=0. -CDADATMFILE=' ' ; CDADBOGFILE=' ' -! -CALL INIT_NMLVAR -CALL POSNAM(IPRE_REAL1,'NAM_REAL_CONF',GFOUND,ILUOUT0) -IF (GFOUND) READ(IPRE_REAL1,NAM_REAL_CONF) -CALL POSNAM(IPRE_REAL1,'NAM_HURR_CONF',GFOUND,ILUOUT0) -IF (GFOUND) READ(IPRE_REAL1,NAM_HURR_CONF) -CALL POSNAM(IPRE_REAL1,'NAM_CH_CONF',GFOUND,ILUOUT0) -IF (GFOUND) READ(UNIT=IPRE_REAL1,NML=NAM_CH_CONF) -CALL UPDATE_MODD_FROM_NMLVAR -CALL POSNAM(IPRE_REAL1,'NAM_AERO_CONF',GFOUND,ILUOUT0) -IF (GFOUND) READ(IPRE_REAL1,NAM_AERO_CONF) -CALL POSNAM(IPRE_REAL1,'NAM_CONFZ',GFOUND,ILUOUT0) -IF (GFOUND) READ(UNIT=IPRE_REAL1,NML=NAM_CONFZ) -CALL POSNAM(IPRE_REAL1,'NAM_IBM_LSF' ,GFOUND,ILUOUT0) -IF (GFOUND) READ(UNIT=IPRE_REAL1,NML=NAM_IBM_LSF) -! -! Sea salt -CALL INIT_SALT -! -!* 4.3 set soil scheme to ISBA for initialization from GRIB -! -IF (YATMFILETYPE=='GRIBEX') THEN - CLBCX(:) ='OPEN' - CLBCY(:) ='OPEN' -END IF -! -CALL SECOND_MNH(ZTIME2) -ZMISC = ZTIME2 - ZTIME1 -!------------------------------------------------------------------------------- -! -!* 5. READING OF THE INPUT DATA -! ------------------------- -! -ZTIME1 = ZTIME2 -! -IF (YATMFILETYPE=='MESONH') THEN - CALL READ_ALL_DATA_MESONH_CASE(TZPRE_REAL1FILE,YATMFILE,TPGDFILE,YDAD_NAME) -ELSE IF (YATMFILETYPE=='GRIBEX') THEN - IF(LEN_TRIM(YCHEMFILE)>0 .AND. YCHEMFILETYPE=='GRIBEX')THEN - CALL READ_ALL_DATA_GRIB_CASE('ATM1',TZPRE_REAL1FILE,YATMFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL) - ELSE - CALL READ_ALL_DATA_GRIB_CASE('ATM0',TZPRE_REAL1FILE,YATMFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL) - END IF -! - YDAD_NAME=' ' -END IF -! -IF (NIMAX==1 .AND. NJMAX==1) THEN - L1D=.TRUE. - L2D=.FALSE. -ELSE IF (NJMAX==1) THEN - L1D=.FALSE. - L2D=.TRUE. -ELSE - L1D=.FALSE. - L2D=.FALSE. -END IF -! -! UPG*PT -!* 5.1 reading of the input chemical data -! -!IF(LEN_TRIM(YCHEMFILE)>0)THEN -! ! read again Nam_aero_conf -! CALL POSNAM(IPRE_REAL1,'NAM_AERO_CONF',GFOUND,ILUOUT0) -! IF (GFOUND) READ(IPRE_REAL1,NAM_AERO_CONF) -! IF(YCHEMFILETYPE=='GRIBEX') & -! CALL READ_ALL_DATA_GRIB_CASE('CHEM',TZPRE_REAL1FILE,YCHEMFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL) -! IF (YCHEMFILETYPE=='NETCDF') & -! CALL READ_CHEM_DATA_NETCDF_CASE(TZPRE_REAL1FILE,YCHEMFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL) -!END IF -! -!* 5.2 reading the input CAMS data -! -!IF(LEN_TRIM(YCAMSFILE)>0)THEN -! IF(YCAMSFILETYPE=='NETCDF') THEN -! CALL READ_CAMS_DATA_NETCDF_CASE(TZPRE_REAL1FILE,YCAMSFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL) -! ELSE -! CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_REAL_CASE','CANNOT READ CAMS GRIB FILES YET') -! END IF -!END IF -!* 5.1 reading CAMS or MACC files for init LIMA -! -IF(LEN_TRIM(YLIMAFILE)>0)THEN - IF(YLIMAFILETYPE=='NETCDF') THEN - CALL READ_LIMA_DATA_NETCDF_CASE(TZPRE_REAL1FILE,YLIMAFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL) - ELSE - WRITE(ILUOUT0,FMT=*) - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_REAL_CASE','Pb in MACC/CAMS file') - STOP - END IF -END IF -! -!* 5.2 reading of the input chemical data + dusts + salts if needed -! -IF(LEN_TRIM(YCHEMFILE)>0)THEN - ! read again Nam_aero_conf - CALL POSNAM(IPRE_REAL1,'NAM_AERO_CONF',GFOUND,ILUOUT0) - IF (GFOUND) READ(IPRE_REAL1,NAM_AERO_CONF) - IF(YCHEMFILETYPE=='GRIBEX') & - CALL READ_ALL_DATA_GRIB_CASE('CHEM',TZPRE_REAL1FILE,YCHEMFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL) - IF (YCHEMFILETYPE=='MOZART') & - CALL READ_CHEM_DATA_MOZART_CASE(TZPRE_REAL1FILE,YCHEMFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL) - IF (YCHEMFILETYPE=='CAMSEU') & - CALL READ_CHEM_DATA_CAMS_CASE(TZPRE_REAL1FILE,YCHEMFILE,TPGDFILE,ZHORI,NVERB, & - LDUMMY_REAL,LUSECHEM) -END IF - -!UPG*PT -! -CALL IO_File_close(TZPRE_REAL1FILE) -! -CALL SECOND_MNH(ZTIME2) -ZREAD = ZTIME2 - ZTIME1 - ZHORI -!------------------------------------------------------------------------------- -! -CALL IO_File_add2list(TINIFILE,CINIFILE,'MNH','WRITE',KLFITYPE=1,KLFIVERB=NVERB) -CALL IO_File_open(TINIFILE) -! -ZTIME1=ZTIME2 -! -!* 6. CONFIGURATION VARIABLES -! ----------------------- -! -!* 6.1 imposed values of some other configuration variables -! -CDCONV='NONE' -CSCONV='NONE' -CRAD='NONE' -CCONF='START' -NRIMX=6 -NRIMY=6 -LHORELAX_UVWTH=.TRUE. -LHORELAX_RV=LUSERV -LHORELAX_RC=LUSERC -LHORELAX_RR=LUSERR -LHORELAX_RI=LUSERI -LHORELAX_RS=LUSERS -LHORELAX_RG=LUSERG -LHORELAX_RH=LUSERH -LHORELAX_SV(:)=.FALSE. -LHORELAX_SVC2R2 = (NSV_C2R2 > 0) -LHORELAX_SVC1R3 = (NSV_C1R3 > 0) -LHORELAX_SVLIMA = (NSV_LIMA > 0) -LHORELAX_SVELEC = (NSV_ELEC > 0) -LHORELAX_SVCHEM = (NSV_CHEM > 0) -LHORELAX_SVCHIC = (NSV_CHIC > 0) -LHORELAX_SVDST = (NSV_DST > 0) -LHORELAX_SVSLT = (NSV_SLT > 0) -LHORELAX_SVAER = (NSV_AER > 0) -LHORELAX_SVPP = (NSV_PP > 0) -#ifdef MNH_FOREFIRE -LHORELAX_SVFF = (NSV_FF > 0) -#endif -LHORELAX_SVCS = (NSV_CS > 0) - -LHORELAX_SVLG = .FALSE. -LHORELAX_SV(1:NSV)=.TRUE. -IF ( CTURB /= 'NONE') THEN - LHORELAX_TKE = .TRUE. -ELSE - LHORELAX_TKE = .FALSE. -END IF -! -! -CSTORAGE_TYPE='TT' -!------------------------------------------------------------------------------- -! -!* 8. COMPUTATION OF GEOMETRIC VARIABLES -! ---------------------------------- -! -ZTIME1 = ZTIME2 -! -ALLOCATE(XMAP(SIZE(XXHAT),SIZE(XYHAT))) -ALLOCATE(XLAT(SIZE(XXHAT),SIZE(XYHAT))) -ALLOCATE(XLON(SIZE(XXHAT),SIZE(XYHAT))) -ALLOCATE(XDXHAT(SIZE(XXHAT))) -ALLOCATE(XDYHAT(SIZE(XYHAT))) -ALLOCATE(XZZ(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT))) -ALLOCATE(ZJ(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT))) -! -IF (LCARTESIAN) THEN - CALL SM_GRIDCART(XXHAT,XYHAT,XZHAT,XZS,LSLEVE,XLEN1,XLEN2,XZSMT,XDXHAT,XDYHAT,XZZ,ZJ) - XMAP=1. -ELSE - CALL SM_GRIDPROJ(XXHAT,XYHAT,XZHAT,XZS, & - LSLEVE,XLEN1,XLEN2,XZSMT,XLATORI,XLONORI, & - XMAP,XLAT,XLON,XDXHAT,XDYHAT,XZZ,ZJ ) -END IF -! -CALL MPPDB_CHECK2D(XZS,"prep_real_case8:XZS",PRECISION) -CALL MPPDB_CHECK2D(XMAP,"prep_real_case8:XMAP",PRECISION) -CALL MPPDB_CHECK2D(XLAT,"prep_real_case8:XLAT",PRECISION) -CALL MPPDB_CHECK2D(XLON,"prep_real_case8:XLON",PRECISION) -CALL MPPDB_CHECK3D(XZZ,"prep_real_case8:XZZ",PRECISION) -CALL MPPDB_CHECK3D(ZJ,"prep_real_case8:ZJ",PRECISION) -! -ALLOCATE(XDXX(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT))) -ALLOCATE(XDYY(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT))) -ALLOCATE(XDZX(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT))) -ALLOCATE(XDZY(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT))) -ALLOCATE(XDZZ(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT))) -! -!20131024 add update halo -!=> corrects on PDXX calculation in metrics and XDXX !! -CALL ADD3DFIELD_ll( TZFIELDS_ll, XZZ, 'PREP_REAL_CASE::XZZ' ) -CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll) -CALL CLEANLIST_ll(TZFIELDS_ll) -! -CALL METRICS(XMAP,XDXHAT,XDYHAT,XZZ,XDXX,XDYY,XDZX,XDZY,XDZZ) -! -CALL MPPDB_CHECK3D(XDXX,"prc8-beforeupdate_metrics:PDXX",PRECISION) -CALL MPPDB_CHECK3D(XDYY,"prc8-beforeupdate_metrics:PDYY",PRECISION) -CALL MPPDB_CHECK3D(XDZX,"prc8-beforeupdate_metrics:PDZX",PRECISION) -CALL MPPDB_CHECK3D(XDZY,"prc8-beforeupdate_metrics:PDZY",PRECISION) -! -CALL UPDATE_METRICS(CLBCX,CLBCY,XDXX,XDYY,XDZX,XDZY,XDZZ) -! -!20131112 add update_halo for XDYY and XDZY!! -CALL ADD3DFIELD_ll( TZFIELDS_ll, XDXX, 'PREP_REAL_CASE::XDXX' ) -CALL ADD3DFIELD_ll( TZFIELDS_ll, XDZX, 'PREP_REAL_CASE::XDZX' ) -CALL ADD3DFIELD_ll( TZFIELDS_ll, XDYY, 'PREP_REAL_CASE::XDYY' ) -CALL ADD3DFIELD_ll( TZFIELDS_ll, XDZY, 'PREP_REAL_CASE::XDZY' ) -CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll) -CALL CLEANLIST_ll(TZFIELDS_ll) - -!CALL EXTRAPOL('W',XDXX,XDZX) -!CALL EXTRAPOL('S',XDYY,XDZY) - -CALL SECOND_MNH(ZTIME2) - -ZMISC = ZMISC + ZTIME2 - ZTIME1 -!------------------------------------------------------------------------------- -! -!* 9. PREPARATION OF THE VERTICAL SHIFT AND INTERPOLATION -! --------------------------------------------------- -! -ZTIME1 = ZTIME2 -! -IF (YATMFILETYPE=='GRIBEX') THEN - CALL VER_PREP_GRIBEX_CASE('ATM ',ZDG) -ELSE IF (YATMFILETYPE=='MESONH') THEN - CALL VER_PREP_MESONH_CASE(ZDG) -END IF -! -IF (LEN_TRIM(YCHEMFILE)>0 .AND. YCHEMFILETYPE=='GRIBEX') THEN - CALL VER_PREP_GRIBEX_CASE('CHEM',ZDG) -END IF -!UPG*PT -!IF ((LEN_TRIM(YCHEMFILE)>0 .AND. YCHEMFILETYPE=='NETCDF') .OR. & -! (LEN_TRIM(YCAMSFILE)>0 .AND. YCAMSFILETYPE=='NETCDF')) THEN -! CALL VER_PREP_NETCDF_CASE(ZDG) -!END IF -IF (LEN_TRIM(YCHEMFILE)>0 .AND. ((YCHEMFILETYPE=='MOZART').OR. & - (YCHEMFILETYPE=='CAMSEU'))) THEN - CALL VER_PREP_NETCDF_CASE(ZDG,XSV_LS) - - DEALLOCATE(XSV_LS) -END IF -! -IF (LEN_TRIM(YLIMAFILE)>0 .AND. YLIMAFILETYPE=='NETCDF') THEN - CALL VER_PREP_NETCDF_CASE(ZDG,XSV_LS_LIMA) - DEALLOCATE(XSV_LS_LIMA) -END IF -!UPG*PT -! -CALL SECOND_MNH(ZTIME2) -ZPREP = ZTIME2 - ZTIME1 - ZDG -ZDIAG = ZDIAG + ZDG -!------------------------------------------------------------------------------- -! -!* 10. VERTICAL INTERPOLATION OF ALL THERMODYNAMICAL VARIABLES -! ------------------------------------------------------- -! -ZTIME1 = ZTIME2 -! -ALLOCATE(XPSURF(SIZE(XXHAT),SIZE(XYHAT))) -! -CALL EXTRAPOL('E',XEXNTOP2D) -IF (YATMFILETYPE=='GRIBEX') THEN - CALL VER_THERMO(TINIFILE,LSHIFT,XTHV_MX,XR_MX,XZS_LS,XZSMT_LS,XZMASS_MX,XZFLUX_MX,XPMHP_MX,ZJ, & - XDXX,XDYY,XEXNTOP2D,XPSURF,ZDG ) -ELSE IF (YATMFILETYPE=='MESONH') THEN - CALL VER_THERMO(TINIFILE,LSHIFT,XTHV_MX,XR_MX,XZS_LS,XZSMT_LS,XZMASS_MX,XZFLUX_MX,XPMHP_MX,ZJ, & - XDXX,XDYY,XEXNTOP2D,XPSURF,ZDG, & - XLSTH_MX,XLSRV_MX ) -END IF -! -CALL SECOND_MNH(ZTIME2) -ZTHERMO = ZTIME2 - ZTIME1 - ZDG -ZDIAG = ZDIAG + ZDG -!------------------------------------------------------------------------------- -! -!* 12. VERTICAL INTERPOLATION OF DYNAMICAL VARIABLES -! --------------------------------------------- -! -ZTIME1 = ZTIME2 -IF (YATMFILETYPE=='GRIBEX') THEN - CALL VER_DYN(LSHIFT,XU_MX,XV_MX,XW_MX,XRHOD_MX,XZFLUX_MX,XZMASS_MX,XZS_LS, & - XDXX,XDYY,XDZZ,XDZX,XDZY,ZJ,YATMFILETYPE ) -ELSE IF (YATMFILETYPE=='MESONH') THEN - CALL VER_DYN(LSHIFT,XU_MX,XV_MX,XW_MX,XRHOD_MX,XZFLUX_MX,XZMASS_MX,XZS_LS, & - XDXX,XDYY,XDZZ,XDZX,XDZY,ZJ,YATMFILETYPE, & - XLSU_MX,XLSV_MX,XLSW_MX ) -END IF -! -! -IF (ALLOCATED(XTHV_MX)) DEALLOCATE(XTHV_MX) -IF (ALLOCATED(XR_MX)) DEALLOCATE(XR_MX) -IF (ALLOCATED(XPMHP_MX)) DEALLOCATE(XPMHP_MX) -IF (ALLOCATED(XU_MX)) DEALLOCATE(XU_MX) -IF (ALLOCATED(XV_MX)) DEALLOCATE(XV_MX) -IF (ALLOCATED(XW_MX)) DEALLOCATE(XW_MX) -IF (ALLOCATED(XLSTH_MX)) DEALLOCATE(XLSTH_MX) -IF (ALLOCATED(XLSRV_MX)) DEALLOCATE(XLSRV_MX) -IF (ALLOCATED(XLSU_MX)) DEALLOCATE(XLSU_MX) -IF (ALLOCATED(XLSV_MX)) DEALLOCATE(XLSV_MX) -IF (ALLOCATED(XLSW_MX)) DEALLOCATE(XLSW_MX) -IF (ALLOCATED(XZFLUX_MX)) DEALLOCATE(XZFLUX_MX) -IF (ALLOCATED(XZMASS_MX)) DEALLOCATE(XZMASS_MX) -IF (ALLOCATED(XRHOD_MX)) DEALLOCATE(XRHOD_MX) -IF (ALLOCATED(XEXNTOP2D)) DEALLOCATE(XEXNTOP2D) -IF (ALLOCATED(XZS_LS)) DEALLOCATE(XZS_LS) -IF (ALLOCATED(XZSMT_LS)) DEALLOCATE(XZSMT_LS) -! -!------------------------------------------------------------------------------- -! -!* 13. ANELASTIC CORRECTION -! -------------------- -! -CALL PRESSURE_IN_PREP(XDXX,XDYY,XDZX,XDZY,XDZZ) -! -CALL SECOND_MNH(ZTIME2) -ZDYN = ZTIME2 - ZTIME1 -! -!------------------------------------------------------------------------------- -! -!* 14. INITIALIZATION OF THE REMAINING PROGNOSTIC VARIABLES (COPIES) -! ------------------------------------------------------------- -! -ZTIME1 = ZTIME2 -! -IF(LEN_TRIM(YCHEMFILE)>0 .AND. YCHEMFILETYPE=='MESONH')THEN - CALL INI_PROG_VAR(XTKE_MX,XSV_MX,YCHEMFILE) - LHORELAX_SVCHEM = (NSV_CHEM > 0) - LHORELAX_SVCHIC = (NSV_CHIC > 0) - LHORELAX_SVDST = (NSV_DST > 0) - LHORELAX_SVSLT = (NSV_SLT > 0) - LHORELAX_SVAER = (NSV_AER > 0) -ELSE -! -!UPG*PT -!IF (LEN_TRIM(YCAMSFILE)>0 .AND. YCAMSFILETYPE=='NETCDF') THEN -IF (LEN_TRIM(YLIMAFILE)>0 .AND. YLIMAFILETYPE=='NETCDF') THEN -!UPG*PT - CALL LIMA_MIXRAT_TO_NCONC(XPABST, XTHT, XRT(:,:,:,1), XSV_MX) -END IF -! - CALL INI_PROG_VAR(XTKE_MX,XSV_MX) -END IF -! - -! Initialization of ORILAM variables -IF (LORILAM) THEN - IF (.NOT.(ASSOCIATED(XN3D))) ALLOCATE(XN3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE)) - IF (.NOT.(ASSOCIATED(XRG3D))) ALLOCATE(XRG3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE)) - IF (.NOT.(ASSOCIATED(XSIG3D))) ALLOCATE(XSIG3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE)) - IF (.NOT.(ASSOCIATED(XRHOP3D))) ALLOCATE(XRHOP3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE)) - IF (.NOT.(ASSOCIATED(XM3D))) ALLOCATE(XM3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE*3)) - IF (.NOT.(ASSOCIATED(XCTOTA3D))) & - ALLOCATE(XCTOTA3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),NSP+NCARB+NSOA,JPMODE)) - - CALL CH_AER_EQM_INIT_n(XSVT(:,:,:,NSV_CHEMBEG:NSV_CHEMEND),& - XSVT(:,:,:,NSV_AERBEG:NSV_AEREND),& - XM3D,XRHOP3D,XSIG3D,& - XRG3D,XN3D, XRHODREF, XCTOTA3D) -END IF -! -! Initialization LIMA variables by ORILAM -IF (CCLOUD == 'LIMA' .AND. ((LORILAM).OR.(LDUST).OR.(LSALT))) THEN - - ! Init LIMA by ORILAM - CALL AER2LIMA(XSVT, XRHODREF, XRT(:,:,:,1), XPABST, XTHT,XZZ) - - ! Init LB LIMA by ORILAM - ALLOCATE(ZLBXRHO(SIZE(XLBXSVM,1), SIZE(XLBXSVM,2), SIZE(XLBXSVM,3))) - ALLOCATE(ZLBYRHO(SIZE(XLBYSVM,1), SIZE(XLBYSVM,2), SIZE(XLBYSVM,3))) - ALLOCATE(ZLBXPABST(SIZE(XLBXSVM,1), SIZE(XLBXSVM,2), SIZE(XLBXSVM,3))) - ALLOCATE(ZLBYPABST(SIZE(XLBYSVM,1), SIZE(XLBYSVM,2), SIZE(XLBYSVM,3))) - ALLOCATE(ZLBXZZ(SIZE(XLBXSVM,1), SIZE(XLBXSVM,2), SIZE(XLBXSVM,3))) - ALLOCATE(ZLBYZZ(SIZE(XLBYSVM,1), SIZE(XLBYSVM,2), SIZE(XLBYSVM,3))) - - ILBX=SIZE(XLBXSVM,1)/2-JPHEXT - ILBY=SIZE(XLBYSVM,2)/2-JPHEXT - - CALL GET_INDICE_ll (IIB,IJB,IIE,IJE) - - ZLBXRHO(1:ILBX+1,:,:) = XRHODREF(IIB-1:IIB-1+ILBX,:,:) - ZLBXRHO(ILBX+2:2*ILBX+2,:,:) = XRHODREF(IIE+1-ILBX:IIE+1,:,:) - ZLBYRHO(:,1:ILBY+1,:) = XRHODREF(:,IJB-1:IJB-1+ILBY,:) - ZLBYRHO(:,ILBY+2:2*ILBY+2,:) = XRHODREF(:,IJE+1-ILBY:IJE+1,:) - ZLBXPABST(1:ILBX+1,:,:) = XPABST(IIB-1:IIB-1+ILBX,:,:) - ZLBXPABST(ILBX+2:2*ILBX+2,:,:) = XPABST(IIE+1-ILBX:IIE+1,:,:) - ZLBYPABST(:,1:ILBY+1,:) = XPABST(:,IJB-1:IJB-1+ILBY,:) - ZLBYPABST(:,ILBY+2:2*ILBY+2,:) = XPABST(:,IJE+1-ILBY:IJE+1,:) - ZLBXZZ(1:ILBX+1,:,:) = XZZ(IIB-1:IIB-1+ILBX,:,:) - ZLBXZZ(ILBX+2:2*ILBX+2,:,:) = XZZ(IIE+1-ILBX:IIE+1,:,:) - ZLBYZZ(:,1:ILBY+1,:) = XZZ(:,IJB-1:IJB-1+ILBY,:) - ZLBYZZ(:,ILBY+2:2*ILBY+2,:) = XZZ(:,IJE+1-ILBY:IJE+1,:) - - CALL AER2LIMA(XLBXSVM, ZLBXRHO, XLBXRM(:,:,:,1), ZLBXPABST, XLBXTHM, ZLBXZZ) - CALL AER2LIMA(XLBYSVM, ZLBYRHO, XLBYRM(:,:,:,1), ZLBYPABST, XLBYTHM, ZLBYZZ) - - DEALLOCATE(ZLBXRHO) - DEALLOCATE(ZLBYRHO) - DEALLOCATE(ZLBXPABST) - DEALLOCATE(ZLBYPABST) - DEALLOCATE(ZLBXZZ) - DEALLOCATE(ZLBYZZ) - -END IF -! -IF (ALLOCATED(XSV_MX)) DEALLOCATE(XSV_MX) -IF (ALLOCATED(XTKE_MX)) DEALLOCATE(XTKE_MX) -! -CALL BOUNDARIES ( & - 0.,CLBCX,CLBCY,NRR,NSV,1, & - XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM, & - XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, & - XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM, & - XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, & - XRHODJ,XRHODREF, & - XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT ) -! -CALL SECOND_MNH(ZTIME2) -ZMISC = ZMISC + ZTIME2 - ZTIME1 -! -!------------------------------------------------------------------------------- -! -!* 15. Error on temperature during interpolations -! ------------------------------------------ -! -ZTIME1 = ZTIME2 -! -IF (YATMFILETYPE=='GRIBEX' .AND. NVERB>1) THEN - CALL ERROR_ON_TEMPERATURE(XT_LS,XPMASS_LS,XPABST,XPS_LS,XPSURF) -END IF -! -IF (YATMFILETYPE=='GRIBEX') THEN - DEALLOCATE(XT_LS) - DEALLOCATE(XPMASS_LS) - DEALLOCATE(XPS_LS) -END IF -! -IF (ALLOCATED(XPSURF)) DEALLOCATE(XPSURF) -! -CALL SECOND_MNH(ZTIME2) -ZDIAG = ZDIAG + ZTIME2 - ZTIME1 -!------------------------------------------------------------------------------- -! -!* 16. INITIALIZE LEVELSET FOR IBM -! --------------------------- -! -IF (LIBM_LSF) THEN - ! - IF (.NOT.LCARTESIAN) THEN - CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','IBM can only be used with cartesian coordinates') - ENDIF - ! - CALL GET_DIM_EXT_ll('B',NIU,NJU) - NKU=NKMAX+2*JPVEXT - ! - ALLOCATE(XIBM_LS(NIU,NJU,NKU,4)) - ! - CALL IBM_INIT_LS(XIBM_LS) - ! -ENDIF -! -!------------------------------------------------------------------------------- -! -!* 17. WRITING OF THE MESO-NH FM-FILE -! ------------------------------ -! -ZTIME1 = ZTIME2 -! -CSTORAGE_TYPE='TT' -IF (YATMFILETYPE=='GRIBEX') THEN - CSURF = "EXTE" - DO JRR=1,NRR - IF (JRR==1) THEN - LUSERV=.TRUE. - IDX_RVT = JRR - END IF - IF (JRR==2) THEN - LUSERC=.TRUE. - IDX_RCT = JRR - END IF - IF (JRR==3) THEN - LUSERR=.TRUE. - IDX_RRT = JRR - END IF - IF (JRR==4) THEN - LUSERI=.TRUE. - IDX_RIT = JRR - END IF - IF (JRR==5) THEN - LUSERS=.TRUE. - IDX_RST = JRR - END IF - IF (JRR==6) THEN - LUSERG=.TRUE. - IDX_RGT = JRR - END IF - IF (JRR==7) THEN - LUSERH=.TRUE. - IDX_RHT = JRR - END IF - END DO -END IF -! -CALL WRITE_DESFM_n(1,TINIFILE) -CALL IO_Header_write(TINIFILE,HDAD_NAME=YDAD_NAME) -CALL WRITE_LFIFM_n(TINIFILE,YDAD_NAME) -! -CALL SECOND_MNH(ZTIME2) -ZWRITE = ZTIME2 - ZTIME1 -! -!------------------------------------------------------------------------------- -! -!* 18. OROGRAPHIC and DUMMY PHYSIOGRAPHIC FIELDS -! ----------------------------------------- -! -!* reading in the PGD file -! -CALL MNHREAD_ZS_DUMMY_n(TPGDFILE) -! -!* writing in the output file -! -TOUTDATAFILE => TINIFILE -CALL MNHWRITE_ZS_DUMMY_n(TINIFILE) -! -CALL DEALLOCATE_MODEL1(3) -! -IF (YATMFILETYPE=='MESONH'.AND. YATMFILE/=YPGDFILE) THEN - CALL IO_File_find_byname(TRIM(YATMFILE),TZATMFILE,IRESP) - CALL IO_File_close(TZATMFILE) -END IF -!------------------------------------------------------------------------------- -! -!* 19. INTERPOLATION OF SURFACE VARIABLES -! ---------------------------------- -! -IF (.NOT. LCOUPLING ) THEN - ZTIME1 = ZTIME2 -! - IF (CSURF=="EXTE") THEN - IF (YATMFILETYPE/='MESONH') THEN - CALL SURFEX_ALLOC_LIST(1) - YSURF_CUR => YSURF_LIST(1) - CALL READ_ALL_NAMELISTS(YSURF_CUR,'MESONH','PRE',.FALSE.) - ENDIF - CALL GOTO_SURFEX(1) - TFILE_SURFEX => TINIFILE - CALL PREP_SURF_MNH(YSURFFILE,YSURFFILETYPE) - NULLIFY(TFILE_SURFEX) - ENDIF -! - CALL SECOND_MNH(ZTIME2) - ZSURF = ZSURF + ZTIME2 - ZTIME1 -ENDIF -! -!------------------------------------------------------------------------------- -! -!* 20. EPILOGUE -! -------- -! -WRITE(ILUOUT0,*) -WRITE(ILUOUT0,*) -WRITE(ILUOUT0,*) -WRITE(ILUOUT0,*) '**************************************************' -WRITE(ILUOUT0,*) '* PREP_REAL_CASE: PREP_REAL_CASE ends correctly. *' -WRITE(ILUOUT0,*) '**************************************************' -WRITE(ILUOUT0,*) -! -!------------------------------------------------------------------------------- -! -CALL SECOND_MNH (ZEND) -! -ZTOT = ZEND - ZSTART ! for computing time analysis -! -ZALL = ZMISC + ZREAD + ZHORI + ZPREP + ZTHERMO + ZSURF + ZDYN + ZDIAG + ZWRITE -! -WRITE(ILUOUT0,*) -WRITE(ILUOUT0,*) ' ------------------------------------------------------------ ' -WRITE(ILUOUT0,*) '| |' -WRITE(ILUOUT0,*) '| COMPUTING TIME ANALYSIS in PREP_REAL_CASE |' -WRITE(ILUOUT0,*) '| |' -WRITE(ILUOUT0,*) '|------------------------------------------------------------|' -WRITE(ILUOUT0,*) '| | | |' -WRITE(ILUOUT0,*) '| ROUTINE NAME | CPU-TIME | PERCENTAGE % |' -WRITE(ILUOUT0,*) '| | | |' -WRITE(ILUOUT0,*) '|---------------------|-------------------|------------------|' -WRITE(ILUOUT0,*) '| | | |' -WRITE(UNIT=ILUOUT0,FMT=2) ZREAD, 100.*ZREAD/ZTOT -WRITE(UNIT=ILUOUT0,FMT=9) ZHORI, 100.*ZHORI/ZTOT -WRITE(UNIT=ILUOUT0,FMT=3) ZPREP, 100.*ZPREP/ZTOT -WRITE(UNIT=ILUOUT0,FMT=4) ZTHERMO, 100.*ZTHERMO/ZTOT -WRITE(UNIT=ILUOUT0,FMT=6) ZDYN, 100.*ZDYN/ZTOT -WRITE(UNIT=ILUOUT0,FMT=7) ZDIAG, 100.*ZDIAG/ZTOT -WRITE(UNIT=ILUOUT0,FMT=8) ZWRITE, 100.*ZWRITE/ZTOT -WRITE(UNIT=ILUOUT0,FMT=1) ZMISC, 100.*ZMISC/ZTOT -WRITE(UNIT=ILUOUT0,FMT=5) ZSURF, 100.*ZSURF/ZTOT -! -WRITE(UNIT=ILUOUT0,FMT=10) ZTOT , 100.*ZALL/ZTOT -WRITE(ILUOUT0,*) ' ------------------------------------------------------------ ' -! -! FORMATS -! ------- -! -2 FORMAT(' | READING OF DATA | ',F8.3,' | ',F8.3,' |') -9 FORMAT(' | HOR. INTERPOLATIONS | ',F8.3,' | ',F8.3,' |') -3 FORMAT(' | VER_PREP | ',F8.3,' | ',F8.3,' |') -4 FORMAT(' | VER_THERMO | ',F8.3,' | ',F8.3,' |') -6 FORMAT(' | VER_DYN | ',F8.3,' | ',F8.3,' |') -7 FORMAT(' | DIAGNOSTICS | ',F8.3,' | ',F8.3,' |') -8 FORMAT(' | WRITE | ',F8.3,' | ',F8.3,' |') -1 FORMAT(' | MISCELLANEOUS | ',F8.3,' | ',F8.3,' |') -5 FORMAT(' | SURFACE | ',F8.3,' | ',F8.3,' |') -10 FORMAT(' | PREP_REAL_CASE | ',F8.3,' | ',F8.3,' |') -! -!------------------------------------------------------------------------------- -! -IF (LEN_TRIM(YDAD_NAME)>0) THEN - WRITE(ILUOUT0,*) ' ' - WRITE(ILUOUT0,*) ' ------------------------------------------------------------' - WRITE(ILUOUT0,*) '| Nesting allowed |' - WRITE(ILUOUT0,*) '| DAD_NAME="',YDAD_NAME,'" |' - WRITE(ILUOUT0,*) ' ------------------------------------------------------------' - WRITE(ILUOUT0,*) ' ' -ELSE - WRITE(ILUOUT0,*) ' ' - WRITE(ILUOUT0,*) ' ------------------------------------------------------------' - WRITE(ILUOUT0,*) '| Nesting not allowed with a larger-scale model. |' - WRITE(ILUOUT0,*) '| The new file can only be used as model number 1 |' - WRITE(ILUOUT0,*) ' ------------------------------------------------------------' - WRITE(ILUOUT0,*) ' ' -END IF -! -!------------------------------------------------------------------------------- -! -CALL IO_File_close(TINIFILE) -CALL IO_File_close(TPGDFILE) -! -CALL FINALIZE_MNH() -! -!------------------------------------------------------------------------------- -! -CONTAINS - -SUBROUTINE INIT_NMLVAR -CPRESOPT=CPRESOPT_n -LRES=LRES_n -XRES=XRES_n -NITR=NITR_n -LUSECHAQ=LUSECHAQ_n -LUSECHIC=LUSECHIC_n -LUSECHEM=LUSECHEM_n -END SUBROUTINE INIT_NMLVAR - -SUBROUTINE UPDATE_MODD_FROM_NMLVAR -CPRESOPT_n=CPRESOPT -LRES_n=LRES -XRES_n=XRES -NITR_n=NITR -LUSECHAQ_n=LUSECHAQ -LUSECHIC_n=LUSECHIC -LUSECHEM_n=LUSECHEM -END SUBROUTINE UPDATE_MODD_FROM_NMLVAR - -END PROGRAM PREP_REAL_CASE diff --git a/src/ICCARE_BASE/put_sfxcpln.F90 b/src/ICCARE_BASE/put_sfxcpln.F90 deleted file mode 100644 index f1f2df37c..000000000 --- a/src/ICCARE_BASE/put_sfxcpln.F90 +++ /dev/null @@ -1,190 +0,0 @@ -!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -! ######### -SUBROUTINE PUT_SFXCPL_n (F, IM, S, U, W, TM, GDM, GRM, & - HPROGRAM,KI,KSW,PSW_BANDS,PZENITH, & - PLAND_WTD,PLAND_FWTD,PLAND_FFLOOD, & - PLAND_PIFLOOD,PSEA_SST,PSEA_UCU, & - PSEA_VCU,PSEAICE_SIT,PSEAICE_CVR, & - PSEAICE_ALB,PTSRAD, & - PDIR_ALB,PSCA_ALB,PEMIS,PTSURF, & - PWAVE_CHA,PWAVE_UCU,PWAVE_VCU, & - PWAVE_HS,PWAVE_TP ) -! ################################################################################################# -! -!!**** *PUT_SFXCPL_n* - routine to modify some variables in surfex from information coming -! from an ocean and/or a river routing model (but already on Surfex grid) -! -! -!! PURPOSE -!! ------- -!! -!!** METHOD -!! ------ -!! -!! EXTERNAL -!! -------- -!! -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! REFERENCE -!! --------- -!! -!! -!! AUTHOR -!! ------ -!! B. Decharme *Meteo France* -!! -!! MODIFICATIONS -!! ------------- -!! Original 08/2009 -!! Modified 11/2014 : J. Pianezze - add wave coupling parameters -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_FLAKE_n, ONLY : FLAKE_t -USE MODD_SURFEX_n, ONLY : ISBA_MODEL_t, TEB_MODEL_t, & - TEB_GARDEN_MODEL_t,TEB_GREENROOF_MODEL_t -USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t -USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t -USE MODD_WATFLUX_n, ONLY : WATFLUX_t -! -USE MODD_SURF_PAR, ONLY : XUNDEF -! -USE MODN_SFX_OASIS, ONLY : LWATER -USE MODD_SFX_OASIS, ONLY : LCPL_SEA, LCPL_SEAICE, & - LCPL_LAND, LCPL_GW, & - LCPL_FLOOD, LCPL_WAVE -! -USE MODI_GET_LUOUT -! -USE MODI_ABOR1_SFX -USE MODI_PUT_SFX_LAND -USE MODI_PUT_SFX_SEA -USE MODI_PUT_SFX_WAVE -USE MODI_UPDATE_ESM_SURF_ATM_n -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -IMPLICIT NONE -! -!* 0.1 Declarations of arguments -! ------------------------- -! -! -TYPE(FLAKE_t), INTENT(INOUT) :: F -TYPE(ISBA_MODEL_t), INTENT(INOUT) :: IM -TYPE(SEAFLUX_t), INTENT(INOUT) :: S -TYPE(SURF_ATM_t), INTENT(INOUT) :: U -TYPE(WATFLUX_t), INTENT(INOUT) :: W -TYPE(TEB_MODEL_t), INTENT(INOUT) :: TM -TYPE(TEB_GARDEN_MODEL_t), INTENT(INOUT) :: GDM -TYPE(TEB_GREENROOF_MODEL_t), INTENT(INOUT) :: GRM -! -CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM -INTEGER, INTENT(IN) :: KI ! number of points -INTEGER, INTENT(IN) :: KSW ! number of bands -! -REAL, DIMENSION(KI), INTENT(IN) :: PZENITH -REAL, DIMENSION(KSW), INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m) -! -REAL, DIMENSION(KI), INTENT(IN) :: PLAND_WTD ! Land water table depth (m) -REAL, DIMENSION(KI), INTENT(IN) :: PLAND_FWTD ! Land grid-cell fraction of water table rise (-) -REAL, DIMENSION(KI), INTENT(IN) :: PLAND_FFLOOD ! Land Floodplains fraction (-) -REAL, DIMENSION(KI), INTENT(IN) :: PLAND_PIFLOOD ! Land Potential flood infiltration (kg/m2) -! -REAL, DIMENSION(KI), INTENT(IN) :: PSEA_SST ! Sea surface temperature (K) -REAL, DIMENSION(KI), INTENT(IN) :: PSEA_UCU ! Sea u-current stress (Pa) -REAL, DIMENSION(KI), INTENT(IN) :: PSEA_VCU ! Sea v-current stress (Pa) -! -REAL, DIMENSION(KI), INTENT(IN) :: PSEAICE_SIT ! Sea-ice Temperature (K) -REAL, DIMENSION(KI), INTENT(IN) :: PSEAICE_CVR ! Sea-ice cover (-) -REAL, DIMENSION(KI), INTENT(IN) :: PSEAICE_ALB ! Sea-ice albedo (-) -! -REAL, DIMENSION(KI), INTENT(IN) :: PWAVE_CHA ! Charnock coefficient (-) -REAL, DIMENSION(KI), INTENT(IN) :: PWAVE_UCU ! u-current velocity (m/s) -REAL, DIMENSION(KI), INTENT(IN) :: PWAVE_VCU ! v-current velocity (m/s) -REAL, DIMENSION(KI), INTENT(IN) :: PWAVE_HS ! Significant wave height (m) -REAL, DIMENSION(KI), INTENT(IN) :: PWAVE_TP ! Peak period (s) -! -REAL, DIMENSION(KI), INTENT(OUT) :: PTSRAD ! Total radiative temperature see by the atmosphere -REAL, DIMENSION(KI), INTENT(OUT) :: PTSURF ! Total surface temperature see by the atmosphere -REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS ! Total emissivity see by the atmosphere -REAL, DIMENSION(KI,KSW), INTENT(OUT) :: PDIR_ALB ! Total direct albedo see by the atmosphere -REAL, DIMENSION(KI,KSW), INTENT(OUT) :: PSCA_ALB ! Total diffus albedo see by the atmosphere -! -! -!* 0.2 Declarations of local variables -! ------------------------------- -! -! -INTEGER :: ILU, ILUOUT -REAL(KIND=JPRB) :: ZHOOK_HANDLE -! -!------------------------------------------------------------------------------- -IF (LHOOK) CALL DR_HOOK('PUT_SFXCL_N',0,ZHOOK_HANDLE) -! -CALL GET_LUOUT(HPROGRAM,ILUOUT) -!------------------------------------------------------------------------------- -! -! Global argument -! -IF(KI/=U%NSIZE_FULL)THEN - WRITE(ILUOUT,*) 'size of field from the coupler :', KI - WRITE(ILUOUT,*) 'size of field in SURFEX :', U%NSIZE_FULL - CALL ABOR1_SFX('PUT_SFXCPL_N: VECTOR SIZE NOT CORRECT FOR COUPLING') -ENDIF -! -!------------------------------------------------------------------------------- -! Put variable over land tile -!------------------------------------------------------------------------------- -! -IF(LCPL_LAND)THEN - CALL PUT_SFX_LAND(IM%O, IM%S, IM%K, IM%NK, IM%NP, U, ILUOUT, LCPL_GW, LCPL_FLOOD, & - PLAND_WTD(:), PLAND_FWTD(:),PLAND_FFLOOD(:),PLAND_PIFLOOD(:)) -ENDIF -! -!------------------------------------------------------------------------------- -! Put variable over sea and/or water tile -!------------------------------------------------------------------------------- -! -IF(LCPL_SEA)THEN -! - CALL PUT_SFX_SEA(S, U, W, ILUOUT,LCPL_SEAICE,LWATER,PSEA_SST(:),PSEA_UCU(:), & - PSEA_VCU(:),PSEAICE_SIT(:),PSEAICE_CVR(:),PSEAICE_ALB(:) ) -! -ENDIF -! -!------------------------------------------------------------------------------- -! Put variable over sea and/or water tile for waves -!------------------------------------------------------------------------------- -! -IF(LCPL_WAVE)THEN -! - CALL PUT_SFX_WAVE(S, U, & - ILUOUT,PWAVE_CHA(:),PWAVE_UCU(:),PWAVE_VCU(:),PWAVE_HS(:),PWAVE_TP(:) ) -! -ENDIF -! -!------------------------------------------------------------------------------- -! Update radiative properties at time t+1 for radiative scheme -!------------------------------------------------------------------------------- -! -IF(LCPL_SEA.OR.LCPL_FLOOD)THEN - CALL UPDATE_ESM_SURF_ATM_n(F, IM, S, U, W, TM, GDM, GRM, HPROGRAM, KI, KSW, PZENITH, & - PSW_BANDS, PTSRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF ) -ENDIF -! -!------------------------------------------------------------------------------- -! -IF (LHOOK) CALL DR_HOOK('PUT_SFXCL_N',1,ZHOOK_HANDLE) -! -! -END SUBROUTINE PUT_SFXCPL_n diff --git a/src/ICCARE_BASE/rain_ice_elec.f90 b/src/ICCARE_BASE/rain_ice_elec.f90 deleted file mode 100644 index a73a0250c..000000000 --- a/src/ICCARE_BASE/rain_ice_elec.f90 +++ /dev/null @@ -1,5850 +0,0 @@ -!MNH_LIC Copyright 2002-2021 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!----------------------------------------------------------------- -! ######################### - MODULE MODI_RAIN_ICE_ELEC -! ######################### -! -INTERFACE - SUBROUTINE RAIN_ICE_ELEC (OSEDIC, HSUBG_AUCV, OWARM, & - KSPLITR, PTSTEP, KMI, KRR, & - PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, & - PTHT, PRVT, PRCT, PRRT, PRIT, PRST, & - PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, & - PINPRC, PINPRR, PINPRR3D, PEVAP3D, & - PINPRS, PINPRG, PSIGS, & - PQPIT, PQCT, PQRT, PQIT, PQST, PQGT, PQNIT, & - PQPIS, PQCS, PQRS, PQIS, PQSS, PQGS, PQNIS, & - PSEA, PTOWN, & - PRHT, PRHS, PINPRH, PQHT, PQHS ) -! -! -LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim. -CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV - ! Kind of Subgrid autoconversion method -LOGICAL, INTENT(IN) :: OWARM ! .TRUE. allows raindrops to - ! form by warm processes - ! (Kessler scheme) -! -INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step - ! integration for rain sedimendation -REAL, INTENT(IN) :: PTSTEP ! Double Time step - ! (single if cold start) -INTEGER, INTENT(IN) :: KMI ! Model index -INTEGER, INTENT(IN) :: KRR ! Number of moist variable -! -REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z) -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density -REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function -REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! absolute pressure at t -! -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t -REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! Cloud fraction -! -REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Pristine ice m.r. at t -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t -! -REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at t -! -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel m.r. source -! -REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip -REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! Rain inst precip 3D -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile -REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip -REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip -! -! Charge Mixing Ratio (CMR) (C/kg) -REAL, DIMENSION(:,:,:), INTENT(IN) :: PQPIT ! Positive ion (Nb/kg) at t -REAL, DIMENSION(:,:,:), INTENT(IN) :: PQNIT ! Negative ion (Nb/kg) at t -REAL, DIMENSION(:,:,:), INTENT(IN) :: PQCT ! Cloud water CMR at t -REAL, DIMENSION(:,:,:), INTENT(IN) :: PQRT ! Rain water CMR at t -REAL, DIMENSION(:,:,:), INTENT(IN) :: PQIT ! Pristine ice CMR at t -REAL, DIMENSION(:,:,:), INTENT(IN) :: PQST ! Snow/aggregate CMR at t -REAL, DIMENSION(:,:,:), INTENT(IN) :: PQGT ! Graupel CMR at t -! -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQPIS ! Positive ion source -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQNIS ! Negative ion source -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQCS ! Cloud water CMR source -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQRS ! Rain water CMR source -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQIS ! Pristine ice CMR source -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQSS ! Snow/aggregate CMR source -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQGS ! Graupel CMR source -! -REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA -REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN -REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t -REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source -REAL, DIMENSION(:,:), OPTIONAL, INTENT(INOUT) :: PINPRH ! Hail instant precip -REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PQHT ! Hail CMR at t -REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PQHS ! Hail CMR source -! -END SUBROUTINE RAIN_ICE_ELEC -END INTERFACE -END MODULE MODI_RAIN_ICE_ELEC -! -! ######spl - SUBROUTINE RAIN_ICE_ELEC (OSEDIC, HSUBG_AUCV, OWARM, & - KSPLITR, PTSTEP, KMI, KRR, & - PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, & - PTHT, PRVT, PRCT, PRRT, PRIT, PRST, & - PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, & - PINPRC, PINPRR, PINPRR3D, PEVAP3D, & - PINPRS, PINPRG, PSIGS, & - PQPIT, PQCT, PQRT, PQIT, PQST, PQGT, PQNIT, & - PQPIS, PQCS, PQRS, PQIS, PQSS, PQGS, PQNIS, & - PSEA, PTOWN, & - PRHT, PRHS, PINPRH, PQHT, PQHS ) -! ###################################################################### -! -!!**** * - compute the explicit microphysical sources -!! and the cloud electrification -!! -!! PURPOSE -!! ------- -!! The purpose of this routine is to compute the slow microphysical sources -!! which can be computed explicitly -!! -!! -!!** METHOD -!! ------ -!! The autoconversion computation follows Kessler (1969). -!! The sedimentation rate is computed with a time spliting technique and -!! an upstream scheme, written as a difference of non-advective fluxes. This -!! source term is added to the future instant ( split-implicit process ). -!! The others microphysical processes are evaluated at the central instant -!! (split-explicit process ): autoconversion, accretion and rain evaporation. -!! These last 3 terms are bounded in order not to create negative values -!! for the water species at the future instant. -!! -!! EXTERNAL -!! -------- -!! None -!! -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! Module MODD_PARAMETERS -!! JPHEXT : Horizontal external points number -!! JPVEXT : Vertical external points number -!! Module MODD_CONF : -!! CCONF configuration of the model for the first time step -!! Module MODD_CST -!! XP00 ! Reference pressure -!! XRD,XRV ! Gaz constant for dry air, vapor -!! XMD,XMV ! Molecular weight for dry air, vapor -!! XCPD ! Cpd (dry air) -!! XCL ! Cl (liquid) -!! XCI ! Ci (solid) -!! XTT ! Triple point temperature -!! XLVTT ! Vaporization heat constant -!! XALPW,XBETAW,XGAMW ! Constants for saturation vapor pressure -!! function over liquid water -!! XALPI,XBETAI,XGAMI ! Constants for saturation vapor pressure -!! function over solid ice -!! -!! REFERENCE -!! --------- -!! -!! -!! -!! AUTHOR -!! ------ -!! C. Barthe, G. Molinie, J.-P. Pinty * Laboratoire d'Aerologie* -!! -!! MODIFICATIONS -!! ------------- -!! Original 2002 -!! Modifications -!! C. Barthe (LACy) Nov. 2009 : update to V4.8.1 -!! M. Chong 26/01/10 Add Small ions parameters -!! J-P Pinty 31/03/11 Add hail -!! C. Lac 2011 : Adaptation to FIT temporal scheme -!! B. Tsenova June 2012 Add new NI parameterizations -!! C. Barthe June 2012 Dependance of RAR on the RELATIVE terminal velocity -!! M. Chong 06/08/13 Add "Beard" effect (ELEC=>MICROPHYSICS) -!! J-P Pinty 21/08/13 Correction of the process limitation algo. -!! SIGN(MIN(ABS ... -!! Correction in elec_update_qd -!! Correction of hail charge transfer -!! Add hail growth charging processes -!! J-P Pinty 26/08/13 Add "Beard" effect control (ELEC=>MICROPHYS) -!! for sedimentation -!! J-P Pinty 26/09/13 Add tabulated treatment of SAUN1 and SAUN2 -!! J-P Pinty 30/09/13 Remove call to MOMG function -!! J-P Pinty 25/10/13 Add "Latham" effect for aggregation process -!! M. Chong 31/10/13 Add other tabulated treatment and recode -!! M. Chong 15/11/13 Bug in the computation of RGWETH (wrong sign) -!! J-P Pinty 25/04/14 Many bugs with ZWQ1(:,...) = 0.0 -!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1 -!! J.Escobar : 10/2017 : for real*4 , limit exp() in RAIN_ICE_ELEC_SLOW with XMNH_HUGE_12_LOG -! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O -! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function -! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90 -! P. Wautelet 03/2020: use the new data structures and subroutines for budgets -! P .Wautelet 09/03/2020: add missing budgets for electricity -! C. Barthe 07/04/2022: correction of budget for CMEL -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -use modd_budget, only: lbu_enable, & - lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, & - lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, & - NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, & - NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, & - tbudgets -USE MODD_CONF -USE MODD_CST -USE MODD_ELEC_DESCR -USE MODD_ELEC_n -USE MODD_ELEC_PARAM -USE MODD_LES -USE MODE_ll -USE MODD_NSV, ONLY: NSV_ELECBEG, NSV_ELECEND ! Scalar variables for budgets -USE MODD_PARAMETERS -USE MODD_PARAM_ICE -USE MODD_RAIN_ICE_DESCR -USE MODD_RAIN_ICE_PARAM -USE MODD_REF, ONLY: XTHVREFZ - -use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end -#ifdef MNH_PGI -USE MODE_PACK_PGI -#endif -use mode_tools, only: Countjv - -USE MODI_MOMG - -IMPLICIT NONE -! -! -!* 0.1 Declarations of dummy arguments : -! -LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim. -CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV - ! Kind of Subgrid autoconversion method -LOGICAL, INTENT(IN) :: OWARM ! .TRUE. allows raindrops to - ! form by warm processes - ! (Kessler scheme) -! -INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step - ! integration for rain sedimendation -REAL, INTENT(IN) :: PTSTEP ! Double Time step - ! (single if cold start) -INTEGER, INTENT(IN) :: KMI ! Model index -INTEGER, INTENT(IN) :: KRR ! Number of moist variable -! -REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z) -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density -REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function -REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! absolute pressure at t -! -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t -REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR! Convective Mass Flux Cloud fraction -! -REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Pristine ice m.r. at t -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t -REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at t -! -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel m.r. source -! -REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip -REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! Rain inst precip 3D -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile -REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip -REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip -! -! Charge Mixing Ratio (CMR) (C/kg) -REAL, DIMENSION(:,:,:), INTENT(IN) :: PQPIT ! Positive ion (Nb/kg) at t -REAL, DIMENSION(:,:,:), INTENT(IN) :: PQNIT ! Negative ion (Nb/kg) at t -REAL, DIMENSION(:,:,:), INTENT(IN) :: PQCT ! Cloud water CMR at t -REAL, DIMENSION(:,:,:), INTENT(IN) :: PQRT ! Rain water CMR at t -REAL, DIMENSION(:,:,:), INTENT(IN) :: PQIT ! Pristine ice CMR at t -REAL, DIMENSION(:,:,:), INTENT(IN) :: PQST ! Snow/aggregate CMR at t -REAL, DIMENSION(:,:,:), INTENT(IN) :: PQGT ! Graupel CMR at t -! -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQPIS ! Positive ion source -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQNIS ! Negative ion source -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQCS ! Cloud water CMR source -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQRS ! Rain water CMR source -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQIS ! Pristine ice CMR source -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQSS ! Snow/aggregate CMR source -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PQGS ! Graupel CMR source -! -REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA -REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN -REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t -REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source -REAL, DIMENSION(:,:), OPTIONAL, INTENT(INOUT) :: PINPRH ! Hail instant precip -REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PQHT ! Hail CMR at t -REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PQHS ! Hail CMR source -! -! -!* 0.2 Declarations of local variables : -! -INTEGER :: JK ! Vertical loop index for the rain sedimentation -INTEGER :: JN ! Temporal loop index for the rain sedimentation -INTEGER :: JJ ! Loop index for the interpolation -INTEGER :: JI ! Loop index for the interpolation -INTEGER :: IIB ! Define the domain where is -INTEGER :: IIE ! the microphysical sources have to be computed -INTEGER :: IJB ! -INTEGER :: IJE ! -INTEGER :: IKB ! -INTEGER :: IKE ! -! -REAL :: ZTSPLITR ! Small time step for rain sedimentation -! -! -INTEGER :: ISEDIMR,ISEDIMC, ISEDIMI, ISEDIMS, ISEDIMG, ISEDIMH, & - INEGT, IMICRO ! Case number of sedimentation, T>0 (for HEN) - ! and r_x>0 locations -INTEGER :: IGRIM, IGACC, IGDRY ! Case number of riming, accretion and dry growth - ! locations -INTEGER :: IGWET, IHAIL ! wet growth locations and case number -! -LOGICAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) & - :: GSEDIMR, GSEDIMC, GSEDIMI, GSEDIMS, GSEDIMG, GSEDIMH ! Test where to compute the SED processes -LOGICAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) & - :: GNEGT ! Test where to compute the HEN process -LOGICAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) & - :: GMICRO ! Test where to compute all processes -LOGICAL, DIMENSION(:), ALLOCATABLE :: GRIM ! Test where to compute riming -LOGICAL, DIMENSION(:), ALLOCATABLE :: GACC ! Test where to compute accretion -LOGICAL, DIMENSION(:), ALLOCATABLE :: GDRY ! Test where to compute dry growth -LOGICAL, DIMENSION(:), ALLOCATABLE :: GWET ! Test where to compute wet growth -LOGICAL, DIMENSION(:), ALLOCATABLE :: GHAIL ! Test where to compute hail growth -! -INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1,IVEC2 ! Vectors of indices for - ! interpolations -REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1,ZVEC2,ZVEC3 ! Work vectors for - ! interpolations -REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) & - :: ZW ! work array -REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) & - :: ZPRCS, ZPRRS, ZPRSS, ZPRGS, ZPRHS ! Mixing ratios created during the time step -REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) & - :: ZWSED ! sedimentation fluxes -REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) & - :: ZWSEDW1 ! sedimentation speed -REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) & - :: ZWSEDW2 ! sedimentation speed -REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2)) & - :: ZCONC_TMP ! Weighted concentration -REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) & - :: ZT ! Temperature -REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: & - ZRAY, & ! Cloud Mean radius - ZLBC, & ! XLBC weighted by sea fraction - ZFSEDC -REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) & - :: ZPQRS, ZPQSS, ZPQGS, ZPQHS ! Charge Mixing ratios created during the time step -REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) & - :: ZWSEDQ ! sedimentation fluxes for charge -REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t -REAL, DIMENSION(:), ALLOCATABLE :: ZRCT ! Cloud water m.r. at t -REAL, DIMENSION(:), ALLOCATABLE :: ZRRT ! Rain water m.r. at t -REAL, DIMENSION(:), ALLOCATABLE :: ZRIT ! Pristine ice m.r. at t -REAL, DIMENSION(:), ALLOCATABLE :: ZRST ! Snow/aggregate m.r. at t -REAL, DIMENSION(:), ALLOCATABLE :: ZRGT ! Graupel m.r. at t -REAL, DIMENSION(:), ALLOCATABLE :: ZRHT ! Hail m.r. at t -REAL, DIMENSION(:), ALLOCATABLE :: ZCIT ! Pristine ice conc. at t -! -REAL, DIMENSION(:), ALLOCATABLE :: ZRVS ! Water vapor m.r. source -REAL, DIMENSION(:), ALLOCATABLE :: ZRCS ! Cloud water m.r. source -REAL, DIMENSION(:), ALLOCATABLE :: ZRRS ! Rain water m.r. source -REAL, DIMENSION(:), ALLOCATABLE :: ZRIS ! Pristine ice m.r. source -REAL, DIMENSION(:), ALLOCATABLE :: ZRSS ! Snow/aggregate m.r. source -REAL, DIMENSION(:), ALLOCATABLE :: ZRGS ! Graupel m.r. source -REAL, DIMENSION(:), ALLOCATABLE :: ZRHS ! Hail m.r. source -REAL, DIMENSION(:), ALLOCATABLE :: ZTHS ! Theta source -REAL, DIMENSION(:), ALLOCATABLE :: ZCRIAUTI ! Snow-to-ice autoconversion thres. -! -REAL, DIMENSION(:), ALLOCATABLE & - :: ZRHODREF, & ! RHO Dry REFerence - ZRHODREFC,& ! RHO Dry REFerence - ZRHODREFR,& ! RHO Dry REFerence - ZRHODREFI,& ! RHO Dry REFerence - ZRHODREFS,& ! RHO Dry REFerence - ZRHODREFG,& ! RHO Dry REFerence - ZRHODREFH,& ! RHO Dry REFerence - ZRHODJ, & ! RHO times Jacobian - ZZT, & ! Temperature - ZPRES, & ! Pressure - ZEXNREF, & ! EXNer Pressure REFerence - ZZW, & ! Work array - ZLSFACT, & ! L_s/(Pi_ref*C_ph) - ZLVFACT, & ! L_v/(Pi_ref*C_ph) - ZUSW, & ! Undersaturation over water - ZSSI, & ! Supersaturation over ice - ZLBDAI, & ! Slope parameter of the pristine ice distribution - ZLBDAR, & ! Slope parameter of the raindrop distribution - ZLBDAS, & ! Slope parameter of the aggregate distribution - ZLBDAG, & ! Slope parameter of the graupel distribution - ZLBDAH, & ! Slope parameter of the hail distribution - ZRDRYG, & ! Dry growth rate of the graupeln - ZRWETG, & ! Wet growth rate of the graupeln - ZAI, & ! Thermodynamical function - ZCJ, & ! Function to compute the ventilation coefficient - ZKA, & ! Thermal conductivity of the air - ZDV, & ! Diffusivity of water vapor in the air - ZSIGMA_RC,& ! Standard deviation of rc at time t - ZCF, & ! Cloud fraction - ZCC, & ! terminal velocity - ZFSEDC1D, & ! For cloud sedimentation - ZWLBDC, & ! Slope parameter of the droplet distribution - ZCONC, & ! Concentration des aérosols - ZRAY1D, & ! Mean radius - ZWLBDA ! Libre parcours moyen -REAL, DIMENSION(:,:), ALLOCATABLE :: ZZW1 ! Work arrays -REAL :: ZTIMAUTIC -REAL, DIMENSION(SIZE(XRTMIN)) :: ZRTMIN -! -INTEGER , DIMENSION(SIZE(GMICRO)) :: I1,I2,I3 ! Used to replace the COUNT -INTEGER :: JL ! and PACK intrinsics -! -LOGICAL, DIMENSION(:,:),ALLOCATABLE :: GELEC ! Logical of work for elec -REAL, DIMENSION(:), ALLOCATABLE :: ZRSMIN_ELEC ! Limit value of ZRXS where charge is available -REAL, DIMENSION(:), ALLOCATABLE :: ZVECQ4, & ! Work - ZVECQ5, & ! vectors for - ZVECQ6, & ! interpolations - ZVECQ7 ! (electrification) -REAL, DIMENSION(:,:), ALLOCATABLE :: ZWQ1 ! Work array for electrification -REAL, DIMENSION(:), ALLOCATABLE :: ZWQ3,ZWQ4 ! Work arrays for electrification - -REAL, DIMENSION(:), ALLOCATABLE :: ZQPIT ! Positive ion (kg^-1) at t -REAL, DIMENSION(:), ALLOCATABLE :: ZQNIT ! Negative ion (kg^-1) at t -REAL, DIMENSION(:), ALLOCATABLE :: ZQCT ! Cloud water CMR at t -REAL, DIMENSION(:), ALLOCATABLE :: ZQRT ! Rain water m.r. at t -REAL, DIMENSION(:), ALLOCATABLE :: ZQIT ! Pristine ice CMR at t -REAL, DIMENSION(:), ALLOCATABLE :: ZQST ! Snow/aggregate CMR at t -REAL, DIMENSION(:), ALLOCATABLE :: ZQGT ! Graupel CMR at t -REAL, DIMENSION(:), ALLOCATABLE :: ZQHT ! Hail CMR at t -! -REAL, DIMENSION(:), ALLOCATABLE :: ZQPIS ! Positive ion source -REAL, DIMENSION(:), ALLOCATABLE :: ZQNIS ! Negative ion source -REAL, DIMENSION(:), ALLOCATABLE :: ZQCS ! Cloud water CMR source -REAL, DIMENSION(:), ALLOCATABLE :: ZQRS ! Rain water CMR source -REAL, DIMENSION(:), ALLOCATABLE :: ZQIS ! Pristine ice CMR source -REAL, DIMENSION(:), ALLOCATABLE :: ZQSS ! Snow/aggregate CMR source -REAL, DIMENSION(:), ALLOCATABLE :: ZQGS ! Graupel CMR source -REAL, DIMENSION(:), ALLOCATABLE :: ZQHS ! Hail CMR source -! -! Charge diameter relation -REAL, DIMENSION(:), ALLOCATABLE :: ZECT ! Cloud water at t -REAL, DIMENSION(:), ALLOCATABLE :: ZERT ! Rain water at t -REAL, DIMENSION(:), ALLOCATABLE :: ZEIT ! Pristine ice at t -REAL, DIMENSION(:), ALLOCATABLE :: ZEST ! Snow/aggregate at t -REAL, DIMENSION(:), ALLOCATABLE :: ZEGT ! Graupel at t -REAL, DIMENSION(:), ALLOCATABLE :: ZEHT ! Hail at t -! -REAL, DIMENSION(:), ALLOCATABLE :: ZECS ! Cloud water at t+dt -REAL, DIMENSION(:), ALLOCATABLE :: ZERS ! Rain water at t+dt -REAL, DIMENSION(:), ALLOCATABLE :: ZEIS ! Pristine ice at t+dt -REAL, DIMENSION(:), ALLOCATABLE :: ZESS ! Snow/aggregate at t+dt -REAL, DIMENSION(:), ALLOCATABLE :: ZEGS ! Graupel at t+dt -REAL, DIMENSION(:), ALLOCATABLE :: ZEHS ! Hail at t+dt -! -REAL, DIMENSION(:), ALLOCATABLE :: ZDELTALWC ! Gap between LWC and a critical LWC -REAL, DIMENSION(:), ALLOCATABLE :: ZLWCC ! Critical LWC in NI charging -REAL, DIMENSION(:), ALLOCATABLE :: ZFT ! Fct depending on temperature -! -! Non-inductive charging process following Saunders et al. (1991) / EW -REAL, DIMENSION(:), ALLOCATABLE :: ZEW ! Effective liquid water content -REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNSK ! constant B _______________________ -REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNIM ! d_i exponent ____________________ -REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNIN ! v_g/s-v_i________________________ -REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNSM ! d_s exponent ____________________ -REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNSN ! v_g-v_s _________________________ -REAL, DIMENSION(:), ALLOCATABLE :: ZFQIAGGS, ZFQIDRYGBS -REAL, DIMENSION(:), ALLOCATABLE :: ZLBQSDRYGB1S, ZLBQSDRYGB2S, ZLBQSDRYGB3S -! -! Non-inductive charging process following Saunders and Peck (1998) / RAR -REAL, DIMENSION(:), ALLOCATABLE :: ZVGMEAN ! Mean velocity of graupel -REAL, DIMENSION(:), ALLOCATABLE :: ZVSMEAN ! Mean velocity of snow -REAL, DIMENSION(:), ALLOCATABLE :: ZRHOCOR ! Density correction for fallspeed -REAL, DIMENSION(:), ALLOCATABLE :: ZRAR ! Rime accretion rate -REAL, DIMENSION(:), ALLOCATABLE :: ZRAR_CRIT ! Critical RAR -REAL, DIMENSION(:), ALLOCATABLE :: ZDQRAR_IS ! q= f(RAR,T) in Saunders and Peck's equation -REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNIM_IS ! d_i exponent ____________________ -REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNIN_IS ! v_g/s-v_i________________________ -REAL, DIMENSION(:), ALLOCATABLE :: ZDQRAR_IG ! q= f(RAR,T) in Saunders and Peck's equation -REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNIM_IG ! d_i exponent ____________________ -REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNIN_IG ! v_g/s-v_i________________________ -REAL, DIMENSION(:), ALLOCATABLE :: ZDQRAR_SG ! q= f(RAR,T) in Saunders and Peck's equation -REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNSK_SG ! constant B _______________________ -REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNSM_SG ! d_s exponent ____________________ -REAL, DIMENSION(:), ALLOCATABLE :: ZSAUNSN_SG ! v_g-v_s _________________________ -! -! Non-inductive charging process following Takahashi (1978) -INTEGER :: IGTAKA ! Case number of charge separation for Takahashi param. -LOGICAL, DIMENSION(:), ALLOCATABLE :: GTAKA ! Test where to compute charge - ! separation for Takahashi param. -REAL, DIMENSION(:), ALLOCATABLE :: ZDQTAKA_OPT ! Optimized array of separated charge -! -INTEGER :: IGSAUN ! Case number of charge separation for Saunders param. -LOGICAL, DIMENSION(:), ALLOCATABLE :: GSAUN ! Test where to compute charge - ! separation for Saunders param. -REAL, DIMENSION(:), ALLOCATABLE :: ZDQLWC_OPT ! Optimized array of separated charge -REAL, DIMENSION(:), ALLOCATABLE :: ZDQLWC ! q=f(LWC,T) -! -! Inductive charging process (Ziegler et al., 1991) -INTEGER :: IIND ! Case number of inductive process -LOGICAL, DIMENSION(:), ALLOCATABLE :: GIND ! Test where to compute inductive process -REAL, DIMENSION(:), ALLOCATABLE :: ZRATE_IND ! Charge transfer rate during inductive process -REAL, DIMENSION(:), ALLOCATABLE :: ZEFIELDW ! Vertical component of the electric field -! -! Latham's effect -REAL, DIMENSION(:), ALLOCATABLE :: ZLATHAMIAGGS ! E Function to simulate - ! enhancement of IAGGS -REAL, DIMENSION(:), ALLOCATABLE :: ZEFIELDU ! Horiz. component of the electric field -REAL, DIMENSION(:), ALLOCATABLE :: ZEFIELDV ! Horiz. component of the electric field -! -REAL, DIMENSION(:), ALLOCATABLE :: ZLIMIT, ZAUX, ZAUX1 -REAL, DIMENSION(:), ALLOCATABLE :: ZCOLIS ! Collection efficiency between ice and snow -REAL, DIMENSION(:), ALLOCATABLE :: ZCOLIG ! Collection efficiency between ice and graupeln -REAL, DIMENSION(:), ALLOCATABLE :: ZCOLSG ! Collection efficiency between snow and graupeln -REAL :: ZRHO00, ZCOR00 ! Surface reference air density -! -!------------------------------------------------------------------------------- -! -!* 1. COMPUTE THE LOOP BOUNDS -! ----------------------- -! -CALL GET_INDICE_ll (IIB,IJB,IIE,IJE) -IKB = 1 + JPVEXT -IKE = SIZE(PZZ,3) - JPVEXT -! -ZRHO00 = XP00 / (XRD * XTHVREFZ(IKB)) -ZCOR00 = ZRHO00**XCEXVT -! -! -!* 2. COMPUTES THE SLOW COLD PROCESS SOURCES -! -------------------------------------- -! -!* 2.1 compute the ice nucleation -! -CALL RAIN_ICE_ELEC_NUCLEATION -! -! -!* 2.2 allocations -! -! optimization by looking for locations where -! the microphysical fields are larger than a minimal value only !!! -! -GMICRO(:,:,:) = .FALSE. - -IF ( KRR == 7 ) THEN - GMICRO(IIB:IIE,IJB:IJE,IKB:IKE) = & - PRCT(IIB:IIE,IJB:IJE,IKB:IKE) > XRTMIN(2) .OR. & - PRRT(IIB:IIE,IJB:IJE,IKB:IKE) > XRTMIN(3) .OR. & - PRIT(IIB:IIE,IJB:IJE,IKB:IKE) > XRTMIN(4) .OR. & - PRST(IIB:IIE,IJB:IJE,IKB:IKE) > XRTMIN(5) .OR. & - PRGT(IIB:IIE,IJB:IJE,IKB:IKE) > XRTMIN(6) .OR. & - PRHT(IIB:IIE,IJB:IJE,IKB:IKE) > XRTMIN(7) -ELSE IF( KRR == 6 ) THEN - GMICRO(IIB:IIE,IJB:IJE,IKB:IKE) = & - PRCT(IIB:IIE,IJB:IJE,IKB:IKE) > XRTMIN(2) .OR. & - PRRT(IIB:IIE,IJB:IJE,IKB:IKE) > XRTMIN(3) .OR. & - PRIT(IIB:IIE,IJB:IJE,IKB:IKE) > XRTMIN(4) .OR. & - PRST(IIB:IIE,IJB:IJE,IKB:IKE) > XRTMIN(5) .OR. & - PRGT(IIB:IIE,IJB:IJE,IKB:IKE) > XRTMIN(6) -END IF - -IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:)) -! -IF (IMICRO > 0) THEN - ALLOCATE(ZRVT(IMICRO)) - ALLOCATE(ZRCT(IMICRO)) - ALLOCATE(ZRRT(IMICRO)) - ALLOCATE(ZRIT(IMICRO)) - ALLOCATE(ZRST(IMICRO)) - ALLOCATE(ZRGT(IMICRO)) - IF (KRR == 7) ALLOCATE(ZRHT(IMICRO)) - ALLOCATE(ZCIT(IMICRO)) - ALLOCATE(ZRVS(IMICRO)) - ALLOCATE(ZRCS(IMICRO)) - ALLOCATE(ZRRS(IMICRO)) - ALLOCATE(ZRIS(IMICRO)) - ALLOCATE(ZRSS(IMICRO)) - ALLOCATE(ZRGS(IMICRO)) - IF (KRR == 7) ALLOCATE(ZRHS(IMICRO)) - ALLOCATE(ZTHS(IMICRO)) - ALLOCATE(ZRHODREF(IMICRO)) - ALLOCATE(ZZT(IMICRO)) - ALLOCATE(ZPRES(IMICRO)) - ALLOCATE(ZEXNREF(IMICRO)) - ALLOCATE(ZSIGMA_RC(IMICRO)) - ALLOCATE(ZCF(IMICRO)) - DO JL = 1, IMICRO - ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL)) - ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL)) - ZRRT(JL) = PRRT(I1(JL),I2(JL),I3(JL)) - ZRIT(JL) = PRIT(I1(JL),I2(JL),I3(JL)) - ZRST(JL) = PRST(I1(JL),I2(JL),I3(JL)) - ZRGT(JL) = PRGT(I1(JL),I2(JL),I3(JL)) - IF (KRR == 7) ZRHT(JL) = PRHT(I1(JL),I2(JL),I3(JL)) - ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL)) - IF (HSUBG_AUCV == 'SIGM') THEN - ZSIGMA_RC(JL) = PSIGS(I1(JL),I2(JL),I3(JL)) * 2. - ELSE IF (HSUBG_AUCV == 'CLFR') THEN - ZCF(JL) = PCLDFR(I1(JL),I2(JL),I3(JL)) - END IF -! - ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL)) - ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL)) - ZRRS(JL) = PRRS(I1(JL),I2(JL),I3(JL)) - ZRIS(JL) = PRIS(I1(JL),I2(JL),I3(JL)) - ZRSS(JL) = PRSS(I1(JL),I2(JL),I3(JL)) - ZRGS(JL) = PRGS(I1(JL),I2(JL),I3(JL)) - IF (KRR == 7) ZRHS(JL) = PRHS(I1(JL),I2(JL),I3(JL)) - ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL)) -! - ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL)) - ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL)) - ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL)) - ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL)) - ENDDO -! - ALLOCATE(ZRHOCOR(IMICRO)) - ZRHOCOR(:) = (ZRHO00 / ZRHODREF(:))**XCEXVT -! - ALLOCATE(ZZW(IMICRO)) - ALLOCATE(ZLSFACT(IMICRO)) - ALLOCATE(ZLVFACT(IMICRO)) -! - ZZW(:) = ZEXNREF(:)*( XCPD+XCPV*ZRVT(:)+XCL*(ZRCT(:)+ZRRT(:)) & - +XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)) ) - ZLSFACT(:) = (XLSTT+(XCPV-XCI)*(ZZT(:)-XTT))/ZZW(:) ! L_s/(Pi_ref*C_ph) - ZLVFACT(:) = (XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZW(:) ! L_v/(Pi_ref*C_ph) -! - ALLOCATE(ZUSW(IMICRO)) - ALLOCATE(ZSSI(IMICRO)) -! - ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) - ZSSI(:) = ZRVT(:)*( ZPRES(:)-ZZW(:) ) / ( (XMV/XMD) * ZZW(:) ) - 1.0 - ! Supersaturation over ice -! - IF (KRR == 7) THEN - ALLOCATE(ZRSMIN_ELEC(7)) - ELSE - ALLOCATE(ZRSMIN_ELEC(6)) - END IF - ZRSMIN_ELEC(:) = XRTMIN_ELEC(:) / PTSTEP -! - ALLOCATE(ZLBDAR(IMICRO)) - ALLOCATE(ZLBDAS(IMICRO)) - ALLOCATE(ZLBDAG(IMICRO)) - IF (KRR == 7) ALLOCATE(ZLBDAH(IMICRO)) - ALLOCATE(ZRDRYG(IMICRO)) - ALLOCATE(ZRWETG(IMICRO)) - ALLOCATE(ZAI(IMICRO)) - ALLOCATE(ZCJ(IMICRO)) - ALLOCATE(ZKA(IMICRO)) - ALLOCATE(ZDV(IMICRO)) -! - IF (KRR == 7) THEN - ALLOCATE(ZZW1(IMICRO,7)) - ELSE IF(KRR == 6) THEN - ALLOCATE(ZZW1(IMICRO,6)) - ENDIF -! - IF (LBU_ENABLE .OR. LLES_CALL) THEN - ALLOCATE(ZRHODJ(IMICRO)) - DO JL=1,IMICRO - ZRHODJ(JL) = PRHODJ(I1(JL),I2(JL),I3(JL)) - END DO - END IF -! - ALLOCATE( ZECT(IMICRO) ) - ALLOCATE( ZERT(IMICRO) ) - ALLOCATE( ZEIT(IMICRO) ) - ALLOCATE( ZEST(IMICRO) ) - ALLOCATE( ZEGT(IMICRO) ) - IF ( KRR == 7 ) ALLOCATE(ZEHT(IMICRO)) - ALLOCATE( ZECS(IMICRO) ) - ALLOCATE( ZERS(IMICRO) ) - ALLOCATE( ZEIS(IMICRO) ) - ALLOCATE( ZESS(IMICRO) ) - ALLOCATE( ZEGS(IMICRO) ) - IF ( KRR == 7 ) ALLOCATE(ZEHS(IMICRO)) - ALLOCATE( ZQPIT(IMICRO) ) - ALLOCATE( ZQNIT(IMICRO) ) - ALLOCATE( ZQCT(IMICRO) ) - ALLOCATE( ZQRT(IMICRO) ) - ALLOCATE( ZQIT(IMICRO) ) - ALLOCATE( ZQST(IMICRO) ) - ALLOCATE( ZQGT(IMICRO) ) - IF ( KRR == 7 ) ALLOCATE(ZQHT(IMICRO)) - ALLOCATE( ZQPIS(IMICRO) ) - ALLOCATE( ZQNIS(IMICRO) ) - ALLOCATE( ZQCS(IMICRO) ) - ALLOCATE( ZQRS(IMICRO) ) - ALLOCATE( ZQIS(IMICRO) ) - ALLOCATE( ZQSS(IMICRO) ) - ALLOCATE( ZQGS(IMICRO) ) - IF ( KRR == 7 ) ALLOCATE(ZQHS(IMICRO)) -! - IF (CNI_CHARGING == 'GARDI') THEN - ALLOCATE( ZDELTALWC(IMICRO) ) - ALLOCATE( ZFT(IMICRO) ) - END IF -! - IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. & - CNI_CHARGING == 'TAKAH' .OR. & - CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2' .OR. & - CNI_CHARGING == 'TEEWC' .OR. CNI_CHARGING == 'TERAR') THEN - ALLOCATE( ZEW(IMICRO) ) - END IF - - IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2') THEN - ALLOCATE( ZLWCC(IMICRO) ) - END IF -! - IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. & - CNI_CHARGING == 'TAKAH' .OR. CNI_CHARGING == 'TEEWC') THEN - ALLOCATE( ZDQLWC(IMICRO) ) - END IF -! - IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. & - CNI_CHARGING == 'TEEWC' ) THEN - ALLOCATE( ZSAUNSK(IMICRO) ) - ALLOCATE( ZSAUNIM(IMICRO) ) - ALLOCATE( ZSAUNIN(IMICRO) ) - ALLOCATE( ZSAUNSM(IMICRO) ) - ALLOCATE( ZSAUNSN(IMICRO) ) - END IF -! - IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. & - CNI_CHARGING == 'SAP98' .OR. & - CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2' .OR. & - CNI_CHARGING == 'TEEWC' .OR. CNI_CHARGING == 'TERAR') THEN - ALLOCATE( ZFQIAGGS(IMICRO) ) - ALLOCATE( ZFQIDRYGBS(IMICRO) ) - ALLOCATE( ZLBQSDRYGB1S(IMICRO) ) - ALLOCATE( ZLBQSDRYGB2S(IMICRO) ) - ALLOCATE( ZLBQSDRYGB3S(IMICRO) ) - END IF -! - IF (CNI_CHARGING == 'SAP98' .OR. & - CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2') THEN - ALLOCATE( ZRAR_CRIT(IMICRO) ) - END IF -! - IF (CNI_CHARGING == 'SAP98' .OR. CNI_CHARGING == 'TERAR' .OR. & - CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2') THEN - ALLOCATE( ZVGMEAN(IMICRO) ) - ALLOCATE( ZVSMEAN(IMICRO) ) - ALLOCATE( ZRAR(IMICRO) ) - ALLOCATE( ZDQRAR_IS(IMICRO) ) - ALLOCATE( ZDQRAR_IG(IMICRO) ) - ALLOCATE( ZDQRAR_SG(IMICRO) ) - ALLOCATE( ZSAUNIM_IS(IMICRO) ) - ALLOCATE( ZSAUNIN_IS(IMICRO) ) - ALLOCATE( ZSAUNIM_IG(IMICRO) ) - ALLOCATE( ZSAUNIN_IG(IMICRO) ) - ALLOCATE( ZSAUNSK_SG(IMICRO) ) - ALLOCATE( ZSAUNSM_SG(IMICRO) ) - ALLOCATE( ZSAUNSN_SG(IMICRO) ) - END IF -! - IF (CNI_CHARGING == 'TAKAH' .OR. CNI_CHARGING == 'SAP98' .OR. & - CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. & - CNI_CHARGING == 'GARDI' .OR. CNI_CHARGING == 'BSMP1' .OR. & - CNI_CHARGING == 'BSMP2' .OR. CNI_CHARGING == 'TEEWC' .OR. & - CNI_CHARGING == 'TERAR') THEN - ALLOCATE( ZAUX1(IMICRO) ) - ALLOCATE( ZLIMIT(IMICRO) ) - END IF -! - IF (LINDUCTIVE) THEN - ALLOCATE( ZEFIELDW(IMICRO) ) - ALLOCATE( ZRATE_IND(IMICRO) ) - ALLOCATE( GIND(IMICRO) ) - END IF -! - IF (LIAGGS_LATHAM) THEN - ALLOCATE( ZEFIELDU(IMICRO) ) - ALLOCATE( ZEFIELDV(IMICRO) ) - IF (.NOT.ALLOCATED(ZEFIELDW)) ALLOCATE( ZEFIELDW(IMICRO) ) - END IF - ALLOCATE( ZLATHAMIAGGS(IMICRO) ) -! - ALLOCATE( ZWQ1(IMICRO,10) ) - ALLOCATE( ZWQ3(IMICRO) ) - ALLOCATE( ZWQ4(IMICRO) ) - ALLOCATE( ZCOLIS(IMICRO) ) - ALLOCATE( ZCOLIG(IMICRO) ) - ALLOCATE( ZCOLSG(IMICRO) ) - ALLOCATE( GELEC(IMICRO,4) ) - GELEC(:,:) = .FALSE. -! - DO JL = 1, IMICRO - IF (LINDUCTIVE) ZEFIELDW(JL) = XEFIELDW(I1(JL), I2(JL), I3(JL)) - IF (LIAGGS_LATHAM) THEN - ZEFIELDU(JL) = XEFIELDU(I1(JL), I2(JL), I3(JL)) - ZEFIELDV(JL) = XEFIELDV(I1(JL), I2(JL), I3(JL)) - IF (.NOT.LINDUCTIVE ) ZEFIELDW(JL) = XEFIELDW(I1(JL), I2(JL), I3(JL)) - END IF -! - ZQPIT(JL) = PQPIT(I1(JL), I2(JL), I3(JL)) - ZQNIT(JL) = PQNIT(I1(JL), I2(JL), I3(JL)) - ZQCT(JL) = PQCT(I1(JL), I2(JL), I3(JL)) - ZQRT(JL) = PQRT(I1(JL), I2(JL), I3(JL)) - ZQIT(JL) = PQIT(I1(JL), I2(JL), I3(JL)) - ZQST(JL) = PQST(I1(JL), I2(JL), I3(JL)) - ZQGT(JL) = PQGT(I1(JL), I2(JL), I3(JL)) - IF (KRR == 7) ZQHT(JL) = PQHT(I1(JL), I2(JL), I3(JL)) -! - ZQPIS(JL) = PQPIS(I1(JL), I2(JL), I3(JL)) - ZQNIS(JL) = PQNIS(I1(JL), I2(JL), I3(JL)) - ZQCS(JL) = PQCS(I1(JL), I2(JL), I3(JL)) - ZQRS(JL) = PQRS(I1(JL), I2(JL), I3(JL)) - ZQIS(JL) = PQIS(I1(JL), I2(JL), I3(JL)) - ZQSS(JL) = PQSS(I1(JL), I2(JL), I3(JL)) - ZQGS(JL) = PQGS(I1(JL), I2(JL), I3(JL)) - IF (KRR == 7) ZQHS(JL) = PQHS(I1(JL), I2(JL), I3(JL)) - ENDDO -! -! -!* 2.3 Update the parameter e in the charge-diameter relation -! - IF (KRR == 7) THEN - CALL COMPUTE_LBDA(ZRRT, ZRST, ZRGT, ZRH=ZRHT) - ZTSPLITR = 1. - CALL ELEC_UPDATE_QD(ZTSPLITR, ZERT, ZEIT, ZEST, ZEGT, ZQRT, ZQIT, ZQST, ZQGT, & - ZRRT, ZRIT, ZRST, ZRGT, & - ZEH=ZEHT, ZQH=ZQHT, ZRH=ZRHT, ZEC=ZECT, ZQC=ZQCT, ZRC=ZRCT) - ZTSPLITR = PTSTEP - CALL ELEC_UPDATE_QD(ZTSPLITR, ZERS, ZEIS, ZESS, ZEGS, ZQRS, ZQIS, ZQSS, ZQGS, & - ZRRS, ZRIS, ZRSS, ZRGS, & - ZEH=ZEHS, ZQH=ZQHS, ZRH=ZRHS, ZEC=ZECS, ZQC=ZQCS, ZRC=ZRCS) - ELSE - CALL COMPUTE_LBDA(ZRRT, ZRST, ZRGT) - ZTSPLITR = 1. - CALL ELEC_UPDATE_QD(ZTSPLITR, ZERT, ZEIT, ZEST, ZEGT, ZQRT, ZQIT, ZQST, ZQGT, & - ZRRT, ZRIT, ZRST, ZRGT, ZEC=ZECT, ZQC=ZQCT, ZRC=ZRCT) - ZTSPLITR = PTSTEP - CALL ELEC_UPDATE_QD(ZTSPLITR, ZERS, ZEIS, ZESS, ZEGS, ZQRS, ZQIS, ZQSS, ZQGS, & - ZRRS, ZRIS, ZRSS, ZRGS, ZEC=ZECS, ZQC=ZQCS, ZRC=ZRCS) - END IF -! -! -!* 2.4 Initialization for the non-inductive charging process -! - CALL ELEC_INI_NI_PROCESS -! -! -!* 2.5 Compute the slow cold process sources -! - CALL RAIN_ICE_ELEC_SLOW -! -!------------------------------------------------------------------------------- -! -!* 3. COMPUTES THE SLOW WARM PROCESS SOURCES -! -------------------------------------- -! - IF( OWARM ) THEN ! Check if the formation of the raindrops by the slow - ! warm processes is allowed - PEVAP3D(:,:,:)= 0. - CALL RAIN_ICE_ELEC_WARM - END IF -! -!------------------------------------------------------------------------------- -! -!* 4. COMPUTES THE FAST COLD PROCESS SOURCES FOR r_s -! ---------------------------------------------- -! - CALL RAIN_ICE_ELEC_FAST_RS -! -!------------------------------------------------------------------------------- -! -!* 5. COMPUTES THE FAST COLD PROCESS SOURCES FOR r_g -! ---------------------------------------------- -! - CALL RAIN_ICE_ELEC_FAST_RG -! -!------------------------------------------------------------------------------- -! -!* 6. COMPUTES THE FAST COLD PROCESS SOURCES FOR r_h -! ---------------------------------------------- -! - IF ( KRR == 7 ) THEN - CALL RAIN_ICE_ELEC_FAST_RH - END IF -! -!------------------------------------------------------------------------------- -! -!* 7. COMPUTES SPECIFIC SOURCES OF THE WARM AND COLD CLOUDY SPECIES -! ------------------------------------------------------------- -! - CALL RAIN_ICE_ELEC_FAST_RI -! -! -!------------------------------------------------------------------------------- -! -!* 8. UPDATE MIXING 3D RATIOS AND VOLUMETRIC CHARGE CONCENTRATIONS -! ------------------------------------------------------------ -! -!* 8.1 Update the mixing ratio -! - DO JL=1,IMICRO - PRVS(I1(JL),I2(JL),I3(JL)) = ZRVS(JL) - PRCS(I1(JL),I2(JL),I3(JL)) = ZRCS(JL) - PRRS(I1(JL),I2(JL),I3(JL)) = ZRRS(JL) - PRIS(I1(JL),I2(JL),I3(JL)) = ZRIS(JL) - PRSS(I1(JL),I2(JL),I3(JL)) = ZRSS(JL) - PRGS(I1(JL),I2(JL),I3(JL)) = ZRGS(JL) - PTHS(I1(JL),I2(JL),I3(JL)) = ZTHS(JL) - PCIT(I1(JL),I2(JL),I3(JL)) = ZCIT(JL) - END DO - IF ( KRR == 7 ) THEN - DO JL=1,IMICRO - PRHS(I1(JL),I2(JL),I3(JL)) = ZRHS(JL) - END DO - END IF -! -! -!* 8.2 Compute the volumetric charge concentration -! - DO JL=1,IMICRO - PQPIS(I1(JL),I2(JL),I3(JL)) = ZQPIS(JL) - PQNIS(I1(JL),I2(JL),I3(JL)) = ZQNIS(JL) - PQCS (I1(JL),I2(JL),I3(JL)) = ZQCS(JL) - PQRS (I1(JL),I2(JL),I3(JL)) = ZQRS(JL) - PQIS (I1(JL),I2(JL),I3(JL)) = ZQIS(JL) - PQSS (I1(JL),I2(JL),I3(JL)) = ZQSS(JL) - PQGS (I1(JL),I2(JL),I3(JL)) = ZQGS(JL) - END DO - IF ( KRR == 7 ) THEN - DO JL=1,IMICRO - PQHS(I1(JL),I2(JL),I3(JL)) = ZQHS(JL) - END DO - END IF -! -! -!* 8.3 Deallocate -! - DEALLOCATE(ZZW1) - DEALLOCATE(ZDV) - DEALLOCATE(ZCJ) - DEALLOCATE(ZRDRYG) - DEALLOCATE(ZRWETG) - DEALLOCATE(ZLBDAG) - IF ( KRR == 7 ) DEALLOCATE(ZLBDAH) - DEALLOCATE(ZLBDAS) - DEALLOCATE(ZLBDAR) - DEALLOCATE(ZSSI) - DEALLOCATE(ZUSW) - DEALLOCATE(ZLVFACT) - DEALLOCATE(ZLSFACT) - DEALLOCATE(ZZW) - DEALLOCATE(ZEXNREF) - DEALLOCATE(ZPRES) - DEALLOCATE(ZRHODREF) - DEALLOCATE(ZRHOCOR) - DEALLOCATE(ZZT) - IF(LBU_ENABLE .OR. LLES_CALL) DEALLOCATE(ZRHODJ) - DEALLOCATE(ZTHS) - IF ( KRR == 7 ) DEALLOCATE(ZRHS) - DEALLOCATE(ZRGS) - DEALLOCATE(ZRSS) - DEALLOCATE(ZRIS) - DEALLOCATE(ZRRS) - DEALLOCATE(ZRCS) - DEALLOCATE(ZRVS) - DEALLOCATE(ZCIT) - DEALLOCATE(ZRGT) - IF ( KRR == 7 ) DEALLOCATE(ZRHT) - DEALLOCATE(ZRST) - DEALLOCATE(ZRIT) - DEALLOCATE(ZRRT) - DEALLOCATE(ZAI) - DEALLOCATE(ZRCT) - DEALLOCATE(ZKA) - DEALLOCATE(ZRVT) - DEALLOCATE(ZSIGMA_RC) - DEALLOCATE(ZCF) -! - DEALLOCATE( ZECT ) - DEALLOCATE( ZERT ) - DEALLOCATE( ZEIT ) - DEALLOCATE( ZEST ) - DEALLOCATE( ZEGT ) - IF ( KRR == 7 ) DEALLOCATE(ZEHT) - DEALLOCATE( ZECS ) - DEALLOCATE( ZERS ) - DEALLOCATE( ZEIS ) - DEALLOCATE( ZESS ) - DEALLOCATE( ZEGS ) - IF ( KRR == 7 ) DEALLOCATE(ZEHS) - DEALLOCATE( ZQPIT ) - DEALLOCATE( ZQNIT ) - DEALLOCATE( ZQCT ) - DEALLOCATE( ZQRT ) - DEALLOCATE( ZQIT ) - DEALLOCATE( ZQST ) - DEALLOCATE( ZQGT ) - IF ( KRR == 7 ) DEALLOCATE(ZQHT) - DEALLOCATE( ZQPIS ) - DEALLOCATE( ZQNIS ) - DEALLOCATE( ZQCS ) - DEALLOCATE( ZQRS ) - DEALLOCATE( ZQIS ) - DEALLOCATE( ZQSS ) - DEALLOCATE( ZQGS ) - IF ( KRR == 7 ) DEALLOCATE(ZQHS) - DEALLOCATE( ZWQ1 ) - DEALLOCATE( ZWQ3 ) - DEALLOCATE( ZWQ4 ) - DEALLOCATE( ZCOLIS ) - DEALLOCATE( ZCOLIG ) - DEALLOCATE( ZCOLSG ) - DEALLOCATE( ZRSMIN_ELEC) - DEALLOCATE( GELEC ) - IF (ALLOCATED( ZDELTALWC )) DEALLOCATE( ZDELTALWC ) - IF (ALLOCATED( ZLWCC )) DEALLOCATE( ZLWCC ) - IF (ALLOCATED( ZFT )) DEALLOCATE( ZFT ) - IF (ALLOCATED( ZEW )) DEALLOCATE( ZEW ) - IF (ALLOCATED( ZSAUNSK )) DEALLOCATE( ZSAUNSK ) - IF (ALLOCATED( ZSAUNIM )) DEALLOCATE( ZSAUNIM ) - IF (ALLOCATED( ZSAUNIN )) DEALLOCATE( ZSAUNIN ) - IF (ALLOCATED( ZSAUNSM )) DEALLOCATE( ZSAUNSM ) - IF (ALLOCATED( ZSAUNSN )) DEALLOCATE( ZSAUNSN ) - IF (ALLOCATED( ZVGMEAN )) DEALLOCATE( ZVGMEAN ) - IF (ALLOCATED( ZRAR )) DEALLOCATE( ZRAR ) - IF (ALLOCATED( ZRAR_CRIT )) DEALLOCATE( ZRAR_CRIT ) - IF (ALLOCATED( ZSAUNIM_IS )) DEALLOCATE( ZSAUNIM_IS ) - IF (ALLOCATED( ZSAUNIN_IS )) DEALLOCATE( ZSAUNIN_IS ) - IF (ALLOCATED( ZFQIAGGS )) DEALLOCATE( ZFQIAGGS ) - IF (ALLOCATED( ZFQIDRYGBS )) DEALLOCATE( ZFQIDRYGBS ) - IF (ALLOCATED( ZLBQSDRYGB1S )) DEALLOCATE( ZLBQSDRYGB1S ) - IF (ALLOCATED( ZLBQSDRYGB2S )) DEALLOCATE( ZLBQSDRYGB2S ) - IF (ALLOCATED( ZLBQSDRYGB3S )) DEALLOCATE( ZLBQSDRYGB3S ) - IF (ALLOCATED( ZSAUNIM_IG )) DEALLOCATE( ZSAUNIM_IG ) - IF (ALLOCATED( ZSAUNIN_IG )) DEALLOCATE( ZSAUNIN_IG ) - IF (ALLOCATED( ZSAUNSK_SG )) DEALLOCATE( ZSAUNSK_SG ) - IF (ALLOCATED( ZSAUNSM_SG )) DEALLOCATE( ZSAUNSM_SG ) - IF (ALLOCATED( ZSAUNSN_SG )) DEALLOCATE( ZSAUNSN_SG ) - IF (ALLOCATED( ZDQLWC )) DEALLOCATE( ZDQLWC ) - IF (ALLOCATED( ZDQRAR_IS )) DEALLOCATE( ZDQRAR_IS ) - IF (ALLOCATED( ZDQRAR_IG )) DEALLOCATE( ZDQRAR_IG ) - IF (ALLOCATED( ZDQRAR_SG )) DEALLOCATE( ZDQRAR_SG ) - IF (ALLOCATED( ZAUX1 )) DEALLOCATE( ZAUX1 ) - IF (ALLOCATED( ZLIMIT )) DEALLOCATE( ZLIMIT ) - IF (ALLOCATED( ZEFIELDW )) DEALLOCATE( ZEFIELDW ) - IF (ALLOCATED( ZRATE_IND )) DEALLOCATE( ZRATE_IND ) - IF (ALLOCATED( GIND )) DEALLOCATE( GIND ) - IF (ALLOCATED( ZEFIELDU )) DEALLOCATE( ZEFIELDU ) - IF (ALLOCATED( ZEFIELDV )) DEALLOCATE( ZEFIELDV ) - DEALLOCATE( ZLATHAMIAGGS ) -! -END IF -! -!------------------------------------------------------------------------------- -! -!* 8. COMPUTE THE SEDIMENTATION (RS) SOURCE -! ------------------------------------- -! -!* 8.1 time splitting loop initialization -! -ZTSPLITR = PTSTEP / REAL(KSPLITR) -! -! -IF (CSEDIM == 'STAT') THEN -! not yet developped for electricity !!! - CALL RAIN_ICE_SEDIMENTATION_STAT -ELSE - CALL RAIN_ICE_ELEC_SEDIMENTATION_SPLIT -END IF -! -! -!------------------------------------------------------------------------------- -! -CONTAINS -! -!------------------------------------------------------------------------------- -! - SUBROUTINE RAIN_ICE_ELEC_SEDIMENTATION_SPLIT -! -!* 0. DECLARATIONS -! ------------ -! -IMPLICIT NONE -! -!* 0.2 declaration of local variables -! -INTEGER , DIMENSION(SIZE(GSEDIMC)) :: IC1,IC2,IC3 ! Used to replace the COUNT -INTEGER , DIMENSION(SIZE(GSEDIMR)) :: IR1,IR2,IR3 ! Used to replace the COUNT -INTEGER , DIMENSION(SIZE(GSEDIMI)) :: II1,II2,II3 ! Used to replace the COUNT -INTEGER , DIMENSION(SIZE(GSEDIMS)) :: IS1,IS2,IS3 ! Used to replace the COUNT -INTEGER , DIMENSION(SIZE(GSEDIMG)) :: IG1,IG2,IG3 ! Used to replace the COUNT -INTEGER , DIMENSION(SIZE(GSEDIMH)) :: IH1,IH2,IH3 ! Used to replace the COUNT -INTEGER :: ILENALLOCC,ILENALLOCR,ILENALLOCI,ILENALLOCS,ILENALLOCG,ILENALLOCH -INTEGER :: ILISTLENC,ILISTLENR,ILISTLENI,ILISTLENS,ILISTLENG,ILISTLENH -INTEGER, ALLOCATABLE :: ILISTR(:),ILISTC(:),ILISTI(:),ILISTS(:),ILISTG(:),ILISTH(:) -! Optimization for NEC -!INTEGER, SAVE :: IOLDALLOCC = SIZE(PEXNREF,1)*SIZE(PEXNREF,2)*SIZE(PEXNREF,3)/10 -!INTEGER, SAVE :: IOLDALLOCR = SIZE(PEXNREF,1)*SIZE(PEXNREF,2)*SIZE(PEXNREF,3)/10 -!INTEGER, SAVE :: IOLDALLOCI = SIZE(PEXNREF,1)*SIZE(PEXNREF,2)*SIZE(PEXNREF,3)/10 -!INTEGER, SAVE :: IOLDALLOCS = SIZE(PEXNREF,1)*SIZE(PEXNREF,2)*SIZE(PEXNREF,3)/10 -!INTEGER, SAVE :: IOLDALLOCG = SIZE(PEXNREF,1)*SIZE(PEXNREF,2)*SIZE(PEXNREF,3)/10 -!INTEGER, SAVE :: IOLDALLOCH = SIZE(PEXNREF,1)*SIZE(PEXNREF,2)*SIZE(PEXNREF,3)/10 -INTEGER, SAVE :: IOLDALLOCC = 6000 -INTEGER, SAVE :: IOLDALLOCR = 6000 -INTEGER, SAVE :: IOLDALLOCI = 6000 -INTEGER, SAVE :: IOLDALLOCS = 6000 -INTEGER, SAVE :: IOLDALLOCG = 6000 -INTEGER, SAVE :: IOLDALLOCH = 6000 -! -REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZCONC3D ! droplet condensation -INTEGER, DIMENSION(:), ALLOCATABLE :: ZCIS -REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZF0, ZF1, ZCOR -REAL :: ZBEARDCOEFR, ZBEARDCOEFI, ZBEARDCOEFS, ZBEARDCOEFG -REAL :: ZVR, ZVI, ZVS, ZVG, ZETA0, ZK, ZRE0 -! For rain, ice, snow and graupel particles, Take into account the -! effects of altitude and electrical force on terminal fallspeed -! (from Beard, JAS 1980, 37,1363-1374) -! -!------------------------------------------------------------------------------- -! -! O. Initialization for sedimentation -! - if ( lbudget_rc .and. osedic ) & - call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_sv ) then - if ( osedic ) & - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'SEDI', pqcs(:, :, :) * prhodj(:, :, :) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'SEDI', pqrs(:, :, :) * prhodj(:, :, :) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'SEDI', pqis(:, :, :) * prhodj(:, :, :) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'SEDI', pqss(:, :, :) * prhodj(:, :, :) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'SEDI', pqgs(:, :, :) * prhodj(:, :, :) ) - if ( krr == 7 ) & - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'SEDI', pqhs(:, :, :) * prhodj(:, :, :) ) - end if - - IF (OSEDIC) PINPRC (:,:) = 0. - PINPRR (:,:) = 0. - PINPRR3D (:,:,:) = 0. - PINPRS (:,:) = 0. - PINPRG (:,:) = 0. - IF ( KRR == 7 ) PINPRH (:,:) = 0. -! - ZT (:,:,:) = ZT (:,:,:) - XTT !ZT from RAIN_ICE_ELEC_NUCLEATION - ZETA0 = (1.718 + 0.0049*(XTHVREFZ(IKB) -XTT)) - WHERE (ZT (:,:,:) >= 0.0) - ZF0(:,:,:) = ZETA0 / (1.718 + 0.0049*ZT(:,:,:)) - ELSEWHERE - ZF0(:,:,:) = ZETA0 / (1.718 + 0.0049*ZT(:,:,:) - 1.2E-5*ZT(:,:,:)*ZT(:,:,:)) - END WHERE -! - ZF1(:,:,:) = SQRT(ZRHO00/PRHODREF(:,:,:)) - ZCOR(:,:,:) = (PRHODREF(:,:,:)/ZRHO00)**XCEXVT ! to eliminate Foote-duToit correction -! - ZVR = (ZRHO00/ZETA0) * XCR * MOMG(XALPHAR,XNUR,XBR+XDR) / MOMG(XALPHAR,XNUR,XBR) - ZVI = (ZRHO00/ZETA0) * 2.1E5 * MOMG(XALPHAI,XNUI,3.285) / MOMG(XALPHAI,XNUI,1.7) ! Columns - ZVS = (ZRHO00/ZETA0) * XCS * MOMG(XALPHAS,XNUS,XBS+XDS) / MOMG(XALPHAS,XNUS,XBS) - ZVG = (ZRHO00/ZETA0) * XCG * MOMG(XALPHAG,XNUG,XBG+XDG) / MOMG(XALPHAG,XNUG,XBG) -! -!* 1. Parameters for cloud sedimentation -! - IF (OSEDIC) THEN - ZRAY(:,:,:) = 0. - ZLBC(:,:,:) = XLBC(1) - ZFSEDC(:,:,:) = XFSEDC(1) - ZCONC3D(:,:,:) = XCONC_LAND - ZCONC_TMP(:,:) = XCONC_LAND - IF (PRESENT(PSEA)) THEN - ZCONC_TMP(:,:) = PSEA(:,:) * XCONC_SEA + (1. - PSEA(:,:)) * XCONC_LAND - DO JK = IKB, IKE - ZLBC(:,:,JK) = PSEA(:,:) * XLBC(2) + (1. - PSEA(:,:)) * XLBC(1) - ZFSEDC(:,:,JK) = PSEA(:,:) * XFSEDC(2) + (1. - PSEA(:,:)) * XFSEDC(1) - ZFSEDC(:,:,JK) = MAX(MIN(XFSEDC(1),XFSEDC(2)),ZFSEDC(:,:,JK)) - ZCONC3D(:,:,JK) = (1. - PTOWN(:,:)) * ZCONC_TMP(:,:) + PTOWN(:,:) * XCONC_URBAN - ZRAY(:,:,JK) = 0.5 * ((1. - PSEA(:,:)) * MOMG(XALPHAC, XNUC, 1.0) + & - PSEA(:,:) * MOMG(XALPHAC2, XNUC2, 1.0) ) - END DO - ELSE - ZCONC3D(:,:,:) = XCONC_LAND - ZRAY(:,:,:) = 0.5 * MOMG(XALPHAC, XNUC, 1.0) - END IF - ZRAY(:,:,:) = MAX(1.,ZRAY(:,:,:)) - ZLBC(:,:,:) = MAX(MIN(XLBC(1),XLBC(2)),ZLBC(:,:,:)) - ENDIF -! -!* 2. compute the fluxes -! -! optimization by looking for locations where -! the precipitating fields are larger than a minimal value only !!! -! For optimization we consider each variable separately - - ZRTMIN(:) = XRTMIN(:) / PTSTEP - IF (OSEDIC) GSEDIMC(:,:,:) = .FALSE. - GSEDIMR(:,:,:) = .FALSE. - GSEDIMI(:,:,:) = .FALSE. - GSEDIMS(:,:,:) = .FALSE. - GSEDIMG(:,:,:) = .FALSE. - IF (KRR == 7) GSEDIMH(:,:,:) = .FALSE. -! - IF (OSEDIC) ILENALLOCC = 0 - ILENALLOCR = 0 - ILENALLOCI = 0 - ILENALLOCS = 0 - ILENALLOCG = 0 - IF ( KRR == 7 ) ILENALLOCH = 0 -! -! ZPiS = Specie i source creating during the current time step -! PRiS = Source of the previous time step -! - IF (OSEDIC) THEN - ZPRCS(:,:,:) = 0.0 - ZPRCS(:,:,:) = PRCS(:,:,:) - PRCT(:,:,:) / PTSTEP - PRCS(:,:,:) = PRCT(:,:,:) / PTSTEP - END IF - ZPRRS(:,:,:) = 0.0 - ZPRSS(:,:,:) = 0.0 - ZPRGS(:,:,:) = 0.0 - IF (KRR == 7) ZPRHS(:,:,:) = 0.0 -! - ZPRRS(:,:,:) = PRRS(:,:,:) - PRRT(:,:,:) / PTSTEP - ZPRSS(:,:,:) = PRSS(:,:,:) - PRST(:,:,:) / PTSTEP - ZPRGS(:,:,:) = PRGS(:,:,:) - PRGT(:,:,:) / PTSTEP - IF (KRR == 7) ZPRHS(:,:,:) = PRHS(:,:,:) - PRHT(:,:,:) / PTSTEP - PRRS(:,:,:) = PRRT(:,:,:) / PTSTEP - PRSS(:,:,:) = PRST(:,:,:) / PTSTEP - PRGS(:,:,:) = PRGT(:,:,:) / PTSTEP - IF (KRR == 7) PRHS(:,:,:) = PRHT(:,:,:) / PTSTEP - ZPQRS(:,:,:) = 0.0 - ZPQSS(:,:,:) = 0.0 - ZPQGS(:,:,:) = 0.0 - IF (KRR == 7) ZPQHS(:,:,:) = 0.0 -! - ZPQRS(:,:,:) = PQRS(:,:,:) - PQRT(:,:,:) / PTSTEP - ZPQSS(:,:,:) = PQSS(:,:,:) - PQST(:,:,:) / PTSTEP - ZPQGS(:,:,:) = PQGS(:,:,:) - PQGT(:,:,:) / PTSTEP - IF (KRR == 7) ZPQHS(:,:,:) = PQHS(:,:,:) - PQHT(:,:,:) / PTSTEP - PQRS(:,:,:) = PQRT(:,:,:) / PTSTEP - PQSS(:,:,:) = PQST(:,:,:) / PTSTEP - PQGS(:,:,:) = PQGT(:,:,:) / PTSTEP - IF (KRR == 7) PQHS(:,:,:) = PQHT(:,:,:) / PTSTEP -! -! PRiS = Source of the previous time step + source created during the subtime -! step -! - DO JN = 1, KSPLITR - IF(JN == 1) THEN - IF (OSEDIC) PRCS(:,:,:) = PRCS(:,:,:) + ZPRCS(:,:,:) / KSPLITR - PRRS(:,:,:) = PRRS(:,:,:) + ZPRRS(:,:,:) / KSPLITR - PRSS(:,:,:) = PRSS(:,:,:) + ZPRSS(:,:,:) / KSPLITR - PRGS(:,:,:) = PRGS(:,:,:) + ZPRGS(:,:,:) / KSPLITR - IF (KRR == 7) PRHS(:,:,:) = PRHS(:,:,:) + ZPRHS(:,:,:) / KSPLITR - PQRS(:,:,:) = PQRS(:,:,:) + ZPQRS(:,:,:) / KSPLITR - PQSS(:,:,:) = PQSS(:,:,:) + ZPQSS(:,:,:) / KSPLITR - PQGS(:,:,:) = PQGS(:,:,:) + ZPQGS(:,:,:) / KSPLITR - IF (KRR == 7) PQHS(:,:,:) = PQHS(:,:,:) + ZPQHS(:,:,:) / KSPLITR - DO JK = IKB, IKE - ZW(:,:,JK) = ZTSPLITR / (PRHODREF(:,:,JK) * (PZZ(:,:,JK+1) - PZZ(:,:,JK))) - END DO - ELSE - IF (OSEDIC) PRCS(:,:,:) = PRCS(:,:,:) + ZPRCS(:,:,:) * ZTSPLITR - PRRS(:,:,:) = PRRS(:,:,:) + ZPRRS(:,:,:) * ZTSPLITR - PRSS(:,:,:) = PRSS(:,:,:) + ZPRSS(:,:,:) * ZTSPLITR - PRGS(:,:,:) = PRGS(:,:,:) + ZPRGS(:,:,:) * ZTSPLITR - IF (KRR == 7) PRHS(:,:,:) = PRHS(:,:,:) + ZPRHS(:,:,:) * ZTSPLITR - PQRS(:,:,:) = PQRS(:,:,:) + ZPQRS(:,:,:) * ZTSPLITR - PQSS(:,:,:) = PQSS(:,:,:) + ZPQSS(:,:,:) * ZTSPLITR - PQGS(:,:,:) = PQGS(:,:,:) + ZPQGS(:,:,:) * ZTSPLITR - IF (KRR == 7) PQHS(:,:,:) = PQHS(:,:,:) + ZPQHS(:,:,:) * ZTSPLITR - END IF - ! - IF (OSEDIC) GSEDIMC(IIB:IIE,IJB:IJE,IKB:IKE) = & - PRCS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN(2) - GSEDIMR(IIB:IIE,IJB:IJE,IKB:IKE) = & - PRRS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN(3) - GSEDIMI(IIB:IIE,IJB:IJE,IKB:IKE) = & - PRIS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN(4) - GSEDIMS(IIB:IIE,IJB:IJE,IKB:IKE) = & - PRSS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN(5) - GSEDIMG(IIB:IIE,IJB:IJE,IKB:IKE) = & - PRGS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN(6) - IF (KRR == 7) GSEDIMH(IIB:IIE,IJB:IJE,IKB:IKE) = & - PRHS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN(7) -! - IF (OSEDIC) ISEDIMC = COUNTJV( GSEDIMC(:,:,:),IC1(:),IC2(:),IC3(:)) - ISEDIMR = COUNTJV( GSEDIMR(:,:,:),IR1(:),IR2(:),IR3(:)) - ISEDIMI = COUNTJV( GSEDIMI(:,:,:),II1(:),II2(:),II3(:)) - ISEDIMS = COUNTJV( GSEDIMS(:,:,:),IS1(:),IS2(:),IS3(:)) - ISEDIMG = COUNTJV( GSEDIMG(:,:,:),IG1(:),IG2(:),IG3(:)) - IF (KRR == 7) ISEDIMH = COUNTJV( GSEDIMH(:,:,:),IH1(:),IH2(:),IH3(:)) -! -!* 2.1 for cloud -! - IF (OSEDIC) THEN - ZWSED(:,:,:) = 0. - IF( JN==1 ) PRCS(:,:,:) = PRCS(:,:,:) * PTSTEP - IF(ISEDIMC >= 1) THEN - IF (ISEDIMC .GT. ILENALLOCC) THEN - IF (ILENALLOCC .GT. 0) THEN - DEALLOCATE (ZRCS, ZRHODREFC, ILISTC, ZWLBDC, ZCONC, ZRCT, & - ZZT, ZPRES, ZRAY1D, ZFSEDC1D, ZWLBDA, ZCC ) - END IF - ILENALLOCC = MAX (IOLDALLOCC, 2*ISEDIMC ) - IOLDALLOCC = ILENALLOCC - ALLOCATE(ZRCS(ILENALLOCC), ZRHODREFC(ILENALLOCC), ILISTC(ILENALLOCC), & - ZWLBDC(ILENALLOCC), ZCONC(ILENALLOCC), ZRCT(ILENALLOCC), ZZT(ILENALLOCC), & - ZPRES(ILENALLOCC), ZRAY1D(ILENALLOCC), ZFSEDC1D(ILENALLOCC), & - ZWLBDA(ILENALLOCC), ZCC(ILENALLOCC)) - END IF -! - DO JL = 1, ISEDIMC - ZRCS(JL) = PRCS(IC1(JL),IC2(JL),IC3(JL)) - ZRHODREFC(JL) = PRHODREF(IC1(JL),IC2(JL),IC3(JL)) - ZWLBDC(JL) = ZLBC(IC1(JL),IC2(JL),IC3(JL)) - ZCONC(JL) = ZCONC3D(IC1(JL),IC2(JL),IC3(JL)) - ZRCT(JL) = PRCT(IC1(JL),IC2(JL),IC3(JL)) - ZZT(JL) = PTHT(IC1(JL),IC2(JL),IC3(JL)) - ZPRES(JL) = PPABST(IC1(JL),IC2(JL),IC3(JL)) - ZRAY1D(JL) = ZRAY(IC1(JL),IC2(JL),IC3(JL)) - ZFSEDC1D(JL) = ZFSEDC(IC1(JL),IC2(JL),IC3(JL)) - END DO -! - ILISTLENC = 0 - DO JL = 1, ISEDIMC - IF(ZRCS(JL) .GT. ZRTMIN(2)) THEN - ILISTLENC = ILISTLENC + 1 - ILISTC(ILISTLENC) = JL - END IF - END DO - DO JJ = 1, ILISTLENC - JL = ILISTC(JJ) - IF (ZRCS(JL) .GT. ZRTMIN(2) .AND. ZRCT(JL) .GT. XRTMIN(2)) THEN - ZWLBDC(JL) = ZWLBDC(JL) * ZCONC(JL) / (ZRHODREFC(JL) * ZRCT(JL)) - ZWLBDC(JL) = ZWLBDC(JL)**XLBEXC - ZRAY1D(JL) = ZRAY1D(JL) / ZWLBDC(JL) !! ZRAY : mean diameter=M(1)/2 - ZZT(JL) = ZZT(JL) * (ZPRES(JL) / XP00)**(XRD/XCPD) - ZWLBDA(JL) = 6.6E-8 * (101325. / ZPRES(JL)) * (ZZT(JL) / 293.15) - ZCC(JL) = XCC * (1. + 1.26 * ZWLBDA(JL) / ZRAY1D(JL)) !! XCC modified for cloud - ZWSED (IC1(JL),IC2(JL),IC3(JL)) = ZRHODREFC(JL)**(-XCEXVT +1 ) * & - ZWLBDC(JL)**(-XDC) * ZCC(JL) * ZFSEDC1D(JL) * ZRCS(JL) - END IF - END DO - END IF - DO JK = IKB, IKE - PRCS(:,:,JK) = PRCS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK)) - END DO - PINPRC(:,:) = PINPRC(:,:) + ZWSED(:,:,IKB) / XRHOLW / KSPLITR - IF(JN == KSPLITR) THEN - PRCS(:,:,:) = PRCS(:,:,:) / PTSTEP - END IF - END IF -! -!* 2.2 for rain -! - IF( JN==1 ) PRRS(:,:,:) = PRRS(:,:,:) * PTSTEP - IF (JN == 1) PQRS(:,:,:) = PQRS(:,:,:) * PTSTEP - ZWSED(:,:,:) = 0. - ZWSEDQ(:,:,:) = 0. - IF( ISEDIMR >= 1 ) THEN - IF ( ISEDIMR .GT. ILENALLOCR ) THEN - IF ( ILENALLOCR .GT. 0 ) THEN - DEALLOCATE (ZRRS, ZRHODREFR, ILISTR) - DEALLOCATE (ZQRS, ZLBDAR, ZERS) - END IF - ILENALLOCR = MAX (IOLDALLOCR, 2*ISEDIMR ) - IOLDALLOCR = ILENALLOCR - ALLOCATE(ZRRS(ILENALLOCR), ZRHODREFR(ILENALLOCR), ILISTR(ILENALLOCR)) - ALLOCATE(ZQRS(ILENALLOCR), ZLBDAR(ILENALLOCR), ZERS(ILENALLOCR)) - END IF - ZERS(:) = 0. -! - DO JL = 1, ISEDIMR - ZRRS(JL) = PRRS(IR1(JL),IR2(JL),IR3(JL)) - ZRHODREFR(JL) = PRHODREF(IR1(JL),IR2(JL),IR3(JL)) - ZQRS(JL) = PQRS(IR1(JL),IR2(JL),IR3(JL)) -! compute lambda_r and e_r - IF (ZRRS(JL) > 0.) THEN - ZLBDAR(JL) = XLBR * (ZRHODREFR(JL) * MAX(ZRRS(JL), ZRTMIN(3)))**XLBEXR - END IF - IF (ZRRS(JL) > ZRTMIN(3) .AND. ZLBDAR(JL) > 0.) THEN - ZERS(JL) = ZRHODREFR(JL) * ZQRS(JL) / (XFQUPDR * ZLBDAR(JL)**(XCXR - XFR)) - ZERS(JL) = SIGN( MIN(ABS(ZERS(JL)), XERMAX), ZERS(JL)) - END IF - END DO -! - ILISTLENR = 0 - DO JL = 1, ISEDIMR - IF(ZRRS(JL) .GT. ZRTMIN(3)) THEN - ILISTLENR = ILISTLENR + 1 - ILISTR(ILISTLENR) = JL - END IF - END DO - DO JJ = 1, ILISTLENR - JL = ILISTR(JJ) - IF (ZRRS(JL) > 0. .AND. LSEDIM_BEARD) THEN - ZK = 1. - ZQRS(JL) * XEFIELDW(IR1(JL),IR2(JL),IR3(JL)) / (ZRRS(JL)*XG) - IF (ZK <= 0.0) THEN - ZBEARDCOEFR = 0. - ELSE - ZRE0 = ZVR / ZLBDAR(JL)**(1.+XDR) - IF (ZRE0 <= 0.2) THEN - ZBEARDCOEFR = ZF0(IR1(JL),IR2(JL),IR3(JL)) * ZK - ELSE IF (ZRE0 >= 1000.) THEN - ZBEARDCOEFR = ZF1(IR1(JL),IR2(JL),IR3(JL)) * SQRT(ZK) - ELSE - ZBEARDCOEFR = ZF0(IR1(JL),IR2(JL),IR3(JL)) * ZK + & - (ZF1(IR1(JL),IR2(JL),IR3(JL)) * & - SQRT(ZK)-ZF0(IR1(JL),IR2(JL),IR3(JL))*ZK) * & - (1.61+LOG(ZRE0)) / 8.52 - END IF - ZBEARDCOEFR = ZBEARDCOEFR * ZCOR(IR1(JL),IR2(JL),IR3(JL)) - END IF - ELSE - ZBEARDCOEFR = 1.0 ! No "Beard" effect - END IF -! - ZWSED(IR1(JL),IR2(JL),IR3(JL)) = ZBEARDCOEFR * & - XFSEDR * ZRRS(JL)**XEXSEDR * & - ZRHODREFR(JL)**(XEXSEDR-XCEXVT) -! - IF (ZRRS(JL) > ZRTMIN(3) .AND. ABS(ZERS(JL)) > XERMIN) THEN - ZWSEDQ(IR1(JL),IR2(JL),IR3(JL)) = ZBEARDCOEFR * & - XFQSEDR * ZERS(JL) * & - ZRRS(JL)**XEXQSEDR * & - ZRHODREFR(JL)**(XEXQSEDR-XCEXVT) - END IF - END DO - END IF - DO JK = IKB , IKE - PRRS(:,:,JK) = PRRS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK)) - PQRS(:,:,JK) = PQRS(:,:,JK) + ZW(:,:,JK) * (ZWSEDQ(:,:,JK+1) - ZWSEDQ(:,:,JK)) - END DO - PINPRR(:,:) = PINPRR(:,:) + ZWSED(:,:,IKB) / XRHOLW / KSPLITR - PINPRR3D(:,:,:) = PINPRR3D(:,:,:) + ZWSED(:,:,:) / XRHOLW / KSPLITR - IF (JN == KSPLITR) THEN - PRRS(:,:,:) = PRRS(:,:,:) / PTSTEP - PQRS(:,:,:) = PQRS(:,:,:) / PTSTEP - END IF -! -! -!* 2.3 for pristine ice -! - IF (JN == 1) PRIS(:,:,:) = PRIS(:,:,:) * PTSTEP - IF (JN == 1) PQIS(:,:,:) = PQIS(:,:,:) * PTSTEP - ZWSED(:,:,:) = 0. - ZWSEDQ(:,:,:) = 0. - IF( ISEDIMI >= 1 ) THEN - IF ( ISEDIMI .GT. ILENALLOCI ) THEN - IF ( ILENALLOCI .GT. 0 ) THEN - DEALLOCATE (ZRIS, ZRHODREFI, ILISTI) - DEALLOCATE (ZQIS, ZEIS, ZCIT, ZCIS, ZLBDAI) - END IF - ILENALLOCI = MAX (IOLDALLOCI, 2*ISEDIMI ) - IOLDALLOCI = ILENALLOCI - ALLOCATE(ZRIS(ILENALLOCI), ZRHODREFI(ILENALLOCI), ILISTI(ILENALLOCI)) - ALLOCATE(ZQIS(ILENALLOCI), & - ZEIS(ILENALLOCI), & - ZCIT(ILENALLOCI), & - ZCIS(ILENALLOCI), & - ZLBDAI(ILENALLOCI)) - END IF -! - DO JL = 1, ISEDIMI - ZRIS(JL) = PRIS(II1(JL),II2(JL),II3(JL)) - ZRHODREFI(JL) = PRHODREF(II1(JL),II2(JL),II3(JL)) - ZQIS(JL) = PQIS(II1(JL),II2(JL),II3(JL)) - ZCIT(JL) = PCIT(II1(JL),II2(JL),II3(JL)) - ZEIS(JL) = 0. -! compute e_i - IF (ZRIS(JL) > ZRTMIN(4) .AND. ZCIT(JL) > 0.0) THEN - ZEIS(JL) = ZRHODREFI(JL) * ZQIS(JL) / ((ZCIT(JL)**(1 - XEXFQUPDI)) * & - XFQUPDI * (ZRHODREFI(JL) * ZRIS(JL))**XEXFQUPDI) - ZEIS(JL) = SIGN( MIN(ABS(ZEIS(JL)), XEIMAX), ZEIS(JL)) - ZCIS(JL) = XFCI * ZRHODREFI(JL) * ZRIS(JL) * & - MAX(0.05E6, & - -0.15319E6 - 0.021454E6 * ALOG(ZRHODREFI(JL) * ZRIS(JL)))**3 - ZLBDAI(JL) = (2.14E-3 * MOMG(XALPHAI,XNUI,1.7) * & - ZCIS(JL) / (ZRHODREFI(JL) * ZRIS(JL)))**0.588235 - END IF - END DO -! - ILISTLENI = 0 - DO JL = 1, ISEDIMI - IF (ZRIS(JL) .GT. MAX(ZRTMIN(4),1.0E-7 )) THEN ! limitation of the McF&H formula - ILISTLENI = ILISTLENI + 1 - ILISTI(ILISTLENI) = JL - END IF - END DO - DO JJ = 1, ILISTLENI - JL = ILISTI(JJ) - IF (ZRIS(JL) > ZRTMIN(4) .AND. ZCIT(JL) > 0.0 .AND. LSEDIM_BEARD) THEN - ZK = 1. - ZQIS(JL) * XEFIELDW(II1(JL),II2(JL),II3(JL)) / (ZRIS(JL)*XG) - IF (ZK <= 0.0) THEN - ZBEARDCOEFI = 0. - ELSE - ZRE0 = ZVI / ZLBDAI(JL)**2.585 - IF (ZRE0 <= 0.2) THEN - ZBEARDCOEFI = ZF0(II1(JL),II2(JL),II3(JL)) * ZK - ELSE IF (ZRE0 >= 1000.) THEN - ZBEARDCOEFI = ZF1(II1(JL),II2(JL),II3(JL)) * SQRT(ZK) - ELSE - ZBEARDCOEFI = ZF0(II1(JL),II2(JL),II3(JL)) * ZK + & - (ZF1(II1(JL),II2(JL),II3(JL)) * & - SQRT(ZK) - ZF0(II1(JL),II2(JL),II3(JL)) * ZK) * & - (1.61 + LOG(ZRE0)) / 8.52 - END IF - ZBEARDCOEFI = ZBEARDCOEFI * ZCOR(II1(JL),II2(JL),II3(JL)) - END IF - ELSE - ZBEARDCOEFI = 1.0 ! No "Beard" effect - END IF -! - ZWSED(II1(JL),II2(JL),II3(JL))= ZBEARDCOEFI * & - XFSEDI * ZRIS(JL) * & - ZRHODREFI(JL)**(1.0-XCEXVT) * & ! McF&H - MAX( 0.05E6,-0.15319E6-0.021454E6* & - ALOG(ZRHODREFI(JL)*ZRIS(JL)) )**XEXCSEDI - IF (ZRIS(JL) .GT. MAX(ZRTMIN(4),1.0E-7) .AND. ABS(ZEIS(JL)) .GT. XEIMIN .AND. & - ZCIT(JL) .GT. 0. ) THEN - ZWSEDQ(II1(JL),II2(JL),II3(JL)) = ZBEARDCOEFI * & - ZCIS(JL)**(1 - XEXQSEDI) * XFQSEDI * & - ZRIS(JL)**XEXQSEDI * ZRHODREFI(JL)**(XEXQSEDI - XCEXVT) * & - ZEIS(JL) * (ZCIT(JL) / ZCIS(JL))**(1.-XFI/XBI) - END IF - END DO - END IF - DO JK = IKB, IKE - PRIS(:,:,JK) = PRIS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK)) - PQIS(:,:,JK) = PQIS(:,:,JK) + ZW(:,:,JK) * (ZWSEDQ(:,:,JK+1) - ZWSEDQ(:,:,JK)) - END DO - IF (JN == KSPLITR) THEN - PRIS(:,:,:) = PRIS(:,:,:) / PTSTEP - PQIS(:,:,:) = PQIS(:,:,:) / PTSTEP - END IF -! -! -!* 2.4 for aggregates/snow -! - IF( JN==1 ) PRSS(:,:,:) = PRSS(:,:,:) * PTSTEP - IF (JN == 1) PQSS(:,:,:) = PQSS(:,:,:) * PTSTEP - ZWSED(:,:,:) = 0. - ZWSEDQ(:,:,:) = 0. - IF( ISEDIMS >= 1 ) THEN - IF ( ISEDIMS .GT. ILENALLOCS ) THEN - IF ( ILENALLOCS .GT. 0 ) THEN - DEALLOCATE (ZRSS, ZRHODREFS, ILISTS) - DEALLOCATE (ZQSS, ZESS, ZLBDAS) - END IF - ILENALLOCS = MAX(IOLDALLOCS, 2*ISEDIMS ) - IOLDALLOCS = ILENALLOCS - ALLOCATE(ZRSS(ILENALLOCS), ZRHODREFS(ILENALLOCS), ILISTS(ILENALLOCS)) - ALLOCATE(ZQSS(ILENALLOCS), ZESS(ILENALLOCS), ZLBDAS(ILENALLOCS)) - END IF -! - DO JL = 1, ISEDIMS - ZRSS(JL) = PRSS(IS1(JL),IS2(JL),IS3(JL)) - ZRHODREFS(JL) = PRHODREF(IS1(JL),IS2(JL),IS3(JL)) - ZQSS(JL) = PQSS(IS1(JL),IS2(JL),IS3(JL)) - ZESS(JL) = 0. -! compute lambda_s and e_s - IF (ZRSS(JL) > 0.) THEN - ZLBDAS(JL) = MIN(XLBDAS_MAX, & - XLBS * (ZRHODREFS(JL) * MAX(ZRSS(JL), ZRTMIN(5)))**XLBEXS) - END IF - IF (ZRSS(JL) > ZRTMIN(5) .AND. ZLBDAS(JL) > 0.) THEN - ZESS(JL) = ZRHODREFS(JL) * ZQSS(JL) / (XFQUPDS * ZLBDAS(JL)**(XCXS - XFS)) - ZESS(JL) = SIGN( MIN(ABS(ZESS(JL)), XESMAX), ZESS(JL)) - END IF - END DO -! - ILISTLENS = 0 - DO JL = 1, ISEDIMS - IF (ZRSS(JL) .GT. ZRTMIN(5)) THEN - ILISTLENS = ILISTLENS + 1 - ILISTS(ILISTLENS) = JL - END IF - END DO - DO JJ = 1, ILISTLENS - JL = ILISTS(JJ) - IF (ZRSS(JL) > 0. .AND. LSEDIM_BEARD) THEN - ZK = 1. - ZQSS(JL) * XEFIELDW(IS1(JL),IS2(JL),IS3(JL)) / (ZRSS(JL)*XG) - IF (ZK <= 0.0) THEN - ZBEARDCOEFS = 0. - ELSE - ZRE0 = ZVS / ZLBDAS(JL)**(1.+XDS) - IF (ZRE0 <= 0.2) THEN - ZBEARDCOEFS = ZF0(IS1(JL),IS2(JL),IS3(JL)) * ZK - ELSE IF (ZRE0 >= 1000.) THEN - ZBEARDCOEFS = ZF1(IS1(JL),IS2(JL),IS3(JL)) * SQRT(ZK) - ELSE - ZBEARDCOEFS = ZF0(IS1(JL),IS2(JL),IS3(JL)) * ZK + & - (ZF1(IS1(JL),IS2(JL),IS3(JL)) * & - SQRT(ZK) -ZF0(IS1(JL),IS2(JL),IS3(JL)) * ZK) * & - (1.61 + LOG(ZRE0)) / 8.52 - END IF - ZBEARDCOEFS = ZBEARDCOEFS * ZCOR(IS1(JL),IS2(JL),IS3(JL)) - END IF - ELSE - ZBEARDCOEFS = 1.0 ! No "Beard" effect - END IF -! - ZWSED (IS1(JL),IS2(JL),IS3(JL)) = ZBEARDCOEFS * & - XFSEDS * ZRSS(JL)**XEXSEDS * & - ZRHODREFS(JL)**(XEXSEDS-XCEXVT) - IF (ZRSS(JL) .GT. ZRTMIN(5) .AND. ABS(ZESS(JL)) > XESMIN) THEN - ZWSEDQ(IS1(JL),IS2(JL),IS3(JL)) = ZBEARDCOEFS * & - XFQSEDS * ZESS(JL) * & - ZRSS(JL)**XEXQSEDS * & - ZRHODREFS(JL)**(XEXQSEDS - XCEXVT) - END IF - END DO - END IF - DO JK = IKB, IKE - PRSS(:,:,JK) = PRSS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK)) - PQSS(:,:,JK) = PQSS(:,:,JK) + ZW(:,:,JK) * (ZWSEDQ(:,:,JK+1) - ZWSEDQ(:,:,JK)) - END DO - PINPRS(:,:) = PINPRS(:,:) + ZWSED(:,:,IKB) / XRHOLW / KSPLITR - IF (JN == KSPLITR) THEN - PRSS(:,:,:) = PRSS(:,:,:) / PTSTEP - PQSS(:,:,:) = PQSS(:,:,:) / PTSTEP - END IF -! -! -!* 2.5 for graupeln -! - ZWSED(:,:,:) = 0. - ZWSEDQ(:,:,:) = 0. - IF( JN==1 ) PRGS(:,:,:) = PRGS(:,:,:) * PTSTEP - IF (JN == 1) PQGS(:,:,:) = PQGS(:,:,:) * PTSTEP - IF( ISEDIMG >= 1 ) THEN - IF ( ISEDIMG .GT. ILENALLOCG ) THEN - IF ( ILENALLOCG .GT. 0 ) THEN - DEALLOCATE (ZRGS, ZRHODREFG, ILISTG) - DEALLOCATE (ZQGS, ZEGS, ZLBDAG) - END IF - ILENALLOCG = MAX (IOLDALLOCG, 2*ISEDIMG ) - IOLDALLOCG = ILENALLOCG - ALLOCATE(ZRGS(ILENALLOCG), ZRHODREFG(ILENALLOCG), ILISTG(ILENALLOCG)) - ALLOCATE(ZQGS(ILENALLOCG), ZEGS(ILENALLOCG), ZLBDAG(ILENALLOCG)) - END IF -! - DO JL = 1, ISEDIMG - ZRGS(JL) = PRGS(IG1(JL),IG2(JL),IG3(JL)) - ZRHODREFG(JL) = PRHODREF(IG1(JL),IG2(JL),IG3(JL)) - ZQGS(JL) = PQGS(IG1(JL),IG2(JL),IG3(JL)) - ZEGS(JL) = 0. -! compute lambda_g and e_g - IF (ZRGS(JL) > 0.) THEN - ZLBDAG(JL) = XLBG * (ZRHODREFG(JL) * MAX(ZRGS(JL), ZRTMIN(6)))**XLBEXG - END IF - IF (ZRGS(JL) > ZRTMIN(6) .AND. ZLBDAG(JL) > 0.) THEN - ZEGS(JL) = ZRHODREFG(JL) * ZQGS(JL) / (XFQUPDG * ZLBDAG(JL)**(XCXG - XFG)) - ZEGS(JL) = SIGN( MIN(ABS(ZEGS(JL)), XEGMAX), ZEGS(JL)) - END IF - END DO -! - ILISTLENG = 0 - DO JL = 1, ISEDIMG - IF (ZRGS(JL) .GT. ZRTMIN(6)) THEN - ILISTLENG = ILISTLENG + 1 - ILISTG(ILISTLENG) = JL - END IF - END DO - DO JJ = 1, ILISTLENG - JL = ILISTG(JJ) - IF (ZRGS(JL) > 0. .AND. LSEDIM_BEARD) THEN - ZK = 1. - ZQGS(JL) * XEFIELDW(IG1(JL),IG2(JL),IG3(JL)) / (ZRGS(JL)*XG) - IF (ZK <= 0.0) THEN - ZBEARDCOEFG = 0. - ELSE - ZRE0 = ZVG / ZLBDAG(JL)**(1.+XDG) - IF (ZRE0 <= 0.2) THEN - ZBEARDCOEFG = ZF0(IG1(JL),IG2(JL),IG3(JL)) * ZK - ELSE IF (ZRE0 >= 1000.) THEN - ZBEARDCOEFG = ZF1(IG1(JL),IG2(JL),IG3(JL)) * SQRT(ZK) - ELSE - ZBEARDCOEFG = ZF0(IG1(JL),IG2(JL),IG3(JL)) * ZK + & - (ZF1(IG1(JL),IG2(JL),IG3(JL)) * & - SQRT(ZK) - ZF0(IG1(JL),IG2(JL),IG3(JL)) * ZK) * & - (1.61 + LOG(ZRE0)) / 8.52 - END IF - ZBEARDCOEFG = ZBEARDCOEFG * ZCOR(IG1(JL),IG2(JL),IG3(JL)) - END IF - ELSE - ZBEARDCOEFG = 1.0 ! No "Beard" effect - END IF -! - ZWSED (IG1(JL),IG2(JL),IG3(JL))= ZBEARDCOEFG * & - XFSEDG * ZRGS(JL)**XEXSEDG * & - ZRHODREFG(JL)**(XEXSEDG-XCEXVT) - IF (ZRGS(JL) .GT. ZRTMIN(6) .AND. ABS(ZEGS(JL)) > XEGMIN) THEN - ZWSEDQ(IG1(JL),IG2(JL),IG3(JL)) = ZBEARDCOEFG * & - XFQSEDG * ZEGS(JL) * & - ZRGS(JL)**XEXQSEDG * & - ZRHODREFG(JL)**(XEXQSEDG - XCEXVT) - END IF - END DO - END IF - DO JK = IKB, IKE - PRGS(:,:,JK) = PRGS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK)) - PQGS(:,:,JK) = PQGS(:,:,JK) + ZW(:,:,JK) * (ZWSEDQ(:,:,JK+1) - ZWSEDQ(:,:,JK)) - END DO - PINPRG(:,:) = PINPRG(:,:) + ZWSED(:,:,IKB) / XRHOLW / KSPLITR - IF (JN == KSPLITR) THEN - PRGS(:,:,:) = PRGS(:,:,:) / PTSTEP - PQGS(:,:,:) = PQGS(:,:,:) / PTSTEP - END IF -! -! -!* 2.6 for hail -! - IF ( KRR == 7 ) THEN - IF( JN==1 ) PRHS(:,:,:) = PRHS(:,:,:) * PTSTEP - IF (JN == 1) PQHS(:,:,:) = PQHS(:,:,:) * PTSTEP - ZWSED(:,:,:) = 0. - ZWSEDQ(:,:,:) = 0. - IF( ISEDIMH >= 1 ) THEN - IF ( ISEDIMH .GT. ILENALLOCH ) THEN - IF ( ILENALLOCH .GT. 0 ) THEN - DEALLOCATE (ZRHS, ZRHODREFH, ILISTH) - DEALLOCATE (ZQHS, ZEHS, ZLBDAH) - END IF - ILENALLOCH = MAX(IOLDALLOCH, 2*ISEDIMH ) - IOLDALLOCH = ILENALLOCH - ALLOCATE(ZRHS(ILENALLOCH), ZRHODREFH(ILENALLOCH), ILISTH(ILENALLOCH)) - ALLOCATE(ZQHS(ILENALLOCH), ZLBDAH(ILENALLOCH), ZEHS(ILENALLOCH)) - END IF -! - DO JL = 1, ISEDIMH - ZRHS(JL) = PRHS(IH1(JL),IH2(JL),IH3(JL)) - ZRHODREFH(JL) = PRHODREF(IH1(JL),IH2(JL),IH3(JL)) - ZQHS(JL) = PQHS(IH1(JL),IH2(JL),IH3(JL)) - ZEHS(JL) = 0. -! compute lambda_h and e_h - IF (ZRHS(JL) > 0.) THEN - ZLBDAH(JL) = XLBH * (ZRHODREFH(JL) * MAX(ZRHS(JL), ZRTMIN(7)))**XLBEXH - END IF - IF (ZRHS(JL) > ZRTMIN(7) .AND. ZLBDAH(JL) > 0.) THEN - ZEHS(JL) = ZRHODREFH(JL) * ZQHS(JL) / (XFQUPDH * ZLBDAH(JL)**(XCXH - XFH)) - ZEHS(JL) = SIGN( MIN(ABS(ZEHS(JL)), XEHMAX), ZEHS(JL)) - END IF - END DO -! - ILISTLENH = 0 - DO JL = 1, ISEDIMH - IF (ZRHS(JL) .GT. ZRTMIN(7)) THEN - ILISTLENH = ILISTLENH + 1 - ILISTH(ILISTLENH) = JL - END IF - END DO - DO JJ = 1, ILISTLENH - JL = ILISTH(JJ) - ZWSED (IH1(JL),IH2(JL),IH3(JL)) = XFSEDH * ZRHS(JL)**XEXSEDH * & - ZRHODREFH(JL)**(XEXSEDH-XCEXVT) - IF (ZRHS(JL) .GT. ZRTMIN(7) .AND. ABS(ZEHS(JL)) > XEHMIN) THEN - ZWSEDQ(IH1(JL),IH2(JL),IH3(JL)) = XFQSEDH * ZEHS(JL) * & - ZRHS(JL)**XEXQSEDH * & - ZRHODREFH(JL)**(XEXQSEDH - XCEXVT) - END IF - END DO - END IF - DO JK = IKB, IKE - PRHS(:,:,JK) = PRHS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK)) - PQHS(:,:,JK) = PQHS(:,:,JK) + ZW(:,:,JK) * (ZWSEDQ(:,:,JK+1) - ZWSEDQ(:,:,JK)) - END DO - PINPRH(:,:) = PINPRH(:,:) + ZWSED(:,:,IKB) / XRHOLW / KSPLITR - IF (JN == KSPLITR) THEN - PRHS(:,:,:) = PRHS(:,:,:) / PTSTEP - PQHS(:,:,:) = PQHS(:,:,:) / PTSTEP - END IF - END IF - END DO -! - IF (OSEDIC) THEN - IF (ILENALLOCC .GT. 0) DEALLOCATE (ZRCS, ZRHODREFC, & - ILISTC,ZWLBDC,ZCONC,ZRCT, ZZT,ZPRES,ZRAY1D,ZFSEDC1D, ZWLBDA,ZCC) - END IF - IF (ILENALLOCR .GT. 0 ) DEALLOCATE(ZRHODREFR,ZRRS,ILISTR) - IF (ILENALLOCI .GT. 0 ) DEALLOCATE(ZRHODREFI,ZRIS,ILISTI) - IF (ILENALLOCS .GT. 0 ) DEALLOCATE(ZRHODREFS,ZRSS,ILISTS) - IF (ILENALLOCG .GT. 0 ) DEALLOCATE(ZRHODREFG,ZRGS,ILISTG) - IF (KRR == 7 .AND. (ILENALLOCH .GT. 0 )) DEALLOCATE(ZRHODREFH,ZRHS,ILISTH) -! - IF (ILENALLOCR .GT. 0 ) DEALLOCATE(ZERS,ZQRS,ZLBDAR) - IF (ILENALLOCI .GT. 0 ) DEALLOCATE(ZEIS,ZQIS,ZCIS,ZCIT,ZLBDAI) - IF (ILENALLOCS .GT. 0 ) DEALLOCATE(ZESS,ZQSS,ZLBDAS) - IF (ILENALLOCG .GT. 0 ) DEALLOCATE(ZEGS,ZQGS,ZLBDAG) - IF (KRR == 7 .AND. (ILENALLOCH .GT. 0 )) DEALLOCATE(ZEHS,ZQHS,ZLBDAH) -! -! -!* 2.3 budget storage -! - if ( lbudget_rc .and. osedic ) & - call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_sv ) then - if ( osedic ) & - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'SEDI', pqcs(:, :, :) * prhodj(:, :, :) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'SEDI', pqrs(:, :, :) * prhodj(:, :, :) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'SEDI', pqis(:, :, :) * prhodj(:, :, :) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'SEDI', pqss(:, :, :) * prhodj(:, :, :) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'SEDI', pqgs(:, :, :) * prhodj(:, :, :) ) - if ( krr == 7 ) & - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'SEDI', pqhs(:, :, :) * prhodj(:, :, :) ) - end if -! - END SUBROUTINE RAIN_ICE_ELEC_SEDIMENTATION_SPLIT -! -!------------------------------------------------------------------------------- -! - SUBROUTINE RAIN_ICE_SEDIMENTATION_STAT -! -!* 0. DECLARATIONS -! ------------ -! -IMPLICIT NONE -! -!* 0.2 declaration of local variables -! -! - -REAL :: ZP1,ZP2,ZQP,ZH,ZZWLBDA,ZZWLBDC,ZZCC -INTEGER :: JI,JJ,JK -! -REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZCONC3D ! droplet condensation -! -!------------------------------------------------------------------------------- - if ( lbudget_rc .and. osedic ) & - call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_sv ) then - if ( osedic ) & - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'SEDI', pqcs(:, :, :) * prhodj(:, :, :) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'SEDI', pqrs(:, :, :) * prhodj(:, :, :) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'SEDI', pqis(:, :, :) * prhodj(:, :, :) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'SEDI', pqss(:, :, :) * prhodj(:, :, :) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'SEDI', pqgs(:, :, :) * prhodj(:, :, :) ) - if ( krr == 7 ) & - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'SEDI', pqhs(:, :, :) * prhodj(:, :, :) ) - end if -! -!* 1. Parameters for cloud sedimentation -! - IF (OSEDIC) THEN - ZRAY(:,:,:) = 0. - ZLBC(:,:,:) = XLBC(1) - ZFSEDC(:,:,:) = XFSEDC(1) - ZCONC3D(:,:,:) = XCONC_LAND - ZCONC_TMP(:,:) = XCONC_LAND - IF (PRESENT(PSEA)) THEN - ZCONC_TMP(:,:) = PSEA(:,:) * XCONC_SEA + (1. - PSEA(:,:)) * XCONC_LAND - DO JK = IKB, IKE - ZLBC(:,:,JK) = PSEA(:,:) * XLBC(2) + (1. - PSEA(:,:)) * XLBC(1) - ZFSEDC(:,:,JK) = (PSEA(:,:) * XFSEDC(2) + (1. - PSEA(:,:)) * XFSEDC(1)) - ZFSEDC(:,:,JK) = MAX(MIN(XFSEDC(1),XFSEDC(2)),ZFSEDC(:,:,JK)) - ZCONC3D(:,:,JK) = (1. - PTOWN(:,:)) * ZCONC_TMP(:,:) + PTOWN(:,:) * XCONC_URBAN - ZRAY(:,:,JK) = 0.5 * ((1. - PSEA(:,:)) * MOMG(XALPHAC, XNUC, 1.0) + & - PSEA(:,:) * MOMG(XALPHAC2, XNUC2, 1.0) ) - END DO - ELSE - ZCONC3D(:,:,:) = XCONC_LAND - ZRAY(:,:,:) = 0.5 * MOMG(XALPHAC, XNUC, 1.0) - END IF - ZRAY(:,:,:) = MAX(1.,ZRAY(:,:,:)) - ZLBC(:,:,:) = MAX(MIN(XLBC(1),XLBC(2)),ZLBC(:,:,:)) - ENDIF -! -! -!* 2. compute the fluxes -! - ZRTMIN(:) = XRTMIN(:) / PTSTEP -! - IF (OSEDIC) THEN - ZPRCS(:,:,:) = 0.0 - ZPRCS(:,:,:) = PRCS(:,:,:) - PRCT(:,:,:) / PTSTEP - PRCS(:,:,:) = PRCT(:,:,:) / PTSTEP - END IF - ZPRRS(:,:,:) = 0.0 - ZPRSS(:,:,:) = 0.0 - ZPRGS(:,:,:) = 0.0 - IF (KRR == 7) ZPRHS(:,:,:) = 0.0 -! - ZPRRS(:,:,:) = PRRS(:,:,:) - PRRT(:,:,:) / PTSTEP - ZPRSS(:,:,:) = PRSS(:,:,:) - PRST(:,:,:) / PTSTEP - ZPRGS(:,:,:) = PRGS(:,:,:) - PRGT(:,:,:) / PTSTEP - IF (KRR == 7) ZPRHS(:,:,:) = PRHS(:,:,:) - PRHT(:,:,:) / PTSTEP - PRRS(:,:,:) = PRRT(:,:,:) / PTSTEP - PRSS(:,:,:) = PRST(:,:,:) / PTSTEP - PRGS(:,:,:) = PRGT(:,:,:) / PTSTEP - IF (KRR == 7) PRHS(:,:,:) = PRHT(:,:,:) / PTSTEP -! - IF (OSEDIC) PRCS(:,:,:) = PRCS(:,:,:) + ZPRCS(:,:,:) - PRRS(:,:,:) = PRRS(:,:,:) + ZPRRS(:,:,:) - PRSS(:,:,:) = PRSS(:,:,:) + ZPRSS(:,:,:) - PRGS(:,:,:) = PRGS(:,:,:) + ZPRGS(:,:,:) - IF (KRR == 7) PRHS(:,:,:) = PRHS(:,:,:) + ZPRHS(:,:,:) - DO JK = IKB, IKE - ZW(:,:,JK) = ZTSPLITR / (PRHODREF(:,:,JK) * (PZZ(:,:,JK+1) - PZZ(:,:,JK))) - END DO -! -! -!* 2.1 for cloud -! - IF (OSEDIC) THEN - PRCS(:,:,:) = PRCS(:,:,:) * PTSTEP - ZWSED(:,:,:) = 0. - ZWSEDW1(:,:,:) = 0. - ZWSEDW2(:,:,:) = 0. - -! calculation of P1, P2 and sedimentation flux - DO JK = IKE , IKB, -1 - DO JJ = IJB, IJE - DO JI = IIB, IIE - ! estimation of q' taking into account incomming ZWSED - ZQP = ZWSED(JI,JJ,JK+1) * ZW(JI,JJ,JK) - ! calculation of w - ! mars 2009 : ajout d'un test - ! IF ( PRCS(JI,JJ,JK) > ZRTMIN(2) ) THEN - IF(PRCS(JI,JJ,JK) > ZRTMIN(2) .AND. PRCT(JI,JJ,JK) > ZRTMIN(2)) THEN - ZZWLBDA = 6.6E-8 * (101325. / PPABST(JI,JJ,JK)) * (PTHT(JI,JJ,JK) / 293.15) - ZZWLBDC = (ZLBC(JI,JJ,JK) * ZCONC3D(JI,JJ,JK) / & - (PRHODREF(JI,JJ,JK) * PRCT(JI,JJ,JK)))**XLBEXC - ZZCC = XCC * (1. + 1.26 * ZZWLBDA * ZZWLBDC / ZRAY(JI,JJ,JK)) ! ZCC: Fall speed - ZWSEDW1(JI,JJ,JK) = PRHODREF(JI,JJ,JK)**(-XCEXVT ) * & - ZZWLBDC**(-XDC) * ZZCC * ZFSEDC(JI,JJ,JK) - ENDIF - IF (ZQP > ZRTMIN(2)) THEN - ZZWLBDA = 6.6E-8 * (101325. / PPABST(JI,JJ,JK)) * (PTHT(JI,JJ,JK) / 293.15) - ZZWLBDC = (ZLBC(JI,JJ,JK) * ZCONC3D(JI,JJ,JK) / & - (PRHODREF(JI,JJ,JK) * ZQP))**XLBEXC - ZZCC = XCC * (1. + 1.26 * ZZWLBDA * ZZWLBDC / ZRAY(JI,JJ,JK)) ! ZCC: Fall speed - ZWSEDW2(JI,JJ,JK) = PRHODREF(JI,JJ,JK)**(-XCEXVT ) * & - ZZWLBDC**(-XDC) * ZZCC * ZFSEDC(JI,JJ,JK) - ENDIF - ENDDO - DO JI = IIB, IIE - ZH = PZZ(JI,JJ,JK+1) - PZZ(JI,JJ,JK) - ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH) - ! mars 2009 : correction : ZWSEDW1 => ZWSEDW2 - !IF (ZWSEDW1(JI,JJ,JK) /= 0.) THEN - IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN - ZP2 = MAX(0., 1. - ZH / (PTSTEP * ZWSEDW2(JI,JJ,JK)) ) - ELSE - ZP2 = 0. - ENDIF - ZWSED(JI,JJ,JK) = ZP1 * PRHODREF(JI,JJ,JK) * & - (PZZ(JI,JJ,JK+1) - PZZ(JI,JJ,JK)) * PRCS(JI,JJ,JK) / & - PTSTEP + ZP2 * ZWSED (JI,JJ,JK+1) - ENDDO - ENDDO - ENDDO -! - DO JK = IKB , IKE - PRCS(:,:,JK) = PRCS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK)) - END DO - - PINPRC(:,:) = ZWSED(:,:,IKB) / XRHOLW ! in m/s - PRCS(:,:,:) = PRCS(:,:,:) / PTSTEP - ENDIF -! -! -!* 2.2 for rain -! - PRRS(:,:,:) = PRRS(:,:,:) * PTSTEP - ZWSED(:,:,:) = 0. - ZWSEDW1(:,:,:) = 0. - ZWSEDW2(:,:,:) = 0. -! -! calculation of ZP1, ZP2 and sedimentation flux - DO JK = IKE , IKB, -1 - DO JJ = IJB, IJE - DO JI = IIB, IIE - ! estimation of q' taking into account incomming ZWSED - ZQP = ZWSED(JI,JJ,JK+1) * ZW(JI,JJ,JK) - ! calculation of w - IF (PRRS(JI,JJ,JK) > ZRTMIN(3)) THEN - ZWSEDW1 (JI,JJ,JK) = XFSEDR * PRRS(JI,JJ,JK)**(XEXSEDR-1) * & - PRHODREF(JI,JJ,JK)**(XEXSEDR-XCEXVT-1) - ENDIF - IF (ZQP > ZRTMIN(3)) THEN - ZWSEDW2(JI,JJ,JK) = XFSEDR * (ZQP)**(XEXSEDR-1) * & - PRHODREF(JI,JJ,JK)**(XEXSEDR-XCEXVT-1) - ENDIF - ENDDO - DO JI = IIB, IIE - ZH = PZZ(JI,JJ,JK+1) - PZZ(JI,JJ,JK) - ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH ) - IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN - ZP2 = MAX(0., 1 - ZH / (PTSTEP * ZWSEDW2(JI,JJ,JK)) ) - ELSE - ZP2 = 0. - ENDIF - ZWSED(JI,JJ,JK) = ZP1 * PRHODREF(JI,JJ,JK) * & - ZH * PRRS(JI,JJ,JK) / & - PTSTEP + ZP2 * ZWSED (JI,JJ,JK+1) - ENDDO - ENDDO - ENDDO - - DO JK = IKB , IKE - PRRS(:,:,JK) = PRRS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK)) - ENDDO - PINPRR(:,:) = ZWSED(:,:,IKB) / XRHOLW ! in m/s - PINPRR3D(:,:,:) = ZWSED(:,:,:) / XRHOLW ! in m/s - PRRS(:,:,:) = PRRS(:,:,:) / PTSTEP -! -! -!* 2.3 for pristine ice -! - PRIS(:,:,:) = PRIS(:,:,:) * PTSTEP - ZWSED(:,:,:) = 0. - ZWSEDW1(:,:,:) = 0. - ZWSEDW2(:,:,:) = 0. -! calculation of ZP1, ZP2 and sedimentation flux - DO JK = IKE , IKB, -1 - DO JJ = IJB, IJE - DO JI = IIB, IIE - ! estimation of q' taking into account incomming ZWSED - ZQP = ZWSED(JI,JJ,JK+1) * ZW(JI,JJ,JK) - ! calculation of w - IF (PRIS(JI,JJ,JK) > MAX(ZRTMIN(4),1.0E-7)) THEN - ZWSEDW1(JI,JJ,JK) = XFSEDI * & - PRHODREF(JI,JJ,JK)**(XCEXVT) * & ! McF&H - MAX(0.05E6,-0.15319E6-0.021454E6* & - ALOG(PRHODREF(JI,JJ,JK)*PRIS(JI,JJ,JK)))**XEXCSEDI - ENDIF - IF (ZQP > MAX(ZRTMIN(4),1.0E-7)) THEN - ZWSEDW2(JI,JJ,JK)= XFSEDI * & - PRHODREF(JI,JJ,JK)**(XCEXVT) * & ! McF&H - MAX( 0.05E6,-0.15319E6-0.021454E6* & - ALOG(PRHODREF(JI,JJ,JK)*ZQP) )**XEXCSEDI - ENDIF - ENDDO - DO JI = IIB, IIE - ZH = PZZ(JI,JJ,JK+1) - PZZ(JI,JJ,JK) - ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH ) - IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN - ZP2 = MAX(0.,1 - ZH / (PTSTEP * ZWSEDW2(JI,JJ,JK))) - ELSE - ZP2 = 0. - ENDIF - ZWSED(JI,JJ,JK) = ZP1 * PRHODREF(JI,JJ,JK) * & - (PZZ(JI,JJ,JK+1) - PZZ(JI,JJ,JK)) * PRIS(JI,JJ,JK) / & - PTSTEP + ZP2 * ZWSED(JI,JJ,JK+1) - ENDDO - ENDDO - ENDDO -! - DO JK = IKB , IKE - PRIS(:,:,JK) = PRIS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK)) - ENDDO -! - PRIS(:,:,:) = PRIS(:,:,:) / PTSTEP -! -! -!* 2.4 for aggregates/snow -! - PRSS(:,:,:) = PRSS(:,:,:) * PTSTEP - ZWSED(:,:,:) = 0. - ZWSEDW1(:,:,:) = 0. - ZWSEDW2(:,:,:) = 0. - -! calculation of ZP1, ZP2 and sedimentation flux - DO JK = IKE , IKB, -1 - DO JJ = IJB, IJE - DO JI = IIB, IIE - ! estimation of q' taking into account incomming ZWSED - ZQP = ZWSED(JI,JJ,JK+1) * ZW(JI,JJ,JK) - ! calculation of w - IF (PRSS(JI,JJ,JK) > ZRTMIN(5)) THEN - ZWSEDW1(JI,JJ,JK) = XFSEDS * (PRSS(JI,JJ,JK))**(XEXSEDS-1) * & - PRHODREF(JI,JJ,JK)**(XEXSEDS-XCEXVT-1) - ENDIF - IF (ZQP > ZRTMIN(5)) THEN - ZWSEDW2(JI,JJ,JK) = XFSEDS * (ZQP)**(XEXSEDS-1) * & - PRHODREF(JI,JJ,JK)**(XEXSEDS-XCEXVT-1) - ENDIF - ENDDO - DO JI = IIB, IIE - ZH = PZZ(JI,JJ,JK+1) - PZZ(JI,JJ,JK) - ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH ) - IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN - ZP2 = MAX(0.,1 - ZH / (PTSTEP * ZWSEDW2(JI,JJ,JK)) ) - ELSE - ZP2 = 0. - ENDIF - ZWSED(JI,JJ,JK) = ZP1 * PRHODREF(JI,JJ,JK) * & - ZH * PRSS(JI,JJ,JK) / & - PTSTEP + ZP2 * ZWSED(JI,JJ,JK+1) - ENDDO - ENDDO - ENDDO -! - DO JK = IKB , IKE - PRSS(:,:,JK) = PRSS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK)) - ENDDO -! - PINPRS(:,:) = ZWSED(:,:,IKB) / XRHOLW ! in m/s - PRSS(:,:,:) = PRSS(:,:,:) / PTSTEP -! -! -! -!* 2.5 for graupeln -! - PRGS(:,:,:) = PRGS(:,:,:) * PTSTEP - ZWSED(:,:,:) = 0. - ZWSEDW1(:,:,:) = 0. - ZWSEDW2(:,:,:) = 0. - -! calculation of ZP1, ZP2 and sedimentation flux - DO JK = IKE , IKB, -1 - DO JJ = IJB, IJE - DO JI = IIB, IIE - ! estimation of q' taking into account incomming ZWSED - ZQP = ZWSED(JI,JJ,JK+1) * ZW(JI,JJ,JK) - ! calculation of w - IF (PRGS(JI,JJ,JK) > ZRTMIN(6)) THEN - ZWSEDW1(JI,JJ,JK) = XFSEDG * (PRGS(JI,JJ,JK))**(XEXSEDG-1) * & - PRHODREF(JI,JJ,JK)**(XEXSEDG-XCEXVT-1) - ENDIF - IF (ZQP > ZRTMIN(6)) THEN - ZWSEDW2(JI,JJ,JK) = XFSEDG * (ZQP)**(XEXSEDG-1) * & - PRHODREF(JI,JJ,JK)**(XEXSEDG-XCEXVT-1) - ENDIF - ENDDO - DO JI = IIB, IIE - ZH = PZZ(JI,JJ,JK+1) - PZZ(JI,JJ,JK) - ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH ) - IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN - ZP2 = MAX(0.,1 - ZH / (PTSTEP * ZWSEDW2(JI,JJ,JK)) ) - ELSE - ZP2 = 0. - ENDIF - ZWSED(JI,JJ,JK) = ZP1 * PRHODREF(JI,JJ,JK) * & - ZH * PRGS(JI,JJ,JK) / & - PTSTEP + ZP2 * ZWSED(JI,JJ,JK+1) - ENDDO - ENDDO - ENDDO -! - DO JK = IKB , IKE - PRGS(:,:,JK) = PRGS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK)) - ENDDO - - PINPRG(:,:) = ZWSED(:,:,IKB) / XRHOLW ! in m/s - PRGS(:,:,:) = PRGS(:,:,:) / PTSTEP -! -! -!* 2.6 for hail -! - IF (KRR == 7) THEN - PRHS(:,:,:) = PRHS(:,:,:) * PTSTEP - ZWSED(:,:,:) = 0. - ZWSEDW1(:,:,:) = 0. - ZWSEDW2(:,:,:) = 0. -! calculation of ZP1, ZP2 and sedimentation flux - DO JK = IKE , IKB, -1 - DO JJ = IJB, IJE - DO JI = IIB, IIE - ! estimation of q' taking into account incomming ZWSED - ZQP = ZWSED(JI,JJ,JK+1) * ZW(JI,JJ,JK) - ! calculation of w - IF ((PRHS(JI,JJ,JK)+ZQP) > ZRTMIN(7) ) THEN - ZWSEDW1 (JI,JJ,JK) = XFSEDH * (PRHS(JI,JJ,JK))**(XEXSEDH-1) * & - PRHODREF(JI,JJ,JK)**(XEXSEDH-XCEXVT-1) - ENDIF - IF (ZQP > ZRTMIN(7)) THEN - ZWSEDW2(JI,JJ,JK) = XFSEDH * ZQP**(XEXSEDH-1) * & - PRHODREF(JI,JJ,JK)**(XEXSEDH-XCEXVT-1) - ENDIF - ENDDO - DO JI = IIB, IIE - ZH = PZZ(JI,JJ,JK+1) - PZZ(JI,JJ,JK) - ZP1 = MIN(1., ZWSEDW1(JI,JJ,JK) * PTSTEP / ZH) - IF (ZWSEDW2(JI,JJ,JK) /= 0.) THEN - ZP2 = MAX(0.,1 - ZH / (PTSTEP*ZWSEDW2(JI,JJ,JK))) - ELSE - ZP2 = 0. - ENDIF - ZWSED(JI,JJ,JK) = ZP1 * PRHODREF(JI,JJ,JK) * & - ZH * PRHS(JI,JJ,JK) / & - PTSTEP + ZP2 * ZWSED(JI,JJ,JK+1) - ENDDO - ENDDO - ENDDO -! - DO JK = IKB , IKE - PRHS(:,:,JK) = PRHS(:,:,JK) + ZW(:,:,JK) * (ZWSED(:,:,JK+1) - ZWSED(:,:,JK)) - ENDDO -! - PINPRH(:,:) = ZWSED(:,:,IKB) / XRHOLW ! in m/s - PRHS(:,:,:) = PRHS(:,:,:) / PTSTEP - ENDIF -! -! -!* 2.3 budget storage -! - if ( lbudget_rc .and. osedic ) & - call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_sv ) then - if ( osedic ) & - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'SEDI', pqcs(:, :, :) * prhodj(:, :, :) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'SEDI', pqrs(:, :, :) * prhodj(:, :, :) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'SEDI', pqis(:, :, :) * prhodj(:, :, :) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'SEDI', pqss(:, :, :) * prhodj(:, :, :) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'SEDI', pqgs(:, :, :) * prhodj(:, :, :) ) - if ( krr == 7 ) & - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'SEDI', pqhs(:, :, :) * prhodj(:, :, :) ) - end if -! - END SUBROUTINE RAIN_ICE_SEDIMENTATION_STAT -! -!------------------------------------------------------------------------------- -! -! - SUBROUTINE RAIN_ICE_ELEC_NUCLEATION -! -!* 0. DECLARATIONS -! ------------ -! -IMPLICIT NONE -! -!* 0.2 declaration of local variables -! -INTEGER , DIMENSION(SIZE(GNEGT)) :: I1,I2,I3 ! Used to replace the COUNT -INTEGER :: JL ! and PACK intrinsics -! -!------------------------------------------------------------------------------- -! -! compute the temperature and the pressure -! -ZT(:,:,:) = PTHT(:,:,:) * (PPABST(:,:,:) / XP00) ** (XRD / XCPD) -! -! optimization by looking for locations where -! the temperature is negative only !!! -! -GNEGT(:,:,:) = .FALSE. -GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE) < XTT -INEGT = COUNTJV( GNEGT(:,:,:),I1(:),I2(:),I3(:)) -! -IF( INEGT >= 1 ) THEN - if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HENU', pris(:, :, :) * prhodj(:, :, :) ) - - ALLOCATE(ZRVT(INEGT)) - ALLOCATE(ZCIT(INEGT)) - ALLOCATE(ZZT(INEGT)) - ALLOCATE(ZPRES(INEGT)) - DO JL = 1, INEGT - ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL)) - ZCIT(JL) = PCIT(I1(JL),I2(JL),I3(JL)) - ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL)) - ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL)) - ENDDO - ALLOCATE(ZZW(INEGT)) - ALLOCATE(ZUSW(INEGT)) - ALLOCATE(ZSSI(INEGT)) - ZZW(:) = EXP(XALPI - XBETAI / ZZT(:) - XGAMI * ALOG(ZZT(:))) ! es_i - ZZW(:) = MIN(ZPRES(:) / 2., ZZW(:)) ! safety limitation - ZSSI(:) = ZRVT(:) * (ZPRES(:) - ZZW(:)) / ((XMV / XMD) * ZZW(:)) - 1.0 - ! Supersaturation over ice - ZUSW(:) = EXP(XALPW - XBETAW / ZZT(:) - XGAMW * ALOG(ZZT(:))) ! es_w - ZUSW(:) = MIN(ZPRES(:) / 2., ZUSW(:)) ! safety limitation - ZUSW(:) = (ZUSW(:) / ZZW(:)) * ((ZPRES(:) - ZZW(:)) / (ZPRES(:) - ZUSW(:))) - 1.0 - ! Supersaturation of saturated water vapor over ice -! -!* 3.1 compute the heterogeneous nucleation source: RVHENI -! -!* 3.1.1 compute the cloud ice concentration -! - ZZW(:) = 0.0 - ZSSI(:) = MIN( ZSSI(:), ZUSW(:) ) ! limitation of SSi according to SSw=0 -! - WHERE ((ZZT(:) < XTT-5.0) .AND. (ZSSI(:) > 0.0)) - ZZW(:) = XNU20 * EXP(XALPHA2 * ZSSI(:) - XBETA2) - END WHERE - WHERE ((ZZT(:) <= XTT-2.0) .AND. (ZZT(:) >= XTT-5.0) .AND. (ZSSI(:) > 0.0)) - ZZW(:) = MAX(XNU20 * EXP(-XBETA2), XNU10 * EXP(-XBETA1 * (ZZT(:) - XTT)) * & - (ZSSI(:) / ZUSW(:))**XALPHA1 ) - END WHERE - ZZW(:) = ZZW(:) - ZCIT(:) -! - IF( MAXVAL(ZZW(:)) > 0.0 ) THEN -! -!* 3.1.2 update the r_i and r_v mixing ratios -! - ZZW(:) = MIN(ZZW(:), 50.E3) ! limitation provisoire a 50 l^-1 - ZW(:,:,:) = UNPACK(ZZW(:), MASK=GNEGT(:,:,:), FIELD=0.0) - ZW(:,:,:) = MAX(ZW(:,:,:), 0.0) * XMNU0 / (PRHODREF(:,:,:) * PTSTEP) - PRIS(:,:,:) = PRIS(:,:,:) + ZW(:,:,:) - PRVS(:,:,:) = PRVS(:,:,:) - ZW(:,:,:) - IF (KRR == 7) THEN - PTHS(:,:,:) = PTHS(:,:,:) + & - ZW(:,:,:) * (XLSTT + (XCPV - XCI) * (ZT(:,:,:) - XTT)) / & - ((XCPD + XCPV * PRVT(:,:,:) + XCL * (PRCT(:,:,:) + PRRT(:,:,:)) + & - XCI * (PRIT(:,:,:) + PRST(:,:,:) + PRGT(:,:,:) + PRHT(:,:,:))) * & - PEXNREF(:,:,:)) - ELSE IF(KRR == 6) THEN - PTHS(:,:,:) = PTHS(:,:,:) + & - ZW(:,:,:) * (XLSTT + (XCPV - XCI) * (ZT(:,:,:) - XTT)) / & - ((XCPD + XCPV * PRVT(:,:,:) + XCL * (PRCT(:,:,:) + PRRT(:,:,:)) + & - XCI * (PRIT(:,:,:) + PRST(:,:,:) + PRGT(:,:,:))) * PEXNREF(:,:,:)) - END IF -! f(L_s*(RVHENI)) - ZZW(:) = MAX( ZZW(:)+ZCIT(:),ZCIT(:) ) - PCIT(:,:,:) = MAX( UNPACK( ZZW(:),MASK=GNEGT(:,:,:),FIELD=0.0 ) , & - PCIT(:,:,:) ) - END IF - DEALLOCATE(ZSSI) - DEALLOCATE(ZUSW) - DEALLOCATE(ZZW) - DEALLOCATE(ZPRES) - DEALLOCATE(ZZT) - DEALLOCATE(ZCIT) - DEALLOCATE(ZRVT) - - if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) ) - if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HENU', pris(:, :, :) * prhodj(:, :, :) ) - -END IF - - END SUBROUTINE RAIN_ICE_ELEC_NUCLEATION -! -!------------------------------------------------------------------------------- -! - SUBROUTINE RAIN_ICE_ELEC_SLOW -! -!* 0. DECLARATIONS -! ------------ -USE MODD_CST, ONLY : XMNH_HUGE_12_LOG -! -IMPLICIT NONE -! -!------------------------------------------------------------------------------- -! -! -!* 3.5.1 compute the homogeneous nucleation source: RCHONI & QCHONI -! - if ( lbudget_sv ) then - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'HON', & - Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'HON', & - Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if - - ZZW(:) = 0.0 - ZWQ1(:,1:7) = 0.0 -! - WHERE( ABS(ZECT(:)) <= XECMIN) - ZECT(:) = 0. - ENDWHERE -! - WHERE( (ZZT(:)<XTT-35.0) .AND. (ZRCT(:)>XRTMIN(2)) .AND. (ZRCS(:)>0.) ) - ZZW(:) = MIN( ZRCS(:),XHON*ZRHODREF(:)*ZRCT(:) & - *EXP( MIN(XMNH_HUGE_12_LOG,XALPHA3*(ZZT(:)-XTT)-XBETA3) ) ) - ZRIS(:) = ZRIS(:) + ZZW(:) - ZRCS(:) = ZRCS(:) - ZZW(:) - ZTHS(:) = ZTHS(:) + ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RCHONI)) - ZWQ1(:,1) = XQHON * ZECT(:) * ZZW(:) ! QCHONI - ENDWHERE -! - WHERE (ZZT(:) < (XTT - 35.) .AND. ZRIS(:) > ZRSMIN_ELEC(4) .AND. & - ZRCT(:) > XRTMIN_ELEC(2) .AND. ZRCS(:) > ZRSMIN_ELEC(2) .AND. & - ABS(ZQCS(:)) > XQTMIN(2) .AND. ABS(ZECT(:)) > XECMIN) - ZWQ1(:,1) = SIGN( MIN( ABS(ZQCS(:)),ABS(ZWQ1(:,1)) ),ZQCS(:) ) - ZQIS(:) = ZQIS(:) + ZWQ1(:,1) - ZQCS(:) = ZQCS(:) - ZWQ1(:,1) - END WHERE - - if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HON', Unpack( zzw(:) * ( zlsfact(:) - zlvfact(:) ) & - * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'HON', & - Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HON', & - Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_sv ) then - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'HON', & - Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'HON', & - Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if -! -!* 3.5.2 compute the spontaneous freezing source: RRHONG & QRHONG -! - ZZW(:) = 0.0 -! - WHERE( (ZZT(:)<XTT-35.0) .AND. (ZRRT(:)>XRTMIN(3)) .AND. (ZRRS(:)>0.) ) - ZZW(:) = MIN( ZRRS(:),ZRRT(:)/PTSTEP ) - ZRGS(:) = ZRGS(:) + ZZW(:) - ZRRS(:) = ZRRS(:) - ZZW(:) - ZTHS(:) = ZTHS(:) + ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RRHONG)) - ENDWHERE -! - WHERE (ZZT(:) < (XTT - 35.) .AND. & - ZRRT(:) > XRTMIN_ELEC(3) .AND. ZRRS(:) > ZRSMIN_ELEC(3) .AND. & - ZRGS(:) > ZRSMIN_ELEC(6) .AND. ABS(ZQRT(:)) > XQTMIN(3)) - ZWQ1(:,2) = SIGN( MIN( ABS(ZQRS(:)),ABS(ZQRT(:)/PTSTEP) ),ZQRS(:) ) ! QRHONG - ZQGS(:) = ZQGS(:) + ZWQ1(:,2) - ZQRS(:) = ZQRS(:) - ZWQ1(:,2) - ENDWHERE - - if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'SFR', Unpack( zzw(:) * ( zlsfact(:) - zlvfact(:) ) & - * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'SFR', & - Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'SFR', & - Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_sv ) then - call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'SFR', & - Unpack( -zwq1(:, 2) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'SFR', & - Unpack( zwq1(:, 2) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if -! -!* 3.5.3 compute the deposition, aggregation and autoconversion sources -! - ZKA(:) = 2.38E-2 + 0.0071E-2 * ( ZZT(:) - XTT ) ! k_a - ZDV(:) = 0.211E-4 * (ZZT(:)/XTT)**1.94 * (XP00/ZPRES(:)) ! D_v -! -!* 3.5.3.1 compute the thermodynamical function A_i(T,P) -!* and the c^prime_j (in the ventilation factor) -! - ZAI(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i - ZAI(:) = ( XLSTT + (XCPV-XCI)*(ZZT(:)-XTT) )**2 / (ZKA(:)*XRV*ZZT(:)**2) & - + ( XRV*ZZT(:) ) / (ZDV(:)*ZAI(:)) - ZCJ(:) = XSCFAC * ZRHODREF(:)**0.3 / SQRT( 1.718E-5+0.0049E-5*(ZZT(:)-XTT) ) -! -!* 3.5.3.2 compute the riming-conversion of r_c for r_i production: RCAUTI -! - if ( lbudget_sv ) then - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'DEPS', & - Unpack( zqpis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'DEPS', & - Unpack( zqnis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'DEPS', & - Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if - - ZZW(:) = 0.0 -! - WHERE ((ZRST(:) > XRTMIN(5)) .AND. (ZRSS(:) > 0.0)) - ZZW(:) = ( ZSSI(:)/(ZRHODREF(:)*ZAI(:)) ) * & - ( X0DEPS*ZLBDAS(:)**XEX0DEPS + X1DEPS*ZCJ(:)*ZLBDAS(:)**XEX1DEPS ) - ZZW(:) = MIN( ZRVS(:),ZZW(:) ) * (0.5 + SIGN(0.5,ZZW(:))) & - - MIN( ZRSS(:),ABS(ZZW(:)) ) * (0.5 - SIGN(0.5,ZZW(:))) - ZRSS(:) = ZRSS(:) + ZZW(:) - ZRVS(:) = ZRVS(:) - ZZW(:) - ZTHS(:) = ZTHS(:) + ZZW(:)*ZLSFACT(:) - ZWQ1(:,5) = XCOEF_RQ_S * ZQST(:) * (-ZZW(:)) / ZRST(:) ! sublimation - END WHERE -! - WHERE (ZRST(:) > XRTMIN_ELEC(5) .AND. ZRSS(:) > ZRSMIN_ELEC(5) .AND. & - ZRVS(:) > ZRSMIN_ELEC(1) .AND. ABS(ZQST(:)) > XQTMIN(5) .AND. & - ZZW(:) < 0. .AND. (-ZZW(:) <= ZRSS(:))) - ZWQ1(:,5) = SIGN( MIN( ABS(ZQSS(:)),ABS(ZWQ1(:,5)) ),ZQSS(:) ) - ZQSS(:) = ZQSS(:) - ZWQ1(:,5) - ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ1(:,5)/XECHARGE ) - ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ1(:,5)/XECHARGE ) - ENDWHERE - - if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPS', Unpack( zzw(:) * zlsfact(:) & - * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPS', & - Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'DEPS', & - Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_sv ) then - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'DEPS', & - Unpack( zqpis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'DEPS', & - Unpack( zqnis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'DEPS', & - Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if -! -!* 3.5.3.4 compute the aggregation on r_s: RIAGGS & QIAGGS -! - if ( lbudget_sv ) then - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'AGGS', & - Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'AGGS', & - Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if - - ZZW(:) = 0.0 - ZLATHAMIAGGS(:) = 1.0 - IF (LIAGGS_LATHAM) THEN - ZLATHAMIAGGS(:) = 1.0 + 0.4E-10 * MIN( 2.25E10, & - ZEFIELDU(:)**2+ZEFIELDV(:)**2+ZEFIELDW(:)**2 ) - ENDIF -! - WHERE (ZRIT(:) > XRTMIN(4) .AND. ZRST(:) > XRTMIN(5) .AND. ZRIS(:) > 0.0) - ZZW(:) = MIN( ZRIS(:),XFIAGGS * EXP( XCOLEXIS*(ZZT(:)-XTT) ) & - * ZLATHAMIAGGS(:) & - * ZRIT(:) & - * ZLBDAS(:)**XEXIAGGS & - * ZRHOCOR(:) / ZCOR00 ) - ZRSS(:) = ZRSS(:) + ZZW(:) - ZRIS(:) = ZRIS(:) - ZZW(:) - ZWQ1(:,3) = XCOEF_RQ_I * ZZW(:) * ZQIT(:) / ZRIT(:) ! QIAGGS_coal - END WHERE -! - WHERE (ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRIS(:) > ZRSMIN_ELEC(4) .AND. & - ZRSS(:) > ZRSMIN_ELEC(5) .AND. ABS(ZQIT(:)) > XQTMIN(4)) - ZWQ1(:,3) = SIGN( MIN( ABS(ZQIS(:)),ABS(ZWQ1(:,3)) ),ZQIS(:) ) - ZQSS(:) = ZQSS(:) + ZWQ1(:,3) - ZQIS(:) = ZQIS(:) - ZWQ1(:,3) - END WHERE - - if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'AGGS', & - Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'AGGS', & - Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_sv ) then - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'AGGS', & - Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'AGGS', & - Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if - - if ( lbudget_sv ) then - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'NIIS', & - Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'NIIS', & - Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if - - CALL ELEC_IAGGS_B() ! QIAGGS_boun - - if ( lbudget_sv ) then - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'NIIS', & - Unpack( zqis(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'NIIS', & - Unpack( zqss(:), mask = gmicro(:, :, :), field = 0. ) ) - end if - -! Save the NI charging rate for temporal series - XNI_IAGGS(:,:,:) = UNPACK(ZWQ1(:,7), MASK=GMICRO, FIELD=0.0) - XNI_IAGGS(:,:,:) = XNI_IAGGS(:,:,:) * PRHODREF(:,:,:) ! C/m3/s -! -!* 3.5.3.5 compute the autoconversion of r_i for r_s production: -! RIAUTS & QIAUTS -! - if ( lbudget_sv ) then - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'AUTS', & - Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'AUTS', & - Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if - - ALLOCATE( ZCRIAUTI(IMICRO )) - ZCRIAUTI(:) = MIN(XCRIAUTI,10**(0.06*(ZZT(:)-XTT)-3.5)) - ZZW(:) = 0.0 -! - WHERE ((ZRIT(:) > XRTMIN(4)) .AND. (ZRIS(:) > 0.0)) - ZZW(:) = MIN( ZRIS(:),XTIMAUTI * EXP( XTEXAUTI*(ZZT(:)-XTT) ) & - * MAX( ZRIT(:)-ZCRIAUTI(:),0.0 ) ) - ZRSS(:) = ZRSS(:) + ZZW(:) - ZRIS(:) = ZRIS(:) - ZZW(:) - ZWQ1(:,4) = XCOEF_RQ_I * ZQIT(:) * ZZW(:) / ZRIT(:) ! QIAUTS - END WHERE -! - WHERE (ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRIS(:) > ZRSMIN_ELEC(4) .AND. & - ZRSS(:) > ZRSMIN_ELEC(5) .AND. ABS(ZQIT(:)) > XQTMIN(4)) - ZWQ1(:,4) = SIGN( MIN( ABS(ZQIS(:)),ABS(ZWQ1(:,4)) ),ZQIS(:) ) - ZQSS(:) = ZQSS(:) + ZWQ1(:,4) - ZQIS(:) = ZQIS(:) - ZWQ1(:,4) - END WHERE -! - DEALLOCATE(ZCRIAUTI) - - if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'AUTS', & - Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'AUTS', & - Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_sv ) then - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'AUTS', & - Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'AUTS', & - Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if -! -!* 3.5.3.6 compute the deposition on r_g: RVDEPG & QVDEPG -! - if ( lbudget_sv ) then - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'DEPG', & - Unpack( zqpis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'DEPG', & - Unpack( zqnis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'DEPG', & - Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if - - ZZW(:) = 0.0 -! - WHERE ((ZRGT(:) > XRTMIN(6)) .AND. (ZRGS(:) > 0.0)) - ZZW(:) = (ZSSI(:) / (ZRHODREF(:) * ZAI(:))) * & - (X0DEPG * ZLBDAG(:)**XEX0DEPG + X1DEPG * ZCJ(:) * ZLBDAG(:)**XEX1DEPG) - ZZW(:) = MIN( ZRVS(:),ZZW(:) )*(0.5+SIGN(0.5,ZZW(:))) & - - MIN( ZRGS(:),ABS(ZZW(:)) )*(0.5-SIGN(0.5,ZZW(:))) - ZRGS(:) = ZRGS(:) + ZZW(:) - ZRVS(:) = ZRVS(:) - ZZW(:) - ZTHS(:) = ZTHS(:) + ZZW(:)*ZLSFACT(:) - ZWQ1(:,6) = XCOEF_RQ_G * ZQGT(:) * (-ZZW(:)) / ZRGT(:) ! sublimation - END WHERE -! - WHERE (ZRGT(:) > XRTMIN_ELEC(6) .AND. ZRGS(:) > ZRSMIN_ELEC(6) .AND. & - ZRVS(:) > ZRSMIN_ELEC(1) .AND. ABS(ZQGT(:)) > XQTMIN(6) .AND. & - ZZW(:) < 0. .AND. (-ZZW(:)) <= ZRGS(:)) - ZWQ1(:,6) = SIGN( MIN( ABS(ZQGS(:)),ABS(ZWQ1(:,6)) ),ZQGS(:) ) - ZQGS(:) = ZQGS(:) - ZWQ1(:,6) - ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ1(:,6)/XECHARGE ) - ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ1(:,6)/XECHARGE ) - END WHERE - - if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPG', Unpack( zzw(:) * zlsfact(:) & - * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPG', & - Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'DEPG', & - Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_sv ) then - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'DEPG', & - Unpack( zqpis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'DEPG', & - Unpack( zqnis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'DEPG', & - Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if - - END SUBROUTINE RAIN_ICE_ELEC_SLOW -! -!------------------------------------------------------------------------------- -! -! - SUBROUTINE RAIN_ICE_ELEC_WARM -! -!* 0. DECLARATIONS -! ------------ -! -IMPLICIT NONE -! -REAL :: ZCRIAUTC ! Critical cloud mixing ratio -! -!------------------------------------------------------------------------------- -! -!* 4.1 compute the autoconversion of r_c for r_r production: -! RCAUTR & QCAUTR -! - if ( lbudget_sv ) then - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'AUTO', & - Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'AUTO', & - Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if - - ZZW(:) = 0.0 - ZWQ1(:,1:3) = 0.0 -! - IF ( HSUBG_AUCV == 'CLFR' ) THEN - WHERE ((ZRCT(:) > 0.0) .AND. (ZRCS(:) > 0.0) .AND. (ZCF(:) > 0.0)) - ZZW(:) = XTIMAUTC * MAX( ZRCT(:)/(ZCF(:)) -XCRIAUTC/ZRHODREF(:),0.0) - ZZW(:) = MIN( ZRCS(:),(ZCF(:))*ZZW(:)) - ZRCS(:) = ZRCS(:) - ZZW(:) - ZRRS(:) = ZRRS(:) + ZZW(:) - ZWQ1(:,1) = XCOEF_RQ_C * ZQCT(:) * ZZW(:) / ZRCT(:) ! QCAUTR - END WHERE - ELSE IF (HSUBG_AUCV == 'SIGM') THEN - DO JL = 1, IMICRO - IF (ZRCS(JL) > 0.0) THEN - ZCRIAUTC = XCRIAUTC / ZRHODREF(JL) - IF (ZRCT(JL) > (ZCRIAUTC + ZSIGMA_RC(JL))) THEN - ZZW(JL) = MIN( ZRCS(JL) , XTIMAUTC* ( ZRCT(JL)-ZCRIAUTC ) ) - ELSEIF (ZRCT(JL) > (ZCRIAUTC - ZSIGMA_RC(JL)) .AND. & - ZRCT(JL) <= (ZCRIAUTC + ZSIGMA_RC(JL))) THEN - ZZW(JL) = MIN( ZRCS(JL) , XTIMAUTC*( ZRCT(JL)+ZSIGMA_RC(JL)-ZCRIAUTC )**2 & - /( 4. * ZSIGMA_RC(JL) ) ) - ENDIF - ZRCS(JL) = ZRCS(JL) - ZZW(JL) - ZRRS(JL) = ZRRS(JL) + ZZW(JL) - IF (ZRCT(JL) > 0.) THEN - ZWQ1(JL,1) = XCOEF_RQ_C * ZQCT(JL) * ZZW(JL) / ZRCT(JL) - END IF - ENDIF - END DO - ELSE - WHERE ((ZRCT(:) > XRTMIN(2)) .AND. (ZRCS(:) > 0.0)) - ZZW(:) = MIN( ZRCS(:),XTIMAUTC*MAX( ZRCT(:)-XCRIAUTC/ZRHODREF(:),0.0 ) ) - ZRCS(:) = ZRCS(:) - ZZW(:) - ZRRS(:) = ZRRS(:) + ZZW(:) - ZWQ1(:,1) = XCOEF_RQ_C * ZQCT(:) * ZZW(:) / ZRCT(:) ! QCAUTR - END WHERE - END IF -! - WHERE (ZRCT(:) > XRTMIN_ELEC(2) .AND. ZRCS(:) > ZRSMIN_ELEC(2) .AND. & - ZRRS(:) > ZRSMIN_ELEC(3) .AND. ABS(ZQCT(:)) > XQTMIN(2)) - ZWQ1(:,1) = SIGN( MIN( ABS(ZQCS(:)),ABS(ZWQ1(:,1)) ),ZQCS(:) ) - ZQCS(:) = ZQCS(:) - ZWQ1(:,1) - ZQRS(:) = ZQRS(:) + ZWQ1(:,1) - END WHERE - - if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'AUTO', & - Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'AUTO', & - Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_sv ) then - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'AUTO', & - Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'AUTO', & - Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if -! -!* 4.2 compute the accretion of r_c for r_r production: RCACCR & QCACCR -! - if ( lbudget_sv ) then - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'ACCR', & - Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'ACCR', & - Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if - - ZZW(:) = 0.0 - WHERE ((ZRCT(:) > XRTMIN(2)) .AND. (ZRRT(:) > XRTMIN(3)) .AND. (ZRCS(:) > 0.0)) - ZZW(:) = MIN( ZRCS(:),XFCACCR * ZRCT(:) & - * ZLBDAR(:)**XEXCACCR & - * ZRHOCOR(:)/ZCOR00 ) - ZRCS(:) = ZRCS(:) - ZZW(:) - ZRRS(:) = ZRRS(:) + ZZW(:) - ZWQ1(:,2) = XCOEF_RQ_C * ZQCT(:) * ZZW(:) / ZRCT(:) ! QCACCR - END WHERE -! - WHERE (ZRCT(:) > XRTMIN_ELEC(2) .AND. ZRRS(:) > ZRSMIN_ELEC(3) .AND. & - ZRCS(:) > ZRSMIN_ELEC(2) .AND. ABS(ZQCT(:)) > XQTMIN(2)) - ZWQ1(:,2) = SIGN( MIN( ABS(ZQCS(:)),ABS(ZWQ1(:,2)) ),ZQCS(:) ) - ZQCS(:) = ZQCS(:) - ZWQ1(:,2) - ZQRS(:) = ZQRS(:) + ZWQ1(:,2) - ENDWHERE - - if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'ACCR', & - Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'ACCR', & - Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_sv ) then - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'ACCR', & - Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'ACCR', & - Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if -! -! -!* 4.3 compute the evaporation of r_r: RREVAV & QREVAV -! - if ( lbudget_sv ) then - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'REVA', & - Unpack( zqpis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'REVA', & - Unpack( zqnis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'REVA', & - Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if - - ZZW(:) = 0.0 - WHERE ((ZRRT(:) > XRTMIN(3)) .AND. (ZRCT(:) <= XRTMIN(2))) - ZZW(:) = EXP( XALPW - XBETAW/ZZT(:) - XGAMW*ALOG(ZZT(:) ) ) ! es_w - ZUSW(:) = 1.0 - ZRVT(:) * (ZPRES(:) - ZZW(:)) / ((XMV / XMD) * ZZW(:)) - ! Undersaturation over water - ZZW(:) = (XLVTT + (XCPV - XCL) * (ZZT(:) - XTT) )**2 / & - (ZKA(:) * XRV * ZZT(:)**2) + & - (XRV * ZZT(:)) / (ZDV(:) * ZZW(:)) - ZZW(:) = MIN( ZRRS(:),( MAX( 0.0,ZUSW(:) )/(ZRHODREF(:)*ZZW(:)) ) * & - ( X0EVAR*ZLBDAR(:)**XEX0EVAR+X1EVAR*ZCJ(:)*ZLBDAR(:)**XEX1EVAR ) ) - ZRRS(:) = ZRRS(:) - ZZW(:) - ZRVS(:) = ZRVS(:) + ZZW(:) - ZTHS(:) = ZTHS(:) - ZZW(:)*ZLVFACT(:) - ZWQ1(:,3) = XCOEF_RQ_R * ZQRT(:) * ZZW(:) / ZRRT(:) ! QREVAV - END WHERE -! - WHERE (ZRRT(:) > XRTMIN_ELEC(3) .AND. ZRRS(:) > ZRSMIN_ELEC(3) .AND. & - ZRVS(:) > ZRSMIN_ELEC(1) .AND. ZRCT(:) <= 0.0 .AND. & - ABS(ZQRT(:)) > XQTMIN(3)) - ZWQ1(:,3) = SIGN( MIN( ABS(ZQRS(:)),ABS(ZWQ1(:,3)) ),ZQRS(:) ) - ZQRS(:) = ZQRS(:) - ZWQ1(:,3) - ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ1(:,3)/XECHARGE ) - ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ1(:,3)/XECHARGE ) - ENDWHERE -! - PEVAP3D(:,:,:)=UNPACK(ZZW(:),MASK=GMICRO(:,:,:),FIELD=PEVAP3D(:,:,:)) - - if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'REVA', & - Unpack( -zzw(:) * zlvfact(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'REVA', & - Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'REVA', & - Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_sv ) then - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'REVA', & - Unpack( zqpis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'REVA', & - Unpack( zqnis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'REVA', & - Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if - - END SUBROUTINE RAIN_ICE_ELEC_WARM -! -!------------------------------------------------------------------------------- -! - SUBROUTINE RAIN_ICE_ELEC_FAST_RS -! -!* 0. DECLARATIONS -! ------------ -! -IMPLICIT NONE -! -!------------------------------------------------------------------------------- -! -!* 5.1 cloud droplet riming of the aggregates -! - ZZW1(:,:) = 0.0 - ZWQ1(:,1:7) = 0.0 -! - ALLOCATE( GRIM(IMICRO) ) - GRIM(:) = (ZRCT(:) > XRTMIN(2)) .AND. (ZRST(:) > XRTMIN(5)) .AND. & - (ZRCS(:) > 0.0) .AND. (ZZT(:) < XTT) - IGRIM = COUNT( GRIM(:) ) -! - IF (IGRIM > 0) THEN - if ( lbudget_sv ) then - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'RIM', & - Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'RIM', & - Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'RIM', & - Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if -! -! 5.1.0 allocations -! - ALLOCATE( ZVEC1(IGRIM) ) - ALLOCATE( ZVEC2(IGRIM) ) - ALLOCATE( IVEC1(IGRIM) ) - ALLOCATE( IVEC2(IGRIM) ) -! -!* 5.1.1 select the ZLBDAS -! - ZVEC1(:) = PACK( ZLBDAS(:),MASK=GRIM(:) ) -! -!* 5.1.2 find the next lower indice for the ZLBDAS in the geometrical -!* set of Lbda_s used to tabulate some moments of the incomplete -! gamma function -! - ZVEC2(1:IGRIM) = MAX( 1.00001, MIN( REAL(NGAMINC)-0.00001, & - XRIMINTP1 * LOG( ZVEC1(1:IGRIM) ) + XRIMINTP2 ) ) - IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) ) - ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - REAL( IVEC2(1:IGRIM) ) -! -!* 5.1.3 perform the linear interpolation of the normalized -!* "2+XDS"-moment of the incomplete gamma function -! - ZVEC1(1:IGRIM) = XGAMINC_RIM1( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) & - - XGAMINC_RIM1( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0) - ZZW(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GRIM,FIELD=0.0 ) -! -!* 5.1.4 riming of the small sized aggregates -! - WHERE (GRIM(:) .AND. ZRCS(:) > 0.0) - ZZW1(:,1) = MIN( ZRCS(:), & - XCRIMSS * ZZW(:) * ZRCT(:) * & ! RCRIMSS - ZLBDAS(:)**XEXCRIMSS * ZRHOCOR(:)/ZCOR00 ) - ZRCS(:) = ZRCS(:) - ZZW1(:,1) - ZRSS(:) = ZRSS(:) + ZZW1(:,1) - ZTHS(:) = ZTHS(:) + ZZW1(:,1) * (ZLSFACT(:) - ZLVFACT(:)) ! f(L_f*(RCRIMSS)) - ZWQ1(:,1) = XCOEF_RQ_C * ZQCT(:) * ZZW1(:,1) / ZRCT(:) ! QCRIMSS - END WHERE -! - WHERE (ZZT(:) < XTT .AND. & - ZRCT(:) > XRTMIN_ELEC(2) .AND. ZRSS(:) > ZRSMIN_ELEC(5) .AND. & - ABS(ZQCT(:)) > XQTMIN(2) .AND. ZRCS(:) > ZRSMIN_ELEC(2)) - ZWQ1(:,1) = SIGN( MIN( ABS(ZQCS(:)),ABS(ZWQ1(:,1)) ),ZQCS(:) ) - ZQCS(:) = ZQCS(:) - ZWQ1(:,1) - ZQSS(:) = ZQSS(:) + ZWQ1(:,1) - ENDWHERE -! -!* 5.1.5 perform the linear interpolation of the normalized -!* "XBS"-moment of the incomplete gamma function -! - ZVEC1(1:IGRIM) = XGAMINC_RIM2( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) & - - XGAMINC_RIM2( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0) - ZZW(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GRIM,FIELD=0.0 ) -! -! -!* 5.1.6 perform the linear interpolation of the normalized -!* "XFS"-moment of the incomplete gamma function -! - ZVEC1(1:IGRIM) = XGAMINC_RIM3( IVEC2(1:IGRIM)+1 ) * ZVEC2(1:IGRIM) & - - XGAMINC_RIM3( IVEC2(1:IGRIM) ) * (ZVEC2(1:IGRIM) - 1.0) - ZWQ1(:,3) = UNPACK( VECTOR=ZVEC1(:), MASK=GRIM, FIELD=0.0 ) -! -!* 5.1.7 riming-conversion of the large sized aggregates into graupeln: -!* RSRIMCG & QSRIMCG and RCRIMSG & QCRIMSG -! - WHERE (GRIM(:) .AND. ZRSS(:) > 0.0 .AND. ZRCS(:) > 0.0 .AND. ZZW(:) < 1.) - ZZW1(:,2) = MIN( ZRCS(:), & - XCRIMSG * ZRCT(:) & ! RCRIMSG - * ZLBDAS(:)**XEXCRIMSG & - * ZRHOCOR(:)/ZCOR00 - ZZW1(:,1) ) - ZZW1(:,3) = MIN( ZRSS(:), & - XSRIMCG * ZLBDAS(:)**XEXSRIMCG & ! RSRIMCG - * (1.0 - ZZW(:) )/(PTSTEP*ZRHODREF(:)) ) - ZRCS(:) = ZRCS(:) - ZZW1(:,2) - ZRSS(:) = ZRSS(:) - ZZW1(:,3) - ZRGS(:) = ZRGS(:) + ZZW1(:,2) + ZZW1(:,3) - ZTHS(:) = ZTHS(:) + ZZW1(:,2) * (ZLSFACT(:) - ZLVFACT(:)) ! f(L_f*(RCRIMSG)) - ZWQ1(:,2) = XCOEF_RQ_C * ZQCT(:) * ZZW1(:,2) / ZRCT(:) ! QCRIMSG - ZWQ1(:,3) = XQSRIMCG * ZEST(:) * & ! QSRIMCG - ZLBDAS(:)**XEXQSRIMCG * (1. - ZWQ1(:,3)) / & - (PTSTEP * ZRHODREF(:)) - END WHERE -! - WHERE (ZRCT(:) > XRTMIN_ELEC(2) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. & - ZRSS(:) > ZRSMIN_ELEC(5) .AND. ZRCS(:) > ZRSMIN_ELEC(2) .AND. & - ZZT(:) < XTT .AND. ABS(ZQCT(:)) > XQTMIN(2)) - ZWQ1(:,2) = SIGN( MIN( ABS(ZQCS(:)),ABS(ZWQ1(:,2)) ),ZQCS(:) ) - ZQGS(:) = ZQGS(:) + ZWQ1(:,2) - ZQCS(:) = ZQCS(:) - ZWQ1(:,2) - ENDWHERE -! - WHERE (ZRCT(:) > XRTMIN_ELEC(2) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. & - ZRSS(:) > ZRSMIN_ELEC(5) .AND. ZRCS(:) > ZRSMIN_ELEC(2) .AND. & - ZZT(:) < XTT .AND. ABS(ZQCT(:)) > XQTMIN(2) .AND. & - ABS(ZEST) > XESMIN) - ZWQ1(:,3) = SIGN( MIN( ABS(ZQSS(:)),ABS(ZWQ1(:,3)) ),ZQSS(:) ) - ZQGS(:) = ZQGS(:) + ZWQ1(:,3) - ZQSS(:) = ZQSS(:) - ZWQ1(:,3) - ENDWHERE -! - DEALLOCATE(IVEC2) - DEALLOCATE(IVEC1) - DEALLOCATE(ZVEC2) - DEALLOCATE(ZVEC1) - - if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'RIM', Unpack( ( zzw1(:,1) + zzw1(:,2) ) & - * ( zlsfact(:) - zlvfact(:) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'RIM', & - Unpack( ( -zzw1(:,1) - zzw1(:,2) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'RIM', & - Unpack( ( zzw1(:,1) - zzw1(:,3) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'RIM', & - Unpack( ( zzw1(:,2) + zzw1(:,3) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_sv ) then - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'RIM', & - Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'RIM', & - Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'RIM', & - Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if - END IF -! - DEALLOCATE(GRIM) -! -! -!* 5.2 rain accretion onto the aggregates -! - ZZW1(:,2:3) = 0.0 - ZWQ4(:) = 0.0 -! - ALLOCATE(GACC(IMICRO)) - GACC(:) = ZRRT(:)>XRTMIN(3) .AND. ZRST(:)>XRTMIN(5) .AND. & - ZRRS(:) > 0.0 .AND. ZZT(:) < XTT - IGACC = COUNT( GACC(:) ) -! - IF( IGACC>0 ) THEN - if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'ACC', & - Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'ACC', & - Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'ACC', & - Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'ACC', & - Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_sv ) then - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'ACC', & - Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'ACC', & - Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'ACC', & - Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if -! -! 5.2.0 allocations -! - ALLOCATE(ZVEC1(IGACC)) - ALLOCATE(ZVEC2(IGACC)) - ALLOCATE(ZVEC3(IGACC)) - ALLOCATE(IVEC1(IGACC)) - ALLOCATE(IVEC2(IGACC)) -! - ALLOCATE( ZVECQ4(IGACC) ) - ALLOCATE( ZVECQ5(IGACC) ) - ALLOCATE( ZVECQ6(IGACC) ) -! -! -! 5.2.1 select the (ZLBDAS,ZLBDAR) couplet -! - ZVEC1(:) = PACK( ZLBDAS(:),MASK=GACC(:) ) - ZVEC2(:) = PACK( ZLBDAR(:),MASK=GACC(:) ) -! -! 5.2.2 find the next lower indice for the ZLBDAS and for the ZLBDAR -! in the geometrical set of (Lbda_s,Lbda_r) couplet use to -! tabulate the RACCSS-kernel -! - ZVEC1(1:IGACC) = MAX( 1.00001, MIN( REAL(NACCLBDAS)-0.00001, & - XACCINTP1S * LOG( ZVEC1(1:IGACC) ) + XACCINTP2S ) ) - IVEC1(1:IGACC) = INT( ZVEC1(1:IGACC) ) - ZVEC1(1:IGACC) = ZVEC1(1:IGACC) - REAL( IVEC1(1:IGACC) ) -! - ZVEC2(1:IGACC) = MAX( 1.00001, MIN( REAL(NACCLBDAR)-0.00001, & - XACCINTP1R * LOG( ZVEC2(1:IGACC) ) + XACCINTP2R ) ) - IVEC2(1:IGACC) = INT( ZVEC2(1:IGACC) ) - ZVEC2(1:IGACC) = ZVEC2(1:IGACC) - REAL( IVEC2(1:IGACC) ) -! -! 5.2.3 perform the bilinear interpolation of the normalized -! RACCSS-kernel -! - ZVEC3(:) = BI_LIN_INTP_V(XKER_RACCSS, IVEC1, IVEC2, ZVEC1, ZVEC2, IGACC) - ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GACC,FIELD=0.0 ) -! - ZVECQ5(:) = BI_LIN_INTP_V(XKER_Q_RACCSS, IVEC1, IVEC2, ZVEC1, ZVEC2, IGACC) - ZWQ1(:,5) = UNPACK( VECTOR=ZVECQ5(:), MASK=GACC, FIELD=0.0 ) -! -! 5.2.4 raindrop accretion on the small sized aggregates: -! RRACCSS & QRACCSS -! - WHERE ( GACC(:) ) - ZZW1(:,2) = & !! coef of RRACCS - XFRACCSS*( ZLBDAS(:)**XCXS )*ZRHOCOR(:)/(ZCOR00* ZRHODREF(:)) & - *( XLBRACCS1/((ZLBDAS(:)**2) ) + & - XLBRACCS2/( ZLBDAS(:) * ZLBDAR(:) ) + & - XLBRACCS3/( (ZLBDAR(:)**2)) )/ZLBDAR(:)**4 - ZZW1(:,4) = MIN( ZRRS(:),ZZW1(:,2)*ZZW(:) ) ! RRACCSS - ZRRS(:) = ZRRS(:) - ZZW1(:,4) - ZRSS(:) = ZRSS(:) + ZZW1(:,4) - ZTHS(:) = ZTHS(:) + ZZW1(:,4)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RRACCSS)) - ZWQ4(:) = XFQRACCS * ZERT(:) * ZRHOCOR(:)/(ZCOR00* ZRHODREF(:)) * & - ZLBDAR(:)**XCXR * ZLBDAS(:)**XCXS * & - (XLBQRACCS1 * ZLBDAR(:)**(-2.0 - XFR) + & - XLBQRACCS2 * ZLBDAR(:)**(-1.0 - XFR) * ZLBDAS(:)**(-1.0) + & - XLBQRACCS3 * ZLBDAR(:)**(-XFR) * ZLBDAS(:)**(-2.0)) - ZWQ1(:,5) = ZWQ1(:,5) * ZWQ4(:) ! QRACCSS - END WHERE -! - WHERE (ZRRT(:) > XRTMIN_ELEC(3) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. & - ZRRS(:) > ZRSMIN_ELEC(3) .AND. ZZT(:) < XTT .AND. & - ABS(ZQRS(:)) > XQTMIN(3) .AND. ABS(ZERT) > XERMIN) - ZWQ1(:,5) = SIGN( MIN( ABS(ZQRS(:)),ABS(ZWQ1(:,5)) ),ZQRS(:) ) - ZQRS(:) = ZQRS(:) - ZWQ1(:,5) - ZQSS(:) = ZQSS(:) + ZWQ1(:,5) - ENDWHERE -! -! 5.2.5 perform the bilinear interpolation of the normalized -! RACCS-kernel -! - ZVEC3(:) = BI_LIN_INTP_V(XKER_RACCS, IVEC1, IVEC2, ZVEC1, ZVEC2, IGACC) - ZZW1(:,2) = ZZW1(:,2)*UNPACK( VECTOR=ZVEC3(:),MASK=GACC(:),FIELD=0.0 ) - !! RRACCS! -! - ZVECQ4(:) = BI_LIN_INTP_V(XKER_Q_RACCS, IVEC1, IVEC2, ZVEC1, ZVEC2, IGACC) - ZWQ1(:,4) = UNPACK( VECTOR=ZVECQ4(:), MASK=GACC, FIELD=0.0 ) -! -! 5.2.6 perform the bilinear interpolation of the normalized -! SACCRG-kernel -! - ZVEC3(:) = BI_LIN_INTP_V(XKER_SACCRG, IVEC2, IVEC1, ZVEC2, ZVEC1, IGACC) - ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GACC,FIELD=0.0 ) -! - ZVECQ6(:) = BI_LIN_INTP_V(XKER_Q_SACCRG, IVEC2,IVEC1, ZVEC2, ZVEC1, IGACC) - ZWQ1(:,6) = UNPACK( VECTOR=ZVECQ6(:), MASK=GACC, FIELD=0.0 ) - ZWQ1(:,4) = ZWQ1(:,4) * ZWQ4(:) ! QRACCS -! -! 5.2.7 raindrop accretion-conversion of the large sized aggregates -! into graupeln: RRACCSG & QRACCSG and RSACCRG & QSACCRG -! - WHERE ( GACC(:) .AND. (ZRSS(:)>0.0) ) - ZZW1(:,2) = MIN( ZRRS(:),ZZW1(:,2)-ZZW1(:,4) ) ! RRACCSG - ZZW1(:,3) = MIN( ZRSS(:),XFSACCRG*ZZW(:)* & ! RSACCRG - ( ZLBDAS(:)**(XCXS-XBS) )*ZRHOCOR(:)/(ZCOR00* ZRHODREF(:)) & - *( XLBSACCR1/((ZLBDAR(:)**2) ) + & - XLBSACCR2/( ZLBDAR(:) * ZLBDAS(:) ) + & - XLBSACCR3/( (ZLBDAS(:)**2)) )/ZLBDAR(:) ) - ZRRS(:) = ZRRS(:) - ZZW1(:,2) - ZRSS(:) = ZRSS(:) - ZZW1(:,3) - ZRGS(:) = ZRGS(:) + ZZW1(:,2)+ZZW1(:,3) - ZTHS(:) = ZTHS(:) + ZZW1(:,2)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RRACCSG)) - ZWQ1(:,4) = ZWQ1(:,4) - ZWQ1(:,5) ! QRACCSG - ZWQ1(:,6) = ZWQ1(:,6) * XFQRACCS * ZEST(:) * & - ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) * & - ZLBDAR(:)**XCXR * ZLBDAS(:)**XCXS * & - (XLBQSACCRG1 * ZLBDAS(:)**(-2.0 - XFS) + & - XLBQSACCRG2 * ZLBDAS(:)**(-1.0 - XFS) * ZLBDAR(:)**(-1.0) + & - XLBQSACCRG3 * ZLBDAS(:)**(-XFS) * ZLBDAR(:)**(-2.0)) ! QSACCR - END WHERE -! - WHERE (ZRRT(:) > XRTMIN_ELEC(3) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. & - ZRSS(:) > ZRSMIN_ELEC(5) .AND. ZRRS(:) > ZRSMIN_ELEC(3) .AND. & - ZZT(:) < XTT .AND. ABS(ZQGS(:)) > XQTMIN(6)) - ZWQ1(:,4) = SIGN( MIN( ABS(ZQRS(:)),ABS(ZWQ1(:,4)) ),ZQRS(:) ) - ZQRS(:) = ZQRS(:) - ZWQ1(:,4) - ZQGS(:) = ZQGS(:) + ZWQ1(:,4) - ENDWHERE -! - WHERE (ZRRT(:) > XRTMIN_ELEC(3) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. & - ZRSS(:) > ZRSMIN_ELEC(5) .AND. ZRRS(:) > ZRSMIN_ELEC(3) .AND. & - ZZT(:) < XTT .AND. ABS(ZQGS(:)) > XQTMIN(6) .AND. & - ABS(ZEST) > XESMIN) - ZWQ1(:,6) = SIGN( MIN( ABS(ZQSS(:)),ABS(ZWQ1(:,6)) ),ZQSS(:) ) - ZQSS(:) = ZQSS(:) - ZWQ1(:,6) - ZQGS(:) = ZQGS(:) + ZWQ1(:,6) - ENDWHERE -! - DEALLOCATE(IVEC2) - DEALLOCATE(IVEC1) - DEALLOCATE(ZVEC3) - DEALLOCATE(ZVEC2) - DEALLOCATE(ZVEC1) - DEALLOCATE( ZVECQ4 ) - DEALLOCATE( ZVECQ5 ) - DEALLOCATE( ZVECQ6 ) - - if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'ACC', & - Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'ACC', & - Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'ACC', & - Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'ACC', & - Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_sv ) then - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'ACC', & - Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'ACC', & - Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'ACC', & - Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if - END IF - - DEALLOCATE(GACC) -! -!* 5.3 Conversion-Melting of the aggregates: RSMLT & QSMLT -! - if ( lbudget_sv ) then - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'CMEL', & - Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'CMEL', & - Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if - - ZZW(:) = 0.0 - WHERE ((ZRST(:) > XRTMIN(5)) .AND. (ZRSS(:) > 0.0) .AND. (ZZT(:) > XTT)) - ZZW(:) = ZRVT(:) * ZPRES(:) / ((XMV / XMD) + ZRVT(:)) ! Vapor pressure - ZZW(:) = ZKA(:) * (XTT - ZZT(:)) + & - (ZDV(:) * (XLVTT + (XCPV - XCL) * (ZZT(:) - XTT)) * & - (XESTT - ZZW(:)) / (XRV * ZZT(:))) -! -! compute RSMLT -! - ZZW(:) = MIN( ZRSS(:), XFSCVMG * MAX( 0.0,( -ZZW(:) * & - (X0DEPS * ZLBDAS(:)**XEX0DEPS + & - X1DEPS * ZCJ(:) * ZLBDAS(:)**XEX1DEPS ) - & - (ZZW1(:,1) + ZZW1(:,4)) * & - (ZRHODREF(:) * XCL * (XTT - ZZT(:)))) / & - (ZRHODREF(:) * XLMTT))) -! -! note that RSCVMG = RSMLT*XFSCVMG but no heat is exchanged (at the rate RSMLT) -! because the graupeln produced by this process are still icy!!! -! - ZRSS(:) = ZRSS(:) - ZZW(:) - ZRGS(:) = ZRGS(:) + ZZW(:) - ZWQ1(:,7) = XCOEF_RQ_S * ZQST(:) * ZZW(:) / ZRST(:) ! QSMLT - END WHERE -! - WHERE (ZRST(:) > XRTMIN_ELEC(5) .AND. ZRSS(:) > ZRSMIN_ELEC(5) .AND. & - ZRGT(:) > XRTMIN_ELEC(6) .AND. ABS(ZQST(:)) > XQTMIN(5) .AND. & - ZZT(:) > XTT .AND. ZRHODREF(:)*XLMTT > 0.) - ZWQ1(:,7) = SIGN( MIN( ABS(ZQSS(:)),ABS(ZWQ1(:,7)) ),ZQSS(:) ) - ZQGS(:) = ZQGS(:) + ZWQ1(:,7) - ZQSS(:) = ZQSS(:) - ZWQ1(:,7) - ENDWHERE - - if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'CMEL', & - Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'CMEL', & - Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_sv ) then - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'CMEL', & - Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'CMEL', & - Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if - - END SUBROUTINE RAIN_ICE_ELEC_FAST_RS -! -!------------------------------------------------------------------------------- -! -! - SUBROUTINE RAIN_ICE_ELEC_FAST_RG -! -!* 0. DECLARATIONS -! ------------ -! -IMPLICIT NONE -! -!------------------------------------------------------------------------------- -! -!* 6.1 rain contact freezing: RICFRRG & QICFRRG and RRCFRIG & QRCFRIG -! - if ( lbudget_sv ) then - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'CFRZ', & - Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'CFRZ', & - Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'CFRZ', & - Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if - - ZZW1(:,3:4) = 0.0 - ZWQ1(:,3:4) = 0.0 - WHERE ((ZRIT(:) > XRTMIN(4)) .AND. (ZRRT(:) > XRTMIN(3)) .AND. & - (ZRIS(:) > 0.0) .AND. (ZRRS(:) > 0.0)) - ZZW1(:,3) = MIN( ZRIS(:),XICFRR * ZRIT(:) & ! RICFRRG - * ZLBDAR(:)**XEXICFRR & - * ZRHOCOR(:) / ZCOR00 ) - ZZW1(:,4) = MIN( ZRRS(:),XRCFRI * ZCIT(:) & ! RRCFRIG - * ZLBDAR(:)**XEXRCFRI & - * ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) ) - ZRIS(:) = ZRIS(:) - ZZW1(:,3) - ZRRS(:) = ZRRS(:) - ZZW1(:,4) - ZRGS(:) = ZRGS(:) + ZZW1(:,3) + ZZW1(:,4) - ZTHS(:) = ZTHS(:) + ZZW1(:,4) * (ZLSFACT(:) - ZLVFACT(:)) ! f(L_f*RRCFRIG) - ZWQ1(:,4) = XQRCFRIG * ZLBDAR(:)**XEXQRCFRIG * ZCIT(:) * & - ZERT(:) * ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) ! QRCFRIG - ZWQ1(:,3) = XCOEF_RQ_I * ZQIT(:) * ZZW1(:,3) / ZRIT(:) ! QICFRRG - END WHERE -! - WHERE (ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRRT(:) > XRTMIN_ELEC(3) .AND. & - ZRIS(:) > ZRSMIN_ELEC(4) .AND. ZRRS(:) > ZRSMIN_ELEC(3) .AND. & - ABS(ZERT) > XERMIN .AND. ABS(ZQRT(:)) > XQTMIN(3)) - ZWQ1(:,4) = SIGN( MIN( ABS(ZQRS(:)),ABS(ZWQ1(:,4)) ),ZQRS(:) ) - ZQGS(:) = ZQGS(:) + ZWQ1(:,4) - ZQRS(:) = ZQRS(:) - ZWQ1(:,4) - ENDWHERE -! - WHERE (ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRRT(:) > XRTMIN_ELEC(3) .AND. & - ZRIS(:) > ZRSMIN_ELEC(4) .AND. ZRRS(:) > ZRSMIN_ELEC(3) .AND. & - ABS(ZQIT(:)) > XQTMIN(4)) - ZWQ1(:,3) = SIGN( MIN( ABS(ZQIS(:)),ABS(ZWQ1(:,3)) ),ZQIS(:) ) - ZQGS(:) = ZQGS(:) + ZWQ1(:,3) - ZQIS(:) = ZQIS(:) - ZWQ1(:,3) - ENDWHERE - - if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'CFRZ', Unpack( zzw1(:,4) * ( zlsfact(:) - zlvfact(:) ) & - * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'CFRZ', & - Unpack( -zzw1(:, 4) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'CFRZ', & - Unpack( -zzw1(:, 3) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'CFRZ', & - Unpack( ( zzw1(:, 3) + zzw1(:, 4) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_sv ) then - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'CFRZ', & - Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'CFRZ', & - Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'CFRZ', & - Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if -! -!* 6.2 compute the Dry growth case -! - if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'WETG', & - Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'WETG', & - Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'WETG', & - Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'WETG', & - Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'WETG', & - Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'WETG', & - Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'WETG', & - Unpack( zrhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_sv ) then - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'WETG', & - Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'WETG', & - Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'WETG', & - Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'WETG', & - Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'WETG', & - Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( krr == 7 ) & - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'WETG', & - Unpack( zqhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if - - ZZW1(:,:) = 0.0 - ZWQ1(:,1:10) = 0.0 - ZWQ3(:) = 0.0 - ZWQ4(:) = 0.0 -! -!* 6.2.1 compute RCDRYG & QCDRYG -! - WHERE ((ZRGT(:) > XRTMIN(6)) .AND. ((ZRCT(:) > XRTMIN(2) .AND. ZRCS(:) > 0.0))) - ZZW(:) = ZLBDAG(:)**(XCXG-XDG-2.0) * ZRHOCOR(:) / ZCOR00 - ZZW1(:,1) = MIN( ZRCS(:),XFCDRYG * ZRCT(:) * ZZW(:) ) ! RCDRYG - ZWQ1(:,1) = XCOEF_RQ_C * ZQCT(:) * ZZW1(:,1) / ZRCT(:) ! QCDRYG - END WHERE -! - WHERE (ZRCT(:) > XRTMIN_ELEC(2) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. & - ABS(ZQCT(:)) > XQTMIN(2) .AND. ZRCS(:) > ZRSMIN_ELEC(2)) - ZWQ1(:,1) = SIGN( MIN( ABS(ZQCS(:)),ABS(ZWQ1(:,1)) ),ZQCS(:) ) - ELSEWHERE - ZWQ1(:,1) = 0. - ENDWHERE -! -!* 6.2.2 compute RIDRYG & QIDRYG -! - WHERE ((ZRGT(:) > XRTMIN(6)) .AND. ((ZRIT(:) > XRTMIN(4) .AND. ZRIS(:) > 0.0)) ) - ZZW(:) = ZLBDAG(:)**(XCXG-XDG-2.0) * ZRHOCOR(:)/ZCOR00 - ZZW1(:,2) = MIN( ZRIS(:),XFIDRYG * EXP( XCOLEXIG*(ZZT(:)-XTT) ) & - * ZRIT(:) * ZZW(:) ) ! RIDRYG - ZWQ1(:,2) = XCOEF_RQ_I * ZQIT(:) * ZZW1(:,2) / ZRIT(:) ! QIDRYG_coal - END WHERE -! - WHERE (GELEC(:,2)) - ZWQ1(:,2) = SIGN( MIN( ABS(ZQIS(:)),ABS(ZWQ1(:,2)) ),ZQIS(:) ) - ELSEWHERE - ZWQ1(:,2) = 0. - ENDWHERE -! - CALL ELEC_IDRYG_B() ! QIDRYG_boun -! -! Save the NI charging rate for temporal series - XNI_IDRYG(:,:,:) = UNPACK(ZWQ1(:,3), MASK=GMICRO, FIELD=0.0) - XNI_IDRYG(:,:,:) = XNI_IDRYG(:,:,:) * PRHODREF(:,:,:) ! C/m3/s -! -!* 6.2.3 accretion of aggregates on the graupeln -! - ALLOCATE(GDRY(IMICRO)) - GDRY(:) = (ZRST(:)>XRTMIN(5)) .AND. (ZRGT(:)>XRTMIN(6)) .AND. (ZRSS(:)>0.0) - IGDRY = COUNT( GDRY(:) ) -! - IF( IGDRY>0 ) THEN -! -! 6.2.3.1 allocations -! - ALLOCATE(ZVEC1(IGDRY)) - ALLOCATE(ZVEC2(IGDRY)) - ALLOCATE(ZVEC3(IGDRY)) - ALLOCATE(IVEC1(IGDRY)) - ALLOCATE(IVEC2(IGDRY)) -! - ALLOCATE( ZVECQ4(IGDRY) ) - ALLOCATE( ZVECQ5(IGDRY) ) - ALLOCATE( ZVECQ6(IGDRY) ) -! - IF (CNI_CHARGING == 'TAKAH' .OR. CNI_CHARGING == 'SAUN1' .OR. & - CNI_CHARGING == 'SAUN2' .OR. CNI_CHARGING == 'SAP98' .OR. & - CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2' .OR. & - CNI_CHARGING == 'TEEWC' .OR. CNI_CHARGING == 'TERAR' .OR. & - CNI_CHARGING == 'GARDI') & -! - ALLOCATE( ZAUX(IGDRY) ) -! -! 6.2.3.2 select the (ZLBDAG,ZLBDAS) couplet -! - ZVEC1(:) = PACK( ZLBDAG(:),MASK=GDRY(:) ) - ZVEC2(:) = PACK( ZLBDAS(:),MASK=GDRY(:) ) -! -! 6.2.3.3 find the next lower indice for the ZLBDAG and for the ZLBDAS -! in the geometrical set of (Lbda_g,Lbda_s) couplet use to -! tabulate the SDRYG-kernel -! - ZVEC1(1:IGDRY) = MAX( 1.00001, MIN( REAL(NDRYLBDAG)-0.00001, & - XDRYINTP1G * LOG( ZVEC1(1:IGDRY) ) + XDRYINTP2G ) ) - IVEC1(1:IGDRY) = INT( ZVEC1(1:IGDRY) ) - ZVEC1(1:IGDRY) = ZVEC1(1:IGDRY) - REAL( IVEC1(1:IGDRY) ) -! - ZVEC2(1:IGDRY) = MAX( 1.00001, MIN( REAL(NDRYLBDAS)-0.00001, & - XDRYINTP1S * LOG( ZVEC2(1:IGDRY) ) + XDRYINTP2S ) ) - IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) ) - ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - REAL( IVEC2(1:IGDRY) ) -! -! 6.2.3.4 perform the bilinear interpolation of the normalized -! SDRYG-kernel -! -! normalized SDRYG-kernel - ZVEC3(:) = BI_LIN_INTP_V(XKER_SDRYG, IVEC1, IVEC2, ZVEC1, ZVEC2, IGDRY) - ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GDRY,FIELD=0.0 ) -! -! normalized Q-SDRYG-kernel - ZVECQ4(:) = BI_LIN_INTP_V(XKER_Q_SDRYG, IVEC1, IVEC2, ZVEC1, ZVEC2, IGDRY) - ZWQ1(:,4) = UNPACK( VECTOR=ZVECQ4(:), MASK=GDRY, FIELD=0.0 ) -! -! normalized Q-???-kernel - IF (CNI_CHARGING == 'TAKAH' .OR. CNI_CHARGING == 'SAUN1' .OR. & - CNI_CHARGING == 'SAUN2' .OR. CNI_CHARGING == 'SAP98' .OR. & - CNI_CHARGING == 'GARDI' .OR. & - CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2' .OR. & - CNI_CHARGING == 'TEEWC' .OR. CNI_CHARGING == 'TERAR') THEN - ZAUX(:) = BI_LIN_INTP_V(XKER_Q_LIMSG, IVEC1, IVEC2, ZVEC1, ZVEC2, IGDRY) - ZAUX1(:) = UNPACK( VECTOR=ZAUX(:), MASK=GDRY, FIELD=0.0 ) - END IF -! -! normalized Q-SDRYG-bouncing kernel - IF (CNI_CHARGING == 'TAKAH' .OR. CNI_CHARGING == 'HELFA' .OR. & - CNI_CHARGING == 'GARDI') THEN - ZVECQ5(:) = BI_LIN_INTP_V(XKER_Q_SDRYGB,IVEC1,IVEC2,ZVEC1,ZVEC2,IGDRY) - ZWQ1(:,10) = UNPACK( VECTOR=ZVECQ5(:), MASK=GDRY, FIELD=0.0 ) - ELSE - ZVECQ5(:) = BI_LIN_INTP_V(XKER_Q_SDRYGB1,IVEC1,IVEC2,ZVEC1,ZVEC2,IGDRY) - ZWQ3(:) = UNPACK( VECTOR=ZVECQ5(:), MASK=GDRY, FIELD=0.0 ) ! Dvqsgmn if charge>0 - ZVECQ6(:) = BI_LIN_INTP_V(XKER_Q_SDRYGB2,IVEC1,IVEC2,ZVEC1,ZVEC2,IGDRY) - ZWQ4(:) = UNPACK( VECTOR=ZVECQ6(:), MASK=GDRY, FIELD=0.0 ) ! Dvqsgmn if charge<0 - ENDIF -! -! 6.2.3.5 compute RSDRYG and QSDRYG = QSDRYG_coal + QSDRYG_boun -! - WHERE( GDRY(:) ) - ZZW1(:,3) = MIN( ZRSS(:),XFSDRYG*ZZW(:) & ! RSDRYG - * EXP( XCOLEXSG*(ZZT(:)-XTT) ) & - *( ZLBDAS(:)**(XCXS-XBS) )*( ZLBDAG(:)**XCXG ) & - * ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) & - *( XLBSDRYG1/( ZLBDAG(:)**2 ) + & - XLBSDRYG2/( ZLBDAG(:) * ZLBDAS(:) ) + & - XLBSDRYG3/( ZLBDAS(:)**2) ) ) - ZWQ1(:,4) = ZWQ1(:,4) * XFQSDRYG * & - XCOLSG * EXP(XCOLEXSG * (ZZT(:) - XTT)) * & - ZEST(:) * ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) * & - ZLBDAG(:)**XCXG * ZLBDAS(:)**XCXS * & - (XLBQSDRYG1 * ZLBDAS(:)**(-2.0-XFS) + & - XLBQSDRYG2 * ZLBDAS(:)**(-1.0-XFS) * ZLBDAG(:)**(-1.0) + & - XLBQSDRYG3 * ZLBDAS(:)**(-XFS) * ZLBDAG(:)**(-2.0)) ! QSDRYG_coal - END WHERE -! - WHERE (ZRSS(:) > ZRSMIN_ELEC(5) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. & - ZRGS(:) > ZRSMIN_ELEC(6) .AND. ABS(ZQST(:)) > XQTMIN(5) .AND. & - ABS(ZEST) > XESMIN) - ZWQ1(:,4) = SIGN( MIN( ABS(ZQSS(:)),ABS(ZWQ1(:,4)) ),ZQSS(:) ) - ELSEWHERE - ZWQ1(:,4) = 0. - END WHERE -! -! QSDRYG_boun - CALL ELEC_SDRYG_B() -! -! save the NI charging rate for temporal series - XNI_SDRYG(:,:,:) = UNPACK(ZWQ1(:,5), MASK=GMICRO, FIELD=0.0) - XNI_SDRYG(:,:,:) = XNI_SDRYG(:,:,:) * PRHODREF(:,:,:) ! C/m3/ -! - DEALLOCATE(IVEC2) - DEALLOCATE(IVEC1) - DEALLOCATE(ZVEC3) - DEALLOCATE(ZVEC2) - DEALLOCATE(ZVEC1) -! - DEALLOCATE( ZVECQ4 ) - DEALLOCATE( ZVECQ5 ) - DEALLOCATE( ZVECQ6 ) - IF (ALLOCATED(ZAUX)) DEALLOCATE( ZAUX ) - END IF -! -! -!* 6.2.4 accretion of raindrops on the graupeln -! - GDRY(:) = (ZRRT(:)>XRTMIN(3)) .AND. (ZRGT(:)>XRTMIN(6)) .AND. (ZRRS(:)>0.0) - IGDRY = COUNT( GDRY(:) ) -! - IF( IGDRY>0 ) THEN -! -! 6.2.4.1 allocations -! - ALLOCATE(ZVEC1(IGDRY)) - ALLOCATE(ZVEC2(IGDRY)) - ALLOCATE(ZVEC3(IGDRY)) - ALLOCATE(IVEC1(IGDRY)) - ALLOCATE(IVEC2(IGDRY)) - ALLOCATE(ZVECQ4(IGDRY)) -! -! 6.2.4.2 select the (ZLBDAG,ZLBDAR) couplet -! - ZVEC1(:) = PACK( ZLBDAG(:),MASK=GDRY(:) ) - ZVEC2(:) = PACK( ZLBDAR(:),MASK=GDRY(:) ) -! -! 6.2.4.3 find the next lower indice for the ZLBDAG and for the ZLBDAR -! in the geometrical set of (Lbda_g,Lbda_r) couplet use to -! tabulate the RDRYG-kernel -! - ZVEC1(1:IGDRY) = MAX( 1.00001, MIN( REAL(NDRYLBDAG)-0.00001, & - XDRYINTP1G * LOG( ZVEC1(1:IGDRY) ) + XDRYINTP2G ) ) - IVEC1(1:IGDRY) = INT( ZVEC1(1:IGDRY) ) - ZVEC1(1:IGDRY) = ZVEC1(1:IGDRY) - REAL( IVEC1(1:IGDRY) ) -! - ZVEC2(1:IGDRY) = MAX( 1.00001, MIN( REAL(NDRYLBDAR)-0.00001, & - XDRYINTP1R * LOG( ZVEC2(1:IGDRY) ) + XDRYINTP2R ) ) - IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) ) - ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - REAL( IVEC2(1:IGDRY) ) -! -! 6.2.4.4 perform the bilinear interpolation of the normalized -! RDRYG-kernel -! - ZVEC3(:) = BI_LIN_INTP_V(XKER_RDRYG, IVEC1, IVEC2, ZVEC1, ZVEC2, IGDRY) - ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GDRY,FIELD=0.0 ) -! - ZVECQ4(:) = BI_LIN_INTP_V(XKER_Q_RDRYG, IVEC1, IVEC2, ZVEC1, ZVEC2, IGDRY) - ZWQ1(:,6) = UNPACK( VECTOR=ZVECQ4(:), MASK=GDRY, FIELD=0.0 ) -! -! 6.2.4.5 compute RRDRYG and QRDRYG -! - WHERE( GDRY(:) ) - ZZW1(:,4) = MIN( ZRRS(:),XFRDRYG*ZZW(:) & ! RRDRYG - *( ZLBDAR(:)**(-4) )*( ZLBDAG(:)**XCXG ) & - * ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) & - *( XLBRDRYG1/( ZLBDAG(:)**2 ) + & - XLBRDRYG2/( ZLBDAG(:) * ZLBDAR(:) ) + & - XLBRDRYG3/( ZLBDAR(:)**2) ) ) - ZWQ1(:,6) = ZWQ1(:,6) * XFQRDRYG * & - ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) * & - ZERT(:) * ZLBDAG(:)**XCXG * ZLBDAR(:)**XCXR * & - (XLBQRDRYG1 * ZLBDAR(:)**(-2.0 - XFR) + & - XLBQRDRYG2 * ZLBDAR(:)**(-1.0 - XFR) * ZLBDAG(:)**(-1.0) + & - XLBQRDRYG3 * ZLBDAR(:)**(-XFR) * ZLBDAG(:)**(-2.0)) ! QRDRYG - END WHERE -! - WHERE (ZRRT(:) > XRTMIN_ELEC(3) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. & - ZRRS(:) > ZRSMIN_ELEC(3).AND. ABS(ZERT) > XERMIN .AND. & - ABS(ZQRT(:)) > XQTMIN(3)) - ZWQ1(:,6) = SIGN( MIN( ABS(ZQRS(:)),ABS(ZWQ1(:,6)) ),ZQRS(:) ) - ELSEWHERE - ZWQ1(:,6) = 0. - ENDWHERE -! - DEALLOCATE(IVEC2) - DEALLOCATE(IVEC1) - DEALLOCATE(ZVEC3) - DEALLOCATE(ZVEC2) - DEALLOCATE(ZVEC1) - DEALLOCATE(ZVECQ4) - END IF -! - ZRDRYG(:) = ZZW1(:,1) + ZZW1(:,2) + ZZW1(:,3) + ZZW1(:,4) - DEALLOCATE(GDRY) -! -! -!* 6.3 compute the Wet growth case -! - ZZW(:) = 0.0 - ZRWETG(:) = 0.0 - ZWQ1(:,7:9) = 0.0 -! - WHERE (ZRGT(:) > XRTMIN(6)) - ZZW1(:,5) = MIN( ZRIS(:), & - ZZW1(:,2) / (XCOLIG*EXP(XCOLEXIG*(ZZT(:)-XTT)) ) ) ! RIWETG - ZZW1(:,6) = MIN( ZRSS(:), & - ZZW1(:,3) / (XCOLSG*EXP(XCOLEXSG*(ZZT(:)-XTT)) ) ) ! RSWETG -! - ZZW(:) = ZRVT(:) * ZPRES(:) / ((XMV / XMD) + ZRVT(:)) ! Vapor pressure - ZZW(:) = ZKA(:) * (XTT - ZZT(:)) + & - (ZDV(:) * (XLVTT + (XCPV - XCL) * (ZZT(:) - XTT)) * & - (XESTT - ZZW(:)) / (XRV * ZZT(:))) -! -! compute RWETG -! - ZRWETG(:) = MAX(0.0, & - (ZZW(:) * (X0DEPG * ZLBDAG(:)**XEX0DEPG + & - X1DEPG * ZCJ(:) * ZLBDAG(:)**XEX1DEPG) + & - (ZZW1(:,5) + ZZW1(:,6) ) * & - (ZRHODREF(:) * (XLMTT + (XCI - XCL) * (XTT - ZZT(:))))) / & - (ZRHODREF(:) * (XLMTT - XCL * (XTT - ZZT(:))))) - END WHERE -! - WHERE (ZRGT(:) > 0.0 .AND. ZRIT(:) > 0. .AND. ZRST(:) > 0.) - ZWQ1(:,7) = XCOEF_RQ_I * ZZW1(:,5) * ZQIT(:) / ZRIT(:) - ZWQ1(:,8) = XCOEF_RQ_S * ZZW1(:,6) * ZQST(:) / ZRST(:) - END WHERE -! - WHERE (ZRGT(:) > XRTMIN_ELEC(6) .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE) - ZWQ1(:,7) = SIGN( MIN( ABS(ZQIS(:)),ABS(ZWQ1(:,7)) ),ZQIS(:) ) - ZWQ1(:,8) = SIGN( MIN( ABS(ZQSS(:)),ABS(ZWQ1(:,8)) ),ZQSS(:) ) - ELSEWHERE - ZWQ1(:,7) = 0. - ZWQ1(:,8) = 0. - ENDWHERE -! - WHERE (ZRGS(:) > ZRSMIN_ELEC(6) .AND. ABS(ZQRT(:)) > XQTMIN(3) .AND. & - ZRRT(:) > XRTMIN_ELEC(3)) - ZWQ1(:,9) = XCOEF_RQ_R * ZQRT(:) * & - (ZRWETG(:) - ZZW1(:,5) - ZZW1(:,6) - ZZW1(:,1)) / ZRRT(:) ! QRWETG - ZWQ1(:,9) = SIGN( MIN( ABS(ZQRS(:)),ABS(ZWQ1(:,9)) ),ZQRS(:) ) - ENDWHERE -! -! -!* 6.4 Select Wet or Dry case -! - ZZW(:) = 0.0 - IF (KRR == 7) THEN - WHERE( ZRGT(:) > XRTMIN(6) .AND. ZZT(:) < XTT .AND. & ! Wet - ZRDRYG(:) >= ZRWETG(:) .AND. ZRWETG(:) > 0.0 ) ! case - ZZW(:) = ZRWETG(:) - ZZW1(:,5) - ZZW1(:,6) ! RCWETG+RRWETG -! -! limitation of the available rainwater mixing ratio (RRWETH < RRS !) -! - ZZW1(:,7) = MAX( 0.0,MIN( ZZW(:),ZRRS(:)+ZZW1(:,1) ) ) - ZUSW(:) = ZZW1(:,7) / ZZW(:) - ZZW1(:,5) = ZZW1(:,5) * ZUSW(:) - ZZW1(:,6) = ZZW1(:,6) * ZUSW(:) - ZRWETG(:) = ZZW1(:,7) + ZZW1(:,5) + ZZW1(:,6) -! - ZRCS(:) = ZRCS(:) - ZZW1(:,1) - ZRIS(:) = ZRIS(:) - ZZW1(:,5) - ZRSS(:) = ZRSS(:) - ZZW1(:,6) -! -! assume a linear percent of conversion of graupel into hail -! - ZRGS(:) = ZRGS(:) + ZRWETG(:) ! Wet growth - ZZW(:) = ZRGS(:) * ZRDRYG(:) / (ZRWETG(:) + ZRDRYG(:)) ! and - ZRGS(:) = ZRGS(:) - ZZW(:) ! partial conversion - ZRHS(:) = ZRHS(:) + ZZW(:) ! of the graupel into hail -! - ZRRS(:) = MAX( 0.0,ZRRS(:) - ZZW1(:,7) + ZZW1(:,1) ) - ZTHS(:) = ZTHS(:) + ZZW1(:,7)*(ZLSFACT(:)-ZLVFACT(:)) - ! f(L_f*(RCWETG+RRWETG)) -! - ZQCS(:) = ZQCS(:) - ZWQ1(:,1) ! QCDRYG .equiv. QCWETG - ZQRS(:) = ZQRS(:) - ZWQ1(:,9) - ZQIS(:) = ZQIS(:) - ZWQ1(:,7) - ZQSS(:) = ZQSS(:) - ZWQ1(:,8) - ZQGS(:) = ZQGS(:) + ZWQ1(:,1) + ZWQ1(:,9) + ZWQ1(:,7) + ZWQ1(:,8) - ZZW(:) = ZQGS(:) * ZRDRYG(:) / (ZRWETG(:) + ZRDRYG(:)) ! partial graupel - ZQGS(:) = ZQGS(:) - ZZW(:) ! charge conversion - ZQHS(:) = ZQHS(:) + ZZW(:) ! into hail charge - END WHERE - ELSE IF( KRR == 6 ) THEN - WHERE (ZRGT(:) > XRTMIN(6) .AND. ZZT(:) < XTT .AND. & ! Wet - ZRDRYG(:) >= ZRWETG(:) .AND. ZRWETG(:) > 0.0) ! case - ZZW(:) = ZRWETG(:) - ZRCS(:) = ZRCS(:) - ZZW1(:,1) - ZRIS(:) = ZRIS(:) - ZZW1(:,5) - ZRSS(:) = ZRSS(:) - ZZW1(:,6) - ZRGS(:) = ZRGS(:) + ZZW(:) -! - ZRRS(:) = ZRRS(:) - ZZW(:) + ZZW1(:,5) + ZZW1(:,6) + ZZW1(:,1) - ZTHS(:) = ZTHS(:) + (ZZW(:)-ZZW1(:,5)-ZZW1(:,6))*(ZLSFACT(:)-ZLVFACT(:)) - ! f(L_f*(RCWETG+RRWETG)) -! - ZQCS(:) = ZQCS(:) - ZWQ1(:,1) ! QCDRYG .equiv. QCWETG - ZQRS(:) = ZQRS(:) - ZWQ1(:,9) - ZQIS(:) = ZQIS(:) - ZWQ1(:,7) - ZQSS(:) = ZQSS(:) - ZWQ1(:,8) - ZQGS(:) = ZQGS(:) + ZWQ1(:,1) + ZWQ1(:,9) + ZWQ1(:,7) + ZWQ1(:,8) - END WHERE - END IF - - if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'WETG', & - Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'WETG', & - Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'WETG', & - Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'WETG', & - Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'WETG', & - Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'WETG', & - Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'WETG', & - Unpack( zrhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_sv ) then - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'WETG', & - Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'WETG', & - Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'WETG', & - Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'WETG', & - Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'WETG', & - Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( krr == 7 ) & - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'WETG', & - Unpack( zqhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if - - if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'DRYG', & - Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DRYG', & - Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'DRYG', & - Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'DRYG', & - Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'DRYG', & - Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'DRYG', & - Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_sv ) then - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'DRYG', & - Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'DRYG', & - Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'DRYG', & - Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'DRYG', & - Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'DRYG', & - Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if - - WHERE (ZRGT(:) > XRTMIN(6) .AND. ZZT(:) < XTT .AND. & ! Dry - ZRDRYG(:) < ZRWETG(:) .AND. ZRDRYG(:) > 0.0) ! case - ZRCS(:) = ZRCS(:) - ZZW1(:,1) - ZRIS(:) = ZRIS(:) - ZZW1(:,2) - ZRSS(:) = ZRSS(:) - ZZW1(:,3) - ZRRS(:) = ZRRS(:) - ZZW1(:,4) - ZRGS(:) = ZRGS(:) + ZRDRYG(:) - ZTHS(:) = ZTHS(:) + (ZZW1(:,1) + ZZW1(:,4)) * (ZLSFACT(:) - ZLVFACT(:)) - ! f(L_f*(RCDRYG+RRDRYG)) -! - ZQCS(:) = ZQCS(:) - ZWQ1(:,1) - ZQRS(:) = ZQRS(:) - ZWQ1(:,6) - ZQIS(:) = ZQIS(:) - ZWQ1(:,2) - ZWQ1(:,3) - ZQSS(:) = ZQSS(:) - ZWQ1(:,4) - ZWQ1(:,5) - ZQGS(:) = ZQGS(:) + ZWQ1(:,1) + ZWQ1(:,2) + ZWQ1(:,3) + ZWQ1(:,4) & - + ZWQ1(:,5) + ZWQ1(:,6) - END WHERE - - if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'DRYG', & - Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DRYG', & - Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'DRYG', & - Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'DRYG', & - Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'DRYG', & - Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'DRYG', & - Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_sv ) then - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'DRYG', & - Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'DRYG', & - Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'DRYG', & - Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'DRYG', & - Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'DRYG', & - Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if -! -! Inductive mecanism -! - IF (LINDUCTIVE) THEN - if ( lbudget_sv ) then - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1), 'INCG', & - Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'INCG', & - Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if - - ZRATE_IND(:) = 0. - GIND(:) = ZRDRYG(:) > 0. .AND. ZRDRYG(:) < ZRWETG(:) .AND. ZZT(:) < XTT - IIND = COUNT(GIND(:)) -! - IF (IIND > 0) CALL INDUCTIVE_PROCESS -! - XIND_RATE(:,:,:) = 0. - XIND_RATE(:,:,:) = UNPACK(ZRATE_IND(:), MASK=GMICRO, FIELD=0.0) - XIND_RATE(:,:,:) = XIND_RATE(:,:,:) * PRHODREF(:,:,:) ! C/m3/s - - if ( lbudget_sv ) then - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1), 'INCG', & - Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'INCG', & - Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if - END IF -! -!* 6.5 Melting of the graupeln -! - if ( lbudget_sv ) then - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2), 'GMLT', & - Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'GMLT', & - Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if - - ZZW(:) = 0.0 - ZWQ1(:,7) = 0.0 - WHERE ((ZRGT(:) > XRTMIN(6)) .AND. (ZRGS(:) > 0.0) .AND. (ZZT(:) > XTT)) - ZZW(:) = ZRVT(:) * ZPRES(:) / ((XMV / XMD) + ZRVT(:)) ! Vapor pressure - ZZW(:) = ZKA(:) * (XTT - ZZT(:)) + & - (ZDV(:) * (XLVTT + ( XCPV - XCL ) * (ZZT(:) - XTT)) * & - (XESTT - ZZW(:)) / (XRV * ZZT(:))) -! compute RGMLTR - ZZW(:) = MIN(ZRGS(:), MAX(0.0, (-ZZW(:) * & - (X0DEPG * ZLBDAG(:)**XEX0DEPG + & - X1DEPG * ZCJ(:) * ZLBDAG(:)**XEX1DEPG) - & - (ZZW1(:,1) + ZZW1(:,4)) * & - (ZRHODREF(:) * XCL * (XTT - ZZT(:)))) / & - (ZRHODREF(:) * XLMTT))) - ZRRS(:) = ZRRS(:) + ZZW(:) - ZRGS(:) = ZRGS(:) - ZZW(:) - ZTHS(:) = ZTHS(:) - ZZW(:) * (ZLSFACT(:) - ZLVFACT(:)) ! f(L_f*(-RGMLTR)) -! compute QGMLTR - ZWQ1(:,7) = XCOEF_RQ_G * ZQGT(:) * ZZW(:) / ZRGT(:) - END WHERE -! -! - WHERE (ZRGT(:) > XRTMIN_ELEC(6) .AND. ZRGS(:) > ZRSMIN_ELEC(6) .AND. & - ZZT(:) > XTT .AND. ABS(ZQGT(:)) > XQTMIN(6)) - ZWQ1(:,7) = SIGN( MIN( ABS(ZQGS(:)),ABS(ZWQ1(:,7)) ),ZQGS(:) ) - ZQRS(:) = ZQRS(:) + ZWQ1(:,7) - ZQGS(:) = ZQGS(:) - ZWQ1(:,7) - ENDWHERE - - if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'GMLT', Unpack( -zzw(:) * ( zlsfact(:) - zlvfact(:) ) & - * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'GMLT', & - Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'GMLT', & - Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_sv ) then - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2), 'GMLT', & - Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'GMLT', & - Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if - - END SUBROUTINE RAIN_ICE_ELEC_FAST_RG -! -!------------------------------------------------------------------------------- -! -! - SUBROUTINE RAIN_ICE_ELEC_FAST_RH -! -!* 0. DECLARATIONS -! ------------ -! -IMPLICIT NONE -! -!------------------------------------------------------------------------------- -! - ALLOCATE( GHAIL(IMICRO) ) - GHAIL(:) = ZRHT(:) > XRTMIN(7) - IHAIL = COUNT(GHAIL(:)) -! - IF( IHAIL>0 ) THEN - if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'WETH', & - Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'WETH', & - Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'WETH', & - Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'WETH', & - Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'WETH', & - Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'WETH', & - Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'WETH', & - Unpack( zrhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) -! -!* 7.2 compute the Wet growth of hail -! - WHERE (GHAIL(:)) - ZLBDAH(:) = XLBH * (ZRHODREF(:) * MAX(ZRHT(:), XRTMIN(7)))**XLBEXH - END WHERE -! - ZZW1(:,:) = 0.0 - WHERE (GHAIL(:) .AND. ((ZRCT(:) > XRTMIN(2) .AND. ZRCS(:) > 0.0))) - ZZW(:) = ZLBDAH(:)**(XCXH-XDH-2.0) * ZRHOCOR(:) / ZCOR00 - ZZW1(:,1) = MIN( ZRCS(:),XFWETH * ZRCT(:) * ZZW(:) ) ! RCWETH - END WHERE - WHERE (GHAIL(:) .AND. ((ZRIT(:) > XRTMIN(4) .AND. ZRIS(:) > 0.0))) - ZZW(:) = ZLBDAH(:)**(XCXH-XDH-2.0) * ZRHOCOR(:) / ZCOR00 - ZZW1(:,2) = MIN( ZRIS(:),XFWETH * ZRIT(:) * ZZW(:) ) ! RIWETH - END WHERE -! -!* 7.2.1 accretion of aggregates on the hailstones -! - ALLOCATE( GWET(IMICRO) ) - GWET(:) = GHAIL(:) .AND. (ZRST(:) > XRTMIN(5) .AND. ZRSS(:) > 0.0) - IGWET = COUNT( GWET(:) ) -! - IF (IGWET > 0) THEN -! -!* 7.2.2 allocations -! - ALLOCATE(ZVEC1(IGWET)) - ALLOCATE(ZVEC2(IGWET)) - ALLOCATE(ZVEC3(IGWET)) - ALLOCATE(IVEC1(IGWET)) - ALLOCATE(IVEC2(IGWET)) -! -!* 7.2.3 select the (ZLBDAH,ZLBDAS) couplet -! - ZVEC1(:) = PACK( ZLBDAH(:),MASK=GWET(:) ) - ZVEC2(:) = PACK( ZLBDAS(:),MASK=GWET(:) ) -! -!* 7.2.4 find the next lower indice for the ZLBDAG and for the ZLBDAS -! in the geometrical set of (Lbda_h,Lbda_s) couplet use to -! tabulate the SWETH-kernel -! - ZVEC1(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAH)-0.00001, & - XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) ) - IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) ) - ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) ) -! - ZVEC2(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAS)-0.00001, & - XWETINTP1S * LOG( ZVEC2(1:IGWET) ) + XWETINTP2S ) ) - IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) ) - ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( IVEC2(1:IGWET) ) -! -!* 7.2.5 perform the bilinear interpolation of the normalized -! SWETH-kernel -! - ZVEC3(:) = BI_LIN_INTP_V(XKER_SWETH, IVEC1, IVEC2, ZVEC1, ZVEC2, IGWET) - ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GWET,FIELD=0.0 ) -! - WHERE( GWET(:) ) - ZZW1(:,3) = MIN( ZRSS(:), XFSWETH*ZZW(:) & ! RSWETH - *( ZLBDAS(:)**(XCXS-XBS) )*( ZLBDAH(:)**XCXH ) & - * ZRHOCOR(:)/(ZCOR00*ZRHODREF(:)) & - *( XLBSWETH1/( ZLBDAH(:)**2 ) + & - XLBSWETH2/( ZLBDAH(:) * ZLBDAS(:) ) + & - XLBSWETH3/( ZLBDAS(:)**2) ) ) - END WHERE - DEALLOCATE(IVEC2) - DEALLOCATE(IVEC1) - DEALLOCATE(ZVEC3) - DEALLOCATE(ZVEC2) - DEALLOCATE(ZVEC1) - END IF -! -!* 7.2.6 accretion of graupeln on the hailstones -! - GWET(:) = GHAIL(:) .AND. (ZRGT(:)>XRTMIN(6) .AND. ZRGS(:)>0.0) - IGWET = COUNT( GWET(:) ) -! - IF (IGWET > 0) THEN -! -!* 7.2.7 allocations -! - ALLOCATE( ZVEC1(IGWET) ) - ALLOCATE( ZVEC2(IGWET) ) - ALLOCATE( ZVEC3(IGWET) ) - ALLOCATE( IVEC1(IGWET) ) - ALLOCATE( IVEC2(IGWET) ) -! -!* 7.2.8 select the (ZLBDAH,ZLBDAG) couplet -! - ZVEC1(:) = PACK( ZLBDAH(:),MASK=GWET(:) ) - ZVEC2(:) = PACK( ZLBDAG(:),MASK=GWET(:) ) -! -!* 7.2.9 find the next lower indice for the ZLBDAH and for the ZLBDAG -! in the geometrical set of (Lbda_h,Lbda_g) couplet use to -! tabulate the GWETH-kernel -! - ZVEC1(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAG)-0.00001, & - XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) ) - IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) ) - ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) ) -! - ZVEC2(1:IGWET) = MAX( 1.00001, MIN( REAL(NWETLBDAG)-0.00001, & - XWETINTP1G * LOG( ZVEC2(1:IGWET) ) + XWETINTP2G ) ) - IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) ) - ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( IVEC2(1:IGWET) ) -! -!* 7.2.10 perform the bilinear interpolation of the normalized -! GWETH-kernel -! - ZVEC3(:) = BI_LIN_INTP_V(XKER_GWETH, IVEC1, IVEC2, ZVEC1, ZVEC2, IGWET) - ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GWET,FIELD=0.0 ) -! - WHERE (GWET(:)) - ZZW1(:,5) = MIN( ZRGS(:),XFGWETH*ZZW(:) & ! RGWETH - *( ZLBDAG(:)**(XCXG-XBG) )*( ZLBDAH(:)**XCXH ) & - * ZRHOCOR(:) / (ZCOR00 * ZRHODREF(:)) & - *( XLBGWETH1/( ZLBDAH(:)**2 ) + & - XLBGWETH2/( ZLBDAH(:) * ZLBDAG(:) ) + & - XLBGWETH3/( ZLBDAG(:)**2) ) ) - END WHERE - DEALLOCATE(IVEC2) - DEALLOCATE(IVEC1) - DEALLOCATE(ZVEC3) - DEALLOCATE(ZVEC2) - DEALLOCATE(ZVEC1) - END IF - DEALLOCATE(GWET) -! -!* 7.3 compute the Wet growth of hail -! - ZZW(:) = 0.0 - WHERE (GHAIL(:) .AND. ZZT(:) < XTT) - ZZW(:) = ZRVT(:) * ZPRES(:) / ((XMV / XMD) + ZRVT(:)) ! Vapor pressure - ZZW(:) = ZKA(:) * (XTT - ZZT(:)) + & - (ZDV(:) * (XLVTT + (XCPV - XCL) * (ZZT(:) - XTT)) * & - (XESTT - ZZW(:)) / (XRV * ZZT(:))) -! -! compute RWETH -! - ZZW(:) = MAX(0., (ZZW(:) * (X0DEPH * ZLBDAH(:)**XEX0DEPH + & - X1DEPH * ZCJ(:) * ZLBDAH(:)**XEX1DEPH) + & - (ZZW1(:,2) + ZZW1(:,3) + ZZW1(:,5) ) * & - (ZRHODREF(:) * (XLMTT + (XCI - XCL) * (XTT - ZZT(:))))) / & - (ZRHODREF(:) * (XLMTT - XCL * (XTT - ZZT(:))))) -! - ZZW1(:,6) = MAX( ZZW(:) - ZZW1(:,2) - ZZW1(:,3) - ZZW1(:,5), 0. ) ! RCWETH+RRWETH - END WHERE -! - ZUSW(:) = 0. -! - WHERE (GHAIL(:) .AND. ZZT(:) < XTT .AND. ZZW1(:,6) /= 0.0) -! -! limitation of the available rainwater mixing ratio (RRWETH < RRS !) -! - ZZW1(:,4) = MAX( 0.0,MIN( ZZW1(:,6),ZRRS(:)+ZZW1(:,1) ) ) - ZUSW(:) = ZZW1(:,4) / ZZW1(:,6) - ZZW1(:,2) = ZZW1(:,2)*ZUSW(:) - ZZW1(:,3) = ZZW1(:,3)*ZUSW(:) - ZZW1(:,5) = ZZW1(:,5)*ZUSW(:) - ZZW(:) = ZZW1(:,4) + ZZW1(:,2) + ZZW1(:,3) + ZZW1(:,5) -! -!* 7.1.6 integrate the Wet growth of hail -! - ZRCS(:) = ZRCS(:) - ZZW1(:,1) - ZRIS(:) = ZRIS(:) - ZZW1(:,2) - ZRSS(:) = ZRSS(:) - ZZW1(:,3) - ZRGS(:) = ZRGS(:) - ZZW1(:,5) - ZRHS(:) = ZRHS(:) + ZZW(:) - ZRRS(:) = MAX( 0.0,ZRRS(:) - ZZW1(:,4) + ZZW1(:,1) ) - ZRRS(:) = ZRRS(:) - ZZW1(:,4) - ZTHS(:) = ZTHS(:) + (ZZW1(:,4)+ZZW1(:,1))*(ZLSFACT(:)-ZLVFACT(:)) - ! f(L_f*(RCWETH+RRWETH)) - END WHERE -! - ZWQ1(:,:) = 0.0 - WHERE (GHAIL(:) .AND. ZZT(:) < XTT .AND. ZRCT(:) > XRTMIN_ELEC(2)) - ZWQ1(:,1) = XCOEF_RQ_C * ZQCT(:) * ZZW1(:,1) / ZRCT(:) - ZWQ1(:,1) = SIGN( MIN( ABS(ZQCS(:)),ABS(ZWQ1(:,1)) ),ZQCS(:) ) - END WHERE - WHERE (GHAIL(:) .AND. ZZT(:) < XTT .AND. ZRIT(:) > XRTMIN_ELEC(4)) - ZWQ1(:,2) = XCOEF_RQ_I * ZQIT(:) * ZZW1(:,2) / ZRIT(:) - ZWQ1(:,2) = SIGN( MIN( ABS(ZQIS(:)),ABS(ZWQ1(:,2)) ),ZQIS(:) ) - END WHERE - WHERE (GHAIL(:) .AND. ZZT(:) < XTT .AND. ZRST(:) > XRTMIN_ELEC(5)) - ZWQ1(:,3) = XCOEF_RQ_S * ZQST(:) * ZZW1(:,3) / ZRST(:) - ZWQ1(:,3) = SIGN( MIN( ABS(ZQSS(:)),ABS(ZWQ1(:,3)) ),ZQSS(:) ) - END WHERE - WHERE (GHAIL(:) .AND. ZZT(:) < XTT .AND. ZRGT(:) > XRTMIN_ELEC(6)) - ZWQ1(:,5) = XCOEF_RQ_G * ZQGT(:) * ZZW1(:,5) / ZRGT(:) - ZWQ1(:,5) = SIGN( MIN( ABS(ZQGS(:)),ABS(ZWQ1(:,5)) ),ZQGS(:) ) - END WHERE - WHERE (GHAIL(:) .AND. ZZT(:) < XTT .AND. ZRRT(:) > XRTMIN_ELEC(3)) - ZWQ1(:,4) = XCOEF_RQ_R * ZQRT(:) * ZZW1(:,4) / ZRRT(:) - ZWQ1(:,4) = SIGN( MIN( ABS(ZQRS(:)),ABS(ZWQ1(:,4)) ),ZQRS(:) ) - END WHERE -! - ZQCS(:) = ZQCS(:) - ZWQ1(:,1) - ZQIS(:) = ZQIS(:) - ZWQ1(:,2) - ZQSS(:) = ZQSS(:) - ZWQ1(:,3) - ZQGS(:) = ZQGS(:) - ZWQ1(:,5) - ZQRS(:) = ZQRS(:) - ZWQ1(:,4) - ZQHS(:) = ZQHS(:) + ZWQ1(:,1) + ZWQ1(:,2) + ZWQ1(:,3) + ZWQ1(:,4) + ZWQ1(:,5) - - if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'WETH', & - Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'WETH', & - Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'WETH', & - Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'WETH', & - Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'WETH', & - Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'WETH', & - Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'WETH', & - Unpack( zrhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_sv ) then - call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'WETH', & - Unpack( -zwq1(:, 1) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'WETH', & - Unpack( -zwq1(:, 4) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'WETH', & - Unpack( -zwq1(:, 2) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'WETH', & - Unpack( -zwq1(:, 3) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'WETH', & - Unpack( -zwq1(:, 5) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'WETH', & - Unpack( ( zwq1(:, 1) + zwq1(:, 2) + zwq1(:, 3) + zwq1(:, 4) + zwq1(:, 5) ) & - * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if - END IF -! - IF (IHAIL > 0) THEN -! -!* 7.5 Melting of the hailstones -! - if ( lbudget_sv ) then - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'HMLT', & - Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'HMLT', & - Unpack( zqhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if - - ZZW(:) = 0.0 - ZWQ1(:,7) = 0. -! - WHERE (GHAIL(:) .AND. (ZRHS(:) > 0.0) .AND. (ZZT(:) > XTT)) - ZZW(:) = ZRVT(:) * ZPRES(:) / ((XMV / XMD) + ZRVT(:)) ! Vapor pressure - ZZW(:) = ZKA(:) * (XTT - ZZT(:)) + & - ( ZDV(:) * (XLVTT + (XCPV - XCL) * (ZZT(:) - XTT)) * & - (XESTT - ZZW(:)) / (XRV * ZZT(:))) -! -! compute RHMLTR -! - ZZW(:) = MIN( ZRHS(:), MAX( 0.0,( -ZZW(:) * & - ( X0DEPH* ZLBDAH(:)**XEX0DEPH + & - X1DEPH*ZCJ(:)*ZLBDAH(:)**XEX1DEPH ) - & - ZZW1(:,6)*( ZRHODREF(:)*XCL*(XTT-ZZT(:))) ) / & - ( ZRHODREF(:)*XLMTT ) ) ) - ZRRS(:) = ZRRS(:) + ZZW(:) - ZRHS(:) = ZRHS(:) - ZZW(:) -! compute QHMLTR - ZWQ1(:,7) = XCOEF_RQ_H * ZQHT(:) * ZZW(:) / ZRHT(:) - ZTHS(:) = ZTHS(:) - ZZW(:) * (ZLSFACT(:) - ZLVFACT(:)) ! f(L_f*(-RHMLTR)) - END WHERE -! - WHERE (ZRHT(:) > XRTMIN_ELEC(7) .AND. ZRHS(:) > ZRSMIN_ELEC(7) .AND. & - ZZT(:) > XTT .AND. ABS(ZQHT(:)) > XQTMIN(7)) - ZWQ1(:,7) = SIGN( MIN( ABS(ZQHS(:)),ABS(ZWQ1(:,7)) ),ZQHS(:) ) - ZQRS(:) = ZQRS(:) + ZWQ1(:,7) - ZQHS(:) = ZQHS(:) - ZWQ1(:,7) - END WHERE - - if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HMLT', & - Unpack( -zzw(:) * ( zlsfact(:) - zlvfact(:) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'HMLT', & - Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rh ) call Budget_store_add( tbudgets(NBUDGET_RH), 'HMLT', & - Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_sv ) then - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'HMLT', & - Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'HMLT', & - Unpack( zqhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if - END IF -! - DEALLOCATE(GHAIL) -! - END SUBROUTINE RAIN_ICE_ELEC_FAST_RH -! -!------------------------------------------------------------------------------- -! -! - SUBROUTINE RAIN_ICE_ELEC_FAST_RI -! -!* 0. DECLARATIONS -! ------------ -! -IMPLICIT NONE -! -!------------------------------------------------------------------------------- -! -!* 7.1 cloud ice melting -! - if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'IMLT', & - Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'IMLT', & - Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'IMLT', & - Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_sv ) then - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'IMLT', & - Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'IMLT', & - Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if - - ZZW(:) = 0.0 - ZWQ1(:,1) = 0.0 - WHERE ((ZRIS(:) > 0.0) .AND. (ZZT(:) > XTT)) - ZZW(:) = ZRIS(:) - ZRCS(:) = ZRCS(:) + ZRIS(:) - ZTHS(:) = ZTHS(:) - ZRIS(:) * (ZLSFACT(:) - ZLVFACT(:)) ! f(L_f*(-RIMLTC)) - ZRIS(:) = 0.0 - ZCIT(:) = 0.0 - ZQCS(:) = ZQCS(:) + ZQIS(:) - ZQIS(:) = 0. - END WHERE - - if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'IMLT', & - Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'IMLT', & - Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'IMLT', & - Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_sv ) then - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'IMLT', & - Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'IMLT', & - Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if -! -!* 7.2 Bergeron-Findeisen effect: RCBERI -! - if ( lbudget_sv ) then - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'BERFI', & - Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'BERFI', & - Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if - - ZZW(:) = 0.0 - ZWQ1(:,1) = 0.0 - WHERE ((ZRCS(:) > 0.0) .AND. (ZSSI(:) > 0.0) .AND. & - (ZRIT(:) > XRTMIN(4)) .AND. (ZCIT(:) > 0.0) .AND. & - ZRCT(:) > 0.) - ZZW(:) = MIN(1.E8,XLBI*( ZRHODREF(:)*ZRIT(:)/ZCIT(:) )**XLBEXI) ! Lbda_i - ZZW(:) = MIN( ZRCS(:),( ZSSI(:) / (ZRHODREF(:)*ZAI(:)) ) * ZCIT(:) * & - ( X0DEPI/ZZW(:) + X2DEPI*ZCJ(:)*ZCJ(:)/ZZW(:)**(XDI+2.0) ) ) - ZRCS(:) = ZRCS(:) - ZZW(:) - ZRIS(:) = ZRIS(:) + ZZW(:) - ZTHS(:) = ZTHS(:) + ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RCBERI)) -! - ZWQ1(:,1) = XCOEF_RQ_C * ZQCT(:) * ZZW(:) / ZRCT(:) - END WHERE -! - WHERE (ZRCS(:) > 0.0 .AND. ZSSI(:) > 0.0 .AND. & - ZRIT(:) > 0.0 .AND. ZCIT(:) > 0.0 .AND. & - ZRCT(:) > XRTMIN_ELEC(2) .AND. ABS(ZQCT(:)) > XQTMIN(2)) - ZWQ1(:,1) = SIGN( MIN( ABS(ZQCS(:)),ABS(ZWQ1(:,1)) ),ZQCS(:) ) - ZQIS(:) = ZQIS(:) + ZWQ1(:,1) - ZQCS(:) = ZQCS(:) - ZWQ1(:,1) - ENDWHERE - - if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'BERFI', & - Unpack( zzw(:) * ( zlsfact(:) - zlvfact(:) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'BERFI', & - Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'BERFI', & - Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_sv ) then - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'BERFI', & - Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'BERFI', & - Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - end if - - END SUBROUTINE RAIN_ICE_ELEC_FAST_RI -! -!------------------------------------------------------------------------------- -! - SUBROUTINE COMPUTE_LBDA(ZRR, ZRS, ZRG, ZRH) -! -!* 0. DECLARATIONS -! ------------ -! -IMPLICIT NONE -! -REAL, DIMENSION(:), INTENT(IN) :: ZRR, ZRS, ZRG -REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: ZRH -! -! -!* 1. COMPUTE LAMBDA -! -------------- -! - ZLBDAR(:) = 0.0 - ZLBDAS(:) = 0.0 - ZLBDAG(:) = 0.0 -! - WHERE( ZRR(:) > 0.0 ) - ZLBDAR(:) = XLBR * (ZRHODREF(:) * MAX(ZRR(:), XRTMIN(3)))**XLBEXR - END WHERE -! - WHERE ( ZRS(:) > 0.0 ) - ZLBDAS(:) = MIN( XLBDAS_MAX, & - XLBS * (ZRHODREF(:) * MAX(ZRS(:), XRTMIN(5)))**XLBEXS ) - END WHERE -! - WHERE ( ZRG(:) > 0.0 ) - ZLBDAG(:) = XLBG * (ZRHODREF(:) * MAX( ZRG(:), XRTMIN(6)))**XLBEXG - END WHERE -! - IF (PRESENT(ZRH)) THEN - ZLBDAH(:) = 0.0 - WHERE ( ZRH(:) > 0.0 ) - ZLBDAH(:) = XLBH * (ZRHODREF(:) * MAX( ZRH(:), XRTMIN(7)))**XLBEXH - END WHERE - END IF -! -END SUBROUTINE COMPUTE_LBDA -! -!------------------------------------------------------------------------------ -! -SUBROUTINE ELEC_UPDATE_QD(ZDUM, ZER, ZEI, ZES, ZEG, ZQR, ZQI, ZQS, ZQG, & - ZRR, ZRI, ZRS, ZRG, & - ZEH, ZQH, ZRH, ZEC, ZQC, ZRC) -! -! Purpose : update the parameter e_x in the relation q_x = e_x d**f_x -! e_x = q_x/(N_x * M(f_x)) -! -! -!* 0. DECLARATIONS -! ------------ -! -IMPLICIT NONE -! -REAL, INTENT(IN) :: ZDUM ! =1. if mixing ratio - ! =timestep if source -REAL, DIMENSION(:), INTENT(IN) :: ZQR, ZQI, ZQS, ZQG ! V. C. -REAL, DIMENSION(:), INTENT(IN) :: ZRR, ZRI, ZRS, ZRG ! mixing ratio -REAL, DIMENSION(:), INTENT(OUT) :: ZER, ZEI, ZES, ZEG ! Coef of the charge diameter relation -REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: ZQH ! hail -REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: ZRH ! hail -REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: ZEH ! hail -! -REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: ZQC ! V. C. for droplets -REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: ZRC ! mixing ration for droplets -REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: ZEC ! Coef of the charge diameter relation for droplets -REAL, DIMENSION(SIZE(XRTMIN)) :: ZRTMIN_E -! -! -!* 1. UPDATE E_x -! ---------- -! -IF (PRESENT(ZEC)) ZEC(:) = 0. -ZER(:) = 0. -ZEI(:) = 0. -ZES(:) = 0. -ZEG(:) = 0. -ZRTMIN_E(:) = XRTMIN(:) / ZDUM -! -!* 1.1 for cloud droplets -! -IF (PRESENT(ZEC) .AND. PRESENT(ZQC) .AND. PRESENT(ZRC)) THEN - WHERE (ZRC(:) > ZRTMIN_E(2)) - ZEC(:) = ZDUM * ZRHODREF(:) * ZQC(:) / XFQUPDC - ZEC(:) = SIGN( MIN(ABS(ZEC(:)), XECMAX), ZEC(:)) - ENDWHERE -END IF -! -!* 1.2 for raindrops -! -WHERE (ZRR(:) > ZRTMIN_E(3) .AND. ZLBDAR(:) > 0.) - ZER(:) = ZDUM * ZRHODREF(:) * ZQR(:) / (XFQUPDR * ZLBDAR(:)**(XCXR - XFR)) - ZER(:) = SIGN( MIN(ABS(ZER(:)), XERMAX), ZER(:)) -ENDWHERE -! -!* 1.3 for ice crystals -! -WHERE (ZRI(:) > ZRTMIN_E(4) .AND. ZCIT(:) > 0.0) - ZEI(:) = ZDUM * ZRHODREF(:) * ZQI(:) / & - ((ZCIT**(1 - XEXFQUPDI)) * XFQUPDI * (ZRHODREF(:) * & - ZDUM * ZRI(:))**XEXFQUPDI) - ZEI(:) = SIGN( MIN(ABS(ZEI(:)), XEIMAX), ZEI(:)) -ENDWHERE -! -!* 1.4 for snow -! -WHERE (ZRS(:) > ZRTMIN_E(5) .AND. ZLBDAS(:) > 0.) - ZES(:) = ZDUM * ZRHODREF(:) * ZQS(:) / (XFQUPDS * ZLBDAS(:)**(XCXS - XFS)) - ZES(:) = SIGN( MIN(ABS(ZES(:)), XESMAX), ZES(:)) -ENDWHERE -! -!* 1.5 for graupel -! -WHERE (ZRG(:) > ZRTMIN_E(6).AND. ZLBDAG(:) > 0.) - ZEG(:) = ZDUM * ZRHODREF(:) * ZQG(:) / (XFQUPDG * ZLBDAG(:)**(XCXG - XFG)) - ZEG(:) = SIGN( MIN(ABS(ZEG(:)), XEGMAX), ZEG(:)) -ENDWHERE -! -!* 1.6 for hail -! -IF (PRESENT(ZEH) .AND. PRESENT(ZQH) .AND. PRESENT(ZRH)) THEN - ZEH(:) = 0. - WHERE (ZRH(:) > ZRTMIN_E(7).AND. ZLBDAH(:) > 0.) - ZEH(:) = ZDUM * ZRHODREF(:) * ZQH(:) / (XFQUPDH * ZLBDAH(:)**(XCXH - XFH)) - ZEH(:) = SIGN( MIN(ABS(ZEH(:)), XEHMAX), ZEH(:)) - ENDWHERE -END IF -! -END SUBROUTINE ELEC_UPDATE_QD -! -!------------------------------------------------------------------------------- -! - SUBROUTINE ELEC_INI_NI_PROCESS -! -! Purpose : initialization for the non-inductive charging process -! -! GELEC(:,1) : logical variable for Ice-Snow process --> ELEC_IAGGS_B -! from RAIN_ICE_ELEC_SLOW routine -! GELEC(:,2) : logical variable for Ice-Graupel process --> ELEC_IDRYG_B -! from RAIN_ICE_ELEC_FAST_RG -! GELEC(:,3) : logical variable for Snow-Graupel process --> ELEC_SDRYG_B -! from RAIN_ICE_ELEC_FAST_RG -! -! -!* 0. DECLARATIONS -! ------------ -! -IMPLICIT NONE -! -! -!* 1. Gardiner et al. (1985) -! ---------------------- -! - IF (CNI_CHARGING == 'GARDI') THEN - ZDELTALWC(:) = 0. - ZFT(:) = 0. -! - GELEC(:,3) = ZZT(:) > (XTT - 40.) .AND. ZZT(:) < XTT - GELEC(:,1) = GELEC(:,3) .AND. & - ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. & - ZCIT(:) > 0.0 .AND. ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE - GELEC(:,2) = GELEC(:,3) .AND. & - ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. & - ZCIT(:) > 0.0 .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE - GELEC(:,3) = GELEC(:,3) .AND. & - ZRST(:) > XRTMIN_ELEC(5) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. & - ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE .AND. & - ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE - GELEC(:,4) = GELEC(:,1) .OR. GELEC(:,2) .OR. GELEC(:,3) -! - WHERE (GELEC(:,4)) - ZFT(:) = - 1.7E-5 * ((-21 / (XQTC - XTT)) * (ZZT(:) - XTT))**3 & - - 0.003 * ((-21 / (XQTC - XTT)) * (ZZT(:) - XTT))**2 & - - 0.05 * ((-21 / (XQTC - XTT)) * (ZZT(:) - XTT)) & - + 0.13 -! - ZDELTALWC(:) = (ZRCT(:) * ZRHODREF(:) * 1.E3) - XLWCC ! (g m^-3) - ENDWHERE - ENDIF -! -! -!* 2. Saunders et al. (1991) -! ---------------------- -! -!* 2.1 common to SAUN1 and SAUN2 -! - IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2') THEN - ZDQLWC(:) = 0. - ZEW(:) = 0. -! -! positive case is the default value - ZFQIAGGS(:) = XFQIAGGSP - ZFQIDRYGBS(:) = XFQIDRYGBSP - ZLBQSDRYGB1S(:) = XLBQSDRYGB1SP - ZLBQSDRYGB2S(:) = XLBQSDRYGB2SP - ZLBQSDRYGB3S(:) = XLBQSDRYGB3SP - ZSAUNIM(:) = XIMP !3.76 - ZSAUNIN(:) = XINP !2.5 - ZSAUNSK(:) = XSKP !52.8 - ZSAUNSM(:) = XSMP !0.44 - ZSAUNSN(:) = XSNP !2.5 -! -! LWC_crit - ZLWCC(:) = MIN( MAX( -0.49 + 6.64E-2*(XTT-ZZT(:)),0.22 ),1.1 ) ! (g m^-3) -! -! Mansell et al. (2005, JGR): droplet collection efficiency of the graupel ~ 0.6-1.0 - ZEW(:) = 0.8 * ZRCT(:) * ZRHODREF(:) * 1.E3 ! (g m^-3) -! - GELEC(:,3) = ZZT(:) > (XTT - 40.) .AND. ZZT(:) <= XTT .AND. & - ZEW(:) >= 0.01 .AND. ZEW(:) <= 10. - GELEC(:,1) = GELEC(:,3) .AND. & - ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. & - ZCIT(:) > 0.0 .AND. ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE - GELEC(:,2) = GELEC(:,3) .AND. & - ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. & - ZCIT(:) > 0.0 .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE - GELEC(:,3) = GELEC(:,3) .AND. & - ZRST(:) > XRTMIN_ELEC(5) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. & - ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE .AND. & - ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE -! - ALLOCATE (GSAUN(IMICRO)) - GSAUN(:) = .FALSE. -! -! For temperature lower than -30C and higher than -40C, value of q at -30C - GSAUN(:) = GELEC(:,1) .OR. GELEC(:,2) .OR. GELEC(:,3) - IGSAUN = COUNT (GSAUN(:)) -! - IF (IGSAUN > 0) THEN - CALL ELEC_INI_NI_SAUNQ(ZEW, ZDQLWC) -! - WHERE (ZDQLWC(:) < 0.) - ZFQIAGGS(:) = XFQIAGGSN - ZFQIDRYGBS(:) = XFQIDRYGBSN - ZLBQSDRYGB1S(:) = XLBQSDRYGB1SN - ZLBQSDRYGB2S(:) = XLBQSDRYGB2SN - ZLBQSDRYGB3S(:) = XLBQSDRYGB3SN - ZSAUNIM(:) = XIMN !2.54 - ZSAUNIN(:) = XINN !2.8 - ZSAUNSK(:) = XSKN !24. - ZSAUNSM(:) = XSMN !0.5 - ZSAUNSN(:) = XSNN !2.8 - ENDWHERE - ENDIF -! - DEALLOCATE( GSAUN ) - END IF -! -! -!* 3. Saunders and Peck (1998) -! - IF (CNI_CHARGING == 'SAP98') THEN - ZRAR_CRIT(:) = 0. -! -! compute the critical rime accretion rate - WHERE (ZZT(:) <= XTT .AND. ZZT(:) >= (XTT - 23.7)) ! Original from SAP98 - ZRAR_CRIT(:) = 1.0 + 7.93E-2 * (ZZT(:) - XTT) + & - 4.48E-2 * (ZZT(:) - XTT)**2 + & - 7.48E-3 * (ZZT(:) - XTT)**3 + & - 5.47E-4 * (ZZT(:) - XTT)**4 + & - 1.67E-5 * (ZZT(:) - XTT)**5 + & - 1.76E-7 * (ZZT(:) - XTT)**6 - END WHERE -! - WHERE (ZZT(:) < (XTT - 23.7) .AND. ZZT(:) > (XTT - 40.)) ! Added by Mansell - ZRAR_CRIT(:) = 3.4 * (1.0 - (ABS(ZZT(:) - XTT + 23.7) / & ! et al. (2005) - (-23.7 + 40.))**3.) - END WHERE -! - GELEC(:,3) = ZZT(:) >= (XTT - 40.) .AND. ZZT(:) <= XTT - GELEC(:,1) = GELEC(:,3) .AND. & - ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. & - ZCIT(:) > 0.0 .AND. ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE - GELEC(:,2) = GELEC(:,3) .AND. & - ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. & - ZCIT(:) > 0.0 .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE - GELEC(:,3) = GELEC(:,3) .AND. & - ZRST(:) > XRTMIN_ELEC(5) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. & - ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE .AND. & - ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE -! -!+++++++++ I - G collisions +++++++++ - ZSAUNIM_IG(:) = 0. -! -! positive case is the default value - ZSAUNIM_IG(:) = XIMP - ZSAUNIN_IG(:) = XINP -! -! Compute the Rime Accretion Rate - ZRAR(:) = 0. - ZVGMEAN(:) = 0. - WHERE (ZLBDAG(:) > 0. .AND. ZRCT(:) > 0.) - ZVGMEAN(:) = XVGCOEF * ZRHOCOR(:) * ZLBDAG(:)**(-XDG) - ZRAR(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * ZVGMEAN(:) * 1.E3 - END WHERE -! - GELEC(:,2) = GELEC(:,2) .AND. ZRAR(:) > 0.1 - GELEC(:,4) = GELEC(:,2) -! - IF (COUNT(GELEC(:,4)) .GT. 0) THEN -! -! compute the coefficients for I-G collisions - CALL ELEC_INI_NI_SAP98 (ZRAR, ZDQRAR_IG) -! - WHERE (ZDQRAR_IG(:) < 0.) - ZSAUNIM_IG(:) = XIMN - ZSAUNIN_IG(:) = XINN - ENDWHERE - ENDIF -! -!+++++++++ I - S collisions +++++++++ - ZDQRAR_IS(:) = 0. -! -! positive case is the default value - ZSAUNIM_IS(:) = XIMP - ZSAUNIN_IS(:) = XINP -! -! Compute the Rime Accretion Rate - ZRAR(:) = 0. - ZVSMEAN(:) = 0. -! - WHERE (ZLBDAS(:) > 0. .AND. ZRCT(:) > 0.) - ZVSMEAN(:) = XVSCOEF * ZRHOCOR(:) * ZLBDAS(:)**(-XDS) - ZRAR(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * ZVSMEAN(:) * 1.E3 - END WHERE -! - GELEC(:,1) = GELEC(:,1) .AND. ZRAR(:) > 0.1 - GELEC(:,4) = GELEC(:,1) -! - IF (COUNT(GELEC(:,4)) .GT. 0) THEN -! compute the coefficients for I-S collisions - CALL ELEC_INI_NI_SAP98 (ZRAR, ZDQRAR_IS) -! - WHERE (ZDQRAR_IS(:) < 0.) - ZSAUNIM_IS(:) = XIMN - ZSAUNIN_IS(:) = XINN - ENDWHERE - ENDIF -! -!+++++++++ S - G collisions +++++++++ - ZDQRAR_SG(:) = 0. -! -! positive case is the default value - ZSAUNSK_SG(:) = XSKP - ZSAUNSM_SG(:) = XSMP - ZSAUNSN_SG(:) = XSNP -! -! Compute the Rime Accretion Rate - ZRAR(:) = 0. -! - WHERE (ZVSMEAN(:) > 0. .AND. ZVGMEAN(:) > 0.) - ZRAR(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * ABS(ZVGMEAN(:) - ZVSMEAN(:)) * 1.E3 - END WHERE -! - GELEC(:,3) = GELEC(:,3) .AND. ZRAR(:) > 0.1 - GELEC(:,4) = GELEC(:,3) -! - IF( COUNT(GELEC(:,4)) .GT. 0) THEN -! -! compute the coefficients for S-G collisions - CALL ELEC_INI_NI_SAP98 (ZRAR, ZDQRAR_SG) -! - WHERE (ZDQRAR_SG(:) < 0.) - ZSAUNSK_SG(:) = XSKN - ZSAUNSM_SG(:) = XSMN - ZSAUNSN_SG(:) = XSNN - ENDWHERE - ENDIF - END IF -! -!* 4. Brooks et al. (1997) without / with anomalies -! - IF (CNI_CHARGING == 'BSMP1' .OR. CNI_CHARGING == 'BSMP2') THEN - - ALLOCATE (GSAUN(IMICRO)) -! -! compute the critical rime accretion rate - WHERE (ZZT(:) > (XTT - 10.7)) - ZRAR_CRIT(:) = 0.66 - END WHERE - WHERE (ZZT(:) <= (XTT - 10.7) .AND. ZZT(:) >= (XTT - 23.7)) - ZRAR_CRIT(:) = -1.47 - 0.2 * (ZZT(:) - XTT) - END WHERE - WHERE (ZZT(:) < (XTT - 23.7) .AND. ZZT(:) > (XTT - 40.)) - ZRAR_CRIT(:) = 3.3 - END WHERE -! - GELEC(:,3) = ZZT(:) > (XTT - 40.) .AND. ZZT(:) <= XTT .AND. & - ZEW(:) >= 0.01 .AND. ZEW(:) <= 10. - GELEC(:,1) = GELEC(:,3) .AND. & - ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. & - ZCIT(:) > 0.0 .AND. ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE - GELEC(:,2) = GELEC(:,3) .AND. & - ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. & - ZCIT(:) > 0.0 .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE - GELEC(:,3) = GELEC(:,3) .AND. & - ZRST(:) > XRTMIN_ELEC(5) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. & - ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE .AND. & - ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE -! -!+++++++++ I - S collisions +++++++++ - ZDQRAR_IS(:) = 0. -! -! positive case is the default value - ZSAUNIM_IS(:) = XIMP - ZSAUNIN_IS(:) = XINP -! - GSAUN(:) = .FALSE. -! -! Compute the Rime Accretion Rate - ZRAR(:) = 0. - ZVSMEAN(:) = 0. -! - WHERE (ZLBDAS(:) > 0. .AND. ZRCT(:) > 0.) - ZVSMEAN(:) = XVSCOEF * ZRHOCOR(:) * ZLBDAS(:)**(-XDS) - ZRAR(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * ZVSMEAN(:) * 1.E3 - END WHERE -! - GELEC(:,1) = GELEC(:,1) .AND. ZRAR(:) > 0.1 - GSAUN(:) = GELEC(:,1) - IGSAUN = COUNT (GSAUN(:)) -! - IF (IGSAUN .GT. 0) THEN - ZEW(:) = ZRAR(:) / 3. -! - CALL ELEC_INI_NI_SAUNQ (ZEW, ZDQRAR_IS) -! - WHERE (ZDQRAR_IS(:) < 0.) - ZSAUNIM_IS(:) = XIMN - ZSAUNIN_IS(:) = XINN - ENDWHERE - ENDIF -! -!+++++++++ I - G collisions +++++++++ - ZDQRAR_IG(:) = 0. -! -! positive case is the default value - ZSAUNIM_IG(:) = XIMP - ZSAUNIN_IG(:) = XINP -! - GSAUN(:) = .FALSE. -! -! Compute the Rime Accretion Rate - ZRAR(:) = 0. - ZVGMEAN(:) = 0. -! - WHERE (ZLBDAG(:) > 0. .AND. ZRCT(:) > 0.) - ZVGMEAN(:) = XVGCOEF * ZRHOCOR(:) * ZLBDAG(:)**(-XDG) - ZRAR(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * ZVGMEAN(:) * 1.E3 - END WHERE -! - GELEC(:,2) = GELEC(:,2) .AND. ZRAR(:) > 0.1 - GSAUN(:) = GELEC(:,2) - IGSAUN = COUNT (GSAUN(:)) -! - IF (IGSAUN .GT. 0) THEN - ZEW(:) = ZRAR(:) / 3. - CALL ELEC_INI_NI_SAUNQ (ZEW, ZDQRAR_IG) -! - WHERE (ZDQRAR_IG(:) < 0.) - ZSAUNIM_IG(:) = XIMN - ZSAUNIN_IG(:) = XINN - ENDWHERE - ENDIF -! -!+++++++++ S - G collisions +++++++++ - ZDQRAR_SG(:) = 0. -! -! positive case is the default value - ZSAUNSK_SG(:) = XSKP - ZSAUNSM_SG(:) = XSMP - ZSAUNSN_SG(:) = XSNP -! - GSAUN(:) = .FALSE. -! -! Compute the Rime Accretion Rate - ZRAR(:) = 0. -! - WHERE (ZVSMEAN(:) > 0. .AND. ZVGMEAN(:) > 0.) - ZRAR(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * ABS(ZVGMEAN(:) - ZVSMEAN(:)) * 1.E3 - END WHERE -! - GELEC(:,3) = GELEC(:,3) .AND. ZRAR(:) > 0.1 - GSAUN(:) = GELEC(:,3) - IGSAUN = COUNT (GSAUN(:)) -! - IF (IGSAUN .GT. 0) THEN - ZEW(:) = ZRAR(:) / 3. - CALL ELEC_INI_NI_SAUNQ (ZEW, ZDQRAR_SG) -! - WHERE (ZDQRAR_SG(:) < 0.) - ZSAUNSK_SG(:) = XSKN - ZSAUNSM_SG(:) = XSMN - ZSAUNSN_SG(:) = XSNN - ENDWHERE - ENDIF -! - DEALLOCATE( GSAUN ) - END IF -! -! -!* 5. Takahashi (1978) -! - IF (CNI_CHARGING == 'TAKAH') THEN - ZDQLWC(:) = 0. -! - ZEW(:) = ZRCT(:) * ZRHODREF(:) * 1.E3 ! (g m^-3) -! - GELEC(:,3) = ZZT(:) > (XTT - 40.) .AND. ZZT(:) <= XTT .AND. & - ZEW(:) >= 0.01 .AND. ZEW(:) <= 10. - GELEC(:,1) = GELEC(:,3) .AND. & - ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. & - ZCIT(:) > 0.0 .AND. ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE - GELEC(:,2) = GELEC(:,3) .AND. & - ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. & - ZCIT(:) > 0.0 .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE - GELEC(:,3) = GELEC(:,3) .AND. & - ZRST(:) > XRTMIN_ELEC(5) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. & - ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE .AND. & - ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE -! - ALLOCATE (GTAKA(IMICRO)) - GTAKA(:) = .FALSE. -! -! For temperature lower than -30C and higher than -40C, value of q at -30C - GTAKA(:) = GELEC(:,1) .OR. GELEC(:,2) .OR. GELEC(:,3) - IGTAKA = COUNT (GTAKA(:)) -! - IF (IGTAKA > 0) THEN - CALL ELEC_INI_NI_TAKAH(ZEW, ZDQLWC, XMANSELL) - ENDIF -! - DEALLOCATE( GTAKA ) - ENDIF -! -! -!* 6. Takahashi with EW (Tsenova and Mitzeva, 2009) -! - IF (CNI_CHARGING == 'TEEWC') THEN - ZDQLWC(:) = 0. -! -! positive case is the default value - ZFQIAGGS(:) = XFQIAGGSP_TAK - ZFQIDRYGBS(:) = XFQIDRYGBSP_TAK - ZLBQSDRYGB1S(:) = XLBQSDRYGB1SP - ZLBQSDRYGB2S(:) = XLBQSDRYGB2SP - ZLBQSDRYGB3S(:) = XLBQSDRYGB3SP - ZSAUNIM(:) = XIMP !3.76 - ZSAUNIN(:) = XINP !2.5 - ZSAUNSK(:) = XSKP_TAK !6.5 - ZSAUNSM(:) = XSMP !0.44 - ZSAUNSN(:) = XSNP !2.5 -! -! Compute the effective water content - ZEW(:) = 0. -! - WHERE (ZLBDAG(:) > 0. .AND. ZRCT(:) > 0.) - ZEW(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * 1.E3 - END WHERE -! - GELEC(:,3) = ZZT(:) >= (XTT - 40.) .AND. ZZT(:) <= XTT .AND. & - ZEW(:) >= 0.01 .AND. ZEW(:) <= 10. - GELEC(:,1) = GELEC(:,3) .AND. & - ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. & - ZCIT(:) > 0.0 .AND. ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE - GELEC(:,2) = GELEC(:,3) .AND. & - ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. & - ZCIT(:) > 0.0 .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE - GELEC(:,3) = GELEC(:,3) .AND. & - ZRST(:) > XRTMIN_ELEC(5) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. & - ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE .AND. & - ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE -! - ALLOCATE (GTAKA(IMICRO)) - GTAKA(:) = .FALSE. -! -! For temperature lower than -30C and higher than -40C, value of q at -30C - GTAKA(:) = GELEC(:,1) .OR. GELEC(:,2) .OR. GELEC(:,3) - IGTAKA = COUNT (GTAKA(:)) -! - IF (IGTAKA > 0) THEN - CALL ELEC_INI_NI_TAKAH(ZEW, ZDQLWC, XTAKA_TM) -! - WHERE (ZDQLWC(:) < 0.) - ZFQIAGGS(:) = XFQIAGGSN_TAK - ZFQIDRYGBS(:) = XFQIDRYGBSN_TAK - ZLBQSDRYGB1S(:) = XLBQSDRYGB1SN - ZLBQSDRYGB2S(:) = XLBQSDRYGB2SN - ZLBQSDRYGB3S(:) = XLBQSDRYGB3SN - ZSAUNIM(:) = XIMN !2.54 - ZSAUNIN(:) = XINN !2.8 - ZSAUNSK(:) = XSKN_TAK !2.0 - ZSAUNSM(:) = XSMN !0.5 - ZSAUNSN(:) = XSNN !2.8 - ENDWHERE - ENDIF -! - DEALLOCATE( GTAKA ) - ENDIF -! -! -!* 7. Takahashi with RAR (Tsenova and Mitzeva, 2011) -! - IF (CNI_CHARGING == 'TERAR') THEN -! - ALLOCATE (GTAKA(IMICRO)) -! - GELEC(:,3) = ZZT(:) >= (XTT - 40.) .AND. ZZT(:) <= XTT - GELEC(:,1) = GELEC(:,3) .AND. & - ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. & - ZCIT(:) > 0.0 .AND. ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE - GELEC(:,2) = GELEC(:,3) .AND. & - ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. & - ZCIT(:) > 0.0 .AND. ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE - GELEC(:,3) = GELEC(:,3) .AND. & - ZRST(:) > XRTMIN_ELEC(5) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. & - ZLBDAS(:) > 0. .AND. ZLBDAS(:) < XLBDAS_MAXE .AND. & - ZLBDAG(:) > 0. .AND. ZLBDAG(:) < XLBDAG_MAXE -! -!+++++++++ I - S collisions +++++++++ - ZDQRAR_IS(:) = 0. -! -! positive case is the default value - ZSAUNIM_IS(:) = XIMP - ZSAUNIN_IS(:) = XINP -! - GTAKA(:) = .FALSE. -! -! Compute the Rime Accretion Rate - ZRAR(:) = 0. - ZVSMEAN(:) = 0. -! - WHERE (ZLBDAS(:) > 0. .AND. ZRCT(:) > 0.) - ZVSMEAN(:) = XVSCOEF * ZRHOCOR(:) * ZLBDAS(:)**(-XDS) - ZRAR(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * ZVSMEAN(:) * 1.E3 - END WHERE -! - GELEC(:,1) = GELEC(:,1) .AND. ZRAR(:) > 0.01 .AND. ZRAR(:) <= 80. - GTAKA(:) = GELEC(:,1) -! - IGTAKA = COUNT (GTAKA(:)) -! - IF (IGTAKA > 0) THEN - ZEW(:) = ZRAR(:) / 8. - CALL ELEC_INI_NI_TAKAH(ZEW, ZDQRAR_IS, XTAKA_TM) -! - WHERE (ZDQRAR_IS(:) < 0.) - ZSAUNIM_IS(:) = XIMN - ZSAUNIN_IS(:) = XINN - ENDWHERE - END IF -! -! -!+++++++++ I - G collisions +++++++++ - ZDQRAR_IG(:) = 0. -! -! positive case is the default value - ZSAUNIM_IG(:) = XIMP - ZSAUNIN_IG(:) = XINP -! - GTAKA(:) = .FALSE. -! -! Compute the Rime Accretion Rate - ZRAR(:) = 0. - ZVGMEAN(:) = 0. -! - WHERE (ZLBDAG(:) > 0. .AND. ZRCT(:) > 0.) - ZVGMEAN(:) = XVGCOEF * ZRHOCOR(:) * ZLBDAG(:)**(-XDG) - ZRAR(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * ZVGMEAN(:) * 1.E3 - END WHERE -! - GELEC(:,2) = GELEC(:,2) .AND. ZRAR(:) > 0.01 .AND. ZRAR(:) <= 80. - GTAKA(:) = GELEC(:,2) -! - IGTAKA = COUNT (GTAKA(:)) -! - IF (IGTAKA > 0) THEN - ZEW(:) = ZRAR(:) / 8. - CALL ELEC_INI_NI_TAKAH(ZEW, ZDQRAR_IG, XTAKA_TM) -! - WHERE (ZDQRAR_IG(:) < 0.) - ZSAUNIM_IG(:) = XIMN - ZSAUNIN_IG(:) = XINN - ENDWHERE - ENDIF -! -!+++++++++ S - G collisions +++++++++ - ZDQRAR_SG(:) = 0. -! -! positive case is the default value - ZSAUNSK_SG(:) = XSKP_TAK - ZSAUNSM_SG(:) = XSMP - ZSAUNSN_SG(:) = XSNP -! - GTAKA(:) = .FALSE. -! -! Compute the Rime Accretion Rate - ZRAR(:) = 0. -! - WHERE (ZVSMEAN(:) > 0. .AND. ZVGMEAN(:) > 0.) - ZRAR(:) = 0.8 * ZRHODREF(:) * ZRCT(:) * ABS(ZVGMEAN(:) - ZVSMEAN(:)) * 1.E3 - END WHERE -! - GELEC(:,3) = GELEC(:,3) .AND. ZRAR(:) > 0.01 .AND. ZRAR(:) <= 80 - GTAKA(:) = GELEC(:,3) - IGTAKA = COUNT (GTAKA(:)) -! - IF (IGTAKA > 0) THEN - ZEW(:) = ZRAR(:) / 8. - CALL ELEC_INI_NI_TAKAH(ZEW, ZDQRAR_SG, XTAKA_TM) -! - WHERE (ZDQRAR_SG(:) < 0.) - ZSAUNSK_SG(:) = XSKN_TAK - ZSAUNSM_SG(:) = XSMN - ZSAUNSN_SG(:) = XSNN - ENDWHERE - ENDIF -! - DEALLOCATE( GTAKA ) - END IF -! -END SUBROUTINE ELEC_INI_NI_PROCESS -! -!------------------------------------------------------------------------------- -! - SUBROUTINE ELEC_INI_NI_SAP98(ZRAR, ZDQRAR_AUX) -! -IMPLICIT NONE -! -REAL, DIMENSION(:), INTENT(IN) :: ZRAR -REAL, DIMENSION(:), INTENT(INOUT) :: ZDQRAR_AUX ! q= f(RAR,T) in Saunders and - ! Peck's equation -! - ZDQRAR_AUX(:) = 0. -! -! positive region : Mansell et al., 2005 - WHERE (GELEC(:,4) .AND. ZRAR(:) > ZRAR_CRIT(:)) - ZDQRAR_AUX(:) = MAX(0., 6.74 * (ZRAR(:) - ZRAR_CRIT(:)) * 1.E-15) - ENDWHERE -! -! negative region : Mansell et al. 2005 - WHERE (GELEC(:,4) .AND. ZRAR(:) < ZRAR_CRIT(:)) - ZDQRAR_AUX(:) = MIN(0., 3.9 * (ZRAR_CRIT(:) - 0.1) * & - (4.0 * ((ZRAR(:) - (ZRAR_CRIT(:) + 0.1) / 2.) / & - (ZRAR_CRIT(:) - 0.1))**2 - 1.) * 1.E-15) - ENDWHERE -! -END SUBROUTINE ELEC_INI_NI_SAP98 -! -!------------------------------------------------------------------------------- -! - SUBROUTINE ELEC_INI_NI_SAUNQ(ZEW, ZDQLWC_AUX) -! -IMPLICIT NONE -! -REAL, DIMENSION(:), INTENT(IN) :: ZEW -REAL, DIMENSION(:), INTENT(INOUT) :: ZDQLWC_AUX ! q= f(RAR or EW,T) in Saunders - !... equation -! -! For temperature lower than -30C and higher than -40C, value of q at -30C -! - ALLOCATE ( IVEC1(IGSAUN) ) - ALLOCATE ( IVEC2(IGSAUN) ) - ALLOCATE ( ZVEC1(IGSAUN) ) - ALLOCATE ( ZVEC2(IGSAUN) ) - ALLOCATE ( ZDQLWC_OPT(IGSAUN) ) -! - ZDQLWC_OPT(:) = 0. - IVEC1(:) = 0 - IVEC2(:) = 0 -! - ZVEC1(:) = PACK( ZZT(:), MASK=GSAUN(:)) - ZVEC2(:) = PACK( ZEW(:), MASK=GSAUN(:)) - ZDQLWC_OPT(:) = PACK( ZDQLWC_AUX(:), MASK=GSAUN ) -! -! Temperature index (0C --> -40C) - ZVEC1(1:IGSAUN) = MAX( 1.00001, MIN( REAL(NIND_TEMP)-0.00001, & - (ZVEC1(1:IGSAUN) - XTT - 1.)/(-1.) ) ) - IVEC1(1:IGSAUN) = INT( ZVEC1(1:IGSAUN) ) - ZVEC1(1:IGSAUN) = ZVEC1(1:IGSAUN) - REAL(IVEC1(1:IGSAUN)) -! -! LWC index (0.01 g.m^-3 --> 10 g.m^-3) - WHERE (ZVEC2(:) >= 0.01 .AND. ZVEC2(:) < 0.1) - ZVEC2(:) = MAX( 1.00001, MIN( REAL(10)-0.00001, & - ZVEC2(:) * 100. )) - IVEC2(:) = INT(ZVEC2(:)) - ZVEC2(:) = ZVEC2(:) - REAL(IVEC2(:)) - ENDWHERE -! - WHERE (ZVEC2(:) >= 0.1 .AND. ZVEC2(:) < 1. .AND. IVEC2(:) == 0) - ZVEC2(:) = MAX( 10.00001, MIN( REAL(19)-0.00001, & - ZVEC2(:) * 10. + 9. ) ) - IVEC2(:) = INT(ZVEC2(:)) - ZVEC2(:) = ZVEC2(:) - REAL(IVEC2(:)) - ENDWHERE -! - WHERE ((ZVEC2(:) >= 1.) .AND. ZVEC2(:) <= 10.) - ZVEC2(:) = MAX( 19.00001, MIN( REAL(NIND_LWC)-0.00001, & - ZVEC2(:) + 18. ) ) - IVEC2(:) = INT(ZVEC2(:)) - ZVEC2(:) = ZVEC2(:) - REAL(IVEC2(:)) - ENDWHERE -! -! Interpolate XSAUNDER - ZDQLWC_OPT(:) = BI_LIN_INTP_V( XSAUNDER, IVEC2, IVEC1, ZVEC2, ZVEC1, & - IGSAUN ) - ZDQLWC_AUX(:) = UNPACK( ZDQLWC_OPT(:), MASK=GSAUN, FIELD=0.0 ) -! - DEALLOCATE( IVEC1 ) - DEALLOCATE( IVEC2 ) - DEALLOCATE( ZVEC1 ) - DEALLOCATE( ZVEC2 ) - DEALLOCATE( ZDQLWC_OPT ) -! -END SUBROUTINE ELEC_INI_NI_SAUNQ -! -!------------------------------------------------------------------------------- -! - SUBROUTINE ELEC_INI_NI_TAKAH(ZEW, ZDQTAKA_AUX, XTAKA_AUX) -! -IMPLICIT NONE -! -REAL, DIMENSION(IMICRO) :: ZEW -REAL, DIMENSION(IMICRO) :: ZDQTAKA_AUX -REAL, DIMENSION(NIND_LWC+1,NIND_TEMP+1) :: XTAKA_AUX !XMANSELL or XTAKA_TM) -! -! - ALLOCATE ( IVEC1(IGTAKA) ) - ALLOCATE ( IVEC2(IGTAKA) ) - ALLOCATE ( ZVEC1(IGTAKA) ) - ALLOCATE ( ZVEC2(IGTAKA) ) - ALLOCATE ( ZDQTAKA_OPT(IGTAKA) ) - - ZDQTAKA_OPT(:) = 0. - IVEC1(:) = 0 - IVEC2(:) = 0 -! - ZVEC1(:) = PACK( ZZT(:), MASK=GTAKA ) - ZVEC2(:) = PACK( ZEW(:), MASK=GTAKA ) - ZDQTAKA_OPT(:) = PACK( ZDQTAKA_AUX(:), MASK=GTAKA ) -! -! Temperature index (0C --> -40C) - ZVEC1(1:IGTAKA) = MAX( 1.00001, MIN( REAL(NIND_TEMP)-0.00001, & - (ZVEC1(1:IGTAKA) - XTT - 1.)/(-1.) ) ) - IVEC1(1:IGTAKA) = INT( ZVEC1(1:IGTAKA) ) - ZVEC1(1:IGTAKA) = ZVEC1(1:IGTAKA) - REAL(IVEC1(1:IGTAKA)) -! -! LWC index (0.01 g.m^-3 --> 10 g.m^-3) - WHERE (ZVEC2(:) >= 0.01 .AND. ZVEC2(:) < 0.1) - ZVEC2(:) = MAX( 1.00001, MIN( REAL(10)-0.00001, & - ZVEC2(:) * 100. )) - IVEC2(:) = INT(ZVEC2(:)) - ZVEC2(:) = ZVEC2(:) - REAL(IVEC2(:)) - ENDWHERE -! - WHERE (ZVEC2(:) >= 0.1 .AND. ZVEC2(:) < 1. .AND. IVEC2(:) == 0) - ZVEC2(:) = MAX( 10.00001, MIN( REAL(19)-0.00001, & - ZVEC2(:) * 10. + 9. ) ) - IVEC2(:) = INT(ZVEC2(:)) - ZVEC2(:) = ZVEC2(:) - REAL(IVEC2(:)) - ENDWHERE -! - WHERE (ZVEC2(:) >= 1. .AND. ZVEC2(:) <= 10.) - ZVEC2(:) = MAX( 19.00001, MIN( REAL(NIND_LWC)-0.00001, & - ZVEC2(:) + 18. ) ) - IVEC2(:) = INT(ZVEC2(:)) - ZVEC2(:) = ZVEC2(:) - REAL(IVEC2(:)) - ENDWHERE -! -! Interpolate XMANSELL or XTAKA_TM - ZDQTAKA_OPT(:) = BI_LIN_INTP_V( XTAKA_AUX, IVEC2, IVEC1, ZVEC2, ZVEC1, & - IGTAKA ) - ZDQTAKA_AUX(:) = UNPACK( ZDQTAKA_OPT(:), MASK=GTAKA, FIELD=0.0 ) -! - DEALLOCATE( IVEC1 ) - DEALLOCATE( IVEC2 ) - DEALLOCATE( ZVEC1 ) - DEALLOCATE( ZVEC2 ) - DEALLOCATE( ZDQTAKA_OPT ) -! -END SUBROUTINE ELEC_INI_NI_TAKAH -! -!------------------------------------------------------------------------------- -! - SUBROUTINE ELEC_IAGGS_B() -! -! Purpose : compute charge separation process during the collision -! between ice and snow -! -!* 0. DECLARATIONS -! ------------ -! -IMPLICIT NONE -! -!* 1. Collision efficiency -! - ZCOLIS(:) = XCOLIS * EXP(XCOLEXIS * (ZZT(:) - XTT)) -! -!* 2. Charging process following Helsdon and Farley (1987) -! - IF (CNI_CHARGING == 'HELFA') THEN - ZWQ1(:,7) = 0. -! - WHERE (ZRIS(:) > XRTMIN_ELEC(4) .AND. ZCIT(:) > 0.0 .AND. & - ZRIT(:) > XRTMIN_ELEC(4) .AND. & - ZRST(:) > XRTMIN_ELEC(5)) - ZWQ1(:,7) = XFQIAGGSBH * ZZW(:) * ZCIT(:) / ZRIT(:) - ZWQ1(:,7) = ZWQ1(:,7) * (1. - ZCOLIS(:)) / ZCOLIS(:) -! -! Temperature dependance of the charge transferred - ZWQ1(:,7) = ZWQ1(:,7) * (ZZT(:) - XQTC) / ABS(ZZT(:) - XQTC) - ZWQ1(:,7) = ZWQ1(:,7) / ZRHODREF(:) -! - ZQSS(:) = ZQSS(:) + ZWQ1(:,7) - ZQIS(:) = ZQIS(:) - ZWQ1(:,7) - END WHERE - END IF -! -!* 3. Charging process following Gardiner et al. (1985) -! - IF (CNI_CHARGING == 'GARDI') THEN - ZWQ1(:,7) = 0. - WHERE (GELEC(:,1) .AND. ZDELTALWC(:) > 0. .AND. & - ZRIS(:) > ZRSMIN_ELEC(4) .AND. ZRSS(:) > ZRSMIN_ELEC(5)) - ZWQ1(:,7) = XFQIAGGSBG * (1 - ZCOLIS(:)) * & - ZRHODREF(:)**(-4. * XCEXVT + 4. / XBI) * & - ZCIT(:)**(1 - 4. / XBI) * & - ZDELTALWC(:) * ZFT(:) * & - ZLBDAS(:)**(XCXS - 2. - 4. * XDS) * & - (XAI * MOMG(XALPHAI, XNUI, XBI) / & - ZRIT(:))**(-4 / XBI) -! -! Dq is limited to XLIM_NI_IS - ZLIMIT(:) = XLIM_NI_IS * ZZW(:) * ZCIT(:) * & - (1 - ZCOLIS(:)) / (ZRIT(:) * ZCOLIS(:)) - ZWQ1(:,7) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,7)) ), ZWQ1(:,7) ) - ZWQ1(:,7) = ZWQ1(:,7) / ZRHODREF(:) - ENDWHERE -! -! For temperatures lower than -30C --> linear interpolation - WHERE (ZWQ1(:,7) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.)) - ZWQ1(:,7) = ZWQ1(:,7) * (ZZT(:) - XTT + 40.) / 10. - ENDWHERE -! - ZQSS(:) = ZQSS(:) + ZWQ1(:,7) - ZQIS(:) = ZQIS(:) - ZWQ1(:,7) - END IF -! -!* 4. Charging process based on EW: SAUN1/SAUN2, TEEWC -!* following Saunders et al. (1991), Takahashi via Tsenova and Mitzeva (2009) -! - IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. & - CNI_CHARGING == 'TEEWC') THEN - ZWQ1(:,7) = 0. -! - WHERE (GELEC(:,1) .AND. ZRIS(:) > ZRSMIN_ELEC(4) .AND. & - ZRSS(:) > ZRSMIN_ELEC(5) .AND. ZDQLWC(:) /= 0.) - ZWQ1(:,7) = XFQIAGGSBS * (1 - ZCOLIS(:)) * & - ZRHOCOR(:)**(1 + ZSAUNIN(:)) * & - ZFQIAGGS(:) * ZDQLWC(:) * & - ZCIT(:)**(1 - ZSAUNIM(:) / XBI) * & - ZLBDAS(:)**(XCXS - 2.- XDS * (1. + ZSAUNIN(:))) * & - (ZRHODREF(:) * ZRIT(:) / XAIGAMMABI)**(ZSAUNIM(:) / XBI) -! -! Dq is limited to XLIM_NI_IS - ZLIMIT(:) = XLIM_NI_IS * ZZW(:) * ZCIT(:) * & - (1 - ZCOLIS(:)) / (ZRIT(:) * ZCOLIS(:)) - ZWQ1(:,7) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,7)) ), ZWQ1(:,7) ) - ZWQ1(:,7) = ZWQ1(:,7) / ZRHODREF(:) - ENDWHERE -! -! For temperatures lower than -30C --> linear interpolation - WHERE (ZWQ1(:,7) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.)) - ZWQ1(:,7) = ZWQ1(:,7) * (ZZT(:) - XTT + 40.) / 10. - ENDWHERE -! - ZQSS(:) = ZQSS(:) + ZWQ1(:,7) - ZQIS(:) = ZQIS(:) - ZWQ1(:,7) -! - END IF -! -!* 5. Charging process based on RAR (=EW*V): SAP98, BSMP1/BSMP2, TERAR -!* following Saunders and Peck (1998) or -!* Brooks et al., 1997 (with/out anomalies) or -!* Takahashi via Tsenova and Mitzeva (2011) -! - IF (CNI_CHARGING == 'SAP98' .OR. CNI_CHARGING == 'BSMP1' .OR. & - CNI_CHARGING == 'BSMP2' .OR. CNI_CHARGING == 'TERAR') THEN -! - IF (CNI_CHARGING /= 'TERAR') THEN - ZFQIAGGS(:) = XFQIAGGSP - WHERE (ZDQRAR_IS(:) < 0.) - ZFQIAGGS(:) = XFQIAGGSN - ENDWHERE - ELSE - ZFQIAGGS(:) = XFQIAGGSP_TAK - WHERE (ZDQRAR_IS(:) <0.) - ZFQIAGGS(:) = XFQIAGGSN_TAK - ENDWHERE - ENDIF -! - ZWQ1(:,7) = 0. -! - WHERE (GELEC(:,1) .AND. ZDQRAR_IS(:) /= 0. .AND. & - ZRIS(:) > ZRSMIN_ELEC(4) .AND. ZRSS(:) > ZRSMIN_ELEC(5)) - ZWQ1(:,7) = XFQIAGGSBS * (1 - ZCOLIS(:)) * & - ZRHOCOR(:)**(1 + ZSAUNIN_IS(:)) * & - ZFQIAGGS(:) * ZDQRAR_IS(:) * & - ZCIT(:)**(1 - ZSAUNIM_IS(:) / XBI) * & - ZLBDAS(:)**(XCXS - 2.- XDS * (1. + ZSAUNIN_IS(:))) * & - (ZRHODREF(:) * ZRIT(:)/XAIGAMMABI)**(ZSAUNIM_IS(:) / XBI) -! -! Dq is limited to XLIM_NI_IS - ZLIMIT(:) = XLIM_NI_IS * ZZW(:) * ZCIT(:) * & - (1 - ZCOLIS(:)) / (ZRIT(:) * ZCOLIS(:)) - ZWQ1(:,7) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,7)) ), ZWQ1(:,7) ) - ZWQ1(:,7) = ZWQ1(:,7) / ZRHODREF(:) - ENDWHERE -! -! For temperatures lower than -30C --> linear interpolation - WHERE (ZWQ1(:,7) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.)) - ZWQ1(:,7) = ZWQ1(:,7) * (ZZT(:) - XTT + 40.) / 10. - ENDWHERE -! - ZQSS(:) = ZQSS(:) + ZWQ1(:,7) - ZQIS(:) = ZQIS(:) - ZWQ1(:,7) - END IF -! -!* 6. Charging process following Takahashi (1978) -! - IF (CNI_CHARGING == 'TAKAH') THEN - ZWQ1(:,7) = 0. - ZLIMIT(:) = 0. -! - WHERE (GELEC(:,1) .AND. ZRIS(:) > ZRSMIN_ELEC(4) .AND. & - ZRSS(:) > ZRSMIN_ELEC(5) .AND. ZDQLWC(:) /= 0.) - ZWQ1(:,7) = XFQIAGGSBT1 * (1.0 - ZCOLIS(:)) * ZRHOCOR(:) * & - ZCIT(:) * ZLBDAS(:)**XCXS * ZDQLWC(:) * & - MIN( XFQIAGGSBT2 / (ZLBDAS(:)**(2. + XDS)) , & - XFQIAGGSBT3 * ZRHOCOR(:) * ZRHODREF(:)**(2./XBI) * & - ZRIT(:)**(2. / XBI) / & - (ZCIT(:)**(2. / XBI) * ZLBDAS(:)**(2. + 2. * XDS))) -! -! Dq is limited to XLIM_NI_IS - ZLIMIT(:) = XLIM_NI_IS * ZZW(:) * ZCIT(:) * & - (1 - ZCOLIS(:)) / (ZRIT(:) * ZCOLIS(:)) - ZWQ1(:,7) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,7)) ), ZWQ1(:,7) ) - ZWQ1(:,7) = ZWQ1(:,7) / ZRHODREF(:) - ENDWHERE -! -! For temperatures lower than -30C --> linear interpolation - WHERE (ZWQ1(:,7) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.)) - ZWQ1(:,7) = ZWQ1(:,7) * (ZZT(:) - XTT + 40.) / 10. - ENDWHERE -! - ZQSS(:) = ZQSS(:) + ZWQ1(:,7) - ZQIS(:) = ZQIS(:) - ZWQ1(:,7) - END IF -! -! -END SUBROUTINE ELEC_IAGGS_B -! -!------------------------------------------------------------------------------- -! - SUBROUTINE ELEC_IDRYG_B() -! -! Purpose : compute charge separation process during the dry collision -! between ice and graupeln -! -!* 0. DECLARATIONS -! ------------ -! -IMPLICIT NONE -! -! -!* 1. COMPUTE THE COLLECTION EFFICIENCY -! --------------------------------- -! - ZCOLIG(:) = XCOLIG * EXP(XCOLEXIG * (ZZT(:) - XTT)) -! -!* 2. COMPUTE THE CHARGE SEPARATION DURING IDRYG_BOUN -! ----------------------------------------------- -! -!* 2.1 Helsdon and Farley (1987) -! - IF (CNI_CHARGING == 'HELFA') THEN - ZWQ1(:,3) = 0. - WHERE (ZRIS(:) > ZRSMIN_ELEC(4) .AND. ZCIT(:) > 0.0 .AND. & - ZRIT(:) > XRTMIN_ELEC(4) .AND. ZRGT(:) > XRTMIN_ELEC(6) .AND. & - ZRGS(:) > ZRSMIN_ELEC(6)) - ZWQ1(:,3) = XHIDRYG * ZZW1(:,2) * ZCIT(:) / ZRIT(:) - ZWQ1(:,3) = ZWQ1(:,3) * (1. - ZCOLIG(:)) / ZCOLIG(:) ! QIDRYG_boun -! -! Temperature dependance of the charge transfered - ZWQ1(:,3) = ZWQ1(:,3) * (ZZT(:) - XQTC) / ABS(ZZT(:) - XQTC) - ZWQ1(:,3) = ZWQ1(:,3) / ZRHODREF(:) - END WHERE - END IF -! -! -!* 2.2 Gardiner et al. (1985) -! - IF (CNI_CHARGING == 'GARDI') THEN - ZWQ1(:,3) = 0. -! - WHERE (GELEC(:,2) .AND. ZRIS(:) > ZRSMIN_ELEC(4) .AND. & - ZRGS(:) > ZRSMIN_ELEC(6) .AND. ZDELTALWC(:) > 0.) - ZWQ1(:,3) = XFQIDRYGBG * XLBQIDRYGBG * (1 - ZCOLIG) * & - ZRHODREF(:)**(-4. * XCEXVT + 4. / XBI) * & - ZCIT(:)**(1 - 4. / XBI) * & - ZDELTALWC(:) * ZFT(:) * & - ZLBDAG(:)**(XCXG - 2. - 4. * XDG) * & - (XAI * MOMG(XALPHAI, XNUI, XBI) / & - ZRIT(:))**(-4 / XBI) -! -! Dq limited to XLIM_NI_IG - ZLIMIT(:) = XLIM_NI_IG * ZZW1(:,2) * ZCIT(:) * (1 - ZCOLIG(:)) / & - (ZRIT(:) * ZCOLIG(:)) - ZWQ1(:,3) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,3)) ), ZWQ1(:,3) ) - ZWQ1(:,3) = ZWQ1(:,3) / ZRHODREF(:) - ENDWHERE -! -! For temperatures lower than -30C --> linear interpolation -! - WHERE (ZWQ1(:,3) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.)) - ZWQ1(:,3) = ZWQ1(:,3) * (ZZT(:) - XTT + 40.) / 10. - ENDWHERE -! - END IF -! -! -!* 2.3 Charging process based on EW: SAUN1/SAUN2, TEEWC -!* following Saunders et al. (1991), Takahashi via Tsenova and Mitzeva(2009) -! - IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. & - CNI_CHARGING == 'TEEWC') THEN - ZWQ1(:,3) = 0. -! - WHERE (GELEC(:,2) .AND. ZRIS(:) > ZRSMIN_ELEC(4) .AND. & - ZRGS(:) > ZRSMIN_ELEC(6) .AND. ZDQLWC(:) /= 0.) - ZWQ1(:,3) = XFQIDRYGBS * (1. - ZCOLIG(:)) * & - ZRHOCOR(:)**(1. + ZSAUNIN(:)) * & - ZFQIDRYGBS(:) * ZDQLWC(:) * & - ZCIT(:)**(1. - ZSAUNIM(:) / XBI) * & - ZLBDAG(:)**(XCXG - 2. - XDG * (1. + ZSAUNIN(:))) * & - (ZRHODREF(:) * ZRIT(:)/XAIGAMMABI)**(ZSAUNIM(:) / XBI) -! -! Dq is limited to XLIM_NI_IG - ZLIMIT(:) = XLIM_NI_IG * ZZW1(:,2) * ZCIT(:) * (1 - ZCOLIG(:)) / & - (ZRIT(:) * ZCOLIG(:)) - ZWQ1(:,3) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,3)) ), ZWQ1(:,3) ) - ZWQ1(:,3) = ZWQ1(:,3) / ZRHODREF(:) - ENDWHERE -! -! For temperatures lower than -30C --> linear interpolation - WHERE (ZWQ1(:,3) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.)) - ZWQ1(:,3) = ZWQ1(:,3) * (ZZT(:) - XTT + 40.) / 10. - ENDWHERE -! - END IF -! -! -!* 2.4 Charging process based on RAR (=EW*V): SAP98, BSMP1/BSMP2, TERAR -!* following Saunders and Peck (1998) or -!* Brooks et al., 1997 (with/out anomalies) or -!* Takahashi via Tsenova and Mitzeva (2011) -! - IF (CNI_CHARGING == 'SAP98' .OR. CNI_CHARGING == 'BSMP1' .OR. & - CNI_CHARGING == 'BSMP2' .OR. CNI_CHARGING == 'TERAR') THEN -! - IF (CNI_CHARGING /= 'TERAR') THEN - ZFQIDRYGBS(:) = XFQIDRYGBSP - WHERE (ZDQRAR_IG(:) < 0.) - ZFQIDRYGBS(:) = XFQIDRYGBSN - ENDWHERE - ELSE - ZFQIDRYGBS(:) = XFQIDRYGBSP_TAK - WHERE (ZDQRAR_IG(:) <0.) - ZFQIDRYGBS(:) = XFQIDRYGBSN_TAK - ENDWHERE - END IF -! - ZWQ1(:,3) = 0. -! - WHERE (GELEC(:,2) .AND. ZDQRAR_IG(:) /= 0. .AND. & - ZRIS(:) > ZRSMIN_ELEC(4) .AND. ZRGS(:) > ZRSMIN_ELEC(6)) - ZWQ1(:,3) = XFQIDRYGBS * (1. - ZCOLIG(:)) * & - ZRHOCOR(:)**(1 + ZSAUNIN_IG(:)) * & - ZFQIDRYGBS(:) * ZDQRAR_IG(:) * & - ZCIT(:)**(1 - ZSAUNIM_IG(:) / XBI) * & - ZLBDAG(:)**(XCXG - 2. - XDG * (1. + ZSAUNIN_IG(:))) * & - (ZRHODREF(:) * ZRIT(:)/XAIGAMMABI)**(ZSAUNIM_IG(:) / XBI) -! -! Dq is limited to XLIM_NI_IG - ZLIMIT(:) = XLIM_NI_IG * ZZW1(:,2) * ZCIT(:) * (1 - ZCOLIG(:)) / & - (ZRIT(:) * ZCOLIG(:)) - ZWQ1(:,3) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,3)) ), ZWQ1(:,3) ) - ZWQ1(:,3) = ZWQ1(:,3) / ZRHODREF(:) - ENDWHERE -! -! For temperatures lower than -30C --> linear interpolation - WHERE (ZWQ1(:,3) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.)) - ZWQ1(:,3) = ZWQ1(:,3) * (ZZT(:) - XTT + 40.) / 10. - ENDWHERE - END IF -! -! -!* 2.5 Takahashi (1978) -! - IF (CNI_CHARGING == 'TAKAH') THEN - ZWQ1(:,3) = 0. - ZLIMIT(:) = 0. -! - WHERE (GELEC(:,2) .AND. ZRIS(:) > ZRSMIN_ELEC(4) .AND. & - ZRGS(:) > ZRSMIN_ELEC(6) .AND. ZDQLWC(:) /= 0.) - ZWQ1(:,3) = XFQIDRYGBT1 * (1. - ZCOLIG(:)) * ZRHOCOR(:) * & - ZCIT(:) * ZLBDAG(:)**XCXG * ZDQLWC(:) * & - MIN( XFQIDRYGBT2 / (ZLBDAG(:)**(2. + XDG)), & - XFQIDRYGBT3 * ZRHOCOR(:) * ZRHODREF(:)**(2./XBI) * & - ZRIT(:)**(2. / XBI) / (ZCIT(:)**(2. / XBI) * & - ZLBDAG(:)**(2. + 2. * XDG)) ) -! -! Dq is limited to XLIM_NI_IG - ZLIMIT(:) = XLIM_NI_IG * ZZW1(:,2) * ZCIT(:) * (1 - ZCOLIG(:)) / & - (ZRIT(:) * ZCOLIG(:)) - ZWQ1(:,3) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,3)) ), ZWQ1(:,3) ) - ZWQ1(:,3) = ZWQ1(:,3) / ZRHODREF(:) - ENDWHERE -! -! For temperatures lower than -30C --> linear interpolation - WHERE (ZWQ1(:,3) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.)) - ZWQ1(:,3) = ZWQ1(:,3) * (ZZT(:) - XTT + 40.) / 10. - ENDWHERE - END IF -! -! -END SUBROUTINE ELEC_IDRYG_B -! -!------------------------------------------------------------------------------- -! - SUBROUTINE ELEC_SDRYG_B() -! -! Purpose : compute the charge separation during the dry collision -! between snow and graupeln -! -!* 0. DECLARATIONS -! ------------ -! -IMPLICIT NONE -! -! -!* 1. COMPUTE THE COLLECTION EFFICIENCY -! --------------------------------- -! - ZCOLSG(:) = XCOLSG * EXP (XCOLEXSG * (ZZT(:) - XTT)) -! -!* 2. COMPUTE THE CHARGE SEPARATION DURING SDRYG_BOUN -! ----------------------------------------------- -! -!* 2.1 Helsdon and Farley (1987) -! - IF (CNI_CHARGING == 'HELFA') THEN - ZWQ1(:,5) = 0. -! - WHERE (ZRGT(:) > XRTMIN_ELEC(6) .AND. ZRST(:) > XRTMIN_ELEC(5) .AND. & - ZRGS(:) > ZRSMIN_ELEC(6) .AND. ZRSS(:) > ZRSMIN_ELEC(5) .AND. & - ZLBDAS(:) > 0. .AND. ZLBDAG(:) > 0.) - ZWQ1(:,5) = ZWQ1(:,10) * XFQSDRYGBH * ZRHODREF(:)**(-XCEXVT) * & - (1. - ZCOLSG(:)) * & - ZLBDAS(:)**(XCXS) * ZLBDAG(:)**(XCXG) * & - (XLBQSDRYGB4H * ZLBDAS(:)**(-2.) + & - XLBQSDRYGB5H * ZLBDAS(:)**(-1.) * ZLBDAG(:)**(-1.) + & - XLBQSDRYGB6H * ZLBDAG(:)**(-2.)) -! -! Temperature dependance of the charge transfered - ZWQ1(:,5) = ZWQ1(:,5) * (ZZT(:) - XQTC) / ABS(ZZT(:) - XQTC) - ZWQ1(:,5) = ZWQ1(:,5) / ZRHODREF(:) - ENDWHERE - ENDIF -! -! -!* 2.2 Gardiner et al. (1985) -! - IF (CNI_CHARGING == 'GARDI') THEN - ZWQ1(:,5) = 0. - ZLIMIT(:) = 0. -! - WHERE (GELEC(:,3) .AND. ZRGS(:) > ZRSMIN_ELEC(6) .AND. & - ZRSS(:) > ZRSMIN_ELEC(5) .AND. ZDELTALWC(:) > 0.) - ZWQ1(:,5) = XFQSDRYGBG * (1. - ZCOLSG(:)) * & - ZRHODREF(:)**(-4. * XCEXVT) * & - ZFT(:) * ZDELTALWC(:) * & - ZLBDAG(:)**XCXG * ZLBDAS(:)**XCXS * & - (XLBQSDRYGB4G * ZLBDAS(:)**(-4.) * ZLBDAG(:)**(-2.) + & - XLBQSDRYGB5G * ZLBDAS(:)**(-5.) * ZLBDAG(:)**(-1.) + & - XLBQSDRYGB6G * ZLBDAS(:)**(-6.)) * & - ZWQ1(:,10) -! -! Dq is limited to XLIM_NI_SG - ZLIMIT(:) = XLIM_NI_SG * ZAUX1(:) * XAUX_LIM * & - ZRHOCOR(:) * (1. - ZCOLSG(:)) * & - ZLBDAS(:)**(XCXS) * ZLBDAG(:)**(XCXG) * & - (XAUX_LIM1 * ZLBDAS(:)**(-2.) + & - XAUX_LIM2 * ZLBDAS(:)**(-1.) * ZLBDAG(:)**(-1.) + & - XAUX_LIM3 * ZLBDAG(:)**(-2.)) - ZWQ1(:,5) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,5)) ), ZWQ1(:,5)) - ZWQ1(:,5) = ZWQ1(:,5) / ZRHODREF(:) - ENDWHERE -! -! For temperatures lower than -30C --> linear interpolation - WHERE (ZWQ1(:,5) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.)) - ZWQ1(:,5) = ZWQ1(:,5) * (ZZT(:) - XTT + 40.) / 10. - ENDWHERE - END IF -! -!* 2.3 Charging process based on EW: SAUN1/SAUN2, TEEWC -!* following Saunders et al. (1991), Takahashi via Tsenova and Mitzeva(2009) -! - IF (CNI_CHARGING == 'SAUN1' .OR. CNI_CHARGING == 'SAUN2' .OR. & - CNI_CHARGING == 'TEEWC') THEN -! - ZWQ1(:,5) = 0. - ZLIMIT(:) = 0. -! - WHERE (GELEC(:,3) .AND. ZRGS(:) > ZRSMIN_ELEC(6) .AND. & - ZRSS(:) > ZRSMIN_ELEC(5) .AND. ZDQLWC(:) /= 0.) -! -! ZWQ1(:,5) = ZWQ3(:) If graupel gains positive charge ZDQLWC(:) > 0. -! ZWQ1(:,5) = ZWQ4(:) If graupel gains negative charge ZDQLWC(:) < 0. - ZWQ1(:,5) = ZWQ3(:) * (0.5 + SIGN(0.5,ZDQLWC(:))) + & - ZWQ4(:) * (0.5 - SIGN(0.5,ZDQLWC(:))) -! - ZWQ1(:,5) = ZWQ1(:,5) * XFQSDRYGBS * (1. - ZCOLSG(:)) * & - ZRHOCOR(:)**(1. + ZSAUNSN(:)) * & - ZSAUNSK(:) * ZDQLWC(:) * & - ZLBDAG(:)**XCXG * ZLBDAS(:)**XCXS * & - ( ZLBQSDRYGB1S(:) / (ZLBDAS(:)**ZSAUNSM(:) *ZLBDAG(:)**2) + & - ZLBQSDRYGB2S(:) / (ZLBDAS(:)**( 1.+ZSAUNSM(:))*ZLBDAG(:)) + & - ZLBQSDRYGB3S(:) / ZLBDAS(:)**(2.+ZSAUNSM(:)) ) -! -! Dq is limited to XLIM_NI_SG - ZLIMIT(:) = XLIM_NI_SG * ZAUX1(:) * XAUX_LIM * & - ZRHOCOR(:) * (1. - ZCOLSG(:)) * & - ZLBDAS(:)**(XCXS) * ZLBDAG(:)**(XCXG) * & - ( XAUX_LIM1 / ZLBDAS(:)**2 + & - XAUX_LIM2 /(ZLBDAS(:) * ZLBDAG(:)) + & - XAUX_LIM3 / ZLBDAG(:)**2 ) - ZWQ1(:,5) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,5)) ), ZWQ1(:,5)) - ZWQ1(:,5) = ZWQ1(:,5) / ZRHODREF(:) - ENDWHERE -! -! For temperatures lower than -30C --> linear interpolation - WHERE (ZWQ1(:,5) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.)) - ZWQ1(:,5) = ZWQ1(:,5) * (ZZT(:) - XTT + 40.) / 10. - ENDWHERE -! - END IF -! -! -!* 2.4 Charging process based on RAR (=EW*V): SAP98, BSMP1/BSMP2, TERAR -!* following Saunders and Peck (1998) or -!* Brooks et al., 1997 (with/out anomalies) or -!* Takahashi via Tsenova and Mitzeva (2011) -! - IF (CNI_CHARGING == 'SAP98' .OR. CNI_CHARGING == 'BSMP1' .OR. & - CNI_CHARGING == 'BSMP2' .OR. CNI_CHARGING == 'TERAR') THEN -! - ZLBQSDRYGB1S(:) = XLBQSDRYGB1SP - ZLBQSDRYGB2S(:) = XLBQSDRYGB2SP - ZLBQSDRYGB3S(:) = XLBQSDRYGB3SP - WHERE (ZDQRAR_SG(:) < 0.) - ZLBQSDRYGB1S(:) = XLBQSDRYGB1SN - ZLBQSDRYGB2S(:) = XLBQSDRYGB2SN - ZLBQSDRYGB3S(:) = XLBQSDRYGB3SN - ENDWHERE -! - ZWQ1(:,5) = 0. - ZLIMIT(:) = 0. -! - WHERE (GELEC(:,3) .AND. ZDQRAR_SG(:) /= 0. .AND. & - ZRGS(:) > ZRSMIN_ELEC(6) .AND. ZRSS(:) > ZRSMIN_ELEC(5)) - ZWQ1(:,5) = ZWQ3(:) * (0.5+SIGN(0.5,ZDQRAR_SG(:))) + & - ZWQ4(:) * (0.5-SIGN(0.5,ZDQRAR_SG(:))) -! - ZWQ1(:,5) = ZWQ1(:,5) * XFQSDRYGBS * (1. - ZCOLSG(:)) * & - ZRHOCOR(:)**(1. + ZSAUNSN_SG(:)) * & - ZSAUNSK_SG(:) * ZDQRAR_SG(:) * & - ZLBDAG(:)**XCXG * ZLBDAS(:)**XCXS * & - (ZLBQSDRYGB1S(:)/(ZLBDAS(:)**ZSAUNSM_SG(:) * ZLBDAG(:)**2) + & - ZLBQSDRYGB2S(:)/(ZLBDAS(:)**(1.+ZSAUNSM_SG(:))*ZLBDAG(:)) + & - ZLBQSDRYGB3S(:)/ ZLBDAS(:)**(2.+ZSAUNSM_SG(:)) ) -! -! -! Dq is limited to XLIM_NI_SG - ZLIMIT(:) = XLIM_NI_SG * ZAUX1(:) * XAUX_LIM * & - ZRHOCOR(:) * (1. - ZCOLSG(:)) * & - ZLBDAS(:)**(XCXS) * ZLBDAG(:)**(XCXG) * & - ( XAUX_LIM1 / ZLBDAS(:)**2 + & - XAUX_LIM2 /(ZLBDAS(:) * ZLBDAG(:)) + & - XAUX_LIM3 / ZLBDAG(:)**2 ) - ZWQ1(:,5) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,5)) ), ZWQ1(:,5)) - ZWQ1(:,5) = ZWQ1(:,5) / ZRHODREF(:) - ENDWHERE -! -! For temperature lower than -30C --> linear interpolation - WHERE (ZWQ1(:,5) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.)) - ZWQ1(:,5) = ZWQ1(:,5) * (ZZT(:) - XTT + 40.) / 10. - ENDWHERE - END IF -! -! -!* 2.5 Takahashi (1978) -! - IF (CNI_CHARGING == 'TAKAH') THEN - ZWQ1(:,5) = 0. - ZLIMIT(:) = 0. -! - WHERE (GELEC(:,3) .AND. ZRGS(:) > ZRSMIN_ELEC(6) .AND. & - ZRSS(:) > ZRSMIN_ELEC(5) .AND. ZDQLWC(:) /= 0.) - ZWQ1(:,5) = XFQSDRYGBT1 * (1. - ZCOLSG(:)) * ZRHOCOR(:) * & - ZLBDAG(:)**XCXG * ZLBDAS(:)**XCXS * ZDQLWC(:) * & - MIN(10. * ( & - ABS(XFQSDRYGBT2 / (ZLBDAG(:)**XDG * ZLBDAS(:)**2.) - & - XFQSDRYGBT3 / (ZLBDAS(:)**(2. + XDS))) + & - ABS(XFQSDRYGBT4 / (ZLBDAG(:)**(2.+XDG)) - & - XFQSDRYGBT5 / (ZLBDAS(:)**XDS * ZLBDAG(:)**2.)) + & - ABS(XFQSDRYGBT6 / (ZLBDAG(:)**(1. + XDG) * ZLBDAS(:)) - & - XFQSDRYGBT7 / (ZLBDAS(:)**(1. + XDS) * ZLBDAG(:)))), & - XFQSDRYGBT8 * ZRHOCOR(:) * ZWQ1(:,10) * & - (XFQSDRYGBT9 / (ZLBDAS(:)**2. * ZLBDAG(:)**2.) + & - XFQSDRYGBT10 / (ZLBDAS(:)**4.) + & - XFQSDRYGBT11 / (ZLBDAS(:)**3. * ZLBDAG(:)))) -! -! Dq is limited to XLIM_NI_SG - ZLIMIT(:) = XLIM_NI_SG * ZAUX1(:) * XAUX_LIM * & - ZRHOCOR(:) * (1. - ZCOLSG(:)) * & - ZLBDAS(:)**(XCXS) * ZLBDAG(:)**(XCXG) * & - ( XAUX_LIM1 / ZLBDAS(:)**2 + & - XAUX_LIM2 /(ZLBDAS(:) * ZLBDAG(:)) + & - XAUX_LIM3 / ZLBDAG(:)**2 ) - ZWQ1(:,5) = SIGN( MIN( ABS(ZLIMIT(:)), ABS(ZWQ1(:,5)) ), ZWQ1(:,5)) - ZWQ1(:,5) = ZWQ1(:,5) / ZRHODREF(:) - ENDWHERE -! -! For temperature lower than -30C --> linear interpolation - WHERE (ZWQ1(:,5) /= 0. .AND. ZZT(:) < (XTT-30.) .AND. ZZT(:) >= (XTT-40.)) - ZWQ1(:,5) = ZWQ1(:,5) * (ZZT(:) - XTT + 40.) / 10. - ENDWHERE - END IF -! -! -END SUBROUTINE ELEC_SDRYG_B -! -!------------------------------------------------------------------------------ -! - SUBROUTINE INDUCTIVE_PROCESS -! -! Computation of the charge transfer rate during inductive mechanism -! Only the bouncing droplet-graupel collision when the graupel is in the dry -! growth mode is considered -! The electric field is limited to 100 kV/m -! -!* 0. DECLARATIONS -! ------------ -! -IMPLICIT NONE -! -! -!* 1. COMPUTE THE CHARGING RATE -! ------------------------- -! - ZRATE_IND(:) = 0. -! - WHERE (GIND(:) .AND. & - ZEFIELDW(:) /= 0. .AND. ABS(ZEGS(:)) > XEGMIN .AND. & - ZLBDAG(:) > 0. .AND. & - ZRGT(:) > XRTMIN_ELEC(6) .AND. ZRGS(:) > ZRSMIN_ELEC(6) .AND. & - ZRCT(:) > XRTMIN_ELEC(2) .AND. ZRCS(:) > ZRSMIN_ELEC(2)) - ZRATE_IND(:) = XIND1 * ZLBDAG(:)**XCXG * ZRHOCOR(:) * & - (XIND2 * SIGN(MIN(100.E3, ABS(ZEFIELDW(:))), ZEFIELDW(:)) * & - ZLBDAG(:) **(-2.-XDG) - & - XIND3 * ZEGS(:) * ZLBDAG(:)**(-XFG-XDG)) - ZRATE_IND(:) = ZRATE_IND(:) / ZRHODREF(:) - ZQGS(:) = ZQGS(:) + ZRATE_IND(:) - ZQCS(:) = ZQCS(:) - ZRATE_IND(:) - END WHERE -! -END SUBROUTINE INDUCTIVE_PROCESS -! -!------------------------------------------------------------------------------ -! -! - FUNCTION BI_LIN_INTP_V(ZT, KI, KJ, PDX, PDY, KN) RESULT(Y) -! -! | | -! ZT(KI(1),KJ(2))-|-------------------|-ZT(KI(2),KJ(2)) -! | | -! | | -! x2-|-------|y(x1,x2) | -! | | | -! PDY| | | -! | | | -! | | | -!ZT( KI(1),KJ(1))-|-------------------|-ZT(KI(2),KJ(1)) -! | PDX |x1 | -! | | -! -!* 0. DECLARATIONS -! ------------ -! -IMPLICIT NONE -! -!* 0.2 Declaration of local variables -! -INTEGER :: KN ! Size of the result vector -INTEGER, DIMENSION(KN) :: KI ! Tabulated coordinate -INTEGER, DIMENSION(KN) :: KJ ! Tabulated coordinate -REAL, INTENT(IN), DIMENSION(:,:) :: ZT ! Tabulated data -REAL, INTENT(IN), DIMENSION(KN) :: PDX, PDY ! -REAL, DIMENSION(KN) :: Y ! Interpolated value -! -INTEGER :: JJ ! Loop index -! -!* 1. INTERPOLATION -! ------------- -! -DO JJ = 1, KN - Y(JJ) = (1.0 - PDX(JJ)) * (1.0 - PDY(JJ)) * ZT(KI(JJ), KJ(JJ)) + & - PDX(JJ) * (1.0 - PDY(JJ)) * ZT(KI(JJ)+1,KJ(JJ)) + & - PDX(JJ) * PDY(JJ) * ZT(KI(JJ)+1,KJ(JJ)+1) + & - (1.0 - PDX(JJ)) * PDY(JJ) * ZT(KI(JJ) ,KJ(JJ)+1) -ENDDO -! -END FUNCTION BI_LIN_INTP_V -! -!------------------------------------------------------------------------------- -! -END SUBROUTINE RAIN_ICE_ELEC diff --git a/src/ICCARE_BASE/read_chem_data_cams_case.f90 b/src/ICCARE_BASE/read_chem_data_cams_case.f90 deleted file mode 100644 index a8487d33a..000000000 --- a/src/ICCARE_BASE/read_chem_data_cams_case.f90 +++ /dev/null @@ -1,1108 +0,0 @@ -!iMNH_LIC Copyright 2012-2017 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!----------------------------------------------------------------- -! #################################### - MODULE MODI_READ_CHEM_DATA_CAMS_CASE -! #################################### -INTERFACE -SUBROUTINE READ_CHEM_DATA_CAMS_CASE(TPPRE_REAL1,HFILE,TPPGDFILE,PTIME_HORI, & - KVERB,ODUMMY_REAL,OUSECHEM ) -! -USE MODD_IO, ONLY: TFILEDATA -! -TYPE(TFILEDATA),POINTER,INTENT(IN) :: TPPRE_REAL1 ! PRE_REAL1 file -CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of the NETCDF file -TYPE(TFILEDATA), INTENT(IN) :: TPPGDFILE ! physiographic data file -REAL, INTENT(INOUT) :: PTIME_HORI ! time spent in hor. interpolations -INTEGER, INTENT(IN) :: KVERB ! verbosity level -LOGICAL, INTENT(IN) :: ODUMMY_REAL! flag to interpolate dummy fields -LOGICAL, INTENT(IN) :: OUSECHEM ! flag to initialize chemistry -END SUBROUTINE READ_CHEM_DATA_CAMS_CASE -! -END INTERFACE -END MODULE MODI_READ_CHEM_DATA_CAMS_CASE -! ############################################################################# - SUBROUTINE READ_CHEM_DATA_CAMS_CASE(TPPRE_REAL1,HFILE,TPPGDFILE,PTIME_HORI, & - KVERB,ODUMMY_REAL,OUSECHEM ) -! ############################################################################# -! -!!**** *READ_CHEM_DATA_CAMS_CASE* - reads data for the initialization of real cases. -!! -!! PURPOSE -!! ------- -! This routine reads the two input files : -! The PGD which is closed after reading -! The CAMS file -! Projection is read in READ_LFIFM_PGD (MODD_GRID). -! Grid and definition of large domain are read in PGD file and -! NETCDF files. -! The PGD files are also read in READ_LFIFM_PGD. -! The PGD file is closed. -! Vertical grid is defined in READ_VER_GRID. -! PGD fields are stored on MESO-NH domain (in TRUNC_PGD). -!! -!!** METHOD -!! ------ -!! 0. Declarations -!! 1. Declaration of arguments -!! 2. Declaration of local variables -!! 1. Read PGD file -!! 1. Domain restriction -!! 2. Coordinate conversion to lat,lon system -!! 2. Read Netcdf fields and transfer CAMS var. in MNH var. -!! 3. Vertical grid -!! 4. Free all temporary allocations -!! -!! EXTERNAL -!! -------- -!! subroutine READ_LFIFM_PGD : to read PGD file -!! subroutine READ_VER_GRID : to read the vertical grid in namelist file. -!! subroutine HORIBL : horizontal bilinear interpolation -!! subroutine XYTOLATLON : projection from conformal to lat,lon -!! -!! Module MODI_READ_VER_GRID : interface for subroutine READ_VER_GRID -!! Module MODI_HORIBL : interface for subroutine HORIBL -!! Module MODI_XYTOLATLON : interface for subroutine XYTOLATLON -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! Module MODD_CONF : contains configuration variables for all models. -!! NVERB : verbosity level for output-listing -!! Module MODD_LUNIT : contains logical unit names for all models -!! CLUOUT0 : name of output-listing -!! Module MODD_PGDDIM : contains dimension of PGD fields -!! NPGDIMAX: dimension along x (no external point) -!! NPGDJMAX: dimension along y (no external point) -!! Module MODD_PARAMETERS -!! JPHEXT -!! -!! MODIFICATIONS -!! ------------- -!! Original 23/01/12 (C. Mari) -!! A. Berger 20/03/12 adapt whatever the chemical mechanism in BASIC -!! P. Wautelet 30/10/17 use F90 module for netCDF -!! J.Pianezzej 13/02/2019 : correction for use of MEGAN -!! M. Leriche 26/01/2021 : adapt to CAMS reanalysis file -!! M. Leriche 26/02/2021 : add initialization for dust and sea salt -!! P. Tulet 01/02/2022 : unit conversion for aerosols (SALTCAMn, AEROCAMn, DUSTCAMn) -!! M. Leriche 02/02/2022 : compute air density from CAMS -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_BLANK_n -USE MODD_CH_AEROSOL, ONLY: CORGANIC, NCARB, NSOA, NSP, LORILAM,& - JPMODE, LVARSIGI, LVARSIGJ,CAERONAMES,LAERINIT -USE MODD_CH_M9_n, ONLY: NEQ , CNAMES -USE MODD_CH_MNHC_n, ONLY: LUSECHEM,LUSECHAQ,LUSECHIC,LCH_PH -USE MODD_DUST, ONLY : LDUST, LDSTCAMS -USE MODD_SALT, ONLY : LSALT, LSLTCAMS -USE MODD_CONF -USE MODD_CONF_n -USE MODD_CST -USE MODD_DIM_n -USE MODD_GRID -USE MODD_GRID_n -USE MODD_IO, ONLY: TFILEDATA -USE MODD_LUNIT, ONLY: TLUOUT0 -USE MODE_MODELN_HANDLER -USE MODD_NETCDF, ONLY:CDFINT -USE MODD_NSV -USE MODD_PARAMETERS -USE MODD_PREP_REAL -USE MODD_TIME -USE MODD_TIME_n -! -!UPG*PT -!USE MODE_FM -!USE MODE_IO -USE MODE_TOOLS, ONLY: UPCASE -USE MODE_TOOLS_ll -USE MODE_IO_FILE, only: IO_File_close -!UPG*PT -USE MODE_MPPDB -USE MODE_THERMO -USE MODE_TIME -! -USE MODI_CH_AER_INIT_SOA -USE MODI_CH_INIT_SCHEME_n -USE MODI_CH_OPEN_INPUT -USE MODI_DUSTCAMS_n -USE MODI_HORIBL -USE MODI_INI_NSV -USE MODI_READ_HGRID_n -USE MODI_READ_VER_GRID -USE MODI_SALTCAMS_n -USE MODI_XYTOLATLON -USE MODI_AEROCAMS_n -! -USE NETCDF -! -IMPLICIT NONE -! -!* 0.1. Declaration of arguments -! ------------------------ -! -TYPE(TFILEDATA),POINTER,INTENT(IN) :: TPPRE_REAL1 ! PRE_REAL1 file -CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of the NETCDF file -TYPE(TFILEDATA), INTENT(IN) :: TPPGDFILE ! physiographic data file -REAL, INTENT(INOUT) :: PTIME_HORI ! time spent in hor. interpolations -INTEGER, INTENT(IN) :: KVERB ! verbosity level -LOGICAL, INTENT(IN) :: ODUMMY_REAL! flag to interpolate dummy fields -LOGICAL, INTENT(IN) :: OUSECHEM ! flag to initialize chemistry -! -!* 0.2 Declaration of local variables -! ------------------------------ -! General purpose variables -INTEGER :: ILUOUT0 ! Unit used for output msg. -INTEGER :: IRET ! Return code from subroutines -INTEGER :: JI,JJ,JK ! Dummy counters -INTEGER :: JLOOP1 ! -INTEGER :: JN ! conter of dust/SS modes -INTEGER :: JNCHEM, JNAER ! conters of chemical species in BASIC -! Variables used by the PGD reader -CHARACTER(LEN=28) :: YPGD_NAME ! not used - dummy argument -CHARACTER(LEN=28) :: YPGD_DAD_NAME ! not used - dummy argument -CHARACTER(LEN=2) :: YPGD_TYPE ! not used - dummy argument -! PGD Grib definition variables -INTEGER :: INO ! Number of points of the grid -INTEGER :: IIU ! Number of points along X -INTEGER :: IJU ! Number of points along Y -REAL, DIMENSION(:), ALLOCATABLE :: ZLONOUT ! mapping PGD -> Grib (lon.) -REAL, DIMENSION(:), ALLOCATABLE :: ZLATOUT ! mapping PGD -> Grib (lat.) -REAL, DIMENSION(:,:), ALLOCATABLE :: ZXM ! X of PGD mass points -REAL, DIMENSION(:,:), ALLOCATABLE :: ZYM ! Y of PGD mass points -REAL, DIMENSION(:,:), ALLOCATABLE :: ZLATM ! Lat of PGD mass points -REAL, DIMENSION(:,:), ALLOCATABLE :: ZLONM ! Lon of PGD mass points -! Variable involved in the task of reading the netcdf file -REAL,DIMENSION(:,:),ALLOCATABLE :: ZVALUE ! Intermediate array -REAL,DIMENSION(:),ALLOCATABLE :: ZVALUE1D ! Intermediate array -REAL,DIMENSION(:,:),ALLOCATABLE :: ZOUT ! Intermediate arrays -REAL,DIMENSION(:),ALLOCATABLE :: ZOUT1D ! Intermediate arrays -INTEGER :: ind_netcdf ! Indice for netcdf var. -!chemistry field infile CAM1.nam -INTEGER :: ICHANNEL -CHARACTER(LEN=8) :: YCAM="CAM1.nam" -integer :: ICAM -CHARACTER(LEN=100) :: YFORMAT -CHARACTER(LEN=40), DIMENSION(:), ALLOCATABLE :: YSPCMNH -integer, dimension(:), ALLOCATABLE :: ISPCCAM -CHARACTER(LEN=9) :: YA -REAL,DIMENSION(:,:),ALLOCATABLE :: ZCOEFCAMSEU -REAL,DIMENSION(:,:),ALLOCATABLE :: ZMASMOLCAMSEU -CHARACTER(LEN=18),dimension(:,:),ALLOCATABLE :: YSPCCAMSEU -type TZCAM -real :: ZCOEFCAM, ZMASMOLCAM -character(16) :: YSPCCAM -end type TZCAM -type(TZCAM), DIMENSION(:,:),ALLOCATABLE :: TZSTOC -! model indice -INTEGER :: IMI -TYPE(TFILEDATA),POINTER :: TZFILE -! for dust and sea salt -REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZMASS1, ZMASS2 -! -! For netcdf -! -integer(kind=CDFINT) :: status, ncid, varid -integer(kind=CDFINT) :: lat_varid, lon_varid, lev_varid -integer(kind=CDFINT) :: t_varid, q_varid, ps_varid -integer(kind=CDFINT) :: recid, latid, lonid, levid -integer(kind=CDFINT) :: latlen, lonlen, levlen -integer(kind=CDFINT) :: KILEN -integer :: mmr_dust1_varid, mmr_dust2_varid, mmr_dust3_varid ! for init. dust -integer :: mmr_seasalt1_varid, mmr_seasalt2_varid, mmr_seasalt3_varid ! for init sea salt -CHARACTER(LEN=40) :: recname -REAL, DIMENSION(:), ALLOCATABLE :: lats -REAL, DIMENSION(:), ALLOCATABLE :: lons -REAL, DIMENSION(:), ALLOCATABLE :: levs -INTEGER, DIMENSION(:), ALLOCATABLE :: count3d, start3d -INTEGER, DIMENSION(:), ALLOCATABLE :: count2d, start2d -INTEGER, DIMENSION(:), ALLOCATABLE :: kinlo -REAL, DIMENSION(:,:,:), ALLOCATABLE :: vartemp3d,vartemp3dbis,vartemp3dter -REAL, DIMENSION(:,:,:), ALLOCATABLE :: vartemp3dquater -REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCHEMCAM, ZTCAM, ZQCAM, ZPRESSCAM -REAL, DIMENSION(:,:), ALLOCATABLE :: ZPSCAM -REAL, DIMENSION(:,:,:), ALLOCATABLE :: mmr_dust1, mmr_dust2, mmr_dust3 -REAL, DIMENSION(:,:,:), ALLOCATABLE :: mmr_seasalt1, mmr_seasalt2, mmr_seasalt3 -REAL :: scale, offset -! for reverse altitude -REAL, DIMENSION(:), ALLOCATABLE :: TMP1, TMP2 -REAL, DIMENSION(:,:,:), ALLOCATABLE :: TMP3 -REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: TMP4,TMP5 -REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZPRESS_SV_LS, ZRHO_SV_LS -! -!---------------------------------------------------------------------- -TZFILE => NULL() -! -IMI = GET_CURRENT_MODEL_INDEX() -! -!* 1. READ PGD FILE -! ------------- -! -ILUOUT0 = TLUOUT0%NLU -CALL READ_HGRID_n(TPPGDFILE,YPGD_NAME,YPGD_DAD_NAME,YPGD_TYPE) -! -!* 1.1 Domain restriction -! -CALL GET_DIM_EXT_ll('B',IIU,IJU) -INO = IIU * IJU -! -!* 1.2 Coordinate conversion to lat,lon system -! -ALLOCATE (ZXM(IIU,IJU)) -ALLOCATE (ZYM(IIU,IJU)) -ALLOCATE (ZLONM(IIU,IJU)) -ALLOCATE (ZLATM(IIU,IJU)) -ZXM(1:IIU-1,1) = (XXHAT(1:IIU-1) + XXHAT(2:IIU) ) / 2. -ZXM(IIU,1) = XXHAT(IIU) - XXHAT(IIU-1) + ZXM(IIU-1,1) -ZXM(:,2:IJU) = SPREAD(ZXM(:,1),2,IJU-1) -ZYM(1,1:IJU-1) = (XYHAT(1:IJU-1) + XYHAT(2:IJU)) / 2. -ZYM(1,IJU) = XYHAT(IJU) - XYHAT(IJU-1) + ZYM(1,IJU-1) -ZYM(2:IIU,:) = SPREAD(ZYM(1,:),1,IIU-1) -CALL SM_XYTOLATLON_A (XLAT0,XLON0,XRPK,XLATORI,XLONORI,ZXM,ZYM,ZLATM,ZLONM, & - IIU,IJU) -ALLOCATE (ZLONOUT(INO)) -ALLOCATE (ZLATOUT(INO)) -JLOOP1 = 0 -DO JJ = 1, IJU - ZLONOUT(JLOOP1+1:JLOOP1+IIU) = ZLONM(1:IIU,JJ) - ZLATOUT(JLOOP1+1:JLOOP1+IIU) = ZLATM(1:IIU,JJ) - JLOOP1 = JLOOP1 + IIU -ENDDO -DEALLOCATE (ZYM) -DEALLOCATE (ZXM) -DEALLOCATE (ZLONM) -DEALLOCATE (ZLATM) -! -! -!* 2. READ NETCDF FIELDS -! ------------------ -! -!* 2.1 Open netcdf files -! -status = nf90_open(HFILE, nf90_nowrite, ncid) -if (status /= nf90_noerr) call handle_err(status) -! -!* 2.2 Read netcdf files -! -! get dimension IDs -! -!* get dimension ID of unlimited variable in netcdf file -!status = nf90_inquire(ncid, unlimitedDimId = recid) -!if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_dimid(ncid, "latitude", latid) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_dimid(ncid, "longitude", lonid) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_dimid(ncid, "level", levid) -if (status /= nf90_noerr) call handle_err(status) -! -! get dimensions -! -!* get dimension and name of unlimited variable in netcdf file -!status = nf90_inquire_dimension(ncid, recid, name=recname, len=nrecs) -!if (status /= nf90_noerr) call handle_err(status) -status = nf90_inquire_dimension(ncid, latid, len=latlen) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inquire_dimension(ncid, lonid, len=lonlen) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inquire_dimension(ncid, levid, len=levlen) -if (status /= nf90_noerr) call handle_err(status) -! -! get variable IDs -! -status = nf90_inq_varid(ncid, "latitude", lat_varid) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_varid(ncid, "longitude", lon_varid) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_varid(ncid, "level", lev_varid) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_varid(ncid, "t", t_varid) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_varid(ncid, "q", q_varid) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_varid(ncid, "sp", ps_varid) -if (status /= nf90_noerr) call handle_err(status) -IF (LDUST .AND. LDSTCAMS) THEN - status = nf90_inq_varid(ncid, "aermr04", mmr_dust1_varid) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_inq_varid(ncid, "aermr05", mmr_dust2_varid) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_inq_varid(ncid, "aermr06", mmr_dust3_varid) - if (status /= nf90_noerr) call handle_err(status) -ENDIF -IF (LSALT .AND. LSLTCAMS) THEN - status = nf90_inq_varid(ncid, "aermr01", mmr_seasalt1_varid) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_inq_varid(ncid, "aermr02", mmr_seasalt2_varid) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_inq_varid(ncid, "aermr03", mmr_seasalt3_varid) - if (status /= nf90_noerr) call handle_err(status) -ENDIF - -! -KILEN = latlen * lonlen -! -!* 2.3 Read data. -! -ALLOCATE (count3d(4)) -ALLOCATE (start3d(4)) -ALLOCATE (count2d(3)) -ALLOCATE (start2d(3)) -ALLOCATE (lats(latlen)) -ALLOCATE (lons(lonlen)) -ALLOCATE (levs(levlen)) -ALLOCATE (kinlo(latlen)) -kinlo(:) = lonlen -IF (OUSECHEM) THEN ! chem and possibly orilam - ALLOCATE (vartemp3d(lonlen,latlen,levlen)) - ALLOCATE (vartemp3dbis(lonlen,latlen,levlen)) - ALLOCATE (vartemp3dter(lonlen,latlen,levlen)) - ALLOCATE (vartemp3dquater(lonlen,latlen,levlen)) - ALLOCATE (ZCHEMCAM(lonlen,latlen,levlen)) -ENDIF -IF (LDUST .AND. LDSTCAMS) THEN - ALLOCATE (mmr_dust1(lonlen,latlen,levlen)) - ALLOCATE (mmr_dust2(lonlen,latlen,levlen)) - ALLOCATE (mmr_dust3(lonlen,latlen,levlen)) -ENDIF -IF (LSALT .AND. LSLTCAMS) THEN - ALLOCATE (mmr_seasalt1(lonlen,latlen,levlen)) - ALLOCATE (mmr_seasalt2(lonlen,latlen,levlen)) - ALLOCATE (mmr_seasalt3(lonlen,latlen,levlen)) -ENDIF -ALLOCATE (ZTCAM(lonlen,latlen,levlen)) -ALLOCATE (ZQCAM(lonlen,latlen,levlen)) -ALLOCATE (ZPSCAM(lonlen,latlen)) -ALLOCATE (ZPRESSCAM(lonlen,latlen,levlen)) -ALLOCATE (XA_SV_LS(levlen)) -ALLOCATE (XB_SV_LS(levlen)) -ALLOCATE (XT_SV_LS(IIU,IJU,levlen)) -ALLOCATE (XQ_SV_LS(IIU,IJU,levlen,1)) -ALLOCATE (XPS_SV_LS(IIU,IJU)) -ALLOCATE (XZS_SV_LS(IIU,IJU)) -ALLOCATE (ZPRESS_SV_LS(IIU,IJU,levlen)) -ALLOCATE (ZRHO_SV_LS(IIU,IJU,levlen)) -! take the orography from ECMWF -XZS_SV_LS(:,:) = XZS_LS(:,:) -! -! get values of variables -! -status = nf90_get_var(ncid, lat_varid, lats(:)) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_get_var(ncid, lon_varid, lons(:)) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_get_var(ncid, lev_varid, levs(:)) -if (status /= nf90_noerr) call handle_err(status) -! -! -! Reference pressure (needed for the vertical interpolation) -!!! XP00_SV_LS = p0 -XP00_SV_LS = 101325.0 -! -! a and b coefficients (needed for the vertical interpolation) -! -XA_SV_LS(:) = (/ 20.000000000, 38.425343000, 63.647804000, 95.636963000, 134.48330700, & - 180.58435100, 234.77905300, 298.49578900, 373.97192400, 464.61813400, & - 575.65100100, 713.21807900, 883.66052200, 1094.8347170, 1356.4746090, & - 1680.6402590, 2082.2739260, 2579.8886720, 3196.4216310, 3960.2915040, & - 4906.7084960, 6018.0195310, 7306.6313480, 8765.0537110, 10376.126953, & - 12077.446289, 13775.325195, 15379.805664, 16819.474609, 18045.183594, & - 19027.695313, 19755.109375, 20222.205078, 20429.863281, 20384.480469, & - 20097.402344, 19584.330078, 18864.750000, 17961.357422, 16899.468750, & - 15706.447266, 14411.124023, 13043.218750, 11632.758789, 10209.500977, & - 8802.3564450, 7438.8032230, 6144.3149410, 4941.7783200, 3850.9133300, & - 2887.6965330, 2063.7797850, 1385.9125980, 855.36175500, 467.33358800, & - 210.39389000, 65.889244000, 7.3677430000, 0.0000000000, 0.0000000000 /) - -XB_SV_LS(:) = (/ 0.00000000, 0.00000000, 0.00000000, 0.00000000, 0.00000000, & - 0.00000000, 0.00000000, 0.00000000, 0.00000000, 0.00000000, & - 0.00000000, 0.00000000, 0.00000000, 0.00000000, 0.00000000, & - 0.00000000, 0.00000000, 0.00000000, 0.00000000, 0.00000000, & - 0.00000000, 0.00000000, 0.00000000, 0.00007600, 0.00046100, & - 0.00181500, 0.00508100, 0.01114300, 0.02067800, 0.03412100, & - 0.05169000, 0.07353400, 0.09967500, 0.13002300, 0.16438400, & - 0.20247600, 0.24393300, 0.28832300, 0.33515500, 0.38389200, & - 0.43396300, 0.48477200, 0.53571000, 0.58616800, 0.63554700, & - 0.68326900, 0.72878600, 0.77159700, 0.81125300, 0.84737500, & - 0.87965700, 0.90788400, 0.93194000, 0.95182200, 0.96764500, & - 0.97966300, 0.98827000, 0.99401900, 0.99763000, 1.00000000 /) -! -! Read 1 record of lon*lat values, starting at the -! beginning of the record (the (1, 1, rec=time) element in the netCDF -! file). -count2d(1) = lonlen -count2d(2) = latlen -count2d(3) = 1 -start2d(1) = 1 -start2d(2) = 1 -start2d(3) = 1 -! Read 1 record of lon*lat*lev values, starting at the -! beginning of the record (the (1, 1, 1, rec) element in the netCDF -! file). -count3d(1) = lonlen -count3d(2) = latlen -count3d(3) = levlen -count3d(4) = 1 -start3d(1) = 1 -start3d(2) = 1 -start3d(3) = 1 -start3d(4) = 1 -! -! -ALLOCATE(ZVALUE(levlen,KILEN)) -ALLOCATE(ZOUT(levlen,INO)) -ALLOCATE(ZVALUE1D(KILEN)) -ALLOCATE(ZOUT1D(INO)) -! -!* 2.3.1 read meteo veriables -! temperature, spec. hum. and surface pressure -! needed for the vertical interpolation -! -status = nf90_get_var(ncid, t_varid, ZTCAM(:,:,:), start=start3d, count=count3d) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_get_att(ncid, t_varid, "scale_factor", scale) -status = nf90_get_att(ncid, t_varid, "add_offset", offset) -ZTCAM(:,:,:) = offset + scale * ZTCAM(:,:,:) -! -status = nf90_get_var(ncid, q_varid, ZQCAM(:,:,:), start=start3d, count=count3d) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_get_att(ncid, q_varid, "scale_factor", scale) -status = nf90_get_att(ncid, q_varid, "add_offset", offset) -ZQCAM(:,:,:) = offset + scale * ZQCAM(:,:,:) -! -status = nf90_get_var(ncid, ps_varid, ZPSCAM(:,:), start=start2d, count=count2d) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_get_att(ncid, ps_varid, "scale_factor", scale) -status = nf90_get_att(ncid, ps_varid, "add_offset", offset) -ZPSCAM(:,:) = offset + scale * ZPSCAM(:,:) -! -DO JK = 1, levlen - IF (JK.EQ.1) THEN - ZPRESSCAM(:,:,JK) = (XA_SV_LS(JK) + XB_SV_LS(JK)*ZPSCAM(:,:)) ! ZPRESCAM = 0. for n=0 - ELSE - ZPRESSCAM(:,:,JK) = ( XA_SV_LS(JK) + XA_SV_LS(JK-1) + & - ( XB_SV_LS(JK) + XB_SV_LS(JK-1))*ZPSCAM(:,:)) / 2. - ENDIF -END DO - -! -where (ZLONOUT(:) < 0.) ZLONOUT(:) = ZLONOUT(:) + 360. ! correct longitudes -! -!* 2.3.2 meteo. variables horizontal interpolation -! -DO JK = 1, levlen - JLOOP1 = 0 - DO JJ = 1, latlen - ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZTCAM(1:lonlen,JJ,JK) - JLOOP1 = JLOOP1 + lonlen - ENDDO - CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), & - latlen,kinlo,KILEN, & - ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, & - ZOUT(JK,:),.FALSE.,PTIME_HORI,.FALSE.) -! - CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU, & - XT_SV_LS(:,:,JK)) -ENDDO -! -DO JK = 1, levlen - JLOOP1 = 0 - DO JJ = 1, latlen - ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZQCAM(1:lonlen,JJ,JK) - JLOOP1 = JLOOP1 + lonlen - ENDDO - CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), & - latlen,kinlo,KILEN, & - ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, & - ZOUT(JK,:),.FALSE.,PTIME_HORI,.FALSE.) -! - CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU, & - XQ_SV_LS(:,:,JK,1)) -ENDDO -! -DO JK = 1, levlen - JLOOP1 = 0 - DO JJ = 1, latlen - ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZPRESSCAM(1:lonlen,JJ,JK) - JLOOP1 = JLOOP1 + lonlen - ENDDO - CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), & - latlen,kinlo,KILEN, & - ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, & - ZOUT(JK,:),.FALSE.,PTIME_HORI,.FALSE.) -! - CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU, & - ZPRESS_SV_LS(:,:,JK)) -ENDDO -! -JLOOP1 = 0 -DO JJ = 1, latlen - ZVALUE1D(JLOOP1+1:JLOOP1+lonlen) = ZPSCAM(1:lonlen,JJ) - JLOOP1 = JLOOP1 + lonlen -ENDDO -CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), & - latlen,kinlo,KILEN, & - ZVALUE1D(:),INO,ZLONOUT,ZLATOUT, & - ZOUT1D(:),.FALSE.,PTIME_HORI,.FALSE.) -! -CALL ARRAY_1D_TO_2D(INO,ZOUT1D(:),IIU,IJU, & - XPS_SV_LS(:,:)) -! -! air density in kg/m3 RHO=PM/RT -ZRHO_SV_LS(:,:,:) = (ZPRESS_SV_LS(:,:,:))/(XRD*XT_SV_LS(:,:,:)) - -! -!* 2.3.3 correct negative values produced by the horizontal interpolations -! -XPS_SV_LS(:,:) = MAX(XPS_SV_LS(:,:),0.) -XT_SV_LS(:,:,:) = MAX(XT_SV_LS(:,:,:),0.) -XQ_SV_LS(:,:,:,1) = MAX(XQ_SV_LS(:,:,:,1),0.) -ZRHO_SV_LS(:,:,:) = MAX(ZRHO_SV_LS(:,:,:),0.) -! -! -!* 2.4 initialize NSV variables -! -! Always initialize chemical scheme variables before INI_NSV call ! -CALL CH_INIT_SCHEME_n(IMI,LUSECHAQ,LUSECHIC,LCH_PH,ILUOUT0,KVERB) -IF (LORILAM) THEN - CORGANIC = "MPMPO" - LVARSIGI = .TRUE. - LVARSIGJ = .TRUE. - CALL CH_AER_INIT_SOA(ILUOUT0, KVERB) -END IF -IF (OUSECHEM) LUSECHEM = .TRUE. -! initialise NSV_* variables -CALL INI_NSV(1) -IF (ALLOCATED(XSV_LS)) DEALLOCATE(XSV_LS) -ALLOCATE (XSV_LS(IIU,IJU,levlen,NSV)) -XSV_LS(:,:,:,:) = 0. -! -!* 2.5 read chem. variables and convert them into MNH variables -! -IF (OUSECHEM) THEN - WRITE (ILUOUT0,'(A,A4,A)') ' | Reading CAMS species (ppp) from ',HFILE,'file' -! -! read CAMS species from the file CAM1.nam -! -! open input file - CALL CH_OPEN_INPUT(YCAM,"CAM2MESONH",TZFILE,ILUOUT0,KVERB) - ICHANNEL = TZFILE%NLU -! -!read number of cams species to transfer into mesonh - READ(ICHANNEL, *) ICAM - IF (KVERB >= 5) WRITE (ILUOUT0,*) "number of cams species to transfer into & - & mesonh : ", ICAM -! -!read data input format - READ(ICHANNEL,"(A)") YFORMAT - YFORMAT=UPCASE(YFORMAT) - IF (KVERB >= 5) WRITE (ILUOUT0,*) "input format is: ", YFORMAT -! -!allocate fields - ALLOCATE(YSPCMNH(ICAM)) !MESONH species - ALLOCATE(TZSTOC(ICAM,4)) !CAMS coefficient and CAMS species associated - ALLOCATE(ISPCCAM(ICAM)) !number of CAMS species into each MESONH species - ALLOCATE(ZCOEFCAMSEU(ICAM,4))!Coef stoich of each CAMS species - ALLOCATE(ZMASMOLCAMSEU(ICAM,4))!molar mass of each CAMS species - ALLOCATE(YSPCCAMSEU(ICAM,4)) !CAMS species name -!read MESONH variable names and CAMS variable names associated - DO JI = 1,ICAM !for every MNH species existing in CAM1.nam - READ(ICHANNEL,YFORMAT) YSPCMNH(JI), ISPCCAM(JI), & !reading line by line - TZSTOC(JI,1)%ZCOEFCAM, TZSTOC(JI,1)%YSPCCAM, TZSTOC(JI,1)%ZMASMOLCAM, & - TZSTOC(JI,2)%ZCOEFCAM, TZSTOC(JI,2)%YSPCCAM, TZSTOC(JI,2)%ZMASMOLCAM, & - TZSTOC(JI,3)%ZCOEFCAM, TZSTOC(JI,3)%YSPCCAM, TZSTOC(JI,3)%ZMASMOLCAM, & - TZSTOC(JI,4)%ZCOEFCAM, TZSTOC(JI,4)%YSPCCAM, TZSTOC(JI,4)%ZMASMOLCAM - WRITE(ILUOUT0,YFORMAT) YSPCMNH(JI), ISPCCAM(JI),& -!writing in arrays - TZSTOC(JI,1)%ZCOEFCAM, TZSTOC(JI,1)%YSPCCAM, TZSTOC(JI,1)%ZMASMOLCAM, & - TZSTOC(JI,2)%ZCOEFCAM, TZSTOC(JI,2)%YSPCCAM, TZSTOC(JI,2)%ZMASMOLCAM, & - TZSTOC(JI,3)%ZCOEFCAM, TZSTOC(JI,3)%YSPCCAM, TZSTOC(JI,3)%ZMASMOLCAM, & - TZSTOC(JI,4)%ZCOEFCAM, TZSTOC(JI,4)%YSPCCAM, TZSTOC(JI,4)%ZMASMOLCAM -! - ZCOEFCAMSEU(JI,1) = (TZSTOC(JI,1)%ZCOEFCAM) !coef stoich of each CAMS species set into an array - ZCOEFCAMSEU(JI,2) = (TZSTOC(JI,2)%ZCOEFCAM) - ZCOEFCAMSEU(JI,3) = (TZSTOC(JI,3)%ZCOEFCAM) - ZCOEFCAMSEU(JI,4) = (TZSTOC(JI,4)%ZCOEFCAM) -! - YSPCCAMSEU(JI,1)=trim(TZSTOC(JI,1)%YSPCCAM) !specie name of each CAMS specie set into an array - YSPCCAMSEU(JI,2)=trim(TZSTOC(JI,2)%YSPCCAM) - YSPCCAMSEU(JI,3)=trim(TZSTOC(JI,3)%YSPCCAM) - YSPCCAMSEU(JI,4)=trim(TZSTOC(JI,4)%YSPCCAM) -! - ZMASMOLCAMSEU(JI,1)= (TZSTOC(JI,1)%ZMASMOLCAM) ! molar mass to convert kg/kg to ppp - ZMASMOLCAMSEU(JI,2)= (TZSTOC(JI,2)%ZMASMOLCAM) - ZMASMOLCAMSEU(JI,3)= (TZSTOC(JI,3)%ZMASMOLCAM) - ZMASMOLCAMSEU(JI,4)= (TZSTOC(JI,4)%ZMASMOLCAM) -! -! read chem. variables and exchange CAMS values onto prognostic variables XSV_LS -! convert CAMS fields to 2D for use in horizontal interpolation routine HORIBL.f90 -! - DO JNCHEM = NSV_CHEMBEG, NSV_CHEMEND !loop on all MNH species - IF (trim(CNAMES(JNCHEM-NSV_CHEMBEG+1))==trim(YSPCMNH(JI))) THEN !MNH mechanism species - IF (ISPCCAM(JI)==1) THEN - status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,1)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale) - status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset) - vartemp3d(:,:,:)=offset + scale * vartemp3d(:,:,:) - ZCHEMCAM(:,:,:)=ZCOEFCAMSEU(JI,1)*vartemp3d(:,:,:)*XMD*1E3/ZMASMOLCAMSEU(JI,1) - ELSE IF (ISPCCAM(JI)==2) THEN - status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,1)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale) - status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset) - vartemp3d(:,:,:)=offset + scale*vartemp3d(:,:,:) - status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,2)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3dbis, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale) - status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset) - vartemp3dbis(:,:,:)=offset + scale*vartemp3dbis(:,:,:) - ZCHEMCAM(:,:,:)=ZCOEFCAMSEU(JI,1)*vartemp3d(:,:,:)*XMD*1E3/ZMASMOLCAMSEU(JI,1) + & - ZCOEFCAMSEU(JI,2)*vartemp3dbis(:,:,:)*XMD*1E3/ZMASMOLCAMSEU(JI,2) - ELSE IF (ISPCCAM(JI)==3) THEN - status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,1)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale) - status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset) - vartemp3d(:,:,:)=offset + scale*vartemp3d(:,:,:) - status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,2)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3dbis, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale) - status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset) - vartemp3dbis(:,:,:)=offset + scale*vartemp3dbis(:,:,:) - status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,3)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3dter, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale) - status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset) - vartemp3dter(:,:,:)=offset + scale*vartemp3dter(:,:,:) - ZCHEMCAM(:,:,:)=ZCOEFCAMSEU(JI,1)*vartemp3d(:,:,:)*XMD*1E3/ZMASMOLCAMSEU(JI,1) +& - ZCOEFCAMSEU(JI,2)*vartemp3dbis(:,:,:)*XMD*1E3/ZMASMOLCAMSEU(JI,2) +& - ZCOEFCAMSEU(JI,3)*vartemp3dter(:,:,:)*XMD*1E3/ZMASMOLCAMSEU(JI,3) - ELSE IF (ISPCCAM(JI)==4) THEN - status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,1)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale) - status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset) - vartemp3d(:,:,:)=offset + scale*vartemp3d(:,:,:) - status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,2)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3dbis, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale) - status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset) - vartemp3dbis(:,:,:)=offset + scale*vartemp3dbis(:,:,:) - status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,3)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3dter, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale) - status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset) - vartemp3dter(:,:,:)=offset + scale*vartemp3dter(:,:,:) - status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,4)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3dquater, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale) - status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset) - vartemp3dquater(:,:,:)=offset + scale*vartemp3dquater(:,:,:) - ZCHEMCAM(:,:,:)=ZCOEFCAMSEU(JI,1)*vartemp3d(:,:,:)*XMD*1E3/ZMASMOLCAMSEU(JI,1)+& - ZCOEFCAMSEU(JI,2)*vartemp3dbis(:,:,:)*XMD*1E3/ZMASMOLCAMSEU(JI,2)+& - ZCOEFCAMSEU(JI,3)*vartemp3dter(:,:,:)*XMD*1E3/ZMASMOLCAMSEU(JI,3)+& - ZCOEFCAMSEU(JI,4)*vartemp3dquater(:,:,:)*XMD*1E3/ZMASMOLCAMSEU(JI,4) - ENDIF - DO JK = 1, levlen - JLOOP1 = 0 - DO JJ = 1, latlen - ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZCHEMCAM(1:lonlen,JJ,JK) - JLOOP1 = JLOOP1+lonlen - ENDDO - CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), & - latlen,kinlo,KILEN, & - ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, & - ZOUT(JK,:),.FALSE.,PTIME_HORI,.TRUE.) - CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU, & - XSV_LS(:,:,JK,JNCHEM) ) - ENDDO ! levlen - ENDIF - XSV_LS(:,:,:,JNCHEM) = MAX(XSV_LS(:,:,:,JNCHEM), 0.) - ENDDO ! JNCHEM -! - DO JNAER = NSV_AERBEG, NSV_AEREND ! no need to convert to ppp - IF (trim(CAERONAMES(JNAER-NSV_AERBEG+1))==trim(YSPCMNH(JI))) THEN !MNH mechanism species - - IF (ISPCCAM(JI)==1) THEN - status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,1)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale) - status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset) - ZCHEMCAM(:,:,:)=ZCOEFCAMSEU(JI,1)*(offset + scale*vartemp3d(:,:,:)) - ELSE IF (ISPCCAM(JI)==2) THEN - status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,1)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale) - status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset) - vartemp3d(:,:,:)=offset + scale*vartemp3d(:,:,:) - status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,2)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3dbis, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale) - status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset) - vartemp3dbis(:,:,:)=offset + scale*vartemp3dbis(:,:,:) - ZCHEMCAM(:,:,:)=ZCOEFCAMSEU(JI,1)*vartemp3d(:,:,:) + & - ZCOEFCAMSEU(JI,2)*vartemp3dbis(:,:,:) - ELSE IF (ISPCCAM(JI)==3) THEN - status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,1)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale) - status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset) - vartemp3d(:,:,:)=offset + scale*vartemp3d(:,:,:) - status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,2)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3dbis, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale) - status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset) - vartemp3dbis(:,:,:)=offset + scale*vartemp3dbis(:,:,:) - status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,3)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3dter, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale) - status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset) - vartemp3dter(:,:,:)=offset + scale*vartemp3dter(:,:,:) - ZCHEMCAM(:,:,:)=ZCOEFCAMSEU(JI,1)*vartemp3d(:,:,:)+& - ZCOEFCAMSEU(JI,2)*vartemp3dbis(:,:,:)+& - ZCOEFCAMSEU(JI,3)*vartemp3dter(:,:,:) - ELSE IF (ISPCCAM(JI)==4) THEN - status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,1)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale) - status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset) - vartemp3d(:,:,:)=offset + scale*vartemp3d(:,:,:) - status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,2)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3dbis, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale) - status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset) - vartemp3dbis(:,:,:)=offset + scale*vartemp3dbis(:,:,:) - status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,3)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3dter, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale) - status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset) - vartemp3dter(:,:,:)=offset + scale*vartemp3dter(:,:,:) - status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,4)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3dquater, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale) - status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset) - vartemp3dquater(:,:,:)=offset + scale*vartemp3dquater(:,:,:) - ZCHEMCAM(:,:,:)=ZCOEFCAMSEU(JI,1)*vartemp3d(:,:,:)+& - ZCOEFCAMSEU(JI,2)*vartemp3dbis(:,:,:)+& - ZCOEFCAMSEU(JI,3)*vartemp3dter(:,:,:)+& - ZCOEFCAMSEU(JI,4)*vartemp3dquater(:,:,:) - ENDIF - DO JK = 1, levlen - JLOOP1 = 0 - DO JJ = 1, latlen - ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZCHEMCAM(1:lonlen,JJ,JK) - JLOOP1 = JLOOP1+lonlen - ENDDO - CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), & - latlen,kinlo,KILEN, & - ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, & - ZOUT(JK,:),.FALSE.,PTIME_HORI,.TRUE.) - CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU, & - XSV_LS(:,:,JK,JNAER) ) - ENDDO ! levlen - ENDIF - XSV_LS(:,:,:,JNAER) = MAX(XSV_LS(:,:,:,JNAER), 1E-40) - ENDDO ! JNAER - ENDDO ! ICAM loop on MNH species in CAM1.nam - DEALLOCATE(YSPCMNH) - DEALLOCATE(TZSTOC) - DEALLOCATE(ISPCCAM) - DEALLOCATE(ZCOEFCAMSEU) - DEALLOCATE(ZMASMOLCAMSEU) - DEALLOCATE(YSPCCAMSEU) -! - IF (LORILAM) THEN ! convert kg/kg into ppv and moments - CALL AEROCAMS_n(XSV_LS(:,:,:,NSV_AERBEG:NSV_AEREND), ZRHO_SV_LS) - LAERINIT = .FALSE. ! to avoid enter in the routine ch_reallfin - ENDIF -ENDIF ! OUSECHEM -! -!* 2.6 read dust variables and convert them into MNH variables -! -IF (LDUST .AND. LDSTCAMS) THEN - WRITE (ILUOUT0,'(A)') ' | Reading CAMS dust (kg/kg)' - ! - status = nf90_get_var(ncid, mmr_dust1_varid, mmr_dust1(:,:,:), start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_att(ncid, mmr_dust1_varid, "scale_factor", scale) - status = nf90_get_att(ncid, mmr_dust1_varid, "add_offset", offset) - mmr_dust1(:,:,:) = offset + scale * mmr_dust1(:,:,:) - ! - status = nf90_get_var(ncid, mmr_dust2_varid, mmr_dust2(:,:,:), start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_att(ncid, mmr_dust2_varid, "scale_factor", scale) - status = nf90_get_att(ncid, mmr_dust2_varid, "add_offset", offset) - mmr_dust2(:,:,:) = offset + scale * mmr_dust2(:,:,:) - ! - status = nf90_get_var(ncid, mmr_dust3_varid, mmr_dust3(:,:,:), start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_att(ncid, mmr_dust3_varid, "scale_factor", scale) - status = nf90_get_att(ncid, mmr_dust3_varid, "add_offset", offset) - mmr_dust3(:,:,:) = offset + scale * mmr_dust3(:,:,:) - ! - ALLOCATE (ZMASS1(lonlen,latlen,levlen,3)) - ALLOCATE (ZMASS2(SIZE(XSV_LS,1), SIZE(XSV_LS,2), SIZE(XSV_LS,3),3)) -! - ZMASS1(:,:,:,1) = mmr_dust1(:,:,:) - ZMASS1(:,:,:,2) = mmr_dust2(:,:,:) - ZMASS1(:,:,:,3) = mmr_dust3(:,:,:) - - ZMASS1(:,:,:,:) = MAX(ZMASS1(:,:,:,:),1E-40) - - DO JN=1,3 - DO JK = 1, levlen - JLOOP1 = 0 - DO JJ = 1, latlen - ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZMASS1(1:lonlen,JJ,JK,JN) - JLOOP1 = JLOOP1 + lonlen - ENDDO - CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), & - latlen,kinlo,KILEN, & - ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, & - ZOUT(JK,:),.FALSE.,PTIME_HORI,.TRUE. ) - CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU,ZMASS2(:,:,JK,JN)) - ENDDO - ENDDO -! - ! conversion kg/kg into moment units (ppv) - CALL DUSTCAMS_n(XSV_LS(:,:,:,NSV_DSTBEG:NSV_DSTEND), ZMASS2(:,:,:,:), ZRHO_SV_LS(:,:,:)) - - DEALLOCATE (ZMASS1) - DEALLOCATE (ZMASS2) -END IF -! -!* 2.7 read sea salt variables and convert them into MNH variables -! -IF (LSALT .AND. LSLTCAMS) THEN - WRITE (ILUOUT0,'(A)') ' | Reading CAMS sea salt (kg/kg)' - ! - status = nf90_get_var(ncid, mmr_seasalt1_varid, mmr_seasalt1(:,:,:), start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_att(ncid, mmr_seasalt1_varid, "scale_factor", scale) - status = nf90_get_att(ncid, mmr_seasalt1_varid, "add_offset", offset) - mmr_seasalt1(:,:,:) = offset + scale * mmr_seasalt1(:,:,:) - ! - status = nf90_get_var(ncid, mmr_seasalt2_varid, mmr_seasalt2(:,:,:), start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_att(ncid, mmr_seasalt2_varid, "scale_factor", scale) - status = nf90_get_att(ncid, mmr_seasalt2_varid, "add_offset", offset) - mmr_seasalt2(:,:,:) = offset + scale * mmr_seasalt2(:,:,:) - ! - status = nf90_get_var(ncid, mmr_seasalt3_varid, mmr_seasalt3(:,:,:), start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_att(ncid, mmr_seasalt3_varid, "scale_factor", scale) - status = nf90_get_att(ncid, mmr_seasalt3_varid, "add_offset", offset) - mmr_seasalt3(:,:,:) = offset + scale * mmr_seasalt3(:,:,:) - ! - ALLOCATE (ZMASS1(lonlen,latlen,levlen,3)) - ALLOCATE (ZMASS2(SIZE(XSV_LS,1), SIZE(XSV_LS,2), SIZE(XSV_LS,3),3)) -! - ZMASS1(:,:,:,1) = mmr_seasalt1(:,:,:) - ZMASS1(:,:,:,2) = mmr_seasalt2(:,:,:) - ZMASS1(:,:,:,3) = mmr_seasalt3(:,:,:) - ZMASS1(:,:,:,:) = MAX(ZMASS1(:,:,:,:),1E-40) - DO JN=1,3 - DO JK = 1, levlen - JLOOP1 = 0 - DO JJ = 1, latlen - ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZMASS1(1:lonlen,JJ,JK,JN) - JLOOP1 = JLOOP1 + lonlen - ENDDO - CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), & - latlen,kinlo,KILEN, & - ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, & - ZOUT(JK,:),.FALSE.,PTIME_HORI,.TRUE. ) - CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU,ZMASS2(:,:,JK,JN)) - ENDDO - ENDDO -! - ! conversion kg/kg into moment units (ppv) - CALL SALTCAMS_n(XSV_LS(:,:,:,NSV_SLTBEG:NSV_SLTEND),ZMASS2(:,:,:,:), ZRHO_SV_LS(:,:,:)) - ! - DEALLOCATE (ZMASS1) - DEALLOCATE (ZMASS2) -ENDIF -! -! -!* 3. If netcdf vertical levels have to be reversed -! -ALLOCATE(TMP1(levlen)) -ALLOCATE(TMP2(levlen)) -ALLOCATE(TMP3(IIU,IJU,levlen)) -ALLOCATE(TMP4(IIU,IJU,levlen,NRR)) -ALLOCATE(TMP5(IIU,IJU,levlen,NSV)) -! -XA_SV_LS(:) = XA_SV_LS(:) / XP00_SV_LS -! -DO JJ=1,levlen -! inv. lev - TMP1(JJ) = XA_SV_LS(levlen+1-JJ) - TMP2(JJ) = XB_SV_LS(levlen+1-JJ) - TMP3(:,:,JJ) = XT_SV_LS(:,:,levlen+1-JJ) - TMP4(:,:,JJ,:) = XQ_SV_LS(:,:,levlen+1-JJ,:) - TMP5(:,:,JJ,:) = XSV_LS(:,:,levlen+1-JJ,:) -ENDDO -! -XA_SV_LS(:) = TMP1(:) -XB_SV_LS(:) = TMP2(:) -XT_SV_LS(:,:,:) = TMP3(:,:,:) -XQ_SV_LS(:,:,:,:) = TMP4(:,:,:,:) -XSV_LS(:,:,:,:) = TMP5(:,:,:,:) - -DEALLOCATE(TMP1) -DEALLOCATE(TMP2) -DEALLOCATE(TMP3) -DEALLOCATE(TMP4) -DEALLOCATE(TMP5) -! -!* 4 close the netcdf file -! -status = nf90_close(ncid) -if (status /= nf90_noerr) call handle_err(status) -! -DEALLOCATE(ZVALUE) -DEALLOCATE(ZOUT) -IF (ALLOCATED(ZVALUE1D)) DEALLOCATE(ZVALUE1D) -IF (ALLOCATED(ZOUT1D)) DEALLOCATE(ZOUT1D) -! -! close -! file -IF (OUSECHEM) CALL IO_FILE_CLOSE(TZFILE) -! -! -!------------------------------------------------------------- -! -!* 5. VERTICAL GRID -! ------------- -! -!* 5.1 Read VERTICAL GRID -! -WRITE (ILUOUT0,'(A)') ' | Reading of vertical grid in progress' -CALL READ_VER_GRID(TPPRE_REAL1) -! -!-------------------------------------------------------------- -! -!* 6. Free all temporary allocations -! ------------------------------ -! -DEALLOCATE (count3d) -DEALLOCATE (count2d) -DEALLOCATE (start3d) -DEALLOCATE (start2d) -DEALLOCATE (lats) -DEALLOCATE (lons) -DEALLOCATE (levs) -DEALLOCATE (kinlo) -DEALLOCATE (ZLATOUT) -DEALLOCATE (ZLONOUT) -DEALLOCATE (ZTCAM) -DEALLOCATE (ZQCAM) -DEALLOCATE (ZPSCAM) -DEALLOCATE (ZPRESSCAM) -DEALLOCATE (ZPRESS_SV_LS) -DEALLOCATE (ZRHO_SV_LS) -IF (ALLOCATED(ZCHEMCAM)) DEALLOCATE(ZCHEMCAM) -IF (ALLOCATED(vartemp3d)) DEALLOCATE(vartemp3d) -IF (ALLOCATED(vartemp3dbis)) DEALLOCATE(vartemp3dbis) -IF (ALLOCATED(vartemp3dter)) DEALLOCATE(vartemp3dter) -IF (ALLOCATED(vartemp3dquater)) DEALLOCATE(vartemp3dquater) -IF (ALLOCATED(mmr_dust1)) DEALLOCATE(mmr_dust1) -IF (ALLOCATED(mmr_dust2)) DEALLOCATE(mmr_dust2) -IF (ALLOCATED(mmr_dust3)) DEALLOCATE(mmr_dust3) -IF (ALLOCATED(mmr_seasalt1)) DEALLOCATE(mmr_seasalt1) -IF (ALLOCATED(mmr_seasalt2)) DEALLOCATE(mmr_seasalt2) -IF (ALLOCATED(mmr_seasalt3)) DEALLOCATE(mmr_seasalt3) -! -WRITE (ILUOUT0,'(A,A4,A)') ' -- netcdf decoder for ',HFILE,' file ended successfully' -! - -CONTAINS -! -! ############################# - SUBROUTINE HANDLE_ERR(STATUS) -! ############################# - INTEGER(KIND=CDFINT) STATUS - IF (STATUS .NE. NF90_NOERR) THEN - PRINT *, NF90_STRERROR(STATUS) - STOP 'Stopped' - ENDIF - END SUBROUTINE HANDLE_ERR -! -! -! ############################################# - SUBROUTINE ARRAY_1D_TO_2D (KN1,P1,KL1,KL2,P2) -! ############################################# -! -! Small routine used to store a linear array into a 2 dimension array -! -USE MODE_MSG -IMPLICIT NONE -INTEGER, INTENT(IN) :: KN1 -REAL,DIMENSION(KN1), INTENT(IN) :: P1 -INTEGER, INTENT(IN) :: KL1 -INTEGER, INTENT(IN) :: KL2 -REAL,DIMENSION(KL1,KL2),INTENT(OUT) :: P2 -INTEGER :: JLOOP1_A1T2 -INTEGER :: JLOOP2_A1T2 -INTEGER :: JPOS_A1T2 -! -IF (KN1 < KL1*KL2) THEN - CALL PRINT_MSG(NVERB_FATAL,'GEN','ARRAY_1D_TO_2D','sizes do not match') -END IF -JPOS_A1T2 = 1 -DO JLOOP2_A1T2 = 1, KL2 - DO JLOOP1_A1T2 = 1, KL1 - P2(JLOOP1_A1T2,JLOOP2_A1T2) = P1(JPOS_A1T2) - JPOS_A1T2 = JPOS_A1T2 + 1 - END DO -END DO -END SUBROUTINE ARRAY_1D_TO_2D -! -END SUBROUTINE READ_CHEM_DATA_CAMS_CASE diff --git a/src/ICCARE_BASE/read_chem_data_mozart_case.f90 b/src/ICCARE_BASE/read_chem_data_mozart_case.f90 deleted file mode 100644 index e8a65c705..000000000 --- a/src/ICCARE_BASE/read_chem_data_mozart_case.f90 +++ /dev/null @@ -1,812 +0,0 @@ -!MNH_LIC Copyright 2012-2017 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!----------------------------------------------------------------- -! ################################ - MODULE MODI_READ_CHEM_DATA_MOZART_CASE -! ################################# -INTERFACE -SUBROUTINE READ_CHEM_DATA_MOZART_CASE(TPPRE_REAL1,HFILE,TPPGDFILE, & - PTIME_HORI,KVERB,ODUMMY_REAL ) -! -USE MODD_IO, ONLY: TFILEDATA -! -TYPE(TFILEDATA),POINTER,INTENT(IN) :: TPPRE_REAL1 ! PRE_REAL1 file -CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of the NETCDF file -TYPE(TFILEDATA), INTENT(IN) :: TPPGDFILE ! physiographic data file -REAL, INTENT(INOUT) :: PTIME_HORI ! time spent in hor. interpolations -INTEGER, INTENT(IN) :: KVERB ! verbosity level -LOGICAL, INTENT(IN) :: ODUMMY_REAL! flag to interpolate dummy fields -END SUBROUTINE READ_CHEM_DATA_MOZART_CASE -! -END INTERFACE -END MODULE MODI_READ_CHEM_DATA_MOZART_CASE -! #################################################################### - SUBROUTINE READ_CHEM_DATA_MOZART_CASE(TPPRE_REAL1,HFILE,TPPGDFILE, & - PTIME_HORI,KVERB,ODUMMY_REAL ) -! #################################################################### -! -!!**** *READ_CHEM_DATA_MOZART_CASE* - reads data for the initialization of real cases. -!! -!! PURPOSE -!! ------- -! This routine reads the two input files : -! The PGD which is closed after reading -! The MOZART file -! Projection is read in READ_LFIFM_PGD (MODD_GRID). -! Grid and definition of large domain are read in PGD file and -! MOZART files. -! The PGD files are also read in READ_LFIFM_PGD. -! The PGD file is closed. -! Vertical grid is defined in READ_VER_GRID. -! PGD fields are stored on MESO-NH domain (in TRUNC_PGD). -!! -!!** METHOD -!! ------ -!! 0. Declarations -!! 1. Declaration of arguments -!! 2. Declaration of local variables -!! 1. Read PGD file -!! 1. Domain restriction -!! 2. Coordinate conversion to lat,lon system -!! 2. Read Netcdf fields -!! 3. Vertical grid -!! 4. Free all temporary allocations -!! -!! EXTERNAL -!! -------- -!! subroutine READ_LFIFM_PGD : to read PGD file -!! subroutine READ_VER_GRID : to read the vertical grid in namelist file. -!! subroutine HORIBL : horizontal bilinear interpolation -!! subroutine XYTOLATLON : projection from conformal to lat,lon -!! -!! Module MODI_READ_VER_GRID : interface for subroutine READ_VER_GRID -!! Module MODI_HORIBL : interface for subroutine HORIBL -!! Module MODI_XYTOLATLON : interface for subroutine XYTOLATLON -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! Module MODD_CONF : contains configuration variables for all models. -!! NVERB : verbosity level for output-listing -!! Module MODD_LUNIT : contains logical unit names for all models -!! CLUOUT0 : name of output-listing -!! Module MODD_PGDDIM : contains dimension of PGD fields -!! NPGDIMAX: dimension along x (no external point) -!! NPGDJMAX: dimension along y (no external point) -!! Module MODD_PARAMETERS -!! JPHEXT -!! -!! MODIFICATIONS -!! ------------- -!! Original 23/01/12 (C. Mari) -!! A. Berger 20/03/12 adapt whatever the chemical mechanism in BASIC -!! P. Wautelet 30/10/17 use F90 module for netCDF -!! J.Pianezzej 13/02/2019 : correction for use of MEGAN -! P. Wautelet 18/09/2019: correct support of 64bit integers (MNH_INT=8) -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -!------------ -! -USE MODD_BLANK_n -USE MODD_CH_AEROSOL, ONLY: CORGANIC, NCARB, NSOA, NSP, LORILAM,& - JPMODE, LVARSIGI, LVARSIGJ,CAERONAMES -USE MODD_CH_M9_n, ONLY: NEQ , CNAMES -USE MODD_CH_MNHC_n, ONLY: LUSECHEM,LUSECHAQ,LUSECHIC,LCH_PH -USE MODD_CONF -USE MODD_CONF_n -USE MODD_CST -USE MODD_DIM_n -USE MODD_GRID -USE MODD_GRID_n -USE MODD_IO, ONLY: TFILEDATA -USE MODD_LUNIT, ONLY: TLUOUT0 -USE MODE_MODELN_HANDLER -USE MODD_NETCDF, ONLY:CDFINT -USE MODD_NSV -USE MODD_PARAMETERS -USE MODD_PARAM_n, ONLY : CTURB -USE MODD_PREP_REAL -USE MODD_TIME -USE MODD_TIME_n -! -!UPG*PT -!USE MODE_FM -!USE MODE_IO_ll -USE MODE_TOOLS, ONLY: UPCASE -use MODE_TOOLS_ll -USE MODE_IO_FILE, only: IO_File_close -!UPG*PT - -USE MODE_MPPDB -USE MODE_THERMO -USE MODE_TIME -! -USE MODI_CH_AER_INIT_SOA -USE MODI_CH_INIT_SCHEME_n -USE MODI_CH_OPEN_INPUT -USE MODI_HORIBL -USE MODI_INI_NSV -USE MODI_READ_HGRID_n -USE MODI_READ_VER_GRID -USE MODI_XYTOLATLON -! -USE NETCDF -! -IMPLICIT NONE -! -!* 0.1. Declaration of arguments -! ------------------------ -! -TYPE(TFILEDATA),POINTER,INTENT(IN) :: TPPRE_REAL1 ! PRE_REAL1 file -CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of the MOZART file -TYPE(TFILEDATA), INTENT(IN) :: TPPGDFILE ! physiographic data file -REAL, INTENT(INOUT) :: PTIME_HORI ! time spent in hor. interpolations -INTEGER, INTENT(IN) :: KVERB ! verbosity level -LOGICAL, INTENT(IN) :: ODUMMY_REAL! flag to interpolate dummy fields -! -!* 0.2 Declaration of local variables -! ------------------------------ -! General purpose variables -INTEGER :: ILUOUT0 ! Unit used for output msg. -INTEGER :: IRET ! Return code from subroutines -INTEGER :: JI,JJ,JK ! Dummy counters -INTEGER :: JLOOP1 ! | -INTEGER :: JNCHEM, JNAER ! conters of chemical species in BASIC -! Variables used by the PGD reader -CHARACTER(LEN=28) :: YPGD_NAME ! not used - dummy argument -CHARACTER(LEN=28) :: YPGD_DAD_NAME ! not used - dummy argument -CHARACTER(LEN=2) :: YPGD_TYPE ! not used - dummy argument -! PGD Grib definition variables -INTEGER :: INO ! Number of points of the grid -INTEGER :: IIU ! Number of points along X -INTEGER :: IJU ! Number of points along Y -REAL, DIMENSION(:), ALLOCATABLE :: ZLONOUT ! mapping PGD -> Grib (lon.) -REAL, DIMENSION(:), ALLOCATABLE :: ZLATOUT ! mapping PGD -> Grib (lat.) -REAL, DIMENSION(:,:), ALLOCATABLE :: ZXM ! X of PGD mass points -REAL, DIMENSION(:,:), ALLOCATABLE :: ZYM ! Y of PGD mass points -REAL, DIMENSION(:,:), ALLOCATABLE :: ZLATM ! Lat of PGD mass points -REAL, DIMENSION(:,:), ALLOCATABLE :: ZLONM ! Lon of PGD mass points -! Variable involved in the task of reading the netcdf file -REAL,DIMENSION(:,:),ALLOCATABLE :: ZVALUE ! Intermediate array -REAL,DIMENSION(:),ALLOCATABLE :: ZVALUE1D ! Intermediate array -REAL,DIMENSION(:,:),ALLOCATABLE :: ZOUT ! Intermediate arrays -REAL,DIMENSION(:),ALLOCATABLE :: ZOUT1D ! Intermediate arrays -INTEGER(kind=CDFINT) :: ind_netcdf ! Indice for netcdf var. -!chemistry field infile MOZ1.nam -INTEGER :: ICHANNEL -CHARACTER(LEN=8) :: YMOZ="MOZ1.nam" -integer :: IMOZ -CHARACTER(LEN=100) :: YFORMAT -CHARACTER(LEN=40), DIMENSION(:), ALLOCATABLE :: YSPCMNH -integer, dimension(:), ALLOCATABLE :: ISPCMOZ -CHARACTER(LEN=9) :: YA -REAL,DIMENSION(:,:),ALLOCATABLE :: ZCOEFMOZART -CHARACTER(LEN=18),dimension(:,:),ALLOCATABLE :: YCHANGE -type TZMOZ -real :: ZCOEFMOZ -character(16) :: YSPCMOZ -end type TZMOZ -type(TZMOZ), DIMENSION(:,:),ALLOCATABLE :: TZSTOC -! model indice -INTEGER :: IMI -TYPE(TFILEDATA),POINTER :: TZFILE -! -! For netcdf -! -integer(kind=CDFINT) :: status, ncid, varid -integer(kind=CDFINT) :: lat_varid, lon_varid, lev_varid, time_varid -integer(kind=CDFINT) :: hyam_varid, hybm_varid, p0_varid, t_varid, q_varid, ps_varid -integer(kind=CDFINT) :: recid, latid, lonid, levid, timeid -integer(kind=CDFINT) :: latlen, lonlen, levlen, nrecs,timelen -integer(kind=CDFINT) :: itimeindex -integer :: KILEN -CHARACTER(LEN=40) :: recname -REAL, DIMENSION(:), ALLOCATABLE :: lats -REAL, DIMENSION(:), ALLOCATABLE :: lons -REAL, DIMENSION(:), ALLOCATABLE :: levs -INTEGER(kind=CDFINT), DIMENSION(:), ALLOCATABLE :: count3d, start3d -INTEGER(kind=CDFINT), DIMENSION(:), ALLOCATABLE :: count2d, start2d -REAL, DIMENSION(:), ALLOCATABLE :: time, hyam, hybm -REAL :: p0 -INTEGER, DIMENSION(:), ALLOCATABLE :: kinlo -REAL, DIMENSION(:,:,:), ALLOCATABLE :: vartemp3d,vartemp3dbis,vartemp3dter -REAL, DIMENSION(:,:,:), ALLOCATABLE :: vartemp3dquater -REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCHEMMOZ, ZTMOZ, ZQMOZ -REAL, DIMENSION(:,:), ALLOCATABLE :: ZPSMOZ - -real ::a,b - -!---------------------------------------------------------------------- -TZFILE => NULL() -! -IMI = GET_CURRENT_MODEL_INDEX() -! -!* 1. READ PGD FILE -! ------------- -! -ILUOUT0 = TLUOUT0%NLU -CALL READ_HGRID_n(TPPGDFILE,YPGD_NAME,YPGD_DAD_NAME,YPGD_TYPE) -! -! 1.1 Domain restriction -! -CALL GET_DIM_EXT_ll('B',IIU,IJU) -INO = IIU * IJU -! -! -! 1.2 Coordinate conversion to lat,lon system -! -ALLOCATE (ZXM(IIU,IJU)) -ALLOCATE (ZYM(IIU,IJU)) -ALLOCATE (ZLONM(IIU,IJU)) -ALLOCATE (ZLATM(IIU,IJU)) -ZXM(1:IIU-1,1) = (XXHAT(1:IIU-1) + XXHAT(2:IIU) ) / 2. -ZXM(IIU,1) = XXHAT(IIU) - XXHAT(IIU-1) + ZXM(IIU-1,1) -ZXM(:,2:IJU) = SPREAD(ZXM(:,1),2,IJU-1) -ZYM(1,1:IJU-1) = (XYHAT(1:IJU-1) + XYHAT(2:IJU)) / 2. -ZYM(1,IJU) = XYHAT(IJU) - XYHAT(IJU-1) + ZYM(1,IJU-1) -ZYM(2:IIU,:) = SPREAD(ZYM(1,:),1,IIU-1) -CALL SM_XYTOLATLON_A (XLAT0,XLON0,XRPK,XLATORI,XLONORI,ZXM,ZYM,ZLATM,ZLONM, & - IIU,IJU) -ALLOCATE (ZLONOUT(INO)) -ALLOCATE (ZLATOUT(INO)) -JLOOP1 = 0 -DO JJ = 1, IJU - ZLONOUT(JLOOP1+1:JLOOP1+IIU) = ZLONM(1:IIU,JJ) - ZLATOUT(JLOOP1+1:JLOOP1+IIU) = ZLATM(1:IIU,JJ) - JLOOP1 = JLOOP1 + IIU -ENDDO -DEALLOCATE (ZYM) -DEALLOCATE (ZXM) -! -! -!* 2. READ NETCDF FIELDS -! ------------------ -! -! 2.1 Open netcdf files -! -status = nf90_open(HFILE, nf90_nowrite, ncid) -if (status /= nf90_noerr) call handle_err(status) -! -! 2.2 Read netcdf files -! -! get dimension IDs -! -!* get dimension ID of unlimited variable in netcdf file -status = nf90_inquire(ncid, unlimitedDimId = recid) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_dimid(ncid, "lat", latid) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_dimid(ncid, "lon", lonid) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_dimid(ncid, "lev", levid) -if (status /= nf90_noerr) call handle_err(status) -! -! get dimensions -! -!* get dimension and name of unlimited variable in netcdf file -status = nf90_inquire_dimension(ncid, recid, name=recname, len=nrecs) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inquire_dimension(ncid, latid, len=latlen) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inquire_dimension(ncid, lonid, len=lonlen) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inquire_dimension(ncid, levid, len=levlen) -if (status /= nf90_noerr) call handle_err(status) -! -! get variable IDs -! -status = nf90_inq_varid(ncid, "lat", lat_varid) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_varid(ncid, "lon", lon_varid) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_varid(ncid, "lev", lev_varid) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_varid(ncid, "time", time_varid) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_varid(ncid, "P0", p0_varid) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_varid(ncid, "hyam", hyam_varid) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_varid(ncid, "hybm", hybm_varid) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_varid(ncid, "T", t_varid) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_varid(ncid, "Q", q_varid) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_varid(ncid, "PS", ps_varid) -if (status /= nf90_noerr) call handle_err(status) -! -KILEN = latlen * lonlen -! -! 2.3 Read data. -! -ALLOCATE (count3d(4)) -ALLOCATE (start3d(4)) -ALLOCATE (count2d(3)) -ALLOCATE (start2d(3)) -ALLOCATE (lats(latlen)) -ALLOCATE (lons(lonlen)) -ALLOCATE (levs(levlen)) -ALLOCATE (time(nrecs)) -ALLOCATE (kinlo(latlen)) -kinlo(:) = lonlen -ALLOCATE (vartemp3d(lonlen,latlen,levlen)) -ALLOCATE (vartemp3dbis(lonlen,latlen,levlen)) -ALLOCATE (vartemp3dter(lonlen,latlen,levlen)) -ALLOCATE (vartemp3dquater(lonlen,latlen,levlen)) -ALLOCATE (ZCHEMMOZ(lonlen,latlen,levlen)) -ALLOCATE (ZTMOZ(lonlen,latlen,levlen)) -ALLOCATE (ZQMOZ(lonlen,latlen,levlen)) -ALLOCATE (ZPSMOZ(lonlen,latlen)) -ALLOCATE (XA_SV_LS(levlen)) -ALLOCATE (hyam(levlen)) -ALLOCATE (XB_SV_LS(levlen)) -ALLOCATE (hybm(levlen)) -ALLOCATE (XT_SV_LS(IIU,IJU,levlen)) -ALLOCATE (XQ_SV_LS(IIU,IJU,levlen,1)) -ALLOCATE (XPS_SV_LS(IIU,IJU)) -ALLOCATE (XZS_SV_LS(IIU,IJU)) -! take the orography from ECMWF -XZS_SV_LS(:,:) = XZS_LS(:,:) -! -! get values of variables -! -status = nf90_get_var(ncid, lat_varid, lats(:)) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_get_var(ncid, lon_varid, lons(:)) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_get_var(ncid, lev_varid, levs(:)) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_get_var(ncid, time_varid, time(:)) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_get_var(ncid, hyam_varid, hyam) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_get_var(ncid, hybm_varid, hybm) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_get_var(ncid, p0_varid, p0) -if (status /= nf90_noerr) call handle_err(status) -XP00_SV_LS = p0 -! -! hyam and hybm coefficients for pressure calculations have to be reversed -! from top-bottom to bottom-up direction -do JJ = 1, levlen - XA_SV_LS(JJ) = hyam(levlen+1-JJ) - XB_SV_LS(JJ) = hybm(levlen+1-JJ) -end do -! -! -! Read 1 record of lon*lat*lev values, starting at the -! beginning of the record (the (1, 1, 1, rec) element in the netCDF -! file). - count3d(1) = lonlen - count3d(2) = latlen - count3d(3) = levlen - count3d(4) = 1 - start3d(1) = 1 - start3d(2) = 1 - start3d(3) = 1 -! Choose time index according to the chosen time in namelist -! 1 for 06h - 2 for 12h - 3 for 18h - 4 for 24h -IF (CDUMMY1=="06") THEN - itimeindex=1 -ELSEIF (CDUMMY1=="12") THEN - itimeindex=2 -ELSEIF (CDUMMY1=="18") THEN - itimeindex=3 -ELSEIF ((CDUMMY1=="24").OR.(CDUMMY1=="00")) THEN - itimeindex=4 -ENDIF - start3d(4) = itimeindex -! - status = nf90_get_var(ncid, t_varid, vartemp3d, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) -! -do JJ=1,levlen -! lev, lat, lon - ZTMOZ(:,:,JJ) = vartemp3d(:,:,levlen+1-JJ) -enddo -! - status = nf90_get_var(ncid, q_varid, vartemp3d, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) -! -do JJ=1,levlen -! lev, lat, lon - ZQMOZ(:,:,JJ) = vartemp3d(:,:,levlen+1-JJ) -enddo -! - count2d(1) = lonlen - count2d(2) = latlen - count2d(3) = 1 - start2d(1) = 1 - start2d(2) = 1 - start2d(3) = itimeindex - status = nf90_get_var(ncid, ps_varid, ZPSMOZ(:,:), start=start2d, count=count2d) - if (status /= nf90_noerr) call handle_err(status) - - -!------------------------------------------------------------------------ -!* 3 Interpolation of MOZART variable -!--------------------------------------------------------------------- - ! Always initialize chemical scheme variables before INI_NSV call ! - CALL CH_INIT_SCHEME_n(IMI,LUSECHAQ,LUSECHIC,LCH_PH,ILUOUT0,KVERB) - LUSECHEM = .TRUE. - IF (LORILAM) THEN - CORGANIC = "MPMPO" - LVARSIGI = .TRUE. - LVARSIGJ = .TRUE. - CALL CH_AER_INIT_SOA(ILUOUT0, KVERB) - END IF - ! initialise NSV_* variables - CALL INI_NSV(1) - DEALLOCATE(XSV_LS) - ALLOCATE (XSV_LS(IIU,IJU,levlen,NSV)) - XSV_LS(:,:,:,:) = 0. -! - WRITE (ILUOUT0,'(A,A4,A)') ' | Reading MOZART species (ppp) from ',HFILE,' file' - -where (ZLONOUT(:) < 0.) ZLONOUT(:) = ZLONOUT(:) + 360. -! -ALLOCATE(ZVALUE(levlen,KILEN)) -ALLOCATE(ZOUT(levlen,INO)) -ALLOCATE(ZVALUE1D(KILEN)) -ALLOCATE(ZOUT1D(INO)) - -! -!* 2.6.1 read MOZART species from the file MOZ1.nam -! -! open input file -CALL CH_OPEN_INPUT(YMOZ,"MOZ2MESONH",TZFILE,ILUOUT0,KVERB) -ICHANNEL = TZFILE%NLU -! -!read number of mocage species to transfer into mesonh -READ(ICHANNEL, *) IMOZ -IF (KVERB >= 5) WRITE (ILUOUT0,*) "number of mozart species to transfer into & -& mesonh : ", IMOZ -! -!read data input format -READ(ICHANNEL,"(A)") YFORMAT -YFORMAT=UPCASE(YFORMAT) -IF (KVERB >= 5) WRITE (ILUOUT0,*) "input format is: ", YFORMAT - -! -!allocate fields -ALLOCATE(YSPCMNH(IMOZ)) !MESONH species -ALLOCATE(TZSTOC(IMOZ,4)) !MOZART coefficient and MOZART species associated -ALLOCATE(ISPCMOZ(IMOZ)) !MOZART species number into MESONH species -ALLOCATE(ZCOEFMOZART(IMOZ,4))!Coef stoich of each MOZART species -ALLOCATE(YCHANGE(IMOZ,4)) !MOZART species with _VMR_inst -!read MESONH variable names and MOZART variable names associated -DO JI = 1,IMOZ !for every MNH species existing in MOZ1.nam - - READ(ICHANNEL,YFORMAT) YSPCMNH(JI), ISPCMOZ(JI), TZSTOC(JI,1)%ZCOEFMOZ,& !reading line by line - TZSTOC(JI,1)%YSPCMOZ, TZSTOC(JI,2)%ZCOEFMOZ,& !of string - TZSTOC(JI,2)%YSPCMOZ, TZSTOC(JI,3)%ZCOEFMOZ,& - TZSTOC(JI,3)%YSPCMOZ, TZSTOC(JI,4)%ZCOEFMOZ,& - TZSTOC(JI,4)%YSPCMOZ - WRITE(ILUOUT0,YFORMAT) YSPCMNH(JI), ISPCMOZ(JI),& !writing in arrays - TZSTOC(JI,1)%ZCOEFMOZ, TZSTOC(JI,1)%YSPCMOZ,& - TZSTOC(JI,2)%ZCOEFMOZ, TZSTOC(JI,2)%YSPCMOZ,& - TZSTOC(JI,3)%ZCOEFMOZ, TZSTOC(JI,3)%YSPCMOZ,& - TZSTOC(JI,4)%ZCOEFMOZ, TZSTOC(JI,4)%YSPCMOZ -! - ZCOEFMOZART(JI,1) = (TZSTOC(JI,1)%ZCOEFMOZ) !coef stoich of each MOZART species set into an array - ZCOEFMOZART(JI,2) = (TZSTOC(JI,2)%ZCOEFMOZ) - ZCOEFMOZART(JI,3) = (TZSTOC(JI,3)%ZCOEFMOZ) - ZCOEFMOZART(JI,4) = (TZSTOC(JI,4)%ZCOEFMOZ) -! - YA="_VMR_inst" - YCHANGE(JI,1)=trim(TZSTOC(JI,1)%YSPCMOZ)//YA !set into an array MOZART species with _VMR_inst - YCHANGE(JI,2)=trim(TZSTOC(JI,2)%YSPCMOZ)//YA - YCHANGE(JI,3)=trim(TZSTOC(JI,3)%YSPCMOZ)//YA - YCHANGE(JI,4)=trim(TZSTOC(JI,4)%YSPCMOZ)//YA -! -!* exchange mozart values onto prognostic variables XSV_LS -! and convert MOZART fields to 2D for use in horizontal interpolation -! routine HORIBL.f90 -! - DO JNCHEM = NSV_CHEMBEG, NSV_CHEMEND !loop on all MNH species - IF (trim(CNAMES(JNCHEM-NSV_CHEMBEG+1))==trim(YSPCMNH(JI))) THEN !MNH mechanism species - IF (ISPCMOZ(JI)==1) THEN - status = nf90_inq_varid(ncid, trim(YCHANGE(JI,1)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - DO JJ=1,levlen ! lev, lat, lon - ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*vartemp3d(:,:,levlen+1-JJ) - ENDDO - ELSE IF (ISPCMOZ(JI)==2) THEN - status = nf90_inq_varid(ncid, trim(YCHANGE(JI,1)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_inq_varid(ncid, trim(YCHANGE(JI,2)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3dbis, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - DO JJ=1,levlen ! lev, lat, lon - ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*vartemp3d(:,:,levlen+1-JJ) + & - ZCOEFMOZART(JI,2)*vartemp3dbis(:,:,levlen+1-JJ) - ENDDO - ELSE IF (ISPCMOZ(JI)==3) THEN - status = nf90_inq_varid(ncid, trim(YCHANGE(JI,1)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_inq_varid(ncid, trim(YCHANGE(JI,2)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3dbis, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_inq_varid(ncid, trim(YCHANGE(JI,3)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3dter, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - DO JJ=1,levlen ! lev, lat, lon - ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*vartemp3d(:,:,levlen+1-JJ)+& - ZCOEFMOZART(JI,2)*vartemp3dbis(:,:,levlen+1-JJ)+& - ZCOEFMOZART(JI,3)*vartemp3dter(:,:,levlen+1-JJ) - ENDDO - ELSE IF (ISPCMOZ(JI)==4) THEN - status = nf90_inq_varid(ncid, trim(YCHANGE(JI,1)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_inq_varid(ncid, trim(YCHANGE(JI,2)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3dbis, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_inq_varid(ncid, trim(YCHANGE(JI,3)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3dter, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_inq_varid(ncid, trim(YCHANGE(JI,4)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3dquater, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - DO JJ=1,levlen ! lev, lat, lon - ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*vartemp3d(:,:,levlen+1-JJ)+& - ZCOEFMOZART(JI,2)*vartemp3dbis(:,:,levlen+1-JJ)+& - ZCOEFMOZART(JI,3)*vartemp3dter(:,:,levlen+1-JJ)+& - ZCOEFMOZART(JI,4)*vartemp3dquater(:,:,levlen+1-JJ) - ENDDO - ENDIF - DO JK = 1, levlen - JLOOP1 = 0 - DO JJ = 1, latlen - ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZCHEMMOZ(1:lonlen,JJ,JK) - JLOOP1 = JLOOP1+lonlen - ENDDO - CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), & - int(latlen,kind=kind(1)),kinlo,KILEN, & - ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, & - ZOUT(JK,:),.FALSE.,PTIME_HORI,.TRUE.) - CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU, & - XSV_LS(:,:,JK,JNCHEM) ) - ENDDO ! levlen - ENDIF - - ENDDO ! JNCHEM - DO JNAER = NSV_AERBEG, NSV_AEREND - IF (trim(CAERONAMES(JNAER-NSV_AERBEG+1))==trim(YSPCMNH(JI))) THEN !MNH mechanism species - IF (ISPCMOZ(JI)==1) THEN - status = nf90_inq_varid(ncid, trim(YCHANGE(JI,1)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - DO JJ=1,levlen ! lev, lat, lon - ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*vartemp3d(:,:,levlen+1-JJ) - ENDDO - ELSE IF (ISPCMOZ(JI)==2) THEN - status = nf90_inq_varid(ncid, trim(YCHANGE(JI,1)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_inq_varid(ncid, trim(YCHANGE(JI,2)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3dbis, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - DO JJ=1,levlen ! lev, lat, lon - ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*vartemp3d(:,:,levlen+1-JJ) + & - ZCOEFMOZART(JI,2)*vartemp3dbis(:,:,levlen+1-JJ) - ENDDO - ELSE IF (ISPCMOZ(JI)==3) THEN - status = nf90_inq_varid(ncid, trim(YCHANGE(JI,1)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_inq_varid(ncid, trim(YCHANGE(JI,2)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3dbis, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_inq_varid(ncid, trim(YCHANGE(JI,3)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3dter, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - DO JJ=1,levlen ! lev, lat, lon - ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*vartemp3d(:,:,levlen+1-JJ)+& - ZCOEFMOZART(JI,2)*vartemp3dbis(:,:,levlen+1-JJ)+& - ZCOEFMOZART(JI,3)*vartemp3dter(:,:,levlen+1-JJ) - ENDDO - ELSE IF (ISPCMOZ(JI)==4) THEN - status = nf90_inq_varid(ncid, trim(YCHANGE(JI,1)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_inq_varid(ncid, trim(YCHANGE(JI,2)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3dbis, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_inq_varid(ncid, trim(YCHANGE(JI,3)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3dter, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_inq_varid(ncid, trim(YCHANGE(JI,4)), ind_netcdf) - if (status /= nf90_noerr) call handle_err(status) - status = nf90_get_var(ncid, ind_netcdf, vartemp3dquater, start=start3d, count=count3d) - if (status /= nf90_noerr) call handle_err(status) - DO JJ=1,levlen ! lev, lat, lon - ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*vartemp3d(:,:,levlen+1-JJ)+& - ZCOEFMOZART(JI,2)*vartemp3dbis(:,:,levlen+1-JJ)+& - ZCOEFMOZART(JI,3)*vartemp3dter(:,:,levlen+1-JJ)+& - ZCOEFMOZART(JI,4)*vartemp3dquater(:,:,levlen+1-JJ) - ENDDO - ENDIF - DO JK = 1, levlen - JLOOP1 = 0 - DO JJ = 1, latlen - ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZCHEMMOZ(1:lonlen,JJ,JK) - JLOOP1 = JLOOP1+lonlen - ENDDO - CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), & - int(latlen,kind=kind(1)),kinlo,KILEN, & - ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, & - ZOUT(JK,:),.FALSE.,PTIME_HORI,.TRUE.) - CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU, & - XSV_LS(:,:,JK,JNAER) ) - ENDDO ! levlen - ENDIF - ENDDO ! JNAER -ENDDO ! JIDO JNCHEM = NSV_CHEMBEG, NSV_CHEMEND !loop on all MNH species -DEALLOCATE(YSPCMNH) -DEALLOCATE(TZSTOC) -DEALLOCATE(ISPCMOZ) -DEALLOCATE(ZCOEFMOZART) -DEALLOCATE(YCHANGE) -! -XSV_LS(:,:,:,:) = MAX(XSV_LS(:,:,:,:),0.) -! -DO JK = 1, levlen - JLOOP1 = 0 - DO JJ = 1, latlen - ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZTMOZ(1:lonlen,JJ,JK) - JLOOP1 = JLOOP1 + lonlen - ENDDO - CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), & - int(latlen,kind=kind(1)),kinlo,KILEN, & - ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, & - ZOUT(JK,:),.FALSE.,PTIME_HORI,.FALSE.) -! - CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU, & - XT_SV_LS(:,:,JK)) -ENDDO -XT_SV_LS(:,:,:) = MAX(XT_SV_LS(:,:,:),0.) -! -DO JK = 1, levlen - JLOOP1 = 0 - DO JJ = 1, latlen - ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZQMOZ(1:lonlen,JJ,JK) - JLOOP1 = JLOOP1 + lonlen - ENDDO - CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), & - int(latlen,kind=kind(1)),kinlo,KILEN, & - ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, & - ZOUT(JK,:),.FALSE.,PTIME_HORI,.FALSE.) -! - CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU, & - XQ_SV_LS(:,:,JK,1)) -ENDDO -XQ_SV_LS(:,:,:,1) = MAX(XQ_SV_LS(:,:,:,1),0.) -! -JLOOP1 = 0 -DO JJ = 1, latlen - ZVALUE1D(JLOOP1+1:JLOOP1+lonlen) = ZPSMOZ(1:lonlen,JJ) - JLOOP1 = JLOOP1 + lonlen -ENDDO -CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), & - int(latlen,kind=kind(1)),kinlo,KILEN, & - ZVALUE1D(:),INO,ZLONOUT,ZLATOUT, & - ZOUT1D(:),.FALSE.,PTIME_HORI,.FALSE.) -! -CALL ARRAY_1D_TO_2D(INO,ZOUT1D(:),IIU,IJU, & - XPS_SV_LS(:,:)) -XPS_SV_LS(:,:) = MAX(XPS_SV_LS(:,:),0.) -! -! -! -! close the netcdf file -status = nf90_close(ncid) -if (status /= nf90_noerr) call handle_err(status) -! - DEALLOCATE (ZVALUE) - DEALLOCATE (ZOUT) - DEALLOCATE (ZVALUE1D) - DEALLOCATE (ZOUT1D) -!! - -! close -! file -CALL IO_File_close(TZFILE) - - -!------------------------------------------------------------- -! -!* 4. VERTICAL GRID -! -!* 4.1 Read VERTICAL GRID -! -WRITE (ILUOUT0,'(A)') ' | Reading of vertical grid in progress' -CALL READ_VER_GRID(TPPRE_REAL1) -! -!-------------------------------------------------------------- -! -!* 4.2 Interpolate on Meso-NH VERTICAL GRID -! -!* 4.3 Free all temporary allocations -! -DEALLOCATE (ZLATOUT) -DEALLOCATE (ZLONOUT) -DEALLOCATE (hyam) -DEALLOCATE (hybm) -DEALLOCATE (vartemp3d) -DEALLOCATE (vartemp3dbis) -DEALLOCATE (vartemp3dter) -DEALLOCATE (vartemp3dquater) -! -WRITE (ILUOUT0,'(A,A4,A)') ' -- netcdf decoder for ',HFILE,' file ended successfully' -! -! -CONTAINS -! -! ############################# - SUBROUTINE HANDLE_ERR(STATUS) -! ############################# - INTEGER(KIND=CDFINT) STATUS - IF (STATUS .NE. NF90_NOERR) THEN - PRINT *, NF90_STRERROR(STATUS) - STOP 'Stopped' - ENDIF - END SUBROUTINE HANDLE_ERR -! -! -! ############################################# - SUBROUTINE ARRAY_1D_TO_2D (KN1,P1,KL1,KL2,P2) -! ############################################# -! -! Small routine used to store a linear array into a 2 dimension array -! -USE MODE_MSG -IMPLICIT NONE -INTEGER, INTENT(IN) :: KN1 -REAL,DIMENSION(KN1), INTENT(IN) :: P1 -INTEGER, INTENT(IN) :: KL1 -INTEGER, INTENT(IN) :: KL2 -REAL,DIMENSION(KL1,KL2),INTENT(OUT) :: P2 -INTEGER :: JLOOP1_A1T2 -INTEGER :: JLOOP2_A1T2 -INTEGER :: JPOS_A1T2 -! -IF (KN1 < KL1*KL2) THEN - CALL PRINT_MSG(NVERB_FATAL,'GEN','ARRAY_1D_TO_2D','sizes do not match') -END IF -JPOS_A1T2 = 1 -DO JLOOP2_A1T2 = 1, KL2 - DO JLOOP1_A1T2 = 1, KL1 - P2(JLOOP1_A1T2,JLOOP2_A1T2) = P1(JPOS_A1T2) - JPOS_A1T2 = JPOS_A1T2 + 1 - END DO -END DO -END SUBROUTINE ARRAY_1D_TO_2D -! -END SUBROUTINE READ_CHEM_DATA_MOZART_CASE diff --git a/src/ICCARE_BASE/read_dmsn.F90 b/src/ICCARE_BASE/read_dmsn.F90 deleted file mode 100644 index c5a34c317..000000000 --- a/src/ICCARE_BASE/read_dmsn.F90 +++ /dev/null @@ -1,102 +0,0 @@ -!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -! ######### - SUBROUTINE READ_DMS_n(DSF, U, HPROGRAM) -! ################################# -! -!!**** *READ_DMS_n* - routine to read oceanic DMS surface fields -!! -!! PURPOSE -!! ------- -!! -!! AUTHOR -!! ------ -!! P. Tulet *LAERO* -!! -!! MODIFICATIONS -!! ------------- -!! Original 06/2021 -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_DMS_SURF_FIELDS_n, ONLY : DMS_SURF_FIELDS_t -USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t -! -USE MODI_READ_SURF -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -IMPLICIT NONE -! -!* 0.1 Declarations of arguments -! ------------------------- -! -TYPE(DMS_SURF_FIELDS_t), INTENT(INOUT) :: DSF -TYPE(SURF_ATM_t), INTENT(INOUT) :: U -! - CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! -! -!* 0.2 Declarations of local variables -! ------------------------------- -! -INTEGER :: JDMS ! loop counter -CHARACTER(LEN=3) :: YDMS -! - CHARACTER(LEN=20 ):: YSTRING20 ! string - CHARACTER(LEN=3 ):: YSTRING03 ! string -! -INTEGER :: IRESP ! IRESP : return-code if a problem appears - CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read - CHARACTER(LEN=100):: YCOMMENT ! Comment string -REAL(KIND=JPRB) :: ZHOOK_HANDLE -! -!------------------------------------------------------------------------------- -! -!* 2. Number of dummy fields : -! ---------------------- -! -IF (LHOOK) CALL DR_HOOK('READ_DMS_N',0,ZHOOK_HANDLE) -! -YRECFM='DMS_GR_NBR' -YCOMMENT=' ' -! - CALL READ_SURF(HPROGRAM,YRECFM,DSF%NDMS_NBR,IRESP,HCOMMENT=YCOMMENT) -! -!------------------------------------------------------------------------------- -! -!* 3. Dummy fields : -! ------------ -! -ALLOCATE(DSF%CDMS_NAME(DSF%NDMS_NBR)) -ALLOCATE(DSF%CDMS_AREA(DSF%NDMS_NBR)) -ALLOCATE(DSF%XDMS_FIELDS(U%NSIZE_FULL,DSF%NDMS_NBR)) -DSF%CDMS_NAME(:) = ' ' -DSF%CDMS_AREA(:) = 'SEA' -! -! -DO JDMS=1,DSF%NDMS_NBR - ! - WRITE(YDMS,'(I3.3)') (JDMS) - YRECFM='DMS_NB'//ADJUSTL(YDMS(:LEN_TRIM(YDMS))) - YSTRING20=DSF%CDMS_NAME(JDMS) - YSTRING03=DSF%CDMS_AREA(JDMS) - YCOMMENT='X_Y_'//ADJUSTL(YRECFM(:LEN_TRIM(YRECFM)))//'_'//ADJUSTL(YSTRING20(:LEN_TRIM(YSTRING20)))//& - '_'//ADJUSTL(YSTRING03(:LEN_TRIM(YSTRING03))) - - CALL READ_SURF(HPROGRAM,YRECFM,DSF%XDMS_FIELDS(:,JDMS),IRESP,HCOMMENT=YCOMMENT) - - YRECFM='DMS_NAME'//ADJUSTL(YDMS(:LEN_TRIM(YDMS))) - CALL READ_SURF(HPROGRAM,YRECFM,DSF%CDMS_NAME(JDMS),IRESP,HCOMMENT=YCOMMENT) - ! -END DO -! -IF (LHOOK) CALL DR_HOOK('READ_DMS_N',1,ZHOOK_HANDLE) -! -!------------------------------------------------------------------------------- -! -END SUBROUTINE READ_DMS_n diff --git a/src/ICCARE_BASE/read_exsegn.f90 b/src/ICCARE_BASE/read_exsegn.f90 deleted file mode 100644 index 623a7cd4e..000000000 --- a/src/ICCARE_BASE/read_exsegn.f90 +++ /dev/null @@ -1,2999 +0,0 @@ -!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!----------------------------------------------------------------- -! ###################### - MODULE MODI_READ_EXSEG_n -! ###################### -! -INTERFACE -! - SUBROUTINE READ_EXSEG_n(KMI,TPEXSEGFILE,HCONF,OFLAT,OUSERV, & - OUSERC,OUSERR,OUSERI,OUSECI,OUSERS,OUSERG,OUSERH, & - OUSECHEM,OUSECHAQ,OUSECHIC,OCH_PH,OCH_CONV_LINOX,OSALT, & - ODEPOS_SLT, ODUST,ODEPOS_DST, OCHTRANS, & - OORILAM,ODEPOS_AER, OLG,OPASPOL, & -#ifdef MNH_FOREFIRE - OFOREFIRE, & -#endif - OLNOX_EXPLICIT, & - OCONDSAMP,OBLOWSNOW, & - KRIMX,KRIMY, KSV_USER, & - HTURB,HTOM,ORMC01,HRAD,HDCONV,HSCONV,HCLOUD,HELEC, & - HEQNSYS,PTSTEP_ALL,HSTORAGE_TYPE,HINIFILEPGD ) -! -USE MODD_IO, ONLY: TFILEDATA -! -INTEGER, INTENT(IN) :: KMI ! Model index -TYPE(TFILEDATA), INTENT(IN) :: TPEXSEGFILE ! EXSEG file -! The following variables are read by READ_DESFM in DESFM descriptor : -CHARACTER (LEN=*), INTENT(IN) :: HCONF ! configuration var. linked to FMfile -LOGICAL, INTENT(IN) :: OFLAT ! Logical for zero orography -LOGICAL, INTENT(IN) :: OUSERV,OUSERC,OUSERR,OUSERI,OUSERS, & - OUSERG,OUSERH ! kind of moist variables in - ! FMfile -LOGICAL, INTENT(IN) :: OUSECI ! ice concentration in - ! FMfile -LOGICAL, INTENT(IN) :: OUSECHEM ! Chemical FLAG in FMFILE -LOGICAL, INTENT(IN) :: OUSECHAQ ! Aqueous chemical FLAG in FMFILE -LOGICAL, INTENT(IN) :: OUSECHIC ! Ice chemical FLAG in FMFILE -LOGICAL, INTENT(IN) :: OCH_PH ! pH FLAG in FMFILE -LOGICAL, INTENT(IN) :: OCH_CONV_LINOX ! LiNOx FLAG in FMFILE -LOGICAL, INTENT(IN) :: ODUST ! Dust FLAG in FMFILE -LOGICAL,DIMENSION(:), INTENT(IN) :: ODEPOS_DST ! Dust wet deposition FLAG in FMFILE -LOGICAL,DIMENSION(:), INTENT(IN) :: ODEPOS_SLT ! Sea Salt wet deposition FLAG in FMFILE -LOGICAL,DIMENSION(:), INTENT(IN) :: ODEPOS_AER ! Orilam wet deposition FLAG in FMFILE -LOGICAL, INTENT(IN) :: OSALT ! Sea Salt FLAG in FMFILE -LOGICAL, INTENT(IN) :: OORILAM ! Orilam FLAG in FMFILE -LOGICAL, INTENT(IN) :: OPASPOL ! Passive pollutant FLAG in FMFILE -#ifdef MNH_FOREFIRE -LOGICAL, INTENT(IN) :: OFOREFIRE ! ForeFire FLAG in FMFILE -#endif -LOGICAL, INTENT(IN) :: OLNOX_EXPLICIT ! explicit LNOx FLAG in FMFILE -LOGICAL, INTENT(IN) :: OCONDSAMP ! Conditional sampling FLAG in FMFILE -LOGICAL, INTENT(IN) :: OBLOWSNOW ! Blowing snow FLAG in FMFILE -LOGICAL, INTENT(IN) :: OCHTRANS ! LCHTRANS FLAG in FMFILE - -LOGICAL, INTENT(IN) :: OLG ! lagrangian FLAG in FMFILE -INTEGER, INTENT(IN) :: KRIMX, KRIMY ! number of points for the - ! horizontal relaxation for the outermost verticals -INTEGER, INTENT(IN) :: KSV_USER ! number of additional scalar - ! variables in FMfile -CHARACTER (LEN=*), INTENT(IN) :: HTURB ! Kind of turbulence parameterization - ! used to produce FMFILE -CHARACTER (LEN=*), INTENT(IN) :: HTOM ! Kind of third order moment -LOGICAL, INTENT(IN) :: ORMC01 ! flag for RMC01 SBL computations -CHARACTER (LEN=*), INTENT(IN) :: HRAD ! Kind of radiation scheme -CHARACTER (LEN=4), INTENT(IN) :: HDCONV ! Kind of deep convection scheme -CHARACTER (LEN=4), INTENT(IN) :: HSCONV ! Kind of shallow convection scheme -CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme -CHARACTER (LEN=4), INTENT(IN) :: HELEC ! Kind of electrical scheme -CHARACTER (LEN=*), INTENT(IN) :: HEQNSYS! type of equations' system -REAL,DIMENSION(:), INTENT(INOUT):: PTSTEP_ALL ! Time STEP of ALL models -CHARACTER (LEN=*), INTENT(IN) :: HSTORAGE_TYPE ! type of initial file -CHARACTER (LEN=*), INTENT(IN) :: HINIFILEPGD ! name of PGD file -! -END SUBROUTINE READ_EXSEG_n -! -END INTERFACE -! -END MODULE MODI_READ_EXSEG_n -! -! -! ######################################################################### - SUBROUTINE READ_EXSEG_n(KMI,TPEXSEGFILE,HCONF,OFLAT,OUSERV, & - OUSERC,OUSERR,OUSERI,OUSECI,OUSERS,OUSERG,OUSERH, & - OUSECHEM,OUSECHAQ,OUSECHIC,OCH_PH,OCH_CONV_LINOX,OSALT, & - ODEPOS_SLT, ODUST,ODEPOS_DST, OCHTRANS, & - OORILAM,ODEPOS_AER, OLG,OPASPOL, & -#ifdef MNH_FOREFIRE - OFOREFIRE, & -#endif - OLNOX_EXPLICIT, & - OCONDSAMP, OBLOWSNOW, & - KRIMX,KRIMY, KSV_USER, & - HTURB,HTOM,ORMC01,HRAD,HDCONV,HSCONV,HCLOUD,HELEC, & - HEQNSYS,PTSTEP_ALL,HSTORAGE_TYPE,HINIFILEPGD ) -! ######################################################################### -! -!!**** *READ_EXSEG_n * - routine to read the descriptor file EXSEG -!! -!! PURPOSE -!! ------- -! The purpose of this routine is to read the descriptor file called -! EXSEG and to control the coherence with FMfile data . -! -!! -!!** METHOD -!! ------ -!! The descriptor file is read. Namelists (NAMXXXn) which contain -!! variables linked to one nested model are at the beginning of the file. -!! Namelists (NAMXXX) which contain variables common to all models -!! are at the end of the file. When the model index is different from 1, -!! the end of the file (namelists NAMXXX) is not read. -!! -!! Coherence between the initial file (description read in DESFM file) -!! and the segment to perform (description read in EXSEG file) -!! is checked for segment achievement configurations -!! or postprocessing configuration. The get indicators are set according -!! to the following check : -!! -!! - segment achievement and preinit configurations : -!! -!! * if there is no turbulence kinetic energy in initial -!! file (HTURB='NONE'), and the segment to perform requires a turbulence -!! parameterization (CTURB /= 'NONE'), the get indicators for turbulence -!! kinetic energy variables are set to 'INIT'; i.e. these variables will be -!! set equal to zero by READ_FIELD according to the get indicators. -!! * The same procedure is applied to the dissipation of TKE. -!! * if there is no moist variables RRn in initial file (OUSERn=.FALSE.) -!! and the segment to perform requires moist variables RRn -!! (LUSERn=.TRUE.), the get indicators for moist variables RRn are set -!! equal to 'INIT'; i.e. these variables will be set equal to zero by -!! READ_FIELD according to the get indicators. -!! * if there are KSV_USER additional scalar variables in initial file and the -!! segment to perform needs more than KSV_USER additional variables, the get -!! indicators for these (NSV_USER-KSV_USER) additional scalar variables are set -!! equal to 'INIT'; i.e. these variables will be set equal to zero by -!! READ_FIELD according to the get indicators. If the segment to perform -!! needs less additional scalar variables than there are in initial file, -!! the get indicators for these (KSV_USER - NSV_USER) additional scalar variables are -!! set equal to 'SKIP'. -!! * warning messages are printed if the fields in initial file are the -!! same at time t and t-dt (HCONF='START') and a leap-frog advance -!! at first time step will be used for the segment to perform -!! (CCONF='RESTA'); It is likewise when HCONF='RESTA' and CCONF='START'. -!! * A warning message is printed if the orography in initial file is zero -!! (OFLAT=.TRUE.) and the segment to perform considers no-zero orography -!! (LFLAT=.FALSE.). It is likewise for LFLAT=.TRUE. and OFLAT=.FALSE.. -!! If the segment to perform requires zero orography (LFLAT=.TRUE.), the -!! orography (XZS) will not read in initial file but set equal to zero -!! by SET_GRID. -!! * check of the depths of the Lateral Damping Layer in x and y -!! direction is performed -!! * If some coupling files are specified, LSTEADYLS is set to T -!! * If no coupling files are specified, LSTEADYLS is set to F -!! -!! -!! EXTERNAL -!! -------- -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! Module MODN_CONF : CCONF,LTHINSHELL,LFLAT,NMODEL,NVERB -!! -!! Module MODN_DYN : LCORIO, LZDIFFU -!! -!! Module MODN_NESTING : NDAD(m),NDTRATIO(m),XWAY(m) -!! -!! Module MODN_BUDGET : CBUTYPE,XBULEN -!! -!! Module MODN_CONF1 : LUSERV,LUSERC,LUSERR,LUSERI,LUSERS,LUSERG,LUSERH,CSEG -!! -!! Module MODN_DYN1 : XTSTEP,CPRESOPT,NITR,XRELAX -!! -!! Module MODD_ADV1 : CMET_ADV_SCHEME,CSV_ADV_SCHEME,CUVW_ADV_SCHEME,NLITER -!! -!! Module MODN_PARAM1 : CTURB,CRAD,CDCONV,CSCONV -!! -!! Module MODN_LUNIT1 : -!! Module MODN_LBC1 : CLBCX,CLBCY,NLBLX,NLBLY,XCPHASE,XPOND -!! -!! Module MODN_TURB_n : CTURBLEN,CTURBDIM -!! -!! Module MODD_GET1: -!! CGETTKEM,CGETTKET, -!! CGETRVM,CGETRCM,CGETRRM,CGETRIM,CGETRSM,CGETRGM,CGETRHM -!! CGETRVT,CGETRCT,CGETRRT,CGETRIT,CGETRST,CGETRGT,CGETRHT,CGETSVM -!! CGETSVT,CGETSIGS,CGETSRCM,CGETSRCT -!! NCPL_NBR,NCPL_TIMES,NCPL_CUR -!! Module MODN_LES : contains declaration of the control parameters -!! for Large Eddy Simulations' storages -!! for the forcing -!! -!! REFERENCE -!! --------- -!! Book2 of the documentation (routine READ_EXSEG_n) -!! -!! -!! AUTHOR -!! ------ -!! V. Ducrocq * Meteo France * -!! -!! MODIFICATIONS -!! ------------- -!! Original 07/06/94 -!! Modification 26/10/94 (Stein) remove NAM_GET from the Namelists -!! present in DESFM + change the namelist names -!! Modification 22/11/94 (Stein) add GET indicator for phi -!! Modification 21/12/94 (Stein) add GET indicator for LS fields -!! Modification 06/01/95 (Stein) bug in the test for Scalar Var. -!! Modifications 09/01/95 (Stein) add the turbulence scheme -!! Modifications 09/01/95 (Stein) add the 1D switch -!! Modifications 10/03/95 (Mallet) add coherence in coupling case -!! Modifications 16/03/95 (Stein) remove R from the historical variables -!! Modifications 01/03/95 (Hereil) add the budget namelists -!! Modifications 16/06/95 (Stein) coherence control for the -!! microphysical scheme + remove the wrong messge for RESTA conf -!! Modifications 30/06/95 (Stein) conditionnal reading of the fields -!! used by the moist turbulence scheme -!! Modifications 12/09/95 (Pinty) add the radiation scheme -!! Modification 06/02/96 (J.Vila) implement scalar advection schemes -!! Modifications 24/02/96 (Stein) change the default value for CCPLFILE -!! Modifications 02/05/96 (Stein Jabouille) change the Z0SEA activation -!! Modifications 24/05/96 (Stein) change the SRC SIGS control -!! Modifications 08/09/96 (Masson) the coupling file names are reset to -!! default value " " before reading in EXSEG1.nam -!! to avoid extra non-existant coupling files -!! -!! Modifications 25/04/95 (K.Suhre)add namelist NAM_BLANK -!! add read for LFORCING -!! 25/04/95 (K.Suhre)add namelist NAM_FRC -!! and switch checking -!! 06/08/96 (K.Suhre)add namelist NAM_CH_MNHCn -!! and NAM_CH_SOLVER -!! Modifications 10/10/96 (Stein) change SRC into SRCM and SRCT -!! Modifications 11/04/96 (Pinty) add the rain-ice microphysical scheme -!! Modifications 11/01/97 (Pinty) add the deep convection scheme -!! Modifications 22/05/97 (Lafore) gridnesting implementation -!! Modifications 22/06/97 (Stein) add the absolute pressure + cleaning -!! Modifications 25/08/97 (Masson) add tests on surface schemes -!! 22/10/97 (Stein) remove the RIMX /= 0 control -!! + new namelist + cleaning -!! Modifications 17/04/98 (Masson) add tests on character variables -!! Modification 15/03/99 (Masson) add tests on PROGRAM -!! Modification 04/01/00 (Masson) removes TSZ0 case -!! Modification 04/06/00 (Pinty) add C2R2 scheme -!! 11/12/00 (Tomasini) add CSEA_FLUX to MODD_PARAMn -!! delete the test on SST_FRC only in 1D -!! Modification 22/01/01 (Gazen) change NSV,KSV to NSV_USER,KSV_USER and add -!! NSV_* variables initialization -!! Modification 15/10/01 (Mallet) allow namelists in different orders -!! Modification 18/03/02 (Solmon) new radiation scheme test -!! Modification 29/11/02 (JP Pinty) add C3R5, ICE2, ICE4, ELEC -!! Modification 06/11/02 (Masson) new LES BL height diagnostic -!! Modification 06/11/02 (Jabouille) remove LTHINSHELL LFORCING test -!! Modification 01/12/03 (Gazen) change Chemical scheme interface -!! Modification 01/2004 (Masson) removes surface (externalization) -!! Modification 01/2005 (Masson) removes 1D and 2D switches -!! Modification 04/2005 (Tulet) add dust, orilam -!! Modification 03/2006 (O.Geoffroy) Add KHKO scheme -!! Modification 04/2006 (Maric) include 4th order advection scheme -!! Modification 05/2006 (Masson) add nudging -!! Modification 05/2006 Remove KEPS -!! Modification 04/2006 (Maric) include PPM advection scheme -!! Modification 04/2006 (J.Escobar) Bug dollarn add CALL UPDATE_NAM_CONFN -!! Modifications 01/2007 (Malardel,Pergaud) add the MF shallow -!! convection scheme MODN_PARAM_MFSHALL_n -!! Modification 09/2009 (J.Escobar) add more info on relaxation problems -!! Modification 09/2011 (J.Escobar) re-add 'ZRESI' choose -!! Modification 12/2011 (C.Lac) Adaptation to FIT temporal scheme -!! Modification 12/2012 (S.Bielli) add NAM_NCOUT for netcdf output (removed 08/07/2016) -!! Modification 02/2012 (Pialat/Tulet) add ForeFire -!! Modification 02/2012 (T.Lunet) add of new Runge-Kutta methods -!! Modification 01/2015 (C. Barthe) add explicit LNOx -!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1 -!! M.Leriche 18/12/2015 : bug chimie glace dans prep_real_case -!! Modification 01/2016 (JP Pinty) Add LIMA -!! Modification 02/2016 (M.Leriche) treat gas and aq. chemicals separately -!! P.Wautelet 08/07/2016 : removed MNH_NCWRIT define -!! Modification 10/2016 (C.LAC) Add OSPLIT_WENO + Add droplet -!! deposition + Add max values -!! Modification 11/2016 (Ph. Wautelet) Allocate/initialise some output/backup structures -!! Modification 03/2017 (JP Chaboureau) Fix the initialization of -!! LUSERx-type variables for LIMA -!! M.Leriche 06/2017 for spawn and prep_real avoid abort if wet dep for -!! aerosol and no cloud scheme defined -!! Q.Libois 02/2018 ECRAD -!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O -!! Modification 07/2017 (V. Vionnet) add blowing snow scheme -!! Modification 01/2019 (Q. Rodier) define XCEDIS depending on BL89 or RM17 mixing length -!! Modification 01/2019 (P. Wautelet) bugs correction: incorrect writes -!! Modification 01/2019 (R. Honnert) remove SURF in CMF_UPDRAFT -!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes -! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg -! C. Lac 11/2019: correction in the drag formula and application to building in addition to tree -! Q. Rodier 03/2020: add abort if use of any LHORELAX and cyclic conditions -! F.Auguste 02/2021: add IBM -! T.Nagel 02/2021: add turbulence recycling -! E.Jezequel 02/2021: add stations read from CSV file -! P. Wautelet 09/03/2021: simplify allocation of scalar variable names -! P. Wautelet 09/03/2021: move some chemistry initializations to ini_nsv -! P. Wautelet 10/03/2021: move scalar variable name initializations to ini_nsv -! R. Honnert 23/04/2021: add ADAP mixing length and delete HRIO and BOUT from CMF_UPDRAFT -! S. Riette 11/05/2021 HighLow cloud -!------------------------------------------------------------------------------ -! -!* 0. DECLARATIONS -! ------------ -USE MODD_BLOWSNOW -USE MODD_BUDGET -USE MODD_CH_AEROSOL -USE MODD_CH_M9_n, ONLY : NEQ -USE MODD_CONDSAMP -USE MODD_CONF -USE MODD_CONF_n, ONLY: CSTORAGE_TYPE -USE MODD_CONFZ -! USE MODD_DRAG_n -USE MODD_DUST -USE MODD_DYN -USE MODD_DYN_n, ONLY : LHORELAX_SVLIMA -#ifdef MNH_FOREFIRE -USE MODD_FOREFIRE -#endif -USE MODD_GET_n -USE MODD_GR_FIELD_n -USE MODD_IO, ONLY: TFILEDATA -USE MODD_LUNIT_n, ONLY: TLUOUT -USE MODD_NSV,NSV_USER_n=>NSV_USER -USE MODD_PARAMETERS -USE MODD_PASPOL -USE MODD_SALT -USE MODD_VAR_ll, ONLY: NPROC -USE MODD_VISCOSITY - -USE MODE_MSG -USE MODE_POS - -USE MODI_INI_NSV -USE MODI_TEST_NAM_VAR - -USE MODN_2D_FRC -USE MODN_ADV_n ! The final filling of these modules for the model n is -USE MODN_BACKUP -USE MODN_BLANK_n -USE MODN_BLOWSNOW -USE MODN_BLOWSNOW_n -USE MODN_BUDGET -USE MODN_CH_MNHC_n -USE MODN_CH_ORILAM -USE MODN_CH_SOLVER_n -USE MODN_CONDSAMP -USE MODN_CONF -USE MODN_CONF_n -USE MODN_CONFZ -USE MODN_DRAGBLDG_n -USE MODN_DRAG_n -USE MODN_DRAGTREE_n -USE MODN_DUST -USE MODN_DYN -USE MODN_DYN_n ! to avoid the duplication of this routine for each model. -USE MODN_ELEC -USE MODN_EOL -USE MODN_EOL_ADNR -USE MODN_EOL_ALM -#ifdef MNH_FOREFIRE -USE MODN_FOREFIRE -#endif -USE MODN_FRC -USE MODN_IBM_PARAM_n -USE MODN_LATZ_EDFLX -USE MODN_LBC_n ! routine is used for each nested model. This has been done -USE MODN_LES -USE MODN_LUNIT_n -USE MODN_MEAN -USE MODN_NESTING -USE MODN_NUDGING_n -USE MODN_OUTPUT -USE MODN_PARAM_C1R3, ONLY : NAM_PARAM_C1R3, CPRISTINE_ICE_C1R3, & - CHEVRIMED_ICE_C1R3 -USE MODN_PARAM_C2R2, ONLY : EPARAM_CCN=>HPARAM_CCN, EINI_CCN=>HINI_CCN, & - WNUC=>XNUC, WALPHAC=>XALPHAC, NAM_PARAM_C2R2 -USE MODN_PARAM_ECRAD_n -USE MODN_PARAM_ICE -USE MODN_PARAM_KAFR_n -USE MODN_PARAM_LIMA, ONLY : FINI_CCN=>HINI_CCN,NAM_PARAM_LIMA,NMOD_CCN,LSCAV, & - CPRISTINE_ICE_LIMA, CHEVRIMED_ICE_LIMA, NMOD_IFN, & - LCOLD, LACTI, LNUCL, XALPHAC, XNUC, LMEYERS, LHAIL,& - LPTSPLIT -USE MODN_PARAM_MFSHALL_n -USE MODN_PARAM_n ! realized in subroutine ini_model n -USE MODN_PARAM_RAD_n -USE MODN_PASPOL -USE MODN_RECYCL_PARAM_n -USE MODN_SALT -USE MODN_SERIES -USE MODN_SERIES_n -USE MODN_STATION_n -USE MODN_TURB -USE MODN_TURB_CLOUD -USE MODN_TURB_n -USE MODN_VISCOSITY - -IMPLICIT NONE -! -!* 0.1 declarations of arguments -! -! -! -INTEGER, INTENT(IN) :: KMI ! Model index -TYPE(TFILEDATA), INTENT(IN) :: TPEXSEGFILE ! EXSEG file -! The following variables are read by READ_DESFM in DESFM descriptor : -CHARACTER (LEN=*), INTENT(IN) :: HCONF ! configuration var. linked to FMfile -LOGICAL, INTENT(IN) :: OFLAT ! Logical for zero orography -LOGICAL, INTENT(IN) :: OUSERV,OUSERC,OUSERR,OUSERI,OUSERS, & - OUSERG,OUSERH ! kind of moist variables in - ! FMfile -LOGICAL, INTENT(IN) :: OUSECI ! ice concentration in - ! FMfile -LOGICAL, INTENT(IN) :: OUSECHEM ! Chemical FLAG in FMFILE -LOGICAL, INTENT(IN) :: OUSECHAQ ! Aqueous chemical FLAG in FMFILE -LOGICAL, INTENT(IN) :: OUSECHIC ! Ice chemical FLAG in FMFILE -LOGICAL, INTENT(IN) :: OCH_PH ! pH FLAG in FMFILE -LOGICAL, INTENT(IN) :: OCH_CONV_LINOX ! LiNOx FLAG in FMFILE -LOGICAL, INTENT(IN) :: ODUST ! Dust FLAG in FMFILE -LOGICAL,DIMENSION(:), INTENT(IN) :: ODEPOS_DST ! Dust Deposition FLAG in FMFILE -LOGICAL,DIMENSION(:), INTENT(IN) :: ODEPOS_SLT ! Sea Salt wet deposition FLAG in FMFILE -LOGICAL,DIMENSION(:), INTENT(IN) :: ODEPOS_AER ! Orilam wet deposition FLAG in FMFILE -LOGICAL, INTENT(IN) :: OSALT ! Sea Salt FLAG in FMFILE -LOGICAL, INTENT(IN) :: OORILAM ! Orilam FLAG in FMFILE -LOGICAL, INTENT(IN) :: OPASPOL ! Passive pollutant FLAG in FMFILE -#ifdef MNH_FOREFIRE -LOGICAL, INTENT(IN) :: OFOREFIRE ! ForeFire FLAG in FMFILE -#endif -LOGICAL, INTENT(IN) :: OLNOX_EXPLICIT ! explicit LNOx FLAG in FMFILE -LOGICAL, INTENT(IN) :: OCONDSAMP ! Conditional sampling FLAG in FMFILE -LOGICAL, INTENT(IN) :: OCHTRANS ! LCHTRANS FLAG in FMFILE -LOGICAL, INTENT(IN) :: OBLOWSNOW ! Blowing snow FLAG in FMFILE - -LOGICAL, INTENT(IN) :: OLG ! lagrangian FLAG in FMFILE -INTEGER, INTENT(IN) :: KRIMX, KRIMY ! number of points for the - ! horizontal relaxation for the outermost verticals -INTEGER, INTENT(IN) :: KSV_USER ! number of additional scalar - ! variables in FMfile -CHARACTER (LEN=*), INTENT(IN) :: HTURB ! Kind of turbulence parameterization - ! used to produce FMFILE -CHARACTER (LEN=*), INTENT(IN) :: HTOM ! Kind of third order moment -LOGICAL, INTENT(IN) :: ORMC01 ! flag for RMC01 SBL computations -CHARACTER (LEN=*), INTENT(IN) :: HRAD ! Kind of radiation scheme -CHARACTER (LEN=4), INTENT(IN) :: HDCONV ! Kind of deep convection scheme -CHARACTER (LEN=4), INTENT(IN) :: HSCONV ! Kind of shallow convection scheme -CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Kind of microphysical scheme -CHARACTER (LEN=4), INTENT(IN) :: HELEC ! Kind of electrical scheme -CHARACTER (LEN=*), INTENT(IN) :: HEQNSYS! type of equations' system -REAL,DIMENSION(:), INTENT(INOUT):: PTSTEP_ALL ! Time STEP of ALL models -CHARACTER (LEN=*), INTENT(IN) :: HSTORAGE_TYPE ! type of initial file -CHARACTER (LEN=*), INTENT(IN) :: HINIFILEPGD ! name of PGD file -! -!* 0.2 declarations of local variables -! -INTEGER :: ILUSEG,ILUOUT ! logical unit numbers of EXSEG file and outputlisting -INTEGER :: JS,JCI,JI,JSV ! Loop indexes -LOGICAL :: GRELAX -LOGICAL :: GFOUND ! Return code when searching namelist -! -!------------------------------------------------------------------------------- -! -!* 1. READ EXSEG FILE -! --------------- -! -CALL PRINT_MSG(NVERB_DEBUG,'IO','READ_EXSEG_n','called for '//TRIM(TPEXSEGFILE%CNAME)) -! -ILUSEG = TPEXSEGFILE%NLU -ILUOUT = TLUOUT%NLU -! -CALL INIT_NAM_LUNITN -CCPLFILE(:)=" " -CALL INIT_NAM_CONFN -CALL INIT_NAM_DYNN -CALL INIT_NAM_ADVN -CALL INIT_NAM_DRAGTREEN -CALL INIT_NAM_DRAGBLDGN -CALL INIT_NAM_PARAMN -CALL INIT_NAM_PARAM_RADN -#ifdef MNH_ECRAD -CALL INIT_NAM_PARAM_ECRADN -#endif -CALL INIT_NAM_PARAM_KAFRN -CALL INIT_NAM_PARAM_MFSHALLN -CALL INIT_NAM_LBCN -CALL INIT_NAM_NUDGINGN -CALL INIT_NAM_TURBN -CALL INIT_NAM_BLANKN -CALL INIT_NAM_DRAGN -CALL INIT_NAM_IBM_PARAMN -CALL INIT_NAM_RECYCL_PARAMN -CALL INIT_NAM_CH_MNHCN -CALL INIT_NAM_CH_SOLVERN -CALL INIT_NAM_SERIESN -CALL INIT_NAM_BLOWSNOWN -CALL INIT_NAM_STATIONn -! -WRITE(UNIT=ILUOUT,FMT="(/,'READING THE EXSEG.NAM FILE')") -CALL POSNAM(ILUSEG,'NAM_LUNITN',GFOUND,ILUOUT) -IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_LUNITn) -CALL POSNAM(ILUSEG,'NAM_CONFN',GFOUND,ILUOUT) -IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONFn) -CALL POSNAM(ILUSEG,'NAM_DYNN',GFOUND,ILUOUT) -IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DYNn) -CALL POSNAM(ILUSEG,'NAM_ADVN',GFOUND,ILUOUT) -IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_ADVn) -CALL POSNAM(ILUSEG,'NAM_PARAMN',GFOUND,ILUOUT) -IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAMn) -CALL POSNAM(ILUSEG,'NAM_PARAM_RADN',GFOUND,ILUOUT) -IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_RADn) -#ifdef MNH_ECRAD -CALL POSNAM(ILUSEG,'NAM_PARAM_ECRADN',GFOUND,ILUOUT) -IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_ECRADn) -#endif -CALL POSNAM(ILUSEG,'NAM_PARAM_KAFRN',GFOUND,ILUOUT) -IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_KAFRn) -CALL POSNAM(ILUSEG,'NAM_PARAM_MFSHALLN',GFOUND,ILUOUT) -IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_MFSHALLn) -CALL POSNAM(ILUSEG,'NAM_LBCN',GFOUND,ILUOUT) -IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_LBCn) -CALL POSNAM(ILUSEG,'NAM_NUDGINGN',GFOUND,ILUOUT) -IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_NUDGINGn) -CALL POSNAM(ILUSEG,'NAM_TURBN',GFOUND,ILUOUT) -IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_TURBn) -CALL POSNAM(ILUSEG,'NAM_DRAGN',GFOUND,ILUOUT) -IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DRAGn) -CALL POSNAM(ILUSEG,'NAM_IBM_PARAMN',GFOUND,ILUOUT) -IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_IBM_PARAMn) -CALL POSNAM(ILUSEG,'NAM_RECYCL_PARAMN',GFOUND,ILUOUT) -IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_RECYCL_PARAMn) -CALL POSNAM(ILUSEG,'NAM_CH_MNHCN',GFOUND,ILUOUT) -IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CH_MNHCn) -CALL POSNAM(ILUSEG,'NAM_CH_SOLVERN',GFOUND,ILUOUT) -IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CH_SOLVERn) -CALL POSNAM(ILUSEG,'NAM_SERIESN',GFOUND,ILUOUT) -IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_SERIESn) -CALL POSNAM(ILUSEG,'NAM_BLANKN',GFOUND,ILUOUT) -IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BLANKn) -CALL POSNAM(ILUSEG,'NAM_BLOWSNOWN',GFOUND,ILUOUT) -IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BLOWSNOWn) -CALL POSNAM(ILUSEG,'NAM_DRAGTREEN',GFOUND,ILUOUT) -IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DRAGTREEn) -CALL POSNAM(ILUSEG,'NAM_DRAGBLDGN',GFOUND,ILUOUT) -IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DRAGBLDGn) -CALL POSNAM(ILUSEG,'NAM_EOL',GFOUND,ILUOUT) -IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_EOL) -CALL POSNAM(ILUSEG,'NAM_EOL_ADNR',GFOUND,ILUOUT) -IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_EOL_ADNR) -CALL POSNAM(ILUSEG,'NAM_EOL_ALM',GFOUND,ILUOUT) -IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_EOL_ALM) -CALL POSNAM(ILUSEG,'NAM_STATIONN',GFOUND,ILUOUT) -IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_STATIONn) -! -IF (KMI == 1) THEN - WRITE(UNIT=ILUOUT,FMT="(' namelists common to all the models ')") - CALL POSNAM(ILUSEG,'NAM_CONF',GFOUND,ILUOUT) - IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONF) - CALL POSNAM(ILUSEG,'NAM_CONFZ',GFOUND,ILUOUT) - IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONFZ) - CALL POSNAM(ILUSEG,'NAM_DYN',GFOUND,ILUOUT) - IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DYN) - CALL POSNAM(ILUSEG,'NAM_NESTING',GFOUND,ILUOUT) - IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_NESTING) - CALL POSNAM(ILUSEG,'NAM_BACKUP',GFOUND,ILUOUT) - IF (GFOUND) THEN - !Should have been allocated before in READ_DESFM_n - IF (.NOT.ALLOCATED(XBAK_TIME)) THEN - ALLOCATE(XBAK_TIME(NMODEL,JPOUTMAX)) - XBAK_TIME(:,:) = XNEGUNDEF - END IF - IF (.NOT.ALLOCATED(XOUT_TIME)) THEN - ALLOCATE(XOUT_TIME(NMODEL,JPOUTMAX)) !Allocate *OUT* variables to prevent - XOUT_TIME(:,:) = XNEGUNDEF - END IF - IF (.NOT.ALLOCATED(NBAK_STEP)) THEN - ALLOCATE(NBAK_STEP(NMODEL,JPOUTMAX)) - NBAK_STEP(:,:) = NNEGUNDEF - END IF - IF (.NOT.ALLOCATED(NOUT_STEP)) THEN - ALLOCATE(NOUT_STEP(NMODEL,JPOUTMAX)) !problems if NAM_OUTPUT does not exist - NOUT_STEP(:,:) = NNEGUNDEF - END IF - IF (.NOT.ALLOCATED(COUT_VAR)) THEN - ALLOCATE(COUT_VAR (NMODEL,JPOUTVARMAX)) - COUT_VAR(:,:) = '' - END IF - READ(UNIT=ILUSEG,NML=NAM_BACKUP) - ELSE - CALL POSNAM(ILUSEG,'NAM_FMOUT',GFOUND) - IF (GFOUND) THEN - CALL PRINT_MSG(NVERB_FATAL,'IO','READ_EXSEG_n','use namelist NAM_BACKUP instead of namelist NAM_FMOUT') - ELSE - IF (CPROGRAM=='MESONH') CALL PRINT_MSG(NVERB_ERROR,'IO','READ_EXSEG_n','namelist NAM_BACKUP not found') - END IF - END IF - CALL POSNAM(ILUSEG,'NAM_OUTPUT',GFOUND,ILUOUT) - IF (GFOUND) THEN - !Should have been allocated before in READ_DESFM_n - IF (.NOT.ALLOCATED(XBAK_TIME)) THEN - ALLOCATE(XBAK_TIME(NMODEL,JPOUTMAX)) !Allocate *BAK* variables to prevent - XBAK_TIME(:,:) = XNEGUNDEF - END IF - IF (.NOT.ALLOCATED(XOUT_TIME)) THEN - ALLOCATE(XOUT_TIME(NMODEL,JPOUTMAX)) - XOUT_TIME(:,:) = XNEGUNDEF - END IF - IF (.NOT.ALLOCATED(NBAK_STEP)) THEN - ALLOCATE(NBAK_STEP(NMODEL,JPOUTMAX)) !problems if NAM_BACKUP does not exist - NBAK_STEP(:,:) = NNEGUNDEF - END IF - IF (.NOT.ALLOCATED(NOUT_STEP)) THEN - ALLOCATE(NOUT_STEP(NMODEL,JPOUTMAX)) - NOUT_STEP(:,:) = NNEGUNDEF - END IF - IF (.NOT.ALLOCATED(COUT_VAR)) THEN - ALLOCATE(COUT_VAR (NMODEL,JPOUTVARMAX)) - COUT_VAR(:,:) = '' - END IF - READ(UNIT=ILUSEG,NML=NAM_OUTPUT) - END IF - CALL POSNAM(ILUSEG,'NAM_BUDGET',GFOUND,ILUOUT) - IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BUDGET) - - CALL POSNAM(ILUSEG,'NAM_BU_RU',GFOUND,ILUOUT) - IF (GFOUND) THEN - IF ( ALLOCATED( CBULIST_RU ) ) THEN - CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RU was already allocated' ) - DEALLOCATE( CBULIST_RU ) - END IF - ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RU(NBULISTMAXLINES) ) - CBULIST_RU(:) = '' - READ(UNIT=ILUSEG,NML=NAM_BU_RU) - ELSE - ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RU(0) ) - END IF - - CALL POSNAM(ILUSEG,'NAM_BU_RV',GFOUND,ILUOUT) - IF (GFOUND) THEN - IF ( ALLOCATED( CBULIST_RV ) ) THEN - CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RV was already allocated' ) - DEALLOCATE( CBULIST_RV ) - END IF - ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RV(NBULISTMAXLINES) ) - CBULIST_RV(:) = '' - READ(UNIT=ILUSEG,NML=NAM_BU_RV) - ELSE - ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RV(0) ) - END IF - - CALL POSNAM(ILUSEG,'NAM_BU_RW',GFOUND,ILUOUT) - IF (GFOUND) THEN - IF ( ALLOCATED( CBULIST_RW ) ) THEN - CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RW was already allocated' ) - DEALLOCATE( CBULIST_RW ) - END IF - ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RW(NBULISTMAXLINES) ) - CBULIST_RW(:) = '' - READ(UNIT=ILUSEG,NML=NAM_BU_RW) - ELSE - ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RW(0) ) - END IF - - CALL POSNAM(ILUSEG,'NAM_BU_RTH',GFOUND,ILUOUT) - IF (GFOUND) THEN - IF ( ALLOCATED( CBULIST_RTH ) ) THEN - CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RTH was already allocated' ) - DEALLOCATE( CBULIST_RTH ) - END IF - ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTH(NBULISTMAXLINES) ) - CBULIST_RTH(:) = '' - READ(UNIT=ILUSEG,NML=NAM_BU_RTH) - ELSE - ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTH(0) ) - END IF - - CALL POSNAM(ILUSEG,'NAM_BU_RTKE',GFOUND,ILUOUT) - IF (GFOUND) THEN - IF ( ALLOCATED( CBULIST_RTKE ) ) THEN - CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RTKE was already allocated' ) - DEALLOCATE( CBULIST_RTKE ) - END IF - ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTKE(NBULISTMAXLINES) ) - CBULIST_RTKE(:) = '' - READ(UNIT=ILUSEG,NML=NAM_BU_RTKE) - ELSE - ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTKE(0) ) - END IF - - CALL POSNAM(ILUSEG,'NAM_BU_RRV',GFOUND,ILUOUT) - IF (GFOUND) THEN - IF ( ALLOCATED( CBULIST_RRV ) ) THEN - CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRV was already allocated' ) - DEALLOCATE( CBULIST_RRV ) - END IF - ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRV(NBULISTMAXLINES) ) - CBULIST_RRV(:) = '' - READ(UNIT=ILUSEG,NML=NAM_BU_RRV) - ELSE - ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRV(0) ) - END IF - - CALL POSNAM(ILUSEG,'NAM_BU_RRC',GFOUND,ILUOUT) - IF (GFOUND) THEN - IF ( ALLOCATED( CBULIST_RRC ) ) THEN - CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRC was already allocated' ) - DEALLOCATE( CBULIST_RRC ) - END IF - ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRC(NBULISTMAXLINES) ) - CBULIST_RRC(:) = '' - READ(UNIT=ILUSEG,NML=NAM_BU_RRC) - ELSE - ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRC(0) ) - END IF - - CALL POSNAM(ILUSEG,'NAM_BU_RRR',GFOUND,ILUOUT) - IF (GFOUND) THEN - IF ( ALLOCATED( CBULIST_RRR ) ) THEN - CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRR was already allocated' ) - DEALLOCATE( CBULIST_RRR ) - END IF - ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRR(NBULISTMAXLINES) ) - CBULIST_RRR(:) = '' - READ(UNIT=ILUSEG,NML=NAM_BU_RRR) - ELSE - ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRR(0) ) - END IF - - CALL POSNAM(ILUSEG,'NAM_BU_RRI',GFOUND,ILUOUT) - IF (GFOUND) THEN - IF ( ALLOCATED( CBULIST_RRI ) ) THEN - CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRI was already allocated' ) - DEALLOCATE( CBULIST_RRI ) - END IF - ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRI(NBULISTMAXLINES) ) - CBULIST_RRI(:) = '' - READ(UNIT=ILUSEG,NML=NAM_BU_RRI) - ELSE - ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRI(0) ) - END IF - - CALL POSNAM(ILUSEG,'NAM_BU_RRS',GFOUND,ILUOUT) - IF (GFOUND) THEN - IF ( ALLOCATED( CBULIST_RRS ) ) THEN - CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRS was already allocated' ) - DEALLOCATE( CBULIST_RRS ) - END IF - ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRS(NBULISTMAXLINES) ) - CBULIST_RRS(:) = '' - READ(UNIT=ILUSEG,NML=NAM_BU_RRS) - ELSE - ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRS(0) ) - END IF - - CALL POSNAM(ILUSEG,'NAM_BU_RRG',GFOUND,ILUOUT) - IF (GFOUND) THEN - IF ( ALLOCATED( CBULIST_RRG ) ) THEN - CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRG was already allocated' ) - DEALLOCATE( CBULIST_RRG ) - END IF - ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRG(NBULISTMAXLINES) ) - CBULIST_RRG(:) = '' - READ(UNIT=ILUSEG,NML=NAM_BU_RRG) - ELSE - ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRG(0) ) - END IF - - CALL POSNAM(ILUSEG,'NAM_BU_RRH',GFOUND,ILUOUT) - IF (GFOUND) THEN - IF ( ALLOCATED( CBULIST_RRH ) ) THEN - CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRH was already allocated' ) - DEALLOCATE( CBULIST_RRH ) - END IF - ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRH(NBULISTMAXLINES) ) - CBULIST_RRH(:) = '' - READ(UNIT=ILUSEG,NML=NAM_BU_RRH) - ELSE - ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRH(0) ) - END IF - - CALL POSNAM(ILUSEG,'NAM_BU_RSV',GFOUND,ILUOUT) - IF (GFOUND) THEN - IF ( ALLOCATED( CBULIST_RSV ) ) THEN - CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RSV was already allocated' ) - DEALLOCATE( CBULIST_RSV ) - END IF - ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RSV(NBULISTMAXLINES) ) - CBULIST_RSV(:) = '' - READ(UNIT=ILUSEG,NML=NAM_BU_RSV) - ELSE - ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RSV(0) ) - END IF - - CALL POSNAM(ILUSEG,'NAM_LES',GFOUND,ILUOUT) - IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_LES) - CALL POSNAM(ILUSEG,'NAM_MEAN',GFOUND,ILUOUT) - IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_MEAN) - CALL POSNAM(ILUSEG,'NAM_PDF',GFOUND,ILUOUT) - IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PDF) - CALL POSNAM(ILUSEG,'NAM_FRC',GFOUND,ILUOUT) - IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_FRC) - CALL POSNAM(ILUSEG,'NAM_PARAM_ICE',GFOUND,ILUOUT) - IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_ICE) - CALL POSNAM(ILUSEG,'NAM_PARAM_C2R2',GFOUND,ILUOUT) - IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_C2R2) - CALL POSNAM(ILUSEG,'NAM_PARAM_C1R3',GFOUND,ILUOUT) - IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_C1R3) - CALL POSNAM(ILUSEG,'NAM_PARAM_LIMA',GFOUND,ILUOUT) - IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PARAM_LIMA) - CALL POSNAM(ILUSEG,'NAM_ELEC',GFOUND,ILUOUT) - IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_ELEC) - CALL POSNAM(ILUSEG,'NAM_SERIES',GFOUND,ILUOUT) - IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_SERIES) - CALL POSNAM(ILUSEG,'NAM_TURB_CLOUD',GFOUND,ILUOUT) - IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_TURB_CLOUD) - CALL POSNAM(ILUSEG,'NAM_TURB',GFOUND,ILUOUT) - IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_TURB) - CALL POSNAM(ILUSEG,'NAM_CH_ORILAM',GFOUND,ILUOUT) - IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CH_ORILAM) - CALL POSNAM(ILUSEG,'NAM_DUST',GFOUND,ILUOUT) - IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DUST) - CALL POSNAM(ILUSEG,'NAM_SALT',GFOUND,ILUOUT) - IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_SALT) - CALL POSNAM(ILUSEG,'NAM_PASPOL',GFOUND,ILUOUT) - IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PASPOL) -#ifdef MNH_FOREFIRE - CALL POSNAM(ILUSEG,'NAM_FOREFIRE',GFOUND,ILUOUT) - IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_FOREFIRE) -#endif - CALL POSNAM(ILUSEG,'NAM_CONDSAMP',GFOUND,ILUOUT) - IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONDSAMP) - CALL POSNAM(ILUSEG,'NAM_2D_FRC',GFOUND,ILUOUT) - IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_2D_FRC) - CALL POSNAM(ILUSEG,'NAM_LATZ_EDFLX',GFOUND) - IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_LATZ_EDFLX) - CALL POSNAM(ILUSEG,'NAM_BLOWSNOW',GFOUND,ILUOUT) - IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BLOWSNOW) - CALL POSNAM(ILUSEG,'NAM_VISC',GFOUND,ILUOUT) - IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_VISC) -END IF -! -!------------------------------------------------------------------------------- -! -CALL TEST_NAM_VAR(ILUOUT,'CPRESOPT',CPRESOPT,'RICHA','CGRAD','CRESI','ZRESI') -! -CALL TEST_NAM_VAR(ILUOUT,'CUVW_ADV_SCHEME',CUVW_ADV_SCHEME, & - 'CEN4TH','CEN2ND','WENO_K' ) -CALL TEST_NAM_VAR(ILUOUT,'CMET_ADV_SCHEME',CMET_ADV_SCHEME, & - &'PPM_00','PPM_01','PPM_02') -CALL TEST_NAM_VAR(ILUOUT,'CSV_ADV_SCHEME',CSV_ADV_SCHEME, & - &'PPM_00','PPM_01','PPM_02') -CALL TEST_NAM_VAR(ILUOUT,'CTEMP_SCHEME',CTEMP_SCHEME, & - &'RK11','RK21','RK33','RKC4','RK53','RK4B','RK62','RK65','NP32','SP32','LEFR') -! -CALL TEST_NAM_VAR(ILUOUT,'CTURB',CTURB,'NONE','TKEL') -CALL TEST_NAM_VAR(ILUOUT,'CRAD',CRAD,'NONE','FIXE','ECMW',& -#ifdef MNH_ECRAD - 'ECRA',& -#endif - 'TOPA') -CALL TEST_NAM_VAR(ILUOUT,'CCLOUD',CCLOUD,'NONE','REVE','KESS', & - & 'ICE3','ICE4','C2R2','C3R5','KHKO','LIMA') -CALL TEST_NAM_VAR(ILUOUT,'CDCONV',CDCONV,'NONE','KAFR') -CALL TEST_NAM_VAR(ILUOUT,'CSCONV',CSCONV,'NONE','KAFR','EDKF') -CALL TEST_NAM_VAR(ILUOUT,'CELEC',CELEC,'NONE','ELE3','ELE4') -! -CALL TEST_NAM_VAR(ILUOUT,'CAER',CAER,'TANR','TEGE','SURF','NONE') -CALL TEST_NAM_VAR(ILUOUT,'CAOP',CAOP,'CLIM','EXPL') -CALL TEST_NAM_VAR(ILUOUT,'CLW',CLW,'RRTM','MORC') -CALL TEST_NAM_VAR(ILUOUT,'CEFRADL',CEFRADL,'PRES','OCLN','MART','C2R2','LIMA') -CALL TEST_NAM_VAR(ILUOUT,'CEFRADI',CEFRADI,'FX40','LIOU','SURI','C3R5','LIMA') -CALL TEST_NAM_VAR(ILUOUT,'COPWLW',COPWLW,'SAVI','SMSH','LILI','MALA') -CALL TEST_NAM_VAR(ILUOUT,'COPILW',COPILW,'FULI','EBCU','SMSH','FU98') -CALL TEST_NAM_VAR(ILUOUT,'COPWSW',COPWSW,'SLIN','FOUQ','MALA') -CALL TEST_NAM_VAR(ILUOUT,'COPISW',COPISW,'FULI','EBCU','FU96') -! -CALL TEST_NAM_VAR(ILUOUT,'CLBCX(1)',CLBCX(1),'CYCL','WALL','OPEN') -CALL TEST_NAM_VAR(ILUOUT,'CLBCX(2)',CLBCX(2),'CYCL','WALL','OPEN') -CALL TEST_NAM_VAR(ILUOUT,'CLBCY(1)',CLBCY(1),'CYCL','WALL','OPEN') -CALL TEST_NAM_VAR(ILUOUT,'CLBCY(2)',CLBCY(2),'CYCL','WALL','OPEN') -! -CALL TEST_NAM_VAR(ILUOUT,'CTURBDIM',CTURBDIM,'1DIM','3DIM') -CALL TEST_NAM_VAR(ILUOUT,'CTURBLEN',CTURBLEN,'DELT','BL89','RM17','DEAR','BLKR','ADAP') -CALL TEST_NAM_VAR(ILUOUT,'CTOM',CTOM,'NONE','TM06') -CALL TEST_NAM_VAR(ILUOUT,'CSUBG_AUCV',CSUBG_AUCV,'NONE','CLFR','SIGM','PDF','ADJU') -CALL TEST_NAM_VAR(ILUOUT,'CSUBG_AUCV_RI',CSUBG_AUCV_RI,'NONE','CLFR','ADJU') -CALL TEST_NAM_VAR(ILUOUT,'CCONDENS',CCONDENS,'CB02','GAUS') -CALL TEST_NAM_VAR(ILUOUT,'CLAMBDA3',CLAMBDA3,'CB','NONE') -CALL TEST_NAM_VAR(ILUOUT,'CSUBG_MF_PDF',CSUBG_MF_PDF,'NONE','TRIANGLE') -! -CALL TEST_NAM_VAR(ILUOUT,'CCH_TDISCRETIZATION',CCH_TDISCRETIZATION, & - 'SPLIT ','CENTER ','LAGGED ') -! -CALL TEST_NAM_VAR(ILUOUT,'CCONF',CCONF,'START','RESTA') -CALL TEST_NAM_VAR(ILUOUT,'CEQNSYS',CEQNSYS,'LHE','DUR','MAE') -CALL TEST_NAM_VAR(ILUOUT,'CSPLIT',CSPLIT,'BSPLITTING','XSPLITTING','YSPLITTING') -! -CALL TEST_NAM_VAR(ILUOUT,'CBUTYPE',CBUTYPE,'NONE','CART','MASK') -! -CALL TEST_NAM_VAR(ILUOUT,'CRELAX_HEIGHT_TYPE',CRELAX_HEIGHT_TYPE,'FIXE','THGR') -! -CALL TEST_NAM_VAR(ILUOUT,'CLES_NORM_TYPE',CLES_NORM_TYPE,'NONE','CONV','EKMA','MOBU') -CALL TEST_NAM_VAR(ILUOUT,'CBL_HEIGHT_DEF',CBL_HEIGHT_DEF,'TKE','KE','WTV','FRI','DTH') -CALL TEST_NAM_VAR(ILUOUT,'CTURBLEN_CLOUD',CTURBLEN_CLOUD,'NONE','DEAR','DELT','BL89') -! -! The test on the mass flux scheme for shallow convection -! -CALL TEST_NAM_VAR(ILUOUT,'CMF_UPDRAFT',CMF_UPDRAFT,'NONE','EDKF','RHCJ') -CALL TEST_NAM_VAR(ILUOUT,'CMF_CLOUD',CMF_CLOUD,'NONE','STAT','DIRE') -! -! The test on the CSOLVER name is made elsewhere -! -CALL TEST_NAM_VAR(ILUOUT,'CPRISTINE_ICE',CPRISTINE_ICE,'PLAT','COLU','BURO') -CALL TEST_NAM_VAR(ILUOUT,'CSEDIM',CSEDIM,'SPLI','STAT','NONE') -IF( CCLOUD == 'C3R5' ) THEN - CALL TEST_NAM_VAR(ILUOUT,'CPRISTINE_ICE_C1R3',CPRISTINE_ICE_C1R3, & - 'PLAT','COLU','BURO') - CALL TEST_NAM_VAR(ILUOUT,'CHEVRIMED_ICE_C1R3',CHEVRIMED_ICE_C1R3, & - 'GRAU','HAIL') -END IF -! -IF( CCLOUD == 'LIMA' ) THEN - CALL TEST_NAM_VAR(ILUOUT,'CPRISTINE_ICE_LIMA',CPRISTINE_ICE_LIMA, & - 'PLAT','COLU','BURO') - CALL TEST_NAM_VAR(ILUOUT,'CHEVRIMED_ICE_LIMA',CHEVRIMED_ICE_LIMA, & - 'GRAU','HAIL') -END IF -IF(LBLOWSNOW) THEN - CALL TEST_NAM_VAR(ILUOUT,'CSNOWSEDIM',CSNOWSEDIM,'NONE','MITC','CARR','TABC') - IF (XALPHA_SNOW .NE. 3 .AND. CSNOWSEDIM=='TABC') THEN - WRITE(ILUOUT,*) '*****************************************' - WRITE(ILUOUT,*) '* XALPHA_SNW must be set to 3 when ' - WRITE(ILUOUT,*) '* CSNOWSEDIM = TABC ' - WRITE(ILUOUT,*) '* Update the look-up table in BLOWSNOW_SEDIM_LKT1D ' - WRITE(ILUOUT,*) '* to use TABC with a different value of XEMIALPHA_SNW' - WRITE(ILUOUT,*) '*****************************************' - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') - ENDIF -END IF -! -!-------------------------------------------------------------------------------! -!* 2. FIRST INITIALIZATIONS -! --------------------- -! -!* 2.1 Time step in gridnesting case -! -IF (KMI /= 1 .AND. NDAD(KMI) /= KMI) THEN - XTSTEP = PTSTEP_ALL(NDAD(KMI)) / NDTRATIO(KMI) -END IF -PTSTEP_ALL(KMI) = XTSTEP -! -!* 2.2 Fill the global configuration module -! -! Check coherence between the microphysical scheme and water species and -!initialize the logicals LUSERn -! -SELECT CASE ( CCLOUD ) - CASE ( 'NONE' ) - IF (.NOT. ( (.NOT. LUSERC) .AND. (.NOT. LUSERR) .AND. (.NOT. LUSERI) .AND. & - (.NOT. LUSERS) .AND. (.NOT. LUSERG) .AND. (.NOT. LUSERH) & - ) .AND. CPROGRAM=='MESONH' ) THEN -! - LUSERC=.FALSE. - LUSERR=.FALSE.; LUSERI=.FALSE. - LUSERS=.FALSE.; LUSERG=.FALSE. - LUSERH=.FALSE. -! - END IF -! - IF (CSUBG_AUCV == 'SIGM') THEN -! - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE THE SUBGRID AUTOCONVERSION SCHEME ' - WRITE(UNIT=ILUOUT,FMT=*) ' WITHOUT MICROPHYSICS' - WRITE(UNIT=ILUOUT,FMT=*) ' CSUBG_AUCV IS PUT TO "NONE"' -! - CSUBG_AUCV = 'NONE' -! - END IF -! - CASE ( 'REVE' ) - IF (.NOT. ( LUSERV .AND. LUSERC .AND. (.NOT. LUSERR) .AND. (.NOT. LUSERI) & - .AND. (.NOT. LUSERS) .AND. (.NOT. LUSERG) .AND. (.NOT. LUSERH) & - ) ) THEN -! - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE A REVERSIBLE MICROPHYSICAL " ,& - &" SCHEME. YOU WILL ONLY HAVE VAPOR AND CLOUD WATER ",/, & - &" LUSERV AND LUSERC ARE TO TRUE AND THE OTHERS TO FALSE ")') -! - LUSERV=.TRUE. ; LUSERC=.TRUE. - LUSERR=.FALSE.; LUSERI=.FALSE. - LUSERS=.FALSE.; LUSERG=.FALSE. - LUSERH=.FALSE. - END IF -! - IF (CSUBG_AUCV == 'SIGM') THEN -! - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE BOTH A REVERSIBLE MICROPHYSICAL SCHEME ' - WRITE(UNIT=ILUOUT,FMT=*) ' AND THE SUBGRID AUTOCONVERSION SCHEME ' - WRITE(UNIT=ILUOUT,FMT=*) 'BUT YOU DO NOT HAVE RAIN in the "REVE" SCHEME' - WRITE(UNIT=ILUOUT,FMT=*) ' CSUBG_AUCV IS PUT TO "NONE"' -! - CSUBG_AUCV = 'NONE' -! - END IF -! - CASE ( 'KESS' ) - IF (.NOT. ( LUSERV .AND. LUSERC .AND. LUSERR .AND. (.NOT. LUSERI) .AND. & - (.NOT. LUSERS) .AND. (.NOT. LUSERG) .AND. (.NOT. LUSERH) & - ) ) THEN -! - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE A KESSLER MICROPHYSICAL " , & - &" SCHEME. YOU WILL ONLY HAVE VAPOR, CLOUD WATER AND RAIN ",/, & - &" LUSERV, LUSERC AND LUSERR ARE SET TO TRUE AND THE OTHERS TO FALSE ")') -! - LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE. - LUSERI=.FALSE.; LUSERS=.FALSE. - LUSERG=.FALSE.; LUSERH=.FALSE. - END IF -! - IF (CSUBG_AUCV == 'SIGM') THEN -! - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE BOTH A KESSLER MICROPHYSICAL SCHEME ' - WRITE(UNIT=ILUOUT,FMT=*) ' AND THE SUBGRID AUTOCONVERSION SCHEME USING' - WRITE(UNIT=ILUOUT,FMT=*) 'SIGMA_RC.' - WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT YET AVAILABLE.' - WRITE(UNIT=ILUOUT,FMT=*) 'SET CSUBG_AUCV TO "CLFR" or "NONE" OR CCLOUD TO "ICE3"' -! - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') - END IF -! - CASE ( 'ICE3' ) - IF (.NOT. ( LUSERV .AND. LUSERC .AND. LUSERR .AND. LUSERI .AND. LUSECI & - .AND. LUSERS .AND. LUSERG .AND. (.NOT. LUSERH)) & - .AND. CPROGRAM=='MESONH' ) THEN - ! - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE THE ice3 SIMPLE MIXED PHASE' - WRITE(UNIT=ILUOUT,FMT=*) 'MICROPHYSICAL SCHEME. YOU WILL ONLY HAVE VAPOR, CLOUD WATER,' - WRITE(UNIT=ILUOUT,FMT=*) 'RAIN WATER, CLOUD ICE (MIXING RATIO AND CONCENTRATION)' - WRITE(UNIT=ILUOUT,FMT=*) 'SNOW-AGGREGATES AND GRAUPELN.' - WRITE(UNIT=ILUOUT,FMT=*) 'LUSERV,LUSERC,LUSERR,LUSERI,LUSECI,LUSERS,LUSERG ARE SET TO TRUE' - WRITE(UNIT=ILUOUT,FMT=*) 'AND LUSERH TO FALSE' -! - LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE. - LUSERI=.TRUE. ; LUSECI=.TRUE. - LUSERS=.TRUE. ; LUSERG=.TRUE. - LUSERH=.FALSE. - END IF -! - IF (CSUBG_AUCV == 'SIGM' .AND. .NOT. LSUBG_COND) THEN - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE SUBGRID AUTOCONVERSION SCHEME' - WRITE(UNIT=ILUOUT,FMT=*) ' WITHOUT THE SUBGRID CONDENSATION SCHEME.' - WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT ALLOWED: CSUBG_AUCV is SET to NONE' - CSUBG_AUCV='NONE' - END IF -! - IF (CSUBG_AUCV == 'CLFR' .AND. CSCONV /= 'EDKF') THEN - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE SUBGRID AUTOCONVERSION SCHEME' - WRITE(UNIT=ILUOUT,FMT=*) 'WITH THE CONVECTIVE CLOUD FRACTION WITHOUT EDKF' - WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT ALLOWED: CSUBG_AUCV is SET to NONE' - CSUBG_AUCV='NONE' - END IF -! - CASE ( 'ICE4' ) - IF (.NOT. ( LUSERV .AND. LUSERC .AND. LUSERR .AND. LUSERI .AND. LUSECI & - .AND. LUSERS .AND. LUSERG .AND. LUSERH) & - .AND. CPROGRAM=='MESONH' ) THEN - ! - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE THE ice4 SIMPLE MIXED PHASE' - WRITE(UNIT=ILUOUT,FMT=*) 'MICROPHYSICAL SCHEME. YOU WILL ONLY HAVE VAPOR, CLOUD WATER,' - WRITE(UNIT=ILUOUT,FMT=*) 'RAIN WATER, CLOUD ICE (MIXING RATIO AND CONCENTRATION)' - WRITE(UNIT=ILUOUT,FMT=*) 'SNOW-AGGREGATES, GRAUPELN AND HAILSTONES.' - WRITE(UNIT=ILUOUT,FMT=*) 'LUSERV,LUSERC,LUSERR,LUSERI,LUSECI,LUSERS,LUSERG' - WRITE(UNIT=ILUOUT,FMT=*) 'AND LUSERH ARE SET TO TRUE' -! - LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE. - LUSERI=.TRUE. ; LUSECI=.TRUE. - LUSERS=.TRUE. ; LUSERG=.TRUE. ; LUSERH=.TRUE. - END IF -! - IF (CSUBG_AUCV /= 'NONE' .AND. .NOT. LSUBG_COND) THEN - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE SUBGRID AUTOCONVERSION SCHEME' - WRITE(UNIT=ILUOUT,FMT=*) ' WITHOUT THE SUBGRID CONDENSATION SCHEME.' - WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT ALLOWED: CSUBG_AUCV is SET to NONE' - CSUBG_AUCV='NONE' - END IF -! - CASE ( 'C2R2','C3R5', 'KHKO' ) - IF (( EPARAM_CCN == 'XXX') .OR. (EINI_CCN == 'XXX')) THEN - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE A 2-MOMENT MICROPHYSICAL ", & - &" SCHEME BUT YOU DIDNT FILL CORRECTLY NAM_PARAM_C2R2", & - &" YOU HAVE TO FILL HPARAM_CCN and HINI_CCN ")') - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') - END IF - IF (HCLOUD == 'NONE') THEN - CGETCLOUD = 'SKIP' - ELSE IF (HCLOUD == 'REVE' ) THEN - CGETCLOUD = 'INI1' - ELSE IF (HCLOUD == 'KESS' ) THEN - CGETCLOUD = 'INI2' - ELSE IF (HCLOUD == 'ICE3' ) THEN - IF (CCLOUD == 'C3R5') THEN - CGETCLOUD = 'INI2' - ELSE - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE WARM MICROPHYSICAL ", & - &" SCHEME BUT YOU WERE USING THE ICE3 SCHEME PREVIOUSLY.",/, & - &" AS THIS IS A LITTLE BIT STUPID IT IS NOT AUTHORIZED !!!")') - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') - END IF - ELSE - CGETCLOUD = 'READ' ! This is automatically done - END IF -! - IF ((CCLOUD == 'C2R2' ).OR. (CCLOUD == 'KHKO' )) THEN - IF (.NOT. ( LUSERV .AND. LUSERC .AND. LUSERR .AND. (.NOT. LUSERI) .AND. & - (.NOT. LUSERS) .AND. (.NOT. LUSERG) .AND. (.NOT. LUSERH) & - ) ) THEN - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE C2R2 MICROPHYSICAL ", & - &" SCHEME. YOU WILL ONLY HAVE VAPOR, CLOUD WATER AND RAIN ",/, & - &"LUSERV, LUSERC AND LUSERR ARE SET TO TRUE AND THE OTHERS TO FALSE ")') -! - LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE. - LUSERI=.FALSE.; LUSERS=.FALSE. - LUSERG=.FALSE.; LUSERH=.FALSE. - END IF - ELSE IF (CCLOUD == 'C3R5') THEN - IF (.NOT. ( LUSERV .AND. LUSERC .AND. LUSERR .AND. LUSERI .AND. & - LUSERS .AND. LUSERG .AND. (.NOT. LUSERH) & - ) ) THEN - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE C3R5 MICROPHYS. SCHEME.",& - &" YOU WILL HAVE VAPOR, CLOUD WATER/ICE, RAIN, SNOW AND GRAUPEL ",/, & - &"LUSERV, LUSERC, LUSERR, LUSERI, LUSERS, LUSERG ARE SET TO TRUE")' ) -! - LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE. - LUSERI=.TRUE. ; LUSECI=.TRUE. - LUSERS=.TRUE. ; LUSERG=.TRUE. - LUSERH=.FALSE. - END IF - ELSE IF (CCLOUD == 'LIMA') THEN - IF (.NOT. ( LUSERV .AND. LUSERC .AND. LUSERR .AND. LUSERI .AND. & - LUSERS .AND. LUSERG .AND. (.NOT. LUSERH) & - ) ) THEN - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE LIMA MICROPHYS. SCHEME.",& - &" YOU WILL HAVE VAPOR, CLOUD WATER/ICE, RAIN, SNOW AND GRAUPEL ",/, & - &"LUSERV, LUSERC, LUSERR, LUSERI, LUSERS, LUSERG ARE SET TO TRUE")' ) -! - LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE. - LUSERI=.TRUE. ; LUSECI=.TRUE. - LUSERS=.TRUE. ; LUSERG=.TRUE. - LUSERH=.FALSE. - END IF - END IF -! - IF (LSUBG_COND) THEN - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE BOTH THE SIMPLE MIXED PHASE' - WRITE(UNIT=ILUOUT,FMT=*) 'MICROPHYS. SCHEME AND THE SUBGRID COND. SCHEME.' - WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT YET AVAILABLE.' - WRITE(UNIT=ILUOUT,FMT=*) 'SET LSUBG_COND TO FALSE OR CCLOUD TO "REVE", "KESS"' - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') - END IF -! - IF ( CEFRADL /= 'C2R2') THEN - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT=*) ' YOU DID NOT CHOOSE CEFRADL=C2R2 FOR RADIATION' - WRITE(UNIT=ILUOUT,FMT=*) ' IT IS ADVISED TO USE CEFRADL=C2R2 ' - WRITE(UNIT=ILUOUT,FMT=*) ' WITH A 2-MOMENT MICROPHYSICAL SCHEME' - END IF -! - IF ( CCLOUD == 'C3R5' .AND. CEFRADI /= 'C3R5') THEN - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT=*) ' YOU DID NOT CHOOSE CEFRADI=C3R5 FOR RADIATION' - WRITE(UNIT=ILUOUT,FMT=*) ' IT IS ADVISED TO USE CEFRADI=C3R5 ' - WRITE(UNIT=ILUOUT,FMT=*) ' WITH A 2-MOMENT MICROPHYSICAL SCHEME' - END IF -! - IF ( WALPHAC /= 3.0 .OR. WNUC /= 2.0) THEN - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT=*) 'IT IS ADVISED TO USE XALPHAC=3. and XNUC=2.' - WRITE(UNIT=ILUOUT,FMT=*) 'FOR STRATOCUMULUS WITH KHKO SCHEME. ' - END IF -! - IF ( CEFRADL /= 'C2R2') THEN - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT=*) ' YOU DID NOT CHOOSE CEFRADL=C2R2 FOR RADIATION' - WRITE(UNIT=ILUOUT,FMT=*) ' IT IS ADVISED TO USE CEFRADL=C2R2 ' - WRITE(UNIT=ILUOUT,FMT=*) ' WITH A 2-MOMENT MICROPHYSICAL SCHEME' - END IF -! - CASE ( 'LIMA') - IF ((LACTI .AND. FINI_CCN == 'XXX')) THEN - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE A 2-MOMENT MICROPHYSICAL ", & - &" SCHEME BUT YOU DIDNT FILL CORRECTLY NAM_PARAM_LIMA", & - &" YOU HAVE TO FILL FINI_CCN ")') - call Print_msg( NVERB_FATAL, 'GEN', 'READ_EXSEG_n', '' ) - END IF -! - IF(LACTI .AND. NMOD_CCN == 0) THEN - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("ACTIVATION OF AEROSOL PARTICLES IS NOT ", & - &"POSSIBLE IF NMOD_CCN HAS VALUE ZERO. YOU HAVE TO SET AN UPPER ", & - &"VALUE OF NMOD_CCN IN ORDER TO USE LIMA WARM ACTIVATION SCHEME.")') - call Print_msg( NVERB_FATAL, 'GEN', 'READ_EXSEG_n', '' ) - END IF -! - IF(LNUCL .AND. NMOD_IFN == 0 .AND. (.NOT.LMEYERS)) THEN - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("NUCLEATION BY DEPOSITION AND CONTACT IS NOT ", & - &"POSSIBLE IF NMOD_IFN HAS VALUE ZERO. YOU HAVE TO SET AN UPPER", & - &"VALUE OF NMOD_IFN IN ORDER TO USE LIMA COLD NUCLEATION SCHEME.")') - END IF -! - IF (HCLOUD == 'NONE') THEN - CGETCLOUD = 'SKIP' - ELSE IF (HCLOUD == 'REVE' ) THEN - CGETCLOUD = 'INI1' - ELSE IF (HCLOUD == 'KESS' ) THEN - CGETCLOUD = 'INI2' - ELSE IF (HCLOUD == 'ICE3' ) THEN - CGETCLOUD = 'INI2' - ELSE - CGETCLOUD = 'READ' ! This is automatically done - END IF -! - IF (LWARM) THEN - LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE. - LUSERI=.FALSE.; LUSERS=.FALSE. ; LUSERG=.FALSE.; LUSERH=.FALSE. - END IF -! - IF (LCOLD) THEN - LUSERV=.TRUE. ; LUSERC=.TRUE. ; LUSERR=.TRUE. - LUSERI=.TRUE. ; LUSERS=.TRUE. ; LUSERG=.TRUE. - LUSERH=LHAIL - END IF -! -!!$ IF (LSUBG_COND .AND. LCOLD) THEN -!!$ WRITE(UNIT=ILUOUT,FMT=9003) KMI -!!$ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE BOTH THE SIMPLE MIXED PHASE' -!!$ WRITE(UNIT=ILUOUT,FMT=*) 'MICROPHYS. SCHEME AND THE SUBGRID COND. SCHEME.' -!!$ WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT YET AVAILABLE. SET LSUBG_COND ' -!!$ WRITE(UNIT=ILUOUT,FMT=*) 'TO FALSE OR CCLOUD TO "REVE", "KESS" ' -!!$ !callabortstop -!!$ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') -!!$ END IF -! - IF (CCLOUD == 'LIMA' .AND. LSUBG_COND .AND. (.NOT. LPTSPLIT)) THEN - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT=*) 'YOU MUST USE LPTSPLIT=T with CCLOUD=LIMA' - WRITE(UNIT=ILUOUT,FMT=*) 'AND LSUBG_COND ' - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','use LPTSPLIT=T with LIMA and LSUBG_COND=T') - END IF -! - IF ( XALPHAC /= 3.0 .OR. XNUC /= 2.0) THEN - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT=*) 'IT IS ADVISED TO USE XALPHAC=3. and XNUC=2.' - WRITE(UNIT=ILUOUT,FMT=*) 'FOR STRATOCUMULUS. ' - END IF -! - IF ( CEFRADL /= 'LIMA') THEN - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT=*) ' YOU DID NOT CHOOSE CEFRADL=LIMA FOR RADIATION' - WRITE(UNIT=ILUOUT,FMT=*) ' IT IS ADVISED TO USE CEFRADL=LIMA ' - WRITE(UNIT=ILUOUT,FMT=*) ' WITH A 2-MOMENT MICROPHYSICAL SCHEME "LIMA"' - END IF - -!UPG*PT -! IF (LUSECHEM ) THEN -! WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE BOTH LIMA MICROPHYS. SCHEME AND CHEMISTRY' -! WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT YET AVAILABLE. SET LUSECHEM ' -! WRITE(UNIT=ILUOUT,FMT=*) 'TO FALSE OR CCLOUD TO "ICE3" ' -! !callabortstop -! CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') -! END IF -! IF (LDUST ) THEN -! WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE BOTH LIMA MICROPHYS. SCHEME AND DUSTS ' -! WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT YET AVAILABLE. SET LDUST ' -! WRITE(UNIT=ILUOUT,FMT=*) 'TO FALSE OR CCLOUD TO "ICE3" ' -! !callabortstop -! CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') -! END IF -! IF (LSALT ) THEN -! WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE BOTH LIMA MICROPHYS. SCHEME AND SEA SALTS ' -! WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT YET AVAILABLE. SET LSALT ' -! WRITE(UNIT=ILUOUT,FMT=*) 'TO FALSE OR CCLOUD TO "ICE3" ' -! !callabortstop -! CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') -! END IF -! -!UPG*PT -END SELECT -! -LUSERV_G(KMI) = LUSERV -LUSERC_G(KMI) = LUSERC -LUSERR_G(KMI) = LUSERR -LUSERI_G(KMI) = LUSERI -LUSERS_G(KMI) = LUSERS -LUSERG_G(KMI) = LUSERG -LUSERH_G(KMI) = LUSERH -LUSETKE(KMI) = (CTURB /= 'NONE') -! -!------------------------------------------------------------------------------- -! -!* 2.3 Chemical and NSV_* variables initializations -! -CALL UPDATE_NAM_IBM_PARAMN -CALL UPDATE_NAM_RECYCL_PARAMN -CALL UPDATE_NAM_PARAMN -CALL UPDATE_NAM_DYNN -CALL UPDATE_NAM_CONFN -! -IF (LORILAM .AND. .NOT. LUSECHEM) THEN - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(ILUOUT,FMT=*) 'YOU CANNOT USE ORILAM AEROSOL SCHEME WITHOUT ' - WRITE(ILUOUT,FMT=*) 'CHEMICAL GASEOUS CHEMISTRY ' - WRITE(ILUOUT,FMT=*) 'THEREFORE LUSECHEM IS SET TO TRUE ' - LUSECHEM=.TRUE. -END IF -! -IF (LUSECHAQ.AND.(.NOT.LUSECHEM)) THEN - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE AQUEOUS PHASE CHEMISTRY' - WRITE(UNIT=ILUOUT,FMT=*) 'BUT THE CHEMISTRY IS NOT ACTIVATED' - WRITE(UNIT=ILUOUT,FMT=*) 'SET LUSECHEM TO TRUE IF YOU WANT REALLY USE CHEMISTRY' - WRITE(UNIT=ILUOUT,FMT=*) 'OR SET LUSECHAQ TO FALSE IF YOU DO NOT WANT USE IT' - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') -END IF -IF (LUSECHAQ.AND.(.NOT.LUSERC).AND.CPROGRAM=='MESONH') THEN - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE AQUEOUS PHASE CHEMISTRY' - WRITE(UNIT=ILUOUT,FMT=*) 'BUT CLOUD MICROPHYSICS IS NOT ACTIVATED' - WRITE(UNIT=ILUOUT,FMT=*) 'LUSECHAQ IS SET TO FALSE' - LUSECHAQ = .FALSE. -END IF -IF (LUSECHAQ.AND.CCLOUD(1:3) == 'ICE'.AND. .NOT. LUSECHIC) THEN - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE AQUEOUS PHASE CHEMISTRY' - WRITE(UNIT=ILUOUT,FMT=*) 'WITH MIXED PHASE CLOUD MICROPHYSICS' - WRITE(UNIT=ILUOUT,FMT=*) 'SET LUSECHIC TO TRUE IF YOU WANT TO ACTIVATE' - WRITE(UNIT=ILUOUT,FMT=*) 'ICE PHASE CHEMICAL SPECIES' - IF (LCH_RET_ICE) THEN - WRITE(UNIT=ILUOUT,FMT=*) 'LCH_RET_ICE TRUE MEANS ALL SOLUBLE' - WRITE(UNIT=ILUOUT,FMT=*) 'GASES ARE RETAINED IN ICE PHASE' - WRITE(UNIT=ILUOUT,FMT=*) 'WHEN SUPERCOOLED WATER FREEZES' - ELSE - WRITE(UNIT=ILUOUT,FMT=*) 'LCH_RET_ICE FALSE MEANS ALL SOLUBLE' - WRITE(UNIT=ILUOUT,FMT=*) 'GASES GO BACK TO THE GAS PHASE WHEN' - WRITE(UNIT=ILUOUT,FMT=*) 'SUPERCOOLED WATER FREEZES' - ENDIF -ENDIF -IF (LUSECHIC.AND. .NOT. CCLOUD(1:3) == 'ICE'.AND.CPROGRAM=='MESONH') THEN - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE ICE PHASE CHEMISTRY' - WRITE(UNIT=ILUOUT,FMT=*) 'BUT MIXED PHASE CLOUD MICROPHYSICS IS NOT ACTIVATED' - WRITE(UNIT=ILUOUT,FMT=*) 'LUSECHIC IS SET TO FALSE' - LUSECHIC= .FALSE. -ENDIF -IF (LCH_PH.AND. (.NOT. LUSECHAQ)) THEN - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(UNIT=ILUOUT,FMT=*) 'DIAGNOSTIC PH COMPUTATION IS ACTIVATED' - WRITE(UNIT=ILUOUT,FMT=*) 'BUT AQUEOUS PHASE CHEMISTRY IS NOT ACTIVATED' - WRITE(UNIT=ILUOUT,FMT=*) 'SET LUSECHAQ TO TRUE IF YOU WANT TO ACTIVATE IT' - WRITE(UNIT=ILUOUT,FMT=*) 'LCH_PH IS SET TO FALSE' - LCH_PH= .FALSE. -ENDIF -IF (LUSECHIC.AND.(.NOT.LUSECHAQ)) THEN - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE ICE PHASE CHEMISTRY' - WRITE(UNIT=ILUOUT,FMT=*) 'BUT THE AQUEOUS PHASE CHEMISTRY IS NOT ACTIVATED' - WRITE(UNIT=ILUOUT,FMT=*) 'SET LUSECHAQ TO TRUE IF YOU WANT REALLY USE CLOUD CHEMISTRY' - WRITE(UNIT=ILUOUT,FMT=*) 'OR SET LUSECHIC TO FALSE IF YOU DO NOT WANT USE IT' -!callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') -END IF -IF ((LUSECHIC).AND.(LCH_RET_ICE)) THEN - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE RETENTION OF SOLUBLE GASES IN ICE' - WRITE(UNIT=ILUOUT,FMT=*) 'BUT THE ICE PHASE CHEMISTRY IS ACTIVATED' - WRITE(UNIT=ILUOUT,FMT=*) 'FLAG LCH_RET_ICE IS ONLY USES WHEN LUSECHIC IS SET' - WRITE(UNIT=ILUOUT,FMT=*) 'TO FALSE IE NO CHEMICAL SPECIES IN ICE' -ENDIF -! -CALL UPDATE_NAM_CH_MNHCN -CALL INI_NSV(KMI) -! -! From this point, all NSV* variables contain valid values for model KMI -! -DO JSV = 1,NSV - LUSESV(JSV,KMI) = .TRUE. -END DO -! -IF ( CAOP=='EXPL' .AND. .NOT.LDUST .AND. .NOT.LORILAM & - .AND. .NOT.LSALT .AND. .NOT.(CCLOUD=='LIMA') ) THEN - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT=*) ' YOU WANT TO USE EXPLICIT AEROSOL OPTICAL ' - WRITE(UNIT=ILUOUT,FMT=*) 'PROPERTIES BUT YOU DONT HAVE DUST OR ' - WRITE(UNIT=ILUOUT,FMT=*) 'AEROSOL OR SALT THEREFORE CAOP=CLIM' - CAOP='CLIM' -END IF -!------------------------------------------------------------------------------- -! -!* 3. CHECK COHERENCE BETWEEN EXSEG VARIABLES AND FMFILE ATTRIBUTES -! ------------------------------------------------------------- -! -! -!* 3.1 Turbulence variable -! -IF ((CTURB /= 'NONE').AND.(HTURB == 'NONE')) THEN - CGETTKET ='INIT' - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT=*)'YOU WANT TO USE TURBULENCE KINETIC ENERGY TKE' - WRITE(UNIT=ILUOUT,FMT=*)'WHEREAS IT IS NOT IN INITIAL FMFILE' - WRITE(UNIT=ILUOUT,FMT=*)'TKE WILL BE INITIALIZED TO ZERO' -ELSE - IF (CTURB /= 'NONE') THEN - CGETTKET ='READ' - IF ((CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETTKET='INIT' - ELSE - CGETTKET ='SKIP' - END IF -END IF -! -! -IF ((CTOM == 'TM06').AND.(HTOM /= 'TM06')) THEN - CGETBL_DEPTH ='INIT' - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT=*)'YOU WANT TO USE BL DEPTH FOR THIRD ORDER MOMENTS' - WRITE(UNIT=ILUOUT,FMT=*)'WHEREAS IT IS NOT IN INITIAL FMFILE' - WRITE(UNIT=ILUOUT,FMT=*)'IT WILL BE INITIALIZED TO ZERO' -ELSE - IF (CTOM == 'TM06') THEN - CGETBL_DEPTH ='READ' - ELSE - CGETBL_DEPTH ='SKIP' - END IF -END IF -! -IF (LRMC01 .AND. .NOT. ORMC01) THEN - CGETSBL_DEPTH ='INIT' - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT=*)'YOU WANT TO USE SBL DEPTH FOR RMC01' - WRITE(UNIT=ILUOUT,FMT=*)'WHEREAS IT IS NOT IN INITIAL FMFILE' - WRITE(UNIT=ILUOUT,FMT=*)'IT WILL BE INITIALIZED TO ZERO' -ELSE - IF (LRMC01) THEN - CGETSBL_DEPTH ='READ' - ELSE - CGETSBL_DEPTH ='SKIP' - END IF -END IF -! -! -!* 3.2 Moist variables -! -IF (LUSERV.AND. (.NOT.OUSERV)) THEN - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE VAPOR VARIABLE Rv WHEREAS IT ", & - & "IS NOT IN INITIAL FMFILE",/, & - & "Rv WILL BE INITIALIZED TO ZERO")') - CGETRVT='INIT' -ELSE - IF (LUSERV) THEN - CGETRVT='READ' - ELSE - CGETRVT='SKIP' - END IF -END IF -! -IF (LUSERC.AND. (.NOT.OUSERC)) THEN - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE CLOUD VARIABLE Rc WHEREAS IT ", & - & " IS NOT IN INITIAL FMFILE",/, & - & "Rc WILL BE INITIALIZED TO ZERO")') - CGETRCT='INIT' -ELSE - IF (LUSERC) THEN - CGETRCT='READ' -! IF(CCONF=='START') CGETRCT='INIT' - ELSE - CGETRCT='SKIP' - END IF -END IF -! -IF (LUSERR.AND. (.NOT.OUSERR)) THEN - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE RAIN VARIABLE Rr WHEREAS IT ", & - & "IS NOT IN INITIAL FMFILE",/, & - & " Rr WILL BE INITIALIZED TO ZERO")') - - CGETRRT='INIT' -ELSE - IF (LUSERR) THEN - CGETRRT='READ' -! IF( (CCONF=='START').AND. CPROGRAM /= 'DIAG') CGETRRT='INIT' - ELSE - CGETRRT='SKIP' - END IF -END IF -! -IF (LUSERI.AND. (.NOT.OUSERI)) THEN - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE ICE VARIABLE Ri WHEREAS IT ", & - & "IS NOT IN INITIAL FMFILE",/, & - & " Ri WILL BE INITIALIZED TO ZERO")') - CGETRIT='INIT' -ELSE - IF (LUSERI) THEN - CGETRIT='READ' -! IF(CCONF=='START') CGETRIT='INIT' - ELSE - CGETRIT='SKIP' - END IF -END IF -! -IF (LUSECI.AND. (.NOT.OUSECI)) THEN - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE ICE CONC. VARIABLE Ci WHEREAS IT ",& - & "IS NOT IN INITIAL FMFILE",/, & - & " Ci WILL BE INITIALIZED TO ZERO")') - CGETCIT='INIT' -ELSE - IF (LUSECI) THEN - CGETCIT='READ' - ELSE - CGETCIT='SKIP' - END IF -END IF -! -IF (LUSERS.AND. (.NOT.OUSERS)) THEN - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE SNOW VARIABLE Rs WHEREAS IT ",& - & "IS NOT IN INITIAL FMFILE",/, & - & " Rs WILL BE INITIALIZED TO ZERO")') - CGETRST='INIT' -ELSE - IF (LUSERS) THEN - CGETRST='READ' -! IF ( (CCONF=='START').AND. CPROGRAM /= 'DIAG') CGETRST='INIT' - ELSE - CGETRST='SKIP' - END IF -END IF -! -IF (LUSERG.AND. (.NOT.OUSERG)) THEN - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE GRAUPEL VARIABLE Rg WHEREAS ",& - & " IT IS NOTIN INITIAL FMFILE",/, & - & "Rg WILL BE INITIALIZED TO ZERO")') - CGETRGT='INIT' -ELSE - IF (LUSERG) THEN - CGETRGT='READ' -! IF ( (CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETRGT='INIT' - ELSE - CGETRGT='SKIP' - END IF -END IF -! -IF (LUSERH.AND. (.NOT.OUSERH)) THEN - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE HAIL VARIABLE Rh WHEREAS",& - & "IT IS NOT IN INITIAL FMFILE",/, & - & " Rh WILL BE INITIALIZED TO ZERO")') - CGETRHT='INIT' -ELSE - IF (LUSERH) THEN - CGETRHT='READ' -! IF ( (CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETRHT='INIT' - ELSE - CGETRHT='SKIP' - END IF -END IF -! -IF (LUSERC.AND. (.NOT.OUSERC)) THEN - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT=*) 'THE CLOUD FRACTION WILL BE INITIALIZED ACCORDING' - WRITE(UNIT=ILUOUT,FMT=*) 'TO CLOUD MIXING RATIO VALUE OR SET TO 0' - CGETCLDFR = 'INIT' -ELSE - IF ( LUSERC ) THEN - CGETCLDFR = 'READ' - IF ( (CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETCLDFR='INIT' - ELSE - CGETCLDFR = 'SKIP' - END IF -END IF -! -IF(CTURBLEN=='RM17' .OR. CTURBLEN=='ADAP') THEN - XCEDIS=0.34 -ELSE - XCEDIS=0.84 -END IF -! -!* 3.3 Moist turbulence -! -IF ( LUSERC .AND. CTURB /= 'NONE' ) THEN - IF ( .NOT. (OUSERC .AND. HTURB /= 'NONE') ) THEN - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE MOIST TURBULENCE WHEREAS IT ",/, & - & " WAS NOT THE CASE FOR THE INITIAL FMFILE GENERATION",/, & - & "SRC AND SIGS ARE INITIALIZED TO 0")') - CGETSRCT ='INIT' - CGETSIGS ='INIT' - ELSE - CGETSRCT ='READ' - IF ( (CCONF=='START') .AND. CPROGRAM /= 'DIAG') CGETSRCT ='INIT' - CGETSIGS ='READ' - END IF -ELSE - CGETSRCT ='SKIP' - CGETSIGS ='SKIP' -END IF -! -IF(NMODEL_CLOUD==KMI .AND. CTURBLEN_CLOUD/='NONE') THEN - IF (CTURB=='NONE' .OR. .NOT.LUSERC) THEN - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO COMPUTE A MIXING LENGTH FOR CLOUD=", & - & A4,/, & - & ", WHEREAS YOU DO NOT SPECIFY A TURBULENCE SCHEME OR ", & - & "USE OF RC,",/," CTURBLEN_CLOUD IS SET TO NONE")') & - CTURBLEN_CLOUD - CTURBLEN_CLOUD='NONE' - END IF - IF( XCEI_MIN > XCEI_MAX ) THEN - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(UNIT=ILUOUT,FMT='("PROBLEM OF CEI LIMITS FOR CLOUD MIXING ",/, & - & "LENGTH COMPUTATION: XCEI_MIN=",E9.3,", XCEI_MAX=",E9.3)')& - XCEI_MIN,XCEI_MAX - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') - END IF -END IF -! -IF ( LSIGMAS ) THEN - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE SIGMA_S FROM TURBULENCE SCHEME",/, & - & " IN ICE SUBGRID CONDENSATION, SO YOUR SIGMA_S"/, & - & " MIGHT BE SMALL ABOVE PBL DEPENDING ON LENGTH SCALE")') -END IF -! -IF (LSUBG_COND .AND. CTURB=='NONE' ) THEN - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE SUBGRID CONDENSATION' - WRITE(UNIT=ILUOUT,FMT=*) ' WITHOUT TURBULENCE ' - WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT ALLOWED: LSUBG_COND is SET to FALSE' - LSUBG_COND=.FALSE. -END IF -! -IF (L1D .AND. CTURB/='NONE' .AND. CTURBDIM == '3DIM') THEN - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE 3D TURBULENCE IN 1D CONFIGURATION ' - WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT POSSIBLE: CTURBDIM IS SET TO 1DIM' - CTURBDIM = '1DIM' -END IF -! -!* 3.4 Additional scalar variables -! -IF (NSV_USER == KSV_USER) THEN - DO JS = 1,KSV_USER ! to read all the variables in initial file - CGETSVT(JS)='READ' ! and to initialize them -! IF(CCONF=='START')CGETSVT(JS)='INIT' ! with these values - END DO -ELSEIF (NSV_USER > KSV_USER) THEN - IF (KSV_USER == 0) THEN - CGETSVT(1:NSV_USER)='INIT' - ELSE - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE MORE ADDITIONAL SCALAR " ,& - &" VARIABLES THAN THERE ARE IN INITIAL FMFILE",/, & - & "THE SUPPLEMENTARY VARIABLES HAVE BEEN INITIALIZED TO ZERO ")') - DO JS = 1,KSV_USER ! to read all the variables in initial file - CGETSVT(JS)='READ' ! and to initialize them -! IF(CCONF=='START')CGETSVT(JS)='INIT' ! with these values - END DO - DO JS = KSV_USER+1, NSV_USER ! to initialize to zero supplementary - CGETSVT(JS)='INIT' ! initial file) - END DO - END IF -ELSE - WRITE(UNIT=ILUOUT,FMT=9000) KMI - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE LESS ADDITIONAL SCALAR " ,& - &" VARIABLES THAN THERE ARE IN INITIAL FMFILE")') - DO JS = 1,NSV_USER ! to read the first NSV_USER variables in initial file - CGETSVT(JS)='READ' ! and to initialize with these values -! IF(CCONF=='START') CGETSVT(JS)='INIT' - END DO - DO JS = NSV_USER + 1, KSV_USER ! to skip the last (KSV_USER-NSV_USER) variables - CGETSVT(JS)='SKIP' - END DO -END IF -! -! C2R2 and KHKO SV case -! -IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO') THEN - IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' .OR. HCLOUD == 'KHKO') THEN - CGETSVT(NSV_C2R2BEG:NSV_C2R2END)='READ' -! IF(CCONF=='START') CGETSVT(NSV_C2R2BEG:NSV_C2R2END)='INIT' - ELSE - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR C2R2 & - & (or KHKO) SCHEME IN INITIAL FMFILE",/,& - & "THE C2R2 (or KHKO) VARIABLES HAVE BEEN INITIALIZED TO ZERO ")') - CGETSVT(NSV_C2R2BEG:NSV_C2R2END)='INIT' - END IF -END IF -! -! C3R5 SV case -! -IF (CCLOUD == 'C3R5') THEN - IF (HCLOUD == 'C3R5') THEN - CGETSVT(NSV_C1R3BEG:NSV_C1R3END)='READ' -! IF(CCONF=='START') CGETSVT(NSV_C1R3BEG:NSV_C1R3END)='INIT' - ELSE - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR C3R5 & - &SCHEME IN INITIAL FMFILE",/,& - & "THE C1R3 VARIABLES HAVE BEEN INITIALIZED TO ZERO ")') - CGETSVT(NSV_C1R3BEG:NSV_C1R3END)='INIT' - END IF -END IF -! -! LIMA SV case -! -IF (CCLOUD == 'LIMA') THEN - IF (HCLOUD == 'LIMA') THEN - CGETSVT(NSV_LIMA_BEG:NSV_LIMA_END)='READ' -!!JPP IF(HSTORAGE_TYPE=='TT') CGETSVT(NSV_LIMA_BEG:NSV_LIMA_END)='INIT' - ELSE - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR LIMA & - & SCHEME IN INITIAL FMFILE",/,& - & "THE LIMA VARIABLES HAVE BEEN INITIALIZED TO ZERO ")') - CGETSVT(NSV_LIMA_BEG:NSV_LIMA_END)='INIT' - END IF -END IF -! -! Electrical SV case -! -IF (CELEC /= 'NONE') THEN - IF (HELEC /= 'NONE') THEN - CGETSVT(NSV_ELECBEG:NSV_ELECEND)='READ' -! IF(CCONF=='START') CGETSVT(NSV_ELECBEG:NSV_ELECEND)='INIT' - ELSE - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR ELECTRICAL & - &SCHEME IN INITIAL FMFILE",/,& - & "THE ELECTRICAL VARIABLES HAVE BEEN INITIALIZED TO ZERO ")') - CGETSVT(NSV_ELECBEG:NSV_ELECEND)='INIT' - END IF -END IF -! -! (explicit) LINOx SV case -! -IF (CELEC /= 'NONE' .AND. LLNOX_EXPLICIT) THEN - IF (HELEC /= 'NONE' .AND. OLNOX_EXPLICIT) THEN - CGETSVT(NSV_LNOXBEG:NSV_LNOXEND)='READ' - ELSE - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR LINOX & - & IN INITIAL FMFILE",/,& - & "THE LINOX VARIABLES HAVE BEEN INITIALIZED TO ZERO ")') - CGETSVT(NSV_LNOXBEG:NSV_LNOXEND)='INIT' - END IF -END IF -! -! Chemical SV case (excluding aqueous chemical species) -! -IF (LUSECHEM) THEN - IF (OUSECHEM) THEN - CGETSVT(NSV_CHGSBEG:NSV_CHGSEND)='READ' - IF(CCONF=='START' .AND. LCH_INIT_FIELD ) CGETSVT(NSV_CHGSBEG:NSV_CHGSEND)='INIT' - ELSE - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR CHEMICAL & - &SCHEME IN INITIAL FMFILE",/,& - & "THE CHEMICAL VARIABLES HAVE BEEN INITIALIZED TO ZERO ")') - CGETSVT(NSV_CHGSBEG:NSV_CHGSEND)='INIT' - END IF -END IF -! add aqueous chemical species -IF (LUSECHAQ) THEN - IF (OUSECHAQ) THEN - CGETSVT(NSV_CHACBEG:NSV_CHACEND)='READ' -! IF(CCONF=='START') CGETSVT(NSV_CHACBEG:NSV_CHACEND)='INIT' - ELSE - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR CHEMICAL & - &SCHEME IN AQUEOUS PHASE IN INITIAL FMFILE",/,& - & "THE AQUEOUS PHASE CHEMICAL VARIABLES HAVE BEEN INITIALIZED TO ZERO ")') - CGETSVT(NSV_CHACBEG:NSV_CHACEND)='INIT' - END IF -END IF -! add ice phase chemical species -IF (LUSECHIC) THEN - IF (OUSECHIC) THEN - CGETSVT(NSV_CHICBEG:NSV_CHICEND)='READ' -! IF(CCONF=='START') CGETSVT(NSV_CHICBEG:NSV_CHICEND)='INIT' - ELSE - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR CHEMICAL & - &SPECIES IN ICE PHASE IN INITIAL FMFILE",/,& - & "THE ICE PHASE CHEMICAL VARIABLES HAVE BEEN INITIALIZED TO ZERO ")') - CGETSVT(NSV_CHICBEG:NSV_CHICEND)='INIT' - END IF -END IF -! pH values = diagnostics -IF (LCH_PH .AND. .NOT. OCH_PH) THEN - CGETPHC ='INIT' !will be initialized to XCH_PHINIT - IF (LUSERR) THEN - CGETPHR = 'INIT' !idem - ELSE - CGETPHR = 'SKIP' - ENDIF -ELSE - IF (LCH_PH) THEN - CGETPHC ='READ' - IF (LUSERR) THEN - CGETPHR = 'READ' - ELSE - CGETPHR = 'SKIP' - ENDIF - ELSE - CGETPHC ='SKIP' - CGETPHR ='SKIP' - END IF -END IF -! -! Dust case -! -IF (LDUST) THEN - IF (ODUST) THEN - CGETSVT(NSV_DSTBEG:NSV_DSTEND)='READ' -! IF(CCONF=='START') CGETSVT(NSV_DSTBEG:NSV_DSTEND)='INIT' - ELSE - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR DUST & - &SCHEME IN INITIAL FMFILE",/,& - & "THE DUST VARIABLES HAVE BEEN INITIALIZED TO ZERO ")') - CGETSVT(NSV_DSTBEG:NSV_DSTEND)='INIT' - END IF - IF (LDEPOS_DST(KMI)) THEN - - !UPG *PT - IF((CCLOUD /= 'ICE3').AND.(CCLOUD /= 'ICE4').AND.(CCLOUD /= 'KESS')& - .AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND.(CCLOUD /= 'LIMA').AND. & - (CPROGRAM/='SPAWN').AND.(CPROGRAM/='REAL')) THEN - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(UNIT=ILUOUT,FMT='("ERROR: WET DEPOSITION OF DUST IS ONLY CODED FOR THE",/,& - & "MICROPHYSICAL SCHEME as ICE3, ICE4, KESS, KHKO, LIMA and C2R2")') - !UPG *PT - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') - END IF - - IF (ODEPOS_DST(KMI) ) THEN - CGETSVT(NSV_DSTDEPBEG:NSV_DSTDEPEND)='READ' -! IF(CCONF=='START') CGETSVT(NSV_DSTDEPBEG:NSV_DSTDEPEND)='INIT' - ELSE - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR RAIN and CLOUD DUST & - & SCHEME IN INITIAL FMFILE",/,& - & "THE MOIST DUST VARIABLES HAVE BEEN INITIALIZED TO ZERO ")') - CGETSVT(NSV_DSTDEPBEG:NSV_DSTDEPEND)='INIT' - END IF - END IF - - IF(NMODE_DST.GT.3 .OR. NMODE_DST.LT.1) THEN - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(UNIT=ILUOUT,FMT='("DUST MODES MUST BE BETWEEN 1 and 3 ")') - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') - END IF -END IF -! -! Sea Salt case -! -IF (LSALT) THEN - IF (OSALT) THEN - CGETSVT(NSV_SLTBEG:NSV_SLTEND)='READ' - CGETZWS='READ' -! IF(CCONF=='START') CGETSVT(NSV_SLTBEG:NSV_SLTEND)='INIT' - ELSE - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR SALT & - &SCHEME IN INITIAL FMFILE",/,& - & "THE SALT VARIABLES HAVE BEEN INITIALIZED TO ZERO ")') - CGETSVT(NSV_SLTBEG:NSV_SLTEND)='INIT' - CGETZWS='INIT' - END IF - IF (LDEPOS_SLT(KMI)) THEN - - !UPG*PT - IF((CCLOUD /= 'ICE3').AND.(CCLOUD /= 'ICE4').AND.(CCLOUD /= 'KESS')& - !.AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND. & - .AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND.(CCLOUD /= 'LIMA').AND. & - (CPROGRAM/='SPAWN').AND.(CPROGRAM/='REAL')) THEN - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(UNIT=ILUOUT,FMT='("ERROR: WET DEPOSITION OF SEA SALT AEROSOLS IS ONLY CODED FOR THE",/,& - & "MICROPHYSICAL SCHEME as ICE3, ICE4, KESS, KHKO, LIMA and C2R2")') - !UPG*PT - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') - END IF - - IF (ODEPOS_SLT(KMI) ) THEN - CGETSVT(NSV_SLTDEPBEG:NSV_SLTDEPEND)='READ' -! IF(CCONF=='START') CGETSVT(NSV_SLTDEPBEG:NSV_SLTDEPEND)='INIT' - ELSE - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR RAIN and CLOUD SEA SALT & - & SCHEME IN INITIAL FMFILE",/,& - & "THE MOIST SEA SALT VARIABLES HAVE BEEN INITIALIZED TO ZERO ")') - CGETSVT(NSV_SLTDEPBEG:NSV_SLTDEPEND)='INIT' - END IF - END IF - IF(NMODE_SLT.GT.8 .OR. NMODE_SLT.LT.1) THEN - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(UNIT=ILUOUT,FMT='("SALT MODES MUST BE BETWEEN 1 and 8 ")') - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') - END IF -END IF -! -! Orilam SV case -! -IF (LORILAM) THEN - IF (OORILAM) THEN - CGETSVT(NSV_AERBEG:NSV_AEREND)='READ' -! IF(CCONF=='START') CGETSVT(NSV_AERBEG:NSV_AEREND)='INIT' - ELSE - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR AEROSOL & - &SCHEME IN INITIAL FMFILE",/,& - & "THE AEROSOLS VARIABLES HAVE BEEN INITIALIZED TO ZERO ")') - CGETSVT(NSV_AERBEG:NSV_AEREND)='INIT' - END IF - IF (LDEPOS_AER(KMI)) THEN - - !UPG*PT - IF((CCLOUD /= 'ICE3').AND.(CCLOUD /= 'ICE4').AND.(CCLOUD /= 'KESS')& - .AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND.(CCLOUD /= 'LIMA').AND. & - !.AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND. & - (CPROGRAM/='SPAWN').AND.(CPROGRAM/='REAL')) THEN - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(UNIT=ILUOUT,FMT='("ERROR: WET DEPOSITION OF ORILAM AEROSOLS IS ONLY CODED FOR THE",/,& - & "MICROPHYSICAL SCHEME as ICE3, ICE4, KESS, KHKO, LIMA and C2R2")') - !UPG*PT - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') - END IF - - IF (ODEPOS_AER(KMI) ) THEN - CGETSVT(NSV_AERDEPBEG:NSV_AERDEPEND)='READ' -! IF(CCONF=='START') CGETSVT(NSV_AERDEPBEG:NSV_AERDEPEND)='INIT' - ELSE - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR RAIN and IN CLOUD & - & AEROSOL SCHEME IN INITIAL FMFILE",/,& - & "THE MOIST AEROSOL VARIABLES HAVE BEEN INITIALIZED TO ZERO ")') - CGETSVT(NSV_AERDEPBEG:NSV_AERDEPEND)='INIT' - END IF - END IF -END IF -! -! Lagrangian variables -! -IF (LINIT_LG .AND. .NOT.(LLG)) THEN - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("IT IS INCOHERENT TO HAVE LINIT_LG=.T. AND LLG=.F.",/,& - & "IF YOU WANT LAGRANGIAN TRACERS CHANGE LLG TO .T. ")') -ENDIF -IF (LLG) THEN - IF (OLG .AND. .NOT.(LINIT_LG .AND. CPROGRAM=='MESONH')) THEN - CGETSVT(NSV_LGBEG:NSV_LGEND)='READ' -! IF(CCONF=='START') CGETSVT(NSV_LGBEG:NSV_LGEND)='INIT' - ELSE - IF(.NOT.(LINIT_LG) .AND. CPROGRAM=='MESONH') THEN - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("THERE IS NO LAGRANGIAN VARIABLES IN INITIAL FMFILE",/,& - & "THE LAGRANGIAN VARIABLES HAVE BEEN REINITIALIZED")') - LINIT_LG=.TRUE. - ENDIF - CGETSVT(NSV_LGBEG:NSV_LGEND)='INIT' - END IF -END IF -! -! -! LINOx SV case -! -IF (.NOT.LUSECHEM .AND. LCH_CONV_LINOX) THEN - IF (.NOT.OUSECHEM .AND. OCH_CONV_LINOX) THEN - CGETSVT(NSV_LNOXBEG:NSV_LNOXEND)='READ' - ELSE - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR LINOX & - &IN INITIAL FMFILE",/,& - & "THE LINOX VARIABLES HAVE BEEN INITIALIZED TO ZERO ")') - CGETSVT(NSV_LNOXBEG:NSV_LNOXEND)='INIT' - END IF -END IF -! -! Passive pollutant case -! -IF (LPASPOL) THEN - IF (OPASPOL) THEN - CGETSVT(NSV_PPBEG:NSV_PPEND)='READ' -! IF(CCONF=='START') CGETSVT(NSV_PPBEG:NSV_PPEND)='INIT' - ELSE - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("THERE IS NO PASSIVE SCALAR VARIABLES IN INITIAL FMFILE",/,& - & "THE VARIABLES HAVE BEEN INITIALIZED TO ZERO")') - CGETSVT(NSV_PPBEG:NSV_PPEND)='INIT' - END IF -END IF -! -#ifdef MNH_FOREFIRE -! ForeFire -! -IF (LFOREFIRE) THEN - IF (OFOREFIRE) THEN - CGETSVT(NSV_FFBEG:NSV_FFEND)='READ' - IF(HSTORAGE_TYPE=='TT') THEN - CGETSVT(NSV_FFBEG:NSV_FFEND)='INIT' - END IF - ELSE - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("THERE IS NO FOREFIRE SCALAR VARIABLES IN INITIAL FMFILE",/,& - & "THE VARIABLES HAVE BEEN INITIALIZED TO ZERO")') - CGETSVT(NSV_FFBEG:NSV_FFEND)='INIT' - END IF -END IF -#endif -! -! Conditional sampling case -! -IF (LCONDSAMP) THEN - IF (OCONDSAMP) THEN - CGETSVT(NSV_CSBEG:NSV_CSEND)='READ' -! IF(CCONF=='START') CGETSVT(NSV_CSBEG:NSV_CSEND)='INIT' - ELSE - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("THERE IS NO PASSIVE SCALAR VARIABLES IN INITIAL FMFILE",/,& - & "THE VARIABLES HAVE BEEN INITIALIZED TO ZERO")') - CGETSVT(NSV_CSBEG:NSV_CSEND)='INIT' - END IF -END IF -! -! Blowing snow scheme -! -IF (LBLOWSNOW) THEN - IF (OBLOWSNOW) THEN - CGETSVT(NSV_SNWBEG:NSV_SNWEND)='READ' - ELSE - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='("THERE IS NO SCALAR VARIABLES FOR BLOWING SNOW & - &SCHEME IN INITIAL FMFILE",/,& - & "THE BLOWING SNOW VARIABLES HAVE BEEN INITIALIZED TO ZERO ")') - CGETSVT(NSV_SNWBEG:NSV_SNWEND)='INIT' - END IF -END IF -! -! -! -!* 3.5 Check coherence between the radiation control parameters -! -IF( CRAD == 'ECMW' .AND. CPROGRAM=='MESONH' ) THEN - IF(CLW == 'RRTM' .AND. COPILW == 'SMSH') THEN - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(UNIT=ILUOUT,FMT=*) 'the SMSH parametrisation of LW optical properties for cloud ice' - WRITE(UNIT=ILUOUT,FMT=*) '(COPILW) can not be used with RRTM radiation scheme' - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') - ENDIF - IF(CLW == 'MORC' .AND. COPWLW == 'LILI') THEN - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(UNIT=ILUOUT,FMT=*) 'the LILI parametrisation of LW optical properties for cloud water' - WRITE(UNIT=ILUOUT,FMT=*) '(COPWLW) can not be used with MORC radiation scheme' - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') - ENDIF - IF( .NOT. LSUBG_COND) THEN - WRITE(UNIT=ILUOUT,FMT=9000) KMI - WRITE(UNIT=ILUOUT,FMT=*) 'YOU DO NOT WANT TO USE SUBGRID CONDENSATION' - WRITE(UNIT=ILUOUT,FMT=*) 'THE OVERLAP OPTION IS NOVLP=5 IN ini_radconf.f90' - ELSE IF (CLW == 'MORC') THEN - WRITE(UNIT=ILUOUT,FMT=9000) KMI - WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE MORCRETTE LW SCHEME' - WRITE(UNIT=ILUOUT,FMT=*) 'THE OVERLAP OPTION IS NOVLP=5 IN ini_radconf.f90' - ELSE - WRITE(UNIT=ILUOUT,FMT=9000) KMI - WRITE(UNIT=ILUOUT,FMT=*) 'THE OVERLAP OPTION IS NOVLP=6 IN ini_radconf.f90' - ENDIF -! - IF( LCLEAR_SKY .AND. XDTRAD_CLONLY /= XDTRAD) THEN - ! Check the validity of the LCLEAR_SKY approximation - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE BOTH THE CLEAR-SKY APPROXIMATION' - WRITE(UNIT=ILUOUT,FMT=*) '(i.e. AVERAGE THE WHOLE CLOUDFREE VERTICALS BUT KEEP' - WRITE(UNIT=ILUOUT,FMT=*) 'ALL THE CLOUDY VERTICALS) AND' - WRITE(UNIT=ILUOUT,FMT=*) 'THE CLOUD-ONLY APPROXIMATION (i.e. YOU CALL MORE OFTEN THE' - WRITE(UNIT=ILUOUT,FMT=*) 'RADIATIONS FOR THE CLOUDY VERTICALS THAN FOR CLOUDFREE ONES).' - WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT POSSIBLE, SO CHOOSE BETWEEN :' - WRITE(UNIT=ILUOUT,FMT=*) 'XDTRAD_CLONLY = XDTRAD and LCLEAR_SKY = FALSE' -! - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') - END IF -! - IF( XDTRAD_CLONLY > XDTRAD ) THEN - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(UNIT=ILUOUT,FMT='("BAD USE OF THE CLOUD-ONLY APPROXIMATION " ,& - &" XDTRAD SHOULD BE LARGER THAN XDTRAD_CLONLY ")') -! - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') - END IF -! - IF(( XDTRAD < XTSTEP ).OR. ( XDTRAD_CLONLY < XTSTEP )) THEN - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(UNIT=ILUOUT,FMT='("THE RADIATION CALL XDTRAD OR XDTRAD_CLONLY " ,& - &" IS MORE FREQUENT THAN THE TIME STEP SO ADJUST XDTRAD OR XDTRAD_CLONLY ")') -! - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') - END IF -END IF -! -IF ( CRAD /= 'NONE' .AND. CPROGRAM=='MESONH' ) THEN - CGETRAD='READ' - IF( HRAD == 'NONE' .AND. CCONF=='RESTA') THEN - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT=*) 'YOU ARE PERFORMING A RESTART. FOR THIS SEGMENT, YOU ARE USING A RADIATION' - WRITE(UNIT=ILUOUT,FMT=*) 'SCHEME AND NO RADIATION SCHEME WAS USED FOR THE PREVIOUS SEGMENT.' - CGETRAD='INIT' - END IF - IF(CCONF=='START') THEN - CGETRAD='INIT' - END IF -END IF -! -! 3.6 check the initialization of the deep convection scheme -! -IF ( (CDCONV /= 'KAFR') .AND. & - (CSCONV /= 'KAFR') .AND. LCHTRANS ) THEN - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE LCHTRANS OPTION= ",& - &"CONVECTIVE TRANSPORT OF TRACERS BUT IT CAN ONLY",& - &"BE USED FOR THE KAIN FRITSCH SCHEME ")') - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') -END IF -! -SELECT CASE ( CDCONV ) - CASE( 'KAFR' ) - IF (.NOT. ( LUSERV ) ) THEN - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE KAIN-FRITSCH DEEP CONV. ",& - &" SCHEME. YOU MUST HAVE VAPOR ",/,"LUSERV IS SET TO TRUE ")') - LUSERV=.TRUE. - ELSE IF (.NOT. ( LUSERI ) ) THEN - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE KAIN-FRITSCH",& - &" DEEP CONV. SCHEME. BUT THE DETRAINED CLOUD ICE WILL BE ADDED TO ",& - &" THE CLOUD WATER ")') - ELSE IF (.NOT. ( LUSERI.AND.LUSERC ) ) THEN - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE KAIN-FRITSCH",& - &" DEEP CONV. SCHEME. BUT THE DETRAINED CLOUD WATER AND CLOUD ICE ",& - &" WILL BE ADDED TO THE WATER VAPOR FIELD ")') - END IF - IF ( LCHTRANS .AND. NSV == 0 ) THEN - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE LCHTRANS OPTION= ",& - &"CONVECTIVE TRANSPORT OF TRACERS BUT YOUR TRACER ",& - &"NUMBER NSV IS ZERO ",/,"LCHTRANS IS SET TO FALSE")') - LCHTRANS=.FALSE. - END IF -END SELECT -! -IF ( CDCONV == 'KAFR' .AND. LCHTRANS .AND. NSV > 0 ) THEN - IF( OCHTRANS ) THEN - CGETSVCONV='READ' - ELSE - CGETSVCONV='INIT' - END IF -END IF -! -SELECT CASE ( CSCONV ) - CASE( 'KAFR' ) - IF (.NOT. ( LUSERV ) ) THEN - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE KAIN-FRITSCH SHALLOW CONV. ",& - &" SCHEME. YOU MUST HAVE VAPOR ",/,"LUSERV IS SET TO TRUE ")') - LUSERV=.TRUE. - ELSE IF (.NOT. ( LUSERI ) ) THEN - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE KAIN-FRITSCH",& - &" SHALLOW CONV. SCHEME. BUT THE DETRAINED CLOUD ICE WILL BE ADDED TO ",& - &" THE CLOUD WATER ")') - ELSE IF (.NOT. ( LUSERI.AND.LUSERC ) ) THEN - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE KAIN-FRITSCH",& - &" SHALLOW CONV. SCHEME. BUT THE DETRAINED CLOUD WATER AND CLOUD ICE ",& - &" WILL BE ADDED TO THE WATER VAPOR FIELD ")') - END IF - IF ( LCHTRANS .AND. NSV == 0 ) THEN - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE LCHTRANS OPTION= ",& - &"CONVECTIVE TRANSPORT OF TRACERS BUT YOUR TRACER ",& - &"NUMBER NSV IS ZERO ",/,"LCHTRANS IS SET TO FALSE")') - LCHTRANS=.FALSE. - END IF - CASE( 'EDKF' ) - IF (CTURB == 'NONE' ) THEN - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE THE EDKF ", & - &"SHALLOW CONVECTION WITHOUT TURBULENCE SCHEME : ", & - &"IT IS NOT POSSIBLE")') -! - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') - END IF -END SELECT -! -! -CGETCONV = 'SKIP' -! -IF ( (CDCONV /= 'NONE' .OR. CSCONV == 'KAFR' ) .AND. CPROGRAM=='MESONH') THEN - CGETCONV = 'READ' - IF( HDCONV == 'NONE' .AND. CCONF=='RESTA') THEN - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(UNIT=ILUOUT,FMT='(" YOU ARE PERFORMING A RESTART. FOR THIS ",& - &" SEGMENT, YOU ARE USING A DEEP CONVECTION SCHEME AND NO DEEP ",& - &" CONVECTION SCHEME WAS USED FOR THE PREVIOUS SEGMENT. ")') -! - CGETCONV = 'INIT' - END IF - IF(CCONF=='START') THEN - CGETCONV = 'INIT' - END IF -END IF -! -!* 3.7 configuration and model version -! -IF (KMI == 1) THEN -! - IF (L1D.AND.(CLBCX(1)/='CYCL'.AND.CLBCX(2)/='CYCL' & - .AND.CLBCY(1)/='CYCL'.AND.CLBCY(2)/='CYCL')) THEN - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE A 1D MODEL VERSION WITH NON-CYCL",& - & "CLBCX OR CLBCY VALUES")') - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') - END IF - IF (L2D.AND.(CLBCY(1)/='CYCL'.AND.CLBCY(2)/='CYCL')) THEN - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE A 2D MODEL VERSION WITH NON-CYCL",& - & " CLBCY VALUES")') - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') - END IF - ! - IF ( (.NOT. LCARTESIAN) .AND. ( LCORIO) .AND. (.NOT. LGEOST_UV_FRC) ) THEN - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(UNIT=ILUOUT,FMT='("BE CAREFUL YOU COULD HAVE SPURIOUS MOTIONS " ,& - & " NEAR THE LBC AS LCORIO=T and LGEOST_UV_FRC=F")') - END IF - ! - IF ((.NOT.LFLAT).AND.OFLAT) THEN - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(UNIT=ILUOUT,FMT=*) 'ZERO OROGRAPHY IN INITIAL FILE' - WRITE(UNIT=ILUOUT,FMT=*) '***** ALL TERMS HAVE BEEN NEVERTHELESS COMPUTED WITHOUT SIMPLIFICATION*****' - WRITE(UNIT=ILUOUT,FMT=*) 'THIS SHOULD LEAD TO ERRORS IN THE PRESSURE COMPUTATION' - END IF - IF (LFLAT.AND.(.NOT.OFLAT)) THEN - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(UNIT=ILUOUT,FMT='(" OROGRAPHY IS NOT EQUAL TO ZERO ", & - & "IN INITIAL FILE" ,/, & - & "******* OROGRAPHY HAS BEEN SET TO ZERO *********",/, & - & "ACCORDING TO ZERO OROGRAPHY, SIMPLIFICATIONS HAVE ", & - & "BEEN MADE IN COMPUTATIONS")') - END IF -END IF -! -!* 3.8 System of equations -! -IF ( HEQNSYS /= CEQNSYS ) THEN - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(ILUOUT,FMT=*) 'YOU HAVE CHANGED THE SYSTEM OF EQUATIONS' - WRITE(ILUOUT,FMT=*) 'THE ANELASTIC CONSTRAINT IS PERHAPS CHANGED :' - WRITE(ILUOUT,FMT=*) 'FOR THE INITIAL FILE YOU HAVE USED ',HEQNSYS - WRITE(ILUOUT,FMT=*) 'FOR THE RUN YOU PLAN TO USE ',CEQNSYS - WRITE(ILUOUT,FMT=*) 'THIS CAN LEAD TO A NUMERICAL EXPLOSION IN THE FIRST TIME STEPS' - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') -END IF -! -! 3.9 Numerical schemes -! -IF ( (CUVW_ADV_SCHEME == 'CEN4TH') .AND. & - (CTEMP_SCHEME /= 'LEFR') .AND. (CTEMP_SCHEME /= 'RKC4') ) THEN - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(UNIT=ILUOUT,FMT='("CEN4TH SCHEME HAS TO BE USED WITH ",& - &"CTEMP_SCHEME = LEFR of RKC4 ONLY")') - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') -END IF -! -IF ( (CUVW_ADV_SCHEME == 'WENO_K') .AND. LNUMDIFU ) THEN - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(UNIT=ILUOUT,FMT='("YOU WANT TO USE NUMERICAL DIFFUSION ",& - &"WITH WENO SCHEME ALREADY DIFFUSIVE")') -END IF -!------------------------------------------------------------------------------- -! -!* 4. CHECK COHERENCE BETWEEN EXSEG VARIABLES -! --------------------------------------- -! -!* 4.1 coherence between coupling variables in EXSEG file -! -IF (KMI == 1) THEN - NCPL_NBR = 0 - DO JCI = 1,JPCPLFILEMAX - IF (LEN_TRIM(CCPLFILE(JCI)) /= 0) THEN ! Finds the number - NCPL_NBR = NCPL_NBR + 1 ! of coupling files - ENDIF - IF (JCI/=JPCPLFILEMAX) THEN ! Deplaces the coupling files - IF ((LEN_TRIM(CCPLFILE(JCI)) == 0) .AND. &! names if one missing - (LEN_TRIM(CCPLFILE(JCI+1)) /= 0)) THEN - DO JI=JCI,JPCPLFILEMAX-1 - CCPLFILE(JI)=CCPLFILE(JI+1) - END DO - CCPLFILE(JPCPLFILEMAX)=' ' - END IF - END IF - END DO -! - IF (NCPL_NBR /= 0) THEN - LSTEADYLS = .FALSE. - ELSE - LSTEADYLS = .TRUE. - ENDIF -END IF -! -!* 4.3 check consistency in forcing switches -! -IF ( LFORCING ) THEN - IF ( LRELAX_THRV_FRC .AND. ( LTEND_THRV_FRC .OR. LGEOST_TH_FRC ) ) THEN - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(ILUOUT,FMT=*) 'YOU CHOSE A TEMPERATURE AND HUMIDITY RELAXATION' - WRITE(ILUOUT,FMT=*) 'TOGETHER WITH TENDENCY OR GEOSTROPHIC FORCING' - WRITE(ILUOUT,FMT=*) & - 'YOU MIGHT CHECK YOUR SWITCHES: LRELAX_THRV_FRC, LTEND_THRV_FRC, AND' - WRITE(ILUOUT,FMT=*) 'LGEOST_TH_FRC' - END IF -! - IF ( LRELAX_UV_FRC .AND. LRELAX_UVMEAN_FRC) THEN - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(ILUOUT,FMT=*) 'YOU MUST CHOOSE BETWEEN A RELAXATION APPLIED TO' - WRITE(ILUOUT,FMT=*) 'THE 3D FULL WIND FIELD (LRELAX_UV_FRC) OR' - WRITE(ILUOUT,FMT=*) 'THE HORIZONTAL MEAN WIND (LRELAX_UVMEAN_FRC)' - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') - END IF -! - IF ( (LRELAX_UV_FRC .OR. LRELAX_UVMEAN_FRC) .AND. LGEOST_UV_FRC ) THEN - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(ILUOUT,FMT=*) 'YOU MUST NOT USE A WIND RELAXATION' - WRITE(ILUOUT,FMT=*) 'TOGETHER WITH A GEOSTROPHIC FORCING' - WRITE(ILUOUT,FMT=*) 'CHECK SWITCHES: LRELAX_UV_FRC, LRELAX_UVMEAN_FRC, LGEOST_UV_FRC' - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') - END IF -! - IF ( CRELAX_HEIGHT_TYPE.NE."FIXE" .AND. CRELAX_HEIGHT_TYPE.NE."THGR" ) THEN - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(ILUOUT,FMT=*) 'CRELAX_HEIGHT_TYPE MUST BE EITHER "FIXE" OR "THGR"' - WRITE(ILUOUT,FMT=*) 'BUT IT IS "', CRELAX_HEIGHT_TYPE, '"' - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') - END IF -! - IF ( .NOT.LCORIO .AND. LGEOST_UV_FRC ) THEN - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(ILUOUT,FMT=*) 'YOU CANNOT HAVE A GEOSTROPHIC FORCING WITHOUT' - WRITE(ILUOUT,FMT=*) 'ACTIVATING LCORIOLIS OPTION' - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') - END IF -! - IF ( LPGROUND_FRC ) THEN - WRITE(ILUOUT,FMT=*) 'SURFACE PRESSURE FORCING NOT YET IMPLEMENTED' - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') - END IF -! -END IF -! -IF (LTRANS .AND. .NOT. LFLAT ) THEN - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(ILUOUT,FMT=*) 'YOU ASK FOR A CONSTANT SPEED DOMAIN TRANSLATION ' - WRITE(ILUOUT,FMT=*) 'BUT NOT IN THE FLAT TERRAIN CASE:' - WRITE(ILUOUT,FMT=*) 'THIS IS NOT ALLOWED ACTUALLY' - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') -END IF -! -!* 4.4 Check the coherence between the LUSERn and LHORELAX -! -IF (.NOT. LUSERV .AND. LHORELAX_RV) THEN - LHORELAX_RV=.FALSE. - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RV FIELD BUT IT DOES NOT EXIST.' - WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RV=FALSE' -END IF -! -IF (.NOT. LUSERC .AND. LHORELAX_RC) THEN - LHORELAX_RC=.FALSE. - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RC FIELD BUT IT DOES NOT EXIST.' - WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RC=FALSE' -END IF -! -IF (.NOT. LUSERR .AND. LHORELAX_RR) THEN - LHORELAX_RR=.FALSE. - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RR FIELD BUT IT DOES NOT EXIST.' - WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RR=FALSE' -END IF -! -IF (.NOT. LUSERI .AND. LHORELAX_RI) THEN - LHORELAX_RI=.FALSE. - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RI FIELD BUT IT DOES NOT EXIST.' - WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RI=FALSE' -END IF -! -IF (.NOT. LUSERS .AND. LHORELAX_RS) THEN - LHORELAX_RS=.FALSE. - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RS FIELD BUT IT DOES NOT EXIST.' - WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RS=FALSE' -END IF -! -IF (.NOT. LUSERG .AND. LHORELAX_RG) THEN - LHORELAX_RG=.FALSE. - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RG FIELD BUT IT DOES NOT EXIST.' - WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RG=FALSE' -END IF -! -IF (.NOT. LUSERH .AND. LHORELAX_RH) THEN - LHORELAX_RH=.FALSE. - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX RH FIELD BUT IT DOES NOT EXIST.' - WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RH=FALSE' -END IF -! -IF (CTURB=='NONE' .AND. LHORELAX_TKE) THEN - LHORELAX_TKE=.FALSE. - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX TKE FIELD BUT IT DOES NOT EXIST.' - WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_TKE=FALSE' -END IF -! -! -IF (CCLOUD/='C2R2' .AND. CCLOUD/='KHKO' .AND. LHORELAX_SVC2R2) THEN - LHORELAX_SVC2R2=.FALSE. - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX C2R2 or KHKO FIELD BUT IT DOES NOT EXIST.' - WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVC2R2=FALSE' -END IF -! -IF (CCLOUD/='C3R5' .AND. LHORELAX_SVC1R3) THEN - LHORELAX_SVC1R3=.FALSE. - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX C3R5 FIELD BUT IT DOES NOT EXIST.' - WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVC1R3=FALSE' -END IF -! -IF (CCLOUD/='LIMA' .AND. LHORELAX_SVLIMA) THEN - LHORELAX_SVLIMA=.FALSE. - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX LIMA FIELD BUT IT DOES NOT EXIST.' - WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVLIMA=FALSE' -END IF -! -IF (CELEC(1:3) /= 'ELE' .AND. LHORELAX_SVELEC) THEN - LHORELAX_SVELEC=.FALSE. - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX ELEC FIELD BUT IT DOES NOT EXIST.' - WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVELEC=FALSE' -END IF -! -IF (.NOT. LUSECHEM .AND. LHORELAX_SVCHEM) THEN - LHORELAX_SVCHEM=.FALSE. - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX CHEM FIELD BUT IT DOES NOT EXIST.' - WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVCHEM=FALSE' -END IF -! -IF (.NOT. LUSECHIC .AND. LHORELAX_SVCHIC) THEN - LHORELAX_SVCHIC=.FALSE. - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX ICE CHEM FIELD BUT IT DOES NOT EXIST.' - WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVCHIC=FALSE' -END IF -! -IF (.NOT. LORILAM .AND. LHORELAX_SVAER) THEN - LHORELAX_SVAER=.FALSE. - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX AEROSOL FIELD BUT IT DOES NOT EXIST.' - WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVAER=FALSE' -END IF - -IF (.NOT. LDUST .AND. LHORELAX_SVDST) THEN - LHORELAX_SVDST=.FALSE. - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX DUST FIELD BUT IT DOES NOT EXIST.' - WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVDST=FALSE' -END IF - -IF (.NOT. LSALT .AND. LHORELAX_SVSLT) THEN - LHORELAX_SVSLT=.FALSE. - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX SEA SALT FIELD BUT IT DOES NOT EXIST.' - WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVSLT=FALSE' -END IF - -IF (.NOT. LPASPOL .AND. LHORELAX_SVPP) THEN - LHORELAX_SVPP=.FALSE. - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX PASSIVE POLLUTANT FIELD BUT IT DOES NOT EXIST.' - WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVPP=FALSE' -END IF -#ifdef MNH_FOREFIRE -IF (.NOT. LFOREFIRE .AND. LHORELAX_SVFF) THEN - LHORELAX_SVFF=.FALSE. - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX FOREFIRE FLUXES BUT THEY DO NOT EXIST.' - WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVFF=FALSE' -END IF -#endif -IF (.NOT. LCONDSAMP .AND. LHORELAX_SVCS) THEN - LHORELAX_SVCS=.FALSE. - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX CONDITIONAL SAMPLING FIELD BUT IT DOES NOT EXIST.' - WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVCS=FALSE' -END IF - -IF (.NOT. LBLOWSNOW .AND. LHORELAX_SVSNW) THEN - LHORELAX_SVSNW=.FALSE. - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX BLOWING SNOW FIELD BUT IT DOES NOT EXIST.' - WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SVSNW=FALSE' -END IF - -IF (ANY(LHORELAX_SV(NSV+1:))) THEN - LHORELAX_SV(NSV+1:)=.FALSE. - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX SV(NSV+1:) FIELD BUT IT DOES NOT EXIST.' - WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SV(NSV+1:)=FALSE' -END IF -! -!* 4.5 check the number of points for the horizontal relaxation -! -IF ( NRIMX > KRIMX .AND. .NOT.LHORELAX_SVELEC ) THEN - NRIMX = KRIMX - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE A LARGER NUMBER OF POINTS ' - WRITE(ILUOUT,FMT=*) 'FOR THE HORIZONTAL RELAXATION THAN THE ' - WRITE(ILUOUT,FMT=*) 'CORRESPONDING NUMBER OF LARGE SCALE FIELDS:' - WRITE(ILUOUT,FMT=*) 'IT IS THEREFORE REDUCED TO NRIMX =',NRIMX -END IF -! -IF ( L2D .AND. KRIMY>0 ) THEN - NRIMY = 0 - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE A 2D MODEL THEREFORE NRIMY=0 ' -END IF -! -IF ( NRIMY > KRIMY .AND. .NOT.LHORELAX_SVELEC ) THEN - NRIMY = KRIMY - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE A LARGER NUMBER OF POINTS ' - WRITE(ILUOUT,FMT=*) 'FOR THE HORIZONTAL RELAXATION THAN THE ' - WRITE(ILUOUT,FMT=*) 'CORRESPONDING NUMBER OF LARGE SCALE FIELDS:' - WRITE(ILUOUT,FMT=*) 'IT IS THEREFORE REDUCED TO NRIMY =',NRIMY -END IF -! -IF ( (.NOT. LHORELAX_UVWTH) .AND. (.NOT.(ANY(LHORELAX_SV))) .AND. & - (.NOT. LHORELAX_SVC2R2).AND. (.NOT. LHORELAX_SVC1R3) .AND. & - (.NOT. LHORELAX_SVLIMA).AND. & - (.NOT. LHORELAX_SVELEC).AND. (.NOT. LHORELAX_SVCHEM) .AND. & - (.NOT. LHORELAX_SVLG) .AND. (.NOT. LHORELAX_SVPP) .AND. & - (.NOT. LHORELAX_SVCS) .AND. & -#ifdef MNH_FOREFIRE - (.NOT. LHORELAX_SVFF) .AND. & -#endif - (.NOT. LHORELAX_RV) .AND. (.NOT. LHORELAX_RC) .AND. & - (.NOT. LHORELAX_RR) .AND. (.NOT. LHORELAX_RI) .AND. & - (.NOT. LHORELAX_RS) .AND. (.NOT. LHORELAX_RG) .AND. & - (.NOT. LHORELAX_RH) .AND. (.NOT. LHORELAX_TKE) .AND. & - (.NOT. LHORELAX_SVCHIC).AND. & - (NRIMX /= 0 .OR. NRIMY /= 0)) THEN - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(ILUOUT,FMT=*) 'YOU DO NOT WANT TO USE THE HORIZONTAL RELAXATION ' - WRITE(ILUOUT,FMT=*) 'THEREFORE NRIMX=NRIMY=0 ' - NRIMX=0 - NRIMY=0 -END IF -! -IF ((LHORELAX_UVWTH .OR. LHORELAX_SVPP .OR. & - LHORELAX_SVCS .OR. & -#ifdef MNH_FOREFIRE - LHORELAX_SVFF .OR. & -#endif - LHORELAX_SVC2R2 .OR. LHORELAX_SVC1R3 .OR. & - LHORELAX_SVLIMA .OR. & - LHORELAX_SVELEC .OR. LHORELAX_SVCHEM .OR. & - LHORELAX_SVLG .OR. ANY(LHORELAX_SV) .OR. & - LHORELAX_RV .OR. LHORELAX_RC .OR. & - LHORELAX_RR .OR. LHORELAX_RI .OR. & - LHORELAX_RG .OR. LHORELAX_RS .OR. & - LHORELAX_RH .OR. LHORELAX_TKE.OR. & - LHORELAX_SVCHIC ) & - .AND. (NRIMX==0 .OR. (NRIMY==0 .AND. .NOT.(L2D) ))) THEN - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE THE HORIZONTAL RELAXATION ' - WRITE(ILUOUT,FMT=*) 'BUT NRIMX OR NRIMY=0 CHANGE YOUR VALUES ' - WRITE(ILUOUT,FMT=*) "LHORELAX_UVWTH=",LHORELAX_UVWTH - WRITE(ILUOUT,FMT=*) "LHORELAX_SVC2R2=",LHORELAX_SVC2R2 - WRITE(ILUOUT,FMT=*) "LHORELAX_SVC1R3=",LHORELAX_SVC1R3 - WRITE(ILUOUT,FMT=*) "LHORELAX_SVLIMA=",LHORELAX_SVLIMA - WRITE(ILUOUT,FMT=*) "LHORELAX_SVELEC=",LHORELAX_SVELEC - WRITE(ILUOUT,FMT=*) "LHORELAX_SVCHEM=",LHORELAX_SVCHEM - WRITE(ILUOUT,FMT=*) "LHORELAX_SVCHIC=",LHORELAX_SVCHIC - WRITE(ILUOUT,FMT=*) "LHORELAX_SVLG=",LHORELAX_SVLG - WRITE(ILUOUT,FMT=*) "LHORELAX_SVPP=",LHORELAX_SVPP -#ifdef MNH_FOREFIRE - WRITE(ILUOUT,FMT=*) "LHORELAX_SVFF=",LHORELAX_SVFF -#endif - WRITE(ILUOUT,FMT=*) "LHORELAX_SVCS=",LHORELAX_SVCS - WRITE(ILUOUT,FMT=*) "LHORELAX_SV=",LHORELAX_SV - WRITE(ILUOUT,FMT=*) "LHORELAX_RV=",LHORELAX_RV - WRITE(ILUOUT,FMT=*) "LHORELAX_RC=",LHORELAX_RC - WRITE(ILUOUT,FMT=*) "LHORELAX_RR=",LHORELAX_RR - WRITE(ILUOUT,FMT=*) "LHORELAX_RI=",LHORELAX_RI - WRITE(ILUOUT,FMT=*) "LHORELAX_RG=",LHORELAX_RG - WRITE(ILUOUT,FMT=*) "LHORELAX_RS=",LHORELAX_RS - WRITE(ILUOUT,FMT=*) "LHORELAX_RH=",LHORELAX_RH - WRITE(ILUOUT,FMT=*) "LHORELAX_TKE=", LHORELAX_TKE - WRITE(ILUOUT,FMT=*) "NRIMX=",NRIMX - WRITE(ILUOUT,FMT=*) "NRIMY=",NRIMY - WRITE(ILUOUT,FMT=*) "L2D=",L2D - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') -END IF -! -IF ((LHORELAX_UVWTH .OR. LHORELAX_SVPP .OR. & - LHORELAX_SVCS .OR. & -#ifdef MNH_FOREFIRE - LHORELAX_SVFF .OR. & -#endif - LHORELAX_SVC2R2 .OR. LHORELAX_SVC1R3 .OR. & - LHORELAX_SVLIMA .OR. & - LHORELAX_SVELEC .OR. LHORELAX_SVCHEM .OR. & - LHORELAX_SVLG .OR. ANY(LHORELAX_SV) .OR. & - LHORELAX_RV .OR. LHORELAX_RC .OR. & - LHORELAX_RR .OR. LHORELAX_RI .OR. & - LHORELAX_RG .OR. LHORELAX_RS .OR. & - LHORELAX_RH .OR. LHORELAX_TKE.OR. & - LHORELAX_SVCHIC ) & - .AND. (KMI /=1)) THEN - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE THE HORIZONTAL RELAXATION ' - WRITE(ILUOUT,FMT=*) 'FOR A NESTED MODEL BUT THE COUPLING IS ALREADY DONE' - WRITE(ILUOUT,FMT=*) 'BY THE GRID NESTING. CHANGE LHORELAX TO FALSE' - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') -END IF -! -IF ((LHORELAX_UVWTH .OR. LHORELAX_SVPP .OR. & - LHORELAX_SVCS .OR. & -#ifdef MNH_FOREFIRE - LHORELAX_SVFF .OR. & -#endif - LHORELAX_SVC2R2 .OR. LHORELAX_SVC1R3 .OR. & - LHORELAX_SVLIMA .OR. & - LHORELAX_SVELEC .OR. LHORELAX_SVCHEM .OR. & - LHORELAX_SVLG .OR. ANY(LHORELAX_SV) .OR. & - LHORELAX_RV .OR. LHORELAX_RC .OR. & - LHORELAX_RR .OR. LHORELAX_RI .OR. & - LHORELAX_RG .OR. LHORELAX_RS .OR. & - LHORELAX_RH .OR. LHORELAX_TKE.OR. & - LHORELAX_SVCHIC ) & - .AND. (CLBCX(1)=='CYCL'.OR.CLBCX(2)=='CYCL' & - .OR.CLBCY(1)=='CYCL'.OR.CLBCY(2)=='CYCL')) THEN - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE THE HORIZONTAL RELAXATION ' - WRITE(ILUOUT,FMT=*) 'FOR CYCLIC CLBCX OR CLBCY VALUES' - WRITE(ILUOUT,FMT=*) 'CHANGE LHORELAX TO FALSE' - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') -END IF -! -IF (KMI==1) THEN - GRELAX = .NOT.(OUSERV) .AND. LUSERV .AND. LHORELAX_RV -ELSE - GRELAX = .NOT.(LUSERV_G(NDAD(KMI))) .AND. LUSERV_G(KMI).AND. LHORELAX_RV -END IF -! -IF ( GRELAX ) THEN - LHORELAX_RV=.FALSE. - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RV FIELD' - WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI) - WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.' - WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RV=FALSE' -END IF -! -IF (KMI==1) THEN - GRELAX = .NOT.(OUSERC) .AND. LUSERC .AND. LHORELAX_RC -ELSE - GRELAX = .NOT.(LUSERC_G(NDAD(KMI))) .AND. LUSERC_G(KMI).AND. LHORELAX_RC -END IF -! -IF ( GRELAX ) THEN - LHORELAX_RC=.FALSE. - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RC FIELD' - WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI) - WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.' - WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RC=FALSE' -END IF -! -IF (KMI==1) THEN - GRELAX = .NOT.(OUSERR) .AND. LUSERR .AND. LHORELAX_RR -ELSE - GRELAX = .NOT.(LUSERR_G(NDAD(KMI))) .AND. LUSERR_G(KMI).AND. LHORELAX_RR -END IF -! -IF ( GRELAX ) THEN - LHORELAX_RR=.FALSE. - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RR FIELD' - WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI) - WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.' - WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RR=FALSE' -END IF -! -IF (KMI==1) THEN - GRELAX = .NOT.(OUSERI) .AND. LUSERI .AND. LHORELAX_RI -ELSE - GRELAX = .NOT.(LUSERI_G(NDAD(KMI))) .AND. LUSERI_G(KMI).AND. LHORELAX_RI -END IF -! -IF ( GRELAX ) THEN - LHORELAX_RI=.FALSE. - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RI FIELD' - WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI) - WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.' - WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RI=FALSE' -END IF -! -IF (KMI==1) THEN - GRELAX = .NOT.(OUSERG) .AND. LUSERG .AND. LHORELAX_RG -ELSE - GRELAX = .NOT.(LUSERG_G(NDAD(KMI))) .AND. LUSERG_G(KMI).AND. LHORELAX_RG -END IF -! -IF ( GRELAX ) THEN - LHORELAX_RG=.FALSE. - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RG FIELD' - WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI) - WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.' - WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RG=FALSE' -END IF -! -IF (KMI==1) THEN - GRELAX = .NOT.(OUSERH) .AND. LUSERH .AND. LHORELAX_RH -ELSE - GRELAX = .NOT.(LUSERH_G(NDAD(KMI))) .AND. LUSERH_G(KMI).AND. LHORELAX_RH -END IF -! -IF ( GRELAX ) THEN - LHORELAX_RH=.FALSE. - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RH FIELD' - WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI) - WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.' - WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RH=FALSE' -END IF -! -IF (KMI==1) THEN - GRELAX = .NOT.(OUSERS) .AND. LUSERS .AND. LHORELAX_RS -ELSE - GRELAX = .NOT.(LUSERS_G(NDAD(KMI))) .AND. LUSERS_G(KMI).AND. LHORELAX_RS -END IF -! -IF ( GRELAX ) THEN - LHORELAX_RS=.FALSE. - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE RS FIELD' - WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI) - WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.' - WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_RS=FALSE' -END IF -! -IF (KMI==1) THEN - GRELAX = HTURB=='NONE' .AND. LUSETKE(1).AND. LHORELAX_TKE -ELSE - GRELAX = .NOT.(LUSETKE(NDAD(KMI))) .AND. LUSETKE(KMI) .AND. LHORELAX_TKE -END IF -! -IF ( GRELAX ) THEN - LHORELAX_TKE=.FALSE. - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE TKE FIELD' - WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI) - WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.' - WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_TKE=FALSE' -END IF -! -! -DO JSV = 1,NSV_USER -! - IF (KMI==1) THEN - GRELAX = KSV_USER<JSV .AND. LUSESV(JSV,1).AND. LHORELAX_SV(JSV) - ELSE - GRELAX = .NOT.(LUSESV(JSV,NDAD(KMI))) .AND. LUSESV(JSV,KMI) .AND. LHORELAX_SV(JSV) - END IF - ! - IF ( GRELAX ) THEN - LHORELAX_SV(JSV)=.FALSE. - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO RELAX THE ',JSV,' SV FIELD' - WRITE(ILUOUT,FMT=*) 'TOWARDS THE LARGE SCALE FIELD OF MODEL',NDAD(KMI) - WRITE(ILUOUT,FMT=*) 'BUT IT DOES NOT EXIST.' - WRITE(ILUOUT,FMT=*) 'THEREFORE LHORELAX_SV(',JSV,')=FALSE' - END IF -END DO -! -!* 4.6 consistency in LES diagnostics choices -! -IF (CLES_NORM_TYPE=='EKMA' .AND. .NOT. LCORIO) THEN - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE THE EKMAN NORMALIZATION' - WRITE(ILUOUT,FMT=*) 'BUT CORIOLIS FORCE IS NOT USED (LCORIO=.FALSE.)' - WRITE(ILUOUT,FMT=*) 'THEN, NO NORMALIZATION IS PERFORMED' - CLES_NORM_TYPE='NONE' -END IF -! -!* 4.7 Check the coherence with LNUMDIFF -! -IF (L1D .AND. (LNUMDIFU .OR. LNUMDIFTH .OR. LNUMDIFSV) ) THEN - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE HORIZONTAL DIFFUSION ' - WRITE(ILUOUT,FMT=*) 'BUT YOU ARE IN A COLUMN MODEL (L1D=.TRUE.).' - WRITE(ILUOUT,FMT=*) 'THEREFORE LNUMDIFU and LNUMDIFTH and LNUMDIFSV' - WRITE(ILUOUT,FMT=*) 'ARE SET TO FALSE' - LNUMDIFU=.FALSE. - LNUMDIFTH=.FALSE. - LNUMDIFSV=.FALSE. -END IF -! -IF (.NOT. LNUMDIFTH .AND. LZDIFFU) THEN - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(ILUOUT,FMT=*) 'YOU DO NOT WANT TO USE HORIZONTAL DIFFUSION (LNUMDIFTH=F)' - WRITE(ILUOUT,FMT=*) 'BUT YOU WANT TO USE Z-NUMERICAL DIFFUSION ' - WRITE(ILUOUT,FMT=*) 'THEREFORE LNUMDIFTH IS SET TO TRUE' - LNUMDIFTH=.TRUE. -END IF -! -!* 4.8 Other -! -IF (XTNUDGING < 4.*XTSTEP) THEN - XTNUDGING = 4.*XTSTEP - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(UNIT=ILUOUT,FMT='("TIME SCALE FOR NUDGING CAN NOT BE SMALLER THAN", & - & " FOUR TIMES THE TIME STEP")') - WRITE(ILUOUT,FMT=*) 'XTNUDGING is SET TO ',XTNUDGING -END IF -! -! -IF (XWAY(KMI) == 3. ) THEN - XWAY(KMI) = 2. - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(UNIT=ILUOUT,FMT='("XWAY=3 DOES NOT EXIST ANYMORE; ", & - & " IT IS REPLACED BY XWAY=2 ")') -END IF -! -IF ( (KMI == 1) .AND. XWAY(KMI) /= 0. ) THEN - XWAY(KMI) = 0. - WRITE(UNIT=ILUOUT,FMT=9002) KMI - WRITE(UNIT=ILUOUT,FMT='("XWAY MUST BE EQUAL TO 0 FOR DAD MODEL")') -END IF -! -!JUANZ ZRESI solver need BSPLITTING -IF ( CPRESOPT == 'ZRESI' .AND. CSPLIT /= 'BSPLITTING' ) THEN - WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(UNIT=ILUOUT,FMT='("Paralleliez in Z solver CPRESOPT=ZRESI need also CSPLIT=BSPLITTING ")') - WRITE(ILUOUT,FMT=*) ' ERROR you have to set also CSPLIT=BSPLITTING ' - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') -END IF -! -IF ( LEN_TRIM(HINIFILEPGD)>0 ) THEN - IF ( CINIFILEPGD/=HINIFILEPGD ) THEN - WRITE(UNIT=ILUOUT,FMT=9001) KMI - WRITE(ILUOUT,FMT=*) ' ERROR : in EXSEG1.nam, in NAM_LUNITn you have CINIFILEPGD= ',CINIFILEPGD - WRITE(ILUOUT,FMT=*) ' whereas in .des you have CINIFILEPGD= ',HINIFILEPGD - WRITE(ILUOUT,FMT=*) ' Please check your Namelist ' - WRITE(ILUOUT,FMT=*) ' For example, you may have specified the un-nested PGD file instead of the nested PGD file ' - WRITE(ILUOUT,FMT=*) - WRITE(ILUOUT,FMT=*) '###############' - WRITE(ILUOUT,FMT=*) ' MESONH ABORTS' - WRITE(ILUOUT,FMT=*) '###############' - WRITE(ILUOUT,FMT=*) - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') - END IF -ELSE - CINIFILEPGD = '' -!* note that after a spawning, there is no value for CINIFILEPGD in the .des file, -! so the checking cannot be made if the user starts a simulation directly from -! a spawned file (without the prep_real_case stage) -END IF -!------------------------------------------------------------------------------- -! -!* 5. WE DO NOT FORGET TO UPDATE ALL DOLLARN NAMELIST VARIABLES -! --------------------------------------------------------- -! -CALL UPDATE_NAM_LUNITN -CALL UPDATE_NAM_CONFN -CALL UPDATE_NAM_DRAGTREEN -CALL UPDATE_NAM_DRAGBLDGN -CALL UPDATE_NAM_DYNN -CALL UPDATE_NAM_ADVN -CALL UPDATE_NAM_PARAMN -CALL UPDATE_NAM_PARAM_RADN -#ifdef MNH_ECRAD -CALL UPDATE_NAM_PARAM_ECRADN -#endif -CALL UPDATE_NAM_PARAM_KAFRN -CALL UPDATE_NAM_PARAM_MFSHALLN -CALL UPDATE_NAM_LBCN -CALL UPDATE_NAM_NUDGINGN -CALL UPDATE_NAM_TURBN -CALL UPDATE_NAM_BLANKN -CALL UPDATE_NAM_CH_MNHCN -CALL UPDATE_NAM_CH_SOLVERN -CALL UPDATE_NAM_SERIESN -CALL UPDATE_NAM_BLOWSNOWN -CALL UPDATE_NAM_STATIONn -!------------------------------------------------------------------------------- -WRITE(UNIT=ILUOUT,FMT='(/)') -!------------------------------------------------------------------------------- -! -!* 6. FORMATS -! ------- -! -9000 FORMAT(/,'NOTE IN READ_EXSEG FOR MODEL ', I2, ' : ',/, & - '--------------------------------') -9001 FORMAT(/,'CAUTION ERROR IN READ_EXSEG FOR MODEL ', I2,' : ',/, & - '----------------------------------------' ) -9002 FORMAT(/,'WARNING IN READ_EXSEG FOR MODEL ', I2,' : ',/, & - '----------------------------------' ) -9003 FORMAT(/,'FATAL ERROR IN READ_EXSEG FOR MODEL ', I2,' : ',/, & - '--------------------------------------' ) -! -!------------------------------------------------------------------------------- -! -END SUBROUTINE READ_EXSEG_n diff --git a/src/ICCARE_BASE/read_field.f90 b/src/ICCARE_BASE/read_field.f90 deleted file mode 100644 index f7ccb114e..000000000 --- a/src/ICCARE_BASE/read_field.f90 +++ /dev/null @@ -1,1963 +0,0 @@ -!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!----------------------------------------------------------------- -! ###################### - MODULE MODI_READ_FIELD -! ###################### -! -INTERFACE -! - SUBROUTINE READ_FIELD(KOCEMI,TPINIFILE,KIU,KJU,KKU, & - HGETTKET,HGETRVT,HGETRCT,HGETRRT,HGETRIT,HGETCIT,HGETZWS, & - HGETRST,HGETRGT,HGETRHT,HGETSVT,HGETSRCT,HGETSIGS,HGETCLDFR, & - HGETBL_DEPTH,HGETSBL_DEPTH,HGETPHC,HGETPHR,HUVW_ADV_SCHEME, & - HTEMP_SCHEME,KSIZELBX_ll,KSIZELBXU_ll,KSIZELBY_ll,KSIZELBYV_ll, & - KSIZELBXTKE_ll,KSIZELBYTKE_ll, & - KSIZELBXR_ll,KSIZELBYR_ll,KSIZELBXSV_ll,KSIZELBYSV_ll, & - PUM,PVM,PWM,PDUM,PDVM,PDWM, & - PUT,PVT,PWT,PTHT,PPABST,PTKET,PRTKEMS, & - PRT,PSVT,PZWS,PCIT,PDRYMASST,PDRYMASSS, & - PSIGS,PSRCT,PCLDFR,PBL_DEPTH,PSBL_DEPTH,PWTHVMF,PPHC,PPHR, & - PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM, PLSZWSM, & - PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, & - PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, & - KFRC,TPDTFRC,PUFRC,PVFRC,PWFRC,PTHFRC,PRVFRC, & - PTENDTHFRC,PTENDRVFRC,PGXTHFRC,PGYTHFRC,PPGROUNDFRC,PATC, & - PTENDUFRC,PTENDVFRC, & - KADVFRC,TPDTADVFRC,PDTHFRC,PDRVFRC, & - KRELFRC,TPDTRELFRC, PTHREL, PRVREL, & - PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLUX_M, & - PRUS_PRES,PRVS_PRES,PRWS_PRES,PRTHS_CLD,PRRS_CLD,PRSVS_CLD, & - PIBM_LSF,PIBM_XMUT,PUMEANW,PVMEANW,PWMEANW,PUMEANN,PVMEANN, & - PWMEANN,PUMEANE,PVMEANE,PWMEANE,PUMEANS,PVMEANS,PWMEANS ) -! -USE MODD_IO, ONLY : TFILEDATA -USE MODD_TIME ! for type DATE_TIME -! -! -INTEGER, INTENT(IN) :: KOCEMI !Ocan model index -TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE !Initial file -INTEGER, INTENT(IN) :: KIU, KJU, KKU - ! array sizes in x, y and z directions -! -CHARACTER (LEN=*), INTENT(IN) :: HGETTKET, & - HGETRVT,HGETRCT,HGETRRT, & - HGETRIT,HGETRST,HGETRGT,HGETRHT, & - HGETCIT,HGETSRCT, HGETZWS, & - HGETSIGS,HGETCLDFR,HGETBL_DEPTH, & - HGETSBL_DEPTH,HGETPHC,HGETPHR -CHARACTER (LEN=*), DIMENSION(:),INTENT(IN) :: HGETSVT -! -! GET indicators to know wether a given variable should or not be read in the -! FM file at time t-deltat and t -CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME ! advection scheme for wind -CHARACTER(LEN=4), INTENT(IN) :: HTEMP_SCHEME ! advection scheme for wind -! -! sizes of the West-east total LB area -INTEGER, INTENT(IN) :: KSIZELBX_ll,KSIZELBXU_ll ! for T,V,W and u -INTEGER, INTENT(IN) :: KSIZELBXTKE_ll ! for TKE -INTEGER, INTENT(IN) :: KSIZELBXR_ll,KSIZELBXSV_ll ! for Rx and SV -! sizes of the North-south total LB area -INTEGER, INTENT(IN) :: KSIZELBY_ll,KSIZELBYV_ll ! for T,U,W and v -INTEGER, INTENT(IN) :: KSIZELBYTKE_ll ! for TKE -INTEGER, INTENT(IN) :: KSIZELBYR_ll,KSIZELBYSV_ll ! for Rx and SV -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PUM,PVM,PWM ! U,V,W at t-dt -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDUM,PDVM,PDWM ! Difference on U,V,W - ! between t+dt and t-dt -REAL, DIMENSION(:,:), INTENT(OUT) :: PBL_DEPTH ! BL depth -REAL, DIMENSION(:,:), INTENT(OUT) :: PSBL_DEPTH ! SBL depth -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTHVMF ! MassFlux buoyancy flux -! -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PUT,PVT,PWT ! U,V,W at t -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHT,PTKET ! theta, tke and -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRTKEMS ! tke adv source -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPABST ! pressure at t -REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PRT,PSVT ! moist and scalar - ! variables at t -REAL, DIMENSION(:,:), INTENT(INOUT) :: PZWS -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCT ! turbulent flux - ! <s'Rc'> at t -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCIT ! ice conc. at t -REAL, INTENT(OUT) :: PDRYMASST ! Md(t) -REAL, INTENT(OUT) :: PDRYMASSS ! d Md(t) / dt -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS ! =sqrt(<s's'>) for the - ! Subgrid Condensation -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! cloud fraction -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPHC ! pH value in cloud water -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPHR ! pH value in rainwater -! Larger Scale fields -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSUM,PLSVM,PLSWM ! Wind -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSTHM, PLSRVM ! Mass -! LB fields -REAL, DIMENSION(:,:), INTENT(OUT) :: PLSZWSM ! significant height of sea waves -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXUM,PLBXVM,PLBXWM ! Wind -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXTHM ! Mass -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYUM,PLBYVM,PLBYWM ! Wind -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYTHM ! Mass -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXTKEM ! TKE -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYTKEM -REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PLBXRM ,PLBXSVM ! Moisture and SV -REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PLBYRM ,PLBYSVM ! in x and y-dir. -! Forcing fields -INTEGER, INTENT(IN) :: KFRC ! number of forcing -TYPE (DATE_TIME), DIMENSION(:), INTENT(OUT) :: TPDTFRC ! date of forcing profs. -REAL, DIMENSION(:,:), INTENT(OUT) :: PUFRC,PVFRC,PWFRC ! forcing variables -REAL, DIMENSION(:,:), INTENT(OUT) :: PTHFRC,PRVFRC -REAL, DIMENSION(:,:), INTENT(OUT) :: PTENDUFRC,PTENDVFRC -REAL, DIMENSION(:,:), INTENT(OUT) :: PTENDTHFRC,PTENDRVFRC,PGXTHFRC,PGYTHFRC -REAL, DIMENSION(:), INTENT(OUT) :: PPGROUNDFRC -REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PATC -INTEGER, INTENT(IN) :: KADVFRC ! number of forcing -TYPE (DATE_TIME), DIMENSION(:), INTENT(OUT) :: TPDTADVFRC ! date of forcing profs. -REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PDTHFRC, PDRVFRC -INTEGER, INTENT(IN) :: KRELFRC ! number of forcing -TYPE (DATE_TIME), DIMENSION(:), INTENT(OUT) :: TPDTRELFRC ! date of forcing profs. -REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PTHREL, PRVREL -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLUX_M ! Eddy fluxes -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS_PRES, PRVS_PRES, PRWS_PRES -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS_CLD -REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS_CLD, PRSVS_CLD -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PIBM_LSF,PIBM_XMUT -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANW,PVMEANW,PWMEANW -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANN,PVMEANN,PWMEANN -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANE,PVMEANE,PWMEANE -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANS,PVMEANS,PWMEANS -! -! -END SUBROUTINE READ_FIELD -! -END INTERFACE -! -END MODULE MODI_READ_FIELD -! -! ######################################################################## - SUBROUTINE READ_FIELD(KOCEMI,TPINIFILE,KIU,KJU,KKU, & - HGETTKET,HGETRVT,HGETRCT,HGETRRT,HGETRIT,HGETCIT,HGETZWS, & - HGETRST,HGETRGT,HGETRHT,HGETSVT,HGETSRCT,HGETSIGS,HGETCLDFR, & - HGETBL_DEPTH,HGETSBL_DEPTH,HGETPHC,HGETPHR,HUVW_ADV_SCHEME, & - HTEMP_SCHEME,KSIZELBX_ll,KSIZELBXU_ll,KSIZELBY_ll,KSIZELBYV_ll, & - KSIZELBXTKE_ll,KSIZELBYTKE_ll, & - KSIZELBXR_ll,KSIZELBYR_ll,KSIZELBXSV_ll,KSIZELBYSV_ll, & - PUM,PVM,PWM,PDUM,PDVM,PDWM, & - PUT,PVT,PWT,PTHT,PPABST,PTKET,PRTKEMS, & - PRT,PSVT,PZWS,PCIT,PDRYMASST,PDRYMASSS, & - PSIGS,PSRCT,PCLDFR,PBL_DEPTH,PSBL_DEPTH,PWTHVMF,PPHC,PPHR, & - PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM,PLSZWSM, & - PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, & - PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, & - KFRC,TPDTFRC,PUFRC,PVFRC,PWFRC,PTHFRC,PRVFRC, & - PTENDTHFRC,PTENDRVFRC,PGXTHFRC,PGYTHFRC,PPGROUNDFRC,PATC, & - PTENDUFRC,PTENDVFRC, & - KADVFRC,TPDTADVFRC,PDTHFRC,PDRVFRC, & - KRELFRC,TPDTRELFRC, PTHREL, PRVREL, & - PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLUX_M, & - PRUS_PRES,PRVS_PRES,PRWS_PRES,PRTHS_CLD,PRRS_CLD,PRSVS_CLD, & - PIBM_LSF,PIBM_XMUT,PUMEANW,PVMEANW,PWMEANW,PUMEANN,PVMEANN, & - PWMEANN,PUMEANE,PVMEANE,PWMEANE,PUMEANS,PVMEANS,PWMEANS ) -! ######################################################################## -! -!!**** *READ_FIELD* - routine to read prognostic and surface fields -!! -!! PURPOSE -!! ------- -! The purpose of this routine is to initialize prognostic and -! surface fields by reading their value in initial file or by setting -! them to a fixed value. -! -!!** METHOD -!! ------ -!! According to the get indicators, the prognostics fields are : -!! - initialized by reading their value in the LFIFM file -!! if the corresponding indicators are equal to 'READ' -!! - initialized to zero if the corresponding indicators -!! are equal to 'INIT' -!! - not initialized if their corresponding indicators -!! are equal to 'SKIP' -!! -!! In case of time step change, all fields at t-dt are (linearly) -!! interpolated to get a consistant initial state before the segment -!! integration -!! -!! EXTERNAL -!! -------- -!! FMREAD : to read data in LFIFM file -!! INI_LS : to initialize larger scale fields -!! INI_LB : to initialize "2D" surfacic LB fields -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! Module MODD_CONF : NVERB,CCONF,CPROGRAM -!! -!! Module MODD_CTURB : XTKEMIN -!! -!! REFERENCE -!! --------- -!! Book2 of the documentation (routine READ_FIELD) -!! -!! -!! AUTHOR -!! ------ -!! V. Ducrocq * Meteo France * -!! -!! MODIFICATIONS -!! ------------- -!! Original 15/06/94 -!! modification 22/11/94 add the pressure function (J.Stein) -!! modification 22/11/94 add the LS fields (J.Stein) -!! modification 06/01/95 add Md(t) (J.P.Lafore) -!! 26/03/95 add EPS var (J. Cuxart) -!! 30/06/95 add var related to the Subgrid condensation -!! (J.Stein) -!! 18/08/95 time step change case (J.P.Lafore) -!! 01/03/96 add the cloud fraction (J. Stein) -!! modification 13/12/95 add fmread of the forcing variables -!! (M.Georgelin) -!! modification 13/02/96 external control of the forcing (J.-P. Pinty) -!! 11/04/96 add the ice concentration (J.-P. Pinty) -!! 27/01/97 read ISVR 3D fields of SV (J.-P. Pinty) -!! 26/02/97 "surfacic" LS fieds introduction (J.P.Lafore) -!! (V MASSON) 03/03/97 positivity control for time step change -!! 10/04/97 proper treatment of minima for LS-fields (J.P.Lafore) -!! J. Stein 22/06/97 use the absolute pressure -!! J. Stein 22/10/97 cleaning + add the LB fields for u,v,w,theta,Rv -!! P. Bechtold 22/01/98 add SST and surface pressure forcing -!! V. Ducrocq 14/08/98 //, remove KIINF,KJINF,KISUP,KJSUP, -!! and introduce INI_LS and INI_LB -!! J. Stein 22/01/99 add the reading of STORAGE_TYPE to improve -!! the START case when the file contains 2 -!! instants MT -!! D. Gazen 22/01/01 use MODD_NSV to handle NSV floating indices -!! for the current model -!! V. Masson 01/2004 removes surface (externalization) -!! J.-P. Pinty 06/05/04 treat NSV_* for C1R3 and ELEC -!! 05/06 Remove EPS -!! M. Leriche 04/10 add pH in cloud water and rainwater -!! M. Leriche 07/10 treat NSV_* for ice phase chemical species -!! C.Lac 11/11 Suppress all the t-Dt fields -!! M.Tomasini, -!! P. Peyrille 06/12 2D west african monsoon : add reading of ADV forcing and addy fluxes -!! C.Lac 03/13 add prognostic supersaturation for C2R2/KHKO -!! Bosseur & Filippi 07/13 Adds Forefire -!! M. Leriche 11/14 correct bug in pH initialization -!! C.Lac 12/14 correction for reproducibility START/RESTA -!! Modification 01/2016 (JP Pinty) Add LIMA -!! M. Leriche 02/16 treat gas and aq. chemicals separately -!! C.Lac 10/16 CEN4TH with RKC4 + Correction on RK loop -!! 09/2017 Q.Rodier add LTEND_UV_FRC -!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O -!! V. Vionnet 07/17 add blowing snow scheme -!! P. Wautelet 01/2019 corrected intent of PDUM,PDVM,PDWM (OUT->INOUT) -! P. Wautelet 13/02/2019: removed PPABSM and PTSTEP dummy arguments (bugfix: PPABSM was intent(OUT)) -!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes -! P. Wautelet 14/03/2019: correct ZWS when variable not present in file -! M. Leriche 10/06/2019: in restart case read all immersion modes for LIMA -!! B. Vie 06/2020: Add prognostic supersaturation for LIMA -!! F. Auguste 02/2021: add fields necessary for IBM -!! T. Nagel 02/2021: add fields necessary for turbulence recycling -!! J.L. Redelsperger 03/2021: add necessary variables for Ocean LES case -!!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_2D_FRC -USE MODD_ADV_n -USE MODD_BLOWSNOW -USE MODD_BLOWSNOW_n -USE MODD_CH_AEROSOL -USE MODD_CH_M9_n, ONLY: CNAMES, CICNAMES -USE MODD_CONF -USE MODD_CONF_n -USE MODD_CST -USE MODD_CTURB -USE MODD_DUST -USE MODD_DYN_n, ONLY: LOCEAN -USE MODD_ELEC_DESCR, ONLY: CELECNAMES -use modd_field, only: tfielddata, tfieldlist, TYPEDATE, TYPEREAL,TYPELOG,TYPEINT -USE MODD_FIELD_n, only: XZWS_DEFAULT -#ifdef MNH_FOREFIRE -USE MODD_FOREFIRE -#endif -USE MODD_IBM_PARAM_n, ONLY: LIBM -USE MODD_ICE_C1R3_DESCR, ONLY: C1R3NAMES -USE MODD_IO, ONLY: TFILEDATA -USE MODD_LATZ_EDFLX -USE MODD_LG, ONLY: CLGNAMES -USE MODD_LUNIT_N, ONLY: TLUOUT -USE MODD_NSV -USE MODD_OCEANH -USE MODD_PARAM_C2R2, ONLY: LSUPSAT -! -USE MODD_PARAM_LIMA , ONLY: NMOD_CCN, LSCAV, LAERO_MASS, & - NMOD_IFN, NMOD_IMM, NINDICE_CCN_IMM, LHHONI -USE MODD_PARAM_LIMA_COLD, ONLY: CLIMA_COLD_NAMES -USE MODD_PARAM_LIMA_WARM, ONLY: CLIMA_WARM_NAMES, CAERO_MASS -USE MODD_PARAM_n, ONLY: CSCONV -USE MODD_PASPOL -USE MODD_RAIN_C2R2_DESCR, ONLY: C2R2NAMES -USE MODD_RECYCL_PARAM_n -USE MODD_REF, ONLY: LCOUPLES -USE MODD_SALT -USE MODD_TIME ! for type DATE_TIME -! -use mode_field, only: Find_field_id_from_mnhname -USE MODE_IO_FIELD_READ, only: IO_Field_read -USE MODE_MSG -USE MODE_TOOLS, ONLY: UPCASE -! -USE MODI_INI_LB -USE MODI_INI_LS -! -IMPLICIT NONE -! -!* 0.1 declarations of arguments -! -! -! -INTEGER, INTENT(IN) :: KOCEMI !Ocan model index -TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE !Initial file -INTEGER, INTENT(IN) :: KIU, KJU, KKU - ! array sizes in x, y and z directions -! -CHARACTER (LEN=*), INTENT(IN) :: HGETTKET, & - HGETRVT,HGETRCT,HGETRRT, & - HGETRIT,HGETRST,HGETRGT,HGETRHT, & - HGETCIT,HGETSRCT,HGETZWS, & - HGETSIGS,HGETCLDFR,HGETBL_DEPTH, & - HGETSBL_DEPTH,HGETPHC,HGETPHR -CHARACTER (LEN=*), DIMENSION(:),INTENT(IN) :: HGETSVT -! -! GET indicators to know wether a given variable should or not be read in the -! FM file at time t-deltat and t -! -CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME ! advection scheme for wind -CHARACTER(LEN=4), INTENT(IN) :: HTEMP_SCHEME ! advection scheme for wind -! -! sizes of the West-east total LB area -INTEGER, INTENT(IN) :: KSIZELBX_ll,KSIZELBXU_ll ! for T,V,W and u -INTEGER, INTENT(IN) :: KSIZELBXTKE_ll ! for TKE -INTEGER, INTENT(IN) :: KSIZELBXR_ll,KSIZELBXSV_ll ! for Rx and SV -! sizes of the North-south total LB area -INTEGER, INTENT(IN) :: KSIZELBY_ll,KSIZELBYV_ll ! for T,U,W and v -INTEGER, INTENT(IN) :: KSIZELBYTKE_ll ! for TKE -INTEGER, INTENT(IN) :: KSIZELBYR_ll,KSIZELBYSV_ll ! for Rx and SV -! -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PUM,PVM,PWM ! U,V,W at t-dt -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDUM,PDVM,PDWM ! Difference on U,V,W - ! between t+dt and t-dt -REAL, DIMENSION(:,:), INTENT(OUT) :: PBL_DEPTH ! BL depth -REAL, DIMENSION(:,:), INTENT(OUT) :: PSBL_DEPTH ! SBL depth -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTHVMF ! MassFlux buoyancy flux -! -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PUT,PVT,PWT ! U,V,W at t -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTHT,PTKET ! theta, tke and -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRTKEMS ! tke adv source -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPABST ! pressure at t -REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PRT,PSVT ! moist and scalar - ! variables at t -REAL, DIMENSION(:,:), INTENT(INOUT) :: PZWS -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCT ! turbulent flux - ! <s'Rc'> at t -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCIT ! ice conc. at t -REAL, INTENT(OUT) :: PDRYMASST ! Md(t) -REAL, INTENT(OUT) :: PDRYMASSS ! d Md(t) / dt -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS ! =sqrt(<s's'>) for the - ! Subgrid Condensation -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! cloud fraction -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPHC ! pH value in cloud water -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PPHR ! pH value in rainwater -! -! -! Larger Scale fields -REAL, DIMENSION(:,:), INTENT(OUT) :: PLSZWSM ! significant height of sea waves -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSUM,PLSVM,PLSWM ! Wind -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLSTHM, PLSRVM ! Mass -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXUM,PLBXVM,PLBXWM ! Wind -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXTHM ! Mass -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYUM,PLBYVM,PLBYWM ! Wind -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYTHM ! Mass -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBXTKEM ! TKE -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLBYTKEM -REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PLBXRM ,PLBXSVM ! Moisture and SV -REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PLBYRM ,PLBYSVM ! in x and y-dir. -! -! -! Forcing fields -INTEGER, INTENT(IN) :: KFRC ! number of forcing -TYPE (DATE_TIME), DIMENSION(:), INTENT(OUT) :: TPDTFRC ! date of forcing profs. -REAL, DIMENSION(:,:), INTENT(OUT) :: PUFRC,PVFRC,PWFRC ! forcing variables -REAL, DIMENSION(:,:), INTENT(OUT) :: PTHFRC,PRVFRC -REAL, DIMENSION(:,:), INTENT(OUT) :: PTENDUFRC,PTENDVFRC -REAL, DIMENSION(:,:), INTENT(OUT) :: PTENDTHFRC,PTENDRVFRC,PGXTHFRC,PGYTHFRC -REAL, DIMENSION(:), INTENT(OUT) :: PPGROUNDFRC -REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PATC -INTEGER, INTENT(IN) :: KADVFRC ! number of forcing -TYPE (DATE_TIME), DIMENSION(:), INTENT(OUT) :: TPDTADVFRC ! date of forcing profs. -REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PDTHFRC, PDRVFRC -INTEGER, INTENT(IN) :: KRELFRC ! number of forcing -TYPE (DATE_TIME), DIMENSION(:), INTENT(OUT) :: TPDTRELFRC ! date of forcing profs. -REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PTHREL, PRVREL -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLUX_M ! Eddy fluxes -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS_PRES, PRVS_PRES, PRWS_PRES -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS_CLD -REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS_CLD, PRSVS_CLD -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PIBM_LSF ! LSF for IBM -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PIBM_XMUT ! Turbulent viscosity -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANW,PVMEANW,PWMEANW ! Velocity average at West boundary -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANN,PVMEANN,PWMEANN ! Velocity average at North boundary -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANE,PVMEANE,PWMEANE ! Velocity average at East boundary -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANS,PVMEANS,PWMEANS ! Velocity average at South boundary -! -!* 0.2 declarations of local variables -! -INTEGER :: IID -INTEGER :: ILUOUT ! Unit number for prints -INTEGER :: IRESP -INTEGER :: ISV ! total number of scalar variables -INTEGER :: JSV ! Loop index for additional scalar variables -INTEGER :: JKLOOP,JRR ! Loop indexes -INTEGER :: IIUP,IJUP ! size of working window arrays -INTEGER :: JT ! loop index -LOGICAL :: GLSOURCE ! switch for the source term (for ini_ls and ini_lb) -LOGICAL :: ZLRECYCL ! switch if turbulence recycling is activated -CHARACTER(LEN=2) :: INDICE -CHARACTER(LEN=3) :: YFRC ! To mark the different forcing dates -CHARACTER(LEN=15) :: YVAL -REAL, DIMENSION(KIU,KJU,KKU) :: ZWORK ! to compute supersaturation -TYPE(TFIELDDATA) :: TZFIELD -! -!------------------------------------------------------------------------------- -! -!* 1. INITIALIZATION -! --------------- -! -GLSOURCE=.FALSE. -ZWORK = 0.0 -! -!------------------------------------------------------------------------------- -! -!* 2. READ PROGNOSTIC VARIABLES -! ------------------------- -! -!* 2.1 Time t: -! -IF (TPINIFILE%NMNHVERSION(1)<5) THEN - CALL FIND_FIELD_ID_FROM_MNHNAME('UT',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CMNHNAME = 'UM' - CALL IO_Field_read(TPINIFILE,TZFIELD,PUT) - ! - CALL FIND_FIELD_ID_FROM_MNHNAME('VT',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CMNHNAME = 'VM' - CALL IO_Field_read(TPINIFILE,TZFIELD,PVT) - ! - CALL FIND_FIELD_ID_FROM_MNHNAME('WT',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CMNHNAME = 'WM' - CALL IO_Field_read(TPINIFILE,TZFIELD,PWT) - ! - CALL FIND_FIELD_ID_FROM_MNHNAME('THT',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CMNHNAME = 'THM' - CALL IO_Field_read(TPINIFILE,TZFIELD,PTHT) - ! - CALL FIND_FIELD_ID_FROM_MNHNAME('PABST',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CMNHNAME = 'PABSM' - CALL IO_Field_read(TPINIFILE,TZFIELD,PPABST) -ELSE - CALL IO_Field_read(TPINIFILE,'UT',PUT) - CALL IO_Field_read(TPINIFILE,'VT',PVT) - CALL IO_Field_read(TPINIFILE,'WT',PWT) - CALL IO_Field_read(TPINIFILE,'THT',PTHT) - CALL IO_Field_read(TPINIFILE,'PABST',PPABST) -ENDIF -! -SELECT CASE(HGETTKET) - CASE('READ') - IF (TPINIFILE%NMNHVERSION(1)<5) THEN - CALL FIND_FIELD_ID_FROM_MNHNAME('TKET',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CMNHNAME = 'TKEM' - CALL IO_Field_read(TPINIFILE,TZFIELD,PTKET) - ELSE - CALL IO_Field_read(TPINIFILE,'TKET',PTKET) - END IF - IF ( ( (TPINIFILE%NMNHVERSION(1)==5 .AND. TPINIFILE%NMNHVERSION(2)>0) .OR. TPINIFILE%NMNHVERSION(1)>5 ) & - .AND. (CCONF == 'RESTA') .AND. LSPLIT_CFL) THEN - CALL IO_Field_read(TPINIFILE,'TKEMS',PRTKEMS) - END IF - CASE('INIT') - PTKET(:,:,:) = XTKEMIN - PRTKEMS(:,:,:) = 0. -END SELECT -! -SELECT CASE(HGETZWS) - CASE('READ') - CALL IO_Field_read(TPINIFILE,'ZWS',PZWS,IRESP) - !If the field ZWS is not in the file, set its value to XZWS_DEFAULT - !ZWS is present in files since MesoNH 5.4.2 - IF ( IRESP/=0 ) THEN - WRITE (YVAL,'( E15.8 )') XZWS_DEFAULT - CALL PRINT_MSG(NVERB_WARNING,'IO','READ_FIELD','ZWS not found in file: using default value: '//TRIM(YVAL)//' m') - PZWS(:,:) = XZWS_DEFAULT - END IF - - CASE('INIT') - PZWS(:,:)=0. -END SELECT -! -SELECT CASE(HGETRVT) ! vapor - CASE('READ') - IF (TPINIFILE%NMNHVERSION(1)<5) THEN - CALL FIND_FIELD_ID_FROM_MNHNAME('RVT',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CMNHNAME = 'RVM' - CALL IO_Field_read(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RVT)) - ELSE - CALL IO_Field_read(TPINIFILE,'RVT',PRT(:,:,:,IDX_RVT)) - END IF - CASE('INIT') - PRT(:,:,:,IDX_RVT) = 0. -END SELECT -! -SELECT CASE(HGETRCT) ! cloud - CASE('READ') - IF (TPINIFILE%NMNHVERSION(1)<5) THEN - CALL FIND_FIELD_ID_FROM_MNHNAME('RCT',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CMNHNAME = 'RCM' - CALL IO_Field_read(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RCT)) - ELSE - CALL IO_Field_read(TPINIFILE,'RCT',PRT(:,:,:,IDX_RCT)) - END IF - CASE('INIT') - PRT(:,:,:,IDX_RCT) = 0. -END SELECT -! -SELECT CASE(HGETRRT) ! rain - CASE('READ') - IF (TPINIFILE%NMNHVERSION(1)<5) THEN - CALL FIND_FIELD_ID_FROM_MNHNAME('RRT',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CMNHNAME = 'RRM' - CALL IO_Field_read(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RRT)) - ELSE - CALL IO_Field_read(TPINIFILE,'RRT',PRT(:,:,:,IDX_RRT)) - END IF - CASE('INIT') - PRT(:,:,:,IDX_RRT) = 0. -END SELECT -! -SELECT CASE(HGETRIT) ! cloud ice - CASE('READ') - IF (TPINIFILE%NMNHVERSION(1)<5) THEN - CALL FIND_FIELD_ID_FROM_MNHNAME('RIT',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CMNHNAME = 'RIM' - CALL IO_Field_read(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RIT)) - ELSE - CALL IO_Field_read(TPINIFILE,'RIT',PRT(:,:,:,IDX_RIT)) - END IF - CASE('INIT') - PRT(:,:,:,IDX_RIT) = 0. -END SELECT -! -SELECT CASE(HGETRST) ! snow - CASE('READ') - IF (TPINIFILE%NMNHVERSION(1)<5) THEN - CALL FIND_FIELD_ID_FROM_MNHNAME('RST',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CMNHNAME = 'RSM' - CALL IO_Field_read(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RST)) - ELSE - CALL IO_Field_read(TPINIFILE,'RST',PRT(:,:,:,IDX_RST)) - END IF - CASE('INIT') - PRT(:,:,:,IDX_RST) = 0. -END SELECT -! -SELECT CASE(HGETRGT) ! graupel - CASE('READ') - IF (TPINIFILE%NMNHVERSION(1)<5) THEN - CALL FIND_FIELD_ID_FROM_MNHNAME('RGT',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CMNHNAME = 'RGM' - CALL IO_Field_read(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RGT)) - ELSE - CALL IO_Field_read(TPINIFILE,'RGT',PRT(:,:,:,IDX_RGT)) - END IF - CASE('INIT') - PRT(:,:,:,IDX_RGT) = 0. -END SELECT -! -SELECT CASE(HGETRHT) ! hail - CASE('READ') - IF (TPINIFILE%NMNHVERSION(1)<5) THEN - CALL FIND_FIELD_ID_FROM_MNHNAME('RHT',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CMNHNAME = 'RHM' - CALL IO_Field_read(TPINIFILE,TZFIELD,PRT(:,:,:,IDX_RHT)) - ELSE - CALL IO_Field_read(TPINIFILE,'RHT',PRT(:,:,:,IDX_RHT)) - END IF - CASE('INIT') - PRT(:,:,:,IDX_RHT) = 0. -END SELECT -! -SELECT CASE(HGETCIT) ! ice concentration - CASE('READ') - IF (SIZE(PCIT) /= 0 ) CALL IO_Field_read(TPINIFILE,'CIT',PCIT) - CASE('INIT') - PCIT(:,:,:)=0. -END SELECT -! -IF (LIBM .AND. CPROGRAM=='MESONH') THEN - ! - TZFIELD%CMNHNAME = 'LSFP' - TZFIELD%CLONGNAME = 'LSFP' - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - CALL IO_Field_read(TPINIFILE,TZFIELD,PIBM_LSF) - ! - TZFIELD%CMNHNAME = 'XMUT' - TZFIELD%CLONGNAME = 'XMUT' - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm2 s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - CALL IO_Field_read(TPINIFILE,TZFIELD,PIBM_XMUT) - ! -ENDIF -! -TZFIELD%CMNHNAME = 'RECYCLING' -TZFIELD%CLONGNAME = 'RECYCLING' -TZFIELD%CSTDNAME = '' -TZFIELD%CUNITS = '' -TZFIELD%CDIR = '--' -TZFIELD%NGRID = 1 -TZFIELD%NTYPE = TYPELOG -TZFIELD%NDIMS = 0 -TZFIELD%LTIMEDEP = .FALSE. -CALL IO_Field_read(TPINIFILE,TZFIELD,ZLRECYCL,IRESP) -!If field not found (file from older version of MesoNH) => set ZLRECYCL to false -IF ( IRESP /= 0 ) ZLRECYCL = .FALSE. - -IF (ZLRECYCL) THEN - ! - TZFIELD%CMNHNAME = 'RCOUNT' - TZFIELD%CLONGNAME = 'RCOUNT' - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = '' - TZFIELD%CDIR = '--' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEINT - TZFIELD%NDIMS = 0 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_read(TPINIFILE,TZFIELD,NR_COUNT) - ! - IF (NR_COUNT .NE. 0) THEN - IF (LRECYCLW) THEN - TZFIELD%CMNHNAME = 'URECYCLW' - TZFIELD%CLONGNAME = 'URECYCLW' - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 2 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_read(TPINIFILE,TZFIELD,PUMEANW) - ! - TZFIELD%CMNHNAME = 'VRECYCLW' - TZFIELD%CLONGNAME = 'VRECYCLW' - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 3 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_read(TPINIFILE,TZFIELD,PVMEANW) - ! - TZFIELD%CMNHNAME = 'WRECYCLW' - TZFIELD%CLONGNAME = 'WRECYCLW' - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 4 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_read(TPINIFILE,TZFIELD,PWMEANW) - ! - ENDIF - IF (LRECYCLN) THEN - TZFIELD%CMNHNAME = 'URECYCLN' - TZFIELD%CLONGNAME = 'URECYCLN' - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 2 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_read(TPINIFILE,TZFIELD,PUMEANN) - ! - TZFIELD%CMNHNAME = 'VRECYCLN' - TZFIELD%CLONGNAME = 'VRECYCLN' - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 3 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_read(TPINIFILE,TZFIELD,PVMEANN) - ! - TZFIELD%CMNHNAME = 'WRECYCLN' - TZFIELD%CLONGNAME = 'WRECYCLN' - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 4 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_read(TPINIFILE,TZFIELD,PWMEANN) - ! - ENDIF - IF (LRECYCLE) THEN - TZFIELD%CMNHNAME = 'URECYCLE' - TZFIELD%CLONGNAME = 'URECYCLE' - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 2 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_read(TPINIFILE,TZFIELD,PUMEANE) - ! - TZFIELD%CMNHNAME = 'VRECYCLE' - TZFIELD%CLONGNAME = 'VRECYCLE' - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 3 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_read(TPINIFILE,TZFIELD,PVMEANE) - ! - TZFIELD%CMNHNAME = 'WRECYCLE' - TZFIELD%CLONGNAME = 'WRECYCLE' - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 4 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_read(TPINIFILE,TZFIELD,PWMEANE) - ! - ENDIF - IF (LRECYCLS) THEN - TZFIELD%CMNHNAME = 'URECYCLS' - TZFIELD%CLONGNAME = 'URECYCLS' - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 2 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_read(TPINIFILE,TZFIELD,PUMEANS) - ! - TZFIELD%CMNHNAME = 'VRECYCLS' - TZFIELD%CLONGNAME = 'VRECYCLS' - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 3 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_read(TPINIFILE,TZFIELD,PVMEANS) - ! - TZFIELD%CMNHNAME = 'WRECYCLS' - TZFIELD%CLONGNAME = 'WRECYCLS' - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 4 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_read(TPINIFILE,TZFIELD,PWMEANS) - ENDIF - ENDIF -ENDIF -! -! Scalar Variables Reading : Users, C2R2, C1R3, LIMA, ELEC, Chemical SV -! -ISV= SIZE(PSVT,4) -! -IF (NSV_USER>0) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'kg kg-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = 1, NSV_USER ! initialize according to the get indicators - SELECT CASE(HGETSVT(JSV)) - CASE ('READ') - WRITE(TZFIELD%CMNHNAME,'(A3,I3.3)')'SVT',JSV - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME) - CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV)) - CASE ('INIT') - PSVT(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -! -IF (NSV_C2R2END>=NSV_C2R2BEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm-3' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_C2R2BEG,NSV_C2R2END - SELECT CASE(HGETSVT(JSV)) - CASE ('READ') - TZFIELD%CMNHNAME = TRIM(C2R2NAMES(JSV-NSV_C2R2BEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV)) - CASE ('INIT') - PSVT(:,:,:,JSV) = 0. - IF (LSUPSAT .AND. (HGETRVT == 'READ') ) THEN - ZWORK(:,:,:) = (PPABST(:,:,:)/XP00 )**(XRD/XCPD) - ZWORK(:,:,:) = PTHT(:,:,:)*ZWORK(:,:,:) - ZWORK(:,:,:) = EXP(XALPW-XBETAW/ZWORK(:,:,:)-XGAMW*ALOG(ZWORK(:,:,:))) - !rvsat - ZWORK(:,:,:) = (XMV / XMD)*ZWORK(:,:,:)/(PPABST(:,:,:)-ZWORK(:,:,:)) - ZWORK(:,:,:) = PRT(:,:,:,1)/ZWORK(:,:,:) - PSVT(:,:,:,NSV_C2R2END ) = ZWORK(:,:,:) - END IF - END SELECT - END DO -END IF -! -IF (NSV_C1R3END>=NSV_C1R3BEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm-3' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_C1R3BEG,NSV_C1R3END - SELECT CASE(HGETSVT(JSV)) - CASE ('READ') - TZFIELD%CMNHNAME = TRIM(C1R3NAMES(JSV-NSV_C1R3BEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV)) - CASE ('INIT') - PSVT(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -! -! LIMA variables -! -DO JSV = NSV_LIMA_BEG,NSV_LIMA_END - SELECT CASE(HGETSVT(JSV)) - CASE ('READ') - TZFIELD%CSTDNAME = '' - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - TZFIELD%CDIR = 'XY' - TZFIELD%CUNITS = 'kg-1' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. -! Nc - IF (JSV .EQ. NSV_LIMA_NC) THEN - TZFIELD%CMNHNAME = TRIM(CLIMA_WARM_NAMES(1))//'T' - END IF -! Nr - IF (JSV .EQ. NSV_LIMA_NR) THEN - TZFIELD%CMNHNAME = TRIM(CLIMA_WARM_NAMES(2))//'T' - END IF -! N CCN free - IF (JSV .GE. NSV_LIMA_CCN_FREE .AND. JSV .LT. NSV_LIMA_CCN_ACTI) THEN - WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_CCN_FREE + 1) - TZFIELD%CMNHNAME = TRIM(CLIMA_WARM_NAMES(3))//INDICE//'T' - END IF -! N CCN acti - IF (JSV .GE. NSV_LIMA_CCN_ACTI .AND. JSV .LT. NSV_LIMA_CCN_ACTI + NMOD_CCN) THEN - WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_CCN_ACTI + 1) - TZFIELD%CMNHNAME = TRIM(CLIMA_WARM_NAMES(4))//INDICE//'T' - END IF -! Scavenging - IF (JSV .EQ. NSV_LIMA_SCAVMASS) THEN - TZFIELD%CMNHNAME = TRIM(CAERO_MASS(1))//'T' - TZFIELD%CUNITS = 'kg kg-1' - END IF -! Ni - IF (JSV .EQ. NSV_LIMA_NI) THEN - TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_NAMES(1))//'T' - END IF -! N IFN free - IF (JSV .GE. NSV_LIMA_IFN_FREE .AND. JSV .LT. NSV_LIMA_IFN_NUCL) THEN - WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_IFN_FREE + 1) - TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_NAMES(2))//INDICE//'T' - END IF -! N IFN nucl - IF (JSV .GE. NSV_LIMA_IFN_NUCL .AND. JSV .LT. NSV_LIMA_IFN_NUCL + NMOD_IFN) THEN - WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_IFN_NUCL + 1) - TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_NAMES(3))//INDICE//'T' - END IF -! N IMM nucl - IF (JSV .GE. NSV_LIMA_IMM_NUCL .AND. JSV .LT. NSV_LIMA_IMM_NUCL + NMOD_IMM) THEN - WRITE(INDICE,'(I2.2)')(NINDICE_CCN_IMM(JSV - NSV_LIMA_IMM_NUCL + 1)) - TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_NAMES(4))//INDICE//'T' - END IF -! Hom. freez. of CCN - IF (JSV .EQ. NSV_LIMA_HOM_HAZE) THEN - TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_NAMES(5))//'T' - END IF -! -! Super saturation - IF (JSV .EQ. NSV_LIMA_SPRO) THEN - TZFIELD%CMNHNAME = TRIM(CLIMA_WARM_NAMES(5))//'T' - END IF -! - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV)) - CASE ('INIT') - PSVT(:,:,:,JSV) = 0. - END SELECT -END DO -! -IF (NSV_ELECEND>=NSV_ELECBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_ELECBEG,NSV_ELECEND - SELECT CASE(HGETSVT(JSV)) - CASE ('READ') - TZFIELD%CMNHNAME = TRIM(CELECNAMES(JSV-NSV_ELECBEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - IF (JSV .GT. NSV_ELECBEG .AND. JSV .LT. NSV_ELECEND) THEN - TZFIELD%CUNITS = 'C m-3' - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - ELSE - TZFIELD%CUNITS = 'm-3' - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3,A8)')'X_Y_Z_','SVT',JSV,' (nb ions/m3)' - END IF - CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV)) - CASE ('INIT') - PSVT(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -! -IF (NSV_CHGSEND>=NSV_CHGSBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppbv' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_CHGSBEG,NSV_CHGSEND - CNAMES(JSV-NSV_CHGSBEG+1) = UPCASE(CNAMES(JSV-NSV_CHGSBEG+1)) - SELECT CASE(HGETSVT(JSV)) - CASE ('READ') - TZFIELD%CMNHNAME = TRIM(CNAMES(JSV-NSV_CHGSBEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','CHIM',JSV - CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV)) - CASE ('INIT') - PSVT(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -! -IF (NSV_CHACEND>=NSV_CHACBEG) THEN - TZFIELD%CSTDNAME = '' - !PW TODO: check units - TZFIELD%CUNITS = '' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_CHACBEG,NSV_CHACEND - CNAMES(JSV-NSV_CHACBEG+NSV_CHGS+1) = UPCASE(CNAMES(JSV-NSV_CHACBEG+NSV_CHGS+1)) - SELECT CASE(HGETSVT(JSV)) - CASE ('READ') - TZFIELD%CMNHNAME = TRIM(CNAMES(JSV-NSV_CHACBEG+NSV_CHGS+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3,A4)')'X_Y_Z_','CHAQ',JSV,' (M)' - CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV)) -!***ATTENTION: BUG ? field written with a M suffix, read with a T suffix - CASE ('INIT') - PSVT(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -! -IF (NSV_CHICEND>=NSV_CHICBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppp' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_CHICBEG,NSV_CHICEND - CICNAMES(JSV-NSV_CHICBEG+1) = UPCASE(CICNAMES(JSV-NSV_CHICBEG+1)) - SELECT CASE(HGETSVT(JSV)) - CASE ('READ') - TZFIELD%CMNHNAME = TRIM(CICNAMES(JSV-NSV_CHICBEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV)) - CASE ('INIT') - PSVT(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -! -IF (NSV_SLTEND>=NSV_SLTBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppp' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_SLTBEG,NSV_SLTEND - SELECT CASE(HGETSVT(JSV)) - CASE ('READ') - TZFIELD%CMNHNAME = TRIM(CSALTNAMES(JSV-NSV_SLTBEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV)) - CASE ('INIT') - PSVT(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -! -IF (NSV_SLTDEPEND>=NSV_SLTDEPBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppp' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_SLTDEPBEG,NSV_SLTDEPEND - SELECT CASE(HGETSVT(JSV)) - CASE ('READ') - TZFIELD%CMNHNAME = TRIM(CDESLTNAMES(JSV-NSV_SLTDEPBEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV)) - CASE ('INIT') - PSVT(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -! -IF (NSV_DSTEND>=NSV_DSTBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppp' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_DSTBEG,NSV_DSTEND - SELECT CASE(HGETSVT(JSV)) - CASE ('READ') - TZFIELD%CMNHNAME = TRIM(CDUSTNAMES(JSV-NSV_DSTBEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV)) - CASE ('INIT') - PSVT(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -! -IF (NSV_DSTDEPEND>=NSV_DSTDEPBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppp' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_DSTDEPBEG,NSV_DSTDEPEND - SELECT CASE(HGETSVT(JSV)) - CASE ('READ') - TZFIELD%CMNHNAME = TRIM(CDEDSTNAMES(JSV-NSV_DSTDEPBEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV)) - CASE ('INIT') - PSVT(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -! -IF (NSV_AEREND>=NSV_AERBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppp' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_AERBEG,NSV_AEREND - SELECT CASE(HGETSVT(JSV)) - CASE ('READ') - TZFIELD%CMNHNAME = TRIM(UPCASE(CAERONAMES(JSV-NSV_AERBEG+1)))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV)) - CASE ('INIT') - PSVT(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -! -IF (NSV_AERDEPEND>=NSV_AERDEPBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppp' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_AERDEPBEG,NSV_AERDEPEND - SELECT CASE(HGETSVT(JSV)) - CASE ('READ') - TZFIELD%CMNHNAME = TRIM(CDEAERNAMES(JSV-NSV_AERDEPBEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV)) - CASE ('INIT') - PSVT(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -! -IF (NSV_LGEND>=NSV_LGBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_LGBEG,NSV_LGEND - SELECT CASE(HGETSVT(JSV)) - CASE ('READ') - TZFIELD%CMNHNAME = TRIM(CLGNAMES(JSV-NSV_LGBEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV)) - CASE ('INIT') - PSVT(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -! -IF (NSV_PPEND>=NSV_PPBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_PPBEG,NSV_PPEND - SELECT CASE(HGETSVT(JSV)) - CASE ('READ') - WRITE(TZFIELD%CMNHNAME,'(A3,I3.3)')'SVT',JSV - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'kg kg-1' - CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV),IRESP) - IF (IRESP/=0) THEN - PSVT(:,:,:,JSV) = 0. - END IF - ! - WRITE(TZFIELD%CMNHNAME,'(A3,I3.3)')'ATC',JSV+NSV_PPBEG-1 - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','ATC',JSV+NSV_PPBEG-1 - TZFIELD%CUNITS = 'm-3' - CALL IO_Field_read(TPINIFILE,TZFIELD,PATC(:,:,:,JSV-NSV_PPBEG+1),IRESP) - IF (IRESP/=0) THEN - PATC(:,:,:,JSV-NSV_PPBEG+1) = 0. - ENDIF - CASE ('INIT') - PSVT(:,:,:,JSV) = 0. - PATC(:,:,:,JSV-NSV_PPBEG+1) = 0. - END SELECT - END DO -END IF -! -#ifdef MNH_FOREFIRE -IF (NSV_FFEND>=NSV_FFBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'kg kg-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_FFBEG,NSV_FFEND - SELECT CASE(HGETSVT(JSV)) - CASE ('READ') - WRITE(TZFIELD%CMNHNAME,'(A3,I3.3)')'SVT',JSV - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME) - CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV),IRESP) - IF (IRESP /= 0) THEN - PSVT(:,:,:,JSV) = 0. - END IF - CASE ('INIT') - PSVT(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -#endif -! -IF (NSV_CSEND>=NSV_CSBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'kg kg-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_CSBEG,NSV_CSEND - SELECT CASE(HGETSVT(JSV)) - CASE ('READ') - WRITE(TZFIELD%CMNHNAME,'(A3,I3.3)')'SVT',JSV - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME) - CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV),IRESP) - IF (IRESP /= 0) THEN - PSVT(:,:,:,JSV) = 0. - END IF - CASE ('INIT') - PSVT(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -! -IF (NSV_LNOXEND>=NSV_LNOXBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppp' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_LNOXBEG,NSV_LNOXEND - SELECT CASE(HGETSVT(JSV)) - CASE ('READ') - TZFIELD%CMNHNAME = 'LINOXT' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)') 'X_Y_Z_','SVT',JSV - CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV)) - CASE ('INIT') - PSVT(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -! -IF (NSV_SNWEND>=NSV_SNWBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'kg kg-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - DO JSV = NSV_SNWBEG,NSV_SNWEND - SELECT CASE(HGETSVT(JSV)) - CASE ('READ') - TZFIELD%CMNHNAME = TRIM(CSNOWNAMES(JSV-NSV_SNWBEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)') 'X_Y_Z_','SVT',JSV - CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV)) - CASE ('INIT') - PSVT(:,:,:,JSV) = 0. - END SELECT - END DO -END IF -IF (NSV_SNW>=1) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'kg kg-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - DO JSV = 1,NSV_SNW - SELECT CASE(HGETSVT(JSV)) - CASE ('READ') - WRITE(TZFIELD%CMNHNAME,'(A10,I3.3)')'SNOWCANO_M',JSV - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A8,I3.3)') 'X_Y_Z_','SNOWCANO',JSV - CALL IO_Field_read(TPINIFILE,TZFIELD,XSNWCANO(:,:,JSV)) - CASE ('INIT') - XSNWCANO(:,:,JSV) = 0. - END SELECT - END DO - -END IF - -! -IF (CCONF == 'RESTA') THEN - IF (CTEMP_SCHEME/='LEFR') THEN - CALL IO_Field_read(TPINIFILE,'US_PRES',PRUS_PRES) - CALL IO_Field_read(TPINIFILE,'VS_PRES',PRVS_PRES) - CALL IO_Field_read(TPINIFILE,'WS_PRES',PRWS_PRES) - END IF - IF (LSPLIT_CFL) THEN - CALL IO_Field_read(TPINIFILE,'THS_CLD',PRTHS_CLD) - DO JRR = 1, SIZE(PRT,4) - SELECT CASE(JRR) - CASE (1) - CALL IO_Field_read(TPINIFILE,'RVS_CLD',PRRS_CLD(:,:,:,JRR)) - CASE (2) - CALL IO_Field_read(TPINIFILE,'RCS_CLD',PRRS_CLD(:,:,:,JRR)) - CASE (3) - CALL IO_Field_read(TPINIFILE,'RRS_CLD',PRRS_CLD(:,:,:,JRR)) - CASE (4) - CALL IO_Field_read(TPINIFILE,'RIS_CLD',PRRS_CLD(:,:,:,JRR)) - CASE (5) - CALL IO_Field_read(TPINIFILE,'RSS_CLD',PRRS_CLD(:,:,:,JRR)) - CASE (6) - CALL IO_Field_read(TPINIFILE,'RGS_CLD',PRRS_CLD(:,:,:,JRR)) - CASE (7) - CALL IO_Field_read(TPINIFILE,'RHS_CLD',PRRS_CLD(:,:,:,JRR)) - CASE DEFAULT - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_FIELD','PRT is too big') - END SELECT - END DO - DO JSV = NSV_C2R2BEG,NSV_C2R2END - IF (JSV == NSV_C2R2BEG ) THEN - TZFIELD%CMNHNAME = 'RSVS_CLD1' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'RSVS_CLD1' - TZFIELD%CUNITS = '1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_RHS_CLD' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_read(TPINIFILE,TZFIELD,PRSVS_CLD(:,:,:,JSV)) - END IF - IF (JSV == NSV_C2R2BEG ) THEN - TZFIELD%CMNHNAME = 'RSVS_CLD2' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'RSVS_CLD2' - TZFIELD%CUNITS = '1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_RHS_CLD' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_read(TPINIFILE,TZFIELD,PRSVS_CLD(:,:,:,JSV)) - END IF - END DO - END IF -END IF -! -!* 2.1 Time t-dt: -! -IF (CPROGRAM=='MESONH' .AND. HUVW_ADV_SCHEME(1:3)=='CEN' .AND. & - HTEMP_SCHEME == 'LEFR' ) THEN - IF (CCONF=='RESTA') THEN - CALL IO_Field_read(TPINIFILE,'UM', PUM) - CALL IO_Field_read(TPINIFILE,'VM', PVM) - CALL IO_Field_read(TPINIFILE,'WM', PWM) - CALL IO_Field_read(TPINIFILE,'DUM',PDUM) - CALL IO_Field_read(TPINIFILE,'DVM',PDVM) - CALL IO_Field_read(TPINIFILE,'DWM',PDWM) - ELSE - PUM = PUT - PVM = PVT - PWM = PWT - END IF -END IF -! -!* 2.2a 3D LS fields -! -! -CALL INI_LS(TPINIFILE,HGETRVT,GLSOURCE,PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM,PLSZWSM) -! -! -!* 2.2b 2D "surfacic" LB fields -! -! -CALL INI_LB(TPINIFILE,GLSOURCE,ISV, & - KSIZELBX_ll,KSIZELBXU_ll,KSIZELBY_ll,KSIZELBYV_ll, & - KSIZELBXTKE_ll,KSIZELBYTKE_ll, & - KSIZELBXR_ll,KSIZELBYR_ll,KSIZELBXSV_ll,KSIZELBYSV_ll, & - HGETTKET,HGETRVT,HGETRCT,HGETRRT,HGETRIT,HGETRST, & - HGETRGT,HGETRHT,HGETSVT, & - PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, & - PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM ) -! -! -!* 2.3 Some special variables: -! -CALL IO_Field_read(TPINIFILE,'DRYMASST',PDRYMASST) ! dry mass -IF (CCONF=='RESTA') THEN - CALL IO_Field_read(TPINIFILE,'DRYMASSS',PDRYMASSS) ! dry mass tendency -ELSE - PDRYMASSS=XUNDEF ! should not be used -END IF -! -SELECT CASE(HGETSRCT) ! turbulent flux SRC at time t - CASE('READ') - CALL IO_Field_read(TPINIFILE,'SRCT',PSRCT) - CASE('INIT') - PSRCT(:,:,:)=0. -END SELECT -! -SELECT CASE(HGETSIGS) ! subgrid condensation - CASE('READ') - CALL IO_Field_read(TPINIFILE,'SIGS',PSIGS) - CASE('INIT') - PSIGS(:,:,:)=0. -END SELECT -! -SELECT CASE(HGETPHC) ! pH in cloud water - CASE('READ') - CALL IO_Field_read(TPINIFILE,'PHC',PPHC) - CASE('INIT') - PPHC(:,:,:)=0. -END SELECT -! -SELECT CASE(HGETPHR) ! pH in rainwater - CASE('READ') - CALL IO_Field_read(TPINIFILE,'PHR',PPHR) - CASE('INIT') - PPHR(:,:,:)=0. -END SELECT -! -IRESP=0 -IF(HGETCLDFR=='READ') THEN ! cloud fraction - CALL IO_Field_read(TPINIFILE,'CLDFR',PCLDFR,IRESP) -ENDIF -IF(HGETCLDFR=='INIT' .OR. IRESP /= 0) THEN - IF(SIZE(PRT,4) > 3) THEN - WHERE(PRT(:,:,:,2)+PRT(:,:,:,4) > 1.E-30) - PCLDFR(:,:,:) = 1. - ELSEWHERE - PCLDFR(:,:,:) = 0. - ENDWHERE - ELSE - WHERE(PRT(:,:,:,2) > 1.E-30) - PCLDFR(:,:,:) = 1. - ELSEWHERE - PCLDFR(:,:,:) = 0. - ENDWHERE - ENDIF -ENDIF -! -!* boundary layer depth -! -IF (HGETBL_DEPTH=='READ') THEN - CALL IO_Field_read(TPINIFILE,'BL_DEPTH',PBL_DEPTH) -ELSE - PBL_DEPTH(:,:)=XUNDEF -END IF -! -!* surface boundary layer depth -! -IF (HGETSBL_DEPTH=='READ') THEN - CALL IO_Field_read(TPINIFILE,'SBL_DEPTH',PSBL_DEPTH) -ELSE - PSBL_DEPTH(:,:)=0. -END IF -! -!* Contribution from MAss Flux parameterizations to vert. flux of buoyancy -! -SELECT CASE(HGETTKET) - CASE('READ') - IF (CSCONV=='EDKF') THEN - CALL IO_Field_read(TPINIFILE,'WTHVMF',PWTHVMF) - ELSE - PWTHVMF(:,:,:)=0 - ENDIF - CASE('INIT') - PWTHVMF(:,:,:)=0. -END SELECT -!------------------------------------------------------------------------------- -! -!* 2.4 READ FORCING VARIABLES -! ---------------------- -! -! READ FIELD ONLY FOR MODEL1 (identical for all model in GN) -IF (LOCEAN .AND. (.NOT.LCOUPLES) .AND. (KOCEMI==1)) THEN -! - CALL IO_Field_read(TPINIFILE,'NFRCLT',NFRCLT) - CALL IO_Field_read(TPINIFILE,'NINFRT',NINFRT) -! - TZFIELD%CMNHNAME = 'SSUFL_T' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'SSUFL' - TZFIELD%CUNITS = 'kg m-1 s-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'sfc stress along U to force ocean LES ' - TZFIELD%NGRID = 0 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - ALLOCATE(XSSUFL_T(NFRCLT)) - CALL IO_Field_read(TPINIFILE,TZFIELD,XSSUFL_T(:)) -! - TZFIELD%CMNHNAME = 'SSVFL_T' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'SSVFL' - TZFIELD%CUNITS = 'kg m-1 s-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'sfc stress along V to force ocean LES ' - TZFIELD%NGRID = 0 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. -ALLOCATE(XSSVFL_T(NFRCLT)) - CALL IO_Field_read(TPINIFILE,TZFIELD,XSSVFL_T(:)) -! - TZFIELD%CMNHNAME = 'SSTFL_T' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'SSTFL' - TZFIELD%CUNITS = 'kg m3 K m s-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'sfc total heat flux to force ocean LES ' - TZFIELD%NGRID = 0 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - ALLOCATE(XSSTFL_T(NFRCLT)) - CALL IO_Field_read(TPINIFILE,TZFIELD,XSSTFL_T(:)) -! - TZFIELD%CMNHNAME = 'SSOLA_T' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'SSOLA' - TZFIELD%CUNITS = 'kg m3 K m s-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'sfc solar flux at sfc to force ocean LES ' - TZFIELD%NGRID = 0 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - ALLOCATE(XSSOLA_T(NFRCLT)) - CALL IO_Field_read(TPINIFILE,TZFIELD,XSSOLA_T(:)) -! -END IF ! ocean sfc forcing end - -! -IF ( LFORCING ) THEN - DO JT=1,KFRC -! - WRITE (YFRC,'(I3.3)') JT -! - TZFIELD%CMNHNAME = 'DTFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'seconds since YYYY-MM-DD HH:MM:SS.S' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Date of forcing profile '//YFRC - TZFIELD%NGRID = 0 - TZFIELD%NTYPE = TYPEDATE - TZFIELD%NDIMS = 0 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_read(TPINIFILE,TZFIELD,TPDTFRC(JT)) -! - TZFIELD%CMNHNAME = 'UFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Zonal component of horizontal forcing wind' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_read(TPINIFILE,TZFIELD,PUFRC(:,JT)) -! - TZFIELD%CMNHNAME = 'VFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Meridian component of horizontal forcing wind' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_read(TPINIFILE,TZFIELD,PVFRC(:,JT)) -! - TZFIELD%CMNHNAME = 'WFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Vertical forcing wind' - TZFIELD%NGRID = 4 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_read(TPINIFILE,TZFIELD,PWFRC(:,JT)) -! - TZFIELD%CMNHNAME = 'THFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'K' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Forcing potential temperature' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_read(TPINIFILE,TZFIELD,PTHFRC(:,JT)) -! - TZFIELD%CMNHNAME = 'RVFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'kg kg-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Forcing vapor mixing ratio' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_read(TPINIFILE,TZFIELD,PRVFRC(:,JT)) -! - TZFIELD%CMNHNAME = 'TENDTHFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'K s-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Large-scale potential temperature tendency for forcing' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_read(TPINIFILE,TZFIELD,PTENDTHFRC(:,JT)) -! - TZFIELD%CMNHNAME = 'TENDRVFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'kg kg-1 s-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Large-scale vapor mixing ratio tendency for forcing' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_read(TPINIFILE,TZFIELD,PTENDRVFRC(:,JT)) -! - TZFIELD%CMNHNAME = 'GXTHFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'K m-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Large-scale potential temperature gradient for forcing' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_read(TPINIFILE,TZFIELD,PGXTHFRC(:,JT)) -! - TZFIELD%CMNHNAME = 'GYTHFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'K m-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Large-scale potential temperature gradient for forcing' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_read(TPINIFILE,TZFIELD,PGYTHFRC(:,JT)) -! - TZFIELD%CMNHNAME = 'PGROUNDFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'Pa' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Forcing ground pressure' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 0 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_read(TPINIFILE,TZFIELD,PPGROUNDFRC(JT)) -! - TZFIELD%CMNHNAME = 'TENDUFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Large-scale U tendency for forcing' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_read(TPINIFILE,TZFIELD,PTENDUFRC(:,JT)) -! - TZFIELD%CMNHNAME = 'TENDVFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Large-scale V tendency for forcing' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_read(TPINIFILE,TZFIELD,PTENDVFRC(:,JT)) - END DO -END IF -! -!------------------------------------------------------------------------------- -IF (L2D_ADV_FRC) THEN - - DO JT=1,KADVFRC - WRITE (YFRC,'(I3.3)') JT - ! - TZFIELD%CMNHNAME = 'DTADV'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'seconds since YYYY-MM-DD HH:MM:SS.S' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Date and time of the advecting forcing '//YFRC - TZFIELD%NGRID = 0 - TZFIELD%NTYPE = TYPEDATE - TZFIELD%NDIMS = 0 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_read(TPINIFILE,TZFIELD,TPDTADVFRC(JT)) - ! - TZFIELD%CMNHNAME = 'TH_ADV'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'K s-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_read(TPINIFILE,TZFIELD,PDTHFRC(:,:,:,JT)) - ! - TZFIELD%CMNHNAME = 'Q_ADV'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'kg kg-1 s-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_read(TPINIFILE,TZFIELD,PDRVFRC(:,:,:,JT)) - ENDDO -ENDIF -! -IF (L2D_REL_FRC) THEN - - DO JT=1,KRELFRC - WRITE (YFRC,'(I3.3)') JT - ! - TZFIELD%CMNHNAME = 'DTREL'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'seconds since YYYY-MM-DD HH:MM:SS.S' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Date and time of the relaxation forcing '//YFRC - TZFIELD%NGRID = 0 - TZFIELD%NTYPE = TYPEDATE - TZFIELD%NDIMS = 0 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_read(TPINIFILE,TZFIELD,TPDTRELFRC(JT)) - ! - ! Relaxation - TZFIELD%CMNHNAME = 'TH_REL'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'K' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_read(TPINIFILE,TZFIELD,PTHREL(:,:,:,JT)) - ! - TZFIELD%CMNHNAME = 'Q_REL'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'kg kg-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_read(TPINIFILE,TZFIELD,PRVREL(:,:,:,JT)) - ENDDO -ENDIF -! -IF (LUV_FLX) THEN - IF ( CCONF /= 'START' .OR. CPROGRAM=='SPAWN ' ) THEN - CALL IO_Field_read(TPINIFILE,'VU_FLX',PVU_FLUX_M) - ELSE IF (CCONF == 'START') THEN - PVU_FLUX_M(:,:,:)=0. - END IF -ENDIF -! -IF (LTH_FLX) THEN - IF ( CCONF /= 'START' .OR. CPROGRAM=='SPAWN ' ) THEN - CALL IO_Field_read(TPINIFILE,'VT_FLX',PVTH_FLUX_M) - CALL IO_Field_read(TPINIFILE,'WT_FLX',PWTH_FLUX_M) - ELSE IF (CCONF == 'START') THEN - PWTH_FLUX_M(:,:,:)=0. - PVTH_FLUX_M(:,:,:)=0. - END IF -ENDIF -! -!------------------------------------------------------------------------------- -! -! -!* 3. PRINT ON OUTPUT-LISTING -! ---------------------- -! -IF (NVERB >= 10 .AND. .NOT. L1D) THEN - IIUP = SIZE(PUT,1) - IJUP = SIZE(PVT,2) - ILUOUT= TLUOUT%NLU -! - WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PUT values:' - WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK ' - DO JKLOOP=1,KKU - WRITE(ILUOUT,FMT=*) PUT(1,1,JKLOOP),PUT(IIUP/2,IJUP/2,JKLOOP), & - PUT(IIUP,KJU,JKLOOP),JKLOOP - END DO -! - WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PVT values:' - WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK ' - DO JKLOOP=1,KKU - WRITE(ILUOUT,FMT=*) PVT(1,1,JKLOOP),PVT(IIUP/2,IJUP/2,JKLOOP), & - PVT(IIUP,IJUP,JKLOOP),JKLOOP - END DO -! - WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PWT values:' - WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK ' - DO JKLOOP=1,KKU - WRITE(ILUOUT,FMT=*) PWT(1,1,JKLOOP),PWT(IIUP/2,IJUP/2,JKLOOP), & - PWT(IIUP,IJUP,JKLOOP),JKLOOP - END DO -! - WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PTHT values:' - WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK ' - DO JKLOOP=1,KKU - WRITE(ILUOUT,FMT=*) PTHT(1,1,JKLOOP),PTHT(IIUP/2,IJUP/2,JKLOOP), & - PTHT(IIUP,IJUP,JKLOOP),JKLOOP - END DO -! - IF(SIZE(PTKET,1) /=0) THEN - WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PTKET values:' - WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK ' - DO JKLOOP=1,KKU - WRITE(ILUOUT,FMT=*) PTKET(1,1,JKLOOP),PTKET(IIUP/2,IJUP/2,JKLOOP), & - PTKET(IIUP,IJUP,JKLOOP),JKLOOP - END DO - END IF -! - IF (SIZE(PRT,4) /= 0) THEN - WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PRT values:' - DO JRR = 1, SIZE(PRT,4) - WRITE(ILUOUT,FMT=*) 'JRR = ',JRR - WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK ' - DO JKLOOP=1,KKU - WRITE(ILUOUT,FMT=*) PRT(1,1,JKLOOP,JRR),PRT(IIUP/2,IJUP/2,JKLOOP,JRR), & - PRT(IIUP,IJUP,JKLOOP,JRR),JKLOOP - END DO - END DO -! - END IF -! - IF (SIZE(PSVT,4) /= 0) THEN - WRITE(ILUOUT,FMT=*) 'READ_FIELD: Some PSVT values:' - DO JRR = 1, SIZE(PSVT,4) - WRITE(ILUOUT,FMT=*) 'JRR = ',JRR - WRITE(ILUOUT,FMT=*) '(1,1,JK) (IIU/2,IJU/2,JK) (IIU,IJU,JK) JK ' - DO JKLOOP=1,KKU - WRITE(ILUOUT,FMT=*) PSVT(1,1,JKLOOP,JRR),PSVT(IIUP/2,IJUP/2,JKLOOP,JRR), & - PSVT(IIUP,IJUP,JKLOOP,JRR),JKLOOP - END DO - END DO -! - END IF -END IF -!------------------------------------------------------------------------------- -! -! -END SUBROUTINE READ_FIELD diff --git a/src/ICCARE_BASE/read_lima_data_netcdf_case.f90 b/src/ICCARE_BASE/read_lima_data_netcdf_case.f90 deleted file mode 100644 index e6ffb4742..000000000 --- a/src/ICCARE_BASE/read_lima_data_netcdf_case.f90 +++ /dev/null @@ -1,898 +0,0 @@ -!MNH_LIC Copyright 2012-2017 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!----------------------------------------------------------------- -! ################################ - MODULE MODI_READ_LIMA_DATA_NETCDF_CASE -! ################################# -INTERFACE -SUBROUTINE READ_LIMA_DATA_NETCDF_CASE(TPPRE_REAL1,HFILE,TPPGDFILE, & - PTIME_HORI,KVERB,ODUMMY_REAL ) -! -USE MODD_IO, ONLY: TFILEDATA -! -TYPE(TFILEDATA),POINTER,INTENT(IN) :: TPPRE_REAL1 ! PRE_REAL1 file -CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of the NETCDF file -TYPE(TFILEDATA), INTENT(IN) :: TPPGDFILE ! physiographic data file -REAL, INTENT(INOUT) :: PTIME_HORI ! time spent in hor. interpolations -INTEGER, INTENT(IN) :: KVERB ! verbosity level -LOGICAL, INTENT(IN) :: ODUMMY_REAL! flag to interpolate dummy fields -END SUBROUTINE READ_LIMA_DATA_NETCDF_CASE -! -END INTERFACE -END MODULE MODI_READ_LIMA_DATA_NETCDF_CASE -! #################################################################### - SUBROUTINE READ_LIMA_DATA_NETCDF_CASE(TPPRE_REAL1,HFILE,TPPGDFILE, & - PTIME_HORI,KVERB,ODUMMY_REAL ) -! #################################################################### -! -!!**** *READ_LIMA_DATA_NETCDF_CASE* - reads data for the initialization of real cases. -!! -!! PURPOSE -!! ------- -! This routine reads the two input files : -! The PGD which is closed after reading -! The NETCDF file -! Projection is read in READ_LFIFM_PGD (MODD_GRID). -! Grid and definition of large domain are read in PGD file and -! NETCDF files. -! The PGD files are also read in READ_LFIFM_PGD. -! The PGD file is closed. -! Vertical grid is defined in READ_VER_GRID. -! PGD fields are stored on MESO-NH domain (in TRUNC_PGD). -!! -!!** METHOD -!! ------ -!! 0. Declarations -!! 1. Declaration of arguments -!! 2. Declaration of local variables -!! 1. Read PGD file -!! 1. Domain restriction -!! 2. Coordinate conversion to lat,lon system -!! 2. Read Netcdf fields -!! 3. Vertical grid -!! 4. Free all temporary allocations -!! -!! EXTERNAL -!! -------- -!! subroutine READ_LFIFM_PGD : to read PGD file -!! subroutine READ_VER_GRID : to read the vertical grid in namelist file. -!! subroutine HORIBL : horizontal bilinear interpolation -!! subroutine XYTOLATLON : projection from conformal to lat,lon -!! -!! Module MODI_READ_VER_GRID : interface for subroutine READ_VER_GRID -!! Module MODI_HORIBL : interface for subroutine HORIBL -!! Module MODI_XYTOLATLON : interface for subroutine XYTOLATLON -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! Module MODD_CONF : contains configuration variables for all models. -!! NVERB : verbosity level for output-listing -!! Module MODD_LUNIT : contains logical unit names for all models -!! CLUOUT0 : name of output-listing -!! Module MODD_PGDDIM : contains dimension of PGD fields -!! NPGDIMAX: dimension along x (no external point) -!! NPGDJMAX: dimension along y (no external point) -!! Module MODD_PARAMETERS -!! JPHEXT -!! -!! MODIFICATIONS -!! ------------- -!! Original 23/01/12 (C. Mari) -!! P. Wautelet 30/10/17 use F90 module for netCDF -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_BLANK_n -USE MODD_CH_AEROSOL, ONLY: CORGANIC, NCARB, NSOA, NSP, LORILAM,& - JPMODE, LVARSIGI, LVARSIGJ,CAERONAMES -USE MODD_CH_M9_n, ONLY: NEQ , CNAMES -USE MODD_CH_MNHC_n, ONLY: LUSECHEM,LUSECHAQ,LUSECHIC,LCH_PH -USE MODD_CONF -USE MODD_CONF_n -USE MODD_CST -USE MODD_DIM_n -USE MODD_GRID -USE MODD_GRID_n -USE MODD_IO, ONLY: TFILEDATA -USE MODD_LUNIT, ONLY: TLUOUT0 -USE MODE_MODELN_HANDLER -USE MODD_NETCDF, ONLY:CDFINT -USE MODD_NSV -USE MODD_PARAMETERS -USE MODD_PARAM_n, ONLY : CTURB -USE MODD_PREP_REAL -USE MODD_TIME -USE MODD_TIME_n -! -!UPG*PT -!USE MODE_FM -!USE MODE_IO_ll -USE MODE_IO -USE MODE_TOOLS_ll -!UPG*PT -USE MODE_MPPDB -USE MODE_THERMO -USE MODE_TIME -! -USE MODI_CH_AER_INIT_SOA -USE MODI_CH_INIT_SCHEME_n -USE MODI_CH_OPEN_INPUT -USE MODI_HORIBL -USE MODI_INI_NSV -USE MODI_READ_HGRID_n -USE MODI_READ_VER_GRID -USE MODI_XYTOLATLON -! -USE NETCDF -! -USE MODD_PARAM_n, ONLY : CCLOUD -USE MODD_PARAM_LIMA, ONLY : NMOD_CCN, LSCAV, LAERO_MASS, HINI_CCN, HTYPE_CCN, & - NMOD_IFN, NMOD_IMM, LHHONI, NINDICE_CCN_IMM -! -IMPLICIT NONE -! -!* 0.1. Declaration of arguments -! ------------------------ -! -TYPE(TFILEDATA),POINTER,INTENT(IN) :: TPPRE_REAL1 ! PRE_REAL1 file -CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of the NETCDF file -TYPE(TFILEDATA), INTENT(IN) :: TPPGDFILE ! physiographic data file -REAL, INTENT(INOUT) :: PTIME_HORI ! time spent in hor. interpolations -INTEGER, INTENT(IN) :: KVERB ! verbosity level -LOGICAL, INTENT(IN) :: ODUMMY_REAL! flag to interpolate dummy fields -! -!* 0.2 Declaration of local variables -! ------------------------------ -! General purpose variables -INTEGER :: ILUOUT0 ! Unit used for output msg. -INTEGER :: JI,JJ,JK ! Dummy counters -INTEGER :: JLOOP1 -! Variables used by the PGD reader -CHARACTER(LEN=28) :: YPGD_NAME ! not used - dummy argument -CHARACTER(LEN=28) :: YPGD_DAD_NAME ! not used - dummy argument -CHARACTER(LEN=2) :: YPGD_TYPE ! not used - dummy argument -! PGD Grib definition variables -INTEGER :: INO ! Number of points of the grid -INTEGER :: IIU ! Number of points along X -INTEGER :: IJU ! Number of points along Y -REAL, DIMENSION(:), ALLOCATABLE :: ZLONOUT ! mapping PGD -> Grib (lon.) -REAL, DIMENSION(:), ALLOCATABLE :: ZLATOUT ! mapping PGD -> Grib (lat.) -REAL, DIMENSION(:,:), ALLOCATABLE :: ZXM ! X of PGD mass points -REAL, DIMENSION(:,:), ALLOCATABLE :: ZYM ! Y of PGD mass points -REAL, DIMENSION(:,:), ALLOCATABLE :: ZLATM ! Lat of PGD mass points -REAL, DIMENSION(:,:), ALLOCATABLE :: ZLONM ! Lon of PGD mass points -! Variable involved in the task of reading the netcdf file -REAL,DIMENSION(:,:),ALLOCATABLE :: ZVALUE ! Intermediate array -REAL,DIMENSION(:),ALLOCATABLE :: ZVALUE1D ! Intermediate array -REAL,DIMENSION(:,:),ALLOCATABLE :: ZOUT ! Intermediate arrays -REAL,DIMENSION(:),ALLOCATABLE :: ZOUT1D ! Intermediate arrays -! model indice -INTEGER :: IMI -TYPE(TFILEDATA),POINTER :: TZFILE -! -! For netcdf -! -integer(kind=CDFINT) :: status, ncid, varid -integer(kind=CDFINT) :: lat_varid, lon_varid, lev_varid, time_varid -integer(kind=CDFINT) :: a_varid, b_varid, p0_varid, ps_varid, t_varid, q_varid -integer(kind=CDFINT) :: mmr_dust1_varid, mmr_dust2_varid, mmr_dust3_varid -integer(kind=CDFINT) :: mmr_seasalt1_varid, mmr_seasalt2_varid, mmr_seasalt3_varid -integer(kind=CDFINT) :: mmr_bc_hydrophilic_varid, mmr_bc_hydrophobic_varid -integer(kind=CDFINT) :: mmr_oc_hydrophilic_varid, mmr_oc_hydrophobic_varid -integer(kind=CDFINT) :: mmr_sulfaer_varid -integer(kind=CDFINT) :: recid, latid, lonid, levid, timeid -integer(kind=CDFINT) :: latlen, lonlen, levlen, nrecs,timelen -integer(kind=CDFINT) :: KILEN -CHARACTER(LEN=40) :: recname -REAL, DIMENSION(:), ALLOCATABLE :: lats -REAL, DIMENSION(:), ALLOCATABLE :: lons -REAL, DIMENSION(:), ALLOCATABLE :: levs -INTEGER, DIMENSION(:), ALLOCATABLE :: count3d, start3d -INTEGER, DIMENSION(:), ALLOCATABLE :: count2d, start2d -REAL, DIMENSION(:), ALLOCATABLE :: time, a, b -REAL :: p0 -INTEGER, DIMENSION(:), ALLOCATABLE :: kinlo -REAL, DIMENSION(:,:,:), ALLOCATABLE :: mmr_dust1, mmr_dust2, mmr_dust3 -REAL, DIMENSION(:,:,:), ALLOCATABLE :: mmr_seasalt1, mmr_seasalt2, mmr_seasalt3 -REAL, DIMENSION(:,:,:), ALLOCATABLE :: mmr_bc_hydrophilic, mmr_bc_hydrophobic -REAL, DIMENSION(:,:,:), ALLOCATABLE :: mmr_oc_hydrophilic, mmr_oc_hydrophobic -REAL, DIMENSION(:,:,:), ALLOCATABLE :: mmr_sulfaer -REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWORK -!REAL, DIMENSION(:,:,:), ALLOCATABLE :: TMOZ, QMOZ, PSMOZ -REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTCAM, ZQCAM -REAL, DIMENSION(:,:), ALLOCATABLE :: ZPSCAM -REAL :: scale, offset -! for reverse altitude -REAL, DIMENSION(:), ALLOCATABLE :: TMP1, TMP2 -REAL, DIMENSION(:,:,:), ALLOCATABLE :: TMP3 -REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: TMP4,TMP5 -!---------------------------------------------------------------------- -TZFILE => NULL() -! -IMI = GET_CURRENT_MODEL_INDEX() -! -!-------------------------------------------------------------- -! -!* 1. READ PGD FILE -! ------------- -! -ILUOUT0 = TLUOUT0%NLU -CALL READ_HGRID_n(TPPGDFILE,YPGD_NAME,YPGD_DAD_NAME,YPGD_TYPE) -! -! 1.1 Domain restriction -! -CALL GET_DIM_EXT_ll('B',IIU,IJU) -INO = IIU * IJU -! -! -! 1.2 Coordinate conversion to lat,lon system -! -ALLOCATE (ZXM(IIU,IJU)) -ALLOCATE (ZYM(IIU,IJU)) -ALLOCATE (ZLONM(IIU,IJU)) -ALLOCATE (ZLATM(IIU,IJU)) -ZXM(1:IIU-1,1) = (XXHAT(1:IIU-1) + XXHAT(2:IIU) ) / 2. -ZXM(IIU,1) = XXHAT(IIU) - XXHAT(IIU-1) + ZXM(IIU-1,1) -ZXM(:,2:IJU) = SPREAD(ZXM(:,1),2,IJU-1) -ZYM(1,1:IJU-1) = (XYHAT(1:IJU-1) + XYHAT(2:IJU)) / 2. -ZYM(1,IJU) = XYHAT(IJU) - XYHAT(IJU-1) + ZYM(1,IJU-1) -ZYM(2:IIU,:) = SPREAD(ZYM(1,:),1,IIU-1) -CALL SM_XYTOLATLON_A (XLAT0,XLON0,XRPK,XLATORI,XLONORI,ZXM,ZYM,ZLATM,ZLONM, & - IIU,IJU) -ALLOCATE (ZLONOUT(INO)) -ALLOCATE (ZLATOUT(INO)) -JLOOP1 = 0 -DO JJ = 1, IJU - ZLONOUT(JLOOP1+1:JLOOP1+IIU) = ZLONM(1:IIU,JJ) - ZLATOUT(JLOOP1+1:JLOOP1+IIU) = ZLATM(1:IIU,JJ) - JLOOP1 = JLOOP1 + IIU -ENDDO -DEALLOCATE (ZYM) -DEALLOCATE (ZXM) -! -!-------------------------------------------------------------- -! -!* 2. READ NETCDF FIELDS -! ------------------ -! -! 2.1 Open netcdf files -! -status = nf90_open(HFILE, nf90_nowrite, ncid) -if (status /= nf90_noerr) call handle_err(status) -! -! 2.2 Read netcdf files -! -! get dimension IDs -! -!* get dimension ID of unlimited variable in netcdf file -status = nf90_inquire(ncid, unlimitedDimId = recid) -!status = nf90_inq_dimid(ncid, "time", timeid) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_dimid(ncid, "latitude", latid) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_dimid(ncid, "longitude", lonid) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_dimid(ncid, "level", levid) -if (status /= nf90_noerr) call handle_err(status) -! -! get dimensions -! -!* get dimension and name of unlimited variable in netcdf file -status = nf90_inquire_dimension(ncid, recid, name=recname, len=nrecs) -!status = nf90_inquire_dimension(ncid, timeid, len=nrecs) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inquire_dimension(ncid, latid, len=latlen) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inquire_dimension(ncid, lonid, len=lonlen) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inquire_dimension(ncid, levid, len=levlen) -if (status /= nf90_noerr) call handle_err(status) -! -! get variable IDs -! -status = nf90_inq_varid(ncid, "latitude", lat_varid) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_varid(ncid, "longitude", lon_varid) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_varid(ncid, "level", lev_varid) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_varid(ncid, "time", time_varid) -if (status /= nf90_noerr) call handle_err(status) -! -!!! status = nf90_inq_varid(ncid, "a", a_varid) -!!! if (status /= nf90_noerr) call handle_err(status) -!!! status = nf90_inq_varid(ncid, "b", b_varid) -!!! if (status /= nf90_noerr) call handle_err(status) -! -status = nf90_inq_varid(ncid, "aermr04", mmr_dust1_varid) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_varid(ncid, "aermr05", mmr_dust2_varid) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_varid(ncid, "aermr06", mmr_dust3_varid) -if (status /= nf90_noerr) call handle_err(status) -! -status = nf90_inq_varid(ncid, "aermr01", mmr_seasalt1_varid) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_varid(ncid, "aermr02", mmr_seasalt2_varid) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_varid(ncid, "aermr03", mmr_seasalt3_varid) -if (status /= nf90_noerr) call handle_err(status) -! -status = nf90_inq_varid(ncid, "aermr10", mmr_bc_hydrophilic_varid) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_varid(ncid, "aermr09", mmr_bc_hydrophobic_varid) -if (status /= nf90_noerr) call handle_err(status) -! -status = nf90_inq_varid(ncid, "aermr08", mmr_oc_hydrophilic_varid) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_varid(ncid, "aermr07", mmr_oc_hydrophobic_varid) -if (status /= nf90_noerr) call handle_err(status) -! -status = nf90_inq_varid(ncid, "aermr11", mmr_sulfaer_varid) -if (status /= nf90_noerr) call handle_err(status) -! -!!! status = nf90_inq_varid(ncid, "p0", p0_varid) -!!! if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_varid(ncid, "sp", ps_varid) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_varid(ncid, "t", t_varid) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_inq_varid(ncid, "q", q_varid) -if (status /= nf90_noerr) call handle_err(status) -! - -KILEN = latlen * lonlen -! -! 2.3 Read data. -! -ALLOCATE (count3d(4)) -ALLOCATE (start3d(4)) -ALLOCATE (count2d(3)) -ALLOCATE (start2d(3)) -ALLOCATE (lats(latlen)) -ALLOCATE (lons(lonlen)) -ALLOCATE (levs(levlen)) -ALLOCATE (kinlo(latlen)) -kinlo(:) = lonlen -!ALLOCATE (time(nrecs)) -!ALLOCATE (a(levlen)) -!ALLOCATE (b(levlen)) -! T, Q, Ps : -ALLOCATE (ZTCAM(lonlen,latlen,levlen)) -ALLOCATE (ZQCAM(lonlen,latlen,levlen)) -!ALLOCATE (ZPSCAM(lonlen,latlen,levlen)) -ALLOCATE (ZPSCAM(lonlen,latlen)) -! transformed a, b : -ALLOCATE (XA_SV_LS(levlen)) -ALLOCATE (XB_SV_LS(levlen)) -! meteo var -ALLOCATE (XT_SV_LS(IIU,IJU,levlen)) -ALLOCATE (XQ_SV_LS(IIU,IJU,levlen,1)) -ALLOCATE (XPS_SV_LS(IIU,IJU)) -ALLOCATE (XZS_SV_LS(IIU,IJU)) -! take the orography from ECMWF -XZS_SV_LS(:,:) = XZS_LS(:,:) -! aerosol mr from CAMS or MACC -ALLOCATE (mmr_dust1(lonlen,latlen,levlen)) -ALLOCATE (mmr_dust2(lonlen,latlen,levlen)) -ALLOCATE (mmr_dust3(lonlen,latlen,levlen)) -! -ALLOCATE (mmr_seasalt1(lonlen,latlen,levlen)) -ALLOCATE (mmr_seasalt2(lonlen,latlen,levlen)) -ALLOCATE (mmr_seasalt3(lonlen,latlen,levlen)) -! -ALLOCATE (mmr_bc_hydrophilic(lonlen,latlen,levlen)) -ALLOCATE (mmr_bc_hydrophobic(lonlen,latlen,levlen)) -! -ALLOCATE (mmr_oc_hydrophilic(lonlen,latlen,levlen)) -ALLOCATE (mmr_oc_hydrophobic(lonlen,latlen,levlen)) -! -ALLOCATE (mmr_sulfaer(lonlen,latlen,levlen)) -! -ALLOCATE (ZWORK(lonlen,latlen,levlen)) -! -! get values of variables -! -status = nf90_get_var(ncid, lat_varid, lats(:)) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_get_var(ncid, lon_varid, lons(:)) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_get_var(ncid, lev_varid, levs(:)) -if (status /= nf90_noerr) call handle_err(status) -!!! status = nf90_get_var(ncid, time_varid, time(:)) -!!! if (status /= nf90_noerr) call handle_err(status) -!!! status = nf90_get_var(ncid, a_varid, a(:)) -!!! if (status /= nf90_noerr) call handle_err(status) -!!! status = nf90_get_var(ncid, b_varid, b(:)) -!!! if (status /= nf90_noerr) call handle_err(status) -!!! status = nf90_get_var(ncid, p0_varid, p0) -!!! if (status /= nf90_noerr) call handle_err(status) -! -! Reference pressure (needed for the vertical interpolation) -! -!!! XP00_SV_LS = p0 -XP00_SV_LS = 101325.0 -! -! a and b coefficients (needed for the vertical interpolation) -! -XA_SV_LS(:) = (/ 20.000000000, 38.425343000, 63.647804000, 95.636963000, 134.48330700, & - 180.58435100, 234.77905300, 298.49578900, 373.97192400, 464.61813400, & - 575.65100100, 713.21807900, 883.66052200, 1094.8347170, 1356.4746090, & - 1680.6402590, 2082.2739260, 2579.8886720, 3196.4216310, 3960.2915040, & - 4906.7084960, 6018.0195310, 7306.6313480, 8765.0537110, 10376.126953, & - 12077.446289, 13775.325195, 15379.805664, 16819.474609, 18045.183594, & - 19027.695313, 19755.109375, 20222.205078, 20429.863281, 20384.480469, & - 20097.402344, 19584.330078, 18864.750000, 17961.357422, 16899.468750, & - 15706.447266, 14411.124023, 13043.218750, 11632.758789, 10209.500977, & - 8802.3564450, 7438.8032230, 6144.3149410, 4941.7783200, 3850.9133300, & - 2887.6965330, 2063.7797850, 1385.9125980, 855.36175500, 467.33358800, & - 210.39389000, 65.889244000, 7.3677430000, 0.0000000000, 0.0000000000 /) - -XA_SV_LS(:) = XA_SV_LS(:) / XP00_SV_LS - -XB_SV_LS(:) = (/ 0.00000000, 0.00000000, 0.00000000, 0.00000000, 0.00000000, & - 0.00000000, 0.00000000, 0.00000000, 0.00000000, 0.00000000, & - 0.00000000, 0.00000000, 0.00000000, 0.00000000, 0.00000000, & - 0.00000000, 0.00000000, 0.00000000, 0.00000000, 0.00000000, & - 0.00000000, 0.00000000, 0.00000000, 0.00007582, 0.00046139, & - 0.00181516, 0.00508112, 0.01114291, 0.02067788, 0.03412116, & - 0.05169041, 0.07353383, 0.09967469, 0.13002251, 0.16438432, & - 0.20247594, 0.24393314, 0.28832296, 0.33515489, 0.38389215, & - 0.43396294, 0.48477158, 0.53570992, 0.58616841, 0.63554746, & - 0.68326861, 0.72878581, 0.77159661, 0.81125343, 0.84737492, & - 0.87965691, 0.90788388, 0.93194032, 0.95182151, 0.96764523, & - 0.97966272, 0.98827010, 0.99401945, 0.99763012, 1.00000000 /) -! -! Read 1 record of lon*lat values, starting at the -! beginning of the record (the (1, 1, rec=time) element in the netCDF -! file). -count2d(1) = lonlen -count2d(2) = latlen -count2d(3) = 1 -start2d(1) = 1 -start2d(2) = 1 -start2d(3) = 1 -! -! Read 1 record of lon*lat*lev values, starting at the -! beginning of the record (the (1, 1, 1, rec=time) element in the netCDF -! file). -count3d(1) = lonlen -count3d(2) = latlen -count3d(3) = levlen -count3d(4) = 1 -start3d(1) = 1 -start3d(2) = 1 -start3d(3) = 1 -start3d(4) = 1 -! -! Temperature and spec. hum. (needed for the vertical interpolation) -! -status = nf90_get_var(ncid, t_varid, ZTCAM(:,:,:), start=start3d, count=count3d) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_get_att(ncid, t_varid, "scale_factor", scale) -status = nf90_get_att(ncid, t_varid, "add_offset", offset) -ZTCAM(:,:,:) = offset + scale * ZTCAM(:,:,:) -! -status = nf90_get_var(ncid, q_varid, ZQCAM(:,:,:), start=start3d, count=count3d) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_get_att(ncid, q_varid, "scale_factor", scale) -status = nf90_get_att(ncid, q_varid, "add_offset", offset) -ZQCAM(:,:,:) = offset + scale * ZQCAM(:,:,:) -! -status = nf90_get_var(ncid, ps_varid, ZPSCAM(:,:), start=start2d, count=count2d) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_get_att(ncid, ps_varid, "scale_factor", scale) -status = nf90_get_att(ncid, ps_varid, "add_offset", offset) -ZPSCAM(:,:) = offset + scale * ZPSCAM(:,:) -!ZPSCAM(:,:) = EXP( ZPSCAM(:,:) ) -! -! Aerosol concentrations -! -status = nf90_get_var(ncid, mmr_dust1_varid, mmr_dust1(:,:,:), start=start3d, count=count3d) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_get_att(ncid, mmr_dust1_varid, "scale_factor", scale) -status = nf90_get_att(ncid, mmr_dust1_varid, "add_offset", offset) -mmr_dust1(:,:,:) = offset + scale * mmr_dust1(:,:,:) -! -status = nf90_get_var(ncid, mmr_dust2_varid, mmr_dust2(:,:,:), start=start3d, count=count3d) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_get_att(ncid, mmr_dust2_varid, "scale_factor", scale) -status = nf90_get_att(ncid, mmr_dust2_varid, "add_offset", offset) -mmr_dust2(:,:,:) = offset + scale * mmr_dust2(:,:,:) -! -status = nf90_get_var(ncid, mmr_dust3_varid, mmr_dust3(:,:,:), start=start3d, count=count3d) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_get_att(ncid, mmr_dust3_varid, "scale_factor", scale) -status = nf90_get_att(ncid, mmr_dust3_varid, "add_offset", offset) -mmr_dust3(:,:,:) = offset + scale * mmr_dust3(:,:,:) -! -! -status = nf90_get_var(ncid, mmr_seasalt1_varid, mmr_seasalt1(:,:,:), start=start3d, count=count3d) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_get_att(ncid, mmr_seasalt1_varid, "scale_factor", scale) -status = nf90_get_att(ncid, mmr_seasalt1_varid, "add_offset", offset) -mmr_seasalt1(:,:,:) = offset + scale * mmr_seasalt1(:,:,:) -! -status = nf90_get_var(ncid, mmr_seasalt2_varid, mmr_seasalt2(:,:,:), start=start3d, count=count3d) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_get_att(ncid, mmr_seasalt2_varid, "scale_factor", scale) -status = nf90_get_att(ncid, mmr_seasalt2_varid, "add_offset", offset) -mmr_seasalt2(:,:,:) = offset + scale * mmr_seasalt2(:,:,:) -! -status = nf90_get_var(ncid, mmr_seasalt3_varid, mmr_seasalt3(:,:,:), start=start3d, count=count3d) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_get_att(ncid, mmr_seasalt3_varid, "scale_factor", scale) -status = nf90_get_att(ncid, mmr_seasalt3_varid, "add_offset", offset) -mmr_seasalt3(:,:,:) = offset + scale * mmr_seasalt3(:,:,:) -! -! -status = nf90_get_var(ncid, mmr_bc_hydrophilic_varid, mmr_bc_hydrophilic(:,:,:), start=start3d, count=count3d) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_get_att(ncid, mmr_bc_hydrophilic_varid, "scale_factor", scale) -status = nf90_get_att(ncid, mmr_bc_hydrophilic_varid, "add_offset", offset) -mmr_bc_hydrophilic(:,:,:) = offset + scale * mmr_bc_hydrophilic(:,:,:) -! -status = nf90_get_var(ncid, mmr_bc_hydrophobic_varid, mmr_bc_hydrophobic(:,:,:), start=start3d, count=count3d) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_get_att(ncid, mmr_bc_hydrophobic_varid, "scale_factor", scale) -status = nf90_get_att(ncid, mmr_bc_hydrophobic_varid, "add_offset", offset) -mmr_bc_hydrophobic(:,:,:) = offset + scale * mmr_bc_hydrophobic(:,:,:) -! -! -status = nf90_get_var(ncid, mmr_oc_hydrophilic_varid, mmr_oc_hydrophilic(:,:,:), start=start3d, count=count3d) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_get_att(ncid, mmr_oc_hydrophilic_varid, "scale_factor", scale) -status = nf90_get_att(ncid, mmr_oc_hydrophilic_varid, "add_offset", offset) -mmr_oc_hydrophilic(:,:,:) = offset + scale * mmr_oc_hydrophilic(:,:,:) -! -status = nf90_get_var(ncid, mmr_oc_hydrophobic_varid, mmr_oc_hydrophobic(:,:,:), start=start3d, count=count3d) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_get_att(ncid, mmr_oc_hydrophobic_varid, "scale_factor", scale) -status = nf90_get_att(ncid, mmr_oc_hydrophobic_varid, "add_offset", offset) -mmr_oc_hydrophobic(:,:,:) = offset + scale * mmr_oc_hydrophobic(:,:,:) -! -! -status = nf90_get_var(ncid, mmr_sulfaer_varid, mmr_sulfaer(:,:,:), start=start3d, count=count3d) -if (status /= nf90_noerr) call handle_err(status) -status = nf90_get_att(ncid, mmr_sulfaer_varid, "scale_factor", scale) -status = nf90_get_att(ncid, mmr_sulfaer_varid, "add_offset", offset) -mmr_sulfaer(:,:,:) = offset + scale * mmr_sulfaer(:,:,:) -! -!-------------------------------------------------------------- -! -!* 3 Conversion of MACC or CAMS variables into LIMA variables -! ------------------------------------------------ -! -! initialise NSV_* variables -! cas simple : 3 modes de CCN (dont 1 actif par immersion), 2 modes IFN -! CCN1 : seasalt -! CCN2 : sulfates -! CCN3 (IMM) : hydrophilic OM and BC -! IFN1 : dust -! IFN2 : hydrophobic OM and BC -! -! XSV : Nc, Nr, 3 CCN free, 3 CCN activés, Ni, 2 IN free, 2 IN activé = 11 variables -! -! Concentrations en nombre par kilo ! -! -CCLOUD='LIMA' -NMOD_CCN=3 -LSCAV=.FALSE. -LAERO_MASS=.FALSE. -NMOD_IFN=2 -NMOD_IMM=1 -LHHONI=.FALSE. -HINI_CCN='AER' -HTYPE_CCN(1)='M' -HTYPE_CCN(2)='C' -HTYPE_CCN(3)='C' -! -! 3.1 initialize lima sv var. -! -! Always initialize chemical scheme variables before INI_NSV call ! -CALL CH_INIT_SCHEME_n(IMI,LUSECHAQ,LUSECHIC,LCH_PH,ILUOUT0,KVERB) -IF (LORILAM) THEN - CORGANIC = "MPMPO" - LVARSIGI = .TRUE. - LVARSIGJ = .TRUE. - CALL CH_AER_INIT_SOA(ILUOUT0, KVERB) -END IF -! -CALL INI_NSV(1) -DEALLOCATE(XSV_LS_LIMA) -ALLOCATE (XSV_LS_LIMA(IIU,IJU,levlen,NSV)) -XSV_LS_LIMA(:,:,:,:) = 0. -! -ALLOCATE(NINDICE_CCN_IMM(1)) -NINDICE_CCN_IMM(1)=3 -! -! Define work arrays -! -ALLOCATE(ZVALUE(levlen,KILEN)) -ALLOCATE(ZVALUE1D(KILEN)) -ALLOCATE(ZOUT(levlen,INO)) -ALLOCATE(ZOUT1D(INO)) -! -where (ZLONOUT(:) < 0.) ZLONOUT(:) = ZLONOUT(:) + 360. ! correct longitudes -! -! -! 3.2 Select CAMS/MACC mixing ratios and perform the horizontal interpolation -! -! Free CCN concentration (mode 1) -! -ZWORK(:,:,:)=mmr_seasalt1(:,:,:)+mmr_seasalt2(:,:,:)+mmr_seasalt3(:,:,:) -!!! ZWORK(:,:,:)=mmr_seasalt2(:,:,:) -!!!JPP ZWORK(:,:,:)=ZWORK(:,:,:)*1.E18/3620. -DO JK = 1, levlen - JLOOP1 = 0 - DO JJ = 1, latlen - ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZWORK(1:lonlen,JJ,JK) - JLOOP1 = JLOOP1 + lonlen - ENDDO - CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), & - latlen,kinlo,KILEN, & - ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, & - ZOUT(JK,:),.FALSE.,PTIME_HORI,.TRUE. ) - CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU,XSV_LS_LIMA(:,:,JK,NSV_LIMA_CCN_FREE)) -ENDDO -! -! Free CCN concentration (mode 2) -! -!!!JPP ZWORK(:,:,:)=mmr_sulfaer(:,:,:)*1.E18/345 -ZWORK(:,:,:)=mmr_sulfaer(:,:,:) -DO JK = 1, levlen - JLOOP1 = 0 - DO JJ = 1, latlen - ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZWORK(1:lonlen,JJ,JK) - JLOOP1 = JLOOP1 + lonlen - ENDDO - CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), & - latlen,kinlo,KILEN, & - ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, & - ZOUT(JK,:),.FALSE.,PTIME_HORI,.TRUE. ) - CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU,XSV_LS_LIMA(:,:,JK,NSV_LIMA_CCN_FREE + 1)) -ENDDO -! -! Free CCN concentration (mode 3, IMM) -! -!!!JPP ZWORK(:,:,:)=mmr_bc_hydrophilic(:,:,:)*1.E18/20. -!!!JPP ZWORK(:,:,:)=ZWORK(:,:,:) + mmr_oc_hydrophilic(:,:,:)*1.E18/16. -ZWORK(:,:,:)=mmr_bc_hydrophilic(:,:,:)+mmr_oc_hydrophilic(:,:,:) -DO JK = 1, levlen - JLOOP1 = 0 - DO JJ = 1, latlen - ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZWORK(1:lonlen,JJ,JK) - JLOOP1 = JLOOP1 + lonlen - ENDDO - CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), & - latlen,kinlo,KILEN, & - ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, & - ZOUT(JK,:),.FALSE.,PTIME_HORI,.TRUE. ) - CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU,XSV_LS_LIMA(:,:,JK,NSV_LIMA_CCN_FREE + 2)) -ENDDO -! -! Free IFN concentration (mode 1) -! -!!!JPP ZWORK(:,:,:)=mmr_dust2(:,:,:)*1.E18/(1204.*0.58) -!!!JPP ZWORK2(:,:,:)=max(0.,(mmr_dust3(:,:,:)*1.E18/1204.-2.4*ZWORK(:,:,:))/70.) -ZWORK(:,:,:)=mmr_dust1(:,:,:) + mmr_dust2(:,:,:) + mmr_dust3(:,:,:) -DO JK = 1, levlen - JLOOP1 = 0 - DO JJ = 1, latlen - ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZWORK(1:lonlen,JJ,JK) - JLOOP1 = JLOOP1 + lonlen - ENDDO - CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), & - latlen,kinlo,KILEN, & - ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, & - ZOUT(JK,:),.FALSE.,PTIME_HORI,.TRUE. ) - CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU,XSV_LS_LIMA(:,:,JK,NSV_LIMA_IFN_FREE)) -ENDDO -! -! Free IFN concentration (mode 2) -! -!!!JPP ZWORK(:,:,:)=mmr_bc_hydrophobic(:,:,:)*1.E18/20. -!!!JPP ZWORK(:,:,:)=ZWORK(:,:,:) + mmr_oc_hydrophobic(:,:,:)*1.E18/16. -ZWORK(:,:,:)=mmr_bc_hydrophobic(:,:,:)+mmr_oc_hydrophobic(:,:,:) -DO JK = 1, levlen - JLOOP1 = 0 - DO JJ = 1, latlen - ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZWORK(1:lonlen,JJ,JK) - JLOOP1 = JLOOP1 + lonlen - ENDDO - CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), & - latlen,kinlo,KILEN, & - ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, & - ZOUT(JK,:),.FALSE.,PTIME_HORI,.TRUE. ) - CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU,XSV_LS_LIMA(:,:,JK,NSV_LIMA_IFN_FREE + 1)) -ENDDO -! -! 3.3 Meteo ver. perform the horizontal interpolation -! -! Temperature (needed for the vertical interpolation) -! -DO JK = 1, levlen - JLOOP1 = 0 - DO JJ = 1, latlen - ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZTCAM(1:lonlen,JJ,JK) - JLOOP1 = JLOOP1 + lonlen - ENDDO - CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), & - latlen,kinlo,KILEN, & - ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, & - ZOUT(JK,:),.FALSE.,PTIME_HORI,.TRUE. ) - CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU,XT_SV_LS(:,:,JK)) -ENDDO ! levlen -! -! Spec. Humidity (needed for the vertical interpolation) -! -DO JK = 1, levlen - JLOOP1 = 0 - DO JJ = 1, latlen - ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZQCAM(1:lonlen,JJ,JK) - JLOOP1 = JLOOP1 + lonlen - ENDDO - CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), & - latlen,kinlo,KILEN, & - ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, & - ZOUT(JK,:),.FALSE.,PTIME_HORI,.TRUE. ) - CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU,XQ_SV_LS(:,:,JK,1)) -ENDDO ! levlen -! -! Surface pressure (needed for the vertical interpolation) -! -JLOOP1 = 0 -DO JJ = 1, latlen - ZVALUE1D(JLOOP1+1:JLOOP1+lonlen) = ZPSCAM(1:lonlen,JJ) - JLOOP1 = JLOOP1 + lonlen -ENDDO -CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), & - latlen,kinlo,KILEN, & - ZVALUE1D(:),INO,ZLONOUT,ZLATOUT, & - ZOUT1D(:),.FALSE.,PTIME_HORI,.TRUE. ) -CALL ARRAY_1D_TO_2D(INO,ZOUT1D(:),IIU,IJU,XPS_SV_LS(:,:)) -! -! 3.4 Correct negative values produced by the horizontal interpolations -! -XSV_LS_LIMA(:,:,:,:) = MAX(XSV_LS_LIMA(:,:,:,:),0.) -XPS_SV_LS(:,:) = MAX(XPS_SV_LS(:,:),0.) -XT_SV_LS(:,:,:) = MAX(XT_SV_LS(:,:,:),0.) -XQ_SV_LS(:,:,:,1) = MAX(XQ_SV_LS(:,:,:,1),0.) -! -! 3.5 If Netcdf vertical levels have to be reversed : -! -ALLOCATE(TMP1(levlen)) -ALLOCATE(TMP2(levlen)) -ALLOCATE(TMP3(IIU,IJU,levlen)) -ALLOCATE(TMP4(IIU,IJU,levlen,NRR)) -ALLOCATE(TMP5(IIU,IJU,levlen,NSV)) -DO JJ=1,levlen - ! inv. lev - TMP1(JJ) = XA_SV_LS(levlen+1-JJ) - TMP2(JJ) = XB_SV_LS(levlen+1-JJ) - TMP3(:,:,JJ) = XT_SV_LS(:,:,levlen+1-JJ) - TMP4(:,:,JJ,:) = XQ_SV_LS(:,:,levlen+1-JJ,:) - TMP5(:,:,JJ,:) = XSV_LS(:,:,levlen+1-JJ,:) -ENDDO -XA_SV_LS(:) = TMP1(:) -XB_SV_LS(:) = TMP2(:) -XT_SV_LS(:,:,:) = TMP3(:,:,:) -XQ_SV_LS(:,:,:,:) = TMP4(:,:,:,:) -XSV_LS(:,:,:,:) = TMP5(:,:,:,:) -DEALLOCATE(TMP1) -DEALLOCATE(TMP2) -DEALLOCATE(TMP3) -DEALLOCATE(TMP4) -DEALLOCATE(TMP5) -! -! 3.6 close the netcdf file -! -status = nf90_close(ncid) -if (status /= nf90_noerr) call handle_err(status) -! -DEALLOCATE (ZVALUE) -DEALLOCATE (ZOUT) -!! -!------------------------------------------------------------- -! -!* 4. VERTICAL GRID -! ------------- -! -! 4.1 Read VERTICAL GRID -! -WRITE (ILUOUT0,'(A)') ' | Reading of vertical grid in progress' -CALL READ_VER_GRID(TPPRE_REAL1) -! -!-------------------------------------------------------------- -! -! 5. Free all temporary allocations -! ------------------------------ -! -DEALLOCATE (ZLATOUT) -DEALLOCATE (ZLONOUT) -DEALLOCATE (count3d) -DEALLOCATE (start3d) -DEALLOCATE (count2d) -DEALLOCATE (start2d) -! -DEALLOCATE (lats) -DEALLOCATE (lons) -DEALLOCATE (levs) -!DEALLOCATE (time) -!DEALLOCATE (a) -!DEALLOCATE (b) -! ps, T, Q : -DEALLOCATE (ZPSCAM) -DEALLOCATE (ZTCAM) -DEALLOCATE (ZQCAM) -! -DEALLOCATE (mmr_dust1) -DEALLOCATE (mmr_dust2) -DEALLOCATE (mmr_dust3) -! -DEALLOCATE (mmr_seasalt1) -DEALLOCATE (mmr_seasalt2) -DEALLOCATE (mmr_seasalt3) -! -DEALLOCATE (mmr_bc_hydrophilic) -DEALLOCATE (mmr_bc_hydrophobic) -! -DEALLOCATE (mmr_oc_hydrophilic) -DEALLOCATE (mmr_oc_hydrophobic) -! -DEALLOCATE (mmr_sulfaer) -! -DEALLOCATE (ZWORK) -! -WRITE (ILUOUT0,'(A,A4,A)') ' -- netcdf decoder for ',HFILE,' file ended successfully' -WRITE (ILUOUT0,'(A,A4,A)') 'MACC mixing ratios are interpolated horizontally' -! -! -CONTAINS -! -! ############################# - SUBROUTINE HANDLE_ERR(STATUS) -! ############################# - INTEGER(KIND=CDFINT) STATUS - IF (STATUS .NE. NF90_NOERR) THEN - PRINT *, NF90_STRERROR(STATUS) - STOP 'Stopped' - ENDIF - END SUBROUTINE HANDLE_ERR -! -! -! ############################################# - SUBROUTINE ARRAY_1D_TO_2D (KN1,P1,KL1,KL2,P2) -! ############################################# -! -! Small routine used to store a linear array into a 2 dimension array -! -USE MODE_MSG -IMPLICIT NONE -INTEGER, INTENT(IN) :: KN1 -REAL,DIMENSION(KN1), INTENT(IN) :: P1 -INTEGER, INTENT(IN) :: KL1 -INTEGER, INTENT(IN) :: KL2 -REAL,DIMENSION(KL1,KL2),INTENT(OUT) :: P2 -INTEGER :: JLOOP1_A1T2 -INTEGER :: JLOOP2_A1T2 -INTEGER :: JPOS_A1T2 -! -IF (KN1 < KL1*KL2) THEN - CALL PRINT_MSG(NVERB_FATAL,'GEN','ARRAY_1D_TO_2D','sizes do not match') -END IF -JPOS_A1T2 = 1 -DO JLOOP2_A1T2 = 1, KL2 - DO JLOOP1_A1T2 = 1, KL1 - P2(JLOOP1_A1T2,JLOOP2_A1T2) = P1(JPOS_A1T2) - JPOS_A1T2 = JPOS_A1T2 + 1 - END DO -END DO -END SUBROUTINE ARRAY_1D_TO_2D -! -END SUBROUTINE READ_LIMA_DATA_NETCDF_CASE diff --git a/src/ICCARE_BASE/read_nam_pgd_chemistry.F90 b/src/ICCARE_BASE/read_nam_pgd_chemistry.F90 deleted file mode 100644 index 97115b11a..000000000 --- a/src/ICCARE_BASE/read_nam_pgd_chemistry.F90 +++ /dev/null @@ -1,120 +0,0 @@ -!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -! ######### - SUBROUTINE READ_NAM_PGD_CHEMISTRY(HPROGRAM, HCH_EMIS, HCH_BIOEMIS, HCH_DMSEMIS) -! ############################################################## -! -!!**** *READ_NAM_PGD_CHEMISTRY* reads namelist for CHEMISTRY -!! -!! PURPOSE -!! ------- -!! -!! METHOD -!! ------ -!! -! -!! EXTERNAL -!! -------- -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! REFERENCE -!! --------- -!! -!! AUTHOR -!! ------ -!! -!! S. Queguiner Meteo-France -!! -!! MODIFICATION -!! ------------ -!! -!! Original 09/2011 -!! M. Leriche 06/17 add coupling MEGAN -!! P. Tulet 06/21 add DMS data base -!---------------------------------------------------------------------------- -! -!* 0. DECLARATION -! ----------- -! -! -USE MODI_GET_LUOUT -USE MODI_OPEN_NAMELIST -USE MODI_CLOSE_NAMELIST -USE MODI_TEST_NAM_VAR_SURF -! -USE MODE_POS_SURF -! -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -IMPLICIT NONE -! -!* 0.1 Declaration of arguments -! ------------------------ -! -CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program -CHARACTER(LEN=4), INTENT(OUT) :: HCH_EMIS ! Option for emissions computations -CHARACTER(LEN=4), INTENT(OUT) :: HCH_BIOEMIS ! Option for activating MEGAN coupling -CHARACTER(LEN=4), INTENT(OUT) :: HCH_DMSEMIS ! Option for activating DMS fluxes -! -!* 0.2 Declaration of local variables -! ------------------------------ -! -INTEGER :: ILUOUT ! output listing logical unit -INTEGER :: ILUNAM ! namelist file logical unit -LOGICAL :: GFOUND ! flag when namelist is present -! -!* 0.3 Declaration of namelists -! ------------------------ -! -CHARACTER(LEN=4) :: CCH_EMIS -CHARACTER(LEN=4) :: CCH_BIOEMIS -CHARACTER(LEN=4) :: CCH_DMSEMIS -REAL(KIND=JPRB) :: ZHOOK_HANDLE -! -NAMELIST/NAM_CH_EMISSIONS/ CCH_EMIS, CCH_BIOEMIS, CCH_DMSEMIS -! -!------------------------------------------------------------------------------- -! -!* 1. Initializations of defaults -! --------------------------- -! -IF (LHOOK) CALL DR_HOOK('READ_NAM_PGD_CHEMISTRY',0,ZHOOK_HANDLE) -CCH_EMIS = 'NONE' -CCH_BIOEMIS = 'NONE' -CCH_DMSEMIS = 'NONE' -! - CALL GET_LUOUT(HPROGRAM,ILUOUT) -! -!------------------------------------------------------------------------------- -! -!* 2. Reading of namelist -! ------------------- -! -CALL OPEN_NAMELIST(HPROGRAM,ILUNAM) -! -CALL POSNAM(ILUNAM,'NAM_CH_EMISSIONS',GFOUND,ILUOUT) -IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_CH_EMISSIONS) -! -CALL TEST_NAM_VAR_SURF(ILUOUT,'CCH_EMIS',CCH_EMIS,'NONE','AGGR','SNAP') -CALL TEST_NAM_VAR_SURF(ILUOUT,'CCH_BIOEMIS',CCH_BIOEMIS,'NONE','MEGA') -CALL TEST_NAM_VAR_SURF(ILUOUT,'CCH_DMSEMIS',CCH_DMSEMIS,'NONE','DMSD') -! -CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM) -! -!------------------------------------------------------------------------------- -! -HCH_EMIS = CCH_EMIS -HCH_BIOEMIS = CCH_BIOEMIS -HCH_DMSEMIS = CCH_DMSEMIS -! -IF (LHOOK) CALL DR_HOOK('READ_NAM_PGD_CHEMISTRY',1,ZHOOK_HANDLE) -! -!------------------------------------------------------------------------------- -! -END SUBROUTINE READ_NAM_PGD_CHEMISTRY diff --git a/src/ICCARE_BASE/read_nam_pgd_dms.F90 b/src/ICCARE_BASE/read_nam_pgd_dms.F90 deleted file mode 100644 index 2cccb4f88..000000000 --- a/src/ICCARE_BASE/read_nam_pgd_dms.F90 +++ /dev/null @@ -1,154 +0,0 @@ -!SURFEX_LIC Copyright 1994-2014 Meteo-France -!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SURFEX_LIC for details. version 1. -! ######### - SUBROUTINE READ_NAM_PGD_DMS(HPROGRAM, KDMS_NBR, HDMS_NAME, HDMS_AREA, & - HDMS_ATYPE, HDMS_FILE, HDMS_FILETYPE ) -! ############################################################## -! -!!**** *READ_NAM_PGD_DMS* reads namelist NAM_DMS_PGD -!! -!! PURPOSE -!! ------- -!! -!! METHOD -!! ------ -!! -! -!! EXTERNAL -!! -------- -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! REFERENCE -!! --------- -!! -!! AUTHOR -!! ------ -!! -!! P. Tulet *LAERO* -!! -!! MODIFICATION -!! ------------ -!! -!! Original 06/2021 -!! -!---------------------------------------------------------------------------- -! -!* 0. DECLARATION -! ----------- -! -USE MODI_GET_LUOUT -USE MODI_OPEN_NAMELIST -USE MODI_CLOSE_NAMELIST -! -USE MODE_POS_SURF -! -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -IMPLICIT NONE -! -!* 0.1 Declaration of arguments -! ------------------------ -! - CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program -INTEGER, INTENT(OUT) :: KDMS_NBR -! ! number of megan pgd fields chosen by user - CHARACTER(LEN=20), DIMENSION(1000), INTENT(OUT) :: HDMS_NAME -! ! name of the megan pgd fields (for information) - CHARACTER(LEN=3), DIMENSION(1000), INTENT(OUT) :: HDMS_AREA -! ! areas where megan pgd fields are defined -! ! 'ALL' : everywhere -! ! 'SEA' : where sea exists -! ! 'LAN' : where land exists -! ! 'WAT' : where inland water exists -! ! 'NAT' : where natural or agricultural areas exist -! ! 'TWN' : where town areas exist -! ! 'STR' : where streets are present -! ! 'BLD' : where buildings are present - CHARACTER(LEN=3), DIMENSION(1000), INTENT(OUT) :: HDMS_ATYPE ! avg type for megan pgd fields -! ! 'ARI' , 'INV' - CHARACTER(LEN=28), DIMENSION(1000), INTENT(OUT) :: HDMS_FILE ! data files - CHARACTER(LEN=6), DIMENSION(1000), INTENT(OUT) :: HDMS_FILETYPE ! type of these files -! -! -!* 0.2 Declaration of local variables -! ------------------------------ -! -INTEGER :: ILUOUT ! output listing logical unit -INTEGER :: ILUNAM ! namelist file logical unit -LOGICAL :: GFOUND ! flag when namelist is present -! -!* 0.3 Declaration of namelists -! ------------------------ -! -INTEGER :: NDMS_NBR -! ! number of megan pgd fields chosen by user - CHARACTER(LEN=20), DIMENSION(1000) :: CDMS_NAME -! ! name of the megan pgd fields (for information) - CHARACTER(LEN=3), DIMENSION(1000) :: CDMS_AREA -! ! areas where megan pgd fields are defined -! ! 'ALL' : everywhere -! ! 'SEA' : where sea exists -! ! 'LAN' : where land exists -! ! 'WAT' : where inland water exists -! ! 'NAT' : where natural or agricultural areas exist -! ! 'TWN' : where town areas exist -! ! 'STR' : where streets are present -! ! 'BLD' : where buildings are present - CHARACTER(LEN=3), DIMENSION(1000) :: CDMS_ATYPE ! avg type for megan pgd fields -! ! 'ARI' , 'INV' - CHARACTER(LEN=28), DIMENSION(1000) :: CDMS_FILE ! data files - CHARACTER(LEN=6), DIMENSION(1000) :: CDMS_FILETYPE ! type of these files -REAL(KIND=JPRB) :: ZHOOK_HANDLE -! -NAMELIST/NAM_DMS_PGD/ NDMS_NBR, CDMS_NAME, CDMS_AREA, & - CDMS_ATYPE, CDMS_FILE, CDMS_FILETYPE -!------------------------------------------------------------------------------- -! -!* 1. Initializations of defaults -! --------------------------- -! -IF (LHOOK) CALL DR_HOOK('READ_NAM_PGD_DMS',0,ZHOOK_HANDLE) -NDMS_NBR = 0 -! -CDMS_NAME = " " -CDMS_FILE = " " -CDMS_FILETYPE = " " -CDMS_AREA = "ALL" -CDMS_ATYPE = "ARI" -! - CALL GET_LUOUT(HPROGRAM,ILUOUT) -! -!------------------------------------------------------------------------------- -! -!* 2. Reading of namelist -! ------------------- -! - CALL OPEN_NAMELIST(HPROGRAM,ILUNAM) -! - CALL POSNAM(ILUNAM,'NAM_DMS_PGD',GFOUND,ILUOUT) -IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_DMS_PGD) -! - CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM) -! -!------------------------------------------------------------------------------- -! -!* 3. Fills output arguments -! ---------------------- -! -KDMS_NBR = NDMS_NBR -HDMS_NAME(:) = CDMS_NAME(:) -HDMS_AREA(:) = CDMS_AREA(:) -HDMS_ATYPE(:) = CDMS_ATYPE(:) -HDMS_FILE(:) = CDMS_FILE(:) -HDMS_FILETYPE(:) = CDMS_FILETYPE(:) -IF (LHOOK) CALL DR_HOOK('READ_NAM_PGD_DMS',1,ZHOOK_HANDLE) -! -!------------------------------------------------------------------------------- -! -END SUBROUTINE READ_NAM_PGD_DMS diff --git a/src/ICCARE_BASE/resolved_cloud.f90 b/src/ICCARE_BASE/resolved_cloud.f90 deleted file mode 100644 index dce56fa74..000000000 --- a/src/ICCARE_BASE/resolved_cloud.f90 +++ /dev/null @@ -1,1105 +0,0 @@ -!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!----------------------------------------------------------------- -! ########################## - MODULE MODI_RESOLVED_CLOUD -! ########################## -INTERFACE - SUBROUTINE RESOLVED_CLOUD ( HCLOUD, HACTCCN, HSCONV, HMF_CLOUD, & - KRR, KSPLITR, KSPLITG, KMI, KTCOUNT, & - HLBCX, HLBCY, TPFILE, HRAD, HTURBDIM, & - OSUBG_COND, OSIGMAS, HSUBG_AUCV, & - PTSTEP, PZZ, PRHODJ, PRHODREF, PEXNREF, & - PPABST, PTHT, PRT, PSIGS, PSIGQSAT, PMFCONV, & - PTHM, PRCM, PPABSM, & - PW_ACT,PDTHRAD, PTHS, PRS, PSVT, PSVS, PSRCS, PCLDFR,& - PCIT, OSEDIC, OACTIT, OSEDC, OSEDI, & - ORAIN, OWARM, OHHONI, OCONVHG, & - PCF_MF,PRC_MF, PRI_MF, & - PINPRC,PINPRC3D,PINPRR,PINPRR3D, PEVAP3D, & - PINPRS,PINPRS3D,PINPRG,PINPRG3D,PINPRH,PINPRH3D, & - PSOLORG,PMI, & - PSPEEDC, PSPEEDR, PSPEEDS, PSPEEDG, PSPEEDH, & - PINDEP, PSUPSAT, PNACT, PNPRO,PSSPRO, PRAINFR, & - PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, & - PSEA,PTOWN ) -! -USE MODD_IO, ONLY: TFILEDATA -! -CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! kind of cloud -CHARACTER(LEN=4), INTENT(IN) :: HACTCCN ! kind of CCN activation scheme - ! paramerization -CHARACTER(LEN=4), INTENT(IN) :: HSCONV ! Shallow convection scheme -CHARACTER(LEN=4), INTENT(IN) :: HMF_CLOUD! Type of statistical cloud -INTEGER, INTENT(IN) :: KRR ! Number of moist variables -INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step - ! integrations for rain sedimendation -INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step - ! integrations for ice sedimendation -INTEGER, INTENT(IN) :: KMI ! Model index -INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter -CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type -TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file -CHARACTER(len=4), INTENT(IN) :: HRAD ! Radiation scheme name -CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! Dimensionality of the - ! turbulence scheme -LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid Cond. -LOGICAL, INTENT(IN) :: OSIGMAS ! Switch for Sigma_s: - ! use values computed in CONDENSATION - ! or that from turbulence scheme -CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV - ! Kind of Subgrid autoconversion method -REAL, INTENT(IN) :: PTSTEP ! Time step :XTSTEP in namelist -! -! -REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z) -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ !Dry density * Jacobian -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference dry air density -REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function -! -! -REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t -REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t -REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PRT ! Moist variables at time t -REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t -REAL, INTENT(IN) :: PSIGQSAT! coeff applied to qsat variance contribution -REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux -REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-Dt -REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Pressure time t-Dt -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at time t-Dt -! -! -REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_ACT ! W for CCN activation -REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD! THeta RADiative Tendancy -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source -REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variable sources -REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Scalar variable at time t -REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Scalar variable sources -! -! -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux - ! s'rc'/2Sigma_s2 at time t+1 - ! multiplied by Lambda_3 -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR! Cloud fraction -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice number - ! concentration at time t -LOGICAL, INTENT(IN) :: OSEDIC! Switch to activate the - ! cloud droplet sedimentation - ! for ICE3 -LOGICAL, INTENT(IN) :: OACTIT ! Switch to activate the - ! activation through temp. - ! evolution in C2R2 and KHKO -LOGICAL, INTENT(IN) :: OSEDC ! Switch to activate the - ! cloud droplet sedimentation - ! for C2R2 or KHKO -LOGICAL, INTENT(IN) :: OSEDI ! Switch to activate the - ! cloud crystal sedimentation -LOGICAL, INTENT(IN) :: ORAIN ! Switch to activate the - ! raindrop formation -LOGICAL, INTENT(IN) :: OWARM ! Control of the rain formation - ! by slow warm microphysical - ! processes -LOGICAL, INTENT(IN) :: OHHONI! enable haze freezing -LOGICAL, INTENT(IN) :: OCONVHG! Switch for conversion from - ! hail to graupel -! -REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI_MF! Convective Mass Flux solid mixing ratio -! -REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip -REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! sed flux of precip -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! evap profile -REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip -REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip -REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRH ! Hail instant precip -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRC3D ! sed flux of precip -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRS3D ! sed flux of precip -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRG3D ! sed flux of precip -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRH3D ! sed flux of precip -REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSOLORG ![%] solubility fraction of soa -REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PMI -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDC ! Cloud sedimentation speed -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDR ! Rain sedimentation speed -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDS ! Snow sedimentation speed -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDG ! Graupel sedimentation speed -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDH ! Hail sedimentation speed -REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud instant deposition -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSUPSAT !sursat -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNACT !concentrtaion d'aérosols activés au temps t -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNPRO !concentrtaion d'aérosols activés au temps t -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSSPRO !sursat -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR ! Rain fraction -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HRC !HighLow liquid content -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HCF !HighLow liquid cloud fraction -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HRI !HighLow ice content -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HCF !HighLow ice clous fraction -REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land Sea mask -REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction -! -END SUBROUTINE RESOLVED_CLOUD -END INTERFACE -END MODULE MODI_RESOLVED_CLOUD -! -! ########################################################################## - SUBROUTINE RESOLVED_CLOUD ( HCLOUD, HACTCCN, HSCONV, HMF_CLOUD, & - KRR, KSPLITR, KSPLITG, KMI, KTCOUNT, & - HLBCX, HLBCY, TPFILE, HRAD, HTURBDIM, & - OSUBG_COND, OSIGMAS, HSUBG_AUCV, & - PTSTEP, PZZ, PRHODJ, PRHODREF, PEXNREF, & - PPABST, PTHT, PRT, PSIGS, PSIGQSAT, PMFCONV, & - PTHM, PRCM, PPABSM, & - PW_ACT,PDTHRAD, PTHS, PRS, PSVT, PSVS, PSRCS, PCLDFR,& - PCIT, OSEDIC, OACTIT, OSEDC, OSEDI, & - ORAIN, OWARM, OHHONI, OCONVHG, & - PCF_MF,PRC_MF, PRI_MF, & - PINPRC,PINPRC3D,PINPRR,PINPRR3D, PEVAP3D, & - PINPRS,PINPRS3D,PINPRG,PINPRG3D,PINPRH,PINPRH3D, & - PSOLORG,PMI, & - PSPEEDC, PSPEEDR, PSPEEDS, PSPEEDG, PSPEEDH, & - PINDEP, PSUPSAT, PNACT, PNPRO,PSSPRO, PRAINFR, & - PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, & - PSEA,PTOWN ) -! ########################################################################## -! -!!**** * - compute the resolved clouds and precipitation -!! -!! PURPOSE -!! ------- -!! The purpose of this routine is to compute the microphysical sources -!! related to the resolved clouds and precipitation -!! -!! -!!** METHOD -!! ------ -!! The main actions of this routine is to call the routines computing the -!! microphysical sources. Before that: -!! - it computes the real absolute pressure, -!! - negative values of the current guess of all mixing ratio are removed. -!! This is done by a global filling algorithm based on a multiplicative -!! method (Rood, 1987), in order to conserved the total mass in the -!! simulation domain. -!! - Sources are transformed in physical tendencies, by removing the -!! multiplicative term Rhod*J. -!! - External points values are filled owing to the use of cyclic -!! l.b.c., in order to performe computations on the full domain. -!! After calling to microphysical routines, the physical tendencies are -!! switched back to prognostic variables. -!! -!! -!! EXTERNAL -!! -------- -!! Subroutine SLOW_TERMS: Computes the explicit microphysical sources -!! Subroutine FAST_TERMS: Performs the saturation adjustment for l -!! Subroutine RAIN_ICE : Computes the explicit microphysical sources for i -!! Subroutine ICE_ADJUST: Performs the saturation adjustment for i+l -!! MIN_ll,SUM3D_ll : distributed functions equivalent to MIN and SUM -!! -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! Module MODD_PARAMETERS : contains declarations of parameter variables -!! JPHEXT : Horizontal external points number -!! JPVEXT : Vertical external points number -!! Module MODD_CST -!! XP00 ! Reference pressure -!! XRD ! Gaz constant for dry air -!! XCPD ! Cpd (dry air) -!! -!! REFERENCE -!! --------- -!! -!! Book1 and book2 of documentation ( routine RESOLVED_CLOUD ) -!! -!! AUTHOR -!! ------ -!! E. Richard * Laboratoire d'Aerologie* -!! -!! MODIFICATIONS -!! ------------- -!! Original 21/12/94 -!! Modifications: June 8, 1995 ( J.Stein ) -!! Cleaning to improve efficienty and clarity -!! in agreement with the MESO-NH coding norm -!! March 1, 1996 ( J.Stein ) -!! store the cloud fraction -!! March 18, 1996 ( J.Stein ) -!! check that ZMASSPOS /= 0 -!! Oct. 12, 1996 ( J.Stein ) -!! remove the negative values correction -!! for the KES2 case -!! Modifications: Dec 14, 1995 (J.-P. Pinty) -!! Add the mixed-phase option -!! Modifications: Jul 01, 1996 (J.-P. Pinty) -!! Change arg. list in routine FAST_TERMS -!! Modifications: Jan 27, 1997 (J.-P. Pinty) -!! add W and SV in arg. list -!! Modifications: March 23, 98 (E.Richard) -!! correction of negative value based on -!! rv+rc+ri and thetal or thetail conservation -!! Modifications: April 08, 98 (J.-P. Lafore and V. Ducrocq ) -!! modify the correction of negative values -!! Modifications: June 08, 00 (J.-P. Pinty and J.-M. Cohard) -!! add the C2R2 scheme -!! Modifications: April 08, 01 (J.-P. Pinty) -!! add the C3R5 scheme -!! Modifications: July 21, 01 (J.-P. Pinty) -!! Add OHHONI and PW_ACT (for haze freezing) -!! Modifications: Sept 21, 01 (J.-P. Pinty) -!! Add XCONC_CCN limitation -!! Modifications: Nov 21, 02 (J.-P. Pinty) -!! Add ICE4 and C3R5 options -!! June, 2005 (V. Masson) -!! Technical change in interface for scalar arguments -!! Modifications : March, 2006 (O.Geoffroy) -!! Add KHKO scheme -!! Modifications : March 2013 (O.Thouron) -!! Add prognostic supersaturation -!! July, 2015 (O.Nuissier/F.Duffourg) Add microphysics diagnostic for -!! aircraft, ballon and profiler -!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1 -!! M.Mazoyer : 04/2016 : Temperature radiative tendency used for -!! activation by cooling (OACTIT) -!! Modification 01/2016 (JP Pinty) Add LIMA -!! 10/2016 M.Mazoyer New KHKO output fields -!! 10/2016 (C.Lac) Add droplet deposition -!! S.Riette : 11/2016 : ice_adjust before and after rain_ice -!! ICE3/ICE4 modified, old version under LRED=F -! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O -! P. Wautelet 01/02/2019: ZRSMIN is now allocatable (instead of size of XRTMIN which was sometimes not allocated) -! C. Lac 02/2019: add rain fraction as an output field -! P. Wautelet 02/2020: use the new data structures and subroutines for budgets -! B. Vie 03/2020: LIMA negativity checks after turbulence, advection and microphysics budgets -! B. Vie 03/03/2020: use DTHRAD instead of dT/dt in Smax diagnostic computation -! P. Wautelet 11/06/2020: bugfix: correct ZSVS array indices -! P. Wautelet 11/06/2020: bugfix: add "Non local correction for precipitating species" for ICE4 -! P. Wautelet + Benoit Vié 06/2020: improve removal of negative scalar variables + adapt the corresponding budgets -! P. Wautelet 23/06/2020: remove ZSVS and ZSVT to improve code readability -! P. Wautelet 30/06/2020: move removal of negative scalar variables to Sources_neg_correct -! P. Wautelet 30/06/2020: remove non-local corrections -! B. Vie 06/2020: add prognostic supersaturation for LIMA -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -USE MODD_CH_AEROSOL, ONLY: LORILAM -USE MODD_DUST, ONLY: LDUST -use modd_cst, only: xcpd, xrd, xp00, xrholw -USE MODD_IO, ONLY: TFILEDATA -!UPG*PT -USE MODD_NSV -!USE MODD_NSV, ONLY: NSV_C1R3END, NSV_C2R2BEG, NSV_C2R2END, & -! NSV_LIMA_BEG, NSV_LIMA_END, NSV_LIMA_CCN_FREE, NSV_LIMA_IFN_FREE, & -! NSV_LIMA_NC, NSV_LIMA_NI, NSV_LIMA_NR -! NSV_LIMA_NC, NSV_LIMA_NI, NSV_LIMA_NR -!UPG*PT -USE MODD_PARAM_C2R2, ONLY: LSUPSAT -USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT -USE MODD_PARAM_ICE, ONLY: CSEDIM, LADJ_BEFORE, LADJ_AFTER, CFRAC_ICE_ADJUST, LRED -USE MODD_PARAM_LIMA, ONLY: LADJ, LCOLD, LPTSPLIT, LSPRO, NMOD_CCN, NMOD_IFN, NMOD_IMM -USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN -USE MODD_SALT, ONLY: LSALT -USE MODD_TURB_n, ONLY: CSUBG_AUCV_RI, CCONDENS, CLAMBDA3, CSUBG_MF_PDF -! -USE MODE_ll -use mode_sources_neg_correct, only: Sources_neg_correct -! -USE MODI_C2R2_ADJUST -USE MODI_FAST_TERMS -USE MODI_GET_HALO -USE MODI_ICE_ADJUST -USE MODI_KHKO_NOTADJUST -USE MODI_LIMA -USE MODI_LIMA_ADJUST -USE MODI_LIMA_ADJUST_SPLIT -USE MODI_LIMA_COLD -USE MODI_LIMA_MIXED -USE MODI_LIMA_NOTADJUST -USE MODI_LIMA_WARM -USE MODI_RAIN_C2R2_KHKO -USE MODI_RAIN_ICE -USE MODI_RAIN_ICE_RED -USE MODI_SHUMAN -USE MODI_SLOW_TERMS -!UPG*PT -USE MODI_AER2LIMA -!UPG*PT -! -IMPLICIT NONE -! -!* 0.1 Declarations of dummy arguments : -! -! -! -CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! kind of cloud paramerization -CHARACTER(LEN=4), INTENT(IN) :: HACTCCN ! kind of CCN activation scheme -CHARACTER(LEN=4), INTENT(IN) :: HSCONV ! Shallow convection scheme -CHARACTER(LEN=4), INTENT(IN) :: HMF_CLOUD! Type of statistical cloud -INTEGER, INTENT(IN) :: KRR ! Number of moist variables -INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step - ! integrations for rain sedimendation -INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step - ! integrations for ice sedimendation -INTEGER, INTENT(IN) :: KMI ! Model index -INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop counter -CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type -TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file -CHARACTER(len=4), INTENT(IN) :: HRAD ! Radiation scheme name -CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! Dimensionality of the - ! turbulence scheme -LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid Cond. -LOGICAL, INTENT(IN) :: OSIGMAS ! Switch for Sigma_s: - ! use values computed in CONDENSATION - ! or that from turbulence scheme -CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV - ! Kind of Subgrid autoconversion method -REAL, INTENT(IN) :: PTSTEP ! Time step :XTSTEP in namelist -! -! -REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z) -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ !Dry density * Jacobian -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference dry air density -REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function -! -! -REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t -REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t -REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PRT ! Moist variables at time t -REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t -REAL, INTENT(IN) :: PSIGQSAT! coeff applied to qsat variance contribution -REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux -REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM ! Theta at time t-Dt -REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Pressure time t-Dt -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at time t-Dt -! -! -REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_ACT ! W for CCN activation -REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD! THeta RADiative Tendancy -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source -REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Moist variable sources -REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Scalar variable at time t -REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Scalar variable sources -! -! -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux - ! s'rc'/2Sigma_s2 at time t+1 - ! multiplied by Lambda_3 -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR! Cloud fraction -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice number - ! concentration at time t -LOGICAL, INTENT(IN) :: OSEDIC! Switch to activate the - ! cloud droplet sedimentation - ! for ICE3 -LOGICAL, INTENT(IN) :: OACTIT ! Switch to activate the - ! activation through temp. - ! evolution in C2R2 and KHKO -LOGICAL, INTENT(IN) :: OSEDC ! Switch to activate the - ! cloud droplet sedimentation -LOGICAL, INTENT(IN) :: OSEDI ! Switch to activate the - ! cloud crystal sedimentation -LOGICAL, INTENT(IN) :: ORAIN ! Switch to activate the - ! raindrop formation -LOGICAL, INTENT(IN) :: OWARM ! Control of the rain formation - ! by slow warm microphysical - ! processes -LOGICAL, INTENT(IN) :: OHHONI! enable haze freezing -LOGICAL, INTENT(IN) :: OCONVHG! Switch for conversion from - ! hail to graupel -! -REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI_MF! Convective Mass Flux solid mixing ratio -! -REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRC ! Cloud instant precip -REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRR ! Rain instant precip -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRR3D ! sed flux of precip -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PEVAP3D ! evap profile -REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip -REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip -REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRH ! Hail instant precip -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRC3D ! sed flux of precip -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRS3D ! sed flux of precip -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRG3D ! sed flux of precip -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINPRH3D ! sed flux of precip -REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSOLORG ![%] solubility fraction of soa -REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PMI -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDC ! Cloud sedimentation speed -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDR ! Rain sedimentation speed -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDS ! Snow sedimentation speed -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDG ! Graupel sedimentation speed -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSPEEDH ! Hail sedimentation speed -REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud instant deposition -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSUPSAT !sursat -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNACT !concentrtaion d'aérosols activés au temps t -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNPRO !concentrtaion d'aérosols activés au temps t -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSSPRO !sursat -REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR ! Rain fraction -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HRC !HighLow liquid content -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HCF !HighLow liquid cloud fraction -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HRI !HighLow ice content -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HCF !HighLow ice clous fraction -REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land Sea mask -REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction -! -! -!* 0.2 Declarations of local variables : -! -INTEGER :: JRR,JSV ! Loop index for the moist and scalar variables -INTEGER :: IIB ! Define the physical domain -INTEGER :: IIE ! -INTEGER :: IJB ! -INTEGER :: IJE ! -INTEGER :: IKB ! -INTEGER :: IKE ! -INTEGER :: IKU -INTEGER :: IINFO_ll ! return code of parallel routine - -INTEGER :: JK,JI,JL,II -! -! -! -REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZDZZ -real, dimension(:,:,:), allocatable :: ZEXN -REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZZZ - ! model layer height -! REAL :: ZMASSTOT ! total mass for one water category -! ! including the negative values -! REAL :: ZMASSPOS ! total mass for one water category -! ! after removing the negative values -! REAL :: ZRATIO ! ZMASSTOT / ZMASSCOR -! -INTEGER :: ISVBEG ! first scalar index for microphysics -INTEGER :: ISVEND ! last scalar index for microphysics -REAL, DIMENSION(:), ALLOCATABLE :: ZRSMIN ! Minimum value for tendencies -!UPG*PT -REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSVT ! scalar variable for microphysics only -!UPG*PT - -LOGICAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: LLMICRO ! mask to limit computation -REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3), KRR) :: ZFPR -! -INTEGER :: JMOD, JMOD_IFN -LOGICAL :: GWEST,GEAST,GNORTH,GSOUTH -! BVIE work array waiting for PINPRI -REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)):: ZINPRI -REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZICEFR -REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZPRCFR -REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZTM -! -!------------------------------------------------------------------------------ -! -!* 1. PRELIMINARY COMPUTATIONS -! ------------------------ -! -CALL GET_INDICE_ll (IIB,IJB,IIE,IJE) -IKB=1+JPVEXT -IKE=SIZE(PZZ,3) - JPVEXT -IKU=SIZE(PZZ,3) -! -GWEST = LWEST_ll() -GEAST = LEAST_ll() -GSOUTH = LSOUTH_ll() -GNORTH = LNORTH_ll() -! -IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'KHKO') THEN - ISVBEG = NSV_C2R2BEG - ISVEND = NSV_C2R2END -ELSE IF (HCLOUD == 'C3R5') THEN - ISVBEG = NSV_C2R2BEG - ISVEND = NSV_C1R3END -ELSE IF (HCLOUD == 'LIMA') THEN - ISVBEG = NSV_LIMA_BEG -!UPG*PT - IF (.NOT. LDUST .AND. .NOT. LSALT .AND. .NOT. LORILAM) THEN - ISVEND = NSV_LIMA_END - ELSE - IF (LORILAM) THEN - ISVEND = NSV_AEREND - END IF - IF (LDUST) THEN - ISVEND = NSV_DSTEND - END IF - IF (LSALT) THEN - ISVEND = NSV_SLTEND - END IF - END IF -ELSE - ISVBEG = 0 - ISVEND = 0 -END IF -! -! -! -!* 1. From ORILAM to LIMA: -! -IF (HCLOUD == 'LIMA') THEN -!IF (HCLOUD == 'LIMA' .AND. ((LORILAM).OR.(LDUST).OR.(LSALT))) THEN -! ORILAM : tendance s --> variable instant t -ALLOCATE(ZSVT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3),NSV)) - DO II = 1, NSV - ZSVT(:,:,:,II) = PSVS(:,:,:,II) * PTSTEP / PRHODJ(:,:,:) - END DO - -CALL AER2LIMA(ZSVT(IIB:IIE,IJB:IJE,IKB:IKE,:),& - PRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), & - PRT(IIB:IIE,IJB:IJE,IKB:IKE,1),& - PPABST(IIB:IIE,IJB:IJE,IKB:IKE),& - PTHT(IIB:IIE,IJB:IJE,IKB:IKE), & - PZZ(IIB:IIE,IJB:IJE,IKB:IKE)) - -! LIMA : variable instant t --> tendance s - PSVS(:,:,:,NSV_LIMA_CCN_FREE) = ZSVT(:,:,:,NSV_LIMA_CCN_FREE) * & - PRHODJ(:,:,:) / PTSTEP - PSVS(:,:,:,NSV_LIMA_CCN_FREE+1) = ZSVT(:,:,:,NSV_LIMA_CCN_FREE+1) * & - PRHODJ(:,:,:) / PTSTEP - PSVS(:,:,:,NSV_LIMA_CCN_FREE+2) = ZSVT(:,:,:,NSV_LIMA_CCN_FREE+2) * & - PRHODJ(:,:,:) / PTSTEP - - PSVS(:,:,:,NSV_LIMA_IFN_FREE) = ZSVT(:,:,:,NSV_LIMA_IFN_FREE) * & - PRHODJ(:,:,:) / PTSTEP - PSVS(:,:,:,NSV_LIMA_IFN_FREE+1) = ZSVT(:,:,:,NSV_LIMA_IFN_FREE+1) * & - PRHODJ(:,:,:) / PTSTEP - -DEALLOCATE(ZSVT) -END IF - -!UPG*PT -! -IF (HCLOUD(1:3)=='ICE' .AND. LRED) THEN - ALLOCATE(ZRSMIN(SIZE(XRTMIN))) - ZRSMIN(:) = XRTMIN(:) / PTSTEP -END IF -! -!* 2. TRANSFORMATION INTO PHYSICAL TENDENCIES -! --------------------------------------- -! -PTHS(:,:,:) = PTHS(:,:,:) / PRHODJ(:,:,:) -DO JRR = 1,KRR - PRS(:,:,:,JRR) = PRS(:,:,:,JRR) / PRHODJ(:,:,:) -END DO -! -IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA') THEN - DO JSV = ISVBEG, ISVEND - PSVS(:,:,:,JSV) = PSVS(:,:,:,JSV) / PRHODJ(:,:,:) - ENDDO -ENDIF -! -! complete the lateral boundaries to avoid possible problems -! -DO JI=1,JPHEXT - PTHS(JI,:,:) = PTHS(IIB,:,:) - PTHS(IIE+JI,:,:) = PTHS(IIE,:,:) - PTHS(:,JI,:) = PTHS(:,IJB,:) - PTHS(:,IJE+JI,:) = PTHS(:,IJE,:) -! - PRS(JI,:,:,:) = PRS(IIB,:,:,:) - PRS(IIE+JI,:,:,:) = PRS(IIE,:,:,:) - PRS(:,JI,:,:) = PRS(:,IJB,:,:) - PRS(:,IJE+JI,:,:) = PRS(:,IJE,:,:) -END DO -! -! complete the physical boundaries to avoid some computations -! -IF(GWEST .AND. HLBCX(1) /= 'CYCL') PRT(:IIB-1,:,:,2:) = 0.0 -IF(GEAST .AND. HLBCX(2) /= 'CYCL') PRT(IIE+1:,:,:,2:) = 0.0 -IF(GSOUTH .AND. HLBCY(1) /= 'CYCL') PRT(:,:IJB-1,:,2:) = 0.0 -IF(GNORTH .AND. HLBCY(2) /= 'CYCL') PRT(:,IJE+1:,:,2:) = 0.0 -! -IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA') THEN -DO JI=1,JPHEXT - PSVS(JI, :, :, ISVBEG:ISVEND) = PSVS(IIB, :, :, ISVBEG:ISVEND) - PSVS(IIE+JI, :, :, ISVBEG:ISVEND) = PSVS(IIE, :, :, ISVBEG:ISVEND) - PSVS(:, JI, :, ISVBEG:ISVEND) = PSVS(:, IJB, :, ISVBEG:ISVEND) - PSVS(:, IJE+JI, :, ISVBEG:ISVEND) = PSVS(:, IJE, :, ISVBEG:ISVEND) -END DO - ! -! complete the physical boundaries to avoid some computations -! - IF(GWEST .AND. HLBCX(1) /= 'CYCL') PSVT(:IIB-1, :, :, ISVBEG:ISVEND) = 0.0 - IF(GEAST .AND. HLBCX(2) /= 'CYCL') PSVT(IIE+1:, :, :, ISVBEG:ISVEND) = 0.0 - IF(GSOUTH .AND. HLBCY(1) /= 'CYCL') PSVT(:, :IJB-1, :, ISVBEG:ISVEND) = 0.0 - IF(GNORTH .AND. HLBCY(2) /= 'CYCL') PSVT(:, IJE+1:, :, ISVBEG:ISVEND) = 0.0 -ENDIF -! -! complete the vertical boundaries -! -PTHS(:,:,IKB-1) = PTHS(:,:,IKB) -PTHS(:,:,IKE+1) = PTHS(:,:,IKE) -! -PRS(:,:,IKB-1,:) = PRS(:,:,IKB,:) -PRS(:,:,IKE+1,:) = PRS(:,:,IKE,:) -! -PRT(:,:,IKB-1,:) = PRT(:,:,IKB,:) -PRT(:,:,IKE+1,:) = PRT(:,:,IKE,:) -! -IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' .OR. HCLOUD == 'KHKO' & - .OR. HCLOUD == 'LIMA') THEN - PSVS(:,:,IKB-1,ISVBEG:ISVEND) = PSVS(:,:,IKB,ISVBEG:ISVEND) - PSVS(:,:,IKE+1,ISVBEG:ISVEND) = PSVS(:,:,IKE,ISVBEG:ISVEND) - PSVT(:,:,IKB-1,ISVBEG:ISVEND) = PSVT(:,:,IKB,ISVBEG:ISVEND) - PSVT(:,:,IKE+1,ISVBEG:ISVEND) = PSVT(:,:,IKE,ISVBEG:ISVEND) -ENDIF -! -! -!* 3. REMOVE NEGATIVE VALUES -! ---------------------- -! -!* 3.1 Non local correction for precipitating species (Rood 87) -! -! IF ( HCLOUD == 'KESS' & -! .OR. HCLOUD == 'ICE3' .OR. HCLOUD == 'ICE4' & -! .OR. HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' & -! .OR. HCLOUD == 'KHKO' .OR. HCLOUD == 'LIMA' ) THEN -! ! -! DO JRR = 3,KRR -! SELECT CASE (JRR) -! CASE(3,5,6,7) ! rain, snow, graupel and hail -! -! IF ( MIN_ll( PRS(:,:,:,JRR), IINFO_ll) < 0.0 ) THEN -! ! -! ! compute the total water mass computation -! ! -! ZMASSTOT = MAX( 0. , SUM3D_ll( PRS(:,:,:,JRR), IINFO_ll ) ) -! ! -! ! remove the negative values -! ! -! PRS(:,:,:,JRR) = MAX( 0., PRS(:,:,:,JRR) ) -! ! -! ! compute the new total mass -! ! -! ZMASSPOS = MAX(XMNH_TINY,SUM3D_ll( PRS(:,:,:,JRR), IINFO_ll ) ) -! ! -! ! correct again in such a way to conserve the total mass -! ! -! ZRATIO = ZMASSTOT / ZMASSPOS -! PRS(:,:,:,JRR) = PRS(:,:,:,JRR) * ZRATIO -! ! -! END IF -! END SELECT -! END DO -! END IF -! -!* 3.2 Adjustement for liquid and solid cloud -! -! Remove non-physical negative values (unnecessary in a perfect world) + corresponding budgets -call Sources_neg_correct( hcloud, 'NEGA', krr, ptstep, ppabst, ptht, prt, pths, prs, psvs, prhodj ) -! -!* 3.4 Limitations of Na and Nc to the CCN max number concentration -! -! Commented by O.Thouron 03/2013 -!IF ((HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' .OR. HCLOUD == 'KHKO') & -! .AND.(XCONC_CCN > 0)) THEN -! IF ((HACTCCN /= 'ABRK')) THEN -! ZSVT(:,:,:,1) = MIN( ZSVT(:,:,:,1),XCONC_CCN ) -! ZSVT(:,:,:,2) = MIN( ZSVT(:,:,:,2),XCONC_CCN ) -! ZSVS(:,:,:,1) = MIN( ZSVS(:,:,:,1),XCONC_CCN ) -! ZSVS(:,:,:,2) = MIN( ZSVS(:,:,:,2),XCONC_CCN ) -! END IF -!END IF -! -! -!------------------------------------------------------------------------------- -! -SELECT CASE ( HCLOUD ) - CASE ('REVE') -! -!* 4. REVERSIBLE MICROPHYSICAL SCHEME -! ------------------------------- -! - CALL FAST_TERMS ( KRR, KMI, HRAD, HTURBDIM, & - HSCONV, HMF_CLOUD, OSUBG_COND, PTSTEP, & - PRHODJ, PSIGS, PPABST, & - PCF_MF,PRC_MF, & - PRVT=PRT(:,:,:,1), PRCT=PRT(:,:,:,2), & - PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), & - PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR ) -! - CASE ('KESS') -! -!* 5. KESSLER MICROPHYSICAL SCHEME -! ---------------------------- -! -! -!* 5.1 Compute the explicit microphysical sources -! - CALL SLOW_TERMS ( KSPLITR, PTSTEP, KMI, HSUBG_AUCV, & - PZZ, PRHODJ, PRHODREF, PCLDFR, & - PTHT, PRT(:,:,:,1), PRT(:,:,:,2), PRT(:,:,:,3), PPABST, & - PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), & - PINPRR, PINPRR3D, PEVAP3D ) -! -!* 5.2 Perform the saturation adjustment -! - CALL FAST_TERMS ( KRR, KMI, HRAD, HTURBDIM, & - HSCONV, HMF_CLOUD, OSUBG_COND, PTSTEP, & - PRHODJ, PSIGS, PPABST, & - PCF_MF,PRC_MF, & - PRVT=PRT(:,:,:,1), PRCT=PRT(:,:,:,2), & - PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), PRRS=PRS(:,:,:,3), & - PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR ) -! -! - CASE ('C2R2','KHKO') -! -!* 7. 2-MOMENT WARM MICROPHYSICAL SCHEME C2R2 or KHKO -! --------------------------------------- -! -! -!* 7.1 Compute the explicit microphysical sources -! -! - CALL RAIN_C2R2_KHKO ( HCLOUD, OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, & - TPFILE, PZZ, PRHODJ, PRHODREF, PEXNREF, & - PPABST, PTHT, PRT(:,:,:,1), PRT(:,:,:,2), PRT(:,:,:,3), & - PTHM, PRCM, PPABSM, & - PW_ACT,PDTHRAD,PTHS, PRS(:,:,:,1),PRS(:,:,:,2),PRS(:,:,:,3), & - PSVT(:,:,:,NSV_C2R2BEG), PSVT(:,:,:,NSV_C2R2BEG+1), & - PSVT(:,:,:,NSV_C2R2BEG+2), PSVS(:,:,:,NSV_C2R2BEG), & - PSVS(:,:,:,NSV_C2R2BEG+1), PSVS(:,:,:,NSV_C2R2BEG+2), & - PINPRC, PINPRR, PINPRR3D, PEVAP3D , & - PSVT(:,:,:,:), PSOLORG, PMI, HACTCCN, & - PINDEP, PSUPSAT, PNACT ) -! -! -!* 7.2 Perform the saturation adjustment -! - IF (LSUPSAT) THEN - CALL KHKO_NOTADJUST (KRR, KTCOUNT,TPFILE, HRAD, & - PTSTEP, PRHODJ, PPABSM, PPABST, PRHODREF, PZZ, & - PTHT,PRT(:,:,:,1),PRT(:,:,:,2),PRT(:,:,:,3), & - PTHS,PRS(:,:,:,1),PRS(:,:,:,2),PRS(:,:,:,3), & - PSVS(:,:,:,NSV_C2R2BEG+1), PSVS(:,:,:,NSV_C2R2BEG), & - PSVS(:,:,:,NSV_C2R2BEG+3), PCLDFR, PSRCS, PNPRO, PSSPRO ) -! - ELSE - CALL C2R2_ADJUST ( KRR,TPFILE, HRAD, & - HTURBDIM, OSUBG_COND, PTSTEP, & - PRHODJ, PSIGS, PPABST, & - PTHS=PTHS, PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), & - PCNUCS=PSVS(:,:,:,NSV_C2R2BEG), & - PCCS=PSVS(:,:,:,NSV_C2R2BEG+1), & - PSRCS=PSRCS, PCLDFR=PCLDFR, PRRS=PRS(:,:,:,3) ) -! - END IF -! - CASE ('ICE3') -! -!* 9. MIXED-PHASE MICROPHYSICAL SCHEME (WITH 3 ICE SPECIES) -! ----------------------------------------------------- -! - allocate( zexn( size( pzz, 1 ), size( pzz, 2 ), size( pzz, 3 ) ) ) - ZEXN(:,:,:)= (PPABST(:,:,:)/XP00)**(XRD/XCPD) -! -!* 9.1 Compute the explicit microphysical sources -! -! - DO JK=IKB,IKE - ZDZZ(:,:,JK)=PZZ(:,:,JK+1)-PZZ(:,:,JK) - ENDDO - ZZZ = MZF( PZZ ) - IF(LRED .AND. LADJ_BEFORE) THEN - CALL ICE_ADJUST (1, IKU, 1, KRR, CFRAC_ICE_ADJUST, CCONDENS, CLAMBDA3, & - 'ADJU', OSUBG_COND, OSIGMAS, CSUBG_MF_PDF, & - PTSTEP, PSIGQSAT, & - PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, PPABST, ZZZ, & - ZEXN, PCF_MF, PRC_MF, PRI_MF, & - PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, & - PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), & - PTH=PTHS*PTSTEP, PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, & - PRR=PRS(:,:,:,3)*PTSTEP, & - PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), & - PRS=PRS(:,:,:,5)*PTSTEP, & - PRG=PRS(:,:,:,6)*PTSTEP, & - PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, & - PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF ) - ENDIF - IF (LRED) THEN - LLMICRO(:,:,:)=PRT(:,:,:,2)>XRTMIN(2) .OR. & - PRT(:,:,:,3)>XRTMIN(3) .OR. & - PRT(:,:,:,4)>XRTMIN(4) .OR. & - PRT(:,:,:,5)>XRTMIN(5) .OR. & - PRT(:,:,:,6)>XRTMIN(6) - LLMICRO(:,:,:)=LLMICRO(:,:,:) .OR. & - PRS(:,:,:,2)>ZRSMIN(2) .OR. & - PRS(:,:,:,3)>ZRSMIN(3) .OR. & - PRS(:,:,:,4)>ZRSMIN(4) .OR. & - PRS(:,:,:,5)>ZRSMIN(5) .OR. & - PRS(:,:,:,6)>ZRSMIN(6) - CALL RAIN_ICE_RED (SIZE(PTHT, 1), SIZE(PTHT, 2), SIZE(PTHT, 3), COUNT(LLMICRO), & - OSEDIC, CSEDIM, HSUBG_AUCV, CSUBG_AUCV_RI, & - OWARM,1,IKU,1, & - PTSTEP, KRR, LLMICRO, ZEXN, & - ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT,PCLDFR,& - PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, & - PTHT, PRT(:,:,:,1), PRT(:,:,:,2), & - PRT(:,:,:,3), PRT(:,:,:,4), & - PRT(:,:,:,5), PRT(:,:,:,6), & - PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), & - PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), & - PINPRC,PINPRR, PINPRR3D, PEVAP3D, & - PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, & - PSEA,PTOWN, PFPR=ZFPR ) - ELSE - CALL RAIN_ICE ( OSEDIC,CSEDIM, HSUBG_AUCV, OWARM,1,IKU,1, & - KSPLITR, PTSTEP, KRR, & - ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT,PCLDFR,& - PTHT, PRT(:,:,:,1), PRT(:,:,:,2), & - PRT(:,:,:,3), PRT(:,:,:,4), & - PRT(:,:,:,5), PRT(:,:,:,6), & - PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), & - PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), & - PINPRC,PINPRR, PINPRR3D, PEVAP3D, & - PINPRS, PINPRG, PSIGS,PINDEP, PRAINFR, & - PSEA,PTOWN, PFPR=ZFPR) - END IF -! -!* 9.2 Perform the saturation adjustment over cloud ice and cloud water -! -! - IF (.NOT. LRED .OR. (LRED .AND. LADJ_AFTER) ) THEN - CALL ICE_ADJUST (1, IKU, 1, KRR, CFRAC_ICE_ADJUST, CCONDENS, CLAMBDA3, & - 'DEPI', OSUBG_COND, OSIGMAS, CSUBG_MF_PDF, & - PTSTEP, PSIGQSAT, & - PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, PPABST, ZZZ, & - ZEXN, PCF_MF, PRC_MF, PRI_MF, & - PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, & - PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), & - PTH=PTHS*PTSTEP, PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, & - PRR=PRS(:,:,:,3)*PTSTEP, & - PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), & - PRS=PRS(:,:,:,5)*PTSTEP, & - PRG=PRS(:,:,:,6)*PTSTEP, & - PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, & - PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF ) - END IF - - deallocate( zexn ) -! - CASE ('ICE4') -! -!* 10. MIXED-PHASE MICROPHYSICAL SCHEME (WITH 4 ICE SPECIES) -! ----------------------------------------------------- -! - allocate( zexn( size( pzz, 1 ), size( pzz, 2 ), size( pzz, 3 ) ) ) - ZEXN(:,:,:)= (PPABST(:,:,:)/XP00)**(XRD/XCPD) -! -!* 10.1 Compute the explicit microphysical sources -! -! - DO JK=IKB,IKE - ZDZZ(:,:,JK)=PZZ(:,:,JK+1)-PZZ(:,:,JK) - ENDDO - ZZZ = MZF( PZZ ) - IF(LRED .AND. LADJ_BEFORE) THEN - CALL ICE_ADJUST (1, IKU, 1, KRR, CFRAC_ICE_ADJUST, CCONDENS, CLAMBDA3, & - 'ADJU', OSUBG_COND, OSIGMAS, CSUBG_MF_PDF, & - PTSTEP, PSIGQSAT, & - PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, PPABST, ZZZ, & - ZEXN, PCF_MF, PRC_MF, PRI_MF, & - PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, & - PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), & - PTH=PTHS*PTSTEP, PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, & - PRR=PRS(:,:,:,3)*PTSTEP, & - PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), & - PRS=PRS(:,:,:,5)*PTSTEP, & - PRG=PRS(:,:,:,6)*PTSTEP, & - PRH=PRS(:,:,:,7)*PTSTEP, & - PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, & - PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF ) - ENDIF - IF (LRED) THEN - LLMICRO(:,:,:)=PRT(:,:,:,2)>XRTMIN(2) .OR. & - PRT(:,:,:,3)>XRTMIN(3) .OR. & - PRT(:,:,:,4)>XRTMIN(4) .OR. & - PRT(:,:,:,5)>XRTMIN(5) .OR. & - PRT(:,:,:,6)>XRTMIN(6) .OR. & - PRT(:,:,:,7)>XRTMIN(7) - LLMICRO(:,:,:)=LLMICRO(:,:,:) .OR. & - PRS(:,:,:,2)>ZRSMIN(2) .OR. & - PRS(:,:,:,3)>ZRSMIN(3) .OR. & - PRS(:,:,:,4)>ZRSMIN(4) .OR. & - PRS(:,:,:,5)>ZRSMIN(5) .OR. & - PRS(:,:,:,6)>ZRSMIN(6) .OR. & - PRS(:,:,:,7)>ZRSMIN(7) - CALL RAIN_ICE_RED (SIZE(PTHT, 1), SIZE(PTHT, 2), SIZE(PTHT, 3), COUNT(LLMICRO), & - OSEDIC, CSEDIM, HSUBG_AUCV, CSUBG_AUCV_RI,& - OWARM, 1, IKU, 1, & - PTSTEP, KRR, LLMICRO, ZEXN, & - ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,& - PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF,& - PTHT, PRT(:,:,:,1), PRT(:,:,:,2), & - PRT(:,:,:,3), PRT(:,:,:,4), & - PRT(:,:,:,5), PRT(:,:,:,6), & - PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), & - PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), & - PINPRC, PINPRR, PINPRR3D, PEVAP3D, & - PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, PSEA, PTOWN, & - PRT(:,:,:,7), PRS(:,:,:,7), PINPRH, PFPR=ZFPR ) - ELSE - CALL RAIN_ICE ( OSEDIC,CSEDIM, HSUBG_AUCV, OWARM,1,IKU,1, & - KSPLITR, PTSTEP, KRR, & - ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,& - PTHT, PRT(:,:,:,1), PRT(:,:,:,2), & - PRT(:,:,:,3), PRT(:,:,:,4), & - PRT(:,:,:,5), PRT(:,:,:,6), & - PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), & - PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), & - PINPRC, PINPRR, PINPRR3D, PEVAP3D, & - PINPRS, PINPRG, PSIGS,PINDEP, PRAINFR, & - PSEA, PTOWN, & - PRT(:,:,:,7), PRS(:,:,:,7), PINPRH,PFPR=ZFPR ) - END IF - - -! -!* 10.2 Perform the saturation adjustment over cloud ice and cloud water -! - IF (.NOT. LRED .OR. (LRED .AND. LADJ_AFTER) ) THEN - CALL ICE_ADJUST (1, IKU, 1, KRR, CFRAC_ICE_ADJUST, CCONDENS, CLAMBDA3, & - 'DEPI', OSUBG_COND, OSIGMAS, CSUBG_MF_PDF, & - PTSTEP, PSIGQSAT, & - PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, PPABST, ZZZ, & - ZEXN, PCF_MF, PRC_MF, PRI_MF, & - PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, & - PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), & - PTH=PTHS*PTSTEP, PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, & - PRR=PRS(:,:,:,3)*PTSTEP, & - PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), & - PRS=PRS(:,:,:,5)*PTSTEP, & - PRG=PRS(:,:,:,6)*PTSTEP, & - PRH=PRS(:,:,:,7)*PTSTEP, & - PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, & - PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF ) - END IF - - deallocate( zexn ) -! -! -!* 12. 2-MOMENT MIXED-PHASE MICROPHYSICAL SCHEME LIMA -! -------------------------------------------------------------- -! -! -!* 12.1 Compute the explicit microphysical sources -! - CASE ('LIMA') - ! - DO JK=IKB,IKE - ZDZZ(:,:,JK)=PZZ(:,:,JK+1)-PZZ(:,:,JK) - ENDDO - ZZZ = MZF( PZZ ) - IF (LPTSPLIT) THEN - CALL LIMA (1, IKU, 1, & - PTSTEP, TPFILE, & - PRHODREF, PEXNREF, ZDZZ, & - PRHODJ, PPABSM, PPABST, & - NMOD_CCN, NMOD_IFN, NMOD_IMM, & - PDTHRAD, PTHT, PRT, & - PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), PW_ACT, & - PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), & - PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, PINPRH, & - PEVAP3D, PCLDFR, ZICEFR, ZPRCFR ) - ELSE - - IF (OWARM) CALL LIMA_WARM(OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, & - TPFILE, KRR, PZZ, PRHODJ, & - PRHODREF, PEXNREF, PW_ACT, PPABSM, PPABST, & - PDTHRAD, PRCM, & - PTHT, PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), & - PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), & - PINPRC, PINPRR, PINDEP, PINPRR3D, PEVAP3D ) -! - IF (LCOLD) CALL LIMA_COLD(OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, & - KRR, PZZ, PRHODJ, & - PRHODREF, PEXNREF, PPABST, PW_ACT, & - PTHM, PPABSM, & - PTHT, PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), & - PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), & - PINPRS, PINPRG, PINPRH ) -! - IF (OWARM .AND. LCOLD) CALL LIMA_MIXED(OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, & - KRR, PZZ, PRHODJ, & - PRHODREF, PEXNREF, PPABST, PW_ACT, & - PTHM, PPABSM, & - PTHT, PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), & - PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END) ) - ENDIF -! -!* 12.2 Perform the saturation adjustment -! - IF (LSPRO) THEN - CALL LIMA_NOTADJUST (KMI, TPFILE, HRAD, & - PTSTEP, PRHODJ, PPABSM, PPABST, PRHODREF, PEXNREF, PZZ, & - PTHT,PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), & - PTHS,PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), & - PCLDFR, PSRCS ) - ELSE IF (LPTSPLIT) THEN - CALL LIMA_ADJUST_SPLIT(KRR, KMI, TPFILE, CCONDENS, CLAMBDA3, & - OSUBG_COND, OSIGMAS, PTSTEP, PSIGQSAT, & - PRHODREF, PRHODJ, PEXNREF, PPABST, PSIGS, PMFCONV, PPABST, ZZZ, & - PDTHRAD, PW_ACT, & - PRT, PRS, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), & - PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), & - PTHS, PSRCS, PCLDFR, PRC_MF, PCF_MF ) - ELSE - CALL LIMA_ADJUST(KRR, KMI, TPFILE, & - OSUBG_COND, PTSTEP, & - PRHODREF, PRHODJ, PEXNREF, PPABST, PPABST, & - PRT, PRS, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), & - PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), & - PTHS, PSRCS, PCLDFR ) - ENDIF -! -END SELECT -! -IF(HCLOUD=='ICE3' .OR. HCLOUD=='ICE4' ) THEN - PINPRC3D=ZFPR(:,:,:,2) / XRHOLW - PINPRR3D=ZFPR(:,:,:,3) / XRHOLW - PINPRS3D=ZFPR(:,:,:,5) / XRHOLW - PINPRG3D=ZFPR(:,:,:,6) / XRHOLW - IF(KRR==7) PINPRH3D=ZFPR(:,:,:,7) / XRHOLW - WHERE (PRT(:,:,:,2) > 1.E-04 ) - PSPEEDC=ZFPR(:,:,:,2) / (PRT(:,:,:,2) * PRHODREF(:,:,:)) - ENDWHERE - WHERE (PRT(:,:,:,3) > 1.E-04 ) - PSPEEDR=ZFPR(:,:,:,3) / (PRT(:,:,:,3) * PRHODREF(:,:,:)) - ENDWHERE - WHERE (PRT(:,:,:,5) > 1.E-04 ) - PSPEEDS=ZFPR(:,:,:,5) / (PRT(:,:,:,5) * PRHODREF(:,:,:)) - ENDWHERE - WHERE (PRT(:,:,:,6) > 1.E-04 ) - PSPEEDG=ZFPR(:,:,:,6) / (PRT(:,:,:,6) * PRHODREF(:,:,:)) - ENDWHERE - IF(KRR==7) THEN - WHERE (PRT(:,:,:,7) > 1.E-04 ) - PSPEEDH=ZFPR(:,:,:,7) / (PRT(:,:,:,7) * PRHODREF(:,:,:)) - ENDWHERE - ENDIF -ENDIF - -! Remove non-physical negative values (unnecessary in a perfect world) + corresponding budgets -call Sources_neg_correct( hcloud, 'NECON', krr, ptstep, ppabst, ptht, prt, pths, prs, psvs, prhodj ) - -!------------------------------------------------------------------------------- -! -! -!* 13. SWITCH BACK TO THE PROGNOSTIC VARIABLES -! --------------------------------------- -! -PTHS(:,:,:) = PTHS(:,:,:) * PRHODJ(:,:,:) -! -DO JRR = 1,KRR - PRS(:,:,:,JRR) = PRS(:,:,:,JRR) * PRHODJ(:,:,:) -END DO -! -IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA') THEN - DO JSV = ISVBEG, ISVEND - PSVS(:,:,:,JSV) = PSVS(:,:,:,JSV) * PRHODJ(:,:,:) - ENDDO -ENDIF - -!------------------------------------------------------------------------------- -! -END SUBROUTINE RESOLVED_CLOUD diff --git a/src/ICCARE_BASE/saltcamsn.f90 b/src/ICCARE_BASE/saltcamsn.f90 deleted file mode 100644 index 1747bddc7..000000000 --- a/src/ICCARE_BASE/saltcamsn.f90 +++ /dev/null @@ -1,281 +0,0 @@ -!----------------------------------------------------------------- -!--------------- special set of characters for RCS information -!----------------------------------------------------------------- -! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/saltlfin.f90,v $ $Revision: 1.1.2.2.2.1.2.1 $ -! MASDEV4_7 newsrc 2007/01/25 13:13:15 -!----------------------------------------------------------------- -! ######################## - MODULE MODI_SALTCAMS_n -! ######################## -! -INTERFACE -! -SUBROUTINE SALTCAMS_n(PSV,PMASSCAMS,PRHODREF) -IMPLICIT NONE -REAL, DIMENSION(:,:,:,:),INTENT(INOUT) :: PSV -REAL, DIMENSION(:,:,:,:),INTENT(IN) :: PMASSCAMS -REAL, DIMENSION(:,:,:),INTENT(IN) :: PRHODREF -END SUBROUTINE SALTCAMS_n -! -END INTERFACE -! -END MODULE MODI_SALTCAMS_n -! -! -! ############################################################ - SUBROUTINE SALTCAMS_n(PSV, PMASSCAMS, PRHODREF) -! ############################################################ -! -!! PURPOSE -!! ------- -!! Initialise le champs de salts à partir des analyses CAMS -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Pierre TULET (LACy) -!! -!! MODIFICATIONS -!! ------------- -!! none -!! -!! EXTERNAL -!! -------- -!! None -!! -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_SALT -USE MODD_NSV -USE MODD_CSTS_SALT -USE MODE_SALT_PSD -USE MODI_INIT_SALT -! -IMPLICIT NONE -! -!* 0.1 declarations of arguments -! -REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSV -REAL, DIMENSION(:,:,:,:),INTENT(IN) :: PMASSCAMS ! macc salt concentration (kg.kg-1) -REAL, DIMENSION(:,:,:),INTENT(IN) :: PRHODREF -! -! -!* 0.2 declarations local variables -! -REAL :: ZDEN2MOL, ZRHOI, ZMI, ZFAC, ZRGMIN -REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZCTOTA -REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZM -REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZSIGMA -REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZMASS -INTEGER,DIMENSION(:), ALLOCATABLE :: IM0, IM3, IM6 -REAL,DIMENSION(:), ALLOCATABLE :: ZMMIN -REAL,DIMENSION(:), ALLOCATABLE :: ZINIRADIUS, ZINISIGMA -INTEGER :: IKU, IMOMENTS -INTEGER :: JJ, JN, JK ! loop counter -INTEGER :: IMODEIDX ! index mode -REAL :: ZRHOMIN - -REAL :: DELTA_1,DELTA_2,DELTA_3,DELTA_4,DELTA_5,DELTA_6,DELTA_7 -REAL :: RATIO_1,RATIO_2,RATIO_3,RATIO_4,RATIO_5, RATIO_6,RATIO_7 -REAL :: DELTA_CAMS_1,DELTA_CAMS_2,DELTA_CAMS_3 -REAL :: RAY_CAMS_1,RAY_CAMS_2,RAY_CAMS_3,RAY_CAMS_4 -REAL :: RAY_2,RAY_3,RAY_4 -REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZMASS_TEST -! -!------------------------------------------------------------------------------- -! -!* 1. TRANSFER FROM GAS TO AEROSOL MODULE -! ----------------------------------- -! -! 1.1 initialisation -! -CALL INIT_SALT -IKU = SIZE(PSV,3) -ZRHOMIN=MINVAL(PRHODREF) -! -ALLOCATE (IM0(NMODE_SLT)) -ALLOCATE (IM3(NMODE_SLT)) -ALLOCATE (IM6(NMODE_SLT)) -ALLOCATE (ZCTOTA(SIZE(PSV,1), SIZE(PSV,2), SIZE(PSV,3), NMODE_SLT)) -ALLOCATE (ZM(SIZE(PSV,1), SIZE(PSV,2), SIZE(PSV,3), NMODE_SLT*3)) -ALLOCATE (ZSIGMA(SIZE(PSV,1), SIZE(PSV,2), SIZE(PSV,3))) -ALLOCATE (ZINIRADIUS(NMODE_SLT)) -ALLOCATE (ZINISIGMA(NMODE_SLT)) -ALLOCATE (ZMMIN(NMODE_SLT*3)) -ALLOCATE (ZMASS(SIZE(PSV,1), SIZE(PSV,2), SIZE(PSV,3),NMODE_SLT)) -! -! Rayons des bins CAMS - -RAY_CAMS_1 = 0.03 -RAY_CAMS_2 = 0.5 -RAY_CAMS_3 = 5 -RAY_CAMS_4 = 20 - -! Choix des diametres de separation (selon Ovadnevaite et al., 2014) - -RAY_2 = 0.045 -RAY_3 = 0.11 -RAY_4 = 0.41 - -! Calcul des proportions - -! Calcul des écarts bin CAMS - -DELTA_CAMS_1 = RAY_CAMS_2 - RAY_CAMS_1 -DELTA_CAMS_2 = RAY_CAMS_3 - RAY_CAMS_2 -DELTA_CAMS_3 = RAY_CAMS_4 - RAY_CAMS_3 - -! Calcul des ecarts par mode en fonction des rayons de separation -! puis calcul de la masse correspondante avec facteur correctif pour eviter -! la surestimation des concentrations en aerosols - -DELTA_1 = RAY_2 - RAY_CAMS_1 -RATIO_1 = DELTA_1 / DELTA_CAMS_1 -ZMASS(:,:,:,2) = PMASSCAMS(:,:,:,1) * RATIO_1 ! * 1E-2 ! Attribution Mode 2 ORILAM - -DELTA_2 = RAY_3 - RAY_2 -RATIO_2 = DELTA_2 / DELTA_CAMS_1 -ZMASS(:,:,:,3) = PMASSCAMS(:,:,:,1) * RATIO_2 ! * 1E-2 ! Attribution Mode 3 ORILAM - -DELTA_3 = RAY_4 - RAY_3 -RATIO_3 = DELTA_3 / DELTA_CAMS_1 -ZMASS(:,:,:,4) = PMASSCAMS(:,:,:,1) * RATIO_3 ! * 1E-1 ! Attribution Mode 4 ORILAM - -DELTA_4 = RAY_CAMS_2 - RAY_4 -RATIO_4 = DELTA_4 / DELTA_CAMS_1 -ZMASS(:,:,:,5) = PMASSCAMS(:,:,:,1) * RATIO_4 ! Attribution Mode 5 ORILAM - -DELTA_5 = RAY_CAMS_3 - RAY_CAMS_2 -RATIO_5 = DELTA_5 / DELTA_CAMS_2 -ZMASS(:,:,:,5) = (PMASSCAMS(:,:,:,2) * RATIO_5) + ZMASS(:,:,:,5) ! Attribution Mode 5 bis ORILAM - -DELTA_6 = 10 - RAY_CAMS_3 -RATIO_6 = DELTA_3 / DELTA_CAMS_1 -ZMASS(:,:,:,5) = (PMASSCAMS(:,:,:,3) * RATIO_6) + ZMASS(:,:,:,5) ! Attribution Mode 5 ter ORILAM - -ZMASS(:,:,:,5) = ZMASS(:,:,:,5) * 1E-1 - -! Hyp : the ultrafine mode is neglected for orilam-lima coupling -ZMASS(:,:,:,1) = PMASSCAMS(:,:,:,1) * 1E-5 ! ultrafin mode -! -!======================================================== -! Adjust the mass / SSA emissions after a few hours -ZMASS(:,:,:,1) = ZMASS(:,:,:,1) * 1. -ZMASS(:,:,:,2) = ZMASS(:,:,:,2) * 1. -ZMASS(:,:,:,3) = ZMASS(:,:,:,3) * 1. -ZMASS(:,:,:,4) = ZMASS(:,:,:,4) * 1. -ZMASS(:,:,:,5) = ZMASS(:,:,:,5) * 1. -!======================================================== - -DO JN = 1, NMODE_SLT - IM0(JN) = 1 + (JN - 1) * 3 - IM3(JN) = 2 + (JN - 1) * 3 - IM6(JN) = 3 + (JN - 1) * 3 - ! - !Get the salt mode we are talking about, MODE 2 is treated first, then mode 3, then 1 - !This index is only needed to get the right radius out of the XINIRADIUS array and the - !right XINISIG out of the XINISIG-array - IMODEIDX = JPSALTORDER(JN) - ! - !Convert initial mass median radius to number median radius - IF (CRGUNITS=="MASS") THEN - ZINIRADIUS(JN) = XINIRADIUS_SLT(IMODEIDX) * EXP(-3.*(LOG(XINISIG_SLT(IMODEIDX)))**2) - ELSE - ZINIRADIUS(JN) = XINIRADIUS_SLT(IMODEIDX) - END IF - ZINISIGMA(JN) = XINISIG_SLT(IMODEIDX) - ! - ZMMIN(IM0(JN)) = XN0MIN_SLT(IMODEIDX) - ZRGMIN = ZINIRADIUS(JN) - ZMMIN(IM3(JN)) = XN0MIN_SLT(IMODEIDX) * (ZRGMIN**3)*EXP(4.5 * LOG(ZINISIGMA(JN))**2) - ZMMIN(IM6(JN)) = XN0MIN_SLT(IMODEIDX) * (ZRGMIN**6)*EXP(18. * LOG(ZINISIGMA(JN))**2) - -END DO - -ZMASS(:,:,:,:) = MAX(ZMASS(:,:,:,:), 1E-40) -! -! -ZRHOI = XDENSITY_SALT -ZMI = XMOLARWEIGHT_SALT -ZDEN2MOL = 1E-6 * XAVOGADRO / XMD -ZFAC = (4. / 3.) * XPI * ZRHOI * 1.e-9 - -! -DO JN = 1, NMODE_SLT - -!* 1.1 calculate moment 0 from ZMASS -! - ZM(:,:,:,IM0(JN)) = ZMASS(:,:,:,JPSALTORDER(JN)) &![kg_{salt}/kg_{air} - / XDENSITY_SALT &![kg__{salt}/m3_{salt}==>m3_{salt}/m3{air} - * (6.d0 / XPI) & - / (2.d0 * ZINIRADIUS(JN) * 1.d-6)**3 &![particle/m_salt^{-3}]==> particle/m3 - * EXP(-4.5*(LOG(ZINISIGMA(JN)))**2) !Take into account distribution - - ZM(:,:,:,IM0(JN)) = MAX(ZMMIN(IM0(JN)), ZM(:,:,:,IM0(JN))) -! -!* 1.2 calculate moment 3 from m0, RG and SIG -! - ZM(:,:,:,IM3(JN)) = ZM(:,:,:,IM0(JN)) * & - (ZINIRADIUS(JN)**3) * & - EXP(4.5*LOG(ZINISIGMA(JN))**2) - - ZM(:,:,:,IM3(JN)) = MAX(ZMMIN(IM3(JN)), ZM(:,:,:,IM3(JN))) -! -!* 1.3 calculate moment 6 from m0, RG and SIG -! - ZM(:,:,:,IM6(JN))= ZM(:,:,:,IM0(JN)) * ((ZINIRADIUS(JN)**6)*& - EXP(18. * (LOG(ZINISIGMA(JN)))**2)) - ZM(:,:,:,IM6(JN)) = MAX(ZMMIN(IM6(JN)), ZM(:,:,:,IM6(JN))) -! -!* 1.4 output concentration (in ppv) -! - IMOMENTS = INT(NSV_SLTEND - NSV_SLTBEG+1) / NMODE_SLT - IF (IMOMENTS == 3) THEN - PSV(:,:,:,1+(JN-1)*3) = ZM(:,:,:,IM0(JN)) * XMD / (XAVOGADRO*PRHODREF(:,:,:)) - XSVMIN(NSV_SLTBEG-1+1+(JN-1)*3) = ZMMIN(IM0(JN)) * XMD / (XAVOGADRO*ZRHOMIN) - - PSV(:,:,:,2+(JN-1)*3) = ZM(:,:,:,IM3(JN)) * XMD * XPI * 4. / 3. * ZRHOI / & - (ZMI*XM3TOUM3_SALT*PRHODREF(:,:,:)) - XSVMIN(NSV_SLTBEG-1+2+(JN-1)*3) = ZMMIN(IM3(JN)) * XMD * XPI * 4. / 3. * ZRHOI / & - (ZMI*XM3TOUM3_SALT**ZRHOMIN) - - PSV(:,:,:,3+(JN-1)*3) = ZM(:,:,:,IM6(JN)) * XMD / (XAVOGADRO*1.d-6*PRHODREF(:,:,:)) - XSVMIN(NSV_SLTBEG-1+3+(JN-1)*3) = ZMMIN(IM6(JN)) * XMD / (XAVOGADRO*1.d-6* ZRHOMIN) - ELSE IF (IMOMENTS == 2) THEN - PSV(:,:,:,1+(JN-1)*2) = ZM(:,:,:,IM0(JN)) * XMD / (XAVOGADRO*PRHODREF(:,:,:)) - XSVMIN(NSV_SLTBEG-1+1+(JN-1)*2) = ZMMIN(IM0(JN)) * XMD / (XAVOGADRO*ZRHOMIN) - - PSV(:,:,:,2+(JN-1)*2) = ZM(:,:,:,IM3(JN)) * XMD * XPI * 4./3. * ZRHOI / & - (ZMI*XM3TOUM3_SALT*PRHODREF(:,:,:)) - XSVMIN(NSV_SLTBEG-1+2+(JN-1)*2) = ZMMIN(IM3(JN)) * XMD * XPI * 4. / 3. * ZRHOI / & - (ZMI*XM3TOUM3_SALT**ZRHOMIN) - - ELSE - PSV(:,:,:,JN) = ZM(:,:,:,IM3(JN)) * XMD * XPI * 4. / 3. * ZRHOI / & - (ZMI * XM3TOUM3_SALT*PRHODREF(:,:,:)) - XSVMIN(NSV_SLTBEG-1+JN) = ZMMIN(IM3(JN)) * XMD * XPI * 4. / 3. * ZRHOI / & - (ZMI*XM3TOUM3_SALT**ZRHOMIN) - - END IF -END DO - -! -DEALLOCATE(ZMMIN) -DEALLOCATE(ZINISIGMA) -DEALLOCATE(ZINIRADIUS) -DEALLOCATE(ZSIGMA) -DEALLOCATE(ZM) -DEALLOCATE(ZCTOTA) -DEALLOCATE(IM6) -DEALLOCATE(IM3) -DEALLOCATE(IM0) -DEALLOCATE(ZMASS) -! -! -END SUBROUTINE SALTCAMS_n diff --git a/src/ICCARE_BASE/saltlfin.f90 b/src/ICCARE_BASE/saltlfin.f90 deleted file mode 100644 index 76b538358..000000000 --- a/src/ICCARE_BASE/saltlfin.f90 +++ /dev/null @@ -1,280 +0,0 @@ -!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence -!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!ORILAM_LIC for details. -!----------------------------------------------------------------- -!--------------- special set of characters for RCS information -!----------------------------------------------------------------- -! $Source$ $Revision$ -! MASDEV4_7 newsrc 2006/10/19 17:13:51 -!----------------------------------------------------------------- -! ######################## - MODULE MODI_SALTLFI_n -! ######################## -! -INTERFACE -! -!++cb++24/10/16 -!SUBROUTINE SALTLFI_n(PSV, PRHODREF) -SUBROUTINE SALTLFI_n(PSV, PRHODREF, PZZ) -IMPLICIT NONE -REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSV -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF -REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ - -END SUBROUTINE SALTLFI_n -! -END INTERFACE -! -END MODULE MODI_SALTLFI_n -! -! -! ############################################################ -! SUBROUTINE SALTLFI_n(PSV, PRHODREF) - SUBROUTINE SALTLFI_n(PSV, PRHODREF, PZZ) -! ############################################################ -! -!! PURPOSE -!! ------- -!! Realise l'équilibre des moments à partir du sigma et du diametre moyen -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Pierre TULET (LA) -!! -!! MODIFICATIONS -!! ------------- -!! none -!! -!! 2014 P.Tulet modif calcul ZM -!! EXTERNAL -!! -------- -!! None -!! -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_SALT -USE MODD_NSV -!++cb++24/10/16 -!USE MODD_GRID_n, ONLY: XZZ -!--cb-- -USE MODD_CSTS_SALT -USE MODD_CST, ONLY : & - XPI & !Definition of pi - ,XBOLTZ & ! Boltzman constant - ,XAVOGADRO & ![molec/mol] avogadros number - ,XG & ! Gravity constant - ,XP00 & ! Reference pressure - ,XMD & ![kg/mol] molar weight of air - ,XRD & ! Gaz constant for dry air - ,XCPD ! Cpd (dry air) -! -IMPLICIT NONE -! -!* 0.1 declarations of arguments -! -REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSV -REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF -REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ -! -! -!* 0.2 declarations local variables -! -REAL :: ZDEN2MOL, ZRHOI, ZMI, ZFAC, ZRGMIN -REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZCTOTA -REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZM -REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZSIGMA -INTEGER,DIMENSION(:), ALLOCATABLE :: IM0, IM3, IM6 -REAL,DIMENSION(:), ALLOCATABLE :: ZMMIN -REAL,DIMENSION(:), ALLOCATABLE :: ZINIRADIUS, ZINISIGMA -REAL,DIMENSION(:,:), ALLOCATABLE :: ZSEA -INTEGER :: IKU -!+Marine -INTEGER :: IMOMENTS -!-Marine -INTEGER :: JI, JJ, JN, JK ! loop counter -INTEGER :: IMODEIDX ! index mode -REAL, PARAMETER :: ZN_SALT=0.1 ! particles of sea salt/cm3 {air} -REAL, PARAMETER :: ZCLM=800. ! Marine Salt layer (m) -REAL :: ZN_SALTN -! -!------------------------------------------------------------------------------- -! -!* 1. TRANSFER FROM GAS TO AEROSOL MODULE -! ----------------------------------- -! -! 1.1 initialisation -! -IKU=SIZE(PSV,3) -!+ Marine -! -ALLOCATE (IM0(NMODE_SLT)) -ALLOCATE (IM3(NMODE_SLT)) -ALLOCATE (IM6(NMODE_SLT)) -ALLOCATE (ZCTOTA(SIZE(PSV,1), SIZE(PSV,2), SIZE(PSV,3), NMODE_SLT)) -ALLOCATE (ZM(SIZE(PSV,1), SIZE(PSV,2), SIZE(PSV,3), NMODE_SLT*3)) -ALLOCATE (ZSIGMA(SIZE(PSV,1), SIZE(PSV,2), SIZE(PSV,3))) -ALLOCATE (ZINIRADIUS(NMODE_SLT)) -ALLOCATE (ZINISIGMA(NMODE_SLT)) -ALLOCATE (ZMMIN(NMODE_SLT*3)) -ALLOCATE (ZSEA(SIZE(PSV,1), SIZE(PSV,2))) - -ZSEA(:,:) = 0. -!++cb++20/10/16 -!WHERE ((XZZ(:,:,1) .LT. 0.1).AND.(XZZ(:,:,1) .GE. 0.)) -! ZSEA(:,:) = 1. -!END WHERE -!++cb++24/10/16 -!WHERE (XZZ(:,:,1) .LE. 0.01) -WHERE (PZZ(:,:,1) .LE. 0.01) -!--cb-- - ZSEA(:,:) = 1. -END WHERE -!--cb-- -! -! -!+ Marine -DO JN = 1, NMODE_SLT - IM0(JN) = 1+(JN-1)*3 - IM3(JN) = 2+(JN-1)*3 - IM6(JN) = 3+(JN-1)*3 - ! - !Get the sea salt mode we are talking about, MODE 2 is treated first, then mode 3, then 1 - !This index is only needed to get the right radius out of the XINIRADIUS_SLT array and the - !right XINISIG_SLT out of the XINISIG_SLT-array - IMODEIDX = JPSALTORDER(JN) - ! - !Convert initial mass median radius to number median radius - IF (CRGUNITS=="MASS") THEN - ZINIRADIUS(JN) = XINIRADIUS_SLT(IMODEIDX) * EXP(-3.*(LOG(XINISIG_SLT(IMODEIDX)))**2) - ELSE - ZINIRADIUS(JN) = XINIRADIUS_SLT(IMODEIDX) - END IF - ZINISIGMA(JN) = XINISIG_SLT(IMODEIDX) - ! - ZMMIN(IM0(JN)) = XN0MIN_SLT(IMODEIDX) - ZRGMIN = ZINIRADIUS(JN) - ZMMIN(IM3(JN)) = XN0MIN_SLT(IMODEIDX) * (ZRGMIN**3)*EXP(4.5 * LOG(ZINISIGMA(JN))**2) - ZMMIN(IM6(JN)) = XN0MIN_SLT(IMODEIDX) * (ZRGMIN**6)*EXP(18. * LOG(ZINISIGMA(JN))**2) -ENDDO -! -! -ZRHOI = XDENSITY_SALT -ZMI = XMOLARWEIGHT_SALT -ZDEN2MOL = 1E-6 * XAVOGADRO / XMD -ZFAC=(4./3.)*XPI*ZRHOI*1.e-9 - -! -DO JN=1,NMODE_SLT - -!* 1.1 calculate moment 0 from sea salt number by m3 -! -! initial vertical profil of sea salt and convert in #/m3 -!+Marine : (reprendre XN0MIN_SLT de modd_salt.f90). -! Pas plus simple de fixer une dimension à ZN_SALT qui dépend de JN pour ne pas -! avoir à rappeler le schéma d'émission? - - IF (JN == 1) ZN_SALTN = XN0MIN_SLT(JPSALTORDER(JN)) * ZN_SALT *1E6 - IF (JN == 2) ZN_SALTN = XN0MIN_SLT(JPSALTORDER(JN)) * ZN_SALT *1E6 - IF (JN == 3) ZN_SALTN = XN0MIN_SLT(JPSALTORDER(JN)) * ZN_SALT *1E6 - IF (JN == 4) ZN_SALTN = XN0MIN_SLT(JPSALTORDER(JN)) * ZN_SALT *1E6 - IF (JN == 5) ZN_SALTN = XN0MIN_SLT(JPSALTORDER(JN)) * ZN_SALT *1E6 - IF (JN == 6) ZN_SALTN = XN0MIN_SLT(JPSALTORDER(JN)) * ZN_SALT *1E6 - IF (JN == 7) ZN_SALTN = XN0MIN_SLT(JPSALTORDER(JN)) * ZN_SALT *1E6 - IF (JN == 8) ZN_SALTN = XN0MIN_SLT(JPSALTORDER(JN)) * ZN_SALT *1E6 - - -!-Marine - - DO JK=1, SIZE(PSV,3) - DO JJ=1, SIZE(PSV,2) - DO JI=1, SIZE(PSV,1) -!++cb++24/10/16 -! IF (XZZ(JI,JJ,JK) .LT. 600.) THEN - IF (PZZ(JI,JJ,JK) .LT. 600.) THEN - ZM(JI,JJ,JK,IM0(JN)) = ZN_SALTN -! ELSE IF ((XZZ(JI,JJ,JK) .GE. 600.).AND.(XZZ(JI,JJ,JK) .LT. 1000.)) THEN - ELSE IF ((PZZ(JI,JJ,JK) .GE. 600.).AND.(PZZ(JI,JJ,JK) .LT. 1000.)) THEN -! ZM(JI,JJ,JK,IM0(JN)) = ZN_SALTN - ZN_SALTN*(1.-1E-3)*(XZZ(JI,JJ,JK)-600.) / 400. - ZM(JI,JJ,JK,IM0(JN)) = ZN_SALTN - & - ZN_SALTN * (1.-1E-3) * (PZZ(JI,JJ,JK)-600.) / 400. -! ELSE IF (XZZ(JI,JJ,JK) .GE. 1000.) THEN - ELSE IF (PZZ(JI,JJ,JK) .GE. 1000.) THEN - ZM(JI,JJ,JK,IM0(JN)) = ZN_SALTN * 1E-3 -!--cb-- - END IF - END DO - END DO - ! Over continent value of the free troposphere - WHERE (ZSEA(:,:) == 0.) - ZM(:,:,JK,IM0(JN)) = ZN_SALTN *1E-3 - END WHERE - WHERE ((ZSEA(:,:) .GT. 0.).AND.(ZSEA(:,:) .LT. 1.)) - ZM(:,:,JK,IM0(JN)) = ZM(:,:,JK,IM0(JN))-(ZM(:,:,JK,IM0(JN)) -ZN_SALTN *1E-3) * & - (1. - ZSEA(:,:)) - END WHERE - END DO - - ZM(:,:,:,IM0(JN)) = MAX(ZMMIN(IM0(JN)), ZM(:,:,:,IM0(JN))) -! -!* 1.2 calculate moment 3 from m0, RG and SIG -! - ZM(:,:,:,IM3(JN)) = ZM(:,:,:,IM0(JN)) * & - (ZINIRADIUS(JN)**3)*EXP(4.5 * LOG(ZINISIGMA(JN))**2) - ZM(:,:,:,IM3(JN)) = MAX(ZMMIN(IM3(JN)), ZM(:,:,:,IM3(JN))) -! -!* 1.3 calculate moment 6 from m0, RG and SIG -! - ZM(:,:,:,IM6(JN))= ZM(:,:,:,IM0(JN)) * ((ZINIRADIUS(JN)**6)*& - EXP(18. * (LOG(ZINISIGMA(JN)))**2)) - ZM(:,:,:,IM6(JN)) = MAX(ZMMIN(IM6(JN)), ZM(:,:,:,IM6(JN))) -! -!* 1.4 output concentration -!+ Marine -! PSV(:,:,:,1+(JN-1)*3) = ZM(:,:,:,IM0(JN)) * XMD / (XAVOGADRO*PRHODREF(:,:,:)) -! PSV(:,:,:,2+(JN-1)*3) = ZM(:,:,:,IM3(JN)) * XMD*XPI * 4./3. / & -! (ZMI*PRHODREF(:,:,:)*(1.d0/ZRHOI)*XM3TOUM3_SALT) -! -! PSV(:,:,:,3+(JN-1)*3) = ZM(:,:,:,IM6(JN)) * XMD / (XAVOGADRO*PRHODREF(:,:,:)*1.d-6) -! -!++cb++20/10/16 - IMOMENTS = INT(NSV_SLTEND - NSV_SLTBEG + 1) / NMODE_SLT -!--cb-- - - IF (IMOMENTS == 3) THEN - PSV(:,:,:,1+(JN-1)*3) = ZM(:,:,:,IM0(JN)) * XMD / (XAVOGADRO*PRHODREF(:,:,:)) - PSV(:,:,:,2+(JN-1)*3) = ZM(:,:,:,IM3(JN)) * XMD*XPI * 4./3. / & - (ZMI*PRHODREF(:,:,:)*(1.d0/ZRHOI)*XM3TOUM3_SALT) - - PSV(:,:,:,3+(JN-1)*3) = ZM(:,:,:,IM6(JN)) * XMD / (XAVOGADRO*PRHODREF(:,:,:)*1.d-6) - ELSE IF (IMOMENTS == 2) THEN - PSV(:,:,:,1+(JN-1)*2) = ZM(:,:,:,IM0(JN)) * XMD / (XAVOGADRO*PRHODREF(:,:,:)) - PSV(:,:,:,2+(JN-1)*2) = ZM(:,:,:,IM3(JN)) * XMD*XPI * 4./3. / & - (ZMI*PRHODREF(:,:,:)*(1.d0/ZRHOI)*XM3TOUM3_SALT) - ELSE - PSV(:,:,:,JN) = ZM(:,:,:,IM3(JN)) * XMD*XPI * 4./3. / & - (ZMI*PRHODREF(:,:,:)*(1.d0/ZRHOI)*XM3TOUM3_SALT) - END IF -! -END DO -! -DEALLOCATE(ZSEA) -DEALLOCATE(ZMMIN) -DEALLOCATE(ZINISIGMA) -DEALLOCATE(ZINIRADIUS) -DEALLOCATE(ZSIGMA) -DEALLOCATE(ZM) -DEALLOCATE(ZCTOTA) -DEALLOCATE(IM6) -DEALLOCATE(IM3) -DEALLOCATE(IM0) -! -! -END SUBROUTINE SALTLFI_n diff --git a/src/ICCARE_BASE/set_mask.f90 b/src/ICCARE_BASE/set_mask.f90 deleted file mode 100644 index b4077f482..000000000 --- a/src/ICCARE_BASE/set_mask.f90 +++ /dev/null @@ -1,181 +0,0 @@ -!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!----------------------------------------------------------------- -!--------------- special set of characters for RCS information -!----------------------------------------------------------------- -! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/set_mask.f90,v $ $Revision: 1.2.2.1.2.1.18.2 $ -! MASDEV4_7 budget 2006/09/08 10:35:15 -!----------------------------------------------------------------- -! ################### - SUBROUTINE SET_MASK -! ################### -! -!!****SET_MASK** -routine to define the mask -!! -!! -!! PURPOSE -!! ------- -! The purpose of this routine is to test the occurence or not of the -! different criteria, used to compute the budgets. It also updates the -! number of occurence of the different criteria. -! -!!** METHOD -!! ------ -!! According to each criterion associated to one zone, the mask is -!! set to TRUE at each point where the criterion is confirmed, at each -!! time step of the model. Finally, The number of occurence of this criteria is -!! increased by 1 and stored in the array XBUSURF. -!! Caution : The mask is defined on the inner domain. -!! -!! -!! EXTERNAL -!! -------- -!! NONE -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! Module MODD_BUDGET -!! LBU_MASK : logical array mask defining the zones -!! NBUTIME : number of the budget step -!! XBUSURF : mask tracer array (surface array) -!! -!! REFERENCE -!! --------- -!! Book2 of MESO-NH documentation (routine BUDGET) -!! -!! -!! AUTHOR -!! ------ -!! J. Nicolau * Meteo France * -!! -!! MODIFICATIONS -!! ------------- -!! Original 27/02/95 -!! Modification 10/11/97 (P.Jabouille) : computation made only in the inner domain -!! Modification 18/06/99 (N.Asencio) : // , computation are performed on the extended -!! domain but logical array mask is initialized -!! to FALSE outside the physical domain -!! 02/02/2017 (J.Escobar & JPP ) bug for 1 model only <-> remove unneeded FIELD_MODEL% -!--------------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_BUDGET -USE MODE_ll -USE MODD_FIELD_n, ONLY : XWT, XRT -! -USE MODD_PRECIP_n, ONLY : XINPRR -USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT -USE MODD_REF_n, ONLY : XRHODREF -USE MODD_GRID_n, ONLY : XZZ -USE MODD_CST, ONLY : XRHOLW -! -IMPLICIT NONE -! -! -!* 0.2 Declarations of local variables : -! -INTEGER :: IIB,IJB ! Lower bounds of the physical - ! sub-domain in x and y directions -INTEGER :: IIE,IJE ! Upper bounds of the physical - ! sub-domain in x and y directions -! -INTEGER :: IKB, IKE -INTEGER :: IIU, IJU ! Array sizes in i,j directions -! -REAL, DIMENSION(:,:), ALLOCATABLE :: ZTHIC, ZTHRW, ZTHCW, ZTHSN, ZTHGR -REAL, DIMENSION(:,:), ALLOCATABLE :: ZTH_LIQ, ZTH_ICE -REAL, DIMENSION(:,:), ALLOCATABLE :: ZDUM -INTEGER :: JK ! loop index -! -!------------------------------------------------------------------------------- -! -!* 1. COMPUTES THE PHYSICAL SUBDOMAIN BOUNDS -! --------------------------------------- -! -CALL GET_INDICE_ll(IIB,IJB,IIE,IJE) -! -!* 2. DEFINITION OF THE MASK -! ---------------------- -! initialization to FALSE on the extended subdomain -LBU_MASK(:,:,:)=.FALSE. -! -! computing on the physical subdomain -!============================================================================== -! Change the following lines to set the criterion for each of the NBUMASK masks -! -IKB = 1 + JPVEXT -IKE = SIZE(XRHODREF,3) - JPVEXT -IIU = IIE + JPHEXT -IJU = IJE + JPHEXT -! -ALLOCATE(ZTHIC(IIU,IJU)) ; ZTHIC(:,:) = 0.0 -ALLOCATE(ZTHRW(IIU,IJU)) ; ZTHRW(:,:) = 0.0 -ALLOCATE(ZTHCW(IIU,IJU)) ; ZTHCW(:,:) = 0.0 -ALLOCATE(ZTHSN(IIU,IJU)) ; ZTHSN(:,:) = 0.0 -ALLOCATE(ZTHGR(IIU,IJU)) ; ZTHGR(:,:) = 0.0 -ALLOCATE(ZDUM(IIU,IJU)) ; ZDUM(:,:) = 0.0 -! -DO JK = IKB, IKE - ZDUM(:,:) = XRHODREF(:,:,JK) * (XZZ(:,:,JK+1) - XZZ(:,:,JK)) / XRHOLW - ZTHIC(:,:) = ZTHIC(:,:) + XRT(:,:,JK,4) * ZDUM(:,:) - ZTHRW(:,:) = ZTHRW(:,:) + XRT(:,:,JK,3) * ZDUM(:,:) - ZTHCW(:,:) = ZTHCW(:,:) + XRT(:,:,JK,2) * ZDUM(:,:) - ZTHSN(:,:) = ZTHSN(:,:) + XRT(:,:,JK,5) * ZDUM(:,:) - ZTHGR(:,:) = ZTHGR(:,:) + XRT(:,:,JK,6) * ZDUM(:,:) -END DO -! -! m --> mm -ZTHIC(:,:) = ZTHIC(:,:) * 1000. -ZTHRW(:,:) = ZTHRW(:,:) * 1000. -ZTHCW(:,:) = ZTHCW(:,:) * 1000. -ZTHSN(:,:) = ZTHSN(:,:) * 1000. -ZTHGR(:,:) = ZTHGR(:,:) * 1000. -! -ALLOCATE(ZTH_LIQ(IIU,IJU)) ; ZTH_LIQ(:,:) = 0.0 -ALLOCATE(ZTH_ICE(IIU,IJU)) ; ZTH_ICE(:,:) = 0.0 -! -ZTH_LIQ(:,:) = ZTHCW(:,:) + ZTHRW(:,:) -ZTH_ICE(:,:) = ZTHIC(:,:) + ZTHSN(:,:) + ZTHGR(:,:) -!print*, nbutime, ' - min-max inprr = ', minval(xinprr*3600.), maxval(xinprr*3600.) -!print*, nbutime, ' - min-max zth_liq = ', minval(zth_liq), maxval(zth_liq) -!print*, nbutime, ' - min-max zth_ice = ', minval(zth_ice), maxval(zth_ice) -! -LBU_MASK(IIB:IIE,IJB:IJE,1) = (XINPRR(IIB:IIE,IJB:IJE)*3.6E6) >= 5. -!LBU_MASK(IIB:IIE,IJB:IJE,2) = .NOT.(LBU_MASK(IIB:IIE,IJB:IJE,1)) .AND. & -! (XINPRR(IIB:IIE,IJB:IJE)*3.6E6) >= 0.5 .AND. & -! ZTH_LIQ(IIB:IIE,IJB:IJE) >= 0.01 .AND. & -! ZTH_ICE(IIB:IIE,IJB:IJE) >= 0.1 -LBU_MASK(IIB:IIE,IJB:IJE,2) = .NOT.(LBU_MASK(IIB:IIE,IJB:IJE,1)) .AND. & - ((XINPRR(IIB:IIE,IJB:IJE)*3.6E6) >= 0.5 .OR. & - ZTH_LIQ(IIB:IIE,IJB:IJE) >= 0.01 .AND. & - ZTH_ICE(IIB:IIE,IJB:IJE) >= 0.1) -LBU_MASK(IIB:IIE,IJB:IJE,3) = .NOT.(LBU_MASK(IIB:IIE,IJB:IJE,1)) .AND. & - .NOT.(LBU_MASK(IIB:IIE,IJB:IJE,2)) .AND. & - ZTH_LIQ(IIB:IIE,IJB:IJE) < 0.01 .AND. & - ZTH_ICE(IIB:IIE,IJB:IJE) >= 0.01 -! -DEALLOCATE(ZTHIC) -DEALLOCATE(ZTHRW) -DEALLOCATE(ZTHCW) -DEALLOCATE(ZTHSN) -DEALLOCATE(ZTHGR) -DEALLOCATE(ZTH_LIQ) -DEALLOCATE(ZTH_ICE) -DEALLOCATE(ZDUM) -! -!============================================================================== -! -!* 3. INCREASE IN SURFACE ARRAY -! ------------------------- -! -WHERE (LBU_MASK(:,:,:)) - NBUSURF(:,:,:,NBUTIME)=NBUSURF(:,:,:,NBUTIME)+1 -END WHERE -! -!------------------------------------------------------------------------------- -! -END SUBROUTINE SET_MASK diff --git a/src/ICCARE_BASE/surfex_alloc.F90 b/src/ICCARE_BASE/surfex_alloc.F90 deleted file mode 100644 index ca482ecd3..000000000 --- a/src/ICCARE_BASE/surfex_alloc.F90 +++ /dev/null @@ -1,244 +0,0 @@ -!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -SUBROUTINE SURFEX_ALLOC(YDSURFEX) -! -USE MODD_TEB_PAR, ONLY : NTEB_PATCH_MAX -USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE_ECOSG, NTILESFC -! -USE MODD_SURFEX_n, ONLY : SURFEX_t -! -USE MODD_CH_EMIS_FIELD_n, ONLY : CH_EMIS_FIELD_INIT -USE MODD_CH_SNAP_n, ONLY : CH_EMIS_SNAP_INIT -USE MODD_CH_SURF_n, ONLY : CH_SURF_INIT -USE MODD_DATA_COVER_n, ONLY : DATA_COVER_INIT -USE MODD_DUMMY_SURF_FIELDS_n, ONLY : DUMMY_SURF_FIELDS_INIT -USE MODD_EMIS_GR_FIELD_n, ONLY : EMIS_GR_FIELD_INIT -USE MODD_SFX_GRID_n, ONLY : GRID_INIT, GRID_NP_INIT -USE MODD_CANOPY_n, ONLY : CANOPY_INIT -USE MODD_GRID_CONF_PROJ_n, ONLY : GRID_CONF_PROJ_INIT -USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_INIT -USE MODD_SURF_ATM_n, ONLY : SURF_ATM_INIT -USE MODD_SSO_n, ONLY : SSO_INIT, SSO_NP_INIT -USE MODD_SV_n, ONLY : SV_INIT -! -USE MODD_DATA_TSZ0_n, ONLY : DATA_TSZ0_INIT -! -USE MODD_IDEAL_n, ONLY : IDEAL_INIT -! -USE MODD_DST_n, ONLY : DST_NP_INIT -USE MODD_SLT_n, ONLY : SLT_INIT -! -USE MODD_DIAG_n, ONLY : DIAG_INIT, DIAG_NP_INIT, DIAG_OPTIONS_INIT -! -USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_INIT, DIAG_EVAP_ISBA_NP_INIT -USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_INIT, DIAG_MISC_ISBA_NP_INIT -USE MODD_DIAG_OCEAN_n, ONLY : DIAG_OCEAN_INIT -USE MODD_DIAG_MISC_SEAICE_n, ONLY : DIAG_MISC_SEAICE_INIT -USE MODD_DIAG_MISC_FLAKE_n, ONLY : DIAG_MISC_FLAKE_INIT -USE MODD_DIAG_MISC_TEB_OPTIONS_n, ONLY : DIAG_MISC_TEB_OPTIONS_INIT -USE MODD_DIAG_UTCI_TEB_n, ONLY : DIAG_UTCI_TEB_INIT -USE MODD_DIAG_MISC_TEB_n, ONLY : DIAG_MISC_TEB_NP_INIT -! -USE MODD_DATA_BEM_n, ONLY : DATA_BEM_INIT -USE MODD_BEM_OPTION_n, ONLY : BEM_OPTIONS_INIT -USE MODD_BLD_DESCRIPTION_n, ONLY : BLD_DESC_INIT -USE MODD_CH_TEB_n, ONLY : CH_TEB_INIT -USE MODD_DATA_TEB_n, ONLY : DATA_TEB_INIT -USE MODD_TEB_IRRIG_n, ONLY : TEB_IRRIG_INIT -USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_INIT -USE MODD_TEB_PANEL_n, ONLY : TEB_PANEL_INIT -USE MODD_BEM_n, ONLY : BEM_NP_INIT -USE MODD_TEB_n, ONLY : TEB_NP_INIT -! -USE MODD_CH_FLAKE_n, ONLY : CH_FLAKE_INIT -USE MODD_FLAKE_n, ONLY : FLAKE_INIT -! -USE MODD_CH_WATFLUX_n, ONLY : CH_WATFLUX_INIT -USE MODD_WATFLUX_n, ONLY : WATFLUX_INIT -! -USE MODD_CH_ISBA_n, ONLY : CH_ISBA_INIT, CH_ISBA_NP_INIT -USE MODD_AGRI_n, ONLY : AGRI_NP_INIT -USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_INIT -USE MODD_GR_BIOG_n, ONLY : GR_BIOG_INIT, GR_BIOG_NP_INIT -USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_INIT -USE MODD_ISBA_n, ONLY : ISBA_S_INIT, ISBA_K_INIT, ISBA_P_INIT, & - ISBA_NK_INIT, ISBA_NP_INIT, ISBA_NPE_INIT -! -USE MODD_DMS_n, ONLY : DMS_INIT -USE MODD_DMS_SURF_FIELDS_n, ONLY : DMS_SURF_FIELDS_INIT - -USE MODD_MEGAN_n, ONLY : MEGAN_INIT -USE MODD_MEGAN_SURF_FIELDS_n, ONLY : MEGAN_SURF_FIELDS_INIT -! -USE MODD_CH_SEAFLUX_n, ONLY : CH_SEAFLUX_INIT -USE MODD_DATA_SEAFLUX_n, ONLY : DATA_SEAFLUX_INIT -USE MODD_SEAFLUX_n, ONLY : SEAFLUX_INIT -USE MODD_OCEAN_n, ONLY : OCEAN_INIT -USE MODD_OCEAN_REL_n, ONLY : OCEAN_REL_INIT -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -IMPLICIT NONE -! -TYPE (SURFEX_t), INTENT (INOUT) :: YDSURFEX -REAL(KIND=JPRB) :: ZHOOK_HANDLE -IF (LHOOK) CALL DR_HOOK("SURFEX_ALLOC",0,ZHOOK_HANDLE) - ! - CALL DIAG_OPTIONS_INIT(YDSURFEX%FM%DFO) - CALL DIAG_INIT(YDSURFEX%FM%DF) - CALL DIAG_INIT(YDSURFEX%FM%DFC) - CALL DIAG_MISC_FLAKE_INIT(YDSURFEX%FM%DMF) - ! - CALL GRID_INIT(YDSURFEX%FM%G) - CALL CANOPY_INIT(YDSURFEX%FM%SB) - CALL CH_FLAKE_INIT(YDSURFEX%FM%CHF) - CALL FLAKE_INIT(YDSURFEX%FM%F) - ! - ! - CALL DIAG_OPTIONS_INIT(YDSURFEX%WM%DWO) - CALL DIAG_INIT(YDSURFEX%WM%DW) - CALL DIAG_INIT(YDSURFEX%WM%DWC) - ! - CALL GRID_INIT(YDSURFEX%WM%G) - CALL CANOPY_INIT(YDSURFEX%WM%SB) - CALL CH_WATFLUX_INIT(YDSURFEX%WM%CHW) - CALL WATFLUX_INIT(YDSURFEX%WM%W) - ! - ! - CALL DIAG_OPTIONS_INIT(YDSURFEX%SM%SD%O) - CALL DIAG_INIT(YDSURFEX%SM%SD%D) - CALL DIAG_INIT(YDSURFEX%SM%SD%DC) - CALL DIAG_INIT(YDSURFEX%SM%SD%DI) - CALL DIAG_INIT(YDSURFEX%SM%SD%DIC) - CALL DIAG_OCEAN_INIT(YDSURFEX%SM%SD%GO) - CALL DIAG_MISC_SEAICE_INIT(YDSURFEX%SM%SD%DMI) - ! - CALL DATA_SEAFLUX_INIT(YDSURFEX%SM%DTS) - CALL GRID_INIT(YDSURFEX%SM%G) - CALL CANOPY_INIT(YDSURFEX%SM%SB) - CALL CH_SEAFLUX_INIT(YDSURFEX%SM%CHS) - CALL SEAFLUX_INIT(YDSURFEX%SM%S) - CALL SEAFLUX_INIT(YDSURFEX%SM%S) - CALL OCEAN_INIT(YDSURFEX%SM%O) - CALL OCEAN_REL_INIT(YDSURFEX%SM%OR) - ! - ! - CALL DIAG_OPTIONS_INIT(YDSURFEX%IM%ID%O) - CALL DIAG_INIT(YDSURFEX%IM%ID%D) - CALL DIAG_INIT(YDSURFEX%IM%ID%DC) - CALL DIAG_NP_INIT(YDSURFEX%IM%ID%ND,NVEGTYPE_ECOSG) - CALL DIAG_NP_INIT(YDSURFEX%IM%ID%NDC,NVEGTYPE_ECOSG) - CALL DIAG_EVAP_ISBA_INIT(YDSURFEX%IM%ID%DE) - CALL DIAG_EVAP_ISBA_INIT(YDSURFEX%IM%ID%DEC) - CALL DIAG_EVAP_ISBA_NP_INIT(YDSURFEX%IM%ID%NDE,NVEGTYPE_ECOSG) - CALL DIAG_EVAP_ISBA_NP_INIT(YDSURFEX%IM%ID%NDEC,NVEGTYPE_ECOSG) - CALL DIAG_MISC_ISBA_INIT(YDSURFEX%IM%ID%DM) - CALL DIAG_MISC_ISBA_NP_INIT(YDSURFEX%IM%ID%NDM,NVEGTYPE_ECOSG) - ! - CALL DATA_ISBA_INIT(YDSURFEX%IM%DTV) - CALL CANOPY_INIT(YDSURFEX%IM%SB) - CALL ISBA_OPTIONS_INIT(YDSURFEX%IM%O) - CALL ISBA_S_INIT(YDSURFEX%IM%S) - CALL CH_ISBA_INIT(YDSURFEX%IM%CHI) - CALL CH_ISBA_NP_INIT(YDSURFEX%IM%NCHI,NVEGTYPE_ECOSG) - CALL GR_BIOG_INIT(YDSURFEX%IM%GB) - CALL GR_BIOG_NP_INIT(YDSURFEX%IM%NGB,NVEGTYPE_ECOSG) - CALL SSO_INIT(YDSURFEX%IM%ISS) - CALL SSO_NP_INIT(YDSURFEX%IM%NISS,NVEGTYPE_ECOSG) - CALL GRID_INIT(YDSURFEX%IM%G) - CALL GRID_NP_INIT(YDSURFEX%IM%NG,NVEGTYPE_ECOSG) - CALL ISBA_K_INIT(YDSURFEX%IM%K) - CALL ISBA_NK_INIT(YDSURFEX%IM%NK,NVEGTYPE_ECOSG) - CALL ISBA_NP_INIT(YDSURFEX%IM%NP,NVEGTYPE_ECOSG) - CALL ISBA_NPE_INIT(YDSURFEX%IM%NPE,NVEGTYPE_ECOSG) - CALL AGRI_NP_INIT(YDSURFEX%IM%NAG,NVEGTYPE_ECOSG) - ! - CALL MEGAN_INIT(YDSURFEX%IM%MGN) - CALL MEGAN_SURF_FIELDS_INIT(YDSURFEX%IM%MSF) - ! - CALL DMS_INIT(YDSURFEX%SM%DMS) - CALL DMS_SURF_FIELDS_INIT(YDSURFEX%SM%DSF) - ! - CALL DIAG_NP_INIT(YDSURFEX%GDM%VD%ND,NTEB_PATCH_MAX) - CALL DIAG_EVAP_ISBA_NP_INIT(YDSURFEX%GDM%VD%NDE,NTEB_PATCH_MAX) - CALL DIAG_EVAP_ISBA_NP_INIT(YDSURFEX%GDM%VD%NDEC,NTEB_PATCH_MAX) - CALL DIAG_MISC_ISBA_NP_INIT(YDSURFEX%GDM%VD%NDM,NTEB_PATCH_MAX) - ! - CALL DATA_ISBA_INIT(YDSURFEX%GDM%DTV) - CALL ISBA_OPTIONS_INIT(YDSURFEX%GDM%O) - CALL ISBA_S_INIT(YDSURFEX%GDM%S) - CALL GR_BIOG_INIT(YDSURFEX%GDM%GB) - CALL ISBA_K_INIT(YDSURFEX%GDM%K) - CALL ISBA_P_INIT(YDSURFEX%GDM%P) - CALL ISBA_NPE_INIT(YDSURFEX%GDM%NPE,NTEB_PATCH_MAX) - ! - ! - CALL DIAG_NP_INIT(YDSURFEX%GRM%VD%ND,NTEB_PATCH_MAX) - CALL DIAG_EVAP_ISBA_NP_INIT(YDSURFEX%GRM%VD%NDE,NTEB_PATCH_MAX) - CALL DIAG_EVAP_ISBA_NP_INIT(YDSURFEX%GRM%VD%NDEC,NTEB_PATCH_MAX) - CALL DIAG_MISC_ISBA_NP_INIT(YDSURFEX%GRM%VD%NDM,NTEB_PATCH_MAX) - ! - CALL DATA_ISBA_INIT(YDSURFEX%GRM%DTV) - CALL ISBA_OPTIONS_INIT(YDSURFEX%GRM%O) - CALL ISBA_S_INIT(YDSURFEX%GRM%S) - CALL GR_BIOG_INIT(YDSURFEX%GRM%GB) - CALL ISBA_K_INIT(YDSURFEX%GRM%K) - CALL ISBA_P_INIT(YDSURFEX%GRM%P) - CALL ISBA_NPE_INIT(YDSURFEX%GRM%NPE,NTEB_PATCH_MAX) - ! - ! - CALL DIAG_OPTIONS_INIT(YDSURFEX%TM%TD%O) - CALL DIAG_INIT(YDSURFEX%TM%TD%D) - CALL DIAG_MISC_TEB_OPTIONS_INIT(YDSURFEX%TM%TD%MTO) - CALL DIAG_MISC_TEB_NP_INIT(YDSURFEX%TM%TD%NDMT,NTEB_PATCH_MAX) - CALL DIAG_MISC_TEB_NP_INIT(YDSURFEX%TM%TD%NDMTC,NTEB_PATCH_MAX) - CALL DIAG_UTCI_TEB_INIT(YDSURFEX%TM%TD%DUT) - ! - CALL DATA_TEB_INIT(YDSURFEX%TM%DTT) - CALL TEB_OPTIONS_INIT(YDSURFEX%TM%TOP) - CALL CANOPY_INIT(YDSURFEX%TM%SB) - CALL GRID_INIT(YDSURFEX%TM%G) - CALL CH_TEB_INIT(YDSURFEX%TM%CHT) - CALL TEB_PANEL_INIT(YDSURFEX%TM%TPN) - CALL TEB_IRRIG_INIT(YDSURFEX%TM%TIR) - CALL TEB_NP_INIT(YDSURFEX%TM%NT,NTEB_PATCH_MAX) - ! - CALL DATA_BEM_INIT(YDSURFEX%TM%DTB) - CALL BEM_OPTIONS_INIT(YDSURFEX%TM%BOP) - CALL BLD_DESC_INIT(YDSURFEX%TM%BDD) - CALL BEM_NP_INIT(YDSURFEX%TM%NB,NTEB_PATCH_MAX) - ! - ! - CALL DATA_COVER_INIT(YDSURFEX%DTCO) - CALL DATA_TSZ0_INIT(YDSURFEX%DTZ) - CALL DUMMY_SURF_FIELDS_INIT(YDSURFEX%DUU) - ! - CALL GRID_CONF_PROJ_INIT(YDSURFEX%GCP) - CALL SURF_ATM_GRID_INIT(YDSURFEX%UG) - CALL SURF_ATM_INIT(YDSURFEX%U) - CALL DIAG_OPTIONS_INIT(YDSURFEX%DUO) - CALL DIAG_INIT(YDSURFEX%DU) - CALL DIAG_INIT(YDSURFEX%DUC) - CALL DIAG_NP_INIT(YDSURFEX%DUP,NTILESFC) - CALL DIAG_NP_INIT(YDSURFEX%DUPC,NTILESFC) - CALL SSO_INIT(YDSURFEX%USS) - CALL CANOPY_INIT(YDSURFEX%SB) - ! - CALL DIAG_INIT(YDSURFEX%DL) - CALL DIAG_INIT(YDSURFEX%DLC) - CALL IDEAL_INIT(YDSURFEX%L) - ! - CALL SV_INIT(YDSURFEX%SV) - CALL CH_SURF_INIT(YDSURFEX%CHU) - CALL CH_EMIS_FIELD_INIT(YDSURFEX%CHE) - CALL CH_EMIS_SNAP_INIT(YDSURFEX%CHN) - CALL EMIS_GR_FIELD_INIT(YDSURFEX%EGF) - CALL DST_NP_INIT(YDSURFEX%NDST,NVEGTYPE_ECOSG) - CALL SLT_INIT(YDSURFEX%SLT) - ! -IF (LHOOK) CALL DR_HOOK("SURFEX_ALLOC",1,ZHOOK_HANDLE) -! -END SUBROUTINE SURFEX_ALLOC diff --git a/src/ICCARE_BASE/update_esm_surf_atmn.F90 b/src/ICCARE_BASE/update_esm_surf_atmn.F90 deleted file mode 100644 index 6d1ec2612..000000000 --- a/src/ICCARE_BASE/update_esm_surf_atmn.F90 +++ /dev/null @@ -1,304 +0,0 @@ -!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -! ################################################################################# -SUBROUTINE UPDATE_ESM_SURF_ATM_n (F, IM, S, U, W, TM, GDM, GRM, HPROGRAM, KI, KSW, PZENITH, & - PSW_BANDS, PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF ) -! ################################################################################# -! -!!**** *UPDATE_ESM_SURF_ATM_n * - Routine to update radiative properties in Earth -!! System Model (SEA, WATER, NATURE, TOWN) after -!! the call to OASIS coupler in order to close the -!! energy budget between radiative scheme and surfex -!! -!! PURPOSE -!! ------- -! -!!** METHOD -!! ------ -!! -!! REFERENCE -!! --------- -!! -!! -!! AUTHOR -!! ------ -!! B. Decharme -!! -!! MODIFICATIONS -!! ------------- -!! Original 09/2009 -!! B. Decharme 06/2013 new coupling variables -!! C. Lebeaupin 01/2020 add teb option -!! -!!------------------------------------------------------------- -! -! -USE MODD_FLAKE_n, ONLY : FLAKE_t -USE MODD_SURFEX_n, ONLY : ISBA_MODEL_t,TEB_MODEL_t, & - TEB_GARDEN_MODEL_t,TEB_GREENROOF_MODEL_t -USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t -USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t -USE MODD_WATFLUX_n, ONLY : WATFLUX_t -! -USE MODD_SURF_PAR, ONLY : XUNDEF -! -USE MODD_DATA_COVER_PAR, ONLY : NTILESFC -! -USE MODI_AVERAGE_RAD -! -USE MODI_AVERAGE_TSURF -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -USE MODI_ABOR1_SFX -! -USE MODI_UPDATE_ESM_ISBA_n -USE MODI_UPDATE_ESM_SEAFLUX_n -USE MODI_UPDATE_ESM_WATFLUX_n -USE MODI_UPDATE_ESM_FLAKE_n -USE MODI_UPDATE_ESM_TEB_n -! -IMPLICIT NONE -! -!* 0.1 declarations of arguments -! -! -TYPE(FLAKE_t), INTENT(INOUT) :: F -TYPE(ISBA_MODEL_t), INTENT(INOUT) :: IM -TYPE(SEAFLUX_t), INTENT(INOUT) :: S -TYPE(SURF_ATM_t), INTENT(INOUT) :: U -TYPE(WATFLUX_t), INTENT(INOUT) :: W -TYPE(TEB_MODEL_t), INTENT(INOUT) :: TM -TYPE(TEB_GARDEN_MODEL_t), INTENT(INOUT) :: GDM -TYPE(TEB_GREENROOF_MODEL_t), INTENT(INOUT) :: GRM - -! - CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes -INTEGER, INTENT(IN) :: KI ! number of points -INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands -REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! zenithal angle (radian from the vertical) -REAL, DIMENSION(KSW), INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m) -! -REAL, DIMENSION(KI), INTENT(OUT) :: PTRAD ! radiative temperature (K) -REAL, DIMENSION(KI,KSW),INTENT(OUT) :: PDIR_ALB ! direct albedo for each spectral band (-) -REAL, DIMENSION(KI,KSW),INTENT(OUT) :: PSCA_ALB ! diffuse albedo for each spectral band (-) -REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS ! emissivity (-) -REAL, DIMENSION(KI), INTENT(OUT) :: PTSURF ! surface effective temperature (K) -! -!* 0.2 declarations of local variables -! -INTEGER :: JTILE ! loop on type of surface -LOGICAL :: GNATURE, GTOWN, GWATER, GSEA ! .T. if the corresponding surface is represented -! -! Tile outputs: -! -REAL, DIMENSION(KI,NTILESFC) :: ZTRAD_TILE ! radiative surface temperature -REAL, DIMENSION(KI,NTILESFC) :: ZEMIS_TILE ! emissivity -REAL, DIMENSION(KI,NTILESFC) :: ZFRAC_TILE ! fraction of each surface type -REAL, DIMENSION(KI,NTILESFC) :: ZTSURF_TILE ! surface effective temperature -! -REAL, DIMENSION(KI,KSW,NTILESFC) :: ZDIR_ALB_TILE ! direct albedo -REAL, DIMENSION(KI,KSW,NTILESFC) :: ZSCA_ALB_TILE ! diffuse albedo -! -REAL(KIND=JPRB) :: ZHOOK_HANDLE -!------------------------------------------------------------------------------------- -! Preliminaries: Tile related operations -!------------------------------------------------------------------------------------- -! FLAGS for the various surfaces: -! -IF (LHOOK) CALL DR_HOOK('UPDATE_ESM_SURF_ATM_N',0,ZHOOK_HANDLE) -GSEA = (U%NSIZE_SEA >0 .AND. U%CSEA/='NONE') -GWATER = (U%NSIZE_WATER >0 .AND. U%CWATER/='NONE') -GNATURE = (U%NSIZE_NATURE >0 .AND. U%CNATURE/='NONE') -! -GTOWN = U%NSIZE_TOWN >0 -IF(GTOWN)THEN - IF ((HPROGRAM/='OFFLIN').AND.(HPROGRAM/='MESONH').AND.(HPROGRAM/='AROME ')) THEN - CALL ABOR1_SFX('UPDATE_ESM_SURF_ATM_n: TOWN SCHEME NOT YET AVAILABLE FOR EARTH SYSTEM MODEL') - ENDIF -ENDIF -! -! Tile counter: -! -JTILE = 0 -! -! Initialization: Outputs to atmosphere over each tile: -! -ZTRAD_TILE(:,:) = XUNDEF -ZDIR_ALB_TILE(:,:,:) = XUNDEF -ZSCA_ALB_TILE(:,:,:) = XUNDEF -ZEMIS_TILE(:,:) = XUNDEF -ZTSURF_TILE(:,:) = XUNDEF -! -! Fractions for each tile: -! -ZFRAC_TILE(:,:) = 0.0 -! -!-------------------------------------------------------------------------------------- -! Call arrange interfaces for sea, water, nature and town here... -!-------------------------------------------------------------------------------------- -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! SEA Tile calculations: -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! -JTILE = JTILE + 1 -! -IF(GSEA)THEN -! - ZFRAC_TILE(:,JTILE) = U%XSEA(:) -! - CALL TREAT_SURF(U%NSIZE_SEA,U%NR_SEA,JTILE) ! pack variables which are arguments to this routine -! -ENDIF -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! INLAND WATER Tile calculations: -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! -JTILE = JTILE + 1 -! -IF(GWATER)THEN -! - ZFRAC_TILE(:,JTILE) = U%XWATER(:) -! - CALL TREAT_SURF(U%NSIZE_WATER,U%NR_WATER,JTILE) -! -ENDIF -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! NATURAL SURFACE Tile calculations: -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! -JTILE = JTILE + 1 -! -IF(GNATURE)THEN -! - ZFRAC_TILE(:,JTILE) = U%XNATURE(:) -! - CALL TREAT_SURF(U%NSIZE_NATURE,U%NR_NATURE,JTILE) -! -ENDIF -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! URBAN Tile calculations: -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! -JTILE = JTILE + 1 -! -IF(GTOWN)THEN -! - ZFRAC_TILE(:,JTILE) = U%XTOWN(:) -! - CALL TREAT_SURF(U%NSIZE_TOWN,U%NR_TOWN,JTILE) -! -ENDIF -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Grid box average radiative properties: -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! - CALL AVERAGE_RAD(ZFRAC_TILE, & - ZDIR_ALB_TILE, ZSCA_ALB_TILE, ZEMIS_TILE, ZTRAD_TILE, & - PDIR_ALB, PSCA_ALB, PEMIS, PTRAD ) -! - CALL AVERAGE_TSURF(ZFRAC_TILE, ZTSURF_TILE, PTSURF) -! -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! -IF (LHOOK) CALL DR_HOOK('UPDATE_ESM_SURF_ATM_N',1,ZHOOK_HANDLE) -CONTAINS -!======================================================================================= -SUBROUTINE TREAT_SURF(KSIZE,KMASK,KTILE) -! -INTEGER, INTENT(IN) :: KSIZE -INTEGER, INTENT(IN), DIMENSION(:) :: KMASK -INTEGER, INTENT(IN) :: KTILE -! -REAL, DIMENSION(KSIZE) :: ZP_ZENITH ! zenithal angle (radian from the vertical) -! -REAL, DIMENSION(KSIZE) :: ZP_TRAD ! radiative temperature (K) -REAL, DIMENSION(KSIZE,KSW) :: ZP_DIR_ALB ! direct albedo for each spectral band (-) -REAL, DIMENSION(KSIZE,KSW) :: ZP_SCA_ALB ! diffuse albedo for each spectral band (-) -REAL, DIMENSION(KSIZE) :: ZP_EMIS ! emissivity -REAL, DIMENSION(KSIZE) :: ZP_TSURF ! effective temperature (K) -! -INTEGER :: JJ -REAL(KIND=JPRB) :: ZHOOK_HANDLE -! -! input arguments: -! -IF (LHOOK) CALL DR_HOOK('UPDATE_ESM_SURF_ATM_N:TREAT_SURF',0,ZHOOK_HANDLE) -! -ZP_TRAD = XUNDEF -ZP_DIR_ALB = XUNDEF -ZP_SCA_ALB = XUNDEF -ZP_EMIS = XUNDEF -ZP_TSURF = XUNDEF -! -DO JJ=1,KSIZE - ZP_ZENITH(JJ) = PZENITH (KMASK(JJ)) -ENDDO -! -! -IF (KTILE==1) THEN - ! - IF (U%CSEA=='SEAFLX') THEN - CALL UPDATE_ESM_SEAFLUX_n(S, U%NSIZE_SEA,KSW,ZP_ZENITH,ZP_DIR_ALB, & - ZP_SCA_ALB,ZP_EMIS,ZP_TRAD,ZP_TSURF ) - ELSE - CALL ABOR1_SFX('UPDATE_ESM_SURF_ATM_n: SEA SCHEME MUST BE ACTIVATED FOR EARTH SYSTEM MODEL') - ENDIF - ! -ELSEIF (KTILE==2) THEN - ! - IF (U%CWATER=='WATFLX') THEN - CALL UPDATE_ESM_WATFLUX_n(W, U%NSIZE_WATER,KSW,ZP_ZENITH,ZP_DIR_ALB, & - ZP_SCA_ALB,ZP_EMIS,ZP_TRAD,ZP_TSURF ) - ELSEIF (U%CWATER=='FLAKE ') THEN - CALL UPDATE_ESM_FLAKE_n(F, U%NSIZE_WATER,KSW,ZP_ZENITH,ZP_DIR_ALB, & - ZP_SCA_ALB,ZP_EMIS,ZP_TRAD,ZP_TSURF ) - ELSE - CALL ABOR1_SFX('UPDATE_ESM_SURF_ATM_n: INLAND WATER SCHEME MUST BE ACTIVATED FOR EARTH SYSTEM MODEL') - ENDIF - ! -ELSEIF (KTILE==3) THEN - ! - IF (U%CNATURE=='ISBA') THEN - CALL UPDATE_ESM_ISBA_n(IM%O, IM%S, IM%K, IM%NK, IM%NP, IM%NPE, U%NSIZE_NATURE,& - KSW,ZP_ZENITH,PSW_BANDS,ZP_DIR_ALB, & - ZP_SCA_ALB,ZP_EMIS,ZP_TRAD,ZP_TSURF ) - ELSE - CALL ABOR1_SFX('UPDATE_ESM_SURF_ATM_n: NATURE SCHEME MUST BE ACTIVATED FOR EARTH SYSTEM MODEL') - ENDIF - ! -ELSEIF (KTILE==4) THEN - ! - IF (U%CTOWN=='TEB ') THEN - CALL UPDATE_ESM_TEB_n(TM%TOP, TM%TPN, TM%NT, TM%NB, GDM, GRM, U%NSIZE_TOWN, & - KSW,ZP_ZENITH,PSW_BANDS,ZP_DIR_ALB,ZP_SCA_ALB,& - ZP_EMIS,ZP_TRAD,ZP_TSURF) - ELSE - CALL ABOR1_SFX('UPDATE_ESM_SURF_ATM_n: TEB SCHEME MUST BE ACTIVATED FOR EARTH SYSTEM MODEL') - ENDIF -! ! -ENDIF -! -DO JJ=1,KSIZE - ZTRAD_TILE (KMASK(JJ),KTILE) = ZP_TRAD (JJ) - ZDIR_ALB_TILE (KMASK(JJ),:,KTILE)= ZP_DIR_ALB (JJ,:) - ZSCA_ALB_TILE (KMASK(JJ),:,KTILE)= ZP_SCA_ALB (JJ,:) - ZEMIS_TILE (KMASK(JJ),KTILE) = ZP_EMIS (JJ) - ZTSURF_TILE (KMASK(JJ),KTILE) = ZP_TSURF (JJ) -ENDDO -! -IF (LHOOK) CALL DR_HOOK('UPDATE_ESM_SURF_ATM_N:TREAT_SURF',1,ZHOOK_HANDLE) -! -END SUBROUTINE TREAT_SURF -!======================================================================================= -! -END SUBROUTINE UPDATE_ESM_SURF_ATM_n - - diff --git a/src/ICCARE_BASE/update_esm_tebn.F90 b/src/ICCARE_BASE/update_esm_tebn.F90 deleted file mode 100644 index 5ae13b2a4..000000000 --- a/src/ICCARE_BASE/update_esm_tebn.F90 +++ /dev/null @@ -1,199 +0,0 @@ -! ####################################################################################### - SUBROUTINE UPDATE_ESM_TEB_n(TOP, TPN, NT, NB, GDM, GRM, KI,KSW,PZENITH,PSW_BANDS,& - PDIR_ALB,PSCA_ALB,PEMIS,PTSRAD,PTSURF) -! ####################################################################################### -! -!!**** *UPDATE_ESM_TEB_n* - routine to update TEB radiative properties in Earth -!! System Model after the call to OASIS coupler in order -!! to close the energy budget between radiative scheme and surfex -!! -!! PURPOSE -!! ------- -!! -!!** METHOD -!! ------ -!! -!! EXTERNAL -!! -------- -!! -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! REFERENCE -!! --------- -!! -!! -!! AUTHOR -!! ------ -!! C. Lebeaupin Brossier -!! -!! MODIFICATIONS -!! ------------- -!! Original 01/2015 -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! - -USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t -USE MODD_TEB_PANEL_n, ONLY : TEB_PANEL_t -USE MODD_TEB_n, ONLY : TEB_NP_t -USE MODD_BEM_n, ONLY : BEM_NP_t -USE MODD_SURFEX_n, ONLY : TEB_GARDEN_MODEL_t, TEB_GREENROOF_MODEL_t - -! -USE MODD_SURF_PAR, ONLY: XUNDEF -USE MODD_CSTS, ONLY : XPI -! -USE MODI_TEB_VEG_PROPERTIES -USE MODI_AVERAGED_TSRAD_TEB -USE MODI_AVERAGED_ALBEDO_TEB -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -IMPLICIT NONE -! -!* 0.1 Declarations of arguments -! ------------------------- -! -TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP -TYPE(TEB_PANEL_t), INTENT(INOUT) :: TPN -TYPE(TEB_NP_t), INTENT(INOUT) :: NT -TYPE(BEM_NP_t), INTENT(INOUT) :: NB -TYPE(TEB_GARDEN_MODEL_t), INTENT(INOUT) :: GDM -TYPE(TEB_GREENROOF_MODEL_t), INTENT(INOUT) :: GRM -! -INTEGER, INTENT(IN) :: KI ! number of points -INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands -! -REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! solar zenithal angle -REAL, DIMENSION(KSW), INTENT(IN) :: PSW_BANDS ! middle wavelength of each band -! -REAL, DIMENSION(KI,KSW),INTENT(OUT) :: PDIR_ALB ! direct albedo for each band -REAL, DIMENSION(KI,KSW),INTENT(OUT) :: PSCA_ALB ! diffuse albedo for each band -REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS ! emissivity -REAL, DIMENSION(KI), INTENT(OUT) :: PTSRAD ! radiative temperature -REAL, DIMENSION(KI), INTENT(OUT) :: PTSURF ! surface temperature -REAL(KIND=JPRB) :: ZHOOK_HANDLE -! -! -!* 0.2 Declarations of local variables -! ------------------------------- -! -INTEGER :: ILU ! sizes of TEB arrays -INTEGER :: ISWB ! number of shortwave spectral bands -INTEGER :: JSWB ! loop on shortwave spectral bands -! -REAL, DIMENSION(:), ALLOCATABLE :: ZDIR_ALB ! direct town albedo -REAL, DIMENSION(:), ALLOCATABLE :: ZSCA_ALB ! diffuse town albedo -! -! local variables for urban green areas -REAL, DIMENSION(KI,KSW) :: ZDIR_ALB_GARDEN ! direct albedo for each band -REAL, DIMENSION(KI,KSW) :: ZSCA_ALB_GARDEN ! diffuse albedo for each band -REAL, DIMENSION(KI,KSW) :: ZDIR_SW ! direct SW for each band -REAL, DIMENSION(KI,KSW) :: ZSCA_SW ! diffuse SW for each band -REAL, DIMENSION(KI) :: ZEMIS_GARDEN ! emissivity -REAL, DIMENSION(KI) :: ZALB_GARDEN ! albedo -REAL, DIMENSION(KI) :: ZTS_GARDEN ! radiative temperature -! -REAL, DIMENSION(KI) :: ZEMIS_GREENROOF ! emissivity -REAL, DIMENSION(KI) :: ZALB_GREENROOF ! albedo -REAL, DIMENSION(KI) :: ZTS_GREENROOF ! radiative temperature -! -REAL, DIMENSION(KI) :: ZAZIM !** strong simplification: to change -REAL, DIMENSION(KI) :: ZWGT !** weight sum -! -INTEGER :: JP -! -!------------------------------------------------------------------------------- -! -! -!* 1. Emissivity, radiative temperature and surf temperature -! ------------------------------------------------------ -! -IF (LHOOK) CALL DR_HOOK('UPDATE_ESM_TEB_N',0,ZHOOK_HANDLE) -! *copy from init_tebn * -ILU = SIZE(TOP%XCOVER,1) -! -PTSURF(:)=0. -ZWGT(:)=0. -! -DO JP=1,TOP%NTEB_PATCH -! - IF (TOP%LGARDEN) THEN - ZDIR_SW=0. ! night as first guess for albedo computation - ZSCA_SW=0. ! - CALL TEB_VEG_PROPERTIES(NT%AL(JP)%XGARDEN, GDM%O, GDM%NPE%AL(JP), & - ZDIR_SW, ZSCA_SW, PSW_BANDS, KSW, & - ZTS_GARDEN, ZEMIS_GARDEN, ZALB_GARDEN ) - ELSE - ZALB_GARDEN = XUNDEF - ZEMIS_GARDEN= XUNDEF - ZTS_GARDEN = XUNDEF - END IF -! - IF (TOP%LGREENROOF) THEN - ZDIR_SW=0. ! night as first guess for albedo computation - ZSCA_SW=0. ! - CALL TEB_VEG_PROPERTIES(NT%AL(JP)%XGREENROOF, GRM%O, GRM%NPE%AL(JP), & - ZDIR_SW, ZSCA_SW, PSW_BANDS, KSW, & - ZTS_GREENROOF, ZEMIS_GREENROOF, ZALB_GREENROOF ) - ELSE - ZALB_GREENROOF = XUNDEF - ZEMIS_GREENROOF = XUNDEF - ZTS_GREENROOF = XUNDEF - END IF -! -!* averaged emissivity and radiative temperature -! - CALL AVERAGED_TSRAD_TEB(NT%AL(JP), NB%AL(JP), ZEMIS_GARDEN, ZTS_GARDEN, & - ZEMIS_GREENROOF, ZTS_GREENROOF, PEMIS, PTSRAD ) -!* averaged surface temperature -!* - CLB: to verify - PTSURF(:)=PTSURF(:)+NT%AL(JP)%XROAD(:)*NT%AL(JP)%XT_ROAD(:,1)+NT%AL(JP)%XBLD(:)*NT%AL(JP)%XT_ROOF(:,1)& - +NT%AL(JP)%XWALL_O_HOR(:)*NT%AL(JP)%XT_WALL_A(:,1) - ZWGT(:)=ZWGT(:) +NT%AL(JP)%XROAD(:)+NT%AL(JP)%XBLD(:)+NT%AL(JP)%XWALL_O_HOR(:) -! - IF (TOP%LGARDEN) THEN - PTSURF(:)=PTSURF(:)+NT%AL(JP)%XGARDEN(:)*ZTS_GARDEN(:) - ZWGT(:) = ZWGT(:) + NT%AL(JP)%XGARDEN(:) - ENDIF - IF (TOP%LGREENROOF) THEN - PTSURF(:)=PTSURF(:)+NT%AL(JP)%XGREENROOF(:)*ZTS_GREENROOF(:) - ZWGT(:) = ZWGT(:) + NT%AL(JP)%XGREENROOF(:) - ENDIF -!* -! -! -!* 2. Visible and near-infra-red Radiative fields: -! ------------------------------------------- -! - ALLOCATE(ZDIR_ALB(ILU)) - ALLOCATE(ZSCA_ALB(ILU)) -! - ZAZIM=XPI !PAZIM? - CALL AVERAGED_ALBEDO_TEB(TOP,NT%AL(JP),TPN,NB%AL(JP),PZENITH,ZAZIM, & - ZALB_GARDEN, ZALB_GREENROOF,ZDIR_ALB, ZSCA_ALB) -! - ISWB=SIZE(PSW_BANDS) - DO JSWB=1,ISWB - PDIR_ALB(:,JSWB) = ZDIR_ALB(:) - PSCA_ALB(:,JSWB) = ZSCA_ALB(:) - END DO -! - DEALLOCATE(ZDIR_ALB) - DEALLOCATE(ZSCA_ALB) -! -ENDDO -! -! - verif? -PTSURF(:) = PTSURF(:)/ZWGT(:) -! -IF (LHOOK) CALL DR_HOOK('UPDATE_ESM_TEB_N',1,ZHOOK_HANDLE) -! -!------------------------------------------------------------------------------- -! -END SUBROUTINE UPDATE_ESM_TEB_n diff --git a/src/ICCARE_BASE/ver_prep_netcdf_case.f90 b/src/ICCARE_BASE/ver_prep_netcdf_case.f90 deleted file mode 100644 index 9cc6fab58..000000000 --- a/src/ICCARE_BASE/ver_prep_netcdf_case.f90 +++ /dev/null @@ -1,222 +0,0 @@ -!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!----------------------------------------------------------------- -! ################################ - MODULE MODI_VER_PREP_NETCDF_CASE -! ################################ -INTERFACE - SUBROUTINE VER_PREP_NETCDF_CASE(PDIAG, PSV_LS) -! -REAL, INTENT(OUT) :: PDIAG ! diagnostics computing time -REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSV_LS ! sv var. -! -END SUBROUTINE VER_PREP_NETCDF_CASE -END INTERFACE -END MODULE MODI_VER_PREP_NETCDF_CASE -! #################################################################### - SUBROUTINE VER_PREP_NETCDF_CASE(PDIAG, PSV_LS) -! #################################################################### -! -!!**** *VER_PREP_NETCDF_CASE* - monitors the preparation to orographic change -!! -!! PURPOSE -!! ------- -!! This routine monitors the preparation of variables to future change -!! of orography, according to the type of input file. -!! -!!** METHOD -!! ------ -!! -!! -!! EXTERNAL -!! -------- -!! -!! function MZF -!! routine VER_INTERP_TO_MIXED_GRID -!! routine CHANGE_GRIBEX_VAR -!! -!! module MODI_SHUMAN -!! module MODI_VER_INTERP_TO_MIXED_GRID -!! module MODI_CHANGE_GRIBEX_VAR -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! Module MODD_CONF1 : contains configuration variables for all models. -!! NVERB : verbosity level for output-listing -!! Module MODD_LUNIT : contains logical unit names for all models -!! TLUOUT0 : output-listing file -!! Module MODD_CST : contains physical constants -!! XRD : gas constant for dry air -!! XRV : gas constant for vapor -!! XP00: reference pressure -!! XCPD: specific heat for dry air -!! XG : gravity constant -!! XRADIUS : earth radius -!! -!! REFERENCE -!! --------- -!! -!! Book 2 -!! -!! AUTHOR -!! ------ -!! -!! V.Masson Meteo-France -!! -!! MODIFICATIONS -!! ------------- -!! Original 14/12/94 -!! Jan, 31 1996 (V. Masson) duplication of the routine -!! to accept different input fields -!! May, 25 1996 (V. Masson) take into account the upper level -!! Aug, 20 1996 (V. Masson) correction on theta -!! Oct, 20 1996 (V. Masson) add deallocations -!! Dec, 06 1996 (V. Masson) add air temperature at ground -!! Dec, 12 1996 (V. Masson) add vertical wind velocity -!! May, 07 1997 (V. Masson) add null tke -!! Jun, 10 1997 (V. Masson) add null difference between -!! pressure and hydrostatic pressure -!! Jul, 11 1997 (V. Masson) add null scalar variables -!! Nov, 22 2000 (I. Mallet) add scalar variables -!! Nov, 22 2000 (P. Jabouille) change routine name -!! May 2006 Remove EPS -!! Oct 2017 (J.Escobar) minor, missing USE MODI_SECOND_MNH -!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O -!! Mars 2019 (Q. Rodier): missing SECOND_MNH(ZTIME1) -!! Fevruary 2021 (M. Leriche) : XSV_LS in argument to avoid -!! duplicate the routine -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_CONF -USE MODD_CONF_n -USE MODD_CST -USE MODD_LUNIT, ONLY: TLUOUT0 -USE MODD_PARAMETERS, ONLY : JPVEXT, XUNDEF -USE MODD_PREP_REAL -! -USE MODE_THERMO -! -USE MODI_CHANGE_GRIBEX_VAR -USE MODI_COMPUTE_EXNER_FROM_TOP -USE MODI_RMS_AT_Z -USE MODI_SECOND_MNH -USE MODI_SHUMAN -USE MODI_VER_INTERP_TO_MIXED_GRID -USE MODI_WATER_SUM -! -IMPLICIT NONE -! -!* 0.1 Declaration of arguments -! ------------------------ -! -REAL, INTENT(OUT) :: PDIAG ! diagnostics computing time -REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSV_LS ! sv var. -! -!* 0.2 Declaration of local variables -! ------------------------------ -INTEGER :: ILUOUT0 -INTEGER :: IIU,IJU,ILU -REAL :: ZTIME1, ZTIME2 -REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZTH_LS ! potential temperature -REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZTH_MX ! potential temperature -REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZPMASS_MX ! pressure -REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZHEXNFLUX_MX ! pressure function -REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZHEXNMASS_MX ! pressure function -! -REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZZFLUX_LS -REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZZMASS_LS -REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZPMHP_LS -REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZTHV_LS -REAL,DIMENSION(:,:,:,:),ALLOCATABLE:: ZR_LS -REAL,DIMENSION(:,:,:,:),ALLOCATABLE:: ZSV_LS -REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZHU_LS -REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZU_LS -REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZV_LS -REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZW_LS -REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZTKE_LS -INTEGER :: JRR ! loop counter -INTEGER :: JSV ! loop counter -INTEGER :: JK ! loop counter -!------------------------------------------------------------------------------- -! -ILUOUT0 = TLUOUT0%NLU -CALL SECOND_MNH(ZTIME1) -! -!* 1. CHANGING OF VARIABLES -! --------------------- -! - IIU=SIZE(XT_SV_LS,1) - IJU=SIZE(XT_SV_LS,2) - ILU=SIZE(XT_SV_LS,3) -! -! - ALLOCATE(XPMASS_SV_LS(IIU,IJU,ILU)) - ALLOCATE(XZMASS_SV_LS(IIU,IJU,ILU),XZFLUX_SV_LS(IIU,IJU,ILU)) - ALLOCATE(XTHV_SV_LS(IIU,IJU,ILU),XR_SV_LS(IIU,IJU,ILU,NRR),XHU_SV_LS(IIU,IJU,ILU)) - CALL CHANGE_GRIBEX_VAR(XA_SV_LS,XB_SV_LS,XP00_SV_LS,XPS_SV_LS,XZS_SV_LS, & - XT_SV_LS,XQ_SV_LS,XPMASS_SV_LS,XZFLUX_SV_LS,XZMASS_SV_LS, & - XTHV_SV_LS,XR_SV_LS,XHU_SV_LS ) -! -!------------------------------------------------------------------------------- -! -!* 2. INTERPOLATION TO MIXED GRID AND DIAGNOSTIC VARIABLES -! ---------------------------------------------------- -!* Add extra points below and above grids, in order to use MESONH linear -! vertical interpolation programs with all ILU physical points -! -ALLOCATE(ZZMASS_LS(IIU,IJU,ILU+2*JPVEXT)) -ALLOCATE(ZSV_LS(IIU,IJU,ILU+2*JPVEXT,SIZE(PSV_LS,4))) -! -ZZMASS_LS (:,:,JPVEXT+1:JPVEXT+ILU) = XZMASS_SV_LS(:,:,:) -DO JK=1,JPVEXT - ZZMASS_LS(:,:, JK) = XZMASS_SV_LS(:,:,1) - (XZMASS_SV_LS(:,:,2) -XZMASS_SV_LS(:,:,1) )*(JPVEXT+1-JK) - ZZMASS_LS(:,:,ILU+JPVEXT+JK) = XZMASS_SV_LS(:,:,ILU) + (XZMASS_SV_LS(:,:,ILU)-XZMASS_SV_LS(:,:,ILU-1))* JK -END DO -! -!ZSV_LS = XUNDEF -ZSV_LS = -999. -! -DO JSV=1,SIZE(PSV_LS,4) - ZSV_LS (:,:,JPVEXT+1:JPVEXT+ILU,JSV) = PSV_LS (:,:,:,JSV) -END DO -! - CALL VER_INTERP_TO_MIXED_GRID('CHEM',.TRUE.,XZS_SV_LS,XZS_SV_LS,& - ZZMASS_LS,ZSV_LS ) -! -DEALLOCATE(ZZMASS_LS) -DEALLOCATE(ZSV_LS) -!------------------------------------------------------------------------------- -! -!* 3. ERROR CONTROL -! ------------- -! -CALL SECOND_MNH(ZTIME2) -PDIAG = ZTIME2 - ZTIME1 -! -!------------------------------------------------------------------------------- -! -!* 4. DEALLOCATIONS -! ------------- -! - DEALLOCATE(XA_SV_LS) - DEALLOCATE(XB_SV_LS) - DEALLOCATE(XT_SV_LS) - DEALLOCATE(XQ_SV_LS) - DEALLOCATE(XZMASS_SV_LS) - DEALLOCATE(XZFLUX_SV_LS) - DEALLOCATE(XTHV_SV_LS) - DEALLOCATE(XR_SV_LS) - DEALLOCATE(XHU_SV_LS) -! -! -!------------------------------------------------------------------------------- -! -WRITE(ILUOUT0,*) 'Routine VER_PREP_NETCDF_CASE completed' -! -END SUBROUTINE VER_PREP_NETCDF_CASE diff --git a/src/ICCARE_BASE/write_diag_pgd_isban.F90 b/src/ICCARE_BASE/write_diag_pgd_isban.F90 deleted file mode 100644 index a3d13829f..000000000 --- a/src/ICCARE_BASE/write_diag_pgd_isban.F90 +++ /dev/null @@ -1,642 +0,0 @@ -!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -! ######### - SUBROUTINE WRITE_DIAG_PGD_ISBA_n (DTCO, HSELECT, U, CHI, NCHI, OSURF_DIAG_ALBEDO, & - IO, S, K, NP, NPE, ISS, HPROGRAM) -! ######################################### -! -!!**** *WRITE_DIAG_PGD_ISBA_n* - writes the ISBA physiographic diagnostic fields -!! -!! PURPOSE -!! ------- -!! -!!** METHOD -!! ------ -!! -!! EXTERNAL -!! -------- -!! -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! REFERENCE -!! --------- -!! -!! -!! AUTHOR -!! ------ -!! V. Masson *Meteo France* -!! -!! MODIFICATIONS -!! ------------- -!! Original 01/2004 -!! Modified 10/2004 by P. Le Moigne: add XZ0REL, XVEGTYPE_PATCH -!! Modified 11/2005 by P. Le Moigne: limit length of VEGTYPE_PATCH field names -!! Modified 11/2013 by B. Decharme : XPATCH now in writesurf_isban.F90 -!! Modified 10/2014 by P. Samuelsson: MEB variables -!! Modified 06/2014 by B. Decharme : add XVEGTYPE -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_TYPE_DATE_SURF -! -USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t -USE MODD_SSO_n, ONLY : SSO_t -USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t -USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t, CH_ISBA_NP_t -USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t -USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t, ISBA_NP_t, ISBA_NPE_t, ISBA_P_t, ISBA_PE_t -! -USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF -USE MODD_AGRI, ONLY : LAGRIP -! -! -USE MODD_IO_SURF_FA, ONLY : LFANOCOMPACT, LPREP -! -USE MODI_INIT_IO_SURF_n -USE MODI_WRITE_SURF -USE MODI_END_IO_SURF_n -USE MODI_WRITE_FIELD_1D_PATCH -USE MODI_WRITE_TFIELD_1D_PATCH -USE MODI_UNPACK_SAME_RANK -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -IMPLICIT NONE -! -!* 0.1 Declarations of arguments -! ------------------------- -! -! -TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO - CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT -TYPE(SURF_ATM_t), INTENT(INOUT) :: U -TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI -TYPE(CH_ISBA_NP_t), INTENT(INOUT) :: NCHI -LOGICAL, INTENT(IN) :: OSURF_DIAG_ALBEDO -TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO -TYPE(ISBA_S_t), INTENT(INOUT) :: S -TYPE(ISBA_K_t), INTENT(INOUT) :: K -TYPE(ISBA_NP_t), INTENT(INOUT) :: NP -TYPE(ISBA_NPE_t), INTENT(INOUT) :: NPE -TYPE(SSO_t), INTENT(INOUT) :: ISS -! - CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling -! -!* 0.2 Declarations of local variables -! ------------------------------- -! -TYPE(ISBA_P_t), POINTER :: PK -TYPE(ISBA_PE_t), POINTER :: PEK -! -REAL, DIMENSION(U%NSIZE_NATURE,IO%NPATCH) :: ZWORK -! -REAL, DIMENSION(:), ALLOCATABLE :: ZWORK1 -REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK2 -! -REAL, DIMENSION(U%NSIZE_NATURE,SIZE(NP%AL(1)%XDG,2)) :: ZDG ! Work array -REAL, DIMENSION(U%NSIZE_NATURE) :: ZDG2 -REAL, DIMENSION(U%NSIZE_NATURE) :: ZDTOT -! -INTEGER :: IRESP ! IRESP : return-code if a problem appears -CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read -CHARACTER(LEN=100):: YCOMMENT ! Comment string -CHARACTER(LEN=2) :: YLVLV, YPAS -CHARACTER(LEN=4) :: YLVL - CHARACTER(LEN=2) :: YPAT -! -INTEGER :: JI, JL, JP, ILAYER, ILU, IMASK -INTEGER :: ISIZE_LMEB_PATCH ! Number of patches where multi-energy balance should be applied -REAL(KIND=JPRB) :: ZHOOK_HANDLE -!------------------------------------------------------------------------------- -! -! Initialisation for IO -! -IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_PGD_ISBA_N',0,ZHOOK_HANDLE) -! -ILU = U%NSIZE_NATURE -! -ISIZE_LMEB_PATCH=COUNT(IO%LMEB_PATCH(:)) -! -CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'NATURE','ISBA ','WRITE','ISBA_VEG_EVOLUTION.OUT.nc') -! -!------------------------------------------------------------------------------- -! -!* Leaf Area Index -! -IF (IO%CPHOTO=='NON' .OR. IO%CPHOTO=='AST') THEN - ! - YRECFM='LAI' - YCOMMENT='leaf area index (-)' - ! - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XLAI(:),ILU,S%XWORK_WR) - ENDDO - ! -ENDIF -! -!* Leaf Area Index previous -! -IF (IO%CPHOTO=='NON' .OR. IO%CPHOTO=='AST') THEN - ! - YRECFM='LAIp' - YCOMMENT='leaf area index previous (-)' - ! - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XLAIp(:),ILU,S%XWORK_WR) - ENDDO - ! -ENDIF - -!------------------------------------------------------------------------------- -! -!* Vegetation fraction -! -YRECFM='VEG' -YCOMMENT='vegetation fraction (-)' -! -DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XVEG(:),ILU,S%XWORK_WR) -ENDDO -! -!* Surface roughness length (without snow) -! -YRECFM='Z0VEG' -YCOMMENT='surface roughness length (without snow) (m)' -! -DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XZ0(:),ILU,S%XWORK_WR) -ENDDO -! -IF (ISIZE_LMEB_PATCH>0) THEN - ! - YRECFM='GNDLITTER' - YCOMMENT='MEB: ground litter fraction (-)' - ! -DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XGNDLITTER(:),ILU,S%XWORK_WR) -ENDDO - ! - YRECFM='Z0LITTER' - YCOMMENT='MEB: ground litter roughness length (without snow) (m)' - ! -DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XZ0LITTER(:),ILU,S%XWORK_WR) -ENDDO - ! -ENDIF -! -!------------------------------------------------------------------------------- -! -!* Soil depth for each patch -! -DO JL=1,SIZE(NP%AL(1)%XDG,2) - IF (JL<10) THEN - WRITE(YRECFM,FMT='(A2,I1)') 'DG',JL - ELSE - WRITE(YRECFM,FMT='(A2,I2)') 'DG',JL - ENDIF - YCOMMENT='soil depth'//' (M)' -DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NP%AL(JP)%XDG(:,JL),ILU,S%XWORK_WR) -ENDDO -END DO -! -!* Averaged Soil depth -! -IF(IO%NPATCH>1)THEN -! - ZDG(:,:)=0.0 - DO JP=1,IO%NPATCH - PK => NP%AL(JP) - DO JL=1,SIZE(PK%XDG,2) - DO JI=1, PK%NSIZE_P - IMASK = PK%NR_P(JI) - ZDG(IMASK,JL) = ZDG(IMASK,JL) + PK%XPATCH(JI)*PK%XDG(JI,JL) - ENDDO - ENDDO - ENDDO -! - DO JL=1,SIZE(NP%AL(1)%XDG,2) - WRITE(YLVL,'(I4)')JL - YRECFM='DG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) - YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA' - YCOMMENT='averaged soil depth layer '//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))//' (m)' - CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,ZDG(:,JL),IRESP,HCOMMENT=YCOMMENT) - END DO -! -ENDIF -! -!------------------------------------------------------------------------------- -! -IF(IO%CISBA=='DIF')THEN - ! - ALLOCATE(ZWORK2(ILU,IO%NPATCH)) - ! - ZDG2 (:)=0.0 - ZDTOT(:)=0.0 - ZWORK2(:,:)=XUNDEF - DO JP=1,IO%NPATCH - PK => NP%AL(JP) - DO JI=1,PK%NSIZE_P - IMASK = PK%NR_P(JI) - ZDG2(IMASK) = ZDG2(IMASK) + PK%XPATCH(JI) * PK%XDG2(JI) - JL = PK%NWG_LAYER(JI) - IF(JL/=NUNDEF)THEN - ZWORK2(JI,JP) = PK%XDG(JI,JL) - ZDTOT(IMASK) = ZDTOT(IMASK) + PK%XPATCH(JI) * PK%XDG(JI,JL) - ENDIF - ENDDO - ENDDO - ! - !* Root depth - ! - YRECFM='DROOT_DIF' - YCOMMENT='Root depth in ISBA-DIF' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NP%AL(JP)%XDROOT(:),ILU,S%XWORK_WR) - ENDDO - ! - YRECFM='DG2_DIF' - YCOMMENT='DG2 depth in ISBA-DIF' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NP%AL(JP)%XDG2(:),ILU,S%XWORK_WR) - ENDDO - ! - IF(IO%NPATCH>1)THEN - YRECFM='DG2_DIF_ISBA' - YCOMMENT='Averaged DG2 depth in ISBA-DIF' - CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,ZDG2(:),IRESP,HCOMMENT=YCOMMENT) - ENDIF - ! - !* Runoff depth - ! - YRECFM='RUNOFFD' - YCOMMENT='Runoff deph in ISBA-DIF' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NP%AL(JP)%XRUNOFFD(:),ILU,S%XWORK_WR) - ENDDO - ! - !* Total soil depth for mositure - ! - YRECFM='DTOT_DIF' - YCOMMENT='Total soil depth for moisture in ISBA-DIF' - DO JP = 1,IO%NPATCH - PK => NP%AL(JP) - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ZWORK2(1:PK%NSIZE_P,JP),ILU,S%XWORK_WR) - ENDDO - DEALLOCATE(ZWORK2) - ! - IF(IO%NPATCH>1)THEN - YRECFM='DTOTDF_ISBA' - YCOMMENT='Averaged Total soil depth for moisture in ISBA-DIF' - CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,ZDTOT(:),IRESP,HCOMMENT=YCOMMENT) - ENDIF - ! - !* Root fraction for each patch - ! - ALLOCATE(ZWORK1(ILU)) - DO JL=1,SIZE(PK%XROOTFRAC,2) - DO JP = 1,IO%NPATCH - PK => NP%AL(JP) - IF (JL<10) THEN - WRITE(YRECFM,FMT='(A8,I1)') 'ROOTFRAC',JL - ELSE - WRITE(YRECFM,FMT='(A8,I2)') 'ROOTFRAC',JL - ENDIF - YCOMMENT='root fraction by layer (-)' - ZWORK1(:)=XUNDEF - DO JI=1,SIZE(PK%XDG,1) - IF(JL<=PK%NWG_LAYER(JI).AND.PK%NWG_LAYER(JI)/=NUNDEF) THEN - ZWORK1(JI) = PK%XROOTFRAC(JI,JL) - ENDIF - ENDDO - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ZWORK1(1:PK%NSIZE_P),ILU,S%XWORK_WR) - ENDDO - END DO - DEALLOCATE(ZWORK1) - ! - !* SOC fraction for each layer - ! - IF(IO%LSOC)THEN - DO JL=1,SIZE(NP%AL(1)%XDG,2) - IF (JL<10) THEN - WRITE(YRECFM,FMT='(A7,I1)') 'FRACSOC',JL - ELSE - WRITE(YRECFM,FMT='(A7,I2)') 'FRACSOC',JL - ENDIF - YCOMMENT='SOC fraction by layer (-)' - CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,S%XFRACSOC(:,JL),IRESP,HCOMMENT=YCOMMENT) - ENDDO - ENDIF -! -ENDIF -! -!------------------------------------------------------------------------------- -! -DO JL=1,SIZE(NP%AL(1)%XDG,2) - IF (JL<10) THEN - WRITE(YRECFM,FMT='(A4,I1)') 'WSAT',JL - ELSE - WRITE(YRECFM,FMT='(A4,I2)') 'WSAT',JL - ENDIF - YCOMMENT='soil porosity by layer (m3/m3)' - CALL WRITE_SURF(HSELECT, & - HPROGRAM,YRECFM,K%XWSAT(:,JL),IRESP,HCOMMENT=YCOMMENT) -ENDDO -! -DO JL=1,SIZE(NP%AL(1)%XDG,2) - IF (JL<10) THEN - WRITE(YRECFM,FMT='(A3,I1)') 'WFC',JL - ELSE - WRITE(YRECFM,FMT='(A3,I2)') 'WFC',JL - ENDIF - YCOMMENT='field capacity by layer (m3/m3)' - CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,K%XWFC(:,JL),IRESP,HCOMMENT=YCOMMENT) -ENDDO -! -DO JL=1,SIZE(NP%AL(1)%XDG,2) - IF (JL<10) THEN - WRITE(YRECFM,FMT='(A5,I1)') 'WWILT',JL - ELSE - WRITE(YRECFM,FMT='(A5,I2)') 'WWILT',JL - ENDIF - YCOMMENT='wilting point by layer (m3/m3)' - CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,K%XWWILT(:,JL),IRESP,HCOMMENT=YCOMMENT) -ENDDO -! -!------------------------------------------------------------------------------- -! For Earth System Model -IF(LFANOCOMPACT.AND..NOT.LPREP)THEN - CALL END_IO_SURF_n(HPROGRAM) - IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_PGD_ISBA_N',1,ZHOOK_HANDLE) - RETURN -ENDIF -! -!------------------------------------------------------------------------------- -! -YRECFM='Z0REL' -YCOMMENT='orography roughness length (M)' -! - CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,ISS%XZ0REL(:),IRESP,HCOMMENT=YCOMMENT) -! -!------------------------------------------------------------------------------- -! -!* Runoff soil ice depth for each patch -! -IF(IO%CHORT=='SGH'.AND.IO%CISBA/='DIF')THEN - YRECFM='DICE' - YCOMMENT='soil ice depth for runoff (m)' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NP%AL(JP)%XD_ICE(:),ILU,S%XWORK_WR) - ENDDO -ENDIF -! -!------------------------------------------------------------------------------- -! -!* Fraction of each vegetation type in the grid cell -! -DO JL=1,SIZE(S%XVEGTYPE_PATCH,2) - WRITE(YPAS,'(I2)') JL - YLVLV=ADJUSTL(YPAS(:LEN_TRIM(YPAS))) - WRITE(YRECFM,FMT='(A9)') 'VEGTYPE'//YLVLV - YCOMMENT='fraction of each vegetation type in the grid cell'//' (-)' - CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,S%XVEGTYPE(:,JL),IRESP,HCOMMENT=YCOMMENT) -END DO -!------------------------------------------------------------------------------- -! -!* Fraction of each vegetation type for each patch -! -IF(IO%NPATCH>1.AND.SIZE(S%XVEGTYPE_PATCH,2)/=SIZE(S%XVEGTYPE_PATCH,3))THEN -! - DO JL=1,SIZE(S%XVEGTYPE_PATCH,2) - WRITE(YPAS,'(I2)') JL - YLVLV=ADJUSTL(YPAS(:LEN_TRIM(YPAS))) - WRITE(YRECFM,FMT='(A9)') 'VEGTY_'//YLVLV - YCOMMENT='fraction of each vegetation type in each patch'//' (-)' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NP%AL(JP)%XVEGTYPE_PATCH(:,JL),ILU,S%XWORK_WR) - ENDDO - END DO -! -ENDIF -! -!------------------------------------------------------------------------------- -! -!* other surface parameters -! -YRECFM='RSMIN' -YCOMMENT='minimum stomatal resistance (sm-1)' -DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XRSMIN(:),ILU,S%XWORK_WR) -ENDDO -! -YRECFM='GAMMA' -YCOMMENT='coefficient for RSMIN calculation (-)' -DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XGAMMA(:),ILU,S%XWORK_WR) -ENDDO -! -YRECFM='CV' -YCOMMENT='vegetation thermal inertia coefficient (-)' -DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XCV(:),ILU,S%XWORK_WR) -ENDDO -! -YRECFM='RGL' -YCOMMENT='maximum solar radiation usable in photosynthesis (-)' -DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XRGL(:),ILU,S%XWORK_WR) -ENDDO -! -YRECFM='EMIS_ISBA' -YCOMMENT='surface emissivity (-)' -DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XEMIS(:),ILU,S%XWORK_WR) -ENDDO -! -YRECFM='WRMAX_CF' -YCOMMENT='coefficient for maximum water interception (-)' -DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XWRMAX_CF(:),ILU,S%XWORK_WR) -ENDDO -! -IF (ISIZE_LMEB_PATCH>0) THEN - ! - YRECFM='H_VEG' - YCOMMENT='MEB: height of vegetation (m)' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XH_VEG(:),ILU,S%XWORK_WR) - ENDDO - ! -ENDIF -! -!------------------------------------------------------------------------------- -! -IF (OSURF_DIAG_ALBEDO) THEN -! -!* Soil albedos -! -! - YRECFM='ALBNIR_S' - YCOMMENT='soil near-infra-red albedo (-)' - DO JP=1,IO%NPATCH - CALL UNPACK_SAME_RANK(NP%AL(JP)%NR_P, NPE%AL(JP)%XALBNIR_SOIL, ZWORK(:,JP)) - WHERE (ZWORK(:,JP)/=XUNDEF) ZWORK(:,1) = ZWORK(:,JP) - ENDDO - CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,ZWORK(:,1),IRESP,HCOMMENT=YCOMMENT) -! -!------------------------------------------------------------------------------- -! - YRECFM='ALBVIS_S' - YCOMMENT='soil visible albedo (-)' - DO JP=1,IO%NPATCH - CALL UNPACK_SAME_RANK(NP%AL(JP)%NR_P, NPE%AL(JP)%XALBVIS_SOIL, ZWORK(:,JP)) - WHERE (ZWORK(:,JP)/=XUNDEF) ZWORK(:,1) = ZWORK(:,JP) - ENDDO - CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,ZWORK(:,1),IRESP,HCOMMENT=YCOMMENT) -! -!------------------------------------------------------------------------------- -! - YRECFM='ALBUV_S' - YCOMMENT='soil UV albedo (-)' - DO JP=1,IO%NPATCH - CALL UNPACK_SAME_RANK(NP%AL(JP)%NR_P, NPE%AL(JP)%XALBUV_SOIL, ZWORK(:,JP)) - WHERE (ZWORK(:,JP)/=XUNDEF) ZWORK(:,1) = ZWORK(:,JP) - ENDDO - CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,ZWORK(:,1),IRESP,HCOMMENT=YCOMMENT) -! -!------------------------------------------------------------------------------- -! -!* albedos -! - YRECFM='ALBNIR' - YCOMMENT='total near-infra-red albedo (-)' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XALBNIR(:),ILU,S%XWORK_WR) - ENDDO -! -!------------------------------------------------------------------------------- -! - YRECFM='ALBVIS' - YCOMMENT='total visible albedo (-)' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XALBVIS(:),ILU,S%XWORK_WR) - ENDDO -! -!------------------------------------------------------------------------------- -! - YRECFM='ALBUV' - YCOMMENT='total UV albedo (-)' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XALBUV(:),ILU,S%XWORK_WR) - ENDDO -! -END IF -! -!------------------------------------------------------------------------------- -! -!* chemical soil resistances -! -IF (CHI%CCH_DRY_DEP=='WES89' .AND. CHI%SVI%NBEQ>0) THEN - YRECFM='SOILRC_SO2' - YCOMMENT='bare soil resistance for SO2 (?)' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NCHI%AL(JP)%XSOILRC_SO2(:),ILU,S%XWORK_WR) - ENDDO - ! - YRECFM='SOILRC_O3' - YCOMMENT='bare soil resistance for O3 (?)' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NCHI%AL(JP)%XSOILRC_O3(:),ILU,S%XWORK_WR) - ENDDO -END IF -! -!------------------------------------------------------------------------------- -! -IF (LAGRIP .AND. (IO%CPHOTO=='NIT' .OR. IO%CPHOTO=='NCB') ) THEN -! -!* seeding and reaping -! - YRECFM='TSEED' - YCOMMENT='date of seeding (-)' - ! - DO JP = 1,IO%NPATCH - CALL WRITE_TFIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%TSEED(:),ILU,S%TDATE_WR) - ENDDO -! - YRECFM='TREAP' - YCOMMENT='date of reaping (-)' -! - DO JP = 1,IO%NPATCH - CALL WRITE_TFIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%TREAP(:),ILU,S%TDATE_WR) - ENDDO -! -!------------------------------------------------------------------------------- -! -!* irrigated fraction -! - YRECFM='IRRIG' - YCOMMENT='flag for irrigation (irrigation if >0.) (-)' -! - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XIRRIG(:),ILU,S%XWORK_WR) - ENDDO -! -!------------------------------------------------------------------------------- -! -!* water supply for irrigation -! - YRECFM='WATSUP' - YCOMMENT='water supply during irrigation process (mm)' -! - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XWATSUP(:),ILU,S%XWORK_WR) - ENDDO -! -ENDIF -! -!------------------------------------------------------------------------------- -! End of IO -! - CALL END_IO_SURF_n(HPROGRAM) -IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_PGD_ISBA_N',1,ZHOOK_HANDLE) -! -! -END SUBROUTINE WRITE_DIAG_PGD_ISBA_n diff --git a/src/ICCARE_BASE/write_diag_seb_isban.F90 b/src/ICCARE_BASE/write_diag_seb_isban.F90 deleted file mode 100644 index 620b40f7c..000000000 --- a/src/ICCARE_BASE/write_diag_seb_isban.F90 +++ /dev/null @@ -1,2166 +0,0 @@ -!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -! ######### - SUBROUTINE WRITE_DIAG_SEB_ISBA_n ( DTCO, DUO, U, NCHI, CHI, ID, NDST, BLOWSNW, GB, & - IO, S, NP, NPE, HPROGRAM) -! ################################# -! -!!**** *WRITE_DIAG_SEB_ISBA* - writes the ISBA diagnostic fields -!! -!! PURPOSE -!! ------- -!! -!! -!!** METHOD -!! ------ -!! -!! REFERENCE -!! --------- -!! -!! -!! AUTHOR -!! ------ -!! V. Masson *Meteo France* -!! -!! MODIFICATIONS -!! ------------- -!! Original 01/2004 -!! B. Decharme 06/2009 key to write (or not) patch result -!! B. Decharme 08/2009 cumulative radiative budget -!! B. Decharme 09/2012 : Bug in local variables declaration in PROVAR_TO_DIAG -!! B. Decharme 09/2012 New diag : -!! carbon fluxes and reservoirs -!! soil liquid and ice water content in kg/m2 and m3/m3 -!! B. Decharme 06/13 Add diags (sublimation, lateral drainage) -!! All snow outputs noted SN -!! delete NWG_SIZE -!! S. Belamari 06/2014 : Introduce GRESET to avoid errors due to NBLOCK=0 -!! when coupled with ARPEGE/ALADIN/AROME -!! P. Samuelsson 10/2014 MEB -!! B. Decharme 02/2016 : NBLOCK instead of LCOUNTW for compilation in AAA -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_SURFEX_MPI, ONLY : NRANK, NPIO -! -USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t -USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t -USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t -USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t, CH_ISBA_NP_t -USE MODD_SURFEX_n, ONLY : ISBA_DIAG_t -USE MODD_DST_n, ONLY : DST_NP_t -USE MODD_GR_BIOG_n, ONLY : GR_BIOG_t -USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t -USE MODD_ISBA_n, ONLY : ISBA_NP_t, ISBA_P_t, ISBA_NPE_t, ISBA_PE_t, ISBA_S_t -USE MODD_BLOWSNW_n, ONLY : BLOWSNW_t -! -#ifdef SFX_ARO -USE MODD_IO_SURF_ARO, ONLY : NBLOCK -#endif -! -USE MODD_XIOS, ONLY : LALLOW_ADD_DIM, YGROUND_LAYER_DIM_NAME, & - YWGROUND_LAYER_DIM_NAME, YWIGROUND_LAYER_DIM_NAME, & - YSWBAND_DIM_NAME -! -USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF -! -USE MODD_CSTS, ONLY : XRHOLW, XTT, XLMTT -! -USE MODD_DST_SURF -! -USE MODD_AGRI, ONLY : LAGRIP -USE MODD_BLOWSNW_SURF, ONLY : LBLOWSNW_CANODIAG -! -USE MODE_DIAG -! -USE MODI_INIT_IO_SURF_n -USE MODI_WRITE_SURF -USE MODI_END_IO_SURF_n -USE MODI_WRITE_FIELD_1D_PATCH -! -#ifdef SFX_OL -USE MODD_IO_SURF_OL, ONLY : LDEF -USE MODN_IO_OFFLINE, ONLY : XTSTEP_OUTPUT -#endif -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -IMPLICIT NONE -! -!* 0.1 Declarations of arguments -! ------------------------- -! -! -TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO -TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DUO -TYPE(SURF_ATM_t), INTENT(INOUT) :: U -TYPE(CH_ISBA_NP_t), INTENT(INOUT) :: NCHI -TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI -TYPE(ISBA_DIAG_t), INTENT(INOUT) :: ID -TYPE(DST_NP_t), INTENT(INOUT) :: NDST -TYPE(GR_BIOG_t), INTENT(INOUT) :: GB -TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO -TYPE(ISBA_S_t), INTENT(INOUT) :: S -TYPE(ISBA_NP_t), INTENT(INOUT) :: NP -TYPE(ISBA_NPE_t), INTENT(INOUT) :: NPE -TYPE(BLOWSNW_t), INTENT(INOUT) :: BLOWSNW -! - CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling -! -!* 0.2 Declarations of local variables -! ------------------------------- -! -TYPE(ISBA_P_t), POINTER :: PK -TYPE(ISBA_PE_t), POINTER :: PEK -! -INTEGER :: IRESP ! IRESP : return-code if a problem appears -CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be write -CHARACTER(LEN=100):: YCOMMENT ! Comment string -CHARACTER(LEN=2) :: YNUM -! -LOGICAL :: GRESET -INTEGER :: JSV, JSW, JP, ISIZE, JLAYER -INTEGER :: ISIZE_LMEB_PATCH ! Number of patches where multi-energy balance should be applied -REAL(KIND=JPRB) :: ZHOOK_HANDLE -! -!------------------------------------------------------------------------------- -! -! Initialisation for IO -! -IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_ISBA_N',0,ZHOOK_HANDLE) -! -ISIZE_LMEB_PATCH=COUNT(IO%LMEB_PATCH(:)) -! -GRESET=.TRUE. -#ifdef SFX_ARO -GRESET=(NBLOCK>0) -#endif -#ifdef SFX_OL -IF (LDEF) GRESET = .FALSE. -#endif -! -#ifdef SFX_OL -IF (ID%O%LSURF_BUDGET .AND. DUO%LRESETCUMUL .AND. ID%O%LSURF_BUDGETC .AND. .NOT.LDEF) THEN - ! - ! Output variables are not instantaneous but averaged over the output time step - ! Fluxes by patch - DO JP = 1,IO%NPATCH - CALL AVG_DIAG_TSTEP_SURF(XTSTEP_OUTPUT, ID%NDC%AL(JP), ID%ND%AL(JP)) - ENDDO - CALL AVG_DIAG_TSTEP_SURF(XTSTEP_OUTPUT, ID%DC, ID%D) - ! - IF (ID%DE%LSURF_EVAP_BUDGET) THEN - DO JP = 1,IO%NPATCH - CALL AVG_DIAG_TSTEP_EVAP(XTSTEP_OUTPUT, ID%NDEC%AL(JP), ID%NDE%AL(JP)) - ENDDO - CALL AVG_DIAG_TSTEP_EVAP(XTSTEP_OUTPUT, ID%DEC, ID%DE) - ! - IF (ID%DE%LWATER_BUDGET) THEN - DO JP = 1,IO%NPATCH - CALL AVG_DIAG_TSTEP_WATER(XTSTEP_OUTPUT, ID%NDEC%AL(JP), ID%NDE%AL(JP)) - ENDDO - CALL AVG_DIAG_TSTEP_WATER(XTSTEP_OUTPUT, ID%DEC, ID%DE) - ENDIF - ENDIF - ! -END IF -#endif -! -IF ( ID%DM%LPROSNOW ) THEN - CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'NATURE','ISBA ','WRITE','ISBA_PROGNOSTIC.OUT.nc') -ELSE - CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'NATURE','ISBA ','WRITE','ISBA_DIAGNOSTICS.OUT.nc') -ENDIF -! -!------------------------------------------------------------------------------- -! -!* 2. Richardson number : -! ----------------- -! -IF (ID%O%N2M>=1) THEN - ! - YRECFM='RI_ISBA' - YCOMMENT='Richardson number over tile nature' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XRI(:),IRESP,HCOMMENT=YCOMMENT) - ! -END IF -! -!* 3. Energy fluxes : -! ------------- -! -IF (ID%O%LSURF_BUDGET) THEN - ! - YRECFM='TALB_ISBA' - YCOMMENT='total albedo over tile nature (-)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,ID%D%XALBT(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='RN_ISBA' - YCOMMENT='Net radiation over tile nature'//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XRN(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='H_ISBA' - YCOMMENT='Sensible heat flux over tile nature'//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XH(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='LE_ISBA' - YCOMMENT='total latent heat flux over tile nature'//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XLE(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='LEI_ISBA' - YCOMMENT='sublimation latent heat flux over tile nature'//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XLEI(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='GFLUX_ISBA' - YCOMMENT='Ground flux over tile nature'//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XGFLUX(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='EVAP_ISBA' - YCOMMENT='total evaporative flux for tile nature'//' (Kg/m2/s)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,ID%D%XEVAP(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='SUBL_ISBA' - YCOMMENT='sublimation flux for tile nature'//' (Kg/m2/s)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,ID%D%XSUBL(:),IRESP,HCOMMENT=YCOMMENT) - ! - IF (ID%O%LRAD_BUDGET .OR. (ID%O%LSURF_BUDGETC .AND. .NOT.DUO%LRESET_BUDGETC)) THEN - ! - YRECFM='SWD_ISBA' - YCOMMENT='short wave downward radiation over tile nature'//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XSWD(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='SWU_ISBA' - YCOMMENT='short wave upward radiation over tile nature'//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XSWU(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='LWD_ISBA' - YCOMMENT='long wave downward radiation over tile nature'//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XLWD(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='LWU_ISBA' - YCOMMENT='long wave upward radiation over tile nature'//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XLWU(:),IRESP,HCOMMENT=YCOMMENT) - ! - IF (LALLOW_ADD_DIM) THEN - ! - YRECFM='SWD_ISBA_' - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT,& - HPROGRAM,YRECFM,ID%D%XSWBD(:,:),IRESP,HCOMMENT=YCOMMENT, HNAM_DIM=YSWBAND_DIM_NAME) - ! - YRECFM='SWU_ISBA_' - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT,& - HPROGRAM,YRECFM,ID%D%XSWBU(:,:),IRESP,HCOMMENT=YCOMMENT, HNAM_DIM=YSWBAND_DIM_NAME) - ! - ELSE - ! - DO JSW=1, SIZE(ID%D%XSWBD,2) - YNUM=ACHAR(48+JSW) - ! - YRECFM='SWD_ISBA_'//YNUM - YCOMMENT='short wave downward radiation over tile nature for spectral band'//YNUM//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XSWBD(:,JSW),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='SWU_ISBA_'//YNUM - YCOMMENT='short wave upward radiation over tile nature for spectral band'//YNUM//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XSWBU(:,JSW),IRESP,HCOMMENT=YCOMMENT) - ! - ENDDO - ! - ENDIF - ! - ENDIF - ! - YRECFM='FMU_ISBA' - YCOMMENT='u component of wind stress'//' (Pa)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XFMU(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='FMV_ISBA' - YCOMMENT='v component of wind stress'//' (Pa)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XFMV(:),IRESP,HCOMMENT=YCOMMENT) - ! -END IF -! -!* 4. Specific Energy fluxes :(for each patch) -! ---------------------------------------- -! -IF (ID%DE%LSURF_EVAP_BUDGET) CALL WRITE_EVAP_BUD(ID%DE,"_ISBA ",.FALSE.) -! -!* 6. parameters at 2 and 10 meters : -! ------------------------------- -! -IF (ID%O%N2M>=1) THEN - ! - YRECFM='T2M_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (K)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XT2M(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='T2MMIN_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (K)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XT2M_MIN(:),IRESP,HCOMMENT=YCOMMENT) - IF(GRESET)ID%D%XT2M_MIN(:)=XUNDEF - ! - YRECFM='T2MMAX_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (K)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XT2M_MAX(:),IRESP,HCOMMENT=YCOMMENT) - IF(GRESET)ID%D%XT2M_MAX(:)=-XUNDEF - ! - YRECFM='Q2M_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (KG/KG)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XQ2M(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='HU2M_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (-)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XHU2M(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='HU2MMIN_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (-)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XHU2M_MIN(:),IRESP,HCOMMENT=YCOMMENT) - IF(GRESET)ID%D%XHU2M_MIN(:)=XUNDEF - ! - YRECFM='HU2MMAX_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (-)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XHU2M_MAX(:),IRESP,HCOMMENT=YCOMMENT) - IF(GRESET)ID%D%XHU2M_MAX(:)=-XUNDEF - ! - YRECFM='ZON10M_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (M/S)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XZON10M(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='MER10M_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (M/S)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XMER10M(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='W10M_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (M/S)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XWIND10M(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='W10MMAX_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (M/S)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XWIND10M_MAX(:),IRESP,HCOMMENT=YCOMMENT) - IF(GRESET)ID%D%XWIND10M_MAX(:)=0.0 - ! - YRECFM='SFCO2_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (M.kgCO2.S-1.kgAIR-1)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XSFCO2(:),IRESP,HCOMMENT=YCOMMENT) - ! -END IF -!---------------------------------------------------------------------------- -! -!* 7. Transfer coefficients -! --------------------- -! -IF (ID%O%LCOEF) THEN - ! - YRECFM='CD_ISBA' - YCOMMENT='X_Y_'//YRECFM - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XCD(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='CH_ISBA' - YCOMMENT='X_Y_'//YRECFM - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XCH(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='CE_ISBA' - YCOMMENT='X_Y_'//YRECFM - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XCE(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='Z0_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (M)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XZ0(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='Z0H_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (M)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XZ0H(:),IRESP,HCOMMENT=YCOMMENT) - ! -ENDIF -! -!---------------------------------------------------------------------------- -! -!* 8. Surface humidity -! ---------------- -IF (ID%O%LSURF_VARS) THEN - ! - YRECFM='QS_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (KG/KG)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%D%XQS(:),IRESP,HCOMMENT=YCOMMENT) - ! -ENDIF -! -!---------------------------------------------------------------------------- -! -ISIZE = U%NSIZE_NATURE -! -!User want (or not) patch output -IF (ID%O%LPATCH_BUDGET.AND.(IO%NPATCH >1)) THEN - ! - !* 10. Richardson number (for each patch) - ! ----------------- - ! - IF (ID%O%N2M>=1) THEN - ! - YRECFM='RI_' - YCOMMENT='X_Y_'//YRECFM - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%ND%AL(JP)%XRI(:),ISIZE,S%XWORK_WR) - ENDDO - ! - END IF - ! - !* 11. Energy fluxes :(for each patch) - ! ------------- - ! - IF (ID%O%LSURF_BUDGET) THEN - ! - YRECFM='TALB_' - YCOMMENT='total albedo per patch' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%ND%AL(JP)%XALBT(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='RN_' - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%ND%AL(JP)%XRN(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='H_' - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%ND%AL(JP)%XH(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='LE_' - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XLE(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='LEI_' - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%ND%AL(JP)%XLEI(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='GFLUX_' - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%ND%AL(JP)%XGFLUX(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='EVAP_' - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%ND%AL(JP)%XEVAP(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='SUBL_' - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%ND%AL(JP)%XSUBL(:),ISIZE,S%XWORK_WR) - ENDDO - ! - IF (ID%O%LRAD_BUDGET .OR. (ID%O%LSURF_BUDGETC .AND. .NOT.DUO%LRESET_BUDGETC)) THEN - ! - YRECFM='SWD_' - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%ND%AL(JP)%XSWD(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='SWU_' - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%ND%AL(JP)%XSWU(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='LWD_' - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%ND%AL(JP)%XLWD(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='LWU_' - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%ND%AL(JP)%XLWU(:),ISIZE,S%XWORK_WR) - ENDDO - ! - DO JSW=1, SIZE(ID%D%XSWBD,2) - YNUM=ACHAR(48+JSW) - ! - YRECFM='SWD_'//YNUM - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%ND%AL(JP)%XSWD(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='SWU_'//YNUM - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%ND%AL(JP)%XSWU(:),ISIZE,S%XWORK_WR) - ENDDO - ! - ENDDO - ! - ENDIF - ! - YRECFM='FMU_' - YCOMMENT='X_Y_'//YRECFM//' (Pa)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%ND%AL(JP)%XFMU(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='FMV_' - YCOMMENT='X_Y_'//YRECFM//' (Pa)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%ND%AL(JP)%XFMV(:),ISIZE,S%XWORK_WR) - ENDDO - ! - END IF - ! - !* 12. Specific Energy fluxes :(for each patch) - ! ---------------------------------------- - ! - IF (ID%DE%LSURF_EVAP_BUDGET) CALL WRITE_EVAP_BUD_PATCH(ID%NDE,'_ ',.FALSE.) - ! - !* 13. surface temperature parameters at 2 and 10 meters (for each patch): - ! ------------------------------------------------------------------- - ! - IF (ID%O%N2M>=1.AND..NOT.IO%LCANOPY) THEN - ! - YRECFM='T2M_' - YCOMMENT='X_Y_'//YRECFM//' (K)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%ND%AL(JP)%XT2M(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='T2MMIN_' - YCOMMENT='X_Y_'//YRECFM//' (K)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%ND%AL(JP)%XT2M_MIN(:),ISIZE,S%XWORK_WR) - IF (GRESET) ID%ND%AL(JP)%XT2M_MIN(:)=XUNDEF - ENDDO - ! - YRECFM='T2MMAX_' - YCOMMENT='X_Y_'//YRECFM//' (K)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%ND%AL(JP)%XT2M_MAX(:),ISIZE,S%XWORK_WR) - IF (GRESET) ID%ND%AL(JP)%XT2M_MAX(:)=-XUNDEF - ENDDO - ! - YRECFM='Q2M_' - YCOMMENT='X_Y_'//YRECFM//' (KG/KG)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%ND%AL(JP)%XQ2M(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='HU2M_' - YCOMMENT='X_Y_'//YRECFM//' (PERCENT)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%ND%AL(JP)%XHU2M(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='ZON10M_' - YCOMMENT='X_Y_'//YRECFM//' (M/S)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%ND%AL(JP)%XZON10M(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='MER10M_' - YCOMMENT='X_Y_'//YRECFM//' (M/S)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%ND%AL(JP)%XMER10M(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='W10M_' - YCOMMENT='X_Y_'//YRECFM//' (M/S)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%ND%AL(JP)%XWIND10M(:),ISIZE,S%XWORK_WR) - ENDDO - ! - END IF - ! -ENDIF -! -!---------------------------------------------------------------------------- -! -!* 9. Diag of prognostic fields -! ------------------------- -! -IF (DUO%LPROVAR_TO_DIAG) CALL PROVAR_TO_DIAG -! -!---------------------------------------------------------------------------- -! -!* 15. chemical diagnostics: -! -------------------- -! -IF (CHI%SVI%NBEQ>0 .AND. CHI%CCH_DRY_DEP=="WES89 ") THEN - ! - DO JSV = 1,SIZE(CHI%CCH_NAMES,1) - YRECFM='DVNT'//TRIM(CHI%CCH_NAMES(JSV)) - WRITE(YCOMMENT,'(A13,I3.3)')'(m/s) DV_NAT_',JSV - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NCHI%AL(JP)%XDEP(:,JSV),ISIZE,S%XWORK_WR) - ENDDO - END DO - ! -ENDIF -! -IF (CHI%SVI%NBEQ>0 .AND. CHI%LCH_BIO_FLUX) THEN - ! - IF (ASSOCIATED(GB%XFISO)) THEN - YRECFM='FISO' - WRITE(YCOMMENT,'(A21)')'FISO (molecules/m2/s)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,GB%XFISO(:),IRESP,HCOMMENT=YCOMMENT) - END IF - ! - IF (ASSOCIATED(GB%XFISO)) THEN - YRECFM='FMONO' - WRITE(YCOMMENT,'(A22)')'FMONO (molecules/m2/s)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,GB%XFMONO(:),IRESP,HCOMMENT=YCOMMENT) - END IF - ! -ENDIF -! -IF (CHI%LCH_NO_FLUX) THEN - IF (ASSOCIATED(GB%XNOFLUX)) THEN - YRECFM='NOFLUX' - WRITE(YCOMMENT,'(A21)')'NOFLUX (molecules/m2/s)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,GB%XNOFLUX(:),IRESP,HCOMMENT=YCOMMENT) - END IF -END IF -! -!UPG*PT - cette ecriture ne fonctionne pas chez moi. Testée ?? -!IF (CHI%SVI%NDSTEQ > 0)THEN -! ! -! DO JSV = 1,NDSTMDE ! for all dust modes -! WRITE(YRECFM,'(A5,I3.3)')'F_DST',JSV -! YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)' -! DO JP = 1,IO%NPATCH -! CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& -! NP%AL(JP)%NR_P,NDST%AL(JP)%XSFDST(:,JSV),ISIZE,S%XWORK_WR) -! ENDDO -! END DO -! ! -!ENDIF -!UPG*PT -! -! -! Blowing snow variables -! -IF (CHI%SVI%NSNWEQ > 0)THEN - - YRECFM='SNOW_SALT' - YCOMMENT='streamwise snow saltation flux (kg/m/s)' - CALL WRITE_SURF(DUO%CSELECT, & - HPROGRAM,YRECFM,BLOWSNW%XSNW_FSALT(:,1),IRESP,HCOMMENT=YCOMMENT) - -DO JSV=1,2 - - WRITE(YRECFM,'(A8,I1.1,A3)') 'SNW_FTUR',JSV,' ' - YCOMMENT='Ins. surface turbulent snow flux (__ /m2/s)' - CALL WRITE_SURF(DUO%CSELECT, & - HPROGRAM,YRECFM,BLOWSNW%XSNW_FTURB(:,JSV),IRESP,HCOMMENT=YCOMMENT) - - WRITE(YRECFM,'(A8,I1.1,A3)') 'SNW_FSED',JSV,' ' - YCOMMENT='Ins. surface sedimentation snow flux (__ /m2/s)' - CALL WRITE_SURF(DUO%CSELECT, & - HPROGRAM,YRECFM,BLOWSNW%XSNW_FSED(:,JSV),IRESP,HCOMMENT=YCOMMENT) - - WRITE(YRECFM,'(A8,I1.1,A3)') 'SNW_FNET',JSV,' ' - YCOMMENT='Ins. surface net snow flux (__ /m2/s)' - CALL WRITE_SURF(DUO%CSELECT, & - HPROGRAM,YRECFM,BLOWSNW%XSNW_FNET(:,JSV),IRESP,HCOMMENT=YCOMMENT) - -ENDDO - - YRECFM='SNW_FTUR_ACC' - YCOMMENT='Acc. surface turbulent snow flux (kg/m2)' - CALL WRITE_SURF(DUO%CSELECT, & - HPROGRAM,YRECFM,BLOWSNW%XSNW_FTURB(:,3),IRESP,HCOMMENT=YCOMMENT) - - YRECFM='SNW_FSED_ACC' - YCOMMENT='Acc. surface sedimentation snow flux (kg/m2)' - CALL WRITE_SURF(DUO%CSELECT, & - HPROGRAM,YRECFM,BLOWSNW%XSNW_FSED(:,3),IRESP,HCOMMENT=YCOMMENT) - - YRECFM='SNW_FNET_ACC' - YCOMMENT='Acc. surface net snow flux (kg/m2)' - CALL WRITE_SURF(DUO%CSELECT, & - HPROGRAM,YRECFM,BLOWSNW%XSNW_FNET(:,3),IRESP,HCOMMENT=YCOMMENT) - - YRECFM='SNW_FSAL_ACC' - YCOMMENT='Acc. surface saltation flux (kg/m2)' - CALL WRITE_SURF(DUO%CSELECT, & - HPROGRAM,YRECFM,BLOWSNW%XSNW_FSALT(:,3),IRESP,HCOMMENT=YCOMMENT) - - YRECFM='SNW_FSAL_INS' - YCOMMENT='Ins. surface saltatio flux (kg/m2)' - CALL WRITE_SURF(DUO%CSELECT, & - HPROGRAM,YRECFM,BLOWSNW%XSNW_FSALT(:,2),IRESP,HCOMMENT=YCOMMENT) - - YRECFM='SNW_SUBL_ACC' - YCOMMENT='Canopy Acc. sublimation (kg/m2)' - CALL WRITE_SURF(DUO%CSELECT, & - HPROGRAM,YRECFM,BLOWSNW%XSNW_SUBL(:,3),IRESP,HCOMMENT=YCOMMENT) - - YRECFM='SNW_SUBL_INS' - YCOMMENT='Canopy Sublimation Rate (mmSWE/day)' - CALL WRITE_SURF(DUO%CSELECT,& - HPROGRAM,YRECFM,BLOWSNW%XSNW_SUBL(:,2),IRESP,HCOMMENT=YCOMMENT) - - - IF(LBLOWSNW_CANODIAG) THEN - DO JLAYER=1,SIZE(BLOWSNW%XSNW_CANO_RGA,2) - - WRITE(YRECFM,'(A10,I2.2)') 'CANSNW_RGL',JLAYER - YCOMMENT='Blowing snow radius at canopy level (m)' - CALL WRITE_SURF(DUO%CSELECT, & - HPROGRAM,YRECFM,BLOWSNW%XSNW_CANO_RGA(:,JLAYER),IRESP,HCOMMENT=YCOMMENT) - - WRITE(YRECFM,'(A10,I2.2)') 'CANSNW_MAS',JLAYER - YCOMMENT='Blowing snow mass at canopy level (kg/m3)' - CALL WRITE_SURF(DUO%CSELECT, & - HPROGRAM,YRECFM,BLOWSNW%XSNW_CANO_VAR(:,JLAYER,2),IRESP,HCOMMENT=YCOMMENT) - - WRITE(YRECFM,'(A10,I2.2)') 'CANSNW_NUM',JLAYER - YCOMMENT='Blowing snow number at canopy level (#/m3)' - CALL WRITE_SURF(DUO%CSELECT, & - HPROGRAM,YRECFM,BLOWSNW%XSNW_CANO_VAR(:,JLAYER,1),IRESP,HCOMMENT=YCOMMENT) - ENDDO - ENDIF - -ENDIF - -!---------------------------------------------------------------------------- -! -!* 5. Cumulated Energy fluxes -! ----------------------- -! - CALL END_IO_SURF_n(HPROGRAM) - CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'NATURE','ISBA ','WRITE','ISBA_DIAG_CUMUL.OUT.nc') -! -IF (ID%O%LSURF_BUDGETC) THEN - ! - CALL WRITE_EVAP_BUD(ID%DEC,"C_ISBA",(ID%O%LSURF_BUDGETC .AND. .NOT.DUO%LRESET_BUDGETC)) - ! - IF(IO%LGLACIER)THEN - YRECFM='ICE_FC_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%DEC%XICEFLUX(:),IRESP,HCOMMENT=YCOMMENT) - ENDIF - ! - YRECFM='RNC_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (J/m2)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%DC%XRN(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='HC_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (J/m2)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%DC%XH(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='LEC_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (J/m2)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%DC%XLE(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='LEIC_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (J/m2)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%DC%XLEI(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='GFLUXC_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (J/m2)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%DC%XGFLUX(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='EVAPC_ISBA' - YCOMMENT='total evaporative flux for tile nature'//' (Kg/m2/s)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,ID%DC%XEVAP(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='SUBLC_ISBA' - YCOMMENT='sublimation flux for tile nature'//' (Kg/m2/s)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,ID%DC%XSUBL(:),IRESP,HCOMMENT=YCOMMENT) - ! - IF (ID%O%LRAD_BUDGET .OR. (ID%O%LSURF_BUDGETC .AND. .NOT.DUO%LRESET_BUDGETC)) THEN - ! - YRECFM='SWDC_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (J/m2)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%DC%XSWD(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='SWUC_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (J/m2)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%DC%XSWU(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='LWDC_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (J/m2)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%DC%XLWD(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='LWUC_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (J/m2)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%DC%XLWU(:),IRESP,HCOMMENT=YCOMMENT) - ! - ENDIF - ! - YRECFM='FMUC_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (Pa.s)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%DC%XFMU(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='FMVC_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (Pa.s)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ID%DC%XFMV(:),IRESP,HCOMMENT=YCOMMENT) - ! -ENDIF -! -!---------------------------------------------------------------------------- -! -!User want (or not) patch output -IF (ID%O%LPATCH_BUDGET.AND.(IO%NPATCH >1)) THEN - ! - !* 14. Cumulated Energy fluxes :(for each patch) - ! ----------------------------------------- - ! - IF (ID%O%LSURF_BUDGETC) THEN - ! - CALL WRITE_EVAP_BUD_PATCH(ID%NDEC,'C_',(ID%O%LSURF_BUDGETC .AND. .NOT.DUO%LRESET_BUDGETC)) - ! - IF(IO%LGLACIER)THEN - YRECFM='ICE_FC_' - YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%NDEC%AL(JP)%XICEFLUX(:),ISIZE,S%XWORK_WR) - ENDDO - ENDIF - ! - YRECFM='RNC_' - YCOMMENT='X_Y_'//YRECFM//' (J/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%NDC%AL(JP)%XRN(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='HC_' - YCOMMENT='X_Y_'//YRECFM//' (J/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%NDC%AL(JP)%XH(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='LEC_' - YCOMMENT='X_Y_'//YRECFM//' (J/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%NDC%AL(JP)%XLE(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='LEIC_' - YCOMMENT='X_Y_'//YRECFM//' (J/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%NDC%AL(JP)%XLEI(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='GFLUXC_' - YCOMMENT='X_Y_'//YRECFM//' (J/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%NDC%AL(JP)%XGFLUX(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='EVAPC_' - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%NDC%AL(JP)%XEVAP(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='SUBLC_' - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%NDC%AL(JP)%XSUBL(:),ISIZE,S%XWORK_WR) - ENDDO - ! - IF (ID%O%LRAD_BUDGET .OR. (ID%O%LSURF_BUDGETC .AND. .NOT.DUO%LRESET_BUDGETC)) THEN - ! - YRECFM='SWDC_' - YCOMMENT='X_Y_'//YRECFM//' (J/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%NDC%AL(JP)%XSWD(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='SWUC_' - YCOMMENT='X_Y_'//YRECFM//' (J/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%NDC%AL(JP)%XSWU(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='LWDC_' - YCOMMENT='X_Y_'//YRECFM//' (J/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%NDC%AL(JP)%XLWD(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='LWUC_' - YCOMMENT='X_Y_'//YRECFM//' (J/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%NDC%AL(JP)%XLWU(:),ISIZE,S%XWORK_WR) - ENDDO - ! - ENDIF - ! - YRECFM='FMUC_' - YCOMMENT='X_Y_'//YRECFM//' (Pa.s)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%NDC%AL(JP)%XFMU(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='FMVC_' - YCOMMENT='X_Y_'//YRECFM//' (Pa.s)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,ID%NDC%AL(JP)%XFMV(:),ISIZE,S%XWORK_WR) - ENDDO - ! - ENDIF - ! - !------------------------------------------------------------------------------- -ENDIF -! -! End of IO -! - CALL END_IO_SURF_n(HPROGRAM) -! -!------------------------------------------------------------------------------- -! -!User want (or not) patch output -!------------------------------------------------------------------------------- -! -IF ( DUO%LRESETCUMUL .AND. ID%O%LSURF_BUDGETC ) THEN - ! - DO JP = 1,IO%NPATCH - CALL INIT_SURF_BUD(ID%NDC%AL(JP),0.) - ENDDO - ! - IF (ID%DE%LSURF_EVAP_BUDGET) THEN - DO JP = 1,IO%NPATCH - CALL INIT_EVAP_BUD(ID%NDEC%AL(JP)) - ENDDO - ! - IF (ID%DE%LWATER_BUDGET) THEN - DO JP = 1,IO%NPATCH - CALL INIT_WATER_BUD(ID%NDEC%AL(JP)) - ENDDO - ENDIF - ENDIF - ! -END IF -! -IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_ISBA_N',1,ZHOOK_HANDLE) -! -CONTAINS -! -!------------------------------------------------------------------------------- -! -SUBROUTINE WRITE_EVAP_BUD(DEA,HTERM,OFLAG) -! -USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t -! -TYPE(DIAG_EVAP_ISBA_t) :: DEA - CHARACTER(LEN=6), INTENT(IN) :: HTERM -LOGICAL, INTENT(IN) :: OFLAG -REAL(KIND=JPRB) :: ZHOOK_HANDLE -! -IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_ISBA_N:WRITE_EVAP_BUD',0,ZHOOK_HANDLE) -! -YRECFM='LEG'//TRIM(HTERM) -YCOMMENT='bare ground evaporation for tile nature'//' (W/m2)' -CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLEG(:),IRESP,HCOMMENT=YCOMMENT) -! -YRECFM='LEGI'//TRIM(HTERM) -YCOMMENT='bare ground sublimation for tile nature'//' (W/m2)' -CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLEGI(:),IRESP,HCOMMENT=YCOMMENT) -! -YRECFM='LEV'//TRIM(HTERM) -YCOMMENT='total vegetation evaporation for tile nature'//' (W/m2)' -CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLEV(:),IRESP,HCOMMENT=YCOMMENT) - ! -YRECFM='LES'//TRIM(HTERM) -YCOMMENT='snow sublimation for tile nature'//' (W/m2)' -CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLES(:),IRESP,HCOMMENT=YCOMMENT) - ! -IF(NPE%AL(1)%TSNOW%SCHEME=='3-L' .OR. NPE%AL(1)%TSNOW%SCHEME=='CRO')THEN - YRECFM='LESL'//TRIM(HTERM) - YCOMMENT='liquid water evaporation over snow for tile nature'//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLESL(:),IRESP,HCOMMENT=YCOMMENT) - YRECFM='SNDRIF'//TRIM(HTERM) - YCOMMENT='blowing snow sublimation for tile nature'//' (Kg/m2/s)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XSNDRIFT(:),IRESP,HCOMMENT=YCOMMENT) -ENDIF - ! -YRECFM='LER'//TRIM(HTERM) -YCOMMENT='canopy direct evaporation for tile nature'//' (W/m2)' -CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLER(:),IRESP,HCOMMENT=YCOMMENT) - ! -YRECFM='LETR'//TRIM(HTERM) -YCOMMENT='vegetation transpiration for tile nature'//' (W/m2)' -CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLETR(:),IRESP,HCOMMENT=YCOMMENT) - ! -YRECFM='DRAIN'//TRIM(HTERM) -YCOMMENT='drainage for tile nature'//' (Kg/m2/s)' -CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XDRAIN(:),IRESP,HCOMMENT=YCOMMENT) - ! -IF(IO%CRUNOFF=='SGH'.AND.IO%CISBA=='DIF')THEN - YRECFM='QSB'//TRIM(HTERM) - YCOMMENT='lateral subsurface flow for tile nature'//' (Kg/m2/s)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XQSB(:),IRESP,HCOMMENT=YCOMMENT) -ENDIF - ! -YRECFM='RUNOFF'//TRIM(HTERM) -YCOMMENT='runoff for tile nature'//' (Kg/m2/s)' -CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XRUNOFF(:),IRESP,HCOMMENT=YCOMMENT) - ! -IF(IO%CHORT=='SGH'.OR.IO%CISBA=='DIF')THEN - YRECFM='HORTON'//TRIM(HTERM) - YCOMMENT='horton runoff for tile nature'//' (Kg/m2/s)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XHORT(:),IRESP,HCOMMENT=YCOMMENT) -ENDIF - ! -YRECFM='DRIVEG'//TRIM(HTERM) -YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)' -CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XDRIP(:),IRESP,HCOMMENT=YCOMMENT) - ! -YRECFM='RRVEG'//TRIM(HTERM) -YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)' -CALL WRITE_SURF(DUO%CSELECT, & - HPROGRAM,YRECFM,DEA%XRRVEG(:),IRESP,HCOMMENT=YCOMMENT) - ! -YRECFM='SNOMLT'//TRIM(HTERM) -YCOMMENT='snow melting rate'//' (Kg/m2/s)' -CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XMELT(:),IRESP,HCOMMENT=YCOMMENT) - ! -IF(LAGRIP)THEN - YRECFM='IRRIG'//TRIM(HTERM) - YCOMMENT='irrigation rate'//' (Kg/m2/s)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XIRRIG_FLUX(:),IRESP,HCOMMENT=YCOMMENT) -ENDIF -! MEB STUFF -IF (ISIZE_LMEB_PATCH>0) THEN - YRECFM='LELIT'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLELITTER(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='LELITI'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLELITTERI(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='DRIPLIT'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XDRIPLIT(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='RRLIT'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XRRLIT(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='LEV_CV'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLEV_CV(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='LES_CV'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLES_CV(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='LETR_CV'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLETR_CV(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='LER_CV'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLER_CV(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='LE_CV'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLE_CV(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='H_CV'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XH_CV(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='MELT_CV'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XMELT_CV(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='FRZ_CV'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XFRZ_CV(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='LETR_GV'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLETR_GV(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='LER_GV'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLER_GV(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='LE_GV'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLE_GV(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='H_GV'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XH_GV(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='LE_GN'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLE_GN(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='H_GN'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XH_GN(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='SR_GN'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XSR_GN(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='SWDN_GN'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XSWDOWN_GN(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='LWDN_GN'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLWDOWN_GN(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='LE_CA'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLE_CA(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='H_CA'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XH_CA(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='SWNT_V'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XSWNET_V(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='SWNT_G'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XSWNET_G(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='SWNT_N'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XSWNET_N(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='SWNT_NS'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XSWNET_NS(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='LWNT_V'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLWNET_V(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='LWNT_G'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLWNET_G(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='LWNT_N'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLWNET_N(:),IRESP,HCOMMENT=YCOMMENT) - ! -ENDIF - ! END MEB STUFF - ! -IF(IO%LFLOOD)THEN - ! - YRECFM='IFLOOD'//TRIM(HTERM) - YCOMMENT='flood soil infiltration (Kg/m2/s)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XIFLOOD(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='PFLOOD'//TRIM(HTERM) - YCOMMENT='intercepted precipitation by floodplains (Kg/m2/s)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XPFLOOD(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='LEF'//TRIM(HTERM) - YCOMMENT='total floodplains evaporation (W/m2)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLE_FLOOD(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='LEIF'//TRIM(HTERM) - YCOMMENT='solid floodplains evaporation (W/m2)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XLEI_FLOOD(:),IRESP,HCOMMENT=YCOMMENT) - ! -ENDIF - ! -IF(IO%CPHOTO/='NON')THEN - ! - YRECFM='GPP'//TRIM(HTERM) - YCOMMENT='gross primary production over tile nature (kgCO2/m2/s)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XGPP(:),IRESP,HCOMMENT=YCOMMENT) - ! - IF (HTERM(1:1)=="C") THEN - YRECFM='RC_AUTO'//TRIM(HTERM(2:)) - ELSE - YRECFM='R_AUTO'//TRIM(HTERM) - ENDIF - YCOMMENT='autotrophic respiration over tile nature (kgCO2/m2/s)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XRESP_AUTO(:),IRESP,HCOMMENT=YCOMMENT) - ! - IF (HTERM(1:1)=="C") THEN - YRECFM='RC_ECO'//TRIM(HTERM(2:)) - ELSE - YRECFM='R_ECO'//TRIM(HTERM) - ENDIF - YCOMMENT='ecosystem respiration over tile nature (kgCO2/m2/s)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XRESP_ECO(:),IRESP,HCOMMENT=YCOMMENT) - ! -ENDIF -! -IF(ID%DE%LWATER_BUDGET .OR. OFLAG)THEN - ! - YRECFM='RAINF'//TRIM(HTERM) - YCOMMENT='input rainfall rate (Kg/m2/s)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XRAINFALL(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='SNOWF'//TRIM(HTERM) - YCOMMENT='input snowfall rate (Kg/m2/s)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XSNOWFALL(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='DWG'//TRIM(HTERM) - YCOMMENT='change in liquid soil moisture (Kg/m2/s)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XDWG(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='DWGI'//TRIM(HTERM) - YCOMMENT='change in solid soil moisture (Kg/m2/s)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XDWGI(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='DWR'//TRIM(HTERM) - YCOMMENT='change in water on canopy (Kg/m2/s)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XDWR(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='DSWE'//TRIM(HTERM) - YCOMMENT='change in snow water equivalent (Kg/m2/s)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XDSWE(:),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='WATBUD'//TRIM(HTERM) - YCOMMENT='isba water budget as residue (Kg/m2/s)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,DEA%XWATBUD(:),IRESP,HCOMMENT=YCOMMENT) - ! -ENDIF -! -IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_ISBA_N:WRITE_EVAP_BUD',1,ZHOOK_HANDLE) - -! -END SUBROUTINE WRITE_EVAP_BUD -! -SUBROUTINE WRITE_EVAP_BUD_PATCH(NDEA,HTERM,OFLAG) -! -USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_NP_t -! -TYPE(DIAG_EVAP_ISBA_NP_t) :: NDEA - CHARACTER(LEN=2), INTENT(IN) :: HTERM -LOGICAL, INTENT(IN) :: OFLAG -REAL(KIND=JPRB) :: ZHOOK_HANDLE -! -IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_ISBA_N:WRITE_EVAP_BUD_PATCH',0,ZHOOK_HANDLE) -! -YRECFM='LEG'//TRIM(HTERM) -YCOMMENT='X_Y_'//YRECFM//' (W/m2)' -DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XLEG(:),ISIZE,S%XWORK_WR) -ENDDO -! -YRECFM='LEGI'//TRIM(HTERM) -YCOMMENT='X_Y_'//YRECFM//' (W/m2)' -DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XLEGI(:),ISIZE,S%XWORK_WR) -ENDDO -! -YRECFM='LEV'//TRIM(HTERM) -YCOMMENT='X_Y_'//YRECFM//' (W/m2)' -DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XLEV(:),ISIZE,S%XWORK_WR) -ENDDO -! - -YRECFM='LES'//TRIM(HTERM) -YCOMMENT='X_Y_'//YRECFM//' (W/m2)' -DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XLES(:),ISIZE,S%XWORK_WR) -ENDDO -! -IF(NPE%AL(1)%TSNOW%SCHEME=='3-L' .OR. NPE%AL(1)%TSNOW%SCHEME=='CRO')THEN - YRECFM='LESL'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XLESL(:),ISIZE,S%XWORK_WR) -ENDDO - YRECFM='SNDRIF'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XSNDRIFT(:),ISIZE,S%XWORK_WR) -ENDDO -ENDIF -! -YRECFM='LER'//TRIM(HTERM) -YCOMMENT='X_Y_'//YRECFM//' (W/m2)' -DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XLER(:),ISIZE,S%XWORK_WR) -ENDDO -! -YRECFM='LETR'//TRIM(HTERM) -YCOMMENT='X_Y_'//YRECFM//' (W/m2)' -DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XLETR(:),ISIZE,S%XWORK_WR) -ENDDO -! -YRECFM='DRAIN'//TRIM(HTERM) -YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)' -DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XDRAIN(:),ISIZE,S%XWORK_WR) -ENDDO -! -IF(IO%CRUNOFF=='SGH'.AND.IO%CISBA=='DIF')THEN - YRECFM='QSB'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XQSB(:),ISIZE,S%XWORK_WR) - ENDDO -ENDIF -! -YRECFM='RUNOFF'//TRIM(HTERM) -YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)' -DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XRUNOFF(:),ISIZE,S%XWORK_WR) -ENDDO -! -IF(IO%CHORT=='SGH'.OR.IO%CISBA=='DIF')THEN - - YRECFM='HORTON'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XHORT(:),ISIZE,S%XWORK_WR) - ENDDO - -ENDIF -! -YRECFM='DRIVEG'//TRIM(HTERM) -YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)' -DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XDRIP(:),ISIZE,S%XWORK_WR) -ENDDO -! -YRECFM='RRVEG'//TRIM(HTERM) -YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)' -DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XRRVEG(:),ISIZE,S%XWORK_WR) -ENDDO -! -YRECFM='SNOMLT'//TRIM(HTERM) -YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)' -DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XMELT(:),ISIZE,S%XWORK_WR) -ENDDO -! -! MEB STUFF -IF (ISIZE_LMEB_PATCH>0) THEN - ! - YRECFM='LELIT'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XLELITTER(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='LELITI'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XLELITTERI(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='DRIPLIT'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XDRIPLIT(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='RRLIT'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XRRLIT(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='LEV_CV'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XLEV_CV(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='LES_CV'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XLES_CV(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='LETR_CV'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XLETR_CV(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='LER_CV'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XLER_CV(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='LE_CV'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XLE_CV(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='H_CV'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XH_CV(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='MELT_CV'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XMELT_CV(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='FRZ_CV'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XFRZ_CV(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='LE_GV'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XLE_GV(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='H_GV'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XH_GV(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='LE_GN'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XLE_GN(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='H_GN'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XH_GN(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='SR_GN'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XSR_GN(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='SWDN_GN'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XSWDOWN_GN(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='LWDN_GN'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XLWDOWN_GN(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='LE_CA'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XLE_CA(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='H_CA'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XH_CA(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='SWNT_V'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XSWNET_V(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='SWNT_G'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XSWNET_G(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='SWNT_N'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XSWNET_N(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='SWNT_NS'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XSWNET_NS(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='LWNT_V'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XLWNET_V(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='LWNT_G'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XLWNET_G(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='LWNT_N'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XLWNET_N(:),ISIZE,S%XWORK_WR) - ENDDO - -ENDIF -! END MEB STUFF -! -IF(LAGRIP)THEN - YRECFM='IRRIG'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XIRRIG_FLUX(:),ISIZE,S%XWORK_WR) - ENDDO -ENDIF -! -IF(IO%LFLOOD)THEN - ! - YRECFM='IFLOOD'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XIFLOOD(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='PFLOOD'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XPFLOOD(:),ISIZE,S%XWORK_WR) - ENDDO - ! - - YRECFM='LEF'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XLE_FLOOD(:),ISIZE,S%XWORK_WR) -ENDDO - ! - - YRECFM='LEIF'//TRIM(HTERM) - YCOMMENT='X_Y_'//YRECFM//' (W/m2)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XLEI_FLOOD(:),ISIZE,S%XWORK_WR) - ENDDO - ! -ENDIF -! -IF(IO%CPHOTO/='NON')THEN - ! - - YRECFM='GPP'//TRIM(HTERM) - YCOMMENT='gross primary production per patch (kgCO2/m2/s)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XGPP(:),ISIZE,S%XWORK_WR) - ENDDO - ! - IF (HTERM(1:1)=="C") THEN - YRECFM='RC_AUTO'//TRIM(HTERM(2:)) - ELSE - YRECFM='R_AUTO'//TRIM(HTERM) - ENDIF - YCOMMENT='autotrophic respiration per patch (kgCO2/m2/s)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XRESP_AUTO(:),ISIZE,S%XWORK_WR) - ENDDO - ! - IF (HTERM(1:1)=="C") THEN - YRECFM='RC_ECO'//TRIM(HTERM(2:)) - ELSE - YRECFM='R_ECO'//TRIM(HTERM) - ENDIF - YCOMMENT='ecosystem respiration per patch (kgCO2/m2/s)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XRESP_ECO(:),ISIZE,S%XWORK_WR) - ENDDO - ! -ENDIF -! -IF(ID%DE%LWATER_BUDGET .OR. OFLAG)THEN - ! - YRECFM='DWG'//TRIM(HTERM) - YCOMMENT='change in liquid soil moisture per patch (Kg/m2/s)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XDWG(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='DWGI'//TRIM(HTERM) - YCOMMENT='change in solid soil moisture per patch (Kg/m2/s)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XDWGI(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='DWR'//TRIM(HTERM) - YCOMMENT='change in water on canopy per patch (Kg/m2/s)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XDWR(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='DSWE'//TRIM(HTERM) - YCOMMENT='change in snow water equivalent per patch (Kg/m2/s)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XDSWE(:),ISIZE,S%XWORK_WR) - ENDDO - ! - YRECFM='WATBUD'//TRIM(HTERM) - YCOMMENT='isba water budget as residue per patch (Kg/m2/s)' - DO JP=1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDEA%AL(JP)%XWATBUD(:),ISIZE,S%XWORK_WR) - ENDDO - ! -ENDIF -! -IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_ISBA_N:WRITE_EVAP_BUD_PATCH',1,ZHOOK_HANDLE) -! -END SUBROUTINE WRITE_EVAP_BUD_PATCH -! -! -SUBROUTINE PROVAR_TO_DIAG -! -REAL, DIMENSION(U%NSIZE_NATURE) :: ZPATCH, ZWORK -REAL, DIMENSION(U%NSIZE_NATURE,SIZE(NPE%AL(1)%XWG,2)) :: ZWG -REAL, DIMENSION(U%NSIZE_NATURE,SIZE(NPE%AL(1)%XWG,2)) :: ZWGI -REAL, DIMENSION(U%NSIZE_NATURE,SIZE(NPE%AL(1)%XTG,2)) :: ZTG -REAL, DIMENSION(U%NSIZE_NATURE,SIZE(NP%AL(1)%XDG,2)) :: ZDG_TOT -REAL, DIMENSION(U%NSIZE_NATURE,SIZE(NP%AL(1)%XDG,2)) :: ZDG -! -REAL, DIMENSION(U%NSIZE_NATURE,IO%NNBIOMASS) :: ZBIOMASS -REAL, DIMENSION(U%NSIZE_NATURE,IO%NNSOILCARB) :: ZSOILCARB -REAL, DIMENSION(U%NSIZE_NATURE,IO%NNLITTLEVS) :: ZLIGNIN_STRUC -REAL, DIMENSION(U%NSIZE_NATURE,IO%NNLITTER,IO%NNLITTLEVS) :: ZLITTER -! -CHARACTER(LEN=4 ) :: YLVL -REAL :: ZMISS -INTEGER :: JL, JP, JJ, INI, IWORK, IDEPTH, IMASK -! -REAL(KIND=JPRB) :: ZHOOK_HANDLE -! -IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_ISBA_N:PROVAR_TO_DIAG',0,ZHOOK_HANDLE) -! -INI=U%NSIZE_NATURE -! -! * soil temperatures (K) -! -IF(IO%LTEMP_ARP)THEN - IWORK=IO%NTEMPLAYER_ARP -ELSEIF(IO%CISBA/='DIF')THEN - IWORK=2 -ELSE - IWORK=IO%NGROUND_LAYER -ENDIF -! -ZTG(:,:)=0.0 -DO JP=1,IO%NPATCH - PK => NP%AL(JP) - PEK => NPE%AL(JP) - DO JL=1,IWORK - DO JJ=1,PK%NSIZE_P - IMASK = PK%NR_P(JJ) - ZTG(IMASK,JL) = ZTG(IMASK,JL) + PK%XPATCH(JJ) * PEK%XTG(JJ,JL) - ENDDO - ENDDO -ENDDO -! -IF (LALLOW_ADD_DIM) THEN - YRECFM='TG_ISBA' ; - YCOMMENT='Soil temperature (K)' - CALL WRITE_SURF(DUO%CSELECT, & - HPROGRAM,YRECFM,ZTG(:,:),IRESP,YCOMMENT,HNAM_DIM=YGROUND_LAYER_DIM_NAME) -ELSE - DO JL=1,IWORK - WRITE(YLVL,'(I4)') JL - YRECFM='TG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) - YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (K)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ZTG(:,JL),IRESP,HCOMMENT=YCOMMENT) - END DO -ENDIF -! -! * Compute soil liquid and ice water content (kg/m2 and m3/m3) -! -ZWG (:,:)=0.0 -ZWGI(:,:)=0.0 -ZDG_TOT(:,:)=0.0 -! -IF(IO%CISBA=='DIF')THEN - ! - DO JP=1,IO%NPATCH - PK => NP%AL(JP) - PEK => NPE%AL(JP) - - DO JJ=1,PK%NSIZE_P - IMASK = PK%NR_P(JJ) - DO JL=1,IO%NGROUND_LAYER -! -! liquid and ice water content - IDEPTH= PK%NWG_LAYER(JJ) - IF(JL<=IDEPTH)THEN - ZWG(IMASK,JL) = ZWG (IMASK,JL)+ PK%XPATCH(JJ) * PEK%XWG (JJ,JL) * PK%XDZG(JJ,JL) - ZWGI(IMASK,JL)= ZWGI(IMASK,JL)+ PK%XPATCH(JJ) * PEK%XWGI(JJ,JL) * PK%XDZG(JJ,JL) - ZDG_TOT(IMASK,JL)= ZDG_TOT(IMASK,JL)+ PK%XPATCH(JJ)* PK%XDZG(JJ,JL) - ENDIF -! - ENDDO - ENDDO - ENDDO -! -ELSE - ! - DO JP=1,IO%NPATCH - PK => NP%AL(JP) - PEK => NPE%AL(JP) - - ZDG(1:PK%NSIZE_P,1) = PK%XDG(:,1) - ZDG(1:PK%NSIZE_P,2) = PK%XDG(:,2) - IF(IO%CISBA=='3-L')THEN - ZDG(1:PK%NSIZE_P,3) = PK%XDG(:,3)-PK%XDG(:,2) - ENDIF - - DO JJ=1,PK%NSIZE_P - IMASK = PK%NR_P(JJ) - DO JL=1,IO%NGROUND_LAYER - - ZWG(IMASK,JL) = ZWG (IMASK,JL)+ PK%XPATCH(JJ) *PEK%XWG(JJ,JL)* ZDG(JJ,JL) - ZWGI(IMASK,JL)= ZWGI(IMASK,JL)+ PK%XPATCH(JJ) *PEK%XWGI(JJ,JL)* ZDG(JJ,JL) - ZDG_TOT(IMASK,JL)=ZDG_TOT(IMASK,JL)+PK%XPATCH(JJ)*ZDG(JJ,JL) - ENDDO - ENDDO - ENDDO -! -ENDIF -! -IF(HPROGRAM=='AROME '.OR.HPROGRAM=='FA ')THEN - ZMISS=0.0 -ELSE - ZMISS=XUNDEF -ENDIF -! -WHERE(ZDG_TOT(:,:)>0.0) - ZWG (:,:)=ZWG (:,:)/ZDG_TOT(:,:) - ZWGI (:,:)=ZWGI(:,:)/ZDG_TOT(:,:) -ELSEWHERE - ZWG (:,:)=ZMISS - ZWGI (:,:)=ZMISS -ENDWHERE -! -! * soil liquid water content (m3/m3) and soil moisture (kg/m2) -! -IF (LALLOW_ADD_DIM) THEN - YRECFM='WG_ISBA' ; - YCOMMENT='Soil liquid water content (m3/m3)' - CALL WRITE_SURF(DUO%CSELECT, & - HPROGRAM,YRECFM,ZWG(:,:),IRESP,YCOMMENT,HNAM_DIM=YWGROUND_LAYER_DIM_NAME) -ELSE - DO JL=1,IO%NGROUND_LAYER - WRITE(YLVL,'(I4)') JL - YRECFM='WG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) - YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA' - YCOMMENT='Soil liquid water content (m3/m3)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ZWG(:,JL),IRESP,HCOMMENT=YCOMMENT) - END DO -ENDIF -! -! * soil ice water content (m3/m3) and soil ice mass (kg/m2) -! -IWORK=IO%NGROUND_LAYER -IF(IO%CISBA/='DIF')THEN - IWORK=2 ! No ice in the FR 3-layers -ENDIF -! -IF (LALLOW_ADD_DIM) THEN - YRECFM='WGI_ISBA' ; - YCOMMENT='Soil solid water content (m3/m3)' - CALL WRITE_SURF(DUO%CSELECT, & - HPROGRAM,YRECFM,ZWGI(:,:),IRESP,YCOMMENT,HNAM_DIM=YWIGROUND_LAYER_DIM_NAME) -ELSE - DO JL=1,IWORK - WRITE(YLVL,'(I4)') JL - YRECFM='WGI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) - YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA' - YCOMMENT='Soil solid water content (m3/m3)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ZWGI(:,JL),IRESP,HCOMMENT=YCOMMENT) - END DO -ENDIF -! -! * water intercepted on leaves (kg/m2) -! -ZWORK(:)=0.0 -DO JP=1,IO%NPATCH - DO JJ=1,NP%AL(JP)%NSIZE_P - IMASK = NP%AL(JP)%NR_P(JJ) - ZWORK(IMASK) = ZWORK(IMASK) + NP%AL(JP)%XPATCH(JJ) * NPE%AL(JP)%XWR(JJ) - ENDDO -ENDDO -! -YRECFM='WR_ISBA' -YCOMMENT='X_Y_'//YRECFM//' (kg/m2)' -CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT) -! -! * Glacier ice storage (semi-prognostic) (kg/m2) -! -IF(IO%LGLACIER)THEN - ! - ZWORK(:)=0.0 - DO JP=1,IO%NPATCH - DO JJ=1,NP%AL(JP)%NSIZE_P - IMASK = NP%AL(JP)%NR_P(JJ) - ZWORK(IMASK) = ZWORK(IMASK) + NP%AL(JP)%XPATCH(JJ) * NPE%AL(JP)%XICE_STO(JJ) - ENDDO - ENDDO - ! - YRECFM='ICE_STO_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (kg/m2)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT) - ! -ENDIF -! -! * Snow albedo (-) -! -ZPATCH(:) = 0.0 -ZWORK (:) = 0.0 -DO JP=1,IO%NPATCH - PK => NP%AL(JP) - PEK => NPE%AL(JP) - - DO JJ=1,PK%NSIZE_P - IMASK = PK%NR_P(JJ) - - IF(PEK%TSNOW%ALB(JJ)/=XUNDEF)THEN - ZWORK (IMASK) = ZWORK (IMASK) + PK%XPATCH(JJ) * PEK%TSNOW%ALB(JJ) - ZPATCH(IMASK) = ZPATCH(IMASK) + PK%XPATCH(JJ) - ENDIF - ENDDO -ENDDO -! -WHERE(ZPATCH(:)>0.0) - ZWORK(:) = ZWORK(:) / ZPATCH(:) -ELSEWHERE - ZWORK(:) = XUNDEF -ENDWHERE -! -YRECFM='ASN_ISBA' -YCOMMENT='X_Y_'//YRECFM//' (-)' -CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT) -! -IF(NPE%AL(1)%TSNOW%SCHEME=='3-L' .OR. NPE%AL(1)%TSNOW%SCHEME=='CRO')THEN - ! - ! * Snow reservoir (kg/m2) by layer - ! - DO JL = 1,NPE%AL(1)%TSNOW%NLAYER - ! - ZWORK(:)=0.0 - DO JP=1,IO%NPATCH - PK => NP%AL(JP) - PEK => NPE%AL(JP) - DO JJ=1,PK%NSIZE_P - IMASK = PK%NR_P(JJ) - ZWORK(IMASK) = ZWORK(IMASK) + PK%XPATCH(JJ) * PEK%TSNOW%WSNOW(JJ,JL) - ENDDO - ENDDO - ! - WRITE(YLVL,'(I4)') JL - YRECFM='WSN_'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) - YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (kg/m2)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT) - ! - ENDDO - ! - ! * Snow depth (m) - ! - DO JL = 1,NPE%AL(1)%TSNOW%NLAYER - ! - ZWORK(:)=0.0 - DO JP=1,IO%NPATCH - PK => NP%AL(JP) - PEK => NPE%AL(JP) - DO JJ=1,PK%NSIZE_P - IMASK = PK%NR_P(JJ) - ZWORK(IMASK) = ZWORK(IMASK) + PK%XPATCH(JJ) * & - PEK%TSNOW%WSNOW(JJ,JL)/PEK%TSNOW%RHO(JJ,JL) - ENDDO - ENDDO - ! - WRITE(YLVL,'(I4)') JL - YRECFM='DSN_'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) - YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (kg/m2)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT) - ! - ENDDO - ! - ! * Snow temperature (k) - ! - IF(HPROGRAM=='AROME '.OR.HPROGRAM=='FA ')THEN - ZMISS=XTT - ELSE - ZMISS=XUNDEF - ENDIF - ! - DO JL = 1,NPE%AL(1)%TSNOW%NLAYER - ! - ZWORK (:) = 0.0 - ZPATCH(:) = 0.0 - DO JP=1,IO%NPATCH - PK => NP%AL(JP) - PEK => NPE%AL(JP) - DO JJ=1,PK%NSIZE_P - IMASK = PK%NR_P(JJ) - IF(PEK%TSNOW%WSNOW(JJ,JL)>0.)THEN - ZWORK (IMASK) = ZWORK (IMASK) + PK%XPATCH(JJ) * PEK%TSNOW%TEMP(JJ,JL) - ZPATCH(IMASK) = ZPATCH(IMASK) + PK%XPATCH(JJ) - ENDIF - ENDDO - ENDDO - ! - WHERE(ZPATCH(:)>0.0) - ZWORK(:) = ZWORK(:) / ZPATCH(:) - ELSEWHERE - ZWORK(:) = ZMISS - ENDWHERE - ! - WRITE(YLVL,'(I4)') JL - YRECFM='TSN_'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) - YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (K)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT) - ! - ENDDO - ! - ! * Snow age (day) - ! - DO JL = 1,NPE%AL(1)%TSNOW%NLAYER - ! - ZWORK (:) = 0.0 - ZPATCH(:) = 0.0 - DO JP=1,IO%NPATCH - PK => NP%AL(JP) - PEK => NPE%AL(JP) - DO JJ=1,PK%NSIZE_P - IMASK = PK%NR_P(JJ) - IF(PEK%TSNOW%WSNOW(JJ,JL)>0.)THEN - ZWORK (IMASK) = ZWORK (IMASK) + PK%XPATCH(JJ) * PEK%TSNOW%AGE(JJ,JL) - ZPATCH(IMASK) = ZPATCH(IMASK) + PK%XPATCH(JJ) - ENDIF - ENDDO - ENDDO - ! - WHERE(ZPATCH(:)>0.0) - ZWORK(:) = ZWORK(:) / ZPATCH(:) - ENDWHERE - ! - WRITE(YLVL,'(I4)') JL - YRECFM='AGSN_'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) - YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (day_since_snowfall)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT) - ! - ENDDO - ! -ENDIF -! -! * Isba-Ags biomass reservoir -! -IF(IO%CPHOTO=='NIT'.OR.IO%CPHOTO=='NCB')THEN -! - ZBIOMASS(:,:)=0.0 - DO JP=1,IO%NPATCH - PK => NP%AL(JP) - PEK => NPE%AL(JP) - DO JJ=1,PK%NSIZE_P - IMASK = PK%NR_P(JJ) - DO JL=1,IO%NNBIOMASS - ZBIOMASS(IMASK,JL) = ZBIOMASS(IMASK,JL) + PK%XPATCH(JJ) * PEK%XBIOMASS(JJ,JL) - ENDDO - ENDDO - ENDDO -! - DO JL = 1,IO%NNBIOMASS - WRITE(YLVL,'(I4)') JL - YRECFM='BIOM'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) - YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (kgDM/m2)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ZBIOMASS(:,JL),IRESP,HCOMMENT=YCOMMENT) - ENDDO -! -ENDIF -! -! * Isba-CC carbon reservoir -! -IF(IO%CRESPSL=='CNT')THEN -! - ZLITTER(:,:,:)=0.0 - ZLIGNIN_STRUC(:,:)=0.0 - DO JP=1,IO%NPATCH - PK => NP%AL(JP) - PEK => NPE%AL(JP) - DO JJ=1,PK%NSIZE_P - IMASK = PK%NR_P(JJ) - DO JL=1,IO%NNLITTLEVS - ZLITTER(IMASK,1,JL) = ZLITTER(IMASK,1,JL) + PK%XPATCH(JJ) * PEK%XLITTER(JJ,1,JL) - ZLITTER(IMASK,2,JL) = ZLITTER(IMASK,2,JL) + PK%XPATCH(JJ) * PEK%XLITTER(JJ,2,JL) - ZLIGNIN_STRUC(IMASK,JL) = ZLIGNIN_STRUC(IMASK,JL) + PK%XPATCH(JJ) * PEK%XLIGNIN_STRUC(JJ,JL) - ENDDO - ENDDO - ENDDO -! - DO JL=1,IO%NNLITTLEVS - WRITE(YLVL,'(I4)') JL - YRECFM='LIT1_'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) - YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (gC/m2)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ZLITTER(:,1,JL),IRESP,HCOMMENT=YCOMMENT) - WRITE(YLVL,'(I4)') JL - YRECFM='LIT2_'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) - YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (gC/m2)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,ZLITTER(:,2,JL),IRESP,HCOMMENT=YCOMMENT) - WRITE(YLVL,'(I4)') JL - YRECFM='LIGSTR'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) - YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (-)' - CALL WRITE_SURF(DUO%CSELECT,HPROGRAM,YRECFM,ZLIGNIN_STRUC(:,JL),IRESP,HCOMMENT=YCOMMENT) - END DO -! - ZSOILCARB(:,:)=0.0 - DO JP=1,IO%NPATCH - PK => NP%AL(JP) - PEK => NPE%AL(JP) - DO JJ=1,PK%NSIZE_P - IMASK = PK%NR_P(JJ) - DO JL=1,IO%NNSOILCARB - ZSOILCARB(IMASK,JL) = ZSOILCARB(IMASK,JL) + PK%XPATCH(JJ) * PEK%XSOILCARB(JJ,JL) - ENDDO - ENDDO - ENDDO -! - DO JL = 1,IO%NNSOILCARB - WRITE(YLVL,'(I4)') JL - YRECFM='SCARB'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) - YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA' - YCOMMENT='X_Y_'//YRECFM//' (gC/m2)' - CALL WRITE_SURF(DUO%CSELECT, HPROGRAM,YRECFM,ZSOILCARB(:,JL),IRESP,HCOMMENT=YCOMMENT) - ENDDO -! -ENDIF -! -IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_ISBA_N:PROVAR_TO_DIAG',1,ZHOOK_HANDLE) -! -END SUBROUTINE PROVAR_TO_DIAG -! -END SUBROUTINE WRITE_DIAG_SEB_ISBA_n diff --git a/src/ICCARE_BASE/write_lbn.f90 b/src/ICCARE_BASE/write_lbn.f90 deleted file mode 100644 index b06f5bc8e..000000000 --- a/src/ICCARE_BASE/write_lbn.f90 +++ /dev/null @@ -1,867 +0,0 @@ -!MNH_LIC Copyright 1998-2021 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!----------------------------------------------------------------- -! ###################### - MODULE MODI_WRITE_LB_n -! ###################### -! -INTERFACE -! -SUBROUTINE WRITE_LB_n(TPFILE) -! -USE MODD_IO, ONLY: TFILEDATA -! -TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File characteristics -END SUBROUTINE WRITE_LB_n -! -END INTERFACE -! -END MODULE MODI_WRITE_LB_n -! -! -! -! ############################## - SUBROUTINE WRITE_LB_n(TPFILE) -! ############################## -! -!!**** *WRITE_LFIFM_n* - routine to write LB fields in the LFIFM file -!! -!! PURPOSE -!! ------- -! The purpose of this routine is to write LB fields in the -! YFMFILE//'.lfi' with the FM routines. -! -!!** METHOD -!! ------ -!! The LB fields (distributed on the processors) are gathered. Then -!! they are writen on the file. -!! -!! EXTERNAL -!! -------- -!! FMWRIT : FM-routine to write a record -!! GET_DISTRIBX_LB : to get the indices of the LB arrays -!! GET_DISTRIBY_LB for each sub-domain -!! -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! Module MODD_DIM_n : contains dimensions -!! Module MODD_LUNIT_n : contains logical unit variables. -!! Module MODD_LSFIELD_n : contains Lateral boundaries variables -!! Module MODD_CONF_n : contains configuration variables -!! Module MODD_PARAM_n : contains parameterization options -!! Module MODD_TURB_n : contains turbulence options -!! -!! REFERENCE -!! --------- -!! -!! -!! AUTHOR -!! ------ -!! P Jabouille *Meteo France* -!! -!! MODIFICATIONS -!! ------------- -!! Original 15/10/98 // -!! D. Gazen 22/01/01 treat NSV_* with floating indices -!! J.-P. Pinty 06/05/04 treat NSV_* for C1R3 and ELEC -!! P. Tulet 06/03/05 treat NSV_* for DUST, SALT and ORILAM -!! 05/06 Remove KEPS -!! G. Tanguy 10/09 add ILENCH=LEN(YCOMMENT) after -!! change of YCOMMENT -!! M. Leriche 07/10 add NSV_* for ice phase chemistry -!! P. Tulet 09/14 modif SALT -!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1 -!! J.-P. Pinty 09/02/16 Add LIMA that is LBC for CCN and IFN -! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O -! S. Bielli 02/2019: Sea salt: significant sea wave height influences salt emission; 5 salt modes -! P. Wautelet 10/03/2021: use scalar variable names for dust and salt -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_DIM_n -USE MODD_DYN_n -USE MODD_CONF_n -USE MODD_LSFIELD_n -USE MODD_LUNIT_n -USE MODD_PARAM_n -USE MODD_TURB_n -USE MODD_NSV -USE MODD_PARAM_LIMA -USE MODD_PARAM_n -! -USE MODE_IO_FIELD_WRITE, only: IO_Field_write, IO_Field_write_lb -USE MODE_ll -USE MODE_MSG -USE MODE_MODELN_HANDLER -USE MODE_TOOLS, ONLY: UPCASE -! -USE MODD_RAIN_C2R2_DESCR, ONLY: C2R2NAMES -USE MODD_ICE_C1R3_DESCR, ONLY: C1R3NAMES -USE MODD_CH_M9_n, ONLY: CNAMES, CICNAMES -USE MODD_LG, ONLY: CLGNAMES -USE MODD_ELEC_DESCR, ONLY: CELECNAMES -USE MODD_PARAM_LIMA_WARM, ONLY: CLIMA_WARM_NAMES -USE MODD_PARAM_LIMA_COLD, ONLY: CLIMA_COLD_NAMES -USE MODD_CH_AEROSOL -USE MODD_CH_AERO_n -USE MODI_CH_AER_REALLFI_n -USE MODD_CONF -USE MODD_REF, ONLY : XRHODREFZ -USE MODD_CONF, ONLY : CPROGRAM -USE MODD_GRID_n, ONLY : XZZ -USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT -USE MODD_DUST -USE MODD_SALT -USE MODI_DUSTLFI_n -USE MODI_SALTLFI_n -USE MODD_PARAMETERS, ONLY: JPHEXT -USE MODD_IO, ONLY: TFILEDATA -use modd_field, only: tfielddata, TYPELOG, TYPEREAL -! -! -IMPLICIT NONE -! -!* 0.1 Declarations of arguments -! -TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File characteristics -! -!* 0.2 Declarations of local variables -! -INTEGER :: ILUOUT ! logical unit -! -INTEGER :: IRR ! Index for moist variables -INTEGER :: JRR,JSV ! loop index for moist and scalar variables -! -LOGICAL :: GHORELAX_R, GHORELAX_SV ! global hor. relax. informations -INTEGER :: IRIMX,IRIMY ! size of the RIM zone -CHARACTER (LEN=1), DIMENSION (7) :: YC ! array with the prefix of the moist variables -LOGICAL, DIMENSION (7) :: GUSER ! array with the use indicator of the moist variables -REAL, DIMENSION(SIZE(XLBXSVM, 1), SIZE(XLBXSVM,2), SIZE(XLBXSVM,3)) :: ZRHODREFX -REAL, DIMENSION(SIZE(XLBYSVM, 1), SIZE(XLBYSVM,2), SIZE(XLBYSVM,3)) :: ZRHODREFY -INTEGER :: JK -INTEGER :: IMI ! Current model index -CHARACTER(LEN=2) :: INDICE ! to index CCN and IFN fields of LIMA scheme -INTEGER :: I -INTEGER :: ILBX,ILBY -INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE -INTEGER :: IIU, IJU, IKU -REAL, DIMENSION(SIZE(XLBXSVM,1), SIZE(XLBXSVM,2), SIZE(XLBXSVM,3)) :: ZLBXZZ -REAL, DIMENSION(SIZE(XLBYSVM,1), SIZE(XLBYSVM,2), SIZE(XLBYSVM,3)) :: ZLBYZZ -CHARACTER(LEN=100) :: YMSG -TYPE(TFIELDDATA) :: TZFIELD -!------------------------------------------------------------------------------- -! -!* 1. SOME INITIALIZATIONS -! -------------------- -! -ILUOUT = TLUOUT%NLU -! -IMI = GET_CURRENT_MODEL_INDEX() - -IIB=JPHEXT+1 -IIE=SIZE(XZZ,1)-JPHEXT -IIU=SIZE(XZZ,1) -IJB=JPHEXT+1 -IJE=SIZE(XZZ,2)-JPHEXT -IJU=SIZE(XZZ,2) -IKB=JPVEXT+1 -IKE=SIZE(XZZ,3)-JPVEXT -IKU=SIZE(XZZ,3) -! -! 2. WRITE THE DIMENSION OF LB FIELDS -! -------------------------------- -! -CALL IO_Field_write(TPFILE,'RIMX',NRIMX) -CALL IO_Field_write(TPFILE,'RIMY',NRIMY) -! -!* 3. BASIC VARIABLES -! -------------- -! -CALL IO_Field_write(TPFILE,'HORELAX_UVWTH',LHORELAX_UVWTH) -! -!gathering and writing of the LB fields -IF(NSIZELBXU_ll /= 0) CALL IO_Field_write_lb(TPFILE,'LBXUM', NSIZELBXU_ll,XLBXUM) -IF(NSIZELBX_ll /= 0) CALL IO_Field_write_lb(TPFILE,'LBXVM', NSIZELBX_ll,XLBXVM) -IF(NSIZELBX_ll /= 0) CALL IO_Field_write_lb(TPFILE,'LBXWM', NSIZELBX_ll,XLBXWM) -IF(NSIZELBY_ll /= 0) CALL IO_Field_write_lb(TPFILE,'LBYUM', NSIZELBY_ll,XLBYUM) -IF(NSIZELBYV_ll /= 0) CALL IO_Field_write_lb(TPFILE,'LBYVM', NSIZELBYV_ll,XLBYVM) -IF(NSIZELBY_ll /= 0) CALL IO_Field_write_lb(TPFILE,'LBYWM', NSIZELBY_ll,XLBYWM) -IF(NSIZELBX_ll /= 0) CALL IO_Field_write_lb(TPFILE,'LBXTHM',NSIZELBX_ll,XLBXTHM) -IF(NSIZELBY_ll /= 0) CALL IO_Field_write_lb(TPFILE,'LBYTHM',NSIZELBY_ll,XLBYTHM) -! -!* 4 LB-TKE -! ------ -! -IF(CTURB/='NONE') THEN - CALL IO_Field_write(TPFILE,'HORELAX_TKE',LHORELAX_TKE) -! - IF(NSIZELBXTKE_ll /= 0) CALL IO_Field_write_lb(TPFILE,'LBXTKEM',NSIZELBXTKE_ll,XLBXTKEM) - IF(NSIZELBYTKE_ll /= 0) CALL IO_Field_write_lb(TPFILE,'LBYTKEM',NSIZELBYTKE_ll,XLBYTKEM) -END IF -! -! -!* 6 LB-Rx -! ----- -! -IF (NRR >=1) THEN - GHORELAX_R = LHORELAX_RV .OR. LHORELAX_RC .OR. LHORELAX_RR .OR. & - LHORELAX_RI .OR. LHORELAX_RS .OR. LHORELAX_RG .OR. & - LHORELAX_RH - ! - TZFIELD%CMNHNAME = 'HORELAX_R' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'HORELAX_R' - TZFIELD%CUNITS = '' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Switch to activate the HOrizontal RELAXation' - TZFIELD%CLBTYPE = 'NONE' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPELOG - TZFIELD%NDIMS = 0 - TZFIELD%LTIMEDEP = .FALSE. - ! - CALL IO_Field_write(TPFILE,TZFIELD,GHORELAX_R) - ! - GUSER(:)=(/LUSERV,LUSERC,LUSERR,LUSERI,LUSERS,LUSERG,LUSERH/) - YC(:)=(/"V","C","R","I","S","G","H"/) - IRR=0 - ! - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'kg kg-1' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! Loop on moist variables - DO JRR=1,7 - IF (GUSER(JRR)) THEN - IRR=IRR+1 - IF(NSIZELBXR_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBXR'//YC(JRR)//'M' - TZFIELD%CLONGNAME = 'LBXR'//YC(JRR)//'M' - TZFIELD%CLBTYPE = 'LBX' - TZFIELD%CCOMMENT = '2_Y_Z_LBXR'//YC(JRR)//'M' - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXR_ll,XLBXRM(:,:,:,IRR)) - END IF - ! - IF(NSIZELBYR_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBYR'//YC(JRR)//'M' - TZFIELD%CLONGNAME = 'LBYR'//YC(JRR)//'M' - TZFIELD%CLBTYPE = 'LBY' - TZFIELD%CCOMMENT = '2_Y_Z_LBYR'//YC(JRR)//'M' - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYR_ll,XLBYRM(:,:,:,IRR)) - END IF - END IF - END DO -END IF -! -! -!* 7 LB-SV -! ----- -! -IF (NSV >=1) THEN - GHORELAX_SV=ANY ( LHORELAX_SV ) -! - TZFIELD%CMNHNAME = 'HORELAX_SV' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'HORELAX_SV' - TZFIELD%CUNITS = '' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = '' - TZFIELD%CLBTYPE = 'NONE' - TZFIELD%NGRID = 0 - TZFIELD%NTYPE = TYPELOG - TZFIELD%NDIMS = 0 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,GHORELAX_SV) -! - IRIMX =(NSIZELBXSV_ll-2*JPHEXT)/2 - IRIMY =(NSIZELBYSV_ll-2*JPHEXT)/2 - IF (NSV_USER>0) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'kg kg-1' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = 1,NSV_USER - IF(NSIZELBXSV_ll /= 0) THEN - WRITE(TZFIELD%CMNHNAME,'(A6,I3.3)')'LBXSVM',JSV - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3,A8)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV)) - END IF - ! - IF(NSIZELBYSV_ll /= 0) THEN - WRITE(TZFIELD%CMNHNAME,'(A6,I3.3)')'LBYSVM',JSV - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3,A8)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV)) - END IF - END DO - END IF - ! - IF (NSV_C2R2END>=NSV_C2R2BEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm-3' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_C2R2BEG,NSV_C2R2END - IF(NSIZELBXSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBX_'//TRIM(C2R2NAMES(JSV-NSV_C2R2BEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV)) - END IF - ! - IF(NSIZELBYSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBY_'//TRIM(C2R2NAMES(JSV-NSV_C2R2BEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV)) - END IF - END DO - END IF - ! - IF (NSV_C1R3END>=NSV_C1R3BEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm-3' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_C1R3BEG,NSV_C1R3END - IF(NSIZELBXSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBX_'//TRIM(C1R3NAMES(JSV-NSV_C1R3BEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV)) - END IF - ! - IF(NSIZELBYSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBY_'//TRIM(C1R3NAMES(JSV-NSV_C1R3BEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV)) - END IF - END DO - END IF -! -! LIMA: CCN and IFN scalar variables -! - IF (CCLOUD=='LIMA' ) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'kg-1' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_LIMA_CCN_FREE,NSV_LIMA_CCN_FREE+NMOD_CCN-1 - WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_CCN_FREE + 1) - IF(NSIZELBXSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CLIMA_WARM_NAMES(3)))//INDICE - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV)) - END IF - ! - IF(NSIZELBYSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CLIMA_WARM_NAMES(3)))//INDICE - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV)) - END IF - END DO - ! - DO JSV = NSV_LIMA_IFN_FREE,NSV_LIMA_IFN_FREE+NMOD_IFN-1 - WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_IFN_FREE + 1) - IF(NSIZELBXSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CLIMA_COLD_NAMES(2)))//INDICE - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV)) - END IF - ! - IF(NSIZELBYSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CLIMA_COLD_NAMES(2)))//INDICE - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV)) - END IF - END DO - END IF -! -! ELEC -! - IF (NSV_ELECEND>=NSV_ELECBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'kg kg-1' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_ELECBEG,NSV_ELECEND - IF(NSIZELBXSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBX_'//TRIM(CELECNAMES(JSV-NSV_ELECBEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV)) - END IF - ! - IF(NSIZELBYSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBY_'//TRIM(CELECNAMES(JSV-NSV_ELECBEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV)) - END IF - END DO - END IF - ! - ! - IF (LORILAM) THEN - DO JK=1,SIZE(XLBXSVM,3) - ZRHODREFX(:,:,JK) = XRHODREFZ(JK) - ZRHODREFY(:,:,JK) = XRHODREFZ(JK) - ENDDO - ! - IF (NSIZELBXSV_ll /= 0) & - XLBXSVM(:,:,:,NSV_AERBEG:NSV_AEREND) = MAX(XLBXSVM(:,:,:,NSV_AERBEG:NSV_AEREND), 0.) - IF (NSIZELBYSV_ll /= 0) & - XLBYSVM(:,:,:,NSV_AERBEG:NSV_AEREND) = MAX(XLBYSVM(:,:,:,NSV_AERBEG:NSV_AEREND), 0.) - IF (LDEPOS_AER(IMI).AND.(NSIZELBXSV_ll /= 0)) & - XLBXSVM(:,:,:,NSV_AERDEPBEG:NSV_AERDEPEND) = MAX(XLBXSVM(:,:,:,NSV_AERDEPBEG:NSV_AERDEPEND), 0.) - IF (LDEPOS_AER(IMI).AND.(NSIZELBYSV_ll /= 0)) & - XLBYSVM(:,:,:,NSV_AERDEPBEG:NSV_AERDEPEND) = MAX(XLBYSVM(:,:,:,NSV_AERDEPBEG:NSV_AERDEPEND), 0.) - IF (LAERINIT) THEN ! GRIBEX CASE (aerosols initialization) - IF ((NSIZELBXSV_ll /= 0).AND.(CPROGRAM == 'REAL ').AND.(NSP > 1)) & - CALL CH_AER_REALLFI_n(XLBXSVM(:,:,:,NSV_AERBEG:NSV_AEREND),XLBXSVM(:,:,:,NSV_CHEMBEG-1+JP_CH_CO),ZRHODREFX) - IF ((NSIZELBYSV_ll /= 0).AND.(CPROGRAM == 'REAL ').AND.(NSP > 1)) & - CALL CH_AER_REALLFI_n(XLBYSVM(:,:,:,NSV_AERBEG:NSV_AEREND),XLBYSVM(:,:,:,NSV_CHEMBEG-1+JP_CH_CO),ZRHODREFY) - IF ((NSIZELBXSV_ll /= 0).AND.(CPROGRAM == 'IDEAL ').AND.(NSP > 1)) & - CALL CH_AER_REALLFI_n(XLBXSVM(:,:,:,NSV_AERBEG:NSV_AEREND),XLBXSVM(:,:,:,NSV_CHEMBEG-1+JP_CH_CO),ZRHODREFX) - IF ((NSIZELBYSV_ll /= 0).AND.(CPROGRAM == 'IDEAL ').AND.(NSP > 1)) & - CALL CH_AER_REALLFI_n(XLBYSVM(:,:,:,NSV_AERBEG:NSV_AEREND),XLBYSVM(:,:,:,NSV_CHEMBEG-1+JP_CH_CO),ZRHODREFY) - END IF - ! - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppp' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_AERBEG,NSV_AEREND - IF(NSIZELBXSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CAERONAMES(JSV-NSV_AERBEG+1))) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV)) - END IF - ! - IF(NSIZELBYSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CAERONAMES(JSV-NSV_AERBEG+1))) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV)) - END IF - END DO - ! - IF (LDEPOS_AER(IMI)) THEN - DO JSV = NSV_AERDEPBEG,NSV_AERDEPEND - IF(NSIZELBXSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBX_'//TRIM(CDEAERNAMES(JSV-NSV_AERDEPBEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV)) - END IF - ! - IF(NSIZELBYSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBY_'//TRIM(CDEAERNAMES(JSV-NSV_AERDEPBEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV)) - END IF - END DO - END IF - END IF - ! - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'kg kg-1' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_CHEMBEG,NSV_CHEMEND - IF(NSIZELBXSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CNAMES(JSV-NSV_CHEMBEG+1))) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV)) - END IF - ! - IF(NSIZELBYSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CNAMES(JSV-NSV_CHEMBEG+1))) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV)) - END IF - END DO - ! - DO JSV = NSV_CHICBEG,NSV_CHICEND - IF(NSIZELBXSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CICNAMES(JSV-NSV_CHICBEG+1))) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV)) - END IF - ! - IF(NSIZELBYSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CICNAMES(JSV-NSV_CHICBEG+1))) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV)) - END IF - END DO - ! - DO JSV = NSV_LNOXBEG,NSV_LNOXEND - IF(NSIZELBXSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBX_LINOX' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV)) - END IF - ! - IF(NSIZELBYSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBY_LINOX' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV)) - END IF - END DO - ! - IF (LDUST) THEN - DO JK=1,size(XLBXSVM,3) - ZRHODREFX(:,:,JK) = XRHODREFZ(JK) - ENDDO - DO JK=1,size(XLBYSVM,3) - ZRHODREFY(:,:,JK) = XRHODREFZ(JK) - ENDDO - IF (NSIZELBXSV_ll /= 0) & - XLBXSVM(:,:,:,NSV_DSTBEG:NSV_DSTEND) = MAX(XLBXSVM(:,:,:,NSV_DSTBEG:NSV_DSTEND), 0.) - IF (NSIZELBYSV_ll /= 0) & - XLBYSVM(:,:,:,NSV_DSTBEG:NSV_DSTEND) = MAX(XLBYSVM(:,:,:,NSV_DSTBEG:NSV_DSTEND), 0.) - IF (LDEPOS_DST(IMI).AND.(NSIZELBXSV_ll /= 0)) & - XLBXSVM(:,:,:,NSV_DSTDEPBEG:NSV_DSTDEPEND) = MAX(XLBXSVM(:,:,:,NSV_DSTDEPBEG:NSV_DSTDEPEND), 0.) - IF (LDEPOS_DST(IMI).AND.(NSIZELBYSV_ll /= 0)) & - XLBYSVM(:,:,:,NSV_DSTDEPBEG:NSV_DSTDEPEND) = MAX(XLBYSVM(:,:,:,NSV_DSTDEPBEG:NSV_DSTDEPEND), 0.) - IF ((LDSTINIT).AND.(.NOT.LDSTCAMS)) THEN ! GRIBEX case (dust initialization) - IF ((NSIZELBXSV_ll /= 0).AND.(CPROGRAM == 'REAL ').AND.(NSV_DST > 1)) THEN - CALL DUSTLFI_n(XLBXSVM(:,:,:,NSV_DSTBEG:NSV_DSTEND), ZRHODREFX) - END IF - IF ((NSIZELBYSV_ll /= 0).AND.(CPROGRAM == 'REAL ').AND.(NSV_DST > 1)) THEN - CALL DUSTLFI_n(XLBYSVM(:,:,:,NSV_DSTBEG:NSV_DSTEND), ZRHODREFY) - END IF - IF ((NSIZELBXSV_ll /= 0).AND.(CPROGRAM == 'IDEAL ').AND.(NSV_DST > 1)) & - CALL DUSTLFI_n(XLBXSVM(:,:,:,NSV_DSTBEG:NSV_DSTEND), ZRHODREFX) - IF ((NSIZELBYSV_ll /= 0).AND.(CPROGRAM == 'IDEAL ').AND.(NSV_DST > 1)) & - CALL DUSTLFI_n(XLBYSVM(:,:,:,NSV_DSTBEG:NSV_DSTEND), ZRHODREFY) - END IF - ! - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppp' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_DSTBEG,NSV_DSTEND - IF(NSIZELBXSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBX_'//TRIM(CDUSTNAMES(JSV-NSV_DSTBEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV)) - END IF - ! - IF(NSIZELBYSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBY_'//TRIM(CDUSTNAMES(JSV-NSV_DSTBEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV)) - END IF - END DO - IF (LDEPOS_DST(IMI)) THEN - DO JSV = NSV_DSTDEPBEG,NSV_DSTDEPEND - IF(NSIZELBXSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBX_'//TRIM(CDEDSTNAMES(JSV-NSV_DSTDEPBEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV)) - END IF - ! - IF(NSIZELBYSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBY_'//TRIM(CDEDSTNAMES(JSV-NSV_DSTDEPBEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV)) - END IF - END DO - END IF - ENDIF - ! - IF (LSALT) THEN - DO JK=1,size(XLBXSVM,3) - ZRHODREFX(:,:,JK) = XRHODREFZ(JK) - ENDDO - DO JK=1,size(XLBYSVM,3) - ZRHODREFY(:,:,JK) = XRHODREFZ(JK) - ENDDO - IIU = SIZE(XZZ,1) - IJU = SIZE(XZZ,2) - IKU = SIZE(XZZ,3) - IF (SIZE(ZLBXZZ) .NE. 0 ) THEN - ILBX=SIZE(ZLBXZZ,1)/2-1 - ZLBXZZ(1:ILBX+1,:,:) = XZZ(IIB-1:IIB-1+ILBX,:,:) - ZLBXZZ(ILBX+2:2*ILBX+2,:,:) = XZZ(IIE+1-ILBX:IIE+1,:,:) - ENDIF - IF (SIZE(ZLBYZZ) .NE. 0 ) THEN - ILBY=SIZE(ZLBYZZ,2)/2-1 - ZLBYZZ(:,1:ILBY+1,:) = XZZ(:,IJB-1:IJB-1+ILBY,:) - ZLBYZZ(:,ILBY+2:2*ILBY+2,:) = XZZ(:,IJE+1-ILBY:IJE+1,:) - ENDIF - IF (NSIZELBXSV_ll /= 0) & - XLBXSVM(:,:,:,NSV_SLTBEG:NSV_SLTEND) = MAX(XLBXSVM(:,:,:,NSV_SLTBEG:NSV_SLTEND), 0.) - IF (NSIZELBYSV_ll /= 0) & - XLBYSVM(:,:,:,NSV_SLTBEG:NSV_SLTEND) = MAX(XLBYSVM(:,:,:,NSV_SLTBEG:NSV_SLTEND), 0.) - IF (LDEPOS_SLT(IMI).AND.(NSIZELBXSV_ll /= 0)) & - XLBXSVM(:,:,:,NSV_SLTDEPBEG:NSV_SLTDEPEND) = MAX(XLBXSVM(:,:,:,NSV_SLTDEPBEG:NSV_SLTDEPEND), 0.) - IF (LDEPOS_SLT(IMI).AND.(NSIZELBYSV_ll /= 0)) & - XLBYSVM(:,:,:,NSV_SLTDEPBEG:NSV_SLTDEPEND) = MAX(XLBYSVM(:,:,:,NSV_SLTDEPBEG:NSV_SLTDEPEND), 0.) - IF ((LSLTINIT).AND.(.NOT.LSLTCAMS)) THEN ! GRIBEX case (dust initialization) - IF ((NSIZELBXSV_ll /= 0).AND.(CPROGRAM == 'REAL ').AND.(NSV_SLT > 1)) THEN - CALL SALTLFI_n(XLBXSVM(:,:,:,NSV_SLTBEG:NSV_SLTEND), ZRHODREFX, ZLBXZZ) - END IF - IF ((NSIZELBYSV_ll /= 0).AND.(CPROGRAM == 'REAL ').AND.(NSV_SLT > 1)) THEN - CALL SALTLFI_n(XLBYSVM(:,:,:,NSV_SLTBEG:NSV_SLTEND), ZRHODREFY, ZLBYZZ) - END IF - IF ((NSIZELBXSV_ll /= 0).AND.(CPROGRAM == 'IDEAL ').AND.(NSV_SLT > 1)) THEN - CALL SALTLFI_n(XLBXSVM(:,:,:,NSV_SLTBEG:NSV_SLTEND), ZRHODREFX, ZLBXZZ) - END IF - IF ((NSIZELBYSV_ll /= 0).AND.(CPROGRAM == 'IDEAL ').AND.(NSV_SLT > 1)) THEN - CALL SALTLFI_n(XLBYSVM(:,:,:,NSV_SLTBEG:NSV_SLTEND), ZRHODREFY, ZLBYZZ) - END IF - END IF - ! - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppp' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_SLTBEG,NSV_SLTEND - IF(NSIZELBXSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBX_'//TRIM(CSALTNAMES(JSV-NSV_SLTBEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV)) - END IF - ! - IF(NSIZELBYSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBY_'//TRIM(CSALTNAMES(JSV-NSV_SLTBEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV)) - END IF - END DO - IF (LDEPOS_SLT(IMI)) THEN - DO JSV = NSV_SLTDEPBEG,NSV_SLTDEPEND - IF(NSIZELBXSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBX_'//TRIM(CDESLTNAMES(JSV-NSV_SLTDEPBEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV)) - END IF - ! - IF(NSIZELBYSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBY_'//TRIM(CDESLTNAMES(JSV-NSV_SLTDEPBEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV)) - END IF - END DO - END IF - ENDIF - ! - ! lagrangian variables - IF (NSV_LGEND>=NSV_LGBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_LGBEG,NSV_LGEND - IF(NSIZELBXSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBX_'//TRIM(CLGNAMES(JSV-NSV_LGBEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV)) - END IF -! - IF(NSIZELBYSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBY_'//TRIM(CLGNAMES(JSV-NSV_LGBEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV)) - END IF - END DO - END IF - ! passive pollutants - IF (NSV_PPEND>=NSV_PPBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'kg kg-1' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_PPBEG,NSV_PPEND - IF(NSIZELBXSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBX_PP' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV)) - END IF - ! - IF(NSIZELBYSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBY_PP' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV)) - END IF - END DO - END IF - ! conditional sampling - IF (NSV_CSEND>=NSV_CSBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'kg kg-1' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_CSBEG,NSV_CSEND - IF(NSIZELBXSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBX_CS' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV)) - END IF - ! - IF(NSIZELBYSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBY_CS' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV)) - END IF - END DO - END IF -#ifdef MNH_FOREFIRE - ! ForeFire scalar variables - IF (NSV_FFEND>=NSV_FFBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'kg kg-1' - TZFIELD%CDIR = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_FFBEG,NSV_FFEND - IF(NSIZELBXSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBX_FF' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBX' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV)) - END IF - ! - IF(NSIZELBYSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBY_FF' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CLBTYPE = 'LBY' - WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV - CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV)) - END IF - END DO - END IF -#endif -END IF -! -!------------------------------------------------------------------------------- -! -! -END SUBROUTINE WRITE_LB_n diff --git a/src/ICCARE_BASE/write_lfifm1_for_diag.f90 b/src/ICCARE_BASE/write_lfifm1_for_diag.f90 deleted file mode 100644 index 54c450494..000000000 --- a/src/ICCARE_BASE/write_lfifm1_for_diag.f90 +++ /dev/null @@ -1,4136 +0,0 @@ -!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!----------------------------------------------------------------- -!################################ -MODULE MODI_WRITE_LFIFM1_FOR_DIAG -!################################ -INTERFACE - SUBROUTINE WRITE_LFIFM1_FOR_DIAG(TPFILE,HDADFILE) -! -USE MODD_IO, ONLY: TFILEDATA -! -TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! outpput data file -CHARACTER(LEN=28), INTENT(IN) :: HDADFILE ! corresponding FM-file name of - ! its DAD model -! -END SUBROUTINE WRITE_LFIFM1_FOR_DIAG -END INTERFACE -END MODULE MODI_WRITE_LFIFM1_FOR_DIAG -! -! ################################################## - SUBROUTINE WRITE_LFIFM1_FOR_DIAG(TPFILE,HDADFILE) -! ################################################## -! -!!**** *WRITE_LFIFM1* - routine to write a LFIFM file for model 1 -!! -!! PURPOSE -!! ------- -! The purpose of this routine is to write an initial LFIFM File -! of name YFMFILE2//'.lfi' with the FM routines. -! -!!** METHOD -!! ------ -!! The data are written in the LFIFM file : -!! - dimensions -!! - grid variables -!! - configuration variables -!! - prognostic variables at time t and t-dt -!! - 1D anelastic reference state -!! -!! The localization on the model grid is also indicated : -!! -!! IGRID = 1 for mass grid point -!! IGRID = 2 for U grid point -!! IGRID = 3 for V grid point -!! IGRID = 4 for w grid point -!! IGRID = 0 for meaningless case -!! -!! -!! EXTERNAL -!! -------- -!! FMWRIT : FM-routine to write a record -!! -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! Module MODD_DIM1 : contains dimensions -!! Module MODD_TIME1 : contains time variables and uses MODD_TIME -!! Module MODD_GRID : contains spatial grid variables for all models -!! Module MODD_GRID1 : contains spatial grid variables -!! Module MODD_REF : contains reference state variables -!! Module MODD_LUNIT1: contains logical unit variables. -!! Module MODD_CONF : contains configuration variables for all models -!! Module MODD_CONF1 : contains configuration variables -!! Module MODD_FIELD1 : contains prognostic variables -!! Module MODD_GR_FIELD1 : contains surface prognostic variables -!! Module MODD_LSFIELD1 : contains Larger Scale variables -!! Module MODD_PARAM1 : contains parameterization options -!! Module MODD_TURB1 : contains turbulence options -!! Module MODD_FRC : contains forcing variables -!! -!! REFERENCE -!! --------- -!! -!! -!! AUTHOR -!! ------ -!! V. Ducrocq *Meteo France* -!! -!! MODIFICATIONS -!! ------------- -!! Original 06/05/94 -!! V. Ducrocq 27/06/94 -!! J.Stein 20/10/94 (name of the FMFILE) -!! J.Stein 06/12/94 add the LS fields -!! J.P. Lafore 09/01/95 add the DRYMASST -!! J.Stein 20/01/95 add TKE and change the ycomment for the water -!! variables -!! J.Stein 23/01/95 add a TKE switch and MODD_PARAM1 -!! J.Stein 16/03/95 remove R from the historical variables -!! J.Stein 20/03/95 add the EPS var. -!! J.Stein 30/06/95 add the variables related to the subgrid condens -!! S. Belair 01/09/95 add surface variables and ground parameters -!! J.-P. Pinty 15/09/95 add the radiation parameters -!! J.Stein 23/01/96 add the TSZ0 option for the surface scheme -!! M.Georgelin 13/12/95 add the forcing variables -!! J.-P. Pinty 15/02/96 add external control for the forcing -!! J.Stein P.Bougeault 15/03/96 add the cloud fraction and change the -!! surface parameters for TSZ0 option -!! J.Stein P.Jabouille 30/04/96 add the storage type -!! J.Stein P.Jabouille 20/05/96 switch for XSIGS and XSRC -!! J.Stein 10/10/96 change Xsrc into XSRCM and XRCT -!! J.P. Lafore 30/07/96 add YFMFILE2 and HDADFILE writing -!! corresponding to MY_NAME and DAD_NAME (for nesting) -!! V.Masson 08/10/96 add LTHINSHELL -!! J.-P. Pinty 15/12/96 add the microphysics (ice) -!! J.-P. Pinty 11/01/97 add the deep convection -!! J.-P. Pinty 27/01/97 split the recording of the SV array -!! J.-P. Pinty 29/01/97 set recording of PRCONV and PACCONV in mm/h and -!! mm respectively -!! J. Viviand 04/02/97 convert precipitation rates in mm/h -!! P. Hereil 04/12/97 add the calculation of cloud top and moist PV -!! P.Hereil N Asencio 3/02/98 add the calculation of precipitation on large scale grid mesh -!! N Asencio 2/10/98 suppress flux calculation if start file -!! V Masson 25/11/98 places dummy arguments in module MODD_DIAG_FLAG -!! V Masson 04/01/00 removes TSZ0 option -!! J.-P. Pinty 29/11/02 add C3R5, ICE2, ICE4, CELEC -!! V Masson 01/2004 removes surface (externalization) -!! P. Tulet 01/2005 add dust, orilam -!! M. Leriche 04/2007 add aqueous concentration in M -!! O. Caumont 03/2008 add simulation of radar observations -!! O. Caumont 14/09/2009 modifications to allow for polar outputs (radar diagnostics) -!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after -!! change of YCOMMENT -!! G. Tanguy 10/2009 add possibility to run radar after -!! PREP_REAL_CASE with AROME -!! O. Caumont 01/2011 [radar diagnostics] add control check for NMAX; revise comments -!! O. Caumont 05/2011 [radar diagnostics] change output format -!! G.Tanguy/ JP Pinty/ JP Chabureau 18/05/2011 : add lidar simulator -!! S.Bielli 12/2012 : add latitude and longitude -!! F. Duffourg 02/2013 : add new fields -!! J.Escobar 21/03/2013: for HALOK get correctly local array dim/bound -!! J. escobar 27/03/2014 : write LAT/LON only in not CARTESIAN case -!! G.Delautier 2014 : remplace MODD_RAIN_C2R2_PARAM par MODD_RAIN_C2R2_KHKO_PARAM -!! C. Augros 2014 : new radar simulator (T matrice) -!! D.Ricard 2015 : add THETAES + POVOES (LMOIST_ES=T) -!! Modification 01/2016 (JP Pinty) Add LIMA -!! C.Lac 04/2016 : add visibility and droplet deposition -!! 10/2017 (G.Delautier) New boundary layer height : replace LBLTOP by CBLTOP -!! T.Dauhut 10/2017 : add parallel 3D clustering -!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O -!! D.Ricard and P.Marquet 2016-2017 : THETAL + THETAS1 POVOS1 or THETAS2 POVOS2 -!! if LMOIST_L LMOIST_S1 or LMOIST_S2 -! P. Wautelet 08/02/2019: minor bug: compute ZWORK36 only when needed -! S Bielli 02/2019: sea salt: significant sea wave height influences salt emission; 5 salt modes -! P. Wautelet 18/03/2020: remove ICE2 option -! B. Vie 06/2020 Add prognostic supersaturation for LIMA -! P. Wautelet 11/03/2021: bugfix: correct name for NSV_LIMA_IMM_NUCL -! J.L Redelsperger 03/2021 Adding OCEAN LES Case and Autocoupled O-A LES -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_DIM_n -USE MODD_CONF -USE MODD_CONF_n -use modd_field, only: tfielddata, tfieldlist, TYPEINT, TYPEREAL -USE MODD_GRID -USE MODD_GRID_n -USE MODD_IO, ONLY : TFILEDATA -USE MODD_METRICS_n -USE MODD_TIME -USE MODD_TIME_n -USE MODD_DYN_n -USE MODD_FIELD_n -USE MODD_GR_FIELD_n -USE MODD_LSFIELD_n -USE MODD_PARAM_n -USE MODD_CURVCOR_n -USE MODD_REF -USE MODD_REF_n -USE MODD_LUNIT, ONLY : TLUOUT0 -USE MODD_LUNIT_n -USE MODD_TURB_n -USE MODD_RADIATIONS_n -USE MODD_FRC -USE MODD_PRECIP_n -USE MODD_CST -USE MODD_CLOUDPAR -USE MODD_DEEP_CONVECTION_n -USE MODD_PARAM_KAFR_n -USE MODD_NESTING -USE MODD_PARAMETERS -USE MODD_DIAG_FLAG -USE MODD_NSV -USE MODD_CH_M9_n, ONLY : CNAMES, NEQAQ -USE MODD_RAIN_C2R2_DESCR, ONLY : C2R2NAMES -USE MODD_ICE_C1R3_DESCR, ONLY : C1R3NAMES -USE MODD_ELEC_DESCR, ONLY : CELECNAMES -USE MODD_RAIN_C2R2_KHKO_PARAM -USE MODD_ICE_C1R3_PARAM -USE MODD_PARAM_ICE, ONLY : LSEDIC -USE MODD_PARAM_LIMA, ONLY : NMOD_CCN, NMOD_IFN, NMOD_IMM, NINDICE_CCN_IMM,& - LSCAV, LHHONI, LAERO_MASS, & - LLIMA_DIAG, & - NSPECIE, XMDIAM_IFN, XSIGMA_IFN, ZFRAC=>XFRAC,& - XR_MEAN_CCN, XLOGSIG_CCN -USE MODD_PARAM_LIMA_WARM, ONLY : CLIMA_WARM_CONC, CAERO_MASS -USE MODD_PARAM_LIMA_COLD, ONLY : CLIMA_COLD_CONC -USE MODD_LG, ONLY : CLGNAMES -USE MODD_PASPOL, ONLY : LPASPOL -USE MODD_CONDSAMP, ONLY : LCONDSAMP -! -USE MODD_DIAG_FLAG -USE MODD_RADAR, ONLY: XLAT_RAD,XELEV,& - XSTEP_RAD,NBRAD,NBELEV,NBAZIM,NBSTEPMAX,& - NCURV_INTERPOL,LATT,LCART_RAD,NPTS_H,NPTS_V,XGRID,& - LREFR,LDNDZ,NMAX,CNAME_RAD,NDIFF,& - XLON_RAD,XALT_RAD,XLAM_RAD,XDT_RAD,LWBSCS,LWREFL -use modd_precision, only: MNHREAL_MPI -! -USE MODI_RADAR_SIMULATOR -! -USE MODD_DUST -USE MODD_CSTS_DUST -USE MODD_SALT -USE MODD_BLOWSNOW -USE MODD_CH_AEROSOL -USE MODD_CH_AERO_n -USE MODD_CH_MNHC_n -USE MODE_DUST_PSD -USE MODE_SALT_PSD -USE MODE_BLOWSNOW_PSD -USE MODE_AERO_PSD -USE MODI_GRADIENT_M -USE MODI_GRADIENT_W -USE MODI_GRADIENT_U -USE MODI_GRADIENT_V -USE MODI_SHUMAN -USE MODI_RADAR_RAIN_ICE -USE MODI_INI_RADAR -USE MODI_COMPUTE_MEAN_PRECIP -USE MODI_UV_TO_ZONAL_AND_MERID -USE MODI_CALCSOUND -USE MODI_FREE_ATM_PROFILE -USE MODI_GPS_ZENITH -USE MODI_CONTRAV -! -use mode_field, only: Find_field_id_from_mnhname -USE MODE_GRIDPROJ -USE MODE_GATHER_ll -USE MODE_IO_FIELD_WRITE, only: IO_Field_write -USE MODE_IO_FILE, only: IO_File_close, IO_File_open -USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list -USE MODE_ll -use mode_msg -USE MODE_THERMO -USE MODE_TOOLS, ONLY: UPCASE -USE MODE_MODELN_HANDLER -USE MODI_LIDAR -USE MODI_CLUSTERING -! -USE MODD_MPIF -USE MODD_VAR_ll -! -IMPLICIT NONE -! -!* 0.1 Declarations of arguments -! -TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! outpput data file -CHARACTER(LEN=28), INTENT(IN) :: HDADFILE ! corresponding FM-file name of - ! its DAD model -! -!* 0.2 Declarations of local variables -! -INTEGER :: IRESP ! return-code for the file routines -! -CHARACTER(LEN=3) :: YFRC ! to mark the time of the forcing -CHARACTER(LEN=31) :: YFGRI ! file name for GPS stations -! -INTEGER :: IIU,IJU,IKU,IIB,IJB,IKB,IIE,IJE,IKE ! Arrays bounds -! -INTEGER :: JLOOP,JI,JJ,JK,JSV,JT,JH,JV,JEL ! loop index -INTEGER :: IMI ! Current model index -! -REAL :: ZRV_OV_RD ! XRV / XRD -REAL :: ZGAMREF ! Standard atmosphere lapse rate (K/m) -REAL :: ZX0D ! work real scalar -REAL :: ZLATOR, ZLONOR ! geographical coordinates of 1st mass point -REAL :: ZXHATM, ZYHATM ! conformal coordinates of 1st mass point -REAL, DIMENSION(:), ALLOCATABLE :: ZXHAT_ll ! Position x in the conformal - ! plane (array on the complete domain) -REAL, DIMENSION(:), ALLOCATABLE :: ZYHAT_ll ! Position y in the conformal - ! plane (array on the complete domain) -! -REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZPOVO -REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZTEMP -REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZVOX,ZVOY,ZVOZ -REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZCORIOZ -REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZWORK31,ZWORK32 -REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZWORK33,ZWORK34 -REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2)) :: ZWORK21,ZWORK22 -REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2)) :: ZWORK23,ZWORK24 -REAL,DIMENSION(:,:,:,:,:), ALLOCATABLE :: ZWORK42 ! reflectivity on a cartesian grid (PREFL_CART) -REAL,DIMENSION(:,:,:,:,:), ALLOCATABLE :: ZWORK42_BIS -REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZWORK43 ! latlon coordinates of cartesian grid points (PLATLON) -REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZPHI,ZTHETAE,ZTHETAV -REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZTHETAES,ZTHETAL,ZTHETAS1,ZTHETAS2 -REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZVISIKUN,ZVISIGUL,ZVISIZHA -INTEGER, DIMENSION(:,:), ALLOCATABLE :: IWORK1 -integer :: ICURR,INBOUT,IERR -! -REAL,DIMENSION(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),NSP+NCARB+NSOA,JPMODE):: ZPTOTA -REAL,DIMENSION(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),NMODE_DST*2):: ZSDSTDEP -REAL,DIMENSION(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),NMODE_SLT*2):: ZSSLTDEP -REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZSIG_DST, ZRG_DST, ZN0_DST -REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZSIG_SLT, ZRG_SLT, ZN0_SLT -REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZBET_SNW, ZRG_SNW -REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZMA_SNW -REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZRHOT, ZTMP ! work array -! -! GBOTUP = True does clustering from bottom up to top, False top down to surface -LOGICAL :: GBOTUP ! clustering propagation -LOGICAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: GCLOUD ! mask -INTEGER,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ICLUSTERID, ICLUSTERLV -REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZCLDSIZE - -!ECRITURE DANS UN FICHIER ASCII DE RESULTATS -!INITIALISATION DU NOM DE FICHIER CREE EN PARALLELE AVEC CELUI LFI -TYPE(TFILEDATA),POINTER :: TZRSFILE -INTEGER :: ILURS -CHARACTER(LEN=32) :: YRS -CHARACTER(LEN=3),DIMENSION(:),ALLOCATABLE :: YRAD -CHARACTER(LEN=2*INT(NBSTEPMAX*XSTEP_RAD/XGRID)*2*9+1), DIMENSION(:), ALLOCATABLE :: CLATLON -CHARACTER(LEN=2*9) :: CBUFFER -CHARACTER(LEN=4) :: YELEV -CHARACTER(LEN=3) :: YGRID_SIZE -INTEGER :: IEL,IIELV -CHARACTER(LEN=5) :: YVIEW ! Upward or Downward integration -INTEGER :: IACCMODE -! -!------------------------------------------------------------------------------- -INTEGER :: IAUX ! work variable -REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZWORK35,ZWORK36 -REAL,DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2)) :: ZWORK25,ZWORK26 -REAL :: ZEAU ! Mean precipitable water -INTEGER, DIMENSION(SIZE(XZZ,1),SIZE(XZZ,2)) ::IKTOP ! level in which is the altitude 3000m -REAL, DIMENSION(SIZE(XZZ,1),SIZE(XZZ,2),SIZE(XZZ,3)) :: ZDELTAZ ! interval (m) between two levels K -INTEGER :: ILUOUT0 ! Logical unit number for output-listing -! -CHARACTER(LEN=2) :: INDICE -CHARACTER(LEN=100) :: YMSG -INTEGER :: IID -TYPE(TFIELDDATA) :: TZFIELD -TYPE(TFIELDDATA),DIMENSION(2) :: TZFIELD2 -! -! LIMA LIDAR -REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZTMP1, ZTMP2, ZTMP3, ZTMP4 -! -! hauteur couche limite -REAL,DIMENSION(:,:,:),ALLOCATABLE :: ZZZ_GRID1 -REAL,DIMENSION(:,:),ALLOCATABLE :: ZTHVSOL,ZSHMIX -REAL,DIMENSION(:,:,:),ALLOCATABLE :: ZZONWIND,ZMERWIND,ZFFWIND2,ZRIB -! -!------------------------------------------------------------------------------- -! -!* 0. ARRAYS BOUNDS INITIALIZATION -! -CALL GET_DIM_EXT_ll ('B',IIU,IJU) -CALL GET_INDICE_ll (IIB,IJB,IIE,IJE) -IKU=NKMAX+2*JPVEXT -IKB=1+JPVEXT -IKE=IKU-JPVEXT - -IMI = GET_CURRENT_MODEL_INDEX() -ILUOUT0 = TLUOUT0%NLU -TZRSFILE => NULL() -!------------------------------------------------------------------------------- -! -!* 1. WRITES IN THE LFI FILE -! ---------------------- -! -!* 1.0 TPFILE%CNAME and HDADFILE : -! -CALL IO_Field_write(TPFILE,'MASDEV', NMASDEV) -CALL IO_Field_write(TPFILE,'BUGFIX', NBUGFIX) -CALL IO_Field_write(TPFILE,'BIBUSER', CBIBUSER) -CALL IO_Field_write(TPFILE,'PROGRAM', CPROGRAM) -! -CALL IO_Field_write(TPFILE,'L1D', L1D) -CALL IO_Field_write(TPFILE,'L2D', L2D) -CALL IO_Field_write(TPFILE,'PACK', LPACK) -! -CALL IO_Field_write(TPFILE,'MY_NAME', TPFILE%CNAME) -CALL IO_Field_write(TPFILE,'DAD_NAME', HDADFILE) -! -IF (LEN_TRIM(HDADFILE)>0) THEN - CALL IO_Field_write(TPFILE,'DXRATIO',NDXRATIO_ALL(1)) - CALL IO_Field_write(TPFILE,'DYRATIO',NDYRATIO_ALL(1)) - CALL IO_Field_write(TPFILE,'XOR', NXOR_ALL(1)) - CALL IO_Field_write(TPFILE,'YOR', NYOR_ALL(1)) -END IF -! -CALL IO_Field_write(TPFILE,'SURF', CSURF) -! -!* 1.1 Type and Dimensions : -! -CALL IO_Field_write(TPFILE,'STORAGE_TYPE','DI') -! -CALL IO_Field_write(TPFILE,'IMAX',NIMAX_ll) -CALL IO_Field_write(TPFILE,'JMAX',NJMAX_ll) -CALL IO_Field_write(TPFILE,'KMAX',NKMAX) -! -CALL IO_Field_write(TPFILE,'JPHEXT',JPHEXT) -! -!* 1.2 Grid variables : -! -IF (.NOT.LCARTESIAN) THEN - CALL IO_Field_write(TPFILE,'RPK', XRPK) - CALL IO_Field_write(TPFILE,'LONORI',XLONORI) - CALL IO_Field_write(TPFILE,'LATORI',XLATORI) -! -!* diagnostic of 1st mass point -! - ALLOCATE(ZXHAT_ll(NIMAX_ll+ 2 * JPHEXT),ZYHAT_ll(NJMAX_ll+2 * JPHEXT)) - CALL GATHERALL_FIELD_ll('XX',XXHAT,ZXHAT_ll,IRESP) !// - CALL GATHERALL_FIELD_ll('YY',XYHAT,ZYHAT_ll,IRESP) !// - ZXHATM = 0.5 * (ZXHAT_ll(1)+ZXHAT_ll(2)) - ZYHATM = 0.5 * (ZYHAT_ll(1)+ZYHAT_ll(2)) - CALL SM_LATLON(XLATORI,XLONORI,ZXHATM,ZYHATM,ZLATOR,ZLONOR) - DEALLOCATE(ZXHAT_ll,ZYHAT_ll) -! - CALL IO_Field_write(TPFILE,'LONOR',ZLONOR) - CALL IO_Field_write(TPFILE,'LATOR',ZLATOR) -! -END IF -! -CALL IO_Field_write(TPFILE,'THINSHELL',LTHINSHELL) -CALL IO_Field_write(TPFILE,'LAT0',XLAT0) -CALL IO_Field_write(TPFILE,'LON0',XLON0) -CALL IO_Field_write(TPFILE,'BETA',XBETA) -! -CALL IO_Field_write(TPFILE,'XHAT',XXHAT) -CALL IO_Field_write(TPFILE,'YHAT',XYHAT) -CALL IO_Field_write(TPFILE,'ZHAT',XZHAT) -CALL IO_Field_write(TPFILE,'ZTOP',XZTOP) -! -CALL IO_Field_write(TPFILE,'ZS', XZS) -CALL IO_Field_write(TPFILE,'ZWS', XZWS) -CALL IO_Field_write(TPFILE,'ZSMT', XZSMT) -CALL IO_Field_write(TPFILE,'SLEVE',LSLEVE) -! -IF (LSLEVE) THEN - CALL IO_Field_write(TPFILE,'LEN1',XLEN1) - CALL IO_Field_write(TPFILE,'LEN2',XLEN2) -END IF -! -! -CALL IO_Field_write(TPFILE,'DTMOD',TDTMOD) -CALL IO_Field_write(TPFILE,'DTCUR',TDTCUR) -CALL IO_Field_write(TPFILE,'DTEXP',TDTEXP) -CALL IO_Field_write(TPFILE,'DTSEG',TDTSEG) -! -!* 1.3 Configuration variables : -! -CALL IO_Field_write(TPFILE,'CARTESIAN',LCARTESIAN) -CALL IO_Field_write(TPFILE,'LBOUSS', LBOUSS) -CALL IO_Field_write(TPFILE,'LOCEAN', LOCEAN) -CALL IO_Field_write(TPFILE,'LCOUPLES', LCOUPLES) -! -IF (LCARTESIAN .AND. LWIND_ZM) THEN - LWIND_ZM=.FALSE. - PRINT*,'YOU ARE IN CARTESIAN GEOMETRY SO LWIND_ZM IS FORCED TO FALSE' -END IF -!* 1.4 Reference state variables : -! -IF (LCOUPLES.AND.LOCEAN) THEN - CALL IO_Field_write(TPFILE,'RHOREFZ',XRHODREFZO) - CALL IO_Field_write(TPFILE,'THVREFZ',XTHVREFZO) - CALL IO_Field_write(TPFILE,'EXNTOP', XEXNTOPO) -ELSE - CALL IO_Field_write(TPFILE,'RHOREFZ',XRHODREFZ) - CALL IO_Field_write(TPFILE,'THVREFZ',XTHVREFZ) - CALL IO_Field_write(TPFILE,'EXNTOP', XEXNTOP) -END IF -! -CALL IO_Field_write(TPFILE,'RHODREF',XRHODREF) -CALL IO_Field_write(TPFILE,'THVREF', XTHVREF) -! -! -!* 1.5 Variables necessary for plots -! -! PABST,THT,POVOM for cross sections at constant pressure -! level or constant theta level or constant PV level -! -IF (INDEX(CISO,'PR') /= 0) THEN - CALL IO_Field_write(TPFILE,'PABST',XPABST) -END IF -! -IF (INDEX(CISO,'TK') /= 0) THEN - CALL IO_Field_write(TPFILE,'THT',XTHT) -END IF -! -ZCORIOZ(:,:,:)=SPREAD( XCORIOZ(:,:),DIM=3,NCOPIES=IKU ) -ZVOX(:,:,:)=GY_W_VW(XWT,XDYY,XDZZ,XDZY)-GZ_V_VW(XVT,XDZZ) -ZVOX(:,:,2)=ZVOX(:,:,3) -ZVOY(:,:,:)=GZ_U_UW(XUT,XDZZ)-GX_W_UW(XWT,XDXX,XDZZ,XDZX) -ZVOY(:,:,2)=ZVOY(:,:,3) -ZVOZ(:,:,:)=GX_V_UV(XVT,XDXX,XDZZ,XDZX)-GY_U_UV(XUT,XDYY,XDZZ,XDZY) -ZVOZ(:,:,2)=ZVOZ(:,:,3) -ZVOZ(:,:,1)=ZVOZ(:,:,3) -ZWORK31(:,:,:)=GX_M_M(XTHT,XDXX,XDZZ,XDZX) -ZWORK32(:,:,:)=GY_M_M(XTHT,XDYY,XDZZ,XDZY) -ZWORK33(:,:,:)=GZ_M_M(XTHT,XDZZ) -ZPOVO(:,:,:)= ZWORK31(:,:,:)*MZF(MYF(ZVOX(:,:,:))) & - + ZWORK32(:,:,:)*MZF(MXF(ZVOY(:,:,:))) & - + ZWORK33(:,:,:)*(MYF(MXF(ZVOZ(:,:,:))) + ZCORIOZ(:,:,:)) -ZPOVO(:,:,:)= ZPOVO(:,:,:)*1E6/XRHODREF(:,:,:) -ZPOVO(:,:,1) =-1.E+11 -ZPOVO(:,:,IKU)=-1.E+11 -IF (INDEX(CISO,'EV') /= 0) THEN - TZFIELD%CMNHNAME = 'POVOT' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'POVOT' - TZFIELD%CUNITS = 'PVU' ! 1 PVU = 1e-6 m^2 s^-1 K kg^-1 - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_POtential VOrticity' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZPOVO) -END IF -! -! -IF (LVAR_RS) THEN - CALL IO_Field_write(TPFILE,'UT',XUT) - CALL IO_Field_write(TPFILE,'VT',XVT) - ! - IF (LWIND_ZM) THEN - TZFIELD2(1)%CMNHNAME = 'UM_ZM' - TZFIELD2(1)%CSTDNAME = '' - TZFIELD2(1)%CLONGNAME = 'UM_ZM' - TZFIELD2(1)%CUNITS = 'm s-1' - TZFIELD2(1)%CDIR = 'XY' - TZFIELD2(1)%CCOMMENT = 'Zonal component of horizontal wind' - TZFIELD2(1)%NGRID = 2 - TZFIELD2(1)%NTYPE = TYPEREAL - TZFIELD2(1)%NDIMS = 3 - TZFIELD2(1)%LTIMEDEP = .TRUE. - ! - TZFIELD2(2)%CMNHNAME = 'VM_ZM' - TZFIELD2(2)%CSTDNAME = '' - TZFIELD2(2)%CLONGNAME = 'VM_ZM' - TZFIELD2(2)%CUNITS = 'm s-1' - TZFIELD2(2)%CDIR = 'XY' - TZFIELD2(2)%CCOMMENT = 'Meridian component of horizontal wind' - TZFIELD2(2)%NGRID = 3 - TZFIELD2(2)%NTYPE = TYPEREAL - TZFIELD2(2)%NDIMS = 3 - TZFIELD2(2)%LTIMEDEP = .TRUE. - ! - CALL UV_TO_ZONAL_AND_MERID(XUT,XVT,23,TPFILE=TPFILE,TZFIELDS=TZFIELD2) - END IF - ! - CALL IO_Field_write(TPFILE,'WT',XWT) - ! - ! write mixing ratio for water vapor required to plot radio-soundings - ! - IF (LUSERV) THEN - CALL IO_Field_write(TPFILE,'RVT',XRT(:,:,:,IDX_RVT)) - END IF -END IF -! -!* Latitude and Longitude arrays -! -IF (.NOT.LCARTESIAN) THEN - CALL IO_Field_write(TPFILE,'LAT',XLAT) - CALL IO_Field_write(TPFILE,'LON',XLON) -END IF -! -! -!------------------------------------------------------------------------------- -! -!* 1.6 Other pronostic variables -! -ZTEMP(:,:,:)=XTHT(:,:,:)*(XPABST(:,:,:)/ XP00) **(XRD/XCPD) -! -IF (LVAR_TURB) THEN - IF (CTURB /= 'NONE') THEN - CALL IO_Field_write(TPFILE,'TKET',XTKET) - ! - IF( NRR > 1 ) THEN - CALL IO_Field_write(TPFILE,'SRCT',XSRCT) - CALL IO_Field_write(TPFILE,'SIGS',XSIGS) - END IF - ! - IF(CTOM=='TM06') THEN - CALL IO_Field_write(TPFILE,'BL_DEPTH',XBL_DEPTH) - END IF - END IF -END IF -! -!* Rains -! -IF (LVAR_PR .AND. LUSERR .AND. SIZE(XINPRR)>0 ) THEN - ! - ! explicit species - ! - CALL FIND_FIELD_ID_FROM_MNHNAME('INPRR',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm hour-1' - CALL IO_Field_write(TPFILE,TZFIELD,XINPRR*3.6E6) - ! - CALL IO_Field_write(TPFILE,'INPRR3D',XINPRR3D) - CALL IO_Field_write(TPFILE,'EVAP3D', XEVAP3D) - ! - CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRR',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm' - CALL IO_Field_write(TPFILE,TZFIELD,XACPRR*1.0E3) - ! - IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR.& - CCLOUD == 'KHKO' .OR. CCLOUD == 'LIMA') THEN - IF (SIZE(XINPRC) /= 0 ) THEN - CALL FIND_FIELD_ID_FROM_MNHNAME('INPRC',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm hour-1' - CALL IO_Field_write(TPFILE,TZFIELD,XINPRC*3.6E6) - ! - CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRC',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm' - CALL IO_Field_write(TPFILE,TZFIELD,XACPRC*1.0E3) - END IF - IF (SIZE(XINDEP) /= 0 ) THEN - CALL FIND_FIELD_ID_FROM_MNHNAME('INDEP',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm hour-1' - CALL IO_Field_write(TPFILE,TZFIELD,XINDEP*3.6E6) - ! - CALL FIND_FIELD_ID_FROM_MNHNAME('ACDEP',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm' - CALL IO_Field_write(TPFILE,TZFIELD,XACDEP*1.0E3) - END IF - END IF - IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'LIMA') THEN - CALL FIND_FIELD_ID_FROM_MNHNAME('INPRS',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm hour-1' - CALL IO_Field_write(TPFILE,TZFIELD,XINPRS*3.6E6) - ! - CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRS',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm' - CALL IO_Field_write(TPFILE,TZFIELD,XACPRS*1.0E3) - ! - CALL FIND_FIELD_ID_FROM_MNHNAME('INPRG',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm hour-1' - CALL IO_Field_write(TPFILE,TZFIELD,XINPRG*3.6E6) - ! - CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRG',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm' - CALL IO_Field_write(TPFILE,TZFIELD,XACPRG*1.0E3) - ! - IF (SIZE(XINPRH) /= 0 ) THEN - CALL FIND_FIELD_ID_FROM_MNHNAME('INPRH',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm hour-1' - CALL IO_Field_write(TPFILE,TZFIELD,XINPRH*3.6E6) - ! - CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRH',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm' - CALL IO_Field_write(TPFILE,TZFIELD,XACPRH*1.0E3) - ENDIF - ! - ZWORK21(:,:) = XINPRR(:,:) + XINPRS(:,:) + XINPRG(:,:) - IF (SIZE(XINPRC) /= 0 ) & - ZWORK21(:,:) = ZWORK21(:,:) + XINPRC(:,:) - IF (SIZE(XINPRH) /= 0 ) & - ZWORK21(:,:) = ZWORK21(:,:) + XINPRH(:,:) - CALL FIND_FIELD_ID_FROM_MNHNAME('INPRT',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm hour-1' - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21*3.6E6) - ! - ZWORK21(:,:) = XACPRR(:,:) + XACPRS(:,:) + XACPRG(:,:) - IF (SIZE(XINPRC) /= 0 ) & - ZWORK21(:,:) = ZWORK21(:,:) + XACPRC(:,:) - IF (SIZE(XINPRH) /= 0 ) & - ZWORK21(:,:) = ZWORK21(:,:) + XACPRH(:,:) - ! - CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRT',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm' - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21*1.0E3) - ! - END IF - ! - !* Convective rain - ! - IF (CDCONV /= 'NONE') THEN - CALL FIND_FIELD_ID_FROM_MNHNAME('PRCONV',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm hour-1' - CALL IO_Field_write(TPFILE,TZFIELD,XPRCONV*3.6E6) - ! - CALL FIND_FIELD_ID_FROM_MNHNAME('PACCONV',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm' - CALL IO_Field_write(TPFILE,TZFIELD,XPACCONV*1.0E3) - ! - CALL FIND_FIELD_ID_FROM_MNHNAME('PRSCONV',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm hour-1' - CALL IO_Field_write(TPFILE,TZFIELD,XPRSCONV*3.6E6) - END IF -END IF -IF (LVAR_PR ) THEN - !Precipitable water in kg/m**2 - ZWORK21(:,:) = 0. - ZWORK22(:,:) = 0. - ZWORK23(:,:) = 0. - ZWORK31(:,:,:) = DZF(XZZ(:,:,:)) - DO JK = IKB,IKE - !* Calcul de qtot - IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'LIMA') THEN - ZWORK23(IIB:IIE,IJB:IJE) = XRT(IIB:IIE,IJB:IJE,JK,1) + & - XRT(IIB:IIE,IJB:IJE,JK,2) + XRT(IIB:IIE,IJB:IJE,JK,3) + & - XRT(IIB:IIE,IJB:IJE,JK,4) + XRT(IIB:IIE,IJB:IJE,JK,5) + & - XRT(IIB:IIE,IJB:IJE,JK,6) - ELSE - ZWORK23(IIB:IIE,IJB:IJE) = XRT(IIB:IIE,IJB:IJE,JK,1) - ENDIF - !* Calcul de l'eau precipitable - ZWORK21(IIB:IIE,IJB:IJE)=XRHODREF(IIB:IIE,IJB:IJE,JK)* & - ZWORK23(IIB:IIE,IJB:IJE)* ZWORK31(IIB:IIE,IJB:IJE,JK) - !* Sum - ZWORK22(IIB:IIE,IJB:IJE) = ZWORK22(IIB:IIE,IJB:IJE)+ZWORK21(IIB:IIE,IJB:IJE) - ZWORK21(:,:) = 0. - ZWORK23(:,:) = 0. - END DO - !* Precipitable water in kg/m**2 - TZFIELD%CMNHNAME = 'PRECIP_WAT' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'PRECIP_WAT' - TZFIELD%CUNITS = 'kg m-2' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK22) -ENDIF -! -! -!* Flux d'humidité et d'hydrométéores -IF (LHU_FLX) THEN - ZWORK35(:,:,:) = XRHODREF(:,:,:) * XRT(:,:,:,1) - ZWORK31(:,:,:) = MXM(ZWORK35(:,:,:)) * XUT(:,:,:) - ZWORK32(:,:,:) = MYM(ZWORK35(:,:,:)) * XVT(:,:,:) - ZWORK35(:,:,:) = GX_U_M(ZWORK31,XDXX,XDZZ,XDZX) + GY_V_M(ZWORK32,XDYY,XDZZ,XDZY) - IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'LIMA') THEN - ZWORK36(:,:,:) = ZWORK35(:,:,:) + XRHODREF(:,:,:) * (XRT(:,:,:,2) + & - XRT(:,:,:,3) + XRT(:,:,:,4) + XRT(:,:,:,5) + XRT(:,:,:,6)) - ZWORK33(:,:,:) = MXM(ZWORK36(:,:,:)) * XUT(:,:,:) - ZWORK34(:,:,:) = MYM(ZWORK36(:,:,:)) * XVT(:,:,:) - ZWORK36(:,:,:) = GX_U_M(ZWORK33,XDXX,XDZZ,XDZX) + GY_V_M(ZWORK34,XDYY,XDZZ,XDZY) - ENDIF - ! - ! Integration sur 3000 m - ! - IKTOP(:,:)=0 - DO JK=1,IKU-1 - WHERE (((XZZ(:,:,JK) -XZS(:,:))<= 3000.0) .AND. ((XZZ(:,:,JK+1) -XZS(:,:))> 3000.0)) - IKTOP(:,:)=JK - END WHERE - END DO - ZDELTAZ(:,:,:)=DZF(XZZ) - ZWORK21(:,:) = 0. - ZWORK22(:,:) = 0. - ZWORK25(:,:) = 0. - DO JJ=1,IJU - DO JI=1,IIU - IAUX=IKTOP(JI,JJ) - DO JK=IKB,IAUX-1 - ZWORK21(JI,JJ) = ZWORK21(JI,JJ) + ZWORK31(JI,JJ,JK) * ZDELTAZ(JI,JJ,JK) - ZWORK22(JI,JJ) = ZWORK22(JI,JJ) + ZWORK32(JI,JJ,JK) * ZDELTAZ(JI,JJ,JK) - ZWORK25(JI,JJ) = ZWORK25(JI,JJ) + ZWORK35(JI,JJ,JK) * ZDELTAZ(JI,JJ,JK) - ENDDO - IF (IAUX >= IKB) THEN - ZDELTAZ(JI,JJ,IAUX)= 3000. - (XZZ(JI,JJ,IAUX) -XZS(JI,JJ)) - ZWORK21(JI,JJ) = ZWORK21(JI,JJ) + ZWORK31(JI,JJ,IAUX) * ZDELTAZ(JI,JJ,IAUX) - ZWORK22(JI,JJ) = ZWORK22(JI,JJ) + ZWORK32(JI,JJ,IAUX) * ZDELTAZ(JI,JJ,IAUX) - ZWORK25(JI,JJ) = ZWORK25(JI,JJ) + ZWORK35(JI,JJ,IAUX) * ZDELTAZ(JI,JJ,IAUX) - ENDIF - ENDDO - ENDDO - IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'LIMA') THEN - ZWORK23(:,:) = 0. - ZWORK24(:,:) = 0. - ZWORK26(:,:) = 0. - DO JJ=1,IJU - DO JI=1,IIU - IAUX=IKTOP(JI,JJ) - DO JK=IKB,IAUX-1 - ZWORK23(JI,JJ) = ZWORK23(JI,JJ) + ZWORK33(JI,JJ,JK) * ZDELTAZ(JI,JJ,JK) - ZWORK24(JI,JJ) = ZWORK24(JI,JJ) + ZWORK34(JI,JJ,JK) * ZDELTAZ(JI,JJ,JK) - ZWORK26(JI,JJ) = ZWORK26(JI,JJ) + ZWORK36(JI,JJ,JK) * ZDELTAZ(JI,JJ,JK) - ENDDO - IF (IAUX >= IKB) THEN - ZDELTAZ(JI,JJ,IAUX)= 3000. - (XZZ(JI,JJ,IAUX) -XZS(JI,JJ)) - ZWORK23(JI,JJ) = ZWORK23(JI,JJ) + ZWORK33(JI,JJ,IAUX) * ZDELTAZ(JI,JJ,IAUX) - ZWORK24(JI,JJ) = ZWORK24(JI,JJ) + ZWORK34(JI,JJ,IAUX) * ZDELTAZ(JI,JJ,IAUX) - ZWORK26(JI,JJ) = ZWORK26(JI,JJ) + ZWORK36(JI,JJ,IAUX) * ZDELTAZ(JI,JJ,IAUX) - ENDIF - ENDDO - ENDDO - ENDIF - ! Ecriture - ! composantes U et V du flux surfacique d'humidité - TZFIELD%CMNHNAME = 'UM90' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'UM90' - TZFIELD%CUNITS = 'kg s-1 m-2' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = '' - TZFIELD%NGRID = 2 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) - ! - TZFIELD%CMNHNAME = 'VM90' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'VM90' - TZFIELD%CUNITS = 'kg s-1 m-2' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = '' - TZFIELD%NGRID = 3 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK32) - ! composantes U et V du flux d'humidité intégré sur 3000 metres - TZFIELD%CMNHNAME = 'UM91' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'UM91' - TZFIELD%CUNITS = 'kg s-1 m-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = '' - TZFIELD%NGRID = 2 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21) - ! - TZFIELD%CMNHNAME = 'VM91' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'VM91' - TZFIELD%CUNITS = 'kg s-1 m-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = '' - TZFIELD%NGRID = 3 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK22) - ! - ! Convergence d'humidité - TZFIELD%CMNHNAME = 'HMCONV' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'HMCONV' - TZFIELD%CUNITS = 'kg s-1 m-3' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Horizontal CONVergence of moisture flux' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,-ZWORK35) - ! - ! Convergence d'humidité intégré sur 3000 mètres - TZFIELD%CMNHNAME = 'HMCONV3000' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'HMCONV3000' - TZFIELD%CUNITS = 'kg s-1 m-3' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Horizontal CONVergence of moisture flux' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,-ZWORK25) - ! - IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'LIMA') THEN - ! composantes U et V du flux surfacique d'hydrométéores - TZFIELD%CMNHNAME = 'UM92' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'UM92' - TZFIELD%CUNITS = 'kg s-1 m-2' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = '' - TZFIELD%NGRID = 2 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33) - ! - TZFIELD%CMNHNAME = 'VM92' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'VM92' - TZFIELD%CUNITS = 'kg s-1 m-2' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = '' - TZFIELD%NGRID = 3 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK34) - ! composantes U et V du flux d'hydrométéores intégré sur 3000 metres - TZFIELD%CMNHNAME = 'UM93' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'UM93' - TZFIELD%CUNITS = 'kg s-1 m-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = '' - TZFIELD%NGRID = 2 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK23) - ! - TZFIELD%CMNHNAME = 'VM93' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'VM93' - TZFIELD%CUNITS = 'kg s-1 m-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = '' - TZFIELD%NGRID = 3 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK24) - ! Convergence d'hydrométéores - TZFIELD%CMNHNAME = 'HMCONV_TT' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'HMCONV_TT' - TZFIELD%CUNITS = 'kg s-1 m-3' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Horizontal CONVergence of hydrometeor flux' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,-ZWORK36) - ! Convergence d'hydrométéores intégré sur 3000 mètres - TZFIELD%CMNHNAME = 'HMCONV3000_TT' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'HMCONV3000_TT' - TZFIELD%CUNITS = 'kg s-1 m-3' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Horizontal CONVergence of hydrometeor flux' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,-ZWORK26) - ENDIF -ENDIF -! -!* Moist variables -! -IF (LVAR_MRW .OR. LLIMA_DIAG) THEN - IF (NRR >=1) THEN - ! Moist variables are written individually in file - TZFIELD%CSTDNAME = '' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - IF (LUSERV) THEN - TZFIELD%CMNHNAME = 'MRV' - TZFIELD%CLONGNAME = 'MRV' - TZFIELD%CUNITS = 'g kg-1' - TZFIELD%CCOMMENT = 'X_Y_Z_MRV' - CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RVT)*1.E3) - END IF - IF (LUSERC) THEN - TZFIELD%CMNHNAME = 'MRC' - TZFIELD%CLONGNAME = 'MRC' - TZFIELD%CUNITS = 'g kg-1' - TZFIELD%CCOMMENT = 'X_Y_Z_MRC' - CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RCT)*1.E3) -! - TZFIELD%CMNHNAME = 'VRC' - TZFIELD%CLONGNAME = 'VRC' - TZFIELD%CUNITS = '1' !vol/vol - TZFIELD%CCOMMENT = 'X_Y_Z_VRC (vol/vol)' - CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RCT)*XRHODREF(:,:,:)/1.E3) - END IF - IF (LUSERR) THEN - TZFIELD%CMNHNAME = 'MRR' - TZFIELD%CLONGNAME = 'MRR' - TZFIELD%CUNITS = 'g kg-1' - TZFIELD%CCOMMENT = 'X_Y_Z_MRR' - CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RRT)*1.E3) -! - TZFIELD%CMNHNAME = 'VRR' - TZFIELD%CLONGNAME = 'VRR' - TZFIELD%CUNITS = '1' !vol/vol - TZFIELD%CCOMMENT = 'X_Y_Z_VRR (vol/vol)' - CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RRT)*XRHODREF(:,:,:)/1.E3) - END IF - IF (LUSERI) THEN - TZFIELD%CMNHNAME = 'MRI' - TZFIELD%CLONGNAME = 'MRI' - TZFIELD%CUNITS = 'g kg-1' - TZFIELD%CCOMMENT = 'X_Y_Z_MRI' - CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RIT)*1.E3) -! - IF (LUSECI) THEN - CALL IO_Field_write(TPFILE,'CIT',XCIT(:,:,:)) - END IF - END IF - IF (LUSERS) THEN - TZFIELD%CMNHNAME = 'MRS' - TZFIELD%CLONGNAME = 'MRS' - TZFIELD%CUNITS = 'g kg-1' - TZFIELD%CCOMMENT = 'X_Y_Z_MRS' - CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RST)*1.E3) - END IF - IF (LUSERG) THEN - TZFIELD%CMNHNAME = 'MRG' - TZFIELD%CLONGNAME = 'MRG' - TZFIELD%CUNITS = 'g kg-1' - TZFIELD%CCOMMENT = 'X_Y_Z_MRG' - CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RGT)*1.E3) - END IF - IF (LUSERH) THEN - TZFIELD%CMNHNAME = 'MRH' - TZFIELD%CLONGNAME = 'MRH' - TZFIELD%CUNITS = 'g kg-1' - TZFIELD%CCOMMENT = 'X_Y_Z_MRH' - CALL IO_Field_write(TPFILE,TZFIELD,XRT(:,:,:,IDX_RHT)*1.E3) - END IF - END IF -END IF -! -!* Scalar Variables -! -! User scalar variables -! individually in the file -IF (LVAR_MRSV) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'g kg-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = 1,NSV_USER - WRITE(TZFIELD%CMNHNAME,'(A4,I3.3)')'MRSV',JSV - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','MRSV',JSV - CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E3) - END DO -END IF -! microphysical C2R2 scheme scalar variables -IF(LVAR_MRW) THEN - IF (NSV_C2R2END>=NSV_C2R2BEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_C2R2BEG,NSV_C2R2END - TZFIELD%CMNHNAME = TRIM(C2R2NAMES(JSV-NSV_C2R2BEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - IF (JSV < NSV_C2R2END) THEN - TZFIELD%CUNITS = 'cm-3' - ZWORK31(:,:,:)=XSVT(:,:,:,JSV)*1.E-6 - ELSE - TZFIELD%CUNITS = 'l-1' - ZWORK31(:,:,:)=XSVT(:,:,:,JSV)*1.E-3 - END IF - WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','MRSV',JSV - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) - END DO - END IF - ! microphysical C3R5 scheme additional scalar variables - IF (NSV_C1R3END>=NSV_C1R3BEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'l-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_C1R3BEG,NSV_C1R3END - TZFIELD%CMNHNAME = TRIM(C1R3NAMES(JSV-NSV_C1R3BEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E-3) - END DO - END IF -END IF -! -! microphysical LIMA scheme scalar variables -! -IF (LLIMA_DIAG) THEN - IF (NSV_LIMA_END>=NSV_LIMA_BEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - END IF - ! - DO JSV = NSV_LIMA_BEG,NSV_LIMA_END - ! - TZFIELD%CUNITS = 'cm-3' - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - ! -! Nc - IF (JSV .EQ. NSV_LIMA_NC) THEN - TZFIELD%CMNHNAME = TRIM(CLIMA_WARM_CONC(1))//'T' - END IF -! Nr - IF (JSV .EQ. NSV_LIMA_NR) THEN - TZFIELD%CMNHNAME = TRIM(CLIMA_WARM_CONC(2))//'T' - END IF -! N CCN free - IF (JSV .GE. NSV_LIMA_CCN_FREE .AND. JSV .LT. NSV_LIMA_CCN_ACTI) THEN - WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_CCN_FREE + 1) - TZFIELD%CMNHNAME = TRIM(CLIMA_WARM_CONC(3))//INDICE//'T' - END IF -! N CCN acti - IF (JSV .GE. NSV_LIMA_CCN_ACTI .AND. JSV .LT. NSV_LIMA_CCN_ACTI + NMOD_CCN) THEN - WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_CCN_ACTI + 1) - TZFIELD%CMNHNAME = TRIM(CLIMA_WARM_CONC(4))//INDICE//'T' - END IF -! Scavenging - IF (JSV .EQ. NSV_LIMA_SCAVMASS) THEN - TZFIELD%CMNHNAME = TRIM(CAERO_MASS(1))//'T' - TZFIELD%CUNITS = 'kg cm-3' - END IF -! Ni - IF (JSV .EQ. NSV_LIMA_NI) THEN - TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_CONC(1))//'T' - END IF -! N IFN free - IF (JSV .GE. NSV_LIMA_IFN_FREE .AND. JSV .LT. NSV_LIMA_IFN_NUCL) THEN - WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_IFN_FREE + 1) - TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_CONC(2))//INDICE//'T' - END IF -! N IFN nucl - IF (JSV .GE. NSV_LIMA_IFN_NUCL .AND. JSV .LT. NSV_LIMA_IFN_NUCL + NMOD_IFN) THEN - WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_IFN_NUCL + 1) - TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_CONC(3))//INDICE//'T' - END IF -! N IMM nucl - IF (JSV .GE. NSV_LIMA_IMM_NUCL .AND. JSV .LT. NSV_LIMA_IMM_NUCL + NMOD_IMM) THEN - WRITE(INDICE,'(I2.2)')(NINDICE_CCN_IMM(JSV - NSV_LIMA_IMM_NUCL + 1)) - TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_CONC(4))//INDICE//'T' - END IF -! Hom. freez. of CCN - IF (JSV .EQ. NSV_LIMA_HOM_HAZE) THEN - TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_CONC(5))//'T' - END IF - ! -! Supersaturation - IF (JSV .EQ. NSV_LIMA_SPRO) THEN - TZFIELD%CMNHNAME = TRIM(CLIMA_WARM_CONC(5))//'T' - END IF - ! - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - ZWORK31(:,:,:)=XSVT(:,:,:,JSV)*1.E-6*XRHODREF(:,:,:) - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) - END DO -! - IF (LUSERC) THEN - TZFIELD%CMNHNAME = 'LWC' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'LWC' - TZFIELD%CUNITS = 'g m-3' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_LWC' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ZWORK31(:,:,:)=XRT(:,:,:,2)*1.E3*XRHODREF(:,:,:) - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) - END IF -! - IF (LUSERI) THEN - TZFIELD%CMNHNAME = 'IWC' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'IWC' - TZFIELD%CUNITS = 'g m-3' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_MRI' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ZWORK31(:,:,:)=XRT(:,:,:,4)*1.E3*XRHODREF(:,:,:) - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) - END IF -! -END IF -! -! chemical scalar variables in gas phase ppbv -IF (LCHEMDIAG) THEN - DO JSV = NSV_CHGSBEG,NSV_CHGSEND - TZFIELD%CMNHNAME = TRIM(UPCASE(CNAMES(JSV-NSV_CHGSBEG+1)))//'T' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'ppbv' - TZFIELD%CDIR = 'XY' - WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','CHIM',JSV - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E9) - END DO -END IF -IF (LCHAQDIAG) THEN !aqueous concentration in M - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'M' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - ZWORK31(:,:,:)=0. - DO JSV = NSV_CHACBEG, NSV_CHACBEG-1+NEQAQ/2 !cloud water - TZFIELD%CMNHNAME = TRIM(CNAMES(JSV-NSV_CHACBEG+NSV_CHGS+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','CHAQ',JSV - WHERE(((XRT(:,:,:,2)*XRHODREF(:,:,:))/1.e3) .GE. XRTMIN_AQ) - ZWORK31(:,:,:)=(XSVT(:,:,:,JSV)*1000.)/(XMD*1.E+3*XRT(:,:,:,2)) - ENDWHERE - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) - END DO - ! - ZWORK31(:,:,:)=0. - DO JSV = NSV_CHACBEG+NEQAQ/2, NSV_CHACEND !rain water - TZFIELD%CMNHNAME = TRIM(CNAMES(JSV-NSV_CHACBEG+NSV_CHGS+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','CHAQ',JSV - WHERE(((XRT(:,:,:,3)*XRHODREF(:,:,:))/1.e3) .GE. XRTMIN_AQ) - ZWORK31(:,:,:)=(XSVT(:,:,:,JSV)*1000.)/(XMD*1.E+3*XRT(:,:,:,3)) - ENDWHERE - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) - END DO -! ZWORK31(:,:,:)=0. -! DO JSV = NSV_CHICBEG,NSV_CHICEND ! ice phase -! TZFIELD%CMNHNAME = TRIM(CICNAMES(JSV-NSV_CHICBEG+1))//'T' -! TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) -! WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3,A4)')'X_Y_Z_','CHIC',JSV,' (M)' -! WHERE(((XRT(:,:,:,3)*XRHODREF(:,:,:))/1.e3) .GE. XRTMIN_AQ) -! ZWORK31(:,:,:)=(XSVT(:,:,:,JSV)*1000.)/(XMD*1.E+3*XRT(:,:,:,3)) -! ENDWHERE -! CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) -! END DO -END IF - -! Passive polluant scalar variables -IF (LPASPOL) THEN - ALLOCATE(ZRHOT( SIZE(XTHT,1), SIZE(XTHT,2),SIZE(XTHT,3))) - ALLOCATE(ZTMP( SIZE(XTHT,1), SIZE(XTHT,2),SIZE(XTHT,3))) -! -!* Density -! - ZRHOT(:,:,:)=XPABST(:,:,:)/(XRD*XTHT(:,:,:)*((XPABST(:,:,:)/XP00)**(XRD/XCPD))) -! -!* Conversion g/m3. -! - ZRHOT(:,:,:)=ZRHOT(:,:,:)*1000.0 - ! - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'g m-3' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = 1,NSV_PP - ZTMP(:,:,:)=ABS( XSVT(:,:,:,JSV+NSV_PPBEG-1)*ZRHOT(:,:,:) ) - WRITE(TZFIELD%CMNHNAME,'(A3,I3.3)')'PPT',JSV - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME) - CALL IO_Field_write(TPFILE,TZFIELD,ZTMP) - END DO - DEALLOCATE(ZTMP) - DEALLOCATE(ZRHOT) -END IF -! Conditional sampling variables -IF (LCONDSAMP) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = '1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_CSBEG,NSV_CSEND - WRITE(TZFIELD%CMNHNAME,'(A3,I3.3)')'CST',JSV - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME) - CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)) - END DO -END IF -! -! Blowing snow variables -! -IF(LBLOWSNOW) THEN - TZFIELD%CMNHNAME = 'SNWSUBL3D' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'kg m-3 s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_INstantaneous 3D Drifting snow sublimation flux' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,XSNWSUBL3D(:,:,:)) - ! - ZWORK21(:,:) = 0. - DO JK = IKB,IKE - ZWORK21(:,:) = ZWORK21(:,:)+XSNWSUBL3D(:,:,JK) * & - (XZZ(:,:,JK+1)-XZZ(:,:,JK))/XRHOLW*3600*24 - END DO - ZWORK21(:,:) = ZWORK21(:,:)*1000. ! vapor water in mm unit - ! - TZFIELD%CMNHNAME = 'COL_SNWSUBL' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'mm day-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Column Sublimation Rate (mmSWE/day)' - TZFIELD%NGRID = 4 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21(:,:)) - ! - IF(.NOT.ALLOCATED(ZBET_SNW)) & - ALLOCATE(ZBET_SNW(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3))) - IF(.NOT.ALLOCATED(ZRG_SNW)) & - ALLOCATE(ZRG_SNW(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3))) - IF(.NOT.ALLOCATED(ZMA_SNW)) & - ALLOCATE(ZMA_SNW(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3),NBLOWSNOW3D)) - ! - CALL PPP2SNOW(XSVT(:,:,:,NSV_SNWBEG:NSV_SNWEND),XRHODREF,& - PBET3D=ZBET_SNW, PRG3D=ZRG_SNW, PM3D=ZMA_SNW) - ! - TZFIELD%CMNHNAME = 'SNWRGA' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'm' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'RG (mean) SNOW' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZRG_SNW(:,:,:)) - ! - TZFIELD%CMNHNAME = 'SNWBETA' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'm' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'BETA SNOW' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZBET_SNW(:,:,:)) - ! - TZFIELD%CMNHNAME = 'SNWNOA' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'm-3' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'NUM CONC SNOW (#/m3)' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZMA_SNW(:,:,:,1)) - ! - TZFIELD%CMNHNAME = 'SNWMASS' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'kg m-3' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'MASS CONC SNOW' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZMA_SNW(:,:,:,2)) - ! - ZWORK21(:,:) = 0. - DO JK = IKB,IKE - ZWORK21(:,:) = ZWORK21(:,:)+ZMA_SNW(:,:,JK,2) * & - (XZZ(:,:,JK+1)-XZZ(:,:,JK))/XRHOLW - END DO - ZWORK21(:,:) = ZWORK21(:,:)*1000. ! vapor water in mm unit - TZFIELD%CMNHNAME = 'THDS' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'mm' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_THickness of Drifting Snow (mm SWE)' - TZFIELD%NGRID = 4 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21(:,:)) -END IF -! Lagrangian variables -IF (LTRAJ) THEN - TZFIELD%CSTDNAME = '' - !PW TODO: check units - TZFIELD%CUNITS = '' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_LGBEG,NSV_LGEND - TZFIELD%CMNHNAME = TRIM(CLGNAMES(JSV-NSV_LGBEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A20,I3.3,A4)')'X_Y_Z_','Lagrangian variable ',JSV,' (M)' - CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)) - END DO - ! X coordinate - DO JK=1,IKU - DO JJ=1,IJU - DO JI=1,IIU-1 - ZWORK31(JI,JJ,JK)=0.5*(XXHAT(JI)+XXHAT(JI+1)) - END DO - ZWORK31(IIU,JJ,JK)=2.*ZWORK31(IIU-1,JJ,JK) - ZWORK31(IIU-2,JJ,JK) - END DO - END DO - TZFIELD%CMNHNAME = 'X' - TZFIELD%CLONGNAME = 'X' - TZFIELD%CCOMMENT = 'X_Y_Z_X coordinate' - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) - ! Y coordinate - DO JK=1,IKU - DO JI=1,IIU - DO JJ=1,IJU-1 - ZWORK31(JI,JJ,JK)=0.5*(XYHAT(JJ)+XYHAT(JJ+1)) - END DO - ZWORK31(JI,IJU,JK)=2.*ZWORK31(JI,IJU-1,JK) - ZWORK31(JI,IJU-2,JK) - END DO - END DO - TZFIELD%CMNHNAME = 'Y' - TZFIELD%CLONGNAME = 'Y' - TZFIELD%CCOMMENT = 'X_Y_Z_Y coordinate' - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) -END IF -! linox scalar variables -IF (.NOT.(LUSECHEM .OR. LCHEMDIAG) .AND. LCH_CONV_LINOX) THEN - DO JSV = NSV_LNOXBEG,NSV_LNOXEND - TZFIELD%CMNHNAME = 'LINOXT' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'ppbv' - TZFIELD%CDIR = 'XY' - WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','LNOX',JSV - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E9) - END DO -END IF -IF (LELECDIAG .AND. CELEC .NE. "NONE") THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_ELECBEG,NSV_ELECEND - TZFIELD%CMNHNAME = TRIM(CELECNAMES(JSV-NSV_ELECBEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - IF (JSV .GT. NSV_ELECBEG .AND. JSV .LT. NSV_ELECEND) THEN - TZFIELD%CUNITS = 'C m-3' - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - ELSE - TZFIELD%CUNITS = 'm-3' - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3,A8)')'X_Y_Z_','SVT',JSV,' (nb ions/m3)' - END IF - ZWORK31(:,:,:)=XSVT(:,:,:,JSV) * XRHODREF(:,:,:) ! C/kg --> C/m3 - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) - END DO -END IF -! Sea Salt variables -IF (LSALT) THEN - IF(.NOT.ALLOCATED(ZSIG_SLT)) & - ALLOCATE(ZSIG_SLT(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3), NMODE_SLT)) - IF(.NOT.ALLOCATED(ZRG_SLT)) & - ALLOCATE(ZRG_SLT(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3), NMODE_SLT)) - IF(.NOT.ALLOCATED(ZN0_SLT)) & - ALLOCATE(ZN0_SLT(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3), NMODE_SLT)) - ! - TZFIELD%CSTDNAME = '' - TZFIELD%CDIR = 'XY' - TZFIELD%CUNITS = 'ppbv' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_SLTBEG,NSV_SLTEND - TZFIELD%CMNHNAME = TRIM(UPCASE(CSALTNAMES(JSV-NSV_SLTBEG+1)))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','SALT',JSV - CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E9) - END DO - ! - CALL PPP2SALT(XSVT(:,:,:,NSV_SLTBEG:NSV_SLTEND),XRHODREF,& - PSIG3D=ZSIG_SLT, PRG3D=ZRG_SLT, PN3D=ZN0_SLT) - ! - TZFIELD%CSTDNAME = '' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JJ=1,NMODE_SLT - WRITE(TZFIELD%CMNHNAME,'(A6,I1)')'SLTRGA',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'um' - WRITE(TZFIELD%CCOMMENT,'(A18,I1)')'RG (nb) SALT MODE ',JJ - CALL IO_Field_write(TPFILE,TZFIELD,ZRG_SLT(:,:,:,JJ)) - ! - WRITE(TZFIELD%CMNHNAME,'(A7,I1)')'SLTRGAM',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'um' - WRITE(TZFIELD%CCOMMENT,'(A17,I1)')'RG (m) SALT MODE ',JJ - ZWORK31(:,:,:)=ZRG_SLT(:,:,:,JJ) / (EXP(-3.*(LOG(ZSIG_SLT(:,:,:,JJ)))**2)) - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) - ! - WRITE(TZFIELD%CMNHNAME,'(A6,I1)')'SLTN0A',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'm-3' - WRITE(TZFIELD%CCOMMENT,'(A13,I1)')'N0 SALT MODE ',JJ - CALL IO_Field_write(TPFILE,TZFIELD,ZN0_SLT(:,:,:,JJ)) - ! - WRITE(TZFIELD%CMNHNAME,'(A7,I1)')'SLTSIGA',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = '1' - WRITE(TZFIELD%CCOMMENT,'(A16,I1)')'SIGMA SALT MODE ',JJ - CALL IO_Field_write(TPFILE,TZFIELD,ZSIG_SLT(:,:,:,JJ)) - !SALT MASS CONCENTRATION - WRITE(TZFIELD%CMNHNAME,'(A4,I1)')'SLTMSS',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'ug m-3' - WRITE(TZFIELD%CCOMMENT,'(A14,I1)')'MASSCONC MODE ',JJ - ZWORK31(:,:,:)= ZN0_SLT(:,:,:,JJ)*4./3.*3.14*2500.*1e9 & !kg-->ug - * (ZRG_SLT(:,:,:,JJ)**3)*1.d-18 & !um-->m - * exp(4.5*log(ZSIG_SLT(:,:,:,JJ))*log(ZSIG_SLT(:,:,:,JJ))) - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) - !SALT BURDEN (g/m2) - ZWORK21(:,:)=0.0 - DO JK=IKB,IKE - ZWORK31(:,:,JK) = ZWORK31(:,:,JK) *(XZZ(:,:,JK+1)-XZZ(:,:,JK)) & - *1.d-6 ! Convert to ug/m2-->g/m2 in each layer - END DO - DO JK=IKB,IKE - DO JT=IJB,IJE - DO JI=IIB,IIE - ZWORK21(JI,JT)=ZWORK21(JI,JT)+ZWORK31(JI,JT,JK) - ENDDO - ENDDO - ENDDO - WRITE(TZFIELD%CMNHNAME,'(A7,I1)')'SLTBRDN',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'g m-2' - WRITE(TZFIELD%CCOMMENT,'(A6,I1)')'BURDEN',JJ - TZFIELD%NDIMS = 2 - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21) - ! - TZFIELD%NDIMS = 3 - ENDDO -END IF -IF (LSALT.AND.LDEPOS_SLT(IMI)) THEN - ! - ZSSLTDEP=XSVT(:,:,:,NSV_SLTDEPBEG:NSV_SLTDEPEND) - ! - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppbv' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = 1,NSV_SLTDEP - TZFIELD%CMNHNAME = TRIM(UPCASE(CDESLTNAMES(JSV)))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','SALTDEP',JSV - CALL IO_Field_write(TPFILE,TZFIELD,ZSSLTDEP(:,:,:,JSV)*1.E9) - END DO - ! - DO JJ=1,NMODE_SLT - ! FOR CLOUDS - WRITE(TZFIELD%CMNHNAME,'(A9,I1)')'SLTDEPN0A',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A16,I1)')'N0 DUSTDEP MODE ',JJ - TZFIELD%CUNITS = 'm-3' - ! CLOUD: CALCULATE MOMENT 3 FROM TOTAL AEROSOL MASS - ZWORK31(:,:,:) = ZSSLTDEP(:,:,:,JJ) &!==>molec_{aer}/molec_{air} - *(XMOLARWEIGHT_DUST/XMD) &!==>kg_{aer}/kg_{air} - *XRHODREF(:,:,:) &!==>kg_{aer}/m3_{air} - /XDENSITY_DUST &!==>m3_{aer}/m3_{air} - *XM3TOUM3 &!==>um3_{aer}/m3_{air} - /(XPI*4./3.) !==>um3_{aer}/m3_{air} - !==>volume 3rd moment - !CLOUD: CALCULATE MOMENT 0 FROM DISPERSION AND MEAN RADIUS - ZWORK31(:,:,:) = ZWORK31(:,:,:)/ & - ((ZRG_SLT(:,:,:,JJ)**3)* & - EXP(4.5 * LOG(ZSIG_SLT(:,:,:,JJ))**2)) - !CLOUD: RETURN TO CONCENTRATION #/m3 - ZWORK31(:,:,:)= ZWORK31(:,:,:) * XMD/ & - (XAVOGADRO*XRHODREF(:,:,:)) - !CLOUD: Get number concentration (#/molec_{air}==>#/m3) - ZWORK31(:,:,:)= & - ZWORK31(:,:,:) & !#/molec_{air} - * XAVOGADRO & !==>#/mole - / XMD & !==>#/kg_{air} - * XRHODREF(:,:,:) !==>#/m3 - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) - ! CLOUD: DUST MASS CONCENTRATION - WRITE(TZFIELD%CMNHNAME,'(A9,I1)')'SLTDEPMSS',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A17,I1)')'DEPMASSCONC MODE ',JJ - TZFIELD%CUNITS = 'ug m-3' - ZWORK31(:,:,:)= ZWORK31(:,:,:)*4./3.*3.14*2500.*1e9 & !kg-->ug - * (ZRG_SLT(:,:,:,JJ)**3)*1.d-18 & !um-->m - * exp(4.5*log(ZSIG_SLT(:,:,:,JJ))*log(ZSIG_SLT(:,:,:,JJ))) - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) - ! FOR RAIN DROPS - WRITE(TZFIELD%CMNHNAME,'(A9,I1)')'SLTDEPN0A',JJ+NMODE_SLT - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A16,I1)')'N0 DUSTDEP MODE ',JJ+NMODE_SLT - TZFIELD%CUNITS = 'm-3' - ! RAIN: CALCULATE MOMENT 3 FROM TOTAL AEROSOL MASS - ZWORK31(:,:,:) = ZSSLTDEP(:,:,:,JJ+NMODE_SLT) &!==>molec_{aer}/molec_{air} - *(XMOLARWEIGHT_DUST/XMD) &!==>kg_{aer}/kg_{air} - *XRHODREF(:,:,:) &!==>kg_{aer}/m3_{air} - /XDENSITY_DUST &!==>m3_{aer}/m3_{air} - *XM3TOUM3 &!==>um3_{aer}/m3_{air} - /(XPI*4./3.) !==>um3_{aer}/m3_{air} - !==>volume 3rd moment - !RAIN: CALCULATE MOMENT 0 FROM DISPERSION AND MEAN RADIUS - ZWORK31(:,:,:)= ZWORK31(:,:,:)/ & - ((ZRG_SLT(:,:,:,JJ)**3)* & - EXP(4.5 * LOG(ZSIG_SLT(:,:,:,JJ))**2)) - !RAIN: RETURN TO CONCENTRATION #/m3 - ZWORK31(:,:,:)= ZWORK31(:,:,:) * XMD/ & - (XAVOGADRO*XRHODREF(:,:,:)) - !RAIN: Get number concentration (#/molec_{air}==>#/m3) - ZWORK31(:,:,:)= & - ZWORK31(:,:,:) & !#/molec_{air} - * XAVOGADRO & !==>#/mole - / XMD & !==>#/kg_{air} - * XRHODREF(:,:,:) !==>#/m3 - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) - ! RAIN: DUST MASS CONCENTRATION - WRITE(TZFIELD%CMNHNAME,'(A9,I1)')'SLTDEPMSS',JJ+NMODE_SLT - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A17,I1)')'DEPMASSCONC MODE ',JJ+NMODE_SLT - TZFIELD%CUNITS = 'ug m-3' - ZWORK31(:,:,:)= ZWORK31(:,:,:)*4./3.*3.14*2500.*1e9 & !kg-->ug - * (ZRG_SLT(:,:,:,JJ)**3)*1.d-18 & !um-->m - * exp(4.5*log(ZSIG_SLT(:,:,:,JJ))*log(ZSIG_SLT(:,:,:,JJ))) - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) - END DO -! -END IF -! Dust variables -IF (LDUST) THEN - IF(.NOT.ALLOCATED(ZSIG_DST)) & - ALLOCATE(ZSIG_DST(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3), NMODE_DST)) - IF(.NOT.ALLOCATED(ZRG_DST)) & - ALLOCATE(ZRG_DST(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3), NMODE_DST)) - IF(.NOT.ALLOCATED(ZN0_DST)) & - ALLOCATE(ZN0_DST(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3), NMODE_DST)) - ! - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppbv' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_DSTBEG,NSV_DSTEND - TZFIELD%CMNHNAME = TRIM(UPCASE(CDUSTNAMES(JSV-NSV_DSTBEG+1)))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','DUST',JSV - CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E9) - END DO - ! - CALL PPP2DUST(XSVT(:,:,:,NSV_DSTBEG:NSV_DSTEND),XRHODREF,& - PSIG3D=ZSIG_DST, PRG3D=ZRG_DST, PN3D=ZN0_DST) - DO JJ=1,NMODE_DST - WRITE(TZFIELD%CMNHNAME,'(A6,I1)')'DSTRGA',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'um' - WRITE(TZFIELD%CCOMMENT,'(A18,I1)')'RG (nb) DUST MODE ',JJ - CALL IO_Field_write(TPFILE,TZFIELD,ZRG_DST(:,:,:,JJ)) - ! - WRITE(TZFIELD%CMNHNAME,'(A7,I1)')'DSTRGAM',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'um' - WRITE(TZFIELD%CCOMMENT,'(A17,I1)')'RG (m) DUST MODE ',JJ - ZWORK31(:,:,:)=ZRG_DST(:,:,:,JJ) / (EXP(-3.*(LOG(ZSIG_DST(:,:,:,JJ)))**2)) - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) - ! - WRITE(TZFIELD%CMNHNAME,'(A6,I1)')'DSTN0A',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'm-3' - WRITE(TZFIELD%CCOMMENT,'(A13,I1)')'N0 DUST MODE ',JJ - CALL IO_Field_write(TPFILE,TZFIELD,ZN0_DST(:,:,:,JJ)) - ! - WRITE(TZFIELD%CMNHNAME,'(A7,I1)')'DSTSIGA',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = '1' - WRITE(TZFIELD%CCOMMENT,'(A16,I1)')'SIGMA DUST MODE ',JJ - CALL IO_Field_write(TPFILE,TZFIELD,ZSIG_DST(:,:,:,JJ)) - !DUST MASS CONCENTRATION - WRITE(TZFIELD%CMNHNAME,'(A4,I1)')'DSTMSS',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'ug m-3' - WRITE(TZFIELD%CCOMMENT,'(A14,I1)')'MASSCONC MODE ',JJ - ZWORK31(:,:,:)= ZN0_DST(:,:,:,JJ)*4./3.*3.14*2500.*1e9 & !kg-->ug - * (ZRG_DST(:,:,:,JJ)**3)*1.d-18 & !um-->m - * exp(4.5*log(ZSIG_DST(:,:,:,JJ))*log(ZSIG_DST(:,:,:,JJ))) - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) - !DUST BURDEN (g/m2) - ZWORK21(:,:)=0.0 - DO JK=IKB,IKE - ZWORK31(:,:,JK) = ZWORK31(:,:,JK) *(XZZ(:,:,JK+1)-XZZ(:,:,JK)) & - *1.d-6 ! Convert to ug/m2-->g/m2 in each layer - END DO - DO JK=IKB,IKE - DO JT=IJB,IJE - DO JI=IIB,IIE - ZWORK21(JI,JT)=ZWORK21(JI,JT)+ZWORK31(JI,JT,JK) - ENDDO - ENDDO - ENDDO - WRITE(TZFIELD%CMNHNAME,'(A7,I1)')'DSTBRDN',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'g m-2' - WRITE(TZFIELD%CCOMMENT,'(A6,I1)')'BURDEN',JJ - TZFIELD%NDIMS = 2 - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21) - ! - TZFIELD%NDIMS = 3 - ENDDO -END IF -IF (LDUST.AND.LDEPOS_DST(IMI)) THEN - ! - ZSDSTDEP=XSVT(:,:,:,NSV_DSTDEPBEG:NSV_DSTDEPEND) - ! - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppbv' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = 1,NSV_DSTDEP - TZFIELD%CMNHNAME = TRIM(UPCASE(CDEDSTNAMES(JSV)))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','DUSTDEP',JSV - CALL IO_Field_write(TPFILE,TZFIELD,ZSDSTDEP(:,:,:,JSV)*1.E9) - END DO - ! - DO JJ=1,NMODE_DST - ! FOR CLOUDS - WRITE(TZFIELD%CMNHNAME,'(A9,I1)')'DSTDEPN0A',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A16,I1)')'N0 DUSTDEP MODE ',JJ - TZFIELD%CUNITS = 'm-3' - ! CLOUD: CALCULATE MOMENT 3 FROM TOTAL AEROSOL MASS - ZWORK31(:,:,:) = ZSDSTDEP(:,:,:,JJ) &!==>molec_{aer}/molec_{air} - *(XMOLARWEIGHT_DUST/XMD) &!==>kg_{aer}/kg_{air} - *XRHODREF(:,:,:) &!==>kg_{aer}/m3_{air} - /XDENSITY_DUST &!==>m3_{aer}/m3_{air} - *XM3TOUM3 &!==>um3_{aer}/m3_{air} - /(XPI*4./3.) !==>um3_{aer}/m3_{air} - !==>volume 3rd moment - !CLOUD: CALCULATE MOMENT 0 FROM DISPERSION AND MEAN RADIUS - ZWORK31(:,:,:)= ZWORK31(:,:,:)/ & - ((ZRG_DST(:,:,:,JJ)**3)* & - EXP(4.5 * LOG(ZSIG_DST(:,:,:,JJ))**2)) - !CLOUD: RETURN TO CONCENTRATION #/m3 - ZWORK31(:,:,:)= ZWORK31(:,:,:) * XMD/ & - (XAVOGADRO*XRHODREF(:,:,:)) - !CLOUD: Get number concentration (#/molec_{air}==>#/m3) - ZWORK31(:,:,:)= & - ZWORK31(:,:,:) & !#/molec_{air} - * XAVOGADRO & !==>#/mole - / XMD & !==>#/kg_{air} - * XRHODREF(:,:,:) !==>#/m3 - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) - ! CLOUD: DUST MASS CONCENTRATION - WRITE(TZFIELD%CMNHNAME,'(A9,I1)')'DSTDEPMSS',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A17,I1)')'DEPMASSCONC MODE ',JJ - TZFIELD%CUNITS = 'ug m-3' - ZWORK31(:,:,:)= ZWORK31(:,:,:)*4./3.*3.14*2500.*1e9 & !kg-->ug - * (ZRG_DST(:,:,:,JJ)**3)*1.d-18 & !um-->m - * exp(4.5*log(ZSIG_DST(:,:,:,JJ))*log(ZSIG_DST(:,:,:,JJ))) - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) - ! FOR RAIN DROPS - WRITE(TZFIELD%CMNHNAME,'(A9,I1)')'DSTDEPN0A',JJ+NMODE_DST - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A16,I1)')'N0 DUSTDEP MODE ',JJ+NMODE_DST - TZFIELD%CUNITS = 'm-3' - ! RAIN: CALCULATE MOMENT 3 FROM TOTAL AEROSOL MASS - ZWORK31(:,:,:)=ZSDSTDEP(:,:,:,JJ+NMODE_DST) &!==>molec_{aer}/molec_{air} - *(XMOLARWEIGHT_DUST/XMD) &!==>kg_{aer}/kg_{air} - *XRHODREF(:,:,:) &!==>kg_{aer}/m3_{air} - *(1.d0/XDENSITY_DUST) &!==>m3_{aer}/m3_{air} - *XM3TOUM3 &!==>um3_{aer}/m3_{air} - /(XPI*4./3.) !==>um3_{aer}/m3_{air} - !==>volume 3rd moment - !RAIN: CALCULATE MOMENT 0 FROM DISPERSION AND MEAN RADIUS - ZWORK31(:,:,:)= ZWORK31(:,:,:)/ & - ((ZRG_DST(:,:,:,JJ)**3)* & - EXP(4.5 * LOG(ZSIG_DST(:,:,:,JJ))**2)) - !RAIN: RETURN TO CONCENTRATION #/m3 - ZWORK31(:,:,:)= ZWORK31(:,:,:) * XMD/ & - (XAVOGADRO*XRHODREF(:,:,:)) - !RAIN: Get number concentration (#/molec_{air}==>#/m3) - ZWORK31(:,:,:)= & - ZWORK31(:,:,:) & !#/molec_{air} - * XAVOGADRO & !==>#/mole - / XMD & !==>#/kg_{air} - * XRHODREF(:,:,:) !==>#/m3 - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) - ! RAIN: DUST MASS CONCENTRATION - WRITE(TZFIELD%CMNHNAME,'(A9,I1)')'DSTDEPMSS',JJ+NMODE_DST - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A17,I1)')'DEPMASSCONC MODE ',JJ+NMODE_DST - TZFIELD%CUNITS = 'ug m-3' - ZWORK31(:,:,:)= ZWORK31(:,:,:)*4./3.*3.14*2500.*1e9 & !kg-->ug - * (ZRG_DST(:,:,:,JJ)**3)*1.d-18 & !um-->m - * exp(4.5*log(ZSIG_DST(:,:,:,JJ))*log(ZSIG_DST(:,:,:,JJ))) - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) - END DO -! -END IF -! Aerosol -IF ((LCHEMDIAG).AND.(LORILAM).AND.(LUSECHEM)) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppbv' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_AERBEG,NSV_AEREND - TZFIELD%CMNHNAME = TRIM(UPCASE(CAERONAMES(JSV-NSV_AERBEG+1)))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','AERO',JSV - CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)*1.E9) - END DO - ! - IF (.NOT.(ASSOCIATED(XN3D))) & - ALLOCATE(XN3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE)) - IF (.NOT.(ASSOCIATED(XRG3D))) & - ALLOCATE(XRG3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE)) - IF (.NOT.(ASSOCIATED(XSIG3D))) & - ALLOCATE(XSIG3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE)) - ! - CALL PPP2AERO(XSVT(:,:,:,NSV_AERBEG:NSV_AEREND), XRHODREF, & - PSIG3D=XSIG3D, PRG3D=XRG3D, PN3D=XN3D, PCTOTA=ZPTOTA) - DO JJ=1,JPMODE - WRITE(TZFIELD%CMNHNAME,'(A3,I1)')'RGA',JJ - TZFIELD%CLONGNAME = 'RGA' - TZFIELD%CUNITS = 'um' - WRITE(TZFIELD%CCOMMENT,'(A21,I1)')'RG (nb) AEROSOL MODE ',JJ - CALL IO_Field_write(TPFILE,TZFIELD,XRG3D(:,:,:,JJ)) - ! - WRITE(TZFIELD%CMNHNAME,'(A4,I1)')'RGAM',JJ - TZFIELD%CLONGNAME = 'RGAM' - TZFIELD%CUNITS = 'um' - WRITE(TZFIELD%CCOMMENT,'(A20,I1)')'RG (m) AEROSOL MODE ',JJ - ZWORK31(:,:,:)=XRG3D(:,:,:,JJ) / (EXP(-3.*(LOG(XSIG3D(:,:,:,JJ)))**2)) - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) - ! - WRITE(TZFIELD%CMNHNAME,'(A3,I1)')'N0A',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'cm-3' - WRITE(TZFIELD%CCOMMENT,'(A16,I1)')'N0 AEROSOL MODE ',JJ - CALL IO_Field_write(TPFILE,TZFIELD,XN3D(:,:,:,JJ)*1.E-6) - ! - WRITE(TZFIELD%CMNHNAME,'(A4,I1)')'SIGA',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = '1' - WRITE(TZFIELD%CCOMMENT,'(A19,I1)')'SIGMA AEROSOL MODE ',JJ - CALL IO_Field_write(TPFILE,TZFIELD,XSIG3D(:,:,:,JJ)) - ! - WRITE(TZFIELD%CMNHNAME,'(A4,I1)')'MSO4',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'ug m-3' - WRITE(TZFIELD%CCOMMENT,'(A22,I1)')'MASS SO4 AEROSOL MODE ',JJ - CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SO4,JJ)) - ! - WRITE(TZFIELD%CMNHNAME,'(A4,I1)')'MNO3',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'ug m-3' - WRITE(TZFIELD%CCOMMENT,'(A22,I1)')'MASS NO3 AEROSOL MODE ',JJ - CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_NO3,JJ)) - ! - WRITE(TZFIELD%CMNHNAME,'(A4,I1)')'MNH3',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'ug m-3' - WRITE(TZFIELD%CCOMMENT,'(A22,I1)')'MASS NH3 AEROSOL MODE ',JJ - CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_NH3,JJ)) - ! - WRITE(TZFIELD%CMNHNAME,'(A4,I1)')'MH2O',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'ug m-3' - WRITE(TZFIELD%CCOMMENT,'(A22,I1)')'MASS H2O AEROSOL MODE ',JJ - CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_H2O,JJ)) - ! - IF (NSOA .EQ. 10) THEN - WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA1',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'ug m-3' - WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA1 AEROSOL MODE ',JJ - CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA1,JJ)) - ! - WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA2',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'ug m-3' - WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA2 AEROSOL MODE ',JJ - CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA2,JJ)) - ! - WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA3',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'ug m-3' - WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA3 AEROSOL MODE ',JJ - CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA3,JJ)) - ! - WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA4',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'ug m-3' - WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA4 AEROSOL MODE ',JJ - CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA4,JJ)) - ! - WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA5',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'ug m-3' - WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA5 AEROSOL MODE ',JJ - CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA5,JJ)) - ! - WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA6',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'ug m-3' - WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA6 AEROSOL MODE ',JJ - CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA6,JJ)) - ! - WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA7',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'ug m-3' - WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA7 AEROSOL MODE ',JJ - CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA7,JJ)) - ! - WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA8',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'ug m-3' - WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA8 AEROSOL MODE ',JJ - CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA8,JJ)) - ! - WRITE(TZFIELD%CMNHNAME,'(A5,I1)')'MSOA9',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'ug m-3' - WRITE(TZFIELD%CCOMMENT,'(A23,I1)')'MASS SOA9 AEROSOL MODE ',JJ - CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA9,JJ)) - ! - WRITE(TZFIELD%CMNHNAME,'(A6,I1)')'MSOA10',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'ug m-3' - WRITE(TZFIELD%CCOMMENT,'(A24,I1)')'MASS SOA10 AEROSOL MODE ',JJ - CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_SOA10,JJ)) - END IF - ! - WRITE(TZFIELD%CMNHNAME,'(A3,I1)')'MOC',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'ug m-3' - WRITE(TZFIELD%CCOMMENT,'(A21,I1)')'MASS OC AEROSOL MODE ',JJ - CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_OC,JJ)) - ! - WRITE(TZFIELD%CMNHNAME,'(A3,I1)')'MBC',JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'ug m-3' - WRITE(TZFIELD%CCOMMENT,'(A21,I1)')'MASS BC AEROSOL MODE ',JJ - CALL IO_Field_write(TPFILE,TZFIELD,ZPTOTA(:,:,:,JP_AER_BC,JJ)) - ENDDO -END IF -! -!* Large Scale variables -! -IF (LVAR_LS) THEN - CALL IO_Field_write(TPFILE,'LSUM', XLSUM) - CALL IO_Field_write(TPFILE,'LSVM', XLSVM) - ! - IF (LWIND_ZM) THEN - TZFIELD2(1)%CMNHNAME = 'LSUM_ZM' - TZFIELD2(1)%CSTDNAME = '' - TZFIELD2(1)%CLONGNAME = 'LSUM_ZM' - TZFIELD2(1)%CUNITS = 'm s-1' - TZFIELD2(1)%CDIR = 'XY' - TZFIELD2(1)%CCOMMENT = 'Large Scale Zonal component of horizontal wind' - TZFIELD2(1)%NGRID = 2 - TZFIELD2(1)%NTYPE = TYPEREAL - TZFIELD2(1)%NDIMS = 3 - TZFIELD2(1)%LTIMEDEP = .TRUE. - ! - TZFIELD2(2)%CMNHNAME = 'LSVM_ZM' - TZFIELD2(2)%CSTDNAME = '' - TZFIELD2(2)%CLONGNAME = 'LSVM_ZM' - TZFIELD2(2)%CUNITS = 'm s-1' - TZFIELD2(2)%CDIR = 'XY' - TZFIELD2(2)%CCOMMENT = 'Large Scale Meridian component of horizontal wind' - TZFIELD2(2)%NGRID = 3 - TZFIELD2(2)%NTYPE = TYPEREAL - TZFIELD2(2)%NDIMS = 3 - TZFIELD2(2)%LTIMEDEP = .TRUE. - ! - CALL UV_TO_ZONAL_AND_MERID(XLSUM,XLSVM,23,TPFILE=TPFILE,TZFIELDS=TZFIELD2) - ENDIF - ! - CALL IO_Field_write(TPFILE,'LSWM', XLSWM) - CALL IO_Field_write(TPFILE,'LSTHM',XLSTHM) -! - IF (LUSERV) THEN - CALL FIND_FIELD_ID_FROM_MNHNAME('LSRVM',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'g kg-1' - CALL IO_Field_write(TPFILE,TZFIELD,XLSRVM(:,:,:)*1.E3) - END IF -END IF -! -!* Forcing variables -! -IF (LVAR_FRC .AND. LFORCING) THEN -! - DO JT=1,NFRC - WRITE (YFRC,'(I3.3)') JT -! - TZFIELD%CMNHNAME = 'UFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Zonal component of horizontal forcing wind' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,XUFRC(:,JT)) -! - TZFIELD%CMNHNAME = 'VFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Meridian component of horizontal forcing wind' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,XVFRC(:,JT)) -! - TZFIELD%CMNHNAME = 'WFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Vertical forcing wind' - TZFIELD%NGRID = 4 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,XWFRC(:,JT)) -! - TZFIELD%CMNHNAME = 'THFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'K' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Forcing potential temperature' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,XTHFRC(:,JT)) -! - TZFIELD%CMNHNAME = 'RVFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'kg kg-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Forcing vapor mixing ratio' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,XRVFRC(:,JT)) -! - TZFIELD%CMNHNAME = 'TENDTHFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'K s-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Large-scale potential temperature tendency for forcing' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,XTENDTHFRC(:,JT)) -! - TZFIELD%CMNHNAME = 'TENDRVFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'kg kg-1 s-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Large-scale vapor mixing ratio tendency for forcing' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,XTENDRVFRC(:,JT)) -! - TZFIELD%CMNHNAME = 'GXTHFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'K m-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Large-scale potential temperature gradient for forcing' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,XGXTHFRC(:,JT)) -! - TZFIELD%CMNHNAME = 'GYTHFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'K m-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Large-scale potential temperature gradient for forcing' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,XGYTHFRC(:,JT)) -! - TZFIELD%CMNHNAME = 'PGROUNDFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'Pa' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Forcing ground pressure' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 0 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,XPGROUNDFRC(JT)) -! - END DO -END IF -! -!------------------------------------------------------------------------------- -! -!* 1.7 Some diagnostic variables -! -IF (LTPZH .OR. LCOREF) THEN -! -!* Temperature in celsius - TZFIELD%CMNHNAME = 'TEMP' - TZFIELD%CSTDNAME = 'air_temperature' - TZFIELD%CLONGNAME = 'TEMP' - TZFIELD%CUNITS = 'celsius' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_TEMPerature' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ZWORK31(:,:,:)=ZTEMP(:,:,:) - XTT - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) -! -!* Pressure in hPa - CALL FIND_FIELD_ID_FROM_MNHNAME('PABST',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CMNHNAME = 'PRES' - TZFIELD%CUNITS = 'hPa' - CALL IO_Field_write(TPFILE,TZFIELD,XPABST(:,:,:)*1E-2) -! -!* Geopotential in meters - CALL IO_Field_write(TPFILE,'ALT',XZZ) -! -!* Relative humidity in percent - IF (LUSERV) THEN - ZWORK31(:,:,:)=SM_FOES(ZTEMP(:,:,:)) - ZWORK33(:,:,:)=ZWORK31(:,:,:) - ZWORK31(:,:,:)=(XMV/XMD)*ZWORK31(:,:,:)/(XPABST(:,:,:)-ZWORK31(:,:,:)) - ZWORK32(:,:,:)=100.*XRT(:,:,:,1)/ZWORK31(:,:,:) - IF (CCLOUD(1:3) =='ICE' .OR. CCLOUD =='C3R5' .OR. CCLOUD == 'LIMA') THEN - WHERE ( ZTEMP(:,:,:)< XTT) - ZWORK31(:,:,:) = EXP( XALPI - XBETAI/ZTEMP(:,:,:) & - - XGAMI*ALOG(ZTEMP(:,:,:)) ) !saturation over ice - ZWORK33(:,:,:)=ZWORK31(:,:,:) - ZWORK31(:,:,:)=(XMV/XMD)*ZWORK31(:,:,:)/(XPABST(:,:,:)-ZWORK31(:,:,:)) - ZWORK32(:,:,:)=100.*XRT(:,:,:,1)/ZWORK31(:,:,:) - END WHERE - END IF - ! - TZFIELD%CMNHNAME = 'REHU' - TZFIELD%CSTDNAME = 'relative_humidity' - TZFIELD%CLONGNAME = 'REHU' - TZFIELD%CUNITS = 'percent' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_RElative HUmidity' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK32) - ! - TZFIELD%CMNHNAME = 'VPRES' - TZFIELD%CSTDNAME = 'water_vapor_partial_pressure_in_air' - TZFIELD%CLONGNAME = 'VPRES' - TZFIELD%CUNITS = 'hPa' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_Vapor PRESsure' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ZWORK33(:,:,:)=ZWORK33(:,:,:)*ZWORK32(:,:,:)*1E-4 - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33) - ! - IF (LCOREF) THEN - ZWORK33(:,:,:)=(77.6*( XPABST(:,:,:)*1E-2 & - +ZWORK33(:,:,:)*4810/ZTEMP(:,:,:)) & - -6*ZWORK33(:,:,:) )/ZTEMP(:,:,:) - TZFIELD%CMNHNAME = 'COREF' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'COREF' - TZFIELD%CUNITS = '1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_REFraction COindex (N-units)' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33) - ! - ZWORK33(:,:,:)=ZWORK33(:,:,:)+MZF(XZZ(:,:,:))*1E6/XRADIUS - TZFIELD%CMNHNAME = 'MCOREF' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'MCOREF' - TZFIELD%CUNITS = '1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_Modified REFraction COindex (M-units)' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33) - END IF - ELSE - PRINT*, 'NO WATER VAPOR IN ',TPFILE%CNAME,' RELATIVE HUMIDITY IS NOT COMPUTED' - END IF -! -END IF -! -!------------------------------------------------------------------------------- -! -!* Virtual potential temperature -! -IF ( LMOIST_V .OR. LMSLP .OR. CBLTOP/='NONE' ) THEN - ALLOCATE(ZTHETAV(IIU,IJU,IKU)) -! - IF(NRR > 0) THEN -! compute the ratio : 1 + total water mass / dry air mass - ZRV_OV_RD = XRV / XRD - ZTHETAV(:,:,:) = 1. + XRT(:,:,:,1) - DO JLOOP = 2,1+NRRL+NRRI - ZTHETAV(:,:,:) = ZTHETAV(:,:,:) + XRT(:,:,:,JLOOP) - END DO -! compute the virtual potential temperature when water is present in any form - ZTHETAV(:,:,:) = XTHT(:,:,:) * (1.+XRT(:,:,:,1)*ZRV_OV_RD) / ZTHETAV(:,:,:) - ELSE -! compute the virtual potential temperature when water is absent - ZTHETAV(:,:,:) = XTHT(:,:,:) - END IF -! - IF (LMOIST_V .AND. NRR > 0) THEN -! Virtual potential temperature - TZFIELD%CMNHNAME = 'THETAV' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'THETAV' - TZFIELD%CUNITS = 'K' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_Virtual potential temperature' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZTHETAV) - END IF -! -END IF -! -!------------------------------------------------------------------------------- -! -!* Fog Visibility -! -IF (LVISI) THEN -! - IF ((CCLOUD /= 'NONE') .AND. (CCLOUD /='REVE')) ALLOCATE(ZVISIKUN(IIU,IJU,IKU)) - IF ((CCLOUD == 'C2R2') .OR. (CCLOUD =='KHKO')) THEN - ALLOCATE(ZVISIGUL(IIU,IJU,IKU)) - ALLOCATE(ZVISIZHA(IIU,IJU,IKU)) - END IF -! - IF ((CCLOUD /= 'NONE') .AND. (CCLOUD /='REVE')) THEN - ZVISIKUN(:,:,:) = 10000. - WHERE ( XRT(:,:,:,2) >= 1E-08 ) - ZVISIKUN(:,:,:) =0.027/(XRT(:,:,:,2)*XRHODREF(:,:,:))**0.88*1000. - END WHERE -! Visibity Kunkel - TZFIELD%CMNHNAME = 'VISIKUN' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'VISIKUN' - TZFIELD%CUNITS = 'm' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_Visibility Kunkel' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZVISIKUN) -! - IF ((CCLOUD == 'C2R2') .OR. (CCLOUD =='KHKO')) THEN - ZVISIGUL(:,:,:) = 10000. - ZVISIZHA(:,:,:) = 10000. - WHERE ( (XRT(:,:,:,2) >= 1E-08 ) .AND. (XSVT(:,:,:,NSV_C2R2BEG+1) >=0.001 ) ) - ZVISIGUL(:,:,:) =1.002/(XRT(:,:,:,2)*XRHODREF(:,:,:)*XSVT(:,:,:,NSV_C2R2BEG+1))**0.6473*1000. - ZVISIZHA(:,:,:) =0.187/(XRT(:,:,:,2)*XRHODREF(:,:,:)*XSVT(:,:,:,NSV_C2R2BEG+1))**0.34*1000. - END WHERE -! Visibity Gultepe - TZFIELD%CMNHNAME = 'VISIGUL' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'VISIGUL' - TZFIELD%CUNITS = 'm' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_Visibility Gultepe' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZVISIGUL) -! Visibity Zhang - TZFIELD%CMNHNAME = 'VISIZHA' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'VISIZHA' - TZFIELD%CUNITS = 'm' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_Visibility Zhang' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZVISIZHA) -! - DEALLOCATE(ZVISIGUL,ZVISIZHA) - END IF - DEALLOCATE(ZVISIKUN) - END IF -! -END IF -! -!------------------------------------------------------------------------------- -! -!* Thetae computation according eq.(21), (43) of Bolton 1980 (MWR108,p 1046-1053) -! -IF (( LMOIST_E .OR. LBV_FR ) .AND. (NRR>0)) THEN - ALLOCATE(ZTHETAE(IIU,IJU,IKU)) - ! - ZWORK31(:,:,:) = MAX(XRT(:,:,:,1),1.E-10) - ZTHETAE(:,:,:)= ( 2840./ & - (3.5*ALOG(XTHT(:,:,:)*( XPABST(:,:,:)/XP00 )**(XRD/XCPD) ) & - - ALOG( XPABST(:,:,:)*0.01*ZWORK31(:,:,:) / ( 0.622+ZWORK31(:,:,:) ) ) & - -4.805 ) ) + 55. - ZTHETAE(:,:,:)= XTHT(:,:,:) * EXP( (3376. / ZTHETAE(:,:,:) - 2.54) & - *ZWORK31(:,:,:) *(1. +0.81 *ZWORK31(:,:,:)) ) -! - IF (LMOIST_E) THEN - TZFIELD%CMNHNAME = 'THETAE' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'THETAE' - TZFIELD%CUNITS = 'K' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_Equivalent potential temperature' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZTHETAE) - END IF -END IF -!------------------------------------------------------------------------------- -! -!* Thetaes computation -! -IF (LMOIST_ES .AND. (NRR>0)) THEN - ALLOCATE(ZTHETAES(IIU,IJU,IKU)) - ZWORK31(:,:,:) = MAX(QSAT(ZTEMP(:,:,:),XPABST(:,:,:)),1.E-10) - ZTHETAES(:,:,:)= ( 2840./ & - (3.5*ALOG(XTHT(:,:,:)*( XPABST(:,:,:)/XP00 )**(XRD/XCPD) ) & - - ALOG( XPABST(:,:,:)*0.01*ZWORK31(:,:,:) / ( 0.622+ZWORK31(:,:,:) ) ) & - -4.805 ) ) + 55. - ZTHETAES(:,:,:)= XTHT(:,:,:) * EXP( (3376. / ZTHETAE(:,:,:) - 2.54) & - *ZWORK31(:,:,:) *(1. +0.81 *ZWORK31(:,:,:)) ) - TZFIELD%CMNHNAME = 'THETAES' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'THETAES' - TZFIELD%CUNITS = 'K' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_Equivalent Saturated potential temperature' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZTHETAES) -ENDIF -! -!------------------------------------------------------------------------------- -!* The Liquid-Water potential temperature (Betts, 1973) -! (also needed for THETAS1 or THETAS2) -! -IF ( LMOIST_L .OR. LMOIST_S1 .OR. LMOIST_S2 ) THEN -! - ALLOCATE(ZTHETAL(IIU,IJU,IKU)) -! - IF(NRR > 1) THEN -! The latent heat of Vaporization: - ZWORK31(:,:,:) = XLVTT + (XCPV-XCL)*(ZTEMP(:,:,:)-XTT) -! The latent heat of Sublimation: - ZWORK32(:,:,:) = XLSTT + (XCPV-XCI)*(ZTEMP(:,:,:)-XTT) -! The numerator in the exponential -! and the total water mixing ratio: - ZTHETAL(:,:,:) = 0.0 - ZWORK33(:,:,:) = XRT(:,:,:,1) - DO JLOOP = 2,1+NRRL - ZTHETAL(:,:,:) = ZTHETAL(:,:,:) + XRT(:,:,:,JLOOP)*ZWORK31(:,:,:) - ZWORK33(:,:,:) = ZWORK33(:,:,:) + XRT(:,:,:,JLOOP) - END DO - DO JLOOP = 1+NRRL+1,1+NRRL+NRRI - ZTHETAL(:,:,:) = ZTHETAL(:,:,:) + XRT(:,:,:,JLOOP)*ZWORK32(:,:,:) - ZWORK33(:,:,:) = ZWORK33(:,:,:) + XRT(:,:,:,JLOOP) - END DO -! compute the liquid-water potential temperature -! theta_l = theta * exp[ -(L_vap * ql + L_sub * qi) / (c_pd * T) ] -! when water is present in any form: - ZTHETAL(:,:,:) = XTHT(:,:,:) & - * exp(-ZTHETAL(:,:,:)/(1.0+ZWORK33(:,:,:))/XCPD/ZTEMP(:,:,:)) - ELSE -! compute the liquid-water potential temperature -! when water is absent: - ZTHETAL(:,:,:) = XTHT(:,:,:) - END IF -! - IF (LMOIST_L .AND. NRR > 0) THEN - ! Liquid-Water potential temperature - TZFIELD%CMNHNAME = 'THETAL' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'THETAL' - TZFIELD%CUNITS = 'K' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_Liquid water potential temperature' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZTHETAL) - END IF -! -END IF -! -!------------------------------------------------------------------------------- -! -!* The Moist-air Entropy potential temperature (Marquet, QJ2011, HDR2016) -! -IF ( LMOIST_S1 .OR. LMOIST_S2 ) THEN - IF (LMOIST_S1) THEN - ALLOCATE(ZTHETAS1(IIU,IJU,IKU)) - END IF - IF (LMOIST_S2) THEN - ALLOCATE(ZTHETAS2(IIU,IJU,IKU)) - END IF -! -! The total water (ZWORK31) and condensed water (ZWORK32) mixing ratios: - ZWORK32(:,:,:) = 0.0 - IF(NRR > 0) THEN - DO JLOOP = 2,1+NRRL+NRRI - ZWORK32(:,:,:) = ZWORK32(:,:,:) + XRT(:,:,:,JLOOP) - END DO - END IF - ZWORK31(:,:,:) = ZWORK32(:,:,:) + XRT(:,:,:,1) -! - IF (LMOIST_S1) THEN -!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! thetas1 = thetal * exp[ 5.87 * qt ] ; with qt=rt/(1+rt) -!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ZTHETAS1(:,:,:) = ZTHETAL(:,:,:) * & - exp( 5.87*ZWORK31(:,:,:)/(1.0+ZWORK31(:,:,:)) ) - END IF - IF (LMOIST_S2) THEN -!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! thetas2 = thetal * exp[ (5.87-0.46*ln(rv/0.0124)-0.46*qc) * qt ] -! where qt=rt/(1+rt) and qc=rc/(1+rt) -!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ZWORK33(:,:,:) = 5.87 - 0.46 * log(MAX(XRT(:,:,:,1),1.E-10)/0.0124) - ZTHETAS2(:,:,:) = ZTHETAL(:,:,:) * & - exp( ZWORK33(:,:,:)*ZWORK31(:,:,:)/(1.0+ZWORK31(:,:,:)) & - - 0.46*ZWORK32(:,:,:)/(1.0+ZWORK31(:,:,:)) ) - END IF - IF (LMOIST_S1) THEN -! The Moist-air Entropy potential temperature (1st order) - TZFIELD%CMNHNAME = 'THETAS1' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'THETAS1' - TZFIELD%CUNITS = 'K' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_Moist air Entropy (1st order) potential temperature' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZTHETAS1) - END IF - IF (LMOIST_S2) THEN -! The Moist-air Entropy potential temperature (2nd order) - TZFIELD%CMNHNAME = 'THETAS2' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'THETAS2' - TZFIELD%CUNITS = 'K' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_Moist air Entropy (2nd order) potential temperature' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZTHETAS2) - END IF -! -END IF -! -!------------------------------------------------------------------------------- -!! -! -!* Vorticity quantities -! -IF (LVORT) THEN -! Vorticity x - ZWORK31(:,:,:)=MYF(MZF(MXM(ZVOX(:,:,:)))) - TZFIELD%CMNHNAME = 'UM1' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'UM1' - TZFIELD%CUNITS = 's-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_x component of vorticity' - TZFIELD%NGRID = 2 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) -! -! Vorticity y - ZWORK32(:,:,:)=MZF(MXF(MYM(ZVOY(:,:,:)))) - TZFIELD%CMNHNAME = 'VM1' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'VM1' - TZFIELD%CUNITS = 's-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_y component of vorticity' - TZFIELD%NGRID = 3 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK32) - ! - IF (LWIND_ZM) THEN - TZFIELD2(1)%CMNHNAME = 'UM1_ZM' - TZFIELD2(1)%CSTDNAME = '' - TZFIELD2(1)%CLONGNAME = 'UM1_ZM' - TZFIELD2(1)%CUNITS = 'm s-1' - TZFIELD2(1)%CDIR = 'XY' - TZFIELD2(1)%CCOMMENT = 'Zonal component of horizontal vorticity' - TZFIELD2(1)%NGRID = 2 - TZFIELD2(1)%NTYPE = TYPEREAL - TZFIELD2(1)%NDIMS = 3 - TZFIELD2(1)%LTIMEDEP = .TRUE. - ! - TZFIELD2(2)%CMNHNAME = 'VM1_ZM' - TZFIELD2(2)%CSTDNAME = '' - TZFIELD2(2)%CLONGNAME = 'VM1_ZM' - TZFIELD2(2)%CUNITS = 'm s-1' - TZFIELD2(2)%CDIR = 'XY' - TZFIELD2(2)%CCOMMENT = 'Meridian component of horizontal vorticity' - TZFIELD2(2)%NGRID = 3 - TZFIELD2(2)%NTYPE = TYPEREAL - TZFIELD2(2)%NDIMS = 3 - TZFIELD2(2)%LTIMEDEP = .TRUE. - ! - CALL UV_TO_ZONAL_AND_MERID(ZWORK31,ZWORK32,23,TPFILE=TPFILE,TZFIELDS=TZFIELD2) - ENDIF -! -! Vorticity z - ZWORK31(:,:,:)=MXF(MYF(MZM(ZVOZ(:,:,:)))) - TZFIELD%CMNHNAME = 'WM1' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'WM1' - TZFIELD%CUNITS = 's-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_relative vorticity' - TZFIELD%NGRID = 4 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) -! -! Absolute Vorticity - ZWORK31(:,:,:)=MYF(MXF(ZVOZ(:,:,:))) + ZCORIOZ(:,:,:) - TZFIELD%CMNHNAME = 'ABVOR' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'ABVOR' - TZFIELD%CUNITS = 's-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_z ABsolute VORticity' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) -! -END IF -! -IF ( LMEAN_POVO ) THEN - ! - ALLOCATE(IWORK1(SIZE(XTHT,1),SIZE(XTHT,2))) - ! - IWORK1(:,:)=0 - ZWORK21(:,:)=0. - IF (XMEAN_POVO(1)>XMEAN_POVO(2)) THEN - XMEAN_POVO(1) = ZX0D - XMEAN_POVO(2) = XMEAN_POVO(1) - ZX0D = XMEAN_POVO(2) - END IF - DO JK=IKB,IKE - WHERE((XPABST(:,:,JK)>XMEAN_POVO(1)).AND.(XPABST(:,:,JK)<XMEAN_POVO(2))) - ZWORK21(:,:)=ZWORK21(:,:)+ZPOVO(:,:,JK) - IWORK1(:,:)=IWORK1(:,:)+1 - END WHERE - END DO - WHERE (IWORK1(:,:)>0) ZWORK21(:,:)=ZWORK21(:,:)/REAL( IWORK1(:,:) ) - TZFIELD%CMNHNAME = 'MEAN_POVO' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'MEAN_POVO' - TZFIELD%CUNITS = 'PVU' ! 1 PVU = 1e-6 m^2 s^-1 K kg^-1 - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_MEAN of POtential VOrticity' - TZFIELD%NGRID = 4 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21) -END IF -! -! Virtual Potential Vorticity in PV units -IF (LMOIST_V .AND. (NRR>0) ) THEN - ZWORK31(:,:,:)=GX_M_M(ZTHETAV,XDXX,XDZZ,XDZX) - ZWORK32(:,:,:)=GY_M_M(ZTHETAV,XDYY,XDZZ,XDZY) - ZWORK33(:,:,:)=GZ_M_M(ZTHETAV,XDZZ) - ZWORK34(:,:,:)= ZWORK31(:,:,:)*MZF(MYF(ZVOX(:,:,:))) & - + ZWORK32(:,:,:)*MZF(MXF(ZVOY(:,:,:))) & - + ZWORK33(:,:,:)*(MYF(MXF(ZVOZ(:,:,:))) + ZCORIOZ(:,:,:)) - ZWORK34(:,:,:)=ZWORK34(:,:,:)*1E6/XRHODREF(:,:,:) - TZFIELD%CMNHNAME = 'POVOV' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'POVOV' - TZFIELD%CUNITS = 'PVU' ! 1 PVU = 1e-6 m^2 s^-1 K kg^-1 - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_Virtual POtential VOrticity' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK34) -! - IF (LMEAN_POVO) THEN - IWORK1(:,:)=0 - ZWORK21(:,:)=0. - DO JK=IKB,IKE - WHERE((XPABST(:,:,JK)>XMEAN_POVO(1)).AND.(XPABST(:,:,JK)<XMEAN_POVO(2))) - ZWORK21(:,:)=ZWORK21(:,:)+ZWORK34(:,:,JK) - IWORK1(:,:)=IWORK1(:,:)+1 - END WHERE - END DO - WHERE(IWORK1(:,:)>0) ZWORK21(:,:)=ZWORK21(:,:)/REAL( IWORK1(:,:) ) - TZFIELD%CMNHNAME = 'MEAN_POVOV' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'MEAN_POVOV' - TZFIELD%CUNITS = 'PVU' ! 1 PVU = 1e-6 m^2 s^-1 K kg^-1 - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_MEAN of Virtual POtential VOrticity' - TZFIELD%NGRID = 4 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21) - END IF -END IF -! -! Equivalent Potential Vorticity in PV units -IF (LMOIST_E .AND. (NRR>0) ) THEN -! - ZWORK31(:,:,:)=GX_M_M(ZTHETAE,XDXX,XDZZ,XDZX) - ZWORK32(:,:,:)=GY_M_M(ZTHETAE,XDYY,XDZZ,XDZY) - ZWORK33(:,:,:)=GZ_M_M(ZTHETAE,XDZZ) - ZWORK34(:,:,:)= ZWORK31(:,:,:)*MZF(MYF(ZVOX(:,:,:))) & - + ZWORK32(:,:,:)*MZF(MXF(ZVOY(:,:,:))) & - + ZWORK33(:,:,:)*(MYF(MXF(ZVOZ(:,:,:))) + ZCORIOZ(:,:,:)) - ZWORK34(:,:,:)=ZWORK34(:,:,:)*1E6/XRHODREF(:,:,:) - TZFIELD%CMNHNAME = 'POVOE' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'POVOE' - TZFIELD%CUNITS = 'PVU' ! 1 PVU = 1e-6 m^2 s^-1 K kg^-1 - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_Equivalent POtential VOrticity' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK34) -! - IF (LMEAN_POVO) THEN - IWORK1(:,:)=0 - ZWORK21(:,:)=0. - DO JK=IKB,IKE - WHERE((XPABST(:,:,JK)>XMEAN_POVO(1)).AND.(XPABST(:,:,JK)<XMEAN_POVO(2))) - ZWORK21(:,:)=ZWORK21(:,:)+ZWORK34(:,:,JK) - IWORK1(:,:)=IWORK1(:,:)+1 - END WHERE - END DO - WHERE(IWORK1(:,:)>0) ZWORK21(:,:)=ZWORK21(:,:)/REAL( IWORK1(:,:) ) - TZFIELD%CMNHNAME = 'MEAN_POVOE' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'MEAN_POVOE' - TZFIELD%CUNITS = 'PVU' ! 1 PVU = 1e-6 m^2 s^-1 K kg^-1 - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_MEAN of Equivalent POtential VOrticity' - TZFIELD%NGRID = 4 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21) - DEALLOCATE(IWORK1) - END IF - ! -END IF -! -! Equivalent Saturated Potential Vorticity in PV units -IF (LMOIST_ES .AND. (NRR>0) ) THEN - ZWORK31(:,:,:)=GX_M_M(ZTHETAES,XDXX,XDZZ,XDZX) - ZWORK32(:,:,:)=GY_M_M(ZTHETAES,XDYY,XDZZ,XDZY) - ZWORK33(:,:,:)=GZ_M_M(ZTHETAES,XDZZ) - ZWORK34(:,:,:)= ZWORK31(:,:,:)*MZF(MYF(ZVOX(:,:,:))) & - + ZWORK32(:,:,:)*MZF(MXF(ZVOY(:,:,:))) & - + ZWORK33(:,:,:)*(MYF(MXF(ZVOZ(:,:,:))) + ZCORIOZ(:,:,:)) - ZWORK34(:,:,:)=ZWORK34(:,:,:)*1E6/XRHODREF(:,:,:) - TZFIELD%CMNHNAME = 'POVOES' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'POVOES' - TZFIELD%CUNITS = 'PVU' ! 1 PVU = 1e-6 m^2 s^-1 K kg^-1 - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_Equivalent Saturated POtential VOrticity' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK34) -ENDIF -! -! -!------------------------------------------------------------------------------- -! -!* Horizontal divergence -! -IF (LDIV) THEN -! - ZWORK31=GX_U_M(XUT,XDXX,XDZZ,XDZX) + GY_V_M(XVT,XDYY,XDZZ,XDZY) - TZFIELD%CMNHNAME = 'HDIV' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'HDIV' - TZFIELD%CUNITS = 's-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_Horizontal DIVergence' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) -! - IF (LUSERV) THEN - TZFIELD%CMNHNAME = 'HMDIV' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'HMDIV' - TZFIELD%CUNITS = 'kg m-3 s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_Horizontal Moisture DIVergence HMDIV' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ZWORK31=MXM(XRHODREF*XRT(:,:,:,1))*XUT - ZWORK32=MYM(XRHODREF*XRT(:,:,:,1))*XVT - ZWORK33=GX_U_M(ZWORK31,XDXX,XDZZ,XDZX) + GY_V_M(ZWORK32,XDYY,XDZZ,XDZY) - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33) - END IF -! -ENDIF -! -!------------------------------------------------------------------------------- -! -!* Clustering -! -IF (LCLSTR) THEN - GCLOUD(:,:,:)=.FALSE. - GBOTUP=LBOTUP - IF (CFIELD=='W') THEN - WHERE(XWT(:,:,:).GT.XTHRES) GCLOUD(:,:,:)=.TRUE. - END IF - IF (CFIELD=='CLOUD') THEN - WHERE((XRT(:,:,:,2)+XRT(:,:,:,4)+XRT(:,:,:,5)+XRT(:,:,:,6)).GT.XTHRES) GCLOUD(:,:,:)=.TRUE. - END IF - PRINT *,'CALL CLUSTERING COUNT(GCLOUD)=',COUNT(GCLOUD) - CALL CLUSTERING(GBOTUP,GCLOUD,XWT,ICLUSTERID,ICLUSTERLV,ZCLDSIZE) - PRINT *,'GOT OUT OF CLUSTERING' - ! - TZFIELD%CMNHNAME = 'CLUSTERID' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'CLUSTERID' - TZFIELD%CUNITS = '' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_CLUSTER (ID NUMBER)' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEINT - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ICLUSTERID) - ! - TZFIELD%CMNHNAME = 'CLUSTERLV' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'CLUSTERLV' - TZFIELD%CUNITS = '' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_CLUSTER (BASE OR TOP LEVEL)' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEINT - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ICLUSTERLV) - ! - TZFIELD%CMNHNAME = 'CLDSIZE' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'CLDSIZE' - TZFIELD%CUNITS = '' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_CLDSIZE (HOR. SECTION)' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZCLDSIZE) -END IF -! -!------------------------------------------------------------------------------- -! -!* Geostrophic and Ageostrophic wind (m/s) -! -IF (LGEO .OR. LAGEO) THEN - ALLOCATE(ZPHI(IIU,IJU,IKU)) - IF(CEQNSYS=='MAE' .OR. CEQNSYS=='DUR') THEN - ZPHI(:,:,:)=(XPABST(:,:,:)/XP00)**(XRD/XCPD)-XEXNREF(:,:,:) - ! - ZPHI(1,1,:)=2*ZPHI(1,2,:)-ZPHI(1,3,:) - ZPHI(1,IJU,:)=2*ZPHI(1,IJU-1,:)-ZPHI(1,IJU-2,:) - ZPHI(IIU,1,:)=2*ZPHI(IIU,2,:)-ZPHI(IIU,3,:) - ZPHI(IIU,IJU,:)=2*ZPHI(IIU,IJU-1,:)-ZPHI(IIU,IJU-2,:) - ZWORK31(:,:,:)=-MXM(GY_M_M(ZPHI,XDYY,XDZZ,XDZY)*XCPD*XTHVREF/ZCORIOZ) - ! - ZPHI(1,1,:)=2*ZPHI(2,1,:)-ZPHI(3,1,:) - ZPHI(IIU,1,:)=2*ZPHI(IIU-1,1,:)-ZPHI(IIU-2,1,:) - ZPHI(1,IJU,:)=2*ZPHI(2,IJU,:)-ZPHI(3,IJU,:) - ZPHI(IIU,IJU,:)=2*ZPHI(IIU-1,IJU,:)-ZPHI(IIU-2,IJU,:) - ZWORK32(:,:,:)=MYM(GX_M_M(ZPHI,XDXX,XDZZ,XDZX)*XCPD*XTHVREF/ZCORIOZ) - ! - ELSE IF(CEQNSYS=='LHE') THEN - ZPHI(:,:,:)= ((XPABST(:,:,:)/XP00)**(XRD/XCPD)-XEXNREF(:,:,:)) & - * XCPD * XTHVREF(:,:,:) - ! - ZPHI(1,1,:)=2*ZPHI(1,2,:)-ZPHI(1,3,:) - ZPHI(1,IJU,:)=2*ZPHI(1,IJU-1,:)-ZPHI(1,IJU-2,:) - ZPHI(IIU,1,:)=2*ZPHI(IIU,2,:)-ZPHI(IIU,3,:) - ZPHI(IIU,IJU,:)=2*ZPHI(IIU,IJU-1,:)-ZPHI(IIU,IJU-2,:) - ZWORK31(:,:,:)=-MXM(GY_M_M(ZPHI,XDYY,XDZZ,XDZY)/ZCORIOZ) - ! - ZPHI(1,1,:)=2*ZPHI(2,1,:)-ZPHI(3,1,:) - ZPHI(IIU,1,:)=2*ZPHI(IIU-1,1,:)-ZPHI(IIU-2,1,:) - ZPHI(1,IJU,:)=2*ZPHI(2,IJU,:)-ZPHI(3,IJU,:) - ZPHI(IIU,IJU,:)=2*ZPHI(IIU-1,IJU,:)-ZPHI(IIU-2,IJU,:) - ZWORK32(:,:,:)=MYM(GX_M_M(ZPHI,XDXX,XDZZ,XDZX)/ZCORIOZ) - END IF - DEALLOCATE(ZPHI) -! - IF (LGEO) THEN - TZFIELD%CMNHNAME = 'UM88' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'UM88' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_U component of GEOstrophic wind' - TZFIELD%NGRID = 2 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) -! - TZFIELD%CMNHNAME = 'VM88' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'VM88' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_V component of GEOstrophic wind' - TZFIELD%NGRID = 3 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK32) - ! - IF (LWIND_ZM) THEN - TZFIELD2(1)%CMNHNAME = 'UM88_ZM' - TZFIELD2(1)%CSTDNAME = '' - TZFIELD2(1)%CLONGNAME = 'UM88_ZM' - TZFIELD2(1)%CUNITS = 'm s-1' - TZFIELD2(1)%CDIR = 'XY' - TZFIELD2(1)%CCOMMENT = 'Zonal component of GEOstrophic wind' - TZFIELD2(1)%NGRID = 2 - TZFIELD2(1)%NTYPE = TYPEREAL - TZFIELD2(1)%NDIMS = 3 - TZFIELD2(1)%LTIMEDEP = .TRUE. - ! - TZFIELD2(2)%CMNHNAME = 'VM88_ZM' - TZFIELD2(2)%CSTDNAME = '' - TZFIELD2(2)%CLONGNAME = 'VM88_ZM' - TZFIELD2(2)%CUNITS = 'm s-1' - TZFIELD2(2)%CDIR = 'XY' - TZFIELD2(2)%CCOMMENT = 'Meridian component of GEOstrophic wind' - TZFIELD2(2)%NGRID = 3 - TZFIELD2(2)%NTYPE = TYPEREAL - TZFIELD2(2)%NDIMS = 3 - TZFIELD2(2)%LTIMEDEP = .TRUE. - ! - CALL UV_TO_ZONAL_AND_MERID(ZWORK31,ZWORK32,23,TPFILE=TPFILE,TZFIELDS=TZFIELD2) - ENDIF -! -! wm necessary to plot vertical cross sections of wind vectors - CALL FIND_FIELD_ID_FROM_MNHNAME('WT',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CMNHNAME = 'WM88' - TZFIELD%CLONGNAME = 'WM88' - CALL IO_Field_write(TPFILE,TZFIELD,XWT) - END IF -! - IF (LAGEO) THEN - ZWORK31(:,:,:)=XUT(:,:,:)-ZWORK31(:,:,:) - ZWORK32(:,:,:)=XVT(:,:,:)-ZWORK32(:,:,:) - ! - TZFIELD%CMNHNAME = 'UM89' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'UM89' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_U component of AGEOstrophic wind' - TZFIELD%NGRID = 2 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) - ! - TZFIELD%CMNHNAME = 'VM89' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'VM89' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_V component of AGEOstrophic wind' - TZFIELD%NGRID = 3 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK32) - ! - IF (LWIND_ZM) THEN - TZFIELD2(1)%CMNHNAME = 'UM89_ZM' - TZFIELD2(1)%CSTDNAME = '' - TZFIELD2(1)%CLONGNAME = 'UM89_ZM' - TZFIELD2(1)%CUNITS = 'm s-1' - TZFIELD2(1)%CDIR = 'XY' - TZFIELD2(1)%CCOMMENT = 'Zonal component of AGEOstrophic wind' - TZFIELD2(1)%NGRID = 2 - TZFIELD2(1)%NTYPE = TYPEREAL - TZFIELD2(1)%NDIMS = 3 - TZFIELD2(1)%LTIMEDEP = .TRUE. - ! - TZFIELD2(2)%CMNHNAME = 'VM89_ZM' - TZFIELD2(2)%CSTDNAME = '' - TZFIELD2(2)%CLONGNAME = 'VM89_ZM' - TZFIELD2(2)%CUNITS = 'm s-1' - TZFIELD2(2)%CDIR = 'XY' - TZFIELD2(2)%CCOMMENT = 'Meridian component of AGEOstrophic wind' - TZFIELD2(2)%NGRID = 3 - TZFIELD2(2)%NTYPE = TYPEREAL - TZFIELD2(2)%NDIMS = 3 - TZFIELD2(2)%LTIMEDEP = .TRUE. - ! - CALL UV_TO_ZONAL_AND_MERID(ZWORK31,ZWORK32,23,TPFILE=TPFILE,TZFIELDS=TZFIELD2) - ENDIF -! -! wm necessary to plot vertical cross sections of wind vectors - CALL FIND_FIELD_ID_FROM_MNHNAME('WT',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CMNHNAME = 'WM89' - TZFIELD%CLONGNAME = 'WM89' - CALL IO_Field_write(TPFILE,TZFIELD,XWT) - END IF -! -END IF -! -!------------------------------------------------------------------------------- -! -!* Contravariant wind field -! -! -IF(LWIND_CONTRAV) THEN!$ - CALL CONTRAV ((/"TEST","TEST"/),(/"TEST","TEST"/),XUT,XVT,XWT,XDXX,XDYY,XDZZ,XDZX,XDZY, & - ZWORK31,ZWORK32,ZWORK33,2) - ! - TZFIELD%CMNHNAME = 'WNORM' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'WNORM' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_W surface normal wind' - TZFIELD%NGRID = 4 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33) -END IF -!------------------------------------------------------------------------------- -! -!* Mean Sea Level Pressure in hPa -! -IF (LMSLP) THEN - ZGAMREF=-6.5E-3 -! Exner function at the first mass point - ZWORK21(:,:) = (XPABST(:,:,IKB) /XP00)**(XRD/XCPD) -! virtual temperature at the first mass point - ZWORK21(:,:) = ZWORK21(:,:) * ZTHETAV(:,:,IKB) -! virtual temperature at ground level - ZWORK21(:,:) = ZWORK21(:,:) - ZGAMREF*((XZZ(:,:,IKB)+XZZ(:,:,IKB+1))/2.-XZS(:,:)) -! virtual temperature at sea level - ZWORK22(:,:) = ZWORK21(:,:) - ZGAMREF*XZS(:,:) -! average underground virtual temperature - ZWORK22(:,:) = 0.5*(ZWORK21(:,:)+ZWORK22(:,:)) -! surface pressure - ZWORK21(:,:) = ( XPABST(:,:,IKB) + XPABST(:,:,IKB-1) )*.5 -! sea level pressure (hPa) - ZWORK22(:,:) = 1.E-2*ZWORK21(:,:)*EXP(XG*XZS(:,:)/(XRD*ZWORK22(:,:))) -! - TZFIELD%CMNHNAME = 'MSLP' - TZFIELD%CSTDNAME = 'air_pressure_at_sea_level' - TZFIELD%CLONGNAME = 'MSLP' - TZFIELD%CUNITS = 'hPa' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Mean Sea Level Pressure' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK22) -END IF -!------------------------------------------------------------------------------- -! -!* Vapor, cloud water and ice thickness -! -IF (LTHW) THEN -! - ZWORK21(:,:) = 0. - IF(SIZE(XRT,4)>=1)THEN - DO JK = IKB,IKE - ZWORK21(:,:) = ZWORK21(:,:)+XRHODREF(:,:,JK)*XRT(:,:,JK,1) * & - (XZZ(:,:,JK+1)-XZZ(:,:,JK))/XRHOLW - END DO - ZWORK21(:,:) = ZWORK21(:,:)*1000. ! vapor water in mm unit - TZFIELD%CMNHNAME = 'THVW' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'THVW' - TZFIELD%CUNITS = 'mm' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_THickness of Vapor Water' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21) - END IF - ! - ZWORK21(:,:) = 0. - IF(SIZE(XRT,4)>=2)THEN - DO JK = IKB,IKE - ZWORK21(:,:) = ZWORK21(:,:)+XRHODREF(:,:,JK)*XRT(:,:,JK,2) * & - (XZZ(:,:,JK+1)-XZZ(:,:,JK))/XRHOLW - END DO - ZWORK21(:,:) = ZWORK21(:,:)*1000. ! cloud water in mm unit - TZFIELD%CMNHNAME = 'THCW' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'THCW' - TZFIELD%CUNITS = 'mm' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_THickness of Cloud Water' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21) - END IF - ! - ZWORK21(:,:) = 0. - IF(SIZE(XRT,4)>=3)THEN - DO JK = IKB,IKE - ZWORK21(:,:) = ZWORK21(:,:)+XRHODREF(:,:,JK)*XRT(:,:,JK,3) * & - (XZZ(:,:,JK+1)-XZZ(:,:,JK))/XRHOLW - END DO - ZWORK21(:,:) = ZWORK21(:,:)*1000. ! rain water in mm unit - TZFIELD%CMNHNAME = 'THRW' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'THRW' - TZFIELD%CUNITS = 'mm' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_THickness of Rain Water' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21) - END IF - ! - ZWORK21(:,:) = 0. - IF(SIZE(XRT,4)>=4)THEN - DO JK = IKB,IKE - ZWORK21(:,:) = ZWORK21(:,:)+XRHODREF(:,:,JK)*XRT(:,:,JK,4) * & - (XZZ(:,:,JK+1)-XZZ(:,:,JK))/XRHOLW - END DO - ZWORK21(:,:) = ZWORK21(:,:)*1000. ! ice thickness in mm unit - TZFIELD%CMNHNAME = 'THIC' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'THIC' - TZFIELD%CUNITS = 'mm' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_THickness of ICe' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21) - END IF - ! - ZWORK21(:,:) = 0. - IF(SIZE(XRT,4)>=5)THEN - DO JK = IKB,IKE - ZWORK21(:,:) = ZWORK21(:,:)+XRHODREF(:,:,JK)*XRT(:,:,JK,5) * & - (XZZ(:,:,JK+1)-XZZ(:,:,JK))/XRHOLW - END DO - ZWORK21(:,:) = ZWORK21(:,:)*1000. ! snow thickness in mm unit - TZFIELD%CMNHNAME = 'THSN' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'THSN' - TZFIELD%CUNITS = 'mm' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_THickness of SNow' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21) - END IF - ! - ZWORK21(:,:) = 0. - IF(SIZE(XRT,4)>=6)THEN - DO JK = IKB,IKE - ZWORK21(:,:) = ZWORK21(:,:)+XRHODREF(:,:,JK)*XRT(:,:,JK,6) * & - (XZZ(:,:,JK+1)-XZZ(:,:,JK))/XRHOLW - END DO - ZWORK21(:,:) = ZWORK21(:,:)*1000. ! graupel thickness in mm unit - TZFIELD%CMNHNAME = 'THGR' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'THGR' - TZFIELD%CUNITS = 'mm' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_THickness of GRaupel' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21) - END IF - ! - ZWORK21(:,:) = 0. - IF(SIZE(XRT,4)>=7)THEN - DO JK = IKB,IKE - ZWORK21(:,:) = ZWORK21(:,:)+XRHODREF(:,:,JK)*XRT(:,:,JK,7) * & - (XZZ(:,:,JK+1)-XZZ(:,:,JK))/XRHOLW - END DO - ZWORK21(:,:) = ZWORK21(:,:)*1000. ! hail thickness in mm unit - TZFIELD%CMNHNAME = 'THHA' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'THHA' - TZFIELD%CUNITS = 'mm' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_THickness of HAil' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21) - END IF -END IF -! -!------------------------------------------------------------------------------- -! -!* Accumulated and instantaneous total precip rates in mm and mm/h -! -IF (LTOTAL_PR .AND. SIZE (XACPRR)>0 ) THEN - ZWORK21(:,:) = 0. - ! - IF (LUSERR) THEN - ZWORK21(:,:) = XACPRR(:,:)*1E3 - END IF - IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'LIMA') THEN - ZWORK21(:,:) = ZWORK21(:,:) + (XACPRS(:,:) + XACPRG(:,:))*1E3 - IF (SIZE(XINPRC) /= 0 ) & - ZWORK21(:,:) = ZWORK21(:,:) + XACPRC(:,:) *1E3 - IF (SIZE(XINPRH) /= 0 ) & - ZWORK21(:,:) = ZWORK21(:,:) + XACPRH(:,:) *1E3 - END IF - IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO' & - .OR. CCLOUD == 'LIMA' ) THEN - IF (SIZE(XINPRC) /= 0 ) & - ZWORK21(:,:) = ZWORK21(:,:) + XACPRC(:,:) *1E3 - END IF - IF (CDCONV /= 'NONE') THEN - ZWORK21(:,:) = ZWORK21(:,:) + XPACCONV(:,:)*1E3 - END IF - IF (LUSERR .OR. CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'C3R5' .OR. & - CCLOUD == 'LIMA' .OR. CDCONV /= 'NONE') THEN - TZFIELD%CMNHNAME = 'ACTOPR' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'ACTOPR' - TZFIELD%CUNITS = 'mm' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_ACccumulated TOtal Precipitation Rate' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21) - ELSE - PRINT * ,'YOU WANT TO COMPUTE THE ACCUMULATED RAIN' - PRINT * ,'BUT NO RAIN IS PRESENT IN THE MODEL' - END IF - ! - ! calculation of the mean accumulated precipitations in the mesh-grid of a - !large-scale model - IF (LMEAN_PR .AND. LUSERR) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'mm' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Large Scale ACccumulated TOtal Precipitation Rate' - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JK=1,SIZE(XMEAN_PR),2 - IF (XMEAN_PR(JK) .NE. XUNDEF .AND. XMEAN_PR(JK+1) .NE. XUNDEF) THEN - PRINT * ,'MEAN accumulated RAIN: GRID ', XMEAN_PR(JK), XMEAN_PR(JK+1) - CALL COMPUTE_MEAN_PRECIP(ZWORK21,XMEAN_PR(JK:JK+1),ZWORK22,TZFIELD%NGRID) - ! - JI=INT(XMEAN_PR(JK)) - JJ=INT(XMEAN_PR(JK+1)) - WRITE(TZFIELD%CMNHNAME,'(A9,2I2.2)')'LS_ACTOPR',JI,JJ - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK22) - END IF - END DO - ! - END IF - ! - ! - ZWORK21(:,:) = 0. - ! - IF (LUSERR) THEN - ZWORK21(:,:) = XINPRR(:,:)*3.6E6 - END IF - IF (CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'LIMA') THEN - ZWORK21(:,:) = ZWORK21(:,:) + (XINPRS(:,:) + XINPRG(:,:))*3.6E6 - IF (SIZE(XINPRC) /= 0 ) & - ZWORK21(:,:) = ZWORK21(:,:) + XINPRC(:,:) *3.6E6 - IF (SIZE(XINPRH) /= 0 ) & - ZWORK21(:,:) = ZWORK21(:,:) + XINPRH(:,:) *3.6E6 - END IF - IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO' & - .OR. CCLOUD == 'LIMA' ) THEN - IF (SIZE(XINPRC) /= 0 ) & - ZWORK21(:,:) = ZWORK21(:,:) + XINPRC(:,:) *3.6E6 - END IF - IF (CDCONV /= 'NONE') THEN - ZWORK21(:,:) = ZWORK21(:,:) + XPRCONV(:,:)*3.6E6 - END IF - IF (LUSERR .OR. CCLOUD(1:3) == 'ICE' .OR. CCLOUD == 'C3R5' .OR. & - CCLOUD == 'LIMA' .OR. CDCONV /= 'NONE') THEN - TZFIELD%CMNHNAME = 'INTOPR' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'INTOPR' - TZFIELD%CUNITS = 'mm hour-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_INstantaneous TOtal Precipitation Rate' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21) - ELSE - PRINT * ,'YOU WANT TO COMPUTE THE RAIN RATE' - PRINT * ,'BUT NO RAIN IS PRESENT IN THE MODEL' - END IF -! - ! calculation of the mean instantaneous precipitations in the mesh-grid of a - ! large-scale model - IF (LMEAN_PR .AND. LUSERR) THEN - CALL COMPUTE_MEAN_PRECIP(ZWORK21,XMEAN_PR,ZWORK22,TZFIELD%NGRID) -! - TZFIELD%CMNHNAME = 'LS_INTOPR' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'LS_INTOPR' - TZFIELD%CUNITS = 'mm hour-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Large Scale INstantaneous TOtal Precipitation Rate' - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK22) - END IF -! -END IF -! -!------------------------------------------------------------------------------- -! -!* CAPEMAX, CINMAX (corresponding to CAPEMAX), CAPE, CIN, DCAPE, VKE in J/kg -! -IF (NCAPE >=0 .AND. LUSERV) THEN - ZWORK31(:,:,:) = XRT(:,:,:,1) * 1000. ! vapour mixing ratio in g/kg - ZWORK32(:,:,:)=0.0 - ZWORK33(:,:,:)=0.0 - ZWORK34(:,:,:)=0.0 - CALL CALCSOUND( XPABST(:,:,IKB:IKE)* 0.01 ,ZTEMP(:,:,IKB:IKE)- XTT, & - ZWORK31(:,:,IKB:IKE), & - ZWORK32(:,:,IKB:IKE),ZWORK33(:,:,IKB:IKE), & - ZWORK34(:,:,IKB:IKE),ZWORK21,ZWORK22 ) - ! - TZFIELD%CMNHNAME = 'CAPEMAX' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'CAPEMAX' - TZFIELD%CUNITS = 'J kg-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_MAX of Convective Available Potential Energy' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21) - ! - TZFIELD%CMNHNAME = 'CINMAX' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'CINMAX' - TZFIELD%CUNITS = 'J kg-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_MAX of Convective INhibition energy' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK22) - ! - IF (NCAPE >=1) THEN - TZFIELD%CMNHNAME = 'CAPE3D' - TZFIELD%CSTDNAME = 'atmosphere_convective_available_potential_energy' - TZFIELD%CLONGNAME = 'CAPE3D' - TZFIELD%CUNITS = 'J kg-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_Convective Available Potential Energy' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK32) - ! - TZFIELD%CMNHNAME = 'CIN3D' - TZFIELD%CSTDNAME = 'atmosphere_convective_inhibition' - TZFIELD%CLONGNAME = 'CIN3D' - TZFIELD%CUNITS = 'J kg-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_Convective INhibition energy' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33) - ! - TZFIELD%CMNHNAME = 'DCAPE3D' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'DCAPE3D' - TZFIELD%CUNITS = 'J kg-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK34) - END IF - ! - IF (NCAPE >=2) THEN - ZWORK31(:,:,1:IKU-1)= 0.5*(XWT(:,:,1:IKU-1)+XWT(:,:,2:IKU)) - ZWORK31(:,:,IKU) = 0. - ZWORK31=0.5*ZWORK31**2 - ! - TZFIELD%CMNHNAME = 'VKE' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'VKE' - TZFIELD%CUNITS = 'J kg-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_Vertical Kinetic Energy' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) - END IF -ENDIF -! -!------------------------------------------------------------------------------- -! -!* B-V frequency to assess thermal tropopause -! -IF (LBV_FR) THEN - ZWORK32(:,:,:)=DZM(XTHT(:,:,:))/ MZM(XTHT(:,:,:)) - DO JK=1,IKU - DO JJ=1,IJU - DO JI=1,IIU - IF(ZWORK32(JI,JJ,JK)<0.) THEN - ZWORK31(JI,JJ,JK)= -1.*SQRT( ABS( XG*ZWORK32(JI,JJ,JK)/ XDZZ(JI,JJ,JK) ) ) - ELSE - ZWORK31(JI,JJ,JK)= SQRT( ABS( XG*ZWORK32(JI,JJ,JK)/ XDZZ(JI,JJ,JK) ) ) - END IF - ENDDO - ENDDO - ENDDO - ! - TZFIELD%CMNHNAME = 'BV' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'BV' - TZFIELD%CUNITS = 's-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_Brunt-Vaissala frequency' - TZFIELD%NGRID = 4 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) -! - IF (NRR > 0) THEN - ZWORK32(:,:,:)=DZM(ZTHETAE(:,:,:))/ MZM(ZTHETAE(:,:,:)) - DO JK=1,IKU - DO JJ=1,IJU - DO JI=1,IIU - IF (ZWORK32(JI,JJ,JK)<0.) THEN - ZWORK31(JI,JJ,JK)= -1.*SQRT( ABS( XG*ZWORK32(JI,JJ,JK)/ XDZZ(JI,JJ,JK) ) ) - ELSE - ZWORK31(JI,JJ,JK)= SQRT( ABS( XG*ZWORK32(JI,JJ,JK)/ XDZZ(JI,JJ,JK) ) ) - END IF - ENDDO - ENDDO - ENDDO -! - TZFIELD%CMNHNAME = 'BVE' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'BVE' - TZFIELD%CUNITS = 's-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_Equivalent Brunt-Vaissala frequency' - TZFIELD%NGRID = 4 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) - END IF -END IF -! -IF(ALLOCATED(ZTHETAE)) DEALLOCATE(ZTHETAE) -IF(ALLOCATED(ZTHETAES)) DEALLOCATE(ZTHETAES) -!------------------------------------------------------------------------------- -! -!* GPS synthetic ZTD, ZHD, ZWD -! -IF ( NGPS>=0 ) THEN - ! surface temperature - ZGAMREF=-6.5E-3 - ZWORK21(:,:) = ZTEMP(:,:,IKB) - ZGAMREF*((XZZ(:,:,IKB)+XZZ(:,:,IKB+1))/2.-XZS(:,:)) - ! - YFGRI=ADJUSTL(ADJUSTR(TPFILE%CNAME)//'GPS') - CALL GPS_ZENITH (YFGRI,XRT(:,:,:,1),ZTEMP,XPABST,ZWORK21,ZWORK22,ZWORK23,ZWORK24) - ! - TZFIELD%CMNHNAME = 'ZTD' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'ZTD' - TZFIELD%CUNITS = 'm' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_Zenithal Total Delay' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK22) - ! - IF (NGPS>=1) THEN - TZFIELD%CMNHNAME = 'ZHD' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'ZHD' - TZFIELD%CUNITS = 'm' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_Zenithal Hydrostatic Delay' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK23) - ! - TZFIELD%CMNHNAME = 'ZWD' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'ZWD' - TZFIELD%CUNITS = 'm' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_Zenithal Wet Delay' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK24) - ! - END IF - ! -END IF -! -!------------------------------------------------------------------------------- -! -!* Radar reflectivities -! -IF(LRADAR .AND. LUSERR) THEN -! CASE PREP_REAL_CASE after arome - IF (CCLOUD=='NONE' .OR. CCLOUD=='KESS') THEN - DEALLOCATE(XCIT) - ALLOCATE(XCIT(IIU,IJU,IKU)) - XCIT(:,:,:)=800. - CALL INI_RADAR('PLAT') - ELSE IF (CCLOUD=='LIMA') THEN - DEALLOCATE(XCIT) - ALLOCATE(XCIT(IIU,IJU,IKU)) - XCIT(:,:,:)=XSVT(:,:,:,NSV_LIMA_NI) - CALL INI_RADAR('PLAT') - END IF -! - IF (NVERSION_RAD == 1) THEN -! original version of radar diagnostics - WRITE(ILUOUT0,*) 'radar diagnostics from RADAR_RAIN_ICE routine' - IF (CCLOUD=='LIMA') THEN - CALL RADAR_RAIN_ICE (XRT, XCIT, XRHODREF, ZTEMP, ZWORK31, ZWORK32, & - ZWORK33, ZWORK34,XSVT(:,:,:,NSV_LIMA_NR) ) - ELSE - CALL RADAR_RAIN_ICE (XRT, XCIT, XRHODREF, ZTEMP, ZWORK31, ZWORK32, & - ZWORK33, ZWORK34 ) - ENDIF -! - TZFIELD%CMNHNAME = 'RARE' - TZFIELD%CSTDNAME = 'equivalent_reflectivity_factor' - TZFIELD%CLONGNAME = 'RARE' - TZFIELD%CUNITS = 'dBZ' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_RAdar REflectivity' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) -! - TZFIELD%CMNHNAME = 'VDOP' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'VDOP' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_radar DOPpler fall speed' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK32) -! - TZFIELD%CMNHNAME = 'ZDR' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'ZDR' - TZFIELD%CUNITS = 'dBZ' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_Differential polar Reflectivity' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK33) -! - TZFIELD%CMNHNAME = 'KDP' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'KDP' - TZFIELD%CUNITS = 'degree km-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_Differential Phase Reflectivity' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK34) -! - ELSE - ! - WRITE(ILUOUT0,*) 'radar diagnostics from RADAR_SIMULATOR routine' - - NBRAD=COUNT(XLAT_RAD(:) /= XUNDEF) - NMAX=INT(NBSTEPMAX*XSTEP_RAD/XGRID) - IF(NBSTEPMAX*XSTEP_RAD/XGRID/=NMAX .AND. (LCART_RAD)) THEN - CALL PRINT_MSG(NVERB_FATAL,'GEN','WRITE_LFIFM1_FOR_DIAG', & - 'NBSTEPMAX*XSTEP_RAD/XGRID is not an integer; please choose another combination') - ENDIF - DO JI=1,NBRAD - NBELEV(JI)=COUNT(XELEV(JI,:) /= XUNDEF) - WRITE(ILUOUT0,*) 'Number of ELEVATIONS : ', NBELEV(JI), 'FOR RADAR:', JI - END DO - IIELV=MAXVAL(NBELEV(1:NBRAD)) - WRITE(ILUOUT0,*) 'Maximum number of ELEVATIONS',IIELV - WRITE(ILUOUT0,*) 'YOU HAVE ASKED FOR ', NBRAD, 'RADARS' - ! - IF (LCART_RAD) NBAZIM=8*NMAX ! number of azimuths - WRITE(ILUOUT0,*) ' Number of AZIMUTHS : ', NBAZIM - IF (LCART_RAD) THEN - ALLOCATE(ZWORK43(NBRAD,4*NMAX,2*NMAX)) - ELSE - ALLOCATE(ZWORK43(1,NBAZIM,1)) - END IF -!! Some controls... - IF(NBRAD/=COUNT(XLON_RAD(:) /= XUNDEF).OR.NBRAD/=COUNT(XALT_RAD(:) /= XUNDEF).OR. & - NBRAD/=COUNT(XLAM_RAD(:) /= XUNDEF).OR.NBRAD/=COUNT(XDT_RAD(:) /= XUNDEF).OR. & - NBRAD/=COUNT(CNAME_RAD(:) /= "UNDEF")) THEN - CALL PRINT_MSG(NVERB_FATAL,'GEN','WRITE_LFIFM1_FOR_DIAG','inconsistency in DIAG1.nam') - END IF - IF(NCURV_INTERPOL==0.AND.(LREFR.OR.LDNDZ)) THEN - LREFR=.FALSE. - LDNDZ=.FALSE. - WRITE(ILUOUT0,*) "Warning: cannot output refractivity nor its vertical gradient when NCURV_INTERPOL=0" - END IF - IF(MOD(NPTS_H,2)==0) THEN - NPTS_H=NPTS_H+1 - WRITE(ILUOUT0,*) "Warning: NPTS_H has to be ODD. Setting it to ",NPTS_H - END IF - IF(MOD(NPTS_V,2)==0) THEN - NPTS_V=NPTS_V+1 - WRITE(ILUOUT0,*) "Warning: NPTS_V has to be ODD. Setting it to ",NPTS_V - END IF - IF(LWBSCS.AND.LWREFL) THEN - LWREFL=.FALSE. - WRITE(ILUOUT0,*) "Warning: LWREFL cannot be set to .TRUE. if LWBSCS is also set to .TRUE.. Setting LWREFL to .FALSE.." - END IF - IF(CCLOUD=="LIMA" .AND. NDIFF/=7) THEN - WRITE(YMSG,*) 'NDIFF=',NDIFF,' not available with CCLOUD=LIMA' - CALL PRINT_MSG(NVERB_FATAL,'GEN','WRITE_LFIFM1_FOR_DIAG',YMSG) - END IF - INBOUT=28 !28: Temperature + RHR, RHS, RHG, ZDA, ZDS, ZDG, KDR, KDS, KDG - IF (CCLOUD=='LIMA') INBOUT=INBOUT+1 ! rain concentration CRT - IF(LREFR) INBOUT=INBOUT+1 !+refractivity - IF(LDNDZ) INBOUT=INBOUT+1 !+refractivity vertical gradient - IF(LATT) INBOUT=INBOUT+12 !+AER-AEG AVR-AVG (vertical specific attenuation) and ATR-ATG - IF ( CCLOUD=='ICE4' ) THEN - INBOUT=INBOUT+5 ! HAIL ZEH RHH ZDH KDH M_H - IF (LATT) THEN - INBOUT=INBOUT+3 ! AEH AVH ATH - ENDIF - END IF - WRITE(ILUOUT0,*) "Nombre de variables dans ZWORK42 en sortie de radar_simulator:",INBOUT - - IF (LCART_RAD) THEN - ALLOCATE(ZWORK42(NBRAD,IIELV,2*NMAX,2*NMAX,INBOUT)) - ELSE - ALLOCATE(ZWORK42(NBRAD,IIELV,NBAZIM,NBSTEPMAX+1,INBOUT)) - ALLOCATE(ZWORK42_BIS(NBRAD,IIELV,NBAZIM,NBSTEPMAX+1,INBOUT)) - END IF - ! - IF (CCLOUD=='LIMA') THEN - CALL RADAR_SIMULATOR(XUT,XVT,XWT,XRT,XSVT(:,:,:,NSV_LIMA_NI),XRHODREF,& - ZTEMP,XPABST,ZWORK42,ZWORK43,XSVT(:,:,:,NSV_LIMA_NR)) - ELSE ! ICE3 - CALL RADAR_SIMULATOR(XUT,XVT,XWT,XRT,XCIT,XRHODREF,ZTEMP,XPABSM,ZWORK42,ZWORK43) - ENDIF - ALLOCATE(YRAD(INBOUT)) - YRAD(1:8)=(/"ZHH","ZDR","KDP","CSR","ZER","ZEI","ZES","ZEG"/) - ICURR=9 - IF (CCLOUD=='ICE4') THEN - YRAD(ICURR)="ZEH" - ICURR=ICURR+1 - END IF - YRAD(ICURR)="VRU" - ICURR=ICURR+1 - IF(LATT) THEN - IF (CCLOUD=='ICE4') THEN - YRAD(ICURR:ICURR+14)=(/"AER","AEI","AES","AEG","AEH","AVR","AVI","AVS","AVG","AVH","ATR","ATI","ATS","ATG","ATH"/) - ICURR=ICURR+15 - ELSE - YRAD(ICURR:ICURR+11)=(/"AER","AEI","AES","AEG","AVR","AVI","AVS","AVG","ATR","ATI","ATS","ATG"/) - ICURR=ICURR+12 - END IF - END IF - YRAD(ICURR:ICURR+2)=(/"RHV","PDP","DHV"/) - ICURR=ICURR+3 - YRAD(ICURR:ICURR+2)=(/"RHR","RHS","RHG"/) - ICURR=ICURR+3 - IF (CCLOUD=='ICE4') THEN - YRAD(ICURR)="RHH" - ICURR=ICURR+1 - END IF - YRAD(ICURR:ICURR+2)=(/"ZDA","ZDS","ZDG"/) - ICURR=ICURR+3 - IF (CCLOUD=='ICE4') THEN - YRAD(ICURR)="ZDH" - ICURR=ICURR+1 - END IF - YRAD(ICURR:ICURR+2)=(/"KDR","KDS","KDG"/) - ICURR=ICURR+3 - IF (CCLOUD=='ICE4') THEN - YRAD(ICURR)="KDH" - ICURR=ICURR+1 - END IF - YRAD(ICURR:ICURR+4)=(/"HAS","M_R","M_I","M_S","M_G"/) - ICURR=ICURR+5 - IF (CCLOUD=='ICE4') THEN - YRAD(ICURR)="M_H" - ICURR=ICURR+1 - END IF - YRAD(ICURR:ICURR+1)=(/"CIT","TEM"/) - ICURR=ICURR+2 - IF (CCLOUD=='LIMA') THEN - YRAD(ICURR)="CRT" - ICURR=ICURR+1 - ENDIF - IF(LREFR) THEN - YRAD(ICURR)="RFR" - ICURR=ICURR+1 - END IF - IF(LDNDZ) THEN - YRAD(ICURR)="DNZ" - ICURR=ICURR+1 - END IF - IF (LCART_RAD) THEN - DO JI=1,NBRAD - IEL=NBELEV(JI) - ! writing latlon in internal files - ALLOCATE(CLATLON(2*NMAX)) - CLATLON="" - DO JV=2*NMAX,1,-1 - DO JH=1,2*NMAX - WRITE(CBUFFER,'(2(f8.3,1X))') ZWORK43(JI,2*JH-1,JV),ZWORK43(JI,2*JH,JV) - CLATLON(JV)=TRIM(CLATLON(JV)) // " " // TRIM(CBUFFER) - END DO - CLATLON(JV)=TRIM(ADJUSTL(CLATLON(JV))) - END DO - DO JEL=1,IEL - WRITE(YELEV,'(I2.2,A1,I1.1)') FLOOR(XELEV(JI,JEL)),'.',& - INT(ANINT(10.*XELEV(JI,JEL))-10*INT(XELEV(JI,JEL))) - WRITE(YGRID_SIZE,'(I3.3)') 2*NMAX - DO JJ=1,SIZE(ZWORK42(:,:,:,:,:),5) - YRS=YRAD(JJ)//CNAME_RAD(JI)(1:3)//YELEV//YGRID_SIZE//TRIM(TPFILE%CNAME) - CALL IO_File_add2list(TZRSFILE,YRS,'TXT','WRITE',KRECL=8192) - CALL IO_File_open(TZRSFILE,HSTATUS='NEW') - ILURS = TZRSFILE%NLU - WRITE(ILURS,'(A,4F12.6,2I5)') '**domaine LATLON ',ZWORK43(JI,1,1),ZWORK43(JI,4*NMAX-1,2*NMAX), & - ZWORK43(JI,2,1),ZWORK43(JI,4*NMAX,2*NMAX),2*NMAX,2*NMAX !! HEADER - DO JV=2*NMAX,1,-1 - DO JH=1,2*NMAX - WRITE(ILURS,'(E11.5,1X)',ADVANCE='NO') ZWORK42(JI,JEL,JH,JV,JJ) - END DO - WRITE(ILURS,*) '' - END DO - - DO JV=2*NMAX,1,-1 - WRITE(ILURS,*) CLATLON(JV) - END DO - CALL IO_File_close(TZRSFILE) - TZRSFILE => NULL() - END DO - END DO - DEALLOCATE(CLATLON) - END DO - ELSE ! polar output - CALL MPI_ALLREDUCE(ZWORK42, ZWORK42_BIS, SIZE(ZWORK42), MNHREAL_MPI, MPI_MAX, NMNH_COMM_WORLD, IERR) - DO JI=1,NBRAD - IEL=NBELEV(JI) - DO JEL=1,IEL - WRITE(YELEV,'(I2.2,A1,I1.1)') FLOOR(XELEV(JI,JEL)),'.',& - INT(ANINT(10.*XELEV(JI,JEL))-10*INT(XELEV(JI,JEL))) - DO JJ=1,SIZE(ZWORK42(:,:,:,:,:),5) - YRS="P"//YRAD(JJ)//CNAME_RAD(JI)(1:3)//YELEV//TRIM(TPFILE%CNAME) - CALL IO_File_add2list(TZRSFILE,YRS,'TXT','WRITE') - CALL IO_File_open(TZRSFILE) - ILURS = TZRSFILE%NLU - DO JH=1,NBAZIM - DO JV=1,NBSTEPMAX+1 - WRITE(ILURS,"(F15.7)") ZWORK42_BIS(JI,JEL,JH,JV,JJ) - END DO - END DO - CALL IO_File_close(TZRSFILE) - TZRSFILE => NULL() - END DO - END DO - END DO - END IF !polar output - DEALLOCATE(ZWORK42,ZWORK43) - END IF -END IF -! -IF (LLIDAR) THEN - PRINT *,'CALL LIDAR/RADAR with TPFILE%CNAME =',TPFILE%CNAME - YVIEW=' ' - YVIEW=TRIM(CVIEW_LIDAR) - PRINT *,'CVIEW_LIDAR REQUESTED ',YVIEW - IF (YVIEW/='NADIR'.AND.YVIEW/='ZENIT') YVIEW='NADIR' - PRINT *,'CVIEW_LIDAR USED ',YVIEW - PRINT *,'XALT_LIDAR REQUESTED (m) ',XALT_LIDAR - PRINT *,'XWVL_LIDAR REQUESTED (m) ',XWVL_LIDAR - IF (XWVL_LIDAR==XUNDEF) XWVL_LIDAR=0.532E-6 - IF (XWVL_LIDAR<1.E-7.OR.XWVL_LIDAR>2.E-6) THEN - PRINT *,'CAUTION: THE XWVL_LIDAR REQUESTED IS OUTSIDE THE USUAL RANGE' - XWVL_LIDAR=0.532E-6 - ENDIF - PRINT *,'XWVL_LIDAR USED (m) ',XWVL_LIDAR -! - IF (LDUST) THEN - IACCMODE=MIN(2,NMODE_DST) - ALLOCATE(ZTMP1(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3), 1)) - ALLOCATE(ZTMP2(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3), 1)) - ALLOCATE(ZTMP3(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3), 1)) - ZTMP1(:,:,:,1)=ZN0_DST(:,:,:,IACCMODE) - ZTMP2(:,:,:,1)=ZRG_DST(:,:,:,IACCMODE) - ZTMP3(:,:,:,1)=ZSIG_DST(:,:,:,IACCMODE) - SELECT CASE ( CCLOUD ) - CASE('KESS''ICE3','ICE4') - CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, XCLDFR, & - XRT, ZWORK31, ZWORK32, & - PDSTC=ZTMP1, & - PDSTD=ZTMP2, & - PDSTS=ZTMP3) - CASE('C2R2') - CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, XCLDFR, & - XRT, ZWORK31, ZWORK32, & - PCT=XSVT(:,:,:,NSV_C2R2BEG+1:NSV_C2R2END), & - PDSTC=ZTMP1, & - PDSTD=ZTMP2, & - PDSTS=ZTMP3) - CASE('C3R5') - CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, XCLDFR, & - XRT, ZWORK31, ZWORK32, & - PCT=XSVT(:,:,:,NSV_C2R2BEG+1:NSV_C1R3END-1), & - PDSTC=ZTMP1, & - PDSTD=ZTMP2, & - PDSTS=ZTMP3) - CASE('LIMA') -! PCT(2) = droplets (3)=drops (4)=ice crystals - ALLOCATE(ZTMP4(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3), 4)) - ZTMP4(:,:,:,1)=0. - ZTMP4(:,:,:,2)=XSVT(:,:,:,NSV_LIMA_NC) - ZTMP4(:,:,:,3)=XSVT(:,:,:,NSV_LIMA_NR) - ZTMP4(:,:,:,4)=XSVT(:,:,:,NSV_LIMA_NI) -! - CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, XCLDFR,& - XRT, ZWORK31, ZWORK32, & - PCT=ZTMP4, & - PDSTC=ZTMP1, & - PDSTD=ZTMP2, & - PDSTS=ZTMP3) -! - END SELECT - ELSE - SELECT CASE ( CCLOUD ) - CASE('KESS','ICE3','ICE4') - CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, XCLDFR, & - XRT, ZWORK31, ZWORK32) - CASE('C2R2') - CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, XCLDFR, & - XRT, ZWORK31, ZWORK32, & - PCT=XSVT(:,:,:,NSV_C2R2BEG+1:NSV_C2R2END)) - CASE('C3R5') - CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, XCLDFR, & - XRT, ZWORK31, ZWORK32, & - PCT=XSVT(:,:,:,NSV_C2R2BEG+1:NSV_C1R3END-1)) - CASE('LIMA') -! PCT(2) = droplets (3)=drops (4)=ice crystals - ALLOCATE(ZTMP4(SIZE(XSVT,1), SIZE(XSVT,2), SIZE(XSVT,3), 4)) - ZTMP4(:,:,:,1)=0. - ZTMP4(:,:,:,2)=XSVT(:,:,:,NSV_LIMA_NC) - ZTMP4(:,:,:,3)=XSVT(:,:,:,NSV_LIMA_NR) - ZTMP4(:,:,:,4)=XSVT(:,:,:,NSV_LIMA_NI) -! - CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, XCLDFR,& - XRT, ZWORK31, ZWORK32, & - PCT=ZTMP4) - END SELECT - ENDIF -! - IF( ALLOCATED(ZTMP1) ) DEALLOCATE(ZTMP1) - IF( ALLOCATED(ZTMP2) ) DEALLOCATE(ZTMP2) - IF( ALLOCATED(ZTMP3) ) DEALLOCATE(ZTMP3) - IF( ALLOCATED(ZTMP4) ) DEALLOCATE(ZTMP4) -! - TZFIELD%CMNHNAME = 'LIDAR' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'LIDAR' - TZFIELD%CUNITS = 'm-1 sr-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_Normalized_Lidar_Profile' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31) -! - TZFIELD%CMNHNAME = 'LIPAR' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'LIPAR' - TZFIELD%CUNITS = 'm-1 sr-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_Particle_Lidar_Profile' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK32) -! -END IF -! -!------------------------------------------------------------------------------- -! -!* Height of boundary layer -! -IF (CBLTOP == 'THETA') THEN - ! - ! méthode de la parcelle - ! - ALLOCATE(ZSHMIX(IIU,IJU)) - - ZWORK31(:,:,1:IKU-1)=0.5*(XZZ(:,:,1:IKU-1)+XZZ(:,:,2:IKU)) - ZWORK31(:,:,IKU)=2.*ZWORK31(:,:,IKU-1)-ZWORK31(:,:,IKU-2) - ZWORK21(:,:) = ZTHETAV(:,:,IKB)+0.5 - ZSHMIX(:,:) = 0.0 - DO JJ=1,IJU - DO JI=1,IIU - DO JK=IKB,IKE - IF ( ZTHETAV(JI,JJ,JK).GT.ZWORK21(JI,JJ) ) THEN - ZSHMIX(JI,JJ) = ZWORK31(JI,JJ,JK-1) & - +( ZWORK31(JI,JJ,JK) - ZWORK31 (JI,JJ,JK-1) ) & - /( ZTHETAV(JI,JJ,JK) - ZTHETAV(JI,JJ,JK-1) ) & - *( ZWORK21(JI,JJ) - ZTHETAV(JI,JJ,JK-1) ) - EXIT - END IF - END DO - END DO - END DO - ZSHMIX(:,:)=ZSHMIX(:,:)-XZS(:,:) - ZSHMIX(:,:)=MAX(ZSHMIX(:,:),50.0) - ! - TZFIELD%CMNHNAME = 'HBLTOP' - TZFIELD%CSTDNAME = 'atmosphere_boundary_layer_thickness' - TZFIELD%CLONGNAME = 'HBLTOP' - TZFIELD%CUNITS = 'm' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'Height of Boundary Layer TOP' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZSHMIX) - ! - DEALLOCATE(ZSHMIX) -ELSEIF (CBLTOP == 'RICHA') THEN - ! - ! méthode du "bulk Richardson number" - ! - ALLOCATE(ZRIB(IIU,IJU,IKU)) - ALLOCATE(ZSHMIX(IIU,IJU)) - - ZWORK31(:,:,1:IKU-1)=0.5*(XZZ(:,:,1:IKU-1)+XZZ(:,:,2:IKU)) - ZWORK31(:,:,IKU)=2.*ZWORK31(:,:,IKU-1)-ZWORK31(:,:,IKU-2) - ZWORK32=MXF(XUT) - ZWORK33=MYF(XVT) - ZWORK34=ZWORK32**2+ZWORK33**2 - DO JK=IKB,IKE - ZRIB(:,:,JK)=XG*ZWORK31(:,:,JK)*(ZTHETAV(:,:,JK)-ZTHETAV(:,:,IKB))/(ZTHETAV(:,:,IKB)*ZWORK34(:,:,JK)) - ENDDO - ZSHMIX=0.0 - DO JJ=1,IJU - DO JI=1,IIU - DO JK=IKB,IKE - IF ( ZRIB(JI,JJ,JK).GT.0.25 ) THEN - ZSHMIX(JI,JJ) = ZWORK31(JI,JJ,JK-1) & - +( ZWORK31(JI,JJ,JK) - ZWORK31(JI,JJ,JK-1) ) & - *( 0.25 - ZRIB(JI,JJ,JK-1) ) & - /( ZRIB(JI,JJ,JK) - ZRIB(JI,JJ,JK-1) ) - EXIT - END IF - END DO - END DO - END DO - ZSHMIX(:,:)=ZSHMIX(:,:)-XZS(:,:) - ! - TZFIELD%CMNHNAME = 'HBLTOP' - TZFIELD%CSTDNAME = 'atmosphere_boundary_layer_thickness' - TZFIELD%CLONGNAME = 'HBLTOP' - TZFIELD%CUNITS = 'm' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'Height of Boundary Layer TOP' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZSHMIX) - ! - DEALLOCATE(ZRIB,ZSHMIX) -ENDIF - ! used before 5-3-1 version - ! - !ZGAMREF=3.5E-3 ! K/m - !ZWORK31(:,:,1:IKU-1)=0.5*(XZZ(:,:,1:IKU-1)+XZZ(:,:,2:IKU)) - !ZWORK31(:,:,IKU)=2.*ZWORK31(:,:,IKU-1)-ZWORK31(:,:,IKU-2) - !CALL FREE_ATM_PROFILE(ZTHETAV,ZWORK31,XZS,XZSMT,ZGAMREF,ZWORK32,ZWORK33) -! -IF (ALLOCATED(ZTHETAV)) DEALLOCATE(ZTHETAV) -! -! -!* Ligthning -! -IF ( LCH_CONV_LINOX ) THEN - CALL IO_Field_write(TPFILE,'IC_RATE', XIC_RATE) - CALL IO_Field_write(TPFILE,'CG_RATE', XCG_RATE) - CALL IO_Field_write(TPFILE,'IC_TOTAL_NB',XIC_TOTAL_NUMBER) - CALL IO_Field_write(TPFILE,'CG_TOTAL_NB',XCG_TOTAL_NUMBER) -END IF -!------------------------------------------------------------------------------- -!------------------------------------------------------------------------------- -! -!* 1.8 My own variables : -! -!------------------------------------------------------------------------------- -!------------------------------------------------------------------------------- -! -!------------------------------------------------------------------------------- -END SUBROUTINE WRITE_LFIFM1_FOR_DIAG diff --git a/src/ICCARE_BASE/write_lfin.f90 b/src/ICCARE_BASE/write_lfin.f90 deleted file mode 100644 index 36d37ac65..000000000 --- a/src/ICCARE_BASE/write_lfin.f90 +++ /dev/null @@ -1,2600 +0,0 @@ -!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier -!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!MNH_LIC for details. version 1. -!----------------------------------------------------------------- -! ######################### - MODULE MODI_WRITE_LFIFM_n -! ######################### -! -INTERFACE -! -SUBROUTINE WRITE_LFIFM_n(TPFILE,HDADFILE) -! -USE MODD_IO, ONLY: TFILEDATA -! -IMPLICIT NONE -! -TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File characteristics -CHARACTER(LEN=*),INTENT(IN) :: HDADFILE ! Corresponding FM-file name of its DAD model -END SUBROUTINE WRITE_LFIFM_n -! -END INTERFACE -! -END MODULE MODI_WRITE_LFIFM_n -! -! -! ########################################## - SUBROUTINE WRITE_LFIFM_n(TPFILE,HDADFILE) -! ########################################## -! -!!**** *WRITE_LFIFM_n* - routine to write a LFIFM file for model $n -!! -!! PURPOSE -!! ------- -! The purpose of this routine is to write an initial LFIFM File -! of name YFMFILE//'.lfi' with the FM routines. -! -!!** METHOD -!! ------ -!! The data are written in the LFIFM file : -!! - dimensions -!! - grid variables -!! - configuration variables -!! - prognostic variables at time t and t-dt -!! - 1D anelastic reference state -!! -!! The localization on the model grid is also indicated : -!! -!! IGRID = 1 for mass grid point -!! IGRID = 2 for U grid point -!! IGRID = 3 for V grid point -!! IGRID = 4 for w grid point -!! IGRID = 0 for meaningless case -!! -!! -!! EXTERNAL -!! -------- -!! WRITE_BALLOON_n : routine to write balloon records -!! WRITE_LB_n : routine to write LB fields -!! FMWRIT : FM-routine to write a record -!! -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! Module MODD_DIM_n : contains dimensions -!! Module MODD_TIME : contains time variables for all models -!! Module MODD_TIME_n : contains time variables -!! Module MODD_GRID : contains spatial grid variables for all models -!! Module MODD_GRID_n : contains spatial grid variables -!! Module MODD_REF : contains reference state variables -!! Module MODD_LUNIT_n: contains logical unit variables. -!! Module MODD_CONF : contains configuration variables for all models -!! Module MODD_CONF_n : contains configuration variables -!! Module MODD_FIELD_n : contains prognostic variables -!! Module MODD_GR_FIELD_n : contains surface prognostic variables -!! Module MODD_LSFIELD_n : contains Larger Scale variables -!! Module MODD_PARAM_n : contains parameterization options -!! Module MODD_TURB_n : contains turbulence options -!! Module MODD_FRC : contains forcing variables -!! Module MODD_DEEP_CONVECTION_n : contains deep convection tendencies -!! Module MODD_PARAM_KAFR_n : contains configuration -!! Module MODD_AIRCRAFT_BALLOON : contains balloon and aircraft variables -!! -!! REFERENCE -!! --------- -!! -!! -!! AUTHOR -!! ------ -!! V. Ducrocq *Meteo France* -!! -!! MODIFICATIONS -!! ------------- -!! Original 06/05/94 -!! V. Ducrocq 27/06/94 -!! J.Stein 20/10/94 (name of the FMFILE) -!! J.Stein 06/12/94 add the LS fields -!! J.P. Lafore 09/01/95 add the DRYMASST -!! J.Stein 20/01/95 add TKE and change the ycomment for the water -!! variables -!! J.Stein 23/01/95 add a TKE switch and MODD_PARAM_n -!! J.Stein 16/03/95 remove R from the historical variables -!! J.Stein 20/03/95 add the EPS var. -!! J.Stein 30/06/95 add the variables related to the subgrid condens -!! S. Belair 01/09/95 add surface variables and ground parameters -!! J.-P. Pinty 15/09/95 add the radiation parameters -!! J.Stein 23/01/96 add the TSZ0 option for the surface scheme -!! M.Georgelin 13/12/95 add the forcing variables -!! J.-P. Pinty 15/02/96 add external control for the forcing -!! J.Stein P.Bougeault 15/03/96 add the cloud fraction and change the -!! surface parameters for TSZ0 option -!! J.Stein P.Jabouille 30/04/96 add the storage type -!! J.Stein P.Jabouille 20/05/96 switch for XSIGS and XSRC -!! J.Stein 10/10/96 change Xsrc into XSRCM and XRCT -!! J.P. Lafore 30/07/96 add YFMFILE and HDADFILE writing -!! corresponding to MY_NAME and DAD_NAME (for nesting) -!! V.Masson 08/10/96 add LTHINSHELL -!! J.-P. Pinty 15/12/96 add the microphysics (ice) -!! J.-P. Pinty 11/01/97 add the deep convection -!! J.-P. Pinty 27/01/97 split the recording of the SV array -!! J.-P. Pinty 29/01/97 set recording of PRCONV and PACCONV in mm/h and -!! mm respectively -!! J. Viviand 04/02/97 convert precipitation rates in mm/h -!! J.P. Lafore 25/11/96 resolution ratio and position for nesting -!! J.P. Lafore 26/02/97 adding of "surfacic" LS fields -!! J.Stein 22/06/97 use the absolute pressure -!! V.Masson 09/07/97 add directional z0 and Subgrid-Scale Orography -!! V.Masson 18/08/97 call to fmwrit directly with dates and strings -!! J.Stein 22/10/97 add the LB fields for U,V,W, THETA, RV.... -!! P.Bechtold 24/01/98 add convective tracer tendencies -!! P.Jabouille 15/10/98 // -!! P.Jabouille 25/05/99 replace 'DTRAD_CLONLY' by 'DTRAD_CLLY' (size too long) -!! J. Stein 20/05/98 remove NXEND and NYEND -!! V. Masson 04/01/00 remove TSZ0 option -!! P. Jabouille 03/04/00 write XCIT only for MESONH program -!! K. Suhre 03/12/99 add chemical variable names -! F.solmon /V.Masson 06/00 adapt for patch surface variables -!! D.Gazen 22/01/01 use MODD_NSV and add names to scalar variables -!! G.Jaubert 06/06/01 add Balloon current positions -!! P.Jabouille 10/04/02 extra radiative surface flux -!! J.-P. Pinty 29/11/02 add C3R5, ICE2, ICE4, CELEC -!! V. Masson 01/2004 removes surface (externalization) -!! 05/2006 Remove KEPS -!! J. escobar 02/09/2009 missing YDIR for CLDFR variable -!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after -!! change of YCOMMENT -!! P. Aumond 12/2009 Mean_UM,... -!! M. Leriche 16/07/10 add ice phase chemical species -!! C. Barthe Jan. 2011 add diagnostics for elec -!! J. Escobar Feb. 2012 replace MINVAL/MAXVAL by MIN_ll/MAX_ll in OUTPUT_LISTING -!! P.Peyrille 06/12 2D west african monsoon: ADV forcing and fluxes writing -!! AEROSOLS and ozone vertical distribution are also written -!! M.Tomasini 06/12 2D west african monsoon: nesting for ADV forcing writing -!! Pialat/Tulet 15/02/2012 add ForeFire variables -!! J. Escobar Mars 2014 , missing YDIR="XY" in 1.6 for tendencies fields -!! J.escobar & M.Leriche 23/06/2014 Pb with JSA increment versus ini_nsv order initialization -!! P. Tulet Nov 2014 accumulated moles of aqueous species that fall at the surface -!! M.Faivre 2014 -!! C.Lac Dec.2014 writing past wind fields for centred advection -!! J.-P. Pinty Jan 2015 add LNOx and flash map diagnostics -!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1 -!! P. Tulet & M. Leriche Nov 2015 add mean pH value in the rain at the surface -!! J.escobar 04/08/2015 suit Pb with writ_lfin JSA increment , modif in ini_nsv to have good order initialization -!! Modification 01/2016 (JP Pinty) Add LIMA -!! M.Mazoyer 04/16 : Add supersaturation fields -! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O -! P. Wautelet 11/07/2016: remove MNH_NCWRIT define -! V. Vionnet 07/2017: add blowing snow variables -! JP Chaboureau 27/11/2017: add wind tendency forcing -! Q. Libois 02/2018: move Diagnostic related to the radiations in radiations.f90 -! P. Wautelet 11/01/2019: bug correction in write XBL_DEPTH->XSBL_DEPTH -! C. Lac 18/02/2019: add rain fraction as an output field -! S. Bielli 02/2019: Sea salt: significant sea wave height influences salt emission; 5 salt modes -! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg -! P. Tulet 02/2020: correction for dust and sea salts -!! B. Vie 06/2020 Add prognostic supersaturation for LIMA -! PA. Joulin 12/2020: add wind turbine outputs -! F. Auguste 02/2021: add IBM -! T. Nagel 02/2021: add turbulence recycling -! P. Wautelet 10/03/2021: use scalar variable names for dust and salt -! P. Wautelet 11/03/2021: bugfix: correct name for NSV_LIMA_IMM_NUCL -! J.L. Redelsperger 03/2021: add OCEAN and auto-coupled O-A LES cases -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_DIM_n -USE MODD_CONF -USE MODD_CONF_n -use modd_field, only: tfielddata, tfieldlist, TYPEDATE, TYPEINT, TYPELOG, TYPEREAL -USE MODD_GRID -USE MODD_GRID_n -USE MODD_TIME -USE MODD_TIME_n -USE MODD_FIELD_n -USE MODD_MEAN_FIELD_n -USE MODD_DUMMY_GR_FIELD_n -USE MODD_LSFIELD_n -USE MODD_DYN_n -USE MODD_PARAM_n -USE MODD_REF -USE MODD_LUNIT_n -USE MODD_TURB_n -USE MODD_RADIATIONS_n, ONLY : XDTHRAD, NCLEARCOL_TM1, XFLALWD, & - XZENITH, XDIR_ALB, XSCA_ALB, XEMIS, XTSRAD, & - XDIRSRFSWD, XSCAFLASWD, XDIRFLASWD, XAZIM -USE MODD_REF_n, ONLY : XRHODREF -USE MODD_FRC -USE MODD_PRECIP_n -USE MODD_ELEC_n -USE MODD_CST -USE MODD_CLOUDPAR -USE MODD_DEEP_CONVECTION_n -USE MODD_PARAM_KAFR_n -USE MODD_NESTING -USE MODD_PARAMETERS -USE MODD_GR_FIELD_n -USE MODD_CH_MNHC_n, ONLY: LUSECHEM,LCH_CONV_LINOX, & - LUSECHAQ,LUSECHIC,LCH_PH, XCH_PHINIT -USE MODD_CH_PH_n -USE MODD_CH_M9_n -USE MODD_RAIN_C2R2_DESCR, ONLY: C2R2NAMES -USE MODD_ICE_C1R3_DESCR, ONLY: C1R3NAMES -USE MODD_ELEC_DESCR, ONLY: CELECNAMES, LLNOX_EXPLICIT -USE MODD_LG, ONLY: CLGNAMES -USE MODD_NSV -USE MODD_AIRCRAFT_BALLOON -USE MODD_HURR_CONF, ONLY: LFILTERING,CFILTERING,NDIAG_FILT -USE MODD_HURR_FIELD_n -USE MODD_PREP_REAL, ONLY: CDUMMY_2D, XDUMMY_2D -USE MODD_DUST -USE MODD_SALT -USE MODD_OCEANH -USE MODD_PASPOL -#ifdef MNH_FOREFIRE -USE MODD_FOREFIRE -#endif -USE MODD_CONDSAMP -USE MODD_CH_AEROSOL -USE MODD_CH_AERO_n -USE MODE_AERO_PSD -USE MODD_BLOWSNOW -USE MODD_BLOWSNOW_n -USE MODD_PAST_FIELD_n -USE MODD_ADV_n, ONLY: CUVW_ADV_SCHEME,XRTKEMS,CTEMP_SCHEME,LSPLIT_CFL -USE MODD_ELEC_FLASH -! -USE MODD_PARAM_LIMA , ONLY: NMOD_CCN, LSCAV, LAERO_MASS, & - NMOD_IFN, NMOD_IMM, NINDICE_CCN_IMM, LHHONI -USE MODD_PARAM_LIMA_WARM, ONLY: CLIMA_WARM_NAMES, CAERO_MASS -USE MODD_PARAM_LIMA_COLD, ONLY: CLIMA_COLD_NAMES -USE MODD_LIMA_PRECIP_SCAVENGING_n -! -USE MODE_IO_FILE, only: IO_File_close -USE MODE_IO_FIELD_WRITE, only: IO_Field_write -USE MODE_ll -USE MODD_IO, ONLY: TFILEDATA -use mode_field, only: Find_field_id_from_mnhname -USE MODE_GATHER_ll -USE MODE_GRIDPROJ -USE MODE_MSG -USE MODE_MODELN_HANDLER -USE MODE_TOOLS, ONLY: UPCASE -! -USE MODI_WRITE_LB_n -USE MODI_WRITE_BALLOON_n -USE MODI_DUSTLFI_n -USE MODI_SALTLFI_n -USE MODI_CH_AER_REALLFI_n -USE MODI_SALT_FILTER -USE MODI_DUST_FILTER -! -!20131128 -USE MODE_MPPDB -USE MODE_EXTRAPOL -! Modif Eddy fluxes -USE MODD_DEF_EDDY_FLUX_n ! Ajout PP -USE MODD_DEF_EDDYUV_FLUX_n ! Ajout PP -USE MODD_LATZ_EDFLX ! Ajout PP -! -USE MODD_2D_FRC ! Ajout PP -USE MODD_ADVFRC_n ! Modif PP ADV FRC -USE MODD_RELFRC_n -! -USE MODD_PARAM_C2R2 -! -USE MODD_EOL_MAIN -USE MODD_EOL_SHARED_IO -USE MODD_EOL_ADNR -USE MODD_EOL_ALM -! -USE MODD_RECYCL_PARAM_n -USE MODD_IBM_PARAM_n, ONLY: LIBM, XIBM_LS -USE MODD_IBM_LSF, ONLY: LIBM_LSF -! -IMPLICIT NONE -! -!* 0.1 Declarations of arguments -! -TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File characteristics -CHARACTER(LEN=*),INTENT(IN) :: HDADFILE ! Corresponding FM-file name of its DAD model -! -!* 0.2 Declarations of local variables -! -INTEGER :: ILUOUT ! logical unit -INTEGER :: IRESP ! IRESP : return-code if a problem appears - !in LFI subroutines at the open of the file -! -INTEGER :: JSV ! loop index for scalar variables -INTEGER :: JSA ! beginning of chemical-aerosol variables - -! -CHARACTER(LEN=3) :: YFRC ! to mark the time of the forcing -INTEGER :: JT ! loop index -! -REAL,DIMENSION(:,:), ALLOCATABLE :: ZWORK2D ! Working array -REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZWORK3D ! Working array -! -REAL :: ZLATOR, ZLONOR ! geographical coordinates of 1st mass point -REAL :: ZXHATM, ZYHATM ! conformal coordinates of 1st mass point -REAL, DIMENSION(:), ALLOCATABLE :: ZXHAT_ll ! Position x in the conformal - ! plane (array on the complete domain) -REAL, DIMENSION(:), ALLOCATABLE :: ZYHAT_ll ! Position y in the conformal - ! plane (array on the complete domain) -INTEGER :: IMI ! Current model index -! -INTEGER :: ICH_NBR ! to write number and names of scalar -INTEGER,DIMENSION(:),ALLOCATABLE :: ICH_NAMES !(chem+aero+dust) variables -CHARACTER(LEN=NMNHNAMELGTMAX),DIMENSION(:),ALLOCATABLE :: YDSTNAMES,YCHNAMES, YSLTNAMES -INTEGER :: ILREC,ILENG !in NSV.DIM and NSV.TITRE -INTEGER :: INFO_ll -INTEGER :: IKRAD -INTEGER :: JI,JJ,JK ! loop index -INTEGER :: IIU,IJU,IKU,IIB,IJB,IKB,IIE,IJE,IKE ! Arrays bounds -! -CHARACTER(LEN=2) :: INDICE -INTEGER :: IID -TYPE(TFIELDDATA) :: TZFIELD -!------------------------------------------------------------------------------- -! -!* 0. Initialization -! -IMI = GET_CURRENT_MODEL_INDEX() -! -ILUOUT=TLUOUT%NLU -! -ALLOCATE(ZWORK2D(SIZE(XTHT,1),SIZE(XTHT,2))) -ALLOCATE(ZWORK3D(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3))) -! -!* 0.2 ARRAYS BOUNDS INITIALIZATION -! -IIU=NIMAX+2*JPHEXT -IJU=NJMAX+2*JPHEXT -IKU=NKMAX+2*JPVEXT -CALL GET_INDICE_ll (IIB,IJB,IIE,IJE) -IKB=1+JPVEXT -IKE=IKU-JPVEXT -! -!* 1. WRITES IN THE LFI FILE -! -! -!* 1.0 File and HDADFILE writing : -! -CALL IO_Field_write(TPFILE,'FILETYPE',TPFILE%CTYPE) -! -IF (LEN_TRIM(HDADFILE)>0) THEN - CALL IO_Field_write(TPFILE,'DXRATIO',NDXRATIO_ALL(IMI)) - CALL IO_Field_write(TPFILE,'DYRATIO',NDYRATIO_ALL(IMI)) - CALL IO_Field_write(TPFILE,'XOR', NXOR_ALL(IMI)) - CALL IO_Field_write(TPFILE,'YOR', NYOR_ALL(IMI)) -END IF -! -!* 1.1 Type and Dimensions : -! -CALL IO_Field_write(TPFILE,'IMAX',NIMAX_ll) -CALL IO_Field_write(TPFILE,'JMAX',NJMAX_ll) -CALL IO_Field_write(TPFILE,'KMAX',NKMAX) -! -CALL IO_Field_write(TPFILE,'JPHEXT',JPHEXT) -! -!* 1.2 Grid variables : -! -IF (.NOT.LCARTESIAN) THEN - CALL IO_Field_write(TPFILE,'RPK', XRPK) - CALL IO_Field_write(TPFILE,'LONORI',XLONORI) - CALL IO_Field_write(TPFILE,'LATORI',XLATORI) -! -!* diagnostic of 1st mass point -! - ALLOCATE(ZXHAT_ll(NIMAX_ll+ 2 * JPHEXT),ZYHAT_ll(NJMAX_ll+2 * JPHEXT)) - CALL GATHERALL_FIELD_ll('XX',XXHAT,ZXHAT_ll,IRESP) !// - CALL GATHERALL_FIELD_ll('YY',XYHAT,ZYHAT_ll,IRESP) !// - ZXHATM = 0.5 * (ZXHAT_ll(1)+ZXHAT_ll(2)) - ZYHATM = 0.5 * (ZYHAT_ll(1)+ZYHAT_ll(2)) - CALL SM_LATLON(XLATORI,XLONORI,ZXHATM,ZYHATM,ZLATOR,ZLONOR) - DEALLOCATE(ZXHAT_ll,ZYHAT_ll) -! - CALL IO_Field_write(TPFILE,'LONOR',ZLONOR) - CALL IO_Field_write(TPFILE,'LATOR',ZLATOR) -END IF -! -CALL IO_Field_write(TPFILE,'THINSHELL',LTHINSHELL) -CALL IO_Field_write(TPFILE,'LAT0',XLAT0) -CALL IO_Field_write(TPFILE,'LON0',XLON0) -CALL IO_Field_write(TPFILE,'BETA',XBETA) -! -CALL IO_Field_write(TPFILE,'XHAT',XXHAT) -CALL IO_Field_write(TPFILE,'YHAT',XYHAT) -CALL IO_Field_write(TPFILE,'ZHAT',XZHAT) -CALL IO_Field_write(TPFILE,'ZTOP',XZTOP) -! -IF (.NOT.LCARTESIAN) THEN - CALL IO_Field_write(TPFILE,'LAT',XLAT) - CALL IO_Field_write(TPFILE,'LON',XLON) -END IF -! -CALL IO_Field_write(TPFILE,'ZS', XZS) -IF(ASSOCIATED(XZWS)) THEN - CALL IO_Field_write(TPFILE,'ZWS', XZWS) -END IF -CALL IO_Field_write(TPFILE,'ZSMT', XZSMT) -CALL IO_Field_write(TPFILE,'SLEVE',LSLEVE) -! -IF (LSLEVE) THEN - CALL IO_Field_write(TPFILE,'LEN1',XLEN1) - CALL IO_Field_write(TPFILE,'LEN2',XLEN2) -END IF -! -! -CALL IO_Field_write(TPFILE,'DTMOD',TDTMOD) -CALL IO_Field_write(TPFILE,'DTCUR',TDTCUR) -CALL IO_Field_write(TPFILE,'DTEXP',TDTEXP) -CALL IO_Field_write(TPFILE,'DTSEG',TDTSEG) -! -!* 1.3 Configuration variables : -! -CALL IO_Field_write(TPFILE,'L1D', L1D) -CALL IO_Field_write(TPFILE,'L2D', L2D) -CALL IO_Field_write(TPFILE,'PACK', LPACK) -CALL IO_Field_write(TPFILE,'CARTESIAN',LCARTESIAN) -CALL IO_Field_write(TPFILE,'LBOUSS', LBOUSS) -CALL IO_Field_write(TPFILE,'LOCEAN', LOCEAN) -CALL IO_Field_write(TPFILE,'LCOUPLES', LCOUPLES) -! -CALL IO_Field_write(TPFILE,'SURF', CSURF) -CALL IO_Field_write(TPFILE,'CPL_AROME',LCPL_AROME) -CALL IO_Field_write(TPFILE,'COUPLING', LCOUPLING) -! -TZFIELD%CMNHNAME = 'RECYCLING' -TZFIELD%CLONGNAME = 'RECYCLING' -TZFIELD%CSTDNAME = '' -TZFIELD%CUNITS = '' -TZFIELD%CDIR = '--' -TZFIELD%NGRID = 1 -TZFIELD%NTYPE = TYPELOG -TZFIELD%NDIMS = 0 -TZFIELD%LTIMEDEP = .FALSE. -CALL IO_Field_write(TPFILE,TZFIELD,LRECYCL) -! -!* 1.4 Prognostic variables : -! -! -!* 1.4.1 Time t: -! -!20131128 check XUT-> X_Y_W_U wind component for PRC -! CALL EXTRAPOL('W',XUT) -! CALL EXTRAPOL('E',XUT) -! CALL EXTRAPOL('N',XUT) -! CALL EXTRAPOL('S',XUT) -CALL MPPDB_CHECK3D(XUT,"write_lfifmn before IO_Field_write::XUT",PRECISION) -CALL IO_Field_write(TPFILE,'UT',XUT) -CALL MPPDB_CHECK3D(XUT,"write_lfifmn after IO_Field_write::XUT",PRECISION) -! -!20131128 check XVT-> X_Y_W_V wind component for PRC -CALL MPPDB_CHECK3D(XVT,"write_lfifmn::XVT",PRECISION) -! -CALL IO_Field_write(TPFILE,'VT',XVT) -CALL IO_Field_write(TPFILE,'WT',XWT) -! -CALL IO_Field_write(TPFILE,'THT',XTHT) -! -!* 1.4.2 Time t-dt: -! -IF ( (CUVW_ADV_SCHEME == 'CEN4TH') .AND. (CTEMP_SCHEME == 'LEFR') ) THEN - CALL IO_Field_write(TPFILE,'UM', XUM) - CALL IO_Field_write(TPFILE,'VM', XVM) - CALL IO_Field_write(TPFILE,'WM', XWM) - CALL IO_Field_write(TPFILE,'DUM',XDUM) - CALL IO_Field_write(TPFILE,'DVM',XDVM) - CALL IO_Field_write(TPFILE,'DWM',XDWM) -END IF -! -IF (LIBM .OR. LIBM_LSF) THEN - ! - TZFIELD%CMNHNAME = 'LSFP' - TZFIELD%CLONGNAME = 'LSFP' - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - TZFIELD%CCOMMENT = 'Level Set Function at mass node' - ! - CALL IO_Field_write(TPFILE,TZFIELD,XIBM_LS(:,:,:,1)) - ! -ENDIF -! -IF (LRECYCL) THEN - ! - TZFIELD%CMNHNAME = 'RCOUNT' - TZFIELD%CLONGNAME = 'RCOUNT' - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = '' - TZFIELD%CDIR = '--' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEINT - TZFIELD%NDIMS = 0 - TZFIELD%LTIMEDEP = .TRUE. - TZFIELD%CCOMMENT = 'Incremental counter for averaging purpose' - CALL IO_Field_write(TPFILE,TZFIELD,NR_COUNT) - ! - IF (LRECYCLW) THEN - TZFIELD%CMNHNAME = 'URECYCLW' - TZFIELD%CLONGNAME = 'URECYCLW' - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 2 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - TZFIELD%CCOMMENT = 'UMEAN-WEST side plan for recycling purpose' - ! - CALL IO_Field_write(TPFILE,TZFIELD,XUMEANW(:,:,:)) - ! - TZFIELD%CMNHNAME = 'VRECYCLW' - TZFIELD%CLONGNAME = 'VRECYCLW' - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 3 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - TZFIELD%CCOMMENT = 'VMEAN-WEST side plan for recycling purpose' - ! - CALL IO_Field_write(TPFILE,TZFIELD,XVMEANW(:,:,:)) - ! - TZFIELD%CMNHNAME = 'WRECYCLW' - TZFIELD%CLONGNAME = 'WRECYCLW' - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 4 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - TZFIELD%CCOMMENT = 'WMEAN-WEST side plan for recycling purpose' - ! - CALL IO_Field_write(TPFILE,TZFIELD,XWMEANW(:,:,:)) - ! - ENDIF - IF (LRECYCLN) THEN - TZFIELD%CMNHNAME = 'URECYCLN' - TZFIELD%CLONGNAME = 'URECYCLN' - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 2 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - TZFIELD%CCOMMENT = 'UMEAN-NORTH side plan for recycling purpose' - ! - CALL IO_Field_write(TPFILE,TZFIELD,XUMEANN(:,:,:)) - ! - TZFIELD%CMNHNAME = 'VRECYCLN' - TZFIELD%CLONGNAME = 'VRECYCLN' - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 3 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - TZFIELD%CCOMMENT = 'VMEAN-NORTH side plan for recycling purpose' - ! - CALL IO_Field_write(TPFILE,TZFIELD,XVMEANN(:,:,:)) - ! - TZFIELD%CMNHNAME = 'WRECYCLN' - TZFIELD%CLONGNAME = 'WRECYCLN' - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 4 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - TZFIELD%CCOMMENT = 'WMEAN-NORTH side plan for recycling purpose' - ! - CALL IO_Field_write(TPFILE,TZFIELD,XWMEANN(:,:,:)) - ! - ENDIF - IF (LRECYCLE) THEN - TZFIELD%CMNHNAME = 'URECYCLE' - TZFIELD%CLONGNAME = 'URECYCLE' - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 2 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - TZFIELD%CCOMMENT = 'UMEAN-EAST side plan for recycling purpose' - ! - CALL IO_Field_write(TPFILE,TZFIELD,XUMEANE(:,:,:)) - ! - TZFIELD%CMNHNAME = 'VRECYCLE' - TZFIELD%CLONGNAME = 'VRECYCLE' - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 3 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - TZFIELD%CCOMMENT = 'VMEAN-EAST side plan for recycling purpose' - ! - CALL IO_Field_write(TPFILE,TZFIELD,XVMEANE(:,:,:)) - ! - TZFIELD%CMNHNAME = 'WRECYCLE' - TZFIELD%CLONGNAME = 'WRECYCLE' - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 4 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - TZFIELD%CCOMMENT = 'WMEAN-EAST side plan for recycling purpose' - ! - CALL IO_Field_write(TPFILE,TZFIELD,XWMEANE(:,:,:)) - ! - ENDIF - IF (LRECYCLS) THEN - TZFIELD%CMNHNAME = 'URECYCLS' - TZFIELD%CLONGNAME = 'URECYCLS' - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 2 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - TZFIELD%CCOMMENT = 'UMEAN-SOUTH side plan for recycling purpose' - ! - CALL IO_Field_write(TPFILE,TZFIELD,XUMEANS(:,:,:)) - ! - TZFIELD%CMNHNAME = 'VRECYCLS' - TZFIELD%CLONGNAME = 'VRECYCLS' - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 3 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - TZFIELD%CCOMMENT = 'VMEAN-SOUTH side plan for recycling purpose' - ! - CALL IO_Field_write(TPFILE,TZFIELD,XVMEANS(:,:,:)) - ! - TZFIELD%CMNHNAME = 'WRECYCLS' - TZFIELD%CLONGNAME = 'WRECYCLS' - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 4 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - TZFIELD%CCOMMENT = 'WMEAN-SOUTH side plan for recycling purpose' - ! - ENDIF -ENDIF -! -IF (MEAN_COUNT /= 0) THEN -! - TZFIELD%CSTDNAME = '' - TZFIELD%CDIR = 'XY' - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. -! - TZFIELD%NGRID = 2 -! - TZFIELD%CMNHNAME = 'UMME' - TZFIELD%CLONGNAME = 'UMME' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CCOMMENT = 'X_Y_Z_U component of mean wind' - ZWORK3D = XUM_MEAN/MEAN_COUNT - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D) -! - TZFIELD%CMNHNAME = 'U2ME' - TZFIELD%CLONGNAME = 'U2ME' - TZFIELD%CUNITS = 'm2 s-2' - TZFIELD%CCOMMENT = 'X_Y_Z_U component of mean wind variance' - ZWORK3D = XU2_MEAN/MEAN_COUNT-XUM_MEAN**2/MEAN_COUNT**2 - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D) - ! - TZFIELD%CMNHNAME = 'UMMA' - TZFIELD%CLONGNAME = 'UMMA' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CCOMMENT = 'X_Y_Z_U component of max wind' - CALL IO_Field_write(TPFILE,TZFIELD,XUM_MAX) -! - TZFIELD%CMNHNAME = 'UWME' - TZFIELD%CLONGNAME = 'UWME' - TZFIELD%CUNITS = 'm2 s-2' - TZFIELD%CCOMMENT = 'X_Y_Z_UW component of mean wind variance' - ZWORK3D = XUW_MEAN/MEAN_COUNT-(XUM_MEAN*XWM_MEAN)/MEAN_COUNT**2 - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D) - ! - TZFIELD%NGRID = 3 -! - TZFIELD%CMNHNAME = 'VMME' - TZFIELD%CLONGNAME = 'VMME' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CCOMMENT = 'X_Y_Z_V component of mean wind' - ZWORK3D = XVM_MEAN/MEAN_COUNT - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D) -! - TZFIELD%CMNHNAME = 'V2ME' - TZFIELD%CLONGNAME = 'V2ME' - TZFIELD%CUNITS = 'm2 s-2' - TZFIELD%CCOMMENT = 'X_Y_Z_V component of mean wind variance' - ZWORK3D = XV2_MEAN/MEAN_COUNT-XVM_MEAN**2/MEAN_COUNT**2 - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D) - ! - TZFIELD%CMNHNAME = 'VMMA' - TZFIELD%CLONGNAME = 'VMMA' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CCOMMENT = 'X_Y_Z_V component of max wind' - CALL IO_Field_write(TPFILE,TZFIELD,XVM_MAX) -! - TZFIELD%NGRID = 4 -! - TZFIELD%CMNHNAME = 'WMME' - TZFIELD%CLONGNAME = 'WMME' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CCOMMENT = 'X_Y_Z_vertical mean wind' - ZWORK3D = XWM_MEAN/MEAN_COUNT - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D) -! - TZFIELD%CMNHNAME = 'W2ME' - TZFIELD%CLONGNAME = 'W2ME' - TZFIELD%CUNITS = 'm2 s-2' - TZFIELD%CCOMMENT = 'X_Y_Z_vertical mean wind variance' - ZWORK3D = XW2_MEAN/MEAN_COUNT-XWM_MEAN**2/MEAN_COUNT**2 - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D) - ! - TZFIELD%CMNHNAME = 'WMMA' - TZFIELD%CLONGNAME = 'WMMA' - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CCOMMENT = 'X_Y_Z_vertical max wind' - CALL IO_Field_write(TPFILE,TZFIELD,XWM_MAX) -! - TZFIELD%NGRID = 1 -! - TZFIELD%CMNHNAME = 'CMME' - TZFIELD%CLONGNAME = 'CMME' - TZFIELD%CUNITS = 'kg kg-1' - TZFIELD%CCOMMENT = 'mean Passive scalar' - ZWORK3D = XSVT_MEAN/MEAN_COUNT - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D) -! - TZFIELD%CMNHNAME = 'THMME' - TZFIELD%CLONGNAME = 'THMME' - TZFIELD%CUNITS = 'K' - TZFIELD%CCOMMENT = 'X_Y_Z_mean potential temperature' - ZWORK3D = XTHM_MEAN/MEAN_COUNT - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D) -! - TZFIELD%CMNHNAME = 'TH2ME' - TZFIELD%CLONGNAME = 'TH2ME' - TZFIELD%CUNITS = 'K2' - TZFIELD%CCOMMENT = 'X_Y_Z_mean potential temperature variance' - ZWORK3D = XTH2_MEAN/MEAN_COUNT-XTHM_MEAN**2/MEAN_COUNT**2 - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D) - ! - TZFIELD%CMNHNAME = 'THMMA' - TZFIELD%CLONGNAME = 'THMMA' - TZFIELD%CUNITS = 'K' - TZFIELD%CCOMMENT = 'X_Y_Z_max potential temperature' - CALL IO_Field_write(TPFILE,TZFIELD,XTHM_MAX) -! - TZFIELD%CMNHNAME = 'TEMPMME' - TZFIELD%CLONGNAME = 'TEMPMME' - TZFIELD%CUNITS = 'K' - TZFIELD%CCOMMENT = 'X_Y_Z_mean temperature' - ZWORK3D = XTEMPM_MEAN/MEAN_COUNT - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D) -! - TZFIELD%CMNHNAME = 'TEMP2ME' - TZFIELD%CLONGNAME = 'TEMP2ME' - TZFIELD%CUNITS = 'K2' - TZFIELD%CCOMMENT = 'X_Y_Z_mean temperature variance' - ZWORK3D = XTEMP2_MEAN/MEAN_COUNT-XTEMPM_MEAN**2/MEAN_COUNT**2 - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D) - ! - TZFIELD%CMNHNAME = 'TEMPMMA' - TZFIELD%CLONGNAME = 'TEMPMMA' - TZFIELD%CUNITS = 'K' - TZFIELD%CCOMMENT = 'X_Y_Z_max temperature' - CALL IO_Field_write(TPFILE,TZFIELD,XTEMPM_MAX) -! - TZFIELD%CMNHNAME = 'PABSMME' - TZFIELD%CLONGNAME = 'PABSMME' - TZFIELD%CUNITS = 'Pa' - TZFIELD%CCOMMENT = 'X_Y_Z_mean ABSolute Pressure' - ZWORK3D = XPABSM_MEAN/MEAN_COUNT - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D) -! - TZFIELD%CMNHNAME = 'PABS2ME' - TZFIELD%CLONGNAME = 'PABS2ME' - TZFIELD%CUNITS = 'Pa2' - TZFIELD%CCOMMENT = 'X_Y_Z_mean ABSolute Pressure variance' - ZWORK3D = XPABS2_MEAN/MEAN_COUNT-XPABSM_MEAN**2/MEAN_COUNT**2 - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D) - ! - TZFIELD%CMNHNAME = 'PABSMMA' - TZFIELD%CLONGNAME = 'PABSMMA' - TZFIELD%CUNITS = 'Pa' - TZFIELD%CCOMMENT = 'X_Y_Z_max ABSolute Pressure' - CALL IO_Field_write(TPFILE,TZFIELD,XPABSM_MAX) -! - IF (CTURB /= 'NONE') THEN - TZFIELD%CMNHNAME = 'TKEMME' - TZFIELD%CLONGNAME = 'TKEMME' - TZFIELD%CUNITS = 'm2 s-2' - TZFIELD%CCOMMENT = 'X_Y_Z_mean kinetic energy' - ZWORK3D= XTKEM_MEAN/MEAN_COUNT - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D) -! - TZFIELD%CMNHNAME = 'TKEMMA' - TZFIELD%CLONGNAME = 'TKEMMA' - TZFIELD%CUNITS = 'm2 s-2' - TZFIELD%CCOMMENT = 'X_Y_Z_max kinetic energy' - CALL IO_Field_write(TPFILE,TZFIELD,XTKEM_MAX) - END IF -! -END IF -! -! -IF (CTURB /= 'NONE') THEN - CALL IO_Field_write(TPFILE,'TKET',XTKET) - IF (CPROGRAM == 'MESONH' .AND. LSPLIT_CFL) CALL IO_Field_write(TPFILE,'TKEMS',XRTKEMS) -END IF -! -! -CALL IO_Field_write(TPFILE,'PABST',XPABST) -! -IF (NRR >=1) THEN - IF (LUSERV) CALL IO_Field_write(TPFILE,'RVT',XRT(:,:,:,IDX_RVT)) - IF (LUSERC) THEN - CALL IO_Field_write(TPFILE,'RCT',XRT(:,:,:,IDX_RCT)) - WRITE (ILUOUT,*) IDX_RCT,' RC min-max ',MIN_ll(XRT(:,:,:,IDX_RCT),INFO_ll),MAX_ll(XRT(:,:,:,IDX_RCT),INFO_ll) - END IF - IF (LUSERR) THEN - CALL IO_Field_write(TPFILE,'RRT',XRT(:,:,:,IDX_RRT)) - WRITE (ILUOUT,*) IDX_RRT,' RR min-max ',MIN_ll(XRT(:,:,:,IDX_RRT),INFO_ll),MAX_ll(XRT(:,:,:,IDX_RRT),INFO_ll) - END IF - IF (LUSERI) THEN - CALL IO_Field_write(TPFILE,'RIT',XRT(:,:,:,IDX_RIT)) - WRITE (ILUOUT,*) IDX_RIT,' RI min-max ',MIN_ll(XRT(:,:,:,IDX_RIT),INFO_ll),MAX_ll(XRT(:,:,:,IDX_RIT),INFO_ll) - IF ( CPROGRAM == 'MESONH' .AND. CCLOUD(1:3) == 'ICE') THEN - CALL IO_Field_write(TPFILE,'CIT',XCIT(:,:,:)) - END IF - END IF - IF (LUSERS) THEN - CALL IO_Field_write(TPFILE,'RST',XRT(:,:,:,IDX_RST)) - WRITE (ILUOUT,*) IDX_RST,' RS min-max ',MINVAL(XRT(:,:,:,IDX_RST)),MAXVAL(XRT(:,:,:,IDX_RST)) - END IF - IF (LUSERG) THEN - CALL IO_Field_write(TPFILE,'RGT',XRT(:,:,:,IDX_RGT)) - WRITE (ILUOUT,*) IDX_RGT,' RG min-max ',MINVAL(XRT(:,:,:,IDX_RGT)),MAXVAL(XRT(:,:,:,IDX_RGT)) - END IF - IF (LUSERH) CALL IO_Field_write(TPFILE,'RHT',XRT(:,:,:,IDX_RHT)) -END IF -! -IF (NSV >=1) THEN - JSA=0 - ! User scalar variables - IF (NSV_USER>0) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'kg kg-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = 1,NSV_USER - WRITE(TZFIELD%CMNHNAME,'(A3,I3.3)')'SVT',JSV - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME) - CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)) - JSA=JSA+1 - END DO - END IF - ! microphysical C2R2 scheme scalar variables - IF (NSV_C2R2END>=NSV_C2R2BEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm-3' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_C2R2BEG,NSV_C2R2END - TZFIELD%CMNHNAME = TRIM(C2R2NAMES(JSV-NSV_C2R2BEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)) - JSA=JSA+1 - END DO - END IF - ! microphysical C3R5 scheme additional scalar variables - IF (NSV_C1R3END>=NSV_C1R3BEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm-3' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_C1R3BEG,NSV_C1R3END - TZFIELD%CMNHNAME = TRIM(C1R3NAMES(JSV-NSV_C1R3BEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)) - JSA=JSA+1 - END DO - END IF -! -! microphysical LIMA variables -! - IF (NSV_LIMA_END>=NSV_LIMA_BEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - END IF - ! - DO JSV = NSV_LIMA_BEG,NSV_LIMA_END - ! - TZFIELD%CUNITS = 'kg-1' - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - ! -! Nc - IF (JSV .EQ. NSV_LIMA_NC) THEN - TZFIELD%CMNHNAME = TRIM(CLIMA_WARM_NAMES(1))//'T' - END IF -! Nr - IF (JSV .EQ. NSV_LIMA_NR) THEN - TZFIELD%CMNHNAME = TRIM(CLIMA_WARM_NAMES(2))//'T' - END IF -! N CCN free - IF (JSV .GE. NSV_LIMA_CCN_FREE .AND. JSV .LT. NSV_LIMA_CCN_ACTI) THEN - WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_CCN_FREE + 1) - TZFIELD%CMNHNAME = TRIM(CLIMA_WARM_NAMES(3))//INDICE//'T' - END IF -! N CCN acti - IF (JSV .GE. NSV_LIMA_CCN_ACTI .AND. JSV .LT. NSV_LIMA_CCN_ACTI + NMOD_CCN) THEN - WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_CCN_ACTI + 1) - TZFIELD%CMNHNAME = TRIM(CLIMA_WARM_NAMES(4))//INDICE//'T' - END IF -! Scavenging - IF (JSV .EQ. NSV_LIMA_SCAVMASS) THEN - TZFIELD%CMNHNAME = TRIM(CAERO_MASS(1))//'T' - TZFIELD%CUNITS = 'kg kg-1' - END IF -! Ni - IF (JSV .EQ. NSV_LIMA_NI) THEN - TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_NAMES(1))//'T' - END IF -! N IFN free - IF (JSV .GE. NSV_LIMA_IFN_FREE .AND. JSV .LT. NSV_LIMA_IFN_NUCL) THEN - WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_IFN_FREE + 1) - TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_NAMES(2))//INDICE//'T' - END IF -! N IFN nucl - IF (JSV .GE. NSV_LIMA_IFN_NUCL .AND. JSV .LT. NSV_LIMA_IFN_NUCL + NMOD_IFN) THEN - WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_IFN_NUCL + 1) - TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_NAMES(3))//INDICE//'T' - END IF -! N IMM nucl - IF (JSV .GE. NSV_LIMA_IMM_NUCL .AND. JSV .LT. NSV_LIMA_IMM_NUCL + NMOD_IMM) THEN - WRITE(INDICE,'(I2.2)')(NINDICE_CCN_IMM(JSV - NSV_LIMA_IMM_NUCL + 1)) - TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_NAMES(4))//INDICE//'T' - END IF -! Hom. freez. of CCN - IF (JSV .EQ. NSV_LIMA_HOM_HAZE) THEN - TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_NAMES(5))//'T' - END IF - ! -! Supersaturation - IF (JSV .EQ. NSV_LIMA_SPRO) THEN - TZFIELD%CMNHNAME = TRIM(CLIMA_WARM_NAMES(5))//'T' - END IF - ! - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)) -! - JSA=JSA+1 - END DO -! - IF (LSCAV .AND. LAERO_MASS) THEN - IF (ASSOCIATED(XINPAP)) THEN - IF (SIZE(XINPAP) /= 0 ) THEN - CALL IO_Field_write(TPFILE,'INPAP',XINPAP) - ! - ZWORK2D(:,:) = XRHOLW*XINPRR(:,:)*XSVT(:,:,2,NSV_LIMA_SCAVMASS)/ & - max( 1.e-20,XRT(:,:,2,3) ) !~2=at ground level - TZFIELD%CMNHNAME = 'INPBP' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'INPBP' - TZFIELD%CUNITS = 'kg m-2 s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_INstantaneous Precipitating Aerosol Rate' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK2D) - ! - CALL IO_Field_write(TPFILE,'ACPAP',XACPAP) - END IF - END IF - END IF -! -! - ! electrical scalar variables - IF (NSV_ELECEND>=NSV_ELECBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_ELECBEG,NSV_ELECEND - TZFIELD%CMNHNAME = TRIM(CELECNAMES(JSV-NSV_ELECBEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - IF (JSV .GT. NSV_ELECBEG .AND. JSV .LT. NSV_ELECEND) THEN - TZFIELD%CUNITS = 'C m-3' - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - ELSE - TZFIELD%CUNITS = 'm-3' - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3,A8)')'X_Y_Z_','SVT',JSV,' (nb ions/m3)' - END IF - ZWORK3D(:,:,:) = XSVT(:,:,:,JSV) * XRHODREF(:,:,:) ! C/kg --> C/m3 - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D) - JSA=JSA+1 - END DO - END IF - ! - IF (CELEC /= 'NONE') THEN - CALL IO_Field_write(TPFILE,'EFIELDU',XEFIELDU) - CALL IO_Field_write(TPFILE,'EFIELDV',XEFIELDV) - CALL IO_Field_write(TPFILE,'EFIELDW',XEFIELDW) - ! - TZFIELD%CMNHNAME = 'EMODULE' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'V m-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME) - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ZWORK3D(:,:,:) = (XEFIELDU**2 + XEFIELDV**2 + XEFIELDW**2)**0.5 - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D) - ! - CALL FIND_FIELD_ID_FROM_MNHNAME('NI_IAGGS',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'pC m-3 s-1' - CALL IO_Field_write(TPFILE,TZFIELD,XNI_IAGGS*1.E12) - ! - CALL FIND_FIELD_ID_FROM_MNHNAME('NI_IDRYG',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'pC m-3 s-1' - CALL IO_Field_write(TPFILE,TZFIELD,XNI_IDRYG*1.E12) - ! - CALL FIND_FIELD_ID_FROM_MNHNAME('NI_SDRYG',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'pC m-3 s-1' - CALL IO_Field_write(TPFILE,TZFIELD,XNI_SDRYG*1.E12) - ! - CALL FIND_FIELD_ID_FROM_MNHNAME('INDUC_CG',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'pC m-3 s-1' - CALL IO_Field_write(TPFILE,TZFIELD,XIND_RATE*1.E12) - ! - CALL IO_Field_write(TPFILE,'TRIG_IC', NMAP_TRIG_IC) - CALL IO_Field_write(TPFILE,'IMPACT_CG', NMAP_IMPACT_CG) - CALL IO_Field_write(TPFILE,'AREA_CG', NMAP_2DAREA_CG) - CALL IO_Field_write(TPFILE,'AREA_IC', NMAP_2DAREA_IC) - CALL IO_Field_write(TPFILE,'FLASH_3DCG',NMAP_3DCG) - CALL IO_Field_write(TPFILE,'FLASH_3DIC',NMAP_3DIC) - ! - IF (LLNOX_EXPLICIT) THEN - TZFIELD%CMNHNAME = 'LINOX' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'mol mol-1' - TZFIELD%CDIR = 'XY' - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,NSV_LNOXEND)) - JSA=JSA+1 - END IF - END IF - ! lagrangian variables - IF (NSV_LGEND>=NSV_LGBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_LGBEG,NSV_LGEND - TZFIELD%CMNHNAME = TRIM(CLGNAMES(JSV-NSV_LGBEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)) - JSA=JSA+1 - END DO - END IF - ! Passive scalar variables - IF (LPASPOL) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'kg kg-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_PPBEG,NSV_PPEND - WRITE(TZFIELD%CMNHNAME,'(A3,I3.3)')'SVT',JSV - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME) - CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)) - JSA=JSA+1 - END DO - END IF -! - IF ( ((CCLOUD == 'KHKO') .OR.(CCLOUD == 'C2R2')) .AND. (.NOT. LSUPSAT)) THEN - CALL IO_Field_write(TPFILE,'SUPSATMAX',XSUPSAT(:,:,:)) - CALL IO_Field_write(TPFILE,'NACT', XNACT(:,:,:)) - END IF - IF ( ((CCLOUD == 'KHKO') .OR.(CCLOUD == 'C2R2')) .AND. LSUPSAT) THEN - CALL IO_Field_write(TPFILE,'SSPRO',XSSPRO(:,:,:)) - CALL IO_Field_write(TPFILE,'NPRO', XNPRO(:,:,:)) - END IF -! -#ifdef MNH_FOREFIRE - ! ForeFire scalar variables - IF ( LFOREFIRE ) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'kg kg-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_FFBEG,NSV_FFEND - WRITE(TZFIELD%CMNHNAME,'(A3,I3.3)')'SVT',JSV - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME) - CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)) - JSA=JSA+1 - END DO - END IF -#endif -! Blowing snow variables - IF (LBLOWSNOW) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'kg kg-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - DO JSV = NSV_SNWBEG,NSV_SNWEND - TZFIELD%CMNHNAME=TRIM(CSNOWNAMES(JSV-NSV_SNWBEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)) - JSA=JSA+1 - END DO - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'kg kg-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - DO JSV = 1,(NSV_SNW) - WRITE(TZFIELD%CMNHNAME,'(A10,I3.3)')'SNOWCANO_M',JSV - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A8,I3.3)')'X_Y_Z_','SNOWCANO',JSV - CALL IO_Field_write(TPFILE,TZFIELD,XSNWCANO(:,:,JSV)) - JSA=JSA+1 - END DO - ENDIF - ! Conditional sampling variables - IF (LCONDSAMP) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'kg kg-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_CSBEG,NSV_CSEND - WRITE(TZFIELD%CMNHNAME,'(A3,I3.3)')'SVT',JSV - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME) - CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)) - JSA=JSA+1 - END DO - ! - END IF - ! number of chemical variables (chem+aero+dust) - ICH_NBR = 0 - IF (LUSECHEM) ICH_NBR = ICH_NBR +NSV_CHEMEND-NSV_CHEMBEG+1 - IF (LUSECHIC) ICH_NBR = ICH_NBR +NSV_CHICEND-NSV_CHICBEG+1 - IF (.NOT.LUSECHEM.AND.LCH_CONV_LINOX) ICH_NBR = ICH_NBR + & - NSV_LNOXEND-NSV_LNOXBEG+1 - IF (LORILAM) ICH_NBR = ICH_NBR +NSV_AEREND -NSV_AERBEG+1 - IF (LDUST) ICH_NBR = ICH_NBR +NSV_DSTEND -NSV_DSTBEG+1 - IF (LDEPOS_DST(IMI)) ICH_NBR = ICH_NBR +NSV_DSTDEPEND -NSV_DSTDEPBEG+1 - IF (LDEPOS_SLT(IMI)) ICH_NBR = ICH_NBR +NSV_SLTDEPEND -NSV_SLTDEPBEG+1 - IF (LDEPOS_AER(IMI)) ICH_NBR = ICH_NBR +NSV_AERDEPEND -NSV_AERDEPBEG+1 - IF (LSALT) ICH_NBR = ICH_NBR +NSV_SLTEND -NSV_SLTBEG+1 - IF (ICH_NBR /=0) ALLOCATE(YCHNAMES(ICH_NBR)) - ! chemical scalar variables - IF (LUSECHEM) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = '' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_CHEMBEG,NSV_CHEMEND - TZFIELD%CMNHNAME = TRIM(UPCASE(CNAMES(JSV-NSV_CHEMBEG+1)))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'ppp' - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)) - ! - YCHNAMES(JSV-JSA)=TZFIELD%CMNHNAME(1:LEN_TRIM(TZFIELD%CMNHNAME)-1) ! without T - END DO - ! - IF (LUSECHIC) THEN - DO JSV = NSV_CHICBEG,NSV_CHICEND - TZFIELD%CMNHNAME = TRIM(UPCASE(CICNAMES(JSV-NSV_CHICBEG+1)))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'ppp' - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)) - ! - YCHNAMES(JSV-JSA)=TZFIELD%CMNHNAME(1:LEN_TRIM(TZFIELD%CMNHNAME)-1) ! without M - END DO - ENDIF - IF (LUSECHAQ.AND.NRR>=3) THEN ! accumulated moles of aqueous species that fall at the surface (mol i/m2) - TZFIELD%NDIMS = 2 - DO JSV = NSV_CHACBEG+NSV_CHAC/2,NSV_CHACEND - TZFIELD%CMNHNAME = 'ACPR_'//TRIM(UPCASE(CNAMES(JSV-NSV_CHEMBEG+1))) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'mol i m-2' - TZFIELD%CCOMMENT = 'X_Y_Accumulated moles of aqueous species at the surface' - ZWORK2D(:,:) = XACPRAQ(:,:,JSV-NSV_CHACBEG-NSV_CHAC/2+1) - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK2D) - END DO - TZFIELD%NDIMS = 3 - END IF - IF (LUSECHAQ.AND.LCH_PH) THEN ! pH values in cloud - CALL IO_Field_write(TPFILE,'PHC',XPHC) - IF (NRR>=3) THEN - CALL IO_Field_write(TPFILE,'PHR',XPHR) - ! compute mean pH in accumulated surface water - !ZWORK2D(:,:) = 10**(-XCH_PHINIT) - WHERE (XACPRR > 0.) - ZWORK2D(:,:) = XACPHR(:,:) *1E3 / XACPRR(:,:) ! moles of H+ / l of water - ELSE WHERE - ZWORK2D(:,:) = XUNDEF - END WHERE - WHERE ((ZWORK2D(:,:) < 1E-1).AND.(ZWORK2D(:,:) > 1E-14)) - ZWORK2D(:,:) = -LOG10(ZWORK2D(:,:)) ! mean pH of surface water - END WHERE - TZFIELD%CMNHNAME = 'MEANPHR' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'MEANPHR' - TZFIELD%CUNITS = '1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_MEAN_PH' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK2D) - ENDIF - ENDIF - ELSE IF (LCH_CONV_LINOX) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppp' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_LNOXBEG,NSV_LNOXEND - TZFIELD%CMNHNAME = 'LINOXT' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)') 'X_Y_Z_','SVT',JSV - CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)) - YCHNAMES(JSV-JSA)=TZFIELD%CMNHNAME(1:LEN_TRIM(TZFIELD%CMNHNAME)-1) - END DO - ENDIF - ! aerosol scalar variables - IF (LORILAM) THEN - IF ((CPROGRAM == 'REAL ').AND.(NSV_AER > 1).AND.(IMI==1).AND.(LAERINIT)) & - CALL CH_AER_REALLFI_n(XSVT(:,:,:,NSV_AERBEG:NSV_AEREND),XSVT(:,:,:,NSV_CHEMBEG-1+JP_CH_CO), XRHODREF) - IF ((CPROGRAM == 'IDEAL ').AND.(NSV_AER > 1).AND.(IMI==1)) & - CALL CH_AER_REALLFI_n(XSVT(:,:,:,NSV_AERBEG:NSV_AEREND),XSVT(:,:,:,NSV_CHEMBEG-1+JP_CH_CO), XRHODREF) - IF (NSV_AEREND>=NSV_AERBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppp' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_AERBEG,NSV_AEREND - TZFIELD%CMNHNAME = TRIM(UPCASE(CAERONAMES(JSV-NSV_AERBEG+1)))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)) - IF (JSV==NSV_AERBEG) WRITE(ILUOUT,*)'MNHC: write_lfin:NSV_AERBEG ',JSV - IF (JSV==NSV_AEREND) WRITE(ILUOUT,*)'MNHC: write_lfin:NSV_AEREND ',JSV - YCHNAMES(JSV-JSA)= TZFIELD%CMNHNAME(1:LEN_TRIM(TZFIELD%CMNHNAME)-1) - END DO - IF (.NOT.(ASSOCIATED(XN3D))) & - ALLOCATE(XN3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE)) - IF (.NOT.(ASSOCIATED(XRG3D))) & - ALLOCATE(XRG3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE)) - IF (.NOT.(ASSOCIATED(XSIG3D))) & - ALLOCATE(XSIG3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE)) - CALL PPP2AERO(XSVT(:,:,:,NSV_AERBEG:NSV_AEREND), XRHODREF, & - PSIG3D=XSIG3D, PRG3D=XRG3D, PN3D=XN3D) - - END IF - IF (LDEPOS_AER(IMI)) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppp' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_AERDEPBEG,NSV_AERDEPEND - TZFIELD%CMNHNAME = TRIM(CDEAERNAMES(JSV-NSV_AERDEPBEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)) - IF (JSV==NSV_AERDEPBEG) WRITE(ILUOUT,*)'MNHC: write_lfin:NSV_AERDEPBEG ',JSV - IF (JSV==NSV_AERDEPEND) WRITE(ILUOUT,*)'MNHC: write_lfin:NSV_AERDEPEND ',JSV - YCHNAMES(JSV-JSA) = TZFIELD%CMNHNAME(1:LEN_TRIM(TZFIELD%CMNHNAME)-1) - END DO ! Loop on aq dust scalar variables - ENDIF - END IF - ! dust scalar variables - IF (LDUST) THEN -! IF ((CPROGRAM == 'REAL ').AND.(NSV_DST > 1).AND.(IMI==1).AND.(LDSTINIT)) & - IF ((CPROGRAM == 'REAL ').AND.(NSV_DST > 1).AND.(IMI==1).AND.(LDSTINIT).AND.(.NOT.LDSTCAMS)) & -!UPG*PT - CALL DUSTLFI_n(XSVT(:,:,:,NSV_DSTBEG:NSV_DSTEND), XRHODREF) - IF ((CPROGRAM == 'IDEAL ').AND.(NSV_DST > 1).AND.(IMI==1)) & - CALL DUSTLFI_n(XSVT(:,:,:,NSV_DSTBEG:NSV_DSTEND), XRHODREF) - !At this point, we have the tracer array in order of importance, i.e. - !if mode 2 is most important it will occupy place 1-3 of XSVT - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppp' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - CALL DUST_FILTER(XSVT(:,:,:,NSV_DSTBEG:NSV_DSTEND), XRHODREF) - DO JSV = NSV_DSTBEG,NSV_DSTEND - TZFIELD%CMNHNAME = TRIM(CDUSTNAMES(JSV-NSV_DSTBEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)) - IF (JSV==NSV_DSTBEG) WRITE(ILUOUT,*)'MNHC: write_lfin:NSV_DSTBEG ',JSV - IF (JSV==NSV_DSTEND) WRITE(ILUOUT,*)'MNHC: write_lfin:NSV_DSTEND ',JSV - YCHNAMES(JSV-JSA) = TZFIELD%CMNHNAME(1:LEN_TRIM(TZFIELD%CMNHNAME)-1) - END DO ! Loop on dust scalar variables - - IF (LDEPOS_DST(IMI)) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppp' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_DSTDEPBEG,NSV_DSTDEPEND - TZFIELD%CMNHNAME = TRIM(CDEDSTNAMES(JSV-NSV_DSTDEPBEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)) - IF (JSV==NSV_DSTDEPBEG) WRITE(ILUOUT,*)'MNHC: write_lfin:NSV_DSTDEPBEG ',JSV - IF (JSV==NSV_DSTDEPEND) WRITE(ILUOUT,*)'MNHC: write_lfin:NSV_DSTDEPEND ',JSV - YCHNAMES(JSV-JSA) = TZFIELD%CMNHNAME(1:LEN_TRIM(TZFIELD%CMNHNAME)-1) - END DO ! Loop on aq dust scalar variables - ENDIF - ENDIF - ! sea salt scalar variables - IF (LSALT) THEN -!UPG*PT -! IF ((CPROGRAM == 'REAL ').AND.(NSV_SLT > 1).AND.(IMI==1).AND.(LSLTINIT)) & - IF ((CPROGRAM == 'REAL ').AND.(NSV_SLT > 1).AND.(IMI==1).AND.(LSLTINIT).AND.(.NOT.LSLTCAMS)) & -!UPG*PT - CALL SALTLFI_n(XSVT(:,:,:,NSV_SLTBEG:NSV_SLTEND), XRHODREF, XZZ) - IF ((CPROGRAM == 'IDEAL ').AND.(NSV_SLT > 1).AND.(IMI==1)) & - CALL SALTLFI_n(XSVT(:,:,:,NSV_SLTBEG:NSV_SLTEND), XRHODREF, XZZ) - !At this point, we have the tracer array in order of importance, i.e. - !if mode 2 is most important it will occupy place 1-3 of XSVT - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppp' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - CALL SALT_FILTER(XSVT(:,:,:,NSV_SLTBEG:NSV_SLTEND), XRHODREF) - DO JSV = NSV_SLTBEG,NSV_SLTEND - TZFIELD%CMNHNAME = TRIM(CSALTNAMES(JSV-NSV_SLTBEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)) - IF (JSV==NSV_SLTBEG) WRITE(ILUOUT,*)'MNHC: write_lfin:NSV_SLTBEG ',JSV - IF (JSV==NSV_SLTEND) WRITE(ILUOUT,*)'MNHC: write_lfin:NSV_SLTEND ',JSV - YCHNAMES(JSV-JSA) = TZFIELD%CMNHNAME(1:LEN_TRIM(TZFIELD%CMNHNAME)-1) - END DO ! Loop on sea salt scalar variables - - IF (LDEPOS_SLT(IMI)) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'ppp' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_SLTDEPBEG,NSV_SLTDEPEND - TZFIELD%CMNHNAME = TRIM(CDESLTNAMES(JSV-NSV_SLTDEPBEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)) - IF (JSV==NSV_SLTDEPBEG) WRITE(ILUOUT,*)'MNHC: write_lfin:NSV_SLTDEPBEG ',JSV - IF (JSV==NSV_SLTDEPEND) WRITE(ILUOUT,*)'MNHC: write_lfin:NSV_SLTDEPEND ',JSV - YCHNAMES(JSV-JSA) = TZFIELD%CMNHNAME(1:LEN_TRIM(TZFIELD%CMNHNAME)-1) - END DO ! Loop on aq dust scalar variables - ENDIF - ENDIF - ! - DO JSV=1,ICH_NBR - WRITE(ILUOUT,*)JSV,TRIM(YCHNAMES(JSV)) - END DO - TZFIELD%CMNHNAME = 'NSV.DIM' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'NSV.DIM' - TZFIELD%CUNITS = '' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Number of chemical variables' - TZFIELD%NGRID = 0 - TZFIELD%NTYPE = TYPEINT - TZFIELD%NDIMS = 0 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,ICH_NBR) - ! - IF (ICH_NBR/=0) THEN - TZFIELD%CMNHNAME = 'NSV.TITRE' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'NSV.TITRE' - TZFIELD%CUNITS = '' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = '' - TZFIELD%NGRID = 0 - TZFIELD%NTYPE = TYPEINT - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - ILREC=LEN(YCHNAMES(1)) - ILENG=ILREC*ICH_NBR - ALLOCATE(ICH_NAMES(ILENG)) - DO JSV = 1,ICH_NBR - DO JT = 1,ILREC - ICH_NAMES(ILREC*(JSV-1)+JT) = ICHAR(YCHNAMES(JSV)(JT:JT)) - ENDDO - ENDDO - CALL IO_Field_write(TPFILE,TZFIELD,ICH_NAMES) - DEALLOCATE(YCHNAMES,ICH_NAMES) - END IF - ! - ! lagrangian variables - IF (NSV_LGEND>=NSV_LGBEG) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 'm' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = NSV_LGBEG,NSV_LGEND - TZFIELD%CMNHNAME = TRIM(CLGNAMES(JSV-NSV_LGBEG+1))//'T' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV - CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV)) - END DO - END IF -END IF -! -! -CALL IO_Field_write(TPFILE,'LSUM', XLSUM) -CALL IO_Field_write(TPFILE,'LSVM', XLSVM) -CALL IO_Field_write(TPFILE,'LSWM', XLSWM) -CALL IO_Field_write(TPFILE,'LSTHM',XLSTHM) -IF (LUSERV) CALL IO_Field_write(TPFILE,'LSRVM',XLSRVM) -! -CALL WRITE_LB_n(TPFILE) -! -! -CALL IO_Field_write(TPFILE,'DRYMASST',XDRYMASST) -! -IF( CTURB /= 'NONE' .AND. CTOM=='TM06') THEN - CALL IO_Field_write(TPFILE,'BL_DEPTH',XBL_DEPTH) -END IF -! -IF( CTURB /= 'NONE' .AND. LRMC01) THEN - CALL IO_Field_write(TPFILE,'SBL_DEPTH',XSBL_DEPTH) -END IF -! -IF( CTURB /= 'NONE' .AND. CSCONV == 'EDKF' .AND.(CPROGRAM == 'MESONH' .OR. CPROGRAM == 'DIAG')) THEN - CALL IO_Field_write(TPFILE,'WTHVMF',XWTHVMF) -END IF -! -IF( NRR > 1 .AND. CTURB /= 'NONE' ) THEN - CALL IO_Field_write(TPFILE,'SRCT',XSRCT) - CALL IO_Field_write(TPFILE,'SIGS',XSIGS) -END IF -! -!* 1.5 Reference state variables : -! -IF (LCOUPLES.AND.LOCEAN) THEN - CALL IO_Field_write(TPFILE,'RHOREFZ',XRHODREFZO) - CALL IO_Field_write(TPFILE,'THVREFZ',XTHVREFZO) - CALL IO_Field_write(TPFILE,'EXNTOP', XEXNTOPO) -ELSE - CALL IO_Field_write(TPFILE,'RHOREFZ',XRHODREFZ) - CALL IO_Field_write(TPFILE,'THVREFZ',XTHVREFZ) - CALL IO_Field_write(TPFILE,'EXNTOP', XEXNTOP) -END IF -! -! -!* 1.6 Tendencies -! -IF (CPROGRAM == 'MESONH') THEN - IF (CTEMP_SCHEME/='LEFR') THEN - CALL IO_Field_write(TPFILE,'US_PRES',XRUS_PRES) - CALL IO_Field_write(TPFILE,'VS_PRES',XRVS_PRES) - CALL IO_Field_write(TPFILE,'WS_PRES',XRWS_PRES) - END IF - IF (LSPLIT_CFL) THEN - CALL IO_Field_write(TPFILE,'THS_CLD',XRTHS_CLD) -! - IF (NRR >=1) THEN - IF (LUSERV) CALL IO_Field_write(TPFILE,'RVS_CLD',XRRS_CLD(:,:,:,IDX_RVT)) - IF (LUSERC) CALL IO_Field_write(TPFILE,'RCS_CLD',XRRS_CLD(:,:,:,IDX_RCT)) - IF (LUSERR) CALL IO_Field_write(TPFILE,'RRS_CLD',XRRS_CLD(:,:,:,IDX_RRT)) - IF (LUSERI) CALL IO_Field_write(TPFILE,'RIS_CLD',XRRS_CLD(:,:,:,IDX_RIT)) - IF (LUSERS) CALL IO_Field_write(TPFILE,'RSS_CLD',XRRS_CLD(:,:,:,IDX_RST)) - IF (LUSERG) CALL IO_Field_write(TPFILE,'RGS_CLD',XRRS_CLD(:,:,:,IDX_RGT)) - IF (LUSERH) CALL IO_Field_write(TPFILE,'RHS_CLD',XRRS_CLD(:,:,:,IDX_RHT)) - END IF - END IF -END IF -! -!IF (LSPLIT_CFL) THEN -! IF (NSV >=1) THEN -! DO JSV = NSV_C2R2BEG,NSV_C2R2END -! IF (JSV == NSV_C2R2BEG ) THEN -! TZFIELD%CMNHNAME = 'RSVS_CLD1' -! TZFIELD%CSTDNAME = '' -! TZFIELD%CLONGNAME = 'RSVS_CLD1' -! TZFIELD%CUNITS = '1' -! TZFIELD%CDIR = 'XY' -! TZFIELD%CCOMMENT = 'X_Y_Z_RHS_CLD' -! TZFIELD%NGRID = 1 -! TZFIELD%NTYPE = TYPEREAL -! TZFIELD%NDIMS = 3 -! TZFIELD%LTIMEDEP = .TRUE. -! CALL IO_Field_write(TPFILE,TZFIELD,XRRS_CLD(:,:,:,IRR)) -! END IF -! IF (JSV == NSV_C2R2END ) THEN -! TZFIELD%CMNHNAME = 'RSVS_CLD2' -! TZFIELD%CSTDNAME = '' -! TZFIELD%CLONGNAME = 'RSVS_CLD2' -! TZFIELD%CUNITS = '1' -! TZFIELD%CDIR = 'XY' -! TZFIELD%CCOMMENT = 'X_Y_Z_RHS_CLD' -! TZFIELD%NGRID = 1 -! TZFIELD%NTYPE = TYPEREAL -! TZFIELD%NDIMS = 3 -! TZFIELD%LTIMEDEP = .TRUE. -! CALL IO_Field_write(TPFILE,TZFIELD,XRRS_CLD(:,:,:,IRR)) -! END IF -! END DO -! END IF -!ENDIF -! -!* 1.8 Diagnostic variables related to the radiations -! -! -IF (CRAD /= 'NONE') THEN - CALL IO_Field_write(TPFILE,'DTRAD_FULL',TDTRAD_FULL) - CALL IO_Field_write(TPFILE,'DTRAD_CLLY',TDTRAD_CLONLY) -! - CALL IO_Field_write(TPFILE,'DTHRAD', XDTHRAD) - CALL IO_Field_write(TPFILE,'FLALWD', XFLALWD) - CALL IO_Field_write(TPFILE,'DIRFLASWD', XDIRFLASWD) - CALL IO_Field_write(TPFILE,'SCAFLASWD', XSCAFLASWD) - CALL IO_Field_write(TPFILE,'DIRSRFSWD', XDIRSRFSWD) - CALL IO_Field_write(TPFILE,'CLEARCOL_TM1',NCLEARCOL_TM1) - CALL IO_Field_write(TPFILE,'ZENITH', XZENITH) - CALL IO_Field_write(TPFILE,'AZIM', XAZIM) - CALL IO_Field_write(TPFILE,'DIR_ALB', XDIR_ALB) - CALL IO_Field_write(TPFILE,'SCA_ALB', XSCA_ALB) - ! - CALL PRINT_MSG(NVERB_INFO,'IO','WRITE_LFIFM_n','EMIS: writing only first band') - CALL FIND_FIELD_ID_FROM_MNHNAME('EMIS',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%NDIMS = 2 - CALL IO_Field_write(TPFILE,TZFIELD,XEMIS(:,:,1)) - ! - CALL IO_Field_write(TPFILE,'TSRAD', XTSRAD) -ENDIF -! -IF (NRR > 1 .AND. CPROGRAM == 'MESONH') THEN - CALL IO_Field_write(TPFILE,'CLDFR',XCLDFR) - CALL IO_Field_write(TPFILE,'RAINFR',XRAINFR) -END IF -! -! -!* 1.9 Diagnostic variables related to deep convection -! -! -IF (CDCONV /= 'NONE' .OR. CSCONV == 'KAFR') THEN -! -! -! - CALL IO_Field_write(TPFILE,'DTDCONV', TDTDCONV) - CALL IO_Field_write(TPFILE,'COUNTCONV',NCOUNTCONV) - CALL IO_Field_write(TPFILE,'DTHCONV', XDTHCONV) - CALL IO_Field_write(TPFILE,'DRVCONV', XDRVCONV) - CALL IO_Field_write(TPFILE,'DRCCONV', XDRCCONV) - CALL IO_Field_write(TPFILE,'DRICONV', XDRICONV) -! - CALL FIND_FIELD_ID_FROM_MNHNAME('PRCONV',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm hour-1' - CALL IO_Field_write(TPFILE,TZFIELD,XPRCONV*3.6E6) -! - CALL FIND_FIELD_ID_FROM_MNHNAME('PACCONV',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm' - CALL IO_Field_write(TPFILE,TZFIELD,XPACCONV*1.0E3) -! - CALL FIND_FIELD_ID_FROM_MNHNAME('PRSCONV',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm hour-1' - CALL IO_Field_write(TPFILE,TZFIELD,XPRSCONV*3.6E6) -! - IF ( LCH_CONV_LINOX ) THEN - CALL IO_Field_write(TPFILE,'IC_RATE', XIC_RATE) - CALL IO_Field_write(TPFILE,'CG_RATE', XCG_RATE) - CALL IO_Field_write(TPFILE,'IC_TOTAL_NB',XIC_TOTAL_NUMBER) - CALL IO_Field_write(TPFILE,'CG_TOTAL_NB',XCG_TOTAL_NUMBER) - END IF -! - IF ( LCHTRANS .AND. NSV > 0 ) THEN - ! scalar variables are recorded - ! individually in the file - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = 's-1' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSV = 1, NSV_USER - WRITE(TZFIELD%CMNHNAME,'(A7,I3.3)')'DSVCONV',JSV - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV - CALL IO_Field_write(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV)) - END DO - DO JSV = NSV_C2R2BEG, NSV_C2R2END - TZFIELD%CMNHNAME = 'DSVCONV_'//TRIM(C2R2NAMES(JSV-NSV_C2R2BEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV - CALL IO_Field_write(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV)) - END DO - DO JSV = NSV_C1R3BEG, NSV_C1R3END - TZFIELD%CMNHNAME = 'DSVCONV_'//TRIM(C1R3NAMES(JSV-NSV_C1R3BEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV - CALL IO_Field_write(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV)) - END DO - DO JSV = NSV_ELECBEG, NSV_ELECEND - TZFIELD%CMNHNAME = 'DSVCONV_'//TRIM(CELECNAMES(JSV-NSV_ELECBEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV - CALL IO_Field_write(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV)) - END DO - DO JSV = NSV_PPBEG, NSV_PPEND - WRITE(TZFIELD%CMNHNAME,'(A7,I3.3)')'DSVCONV',JSV - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV - CALL IO_Field_write(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV)) - END DO -#ifdef MNH_FOREFIRE - IF (LFOREFIRE) THEN - DO JSV = NSV_FFBEG, NSV_FFEND - WRITE(TZFIELD%CMNHNAME,'(A7,I3.3)')'DSVCONV',JSV - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV - CALL IO_Field_write(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV)) - END DO - END IF -#endif - IF (LUSECHEM) THEN - DO JSV = NSV_CHEMBEG, NSV_CHEMEND - TZFIELD%CMNHNAME = 'DSVCONV_'//TRIM(UPCASE(CNAMES(JSV-NSV_CHEMBEG+1))) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV - CALL IO_Field_write(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV)) - END DO - IF (LORILAM) THEN - DO JSV = NSV_AERBEG, NSV_AEREND - TZFIELD%CMNHNAME = 'DSVCONV_'//TRIM(UPCASE(CAERONAMES(JSV-NSV_AERBEG+1))) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV - CALL IO_Field_write(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV)) - END DO - END IF -! linox scalar variables - ELSE IF (LCH_CONV_LINOX) THEN - DO JSV = NSV_LNOXBEG,NSV_LNOXEND - TZFIELD%CMNHNAME = 'DSVCONV_LINOX' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV - CALL IO_Field_write(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV)) - END DO - END IF - DO JSV = NSV_LGBEG, NSV_LGEND - TZFIELD%CMNHNAME = 'DSVCONV_'//TRIM(CLGNAMES(JSV-NSV_LGBEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV - CALL IO_Field_write(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV)) - END DO - DO JSV = NSV_DSTBEG, NSV_DSTEND - TZFIELD%CMNHNAME = 'DSVCONV_'//TRIM(CDUSTNAMES(JSV-NSV_DSTBEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV - CALL IO_Field_write(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV)) - END DO - DO JSV = NSV_SLTBEG, NSV_SLTEND - TZFIELD%CMNHNAME = 'DSVCONV_'//TRIM(CSALTNAMES(JSV-NSV_SLTBEG+1)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - WRITE(TZFIELD%CCOMMENT,'(A6,A7,I3.3)')'X_Y_Z_','DSVCONV',JSV - CALL IO_Field_write(TPFILE,TZFIELD,XDSVCONV(:,:,:,JSV)) - END DO - END IF -! -END IF -! -! -!* 1.10 Diagnostic variables related to the precipitations -! -IF (CPROGRAM /= 'IDEAL') THEN - IF (ASSOCIATED(XINPRC)) THEN - IF (SIZE(XINPRC) /= 0 ) THEN - CALL FIND_FIELD_ID_FROM_MNHNAME('INPRC',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm hour-1' - CALL IO_Field_write(TPFILE,TZFIELD,XINPRC*3.6E6) -! - CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRC',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm' - CALL IO_Field_write(TPFILE,TZFIELD,XACPRC*1.0E3) -! - ENDIF - ENDIF -! - IF (ASSOCIATED(XINDEP)) THEN - IF (SIZE(XINDEP) /= 0 ) THEN - CALL FIND_FIELD_ID_FROM_MNHNAME('INDEP',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm hour-1' - CALL IO_Field_write(TPFILE,TZFIELD,XINDEP*3.6E6) -! - CALL FIND_FIELD_ID_FROM_MNHNAME('ACDEP',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm' - CALL IO_Field_write(TPFILE,TZFIELD,XACDEP*1.0E3) -! - ENDIF - ENDIF -! - IF (ASSOCIATED(XINPRR)) THEN - IF (SIZE(XINPRR) /= 0 ) THEN - CALL FIND_FIELD_ID_FROM_MNHNAME('INPRR',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm hour-1' - CALL IO_Field_write(TPFILE,TZFIELD,XINPRR*3.6E6) -! - CALL IO_Field_write(TPFILE,'INPRR3D',XINPRR3D) - CALL IO_Field_write(TPFILE,'EVAP3D', XEVAP3D) -! - CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRR',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm' - CALL IO_Field_write(TPFILE,TZFIELD,XACPRR*1.0E3) -! - ENDIF - ENDIF -! - IF (ASSOCIATED(XINPRS)) THEN - IF (SIZE(XINPRS) /= 0 ) THEN - CALL FIND_FIELD_ID_FROM_MNHNAME('INPRS',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm hour-1' - CALL IO_Field_write(TPFILE,TZFIELD,XINPRS*3.6E6) -! - CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRS',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm' - CALL IO_Field_write(TPFILE,TZFIELD,XACPRS*1.0E3) - END IF - END IF -! - IF (ASSOCIATED(XINPRG)) THEN - IF (SIZE(XINPRG) /= 0 ) THEN - CALL FIND_FIELD_ID_FROM_MNHNAME('INPRG',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm hour-1' - CALL IO_Field_write(TPFILE,TZFIELD,XINPRG*3.6E6) -! - CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRG',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm' - CALL IO_Field_write(TPFILE,TZFIELD,XACPRG*1.0E3) - END IF - END IF -! - IF (ASSOCIATED(XINPRH)) THEN - IF (SIZE(XINPRH) /= 0 ) THEN - CALL FIND_FIELD_ID_FROM_MNHNAME('INPRH',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm hour-1' - CALL IO_Field_write(TPFILE,TZFIELD,XINPRH*3.6E6) -! - CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRH',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm' - CALL IO_Field_write(TPFILE,TZFIELD,XACPRH*1.0E3) - ENDIF - ENDIF -! - IF (ASSOCIATED(XINPRS)) THEN - IF (SIZE(XINPRS) /= 0 ) THEN - ZWORK2D = XINPRR + XINPRS - IF (SIZE(XINPRG) /= 0 ) ZWORK2D = ZWORK2D + XINPRG - IF (SIZE(XINPRH) /= 0 ) ZWORK2D = ZWORK2D + XINPRH - IF (SIZE(XINPRC) /= 0 ) ZWORK2D = ZWORK2D + XINPRC - CALL FIND_FIELD_ID_FROM_MNHNAME('INPRT',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm hour-1' - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK2D*3.6E6) -! - ZWORK2D = XACPRR + XACPRS - IF (SIZE(XINPRG) /= 0 ) ZWORK2D = ZWORK2D + XACPRG - IF (SIZE(XINPRH) /= 0 ) ZWORK2D = ZWORK2D + XACPRH - IF (SIZE(XINPRC) /= 0 ) ZWORK2D = ZWORK2D + XACPRC - CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRT',IID,IRESP) - TZFIELD = TFIELDLIST(IID) - TZFIELD%CUNITS = 'mm' - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK2D*1.0E3) - END IF - END IF -! -END IF -! -IF(LBLOWSNOW) THEN - IF (ASSOCIATED(XSNWSUBL3D)) THEN - IF (SIZE(XSNWSUBL3D) /= 0 ) THEN - TZFIELD%CMNHNAME = 'SNWSUBL3D' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'kg m-3 s-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_INstantaneous 3D Drifting snow sublimation flux' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,XSNWSUBL3D(:,:,:)) - ZWORK2D(:,:) = 0. - DO JK = IKB,IKE - ZWORK2D(:,:) = ZWORK2D(:,:)+XSNWSUBL3D(:,:,JK) * & - (XZZ(:,:,JK+1)-XZZ(:,:,JK))/XRHOLW*3600*24 - END DO - ZWORK2D(:,:) = ZWORK2D(:,:)*1000. ! vapor water in mm unit - ! - TZFIELD%CMNHNAME = 'COL_SNWSUBL' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'mm day-1' - TZFIELD%CDIR = 'XY' - TZFIELD%CCOMMENT = 'X_Y_Column Sublimation Rate (mmSWE/day)' - TZFIELD%NGRID = 4 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - CALL IO_Field_write(TPFILE,TZFIELD,ZWORK2D(:,:)) - END IF - END IF -ENDIF -! -!* 1.11 Ocean LES variables -! -IF ((.NOT.LCOUPLES).AND.LOCEAN) THEN - CALL IO_Field_write(TPFILE,'NFRCLT',NFRCLT) - CALL IO_Field_write(TPFILE,'NINFRT',NINFRT) - ! - TZFIELD%CMNHNAME = 'SSUFL_T' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'SSUFL' - TZFIELD%CUNITS = 'kg m-1 s-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'sfc stress along U to force ocean LES' - TZFIELD%NGRID = 0 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,XSSUFL_T(:)) - ! - TZFIELD%CMNHNAME = 'SSVFL_T' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'SSVFL' - TZFIELD%CUNITS = 'kg m-1 s-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'sfc stress along V to force ocean LES' - TZFIELD%NGRID = 0 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,XSSVFL_T(:)) - ! - TZFIELD%CMNHNAME = 'SSTFL_T' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'SSTFL' - TZFIELD%CUNITS = 'kg m3 K m s-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'sfc total heat flux to force ocean LES' - TZFIELD%NGRID = 0 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,XSSTFL_T(:)) - ! - TZFIELD%CMNHNAME = 'SSOLA_T' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'SSOLA' - TZFIELD%CUNITS = 'kg m3 K m s-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'sfc solar flux to force ocean LES' - TZFIELD%NGRID = 0 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,XSSOLA_T(:)) - ! -END IF ! ocean sfc forcing end -! -!* 1.12 Forcing variables -! -IF (LFORCING) THEN -! - CALL IO_Field_write(TPFILE,'FRC',NFRC) -! - DO JT=1,NFRC -! - WRITE (YFRC,'(I3.3)') JT -! - TZFIELD%CMNHNAME = 'DTFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'seconds since YYYY-MM-DD HH:MM:SS.S' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Date of forcing profile '//YFRC - TZFIELD%NGRID = 0 - TZFIELD%NTYPE = TYPEDATE - TZFIELD%NDIMS = 0 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,TDTFRC(JT)) -! - TZFIELD%CMNHNAME = 'UFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Zonal component of horizontal forcing wind' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,XUFRC(:,JT)) -! - TZFIELD%CMNHNAME = 'VFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Meridian component of horizontal forcing wind' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,XVFRC(:,JT)) -! - TZFIELD%CMNHNAME = 'WFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Vertical forcing wind' - TZFIELD%NGRID = 4 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,XWFRC(:,JT)) -! - TZFIELD%CMNHNAME = 'THFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'K' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Forcing potential temperature' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,XTHFRC(:,JT)) -! - TZFIELD%CMNHNAME = 'RVFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'kg kg-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Forcing vapor mixing ratio' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,XRVFRC(:,JT)) -! - TZFIELD%CMNHNAME = 'TENDTHFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'K s-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Large-scale potential temperature tendency for forcing' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,XTENDTHFRC(:,JT)) -! - TZFIELD%CMNHNAME = 'TENDRVFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'kg kg-1 s-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Large-scale vapor mixing ratio tendency for forcing' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,XTENDRVFRC(:,JT)) -! - TZFIELD%CMNHNAME = 'GXTHFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'K m-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Large-scale potential temperature gradient for forcing' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,XGXTHFRC(:,JT)) -! - TZFIELD%CMNHNAME = 'GYTHFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'K m-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Large-scale potential temperature gradient for forcing' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,XGYTHFRC(:,JT)) -! - TZFIELD%CMNHNAME = 'PGROUNDFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'Pa' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Forcing ground pressure' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 0 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,XPGROUNDFRC(JT)) -! - TZFIELD%CMNHNAME = 'TENDUFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Large-scale U tendency for forcing' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,XTENDUFRC(:,JT)) -! - TZFIELD%CMNHNAME = 'TENDVFRC'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'm s-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Large-scale V tendency for forcing' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,XTENDVFRC(:,JT)) -! - END DO -! -! -END IF -! -! ------------------------------------------------------------------------- -IF ( L2D_ADV_FRC ) THEN -! - TZFIELD%CMNHNAME = 'NADVFRC1' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'NADVFRC1' - TZFIELD%CUNITS = '1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Number of forcing profiles' - TZFIELD%NGRID = 0 - TZFIELD%NTYPE = TYPEINT - TZFIELD%NDIMS = 0 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,NADVFRC) -! - DO JT=1,NADVFRC -! - WRITE (YFRC,'(I3.3)') JT -! - TZFIELD%CMNHNAME = 'DTADV'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'seconds since YYYY-MM-DD HH:MM:SS.S' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Date and time of the advecting forcing '//YFRC - TZFIELD%NGRID = 0 - TZFIELD%NTYPE = TYPEDATE - TZFIELD%NDIMS = 0 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,TDTADVFRC(JT)) -! - TZFIELD%CMNHNAME = 'TH_ADV'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'K s-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,XDTHFRC(:,:,:,JT)) -! - TZFIELD%CMNHNAME = 'Q_ADV'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'kg kg-1 s-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,XDRVFRC(:,:,:,JT)) -! - ENDDO -ENDIF -! -IF ( L2D_REL_FRC ) THEN -! - TZFIELD%CMNHNAME = 'NRELFRC1' - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = 'NRELFRC1' - TZFIELD%CUNITS = '1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Number of forcing profiles' - TZFIELD%NGRID = 0 - TZFIELD%NTYPE = TYPEINT - TZFIELD%NDIMS = 0 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,NRELFRC) -! - DO JT=1,NRELFRC -! - WRITE (YFRC,'(I3.3)') JT -! - TZFIELD%CMNHNAME = 'DTREL'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'seconds since YYYY-MM-DD HH:MM:SS.S' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = 'Date and time of the relaxation forcing '//YFRC - TZFIELD%NGRID = 0 - TZFIELD%NTYPE = TYPEDATE - TZFIELD%NDIMS = 0 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,TDTRELFRC(JT)) -! - TZFIELD%CMNHNAME = 'TH_REL'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'K' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,XTHREL(:,:,:,JT)) -! - TZFIELD%CMNHNAME = 'Q_REL'//YFRC - TZFIELD%CSTDNAME = '' - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CUNITS = 'kg kg-1' - TZFIELD%CDIR = '--' - TZFIELD%CCOMMENT = '' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%LTIMEDEP = .FALSE. - CALL IO_Field_write(TPFILE,TZFIELD,XRVREL(:,:,:,JT)) -! - ENDDO -ENDIF -! -!* 1.13 Eddy Fluxes variables ! Modif PP -! -IF ( LTH_FLX ) THEN - CALL IO_Field_write(TPFILE,'VT_FLX',XVTH_FLUX_M) - CALL IO_Field_write(TPFILE,'WT_FLX',XWTH_FLUX_M) -END IF -! -IF ( LUV_FLX) CALL IO_Field_write(TPFILE,'VU_FLX',XVU_FLUX_M) -! -!* 1.14 Balloon variables -! -! -IF (LFLYER) CALL WRITE_BALLOON_n(TPFILE) -! -! -!* 1.15 Filtered variables for hurricane initialization -! -! -IF ( CPROGRAM=='REAL ' ) THEN - IF (LFILTERING) THEN - ! - IF (NDIAG_FILT >=0) THEN -! -! i) Total fields (TOT=BASIC+TOTDIS) -! - CALL IO_Field_write(TPFILE,'UT15', XUTOT) - CALL IO_Field_write(TPFILE,'VT15', XVTOT) - CALL IO_Field_write(TPFILE,'TEMPTOT',XTTOT) - IF (INDEX(CFILTERING,'P')/=0) CALL IO_Field_write(TPFILE,'PRESTOT',XPTOT) - IF (INDEX(CFILTERING,'Q')/=0) CALL IO_Field_write(TPFILE,'HUMTOT', XQTOT) -! -! ii) Environmental fields (ENV=TOT-VORDIS) -! - CALL IO_Field_write(TPFILE,'UT16', XUENV) - CALL IO_Field_write(TPFILE,'VT16', XVENV) - CALL IO_Field_write(TPFILE,'TEMPENV',XTENV) - IF (INDEX(CFILTERING,'P')/=0) CALL IO_Field_write(TPFILE,'PRESENV',XPENV) - IF (INDEX(CFILTERING,'Q')/=0) CALL IO_Field_write(TPFILE,'HUMENV', XQENV) -! - END IF - IF (NDIAG_FILT >=1) THEN -! -! iii) Basic (filtered) fields -! - CALL IO_Field_write(TPFILE,'UT17', XUBASIC) - CALL IO_Field_write(TPFILE,'VT17', XVBASIC) - CALL IO_Field_write(TPFILE,'TEMPBAS',XTBASIC) - IF (INDEX(CFILTERING,'P')/=0) CALL IO_Field_write(TPFILE,'PRESBAS',XPBASIC) - IF (INDEX(CFILTERING,'Q')/=0) CALL IO_Field_write(TPFILE,'HUMBAS', XQBASIC) - END IF - IF (NDIAG_FILT >=2) THEN -! -! iv) Total disturbance tangential wind -! - CALL IO_Field_write(TPFILE,'VTDIS',XVTDIS) -! - END IF -! - END IF -! -!* 1.16 Dummy variables in PREP_REAL_CASE -! - IF (ALLOCATED(CDUMMY_2D)) THEN - TZFIELD%CSTDNAME = '' - TZFIELD%CUNITS = '' - TZFIELD%CDIR = 'XY' - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 2 - TZFIELD%LTIMEDEP = .TRUE. - ! - DO JSA=1,SIZE(XDUMMY_2D,3) - TZFIELD%CMNHNAME = ADJUSTL(CDUMMY_2D(JSA)) - TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) - TZFIELD%CCOMMENT = 'X_Y_Z_'//TRIM(TZFIELD%CMNHNAME) - CALL IO_Field_write(TPFILE,TZFIELD,XDUMMY_2D(:,:,JSA)) - END DO - END IF -! -END IF -! -!* 1.17 Wind turbine variables -! -! i) Main -! -IF (LMAIN_EOL .AND. IMI == NMODEL_EOL) THEN - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 3 - TZFIELD%CDIR = 'XY' - TZFIELD%CUNITS = 'N' -! - TZFIELD%CMNHNAME = 'FX_RG' - TZFIELD%CLONGNAME = 'FX_RG' - TZFIELD%CCOMMENT = 'X-component field of aerodynamic force (wind->rotor) in global frame (N)' - CALL IO_Field_write(TPFILE,TZFIELD,XFX_RG) -! - TZFIELD%CMNHNAME = 'FY_RG' - TZFIELD%CLONGNAME = 'FY_RG' - TZFIELD%CCOMMENT = 'Y-component field of aerodynamic force (wind->rotor) in global frame (N)' - CALL IO_Field_write(TPFILE,TZFIELD,XFY_RG) -! - TZFIELD%CMNHNAME = 'FZ_RG' - TZFIELD%CLONGNAME = 'FZ_RG' - TZFIELD%CCOMMENT = 'Z-component field of aerodynamic force (wind->rotor) in global frame (N)' - CALL IO_Field_write(TPFILE,TZFIELD,XFZ_RG) -! - TZFIELD%CMNHNAME = 'FX_SMR_RG' - TZFIELD%CLONGNAME = 'FX_SMR_RG' - TZFIELD%CCOMMENT = 'X-component field of smeared aerodynamic force (wind->rotor) in global frame (N)' - TZFIELD%CCOMMENT = '' - CALL IO_Field_write(TPFILE,TZFIELD,XFX_SMR_RG) -! - TZFIELD%CMNHNAME = 'FY_SMR_RG' - TZFIELD%CLONGNAME = 'FY_SMR_RG' - TZFIELD%CCOMMENT = 'Y-component field of smeared aerodynamic force (wind->rotor) in global frame (N)' - CALL IO_Field_write(TPFILE,TZFIELD,XFY_SMR_RG) -! - TZFIELD%CMNHNAME = 'FZ_SMR_RG' - TZFIELD%CLONGNAME = 'FZ_SMR_RG' - TZFIELD%CCOMMENT = 'Z-component field of smeared aerodynamic force (wind->rotor) in global frame (N)' - CALL IO_Field_write(TPFILE,TZFIELD,XFZ_SMR_RG) -! -SELECT CASE(CMETH_EOL) -! -! ii) Actuator Disk without Rotation model -! - CASE('ADNR') ! Actuator Disc Non-Rotating -! - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%NDIMS = 1 - TZFIELD%CDIR = '--' - TZFIELD%CUNITS = '1' -! - TZFIELD%CMNHNAME = 'A_INDU' - TZFIELD%CLONGNAME = 'INDUCTION_FACTOR' - TZFIELD%CCOMMENT = 'Induction factor (1)' - CALL IO_Field_write(TPFILE,TZFIELD,XA_INDU) -! - TZFIELD%CMNHNAME = 'CT_D' - TZFIELD%CLONGNAME = 'CTHRUST_D' - TZFIELD%CCOMMENT = 'Thrust coefficient at disk (1), & - used with wind speed at disk' - CALL IO_Field_write(TPFILE,TZFIELD,XCT_D) -! - TZFIELD%CMNHNAME = 'THRUT' - TZFIELD%CLONGNAME = 'THRUSTT_EOL' - TZFIELD%CUNITS = 'N' - TZFIELD%CCOMMENT = 'RID instantaneous thrust of the wind turbines (N)' - CALL IO_Field_write(TPFILE,TZFIELD,XTHRUT) -! - IF (MEAN_COUNT /= 0) THEN - - TZFIELD%CMNHNAME = 'THRUMME' - TZFIELD%CLONGNAME = 'MEAN_THRUST_EOL' - TZFIELD%CUNITS = 'N' - TZFIELD%CCOMMENT = 'RID mean thrust of the wind turbines (N)' - CALL IO_Field_write(TPFILE,TZFIELD,XTHRU_SUM/MEAN_COUNT) -! - END IF -! iii) Actuator Line Model -! - CASE('ALM') ! Actuator Line Method -! - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%CDIR = '--' -! - TZFIELD%NDIMS = 1 -! - TZFIELD%CMNHNAME = 'THRUT' - TZFIELD%CLONGNAME = 'THRUSTT_EOL' - TZFIELD%CUNITS = 'N' - TZFIELD%CCOMMENT = 'RID instantaneous thrust (N) of wind turbines' - CALL IO_Field_write(TPFILE,TZFIELD,XTHRUT) -! - TZFIELD%CMNHNAME = 'TORQT' - TZFIELD%CLONGNAME = 'TORQUET_EOL' - TZFIELD%CUNITS = 'Nm' - TZFIELD%CCOMMENT = 'RID instantaneous torque (Nm) of wind turbines' - CALL IO_Field_write(TPFILE,TZFIELD,XTORQT) -! - TZFIELD%CMNHNAME = 'POWT' - TZFIELD%CLONGNAME = 'POWERT_EOL' - TZFIELD%CUNITS = 'W' - TZFIELD%CCOMMENT = 'RID instantaneous power (W) of wind turbines' - CALL IO_Field_write(TPFILE,TZFIELD,XPOWT) -! - TZFIELD%NDIMS = 3 -! - TZFIELD%CMNHNAME = 'ELT_RAD' - TZFIELD%CLONGNAME = 'ELT_RAD' - TZFIELD%CUNITS = 'm' - TZFIELD%CCOMMENT = 'RID_BID_EID radius (m) of wind turbine blade elements' - CALL IO_Field_write(TPFILE,TZFIELD,XELT_RAD) -! - TZFIELD%CMNHNAME = 'AOA' - TZFIELD%CLONGNAME = 'ANGLE OF ATTACK' - TZFIELD%CUNITS = 'rad' - TZFIELD%CCOMMENT = 'RID_BID_EID instantaneous angle of attack (rad)' - CALL IO_Field_write(TPFILE,TZFIELD,XAOA_GLB) -! - TZFIELD%CMNHNAME = 'FLIFT' - TZFIELD%CLONGNAME = 'LIFT FORCE' - TZFIELD%CUNITS = 'N' - TZFIELD%CCOMMENT = 'RID_BID_EID instantaneous lift (N) in relative frame' - CALL IO_Field_write(TPFILE,TZFIELD,XFLIFT_GLB) -! - TZFIELD%CMNHNAME = 'FDRAG' - TZFIELD%CLONGNAME = 'DRAG FORCE' - TZFIELD%CUNITS = 'N' - TZFIELD%CCOMMENT = 'RID_BID_EID instantaneous drag (N) in relative frame' - CALL IO_Field_write(TPFILE,TZFIELD,XFDRAG_GLB) -! - TZFIELD%NDIMS = 4 -! - TZFIELD%CMNHNAME = 'FAERO_RE' - TZFIELD%CLONGNAME = 'AERODYNAMIC FORCE RE' - TZFIELD%CUNITS = 'N' - TZFIELD%CCOMMENT = 'RID_BID_EID_XYZ instantaneous forces (N) in RE' - CALL IO_Field_write(TPFILE,TZFIELD,XFAERO_RE_GLB) -! - TZFIELD%CMNHNAME = 'FAERO_RG' - TZFIELD%CLONGNAME = 'AERODYNAMIC FORCE RG' - TZFIELD%CUNITS = 'N' - TZFIELD%CCOMMENT = 'RID_BID_EID_XYZ instantaneous forces (N) in RG' - CALL IO_Field_write(TPFILE,TZFIELD,XFAERO_RG_GLB) -! - IF (MEAN_COUNT /= 0) THEN -! - TZFIELD%NGRID = 1 - TZFIELD%NTYPE = TYPEREAL - TZFIELD%CDIR = '--' -! - TZFIELD%NDIMS = 1 -! - TZFIELD%CMNHNAME = 'THRUMME' - TZFIELD%CLONGNAME = 'MEAN_THRUST_EOL' - TZFIELD%CUNITS = 'N' - TZFIELD%CCOMMENT = 'RID mean thrust of the wind turbines (N)' - CALL IO_Field_write(TPFILE,TZFIELD,XTHRU_SUM/MEAN_COUNT) -! - TZFIELD%CMNHNAME = 'TORQMME' - TZFIELD%CLONGNAME = 'MEAN_TORQUE_EOL' - TZFIELD%CUNITS = 'Nm' - TZFIELD%CCOMMENT = 'RID mean torque of the wind turbines (Nm)' - CALL IO_Field_write(TPFILE,TZFIELD,XTORQ_SUM/MEAN_COUNT) -! - TZFIELD%CMNHNAME = 'POWMME' - TZFIELD%CLONGNAME = 'MEAN_POWER_EOL' - TZFIELD%CUNITS = 'W' - TZFIELD%CCOMMENT = 'RID mean power of the wind turbines (W)' - CALL IO_Field_write(TPFILE,TZFIELD,XPOW_SUM/MEAN_COUNT) -! - TZFIELD%NDIMS = 3 -! - TZFIELD%CMNHNAME = 'AOAMME' - TZFIELD%CLONGNAME = 'MEAN_ANGLE_OF_ATTACK' - TZFIELD%CUNITS = 'rad' - TZFIELD%CCOMMENT = 'RID_BID_EID mean angle of attack (rad)' - CALL IO_Field_write(TPFILE,TZFIELD,XAOA_SUM/MEAN_COUNT) -! - TZFIELD%NDIMS = 4 -! - TZFIELD%CMNHNAME = 'FAEROMME_RE' - TZFIELD%CLONGNAME = 'MEAN_AERODYNAMIC_FORCE_RE' - TZFIELD%CUNITS = 'N' - TZFIELD%CCOMMENT = 'RID_BID_EID_XYZ mean forces (N) in RE' - CALL IO_Field_write(TPFILE,TZFIELD,XFAERO_RE_SUM/MEAN_COUNT) -! - END IF -! - END SELECT -END IF -! -DEALLOCATE(ZWORK2D,ZWORK3D) -! -!-------------------------------------------------------------------------------! -! -END SUBROUTINE WRITE_LFIFM_n diff --git a/src/ICCARE_BASE/write_pgd_surf_atmn.F90 b/src/ICCARE_BASE/write_pgd_surf_atmn.F90 deleted file mode 100644 index 9c6df17d0..000000000 --- a/src/ICCARE_BASE/write_pgd_surf_atmn.F90 +++ /dev/null @@ -1,216 +0,0 @@ -!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -! #################################### - SUBROUTINE WRITE_PGD_SURF_ATM_n (YSC, HPROGRAM) -! #################################### -! -!!**** *WRITE_PGD_SURF_ATM_n* - routine to write pgd surface variables -!! in their respective files or in file -!! -!! PURPOSE -!! ------- -!! -!!** METHOD -!! ------ -!! -!! EXTERNAL -!! -------- -!! -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! REFERENCE -!! --------- -!! -!! -!! AUTHOR -!! ------ -!! B. Decharme *Meteo France* -!! -!! MODIFICATIONS -!! ------------- -!! Original 05/2011 according to previous write_surf_atmn.f90 -!! P.Tulet & M. Leriche 06/2017 add coupling MEGAN -!! P.Tulet 2021 DMS field data -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -! -USE MODD_SURFEX_n, ONLY : SURFEX_t -! -USE MODD_SURF_CONF, ONLY : CPROGNAME -USE MODD_SURF_PAR, ONLY : NVERSION, NBUGFIX -USE MODD_IO_SURF_FA, ONLY : LFANOCOMPACT -! -USE MODD_WRITE_SURF_ATM, ONLY : LSPLIT_PATCH -! -USE MODI_INIT_IO_SURF_n -USE MODI_WRITE_SURF -USE MODI_WRITE_PGD_SEA_n -USE MODI_WRITE_PGD_INLAND_WATER_n -USE MODI_WRITE_PGD_NATURE_n -USE MODI_WRITE_PGD_TOWN_n -USE MODI_END_IO_SURF_n -! -USE MODI_FLAG_UPDATE -! -USE MODI_WRITESURF_COVER_n -USE MODI_WRITESURF_SSO_n -USE MODI_WRITESURF_DUMMY_n -USE MODI_WRITESURF_SNAP_n -USE MODI_WRITESURF_CH_EMIS_n -USE MODI_WRITESURF_MEGAN_n -USE MODI_WRITESURF_DMS_n -! -USE MODI_WRITE_GRID -! -USE MODI_WRITE_ECOCLIMAP2_DATA -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -IMPLICIT NONE -! -!* 0.1 Declarations of arguments -! ------------------------- -! -! -TYPE(SURFEX_t), INTENT(INOUT) :: YSC -! - CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes -! -!* 0.2 Declarations of local variables -! ------------------------------- -! - CHARACTER(LEN=3) :: YWRITE - CHARACTER(LEN=100) :: YCOMMENT -INTEGER :: IRESP -REAL(KIND=JPRB) :: ZHOOK_HANDLE -!------------------------------------------------------------------------------- -! -IF (LHOOK) CALL DR_HOOK('WRITE_PGD_SURF_ATM_N',0,ZHOOK_HANDLE) -! -!* 0. Initialize some options: -! ------------------------ -! -CPROGNAME = HPROGRAM -! - CALL FLAG_UPDATE(YSC%IM%ID%O, YSC%DUO, .FALSE.,.TRUE.,.FALSE.,.FALSE.) -! -!* 1. Configuration and cover fields: -! ------------------------------ -! -! -! Initialisation for IO -! -CALL INIT_IO_SURF_n(YSC%DTCO, YSC%U, HPROGRAM,'FULL ','SURF ','WRITE') -! -YWRITE='PGD' -YCOMMENT='(-)' - CALL WRITE_SURF( YSC%DUO%CSELECT, HPROGRAM,'VERSION',NVERSION,IRESP,YCOMMENT) - CALL WRITE_SURF( YSC%DUO%CSELECT, HPROGRAM,'BUG ',NBUGFIX ,IRESP,YCOMMENT) - CALL WRITE_SURF( YSC%DUO%CSELECT, HPROGRAM,'STORAGETYPE',YWRITE,IRESP,YCOMMENT) -! - CALL WRITE_SURF( YSC%DUO%CSELECT, HPROGRAM,'SPLIT_PATCH',LSPLIT_PATCH,IRESP,YCOMMENT) -! - CALL WRITE_SURF( YSC%DUO%CSELECT, HPROGRAM,'SEA ',YSC%U%CSEA ,IRESP,YCOMMENT) - CALL WRITE_SURF( YSC%DUO%CSELECT, HPROGRAM,'WATER ',YSC%U%CWATER ,IRESP,YCOMMENT) - CALL WRITE_SURF( YSC%DUO%CSELECT, HPROGRAM,'NATURE',YSC%U%CNATURE,IRESP,YCOMMENT) - CALL WRITE_SURF( YSC%DUO%CSELECT, HPROGRAM,'TOWN ',YSC%U%CTOWN ,IRESP,YCOMMENT) -! - CALL WRITE_SURF( YSC%DUO%CSELECT, HPROGRAM,'DIM_FULL ',YSC%U%NDIM_FULL,IRESP,HCOMMENT=YCOMMENT) - CALL WRITE_SURF( YSC%DUO%CSELECT, HPROGRAM,'DIM_SEA ',YSC%U%NDIM_SEA, IRESP,HCOMMENT=YCOMMENT) - CALL WRITE_SURF( YSC%DUO%CSELECT, HPROGRAM,'DIM_NATURE',YSC%U%NDIM_NATURE,IRESP,HCOMMENT=YCOMMENT) - CALL WRITE_SURF( YSC%DUO%CSELECT, HPROGRAM,'DIM_WATER ',YSC%U%NDIM_WATER, IRESP,HCOMMENT=YCOMMENT) - CALL WRITE_SURF( YSC%DUO%CSELECT, HPROGRAM,'DIM_TOWN ',YSC%U%NDIM_TOWN, IRESP,HCOMMENT=YCOMMENT) - CALL WRITE_SURF( YSC%DUO%CSELECT, HPROGRAM,'ECOCLIMAP ',YSC%U%LECOCLIMAP ,IRESP,YCOMMENT) - CALL WRITE_SURF( YSC%DUO%CSELECT, HPROGRAM,'ECOSG ',YSC%U%LECOSG ,IRESP,YCOMMENT) - CALL WRITE_SURF( YSC%DUO%CSELECT, HPROGRAM,'WATER_TO_NAT',YSC%U%LWATER_TO_NATURE,IRESP,YCOMMENT) - CALL WRITE_SURF( YSC%DUO%CSELECT, HPROGRAM,'TOWN_TO_ROCK',YSC%U%LTOWN_TO_ROCK,IRESP,YCOMMENT) - CALL WRITE_SURF( YSC%DUO%CSELECT, HPROGRAM,'GARDEN',YSC%U%LGARDEN,IRESP,YCOMMENT) -IF (HPROGRAM.NE.'BINARY' .AND. HPROGRAM.NE.'TEXTE ') THEN - CALL WRITE_ECOCLIMAP2_DATA( YSC%DUO%CSELECT, HPROGRAM) -ENDIF -! - CALL WRITE_GRID(YSC%DUO%CSELECT, HPROGRAM,YSC%UG%G%CGRID,YSC%UG%G%XGRID_PAR,& - YSC%UG%G%XLAT,YSC%UG%G%XLON,YSC%UG%G%XMESH_SIZE,IRESP) -! - CALL WRITESURF_COVER_n(YSC%DUO%CSELECT, YSC%U, HPROGRAM) - CALL WRITESURF_SSO_n(YSC%DUO%CSELECT, YSC%USS, HPROGRAM) - CALL WRITESURF_DUMMY_n(YSC%DUO%CSELECT, YSC%DUU, HPROGRAM) -! -YCOMMENT='CH_EMIS' - CALL WRITE_SURF(YSC%DUO%CSELECT,HPROGRAM,'CH_EMIS',YSC%CHU%LCH_EMIS,IRESP,HCOMMENT=YCOMMENT) -! -IF (YSC%CHU%LCH_EMIS) THEN - YCOMMENT='CH_EMIS_OPT' - CALL WRITE_SURF(YSC%DUO%CSELECT,HPROGRAM,'CH_EMIS_OPT',YSC%CHU%CCH_EMIS,IRESP,HCOMMENT=YCOMMENT) -END IF -! -! MEGAN coupling - -IF (YSC%U%NDIM_NATURE>0) THEN -YCOMMENT='CH_BIOEMIS' -CALL WRITE_SURF(YSC%DUO%CSELECT, HPROGRAM,'CH_BIOEMIS',YSC%CHU%LCH_BIOEMIS,IRESP,HCOMMENT=YCOMMENT) - IF (YSC%CHU%LCH_BIOEMIS) CALL WRITESURF_MEGAN_n(YSC%DUO%CSELECT, YSC%IM%MSF, HPROGRAM) -ENDIF -! -IF (YSC%CHU%LCH_EMIS) THEN - IF (YSC%CHU%CCH_EMIS=='AGGR') THEN - CALL WRITESURF_CH_EMIS_n(YSC%DUO%CSELECT, YSC%CHE, HPROGRAM) - ELSE IF (YSC%CHU%CCH_EMIS=='SNAP') THEN - CALL WRITESURF_SNAP_n(YSC%DUO%CSELECT, YSC%CHN, HPROGRAM) - ENDIF -ENDIF -! -! DMS fluxes -IF (YSC%U%NDIM_SEA>0) THEN - YCOMMENT='CH_DMSEMIS' - CALL WRITE_SURF(YSC%DUO%CSELECT, HPROGRAM,'CH_DMSEMIS',YSC%CHU%LCH_DMSEMIS,IRESP,HCOMMENT=YCOMMENT) - IF (YSC%CHU%LCH_DMSEMIS) CALL WRITESURF_DMS_n(YSC%DUO%CSELECT, YSC%SM%DSF, HPROGRAM) -ENDIF - -! End of IO -! - CALL END_IO_SURF_n(HPROGRAM) -! -! -!* 2. Sea -! --- -! -IF (YSC%U%NDIM_SEA>0) CALL WRITE_PGD_SEA_n(YSC%DTCO, YSC%DUO%CSELECT, YSC%U, & - YSC%SM%DTS, YSC%SM%G, YSC%SM%S, HPROGRAM) -! -! -!* 3. Inland water -! ------------ -! -IF (YSC%U%NDIM_WATER>0) CALL WRITE_PGD_INLAND_WATER_n(YSC%DTCO, YSC%DUO%CSELECT, YSC%U, & - YSC%WM%G, YSC%WM%W, YSC%FM%G, YSC%FM%F, & - HPROGRAM) -! -! -!* 4. Vegetation scheme -! ----------------- -! -IF (YSC%U%NDIM_NATURE>0) CALL WRITE_PGD_NATURE_n(YSC%DTCO, YSC%DUO%CSELECT, YSC%U, & - YSC%DTZ, YSC%IM, HPROGRAM) -! -! -!* 5. Urban scheme -! ------------ -! -IF (YSC%U%NDIM_TOWN>0) CALL WRITE_PGD_TOWN_n(YSC%DTCO, YSC%DUO%CSELECT, YSC%U, & - YSC%TM, YSC%GDM, YSC%GRM, HPROGRAM) -! -! -IF (LHOOK) CALL DR_HOOK('WRITE_PGD_SURF_ATM_N',1,ZHOOK_HANDLE) -! -!------------------------------------------------------------------------------- -! -END SUBROUTINE WRITE_PGD_SURF_ATM_n diff --git a/src/ICCARE_BASE/writesurf_dmsn.F90 b/src/ICCARE_BASE/writesurf_dmsn.F90 deleted file mode 100644 index f3ab4258b..000000000 --- a/src/ICCARE_BASE/writesurf_dmsn.F90 +++ /dev/null @@ -1,91 +0,0 @@ -!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -! ######### - SUBROUTINE WRITESURF_DMS_n(HSELECT, DSF, HPROGRAM) -! ########################################## -! -!!**** *WRITESURF_DMS_n* - routine to write dummy surface fields -!! -!! PURPOSE -!! ------- -!! -!! AUTHOR -!! ------ -!! P. Tulet *LAERO* -!! -!! MODIFICATIONS -!! ------------- -!! Original 06/2021 -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_DMS_SURF_FIELDS_n, ONLY : DMS_SURF_FIELDS_t -! -USE MODI_WRITE_SURF -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -IMPLICIT NONE -! -!* 0.1 Declarations of arguments -! ------------------------- -! - CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT -TYPE(DMS_SURF_FIELDS_t), INTENT(INOUT) :: DSF - CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! -! -!* 0.2 Declarations of local variables -! ------------------------------- -! -INTEGER :: JDMS ! loop counter -CHARACTER(LEN=3) :: YDMS -! -CHARACTER(LEN=20) :: YSTRING20 ! string -CHARACTER(LEN=3 ) :: YSTRING03 ! string -! -INTEGER :: IRESP ! IRESP : return-code if a problem appears -CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read -CHARACTER(LEN=100):: YCOMMENT ! Comment string -REAL(KIND=JPRB) :: ZHOOK_HANDLE -! -!------------------------------------------------------------------------------- -! -!* 1. Number of megan fields : -! ---------------------- -! -IF (LHOOK) CALL DR_HOOK('WRITESURF_DMS_N',0,ZHOOK_HANDLE) -! -YRECFM='DMS_GR_NBR' -YCOMMENT=' ' -! - CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DSF%NDMS_NBR,IRESP,HCOMMENT=YCOMMENT) -! -!------------------------------------------------------------------------------- -! -!* 2. DMS fields : -! ------------ -! -DO JDMS=1,DSF%NDMS_NBR - ! - WRITE(YDMS,'(I3.3)') (JDMS) - YRECFM='DMS_NB'//ADJUSTL(YDMS(:LEN_TRIM(YDMS))) - YSTRING20=DSF%CDMS_NAME(JDMS) - YSTRING03=DSF%CDMS_AREA(JDMS) - YCOMMENT='X_Y_'//ADJUSTL(YRECFM(:LEN_TRIM(YRECFM)))//'_'//ADJUSTL(YSTRING20(:LEN_TRIM(YSTRING20)))//& - '_'//ADJUSTL(YSTRING03(:LEN_TRIM(YSTRING03))) - CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DSF%XDMS_FIELDS(:,JDMS),IRESP,HCOMMENT=YCOMMENT) - ! - YRECFM='DMS_NAME'//ADJUSTL(YDMS(:LEN_TRIM(YDMS))) - CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,DSF%CDMS_NAME(JDMS),IRESP,HCOMMENT=YCOMMENT) - ! - END DO -IF (LHOOK) CALL DR_HOOK('WRITESURF_DMS_N',1,ZHOOK_HANDLE) -! -!------------------------------------------------------------------------------- -! -END SUBROUTINE WRITESURF_DMS_n diff --git a/src/ICCARE_BASE/writesurf_isban.F90 b/src/ICCARE_BASE/writesurf_isban.F90 deleted file mode 100644 index 5bf478d24..000000000 --- a/src/ICCARE_BASE/writesurf_isban.F90 +++ /dev/null @@ -1,550 +0,0 @@ -!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier -!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence -!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt -!SFX_LIC for details. version 1. -! ######### - SUBROUTINE WRITESURF_ISBA_n (HSELECT, OSNOWDIMNC, CHI, MGN, NDST, & - IO, S, NP, NPE, KI, HPROGRAM, OLAND_USE) -! ##################################### -! -!!**** *WRITESURF_ISBA_n* - writes ISBA prognostic fields -!! -!! -!! PURPOSE -!! ------- -!! -!!** METHOD -!! ------ -!! -!! EXTERNAL -!! -------- -!! -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -! -!! REFERENCE -!! --------- -!! -!! -!! AUTHOR -!! ------ -!! V. Masson *Meteo France* -!! -!! MODIFICATIONS -!! ------------- -!! Original 01/2003 -!! P. LeMoigne 12/2004 : correct dimensionning if more than 10 layers in -!! the soil (diffusion version) -!! B. Decharme 2008 : Floodplains -!! B. Decharme 01/2009 : Optional Arpege deep soil temperature write -!! A.L. Gibelin 03/09 : modifications for CENTURY model -!! A.L. Gibelin 04/2009 : BIOMASS and RESP_BIOMASS arrays -!! A.L. Gibelin 06/2009 : Soil carbon variables for CNT option -!! B. Decharme 07/2011 : land_use semi-prognostic variables -!! B. Decharme 09/2012 : suppress NWG_LAYER (parallelization problems) -!! B. Decharme 09/2012 : write some key for prep_read_external -!! B. Decharme 04/2013 : Only 2 temperature layer in ISBA-FR -!! P. Samuelsson 10/2014: MEB -!! P. Tulet 06/2016 : add XEF et XPFT for MEGAN coupling -!! M. Leriche 06/2017: comment write XEF & XPFT bug -!! -!------------------------------------------------------------------------------- -! -!* 0. DECLARATIONS -! ------------ -! -USE MODD_SURFEX_MPI, ONLY : NRANK -! -USE MODN_PREP_SURF_ATM, ONLY : LWRITE_EXTERN -USE MODD_WRITE_SURF_ATM, ONLY : LSPLIT_PATCH -! -USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t -USE MODD_DST_n, ONLY : DST_NP_t -! -USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t -USE MODD_ISBA_n, ONLY : ISBA_NP_t, ISBA_NPE_t, ISBA_S_t -USE MODD_MEGAN_n, ONLY : MEGAN_t -! -USE MODD_SURF_PAR, ONLY : NUNDEF -! -USE MODD_ASSIM, ONLY : LASSIM, CASSIM, CASSIM_ISBA, NIE, NENS, & - XADDTIMECORR, LENS_GEN, NVAR -! -USE MODD_DST_SURF -! -USE MODI_WRITE_FIELD_1D_PATCH -USE MODI_WRITE_SURF -USE MODI_WRITESURF_GR_SNOW -USE MODI_ALLOCATE_GR_SNOW -USE MODI_DEALLOC_GR_SNOW -! -USE YOMHOOK ,ONLY : LHOOK, DR_HOOK -USE PARKIND1 ,ONLY : JPRB -! -IMPLICIT NONE -! -!* 0.1 Declarations of arguments -! ------------------------- -! - CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT -LOGICAL, INTENT(IN) :: OSNOWDIMNC -! -TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI -TYPE(MEGAN_t), INTENT(INOUT) :: MGN -TYPE(DST_NP_t), INTENT(INOUT) :: NDST -! -TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO -TYPE(ISBA_S_t), INTENT(INOUT) :: S -TYPE(ISBA_NP_t), INTENT(INOUT) :: NP -TYPE(ISBA_NPE_t), INTENT(INOUT) :: NPE -INTEGER, INTENT(IN) :: KI -! - CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling -LOGICAL, INTENT(IN) :: OLAND_USE ! -! -!* 0.2 Declarations of local variables -! ------------------------------- -! -INTEGER :: IRESP ! IRESP : return-code if a problem appears - CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read - CHARACTER(LEN=4 ) :: YLVL - CHARACTER(LEN=3 ) :: YVAR - CHARACTER(LEN=100):: YCOMMENT ! Comment string - CHARACTER(LEN=25) :: YFORM ! Writing format - CHARACTER(LEN=2) :: YPAT -! -INTEGER :: JJ, JL, JP, JNB, JNL, JNS, JNLV ! loop counter on levels -INTEGER :: IWORK ! Work integer -INTEGER :: JSV -INTEGER :: ISIZE_LMEB_PATCH -INTEGER :: JVAR -! -REAL(KIND=JPRB) :: ZHOOK_HANDLE -! -!------------------------------------------------------------------------------ -! -!* 2. Prognostic fields: -! ----------------- -! -IF (LHOOK) CALL DR_HOOK('WRITESURF_ISBA_N',0,ZHOOK_HANDLE) -! -!* soil temperatures -! -IF(IO%LTEMP_ARP)THEN - IWORK=IO%NTEMPLAYER_ARP -ELSEIF(IO%CISBA=='DIF')THEN - IWORK=IO%NGROUND_LAYER -ELSE - IWORK=2 !Only 2 temperature layer in ISBA-FR -ENDIF -! -DO JL=1,IWORK - WRITE(YLVL,'(I4)') JL - YRECFM='TG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) - YFORM='(A6,I1.1,A4)' - IF (JL >= 10) YFORM='(A6,I2.2,A4)' - WRITE(YCOMMENT,FMT=YFORM) 'X_Y_TG',JL,' (K)' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XTG(:,JL),KI,S%XWORK_WR) - ENDDO -END DO -! -!* soil liquid water contents -! -DO JL=1,IO%NGROUND_LAYER - WRITE(YLVL,'(I4)') JL - YRECFM='WG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) - YFORM='(A6,I1.1,A8)' - IF (JL >= 10) YFORM='(A6,I2.2,A8)' - WRITE(YCOMMENT,FMT=YFORM) 'X_Y_WG',JL,' (m3/m3)' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XWG(:,JL),KI,S%XWORK_WR) - ENDDO -END DO -! -!* soil ice water contents -! -IF(IO%CISBA=='DIF')THEN - IWORK=IO%NGROUND_LAYER -ELSE - IWORK=2 !Only 2 soil ice layer in ISBA-FR -ENDIF -! -DO JL=1,IWORK - WRITE(YLVL,'(I4)') JL - YRECFM='WGI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) - YFORM='(A7,I1.1,A8)' - IF (JL >= 10) YFORM='(A7,I2.2,A8)' - WRITE(YCOMMENT,YFORM) 'X_Y_WGI',JL,' (m3/m3)' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XWGI(:,JL),KI,S%XWORK_WR) - ENDDO -END DO -! -!* water intercepted on leaves -! -YRECFM='WR' -YCOMMENT='X_Y_WR (kg/m2)' -DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XWR(:),KI,S%XWORK_WR) -ENDDO -! -!* Glacier ice storage -! -YRECFM = 'GLACIER' -YCOMMENT='LGLACIER key for external prep' -CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,IO%LGLACIER,IRESP,HCOMMENT=YCOMMENT) -! -IF(IO%LGLACIER)THEN - YRECFM='ICE_STO' - YCOMMENT='X_Y_ICE_STO (kg/m2)' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XICE_STO(:),KI,S%XWORK_WR) - ENDDO -ENDIF -! -!* Leaf Area Index -! -IF (IO%CPHOTO/='NON' .AND. IO%CPHOTO/='AST') THEN - ! - YRECFM='LAI' - ! - YCOMMENT='X_Y_LAI (m2/m2)' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XLAI(:),KI,S%XWORK_WR) - ENDDO - ! -END IF -! -IF ( TRIM(CASSIM_ISBA)=="ENKF" .AND. (LASSIM .OR. NIE/=0) ) THEN - DO JVAR = 1,NVAR - IF ( XADDTIMECORR(JVAR)>0. ) THEN - WRITE(YVAR,'(I3)') JVAR - YCOMMENT = 'Red_Noise_Enkf' - YRECFM='RD_NS'//ADJUSTL(YVAR(:LEN_TRIM(YVAR))) - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NP%AL(JP)%XRED_NOISE(:,JVAR),KI,S%XWORK_WR) - ENDDO - ENDIF - ENDDO -ENDIF -! -!* snow mantel -! -DO JP = 1,IO%NPATCH - CALL WRITESURF_GR_SNOW(OSNOWDIMNC, HSELECT, HPROGRAM, 'VEG', ' ', KI, & - NP%AL(JP)%NR_P, JP, NPE%AL(JP)%TSNOW, S%XWSN_WR, S%XRHO_WR, & - S%XHEA_WR, S%XAGE_WR, S%XSG1_WR, S%XSG2_WR, S%XHIS_WR, S%XALB_WR) -ENDDO -! -!* key and/or field usefull to make an external prep -! -IF(IO%CISBA=='DIF')THEN -! - YRECFM = 'SOC' - YCOMMENT='SOC key for external prep' - CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,IO%LSOC,IRESP,HCOMMENT=YCOMMENT) -! -ELSE -! - YRECFM = 'TEMPARP' - YCOMMENT='LTEMP_ARP key for external prep' - CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,IO%LTEMP_ARP,IRESP,HCOMMENT=YCOMMENT) -! - IF(IO%LTEMP_ARP)THEN - YRECFM = 'NTEMPLARP' - YCOMMENT='NTEMPLAYER_ARP for external prep' - CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,IO%NTEMPLAYER_ARP,IRESP,HCOMMENT=YCOMMENT) - ENDIF -! -ENDIF -! -!------------------------------------------------------------------------------- -! -!* 3. MEB Prognostic or Semi-prognostic variables -! ------------------------------------------- -! -! -ISIZE_LMEB_PATCH=COUNT(IO%LMEB_PATCH(:)) -! -IF (ISIZE_LMEB_PATCH>0) THEN -! -!* water intercepted on canopy vegetation leaves -! - YRECFM='WRL' - YCOMMENT='X_Y_WRL (kg/m2)' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XWRL(:),KI,S%XWORK_WR) - ENDDO -! -!* ice on litter -! - YRECFM='WRLI' - YCOMMENT='X_Y_WRLI (kg/m2)' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XWRLI(:),KI,S%XWORK_WR) - ENDDO -! -!* snow intercepted on canopy vegetation leaves -! - YRECFM='WRVN' - YCOMMENT='X_Y_WRVN (kg/m2)' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XWRVN(:),KI,S%XWORK_WR) - ENDDO - -! -!* canopy vegetation temperature -! - YRECFM='TV' - YCOMMENT='X_Y_TV (K)' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XTV(:),KI,S%XWORK_WR) - ENDDO -! -!* litter temperature -! - YRECFM='TL' - YCOMMENT='X_Y_TL (K)' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XTL(:),KI,S%XWORK_WR) - ENDDO -! -!* vegetation canopy air temperature -! - YRECFM='TC' - YCOMMENT='X_Y_TC (K)' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XTC(:),KI,S%XWORK_WR) - ENDDO -! -!* vegetation canopy air specific humidity -! - YRECFM='QC' - YCOMMENT='X_Y_QC (kg/kg)' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XQC(:),KI,S%XWORK_WR) - ENDDO -! -ENDIF -! -!------------------------------------------------------------------------------- -! -!* 4. Semi-prognostic variables -! ------------------------- -! -! -!* Fraction for each patch -! -YRECFM='PATCH' -YCOMMENT='fraction for each patch (-)' -DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NP%AL(JP)%XPATCH(:),KI,S%XWORK_WR) -ENDDO -! -!* patch averaged radiative temperature (K) -! -YRECFM='TSRAD_NAT' -YCOMMENT='X_TSRAD_NAT (K)' - CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,S%XTSRAD_NAT(:),IRESP,HCOMMENT=YCOMMENT) -! -!* aerodynamical resistance -! -YRECFM='RESA' -YCOMMENT='X_Y_RESA (s/m)' -DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XRESA(:),KI,S%XWORK_WR) -ENDDO -! -!* Land use variables -! -IF(OLAND_USE .OR. LWRITE_EXTERN)THEN -! - DO JL=1,IO%NGROUND_LAYER - WRITE(YLVL,'(I4)') JL - YFORM='(A6,I1.1,A8)' - IF (JL >= 10) YFORM='(A6,I2.2,A8)' - IF (OLAND_USE) THEN - YRECFM='OLD_DG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) - WRITE(YCOMMENT,FMT=YFORM) 'X_Y_OLD_DG',JL,' (m)' - ELSE - YRECFM='DG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) - WRITE(YCOMMENT,FMT=YFORM) 'X_Y_DG',JL,' (m)' - ENDIF - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NP%AL(JP)%XDG(:,JL),KI,S%XWORK_WR) - ENDDO - END DO -! -ENDIF -! -!* ISBA-AGS variables -! -IF (IO%CPHOTO/='NON') THEN - YRECFM='AN' - YCOMMENT='X_Y_AN (kgCO2/kgair m/s)' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XAN(:),KI,S%XWORK_WR) - ENDDO -! - YRECFM='ANDAY' - YCOMMENT='X_Y_ANDAY (kgCO2/m2/day)' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XANDAY(:),KI,S%XWORK_WR) - ENDDO -! - YRECFM='ANFM' - YCOMMENT='X_Y_ANFM (kgCO2/kgair m/s)' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XANFM(:),KI,S%XWORK_WR) - ENDDO -! - YRECFM='LE_AGS' - YCOMMENT='X_Y_LE_AGS (W/m2)' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XLE(:),KI,S%XWORK_WR) - ENDDO -END IF -! -! -IF (IO%CPHOTO=='NIT' .OR. IO%CPHOTO=='NCB') THEN - ! - DO JNB=1,IO%NNBIOMASS - WRITE(YLVL,'(I1)') JNB - YRECFM='BIOMA'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) - YFORM='(A11,I1.1,A10)' - WRITE(YCOMMENT,FMT=YFORM) 'X_Y_BIOMASS',JNB,' (kgDM/m2)' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XBIOMASS(:,JNB),KI,S%XWORK_WR) - ENDDO - END DO - ! - ! - DO JNB=2,IO%NNBIOMASS - WRITE(YLVL,'(I1)') JNB - YRECFM='RESPI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) - YFORM='(A16,I1.1,A10)' - WRITE(YCOMMENT,FMT=YFORM) 'X_Y_RESP_BIOMASS',JNB,' (kg/m2/s)' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XRESP_BIOMASS(:,JNB),KI,S%XWORK_WR) - ENDDO - END DO - ! -END IF -! -!* Soil carbon -! -YRECFM = 'RESPSL' -YCOMMENT=YRECFM - CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,IO%CRESPSL,IRESP,HCOMMENT=YCOMMENT) -! -YRECFM='NLITTER' -YCOMMENT=YRECFM - CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,IO%NNLITTER,IRESP,HCOMMENT=YCOMMENT) -! -YRECFM='NLITTLEVS' -YCOMMENT=YRECFM - CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,IO%NNLITTLEVS,IRESP,HCOMMENT=YCOMMENT) -! -YRECFM='NSOILCARB' -YCOMMENT=YRECFM - CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,IO%NNSOILCARB,IRESP,HCOMMENT=YCOMMENT) -! -IF(IO%LSPINUPCARBS.OR.IO%LSPINUPCARBW)THEN - YRECFM='NBYEARSOLD' - YCOMMENT='yrs' - CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,IO%NNBYEARSOLD,IRESP,HCOMMENT=YCOMMENT) -ENDIF -! -IF (IO%CRESPSL=='CNT') THEN - ! - DO JNL=1,IO%NNLITTER - DO JNLV=1,IO%NNLITTLEVS - WRITE(YLVL,'(I1,A1,I1)') JNL,'_',JNLV - YRECFM='LITTER'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) - YFORM='(A10,I1.1,A1,I1.1,A8)' - WRITE(YCOMMENT,FMT=YFORM) 'X_Y_LITTER',JNL,' ',JNLV,' (gC/m2)' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XLITTER(:,JNL,JNLV),KI,S%XWORK_WR) - ENDDO - END DO - END DO - - DO JNS=1,IO%NNSOILCARB - WRITE(YLVL,'(I4)') JNS - YRECFM='SOILCARB'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) - YFORM='(A8,I1.1,A8)' - WRITE(YCOMMENT,FMT=YFORM) 'X_Y_SOILCARB',JNS,' (gC/m2)' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XSOILCARB(:,JNS),KI,S%XWORK_WR) - ENDDO - END DO -! - DO JNLV=1,IO%NNLITTLEVS - WRITE(YLVL,'(I4)') JNLV - YRECFM='LIGN_STR'//ADJUSTL(YLVL(:LEN_TRIM(YLVL))) - YFORM='(A12,I1.1,A8)' - WRITE(YCOMMENT,FMT=YFORM) 'X_Y_LIGNIN_STRUC',JNLV,' (-)' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NPE%AL(JP)%XLIGNIN_STRUC(:,JNLV),KI,S%XWORK_WR) - ENDDO - END DO -! -ENDIF -! -! -!UPG*PT -! Je ne sais pas qui a codé cette ecriture mais chez moi ca plante. Pourtant XSFDSTM est bien calculé dans coupling_isban -!IF (CHI%SVI%NDSTEQ > 0)THEN -! DO JSV = 1,NDSTMDE ! for all dust modes -! WRITE(YRECFM,'(A6,I3.3)')'F_DSTM',JSV -! YCOMMENT='X_Y_'//YRECFM//' (kg/m2)' -! DO JP = 1,IO%NPATCH -! CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& -! NP%AL(JP)%NR_P,NDST%AL(JP)%XSFDSTM(:,JSV),KI,S%XWORK_WR) -! ENDDO -! END DO -!ENDIF -!UPG*PT -! -!------------------------------------------------------------------------------- - -!* 5. Time -! ---- -! -YRECFM='DTCUR' -YCOMMENT='s' - CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,S%TTIME,IRESP,HCOMMENT=YCOMMENT) -! -IF (LHOOK) CALL DR_HOOK('WRITESURF_ISBA_N',1,ZHOOK_HANDLE) -! -!------------------------------------------------------------------------------- -! -END SUBROUTINE WRITESURF_ISBA_n diff --git a/src/MNH/BASIC.f90 b/src/MNH/BASIC.f90 old mode 100755 new mode 100644 index 0160a3c40..b08332e85 --- a/src/MNH/BASIC.f90 +++ b/src/MNH/BASIC.f90 @@ -1,5 +1,3 @@ -! Modifications: -! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg ! !======================================================================== ! @@ -168,6 +166,9 @@ ! K130=4.00E-12::XO2+NO-->NO2 ! K131=1.20E-12::XO2+NO3-->NO2 ! K132=1.00E-40::SULF--> +! K133=5.40E-13::DMS+NO3-->SO2+NO2 +! K134=1.30E-11*exp(-(400./TPK%T))::DMS+O3P-->SO2 +! K135=(TPK%T*exp(-234./TPK%T)+8.4E-10*exp(7230./TPK%T)+2.68E-10*exp(7810./TPK%T))/(1.04E11*TPK%T+88.1*exp(7460./TPK%T))::DMS+OH-->0.8*SO2 ! KTC1=@KT(0.05,48.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::O3-->WC_O3 ! KTC2=@KT(0.11,34.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::H2O2-->WC_H2O2 ! KTC3=@KT(0.0001,30.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::NO-->WC_NO @@ -188,14 +189,14 @@ ! KTC18=@KT(0.03,60.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::ORA2-->WC_ORA2 ! KTC19=@KT(0.05,47.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::MO2-->WC_MO2 ! KTC20=@KT(0.007,48.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::OP1-->WC_OP1 -! KTC21=@KT(0.05,48.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(1.1e-2,-2830.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_O3-->O3 -! KTC22=@KT(0.11,34.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(7.73e4,-7310.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_H2O2-->H2O2 +! KTC21=@KT(0.05,48.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(1.03e-2,-2830.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_O3-->O3 +! KTC22=@KT(0.11,34.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(8.44e4,-7600.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_H2O2-->H2O2 ! KTC23=@KT(0.0001,30.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(1.92e-3,-1790.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_NO-->NO -! KTC24=@KT(0.0015,46.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(1.4e-2,0.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_NO2-->NO2 +! KTC24=@KT(0.0015,46.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(1.2e-2,-2400.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_NO2-->NO2 ! KTC25=@KT(0.05,62.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(3.8e-2,0.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_NO3-->NO3 -! KTC26=@KT(0.0037,108.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(2.1,-3400.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_N2O5-->N2O5 +! KTC26=@KT(0.0037,108.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(8.8e-2,-3600.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_N2O5-->N2O5 ! KTC27=@KT(0.05,47.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(5.0e1,-4880.,1.6e-3,1760.,0.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_HONO-->HONO -! KTC28=@KT(0.054,63.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(2.1e5,-8700.,2.2e1,0.,0.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_HNO3-->HNO3 +! KTC28=@KT(0.054,63.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(2.1e5,-10500.,2.2e1,0.,0.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_HNO3-->HNO3 ! KTC29=@KT(0.05,79.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(1.2e4,-6900.,1.26e-6,0.,0.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_HNO4-->HNO4 ! KTC30=@KT(0.04,17.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFB(6.02e1,-4160.,1.7e-5,4350.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_NH3-->NH3 ! KTC31=@KT(0.05,17.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(3.9e1,0.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_OH-->OH @@ -206,7 +207,7 @@ ! KTC36=@KT(0.04,30.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(3.23e3,-7100.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_HCHO-->HCHO ! KTC37=@KT(0.012,46.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(8.9e3,-6100.,1.8e-4,150.,0.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_ORA1-->ORA1 ! KTC38=@KT(0.03,60.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(4.1e3,-6200.,1.74e-5,0.,0.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_ORA2-->ORA2 -! KTC39=@KT(0.05,47.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(2.7e0,-2030.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_MO2-->MO2 +! KTC39=@KT(0.05,47.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(2.45e0,-5280.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_MO2-->MO2 ! KTC40=@KT(0.007,48.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(3.e2,-5280.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_OP1-->OP1 ! KTR1=@KT(0.05,48.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::O3-->WR_O3 ! KTR2=@KT(0.11,34.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::H2O2-->WR_H2O2 @@ -228,14 +229,14 @@ ! KTR18=@KT(0.03,60.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::ORA2-->WR_ORA2 ! KTR19=@KT(0.05,47.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::MO2-->WR_MO2 ! KTR20=@KT(0.007,48.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::OP1-->WR_OP1 -! KTR21=@KT(0.05,48.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(1.1e-2,-2830.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_O3-->O3 -! KTR22=@KT(0.11,34.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(7.73e4,-7310.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_H2O2-->H2O2 +! KTR21=@KT(0.05,48.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(1.03e-2,-2830.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_O3-->O3 +! KTR22=@KT(0.11,34.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(8.44e4,-7600.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_H2O2-->H2O2 ! KTR23=@KT(0.0001,30.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(1.92e-3,-1790.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_NO-->NO -! KTR24=@KT(0.0015,46.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(1.4e-2,0.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_NO2-->NO2 +! KTR24=@KT(0.0015,46.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(1.2e-2,-2400.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_NO2-->NO2 ! KTR25=@KT(0.05,62.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(3.8e-2,0.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_NO3-->NO3 -! KTR26=@KT(0.0037,108.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(2.1,-3400.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_N2O5-->N2O5 +! KTR26=@KT(0.0037,108.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(8.8e-2,-3600.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_N2O5-->N2O5 ! KTR27=@KT(0.05,47.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(5.0e1,-4880.,1.6e-3,1760.,0.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_HONO-->HONO -! KTR28=@KT(0.054,63.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(2.1e5,-8700.,2.2e1,0.,0.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_HNO3-->HNO3 +! KTR28=@KT(0.054,63.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(2.1e5,-10500.,2.2e1,0.,0.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_HNO3-->HNO3 ! KTR29=@KT(0.05,79.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(1.2e4,-6900.,1.26e-6,0.,0.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_HNO4-->HNO4 ! KTR30=@KT(0.04,17.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFB(6.02e1,-4160.,1.7e-5,4350.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_NH3-->NH3 ! KTR31=@KT(0.05,17.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(3.9e1,0.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_OH-->OH @@ -246,7 +247,7 @@ ! KTR36=@KT(0.04,30.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(3.23e3,-7100.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_HCHO-->HCHO ! KTR37=@KT(0.012,46.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(8.9e3,-6100.,1.8e-4,150.,0.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_ORA1-->ORA1 ! KTR38=@KT(0.03,60.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(4.1e3,-6200.,1.74e-5,0.,0.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_ORA2-->ORA2 -! KTR39=@KT(0.05,47.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(2.7e0,-2030.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_MO2-->MO2 +! KTR39=@KT(0.05,47.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(2.45e0,-5280.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_MO2-->MO2 ! KTR40=@KT(0.007,48.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(3.e2,-5280.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_OP1-->OP1 ! KC1=!ZRATES(:,018)::WC_H2O2-->WC_OH+WC_OH ! KC2=(3.6E+9*exp(-930.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLECCLOUD::WC_OH+WC_OH-->WC_H2O2 @@ -323,87 +324,88 @@ ! 8. HNO3 PCONC(:,8) ! 9. HNO4 PCONC(:,9) ! 10. NH3 PCONC(:,10) -! 11. SO2 PCONC(:,11) -! 12. SULF PCONC(:,12) -! 13. CO PCONC(:,13) -! 14. OH PCONC(:,14) -! 15. HO2 PCONC(:,15) -! 16. CH4 PCONC(:,16) -! 17. ETH PCONC(:,17) -! 18. ALKA PCONC(:,18) -! 19. ALKE PCONC(:,19) -! 20. BIO PCONC(:,20) -! 21. ARO PCONC(:,21) -! 22. HCHO PCONC(:,22) -! 23. ALD PCONC(:,23) -! 24. KET PCONC(:,24) -! 25. CARBO PCONC(:,25) -! 26. ONIT PCONC(:,26) -! 27. PAN PCONC(:,27) -! 28. OP1 PCONC(:,28) -! 29. OP2 PCONC(:,29) -! 30. ORA1 PCONC(:,30) -! 31. ORA2 PCONC(:,31) -! 32. MO2 PCONC(:,32) -! 33. ALKAP PCONC(:,33) -! 34. ALKEP PCONC(:,34) -! 35. BIOP PCONC(:,35) -! 36. PHO PCONC(:,36) -! 37. ADD PCONC(:,37) -! 38. AROP PCONC(:,38) -! 39. CARBOP PCONC(:,39) -! 40. OLN PCONC(:,40) -! 41. XO2 PCONC(:,41) -! 42. WC_O3 PCONC(:,42) -! 43. WC_H2O2 PCONC(:,43) -! 44. WC_NO PCONC(:,44) -! 45. WC_NO2 PCONC(:,45) -! 46. WC_NO3 PCONC(:,46) -! 47. WC_N2O5 PCONC(:,47) -! 48. WC_HONO PCONC(:,48) -! 49. WC_HNO3 PCONC(:,49) -! 50. WC_HNO4 PCONC(:,50) -! 51. WC_NH3 PCONC(:,51) -! 52. WC_OH PCONC(:,52) -! 53. WC_HO2 PCONC(:,53) -! 54. WC_CO2 PCONC(:,54) -! 55. WC_SO2 PCONC(:,55) -! 56. WC_SULF PCONC(:,56) -! 57. WC_HCHO PCONC(:,57) -! 58. WC_ORA1 PCONC(:,58) -! 59. WC_ORA2 PCONC(:,59) -! 60. WC_MO2 PCONC(:,60) -! 61. WC_OP1 PCONC(:,61) -! 62. WC_ASO3 PCONC(:,62) -! 63. WC_ASO4 PCONC(:,63) -! 64. WC_ASO5 PCONC(:,64) -! 65. WC_AHSO5 PCONC(:,65) -! 66. WC_AHMS PCONC(:,66) -! 67. WR_O3 PCONC(:,67) -! 68. WR_H2O2 PCONC(:,68) -! 69. WR_NO PCONC(:,69) -! 70. WR_NO2 PCONC(:,70) -! 71. WR_NO3 PCONC(:,71) -! 72. WR_N2O5 PCONC(:,72) -! 73. WR_HONO PCONC(:,73) -! 74. WR_HNO3 PCONC(:,74) -! 75. WR_HNO4 PCONC(:,75) -! 76. WR_NH3 PCONC(:,76) -! 77. WR_OH PCONC(:,77) -! 78. WR_HO2 PCONC(:,78) -! 79. WR_CO2 PCONC(:,79) -! 80. WR_SO2 PCONC(:,80) -! 81. WR_SULF PCONC(:,81) -! 82. WR_HCHO PCONC(:,82) -! 83. WR_ORA1 PCONC(:,83) -! 84. WR_ORA2 PCONC(:,84) -! 85. WR_MO2 PCONC(:,85) -! 86. WR_OP1 PCONC(:,86) -! 87. WR_ASO3 PCONC(:,87) -! 88. WR_ASO4 PCONC(:,88) -! 89. WR_ASO5 PCONC(:,89) -! 90. WR_AHSO5 PCONC(:,90) -! 91. WR_AHMS PCONC(:,91) +! 11. DMS PCONC(:,11) +! 12. SO2 PCONC(:,12) +! 13. SULF PCONC(:,13) +! 14. CO PCONC(:,14) +! 15. OH PCONC(:,15) +! 16. HO2 PCONC(:,16) +! 17. CH4 PCONC(:,17) +! 18. ETH PCONC(:,18) +! 19. ALKA PCONC(:,19) +! 20. ALKE PCONC(:,20) +! 21. BIO PCONC(:,21) +! 22. ARO PCONC(:,22) +! 23. HCHO PCONC(:,23) +! 24. ALD PCONC(:,24) +! 25. KET PCONC(:,25) +! 26. CARBO PCONC(:,26) +! 27. ONIT PCONC(:,27) +! 28. PAN PCONC(:,28) +! 29. OP1 PCONC(:,29) +! 30. OP2 PCONC(:,30) +! 31. ORA1 PCONC(:,31) +! 32. ORA2 PCONC(:,32) +! 33. MO2 PCONC(:,33) +! 34. ALKAP PCONC(:,34) +! 35. ALKEP PCONC(:,35) +! 36. BIOP PCONC(:,36) +! 37. PHO PCONC(:,37) +! 38. ADD PCONC(:,38) +! 39. AROP PCONC(:,39) +! 40. CARBOP PCONC(:,40) +! 41. OLN PCONC(:,41) +! 42. XO2 PCONC(:,42) +! 43. WC_O3 PCONC(:,43) +! 44. WC_H2O2 PCONC(:,44) +! 45. WC_NO PCONC(:,45) +! 46. WC_NO2 PCONC(:,46) +! 47. WC_NO3 PCONC(:,47) +! 48. WC_N2O5 PCONC(:,48) +! 49. WC_HONO PCONC(:,49) +! 50. WC_HNO3 PCONC(:,50) +! 51. WC_HNO4 PCONC(:,51) +! 52. WC_NH3 PCONC(:,52) +! 53. WC_OH PCONC(:,53) +! 54. WC_HO2 PCONC(:,54) +! 55. WC_CO2 PCONC(:,55) +! 56. WC_SO2 PCONC(:,56) +! 57. WC_SULF PCONC(:,57) +! 58. WC_HCHO PCONC(:,58) +! 59. WC_ORA1 PCONC(:,59) +! 60. WC_ORA2 PCONC(:,60) +! 61. WC_MO2 PCONC(:,61) +! 62. WC_OP1 PCONC(:,62) +! 63. WC_ASO3 PCONC(:,63) +! 64. WC_ASO4 PCONC(:,64) +! 65. WC_ASO5 PCONC(:,65) +! 66. WC_AHSO5 PCONC(:,66) +! 67. WC_AHMS PCONC(:,67) +! 68. WR_O3 PCONC(:,68) +! 69. WR_H2O2 PCONC(:,69) +! 70. WR_NO PCONC(:,70) +! 71. WR_NO2 PCONC(:,71) +! 72. WR_NO3 PCONC(:,72) +! 73. WR_N2O5 PCONC(:,73) +! 74. WR_HONO PCONC(:,74) +! 75. WR_HNO3 PCONC(:,75) +! 76. WR_HNO4 PCONC(:,76) +! 77. WR_NH3 PCONC(:,77) +! 78. WR_OH PCONC(:,78) +! 79. WR_HO2 PCONC(:,79) +! 80. WR_CO2 PCONC(:,80) +! 81. WR_SO2 PCONC(:,81) +! 82. WR_SULF PCONC(:,82) +! 83. WR_HCHO PCONC(:,83) +! 84. WR_ORA1 PCONC(:,84) +! 85. WR_ORA2 PCONC(:,85) +! 86. WR_MO2 PCONC(:,86) +! 87. WR_OP1 PCONC(:,87) +! 88. WR_ASO3 PCONC(:,88) +! 89. WR_ASO4 PCONC(:,89) +! 90. WR_ASO5 PCONC(:,90) +! 91. WR_AHSO5 PCONC(:,91) +! 92. WR_AHMS PCONC(:,92) ! !======================================================================== ! @@ -509,6 +511,7 @@ ! + 1.74072*K125*<OLN>*<NO3> ! + K130*<XO2>*<NO> ! + K131*<XO2>*<NO3> +! + K133*<DMS>*<NO3> ! + KTC24*<WC_NO2> ! + KTR24*<WR_NO2> ! - K001*<NO2> @@ -558,6 +561,7 @@ ! - K124*<CARBOP>*<NO3> ! - K125*<OLN>*<NO3> ! - K131*<XO2>*<NO3> +! - K133*<DMS>*<NO3> ! - KTC5*<NO3> ! - KTR5*<NO3> ! terms for N2O5: @@ -604,7 +608,15 @@ ! - K050*<NH3>*<OH> ! - KTC10*<NH3> ! - KTR10*<NH3> +! terms for DMS: +! + 0.0 +! - K133*<DMS>*<NO3> +! - K134*<DMS>*<O3P> +! - K135*<DMS>*<OH> ! terms for SO2: +! + K133*<DMS>*<NO3> +! + K134*<DMS>*<O3P> +! + 0.8*K135*<DMS>*<OH> ! + KTC34*<WC_SO2> ! + KTR34*<WR_SO2> ! - K052*<OH>*<SO2> @@ -686,6 +698,7 @@ ! - K069*<OP2>*<OH> ! - K070*<PAN>*<OH> ! - K071*<ONIT>*<OH> +! - K135*<DMS>*<OH> ! - KTC11*<OH> ! - KTR11*<OH> ! terms for HO2: @@ -1539,11 +1552,11 @@ !! DECLARATIONS !! ------------ IMPLICIT NONE -INTEGER, DIMENSION(2), PARAMETER :: JPNEQ = (/41,91/) ! number of prognostic chemical species +INTEGER, DIMENSION(2), PARAMETER :: JPNEQ = (/42,92/) ! number of prognostic chemical species INTEGER, DIMENSION(2), PARAMETER :: JPNEQAQ = (/0,50/) ! number of prognostic aqueous phase chemical species -INTEGER, DIMENSION(2), PARAMETER :: JPNREAC = (/132,272/) ! number of chemical reactions +INTEGER, DIMENSION(2), PARAMETER :: JPNREAC = (/135,275/) ! number of chemical reactions INTEGER, DIMENSION(2), PARAMETER :: JPNMETEOVARS = (/13,13/) ! number of meteorological variables -INTEGER, DIMENSION(2), PARAMETER :: JPNNONZEROTERMS = (/606,942/) ! number of non-zero terms returned by CH_TERMS +INTEGER, DIMENSION(2), PARAMETER :: JPNNONZEROTERMS = (/615,951/) ! number of non-zero terms returned by CH_TERMS ! CHARACTER(LEN=32), DIMENSION(JPNEQ(2)), TARGET :: CNAMES ! names of the species CHARACTER(LEN=32), DIMENSION(JPNREAC(2)), TARGET :: CREACS ! the reaction rate names @@ -1689,6 +1702,9 @@ REAL,DIMENSION(:),POINTER :: K129=>NULL() REAL,DIMENSION(:),POINTER :: K130=>NULL() REAL,DIMENSION(:),POINTER :: K131=>NULL() REAL,DIMENSION(:),POINTER :: K132=>NULL() +REAL,DIMENSION(:),POINTER :: K133=>NULL() +REAL,DIMENSION(:),POINTER :: K134=>NULL() +REAL,DIMENSION(:),POINTER :: K135=>NULL() REAL,DIMENSION(:),POINTER :: KTC1=>NULL() REAL,DIMENSION(:),POINTER :: KTC2=>NULL() REAL,DIMENSION(:),POINTER :: KTC3=>NULL() @@ -1888,87 +1904,88 @@ INTEGER, PARAMETER :: JP_HONO = 7 INTEGER, PARAMETER :: JP_HNO3 = 8 INTEGER, PARAMETER :: JP_HNO4 = 9 INTEGER, PARAMETER :: JP_NH3 = 10 -INTEGER, PARAMETER :: JP_SO2 = 11 -INTEGER, PARAMETER :: JP_SULF = 12 -INTEGER, PARAMETER :: JP_CO = 13 -INTEGER, PARAMETER :: JP_OH = 14 -INTEGER, PARAMETER :: JP_HO2 = 15 -INTEGER, PARAMETER :: JP_CH4 = 16 -INTEGER, PARAMETER :: JP_ETH = 17 -INTEGER, PARAMETER :: JP_ALKA = 18 -INTEGER, PARAMETER :: JP_ALKE = 19 -INTEGER, PARAMETER :: JP_BIO = 20 -INTEGER, PARAMETER :: JP_ARO = 21 -INTEGER, PARAMETER :: JP_HCHO = 22 -INTEGER, PARAMETER :: JP_ALD = 23 -INTEGER, PARAMETER :: JP_KET = 24 -INTEGER, PARAMETER :: JP_CARBO = 25 -INTEGER, PARAMETER :: JP_ONIT = 26 -INTEGER, PARAMETER :: JP_PAN = 27 -INTEGER, PARAMETER :: JP_OP1 = 28 -INTEGER, PARAMETER :: JP_OP2 = 29 -INTEGER, PARAMETER :: JP_ORA1 = 30 -INTEGER, PARAMETER :: JP_ORA2 = 31 -INTEGER, PARAMETER :: JP_MO2 = 32 -INTEGER, PARAMETER :: JP_ALKAP = 33 -INTEGER, PARAMETER :: JP_ALKEP = 34 -INTEGER, PARAMETER :: JP_BIOP = 35 -INTEGER, PARAMETER :: JP_PHO = 36 -INTEGER, PARAMETER :: JP_ADD = 37 -INTEGER, PARAMETER :: JP_AROP = 38 -INTEGER, PARAMETER :: JP_CARBOP = 39 -INTEGER, PARAMETER :: JP_OLN = 40 -INTEGER, PARAMETER :: JP_XO2 = 41 -INTEGER, PARAMETER :: JP_WC_O3 = 42 -INTEGER, PARAMETER :: JP_WC_H2O2 = 43 -INTEGER, PARAMETER :: JP_WC_NO = 44 -INTEGER, PARAMETER :: JP_WC_NO2 = 45 -INTEGER, PARAMETER :: JP_WC_NO3 = 46 -INTEGER, PARAMETER :: JP_WC_N2O5 = 47 -INTEGER, PARAMETER :: JP_WC_HONO = 48 -INTEGER, PARAMETER :: JP_WC_HNO3 = 49 -INTEGER, PARAMETER :: JP_WC_HNO4 = 50 -INTEGER, PARAMETER :: JP_WC_NH3 = 51 -INTEGER, PARAMETER :: JP_WC_OH = 52 -INTEGER, PARAMETER :: JP_WC_HO2 = 53 -INTEGER, PARAMETER :: JP_WC_CO2 = 54 -INTEGER, PARAMETER :: JP_WC_SO2 = 55 -INTEGER, PARAMETER :: JP_WC_SULF = 56 -INTEGER, PARAMETER :: JP_WC_HCHO = 57 -INTEGER, PARAMETER :: JP_WC_ORA1 = 58 -INTEGER, PARAMETER :: JP_WC_ORA2 = 59 -INTEGER, PARAMETER :: JP_WC_MO2 = 60 -INTEGER, PARAMETER :: JP_WC_OP1 = 61 -INTEGER, PARAMETER :: JP_WC_ASO3 = 62 -INTEGER, PARAMETER :: JP_WC_ASO4 = 63 -INTEGER, PARAMETER :: JP_WC_ASO5 = 64 -INTEGER, PARAMETER :: JP_WC_AHSO5 = 65 -INTEGER, PARAMETER :: JP_WC_AHMS = 66 -INTEGER, PARAMETER :: JP_WR_O3 = 67 -INTEGER, PARAMETER :: JP_WR_H2O2 = 68 -INTEGER, PARAMETER :: JP_WR_NO = 69 -INTEGER, PARAMETER :: JP_WR_NO2 = 70 -INTEGER, PARAMETER :: JP_WR_NO3 = 71 -INTEGER, PARAMETER :: JP_WR_N2O5 = 72 -INTEGER, PARAMETER :: JP_WR_HONO = 73 -INTEGER, PARAMETER :: JP_WR_HNO3 = 74 -INTEGER, PARAMETER :: JP_WR_HNO4 = 75 -INTEGER, PARAMETER :: JP_WR_NH3 = 76 -INTEGER, PARAMETER :: JP_WR_OH = 77 -INTEGER, PARAMETER :: JP_WR_HO2 = 78 -INTEGER, PARAMETER :: JP_WR_CO2 = 79 -INTEGER, PARAMETER :: JP_WR_SO2 = 80 -INTEGER, PARAMETER :: JP_WR_SULF = 81 -INTEGER, PARAMETER :: JP_WR_HCHO = 82 -INTEGER, PARAMETER :: JP_WR_ORA1 = 83 -INTEGER, PARAMETER :: JP_WR_ORA2 = 84 -INTEGER, PARAMETER :: JP_WR_MO2 = 85 -INTEGER, PARAMETER :: JP_WR_OP1 = 86 -INTEGER, PARAMETER :: JP_WR_ASO3 = 87 -INTEGER, PARAMETER :: JP_WR_ASO4 = 88 -INTEGER, PARAMETER :: JP_WR_ASO5 = 89 -INTEGER, PARAMETER :: JP_WR_AHSO5 = 90 -INTEGER, PARAMETER :: JP_WR_AHMS = 91 +INTEGER, PARAMETER :: JP_DMS = 11 +INTEGER, PARAMETER :: JP_SO2 = 12 +INTEGER, PARAMETER :: JP_SULF = 13 +INTEGER, PARAMETER :: JP_CO = 14 +INTEGER, PARAMETER :: JP_OH = 15 +INTEGER, PARAMETER :: JP_HO2 = 16 +INTEGER, PARAMETER :: JP_CH4 = 17 +INTEGER, PARAMETER :: JP_ETH = 18 +INTEGER, PARAMETER :: JP_ALKA = 19 +INTEGER, PARAMETER :: JP_ALKE = 20 +INTEGER, PARAMETER :: JP_BIO = 21 +INTEGER, PARAMETER :: JP_ARO = 22 +INTEGER, PARAMETER :: JP_HCHO = 23 +INTEGER, PARAMETER :: JP_ALD = 24 +INTEGER, PARAMETER :: JP_KET = 25 +INTEGER, PARAMETER :: JP_CARBO = 26 +INTEGER, PARAMETER :: JP_ONIT = 27 +INTEGER, PARAMETER :: JP_PAN = 28 +INTEGER, PARAMETER :: JP_OP1 = 29 +INTEGER, PARAMETER :: JP_OP2 = 30 +INTEGER, PARAMETER :: JP_ORA1 = 31 +INTEGER, PARAMETER :: JP_ORA2 = 32 +INTEGER, PARAMETER :: JP_MO2 = 33 +INTEGER, PARAMETER :: JP_ALKAP = 34 +INTEGER, PARAMETER :: JP_ALKEP = 35 +INTEGER, PARAMETER :: JP_BIOP = 36 +INTEGER, PARAMETER :: JP_PHO = 37 +INTEGER, PARAMETER :: JP_ADD = 38 +INTEGER, PARAMETER :: JP_AROP = 39 +INTEGER, PARAMETER :: JP_CARBOP = 40 +INTEGER, PARAMETER :: JP_OLN = 41 +INTEGER, PARAMETER :: JP_XO2 = 42 +INTEGER, PARAMETER :: JP_WC_O3 = 43 +INTEGER, PARAMETER :: JP_WC_H2O2 = 44 +INTEGER, PARAMETER :: JP_WC_NO = 45 +INTEGER, PARAMETER :: JP_WC_NO2 = 46 +INTEGER, PARAMETER :: JP_WC_NO3 = 47 +INTEGER, PARAMETER :: JP_WC_N2O5 = 48 +INTEGER, PARAMETER :: JP_WC_HONO = 49 +INTEGER, PARAMETER :: JP_WC_HNO3 = 50 +INTEGER, PARAMETER :: JP_WC_HNO4 = 51 +INTEGER, PARAMETER :: JP_WC_NH3 = 52 +INTEGER, PARAMETER :: JP_WC_OH = 53 +INTEGER, PARAMETER :: JP_WC_HO2 = 54 +INTEGER, PARAMETER :: JP_WC_CO2 = 55 +INTEGER, PARAMETER :: JP_WC_SO2 = 56 +INTEGER, PARAMETER :: JP_WC_SULF = 57 +INTEGER, PARAMETER :: JP_WC_HCHO = 58 +INTEGER, PARAMETER :: JP_WC_ORA1 = 59 +INTEGER, PARAMETER :: JP_WC_ORA2 = 60 +INTEGER, PARAMETER :: JP_WC_MO2 = 61 +INTEGER, PARAMETER :: JP_WC_OP1 = 62 +INTEGER, PARAMETER :: JP_WC_ASO3 = 63 +INTEGER, PARAMETER :: JP_WC_ASO4 = 64 +INTEGER, PARAMETER :: JP_WC_ASO5 = 65 +INTEGER, PARAMETER :: JP_WC_AHSO5 = 66 +INTEGER, PARAMETER :: JP_WC_AHMS = 67 +INTEGER, PARAMETER :: JP_WR_O3 = 68 +INTEGER, PARAMETER :: JP_WR_H2O2 = 69 +INTEGER, PARAMETER :: JP_WR_NO = 70 +INTEGER, PARAMETER :: JP_WR_NO2 = 71 +INTEGER, PARAMETER :: JP_WR_NO3 = 72 +INTEGER, PARAMETER :: JP_WR_N2O5 = 73 +INTEGER, PARAMETER :: JP_WR_HONO = 74 +INTEGER, PARAMETER :: JP_WR_HNO3 = 75 +INTEGER, PARAMETER :: JP_WR_HNO4 = 76 +INTEGER, PARAMETER :: JP_WR_NH3 = 77 +INTEGER, PARAMETER :: JP_WR_OH = 78 +INTEGER, PARAMETER :: JP_WR_HO2 = 79 +INTEGER, PARAMETER :: JP_WR_CO2 = 80 +INTEGER, PARAMETER :: JP_WR_SO2 = 81 +INTEGER, PARAMETER :: JP_WR_SULF = 82 +INTEGER, PARAMETER :: JP_WR_HCHO = 83 +INTEGER, PARAMETER :: JP_WR_ORA1 = 84 +INTEGER, PARAMETER :: JP_WR_ORA2 = 85 +INTEGER, PARAMETER :: JP_WR_MO2 = 86 +INTEGER, PARAMETER :: JP_WR_OP1 = 87 +INTEGER, PARAMETER :: JP_WR_ASO3 = 88 +INTEGER, PARAMETER :: JP_WR_ASO4 = 89 +INTEGER, PARAMETER :: JP_WR_ASO5 = 90 +INTEGER, PARAMETER :: JP_WR_AHSO5 = 91 +INTEGER, PARAMETER :: JP_WR_AHMS = 92 ! END MODULE MODD_CH_M9_SCHEME ! @@ -2172,6 +2189,9 @@ ALLOCATE(TACCS(KMI)%K129(KVECNPT)) ALLOCATE(TACCS(KMI)%K130(KVECNPT)) ALLOCATE(TACCS(KMI)%K131(KVECNPT)) ALLOCATE(TACCS(KMI)%K132(KVECNPT)) +ALLOCATE(TACCS(KMI)%K133(KVECNPT)) +ALLOCATE(TACCS(KMI)%K134(KVECNPT)) +ALLOCATE(TACCS(KMI)%K135(KVECNPT)) IF (TACCS(KMI)%LUSECHAQ) THEN ALLOCATE(TACCS(KMI)%KTC1(KVECNPT)) ALLOCATE(TACCS(KMI)%KTC2(KVECNPT)) @@ -2545,6 +2565,9 @@ IF (ASSOCIATED(TACCS(KMI)%K129)) DEALLOCATE(TACCS(KMI)%K129) IF (ASSOCIATED(TACCS(KMI)%K130)) DEALLOCATE(TACCS(KMI)%K130) IF (ASSOCIATED(TACCS(KMI)%K131)) DEALLOCATE(TACCS(KMI)%K131) IF (ASSOCIATED(TACCS(KMI)%K132)) DEALLOCATE(TACCS(KMI)%K132) +IF (ASSOCIATED(TACCS(KMI)%K133)) DEALLOCATE(TACCS(KMI)%K133) +IF (ASSOCIATED(TACCS(KMI)%K134)) DEALLOCATE(TACCS(KMI)%K134) +IF (ASSOCIATED(TACCS(KMI)%K135)) DEALLOCATE(TACCS(KMI)%K135) IF (ASSOCIATED(TACCS(KMI)%KTC1)) DEALLOCATE(TACCS(KMI)%KTC1) IF (ASSOCIATED(TACCS(KMI)%KTC2)) DEALLOCATE(TACCS(KMI)%KTC2) IF (ASSOCIATED(TACCS(KMI)%KTC3)) DEALLOCATE(TACCS(KMI)%KTC3) @@ -2822,87 +2845,88 @@ IF (GFIRSTCALL) THEN CNAMES(8) = 'HNO3' CNAMES(9) = 'HNO4' CNAMES(10) = 'NH3' - CNAMES(11) = 'SO2' - CNAMES(12) = 'SULF' - CNAMES(13) = 'CO' - CNAMES(14) = 'OH' - CNAMES(15) = 'HO2' - CNAMES(16) = 'CH4' - CNAMES(17) = 'ETH' - CNAMES(18) = 'ALKA' - CNAMES(19) = 'ALKE' - CNAMES(20) = 'BIO' - CNAMES(21) = 'ARO' - CNAMES(22) = 'HCHO' - CNAMES(23) = 'ALD' - CNAMES(24) = 'KET' - CNAMES(25) = 'CARBO' - CNAMES(26) = 'ONIT' - CNAMES(27) = 'PAN' - CNAMES(28) = 'OP1' - CNAMES(29) = 'OP2' - CNAMES(30) = 'ORA1' - CNAMES(31) = 'ORA2' - CNAMES(32) = 'MO2' - CNAMES(33) = 'ALKAP' - CNAMES(34) = 'ALKEP' - CNAMES(35) = 'BIOP' - CNAMES(36) = 'PHO' - CNAMES(37) = 'ADD' - CNAMES(38) = 'AROP' - CNAMES(39) = 'CARBOP' - CNAMES(40) = 'OLN' - CNAMES(41) = 'XO2' - CNAMES(42) = 'WC_O3' - CNAMES(43) = 'WC_H2O2' - CNAMES(44) = 'WC_NO' - CNAMES(45) = 'WC_NO2' - CNAMES(46) = 'WC_NO3' - CNAMES(47) = 'WC_N2O5' - CNAMES(48) = 'WC_HONO' - CNAMES(49) = 'WC_HNO3' - CNAMES(50) = 'WC_HNO4' - CNAMES(51) = 'WC_NH3' - CNAMES(52) = 'WC_OH' - CNAMES(53) = 'WC_HO2' - CNAMES(54) = 'WC_CO2' - CNAMES(55) = 'WC_SO2' - CNAMES(56) = 'WC_SULF' - CNAMES(57) = 'WC_HCHO' - CNAMES(58) = 'WC_ORA1' - CNAMES(59) = 'WC_ORA2' - CNAMES(60) = 'WC_MO2' - CNAMES(61) = 'WC_OP1' - CNAMES(62) = 'WC_ASO3' - CNAMES(63) = 'WC_ASO4' - CNAMES(64) = 'WC_ASO5' - CNAMES(65) = 'WC_AHSO5' - CNAMES(66) = 'WC_AHMS' - CNAMES(67) = 'WR_O3' - CNAMES(68) = 'WR_H2O2' - CNAMES(69) = 'WR_NO' - CNAMES(70) = 'WR_NO2' - CNAMES(71) = 'WR_NO3' - CNAMES(72) = 'WR_N2O5' - CNAMES(73) = 'WR_HONO' - CNAMES(74) = 'WR_HNO3' - CNAMES(75) = 'WR_HNO4' - CNAMES(76) = 'WR_NH3' - CNAMES(77) = 'WR_OH' - CNAMES(78) = 'WR_HO2' - CNAMES(79) = 'WR_CO2' - CNAMES(80) = 'WR_SO2' - CNAMES(81) = 'WR_SULF' - CNAMES(82) = 'WR_HCHO' - CNAMES(83) = 'WR_ORA1' - CNAMES(84) = 'WR_ORA2' - CNAMES(85) = 'WR_MO2' - CNAMES(86) = 'WR_OP1' - CNAMES(87) = 'WR_ASO3' - CNAMES(88) = 'WR_ASO4' - CNAMES(89) = 'WR_ASO5' - CNAMES(90) = 'WR_AHSO5' - CNAMES(91) = 'WR_AHMS' + CNAMES(11) = 'DMS' + CNAMES(12) = 'SO2' + CNAMES(13) = 'SULF' + CNAMES(14) = 'CO' + CNAMES(15) = 'OH' + CNAMES(16) = 'HO2' + CNAMES(17) = 'CH4' + CNAMES(18) = 'ETH' + CNAMES(19) = 'ALKA' + CNAMES(20) = 'ALKE' + CNAMES(21) = 'BIO' + CNAMES(22) = 'ARO' + CNAMES(23) = 'HCHO' + CNAMES(24) = 'ALD' + CNAMES(25) = 'KET' + CNAMES(26) = 'CARBO' + CNAMES(27) = 'ONIT' + CNAMES(28) = 'PAN' + CNAMES(29) = 'OP1' + CNAMES(30) = 'OP2' + CNAMES(31) = 'ORA1' + CNAMES(32) = 'ORA2' + CNAMES(33) = 'MO2' + CNAMES(34) = 'ALKAP' + CNAMES(35) = 'ALKEP' + CNAMES(36) = 'BIOP' + CNAMES(37) = 'PHO' + CNAMES(38) = 'ADD' + CNAMES(39) = 'AROP' + CNAMES(40) = 'CARBOP' + CNAMES(41) = 'OLN' + CNAMES(42) = 'XO2' + CNAMES(43) = 'WC_O3' + CNAMES(44) = 'WC_H2O2' + CNAMES(45) = 'WC_NO' + CNAMES(46) = 'WC_NO2' + CNAMES(47) = 'WC_NO3' + CNAMES(48) = 'WC_N2O5' + CNAMES(49) = 'WC_HONO' + CNAMES(50) = 'WC_HNO3' + CNAMES(51) = 'WC_HNO4' + CNAMES(52) = 'WC_NH3' + CNAMES(53) = 'WC_OH' + CNAMES(54) = 'WC_HO2' + CNAMES(55) = 'WC_CO2' + CNAMES(56) = 'WC_SO2' + CNAMES(57) = 'WC_SULF' + CNAMES(58) = 'WC_HCHO' + CNAMES(59) = 'WC_ORA1' + CNAMES(60) = 'WC_ORA2' + CNAMES(61) = 'WC_MO2' + CNAMES(62) = 'WC_OP1' + CNAMES(63) = 'WC_ASO3' + CNAMES(64) = 'WC_ASO4' + CNAMES(65) = 'WC_ASO5' + CNAMES(66) = 'WC_AHSO5' + CNAMES(67) = 'WC_AHMS' + CNAMES(68) = 'WR_O3' + CNAMES(69) = 'WR_H2O2' + CNAMES(70) = 'WR_NO' + CNAMES(71) = 'WR_NO2' + CNAMES(72) = 'WR_NO3' + CNAMES(73) = 'WR_N2O5' + CNAMES(74) = 'WR_HONO' + CNAMES(75) = 'WR_HNO3' + CNAMES(76) = 'WR_HNO4' + CNAMES(77) = 'WR_NH3' + CNAMES(78) = 'WR_OH' + CNAMES(79) = 'WR_HO2' + CNAMES(80) = 'WR_CO2' + CNAMES(81) = 'WR_SO2' + CNAMES(82) = 'WR_SULF' + CNAMES(83) = 'WR_HCHO' + CNAMES(84) = 'WR_ORA1' + CNAMES(85) = 'WR_ORA2' + CNAMES(86) = 'WR_MO2' + CNAMES(87) = 'WR_OP1' + CNAMES(88) = 'WR_ASO3' + CNAMES(89) = 'WR_ASO4' + CNAMES(90) = 'WR_ASO5' + CNAMES(91) = 'WR_AHSO5' + CNAMES(92) = 'WR_AHMS' ! initialisation of the names of the reactions CREACS(1) = 'K001' CREACS(2) = 'K002' @@ -3036,146 +3060,149 @@ IF (GFIRSTCALL) THEN CREACS(130) = 'K130' CREACS(131) = 'K131' CREACS(132) = 'K132' - CREACS(133) = 'KTC1' - CREACS(134) = 'KTC2' - CREACS(135) = 'KTC3' - CREACS(136) = 'KTC4' - CREACS(137) = 'KTC5' - CREACS(138) = 'KTC6' - CREACS(139) = 'KTC7' - CREACS(140) = 'KTC8' - CREACS(141) = 'KTC9' - CREACS(142) = 'KTC10' - CREACS(143) = 'KTC11' - CREACS(144) = 'KTC12' - CREACS(145) = 'KTC13' - CREACS(146) = 'KTC14' - CREACS(147) = 'KTC15' - CREACS(148) = 'KTC16' - CREACS(149) = 'KTC17' - CREACS(150) = 'KTC18' - CREACS(151) = 'KTC19' - CREACS(152) = 'KTC20' - CREACS(153) = 'KTC21' - CREACS(154) = 'KTC22' - CREACS(155) = 'KTC23' - CREACS(156) = 'KTC24' - CREACS(157) = 'KTC25' - CREACS(158) = 'KTC26' - CREACS(159) = 'KTC27' - CREACS(160) = 'KTC28' - CREACS(161) = 'KTC29' - CREACS(162) = 'KTC30' - CREACS(163) = 'KTC31' - CREACS(164) = 'KTC32' - CREACS(165) = 'KTC33' - CREACS(166) = 'KTC34' - CREACS(167) = 'KTC35' - CREACS(168) = 'KTC36' - CREACS(169) = 'KTC37' - CREACS(170) = 'KTC38' - CREACS(171) = 'KTC39' - CREACS(172) = 'KTC40' - CREACS(173) = 'KTR1' - CREACS(174) = 'KTR2' - CREACS(175) = 'KTR3' - CREACS(176) = 'KTR4' - CREACS(177) = 'KTR5' - CREACS(178) = 'KTR6' - CREACS(179) = 'KTR7' - CREACS(180) = 'KTR8' - CREACS(181) = 'KTR9' - CREACS(182) = 'KTR10' - CREACS(183) = 'KTR11' - CREACS(184) = 'KTR12' - CREACS(185) = 'KTR13' - CREACS(186) = 'KTR14' - CREACS(187) = 'KTR15' - CREACS(188) = 'KTR16' - CREACS(189) = 'KTR17' - CREACS(190) = 'KTR18' - CREACS(191) = 'KTR19' - CREACS(192) = 'KTR20' - CREACS(193) = 'KTR21' - CREACS(194) = 'KTR22' - CREACS(195) = 'KTR23' - CREACS(196) = 'KTR24' - CREACS(197) = 'KTR25' - CREACS(198) = 'KTR26' - CREACS(199) = 'KTR27' - CREACS(200) = 'KTR28' - CREACS(201) = 'KTR29' - CREACS(202) = 'KTR30' - CREACS(203) = 'KTR31' - CREACS(204) = 'KTR32' - CREACS(205) = 'KTR33' - CREACS(206) = 'KTR34' - CREACS(207) = 'KTR35' - CREACS(208) = 'KTR36' - CREACS(209) = 'KTR37' - CREACS(210) = 'KTR38' - CREACS(211) = 'KTR39' - CREACS(212) = 'KTR40' - CREACS(213) = 'KC1' - CREACS(214) = 'KC2' - CREACS(215) = 'KC3' - CREACS(216) = 'KC4' - CREACS(217) = 'KC5' - CREACS(218) = 'KC6' - CREACS(219) = 'KC7' - CREACS(220) = 'KC8' - CREACS(221) = 'KC9' - CREACS(222) = 'KC10' - CREACS(223) = 'KC11' - CREACS(224) = 'KC12' - CREACS(225) = 'KC13' - CREACS(226) = 'KC14' - CREACS(227) = 'KC15' - CREACS(228) = 'KC16' - CREACS(229) = 'KC17' - CREACS(230) = 'KC18' - CREACS(231) = 'KC19' - CREACS(232) = 'KC20' - CREACS(233) = 'KC21' - CREACS(234) = 'KC22' - CREACS(235) = 'KC23' - CREACS(236) = 'KC24' - CREACS(237) = 'KC25' - CREACS(238) = 'KC26' - CREACS(239) = 'KC27' - CREACS(240) = 'KC28' - CREACS(241) = 'KC29' - CREACS(242) = 'KC30' - CREACS(243) = 'KR1' - CREACS(244) = 'KR2' - CREACS(245) = 'KR3' - CREACS(246) = 'KR4' - CREACS(247) = 'KR5' - CREACS(248) = 'KR6' - CREACS(249) = 'KR7' - CREACS(250) = 'KR8' - CREACS(251) = 'KR9' - CREACS(252) = 'KR10' - CREACS(253) = 'KR11' - CREACS(254) = 'KR12' - CREACS(255) = 'KR13' - CREACS(256) = 'KR14' - CREACS(257) = 'KR15' - CREACS(258) = 'KR16' - CREACS(259) = 'KR17' - CREACS(260) = 'KR18' - CREACS(261) = 'KR19' - CREACS(262) = 'KR20' - CREACS(263) = 'KR21' - CREACS(264) = 'KR22' - CREACS(265) = 'KR23' - CREACS(266) = 'KR24' - CREACS(267) = 'KR25' - CREACS(268) = 'KR26' - CREACS(269) = 'KR27' - CREACS(270) = 'KR28' - CREACS(271) = 'KR29' - CREACS(272) = 'KR30' + CREACS(133) = 'K133' + CREACS(134) = 'K134' + CREACS(135) = 'K135' + CREACS(136) = 'KTC1' + CREACS(137) = 'KTC2' + CREACS(138) = 'KTC3' + CREACS(139) = 'KTC4' + CREACS(140) = 'KTC5' + CREACS(141) = 'KTC6' + CREACS(142) = 'KTC7' + CREACS(143) = 'KTC8' + CREACS(144) = 'KTC9' + CREACS(145) = 'KTC10' + CREACS(146) = 'KTC11' + CREACS(147) = 'KTC12' + CREACS(148) = 'KTC13' + CREACS(149) = 'KTC14' + CREACS(150) = 'KTC15' + CREACS(151) = 'KTC16' + CREACS(152) = 'KTC17' + CREACS(153) = 'KTC18' + CREACS(154) = 'KTC19' + CREACS(155) = 'KTC20' + CREACS(156) = 'KTC21' + CREACS(157) = 'KTC22' + CREACS(158) = 'KTC23' + CREACS(159) = 'KTC24' + CREACS(160) = 'KTC25' + CREACS(161) = 'KTC26' + CREACS(162) = 'KTC27' + CREACS(163) = 'KTC28' + CREACS(164) = 'KTC29' + CREACS(165) = 'KTC30' + CREACS(166) = 'KTC31' + CREACS(167) = 'KTC32' + CREACS(168) = 'KTC33' + CREACS(169) = 'KTC34' + CREACS(170) = 'KTC35' + CREACS(171) = 'KTC36' + CREACS(172) = 'KTC37' + CREACS(173) = 'KTC38' + CREACS(174) = 'KTC39' + CREACS(175) = 'KTC40' + CREACS(176) = 'KTR1' + CREACS(177) = 'KTR2' + CREACS(178) = 'KTR3' + CREACS(179) = 'KTR4' + CREACS(180) = 'KTR5' + CREACS(181) = 'KTR6' + CREACS(182) = 'KTR7' + CREACS(183) = 'KTR8' + CREACS(184) = 'KTR9' + CREACS(185) = 'KTR10' + CREACS(186) = 'KTR11' + CREACS(187) = 'KTR12' + CREACS(188) = 'KTR13' + CREACS(189) = 'KTR14' + CREACS(190) = 'KTR15' + CREACS(191) = 'KTR16' + CREACS(192) = 'KTR17' + CREACS(193) = 'KTR18' + CREACS(194) = 'KTR19' + CREACS(195) = 'KTR20' + CREACS(196) = 'KTR21' + CREACS(197) = 'KTR22' + CREACS(198) = 'KTR23' + CREACS(199) = 'KTR24' + CREACS(200) = 'KTR25' + CREACS(201) = 'KTR26' + CREACS(202) = 'KTR27' + CREACS(203) = 'KTR28' + CREACS(204) = 'KTR29' + CREACS(205) = 'KTR30' + CREACS(206) = 'KTR31' + CREACS(207) = 'KTR32' + CREACS(208) = 'KTR33' + CREACS(209) = 'KTR34' + CREACS(210) = 'KTR35' + CREACS(211) = 'KTR36' + CREACS(212) = 'KTR37' + CREACS(213) = 'KTR38' + CREACS(214) = 'KTR39' + CREACS(215) = 'KTR40' + CREACS(216) = 'KC1' + CREACS(217) = 'KC2' + CREACS(218) = 'KC3' + CREACS(219) = 'KC4' + CREACS(220) = 'KC5' + CREACS(221) = 'KC6' + CREACS(222) = 'KC7' + CREACS(223) = 'KC8' + CREACS(224) = 'KC9' + CREACS(225) = 'KC10' + CREACS(226) = 'KC11' + CREACS(227) = 'KC12' + CREACS(228) = 'KC13' + CREACS(229) = 'KC14' + CREACS(230) = 'KC15' + CREACS(231) = 'KC16' + CREACS(232) = 'KC17' + CREACS(233) = 'KC18' + CREACS(234) = 'KC19' + CREACS(235) = 'KC20' + CREACS(236) = 'KC21' + CREACS(237) = 'KC22' + CREACS(238) = 'KC23' + CREACS(239) = 'KC24' + CREACS(240) = 'KC25' + CREACS(241) = 'KC26' + CREACS(242) = 'KC27' + CREACS(243) = 'KC28' + CREACS(244) = 'KC29' + CREACS(245) = 'KC30' + CREACS(246) = 'KR1' + CREACS(247) = 'KR2' + CREACS(248) = 'KR3' + CREACS(249) = 'KR4' + CREACS(250) = 'KR5' + CREACS(251) = 'KR6' + CREACS(252) = 'KR7' + CREACS(253) = 'KR8' + CREACS(254) = 'KR9' + CREACS(255) = 'KR10' + CREACS(256) = 'KR11' + CREACS(257) = 'KR12' + CREACS(258) = 'KR13' + CREACS(259) = 'KR14' + CREACS(260) = 'KR15' + CREACS(261) = 'KR16' + CREACS(262) = 'KR17' + CREACS(263) = 'KR18' + CREACS(264) = 'KR19' + CREACS(265) = 'KR20' + CREACS(266) = 'KR21' + CREACS(267) = 'KR22' + CREACS(268) = 'KR23' + CREACS(269) = 'KR24' + CREACS(270) = 'KR25' + CREACS(271) = 'KR26' + CREACS(272) = 'KR27' + CREACS(273) = 'KR28' + CREACS(274) = 'KR29' + CREACS(275) = 'KR30' ! initialisation of the full reactions CFULLREACS(1) = 'K001=!ZRATES(:,001)::NO2-->O3P+NO' CFULLREACS(2) = 'K002=!ZRATES(:,002)::O3-->O1D+O2' @@ -3406,340 +3433,344 @@ IF (GFIRSTCALL) THEN CFULLREACS(130) = 'K130=4.00E-12::XO2+NO-->NO2' CFULLREACS(131) = 'K131=1.20E-12::XO2+NO3-->NO2' CFULLREACS(132) = 'K132=1.00E-40::SULF-->' - CFULLREACS(133) = 'KTC1=@KT(0.05,48.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::O3-->WC_& + CFULLREACS(133) = 'K133=5.40E-13::DMS+NO3-->SO2+NO2' + CFULLREACS(134) = 'K134=1.30E-11*exp(-(400./TPK%T))::DMS+O3P-->SO2' + CFULLREACS(135) = 'K135=(TPK%T*exp(-234./TPK%T)+8.4E-10*exp(7230./TPK%T)+2.68E& +&-10*exp(7810./TPK%T))/(1.04E11*TPK%T+88.1*exp(7460./TPK%T))::DMS+OH-->0.8*SO2' + CFULLREACS(136) = 'KTC1=@KT(0.05,48.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::O3-->WC_& &O3' - CFULLREACS(134) = 'KTC2=@KT(0.11,34.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::H2O2-->W& + CFULLREACS(137) = 'KTC2=@KT(0.11,34.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::H2O2-->W& &C_H2O2' - CFULLREACS(135) = 'KTC3=@KT(0.0001,30.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::NO-->W& + CFULLREACS(138) = 'KTC3=@KT(0.0001,30.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::NO-->W& &C_NO' - CFULLREACS(136) = 'KTC4=@KT(0.0015,46.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::NO2-->& + CFULLREACS(139) = 'KTC4=@KT(0.0015,46.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::NO2-->& &WC_NO2' - CFULLREACS(137) = 'KTC5=@KT(0.05,62.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::NO3-->WC& + CFULLREACS(140) = 'KTC5=@KT(0.05,62.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::NO3-->WC& &_NO3' - CFULLREACS(138) = 'KTC6=@KT(0.0037,108.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::N2O5-& + CFULLREACS(141) = 'KTC6=@KT(0.0037,108.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::N2O5-& &->WC_N2O5' - CFULLREACS(139) = 'KTC7=@KT(0.05,47.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::HONO-->W& + CFULLREACS(142) = 'KTC7=@KT(0.05,47.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::HONO-->W& &C_HONO' - CFULLREACS(140) = 'KTC8=@KT(0.054,63.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::HNO3-->& + CFULLREACS(143) = 'KTC8=@KT(0.054,63.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::HNO3-->& &WC_HNO3' - CFULLREACS(141) = 'KTC9=@KT(0.05,79.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::HNO4-->W& + CFULLREACS(144) = 'KTC9=@KT(0.05,79.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::HNO4-->W& &C_HNO4' - CFULLREACS(142) = 'KTC10=@KT(0.04,17.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::NH3-->W& + CFULLREACS(145) = 'KTC10=@KT(0.04,17.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::NH3-->W& &C_NH3' - CFULLREACS(143) = 'KTC11=@KT(0.05,17.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::OH-->WC& + CFULLREACS(146) = 'KTC11=@KT(0.05,17.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::OH-->WC& &_OH' - CFULLREACS(144) = 'KTC12=@KT(0.2,30.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::HO2-->WC& + CFULLREACS(147) = 'KTC12=@KT(0.2,30.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::HO2-->WC& &_HO2' - CFULLREACS(145) = 'KTC13=@KT(0.0002,44.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::CO2--& + CFULLREACS(148) = 'KTC13=@KT(0.0002,44.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::CO2--& &>WC_CO2' - CFULLREACS(146) = 'KTC14=@KT(0.11,64.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::SO2-->W& + CFULLREACS(149) = 'KTC14=@KT(0.11,64.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::SO2-->W& &C_SO2' - CFULLREACS(147) = 'KTC15=@KT(0.07,98.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::SULF-->& + CFULLREACS(150) = 'KTC15=@KT(0.07,98.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::SULF-->& &WC_SULF' - CFULLREACS(148) = 'KTC16=@KT(0.04,30.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::HCHO-->& + CFULLREACS(151) = 'KTC16=@KT(0.04,30.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::HCHO-->& &WC_HCHO' - CFULLREACS(149) = 'KTC17=@KT(0.012,46.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::ORA1--& + CFULLREACS(152) = 'KTC17=@KT(0.012,46.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::ORA1--& &>WC_ORA1' - CFULLREACS(150) = 'KTC18=@KT(0.03,60.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::ORA2-->& + CFULLREACS(153) = 'KTC18=@KT(0.03,60.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::ORA2-->& &WC_ORA2' - CFULLREACS(151) = 'KTC19=@KT(0.05,47.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::MO2-->W& + CFULLREACS(154) = 'KTC19=@KT(0.05,47.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::MO2-->W& &C_MO2' - CFULLREACS(152) = 'KTC20=@KT(0.007,48.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::OP1-->& + CFULLREACS(155) = 'KTC20=@KT(0.007,48.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC::OP1-->& &WC_OP1' - CFULLREACS(153) = 'KTC21=@KT(0.05,48.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(1.1e-2,-& -&2830.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_O3-->O3' - CFULLREACS(154) = 'KTC22=@KT(0.11,34.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(7.73e4,-& -&7310.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_H2O2-->H2O2' - CFULLREACS(155) = 'KTC23=@KT(0.0001,30.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(1.92e-& + CFULLREACS(156) = 'KTC21=@KT(0.05,48.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(1.03e-2,& +&-2830.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_O3-->O3' + CFULLREACS(157) = 'KTC22=@KT(0.11,34.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(8.44e4,-& +&7600.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_H2O2-->H2O2' + CFULLREACS(158) = 'KTC23=@KT(0.0001,30.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(1.92e-& &3,-1790.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_NO-->NO' - CFULLREACS(156) = 'KTC24=@KT(0.0015,46.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(1.4e-2& -&,0.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_NO2-->NO2' - CFULLREACS(157) = 'KTC25=@KT(0.05,62.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(3.8e-2,0& + CFULLREACS(159) = 'KTC24=@KT(0.0015,46.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(1.2e-2& +&,-2400.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_NO2-->NO2' + CFULLREACS(160) = 'KTC25=@KT(0.05,62.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(3.8e-2,0& &.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_NO3-->NO3' - CFULLREACS(158) = 'KTC26=@KT(0.0037,108.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(2.1,-& -&3400.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_N2O5-->N2O5' - CFULLREACS(159) = 'KTC27=@KT(0.05,47.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(5.0e1,-4& + CFULLREACS(161) = 'KTC26=@KT(0.0037,108.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(8.8e-& +&2,-3600.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_N2O5-->N2O5' + CFULLREACS(162) = 'KTC27=@KT(0.05,47.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(5.0e1,-4& &880.,1.6e-3,1760.,0.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_HONO-->HONO' - CFULLREACS(160) = 'KTC28=@KT(0.054,63.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(2.1e5,-& -&8700.,2.2e1,0.,0.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_HNO3-->HNO3' - CFULLREACS(161) = 'KTC29=@KT(0.05,79.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(1.2e4,-6& + CFULLREACS(163) = 'KTC28=@KT(0.054,63.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(2.1e5,-& +&10500.,2.2e1,0.,0.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_HNO3-->HNO3' + CFULLREACS(164) = 'KTC29=@KT(0.05,79.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(1.2e4,-6& &900.,1.26e-6,0.,0.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_HNO4-->HNO4' - CFULLREACS(162) = 'KTC30=@KT(0.04,17.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFB(6.02e1,-& + CFULLREACS(165) = 'KTC30=@KT(0.04,17.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFB(6.02e1,-& &4160.,1.7e-5,4350.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_NH3-->NH3' - CFULLREACS(163) = 'KTC31=@KT(0.05,17.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(3.9e1,0.& + CFULLREACS(166) = 'KTC31=@KT(0.05,17.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(3.9e1,0.& &,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_OH-->OH' - CFULLREACS(164) = 'KTC32=@KT(0.2,30.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(6.9e2,0.,& + CFULLREACS(167) = 'KTC32=@KT(0.2,30.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(6.9e2,0.,& &1.6e-5,0.,0.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_HO2-->HO2' - CFULLREACS(165) = 'KTC33=@KT(0.0002,44.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(3.4e-2& + CFULLREACS(168) = 'KTC33=@KT(0.0002,44.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(3.4e-2& &,-2710.,4.3e-7,920.,4.7e-11,1780.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_CO& &2-->CO2' - CFULLREACS(166) = 'KTC34=@KT(0.11,64.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(1.36,-29& + CFULLREACS(169) = 'KTC34=@KT(0.11,64.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(1.36,-29& &30.,1.3e-2,-1965.,6.4e-8,-1430.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_SO2-& &->SO2' - CFULLREACS(167) = 'KTC35=@KT(0.07,98.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(2.1e5,-8& + CFULLREACS(170) = 'KTC35=@KT(0.07,98.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(2.1e5,-8& &700.,1.0e3,0.,1.0e-2,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_SULF-->SULF' - CFULLREACS(168) = 'KTC36=@KT(0.04,30.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(3.23e3,-& + CFULLREACS(171) = 'KTC36=@KT(0.04,30.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(3.23e3,-& &7100.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_HCHO-->HCHO' - CFULLREACS(169) = 'KTC37=@KT(0.012,46.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(8.9e3,-& + CFULLREACS(172) = 'KTC37=@KT(0.012,46.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(8.9e3,-& &6100.,1.8e-4,150.,0.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_ORA1-->ORA1' - CFULLREACS(170) = 'KTC38=@KT(0.03,60.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(4.1e3,-6& + CFULLREACS(173) = 'KTC38=@KT(0.03,60.,TPK%T,TPK%RADC,KVECNPT)/(@HEFFA(4.1e3,-6& &200.,1.74e-5,0.,0.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_ORA2-->ORA2' - CFULLREACS(171) = 'KTC39=@KT(0.05,47.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(2.7e0,-2& -&030.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_MO2-->MO2' - CFULLREACS(172) = 'KTC40=@KT(0.007,48.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(3.e2,-5& + CFULLREACS(174) = 'KTC39=@KT(0.05,47.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(2.45e0,-& +&5280.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_MO2-->MO2' + CFULLREACS(175) = 'KTC40=@KT(0.007,48.,TPK%T,TPK%RADC,KVECNPT)/(@HENRY(3.e2,-5& &280.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WC_OP1-->OP1' - CFULLREACS(173) = 'KTR1=@KT(0.05,48.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::O3-->WR_& + CFULLREACS(176) = 'KTR1=@KT(0.05,48.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::O3-->WR_& &O3' - CFULLREACS(174) = 'KTR2=@KT(0.11,34.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::H2O2-->W& + CFULLREACS(177) = 'KTR2=@KT(0.11,34.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::H2O2-->W& &R_H2O2' - CFULLREACS(175) = 'KTR3=@KT(0.0001,30.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::NO-->W& + CFULLREACS(178) = 'KTR3=@KT(0.0001,30.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::NO-->W& &R_NO' - CFULLREACS(176) = 'KTR4=@KT(0.0015,46.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::NO2-->& + CFULLREACS(179) = 'KTR4=@KT(0.0015,46.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::NO2-->& &WR_NO2' - CFULLREACS(177) = 'KTR5=@KT(0.05,62.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::NO3-->WR& + CFULLREACS(180) = 'KTR5=@KT(0.05,62.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::NO3-->WR& &_NO3' - CFULLREACS(178) = 'KTR6=@KT(0.0037,108.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::N2O5-& + CFULLREACS(181) = 'KTR6=@KT(0.0037,108.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::N2O5-& &->WR_N2O5' - CFULLREACS(179) = 'KTR7=@KT(0.05,47.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::HONO-->W& + CFULLREACS(182) = 'KTR7=@KT(0.05,47.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::HONO-->W& &R_HONO' - CFULLREACS(180) = 'KTR8=@KT(0.054,63.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::HNO3-->& + CFULLREACS(183) = 'KTR8=@KT(0.054,63.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::HNO3-->& &WR_HNO3' - CFULLREACS(181) = 'KTR9=@KT(0.05,79.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::HNO4-->W& + CFULLREACS(184) = 'KTR9=@KT(0.05,79.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::HNO4-->W& &R_HNO4' - CFULLREACS(182) = 'KTR10=@KT(0.04,17.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::NH3-->W& + CFULLREACS(185) = 'KTR10=@KT(0.04,17.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::NH3-->W& &R_NH3' - CFULLREACS(183) = 'KTR11=@KT(0.05,17.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::OH-->WR& + CFULLREACS(186) = 'KTR11=@KT(0.05,17.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::OH-->WR& &_OH' - CFULLREACS(184) = 'KTR12=@KT(0.2,30.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::HO2-->WR& + CFULLREACS(187) = 'KTR12=@KT(0.2,30.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::HO2-->WR& &_HO2' - CFULLREACS(185) = 'KTR13=@KT(0.0002,44.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::CO2--& + CFULLREACS(188) = 'KTR13=@KT(0.0002,44.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::CO2--& &>WR_CO2' - CFULLREACS(186) = 'KTR14=@KT(0.11,64.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::SO2-->W& + CFULLREACS(189) = 'KTR14=@KT(0.11,64.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::SO2-->W& &R_SO2' - CFULLREACS(187) = 'KTR15=@KT(0.07,98.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::SULF-->& + CFULLREACS(190) = 'KTR15=@KT(0.07,98.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::SULF-->& &WR_SULF' - CFULLREACS(188) = 'KTR16=@KT(0.04,30.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::HCHO-->& + CFULLREACS(191) = 'KTR16=@KT(0.04,30.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::HCHO-->& &WR_HCHO' - CFULLREACS(189) = 'KTR17=@KT(0.012,46.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::ORA1--& + CFULLREACS(192) = 'KTR17=@KT(0.012,46.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::ORA1--& &>WR_ORA1' - CFULLREACS(190) = 'KTR18=@KT(0.03,60.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::ORA2-->& + CFULLREACS(193) = 'KTR18=@KT(0.03,60.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::ORA2-->& &WR_ORA2' - CFULLREACS(191) = 'KTR19=@KT(0.05,47.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::MO2-->W& + CFULLREACS(194) = 'KTR19=@KT(0.05,47.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::MO2-->W& &R_MO2' - CFULLREACS(192) = 'KTR20=@KT(0.007,48.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::OP1-->& + CFULLREACS(195) = 'KTR20=@KT(0.007,48.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR::OP1-->& &WR_OP1' - CFULLREACS(193) = 'KTR21=@KT(0.05,48.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(1.1e-2,-& -&2830.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_O3-->O3' - CFULLREACS(194) = 'KTR22=@KT(0.11,34.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(7.73e4,-& -&7310.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_H2O2-->H2O2' - CFULLREACS(195) = 'KTR23=@KT(0.0001,30.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(1.92e-& + CFULLREACS(196) = 'KTR21=@KT(0.05,48.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(1.03e-2,& +&-2830.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_O3-->O3' + CFULLREACS(197) = 'KTR22=@KT(0.11,34.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(8.44e4,-& +&7600.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_H2O2-->H2O2' + CFULLREACS(198) = 'KTR23=@KT(0.0001,30.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(1.92e-& &3,-1790.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_NO-->NO' - CFULLREACS(196) = 'KTR24=@KT(0.0015,46.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(1.4e-2& -&,0.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_NO2-->NO2' - CFULLREACS(197) = 'KTR25=@KT(0.05,62.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(3.8e-2,0& + CFULLREACS(199) = 'KTR24=@KT(0.0015,46.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(1.2e-2& +&,-2400.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_NO2-->NO2' + CFULLREACS(200) = 'KTR25=@KT(0.05,62.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(3.8e-2,0& &.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_NO3-->NO3' - CFULLREACS(198) = 'KTR26=@KT(0.0037,108.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(2.1,-& -&3400.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_N2O5-->N2O5' - CFULLREACS(199) = 'KTR27=@KT(0.05,47.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(5.0e1,-4& + CFULLREACS(201) = 'KTR26=@KT(0.0037,108.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(8.8e-& +&2,-3600.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_N2O5-->N2O5' + CFULLREACS(202) = 'KTR27=@KT(0.05,47.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(5.0e1,-4& &880.,1.6e-3,1760.,0.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_HONO-->HONO' - CFULLREACS(200) = 'KTR28=@KT(0.054,63.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(2.1e5,-& -&8700.,2.2e1,0.,0.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_HNO3-->HNO3' - CFULLREACS(201) = 'KTR29=@KT(0.05,79.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(1.2e4,-6& + CFULLREACS(203) = 'KTR28=@KT(0.054,63.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(2.1e5,-& +&10500.,2.2e1,0.,0.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_HNO3-->HNO3' + CFULLREACS(204) = 'KTR29=@KT(0.05,79.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(1.2e4,-6& &900.,1.26e-6,0.,0.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_HNO4-->HNO4' - CFULLREACS(202) = 'KTR30=@KT(0.04,17.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFB(6.02e1,-& + CFULLREACS(205) = 'KTR30=@KT(0.04,17.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFB(6.02e1,-& &4160.,1.7e-5,4350.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_NH3-->NH3' - CFULLREACS(203) = 'KTR31=@KT(0.05,17.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(3.9e1,0.& + CFULLREACS(206) = 'KTR31=@KT(0.05,17.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(3.9e1,0.& &,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_OH-->OH' - CFULLREACS(204) = 'KTR32=@KT(0.2,30.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(6.9e2,0.,& + CFULLREACS(207) = 'KTR32=@KT(0.2,30.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(6.9e2,0.,& &1.6e-5,0.,0.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_HO2-->HO2' - CFULLREACS(205) = 'KTR33=@KT(0.0002,44.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(3.4e-2& + CFULLREACS(208) = 'KTR33=@KT(0.0002,44.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(3.4e-2& &,-2710.,4.3e-7,920.,4.7e-11,1780.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_CO& &2-->CO2' - CFULLREACS(206) = 'KTR34=@KT(0.11,64.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(1.36,-29& + CFULLREACS(209) = 'KTR34=@KT(0.11,64.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(1.36,-29& &30.,1.3e-2,-1965.,6.4e-8,-1430.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_SO2-& &->SO2' - CFULLREACS(207) = 'KTR35=@KT(0.07,98.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(2.1e5,-8& + CFULLREACS(210) = 'KTR35=@KT(0.07,98.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(2.1e5,-8& &700.,1.0e3,0.,1.0e-2,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_SULF-->SULF' - CFULLREACS(208) = 'KTR36=@KT(0.04,30.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(3.23e3,-& + CFULLREACS(211) = 'KTR36=@KT(0.04,30.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(3.23e3,-& &7100.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_HCHO-->HCHO' - CFULLREACS(209) = 'KTR37=@KT(0.012,46.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(8.9e3,-& + CFULLREACS(212) = 'KTR37=@KT(0.012,46.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(8.9e3,-& &6100.,1.8e-4,150.,0.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_ORA1-->ORA1' - CFULLREACS(210) = 'KTR38=@KT(0.03,60.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(4.1e3,-6& + CFULLREACS(213) = 'KTR38=@KT(0.03,60.,TPK%T,TPK%RADR,KVECNPT)/(@HEFFA(4.1e3,-6& &200.,1.74e-5,0.,0.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_ORA2-->ORA2' - CFULLREACS(211) = 'KTR39=@KT(0.05,47.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(2.7e0,-2& -&030.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_MO2-->MO2' - CFULLREACS(212) = 'KTR40=@KT(0.007,48.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(3.e2,-5& + CFULLREACS(214) = 'KTR39=@KT(0.05,47.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(2.45e0,-& +&5280.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_MO2-->MO2' + CFULLREACS(215) = 'KTR40=@KT(0.007,48.,TPK%T,TPK%RADR,KVECNPT)/(@HENRY(3.e2,-5& &280.,TPK%T,KVECNPT)*TPK%RCH*TPK%T)::WR_OP1-->OP1' - CFULLREACS(213) = 'KC1=!ZRATES(:,018)::WC_H2O2-->WC_OH+WC_OH' - CFULLREACS(214) = 'KC2=(3.6E+9*exp(-930.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLECC& + CFULLREACS(216) = 'KC1=!ZRATES(:,018)::WC_H2O2-->WC_OH+WC_OH' + CFULLREACS(217) = 'KC2=(3.6E+9*exp(-930.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLECC& &LOUD::WC_OH+WC_OH-->WC_H2O2' - CFULLREACS(215) = 'KC3=((2.8E+10*10.**(-TPK%PHC)+3.5E+10*exp(-720.*(1./TPK%T-1& + CFULLREACS(218) = 'KC3=((2.8E+10*10.**(-TPK%PHC)+3.5E+10*exp(-720.*(1./TPK%T-1& &./298.15))*1.6e-5)/(1.6e-5+10.**(-TPK%PHC)))/TPK%MOL2MOLECCLOUD::WC_OH+WC_HO2-& &->' - CFULLREACS(216) = 'KC4=(3.2E+7*exp(-1700.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLEC& + CFULLREACS(219) = 'KC4=(3.2E+7*exp(-1700.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLEC& &CLOUD::WC_H2O2+WC_OH-->WC_HO2' - CFULLREACS(217) = 'KC5=((8.3E+5*exp(-2700.*(1./TPK%T-1./298.15))*(10.**(-TPK%P& + CFULLREACS(220) = 'KC5=((8.3E+5*exp(-2700.*(1./TPK%T-1./298.15))*(10.**(-TPK%P& &HC))**2.+9.6E+7*exp(-910.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)*1.6e-5)/(1.6e-& &5+10.**(-TPK%PHC))**2.)/TPK%MOL2MOLECCLOUD::WC_HO2+WC_HO2-->WC_H2O2' - CFULLREACS(218) = 'KC6=(1.5E+9*exp(-1500.*(1./TPK%T-1./298.15))*1.6e-5/(1.6e-5& + CFULLREACS(221) = 'KC6=(1.5E+9*exp(-1500.*(1./TPK%T-1./298.15))*1.6e-5/(1.6e-5& &+10.**(-TPK%PHC)))/TPK%MOL2MOLECCLOUD::WC_O3+WC_HO2-->WC_OH' - CFULLREACS(219) = 'KC7=(2.7E+9*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-T& + CFULLREACS(222) = 'KC7=(2.7E+9*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-T& &PK%PHC)/(1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./& &298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)+(10.**(-TPK%PH& &C))**2.))/TPK%MOL2MOLECCLOUD::WC_OH+WC_SO2-->WC_ASO3' - CFULLREACS(220) = 'KC8=(1.0E+10*10.**(-TPK%PHC)/(1.6e-3*exp(-1760.*(1./TPK%T-1& + CFULLREACS(223) = 'KC8=(1.0E+10*10.**(-TPK%PHC)/(1.6e-3*exp(-1760.*(1./TPK%T-1& &./298.15))+10.**(-TPK%PHC)))/TPK%MOL2MOLECCLOUD::WC_HONO+WC_OH-->WC_NO2' - CFULLREACS(221) = 'KC9=((1.8E+9*10.**(-TPK%PHC)+4.5E+9*1.6e-5)/(1.6e-5+10.**(-& + CFULLREACS(224) = 'KC9=((1.8E+9*10.**(-TPK%PHC)+4.5E+9*1.6e-5)/(1.6e-5+10.**(-& &TPK%PHC)))/TPK%MOL2MOLECCLOUD::WC_NO2+WC_HO2-->WC_HNO4' - CFULLREACS(222) = 'KC10=2.6E-2*10.**(-TPK%PHC)/(1.26e-6+10.**(-TPK%PHC))::WC_H& + CFULLREACS(225) = 'KC10=2.6E-2*10.**(-TPK%PHC)/(1.26e-6+10.**(-TPK%PHC))::WC_H& &NO4-->WC_HO2+WC_NO2' - CFULLREACS(223) = 'KC11=1.1E0*1.26e-6/(1.26e-6+10.**(-TPK%PHC))::WC_HNO4-->WC_& + CFULLREACS(226) = 'KC11=1.1E0*1.26e-6/(1.26e-6+10.**(-TPK%PHC))::WC_HNO4-->WC_& &HONO' - CFULLREACS(224) = 'KC12=(3.3E+5*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*(10.**(& + CFULLREACS(227) = 'KC12=(3.3E+5*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*(10.**(& &-TPK%PHC))**2./((1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./T& &PK%T-1./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)+(10.**& &(-TPK%PHC))**2.)*(1.26e-6+10.**(-TPK%PHC))))/TPK%MOL2MOLECCLOUD::WC_HNO4+WC_SO& &2-->WC_SULF+WC_HNO3' - CFULLREACS(225) = 'KC13=!ZRATES(:,019)*2.2e+1/(2.2e+1+10.**(-TPK%PHC))::WC_HNO& + CFULLREACS(228) = 'KC13=!ZRATES(:,019)*2.2e+1/(2.2e+1+10.**(-TPK%PHC))::WC_HNO& &3-->WC_NO2+WC_OH' - CFULLREACS(226) = 'KC14=1.0E+10::WC_N2O5-->WC_HNO3+WC_HNO3' - CFULLREACS(227) = 'KC15=(1.0E+5*1.0e+3*1.0e-2/(1.0e+3*1.0e-2+1.0e+3*10.**(-TPK& + CFULLREACS(229) = 'KC14=1.0E+10::WC_N2O5-->WC_HNO3+WC_HNO3' + CFULLREACS(230) = 'KC15=(1.0E+5*1.0e+3*1.0e-2/(1.0e+3*1.0e-2+1.0e+3*10.**(-TPK& &%PHC)+(10.**(-TPK%PHC))**2.))/TPK%MOL2MOLECCLOUD::WC_NO3+WC_SULF-->WC_HNO3+WC_& &ASO4' - CFULLREACS(228) = 'KC16=(1.3E+9*exp(-2200.*(1./TPK%T-1./298.15))*1.3e-2*exp(19& + CFULLREACS(231) = 'KC16=(1.3E+9*exp(-2200.*(1./TPK%T-1./298.15))*1.3e-2*exp(19& &65.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)/(1.3e-2*exp(1965.*(1./TPK%T-1./298.1& &5))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.1& &5))*10.**(-TPK%PHC)+(10.**(-TPK%PHC))**2.))/TPK%MOL2MOLECCLOUD::WC_NO3+WC_SO2-& &->WC_HNO3+WC_ASO3' - CFULLREACS(229) = 'KC17=(1.7E+8*exp(-2200.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLE& + CFULLREACS(232) = 'KC17=(1.7E+8*exp(-2200.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLE& &CCLOUD::WC_MO2+WC_MO2-->2.00*WC_HCHO+2.00*WC_HO2' - CFULLREACS(230) = 'KC18=(5.0E+5*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-& + CFULLREACS(233) = 'KC18=(5.0E+5*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-& &TPK%PHC)/(1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1.& &/298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)+(10.**(-TPK%P& &HC))**2.))/TPK%MOL2MOLECCLOUD::WC_MO2+WC_SO2-->WC_OP1+WC_ASO3' - CFULLREACS(231) = 'KC19=(7.8E+8*exp(-1000.*(1./TPK%T-1./298.15))*2.5e3*exp(403& + CFULLREACS(234) = 'KC19=(7.8E+8*exp(-1000.*(1./TPK%T-1./298.15))*2.5e3*exp(403& &0.*(1./TPK%T-1./298.15))/(1.+2.5e3*exp(4030.*(1./TPK%T-1./298.15))))/TPK%MOL2M& &OLECCLOUD::WC_HCHO+WC_OH-->WC_ORA1+WC_HO2' - CFULLREACS(232) = 'KC20=((1.0E+8*exp(-1000.*(1./TPK%T-1./298.15))*10.**(-TPK%P& + CFULLREACS(235) = 'KC20=((1.0E+8*exp(-1000.*(1./TPK%T-1./298.15))*10.**(-TPK%P& &HC)+3.4E+9*exp(-1200.*(1./TPK%T-1./298.15))*1.8e-4*exp(150.*(1./TPK%T-1./298.1& &5)))/(1.8e-4*exp(150.*(1./TPK%T-1./298.15))+10.**(-TPK%PHC)))/TPK%MOL2MOLECCLO& &UD::WC_ORA1+WC_OH-->WC_CO2+WC_HO2' - CFULLREACS(233) = 'KC21=((7.9E+2*exp(-2900.*(1./TPK%T-1./298.15))*1.3e-2*exp(1& + CFULLREACS(236) = 'KC21=((7.9E+2*exp(-2900.*(1./TPK%T-1./298.15))*1.3e-2*exp(1& &965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)+2.5E+7*exp(-2450.*(1./TPK%T-1./298.& &15))*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.& &15)))/((1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./2& &98.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)+(10.**(-TPK%PHC& &))**2.)*(1.+2.5e3*exp(4030.*(1./TPK%T-1./298.15)))))/TPK%MOL2MOLECCLOUD::WC_SO& &2+WC_HCHO-->WC_AHMS' - CFULLREACS(234) = 'KC22=7.7E-3*exp(-9200.*(1./TPK%T-1./298.15))+3.7E+3*1.e-14*& + CFULLREACS(237) = 'KC22=7.7E-3*exp(-9200.*(1./TPK%T-1./298.15))+3.7E+3*1.e-14*& &EXP(-6716*(1./TPK%T-1./298.15))/10.**(-TPK%PHC)::WC_AHMS-->WC_SO2+WC_HCHO' - CFULLREACS(235) = 'KC23=3.0E+8/TPK%MOL2MOLECCLOUD::WC_AHMS+WC_OH-->WC_HO2+WC_O& + CFULLREACS(238) = 'KC23=3.0E+8/TPK%MOL2MOLECCLOUD::WC_AHMS+WC_OH-->WC_HO2+WC_O& &RA1+WC_SO2' - CFULLREACS(236) = 'KC24=1.1E+9::WC_ASO3+W_O2-->WC_ASO5' - CFULLREACS(237) = 'KC25=(1.7E+9*10.**(-TPK%PHC)/(1.6e-5+10.**(-TPK%PHC)))/TPK%& + CFULLREACS(239) = 'KC24=1.1E+9::WC_ASO3+W_O2-->WC_ASO5' + CFULLREACS(240) = 'KC25=(1.7E+9*10.**(-TPK%PHC)/(1.6e-5+10.**(-TPK%PHC)))/TPK%& &MOL2MOLECCLOUD::WC_ASO5+WC_HO2-->WC_AHSO5' - CFULLREACS(238) = 'KC26=(2.2E+8*exp(-2600.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLE& + CFULLREACS(241) = 'KC26=(2.2E+8*exp(-2600.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLE& &CCLOUD::WC_ASO5+WC_ASO5-->WC_ASO4+WC_ASO4' - CFULLREACS(239) = 'KC27=(7.1E+6*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-& + CFULLREACS(242) = 'KC27=(7.1E+6*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-& &TPK%PHC)*10.**(-TPK%PHC)/(1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(14& &30.*(1./TPK%T-1./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PH& &C)+(10.**(-TPK%PHC))**2.))/TPK%MOL2MOLECCLOUD::WC_AHSO5+WC_SO2-->2.00*WC_SULF' - CFULLREACS(240) = 'KC28=4.6E+2*exp(-1100.*(1./TPK%T-1./298.15))::WC_ASO4-->WC_& + CFULLREACS(243) = 'KC28=4.6E+2*exp(-1100.*(1./TPK%T-1./298.15))::WC_ASO4-->WC_& &SULF+WC_OH' - CFULLREACS(241) = 'KC29=((3.7E+5*exp(-5500.*(1./TPK%T-1./298.15))*1.3e-2*exp(1& + CFULLREACS(244) = 'KC29=((3.7E+5*exp(-5500.*(1./TPK%T-1./298.15))*1.3e-2*exp(1& &965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)+1.5E+9*exp(-5300.*(1./TPK%T-1./298.& &15))*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.& &15)))/(1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./29& &8.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)+(10.**(-TPK%PHC)& &)**2.))/TPK%MOL2MOLECCLOUD::WC_SO2+WC_O3-->WC_SULF' - CFULLREACS(242) = 'KC30=(9.1E+7*exp(-3600.*(1./TPK%T-1./298.15))*1.3e-2*exp(19& + CFULLREACS(245) = 'KC30=(9.1E+7*exp(-3600.*(1./TPK%T-1./298.15))*1.3e-2*exp(19& &65.*(1./TPK%T-1./298.15))*10.**(-TPK%PHC)*10.**(-TPK%PHC)/(1.3e-2*exp(1965.*(1& &./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-2*exp(1965.*(1& &./TPK%T-1./298.15))*10.**(-TPK%PHC)+(10.**(-TPK%PHC))**2.))/TPK%MOL2MOLECCLOUD& &::WC_SO2+WC_H2O2-->WC_SULF' - CFULLREACS(243) = 'KR1=!ZRATES(:,018)::WR_H2O2-->WR_OH+WR_OH' - CFULLREACS(244) = 'KR2=(3.6E+9*exp(-930.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLECR& + CFULLREACS(246) = 'KR1=!ZRATES(:,018)::WR_H2O2-->WR_OH+WR_OH' + CFULLREACS(247) = 'KR2=(3.6E+9*exp(-930.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLECR& &AIN::WR_OH+WR_OH-->WR_H2O2' - CFULLREACS(245) = 'KR3=((2.8E+10*10.**(-TPK%PHR)+3.5E+10*exp(-720.*(1./TPK%T-1& + CFULLREACS(248) = 'KR3=((2.8E+10*10.**(-TPK%PHR)+3.5E+10*exp(-720.*(1./TPK%T-1& &./298.15))*1.6e-5)/(1.6e-5+10.**(-TPK%PHR)))/TPK%MOL2MOLECRAIN::WR_OH+WR_HO2--& &>' - CFULLREACS(246) = 'KR4=(3.2E+7*exp(-1700.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLEC& + CFULLREACS(249) = 'KR4=(3.2E+7*exp(-1700.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLEC& &RAIN::WR_H2O2+WR_OH-->WR_HO2' - CFULLREACS(247) = 'KR5=((8.3E+5*exp(-2700.*(1./TPK%T-1./298.15))*(10.**(-TPK%P& + CFULLREACS(250) = 'KR5=((8.3E+5*exp(-2700.*(1./TPK%T-1./298.15))*(10.**(-TPK%P& &HR))**2.+9.6E+7*exp(-910.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)*1.6e-5)/(1.6e-& &5+10.**(-TPK%PHR))**2.)/TPK%MOL2MOLECRAIN::WR_HO2+WR_HO2-->WR_H2O2' - CFULLREACS(248) = 'KR6=(1.5E+9*exp(-1500.*(1./TPK%T-1./298.15))*1.6e-5/(1.6e-5& + CFULLREACS(251) = 'KR6=(1.5E+9*exp(-1500.*(1./TPK%T-1./298.15))*1.6e-5/(1.6e-5& &+10.**(-TPK%PHR)))/TPK%MOL2MOLECRAIN::WR_O3+WR_HO2-->WR_OH' - CFULLREACS(249) = 'KR7=(2.7E+9*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-T& + CFULLREACS(252) = 'KR7=(2.7E+9*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-T& &PK%PHR)/(1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./& &298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)+(10.**(-TPK%PH& &R))**2.))/TPK%MOL2MOLECRAIN::WR_OH+WR_SO2-->WR_ASO3' - CFULLREACS(250) = 'KR8=(1.0E+10*10.**(-TPK%PHR)/(1.6e-3*exp(-1760.*(1./TPK%T-1& + CFULLREACS(253) = 'KR8=(1.0E+10*10.**(-TPK%PHR)/(1.6e-3*exp(-1760.*(1./TPK%T-1& &./298.15))+10.**(-TPK%PHR)))/TPK%MOL2MOLECRAIN::WR_HONO+WR_OH-->WR_NO2' - CFULLREACS(251) = 'KR9=((1.8E+9*10.**(-TPK%PHR)+4.5E+9*1.6e-5)/(1.6e-5+10.**(-& + CFULLREACS(254) = 'KR9=((1.8E+9*10.**(-TPK%PHR)+4.5E+9*1.6e-5)/(1.6e-5+10.**(-& &TPK%PHR)))/TPK%MOL2MOLECRAIN::WR_NO2+WR_HO2-->WR_HNO4' - CFULLREACS(252) = 'KR10=2.6E-2*10.**(-TPK%PHR)/(1.26e-6+10.**(-TPK%PHR))::WR_H& + CFULLREACS(255) = 'KR10=2.6E-2*10.**(-TPK%PHR)/(1.26e-6+10.**(-TPK%PHR))::WR_H& &NO4-->WR_HO2+WR_NO2' - CFULLREACS(253) = 'KR11=1.1E0*1.26e-6/(1.26e-6+10.**(-TPK%PHR))::WR_HNO4-->WR_& + CFULLREACS(256) = 'KR11=1.1E0*1.26e-6/(1.26e-6+10.**(-TPK%PHR))::WR_HNO4-->WR_& &HONO' - CFULLREACS(254) = 'KR12=(3.3E+5*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*(10.**(& + CFULLREACS(257) = 'KR12=(3.3E+5*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*(10.**(& &-TPK%PHR))**2./((1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./T& &PK%T-1./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)+(10.**& &(-TPK%PHR))**2.)*(1.26e-6+10.**(-TPK%PHR))))/TPK%MOL2MOLECRAIN::WR_HNO4+WR_SO2& &-->WR_SULF+WR_HNO3' - CFULLREACS(255) = 'KR13=!ZRATES(:,019)*2.2e+1/(2.2e+1+10.**(-TPK%PHR))::WR_HNO& + CFULLREACS(258) = 'KR13=!ZRATES(:,019)*2.2e+1/(2.2e+1+10.**(-TPK%PHR))::WR_HNO& &3-->WR_NO2+WR_OH' - CFULLREACS(256) = 'KR14=1.0E+10::WR_N2O5-->WR_HNO3+WR_HNO3' - CFULLREACS(257) = 'KR15=(1.0E+5*1.0e+3*1.0e-2/(1.0e+3*1.0e-2+1.0e+3*10.**(-TPK& + CFULLREACS(259) = 'KR14=1.0E+10::WR_N2O5-->WR_HNO3+WR_HNO3' + CFULLREACS(260) = 'KR15=(1.0E+5*1.0e+3*1.0e-2/(1.0e+3*1.0e-2+1.0e+3*10.**(-TPK& &%PHR)+(10.**(-TPK%PHR))**2.))/TPK%MOL2MOLECRAIN::WR_NO3+WR_SULF-->WR_HNO3+WR_A& &SO4' - CFULLREACS(258) = 'KR16=(1.3E+9*exp(-2200.*(1./TPK%T-1./298.15))*1.3e-2*exp(19& + CFULLREACS(261) = 'KR16=(1.3E+9*exp(-2200.*(1./TPK%T-1./298.15))*1.3e-2*exp(19& &65.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)/(1.3e-2*exp(1965.*(1./TPK%T-1./298.1& &5))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.1& &5))*10.**(-TPK%PHR)+(10.**(-TPK%PHR))**2.))/TPK%MOL2MOLECRAIN::WR_NO3+WR_SO2--& &>WR_HNO3+WR_ASO3' - CFULLREACS(259) = 'KR17=(1.7E+8*exp(-2200.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLE& + CFULLREACS(262) = 'KR17=(1.7E+8*exp(-2200.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLE& &CRAIN::WR_MO2+WR_MO2-->2.00*WR_HCHO+2.00*WR_HO2' - CFULLREACS(260) = 'KR18=(5.0E+5*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-& + CFULLREACS(263) = 'KR18=(5.0E+5*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-& &TPK%PHR)/(1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1.& &/298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)+(10.**(-TPK%P& &HR))**2.))/TPK%MOL2MOLECRAIN::WR_MO2+WR_SO2-->WR_OP1+WR_ASO3' - CFULLREACS(261) = 'KR19=(7.8E+8*exp(-1000.*(1./TPK%T-1./298.15))*2.5e3*exp(403& + CFULLREACS(264) = 'KR19=(7.8E+8*exp(-1000.*(1./TPK%T-1./298.15))*2.5e3*exp(403& &0.*(1./TPK%T-1./298.15))/(1.+2.5e3*exp(4030.*(1./TPK%T-1./298.15))))/TPK%MOL2M& &OLECRAIN::WR_HCHO+WR_OH-->WR_ORA1+WR_HO2' - CFULLREACS(262) = 'KR20=((1.0E+8*exp(-1000.*(1./TPK%T-1./298.15))*10.**(-TPK%P& + CFULLREACS(265) = 'KR20=((1.0E+8*exp(-1000.*(1./TPK%T-1./298.15))*10.**(-TPK%P& &HR)+3.4E+9*exp(-1200.*(1./TPK%T-1./298.15))*1.8e-4*exp(150.*(1./TPK%T-1./298.1& &5)))/(1.8e-4*exp(150.*(1./TPK%T-1./298.15))+10.**(-TPK%PHR)))/TPK%MOL2MOLECRAI& &N::WR_ORA1+WR_OH-->WR_CO2+WR_HO2' - CFULLREACS(263) = 'KR21=((7.9E+2*exp(-2900.*(1./TPK%T-1./298.15))*1.3e-2*exp(1& + CFULLREACS(266) = 'KR21=((7.9E+2*exp(-2900.*(1./TPK%T-1./298.15))*1.3e-2*exp(1& &965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)+2.5E+7*exp(-2450.*(1./TPK%T-1./298.& &15))*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.& &15)))/((1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./2& &98.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)+(10.**(-TPK%PHR& &))**2.)*(1.+2.5e3*exp(4030.*(1./TPK%T-1./298.15)))))/TPK%MOL2MOLECRAIN::WR_SO2& &+WR_HCHO-->WR_AHMS' - CFULLREACS(264) = 'KR22=7.7E-3*exp(-9200.*(1./TPK%T-1./298.15))+3.7E+3*1.e-14*& + CFULLREACS(267) = 'KR22=7.7E-3*exp(-9200.*(1./TPK%T-1./298.15))+3.7E+3*1.e-14*& &EXP(-6716*(1./TPK%T-1./298.15))/10.**(-TPK%PHR)::WR_AHMS-->WR_SO2+WR_HCHO' - CFULLREACS(265) = 'KR23=3.0E+8/TPK%MOL2MOLECRAIN::WR_AHMS+WR_OH-->WR_HO2+WR_OR& + CFULLREACS(268) = 'KR23=3.0E+8/TPK%MOL2MOLECRAIN::WR_AHMS+WR_OH-->WR_HO2+WR_OR& &A1+WR_SO2' - CFULLREACS(266) = 'KR24=1.1E+9::WR_ASO3+W_O2-->WR_ASO5' - CFULLREACS(267) = 'KR25=(1.7E+9*10.**(-TPK%PHR)/(1.6e-5+10.**(-TPK%PHR)))/TPK%& + CFULLREACS(269) = 'KR24=1.1E+9::WR_ASO3+W_O2-->WR_ASO5' + CFULLREACS(270) = 'KR25=(1.7E+9*10.**(-TPK%PHR)/(1.6e-5+10.**(-TPK%PHR)))/TPK%& &MOL2MOLECRAIN::WR_ASO5+WR_HO2-->WR_AHSO5' - CFULLREACS(268) = 'KR26=(2.2E+8*exp(-2600.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLE& + CFULLREACS(271) = 'KR26=(2.2E+8*exp(-2600.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLE& &CRAIN::WR_ASO5+WR_ASO5-->WR_ASO4+WR_ASO4' - CFULLREACS(269) = 'KR27=(7.1E+6*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-& + CFULLREACS(272) = 'KR27=(7.1E+6*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-& &TPK%PHR)*10.**(-TPK%PHR)/(1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(14& &30.*(1./TPK%T-1./298.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PH& &R)+(10.**(-TPK%PHR))**2.))/TPK%MOL2MOLECRAIN::WR_AHSO5+WR_SO2-->2.00*WR_SULF' - CFULLREACS(270) = 'KR28=4.6E+2*exp(-1100.*(1./TPK%T-1./298.15))::WR_ASO4-->WR_& + CFULLREACS(273) = 'KR28=4.6E+2*exp(-1100.*(1./TPK%T-1./298.15))::WR_ASO4-->WR_& &SULF+WR_OH' - CFULLREACS(271) = 'KR29=((3.7E+5*exp(-5500.*(1./TPK%T-1./298.15))*1.3e-2*exp(1& + CFULLREACS(274) = 'KR29=((3.7E+5*exp(-5500.*(1./TPK%T-1./298.15))*1.3e-2*exp(1& &965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)+1.5E+9*exp(-5300.*(1./TPK%T-1./298.& &15))*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.& &15)))/(1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./29& &8.15))+1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)+(10.**(-TPK%PHR)& &)**2.))/TPK%MOL2MOLECRAIN::WR_SO2+WR_O3-->WR_SULF' - CFULLREACS(272) = 'KR30=(9.1E+7*exp(-3600.*(1./TPK%T-1./298.15))*1.3e-2*exp(19& + CFULLREACS(275) = 'KR30=(9.1E+7*exp(-3600.*(1./TPK%T-1./298.15))*1.3e-2*exp(19& &65.*(1./TPK%T-1./298.15))*10.**(-TPK%PHR)*10.**(-TPK%PHR)/(1.3e-2*exp(1965.*(1& &./TPK%T-1./298.15))*6.4e-8*exp(1430.*(1./TPK%T-1./298.15))+1.3e-2*exp(1965.*(1& &./TPK%T-1./298.15))*10.**(-TPK%PHR)+(10.**(-TPK%PHR))**2.))/TPK%MOL2MOLECRAIN:& @@ -4003,7 +4034,7 @@ TPK%O3P(:)=(TPK%K001(:)*PCONC(:,JP_NO2)+TPK%K003(:)*PCONC(:,JP_O3)+TPK%K008(:)*P &0.09000*TPK%K080(:)*PCONC(:,JP_BIO)*PCONC(:,JP_O3))/& &(TPK%K018(:)*TPK%O2(:)+TPK%K019(:)*PCONC(:,JP_O3)+TPK%K029(:)*PCONC(:,JP_NO)+& &TPK%K030(:)*PCONC(:,JP_NO2)+TPK%K031(:)*PCONC(:,JP_NO2)+TPK%K054(:)*PCONC(:,JP_BIO)+& - &TPK%K055(:)*PCONC(:,JP_CARBO)) + &TPK%K055(:)*PCONC(:,JP_CARBO)+TPK%K134(:)*PCONC(:,JP_DMS)) ! /END_CODE/ CALL SUB0 CALL SUB1 @@ -4025,36 +4056,36 @@ SUBROUTINE SUB0 ! !PPROD(O3) = +K018*<O3P>*<O2>+0.17307*K0102*<CARBOP>*<HO2>+KTC21*<WC_O3>+KTR21* !<WR_O3> - PPROD(:,1) = +TPK%K018(:)*TPK%O3P(:)*TPK%O2(:)+0.17307*TPK%K0102(:)*PCONC(:,39& -&)*PCONC(:,15)+TPK%KTC21(:)*PCONC(:,42)+TPK%KTR21(:)*PCONC(:,67) + PPROD(:,1) = +TPK%K018(:)*TPK%O3P(:)*TPK%O2(:)+0.17307*TPK%K0102(:)*PCONC(:,40& +&)*PCONC(:,16)+TPK%KTC21(:)*PCONC(:,43)+TPK%KTR21(:)*PCONC(:,68) !PLOSS(O3) = +K002+K003+K019*<O3P>+K023*<OH>+K024*<HO2>+K042*<NO>+K043*<NO2>+K0 !79*<ALKE>+K080*<BIO>+K081*<CARBO>+K082*<PAN>+K087*<ADD>+KTC1+KTR1 PLOSS(:,1) = +TPK%K002(:)+TPK%K003(:)+TPK%K019(:)*TPK%O3P(:)+TPK%K023(:)*PCONC& -&(:,14)+TPK%K024(:)*PCONC(:,15)+TPK%K042(:)*PCONC(:,3)+TPK%K043(:)*PCONC(:,4)+T& -&PK%K079(:)*PCONC(:,19)+TPK%K080(:)*PCONC(:,20)+TPK%K081(:)*PCONC(:,25)+TPK%K08& -&2(:)*PCONC(:,27)+TPK%K087(:)*PCONC(:,37)+TPK%KTC1(:)+TPK%KTR1(:) +&(:,15)+TPK%K024(:)*PCONC(:,16)+TPK%K042(:)*PCONC(:,3)+TPK%K043(:)*PCONC(:,4)+T& +&PK%K079(:)*PCONC(:,20)+TPK%K080(:)*PCONC(:,21)+TPK%K081(:)*PCONC(:,26)+TPK%K08& +&2(:)*PCONC(:,28)+TPK%K087(:)*PCONC(:,38)+TPK%KTC1(:)+TPK%KTR1(:) ! !PPROD(H2O2) = +K027*<HO2>*<HO2>+K028*<HO2>*<HO2>*<H2O>+0.01833*K079*<ALKE>*<O3 !>+0.00100*K080*<BIO>*<O3>+KTC22*<WC_H2O2>+KTR22*<WR_H2O2> - PPROD(:,2) = +TPK%K027(:)*PCONC(:,15)*PCONC(:,15)+TPK%K028(:)*PCONC(:,15)*PCON& -&C(:,15)*TPK%H2O(:)+0.01833*TPK%K079(:)*PCONC(:,19)*PCONC(:,1)+0.00100*TPK%K080& -&(:)*PCONC(:,20)*PCONC(:,1)+TPK%KTC22(:)*PCONC(:,43)+TPK%KTR22(:)*PCONC(:,68) + PPROD(:,2) = +TPK%K027(:)*PCONC(:,16)*PCONC(:,16)+TPK%K028(:)*PCONC(:,16)*PCON& +&C(:,16)*TPK%H2O(:)+0.01833*TPK%K079(:)*PCONC(:,20)*PCONC(:,1)+0.00100*TPK%K080& +&(:)*PCONC(:,21)*PCONC(:,1)+TPK%KTC22(:)*PCONC(:,44)+TPK%KTR22(:)*PCONC(:,69) !PLOSS(H2O2) = +K009+K026*<OH>+KTC2+KTR2 - PLOSS(:,2) = +TPK%K009(:)+TPK%K026(:)*PCONC(:,14)+TPK%KTC2(:)+TPK%KTR2(:) + PLOSS(:,2) = +TPK%K009(:)+TPK%K026(:)*PCONC(:,15)+TPK%KTC2(:)+TPK%KTR2(:) ! !PPROD(NO) = +K001*<NO2>+K004*<HONO>+K007*<NO3>+K030*<O3P>*<NO2>+K046*<NO3>*<NO !2>+KTC23*<WC_NO>+KTR23*<WR_NO> PPROD(:,3) = +TPK%K001(:)*PCONC(:,4)+TPK%K004(:)*PCONC(:,7)+TPK%K007(:)*PCONC(& &:,5)+TPK%K030(:)*TPK%O3P(:)*PCONC(:,4)+TPK%K046(:)*PCONC(:,5)*PCONC(:,4)+TPK%K& -&TC23(:)*PCONC(:,44)+TPK%KTR23(:)*PCONC(:,69) +&TC23(:)*PCONC(:,45)+TPK%KTR23(:)*PCONC(:,70) !PLOSS(NO) = +K029*<O3P>+K032*<OH>+K035*<HO2>+K042*<O3>+K044*<NO>*<O2>+K044*<NO !>*<O2>+K045*<NO3>+K090*<MO2>+K091*<ALKAP>+K092*<ALKEP>+K093*<BIOP>+K094*<AROP> !+K095*<CARBOP>+K096*<OLN>+K130*<XO2>+KTC3+KTR3 - PLOSS(:,3) = +TPK%K029(:)*TPK%O3P(:)+TPK%K032(:)*PCONC(:,14)+TPK%K035(:)*PCONC& -&(:,15)+TPK%K042(:)*PCONC(:,1)+TPK%K044(:)*PCONC(:,3)*TPK%O2(:)+TPK%K044(:)*PCO& -&NC(:,3)*TPK%O2(:)+TPK%K045(:)*PCONC(:,5)+TPK%K090(:)*PCONC(:,32)+TPK%K091(:)*P& -&CONC(:,33)+TPK%K092(:)*PCONC(:,34)+TPK%K093(:)*PCONC(:,35)+TPK%K094(:)*PCONC(:& -&,38)+TPK%K095(:)*PCONC(:,39)+TPK%K096(:)*PCONC(:,40)+TPK%K130(:)*PCONC(:,41)+T& + PLOSS(:,3) = +TPK%K029(:)*TPK%O3P(:)+TPK%K032(:)*PCONC(:,15)+TPK%K035(:)*PCONC& +&(:,16)+TPK%K042(:)*PCONC(:,1)+TPK%K044(:)*PCONC(:,3)*TPK%O2(:)+TPK%K044(:)*PCO& +&NC(:,3)*TPK%O2(:)+TPK%K045(:)*PCONC(:,5)+TPK%K090(:)*PCONC(:,33)+TPK%K091(:)*P& +&CONC(:,34)+TPK%K092(:)*PCONC(:,35)+TPK%K093(:)*PCONC(:,36)+TPK%K094(:)*PCONC(:& +&,39)+TPK%K095(:)*PCONC(:,40)+TPK%K096(:)*PCONC(:,41)+TPK%K130(:)*PCONC(:,42)+T& &PK%KTC3(:)+TPK%KTR3(:) ! !PPROD(NO2) = +K005*<HNO3>+0.65*K006*<HNO4>+K008*<NO3>+K017*<ONIT>+K029*<O3P>*< @@ -4067,88 +4098,90 @@ SUBROUTINE SUB0 !ARBOP>*<NO>+1.81599*K096*<OLN>*<NO>+0.32440*K110*<OLN>*<MO2>+0.00000*K116*<OLN !>*<CARBOP>+0.00000*K118*<OLN>*<OLN>+K119*<MO2>*<NO3>+K120*<ALKAP>*<NO3>+K121*< !ALKEP>*<NO3>+K122*<BIOP>*<NO3>+K123*<AROP>*<NO3>+K124*<CARBOP>*<NO3>+1.74072*K -!125*<OLN>*<NO3>+K130*<XO2>*<NO>+K131*<XO2>*<NO3>+KTC24*<WC_NO2>+KTR24*<WR_NO2> +!125*<OLN>*<NO3>+K130*<XO2>*<NO>+K131*<XO2>*<NO3>+K133*<DMS>*<NO3>+KTC24*<WC_NO +!2>+KTR24*<WR_NO2> PPROD(:,4) = +TPK%K005(:)*PCONC(:,8)+0.65*TPK%K006(:)*PCONC(:,9)+TPK%K008(:)*P& -&CONC(:,5)+TPK%K017(:)*PCONC(:,26)+TPK%K029(:)*TPK%O3P(:)*PCONC(:,3)+TPK%K034(:& -&)*PCONC(:,14)*PCONC(:,5)+TPK%K035(:)*PCONC(:,15)*PCONC(:,3)+TPK%K037(:)*PCONC(& -&:,9)+0.7*TPK%K038(:)*PCONC(:,15)*PCONC(:,5)+TPK%K039(:)*PCONC(:,14)*PCONC(:,7)& -&+TPK%K041(:)*PCONC(:,14)*PCONC(:,9)+TPK%K042(:)*PCONC(:,1)*PCONC(:,3)+TPK%K044& +&CONC(:,5)+TPK%K017(:)*PCONC(:,27)+TPK%K029(:)*TPK%O3P(:)*PCONC(:,3)+TPK%K034(:& +&)*PCONC(:,15)*PCONC(:,5)+TPK%K035(:)*PCONC(:,16)*PCONC(:,3)+TPK%K037(:)*PCONC(& +&:,9)+0.7*TPK%K038(:)*PCONC(:,16)*PCONC(:,5)+TPK%K039(:)*PCONC(:,15)*PCONC(:,7)& +&+TPK%K041(:)*PCONC(:,15)*PCONC(:,9)+TPK%K042(:)*PCONC(:,1)*PCONC(:,3)+TPK%K044& &(:)*PCONC(:,3)*PCONC(:,3)*TPK%O2(:)+TPK%K044(:)*PCONC(:,3)*PCONC(:,3)*TPK%O2(:& &)+TPK%K045(:)*PCONC(:,5)*PCONC(:,3)+TPK%K045(:)*PCONC(:,5)*PCONC(:,3)+TPK%K046& &(:)*PCONC(:,5)*PCONC(:,4)+TPK%K048(:)*PCONC(:,6)+TPK%K049(:)*PCONC(:,5)*PCONC(& -&:,5)+TPK%K049(:)*PCONC(:,5)*PCONC(:,5)+TPK%K071(:)*PCONC(:,26)*PCONC(:,14)+0.1& -&0530*TPK%K074(:)*PCONC(:,25)*PCONC(:,5)+0.40*TPK%K078(:)*PCONC(:,27)*PCONC(:,5& -&)+0.70*TPK%K082(:)*PCONC(:,27)*PCONC(:,1)+TPK%K089(:)*PCONC(:,27)+TPK%K090(:)*& -&PCONC(:,32)*PCONC(:,3)+0.91541*TPK%K091(:)*PCONC(:,33)*PCONC(:,3)+TPK%K092(:)*& -&PCONC(:,34)*PCONC(:,3)+0.84700*TPK%K093(:)*PCONC(:,35)*PCONC(:,3)+0.95115*TPK%& -&K094(:)*PCONC(:,38)*PCONC(:,3)+TPK%K095(:)*PCONC(:,39)*PCONC(:,3)+1.81599*TPK%& -&K096(:)*PCONC(:,40)*PCONC(:,3)+0.32440*TPK%K110(:)*PCONC(:,40)*PCONC(:,32)+0.0& -&0000*TPK%K116(:)*PCONC(:,40)*PCONC(:,39)+0.00000*TPK%K118(:)*PCONC(:,40)*PCONC& -&(:,40)+TPK%K119(:)*PCONC(:,32)*PCONC(:,5)+TPK%K120(:)*PCONC(:,33)*PCONC(:,5)+T& -&PK%K121(:)*PCONC(:,34)*PCONC(:,5)+TPK%K122(:)*PCONC(:,35)*PCONC(:,5)+TPK%K123(& -&:)*PCONC(:,38)*PCONC(:,5)+TPK%K124(:)*PCONC(:,39)*PCONC(:,5)+1.74072*TPK%K125(& -&:)*PCONC(:,40)*PCONC(:,5)+TPK%K130(:)*PCONC(:,41)*PCONC(:,3)+TPK%K131(:)*PCONC& -&(:,41)*PCONC(:,5)+TPK%KTC24(:)*PCONC(:,45)+TPK%KTR24(:)*PCONC(:,70) +&:,5)+TPK%K049(:)*PCONC(:,5)*PCONC(:,5)+TPK%K071(:)*PCONC(:,27)*PCONC(:,15)+0.1& +&0530*TPK%K074(:)*PCONC(:,26)*PCONC(:,5)+0.40*TPK%K078(:)*PCONC(:,28)*PCONC(:,5& +&)+0.70*TPK%K082(:)*PCONC(:,28)*PCONC(:,1)+TPK%K089(:)*PCONC(:,28)+TPK%K090(:)*& +&PCONC(:,33)*PCONC(:,3)+0.91541*TPK%K091(:)*PCONC(:,34)*PCONC(:,3)+TPK%K092(:)*& +&PCONC(:,35)*PCONC(:,3)+0.84700*TPK%K093(:)*PCONC(:,36)*PCONC(:,3)+0.95115*TPK%& +&K094(:)*PCONC(:,39)*PCONC(:,3)+TPK%K095(:)*PCONC(:,40)*PCONC(:,3)+1.81599*TPK%& +&K096(:)*PCONC(:,41)*PCONC(:,3)+0.32440*TPK%K110(:)*PCONC(:,41)*PCONC(:,33)+0.0& +&0000*TPK%K116(:)*PCONC(:,41)*PCONC(:,40)+0.00000*TPK%K118(:)*PCONC(:,41)*PCONC& +&(:,41)+TPK%K119(:)*PCONC(:,33)*PCONC(:,5)+TPK%K120(:)*PCONC(:,34)*PCONC(:,5)+T& +&PK%K121(:)*PCONC(:,35)*PCONC(:,5)+TPK%K122(:)*PCONC(:,36)*PCONC(:,5)+TPK%K123(& +&:)*PCONC(:,39)*PCONC(:,5)+TPK%K124(:)*PCONC(:,40)*PCONC(:,5)+1.74072*TPK%K125(& +&:)*PCONC(:,41)*PCONC(:,5)+TPK%K130(:)*PCONC(:,42)*PCONC(:,3)+TPK%K131(:)*PCONC& +&(:,42)*PCONC(:,5)+TPK%K133(:)*PCONC(:,11)*PCONC(:,5)+TPK%KTC24(:)*PCONC(:,46)+& +&TPK%KTR24(:)*PCONC(:,71) !PLOSS(NO2) = +K001+K030*<O3P>+K031*<O3P>+K033*<OH>+K036*<HO2>+K043*<O3>+K046*< !NO3>+K047*<NO3>+K083*<PHO>+K085*<ADD>+K088*<CARBOP>+KTC4+KTR4 PLOSS(:,4) = +TPK%K001(:)+TPK%K030(:)*TPK%O3P(:)+TPK%K031(:)*TPK%O3P(:)+TPK%K0& -&33(:)*PCONC(:,14)+TPK%K036(:)*PCONC(:,15)+TPK%K043(:)*PCONC(:,1)+TPK%K046(:)*P& -&CONC(:,5)+TPK%K047(:)*PCONC(:,5)+TPK%K083(:)*PCONC(:,36)+TPK%K085(:)*PCONC(:,3& -&7)+TPK%K088(:)*PCONC(:,39)+TPK%KTC4(:)+TPK%KTR4(:) +&33(:)*PCONC(:,15)+TPK%K036(:)*PCONC(:,16)+TPK%K043(:)*PCONC(:,1)+TPK%K046(:)*P& +&CONC(:,5)+TPK%K047(:)*PCONC(:,5)+TPK%K083(:)*PCONC(:,37)+TPK%K085(:)*PCONC(:,3& +&8)+TPK%K088(:)*PCONC(:,40)+TPK%KTC4(:)+TPK%KTR4(:) ! !PPROD(NO3) = +0.35*K006*<HNO4>+K031*<O3P>*<NO2>+K040*<OH>*<HNO3>+K043*<O3>*<NO !2>+K048*<N2O5>+0.71893*K070*<PAN>*<OH>+0.60*K078*<PAN>*<NO3>+KTC25*<WC_NO3>+KT !R25*<WR_NO3> PPROD(:,5) = +0.35*TPK%K006(:)*PCONC(:,9)+TPK%K031(:)*TPK%O3P(:)*PCONC(:,4)+TP& -&K%K040(:)*PCONC(:,14)*PCONC(:,8)+TPK%K043(:)*PCONC(:,1)*PCONC(:,4)+TPK%K048(:)& -&*PCONC(:,6)+0.71893*TPK%K070(:)*PCONC(:,27)*PCONC(:,14)+0.60*TPK%K078(:)*PCONC& -&(:,27)*PCONC(:,5)+TPK%KTC25(:)*PCONC(:,46)+TPK%KTR25(:)*PCONC(:,71) +&K%K040(:)*PCONC(:,15)*PCONC(:,8)+TPK%K043(:)*PCONC(:,1)*PCONC(:,4)+TPK%K048(:)& +&*PCONC(:,6)+0.71893*TPK%K070(:)*PCONC(:,28)*PCONC(:,15)+0.60*TPK%K078(:)*PCONC& +&(:,28)*PCONC(:,5)+TPK%KTC25(:)*PCONC(:,47)+TPK%KTR25(:)*PCONC(:,72) !PLOSS(NO3) = +K007+K008+K034*<OH>+K038*<HO2>+K045*<NO>+K046*<NO2>+K047*<NO2>+K !049*<NO3>+K049*<NO3>+K072*<HCHO>+K073*<ALD>+K074*<CARBO>+K075*<ARO>+K076*<ALKE !>+K077*<BIO>+K078*<PAN>+K119*<MO2>+K120*<ALKAP>+K121*<ALKEP>+K122*<BIOP>+K123* -!<AROP>+K124*<CARBOP>+K125*<OLN>+K131*<XO2>+KTC5+KTR5 - PLOSS(:,5) = +TPK%K007(:)+TPK%K008(:)+TPK%K034(:)*PCONC(:,14)+TPK%K038(:)*PCON& -&C(:,15)+TPK%K045(:)*PCONC(:,3)+TPK%K046(:)*PCONC(:,4)+TPK%K047(:)*PCONC(:,4)+T& -&PK%K049(:)*PCONC(:,5)+TPK%K049(:)*PCONC(:,5)+TPK%K072(:)*PCONC(:,22)+TPK%K073(& -&:)*PCONC(:,23)+TPK%K074(:)*PCONC(:,25)+TPK%K075(:)*PCONC(:,21)+TPK%K076(:)*PCO& -&NC(:,19)+TPK%K077(:)*PCONC(:,20)+TPK%K078(:)*PCONC(:,27)+TPK%K119(:)*PCONC(:,3& -&2)+TPK%K120(:)*PCONC(:,33)+TPK%K121(:)*PCONC(:,34)+TPK%K122(:)*PCONC(:,35)+TPK& -&%K123(:)*PCONC(:,38)+TPK%K124(:)*PCONC(:,39)+TPK%K125(:)*PCONC(:,40)+TPK%K131(& -&:)*PCONC(:,41)+TPK%KTC5(:)+TPK%KTR5(:) +!<AROP>+K124*<CARBOP>+K125*<OLN>+K131*<XO2>+K133*<DMS>+KTC5+KTR5 + PLOSS(:,5) = +TPK%K007(:)+TPK%K008(:)+TPK%K034(:)*PCONC(:,15)+TPK%K038(:)*PCON& +&C(:,16)+TPK%K045(:)*PCONC(:,3)+TPK%K046(:)*PCONC(:,4)+TPK%K047(:)*PCONC(:,4)+T& +&PK%K049(:)*PCONC(:,5)+TPK%K049(:)*PCONC(:,5)+TPK%K072(:)*PCONC(:,23)+TPK%K073(& +&:)*PCONC(:,24)+TPK%K074(:)*PCONC(:,26)+TPK%K075(:)*PCONC(:,22)+TPK%K076(:)*PCO& +&NC(:,20)+TPK%K077(:)*PCONC(:,21)+TPK%K078(:)*PCONC(:,28)+TPK%K119(:)*PCONC(:,3& +&3)+TPK%K120(:)*PCONC(:,34)+TPK%K121(:)*PCONC(:,35)+TPK%K122(:)*PCONC(:,36)+TPK& +&%K123(:)*PCONC(:,39)+TPK%K124(:)*PCONC(:,40)+TPK%K125(:)*PCONC(:,41)+TPK%K131(& +&:)*PCONC(:,42)+TPK%K133(:)*PCONC(:,11)+TPK%KTC5(:)+TPK%KTR5(:) ! !PPROD(N2O5) = +K047*<NO3>*<NO2>+KTC26*<WC_N2O5>+KTR26*<WR_N2O5> - PPROD(:,6) = +TPK%K047(:)*PCONC(:,5)*PCONC(:,4)+TPK%KTC26(:)*PCONC(:,47)+TPK%K& -&TR26(:)*PCONC(:,72) + PPROD(:,6) = +TPK%K047(:)*PCONC(:,5)*PCONC(:,4)+TPK%KTC26(:)*PCONC(:,48)+TPK%K& +&TR26(:)*PCONC(:,73) !PLOSS(N2O5) = +K048+KTC6+KTR6 PLOSS(:,6) = +TPK%K048(:)+TPK%KTC6(:)+TPK%KTR6(:) ! !PPROD(HONO) = +K032*<OH>*<NO>+K085*<ADD>*<NO2>+KTC27*<WC_HONO>+KTR27*<WR_HONO> - PPROD(:,7) = +TPK%K032(:)*PCONC(:,14)*PCONC(:,3)+TPK%K085(:)*PCONC(:,37)*PCONC& -&(:,4)+TPK%KTC27(:)*PCONC(:,48)+TPK%KTR27(:)*PCONC(:,73) + PPROD(:,7) = +TPK%K032(:)*PCONC(:,15)*PCONC(:,3)+TPK%K085(:)*PCONC(:,38)*PCONC& +&(:,4)+TPK%KTC27(:)*PCONC(:,49)+TPK%KTR27(:)*PCONC(:,74) !PLOSS(HONO) = +K004+K039*<OH>+KTC7+KTR7 - PLOSS(:,7) = +TPK%K004(:)+TPK%K039(:)*PCONC(:,14)+TPK%KTC7(:)+TPK%KTR7(:) + PLOSS(:,7) = +TPK%K004(:)+TPK%K039(:)*PCONC(:,15)+TPK%KTC7(:)+TPK%KTR7(:) ! !PPROD(HNO3) = +K033*<OH>*<NO2>+0.3*K038*<HO2>*<NO3>+K072*<HCHO>*<NO3>+K073*<AL !D>*<NO3>+0.91567*K074*<CARBO>*<NO3>+K075*<ARO>*<NO3>+KTC28*<WC_HNO3>+KTR28*<WR !_HNO3> - PPROD(:,8) = +TPK%K033(:)*PCONC(:,14)*PCONC(:,4)+0.3*TPK%K038(:)*PCONC(:,15)*P& -&CONC(:,5)+TPK%K072(:)*PCONC(:,22)*PCONC(:,5)+TPK%K073(:)*PCONC(:,23)*PCONC(:,5& -&)+0.91567*TPK%K074(:)*PCONC(:,25)*PCONC(:,5)+TPK%K075(:)*PCONC(:,21)*PCONC(:,5& -&)+TPK%KTC28(:)*PCONC(:,49)+TPK%KTR28(:)*PCONC(:,74) + PPROD(:,8) = +TPK%K033(:)*PCONC(:,15)*PCONC(:,4)+0.3*TPK%K038(:)*PCONC(:,16)*P& +&CONC(:,5)+TPK%K072(:)*PCONC(:,23)*PCONC(:,5)+TPK%K073(:)*PCONC(:,24)*PCONC(:,5& +&)+0.91567*TPK%K074(:)*PCONC(:,26)*PCONC(:,5)+TPK%K075(:)*PCONC(:,22)*PCONC(:,5& +&)+TPK%KTC28(:)*PCONC(:,50)+TPK%KTR28(:)*PCONC(:,75) !PLOSS(HNO3) = +K005+K040*<OH>+KTC8+KTR8 - PLOSS(:,8) = +TPK%K005(:)+TPK%K040(:)*PCONC(:,14)+TPK%KTC8(:)+TPK%KTR8(:) + PLOSS(:,8) = +TPK%K005(:)+TPK%K040(:)*PCONC(:,15)+TPK%KTC8(:)+TPK%KTR8(:) ! !PPROD(HNO4) = +K036*<HO2>*<NO2>+KTC29*<WC_HNO4>+KTR29*<WR_HNO4> - PPROD(:,9) = +TPK%K036(:)*PCONC(:,15)*PCONC(:,4)+TPK%KTC29(:)*PCONC(:,50)+TPK%& -&KTR29(:)*PCONC(:,75) + PPROD(:,9) = +TPK%K036(:)*PCONC(:,16)*PCONC(:,4)+TPK%KTC29(:)*PCONC(:,51)+TPK%& +&KTR29(:)*PCONC(:,76) !PLOSS(HNO4) = +K006+K037+K041*<OH>+KTC9+KTR9 - PLOSS(:,9) = +TPK%K006(:)+TPK%K037(:)+TPK%K041(:)*PCONC(:,14)+TPK%KTC9(:)+TPK%& + PLOSS(:,9) = +TPK%K006(:)+TPK%K037(:)+TPK%K041(:)*PCONC(:,15)+TPK%KTC9(:)+TPK%& &KTR9(:) ! !PPROD(NH3) = +KTC30*<WC_NH3>+KTR30*<WR_NH3> - PPROD(:,10) = +TPK%KTC30(:)*PCONC(:,51)+TPK%KTR30(:)*PCONC(:,76) + PPROD(:,10) = +TPK%KTC30(:)*PCONC(:,52)+TPK%KTR30(:)*PCONC(:,77) !PLOSS(NH3) = +K050*<OH>+KTC10+KTR10 - PLOSS(:,10) = +TPK%K050(:)*PCONC(:,14)+TPK%KTC10(:)+TPK%KTR10(:) + PLOSS(:,10) = +TPK%K050(:)*PCONC(:,15)+TPK%KTC10(:)+TPK%KTR10(:) ! RETURN END SUBROUTINE SUB0 @@ -4158,30 +4191,39 @@ SUBROUTINE SUB1 !Indices 11 a 20 ! ! -!PPROD(SO2) = +KTC34*<WC_SO2>+KTR34*<WR_SO2> - PPROD(:,11) = +TPK%KTC34(:)*PCONC(:,55)+TPK%KTR34(:)*PCONC(:,80) +!PPROD(DMS) = 0.0 + PPROD(:,11) = 0.0 +!PLOSS(DMS) = +K133*<NO3>+K134*<O3P>+K135*<OH> + PLOSS(:,11) = +TPK%K133(:)*PCONC(:,5)+TPK%K134(:)*TPK%O3P(:)+TPK%K135(:)*PCONC& +&(:,15) +! +!PPROD(SO2) = +K133*<DMS>*<NO3>+K134*<DMS>*<O3P>+0.8*K135*<DMS>*<OH>+KTC34*<WC_ +!SO2>+KTR34*<WR_SO2> + PPROD(:,12) = +TPK%K133(:)*PCONC(:,11)*PCONC(:,5)+TPK%K134(:)*PCONC(:,11)*TPK%& +&O3P(:)+0.8*TPK%K135(:)*PCONC(:,11)*PCONC(:,15)+TPK%KTC34(:)*PCONC(:,56)+TPK%KT& +&R34(:)*PCONC(:,81) !PLOSS(SO2) = +K052*<OH>+KTC14+KTR14 - PLOSS(:,11) = +TPK%K052(:)*PCONC(:,14)+TPK%KTC14(:)+TPK%KTR14(:) + PLOSS(:,12) = +TPK%K052(:)*PCONC(:,15)+TPK%KTC14(:)+TPK%KTR14(:) ! !PPROD(SULF) = +K052*<OH>*<SO2>+KTC35*<WC_SULF>+KTR35*<WR_SULF> - PPROD(:,12) = +TPK%K052(:)*PCONC(:,14)*PCONC(:,11)+TPK%KTC35(:)*PCONC(:,56)+TP& -&K%KTR35(:)*PCONC(:,81) + PPROD(:,13) = +TPK%K052(:)*PCONC(:,15)*PCONC(:,12)+TPK%KTC35(:)*PCONC(:,57)+TP& +&K%KTR35(:)*PCONC(:,82) !PLOSS(SULF) = +K132+KTC15+KTR15 - PLOSS(:,12) = +TPK%K132(:)+TPK%KTC15(:)+TPK%KTR15(:) + PLOSS(:,13) = +TPK%K132(:)+TPK%KTC15(:)+TPK%KTR15(:) ! !PPROD(CO) = +K010*<HCHO>+K011*<HCHO>+K012*<ALD>+0.91924*K016*<CARBO>+0.01*K054 !*<BIO>*<O3P>+0.00878*K058*<ALKA>*<OH>+K062*<HCHO>*<OH>+1.01732*K065*<CARBO>*<O !H>+K072*<HCHO>*<NO3>+1.33723*K074*<CARBO>*<NO3>+0.35120*K079*<ALKE>*<O3>+0.360 !00*K080*<BIO>*<O3>+0.64728*K081*<CARBO>*<O3>+0.13*K082*<PAN>*<O3> - PPROD(:,13) = +TPK%K010(:)*PCONC(:,22)+TPK%K011(:)*PCONC(:,22)+TPK%K012(:)*PCO& -&NC(:,23)+0.91924*TPK%K016(:)*PCONC(:,25)+0.01*TPK%K054(:)*PCONC(:,20)*TPK%O3P(& -&:)+0.00878*TPK%K058(:)*PCONC(:,18)*PCONC(:,14)+TPK%K062(:)*PCONC(:,22)*PCONC(:& -&,14)+1.01732*TPK%K065(:)*PCONC(:,25)*PCONC(:,14)+TPK%K072(:)*PCONC(:,22)*PCONC& -&(:,5)+1.33723*TPK%K074(:)*PCONC(:,25)*PCONC(:,5)+0.35120*TPK%K079(:)*PCONC(:,1& -&9)*PCONC(:,1)+0.36000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1)+0.64728*TPK%K081(:)*P& -&CONC(:,25)*PCONC(:,1)+0.13*TPK%K082(:)*PCONC(:,27)*PCONC(:,1) + PPROD(:,14) = +TPK%K010(:)*PCONC(:,23)+TPK%K011(:)*PCONC(:,23)+TPK%K012(:)*PCO& +&NC(:,24)+0.91924*TPK%K016(:)*PCONC(:,26)+0.01*TPK%K054(:)*PCONC(:,21)*TPK%O3P(& +&:)+0.00878*TPK%K058(:)*PCONC(:,19)*PCONC(:,15)+TPK%K062(:)*PCONC(:,23)*PCONC(:& +&,15)+1.01732*TPK%K065(:)*PCONC(:,26)*PCONC(:,15)+TPK%K072(:)*PCONC(:,23)*PCONC& +&(:,5)+1.33723*TPK%K074(:)*PCONC(:,26)*PCONC(:,5)+0.35120*TPK%K079(:)*PCONC(:,2& +&0)*PCONC(:,1)+0.36000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.64728*TPK%K081(:)*P& +&CONC(:,26)*PCONC(:,1)+0.13*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) !PLOSS(CO) = +K053*<OH> - PLOSS(:,13) = +TPK%K053(:)*PCONC(:,14) + PLOSS(:,14) = +TPK%K053(:)*PCONC(:,15) ! !PPROD(OH) = +K004*<HONO>+K005*<HNO3>+0.35*K006*<HNO4>+K009*<H2O2>+K009*<H2O2>+ !K013*<OP1>+K014*<OP2>+K022*<O1D>*<H2O>+K022*<O1D>*<H2O>+K024*<O3>*<HO2>+K035*< @@ -4189,32 +4231,32 @@ SUBROUTINE SUB1 !0.35*K068*<OP1>*<OH>+0.44925*K069*<OP2>*<OH>+0.39435*K079*<ALKE>*<O3>+0.28000* !K080*<BIO>*<O3>+0.20595*K081*<CARBO>*<O3>+0.036*K082*<PAN>*<O3>+K087*<ADD>*<O3 !>+KTC31*<WC_OH>+KTR31*<WR_OH> - PPROD(:,14) = +TPK%K004(:)*PCONC(:,7)+TPK%K005(:)*PCONC(:,8)+0.35*TPK%K006(:)*& + PPROD(:,15) = +TPK%K004(:)*PCONC(:,7)+TPK%K005(:)*PCONC(:,8)+0.35*TPK%K006(:)*& &PCONC(:,9)+TPK%K009(:)*PCONC(:,2)+TPK%K009(:)*PCONC(:,2)+TPK%K013(:)*PCONC(:,2& -&8)+TPK%K014(:)*PCONC(:,29)+TPK%K022(:)*TPK%O1D(:)*TPK%H2O(:)+TPK%K022(:)*TPK%O& -&1D(:)*TPK%H2O(:)+TPK%K024(:)*PCONC(:,1)*PCONC(:,15)+TPK%K035(:)*PCONC(:,15)*PC& -&ONC(:,3)+0.7*TPK%K038(:)*PCONC(:,15)*PCONC(:,5)+0.02*TPK%K054(:)*PCONC(:,20)*T& -&PK%O3P(:)+0.00878*TPK%K058(:)*PCONC(:,18)*PCONC(:,14)+0.35*TPK%K068(:)*PCONC(:& -&,28)*PCONC(:,14)+0.44925*TPK%K069(:)*PCONC(:,29)*PCONC(:,14)+0.39435*TPK%K079(& -&:)*PCONC(:,19)*PCONC(:,1)+0.28000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1)+0.20595*T& -&PK%K081(:)*PCONC(:,25)*PCONC(:,1)+0.036*TPK%K082(:)*PCONC(:,27)*PCONC(:,1)+TPK& -&%K087(:)*PCONC(:,37)*PCONC(:,1)+TPK%KTC31(:)*PCONC(:,52)+TPK%KTR31(:)*PCONC(:,& -&77) +&9)+TPK%K014(:)*PCONC(:,30)+TPK%K022(:)*TPK%O1D(:)*TPK%H2O(:)+TPK%K022(:)*TPK%O& +&1D(:)*TPK%H2O(:)+TPK%K024(:)*PCONC(:,1)*PCONC(:,16)+TPK%K035(:)*PCONC(:,16)*PC& +&ONC(:,3)+0.7*TPK%K038(:)*PCONC(:,16)*PCONC(:,5)+0.02*TPK%K054(:)*PCONC(:,21)*T& +&PK%O3P(:)+0.00878*TPK%K058(:)*PCONC(:,19)*PCONC(:,15)+0.35*TPK%K068(:)*PCONC(:& +&,29)*PCONC(:,15)+0.44925*TPK%K069(:)*PCONC(:,30)*PCONC(:,15)+0.39435*TPK%K079(& +&:)*PCONC(:,20)*PCONC(:,1)+0.28000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.20595*T& +&PK%K081(:)*PCONC(:,26)*PCONC(:,1)+0.036*TPK%K082(:)*PCONC(:,28)*PCONC(:,1)+TPK& +&%K087(:)*PCONC(:,38)*PCONC(:,1)+TPK%KTC31(:)*PCONC(:,53)+TPK%KTR31(:)*PCONC(:,& +&78) !PLOSS(OH) = +K023*<O3>+K025*<HO2>+K026*<H2O2>+K032*<NO>+K033*<NO2>+K034*<NO3>+ !K039*<HONO>+K040*<HNO3>+K041*<HNO4>+K050*<NH3>+K051*<H2>+K052*<SO2>+K053*<CO>+ !K056*<CH4>+K057*<ETH>+K058*<ALKA>+K059*<ALKE>+K060*<BIO>+K061*<ARO>+K062*<HCHO !>+K063*<ALD>+K064*<KET>+K065*<CARBO>+K066*<ORA1>+K067*<ORA2>+K068*<OP1>+K069*< -!OP2>+K070*<PAN>+K071*<ONIT>+KTC11+KTR11 - PLOSS(:,14) = +TPK%K023(:)*PCONC(:,1)+TPK%K025(:)*PCONC(:,15)+TPK%K026(:)*PCON& +!OP2>+K070*<PAN>+K071*<ONIT>+K135*<DMS>+KTC11+KTR11 + PLOSS(:,15) = +TPK%K023(:)*PCONC(:,1)+TPK%K025(:)*PCONC(:,16)+TPK%K026(:)*PCON& &C(:,2)+TPK%K032(:)*PCONC(:,3)+TPK%K033(:)*PCONC(:,4)+TPK%K034(:)*PCONC(:,5)+TP& &K%K039(:)*PCONC(:,7)+TPK%K040(:)*PCONC(:,8)+TPK%K041(:)*PCONC(:,9)+TPK%K050(:)& -&*PCONC(:,10)+TPK%K051(:)*TPK%H2(:)+TPK%K052(:)*PCONC(:,11)+TPK%K053(:)*PCONC(:& -&,13)+TPK%K056(:)*PCONC(:,16)+TPK%K057(:)*PCONC(:,17)+TPK%K058(:)*PCONC(:,18)+T& -&PK%K059(:)*PCONC(:,19)+TPK%K060(:)*PCONC(:,20)+TPK%K061(:)*PCONC(:,21)+TPK%K06& -&2(:)*PCONC(:,22)+TPK%K063(:)*PCONC(:,23)+TPK%K064(:)*PCONC(:,24)+TPK%K065(:)*P& -&CONC(:,25)+TPK%K066(:)*PCONC(:,30)+TPK%K067(:)*PCONC(:,31)+TPK%K068(:)*PCONC(:& -&,28)+TPK%K069(:)*PCONC(:,29)+TPK%K070(:)*PCONC(:,27)+TPK%K071(:)*PCONC(:,26)+T& -&PK%KTC11(:)+TPK%KTR11(:) +&*PCONC(:,10)+TPK%K051(:)*TPK%H2(:)+TPK%K052(:)*PCONC(:,12)+TPK%K053(:)*PCONC(:& +&,14)+TPK%K056(:)*PCONC(:,17)+TPK%K057(:)*PCONC(:,18)+TPK%K058(:)*PCONC(:,19)+T& +&PK%K059(:)*PCONC(:,20)+TPK%K060(:)*PCONC(:,21)+TPK%K061(:)*PCONC(:,22)+TPK%K06& +&2(:)*PCONC(:,23)+TPK%K063(:)*PCONC(:,24)+TPK%K064(:)*PCONC(:,25)+TPK%K065(:)*P& +&CONC(:,26)+TPK%K066(:)*PCONC(:,31)+TPK%K067(:)*PCONC(:,32)+TPK%K068(:)*PCONC(:& +&,29)+TPK%K069(:)*PCONC(:,30)+TPK%K070(:)*PCONC(:,28)+TPK%K071(:)*PCONC(:,27)+T& +&PK%K135(:)*PCONC(:,11)+TPK%KTC11(:)+TPK%KTR11(:) ! !PPROD(HO2) = +0.65*K006*<HNO4>+K011*<HCHO>+K011*<HCHO>+K012*<ALD>+K013*<OP1>+0 !.96205*K014*<OP2>+0.75830*K016*<CARBO>+K017*<ONIT>+K023*<O3>*<OH>+K026*<H2O2>* @@ -4233,82 +4275,76 @@ SUBROUTINE SUB1 !LN>+0.00000*K118*<OLN>*<OLN>+K119*<MO2>*<NO3>+0.81290*K120*<ALKAP>*<NO3>+K121* !<ALKEP>*<NO3>+K122*<BIOP>*<NO3>+K123*<AROP>*<NO3>+0.04915*K124*<CARBOP>*<NO3>+ !0.25928*K125*<OLN>*<NO3>+K127*<XO2>*<MO2>+KTC32*<WC_HO2>+KTR32*<WR_HO2> - PPROD(:,15) = +0.65*TPK%K006(:)*PCONC(:,9)+TPK%K011(:)*PCONC(:,22)+TPK%K011(:)& -&*PCONC(:,22)+TPK%K012(:)*PCONC(:,23)+TPK%K013(:)*PCONC(:,28)+0.96205*TPK%K014(& -&:)*PCONC(:,29)+0.75830*TPK%K016(:)*PCONC(:,25)+TPK%K017(:)*PCONC(:,26)+TPK%K02& -&3(:)*PCONC(:,1)*PCONC(:,14)+TPK%K026(:)*PCONC(:,2)*PCONC(:,14)+TPK%K034(:)*PCO& -&NC(:,14)*PCONC(:,5)+TPK%K037(:)*PCONC(:,9)+TPK%K051(:)*PCONC(:,14)*TPK%H2(:)+T& -&PK%K052(:)*PCONC(:,14)*PCONC(:,11)+TPK%K053(:)*PCONC(:,13)*PCONC(:,14)+0.28*TP& -&K%K054(:)*PCONC(:,20)*TPK%O3P(:)+0.12793*TPK%K058(:)*PCONC(:,18)*PCONC(:,14)+0& -&.10318*TPK%K061(:)*PCONC(:,21)*PCONC(:,14)+TPK%K062(:)*PCONC(:,22)*PCONC(:,14)& -&+0.51208*TPK%K065(:)*PCONC(:,25)*PCONC(:,14)+TPK%K066(:)*PCONC(:,30)*PCONC(:,1& -&4)+0.02915*TPK%K069(:)*PCONC(:,29)*PCONC(:,14)+0.28107*TPK%K070(:)*PCONC(:,27)& -&*PCONC(:,14)+TPK%K072(:)*PCONC(:,22)*PCONC(:,5)+0.63217*TPK%K074(:)*PCONC(:,25& -&)*PCONC(:,5)+0.23451*TPK%K079(:)*PCONC(:,19)*PCONC(:,1)+0.30000*TPK%K080(:)*PC& -&ONC(:,20)*PCONC(:,1)+0.28441*TPK%K081(:)*PCONC(:,25)*PCONC(:,1)+0.08*TPK%K082(& -&:)*PCONC(:,27)*PCONC(:,1)+0.02*TPK%K086(:)*PCONC(:,37)*TPK%O2(:)+TPK%K090(:)*P& -&CONC(:,32)*PCONC(:,3)+0.74265*TPK%K091(:)*PCONC(:,33)*PCONC(:,3)+TPK%K092(:)*P& -&CONC(:,34)*PCONC(:,3)+0.84700*TPK%K093(:)*PCONC(:,35)*PCONC(:,3)+0.95115*TPK%K& -&094(:)*PCONC(:,38)*PCONC(:,3)+0.12334*TPK%K095(:)*PCONC(:,39)*PCONC(:,3)+0.184& -&01*TPK%K096(:)*PCONC(:,40)*PCONC(:,3)+0.66*TPK%K104(:)*PCONC(:,32)*PCONC(:,32)& -&+0.98383*TPK%K105(:)*PCONC(:,33)*PCONC(:,32)+TPK%K106(:)*PCONC(:,34)*PCONC(:,3& -&2)+1.00000*TPK%K107(:)*PCONC(:,35)*PCONC(:,32)+1.02767*TPK%K108(:)*PCONC(:,38)& -&*PCONC(:,32)+0.82998*TPK%K109(:)*PCONC(:,39)*PCONC(:,32)+0.67560*TPK%K110(:)*P& -&CONC(:,40)*PCONC(:,32)+0.48079*TPK%K111(:)*PCONC(:,33)*PCONC(:,39)+0.50078*TPK& -&%K112(:)*PCONC(:,34)*PCONC(:,39)+0.50600*TPK%K113(:)*PCONC(:,35)*PCONC(:,39)+T& -&PK%K114(:)*PCONC(:,38)*PCONC(:,39)+0.07566*TPK%K115(:)*PCONC(:,39)*PCONC(:,39)& -&+0.17599*TPK%K116(:)*PCONC(:,40)*PCONC(:,39)+TPK%K117(:)*PCONC(:,40)*PCONC(:,4& -&0)+0.00000*TPK%K118(:)*PCONC(:,40)*PCONC(:,40)+TPK%K119(:)*PCONC(:,32)*PCONC(:& -&,5)+0.81290*TPK%K120(:)*PCONC(:,33)*PCONC(:,5)+TPK%K121(:)*PCONC(:,34)*PCONC(:& -&,5)+TPK%K122(:)*PCONC(:,35)*PCONC(:,5)+TPK%K123(:)*PCONC(:,38)*PCONC(:,5)+0.04& -&915*TPK%K124(:)*PCONC(:,39)*PCONC(:,5)+0.25928*TPK%K125(:)*PCONC(:,40)*PCONC(:& -&,5)+TPK%K127(:)*PCONC(:,41)*PCONC(:,32)+TPK%KTC32(:)*PCONC(:,53)+TPK%KTR32(:)*& -&PCONC(:,78) + PPROD(:,16) = +0.65*TPK%K006(:)*PCONC(:,9)+TPK%K011(:)*PCONC(:,23)+TPK%K011(:)& +&*PCONC(:,23)+TPK%K012(:)*PCONC(:,24)+TPK%K013(:)*PCONC(:,29)+0.96205*TPK%K014(& +&:)*PCONC(:,30)+0.75830*TPK%K016(:)*PCONC(:,26)+TPK%K017(:)*PCONC(:,27)+TPK%K02& +&3(:)*PCONC(:,1)*PCONC(:,15)+TPK%K026(:)*PCONC(:,2)*PCONC(:,15)+TPK%K034(:)*PCO& +&NC(:,15)*PCONC(:,5)+TPK%K037(:)*PCONC(:,9)+TPK%K051(:)*PCONC(:,15)*TPK%H2(:)+T& +&PK%K052(:)*PCONC(:,15)*PCONC(:,12)+TPK%K053(:)*PCONC(:,14)*PCONC(:,15)+0.28*TP& +&K%K054(:)*PCONC(:,21)*TPK%O3P(:)+0.12793*TPK%K058(:)*PCONC(:,19)*PCONC(:,15)+0& +&.10318*TPK%K061(:)*PCONC(:,22)*PCONC(:,15)+TPK%K062(:)*PCONC(:,23)*PCONC(:,15)& +&+0.51208*TPK%K065(:)*PCONC(:,26)*PCONC(:,15)+TPK%K066(:)*PCONC(:,31)*PCONC(:,1& +&5)+0.02915*TPK%K069(:)*PCONC(:,30)*PCONC(:,15)+0.28107*TPK%K070(:)*PCONC(:,28)& +&*PCONC(:,15)+TPK%K072(:)*PCONC(:,23)*PCONC(:,5)+0.63217*TPK%K074(:)*PCONC(:,26& +&)*PCONC(:,5)+0.23451*TPK%K079(:)*PCONC(:,20)*PCONC(:,1)+0.30000*TPK%K080(:)*PC& +&ONC(:,21)*PCONC(:,1)+0.28441*TPK%K081(:)*PCONC(:,26)*PCONC(:,1)+0.08*TPK%K082(& +&:)*PCONC(:,28)*PCONC(:,1)+0.02*TPK%K086(:)*PCONC(:,38)*TPK%O2(:)+TPK%K090(:)*P& +&CONC(:,33)*PCONC(:,3)+0.74265*TPK%K091(:)*PCONC(:,34)*PCONC(:,3)+TPK%K092(:)*P& +&CONC(:,35)*PCONC(:,3)+0.84700*TPK%K093(:)*PCONC(:,36)*PCONC(:,3)+0.95115*TPK%K& +&094(:)*PCONC(:,39)*PCONC(:,3)+0.12334*TPK%K095(:)*PCONC(:,40)*PCONC(:,3)+0.184& +&01*TPK%K096(:)*PCONC(:,41)*PCONC(:,3)+0.66*TPK%K104(:)*PCONC(:,33)*PCONC(:,33)& +&+0.98383*TPK%K105(:)*PCONC(:,34)*PCONC(:,33)+TPK%K106(:)*PCONC(:,35)*PCONC(:,3& +&3)+1.00000*TPK%K107(:)*PCONC(:,36)*PCONC(:,33)+1.02767*TPK%K108(:)*PCONC(:,39)& +&*PCONC(:,33)+0.82998*TPK%K109(:)*PCONC(:,40)*PCONC(:,33)+0.67560*TPK%K110(:)*P& +&CONC(:,41)*PCONC(:,33)+0.48079*TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.50078*TPK& +&%K112(:)*PCONC(:,35)*PCONC(:,40)+0.50600*TPK%K113(:)*PCONC(:,36)*PCONC(:,40)+T& +&PK%K114(:)*PCONC(:,39)*PCONC(:,40)+0.07566*TPK%K115(:)*PCONC(:,40)*PCONC(:,40)& +&+0.17599*TPK%K116(:)*PCONC(:,41)*PCONC(:,40)+TPK%K117(:)*PCONC(:,41)*PCONC(:,4& +&1)+0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,41)+TPK%K119(:)*PCONC(:,33)*PCONC(:& +&,5)+0.81290*TPK%K120(:)*PCONC(:,34)*PCONC(:,5)+TPK%K121(:)*PCONC(:,35)*PCONC(:& +&,5)+TPK%K122(:)*PCONC(:,36)*PCONC(:,5)+TPK%K123(:)*PCONC(:,39)*PCONC(:,5)+0.04& +&915*TPK%K124(:)*PCONC(:,40)*PCONC(:,5)+0.25928*TPK%K125(:)*PCONC(:,41)*PCONC(:& +&,5)+TPK%K127(:)*PCONC(:,42)*PCONC(:,33)+TPK%KTC32(:)*PCONC(:,54)+TPK%KTR32(:)*& +&PCONC(:,79) !PLOSS(HO2) = +K024*<O3>+K025*<OH>+K027*<HO2>+K027*<HO2>+K028*<HO2>*<H2O>+K028* !<HO2>*<H2O>+K035*<NO>+K036*<NO2>+K038*<NO3>+K084*<PHO>+K097*<MO2>+K098*<ALKAP> !+K099*<ALKEP>+K0100*<BIOP>+K0101*<AROP>+K0102*<CARBOP>+K103*<OLN>+K126*<XO2>+K !TC12+KTR12 - PLOSS(:,15) = +TPK%K024(:)*PCONC(:,1)+TPK%K025(:)*PCONC(:,14)+TPK%K027(:)*PCON& -&C(:,15)+TPK%K027(:)*PCONC(:,15)+TPK%K028(:)*PCONC(:,15)*TPK%H2O(:)+TPK%K028(:)& -&*PCONC(:,15)*TPK%H2O(:)+TPK%K035(:)*PCONC(:,3)+TPK%K036(:)*PCONC(:,4)+TPK%K038& -&(:)*PCONC(:,5)+TPK%K084(:)*PCONC(:,36)+TPK%K097(:)*PCONC(:,32)+TPK%K098(:)*PCO& -&NC(:,33)+TPK%K099(:)*PCONC(:,34)+TPK%K0100(:)*PCONC(:,35)+TPK%K0101(:)*PCONC(:& -&,38)+TPK%K0102(:)*PCONC(:,39)+TPK%K103(:)*PCONC(:,40)+TPK%K126(:)*PCONC(:,41)+& + PLOSS(:,16) = +TPK%K024(:)*PCONC(:,1)+TPK%K025(:)*PCONC(:,15)+TPK%K027(:)*PCON& +&C(:,16)+TPK%K027(:)*PCONC(:,16)+TPK%K028(:)*PCONC(:,16)*TPK%H2O(:)+TPK%K028(:)& +&*PCONC(:,16)*TPK%H2O(:)+TPK%K035(:)*PCONC(:,3)+TPK%K036(:)*PCONC(:,4)+TPK%K038& +&(:)*PCONC(:,5)+TPK%K084(:)*PCONC(:,37)+TPK%K097(:)*PCONC(:,33)+TPK%K098(:)*PCO& +&NC(:,34)+TPK%K099(:)*PCONC(:,35)+TPK%K0100(:)*PCONC(:,36)+TPK%K0101(:)*PCONC(:& +&,39)+TPK%K0102(:)*PCONC(:,40)+TPK%K103(:)*PCONC(:,41)+TPK%K126(:)*PCONC(:,42)+& &TPK%KTC12(:)+TPK%KTR12(:) ! !PPROD(CH4) = +0.04300*K079*<ALKE>*<O3> - PPROD(:,16) = +0.04300*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PPROD(:,17) = +0.04300*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) !PLOSS(CH4) = +K056*<OH> - PLOSS(:,16) = +TPK%K056(:)*PCONC(:,14) + PLOSS(:,17) = +TPK%K056(:)*PCONC(:,15) ! !PPROD(ETH) = +0.03196*K079*<ALKE>*<O3> - PPROD(:,17) = +0.03196*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PPROD(:,18) = +0.03196*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) !PLOSS(ETH) = +K057*<OH> - PLOSS(:,17) = +TPK%K057(:)*PCONC(:,14) + PLOSS(:,18) = +TPK%K057(:)*PCONC(:,15) ! !PPROD(ALKA) = 0.0 - PPROD(:,18) = 0.0 + PPROD(:,19) = 0.0 !PLOSS(ALKA) = +K058*<OH> - PLOSS(:,18) = +TPK%K058(:)*PCONC(:,14) + PLOSS(:,19) = +TPK%K058(:)*PCONC(:,15) ! !PPROD(ALKE) = +0.91868*K054*<BIO>*<O3P>+0.00000*K079*<ALKE>*<O3>+0.37388*K080* !<BIO>*<O3>+0.37815*K093*<BIOP>*<NO>+0.48074*K107*<BIOP>*<MO2>+0.24463*K113*<BI !OP>*<CARBOP>+0.42729*K122*<BIOP>*<NO3> - PPROD(:,19) = +0.91868*TPK%K054(:)*PCONC(:,20)*TPK%O3P(:)+0.00000*TPK%K079(:)*& -&PCONC(:,19)*PCONC(:,1)+0.37388*TPK%K080(:)*PCONC(:,20)*PCONC(:,1)+0.37815*TPK%& -&K093(:)*PCONC(:,35)*PCONC(:,3)+0.48074*TPK%K107(:)*PCONC(:,35)*PCONC(:,32)+0.2& -&4463*TPK%K113(:)*PCONC(:,35)*PCONC(:,39)+0.42729*TPK%K122(:)*PCONC(:,35)*PCONC& + PPROD(:,20) = +0.91868*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:)+0.00000*TPK%K079(:)*& +&PCONC(:,20)*PCONC(:,1)+0.37388*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.37815*TPK%& +&K093(:)*PCONC(:,36)*PCONC(:,3)+0.48074*TPK%K107(:)*PCONC(:,36)*PCONC(:,33)+0.2& +&4463*TPK%K113(:)*PCONC(:,36)*PCONC(:,40)+0.42729*TPK%K122(:)*PCONC(:,36)*PCONC& &(:,5) !PLOSS(ALKE) = +K059*<OH>+K076*<NO3>+K079*<O3> - PLOSS(:,19) = +TPK%K059(:)*PCONC(:,14)+TPK%K076(:)*PCONC(:,5)+TPK%K079(:)*PCON& + PLOSS(:,20) = +TPK%K059(:)*PCONC(:,15)+TPK%K076(:)*PCONC(:,5)+TPK%K079(:)*PCON& &C(:,1) ! -!PPROD(BIO) = 0.0 - PPROD(:,20) = 0.0 -!PLOSS(BIO) = +K054*<O3P>+K060*<OH>+K077*<NO3>+K080*<O3> - PLOSS(:,20) = +TPK%K054(:)*TPK%O3P(:)+TPK%K060(:)*PCONC(:,14)+TPK%K077(:)*PCON& -&C(:,5)+TPK%K080(:)*PCONC(:,1) -! RETURN END SUBROUTINE SUB1 ! @@ -4317,13 +4353,19 @@ SUBROUTINE SUB2 !Indices 21 a 30 ! ! +!PPROD(BIO) = 0.0 + PPROD(:,21) = 0.0 +!PLOSS(BIO) = +K054*<O3P>+K060*<OH>+K077*<NO3>+K080*<O3> + PLOSS(:,21) = +TPK%K054(:)*TPK%O3P(:)+TPK%K060(:)*PCONC(:,15)+TPK%K077(:)*PCON& +&C(:,5)+TPK%K080(:)*PCONC(:,1) +! !PPROD(ARO) = +0.10670*K083*<PHO>*<NO2>+1.06698*K084*<PHO>*<HO2>+K085*<ADD>*<NO !2>+0.02*K086*<ADD>*<O2>+K087*<ADD>*<O3> - PPROD(:,21) = +0.10670*TPK%K083(:)*PCONC(:,36)*PCONC(:,4)+1.06698*TPK%K084(:)*& -&PCONC(:,36)*PCONC(:,15)+TPK%K085(:)*PCONC(:,37)*PCONC(:,4)+0.02*TPK%K086(:)*PC& -&ONC(:,37)*TPK%O2(:)+TPK%K087(:)*PCONC(:,37)*PCONC(:,1) + PPROD(:,22) = +0.10670*TPK%K083(:)*PCONC(:,37)*PCONC(:,4)+1.06698*TPK%K084(:)*& +&PCONC(:,37)*PCONC(:,16)+TPK%K085(:)*PCONC(:,38)*PCONC(:,4)+0.02*TPK%K086(:)*PC& +&ONC(:,38)*TPK%O2(:)+TPK%K087(:)*PCONC(:,38)*PCONC(:,1) !PLOSS(ARO) = +K061*<OH>+K075*<NO3> - PLOSS(:,21) = +TPK%K061(:)*PCONC(:,14)+TPK%K075(:)*PCONC(:,5) + PLOSS(:,22) = +TPK%K061(:)*PCONC(:,15)+TPK%K075(:)*PCONC(:,5) ! !PPROD(HCHO) = +K013*<OP1>+0.06517*K016*<CARBO>+0.05*K054*<BIO>*<O3P>+0.00140*K !058*<ALKA>*<OH>+0.00000*K065*<CARBO>*<OH>+0.35*K068*<OP1>*<OH>+0.02915*K069*<O @@ -4338,30 +4380,30 @@ SUBROUTINE SUB2 !K118*<OLN>*<OLN>+K119*<MO2>*<NO3>+0.03142*K120*<ALKAP>*<NO3>+1.40909*K121*<ALK !EP>*<NO3>+0.68600*K122*<BIOP>*<NO3>+0.03175*K124*<CARBOP>*<NO3>+0.20740*K125*< !OLN>*<NO3>+K127*<XO2>*<MO2>+KTC36*<WC_HCHO>+KTR36*<WR_HCHO> - PPROD(:,22) = +TPK%K013(:)*PCONC(:,28)+0.06517*TPK%K016(:)*PCONC(:,25)+0.05*TP& -&K%K054(:)*PCONC(:,20)*TPK%O3P(:)+0.00140*TPK%K058(:)*PCONC(:,18)*PCONC(:,14)+0& -&.00000*TPK%K065(:)*PCONC(:,25)*PCONC(:,14)+0.35*TPK%K068(:)*PCONC(:,28)*PCONC(& -&:,14)+0.02915*TPK%K069(:)*PCONC(:,29)*PCONC(:,14)+0.57839*TPK%K070(:)*PCONC(:,& -&27)*PCONC(:,14)+0.40*TPK%K078(:)*PCONC(:,27)*PCONC(:,5)+0.48290*TPK%K079(:)*PC& -&ONC(:,19)*PCONC(:,1)+0.90000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1)+0.00000*TPK%K0& -&81(:)*PCONC(:,25)*PCONC(:,1)+0.70*TPK%K082(:)*PCONC(:,27)*PCONC(:,1)+TPK%K090(& -&:)*PCONC(:,32)*PCONC(:,3)+0.03002*TPK%K091(:)*PCONC(:,33)*PCONC(:,3)+1.39870*T& -&PK%K092(:)*PCONC(:,34)*PCONC(:,3)+0.60600*TPK%K093(:)*PCONC(:,35)*PCONC(:,3)+0& -&.05848*TPK%K095(:)*PCONC(:,39)*PCONC(:,3)+0.23419*TPK%K096(:)*PCONC(:,40)*PCON& -&C(:,3)+1.33*TPK%K104(:)*PCONC(:,32)*PCONC(:,32)+0.80556*TPK%K105(:)*PCONC(:,33& -&)*PCONC(:,32)+1.42894*TPK%K106(:)*PCONC(:,34)*PCONC(:,32)+1.09000*TPK%K107(:)*& -&PCONC(:,35)*PCONC(:,32)+TPK%K108(:)*PCONC(:,38)*PCONC(:,32)+0.95723*TPK%K109(:& -&)*PCONC(:,39)*PCONC(:,32)+0.88625*TPK%K110(:)*PCONC(:,40)*PCONC(:,32)+0.07600*& -&TPK%K111(:)*PCONC(:,33)*PCONC(:,39)+0.68192*TPK%K112(:)*PCONC(:,34)*PCONC(:,39& -&)+0.34000*TPK%K113(:)*PCONC(:,35)*PCONC(:,39)+0.03432*TPK%K115(:)*PCONC(:,39)*& -&PCONC(:,39)+0.13414*TPK%K116(:)*PCONC(:,40)*PCONC(:,39)+0.00000*TPK%K118(:)*PC& -&ONC(:,40)*PCONC(:,40)+TPK%K119(:)*PCONC(:,32)*PCONC(:,5)+0.03142*TPK%K120(:)*P& -&CONC(:,33)*PCONC(:,5)+1.40909*TPK%K121(:)*PCONC(:,34)*PCONC(:,5)+0.68600*TPK%K& -&122(:)*PCONC(:,35)*PCONC(:,5)+0.03175*TPK%K124(:)*PCONC(:,39)*PCONC(:,5)+0.207& -&40*TPK%K125(:)*PCONC(:,40)*PCONC(:,5)+TPK%K127(:)*PCONC(:,41)*PCONC(:,32)+TPK%& -&KTC36(:)*PCONC(:,57)+TPK%KTR36(:)*PCONC(:,82) + PPROD(:,23) = +TPK%K013(:)*PCONC(:,29)+0.06517*TPK%K016(:)*PCONC(:,26)+0.05*TP& +&K%K054(:)*PCONC(:,21)*TPK%O3P(:)+0.00140*TPK%K058(:)*PCONC(:,19)*PCONC(:,15)+0& +&.00000*TPK%K065(:)*PCONC(:,26)*PCONC(:,15)+0.35*TPK%K068(:)*PCONC(:,29)*PCONC(& +&:,15)+0.02915*TPK%K069(:)*PCONC(:,30)*PCONC(:,15)+0.57839*TPK%K070(:)*PCONC(:,& +&28)*PCONC(:,15)+0.40*TPK%K078(:)*PCONC(:,28)*PCONC(:,5)+0.48290*TPK%K079(:)*PC& +&ONC(:,20)*PCONC(:,1)+0.90000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.00000*TPK%K0& +&81(:)*PCONC(:,26)*PCONC(:,1)+0.70*TPK%K082(:)*PCONC(:,28)*PCONC(:,1)+TPK%K090(& +&:)*PCONC(:,33)*PCONC(:,3)+0.03002*TPK%K091(:)*PCONC(:,34)*PCONC(:,3)+1.39870*T& +&PK%K092(:)*PCONC(:,35)*PCONC(:,3)+0.60600*TPK%K093(:)*PCONC(:,36)*PCONC(:,3)+0& +&.05848*TPK%K095(:)*PCONC(:,40)*PCONC(:,3)+0.23419*TPK%K096(:)*PCONC(:,41)*PCON& +&C(:,3)+1.33*TPK%K104(:)*PCONC(:,33)*PCONC(:,33)+0.80556*TPK%K105(:)*PCONC(:,34& +&)*PCONC(:,33)+1.42894*TPK%K106(:)*PCONC(:,35)*PCONC(:,33)+1.09000*TPK%K107(:)*& +&PCONC(:,36)*PCONC(:,33)+TPK%K108(:)*PCONC(:,39)*PCONC(:,33)+0.95723*TPK%K109(:& +&)*PCONC(:,40)*PCONC(:,33)+0.88625*TPK%K110(:)*PCONC(:,41)*PCONC(:,33)+0.07600*& +&TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.68192*TPK%K112(:)*PCONC(:,35)*PCONC(:,40& +&)+0.34000*TPK%K113(:)*PCONC(:,36)*PCONC(:,40)+0.03432*TPK%K115(:)*PCONC(:,40)*& +&PCONC(:,40)+0.13414*TPK%K116(:)*PCONC(:,41)*PCONC(:,40)+0.00000*TPK%K118(:)*PC& +&ONC(:,41)*PCONC(:,41)+TPK%K119(:)*PCONC(:,33)*PCONC(:,5)+0.03142*TPK%K120(:)*P& +&CONC(:,34)*PCONC(:,5)+1.40909*TPK%K121(:)*PCONC(:,35)*PCONC(:,5)+0.68600*TPK%K& +&122(:)*PCONC(:,36)*PCONC(:,5)+0.03175*TPK%K124(:)*PCONC(:,40)*PCONC(:,5)+0.207& +&40*TPK%K125(:)*PCONC(:,41)*PCONC(:,5)+TPK%K127(:)*PCONC(:,42)*PCONC(:,33)+TPK%& +&KTC36(:)*PCONC(:,58)+TPK%KTR36(:)*PCONC(:,83) !PLOSS(HCHO) = +K010+K011+K062*<OH>+K072*<NO3>+KTC16+KTR16 - PLOSS(:,22) = +TPK%K010(:)+TPK%K011(:)+TPK%K062(:)*PCONC(:,14)+TPK%K072(:)*PCO& + PLOSS(:,23) = +TPK%K010(:)+TPK%K011(:)+TPK%K062(:)*PCONC(:,15)+TPK%K072(:)*PCO& &NC(:,5)+TPK%KTC16(:)+TPK%KTR16(:) ! !PPROD(ALD) = +0.96205*K014*<OP2>+0.20*K017*<ONIT>+K055*<CARBO>*<O3P>+0.08173*K @@ -4375,26 +4417,26 @@ SUBROUTINE SUB2 !P>+0.42122*K116*<OLN>*<CARBOP>+0.00000*K118*<OLN>*<OLN>+0.33743*K120*<ALKAP>*< !NO3>+0.43039*K121*<ALKEP>*<NO3>+0.00000*K122*<BIOP>*<NO3>+0.02936*K124*<CARBOP !>*<NO3>+0.91850*K125*<OLN>*<NO3> - PPROD(:,23) = +0.96205*TPK%K014(:)*PCONC(:,29)+0.20*TPK%K017(:)*PCONC(:,26)+TP& -&K%K055(:)*PCONC(:,25)*TPK%O3P(:)+0.08173*TPK%K058(:)*PCONC(:,18)*PCONC(:,14)+0& -&.06253*TPK%K065(:)*PCONC(:,25)*PCONC(:,14)+0.07335*TPK%K069(:)*PCONC(:,29)*PCO& -&NC(:,14)+0.05265*TPK%K074(:)*PCONC(:,25)*PCONC(:,5)+0.51468*TPK%K079(:)*PCONC(& -&:,19)*PCONC(:,1)+0.00000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1)+0.15692*TPK%K081(:& -&)*PCONC(:,25)*PCONC(:,1)+0.33144*TPK%K091(:)*PCONC(:,33)*PCONC(:,3)+0.42125*TP& -&K%K092(:)*PCONC(:,34)*PCONC(:,3)+0.00000*TPK%K093(:)*PCONC(:,35)*PCONC(:,3)+0.& -&07368*TPK%K095(:)*PCONC(:,39)*PCONC(:,3)+1.01182*TPK%K096(:)*PCONC(:,40)*PCONC& -&(:,3)+0.56070*TPK%K105(:)*PCONC(:,33)*PCONC(:,32)+0.46413*TPK%K106(:)*PCONC(:,& -&34)*PCONC(:,32)+0.00000*TPK%K107(:)*PCONC(:,35)*PCONC(:,32)+0.08295*TPK%K109(:& -&)*PCONC(:,39)*PCONC(:,32)+0.41524*TPK%K110(:)*PCONC(:,40)*PCONC(:,32)+0.71461*& -&TPK%K111(:)*PCONC(:,33)*PCONC(:,39)+0.68374*TPK%K112(:)*PCONC(:,34)*PCONC(:,39& -&)+0.00000*TPK%K113(:)*PCONC(:,35)*PCONC(:,39)+0.06969*TPK%K115(:)*PCONC(:,39)*& -&PCONC(:,39)+0.42122*TPK%K116(:)*PCONC(:,40)*PCONC(:,39)+0.00000*TPK%K118(:)*PC& -&ONC(:,40)*PCONC(:,40)+0.33743*TPK%K120(:)*PCONC(:,33)*PCONC(:,5)+0.43039*TPK%K& -&121(:)*PCONC(:,34)*PCONC(:,5)+0.00000*TPK%K122(:)*PCONC(:,35)*PCONC(:,5)+0.029& -&36*TPK%K124(:)*PCONC(:,39)*PCONC(:,5)+0.91850*TPK%K125(:)*PCONC(:,40)*PCONC(:,& + PPROD(:,24) = +0.96205*TPK%K014(:)*PCONC(:,30)+0.20*TPK%K017(:)*PCONC(:,27)+TP& +&K%K055(:)*PCONC(:,26)*TPK%O3P(:)+0.08173*TPK%K058(:)*PCONC(:,19)*PCONC(:,15)+0& +&.06253*TPK%K065(:)*PCONC(:,26)*PCONC(:,15)+0.07335*TPK%K069(:)*PCONC(:,30)*PCO& +&NC(:,15)+0.05265*TPK%K074(:)*PCONC(:,26)*PCONC(:,5)+0.51468*TPK%K079(:)*PCONC(& +&:,20)*PCONC(:,1)+0.00000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.15692*TPK%K081(:& +&)*PCONC(:,26)*PCONC(:,1)+0.33144*TPK%K091(:)*PCONC(:,34)*PCONC(:,3)+0.42125*TP& +&K%K092(:)*PCONC(:,35)*PCONC(:,3)+0.00000*TPK%K093(:)*PCONC(:,36)*PCONC(:,3)+0.& +&07368*TPK%K095(:)*PCONC(:,40)*PCONC(:,3)+1.01182*TPK%K096(:)*PCONC(:,41)*PCONC& +&(:,3)+0.56070*TPK%K105(:)*PCONC(:,34)*PCONC(:,33)+0.46413*TPK%K106(:)*PCONC(:,& +&35)*PCONC(:,33)+0.00000*TPK%K107(:)*PCONC(:,36)*PCONC(:,33)+0.08295*TPK%K109(:& +&)*PCONC(:,40)*PCONC(:,33)+0.41524*TPK%K110(:)*PCONC(:,41)*PCONC(:,33)+0.71461*& +&TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.68374*TPK%K112(:)*PCONC(:,35)*PCONC(:,40& +&)+0.00000*TPK%K113(:)*PCONC(:,36)*PCONC(:,40)+0.06969*TPK%K115(:)*PCONC(:,40)*& +&PCONC(:,40)+0.42122*TPK%K116(:)*PCONC(:,41)*PCONC(:,40)+0.00000*TPK%K118(:)*PC& +&ONC(:,41)*PCONC(:,41)+0.33743*TPK%K120(:)*PCONC(:,34)*PCONC(:,5)+0.43039*TPK%K& +&121(:)*PCONC(:,35)*PCONC(:,5)+0.00000*TPK%K122(:)*PCONC(:,36)*PCONC(:,5)+0.029& +&36*TPK%K124(:)*PCONC(:,40)*PCONC(:,5)+0.91850*TPK%K125(:)*PCONC(:,41)*PCONC(:,& &5) !PLOSS(ALD) = +K012+K063*<OH>+K073*<NO3> - PLOSS(:,23) = +TPK%K012(:)+TPK%K063(:)*PCONC(:,14)+TPK%K073(:)*PCONC(:,5) + PLOSS(:,24) = +TPK%K012(:)+TPK%K063(:)*PCONC(:,15)+TPK%K073(:)*PCONC(:,5) ! !PPROD(KET) = +0.80*K017*<ONIT>+0.03498*K058*<ALKA>*<OH>+0.00853*K065*<CARBO>*< !OH>+0.37591*K069*<OP2>*<OH>+0.00632*K074*<CARBO>*<NO3>+0.07377*K079*<ALKE>*<O3 @@ -4405,22 +4447,22 @@ SUBROUTINE SUB2 !<CARBOP>+0.02190*K115*<CARBOP>*<CARBOP>+0.10822*K116*<OLN>*<CARBOP>+0.00000*K1 !18*<OLN>*<OLN>+0.62978*K120*<ALKAP>*<NO3>+0.02051*K121*<ALKEP>*<NO3>+0.00000*K !122*<BIOP>*<NO3>+0.34740*K125*<OLN>*<NO3> - PPROD(:,24) = +0.80*TPK%K017(:)*PCONC(:,26)+0.03498*TPK%K058(:)*PCONC(:,18)*PC& -&ONC(:,14)+0.00853*TPK%K065(:)*PCONC(:,25)*PCONC(:,14)+0.37591*TPK%K069(:)*PCON& -&C(:,29)*PCONC(:,14)+0.00632*TPK%K074(:)*PCONC(:,25)*PCONC(:,5)+0.07377*TPK%K07& -&9(:)*PCONC(:,19)*PCONC(:,1)+0.00000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1)+0.54531& -&*TPK%K091(:)*PCONC(:,33)*PCONC(:,3)+0.05220*TPK%K092(:)*PCONC(:,34)*PCONC(:,3)& -&+0.00000*TPK%K093(:)*PCONC(:,35)*PCONC(:,3)+0.37862*TPK%K096(:)*PCONC(:,40)*PC& -&ONC(:,3)+0.09673*TPK%K105(:)*PCONC(:,33)*PCONC(:,32)+0.03814*TPK%K106(:)*PCONC& -&(:,34)*PCONC(:,32)+0.00000*TPK%K107(:)*PCONC(:,35)*PCONC(:,32)+0.09667*TPK%K11& -&0(:)*PCONC(:,40)*PCONC(:,32)+0.18819*TPK%K111(:)*PCONC(:,33)*PCONC(:,39)+0.065& -&79*TPK%K112(:)*PCONC(:,34)*PCONC(:,39)+0.00000*TPK%K113(:)*PCONC(:,35)*PCONC(:& -&,39)+0.02190*TPK%K115(:)*PCONC(:,39)*PCONC(:,39)+0.10822*TPK%K116(:)*PCONC(:,4& -&0)*PCONC(:,39)+0.00000*TPK%K118(:)*PCONC(:,40)*PCONC(:,40)+0.62978*TPK%K120(:)& -&*PCONC(:,33)*PCONC(:,5)+0.02051*TPK%K121(:)*PCONC(:,34)*PCONC(:,5)+0.00000*TPK& -&%K122(:)*PCONC(:,35)*PCONC(:,5)+0.34740*TPK%K125(:)*PCONC(:,40)*PCONC(:,5) + PPROD(:,25) = +0.80*TPK%K017(:)*PCONC(:,27)+0.03498*TPK%K058(:)*PCONC(:,19)*PC& +&ONC(:,15)+0.00853*TPK%K065(:)*PCONC(:,26)*PCONC(:,15)+0.37591*TPK%K069(:)*PCON& +&C(:,30)*PCONC(:,15)+0.00632*TPK%K074(:)*PCONC(:,26)*PCONC(:,5)+0.07377*TPK%K07& +&9(:)*PCONC(:,20)*PCONC(:,1)+0.00000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.54531& +&*TPK%K091(:)*PCONC(:,34)*PCONC(:,3)+0.05220*TPK%K092(:)*PCONC(:,35)*PCONC(:,3)& +&+0.00000*TPK%K093(:)*PCONC(:,36)*PCONC(:,3)+0.37862*TPK%K096(:)*PCONC(:,41)*PC& +&ONC(:,3)+0.09673*TPK%K105(:)*PCONC(:,34)*PCONC(:,33)+0.03814*TPK%K106(:)*PCONC& +&(:,35)*PCONC(:,33)+0.00000*TPK%K107(:)*PCONC(:,36)*PCONC(:,33)+0.09667*TPK%K11& +&0(:)*PCONC(:,41)*PCONC(:,33)+0.18819*TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.065& +&79*TPK%K112(:)*PCONC(:,35)*PCONC(:,40)+0.00000*TPK%K113(:)*PCONC(:,36)*PCONC(:& +&,40)+0.02190*TPK%K115(:)*PCONC(:,40)*PCONC(:,40)+0.10822*TPK%K116(:)*PCONC(:,4& +&1)*PCONC(:,40)+0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,41)+0.62978*TPK%K120(:)& +&*PCONC(:,34)*PCONC(:,5)+0.02051*TPK%K121(:)*PCONC(:,35)*PCONC(:,5)+0.00000*TPK& +&%K122(:)*PCONC(:,36)*PCONC(:,5)+0.34740*TPK%K125(:)*PCONC(:,41)*PCONC(:,5) !PLOSS(KET) = +K015+K064*<OH> - PLOSS(:,24) = +TPK%K015(:)+TPK%K064(:)*PCONC(:,14) + PLOSS(:,25) = +TPK%K015(:)+TPK%K064(:)*PCONC(:,15) ! !PPROD(CARBO) = +0.13255*K054*<BIO>*<O3P>+0.00835*K058*<ALKA>*<OH>+0.16919*K065 !*<CARBO>*<OH>+0.21863*K070*<PAN>*<OH>+0.10530*K074*<CARBO>*<NO3>+0.00000*K076* @@ -4432,74 +4474,64 @@ SUBROUTINE SUB2 !K114*<AROP>*<CARBOP>+0.10777*K115*<CARBOP>*<CARBOP>+0.03531*K120*<ALKAP>*<NO3> !+0.61160*K122*<BIOP>*<NO3>+2.81904*K123*<AROP>*<NO3>+0.03455*K124*<CARBOP>*<NO !3> - PPROD(:,25) = +0.13255*TPK%K054(:)*PCONC(:,20)*TPK%O3P(:)+0.00835*TPK%K058(:)*& -&PCONC(:,18)*PCONC(:,14)+0.16919*TPK%K065(:)*PCONC(:,25)*PCONC(:,14)+0.21863*TP& -&K%K070(:)*PCONC(:,27)*PCONC(:,14)+0.10530*TPK%K074(:)*PCONC(:,25)*PCONC(:,5)+0& -&.00000*TPK%K076(:)*PCONC(:,19)*PCONC(:,5)+0.91741*TPK%K077(:)*PCONC(:,20)*PCON& -&C(:,5)+0.00000*TPK%K079(:)*PCONC(:,19)*PCONC(:,1)+0.39754*TPK%K080(:)*PCONC(:,& -&20)*PCONC(:,1)+1.07583*TPK%K081(:)*PCONC(:,25)*PCONC(:,1)+0.03407*TPK%K091(:)*& -&PCONC(:,33)*PCONC(:,3)+0.45463*TPK%K093(:)*PCONC(:,35)*PCONC(:,3)+2.06993*TPK%& -&K094(:)*PCONC(:,38)*PCONC(:,3)+0.08670*TPK%K095(:)*PCONC(:,39)*PCONC(:,3)+0.07& -&976*TPK%K105(:)*PCONC(:,33)*PCONC(:,32)+0.56064*TPK%K107(:)*PCONC(:,35)*PCONC(& -&:,32)+1.99461*TPK%K108(:)*PCONC(:,38)*PCONC(:,32)+0.15387*TPK%K109(:)*PCONC(:,& -&39)*PCONC(:,32)+0.06954*TPK%K111(:)*PCONC(:,33)*PCONC(:,39)+0.78591*TPK%K113(:& -&)*PCONC(:,35)*PCONC(:,39)+1.99455*TPK%K114(:)*PCONC(:,38)*PCONC(:,39)+0.10777*& -&TPK%K115(:)*PCONC(:,39)*PCONC(:,39)+0.03531*TPK%K120(:)*PCONC(:,33)*PCONC(:,5)& -&+0.61160*TPK%K122(:)*PCONC(:,35)*PCONC(:,5)+2.81904*TPK%K123(:)*PCONC(:,38)*PC& -&ONC(:,5)+0.03455*TPK%K124(:)*PCONC(:,39)*PCONC(:,5) + PPROD(:,26) = +0.13255*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:)+0.00835*TPK%K058(:)*& +&PCONC(:,19)*PCONC(:,15)+0.16919*TPK%K065(:)*PCONC(:,26)*PCONC(:,15)+0.21863*TP& +&K%K070(:)*PCONC(:,28)*PCONC(:,15)+0.10530*TPK%K074(:)*PCONC(:,26)*PCONC(:,5)+0& +&.00000*TPK%K076(:)*PCONC(:,20)*PCONC(:,5)+0.91741*TPK%K077(:)*PCONC(:,21)*PCON& +&C(:,5)+0.00000*TPK%K079(:)*PCONC(:,20)*PCONC(:,1)+0.39754*TPK%K080(:)*PCONC(:,& +&21)*PCONC(:,1)+1.07583*TPK%K081(:)*PCONC(:,26)*PCONC(:,1)+0.03407*TPK%K091(:)*& +&PCONC(:,34)*PCONC(:,3)+0.45463*TPK%K093(:)*PCONC(:,36)*PCONC(:,3)+2.06993*TPK%& +&K094(:)*PCONC(:,39)*PCONC(:,3)+0.08670*TPK%K095(:)*PCONC(:,40)*PCONC(:,3)+0.07& +&976*TPK%K105(:)*PCONC(:,34)*PCONC(:,33)+0.56064*TPK%K107(:)*PCONC(:,36)*PCONC(& +&:,33)+1.99461*TPK%K108(:)*PCONC(:,39)*PCONC(:,33)+0.15387*TPK%K109(:)*PCONC(:,& +&40)*PCONC(:,33)+0.06954*TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.78591*TPK%K113(:& +&)*PCONC(:,36)*PCONC(:,40)+1.99455*TPK%K114(:)*PCONC(:,39)*PCONC(:,40)+0.10777*& +&TPK%K115(:)*PCONC(:,40)*PCONC(:,40)+0.03531*TPK%K120(:)*PCONC(:,34)*PCONC(:,5)& +&+0.61160*TPK%K122(:)*PCONC(:,36)*PCONC(:,5)+2.81904*TPK%K123(:)*PCONC(:,39)*PC& +&ONC(:,5)+0.03455*TPK%K124(:)*PCONC(:,40)*PCONC(:,5) !PLOSS(CARBO) = +K016+K055*<O3P>+K065*<OH>+K074*<NO3>+K081*<O3> - PLOSS(:,25) = +TPK%K016(:)+TPK%K055(:)*TPK%O3P(:)+TPK%K065(:)*PCONC(:,14)+TPK%& + PLOSS(:,26) = +TPK%K016(:)+TPK%K055(:)*TPK%O3P(:)+TPK%K065(:)*PCONC(:,15)+TPK%& &K074(:)*PCONC(:,5)+TPK%K081(:)*PCONC(:,1) ! !PPROD(ONIT) = +0.60*K078*<PAN>*<NO3>+K083*<PHO>*<NO2>+0.08459*K091*<ALKAP>*<NO !>+0.15300*K093*<BIOP>*<NO>+0.04885*K094*<AROP>*<NO>+0.18401*K096*<OLN>*<NO>+K1 !03*<OLN>*<HO2>+0.67560*K110*<OLN>*<MO2>+0.66562*K116*<OLN>*<CARBOP>+2.00*K117* !<OLN>*<OLN>+0.00000*K118*<OLN>*<OLN>+0.25928*K125*<OLN>*<NO3> - PPROD(:,26) = +0.60*TPK%K078(:)*PCONC(:,27)*PCONC(:,5)+TPK%K083(:)*PCONC(:,36)& -&*PCONC(:,4)+0.08459*TPK%K091(:)*PCONC(:,33)*PCONC(:,3)+0.15300*TPK%K093(:)*PCO& -&NC(:,35)*PCONC(:,3)+0.04885*TPK%K094(:)*PCONC(:,38)*PCONC(:,3)+0.18401*TPK%K09& -&6(:)*PCONC(:,40)*PCONC(:,3)+TPK%K103(:)*PCONC(:,40)*PCONC(:,15)+0.67560*TPK%K1& -&10(:)*PCONC(:,40)*PCONC(:,32)+0.66562*TPK%K116(:)*PCONC(:,40)*PCONC(:,39)+2.00& -&*TPK%K117(:)*PCONC(:,40)*PCONC(:,40)+0.00000*TPK%K118(:)*PCONC(:,40)*PCONC(:,4& -&0)+0.25928*TPK%K125(:)*PCONC(:,40)*PCONC(:,5) + PPROD(:,27) = +0.60*TPK%K078(:)*PCONC(:,28)*PCONC(:,5)+TPK%K083(:)*PCONC(:,37)& +&*PCONC(:,4)+0.08459*TPK%K091(:)*PCONC(:,34)*PCONC(:,3)+0.15300*TPK%K093(:)*PCO& +&NC(:,36)*PCONC(:,3)+0.04885*TPK%K094(:)*PCONC(:,39)*PCONC(:,3)+0.18401*TPK%K09& +&6(:)*PCONC(:,41)*PCONC(:,3)+TPK%K103(:)*PCONC(:,41)*PCONC(:,16)+0.67560*TPK%K1& +&10(:)*PCONC(:,41)*PCONC(:,33)+0.66562*TPK%K116(:)*PCONC(:,41)*PCONC(:,40)+2.00& +&*TPK%K117(:)*PCONC(:,41)*PCONC(:,41)+0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,4& +&1)+0.25928*TPK%K125(:)*PCONC(:,41)*PCONC(:,5) !PLOSS(ONIT) = +K017+K071*<OH> - PLOSS(:,26) = +TPK%K017(:)+TPK%K071(:)*PCONC(:,14) + PLOSS(:,27) = +TPK%K017(:)+TPK%K071(:)*PCONC(:,15) ! !PPROD(PAN) = +0.28107*K070*<PAN>*<OH>+0.40000*K078*<PAN>*<NO3>+0.30000*K082*<P !AN>*<O3>+1.00000*K088*<CARBOP>*<NO2> - PPROD(:,27) = +0.28107*TPK%K070(:)*PCONC(:,27)*PCONC(:,14)+0.40000*TPK%K078(:)& -&*PCONC(:,27)*PCONC(:,5)+0.30000*TPK%K082(:)*PCONC(:,27)*PCONC(:,1)+1.00000*TPK& -&%K088(:)*PCONC(:,39)*PCONC(:,4) + PPROD(:,28) = +0.28107*TPK%K070(:)*PCONC(:,28)*PCONC(:,15)+0.40000*TPK%K078(:)& +&*PCONC(:,28)*PCONC(:,5)+0.30000*TPK%K082(:)*PCONC(:,28)*PCONC(:,1)+1.00000*TPK& +&%K088(:)*PCONC(:,40)*PCONC(:,4) !PLOSS(PAN) = +K070*<OH>+K078*<NO3>+K082*<O3>+K089 - PLOSS(:,27) = +TPK%K070(:)*PCONC(:,14)+TPK%K078(:)*PCONC(:,5)+TPK%K082(:)*PCON& + PLOSS(:,28) = +TPK%K070(:)*PCONC(:,15)+TPK%K078(:)*PCONC(:,5)+TPK%K082(:)*PCON& &C(:,1)+TPK%K089(:) ! !PPROD(OP1) = +K097*<MO2>*<HO2>+KTC40*<WC_OP1>+KTR40*<WR_OP1> - PPROD(:,28) = +TPK%K097(:)*PCONC(:,32)*PCONC(:,15)+TPK%KTC40(:)*PCONC(:,61)+TP& -&K%KTR40(:)*PCONC(:,86) + PPROD(:,29) = +TPK%K097(:)*PCONC(:,33)*PCONC(:,16)+TPK%KTC40(:)*PCONC(:,62)+TP& +&K%KTR40(:)*PCONC(:,87) !PLOSS(OP1) = +K013+K068*<OH>+KTC20+KTR20 - PLOSS(:,28) = +TPK%K013(:)+TPK%K068(:)*PCONC(:,14)+TPK%KTC20(:)+TPK%KTR20(:) + PLOSS(:,29) = +TPK%K013(:)+TPK%K068(:)*PCONC(:,15)+TPK%KTC20(:)+TPK%KTR20(:) ! !PPROD(OP2) = +0.10149*K081*<CARBO>*<O3>+1.00524*K098*<ALKAP>*<HO2>+1.00524*K09 !9*<ALKEP>*<HO2>+1.00524*K0100*<BIOP>*<HO2>+1.00524*K0101*<AROP>*<HO2>+0.80904* !K0102*<CARBOP>*<HO2>+1.00524*K126*<XO2>*<HO2> - PPROD(:,29) = +0.10149*TPK%K081(:)*PCONC(:,25)*PCONC(:,1)+1.00524*TPK%K098(:)*& -&PCONC(:,33)*PCONC(:,15)+1.00524*TPK%K099(:)*PCONC(:,34)*PCONC(:,15)+1.00524*TP& -&K%K0100(:)*PCONC(:,35)*PCONC(:,15)+1.00524*TPK%K0101(:)*PCONC(:,38)*PCONC(:,15& -&)+0.80904*TPK%K0102(:)*PCONC(:,39)*PCONC(:,15)+1.00524*TPK%K126(:)*PCONC(:,41)& -&*PCONC(:,15) + PPROD(:,30) = +0.10149*TPK%K081(:)*PCONC(:,26)*PCONC(:,1)+1.00524*TPK%K098(:)*& +&PCONC(:,34)*PCONC(:,16)+1.00524*TPK%K099(:)*PCONC(:,35)*PCONC(:,16)+1.00524*TP& +&K%K0100(:)*PCONC(:,36)*PCONC(:,16)+1.00524*TPK%K0101(:)*PCONC(:,39)*PCONC(:,16& +&)+0.80904*TPK%K0102(:)*PCONC(:,40)*PCONC(:,16)+1.00524*TPK%K126(:)*PCONC(:,42)& +&*PCONC(:,16) !PLOSS(OP2) = +K014+K069*<OH> - PLOSS(:,29) = +TPK%K014(:)+TPK%K069(:)*PCONC(:,14) -! -!PPROD(ORA1) = +0.00878*K058*<ALKA>*<OH>+0.15343*K079*<ALKE>*<O3>+0.15000*K080* -!<BIO>*<O3>+0.10788*K081*<CARBO>*<O3>+0.11*K082*<PAN>*<O3>+KTC37*<WC_ORA1>+KTR3 -!7*<WR_ORA1> - PPROD(:,30) = +0.00878*TPK%K058(:)*PCONC(:,18)*PCONC(:,14)+0.15343*TPK%K079(:)& -&*PCONC(:,19)*PCONC(:,1)+0.15000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1)+0.10788*TPK& -&%K081(:)*PCONC(:,25)*PCONC(:,1)+0.11*TPK%K082(:)*PCONC(:,27)*PCONC(:,1)+TPK%KT& -&C37(:)*PCONC(:,58)+TPK%KTR37(:)*PCONC(:,83) -!PLOSS(ORA1) = +K066*<OH>+KTC17+KTR17 - PLOSS(:,30) = +TPK%K066(:)*PCONC(:,14)+TPK%KTC17(:)+TPK%KTR17(:) + PLOSS(:,30) = +TPK%K014(:)+TPK%K069(:)*PCONC(:,15) ! RETURN END SUBROUTINE SUB2 @@ -4509,20 +4541,30 @@ SUBROUTINE SUB3 !Indices 31 a 40 ! ! +!PPROD(ORA1) = +0.00878*K058*<ALKA>*<OH>+0.15343*K079*<ALKE>*<O3>+0.15000*K080* +!<BIO>*<O3>+0.10788*K081*<CARBO>*<O3>+0.11*K082*<PAN>*<O3>+KTC37*<WC_ORA1>+KTR3 +!7*<WR_ORA1> + PPROD(:,31) = +0.00878*TPK%K058(:)*PCONC(:,19)*PCONC(:,15)+0.15343*TPK%K079(:)& +&*PCONC(:,20)*PCONC(:,1)+0.15000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.10788*TPK& +&%K081(:)*PCONC(:,26)*PCONC(:,1)+0.11*TPK%K082(:)*PCONC(:,28)*PCONC(:,1)+TPK%KT& +&C37(:)*PCONC(:,59)+TPK%KTR37(:)*PCONC(:,84) +!PLOSS(ORA1) = +K066*<OH>+KTC17+KTR17 + PLOSS(:,31) = +TPK%K066(:)*PCONC(:,15)+TPK%KTC17(:)+TPK%KTR17(:) +! !PPROD(ORA2) = +0.08143*K079*<ALKE>*<O3>+0.00000*K080*<BIO>*<O3>+0.20595*K081*< !CARBO>*<O3>+0.17307*K0102*<CARBOP>*<HO2>+0.13684*K109*<CARBOP>*<MO2>+0.49810*K !111*<ALKAP>*<CARBOP>+0.49922*K112*<ALKEP>*<CARBOP>+0.49400*K113*<BIOP>*<CARBOP !>+0.09955*K115*<CARBOP>*<CARBOP>+0.48963*K116*<OLN>*<CARBOP>+KTC38*<WC_ORA2>+K !TR38*<WR_ORA2> - PPROD(:,31) = +0.08143*TPK%K079(:)*PCONC(:,19)*PCONC(:,1)+0.00000*TPK%K080(:)*& -&PCONC(:,20)*PCONC(:,1)+0.20595*TPK%K081(:)*PCONC(:,25)*PCONC(:,1)+0.17307*TPK%& -&K0102(:)*PCONC(:,39)*PCONC(:,15)+0.13684*TPK%K109(:)*PCONC(:,39)*PCONC(:,32)+0& -&.49810*TPK%K111(:)*PCONC(:,33)*PCONC(:,39)+0.49922*TPK%K112(:)*PCONC(:,34)*PCO& -&NC(:,39)+0.49400*TPK%K113(:)*PCONC(:,35)*PCONC(:,39)+0.09955*TPK%K115(:)*PCONC& -&(:,39)*PCONC(:,39)+0.48963*TPK%K116(:)*PCONC(:,40)*PCONC(:,39)+TPK%KTC38(:)*PC& -&ONC(:,59)+TPK%KTR38(:)*PCONC(:,84) + PPROD(:,32) = +0.08143*TPK%K079(:)*PCONC(:,20)*PCONC(:,1)+0.00000*TPK%K080(:)*& +&PCONC(:,21)*PCONC(:,1)+0.20595*TPK%K081(:)*PCONC(:,26)*PCONC(:,1)+0.17307*TPK%& +&K0102(:)*PCONC(:,40)*PCONC(:,16)+0.13684*TPK%K109(:)*PCONC(:,40)*PCONC(:,33)+0& +&.49810*TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.49922*TPK%K112(:)*PCONC(:,35)*PCO& +&NC(:,40)+0.49400*TPK%K113(:)*PCONC(:,36)*PCONC(:,40)+0.09955*TPK%K115(:)*PCONC& +&(:,40)*PCONC(:,40)+0.48963*TPK%K116(:)*PCONC(:,41)*PCONC(:,40)+TPK%KTC38(:)*PC& +&ONC(:,60)+TPK%KTR38(:)*PCONC(:,85) !PLOSS(ORA2) = +K067*<OH>+KTC18+KTR18 - PLOSS(:,31) = +TPK%K067(:)*PCONC(:,14)+TPK%KTC18(:)+TPK%KTR18(:) + PLOSS(:,32) = +TPK%K067(:)*PCONC(:,15)+TPK%KTC18(:)+TPK%KTR18(:) ! !PPROD(MO2) = +K012*<ALD>+0.03795*K014*<OP2>+K056*<CH4>*<OH>+0.65*K068*<OP1>*<O !H>+0.13966*K079*<ALKE>*<O3>+0.03000*K080*<BIO>*<O3>+0.09016*K091*<ALKAP>*<NO>+ @@ -4531,71 +4573,71 @@ SUBROUTINE SUB3 !BIOP>*<CARBOP>+K114*<AROP>*<CARBOP>+1.66702*K115*<CARBOP>*<CARBOP>+0.51037*K11 !6*<OLN>*<CARBOP>+0.09731*K120*<ALKAP>*<NO3>+0.91910*K124*<CARBOP>*<NO3>+K128*< !XO2>*<CARBOP>+KTC39*<WC_MO2>+KTR39*<WR_MO2> - PPROD(:,32) = +TPK%K012(:)*PCONC(:,23)+0.03795*TPK%K014(:)*PCONC(:,29)+TPK%K05& -&6(:)*PCONC(:,16)*PCONC(:,14)+0.65*TPK%K068(:)*PCONC(:,28)*PCONC(:,14)+0.13966*& -&TPK%K079(:)*PCONC(:,19)*PCONC(:,1)+0.03000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1)+& -&0.09016*TPK%K091(:)*PCONC(:,33)*PCONC(:,3)+0.78134*TPK%K095(:)*PCONC(:,39)*PCO& -&NC(:,3)+0.01390*TPK%K105(:)*PCONC(:,33)*PCONC(:,32)+0.56031*TPK%K109(:)*PCONC(& -&:,39)*PCONC(:,32)+0.51480*TPK%K111(:)*PCONC(:,33)*PCONC(:,39)+0.50078*TPK%K112& -&(:)*PCONC(:,34)*PCONC(:,39)+0.50600*TPK%K113(:)*PCONC(:,35)*PCONC(:,39)+TPK%K1& -&14(:)*PCONC(:,38)*PCONC(:,39)+1.66702*TPK%K115(:)*PCONC(:,39)*PCONC(:,39)+0.51& -&037*TPK%K116(:)*PCONC(:,40)*PCONC(:,39)+0.09731*TPK%K120(:)*PCONC(:,33)*PCONC(& -&:,5)+0.91910*TPK%K124(:)*PCONC(:,39)*PCONC(:,5)+TPK%K128(:)*PCONC(:,41)*PCONC(& -&:,39)+TPK%KTC39(:)*PCONC(:,60)+TPK%KTR39(:)*PCONC(:,85) + PPROD(:,33) = +TPK%K012(:)*PCONC(:,24)+0.03795*TPK%K014(:)*PCONC(:,30)+TPK%K05& +&6(:)*PCONC(:,17)*PCONC(:,15)+0.65*TPK%K068(:)*PCONC(:,29)*PCONC(:,15)+0.13966*& +&TPK%K079(:)*PCONC(:,20)*PCONC(:,1)+0.03000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+& +&0.09016*TPK%K091(:)*PCONC(:,34)*PCONC(:,3)+0.78134*TPK%K095(:)*PCONC(:,40)*PCO& +&NC(:,3)+0.01390*TPK%K105(:)*PCONC(:,34)*PCONC(:,33)+0.56031*TPK%K109(:)*PCONC(& +&:,40)*PCONC(:,33)+0.51480*TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.50078*TPK%K112& +&(:)*PCONC(:,35)*PCONC(:,40)+0.50600*TPK%K113(:)*PCONC(:,36)*PCONC(:,40)+TPK%K1& +&14(:)*PCONC(:,39)*PCONC(:,40)+1.66702*TPK%K115(:)*PCONC(:,40)*PCONC(:,40)+0.51& +&037*TPK%K116(:)*PCONC(:,41)*PCONC(:,40)+0.09731*TPK%K120(:)*PCONC(:,34)*PCONC(& +&:,5)+0.91910*TPK%K124(:)*PCONC(:,40)*PCONC(:,5)+TPK%K128(:)*PCONC(:,42)*PCONC(& +&:,40)+TPK%KTC39(:)*PCONC(:,61)+TPK%KTR39(:)*PCONC(:,86) !PLOSS(MO2) = +K090*<NO>+K097*<HO2>+K104*<MO2>+K104*<MO2>+K105*<ALKAP>+K106*<AL !KEP>+K107*<BIOP>+K108*<AROP>+K109*<CARBOP>+K110*<OLN>+K119*<NO3>+K127*<XO2>+KT !C19+KTR19 - PLOSS(:,32) = +TPK%K090(:)*PCONC(:,3)+TPK%K097(:)*PCONC(:,15)+TPK%K104(:)*PCON& -&C(:,32)+TPK%K104(:)*PCONC(:,32)+TPK%K105(:)*PCONC(:,33)+TPK%K106(:)*PCONC(:,34& -&)+TPK%K107(:)*PCONC(:,35)+TPK%K108(:)*PCONC(:,38)+TPK%K109(:)*PCONC(:,39)+TPK%& -&K110(:)*PCONC(:,40)+TPK%K119(:)*PCONC(:,5)+TPK%K127(:)*PCONC(:,41)+TPK%KTC19(:& + PLOSS(:,33) = +TPK%K090(:)*PCONC(:,3)+TPK%K097(:)*PCONC(:,16)+TPK%K104(:)*PCON& +&C(:,33)+TPK%K104(:)*PCONC(:,33)+TPK%K105(:)*PCONC(:,34)+TPK%K106(:)*PCONC(:,35& +&)+TPK%K107(:)*PCONC(:,36)+TPK%K108(:)*PCONC(:,39)+TPK%K109(:)*PCONC(:,40)+TPK%& +&K110(:)*PCONC(:,41)+TPK%K119(:)*PCONC(:,5)+TPK%K127(:)*PCONC(:,42)+TPK%KTC19(:& &)+TPK%KTR19(:) ! !PPROD(ALKAP) = +1.00000*K015*<KET>+K057*<ETH>*<OH>+0.87811*K058*<ALKA>*<OH>+0. !40341*K069*<OP2>*<OH>+1.00000*K071*<ONIT>*<OH>+0.09815*K079*<ALKE>*<O3>+0.0000 !0*K080*<BIO>*<O3>+0.08187*K091*<ALKAP>*<NO>+0.00385*K105*<ALKAP>*<MO2>+0.00828 !*K111*<ALKAP>*<CARBOP>+0.08994*K120*<ALKAP>*<NO3> - PPROD(:,33) = +1.00000*TPK%K015(:)*PCONC(:,24)+TPK%K057(:)*PCONC(:,17)*PCONC(:& -&,14)+0.87811*TPK%K058(:)*PCONC(:,18)*PCONC(:,14)+0.40341*TPK%K069(:)*PCONC(:,2& -&9)*PCONC(:,14)+1.00000*TPK%K071(:)*PCONC(:,26)*PCONC(:,14)+0.09815*TPK%K079(:)& -&*PCONC(:,19)*PCONC(:,1)+0.00000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1)+0.08187*TPK& -&%K091(:)*PCONC(:,33)*PCONC(:,3)+0.00385*TPK%K105(:)*PCONC(:,33)*PCONC(:,32)+0.& -&00828*TPK%K111(:)*PCONC(:,33)*PCONC(:,39)+0.08994*TPK%K120(:)*PCONC(:,33)*PCON& + PPROD(:,34) = +1.00000*TPK%K015(:)*PCONC(:,25)+TPK%K057(:)*PCONC(:,18)*PCONC(:& +&,15)+0.87811*TPK%K058(:)*PCONC(:,19)*PCONC(:,15)+0.40341*TPK%K069(:)*PCONC(:,3& +&0)*PCONC(:,15)+1.00000*TPK%K071(:)*PCONC(:,27)*PCONC(:,15)+0.09815*TPK%K079(:)& +&*PCONC(:,20)*PCONC(:,1)+0.00000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.08187*TPK& +&%K091(:)*PCONC(:,34)*PCONC(:,3)+0.00385*TPK%K105(:)*PCONC(:,34)*PCONC(:,33)+0.& +&00828*TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.08994*TPK%K120(:)*PCONC(:,34)*PCON& &C(:,5) !PLOSS(ALKAP) = +K091*<NO>+K098*<HO2>+K105*<MO2>+K111*<CARBOP>+K120*<NO3> - PLOSS(:,33) = +TPK%K091(:)*PCONC(:,3)+TPK%K098(:)*PCONC(:,15)+TPK%K105(:)*PCON& -&C(:,32)+TPK%K111(:)*PCONC(:,39)+TPK%K120(:)*PCONC(:,5) + PLOSS(:,34) = +TPK%K091(:)*PCONC(:,3)+TPK%K098(:)*PCONC(:,16)+TPK%K105(:)*PCON& +&C(:,33)+TPK%K111(:)*PCONC(:,40)+TPK%K120(:)*PCONC(:,5) ! !PPROD(ALKEP) = +1.02529*K059*<ALKE>*<OH> - PPROD(:,34) = +1.02529*TPK%K059(:)*PCONC(:,19)*PCONC(:,14) + PPROD(:,35) = +1.02529*TPK%K059(:)*PCONC(:,20)*PCONC(:,15) !PLOSS(ALKEP) = +K092*<NO>+K099*<HO2>+K106*<MO2>+K112*<CARBOP>+K121*<NO3> - PLOSS(:,34) = +TPK%K092(:)*PCONC(:,3)+TPK%K099(:)*PCONC(:,15)+TPK%K106(:)*PCON& -&C(:,32)+TPK%K112(:)*PCONC(:,39)+TPK%K121(:)*PCONC(:,5) + PLOSS(:,35) = +TPK%K092(:)*PCONC(:,3)+TPK%K099(:)*PCONC(:,16)+TPK%K106(:)*PCON& +&C(:,33)+TPK%K112(:)*PCONC(:,40)+TPK%K121(:)*PCONC(:,5) ! !PPROD(BIOP) = +0.00000*K059*<ALKE>*<OH>+1.00000*K060*<BIO>*<OH> - PPROD(:,35) = +0.00000*TPK%K059(:)*PCONC(:,19)*PCONC(:,14)+1.00000*TPK%K060(:)& -&*PCONC(:,20)*PCONC(:,14) + PPROD(:,36) = +0.00000*TPK%K059(:)*PCONC(:,20)*PCONC(:,15)+1.00000*TPK%K060(:)& +&*PCONC(:,21)*PCONC(:,15) !PLOSS(BIOP) = +K093*<NO>+K0100*<HO2>+K107*<MO2>+K113*<CARBOP>+K122*<NO3> - PLOSS(:,35) = +TPK%K093(:)*PCONC(:,3)+TPK%K0100(:)*PCONC(:,15)+TPK%K107(:)*PCO& -&NC(:,32)+TPK%K113(:)*PCONC(:,39)+TPK%K122(:)*PCONC(:,5) + PLOSS(:,36) = +TPK%K093(:)*PCONC(:,3)+TPK%K0100(:)*PCONC(:,16)+TPK%K107(:)*PCO& +&NC(:,33)+TPK%K113(:)*PCONC(:,40)+TPK%K122(:)*PCONC(:,5) ! !PPROD(PHO) = +0.00276*K061*<ARO>*<OH>+K075*<ARO>*<NO3> - PPROD(:,36) = +0.00276*TPK%K061(:)*PCONC(:,21)*PCONC(:,14)+TPK%K075(:)*PCONC(:& -&,21)*PCONC(:,5) + PPROD(:,37) = +0.00276*TPK%K061(:)*PCONC(:,22)*PCONC(:,15)+TPK%K075(:)*PCONC(:& +&,22)*PCONC(:,5) !PLOSS(PHO) = +K083*<NO2>+K084*<HO2> - PLOSS(:,36) = +TPK%K083(:)*PCONC(:,4)+TPK%K084(:)*PCONC(:,15) + PLOSS(:,37) = +TPK%K083(:)*PCONC(:,4)+TPK%K084(:)*PCONC(:,16) ! !PPROD(ADD) = +0.93968*K061*<ARO>*<OH> - PPROD(:,37) = +0.93968*TPK%K061(:)*PCONC(:,21)*PCONC(:,14) + PPROD(:,38) = +0.93968*TPK%K061(:)*PCONC(:,22)*PCONC(:,15) !PLOSS(ADD) = +K085*<NO2>+K086*<O2>+K087*<O3> - PLOSS(:,37) = +TPK%K085(:)*PCONC(:,4)+TPK%K086(:)*TPK%O2(:)+TPK%K087(:)*PCONC(& + PLOSS(:,38) = +TPK%K085(:)*PCONC(:,4)+TPK%K086(:)*TPK%O2(:)+TPK%K087(:)*PCONC(& &:,1) ! !PPROD(AROP) = +0.98*K086*<ADD>*<O2> - PPROD(:,38) = +0.98*TPK%K086(:)*PCONC(:,37)*TPK%O2(:) + PPROD(:,39) = +0.98*TPK%K086(:)*PCONC(:,38)*TPK%O2(:) !PLOSS(AROP) = +K094*<NO>+K0101*<HO2>+K108*<MO2>+K114*<CARBOP>+K123*<NO3> - PLOSS(:,38) = +TPK%K094(:)*PCONC(:,3)+TPK%K0101(:)*PCONC(:,15)+TPK%K108(:)*PCO& -&NC(:,32)+TPK%K114(:)*PCONC(:,39)+TPK%K123(:)*PCONC(:,5) + PLOSS(:,39) = +TPK%K094(:)*PCONC(:,3)+TPK%K0101(:)*PCONC(:,16)+TPK%K108(:)*PCO& +&NC(:,33)+TPK%K114(:)*PCONC(:,40)+TPK%K123(:)*PCONC(:,5) ! !PPROD(CARBOP) = +1.00000*K015*<KET>+0.69622*K016*<CARBO>+1.00000*K063*<ALD>*<O !H>+1.00000*K064*<KET>*<OH>+0.51419*K065*<CARBO>*<OH>+0.05413*K069*<OP2>*<OH>+1 @@ -4603,34 +4645,24 @@ SUBROUTINE SUB3 !17000*K080*<BIO>*<O3>+0.27460*K081*<CARBO>*<O3>+0.70000*K082*<PAN>*<O3>+1.0000 !0*K089*<PAN>+0.09532*K095*<CARBOP>*<NO>+0.05954*K109*<CARBOP>*<MO2>+0.05821*K1 !15*<CARBOP>*<CARBOP>+0.03175*K124*<CARBOP>*<NO3> - PPROD(:,39) = +1.00000*TPK%K015(:)*PCONC(:,24)+0.69622*TPK%K016(:)*PCONC(:,25)& -&+1.00000*TPK%K063(:)*PCONC(:,23)*PCONC(:,14)+1.00000*TPK%K064(:)*PCONC(:,24)*P& -&CONC(:,14)+0.51419*TPK%K065(:)*PCONC(:,25)*PCONC(:,14)+0.05413*TPK%K069(:)*PCO& -&NC(:,29)*PCONC(:,14)+1.00000*TPK%K073(:)*PCONC(:,23)*PCONC(:,5)+0.38881*TPK%K0& -&74(:)*PCONC(:,25)*PCONC(:,5)+0.05705*TPK%K079(:)*PCONC(:,19)*PCONC(:,1)+0.1700& -&0*TPK%K080(:)*PCONC(:,20)*PCONC(:,1)+0.27460*TPK%K081(:)*PCONC(:,25)*PCONC(:,1& -&)+0.70000*TPK%K082(:)*PCONC(:,27)*PCONC(:,1)+1.00000*TPK%K089(:)*PCONC(:,27)+0& -&.09532*TPK%K095(:)*PCONC(:,39)*PCONC(:,3)+0.05954*TPK%K109(:)*PCONC(:,39)*PCON& -&C(:,32)+0.05821*TPK%K115(:)*PCONC(:,39)*PCONC(:,39)+0.03175*TPK%K124(:)*PCONC(& -&:,39)*PCONC(:,5) + PPROD(:,40) = +1.00000*TPK%K015(:)*PCONC(:,25)+0.69622*TPK%K016(:)*PCONC(:,26)& +&+1.00000*TPK%K063(:)*PCONC(:,24)*PCONC(:,15)+1.00000*TPK%K064(:)*PCONC(:,25)*P& +&CONC(:,15)+0.51419*TPK%K065(:)*PCONC(:,26)*PCONC(:,15)+0.05413*TPK%K069(:)*PCO& +&NC(:,30)*PCONC(:,15)+1.00000*TPK%K073(:)*PCONC(:,24)*PCONC(:,5)+0.38881*TPK%K0& +&74(:)*PCONC(:,26)*PCONC(:,5)+0.05705*TPK%K079(:)*PCONC(:,20)*PCONC(:,1)+0.1700& +&0*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.27460*TPK%K081(:)*PCONC(:,26)*PCONC(:,1& +&)+0.70000*TPK%K082(:)*PCONC(:,28)*PCONC(:,1)+1.00000*TPK%K089(:)*PCONC(:,28)+0& +&.09532*TPK%K095(:)*PCONC(:,40)*PCONC(:,3)+0.05954*TPK%K109(:)*PCONC(:,40)*PCON& +&C(:,33)+0.05821*TPK%K115(:)*PCONC(:,40)*PCONC(:,40)+0.03175*TPK%K124(:)*PCONC(& +&:,40)*PCONC(:,5) !PLOSS(CARBOP) = +K088*<NO2>+K095*<NO>+K0102*<HO2>+K109*<MO2>+K111*<ALKAP>+K112 !*<ALKEP>+K113*<BIOP>+K114*<AROP>+K115*<CARBOP>+K115*<CARBOP>+K116*<OLN>+K124*< !NO3>+K128*<XO2> - PLOSS(:,39) = +TPK%K088(:)*PCONC(:,4)+TPK%K095(:)*PCONC(:,3)+TPK%K0102(:)*PCON& -&C(:,15)+TPK%K109(:)*PCONC(:,32)+TPK%K111(:)*PCONC(:,33)+TPK%K112(:)*PCONC(:,34& -&)+TPK%K113(:)*PCONC(:,35)+TPK%K114(:)*PCONC(:,38)+TPK%K115(:)*PCONC(:,39)+TPK%& -&K115(:)*PCONC(:,39)+TPK%K116(:)*PCONC(:,40)+TPK%K124(:)*PCONC(:,5)+TPK%K128(:)& -&*PCONC(:,41) -! -!PPROD(OLN) = +0.00000*K074*<CARBO>*<NO3>+0.93768*K076*<ALKE>*<NO3>+1.00000*K07 -!7*<BIO>*<NO3> - PPROD(:,40) = +0.00000*TPK%K074(:)*PCONC(:,25)*PCONC(:,5)+0.93768*TPK%K076(:)*& -&PCONC(:,19)*PCONC(:,5)+1.00000*TPK%K077(:)*PCONC(:,20)*PCONC(:,5) -!PLOSS(OLN) = +K096*<NO>+K103*<HO2>+K110*<MO2>+K116*<CARBOP>+K117*<OLN>+K117*<O -!LN>+K118*<OLN>+K118*<OLN>+K125*<NO3> - PLOSS(:,40) = +TPK%K096(:)*PCONC(:,3)+TPK%K103(:)*PCONC(:,15)+TPK%K110(:)*PCON& -&C(:,32)+TPK%K116(:)*PCONC(:,39)+TPK%K117(:)*PCONC(:,40)+TPK%K117(:)*PCONC(:,40& -&)+TPK%K118(:)*PCONC(:,40)+TPK%K118(:)*PCONC(:,40)+TPK%K125(:)*PCONC(:,5) + PLOSS(:,40) = +TPK%K088(:)*PCONC(:,4)+TPK%K095(:)*PCONC(:,3)+TPK%K0102(:)*PCON& +&C(:,16)+TPK%K109(:)*PCONC(:,33)+TPK%K111(:)*PCONC(:,34)+TPK%K112(:)*PCONC(:,35& +&)+TPK%K113(:)*PCONC(:,36)+TPK%K114(:)*PCONC(:,39)+TPK%K115(:)*PCONC(:,40)+TPK%& +&K115(:)*PCONC(:,40)+TPK%K116(:)*PCONC(:,41)+TPK%K124(:)*PCONC(:,5)+TPK%K128(:)& +&*PCONC(:,42) ! RETURN END SUBROUTINE SUB3 @@ -4640,79 +4672,84 @@ SUBROUTINE SUB4 !Indices 41 a 50 ! ! +!PPROD(OLN) = +0.00000*K074*<CARBO>*<NO3>+0.93768*K076*<ALKE>*<NO3>+1.00000*K07 +!7*<BIO>*<NO3> + PPROD(:,41) = +0.00000*TPK%K074(:)*PCONC(:,26)*PCONC(:,5)+0.93768*TPK%K076(:)*& +&PCONC(:,20)*PCONC(:,5)+1.00000*TPK%K077(:)*PCONC(:,21)*PCONC(:,5) +!PLOSS(OLN) = +K096*<NO>+K103*<HO2>+K110*<MO2>+K116*<CARBOP>+K117*<OLN>+K117*<O +!LN>+K118*<OLN>+K118*<OLN>+K125*<NO3> + PLOSS(:,41) = +TPK%K096(:)*PCONC(:,3)+TPK%K103(:)*PCONC(:,16)+TPK%K110(:)*PCON& +&C(:,33)+TPK%K116(:)*PCONC(:,40)+TPK%K117(:)*PCONC(:,41)+TPK%K117(:)*PCONC(:,41& +&)+TPK%K118(:)*PCONC(:,41)+TPK%K118(:)*PCONC(:,41)+TPK%K125(:)*PCONC(:,5) +! !PPROD(XO2) = +0.15*K054*<BIO>*<O3P>+0.10318*K061*<ARO>*<OH>+0.10162*K065*<CARB !O>*<OH>+0.09333*K069*<OP2>*<OH>+K070*<PAN>*<OH>+0.10530*K074*<CARBO>*<NO3>+K07 !8*<PAN>*<NO3>+0.00000*K079*<ALKE>*<O3>+0.13000*K080*<BIO>*<O3>+0.13007*K091*<A !LKAP>*<NO>+0.02563*K095*<CARBOP>*<NO>+0.13370*K105*<ALKAP>*<MO2>+0.02212*K109* !<CARBOP>*<MO2>+0.11306*K111*<ALKAP>*<CARBOP>+0.01593*K115*<CARBOP>*<CARBOP>+0. !16271*K120*<ALKAP>*<NO3>+0.01021*K124*<CARBOP>*<NO3> - PPROD(:,41) = +0.15*TPK%K054(:)*PCONC(:,20)*TPK%O3P(:)+0.10318*TPK%K061(:)*PCO& -&NC(:,21)*PCONC(:,14)+0.10162*TPK%K065(:)*PCONC(:,25)*PCONC(:,14)+0.09333*TPK%K& -&069(:)*PCONC(:,29)*PCONC(:,14)+TPK%K070(:)*PCONC(:,27)*PCONC(:,14)+0.10530*TPK& -&%K074(:)*PCONC(:,25)*PCONC(:,5)+TPK%K078(:)*PCONC(:,27)*PCONC(:,5)+0.00000*TPK& -&%K079(:)*PCONC(:,19)*PCONC(:,1)+0.13000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1)+0.1& -&3007*TPK%K091(:)*PCONC(:,33)*PCONC(:,3)+0.02563*TPK%K095(:)*PCONC(:,39)*PCONC(& -&:,3)+0.13370*TPK%K105(:)*PCONC(:,33)*PCONC(:,32)+0.02212*TPK%K109(:)*PCONC(:,3& -&9)*PCONC(:,32)+0.11306*TPK%K111(:)*PCONC(:,33)*PCONC(:,39)+0.01593*TPK%K115(:)& -&*PCONC(:,39)*PCONC(:,39)+0.16271*TPK%K120(:)*PCONC(:,33)*PCONC(:,5)+0.01021*TP& -&K%K124(:)*PCONC(:,39)*PCONC(:,5) + PPROD(:,42) = +0.15*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:)+0.10318*TPK%K061(:)*PCO& +&NC(:,22)*PCONC(:,15)+0.10162*TPK%K065(:)*PCONC(:,26)*PCONC(:,15)+0.09333*TPK%K& +&069(:)*PCONC(:,30)*PCONC(:,15)+TPK%K070(:)*PCONC(:,28)*PCONC(:,15)+0.10530*TPK& +&%K074(:)*PCONC(:,26)*PCONC(:,5)+TPK%K078(:)*PCONC(:,28)*PCONC(:,5)+0.00000*TPK& +&%K079(:)*PCONC(:,20)*PCONC(:,1)+0.13000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.1& +&3007*TPK%K091(:)*PCONC(:,34)*PCONC(:,3)+0.02563*TPK%K095(:)*PCONC(:,40)*PCONC(& +&:,3)+0.13370*TPK%K105(:)*PCONC(:,34)*PCONC(:,33)+0.02212*TPK%K109(:)*PCONC(:,4& +&0)*PCONC(:,33)+0.11306*TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.01593*TPK%K115(:)& +&*PCONC(:,40)*PCONC(:,40)+0.16271*TPK%K120(:)*PCONC(:,34)*PCONC(:,5)+0.01021*TP& +&K%K124(:)*PCONC(:,40)*PCONC(:,5) !PLOSS(XO2) = +K126*<HO2>+K127*<MO2>+K128*<CARBOP>+K129*<XO2>+K129*<XO2>+K130*< !NO>+K131*<NO3> - PLOSS(:,41) = +TPK%K126(:)*PCONC(:,15)+TPK%K127(:)*PCONC(:,32)+TPK%K128(:)*PCO& -&NC(:,39)+TPK%K129(:)*PCONC(:,41)+TPK%K129(:)*PCONC(:,41)+TPK%K130(:)*PCONC(:,3& + PLOSS(:,42) = +TPK%K126(:)*PCONC(:,16)+TPK%K127(:)*PCONC(:,33)+TPK%K128(:)*PCO& +&NC(:,40)+TPK%K129(:)*PCONC(:,42)+TPK%K129(:)*PCONC(:,42)+TPK%K130(:)*PCONC(:,3& &)+TPK%K131(:)*PCONC(:,5) ! !PPROD(WC_O3) = +KTC1*<O3> - PPROD(:,42) = +TPK%KTC1(:)*PCONC(:,1) + PPROD(:,43) = +TPK%KTC1(:)*PCONC(:,1) !PLOSS(WC_O3) = +KTC21+KC6*<WC_HO2>+KC29*<WC_SO2> - PLOSS(:,42) = +TPK%KTC21(:)+TPK%KC6(:)*PCONC(:,53)+TPK%KC29(:)*PCONC(:,55) + PLOSS(:,43) = +TPK%KTC21(:)+TPK%KC6(:)*PCONC(:,54)+TPK%KC29(:)*PCONC(:,56) ! !PPROD(WC_H2O2) = +KTC2*<H2O2>+KC2*<WC_OH>*<WC_OH>+KC5*<WC_HO2>*<WC_HO2> - PPROD(:,43) = +TPK%KTC2(:)*PCONC(:,2)+TPK%KC2(:)*PCONC(:,52)*PCONC(:,52)+TPK%K& -&C5(:)*PCONC(:,53)*PCONC(:,53) + PPROD(:,44) = +TPK%KTC2(:)*PCONC(:,2)+TPK%KC2(:)*PCONC(:,53)*PCONC(:,53)+TPK%K& +&C5(:)*PCONC(:,54)*PCONC(:,54) !PLOSS(WC_H2O2) = +KTC22+KC1+KC4*<WC_OH>+KC30*<WC_SO2> - PLOSS(:,43) = +TPK%KTC22(:)+TPK%KC1(:)+TPK%KC4(:)*PCONC(:,52)+TPK%KC30(:)*PCON& -&C(:,55) + PLOSS(:,44) = +TPK%KTC22(:)+TPK%KC1(:)+TPK%KC4(:)*PCONC(:,53)+TPK%KC30(:)*PCON& +&C(:,56) ! !PPROD(WC_NO) = +KTC3*<NO> - PPROD(:,44) = +TPK%KTC3(:)*PCONC(:,3) + PPROD(:,45) = +TPK%KTC3(:)*PCONC(:,3) !PLOSS(WC_NO) = +KTC23 - PLOSS(:,44) = +TPK%KTC23(:) + PLOSS(:,45) = +TPK%KTC23(:) ! !PPROD(WC_NO2) = +KTC4*<NO2>+KC8*<WC_HONO>*<WC_OH>+KC10*<WC_HNO4>+KC13*<WC_HNO3 !> - PPROD(:,45) = +TPK%KTC4(:)*PCONC(:,4)+TPK%KC8(:)*PCONC(:,48)*PCONC(:,52)+TPK%K& -&C10(:)*PCONC(:,50)+TPK%KC13(:)*PCONC(:,49) + PPROD(:,46) = +TPK%KTC4(:)*PCONC(:,4)+TPK%KC8(:)*PCONC(:,49)*PCONC(:,53)+TPK%K& +&C10(:)*PCONC(:,51)+TPK%KC13(:)*PCONC(:,50) !PLOSS(WC_NO2) = +KTC24+KC9*<WC_HO2> - PLOSS(:,45) = +TPK%KTC24(:)+TPK%KC9(:)*PCONC(:,53) + PLOSS(:,46) = +TPK%KTC24(:)+TPK%KC9(:)*PCONC(:,54) ! !PPROD(WC_NO3) = +KTC5*<NO3> - PPROD(:,46) = +TPK%KTC5(:)*PCONC(:,5) + PPROD(:,47) = +TPK%KTC5(:)*PCONC(:,5) !PLOSS(WC_NO3) = +KTC25+KC15*<WC_SULF>+KC16*<WC_SO2> - PLOSS(:,46) = +TPK%KTC25(:)+TPK%KC15(:)*PCONC(:,56)+TPK%KC16(:)*PCONC(:,55) + PLOSS(:,47) = +TPK%KTC25(:)+TPK%KC15(:)*PCONC(:,57)+TPK%KC16(:)*PCONC(:,56) ! !PPROD(WC_N2O5) = +KTC6*<N2O5> - PPROD(:,47) = +TPK%KTC6(:)*PCONC(:,6) + PPROD(:,48) = +TPK%KTC6(:)*PCONC(:,6) !PLOSS(WC_N2O5) = +KTC26+KC14 - PLOSS(:,47) = +TPK%KTC26(:)+TPK%KC14(:) + PLOSS(:,48) = +TPK%KTC26(:)+TPK%KC14(:) ! !PPROD(WC_HONO) = +KTC7*<HONO>+KC11*<WC_HNO4> - PPROD(:,48) = +TPK%KTC7(:)*PCONC(:,7)+TPK%KC11(:)*PCONC(:,50) + PPROD(:,49) = +TPK%KTC7(:)*PCONC(:,7)+TPK%KC11(:)*PCONC(:,51) !PLOSS(WC_HONO) = +KTC27+KC8*<WC_OH> - PLOSS(:,48) = +TPK%KTC27(:)+TPK%KC8(:)*PCONC(:,52) + PLOSS(:,49) = +TPK%KTC27(:)+TPK%KC8(:)*PCONC(:,53) ! !PPROD(WC_HNO3) = +KTC8*<HNO3>+KC12*<WC_HNO4>*<WC_SO2>+KC14*<WC_N2O5>+KC14*<WC_ !N2O5>+KC15*<WC_NO3>*<WC_SULF>+KC16*<WC_NO3>*<WC_SO2> - PPROD(:,49) = +TPK%KTC8(:)*PCONC(:,8)+TPK%KC12(:)*PCONC(:,50)*PCONC(:,55)+TPK%& -&KC14(:)*PCONC(:,47)+TPK%KC14(:)*PCONC(:,47)+TPK%KC15(:)*PCONC(:,46)*PCONC(:,56& -&)+TPK%KC16(:)*PCONC(:,46)*PCONC(:,55) + PPROD(:,50) = +TPK%KTC8(:)*PCONC(:,8)+TPK%KC12(:)*PCONC(:,51)*PCONC(:,56)+TPK%& +&KC14(:)*PCONC(:,48)+TPK%KC14(:)*PCONC(:,48)+TPK%KC15(:)*PCONC(:,47)*PCONC(:,57& +&)+TPK%KC16(:)*PCONC(:,47)*PCONC(:,56) !PLOSS(WC_HNO3) = +KTC28+KC13 - PLOSS(:,49) = +TPK%KTC28(:)+TPK%KC13(:) -! -!PPROD(WC_HNO4) = +KTC9*<HNO4>+KC9*<WC_NO2>*<WC_HO2> - PPROD(:,50) = +TPK%KTC9(:)*PCONC(:,9)+TPK%KC9(:)*PCONC(:,45)*PCONC(:,53) -!PLOSS(WC_HNO4) = +KTC29+KC10+KC11+KC12*<WC_SO2> - PLOSS(:,50) = +TPK%KTC29(:)+TPK%KC10(:)+TPK%KC11(:)+TPK%KC12(:)*PCONC(:,55) + PLOSS(:,50) = +TPK%KTC28(:)+TPK%KC13(:) ! RETURN END SUBROUTINE SUB4 @@ -4722,80 +4759,79 @@ SUBROUTINE SUB5 !Indices 51 a 60 ! ! +!PPROD(WC_HNO4) = +KTC9*<HNO4>+KC9*<WC_NO2>*<WC_HO2> + PPROD(:,51) = +TPK%KTC9(:)*PCONC(:,9)+TPK%KC9(:)*PCONC(:,46)*PCONC(:,54) +!PLOSS(WC_HNO4) = +KTC29+KC10+KC11+KC12*<WC_SO2> + PLOSS(:,51) = +TPK%KTC29(:)+TPK%KC10(:)+TPK%KC11(:)+TPK%KC12(:)*PCONC(:,56) +! !PPROD(WC_NH3) = +KTC10*<NH3> - PPROD(:,51) = +TPK%KTC10(:)*PCONC(:,10) + PPROD(:,52) = +TPK%KTC10(:)*PCONC(:,10) !PLOSS(WC_NH3) = +KTC30 - PLOSS(:,51) = +TPK%KTC30(:) + PLOSS(:,52) = +TPK%KTC30(:) ! !PPROD(WC_OH) = +KTC11*<OH>+KC1*<WC_H2O2>+KC1*<WC_H2O2>+KC6*<WC_O3>*<WC_HO2>+KC !13*<WC_HNO3>+KC28*<WC_ASO4> - PPROD(:,52) = +TPK%KTC11(:)*PCONC(:,14)+TPK%KC1(:)*PCONC(:,43)+TPK%KC1(:)*PCON& -&C(:,43)+TPK%KC6(:)*PCONC(:,42)*PCONC(:,53)+TPK%KC13(:)*PCONC(:,49)+TPK%KC28(:)& -&*PCONC(:,63) + PPROD(:,53) = +TPK%KTC11(:)*PCONC(:,15)+TPK%KC1(:)*PCONC(:,44)+TPK%KC1(:)*PCON& +&C(:,44)+TPK%KC6(:)*PCONC(:,43)*PCONC(:,54)+TPK%KC13(:)*PCONC(:,50)+TPK%KC28(:)& +&*PCONC(:,64) !PLOSS(WC_OH) = +KTC31+KC2*<WC_OH>+KC2*<WC_OH>+KC3*<WC_HO2>+KC4*<WC_H2O2>+KC7*< !WC_SO2>+KC8*<WC_HONO>+KC19*<WC_HCHO>+KC20*<WC_ORA1>+KC23*<WC_AHMS> - PLOSS(:,52) = +TPK%KTC31(:)+TPK%KC2(:)*PCONC(:,52)+TPK%KC2(:)*PCONC(:,52)+TPK%& -&KC3(:)*PCONC(:,53)+TPK%KC4(:)*PCONC(:,43)+TPK%KC7(:)*PCONC(:,55)+TPK%KC8(:)*PC& -&ONC(:,48)+TPK%KC19(:)*PCONC(:,57)+TPK%KC20(:)*PCONC(:,58)+TPK%KC23(:)*PCONC(:,& -&66) + PLOSS(:,53) = +TPK%KTC31(:)+TPK%KC2(:)*PCONC(:,53)+TPK%KC2(:)*PCONC(:,53)+TPK%& +&KC3(:)*PCONC(:,54)+TPK%KC4(:)*PCONC(:,44)+TPK%KC7(:)*PCONC(:,56)+TPK%KC8(:)*PC& +&ONC(:,49)+TPK%KC19(:)*PCONC(:,58)+TPK%KC20(:)*PCONC(:,59)+TPK%KC23(:)*PCONC(:,& +&67) ! !PPROD(WC_HO2) = +KTC12*<HO2>+KC4*<WC_H2O2>*<WC_OH>+KC10*<WC_HNO4>+2.00*KC17*<W !C_MO2>*<WC_MO2>+KC19*<WC_HCHO>*<WC_OH>+KC20*<WC_ORA1>*<WC_OH>+KC23*<WC_AHMS>*< !WC_OH> - PPROD(:,53) = +TPK%KTC12(:)*PCONC(:,15)+TPK%KC4(:)*PCONC(:,43)*PCONC(:,52)+TPK& -&%KC10(:)*PCONC(:,50)+2.00*TPK%KC17(:)*PCONC(:,60)*PCONC(:,60)+TPK%KC19(:)*PCON& -&C(:,57)*PCONC(:,52)+TPK%KC20(:)*PCONC(:,58)*PCONC(:,52)+TPK%KC23(:)*PCONC(:,66& -&)*PCONC(:,52) + PPROD(:,54) = +TPK%KTC12(:)*PCONC(:,16)+TPK%KC4(:)*PCONC(:,44)*PCONC(:,53)+TPK& +&%KC10(:)*PCONC(:,51)+2.00*TPK%KC17(:)*PCONC(:,61)*PCONC(:,61)+TPK%KC19(:)*PCON& +&C(:,58)*PCONC(:,53)+TPK%KC20(:)*PCONC(:,59)*PCONC(:,53)+TPK%KC23(:)*PCONC(:,67& +&)*PCONC(:,53) !PLOSS(WC_HO2) = +KTC32+KC3*<WC_OH>+KC5*<WC_HO2>+KC5*<WC_HO2>+KC6*<WC_O3>+KC9*< !WC_NO2>+KC25*<WC_ASO5> - PLOSS(:,53) = +TPK%KTC32(:)+TPK%KC3(:)*PCONC(:,52)+TPK%KC5(:)*PCONC(:,53)+TPK%& -&KC5(:)*PCONC(:,53)+TPK%KC6(:)*PCONC(:,42)+TPK%KC9(:)*PCONC(:,45)+TPK%KC25(:)*P& -&CONC(:,64) + PLOSS(:,54) = +TPK%KTC32(:)+TPK%KC3(:)*PCONC(:,53)+TPK%KC5(:)*PCONC(:,54)+TPK%& +&KC5(:)*PCONC(:,54)+TPK%KC6(:)*PCONC(:,43)+TPK%KC9(:)*PCONC(:,46)+TPK%KC25(:)*P& +&CONC(:,65) ! !PPROD(WC_CO2) = +KTC13*<CO2>+KC20*<WC_ORA1>*<WC_OH> - PPROD(:,54) = +TPK%KTC13(:)*TPK%CO2(:)+TPK%KC20(:)*PCONC(:,58)*PCONC(:,52) + PPROD(:,55) = +TPK%KTC13(:)*TPK%CO2(:)+TPK%KC20(:)*PCONC(:,59)*PCONC(:,53) !PLOSS(WC_CO2) = +KTC33 - PLOSS(:,54) = +TPK%KTC33(:) + PLOSS(:,55) = +TPK%KTC33(:) ! !PPROD(WC_SO2) = +KTC14*<SO2>+KC22*<WC_AHMS>+KC23*<WC_AHMS>*<WC_OH> - PPROD(:,55) = +TPK%KTC14(:)*PCONC(:,11)+TPK%KC22(:)*PCONC(:,66)+TPK%KC23(:)*PC& -&ONC(:,66)*PCONC(:,52) + PPROD(:,56) = +TPK%KTC14(:)*PCONC(:,12)+TPK%KC22(:)*PCONC(:,67)+TPK%KC23(:)*PC& +&ONC(:,67)*PCONC(:,53) !PLOSS(WC_SO2) = +KTC34+KC7*<WC_OH>+KC12*<WC_HNO4>+KC16*<WC_NO3>+KC18*<WC_MO2>+ !KC21*<WC_HCHO>+KC27*<WC_AHSO5>+KC29*<WC_O3>+KC30*<WC_H2O2> - PLOSS(:,55) = +TPK%KTC34(:)+TPK%KC7(:)*PCONC(:,52)+TPK%KC12(:)*PCONC(:,50)+TPK& -&%KC16(:)*PCONC(:,46)+TPK%KC18(:)*PCONC(:,60)+TPK%KC21(:)*PCONC(:,57)+TPK%KC27(& -&:)*PCONC(:,65)+TPK%KC29(:)*PCONC(:,42)+TPK%KC30(:)*PCONC(:,43) + PLOSS(:,56) = +TPK%KTC34(:)+TPK%KC7(:)*PCONC(:,53)+TPK%KC12(:)*PCONC(:,51)+TPK& +&%KC16(:)*PCONC(:,47)+TPK%KC18(:)*PCONC(:,61)+TPK%KC21(:)*PCONC(:,58)+TPK%KC27(& +&:)*PCONC(:,66)+TPK%KC29(:)*PCONC(:,43)+TPK%KC30(:)*PCONC(:,44) ! !PPROD(WC_SULF) = +KTC15*<SULF>+KC12*<WC_HNO4>*<WC_SO2>+2.00*KC27*<WC_AHSO5>*<W !C_SO2>+KC28*<WC_ASO4>+KC29*<WC_SO2>*<WC_O3>+KC30*<WC_SO2>*<WC_H2O2> - PPROD(:,56) = +TPK%KTC15(:)*PCONC(:,12)+TPK%KC12(:)*PCONC(:,50)*PCONC(:,55)+2.& -&00*TPK%KC27(:)*PCONC(:,65)*PCONC(:,55)+TPK%KC28(:)*PCONC(:,63)+TPK%KC29(:)*PCO& -&NC(:,55)*PCONC(:,42)+TPK%KC30(:)*PCONC(:,55)*PCONC(:,43) + PPROD(:,57) = +TPK%KTC15(:)*PCONC(:,13)+TPK%KC12(:)*PCONC(:,51)*PCONC(:,56)+2.& +&00*TPK%KC27(:)*PCONC(:,66)*PCONC(:,56)+TPK%KC28(:)*PCONC(:,64)+TPK%KC29(:)*PCO& +&NC(:,56)*PCONC(:,43)+TPK%KC30(:)*PCONC(:,56)*PCONC(:,44) !PLOSS(WC_SULF) = +KTC35+KC15*<WC_NO3> - PLOSS(:,56) = +TPK%KTC35(:)+TPK%KC15(:)*PCONC(:,46) + PLOSS(:,57) = +TPK%KTC35(:)+TPK%KC15(:)*PCONC(:,47) ! !PPROD(WC_HCHO) = +KTC16*<HCHO>+2.00*KC17*<WC_MO2>*<WC_MO2>+KC22*<WC_AHMS> - PPROD(:,57) = +TPK%KTC16(:)*PCONC(:,22)+2.00*TPK%KC17(:)*PCONC(:,60)*PCONC(:,6& -&0)+TPK%KC22(:)*PCONC(:,66) + PPROD(:,58) = +TPK%KTC16(:)*PCONC(:,23)+2.00*TPK%KC17(:)*PCONC(:,61)*PCONC(:,6& +&1)+TPK%KC22(:)*PCONC(:,67) !PLOSS(WC_HCHO) = +KTC36+KC19*<WC_OH>+KC21*<WC_SO2> - PLOSS(:,57) = +TPK%KTC36(:)+TPK%KC19(:)*PCONC(:,52)+TPK%KC21(:)*PCONC(:,55) + PLOSS(:,58) = +TPK%KTC36(:)+TPK%KC19(:)*PCONC(:,53)+TPK%KC21(:)*PCONC(:,56) ! !PPROD(WC_ORA1) = +KTC17*<ORA1>+KC19*<WC_HCHO>*<WC_OH>+KC23*<WC_AHMS>*<WC_OH> - PPROD(:,58) = +TPK%KTC17(:)*PCONC(:,30)+TPK%KC19(:)*PCONC(:,57)*PCONC(:,52)+TP& -&K%KC23(:)*PCONC(:,66)*PCONC(:,52) + PPROD(:,59) = +TPK%KTC17(:)*PCONC(:,31)+TPK%KC19(:)*PCONC(:,58)*PCONC(:,53)+TP& +&K%KC23(:)*PCONC(:,67)*PCONC(:,53) !PLOSS(WC_ORA1) = +KTC37+KC20*<WC_OH> - PLOSS(:,58) = +TPK%KTC37(:)+TPK%KC20(:)*PCONC(:,52) + PLOSS(:,59) = +TPK%KTC37(:)+TPK%KC20(:)*PCONC(:,53) ! !PPROD(WC_ORA2) = +KTC18*<ORA2> - PPROD(:,59) = +TPK%KTC18(:)*PCONC(:,31) + PPROD(:,60) = +TPK%KTC18(:)*PCONC(:,32) !PLOSS(WC_ORA2) = +KTC38 - PLOSS(:,59) = +TPK%KTC38(:) -! -!PPROD(WC_MO2) = +KTC19*<MO2> - PPROD(:,60) = +TPK%KTC19(:)*PCONC(:,32) -!PLOSS(WC_MO2) = +KTC39+KC17*<WC_MO2>+KC17*<WC_MO2>+KC18*<WC_SO2> - PLOSS(:,60) = +TPK%KTC39(:)+TPK%KC17(:)*PCONC(:,60)+TPK%KC17(:)*PCONC(:,60)+TP& -&K%KC18(:)*PCONC(:,55) + PLOSS(:,60) = +TPK%KTC38(:) ! RETURN END SUBROUTINE SUB5 @@ -4805,64 +4841,63 @@ SUBROUTINE SUB6 !Indices 61 a 70 ! ! +!PPROD(WC_MO2) = +KTC19*<MO2> + PPROD(:,61) = +TPK%KTC19(:)*PCONC(:,33) +!PLOSS(WC_MO2) = +KTC39+KC17*<WC_MO2>+KC17*<WC_MO2>+KC18*<WC_SO2> + PLOSS(:,61) = +TPK%KTC39(:)+TPK%KC17(:)*PCONC(:,61)+TPK%KC17(:)*PCONC(:,61)+TP& +&K%KC18(:)*PCONC(:,56) +! !PPROD(WC_OP1) = +KTC20*<OP1>+KC18*<WC_MO2>*<WC_SO2> - PPROD(:,61) = +TPK%KTC20(:)*PCONC(:,28)+TPK%KC18(:)*PCONC(:,60)*PCONC(:,55) + PPROD(:,62) = +TPK%KTC20(:)*PCONC(:,29)+TPK%KC18(:)*PCONC(:,61)*PCONC(:,56) !PLOSS(WC_OP1) = +KTC40 - PLOSS(:,61) = +TPK%KTC40(:) + PLOSS(:,62) = +TPK%KTC40(:) ! !PPROD(WC_ASO3) = +KC7*<WC_OH>*<WC_SO2>+KC16*<WC_NO3>*<WC_SO2>+KC18*<WC_MO2>*<W !C_SO2> - PPROD(:,62) = +TPK%KC7(:)*PCONC(:,52)*PCONC(:,55)+TPK%KC16(:)*PCONC(:,46)*PCON& -&C(:,55)+TPK%KC18(:)*PCONC(:,60)*PCONC(:,55) + PPROD(:,63) = +TPK%KC7(:)*PCONC(:,53)*PCONC(:,56)+TPK%KC16(:)*PCONC(:,47)*PCON& +&C(:,56)+TPK%KC18(:)*PCONC(:,61)*PCONC(:,56) !PLOSS(WC_ASO3) = +KC24*<W_O2> - PLOSS(:,62) = +TPK%KC24(:)*TPK%W_O2(:) + PLOSS(:,63) = +TPK%KC24(:)*TPK%W_O2(:) ! !PPROD(WC_ASO4) = +KC15*<WC_NO3>*<WC_SULF>+KC26*<WC_ASO5>*<WC_ASO5>+KC26*<WC_AS !O5>*<WC_ASO5> - PPROD(:,63) = +TPK%KC15(:)*PCONC(:,46)*PCONC(:,56)+TPK%KC26(:)*PCONC(:,64)*PCO& -&NC(:,64)+TPK%KC26(:)*PCONC(:,64)*PCONC(:,64) + PPROD(:,64) = +TPK%KC15(:)*PCONC(:,47)*PCONC(:,57)+TPK%KC26(:)*PCONC(:,65)*PCO& +&NC(:,65)+TPK%KC26(:)*PCONC(:,65)*PCONC(:,65) !PLOSS(WC_ASO4) = +KC28 - PLOSS(:,63) = +TPK%KC28(:) + PLOSS(:,64) = +TPK%KC28(:) ! !PPROD(WC_ASO5) = +KC24*<WC_ASO3>*<W_O2> - PPROD(:,64) = +TPK%KC24(:)*PCONC(:,62)*TPK%W_O2(:) + PPROD(:,65) = +TPK%KC24(:)*PCONC(:,63)*TPK%W_O2(:) !PLOSS(WC_ASO5) = +KC25*<WC_HO2>+KC26*<WC_ASO5>+KC26*<WC_ASO5> - PLOSS(:,64) = +TPK%KC25(:)*PCONC(:,53)+TPK%KC26(:)*PCONC(:,64)+TPK%KC26(:)*PCO& -&NC(:,64) + PLOSS(:,65) = +TPK%KC25(:)*PCONC(:,54)+TPK%KC26(:)*PCONC(:,65)+TPK%KC26(:)*PCO& +&NC(:,65) ! !PPROD(WC_AHSO5) = +KC25*<WC_ASO5>*<WC_HO2> - PPROD(:,65) = +TPK%KC25(:)*PCONC(:,64)*PCONC(:,53) + PPROD(:,66) = +TPK%KC25(:)*PCONC(:,65)*PCONC(:,54) !PLOSS(WC_AHSO5) = +KC27*<WC_SO2> - PLOSS(:,65) = +TPK%KC27(:)*PCONC(:,55) + PLOSS(:,66) = +TPK%KC27(:)*PCONC(:,56) ! !PPROD(WC_AHMS) = +KC21*<WC_SO2>*<WC_HCHO> - PPROD(:,66) = +TPK%KC21(:)*PCONC(:,55)*PCONC(:,57) + PPROD(:,67) = +TPK%KC21(:)*PCONC(:,56)*PCONC(:,58) !PLOSS(WC_AHMS) = +KC22+KC23*<WC_OH> - PLOSS(:,66) = +TPK%KC22(:)+TPK%KC23(:)*PCONC(:,52) + PLOSS(:,67) = +TPK%KC22(:)+TPK%KC23(:)*PCONC(:,53) ! !PPROD(WR_O3) = +KTR1*<O3> - PPROD(:,67) = +TPK%KTR1(:)*PCONC(:,1) + PPROD(:,68) = +TPK%KTR1(:)*PCONC(:,1) !PLOSS(WR_O3) = +KTR21+KR6*<WR_HO2>+KR29*<WR_SO2> - PLOSS(:,67) = +TPK%KTR21(:)+TPK%KR6(:)*PCONC(:,78)+TPK%KR29(:)*PCONC(:,80) + PLOSS(:,68) = +TPK%KTR21(:)+TPK%KR6(:)*PCONC(:,79)+TPK%KR29(:)*PCONC(:,81) ! !PPROD(WR_H2O2) = +KTR2*<H2O2>+KR2*<WR_OH>*<WR_OH>+KR5*<WR_HO2>*<WR_HO2> - PPROD(:,68) = +TPK%KTR2(:)*PCONC(:,2)+TPK%KR2(:)*PCONC(:,77)*PCONC(:,77)+TPK%K& -&R5(:)*PCONC(:,78)*PCONC(:,78) + PPROD(:,69) = +TPK%KTR2(:)*PCONC(:,2)+TPK%KR2(:)*PCONC(:,78)*PCONC(:,78)+TPK%K& +&R5(:)*PCONC(:,79)*PCONC(:,79) !PLOSS(WR_H2O2) = +KTR22+KR1+KR4*<WR_OH>+KR30*<WR_SO2> - PLOSS(:,68) = +TPK%KTR22(:)+TPK%KR1(:)+TPK%KR4(:)*PCONC(:,77)+TPK%KR30(:)*PCON& -&C(:,80) + PLOSS(:,69) = +TPK%KTR22(:)+TPK%KR1(:)+TPK%KR4(:)*PCONC(:,78)+TPK%KR30(:)*PCON& +&C(:,81) ! !PPROD(WR_NO) = +KTR3*<NO> - PPROD(:,69) = +TPK%KTR3(:)*PCONC(:,3) + PPROD(:,70) = +TPK%KTR3(:)*PCONC(:,3) !PLOSS(WR_NO) = +KTR23 - PLOSS(:,69) = +TPK%KTR23(:) -! -!PPROD(WR_NO2) = +KTR4*<NO2>+KR8*<WR_HONO>*<WR_OH>+KR10*<WR_HNO4>+KR13*<WR_HNO3 -!> - PPROD(:,70) = +TPK%KTR4(:)*PCONC(:,4)+TPK%KR8(:)*PCONC(:,73)*PCONC(:,77)+TPK%K& -&R10(:)*PCONC(:,75)+TPK%KR13(:)*PCONC(:,74) -!PLOSS(WR_NO2) = +KTR24+KR9*<WR_HO2> - PLOSS(:,70) = +TPK%KTR24(:)+TPK%KR9(:)*PCONC(:,78) + PLOSS(:,70) = +TPK%KTR23(:) ! RETURN END SUBROUTINE SUB6 @@ -4872,77 +4907,75 @@ SUBROUTINE SUB7 !Indices 71 a 80 ! ! +!PPROD(WR_NO2) = +KTR4*<NO2>+KR8*<WR_HONO>*<WR_OH>+KR10*<WR_HNO4>+KR13*<WR_HNO3 +!> + PPROD(:,71) = +TPK%KTR4(:)*PCONC(:,4)+TPK%KR8(:)*PCONC(:,74)*PCONC(:,78)+TPK%K& +&R10(:)*PCONC(:,76)+TPK%KR13(:)*PCONC(:,75) +!PLOSS(WR_NO2) = +KTR24+KR9*<WR_HO2> + PLOSS(:,71) = +TPK%KTR24(:)+TPK%KR9(:)*PCONC(:,79) +! !PPROD(WR_NO3) = +KTR5*<NO3> - PPROD(:,71) = +TPK%KTR5(:)*PCONC(:,5) + PPROD(:,72) = +TPK%KTR5(:)*PCONC(:,5) !PLOSS(WR_NO3) = +KTR25+KR15*<WR_SULF>+KR16*<WR_SO2> - PLOSS(:,71) = +TPK%KTR25(:)+TPK%KR15(:)*PCONC(:,81)+TPK%KR16(:)*PCONC(:,80) + PLOSS(:,72) = +TPK%KTR25(:)+TPK%KR15(:)*PCONC(:,82)+TPK%KR16(:)*PCONC(:,81) ! !PPROD(WR_N2O5) = +KTR6*<N2O5> - PPROD(:,72) = +TPK%KTR6(:)*PCONC(:,6) + PPROD(:,73) = +TPK%KTR6(:)*PCONC(:,6) !PLOSS(WR_N2O5) = +KTR26+KR14 - PLOSS(:,72) = +TPK%KTR26(:)+TPK%KR14(:) + PLOSS(:,73) = +TPK%KTR26(:)+TPK%KR14(:) ! !PPROD(WR_HONO) = +KTR7*<HONO>+KR11*<WR_HNO4> - PPROD(:,73) = +TPK%KTR7(:)*PCONC(:,7)+TPK%KR11(:)*PCONC(:,75) + PPROD(:,74) = +TPK%KTR7(:)*PCONC(:,7)+TPK%KR11(:)*PCONC(:,76) !PLOSS(WR_HONO) = +KTR27+KR8*<WR_OH> - PLOSS(:,73) = +TPK%KTR27(:)+TPK%KR8(:)*PCONC(:,77) + PLOSS(:,74) = +TPK%KTR27(:)+TPK%KR8(:)*PCONC(:,78) ! !PPROD(WR_HNO3) = +KTR8*<HNO3>+KR12*<WR_HNO4>*<WR_SO2>+KR14*<WR_N2O5>+KR14*<WR_ !N2O5>+KR15*<WR_NO3>*<WR_SULF>+KR16*<WR_NO3>*<WR_SO2> - PPROD(:,74) = +TPK%KTR8(:)*PCONC(:,8)+TPK%KR12(:)*PCONC(:,75)*PCONC(:,80)+TPK%& -&KR14(:)*PCONC(:,72)+TPK%KR14(:)*PCONC(:,72)+TPK%KR15(:)*PCONC(:,71)*PCONC(:,81& -&)+TPK%KR16(:)*PCONC(:,71)*PCONC(:,80) + PPROD(:,75) = +TPK%KTR8(:)*PCONC(:,8)+TPK%KR12(:)*PCONC(:,76)*PCONC(:,81)+TPK%& +&KR14(:)*PCONC(:,73)+TPK%KR14(:)*PCONC(:,73)+TPK%KR15(:)*PCONC(:,72)*PCONC(:,82& +&)+TPK%KR16(:)*PCONC(:,72)*PCONC(:,81) !PLOSS(WR_HNO3) = +KTR28+KR13 - PLOSS(:,74) = +TPK%KTR28(:)+TPK%KR13(:) + PLOSS(:,75) = +TPK%KTR28(:)+TPK%KR13(:) ! !PPROD(WR_HNO4) = +KTR9*<HNO4>+KR9*<WR_NO2>*<WR_HO2> - PPROD(:,75) = +TPK%KTR9(:)*PCONC(:,9)+TPK%KR9(:)*PCONC(:,70)*PCONC(:,78) + PPROD(:,76) = +TPK%KTR9(:)*PCONC(:,9)+TPK%KR9(:)*PCONC(:,71)*PCONC(:,79) !PLOSS(WR_HNO4) = +KTR29+KR10+KR11+KR12*<WR_SO2> - PLOSS(:,75) = +TPK%KTR29(:)+TPK%KR10(:)+TPK%KR11(:)+TPK%KR12(:)*PCONC(:,80) + PLOSS(:,76) = +TPK%KTR29(:)+TPK%KR10(:)+TPK%KR11(:)+TPK%KR12(:)*PCONC(:,81) ! !PPROD(WR_NH3) = +KTR10*<NH3> - PPROD(:,76) = +TPK%KTR10(:)*PCONC(:,10) + PPROD(:,77) = +TPK%KTR10(:)*PCONC(:,10) !PLOSS(WR_NH3) = +KTR30 - PLOSS(:,76) = +TPK%KTR30(:) + PLOSS(:,77) = +TPK%KTR30(:) ! !PPROD(WR_OH) = +KTR11*<OH>+KR1*<WR_H2O2>+KR1*<WR_H2O2>+KR6*<WR_O3>*<WR_HO2>+KR !13*<WR_HNO3>+KR28*<WR_ASO4> - PPROD(:,77) = +TPK%KTR11(:)*PCONC(:,14)+TPK%KR1(:)*PCONC(:,68)+TPK%KR1(:)*PCON& -&C(:,68)+TPK%KR6(:)*PCONC(:,67)*PCONC(:,78)+TPK%KR13(:)*PCONC(:,74)+TPK%KR28(:)& -&*PCONC(:,88) + PPROD(:,78) = +TPK%KTR11(:)*PCONC(:,15)+TPK%KR1(:)*PCONC(:,69)+TPK%KR1(:)*PCON& +&C(:,69)+TPK%KR6(:)*PCONC(:,68)*PCONC(:,79)+TPK%KR13(:)*PCONC(:,75)+TPK%KR28(:)& +&*PCONC(:,89) !PLOSS(WR_OH) = +KTR31+KR2*<WR_OH>+KR2*<WR_OH>+KR3*<WR_HO2>+KR4*<WR_H2O2>+KR7*< !WR_SO2>+KR8*<WR_HONO>+KR19*<WR_HCHO>+KR20*<WR_ORA1>+KR23*<WR_AHMS> - PLOSS(:,77) = +TPK%KTR31(:)+TPK%KR2(:)*PCONC(:,77)+TPK%KR2(:)*PCONC(:,77)+TPK%& -&KR3(:)*PCONC(:,78)+TPK%KR4(:)*PCONC(:,68)+TPK%KR7(:)*PCONC(:,80)+TPK%KR8(:)*PC& -&ONC(:,73)+TPK%KR19(:)*PCONC(:,82)+TPK%KR20(:)*PCONC(:,83)+TPK%KR23(:)*PCONC(:,& -&91) + PLOSS(:,78) = +TPK%KTR31(:)+TPK%KR2(:)*PCONC(:,78)+TPK%KR2(:)*PCONC(:,78)+TPK%& +&KR3(:)*PCONC(:,79)+TPK%KR4(:)*PCONC(:,69)+TPK%KR7(:)*PCONC(:,81)+TPK%KR8(:)*PC& +&ONC(:,74)+TPK%KR19(:)*PCONC(:,83)+TPK%KR20(:)*PCONC(:,84)+TPK%KR23(:)*PCONC(:,& +&92) ! !PPROD(WR_HO2) = +KTR12*<HO2>+KR4*<WR_H2O2>*<WR_OH>+KR10*<WR_HNO4>+2.00*KR17*<W !R_MO2>*<WR_MO2>+KR19*<WR_HCHO>*<WR_OH>+KR20*<WR_ORA1>*<WR_OH>+KR23*<WR_AHMS>*< !WR_OH> - PPROD(:,78) = +TPK%KTR12(:)*PCONC(:,15)+TPK%KR4(:)*PCONC(:,68)*PCONC(:,77)+TPK& -&%KR10(:)*PCONC(:,75)+2.00*TPK%KR17(:)*PCONC(:,85)*PCONC(:,85)+TPK%KR19(:)*PCON& -&C(:,82)*PCONC(:,77)+TPK%KR20(:)*PCONC(:,83)*PCONC(:,77)+TPK%KR23(:)*PCONC(:,91& -&)*PCONC(:,77) + PPROD(:,79) = +TPK%KTR12(:)*PCONC(:,16)+TPK%KR4(:)*PCONC(:,69)*PCONC(:,78)+TPK& +&%KR10(:)*PCONC(:,76)+2.00*TPK%KR17(:)*PCONC(:,86)*PCONC(:,86)+TPK%KR19(:)*PCON& +&C(:,83)*PCONC(:,78)+TPK%KR20(:)*PCONC(:,84)*PCONC(:,78)+TPK%KR23(:)*PCONC(:,92& +&)*PCONC(:,78) !PLOSS(WR_HO2) = +KTR32+KR3*<WR_OH>+KR5*<WR_HO2>+KR5*<WR_HO2>+KR6*<WR_O3>+KR9*< !WR_NO2>+KR25*<WR_ASO5> - PLOSS(:,78) = +TPK%KTR32(:)+TPK%KR3(:)*PCONC(:,77)+TPK%KR5(:)*PCONC(:,78)+TPK%& -&KR5(:)*PCONC(:,78)+TPK%KR6(:)*PCONC(:,67)+TPK%KR9(:)*PCONC(:,70)+TPK%KR25(:)*P& -&CONC(:,89) + PLOSS(:,79) = +TPK%KTR32(:)+TPK%KR3(:)*PCONC(:,78)+TPK%KR5(:)*PCONC(:,79)+TPK%& +&KR5(:)*PCONC(:,79)+TPK%KR6(:)*PCONC(:,68)+TPK%KR9(:)*PCONC(:,71)+TPK%KR25(:)*P& +&CONC(:,90) ! !PPROD(WR_CO2) = +KTR13*<CO2>+KR20*<WR_ORA1>*<WR_OH> - PPROD(:,79) = +TPK%KTR13(:)*TPK%CO2(:)+TPK%KR20(:)*PCONC(:,83)*PCONC(:,77) + PPROD(:,80) = +TPK%KTR13(:)*TPK%CO2(:)+TPK%KR20(:)*PCONC(:,84)*PCONC(:,78) !PLOSS(WR_CO2) = +KTR33 - PLOSS(:,79) = +TPK%KTR33(:) -! -!PPROD(WR_SO2) = +KTR14*<SO2>+KR22*<WR_AHMS>+KR23*<WR_AHMS>*<WR_OH> - PPROD(:,80) = +TPK%KTR14(:)*PCONC(:,11)+TPK%KR22(:)*PCONC(:,91)+TPK%KR23(:)*PC& -&ONC(:,91)*PCONC(:,77) -!PLOSS(WR_SO2) = +KTR34+KR7*<WR_OH>+KR12*<WR_HNO4>+KR16*<WR_NO3>+KR18*<WR_MO2>+ -!KR21*<WR_HCHO>+KR27*<WR_AHSO5>+KR29*<WR_O3>+KR30*<WR_H2O2> - PLOSS(:,80) = +TPK%KTR34(:)+TPK%KR7(:)*PCONC(:,77)+TPK%KR12(:)*PCONC(:,75)+TPK& -&%KR16(:)*PCONC(:,71)+TPK%KR18(:)*PCONC(:,85)+TPK%KR21(:)*PCONC(:,82)+TPK%KR27(& -&:)*PCONC(:,90)+TPK%KR29(:)*PCONC(:,67)+TPK%KR30(:)*PCONC(:,68) + PLOSS(:,80) = +TPK%KTR33(:) ! RETURN END SUBROUTINE SUB7 @@ -4952,79 +4985,88 @@ SUBROUTINE SUB8 !Indices 81 a 90 ! ! +!PPROD(WR_SO2) = +KTR14*<SO2>+KR22*<WR_AHMS>+KR23*<WR_AHMS>*<WR_OH> + PPROD(:,81) = +TPK%KTR14(:)*PCONC(:,12)+TPK%KR22(:)*PCONC(:,92)+TPK%KR23(:)*PC& +&ONC(:,92)*PCONC(:,78) +!PLOSS(WR_SO2) = +KTR34+KR7*<WR_OH>+KR12*<WR_HNO4>+KR16*<WR_NO3>+KR18*<WR_MO2>+ +!KR21*<WR_HCHO>+KR27*<WR_AHSO5>+KR29*<WR_O3>+KR30*<WR_H2O2> + PLOSS(:,81) = +TPK%KTR34(:)+TPK%KR7(:)*PCONC(:,78)+TPK%KR12(:)*PCONC(:,76)+TPK& +&%KR16(:)*PCONC(:,72)+TPK%KR18(:)*PCONC(:,86)+TPK%KR21(:)*PCONC(:,83)+TPK%KR27(& +&:)*PCONC(:,91)+TPK%KR29(:)*PCONC(:,68)+TPK%KR30(:)*PCONC(:,69) +! !PPROD(WR_SULF) = +KTR15*<SULF>+KR12*<WR_HNO4>*<WR_SO2>+2.00*KR27*<WR_AHSO5>*<W !R_SO2>+KR28*<WR_ASO4>+KR29*<WR_SO2>*<WR_O3>+KR30*<WR_SO2>*<WR_H2O2> - PPROD(:,81) = +TPK%KTR15(:)*PCONC(:,12)+TPK%KR12(:)*PCONC(:,75)*PCONC(:,80)+2.& -&00*TPK%KR27(:)*PCONC(:,90)*PCONC(:,80)+TPK%KR28(:)*PCONC(:,88)+TPK%KR29(:)*PCO& -&NC(:,80)*PCONC(:,67)+TPK%KR30(:)*PCONC(:,80)*PCONC(:,68) + PPROD(:,82) = +TPK%KTR15(:)*PCONC(:,13)+TPK%KR12(:)*PCONC(:,76)*PCONC(:,81)+2.& +&00*TPK%KR27(:)*PCONC(:,91)*PCONC(:,81)+TPK%KR28(:)*PCONC(:,89)+TPK%KR29(:)*PCO& +&NC(:,81)*PCONC(:,68)+TPK%KR30(:)*PCONC(:,81)*PCONC(:,69) !PLOSS(WR_SULF) = +KTR35+KR15*<WR_NO3> - PLOSS(:,81) = +TPK%KTR35(:)+TPK%KR15(:)*PCONC(:,71) + PLOSS(:,82) = +TPK%KTR35(:)+TPK%KR15(:)*PCONC(:,72) ! !PPROD(WR_HCHO) = +KTR16*<HCHO>+2.00*KR17*<WR_MO2>*<WR_MO2>+KR22*<WR_AHMS> - PPROD(:,82) = +TPK%KTR16(:)*PCONC(:,22)+2.00*TPK%KR17(:)*PCONC(:,85)*PCONC(:,8& -&5)+TPK%KR22(:)*PCONC(:,91) + PPROD(:,83) = +TPK%KTR16(:)*PCONC(:,23)+2.00*TPK%KR17(:)*PCONC(:,86)*PCONC(:,8& +&6)+TPK%KR22(:)*PCONC(:,92) !PLOSS(WR_HCHO) = +KTR36+KR19*<WR_OH>+KR21*<WR_SO2> - PLOSS(:,82) = +TPK%KTR36(:)+TPK%KR19(:)*PCONC(:,77)+TPK%KR21(:)*PCONC(:,80) + PLOSS(:,83) = +TPK%KTR36(:)+TPK%KR19(:)*PCONC(:,78)+TPK%KR21(:)*PCONC(:,81) ! !PPROD(WR_ORA1) = +KTR17*<ORA1>+KR19*<WR_HCHO>*<WR_OH>+KR23*<WR_AHMS>*<WR_OH> - PPROD(:,83) = +TPK%KTR17(:)*PCONC(:,30)+TPK%KR19(:)*PCONC(:,82)*PCONC(:,77)+TP& -&K%KR23(:)*PCONC(:,91)*PCONC(:,77) + PPROD(:,84) = +TPK%KTR17(:)*PCONC(:,31)+TPK%KR19(:)*PCONC(:,83)*PCONC(:,78)+TP& +&K%KR23(:)*PCONC(:,92)*PCONC(:,78) !PLOSS(WR_ORA1) = +KTR37+KR20*<WR_OH> - PLOSS(:,83) = +TPK%KTR37(:)+TPK%KR20(:)*PCONC(:,77) + PLOSS(:,84) = +TPK%KTR37(:)+TPK%KR20(:)*PCONC(:,78) ! !PPROD(WR_ORA2) = +KTR18*<ORA2> - PPROD(:,84) = +TPK%KTR18(:)*PCONC(:,31) + PPROD(:,85) = +TPK%KTR18(:)*PCONC(:,32) !PLOSS(WR_ORA2) = +KTR38 - PLOSS(:,84) = +TPK%KTR38(:) + PLOSS(:,85) = +TPK%KTR38(:) ! !PPROD(WR_MO2) = +KTR19*<MO2> - PPROD(:,85) = +TPK%KTR19(:)*PCONC(:,32) + PPROD(:,86) = +TPK%KTR19(:)*PCONC(:,33) !PLOSS(WR_MO2) = +KTR39+KR17*<WR_MO2>+KR17*<WR_MO2>+KR18*<WR_SO2> - PLOSS(:,85) = +TPK%KTR39(:)+TPK%KR17(:)*PCONC(:,85)+TPK%KR17(:)*PCONC(:,85)+TP& -&K%KR18(:)*PCONC(:,80) + PLOSS(:,86) = +TPK%KTR39(:)+TPK%KR17(:)*PCONC(:,86)+TPK%KR17(:)*PCONC(:,86)+TP& +&K%KR18(:)*PCONC(:,81) ! !PPROD(WR_OP1) = +KTR20*<OP1>+KR18*<WR_MO2>*<WR_SO2> - PPROD(:,86) = +TPK%KTR20(:)*PCONC(:,28)+TPK%KR18(:)*PCONC(:,85)*PCONC(:,80) + PPROD(:,87) = +TPK%KTR20(:)*PCONC(:,29)+TPK%KR18(:)*PCONC(:,86)*PCONC(:,81) !PLOSS(WR_OP1) = +KTR40 - PLOSS(:,86) = +TPK%KTR40(:) + PLOSS(:,87) = +TPK%KTR40(:) ! !PPROD(WR_ASO3) = +KR7*<WR_OH>*<WR_SO2>+KR16*<WR_NO3>*<WR_SO2>+KR18*<WR_MO2>*<W !R_SO2> - PPROD(:,87) = +TPK%KR7(:)*PCONC(:,77)*PCONC(:,80)+TPK%KR16(:)*PCONC(:,71)*PCON& -&C(:,80)+TPK%KR18(:)*PCONC(:,85)*PCONC(:,80) + PPROD(:,88) = +TPK%KR7(:)*PCONC(:,78)*PCONC(:,81)+TPK%KR16(:)*PCONC(:,72)*PCON& +&C(:,81)+TPK%KR18(:)*PCONC(:,86)*PCONC(:,81) !PLOSS(WR_ASO3) = +KR24*<W_O2> - PLOSS(:,87) = +TPK%KR24(:)*TPK%W_O2(:) + PLOSS(:,88) = +TPK%KR24(:)*TPK%W_O2(:) ! !PPROD(WR_ASO4) = +KR15*<WR_NO3>*<WR_SULF>+KR26*<WR_ASO5>*<WR_ASO5>+KR26*<WR_AS !O5>*<WR_ASO5> - PPROD(:,88) = +TPK%KR15(:)*PCONC(:,71)*PCONC(:,81)+TPK%KR26(:)*PCONC(:,89)*PCO& -&NC(:,89)+TPK%KR26(:)*PCONC(:,89)*PCONC(:,89) + PPROD(:,89) = +TPK%KR15(:)*PCONC(:,72)*PCONC(:,82)+TPK%KR26(:)*PCONC(:,90)*PCO& +&NC(:,90)+TPK%KR26(:)*PCONC(:,90)*PCONC(:,90) !PLOSS(WR_ASO4) = +KR28 - PLOSS(:,88) = +TPK%KR28(:) + PLOSS(:,89) = +TPK%KR28(:) ! !PPROD(WR_ASO5) = +KR24*<WR_ASO3>*<W_O2> - PPROD(:,89) = +TPK%KR24(:)*PCONC(:,87)*TPK%W_O2(:) + PPROD(:,90) = +TPK%KR24(:)*PCONC(:,88)*TPK%W_O2(:) !PLOSS(WR_ASO5) = +KR25*<WR_HO2>+KR26*<WR_ASO5>+KR26*<WR_ASO5> - PLOSS(:,89) = +TPK%KR25(:)*PCONC(:,78)+TPK%KR26(:)*PCONC(:,89)+TPK%KR26(:)*PCO& -&NC(:,89) -! -!PPROD(WR_AHSO5) = +KR25*<WR_ASO5>*<WR_HO2> - PPROD(:,90) = +TPK%KR25(:)*PCONC(:,89)*PCONC(:,78) -!PLOSS(WR_AHSO5) = +KR27*<WR_SO2> - PLOSS(:,90) = +TPK%KR27(:)*PCONC(:,80) + PLOSS(:,90) = +TPK%KR25(:)*PCONC(:,79)+TPK%KR26(:)*PCONC(:,90)+TPK%KR26(:)*PCO& +&NC(:,90) ! RETURN END SUBROUTINE SUB8 ! SUBROUTINE SUB9 ! -!Indices 91 a 91 +!Indices 91 a 92 ! ! +!PPROD(WR_AHSO5) = +KR25*<WR_ASO5>*<WR_HO2> + PPROD(:,91) = +TPK%KR25(:)*PCONC(:,90)*PCONC(:,79) +!PLOSS(WR_AHSO5) = +KR27*<WR_SO2> + PLOSS(:,91) = +TPK%KR27(:)*PCONC(:,81) +! !PPROD(WR_AHMS) = +KR21*<WR_SO2>*<WR_HCHO> - PPROD(:,91) = +TPK%KR21(:)*PCONC(:,80)*PCONC(:,82) + PPROD(:,92) = +TPK%KR21(:)*PCONC(:,81)*PCONC(:,83) !PLOSS(WR_AHMS) = +KR22+KR23*<WR_OH> - PLOSS(:,91) = +TPK%KR22(:)+TPK%KR23(:)*PCONC(:,77) + PLOSS(:,92) = +TPK%KR22(:)+TPK%KR23(:)*PCONC(:,78) ! RETURN END SUBROUTINE SUB9 @@ -5116,7 +5158,7 @@ TPK%O3P(:)=(TPK%K001(:)*PCONC(:,JP_NO2)+TPK%K003(:)*PCONC(:,JP_O3)+TPK%K008(:)*P &0.09000*TPK%K080(:)*PCONC(:,JP_BIO)*PCONC(:,JP_O3))/& &(TPK%K018(:)*TPK%O2(:)+TPK%K019(:)*PCONC(:,JP_O3)+TPK%K029(:)*PCONC(:,JP_NO)+& &TPK%K030(:)*PCONC(:,JP_NO2)+TPK%K031(:)*PCONC(:,JP_NO2)+TPK%K054(:)*PCONC(:,JP_BIO)+& - &TPK%K055(:)*PCONC(:,JP_CARBO)) + &TPK%K055(:)*PCONC(:,JP_CARBO)+TPK%K134(:)*PCONC(:,JP_DMS)) ! /END_CODE/ CALL SUB0 CALL SUB1 @@ -5132,22 +5174,22 @@ SUBROUTINE SUB0 ! ! !PPROD(O3) = +K018*<O3P>*<O2>+0.17307*K0102*<CARBOP>*<HO2> - PPROD(:,1) = +TPK%K018(:)*TPK%O3P(:)*TPK%O2(:)+0.17307*TPK%K0102(:)*PCONC(:,39& -&)*PCONC(:,15) + PPROD(:,1) = +TPK%K018(:)*TPK%O3P(:)*TPK%O2(:)+0.17307*TPK%K0102(:)*PCONC(:,40& +&)*PCONC(:,16) !PLOSS(O3) = +K002+K003+K019*<O3P>+K023*<OH>+K024*<HO2>+K042*<NO>+K043*<NO2>+K0 !79*<ALKE>+K080*<BIO>+K081*<CARBO>+K082*<PAN>+K087*<ADD> PLOSS(:,1) = +TPK%K002(:)+TPK%K003(:)+TPK%K019(:)*TPK%O3P(:)+TPK%K023(:)*PCONC& -&(:,14)+TPK%K024(:)*PCONC(:,15)+TPK%K042(:)*PCONC(:,3)+TPK%K043(:)*PCONC(:,4)+T& -&PK%K079(:)*PCONC(:,19)+TPK%K080(:)*PCONC(:,20)+TPK%K081(:)*PCONC(:,25)+TPK%K08& -&2(:)*PCONC(:,27)+TPK%K087(:)*PCONC(:,37) +&(:,15)+TPK%K024(:)*PCONC(:,16)+TPK%K042(:)*PCONC(:,3)+TPK%K043(:)*PCONC(:,4)+T& +&PK%K079(:)*PCONC(:,20)+TPK%K080(:)*PCONC(:,21)+TPK%K081(:)*PCONC(:,26)+TPK%K08& +&2(:)*PCONC(:,28)+TPK%K087(:)*PCONC(:,38) ! !PPROD(H2O2) = +K027*<HO2>*<HO2>+K028*<HO2>*<HO2>*<H2O>+0.01833*K079*<ALKE>*<O3 !>+0.00100*K080*<BIO>*<O3> - PPROD(:,2) = +TPK%K027(:)*PCONC(:,15)*PCONC(:,15)+TPK%K028(:)*PCONC(:,15)*PCON& -&C(:,15)*TPK%H2O(:)+0.01833*TPK%K079(:)*PCONC(:,19)*PCONC(:,1)+0.00100*TPK%K080& -&(:)*PCONC(:,20)*PCONC(:,1) + PPROD(:,2) = +TPK%K027(:)*PCONC(:,16)*PCONC(:,16)+TPK%K028(:)*PCONC(:,16)*PCON& +&C(:,16)*TPK%H2O(:)+0.01833*TPK%K079(:)*PCONC(:,20)*PCONC(:,1)+0.00100*TPK%K080& +&(:)*PCONC(:,21)*PCONC(:,1) !PLOSS(H2O2) = +K009+K026*<OH> - PLOSS(:,2) = +TPK%K009(:)+TPK%K026(:)*PCONC(:,14) + PLOSS(:,2) = +TPK%K009(:)+TPK%K026(:)*PCONC(:,15) ! !PPROD(NO) = +K001*<NO2>+K004*<HONO>+K007*<NO3>+K030*<O3P>*<NO2>+K046*<NO3>*<NO !2> @@ -5156,11 +5198,11 @@ SUBROUTINE SUB0 !PLOSS(NO) = +K029*<O3P>+K032*<OH>+K035*<HO2>+K042*<O3>+K044*<NO>*<O2>+K044*<NO !>*<O2>+K045*<NO3>+K090*<MO2>+K091*<ALKAP>+K092*<ALKEP>+K093*<BIOP>+K094*<AROP> !+K095*<CARBOP>+K096*<OLN>+K130*<XO2> - PLOSS(:,3) = +TPK%K029(:)*TPK%O3P(:)+TPK%K032(:)*PCONC(:,14)+TPK%K035(:)*PCONC& -&(:,15)+TPK%K042(:)*PCONC(:,1)+TPK%K044(:)*PCONC(:,3)*TPK%O2(:)+TPK%K044(:)*PCO& -&NC(:,3)*TPK%O2(:)+TPK%K045(:)*PCONC(:,5)+TPK%K090(:)*PCONC(:,32)+TPK%K091(:)*P& -&CONC(:,33)+TPK%K092(:)*PCONC(:,34)+TPK%K093(:)*PCONC(:,35)+TPK%K094(:)*PCONC(:& -&,38)+TPK%K095(:)*PCONC(:,39)+TPK%K096(:)*PCONC(:,40)+TPK%K130(:)*PCONC(:,41) + PLOSS(:,3) = +TPK%K029(:)*TPK%O3P(:)+TPK%K032(:)*PCONC(:,15)+TPK%K035(:)*PCONC& +&(:,16)+TPK%K042(:)*PCONC(:,1)+TPK%K044(:)*PCONC(:,3)*TPK%O2(:)+TPK%K044(:)*PCO& +&NC(:,3)*TPK%O2(:)+TPK%K045(:)*PCONC(:,5)+TPK%K090(:)*PCONC(:,33)+TPK%K091(:)*P& +&CONC(:,34)+TPK%K092(:)*PCONC(:,35)+TPK%K093(:)*PCONC(:,36)+TPK%K094(:)*PCONC(:& +&,39)+TPK%K095(:)*PCONC(:,40)+TPK%K096(:)*PCONC(:,41)+TPK%K130(:)*PCONC(:,42) ! !PPROD(NO2) = +K005*<HNO3>+0.65*K006*<HNO4>+K008*<NO3>+K017*<ONIT>+K029*<O3P>*< !NO>+K034*<OH>*<NO3>+K035*<HO2>*<NO>+K037*<HNO4>+0.7*K038*<HO2>*<NO3>+K039*<OH> @@ -5172,53 +5214,53 @@ SUBROUTINE SUB0 !ARBOP>*<NO>+1.81599*K096*<OLN>*<NO>+0.32440*K110*<OLN>*<MO2>+0.00000*K116*<OLN !>*<CARBOP>+0.00000*K118*<OLN>*<OLN>+K119*<MO2>*<NO3>+K120*<ALKAP>*<NO3>+K121*< !ALKEP>*<NO3>+K122*<BIOP>*<NO3>+K123*<AROP>*<NO3>+K124*<CARBOP>*<NO3>+1.74072*K -!125*<OLN>*<NO3>+K130*<XO2>*<NO>+K131*<XO2>*<NO3> +!125*<OLN>*<NO3>+K130*<XO2>*<NO>+K131*<XO2>*<NO3>+K133*<DMS>*<NO3> PPROD(:,4) = +TPK%K005(:)*PCONC(:,8)+0.65*TPK%K006(:)*PCONC(:,9)+TPK%K008(:)*P& -&CONC(:,5)+TPK%K017(:)*PCONC(:,26)+TPK%K029(:)*TPK%O3P(:)*PCONC(:,3)+TPK%K034(:& -&)*PCONC(:,14)*PCONC(:,5)+TPK%K035(:)*PCONC(:,15)*PCONC(:,3)+TPK%K037(:)*PCONC(& -&:,9)+0.7*TPK%K038(:)*PCONC(:,15)*PCONC(:,5)+TPK%K039(:)*PCONC(:,14)*PCONC(:,7)& -&+TPK%K041(:)*PCONC(:,14)*PCONC(:,9)+TPK%K042(:)*PCONC(:,1)*PCONC(:,3)+TPK%K044& +&CONC(:,5)+TPK%K017(:)*PCONC(:,27)+TPK%K029(:)*TPK%O3P(:)*PCONC(:,3)+TPK%K034(:& +&)*PCONC(:,15)*PCONC(:,5)+TPK%K035(:)*PCONC(:,16)*PCONC(:,3)+TPK%K037(:)*PCONC(& +&:,9)+0.7*TPK%K038(:)*PCONC(:,16)*PCONC(:,5)+TPK%K039(:)*PCONC(:,15)*PCONC(:,7)& +&+TPK%K041(:)*PCONC(:,15)*PCONC(:,9)+TPK%K042(:)*PCONC(:,1)*PCONC(:,3)+TPK%K044& &(:)*PCONC(:,3)*PCONC(:,3)*TPK%O2(:)+TPK%K044(:)*PCONC(:,3)*PCONC(:,3)*TPK%O2(:& &)+TPK%K045(:)*PCONC(:,5)*PCONC(:,3)+TPK%K045(:)*PCONC(:,5)*PCONC(:,3)+TPK%K046& &(:)*PCONC(:,5)*PCONC(:,4)+TPK%K048(:)*PCONC(:,6)+TPK%K049(:)*PCONC(:,5)*PCONC(& -&:,5)+TPK%K049(:)*PCONC(:,5)*PCONC(:,5)+TPK%K071(:)*PCONC(:,26)*PCONC(:,14)+0.1& -&0530*TPK%K074(:)*PCONC(:,25)*PCONC(:,5)+0.40*TPK%K078(:)*PCONC(:,27)*PCONC(:,5& -&)+0.70*TPK%K082(:)*PCONC(:,27)*PCONC(:,1)+TPK%K089(:)*PCONC(:,27)+TPK%K090(:)*& -&PCONC(:,32)*PCONC(:,3)+0.91541*TPK%K091(:)*PCONC(:,33)*PCONC(:,3)+TPK%K092(:)*& -&PCONC(:,34)*PCONC(:,3)+0.84700*TPK%K093(:)*PCONC(:,35)*PCONC(:,3)+0.95115*TPK%& -&K094(:)*PCONC(:,38)*PCONC(:,3)+TPK%K095(:)*PCONC(:,39)*PCONC(:,3)+1.81599*TPK%& -&K096(:)*PCONC(:,40)*PCONC(:,3)+0.32440*TPK%K110(:)*PCONC(:,40)*PCONC(:,32)+0.0& -&0000*TPK%K116(:)*PCONC(:,40)*PCONC(:,39)+0.00000*TPK%K118(:)*PCONC(:,40)*PCONC& -&(:,40)+TPK%K119(:)*PCONC(:,32)*PCONC(:,5)+TPK%K120(:)*PCONC(:,33)*PCONC(:,5)+T& -&PK%K121(:)*PCONC(:,34)*PCONC(:,5)+TPK%K122(:)*PCONC(:,35)*PCONC(:,5)+TPK%K123(& -&:)*PCONC(:,38)*PCONC(:,5)+TPK%K124(:)*PCONC(:,39)*PCONC(:,5)+1.74072*TPK%K125(& -&:)*PCONC(:,40)*PCONC(:,5)+TPK%K130(:)*PCONC(:,41)*PCONC(:,3)+TPK%K131(:)*PCONC& -&(:,41)*PCONC(:,5) +&:,5)+TPK%K049(:)*PCONC(:,5)*PCONC(:,5)+TPK%K071(:)*PCONC(:,27)*PCONC(:,15)+0.1& +&0530*TPK%K074(:)*PCONC(:,26)*PCONC(:,5)+0.40*TPK%K078(:)*PCONC(:,28)*PCONC(:,5& +&)+0.70*TPK%K082(:)*PCONC(:,28)*PCONC(:,1)+TPK%K089(:)*PCONC(:,28)+TPK%K090(:)*& +&PCONC(:,33)*PCONC(:,3)+0.91541*TPK%K091(:)*PCONC(:,34)*PCONC(:,3)+TPK%K092(:)*& +&PCONC(:,35)*PCONC(:,3)+0.84700*TPK%K093(:)*PCONC(:,36)*PCONC(:,3)+0.95115*TPK%& +&K094(:)*PCONC(:,39)*PCONC(:,3)+TPK%K095(:)*PCONC(:,40)*PCONC(:,3)+1.81599*TPK%& +&K096(:)*PCONC(:,41)*PCONC(:,3)+0.32440*TPK%K110(:)*PCONC(:,41)*PCONC(:,33)+0.0& +&0000*TPK%K116(:)*PCONC(:,41)*PCONC(:,40)+0.00000*TPK%K118(:)*PCONC(:,41)*PCONC& +&(:,41)+TPK%K119(:)*PCONC(:,33)*PCONC(:,5)+TPK%K120(:)*PCONC(:,34)*PCONC(:,5)+T& +&PK%K121(:)*PCONC(:,35)*PCONC(:,5)+TPK%K122(:)*PCONC(:,36)*PCONC(:,5)+TPK%K123(& +&:)*PCONC(:,39)*PCONC(:,5)+TPK%K124(:)*PCONC(:,40)*PCONC(:,5)+1.74072*TPK%K125(& +&:)*PCONC(:,41)*PCONC(:,5)+TPK%K130(:)*PCONC(:,42)*PCONC(:,3)+TPK%K131(:)*PCONC& +&(:,42)*PCONC(:,5)+TPK%K133(:)*PCONC(:,11)*PCONC(:,5) !PLOSS(NO2) = +K001+K030*<O3P>+K031*<O3P>+K033*<OH>+K036*<HO2>+K043*<O3>+K046*< !NO3>+K047*<NO3>+K083*<PHO>+K085*<ADD>+K088*<CARBOP> PLOSS(:,4) = +TPK%K001(:)+TPK%K030(:)*TPK%O3P(:)+TPK%K031(:)*TPK%O3P(:)+TPK%K0& -&33(:)*PCONC(:,14)+TPK%K036(:)*PCONC(:,15)+TPK%K043(:)*PCONC(:,1)+TPK%K046(:)*P& -&CONC(:,5)+TPK%K047(:)*PCONC(:,5)+TPK%K083(:)*PCONC(:,36)+TPK%K085(:)*PCONC(:,3& -&7)+TPK%K088(:)*PCONC(:,39) +&33(:)*PCONC(:,15)+TPK%K036(:)*PCONC(:,16)+TPK%K043(:)*PCONC(:,1)+TPK%K046(:)*P& +&CONC(:,5)+TPK%K047(:)*PCONC(:,5)+TPK%K083(:)*PCONC(:,37)+TPK%K085(:)*PCONC(:,3& +&8)+TPK%K088(:)*PCONC(:,40) ! !PPROD(NO3) = +0.35*K006*<HNO4>+K031*<O3P>*<NO2>+K040*<OH>*<HNO3>+K043*<O3>*<NO !2>+K048*<N2O5>+0.71893*K070*<PAN>*<OH>+0.60*K078*<PAN>*<NO3> PPROD(:,5) = +0.35*TPK%K006(:)*PCONC(:,9)+TPK%K031(:)*TPK%O3P(:)*PCONC(:,4)+TP& -&K%K040(:)*PCONC(:,14)*PCONC(:,8)+TPK%K043(:)*PCONC(:,1)*PCONC(:,4)+TPK%K048(:)& -&*PCONC(:,6)+0.71893*TPK%K070(:)*PCONC(:,27)*PCONC(:,14)+0.60*TPK%K078(:)*PCONC& -&(:,27)*PCONC(:,5) +&K%K040(:)*PCONC(:,15)*PCONC(:,8)+TPK%K043(:)*PCONC(:,1)*PCONC(:,4)+TPK%K048(:)& +&*PCONC(:,6)+0.71893*TPK%K070(:)*PCONC(:,28)*PCONC(:,15)+0.60*TPK%K078(:)*PCONC& +&(:,28)*PCONC(:,5) !PLOSS(NO3) = +K007+K008+K034*<OH>+K038*<HO2>+K045*<NO>+K046*<NO2>+K047*<NO2>+K !049*<NO3>+K049*<NO3>+K072*<HCHO>+K073*<ALD>+K074*<CARBO>+K075*<ARO>+K076*<ALKE !>+K077*<BIO>+K078*<PAN>+K119*<MO2>+K120*<ALKAP>+K121*<ALKEP>+K122*<BIOP>+K123* -!<AROP>+K124*<CARBOP>+K125*<OLN>+K131*<XO2> - PLOSS(:,5) = +TPK%K007(:)+TPK%K008(:)+TPK%K034(:)*PCONC(:,14)+TPK%K038(:)*PCON& -&C(:,15)+TPK%K045(:)*PCONC(:,3)+TPK%K046(:)*PCONC(:,4)+TPK%K047(:)*PCONC(:,4)+T& -&PK%K049(:)*PCONC(:,5)+TPK%K049(:)*PCONC(:,5)+TPK%K072(:)*PCONC(:,22)+TPK%K073(& -&:)*PCONC(:,23)+TPK%K074(:)*PCONC(:,25)+TPK%K075(:)*PCONC(:,21)+TPK%K076(:)*PCO& -&NC(:,19)+TPK%K077(:)*PCONC(:,20)+TPK%K078(:)*PCONC(:,27)+TPK%K119(:)*PCONC(:,3& -&2)+TPK%K120(:)*PCONC(:,33)+TPK%K121(:)*PCONC(:,34)+TPK%K122(:)*PCONC(:,35)+TPK& -&%K123(:)*PCONC(:,38)+TPK%K124(:)*PCONC(:,39)+TPK%K125(:)*PCONC(:,40)+TPK%K131(& -&:)*PCONC(:,41) +!<AROP>+K124*<CARBOP>+K125*<OLN>+K131*<XO2>+K133*<DMS> + PLOSS(:,5) = +TPK%K007(:)+TPK%K008(:)+TPK%K034(:)*PCONC(:,15)+TPK%K038(:)*PCON& +&C(:,16)+TPK%K045(:)*PCONC(:,3)+TPK%K046(:)*PCONC(:,4)+TPK%K047(:)*PCONC(:,4)+T& +&PK%K049(:)*PCONC(:,5)+TPK%K049(:)*PCONC(:,5)+TPK%K072(:)*PCONC(:,23)+TPK%K073(& +&:)*PCONC(:,24)+TPK%K074(:)*PCONC(:,26)+TPK%K075(:)*PCONC(:,22)+TPK%K076(:)*PCO& +&NC(:,20)+TPK%K077(:)*PCONC(:,21)+TPK%K078(:)*PCONC(:,28)+TPK%K119(:)*PCONC(:,3& +&3)+TPK%K120(:)*PCONC(:,34)+TPK%K121(:)*PCONC(:,35)+TPK%K122(:)*PCONC(:,36)+TPK& +&%K123(:)*PCONC(:,39)+TPK%K124(:)*PCONC(:,40)+TPK%K125(:)*PCONC(:,41)+TPK%K131(& +&:)*PCONC(:,42)+TPK%K133(:)*PCONC(:,11) ! !PPROD(N2O5) = +K047*<NO3>*<NO2> PPROD(:,6) = +TPK%K047(:)*PCONC(:,5)*PCONC(:,4) @@ -5226,29 +5268,29 @@ SUBROUTINE SUB0 PLOSS(:,6) = +TPK%K048(:) ! !PPROD(HONO) = +K032*<OH>*<NO>+K085*<ADD>*<NO2> - PPROD(:,7) = +TPK%K032(:)*PCONC(:,14)*PCONC(:,3)+TPK%K085(:)*PCONC(:,37)*PCONC& + PPROD(:,7) = +TPK%K032(:)*PCONC(:,15)*PCONC(:,3)+TPK%K085(:)*PCONC(:,38)*PCONC& &(:,4) !PLOSS(HONO) = +K004+K039*<OH> - PLOSS(:,7) = +TPK%K004(:)+TPK%K039(:)*PCONC(:,14) + PLOSS(:,7) = +TPK%K004(:)+TPK%K039(:)*PCONC(:,15) ! !PPROD(HNO3) = +K033*<OH>*<NO2>+0.3*K038*<HO2>*<NO3>+K072*<HCHO>*<NO3>+K073*<AL !D>*<NO3>+0.91567*K074*<CARBO>*<NO3>+K075*<ARO>*<NO3> - PPROD(:,8) = +TPK%K033(:)*PCONC(:,14)*PCONC(:,4)+0.3*TPK%K038(:)*PCONC(:,15)*P& -&CONC(:,5)+TPK%K072(:)*PCONC(:,22)*PCONC(:,5)+TPK%K073(:)*PCONC(:,23)*PCONC(:,5& -&)+0.91567*TPK%K074(:)*PCONC(:,25)*PCONC(:,5)+TPK%K075(:)*PCONC(:,21)*PCONC(:,5& + PPROD(:,8) = +TPK%K033(:)*PCONC(:,15)*PCONC(:,4)+0.3*TPK%K038(:)*PCONC(:,16)*P& +&CONC(:,5)+TPK%K072(:)*PCONC(:,23)*PCONC(:,5)+TPK%K073(:)*PCONC(:,24)*PCONC(:,5& +&)+0.91567*TPK%K074(:)*PCONC(:,26)*PCONC(:,5)+TPK%K075(:)*PCONC(:,22)*PCONC(:,5& &) !PLOSS(HNO3) = +K005+K040*<OH> - PLOSS(:,8) = +TPK%K005(:)+TPK%K040(:)*PCONC(:,14) + PLOSS(:,8) = +TPK%K005(:)+TPK%K040(:)*PCONC(:,15) ! !PPROD(HNO4) = +K036*<HO2>*<NO2> - PPROD(:,9) = +TPK%K036(:)*PCONC(:,15)*PCONC(:,4) + PPROD(:,9) = +TPK%K036(:)*PCONC(:,16)*PCONC(:,4) !PLOSS(HNO4) = +K006+K037+K041*<OH> - PLOSS(:,9) = +TPK%K006(:)+TPK%K037(:)+TPK%K041(:)*PCONC(:,14) + PLOSS(:,9) = +TPK%K006(:)+TPK%K037(:)+TPK%K041(:)*PCONC(:,15) ! !PPROD(NH3) = 0.0 PPROD(:,10) = 0.0 !PLOSS(NH3) = +K050*<OH> - PLOSS(:,10) = +TPK%K050(:)*PCONC(:,14) + PLOSS(:,10) = +TPK%K050(:)*PCONC(:,15) ! RETURN END SUBROUTINE SUB0 @@ -5258,29 +5300,36 @@ SUBROUTINE SUB1 !Indices 11 a 20 ! ! -!PPROD(SO2) = 0.0 +!PPROD(DMS) = 0.0 PPROD(:,11) = 0.0 +!PLOSS(DMS) = +K133*<NO3>+K134*<O3P>+K135*<OH> + PLOSS(:,11) = +TPK%K133(:)*PCONC(:,5)+TPK%K134(:)*TPK%O3P(:)+TPK%K135(:)*PCONC& +&(:,15) +! +!PPROD(SO2) = +K133*<DMS>*<NO3>+K134*<DMS>*<O3P>+0.8*K135*<DMS>*<OH> + PPROD(:,12) = +TPK%K133(:)*PCONC(:,11)*PCONC(:,5)+TPK%K134(:)*PCONC(:,11)*TPK%& +&O3P(:)+0.8*TPK%K135(:)*PCONC(:,11)*PCONC(:,15) !PLOSS(SO2) = +K052*<OH> - PLOSS(:,11) = +TPK%K052(:)*PCONC(:,14) + PLOSS(:,12) = +TPK%K052(:)*PCONC(:,15) ! !PPROD(SULF) = +K052*<OH>*<SO2> - PPROD(:,12) = +TPK%K052(:)*PCONC(:,14)*PCONC(:,11) + PPROD(:,13) = +TPK%K052(:)*PCONC(:,15)*PCONC(:,12) !PLOSS(SULF) = +K132 - PLOSS(:,12) = +TPK%K132(:) + PLOSS(:,13) = +TPK%K132(:) ! !PPROD(CO) = +K010*<HCHO>+K011*<HCHO>+K012*<ALD>+0.91924*K016*<CARBO>+0.01*K054 !*<BIO>*<O3P>+0.00878*K058*<ALKA>*<OH>+K062*<HCHO>*<OH>+1.01732*K065*<CARBO>*<O !H>+K072*<HCHO>*<NO3>+1.33723*K074*<CARBO>*<NO3>+0.35120*K079*<ALKE>*<O3>+0.360 !00*K080*<BIO>*<O3>+0.64728*K081*<CARBO>*<O3>+0.13*K082*<PAN>*<O3> - PPROD(:,13) = +TPK%K010(:)*PCONC(:,22)+TPK%K011(:)*PCONC(:,22)+TPK%K012(:)*PCO& -&NC(:,23)+0.91924*TPK%K016(:)*PCONC(:,25)+0.01*TPK%K054(:)*PCONC(:,20)*TPK%O3P(& -&:)+0.00878*TPK%K058(:)*PCONC(:,18)*PCONC(:,14)+TPK%K062(:)*PCONC(:,22)*PCONC(:& -&,14)+1.01732*TPK%K065(:)*PCONC(:,25)*PCONC(:,14)+TPK%K072(:)*PCONC(:,22)*PCONC& -&(:,5)+1.33723*TPK%K074(:)*PCONC(:,25)*PCONC(:,5)+0.35120*TPK%K079(:)*PCONC(:,1& -&9)*PCONC(:,1)+0.36000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1)+0.64728*TPK%K081(:)*P& -&CONC(:,25)*PCONC(:,1)+0.13*TPK%K082(:)*PCONC(:,27)*PCONC(:,1) + PPROD(:,14) = +TPK%K010(:)*PCONC(:,23)+TPK%K011(:)*PCONC(:,23)+TPK%K012(:)*PCO& +&NC(:,24)+0.91924*TPK%K016(:)*PCONC(:,26)+0.01*TPK%K054(:)*PCONC(:,21)*TPK%O3P(& +&:)+0.00878*TPK%K058(:)*PCONC(:,19)*PCONC(:,15)+TPK%K062(:)*PCONC(:,23)*PCONC(:& +&,15)+1.01732*TPK%K065(:)*PCONC(:,26)*PCONC(:,15)+TPK%K072(:)*PCONC(:,23)*PCONC& +&(:,5)+1.33723*TPK%K074(:)*PCONC(:,26)*PCONC(:,5)+0.35120*TPK%K079(:)*PCONC(:,2& +&0)*PCONC(:,1)+0.36000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.64728*TPK%K081(:)*P& +&CONC(:,26)*PCONC(:,1)+0.13*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) !PLOSS(CO) = +K053*<OH> - PLOSS(:,13) = +TPK%K053(:)*PCONC(:,14) + PLOSS(:,14) = +TPK%K053(:)*PCONC(:,15) ! !PPROD(OH) = +K004*<HONO>+K005*<HNO3>+0.35*K006*<HNO4>+K009*<H2O2>+K009*<H2O2>+ !K013*<OP1>+K014*<OP2>+K022*<O1D>*<H2O>+K022*<O1D>*<H2O>+K024*<O3>*<HO2>+K035*< @@ -5288,30 +5337,31 @@ SUBROUTINE SUB1 !0.35*K068*<OP1>*<OH>+0.44925*K069*<OP2>*<OH>+0.39435*K079*<ALKE>*<O3>+0.28000* !K080*<BIO>*<O3>+0.20595*K081*<CARBO>*<O3>+0.036*K082*<PAN>*<O3>+K087*<ADD>*<O3 !> - PPROD(:,14) = +TPK%K004(:)*PCONC(:,7)+TPK%K005(:)*PCONC(:,8)+0.35*TPK%K006(:)*& + PPROD(:,15) = +TPK%K004(:)*PCONC(:,7)+TPK%K005(:)*PCONC(:,8)+0.35*TPK%K006(:)*& &PCONC(:,9)+TPK%K009(:)*PCONC(:,2)+TPK%K009(:)*PCONC(:,2)+TPK%K013(:)*PCONC(:,2& -&8)+TPK%K014(:)*PCONC(:,29)+TPK%K022(:)*TPK%O1D(:)*TPK%H2O(:)+TPK%K022(:)*TPK%O& -&1D(:)*TPK%H2O(:)+TPK%K024(:)*PCONC(:,1)*PCONC(:,15)+TPK%K035(:)*PCONC(:,15)*PC& -&ONC(:,3)+0.7*TPK%K038(:)*PCONC(:,15)*PCONC(:,5)+0.02*TPK%K054(:)*PCONC(:,20)*T& -&PK%O3P(:)+0.00878*TPK%K058(:)*PCONC(:,18)*PCONC(:,14)+0.35*TPK%K068(:)*PCONC(:& -&,28)*PCONC(:,14)+0.44925*TPK%K069(:)*PCONC(:,29)*PCONC(:,14)+0.39435*TPK%K079(& -&:)*PCONC(:,19)*PCONC(:,1)+0.28000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1)+0.20595*T& -&PK%K081(:)*PCONC(:,25)*PCONC(:,1)+0.036*TPK%K082(:)*PCONC(:,27)*PCONC(:,1)+TPK& -&%K087(:)*PCONC(:,37)*PCONC(:,1) +&9)+TPK%K014(:)*PCONC(:,30)+TPK%K022(:)*TPK%O1D(:)*TPK%H2O(:)+TPK%K022(:)*TPK%O& +&1D(:)*TPK%H2O(:)+TPK%K024(:)*PCONC(:,1)*PCONC(:,16)+TPK%K035(:)*PCONC(:,16)*PC& +&ONC(:,3)+0.7*TPK%K038(:)*PCONC(:,16)*PCONC(:,5)+0.02*TPK%K054(:)*PCONC(:,21)*T& +&PK%O3P(:)+0.00878*TPK%K058(:)*PCONC(:,19)*PCONC(:,15)+0.35*TPK%K068(:)*PCONC(:& +&,29)*PCONC(:,15)+0.44925*TPK%K069(:)*PCONC(:,30)*PCONC(:,15)+0.39435*TPK%K079(& +&:)*PCONC(:,20)*PCONC(:,1)+0.28000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.20595*T& +&PK%K081(:)*PCONC(:,26)*PCONC(:,1)+0.036*TPK%K082(:)*PCONC(:,28)*PCONC(:,1)+TPK& +&%K087(:)*PCONC(:,38)*PCONC(:,1) !PLOSS(OH) = +K023*<O3>+K025*<HO2>+K026*<H2O2>+K032*<NO>+K033*<NO2>+K034*<NO3>+ !K039*<HONO>+K040*<HNO3>+K041*<HNO4>+K050*<NH3>+K051*<H2>+K052*<SO2>+K053*<CO>+ !K056*<CH4>+K057*<ETH>+K058*<ALKA>+K059*<ALKE>+K060*<BIO>+K061*<ARO>+K062*<HCHO !>+K063*<ALD>+K064*<KET>+K065*<CARBO>+K066*<ORA1>+K067*<ORA2>+K068*<OP1>+K069*< -!OP2>+K070*<PAN>+K071*<ONIT> - PLOSS(:,14) = +TPK%K023(:)*PCONC(:,1)+TPK%K025(:)*PCONC(:,15)+TPK%K026(:)*PCON& +!OP2>+K070*<PAN>+K071*<ONIT>+K135*<DMS> + PLOSS(:,15) = +TPK%K023(:)*PCONC(:,1)+TPK%K025(:)*PCONC(:,16)+TPK%K026(:)*PCON& &C(:,2)+TPK%K032(:)*PCONC(:,3)+TPK%K033(:)*PCONC(:,4)+TPK%K034(:)*PCONC(:,5)+TP& &K%K039(:)*PCONC(:,7)+TPK%K040(:)*PCONC(:,8)+TPK%K041(:)*PCONC(:,9)+TPK%K050(:)& -&*PCONC(:,10)+TPK%K051(:)*TPK%H2(:)+TPK%K052(:)*PCONC(:,11)+TPK%K053(:)*PCONC(:& -&,13)+TPK%K056(:)*PCONC(:,16)+TPK%K057(:)*PCONC(:,17)+TPK%K058(:)*PCONC(:,18)+T& -&PK%K059(:)*PCONC(:,19)+TPK%K060(:)*PCONC(:,20)+TPK%K061(:)*PCONC(:,21)+TPK%K06& -&2(:)*PCONC(:,22)+TPK%K063(:)*PCONC(:,23)+TPK%K064(:)*PCONC(:,24)+TPK%K065(:)*P& -&CONC(:,25)+TPK%K066(:)*PCONC(:,30)+TPK%K067(:)*PCONC(:,31)+TPK%K068(:)*PCONC(:& -&,28)+TPK%K069(:)*PCONC(:,29)+TPK%K070(:)*PCONC(:,27)+TPK%K071(:)*PCONC(:,26) +&*PCONC(:,10)+TPK%K051(:)*TPK%H2(:)+TPK%K052(:)*PCONC(:,12)+TPK%K053(:)*PCONC(:& +&,14)+TPK%K056(:)*PCONC(:,17)+TPK%K057(:)*PCONC(:,18)+TPK%K058(:)*PCONC(:,19)+T& +&PK%K059(:)*PCONC(:,20)+TPK%K060(:)*PCONC(:,21)+TPK%K061(:)*PCONC(:,22)+TPK%K06& +&2(:)*PCONC(:,23)+TPK%K063(:)*PCONC(:,24)+TPK%K064(:)*PCONC(:,25)+TPK%K065(:)*P& +&CONC(:,26)+TPK%K066(:)*PCONC(:,31)+TPK%K067(:)*PCONC(:,32)+TPK%K068(:)*PCONC(:& +&,29)+TPK%K069(:)*PCONC(:,30)+TPK%K070(:)*PCONC(:,28)+TPK%K071(:)*PCONC(:,27)+T& +&PK%K135(:)*PCONC(:,11) ! !PPROD(HO2) = +0.65*K006*<HNO4>+K011*<HCHO>+K011*<HCHO>+K012*<ALD>+K013*<OP1>+0 !.96205*K014*<OP2>+0.75830*K016*<CARBO>+K017*<ONIT>+K023*<O3>*<OH>+K026*<H2O2>* @@ -5330,79 +5380,73 @@ SUBROUTINE SUB1 !LN>+0.00000*K118*<OLN>*<OLN>+K119*<MO2>*<NO3>+0.81290*K120*<ALKAP>*<NO3>+K121* !<ALKEP>*<NO3>+K122*<BIOP>*<NO3>+K123*<AROP>*<NO3>+0.04915*K124*<CARBOP>*<NO3>+ !0.25928*K125*<OLN>*<NO3>+K127*<XO2>*<MO2> - PPROD(:,15) = +0.65*TPK%K006(:)*PCONC(:,9)+TPK%K011(:)*PCONC(:,22)+TPK%K011(:)& -&*PCONC(:,22)+TPK%K012(:)*PCONC(:,23)+TPK%K013(:)*PCONC(:,28)+0.96205*TPK%K014(& -&:)*PCONC(:,29)+0.75830*TPK%K016(:)*PCONC(:,25)+TPK%K017(:)*PCONC(:,26)+TPK%K02& -&3(:)*PCONC(:,1)*PCONC(:,14)+TPK%K026(:)*PCONC(:,2)*PCONC(:,14)+TPK%K034(:)*PCO& -&NC(:,14)*PCONC(:,5)+TPK%K037(:)*PCONC(:,9)+TPK%K051(:)*PCONC(:,14)*TPK%H2(:)+T& -&PK%K052(:)*PCONC(:,14)*PCONC(:,11)+TPK%K053(:)*PCONC(:,13)*PCONC(:,14)+0.28*TP& -&K%K054(:)*PCONC(:,20)*TPK%O3P(:)+0.12793*TPK%K058(:)*PCONC(:,18)*PCONC(:,14)+0& -&.10318*TPK%K061(:)*PCONC(:,21)*PCONC(:,14)+TPK%K062(:)*PCONC(:,22)*PCONC(:,14)& -&+0.51208*TPK%K065(:)*PCONC(:,25)*PCONC(:,14)+TPK%K066(:)*PCONC(:,30)*PCONC(:,1& -&4)+0.02915*TPK%K069(:)*PCONC(:,29)*PCONC(:,14)+0.28107*TPK%K070(:)*PCONC(:,27)& -&*PCONC(:,14)+TPK%K072(:)*PCONC(:,22)*PCONC(:,5)+0.63217*TPK%K074(:)*PCONC(:,25& -&)*PCONC(:,5)+0.23451*TPK%K079(:)*PCONC(:,19)*PCONC(:,1)+0.30000*TPK%K080(:)*PC& -&ONC(:,20)*PCONC(:,1)+0.28441*TPK%K081(:)*PCONC(:,25)*PCONC(:,1)+0.08*TPK%K082(& -&:)*PCONC(:,27)*PCONC(:,1)+0.02*TPK%K086(:)*PCONC(:,37)*TPK%O2(:)+TPK%K090(:)*P& -&CONC(:,32)*PCONC(:,3)+0.74265*TPK%K091(:)*PCONC(:,33)*PCONC(:,3)+TPK%K092(:)*P& -&CONC(:,34)*PCONC(:,3)+0.84700*TPK%K093(:)*PCONC(:,35)*PCONC(:,3)+0.95115*TPK%K& -&094(:)*PCONC(:,38)*PCONC(:,3)+0.12334*TPK%K095(:)*PCONC(:,39)*PCONC(:,3)+0.184& -&01*TPK%K096(:)*PCONC(:,40)*PCONC(:,3)+0.66*TPK%K104(:)*PCONC(:,32)*PCONC(:,32)& -&+0.98383*TPK%K105(:)*PCONC(:,33)*PCONC(:,32)+TPK%K106(:)*PCONC(:,34)*PCONC(:,3& -&2)+1.00000*TPK%K107(:)*PCONC(:,35)*PCONC(:,32)+1.02767*TPK%K108(:)*PCONC(:,38)& -&*PCONC(:,32)+0.82998*TPK%K109(:)*PCONC(:,39)*PCONC(:,32)+0.67560*TPK%K110(:)*P& -&CONC(:,40)*PCONC(:,32)+0.48079*TPK%K111(:)*PCONC(:,33)*PCONC(:,39)+0.50078*TPK& -&%K112(:)*PCONC(:,34)*PCONC(:,39)+0.50600*TPK%K113(:)*PCONC(:,35)*PCONC(:,39)+T& -&PK%K114(:)*PCONC(:,38)*PCONC(:,39)+0.07566*TPK%K115(:)*PCONC(:,39)*PCONC(:,39)& -&+0.17599*TPK%K116(:)*PCONC(:,40)*PCONC(:,39)+TPK%K117(:)*PCONC(:,40)*PCONC(:,4& -&0)+0.00000*TPK%K118(:)*PCONC(:,40)*PCONC(:,40)+TPK%K119(:)*PCONC(:,32)*PCONC(:& -&,5)+0.81290*TPK%K120(:)*PCONC(:,33)*PCONC(:,5)+TPK%K121(:)*PCONC(:,34)*PCONC(:& -&,5)+TPK%K122(:)*PCONC(:,35)*PCONC(:,5)+TPK%K123(:)*PCONC(:,38)*PCONC(:,5)+0.04& -&915*TPK%K124(:)*PCONC(:,39)*PCONC(:,5)+0.25928*TPK%K125(:)*PCONC(:,40)*PCONC(:& -&,5)+TPK%K127(:)*PCONC(:,41)*PCONC(:,32) + PPROD(:,16) = +0.65*TPK%K006(:)*PCONC(:,9)+TPK%K011(:)*PCONC(:,23)+TPK%K011(:)& +&*PCONC(:,23)+TPK%K012(:)*PCONC(:,24)+TPK%K013(:)*PCONC(:,29)+0.96205*TPK%K014(& +&:)*PCONC(:,30)+0.75830*TPK%K016(:)*PCONC(:,26)+TPK%K017(:)*PCONC(:,27)+TPK%K02& +&3(:)*PCONC(:,1)*PCONC(:,15)+TPK%K026(:)*PCONC(:,2)*PCONC(:,15)+TPK%K034(:)*PCO& +&NC(:,15)*PCONC(:,5)+TPK%K037(:)*PCONC(:,9)+TPK%K051(:)*PCONC(:,15)*TPK%H2(:)+T& +&PK%K052(:)*PCONC(:,15)*PCONC(:,12)+TPK%K053(:)*PCONC(:,14)*PCONC(:,15)+0.28*TP& +&K%K054(:)*PCONC(:,21)*TPK%O3P(:)+0.12793*TPK%K058(:)*PCONC(:,19)*PCONC(:,15)+0& +&.10318*TPK%K061(:)*PCONC(:,22)*PCONC(:,15)+TPK%K062(:)*PCONC(:,23)*PCONC(:,15)& +&+0.51208*TPK%K065(:)*PCONC(:,26)*PCONC(:,15)+TPK%K066(:)*PCONC(:,31)*PCONC(:,1& +&5)+0.02915*TPK%K069(:)*PCONC(:,30)*PCONC(:,15)+0.28107*TPK%K070(:)*PCONC(:,28)& +&*PCONC(:,15)+TPK%K072(:)*PCONC(:,23)*PCONC(:,5)+0.63217*TPK%K074(:)*PCONC(:,26& +&)*PCONC(:,5)+0.23451*TPK%K079(:)*PCONC(:,20)*PCONC(:,1)+0.30000*TPK%K080(:)*PC& +&ONC(:,21)*PCONC(:,1)+0.28441*TPK%K081(:)*PCONC(:,26)*PCONC(:,1)+0.08*TPK%K082(& +&:)*PCONC(:,28)*PCONC(:,1)+0.02*TPK%K086(:)*PCONC(:,38)*TPK%O2(:)+TPK%K090(:)*P& +&CONC(:,33)*PCONC(:,3)+0.74265*TPK%K091(:)*PCONC(:,34)*PCONC(:,3)+TPK%K092(:)*P& +&CONC(:,35)*PCONC(:,3)+0.84700*TPK%K093(:)*PCONC(:,36)*PCONC(:,3)+0.95115*TPK%K& +&094(:)*PCONC(:,39)*PCONC(:,3)+0.12334*TPK%K095(:)*PCONC(:,40)*PCONC(:,3)+0.184& +&01*TPK%K096(:)*PCONC(:,41)*PCONC(:,3)+0.66*TPK%K104(:)*PCONC(:,33)*PCONC(:,33)& +&+0.98383*TPK%K105(:)*PCONC(:,34)*PCONC(:,33)+TPK%K106(:)*PCONC(:,35)*PCONC(:,3& +&3)+1.00000*TPK%K107(:)*PCONC(:,36)*PCONC(:,33)+1.02767*TPK%K108(:)*PCONC(:,39)& +&*PCONC(:,33)+0.82998*TPK%K109(:)*PCONC(:,40)*PCONC(:,33)+0.67560*TPK%K110(:)*P& +&CONC(:,41)*PCONC(:,33)+0.48079*TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.50078*TPK& +&%K112(:)*PCONC(:,35)*PCONC(:,40)+0.50600*TPK%K113(:)*PCONC(:,36)*PCONC(:,40)+T& +&PK%K114(:)*PCONC(:,39)*PCONC(:,40)+0.07566*TPK%K115(:)*PCONC(:,40)*PCONC(:,40)& +&+0.17599*TPK%K116(:)*PCONC(:,41)*PCONC(:,40)+TPK%K117(:)*PCONC(:,41)*PCONC(:,4& +&1)+0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,41)+TPK%K119(:)*PCONC(:,33)*PCONC(:& +&,5)+0.81290*TPK%K120(:)*PCONC(:,34)*PCONC(:,5)+TPK%K121(:)*PCONC(:,35)*PCONC(:& +&,5)+TPK%K122(:)*PCONC(:,36)*PCONC(:,5)+TPK%K123(:)*PCONC(:,39)*PCONC(:,5)+0.04& +&915*TPK%K124(:)*PCONC(:,40)*PCONC(:,5)+0.25928*TPK%K125(:)*PCONC(:,41)*PCONC(:& +&,5)+TPK%K127(:)*PCONC(:,42)*PCONC(:,33) !PLOSS(HO2) = +K024*<O3>+K025*<OH>+K027*<HO2>+K027*<HO2>+K028*<HO2>*<H2O>+K028* !<HO2>*<H2O>+K035*<NO>+K036*<NO2>+K038*<NO3>+K084*<PHO>+K097*<MO2>+K098*<ALKAP> !+K099*<ALKEP>+K0100*<BIOP>+K0101*<AROP>+K0102*<CARBOP>+K103*<OLN>+K126*<XO2> - PLOSS(:,15) = +TPK%K024(:)*PCONC(:,1)+TPK%K025(:)*PCONC(:,14)+TPK%K027(:)*PCON& -&C(:,15)+TPK%K027(:)*PCONC(:,15)+TPK%K028(:)*PCONC(:,15)*TPK%H2O(:)+TPK%K028(:)& -&*PCONC(:,15)*TPK%H2O(:)+TPK%K035(:)*PCONC(:,3)+TPK%K036(:)*PCONC(:,4)+TPK%K038& -&(:)*PCONC(:,5)+TPK%K084(:)*PCONC(:,36)+TPK%K097(:)*PCONC(:,32)+TPK%K098(:)*PCO& -&NC(:,33)+TPK%K099(:)*PCONC(:,34)+TPK%K0100(:)*PCONC(:,35)+TPK%K0101(:)*PCONC(:& -&,38)+TPK%K0102(:)*PCONC(:,39)+TPK%K103(:)*PCONC(:,40)+TPK%K126(:)*PCONC(:,41) + PLOSS(:,16) = +TPK%K024(:)*PCONC(:,1)+TPK%K025(:)*PCONC(:,15)+TPK%K027(:)*PCON& +&C(:,16)+TPK%K027(:)*PCONC(:,16)+TPK%K028(:)*PCONC(:,16)*TPK%H2O(:)+TPK%K028(:)& +&*PCONC(:,16)*TPK%H2O(:)+TPK%K035(:)*PCONC(:,3)+TPK%K036(:)*PCONC(:,4)+TPK%K038& +&(:)*PCONC(:,5)+TPK%K084(:)*PCONC(:,37)+TPK%K097(:)*PCONC(:,33)+TPK%K098(:)*PCO& +&NC(:,34)+TPK%K099(:)*PCONC(:,35)+TPK%K0100(:)*PCONC(:,36)+TPK%K0101(:)*PCONC(:& +&,39)+TPK%K0102(:)*PCONC(:,40)+TPK%K103(:)*PCONC(:,41)+TPK%K126(:)*PCONC(:,42) ! !PPROD(CH4) = +0.04300*K079*<ALKE>*<O3> - PPROD(:,16) = +0.04300*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PPROD(:,17) = +0.04300*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) !PLOSS(CH4) = +K056*<OH> - PLOSS(:,16) = +TPK%K056(:)*PCONC(:,14) + PLOSS(:,17) = +TPK%K056(:)*PCONC(:,15) ! !PPROD(ETH) = +0.03196*K079*<ALKE>*<O3> - PPROD(:,17) = +0.03196*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PPROD(:,18) = +0.03196*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) !PLOSS(ETH) = +K057*<OH> - PLOSS(:,17) = +TPK%K057(:)*PCONC(:,14) + PLOSS(:,18) = +TPK%K057(:)*PCONC(:,15) ! !PPROD(ALKA) = 0.0 - PPROD(:,18) = 0.0 + PPROD(:,19) = 0.0 !PLOSS(ALKA) = +K058*<OH> - PLOSS(:,18) = +TPK%K058(:)*PCONC(:,14) + PLOSS(:,19) = +TPK%K058(:)*PCONC(:,15) ! !PPROD(ALKE) = +0.91868*K054*<BIO>*<O3P>+0.00000*K079*<ALKE>*<O3>+0.37388*K080* !<BIO>*<O3>+0.37815*K093*<BIOP>*<NO>+0.48074*K107*<BIOP>*<MO2>+0.24463*K113*<BI !OP>*<CARBOP>+0.42729*K122*<BIOP>*<NO3> - PPROD(:,19) = +0.91868*TPK%K054(:)*PCONC(:,20)*TPK%O3P(:)+0.00000*TPK%K079(:)*& -&PCONC(:,19)*PCONC(:,1)+0.37388*TPK%K080(:)*PCONC(:,20)*PCONC(:,1)+0.37815*TPK%& -&K093(:)*PCONC(:,35)*PCONC(:,3)+0.48074*TPK%K107(:)*PCONC(:,35)*PCONC(:,32)+0.2& -&4463*TPK%K113(:)*PCONC(:,35)*PCONC(:,39)+0.42729*TPK%K122(:)*PCONC(:,35)*PCONC& + PPROD(:,20) = +0.91868*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:)+0.00000*TPK%K079(:)*& +&PCONC(:,20)*PCONC(:,1)+0.37388*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.37815*TPK%& +&K093(:)*PCONC(:,36)*PCONC(:,3)+0.48074*TPK%K107(:)*PCONC(:,36)*PCONC(:,33)+0.2& +&4463*TPK%K113(:)*PCONC(:,36)*PCONC(:,40)+0.42729*TPK%K122(:)*PCONC(:,36)*PCONC& &(:,5) !PLOSS(ALKE) = +K059*<OH>+K076*<NO3>+K079*<O3> - PLOSS(:,19) = +TPK%K059(:)*PCONC(:,14)+TPK%K076(:)*PCONC(:,5)+TPK%K079(:)*PCON& + PLOSS(:,20) = +TPK%K059(:)*PCONC(:,15)+TPK%K076(:)*PCONC(:,5)+TPK%K079(:)*PCON& &C(:,1) ! -!PPROD(BIO) = 0.0 - PPROD(:,20) = 0.0 -!PLOSS(BIO) = +K054*<O3P>+K060*<OH>+K077*<NO3>+K080*<O3> - PLOSS(:,20) = +TPK%K054(:)*TPK%O3P(:)+TPK%K060(:)*PCONC(:,14)+TPK%K077(:)*PCON& -&C(:,5)+TPK%K080(:)*PCONC(:,1) -! RETURN END SUBROUTINE SUB1 ! @@ -5411,13 +5455,19 @@ SUBROUTINE SUB2 !Indices 21 a 30 ! ! +!PPROD(BIO) = 0.0 + PPROD(:,21) = 0.0 +!PLOSS(BIO) = +K054*<O3P>+K060*<OH>+K077*<NO3>+K080*<O3> + PLOSS(:,21) = +TPK%K054(:)*TPK%O3P(:)+TPK%K060(:)*PCONC(:,15)+TPK%K077(:)*PCON& +&C(:,5)+TPK%K080(:)*PCONC(:,1) +! !PPROD(ARO) = +0.10670*K083*<PHO>*<NO2>+1.06698*K084*<PHO>*<HO2>+K085*<ADD>*<NO !2>+0.02*K086*<ADD>*<O2>+K087*<ADD>*<O3> - PPROD(:,21) = +0.10670*TPK%K083(:)*PCONC(:,36)*PCONC(:,4)+1.06698*TPK%K084(:)*& -&PCONC(:,36)*PCONC(:,15)+TPK%K085(:)*PCONC(:,37)*PCONC(:,4)+0.02*TPK%K086(:)*PC& -&ONC(:,37)*TPK%O2(:)+TPK%K087(:)*PCONC(:,37)*PCONC(:,1) + PPROD(:,22) = +0.10670*TPK%K083(:)*PCONC(:,37)*PCONC(:,4)+1.06698*TPK%K084(:)*& +&PCONC(:,37)*PCONC(:,16)+TPK%K085(:)*PCONC(:,38)*PCONC(:,4)+0.02*TPK%K086(:)*PC& +&ONC(:,38)*TPK%O2(:)+TPK%K087(:)*PCONC(:,38)*PCONC(:,1) !PLOSS(ARO) = +K061*<OH>+K075*<NO3> - PLOSS(:,21) = +TPK%K061(:)*PCONC(:,14)+TPK%K075(:)*PCONC(:,5) + PLOSS(:,22) = +TPK%K061(:)*PCONC(:,15)+TPK%K075(:)*PCONC(:,5) ! !PPROD(HCHO) = +K013*<OP1>+0.06517*K016*<CARBO>+0.05*K054*<BIO>*<O3P>+0.00140*K !058*<ALKA>*<OH>+0.00000*K065*<CARBO>*<OH>+0.35*K068*<OP1>*<OH>+0.02915*K069*<O @@ -5432,29 +5482,29 @@ SUBROUTINE SUB2 !K118*<OLN>*<OLN>+K119*<MO2>*<NO3>+0.03142*K120*<ALKAP>*<NO3>+1.40909*K121*<ALK !EP>*<NO3>+0.68600*K122*<BIOP>*<NO3>+0.03175*K124*<CARBOP>*<NO3>+0.20740*K125*< !OLN>*<NO3>+K127*<XO2>*<MO2> - PPROD(:,22) = +TPK%K013(:)*PCONC(:,28)+0.06517*TPK%K016(:)*PCONC(:,25)+0.05*TP& -&K%K054(:)*PCONC(:,20)*TPK%O3P(:)+0.00140*TPK%K058(:)*PCONC(:,18)*PCONC(:,14)+0& -&.00000*TPK%K065(:)*PCONC(:,25)*PCONC(:,14)+0.35*TPK%K068(:)*PCONC(:,28)*PCONC(& -&:,14)+0.02915*TPK%K069(:)*PCONC(:,29)*PCONC(:,14)+0.57839*TPK%K070(:)*PCONC(:,& -&27)*PCONC(:,14)+0.40*TPK%K078(:)*PCONC(:,27)*PCONC(:,5)+0.48290*TPK%K079(:)*PC& -&ONC(:,19)*PCONC(:,1)+0.90000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1)+0.00000*TPK%K0& -&81(:)*PCONC(:,25)*PCONC(:,1)+0.70*TPK%K082(:)*PCONC(:,27)*PCONC(:,1)+TPK%K090(& -&:)*PCONC(:,32)*PCONC(:,3)+0.03002*TPK%K091(:)*PCONC(:,33)*PCONC(:,3)+1.39870*T& -&PK%K092(:)*PCONC(:,34)*PCONC(:,3)+0.60600*TPK%K093(:)*PCONC(:,35)*PCONC(:,3)+0& -&.05848*TPK%K095(:)*PCONC(:,39)*PCONC(:,3)+0.23419*TPK%K096(:)*PCONC(:,40)*PCON& -&C(:,3)+1.33*TPK%K104(:)*PCONC(:,32)*PCONC(:,32)+0.80556*TPK%K105(:)*PCONC(:,33& -&)*PCONC(:,32)+1.42894*TPK%K106(:)*PCONC(:,34)*PCONC(:,32)+1.09000*TPK%K107(:)*& -&PCONC(:,35)*PCONC(:,32)+TPK%K108(:)*PCONC(:,38)*PCONC(:,32)+0.95723*TPK%K109(:& -&)*PCONC(:,39)*PCONC(:,32)+0.88625*TPK%K110(:)*PCONC(:,40)*PCONC(:,32)+0.07600*& -&TPK%K111(:)*PCONC(:,33)*PCONC(:,39)+0.68192*TPK%K112(:)*PCONC(:,34)*PCONC(:,39& -&)+0.34000*TPK%K113(:)*PCONC(:,35)*PCONC(:,39)+0.03432*TPK%K115(:)*PCONC(:,39)*& -&PCONC(:,39)+0.13414*TPK%K116(:)*PCONC(:,40)*PCONC(:,39)+0.00000*TPK%K118(:)*PC& -&ONC(:,40)*PCONC(:,40)+TPK%K119(:)*PCONC(:,32)*PCONC(:,5)+0.03142*TPK%K120(:)*P& -&CONC(:,33)*PCONC(:,5)+1.40909*TPK%K121(:)*PCONC(:,34)*PCONC(:,5)+0.68600*TPK%K& -&122(:)*PCONC(:,35)*PCONC(:,5)+0.03175*TPK%K124(:)*PCONC(:,39)*PCONC(:,5)+0.207& -&40*TPK%K125(:)*PCONC(:,40)*PCONC(:,5)+TPK%K127(:)*PCONC(:,41)*PCONC(:,32) + PPROD(:,23) = +TPK%K013(:)*PCONC(:,29)+0.06517*TPK%K016(:)*PCONC(:,26)+0.05*TP& +&K%K054(:)*PCONC(:,21)*TPK%O3P(:)+0.00140*TPK%K058(:)*PCONC(:,19)*PCONC(:,15)+0& +&.00000*TPK%K065(:)*PCONC(:,26)*PCONC(:,15)+0.35*TPK%K068(:)*PCONC(:,29)*PCONC(& +&:,15)+0.02915*TPK%K069(:)*PCONC(:,30)*PCONC(:,15)+0.57839*TPK%K070(:)*PCONC(:,& +&28)*PCONC(:,15)+0.40*TPK%K078(:)*PCONC(:,28)*PCONC(:,5)+0.48290*TPK%K079(:)*PC& +&ONC(:,20)*PCONC(:,1)+0.90000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.00000*TPK%K0& +&81(:)*PCONC(:,26)*PCONC(:,1)+0.70*TPK%K082(:)*PCONC(:,28)*PCONC(:,1)+TPK%K090(& +&:)*PCONC(:,33)*PCONC(:,3)+0.03002*TPK%K091(:)*PCONC(:,34)*PCONC(:,3)+1.39870*T& +&PK%K092(:)*PCONC(:,35)*PCONC(:,3)+0.60600*TPK%K093(:)*PCONC(:,36)*PCONC(:,3)+0& +&.05848*TPK%K095(:)*PCONC(:,40)*PCONC(:,3)+0.23419*TPK%K096(:)*PCONC(:,41)*PCON& +&C(:,3)+1.33*TPK%K104(:)*PCONC(:,33)*PCONC(:,33)+0.80556*TPK%K105(:)*PCONC(:,34& +&)*PCONC(:,33)+1.42894*TPK%K106(:)*PCONC(:,35)*PCONC(:,33)+1.09000*TPK%K107(:)*& +&PCONC(:,36)*PCONC(:,33)+TPK%K108(:)*PCONC(:,39)*PCONC(:,33)+0.95723*TPK%K109(:& +&)*PCONC(:,40)*PCONC(:,33)+0.88625*TPK%K110(:)*PCONC(:,41)*PCONC(:,33)+0.07600*& +&TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.68192*TPK%K112(:)*PCONC(:,35)*PCONC(:,40& +&)+0.34000*TPK%K113(:)*PCONC(:,36)*PCONC(:,40)+0.03432*TPK%K115(:)*PCONC(:,40)*& +&PCONC(:,40)+0.13414*TPK%K116(:)*PCONC(:,41)*PCONC(:,40)+0.00000*TPK%K118(:)*PC& +&ONC(:,41)*PCONC(:,41)+TPK%K119(:)*PCONC(:,33)*PCONC(:,5)+0.03142*TPK%K120(:)*P& +&CONC(:,34)*PCONC(:,5)+1.40909*TPK%K121(:)*PCONC(:,35)*PCONC(:,5)+0.68600*TPK%K& +&122(:)*PCONC(:,36)*PCONC(:,5)+0.03175*TPK%K124(:)*PCONC(:,40)*PCONC(:,5)+0.207& +&40*TPK%K125(:)*PCONC(:,41)*PCONC(:,5)+TPK%K127(:)*PCONC(:,42)*PCONC(:,33) !PLOSS(HCHO) = +K010+K011+K062*<OH>+K072*<NO3> - PLOSS(:,22) = +TPK%K010(:)+TPK%K011(:)+TPK%K062(:)*PCONC(:,14)+TPK%K072(:)*PCO& + PLOSS(:,23) = +TPK%K010(:)+TPK%K011(:)+TPK%K062(:)*PCONC(:,15)+TPK%K072(:)*PCO& &NC(:,5) ! !PPROD(ALD) = +0.96205*K014*<OP2>+0.20*K017*<ONIT>+K055*<CARBO>*<O3P>+0.08173*K @@ -5468,26 +5518,26 @@ SUBROUTINE SUB2 !P>+0.42122*K116*<OLN>*<CARBOP>+0.00000*K118*<OLN>*<OLN>+0.33743*K120*<ALKAP>*< !NO3>+0.43039*K121*<ALKEP>*<NO3>+0.00000*K122*<BIOP>*<NO3>+0.02936*K124*<CARBOP !>*<NO3>+0.91850*K125*<OLN>*<NO3> - PPROD(:,23) = +0.96205*TPK%K014(:)*PCONC(:,29)+0.20*TPK%K017(:)*PCONC(:,26)+TP& -&K%K055(:)*PCONC(:,25)*TPK%O3P(:)+0.08173*TPK%K058(:)*PCONC(:,18)*PCONC(:,14)+0& -&.06253*TPK%K065(:)*PCONC(:,25)*PCONC(:,14)+0.07335*TPK%K069(:)*PCONC(:,29)*PCO& -&NC(:,14)+0.05265*TPK%K074(:)*PCONC(:,25)*PCONC(:,5)+0.51468*TPK%K079(:)*PCONC(& -&:,19)*PCONC(:,1)+0.00000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1)+0.15692*TPK%K081(:& -&)*PCONC(:,25)*PCONC(:,1)+0.33144*TPK%K091(:)*PCONC(:,33)*PCONC(:,3)+0.42125*TP& -&K%K092(:)*PCONC(:,34)*PCONC(:,3)+0.00000*TPK%K093(:)*PCONC(:,35)*PCONC(:,3)+0.& -&07368*TPK%K095(:)*PCONC(:,39)*PCONC(:,3)+1.01182*TPK%K096(:)*PCONC(:,40)*PCONC& -&(:,3)+0.56070*TPK%K105(:)*PCONC(:,33)*PCONC(:,32)+0.46413*TPK%K106(:)*PCONC(:,& -&34)*PCONC(:,32)+0.00000*TPK%K107(:)*PCONC(:,35)*PCONC(:,32)+0.08295*TPK%K109(:& -&)*PCONC(:,39)*PCONC(:,32)+0.41524*TPK%K110(:)*PCONC(:,40)*PCONC(:,32)+0.71461*& -&TPK%K111(:)*PCONC(:,33)*PCONC(:,39)+0.68374*TPK%K112(:)*PCONC(:,34)*PCONC(:,39& -&)+0.00000*TPK%K113(:)*PCONC(:,35)*PCONC(:,39)+0.06969*TPK%K115(:)*PCONC(:,39)*& -&PCONC(:,39)+0.42122*TPK%K116(:)*PCONC(:,40)*PCONC(:,39)+0.00000*TPK%K118(:)*PC& -&ONC(:,40)*PCONC(:,40)+0.33743*TPK%K120(:)*PCONC(:,33)*PCONC(:,5)+0.43039*TPK%K& -&121(:)*PCONC(:,34)*PCONC(:,5)+0.00000*TPK%K122(:)*PCONC(:,35)*PCONC(:,5)+0.029& -&36*TPK%K124(:)*PCONC(:,39)*PCONC(:,5)+0.91850*TPK%K125(:)*PCONC(:,40)*PCONC(:,& + PPROD(:,24) = +0.96205*TPK%K014(:)*PCONC(:,30)+0.20*TPK%K017(:)*PCONC(:,27)+TP& +&K%K055(:)*PCONC(:,26)*TPK%O3P(:)+0.08173*TPK%K058(:)*PCONC(:,19)*PCONC(:,15)+0& +&.06253*TPK%K065(:)*PCONC(:,26)*PCONC(:,15)+0.07335*TPK%K069(:)*PCONC(:,30)*PCO& +&NC(:,15)+0.05265*TPK%K074(:)*PCONC(:,26)*PCONC(:,5)+0.51468*TPK%K079(:)*PCONC(& +&:,20)*PCONC(:,1)+0.00000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.15692*TPK%K081(:& +&)*PCONC(:,26)*PCONC(:,1)+0.33144*TPK%K091(:)*PCONC(:,34)*PCONC(:,3)+0.42125*TP& +&K%K092(:)*PCONC(:,35)*PCONC(:,3)+0.00000*TPK%K093(:)*PCONC(:,36)*PCONC(:,3)+0.& +&07368*TPK%K095(:)*PCONC(:,40)*PCONC(:,3)+1.01182*TPK%K096(:)*PCONC(:,41)*PCONC& +&(:,3)+0.56070*TPK%K105(:)*PCONC(:,34)*PCONC(:,33)+0.46413*TPK%K106(:)*PCONC(:,& +&35)*PCONC(:,33)+0.00000*TPK%K107(:)*PCONC(:,36)*PCONC(:,33)+0.08295*TPK%K109(:& +&)*PCONC(:,40)*PCONC(:,33)+0.41524*TPK%K110(:)*PCONC(:,41)*PCONC(:,33)+0.71461*& +&TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.68374*TPK%K112(:)*PCONC(:,35)*PCONC(:,40& +&)+0.00000*TPK%K113(:)*PCONC(:,36)*PCONC(:,40)+0.06969*TPK%K115(:)*PCONC(:,40)*& +&PCONC(:,40)+0.42122*TPK%K116(:)*PCONC(:,41)*PCONC(:,40)+0.00000*TPK%K118(:)*PC& +&ONC(:,41)*PCONC(:,41)+0.33743*TPK%K120(:)*PCONC(:,34)*PCONC(:,5)+0.43039*TPK%K& +&121(:)*PCONC(:,35)*PCONC(:,5)+0.00000*TPK%K122(:)*PCONC(:,36)*PCONC(:,5)+0.029& +&36*TPK%K124(:)*PCONC(:,40)*PCONC(:,5)+0.91850*TPK%K125(:)*PCONC(:,41)*PCONC(:,& &5) !PLOSS(ALD) = +K012+K063*<OH>+K073*<NO3> - PLOSS(:,23) = +TPK%K012(:)+TPK%K063(:)*PCONC(:,14)+TPK%K073(:)*PCONC(:,5) + PLOSS(:,24) = +TPK%K012(:)+TPK%K063(:)*PCONC(:,15)+TPK%K073(:)*PCONC(:,5) ! !PPROD(KET) = +0.80*K017*<ONIT>+0.03498*K058*<ALKA>*<OH>+0.00853*K065*<CARBO>*< !OH>+0.37591*K069*<OP2>*<OH>+0.00632*K074*<CARBO>*<NO3>+0.07377*K079*<ALKE>*<O3 @@ -5498,22 +5548,22 @@ SUBROUTINE SUB2 !<CARBOP>+0.02190*K115*<CARBOP>*<CARBOP>+0.10822*K116*<OLN>*<CARBOP>+0.00000*K1 !18*<OLN>*<OLN>+0.62978*K120*<ALKAP>*<NO3>+0.02051*K121*<ALKEP>*<NO3>+0.00000*K !122*<BIOP>*<NO3>+0.34740*K125*<OLN>*<NO3> - PPROD(:,24) = +0.80*TPK%K017(:)*PCONC(:,26)+0.03498*TPK%K058(:)*PCONC(:,18)*PC& -&ONC(:,14)+0.00853*TPK%K065(:)*PCONC(:,25)*PCONC(:,14)+0.37591*TPK%K069(:)*PCON& -&C(:,29)*PCONC(:,14)+0.00632*TPK%K074(:)*PCONC(:,25)*PCONC(:,5)+0.07377*TPK%K07& -&9(:)*PCONC(:,19)*PCONC(:,1)+0.00000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1)+0.54531& -&*TPK%K091(:)*PCONC(:,33)*PCONC(:,3)+0.05220*TPK%K092(:)*PCONC(:,34)*PCONC(:,3)& -&+0.00000*TPK%K093(:)*PCONC(:,35)*PCONC(:,3)+0.37862*TPK%K096(:)*PCONC(:,40)*PC& -&ONC(:,3)+0.09673*TPK%K105(:)*PCONC(:,33)*PCONC(:,32)+0.03814*TPK%K106(:)*PCONC& -&(:,34)*PCONC(:,32)+0.00000*TPK%K107(:)*PCONC(:,35)*PCONC(:,32)+0.09667*TPK%K11& -&0(:)*PCONC(:,40)*PCONC(:,32)+0.18819*TPK%K111(:)*PCONC(:,33)*PCONC(:,39)+0.065& -&79*TPK%K112(:)*PCONC(:,34)*PCONC(:,39)+0.00000*TPK%K113(:)*PCONC(:,35)*PCONC(:& -&,39)+0.02190*TPK%K115(:)*PCONC(:,39)*PCONC(:,39)+0.10822*TPK%K116(:)*PCONC(:,4& -&0)*PCONC(:,39)+0.00000*TPK%K118(:)*PCONC(:,40)*PCONC(:,40)+0.62978*TPK%K120(:)& -&*PCONC(:,33)*PCONC(:,5)+0.02051*TPK%K121(:)*PCONC(:,34)*PCONC(:,5)+0.00000*TPK& -&%K122(:)*PCONC(:,35)*PCONC(:,5)+0.34740*TPK%K125(:)*PCONC(:,40)*PCONC(:,5) + PPROD(:,25) = +0.80*TPK%K017(:)*PCONC(:,27)+0.03498*TPK%K058(:)*PCONC(:,19)*PC& +&ONC(:,15)+0.00853*TPK%K065(:)*PCONC(:,26)*PCONC(:,15)+0.37591*TPK%K069(:)*PCON& +&C(:,30)*PCONC(:,15)+0.00632*TPK%K074(:)*PCONC(:,26)*PCONC(:,5)+0.07377*TPK%K07& +&9(:)*PCONC(:,20)*PCONC(:,1)+0.00000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.54531& +&*TPK%K091(:)*PCONC(:,34)*PCONC(:,3)+0.05220*TPK%K092(:)*PCONC(:,35)*PCONC(:,3)& +&+0.00000*TPK%K093(:)*PCONC(:,36)*PCONC(:,3)+0.37862*TPK%K096(:)*PCONC(:,41)*PC& +&ONC(:,3)+0.09673*TPK%K105(:)*PCONC(:,34)*PCONC(:,33)+0.03814*TPK%K106(:)*PCONC& +&(:,35)*PCONC(:,33)+0.00000*TPK%K107(:)*PCONC(:,36)*PCONC(:,33)+0.09667*TPK%K11& +&0(:)*PCONC(:,41)*PCONC(:,33)+0.18819*TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.065& +&79*TPK%K112(:)*PCONC(:,35)*PCONC(:,40)+0.00000*TPK%K113(:)*PCONC(:,36)*PCONC(:& +&,40)+0.02190*TPK%K115(:)*PCONC(:,40)*PCONC(:,40)+0.10822*TPK%K116(:)*PCONC(:,4& +&1)*PCONC(:,40)+0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,41)+0.62978*TPK%K120(:)& +&*PCONC(:,34)*PCONC(:,5)+0.02051*TPK%K121(:)*PCONC(:,35)*PCONC(:,5)+0.00000*TPK& +&%K122(:)*PCONC(:,36)*PCONC(:,5)+0.34740*TPK%K125(:)*PCONC(:,41)*PCONC(:,5) !PLOSS(KET) = +K015+K064*<OH> - PLOSS(:,24) = +TPK%K015(:)+TPK%K064(:)*PCONC(:,14) + PLOSS(:,25) = +TPK%K015(:)+TPK%K064(:)*PCONC(:,15) ! !PPROD(CARBO) = +0.13255*K054*<BIO>*<O3P>+0.00835*K058*<ALKA>*<OH>+0.16919*K065 !*<CARBO>*<OH>+0.21863*K070*<PAN>*<OH>+0.10530*K074*<CARBO>*<NO3>+0.00000*K076* @@ -5525,71 +5575,63 @@ SUBROUTINE SUB2 !K114*<AROP>*<CARBOP>+0.10777*K115*<CARBOP>*<CARBOP>+0.03531*K120*<ALKAP>*<NO3> !+0.61160*K122*<BIOP>*<NO3>+2.81904*K123*<AROP>*<NO3>+0.03455*K124*<CARBOP>*<NO !3> - PPROD(:,25) = +0.13255*TPK%K054(:)*PCONC(:,20)*TPK%O3P(:)+0.00835*TPK%K058(:)*& -&PCONC(:,18)*PCONC(:,14)+0.16919*TPK%K065(:)*PCONC(:,25)*PCONC(:,14)+0.21863*TP& -&K%K070(:)*PCONC(:,27)*PCONC(:,14)+0.10530*TPK%K074(:)*PCONC(:,25)*PCONC(:,5)+0& -&.00000*TPK%K076(:)*PCONC(:,19)*PCONC(:,5)+0.91741*TPK%K077(:)*PCONC(:,20)*PCON& -&C(:,5)+0.00000*TPK%K079(:)*PCONC(:,19)*PCONC(:,1)+0.39754*TPK%K080(:)*PCONC(:,& -&20)*PCONC(:,1)+1.07583*TPK%K081(:)*PCONC(:,25)*PCONC(:,1)+0.03407*TPK%K091(:)*& -&PCONC(:,33)*PCONC(:,3)+0.45463*TPK%K093(:)*PCONC(:,35)*PCONC(:,3)+2.06993*TPK%& -&K094(:)*PCONC(:,38)*PCONC(:,3)+0.08670*TPK%K095(:)*PCONC(:,39)*PCONC(:,3)+0.07& -&976*TPK%K105(:)*PCONC(:,33)*PCONC(:,32)+0.56064*TPK%K107(:)*PCONC(:,35)*PCONC(& -&:,32)+1.99461*TPK%K108(:)*PCONC(:,38)*PCONC(:,32)+0.15387*TPK%K109(:)*PCONC(:,& -&39)*PCONC(:,32)+0.06954*TPK%K111(:)*PCONC(:,33)*PCONC(:,39)+0.78591*TPK%K113(:& -&)*PCONC(:,35)*PCONC(:,39)+1.99455*TPK%K114(:)*PCONC(:,38)*PCONC(:,39)+0.10777*& -&TPK%K115(:)*PCONC(:,39)*PCONC(:,39)+0.03531*TPK%K120(:)*PCONC(:,33)*PCONC(:,5)& -&+0.61160*TPK%K122(:)*PCONC(:,35)*PCONC(:,5)+2.81904*TPK%K123(:)*PCONC(:,38)*PC& -&ONC(:,5)+0.03455*TPK%K124(:)*PCONC(:,39)*PCONC(:,5) + PPROD(:,26) = +0.13255*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:)+0.00835*TPK%K058(:)*& +&PCONC(:,19)*PCONC(:,15)+0.16919*TPK%K065(:)*PCONC(:,26)*PCONC(:,15)+0.21863*TP& +&K%K070(:)*PCONC(:,28)*PCONC(:,15)+0.10530*TPK%K074(:)*PCONC(:,26)*PCONC(:,5)+0& +&.00000*TPK%K076(:)*PCONC(:,20)*PCONC(:,5)+0.91741*TPK%K077(:)*PCONC(:,21)*PCON& +&C(:,5)+0.00000*TPK%K079(:)*PCONC(:,20)*PCONC(:,1)+0.39754*TPK%K080(:)*PCONC(:,& +&21)*PCONC(:,1)+1.07583*TPK%K081(:)*PCONC(:,26)*PCONC(:,1)+0.03407*TPK%K091(:)*& +&PCONC(:,34)*PCONC(:,3)+0.45463*TPK%K093(:)*PCONC(:,36)*PCONC(:,3)+2.06993*TPK%& +&K094(:)*PCONC(:,39)*PCONC(:,3)+0.08670*TPK%K095(:)*PCONC(:,40)*PCONC(:,3)+0.07& +&976*TPK%K105(:)*PCONC(:,34)*PCONC(:,33)+0.56064*TPK%K107(:)*PCONC(:,36)*PCONC(& +&:,33)+1.99461*TPK%K108(:)*PCONC(:,39)*PCONC(:,33)+0.15387*TPK%K109(:)*PCONC(:,& +&40)*PCONC(:,33)+0.06954*TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.78591*TPK%K113(:& +&)*PCONC(:,36)*PCONC(:,40)+1.99455*TPK%K114(:)*PCONC(:,39)*PCONC(:,40)+0.10777*& +&TPK%K115(:)*PCONC(:,40)*PCONC(:,40)+0.03531*TPK%K120(:)*PCONC(:,34)*PCONC(:,5)& +&+0.61160*TPK%K122(:)*PCONC(:,36)*PCONC(:,5)+2.81904*TPK%K123(:)*PCONC(:,39)*PC& +&ONC(:,5)+0.03455*TPK%K124(:)*PCONC(:,40)*PCONC(:,5) !PLOSS(CARBO) = +K016+K055*<O3P>+K065*<OH>+K074*<NO3>+K081*<O3> - PLOSS(:,25) = +TPK%K016(:)+TPK%K055(:)*TPK%O3P(:)+TPK%K065(:)*PCONC(:,14)+TPK%& + PLOSS(:,26) = +TPK%K016(:)+TPK%K055(:)*TPK%O3P(:)+TPK%K065(:)*PCONC(:,15)+TPK%& &K074(:)*PCONC(:,5)+TPK%K081(:)*PCONC(:,1) ! !PPROD(ONIT) = +0.60*K078*<PAN>*<NO3>+K083*<PHO>*<NO2>+0.08459*K091*<ALKAP>*<NO !>+0.15300*K093*<BIOP>*<NO>+0.04885*K094*<AROP>*<NO>+0.18401*K096*<OLN>*<NO>+K1 !03*<OLN>*<HO2>+0.67560*K110*<OLN>*<MO2>+0.66562*K116*<OLN>*<CARBOP>+2.00*K117* !<OLN>*<OLN>+0.00000*K118*<OLN>*<OLN>+0.25928*K125*<OLN>*<NO3> - PPROD(:,26) = +0.60*TPK%K078(:)*PCONC(:,27)*PCONC(:,5)+TPK%K083(:)*PCONC(:,36)& -&*PCONC(:,4)+0.08459*TPK%K091(:)*PCONC(:,33)*PCONC(:,3)+0.15300*TPK%K093(:)*PCO& -&NC(:,35)*PCONC(:,3)+0.04885*TPK%K094(:)*PCONC(:,38)*PCONC(:,3)+0.18401*TPK%K09& -&6(:)*PCONC(:,40)*PCONC(:,3)+TPK%K103(:)*PCONC(:,40)*PCONC(:,15)+0.67560*TPK%K1& -&10(:)*PCONC(:,40)*PCONC(:,32)+0.66562*TPK%K116(:)*PCONC(:,40)*PCONC(:,39)+2.00& -&*TPK%K117(:)*PCONC(:,40)*PCONC(:,40)+0.00000*TPK%K118(:)*PCONC(:,40)*PCONC(:,4& -&0)+0.25928*TPK%K125(:)*PCONC(:,40)*PCONC(:,5) + PPROD(:,27) = +0.60*TPK%K078(:)*PCONC(:,28)*PCONC(:,5)+TPK%K083(:)*PCONC(:,37)& +&*PCONC(:,4)+0.08459*TPK%K091(:)*PCONC(:,34)*PCONC(:,3)+0.15300*TPK%K093(:)*PCO& +&NC(:,36)*PCONC(:,3)+0.04885*TPK%K094(:)*PCONC(:,39)*PCONC(:,3)+0.18401*TPK%K09& +&6(:)*PCONC(:,41)*PCONC(:,3)+TPK%K103(:)*PCONC(:,41)*PCONC(:,16)+0.67560*TPK%K1& +&10(:)*PCONC(:,41)*PCONC(:,33)+0.66562*TPK%K116(:)*PCONC(:,41)*PCONC(:,40)+2.00& +&*TPK%K117(:)*PCONC(:,41)*PCONC(:,41)+0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,4& +&1)+0.25928*TPK%K125(:)*PCONC(:,41)*PCONC(:,5) !PLOSS(ONIT) = +K017+K071*<OH> - PLOSS(:,26) = +TPK%K017(:)+TPK%K071(:)*PCONC(:,14) + PLOSS(:,27) = +TPK%K017(:)+TPK%K071(:)*PCONC(:,15) ! !PPROD(PAN) = +0.28107*K070*<PAN>*<OH>+0.40000*K078*<PAN>*<NO3>+0.30000*K082*<P !AN>*<O3>+1.00000*K088*<CARBOP>*<NO2> - PPROD(:,27) = +0.28107*TPK%K070(:)*PCONC(:,27)*PCONC(:,14)+0.40000*TPK%K078(:)& -&*PCONC(:,27)*PCONC(:,5)+0.30000*TPK%K082(:)*PCONC(:,27)*PCONC(:,1)+1.00000*TPK& -&%K088(:)*PCONC(:,39)*PCONC(:,4) + PPROD(:,28) = +0.28107*TPK%K070(:)*PCONC(:,28)*PCONC(:,15)+0.40000*TPK%K078(:)& +&*PCONC(:,28)*PCONC(:,5)+0.30000*TPK%K082(:)*PCONC(:,28)*PCONC(:,1)+1.00000*TPK& +&%K088(:)*PCONC(:,40)*PCONC(:,4) !PLOSS(PAN) = +K070*<OH>+K078*<NO3>+K082*<O3>+K089 - PLOSS(:,27) = +TPK%K070(:)*PCONC(:,14)+TPK%K078(:)*PCONC(:,5)+TPK%K082(:)*PCON& + PLOSS(:,28) = +TPK%K070(:)*PCONC(:,15)+TPK%K078(:)*PCONC(:,5)+TPK%K082(:)*PCON& &C(:,1)+TPK%K089(:) ! !PPROD(OP1) = +K097*<MO2>*<HO2> - PPROD(:,28) = +TPK%K097(:)*PCONC(:,32)*PCONC(:,15) + PPROD(:,29) = +TPK%K097(:)*PCONC(:,33)*PCONC(:,16) !PLOSS(OP1) = +K013+K068*<OH> - PLOSS(:,28) = +TPK%K013(:)+TPK%K068(:)*PCONC(:,14) + PLOSS(:,29) = +TPK%K013(:)+TPK%K068(:)*PCONC(:,15) ! !PPROD(OP2) = +0.10149*K081*<CARBO>*<O3>+1.00524*K098*<ALKAP>*<HO2>+1.00524*K09 !9*<ALKEP>*<HO2>+1.00524*K0100*<BIOP>*<HO2>+1.00524*K0101*<AROP>*<HO2>+0.80904* !K0102*<CARBOP>*<HO2>+1.00524*K126*<XO2>*<HO2> - PPROD(:,29) = +0.10149*TPK%K081(:)*PCONC(:,25)*PCONC(:,1)+1.00524*TPK%K098(:)*& -&PCONC(:,33)*PCONC(:,15)+1.00524*TPK%K099(:)*PCONC(:,34)*PCONC(:,15)+1.00524*TP& -&K%K0100(:)*PCONC(:,35)*PCONC(:,15)+1.00524*TPK%K0101(:)*PCONC(:,38)*PCONC(:,15& -&)+0.80904*TPK%K0102(:)*PCONC(:,39)*PCONC(:,15)+1.00524*TPK%K126(:)*PCONC(:,41)& -&*PCONC(:,15) + PPROD(:,30) = +0.10149*TPK%K081(:)*PCONC(:,26)*PCONC(:,1)+1.00524*TPK%K098(:)*& +&PCONC(:,34)*PCONC(:,16)+1.00524*TPK%K099(:)*PCONC(:,35)*PCONC(:,16)+1.00524*TP& +&K%K0100(:)*PCONC(:,36)*PCONC(:,16)+1.00524*TPK%K0101(:)*PCONC(:,39)*PCONC(:,16& +&)+0.80904*TPK%K0102(:)*PCONC(:,40)*PCONC(:,16)+1.00524*TPK%K126(:)*PCONC(:,42)& +&*PCONC(:,16) !PLOSS(OP2) = +K014+K069*<OH> - PLOSS(:,29) = +TPK%K014(:)+TPK%K069(:)*PCONC(:,14) -! -!PPROD(ORA1) = +0.00878*K058*<ALKA>*<OH>+0.15343*K079*<ALKE>*<O3>+0.15000*K080* -!<BIO>*<O3>+0.10788*K081*<CARBO>*<O3>+0.11*K082*<PAN>*<O3> - PPROD(:,30) = +0.00878*TPK%K058(:)*PCONC(:,18)*PCONC(:,14)+0.15343*TPK%K079(:)& -&*PCONC(:,19)*PCONC(:,1)+0.15000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1)+0.10788*TPK& -&%K081(:)*PCONC(:,25)*PCONC(:,1)+0.11*TPK%K082(:)*PCONC(:,27)*PCONC(:,1) -!PLOSS(ORA1) = +K066*<OH> - PLOSS(:,30) = +TPK%K066(:)*PCONC(:,14) + PLOSS(:,30) = +TPK%K014(:)+TPK%K069(:)*PCONC(:,15) ! RETURN END SUBROUTINE SUB2 @@ -5599,18 +5641,26 @@ SUBROUTINE SUB3 !Indices 31 a 40 ! ! +!PPROD(ORA1) = +0.00878*K058*<ALKA>*<OH>+0.15343*K079*<ALKE>*<O3>+0.15000*K080* +!<BIO>*<O3>+0.10788*K081*<CARBO>*<O3>+0.11*K082*<PAN>*<O3> + PPROD(:,31) = +0.00878*TPK%K058(:)*PCONC(:,19)*PCONC(:,15)+0.15343*TPK%K079(:)& +&*PCONC(:,20)*PCONC(:,1)+0.15000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.10788*TPK& +&%K081(:)*PCONC(:,26)*PCONC(:,1)+0.11*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) +!PLOSS(ORA1) = +K066*<OH> + PLOSS(:,31) = +TPK%K066(:)*PCONC(:,15) +! !PPROD(ORA2) = +0.08143*K079*<ALKE>*<O3>+0.00000*K080*<BIO>*<O3>+0.20595*K081*< !CARBO>*<O3>+0.17307*K0102*<CARBOP>*<HO2>+0.13684*K109*<CARBOP>*<MO2>+0.49810*K !111*<ALKAP>*<CARBOP>+0.49922*K112*<ALKEP>*<CARBOP>+0.49400*K113*<BIOP>*<CARBOP !>+0.09955*K115*<CARBOP>*<CARBOP>+0.48963*K116*<OLN>*<CARBOP> - PPROD(:,31) = +0.08143*TPK%K079(:)*PCONC(:,19)*PCONC(:,1)+0.00000*TPK%K080(:)*& -&PCONC(:,20)*PCONC(:,1)+0.20595*TPK%K081(:)*PCONC(:,25)*PCONC(:,1)+0.17307*TPK%& -&K0102(:)*PCONC(:,39)*PCONC(:,15)+0.13684*TPK%K109(:)*PCONC(:,39)*PCONC(:,32)+0& -&.49810*TPK%K111(:)*PCONC(:,33)*PCONC(:,39)+0.49922*TPK%K112(:)*PCONC(:,34)*PCO& -&NC(:,39)+0.49400*TPK%K113(:)*PCONC(:,35)*PCONC(:,39)+0.09955*TPK%K115(:)*PCONC& -&(:,39)*PCONC(:,39)+0.48963*TPK%K116(:)*PCONC(:,40)*PCONC(:,39) + PPROD(:,32) = +0.08143*TPK%K079(:)*PCONC(:,20)*PCONC(:,1)+0.00000*TPK%K080(:)*& +&PCONC(:,21)*PCONC(:,1)+0.20595*TPK%K081(:)*PCONC(:,26)*PCONC(:,1)+0.17307*TPK%& +&K0102(:)*PCONC(:,40)*PCONC(:,16)+0.13684*TPK%K109(:)*PCONC(:,40)*PCONC(:,33)+0& +&.49810*TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.49922*TPK%K112(:)*PCONC(:,35)*PCO& +&NC(:,40)+0.49400*TPK%K113(:)*PCONC(:,36)*PCONC(:,40)+0.09955*TPK%K115(:)*PCONC& +&(:,40)*PCONC(:,40)+0.48963*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) !PLOSS(ORA2) = +K067*<OH> - PLOSS(:,31) = +TPK%K067(:)*PCONC(:,14) + PLOSS(:,32) = +TPK%K067(:)*PCONC(:,15) ! !PPROD(MO2) = +K012*<ALD>+0.03795*K014*<OP2>+K056*<CH4>*<OH>+0.65*K068*<OP1>*<O !H>+0.13966*K079*<ALKE>*<O3>+0.03000*K080*<BIO>*<O3>+0.09016*K091*<ALKAP>*<NO>+ @@ -5619,69 +5669,69 @@ SUBROUTINE SUB3 !BIOP>*<CARBOP>+K114*<AROP>*<CARBOP>+1.66702*K115*<CARBOP>*<CARBOP>+0.51037*K11 !6*<OLN>*<CARBOP>+0.09731*K120*<ALKAP>*<NO3>+0.91910*K124*<CARBOP>*<NO3>+K128*< !XO2>*<CARBOP> - PPROD(:,32) = +TPK%K012(:)*PCONC(:,23)+0.03795*TPK%K014(:)*PCONC(:,29)+TPK%K05& -&6(:)*PCONC(:,16)*PCONC(:,14)+0.65*TPK%K068(:)*PCONC(:,28)*PCONC(:,14)+0.13966*& -&TPK%K079(:)*PCONC(:,19)*PCONC(:,1)+0.03000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1)+& -&0.09016*TPK%K091(:)*PCONC(:,33)*PCONC(:,3)+0.78134*TPK%K095(:)*PCONC(:,39)*PCO& -&NC(:,3)+0.01390*TPK%K105(:)*PCONC(:,33)*PCONC(:,32)+0.56031*TPK%K109(:)*PCONC(& -&:,39)*PCONC(:,32)+0.51480*TPK%K111(:)*PCONC(:,33)*PCONC(:,39)+0.50078*TPK%K112& -&(:)*PCONC(:,34)*PCONC(:,39)+0.50600*TPK%K113(:)*PCONC(:,35)*PCONC(:,39)+TPK%K1& -&14(:)*PCONC(:,38)*PCONC(:,39)+1.66702*TPK%K115(:)*PCONC(:,39)*PCONC(:,39)+0.51& -&037*TPK%K116(:)*PCONC(:,40)*PCONC(:,39)+0.09731*TPK%K120(:)*PCONC(:,33)*PCONC(& -&:,5)+0.91910*TPK%K124(:)*PCONC(:,39)*PCONC(:,5)+TPK%K128(:)*PCONC(:,41)*PCONC(& -&:,39) + PPROD(:,33) = +TPK%K012(:)*PCONC(:,24)+0.03795*TPK%K014(:)*PCONC(:,30)+TPK%K05& +&6(:)*PCONC(:,17)*PCONC(:,15)+0.65*TPK%K068(:)*PCONC(:,29)*PCONC(:,15)+0.13966*& +&TPK%K079(:)*PCONC(:,20)*PCONC(:,1)+0.03000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+& +&0.09016*TPK%K091(:)*PCONC(:,34)*PCONC(:,3)+0.78134*TPK%K095(:)*PCONC(:,40)*PCO& +&NC(:,3)+0.01390*TPK%K105(:)*PCONC(:,34)*PCONC(:,33)+0.56031*TPK%K109(:)*PCONC(& +&:,40)*PCONC(:,33)+0.51480*TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.50078*TPK%K112& +&(:)*PCONC(:,35)*PCONC(:,40)+0.50600*TPK%K113(:)*PCONC(:,36)*PCONC(:,40)+TPK%K1& +&14(:)*PCONC(:,39)*PCONC(:,40)+1.66702*TPK%K115(:)*PCONC(:,40)*PCONC(:,40)+0.51& +&037*TPK%K116(:)*PCONC(:,41)*PCONC(:,40)+0.09731*TPK%K120(:)*PCONC(:,34)*PCONC(& +&:,5)+0.91910*TPK%K124(:)*PCONC(:,40)*PCONC(:,5)+TPK%K128(:)*PCONC(:,42)*PCONC(& +&:,40) !PLOSS(MO2) = +K090*<NO>+K097*<HO2>+K104*<MO2>+K104*<MO2>+K105*<ALKAP>+K106*<AL !KEP>+K107*<BIOP>+K108*<AROP>+K109*<CARBOP>+K110*<OLN>+K119*<NO3>+K127*<XO2> - PLOSS(:,32) = +TPK%K090(:)*PCONC(:,3)+TPK%K097(:)*PCONC(:,15)+TPK%K104(:)*PCON& -&C(:,32)+TPK%K104(:)*PCONC(:,32)+TPK%K105(:)*PCONC(:,33)+TPK%K106(:)*PCONC(:,34& -&)+TPK%K107(:)*PCONC(:,35)+TPK%K108(:)*PCONC(:,38)+TPK%K109(:)*PCONC(:,39)+TPK%& -&K110(:)*PCONC(:,40)+TPK%K119(:)*PCONC(:,5)+TPK%K127(:)*PCONC(:,41) + PLOSS(:,33) = +TPK%K090(:)*PCONC(:,3)+TPK%K097(:)*PCONC(:,16)+TPK%K104(:)*PCON& +&C(:,33)+TPK%K104(:)*PCONC(:,33)+TPK%K105(:)*PCONC(:,34)+TPK%K106(:)*PCONC(:,35& +&)+TPK%K107(:)*PCONC(:,36)+TPK%K108(:)*PCONC(:,39)+TPK%K109(:)*PCONC(:,40)+TPK%& +&K110(:)*PCONC(:,41)+TPK%K119(:)*PCONC(:,5)+TPK%K127(:)*PCONC(:,42) ! !PPROD(ALKAP) = +1.00000*K015*<KET>+K057*<ETH>*<OH>+0.87811*K058*<ALKA>*<OH>+0. !40341*K069*<OP2>*<OH>+1.00000*K071*<ONIT>*<OH>+0.09815*K079*<ALKE>*<O3>+0.0000 !0*K080*<BIO>*<O3>+0.08187*K091*<ALKAP>*<NO>+0.00385*K105*<ALKAP>*<MO2>+0.00828 !*K111*<ALKAP>*<CARBOP>+0.08994*K120*<ALKAP>*<NO3> - PPROD(:,33) = +1.00000*TPK%K015(:)*PCONC(:,24)+TPK%K057(:)*PCONC(:,17)*PCONC(:& -&,14)+0.87811*TPK%K058(:)*PCONC(:,18)*PCONC(:,14)+0.40341*TPK%K069(:)*PCONC(:,2& -&9)*PCONC(:,14)+1.00000*TPK%K071(:)*PCONC(:,26)*PCONC(:,14)+0.09815*TPK%K079(:)& -&*PCONC(:,19)*PCONC(:,1)+0.00000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1)+0.08187*TPK& -&%K091(:)*PCONC(:,33)*PCONC(:,3)+0.00385*TPK%K105(:)*PCONC(:,33)*PCONC(:,32)+0.& -&00828*TPK%K111(:)*PCONC(:,33)*PCONC(:,39)+0.08994*TPK%K120(:)*PCONC(:,33)*PCON& + PPROD(:,34) = +1.00000*TPK%K015(:)*PCONC(:,25)+TPK%K057(:)*PCONC(:,18)*PCONC(:& +&,15)+0.87811*TPK%K058(:)*PCONC(:,19)*PCONC(:,15)+0.40341*TPK%K069(:)*PCONC(:,3& +&0)*PCONC(:,15)+1.00000*TPK%K071(:)*PCONC(:,27)*PCONC(:,15)+0.09815*TPK%K079(:)& +&*PCONC(:,20)*PCONC(:,1)+0.00000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.08187*TPK& +&%K091(:)*PCONC(:,34)*PCONC(:,3)+0.00385*TPK%K105(:)*PCONC(:,34)*PCONC(:,33)+0.& +&00828*TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.08994*TPK%K120(:)*PCONC(:,34)*PCON& &C(:,5) !PLOSS(ALKAP) = +K091*<NO>+K098*<HO2>+K105*<MO2>+K111*<CARBOP>+K120*<NO3> - PLOSS(:,33) = +TPK%K091(:)*PCONC(:,3)+TPK%K098(:)*PCONC(:,15)+TPK%K105(:)*PCON& -&C(:,32)+TPK%K111(:)*PCONC(:,39)+TPK%K120(:)*PCONC(:,5) + PLOSS(:,34) = +TPK%K091(:)*PCONC(:,3)+TPK%K098(:)*PCONC(:,16)+TPK%K105(:)*PCON& +&C(:,33)+TPK%K111(:)*PCONC(:,40)+TPK%K120(:)*PCONC(:,5) ! !PPROD(ALKEP) = +1.02529*K059*<ALKE>*<OH> - PPROD(:,34) = +1.02529*TPK%K059(:)*PCONC(:,19)*PCONC(:,14) + PPROD(:,35) = +1.02529*TPK%K059(:)*PCONC(:,20)*PCONC(:,15) !PLOSS(ALKEP) = +K092*<NO>+K099*<HO2>+K106*<MO2>+K112*<CARBOP>+K121*<NO3> - PLOSS(:,34) = +TPK%K092(:)*PCONC(:,3)+TPK%K099(:)*PCONC(:,15)+TPK%K106(:)*PCON& -&C(:,32)+TPK%K112(:)*PCONC(:,39)+TPK%K121(:)*PCONC(:,5) + PLOSS(:,35) = +TPK%K092(:)*PCONC(:,3)+TPK%K099(:)*PCONC(:,16)+TPK%K106(:)*PCON& +&C(:,33)+TPK%K112(:)*PCONC(:,40)+TPK%K121(:)*PCONC(:,5) ! !PPROD(BIOP) = +0.00000*K059*<ALKE>*<OH>+1.00000*K060*<BIO>*<OH> - PPROD(:,35) = +0.00000*TPK%K059(:)*PCONC(:,19)*PCONC(:,14)+1.00000*TPK%K060(:)& -&*PCONC(:,20)*PCONC(:,14) + PPROD(:,36) = +0.00000*TPK%K059(:)*PCONC(:,20)*PCONC(:,15)+1.00000*TPK%K060(:)& +&*PCONC(:,21)*PCONC(:,15) !PLOSS(BIOP) = +K093*<NO>+K0100*<HO2>+K107*<MO2>+K113*<CARBOP>+K122*<NO3> - PLOSS(:,35) = +TPK%K093(:)*PCONC(:,3)+TPK%K0100(:)*PCONC(:,15)+TPK%K107(:)*PCO& -&NC(:,32)+TPK%K113(:)*PCONC(:,39)+TPK%K122(:)*PCONC(:,5) + PLOSS(:,36) = +TPK%K093(:)*PCONC(:,3)+TPK%K0100(:)*PCONC(:,16)+TPK%K107(:)*PCO& +&NC(:,33)+TPK%K113(:)*PCONC(:,40)+TPK%K122(:)*PCONC(:,5) ! !PPROD(PHO) = +0.00276*K061*<ARO>*<OH>+K075*<ARO>*<NO3> - PPROD(:,36) = +0.00276*TPK%K061(:)*PCONC(:,21)*PCONC(:,14)+TPK%K075(:)*PCONC(:& -&,21)*PCONC(:,5) + PPROD(:,37) = +0.00276*TPK%K061(:)*PCONC(:,22)*PCONC(:,15)+TPK%K075(:)*PCONC(:& +&,22)*PCONC(:,5) !PLOSS(PHO) = +K083*<NO2>+K084*<HO2> - PLOSS(:,36) = +TPK%K083(:)*PCONC(:,4)+TPK%K084(:)*PCONC(:,15) + PLOSS(:,37) = +TPK%K083(:)*PCONC(:,4)+TPK%K084(:)*PCONC(:,16) ! !PPROD(ADD) = +0.93968*K061*<ARO>*<OH> - PPROD(:,37) = +0.93968*TPK%K061(:)*PCONC(:,21)*PCONC(:,14) + PPROD(:,38) = +0.93968*TPK%K061(:)*PCONC(:,22)*PCONC(:,15) !PLOSS(ADD) = +K085*<NO2>+K086*<O2>+K087*<O3> - PLOSS(:,37) = +TPK%K085(:)*PCONC(:,4)+TPK%K086(:)*TPK%O2(:)+TPK%K087(:)*PCONC(& + PLOSS(:,38) = +TPK%K085(:)*PCONC(:,4)+TPK%K086(:)*TPK%O2(:)+TPK%K087(:)*PCONC(& &:,1) ! !PPROD(AROP) = +0.98*K086*<ADD>*<O2> - PPROD(:,38) = +0.98*TPK%K086(:)*PCONC(:,37)*TPK%O2(:) + PPROD(:,39) = +0.98*TPK%K086(:)*PCONC(:,38)*TPK%O2(:) !PLOSS(AROP) = +K094*<NO>+K0101*<HO2>+K108*<MO2>+K114*<CARBOP>+K123*<NO3> - PLOSS(:,38) = +TPK%K094(:)*PCONC(:,3)+TPK%K0101(:)*PCONC(:,15)+TPK%K108(:)*PCO& -&NC(:,32)+TPK%K114(:)*PCONC(:,39)+TPK%K123(:)*PCONC(:,5) + PLOSS(:,39) = +TPK%K094(:)*PCONC(:,3)+TPK%K0101(:)*PCONC(:,16)+TPK%K108(:)*PCO& +&NC(:,33)+TPK%K114(:)*PCONC(:,40)+TPK%K123(:)*PCONC(:,5) ! !PPROD(CARBOP) = +1.00000*K015*<KET>+0.69622*K016*<CARBO>+1.00000*K063*<ALD>*<O !H>+1.00000*K064*<KET>*<OH>+0.51419*K065*<CARBO>*<OH>+0.05413*K069*<OP2>*<OH>+1 @@ -5689,42 +5739,42 @@ SUBROUTINE SUB3 !17000*K080*<BIO>*<O3>+0.27460*K081*<CARBO>*<O3>+0.70000*K082*<PAN>*<O3>+1.0000 !0*K089*<PAN>+0.09532*K095*<CARBOP>*<NO>+0.05954*K109*<CARBOP>*<MO2>+0.05821*K1 !15*<CARBOP>*<CARBOP>+0.03175*K124*<CARBOP>*<NO3> - PPROD(:,39) = +1.00000*TPK%K015(:)*PCONC(:,24)+0.69622*TPK%K016(:)*PCONC(:,25)& -&+1.00000*TPK%K063(:)*PCONC(:,23)*PCONC(:,14)+1.00000*TPK%K064(:)*PCONC(:,24)*P& -&CONC(:,14)+0.51419*TPK%K065(:)*PCONC(:,25)*PCONC(:,14)+0.05413*TPK%K069(:)*PCO& -&NC(:,29)*PCONC(:,14)+1.00000*TPK%K073(:)*PCONC(:,23)*PCONC(:,5)+0.38881*TPK%K0& -&74(:)*PCONC(:,25)*PCONC(:,5)+0.05705*TPK%K079(:)*PCONC(:,19)*PCONC(:,1)+0.1700& -&0*TPK%K080(:)*PCONC(:,20)*PCONC(:,1)+0.27460*TPK%K081(:)*PCONC(:,25)*PCONC(:,1& -&)+0.70000*TPK%K082(:)*PCONC(:,27)*PCONC(:,1)+1.00000*TPK%K089(:)*PCONC(:,27)+0& -&.09532*TPK%K095(:)*PCONC(:,39)*PCONC(:,3)+0.05954*TPK%K109(:)*PCONC(:,39)*PCON& -&C(:,32)+0.05821*TPK%K115(:)*PCONC(:,39)*PCONC(:,39)+0.03175*TPK%K124(:)*PCONC(& -&:,39)*PCONC(:,5) + PPROD(:,40) = +1.00000*TPK%K015(:)*PCONC(:,25)+0.69622*TPK%K016(:)*PCONC(:,26)& +&+1.00000*TPK%K063(:)*PCONC(:,24)*PCONC(:,15)+1.00000*TPK%K064(:)*PCONC(:,25)*P& +&CONC(:,15)+0.51419*TPK%K065(:)*PCONC(:,26)*PCONC(:,15)+0.05413*TPK%K069(:)*PCO& +&NC(:,30)*PCONC(:,15)+1.00000*TPK%K073(:)*PCONC(:,24)*PCONC(:,5)+0.38881*TPK%K0& +&74(:)*PCONC(:,26)*PCONC(:,5)+0.05705*TPK%K079(:)*PCONC(:,20)*PCONC(:,1)+0.1700& +&0*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.27460*TPK%K081(:)*PCONC(:,26)*PCONC(:,1& +&)+0.70000*TPK%K082(:)*PCONC(:,28)*PCONC(:,1)+1.00000*TPK%K089(:)*PCONC(:,28)+0& +&.09532*TPK%K095(:)*PCONC(:,40)*PCONC(:,3)+0.05954*TPK%K109(:)*PCONC(:,40)*PCON& +&C(:,33)+0.05821*TPK%K115(:)*PCONC(:,40)*PCONC(:,40)+0.03175*TPK%K124(:)*PCONC(& +&:,40)*PCONC(:,5) !PLOSS(CARBOP) = +K088*<NO2>+K095*<NO>+K0102*<HO2>+K109*<MO2>+K111*<ALKAP>+K112 !*<ALKEP>+K113*<BIOP>+K114*<AROP>+K115*<CARBOP>+K115*<CARBOP>+K116*<OLN>+K124*< !NO3>+K128*<XO2> - PLOSS(:,39) = +TPK%K088(:)*PCONC(:,4)+TPK%K095(:)*PCONC(:,3)+TPK%K0102(:)*PCON& -&C(:,15)+TPK%K109(:)*PCONC(:,32)+TPK%K111(:)*PCONC(:,33)+TPK%K112(:)*PCONC(:,34& -&)+TPK%K113(:)*PCONC(:,35)+TPK%K114(:)*PCONC(:,38)+TPK%K115(:)*PCONC(:,39)+TPK%& -&K115(:)*PCONC(:,39)+TPK%K116(:)*PCONC(:,40)+TPK%K124(:)*PCONC(:,5)+TPK%K128(:)& -&*PCONC(:,41) -! -!PPROD(OLN) = +0.00000*K074*<CARBO>*<NO3>+0.93768*K076*<ALKE>*<NO3>+1.00000*K07 -!7*<BIO>*<NO3> - PPROD(:,40) = +0.00000*TPK%K074(:)*PCONC(:,25)*PCONC(:,5)+0.93768*TPK%K076(:)*& -&PCONC(:,19)*PCONC(:,5)+1.00000*TPK%K077(:)*PCONC(:,20)*PCONC(:,5) -!PLOSS(OLN) = +K096*<NO>+K103*<HO2>+K110*<MO2>+K116*<CARBOP>+K117*<OLN>+K117*<O -!LN>+K118*<OLN>+K118*<OLN>+K125*<NO3> - PLOSS(:,40) = +TPK%K096(:)*PCONC(:,3)+TPK%K103(:)*PCONC(:,15)+TPK%K110(:)*PCON& -&C(:,32)+TPK%K116(:)*PCONC(:,39)+TPK%K117(:)*PCONC(:,40)+TPK%K117(:)*PCONC(:,40& -&)+TPK%K118(:)*PCONC(:,40)+TPK%K118(:)*PCONC(:,40)+TPK%K125(:)*PCONC(:,5) + PLOSS(:,40) = +TPK%K088(:)*PCONC(:,4)+TPK%K095(:)*PCONC(:,3)+TPK%K0102(:)*PCON& +&C(:,16)+TPK%K109(:)*PCONC(:,33)+TPK%K111(:)*PCONC(:,34)+TPK%K112(:)*PCONC(:,35& +&)+TPK%K113(:)*PCONC(:,36)+TPK%K114(:)*PCONC(:,39)+TPK%K115(:)*PCONC(:,40)+TPK%& +&K115(:)*PCONC(:,40)+TPK%K116(:)*PCONC(:,41)+TPK%K124(:)*PCONC(:,5)+TPK%K128(:)& +&*PCONC(:,42) ! RETURN END SUBROUTINE SUB3 ! SUBROUTINE SUB4 ! -!Indices 41 a 41 +!Indices 41 a 42 +! ! +!PPROD(OLN) = +0.00000*K074*<CARBO>*<NO3>+0.93768*K076*<ALKE>*<NO3>+1.00000*K07 +!7*<BIO>*<NO3> + PPROD(:,41) = +0.00000*TPK%K074(:)*PCONC(:,26)*PCONC(:,5)+0.93768*TPK%K076(:)*& +&PCONC(:,20)*PCONC(:,5)+1.00000*TPK%K077(:)*PCONC(:,21)*PCONC(:,5) +!PLOSS(OLN) = +K096*<NO>+K103*<HO2>+K110*<MO2>+K116*<CARBOP>+K117*<OLN>+K117*<O +!LN>+K118*<OLN>+K118*<OLN>+K125*<NO3> + PLOSS(:,41) = +TPK%K096(:)*PCONC(:,3)+TPK%K103(:)*PCONC(:,16)+TPK%K110(:)*PCON& +&C(:,33)+TPK%K116(:)*PCONC(:,40)+TPK%K117(:)*PCONC(:,41)+TPK%K117(:)*PCONC(:,41& +&)+TPK%K118(:)*PCONC(:,41)+TPK%K118(:)*PCONC(:,41)+TPK%K125(:)*PCONC(:,5) ! !PPROD(XO2) = +0.15*K054*<BIO>*<O3P>+0.10318*K061*<ARO>*<OH>+0.10162*K065*<CARB !O>*<OH>+0.09333*K069*<OP2>*<OH>+K070*<PAN>*<OH>+0.10530*K074*<CARBO>*<NO3>+K07 @@ -5732,20 +5782,20 @@ SUBROUTINE SUB4 !LKAP>*<NO>+0.02563*K095*<CARBOP>*<NO>+0.13370*K105*<ALKAP>*<MO2>+0.02212*K109* !<CARBOP>*<MO2>+0.11306*K111*<ALKAP>*<CARBOP>+0.01593*K115*<CARBOP>*<CARBOP>+0. !16271*K120*<ALKAP>*<NO3>+0.01021*K124*<CARBOP>*<NO3> - PPROD(:,41) = +0.15*TPK%K054(:)*PCONC(:,20)*TPK%O3P(:)+0.10318*TPK%K061(:)*PCO& -&NC(:,21)*PCONC(:,14)+0.10162*TPK%K065(:)*PCONC(:,25)*PCONC(:,14)+0.09333*TPK%K& -&069(:)*PCONC(:,29)*PCONC(:,14)+TPK%K070(:)*PCONC(:,27)*PCONC(:,14)+0.10530*TPK& -&%K074(:)*PCONC(:,25)*PCONC(:,5)+TPK%K078(:)*PCONC(:,27)*PCONC(:,5)+0.00000*TPK& -&%K079(:)*PCONC(:,19)*PCONC(:,1)+0.13000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1)+0.1& -&3007*TPK%K091(:)*PCONC(:,33)*PCONC(:,3)+0.02563*TPK%K095(:)*PCONC(:,39)*PCONC(& -&:,3)+0.13370*TPK%K105(:)*PCONC(:,33)*PCONC(:,32)+0.02212*TPK%K109(:)*PCONC(:,3& -&9)*PCONC(:,32)+0.11306*TPK%K111(:)*PCONC(:,33)*PCONC(:,39)+0.01593*TPK%K115(:)& -&*PCONC(:,39)*PCONC(:,39)+0.16271*TPK%K120(:)*PCONC(:,33)*PCONC(:,5)+0.01021*TP& -&K%K124(:)*PCONC(:,39)*PCONC(:,5) + PPROD(:,42) = +0.15*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:)+0.10318*TPK%K061(:)*PCO& +&NC(:,22)*PCONC(:,15)+0.10162*TPK%K065(:)*PCONC(:,26)*PCONC(:,15)+0.09333*TPK%K& +&069(:)*PCONC(:,30)*PCONC(:,15)+TPK%K070(:)*PCONC(:,28)*PCONC(:,15)+0.10530*TPK& +&%K074(:)*PCONC(:,26)*PCONC(:,5)+TPK%K078(:)*PCONC(:,28)*PCONC(:,5)+0.00000*TPK& +&%K079(:)*PCONC(:,20)*PCONC(:,1)+0.13000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1)+0.1& +&3007*TPK%K091(:)*PCONC(:,34)*PCONC(:,3)+0.02563*TPK%K095(:)*PCONC(:,40)*PCONC(& +&:,3)+0.13370*TPK%K105(:)*PCONC(:,34)*PCONC(:,33)+0.02212*TPK%K109(:)*PCONC(:,4& +&0)*PCONC(:,33)+0.11306*TPK%K111(:)*PCONC(:,34)*PCONC(:,40)+0.01593*TPK%K115(:)& +&*PCONC(:,40)*PCONC(:,40)+0.16271*TPK%K120(:)*PCONC(:,34)*PCONC(:,5)+0.01021*TP& +&K%K124(:)*PCONC(:,40)*PCONC(:,5) !PLOSS(XO2) = +K126*<HO2>+K127*<MO2>+K128*<CARBOP>+K129*<XO2>+K129*<XO2>+K130*< !NO>+K131*<NO3> - PLOSS(:,41) = +TPK%K126(:)*PCONC(:,15)+TPK%K127(:)*PCONC(:,32)+TPK%K128(:)*PCO& -&NC(:,39)+TPK%K129(:)*PCONC(:,41)+TPK%K129(:)*PCONC(:,41)+TPK%K130(:)*PCONC(:,3& + PLOSS(:,42) = +TPK%K126(:)*PCONC(:,16)+TPK%K127(:)*PCONC(:,33)+TPK%K128(:)*PCO& +&NC(:,40)+TPK%K129(:)*PCONC(:,42)+TPK%K129(:)*PCONC(:,42)+TPK%K130(:)*PCONC(:,3& &)+TPK%K131(:)*PCONC(:,5) ! RETURN @@ -6019,7 +6069,7 @@ TPK%O3P(:)=(TPK%K001(:)*PCONC(:,JP_NO2)+TPK%K003(:)*PCONC(:,JP_O3)+TPK%K008(:)*P &0.09000*TPK%K080(:)*PCONC(:,JP_BIO)*PCONC(:,JP_O3))/& &(TPK%K018(:)*TPK%O2(:)+TPK%K019(:)*PCONC(:,JP_O3)+TPK%K029(:)*PCONC(:,JP_NO)+& &TPK%K030(:)*PCONC(:,JP_NO2)+TPK%K031(:)*PCONC(:,JP_NO2)+TPK%K054(:)*PCONC(:,JP_BIO)+& - &TPK%K055(:)*PCONC(:,JP_CARBO)) + &TPK%K055(:)*PCONC(:,JP_CARBO)+TPK%K134(:)*PCONC(:,JP_DMS)) ! /END_CODE/ PJAC(:,:,:) = 0.0 CALL SUBJ0 @@ -6053,9 +6103,9 @@ SUBROUTINE SUBJ0 !O3/O3=-K002-K003-K019*<O3P>-K023*<OH>-K024*<HO2>-K042*<NO>-K043*<NO2>-K079*<AL !KE>-K080*<BIO>-K081*<CARBO>-K082*<PAN>-K087*<ADD>-KTC1-KTR1 PJAC(:,1,1)=-TPK%K002(:)-TPK%K003(:)-TPK%K019(:)*TPK%O3P(:)-TPK%K023(:)*PCONC(& -&:,14)-TPK%K024(:)*PCONC(:,15)-TPK%K042(:)*PCONC(:,3)-TPK%K043(:)*PCONC(:,4)-TP& -&K%K079(:)*PCONC(:,19)-TPK%K080(:)*PCONC(:,20)-TPK%K081(:)*PCONC(:,25)-TPK%K082& -&(:)*PCONC(:,27)-TPK%K087(:)*PCONC(:,37)-TPK%KTC1(:)-TPK%KTR1(:) +&:,15)-TPK%K024(:)*PCONC(:,16)-TPK%K042(:)*PCONC(:,3)-TPK%K043(:)*PCONC(:,4)-TP& +&K%K079(:)*PCONC(:,20)-TPK%K080(:)*PCONC(:,21)-TPK%K081(:)*PCONC(:,26)-TPK%K082& +&(:)*PCONC(:,28)-TPK%K087(:)*PCONC(:,38)-TPK%KTC1(:)-TPK%KTR1(:) ! !O3/H2O2=0.0 ! @@ -6077,6 +6127,8 @@ SUBROUTINE SUBJ0 ! !O3/NH3=0.0 ! +!O3/DMS=0.0 +! !O3/SO2=0.0 ! !O3/SULF=0.0 @@ -6084,10 +6136,10 @@ SUBROUTINE SUBJ0 !O3/CO=0.0 ! !O3/OH=-K023*<O3> - PJAC(:,1,14)=-TPK%K023(:)*PCONC(:,1) + PJAC(:,1,15)=-TPK%K023(:)*PCONC(:,1) ! !O3/HO2=-K024*<O3>+0.17307*K0102*<CARBOP> - PJAC(:,1,15)=-TPK%K024(:)*PCONC(:,1)+0.17307*TPK%K0102(:)*PCONC(:,39) + PJAC(:,1,16)=-TPK%K024(:)*PCONC(:,1)+0.17307*TPK%K0102(:)*PCONC(:,40) ! !O3/CH4=0.0 ! @@ -6096,10 +6148,10 @@ SUBROUTINE SUBJ0 !O3/ALKA=0.0 ! !O3/ALKE=-K079*<O3> - PJAC(:,1,19)=-TPK%K079(:)*PCONC(:,1) + PJAC(:,1,20)=-TPK%K079(:)*PCONC(:,1) ! !O3/BIO=-K080*<O3> - PJAC(:,1,20)=-TPK%K080(:)*PCONC(:,1) + PJAC(:,1,21)=-TPK%K080(:)*PCONC(:,1) ! !O3/ARO=0.0 ! @@ -6110,12 +6162,12 @@ SUBROUTINE SUBJ0 !O3/KET=0.0 ! !O3/CARBO=-K081*<O3> - PJAC(:,1,25)=-TPK%K081(:)*PCONC(:,1) + PJAC(:,1,26)=-TPK%K081(:)*PCONC(:,1) ! !O3/ONIT=0.0 ! !O3/PAN=-K082*<O3> - PJAC(:,1,27)=-TPK%K082(:)*PCONC(:,1) + PJAC(:,1,28)=-TPK%K082(:)*PCONC(:,1) ! !O3/OP1=0.0 ! @@ -6136,19 +6188,19 @@ SUBROUTINE SUBJ0 !O3/PHO=0.0 ! !O3/ADD=-K087*<O3> - PJAC(:,1,37)=-TPK%K087(:)*PCONC(:,1) + PJAC(:,1,38)=-TPK%K087(:)*PCONC(:,1) ! !O3/AROP=0.0 ! !O3/CARBOP=+0.17307*K0102*<HO2> - PJAC(:,1,39)=+0.17307*TPK%K0102(:)*PCONC(:,15) + PJAC(:,1,40)=+0.17307*TPK%K0102(:)*PCONC(:,16) ! !O3/OLN=0.0 ! !O3/XO2=0.0 ! !O3/WC_O3=+KTC21 - PJAC(:,1,42)=+TPK%KTC21(:) + PJAC(:,1,43)=+TPK%KTC21(:) ! !O3/WC_H2O2=0.0 ! @@ -6199,7 +6251,7 @@ SUBROUTINE SUBJ0 !O3/WC_AHMS=0.0 ! !O3/WR_O3=+KTR21 - PJAC(:,1,67)=+TPK%KTR21(:) + PJAC(:,1,68)=+TPK%KTR21(:) ! !O3/WR_H2O2=0.0 ! @@ -6250,10 +6302,10 @@ SUBROUTINE SUBJ0 !O3/WR_AHMS=0.0 ! !H2O2/O3=+0.01833*K079*<ALKE>+0.00100*K080*<BIO> - PJAC(:,2,1)=+0.01833*TPK%K079(:)*PCONC(:,19)+0.00100*TPK%K080(:)*PCONC(:,20) + PJAC(:,2,1)=+0.01833*TPK%K079(:)*PCONC(:,20)+0.00100*TPK%K080(:)*PCONC(:,21) ! !H2O2/H2O2=-K009-K026*<OH>-KTC2-KTR2 - PJAC(:,2,2)=-TPK%K009(:)-TPK%K026(:)*PCONC(:,14)-TPK%KTC2(:)-TPK%KTR2(:) + PJAC(:,2,2)=-TPK%K009(:)-TPK%K026(:)*PCONC(:,15)-TPK%KTC2(:)-TPK%KTR2(:) ! !H2O2/NO=0.0 ! @@ -6271,6 +6323,8 @@ SUBROUTINE SUBJ0 ! !H2O2/NH3=0.0 ! +!H2O2/DMS=0.0 +! !H2O2/SO2=0.0 ! !H2O2/SULF=0.0 @@ -6278,11 +6332,11 @@ SUBROUTINE SUBJ0 !H2O2/CO=0.0 ! !H2O2/OH=-K026*<H2O2> - PJAC(:,2,14)=-TPK%K026(:)*PCONC(:,2) + PJAC(:,2,15)=-TPK%K026(:)*PCONC(:,2) ! !H2O2/HO2=+K027*<HO2>+K027*<HO2>+K028*<HO2>*<H2O>+K028*<HO2>*<H2O> - PJAC(:,2,15)=+TPK%K027(:)*PCONC(:,15)+TPK%K027(:)*PCONC(:,15)+TPK%K028(:)*PCON& -&C(:,15)*TPK%H2O(:)+TPK%K028(:)*PCONC(:,15)*TPK%H2O(:) + PJAC(:,2,16)=+TPK%K027(:)*PCONC(:,16)+TPK%K027(:)*PCONC(:,16)+TPK%K028(:)*PCON& +&C(:,16)*TPK%H2O(:)+TPK%K028(:)*PCONC(:,16)*TPK%H2O(:) ! !H2O2/CH4=0.0 ! @@ -6291,10 +6345,10 @@ SUBROUTINE SUBJ0 !H2O2/ALKA=0.0 ! !H2O2/ALKE=+0.01833*K079*<O3> - PJAC(:,2,19)=+0.01833*TPK%K079(:)*PCONC(:,1) + PJAC(:,2,20)=+0.01833*TPK%K079(:)*PCONC(:,1) ! !H2O2/BIO=+0.00100*K080*<O3> - PJAC(:,2,20)=+0.00100*TPK%K080(:)*PCONC(:,1) + PJAC(:,2,21)=+0.00100*TPK%K080(:)*PCONC(:,1) ! !H2O2/ARO=0.0 ! @@ -6341,7 +6395,7 @@ SUBROUTINE SUBJ0 !H2O2/WC_O3=0.0 ! !H2O2/WC_H2O2=+KTC22 - PJAC(:,2,43)=+TPK%KTC22(:) + PJAC(:,2,44)=+TPK%KTC22(:) ! !H2O2/WC_NO=0.0 ! @@ -6392,7 +6446,7 @@ SUBROUTINE SUBJ0 !H2O2/WR_O3=0.0 ! !H2O2/WR_H2O2=+KTR22 - PJAC(:,2,68)=+TPK%KTR22(:) + PJAC(:,2,69)=+TPK%KTR22(:) ! !H2O2/WR_NO=0.0 ! @@ -6448,12 +6502,12 @@ SUBROUTINE SUBJ0 !NO/NO=-K029*<O3P>-K032*<OH>-K035*<HO2>-K042*<O3>-K044*<NO>*<O2>-K044*<NO>*<O2> !-K044*<NO>*<O2>-K044*<NO>*<O2>-K045*<NO3>-K090*<MO2>-K091*<ALKAP>-K092*<ALKEP> !-K093*<BIOP>-K094*<AROP>-K095*<CARBOP>-K096*<OLN>-K130*<XO2>-KTC3-KTR3 - PJAC(:,3,3)=-TPK%K029(:)*TPK%O3P(:)-TPK%K032(:)*PCONC(:,14)-TPK%K035(:)*PCONC(& -&:,15)-TPK%K042(:)*PCONC(:,1)-TPK%K044(:)*PCONC(:,3)*TPK%O2(:)-TPK%K044(:)*PCON& + PJAC(:,3,3)=-TPK%K029(:)*TPK%O3P(:)-TPK%K032(:)*PCONC(:,15)-TPK%K035(:)*PCONC(& +&:,16)-TPK%K042(:)*PCONC(:,1)-TPK%K044(:)*PCONC(:,3)*TPK%O2(:)-TPK%K044(:)*PCON& &C(:,3)*TPK%O2(:)-TPK%K044(:)*PCONC(:,3)*TPK%O2(:)-TPK%K044(:)*PCONC(:,3)*TPK%O& -&2(:)-TPK%K045(:)*PCONC(:,5)-TPK%K090(:)*PCONC(:,32)-TPK%K091(:)*PCONC(:,33)-TP& -&K%K092(:)*PCONC(:,34)-TPK%K093(:)*PCONC(:,35)-TPK%K094(:)*PCONC(:,38)-TPK%K095& -&(:)*PCONC(:,39)-TPK%K096(:)*PCONC(:,40)-TPK%K130(:)*PCONC(:,41)-TPK%KTC3(:)-TP& +&2(:)-TPK%K045(:)*PCONC(:,5)-TPK%K090(:)*PCONC(:,33)-TPK%K091(:)*PCONC(:,34)-TP& +&K%K092(:)*PCONC(:,35)-TPK%K093(:)*PCONC(:,36)-TPK%K094(:)*PCONC(:,39)-TPK%K095& +&(:)*PCONC(:,40)-TPK%K096(:)*PCONC(:,41)-TPK%K130(:)*PCONC(:,42)-TPK%KTC3(:)-TP& &K%KTR3(:) ! !NO/NO2=+K001+K030*<O3P>+K046*<NO3> @@ -6473,6 +6527,8 @@ SUBROUTINE SUBJ0 ! !NO/NH3=0.0 ! +!NO/DMS=0.0 +! !NO/SO2=0.0 ! !NO/SULF=0.0 @@ -6480,10 +6536,10 @@ SUBROUTINE SUBJ0 !NO/CO=0.0 ! !NO/OH=-K032*<NO> - PJAC(:,3,14)=-TPK%K032(:)*PCONC(:,3) + PJAC(:,3,15)=-TPK%K032(:)*PCONC(:,3) ! !NO/HO2=-K035*<NO> - PJAC(:,3,15)=-TPK%K035(:)*PCONC(:,3) + PJAC(:,3,16)=-TPK%K035(:)*PCONC(:,3) ! !NO/CH4=0.0 ! @@ -6518,39 +6574,39 @@ SUBROUTINE SUBJ0 !NO/ORA2=0.0 ! !NO/MO2=-K090*<NO> - PJAC(:,3,32)=-TPK%K090(:)*PCONC(:,3) + PJAC(:,3,33)=-TPK%K090(:)*PCONC(:,3) ! !NO/ALKAP=-K091*<NO> - PJAC(:,3,33)=-TPK%K091(:)*PCONC(:,3) + PJAC(:,3,34)=-TPK%K091(:)*PCONC(:,3) ! !NO/ALKEP=-K092*<NO> - PJAC(:,3,34)=-TPK%K092(:)*PCONC(:,3) + PJAC(:,3,35)=-TPK%K092(:)*PCONC(:,3) ! !NO/BIOP=-K093*<NO> - PJAC(:,3,35)=-TPK%K093(:)*PCONC(:,3) + PJAC(:,3,36)=-TPK%K093(:)*PCONC(:,3) ! !NO/PHO=0.0 ! !NO/ADD=0.0 ! !NO/AROP=-K094*<NO> - PJAC(:,3,38)=-TPK%K094(:)*PCONC(:,3) + PJAC(:,3,39)=-TPK%K094(:)*PCONC(:,3) ! !NO/CARBOP=-K095*<NO> - PJAC(:,3,39)=-TPK%K095(:)*PCONC(:,3) + PJAC(:,3,40)=-TPK%K095(:)*PCONC(:,3) ! !NO/OLN=-K096*<NO> - PJAC(:,3,40)=-TPK%K096(:)*PCONC(:,3) + PJAC(:,3,41)=-TPK%K096(:)*PCONC(:,3) ! !NO/XO2=-K130*<NO> - PJAC(:,3,41)=-TPK%K130(:)*PCONC(:,3) + PJAC(:,3,42)=-TPK%K130(:)*PCONC(:,3) ! !NO/WC_O3=0.0 ! !NO/WC_H2O2=0.0 ! !NO/WC_NO=+KTC23 - PJAC(:,3,44)=+TPK%KTC23(:) + PJAC(:,3,45)=+TPK%KTC23(:) ! !NO/WC_NO2=0.0 ! @@ -6601,7 +6657,7 @@ SUBROUTINE SUBJ0 !NO/WR_H2O2=0.0 ! !NO/WR_NO=+KTR23 - PJAC(:,3,69)=+TPK%KTR23(:) + PJAC(:,3,70)=+TPK%KTR23(:) ! !NO/WR_NO2=0.0 ! @@ -6649,7 +6705,7 @@ SUBROUTINE SUBJ0 ! !NO2/O3=+K042*<NO>-K043*<NO2>+0.70*K082*<PAN> PJAC(:,4,1)=+TPK%K042(:)*PCONC(:,3)-TPK%K043(:)*PCONC(:,4)+0.70*TPK%K082(:)*PC& -&ONC(:,27) +&ONC(:,28) ! !NO2/H2O2=0.0 ! @@ -6657,47 +6713,51 @@ SUBROUTINE SUBJ0 !>*<O2>+K044*<NO>*<O2>+K045*<NO3>+K045*<NO3>+K090*<MO2>+0.91541*K091*<ALKAP>+K0 !92*<ALKEP>+0.84700*K093*<BIOP>+0.95115*K094*<AROP>+K095*<CARBOP>+1.81599*K096* !<OLN>+K130*<XO2> - PJAC(:,4,3)=+TPK%K029(:)*TPK%O3P(:)+TPK%K035(:)*PCONC(:,15)+TPK%K042(:)*PCONC(& + PJAC(:,4,3)=+TPK%K029(:)*TPK%O3P(:)+TPK%K035(:)*PCONC(:,16)+TPK%K042(:)*PCONC(& &:,1)+TPK%K044(:)*PCONC(:,3)*TPK%O2(:)+TPK%K044(:)*PCONC(:,3)*TPK%O2(:)+TPK%K04& &4(:)*PCONC(:,3)*TPK%O2(:)+TPK%K044(:)*PCONC(:,3)*TPK%O2(:)+TPK%K045(:)*PCONC(:& -&,5)+TPK%K045(:)*PCONC(:,5)+TPK%K090(:)*PCONC(:,32)+0.91541*TPK%K091(:)*PCONC(:& -&,33)+TPK%K092(:)*PCONC(:,34)+0.84700*TPK%K093(:)*PCONC(:,35)+0.95115*TPK%K094(& -&:)*PCONC(:,38)+TPK%K095(:)*PCONC(:,39)+1.81599*TPK%K096(:)*PCONC(:,40)+TPK%K13& -&0(:)*PCONC(:,41) +&,5)+TPK%K045(:)*PCONC(:,5)+TPK%K090(:)*PCONC(:,33)+0.91541*TPK%K091(:)*PCONC(:& +&,34)+TPK%K092(:)*PCONC(:,35)+0.84700*TPK%K093(:)*PCONC(:,36)+0.95115*TPK%K094(& +&:)*PCONC(:,39)+TPK%K095(:)*PCONC(:,40)+1.81599*TPK%K096(:)*PCONC(:,41)+TPK%K13& +&0(:)*PCONC(:,42) ! !NO2/NO2=-K001-K030*<O3P>-K031*<O3P>-K033*<OH>-K036*<HO2>-K043*<O3>+K046*<NO3>- !K046*<NO3>-K047*<NO3>-K083*<PHO>-K085*<ADD>-K088*<CARBOP>-KTC4-KTR4 PJAC(:,4,4)=-TPK%K001(:)-TPK%K030(:)*TPK%O3P(:)-TPK%K031(:)*TPK%O3P(:)-TPK%K03& -&3(:)*PCONC(:,14)-TPK%K036(:)*PCONC(:,15)-TPK%K043(:)*PCONC(:,1)+TPK%K046(:)*PC& -&ONC(:,5)-TPK%K046(:)*PCONC(:,5)-TPK%K047(:)*PCONC(:,5)-TPK%K083(:)*PCONC(:,36)& -&-TPK%K085(:)*PCONC(:,37)-TPK%K088(:)*PCONC(:,39)-TPK%KTC4(:)-TPK%KTR4(:) +&3(:)*PCONC(:,15)-TPK%K036(:)*PCONC(:,16)-TPK%K043(:)*PCONC(:,1)+TPK%K046(:)*PC& +&ONC(:,5)-TPK%K046(:)*PCONC(:,5)-TPK%K047(:)*PCONC(:,5)-TPK%K083(:)*PCONC(:,37)& +&-TPK%K085(:)*PCONC(:,38)-TPK%K088(:)*PCONC(:,40)-TPK%KTC4(:)-TPK%KTR4(:) ! !NO2/NO3=+K008+K034*<OH>+0.7*K038*<HO2>+K045*<NO>+K045*<NO>+K046*<NO2>-K046*<NO !2>-K047*<NO2>+K049*<NO3>+K049*<NO3>+K049*<NO3>+K049*<NO3>+0.10530*K074*<CARBO> !+0.40*K078*<PAN>+K119*<MO2>+K120*<ALKAP>+K121*<ALKEP>+K122*<BIOP>+K123*<AROP>+ -!K124*<CARBOP>+1.74072*K125*<OLN>+K131*<XO2> - PJAC(:,4,5)=+TPK%K008(:)+TPK%K034(:)*PCONC(:,14)+0.7*TPK%K038(:)*PCONC(:,15)+T& +!K124*<CARBOP>+1.74072*K125*<OLN>+K131*<XO2>+K133*<DMS> + PJAC(:,4,5)=+TPK%K008(:)+TPK%K034(:)*PCONC(:,15)+0.7*TPK%K038(:)*PCONC(:,16)+T& &PK%K045(:)*PCONC(:,3)+TPK%K045(:)*PCONC(:,3)+TPK%K046(:)*PCONC(:,4)-TPK%K046(:& &)*PCONC(:,4)-TPK%K047(:)*PCONC(:,4)+TPK%K049(:)*PCONC(:,5)+TPK%K049(:)*PCONC(:& &,5)+TPK%K049(:)*PCONC(:,5)+TPK%K049(:)*PCONC(:,5)+0.10530*TPK%K074(:)*PCONC(:,& -&25)+0.40*TPK%K078(:)*PCONC(:,27)+TPK%K119(:)*PCONC(:,32)+TPK%K120(:)*PCONC(:,3& -&3)+TPK%K121(:)*PCONC(:,34)+TPK%K122(:)*PCONC(:,35)+TPK%K123(:)*PCONC(:,38)+TPK& -&%K124(:)*PCONC(:,39)+1.74072*TPK%K125(:)*PCONC(:,40)+TPK%K131(:)*PCONC(:,41) +&26)+0.40*TPK%K078(:)*PCONC(:,28)+TPK%K119(:)*PCONC(:,33)+TPK%K120(:)*PCONC(:,3& +&4)+TPK%K121(:)*PCONC(:,35)+TPK%K122(:)*PCONC(:,36)+TPK%K123(:)*PCONC(:,39)+TPK& +&%K124(:)*PCONC(:,40)+1.74072*TPK%K125(:)*PCONC(:,41)+TPK%K131(:)*PCONC(:,42)+T& +&PK%K133(:)*PCONC(:,11) ! !NO2/N2O5=+K048 PJAC(:,4,6)=+TPK%K048(:) ! !NO2/HONO=+K039*<OH> - PJAC(:,4,7)=+TPK%K039(:)*PCONC(:,14) + PJAC(:,4,7)=+TPK%K039(:)*PCONC(:,15) ! !NO2/HNO3=+K005 PJAC(:,4,8)=+TPK%K005(:) ! !NO2/HNO4=+0.65*K006+K037+K041*<OH> - PJAC(:,4,9)=+0.65*TPK%K006(:)+TPK%K037(:)+TPK%K041(:)*PCONC(:,14) + PJAC(:,4,9)=+0.65*TPK%K006(:)+TPK%K037(:)+TPK%K041(:)*PCONC(:,15) ! !NO2/NH3=0.0 ! +!NO2/DMS=+K133*<NO3> + PJAC(:,4,11)=+TPK%K133(:)*PCONC(:,5) +! !NO2/SO2=0.0 ! !NO2/SULF=0.0 @@ -6705,11 +6765,11 @@ SUBROUTINE SUBJ0 !NO2/CO=0.0 ! !NO2/OH=-K033*<NO2>+K034*<NO3>+K039*<HONO>+K041*<HNO4>+K071*<ONIT> - PJAC(:,4,14)=-TPK%K033(:)*PCONC(:,4)+TPK%K034(:)*PCONC(:,5)+TPK%K039(:)*PCONC(& -&:,7)+TPK%K041(:)*PCONC(:,9)+TPK%K071(:)*PCONC(:,26) + PJAC(:,4,15)=-TPK%K033(:)*PCONC(:,4)+TPK%K034(:)*PCONC(:,5)+TPK%K039(:)*PCONC(& +&:,7)+TPK%K041(:)*PCONC(:,9)+TPK%K071(:)*PCONC(:,27) ! !NO2/HO2=+K035*<NO>-K036*<NO2>+0.7*K038*<NO3> - PJAC(:,4,15)=+TPK%K035(:)*PCONC(:,3)-TPK%K036(:)*PCONC(:,4)+0.7*TPK%K038(:)*PC& + PJAC(:,4,16)=+TPK%K035(:)*PCONC(:,3)-TPK%K036(:)*PCONC(:,4)+0.7*TPK%K038(:)*PC& &ONC(:,5) ! !NO2/CH4=0.0 @@ -6731,13 +6791,13 @@ SUBROUTINE SUBJ0 !NO2/KET=0.0 ! !NO2/CARBO=+0.10530*K074*<NO3> - PJAC(:,4,25)=+0.10530*TPK%K074(:)*PCONC(:,5) + PJAC(:,4,26)=+0.10530*TPK%K074(:)*PCONC(:,5) ! !NO2/ONIT=+K017+K071*<OH> - PJAC(:,4,26)=+TPK%K017(:)+TPK%K071(:)*PCONC(:,14) + PJAC(:,4,27)=+TPK%K017(:)+TPK%K071(:)*PCONC(:,15) ! !NO2/PAN=+0.40*K078*<NO3>+0.70*K082*<O3>+K089 - PJAC(:,4,27)=+0.40*TPK%K078(:)*PCONC(:,5)+0.70*TPK%K082(:)*PCONC(:,1)+TPK%K089& + PJAC(:,4,28)=+0.40*TPK%K078(:)*PCONC(:,5)+0.70*TPK%K082(:)*PCONC(:,1)+TPK%K089& &(:) ! !NO2/OP1=0.0 @@ -6749,39 +6809,39 @@ SUBROUTINE SUBJ0 !NO2/ORA2=0.0 ! !NO2/MO2=+K090*<NO>+0.32440*K110*<OLN>+K119*<NO3> - PJAC(:,4,32)=+TPK%K090(:)*PCONC(:,3)+0.32440*TPK%K110(:)*PCONC(:,40)+TPK%K119(& + PJAC(:,4,33)=+TPK%K090(:)*PCONC(:,3)+0.32440*TPK%K110(:)*PCONC(:,41)+TPK%K119(& &:)*PCONC(:,5) ! !NO2/ALKAP=+0.91541*K091*<NO>+K120*<NO3> - PJAC(:,4,33)=+0.91541*TPK%K091(:)*PCONC(:,3)+TPK%K120(:)*PCONC(:,5) + PJAC(:,4,34)=+0.91541*TPK%K091(:)*PCONC(:,3)+TPK%K120(:)*PCONC(:,5) ! !NO2/ALKEP=+K092*<NO>+K121*<NO3> - PJAC(:,4,34)=+TPK%K092(:)*PCONC(:,3)+TPK%K121(:)*PCONC(:,5) + PJAC(:,4,35)=+TPK%K092(:)*PCONC(:,3)+TPK%K121(:)*PCONC(:,5) ! !NO2/BIOP=+0.84700*K093*<NO>+K122*<NO3> - PJAC(:,4,35)=+0.84700*TPK%K093(:)*PCONC(:,3)+TPK%K122(:)*PCONC(:,5) + PJAC(:,4,36)=+0.84700*TPK%K093(:)*PCONC(:,3)+TPK%K122(:)*PCONC(:,5) ! !NO2/PHO=-K083*<NO2> - PJAC(:,4,36)=-TPK%K083(:)*PCONC(:,4) + PJAC(:,4,37)=-TPK%K083(:)*PCONC(:,4) ! !NO2/ADD=-K085*<NO2> - PJAC(:,4,37)=-TPK%K085(:)*PCONC(:,4) + PJAC(:,4,38)=-TPK%K085(:)*PCONC(:,4) ! !NO2/AROP=+0.95115*K094*<NO>+K123*<NO3> - PJAC(:,4,38)=+0.95115*TPK%K094(:)*PCONC(:,3)+TPK%K123(:)*PCONC(:,5) + PJAC(:,4,39)=+0.95115*TPK%K094(:)*PCONC(:,3)+TPK%K123(:)*PCONC(:,5) ! !NO2/CARBOP=-K088*<NO2>+K095*<NO>+0.00000*K116*<OLN>+K124*<NO3> - PJAC(:,4,39)=-TPK%K088(:)*PCONC(:,4)+TPK%K095(:)*PCONC(:,3)+0.00000*TPK%K116(:& -&)*PCONC(:,40)+TPK%K124(:)*PCONC(:,5) + PJAC(:,4,40)=-TPK%K088(:)*PCONC(:,4)+TPK%K095(:)*PCONC(:,3)+0.00000*TPK%K116(:& +&)*PCONC(:,41)+TPK%K124(:)*PCONC(:,5) ! !NO2/OLN=+1.81599*K096*<NO>+0.32440*K110*<MO2>+0.00000*K116*<CARBOP>+0.00000*K1 !18*<OLN>+0.00000*K118*<OLN>+1.74072*K125*<NO3> - PJAC(:,4,40)=+1.81599*TPK%K096(:)*PCONC(:,3)+0.32440*TPK%K110(:)*PCONC(:,32)+0& -&.00000*TPK%K116(:)*PCONC(:,39)+0.00000*TPK%K118(:)*PCONC(:,40)+0.00000*TPK%K11& -&8(:)*PCONC(:,40)+1.74072*TPK%K125(:)*PCONC(:,5) + PJAC(:,4,41)=+1.81599*TPK%K096(:)*PCONC(:,3)+0.32440*TPK%K110(:)*PCONC(:,33)+0& +&.00000*TPK%K116(:)*PCONC(:,40)+0.00000*TPK%K118(:)*PCONC(:,41)+0.00000*TPK%K11& +&8(:)*PCONC(:,41)+1.74072*TPK%K125(:)*PCONC(:,5) ! !NO2/XO2=+K130*<NO>+K131*<NO3> - PJAC(:,4,41)=+TPK%K130(:)*PCONC(:,3)+TPK%K131(:)*PCONC(:,5) + PJAC(:,4,42)=+TPK%K130(:)*PCONC(:,3)+TPK%K131(:)*PCONC(:,5) ! !NO2/WC_O3=0.0 ! @@ -6790,7 +6850,7 @@ SUBROUTINE SUBJ0 !NO2/WC_NO=0.0 ! !NO2/WC_NO2=+KTC24 - PJAC(:,4,45)=+TPK%KTC24(:) + PJAC(:,4,46)=+TPK%KTC24(:) ! !NO2/WC_NO3=0.0 ! @@ -6841,7 +6901,7 @@ SUBROUTINE SUBJ0 !NO2/WR_NO=0.0 ! !NO2/WR_NO2=+KTR24 - PJAC(:,4,70)=+TPK%KTR24(:) + PJAC(:,4,71)=+TPK%KTR24(:) ! !NO2/WR_NO3=0.0 ! @@ -6900,17 +6960,17 @@ SUBROUTINE SUBJ0 !NO3/NO3=-K007-K008-K034*<OH>-K038*<HO2>-K045*<NO>-K046*<NO2>-K047*<NO2>-K049*< !NO3>-K049*<NO3>-K049*<NO3>-K049*<NO3>-K072*<HCHO>-K073*<ALD>-K074*<CARBO>-K075 !*<ARO>-K076*<ALKE>-K077*<BIO>+0.60*K078*<PAN>-K078*<PAN>-K119*<MO2>-K120*<ALKA -!P>-K121*<ALKEP>-K122*<BIOP>-K123*<AROP>-K124*<CARBOP>-K125*<OLN>-K131*<XO2>-KT -!C5-KTR5 - PJAC(:,5,5)=-TPK%K007(:)-TPK%K008(:)-TPK%K034(:)*PCONC(:,14)-TPK%K038(:)*PCONC& -&(:,15)-TPK%K045(:)*PCONC(:,3)-TPK%K046(:)*PCONC(:,4)-TPK%K047(:)*PCONC(:,4)-TP& +!P>-K121*<ALKEP>-K122*<BIOP>-K123*<AROP>-K124*<CARBOP>-K125*<OLN>-K131*<XO2>-K1 +!33*<DMS>-KTC5-KTR5 + PJAC(:,5,5)=-TPK%K007(:)-TPK%K008(:)-TPK%K034(:)*PCONC(:,15)-TPK%K038(:)*PCONC& +&(:,16)-TPK%K045(:)*PCONC(:,3)-TPK%K046(:)*PCONC(:,4)-TPK%K047(:)*PCONC(:,4)-TP& &K%K049(:)*PCONC(:,5)-TPK%K049(:)*PCONC(:,5)-TPK%K049(:)*PCONC(:,5)-TPK%K049(:)& -&*PCONC(:,5)-TPK%K072(:)*PCONC(:,22)-TPK%K073(:)*PCONC(:,23)-TPK%K074(:)*PCONC(& -&:,25)-TPK%K075(:)*PCONC(:,21)-TPK%K076(:)*PCONC(:,19)-TPK%K077(:)*PCONC(:,20)+& -&0.60*TPK%K078(:)*PCONC(:,27)-TPK%K078(:)*PCONC(:,27)-TPK%K119(:)*PCONC(:,32)-T& -&PK%K120(:)*PCONC(:,33)-TPK%K121(:)*PCONC(:,34)-TPK%K122(:)*PCONC(:,35)-TPK%K12& -&3(:)*PCONC(:,38)-TPK%K124(:)*PCONC(:,39)-TPK%K125(:)*PCONC(:,40)-TPK%K131(:)*P& -&CONC(:,41)-TPK%KTC5(:)-TPK%KTR5(:) +&*PCONC(:,5)-TPK%K072(:)*PCONC(:,23)-TPK%K073(:)*PCONC(:,24)-TPK%K074(:)*PCONC(& +&:,26)-TPK%K075(:)*PCONC(:,22)-TPK%K076(:)*PCONC(:,20)-TPK%K077(:)*PCONC(:,21)+& +&0.60*TPK%K078(:)*PCONC(:,28)-TPK%K078(:)*PCONC(:,28)-TPK%K119(:)*PCONC(:,33)-T& +&PK%K120(:)*PCONC(:,34)-TPK%K121(:)*PCONC(:,35)-TPK%K122(:)*PCONC(:,36)-TPK%K12& +&3(:)*PCONC(:,39)-TPK%K124(:)*PCONC(:,40)-TPK%K125(:)*PCONC(:,41)-TPK%K131(:)*P& +&CONC(:,42)-TPK%K133(:)*PCONC(:,11)-TPK%KTC5(:)-TPK%KTR5(:) ! !NO3/N2O5=+K048 PJAC(:,5,6)=+TPK%K048(:) @@ -6918,13 +6978,16 @@ SUBROUTINE SUBJ0 !NO3/HONO=0.0 ! !NO3/HNO3=+K040*<OH> - PJAC(:,5,8)=+TPK%K040(:)*PCONC(:,14) + PJAC(:,5,8)=+TPK%K040(:)*PCONC(:,15) ! !NO3/HNO4=+0.35*K006 PJAC(:,5,9)=+0.35*TPK%K006(:) ! !NO3/NH3=0.0 ! +!NO3/DMS=-K133*<NO3> + PJAC(:,5,11)=-TPK%K133(:)*PCONC(:,5) +! !NO3/SO2=0.0 ! !NO3/SULF=0.0 @@ -6932,11 +6995,11 @@ SUBROUTINE SUBJ0 !NO3/CO=0.0 ! !NO3/OH=-K034*<NO3>+K040*<HNO3>+0.71893*K070*<PAN> - PJAC(:,5,14)=-TPK%K034(:)*PCONC(:,5)+TPK%K040(:)*PCONC(:,8)+0.71893*TPK%K070(:& -&)*PCONC(:,27) + PJAC(:,5,15)=-TPK%K034(:)*PCONC(:,5)+TPK%K040(:)*PCONC(:,8)+0.71893*TPK%K070(:& +&)*PCONC(:,28) ! !NO3/HO2=-K038*<NO3> - PJAC(:,5,15)=-TPK%K038(:)*PCONC(:,5) + PJAC(:,5,16)=-TPK%K038(:)*PCONC(:,5) ! !NO3/CH4=0.0 ! @@ -6945,29 +7008,29 @@ SUBROUTINE SUBJ0 !NO3/ALKA=0.0 ! !NO3/ALKE=-K076*<NO3> - PJAC(:,5,19)=-TPK%K076(:)*PCONC(:,5) + PJAC(:,5,20)=-TPK%K076(:)*PCONC(:,5) ! !NO3/BIO=-K077*<NO3> - PJAC(:,5,20)=-TPK%K077(:)*PCONC(:,5) + PJAC(:,5,21)=-TPK%K077(:)*PCONC(:,5) ! !NO3/ARO=-K075*<NO3> - PJAC(:,5,21)=-TPK%K075(:)*PCONC(:,5) + PJAC(:,5,22)=-TPK%K075(:)*PCONC(:,5) ! !NO3/HCHO=-K072*<NO3> - PJAC(:,5,22)=-TPK%K072(:)*PCONC(:,5) + PJAC(:,5,23)=-TPK%K072(:)*PCONC(:,5) ! !NO3/ALD=-K073*<NO3> - PJAC(:,5,23)=-TPK%K073(:)*PCONC(:,5) + PJAC(:,5,24)=-TPK%K073(:)*PCONC(:,5) ! !NO3/KET=0.0 ! !NO3/CARBO=-K074*<NO3> - PJAC(:,5,25)=-TPK%K074(:)*PCONC(:,5) + PJAC(:,5,26)=-TPK%K074(:)*PCONC(:,5) ! !NO3/ONIT=0.0 ! !NO3/PAN=+0.71893*K070*<OH>+0.60*K078*<NO3>-K078*<NO3> - PJAC(:,5,27)=+0.71893*TPK%K070(:)*PCONC(:,14)+0.60*TPK%K078(:)*PCONC(:,5)-TPK%& + PJAC(:,5,28)=+0.71893*TPK%K070(:)*PCONC(:,15)+0.60*TPK%K078(:)*PCONC(:,5)-TPK%& &K078(:)*PCONC(:,5) ! !NO3/OP1=0.0 @@ -6979,32 +7042,32 @@ SUBROUTINE SUBJ0 !NO3/ORA2=0.0 ! !NO3/MO2=-K119*<NO3> - PJAC(:,5,32)=-TPK%K119(:)*PCONC(:,5) + PJAC(:,5,33)=-TPK%K119(:)*PCONC(:,5) ! !NO3/ALKAP=-K120*<NO3> - PJAC(:,5,33)=-TPK%K120(:)*PCONC(:,5) + PJAC(:,5,34)=-TPK%K120(:)*PCONC(:,5) ! !NO3/ALKEP=-K121*<NO3> - PJAC(:,5,34)=-TPK%K121(:)*PCONC(:,5) + PJAC(:,5,35)=-TPK%K121(:)*PCONC(:,5) ! !NO3/BIOP=-K122*<NO3> - PJAC(:,5,35)=-TPK%K122(:)*PCONC(:,5) + PJAC(:,5,36)=-TPK%K122(:)*PCONC(:,5) ! !NO3/PHO=0.0 ! !NO3/ADD=0.0 ! !NO3/AROP=-K123*<NO3> - PJAC(:,5,38)=-TPK%K123(:)*PCONC(:,5) + PJAC(:,5,39)=-TPK%K123(:)*PCONC(:,5) ! !NO3/CARBOP=-K124*<NO3> - PJAC(:,5,39)=-TPK%K124(:)*PCONC(:,5) + PJAC(:,5,40)=-TPK%K124(:)*PCONC(:,5) ! !NO3/OLN=-K125*<NO3> - PJAC(:,5,40)=-TPK%K125(:)*PCONC(:,5) + PJAC(:,5,41)=-TPK%K125(:)*PCONC(:,5) ! !NO3/XO2=-K131*<NO3> - PJAC(:,5,41)=-TPK%K131(:)*PCONC(:,5) + PJAC(:,5,42)=-TPK%K131(:)*PCONC(:,5) ! !NO3/WC_O3=0.0 ! @@ -7015,7 +7078,7 @@ SUBROUTINE SUBJ0 !NO3/WC_NO2=0.0 ! !NO3/WC_NO3=+KTC25 - PJAC(:,5,46)=+TPK%KTC25(:) + PJAC(:,5,47)=+TPK%KTC25(:) ! !NO3/WC_N2O5=0.0 ! @@ -7066,7 +7129,7 @@ SUBROUTINE SUBJ0 !NO3/WR_NO2=0.0 ! !NO3/WR_NO3=+KTR25 - PJAC(:,5,71)=+TPK%KTR25(:) + PJAC(:,5,72)=+TPK%KTR25(:) ! !NO3/WR_N2O5=0.0 ! @@ -7139,6 +7202,8 @@ SUBROUTINE SUBJ1 ! !N2O5/NH3=0.0 ! +!N2O5/DMS=0.0 +! !N2O5/SO2=0.0 ! !N2O5/SULF=0.0 @@ -7212,7 +7277,7 @@ SUBROUTINE SUBJ1 !N2O5/WC_NO3=0.0 ! !N2O5/WC_N2O5=+KTC26 - PJAC(:,6,47)=+TPK%KTC26(:) + PJAC(:,6,48)=+TPK%KTC26(:) ! !N2O5/WC_HONO=0.0 ! @@ -7263,7 +7328,7 @@ SUBROUTINE SUBJ1 !N2O5/WR_NO3=0.0 ! !N2O5/WR_N2O5=+KTR26 - PJAC(:,6,72)=+TPK%KTR26(:) + PJAC(:,6,73)=+TPK%KTR26(:) ! !N2O5/WR_HONO=0.0 ! @@ -7308,17 +7373,17 @@ SUBROUTINE SUBJ1 !HONO/H2O2=0.0 ! !HONO/NO=+K032*<OH> - PJAC(:,7,3)=+TPK%K032(:)*PCONC(:,14) + PJAC(:,7,3)=+TPK%K032(:)*PCONC(:,15) ! !HONO/NO2=+K085*<ADD> - PJAC(:,7,4)=+TPK%K085(:)*PCONC(:,37) + PJAC(:,7,4)=+TPK%K085(:)*PCONC(:,38) ! !HONO/NO3=0.0 ! !HONO/N2O5=0.0 ! !HONO/HONO=-K004-K039*<OH>-KTC7-KTR7 - PJAC(:,7,7)=-TPK%K004(:)-TPK%K039(:)*PCONC(:,14)-TPK%KTC7(:)-TPK%KTR7(:) + PJAC(:,7,7)=-TPK%K004(:)-TPK%K039(:)*PCONC(:,15)-TPK%KTC7(:)-TPK%KTR7(:) ! !HONO/HNO3=0.0 ! @@ -7326,6 +7391,8 @@ SUBROUTINE SUBJ1 ! !HONO/NH3=0.0 ! +!HONO/DMS=0.0 +! !HONO/SO2=0.0 ! !HONO/SULF=0.0 @@ -7333,7 +7400,7 @@ SUBROUTINE SUBJ1 !HONO/CO=0.0 ! !HONO/OH=+K032*<NO>-K039*<HONO> - PJAC(:,7,14)=+TPK%K032(:)*PCONC(:,3)-TPK%K039(:)*PCONC(:,7) + PJAC(:,7,15)=+TPK%K032(:)*PCONC(:,3)-TPK%K039(:)*PCONC(:,7) ! !HONO/HO2=0.0 ! @@ -7380,7 +7447,7 @@ SUBROUTINE SUBJ1 !HONO/PHO=0.0 ! !HONO/ADD=+K085*<NO2> - PJAC(:,7,37)=+TPK%K085(:)*PCONC(:,4) + PJAC(:,7,38)=+TPK%K085(:)*PCONC(:,4) ! !HONO/AROP=0.0 ! @@ -7403,7 +7470,7 @@ SUBROUTINE SUBJ1 !HONO/WC_N2O5=0.0 ! !HONO/WC_HONO=+KTC27 - PJAC(:,7,48)=+TPK%KTC27(:) + PJAC(:,7,49)=+TPK%KTC27(:) ! !HONO/WC_HNO3=0.0 ! @@ -7454,7 +7521,7 @@ SUBROUTINE SUBJ1 !HONO/WR_N2O5=0.0 ! !HONO/WR_HONO=+KTR27 - PJAC(:,7,73)=+TPK%KTR27(:) + PJAC(:,7,74)=+TPK%KTR27(:) ! !HONO/WR_HNO3=0.0 ! @@ -7499,24 +7566,26 @@ SUBROUTINE SUBJ1 !HNO3/NO=0.0 ! !HNO3/NO2=+K033*<OH> - PJAC(:,8,4)=+TPK%K033(:)*PCONC(:,14) + PJAC(:,8,4)=+TPK%K033(:)*PCONC(:,15) ! !HNO3/NO3=+0.3*K038*<HO2>+K072*<HCHO>+K073*<ALD>+0.91567*K074*<CARBO>+K075*<ARO !> - PJAC(:,8,5)=+0.3*TPK%K038(:)*PCONC(:,15)+TPK%K072(:)*PCONC(:,22)+TPK%K073(:)*P& -&CONC(:,23)+0.91567*TPK%K074(:)*PCONC(:,25)+TPK%K075(:)*PCONC(:,21) + PJAC(:,8,5)=+0.3*TPK%K038(:)*PCONC(:,16)+TPK%K072(:)*PCONC(:,23)+TPK%K073(:)*P& +&CONC(:,24)+0.91567*TPK%K074(:)*PCONC(:,26)+TPK%K075(:)*PCONC(:,22) ! !HNO3/N2O5=0.0 ! !HNO3/HONO=0.0 ! !HNO3/HNO3=-K005-K040*<OH>-KTC8-KTR8 - PJAC(:,8,8)=-TPK%K005(:)-TPK%K040(:)*PCONC(:,14)-TPK%KTC8(:)-TPK%KTR8(:) + PJAC(:,8,8)=-TPK%K005(:)-TPK%K040(:)*PCONC(:,15)-TPK%KTC8(:)-TPK%KTR8(:) ! !HNO3/HNO4=0.0 ! !HNO3/NH3=0.0 ! +!HNO3/DMS=0.0 +! !HNO3/SO2=0.0 ! !HNO3/SULF=0.0 @@ -7524,10 +7593,10 @@ SUBROUTINE SUBJ1 !HNO3/CO=0.0 ! !HNO3/OH=+K033*<NO2>-K040*<HNO3> - PJAC(:,8,14)=+TPK%K033(:)*PCONC(:,4)-TPK%K040(:)*PCONC(:,8) + PJAC(:,8,15)=+TPK%K033(:)*PCONC(:,4)-TPK%K040(:)*PCONC(:,8) ! !HNO3/HO2=+0.3*K038*<NO3> - PJAC(:,8,15)=+0.3*TPK%K038(:)*PCONC(:,5) + PJAC(:,8,16)=+0.3*TPK%K038(:)*PCONC(:,5) ! !HNO3/CH4=0.0 ! @@ -7540,18 +7609,18 @@ SUBROUTINE SUBJ1 !HNO3/BIO=0.0 ! !HNO3/ARO=+K075*<NO3> - PJAC(:,8,21)=+TPK%K075(:)*PCONC(:,5) + PJAC(:,8,22)=+TPK%K075(:)*PCONC(:,5) ! !HNO3/HCHO=+K072*<NO3> - PJAC(:,8,22)=+TPK%K072(:)*PCONC(:,5) + PJAC(:,8,23)=+TPK%K072(:)*PCONC(:,5) ! !HNO3/ALD=+K073*<NO3> - PJAC(:,8,23)=+TPK%K073(:)*PCONC(:,5) + PJAC(:,8,24)=+TPK%K073(:)*PCONC(:,5) ! !HNO3/KET=0.0 ! !HNO3/CARBO=+0.91567*K074*<NO3> - PJAC(:,8,25)=+0.91567*TPK%K074(:)*PCONC(:,5) + PJAC(:,8,26)=+0.91567*TPK%K074(:)*PCONC(:,5) ! !HNO3/ONIT=0.0 ! @@ -7600,7 +7669,7 @@ SUBROUTINE SUBJ1 !HNO3/WC_HONO=0.0 ! !HNO3/WC_HNO3=+KTC28 - PJAC(:,8,49)=+TPK%KTC28(:) + PJAC(:,8,50)=+TPK%KTC28(:) ! !HNO3/WC_HNO4=0.0 ! @@ -7651,7 +7720,7 @@ SUBROUTINE SUBJ1 !HNO3/WR_HONO=0.0 ! !HNO3/WR_HNO3=+KTR28 - PJAC(:,8,74)=+TPK%KTR28(:) + PJAC(:,8,75)=+TPK%KTR28(:) ! !HNO3/WR_HNO4=0.0 ! @@ -7694,7 +7763,7 @@ SUBROUTINE SUBJ1 !HNO4/NO=0.0 ! !HNO4/NO2=+K036*<HO2> - PJAC(:,9,4)=+TPK%K036(:)*PCONC(:,15) + PJAC(:,9,4)=+TPK%K036(:)*PCONC(:,16) ! !HNO4/NO3=0.0 ! @@ -7705,11 +7774,13 @@ SUBROUTINE SUBJ1 !HNO4/HNO3=0.0 ! !HNO4/HNO4=-K006-K037-K041*<OH>-KTC9-KTR9 - PJAC(:,9,9)=-TPK%K006(:)-TPK%K037(:)-TPK%K041(:)*PCONC(:,14)-TPK%KTC9(:)-TPK%K& + PJAC(:,9,9)=-TPK%K006(:)-TPK%K037(:)-TPK%K041(:)*PCONC(:,15)-TPK%KTC9(:)-TPK%K& &TR9(:) ! !HNO4/NH3=0.0 ! +!HNO4/DMS=0.0 +! !HNO4/SO2=0.0 ! !HNO4/SULF=0.0 @@ -7717,10 +7788,10 @@ SUBROUTINE SUBJ1 !HNO4/CO=0.0 ! !HNO4/OH=-K041*<HNO4> - PJAC(:,9,14)=-TPK%K041(:)*PCONC(:,9) + PJAC(:,9,15)=-TPK%K041(:)*PCONC(:,9) ! !HNO4/HO2=+K036*<NO2> - PJAC(:,9,15)=+TPK%K036(:)*PCONC(:,4) + PJAC(:,9,16)=+TPK%K036(:)*PCONC(:,4) ! !HNO4/CH4=0.0 ! @@ -7791,7 +7862,7 @@ SUBROUTINE SUBJ1 !HNO4/WC_HNO3=0.0 ! !HNO4/WC_HNO4=+KTC29 - PJAC(:,9,50)=+TPK%KTC29(:) + PJAC(:,9,51)=+TPK%KTC29(:) ! !HNO4/WC_NH3=0.0 ! @@ -7842,7 +7913,7 @@ SUBROUTINE SUBJ1 !HNO4/WR_HNO3=0.0 ! !HNO4/WR_HNO4=+KTR29 - PJAC(:,9,75)=+TPK%KTR29(:) + PJAC(:,9,76)=+TPK%KTR29(:) ! !HNO4/WR_NH3=0.0 ! @@ -7895,7 +7966,9 @@ SUBROUTINE SUBJ1 !NH3/HNO4=0.0 ! !NH3/NH3=-K050*<OH>-KTC10-KTR10 - PJAC(:,10,10)=-TPK%K050(:)*PCONC(:,14)-TPK%KTC10(:)-TPK%KTR10(:) + PJAC(:,10,10)=-TPK%K050(:)*PCONC(:,15)-TPK%KTC10(:)-TPK%KTR10(:) +! +!NH3/DMS=0.0 ! !NH3/SO2=0.0 ! @@ -7904,7 +7977,7 @@ SUBROUTINE SUBJ1 !NH3/CO=0.0 ! !NH3/OH=-K050*<NH3> - PJAC(:,10,14)=-TPK%K050(:)*PCONC(:,10) + PJAC(:,10,15)=-TPK%K050(:)*PCONC(:,10) ! !NH3/HO2=0.0 ! @@ -7979,7 +8052,7 @@ SUBROUTINE SUBJ1 !NH3/WC_HNO4=0.0 ! !NH3/WC_NH3=+KTC30 - PJAC(:,10,51)=+TPK%KTC30(:) + PJAC(:,10,52)=+TPK%KTC30(:) ! !NH3/WC_OH=0.0 ! @@ -8030,7 +8103,7 @@ SUBROUTINE SUBJ1 !NH3/WR_HNO4=0.0 ! !NH3/WR_NH3=+KTR30 - PJAC(:,10,76)=+TPK%KTR30(:) + PJAC(:,10,77)=+TPK%KTR30(:) ! !NH3/WR_OH=0.0 ! @@ -8070,6 +8143,194 @@ SUBROUTINE SUBJ2 !Indices 11 a 15 ! ! +!DMS/O3=0.0 +! +!DMS/H2O2=0.0 +! +!DMS/NO=0.0 +! +!DMS/NO2=0.0 +! +!DMS/NO3=-K133*<DMS> + PJAC(:,11,5)=-TPK%K133(:)*PCONC(:,11) +! +!DMS/N2O5=0.0 +! +!DMS/HONO=0.0 +! +!DMS/HNO3=0.0 +! +!DMS/HNO4=0.0 +! +!DMS/NH3=0.0 +! +!DMS/DMS=-K133*<NO3>-K134*<O3P>-K135*<OH> + PJAC(:,11,11)=-TPK%K133(:)*PCONC(:,5)-TPK%K134(:)*TPK%O3P(:)-TPK%K135(:)*PCONC& +&(:,15) +! +!DMS/SO2=0.0 +! +!DMS/SULF=0.0 +! +!DMS/CO=0.0 +! +!DMS/OH=-K135*<DMS> + PJAC(:,11,15)=-TPK%K135(:)*PCONC(:,11) +! +!DMS/HO2=0.0 +! +!DMS/CH4=0.0 +! +!DMS/ETH=0.0 +! +!DMS/ALKA=0.0 +! +!DMS/ALKE=0.0 +! +!DMS/BIO=0.0 +! +!DMS/ARO=0.0 +! +!DMS/HCHO=0.0 +! +!DMS/ALD=0.0 +! +!DMS/KET=0.0 +! +!DMS/CARBO=0.0 +! +!DMS/ONIT=0.0 +! +!DMS/PAN=0.0 +! +!DMS/OP1=0.0 +! +!DMS/OP2=0.0 +! +!DMS/ORA1=0.0 +! +!DMS/ORA2=0.0 +! +!DMS/MO2=0.0 +! +!DMS/ALKAP=0.0 +! +!DMS/ALKEP=0.0 +! +!DMS/BIOP=0.0 +! +!DMS/PHO=0.0 +! +!DMS/ADD=0.0 +! +!DMS/AROP=0.0 +! +!DMS/CARBOP=0.0 +! +!DMS/OLN=0.0 +! +!DMS/XO2=0.0 +! +!DMS/WC_O3=0.0 +! +!DMS/WC_H2O2=0.0 +! +!DMS/WC_NO=0.0 +! +!DMS/WC_NO2=0.0 +! +!DMS/WC_NO3=0.0 +! +!DMS/WC_N2O5=0.0 +! +!DMS/WC_HONO=0.0 +! +!DMS/WC_HNO3=0.0 +! +!DMS/WC_HNO4=0.0 +! +!DMS/WC_NH3=0.0 +! +!DMS/WC_OH=0.0 +! +!DMS/WC_HO2=0.0 +! +!DMS/WC_CO2=0.0 +! +!DMS/WC_SO2=0.0 +! +!DMS/WC_SULF=0.0 +! +!DMS/WC_HCHO=0.0 +! +!DMS/WC_ORA1=0.0 +! +!DMS/WC_ORA2=0.0 +! +!DMS/WC_MO2=0.0 +! +!DMS/WC_OP1=0.0 +! +!DMS/WC_ASO3=0.0 +! +!DMS/WC_ASO4=0.0 +! +!DMS/WC_ASO5=0.0 +! +!DMS/WC_AHSO5=0.0 +! +!DMS/WC_AHMS=0.0 +! +!DMS/WR_O3=0.0 +! +!DMS/WR_H2O2=0.0 +! +!DMS/WR_NO=0.0 +! +!DMS/WR_NO2=0.0 +! +!DMS/WR_NO3=0.0 +! +!DMS/WR_N2O5=0.0 +! +!DMS/WR_HONO=0.0 +! +!DMS/WR_HNO3=0.0 +! +!DMS/WR_HNO4=0.0 +! +!DMS/WR_NH3=0.0 +! +!DMS/WR_OH=0.0 +! +!DMS/WR_HO2=0.0 +! +!DMS/WR_CO2=0.0 +! +!DMS/WR_SO2=0.0 +! +!DMS/WR_SULF=0.0 +! +!DMS/WR_HCHO=0.0 +! +!DMS/WR_ORA1=0.0 +! +!DMS/WR_ORA2=0.0 +! +!DMS/WR_MO2=0.0 +! +!DMS/WR_OP1=0.0 +! +!DMS/WR_ASO3=0.0 +! +!DMS/WR_ASO4=0.0 +! +!DMS/WR_ASO5=0.0 +! +!DMS/WR_AHSO5=0.0 +! +!DMS/WR_AHMS=0.0 +! !SO2/O3=0.0 ! !SO2/H2O2=0.0 @@ -8078,7 +8339,8 @@ SUBROUTINE SUBJ2 ! !SO2/NO2=0.0 ! -!SO2/NO3=0.0 +!SO2/NO3=+K133*<DMS> + PJAC(:,12,5)=+TPK%K133(:)*PCONC(:,11) ! !SO2/N2O5=0.0 ! @@ -8090,15 +8352,19 @@ SUBROUTINE SUBJ2 ! !SO2/NH3=0.0 ! +!SO2/DMS=+K133*<NO3>+K134*<O3P>+0.8*K135*<OH> + PJAC(:,12,11)=+TPK%K133(:)*PCONC(:,5)+TPK%K134(:)*TPK%O3P(:)+0.8*TPK%K135(:)*P& +&CONC(:,15) +! !SO2/SO2=-K052*<OH>-KTC14-KTR14 - PJAC(:,11,11)=-TPK%K052(:)*PCONC(:,14)-TPK%KTC14(:)-TPK%KTR14(:) + PJAC(:,12,12)=-TPK%K052(:)*PCONC(:,15)-TPK%KTC14(:)-TPK%KTR14(:) ! !SO2/SULF=0.0 ! !SO2/CO=0.0 ! -!SO2/OH=-K052*<SO2> - PJAC(:,11,14)=-TPK%K052(:)*PCONC(:,11) +!SO2/OH=-K052*<SO2>+0.8*K135*<DMS> + PJAC(:,12,15)=-TPK%K052(:)*PCONC(:,12)+0.8*TPK%K135(:)*PCONC(:,11) ! !SO2/HO2=0.0 ! @@ -8181,7 +8447,7 @@ SUBROUTINE SUBJ2 !SO2/WC_CO2=0.0 ! !SO2/WC_SO2=+KTC34 - PJAC(:,11,55)=+TPK%KTC34(:) + PJAC(:,12,56)=+TPK%KTC34(:) ! !SO2/WC_SULF=0.0 ! @@ -8232,7 +8498,7 @@ SUBROUTINE SUBJ2 !SO2/WR_CO2=0.0 ! !SO2/WR_SO2=+KTR34 - PJAC(:,11,80)=+TPK%KTR34(:) + PJAC(:,12,81)=+TPK%KTR34(:) ! !SO2/WR_SULF=0.0 ! @@ -8276,16 +8542,18 @@ SUBROUTINE SUBJ2 ! !SULF/NH3=0.0 ! +!SULF/DMS=0.0 +! !SULF/SO2=+K052*<OH> - PJAC(:,12,11)=+TPK%K052(:)*PCONC(:,14) + PJAC(:,13,12)=+TPK%K052(:)*PCONC(:,15) ! !SULF/SULF=-K132-KTC15-KTR15 - PJAC(:,12,12)=-TPK%K132(:)-TPK%KTC15(:)-TPK%KTR15(:) + PJAC(:,13,13)=-TPK%K132(:)-TPK%KTC15(:)-TPK%KTR15(:) ! !SULF/CO=0.0 ! !SULF/OH=+K052*<SO2> - PJAC(:,12,14)=+TPK%K052(:)*PCONC(:,11) + PJAC(:,13,15)=+TPK%K052(:)*PCONC(:,12) ! !SULF/HO2=0.0 ! @@ -8370,7 +8638,7 @@ SUBROUTINE SUBJ2 !SULF/WC_SO2=0.0 ! !SULF/WC_SULF=+KTC35 - PJAC(:,12,56)=+TPK%KTC35(:) + PJAC(:,13,57)=+TPK%KTC35(:) ! !SULF/WC_HCHO=0.0 ! @@ -8421,7 +8689,7 @@ SUBROUTINE SUBJ2 !SULF/WR_SO2=0.0 ! !SULF/WR_SULF=+KTR35 - PJAC(:,12,81)=+TPK%KTR35(:) + PJAC(:,13,82)=+TPK%KTR35(:) ! !SULF/WR_HCHO=0.0 ! @@ -8445,8 +8713,8 @@ SUBROUTINE SUBJ2 ! !CO/O3=+0.35120*K079*<ALKE>+0.36000*K080*<BIO>+0.64728*K081*<CARBO>+0.13*K082*< !PAN> - PJAC(:,13,1)=+0.35120*TPK%K079(:)*PCONC(:,19)+0.36000*TPK%K080(:)*PCONC(:,20)+& -&0.64728*TPK%K081(:)*PCONC(:,25)+0.13*TPK%K082(:)*PCONC(:,27) + PJAC(:,14,1)=+0.35120*TPK%K079(:)*PCONC(:,20)+0.36000*TPK%K080(:)*PCONC(:,21)+& +&0.64728*TPK%K081(:)*PCONC(:,26)+0.13*TPK%K082(:)*PCONC(:,28) ! !CO/H2O2=0.0 ! @@ -8455,7 +8723,7 @@ SUBROUTINE SUBJ2 !CO/NO2=0.0 ! !CO/NO3=+K072*<HCHO>+1.33723*K074*<CARBO> - PJAC(:,13,5)=+TPK%K072(:)*PCONC(:,22)+1.33723*TPK%K074(:)*PCONC(:,25) + PJAC(:,14,5)=+TPK%K072(:)*PCONC(:,23)+1.33723*TPK%K074(:)*PCONC(:,26) ! !CO/N2O5=0.0 ! @@ -8467,16 +8735,18 @@ SUBROUTINE SUBJ2 ! !CO/NH3=0.0 ! +!CO/DMS=0.0 +! !CO/SO2=0.0 ! !CO/SULF=0.0 ! !CO/CO=-K053*<OH> - PJAC(:,13,13)=-TPK%K053(:)*PCONC(:,14) + PJAC(:,14,14)=-TPK%K053(:)*PCONC(:,15) ! !CO/OH=-K053*<CO>+0.00878*K058*<ALKA>+K062*<HCHO>+1.01732*K065*<CARBO> - PJAC(:,13,14)=-TPK%K053(:)*PCONC(:,13)+0.00878*TPK%K058(:)*PCONC(:,18)+TPK%K06& -&2(:)*PCONC(:,22)+1.01732*TPK%K065(:)*PCONC(:,25) + PJAC(:,14,15)=-TPK%K053(:)*PCONC(:,14)+0.00878*TPK%K058(:)*PCONC(:,19)+TPK%K06& +&2(:)*PCONC(:,23)+1.01732*TPK%K065(:)*PCONC(:,26) ! !CO/HO2=0.0 ! @@ -8485,33 +8755,33 @@ SUBROUTINE SUBJ2 !CO/ETH=0.0 ! !CO/ALKA=+0.00878*K058*<OH> - PJAC(:,13,18)=+0.00878*TPK%K058(:)*PCONC(:,14) + PJAC(:,14,19)=+0.00878*TPK%K058(:)*PCONC(:,15) ! !CO/ALKE=+0.35120*K079*<O3> - PJAC(:,13,19)=+0.35120*TPK%K079(:)*PCONC(:,1) + PJAC(:,14,20)=+0.35120*TPK%K079(:)*PCONC(:,1) ! !CO/BIO=+0.01*K054*<O3P>+0.36000*K080*<O3> - PJAC(:,13,20)=+0.01*TPK%K054(:)*TPK%O3P(:)+0.36000*TPK%K080(:)*PCONC(:,1) + PJAC(:,14,21)=+0.01*TPK%K054(:)*TPK%O3P(:)+0.36000*TPK%K080(:)*PCONC(:,1) ! !CO/ARO=0.0 ! !CO/HCHO=+K010+K011+K062*<OH>+K072*<NO3> - PJAC(:,13,22)=+TPK%K010(:)+TPK%K011(:)+TPK%K062(:)*PCONC(:,14)+TPK%K072(:)*PCO& + PJAC(:,14,23)=+TPK%K010(:)+TPK%K011(:)+TPK%K062(:)*PCONC(:,15)+TPK%K072(:)*PCO& &NC(:,5) ! !CO/ALD=+K012 - PJAC(:,13,23)=+TPK%K012(:) + PJAC(:,14,24)=+TPK%K012(:) ! !CO/KET=0.0 ! !CO/CARBO=+0.91924*K016+1.01732*K065*<OH>+1.33723*K074*<NO3>+0.64728*K081*<O3> - PJAC(:,13,25)=+0.91924*TPK%K016(:)+1.01732*TPK%K065(:)*PCONC(:,14)+1.33723*TPK& + PJAC(:,14,26)=+0.91924*TPK%K016(:)+1.01732*TPK%K065(:)*PCONC(:,15)+1.33723*TPK& &%K074(:)*PCONC(:,5)+0.64728*TPK%K081(:)*PCONC(:,1) ! !CO/ONIT=0.0 ! !CO/PAN=+0.13*K082*<O3> - PJAC(:,13,27)=+0.13*TPK%K082(:)*PCONC(:,1) + PJAC(:,14,28)=+0.13*TPK%K082(:)*PCONC(:,1) ! !CO/OP1=0.0 ! @@ -8643,116 +8913,119 @@ SUBROUTINE SUBJ2 ! !OH/O3=-K023*<OH>+K024*<HO2>+0.39435*K079*<ALKE>+0.28000*K080*<BIO>+0.20595*K08 !1*<CARBO>+0.036*K082*<PAN>+K087*<ADD> - PJAC(:,14,1)=-TPK%K023(:)*PCONC(:,14)+TPK%K024(:)*PCONC(:,15)+0.39435*TPK%K079& -&(:)*PCONC(:,19)+0.28000*TPK%K080(:)*PCONC(:,20)+0.20595*TPK%K081(:)*PCONC(:,25& -&)+0.036*TPK%K082(:)*PCONC(:,27)+TPK%K087(:)*PCONC(:,37) + PJAC(:,15,1)=-TPK%K023(:)*PCONC(:,15)+TPK%K024(:)*PCONC(:,16)+0.39435*TPK%K079& +&(:)*PCONC(:,20)+0.28000*TPK%K080(:)*PCONC(:,21)+0.20595*TPK%K081(:)*PCONC(:,26& +&)+0.036*TPK%K082(:)*PCONC(:,28)+TPK%K087(:)*PCONC(:,38) ! !OH/H2O2=+K009+K009-K026*<OH> - PJAC(:,14,2)=+TPK%K009(:)+TPK%K009(:)-TPK%K026(:)*PCONC(:,14) + PJAC(:,15,2)=+TPK%K009(:)+TPK%K009(:)-TPK%K026(:)*PCONC(:,15) ! !OH/NO=-K032*<OH>+K035*<HO2> - PJAC(:,14,3)=-TPK%K032(:)*PCONC(:,14)+TPK%K035(:)*PCONC(:,15) + PJAC(:,15,3)=-TPK%K032(:)*PCONC(:,15)+TPK%K035(:)*PCONC(:,16) ! !OH/NO2=-K033*<OH> - PJAC(:,14,4)=-TPK%K033(:)*PCONC(:,14) + PJAC(:,15,4)=-TPK%K033(:)*PCONC(:,15) ! !OH/NO3=-K034*<OH>+0.7*K038*<HO2> - PJAC(:,14,5)=-TPK%K034(:)*PCONC(:,14)+0.7*TPK%K038(:)*PCONC(:,15) + PJAC(:,15,5)=-TPK%K034(:)*PCONC(:,15)+0.7*TPK%K038(:)*PCONC(:,16) ! !OH/N2O5=0.0 ! !OH/HONO=+K004-K039*<OH> - PJAC(:,14,7)=+TPK%K004(:)-TPK%K039(:)*PCONC(:,14) + PJAC(:,15,7)=+TPK%K004(:)-TPK%K039(:)*PCONC(:,15) ! !OH/HNO3=+K005-K040*<OH> - PJAC(:,14,8)=+TPK%K005(:)-TPK%K040(:)*PCONC(:,14) + PJAC(:,15,8)=+TPK%K005(:)-TPK%K040(:)*PCONC(:,15) ! !OH/HNO4=+0.35*K006-K041*<OH> - PJAC(:,14,9)=+0.35*TPK%K006(:)-TPK%K041(:)*PCONC(:,14) + PJAC(:,15,9)=+0.35*TPK%K006(:)-TPK%K041(:)*PCONC(:,15) ! !OH/NH3=-K050*<OH> - PJAC(:,14,10)=-TPK%K050(:)*PCONC(:,14) + PJAC(:,15,10)=-TPK%K050(:)*PCONC(:,15) +! +!OH/DMS=-K135*<OH> + PJAC(:,15,11)=-TPK%K135(:)*PCONC(:,15) ! !OH/SO2=-K052*<OH> - PJAC(:,14,11)=-TPK%K052(:)*PCONC(:,14) + PJAC(:,15,12)=-TPK%K052(:)*PCONC(:,15) ! !OH/SULF=0.0 ! !OH/CO=-K053*<OH> - PJAC(:,14,13)=-TPK%K053(:)*PCONC(:,14) + PJAC(:,15,14)=-TPK%K053(:)*PCONC(:,15) ! !OH/OH=-K023*<O3>-K025*<HO2>-K026*<H2O2>-K032*<NO>-K033*<NO2>-K034*<NO3>-K039*< !HONO>-K040*<HNO3>-K041*<HNO4>-K050*<NH3>-K051*<H2>-K052*<SO2>-K053*<CO>-K056*< !CH4>-K057*<ETH>+0.00878*K058*<ALKA>-K058*<ALKA>-K059*<ALKE>-K060*<BIO>-K061*<A !RO>-K062*<HCHO>-K063*<ALD>-K064*<KET>-K065*<CARBO>-K066*<ORA1>-K067*<ORA2>+0.3 !5*K068*<OP1>-K068*<OP1>+0.44925*K069*<OP2>-K069*<OP2>-K070*<PAN>-K071*<ONIT>-K -!TC11-KTR11 - PJAC(:,14,14)=-TPK%K023(:)*PCONC(:,1)-TPK%K025(:)*PCONC(:,15)-TPK%K026(:)*PCON& +!135*<DMS>-KTC11-KTR11 + PJAC(:,15,15)=-TPK%K023(:)*PCONC(:,1)-TPK%K025(:)*PCONC(:,16)-TPK%K026(:)*PCON& &C(:,2)-TPK%K032(:)*PCONC(:,3)-TPK%K033(:)*PCONC(:,4)-TPK%K034(:)*PCONC(:,5)-TP& &K%K039(:)*PCONC(:,7)-TPK%K040(:)*PCONC(:,8)-TPK%K041(:)*PCONC(:,9)-TPK%K050(:)& -&*PCONC(:,10)-TPK%K051(:)*TPK%H2(:)-TPK%K052(:)*PCONC(:,11)-TPK%K053(:)*PCONC(:& -&,13)-TPK%K056(:)*PCONC(:,16)-TPK%K057(:)*PCONC(:,17)+0.00878*TPK%K058(:)*PCONC& -&(:,18)-TPK%K058(:)*PCONC(:,18)-TPK%K059(:)*PCONC(:,19)-TPK%K060(:)*PCONC(:,20)& -&-TPK%K061(:)*PCONC(:,21)-TPK%K062(:)*PCONC(:,22)-TPK%K063(:)*PCONC(:,23)-TPK%K& -&064(:)*PCONC(:,24)-TPK%K065(:)*PCONC(:,25)-TPK%K066(:)*PCONC(:,30)-TPK%K067(:)& -&*PCONC(:,31)+0.35*TPK%K068(:)*PCONC(:,28)-TPK%K068(:)*PCONC(:,28)+0.44925*TPK%& -&K069(:)*PCONC(:,29)-TPK%K069(:)*PCONC(:,29)-TPK%K070(:)*PCONC(:,27)-TPK%K071(:& -&)*PCONC(:,26)-TPK%KTC11(:)-TPK%KTR11(:) +&*PCONC(:,10)-TPK%K051(:)*TPK%H2(:)-TPK%K052(:)*PCONC(:,12)-TPK%K053(:)*PCONC(:& +&,14)-TPK%K056(:)*PCONC(:,17)-TPK%K057(:)*PCONC(:,18)+0.00878*TPK%K058(:)*PCONC& +&(:,19)-TPK%K058(:)*PCONC(:,19)-TPK%K059(:)*PCONC(:,20)-TPK%K060(:)*PCONC(:,21)& +&-TPK%K061(:)*PCONC(:,22)-TPK%K062(:)*PCONC(:,23)-TPK%K063(:)*PCONC(:,24)-TPK%K& +&064(:)*PCONC(:,25)-TPK%K065(:)*PCONC(:,26)-TPK%K066(:)*PCONC(:,31)-TPK%K067(:)& +&*PCONC(:,32)+0.35*TPK%K068(:)*PCONC(:,29)-TPK%K068(:)*PCONC(:,29)+0.44925*TPK%& +&K069(:)*PCONC(:,30)-TPK%K069(:)*PCONC(:,30)-TPK%K070(:)*PCONC(:,28)-TPK%K071(:& +&)*PCONC(:,27)-TPK%K135(:)*PCONC(:,11)-TPK%KTC11(:)-TPK%KTR11(:) ! !OH/HO2=+K024*<O3>-K025*<OH>+K035*<NO>+0.7*K038*<NO3> - PJAC(:,14,15)=+TPK%K024(:)*PCONC(:,1)-TPK%K025(:)*PCONC(:,14)+TPK%K035(:)*PCON& + PJAC(:,15,16)=+TPK%K024(:)*PCONC(:,1)-TPK%K025(:)*PCONC(:,15)+TPK%K035(:)*PCON& &C(:,3)+0.7*TPK%K038(:)*PCONC(:,5) ! !OH/CH4=-K056*<OH> - PJAC(:,14,16)=-TPK%K056(:)*PCONC(:,14) + PJAC(:,15,17)=-TPK%K056(:)*PCONC(:,15) ! !OH/ETH=-K057*<OH> - PJAC(:,14,17)=-TPK%K057(:)*PCONC(:,14) + PJAC(:,15,18)=-TPK%K057(:)*PCONC(:,15) ! !OH/ALKA=+0.00878*K058*<OH>-K058*<OH> - PJAC(:,14,18)=+0.00878*TPK%K058(:)*PCONC(:,14)-TPK%K058(:)*PCONC(:,14) + PJAC(:,15,19)=+0.00878*TPK%K058(:)*PCONC(:,15)-TPK%K058(:)*PCONC(:,15) ! !OH/ALKE=-K059*<OH>+0.39435*K079*<O3> - PJAC(:,14,19)=-TPK%K059(:)*PCONC(:,14)+0.39435*TPK%K079(:)*PCONC(:,1) + PJAC(:,15,20)=-TPK%K059(:)*PCONC(:,15)+0.39435*TPK%K079(:)*PCONC(:,1) ! !OH/BIO=+0.02*K054*<O3P>-K060*<OH>+0.28000*K080*<O3> - PJAC(:,14,20)=+0.02*TPK%K054(:)*TPK%O3P(:)-TPK%K060(:)*PCONC(:,14)+0.28000*TPK& + PJAC(:,15,21)=+0.02*TPK%K054(:)*TPK%O3P(:)-TPK%K060(:)*PCONC(:,15)+0.28000*TPK& &%K080(:)*PCONC(:,1) ! !OH/ARO=-K061*<OH> - PJAC(:,14,21)=-TPK%K061(:)*PCONC(:,14) + PJAC(:,15,22)=-TPK%K061(:)*PCONC(:,15) ! !OH/HCHO=-K062*<OH> - PJAC(:,14,22)=-TPK%K062(:)*PCONC(:,14) + PJAC(:,15,23)=-TPK%K062(:)*PCONC(:,15) ! !OH/ALD=-K063*<OH> - PJAC(:,14,23)=-TPK%K063(:)*PCONC(:,14) + PJAC(:,15,24)=-TPK%K063(:)*PCONC(:,15) ! !OH/KET=-K064*<OH> - PJAC(:,14,24)=-TPK%K064(:)*PCONC(:,14) + PJAC(:,15,25)=-TPK%K064(:)*PCONC(:,15) ! !OH/CARBO=-K065*<OH>+0.20595*K081*<O3> - PJAC(:,14,25)=-TPK%K065(:)*PCONC(:,14)+0.20595*TPK%K081(:)*PCONC(:,1) + PJAC(:,15,26)=-TPK%K065(:)*PCONC(:,15)+0.20595*TPK%K081(:)*PCONC(:,1) ! !OH/ONIT=-K071*<OH> - PJAC(:,14,26)=-TPK%K071(:)*PCONC(:,14) + PJAC(:,15,27)=-TPK%K071(:)*PCONC(:,15) ! !OH/PAN=-K070*<OH>+0.036*K082*<O3> - PJAC(:,14,27)=-TPK%K070(:)*PCONC(:,14)+0.036*TPK%K082(:)*PCONC(:,1) + PJAC(:,15,28)=-TPK%K070(:)*PCONC(:,15)+0.036*TPK%K082(:)*PCONC(:,1) ! !OH/OP1=+K013+0.35*K068*<OH>-K068*<OH> - PJAC(:,14,28)=+TPK%K013(:)+0.35*TPK%K068(:)*PCONC(:,14)-TPK%K068(:)*PCONC(:,14& + PJAC(:,15,29)=+TPK%K013(:)+0.35*TPK%K068(:)*PCONC(:,15)-TPK%K068(:)*PCONC(:,15& &) ! !OH/OP2=+K014+0.44925*K069*<OH>-K069*<OH> - PJAC(:,14,29)=+TPK%K014(:)+0.44925*TPK%K069(:)*PCONC(:,14)-TPK%K069(:)*PCONC(:& -&,14) + PJAC(:,15,30)=+TPK%K014(:)+0.44925*TPK%K069(:)*PCONC(:,15)-TPK%K069(:)*PCONC(:& +&,15) ! !OH/ORA1=-K066*<OH> - PJAC(:,14,30)=-TPK%K066(:)*PCONC(:,14) + PJAC(:,15,31)=-TPK%K066(:)*PCONC(:,15) ! !OH/ORA2=-K067*<OH> - PJAC(:,14,31)=-TPK%K067(:)*PCONC(:,14) + PJAC(:,15,32)=-TPK%K067(:)*PCONC(:,15) ! !OH/MO2=0.0 ! @@ -8765,7 +9038,7 @@ SUBROUTINE SUBJ2 !OH/PHO=0.0 ! !OH/ADD=+K087*<O3> - PJAC(:,14,37)=+TPK%K087(:)*PCONC(:,1) + PJAC(:,15,38)=+TPK%K087(:)*PCONC(:,1) ! !OH/AROP=0.0 ! @@ -8796,7 +9069,7 @@ SUBROUTINE SUBJ2 !OH/WC_NH3=0.0 ! !OH/WC_OH=+KTC31 - PJAC(:,14,52)=+TPK%KTC31(:) + PJAC(:,15,53)=+TPK%KTC31(:) ! !OH/WC_HO2=0.0 ! @@ -8847,7 +9120,7 @@ SUBROUTINE SUBJ2 !OH/WR_NH3=0.0 ! !OH/WR_OH=+KTR31 - PJAC(:,14,77)=+TPK%KTR31(:) + PJAC(:,15,78)=+TPK%KTR31(:) ! !OH/WR_HO2=0.0 ! @@ -8877,32 +9150,40 @@ SUBROUTINE SUBJ2 ! !OH/WR_AHMS=0.0 ! +RETURN +END SUBROUTINE SUBJ2 +! +SUBROUTINE SUBJ3 +! +!Indices 16 a 20 +! +! !HO2/O3=+K023*<OH>-K024*<HO2>+0.23451*K079*<ALKE>+0.30000*K080*<BIO>+0.28441*K0 !81*<CARBO>+0.08*K082*<PAN> - PJAC(:,15,1)=+TPK%K023(:)*PCONC(:,14)-TPK%K024(:)*PCONC(:,15)+0.23451*TPK%K079& -&(:)*PCONC(:,19)+0.30000*TPK%K080(:)*PCONC(:,20)+0.28441*TPK%K081(:)*PCONC(:,25& -&)+0.08*TPK%K082(:)*PCONC(:,27) + PJAC(:,16,1)=+TPK%K023(:)*PCONC(:,15)-TPK%K024(:)*PCONC(:,16)+0.23451*TPK%K079& +&(:)*PCONC(:,20)+0.30000*TPK%K080(:)*PCONC(:,21)+0.28441*TPK%K081(:)*PCONC(:,26& +&)+0.08*TPK%K082(:)*PCONC(:,28) ! !HO2/H2O2=+K026*<OH> - PJAC(:,15,2)=+TPK%K026(:)*PCONC(:,14) + PJAC(:,16,2)=+TPK%K026(:)*PCONC(:,15) ! !HO2/NO=-K035*<HO2>+K090*<MO2>+0.74265*K091*<ALKAP>+K092*<ALKEP>+0.84700*K093*< !BIOP>+0.95115*K094*<AROP>+0.12334*K095*<CARBOP>+0.18401*K096*<OLN> - PJAC(:,15,3)=-TPK%K035(:)*PCONC(:,15)+TPK%K090(:)*PCONC(:,32)+0.74265*TPK%K091& -&(:)*PCONC(:,33)+TPK%K092(:)*PCONC(:,34)+0.84700*TPK%K093(:)*PCONC(:,35)+0.9511& -&5*TPK%K094(:)*PCONC(:,38)+0.12334*TPK%K095(:)*PCONC(:,39)+0.18401*TPK%K096(:)*& -&PCONC(:,40) + PJAC(:,16,3)=-TPK%K035(:)*PCONC(:,16)+TPK%K090(:)*PCONC(:,33)+0.74265*TPK%K091& +&(:)*PCONC(:,34)+TPK%K092(:)*PCONC(:,35)+0.84700*TPK%K093(:)*PCONC(:,36)+0.9511& +&5*TPK%K094(:)*PCONC(:,39)+0.12334*TPK%K095(:)*PCONC(:,40)+0.18401*TPK%K096(:)*& +&PCONC(:,41) ! !HO2/NO2=-K036*<HO2> - PJAC(:,15,4)=-TPK%K036(:)*PCONC(:,15) + PJAC(:,16,4)=-TPK%K036(:)*PCONC(:,16) ! !HO2/NO3=+K034*<OH>-K038*<HO2>+K072*<HCHO>+0.63217*K074*<CARBO>+K119*<MO2>+0.81 !290*K120*<ALKAP>+K121*<ALKEP>+K122*<BIOP>+K123*<AROP>+0.04915*K124*<CARBOP>+0. !25928*K125*<OLN> - PJAC(:,15,5)=+TPK%K034(:)*PCONC(:,14)-TPK%K038(:)*PCONC(:,15)+TPK%K072(:)*PCON& -&C(:,22)+0.63217*TPK%K074(:)*PCONC(:,25)+TPK%K119(:)*PCONC(:,32)+0.81290*TPK%K1& -&20(:)*PCONC(:,33)+TPK%K121(:)*PCONC(:,34)+TPK%K122(:)*PCONC(:,35)+TPK%K123(:)*& -&PCONC(:,38)+0.04915*TPK%K124(:)*PCONC(:,39)+0.25928*TPK%K125(:)*PCONC(:,40) + PJAC(:,16,5)=+TPK%K034(:)*PCONC(:,15)-TPK%K038(:)*PCONC(:,16)+TPK%K072(:)*PCON& +&C(:,23)+0.63217*TPK%K074(:)*PCONC(:,26)+TPK%K119(:)*PCONC(:,33)+0.81290*TPK%K1& +&20(:)*PCONC(:,34)+TPK%K121(:)*PCONC(:,35)+TPK%K122(:)*PCONC(:,36)+TPK%K123(:)*& +&PCONC(:,39)+0.04915*TPK%K124(:)*PCONC(:,40)+0.25928*TPK%K125(:)*PCONC(:,41) ! !HO2/N2O5=0.0 ! @@ -8911,141 +9192,143 @@ SUBROUTINE SUBJ2 !HO2/HNO3=0.0 ! !HO2/HNO4=+0.65*K006+K037 - PJAC(:,15,9)=+0.65*TPK%K006(:)+TPK%K037(:) + PJAC(:,16,9)=+0.65*TPK%K006(:)+TPK%K037(:) ! !HO2/NH3=0.0 ! +!HO2/DMS=0.0 +! !HO2/SO2=+K052*<OH> - PJAC(:,15,11)=+TPK%K052(:)*PCONC(:,14) + PJAC(:,16,12)=+TPK%K052(:)*PCONC(:,15) ! !HO2/SULF=0.0 ! !HO2/CO=+K053*<OH> - PJAC(:,15,13)=+TPK%K053(:)*PCONC(:,14) + PJAC(:,16,14)=+TPK%K053(:)*PCONC(:,15) ! !HO2/OH=+K023*<O3>-K025*<HO2>+K026*<H2O2>+K034*<NO3>+K051*<H2>+K052*<SO2>+K053* !<CO>+0.12793*K058*<ALKA>+0.10318*K061*<ARO>+K062*<HCHO>+0.51208*K065*<CARBO>+K !066*<ORA1>+0.02915*K069*<OP2>+0.28107*K070*<PAN> - PJAC(:,15,14)=+TPK%K023(:)*PCONC(:,1)-TPK%K025(:)*PCONC(:,15)+TPK%K026(:)*PCON& -&C(:,2)+TPK%K034(:)*PCONC(:,5)+TPK%K051(:)*TPK%H2(:)+TPK%K052(:)*PCONC(:,11)+TP& -&K%K053(:)*PCONC(:,13)+0.12793*TPK%K058(:)*PCONC(:,18)+0.10318*TPK%K061(:)*PCON& -&C(:,21)+TPK%K062(:)*PCONC(:,22)+0.51208*TPK%K065(:)*PCONC(:,25)+TPK%K066(:)*PC& -&ONC(:,30)+0.02915*TPK%K069(:)*PCONC(:,29)+0.28107*TPK%K070(:)*PCONC(:,27) + PJAC(:,16,15)=+TPK%K023(:)*PCONC(:,1)-TPK%K025(:)*PCONC(:,16)+TPK%K026(:)*PCON& +&C(:,2)+TPK%K034(:)*PCONC(:,5)+TPK%K051(:)*TPK%H2(:)+TPK%K052(:)*PCONC(:,12)+TP& +&K%K053(:)*PCONC(:,14)+0.12793*TPK%K058(:)*PCONC(:,19)+0.10318*TPK%K061(:)*PCON& +&C(:,22)+TPK%K062(:)*PCONC(:,23)+0.51208*TPK%K065(:)*PCONC(:,26)+TPK%K066(:)*PC& +&ONC(:,31)+0.02915*TPK%K069(:)*PCONC(:,30)+0.28107*TPK%K070(:)*PCONC(:,28) ! !HO2/HO2=-K024*<O3>-K025*<OH>-K027*<HO2>-K027*<HO2>-K027*<HO2>-K027*<HO2>-K028* !<HO2>*<H2O>-K028*<HO2>*<H2O>-K028*<HO2>*<H2O>-K028*<HO2>*<H2O>-K035*<NO>-K036* !<NO2>-K038*<NO3>-K084*<PHO>-K097*<MO2>-K098*<ALKAP>-K099*<ALKEP>-K0100*<BIOP>- !K0101*<AROP>-K0102*<CARBOP>-K103*<OLN>-K126*<XO2>-KTC12-KTR12 - PJAC(:,15,15)=-TPK%K024(:)*PCONC(:,1)-TPK%K025(:)*PCONC(:,14)-TPK%K027(:)*PCON& -&C(:,15)-TPK%K027(:)*PCONC(:,15)-TPK%K027(:)*PCONC(:,15)-TPK%K027(:)*PCONC(:,15& -&)-TPK%K028(:)*PCONC(:,15)*TPK%H2O(:)-TPK%K028(:)*PCONC(:,15)*TPK%H2O(:)-TPK%K0& -&28(:)*PCONC(:,15)*TPK%H2O(:)-TPK%K028(:)*PCONC(:,15)*TPK%H2O(:)-TPK%K035(:)*PC& -&ONC(:,3)-TPK%K036(:)*PCONC(:,4)-TPK%K038(:)*PCONC(:,5)-TPK%K084(:)*PCONC(:,36)& -&-TPK%K097(:)*PCONC(:,32)-TPK%K098(:)*PCONC(:,33)-TPK%K099(:)*PCONC(:,34)-TPK%K& -&0100(:)*PCONC(:,35)-TPK%K0101(:)*PCONC(:,38)-TPK%K0102(:)*PCONC(:,39)-TPK%K103& -&(:)*PCONC(:,40)-TPK%K126(:)*PCONC(:,41)-TPK%KTC12(:)-TPK%KTR12(:) + PJAC(:,16,16)=-TPK%K024(:)*PCONC(:,1)-TPK%K025(:)*PCONC(:,15)-TPK%K027(:)*PCON& +&C(:,16)-TPK%K027(:)*PCONC(:,16)-TPK%K027(:)*PCONC(:,16)-TPK%K027(:)*PCONC(:,16& +&)-TPK%K028(:)*PCONC(:,16)*TPK%H2O(:)-TPK%K028(:)*PCONC(:,16)*TPK%H2O(:)-TPK%K0& +&28(:)*PCONC(:,16)*TPK%H2O(:)-TPK%K028(:)*PCONC(:,16)*TPK%H2O(:)-TPK%K035(:)*PC& +&ONC(:,3)-TPK%K036(:)*PCONC(:,4)-TPK%K038(:)*PCONC(:,5)-TPK%K084(:)*PCONC(:,37)& +&-TPK%K097(:)*PCONC(:,33)-TPK%K098(:)*PCONC(:,34)-TPK%K099(:)*PCONC(:,35)-TPK%K& +&0100(:)*PCONC(:,36)-TPK%K0101(:)*PCONC(:,39)-TPK%K0102(:)*PCONC(:,40)-TPK%K103& +&(:)*PCONC(:,41)-TPK%K126(:)*PCONC(:,42)-TPK%KTC12(:)-TPK%KTR12(:) ! !HO2/CH4=0.0 ! !HO2/ETH=0.0 ! !HO2/ALKA=+0.12793*K058*<OH> - PJAC(:,15,18)=+0.12793*TPK%K058(:)*PCONC(:,14) + PJAC(:,16,19)=+0.12793*TPK%K058(:)*PCONC(:,15) ! !HO2/ALKE=+0.23451*K079*<O3> - PJAC(:,15,19)=+0.23451*TPK%K079(:)*PCONC(:,1) + PJAC(:,16,20)=+0.23451*TPK%K079(:)*PCONC(:,1) ! !HO2/BIO=+0.28*K054*<O3P>+0.30000*K080*<O3> - PJAC(:,15,20)=+0.28*TPK%K054(:)*TPK%O3P(:)+0.30000*TPK%K080(:)*PCONC(:,1) + PJAC(:,16,21)=+0.28*TPK%K054(:)*TPK%O3P(:)+0.30000*TPK%K080(:)*PCONC(:,1) ! !HO2/ARO=+0.10318*K061*<OH> - PJAC(:,15,21)=+0.10318*TPK%K061(:)*PCONC(:,14) + PJAC(:,16,22)=+0.10318*TPK%K061(:)*PCONC(:,15) ! !HO2/HCHO=+K011+K011+K062*<OH>+K072*<NO3> - PJAC(:,15,22)=+TPK%K011(:)+TPK%K011(:)+TPK%K062(:)*PCONC(:,14)+TPK%K072(:)*PCO& + PJAC(:,16,23)=+TPK%K011(:)+TPK%K011(:)+TPK%K062(:)*PCONC(:,15)+TPK%K072(:)*PCO& &NC(:,5) ! !HO2/ALD=+K012 - PJAC(:,15,23)=+TPK%K012(:) + PJAC(:,16,24)=+TPK%K012(:) ! !HO2/KET=0.0 ! !HO2/CARBO=+0.75830*K016+0.51208*K065*<OH>+0.63217*K074*<NO3>+0.28441*K081*<O3> - PJAC(:,15,25)=+0.75830*TPK%K016(:)+0.51208*TPK%K065(:)*PCONC(:,14)+0.63217*TPK& + PJAC(:,16,26)=+0.75830*TPK%K016(:)+0.51208*TPK%K065(:)*PCONC(:,15)+0.63217*TPK& &%K074(:)*PCONC(:,5)+0.28441*TPK%K081(:)*PCONC(:,1) ! !HO2/ONIT=+K017 - PJAC(:,15,26)=+TPK%K017(:) + PJAC(:,16,27)=+TPK%K017(:) ! !HO2/PAN=+0.28107*K070*<OH>+0.08*K082*<O3> - PJAC(:,15,27)=+0.28107*TPK%K070(:)*PCONC(:,14)+0.08*TPK%K082(:)*PCONC(:,1) + PJAC(:,16,28)=+0.28107*TPK%K070(:)*PCONC(:,15)+0.08*TPK%K082(:)*PCONC(:,1) ! !HO2/OP1=+K013 - PJAC(:,15,28)=+TPK%K013(:) + PJAC(:,16,29)=+TPK%K013(:) ! !HO2/OP2=+0.96205*K014+0.02915*K069*<OH> - PJAC(:,15,29)=+0.96205*TPK%K014(:)+0.02915*TPK%K069(:)*PCONC(:,14) + PJAC(:,16,30)=+0.96205*TPK%K014(:)+0.02915*TPK%K069(:)*PCONC(:,15) ! !HO2/ORA1=+K066*<OH> - PJAC(:,15,30)=+TPK%K066(:)*PCONC(:,14) + PJAC(:,16,31)=+TPK%K066(:)*PCONC(:,15) ! !HO2/ORA2=0.0 ! !HO2/MO2=+K090*<NO>-K097*<HO2>+0.66*K104*<MO2>+0.66*K104*<MO2>+0.98383*K105*<AL !KAP>+K106*<ALKEP>+1.00000*K107*<BIOP>+1.02767*K108*<AROP>+0.82998*K109*<CARBOP !>+0.67560*K110*<OLN>+K119*<NO3>+K127*<XO2> - PJAC(:,15,32)=+TPK%K090(:)*PCONC(:,3)-TPK%K097(:)*PCONC(:,15)+0.66*TPK%K104(:)& -&*PCONC(:,32)+0.66*TPK%K104(:)*PCONC(:,32)+0.98383*TPK%K105(:)*PCONC(:,33)+TPK%& -&K106(:)*PCONC(:,34)+1.00000*TPK%K107(:)*PCONC(:,35)+1.02767*TPK%K108(:)*PCONC(& -&:,38)+0.82998*TPK%K109(:)*PCONC(:,39)+0.67560*TPK%K110(:)*PCONC(:,40)+TPK%K119& -&(:)*PCONC(:,5)+TPK%K127(:)*PCONC(:,41) + PJAC(:,16,33)=+TPK%K090(:)*PCONC(:,3)-TPK%K097(:)*PCONC(:,16)+0.66*TPK%K104(:)& +&*PCONC(:,33)+0.66*TPK%K104(:)*PCONC(:,33)+0.98383*TPK%K105(:)*PCONC(:,34)+TPK%& +&K106(:)*PCONC(:,35)+1.00000*TPK%K107(:)*PCONC(:,36)+1.02767*TPK%K108(:)*PCONC(& +&:,39)+0.82998*TPK%K109(:)*PCONC(:,40)+0.67560*TPK%K110(:)*PCONC(:,41)+TPK%K119& +&(:)*PCONC(:,5)+TPK%K127(:)*PCONC(:,42) ! !HO2/ALKAP=+0.74265*K091*<NO>-K098*<HO2>+0.98383*K105*<MO2>+0.48079*K111*<CARBO !P>+0.81290*K120*<NO3> - PJAC(:,15,33)=+0.74265*TPK%K091(:)*PCONC(:,3)-TPK%K098(:)*PCONC(:,15)+0.98383*& -&TPK%K105(:)*PCONC(:,32)+0.48079*TPK%K111(:)*PCONC(:,39)+0.81290*TPK%K120(:)*PC& + PJAC(:,16,34)=+0.74265*TPK%K091(:)*PCONC(:,3)-TPK%K098(:)*PCONC(:,16)+0.98383*& +&TPK%K105(:)*PCONC(:,33)+0.48079*TPK%K111(:)*PCONC(:,40)+0.81290*TPK%K120(:)*PC& &ONC(:,5) ! !HO2/ALKEP=+K092*<NO>-K099*<HO2>+K106*<MO2>+0.50078*K112*<CARBOP>+K121*<NO3> - PJAC(:,15,34)=+TPK%K092(:)*PCONC(:,3)-TPK%K099(:)*PCONC(:,15)+TPK%K106(:)*PCON& -&C(:,32)+0.50078*TPK%K112(:)*PCONC(:,39)+TPK%K121(:)*PCONC(:,5) + PJAC(:,16,35)=+TPK%K092(:)*PCONC(:,3)-TPK%K099(:)*PCONC(:,16)+TPK%K106(:)*PCON& +&C(:,33)+0.50078*TPK%K112(:)*PCONC(:,40)+TPK%K121(:)*PCONC(:,5) ! !HO2/BIOP=+0.84700*K093*<NO>-K0100*<HO2>+1.00000*K107*<MO2>+0.50600*K113*<CARBO !P>+K122*<NO3> - PJAC(:,15,35)=+0.84700*TPK%K093(:)*PCONC(:,3)-TPK%K0100(:)*PCONC(:,15)+1.00000& -&*TPK%K107(:)*PCONC(:,32)+0.50600*TPK%K113(:)*PCONC(:,39)+TPK%K122(:)*PCONC(:,5& + PJAC(:,16,36)=+0.84700*TPK%K093(:)*PCONC(:,3)-TPK%K0100(:)*PCONC(:,16)+1.00000& +&*TPK%K107(:)*PCONC(:,33)+0.50600*TPK%K113(:)*PCONC(:,40)+TPK%K122(:)*PCONC(:,5& &) ! !HO2/PHO=-K084*<HO2> - PJAC(:,15,36)=-TPK%K084(:)*PCONC(:,15) + PJAC(:,16,37)=-TPK%K084(:)*PCONC(:,16) ! !HO2/ADD=+0.02*K086*<O2> - PJAC(:,15,37)=+0.02*TPK%K086(:)*TPK%O2(:) + PJAC(:,16,38)=+0.02*TPK%K086(:)*TPK%O2(:) ! !HO2/AROP=+0.95115*K094*<NO>-K0101*<HO2>+1.02767*K108*<MO2>+K114*<CARBOP>+K123* !<NO3> - PJAC(:,15,38)=+0.95115*TPK%K094(:)*PCONC(:,3)-TPK%K0101(:)*PCONC(:,15)+1.02767& -&*TPK%K108(:)*PCONC(:,32)+TPK%K114(:)*PCONC(:,39)+TPK%K123(:)*PCONC(:,5) + PJAC(:,16,39)=+0.95115*TPK%K094(:)*PCONC(:,3)-TPK%K0101(:)*PCONC(:,16)+1.02767& +&*TPK%K108(:)*PCONC(:,33)+TPK%K114(:)*PCONC(:,40)+TPK%K123(:)*PCONC(:,5) ! !HO2/CARBOP=+0.12334*K095*<NO>-K0102*<HO2>+0.82998*K109*<MO2>+0.48079*K111*<ALK !AP>+0.50078*K112*<ALKEP>+0.50600*K113*<BIOP>+K114*<AROP>+0.07566*K115*<CARBOP> !+0.07566*K115*<CARBOP>+0.17599*K116*<OLN>+0.04915*K124*<NO3> - PJAC(:,15,39)=+0.12334*TPK%K095(:)*PCONC(:,3)-TPK%K0102(:)*PCONC(:,15)+0.82998& -&*TPK%K109(:)*PCONC(:,32)+0.48079*TPK%K111(:)*PCONC(:,33)+0.50078*TPK%K112(:)*P& -&CONC(:,34)+0.50600*TPK%K113(:)*PCONC(:,35)+TPK%K114(:)*PCONC(:,38)+0.07566*TPK& -&%K115(:)*PCONC(:,39)+0.07566*TPK%K115(:)*PCONC(:,39)+0.17599*TPK%K116(:)*PCONC& -&(:,40)+0.04915*TPK%K124(:)*PCONC(:,5) + PJAC(:,16,40)=+0.12334*TPK%K095(:)*PCONC(:,3)-TPK%K0102(:)*PCONC(:,16)+0.82998& +&*TPK%K109(:)*PCONC(:,33)+0.48079*TPK%K111(:)*PCONC(:,34)+0.50078*TPK%K112(:)*P& +&CONC(:,35)+0.50600*TPK%K113(:)*PCONC(:,36)+TPK%K114(:)*PCONC(:,39)+0.07566*TPK& +&%K115(:)*PCONC(:,40)+0.07566*TPK%K115(:)*PCONC(:,40)+0.17599*TPK%K116(:)*PCONC& +&(:,41)+0.04915*TPK%K124(:)*PCONC(:,5) ! !HO2/OLN=+0.18401*K096*<NO>-K103*<HO2>+0.67560*K110*<MO2>+0.17599*K116*<CARBOP> !+K117*<OLN>+K117*<OLN>+0.00000*K118*<OLN>+0.00000*K118*<OLN>+0.25928*K125*<NO3 !> - PJAC(:,15,40)=+0.18401*TPK%K096(:)*PCONC(:,3)-TPK%K103(:)*PCONC(:,15)+0.67560*& -&TPK%K110(:)*PCONC(:,32)+0.17599*TPK%K116(:)*PCONC(:,39)+TPK%K117(:)*PCONC(:,40& -&)+TPK%K117(:)*PCONC(:,40)+0.00000*TPK%K118(:)*PCONC(:,40)+0.00000*TPK%K118(:)*& -&PCONC(:,40)+0.25928*TPK%K125(:)*PCONC(:,5) + PJAC(:,16,41)=+0.18401*TPK%K096(:)*PCONC(:,3)-TPK%K103(:)*PCONC(:,16)+0.67560*& +&TPK%K110(:)*PCONC(:,33)+0.17599*TPK%K116(:)*PCONC(:,40)+TPK%K117(:)*PCONC(:,41& +&)+TPK%K117(:)*PCONC(:,41)+0.00000*TPK%K118(:)*PCONC(:,41)+0.00000*TPK%K118(:)*& +&PCONC(:,41)+0.25928*TPK%K125(:)*PCONC(:,5) ! !HO2/XO2=-K126*<HO2>+K127*<MO2> - PJAC(:,15,41)=-TPK%K126(:)*PCONC(:,15)+TPK%K127(:)*PCONC(:,32) + PJAC(:,16,42)=-TPK%K126(:)*PCONC(:,16)+TPK%K127(:)*PCONC(:,33) ! !HO2/WC_O3=0.0 ! @@ -9070,7 +9353,7 @@ SUBROUTINE SUBJ2 !HO2/WC_OH=0.0 ! !HO2/WC_HO2=+KTC32 - PJAC(:,15,53)=+TPK%KTC32(:) + PJAC(:,16,54)=+TPK%KTC32(:) ! !HO2/WC_CO2=0.0 ! @@ -9121,7 +9404,7 @@ SUBROUTINE SUBJ2 !HO2/WR_OH=0.0 ! !HO2/WR_HO2=+KTR32 - PJAC(:,15,78)=+TPK%KTR32(:) + PJAC(:,16,79)=+TPK%KTR32(:) ! !HO2/WR_CO2=0.0 ! @@ -9149,16 +9432,8 @@ SUBROUTINE SUBJ2 ! !HO2/WR_AHMS=0.0 ! -RETURN -END SUBROUTINE SUBJ2 -! -SUBROUTINE SUBJ3 -! -!Indices 16 a 20 -! -! !CH4/O3=+0.04300*K079*<ALKE> - PJAC(:,16,1)=+0.04300*TPK%K079(:)*PCONC(:,19) + PJAC(:,17,1)=+0.04300*TPK%K079(:)*PCONC(:,20) ! !CH4/H2O2=0.0 ! @@ -9178,6 +9453,8 @@ SUBROUTINE SUBJ3 ! !CH4/NH3=0.0 ! +!CH4/DMS=0.0 +! !CH4/SO2=0.0 ! !CH4/SULF=0.0 @@ -9185,19 +9462,19 @@ SUBROUTINE SUBJ3 !CH4/CO=0.0 ! !CH4/OH=-K056*<CH4> - PJAC(:,16,14)=-TPK%K056(:)*PCONC(:,16) + PJAC(:,17,15)=-TPK%K056(:)*PCONC(:,17) ! !CH4/HO2=0.0 ! !CH4/CH4=-K056*<OH> - PJAC(:,16,16)=-TPK%K056(:)*PCONC(:,14) + PJAC(:,17,17)=-TPK%K056(:)*PCONC(:,15) ! !CH4/ETH=0.0 ! !CH4/ALKA=0.0 ! !CH4/ALKE=+0.04300*K079*<O3> - PJAC(:,16,19)=+0.04300*TPK%K079(:)*PCONC(:,1) + PJAC(:,17,20)=+0.04300*TPK%K079(:)*PCONC(:,1) ! !CH4/BIO=0.0 ! @@ -9344,7 +9621,7 @@ SUBROUTINE SUBJ3 !CH4/WR_AHMS=0.0 ! !ETH/O3=+0.03196*K079*<ALKE> - PJAC(:,17,1)=+0.03196*TPK%K079(:)*PCONC(:,19) + PJAC(:,18,1)=+0.03196*TPK%K079(:)*PCONC(:,20) ! !ETH/H2O2=0.0 ! @@ -9364,6 +9641,8 @@ SUBROUTINE SUBJ3 ! !ETH/NH3=0.0 ! +!ETH/DMS=0.0 +! !ETH/SO2=0.0 ! !ETH/SULF=0.0 @@ -9371,19 +9650,19 @@ SUBROUTINE SUBJ3 !ETH/CO=0.0 ! !ETH/OH=-K057*<ETH> - PJAC(:,17,14)=-TPK%K057(:)*PCONC(:,17) + PJAC(:,18,15)=-TPK%K057(:)*PCONC(:,18) ! !ETH/HO2=0.0 ! !ETH/CH4=0.0 ! !ETH/ETH=-K057*<OH> - PJAC(:,17,17)=-TPK%K057(:)*PCONC(:,14) + PJAC(:,18,18)=-TPK%K057(:)*PCONC(:,15) ! !ETH/ALKA=0.0 ! !ETH/ALKE=+0.03196*K079*<O3> - PJAC(:,17,19)=+0.03196*TPK%K079(:)*PCONC(:,1) + PJAC(:,18,20)=+0.03196*TPK%K079(:)*PCONC(:,1) ! !ETH/BIO=0.0 ! @@ -9549,6 +9828,8 @@ SUBROUTINE SUBJ3 ! !ALKA/NH3=0.0 ! +!ALKA/DMS=0.0 +! !ALKA/SO2=0.0 ! !ALKA/SULF=0.0 @@ -9556,7 +9837,7 @@ SUBROUTINE SUBJ3 !ALKA/CO=0.0 ! !ALKA/OH=-K058*<ALKA> - PJAC(:,18,14)=-TPK%K058(:)*PCONC(:,18) + PJAC(:,19,15)=-TPK%K058(:)*PCONC(:,19) ! !ALKA/HO2=0.0 ! @@ -9565,7 +9846,7 @@ SUBROUTINE SUBJ3 !ALKA/ETH=0.0 ! !ALKA/ALKA=-K058*<OH> - PJAC(:,18,18)=-TPK%K058(:)*PCONC(:,14) + PJAC(:,19,19)=-TPK%K058(:)*PCONC(:,15) ! !ALKA/ALKE=0.0 ! @@ -9714,18 +9995,18 @@ SUBROUTINE SUBJ3 !ALKA/WR_AHMS=0.0 ! !ALKE/O3=+0.00000*K079*<ALKE>-K079*<ALKE>+0.37388*K080*<BIO> - PJAC(:,19,1)=+0.00000*TPK%K079(:)*PCONC(:,19)-TPK%K079(:)*PCONC(:,19)+0.37388*& -&TPK%K080(:)*PCONC(:,20) + PJAC(:,20,1)=+0.00000*TPK%K079(:)*PCONC(:,20)-TPK%K079(:)*PCONC(:,20)+0.37388*& +&TPK%K080(:)*PCONC(:,21) ! !ALKE/H2O2=0.0 ! !ALKE/NO=+0.37815*K093*<BIOP> - PJAC(:,19,3)=+0.37815*TPK%K093(:)*PCONC(:,35) + PJAC(:,20,3)=+0.37815*TPK%K093(:)*PCONC(:,36) ! !ALKE/NO2=0.0 ! !ALKE/NO3=-K076*<ALKE>+0.42729*K122*<BIOP> - PJAC(:,19,5)=-TPK%K076(:)*PCONC(:,19)+0.42729*TPK%K122(:)*PCONC(:,35) + PJAC(:,20,5)=-TPK%K076(:)*PCONC(:,20)+0.42729*TPK%K122(:)*PCONC(:,36) ! !ALKE/N2O5=0.0 ! @@ -9737,6 +10018,8 @@ SUBROUTINE SUBJ3 ! !ALKE/NH3=0.0 ! +!ALKE/DMS=0.0 +! !ALKE/SO2=0.0 ! !ALKE/SULF=0.0 @@ -9744,7 +10027,7 @@ SUBROUTINE SUBJ3 !ALKE/CO=0.0 ! !ALKE/OH=-K059*<ALKE> - PJAC(:,19,14)=-TPK%K059(:)*PCONC(:,19) + PJAC(:,20,15)=-TPK%K059(:)*PCONC(:,20) ! !ALKE/HO2=0.0 ! @@ -9755,11 +10038,11 @@ SUBROUTINE SUBJ3 !ALKE/ALKA=0.0 ! !ALKE/ALKE=-K059*<OH>-K076*<NO3>+0.00000*K079*<O3>-K079*<O3> - PJAC(:,19,19)=-TPK%K059(:)*PCONC(:,14)-TPK%K076(:)*PCONC(:,5)+0.00000*TPK%K079& + PJAC(:,20,20)=-TPK%K059(:)*PCONC(:,15)-TPK%K076(:)*PCONC(:,5)+0.00000*TPK%K079& &(:)*PCONC(:,1)-TPK%K079(:)*PCONC(:,1) ! !ALKE/BIO=+0.91868*K054*<O3P>+0.37388*K080*<O3> - PJAC(:,19,20)=+0.91868*TPK%K054(:)*TPK%O3P(:)+0.37388*TPK%K080(:)*PCONC(:,1) + PJAC(:,20,21)=+0.91868*TPK%K054(:)*TPK%O3P(:)+0.37388*TPK%K080(:)*PCONC(:,1) ! !ALKE/ARO=0.0 ! @@ -9784,7 +10067,7 @@ SUBROUTINE SUBJ3 !ALKE/ORA2=0.0 ! !ALKE/MO2=+0.48074*K107*<BIOP> - PJAC(:,19,32)=+0.48074*TPK%K107(:)*PCONC(:,35) + PJAC(:,20,33)=+0.48074*TPK%K107(:)*PCONC(:,36) ! !ALKE/ALKAP=0.0 ! @@ -9792,8 +10075,8 @@ SUBROUTINE SUBJ3 ! !ALKE/BIOP=+0.37815*K093*<NO>+0.48074*K107*<MO2>+0.24463*K113*<CARBOP>+0.42729* !K122*<NO3> - PJAC(:,19,35)=+0.37815*TPK%K093(:)*PCONC(:,3)+0.48074*TPK%K107(:)*PCONC(:,32)+& -&0.24463*TPK%K113(:)*PCONC(:,39)+0.42729*TPK%K122(:)*PCONC(:,5) + PJAC(:,20,36)=+0.37815*TPK%K093(:)*PCONC(:,3)+0.48074*TPK%K107(:)*PCONC(:,33)+& +&0.24463*TPK%K113(:)*PCONC(:,40)+0.42729*TPK%K122(:)*PCONC(:,5) ! !ALKE/PHO=0.0 ! @@ -9802,7 +10085,7 @@ SUBROUTINE SUBJ3 !ALKE/AROP=0.0 ! !ALKE/CARBOP=+0.24463*K113*<BIOP> - PJAC(:,19,39)=+0.24463*TPK%K113(:)*PCONC(:,35) + PJAC(:,20,40)=+0.24463*TPK%K113(:)*PCONC(:,36) ! !ALKE/OLN=0.0 ! @@ -9908,8 +10191,16 @@ SUBROUTINE SUBJ3 ! !ALKE/WR_AHMS=0.0 ! +RETURN +END SUBROUTINE SUBJ3 +! +SUBROUTINE SUBJ4 +! +!Indices 21 a 25 +! +! !BIO/O3=-K080*<BIO> - PJAC(:,20,1)=-TPK%K080(:)*PCONC(:,20) + PJAC(:,21,1)=-TPK%K080(:)*PCONC(:,21) ! !BIO/H2O2=0.0 ! @@ -9918,7 +10209,7 @@ SUBROUTINE SUBJ3 !BIO/NO2=0.0 ! !BIO/NO3=-K077*<BIO> - PJAC(:,20,5)=-TPK%K077(:)*PCONC(:,20) + PJAC(:,21,5)=-TPK%K077(:)*PCONC(:,21) ! !BIO/N2O5=0.0 ! @@ -9930,6 +10221,8 @@ SUBROUTINE SUBJ3 ! !BIO/NH3=0.0 ! +!BIO/DMS=0.0 +! !BIO/SO2=0.0 ! !BIO/SULF=0.0 @@ -9937,7 +10230,7 @@ SUBROUTINE SUBJ3 !BIO/CO=0.0 ! !BIO/OH=-K060*<BIO> - PJAC(:,20,14)=-TPK%K060(:)*PCONC(:,20) + PJAC(:,21,15)=-TPK%K060(:)*PCONC(:,21) ! !BIO/HO2=0.0 ! @@ -9950,7 +10243,7 @@ SUBROUTINE SUBJ3 !BIO/ALKE=0.0 ! !BIO/BIO=-K054*<O3P>-K060*<OH>-K077*<NO3>-K080*<O3> - PJAC(:,20,20)=-TPK%K054(:)*TPK%O3P(:)-TPK%K060(:)*PCONC(:,14)-TPK%K077(:)*PCON& + PJAC(:,21,21)=-TPK%K054(:)*TPK%O3P(:)-TPK%K060(:)*PCONC(:,15)-TPK%K077(:)*PCON& &C(:,5)-TPK%K080(:)*PCONC(:,1) ! !BIO/ARO=0.0 @@ -10095,26 +10388,18 @@ SUBROUTINE SUBJ3 ! !BIO/WR_AHMS=0.0 ! -RETURN -END SUBROUTINE SUBJ3 -! -SUBROUTINE SUBJ4 -! -!Indices 21 a 25 -! -! !ARO/O3=+K087*<ADD> - PJAC(:,21,1)=+TPK%K087(:)*PCONC(:,37) + PJAC(:,22,1)=+TPK%K087(:)*PCONC(:,38) ! !ARO/H2O2=0.0 ! !ARO/NO=0.0 ! !ARO/NO2=+0.10670*K083*<PHO>+K085*<ADD> - PJAC(:,21,4)=+0.10670*TPK%K083(:)*PCONC(:,36)+TPK%K085(:)*PCONC(:,37) + PJAC(:,22,4)=+0.10670*TPK%K083(:)*PCONC(:,37)+TPK%K085(:)*PCONC(:,38) ! !ARO/NO3=-K075*<ARO> - PJAC(:,21,5)=-TPK%K075(:)*PCONC(:,21) + PJAC(:,22,5)=-TPK%K075(:)*PCONC(:,22) ! !ARO/N2O5=0.0 ! @@ -10126,6 +10411,8 @@ SUBROUTINE SUBJ4 ! !ARO/NH3=0.0 ! +!ARO/DMS=0.0 +! !ARO/SO2=0.0 ! !ARO/SULF=0.0 @@ -10133,10 +10420,10 @@ SUBROUTINE SUBJ4 !ARO/CO=0.0 ! !ARO/OH=-K061*<ARO> - PJAC(:,21,14)=-TPK%K061(:)*PCONC(:,21) + PJAC(:,22,15)=-TPK%K061(:)*PCONC(:,22) ! !ARO/HO2=+1.06698*K084*<PHO> - PJAC(:,21,15)=+1.06698*TPK%K084(:)*PCONC(:,36) + PJAC(:,22,16)=+1.06698*TPK%K084(:)*PCONC(:,37) ! !ARO/CH4=0.0 ! @@ -10149,7 +10436,7 @@ SUBROUTINE SUBJ4 !ARO/BIO=0.0 ! !ARO/ARO=-K061*<OH>-K075*<NO3> - PJAC(:,21,21)=-TPK%K061(:)*PCONC(:,14)-TPK%K075(:)*PCONC(:,5) + PJAC(:,22,22)=-TPK%K061(:)*PCONC(:,15)-TPK%K075(:)*PCONC(:,5) ! !ARO/HCHO=0.0 ! @@ -10180,10 +10467,10 @@ SUBROUTINE SUBJ4 !ARO/BIOP=0.0 ! !ARO/PHO=+0.10670*K083*<NO2>+1.06698*K084*<HO2> - PJAC(:,21,36)=+0.10670*TPK%K083(:)*PCONC(:,4)+1.06698*TPK%K084(:)*PCONC(:,15) + PJAC(:,22,37)=+0.10670*TPK%K083(:)*PCONC(:,4)+1.06698*TPK%K084(:)*PCONC(:,16) ! !ARO/ADD=+K085*<NO2>+0.02*K086*<O2>+K087*<O3> - PJAC(:,21,37)=+TPK%K085(:)*PCONC(:,4)+0.02*TPK%K086(:)*TPK%O2(:)+TPK%K087(:)*P& + PJAC(:,22,38)=+TPK%K085(:)*PCONC(:,4)+0.02*TPK%K086(:)*TPK%O2(:)+TPK%K087(:)*P& &CONC(:,1) ! !ARO/AROP=0.0 @@ -10296,25 +10583,25 @@ SUBROUTINE SUBJ4 ! !HCHO/O3=+0.48290*K079*<ALKE>+0.90000*K080*<BIO>+0.00000*K081*<CARBO>+0.70*K082 !*<PAN> - PJAC(:,22,1)=+0.48290*TPK%K079(:)*PCONC(:,19)+0.90000*TPK%K080(:)*PCONC(:,20)+& -&0.00000*TPK%K081(:)*PCONC(:,25)+0.70*TPK%K082(:)*PCONC(:,27) + PJAC(:,23,1)=+0.48290*TPK%K079(:)*PCONC(:,20)+0.90000*TPK%K080(:)*PCONC(:,21)+& +&0.00000*TPK%K081(:)*PCONC(:,26)+0.70*TPK%K082(:)*PCONC(:,28) ! !HCHO/H2O2=0.0 ! !HCHO/NO=+K090*<MO2>+0.03002*K091*<ALKAP>+1.39870*K092*<ALKEP>+0.60600*K093*<BI !OP>+0.05848*K095*<CARBOP>+0.23419*K096*<OLN> - PJAC(:,22,3)=+TPK%K090(:)*PCONC(:,32)+0.03002*TPK%K091(:)*PCONC(:,33)+1.39870*& -&TPK%K092(:)*PCONC(:,34)+0.60600*TPK%K093(:)*PCONC(:,35)+0.05848*TPK%K095(:)*PC& -&ONC(:,39)+0.23419*TPK%K096(:)*PCONC(:,40) + PJAC(:,23,3)=+TPK%K090(:)*PCONC(:,33)+0.03002*TPK%K091(:)*PCONC(:,34)+1.39870*& +&TPK%K092(:)*PCONC(:,35)+0.60600*TPK%K093(:)*PCONC(:,36)+0.05848*TPK%K095(:)*PC& +&ONC(:,40)+0.23419*TPK%K096(:)*PCONC(:,41) ! !HCHO/NO2=0.0 ! !HCHO/NO3=-K072*<HCHO>+0.40*K078*<PAN>+K119*<MO2>+0.03142*K120*<ALKAP>+1.40909* !K121*<ALKEP>+0.68600*K122*<BIOP>+0.03175*K124*<CARBOP>+0.20740*K125*<OLN> - PJAC(:,22,5)=-TPK%K072(:)*PCONC(:,22)+0.40*TPK%K078(:)*PCONC(:,27)+TPK%K119(:)& -&*PCONC(:,32)+0.03142*TPK%K120(:)*PCONC(:,33)+1.40909*TPK%K121(:)*PCONC(:,34)+0& -&.68600*TPK%K122(:)*PCONC(:,35)+0.03175*TPK%K124(:)*PCONC(:,39)+0.20740*TPK%K12& -&5(:)*PCONC(:,40) + PJAC(:,23,5)=-TPK%K072(:)*PCONC(:,23)+0.40*TPK%K078(:)*PCONC(:,28)+TPK%K119(:)& +&*PCONC(:,33)+0.03142*TPK%K120(:)*PCONC(:,34)+1.40909*TPK%K121(:)*PCONC(:,35)+0& +&.68600*TPK%K122(:)*PCONC(:,36)+0.03175*TPK%K124(:)*PCONC(:,40)+0.20740*TPK%K12& +&5(:)*PCONC(:,41) ! !HCHO/N2O5=0.0 ! @@ -10326,6 +10613,8 @@ SUBROUTINE SUBJ4 ! !HCHO/NH3=0.0 ! +!HCHO/DMS=0.0 +! !HCHO/SO2=0.0 ! !HCHO/SULF=0.0 @@ -10334,9 +10623,9 @@ SUBROUTINE SUBJ4 ! !HCHO/OH=+0.00140*K058*<ALKA>-K062*<HCHO>+0.00000*K065*<CARBO>+0.35*K068*<OP1>+ !0.02915*K069*<OP2>+0.57839*K070*<PAN> - PJAC(:,22,14)=+0.00140*TPK%K058(:)*PCONC(:,18)-TPK%K062(:)*PCONC(:,22)+0.00000& -&*TPK%K065(:)*PCONC(:,25)+0.35*TPK%K068(:)*PCONC(:,28)+0.02915*TPK%K069(:)*PCON& -&C(:,29)+0.57839*TPK%K070(:)*PCONC(:,27) + PJAC(:,23,15)=+0.00140*TPK%K058(:)*PCONC(:,19)-TPK%K062(:)*PCONC(:,23)+0.00000& +&*TPK%K065(:)*PCONC(:,26)+0.35*TPK%K068(:)*PCONC(:,29)+0.02915*TPK%K069(:)*PCON& +&C(:,30)+0.57839*TPK%K070(:)*PCONC(:,28) ! !HCHO/HO2=0.0 ! @@ -10345,18 +10634,18 @@ SUBROUTINE SUBJ4 !HCHO/ETH=0.0 ! !HCHO/ALKA=+0.00140*K058*<OH> - PJAC(:,22,18)=+0.00140*TPK%K058(:)*PCONC(:,14) + PJAC(:,23,19)=+0.00140*TPK%K058(:)*PCONC(:,15) ! !HCHO/ALKE=+0.48290*K079*<O3> - PJAC(:,22,19)=+0.48290*TPK%K079(:)*PCONC(:,1) + PJAC(:,23,20)=+0.48290*TPK%K079(:)*PCONC(:,1) ! !HCHO/BIO=+0.05*K054*<O3P>+0.90000*K080*<O3> - PJAC(:,22,20)=+0.05*TPK%K054(:)*TPK%O3P(:)+0.90000*TPK%K080(:)*PCONC(:,1) + PJAC(:,23,21)=+0.05*TPK%K054(:)*TPK%O3P(:)+0.90000*TPK%K080(:)*PCONC(:,1) ! !HCHO/ARO=0.0 ! !HCHO/HCHO=-K010-K011-K062*<OH>-K072*<NO3>-KTC16-KTR16 - PJAC(:,22,22)=-TPK%K010(:)-TPK%K011(:)-TPK%K062(:)*PCONC(:,14)-TPK%K072(:)*PCO& + PJAC(:,23,23)=-TPK%K010(:)-TPK%K011(:)-TPK%K062(:)*PCONC(:,15)-TPK%K072(:)*PCO& &NC(:,5)-TPK%KTC16(:)-TPK%KTR16(:) ! !HCHO/ALD=0.0 @@ -10364,20 +10653,20 @@ SUBROUTINE SUBJ4 !HCHO/KET=0.0 ! !HCHO/CARBO=+0.06517*K016+0.00000*K065*<OH>+0.00000*K081*<O3> - PJAC(:,22,25)=+0.06517*TPK%K016(:)+0.00000*TPK%K065(:)*PCONC(:,14)+0.00000*TPK& + PJAC(:,23,26)=+0.06517*TPK%K016(:)+0.00000*TPK%K065(:)*PCONC(:,15)+0.00000*TPK& &%K081(:)*PCONC(:,1) ! !HCHO/ONIT=0.0 ! !HCHO/PAN=+0.57839*K070*<OH>+0.40*K078*<NO3>+0.70*K082*<O3> - PJAC(:,22,27)=+0.57839*TPK%K070(:)*PCONC(:,14)+0.40*TPK%K078(:)*PCONC(:,5)+0.7& + PJAC(:,23,28)=+0.57839*TPK%K070(:)*PCONC(:,15)+0.40*TPK%K078(:)*PCONC(:,5)+0.7& &0*TPK%K082(:)*PCONC(:,1) ! !HCHO/OP1=+K013+0.35*K068*<OH> - PJAC(:,22,28)=+TPK%K013(:)+0.35*TPK%K068(:)*PCONC(:,14) + PJAC(:,23,29)=+TPK%K013(:)+0.35*TPK%K068(:)*PCONC(:,15) ! !HCHO/OP2=+0.02915*K069*<OH> - PJAC(:,22,29)=+0.02915*TPK%K069(:)*PCONC(:,14) + PJAC(:,23,30)=+0.02915*TPK%K069(:)*PCONC(:,15) ! !HCHO/ORA1=0.0 ! @@ -10386,50 +10675,50 @@ SUBROUTINE SUBJ4 !HCHO/MO2=+K090*<NO>+1.33*K104*<MO2>+1.33*K104*<MO2>+0.80556*K105*<ALKAP>+1.428 !94*K106*<ALKEP>+1.09000*K107*<BIOP>+K108*<AROP>+0.95723*K109*<CARBOP>+0.88625* !K110*<OLN>+K119*<NO3>+K127*<XO2> - PJAC(:,22,32)=+TPK%K090(:)*PCONC(:,3)+1.33*TPK%K104(:)*PCONC(:,32)+1.33*TPK%K1& -&04(:)*PCONC(:,32)+0.80556*TPK%K105(:)*PCONC(:,33)+1.42894*TPK%K106(:)*PCONC(:,& -&34)+1.09000*TPK%K107(:)*PCONC(:,35)+TPK%K108(:)*PCONC(:,38)+0.95723*TPK%K109(:& -&)*PCONC(:,39)+0.88625*TPK%K110(:)*PCONC(:,40)+TPK%K119(:)*PCONC(:,5)+TPK%K127(& -&:)*PCONC(:,41) + PJAC(:,23,33)=+TPK%K090(:)*PCONC(:,3)+1.33*TPK%K104(:)*PCONC(:,33)+1.33*TPK%K1& +&04(:)*PCONC(:,33)+0.80556*TPK%K105(:)*PCONC(:,34)+1.42894*TPK%K106(:)*PCONC(:,& +&35)+1.09000*TPK%K107(:)*PCONC(:,36)+TPK%K108(:)*PCONC(:,39)+0.95723*TPK%K109(:& +&)*PCONC(:,40)+0.88625*TPK%K110(:)*PCONC(:,41)+TPK%K119(:)*PCONC(:,5)+TPK%K127(& +&:)*PCONC(:,42) ! !HCHO/ALKAP=+0.03002*K091*<NO>+0.80556*K105*<MO2>+0.07600*K111*<CARBOP>+0.03142 !*K120*<NO3> - PJAC(:,22,33)=+0.03002*TPK%K091(:)*PCONC(:,3)+0.80556*TPK%K105(:)*PCONC(:,32)+& -&0.07600*TPK%K111(:)*PCONC(:,39)+0.03142*TPK%K120(:)*PCONC(:,5) + PJAC(:,23,34)=+0.03002*TPK%K091(:)*PCONC(:,3)+0.80556*TPK%K105(:)*PCONC(:,33)+& +&0.07600*TPK%K111(:)*PCONC(:,40)+0.03142*TPK%K120(:)*PCONC(:,5) ! !HCHO/ALKEP=+1.39870*K092*<NO>+1.42894*K106*<MO2>+0.68192*K112*<CARBOP>+1.40909 !*K121*<NO3> - PJAC(:,22,34)=+1.39870*TPK%K092(:)*PCONC(:,3)+1.42894*TPK%K106(:)*PCONC(:,32)+& -&0.68192*TPK%K112(:)*PCONC(:,39)+1.40909*TPK%K121(:)*PCONC(:,5) + PJAC(:,23,35)=+1.39870*TPK%K092(:)*PCONC(:,3)+1.42894*TPK%K106(:)*PCONC(:,33)+& +&0.68192*TPK%K112(:)*PCONC(:,40)+1.40909*TPK%K121(:)*PCONC(:,5) ! !HCHO/BIOP=+0.60600*K093*<NO>+1.09000*K107*<MO2>+0.34000*K113*<CARBOP>+0.68600* !K122*<NO3> - PJAC(:,22,35)=+0.60600*TPK%K093(:)*PCONC(:,3)+1.09000*TPK%K107(:)*PCONC(:,32)+& -&0.34000*TPK%K113(:)*PCONC(:,39)+0.68600*TPK%K122(:)*PCONC(:,5) + PJAC(:,23,36)=+0.60600*TPK%K093(:)*PCONC(:,3)+1.09000*TPK%K107(:)*PCONC(:,33)+& +&0.34000*TPK%K113(:)*PCONC(:,40)+0.68600*TPK%K122(:)*PCONC(:,5) ! !HCHO/PHO=0.0 ! !HCHO/ADD=0.0 ! !HCHO/AROP=+K108*<MO2> - PJAC(:,22,38)=+TPK%K108(:)*PCONC(:,32) + PJAC(:,23,39)=+TPK%K108(:)*PCONC(:,33) ! !HCHO/CARBOP=+0.05848*K095*<NO>+0.95723*K109*<MO2>+0.07600*K111*<ALKAP>+0.68192 !*K112*<ALKEP>+0.34000*K113*<BIOP>+0.03432*K115*<CARBOP>+0.03432*K115*<CARBOP>+ !0.13414*K116*<OLN>+0.03175*K124*<NO3> - PJAC(:,22,39)=+0.05848*TPK%K095(:)*PCONC(:,3)+0.95723*TPK%K109(:)*PCONC(:,32)+& -&0.07600*TPK%K111(:)*PCONC(:,33)+0.68192*TPK%K112(:)*PCONC(:,34)+0.34000*TPK%K1& -&13(:)*PCONC(:,35)+0.03432*TPK%K115(:)*PCONC(:,39)+0.03432*TPK%K115(:)*PCONC(:,& -&39)+0.13414*TPK%K116(:)*PCONC(:,40)+0.03175*TPK%K124(:)*PCONC(:,5) + PJAC(:,23,40)=+0.05848*TPK%K095(:)*PCONC(:,3)+0.95723*TPK%K109(:)*PCONC(:,33)+& +&0.07600*TPK%K111(:)*PCONC(:,34)+0.68192*TPK%K112(:)*PCONC(:,35)+0.34000*TPK%K1& +&13(:)*PCONC(:,36)+0.03432*TPK%K115(:)*PCONC(:,40)+0.03432*TPK%K115(:)*PCONC(:,& +&40)+0.13414*TPK%K116(:)*PCONC(:,41)+0.03175*TPK%K124(:)*PCONC(:,5) ! !HCHO/OLN=+0.23419*K096*<NO>+0.88625*K110*<MO2>+0.13414*K116*<CARBOP>+0.00000*K !118*<OLN>+0.00000*K118*<OLN>+0.20740*K125*<NO3> - PJAC(:,22,40)=+0.23419*TPK%K096(:)*PCONC(:,3)+0.88625*TPK%K110(:)*PCONC(:,32)+& -&0.13414*TPK%K116(:)*PCONC(:,39)+0.00000*TPK%K118(:)*PCONC(:,40)+0.00000*TPK%K1& -&18(:)*PCONC(:,40)+0.20740*TPK%K125(:)*PCONC(:,5) + PJAC(:,23,41)=+0.23419*TPK%K096(:)*PCONC(:,3)+0.88625*TPK%K110(:)*PCONC(:,33)+& +&0.13414*TPK%K116(:)*PCONC(:,40)+0.00000*TPK%K118(:)*PCONC(:,41)+0.00000*TPK%K1& +&18(:)*PCONC(:,41)+0.20740*TPK%K125(:)*PCONC(:,5) ! !HCHO/XO2=+K127*<MO2> - PJAC(:,22,41)=+TPK%K127(:)*PCONC(:,32) + PJAC(:,23,42)=+TPK%K127(:)*PCONC(:,33) ! !HCHO/WC_O3=0.0 ! @@ -10462,7 +10751,7 @@ SUBROUTINE SUBJ4 !HCHO/WC_SULF=0.0 ! !HCHO/WC_HCHO=+KTC36 - PJAC(:,22,57)=+TPK%KTC36(:) + PJAC(:,23,58)=+TPK%KTC36(:) ! !HCHO/WC_ORA1=0.0 ! @@ -10513,7 +10802,7 @@ SUBROUTINE SUBJ4 !HCHO/WR_SULF=0.0 ! !HCHO/WR_HCHO=+KTR36 - PJAC(:,22,82)=+TPK%KTR36(:) + PJAC(:,23,83)=+TPK%KTR36(:) ! !HCHO/WR_ORA1=0.0 ! @@ -10534,24 +10823,24 @@ SUBROUTINE SUBJ4 !HCHO/WR_AHMS=0.0 ! !ALD/O3=+0.51468*K079*<ALKE>+0.00000*K080*<BIO>+0.15692*K081*<CARBO> - PJAC(:,23,1)=+0.51468*TPK%K079(:)*PCONC(:,19)+0.00000*TPK%K080(:)*PCONC(:,20)+& -&0.15692*TPK%K081(:)*PCONC(:,25) + PJAC(:,24,1)=+0.51468*TPK%K079(:)*PCONC(:,20)+0.00000*TPK%K080(:)*PCONC(:,21)+& +&0.15692*TPK%K081(:)*PCONC(:,26) ! !ALD/H2O2=0.0 ! !ALD/NO=+0.33144*K091*<ALKAP>+0.42125*K092*<ALKEP>+0.00000*K093*<BIOP>+0.07368* !K095*<CARBOP>+1.01182*K096*<OLN> - PJAC(:,23,3)=+0.33144*TPK%K091(:)*PCONC(:,33)+0.42125*TPK%K092(:)*PCONC(:,34)+& -&0.00000*TPK%K093(:)*PCONC(:,35)+0.07368*TPK%K095(:)*PCONC(:,39)+1.01182*TPK%K0& -&96(:)*PCONC(:,40) + PJAC(:,24,3)=+0.33144*TPK%K091(:)*PCONC(:,34)+0.42125*TPK%K092(:)*PCONC(:,35)+& +&0.00000*TPK%K093(:)*PCONC(:,36)+0.07368*TPK%K095(:)*PCONC(:,40)+1.01182*TPK%K0& +&96(:)*PCONC(:,41) ! !ALD/NO2=0.0 ! !ALD/NO3=-K073*<ALD>+0.05265*K074*<CARBO>+0.33743*K120*<ALKAP>+0.43039*K121*<AL !KEP>+0.00000*K122*<BIOP>+0.02936*K124*<CARBOP>+0.91850*K125*<OLN> - PJAC(:,23,5)=-TPK%K073(:)*PCONC(:,23)+0.05265*TPK%K074(:)*PCONC(:,25)+0.33743*& -&TPK%K120(:)*PCONC(:,33)+0.43039*TPK%K121(:)*PCONC(:,34)+0.00000*TPK%K122(:)*PC& -&ONC(:,35)+0.02936*TPK%K124(:)*PCONC(:,39)+0.91850*TPK%K125(:)*PCONC(:,40) + PJAC(:,24,5)=-TPK%K073(:)*PCONC(:,24)+0.05265*TPK%K074(:)*PCONC(:,26)+0.33743*& +&TPK%K120(:)*PCONC(:,34)+0.43039*TPK%K121(:)*PCONC(:,35)+0.00000*TPK%K122(:)*PC& +&ONC(:,36)+0.02936*TPK%K124(:)*PCONC(:,40)+0.91850*TPK%K125(:)*PCONC(:,41) ! !ALD/N2O5=0.0 ! @@ -10563,6 +10852,8 @@ SUBROUTINE SUBJ4 ! !ALD/NH3=0.0 ! +!ALD/DMS=0.0 +! !ALD/SO2=0.0 ! !ALD/SULF=0.0 @@ -10570,8 +10861,8 @@ SUBROUTINE SUBJ4 !ALD/CO=0.0 ! !ALD/OH=+0.08173*K058*<ALKA>-K063*<ALD>+0.06253*K065*<CARBO>+0.07335*K069*<OP2> - PJAC(:,23,14)=+0.08173*TPK%K058(:)*PCONC(:,18)-TPK%K063(:)*PCONC(:,23)+0.06253& -&*TPK%K065(:)*PCONC(:,25)+0.07335*TPK%K069(:)*PCONC(:,29) + PJAC(:,24,15)=+0.08173*TPK%K058(:)*PCONC(:,19)-TPK%K063(:)*PCONC(:,24)+0.06253& +&*TPK%K065(:)*PCONC(:,26)+0.07335*TPK%K069(:)*PCONC(:,30) ! !ALD/HO2=0.0 ! @@ -10580,36 +10871,36 @@ SUBROUTINE SUBJ4 !ALD/ETH=0.0 ! !ALD/ALKA=+0.08173*K058*<OH> - PJAC(:,23,18)=+0.08173*TPK%K058(:)*PCONC(:,14) + PJAC(:,24,19)=+0.08173*TPK%K058(:)*PCONC(:,15) ! !ALD/ALKE=+0.51468*K079*<O3> - PJAC(:,23,19)=+0.51468*TPK%K079(:)*PCONC(:,1) + PJAC(:,24,20)=+0.51468*TPK%K079(:)*PCONC(:,1) ! !ALD/BIO=+0.00000*K080*<O3> - PJAC(:,23,20)=+0.00000*TPK%K080(:)*PCONC(:,1) + PJAC(:,24,21)=+0.00000*TPK%K080(:)*PCONC(:,1) ! !ALD/ARO=0.0 ! !ALD/HCHO=0.0 ! !ALD/ALD=-K012-K063*<OH>-K073*<NO3> - PJAC(:,23,23)=-TPK%K012(:)-TPK%K063(:)*PCONC(:,14)-TPK%K073(:)*PCONC(:,5) + PJAC(:,24,24)=-TPK%K012(:)-TPK%K063(:)*PCONC(:,15)-TPK%K073(:)*PCONC(:,5) ! !ALD/KET=0.0 ! !ALD/CARBO=+K055*<O3P>+0.06253*K065*<OH>+0.05265*K074*<NO3>+0.15692*K081*<O3> - PJAC(:,23,25)=+TPK%K055(:)*TPK%O3P(:)+0.06253*TPK%K065(:)*PCONC(:,14)+0.05265*& + PJAC(:,24,26)=+TPK%K055(:)*TPK%O3P(:)+0.06253*TPK%K065(:)*PCONC(:,15)+0.05265*& &TPK%K074(:)*PCONC(:,5)+0.15692*TPK%K081(:)*PCONC(:,1) ! !ALD/ONIT=+0.20*K017 - PJAC(:,23,26)=+0.20*TPK%K017(:) + PJAC(:,24,27)=+0.20*TPK%K017(:) ! !ALD/PAN=0.0 ! !ALD/OP1=0.0 ! !ALD/OP2=+0.96205*K014+0.07335*K069*<OH> - PJAC(:,23,29)=+0.96205*TPK%K014(:)+0.07335*TPK%K069(:)*PCONC(:,14) + PJAC(:,24,30)=+0.96205*TPK%K014(:)+0.07335*TPK%K069(:)*PCONC(:,15) ! !ALD/ORA1=0.0 ! @@ -10617,24 +10908,24 @@ SUBROUTINE SUBJ4 ! !ALD/MO2=+0.56070*K105*<ALKAP>+0.46413*K106*<ALKEP>+0.00000*K107*<BIOP>+0.08295 !*K109*<CARBOP>+0.41524*K110*<OLN> - PJAC(:,23,32)=+0.56070*TPK%K105(:)*PCONC(:,33)+0.46413*TPK%K106(:)*PCONC(:,34)& -&+0.00000*TPK%K107(:)*PCONC(:,35)+0.08295*TPK%K109(:)*PCONC(:,39)+0.41524*TPK%K& -&110(:)*PCONC(:,40) + PJAC(:,24,33)=+0.56070*TPK%K105(:)*PCONC(:,34)+0.46413*TPK%K106(:)*PCONC(:,35)& +&+0.00000*TPK%K107(:)*PCONC(:,36)+0.08295*TPK%K109(:)*PCONC(:,40)+0.41524*TPK%K& +&110(:)*PCONC(:,41) ! !ALD/ALKAP=+0.33144*K091*<NO>+0.56070*K105*<MO2>+0.71461*K111*<CARBOP>+0.33743* !K120*<NO3> - PJAC(:,23,33)=+0.33144*TPK%K091(:)*PCONC(:,3)+0.56070*TPK%K105(:)*PCONC(:,32)+& -&0.71461*TPK%K111(:)*PCONC(:,39)+0.33743*TPK%K120(:)*PCONC(:,5) + PJAC(:,24,34)=+0.33144*TPK%K091(:)*PCONC(:,3)+0.56070*TPK%K105(:)*PCONC(:,33)+& +&0.71461*TPK%K111(:)*PCONC(:,40)+0.33743*TPK%K120(:)*PCONC(:,5) ! !ALD/ALKEP=+0.42125*K092*<NO>+0.46413*K106*<MO2>+0.68374*K112*<CARBOP>+0.43039* !K121*<NO3> - PJAC(:,23,34)=+0.42125*TPK%K092(:)*PCONC(:,3)+0.46413*TPK%K106(:)*PCONC(:,32)+& -&0.68374*TPK%K112(:)*PCONC(:,39)+0.43039*TPK%K121(:)*PCONC(:,5) + PJAC(:,24,35)=+0.42125*TPK%K092(:)*PCONC(:,3)+0.46413*TPK%K106(:)*PCONC(:,33)+& +&0.68374*TPK%K112(:)*PCONC(:,40)+0.43039*TPK%K121(:)*PCONC(:,5) ! !ALD/BIOP=+0.00000*K093*<NO>+0.00000*K107*<MO2>+0.00000*K113*<CARBOP>+0.00000*K !122*<NO3> - PJAC(:,23,35)=+0.00000*TPK%K093(:)*PCONC(:,3)+0.00000*TPK%K107(:)*PCONC(:,32)+& -&0.00000*TPK%K113(:)*PCONC(:,39)+0.00000*TPK%K122(:)*PCONC(:,5) + PJAC(:,24,36)=+0.00000*TPK%K093(:)*PCONC(:,3)+0.00000*TPK%K107(:)*PCONC(:,33)+& +&0.00000*TPK%K113(:)*PCONC(:,40)+0.00000*TPK%K122(:)*PCONC(:,5) ! !ALD/PHO=0.0 ! @@ -10645,16 +10936,16 @@ SUBROUTINE SUBJ4 !ALD/CARBOP=+0.07368*K095*<NO>+0.08295*K109*<MO2>+0.71461*K111*<ALKAP>+0.68374* !K112*<ALKEP>+0.00000*K113*<BIOP>+0.06969*K115*<CARBOP>+0.06969*K115*<CARBOP>+0 !.42122*K116*<OLN>+0.02936*K124*<NO3> - PJAC(:,23,39)=+0.07368*TPK%K095(:)*PCONC(:,3)+0.08295*TPK%K109(:)*PCONC(:,32)+& -&0.71461*TPK%K111(:)*PCONC(:,33)+0.68374*TPK%K112(:)*PCONC(:,34)+0.00000*TPK%K1& -&13(:)*PCONC(:,35)+0.06969*TPK%K115(:)*PCONC(:,39)+0.06969*TPK%K115(:)*PCONC(:,& -&39)+0.42122*TPK%K116(:)*PCONC(:,40)+0.02936*TPK%K124(:)*PCONC(:,5) + PJAC(:,24,40)=+0.07368*TPK%K095(:)*PCONC(:,3)+0.08295*TPK%K109(:)*PCONC(:,33)+& +&0.71461*TPK%K111(:)*PCONC(:,34)+0.68374*TPK%K112(:)*PCONC(:,35)+0.00000*TPK%K1& +&13(:)*PCONC(:,36)+0.06969*TPK%K115(:)*PCONC(:,40)+0.06969*TPK%K115(:)*PCONC(:,& +&40)+0.42122*TPK%K116(:)*PCONC(:,41)+0.02936*TPK%K124(:)*PCONC(:,5) ! !ALD/OLN=+1.01182*K096*<NO>+0.41524*K110*<MO2>+0.42122*K116*<CARBOP>+0.00000*K1 !18*<OLN>+0.00000*K118*<OLN>+0.91850*K125*<NO3> - PJAC(:,23,40)=+1.01182*TPK%K096(:)*PCONC(:,3)+0.41524*TPK%K110(:)*PCONC(:,32)+& -&0.42122*TPK%K116(:)*PCONC(:,39)+0.00000*TPK%K118(:)*PCONC(:,40)+0.00000*TPK%K1& -&18(:)*PCONC(:,40)+0.91850*TPK%K125(:)*PCONC(:,5) + PJAC(:,24,41)=+1.01182*TPK%K096(:)*PCONC(:,3)+0.41524*TPK%K110(:)*PCONC(:,33)+& +&0.42122*TPK%K116(:)*PCONC(:,40)+0.00000*TPK%K118(:)*PCONC(:,41)+0.00000*TPK%K1& +&18(:)*PCONC(:,41)+0.91850*TPK%K125(:)*PCONC(:,5) ! !ALD/XO2=0.0 ! @@ -10759,22 +11050,22 @@ SUBROUTINE SUBJ4 !ALD/WR_AHMS=0.0 ! !KET/O3=+0.07377*K079*<ALKE>+0.00000*K080*<BIO> - PJAC(:,24,1)=+0.07377*TPK%K079(:)*PCONC(:,19)+0.00000*TPK%K080(:)*PCONC(:,20) + PJAC(:,25,1)=+0.07377*TPK%K079(:)*PCONC(:,20)+0.00000*TPK%K080(:)*PCONC(:,21) ! !KET/H2O2=0.0 ! !KET/NO=+0.54531*K091*<ALKAP>+0.05220*K092*<ALKEP>+0.00000*K093*<BIOP>+0.37862* !K096*<OLN> - PJAC(:,24,3)=+0.54531*TPK%K091(:)*PCONC(:,33)+0.05220*TPK%K092(:)*PCONC(:,34)+& -&0.00000*TPK%K093(:)*PCONC(:,35)+0.37862*TPK%K096(:)*PCONC(:,40) + PJAC(:,25,3)=+0.54531*TPK%K091(:)*PCONC(:,34)+0.05220*TPK%K092(:)*PCONC(:,35)+& +&0.00000*TPK%K093(:)*PCONC(:,36)+0.37862*TPK%K096(:)*PCONC(:,41) ! !KET/NO2=0.0 ! !KET/NO3=+0.00632*K074*<CARBO>+0.62978*K120*<ALKAP>+0.02051*K121*<ALKEP>+0.0000 !0*K122*<BIOP>+0.34740*K125*<OLN> - PJAC(:,24,5)=+0.00632*TPK%K074(:)*PCONC(:,25)+0.62978*TPK%K120(:)*PCONC(:,33)+& -&0.02051*TPK%K121(:)*PCONC(:,34)+0.00000*TPK%K122(:)*PCONC(:,35)+0.34740*TPK%K1& -&25(:)*PCONC(:,40) + PJAC(:,25,5)=+0.00632*TPK%K074(:)*PCONC(:,26)+0.62978*TPK%K120(:)*PCONC(:,34)+& +&0.02051*TPK%K121(:)*PCONC(:,35)+0.00000*TPK%K122(:)*PCONC(:,36)+0.34740*TPK%K1& +&25(:)*PCONC(:,41) ! !KET/N2O5=0.0 ! @@ -10786,6 +11077,8 @@ SUBROUTINE SUBJ4 ! !KET/NH3=0.0 ! +!KET/DMS=0.0 +! !KET/SO2=0.0 ! !KET/SULF=0.0 @@ -10793,8 +11086,8 @@ SUBROUTINE SUBJ4 !KET/CO=0.0 ! !KET/OH=+0.03498*K058*<ALKA>-K064*<KET>+0.00853*K065*<CARBO>+0.37591*K069*<OP2> - PJAC(:,24,14)=+0.03498*TPK%K058(:)*PCONC(:,18)-TPK%K064(:)*PCONC(:,24)+0.00853& -&*TPK%K065(:)*PCONC(:,25)+0.37591*TPK%K069(:)*PCONC(:,29) + PJAC(:,25,15)=+0.03498*TPK%K058(:)*PCONC(:,19)-TPK%K064(:)*PCONC(:,25)+0.00853& +&*TPK%K065(:)*PCONC(:,26)+0.37591*TPK%K069(:)*PCONC(:,30) ! !KET/HO2=0.0 ! @@ -10803,13 +11096,13 @@ SUBROUTINE SUBJ4 !KET/ETH=0.0 ! !KET/ALKA=+0.03498*K058*<OH> - PJAC(:,24,18)=+0.03498*TPK%K058(:)*PCONC(:,14) + PJAC(:,25,19)=+0.03498*TPK%K058(:)*PCONC(:,15) ! !KET/ALKE=+0.07377*K079*<O3> - PJAC(:,24,19)=+0.07377*TPK%K079(:)*PCONC(:,1) + PJAC(:,25,20)=+0.07377*TPK%K079(:)*PCONC(:,1) ! !KET/BIO=+0.00000*K080*<O3> - PJAC(:,24,20)=+0.00000*TPK%K080(:)*PCONC(:,1) + PJAC(:,25,21)=+0.00000*TPK%K080(:)*PCONC(:,1) ! !KET/ARO=0.0 ! @@ -10818,20 +11111,20 @@ SUBROUTINE SUBJ4 !KET/ALD=0.0 ! !KET/KET=-K015-K064*<OH> - PJAC(:,24,24)=-TPK%K015(:)-TPK%K064(:)*PCONC(:,14) + PJAC(:,25,25)=-TPK%K015(:)-TPK%K064(:)*PCONC(:,15) ! !KET/CARBO=+0.00853*K065*<OH>+0.00632*K074*<NO3> - PJAC(:,24,25)=+0.00853*TPK%K065(:)*PCONC(:,14)+0.00632*TPK%K074(:)*PCONC(:,5) + PJAC(:,25,26)=+0.00853*TPK%K065(:)*PCONC(:,15)+0.00632*TPK%K074(:)*PCONC(:,5) ! !KET/ONIT=+0.80*K017 - PJAC(:,24,26)=+0.80*TPK%K017(:) + PJAC(:,25,27)=+0.80*TPK%K017(:) ! !KET/PAN=0.0 ! !KET/OP1=0.0 ! !KET/OP2=+0.37591*K069*<OH> - PJAC(:,24,29)=+0.37591*TPK%K069(:)*PCONC(:,14) + PJAC(:,25,30)=+0.37591*TPK%K069(:)*PCONC(:,15) ! !KET/ORA1=0.0 ! @@ -10839,23 +11132,23 @@ SUBROUTINE SUBJ4 ! !KET/MO2=+0.09673*K105*<ALKAP>+0.03814*K106*<ALKEP>+0.00000*K107*<BIOP>+0.09667 !*K110*<OLN> - PJAC(:,24,32)=+0.09673*TPK%K105(:)*PCONC(:,33)+0.03814*TPK%K106(:)*PCONC(:,34)& -&+0.00000*TPK%K107(:)*PCONC(:,35)+0.09667*TPK%K110(:)*PCONC(:,40) + PJAC(:,25,33)=+0.09673*TPK%K105(:)*PCONC(:,34)+0.03814*TPK%K106(:)*PCONC(:,35)& +&+0.00000*TPK%K107(:)*PCONC(:,36)+0.09667*TPK%K110(:)*PCONC(:,41) ! !KET/ALKAP=+0.54531*K091*<NO>+0.09673*K105*<MO2>+0.18819*K111*<CARBOP>+0.62978* !K120*<NO3> - PJAC(:,24,33)=+0.54531*TPK%K091(:)*PCONC(:,3)+0.09673*TPK%K105(:)*PCONC(:,32)+& -&0.18819*TPK%K111(:)*PCONC(:,39)+0.62978*TPK%K120(:)*PCONC(:,5) + PJAC(:,25,34)=+0.54531*TPK%K091(:)*PCONC(:,3)+0.09673*TPK%K105(:)*PCONC(:,33)+& +&0.18819*TPK%K111(:)*PCONC(:,40)+0.62978*TPK%K120(:)*PCONC(:,5) ! !KET/ALKEP=+0.05220*K092*<NO>+0.03814*K106*<MO2>+0.06579*K112*<CARBOP>+0.02051* !K121*<NO3> - PJAC(:,24,34)=+0.05220*TPK%K092(:)*PCONC(:,3)+0.03814*TPK%K106(:)*PCONC(:,32)+& -&0.06579*TPK%K112(:)*PCONC(:,39)+0.02051*TPK%K121(:)*PCONC(:,5) + PJAC(:,25,35)=+0.05220*TPK%K092(:)*PCONC(:,3)+0.03814*TPK%K106(:)*PCONC(:,33)+& +&0.06579*TPK%K112(:)*PCONC(:,40)+0.02051*TPK%K121(:)*PCONC(:,5) ! !KET/BIOP=+0.00000*K093*<NO>+0.00000*K107*<MO2>+0.00000*K113*<CARBOP>+0.00000*K !122*<NO3> - PJAC(:,24,35)=+0.00000*TPK%K093(:)*PCONC(:,3)+0.00000*TPK%K107(:)*PCONC(:,32)+& -&0.00000*TPK%K113(:)*PCONC(:,39)+0.00000*TPK%K122(:)*PCONC(:,5) + PJAC(:,25,36)=+0.00000*TPK%K093(:)*PCONC(:,3)+0.00000*TPK%K107(:)*PCONC(:,33)+& +&0.00000*TPK%K113(:)*PCONC(:,40)+0.00000*TPK%K122(:)*PCONC(:,5) ! !KET/PHO=0.0 ! @@ -10865,15 +11158,15 @@ SUBROUTINE SUBJ4 ! !KET/CARBOP=+0.18819*K111*<ALKAP>+0.06579*K112*<ALKEP>+0.00000*K113*<BIOP>+0.02 !190*K115*<CARBOP>+0.02190*K115*<CARBOP>+0.10822*K116*<OLN> - PJAC(:,24,39)=+0.18819*TPK%K111(:)*PCONC(:,33)+0.06579*TPK%K112(:)*PCONC(:,34)& -&+0.00000*TPK%K113(:)*PCONC(:,35)+0.02190*TPK%K115(:)*PCONC(:,39)+0.02190*TPK%K& -&115(:)*PCONC(:,39)+0.10822*TPK%K116(:)*PCONC(:,40) + PJAC(:,25,40)=+0.18819*TPK%K111(:)*PCONC(:,34)+0.06579*TPK%K112(:)*PCONC(:,35)& +&+0.00000*TPK%K113(:)*PCONC(:,36)+0.02190*TPK%K115(:)*PCONC(:,40)+0.02190*TPK%K& +&115(:)*PCONC(:,40)+0.10822*TPK%K116(:)*PCONC(:,41) ! !KET/OLN=+0.37862*K096*<NO>+0.09667*K110*<MO2>+0.10822*K116*<CARBOP>+0.00000*K1 !18*<OLN>+0.00000*K118*<OLN>+0.34740*K125*<NO3> - PJAC(:,24,40)=+0.37862*TPK%K096(:)*PCONC(:,3)+0.09667*TPK%K110(:)*PCONC(:,32)+& -&0.10822*TPK%K116(:)*PCONC(:,39)+0.00000*TPK%K118(:)*PCONC(:,40)+0.00000*TPK%K1& -&18(:)*PCONC(:,40)+0.34740*TPK%K125(:)*PCONC(:,5) + PJAC(:,25,41)=+0.37862*TPK%K096(:)*PCONC(:,3)+0.09667*TPK%K110(:)*PCONC(:,33)+& +&0.10822*TPK%K116(:)*PCONC(:,40)+0.00000*TPK%K118(:)*PCONC(:,41)+0.00000*TPK%K1& +&18(:)*PCONC(:,41)+0.34740*TPK%K125(:)*PCONC(:,5) ! !KET/XO2=0.0 ! @@ -10977,27 +11270,35 @@ SUBROUTINE SUBJ4 ! !KET/WR_AHMS=0.0 ! +RETURN +END SUBROUTINE SUBJ4 +! +SUBROUTINE SUBJ5 +! +!Indices 26 a 30 +! +! !CARBO/O3=+0.00000*K079*<ALKE>+0.39754*K080*<BIO>+1.07583*K081*<CARBO>-K081*<CA !RBO> - PJAC(:,25,1)=+0.00000*TPK%K079(:)*PCONC(:,19)+0.39754*TPK%K080(:)*PCONC(:,20)+& -&1.07583*TPK%K081(:)*PCONC(:,25)-TPK%K081(:)*PCONC(:,25) + PJAC(:,26,1)=+0.00000*TPK%K079(:)*PCONC(:,20)+0.39754*TPK%K080(:)*PCONC(:,21)+& +&1.07583*TPK%K081(:)*PCONC(:,26)-TPK%K081(:)*PCONC(:,26) ! !CARBO/H2O2=0.0 ! !CARBO/NO=+0.03407*K091*<ALKAP>+0.45463*K093*<BIOP>+2.06993*K094*<AROP>+0.08670 !*K095*<CARBOP> - PJAC(:,25,3)=+0.03407*TPK%K091(:)*PCONC(:,33)+0.45463*TPK%K093(:)*PCONC(:,35)+& -&2.06993*TPK%K094(:)*PCONC(:,38)+0.08670*TPK%K095(:)*PCONC(:,39) + PJAC(:,26,3)=+0.03407*TPK%K091(:)*PCONC(:,34)+0.45463*TPK%K093(:)*PCONC(:,36)+& +&2.06993*TPK%K094(:)*PCONC(:,39)+0.08670*TPK%K095(:)*PCONC(:,40) ! !CARBO/NO2=0.0 ! !CARBO/NO3=+0.10530*K074*<CARBO>-K074*<CARBO>+0.00000*K076*<ALKE>+0.91741*K077* !<BIO>+0.03531*K120*<ALKAP>+0.61160*K122*<BIOP>+2.81904*K123*<AROP>+0.03455*K12 !4*<CARBOP> - PJAC(:,25,5)=+0.10530*TPK%K074(:)*PCONC(:,25)-TPK%K074(:)*PCONC(:,25)+0.00000*& -&TPK%K076(:)*PCONC(:,19)+0.91741*TPK%K077(:)*PCONC(:,20)+0.03531*TPK%K120(:)*PC& -&ONC(:,33)+0.61160*TPK%K122(:)*PCONC(:,35)+2.81904*TPK%K123(:)*PCONC(:,38)+0.03& -&455*TPK%K124(:)*PCONC(:,39) + PJAC(:,26,5)=+0.10530*TPK%K074(:)*PCONC(:,26)-TPK%K074(:)*PCONC(:,26)+0.00000*& +&TPK%K076(:)*PCONC(:,20)+0.91741*TPK%K077(:)*PCONC(:,21)+0.03531*TPK%K120(:)*PC& +&ONC(:,34)+0.61160*TPK%K122(:)*PCONC(:,36)+2.81904*TPK%K123(:)*PCONC(:,39)+0.03& +&455*TPK%K124(:)*PCONC(:,40) ! !CARBO/N2O5=0.0 ! @@ -11009,6 +11310,8 @@ SUBROUTINE SUBJ4 ! !CARBO/NH3=0.0 ! +!CARBO/DMS=0.0 +! !CARBO/SO2=0.0 ! !CARBO/SULF=0.0 @@ -11017,8 +11320,8 @@ SUBROUTINE SUBJ4 ! !CARBO/OH=+0.00835*K058*<ALKA>+0.16919*K065*<CARBO>-K065*<CARBO>+0.21863*K070*< !PAN> - PJAC(:,25,14)=+0.00835*TPK%K058(:)*PCONC(:,18)+0.16919*TPK%K065(:)*PCONC(:,25)& -&-TPK%K065(:)*PCONC(:,25)+0.21863*TPK%K070(:)*PCONC(:,27) + PJAC(:,26,15)=+0.00835*TPK%K058(:)*PCONC(:,19)+0.16919*TPK%K065(:)*PCONC(:,26)& +&-TPK%K065(:)*PCONC(:,26)+0.21863*TPK%K070(:)*PCONC(:,28) ! !CARBO/HO2=0.0 ! @@ -11027,13 +11330,13 @@ SUBROUTINE SUBJ4 !CARBO/ETH=0.0 ! !CARBO/ALKA=+0.00835*K058*<OH> - PJAC(:,25,18)=+0.00835*TPK%K058(:)*PCONC(:,14) + PJAC(:,26,19)=+0.00835*TPK%K058(:)*PCONC(:,15) ! !CARBO/ALKE=+0.00000*K076*<NO3>+0.00000*K079*<O3> - PJAC(:,25,19)=+0.00000*TPK%K076(:)*PCONC(:,5)+0.00000*TPK%K079(:)*PCONC(:,1) + PJAC(:,26,20)=+0.00000*TPK%K076(:)*PCONC(:,5)+0.00000*TPK%K079(:)*PCONC(:,1) ! !CARBO/BIO=+0.13255*K054*<O3P>+0.91741*K077*<NO3>+0.39754*K080*<O3> - PJAC(:,25,20)=+0.13255*TPK%K054(:)*TPK%O3P(:)+0.91741*TPK%K077(:)*PCONC(:,5)+0& + PJAC(:,26,21)=+0.13255*TPK%K054(:)*TPK%O3P(:)+0.91741*TPK%K077(:)*PCONC(:,5)+0& &.39754*TPK%K080(:)*PCONC(:,1) ! !CARBO/ARO=0.0 @@ -11046,14 +11349,14 @@ SUBROUTINE SUBJ4 ! !CARBO/CARBO=-K016-K055*<O3P>+0.16919*K065*<OH>-K065*<OH>+0.10530*K074*<NO3>-K0 !74*<NO3>+1.07583*K081*<O3>-K081*<O3> - PJAC(:,25,25)=-TPK%K016(:)-TPK%K055(:)*TPK%O3P(:)+0.16919*TPK%K065(:)*PCONC(:,& -&14)-TPK%K065(:)*PCONC(:,14)+0.10530*TPK%K074(:)*PCONC(:,5)-TPK%K074(:)*PCONC(:& + PJAC(:,26,26)=-TPK%K016(:)-TPK%K055(:)*TPK%O3P(:)+0.16919*TPK%K065(:)*PCONC(:,& +&15)-TPK%K065(:)*PCONC(:,15)+0.10530*TPK%K074(:)*PCONC(:,5)-TPK%K074(:)*PCONC(:& &,5)+1.07583*TPK%K081(:)*PCONC(:,1)-TPK%K081(:)*PCONC(:,1) ! !CARBO/ONIT=0.0 ! !CARBO/PAN=+0.21863*K070*<OH> - PJAC(:,25,27)=+0.21863*TPK%K070(:)*PCONC(:,14) + PJAC(:,26,28)=+0.21863*TPK%K070(:)*PCONC(:,15) ! !CARBO/OP1=0.0 ! @@ -11065,20 +11368,20 @@ SUBROUTINE SUBJ4 ! !CARBO/MO2=+0.07976*K105*<ALKAP>+0.56064*K107*<BIOP>+1.99461*K108*<AROP>+0.1538 !7*K109*<CARBOP> - PJAC(:,25,32)=+0.07976*TPK%K105(:)*PCONC(:,33)+0.56064*TPK%K107(:)*PCONC(:,35)& -&+1.99461*TPK%K108(:)*PCONC(:,38)+0.15387*TPK%K109(:)*PCONC(:,39) + PJAC(:,26,33)=+0.07976*TPK%K105(:)*PCONC(:,34)+0.56064*TPK%K107(:)*PCONC(:,36)& +&+1.99461*TPK%K108(:)*PCONC(:,39)+0.15387*TPK%K109(:)*PCONC(:,40) ! !CARBO/ALKAP=+0.03407*K091*<NO>+0.07976*K105*<MO2>+0.06954*K111*<CARBOP>+0.0353 !1*K120*<NO3> - PJAC(:,25,33)=+0.03407*TPK%K091(:)*PCONC(:,3)+0.07976*TPK%K105(:)*PCONC(:,32)+& -&0.06954*TPK%K111(:)*PCONC(:,39)+0.03531*TPK%K120(:)*PCONC(:,5) + PJAC(:,26,34)=+0.03407*TPK%K091(:)*PCONC(:,3)+0.07976*TPK%K105(:)*PCONC(:,33)+& +&0.06954*TPK%K111(:)*PCONC(:,40)+0.03531*TPK%K120(:)*PCONC(:,5) ! !CARBO/ALKEP=0.0 ! !CARBO/BIOP=+0.45463*K093*<NO>+0.56064*K107*<MO2>+0.78591*K113*<CARBOP>+0.61160 !*K122*<NO3> - PJAC(:,25,35)=+0.45463*TPK%K093(:)*PCONC(:,3)+0.56064*TPK%K107(:)*PCONC(:,32)+& -&0.78591*TPK%K113(:)*PCONC(:,39)+0.61160*TPK%K122(:)*PCONC(:,5) + PJAC(:,26,36)=+0.45463*TPK%K093(:)*PCONC(:,3)+0.56064*TPK%K107(:)*PCONC(:,33)+& +&0.78591*TPK%K113(:)*PCONC(:,40)+0.61160*TPK%K122(:)*PCONC(:,5) ! !CARBO/PHO=0.0 ! @@ -11086,16 +11389,16 @@ SUBROUTINE SUBJ4 ! !CARBO/AROP=+2.06993*K094*<NO>+1.99461*K108*<MO2>+1.99455*K114*<CARBOP>+2.81904 !*K123*<NO3> - PJAC(:,25,38)=+2.06993*TPK%K094(:)*PCONC(:,3)+1.99461*TPK%K108(:)*PCONC(:,32)+& -&1.99455*TPK%K114(:)*PCONC(:,39)+2.81904*TPK%K123(:)*PCONC(:,5) + PJAC(:,26,39)=+2.06993*TPK%K094(:)*PCONC(:,3)+1.99461*TPK%K108(:)*PCONC(:,33)+& +&1.99455*TPK%K114(:)*PCONC(:,40)+2.81904*TPK%K123(:)*PCONC(:,5) ! !CARBO/CARBOP=+0.08670*K095*<NO>+0.15387*K109*<MO2>+0.06954*K111*<ALKAP>+0.7859 !1*K113*<BIOP>+1.99455*K114*<AROP>+0.10777*K115*<CARBOP>+0.10777*K115*<CARBOP>+ !0.03455*K124*<NO3> - PJAC(:,25,39)=+0.08670*TPK%K095(:)*PCONC(:,3)+0.15387*TPK%K109(:)*PCONC(:,32)+& -&0.06954*TPK%K111(:)*PCONC(:,33)+0.78591*TPK%K113(:)*PCONC(:,35)+1.99455*TPK%K1& -&14(:)*PCONC(:,38)+0.10777*TPK%K115(:)*PCONC(:,39)+0.10777*TPK%K115(:)*PCONC(:,& -&39)+0.03455*TPK%K124(:)*PCONC(:,5) + PJAC(:,26,40)=+0.08670*TPK%K095(:)*PCONC(:,3)+0.15387*TPK%K109(:)*PCONC(:,33)+& +&0.06954*TPK%K111(:)*PCONC(:,34)+0.78591*TPK%K113(:)*PCONC(:,36)+1.99455*TPK%K1& +&14(:)*PCONC(:,39)+0.10777*TPK%K115(:)*PCONC(:,40)+0.10777*TPK%K115(:)*PCONC(:,& +&40)+0.03455*TPK%K124(:)*PCONC(:,5) ! !CARBO/OLN=0.0 ! @@ -11201,28 +11504,20 @@ SUBROUTINE SUBJ4 ! !CARBO/WR_AHMS=0.0 ! -RETURN -END SUBROUTINE SUBJ4 -! -SUBROUTINE SUBJ5 -! -!Indices 26 a 30 -! -! !ONIT/O3=0.0 ! !ONIT/H2O2=0.0 ! !ONIT/NO=+0.08459*K091*<ALKAP>+0.15300*K093*<BIOP>+0.04885*K094*<AROP>+0.18401* !K096*<OLN> - PJAC(:,26,3)=+0.08459*TPK%K091(:)*PCONC(:,33)+0.15300*TPK%K093(:)*PCONC(:,35)+& -&0.04885*TPK%K094(:)*PCONC(:,38)+0.18401*TPK%K096(:)*PCONC(:,40) + PJAC(:,27,3)=+0.08459*TPK%K091(:)*PCONC(:,34)+0.15300*TPK%K093(:)*PCONC(:,36)+& +&0.04885*TPK%K094(:)*PCONC(:,39)+0.18401*TPK%K096(:)*PCONC(:,41) ! !ONIT/NO2=+K083*<PHO> - PJAC(:,26,4)=+TPK%K083(:)*PCONC(:,36) + PJAC(:,27,4)=+TPK%K083(:)*PCONC(:,37) ! !ONIT/NO3=+0.60*K078*<PAN>+0.25928*K125*<OLN> - PJAC(:,26,5)=+0.60*TPK%K078(:)*PCONC(:,27)+0.25928*TPK%K125(:)*PCONC(:,40) + PJAC(:,27,5)=+0.60*TPK%K078(:)*PCONC(:,28)+0.25928*TPK%K125(:)*PCONC(:,41) ! !ONIT/N2O5=0.0 ! @@ -11234,6 +11529,8 @@ SUBROUTINE SUBJ5 ! !ONIT/NH3=0.0 ! +!ONIT/DMS=0.0 +! !ONIT/SO2=0.0 ! !ONIT/SULF=0.0 @@ -11241,10 +11538,10 @@ SUBROUTINE SUBJ5 !ONIT/CO=0.0 ! !ONIT/OH=-K071*<ONIT> - PJAC(:,26,14)=-TPK%K071(:)*PCONC(:,26) + PJAC(:,27,15)=-TPK%K071(:)*PCONC(:,27) ! !ONIT/HO2=+K103*<OLN> - PJAC(:,26,15)=+TPK%K103(:)*PCONC(:,40) + PJAC(:,27,16)=+TPK%K103(:)*PCONC(:,41) ! !ONIT/CH4=0.0 ! @@ -11267,10 +11564,10 @@ SUBROUTINE SUBJ5 !ONIT/CARBO=0.0 ! !ONIT/ONIT=-K017-K071*<OH> - PJAC(:,26,26)=-TPK%K017(:)-TPK%K071(:)*PCONC(:,14) + PJAC(:,27,27)=-TPK%K017(:)-TPK%K071(:)*PCONC(:,15) ! !ONIT/PAN=+0.60*K078*<NO3> - PJAC(:,26,27)=+0.60*TPK%K078(:)*PCONC(:,5) + PJAC(:,27,28)=+0.60*TPK%K078(:)*PCONC(:,5) ! !ONIT/OP1=0.0 ! @@ -11281,34 +11578,34 @@ SUBROUTINE SUBJ5 !ONIT/ORA2=0.0 ! !ONIT/MO2=+0.67560*K110*<OLN> - PJAC(:,26,32)=+0.67560*TPK%K110(:)*PCONC(:,40) + PJAC(:,27,33)=+0.67560*TPK%K110(:)*PCONC(:,41) ! !ONIT/ALKAP=+0.08459*K091*<NO> - PJAC(:,26,33)=+0.08459*TPK%K091(:)*PCONC(:,3) + PJAC(:,27,34)=+0.08459*TPK%K091(:)*PCONC(:,3) ! !ONIT/ALKEP=0.0 ! !ONIT/BIOP=+0.15300*K093*<NO> - PJAC(:,26,35)=+0.15300*TPK%K093(:)*PCONC(:,3) + PJAC(:,27,36)=+0.15300*TPK%K093(:)*PCONC(:,3) ! !ONIT/PHO=+K083*<NO2> - PJAC(:,26,36)=+TPK%K083(:)*PCONC(:,4) + PJAC(:,27,37)=+TPK%K083(:)*PCONC(:,4) ! !ONIT/ADD=0.0 ! !ONIT/AROP=+0.04885*K094*<NO> - PJAC(:,26,38)=+0.04885*TPK%K094(:)*PCONC(:,3) + PJAC(:,27,39)=+0.04885*TPK%K094(:)*PCONC(:,3) ! !ONIT/CARBOP=+0.66562*K116*<OLN> - PJAC(:,26,39)=+0.66562*TPK%K116(:)*PCONC(:,40) + PJAC(:,27,40)=+0.66562*TPK%K116(:)*PCONC(:,41) ! !ONIT/OLN=+0.18401*K096*<NO>+K103*<HO2>+0.67560*K110*<MO2>+0.66562*K116*<CARBOP !>+2.00*K117*<OLN>+2.00*K117*<OLN>+0.00000*K118*<OLN>+0.00000*K118*<OLN>+0.2592 !8*K125*<NO3> - PJAC(:,26,40)=+0.18401*TPK%K096(:)*PCONC(:,3)+TPK%K103(:)*PCONC(:,15)+0.67560*& -&TPK%K110(:)*PCONC(:,32)+0.66562*TPK%K116(:)*PCONC(:,39)+2.00*TPK%K117(:)*PCONC& -&(:,40)+2.00*TPK%K117(:)*PCONC(:,40)+0.00000*TPK%K118(:)*PCONC(:,40)+0.00000*TP& -&K%K118(:)*PCONC(:,40)+0.25928*TPK%K125(:)*PCONC(:,5) + PJAC(:,27,41)=+0.18401*TPK%K096(:)*PCONC(:,3)+TPK%K103(:)*PCONC(:,16)+0.67560*& +&TPK%K110(:)*PCONC(:,33)+0.66562*TPK%K116(:)*PCONC(:,40)+2.00*TPK%K117(:)*PCONC& +&(:,41)+2.00*TPK%K117(:)*PCONC(:,41)+0.00000*TPK%K118(:)*PCONC(:,41)+0.00000*TP& +&K%K118(:)*PCONC(:,41)+0.25928*TPK%K125(:)*PCONC(:,5) ! !ONIT/XO2=0.0 ! @@ -11413,17 +11710,17 @@ SUBROUTINE SUBJ5 !ONIT/WR_AHMS=0.0 ! !PAN/O3=+0.30000*K082*<PAN>-K082*<PAN> - PJAC(:,27,1)=+0.30000*TPK%K082(:)*PCONC(:,27)-TPK%K082(:)*PCONC(:,27) + PJAC(:,28,1)=+0.30000*TPK%K082(:)*PCONC(:,28)-TPK%K082(:)*PCONC(:,28) ! !PAN/H2O2=0.0 ! !PAN/NO=0.0 ! !PAN/NO2=+1.00000*K088*<CARBOP> - PJAC(:,27,4)=+1.00000*TPK%K088(:)*PCONC(:,39) + PJAC(:,28,4)=+1.00000*TPK%K088(:)*PCONC(:,40) ! !PAN/NO3=+0.40000*K078*<PAN>-K078*<PAN> - PJAC(:,27,5)=+0.40000*TPK%K078(:)*PCONC(:,27)-TPK%K078(:)*PCONC(:,27) + PJAC(:,28,5)=+0.40000*TPK%K078(:)*PCONC(:,28)-TPK%K078(:)*PCONC(:,28) ! !PAN/N2O5=0.0 ! @@ -11435,6 +11732,8 @@ SUBROUTINE SUBJ5 ! !PAN/NH3=0.0 ! +!PAN/DMS=0.0 +! !PAN/SO2=0.0 ! !PAN/SULF=0.0 @@ -11442,7 +11741,7 @@ SUBROUTINE SUBJ5 !PAN/CO=0.0 ! !PAN/OH=+0.28107*K070*<PAN>-K070*<PAN> - PJAC(:,27,14)=+0.28107*TPK%K070(:)*PCONC(:,27)-TPK%K070(:)*PCONC(:,27) + PJAC(:,28,15)=+0.28107*TPK%K070(:)*PCONC(:,28)-TPK%K070(:)*PCONC(:,28) ! !PAN/HO2=0.0 ! @@ -11470,7 +11769,7 @@ SUBROUTINE SUBJ5 ! !PAN/PAN=+0.28107*K070*<OH>-K070*<OH>+0.40000*K078*<NO3>-K078*<NO3>+0.30000*K08 !2*<O3>-K082*<O3>-K089 - PJAC(:,27,27)=+0.28107*TPK%K070(:)*PCONC(:,14)-TPK%K070(:)*PCONC(:,14)+0.40000& + PJAC(:,28,28)=+0.28107*TPK%K070(:)*PCONC(:,15)-TPK%K070(:)*PCONC(:,15)+0.40000& &*TPK%K078(:)*PCONC(:,5)-TPK%K078(:)*PCONC(:,5)+0.30000*TPK%K082(:)*PCONC(:,1)-& &TPK%K082(:)*PCONC(:,1)-TPK%K089(:) ! @@ -11497,7 +11796,7 @@ SUBROUTINE SUBJ5 !PAN/AROP=0.0 ! !PAN/CARBOP=+1.00000*K088*<NO2> - PJAC(:,27,39)=+1.00000*TPK%K088(:)*PCONC(:,4) + PJAC(:,28,40)=+1.00000*TPK%K088(:)*PCONC(:,4) ! !PAN/OLN=0.0 ! @@ -11623,6 +11922,8 @@ SUBROUTINE SUBJ5 ! !OP1/NH3=0.0 ! +!OP1/DMS=0.0 +! !OP1/SO2=0.0 ! !OP1/SULF=0.0 @@ -11630,10 +11931,10 @@ SUBROUTINE SUBJ5 !OP1/CO=0.0 ! !OP1/OH=-K068*<OP1> - PJAC(:,28,14)=-TPK%K068(:)*PCONC(:,28) + PJAC(:,29,15)=-TPK%K068(:)*PCONC(:,29) ! !OP1/HO2=+K097*<MO2> - PJAC(:,28,15)=+TPK%K097(:)*PCONC(:,32) + PJAC(:,29,16)=+TPK%K097(:)*PCONC(:,33) ! !OP1/CH4=0.0 ! @@ -11660,7 +11961,7 @@ SUBROUTINE SUBJ5 !OP1/PAN=0.0 ! !OP1/OP1=-K013-K068*<OH>-KTC20-KTR20 - PJAC(:,28,28)=-TPK%K013(:)-TPK%K068(:)*PCONC(:,14)-TPK%KTC20(:)-TPK%KTR20(:) + PJAC(:,29,29)=-TPK%K013(:)-TPK%K068(:)*PCONC(:,15)-TPK%KTC20(:)-TPK%KTR20(:) ! !OP1/OP2=0.0 ! @@ -11669,7 +11970,7 @@ SUBROUTINE SUBJ5 !OP1/ORA2=0.0 ! !OP1/MO2=+K097*<HO2> - PJAC(:,28,32)=+TPK%K097(:)*PCONC(:,15) + PJAC(:,29,33)=+TPK%K097(:)*PCONC(:,16) ! !OP1/ALKAP=0.0 ! @@ -11728,7 +12029,7 @@ SUBROUTINE SUBJ5 !OP1/WC_MO2=0.0 ! !OP1/WC_OP1=+KTC40 - PJAC(:,28,61)=+TPK%KTC40(:) + PJAC(:,29,62)=+TPK%KTC40(:) ! !OP1/WC_ASO3=0.0 ! @@ -11779,7 +12080,7 @@ SUBROUTINE SUBJ5 !OP1/WR_MO2=0.0 ! !OP1/WR_OP1=+KTR40 - PJAC(:,28,86)=+TPK%KTR40(:) + PJAC(:,29,87)=+TPK%KTR40(:) ! !OP1/WR_ASO3=0.0 ! @@ -11792,7 +12093,7 @@ SUBROUTINE SUBJ5 !OP1/WR_AHMS=0.0 ! !OP2/O3=+0.10149*K081*<CARBO> - PJAC(:,29,1)=+0.10149*TPK%K081(:)*PCONC(:,25) + PJAC(:,30,1)=+0.10149*TPK%K081(:)*PCONC(:,26) ! !OP2/H2O2=0.0 ! @@ -11812,6 +12113,8 @@ SUBROUTINE SUBJ5 ! !OP2/NH3=0.0 ! +!OP2/DMS=0.0 +! !OP2/SO2=0.0 ! !OP2/SULF=0.0 @@ -11819,13 +12122,13 @@ SUBROUTINE SUBJ5 !OP2/CO=0.0 ! !OP2/OH=-K069*<OP2> - PJAC(:,29,14)=-TPK%K069(:)*PCONC(:,29) + PJAC(:,30,15)=-TPK%K069(:)*PCONC(:,30) ! !OP2/HO2=+1.00524*K098*<ALKAP>+1.00524*K099*<ALKEP>+1.00524*K0100*<BIOP>+1.0052 !4*K0101*<AROP>+0.80904*K0102*<CARBOP>+1.00524*K126*<XO2> - PJAC(:,29,15)=+1.00524*TPK%K098(:)*PCONC(:,33)+1.00524*TPK%K099(:)*PCONC(:,34)& -&+1.00524*TPK%K0100(:)*PCONC(:,35)+1.00524*TPK%K0101(:)*PCONC(:,38)+0.80904*TPK& -&%K0102(:)*PCONC(:,39)+1.00524*TPK%K126(:)*PCONC(:,41) + PJAC(:,30,16)=+1.00524*TPK%K098(:)*PCONC(:,34)+1.00524*TPK%K099(:)*PCONC(:,35)& +&+1.00524*TPK%K0100(:)*PCONC(:,36)+1.00524*TPK%K0101(:)*PCONC(:,39)+0.80904*TPK& +&%K0102(:)*PCONC(:,40)+1.00524*TPK%K126(:)*PCONC(:,42) ! !OP2/CH4=0.0 ! @@ -11846,7 +12149,7 @@ SUBROUTINE SUBJ5 !OP2/KET=0.0 ! !OP2/CARBO=+0.10149*K081*<O3> - PJAC(:,29,25)=+0.10149*TPK%K081(:)*PCONC(:,1) + PJAC(:,30,26)=+0.10149*TPK%K081(:)*PCONC(:,1) ! !OP2/ONIT=0.0 ! @@ -11855,7 +12158,7 @@ SUBROUTINE SUBJ5 !OP2/OP1=0.0 ! !OP2/OP2=-K014-K069*<OH> - PJAC(:,29,29)=-TPK%K014(:)-TPK%K069(:)*PCONC(:,14) + PJAC(:,30,30)=-TPK%K014(:)-TPK%K069(:)*PCONC(:,15) ! !OP2/ORA1=0.0 ! @@ -11864,28 +12167,28 @@ SUBROUTINE SUBJ5 !OP2/MO2=0.0 ! !OP2/ALKAP=+1.00524*K098*<HO2> - PJAC(:,29,33)=+1.00524*TPK%K098(:)*PCONC(:,15) + PJAC(:,30,34)=+1.00524*TPK%K098(:)*PCONC(:,16) ! !OP2/ALKEP=+1.00524*K099*<HO2> - PJAC(:,29,34)=+1.00524*TPK%K099(:)*PCONC(:,15) + PJAC(:,30,35)=+1.00524*TPK%K099(:)*PCONC(:,16) ! !OP2/BIOP=+1.00524*K0100*<HO2> - PJAC(:,29,35)=+1.00524*TPK%K0100(:)*PCONC(:,15) + PJAC(:,30,36)=+1.00524*TPK%K0100(:)*PCONC(:,16) ! !OP2/PHO=0.0 ! !OP2/ADD=0.0 ! !OP2/AROP=+1.00524*K0101*<HO2> - PJAC(:,29,38)=+1.00524*TPK%K0101(:)*PCONC(:,15) + PJAC(:,30,39)=+1.00524*TPK%K0101(:)*PCONC(:,16) ! !OP2/CARBOP=+0.80904*K0102*<HO2> - PJAC(:,29,39)=+0.80904*TPK%K0102(:)*PCONC(:,15) + PJAC(:,30,40)=+0.80904*TPK%K0102(:)*PCONC(:,16) ! !OP2/OLN=0.0 ! !OP2/XO2=+1.00524*K126*<HO2> - PJAC(:,29,41)=+1.00524*TPK%K126(:)*PCONC(:,15) + PJAC(:,30,42)=+1.00524*TPK%K126(:)*PCONC(:,16) ! !OP2/WC_O3=0.0 ! @@ -11987,10 +12290,18 @@ SUBROUTINE SUBJ5 ! !OP2/WR_AHMS=0.0 ! +RETURN +END SUBROUTINE SUBJ5 +! +SUBROUTINE SUBJ6 +! +!Indices 31 a 35 +! +! !ORA1/O3=+0.15343*K079*<ALKE>+0.15000*K080*<BIO>+0.10788*K081*<CARBO>+0.11*K082 !*<PAN> - PJAC(:,30,1)=+0.15343*TPK%K079(:)*PCONC(:,19)+0.15000*TPK%K080(:)*PCONC(:,20)+& -&0.10788*TPK%K081(:)*PCONC(:,25)+0.11*TPK%K082(:)*PCONC(:,27) + PJAC(:,31,1)=+0.15343*TPK%K079(:)*PCONC(:,20)+0.15000*TPK%K080(:)*PCONC(:,21)+& +&0.10788*TPK%K081(:)*PCONC(:,26)+0.11*TPK%K082(:)*PCONC(:,28) ! !ORA1/H2O2=0.0 ! @@ -12010,6 +12321,8 @@ SUBROUTINE SUBJ5 ! !ORA1/NH3=0.0 ! +!ORA1/DMS=0.0 +! !ORA1/SO2=0.0 ! !ORA1/SULF=0.0 @@ -12017,7 +12330,7 @@ SUBROUTINE SUBJ5 !ORA1/CO=0.0 ! !ORA1/OH=+0.00878*K058*<ALKA>-K066*<ORA1> - PJAC(:,30,14)=+0.00878*TPK%K058(:)*PCONC(:,18)-TPK%K066(:)*PCONC(:,30) + PJAC(:,31,15)=+0.00878*TPK%K058(:)*PCONC(:,19)-TPK%K066(:)*PCONC(:,31) ! !ORA1/HO2=0.0 ! @@ -12026,13 +12339,13 @@ SUBROUTINE SUBJ5 !ORA1/ETH=0.0 ! !ORA1/ALKA=+0.00878*K058*<OH> - PJAC(:,30,18)=+0.00878*TPK%K058(:)*PCONC(:,14) + PJAC(:,31,19)=+0.00878*TPK%K058(:)*PCONC(:,15) ! !ORA1/ALKE=+0.15343*K079*<O3> - PJAC(:,30,19)=+0.15343*TPK%K079(:)*PCONC(:,1) + PJAC(:,31,20)=+0.15343*TPK%K079(:)*PCONC(:,1) ! !ORA1/BIO=+0.15000*K080*<O3> - PJAC(:,30,20)=+0.15000*TPK%K080(:)*PCONC(:,1) + PJAC(:,31,21)=+0.15000*TPK%K080(:)*PCONC(:,1) ! !ORA1/ARO=0.0 ! @@ -12043,19 +12356,19 @@ SUBROUTINE SUBJ5 !ORA1/KET=0.0 ! !ORA1/CARBO=+0.10788*K081*<O3> - PJAC(:,30,25)=+0.10788*TPK%K081(:)*PCONC(:,1) + PJAC(:,31,26)=+0.10788*TPK%K081(:)*PCONC(:,1) ! !ORA1/ONIT=0.0 ! !ORA1/PAN=+0.11*K082*<O3> - PJAC(:,30,27)=+0.11*TPK%K082(:)*PCONC(:,1) + PJAC(:,31,28)=+0.11*TPK%K082(:)*PCONC(:,1) ! !ORA1/OP1=0.0 ! !ORA1/OP2=0.0 ! !ORA1/ORA1=-K066*<OH>-KTC17-KTR17 - PJAC(:,30,30)=-TPK%K066(:)*PCONC(:,14)-TPK%KTC17(:)-TPK%KTR17(:) + PJAC(:,31,31)=-TPK%K066(:)*PCONC(:,15)-TPK%KTC17(:)-TPK%KTR17(:) ! !ORA1/ORA2=0.0 ! @@ -12112,7 +12425,7 @@ SUBROUTINE SUBJ5 !ORA1/WC_HCHO=0.0 ! !ORA1/WC_ORA1=+KTC37 - PJAC(:,30,58)=+TPK%KTC37(:) + PJAC(:,31,59)=+TPK%KTC37(:) ! !ORA1/WC_ORA2=0.0 ! @@ -12163,7 +12476,7 @@ SUBROUTINE SUBJ5 !ORA1/WR_HCHO=0.0 ! !ORA1/WR_ORA1=+KTR37 - PJAC(:,30,83)=+TPK%KTR37(:) + PJAC(:,31,84)=+TPK%KTR37(:) ! !ORA1/WR_ORA2=0.0 ! @@ -12181,17 +12494,9 @@ SUBROUTINE SUBJ5 ! !ORA1/WR_AHMS=0.0 ! -RETURN -END SUBROUTINE SUBJ5 -! -SUBROUTINE SUBJ6 -! -!Indices 31 a 35 -! -! !ORA2/O3=+0.08143*K079*<ALKE>+0.00000*K080*<BIO>+0.20595*K081*<CARBO> - PJAC(:,31,1)=+0.08143*TPK%K079(:)*PCONC(:,19)+0.00000*TPK%K080(:)*PCONC(:,20)+& -&0.20595*TPK%K081(:)*PCONC(:,25) + PJAC(:,32,1)=+0.08143*TPK%K079(:)*PCONC(:,20)+0.00000*TPK%K080(:)*PCONC(:,21)+& +&0.20595*TPK%K081(:)*PCONC(:,26) ! !ORA2/H2O2=0.0 ! @@ -12211,6 +12516,8 @@ SUBROUTINE SUBJ6 ! !ORA2/NH3=0.0 ! +!ORA2/DMS=0.0 +! !ORA2/SO2=0.0 ! !ORA2/SULF=0.0 @@ -12218,10 +12525,10 @@ SUBROUTINE SUBJ6 !ORA2/CO=0.0 ! !ORA2/OH=-K067*<ORA2> - PJAC(:,31,14)=-TPK%K067(:)*PCONC(:,31) + PJAC(:,32,15)=-TPK%K067(:)*PCONC(:,32) ! !ORA2/HO2=+0.17307*K0102*<CARBOP> - PJAC(:,31,15)=+0.17307*TPK%K0102(:)*PCONC(:,39) + PJAC(:,32,16)=+0.17307*TPK%K0102(:)*PCONC(:,40) ! !ORA2/CH4=0.0 ! @@ -12230,10 +12537,10 @@ SUBROUTINE SUBJ6 !ORA2/ALKA=0.0 ! !ORA2/ALKE=+0.08143*K079*<O3> - PJAC(:,31,19)=+0.08143*TPK%K079(:)*PCONC(:,1) + PJAC(:,32,20)=+0.08143*TPK%K079(:)*PCONC(:,1) ! !ORA2/BIO=+0.00000*K080*<O3> - PJAC(:,31,20)=+0.00000*TPK%K080(:)*PCONC(:,1) + PJAC(:,32,21)=+0.00000*TPK%K080(:)*PCONC(:,1) ! !ORA2/ARO=0.0 ! @@ -12244,7 +12551,7 @@ SUBROUTINE SUBJ6 !ORA2/KET=0.0 ! !ORA2/CARBO=+0.20595*K081*<O3> - PJAC(:,31,25)=+0.20595*TPK%K081(:)*PCONC(:,1) + PJAC(:,32,26)=+0.20595*TPK%K081(:)*PCONC(:,1) ! !ORA2/ONIT=0.0 ! @@ -12257,19 +12564,19 @@ SUBROUTINE SUBJ6 !ORA2/ORA1=0.0 ! !ORA2/ORA2=-K067*<OH>-KTC18-KTR18 - PJAC(:,31,31)=-TPK%K067(:)*PCONC(:,14)-TPK%KTC18(:)-TPK%KTR18(:) + PJAC(:,32,32)=-TPK%K067(:)*PCONC(:,15)-TPK%KTC18(:)-TPK%KTR18(:) ! !ORA2/MO2=+0.13684*K109*<CARBOP> - PJAC(:,31,32)=+0.13684*TPK%K109(:)*PCONC(:,39) + PJAC(:,32,33)=+0.13684*TPK%K109(:)*PCONC(:,40) ! !ORA2/ALKAP=+0.49810*K111*<CARBOP> - PJAC(:,31,33)=+0.49810*TPK%K111(:)*PCONC(:,39) + PJAC(:,32,34)=+0.49810*TPK%K111(:)*PCONC(:,40) ! !ORA2/ALKEP=+0.49922*K112*<CARBOP> - PJAC(:,31,34)=+0.49922*TPK%K112(:)*PCONC(:,39) + PJAC(:,32,35)=+0.49922*TPK%K112(:)*PCONC(:,40) ! !ORA2/BIOP=+0.49400*K113*<CARBOP> - PJAC(:,31,35)=+0.49400*TPK%K113(:)*PCONC(:,39) + PJAC(:,32,36)=+0.49400*TPK%K113(:)*PCONC(:,40) ! !ORA2/PHO=0.0 ! @@ -12280,13 +12587,13 @@ SUBROUTINE SUBJ6 !ORA2/CARBOP=+0.17307*K0102*<HO2>+0.13684*K109*<MO2>+0.49810*K111*<ALKAP>+0.499 !22*K112*<ALKEP>+0.49400*K113*<BIOP>+0.09955*K115*<CARBOP>+0.09955*K115*<CARBOP !>+0.48963*K116*<OLN> - PJAC(:,31,39)=+0.17307*TPK%K0102(:)*PCONC(:,15)+0.13684*TPK%K109(:)*PCONC(:,32& -&)+0.49810*TPK%K111(:)*PCONC(:,33)+0.49922*TPK%K112(:)*PCONC(:,34)+0.49400*TPK%& -&K113(:)*PCONC(:,35)+0.09955*TPK%K115(:)*PCONC(:,39)+0.09955*TPK%K115(:)*PCONC(& -&:,39)+0.48963*TPK%K116(:)*PCONC(:,40) + PJAC(:,32,40)=+0.17307*TPK%K0102(:)*PCONC(:,16)+0.13684*TPK%K109(:)*PCONC(:,33& +&)+0.49810*TPK%K111(:)*PCONC(:,34)+0.49922*TPK%K112(:)*PCONC(:,35)+0.49400*TPK%& +&K113(:)*PCONC(:,36)+0.09955*TPK%K115(:)*PCONC(:,40)+0.09955*TPK%K115(:)*PCONC(& +&:,40)+0.48963*TPK%K116(:)*PCONC(:,41) ! !ORA2/OLN=+0.48963*K116*<CARBOP> - PJAC(:,31,40)=+0.48963*TPK%K116(:)*PCONC(:,39) + PJAC(:,32,41)=+0.48963*TPK%K116(:)*PCONC(:,40) ! !ORA2/XO2=0.0 ! @@ -12325,7 +12632,7 @@ SUBROUTINE SUBJ6 !ORA2/WC_ORA1=0.0 ! !ORA2/WC_ORA2=+KTC38 - PJAC(:,31,59)=+TPK%KTC38(:) + PJAC(:,32,60)=+TPK%KTC38(:) ! !ORA2/WC_MO2=0.0 ! @@ -12376,7 +12683,7 @@ SUBROUTINE SUBJ6 !ORA2/WR_ORA1=0.0 ! !ORA2/WR_ORA2=+KTR38 - PJAC(:,31,84)=+TPK%KTR38(:) + PJAC(:,32,85)=+TPK%KTR38(:) ! !ORA2/WR_MO2=0.0 ! @@ -12393,19 +12700,19 @@ SUBROUTINE SUBJ6 !ORA2/WR_AHMS=0.0 ! !MO2/O3=+0.13966*K079*<ALKE>+0.03000*K080*<BIO> - PJAC(:,32,1)=+0.13966*TPK%K079(:)*PCONC(:,19)+0.03000*TPK%K080(:)*PCONC(:,20) + PJAC(:,33,1)=+0.13966*TPK%K079(:)*PCONC(:,20)+0.03000*TPK%K080(:)*PCONC(:,21) ! !MO2/H2O2=0.0 ! !MO2/NO=-K090*<MO2>+0.09016*K091*<ALKAP>+0.78134*K095*<CARBOP> - PJAC(:,32,3)=-TPK%K090(:)*PCONC(:,32)+0.09016*TPK%K091(:)*PCONC(:,33)+0.78134*& -&TPK%K095(:)*PCONC(:,39) + PJAC(:,33,3)=-TPK%K090(:)*PCONC(:,33)+0.09016*TPK%K091(:)*PCONC(:,34)+0.78134*& +&TPK%K095(:)*PCONC(:,40) ! !MO2/NO2=0.0 ! !MO2/NO3=-K119*<MO2>+0.09731*K120*<ALKAP>+0.91910*K124*<CARBOP> - PJAC(:,32,5)=-TPK%K119(:)*PCONC(:,32)+0.09731*TPK%K120(:)*PCONC(:,33)+0.91910*& -&TPK%K124(:)*PCONC(:,39) + PJAC(:,33,5)=-TPK%K119(:)*PCONC(:,33)+0.09731*TPK%K120(:)*PCONC(:,34)+0.91910*& +&TPK%K124(:)*PCONC(:,40) ! !MO2/N2O5=0.0 ! @@ -12417,6 +12724,8 @@ SUBROUTINE SUBJ6 ! !MO2/NH3=0.0 ! +!MO2/DMS=0.0 +! !MO2/SO2=0.0 ! !MO2/SULF=0.0 @@ -12424,30 +12733,30 @@ SUBROUTINE SUBJ6 !MO2/CO=0.0 ! !MO2/OH=+K056*<CH4>+0.65*K068*<OP1> - PJAC(:,32,14)=+TPK%K056(:)*PCONC(:,16)+0.65*TPK%K068(:)*PCONC(:,28) + PJAC(:,33,15)=+TPK%K056(:)*PCONC(:,17)+0.65*TPK%K068(:)*PCONC(:,29) ! !MO2/HO2=-K097*<MO2> - PJAC(:,32,15)=-TPK%K097(:)*PCONC(:,32) + PJAC(:,33,16)=-TPK%K097(:)*PCONC(:,33) ! !MO2/CH4=+K056*<OH> - PJAC(:,32,16)=+TPK%K056(:)*PCONC(:,14) + PJAC(:,33,17)=+TPK%K056(:)*PCONC(:,15) ! !MO2/ETH=0.0 ! !MO2/ALKA=0.0 ! !MO2/ALKE=+0.13966*K079*<O3> - PJAC(:,32,19)=+0.13966*TPK%K079(:)*PCONC(:,1) + PJAC(:,33,20)=+0.13966*TPK%K079(:)*PCONC(:,1) ! !MO2/BIO=+0.03000*K080*<O3> - PJAC(:,32,20)=+0.03000*TPK%K080(:)*PCONC(:,1) + PJAC(:,33,21)=+0.03000*TPK%K080(:)*PCONC(:,1) ! !MO2/ARO=0.0 ! !MO2/HCHO=0.0 ! !MO2/ALD=+K012 - PJAC(:,32,23)=+TPK%K012(:) + PJAC(:,33,24)=+TPK%K012(:) ! !MO2/KET=0.0 ! @@ -12458,10 +12767,10 @@ SUBROUTINE SUBJ6 !MO2/PAN=0.0 ! !MO2/OP1=+0.65*K068*<OH> - PJAC(:,32,28)=+0.65*TPK%K068(:)*PCONC(:,14) + PJAC(:,33,29)=+0.65*TPK%K068(:)*PCONC(:,15) ! !MO2/OP2=+0.03795*K014 - PJAC(:,32,29)=+0.03795*TPK%K014(:) + PJAC(:,33,30)=+0.03795*TPK%K014(:) ! !MO2/ORA1=0.0 ! @@ -12470,46 +12779,46 @@ SUBROUTINE SUBJ6 !MO2/MO2=-K090*<NO>-K097*<HO2>-K104*<MO2>-K104*<MO2>-K104*<MO2>-K104*<MO2>+0.01 !390*K105*<ALKAP>-K105*<ALKAP>-K106*<ALKEP>-K107*<BIOP>-K108*<AROP>+0.56031*K10 !9*<CARBOP>-K109*<CARBOP>-K110*<OLN>-K119*<NO3>-K127*<XO2>-KTC19-KTR19 - PJAC(:,32,32)=-TPK%K090(:)*PCONC(:,3)-TPK%K097(:)*PCONC(:,15)-TPK%K104(:)*PCON& -&C(:,32)-TPK%K104(:)*PCONC(:,32)-TPK%K104(:)*PCONC(:,32)-TPK%K104(:)*PCONC(:,32& -&)+0.01390*TPK%K105(:)*PCONC(:,33)-TPK%K105(:)*PCONC(:,33)-TPK%K106(:)*PCONC(:,& -&34)-TPK%K107(:)*PCONC(:,35)-TPK%K108(:)*PCONC(:,38)+0.56031*TPK%K109(:)*PCONC(& -&:,39)-TPK%K109(:)*PCONC(:,39)-TPK%K110(:)*PCONC(:,40)-TPK%K119(:)*PCONC(:,5)-T& -&PK%K127(:)*PCONC(:,41)-TPK%KTC19(:)-TPK%KTR19(:) + PJAC(:,33,33)=-TPK%K090(:)*PCONC(:,3)-TPK%K097(:)*PCONC(:,16)-TPK%K104(:)*PCON& +&C(:,33)-TPK%K104(:)*PCONC(:,33)-TPK%K104(:)*PCONC(:,33)-TPK%K104(:)*PCONC(:,33& +&)+0.01390*TPK%K105(:)*PCONC(:,34)-TPK%K105(:)*PCONC(:,34)-TPK%K106(:)*PCONC(:,& +&35)-TPK%K107(:)*PCONC(:,36)-TPK%K108(:)*PCONC(:,39)+0.56031*TPK%K109(:)*PCONC(& +&:,40)-TPK%K109(:)*PCONC(:,40)-TPK%K110(:)*PCONC(:,41)-TPK%K119(:)*PCONC(:,5)-T& +&PK%K127(:)*PCONC(:,42)-TPK%KTC19(:)-TPK%KTR19(:) ! !MO2/ALKAP=+0.09016*K091*<NO>+0.01390*K105*<MO2>-K105*<MO2>+0.51480*K111*<CARBO !P>+0.09731*K120*<NO3> - PJAC(:,32,33)=+0.09016*TPK%K091(:)*PCONC(:,3)+0.01390*TPK%K105(:)*PCONC(:,32)-& -&TPK%K105(:)*PCONC(:,32)+0.51480*TPK%K111(:)*PCONC(:,39)+0.09731*TPK%K120(:)*PC& + PJAC(:,33,34)=+0.09016*TPK%K091(:)*PCONC(:,3)+0.01390*TPK%K105(:)*PCONC(:,33)-& +&TPK%K105(:)*PCONC(:,33)+0.51480*TPK%K111(:)*PCONC(:,40)+0.09731*TPK%K120(:)*PC& &ONC(:,5) ! !MO2/ALKEP=-K106*<MO2>+0.50078*K112*<CARBOP> - PJAC(:,32,34)=-TPK%K106(:)*PCONC(:,32)+0.50078*TPK%K112(:)*PCONC(:,39) + PJAC(:,33,35)=-TPK%K106(:)*PCONC(:,33)+0.50078*TPK%K112(:)*PCONC(:,40) ! !MO2/BIOP=-K107*<MO2>+0.50600*K113*<CARBOP> - PJAC(:,32,35)=-TPK%K107(:)*PCONC(:,32)+0.50600*TPK%K113(:)*PCONC(:,39) + PJAC(:,33,36)=-TPK%K107(:)*PCONC(:,33)+0.50600*TPK%K113(:)*PCONC(:,40) ! !MO2/PHO=0.0 ! !MO2/ADD=0.0 ! !MO2/AROP=-K108*<MO2>+K114*<CARBOP> - PJAC(:,32,38)=-TPK%K108(:)*PCONC(:,32)+TPK%K114(:)*PCONC(:,39) + PJAC(:,33,39)=-TPK%K108(:)*PCONC(:,33)+TPK%K114(:)*PCONC(:,40) ! !MO2/CARBOP=+0.78134*K095*<NO>+0.56031*K109*<MO2>-K109*<MO2>+0.51480*K111*<ALKA !P>+0.50078*K112*<ALKEP>+0.50600*K113*<BIOP>+K114*<AROP>+1.66702*K115*<CARBOP>+ !1.66702*K115*<CARBOP>+0.51037*K116*<OLN>+0.91910*K124*<NO3>+K128*<XO2> - PJAC(:,32,39)=+0.78134*TPK%K095(:)*PCONC(:,3)+0.56031*TPK%K109(:)*PCONC(:,32)-& -&TPK%K109(:)*PCONC(:,32)+0.51480*TPK%K111(:)*PCONC(:,33)+0.50078*TPK%K112(:)*PC& -&ONC(:,34)+0.50600*TPK%K113(:)*PCONC(:,35)+TPK%K114(:)*PCONC(:,38)+1.66702*TPK%& -&K115(:)*PCONC(:,39)+1.66702*TPK%K115(:)*PCONC(:,39)+0.51037*TPK%K116(:)*PCONC(& -&:,40)+0.91910*TPK%K124(:)*PCONC(:,5)+TPK%K128(:)*PCONC(:,41) + PJAC(:,33,40)=+0.78134*TPK%K095(:)*PCONC(:,3)+0.56031*TPK%K109(:)*PCONC(:,33)-& +&TPK%K109(:)*PCONC(:,33)+0.51480*TPK%K111(:)*PCONC(:,34)+0.50078*TPK%K112(:)*PC& +&ONC(:,35)+0.50600*TPK%K113(:)*PCONC(:,36)+TPK%K114(:)*PCONC(:,39)+1.66702*TPK%& +&K115(:)*PCONC(:,40)+1.66702*TPK%K115(:)*PCONC(:,40)+0.51037*TPK%K116(:)*PCONC(& +&:,41)+0.91910*TPK%K124(:)*PCONC(:,5)+TPK%K128(:)*PCONC(:,42) ! !MO2/OLN=-K110*<MO2>+0.51037*K116*<CARBOP> - PJAC(:,32,40)=-TPK%K110(:)*PCONC(:,32)+0.51037*TPK%K116(:)*PCONC(:,39) + PJAC(:,33,41)=-TPK%K110(:)*PCONC(:,33)+0.51037*TPK%K116(:)*PCONC(:,40) ! !MO2/XO2=-K127*<MO2>+K128*<CARBOP> - PJAC(:,32,41)=-TPK%K127(:)*PCONC(:,32)+TPK%K128(:)*PCONC(:,39) + PJAC(:,33,42)=-TPK%K127(:)*PCONC(:,33)+TPK%K128(:)*PCONC(:,40) ! !MO2/WC_O3=0.0 ! @@ -12548,7 +12857,7 @@ SUBROUTINE SUBJ6 !MO2/WC_ORA2=0.0 ! !MO2/WC_MO2=+KTC39 - PJAC(:,32,60)=+TPK%KTC39(:) + PJAC(:,33,61)=+TPK%KTC39(:) ! !MO2/WC_OP1=0.0 ! @@ -12599,7 +12908,7 @@ SUBROUTINE SUBJ6 !MO2/WR_ORA2=0.0 ! !MO2/WR_MO2=+KTR39 - PJAC(:,32,85)=+TPK%KTR39(:) + PJAC(:,33,86)=+TPK%KTR39(:) ! !MO2/WR_OP1=0.0 ! @@ -12614,17 +12923,17 @@ SUBROUTINE SUBJ6 !MO2/WR_AHMS=0.0 ! !ALKAP/O3=+0.09815*K079*<ALKE>+0.00000*K080*<BIO> - PJAC(:,33,1)=+0.09815*TPK%K079(:)*PCONC(:,19)+0.00000*TPK%K080(:)*PCONC(:,20) + PJAC(:,34,1)=+0.09815*TPK%K079(:)*PCONC(:,20)+0.00000*TPK%K080(:)*PCONC(:,21) ! !ALKAP/H2O2=0.0 ! !ALKAP/NO=+0.08187*K091*<ALKAP>-K091*<ALKAP> - PJAC(:,33,3)=+0.08187*TPK%K091(:)*PCONC(:,33)-TPK%K091(:)*PCONC(:,33) + PJAC(:,34,3)=+0.08187*TPK%K091(:)*PCONC(:,34)-TPK%K091(:)*PCONC(:,34) ! !ALKAP/NO2=0.0 ! !ALKAP/NO3=+0.08994*K120*<ALKAP>-K120*<ALKAP> - PJAC(:,33,5)=+0.08994*TPK%K120(:)*PCONC(:,33)-TPK%K120(:)*PCONC(:,33) + PJAC(:,34,5)=+0.08994*TPK%K120(:)*PCONC(:,34)-TPK%K120(:)*PCONC(:,34) ! !ALKAP/N2O5=0.0 ! @@ -12636,6 +12945,8 @@ SUBROUTINE SUBJ6 ! !ALKAP/NH3=0.0 ! +!ALKAP/DMS=0.0 +! !ALKAP/SO2=0.0 ! !ALKAP/SULF=0.0 @@ -12644,25 +12955,25 @@ SUBROUTINE SUBJ6 ! !ALKAP/OH=+K057*<ETH>+0.87811*K058*<ALKA>+0.40341*K069*<OP2>+1.00000*K071*<ONIT !> - PJAC(:,33,14)=+TPK%K057(:)*PCONC(:,17)+0.87811*TPK%K058(:)*PCONC(:,18)+0.40341& -&*TPK%K069(:)*PCONC(:,29)+1.00000*TPK%K071(:)*PCONC(:,26) + PJAC(:,34,15)=+TPK%K057(:)*PCONC(:,18)+0.87811*TPK%K058(:)*PCONC(:,19)+0.40341& +&*TPK%K069(:)*PCONC(:,30)+1.00000*TPK%K071(:)*PCONC(:,27) ! !ALKAP/HO2=-K098*<ALKAP> - PJAC(:,33,15)=-TPK%K098(:)*PCONC(:,33) + PJAC(:,34,16)=-TPK%K098(:)*PCONC(:,34) ! !ALKAP/CH4=0.0 ! !ALKAP/ETH=+K057*<OH> - PJAC(:,33,17)=+TPK%K057(:)*PCONC(:,14) + PJAC(:,34,18)=+TPK%K057(:)*PCONC(:,15) ! !ALKAP/ALKA=+0.87811*K058*<OH> - PJAC(:,33,18)=+0.87811*TPK%K058(:)*PCONC(:,14) + PJAC(:,34,19)=+0.87811*TPK%K058(:)*PCONC(:,15) ! !ALKAP/ALKE=+0.09815*K079*<O3> - PJAC(:,33,19)=+0.09815*TPK%K079(:)*PCONC(:,1) + PJAC(:,34,20)=+0.09815*TPK%K079(:)*PCONC(:,1) ! !ALKAP/BIO=+0.00000*K080*<O3> - PJAC(:,33,20)=+0.00000*TPK%K080(:)*PCONC(:,1) + PJAC(:,34,21)=+0.00000*TPK%K080(:)*PCONC(:,1) ! !ALKAP/ARO=0.0 ! @@ -12671,32 +12982,32 @@ SUBROUTINE SUBJ6 !ALKAP/ALD=0.0 ! !ALKAP/KET=+1.00000*K015 - PJAC(:,33,24)=+1.00000*TPK%K015(:) + PJAC(:,34,25)=+1.00000*TPK%K015(:) ! !ALKAP/CARBO=0.0 ! !ALKAP/ONIT=+1.00000*K071*<OH> - PJAC(:,33,26)=+1.00000*TPK%K071(:)*PCONC(:,14) + PJAC(:,34,27)=+1.00000*TPK%K071(:)*PCONC(:,15) ! !ALKAP/PAN=0.0 ! !ALKAP/OP1=0.0 ! !ALKAP/OP2=+0.40341*K069*<OH> - PJAC(:,33,29)=+0.40341*TPK%K069(:)*PCONC(:,14) + PJAC(:,34,30)=+0.40341*TPK%K069(:)*PCONC(:,15) ! !ALKAP/ORA1=0.0 ! !ALKAP/ORA2=0.0 ! !ALKAP/MO2=+0.00385*K105*<ALKAP>-K105*<ALKAP> - PJAC(:,33,32)=+0.00385*TPK%K105(:)*PCONC(:,33)-TPK%K105(:)*PCONC(:,33) + PJAC(:,34,33)=+0.00385*TPK%K105(:)*PCONC(:,34)-TPK%K105(:)*PCONC(:,34) ! !ALKAP/ALKAP=+0.08187*K091*<NO>-K091*<NO>-K098*<HO2>+0.00385*K105*<MO2>-K105*<M !O2>+0.00828*K111*<CARBOP>-K111*<CARBOP>+0.08994*K120*<NO3>-K120*<NO3> - PJAC(:,33,33)=+0.08187*TPK%K091(:)*PCONC(:,3)-TPK%K091(:)*PCONC(:,3)-TPK%K098(& -&:)*PCONC(:,15)+0.00385*TPK%K105(:)*PCONC(:,32)-TPK%K105(:)*PCONC(:,32)+0.00828& -&*TPK%K111(:)*PCONC(:,39)-TPK%K111(:)*PCONC(:,39)+0.08994*TPK%K120(:)*PCONC(:,5& + PJAC(:,34,34)=+0.08187*TPK%K091(:)*PCONC(:,3)-TPK%K091(:)*PCONC(:,3)-TPK%K098(& +&:)*PCONC(:,16)+0.00385*TPK%K105(:)*PCONC(:,33)-TPK%K105(:)*PCONC(:,33)+0.00828& +&*TPK%K111(:)*PCONC(:,40)-TPK%K111(:)*PCONC(:,40)+0.08994*TPK%K120(:)*PCONC(:,5& &)-TPK%K120(:)*PCONC(:,5) ! !ALKAP/ALKEP=0.0 @@ -12710,7 +13021,7 @@ SUBROUTINE SUBJ6 !ALKAP/AROP=0.0 ! !ALKAP/CARBOP=+0.00828*K111*<ALKAP>-K111*<ALKAP> - PJAC(:,33,39)=+0.00828*TPK%K111(:)*PCONC(:,33)-TPK%K111(:)*PCONC(:,33) + PJAC(:,34,40)=+0.00828*TPK%K111(:)*PCONC(:,34)-TPK%K111(:)*PCONC(:,34) ! !ALKAP/OLN=0.0 ! @@ -12821,12 +13132,12 @@ SUBROUTINE SUBJ6 !ALKEP/H2O2=0.0 ! !ALKEP/NO=-K092*<ALKEP> - PJAC(:,34,3)=-TPK%K092(:)*PCONC(:,34) + PJAC(:,35,3)=-TPK%K092(:)*PCONC(:,35) ! !ALKEP/NO2=0.0 ! !ALKEP/NO3=-K121*<ALKEP> - PJAC(:,34,5)=-TPK%K121(:)*PCONC(:,34) + PJAC(:,35,5)=-TPK%K121(:)*PCONC(:,35) ! !ALKEP/N2O5=0.0 ! @@ -12838,6 +13149,8 @@ SUBROUTINE SUBJ6 ! !ALKEP/NH3=0.0 ! +!ALKEP/DMS=0.0 +! !ALKEP/SO2=0.0 ! !ALKEP/SULF=0.0 @@ -12845,10 +13158,10 @@ SUBROUTINE SUBJ6 !ALKEP/CO=0.0 ! !ALKEP/OH=+1.02529*K059*<ALKE> - PJAC(:,34,14)=+1.02529*TPK%K059(:)*PCONC(:,19) + PJAC(:,35,15)=+1.02529*TPK%K059(:)*PCONC(:,20) ! !ALKEP/HO2=-K099*<ALKEP> - PJAC(:,34,15)=-TPK%K099(:)*PCONC(:,34) + PJAC(:,35,16)=-TPK%K099(:)*PCONC(:,35) ! !ALKEP/CH4=0.0 ! @@ -12857,7 +13170,7 @@ SUBROUTINE SUBJ6 !ALKEP/ALKA=0.0 ! !ALKEP/ALKE=+1.02529*K059*<OH> - PJAC(:,34,19)=+1.02529*TPK%K059(:)*PCONC(:,14) + PJAC(:,35,20)=+1.02529*TPK%K059(:)*PCONC(:,15) ! !ALKEP/BIO=0.0 ! @@ -12884,13 +13197,13 @@ SUBROUTINE SUBJ6 !ALKEP/ORA2=0.0 ! !ALKEP/MO2=-K106*<ALKEP> - PJAC(:,34,32)=-TPK%K106(:)*PCONC(:,34) + PJAC(:,35,33)=-TPK%K106(:)*PCONC(:,35) ! !ALKEP/ALKAP=0.0 ! !ALKEP/ALKEP=-K092*<NO>-K099*<HO2>-K106*<MO2>-K112*<CARBOP>-K121*<NO3> - PJAC(:,34,34)=-TPK%K092(:)*PCONC(:,3)-TPK%K099(:)*PCONC(:,15)-TPK%K106(:)*PCON& -&C(:,32)-TPK%K112(:)*PCONC(:,39)-TPK%K121(:)*PCONC(:,5) + PJAC(:,35,35)=-TPK%K092(:)*PCONC(:,3)-TPK%K099(:)*PCONC(:,16)-TPK%K106(:)*PCON& +&C(:,33)-TPK%K112(:)*PCONC(:,40)-TPK%K121(:)*PCONC(:,5) ! !ALKEP/BIOP=0.0 ! @@ -12901,7 +13214,7 @@ SUBROUTINE SUBJ6 !ALKEP/AROP=0.0 ! !ALKEP/CARBOP=-K112*<ALKEP> - PJAC(:,34,39)=-TPK%K112(:)*PCONC(:,34) + PJAC(:,35,40)=-TPK%K112(:)*PCONC(:,35) ! !ALKEP/OLN=0.0 ! @@ -13007,17 +13320,25 @@ SUBROUTINE SUBJ6 ! !ALKEP/WR_AHMS=0.0 ! +RETURN +END SUBROUTINE SUBJ6 +! +SUBROUTINE SUBJ7 +! +!Indices 36 a 40 +! +! !BIOP/O3=0.0 ! !BIOP/H2O2=0.0 ! !BIOP/NO=-K093*<BIOP> - PJAC(:,35,3)=-TPK%K093(:)*PCONC(:,35) + PJAC(:,36,3)=-TPK%K093(:)*PCONC(:,36) ! !BIOP/NO2=0.0 ! !BIOP/NO3=-K122*<BIOP> - PJAC(:,35,5)=-TPK%K122(:)*PCONC(:,35) + PJAC(:,36,5)=-TPK%K122(:)*PCONC(:,36) ! !BIOP/N2O5=0.0 ! @@ -13029,6 +13350,8 @@ SUBROUTINE SUBJ6 ! !BIOP/NH3=0.0 ! +!BIOP/DMS=0.0 +! !BIOP/SO2=0.0 ! !BIOP/SULF=0.0 @@ -13036,10 +13359,10 @@ SUBROUTINE SUBJ6 !BIOP/CO=0.0 ! !BIOP/OH=+0.00000*K059*<ALKE>+1.00000*K060*<BIO> - PJAC(:,35,14)=+0.00000*TPK%K059(:)*PCONC(:,19)+1.00000*TPK%K060(:)*PCONC(:,20) + PJAC(:,36,15)=+0.00000*TPK%K059(:)*PCONC(:,20)+1.00000*TPK%K060(:)*PCONC(:,21) ! !BIOP/HO2=-K0100*<BIOP> - PJAC(:,35,15)=-TPK%K0100(:)*PCONC(:,35) + PJAC(:,36,16)=-TPK%K0100(:)*PCONC(:,36) ! !BIOP/CH4=0.0 ! @@ -13048,10 +13371,10 @@ SUBROUTINE SUBJ6 !BIOP/ALKA=0.0 ! !BIOP/ALKE=+0.00000*K059*<OH> - PJAC(:,35,19)=+0.00000*TPK%K059(:)*PCONC(:,14) + PJAC(:,36,20)=+0.00000*TPK%K059(:)*PCONC(:,15) ! !BIOP/BIO=+1.00000*K060*<OH> - PJAC(:,35,20)=+1.00000*TPK%K060(:)*PCONC(:,14) + PJAC(:,36,21)=+1.00000*TPK%K060(:)*PCONC(:,15) ! !BIOP/ARO=0.0 ! @@ -13076,15 +13399,15 @@ SUBROUTINE SUBJ6 !BIOP/ORA2=0.0 ! !BIOP/MO2=-K107*<BIOP> - PJAC(:,35,32)=-TPK%K107(:)*PCONC(:,35) + PJAC(:,36,33)=-TPK%K107(:)*PCONC(:,36) ! !BIOP/ALKAP=0.0 ! !BIOP/ALKEP=0.0 ! !BIOP/BIOP=-K093*<NO>-K0100*<HO2>-K107*<MO2>-K113*<CARBOP>-K122*<NO3> - PJAC(:,35,35)=-TPK%K093(:)*PCONC(:,3)-TPK%K0100(:)*PCONC(:,15)-TPK%K107(:)*PCO& -&NC(:,32)-TPK%K113(:)*PCONC(:,39)-TPK%K122(:)*PCONC(:,5) + PJAC(:,36,36)=-TPK%K093(:)*PCONC(:,3)-TPK%K0100(:)*PCONC(:,16)-TPK%K107(:)*PCO& +&NC(:,33)-TPK%K113(:)*PCONC(:,40)-TPK%K122(:)*PCONC(:,5) ! !BIOP/PHO=0.0 ! @@ -13093,7 +13416,7 @@ SUBROUTINE SUBJ6 !BIOP/AROP=0.0 ! !BIOP/CARBOP=-K113*<BIOP> - PJAC(:,35,39)=-TPK%K113(:)*PCONC(:,35) + PJAC(:,36,40)=-TPK%K113(:)*PCONC(:,36) ! !BIOP/OLN=0.0 ! @@ -13199,14 +13522,6 @@ SUBROUTINE SUBJ6 ! !BIOP/WR_AHMS=0.0 ! -RETURN -END SUBROUTINE SUBJ6 -! -SUBROUTINE SUBJ7 -! -!Indices 36 a 40 -! -! !PHO/O3=0.0 ! !PHO/H2O2=0.0 @@ -13214,10 +13529,10 @@ SUBROUTINE SUBJ7 !PHO/NO=0.0 ! !PHO/NO2=-K083*<PHO> - PJAC(:,36,4)=-TPK%K083(:)*PCONC(:,36) + PJAC(:,37,4)=-TPK%K083(:)*PCONC(:,37) ! !PHO/NO3=+K075*<ARO> - PJAC(:,36,5)=+TPK%K075(:)*PCONC(:,21) + PJAC(:,37,5)=+TPK%K075(:)*PCONC(:,22) ! !PHO/N2O5=0.0 ! @@ -13229,6 +13544,8 @@ SUBROUTINE SUBJ7 ! !PHO/NH3=0.0 ! +!PHO/DMS=0.0 +! !PHO/SO2=0.0 ! !PHO/SULF=0.0 @@ -13236,10 +13553,10 @@ SUBROUTINE SUBJ7 !PHO/CO=0.0 ! !PHO/OH=+0.00276*K061*<ARO> - PJAC(:,36,14)=+0.00276*TPK%K061(:)*PCONC(:,21) + PJAC(:,37,15)=+0.00276*TPK%K061(:)*PCONC(:,22) ! !PHO/HO2=-K084*<PHO> - PJAC(:,36,15)=-TPK%K084(:)*PCONC(:,36) + PJAC(:,37,16)=-TPK%K084(:)*PCONC(:,37) ! !PHO/CH4=0.0 ! @@ -13252,7 +13569,7 @@ SUBROUTINE SUBJ7 !PHO/BIO=0.0 ! !PHO/ARO=+0.00276*K061*<OH>+K075*<NO3> - PJAC(:,36,21)=+0.00276*TPK%K061(:)*PCONC(:,14)+TPK%K075(:)*PCONC(:,5) + PJAC(:,37,22)=+0.00276*TPK%K061(:)*PCONC(:,15)+TPK%K075(:)*PCONC(:,5) ! !PHO/HCHO=0.0 ! @@ -13283,7 +13600,7 @@ SUBROUTINE SUBJ7 !PHO/BIOP=0.0 ! !PHO/PHO=-K083*<NO2>-K084*<HO2> - PJAC(:,36,36)=-TPK%K083(:)*PCONC(:,4)-TPK%K084(:)*PCONC(:,15) + PJAC(:,37,37)=-TPK%K083(:)*PCONC(:,4)-TPK%K084(:)*PCONC(:,16) ! !PHO/ADD=0.0 ! @@ -13396,14 +13713,14 @@ SUBROUTINE SUBJ7 !PHO/WR_AHMS=0.0 ! !ADD/O3=-K087*<ADD> - PJAC(:,37,1)=-TPK%K087(:)*PCONC(:,37) + PJAC(:,38,1)=-TPK%K087(:)*PCONC(:,38) ! !ADD/H2O2=0.0 ! !ADD/NO=0.0 ! !ADD/NO2=-K085*<ADD> - PJAC(:,37,4)=-TPK%K085(:)*PCONC(:,37) + PJAC(:,38,4)=-TPK%K085(:)*PCONC(:,38) ! !ADD/NO3=0.0 ! @@ -13417,6 +13734,8 @@ SUBROUTINE SUBJ7 ! !ADD/NH3=0.0 ! +!ADD/DMS=0.0 +! !ADD/SO2=0.0 ! !ADD/SULF=0.0 @@ -13424,7 +13743,7 @@ SUBROUTINE SUBJ7 !ADD/CO=0.0 ! !ADD/OH=+0.93968*K061*<ARO> - PJAC(:,37,14)=+0.93968*TPK%K061(:)*PCONC(:,21) + PJAC(:,38,15)=+0.93968*TPK%K061(:)*PCONC(:,22) ! !ADD/HO2=0.0 ! @@ -13439,7 +13758,7 @@ SUBROUTINE SUBJ7 !ADD/BIO=0.0 ! !ADD/ARO=+0.93968*K061*<OH> - PJAC(:,37,21)=+0.93968*TPK%K061(:)*PCONC(:,14) + PJAC(:,38,22)=+0.93968*TPK%K061(:)*PCONC(:,15) ! !ADD/HCHO=0.0 ! @@ -13472,7 +13791,7 @@ SUBROUTINE SUBJ7 !ADD/PHO=0.0 ! !ADD/ADD=-K085*<NO2>-K086*<O2>-K087*<O3> - PJAC(:,37,37)=-TPK%K085(:)*PCONC(:,4)-TPK%K086(:)*TPK%O2(:)-TPK%K087(:)*PCONC(& + PJAC(:,38,38)=-TPK%K085(:)*PCONC(:,4)-TPK%K086(:)*TPK%O2(:)-TPK%K087(:)*PCONC(& &:,1) ! !ADD/AROP=0.0 @@ -13588,12 +13907,12 @@ SUBROUTINE SUBJ7 !AROP/H2O2=0.0 ! !AROP/NO=-K094*<AROP> - PJAC(:,38,3)=-TPK%K094(:)*PCONC(:,38) + PJAC(:,39,3)=-TPK%K094(:)*PCONC(:,39) ! !AROP/NO2=0.0 ! !AROP/NO3=-K123*<AROP> - PJAC(:,38,5)=-TPK%K123(:)*PCONC(:,38) + PJAC(:,39,5)=-TPK%K123(:)*PCONC(:,39) ! !AROP/N2O5=0.0 ! @@ -13605,6 +13924,8 @@ SUBROUTINE SUBJ7 ! !AROP/NH3=0.0 ! +!AROP/DMS=0.0 +! !AROP/SO2=0.0 ! !AROP/SULF=0.0 @@ -13614,7 +13935,7 @@ SUBROUTINE SUBJ7 !AROP/OH=0.0 ! !AROP/HO2=-K0101*<AROP> - PJAC(:,38,15)=-TPK%K0101(:)*PCONC(:,38) + PJAC(:,39,16)=-TPK%K0101(:)*PCONC(:,39) ! !AROP/CH4=0.0 ! @@ -13649,7 +13970,7 @@ SUBROUTINE SUBJ7 !AROP/ORA2=0.0 ! !AROP/MO2=-K108*<AROP> - PJAC(:,38,32)=-TPK%K108(:)*PCONC(:,38) + PJAC(:,39,33)=-TPK%K108(:)*PCONC(:,39) ! !AROP/ALKAP=0.0 ! @@ -13660,14 +13981,14 @@ SUBROUTINE SUBJ7 !AROP/PHO=0.0 ! !AROP/ADD=+0.98*K086*<O2> - PJAC(:,38,37)=+0.98*TPK%K086(:)*TPK%O2(:) + PJAC(:,39,38)=+0.98*TPK%K086(:)*TPK%O2(:) ! !AROP/AROP=-K094*<NO>-K0101*<HO2>-K108*<MO2>-K114*<CARBOP>-K123*<NO3> - PJAC(:,38,38)=-TPK%K094(:)*PCONC(:,3)-TPK%K0101(:)*PCONC(:,15)-TPK%K108(:)*PCO& -&NC(:,32)-TPK%K114(:)*PCONC(:,39)-TPK%K123(:)*PCONC(:,5) + PJAC(:,39,39)=-TPK%K094(:)*PCONC(:,3)-TPK%K0101(:)*PCONC(:,16)-TPK%K108(:)*PCO& +&NC(:,33)-TPK%K114(:)*PCONC(:,40)-TPK%K123(:)*PCONC(:,5) ! !AROP/CARBOP=-K114*<AROP> - PJAC(:,38,39)=-TPK%K114(:)*PCONC(:,38) + PJAC(:,39,40)=-TPK%K114(:)*PCONC(:,39) ! !AROP/OLN=0.0 ! @@ -13775,21 +14096,21 @@ SUBROUTINE SUBJ7 ! !CARBOP/O3=+0.05705*K079*<ALKE>+0.17000*K080*<BIO>+0.27460*K081*<CARBO>+0.70000 !*K082*<PAN> - PJAC(:,39,1)=+0.05705*TPK%K079(:)*PCONC(:,19)+0.17000*TPK%K080(:)*PCONC(:,20)+& -&0.27460*TPK%K081(:)*PCONC(:,25)+0.70000*TPK%K082(:)*PCONC(:,27) + PJAC(:,40,1)=+0.05705*TPK%K079(:)*PCONC(:,20)+0.17000*TPK%K080(:)*PCONC(:,21)+& +&0.27460*TPK%K081(:)*PCONC(:,26)+0.70000*TPK%K082(:)*PCONC(:,28) ! !CARBOP/H2O2=0.0 ! !CARBOP/NO=+0.09532*K095*<CARBOP>-K095*<CARBOP> - PJAC(:,39,3)=+0.09532*TPK%K095(:)*PCONC(:,39)-TPK%K095(:)*PCONC(:,39) + PJAC(:,40,3)=+0.09532*TPK%K095(:)*PCONC(:,40)-TPK%K095(:)*PCONC(:,40) ! !CARBOP/NO2=-K088*<CARBOP> - PJAC(:,39,4)=-TPK%K088(:)*PCONC(:,39) + PJAC(:,40,4)=-TPK%K088(:)*PCONC(:,40) ! !CARBOP/NO3=+1.00000*K073*<ALD>+0.38881*K074*<CARBO>+0.03175*K124*<CARBOP>-K124 !*<CARBOP> - PJAC(:,39,5)=+1.00000*TPK%K073(:)*PCONC(:,23)+0.38881*TPK%K074(:)*PCONC(:,25)+& -&0.03175*TPK%K124(:)*PCONC(:,39)-TPK%K124(:)*PCONC(:,39) + PJAC(:,40,5)=+1.00000*TPK%K073(:)*PCONC(:,24)+0.38881*TPK%K074(:)*PCONC(:,26)+& +&0.03175*TPK%K124(:)*PCONC(:,40)-TPK%K124(:)*PCONC(:,40) ! !CARBOP/N2O5=0.0 ! @@ -13801,6 +14122,8 @@ SUBROUTINE SUBJ7 ! !CARBOP/NH3=0.0 ! +!CARBOP/DMS=0.0 +! !CARBOP/SO2=0.0 ! !CARBOP/SULF=0.0 @@ -13809,11 +14132,11 @@ SUBROUTINE SUBJ7 ! !CARBOP/OH=+1.00000*K063*<ALD>+1.00000*K064*<KET>+0.51419*K065*<CARBO>+0.05413* !K069*<OP2> - PJAC(:,39,14)=+1.00000*TPK%K063(:)*PCONC(:,23)+1.00000*TPK%K064(:)*PCONC(:,24)& -&+0.51419*TPK%K065(:)*PCONC(:,25)+0.05413*TPK%K069(:)*PCONC(:,29) + PJAC(:,40,15)=+1.00000*TPK%K063(:)*PCONC(:,24)+1.00000*TPK%K064(:)*PCONC(:,25)& +&+0.51419*TPK%K065(:)*PCONC(:,26)+0.05413*TPK%K069(:)*PCONC(:,30) ! !CARBOP/HO2=-K0102*<CARBOP> - PJAC(:,39,15)=-TPK%K0102(:)*PCONC(:,39) + PJAC(:,40,16)=-TPK%K0102(:)*PCONC(:,40) ! !CARBOP/CH4=0.0 ! @@ -13822,76 +14145,76 @@ SUBROUTINE SUBJ7 !CARBOP/ALKA=0.0 ! !CARBOP/ALKE=+0.05705*K079*<O3> - PJAC(:,39,19)=+0.05705*TPK%K079(:)*PCONC(:,1) + PJAC(:,40,20)=+0.05705*TPK%K079(:)*PCONC(:,1) ! !CARBOP/BIO=+0.17000*K080*<O3> - PJAC(:,39,20)=+0.17000*TPK%K080(:)*PCONC(:,1) + PJAC(:,40,21)=+0.17000*TPK%K080(:)*PCONC(:,1) ! !CARBOP/ARO=0.0 ! !CARBOP/HCHO=0.0 ! !CARBOP/ALD=+1.00000*K063*<OH>+1.00000*K073*<NO3> - PJAC(:,39,23)=+1.00000*TPK%K063(:)*PCONC(:,14)+1.00000*TPK%K073(:)*PCONC(:,5) + PJAC(:,40,24)=+1.00000*TPK%K063(:)*PCONC(:,15)+1.00000*TPK%K073(:)*PCONC(:,5) ! !CARBOP/KET=+1.00000*K015+1.00000*K064*<OH> - PJAC(:,39,24)=+1.00000*TPK%K015(:)+1.00000*TPK%K064(:)*PCONC(:,14) + PJAC(:,40,25)=+1.00000*TPK%K015(:)+1.00000*TPK%K064(:)*PCONC(:,15) ! !CARBOP/CARBO=+0.69622*K016+0.51419*K065*<OH>+0.38881*K074*<NO3>+0.27460*K081*< !O3> - PJAC(:,39,25)=+0.69622*TPK%K016(:)+0.51419*TPK%K065(:)*PCONC(:,14)+0.38881*TPK& + PJAC(:,40,26)=+0.69622*TPK%K016(:)+0.51419*TPK%K065(:)*PCONC(:,15)+0.38881*TPK& &%K074(:)*PCONC(:,5)+0.27460*TPK%K081(:)*PCONC(:,1) ! !CARBOP/ONIT=0.0 ! !CARBOP/PAN=+0.70000*K082*<O3>+1.00000*K089 - PJAC(:,39,27)=+0.70000*TPK%K082(:)*PCONC(:,1)+1.00000*TPK%K089(:) + PJAC(:,40,28)=+0.70000*TPK%K082(:)*PCONC(:,1)+1.00000*TPK%K089(:) ! !CARBOP/OP1=0.0 ! !CARBOP/OP2=+0.05413*K069*<OH> - PJAC(:,39,29)=+0.05413*TPK%K069(:)*PCONC(:,14) + PJAC(:,40,30)=+0.05413*TPK%K069(:)*PCONC(:,15) ! !CARBOP/ORA1=0.0 ! !CARBOP/ORA2=0.0 ! !CARBOP/MO2=+0.05954*K109*<CARBOP>-K109*<CARBOP> - PJAC(:,39,32)=+0.05954*TPK%K109(:)*PCONC(:,39)-TPK%K109(:)*PCONC(:,39) + PJAC(:,40,33)=+0.05954*TPK%K109(:)*PCONC(:,40)-TPK%K109(:)*PCONC(:,40) ! !CARBOP/ALKAP=-K111*<CARBOP> - PJAC(:,39,33)=-TPK%K111(:)*PCONC(:,39) + PJAC(:,40,34)=-TPK%K111(:)*PCONC(:,40) ! !CARBOP/ALKEP=-K112*<CARBOP> - PJAC(:,39,34)=-TPK%K112(:)*PCONC(:,39) + PJAC(:,40,35)=-TPK%K112(:)*PCONC(:,40) ! !CARBOP/BIOP=-K113*<CARBOP> - PJAC(:,39,35)=-TPK%K113(:)*PCONC(:,39) + PJAC(:,40,36)=-TPK%K113(:)*PCONC(:,40) ! !CARBOP/PHO=0.0 ! !CARBOP/ADD=0.0 ! !CARBOP/AROP=-K114*<CARBOP> - PJAC(:,39,38)=-TPK%K114(:)*PCONC(:,39) + PJAC(:,40,39)=-TPK%K114(:)*PCONC(:,40) ! !CARBOP/CARBOP=-K088*<NO2>+0.09532*K095*<NO>-K095*<NO>-K0102*<HO2>+0.05954*K109 !*<MO2>-K109*<MO2>-K111*<ALKAP>-K112*<ALKEP>-K113*<BIOP>-K114*<AROP>+0.05821*K1 !15*<CARBOP>+0.05821*K115*<CARBOP>-K115*<CARBOP>-K115*<CARBOP>-K115*<CARBOP>-K1 !15*<CARBOP>-K116*<OLN>+0.03175*K124*<NO3>-K124*<NO3>-K128*<XO2> - PJAC(:,39,39)=-TPK%K088(:)*PCONC(:,4)+0.09532*TPK%K095(:)*PCONC(:,3)-TPK%K095(& -&:)*PCONC(:,3)-TPK%K0102(:)*PCONC(:,15)+0.05954*TPK%K109(:)*PCONC(:,32)-TPK%K10& -&9(:)*PCONC(:,32)-TPK%K111(:)*PCONC(:,33)-TPK%K112(:)*PCONC(:,34)-TPK%K113(:)*P& -&CONC(:,35)-TPK%K114(:)*PCONC(:,38)+0.05821*TPK%K115(:)*PCONC(:,39)+0.05821*TPK& -&%K115(:)*PCONC(:,39)-TPK%K115(:)*PCONC(:,39)-TPK%K115(:)*PCONC(:,39)-TPK%K115(& -&:)*PCONC(:,39)-TPK%K115(:)*PCONC(:,39)-TPK%K116(:)*PCONC(:,40)+0.03175*TPK%K12& -&4(:)*PCONC(:,5)-TPK%K124(:)*PCONC(:,5)-TPK%K128(:)*PCONC(:,41) + PJAC(:,40,40)=-TPK%K088(:)*PCONC(:,4)+0.09532*TPK%K095(:)*PCONC(:,3)-TPK%K095(& +&:)*PCONC(:,3)-TPK%K0102(:)*PCONC(:,16)+0.05954*TPK%K109(:)*PCONC(:,33)-TPK%K10& +&9(:)*PCONC(:,33)-TPK%K111(:)*PCONC(:,34)-TPK%K112(:)*PCONC(:,35)-TPK%K113(:)*P& +&CONC(:,36)-TPK%K114(:)*PCONC(:,39)+0.05821*TPK%K115(:)*PCONC(:,40)+0.05821*TPK& +&%K115(:)*PCONC(:,40)-TPK%K115(:)*PCONC(:,40)-TPK%K115(:)*PCONC(:,40)-TPK%K115(& +&:)*PCONC(:,40)-TPK%K115(:)*PCONC(:,40)-TPK%K116(:)*PCONC(:,41)+0.03175*TPK%K12& +&4(:)*PCONC(:,5)-TPK%K124(:)*PCONC(:,5)-TPK%K128(:)*PCONC(:,42) ! !CARBOP/OLN=-K116*<CARBOP> - PJAC(:,39,40)=-TPK%K116(:)*PCONC(:,39) + PJAC(:,40,41)=-TPK%K116(:)*PCONC(:,40) ! !CARBOP/XO2=-K128*<CARBOP> - PJAC(:,39,41)=-TPK%K128(:)*PCONC(:,39) + PJAC(:,40,42)=-TPK%K128(:)*PCONC(:,40) ! !CARBOP/WC_O3=0.0 ! @@ -13993,19 +14316,27 @@ SUBROUTINE SUBJ7 ! !CARBOP/WR_AHMS=0.0 ! +RETURN +END SUBROUTINE SUBJ7 +! +SUBROUTINE SUBJ8 +! +!Indices 41 a 45 +! +! !OLN/O3=0.0 ! !OLN/H2O2=0.0 ! !OLN/NO=-K096*<OLN> - PJAC(:,40,3)=-TPK%K096(:)*PCONC(:,40) + PJAC(:,41,3)=-TPK%K096(:)*PCONC(:,41) ! !OLN/NO2=0.0 ! !OLN/NO3=+0.00000*K074*<CARBO>+0.93768*K076*<ALKE>+1.00000*K077*<BIO>-K125*<OLN !> - PJAC(:,40,5)=+0.00000*TPK%K074(:)*PCONC(:,25)+0.93768*TPK%K076(:)*PCONC(:,19)+& -&1.00000*TPK%K077(:)*PCONC(:,20)-TPK%K125(:)*PCONC(:,40) + PJAC(:,41,5)=+0.00000*TPK%K074(:)*PCONC(:,26)+0.93768*TPK%K076(:)*PCONC(:,20)+& +&1.00000*TPK%K077(:)*PCONC(:,21)-TPK%K125(:)*PCONC(:,41) ! !OLN/N2O5=0.0 ! @@ -14017,6 +14348,8 @@ SUBROUTINE SUBJ7 ! !OLN/NH3=0.0 ! +!OLN/DMS=0.0 +! !OLN/SO2=0.0 ! !OLN/SULF=0.0 @@ -14026,7 +14359,7 @@ SUBROUTINE SUBJ7 !OLN/OH=0.0 ! !OLN/HO2=-K103*<OLN> - PJAC(:,40,15)=-TPK%K103(:)*PCONC(:,40) + PJAC(:,41,16)=-TPK%K103(:)*PCONC(:,41) ! !OLN/CH4=0.0 ! @@ -14035,10 +14368,10 @@ SUBROUTINE SUBJ7 !OLN/ALKA=0.0 ! !OLN/ALKE=+0.93768*K076*<NO3> - PJAC(:,40,19)=+0.93768*TPK%K076(:)*PCONC(:,5) + PJAC(:,41,20)=+0.93768*TPK%K076(:)*PCONC(:,5) ! !OLN/BIO=+1.00000*K077*<NO3> - PJAC(:,40,20)=+1.00000*TPK%K077(:)*PCONC(:,5) + PJAC(:,41,21)=+1.00000*TPK%K077(:)*PCONC(:,5) ! !OLN/ARO=0.0 ! @@ -14049,7 +14382,7 @@ SUBROUTINE SUBJ7 !OLN/KET=0.0 ! !OLN/CARBO=+0.00000*K074*<NO3> - PJAC(:,40,25)=+0.00000*TPK%K074(:)*PCONC(:,5) + PJAC(:,41,26)=+0.00000*TPK%K074(:)*PCONC(:,5) ! !OLN/ONIT=0.0 ! @@ -14064,7 +14397,7 @@ SUBROUTINE SUBJ7 !OLN/ORA2=0.0 ! !OLN/MO2=-K110*<OLN> - PJAC(:,40,32)=-TPK%K110(:)*PCONC(:,40) + PJAC(:,41,33)=-TPK%K110(:)*PCONC(:,41) ! !OLN/ALKAP=0.0 ! @@ -14079,14 +14412,14 @@ SUBROUTINE SUBJ7 !OLN/AROP=0.0 ! !OLN/CARBOP=-K116*<OLN> - PJAC(:,40,39)=-TPK%K116(:)*PCONC(:,40) + PJAC(:,41,40)=-TPK%K116(:)*PCONC(:,41) ! !OLN/OLN=-K096*<NO>-K103*<HO2>-K110*<MO2>-K116*<CARBOP>-K117*<OLN>-K117*<OLN>-K !117*<OLN>-K117*<OLN>-K118*<OLN>-K118*<OLN>-K118*<OLN>-K118*<OLN>-K125*<NO3> - PJAC(:,40,40)=-TPK%K096(:)*PCONC(:,3)-TPK%K103(:)*PCONC(:,15)-TPK%K110(:)*PCON& -&C(:,32)-TPK%K116(:)*PCONC(:,39)-TPK%K117(:)*PCONC(:,40)-TPK%K117(:)*PCONC(:,40& -&)-TPK%K117(:)*PCONC(:,40)-TPK%K117(:)*PCONC(:,40)-TPK%K118(:)*PCONC(:,40)-TPK%& -&K118(:)*PCONC(:,40)-TPK%K118(:)*PCONC(:,40)-TPK%K118(:)*PCONC(:,40)-TPK%K125(:& + PJAC(:,41,41)=-TPK%K096(:)*PCONC(:,3)-TPK%K103(:)*PCONC(:,16)-TPK%K110(:)*PCON& +&C(:,33)-TPK%K116(:)*PCONC(:,40)-TPK%K117(:)*PCONC(:,41)-TPK%K117(:)*PCONC(:,41& +&)-TPK%K117(:)*PCONC(:,41)-TPK%K117(:)*PCONC(:,41)-TPK%K118(:)*PCONC(:,41)-TPK%& +&K118(:)*PCONC(:,41)-TPK%K118(:)*PCONC(:,41)-TPK%K118(:)*PCONC(:,41)-TPK%K125(:& &)*PCONC(:,5) ! !OLN/XO2=0.0 @@ -14191,29 +14524,21 @@ SUBROUTINE SUBJ7 ! !OLN/WR_AHMS=0.0 ! -RETURN -END SUBROUTINE SUBJ7 -! -SUBROUTINE SUBJ8 -! -!Indices 41 a 45 -! -! !XO2/O3=+0.00000*K079*<ALKE>+0.13000*K080*<BIO> - PJAC(:,41,1)=+0.00000*TPK%K079(:)*PCONC(:,19)+0.13000*TPK%K080(:)*PCONC(:,20) + PJAC(:,42,1)=+0.00000*TPK%K079(:)*PCONC(:,20)+0.13000*TPK%K080(:)*PCONC(:,21) ! !XO2/H2O2=0.0 ! !XO2/NO=+0.13007*K091*<ALKAP>+0.02563*K095*<CARBOP>-K130*<XO2> - PJAC(:,41,3)=+0.13007*TPK%K091(:)*PCONC(:,33)+0.02563*TPK%K095(:)*PCONC(:,39)-& -&TPK%K130(:)*PCONC(:,41) + PJAC(:,42,3)=+0.13007*TPK%K091(:)*PCONC(:,34)+0.02563*TPK%K095(:)*PCONC(:,40)-& +&TPK%K130(:)*PCONC(:,42) ! !XO2/NO2=0.0 ! !XO2/NO3=+0.10530*K074*<CARBO>+K078*<PAN>+0.16271*K120*<ALKAP>+0.01021*K124*<CA !RBOP>-K131*<XO2> - PJAC(:,41,5)=+0.10530*TPK%K074(:)*PCONC(:,25)+TPK%K078(:)*PCONC(:,27)+0.16271*& -&TPK%K120(:)*PCONC(:,33)+0.01021*TPK%K124(:)*PCONC(:,39)-TPK%K131(:)*PCONC(:,41& + PJAC(:,42,5)=+0.10530*TPK%K074(:)*PCONC(:,26)+TPK%K078(:)*PCONC(:,28)+0.16271*& +&TPK%K120(:)*PCONC(:,34)+0.01021*TPK%K124(:)*PCONC(:,40)-TPK%K131(:)*PCONC(:,42& &) ! !XO2/N2O5=0.0 @@ -14226,6 +14551,8 @@ SUBROUTINE SUBJ8 ! !XO2/NH3=0.0 ! +!XO2/DMS=0.0 +! !XO2/SO2=0.0 ! !XO2/SULF=0.0 @@ -14233,11 +14560,11 @@ SUBROUTINE SUBJ8 !XO2/CO=0.0 ! !XO2/OH=+0.10318*K061*<ARO>+0.10162*K065*<CARBO>+0.09333*K069*<OP2>+K070*<PAN> - PJAC(:,41,14)=+0.10318*TPK%K061(:)*PCONC(:,21)+0.10162*TPK%K065(:)*PCONC(:,25)& -&+0.09333*TPK%K069(:)*PCONC(:,29)+TPK%K070(:)*PCONC(:,27) + PJAC(:,42,15)=+0.10318*TPK%K061(:)*PCONC(:,22)+0.10162*TPK%K065(:)*PCONC(:,26)& +&+0.09333*TPK%K069(:)*PCONC(:,30)+TPK%K070(:)*PCONC(:,28) ! !XO2/HO2=-K126*<XO2> - PJAC(:,41,15)=-TPK%K126(:)*PCONC(:,41) + PJAC(:,42,16)=-TPK%K126(:)*PCONC(:,42) ! !XO2/CH4=0.0 ! @@ -14246,13 +14573,13 @@ SUBROUTINE SUBJ8 !XO2/ALKA=0.0 ! !XO2/ALKE=+0.00000*K079*<O3> - PJAC(:,41,19)=+0.00000*TPK%K079(:)*PCONC(:,1) + PJAC(:,42,20)=+0.00000*TPK%K079(:)*PCONC(:,1) ! !XO2/BIO=+0.15*K054*<O3P>+0.13000*K080*<O3> - PJAC(:,41,20)=+0.15*TPK%K054(:)*TPK%O3P(:)+0.13000*TPK%K080(:)*PCONC(:,1) + PJAC(:,42,21)=+0.15*TPK%K054(:)*TPK%O3P(:)+0.13000*TPK%K080(:)*PCONC(:,1) ! !XO2/ARO=+0.10318*K061*<OH> - PJAC(:,41,21)=+0.10318*TPK%K061(:)*PCONC(:,14) + PJAC(:,42,22)=+0.10318*TPK%K061(:)*PCONC(:,15) ! !XO2/HCHO=0.0 ! @@ -14261,30 +14588,30 @@ SUBROUTINE SUBJ8 !XO2/KET=0.0 ! !XO2/CARBO=+0.10162*K065*<OH>+0.10530*K074*<NO3> - PJAC(:,41,25)=+0.10162*TPK%K065(:)*PCONC(:,14)+0.10530*TPK%K074(:)*PCONC(:,5) + PJAC(:,42,26)=+0.10162*TPK%K065(:)*PCONC(:,15)+0.10530*TPK%K074(:)*PCONC(:,5) ! !XO2/ONIT=0.0 ! !XO2/PAN=+K070*<OH>+K078*<NO3> - PJAC(:,41,27)=+TPK%K070(:)*PCONC(:,14)+TPK%K078(:)*PCONC(:,5) + PJAC(:,42,28)=+TPK%K070(:)*PCONC(:,15)+TPK%K078(:)*PCONC(:,5) ! !XO2/OP1=0.0 ! !XO2/OP2=+0.09333*K069*<OH> - PJAC(:,41,29)=+0.09333*TPK%K069(:)*PCONC(:,14) + PJAC(:,42,30)=+0.09333*TPK%K069(:)*PCONC(:,15) ! !XO2/ORA1=0.0 ! !XO2/ORA2=0.0 ! !XO2/MO2=+0.13370*K105*<ALKAP>+0.02212*K109*<CARBOP>-K127*<XO2> - PJAC(:,41,32)=+0.13370*TPK%K105(:)*PCONC(:,33)+0.02212*TPK%K109(:)*PCONC(:,39)& -&-TPK%K127(:)*PCONC(:,41) + PJAC(:,42,33)=+0.13370*TPK%K105(:)*PCONC(:,34)+0.02212*TPK%K109(:)*PCONC(:,40)& +&-TPK%K127(:)*PCONC(:,42) ! !XO2/ALKAP=+0.13007*K091*<NO>+0.13370*K105*<MO2>+0.11306*K111*<CARBOP>+0.16271* !K120*<NO3> - PJAC(:,41,33)=+0.13007*TPK%K091(:)*PCONC(:,3)+0.13370*TPK%K105(:)*PCONC(:,32)+& -&0.11306*TPK%K111(:)*PCONC(:,39)+0.16271*TPK%K120(:)*PCONC(:,5) + PJAC(:,42,34)=+0.13007*TPK%K091(:)*PCONC(:,3)+0.13370*TPK%K105(:)*PCONC(:,33)+& +&0.11306*TPK%K111(:)*PCONC(:,40)+0.16271*TPK%K120(:)*PCONC(:,5) ! !XO2/ALKEP=0.0 ! @@ -14298,17 +14625,17 @@ SUBROUTINE SUBJ8 ! !XO2/CARBOP=+0.02563*K095*<NO>+0.02212*K109*<MO2>+0.11306*K111*<ALKAP>+0.01593* !K115*<CARBOP>+0.01593*K115*<CARBOP>+0.01021*K124*<NO3>-K128*<XO2> - PJAC(:,41,39)=+0.02563*TPK%K095(:)*PCONC(:,3)+0.02212*TPK%K109(:)*PCONC(:,32)+& -&0.11306*TPK%K111(:)*PCONC(:,33)+0.01593*TPK%K115(:)*PCONC(:,39)+0.01593*TPK%K1& -&15(:)*PCONC(:,39)+0.01021*TPK%K124(:)*PCONC(:,5)-TPK%K128(:)*PCONC(:,41) + PJAC(:,42,40)=+0.02563*TPK%K095(:)*PCONC(:,3)+0.02212*TPK%K109(:)*PCONC(:,33)+& +&0.11306*TPK%K111(:)*PCONC(:,34)+0.01593*TPK%K115(:)*PCONC(:,40)+0.01593*TPK%K1& +&15(:)*PCONC(:,40)+0.01021*TPK%K124(:)*PCONC(:,5)-TPK%K128(:)*PCONC(:,42) ! !XO2/OLN=0.0 ! !XO2/XO2=-K126*<HO2>-K127*<MO2>-K128*<CARBOP>-K129*<XO2>-K129*<XO2>-K129*<XO2>- !K129*<XO2>-K130*<NO>-K131*<NO3> - PJAC(:,41,41)=-TPK%K126(:)*PCONC(:,15)-TPK%K127(:)*PCONC(:,32)-TPK%K128(:)*PCO& -&NC(:,39)-TPK%K129(:)*PCONC(:,41)-TPK%K129(:)*PCONC(:,41)-TPK%K129(:)*PCONC(:,4& -&1)-TPK%K129(:)*PCONC(:,41)-TPK%K130(:)*PCONC(:,3)-TPK%K131(:)*PCONC(:,5) + PJAC(:,42,42)=-TPK%K126(:)*PCONC(:,16)-TPK%K127(:)*PCONC(:,33)-TPK%K128(:)*PCO& +&NC(:,40)-TPK%K129(:)*PCONC(:,42)-TPK%K129(:)*PCONC(:,42)-TPK%K129(:)*PCONC(:,4& +&2)-TPK%K129(:)*PCONC(:,42)-TPK%K130(:)*PCONC(:,3)-TPK%K131(:)*PCONC(:,5) ! !XO2/WC_O3=0.0 ! @@ -14411,7 +14738,7 @@ SUBROUTINE SUBJ8 !XO2/WR_AHMS=0.0 ! !WC_O3/O3=+KTC1 - PJAC(:,42,1)=+TPK%KTC1(:) + PJAC(:,43,1)=+TPK%KTC1(:) ! !WC_O3/H2O2=0.0 ! @@ -14431,6 +14758,8 @@ SUBROUTINE SUBJ8 ! !WC_O3/NH3=0.0 ! +!WC_O3/DMS=0.0 +! !WC_O3/SO2=0.0 ! !WC_O3/SULF=0.0 @@ -14494,7 +14823,7 @@ SUBROUTINE SUBJ8 !WC_O3/XO2=0.0 ! !WC_O3/WC_O3=-KTC21-KC6*<WC_HO2>-KC29*<WC_SO2> - PJAC(:,42,42)=-TPK%KTC21(:)-TPK%KC6(:)*PCONC(:,53)-TPK%KC29(:)*PCONC(:,55) + PJAC(:,43,43)=-TPK%KTC21(:)-TPK%KC6(:)*PCONC(:,54)-TPK%KC29(:)*PCONC(:,56) ! !WC_O3/WC_H2O2=0.0 ! @@ -14517,12 +14846,12 @@ SUBROUTINE SUBJ8 !WC_O3/WC_OH=0.0 ! !WC_O3/WC_HO2=-KC6*<WC_O3> - PJAC(:,42,53)=-TPK%KC6(:)*PCONC(:,42) + PJAC(:,43,54)=-TPK%KC6(:)*PCONC(:,43) ! !WC_O3/WC_CO2=0.0 ! !WC_O3/WC_SO2=-KC29*<WC_O3> - PJAC(:,42,55)=-TPK%KC29(:)*PCONC(:,42) + PJAC(:,43,56)=-TPK%KC29(:)*PCONC(:,43) ! !WC_O3/WC_SULF=0.0 ! @@ -14599,7 +14928,7 @@ SUBROUTINE SUBJ8 !WC_H2O2/O3=0.0 ! !WC_H2O2/H2O2=+KTC2 - PJAC(:,43,2)=+TPK%KTC2(:) + PJAC(:,44,2)=+TPK%KTC2(:) ! !WC_H2O2/NO=0.0 ! @@ -14617,6 +14946,8 @@ SUBROUTINE SUBJ8 ! !WC_H2O2/NH3=0.0 ! +!WC_H2O2/DMS=0.0 +! !WC_H2O2/SO2=0.0 ! !WC_H2O2/SULF=0.0 @@ -14682,8 +15013,8 @@ SUBROUTINE SUBJ8 !WC_H2O2/WC_O3=0.0 ! !WC_H2O2/WC_H2O2=-KTC22-KC1-KC4*<WC_OH>-KC30*<WC_SO2> - PJAC(:,43,43)=-TPK%KTC22(:)-TPK%KC1(:)-TPK%KC4(:)*PCONC(:,52)-TPK%KC30(:)*PCON& -&C(:,55) + PJAC(:,44,44)=-TPK%KTC22(:)-TPK%KC1(:)-TPK%KC4(:)*PCONC(:,53)-TPK%KC30(:)*PCON& +&C(:,56) ! !WC_H2O2/WC_NO=0.0 ! @@ -14702,16 +15033,16 @@ SUBROUTINE SUBJ8 !WC_H2O2/WC_NH3=0.0 ! !WC_H2O2/WC_OH=+KC2*<WC_OH>+KC2*<WC_OH>-KC4*<WC_H2O2> - PJAC(:,43,52)=+TPK%KC2(:)*PCONC(:,52)+TPK%KC2(:)*PCONC(:,52)-TPK%KC4(:)*PCONC(& -&:,43) + PJAC(:,44,53)=+TPK%KC2(:)*PCONC(:,53)+TPK%KC2(:)*PCONC(:,53)-TPK%KC4(:)*PCONC(& +&:,44) ! !WC_H2O2/WC_HO2=+KC5*<WC_HO2>+KC5*<WC_HO2> - PJAC(:,43,53)=+TPK%KC5(:)*PCONC(:,53)+TPK%KC5(:)*PCONC(:,53) + PJAC(:,44,54)=+TPK%KC5(:)*PCONC(:,54)+TPK%KC5(:)*PCONC(:,54) ! !WC_H2O2/WC_CO2=0.0 ! !WC_H2O2/WC_SO2=-KC30*<WC_H2O2> - PJAC(:,43,55)=-TPK%KC30(:)*PCONC(:,43) + PJAC(:,44,56)=-TPK%KC30(:)*PCONC(:,44) ! !WC_H2O2/WC_SULF=0.0 ! @@ -14790,7 +15121,7 @@ SUBROUTINE SUBJ8 !WC_NO/H2O2=0.0 ! !WC_NO/NO=+KTC3 - PJAC(:,44,3)=+TPK%KTC3(:) + PJAC(:,45,3)=+TPK%KTC3(:) ! !WC_NO/NO2=0.0 ! @@ -14806,6 +15137,8 @@ SUBROUTINE SUBJ8 ! !WC_NO/NH3=0.0 ! +!WC_NO/DMS=0.0 +! !WC_NO/SO2=0.0 ! !WC_NO/SULF=0.0 @@ -14873,7 +15206,7 @@ SUBROUTINE SUBJ8 !WC_NO/WC_H2O2=0.0 ! !WC_NO/WC_NO=-KTC23 - PJAC(:,44,44)=-TPK%KTC23(:) + PJAC(:,45,45)=-TPK%KTC23(:) ! !WC_NO/WC_NO2=0.0 ! @@ -14969,6 +15302,14 @@ SUBROUTINE SUBJ8 ! !WC_NO/WR_AHMS=0.0 ! +RETURN +END SUBROUTINE SUBJ8 +! +SUBROUTINE SUBJ9 +! +!Indices 46 a 50 +! +! !WC_NO2/O3=0.0 ! !WC_NO2/H2O2=0.0 @@ -14976,7 +15317,7 @@ SUBROUTINE SUBJ8 !WC_NO2/NO=0.0 ! !WC_NO2/NO2=+KTC4 - PJAC(:,45,4)=+TPK%KTC4(:) + PJAC(:,46,4)=+TPK%KTC4(:) ! !WC_NO2/NO3=0.0 ! @@ -14990,6 +15331,8 @@ SUBROUTINE SUBJ8 ! !WC_NO2/NH3=0.0 ! +!WC_NO2/DMS=0.0 +! !WC_NO2/SO2=0.0 ! !WC_NO2/SULF=0.0 @@ -15059,28 +15402,28 @@ SUBROUTINE SUBJ8 !WC_NO2/WC_NO=0.0 ! !WC_NO2/WC_NO2=-KTC24-KC9*<WC_HO2> - PJAC(:,45,45)=-TPK%KTC24(:)-TPK%KC9(:)*PCONC(:,53) + PJAC(:,46,46)=-TPK%KTC24(:)-TPK%KC9(:)*PCONC(:,54) ! !WC_NO2/WC_NO3=0.0 ! !WC_NO2/WC_N2O5=0.0 ! !WC_NO2/WC_HONO=+KC8*<WC_OH> - PJAC(:,45,48)=+TPK%KC8(:)*PCONC(:,52) + PJAC(:,46,49)=+TPK%KC8(:)*PCONC(:,53) ! !WC_NO2/WC_HNO3=+KC13 - PJAC(:,45,49)=+TPK%KC13(:) + PJAC(:,46,50)=+TPK%KC13(:) ! !WC_NO2/WC_HNO4=+KC10 - PJAC(:,45,50)=+TPK%KC10(:) + PJAC(:,46,51)=+TPK%KC10(:) ! !WC_NO2/WC_NH3=0.0 ! !WC_NO2/WC_OH=+KC8*<WC_HONO> - PJAC(:,45,52)=+TPK%KC8(:)*PCONC(:,48) + PJAC(:,46,53)=+TPK%KC8(:)*PCONC(:,49) ! !WC_NO2/WC_HO2=-KC9*<WC_NO2> - PJAC(:,45,53)=-TPK%KC9(:)*PCONC(:,45) + PJAC(:,46,54)=-TPK%KC9(:)*PCONC(:,46) ! !WC_NO2/WC_CO2=0.0 ! @@ -15158,14 +15501,6 @@ SUBROUTINE SUBJ8 ! !WC_NO2/WR_AHMS=0.0 ! -RETURN -END SUBROUTINE SUBJ8 -! -SUBROUTINE SUBJ9 -! -!Indices 46 a 50 -! -! !WC_NO3/O3=0.0 ! !WC_NO3/H2O2=0.0 @@ -15175,7 +15510,7 @@ SUBROUTINE SUBJ9 !WC_NO3/NO2=0.0 ! !WC_NO3/NO3=+KTC5 - PJAC(:,46,5)=+TPK%KTC5(:) + PJAC(:,47,5)=+TPK%KTC5(:) ! !WC_NO3/N2O5=0.0 ! @@ -15187,6 +15522,8 @@ SUBROUTINE SUBJ9 ! !WC_NO3/NH3=0.0 ! +!WC_NO3/DMS=0.0 +! !WC_NO3/SO2=0.0 ! !WC_NO3/SULF=0.0 @@ -15258,7 +15595,7 @@ SUBROUTINE SUBJ9 !WC_NO3/WC_NO2=0.0 ! !WC_NO3/WC_NO3=-KTC25-KC15*<WC_SULF>-KC16*<WC_SO2> - PJAC(:,46,46)=-TPK%KTC25(:)-TPK%KC15(:)*PCONC(:,56)-TPK%KC16(:)*PCONC(:,55) + PJAC(:,47,47)=-TPK%KTC25(:)-TPK%KC15(:)*PCONC(:,57)-TPK%KC16(:)*PCONC(:,56) ! !WC_NO3/WC_N2O5=0.0 ! @@ -15277,10 +15614,10 @@ SUBROUTINE SUBJ9 !WC_NO3/WC_CO2=0.0 ! !WC_NO3/WC_SO2=-KC16*<WC_NO3> - PJAC(:,46,55)=-TPK%KC16(:)*PCONC(:,46) + PJAC(:,47,56)=-TPK%KC16(:)*PCONC(:,47) ! !WC_NO3/WC_SULF=-KC15*<WC_NO3> - PJAC(:,46,56)=-TPK%KC15(:)*PCONC(:,46) + PJAC(:,47,57)=-TPK%KC15(:)*PCONC(:,47) ! !WC_NO3/WC_HCHO=0.0 ! @@ -15363,7 +15700,7 @@ SUBROUTINE SUBJ9 !WC_N2O5/NO3=0.0 ! !WC_N2O5/N2O5=+KTC6 - PJAC(:,47,6)=+TPK%KTC6(:) + PJAC(:,48,6)=+TPK%KTC6(:) ! !WC_N2O5/HONO=0.0 ! @@ -15373,6 +15710,8 @@ SUBROUTINE SUBJ9 ! !WC_N2O5/NH3=0.0 ! +!WC_N2O5/DMS=0.0 +! !WC_N2O5/SO2=0.0 ! !WC_N2O5/SULF=0.0 @@ -15446,7 +15785,7 @@ SUBROUTINE SUBJ9 !WC_N2O5/WC_NO3=0.0 ! !WC_N2O5/WC_N2O5=-KTC26-KC14 - PJAC(:,47,47)=-TPK%KTC26(:)-TPK%KC14(:) + PJAC(:,48,48)=-TPK%KTC26(:)-TPK%KC14(:) ! !WC_N2O5/WC_HONO=0.0 ! @@ -15549,7 +15888,7 @@ SUBROUTINE SUBJ9 !WC_HONO/N2O5=0.0 ! !WC_HONO/HONO=+KTC7 - PJAC(:,48,7)=+TPK%KTC7(:) + PJAC(:,49,7)=+TPK%KTC7(:) ! !WC_HONO/HNO3=0.0 ! @@ -15557,6 +15896,8 @@ SUBROUTINE SUBJ9 ! !WC_HONO/NH3=0.0 ! +!WC_HONO/DMS=0.0 +! !WC_HONO/SO2=0.0 ! !WC_HONO/SULF=0.0 @@ -15632,17 +15973,17 @@ SUBROUTINE SUBJ9 !WC_HONO/WC_N2O5=0.0 ! !WC_HONO/WC_HONO=-KTC27-KC8*<WC_OH> - PJAC(:,48,48)=-TPK%KTC27(:)-TPK%KC8(:)*PCONC(:,52) + PJAC(:,49,49)=-TPK%KTC27(:)-TPK%KC8(:)*PCONC(:,53) ! !WC_HONO/WC_HNO3=0.0 ! !WC_HONO/WC_HNO4=+KC11 - PJAC(:,48,50)=+TPK%KC11(:) + PJAC(:,49,51)=+TPK%KC11(:) ! !WC_HONO/WC_NH3=0.0 ! !WC_HONO/WC_OH=-KC8*<WC_HONO> - PJAC(:,48,52)=-TPK%KC8(:)*PCONC(:,48) + PJAC(:,49,53)=-TPK%KC8(:)*PCONC(:,49) ! !WC_HONO/WC_HO2=0.0 ! @@ -15737,12 +16078,14 @@ SUBROUTINE SUBJ9 !WC_HNO3/HONO=0.0 ! !WC_HNO3/HNO3=+KTC8 - PJAC(:,49,8)=+TPK%KTC8(:) + PJAC(:,50,8)=+TPK%KTC8(:) ! !WC_HNO3/HNO4=0.0 ! !WC_HNO3/NH3=0.0 ! +!WC_HNO3/DMS=0.0 +! !WC_HNO3/SO2=0.0 ! !WC_HNO3/SULF=0.0 @@ -15814,18 +16157,18 @@ SUBROUTINE SUBJ9 !WC_HNO3/WC_NO2=0.0 ! !WC_HNO3/WC_NO3=+KC15*<WC_SULF>+KC16*<WC_SO2> - PJAC(:,49,46)=+TPK%KC15(:)*PCONC(:,56)+TPK%KC16(:)*PCONC(:,55) + PJAC(:,50,47)=+TPK%KC15(:)*PCONC(:,57)+TPK%KC16(:)*PCONC(:,56) ! !WC_HNO3/WC_N2O5=+KC14+KC14 - PJAC(:,49,47)=+TPK%KC14(:)+TPK%KC14(:) + PJAC(:,50,48)=+TPK%KC14(:)+TPK%KC14(:) ! !WC_HNO3/WC_HONO=0.0 ! !WC_HNO3/WC_HNO3=-KTC28-KC13 - PJAC(:,49,49)=-TPK%KTC28(:)-TPK%KC13(:) + PJAC(:,50,50)=-TPK%KTC28(:)-TPK%KC13(:) ! !WC_HNO3/WC_HNO4=+KC12*<WC_SO2> - PJAC(:,49,50)=+TPK%KC12(:)*PCONC(:,55) + PJAC(:,50,51)=+TPK%KC12(:)*PCONC(:,56) ! !WC_HNO3/WC_NH3=0.0 ! @@ -15836,10 +16179,10 @@ SUBROUTINE SUBJ9 !WC_HNO3/WC_CO2=0.0 ! !WC_HNO3/WC_SO2=+KC12*<WC_HNO4>+KC16*<WC_NO3> - PJAC(:,49,55)=+TPK%KC12(:)*PCONC(:,50)+TPK%KC16(:)*PCONC(:,46) + PJAC(:,50,56)=+TPK%KC12(:)*PCONC(:,51)+TPK%KC16(:)*PCONC(:,47) ! !WC_HNO3/WC_SULF=+KC15*<WC_NO3> - PJAC(:,49,56)=+TPK%KC15(:)*PCONC(:,46) + PJAC(:,50,57)=+TPK%KC15(:)*PCONC(:,47) ! !WC_HNO3/WC_HCHO=0.0 ! @@ -15911,6 +16254,14 @@ SUBROUTINE SUBJ9 ! !WC_HNO3/WR_AHMS=0.0 ! +RETURN +END SUBROUTINE SUBJ9 +! +SUBROUTINE SUBJ10 +! +!Indices 51 a 55 +! +! !WC_HNO4/O3=0.0 ! !WC_HNO4/H2O2=0.0 @@ -15928,10 +16279,12 @@ SUBROUTINE SUBJ9 !WC_HNO4/HNO3=0.0 ! !WC_HNO4/HNO4=+KTC9 - PJAC(:,50,9)=+TPK%KTC9(:) + PJAC(:,51,9)=+TPK%KTC9(:) ! !WC_HNO4/NH3=0.0 ! +!WC_HNO4/DMS=0.0 +! !WC_HNO4/SO2=0.0 ! !WC_HNO4/SULF=0.0 @@ -16001,7 +16354,7 @@ SUBROUTINE SUBJ9 !WC_HNO4/WC_NO=0.0 ! !WC_HNO4/WC_NO2=+KC9*<WC_HO2> - PJAC(:,50,45)=+TPK%KC9(:)*PCONC(:,53) + PJAC(:,51,46)=+TPK%KC9(:)*PCONC(:,54) ! !WC_HNO4/WC_NO3=0.0 ! @@ -16012,19 +16365,19 @@ SUBROUTINE SUBJ9 !WC_HNO4/WC_HNO3=0.0 ! !WC_HNO4/WC_HNO4=-KTC29-KC10-KC11-KC12*<WC_SO2> - PJAC(:,50,50)=-TPK%KTC29(:)-TPK%KC10(:)-TPK%KC11(:)-TPK%KC12(:)*PCONC(:,55) + PJAC(:,51,51)=-TPK%KTC29(:)-TPK%KC10(:)-TPK%KC11(:)-TPK%KC12(:)*PCONC(:,56) ! !WC_HNO4/WC_NH3=0.0 ! !WC_HNO4/WC_OH=0.0 ! !WC_HNO4/WC_HO2=+KC9*<WC_NO2> - PJAC(:,50,53)=+TPK%KC9(:)*PCONC(:,45) + PJAC(:,51,54)=+TPK%KC9(:)*PCONC(:,46) ! !WC_HNO4/WC_CO2=0.0 ! !WC_HNO4/WC_SO2=-KC12*<WC_HNO4> - PJAC(:,50,55)=-TPK%KC12(:)*PCONC(:,50) + PJAC(:,51,56)=-TPK%KC12(:)*PCONC(:,51) ! !WC_HNO4/WC_SULF=0.0 ! @@ -16098,14 +16451,6 @@ SUBROUTINE SUBJ9 ! !WC_HNO4/WR_AHMS=0.0 ! -RETURN -END SUBROUTINE SUBJ9 -! -SUBROUTINE SUBJ10 -! -!Indices 51 a 55 -! -! !WC_NH3/O3=0.0 ! !WC_NH3/H2O2=0.0 @@ -16125,7 +16470,9 @@ SUBROUTINE SUBJ10 !WC_NH3/HNO4=0.0 ! !WC_NH3/NH3=+KTC10 - PJAC(:,51,10)=+TPK%KTC10(:) + PJAC(:,52,10)=+TPK%KTC10(:) +! +!WC_NH3/DMS=0.0 ! !WC_NH3/SO2=0.0 ! @@ -16208,7 +16555,7 @@ SUBROUTINE SUBJ10 !WC_NH3/WC_HNO4=0.0 ! !WC_NH3/WC_NH3=-KTC30 - PJAC(:,51,51)=-TPK%KTC30(:) + PJAC(:,52,52)=-TPK%KTC30(:) ! !WC_NH3/WC_OH=0.0 ! @@ -16310,6 +16657,8 @@ SUBROUTINE SUBJ10 ! !WC_OH/NH3=0.0 ! +!WC_OH/DMS=0.0 +! !WC_OH/SO2=0.0 ! !WC_OH/SULF=0.0 @@ -16317,7 +16666,7 @@ SUBROUTINE SUBJ10 !WC_OH/CO=0.0 ! !WC_OH/OH=+KTC11 - PJAC(:,52,14)=+TPK%KTC11(:) + PJAC(:,53,15)=+TPK%KTC11(:) ! !WC_OH/HO2=0.0 ! @@ -16374,10 +16723,10 @@ SUBROUTINE SUBJ10 !WC_OH/XO2=0.0 ! !WC_OH/WC_O3=+KC6*<WC_HO2> - PJAC(:,52,42)=+TPK%KC6(:)*PCONC(:,53) + PJAC(:,53,43)=+TPK%KC6(:)*PCONC(:,54) ! !WC_OH/WC_H2O2=+KC1+KC1-KC4*<WC_OH> - PJAC(:,52,43)=+TPK%KC1(:)+TPK%KC1(:)-TPK%KC4(:)*PCONC(:,52) + PJAC(:,53,44)=+TPK%KC1(:)+TPK%KC1(:)-TPK%KC4(:)*PCONC(:,53) ! !WC_OH/WC_NO=0.0 ! @@ -16388,10 +16737,10 @@ SUBROUTINE SUBJ10 !WC_OH/WC_N2O5=0.0 ! !WC_OH/WC_HONO=-KC8*<WC_OH> - PJAC(:,52,48)=-TPK%KC8(:)*PCONC(:,52) + PJAC(:,53,49)=-TPK%KC8(:)*PCONC(:,53) ! !WC_OH/WC_HNO3=+KC13 - PJAC(:,52,49)=+TPK%KC13(:) + PJAC(:,53,50)=+TPK%KC13(:) ! !WC_OH/WC_HNO4=0.0 ! @@ -16400,26 +16749,26 @@ SUBROUTINE SUBJ10 !WC_OH/WC_OH=-KTC31-KC2*<WC_OH>-KC2*<WC_OH>-KC2*<WC_OH>-KC2*<WC_OH>-KC3*<WC_HO2 !>-KC4*<WC_H2O2>-KC7*<WC_SO2>-KC8*<WC_HONO>-KC19*<WC_HCHO>-KC20*<WC_ORA1>-KC23* !<WC_AHMS> - PJAC(:,52,52)=-TPK%KTC31(:)-TPK%KC2(:)*PCONC(:,52)-TPK%KC2(:)*PCONC(:,52)-TPK%& -&KC2(:)*PCONC(:,52)-TPK%KC2(:)*PCONC(:,52)-TPK%KC3(:)*PCONC(:,53)-TPK%KC4(:)*PC& -&ONC(:,43)-TPK%KC7(:)*PCONC(:,55)-TPK%KC8(:)*PCONC(:,48)-TPK%KC19(:)*PCONC(:,57& -&)-TPK%KC20(:)*PCONC(:,58)-TPK%KC23(:)*PCONC(:,66) + PJAC(:,53,53)=-TPK%KTC31(:)-TPK%KC2(:)*PCONC(:,53)-TPK%KC2(:)*PCONC(:,53)-TPK%& +&KC2(:)*PCONC(:,53)-TPK%KC2(:)*PCONC(:,53)-TPK%KC3(:)*PCONC(:,54)-TPK%KC4(:)*PC& +&ONC(:,44)-TPK%KC7(:)*PCONC(:,56)-TPK%KC8(:)*PCONC(:,49)-TPK%KC19(:)*PCONC(:,58& +&)-TPK%KC20(:)*PCONC(:,59)-TPK%KC23(:)*PCONC(:,67) ! !WC_OH/WC_HO2=-KC3*<WC_OH>+KC6*<WC_O3> - PJAC(:,52,53)=-TPK%KC3(:)*PCONC(:,52)+TPK%KC6(:)*PCONC(:,42) + PJAC(:,53,54)=-TPK%KC3(:)*PCONC(:,53)+TPK%KC6(:)*PCONC(:,43) ! !WC_OH/WC_CO2=0.0 ! !WC_OH/WC_SO2=-KC7*<WC_OH> - PJAC(:,52,55)=-TPK%KC7(:)*PCONC(:,52) + PJAC(:,53,56)=-TPK%KC7(:)*PCONC(:,53) ! !WC_OH/WC_SULF=0.0 ! !WC_OH/WC_HCHO=-KC19*<WC_OH> - PJAC(:,52,57)=-TPK%KC19(:)*PCONC(:,52) + PJAC(:,53,58)=-TPK%KC19(:)*PCONC(:,53) ! !WC_OH/WC_ORA1=-KC20*<WC_OH> - PJAC(:,52,58)=-TPK%KC20(:)*PCONC(:,52) + PJAC(:,53,59)=-TPK%KC20(:)*PCONC(:,53) ! !WC_OH/WC_ORA2=0.0 ! @@ -16430,14 +16779,14 @@ SUBROUTINE SUBJ10 !WC_OH/WC_ASO3=0.0 ! !WC_OH/WC_ASO4=+KC28 - PJAC(:,52,63)=+TPK%KC28(:) + PJAC(:,53,64)=+TPK%KC28(:) ! !WC_OH/WC_ASO5=0.0 ! !WC_OH/WC_AHSO5=0.0 ! !WC_OH/WC_AHMS=-KC23*<WC_OH> - PJAC(:,52,66)=-TPK%KC23(:)*PCONC(:,52) + PJAC(:,53,67)=-TPK%KC23(:)*PCONC(:,53) ! !WC_OH/WR_O3=0.0 ! @@ -16509,6 +16858,8 @@ SUBROUTINE SUBJ10 ! !WC_HO2/NH3=0.0 ! +!WC_HO2/DMS=0.0 +! !WC_HO2/SO2=0.0 ! !WC_HO2/SULF=0.0 @@ -16518,7 +16869,7 @@ SUBROUTINE SUBJ10 !WC_HO2/OH=0.0 ! !WC_HO2/HO2=+KTC12 - PJAC(:,53,15)=+TPK%KTC12(:) + PJAC(:,54,16)=+TPK%KTC12(:) ! !WC_HO2/CH4=0.0 ! @@ -16573,15 +16924,15 @@ SUBROUTINE SUBJ10 !WC_HO2/XO2=0.0 ! !WC_HO2/WC_O3=-KC6*<WC_HO2> - PJAC(:,53,42)=-TPK%KC6(:)*PCONC(:,53) + PJAC(:,54,43)=-TPK%KC6(:)*PCONC(:,54) ! !WC_HO2/WC_H2O2=+KC4*<WC_OH> - PJAC(:,53,43)=+TPK%KC4(:)*PCONC(:,52) + PJAC(:,54,44)=+TPK%KC4(:)*PCONC(:,53) ! !WC_HO2/WC_NO=0.0 ! !WC_HO2/WC_NO2=-KC9*<WC_HO2> - PJAC(:,53,45)=-TPK%KC9(:)*PCONC(:,53) + PJAC(:,54,46)=-TPK%KC9(:)*PCONC(:,54) ! !WC_HO2/WC_NO3=0.0 ! @@ -16592,20 +16943,20 @@ SUBROUTINE SUBJ10 !WC_HO2/WC_HNO3=0.0 ! !WC_HO2/WC_HNO4=+KC10 - PJAC(:,53,50)=+TPK%KC10(:) + PJAC(:,54,51)=+TPK%KC10(:) ! !WC_HO2/WC_NH3=0.0 ! !WC_HO2/WC_OH=-KC3*<WC_HO2>+KC4*<WC_H2O2>+KC19*<WC_HCHO>+KC20*<WC_ORA1>+KC23*<W !C_AHMS> - PJAC(:,53,52)=-TPK%KC3(:)*PCONC(:,53)+TPK%KC4(:)*PCONC(:,43)+TPK%KC19(:)*PCONC& -&(:,57)+TPK%KC20(:)*PCONC(:,58)+TPK%KC23(:)*PCONC(:,66) + PJAC(:,54,53)=-TPK%KC3(:)*PCONC(:,54)+TPK%KC4(:)*PCONC(:,44)+TPK%KC19(:)*PCONC& +&(:,58)+TPK%KC20(:)*PCONC(:,59)+TPK%KC23(:)*PCONC(:,67) ! !WC_HO2/WC_HO2=-KTC32-KC3*<WC_OH>-KC5*<WC_HO2>-KC5*<WC_HO2>-KC5*<WC_HO2>-KC5*<W !C_HO2>-KC6*<WC_O3>-KC9*<WC_NO2>-KC25*<WC_ASO5> - PJAC(:,53,53)=-TPK%KTC32(:)-TPK%KC3(:)*PCONC(:,52)-TPK%KC5(:)*PCONC(:,53)-TPK%& -&KC5(:)*PCONC(:,53)-TPK%KC5(:)*PCONC(:,53)-TPK%KC5(:)*PCONC(:,53)-TPK%KC6(:)*PC& -&ONC(:,42)-TPK%KC9(:)*PCONC(:,45)-TPK%KC25(:)*PCONC(:,64) + PJAC(:,54,54)=-TPK%KTC32(:)-TPK%KC3(:)*PCONC(:,53)-TPK%KC5(:)*PCONC(:,54)-TPK%& +&KC5(:)*PCONC(:,54)-TPK%KC5(:)*PCONC(:,54)-TPK%KC5(:)*PCONC(:,54)-TPK%KC6(:)*PC& +&ONC(:,43)-TPK%KC9(:)*PCONC(:,46)-TPK%KC25(:)*PCONC(:,65) ! !WC_HO2/WC_CO2=0.0 ! @@ -16614,15 +16965,15 @@ SUBROUTINE SUBJ10 !WC_HO2/WC_SULF=0.0 ! !WC_HO2/WC_HCHO=+KC19*<WC_OH> - PJAC(:,53,57)=+TPK%KC19(:)*PCONC(:,52) + PJAC(:,54,58)=+TPK%KC19(:)*PCONC(:,53) ! !WC_HO2/WC_ORA1=+KC20*<WC_OH> - PJAC(:,53,58)=+TPK%KC20(:)*PCONC(:,52) + PJAC(:,54,59)=+TPK%KC20(:)*PCONC(:,53) ! !WC_HO2/WC_ORA2=0.0 ! !WC_HO2/WC_MO2=+2.00*KC17*<WC_MO2>+2.00*KC17*<WC_MO2> - PJAC(:,53,60)=+2.00*TPK%KC17(:)*PCONC(:,60)+2.00*TPK%KC17(:)*PCONC(:,60) + PJAC(:,54,61)=+2.00*TPK%KC17(:)*PCONC(:,61)+2.00*TPK%KC17(:)*PCONC(:,61) ! !WC_HO2/WC_OP1=0.0 ! @@ -16631,12 +16982,12 @@ SUBROUTINE SUBJ10 !WC_HO2/WC_ASO4=0.0 ! !WC_HO2/WC_ASO5=-KC25*<WC_HO2> - PJAC(:,53,64)=-TPK%KC25(:)*PCONC(:,53) + PJAC(:,54,65)=-TPK%KC25(:)*PCONC(:,54) ! !WC_HO2/WC_AHSO5=0.0 ! !WC_HO2/WC_AHMS=+KC23*<WC_OH> - PJAC(:,53,66)=+TPK%KC23(:)*PCONC(:,52) + PJAC(:,54,67)=+TPK%KC23(:)*PCONC(:,53) ! !WC_HO2/WR_O3=0.0 ! @@ -16708,6 +17059,8 @@ SUBROUTINE SUBJ10 ! !WC_CO2/NH3=0.0 ! +!WC_CO2/DMS=0.0 +! !WC_CO2/SO2=0.0 ! !WC_CO2/SULF=0.0 @@ -16791,12 +17144,12 @@ SUBROUTINE SUBJ10 !WC_CO2/WC_NH3=0.0 ! !WC_CO2/WC_OH=+KC20*<WC_ORA1> - PJAC(:,54,52)=+TPK%KC20(:)*PCONC(:,58) + PJAC(:,55,53)=+TPK%KC20(:)*PCONC(:,59) ! !WC_CO2/WC_HO2=0.0 ! !WC_CO2/WC_CO2=-KTC33 - PJAC(:,54,54)=-TPK%KTC33(:) + PJAC(:,55,55)=-TPK%KTC33(:) ! !WC_CO2/WC_SO2=0.0 ! @@ -16805,7 +17158,7 @@ SUBROUTINE SUBJ10 !WC_CO2/WC_HCHO=0.0 ! !WC_CO2/WC_ORA1=+KC20*<WC_OH> - PJAC(:,54,58)=+TPK%KC20(:)*PCONC(:,52) + PJAC(:,55,59)=+TPK%KC20(:)*PCONC(:,53) ! !WC_CO2/WC_ORA2=0.0 ! @@ -16873,6 +17226,14 @@ SUBROUTINE SUBJ10 ! !WC_CO2/WR_AHMS=0.0 ! +RETURN +END SUBROUTINE SUBJ10 +! +SUBROUTINE SUBJ11 +! +!Indices 56 a 60 +! +! !WC_SO2/O3=0.0 ! !WC_SO2/H2O2=0.0 @@ -16893,8 +17254,10 @@ SUBROUTINE SUBJ10 ! !WC_SO2/NH3=0.0 ! +!WC_SO2/DMS=0.0 +! !WC_SO2/SO2=+KTC14 - PJAC(:,55,11)=+TPK%KTC14(:) + PJAC(:,56,12)=+TPK%KTC14(:) ! !WC_SO2/SULF=0.0 ! @@ -16957,17 +17320,17 @@ SUBROUTINE SUBJ10 !WC_SO2/XO2=0.0 ! !WC_SO2/WC_O3=-KC29*<WC_SO2> - PJAC(:,55,42)=-TPK%KC29(:)*PCONC(:,55) + PJAC(:,56,43)=-TPK%KC29(:)*PCONC(:,56) ! !WC_SO2/WC_H2O2=-KC30*<WC_SO2> - PJAC(:,55,43)=-TPK%KC30(:)*PCONC(:,55) + PJAC(:,56,44)=-TPK%KC30(:)*PCONC(:,56) ! !WC_SO2/WC_NO=0.0 ! !WC_SO2/WC_NO2=0.0 ! !WC_SO2/WC_NO3=-KC16*<WC_SO2> - PJAC(:,55,46)=-TPK%KC16(:)*PCONC(:,55) + PJAC(:,56,47)=-TPK%KC16(:)*PCONC(:,56) ! !WC_SO2/WC_N2O5=0.0 ! @@ -16976,12 +17339,12 @@ SUBROUTINE SUBJ10 !WC_SO2/WC_HNO3=0.0 ! !WC_SO2/WC_HNO4=-KC12*<WC_SO2> - PJAC(:,55,50)=-TPK%KC12(:)*PCONC(:,55) + PJAC(:,56,51)=-TPK%KC12(:)*PCONC(:,56) ! !WC_SO2/WC_NH3=0.0 ! !WC_SO2/WC_OH=-KC7*<WC_SO2>+KC23*<WC_AHMS> - PJAC(:,55,52)=-TPK%KC7(:)*PCONC(:,55)+TPK%KC23(:)*PCONC(:,66) + PJAC(:,56,53)=-TPK%KC7(:)*PCONC(:,56)+TPK%KC23(:)*PCONC(:,67) ! !WC_SO2/WC_HO2=0.0 ! @@ -16989,21 +17352,21 @@ SUBROUTINE SUBJ10 ! !WC_SO2/WC_SO2=-KTC34-KC7*<WC_OH>-KC12*<WC_HNO4>-KC16*<WC_NO3>-KC18*<WC_MO2>-KC !21*<WC_HCHO>-KC27*<WC_AHSO5>-KC29*<WC_O3>-KC30*<WC_H2O2> - PJAC(:,55,55)=-TPK%KTC34(:)-TPK%KC7(:)*PCONC(:,52)-TPK%KC12(:)*PCONC(:,50)-TPK& -&%KC16(:)*PCONC(:,46)-TPK%KC18(:)*PCONC(:,60)-TPK%KC21(:)*PCONC(:,57)-TPK%KC27(& -&:)*PCONC(:,65)-TPK%KC29(:)*PCONC(:,42)-TPK%KC30(:)*PCONC(:,43) + PJAC(:,56,56)=-TPK%KTC34(:)-TPK%KC7(:)*PCONC(:,53)-TPK%KC12(:)*PCONC(:,51)-TPK& +&%KC16(:)*PCONC(:,47)-TPK%KC18(:)*PCONC(:,61)-TPK%KC21(:)*PCONC(:,58)-TPK%KC27(& +&:)*PCONC(:,66)-TPK%KC29(:)*PCONC(:,43)-TPK%KC30(:)*PCONC(:,44) ! !WC_SO2/WC_SULF=0.0 ! !WC_SO2/WC_HCHO=-KC21*<WC_SO2> - PJAC(:,55,57)=-TPK%KC21(:)*PCONC(:,55) + PJAC(:,56,58)=-TPK%KC21(:)*PCONC(:,56) ! !WC_SO2/WC_ORA1=0.0 ! !WC_SO2/WC_ORA2=0.0 ! !WC_SO2/WC_MO2=-KC18*<WC_SO2> - PJAC(:,55,60)=-TPK%KC18(:)*PCONC(:,55) + PJAC(:,56,61)=-TPK%KC18(:)*PCONC(:,56) ! !WC_SO2/WC_OP1=0.0 ! @@ -17014,10 +17377,10 @@ SUBROUTINE SUBJ10 !WC_SO2/WC_ASO5=0.0 ! !WC_SO2/WC_AHSO5=-KC27*<WC_SO2> - PJAC(:,55,65)=-TPK%KC27(:)*PCONC(:,55) + PJAC(:,56,66)=-TPK%KC27(:)*PCONC(:,56) ! !WC_SO2/WC_AHMS=+KC22+KC23*<WC_OH> - PJAC(:,55,66)=+TPK%KC22(:)+TPK%KC23(:)*PCONC(:,52) + PJAC(:,56,67)=+TPK%KC22(:)+TPK%KC23(:)*PCONC(:,53) ! !WC_SO2/WR_O3=0.0 ! @@ -17069,14 +17432,6 @@ SUBROUTINE SUBJ10 ! !WC_SO2/WR_AHMS=0.0 ! -RETURN -END SUBROUTINE SUBJ10 -! -SUBROUTINE SUBJ11 -! -!Indices 56 a 60 -! -! !WC_SULF/O3=0.0 ! !WC_SULF/H2O2=0.0 @@ -17097,10 +17452,12 @@ SUBROUTINE SUBJ11 ! !WC_SULF/NH3=0.0 ! +!WC_SULF/DMS=0.0 +! !WC_SULF/SO2=0.0 ! !WC_SULF/SULF=+KTC15 - PJAC(:,56,12)=+TPK%KTC15(:) + PJAC(:,57,13)=+TPK%KTC15(:) ! !WC_SULF/CO=0.0 ! @@ -17161,17 +17518,17 @@ SUBROUTINE SUBJ11 !WC_SULF/XO2=0.0 ! !WC_SULF/WC_O3=+KC29*<WC_SO2> - PJAC(:,56,42)=+TPK%KC29(:)*PCONC(:,55) + PJAC(:,57,43)=+TPK%KC29(:)*PCONC(:,56) ! !WC_SULF/WC_H2O2=+KC30*<WC_SO2> - PJAC(:,56,43)=+TPK%KC30(:)*PCONC(:,55) + PJAC(:,57,44)=+TPK%KC30(:)*PCONC(:,56) ! !WC_SULF/WC_NO=0.0 ! !WC_SULF/WC_NO2=0.0 ! !WC_SULF/WC_NO3=-KC15*<WC_SULF> - PJAC(:,56,46)=-TPK%KC15(:)*PCONC(:,56) + PJAC(:,57,47)=-TPK%KC15(:)*PCONC(:,57) ! !WC_SULF/WC_N2O5=0.0 ! @@ -17180,7 +17537,7 @@ SUBROUTINE SUBJ11 !WC_SULF/WC_HNO3=0.0 ! !WC_SULF/WC_HNO4=+KC12*<WC_SO2> - PJAC(:,56,50)=+TPK%KC12(:)*PCONC(:,55) + PJAC(:,57,51)=+TPK%KC12(:)*PCONC(:,56) ! !WC_SULF/WC_NH3=0.0 ! @@ -17192,11 +17549,11 @@ SUBROUTINE SUBJ11 ! !WC_SULF/WC_SO2=+KC12*<WC_HNO4>+2.00*KC27*<WC_AHSO5>+KC29*<WC_O3>+KC30*<WC_H2O2 !> - PJAC(:,56,55)=+TPK%KC12(:)*PCONC(:,50)+2.00*TPK%KC27(:)*PCONC(:,65)+TPK%KC29(:& -&)*PCONC(:,42)+TPK%KC30(:)*PCONC(:,43) + PJAC(:,57,56)=+TPK%KC12(:)*PCONC(:,51)+2.00*TPK%KC27(:)*PCONC(:,66)+TPK%KC29(:& +&)*PCONC(:,43)+TPK%KC30(:)*PCONC(:,44) ! !WC_SULF/WC_SULF=-KTC35-KC15*<WC_NO3> - PJAC(:,56,56)=-TPK%KTC35(:)-TPK%KC15(:)*PCONC(:,46) + PJAC(:,57,57)=-TPK%KTC35(:)-TPK%KC15(:)*PCONC(:,47) ! !WC_SULF/WC_HCHO=0.0 ! @@ -17211,12 +17568,12 @@ SUBROUTINE SUBJ11 !WC_SULF/WC_ASO3=0.0 ! !WC_SULF/WC_ASO4=+KC28 - PJAC(:,56,63)=+TPK%KC28(:) + PJAC(:,57,64)=+TPK%KC28(:) ! !WC_SULF/WC_ASO5=0.0 ! !WC_SULF/WC_AHSO5=+2.00*KC27*<WC_SO2> - PJAC(:,56,65)=+2.00*TPK%KC27(:)*PCONC(:,55) + PJAC(:,57,66)=+2.00*TPK%KC27(:)*PCONC(:,56) ! !WC_SULF/WC_AHMS=0.0 ! @@ -17290,6 +17647,8 @@ SUBROUTINE SUBJ11 ! !WC_HCHO/NH3=0.0 ! +!WC_HCHO/DMS=0.0 +! !WC_HCHO/SO2=0.0 ! !WC_HCHO/SULF=0.0 @@ -17313,7 +17672,7 @@ SUBROUTINE SUBJ11 !WC_HCHO/ARO=0.0 ! !WC_HCHO/HCHO=+KTC16 - PJAC(:,57,22)=+TPK%KTC16(:) + PJAC(:,58,23)=+TPK%KTC16(:) ! !WC_HCHO/ALD=0.0 ! @@ -17374,26 +17733,26 @@ SUBROUTINE SUBJ11 !WC_HCHO/WC_NH3=0.0 ! !WC_HCHO/WC_OH=-KC19*<WC_HCHO> - PJAC(:,57,52)=-TPK%KC19(:)*PCONC(:,57) + PJAC(:,58,53)=-TPK%KC19(:)*PCONC(:,58) ! !WC_HCHO/WC_HO2=0.0 ! !WC_HCHO/WC_CO2=0.0 ! !WC_HCHO/WC_SO2=-KC21*<WC_HCHO> - PJAC(:,57,55)=-TPK%KC21(:)*PCONC(:,57) + PJAC(:,58,56)=-TPK%KC21(:)*PCONC(:,58) ! !WC_HCHO/WC_SULF=0.0 ! !WC_HCHO/WC_HCHO=-KTC36-KC19*<WC_OH>-KC21*<WC_SO2> - PJAC(:,57,57)=-TPK%KTC36(:)-TPK%KC19(:)*PCONC(:,52)-TPK%KC21(:)*PCONC(:,55) + PJAC(:,58,58)=-TPK%KTC36(:)-TPK%KC19(:)*PCONC(:,53)-TPK%KC21(:)*PCONC(:,56) ! !WC_HCHO/WC_ORA1=0.0 ! !WC_HCHO/WC_ORA2=0.0 ! !WC_HCHO/WC_MO2=+2.00*KC17*<WC_MO2>+2.00*KC17*<WC_MO2> - PJAC(:,57,60)=+2.00*TPK%KC17(:)*PCONC(:,60)+2.00*TPK%KC17(:)*PCONC(:,60) + PJAC(:,58,61)=+2.00*TPK%KC17(:)*PCONC(:,61)+2.00*TPK%KC17(:)*PCONC(:,61) ! !WC_HCHO/WC_OP1=0.0 ! @@ -17406,7 +17765,7 @@ SUBROUTINE SUBJ11 !WC_HCHO/WC_AHSO5=0.0 ! !WC_HCHO/WC_AHMS=+KC22 - PJAC(:,57,66)=+TPK%KC22(:) + PJAC(:,58,67)=+TPK%KC22(:) ! !WC_HCHO/WR_O3=0.0 ! @@ -17478,6 +17837,8 @@ SUBROUTINE SUBJ11 ! !WC_ORA1/NH3=0.0 ! +!WC_ORA1/DMS=0.0 +! !WC_ORA1/SO2=0.0 ! !WC_ORA1/SULF=0.0 @@ -17517,7 +17878,7 @@ SUBROUTINE SUBJ11 !WC_ORA1/OP2=0.0 ! !WC_ORA1/ORA1=+KTC17 - PJAC(:,58,30)=+TPK%KTC17(:) + PJAC(:,59,31)=+TPK%KTC17(:) ! !WC_ORA1/ORA2=0.0 ! @@ -17562,8 +17923,8 @@ SUBROUTINE SUBJ11 !WC_ORA1/WC_NH3=0.0 ! !WC_ORA1/WC_OH=+KC19*<WC_HCHO>-KC20*<WC_ORA1>+KC23*<WC_AHMS> - PJAC(:,58,52)=+TPK%KC19(:)*PCONC(:,57)-TPK%KC20(:)*PCONC(:,58)+TPK%KC23(:)*PCO& -&NC(:,66) + PJAC(:,59,53)=+TPK%KC19(:)*PCONC(:,58)-TPK%KC20(:)*PCONC(:,59)+TPK%KC23(:)*PCO& +&NC(:,67) ! !WC_ORA1/WC_HO2=0.0 ! @@ -17574,10 +17935,10 @@ SUBROUTINE SUBJ11 !WC_ORA1/WC_SULF=0.0 ! !WC_ORA1/WC_HCHO=+KC19*<WC_OH> - PJAC(:,58,57)=+TPK%KC19(:)*PCONC(:,52) + PJAC(:,59,58)=+TPK%KC19(:)*PCONC(:,53) ! !WC_ORA1/WC_ORA1=-KTC37-KC20*<WC_OH> - PJAC(:,58,58)=-TPK%KTC37(:)-TPK%KC20(:)*PCONC(:,52) + PJAC(:,59,59)=-TPK%KTC37(:)-TPK%KC20(:)*PCONC(:,53) ! !WC_ORA1/WC_ORA2=0.0 ! @@ -17594,7 +17955,7 @@ SUBROUTINE SUBJ11 !WC_ORA1/WC_AHSO5=0.0 ! !WC_ORA1/WC_AHMS=+KC23*<WC_OH> - PJAC(:,58,66)=+TPK%KC23(:)*PCONC(:,52) + PJAC(:,59,67)=+TPK%KC23(:)*PCONC(:,53) ! !WC_ORA1/WR_O3=0.0 ! @@ -17666,6 +18027,8 @@ SUBROUTINE SUBJ11 ! !WC_ORA2/NH3=0.0 ! +!WC_ORA2/DMS=0.0 +! !WC_ORA2/SO2=0.0 ! !WC_ORA2/SULF=0.0 @@ -17707,7 +18070,7 @@ SUBROUTINE SUBJ11 !WC_ORA2/ORA1=0.0 ! !WC_ORA2/ORA2=+KTC18 - PJAC(:,59,31)=+TPK%KTC18(:) + PJAC(:,60,32)=+TPK%KTC18(:) ! !WC_ORA2/MO2=0.0 ! @@ -17764,7 +18127,7 @@ SUBROUTINE SUBJ11 !WC_ORA2/WC_ORA1=0.0 ! !WC_ORA2/WC_ORA2=-KTC38 - PJAC(:,59,59)=-TPK%KTC38(:) + PJAC(:,60,60)=-TPK%KTC38(:) ! !WC_ORA2/WC_MO2=0.0 ! @@ -17830,6 +18193,14 @@ SUBROUTINE SUBJ11 ! !WC_ORA2/WR_AHMS=0.0 ! +RETURN +END SUBROUTINE SUBJ11 +! +SUBROUTINE SUBJ12 +! +!Indices 61 a 65 +! +! !WC_MO2/O3=0.0 ! !WC_MO2/H2O2=0.0 @@ -17850,6 +18221,8 @@ SUBROUTINE SUBJ11 ! !WC_MO2/NH3=0.0 ! +!WC_MO2/DMS=0.0 +! !WC_MO2/SO2=0.0 ! !WC_MO2/SULF=0.0 @@ -17893,7 +18266,7 @@ SUBROUTINE SUBJ11 !WC_MO2/ORA2=0.0 ! !WC_MO2/MO2=+KTC19 - PJAC(:,60,32)=+TPK%KTC19(:) + PJAC(:,61,33)=+TPK%KTC19(:) ! !WC_MO2/ALKAP=0.0 ! @@ -17940,7 +18313,7 @@ SUBROUTINE SUBJ11 !WC_MO2/WC_CO2=0.0 ! !WC_MO2/WC_SO2=-KC18*<WC_MO2> - PJAC(:,60,55)=-TPK%KC18(:)*PCONC(:,60) + PJAC(:,61,56)=-TPK%KC18(:)*PCONC(:,61) ! !WC_MO2/WC_SULF=0.0 ! @@ -17952,8 +18325,8 @@ SUBROUTINE SUBJ11 ! !WC_MO2/WC_MO2=-KTC39-KC17*<WC_MO2>-KC17*<WC_MO2>-KC17*<WC_MO2>-KC17*<WC_MO2>-K !C18*<WC_SO2> - PJAC(:,60,60)=-TPK%KTC39(:)-TPK%KC17(:)*PCONC(:,60)-TPK%KC17(:)*PCONC(:,60)-TP& -&K%KC17(:)*PCONC(:,60)-TPK%KC17(:)*PCONC(:,60)-TPK%KC18(:)*PCONC(:,55) + PJAC(:,61,61)=-TPK%KTC39(:)-TPK%KC17(:)*PCONC(:,61)-TPK%KC17(:)*PCONC(:,61)-TP& +&K%KC17(:)*PCONC(:,61)-TPK%KC17(:)*PCONC(:,61)-TPK%KC18(:)*PCONC(:,56) ! !WC_MO2/WC_OP1=0.0 ! @@ -18017,14 +18390,6 @@ SUBROUTINE SUBJ11 ! !WC_MO2/WR_AHMS=0.0 ! -RETURN -END SUBROUTINE SUBJ11 -! -SUBROUTINE SUBJ12 -! -!Indices 61 a 65 -! -! !WC_OP1/O3=0.0 ! !WC_OP1/H2O2=0.0 @@ -18045,6 +18410,8 @@ SUBROUTINE SUBJ12 ! !WC_OP1/NH3=0.0 ! +!WC_OP1/DMS=0.0 +! !WC_OP1/SO2=0.0 ! !WC_OP1/SULF=0.0 @@ -18080,7 +18447,7 @@ SUBROUTINE SUBJ12 !WC_OP1/PAN=0.0 ! !WC_OP1/OP1=+KTC20 - PJAC(:,61,28)=+TPK%KTC20(:) + PJAC(:,62,29)=+TPK%KTC20(:) ! !WC_OP1/OP2=0.0 ! @@ -18135,7 +18502,7 @@ SUBROUTINE SUBJ12 !WC_OP1/WC_CO2=0.0 ! !WC_OP1/WC_SO2=+KC18*<WC_MO2> - PJAC(:,61,55)=+TPK%KC18(:)*PCONC(:,60) + PJAC(:,62,56)=+TPK%KC18(:)*PCONC(:,61) ! !WC_OP1/WC_SULF=0.0 ! @@ -18146,10 +18513,10 @@ SUBROUTINE SUBJ12 !WC_OP1/WC_ORA2=0.0 ! !WC_OP1/WC_MO2=+KC18*<WC_SO2> - PJAC(:,61,60)=+TPK%KC18(:)*PCONC(:,55) + PJAC(:,62,61)=+TPK%KC18(:)*PCONC(:,56) ! !WC_OP1/WC_OP1=-KTC40 - PJAC(:,61,61)=-TPK%KTC40(:) + PJAC(:,62,62)=-TPK%KTC40(:) ! !WC_OP1/WC_ASO3=0.0 ! @@ -18231,6 +18598,8 @@ SUBROUTINE SUBJ12 ! !WC_ASO3/NH3=0.0 ! +!WC_ASO3/DMS=0.0 +! !WC_ASO3/SO2=0.0 ! !WC_ASO3/SULF=0.0 @@ -18302,7 +18671,7 @@ SUBROUTINE SUBJ12 !WC_ASO3/WC_NO2=0.0 ! !WC_ASO3/WC_NO3=+KC16*<WC_SO2> - PJAC(:,62,46)=+TPK%KC16(:)*PCONC(:,55) + PJAC(:,63,47)=+TPK%KC16(:)*PCONC(:,56) ! !WC_ASO3/WC_N2O5=0.0 ! @@ -18315,15 +18684,15 @@ SUBROUTINE SUBJ12 !WC_ASO3/WC_NH3=0.0 ! !WC_ASO3/WC_OH=+KC7*<WC_SO2> - PJAC(:,62,52)=+TPK%KC7(:)*PCONC(:,55) + PJAC(:,63,53)=+TPK%KC7(:)*PCONC(:,56) ! !WC_ASO3/WC_HO2=0.0 ! !WC_ASO3/WC_CO2=0.0 ! !WC_ASO3/WC_SO2=+KC7*<WC_OH>+KC16*<WC_NO3>+KC18*<WC_MO2> - PJAC(:,62,55)=+TPK%KC7(:)*PCONC(:,52)+TPK%KC16(:)*PCONC(:,46)+TPK%KC18(:)*PCON& -&C(:,60) + PJAC(:,63,56)=+TPK%KC7(:)*PCONC(:,53)+TPK%KC16(:)*PCONC(:,47)+TPK%KC18(:)*PCON& +&C(:,61) ! !WC_ASO3/WC_SULF=0.0 ! @@ -18334,12 +18703,12 @@ SUBROUTINE SUBJ12 !WC_ASO3/WC_ORA2=0.0 ! !WC_ASO3/WC_MO2=+KC18*<WC_SO2> - PJAC(:,62,60)=+TPK%KC18(:)*PCONC(:,55) + PJAC(:,63,61)=+TPK%KC18(:)*PCONC(:,56) ! !WC_ASO3/WC_OP1=0.0 ! !WC_ASO3/WC_ASO3=-KC24*<W_O2> - PJAC(:,62,62)=-TPK%KC24(:)*TPK%W_O2(:) + PJAC(:,63,63)=-TPK%KC24(:)*TPK%W_O2(:) ! !WC_ASO3/WC_ASO4=0.0 ! @@ -18419,6 +18788,8 @@ SUBROUTINE SUBJ12 ! !WC_ASO4/NH3=0.0 ! +!WC_ASO4/DMS=0.0 +! !WC_ASO4/SO2=0.0 ! !WC_ASO4/SULF=0.0 @@ -18490,7 +18861,7 @@ SUBROUTINE SUBJ12 !WC_ASO4/WC_NO2=0.0 ! !WC_ASO4/WC_NO3=+KC15*<WC_SULF> - PJAC(:,63,46)=+TPK%KC15(:)*PCONC(:,56) + PJAC(:,64,47)=+TPK%KC15(:)*PCONC(:,57) ! !WC_ASO4/WC_N2O5=0.0 ! @@ -18511,7 +18882,7 @@ SUBROUTINE SUBJ12 !WC_ASO4/WC_SO2=0.0 ! !WC_ASO4/WC_SULF=+KC15*<WC_NO3> - PJAC(:,63,56)=+TPK%KC15(:)*PCONC(:,46) + PJAC(:,64,57)=+TPK%KC15(:)*PCONC(:,47) ! !WC_ASO4/WC_HCHO=0.0 ! @@ -18526,11 +18897,11 @@ SUBROUTINE SUBJ12 !WC_ASO4/WC_ASO3=0.0 ! !WC_ASO4/WC_ASO4=-KC28 - PJAC(:,63,63)=-TPK%KC28(:) + PJAC(:,64,64)=-TPK%KC28(:) ! !WC_ASO4/WC_ASO5=+KC26*<WC_ASO5>+KC26*<WC_ASO5>+KC26*<WC_ASO5>+KC26*<WC_ASO5> - PJAC(:,63,64)=+TPK%KC26(:)*PCONC(:,64)+TPK%KC26(:)*PCONC(:,64)+TPK%KC26(:)*PCO& -&NC(:,64)+TPK%KC26(:)*PCONC(:,64) + PJAC(:,64,65)=+TPK%KC26(:)*PCONC(:,65)+TPK%KC26(:)*PCONC(:,65)+TPK%KC26(:)*PCO& +&NC(:,65)+TPK%KC26(:)*PCONC(:,65) ! !WC_ASO4/WC_AHSO5=0.0 ! @@ -18606,6 +18977,8 @@ SUBROUTINE SUBJ12 ! !WC_ASO5/NH3=0.0 ! +!WC_ASO5/DMS=0.0 +! !WC_ASO5/SO2=0.0 ! !WC_ASO5/SULF=0.0 @@ -18691,7 +19064,7 @@ SUBROUTINE SUBJ12 !WC_ASO5/WC_OH=0.0 ! !WC_ASO5/WC_HO2=-KC25*<WC_ASO5> - PJAC(:,64,53)=-TPK%KC25(:)*PCONC(:,64) + PJAC(:,65,54)=-TPK%KC25(:)*PCONC(:,65) ! !WC_ASO5/WC_CO2=0.0 ! @@ -18710,14 +19083,14 @@ SUBROUTINE SUBJ12 !WC_ASO5/WC_OP1=0.0 ! !WC_ASO5/WC_ASO3=+KC24*<W_O2> - PJAC(:,64,62)=+TPK%KC24(:)*TPK%W_O2(:) + PJAC(:,65,63)=+TPK%KC24(:)*TPK%W_O2(:) ! !WC_ASO5/WC_ASO4=0.0 ! !WC_ASO5/WC_ASO5=-KC25*<WC_HO2>-KC26*<WC_ASO5>-KC26*<WC_ASO5>-KC26*<WC_ASO5>-KC !26*<WC_ASO5> - PJAC(:,64,64)=-TPK%KC25(:)*PCONC(:,53)-TPK%KC26(:)*PCONC(:,64)-TPK%KC26(:)*PCO& -&NC(:,64)-TPK%KC26(:)*PCONC(:,64)-TPK%KC26(:)*PCONC(:,64) + PJAC(:,65,65)=-TPK%KC25(:)*PCONC(:,54)-TPK%KC26(:)*PCONC(:,65)-TPK%KC26(:)*PCO& +&NC(:,65)-TPK%KC26(:)*PCONC(:,65)-TPK%KC26(:)*PCONC(:,65) ! !WC_ASO5/WC_AHSO5=0.0 ! @@ -18773,6 +19146,14 @@ SUBROUTINE SUBJ12 ! !WC_ASO5/WR_AHMS=0.0 ! +RETURN +END SUBROUTINE SUBJ12 +! +SUBROUTINE SUBJ13 +! +!Indices 66 a 70 +! +! !WC_AHSO5/O3=0.0 ! !WC_AHSO5/H2O2=0.0 @@ -18793,6 +19174,8 @@ SUBROUTINE SUBJ12 ! !WC_AHSO5/NH3=0.0 ! +!WC_AHSO5/DMS=0.0 +! !WC_AHSO5/SO2=0.0 ! !WC_AHSO5/SULF=0.0 @@ -18878,12 +19261,12 @@ SUBROUTINE SUBJ12 !WC_AHSO5/WC_OH=0.0 ! !WC_AHSO5/WC_HO2=+KC25*<WC_ASO5> - PJAC(:,65,53)=+TPK%KC25(:)*PCONC(:,64) + PJAC(:,66,54)=+TPK%KC25(:)*PCONC(:,65) ! !WC_AHSO5/WC_CO2=0.0 ! !WC_AHSO5/WC_SO2=-KC27*<WC_AHSO5> - PJAC(:,65,55)=-TPK%KC27(:)*PCONC(:,65) + PJAC(:,66,56)=-TPK%KC27(:)*PCONC(:,66) ! !WC_AHSO5/WC_SULF=0.0 ! @@ -18902,10 +19285,10 @@ SUBROUTINE SUBJ12 !WC_AHSO5/WC_ASO4=0.0 ! !WC_AHSO5/WC_ASO5=+KC25*<WC_HO2> - PJAC(:,65,64)=+TPK%KC25(:)*PCONC(:,53) + PJAC(:,66,65)=+TPK%KC25(:)*PCONC(:,54) ! !WC_AHSO5/WC_AHSO5=-KC27*<WC_SO2> - PJAC(:,65,65)=-TPK%KC27(:)*PCONC(:,55) + PJAC(:,66,66)=-TPK%KC27(:)*PCONC(:,56) ! !WC_AHSO5/WC_AHMS=0.0 ! @@ -18959,14 +19342,6 @@ SUBROUTINE SUBJ12 ! !WC_AHSO5/WR_AHMS=0.0 ! -RETURN -END SUBROUTINE SUBJ12 -! -SUBROUTINE SUBJ13 -! -!Indices 66 a 70 -! -! !WC_AHMS/O3=0.0 ! !WC_AHMS/H2O2=0.0 @@ -18987,6 +19362,8 @@ SUBROUTINE SUBJ13 ! !WC_AHMS/NH3=0.0 ! +!WC_AHMS/DMS=0.0 +! !WC_AHMS/SO2=0.0 ! !WC_AHMS/SULF=0.0 @@ -19070,19 +19447,19 @@ SUBROUTINE SUBJ13 !WC_AHMS/WC_NH3=0.0 ! !WC_AHMS/WC_OH=-KC23*<WC_AHMS> - PJAC(:,66,52)=-TPK%KC23(:)*PCONC(:,66) + PJAC(:,67,53)=-TPK%KC23(:)*PCONC(:,67) ! !WC_AHMS/WC_HO2=0.0 ! !WC_AHMS/WC_CO2=0.0 ! !WC_AHMS/WC_SO2=+KC21*<WC_HCHO> - PJAC(:,66,55)=+TPK%KC21(:)*PCONC(:,57) + PJAC(:,67,56)=+TPK%KC21(:)*PCONC(:,58) ! !WC_AHMS/WC_SULF=0.0 ! !WC_AHMS/WC_HCHO=+KC21*<WC_SO2> - PJAC(:,66,57)=+TPK%KC21(:)*PCONC(:,55) + PJAC(:,67,58)=+TPK%KC21(:)*PCONC(:,56) ! !WC_AHMS/WC_ORA1=0.0 ! @@ -19101,7 +19478,7 @@ SUBROUTINE SUBJ13 !WC_AHMS/WC_AHSO5=0.0 ! !WC_AHMS/WC_AHMS=-KC22-KC23*<WC_OH> - PJAC(:,66,66)=-TPK%KC22(:)-TPK%KC23(:)*PCONC(:,52) + PJAC(:,67,67)=-TPK%KC22(:)-TPK%KC23(:)*PCONC(:,53) ! !WC_AHMS/WR_O3=0.0 ! @@ -19154,7 +19531,7 @@ SUBROUTINE SUBJ13 !WC_AHMS/WR_AHMS=0.0 ! !WR_O3/O3=+KTR1 - PJAC(:,67,1)=+TPK%KTR1(:) + PJAC(:,68,1)=+TPK%KTR1(:) ! !WR_O3/H2O2=0.0 ! @@ -19174,6 +19551,8 @@ SUBROUTINE SUBJ13 ! !WR_O3/NH3=0.0 ! +!WR_O3/DMS=0.0 +! !WR_O3/SO2=0.0 ! !WR_O3/SULF=0.0 @@ -19287,7 +19666,7 @@ SUBROUTINE SUBJ13 !WR_O3/WC_AHMS=0.0 ! !WR_O3/WR_O3=-KTR21-KR6*<WR_HO2>-KR29*<WR_SO2> - PJAC(:,67,67)=-TPK%KTR21(:)-TPK%KR6(:)*PCONC(:,78)-TPK%KR29(:)*PCONC(:,80) + PJAC(:,68,68)=-TPK%KTR21(:)-TPK%KR6(:)*PCONC(:,79)-TPK%KR29(:)*PCONC(:,81) ! !WR_O3/WR_H2O2=0.0 ! @@ -19310,12 +19689,12 @@ SUBROUTINE SUBJ13 !WR_O3/WR_OH=0.0 ! !WR_O3/WR_HO2=-KR6*<WR_O3> - PJAC(:,67,78)=-TPK%KR6(:)*PCONC(:,67) + PJAC(:,68,79)=-TPK%KR6(:)*PCONC(:,68) ! !WR_O3/WR_CO2=0.0 ! !WR_O3/WR_SO2=-KR29*<WR_O3> - PJAC(:,67,80)=-TPK%KR29(:)*PCONC(:,67) + PJAC(:,68,81)=-TPK%KR29(:)*PCONC(:,68) ! !WR_O3/WR_SULF=0.0 ! @@ -19342,7 +19721,7 @@ SUBROUTINE SUBJ13 !WR_H2O2/O3=0.0 ! !WR_H2O2/H2O2=+KTR2 - PJAC(:,68,2)=+TPK%KTR2(:) + PJAC(:,69,2)=+TPK%KTR2(:) ! !WR_H2O2/NO=0.0 ! @@ -19360,6 +19739,8 @@ SUBROUTINE SUBJ13 ! !WR_H2O2/NH3=0.0 ! +!WR_H2O2/DMS=0.0 +! !WR_H2O2/SO2=0.0 ! !WR_H2O2/SULF=0.0 @@ -19475,8 +19856,8 @@ SUBROUTINE SUBJ13 !WR_H2O2/WR_O3=0.0 ! !WR_H2O2/WR_H2O2=-KTR22-KR1-KR4*<WR_OH>-KR30*<WR_SO2> - PJAC(:,68,68)=-TPK%KTR22(:)-TPK%KR1(:)-TPK%KR4(:)*PCONC(:,77)-TPK%KR30(:)*PCON& -&C(:,80) + PJAC(:,69,69)=-TPK%KTR22(:)-TPK%KR1(:)-TPK%KR4(:)*PCONC(:,78)-TPK%KR30(:)*PCON& +&C(:,81) ! !WR_H2O2/WR_NO=0.0 ! @@ -19495,16 +19876,16 @@ SUBROUTINE SUBJ13 !WR_H2O2/WR_NH3=0.0 ! !WR_H2O2/WR_OH=+KR2*<WR_OH>+KR2*<WR_OH>-KR4*<WR_H2O2> - PJAC(:,68,77)=+TPK%KR2(:)*PCONC(:,77)+TPK%KR2(:)*PCONC(:,77)-TPK%KR4(:)*PCONC(& -&:,68) + PJAC(:,69,78)=+TPK%KR2(:)*PCONC(:,78)+TPK%KR2(:)*PCONC(:,78)-TPK%KR4(:)*PCONC(& +&:,69) ! !WR_H2O2/WR_HO2=+KR5*<WR_HO2>+KR5*<WR_HO2> - PJAC(:,68,78)=+TPK%KR5(:)*PCONC(:,78)+TPK%KR5(:)*PCONC(:,78) + PJAC(:,69,79)=+TPK%KR5(:)*PCONC(:,79)+TPK%KR5(:)*PCONC(:,79) ! !WR_H2O2/WR_CO2=0.0 ! !WR_H2O2/WR_SO2=-KR30*<WR_H2O2> - PJAC(:,68,80)=-TPK%KR30(:)*PCONC(:,68) + PJAC(:,69,81)=-TPK%KR30(:)*PCONC(:,69) ! !WR_H2O2/WR_SULF=0.0 ! @@ -19533,7 +19914,7 @@ SUBROUTINE SUBJ13 !WR_NO/H2O2=0.0 ! !WR_NO/NO=+KTR3 - PJAC(:,69,3)=+TPK%KTR3(:) + PJAC(:,70,3)=+TPK%KTR3(:) ! !WR_NO/NO2=0.0 ! @@ -19549,6 +19930,8 @@ SUBROUTINE SUBJ13 ! !WR_NO/NH3=0.0 ! +!WR_NO/DMS=0.0 +! !WR_NO/SO2=0.0 ! !WR_NO/SULF=0.0 @@ -19666,7 +20049,7 @@ SUBROUTINE SUBJ13 !WR_NO/WR_H2O2=0.0 ! !WR_NO/WR_NO=-KTR23 - PJAC(:,69,69)=-TPK%KTR23(:) + PJAC(:,70,70)=-TPK%KTR23(:) ! !WR_NO/WR_NO2=0.0 ! @@ -19712,6 +20095,14 @@ SUBROUTINE SUBJ13 ! !WR_NO/WR_AHMS=0.0 ! +RETURN +END SUBROUTINE SUBJ13 +! +SUBROUTINE SUBJ14 +! +!Indices 71 a 75 +! +! !WR_NO2/O3=0.0 ! !WR_NO2/H2O2=0.0 @@ -19719,7 +20110,7 @@ SUBROUTINE SUBJ13 !WR_NO2/NO=0.0 ! !WR_NO2/NO2=+KTR4 - PJAC(:,70,4)=+TPK%KTR4(:) + PJAC(:,71,4)=+TPK%KTR4(:) ! !WR_NO2/NO3=0.0 ! @@ -19733,6 +20124,8 @@ SUBROUTINE SUBJ13 ! !WR_NO2/NH3=0.0 ! +!WR_NO2/DMS=0.0 +! !WR_NO2/SO2=0.0 ! !WR_NO2/SULF=0.0 @@ -19852,28 +20245,28 @@ SUBROUTINE SUBJ13 !WR_NO2/WR_NO=0.0 ! !WR_NO2/WR_NO2=-KTR24-KR9*<WR_HO2> - PJAC(:,70,70)=-TPK%KTR24(:)-TPK%KR9(:)*PCONC(:,78) + PJAC(:,71,71)=-TPK%KTR24(:)-TPK%KR9(:)*PCONC(:,79) ! !WR_NO2/WR_NO3=0.0 ! !WR_NO2/WR_N2O5=0.0 ! !WR_NO2/WR_HONO=+KR8*<WR_OH> - PJAC(:,70,73)=+TPK%KR8(:)*PCONC(:,77) + PJAC(:,71,74)=+TPK%KR8(:)*PCONC(:,78) ! !WR_NO2/WR_HNO3=+KR13 - PJAC(:,70,74)=+TPK%KR13(:) + PJAC(:,71,75)=+TPK%KR13(:) ! !WR_NO2/WR_HNO4=+KR10 - PJAC(:,70,75)=+TPK%KR10(:) + PJAC(:,71,76)=+TPK%KR10(:) ! !WR_NO2/WR_NH3=0.0 ! !WR_NO2/WR_OH=+KR8*<WR_HONO> - PJAC(:,70,77)=+TPK%KR8(:)*PCONC(:,73) + PJAC(:,71,78)=+TPK%KR8(:)*PCONC(:,74) ! !WR_NO2/WR_HO2=-KR9*<WR_NO2> - PJAC(:,70,78)=-TPK%KR9(:)*PCONC(:,70) + PJAC(:,71,79)=-TPK%KR9(:)*PCONC(:,71) ! !WR_NO2/WR_CO2=0.0 ! @@ -19901,14 +20294,6 @@ SUBROUTINE SUBJ13 ! !WR_NO2/WR_AHMS=0.0 ! -RETURN -END SUBROUTINE SUBJ13 -! -SUBROUTINE SUBJ14 -! -!Indices 71 a 75 -! -! !WR_NO3/O3=0.0 ! !WR_NO3/H2O2=0.0 @@ -19918,7 +20303,7 @@ SUBROUTINE SUBJ14 !WR_NO3/NO2=0.0 ! !WR_NO3/NO3=+KTR5 - PJAC(:,71,5)=+TPK%KTR5(:) + PJAC(:,72,5)=+TPK%KTR5(:) ! !WR_NO3/N2O5=0.0 ! @@ -19930,6 +20315,8 @@ SUBROUTINE SUBJ14 ! !WR_NO3/NH3=0.0 ! +!WR_NO3/DMS=0.0 +! !WR_NO3/SO2=0.0 ! !WR_NO3/SULF=0.0 @@ -20051,7 +20438,7 @@ SUBROUTINE SUBJ14 !WR_NO3/WR_NO2=0.0 ! !WR_NO3/WR_NO3=-KTR25-KR15*<WR_SULF>-KR16*<WR_SO2> - PJAC(:,71,71)=-TPK%KTR25(:)-TPK%KR15(:)*PCONC(:,81)-TPK%KR16(:)*PCONC(:,80) + PJAC(:,72,72)=-TPK%KTR25(:)-TPK%KR15(:)*PCONC(:,82)-TPK%KR16(:)*PCONC(:,81) ! !WR_NO3/WR_N2O5=0.0 ! @@ -20070,10 +20457,10 @@ SUBROUTINE SUBJ14 !WR_NO3/WR_CO2=0.0 ! !WR_NO3/WR_SO2=-KR16*<WR_NO3> - PJAC(:,71,80)=-TPK%KR16(:)*PCONC(:,71) + PJAC(:,72,81)=-TPK%KR16(:)*PCONC(:,72) ! !WR_NO3/WR_SULF=-KR15*<WR_NO3> - PJAC(:,71,81)=-TPK%KR15(:)*PCONC(:,71) + PJAC(:,72,82)=-TPK%KR15(:)*PCONC(:,72) ! !WR_NO3/WR_HCHO=0.0 ! @@ -20106,7 +20493,7 @@ SUBROUTINE SUBJ14 !WR_N2O5/NO3=0.0 ! !WR_N2O5/N2O5=+KTR6 - PJAC(:,72,6)=+TPK%KTR6(:) + PJAC(:,73,6)=+TPK%KTR6(:) ! !WR_N2O5/HONO=0.0 ! @@ -20116,6 +20503,8 @@ SUBROUTINE SUBJ14 ! !WR_N2O5/NH3=0.0 ! +!WR_N2O5/DMS=0.0 +! !WR_N2O5/SO2=0.0 ! !WR_N2O5/SULF=0.0 @@ -20239,7 +20628,7 @@ SUBROUTINE SUBJ14 !WR_N2O5/WR_NO3=0.0 ! !WR_N2O5/WR_N2O5=-KTR26-KR14 - PJAC(:,72,72)=-TPK%KTR26(:)-TPK%KR14(:) + PJAC(:,73,73)=-TPK%KTR26(:)-TPK%KR14(:) ! !WR_N2O5/WR_HONO=0.0 ! @@ -20292,7 +20681,7 @@ SUBROUTINE SUBJ14 !WR_HONO/N2O5=0.0 ! !WR_HONO/HONO=+KTR7 - PJAC(:,73,7)=+TPK%KTR7(:) + PJAC(:,74,7)=+TPK%KTR7(:) ! !WR_HONO/HNO3=0.0 ! @@ -20300,6 +20689,8 @@ SUBROUTINE SUBJ14 ! !WR_HONO/NH3=0.0 ! +!WR_HONO/DMS=0.0 +! !WR_HONO/SO2=0.0 ! !WR_HONO/SULF=0.0 @@ -20425,17 +20816,17 @@ SUBROUTINE SUBJ14 !WR_HONO/WR_N2O5=0.0 ! !WR_HONO/WR_HONO=-KTR27-KR8*<WR_OH> - PJAC(:,73,73)=-TPK%KTR27(:)-TPK%KR8(:)*PCONC(:,77) + PJAC(:,74,74)=-TPK%KTR27(:)-TPK%KR8(:)*PCONC(:,78) ! !WR_HONO/WR_HNO3=0.0 ! !WR_HONO/WR_HNO4=+KR11 - PJAC(:,73,75)=+TPK%KR11(:) + PJAC(:,74,76)=+TPK%KR11(:) ! !WR_HONO/WR_NH3=0.0 ! !WR_HONO/WR_OH=-KR8*<WR_HONO> - PJAC(:,73,77)=-TPK%KR8(:)*PCONC(:,73) + PJAC(:,74,78)=-TPK%KR8(:)*PCONC(:,74) ! !WR_HONO/WR_HO2=0.0 ! @@ -20480,12 +20871,14 @@ SUBROUTINE SUBJ14 !WR_HNO3/HONO=0.0 ! !WR_HNO3/HNO3=+KTR8 - PJAC(:,74,8)=+TPK%KTR8(:) + PJAC(:,75,8)=+TPK%KTR8(:) ! !WR_HNO3/HNO4=0.0 ! !WR_HNO3/NH3=0.0 ! +!WR_HNO3/DMS=0.0 +! !WR_HNO3/SO2=0.0 ! !WR_HNO3/SULF=0.0 @@ -20607,18 +21000,18 @@ SUBROUTINE SUBJ14 !WR_HNO3/WR_NO2=0.0 ! !WR_HNO3/WR_NO3=+KR15*<WR_SULF>+KR16*<WR_SO2> - PJAC(:,74,71)=+TPK%KR15(:)*PCONC(:,81)+TPK%KR16(:)*PCONC(:,80) + PJAC(:,75,72)=+TPK%KR15(:)*PCONC(:,82)+TPK%KR16(:)*PCONC(:,81) ! !WR_HNO3/WR_N2O5=+KR14+KR14 - PJAC(:,74,72)=+TPK%KR14(:)+TPK%KR14(:) + PJAC(:,75,73)=+TPK%KR14(:)+TPK%KR14(:) ! !WR_HNO3/WR_HONO=0.0 ! !WR_HNO3/WR_HNO3=-KTR28-KR13 - PJAC(:,74,74)=-TPK%KTR28(:)-TPK%KR13(:) + PJAC(:,75,75)=-TPK%KTR28(:)-TPK%KR13(:) ! !WR_HNO3/WR_HNO4=+KR12*<WR_SO2> - PJAC(:,74,75)=+TPK%KR12(:)*PCONC(:,80) + PJAC(:,75,76)=+TPK%KR12(:)*PCONC(:,81) ! !WR_HNO3/WR_NH3=0.0 ! @@ -20629,10 +21022,10 @@ SUBROUTINE SUBJ14 !WR_HNO3/WR_CO2=0.0 ! !WR_HNO3/WR_SO2=+KR12*<WR_HNO4>+KR16*<WR_NO3> - PJAC(:,74,80)=+TPK%KR12(:)*PCONC(:,75)+TPK%KR16(:)*PCONC(:,71) + PJAC(:,75,81)=+TPK%KR12(:)*PCONC(:,76)+TPK%KR16(:)*PCONC(:,72) ! !WR_HNO3/WR_SULF=+KR15*<WR_NO3> - PJAC(:,74,81)=+TPK%KR15(:)*PCONC(:,71) + PJAC(:,75,82)=+TPK%KR15(:)*PCONC(:,72) ! !WR_HNO3/WR_HCHO=0.0 ! @@ -20654,6 +21047,14 @@ SUBROUTINE SUBJ14 ! !WR_HNO3/WR_AHMS=0.0 ! +RETURN +END SUBROUTINE SUBJ14 +! +SUBROUTINE SUBJ15 +! +!Indices 76 a 80 +! +! !WR_HNO4/O3=0.0 ! !WR_HNO4/H2O2=0.0 @@ -20671,10 +21072,12 @@ SUBROUTINE SUBJ14 !WR_HNO4/HNO3=0.0 ! !WR_HNO4/HNO4=+KTR9 - PJAC(:,75,9)=+TPK%KTR9(:) + PJAC(:,76,9)=+TPK%KTR9(:) ! !WR_HNO4/NH3=0.0 ! +!WR_HNO4/DMS=0.0 +! !WR_HNO4/SO2=0.0 ! !WR_HNO4/SULF=0.0 @@ -20794,7 +21197,7 @@ SUBROUTINE SUBJ14 !WR_HNO4/WR_NO=0.0 ! !WR_HNO4/WR_NO2=+KR9*<WR_HO2> - PJAC(:,75,70)=+TPK%KR9(:)*PCONC(:,78) + PJAC(:,76,71)=+TPK%KR9(:)*PCONC(:,79) ! !WR_HNO4/WR_NO3=0.0 ! @@ -20805,19 +21208,19 @@ SUBROUTINE SUBJ14 !WR_HNO4/WR_HNO3=0.0 ! !WR_HNO4/WR_HNO4=-KTR29-KR10-KR11-KR12*<WR_SO2> - PJAC(:,75,75)=-TPK%KTR29(:)-TPK%KR10(:)-TPK%KR11(:)-TPK%KR12(:)*PCONC(:,80) + PJAC(:,76,76)=-TPK%KTR29(:)-TPK%KR10(:)-TPK%KR11(:)-TPK%KR12(:)*PCONC(:,81) ! !WR_HNO4/WR_NH3=0.0 ! !WR_HNO4/WR_OH=0.0 ! !WR_HNO4/WR_HO2=+KR9*<WR_NO2> - PJAC(:,75,78)=+TPK%KR9(:)*PCONC(:,70) + PJAC(:,76,79)=+TPK%KR9(:)*PCONC(:,71) ! !WR_HNO4/WR_CO2=0.0 ! !WR_HNO4/WR_SO2=-KR12*<WR_HNO4> - PJAC(:,75,80)=-TPK%KR12(:)*PCONC(:,75) + PJAC(:,76,81)=-TPK%KR12(:)*PCONC(:,76) ! !WR_HNO4/WR_SULF=0.0 ! @@ -20841,14 +21244,6 @@ SUBROUTINE SUBJ14 ! !WR_HNO4/WR_AHMS=0.0 ! -RETURN -END SUBROUTINE SUBJ14 -! -SUBROUTINE SUBJ15 -! -!Indices 76 a 80 -! -! !WR_NH3/O3=0.0 ! !WR_NH3/H2O2=0.0 @@ -20868,7 +21263,9 @@ SUBROUTINE SUBJ15 !WR_NH3/HNO4=0.0 ! !WR_NH3/NH3=+KTR10 - PJAC(:,76,10)=+TPK%KTR10(:) + PJAC(:,77,10)=+TPK%KTR10(:) +! +!WR_NH3/DMS=0.0 ! !WR_NH3/SO2=0.0 ! @@ -21001,7 +21398,7 @@ SUBROUTINE SUBJ15 !WR_NH3/WR_HNO4=0.0 ! !WR_NH3/WR_NH3=-KTR30 - PJAC(:,76,76)=-TPK%KTR30(:) + PJAC(:,77,77)=-TPK%KTR30(:) ! !WR_NH3/WR_OH=0.0 ! @@ -21053,6 +21450,8 @@ SUBROUTINE SUBJ15 ! !WR_OH/NH3=0.0 ! +!WR_OH/DMS=0.0 +! !WR_OH/SO2=0.0 ! !WR_OH/SULF=0.0 @@ -21060,7 +21459,7 @@ SUBROUTINE SUBJ15 !WR_OH/CO=0.0 ! !WR_OH/OH=+KTR11 - PJAC(:,77,14)=+TPK%KTR11(:) + PJAC(:,78,15)=+TPK%KTR11(:) ! !WR_OH/HO2=0.0 ! @@ -21167,10 +21566,10 @@ SUBROUTINE SUBJ15 !WR_OH/WC_AHMS=0.0 ! !WR_OH/WR_O3=+KR6*<WR_HO2> - PJAC(:,77,67)=+TPK%KR6(:)*PCONC(:,78) + PJAC(:,78,68)=+TPK%KR6(:)*PCONC(:,79) ! !WR_OH/WR_H2O2=+KR1+KR1-KR4*<WR_OH> - PJAC(:,77,68)=+TPK%KR1(:)+TPK%KR1(:)-TPK%KR4(:)*PCONC(:,77) + PJAC(:,78,69)=+TPK%KR1(:)+TPK%KR1(:)-TPK%KR4(:)*PCONC(:,78) ! !WR_OH/WR_NO=0.0 ! @@ -21181,10 +21580,10 @@ SUBROUTINE SUBJ15 !WR_OH/WR_N2O5=0.0 ! !WR_OH/WR_HONO=-KR8*<WR_OH> - PJAC(:,77,73)=-TPK%KR8(:)*PCONC(:,77) + PJAC(:,78,74)=-TPK%KR8(:)*PCONC(:,78) ! !WR_OH/WR_HNO3=+KR13 - PJAC(:,77,74)=+TPK%KR13(:) + PJAC(:,78,75)=+TPK%KR13(:) ! !WR_OH/WR_HNO4=0.0 ! @@ -21193,26 +21592,26 @@ SUBROUTINE SUBJ15 !WR_OH/WR_OH=-KTR31-KR2*<WR_OH>-KR2*<WR_OH>-KR2*<WR_OH>-KR2*<WR_OH>-KR3*<WR_HO2 !>-KR4*<WR_H2O2>-KR7*<WR_SO2>-KR8*<WR_HONO>-KR19*<WR_HCHO>-KR20*<WR_ORA1>-KR23* !<WR_AHMS> - PJAC(:,77,77)=-TPK%KTR31(:)-TPK%KR2(:)*PCONC(:,77)-TPK%KR2(:)*PCONC(:,77)-TPK%& -&KR2(:)*PCONC(:,77)-TPK%KR2(:)*PCONC(:,77)-TPK%KR3(:)*PCONC(:,78)-TPK%KR4(:)*PC& -&ONC(:,68)-TPK%KR7(:)*PCONC(:,80)-TPK%KR8(:)*PCONC(:,73)-TPK%KR19(:)*PCONC(:,82& -&)-TPK%KR20(:)*PCONC(:,83)-TPK%KR23(:)*PCONC(:,91) + PJAC(:,78,78)=-TPK%KTR31(:)-TPK%KR2(:)*PCONC(:,78)-TPK%KR2(:)*PCONC(:,78)-TPK%& +&KR2(:)*PCONC(:,78)-TPK%KR2(:)*PCONC(:,78)-TPK%KR3(:)*PCONC(:,79)-TPK%KR4(:)*PC& +&ONC(:,69)-TPK%KR7(:)*PCONC(:,81)-TPK%KR8(:)*PCONC(:,74)-TPK%KR19(:)*PCONC(:,83& +&)-TPK%KR20(:)*PCONC(:,84)-TPK%KR23(:)*PCONC(:,92) ! !WR_OH/WR_HO2=-KR3*<WR_OH>+KR6*<WR_O3> - PJAC(:,77,78)=-TPK%KR3(:)*PCONC(:,77)+TPK%KR6(:)*PCONC(:,67) + PJAC(:,78,79)=-TPK%KR3(:)*PCONC(:,78)+TPK%KR6(:)*PCONC(:,68) ! !WR_OH/WR_CO2=0.0 ! !WR_OH/WR_SO2=-KR7*<WR_OH> - PJAC(:,77,80)=-TPK%KR7(:)*PCONC(:,77) + PJAC(:,78,81)=-TPK%KR7(:)*PCONC(:,78) ! !WR_OH/WR_SULF=0.0 ! !WR_OH/WR_HCHO=-KR19*<WR_OH> - PJAC(:,77,82)=-TPK%KR19(:)*PCONC(:,77) + PJAC(:,78,83)=-TPK%KR19(:)*PCONC(:,78) ! !WR_OH/WR_ORA1=-KR20*<WR_OH> - PJAC(:,77,83)=-TPK%KR20(:)*PCONC(:,77) + PJAC(:,78,84)=-TPK%KR20(:)*PCONC(:,78) ! !WR_OH/WR_ORA2=0.0 ! @@ -21223,14 +21622,14 @@ SUBROUTINE SUBJ15 !WR_OH/WR_ASO3=0.0 ! !WR_OH/WR_ASO4=+KR28 - PJAC(:,77,88)=+TPK%KR28(:) + PJAC(:,78,89)=+TPK%KR28(:) ! !WR_OH/WR_ASO5=0.0 ! !WR_OH/WR_AHSO5=0.0 ! !WR_OH/WR_AHMS=-KR23*<WR_OH> - PJAC(:,77,91)=-TPK%KR23(:)*PCONC(:,77) + PJAC(:,78,92)=-TPK%KR23(:)*PCONC(:,78) ! !WR_HO2/O3=0.0 ! @@ -21252,6 +21651,8 @@ SUBROUTINE SUBJ15 ! !WR_HO2/NH3=0.0 ! +!WR_HO2/DMS=0.0 +! !WR_HO2/SO2=0.0 ! !WR_HO2/SULF=0.0 @@ -21261,7 +21662,7 @@ SUBROUTINE SUBJ15 !WR_HO2/OH=0.0 ! !WR_HO2/HO2=+KTR12 - PJAC(:,78,15)=+TPK%KTR12(:) + PJAC(:,79,16)=+TPK%KTR12(:) ! !WR_HO2/CH4=0.0 ! @@ -21366,15 +21767,15 @@ SUBROUTINE SUBJ15 !WR_HO2/WC_AHMS=0.0 ! !WR_HO2/WR_O3=-KR6*<WR_HO2> - PJAC(:,78,67)=-TPK%KR6(:)*PCONC(:,78) + PJAC(:,79,68)=-TPK%KR6(:)*PCONC(:,79) ! !WR_HO2/WR_H2O2=+KR4*<WR_OH> - PJAC(:,78,68)=+TPK%KR4(:)*PCONC(:,77) + PJAC(:,79,69)=+TPK%KR4(:)*PCONC(:,78) ! !WR_HO2/WR_NO=0.0 ! !WR_HO2/WR_NO2=-KR9*<WR_HO2> - PJAC(:,78,70)=-TPK%KR9(:)*PCONC(:,78) + PJAC(:,79,71)=-TPK%KR9(:)*PCONC(:,79) ! !WR_HO2/WR_NO3=0.0 ! @@ -21385,20 +21786,20 @@ SUBROUTINE SUBJ15 !WR_HO2/WR_HNO3=0.0 ! !WR_HO2/WR_HNO4=+KR10 - PJAC(:,78,75)=+TPK%KR10(:) + PJAC(:,79,76)=+TPK%KR10(:) ! !WR_HO2/WR_NH3=0.0 ! !WR_HO2/WR_OH=-KR3*<WR_HO2>+KR4*<WR_H2O2>+KR19*<WR_HCHO>+KR20*<WR_ORA1>+KR23*<W !R_AHMS> - PJAC(:,78,77)=-TPK%KR3(:)*PCONC(:,78)+TPK%KR4(:)*PCONC(:,68)+TPK%KR19(:)*PCONC& -&(:,82)+TPK%KR20(:)*PCONC(:,83)+TPK%KR23(:)*PCONC(:,91) + PJAC(:,79,78)=-TPK%KR3(:)*PCONC(:,79)+TPK%KR4(:)*PCONC(:,69)+TPK%KR19(:)*PCONC& +&(:,83)+TPK%KR20(:)*PCONC(:,84)+TPK%KR23(:)*PCONC(:,92) ! !WR_HO2/WR_HO2=-KTR32-KR3*<WR_OH>-KR5*<WR_HO2>-KR5*<WR_HO2>-KR5*<WR_HO2>-KR5*<W !R_HO2>-KR6*<WR_O3>-KR9*<WR_NO2>-KR25*<WR_ASO5> - PJAC(:,78,78)=-TPK%KTR32(:)-TPK%KR3(:)*PCONC(:,77)-TPK%KR5(:)*PCONC(:,78)-TPK%& -&KR5(:)*PCONC(:,78)-TPK%KR5(:)*PCONC(:,78)-TPK%KR5(:)*PCONC(:,78)-TPK%KR6(:)*PC& -&ONC(:,67)-TPK%KR9(:)*PCONC(:,70)-TPK%KR25(:)*PCONC(:,89) + PJAC(:,79,79)=-TPK%KTR32(:)-TPK%KR3(:)*PCONC(:,78)-TPK%KR5(:)*PCONC(:,79)-TPK%& +&KR5(:)*PCONC(:,79)-TPK%KR5(:)*PCONC(:,79)-TPK%KR5(:)*PCONC(:,79)-TPK%KR6(:)*PC& +&ONC(:,68)-TPK%KR9(:)*PCONC(:,71)-TPK%KR25(:)*PCONC(:,90) ! !WR_HO2/WR_CO2=0.0 ! @@ -21407,15 +21808,15 @@ SUBROUTINE SUBJ15 !WR_HO2/WR_SULF=0.0 ! !WR_HO2/WR_HCHO=+KR19*<WR_OH> - PJAC(:,78,82)=+TPK%KR19(:)*PCONC(:,77) + PJAC(:,79,83)=+TPK%KR19(:)*PCONC(:,78) ! !WR_HO2/WR_ORA1=+KR20*<WR_OH> - PJAC(:,78,83)=+TPK%KR20(:)*PCONC(:,77) + PJAC(:,79,84)=+TPK%KR20(:)*PCONC(:,78) ! !WR_HO2/WR_ORA2=0.0 ! !WR_HO2/WR_MO2=+2.00*KR17*<WR_MO2>+2.00*KR17*<WR_MO2> - PJAC(:,78,85)=+2.00*TPK%KR17(:)*PCONC(:,85)+2.00*TPK%KR17(:)*PCONC(:,85) + PJAC(:,79,86)=+2.00*TPK%KR17(:)*PCONC(:,86)+2.00*TPK%KR17(:)*PCONC(:,86) ! !WR_HO2/WR_OP1=0.0 ! @@ -21424,12 +21825,12 @@ SUBROUTINE SUBJ15 !WR_HO2/WR_ASO4=0.0 ! !WR_HO2/WR_ASO5=-KR25*<WR_HO2> - PJAC(:,78,89)=-TPK%KR25(:)*PCONC(:,78) + PJAC(:,79,90)=-TPK%KR25(:)*PCONC(:,79) ! !WR_HO2/WR_AHSO5=0.0 ! !WR_HO2/WR_AHMS=+KR23*<WR_OH> - PJAC(:,78,91)=+TPK%KR23(:)*PCONC(:,77) + PJAC(:,79,92)=+TPK%KR23(:)*PCONC(:,78) ! !WR_CO2/O3=0.0 ! @@ -21451,6 +21852,8 @@ SUBROUTINE SUBJ15 ! !WR_CO2/NH3=0.0 ! +!WR_CO2/DMS=0.0 +! !WR_CO2/SO2=0.0 ! !WR_CO2/SULF=0.0 @@ -21584,12 +21987,12 @@ SUBROUTINE SUBJ15 !WR_CO2/WR_NH3=0.0 ! !WR_CO2/WR_OH=+KR20*<WR_ORA1> - PJAC(:,79,77)=+TPK%KR20(:)*PCONC(:,83) + PJAC(:,80,78)=+TPK%KR20(:)*PCONC(:,84) ! !WR_CO2/WR_HO2=0.0 ! !WR_CO2/WR_CO2=-KTR33 - PJAC(:,79,79)=-TPK%KTR33(:) + PJAC(:,80,80)=-TPK%KTR33(:) ! !WR_CO2/WR_SO2=0.0 ! @@ -21598,7 +22001,7 @@ SUBROUTINE SUBJ15 !WR_CO2/WR_HCHO=0.0 ! !WR_CO2/WR_ORA1=+KR20*<WR_OH> - PJAC(:,79,83)=+TPK%KR20(:)*PCONC(:,77) + PJAC(:,80,84)=+TPK%KR20(:)*PCONC(:,78) ! !WR_CO2/WR_ORA2=0.0 ! @@ -21616,6 +22019,14 @@ SUBROUTINE SUBJ15 ! !WR_CO2/WR_AHMS=0.0 ! +RETURN +END SUBROUTINE SUBJ15 +! +SUBROUTINE SUBJ16 +! +!Indices 81 a 85 +! +! !WR_SO2/O3=0.0 ! !WR_SO2/H2O2=0.0 @@ -21636,8 +22047,10 @@ SUBROUTINE SUBJ15 ! !WR_SO2/NH3=0.0 ! +!WR_SO2/DMS=0.0 +! !WR_SO2/SO2=+KTR14 - PJAC(:,80,11)=+TPK%KTR14(:) + PJAC(:,81,12)=+TPK%KTR14(:) ! !WR_SO2/SULF=0.0 ! @@ -21750,17 +22163,17 @@ SUBROUTINE SUBJ15 !WR_SO2/WC_AHMS=0.0 ! !WR_SO2/WR_O3=-KR29*<WR_SO2> - PJAC(:,80,67)=-TPK%KR29(:)*PCONC(:,80) + PJAC(:,81,68)=-TPK%KR29(:)*PCONC(:,81) ! !WR_SO2/WR_H2O2=-KR30*<WR_SO2> - PJAC(:,80,68)=-TPK%KR30(:)*PCONC(:,80) + PJAC(:,81,69)=-TPK%KR30(:)*PCONC(:,81) ! !WR_SO2/WR_NO=0.0 ! !WR_SO2/WR_NO2=0.0 ! !WR_SO2/WR_NO3=-KR16*<WR_SO2> - PJAC(:,80,71)=-TPK%KR16(:)*PCONC(:,80) + PJAC(:,81,72)=-TPK%KR16(:)*PCONC(:,81) ! !WR_SO2/WR_N2O5=0.0 ! @@ -21769,12 +22182,12 @@ SUBROUTINE SUBJ15 !WR_SO2/WR_HNO3=0.0 ! !WR_SO2/WR_HNO4=-KR12*<WR_SO2> - PJAC(:,80,75)=-TPK%KR12(:)*PCONC(:,80) + PJAC(:,81,76)=-TPK%KR12(:)*PCONC(:,81) ! !WR_SO2/WR_NH3=0.0 ! !WR_SO2/WR_OH=-KR7*<WR_SO2>+KR23*<WR_AHMS> - PJAC(:,80,77)=-TPK%KR7(:)*PCONC(:,80)+TPK%KR23(:)*PCONC(:,91) + PJAC(:,81,78)=-TPK%KR7(:)*PCONC(:,81)+TPK%KR23(:)*PCONC(:,92) ! !WR_SO2/WR_HO2=0.0 ! @@ -21782,21 +22195,21 @@ SUBROUTINE SUBJ15 ! !WR_SO2/WR_SO2=-KTR34-KR7*<WR_OH>-KR12*<WR_HNO4>-KR16*<WR_NO3>-KR18*<WR_MO2>-KR !21*<WR_HCHO>-KR27*<WR_AHSO5>-KR29*<WR_O3>-KR30*<WR_H2O2> - PJAC(:,80,80)=-TPK%KTR34(:)-TPK%KR7(:)*PCONC(:,77)-TPK%KR12(:)*PCONC(:,75)-TPK& -&%KR16(:)*PCONC(:,71)-TPK%KR18(:)*PCONC(:,85)-TPK%KR21(:)*PCONC(:,82)-TPK%KR27(& -&:)*PCONC(:,90)-TPK%KR29(:)*PCONC(:,67)-TPK%KR30(:)*PCONC(:,68) + PJAC(:,81,81)=-TPK%KTR34(:)-TPK%KR7(:)*PCONC(:,78)-TPK%KR12(:)*PCONC(:,76)-TPK& +&%KR16(:)*PCONC(:,72)-TPK%KR18(:)*PCONC(:,86)-TPK%KR21(:)*PCONC(:,83)-TPK%KR27(& +&:)*PCONC(:,91)-TPK%KR29(:)*PCONC(:,68)-TPK%KR30(:)*PCONC(:,69) ! !WR_SO2/WR_SULF=0.0 ! !WR_SO2/WR_HCHO=-KR21*<WR_SO2> - PJAC(:,80,82)=-TPK%KR21(:)*PCONC(:,80) + PJAC(:,81,83)=-TPK%KR21(:)*PCONC(:,81) ! !WR_SO2/WR_ORA1=0.0 ! !WR_SO2/WR_ORA2=0.0 ! !WR_SO2/WR_MO2=-KR18*<WR_SO2> - PJAC(:,80,85)=-TPK%KR18(:)*PCONC(:,80) + PJAC(:,81,86)=-TPK%KR18(:)*PCONC(:,81) ! !WR_SO2/WR_OP1=0.0 ! @@ -21807,18 +22220,10 @@ SUBROUTINE SUBJ15 !WR_SO2/WR_ASO5=0.0 ! !WR_SO2/WR_AHSO5=-KR27*<WR_SO2> - PJAC(:,80,90)=-TPK%KR27(:)*PCONC(:,80) + PJAC(:,81,91)=-TPK%KR27(:)*PCONC(:,81) ! !WR_SO2/WR_AHMS=+KR22+KR23*<WR_OH> - PJAC(:,80,91)=+TPK%KR22(:)+TPK%KR23(:)*PCONC(:,77) -! -RETURN -END SUBROUTINE SUBJ15 -! -SUBROUTINE SUBJ16 -! -!Indices 81 a 85 -! + PJAC(:,81,92)=+TPK%KR22(:)+TPK%KR23(:)*PCONC(:,78) ! !WR_SULF/O3=0.0 ! @@ -21840,10 +22245,12 @@ SUBROUTINE SUBJ16 ! !WR_SULF/NH3=0.0 ! +!WR_SULF/DMS=0.0 +! !WR_SULF/SO2=0.0 ! !WR_SULF/SULF=+KTR15 - PJAC(:,81,12)=+TPK%KTR15(:) + PJAC(:,82,13)=+TPK%KTR15(:) ! !WR_SULF/CO=0.0 ! @@ -21954,17 +22361,17 @@ SUBROUTINE SUBJ16 !WR_SULF/WC_AHMS=0.0 ! !WR_SULF/WR_O3=+KR29*<WR_SO2> - PJAC(:,81,67)=+TPK%KR29(:)*PCONC(:,80) + PJAC(:,82,68)=+TPK%KR29(:)*PCONC(:,81) ! !WR_SULF/WR_H2O2=+KR30*<WR_SO2> - PJAC(:,81,68)=+TPK%KR30(:)*PCONC(:,80) + PJAC(:,82,69)=+TPK%KR30(:)*PCONC(:,81) ! !WR_SULF/WR_NO=0.0 ! !WR_SULF/WR_NO2=0.0 ! !WR_SULF/WR_NO3=-KR15*<WR_SULF> - PJAC(:,81,71)=-TPK%KR15(:)*PCONC(:,81) + PJAC(:,82,72)=-TPK%KR15(:)*PCONC(:,82) ! !WR_SULF/WR_N2O5=0.0 ! @@ -21973,7 +22380,7 @@ SUBROUTINE SUBJ16 !WR_SULF/WR_HNO3=0.0 ! !WR_SULF/WR_HNO4=+KR12*<WR_SO2> - PJAC(:,81,75)=+TPK%KR12(:)*PCONC(:,80) + PJAC(:,82,76)=+TPK%KR12(:)*PCONC(:,81) ! !WR_SULF/WR_NH3=0.0 ! @@ -21985,11 +22392,11 @@ SUBROUTINE SUBJ16 ! !WR_SULF/WR_SO2=+KR12*<WR_HNO4>+2.00*KR27*<WR_AHSO5>+KR29*<WR_O3>+KR30*<WR_H2O2 !> - PJAC(:,81,80)=+TPK%KR12(:)*PCONC(:,75)+2.00*TPK%KR27(:)*PCONC(:,90)+TPK%KR29(:& -&)*PCONC(:,67)+TPK%KR30(:)*PCONC(:,68) + PJAC(:,82,81)=+TPK%KR12(:)*PCONC(:,76)+2.00*TPK%KR27(:)*PCONC(:,91)+TPK%KR29(:& +&)*PCONC(:,68)+TPK%KR30(:)*PCONC(:,69) ! !WR_SULF/WR_SULF=-KTR35-KR15*<WR_NO3> - PJAC(:,81,81)=-TPK%KTR35(:)-TPK%KR15(:)*PCONC(:,71) + PJAC(:,82,82)=-TPK%KTR35(:)-TPK%KR15(:)*PCONC(:,72) ! !WR_SULF/WR_HCHO=0.0 ! @@ -22004,12 +22411,12 @@ SUBROUTINE SUBJ16 !WR_SULF/WR_ASO3=0.0 ! !WR_SULF/WR_ASO4=+KR28 - PJAC(:,81,88)=+TPK%KR28(:) + PJAC(:,82,89)=+TPK%KR28(:) ! !WR_SULF/WR_ASO5=0.0 ! !WR_SULF/WR_AHSO5=+2.00*KR27*<WR_SO2> - PJAC(:,81,90)=+2.00*TPK%KR27(:)*PCONC(:,80) + PJAC(:,82,91)=+2.00*TPK%KR27(:)*PCONC(:,81) ! !WR_SULF/WR_AHMS=0.0 ! @@ -22033,6 +22440,8 @@ SUBROUTINE SUBJ16 ! !WR_HCHO/NH3=0.0 ! +!WR_HCHO/DMS=0.0 +! !WR_HCHO/SO2=0.0 ! !WR_HCHO/SULF=0.0 @@ -22056,7 +22465,7 @@ SUBROUTINE SUBJ16 !WR_HCHO/ARO=0.0 ! !WR_HCHO/HCHO=+KTR16 - PJAC(:,82,22)=+TPK%KTR16(:) + PJAC(:,83,23)=+TPK%KTR16(:) ! !WR_HCHO/ALD=0.0 ! @@ -22167,26 +22576,26 @@ SUBROUTINE SUBJ16 !WR_HCHO/WR_NH3=0.0 ! !WR_HCHO/WR_OH=-KR19*<WR_HCHO> - PJAC(:,82,77)=-TPK%KR19(:)*PCONC(:,82) + PJAC(:,83,78)=-TPK%KR19(:)*PCONC(:,83) ! !WR_HCHO/WR_HO2=0.0 ! !WR_HCHO/WR_CO2=0.0 ! !WR_HCHO/WR_SO2=-KR21*<WR_HCHO> - PJAC(:,82,80)=-TPK%KR21(:)*PCONC(:,82) + PJAC(:,83,81)=-TPK%KR21(:)*PCONC(:,83) ! !WR_HCHO/WR_SULF=0.0 ! !WR_HCHO/WR_HCHO=-KTR36-KR19*<WR_OH>-KR21*<WR_SO2> - PJAC(:,82,82)=-TPK%KTR36(:)-TPK%KR19(:)*PCONC(:,77)-TPK%KR21(:)*PCONC(:,80) + PJAC(:,83,83)=-TPK%KTR36(:)-TPK%KR19(:)*PCONC(:,78)-TPK%KR21(:)*PCONC(:,81) ! !WR_HCHO/WR_ORA1=0.0 ! !WR_HCHO/WR_ORA2=0.0 ! !WR_HCHO/WR_MO2=+2.00*KR17*<WR_MO2>+2.00*KR17*<WR_MO2> - PJAC(:,82,85)=+2.00*TPK%KR17(:)*PCONC(:,85)+2.00*TPK%KR17(:)*PCONC(:,85) + PJAC(:,83,86)=+2.00*TPK%KR17(:)*PCONC(:,86)+2.00*TPK%KR17(:)*PCONC(:,86) ! !WR_HCHO/WR_OP1=0.0 ! @@ -22199,7 +22608,7 @@ SUBROUTINE SUBJ16 !WR_HCHO/WR_AHSO5=0.0 ! !WR_HCHO/WR_AHMS=+KR22 - PJAC(:,82,91)=+TPK%KR22(:) + PJAC(:,83,92)=+TPK%KR22(:) ! !WR_ORA1/O3=0.0 ! @@ -22221,6 +22630,8 @@ SUBROUTINE SUBJ16 ! !WR_ORA1/NH3=0.0 ! +!WR_ORA1/DMS=0.0 +! !WR_ORA1/SO2=0.0 ! !WR_ORA1/SULF=0.0 @@ -22260,7 +22671,7 @@ SUBROUTINE SUBJ16 !WR_ORA1/OP2=0.0 ! !WR_ORA1/ORA1=+KTR17 - PJAC(:,83,30)=+TPK%KTR17(:) + PJAC(:,84,31)=+TPK%KTR17(:) ! !WR_ORA1/ORA2=0.0 ! @@ -22355,8 +22766,8 @@ SUBROUTINE SUBJ16 !WR_ORA1/WR_NH3=0.0 ! !WR_ORA1/WR_OH=+KR19*<WR_HCHO>-KR20*<WR_ORA1>+KR23*<WR_AHMS> - PJAC(:,83,77)=+TPK%KR19(:)*PCONC(:,82)-TPK%KR20(:)*PCONC(:,83)+TPK%KR23(:)*PCO& -&NC(:,91) + PJAC(:,84,78)=+TPK%KR19(:)*PCONC(:,83)-TPK%KR20(:)*PCONC(:,84)+TPK%KR23(:)*PCO& +&NC(:,92) ! !WR_ORA1/WR_HO2=0.0 ! @@ -22367,10 +22778,10 @@ SUBROUTINE SUBJ16 !WR_ORA1/WR_SULF=0.0 ! !WR_ORA1/WR_HCHO=+KR19*<WR_OH> - PJAC(:,83,82)=+TPK%KR19(:)*PCONC(:,77) + PJAC(:,84,83)=+TPK%KR19(:)*PCONC(:,78) ! !WR_ORA1/WR_ORA1=-KTR37-KR20*<WR_OH> - PJAC(:,83,83)=-TPK%KTR37(:)-TPK%KR20(:)*PCONC(:,77) + PJAC(:,84,84)=-TPK%KTR37(:)-TPK%KR20(:)*PCONC(:,78) ! !WR_ORA1/WR_ORA2=0.0 ! @@ -22387,7 +22798,7 @@ SUBROUTINE SUBJ16 !WR_ORA1/WR_AHSO5=0.0 ! !WR_ORA1/WR_AHMS=+KR23*<WR_OH> - PJAC(:,83,91)=+TPK%KR23(:)*PCONC(:,77) + PJAC(:,84,92)=+TPK%KR23(:)*PCONC(:,78) ! !WR_ORA2/O3=0.0 ! @@ -22409,6 +22820,8 @@ SUBROUTINE SUBJ16 ! !WR_ORA2/NH3=0.0 ! +!WR_ORA2/DMS=0.0 +! !WR_ORA2/SO2=0.0 ! !WR_ORA2/SULF=0.0 @@ -22450,7 +22863,7 @@ SUBROUTINE SUBJ16 !WR_ORA2/ORA1=0.0 ! !WR_ORA2/ORA2=+KTR18 - PJAC(:,84,31)=+TPK%KTR18(:) + PJAC(:,85,32)=+TPK%KTR18(:) ! !WR_ORA2/MO2=0.0 ! @@ -22557,7 +22970,7 @@ SUBROUTINE SUBJ16 !WR_ORA2/WR_ORA1=0.0 ! !WR_ORA2/WR_ORA2=-KTR38 - PJAC(:,84,84)=-TPK%KTR38(:) + PJAC(:,85,85)=-TPK%KTR38(:) ! !WR_ORA2/WR_MO2=0.0 ! @@ -22573,6 +22986,14 @@ SUBROUTINE SUBJ16 ! !WR_ORA2/WR_AHMS=0.0 ! +RETURN +END SUBROUTINE SUBJ16 +! +SUBROUTINE SUBJ17 +! +!Indices 86 a 90 +! +! !WR_MO2/O3=0.0 ! !WR_MO2/H2O2=0.0 @@ -22593,6 +23014,8 @@ SUBROUTINE SUBJ16 ! !WR_MO2/NH3=0.0 ! +!WR_MO2/DMS=0.0 +! !WR_MO2/SO2=0.0 ! !WR_MO2/SULF=0.0 @@ -22636,7 +23059,7 @@ SUBROUTINE SUBJ16 !WR_MO2/ORA2=0.0 ! !WR_MO2/MO2=+KTR19 - PJAC(:,85,32)=+TPK%KTR19(:) + PJAC(:,86,33)=+TPK%KTR19(:) ! !WR_MO2/ALKAP=0.0 ! @@ -22733,7 +23156,7 @@ SUBROUTINE SUBJ16 !WR_MO2/WR_CO2=0.0 ! !WR_MO2/WR_SO2=-KR18*<WR_MO2> - PJAC(:,85,80)=-TPK%KR18(:)*PCONC(:,85) + PJAC(:,86,81)=-TPK%KR18(:)*PCONC(:,86) ! !WR_MO2/WR_SULF=0.0 ! @@ -22745,8 +23168,8 @@ SUBROUTINE SUBJ16 ! !WR_MO2/WR_MO2=-KTR39-KR17*<WR_MO2>-KR17*<WR_MO2>-KR17*<WR_MO2>-KR17*<WR_MO2>-K !R18*<WR_SO2> - PJAC(:,85,85)=-TPK%KTR39(:)-TPK%KR17(:)*PCONC(:,85)-TPK%KR17(:)*PCONC(:,85)-TP& -&K%KR17(:)*PCONC(:,85)-TPK%KR17(:)*PCONC(:,85)-TPK%KR18(:)*PCONC(:,80) + PJAC(:,86,86)=-TPK%KTR39(:)-TPK%KR17(:)*PCONC(:,86)-TPK%KR17(:)*PCONC(:,86)-TP& +&K%KR17(:)*PCONC(:,86)-TPK%KR17(:)*PCONC(:,86)-TPK%KR18(:)*PCONC(:,81) ! !WR_MO2/WR_OP1=0.0 ! @@ -22760,14 +23183,6 @@ SUBROUTINE SUBJ16 ! !WR_MO2/WR_AHMS=0.0 ! -RETURN -END SUBROUTINE SUBJ16 -! -SUBROUTINE SUBJ17 -! -!Indices 86 a 90 -! -! !WR_OP1/O3=0.0 ! !WR_OP1/H2O2=0.0 @@ -22788,6 +23203,8 @@ SUBROUTINE SUBJ17 ! !WR_OP1/NH3=0.0 ! +!WR_OP1/DMS=0.0 +! !WR_OP1/SO2=0.0 ! !WR_OP1/SULF=0.0 @@ -22823,7 +23240,7 @@ SUBROUTINE SUBJ17 !WR_OP1/PAN=0.0 ! !WR_OP1/OP1=+KTR20 - PJAC(:,86,28)=+TPK%KTR20(:) + PJAC(:,87,29)=+TPK%KTR20(:) ! !WR_OP1/OP2=0.0 ! @@ -22928,7 +23345,7 @@ SUBROUTINE SUBJ17 !WR_OP1/WR_CO2=0.0 ! !WR_OP1/WR_SO2=+KR18*<WR_MO2> - PJAC(:,86,80)=+TPK%KR18(:)*PCONC(:,85) + PJAC(:,87,81)=+TPK%KR18(:)*PCONC(:,86) ! !WR_OP1/WR_SULF=0.0 ! @@ -22939,10 +23356,10 @@ SUBROUTINE SUBJ17 !WR_OP1/WR_ORA2=0.0 ! !WR_OP1/WR_MO2=+KR18*<WR_SO2> - PJAC(:,86,85)=+TPK%KR18(:)*PCONC(:,80) + PJAC(:,87,86)=+TPK%KR18(:)*PCONC(:,81) ! !WR_OP1/WR_OP1=-KTR40 - PJAC(:,86,86)=-TPK%KTR40(:) + PJAC(:,87,87)=-TPK%KTR40(:) ! !WR_OP1/WR_ASO3=0.0 ! @@ -22974,6 +23391,8 @@ SUBROUTINE SUBJ17 ! !WR_ASO3/NH3=0.0 ! +!WR_ASO3/DMS=0.0 +! !WR_ASO3/SO2=0.0 ! !WR_ASO3/SULF=0.0 @@ -23095,7 +23514,7 @@ SUBROUTINE SUBJ17 !WR_ASO3/WR_NO2=0.0 ! !WR_ASO3/WR_NO3=+KR16*<WR_SO2> - PJAC(:,87,71)=+TPK%KR16(:)*PCONC(:,80) + PJAC(:,88,72)=+TPK%KR16(:)*PCONC(:,81) ! !WR_ASO3/WR_N2O5=0.0 ! @@ -23108,15 +23527,15 @@ SUBROUTINE SUBJ17 !WR_ASO3/WR_NH3=0.0 ! !WR_ASO3/WR_OH=+KR7*<WR_SO2> - PJAC(:,87,77)=+TPK%KR7(:)*PCONC(:,80) + PJAC(:,88,78)=+TPK%KR7(:)*PCONC(:,81) ! !WR_ASO3/WR_HO2=0.0 ! !WR_ASO3/WR_CO2=0.0 ! !WR_ASO3/WR_SO2=+KR7*<WR_OH>+KR16*<WR_NO3>+KR18*<WR_MO2> - PJAC(:,87,80)=+TPK%KR7(:)*PCONC(:,77)+TPK%KR16(:)*PCONC(:,71)+TPK%KR18(:)*PCON& -&C(:,85) + PJAC(:,88,81)=+TPK%KR7(:)*PCONC(:,78)+TPK%KR16(:)*PCONC(:,72)+TPK%KR18(:)*PCON& +&C(:,86) ! !WR_ASO3/WR_SULF=0.0 ! @@ -23127,12 +23546,12 @@ SUBROUTINE SUBJ17 !WR_ASO3/WR_ORA2=0.0 ! !WR_ASO3/WR_MO2=+KR18*<WR_SO2> - PJAC(:,87,85)=+TPK%KR18(:)*PCONC(:,80) + PJAC(:,88,86)=+TPK%KR18(:)*PCONC(:,81) ! !WR_ASO3/WR_OP1=0.0 ! !WR_ASO3/WR_ASO3=-KR24*<W_O2> - PJAC(:,87,87)=-TPK%KR24(:)*TPK%W_O2(:) + PJAC(:,88,88)=-TPK%KR24(:)*TPK%W_O2(:) ! !WR_ASO3/WR_ASO4=0.0 ! @@ -23162,6 +23581,8 @@ SUBROUTINE SUBJ17 ! !WR_ASO4/NH3=0.0 ! +!WR_ASO4/DMS=0.0 +! !WR_ASO4/SO2=0.0 ! !WR_ASO4/SULF=0.0 @@ -23283,7 +23704,7 @@ SUBROUTINE SUBJ17 !WR_ASO4/WR_NO2=0.0 ! !WR_ASO4/WR_NO3=+KR15*<WR_SULF> - PJAC(:,88,71)=+TPK%KR15(:)*PCONC(:,81) + PJAC(:,89,72)=+TPK%KR15(:)*PCONC(:,82) ! !WR_ASO4/WR_N2O5=0.0 ! @@ -23304,7 +23725,7 @@ SUBROUTINE SUBJ17 !WR_ASO4/WR_SO2=0.0 ! !WR_ASO4/WR_SULF=+KR15*<WR_NO3> - PJAC(:,88,81)=+TPK%KR15(:)*PCONC(:,71) + PJAC(:,89,82)=+TPK%KR15(:)*PCONC(:,72) ! !WR_ASO4/WR_HCHO=0.0 ! @@ -23319,11 +23740,11 @@ SUBROUTINE SUBJ17 !WR_ASO4/WR_ASO3=0.0 ! !WR_ASO4/WR_ASO4=-KR28 - PJAC(:,88,88)=-TPK%KR28(:) + PJAC(:,89,89)=-TPK%KR28(:) ! !WR_ASO4/WR_ASO5=+KR26*<WR_ASO5>+KR26*<WR_ASO5>+KR26*<WR_ASO5>+KR26*<WR_ASO5> - PJAC(:,88,89)=+TPK%KR26(:)*PCONC(:,89)+TPK%KR26(:)*PCONC(:,89)+TPK%KR26(:)*PCO& -&NC(:,89)+TPK%KR26(:)*PCONC(:,89) + PJAC(:,89,90)=+TPK%KR26(:)*PCONC(:,90)+TPK%KR26(:)*PCONC(:,90)+TPK%KR26(:)*PCO& +&NC(:,90)+TPK%KR26(:)*PCONC(:,90) ! !WR_ASO4/WR_AHSO5=0.0 ! @@ -23349,6 +23770,8 @@ SUBROUTINE SUBJ17 ! !WR_ASO5/NH3=0.0 ! +!WR_ASO5/DMS=0.0 +! !WR_ASO5/SO2=0.0 ! !WR_ASO5/SULF=0.0 @@ -23484,7 +23907,7 @@ SUBROUTINE SUBJ17 !WR_ASO5/WR_OH=0.0 ! !WR_ASO5/WR_HO2=-KR25*<WR_ASO5> - PJAC(:,89,78)=-TPK%KR25(:)*PCONC(:,89) + PJAC(:,90,79)=-TPK%KR25(:)*PCONC(:,90) ! !WR_ASO5/WR_CO2=0.0 ! @@ -23503,19 +23926,27 @@ SUBROUTINE SUBJ17 !WR_ASO5/WR_OP1=0.0 ! !WR_ASO5/WR_ASO3=+KR24*<W_O2> - PJAC(:,89,87)=+TPK%KR24(:)*TPK%W_O2(:) + PJAC(:,90,88)=+TPK%KR24(:)*TPK%W_O2(:) ! !WR_ASO5/WR_ASO4=0.0 ! !WR_ASO5/WR_ASO5=-KR25*<WR_HO2>-KR26*<WR_ASO5>-KR26*<WR_ASO5>-KR26*<WR_ASO5>-KR !26*<WR_ASO5> - PJAC(:,89,89)=-TPK%KR25(:)*PCONC(:,78)-TPK%KR26(:)*PCONC(:,89)-TPK%KR26(:)*PCO& -&NC(:,89)-TPK%KR26(:)*PCONC(:,89)-TPK%KR26(:)*PCONC(:,89) + PJAC(:,90,90)=-TPK%KR25(:)*PCONC(:,79)-TPK%KR26(:)*PCONC(:,90)-TPK%KR26(:)*PCO& +&NC(:,90)-TPK%KR26(:)*PCONC(:,90)-TPK%KR26(:)*PCONC(:,90) ! !WR_ASO5/WR_AHSO5=0.0 ! !WR_ASO5/WR_AHMS=0.0 ! +RETURN +END SUBROUTINE SUBJ17 +! +SUBROUTINE SUBJ18 +! +!Indices 91 a 92 +! +! !WR_AHSO5/O3=0.0 ! !WR_AHSO5/H2O2=0.0 @@ -23536,6 +23967,8 @@ SUBROUTINE SUBJ17 ! !WR_AHSO5/NH3=0.0 ! +!WR_AHSO5/DMS=0.0 +! !WR_AHSO5/SO2=0.0 ! !WR_AHSO5/SULF=0.0 @@ -23671,12 +24104,12 @@ SUBROUTINE SUBJ17 !WR_AHSO5/WR_OH=0.0 ! !WR_AHSO5/WR_HO2=+KR25*<WR_ASO5> - PJAC(:,90,78)=+TPK%KR25(:)*PCONC(:,89) + PJAC(:,91,79)=+TPK%KR25(:)*PCONC(:,90) ! !WR_AHSO5/WR_CO2=0.0 ! !WR_AHSO5/WR_SO2=-KR27*<WR_AHSO5> - PJAC(:,90,80)=-TPK%KR27(:)*PCONC(:,90) + PJAC(:,91,81)=-TPK%KR27(:)*PCONC(:,91) ! !WR_AHSO5/WR_SULF=0.0 ! @@ -23695,21 +24128,13 @@ SUBROUTINE SUBJ17 !WR_AHSO5/WR_ASO4=0.0 ! !WR_AHSO5/WR_ASO5=+KR25*<WR_HO2> - PJAC(:,90,89)=+TPK%KR25(:)*PCONC(:,78) + PJAC(:,91,90)=+TPK%KR25(:)*PCONC(:,79) ! !WR_AHSO5/WR_AHSO5=-KR27*<WR_SO2> - PJAC(:,90,90)=-TPK%KR27(:)*PCONC(:,80) + PJAC(:,91,91)=-TPK%KR27(:)*PCONC(:,81) ! !WR_AHSO5/WR_AHMS=0.0 ! -RETURN -END SUBROUTINE SUBJ17 -! -SUBROUTINE SUBJ18 -! -!Indices 91 a 91 -! -! !WR_AHMS/O3=0.0 ! !WR_AHMS/H2O2=0.0 @@ -23730,6 +24155,8 @@ SUBROUTINE SUBJ18 ! !WR_AHMS/NH3=0.0 ! +!WR_AHMS/DMS=0.0 +! !WR_AHMS/SO2=0.0 ! !WR_AHMS/SULF=0.0 @@ -23863,19 +24290,19 @@ SUBROUTINE SUBJ18 !WR_AHMS/WR_NH3=0.0 ! !WR_AHMS/WR_OH=-KR23*<WR_AHMS> - PJAC(:,91,77)=-TPK%KR23(:)*PCONC(:,91) + PJAC(:,92,78)=-TPK%KR23(:)*PCONC(:,92) ! !WR_AHMS/WR_HO2=0.0 ! !WR_AHMS/WR_CO2=0.0 ! !WR_AHMS/WR_SO2=+KR21*<WR_HCHO> - PJAC(:,91,80)=+TPK%KR21(:)*PCONC(:,82) + PJAC(:,92,81)=+TPK%KR21(:)*PCONC(:,83) ! !WR_AHMS/WR_SULF=0.0 ! !WR_AHMS/WR_HCHO=+KR21*<WR_SO2> - PJAC(:,91,82)=+TPK%KR21(:)*PCONC(:,80) + PJAC(:,92,83)=+TPK%KR21(:)*PCONC(:,81) ! !WR_AHMS/WR_ORA1=0.0 ! @@ -23894,7 +24321,7 @@ SUBROUTINE SUBJ18 !WR_AHMS/WR_AHSO5=0.0 ! !WR_AHMS/WR_AHMS=-KR22-KR23*<WR_OH> - PJAC(:,91,91)=-TPK%KR22(:)-TPK%KR23(:)*PCONC(:,77) + PJAC(:,92,92)=-TPK%KR22(:)-TPK%KR23(:)*PCONC(:,78) ! RETURN END SUBROUTINE SUBJ18 @@ -23987,7 +24414,7 @@ TPK%O3P(:)=(TPK%K001(:)*PCONC(:,JP_NO2)+TPK%K003(:)*PCONC(:,JP_O3)+TPK%K008(:)*P &0.09000*TPK%K080(:)*PCONC(:,JP_BIO)*PCONC(:,JP_O3))/& &(TPK%K018(:)*TPK%O2(:)+TPK%K019(:)*PCONC(:,JP_O3)+TPK%K029(:)*PCONC(:,JP_NO)+& &TPK%K030(:)*PCONC(:,JP_NO2)+TPK%K031(:)*PCONC(:,JP_NO2)+TPK%K054(:)*PCONC(:,JP_BIO)+& - &TPK%K055(:)*PCONC(:,JP_CARBO)) + &TPK%K055(:)*PCONC(:,JP_CARBO)+TPK%K134(:)*PCONC(:,JP_DMS)) ! /END_CODE/ PJAC(:,:,:) = 0.0 CALL SUBJ0 @@ -24011,9 +24438,9 @@ SUBROUTINE SUBJ0 !O3/O3=-K002-K003-K019*<O3P>-K023*<OH>-K024*<HO2>-K042*<NO>-K043*<NO2>-K079*<AL !KE>-K080*<BIO>-K081*<CARBO>-K082*<PAN>-K087*<ADD> PJAC(:,1,1)=-TPK%K002(:)-TPK%K003(:)-TPK%K019(:)*TPK%O3P(:)-TPK%K023(:)*PCONC(& -&:,14)-TPK%K024(:)*PCONC(:,15)-TPK%K042(:)*PCONC(:,3)-TPK%K043(:)*PCONC(:,4)-TP& -&K%K079(:)*PCONC(:,19)-TPK%K080(:)*PCONC(:,20)-TPK%K081(:)*PCONC(:,25)-TPK%K082& -&(:)*PCONC(:,27)-TPK%K087(:)*PCONC(:,37) +&:,15)-TPK%K024(:)*PCONC(:,16)-TPK%K042(:)*PCONC(:,3)-TPK%K043(:)*PCONC(:,4)-TP& +&K%K079(:)*PCONC(:,20)-TPK%K080(:)*PCONC(:,21)-TPK%K081(:)*PCONC(:,26)-TPK%K082& +&(:)*PCONC(:,28)-TPK%K087(:)*PCONC(:,38) ! !O3/H2O2=0.0 ! @@ -24035,6 +24462,8 @@ SUBROUTINE SUBJ0 ! !O3/NH3=0.0 ! +!O3/DMS=0.0 +! !O3/SO2=0.0 ! !O3/SULF=0.0 @@ -24042,10 +24471,10 @@ SUBROUTINE SUBJ0 !O3/CO=0.0 ! !O3/OH=-K023*<O3> - PJAC(:,1,14)=-TPK%K023(:)*PCONC(:,1) + PJAC(:,1,15)=-TPK%K023(:)*PCONC(:,1) ! !O3/HO2=-K024*<O3>+0.17307*K0102*<CARBOP> - PJAC(:,1,15)=-TPK%K024(:)*PCONC(:,1)+0.17307*TPK%K0102(:)*PCONC(:,39) + PJAC(:,1,16)=-TPK%K024(:)*PCONC(:,1)+0.17307*TPK%K0102(:)*PCONC(:,40) ! !O3/CH4=0.0 ! @@ -24054,10 +24483,10 @@ SUBROUTINE SUBJ0 !O3/ALKA=0.0 ! !O3/ALKE=-K079*<O3> - PJAC(:,1,19)=-TPK%K079(:)*PCONC(:,1) + PJAC(:,1,20)=-TPK%K079(:)*PCONC(:,1) ! !O3/BIO=-K080*<O3> - PJAC(:,1,20)=-TPK%K080(:)*PCONC(:,1) + PJAC(:,1,21)=-TPK%K080(:)*PCONC(:,1) ! !O3/ARO=0.0 ! @@ -24068,12 +24497,12 @@ SUBROUTINE SUBJ0 !O3/KET=0.0 ! !O3/CARBO=-K081*<O3> - PJAC(:,1,25)=-TPK%K081(:)*PCONC(:,1) + PJAC(:,1,26)=-TPK%K081(:)*PCONC(:,1) ! !O3/ONIT=0.0 ! !O3/PAN=-K082*<O3> - PJAC(:,1,27)=-TPK%K082(:)*PCONC(:,1) + PJAC(:,1,28)=-TPK%K082(:)*PCONC(:,1) ! !O3/OP1=0.0 ! @@ -24094,22 +24523,22 @@ SUBROUTINE SUBJ0 !O3/PHO=0.0 ! !O3/ADD=-K087*<O3> - PJAC(:,1,37)=-TPK%K087(:)*PCONC(:,1) + PJAC(:,1,38)=-TPK%K087(:)*PCONC(:,1) ! !O3/AROP=0.0 ! !O3/CARBOP=+0.17307*K0102*<HO2> - PJAC(:,1,39)=+0.17307*TPK%K0102(:)*PCONC(:,15) + PJAC(:,1,40)=+0.17307*TPK%K0102(:)*PCONC(:,16) ! !O3/OLN=0.0 ! !O3/XO2=0.0 ! !H2O2/O3=+0.01833*K079*<ALKE>+0.00100*K080*<BIO> - PJAC(:,2,1)=+0.01833*TPK%K079(:)*PCONC(:,19)+0.00100*TPK%K080(:)*PCONC(:,20) + PJAC(:,2,1)=+0.01833*TPK%K079(:)*PCONC(:,20)+0.00100*TPK%K080(:)*PCONC(:,21) ! !H2O2/H2O2=-K009-K026*<OH> - PJAC(:,2,2)=-TPK%K009(:)-TPK%K026(:)*PCONC(:,14) + PJAC(:,2,2)=-TPK%K009(:)-TPK%K026(:)*PCONC(:,15) ! !H2O2/NO=0.0 ! @@ -24127,6 +24556,8 @@ SUBROUTINE SUBJ0 ! !H2O2/NH3=0.0 ! +!H2O2/DMS=0.0 +! !H2O2/SO2=0.0 ! !H2O2/SULF=0.0 @@ -24134,11 +24565,11 @@ SUBROUTINE SUBJ0 !H2O2/CO=0.0 ! !H2O2/OH=-K026*<H2O2> - PJAC(:,2,14)=-TPK%K026(:)*PCONC(:,2) + PJAC(:,2,15)=-TPK%K026(:)*PCONC(:,2) ! !H2O2/HO2=+K027*<HO2>+K027*<HO2>+K028*<HO2>*<H2O>+K028*<HO2>*<H2O> - PJAC(:,2,15)=+TPK%K027(:)*PCONC(:,15)+TPK%K027(:)*PCONC(:,15)+TPK%K028(:)*PCON& -&C(:,15)*TPK%H2O(:)+TPK%K028(:)*PCONC(:,15)*TPK%H2O(:) + PJAC(:,2,16)=+TPK%K027(:)*PCONC(:,16)+TPK%K027(:)*PCONC(:,16)+TPK%K028(:)*PCON& +&C(:,16)*TPK%H2O(:)+TPK%K028(:)*PCONC(:,16)*TPK%H2O(:) ! !H2O2/CH4=0.0 ! @@ -24147,10 +24578,10 @@ SUBROUTINE SUBJ0 !H2O2/ALKA=0.0 ! !H2O2/ALKE=+0.01833*K079*<O3> - PJAC(:,2,19)=+0.01833*TPK%K079(:)*PCONC(:,1) + PJAC(:,2,20)=+0.01833*TPK%K079(:)*PCONC(:,1) ! !H2O2/BIO=+0.00100*K080*<O3> - PJAC(:,2,20)=+0.00100*TPK%K080(:)*PCONC(:,1) + PJAC(:,2,21)=+0.00100*TPK%K080(:)*PCONC(:,1) ! !H2O2/ARO=0.0 ! @@ -24202,12 +24633,12 @@ SUBROUTINE SUBJ0 !NO/NO=-K029*<O3P>-K032*<OH>-K035*<HO2>-K042*<O3>-K044*<NO>*<O2>-K044*<NO>*<O2> !-K044*<NO>*<O2>-K044*<NO>*<O2>-K045*<NO3>-K090*<MO2>-K091*<ALKAP>-K092*<ALKEP> !-K093*<BIOP>-K094*<AROP>-K095*<CARBOP>-K096*<OLN>-K130*<XO2> - PJAC(:,3,3)=-TPK%K029(:)*TPK%O3P(:)-TPK%K032(:)*PCONC(:,14)-TPK%K035(:)*PCONC(& -&:,15)-TPK%K042(:)*PCONC(:,1)-TPK%K044(:)*PCONC(:,3)*TPK%O2(:)-TPK%K044(:)*PCON& + PJAC(:,3,3)=-TPK%K029(:)*TPK%O3P(:)-TPK%K032(:)*PCONC(:,15)-TPK%K035(:)*PCONC(& +&:,16)-TPK%K042(:)*PCONC(:,1)-TPK%K044(:)*PCONC(:,3)*TPK%O2(:)-TPK%K044(:)*PCON& &C(:,3)*TPK%O2(:)-TPK%K044(:)*PCONC(:,3)*TPK%O2(:)-TPK%K044(:)*PCONC(:,3)*TPK%O& -&2(:)-TPK%K045(:)*PCONC(:,5)-TPK%K090(:)*PCONC(:,32)-TPK%K091(:)*PCONC(:,33)-TP& -&K%K092(:)*PCONC(:,34)-TPK%K093(:)*PCONC(:,35)-TPK%K094(:)*PCONC(:,38)-TPK%K095& -&(:)*PCONC(:,39)-TPK%K096(:)*PCONC(:,40)-TPK%K130(:)*PCONC(:,41) +&2(:)-TPK%K045(:)*PCONC(:,5)-TPK%K090(:)*PCONC(:,33)-TPK%K091(:)*PCONC(:,34)-TP& +&K%K092(:)*PCONC(:,35)-TPK%K093(:)*PCONC(:,36)-TPK%K094(:)*PCONC(:,39)-TPK%K095& +&(:)*PCONC(:,40)-TPK%K096(:)*PCONC(:,41)-TPK%K130(:)*PCONC(:,42) ! !NO/NO2=+K001+K030*<O3P>+K046*<NO3> PJAC(:,3,4)=+TPK%K001(:)+TPK%K030(:)*TPK%O3P(:)+TPK%K046(:)*PCONC(:,5) @@ -24226,6 +24657,8 @@ SUBROUTINE SUBJ0 ! !NO/NH3=0.0 ! +!NO/DMS=0.0 +! !NO/SO2=0.0 ! !NO/SULF=0.0 @@ -24233,10 +24666,10 @@ SUBROUTINE SUBJ0 !NO/CO=0.0 ! !NO/OH=-K032*<NO> - PJAC(:,3,14)=-TPK%K032(:)*PCONC(:,3) + PJAC(:,3,15)=-TPK%K032(:)*PCONC(:,3) ! !NO/HO2=-K035*<NO> - PJAC(:,3,15)=-TPK%K035(:)*PCONC(:,3) + PJAC(:,3,16)=-TPK%K035(:)*PCONC(:,3) ! !NO/CH4=0.0 ! @@ -24271,36 +24704,36 @@ SUBROUTINE SUBJ0 !NO/ORA2=0.0 ! !NO/MO2=-K090*<NO> - PJAC(:,3,32)=-TPK%K090(:)*PCONC(:,3) + PJAC(:,3,33)=-TPK%K090(:)*PCONC(:,3) ! !NO/ALKAP=-K091*<NO> - PJAC(:,3,33)=-TPK%K091(:)*PCONC(:,3) + PJAC(:,3,34)=-TPK%K091(:)*PCONC(:,3) ! !NO/ALKEP=-K092*<NO> - PJAC(:,3,34)=-TPK%K092(:)*PCONC(:,3) + PJAC(:,3,35)=-TPK%K092(:)*PCONC(:,3) ! !NO/BIOP=-K093*<NO> - PJAC(:,3,35)=-TPK%K093(:)*PCONC(:,3) + PJAC(:,3,36)=-TPK%K093(:)*PCONC(:,3) ! !NO/PHO=0.0 ! !NO/ADD=0.0 ! !NO/AROP=-K094*<NO> - PJAC(:,3,38)=-TPK%K094(:)*PCONC(:,3) + PJAC(:,3,39)=-TPK%K094(:)*PCONC(:,3) ! !NO/CARBOP=-K095*<NO> - PJAC(:,3,39)=-TPK%K095(:)*PCONC(:,3) + PJAC(:,3,40)=-TPK%K095(:)*PCONC(:,3) ! !NO/OLN=-K096*<NO> - PJAC(:,3,40)=-TPK%K096(:)*PCONC(:,3) + PJAC(:,3,41)=-TPK%K096(:)*PCONC(:,3) ! !NO/XO2=-K130*<NO> - PJAC(:,3,41)=-TPK%K130(:)*PCONC(:,3) + PJAC(:,3,42)=-TPK%K130(:)*PCONC(:,3) ! !NO2/O3=+K042*<NO>-K043*<NO2>+0.70*K082*<PAN> PJAC(:,4,1)=+TPK%K042(:)*PCONC(:,3)-TPK%K043(:)*PCONC(:,4)+0.70*TPK%K082(:)*PC& -&ONC(:,27) +&ONC(:,28) ! !NO2/H2O2=0.0 ! @@ -24308,47 +24741,51 @@ SUBROUTINE SUBJ0 !>*<O2>+K044*<NO>*<O2>+K045*<NO3>+K045*<NO3>+K090*<MO2>+0.91541*K091*<ALKAP>+K0 !92*<ALKEP>+0.84700*K093*<BIOP>+0.95115*K094*<AROP>+K095*<CARBOP>+1.81599*K096* !<OLN>+K130*<XO2> - PJAC(:,4,3)=+TPK%K029(:)*TPK%O3P(:)+TPK%K035(:)*PCONC(:,15)+TPK%K042(:)*PCONC(& + PJAC(:,4,3)=+TPK%K029(:)*TPK%O3P(:)+TPK%K035(:)*PCONC(:,16)+TPK%K042(:)*PCONC(& &:,1)+TPK%K044(:)*PCONC(:,3)*TPK%O2(:)+TPK%K044(:)*PCONC(:,3)*TPK%O2(:)+TPK%K04& &4(:)*PCONC(:,3)*TPK%O2(:)+TPK%K044(:)*PCONC(:,3)*TPK%O2(:)+TPK%K045(:)*PCONC(:& -&,5)+TPK%K045(:)*PCONC(:,5)+TPK%K090(:)*PCONC(:,32)+0.91541*TPK%K091(:)*PCONC(:& -&,33)+TPK%K092(:)*PCONC(:,34)+0.84700*TPK%K093(:)*PCONC(:,35)+0.95115*TPK%K094(& -&:)*PCONC(:,38)+TPK%K095(:)*PCONC(:,39)+1.81599*TPK%K096(:)*PCONC(:,40)+TPK%K13& -&0(:)*PCONC(:,41) +&,5)+TPK%K045(:)*PCONC(:,5)+TPK%K090(:)*PCONC(:,33)+0.91541*TPK%K091(:)*PCONC(:& +&,34)+TPK%K092(:)*PCONC(:,35)+0.84700*TPK%K093(:)*PCONC(:,36)+0.95115*TPK%K094(& +&:)*PCONC(:,39)+TPK%K095(:)*PCONC(:,40)+1.81599*TPK%K096(:)*PCONC(:,41)+TPK%K13& +&0(:)*PCONC(:,42) ! !NO2/NO2=-K001-K030*<O3P>-K031*<O3P>-K033*<OH>-K036*<HO2>-K043*<O3>+K046*<NO3>- !K046*<NO3>-K047*<NO3>-K083*<PHO>-K085*<ADD>-K088*<CARBOP> PJAC(:,4,4)=-TPK%K001(:)-TPK%K030(:)*TPK%O3P(:)-TPK%K031(:)*TPK%O3P(:)-TPK%K03& -&3(:)*PCONC(:,14)-TPK%K036(:)*PCONC(:,15)-TPK%K043(:)*PCONC(:,1)+TPK%K046(:)*PC& -&ONC(:,5)-TPK%K046(:)*PCONC(:,5)-TPK%K047(:)*PCONC(:,5)-TPK%K083(:)*PCONC(:,36)& -&-TPK%K085(:)*PCONC(:,37)-TPK%K088(:)*PCONC(:,39) +&3(:)*PCONC(:,15)-TPK%K036(:)*PCONC(:,16)-TPK%K043(:)*PCONC(:,1)+TPK%K046(:)*PC& +&ONC(:,5)-TPK%K046(:)*PCONC(:,5)-TPK%K047(:)*PCONC(:,5)-TPK%K083(:)*PCONC(:,37)& +&-TPK%K085(:)*PCONC(:,38)-TPK%K088(:)*PCONC(:,40) ! !NO2/NO3=+K008+K034*<OH>+0.7*K038*<HO2>+K045*<NO>+K045*<NO>+K046*<NO2>-K046*<NO !2>-K047*<NO2>+K049*<NO3>+K049*<NO3>+K049*<NO3>+K049*<NO3>+0.10530*K074*<CARBO> !+0.40*K078*<PAN>+K119*<MO2>+K120*<ALKAP>+K121*<ALKEP>+K122*<BIOP>+K123*<AROP>+ -!K124*<CARBOP>+1.74072*K125*<OLN>+K131*<XO2> - PJAC(:,4,5)=+TPK%K008(:)+TPK%K034(:)*PCONC(:,14)+0.7*TPK%K038(:)*PCONC(:,15)+T& +!K124*<CARBOP>+1.74072*K125*<OLN>+K131*<XO2>+K133*<DMS> + PJAC(:,4,5)=+TPK%K008(:)+TPK%K034(:)*PCONC(:,15)+0.7*TPK%K038(:)*PCONC(:,16)+T& &PK%K045(:)*PCONC(:,3)+TPK%K045(:)*PCONC(:,3)+TPK%K046(:)*PCONC(:,4)-TPK%K046(:& &)*PCONC(:,4)-TPK%K047(:)*PCONC(:,4)+TPK%K049(:)*PCONC(:,5)+TPK%K049(:)*PCONC(:& &,5)+TPK%K049(:)*PCONC(:,5)+TPK%K049(:)*PCONC(:,5)+0.10530*TPK%K074(:)*PCONC(:,& -&25)+0.40*TPK%K078(:)*PCONC(:,27)+TPK%K119(:)*PCONC(:,32)+TPK%K120(:)*PCONC(:,3& -&3)+TPK%K121(:)*PCONC(:,34)+TPK%K122(:)*PCONC(:,35)+TPK%K123(:)*PCONC(:,38)+TPK& -&%K124(:)*PCONC(:,39)+1.74072*TPK%K125(:)*PCONC(:,40)+TPK%K131(:)*PCONC(:,41) +&26)+0.40*TPK%K078(:)*PCONC(:,28)+TPK%K119(:)*PCONC(:,33)+TPK%K120(:)*PCONC(:,3& +&4)+TPK%K121(:)*PCONC(:,35)+TPK%K122(:)*PCONC(:,36)+TPK%K123(:)*PCONC(:,39)+TPK& +&%K124(:)*PCONC(:,40)+1.74072*TPK%K125(:)*PCONC(:,41)+TPK%K131(:)*PCONC(:,42)+T& +&PK%K133(:)*PCONC(:,11) ! !NO2/N2O5=+K048 PJAC(:,4,6)=+TPK%K048(:) ! !NO2/HONO=+K039*<OH> - PJAC(:,4,7)=+TPK%K039(:)*PCONC(:,14) + PJAC(:,4,7)=+TPK%K039(:)*PCONC(:,15) ! !NO2/HNO3=+K005 PJAC(:,4,8)=+TPK%K005(:) ! !NO2/HNO4=+0.65*K006+K037+K041*<OH> - PJAC(:,4,9)=+0.65*TPK%K006(:)+TPK%K037(:)+TPK%K041(:)*PCONC(:,14) + PJAC(:,4,9)=+0.65*TPK%K006(:)+TPK%K037(:)+TPK%K041(:)*PCONC(:,15) ! !NO2/NH3=0.0 ! +!NO2/DMS=+K133*<NO3> + PJAC(:,4,11)=+TPK%K133(:)*PCONC(:,5) +! !NO2/SO2=0.0 ! !NO2/SULF=0.0 @@ -24356,11 +24793,11 @@ SUBROUTINE SUBJ0 !NO2/CO=0.0 ! !NO2/OH=-K033*<NO2>+K034*<NO3>+K039*<HONO>+K041*<HNO4>+K071*<ONIT> - PJAC(:,4,14)=-TPK%K033(:)*PCONC(:,4)+TPK%K034(:)*PCONC(:,5)+TPK%K039(:)*PCONC(& -&:,7)+TPK%K041(:)*PCONC(:,9)+TPK%K071(:)*PCONC(:,26) + PJAC(:,4,15)=-TPK%K033(:)*PCONC(:,4)+TPK%K034(:)*PCONC(:,5)+TPK%K039(:)*PCONC(& +&:,7)+TPK%K041(:)*PCONC(:,9)+TPK%K071(:)*PCONC(:,27) ! !NO2/HO2=+K035*<NO>-K036*<NO2>+0.7*K038*<NO3> - PJAC(:,4,15)=+TPK%K035(:)*PCONC(:,3)-TPK%K036(:)*PCONC(:,4)+0.7*TPK%K038(:)*PC& + PJAC(:,4,16)=+TPK%K035(:)*PCONC(:,3)-TPK%K036(:)*PCONC(:,4)+0.7*TPK%K038(:)*PC& &ONC(:,5) ! !NO2/CH4=0.0 @@ -24382,13 +24819,13 @@ SUBROUTINE SUBJ0 !NO2/KET=0.0 ! !NO2/CARBO=+0.10530*K074*<NO3> - PJAC(:,4,25)=+0.10530*TPK%K074(:)*PCONC(:,5) + PJAC(:,4,26)=+0.10530*TPK%K074(:)*PCONC(:,5) ! !NO2/ONIT=+K017+K071*<OH> - PJAC(:,4,26)=+TPK%K017(:)+TPK%K071(:)*PCONC(:,14) + PJAC(:,4,27)=+TPK%K017(:)+TPK%K071(:)*PCONC(:,15) ! !NO2/PAN=+0.40*K078*<NO3>+0.70*K082*<O3>+K089 - PJAC(:,4,27)=+0.40*TPK%K078(:)*PCONC(:,5)+0.70*TPK%K082(:)*PCONC(:,1)+TPK%K089& + PJAC(:,4,28)=+0.40*TPK%K078(:)*PCONC(:,5)+0.70*TPK%K082(:)*PCONC(:,1)+TPK%K089& &(:) ! !NO2/OP1=0.0 @@ -24400,39 +24837,39 @@ SUBROUTINE SUBJ0 !NO2/ORA2=0.0 ! !NO2/MO2=+K090*<NO>+0.32440*K110*<OLN>+K119*<NO3> - PJAC(:,4,32)=+TPK%K090(:)*PCONC(:,3)+0.32440*TPK%K110(:)*PCONC(:,40)+TPK%K119(& + PJAC(:,4,33)=+TPK%K090(:)*PCONC(:,3)+0.32440*TPK%K110(:)*PCONC(:,41)+TPK%K119(& &:)*PCONC(:,5) ! !NO2/ALKAP=+0.91541*K091*<NO>+K120*<NO3> - PJAC(:,4,33)=+0.91541*TPK%K091(:)*PCONC(:,3)+TPK%K120(:)*PCONC(:,5) + PJAC(:,4,34)=+0.91541*TPK%K091(:)*PCONC(:,3)+TPK%K120(:)*PCONC(:,5) ! !NO2/ALKEP=+K092*<NO>+K121*<NO3> - PJAC(:,4,34)=+TPK%K092(:)*PCONC(:,3)+TPK%K121(:)*PCONC(:,5) + PJAC(:,4,35)=+TPK%K092(:)*PCONC(:,3)+TPK%K121(:)*PCONC(:,5) ! !NO2/BIOP=+0.84700*K093*<NO>+K122*<NO3> - PJAC(:,4,35)=+0.84700*TPK%K093(:)*PCONC(:,3)+TPK%K122(:)*PCONC(:,5) + PJAC(:,4,36)=+0.84700*TPK%K093(:)*PCONC(:,3)+TPK%K122(:)*PCONC(:,5) ! !NO2/PHO=-K083*<NO2> - PJAC(:,4,36)=-TPK%K083(:)*PCONC(:,4) + PJAC(:,4,37)=-TPK%K083(:)*PCONC(:,4) ! !NO2/ADD=-K085*<NO2> - PJAC(:,4,37)=-TPK%K085(:)*PCONC(:,4) + PJAC(:,4,38)=-TPK%K085(:)*PCONC(:,4) ! !NO2/AROP=+0.95115*K094*<NO>+K123*<NO3> - PJAC(:,4,38)=+0.95115*TPK%K094(:)*PCONC(:,3)+TPK%K123(:)*PCONC(:,5) + PJAC(:,4,39)=+0.95115*TPK%K094(:)*PCONC(:,3)+TPK%K123(:)*PCONC(:,5) ! !NO2/CARBOP=-K088*<NO2>+K095*<NO>+0.00000*K116*<OLN>+K124*<NO3> - PJAC(:,4,39)=-TPK%K088(:)*PCONC(:,4)+TPK%K095(:)*PCONC(:,3)+0.00000*TPK%K116(:& -&)*PCONC(:,40)+TPK%K124(:)*PCONC(:,5) + PJAC(:,4,40)=-TPK%K088(:)*PCONC(:,4)+TPK%K095(:)*PCONC(:,3)+0.00000*TPK%K116(:& +&)*PCONC(:,41)+TPK%K124(:)*PCONC(:,5) ! !NO2/OLN=+1.81599*K096*<NO>+0.32440*K110*<MO2>+0.00000*K116*<CARBOP>+0.00000*K1 !18*<OLN>+0.00000*K118*<OLN>+1.74072*K125*<NO3> - PJAC(:,4,40)=+1.81599*TPK%K096(:)*PCONC(:,3)+0.32440*TPK%K110(:)*PCONC(:,32)+0& -&.00000*TPK%K116(:)*PCONC(:,39)+0.00000*TPK%K118(:)*PCONC(:,40)+0.00000*TPK%K11& -&8(:)*PCONC(:,40)+1.74072*TPK%K125(:)*PCONC(:,5) + PJAC(:,4,41)=+1.81599*TPK%K096(:)*PCONC(:,3)+0.32440*TPK%K110(:)*PCONC(:,33)+0& +&.00000*TPK%K116(:)*PCONC(:,40)+0.00000*TPK%K118(:)*PCONC(:,41)+0.00000*TPK%K11& +&8(:)*PCONC(:,41)+1.74072*TPK%K125(:)*PCONC(:,5) ! !NO2/XO2=+K130*<NO>+K131*<NO3> - PJAC(:,4,41)=+TPK%K130(:)*PCONC(:,3)+TPK%K131(:)*PCONC(:,5) + PJAC(:,4,42)=+TPK%K130(:)*PCONC(:,3)+TPK%K131(:)*PCONC(:,5) ! !NO3/O3=+K043*<NO2> PJAC(:,5,1)=+TPK%K043(:)*PCONC(:,4) @@ -24449,16 +24886,17 @@ SUBROUTINE SUBJ0 !NO3/NO3=-K007-K008-K034*<OH>-K038*<HO2>-K045*<NO>-K046*<NO2>-K047*<NO2>-K049*< !NO3>-K049*<NO3>-K049*<NO3>-K049*<NO3>-K072*<HCHO>-K073*<ALD>-K074*<CARBO>-K075 !*<ARO>-K076*<ALKE>-K077*<BIO>+0.60*K078*<PAN>-K078*<PAN>-K119*<MO2>-K120*<ALKA -!P>-K121*<ALKEP>-K122*<BIOP>-K123*<AROP>-K124*<CARBOP>-K125*<OLN>-K131*<XO2> - PJAC(:,5,5)=-TPK%K007(:)-TPK%K008(:)-TPK%K034(:)*PCONC(:,14)-TPK%K038(:)*PCONC& -&(:,15)-TPK%K045(:)*PCONC(:,3)-TPK%K046(:)*PCONC(:,4)-TPK%K047(:)*PCONC(:,4)-TP& +!P>-K121*<ALKEP>-K122*<BIOP>-K123*<AROP>-K124*<CARBOP>-K125*<OLN>-K131*<XO2>-K1 +!33*<DMS> + PJAC(:,5,5)=-TPK%K007(:)-TPK%K008(:)-TPK%K034(:)*PCONC(:,15)-TPK%K038(:)*PCONC& +&(:,16)-TPK%K045(:)*PCONC(:,3)-TPK%K046(:)*PCONC(:,4)-TPK%K047(:)*PCONC(:,4)-TP& &K%K049(:)*PCONC(:,5)-TPK%K049(:)*PCONC(:,5)-TPK%K049(:)*PCONC(:,5)-TPK%K049(:)& -&*PCONC(:,5)-TPK%K072(:)*PCONC(:,22)-TPK%K073(:)*PCONC(:,23)-TPK%K074(:)*PCONC(& -&:,25)-TPK%K075(:)*PCONC(:,21)-TPK%K076(:)*PCONC(:,19)-TPK%K077(:)*PCONC(:,20)+& -&0.60*TPK%K078(:)*PCONC(:,27)-TPK%K078(:)*PCONC(:,27)-TPK%K119(:)*PCONC(:,32)-T& -&PK%K120(:)*PCONC(:,33)-TPK%K121(:)*PCONC(:,34)-TPK%K122(:)*PCONC(:,35)-TPK%K12& -&3(:)*PCONC(:,38)-TPK%K124(:)*PCONC(:,39)-TPK%K125(:)*PCONC(:,40)-TPK%K131(:)*P& -&CONC(:,41) +&*PCONC(:,5)-TPK%K072(:)*PCONC(:,23)-TPK%K073(:)*PCONC(:,24)-TPK%K074(:)*PCONC(& +&:,26)-TPK%K075(:)*PCONC(:,22)-TPK%K076(:)*PCONC(:,20)-TPK%K077(:)*PCONC(:,21)+& +&0.60*TPK%K078(:)*PCONC(:,28)-TPK%K078(:)*PCONC(:,28)-TPK%K119(:)*PCONC(:,33)-T& +&PK%K120(:)*PCONC(:,34)-TPK%K121(:)*PCONC(:,35)-TPK%K122(:)*PCONC(:,36)-TPK%K12& +&3(:)*PCONC(:,39)-TPK%K124(:)*PCONC(:,40)-TPK%K125(:)*PCONC(:,41)-TPK%K131(:)*P& +&CONC(:,42)-TPK%K133(:)*PCONC(:,11) ! !NO3/N2O5=+K048 PJAC(:,5,6)=+TPK%K048(:) @@ -24466,13 +24904,16 @@ SUBROUTINE SUBJ0 !NO3/HONO=0.0 ! !NO3/HNO3=+K040*<OH> - PJAC(:,5,8)=+TPK%K040(:)*PCONC(:,14) + PJAC(:,5,8)=+TPK%K040(:)*PCONC(:,15) ! !NO3/HNO4=+0.35*K006 PJAC(:,5,9)=+0.35*TPK%K006(:) ! !NO3/NH3=0.0 ! +!NO3/DMS=-K133*<NO3> + PJAC(:,5,11)=-TPK%K133(:)*PCONC(:,5) +! !NO3/SO2=0.0 ! !NO3/SULF=0.0 @@ -24480,11 +24921,11 @@ SUBROUTINE SUBJ0 !NO3/CO=0.0 ! !NO3/OH=-K034*<NO3>+K040*<HNO3>+0.71893*K070*<PAN> - PJAC(:,5,14)=-TPK%K034(:)*PCONC(:,5)+TPK%K040(:)*PCONC(:,8)+0.71893*TPK%K070(:& -&)*PCONC(:,27) + PJAC(:,5,15)=-TPK%K034(:)*PCONC(:,5)+TPK%K040(:)*PCONC(:,8)+0.71893*TPK%K070(:& +&)*PCONC(:,28) ! !NO3/HO2=-K038*<NO3> - PJAC(:,5,15)=-TPK%K038(:)*PCONC(:,5) + PJAC(:,5,16)=-TPK%K038(:)*PCONC(:,5) ! !NO3/CH4=0.0 ! @@ -24493,29 +24934,29 @@ SUBROUTINE SUBJ0 !NO3/ALKA=0.0 ! !NO3/ALKE=-K076*<NO3> - PJAC(:,5,19)=-TPK%K076(:)*PCONC(:,5) + PJAC(:,5,20)=-TPK%K076(:)*PCONC(:,5) ! !NO3/BIO=-K077*<NO3> - PJAC(:,5,20)=-TPK%K077(:)*PCONC(:,5) + PJAC(:,5,21)=-TPK%K077(:)*PCONC(:,5) ! !NO3/ARO=-K075*<NO3> - PJAC(:,5,21)=-TPK%K075(:)*PCONC(:,5) + PJAC(:,5,22)=-TPK%K075(:)*PCONC(:,5) ! !NO3/HCHO=-K072*<NO3> - PJAC(:,5,22)=-TPK%K072(:)*PCONC(:,5) + PJAC(:,5,23)=-TPK%K072(:)*PCONC(:,5) ! !NO3/ALD=-K073*<NO3> - PJAC(:,5,23)=-TPK%K073(:)*PCONC(:,5) + PJAC(:,5,24)=-TPK%K073(:)*PCONC(:,5) ! !NO3/KET=0.0 ! !NO3/CARBO=-K074*<NO3> - PJAC(:,5,25)=-TPK%K074(:)*PCONC(:,5) + PJAC(:,5,26)=-TPK%K074(:)*PCONC(:,5) ! !NO3/ONIT=0.0 ! !NO3/PAN=+0.71893*K070*<OH>+0.60*K078*<NO3>-K078*<NO3> - PJAC(:,5,27)=+0.71893*TPK%K070(:)*PCONC(:,14)+0.60*TPK%K078(:)*PCONC(:,5)-TPK%& + PJAC(:,5,28)=+0.71893*TPK%K070(:)*PCONC(:,15)+0.60*TPK%K078(:)*PCONC(:,5)-TPK%& &K078(:)*PCONC(:,5) ! !NO3/OP1=0.0 @@ -24527,32 +24968,32 @@ SUBROUTINE SUBJ0 !NO3/ORA2=0.0 ! !NO3/MO2=-K119*<NO3> - PJAC(:,5,32)=-TPK%K119(:)*PCONC(:,5) + PJAC(:,5,33)=-TPK%K119(:)*PCONC(:,5) ! !NO3/ALKAP=-K120*<NO3> - PJAC(:,5,33)=-TPK%K120(:)*PCONC(:,5) + PJAC(:,5,34)=-TPK%K120(:)*PCONC(:,5) ! !NO3/ALKEP=-K121*<NO3> - PJAC(:,5,34)=-TPK%K121(:)*PCONC(:,5) + PJAC(:,5,35)=-TPK%K121(:)*PCONC(:,5) ! !NO3/BIOP=-K122*<NO3> - PJAC(:,5,35)=-TPK%K122(:)*PCONC(:,5) + PJAC(:,5,36)=-TPK%K122(:)*PCONC(:,5) ! !NO3/PHO=0.0 ! !NO3/ADD=0.0 ! !NO3/AROP=-K123*<NO3> - PJAC(:,5,38)=-TPK%K123(:)*PCONC(:,5) + PJAC(:,5,39)=-TPK%K123(:)*PCONC(:,5) ! !NO3/CARBOP=-K124*<NO3> - PJAC(:,5,39)=-TPK%K124(:)*PCONC(:,5) + PJAC(:,5,40)=-TPK%K124(:)*PCONC(:,5) ! !NO3/OLN=-K125*<NO3> - PJAC(:,5,40)=-TPK%K125(:)*PCONC(:,5) + PJAC(:,5,41)=-TPK%K125(:)*PCONC(:,5) ! !NO3/XO2=-K131*<NO3> - PJAC(:,5,41)=-TPK%K131(:)*PCONC(:,5) + PJAC(:,5,42)=-TPK%K131(:)*PCONC(:,5) ! RETURN END SUBROUTINE SUBJ0 @@ -24585,6 +25026,8 @@ SUBROUTINE SUBJ1 ! !N2O5/NH3=0.0 ! +!N2O5/DMS=0.0 +! !N2O5/SO2=0.0 ! !N2O5/SULF=0.0 @@ -24652,17 +25095,17 @@ SUBROUTINE SUBJ1 !HONO/H2O2=0.0 ! !HONO/NO=+K032*<OH> - PJAC(:,7,3)=+TPK%K032(:)*PCONC(:,14) + PJAC(:,7,3)=+TPK%K032(:)*PCONC(:,15) ! !HONO/NO2=+K085*<ADD> - PJAC(:,7,4)=+TPK%K085(:)*PCONC(:,37) + PJAC(:,7,4)=+TPK%K085(:)*PCONC(:,38) ! !HONO/NO3=0.0 ! !HONO/N2O5=0.0 ! !HONO/HONO=-K004-K039*<OH> - PJAC(:,7,7)=-TPK%K004(:)-TPK%K039(:)*PCONC(:,14) + PJAC(:,7,7)=-TPK%K004(:)-TPK%K039(:)*PCONC(:,15) ! !HONO/HNO3=0.0 ! @@ -24670,6 +25113,8 @@ SUBROUTINE SUBJ1 ! !HONO/NH3=0.0 ! +!HONO/DMS=0.0 +! !HONO/SO2=0.0 ! !HONO/SULF=0.0 @@ -24677,7 +25122,7 @@ SUBROUTINE SUBJ1 !HONO/CO=0.0 ! !HONO/OH=+K032*<NO>-K039*<HONO> - PJAC(:,7,14)=+TPK%K032(:)*PCONC(:,3)-TPK%K039(:)*PCONC(:,7) + PJAC(:,7,15)=+TPK%K032(:)*PCONC(:,3)-TPK%K039(:)*PCONC(:,7) ! !HONO/HO2=0.0 ! @@ -24724,7 +25169,7 @@ SUBROUTINE SUBJ1 !HONO/PHO=0.0 ! !HONO/ADD=+K085*<NO2> - PJAC(:,7,37)=+TPK%K085(:)*PCONC(:,4) + PJAC(:,7,38)=+TPK%K085(:)*PCONC(:,4) ! !HONO/AROP=0.0 ! @@ -24741,24 +25186,26 @@ SUBROUTINE SUBJ1 !HNO3/NO=0.0 ! !HNO3/NO2=+K033*<OH> - PJAC(:,8,4)=+TPK%K033(:)*PCONC(:,14) + PJAC(:,8,4)=+TPK%K033(:)*PCONC(:,15) ! !HNO3/NO3=+0.3*K038*<HO2>+K072*<HCHO>+K073*<ALD>+0.91567*K074*<CARBO>+K075*<ARO !> - PJAC(:,8,5)=+0.3*TPK%K038(:)*PCONC(:,15)+TPK%K072(:)*PCONC(:,22)+TPK%K073(:)*P& -&CONC(:,23)+0.91567*TPK%K074(:)*PCONC(:,25)+TPK%K075(:)*PCONC(:,21) + PJAC(:,8,5)=+0.3*TPK%K038(:)*PCONC(:,16)+TPK%K072(:)*PCONC(:,23)+TPK%K073(:)*P& +&CONC(:,24)+0.91567*TPK%K074(:)*PCONC(:,26)+TPK%K075(:)*PCONC(:,22) ! !HNO3/N2O5=0.0 ! !HNO3/HONO=0.0 ! !HNO3/HNO3=-K005-K040*<OH> - PJAC(:,8,8)=-TPK%K005(:)-TPK%K040(:)*PCONC(:,14) + PJAC(:,8,8)=-TPK%K005(:)-TPK%K040(:)*PCONC(:,15) ! !HNO3/HNO4=0.0 ! !HNO3/NH3=0.0 ! +!HNO3/DMS=0.0 +! !HNO3/SO2=0.0 ! !HNO3/SULF=0.0 @@ -24766,10 +25213,10 @@ SUBROUTINE SUBJ1 !HNO3/CO=0.0 ! !HNO3/OH=+K033*<NO2>-K040*<HNO3> - PJAC(:,8,14)=+TPK%K033(:)*PCONC(:,4)-TPK%K040(:)*PCONC(:,8) + PJAC(:,8,15)=+TPK%K033(:)*PCONC(:,4)-TPK%K040(:)*PCONC(:,8) ! !HNO3/HO2=+0.3*K038*<NO3> - PJAC(:,8,15)=+0.3*TPK%K038(:)*PCONC(:,5) + PJAC(:,8,16)=+0.3*TPK%K038(:)*PCONC(:,5) ! !HNO3/CH4=0.0 ! @@ -24782,18 +25229,18 @@ SUBROUTINE SUBJ1 !HNO3/BIO=0.0 ! !HNO3/ARO=+K075*<NO3> - PJAC(:,8,21)=+TPK%K075(:)*PCONC(:,5) + PJAC(:,8,22)=+TPK%K075(:)*PCONC(:,5) ! !HNO3/HCHO=+K072*<NO3> - PJAC(:,8,22)=+TPK%K072(:)*PCONC(:,5) + PJAC(:,8,23)=+TPK%K072(:)*PCONC(:,5) ! !HNO3/ALD=+K073*<NO3> - PJAC(:,8,23)=+TPK%K073(:)*PCONC(:,5) + PJAC(:,8,24)=+TPK%K073(:)*PCONC(:,5) ! !HNO3/KET=0.0 ! !HNO3/CARBO=+0.91567*K074*<NO3> - PJAC(:,8,25)=+0.91567*TPK%K074(:)*PCONC(:,5) + PJAC(:,8,26)=+0.91567*TPK%K074(:)*PCONC(:,5) ! !HNO3/ONIT=0.0 ! @@ -24834,7 +25281,7 @@ SUBROUTINE SUBJ1 !HNO4/NO=0.0 ! !HNO4/NO2=+K036*<HO2> - PJAC(:,9,4)=+TPK%K036(:)*PCONC(:,15) + PJAC(:,9,4)=+TPK%K036(:)*PCONC(:,16) ! !HNO4/NO3=0.0 ! @@ -24845,10 +25292,12 @@ SUBROUTINE SUBJ1 !HNO4/HNO3=0.0 ! !HNO4/HNO4=-K006-K037-K041*<OH> - PJAC(:,9,9)=-TPK%K006(:)-TPK%K037(:)-TPK%K041(:)*PCONC(:,14) + PJAC(:,9,9)=-TPK%K006(:)-TPK%K037(:)-TPK%K041(:)*PCONC(:,15) ! !HNO4/NH3=0.0 ! +!HNO4/DMS=0.0 +! !HNO4/SO2=0.0 ! !HNO4/SULF=0.0 @@ -24856,10 +25305,10 @@ SUBROUTINE SUBJ1 !HNO4/CO=0.0 ! !HNO4/OH=-K041*<HNO4> - PJAC(:,9,14)=-TPK%K041(:)*PCONC(:,9) + PJAC(:,9,15)=-TPK%K041(:)*PCONC(:,9) ! !HNO4/HO2=+K036*<NO2> - PJAC(:,9,15)=+TPK%K036(:)*PCONC(:,4) + PJAC(:,9,16)=+TPK%K036(:)*PCONC(:,4) ! !HNO4/CH4=0.0 ! @@ -24932,7 +25381,9 @@ SUBROUTINE SUBJ1 !NH3/HNO4=0.0 ! !NH3/NH3=-K050*<OH> - PJAC(:,10,10)=-TPK%K050(:)*PCONC(:,14) + PJAC(:,10,10)=-TPK%K050(:)*PCONC(:,15) +! +!NH3/DMS=0.0 ! !NH3/SO2=0.0 ! @@ -24941,7 +25392,7 @@ SUBROUTINE SUBJ1 !NH3/CO=0.0 ! !NH3/OH=-K050*<NH3> - PJAC(:,10,14)=-TPK%K050(:)*PCONC(:,10) + PJAC(:,10,15)=-TPK%K050(:)*PCONC(:,10) ! !NH3/HO2=0.0 ! @@ -25005,6 +25456,94 @@ SUBROUTINE SUBJ2 !Indices 11 a 15 ! ! +!DMS/O3=0.0 +! +!DMS/H2O2=0.0 +! +!DMS/NO=0.0 +! +!DMS/NO2=0.0 +! +!DMS/NO3=-K133*<DMS> + PJAC(:,11,5)=-TPK%K133(:)*PCONC(:,11) +! +!DMS/N2O5=0.0 +! +!DMS/HONO=0.0 +! +!DMS/HNO3=0.0 +! +!DMS/HNO4=0.0 +! +!DMS/NH3=0.0 +! +!DMS/DMS=-K133*<NO3>-K134*<O3P>-K135*<OH> + PJAC(:,11,11)=-TPK%K133(:)*PCONC(:,5)-TPK%K134(:)*TPK%O3P(:)-TPK%K135(:)*PCONC& +&(:,15) +! +!DMS/SO2=0.0 +! +!DMS/SULF=0.0 +! +!DMS/CO=0.0 +! +!DMS/OH=-K135*<DMS> + PJAC(:,11,15)=-TPK%K135(:)*PCONC(:,11) +! +!DMS/HO2=0.0 +! +!DMS/CH4=0.0 +! +!DMS/ETH=0.0 +! +!DMS/ALKA=0.0 +! +!DMS/ALKE=0.0 +! +!DMS/BIO=0.0 +! +!DMS/ARO=0.0 +! +!DMS/HCHO=0.0 +! +!DMS/ALD=0.0 +! +!DMS/KET=0.0 +! +!DMS/CARBO=0.0 +! +!DMS/ONIT=0.0 +! +!DMS/PAN=0.0 +! +!DMS/OP1=0.0 +! +!DMS/OP2=0.0 +! +!DMS/ORA1=0.0 +! +!DMS/ORA2=0.0 +! +!DMS/MO2=0.0 +! +!DMS/ALKAP=0.0 +! +!DMS/ALKEP=0.0 +! +!DMS/BIOP=0.0 +! +!DMS/PHO=0.0 +! +!DMS/ADD=0.0 +! +!DMS/AROP=0.0 +! +!DMS/CARBOP=0.0 +! +!DMS/OLN=0.0 +! +!DMS/XO2=0.0 +! !SO2/O3=0.0 ! !SO2/H2O2=0.0 @@ -25013,7 +25552,8 @@ SUBROUTINE SUBJ2 ! !SO2/NO2=0.0 ! -!SO2/NO3=0.0 +!SO2/NO3=+K133*<DMS> + PJAC(:,12,5)=+TPK%K133(:)*PCONC(:,11) ! !SO2/N2O5=0.0 ! @@ -25025,15 +25565,19 @@ SUBROUTINE SUBJ2 ! !SO2/NH3=0.0 ! +!SO2/DMS=+K133*<NO3>+K134*<O3P>+0.8*K135*<OH> + PJAC(:,12,11)=+TPK%K133(:)*PCONC(:,5)+TPK%K134(:)*TPK%O3P(:)+0.8*TPK%K135(:)*P& +&CONC(:,15) +! !SO2/SO2=-K052*<OH> - PJAC(:,11,11)=-TPK%K052(:)*PCONC(:,14) + PJAC(:,12,12)=-TPK%K052(:)*PCONC(:,15) ! !SO2/SULF=0.0 ! !SO2/CO=0.0 ! -!SO2/OH=-K052*<SO2> - PJAC(:,11,14)=-TPK%K052(:)*PCONC(:,11) +!SO2/OH=-K052*<SO2>+0.8*K135*<DMS> + PJAC(:,12,15)=-TPK%K052(:)*PCONC(:,12)+0.8*TPK%K135(:)*PCONC(:,11) ! !SO2/HO2=0.0 ! @@ -25109,16 +25653,18 @@ SUBROUTINE SUBJ2 ! !SULF/NH3=0.0 ! +!SULF/DMS=0.0 +! !SULF/SO2=+K052*<OH> - PJAC(:,12,11)=+TPK%K052(:)*PCONC(:,14) + PJAC(:,13,12)=+TPK%K052(:)*PCONC(:,15) ! !SULF/SULF=-K132 - PJAC(:,12,12)=-TPK%K132(:) + PJAC(:,13,13)=-TPK%K132(:) ! !SULF/CO=0.0 ! !SULF/OH=+K052*<SO2> - PJAC(:,12,14)=+TPK%K052(:)*PCONC(:,11) + PJAC(:,13,15)=+TPK%K052(:)*PCONC(:,12) ! !SULF/HO2=0.0 ! @@ -25176,8 +25722,8 @@ SUBROUTINE SUBJ2 ! !CO/O3=+0.35120*K079*<ALKE>+0.36000*K080*<BIO>+0.64728*K081*<CARBO>+0.13*K082*< !PAN> - PJAC(:,13,1)=+0.35120*TPK%K079(:)*PCONC(:,19)+0.36000*TPK%K080(:)*PCONC(:,20)+& -&0.64728*TPK%K081(:)*PCONC(:,25)+0.13*TPK%K082(:)*PCONC(:,27) + PJAC(:,14,1)=+0.35120*TPK%K079(:)*PCONC(:,20)+0.36000*TPK%K080(:)*PCONC(:,21)+& +&0.64728*TPK%K081(:)*PCONC(:,26)+0.13*TPK%K082(:)*PCONC(:,28) ! !CO/H2O2=0.0 ! @@ -25186,7 +25732,7 @@ SUBROUTINE SUBJ2 !CO/NO2=0.0 ! !CO/NO3=+K072*<HCHO>+1.33723*K074*<CARBO> - PJAC(:,13,5)=+TPK%K072(:)*PCONC(:,22)+1.33723*TPK%K074(:)*PCONC(:,25) + PJAC(:,14,5)=+TPK%K072(:)*PCONC(:,23)+1.33723*TPK%K074(:)*PCONC(:,26) ! !CO/N2O5=0.0 ! @@ -25198,16 +25744,18 @@ SUBROUTINE SUBJ2 ! !CO/NH3=0.0 ! +!CO/DMS=0.0 +! !CO/SO2=0.0 ! !CO/SULF=0.0 ! !CO/CO=-K053*<OH> - PJAC(:,13,13)=-TPK%K053(:)*PCONC(:,14) + PJAC(:,14,14)=-TPK%K053(:)*PCONC(:,15) ! !CO/OH=-K053*<CO>+0.00878*K058*<ALKA>+K062*<HCHO>+1.01732*K065*<CARBO> - PJAC(:,13,14)=-TPK%K053(:)*PCONC(:,13)+0.00878*TPK%K058(:)*PCONC(:,18)+TPK%K06& -&2(:)*PCONC(:,22)+1.01732*TPK%K065(:)*PCONC(:,25) + PJAC(:,14,15)=-TPK%K053(:)*PCONC(:,14)+0.00878*TPK%K058(:)*PCONC(:,19)+TPK%K06& +&2(:)*PCONC(:,23)+1.01732*TPK%K065(:)*PCONC(:,26) ! !CO/HO2=0.0 ! @@ -25216,33 +25764,33 @@ SUBROUTINE SUBJ2 !CO/ETH=0.0 ! !CO/ALKA=+0.00878*K058*<OH> - PJAC(:,13,18)=+0.00878*TPK%K058(:)*PCONC(:,14) + PJAC(:,14,19)=+0.00878*TPK%K058(:)*PCONC(:,15) ! !CO/ALKE=+0.35120*K079*<O3> - PJAC(:,13,19)=+0.35120*TPK%K079(:)*PCONC(:,1) + PJAC(:,14,20)=+0.35120*TPK%K079(:)*PCONC(:,1) ! !CO/BIO=+0.01*K054*<O3P>+0.36000*K080*<O3> - PJAC(:,13,20)=+0.01*TPK%K054(:)*TPK%O3P(:)+0.36000*TPK%K080(:)*PCONC(:,1) + PJAC(:,14,21)=+0.01*TPK%K054(:)*TPK%O3P(:)+0.36000*TPK%K080(:)*PCONC(:,1) ! !CO/ARO=0.0 ! !CO/HCHO=+K010+K011+K062*<OH>+K072*<NO3> - PJAC(:,13,22)=+TPK%K010(:)+TPK%K011(:)+TPK%K062(:)*PCONC(:,14)+TPK%K072(:)*PCO& + PJAC(:,14,23)=+TPK%K010(:)+TPK%K011(:)+TPK%K062(:)*PCONC(:,15)+TPK%K072(:)*PCO& &NC(:,5) ! !CO/ALD=+K012 - PJAC(:,13,23)=+TPK%K012(:) + PJAC(:,14,24)=+TPK%K012(:) ! !CO/KET=0.0 ! !CO/CARBO=+0.91924*K016+1.01732*K065*<OH>+1.33723*K074*<NO3>+0.64728*K081*<O3> - PJAC(:,13,25)=+0.91924*TPK%K016(:)+1.01732*TPK%K065(:)*PCONC(:,14)+1.33723*TPK& + PJAC(:,14,26)=+0.91924*TPK%K016(:)+1.01732*TPK%K065(:)*PCONC(:,15)+1.33723*TPK& &%K074(:)*PCONC(:,5)+0.64728*TPK%K081(:)*PCONC(:,1) ! !CO/ONIT=0.0 ! !CO/PAN=+0.13*K082*<O3> - PJAC(:,13,27)=+0.13*TPK%K082(:)*PCONC(:,1) + PJAC(:,14,28)=+0.13*TPK%K082(:)*PCONC(:,1) ! !CO/OP1=0.0 ! @@ -25274,115 +25822,119 @@ SUBROUTINE SUBJ2 ! !OH/O3=-K023*<OH>+K024*<HO2>+0.39435*K079*<ALKE>+0.28000*K080*<BIO>+0.20595*K08 !1*<CARBO>+0.036*K082*<PAN>+K087*<ADD> - PJAC(:,14,1)=-TPK%K023(:)*PCONC(:,14)+TPK%K024(:)*PCONC(:,15)+0.39435*TPK%K079& -&(:)*PCONC(:,19)+0.28000*TPK%K080(:)*PCONC(:,20)+0.20595*TPK%K081(:)*PCONC(:,25& -&)+0.036*TPK%K082(:)*PCONC(:,27)+TPK%K087(:)*PCONC(:,37) + PJAC(:,15,1)=-TPK%K023(:)*PCONC(:,15)+TPK%K024(:)*PCONC(:,16)+0.39435*TPK%K079& +&(:)*PCONC(:,20)+0.28000*TPK%K080(:)*PCONC(:,21)+0.20595*TPK%K081(:)*PCONC(:,26& +&)+0.036*TPK%K082(:)*PCONC(:,28)+TPK%K087(:)*PCONC(:,38) ! !OH/H2O2=+K009+K009-K026*<OH> - PJAC(:,14,2)=+TPK%K009(:)+TPK%K009(:)-TPK%K026(:)*PCONC(:,14) + PJAC(:,15,2)=+TPK%K009(:)+TPK%K009(:)-TPK%K026(:)*PCONC(:,15) ! !OH/NO=-K032*<OH>+K035*<HO2> - PJAC(:,14,3)=-TPK%K032(:)*PCONC(:,14)+TPK%K035(:)*PCONC(:,15) + PJAC(:,15,3)=-TPK%K032(:)*PCONC(:,15)+TPK%K035(:)*PCONC(:,16) ! !OH/NO2=-K033*<OH> - PJAC(:,14,4)=-TPK%K033(:)*PCONC(:,14) + PJAC(:,15,4)=-TPK%K033(:)*PCONC(:,15) ! !OH/NO3=-K034*<OH>+0.7*K038*<HO2> - PJAC(:,14,5)=-TPK%K034(:)*PCONC(:,14)+0.7*TPK%K038(:)*PCONC(:,15) + PJAC(:,15,5)=-TPK%K034(:)*PCONC(:,15)+0.7*TPK%K038(:)*PCONC(:,16) ! !OH/N2O5=0.0 ! !OH/HONO=+K004-K039*<OH> - PJAC(:,14,7)=+TPK%K004(:)-TPK%K039(:)*PCONC(:,14) + PJAC(:,15,7)=+TPK%K004(:)-TPK%K039(:)*PCONC(:,15) ! !OH/HNO3=+K005-K040*<OH> - PJAC(:,14,8)=+TPK%K005(:)-TPK%K040(:)*PCONC(:,14) + PJAC(:,15,8)=+TPK%K005(:)-TPK%K040(:)*PCONC(:,15) ! !OH/HNO4=+0.35*K006-K041*<OH> - PJAC(:,14,9)=+0.35*TPK%K006(:)-TPK%K041(:)*PCONC(:,14) + PJAC(:,15,9)=+0.35*TPK%K006(:)-TPK%K041(:)*PCONC(:,15) ! !OH/NH3=-K050*<OH> - PJAC(:,14,10)=-TPK%K050(:)*PCONC(:,14) + PJAC(:,15,10)=-TPK%K050(:)*PCONC(:,15) +! +!OH/DMS=-K135*<OH> + PJAC(:,15,11)=-TPK%K135(:)*PCONC(:,15) ! !OH/SO2=-K052*<OH> - PJAC(:,14,11)=-TPK%K052(:)*PCONC(:,14) + PJAC(:,15,12)=-TPK%K052(:)*PCONC(:,15) ! !OH/SULF=0.0 ! !OH/CO=-K053*<OH> - PJAC(:,14,13)=-TPK%K053(:)*PCONC(:,14) + PJAC(:,15,14)=-TPK%K053(:)*PCONC(:,15) ! !OH/OH=-K023*<O3>-K025*<HO2>-K026*<H2O2>-K032*<NO>-K033*<NO2>-K034*<NO3>-K039*< !HONO>-K040*<HNO3>-K041*<HNO4>-K050*<NH3>-K051*<H2>-K052*<SO2>-K053*<CO>-K056*< !CH4>-K057*<ETH>+0.00878*K058*<ALKA>-K058*<ALKA>-K059*<ALKE>-K060*<BIO>-K061*<A !RO>-K062*<HCHO>-K063*<ALD>-K064*<KET>-K065*<CARBO>-K066*<ORA1>-K067*<ORA2>+0.3 -!5*K068*<OP1>-K068*<OP1>+0.44925*K069*<OP2>-K069*<OP2>-K070*<PAN>-K071*<ONIT> - PJAC(:,14,14)=-TPK%K023(:)*PCONC(:,1)-TPK%K025(:)*PCONC(:,15)-TPK%K026(:)*PCON& +!5*K068*<OP1>-K068*<OP1>+0.44925*K069*<OP2>-K069*<OP2>-K070*<PAN>-K071*<ONIT>-K +!135*<DMS> + PJAC(:,15,15)=-TPK%K023(:)*PCONC(:,1)-TPK%K025(:)*PCONC(:,16)-TPK%K026(:)*PCON& &C(:,2)-TPK%K032(:)*PCONC(:,3)-TPK%K033(:)*PCONC(:,4)-TPK%K034(:)*PCONC(:,5)-TP& &K%K039(:)*PCONC(:,7)-TPK%K040(:)*PCONC(:,8)-TPK%K041(:)*PCONC(:,9)-TPK%K050(:)& -&*PCONC(:,10)-TPK%K051(:)*TPK%H2(:)-TPK%K052(:)*PCONC(:,11)-TPK%K053(:)*PCONC(:& -&,13)-TPK%K056(:)*PCONC(:,16)-TPK%K057(:)*PCONC(:,17)+0.00878*TPK%K058(:)*PCONC& -&(:,18)-TPK%K058(:)*PCONC(:,18)-TPK%K059(:)*PCONC(:,19)-TPK%K060(:)*PCONC(:,20)& -&-TPK%K061(:)*PCONC(:,21)-TPK%K062(:)*PCONC(:,22)-TPK%K063(:)*PCONC(:,23)-TPK%K& -&064(:)*PCONC(:,24)-TPK%K065(:)*PCONC(:,25)-TPK%K066(:)*PCONC(:,30)-TPK%K067(:)& -&*PCONC(:,31)+0.35*TPK%K068(:)*PCONC(:,28)-TPK%K068(:)*PCONC(:,28)+0.44925*TPK%& -&K069(:)*PCONC(:,29)-TPK%K069(:)*PCONC(:,29)-TPK%K070(:)*PCONC(:,27)-TPK%K071(:& -&)*PCONC(:,26) +&*PCONC(:,10)-TPK%K051(:)*TPK%H2(:)-TPK%K052(:)*PCONC(:,12)-TPK%K053(:)*PCONC(:& +&,14)-TPK%K056(:)*PCONC(:,17)-TPK%K057(:)*PCONC(:,18)+0.00878*TPK%K058(:)*PCONC& +&(:,19)-TPK%K058(:)*PCONC(:,19)-TPK%K059(:)*PCONC(:,20)-TPK%K060(:)*PCONC(:,21)& +&-TPK%K061(:)*PCONC(:,22)-TPK%K062(:)*PCONC(:,23)-TPK%K063(:)*PCONC(:,24)-TPK%K& +&064(:)*PCONC(:,25)-TPK%K065(:)*PCONC(:,26)-TPK%K066(:)*PCONC(:,31)-TPK%K067(:)& +&*PCONC(:,32)+0.35*TPK%K068(:)*PCONC(:,29)-TPK%K068(:)*PCONC(:,29)+0.44925*TPK%& +&K069(:)*PCONC(:,30)-TPK%K069(:)*PCONC(:,30)-TPK%K070(:)*PCONC(:,28)-TPK%K071(:& +&)*PCONC(:,27)-TPK%K135(:)*PCONC(:,11) ! !OH/HO2=+K024*<O3>-K025*<OH>+K035*<NO>+0.7*K038*<NO3> - PJAC(:,14,15)=+TPK%K024(:)*PCONC(:,1)-TPK%K025(:)*PCONC(:,14)+TPK%K035(:)*PCON& + PJAC(:,15,16)=+TPK%K024(:)*PCONC(:,1)-TPK%K025(:)*PCONC(:,15)+TPK%K035(:)*PCON& &C(:,3)+0.7*TPK%K038(:)*PCONC(:,5) ! !OH/CH4=-K056*<OH> - PJAC(:,14,16)=-TPK%K056(:)*PCONC(:,14) + PJAC(:,15,17)=-TPK%K056(:)*PCONC(:,15) ! !OH/ETH=-K057*<OH> - PJAC(:,14,17)=-TPK%K057(:)*PCONC(:,14) + PJAC(:,15,18)=-TPK%K057(:)*PCONC(:,15) ! !OH/ALKA=+0.00878*K058*<OH>-K058*<OH> - PJAC(:,14,18)=+0.00878*TPK%K058(:)*PCONC(:,14)-TPK%K058(:)*PCONC(:,14) + PJAC(:,15,19)=+0.00878*TPK%K058(:)*PCONC(:,15)-TPK%K058(:)*PCONC(:,15) ! !OH/ALKE=-K059*<OH>+0.39435*K079*<O3> - PJAC(:,14,19)=-TPK%K059(:)*PCONC(:,14)+0.39435*TPK%K079(:)*PCONC(:,1) + PJAC(:,15,20)=-TPK%K059(:)*PCONC(:,15)+0.39435*TPK%K079(:)*PCONC(:,1) ! !OH/BIO=+0.02*K054*<O3P>-K060*<OH>+0.28000*K080*<O3> - PJAC(:,14,20)=+0.02*TPK%K054(:)*TPK%O3P(:)-TPK%K060(:)*PCONC(:,14)+0.28000*TPK& + PJAC(:,15,21)=+0.02*TPK%K054(:)*TPK%O3P(:)-TPK%K060(:)*PCONC(:,15)+0.28000*TPK& &%K080(:)*PCONC(:,1) ! !OH/ARO=-K061*<OH> - PJAC(:,14,21)=-TPK%K061(:)*PCONC(:,14) + PJAC(:,15,22)=-TPK%K061(:)*PCONC(:,15) ! !OH/HCHO=-K062*<OH> - PJAC(:,14,22)=-TPK%K062(:)*PCONC(:,14) + PJAC(:,15,23)=-TPK%K062(:)*PCONC(:,15) ! !OH/ALD=-K063*<OH> - PJAC(:,14,23)=-TPK%K063(:)*PCONC(:,14) + PJAC(:,15,24)=-TPK%K063(:)*PCONC(:,15) ! !OH/KET=-K064*<OH> - PJAC(:,14,24)=-TPK%K064(:)*PCONC(:,14) + PJAC(:,15,25)=-TPK%K064(:)*PCONC(:,15) ! !OH/CARBO=-K065*<OH>+0.20595*K081*<O3> - PJAC(:,14,25)=-TPK%K065(:)*PCONC(:,14)+0.20595*TPK%K081(:)*PCONC(:,1) + PJAC(:,15,26)=-TPK%K065(:)*PCONC(:,15)+0.20595*TPK%K081(:)*PCONC(:,1) ! !OH/ONIT=-K071*<OH> - PJAC(:,14,26)=-TPK%K071(:)*PCONC(:,14) + PJAC(:,15,27)=-TPK%K071(:)*PCONC(:,15) ! !OH/PAN=-K070*<OH>+0.036*K082*<O3> - PJAC(:,14,27)=-TPK%K070(:)*PCONC(:,14)+0.036*TPK%K082(:)*PCONC(:,1) + PJAC(:,15,28)=-TPK%K070(:)*PCONC(:,15)+0.036*TPK%K082(:)*PCONC(:,1) ! !OH/OP1=+K013+0.35*K068*<OH>-K068*<OH> - PJAC(:,14,28)=+TPK%K013(:)+0.35*TPK%K068(:)*PCONC(:,14)-TPK%K068(:)*PCONC(:,14& + PJAC(:,15,29)=+TPK%K013(:)+0.35*TPK%K068(:)*PCONC(:,15)-TPK%K068(:)*PCONC(:,15& &) ! !OH/OP2=+K014+0.44925*K069*<OH>-K069*<OH> - PJAC(:,14,29)=+TPK%K014(:)+0.44925*TPK%K069(:)*PCONC(:,14)-TPK%K069(:)*PCONC(:& -&,14) + PJAC(:,15,30)=+TPK%K014(:)+0.44925*TPK%K069(:)*PCONC(:,15)-TPK%K069(:)*PCONC(:& +&,15) ! !OH/ORA1=-K066*<OH> - PJAC(:,14,30)=-TPK%K066(:)*PCONC(:,14) + PJAC(:,15,31)=-TPK%K066(:)*PCONC(:,15) ! !OH/ORA2=-K067*<OH> - PJAC(:,14,31)=-TPK%K067(:)*PCONC(:,14) + PJAC(:,15,32)=-TPK%K067(:)*PCONC(:,15) ! !OH/MO2=0.0 ! @@ -25395,7 +25947,7 @@ SUBROUTINE SUBJ2 !OH/PHO=0.0 ! !OH/ADD=+K087*<O3> - PJAC(:,14,37)=+TPK%K087(:)*PCONC(:,1) + PJAC(:,15,38)=+TPK%K087(:)*PCONC(:,1) ! !OH/AROP=0.0 ! @@ -25405,32 +25957,40 @@ SUBROUTINE SUBJ2 ! !OH/XO2=0.0 ! +RETURN +END SUBROUTINE SUBJ2 +! +SUBROUTINE SUBJ3 +! +!Indices 16 a 20 +! +! !HO2/O3=+K023*<OH>-K024*<HO2>+0.23451*K079*<ALKE>+0.30000*K080*<BIO>+0.28441*K0 !81*<CARBO>+0.08*K082*<PAN> - PJAC(:,15,1)=+TPK%K023(:)*PCONC(:,14)-TPK%K024(:)*PCONC(:,15)+0.23451*TPK%K079& -&(:)*PCONC(:,19)+0.30000*TPK%K080(:)*PCONC(:,20)+0.28441*TPK%K081(:)*PCONC(:,25& -&)+0.08*TPK%K082(:)*PCONC(:,27) + PJAC(:,16,1)=+TPK%K023(:)*PCONC(:,15)-TPK%K024(:)*PCONC(:,16)+0.23451*TPK%K079& +&(:)*PCONC(:,20)+0.30000*TPK%K080(:)*PCONC(:,21)+0.28441*TPK%K081(:)*PCONC(:,26& +&)+0.08*TPK%K082(:)*PCONC(:,28) ! !HO2/H2O2=+K026*<OH> - PJAC(:,15,2)=+TPK%K026(:)*PCONC(:,14) + PJAC(:,16,2)=+TPK%K026(:)*PCONC(:,15) ! !HO2/NO=-K035*<HO2>+K090*<MO2>+0.74265*K091*<ALKAP>+K092*<ALKEP>+0.84700*K093*< !BIOP>+0.95115*K094*<AROP>+0.12334*K095*<CARBOP>+0.18401*K096*<OLN> - PJAC(:,15,3)=-TPK%K035(:)*PCONC(:,15)+TPK%K090(:)*PCONC(:,32)+0.74265*TPK%K091& -&(:)*PCONC(:,33)+TPK%K092(:)*PCONC(:,34)+0.84700*TPK%K093(:)*PCONC(:,35)+0.9511& -&5*TPK%K094(:)*PCONC(:,38)+0.12334*TPK%K095(:)*PCONC(:,39)+0.18401*TPK%K096(:)*& -&PCONC(:,40) + PJAC(:,16,3)=-TPK%K035(:)*PCONC(:,16)+TPK%K090(:)*PCONC(:,33)+0.74265*TPK%K091& +&(:)*PCONC(:,34)+TPK%K092(:)*PCONC(:,35)+0.84700*TPK%K093(:)*PCONC(:,36)+0.9511& +&5*TPK%K094(:)*PCONC(:,39)+0.12334*TPK%K095(:)*PCONC(:,40)+0.18401*TPK%K096(:)*& +&PCONC(:,41) ! !HO2/NO2=-K036*<HO2> - PJAC(:,15,4)=-TPK%K036(:)*PCONC(:,15) + PJAC(:,16,4)=-TPK%K036(:)*PCONC(:,16) ! !HO2/NO3=+K034*<OH>-K038*<HO2>+K072*<HCHO>+0.63217*K074*<CARBO>+K119*<MO2>+0.81 !290*K120*<ALKAP>+K121*<ALKEP>+K122*<BIOP>+K123*<AROP>+0.04915*K124*<CARBOP>+0. !25928*K125*<OLN> - PJAC(:,15,5)=+TPK%K034(:)*PCONC(:,14)-TPK%K038(:)*PCONC(:,15)+TPK%K072(:)*PCON& -&C(:,22)+0.63217*TPK%K074(:)*PCONC(:,25)+TPK%K119(:)*PCONC(:,32)+0.81290*TPK%K1& -&20(:)*PCONC(:,33)+TPK%K121(:)*PCONC(:,34)+TPK%K122(:)*PCONC(:,35)+TPK%K123(:)*& -&PCONC(:,38)+0.04915*TPK%K124(:)*PCONC(:,39)+0.25928*TPK%K125(:)*PCONC(:,40) + PJAC(:,16,5)=+TPK%K034(:)*PCONC(:,15)-TPK%K038(:)*PCONC(:,16)+TPK%K072(:)*PCON& +&C(:,23)+0.63217*TPK%K074(:)*PCONC(:,26)+TPK%K119(:)*PCONC(:,33)+0.81290*TPK%K1& +&20(:)*PCONC(:,34)+TPK%K121(:)*PCONC(:,35)+TPK%K122(:)*PCONC(:,36)+TPK%K123(:)*& +&PCONC(:,39)+0.04915*TPK%K124(:)*PCONC(:,40)+0.25928*TPK%K125(:)*PCONC(:,41) ! !HO2/N2O5=0.0 ! @@ -25439,152 +25999,146 @@ SUBROUTINE SUBJ2 !HO2/HNO3=0.0 ! !HO2/HNO4=+0.65*K006+K037 - PJAC(:,15,9)=+0.65*TPK%K006(:)+TPK%K037(:) + PJAC(:,16,9)=+0.65*TPK%K006(:)+TPK%K037(:) ! !HO2/NH3=0.0 ! +!HO2/DMS=0.0 +! !HO2/SO2=+K052*<OH> - PJAC(:,15,11)=+TPK%K052(:)*PCONC(:,14) + PJAC(:,16,12)=+TPK%K052(:)*PCONC(:,15) ! !HO2/SULF=0.0 ! !HO2/CO=+K053*<OH> - PJAC(:,15,13)=+TPK%K053(:)*PCONC(:,14) + PJAC(:,16,14)=+TPK%K053(:)*PCONC(:,15) ! !HO2/OH=+K023*<O3>-K025*<HO2>+K026*<H2O2>+K034*<NO3>+K051*<H2>+K052*<SO2>+K053* !<CO>+0.12793*K058*<ALKA>+0.10318*K061*<ARO>+K062*<HCHO>+0.51208*K065*<CARBO>+K !066*<ORA1>+0.02915*K069*<OP2>+0.28107*K070*<PAN> - PJAC(:,15,14)=+TPK%K023(:)*PCONC(:,1)-TPK%K025(:)*PCONC(:,15)+TPK%K026(:)*PCON& -&C(:,2)+TPK%K034(:)*PCONC(:,5)+TPK%K051(:)*TPK%H2(:)+TPK%K052(:)*PCONC(:,11)+TP& -&K%K053(:)*PCONC(:,13)+0.12793*TPK%K058(:)*PCONC(:,18)+0.10318*TPK%K061(:)*PCON& -&C(:,21)+TPK%K062(:)*PCONC(:,22)+0.51208*TPK%K065(:)*PCONC(:,25)+TPK%K066(:)*PC& -&ONC(:,30)+0.02915*TPK%K069(:)*PCONC(:,29)+0.28107*TPK%K070(:)*PCONC(:,27) + PJAC(:,16,15)=+TPK%K023(:)*PCONC(:,1)-TPK%K025(:)*PCONC(:,16)+TPK%K026(:)*PCON& +&C(:,2)+TPK%K034(:)*PCONC(:,5)+TPK%K051(:)*TPK%H2(:)+TPK%K052(:)*PCONC(:,12)+TP& +&K%K053(:)*PCONC(:,14)+0.12793*TPK%K058(:)*PCONC(:,19)+0.10318*TPK%K061(:)*PCON& +&C(:,22)+TPK%K062(:)*PCONC(:,23)+0.51208*TPK%K065(:)*PCONC(:,26)+TPK%K066(:)*PC& +&ONC(:,31)+0.02915*TPK%K069(:)*PCONC(:,30)+0.28107*TPK%K070(:)*PCONC(:,28) ! !HO2/HO2=-K024*<O3>-K025*<OH>-K027*<HO2>-K027*<HO2>-K027*<HO2>-K027*<HO2>-K028* !<HO2>*<H2O>-K028*<HO2>*<H2O>-K028*<HO2>*<H2O>-K028*<HO2>*<H2O>-K035*<NO>-K036* !<NO2>-K038*<NO3>-K084*<PHO>-K097*<MO2>-K098*<ALKAP>-K099*<ALKEP>-K0100*<BIOP>- !K0101*<AROP>-K0102*<CARBOP>-K103*<OLN>-K126*<XO2> - PJAC(:,15,15)=-TPK%K024(:)*PCONC(:,1)-TPK%K025(:)*PCONC(:,14)-TPK%K027(:)*PCON& -&C(:,15)-TPK%K027(:)*PCONC(:,15)-TPK%K027(:)*PCONC(:,15)-TPK%K027(:)*PCONC(:,15& -&)-TPK%K028(:)*PCONC(:,15)*TPK%H2O(:)-TPK%K028(:)*PCONC(:,15)*TPK%H2O(:)-TPK%K0& -&28(:)*PCONC(:,15)*TPK%H2O(:)-TPK%K028(:)*PCONC(:,15)*TPK%H2O(:)-TPK%K035(:)*PC& -&ONC(:,3)-TPK%K036(:)*PCONC(:,4)-TPK%K038(:)*PCONC(:,5)-TPK%K084(:)*PCONC(:,36)& -&-TPK%K097(:)*PCONC(:,32)-TPK%K098(:)*PCONC(:,33)-TPK%K099(:)*PCONC(:,34)-TPK%K& -&0100(:)*PCONC(:,35)-TPK%K0101(:)*PCONC(:,38)-TPK%K0102(:)*PCONC(:,39)-TPK%K103& -&(:)*PCONC(:,40)-TPK%K126(:)*PCONC(:,41) + PJAC(:,16,16)=-TPK%K024(:)*PCONC(:,1)-TPK%K025(:)*PCONC(:,15)-TPK%K027(:)*PCON& +&C(:,16)-TPK%K027(:)*PCONC(:,16)-TPK%K027(:)*PCONC(:,16)-TPK%K027(:)*PCONC(:,16& +&)-TPK%K028(:)*PCONC(:,16)*TPK%H2O(:)-TPK%K028(:)*PCONC(:,16)*TPK%H2O(:)-TPK%K0& +&28(:)*PCONC(:,16)*TPK%H2O(:)-TPK%K028(:)*PCONC(:,16)*TPK%H2O(:)-TPK%K035(:)*PC& +&ONC(:,3)-TPK%K036(:)*PCONC(:,4)-TPK%K038(:)*PCONC(:,5)-TPK%K084(:)*PCONC(:,37)& +&-TPK%K097(:)*PCONC(:,33)-TPK%K098(:)*PCONC(:,34)-TPK%K099(:)*PCONC(:,35)-TPK%K& +&0100(:)*PCONC(:,36)-TPK%K0101(:)*PCONC(:,39)-TPK%K0102(:)*PCONC(:,40)-TPK%K103& +&(:)*PCONC(:,41)-TPK%K126(:)*PCONC(:,42) ! !HO2/CH4=0.0 ! !HO2/ETH=0.0 ! !HO2/ALKA=+0.12793*K058*<OH> - PJAC(:,15,18)=+0.12793*TPK%K058(:)*PCONC(:,14) + PJAC(:,16,19)=+0.12793*TPK%K058(:)*PCONC(:,15) ! !HO2/ALKE=+0.23451*K079*<O3> - PJAC(:,15,19)=+0.23451*TPK%K079(:)*PCONC(:,1) + PJAC(:,16,20)=+0.23451*TPK%K079(:)*PCONC(:,1) ! !HO2/BIO=+0.28*K054*<O3P>+0.30000*K080*<O3> - PJAC(:,15,20)=+0.28*TPK%K054(:)*TPK%O3P(:)+0.30000*TPK%K080(:)*PCONC(:,1) + PJAC(:,16,21)=+0.28*TPK%K054(:)*TPK%O3P(:)+0.30000*TPK%K080(:)*PCONC(:,1) ! !HO2/ARO=+0.10318*K061*<OH> - PJAC(:,15,21)=+0.10318*TPK%K061(:)*PCONC(:,14) + PJAC(:,16,22)=+0.10318*TPK%K061(:)*PCONC(:,15) ! !HO2/HCHO=+K011+K011+K062*<OH>+K072*<NO3> - PJAC(:,15,22)=+TPK%K011(:)+TPK%K011(:)+TPK%K062(:)*PCONC(:,14)+TPK%K072(:)*PCO& + PJAC(:,16,23)=+TPK%K011(:)+TPK%K011(:)+TPK%K062(:)*PCONC(:,15)+TPK%K072(:)*PCO& &NC(:,5) ! !HO2/ALD=+K012 - PJAC(:,15,23)=+TPK%K012(:) + PJAC(:,16,24)=+TPK%K012(:) ! !HO2/KET=0.0 ! !HO2/CARBO=+0.75830*K016+0.51208*K065*<OH>+0.63217*K074*<NO3>+0.28441*K081*<O3> - PJAC(:,15,25)=+0.75830*TPK%K016(:)+0.51208*TPK%K065(:)*PCONC(:,14)+0.63217*TPK& + PJAC(:,16,26)=+0.75830*TPK%K016(:)+0.51208*TPK%K065(:)*PCONC(:,15)+0.63217*TPK& &%K074(:)*PCONC(:,5)+0.28441*TPK%K081(:)*PCONC(:,1) ! !HO2/ONIT=+K017 - PJAC(:,15,26)=+TPK%K017(:) + PJAC(:,16,27)=+TPK%K017(:) ! !HO2/PAN=+0.28107*K070*<OH>+0.08*K082*<O3> - PJAC(:,15,27)=+0.28107*TPK%K070(:)*PCONC(:,14)+0.08*TPK%K082(:)*PCONC(:,1) + PJAC(:,16,28)=+0.28107*TPK%K070(:)*PCONC(:,15)+0.08*TPK%K082(:)*PCONC(:,1) ! !HO2/OP1=+K013 - PJAC(:,15,28)=+TPK%K013(:) + PJAC(:,16,29)=+TPK%K013(:) ! !HO2/OP2=+0.96205*K014+0.02915*K069*<OH> - PJAC(:,15,29)=+0.96205*TPK%K014(:)+0.02915*TPK%K069(:)*PCONC(:,14) + PJAC(:,16,30)=+0.96205*TPK%K014(:)+0.02915*TPK%K069(:)*PCONC(:,15) ! !HO2/ORA1=+K066*<OH> - PJAC(:,15,30)=+TPK%K066(:)*PCONC(:,14) + PJAC(:,16,31)=+TPK%K066(:)*PCONC(:,15) ! !HO2/ORA2=0.0 ! !HO2/MO2=+K090*<NO>-K097*<HO2>+0.66*K104*<MO2>+0.66*K104*<MO2>+0.98383*K105*<AL !KAP>+K106*<ALKEP>+1.00000*K107*<BIOP>+1.02767*K108*<AROP>+0.82998*K109*<CARBOP !>+0.67560*K110*<OLN>+K119*<NO3>+K127*<XO2> - PJAC(:,15,32)=+TPK%K090(:)*PCONC(:,3)-TPK%K097(:)*PCONC(:,15)+0.66*TPK%K104(:)& -&*PCONC(:,32)+0.66*TPK%K104(:)*PCONC(:,32)+0.98383*TPK%K105(:)*PCONC(:,33)+TPK%& -&K106(:)*PCONC(:,34)+1.00000*TPK%K107(:)*PCONC(:,35)+1.02767*TPK%K108(:)*PCONC(& -&:,38)+0.82998*TPK%K109(:)*PCONC(:,39)+0.67560*TPK%K110(:)*PCONC(:,40)+TPK%K119& -&(:)*PCONC(:,5)+TPK%K127(:)*PCONC(:,41) + PJAC(:,16,33)=+TPK%K090(:)*PCONC(:,3)-TPK%K097(:)*PCONC(:,16)+0.66*TPK%K104(:)& +&*PCONC(:,33)+0.66*TPK%K104(:)*PCONC(:,33)+0.98383*TPK%K105(:)*PCONC(:,34)+TPK%& +&K106(:)*PCONC(:,35)+1.00000*TPK%K107(:)*PCONC(:,36)+1.02767*TPK%K108(:)*PCONC(& +&:,39)+0.82998*TPK%K109(:)*PCONC(:,40)+0.67560*TPK%K110(:)*PCONC(:,41)+TPK%K119& +&(:)*PCONC(:,5)+TPK%K127(:)*PCONC(:,42) ! !HO2/ALKAP=+0.74265*K091*<NO>-K098*<HO2>+0.98383*K105*<MO2>+0.48079*K111*<CARBO !P>+0.81290*K120*<NO3> - PJAC(:,15,33)=+0.74265*TPK%K091(:)*PCONC(:,3)-TPK%K098(:)*PCONC(:,15)+0.98383*& -&TPK%K105(:)*PCONC(:,32)+0.48079*TPK%K111(:)*PCONC(:,39)+0.81290*TPK%K120(:)*PC& + PJAC(:,16,34)=+0.74265*TPK%K091(:)*PCONC(:,3)-TPK%K098(:)*PCONC(:,16)+0.98383*& +&TPK%K105(:)*PCONC(:,33)+0.48079*TPK%K111(:)*PCONC(:,40)+0.81290*TPK%K120(:)*PC& &ONC(:,5) ! !HO2/ALKEP=+K092*<NO>-K099*<HO2>+K106*<MO2>+0.50078*K112*<CARBOP>+K121*<NO3> - PJAC(:,15,34)=+TPK%K092(:)*PCONC(:,3)-TPK%K099(:)*PCONC(:,15)+TPK%K106(:)*PCON& -&C(:,32)+0.50078*TPK%K112(:)*PCONC(:,39)+TPK%K121(:)*PCONC(:,5) + PJAC(:,16,35)=+TPK%K092(:)*PCONC(:,3)-TPK%K099(:)*PCONC(:,16)+TPK%K106(:)*PCON& +&C(:,33)+0.50078*TPK%K112(:)*PCONC(:,40)+TPK%K121(:)*PCONC(:,5) ! !HO2/BIOP=+0.84700*K093*<NO>-K0100*<HO2>+1.00000*K107*<MO2>+0.50600*K113*<CARBO !P>+K122*<NO3> - PJAC(:,15,35)=+0.84700*TPK%K093(:)*PCONC(:,3)-TPK%K0100(:)*PCONC(:,15)+1.00000& -&*TPK%K107(:)*PCONC(:,32)+0.50600*TPK%K113(:)*PCONC(:,39)+TPK%K122(:)*PCONC(:,5& + PJAC(:,16,36)=+0.84700*TPK%K093(:)*PCONC(:,3)-TPK%K0100(:)*PCONC(:,16)+1.00000& +&*TPK%K107(:)*PCONC(:,33)+0.50600*TPK%K113(:)*PCONC(:,40)+TPK%K122(:)*PCONC(:,5& &) ! !HO2/PHO=-K084*<HO2> - PJAC(:,15,36)=-TPK%K084(:)*PCONC(:,15) + PJAC(:,16,37)=-TPK%K084(:)*PCONC(:,16) ! !HO2/ADD=+0.02*K086*<O2> - PJAC(:,15,37)=+0.02*TPK%K086(:)*TPK%O2(:) + PJAC(:,16,38)=+0.02*TPK%K086(:)*TPK%O2(:) ! !HO2/AROP=+0.95115*K094*<NO>-K0101*<HO2>+1.02767*K108*<MO2>+K114*<CARBOP>+K123* !<NO3> - PJAC(:,15,38)=+0.95115*TPK%K094(:)*PCONC(:,3)-TPK%K0101(:)*PCONC(:,15)+1.02767& -&*TPK%K108(:)*PCONC(:,32)+TPK%K114(:)*PCONC(:,39)+TPK%K123(:)*PCONC(:,5) + PJAC(:,16,39)=+0.95115*TPK%K094(:)*PCONC(:,3)-TPK%K0101(:)*PCONC(:,16)+1.02767& +&*TPK%K108(:)*PCONC(:,33)+TPK%K114(:)*PCONC(:,40)+TPK%K123(:)*PCONC(:,5) ! !HO2/CARBOP=+0.12334*K095*<NO>-K0102*<HO2>+0.82998*K109*<MO2>+0.48079*K111*<ALK !AP>+0.50078*K112*<ALKEP>+0.50600*K113*<BIOP>+K114*<AROP>+0.07566*K115*<CARBOP> !+0.07566*K115*<CARBOP>+0.17599*K116*<OLN>+0.04915*K124*<NO3> - PJAC(:,15,39)=+0.12334*TPK%K095(:)*PCONC(:,3)-TPK%K0102(:)*PCONC(:,15)+0.82998& -&*TPK%K109(:)*PCONC(:,32)+0.48079*TPK%K111(:)*PCONC(:,33)+0.50078*TPK%K112(:)*P& -&CONC(:,34)+0.50600*TPK%K113(:)*PCONC(:,35)+TPK%K114(:)*PCONC(:,38)+0.07566*TPK& -&%K115(:)*PCONC(:,39)+0.07566*TPK%K115(:)*PCONC(:,39)+0.17599*TPK%K116(:)*PCONC& -&(:,40)+0.04915*TPK%K124(:)*PCONC(:,5) + PJAC(:,16,40)=+0.12334*TPK%K095(:)*PCONC(:,3)-TPK%K0102(:)*PCONC(:,16)+0.82998& +&*TPK%K109(:)*PCONC(:,33)+0.48079*TPK%K111(:)*PCONC(:,34)+0.50078*TPK%K112(:)*P& +&CONC(:,35)+0.50600*TPK%K113(:)*PCONC(:,36)+TPK%K114(:)*PCONC(:,39)+0.07566*TPK& +&%K115(:)*PCONC(:,40)+0.07566*TPK%K115(:)*PCONC(:,40)+0.17599*TPK%K116(:)*PCONC& +&(:,41)+0.04915*TPK%K124(:)*PCONC(:,5) ! !HO2/OLN=+0.18401*K096*<NO>-K103*<HO2>+0.67560*K110*<MO2>+0.17599*K116*<CARBOP> !+K117*<OLN>+K117*<OLN>+0.00000*K118*<OLN>+0.00000*K118*<OLN>+0.25928*K125*<NO3 !> - PJAC(:,15,40)=+0.18401*TPK%K096(:)*PCONC(:,3)-TPK%K103(:)*PCONC(:,15)+0.67560*& -&TPK%K110(:)*PCONC(:,32)+0.17599*TPK%K116(:)*PCONC(:,39)+TPK%K117(:)*PCONC(:,40& -&)+TPK%K117(:)*PCONC(:,40)+0.00000*TPK%K118(:)*PCONC(:,40)+0.00000*TPK%K118(:)*& -&PCONC(:,40)+0.25928*TPK%K125(:)*PCONC(:,5) + PJAC(:,16,41)=+0.18401*TPK%K096(:)*PCONC(:,3)-TPK%K103(:)*PCONC(:,16)+0.67560*& +&TPK%K110(:)*PCONC(:,33)+0.17599*TPK%K116(:)*PCONC(:,40)+TPK%K117(:)*PCONC(:,41& +&)+TPK%K117(:)*PCONC(:,41)+0.00000*TPK%K118(:)*PCONC(:,41)+0.00000*TPK%K118(:)*& +&PCONC(:,41)+0.25928*TPK%K125(:)*PCONC(:,5) ! !HO2/XO2=-K126*<HO2>+K127*<MO2> - PJAC(:,15,41)=-TPK%K126(:)*PCONC(:,15)+TPK%K127(:)*PCONC(:,32) -! -RETURN -END SUBROUTINE SUBJ2 -! -SUBROUTINE SUBJ3 -! -!Indices 16 a 20 -! + PJAC(:,16,42)=-TPK%K126(:)*PCONC(:,16)+TPK%K127(:)*PCONC(:,33) ! !CH4/O3=+0.04300*K079*<ALKE> - PJAC(:,16,1)=+0.04300*TPK%K079(:)*PCONC(:,19) + PJAC(:,17,1)=+0.04300*TPK%K079(:)*PCONC(:,20) ! !CH4/H2O2=0.0 ! @@ -25604,6 +26158,8 @@ SUBROUTINE SUBJ3 ! !CH4/NH3=0.0 ! +!CH4/DMS=0.0 +! !CH4/SO2=0.0 ! !CH4/SULF=0.0 @@ -25611,19 +26167,19 @@ SUBROUTINE SUBJ3 !CH4/CO=0.0 ! !CH4/OH=-K056*<CH4> - PJAC(:,16,14)=-TPK%K056(:)*PCONC(:,16) + PJAC(:,17,15)=-TPK%K056(:)*PCONC(:,17) ! !CH4/HO2=0.0 ! !CH4/CH4=-K056*<OH> - PJAC(:,16,16)=-TPK%K056(:)*PCONC(:,14) + PJAC(:,17,17)=-TPK%K056(:)*PCONC(:,15) ! !CH4/ETH=0.0 ! !CH4/ALKA=0.0 ! !CH4/ALKE=+0.04300*K079*<O3> - PJAC(:,16,19)=+0.04300*TPK%K079(:)*PCONC(:,1) + PJAC(:,17,20)=+0.04300*TPK%K079(:)*PCONC(:,1) ! !CH4/BIO=0.0 ! @@ -25670,7 +26226,7 @@ SUBROUTINE SUBJ3 !CH4/XO2=0.0 ! !ETH/O3=+0.03196*K079*<ALKE> - PJAC(:,17,1)=+0.03196*TPK%K079(:)*PCONC(:,19) + PJAC(:,18,1)=+0.03196*TPK%K079(:)*PCONC(:,20) ! !ETH/H2O2=0.0 ! @@ -25690,6 +26246,8 @@ SUBROUTINE SUBJ3 ! !ETH/NH3=0.0 ! +!ETH/DMS=0.0 +! !ETH/SO2=0.0 ! !ETH/SULF=0.0 @@ -25697,19 +26255,19 @@ SUBROUTINE SUBJ3 !ETH/CO=0.0 ! !ETH/OH=-K057*<ETH> - PJAC(:,17,14)=-TPK%K057(:)*PCONC(:,17) + PJAC(:,18,15)=-TPK%K057(:)*PCONC(:,18) ! !ETH/HO2=0.0 ! !ETH/CH4=0.0 ! !ETH/ETH=-K057*<OH> - PJAC(:,17,17)=-TPK%K057(:)*PCONC(:,14) + PJAC(:,18,18)=-TPK%K057(:)*PCONC(:,15) ! !ETH/ALKA=0.0 ! !ETH/ALKE=+0.03196*K079*<O3> - PJAC(:,17,19)=+0.03196*TPK%K079(:)*PCONC(:,1) + PJAC(:,18,20)=+0.03196*TPK%K079(:)*PCONC(:,1) ! !ETH/BIO=0.0 ! @@ -25775,6 +26333,8 @@ SUBROUTINE SUBJ3 ! !ALKA/NH3=0.0 ! +!ALKA/DMS=0.0 +! !ALKA/SO2=0.0 ! !ALKA/SULF=0.0 @@ -25782,7 +26342,7 @@ SUBROUTINE SUBJ3 !ALKA/CO=0.0 ! !ALKA/OH=-K058*<ALKA> - PJAC(:,18,14)=-TPK%K058(:)*PCONC(:,18) + PJAC(:,19,15)=-TPK%K058(:)*PCONC(:,19) ! !ALKA/HO2=0.0 ! @@ -25791,7 +26351,7 @@ SUBROUTINE SUBJ3 !ALKA/ETH=0.0 ! !ALKA/ALKA=-K058*<OH> - PJAC(:,18,18)=-TPK%K058(:)*PCONC(:,14) + PJAC(:,19,19)=-TPK%K058(:)*PCONC(:,15) ! !ALKA/ALKE=0.0 ! @@ -25840,18 +26400,18 @@ SUBROUTINE SUBJ3 !ALKA/XO2=0.0 ! !ALKE/O3=+0.00000*K079*<ALKE>-K079*<ALKE>+0.37388*K080*<BIO> - PJAC(:,19,1)=+0.00000*TPK%K079(:)*PCONC(:,19)-TPK%K079(:)*PCONC(:,19)+0.37388*& -&TPK%K080(:)*PCONC(:,20) + PJAC(:,20,1)=+0.00000*TPK%K079(:)*PCONC(:,20)-TPK%K079(:)*PCONC(:,20)+0.37388*& +&TPK%K080(:)*PCONC(:,21) ! !ALKE/H2O2=0.0 ! !ALKE/NO=+0.37815*K093*<BIOP> - PJAC(:,19,3)=+0.37815*TPK%K093(:)*PCONC(:,35) + PJAC(:,20,3)=+0.37815*TPK%K093(:)*PCONC(:,36) ! !ALKE/NO2=0.0 ! !ALKE/NO3=-K076*<ALKE>+0.42729*K122*<BIOP> - PJAC(:,19,5)=-TPK%K076(:)*PCONC(:,19)+0.42729*TPK%K122(:)*PCONC(:,35) + PJAC(:,20,5)=-TPK%K076(:)*PCONC(:,20)+0.42729*TPK%K122(:)*PCONC(:,36) ! !ALKE/N2O5=0.0 ! @@ -25863,6 +26423,8 @@ SUBROUTINE SUBJ3 ! !ALKE/NH3=0.0 ! +!ALKE/DMS=0.0 +! !ALKE/SO2=0.0 ! !ALKE/SULF=0.0 @@ -25870,7 +26432,7 @@ SUBROUTINE SUBJ3 !ALKE/CO=0.0 ! !ALKE/OH=-K059*<ALKE> - PJAC(:,19,14)=-TPK%K059(:)*PCONC(:,19) + PJAC(:,20,15)=-TPK%K059(:)*PCONC(:,20) ! !ALKE/HO2=0.0 ! @@ -25881,11 +26443,11 @@ SUBROUTINE SUBJ3 !ALKE/ALKA=0.0 ! !ALKE/ALKE=-K059*<OH>-K076*<NO3>+0.00000*K079*<O3>-K079*<O3> - PJAC(:,19,19)=-TPK%K059(:)*PCONC(:,14)-TPK%K076(:)*PCONC(:,5)+0.00000*TPK%K079& + PJAC(:,20,20)=-TPK%K059(:)*PCONC(:,15)-TPK%K076(:)*PCONC(:,5)+0.00000*TPK%K079& &(:)*PCONC(:,1)-TPK%K079(:)*PCONC(:,1) ! !ALKE/BIO=+0.91868*K054*<O3P>+0.37388*K080*<O3> - PJAC(:,19,20)=+0.91868*TPK%K054(:)*TPK%O3P(:)+0.37388*TPK%K080(:)*PCONC(:,1) + PJAC(:,20,21)=+0.91868*TPK%K054(:)*TPK%O3P(:)+0.37388*TPK%K080(:)*PCONC(:,1) ! !ALKE/ARO=0.0 ! @@ -25910,7 +26472,7 @@ SUBROUTINE SUBJ3 !ALKE/ORA2=0.0 ! !ALKE/MO2=+0.48074*K107*<BIOP> - PJAC(:,19,32)=+0.48074*TPK%K107(:)*PCONC(:,35) + PJAC(:,20,33)=+0.48074*TPK%K107(:)*PCONC(:,36) ! !ALKE/ALKAP=0.0 ! @@ -25918,8 +26480,8 @@ SUBROUTINE SUBJ3 ! !ALKE/BIOP=+0.37815*K093*<NO>+0.48074*K107*<MO2>+0.24463*K113*<CARBOP>+0.42729* !K122*<NO3> - PJAC(:,19,35)=+0.37815*TPK%K093(:)*PCONC(:,3)+0.48074*TPK%K107(:)*PCONC(:,32)+& -&0.24463*TPK%K113(:)*PCONC(:,39)+0.42729*TPK%K122(:)*PCONC(:,5) + PJAC(:,20,36)=+0.37815*TPK%K093(:)*PCONC(:,3)+0.48074*TPK%K107(:)*PCONC(:,33)+& +&0.24463*TPK%K113(:)*PCONC(:,40)+0.42729*TPK%K122(:)*PCONC(:,5) ! !ALKE/PHO=0.0 ! @@ -25928,14 +26490,22 @@ SUBROUTINE SUBJ3 !ALKE/AROP=0.0 ! !ALKE/CARBOP=+0.24463*K113*<BIOP> - PJAC(:,19,39)=+0.24463*TPK%K113(:)*PCONC(:,35) + PJAC(:,20,40)=+0.24463*TPK%K113(:)*PCONC(:,36) ! !ALKE/OLN=0.0 ! !ALKE/XO2=0.0 ! +RETURN +END SUBROUTINE SUBJ3 +! +SUBROUTINE SUBJ4 +! +!Indices 21 a 25 +! +! !BIO/O3=-K080*<BIO> - PJAC(:,20,1)=-TPK%K080(:)*PCONC(:,20) + PJAC(:,21,1)=-TPK%K080(:)*PCONC(:,21) ! !BIO/H2O2=0.0 ! @@ -25944,7 +26514,7 @@ SUBROUTINE SUBJ3 !BIO/NO2=0.0 ! !BIO/NO3=-K077*<BIO> - PJAC(:,20,5)=-TPK%K077(:)*PCONC(:,20) + PJAC(:,21,5)=-TPK%K077(:)*PCONC(:,21) ! !BIO/N2O5=0.0 ! @@ -25956,6 +26526,8 @@ SUBROUTINE SUBJ3 ! !BIO/NH3=0.0 ! +!BIO/DMS=0.0 +! !BIO/SO2=0.0 ! !BIO/SULF=0.0 @@ -25963,7 +26535,7 @@ SUBROUTINE SUBJ3 !BIO/CO=0.0 ! !BIO/OH=-K060*<BIO> - PJAC(:,20,14)=-TPK%K060(:)*PCONC(:,20) + PJAC(:,21,15)=-TPK%K060(:)*PCONC(:,21) ! !BIO/HO2=0.0 ! @@ -25976,7 +26548,7 @@ SUBROUTINE SUBJ3 !BIO/ALKE=0.0 ! !BIO/BIO=-K054*<O3P>-K060*<OH>-K077*<NO3>-K080*<O3> - PJAC(:,20,20)=-TPK%K054(:)*TPK%O3P(:)-TPK%K060(:)*PCONC(:,14)-TPK%K077(:)*PCON& + PJAC(:,21,21)=-TPK%K054(:)*TPK%O3P(:)-TPK%K060(:)*PCONC(:,15)-TPK%K077(:)*PCON& &C(:,5)-TPK%K080(:)*PCONC(:,1) ! !BIO/ARO=0.0 @@ -26021,26 +26593,18 @@ SUBROUTINE SUBJ3 ! !BIO/XO2=0.0 ! -RETURN -END SUBROUTINE SUBJ3 -! -SUBROUTINE SUBJ4 -! -!Indices 21 a 25 -! -! !ARO/O3=+K087*<ADD> - PJAC(:,21,1)=+TPK%K087(:)*PCONC(:,37) + PJAC(:,22,1)=+TPK%K087(:)*PCONC(:,38) ! !ARO/H2O2=0.0 ! !ARO/NO=0.0 ! !ARO/NO2=+0.10670*K083*<PHO>+K085*<ADD> - PJAC(:,21,4)=+0.10670*TPK%K083(:)*PCONC(:,36)+TPK%K085(:)*PCONC(:,37) + PJAC(:,22,4)=+0.10670*TPK%K083(:)*PCONC(:,37)+TPK%K085(:)*PCONC(:,38) ! !ARO/NO3=-K075*<ARO> - PJAC(:,21,5)=-TPK%K075(:)*PCONC(:,21) + PJAC(:,22,5)=-TPK%K075(:)*PCONC(:,22) ! !ARO/N2O5=0.0 ! @@ -26052,6 +26616,8 @@ SUBROUTINE SUBJ4 ! !ARO/NH3=0.0 ! +!ARO/DMS=0.0 +! !ARO/SO2=0.0 ! !ARO/SULF=0.0 @@ -26059,10 +26625,10 @@ SUBROUTINE SUBJ4 !ARO/CO=0.0 ! !ARO/OH=-K061*<ARO> - PJAC(:,21,14)=-TPK%K061(:)*PCONC(:,21) + PJAC(:,22,15)=-TPK%K061(:)*PCONC(:,22) ! !ARO/HO2=+1.06698*K084*<PHO> - PJAC(:,21,15)=+1.06698*TPK%K084(:)*PCONC(:,36) + PJAC(:,22,16)=+1.06698*TPK%K084(:)*PCONC(:,37) ! !ARO/CH4=0.0 ! @@ -26075,7 +26641,7 @@ SUBROUTINE SUBJ4 !ARO/BIO=0.0 ! !ARO/ARO=-K061*<OH>-K075*<NO3> - PJAC(:,21,21)=-TPK%K061(:)*PCONC(:,14)-TPK%K075(:)*PCONC(:,5) + PJAC(:,22,22)=-TPK%K061(:)*PCONC(:,15)-TPK%K075(:)*PCONC(:,5) ! !ARO/HCHO=0.0 ! @@ -26106,10 +26672,10 @@ SUBROUTINE SUBJ4 !ARO/BIOP=0.0 ! !ARO/PHO=+0.10670*K083*<NO2>+1.06698*K084*<HO2> - PJAC(:,21,36)=+0.10670*TPK%K083(:)*PCONC(:,4)+1.06698*TPK%K084(:)*PCONC(:,15) + PJAC(:,22,37)=+0.10670*TPK%K083(:)*PCONC(:,4)+1.06698*TPK%K084(:)*PCONC(:,16) ! !ARO/ADD=+K085*<NO2>+0.02*K086*<O2>+K087*<O3> - PJAC(:,21,37)=+TPK%K085(:)*PCONC(:,4)+0.02*TPK%K086(:)*TPK%O2(:)+TPK%K087(:)*P& + PJAC(:,22,38)=+TPK%K085(:)*PCONC(:,4)+0.02*TPK%K086(:)*TPK%O2(:)+TPK%K087(:)*P& &CONC(:,1) ! !ARO/AROP=0.0 @@ -26122,25 +26688,25 @@ SUBROUTINE SUBJ4 ! !HCHO/O3=+0.48290*K079*<ALKE>+0.90000*K080*<BIO>+0.00000*K081*<CARBO>+0.70*K082 !*<PAN> - PJAC(:,22,1)=+0.48290*TPK%K079(:)*PCONC(:,19)+0.90000*TPK%K080(:)*PCONC(:,20)+& -&0.00000*TPK%K081(:)*PCONC(:,25)+0.70*TPK%K082(:)*PCONC(:,27) + PJAC(:,23,1)=+0.48290*TPK%K079(:)*PCONC(:,20)+0.90000*TPK%K080(:)*PCONC(:,21)+& +&0.00000*TPK%K081(:)*PCONC(:,26)+0.70*TPK%K082(:)*PCONC(:,28) ! !HCHO/H2O2=0.0 ! !HCHO/NO=+K090*<MO2>+0.03002*K091*<ALKAP>+1.39870*K092*<ALKEP>+0.60600*K093*<BI !OP>+0.05848*K095*<CARBOP>+0.23419*K096*<OLN> - PJAC(:,22,3)=+TPK%K090(:)*PCONC(:,32)+0.03002*TPK%K091(:)*PCONC(:,33)+1.39870*& -&TPK%K092(:)*PCONC(:,34)+0.60600*TPK%K093(:)*PCONC(:,35)+0.05848*TPK%K095(:)*PC& -&ONC(:,39)+0.23419*TPK%K096(:)*PCONC(:,40) + PJAC(:,23,3)=+TPK%K090(:)*PCONC(:,33)+0.03002*TPK%K091(:)*PCONC(:,34)+1.39870*& +&TPK%K092(:)*PCONC(:,35)+0.60600*TPK%K093(:)*PCONC(:,36)+0.05848*TPK%K095(:)*PC& +&ONC(:,40)+0.23419*TPK%K096(:)*PCONC(:,41) ! !HCHO/NO2=0.0 ! !HCHO/NO3=-K072*<HCHO>+0.40*K078*<PAN>+K119*<MO2>+0.03142*K120*<ALKAP>+1.40909* !K121*<ALKEP>+0.68600*K122*<BIOP>+0.03175*K124*<CARBOP>+0.20740*K125*<OLN> - PJAC(:,22,5)=-TPK%K072(:)*PCONC(:,22)+0.40*TPK%K078(:)*PCONC(:,27)+TPK%K119(:)& -&*PCONC(:,32)+0.03142*TPK%K120(:)*PCONC(:,33)+1.40909*TPK%K121(:)*PCONC(:,34)+0& -&.68600*TPK%K122(:)*PCONC(:,35)+0.03175*TPK%K124(:)*PCONC(:,39)+0.20740*TPK%K12& -&5(:)*PCONC(:,40) + PJAC(:,23,5)=-TPK%K072(:)*PCONC(:,23)+0.40*TPK%K078(:)*PCONC(:,28)+TPK%K119(:)& +&*PCONC(:,33)+0.03142*TPK%K120(:)*PCONC(:,34)+1.40909*TPK%K121(:)*PCONC(:,35)+0& +&.68600*TPK%K122(:)*PCONC(:,36)+0.03175*TPK%K124(:)*PCONC(:,40)+0.20740*TPK%K12& +&5(:)*PCONC(:,41) ! !HCHO/N2O5=0.0 ! @@ -26152,6 +26718,8 @@ SUBROUTINE SUBJ4 ! !HCHO/NH3=0.0 ! +!HCHO/DMS=0.0 +! !HCHO/SO2=0.0 ! !HCHO/SULF=0.0 @@ -26160,9 +26728,9 @@ SUBROUTINE SUBJ4 ! !HCHO/OH=+0.00140*K058*<ALKA>-K062*<HCHO>+0.00000*K065*<CARBO>+0.35*K068*<OP1>+ !0.02915*K069*<OP2>+0.57839*K070*<PAN> - PJAC(:,22,14)=+0.00140*TPK%K058(:)*PCONC(:,18)-TPK%K062(:)*PCONC(:,22)+0.00000& -&*TPK%K065(:)*PCONC(:,25)+0.35*TPK%K068(:)*PCONC(:,28)+0.02915*TPK%K069(:)*PCON& -&C(:,29)+0.57839*TPK%K070(:)*PCONC(:,27) + PJAC(:,23,15)=+0.00140*TPK%K058(:)*PCONC(:,19)-TPK%K062(:)*PCONC(:,23)+0.00000& +&*TPK%K065(:)*PCONC(:,26)+0.35*TPK%K068(:)*PCONC(:,29)+0.02915*TPK%K069(:)*PCON& +&C(:,30)+0.57839*TPK%K070(:)*PCONC(:,28) ! !HCHO/HO2=0.0 ! @@ -26171,18 +26739,18 @@ SUBROUTINE SUBJ4 !HCHO/ETH=0.0 ! !HCHO/ALKA=+0.00140*K058*<OH> - PJAC(:,22,18)=+0.00140*TPK%K058(:)*PCONC(:,14) + PJAC(:,23,19)=+0.00140*TPK%K058(:)*PCONC(:,15) ! !HCHO/ALKE=+0.48290*K079*<O3> - PJAC(:,22,19)=+0.48290*TPK%K079(:)*PCONC(:,1) + PJAC(:,23,20)=+0.48290*TPK%K079(:)*PCONC(:,1) ! !HCHO/BIO=+0.05*K054*<O3P>+0.90000*K080*<O3> - PJAC(:,22,20)=+0.05*TPK%K054(:)*TPK%O3P(:)+0.90000*TPK%K080(:)*PCONC(:,1) + PJAC(:,23,21)=+0.05*TPK%K054(:)*TPK%O3P(:)+0.90000*TPK%K080(:)*PCONC(:,1) ! !HCHO/ARO=0.0 ! !HCHO/HCHO=-K010-K011-K062*<OH>-K072*<NO3> - PJAC(:,22,22)=-TPK%K010(:)-TPK%K011(:)-TPK%K062(:)*PCONC(:,14)-TPK%K072(:)*PCO& + PJAC(:,23,23)=-TPK%K010(:)-TPK%K011(:)-TPK%K062(:)*PCONC(:,15)-TPK%K072(:)*PCO& &NC(:,5) ! !HCHO/ALD=0.0 @@ -26190,20 +26758,20 @@ SUBROUTINE SUBJ4 !HCHO/KET=0.0 ! !HCHO/CARBO=+0.06517*K016+0.00000*K065*<OH>+0.00000*K081*<O3> - PJAC(:,22,25)=+0.06517*TPK%K016(:)+0.00000*TPK%K065(:)*PCONC(:,14)+0.00000*TPK& + PJAC(:,23,26)=+0.06517*TPK%K016(:)+0.00000*TPK%K065(:)*PCONC(:,15)+0.00000*TPK& &%K081(:)*PCONC(:,1) ! !HCHO/ONIT=0.0 ! !HCHO/PAN=+0.57839*K070*<OH>+0.40*K078*<NO3>+0.70*K082*<O3> - PJAC(:,22,27)=+0.57839*TPK%K070(:)*PCONC(:,14)+0.40*TPK%K078(:)*PCONC(:,5)+0.7& + PJAC(:,23,28)=+0.57839*TPK%K070(:)*PCONC(:,15)+0.40*TPK%K078(:)*PCONC(:,5)+0.7& &0*TPK%K082(:)*PCONC(:,1) ! !HCHO/OP1=+K013+0.35*K068*<OH> - PJAC(:,22,28)=+TPK%K013(:)+0.35*TPK%K068(:)*PCONC(:,14) + PJAC(:,23,29)=+TPK%K013(:)+0.35*TPK%K068(:)*PCONC(:,15) ! !HCHO/OP2=+0.02915*K069*<OH> - PJAC(:,22,29)=+0.02915*TPK%K069(:)*PCONC(:,14) + PJAC(:,23,30)=+0.02915*TPK%K069(:)*PCONC(:,15) ! !HCHO/ORA1=0.0 ! @@ -26212,70 +26780,70 @@ SUBROUTINE SUBJ4 !HCHO/MO2=+K090*<NO>+1.33*K104*<MO2>+1.33*K104*<MO2>+0.80556*K105*<ALKAP>+1.428 !94*K106*<ALKEP>+1.09000*K107*<BIOP>+K108*<AROP>+0.95723*K109*<CARBOP>+0.88625* !K110*<OLN>+K119*<NO3>+K127*<XO2> - PJAC(:,22,32)=+TPK%K090(:)*PCONC(:,3)+1.33*TPK%K104(:)*PCONC(:,32)+1.33*TPK%K1& -&04(:)*PCONC(:,32)+0.80556*TPK%K105(:)*PCONC(:,33)+1.42894*TPK%K106(:)*PCONC(:,& -&34)+1.09000*TPK%K107(:)*PCONC(:,35)+TPK%K108(:)*PCONC(:,38)+0.95723*TPK%K109(:& -&)*PCONC(:,39)+0.88625*TPK%K110(:)*PCONC(:,40)+TPK%K119(:)*PCONC(:,5)+TPK%K127(& -&:)*PCONC(:,41) + PJAC(:,23,33)=+TPK%K090(:)*PCONC(:,3)+1.33*TPK%K104(:)*PCONC(:,33)+1.33*TPK%K1& +&04(:)*PCONC(:,33)+0.80556*TPK%K105(:)*PCONC(:,34)+1.42894*TPK%K106(:)*PCONC(:,& +&35)+1.09000*TPK%K107(:)*PCONC(:,36)+TPK%K108(:)*PCONC(:,39)+0.95723*TPK%K109(:& +&)*PCONC(:,40)+0.88625*TPK%K110(:)*PCONC(:,41)+TPK%K119(:)*PCONC(:,5)+TPK%K127(& +&:)*PCONC(:,42) ! !HCHO/ALKAP=+0.03002*K091*<NO>+0.80556*K105*<MO2>+0.07600*K111*<CARBOP>+0.03142 !*K120*<NO3> - PJAC(:,22,33)=+0.03002*TPK%K091(:)*PCONC(:,3)+0.80556*TPK%K105(:)*PCONC(:,32)+& -&0.07600*TPK%K111(:)*PCONC(:,39)+0.03142*TPK%K120(:)*PCONC(:,5) + PJAC(:,23,34)=+0.03002*TPK%K091(:)*PCONC(:,3)+0.80556*TPK%K105(:)*PCONC(:,33)+& +&0.07600*TPK%K111(:)*PCONC(:,40)+0.03142*TPK%K120(:)*PCONC(:,5) ! !HCHO/ALKEP=+1.39870*K092*<NO>+1.42894*K106*<MO2>+0.68192*K112*<CARBOP>+1.40909 !*K121*<NO3> - PJAC(:,22,34)=+1.39870*TPK%K092(:)*PCONC(:,3)+1.42894*TPK%K106(:)*PCONC(:,32)+& -&0.68192*TPK%K112(:)*PCONC(:,39)+1.40909*TPK%K121(:)*PCONC(:,5) + PJAC(:,23,35)=+1.39870*TPK%K092(:)*PCONC(:,3)+1.42894*TPK%K106(:)*PCONC(:,33)+& +&0.68192*TPK%K112(:)*PCONC(:,40)+1.40909*TPK%K121(:)*PCONC(:,5) ! !HCHO/BIOP=+0.60600*K093*<NO>+1.09000*K107*<MO2>+0.34000*K113*<CARBOP>+0.68600* !K122*<NO3> - PJAC(:,22,35)=+0.60600*TPK%K093(:)*PCONC(:,3)+1.09000*TPK%K107(:)*PCONC(:,32)+& -&0.34000*TPK%K113(:)*PCONC(:,39)+0.68600*TPK%K122(:)*PCONC(:,5) + PJAC(:,23,36)=+0.60600*TPK%K093(:)*PCONC(:,3)+1.09000*TPK%K107(:)*PCONC(:,33)+& +&0.34000*TPK%K113(:)*PCONC(:,40)+0.68600*TPK%K122(:)*PCONC(:,5) ! !HCHO/PHO=0.0 ! !HCHO/ADD=0.0 ! !HCHO/AROP=+K108*<MO2> - PJAC(:,22,38)=+TPK%K108(:)*PCONC(:,32) + PJAC(:,23,39)=+TPK%K108(:)*PCONC(:,33) ! !HCHO/CARBOP=+0.05848*K095*<NO>+0.95723*K109*<MO2>+0.07600*K111*<ALKAP>+0.68192 !*K112*<ALKEP>+0.34000*K113*<BIOP>+0.03432*K115*<CARBOP>+0.03432*K115*<CARBOP>+ !0.13414*K116*<OLN>+0.03175*K124*<NO3> - PJAC(:,22,39)=+0.05848*TPK%K095(:)*PCONC(:,3)+0.95723*TPK%K109(:)*PCONC(:,32)+& -&0.07600*TPK%K111(:)*PCONC(:,33)+0.68192*TPK%K112(:)*PCONC(:,34)+0.34000*TPK%K1& -&13(:)*PCONC(:,35)+0.03432*TPK%K115(:)*PCONC(:,39)+0.03432*TPK%K115(:)*PCONC(:,& -&39)+0.13414*TPK%K116(:)*PCONC(:,40)+0.03175*TPK%K124(:)*PCONC(:,5) + PJAC(:,23,40)=+0.05848*TPK%K095(:)*PCONC(:,3)+0.95723*TPK%K109(:)*PCONC(:,33)+& +&0.07600*TPK%K111(:)*PCONC(:,34)+0.68192*TPK%K112(:)*PCONC(:,35)+0.34000*TPK%K1& +&13(:)*PCONC(:,36)+0.03432*TPK%K115(:)*PCONC(:,40)+0.03432*TPK%K115(:)*PCONC(:,& +&40)+0.13414*TPK%K116(:)*PCONC(:,41)+0.03175*TPK%K124(:)*PCONC(:,5) ! !HCHO/OLN=+0.23419*K096*<NO>+0.88625*K110*<MO2>+0.13414*K116*<CARBOP>+0.00000*K !118*<OLN>+0.00000*K118*<OLN>+0.20740*K125*<NO3> - PJAC(:,22,40)=+0.23419*TPK%K096(:)*PCONC(:,3)+0.88625*TPK%K110(:)*PCONC(:,32)+& -&0.13414*TPK%K116(:)*PCONC(:,39)+0.00000*TPK%K118(:)*PCONC(:,40)+0.00000*TPK%K1& -&18(:)*PCONC(:,40)+0.20740*TPK%K125(:)*PCONC(:,5) + PJAC(:,23,41)=+0.23419*TPK%K096(:)*PCONC(:,3)+0.88625*TPK%K110(:)*PCONC(:,33)+& +&0.13414*TPK%K116(:)*PCONC(:,40)+0.00000*TPK%K118(:)*PCONC(:,41)+0.00000*TPK%K1& +&18(:)*PCONC(:,41)+0.20740*TPK%K125(:)*PCONC(:,5) ! !HCHO/XO2=+K127*<MO2> - PJAC(:,22,41)=+TPK%K127(:)*PCONC(:,32) + PJAC(:,23,42)=+TPK%K127(:)*PCONC(:,33) ! !ALD/O3=+0.51468*K079*<ALKE>+0.00000*K080*<BIO>+0.15692*K081*<CARBO> - PJAC(:,23,1)=+0.51468*TPK%K079(:)*PCONC(:,19)+0.00000*TPK%K080(:)*PCONC(:,20)+& -&0.15692*TPK%K081(:)*PCONC(:,25) + PJAC(:,24,1)=+0.51468*TPK%K079(:)*PCONC(:,20)+0.00000*TPK%K080(:)*PCONC(:,21)+& +&0.15692*TPK%K081(:)*PCONC(:,26) ! !ALD/H2O2=0.0 ! !ALD/NO=+0.33144*K091*<ALKAP>+0.42125*K092*<ALKEP>+0.00000*K093*<BIOP>+0.07368* !K095*<CARBOP>+1.01182*K096*<OLN> - PJAC(:,23,3)=+0.33144*TPK%K091(:)*PCONC(:,33)+0.42125*TPK%K092(:)*PCONC(:,34)+& -&0.00000*TPK%K093(:)*PCONC(:,35)+0.07368*TPK%K095(:)*PCONC(:,39)+1.01182*TPK%K0& -&96(:)*PCONC(:,40) + PJAC(:,24,3)=+0.33144*TPK%K091(:)*PCONC(:,34)+0.42125*TPK%K092(:)*PCONC(:,35)+& +&0.00000*TPK%K093(:)*PCONC(:,36)+0.07368*TPK%K095(:)*PCONC(:,40)+1.01182*TPK%K0& +&96(:)*PCONC(:,41) ! !ALD/NO2=0.0 ! !ALD/NO3=-K073*<ALD>+0.05265*K074*<CARBO>+0.33743*K120*<ALKAP>+0.43039*K121*<AL !KEP>+0.00000*K122*<BIOP>+0.02936*K124*<CARBOP>+0.91850*K125*<OLN> - PJAC(:,23,5)=-TPK%K073(:)*PCONC(:,23)+0.05265*TPK%K074(:)*PCONC(:,25)+0.33743*& -&TPK%K120(:)*PCONC(:,33)+0.43039*TPK%K121(:)*PCONC(:,34)+0.00000*TPK%K122(:)*PC& -&ONC(:,35)+0.02936*TPK%K124(:)*PCONC(:,39)+0.91850*TPK%K125(:)*PCONC(:,40) + PJAC(:,24,5)=-TPK%K073(:)*PCONC(:,24)+0.05265*TPK%K074(:)*PCONC(:,26)+0.33743*& +&TPK%K120(:)*PCONC(:,34)+0.43039*TPK%K121(:)*PCONC(:,35)+0.00000*TPK%K122(:)*PC& +&ONC(:,36)+0.02936*TPK%K124(:)*PCONC(:,40)+0.91850*TPK%K125(:)*PCONC(:,41) ! !ALD/N2O5=0.0 ! @@ -26287,6 +26855,8 @@ SUBROUTINE SUBJ4 ! !ALD/NH3=0.0 ! +!ALD/DMS=0.0 +! !ALD/SO2=0.0 ! !ALD/SULF=0.0 @@ -26294,8 +26864,8 @@ SUBROUTINE SUBJ4 !ALD/CO=0.0 ! !ALD/OH=+0.08173*K058*<ALKA>-K063*<ALD>+0.06253*K065*<CARBO>+0.07335*K069*<OP2> - PJAC(:,23,14)=+0.08173*TPK%K058(:)*PCONC(:,18)-TPK%K063(:)*PCONC(:,23)+0.06253& -&*TPK%K065(:)*PCONC(:,25)+0.07335*TPK%K069(:)*PCONC(:,29) + PJAC(:,24,15)=+0.08173*TPK%K058(:)*PCONC(:,19)-TPK%K063(:)*PCONC(:,24)+0.06253& +&*TPK%K065(:)*PCONC(:,26)+0.07335*TPK%K069(:)*PCONC(:,30) ! !ALD/HO2=0.0 ! @@ -26304,36 +26874,36 @@ SUBROUTINE SUBJ4 !ALD/ETH=0.0 ! !ALD/ALKA=+0.08173*K058*<OH> - PJAC(:,23,18)=+0.08173*TPK%K058(:)*PCONC(:,14) + PJAC(:,24,19)=+0.08173*TPK%K058(:)*PCONC(:,15) ! !ALD/ALKE=+0.51468*K079*<O3> - PJAC(:,23,19)=+0.51468*TPK%K079(:)*PCONC(:,1) + PJAC(:,24,20)=+0.51468*TPK%K079(:)*PCONC(:,1) ! !ALD/BIO=+0.00000*K080*<O3> - PJAC(:,23,20)=+0.00000*TPK%K080(:)*PCONC(:,1) + PJAC(:,24,21)=+0.00000*TPK%K080(:)*PCONC(:,1) ! !ALD/ARO=0.0 ! !ALD/HCHO=0.0 ! !ALD/ALD=-K012-K063*<OH>-K073*<NO3> - PJAC(:,23,23)=-TPK%K012(:)-TPK%K063(:)*PCONC(:,14)-TPK%K073(:)*PCONC(:,5) + PJAC(:,24,24)=-TPK%K012(:)-TPK%K063(:)*PCONC(:,15)-TPK%K073(:)*PCONC(:,5) ! !ALD/KET=0.0 ! !ALD/CARBO=+K055*<O3P>+0.06253*K065*<OH>+0.05265*K074*<NO3>+0.15692*K081*<O3> - PJAC(:,23,25)=+TPK%K055(:)*TPK%O3P(:)+0.06253*TPK%K065(:)*PCONC(:,14)+0.05265*& + PJAC(:,24,26)=+TPK%K055(:)*TPK%O3P(:)+0.06253*TPK%K065(:)*PCONC(:,15)+0.05265*& &TPK%K074(:)*PCONC(:,5)+0.15692*TPK%K081(:)*PCONC(:,1) ! !ALD/ONIT=+0.20*K017 - PJAC(:,23,26)=+0.20*TPK%K017(:) + PJAC(:,24,27)=+0.20*TPK%K017(:) ! !ALD/PAN=0.0 ! !ALD/OP1=0.0 ! !ALD/OP2=+0.96205*K014+0.07335*K069*<OH> - PJAC(:,23,29)=+0.96205*TPK%K014(:)+0.07335*TPK%K069(:)*PCONC(:,14) + PJAC(:,24,30)=+0.96205*TPK%K014(:)+0.07335*TPK%K069(:)*PCONC(:,15) ! !ALD/ORA1=0.0 ! @@ -26341,24 +26911,24 @@ SUBROUTINE SUBJ4 ! !ALD/MO2=+0.56070*K105*<ALKAP>+0.46413*K106*<ALKEP>+0.00000*K107*<BIOP>+0.08295 !*K109*<CARBOP>+0.41524*K110*<OLN> - PJAC(:,23,32)=+0.56070*TPK%K105(:)*PCONC(:,33)+0.46413*TPK%K106(:)*PCONC(:,34)& -&+0.00000*TPK%K107(:)*PCONC(:,35)+0.08295*TPK%K109(:)*PCONC(:,39)+0.41524*TPK%K& -&110(:)*PCONC(:,40) + PJAC(:,24,33)=+0.56070*TPK%K105(:)*PCONC(:,34)+0.46413*TPK%K106(:)*PCONC(:,35)& +&+0.00000*TPK%K107(:)*PCONC(:,36)+0.08295*TPK%K109(:)*PCONC(:,40)+0.41524*TPK%K& +&110(:)*PCONC(:,41) ! !ALD/ALKAP=+0.33144*K091*<NO>+0.56070*K105*<MO2>+0.71461*K111*<CARBOP>+0.33743* !K120*<NO3> - PJAC(:,23,33)=+0.33144*TPK%K091(:)*PCONC(:,3)+0.56070*TPK%K105(:)*PCONC(:,32)+& -&0.71461*TPK%K111(:)*PCONC(:,39)+0.33743*TPK%K120(:)*PCONC(:,5) + PJAC(:,24,34)=+0.33144*TPK%K091(:)*PCONC(:,3)+0.56070*TPK%K105(:)*PCONC(:,33)+& +&0.71461*TPK%K111(:)*PCONC(:,40)+0.33743*TPK%K120(:)*PCONC(:,5) ! !ALD/ALKEP=+0.42125*K092*<NO>+0.46413*K106*<MO2>+0.68374*K112*<CARBOP>+0.43039* !K121*<NO3> - PJAC(:,23,34)=+0.42125*TPK%K092(:)*PCONC(:,3)+0.46413*TPK%K106(:)*PCONC(:,32)+& -&0.68374*TPK%K112(:)*PCONC(:,39)+0.43039*TPK%K121(:)*PCONC(:,5) + PJAC(:,24,35)=+0.42125*TPK%K092(:)*PCONC(:,3)+0.46413*TPK%K106(:)*PCONC(:,33)+& +&0.68374*TPK%K112(:)*PCONC(:,40)+0.43039*TPK%K121(:)*PCONC(:,5) ! !ALD/BIOP=+0.00000*K093*<NO>+0.00000*K107*<MO2>+0.00000*K113*<CARBOP>+0.00000*K !122*<NO3> - PJAC(:,23,35)=+0.00000*TPK%K093(:)*PCONC(:,3)+0.00000*TPK%K107(:)*PCONC(:,32)+& -&0.00000*TPK%K113(:)*PCONC(:,39)+0.00000*TPK%K122(:)*PCONC(:,5) + PJAC(:,24,36)=+0.00000*TPK%K093(:)*PCONC(:,3)+0.00000*TPK%K107(:)*PCONC(:,33)+& +&0.00000*TPK%K113(:)*PCONC(:,40)+0.00000*TPK%K122(:)*PCONC(:,5) ! !ALD/PHO=0.0 ! @@ -26369,36 +26939,36 @@ SUBROUTINE SUBJ4 !ALD/CARBOP=+0.07368*K095*<NO>+0.08295*K109*<MO2>+0.71461*K111*<ALKAP>+0.68374* !K112*<ALKEP>+0.00000*K113*<BIOP>+0.06969*K115*<CARBOP>+0.06969*K115*<CARBOP>+0 !.42122*K116*<OLN>+0.02936*K124*<NO3> - PJAC(:,23,39)=+0.07368*TPK%K095(:)*PCONC(:,3)+0.08295*TPK%K109(:)*PCONC(:,32)+& -&0.71461*TPK%K111(:)*PCONC(:,33)+0.68374*TPK%K112(:)*PCONC(:,34)+0.00000*TPK%K1& -&13(:)*PCONC(:,35)+0.06969*TPK%K115(:)*PCONC(:,39)+0.06969*TPK%K115(:)*PCONC(:,& -&39)+0.42122*TPK%K116(:)*PCONC(:,40)+0.02936*TPK%K124(:)*PCONC(:,5) + PJAC(:,24,40)=+0.07368*TPK%K095(:)*PCONC(:,3)+0.08295*TPK%K109(:)*PCONC(:,33)+& +&0.71461*TPK%K111(:)*PCONC(:,34)+0.68374*TPK%K112(:)*PCONC(:,35)+0.00000*TPK%K1& +&13(:)*PCONC(:,36)+0.06969*TPK%K115(:)*PCONC(:,40)+0.06969*TPK%K115(:)*PCONC(:,& +&40)+0.42122*TPK%K116(:)*PCONC(:,41)+0.02936*TPK%K124(:)*PCONC(:,5) ! !ALD/OLN=+1.01182*K096*<NO>+0.41524*K110*<MO2>+0.42122*K116*<CARBOP>+0.00000*K1 !18*<OLN>+0.00000*K118*<OLN>+0.91850*K125*<NO3> - PJAC(:,23,40)=+1.01182*TPK%K096(:)*PCONC(:,3)+0.41524*TPK%K110(:)*PCONC(:,32)+& -&0.42122*TPK%K116(:)*PCONC(:,39)+0.00000*TPK%K118(:)*PCONC(:,40)+0.00000*TPK%K1& -&18(:)*PCONC(:,40)+0.91850*TPK%K125(:)*PCONC(:,5) + PJAC(:,24,41)=+1.01182*TPK%K096(:)*PCONC(:,3)+0.41524*TPK%K110(:)*PCONC(:,33)+& +&0.42122*TPK%K116(:)*PCONC(:,40)+0.00000*TPK%K118(:)*PCONC(:,41)+0.00000*TPK%K1& +&18(:)*PCONC(:,41)+0.91850*TPK%K125(:)*PCONC(:,5) ! !ALD/XO2=0.0 ! !KET/O3=+0.07377*K079*<ALKE>+0.00000*K080*<BIO> - PJAC(:,24,1)=+0.07377*TPK%K079(:)*PCONC(:,19)+0.00000*TPK%K080(:)*PCONC(:,20) + PJAC(:,25,1)=+0.07377*TPK%K079(:)*PCONC(:,20)+0.00000*TPK%K080(:)*PCONC(:,21) ! !KET/H2O2=0.0 ! !KET/NO=+0.54531*K091*<ALKAP>+0.05220*K092*<ALKEP>+0.00000*K093*<BIOP>+0.37862* !K096*<OLN> - PJAC(:,24,3)=+0.54531*TPK%K091(:)*PCONC(:,33)+0.05220*TPK%K092(:)*PCONC(:,34)+& -&0.00000*TPK%K093(:)*PCONC(:,35)+0.37862*TPK%K096(:)*PCONC(:,40) + PJAC(:,25,3)=+0.54531*TPK%K091(:)*PCONC(:,34)+0.05220*TPK%K092(:)*PCONC(:,35)+& +&0.00000*TPK%K093(:)*PCONC(:,36)+0.37862*TPK%K096(:)*PCONC(:,41) ! !KET/NO2=0.0 ! !KET/NO3=+0.00632*K074*<CARBO>+0.62978*K120*<ALKAP>+0.02051*K121*<ALKEP>+0.0000 !0*K122*<BIOP>+0.34740*K125*<OLN> - PJAC(:,24,5)=+0.00632*TPK%K074(:)*PCONC(:,25)+0.62978*TPK%K120(:)*PCONC(:,33)+& -&0.02051*TPK%K121(:)*PCONC(:,34)+0.00000*TPK%K122(:)*PCONC(:,35)+0.34740*TPK%K1& -&25(:)*PCONC(:,40) + PJAC(:,25,5)=+0.00632*TPK%K074(:)*PCONC(:,26)+0.62978*TPK%K120(:)*PCONC(:,34)+& +&0.02051*TPK%K121(:)*PCONC(:,35)+0.00000*TPK%K122(:)*PCONC(:,36)+0.34740*TPK%K1& +&25(:)*PCONC(:,41) ! !KET/N2O5=0.0 ! @@ -26410,6 +26980,8 @@ SUBROUTINE SUBJ4 ! !KET/NH3=0.0 ! +!KET/DMS=0.0 +! !KET/SO2=0.0 ! !KET/SULF=0.0 @@ -26417,8 +26989,8 @@ SUBROUTINE SUBJ4 !KET/CO=0.0 ! !KET/OH=+0.03498*K058*<ALKA>-K064*<KET>+0.00853*K065*<CARBO>+0.37591*K069*<OP2> - PJAC(:,24,14)=+0.03498*TPK%K058(:)*PCONC(:,18)-TPK%K064(:)*PCONC(:,24)+0.00853& -&*TPK%K065(:)*PCONC(:,25)+0.37591*TPK%K069(:)*PCONC(:,29) + PJAC(:,25,15)=+0.03498*TPK%K058(:)*PCONC(:,19)-TPK%K064(:)*PCONC(:,25)+0.00853& +&*TPK%K065(:)*PCONC(:,26)+0.37591*TPK%K069(:)*PCONC(:,30) ! !KET/HO2=0.0 ! @@ -26427,13 +26999,13 @@ SUBROUTINE SUBJ4 !KET/ETH=0.0 ! !KET/ALKA=+0.03498*K058*<OH> - PJAC(:,24,18)=+0.03498*TPK%K058(:)*PCONC(:,14) + PJAC(:,25,19)=+0.03498*TPK%K058(:)*PCONC(:,15) ! !KET/ALKE=+0.07377*K079*<O3> - PJAC(:,24,19)=+0.07377*TPK%K079(:)*PCONC(:,1) + PJAC(:,25,20)=+0.07377*TPK%K079(:)*PCONC(:,1) ! !KET/BIO=+0.00000*K080*<O3> - PJAC(:,24,20)=+0.00000*TPK%K080(:)*PCONC(:,1) + PJAC(:,25,21)=+0.00000*TPK%K080(:)*PCONC(:,1) ! !KET/ARO=0.0 ! @@ -26442,20 +27014,20 @@ SUBROUTINE SUBJ4 !KET/ALD=0.0 ! !KET/KET=-K015-K064*<OH> - PJAC(:,24,24)=-TPK%K015(:)-TPK%K064(:)*PCONC(:,14) + PJAC(:,25,25)=-TPK%K015(:)-TPK%K064(:)*PCONC(:,15) ! !KET/CARBO=+0.00853*K065*<OH>+0.00632*K074*<NO3> - PJAC(:,24,25)=+0.00853*TPK%K065(:)*PCONC(:,14)+0.00632*TPK%K074(:)*PCONC(:,5) + PJAC(:,25,26)=+0.00853*TPK%K065(:)*PCONC(:,15)+0.00632*TPK%K074(:)*PCONC(:,5) ! !KET/ONIT=+0.80*K017 - PJAC(:,24,26)=+0.80*TPK%K017(:) + PJAC(:,25,27)=+0.80*TPK%K017(:) ! !KET/PAN=0.0 ! !KET/OP1=0.0 ! !KET/OP2=+0.37591*K069*<OH> - PJAC(:,24,29)=+0.37591*TPK%K069(:)*PCONC(:,14) + PJAC(:,25,30)=+0.37591*TPK%K069(:)*PCONC(:,15) ! !KET/ORA1=0.0 ! @@ -26463,23 +27035,23 @@ SUBROUTINE SUBJ4 ! !KET/MO2=+0.09673*K105*<ALKAP>+0.03814*K106*<ALKEP>+0.00000*K107*<BIOP>+0.09667 !*K110*<OLN> - PJAC(:,24,32)=+0.09673*TPK%K105(:)*PCONC(:,33)+0.03814*TPK%K106(:)*PCONC(:,34)& -&+0.00000*TPK%K107(:)*PCONC(:,35)+0.09667*TPK%K110(:)*PCONC(:,40) + PJAC(:,25,33)=+0.09673*TPK%K105(:)*PCONC(:,34)+0.03814*TPK%K106(:)*PCONC(:,35)& +&+0.00000*TPK%K107(:)*PCONC(:,36)+0.09667*TPK%K110(:)*PCONC(:,41) ! !KET/ALKAP=+0.54531*K091*<NO>+0.09673*K105*<MO2>+0.18819*K111*<CARBOP>+0.62978* !K120*<NO3> - PJAC(:,24,33)=+0.54531*TPK%K091(:)*PCONC(:,3)+0.09673*TPK%K105(:)*PCONC(:,32)+& -&0.18819*TPK%K111(:)*PCONC(:,39)+0.62978*TPK%K120(:)*PCONC(:,5) + PJAC(:,25,34)=+0.54531*TPK%K091(:)*PCONC(:,3)+0.09673*TPK%K105(:)*PCONC(:,33)+& +&0.18819*TPK%K111(:)*PCONC(:,40)+0.62978*TPK%K120(:)*PCONC(:,5) ! !KET/ALKEP=+0.05220*K092*<NO>+0.03814*K106*<MO2>+0.06579*K112*<CARBOP>+0.02051* !K121*<NO3> - PJAC(:,24,34)=+0.05220*TPK%K092(:)*PCONC(:,3)+0.03814*TPK%K106(:)*PCONC(:,32)+& -&0.06579*TPK%K112(:)*PCONC(:,39)+0.02051*TPK%K121(:)*PCONC(:,5) + PJAC(:,25,35)=+0.05220*TPK%K092(:)*PCONC(:,3)+0.03814*TPK%K106(:)*PCONC(:,33)+& +&0.06579*TPK%K112(:)*PCONC(:,40)+0.02051*TPK%K121(:)*PCONC(:,5) ! !KET/BIOP=+0.00000*K093*<NO>+0.00000*K107*<MO2>+0.00000*K113*<CARBOP>+0.00000*K !122*<NO3> - PJAC(:,24,35)=+0.00000*TPK%K093(:)*PCONC(:,3)+0.00000*TPK%K107(:)*PCONC(:,32)+& -&0.00000*TPK%K113(:)*PCONC(:,39)+0.00000*TPK%K122(:)*PCONC(:,5) + PJAC(:,25,36)=+0.00000*TPK%K093(:)*PCONC(:,3)+0.00000*TPK%K107(:)*PCONC(:,33)+& +&0.00000*TPK%K113(:)*PCONC(:,40)+0.00000*TPK%K122(:)*PCONC(:,5) ! !KET/PHO=0.0 ! @@ -26489,39 +27061,47 @@ SUBROUTINE SUBJ4 ! !KET/CARBOP=+0.18819*K111*<ALKAP>+0.06579*K112*<ALKEP>+0.00000*K113*<BIOP>+0.02 !190*K115*<CARBOP>+0.02190*K115*<CARBOP>+0.10822*K116*<OLN> - PJAC(:,24,39)=+0.18819*TPK%K111(:)*PCONC(:,33)+0.06579*TPK%K112(:)*PCONC(:,34)& -&+0.00000*TPK%K113(:)*PCONC(:,35)+0.02190*TPK%K115(:)*PCONC(:,39)+0.02190*TPK%K& -&115(:)*PCONC(:,39)+0.10822*TPK%K116(:)*PCONC(:,40) + PJAC(:,25,40)=+0.18819*TPK%K111(:)*PCONC(:,34)+0.06579*TPK%K112(:)*PCONC(:,35)& +&+0.00000*TPK%K113(:)*PCONC(:,36)+0.02190*TPK%K115(:)*PCONC(:,40)+0.02190*TPK%K& +&115(:)*PCONC(:,40)+0.10822*TPK%K116(:)*PCONC(:,41) ! !KET/OLN=+0.37862*K096*<NO>+0.09667*K110*<MO2>+0.10822*K116*<CARBOP>+0.00000*K1 !18*<OLN>+0.00000*K118*<OLN>+0.34740*K125*<NO3> - PJAC(:,24,40)=+0.37862*TPK%K096(:)*PCONC(:,3)+0.09667*TPK%K110(:)*PCONC(:,32)+& -&0.10822*TPK%K116(:)*PCONC(:,39)+0.00000*TPK%K118(:)*PCONC(:,40)+0.00000*TPK%K1& -&18(:)*PCONC(:,40)+0.34740*TPK%K125(:)*PCONC(:,5) + PJAC(:,25,41)=+0.37862*TPK%K096(:)*PCONC(:,3)+0.09667*TPK%K110(:)*PCONC(:,33)+& +&0.10822*TPK%K116(:)*PCONC(:,40)+0.00000*TPK%K118(:)*PCONC(:,41)+0.00000*TPK%K1& +&18(:)*PCONC(:,41)+0.34740*TPK%K125(:)*PCONC(:,5) ! !KET/XO2=0.0 ! +RETURN +END SUBROUTINE SUBJ4 +! +SUBROUTINE SUBJ5 +! +!Indices 26 a 30 +! +! !CARBO/O3=+0.00000*K079*<ALKE>+0.39754*K080*<BIO>+1.07583*K081*<CARBO>-K081*<CA !RBO> - PJAC(:,25,1)=+0.00000*TPK%K079(:)*PCONC(:,19)+0.39754*TPK%K080(:)*PCONC(:,20)+& -&1.07583*TPK%K081(:)*PCONC(:,25)-TPK%K081(:)*PCONC(:,25) + PJAC(:,26,1)=+0.00000*TPK%K079(:)*PCONC(:,20)+0.39754*TPK%K080(:)*PCONC(:,21)+& +&1.07583*TPK%K081(:)*PCONC(:,26)-TPK%K081(:)*PCONC(:,26) ! !CARBO/H2O2=0.0 ! !CARBO/NO=+0.03407*K091*<ALKAP>+0.45463*K093*<BIOP>+2.06993*K094*<AROP>+0.08670 !*K095*<CARBOP> - PJAC(:,25,3)=+0.03407*TPK%K091(:)*PCONC(:,33)+0.45463*TPK%K093(:)*PCONC(:,35)+& -&2.06993*TPK%K094(:)*PCONC(:,38)+0.08670*TPK%K095(:)*PCONC(:,39) + PJAC(:,26,3)=+0.03407*TPK%K091(:)*PCONC(:,34)+0.45463*TPK%K093(:)*PCONC(:,36)+& +&2.06993*TPK%K094(:)*PCONC(:,39)+0.08670*TPK%K095(:)*PCONC(:,40) ! !CARBO/NO2=0.0 ! !CARBO/NO3=+0.10530*K074*<CARBO>-K074*<CARBO>+0.00000*K076*<ALKE>+0.91741*K077* !<BIO>+0.03531*K120*<ALKAP>+0.61160*K122*<BIOP>+2.81904*K123*<AROP>+0.03455*K12 !4*<CARBOP> - PJAC(:,25,5)=+0.10530*TPK%K074(:)*PCONC(:,25)-TPK%K074(:)*PCONC(:,25)+0.00000*& -&TPK%K076(:)*PCONC(:,19)+0.91741*TPK%K077(:)*PCONC(:,20)+0.03531*TPK%K120(:)*PC& -&ONC(:,33)+0.61160*TPK%K122(:)*PCONC(:,35)+2.81904*TPK%K123(:)*PCONC(:,38)+0.03& -&455*TPK%K124(:)*PCONC(:,39) + PJAC(:,26,5)=+0.10530*TPK%K074(:)*PCONC(:,26)-TPK%K074(:)*PCONC(:,26)+0.00000*& +&TPK%K076(:)*PCONC(:,20)+0.91741*TPK%K077(:)*PCONC(:,21)+0.03531*TPK%K120(:)*PC& +&ONC(:,34)+0.61160*TPK%K122(:)*PCONC(:,36)+2.81904*TPK%K123(:)*PCONC(:,39)+0.03& +&455*TPK%K124(:)*PCONC(:,40) ! !CARBO/N2O5=0.0 ! @@ -26533,6 +27113,8 @@ SUBROUTINE SUBJ4 ! !CARBO/NH3=0.0 ! +!CARBO/DMS=0.0 +! !CARBO/SO2=0.0 ! !CARBO/SULF=0.0 @@ -26541,8 +27123,8 @@ SUBROUTINE SUBJ4 ! !CARBO/OH=+0.00835*K058*<ALKA>+0.16919*K065*<CARBO>-K065*<CARBO>+0.21863*K070*< !PAN> - PJAC(:,25,14)=+0.00835*TPK%K058(:)*PCONC(:,18)+0.16919*TPK%K065(:)*PCONC(:,25)& -&-TPK%K065(:)*PCONC(:,25)+0.21863*TPK%K070(:)*PCONC(:,27) + PJAC(:,26,15)=+0.00835*TPK%K058(:)*PCONC(:,19)+0.16919*TPK%K065(:)*PCONC(:,26)& +&-TPK%K065(:)*PCONC(:,26)+0.21863*TPK%K070(:)*PCONC(:,28) ! !CARBO/HO2=0.0 ! @@ -26551,13 +27133,13 @@ SUBROUTINE SUBJ4 !CARBO/ETH=0.0 ! !CARBO/ALKA=+0.00835*K058*<OH> - PJAC(:,25,18)=+0.00835*TPK%K058(:)*PCONC(:,14) + PJAC(:,26,19)=+0.00835*TPK%K058(:)*PCONC(:,15) ! !CARBO/ALKE=+0.00000*K076*<NO3>+0.00000*K079*<O3> - PJAC(:,25,19)=+0.00000*TPK%K076(:)*PCONC(:,5)+0.00000*TPK%K079(:)*PCONC(:,1) + PJAC(:,26,20)=+0.00000*TPK%K076(:)*PCONC(:,5)+0.00000*TPK%K079(:)*PCONC(:,1) ! !CARBO/BIO=+0.13255*K054*<O3P>+0.91741*K077*<NO3>+0.39754*K080*<O3> - PJAC(:,25,20)=+0.13255*TPK%K054(:)*TPK%O3P(:)+0.91741*TPK%K077(:)*PCONC(:,5)+0& + PJAC(:,26,21)=+0.13255*TPK%K054(:)*TPK%O3P(:)+0.91741*TPK%K077(:)*PCONC(:,5)+0& &.39754*TPK%K080(:)*PCONC(:,1) ! !CARBO/ARO=0.0 @@ -26570,14 +27152,14 @@ SUBROUTINE SUBJ4 ! !CARBO/CARBO=-K016-K055*<O3P>+0.16919*K065*<OH>-K065*<OH>+0.10530*K074*<NO3>-K0 !74*<NO3>+1.07583*K081*<O3>-K081*<O3> - PJAC(:,25,25)=-TPK%K016(:)-TPK%K055(:)*TPK%O3P(:)+0.16919*TPK%K065(:)*PCONC(:,& -&14)-TPK%K065(:)*PCONC(:,14)+0.10530*TPK%K074(:)*PCONC(:,5)-TPK%K074(:)*PCONC(:& + PJAC(:,26,26)=-TPK%K016(:)-TPK%K055(:)*TPK%O3P(:)+0.16919*TPK%K065(:)*PCONC(:,& +&15)-TPK%K065(:)*PCONC(:,15)+0.10530*TPK%K074(:)*PCONC(:,5)-TPK%K074(:)*PCONC(:& &,5)+1.07583*TPK%K081(:)*PCONC(:,1)-TPK%K081(:)*PCONC(:,1) ! !CARBO/ONIT=0.0 ! !CARBO/PAN=+0.21863*K070*<OH> - PJAC(:,25,27)=+0.21863*TPK%K070(:)*PCONC(:,14) + PJAC(:,26,28)=+0.21863*TPK%K070(:)*PCONC(:,15) ! !CARBO/OP1=0.0 ! @@ -26589,20 +27171,20 @@ SUBROUTINE SUBJ4 ! !CARBO/MO2=+0.07976*K105*<ALKAP>+0.56064*K107*<BIOP>+1.99461*K108*<AROP>+0.1538 !7*K109*<CARBOP> - PJAC(:,25,32)=+0.07976*TPK%K105(:)*PCONC(:,33)+0.56064*TPK%K107(:)*PCONC(:,35)& -&+1.99461*TPK%K108(:)*PCONC(:,38)+0.15387*TPK%K109(:)*PCONC(:,39) + PJAC(:,26,33)=+0.07976*TPK%K105(:)*PCONC(:,34)+0.56064*TPK%K107(:)*PCONC(:,36)& +&+1.99461*TPK%K108(:)*PCONC(:,39)+0.15387*TPK%K109(:)*PCONC(:,40) ! !CARBO/ALKAP=+0.03407*K091*<NO>+0.07976*K105*<MO2>+0.06954*K111*<CARBOP>+0.0353 !1*K120*<NO3> - PJAC(:,25,33)=+0.03407*TPK%K091(:)*PCONC(:,3)+0.07976*TPK%K105(:)*PCONC(:,32)+& -&0.06954*TPK%K111(:)*PCONC(:,39)+0.03531*TPK%K120(:)*PCONC(:,5) + PJAC(:,26,34)=+0.03407*TPK%K091(:)*PCONC(:,3)+0.07976*TPK%K105(:)*PCONC(:,33)+& +&0.06954*TPK%K111(:)*PCONC(:,40)+0.03531*TPK%K120(:)*PCONC(:,5) ! !CARBO/ALKEP=0.0 ! !CARBO/BIOP=+0.45463*K093*<NO>+0.56064*K107*<MO2>+0.78591*K113*<CARBOP>+0.61160 !*K122*<NO3> - PJAC(:,25,35)=+0.45463*TPK%K093(:)*PCONC(:,3)+0.56064*TPK%K107(:)*PCONC(:,32)+& -&0.78591*TPK%K113(:)*PCONC(:,39)+0.61160*TPK%K122(:)*PCONC(:,5) + PJAC(:,26,36)=+0.45463*TPK%K093(:)*PCONC(:,3)+0.56064*TPK%K107(:)*PCONC(:,33)+& +&0.78591*TPK%K113(:)*PCONC(:,40)+0.61160*TPK%K122(:)*PCONC(:,5) ! !CARBO/PHO=0.0 ! @@ -26610,43 +27192,35 @@ SUBROUTINE SUBJ4 ! !CARBO/AROP=+2.06993*K094*<NO>+1.99461*K108*<MO2>+1.99455*K114*<CARBOP>+2.81904 !*K123*<NO3> - PJAC(:,25,38)=+2.06993*TPK%K094(:)*PCONC(:,3)+1.99461*TPK%K108(:)*PCONC(:,32)+& -&1.99455*TPK%K114(:)*PCONC(:,39)+2.81904*TPK%K123(:)*PCONC(:,5) + PJAC(:,26,39)=+2.06993*TPK%K094(:)*PCONC(:,3)+1.99461*TPK%K108(:)*PCONC(:,33)+& +&1.99455*TPK%K114(:)*PCONC(:,40)+2.81904*TPK%K123(:)*PCONC(:,5) ! !CARBO/CARBOP=+0.08670*K095*<NO>+0.15387*K109*<MO2>+0.06954*K111*<ALKAP>+0.7859 !1*K113*<BIOP>+1.99455*K114*<AROP>+0.10777*K115*<CARBOP>+0.10777*K115*<CARBOP>+ !0.03455*K124*<NO3> - PJAC(:,25,39)=+0.08670*TPK%K095(:)*PCONC(:,3)+0.15387*TPK%K109(:)*PCONC(:,32)+& -&0.06954*TPK%K111(:)*PCONC(:,33)+0.78591*TPK%K113(:)*PCONC(:,35)+1.99455*TPK%K1& -&14(:)*PCONC(:,38)+0.10777*TPK%K115(:)*PCONC(:,39)+0.10777*TPK%K115(:)*PCONC(:,& -&39)+0.03455*TPK%K124(:)*PCONC(:,5) + PJAC(:,26,40)=+0.08670*TPK%K095(:)*PCONC(:,3)+0.15387*TPK%K109(:)*PCONC(:,33)+& +&0.06954*TPK%K111(:)*PCONC(:,34)+0.78591*TPK%K113(:)*PCONC(:,36)+1.99455*TPK%K1& +&14(:)*PCONC(:,39)+0.10777*TPK%K115(:)*PCONC(:,40)+0.10777*TPK%K115(:)*PCONC(:,& +&40)+0.03455*TPK%K124(:)*PCONC(:,5) ! !CARBO/OLN=0.0 ! !CARBO/XO2=0.0 ! -RETURN -END SUBROUTINE SUBJ4 -! -SUBROUTINE SUBJ5 -! -!Indices 26 a 30 -! -! !ONIT/O3=0.0 ! !ONIT/H2O2=0.0 ! !ONIT/NO=+0.08459*K091*<ALKAP>+0.15300*K093*<BIOP>+0.04885*K094*<AROP>+0.18401* !K096*<OLN> - PJAC(:,26,3)=+0.08459*TPK%K091(:)*PCONC(:,33)+0.15300*TPK%K093(:)*PCONC(:,35)+& -&0.04885*TPK%K094(:)*PCONC(:,38)+0.18401*TPK%K096(:)*PCONC(:,40) + PJAC(:,27,3)=+0.08459*TPK%K091(:)*PCONC(:,34)+0.15300*TPK%K093(:)*PCONC(:,36)+& +&0.04885*TPK%K094(:)*PCONC(:,39)+0.18401*TPK%K096(:)*PCONC(:,41) ! !ONIT/NO2=+K083*<PHO> - PJAC(:,26,4)=+TPK%K083(:)*PCONC(:,36) + PJAC(:,27,4)=+TPK%K083(:)*PCONC(:,37) ! !ONIT/NO3=+0.60*K078*<PAN>+0.25928*K125*<OLN> - PJAC(:,26,5)=+0.60*TPK%K078(:)*PCONC(:,27)+0.25928*TPK%K125(:)*PCONC(:,40) + PJAC(:,27,5)=+0.60*TPK%K078(:)*PCONC(:,28)+0.25928*TPK%K125(:)*PCONC(:,41) ! !ONIT/N2O5=0.0 ! @@ -26658,6 +27232,8 @@ SUBROUTINE SUBJ5 ! !ONIT/NH3=0.0 ! +!ONIT/DMS=0.0 +! !ONIT/SO2=0.0 ! !ONIT/SULF=0.0 @@ -26665,10 +27241,10 @@ SUBROUTINE SUBJ5 !ONIT/CO=0.0 ! !ONIT/OH=-K071*<ONIT> - PJAC(:,26,14)=-TPK%K071(:)*PCONC(:,26) + PJAC(:,27,15)=-TPK%K071(:)*PCONC(:,27) ! !ONIT/HO2=+K103*<OLN> - PJAC(:,26,15)=+TPK%K103(:)*PCONC(:,40) + PJAC(:,27,16)=+TPK%K103(:)*PCONC(:,41) ! !ONIT/CH4=0.0 ! @@ -26691,10 +27267,10 @@ SUBROUTINE SUBJ5 !ONIT/CARBO=0.0 ! !ONIT/ONIT=-K017-K071*<OH> - PJAC(:,26,26)=-TPK%K017(:)-TPK%K071(:)*PCONC(:,14) + PJAC(:,27,27)=-TPK%K017(:)-TPK%K071(:)*PCONC(:,15) ! !ONIT/PAN=+0.60*K078*<NO3> - PJAC(:,26,27)=+0.60*TPK%K078(:)*PCONC(:,5) + PJAC(:,27,28)=+0.60*TPK%K078(:)*PCONC(:,5) ! !ONIT/OP1=0.0 ! @@ -26705,49 +27281,49 @@ SUBROUTINE SUBJ5 !ONIT/ORA2=0.0 ! !ONIT/MO2=+0.67560*K110*<OLN> - PJAC(:,26,32)=+0.67560*TPK%K110(:)*PCONC(:,40) + PJAC(:,27,33)=+0.67560*TPK%K110(:)*PCONC(:,41) ! !ONIT/ALKAP=+0.08459*K091*<NO> - PJAC(:,26,33)=+0.08459*TPK%K091(:)*PCONC(:,3) + PJAC(:,27,34)=+0.08459*TPK%K091(:)*PCONC(:,3) ! !ONIT/ALKEP=0.0 ! !ONIT/BIOP=+0.15300*K093*<NO> - PJAC(:,26,35)=+0.15300*TPK%K093(:)*PCONC(:,3) + PJAC(:,27,36)=+0.15300*TPK%K093(:)*PCONC(:,3) ! !ONIT/PHO=+K083*<NO2> - PJAC(:,26,36)=+TPK%K083(:)*PCONC(:,4) + PJAC(:,27,37)=+TPK%K083(:)*PCONC(:,4) ! !ONIT/ADD=0.0 ! !ONIT/AROP=+0.04885*K094*<NO> - PJAC(:,26,38)=+0.04885*TPK%K094(:)*PCONC(:,3) + PJAC(:,27,39)=+0.04885*TPK%K094(:)*PCONC(:,3) ! !ONIT/CARBOP=+0.66562*K116*<OLN> - PJAC(:,26,39)=+0.66562*TPK%K116(:)*PCONC(:,40) + PJAC(:,27,40)=+0.66562*TPK%K116(:)*PCONC(:,41) ! !ONIT/OLN=+0.18401*K096*<NO>+K103*<HO2>+0.67560*K110*<MO2>+0.66562*K116*<CARBOP !>+2.00*K117*<OLN>+2.00*K117*<OLN>+0.00000*K118*<OLN>+0.00000*K118*<OLN>+0.2592 !8*K125*<NO3> - PJAC(:,26,40)=+0.18401*TPK%K096(:)*PCONC(:,3)+TPK%K103(:)*PCONC(:,15)+0.67560*& -&TPK%K110(:)*PCONC(:,32)+0.66562*TPK%K116(:)*PCONC(:,39)+2.00*TPK%K117(:)*PCONC& -&(:,40)+2.00*TPK%K117(:)*PCONC(:,40)+0.00000*TPK%K118(:)*PCONC(:,40)+0.00000*TP& -&K%K118(:)*PCONC(:,40)+0.25928*TPK%K125(:)*PCONC(:,5) + PJAC(:,27,41)=+0.18401*TPK%K096(:)*PCONC(:,3)+TPK%K103(:)*PCONC(:,16)+0.67560*& +&TPK%K110(:)*PCONC(:,33)+0.66562*TPK%K116(:)*PCONC(:,40)+2.00*TPK%K117(:)*PCONC& +&(:,41)+2.00*TPK%K117(:)*PCONC(:,41)+0.00000*TPK%K118(:)*PCONC(:,41)+0.00000*TP& +&K%K118(:)*PCONC(:,41)+0.25928*TPK%K125(:)*PCONC(:,5) ! !ONIT/XO2=0.0 ! !PAN/O3=+0.30000*K082*<PAN>-K082*<PAN> - PJAC(:,27,1)=+0.30000*TPK%K082(:)*PCONC(:,27)-TPK%K082(:)*PCONC(:,27) + PJAC(:,28,1)=+0.30000*TPK%K082(:)*PCONC(:,28)-TPK%K082(:)*PCONC(:,28) ! !PAN/H2O2=0.0 ! !PAN/NO=0.0 ! !PAN/NO2=+1.00000*K088*<CARBOP> - PJAC(:,27,4)=+1.00000*TPK%K088(:)*PCONC(:,39) + PJAC(:,28,4)=+1.00000*TPK%K088(:)*PCONC(:,40) ! !PAN/NO3=+0.40000*K078*<PAN>-K078*<PAN> - PJAC(:,27,5)=+0.40000*TPK%K078(:)*PCONC(:,27)-TPK%K078(:)*PCONC(:,27) + PJAC(:,28,5)=+0.40000*TPK%K078(:)*PCONC(:,28)-TPK%K078(:)*PCONC(:,28) ! !PAN/N2O5=0.0 ! @@ -26759,6 +27335,8 @@ SUBROUTINE SUBJ5 ! !PAN/NH3=0.0 ! +!PAN/DMS=0.0 +! !PAN/SO2=0.0 ! !PAN/SULF=0.0 @@ -26766,7 +27344,7 @@ SUBROUTINE SUBJ5 !PAN/CO=0.0 ! !PAN/OH=+0.28107*K070*<PAN>-K070*<PAN> - PJAC(:,27,14)=+0.28107*TPK%K070(:)*PCONC(:,27)-TPK%K070(:)*PCONC(:,27) + PJAC(:,28,15)=+0.28107*TPK%K070(:)*PCONC(:,28)-TPK%K070(:)*PCONC(:,28) ! !PAN/HO2=0.0 ! @@ -26794,7 +27372,7 @@ SUBROUTINE SUBJ5 ! !PAN/PAN=+0.28107*K070*<OH>-K070*<OH>+0.40000*K078*<NO3>-K078*<NO3>+0.30000*K08 !2*<O3>-K082*<O3>-K089 - PJAC(:,27,27)=+0.28107*TPK%K070(:)*PCONC(:,14)-TPK%K070(:)*PCONC(:,14)+0.40000& + PJAC(:,28,28)=+0.28107*TPK%K070(:)*PCONC(:,15)-TPK%K070(:)*PCONC(:,15)+0.40000& &*TPK%K078(:)*PCONC(:,5)-TPK%K078(:)*PCONC(:,5)+0.30000*TPK%K082(:)*PCONC(:,1)-& &TPK%K082(:)*PCONC(:,1)-TPK%K089(:) ! @@ -26821,7 +27399,7 @@ SUBROUTINE SUBJ5 !PAN/AROP=0.0 ! !PAN/CARBOP=+1.00000*K088*<NO2> - PJAC(:,27,39)=+1.00000*TPK%K088(:)*PCONC(:,4) + PJAC(:,28,40)=+1.00000*TPK%K088(:)*PCONC(:,4) ! !PAN/OLN=0.0 ! @@ -26847,6 +27425,8 @@ SUBROUTINE SUBJ5 ! !OP1/NH3=0.0 ! +!OP1/DMS=0.0 +! !OP1/SO2=0.0 ! !OP1/SULF=0.0 @@ -26854,10 +27434,10 @@ SUBROUTINE SUBJ5 !OP1/CO=0.0 ! !OP1/OH=-K068*<OP1> - PJAC(:,28,14)=-TPK%K068(:)*PCONC(:,28) + PJAC(:,29,15)=-TPK%K068(:)*PCONC(:,29) ! !OP1/HO2=+K097*<MO2> - PJAC(:,28,15)=+TPK%K097(:)*PCONC(:,32) + PJAC(:,29,16)=+TPK%K097(:)*PCONC(:,33) ! !OP1/CH4=0.0 ! @@ -26884,7 +27464,7 @@ SUBROUTINE SUBJ5 !OP1/PAN=0.0 ! !OP1/OP1=-K013-K068*<OH> - PJAC(:,28,28)=-TPK%K013(:)-TPK%K068(:)*PCONC(:,14) + PJAC(:,29,29)=-TPK%K013(:)-TPK%K068(:)*PCONC(:,15) ! !OP1/OP2=0.0 ! @@ -26893,7 +27473,7 @@ SUBROUTINE SUBJ5 !OP1/ORA2=0.0 ! !OP1/MO2=+K097*<HO2> - PJAC(:,28,32)=+TPK%K097(:)*PCONC(:,15) + PJAC(:,29,33)=+TPK%K097(:)*PCONC(:,16) ! !OP1/ALKAP=0.0 ! @@ -26914,7 +27494,7 @@ SUBROUTINE SUBJ5 !OP1/XO2=0.0 ! !OP2/O3=+0.10149*K081*<CARBO> - PJAC(:,29,1)=+0.10149*TPK%K081(:)*PCONC(:,25) + PJAC(:,30,1)=+0.10149*TPK%K081(:)*PCONC(:,26) ! !OP2/H2O2=0.0 ! @@ -26934,6 +27514,8 @@ SUBROUTINE SUBJ5 ! !OP2/NH3=0.0 ! +!OP2/DMS=0.0 +! !OP2/SO2=0.0 ! !OP2/SULF=0.0 @@ -26941,13 +27523,13 @@ SUBROUTINE SUBJ5 !OP2/CO=0.0 ! !OP2/OH=-K069*<OP2> - PJAC(:,29,14)=-TPK%K069(:)*PCONC(:,29) + PJAC(:,30,15)=-TPK%K069(:)*PCONC(:,30) ! !OP2/HO2=+1.00524*K098*<ALKAP>+1.00524*K099*<ALKEP>+1.00524*K0100*<BIOP>+1.0052 !4*K0101*<AROP>+0.80904*K0102*<CARBOP>+1.00524*K126*<XO2> - PJAC(:,29,15)=+1.00524*TPK%K098(:)*PCONC(:,33)+1.00524*TPK%K099(:)*PCONC(:,34)& -&+1.00524*TPK%K0100(:)*PCONC(:,35)+1.00524*TPK%K0101(:)*PCONC(:,38)+0.80904*TPK& -&%K0102(:)*PCONC(:,39)+1.00524*TPK%K126(:)*PCONC(:,41) + PJAC(:,30,16)=+1.00524*TPK%K098(:)*PCONC(:,34)+1.00524*TPK%K099(:)*PCONC(:,35)& +&+1.00524*TPK%K0100(:)*PCONC(:,36)+1.00524*TPK%K0101(:)*PCONC(:,39)+0.80904*TPK& +&%K0102(:)*PCONC(:,40)+1.00524*TPK%K126(:)*PCONC(:,42) ! !OP2/CH4=0.0 ! @@ -26968,7 +27550,7 @@ SUBROUTINE SUBJ5 !OP2/KET=0.0 ! !OP2/CARBO=+0.10149*K081*<O3> - PJAC(:,29,25)=+0.10149*TPK%K081(:)*PCONC(:,1) + PJAC(:,30,26)=+0.10149*TPK%K081(:)*PCONC(:,1) ! !OP2/ONIT=0.0 ! @@ -26977,7 +27559,7 @@ SUBROUTINE SUBJ5 !OP2/OP1=0.0 ! !OP2/OP2=-K014-K069*<OH> - PJAC(:,29,29)=-TPK%K014(:)-TPK%K069(:)*PCONC(:,14) + PJAC(:,30,30)=-TPK%K014(:)-TPK%K069(:)*PCONC(:,15) ! !OP2/ORA1=0.0 ! @@ -26986,33 +27568,41 @@ SUBROUTINE SUBJ5 !OP2/MO2=0.0 ! !OP2/ALKAP=+1.00524*K098*<HO2> - PJAC(:,29,33)=+1.00524*TPK%K098(:)*PCONC(:,15) + PJAC(:,30,34)=+1.00524*TPK%K098(:)*PCONC(:,16) ! !OP2/ALKEP=+1.00524*K099*<HO2> - PJAC(:,29,34)=+1.00524*TPK%K099(:)*PCONC(:,15) + PJAC(:,30,35)=+1.00524*TPK%K099(:)*PCONC(:,16) ! !OP2/BIOP=+1.00524*K0100*<HO2> - PJAC(:,29,35)=+1.00524*TPK%K0100(:)*PCONC(:,15) + PJAC(:,30,36)=+1.00524*TPK%K0100(:)*PCONC(:,16) ! !OP2/PHO=0.0 ! !OP2/ADD=0.0 ! !OP2/AROP=+1.00524*K0101*<HO2> - PJAC(:,29,38)=+1.00524*TPK%K0101(:)*PCONC(:,15) + PJAC(:,30,39)=+1.00524*TPK%K0101(:)*PCONC(:,16) ! !OP2/CARBOP=+0.80904*K0102*<HO2> - PJAC(:,29,39)=+0.80904*TPK%K0102(:)*PCONC(:,15) + PJAC(:,30,40)=+0.80904*TPK%K0102(:)*PCONC(:,16) ! !OP2/OLN=0.0 ! !OP2/XO2=+1.00524*K126*<HO2> - PJAC(:,29,41)=+1.00524*TPK%K126(:)*PCONC(:,15) + PJAC(:,30,42)=+1.00524*TPK%K126(:)*PCONC(:,16) +! +RETURN +END SUBROUTINE SUBJ5 +! +SUBROUTINE SUBJ6 +! +!Indices 31 a 35 +! ! !ORA1/O3=+0.15343*K079*<ALKE>+0.15000*K080*<BIO>+0.10788*K081*<CARBO>+0.11*K082 !*<PAN> - PJAC(:,30,1)=+0.15343*TPK%K079(:)*PCONC(:,19)+0.15000*TPK%K080(:)*PCONC(:,20)+& -&0.10788*TPK%K081(:)*PCONC(:,25)+0.11*TPK%K082(:)*PCONC(:,27) + PJAC(:,31,1)=+0.15343*TPK%K079(:)*PCONC(:,20)+0.15000*TPK%K080(:)*PCONC(:,21)+& +&0.10788*TPK%K081(:)*PCONC(:,26)+0.11*TPK%K082(:)*PCONC(:,28) ! !ORA1/H2O2=0.0 ! @@ -27032,6 +27622,8 @@ SUBROUTINE SUBJ5 ! !ORA1/NH3=0.0 ! +!ORA1/DMS=0.0 +! !ORA1/SO2=0.0 ! !ORA1/SULF=0.0 @@ -27039,7 +27631,7 @@ SUBROUTINE SUBJ5 !ORA1/CO=0.0 ! !ORA1/OH=+0.00878*K058*<ALKA>-K066*<ORA1> - PJAC(:,30,14)=+0.00878*TPK%K058(:)*PCONC(:,18)-TPK%K066(:)*PCONC(:,30) + PJAC(:,31,15)=+0.00878*TPK%K058(:)*PCONC(:,19)-TPK%K066(:)*PCONC(:,31) ! !ORA1/HO2=0.0 ! @@ -27048,13 +27640,13 @@ SUBROUTINE SUBJ5 !ORA1/ETH=0.0 ! !ORA1/ALKA=+0.00878*K058*<OH> - PJAC(:,30,18)=+0.00878*TPK%K058(:)*PCONC(:,14) + PJAC(:,31,19)=+0.00878*TPK%K058(:)*PCONC(:,15) ! !ORA1/ALKE=+0.15343*K079*<O3> - PJAC(:,30,19)=+0.15343*TPK%K079(:)*PCONC(:,1) + PJAC(:,31,20)=+0.15343*TPK%K079(:)*PCONC(:,1) ! !ORA1/BIO=+0.15000*K080*<O3> - PJAC(:,30,20)=+0.15000*TPK%K080(:)*PCONC(:,1) + PJAC(:,31,21)=+0.15000*TPK%K080(:)*PCONC(:,1) ! !ORA1/ARO=0.0 ! @@ -27065,19 +27657,19 @@ SUBROUTINE SUBJ5 !ORA1/KET=0.0 ! !ORA1/CARBO=+0.10788*K081*<O3> - PJAC(:,30,25)=+0.10788*TPK%K081(:)*PCONC(:,1) + PJAC(:,31,26)=+0.10788*TPK%K081(:)*PCONC(:,1) ! !ORA1/ONIT=0.0 ! !ORA1/PAN=+0.11*K082*<O3> - PJAC(:,30,27)=+0.11*TPK%K082(:)*PCONC(:,1) + PJAC(:,31,28)=+0.11*TPK%K082(:)*PCONC(:,1) ! !ORA1/OP1=0.0 ! !ORA1/OP2=0.0 ! !ORA1/ORA1=-K066*<OH> - PJAC(:,30,30)=-TPK%K066(:)*PCONC(:,14) + PJAC(:,31,31)=-TPK%K066(:)*PCONC(:,15) ! !ORA1/ORA2=0.0 ! @@ -27101,17 +27693,9 @@ SUBROUTINE SUBJ5 ! !ORA1/XO2=0.0 ! -RETURN -END SUBROUTINE SUBJ5 -! -SUBROUTINE SUBJ6 -! -!Indices 31 a 35 -! -! !ORA2/O3=+0.08143*K079*<ALKE>+0.00000*K080*<BIO>+0.20595*K081*<CARBO> - PJAC(:,31,1)=+0.08143*TPK%K079(:)*PCONC(:,19)+0.00000*TPK%K080(:)*PCONC(:,20)+& -&0.20595*TPK%K081(:)*PCONC(:,25) + PJAC(:,32,1)=+0.08143*TPK%K079(:)*PCONC(:,20)+0.00000*TPK%K080(:)*PCONC(:,21)+& +&0.20595*TPK%K081(:)*PCONC(:,26) ! !ORA2/H2O2=0.0 ! @@ -27131,6 +27715,8 @@ SUBROUTINE SUBJ6 ! !ORA2/NH3=0.0 ! +!ORA2/DMS=0.0 +! !ORA2/SO2=0.0 ! !ORA2/SULF=0.0 @@ -27138,10 +27724,10 @@ SUBROUTINE SUBJ6 !ORA2/CO=0.0 ! !ORA2/OH=-K067*<ORA2> - PJAC(:,31,14)=-TPK%K067(:)*PCONC(:,31) + PJAC(:,32,15)=-TPK%K067(:)*PCONC(:,32) ! !ORA2/HO2=+0.17307*K0102*<CARBOP> - PJAC(:,31,15)=+0.17307*TPK%K0102(:)*PCONC(:,39) + PJAC(:,32,16)=+0.17307*TPK%K0102(:)*PCONC(:,40) ! !ORA2/CH4=0.0 ! @@ -27150,10 +27736,10 @@ SUBROUTINE SUBJ6 !ORA2/ALKA=0.0 ! !ORA2/ALKE=+0.08143*K079*<O3> - PJAC(:,31,19)=+0.08143*TPK%K079(:)*PCONC(:,1) + PJAC(:,32,20)=+0.08143*TPK%K079(:)*PCONC(:,1) ! !ORA2/BIO=+0.00000*K080*<O3> - PJAC(:,31,20)=+0.00000*TPK%K080(:)*PCONC(:,1) + PJAC(:,32,21)=+0.00000*TPK%K080(:)*PCONC(:,1) ! !ORA2/ARO=0.0 ! @@ -27164,7 +27750,7 @@ SUBROUTINE SUBJ6 !ORA2/KET=0.0 ! !ORA2/CARBO=+0.20595*K081*<O3> - PJAC(:,31,25)=+0.20595*TPK%K081(:)*PCONC(:,1) + PJAC(:,32,26)=+0.20595*TPK%K081(:)*PCONC(:,1) ! !ORA2/ONIT=0.0 ! @@ -27177,19 +27763,19 @@ SUBROUTINE SUBJ6 !ORA2/ORA1=0.0 ! !ORA2/ORA2=-K067*<OH> - PJAC(:,31,31)=-TPK%K067(:)*PCONC(:,14) + PJAC(:,32,32)=-TPK%K067(:)*PCONC(:,15) ! !ORA2/MO2=+0.13684*K109*<CARBOP> - PJAC(:,31,32)=+0.13684*TPK%K109(:)*PCONC(:,39) + PJAC(:,32,33)=+0.13684*TPK%K109(:)*PCONC(:,40) ! !ORA2/ALKAP=+0.49810*K111*<CARBOP> - PJAC(:,31,33)=+0.49810*TPK%K111(:)*PCONC(:,39) + PJAC(:,32,34)=+0.49810*TPK%K111(:)*PCONC(:,40) ! !ORA2/ALKEP=+0.49922*K112*<CARBOP> - PJAC(:,31,34)=+0.49922*TPK%K112(:)*PCONC(:,39) + PJAC(:,32,35)=+0.49922*TPK%K112(:)*PCONC(:,40) ! !ORA2/BIOP=+0.49400*K113*<CARBOP> - PJAC(:,31,35)=+0.49400*TPK%K113(:)*PCONC(:,39) + PJAC(:,32,36)=+0.49400*TPK%K113(:)*PCONC(:,40) ! !ORA2/PHO=0.0 ! @@ -27200,30 +27786,30 @@ SUBROUTINE SUBJ6 !ORA2/CARBOP=+0.17307*K0102*<HO2>+0.13684*K109*<MO2>+0.49810*K111*<ALKAP>+0.499 !22*K112*<ALKEP>+0.49400*K113*<BIOP>+0.09955*K115*<CARBOP>+0.09955*K115*<CARBOP !>+0.48963*K116*<OLN> - PJAC(:,31,39)=+0.17307*TPK%K0102(:)*PCONC(:,15)+0.13684*TPK%K109(:)*PCONC(:,32& -&)+0.49810*TPK%K111(:)*PCONC(:,33)+0.49922*TPK%K112(:)*PCONC(:,34)+0.49400*TPK%& -&K113(:)*PCONC(:,35)+0.09955*TPK%K115(:)*PCONC(:,39)+0.09955*TPK%K115(:)*PCONC(& -&:,39)+0.48963*TPK%K116(:)*PCONC(:,40) + PJAC(:,32,40)=+0.17307*TPK%K0102(:)*PCONC(:,16)+0.13684*TPK%K109(:)*PCONC(:,33& +&)+0.49810*TPK%K111(:)*PCONC(:,34)+0.49922*TPK%K112(:)*PCONC(:,35)+0.49400*TPK%& +&K113(:)*PCONC(:,36)+0.09955*TPK%K115(:)*PCONC(:,40)+0.09955*TPK%K115(:)*PCONC(& +&:,40)+0.48963*TPK%K116(:)*PCONC(:,41) ! !ORA2/OLN=+0.48963*K116*<CARBOP> - PJAC(:,31,40)=+0.48963*TPK%K116(:)*PCONC(:,39) + PJAC(:,32,41)=+0.48963*TPK%K116(:)*PCONC(:,40) ! !ORA2/XO2=0.0 ! !MO2/O3=+0.13966*K079*<ALKE>+0.03000*K080*<BIO> - PJAC(:,32,1)=+0.13966*TPK%K079(:)*PCONC(:,19)+0.03000*TPK%K080(:)*PCONC(:,20) + PJAC(:,33,1)=+0.13966*TPK%K079(:)*PCONC(:,20)+0.03000*TPK%K080(:)*PCONC(:,21) ! !MO2/H2O2=0.0 ! !MO2/NO=-K090*<MO2>+0.09016*K091*<ALKAP>+0.78134*K095*<CARBOP> - PJAC(:,32,3)=-TPK%K090(:)*PCONC(:,32)+0.09016*TPK%K091(:)*PCONC(:,33)+0.78134*& -&TPK%K095(:)*PCONC(:,39) + PJAC(:,33,3)=-TPK%K090(:)*PCONC(:,33)+0.09016*TPK%K091(:)*PCONC(:,34)+0.78134*& +&TPK%K095(:)*PCONC(:,40) ! !MO2/NO2=0.0 ! !MO2/NO3=-K119*<MO2>+0.09731*K120*<ALKAP>+0.91910*K124*<CARBOP> - PJAC(:,32,5)=-TPK%K119(:)*PCONC(:,32)+0.09731*TPK%K120(:)*PCONC(:,33)+0.91910*& -&TPK%K124(:)*PCONC(:,39) + PJAC(:,33,5)=-TPK%K119(:)*PCONC(:,33)+0.09731*TPK%K120(:)*PCONC(:,34)+0.91910*& +&TPK%K124(:)*PCONC(:,40) ! !MO2/N2O5=0.0 ! @@ -27235,6 +27821,8 @@ SUBROUTINE SUBJ6 ! !MO2/NH3=0.0 ! +!MO2/DMS=0.0 +! !MO2/SO2=0.0 ! !MO2/SULF=0.0 @@ -27242,30 +27830,30 @@ SUBROUTINE SUBJ6 !MO2/CO=0.0 ! !MO2/OH=+K056*<CH4>+0.65*K068*<OP1> - PJAC(:,32,14)=+TPK%K056(:)*PCONC(:,16)+0.65*TPK%K068(:)*PCONC(:,28) + PJAC(:,33,15)=+TPK%K056(:)*PCONC(:,17)+0.65*TPK%K068(:)*PCONC(:,29) ! !MO2/HO2=-K097*<MO2> - PJAC(:,32,15)=-TPK%K097(:)*PCONC(:,32) + PJAC(:,33,16)=-TPK%K097(:)*PCONC(:,33) ! !MO2/CH4=+K056*<OH> - PJAC(:,32,16)=+TPK%K056(:)*PCONC(:,14) + PJAC(:,33,17)=+TPK%K056(:)*PCONC(:,15) ! !MO2/ETH=0.0 ! !MO2/ALKA=0.0 ! !MO2/ALKE=+0.13966*K079*<O3> - PJAC(:,32,19)=+0.13966*TPK%K079(:)*PCONC(:,1) + PJAC(:,33,20)=+0.13966*TPK%K079(:)*PCONC(:,1) ! !MO2/BIO=+0.03000*K080*<O3> - PJAC(:,32,20)=+0.03000*TPK%K080(:)*PCONC(:,1) + PJAC(:,33,21)=+0.03000*TPK%K080(:)*PCONC(:,1) ! !MO2/ARO=0.0 ! !MO2/HCHO=0.0 ! !MO2/ALD=+K012 - PJAC(:,32,23)=+TPK%K012(:) + PJAC(:,33,24)=+TPK%K012(:) ! !MO2/KET=0.0 ! @@ -27276,10 +27864,10 @@ SUBROUTINE SUBJ6 !MO2/PAN=0.0 ! !MO2/OP1=+0.65*K068*<OH> - PJAC(:,32,28)=+0.65*TPK%K068(:)*PCONC(:,14) + PJAC(:,33,29)=+0.65*TPK%K068(:)*PCONC(:,15) ! !MO2/OP2=+0.03795*K014 - PJAC(:,32,29)=+0.03795*TPK%K014(:) + PJAC(:,33,30)=+0.03795*TPK%K014(:) ! !MO2/ORA1=0.0 ! @@ -27288,59 +27876,59 @@ SUBROUTINE SUBJ6 !MO2/MO2=-K090*<NO>-K097*<HO2>-K104*<MO2>-K104*<MO2>-K104*<MO2>-K104*<MO2>+0.01 !390*K105*<ALKAP>-K105*<ALKAP>-K106*<ALKEP>-K107*<BIOP>-K108*<AROP>+0.56031*K10 !9*<CARBOP>-K109*<CARBOP>-K110*<OLN>-K119*<NO3>-K127*<XO2> - PJAC(:,32,32)=-TPK%K090(:)*PCONC(:,3)-TPK%K097(:)*PCONC(:,15)-TPK%K104(:)*PCON& -&C(:,32)-TPK%K104(:)*PCONC(:,32)-TPK%K104(:)*PCONC(:,32)-TPK%K104(:)*PCONC(:,32& -&)+0.01390*TPK%K105(:)*PCONC(:,33)-TPK%K105(:)*PCONC(:,33)-TPK%K106(:)*PCONC(:,& -&34)-TPK%K107(:)*PCONC(:,35)-TPK%K108(:)*PCONC(:,38)+0.56031*TPK%K109(:)*PCONC(& -&:,39)-TPK%K109(:)*PCONC(:,39)-TPK%K110(:)*PCONC(:,40)-TPK%K119(:)*PCONC(:,5)-T& -&PK%K127(:)*PCONC(:,41) + PJAC(:,33,33)=-TPK%K090(:)*PCONC(:,3)-TPK%K097(:)*PCONC(:,16)-TPK%K104(:)*PCON& +&C(:,33)-TPK%K104(:)*PCONC(:,33)-TPK%K104(:)*PCONC(:,33)-TPK%K104(:)*PCONC(:,33& +&)+0.01390*TPK%K105(:)*PCONC(:,34)-TPK%K105(:)*PCONC(:,34)-TPK%K106(:)*PCONC(:,& +&35)-TPK%K107(:)*PCONC(:,36)-TPK%K108(:)*PCONC(:,39)+0.56031*TPK%K109(:)*PCONC(& +&:,40)-TPK%K109(:)*PCONC(:,40)-TPK%K110(:)*PCONC(:,41)-TPK%K119(:)*PCONC(:,5)-T& +&PK%K127(:)*PCONC(:,42) ! !MO2/ALKAP=+0.09016*K091*<NO>+0.01390*K105*<MO2>-K105*<MO2>+0.51480*K111*<CARBO !P>+0.09731*K120*<NO3> - PJAC(:,32,33)=+0.09016*TPK%K091(:)*PCONC(:,3)+0.01390*TPK%K105(:)*PCONC(:,32)-& -&TPK%K105(:)*PCONC(:,32)+0.51480*TPK%K111(:)*PCONC(:,39)+0.09731*TPK%K120(:)*PC& + PJAC(:,33,34)=+0.09016*TPK%K091(:)*PCONC(:,3)+0.01390*TPK%K105(:)*PCONC(:,33)-& +&TPK%K105(:)*PCONC(:,33)+0.51480*TPK%K111(:)*PCONC(:,40)+0.09731*TPK%K120(:)*PC& &ONC(:,5) ! !MO2/ALKEP=-K106*<MO2>+0.50078*K112*<CARBOP> - PJAC(:,32,34)=-TPK%K106(:)*PCONC(:,32)+0.50078*TPK%K112(:)*PCONC(:,39) + PJAC(:,33,35)=-TPK%K106(:)*PCONC(:,33)+0.50078*TPK%K112(:)*PCONC(:,40) ! !MO2/BIOP=-K107*<MO2>+0.50600*K113*<CARBOP> - PJAC(:,32,35)=-TPK%K107(:)*PCONC(:,32)+0.50600*TPK%K113(:)*PCONC(:,39) + PJAC(:,33,36)=-TPK%K107(:)*PCONC(:,33)+0.50600*TPK%K113(:)*PCONC(:,40) ! !MO2/PHO=0.0 ! !MO2/ADD=0.0 ! !MO2/AROP=-K108*<MO2>+K114*<CARBOP> - PJAC(:,32,38)=-TPK%K108(:)*PCONC(:,32)+TPK%K114(:)*PCONC(:,39) + PJAC(:,33,39)=-TPK%K108(:)*PCONC(:,33)+TPK%K114(:)*PCONC(:,40) ! !MO2/CARBOP=+0.78134*K095*<NO>+0.56031*K109*<MO2>-K109*<MO2>+0.51480*K111*<ALKA !P>+0.50078*K112*<ALKEP>+0.50600*K113*<BIOP>+K114*<AROP>+1.66702*K115*<CARBOP>+ !1.66702*K115*<CARBOP>+0.51037*K116*<OLN>+0.91910*K124*<NO3>+K128*<XO2> - PJAC(:,32,39)=+0.78134*TPK%K095(:)*PCONC(:,3)+0.56031*TPK%K109(:)*PCONC(:,32)-& -&TPK%K109(:)*PCONC(:,32)+0.51480*TPK%K111(:)*PCONC(:,33)+0.50078*TPK%K112(:)*PC& -&ONC(:,34)+0.50600*TPK%K113(:)*PCONC(:,35)+TPK%K114(:)*PCONC(:,38)+1.66702*TPK%& -&K115(:)*PCONC(:,39)+1.66702*TPK%K115(:)*PCONC(:,39)+0.51037*TPK%K116(:)*PCONC(& -&:,40)+0.91910*TPK%K124(:)*PCONC(:,5)+TPK%K128(:)*PCONC(:,41) + PJAC(:,33,40)=+0.78134*TPK%K095(:)*PCONC(:,3)+0.56031*TPK%K109(:)*PCONC(:,33)-& +&TPK%K109(:)*PCONC(:,33)+0.51480*TPK%K111(:)*PCONC(:,34)+0.50078*TPK%K112(:)*PC& +&ONC(:,35)+0.50600*TPK%K113(:)*PCONC(:,36)+TPK%K114(:)*PCONC(:,39)+1.66702*TPK%& +&K115(:)*PCONC(:,40)+1.66702*TPK%K115(:)*PCONC(:,40)+0.51037*TPK%K116(:)*PCONC(& +&:,41)+0.91910*TPK%K124(:)*PCONC(:,5)+TPK%K128(:)*PCONC(:,42) ! !MO2/OLN=-K110*<MO2>+0.51037*K116*<CARBOP> - PJAC(:,32,40)=-TPK%K110(:)*PCONC(:,32)+0.51037*TPK%K116(:)*PCONC(:,39) + PJAC(:,33,41)=-TPK%K110(:)*PCONC(:,33)+0.51037*TPK%K116(:)*PCONC(:,40) ! !MO2/XO2=-K127*<MO2>+K128*<CARBOP> - PJAC(:,32,41)=-TPK%K127(:)*PCONC(:,32)+TPK%K128(:)*PCONC(:,39) + PJAC(:,33,42)=-TPK%K127(:)*PCONC(:,33)+TPK%K128(:)*PCONC(:,40) ! !ALKAP/O3=+0.09815*K079*<ALKE>+0.00000*K080*<BIO> - PJAC(:,33,1)=+0.09815*TPK%K079(:)*PCONC(:,19)+0.00000*TPK%K080(:)*PCONC(:,20) + PJAC(:,34,1)=+0.09815*TPK%K079(:)*PCONC(:,20)+0.00000*TPK%K080(:)*PCONC(:,21) ! !ALKAP/H2O2=0.0 ! !ALKAP/NO=+0.08187*K091*<ALKAP>-K091*<ALKAP> - PJAC(:,33,3)=+0.08187*TPK%K091(:)*PCONC(:,33)-TPK%K091(:)*PCONC(:,33) + PJAC(:,34,3)=+0.08187*TPK%K091(:)*PCONC(:,34)-TPK%K091(:)*PCONC(:,34) ! !ALKAP/NO2=0.0 ! !ALKAP/NO3=+0.08994*K120*<ALKAP>-K120*<ALKAP> - PJAC(:,33,5)=+0.08994*TPK%K120(:)*PCONC(:,33)-TPK%K120(:)*PCONC(:,33) + PJAC(:,34,5)=+0.08994*TPK%K120(:)*PCONC(:,34)-TPK%K120(:)*PCONC(:,34) ! !ALKAP/N2O5=0.0 ! @@ -27352,6 +27940,8 @@ SUBROUTINE SUBJ6 ! !ALKAP/NH3=0.0 ! +!ALKAP/DMS=0.0 +! !ALKAP/SO2=0.0 ! !ALKAP/SULF=0.0 @@ -27360,25 +27950,25 @@ SUBROUTINE SUBJ6 ! !ALKAP/OH=+K057*<ETH>+0.87811*K058*<ALKA>+0.40341*K069*<OP2>+1.00000*K071*<ONIT !> - PJAC(:,33,14)=+TPK%K057(:)*PCONC(:,17)+0.87811*TPK%K058(:)*PCONC(:,18)+0.40341& -&*TPK%K069(:)*PCONC(:,29)+1.00000*TPK%K071(:)*PCONC(:,26) + PJAC(:,34,15)=+TPK%K057(:)*PCONC(:,18)+0.87811*TPK%K058(:)*PCONC(:,19)+0.40341& +&*TPK%K069(:)*PCONC(:,30)+1.00000*TPK%K071(:)*PCONC(:,27) ! !ALKAP/HO2=-K098*<ALKAP> - PJAC(:,33,15)=-TPK%K098(:)*PCONC(:,33) + PJAC(:,34,16)=-TPK%K098(:)*PCONC(:,34) ! !ALKAP/CH4=0.0 ! !ALKAP/ETH=+K057*<OH> - PJAC(:,33,17)=+TPK%K057(:)*PCONC(:,14) + PJAC(:,34,18)=+TPK%K057(:)*PCONC(:,15) ! !ALKAP/ALKA=+0.87811*K058*<OH> - PJAC(:,33,18)=+0.87811*TPK%K058(:)*PCONC(:,14) + PJAC(:,34,19)=+0.87811*TPK%K058(:)*PCONC(:,15) ! !ALKAP/ALKE=+0.09815*K079*<O3> - PJAC(:,33,19)=+0.09815*TPK%K079(:)*PCONC(:,1) + PJAC(:,34,20)=+0.09815*TPK%K079(:)*PCONC(:,1) ! !ALKAP/BIO=+0.00000*K080*<O3> - PJAC(:,33,20)=+0.00000*TPK%K080(:)*PCONC(:,1) + PJAC(:,34,21)=+0.00000*TPK%K080(:)*PCONC(:,1) ! !ALKAP/ARO=0.0 ! @@ -27387,32 +27977,32 @@ SUBROUTINE SUBJ6 !ALKAP/ALD=0.0 ! !ALKAP/KET=+1.00000*K015 - PJAC(:,33,24)=+1.00000*TPK%K015(:) + PJAC(:,34,25)=+1.00000*TPK%K015(:) ! !ALKAP/CARBO=0.0 ! !ALKAP/ONIT=+1.00000*K071*<OH> - PJAC(:,33,26)=+1.00000*TPK%K071(:)*PCONC(:,14) + PJAC(:,34,27)=+1.00000*TPK%K071(:)*PCONC(:,15) ! !ALKAP/PAN=0.0 ! !ALKAP/OP1=0.0 ! !ALKAP/OP2=+0.40341*K069*<OH> - PJAC(:,33,29)=+0.40341*TPK%K069(:)*PCONC(:,14) + PJAC(:,34,30)=+0.40341*TPK%K069(:)*PCONC(:,15) ! !ALKAP/ORA1=0.0 ! !ALKAP/ORA2=0.0 ! !ALKAP/MO2=+0.00385*K105*<ALKAP>-K105*<ALKAP> - PJAC(:,33,32)=+0.00385*TPK%K105(:)*PCONC(:,33)-TPK%K105(:)*PCONC(:,33) + PJAC(:,34,33)=+0.00385*TPK%K105(:)*PCONC(:,34)-TPK%K105(:)*PCONC(:,34) ! !ALKAP/ALKAP=+0.08187*K091*<NO>-K091*<NO>-K098*<HO2>+0.00385*K105*<MO2>-K105*<M !O2>+0.00828*K111*<CARBOP>-K111*<CARBOP>+0.08994*K120*<NO3>-K120*<NO3> - PJAC(:,33,33)=+0.08187*TPK%K091(:)*PCONC(:,3)-TPK%K091(:)*PCONC(:,3)-TPK%K098(& -&:)*PCONC(:,15)+0.00385*TPK%K105(:)*PCONC(:,32)-TPK%K105(:)*PCONC(:,32)+0.00828& -&*TPK%K111(:)*PCONC(:,39)-TPK%K111(:)*PCONC(:,39)+0.08994*TPK%K120(:)*PCONC(:,5& + PJAC(:,34,34)=+0.08187*TPK%K091(:)*PCONC(:,3)-TPK%K091(:)*PCONC(:,3)-TPK%K098(& +&:)*PCONC(:,16)+0.00385*TPK%K105(:)*PCONC(:,33)-TPK%K105(:)*PCONC(:,33)+0.00828& +&*TPK%K111(:)*PCONC(:,40)-TPK%K111(:)*PCONC(:,40)+0.08994*TPK%K120(:)*PCONC(:,5& &)-TPK%K120(:)*PCONC(:,5) ! !ALKAP/ALKEP=0.0 @@ -27426,7 +28016,7 @@ SUBROUTINE SUBJ6 !ALKAP/AROP=0.0 ! !ALKAP/CARBOP=+0.00828*K111*<ALKAP>-K111*<ALKAP> - PJAC(:,33,39)=+0.00828*TPK%K111(:)*PCONC(:,33)-TPK%K111(:)*PCONC(:,33) + PJAC(:,34,40)=+0.00828*TPK%K111(:)*PCONC(:,34)-TPK%K111(:)*PCONC(:,34) ! !ALKAP/OLN=0.0 ! @@ -27437,12 +28027,12 @@ SUBROUTINE SUBJ6 !ALKEP/H2O2=0.0 ! !ALKEP/NO=-K092*<ALKEP> - PJAC(:,34,3)=-TPK%K092(:)*PCONC(:,34) + PJAC(:,35,3)=-TPK%K092(:)*PCONC(:,35) ! !ALKEP/NO2=0.0 ! !ALKEP/NO3=-K121*<ALKEP> - PJAC(:,34,5)=-TPK%K121(:)*PCONC(:,34) + PJAC(:,35,5)=-TPK%K121(:)*PCONC(:,35) ! !ALKEP/N2O5=0.0 ! @@ -27454,6 +28044,8 @@ SUBROUTINE SUBJ6 ! !ALKEP/NH3=0.0 ! +!ALKEP/DMS=0.0 +! !ALKEP/SO2=0.0 ! !ALKEP/SULF=0.0 @@ -27461,10 +28053,10 @@ SUBROUTINE SUBJ6 !ALKEP/CO=0.0 ! !ALKEP/OH=+1.02529*K059*<ALKE> - PJAC(:,34,14)=+1.02529*TPK%K059(:)*PCONC(:,19) + PJAC(:,35,15)=+1.02529*TPK%K059(:)*PCONC(:,20) ! !ALKEP/HO2=-K099*<ALKEP> - PJAC(:,34,15)=-TPK%K099(:)*PCONC(:,34) + PJAC(:,35,16)=-TPK%K099(:)*PCONC(:,35) ! !ALKEP/CH4=0.0 ! @@ -27473,7 +28065,7 @@ SUBROUTINE SUBJ6 !ALKEP/ALKA=0.0 ! !ALKEP/ALKE=+1.02529*K059*<OH> - PJAC(:,34,19)=+1.02529*TPK%K059(:)*PCONC(:,14) + PJAC(:,35,20)=+1.02529*TPK%K059(:)*PCONC(:,15) ! !ALKEP/BIO=0.0 ! @@ -27500,13 +28092,13 @@ SUBROUTINE SUBJ6 !ALKEP/ORA2=0.0 ! !ALKEP/MO2=-K106*<ALKEP> - PJAC(:,34,32)=-TPK%K106(:)*PCONC(:,34) + PJAC(:,35,33)=-TPK%K106(:)*PCONC(:,35) ! !ALKEP/ALKAP=0.0 ! !ALKEP/ALKEP=-K092*<NO>-K099*<HO2>-K106*<MO2>-K112*<CARBOP>-K121*<NO3> - PJAC(:,34,34)=-TPK%K092(:)*PCONC(:,3)-TPK%K099(:)*PCONC(:,15)-TPK%K106(:)*PCON& -&C(:,32)-TPK%K112(:)*PCONC(:,39)-TPK%K121(:)*PCONC(:,5) + PJAC(:,35,35)=-TPK%K092(:)*PCONC(:,3)-TPK%K099(:)*PCONC(:,16)-TPK%K106(:)*PCON& +&C(:,33)-TPK%K112(:)*PCONC(:,40)-TPK%K121(:)*PCONC(:,5) ! !ALKEP/BIOP=0.0 ! @@ -27517,23 +28109,31 @@ SUBROUTINE SUBJ6 !ALKEP/AROP=0.0 ! !ALKEP/CARBOP=-K112*<ALKEP> - PJAC(:,34,39)=-TPK%K112(:)*PCONC(:,34) + PJAC(:,35,40)=-TPK%K112(:)*PCONC(:,35) ! !ALKEP/OLN=0.0 ! !ALKEP/XO2=0.0 ! +RETURN +END SUBROUTINE SUBJ6 +! +SUBROUTINE SUBJ7 +! +!Indices 36 a 40 +! +! !BIOP/O3=0.0 ! !BIOP/H2O2=0.0 ! !BIOP/NO=-K093*<BIOP> - PJAC(:,35,3)=-TPK%K093(:)*PCONC(:,35) + PJAC(:,36,3)=-TPK%K093(:)*PCONC(:,36) ! !BIOP/NO2=0.0 ! !BIOP/NO3=-K122*<BIOP> - PJAC(:,35,5)=-TPK%K122(:)*PCONC(:,35) + PJAC(:,36,5)=-TPK%K122(:)*PCONC(:,36) ! !BIOP/N2O5=0.0 ! @@ -27545,6 +28145,8 @@ SUBROUTINE SUBJ6 ! !BIOP/NH3=0.0 ! +!BIOP/DMS=0.0 +! !BIOP/SO2=0.0 ! !BIOP/SULF=0.0 @@ -27552,10 +28154,10 @@ SUBROUTINE SUBJ6 !BIOP/CO=0.0 ! !BIOP/OH=+0.00000*K059*<ALKE>+1.00000*K060*<BIO> - PJAC(:,35,14)=+0.00000*TPK%K059(:)*PCONC(:,19)+1.00000*TPK%K060(:)*PCONC(:,20) + PJAC(:,36,15)=+0.00000*TPK%K059(:)*PCONC(:,20)+1.00000*TPK%K060(:)*PCONC(:,21) ! !BIOP/HO2=-K0100*<BIOP> - PJAC(:,35,15)=-TPK%K0100(:)*PCONC(:,35) + PJAC(:,36,16)=-TPK%K0100(:)*PCONC(:,36) ! !BIOP/CH4=0.0 ! @@ -27564,10 +28166,10 @@ SUBROUTINE SUBJ6 !BIOP/ALKA=0.0 ! !BIOP/ALKE=+0.00000*K059*<OH> - PJAC(:,35,19)=+0.00000*TPK%K059(:)*PCONC(:,14) + PJAC(:,36,20)=+0.00000*TPK%K059(:)*PCONC(:,15) ! !BIOP/BIO=+1.00000*K060*<OH> - PJAC(:,35,20)=+1.00000*TPK%K060(:)*PCONC(:,14) + PJAC(:,36,21)=+1.00000*TPK%K060(:)*PCONC(:,15) ! !BIOP/ARO=0.0 ! @@ -27592,15 +28194,15 @@ SUBROUTINE SUBJ6 !BIOP/ORA2=0.0 ! !BIOP/MO2=-K107*<BIOP> - PJAC(:,35,32)=-TPK%K107(:)*PCONC(:,35) + PJAC(:,36,33)=-TPK%K107(:)*PCONC(:,36) ! !BIOP/ALKAP=0.0 ! !BIOP/ALKEP=0.0 ! !BIOP/BIOP=-K093*<NO>-K0100*<HO2>-K107*<MO2>-K113*<CARBOP>-K122*<NO3> - PJAC(:,35,35)=-TPK%K093(:)*PCONC(:,3)-TPK%K0100(:)*PCONC(:,15)-TPK%K107(:)*PCO& -&NC(:,32)-TPK%K113(:)*PCONC(:,39)-TPK%K122(:)*PCONC(:,5) + PJAC(:,36,36)=-TPK%K093(:)*PCONC(:,3)-TPK%K0100(:)*PCONC(:,16)-TPK%K107(:)*PCO& +&NC(:,33)-TPK%K113(:)*PCONC(:,40)-TPK%K122(:)*PCONC(:,5) ! !BIOP/PHO=0.0 ! @@ -27609,20 +28211,12 @@ SUBROUTINE SUBJ6 !BIOP/AROP=0.0 ! !BIOP/CARBOP=-K113*<BIOP> - PJAC(:,35,39)=-TPK%K113(:)*PCONC(:,35) + PJAC(:,36,40)=-TPK%K113(:)*PCONC(:,36) ! !BIOP/OLN=0.0 ! !BIOP/XO2=0.0 ! -RETURN -END SUBROUTINE SUBJ6 -! -SUBROUTINE SUBJ7 -! -!Indices 36 a 40 -! -! !PHO/O3=0.0 ! !PHO/H2O2=0.0 @@ -27630,10 +28224,10 @@ SUBROUTINE SUBJ7 !PHO/NO=0.0 ! !PHO/NO2=-K083*<PHO> - PJAC(:,36,4)=-TPK%K083(:)*PCONC(:,36) + PJAC(:,37,4)=-TPK%K083(:)*PCONC(:,37) ! !PHO/NO3=+K075*<ARO> - PJAC(:,36,5)=+TPK%K075(:)*PCONC(:,21) + PJAC(:,37,5)=+TPK%K075(:)*PCONC(:,22) ! !PHO/N2O5=0.0 ! @@ -27645,6 +28239,8 @@ SUBROUTINE SUBJ7 ! !PHO/NH3=0.0 ! +!PHO/DMS=0.0 +! !PHO/SO2=0.0 ! !PHO/SULF=0.0 @@ -27652,10 +28248,10 @@ SUBROUTINE SUBJ7 !PHO/CO=0.0 ! !PHO/OH=+0.00276*K061*<ARO> - PJAC(:,36,14)=+0.00276*TPK%K061(:)*PCONC(:,21) + PJAC(:,37,15)=+0.00276*TPK%K061(:)*PCONC(:,22) ! !PHO/HO2=-K084*<PHO> - PJAC(:,36,15)=-TPK%K084(:)*PCONC(:,36) + PJAC(:,37,16)=-TPK%K084(:)*PCONC(:,37) ! !PHO/CH4=0.0 ! @@ -27668,7 +28264,7 @@ SUBROUTINE SUBJ7 !PHO/BIO=0.0 ! !PHO/ARO=+0.00276*K061*<OH>+K075*<NO3> - PJAC(:,36,21)=+0.00276*TPK%K061(:)*PCONC(:,14)+TPK%K075(:)*PCONC(:,5) + PJAC(:,37,22)=+0.00276*TPK%K061(:)*PCONC(:,15)+TPK%K075(:)*PCONC(:,5) ! !PHO/HCHO=0.0 ! @@ -27699,7 +28295,7 @@ SUBROUTINE SUBJ7 !PHO/BIOP=0.0 ! !PHO/PHO=-K083*<NO2>-K084*<HO2> - PJAC(:,36,36)=-TPK%K083(:)*PCONC(:,4)-TPK%K084(:)*PCONC(:,15) + PJAC(:,37,37)=-TPK%K083(:)*PCONC(:,4)-TPK%K084(:)*PCONC(:,16) ! !PHO/ADD=0.0 ! @@ -27712,14 +28308,14 @@ SUBROUTINE SUBJ7 !PHO/XO2=0.0 ! !ADD/O3=-K087*<ADD> - PJAC(:,37,1)=-TPK%K087(:)*PCONC(:,37) + PJAC(:,38,1)=-TPK%K087(:)*PCONC(:,38) ! !ADD/H2O2=0.0 ! !ADD/NO=0.0 ! !ADD/NO2=-K085*<ADD> - PJAC(:,37,4)=-TPK%K085(:)*PCONC(:,37) + PJAC(:,38,4)=-TPK%K085(:)*PCONC(:,38) ! !ADD/NO3=0.0 ! @@ -27733,6 +28329,8 @@ SUBROUTINE SUBJ7 ! !ADD/NH3=0.0 ! +!ADD/DMS=0.0 +! !ADD/SO2=0.0 ! !ADD/SULF=0.0 @@ -27740,7 +28338,7 @@ SUBROUTINE SUBJ7 !ADD/CO=0.0 ! !ADD/OH=+0.93968*K061*<ARO> - PJAC(:,37,14)=+0.93968*TPK%K061(:)*PCONC(:,21) + PJAC(:,38,15)=+0.93968*TPK%K061(:)*PCONC(:,22) ! !ADD/HO2=0.0 ! @@ -27755,7 +28353,7 @@ SUBROUTINE SUBJ7 !ADD/BIO=0.0 ! !ADD/ARO=+0.93968*K061*<OH> - PJAC(:,37,21)=+0.93968*TPK%K061(:)*PCONC(:,14) + PJAC(:,38,22)=+0.93968*TPK%K061(:)*PCONC(:,15) ! !ADD/HCHO=0.0 ! @@ -27788,7 +28386,7 @@ SUBROUTINE SUBJ7 !ADD/PHO=0.0 ! !ADD/ADD=-K085*<NO2>-K086*<O2>-K087*<O3> - PJAC(:,37,37)=-TPK%K085(:)*PCONC(:,4)-TPK%K086(:)*TPK%O2(:)-TPK%K087(:)*PCONC(& + PJAC(:,38,38)=-TPK%K085(:)*PCONC(:,4)-TPK%K086(:)*TPK%O2(:)-TPK%K087(:)*PCONC(& &:,1) ! !ADD/AROP=0.0 @@ -27804,12 +28402,12 @@ SUBROUTINE SUBJ7 !AROP/H2O2=0.0 ! !AROP/NO=-K094*<AROP> - PJAC(:,38,3)=-TPK%K094(:)*PCONC(:,38) + PJAC(:,39,3)=-TPK%K094(:)*PCONC(:,39) ! !AROP/NO2=0.0 ! !AROP/NO3=-K123*<AROP> - PJAC(:,38,5)=-TPK%K123(:)*PCONC(:,38) + PJAC(:,39,5)=-TPK%K123(:)*PCONC(:,39) ! !AROP/N2O5=0.0 ! @@ -27821,6 +28419,8 @@ SUBROUTINE SUBJ7 ! !AROP/NH3=0.0 ! +!AROP/DMS=0.0 +! !AROP/SO2=0.0 ! !AROP/SULF=0.0 @@ -27830,7 +28430,7 @@ SUBROUTINE SUBJ7 !AROP/OH=0.0 ! !AROP/HO2=-K0101*<AROP> - PJAC(:,38,15)=-TPK%K0101(:)*PCONC(:,38) + PJAC(:,39,16)=-TPK%K0101(:)*PCONC(:,39) ! !AROP/CH4=0.0 ! @@ -27865,7 +28465,7 @@ SUBROUTINE SUBJ7 !AROP/ORA2=0.0 ! !AROP/MO2=-K108*<AROP> - PJAC(:,38,32)=-TPK%K108(:)*PCONC(:,38) + PJAC(:,39,33)=-TPK%K108(:)*PCONC(:,39) ! !AROP/ALKAP=0.0 ! @@ -27876,14 +28476,14 @@ SUBROUTINE SUBJ7 !AROP/PHO=0.0 ! !AROP/ADD=+0.98*K086*<O2> - PJAC(:,38,37)=+0.98*TPK%K086(:)*TPK%O2(:) + PJAC(:,39,38)=+0.98*TPK%K086(:)*TPK%O2(:) ! !AROP/AROP=-K094*<NO>-K0101*<HO2>-K108*<MO2>-K114*<CARBOP>-K123*<NO3> - PJAC(:,38,38)=-TPK%K094(:)*PCONC(:,3)-TPK%K0101(:)*PCONC(:,15)-TPK%K108(:)*PCO& -&NC(:,32)-TPK%K114(:)*PCONC(:,39)-TPK%K123(:)*PCONC(:,5) + PJAC(:,39,39)=-TPK%K094(:)*PCONC(:,3)-TPK%K0101(:)*PCONC(:,16)-TPK%K108(:)*PCO& +&NC(:,33)-TPK%K114(:)*PCONC(:,40)-TPK%K123(:)*PCONC(:,5) ! !AROP/CARBOP=-K114*<AROP> - PJAC(:,38,39)=-TPK%K114(:)*PCONC(:,38) + PJAC(:,39,40)=-TPK%K114(:)*PCONC(:,39) ! !AROP/OLN=0.0 ! @@ -27891,21 +28491,21 @@ SUBROUTINE SUBJ7 ! !CARBOP/O3=+0.05705*K079*<ALKE>+0.17000*K080*<BIO>+0.27460*K081*<CARBO>+0.70000 !*K082*<PAN> - PJAC(:,39,1)=+0.05705*TPK%K079(:)*PCONC(:,19)+0.17000*TPK%K080(:)*PCONC(:,20)+& -&0.27460*TPK%K081(:)*PCONC(:,25)+0.70000*TPK%K082(:)*PCONC(:,27) + PJAC(:,40,1)=+0.05705*TPK%K079(:)*PCONC(:,20)+0.17000*TPK%K080(:)*PCONC(:,21)+& +&0.27460*TPK%K081(:)*PCONC(:,26)+0.70000*TPK%K082(:)*PCONC(:,28) ! !CARBOP/H2O2=0.0 ! !CARBOP/NO=+0.09532*K095*<CARBOP>-K095*<CARBOP> - PJAC(:,39,3)=+0.09532*TPK%K095(:)*PCONC(:,39)-TPK%K095(:)*PCONC(:,39) + PJAC(:,40,3)=+0.09532*TPK%K095(:)*PCONC(:,40)-TPK%K095(:)*PCONC(:,40) ! !CARBOP/NO2=-K088*<CARBOP> - PJAC(:,39,4)=-TPK%K088(:)*PCONC(:,39) + PJAC(:,40,4)=-TPK%K088(:)*PCONC(:,40) ! !CARBOP/NO3=+1.00000*K073*<ALD>+0.38881*K074*<CARBO>+0.03175*K124*<CARBOP>-K124 !*<CARBOP> - PJAC(:,39,5)=+1.00000*TPK%K073(:)*PCONC(:,23)+0.38881*TPK%K074(:)*PCONC(:,25)+& -&0.03175*TPK%K124(:)*PCONC(:,39)-TPK%K124(:)*PCONC(:,39) + PJAC(:,40,5)=+1.00000*TPK%K073(:)*PCONC(:,24)+0.38881*TPK%K074(:)*PCONC(:,26)+& +&0.03175*TPK%K124(:)*PCONC(:,40)-TPK%K124(:)*PCONC(:,40) ! !CARBOP/N2O5=0.0 ! @@ -27917,6 +28517,8 @@ SUBROUTINE SUBJ7 ! !CARBOP/NH3=0.0 ! +!CARBOP/DMS=0.0 +! !CARBOP/SO2=0.0 ! !CARBOP/SULF=0.0 @@ -27925,11 +28527,11 @@ SUBROUTINE SUBJ7 ! !CARBOP/OH=+1.00000*K063*<ALD>+1.00000*K064*<KET>+0.51419*K065*<CARBO>+0.05413* !K069*<OP2> - PJAC(:,39,14)=+1.00000*TPK%K063(:)*PCONC(:,23)+1.00000*TPK%K064(:)*PCONC(:,24)& -&+0.51419*TPK%K065(:)*PCONC(:,25)+0.05413*TPK%K069(:)*PCONC(:,29) + PJAC(:,40,15)=+1.00000*TPK%K063(:)*PCONC(:,24)+1.00000*TPK%K064(:)*PCONC(:,25)& +&+0.51419*TPK%K065(:)*PCONC(:,26)+0.05413*TPK%K069(:)*PCONC(:,30) ! !CARBOP/HO2=-K0102*<CARBOP> - PJAC(:,39,15)=-TPK%K0102(:)*PCONC(:,39) + PJAC(:,40,16)=-TPK%K0102(:)*PCONC(:,40) ! !CARBOP/CH4=0.0 ! @@ -27938,90 +28540,98 @@ SUBROUTINE SUBJ7 !CARBOP/ALKA=0.0 ! !CARBOP/ALKE=+0.05705*K079*<O3> - PJAC(:,39,19)=+0.05705*TPK%K079(:)*PCONC(:,1) + PJAC(:,40,20)=+0.05705*TPK%K079(:)*PCONC(:,1) ! !CARBOP/BIO=+0.17000*K080*<O3> - PJAC(:,39,20)=+0.17000*TPK%K080(:)*PCONC(:,1) + PJAC(:,40,21)=+0.17000*TPK%K080(:)*PCONC(:,1) ! !CARBOP/ARO=0.0 ! !CARBOP/HCHO=0.0 ! !CARBOP/ALD=+1.00000*K063*<OH>+1.00000*K073*<NO3> - PJAC(:,39,23)=+1.00000*TPK%K063(:)*PCONC(:,14)+1.00000*TPK%K073(:)*PCONC(:,5) + PJAC(:,40,24)=+1.00000*TPK%K063(:)*PCONC(:,15)+1.00000*TPK%K073(:)*PCONC(:,5) ! !CARBOP/KET=+1.00000*K015+1.00000*K064*<OH> - PJAC(:,39,24)=+1.00000*TPK%K015(:)+1.00000*TPK%K064(:)*PCONC(:,14) + PJAC(:,40,25)=+1.00000*TPK%K015(:)+1.00000*TPK%K064(:)*PCONC(:,15) ! !CARBOP/CARBO=+0.69622*K016+0.51419*K065*<OH>+0.38881*K074*<NO3>+0.27460*K081*< !O3> - PJAC(:,39,25)=+0.69622*TPK%K016(:)+0.51419*TPK%K065(:)*PCONC(:,14)+0.38881*TPK& + PJAC(:,40,26)=+0.69622*TPK%K016(:)+0.51419*TPK%K065(:)*PCONC(:,15)+0.38881*TPK& &%K074(:)*PCONC(:,5)+0.27460*TPK%K081(:)*PCONC(:,1) ! !CARBOP/ONIT=0.0 ! !CARBOP/PAN=+0.70000*K082*<O3>+1.00000*K089 - PJAC(:,39,27)=+0.70000*TPK%K082(:)*PCONC(:,1)+1.00000*TPK%K089(:) + PJAC(:,40,28)=+0.70000*TPK%K082(:)*PCONC(:,1)+1.00000*TPK%K089(:) ! !CARBOP/OP1=0.0 ! !CARBOP/OP2=+0.05413*K069*<OH> - PJAC(:,39,29)=+0.05413*TPK%K069(:)*PCONC(:,14) + PJAC(:,40,30)=+0.05413*TPK%K069(:)*PCONC(:,15) ! !CARBOP/ORA1=0.0 ! !CARBOP/ORA2=0.0 ! !CARBOP/MO2=+0.05954*K109*<CARBOP>-K109*<CARBOP> - PJAC(:,39,32)=+0.05954*TPK%K109(:)*PCONC(:,39)-TPK%K109(:)*PCONC(:,39) + PJAC(:,40,33)=+0.05954*TPK%K109(:)*PCONC(:,40)-TPK%K109(:)*PCONC(:,40) ! !CARBOP/ALKAP=-K111*<CARBOP> - PJAC(:,39,33)=-TPK%K111(:)*PCONC(:,39) + PJAC(:,40,34)=-TPK%K111(:)*PCONC(:,40) ! !CARBOP/ALKEP=-K112*<CARBOP> - PJAC(:,39,34)=-TPK%K112(:)*PCONC(:,39) + PJAC(:,40,35)=-TPK%K112(:)*PCONC(:,40) ! !CARBOP/BIOP=-K113*<CARBOP> - PJAC(:,39,35)=-TPK%K113(:)*PCONC(:,39) + PJAC(:,40,36)=-TPK%K113(:)*PCONC(:,40) ! !CARBOP/PHO=0.0 ! !CARBOP/ADD=0.0 ! !CARBOP/AROP=-K114*<CARBOP> - PJAC(:,39,38)=-TPK%K114(:)*PCONC(:,39) + PJAC(:,40,39)=-TPK%K114(:)*PCONC(:,40) ! !CARBOP/CARBOP=-K088*<NO2>+0.09532*K095*<NO>-K095*<NO>-K0102*<HO2>+0.05954*K109 !*<MO2>-K109*<MO2>-K111*<ALKAP>-K112*<ALKEP>-K113*<BIOP>-K114*<AROP>+0.05821*K1 !15*<CARBOP>+0.05821*K115*<CARBOP>-K115*<CARBOP>-K115*<CARBOP>-K115*<CARBOP>-K1 !15*<CARBOP>-K116*<OLN>+0.03175*K124*<NO3>-K124*<NO3>-K128*<XO2> - PJAC(:,39,39)=-TPK%K088(:)*PCONC(:,4)+0.09532*TPK%K095(:)*PCONC(:,3)-TPK%K095(& -&:)*PCONC(:,3)-TPK%K0102(:)*PCONC(:,15)+0.05954*TPK%K109(:)*PCONC(:,32)-TPK%K10& -&9(:)*PCONC(:,32)-TPK%K111(:)*PCONC(:,33)-TPK%K112(:)*PCONC(:,34)-TPK%K113(:)*P& -&CONC(:,35)-TPK%K114(:)*PCONC(:,38)+0.05821*TPK%K115(:)*PCONC(:,39)+0.05821*TPK& -&%K115(:)*PCONC(:,39)-TPK%K115(:)*PCONC(:,39)-TPK%K115(:)*PCONC(:,39)-TPK%K115(& -&:)*PCONC(:,39)-TPK%K115(:)*PCONC(:,39)-TPK%K116(:)*PCONC(:,40)+0.03175*TPK%K12& -&4(:)*PCONC(:,5)-TPK%K124(:)*PCONC(:,5)-TPK%K128(:)*PCONC(:,41) + PJAC(:,40,40)=-TPK%K088(:)*PCONC(:,4)+0.09532*TPK%K095(:)*PCONC(:,3)-TPK%K095(& +&:)*PCONC(:,3)-TPK%K0102(:)*PCONC(:,16)+0.05954*TPK%K109(:)*PCONC(:,33)-TPK%K10& +&9(:)*PCONC(:,33)-TPK%K111(:)*PCONC(:,34)-TPK%K112(:)*PCONC(:,35)-TPK%K113(:)*P& +&CONC(:,36)-TPK%K114(:)*PCONC(:,39)+0.05821*TPK%K115(:)*PCONC(:,40)+0.05821*TPK& +&%K115(:)*PCONC(:,40)-TPK%K115(:)*PCONC(:,40)-TPK%K115(:)*PCONC(:,40)-TPK%K115(& +&:)*PCONC(:,40)-TPK%K115(:)*PCONC(:,40)-TPK%K116(:)*PCONC(:,41)+0.03175*TPK%K12& +&4(:)*PCONC(:,5)-TPK%K124(:)*PCONC(:,5)-TPK%K128(:)*PCONC(:,42) ! !CARBOP/OLN=-K116*<CARBOP> - PJAC(:,39,40)=-TPK%K116(:)*PCONC(:,39) + PJAC(:,40,41)=-TPK%K116(:)*PCONC(:,40) ! !CARBOP/XO2=-K128*<CARBOP> - PJAC(:,39,41)=-TPK%K128(:)*PCONC(:,39) + PJAC(:,40,42)=-TPK%K128(:)*PCONC(:,40) +! +RETURN +END SUBROUTINE SUBJ7 +! +SUBROUTINE SUBJ8 +! +!Indices 41 a 42 +! ! !OLN/O3=0.0 ! !OLN/H2O2=0.0 ! !OLN/NO=-K096*<OLN> - PJAC(:,40,3)=-TPK%K096(:)*PCONC(:,40) + PJAC(:,41,3)=-TPK%K096(:)*PCONC(:,41) ! !OLN/NO2=0.0 ! !OLN/NO3=+0.00000*K074*<CARBO>+0.93768*K076*<ALKE>+1.00000*K077*<BIO>-K125*<OLN !> - PJAC(:,40,5)=+0.00000*TPK%K074(:)*PCONC(:,25)+0.93768*TPK%K076(:)*PCONC(:,19)+& -&1.00000*TPK%K077(:)*PCONC(:,20)-TPK%K125(:)*PCONC(:,40) + PJAC(:,41,5)=+0.00000*TPK%K074(:)*PCONC(:,26)+0.93768*TPK%K076(:)*PCONC(:,20)+& +&1.00000*TPK%K077(:)*PCONC(:,21)-TPK%K125(:)*PCONC(:,41) ! !OLN/N2O5=0.0 ! @@ -28033,6 +28643,8 @@ SUBROUTINE SUBJ7 ! !OLN/NH3=0.0 ! +!OLN/DMS=0.0 +! !OLN/SO2=0.0 ! !OLN/SULF=0.0 @@ -28042,7 +28654,7 @@ SUBROUTINE SUBJ7 !OLN/OH=0.0 ! !OLN/HO2=-K103*<OLN> - PJAC(:,40,15)=-TPK%K103(:)*PCONC(:,40) + PJAC(:,41,16)=-TPK%K103(:)*PCONC(:,41) ! !OLN/CH4=0.0 ! @@ -28051,10 +28663,10 @@ SUBROUTINE SUBJ7 !OLN/ALKA=0.0 ! !OLN/ALKE=+0.93768*K076*<NO3> - PJAC(:,40,19)=+0.93768*TPK%K076(:)*PCONC(:,5) + PJAC(:,41,20)=+0.93768*TPK%K076(:)*PCONC(:,5) ! !OLN/BIO=+1.00000*K077*<NO3> - PJAC(:,40,20)=+1.00000*TPK%K077(:)*PCONC(:,5) + PJAC(:,41,21)=+1.00000*TPK%K077(:)*PCONC(:,5) ! !OLN/ARO=0.0 ! @@ -28065,7 +28677,7 @@ SUBROUTINE SUBJ7 !OLN/KET=0.0 ! !OLN/CARBO=+0.00000*K074*<NO3> - PJAC(:,40,25)=+0.00000*TPK%K074(:)*PCONC(:,5) + PJAC(:,41,26)=+0.00000*TPK%K074(:)*PCONC(:,5) ! !OLN/ONIT=0.0 ! @@ -28080,7 +28692,7 @@ SUBROUTINE SUBJ7 !OLN/ORA2=0.0 ! !OLN/MO2=-K110*<OLN> - PJAC(:,40,32)=-TPK%K110(:)*PCONC(:,40) + PJAC(:,41,33)=-TPK%K110(:)*PCONC(:,41) ! !OLN/ALKAP=0.0 ! @@ -28095,41 +28707,33 @@ SUBROUTINE SUBJ7 !OLN/AROP=0.0 ! !OLN/CARBOP=-K116*<OLN> - PJAC(:,40,39)=-TPK%K116(:)*PCONC(:,40) + PJAC(:,41,40)=-TPK%K116(:)*PCONC(:,41) ! !OLN/OLN=-K096*<NO>-K103*<HO2>-K110*<MO2>-K116*<CARBOP>-K117*<OLN>-K117*<OLN>-K !117*<OLN>-K117*<OLN>-K118*<OLN>-K118*<OLN>-K118*<OLN>-K118*<OLN>-K125*<NO3> - PJAC(:,40,40)=-TPK%K096(:)*PCONC(:,3)-TPK%K103(:)*PCONC(:,15)-TPK%K110(:)*PCON& -&C(:,32)-TPK%K116(:)*PCONC(:,39)-TPK%K117(:)*PCONC(:,40)-TPK%K117(:)*PCONC(:,40& -&)-TPK%K117(:)*PCONC(:,40)-TPK%K117(:)*PCONC(:,40)-TPK%K118(:)*PCONC(:,40)-TPK%& -&K118(:)*PCONC(:,40)-TPK%K118(:)*PCONC(:,40)-TPK%K118(:)*PCONC(:,40)-TPK%K125(:& + PJAC(:,41,41)=-TPK%K096(:)*PCONC(:,3)-TPK%K103(:)*PCONC(:,16)-TPK%K110(:)*PCON& +&C(:,33)-TPK%K116(:)*PCONC(:,40)-TPK%K117(:)*PCONC(:,41)-TPK%K117(:)*PCONC(:,41& +&)-TPK%K117(:)*PCONC(:,41)-TPK%K117(:)*PCONC(:,41)-TPK%K118(:)*PCONC(:,41)-TPK%& +&K118(:)*PCONC(:,41)-TPK%K118(:)*PCONC(:,41)-TPK%K118(:)*PCONC(:,41)-TPK%K125(:& &)*PCONC(:,5) ! !OLN/XO2=0.0 ! -RETURN -END SUBROUTINE SUBJ7 -! -SUBROUTINE SUBJ8 -! -!Indices 41 a 41 -! -! !XO2/O3=+0.00000*K079*<ALKE>+0.13000*K080*<BIO> - PJAC(:,41,1)=+0.00000*TPK%K079(:)*PCONC(:,19)+0.13000*TPK%K080(:)*PCONC(:,20) + PJAC(:,42,1)=+0.00000*TPK%K079(:)*PCONC(:,20)+0.13000*TPK%K080(:)*PCONC(:,21) ! !XO2/H2O2=0.0 ! !XO2/NO=+0.13007*K091*<ALKAP>+0.02563*K095*<CARBOP>-K130*<XO2> - PJAC(:,41,3)=+0.13007*TPK%K091(:)*PCONC(:,33)+0.02563*TPK%K095(:)*PCONC(:,39)-& -&TPK%K130(:)*PCONC(:,41) + PJAC(:,42,3)=+0.13007*TPK%K091(:)*PCONC(:,34)+0.02563*TPK%K095(:)*PCONC(:,40)-& +&TPK%K130(:)*PCONC(:,42) ! !XO2/NO2=0.0 ! !XO2/NO3=+0.10530*K074*<CARBO>+K078*<PAN>+0.16271*K120*<ALKAP>+0.01021*K124*<CA !RBOP>-K131*<XO2> - PJAC(:,41,5)=+0.10530*TPK%K074(:)*PCONC(:,25)+TPK%K078(:)*PCONC(:,27)+0.16271*& -&TPK%K120(:)*PCONC(:,33)+0.01021*TPK%K124(:)*PCONC(:,39)-TPK%K131(:)*PCONC(:,41& + PJAC(:,42,5)=+0.10530*TPK%K074(:)*PCONC(:,26)+TPK%K078(:)*PCONC(:,28)+0.16271*& +&TPK%K120(:)*PCONC(:,34)+0.01021*TPK%K124(:)*PCONC(:,40)-TPK%K131(:)*PCONC(:,42& &) ! !XO2/N2O5=0.0 @@ -28142,6 +28746,8 @@ SUBROUTINE SUBJ8 ! !XO2/NH3=0.0 ! +!XO2/DMS=0.0 +! !XO2/SO2=0.0 ! !XO2/SULF=0.0 @@ -28149,11 +28755,11 @@ SUBROUTINE SUBJ8 !XO2/CO=0.0 ! !XO2/OH=+0.10318*K061*<ARO>+0.10162*K065*<CARBO>+0.09333*K069*<OP2>+K070*<PAN> - PJAC(:,41,14)=+0.10318*TPK%K061(:)*PCONC(:,21)+0.10162*TPK%K065(:)*PCONC(:,25)& -&+0.09333*TPK%K069(:)*PCONC(:,29)+TPK%K070(:)*PCONC(:,27) + PJAC(:,42,15)=+0.10318*TPK%K061(:)*PCONC(:,22)+0.10162*TPK%K065(:)*PCONC(:,26)& +&+0.09333*TPK%K069(:)*PCONC(:,30)+TPK%K070(:)*PCONC(:,28) ! !XO2/HO2=-K126*<XO2> - PJAC(:,41,15)=-TPK%K126(:)*PCONC(:,41) + PJAC(:,42,16)=-TPK%K126(:)*PCONC(:,42) ! !XO2/CH4=0.0 ! @@ -28162,13 +28768,13 @@ SUBROUTINE SUBJ8 !XO2/ALKA=0.0 ! !XO2/ALKE=+0.00000*K079*<O3> - PJAC(:,41,19)=+0.00000*TPK%K079(:)*PCONC(:,1) + PJAC(:,42,20)=+0.00000*TPK%K079(:)*PCONC(:,1) ! !XO2/BIO=+0.15*K054*<O3P>+0.13000*K080*<O3> - PJAC(:,41,20)=+0.15*TPK%K054(:)*TPK%O3P(:)+0.13000*TPK%K080(:)*PCONC(:,1) + PJAC(:,42,21)=+0.15*TPK%K054(:)*TPK%O3P(:)+0.13000*TPK%K080(:)*PCONC(:,1) ! !XO2/ARO=+0.10318*K061*<OH> - PJAC(:,41,21)=+0.10318*TPK%K061(:)*PCONC(:,14) + PJAC(:,42,22)=+0.10318*TPK%K061(:)*PCONC(:,15) ! !XO2/HCHO=0.0 ! @@ -28177,30 +28783,30 @@ SUBROUTINE SUBJ8 !XO2/KET=0.0 ! !XO2/CARBO=+0.10162*K065*<OH>+0.10530*K074*<NO3> - PJAC(:,41,25)=+0.10162*TPK%K065(:)*PCONC(:,14)+0.10530*TPK%K074(:)*PCONC(:,5) + PJAC(:,42,26)=+0.10162*TPK%K065(:)*PCONC(:,15)+0.10530*TPK%K074(:)*PCONC(:,5) ! !XO2/ONIT=0.0 ! !XO2/PAN=+K070*<OH>+K078*<NO3> - PJAC(:,41,27)=+TPK%K070(:)*PCONC(:,14)+TPK%K078(:)*PCONC(:,5) + PJAC(:,42,28)=+TPK%K070(:)*PCONC(:,15)+TPK%K078(:)*PCONC(:,5) ! !XO2/OP1=0.0 ! !XO2/OP2=+0.09333*K069*<OH> - PJAC(:,41,29)=+0.09333*TPK%K069(:)*PCONC(:,14) + PJAC(:,42,30)=+0.09333*TPK%K069(:)*PCONC(:,15) ! !XO2/ORA1=0.0 ! !XO2/ORA2=0.0 ! !XO2/MO2=+0.13370*K105*<ALKAP>+0.02212*K109*<CARBOP>-K127*<XO2> - PJAC(:,41,32)=+0.13370*TPK%K105(:)*PCONC(:,33)+0.02212*TPK%K109(:)*PCONC(:,39)& -&-TPK%K127(:)*PCONC(:,41) + PJAC(:,42,33)=+0.13370*TPK%K105(:)*PCONC(:,34)+0.02212*TPK%K109(:)*PCONC(:,40)& +&-TPK%K127(:)*PCONC(:,42) ! !XO2/ALKAP=+0.13007*K091*<NO>+0.13370*K105*<MO2>+0.11306*K111*<CARBOP>+0.16271* !K120*<NO3> - PJAC(:,41,33)=+0.13007*TPK%K091(:)*PCONC(:,3)+0.13370*TPK%K105(:)*PCONC(:,32)+& -&0.11306*TPK%K111(:)*PCONC(:,39)+0.16271*TPK%K120(:)*PCONC(:,5) + PJAC(:,42,34)=+0.13007*TPK%K091(:)*PCONC(:,3)+0.13370*TPK%K105(:)*PCONC(:,33)+& +&0.11306*TPK%K111(:)*PCONC(:,40)+0.16271*TPK%K120(:)*PCONC(:,5) ! !XO2/ALKEP=0.0 ! @@ -28214,17 +28820,17 @@ SUBROUTINE SUBJ8 ! !XO2/CARBOP=+0.02563*K095*<NO>+0.02212*K109*<MO2>+0.11306*K111*<ALKAP>+0.01593* !K115*<CARBOP>+0.01593*K115*<CARBOP>+0.01021*K124*<NO3>-K128*<XO2> - PJAC(:,41,39)=+0.02563*TPK%K095(:)*PCONC(:,3)+0.02212*TPK%K109(:)*PCONC(:,32)+& -&0.11306*TPK%K111(:)*PCONC(:,33)+0.01593*TPK%K115(:)*PCONC(:,39)+0.01593*TPK%K1& -&15(:)*PCONC(:,39)+0.01021*TPK%K124(:)*PCONC(:,5)-TPK%K128(:)*PCONC(:,41) + PJAC(:,42,40)=+0.02563*TPK%K095(:)*PCONC(:,3)+0.02212*TPK%K109(:)*PCONC(:,33)+& +&0.11306*TPK%K111(:)*PCONC(:,34)+0.01593*TPK%K115(:)*PCONC(:,40)+0.01593*TPK%K1& +&15(:)*PCONC(:,40)+0.01021*TPK%K124(:)*PCONC(:,5)-TPK%K128(:)*PCONC(:,42) ! !XO2/OLN=0.0 ! !XO2/XO2=-K126*<HO2>-K127*<MO2>-K128*<CARBOP>-K129*<XO2>-K129*<XO2>-K129*<XO2>- !K129*<XO2>-K130*<NO>-K131*<NO3> - PJAC(:,41,41)=-TPK%K126(:)*PCONC(:,15)-TPK%K127(:)*PCONC(:,32)-TPK%K128(:)*PCO& -&NC(:,39)-TPK%K129(:)*PCONC(:,41)-TPK%K129(:)*PCONC(:,41)-TPK%K129(:)*PCONC(:,4& -&1)-TPK%K129(:)*PCONC(:,41)-TPK%K130(:)*PCONC(:,3)-TPK%K131(:)*PCONC(:,5) + PJAC(:,42,42)=-TPK%K126(:)*PCONC(:,16)-TPK%K127(:)*PCONC(:,33)-TPK%K128(:)*PCO& +&NC(:,40)-TPK%K129(:)*PCONC(:,42)-TPK%K129(:)*PCONC(:,42)-TPK%K129(:)*PCONC(:,4& +&2)-TPK%K129(:)*PCONC(:,42)-TPK%K130(:)*PCONC(:,3)-TPK%K131(:)*PCONC(:,5) ! RETURN END SUBROUTINE SUBJ8 @@ -28721,17 +29327,21 @@ END SUBROUTINE SUBSRG12 ! SUBROUTINE SUBSRG13 ! -!Indices 131 a 132 +!Indices 131 a 135 ! TPK%K131=1.20E-12 TPK%K132=1.00E-40 + TPK%K133=5.40E-13 + TPK%K134=1.30E-11*exp(-(400./TPK%T)) + TPK%K135=(TPK%T*exp(-234./TPK%T)+8.4E-10*exp(7230./TPK%T)+2.68E-10*exp(7810./T& +&PK%T))/(1.04E11*TPK%T+88.1*exp(7460./TPK%T)) ! RETURN END SUBROUTINE SUBSRG13 ! SUBROUTINE SUBSRW0 ! -!Indices 133 a 142 +!Indices 136 a 145 ! TPK%KTC1=KT(0.05,48.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC TPK%KTC2=KT(0.11,34.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC @@ -28749,7 +29359,7 @@ END SUBROUTINE SUBSRW0 ! SUBROUTINE SUBSRW1 ! -!Indices 143 a 152 +!Indices 146 a 155 ! TPK%KTC11=KT(0.05,17.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC TPK%KTC12=KT(0.2,30.,TPK%T,TPK%RADC,KVECNPT)*TPK%LWC @@ -28767,24 +29377,24 @@ END SUBROUTINE SUBSRW1 ! SUBROUTINE SUBSRW2 ! -!Indices 153 a 162 +!Indices 156 a 165 ! - TPK%KTC21=KT(0.05,48.,TPK%T,TPK%RADC,KVECNPT)/(HENRY(1.1e-2,-2830.,TPK%T,KVECN& -&PT)*TPK%RCH*TPK%T) - TPK%KTC22=KT(0.11,34.,TPK%T,TPK%RADC,KVECNPT)/(HENRY(7.73e4,-7310.,TPK%T,KVECN& + TPK%KTC21=KT(0.05,48.,TPK%T,TPK%RADC,KVECNPT)/(HENRY(1.03e-2,-2830.,TPK%T,KVEC& +&NPT)*TPK%RCH*TPK%T) + TPK%KTC22=KT(0.11,34.,TPK%T,TPK%RADC,KVECNPT)/(HENRY(8.44e4,-7600.,TPK%T,KVECN& &PT)*TPK%RCH*TPK%T) TPK%KTC23=KT(0.0001,30.,TPK%T,TPK%RADC,KVECNPT)/(HENRY(1.92e-3,-1790.,TPK%T,KV& &ECNPT)*TPK%RCH*TPK%T) - TPK%KTC24=KT(0.0015,46.,TPK%T,TPK%RADC,KVECNPT)/(HENRY(1.4e-2,0.,TPK%T,KVECNPT& -&)*TPK%RCH*TPK%T) + TPK%KTC24=KT(0.0015,46.,TPK%T,TPK%RADC,KVECNPT)/(HENRY(1.2e-2,-2400.,TPK%T,KVE& +&CNPT)*TPK%RCH*TPK%T) TPK%KTC25=KT(0.05,62.,TPK%T,TPK%RADC,KVECNPT)/(HENRY(3.8e-2,0.,TPK%T,KVECNPT)*& &TPK%RCH*TPK%T) - TPK%KTC26=KT(0.0037,108.,TPK%T,TPK%RADC,KVECNPT)/(HENRY(2.1,-3400.,TPK%T,KVECN& -&PT)*TPK%RCH*TPK%T) + TPK%KTC26=KT(0.0037,108.,TPK%T,TPK%RADC,KVECNPT)/(HENRY(8.8e-2,-3600.,TPK%T,KV& +&ECNPT)*TPK%RCH*TPK%T) TPK%KTC27=KT(0.05,47.,TPK%T,TPK%RADC,KVECNPT)/(HEFFA(5.0e1,-4880.,1.6e-3,1760.& &,0.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T) - TPK%KTC28=KT(0.054,63.,TPK%T,TPK%RADC,KVECNPT)/(HEFFA(2.1e5,-8700.,2.2e1,0.,0.& -&,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T) + TPK%KTC28=KT(0.054,63.,TPK%T,TPK%RADC,KVECNPT)/(HEFFA(2.1e5,-10500.,2.2e1,0.,0& +&.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T) TPK%KTC29=KT(0.05,79.,TPK%T,TPK%RADC,KVECNPT)/(HEFFA(1.2e4,-6900.,1.26e-6,0.,0& &.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T) TPK%KTC30=KT(0.04,17.,TPK%T,TPK%RADC,KVECNPT)/(HEFFB(6.02e1,-4160.,1.7e-5,4350& @@ -28795,7 +29405,7 @@ END SUBROUTINE SUBSRW2 ! SUBROUTINE SUBSRW3 ! -!Indices 163 a 172 +!Indices 166 a 175 ! TPK%KTC31=KT(0.05,17.,TPK%T,TPK%RADC,KVECNPT)/(HENRY(3.9e1,0.,TPK%T,KVECNPT)*T& &PK%RCH*TPK%T) @@ -28813,8 +29423,8 @@ SUBROUTINE SUBSRW3 &,0.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T) TPK%KTC38=KT(0.03,60.,TPK%T,TPK%RADC,KVECNPT)/(HEFFA(4.1e3,-6200.,1.74e-5,0.,0& &.,0.,TPK%PHC,TPK%T,KVECNPT)*TPK%RCH*TPK%T) - TPK%KTC39=KT(0.05,47.,TPK%T,TPK%RADC,KVECNPT)/(HENRY(2.7e0,-2030.,TPK%T,KVECNP& -&T)*TPK%RCH*TPK%T) + TPK%KTC39=KT(0.05,47.,TPK%T,TPK%RADC,KVECNPT)/(HENRY(2.45e0,-5280.,TPK%T,KVECN& +&PT)*TPK%RCH*TPK%T) TPK%KTC40=KT(0.007,48.,TPK%T,TPK%RADC,KVECNPT)/(HENRY(3.e2,-5280.,TPK%T,KVECNP& &T)*TPK%RCH*TPK%T) ! @@ -28823,7 +29433,7 @@ END SUBROUTINE SUBSRW3 ! SUBROUTINE SUBSRW4 ! -!Indices 173 a 182 +!Indices 176 a 185 ! TPK%KTR1=KT(0.05,48.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR TPK%KTR2=KT(0.11,34.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR @@ -28841,7 +29451,7 @@ END SUBROUTINE SUBSRW4 ! SUBROUTINE SUBSRW5 ! -!Indices 183 a 192 +!Indices 186 a 195 ! TPK%KTR11=KT(0.05,17.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR TPK%KTR12=KT(0.2,30.,TPK%T,TPK%RADR,KVECNPT)*TPK%LWR @@ -28859,24 +29469,24 @@ END SUBROUTINE SUBSRW5 ! SUBROUTINE SUBSRW6 ! -!Indices 193 a 202 +!Indices 196 a 205 ! - TPK%KTR21=KT(0.05,48.,TPK%T,TPK%RADR,KVECNPT)/(HENRY(1.1e-2,-2830.,TPK%T,KVECN& -&PT)*TPK%RCH*TPK%T) - TPK%KTR22=KT(0.11,34.,TPK%T,TPK%RADR,KVECNPT)/(HENRY(7.73e4,-7310.,TPK%T,KVECN& + TPK%KTR21=KT(0.05,48.,TPK%T,TPK%RADR,KVECNPT)/(HENRY(1.03e-2,-2830.,TPK%T,KVEC& +&NPT)*TPK%RCH*TPK%T) + TPK%KTR22=KT(0.11,34.,TPK%T,TPK%RADR,KVECNPT)/(HENRY(8.44e4,-7600.,TPK%T,KVECN& &PT)*TPK%RCH*TPK%T) TPK%KTR23=KT(0.0001,30.,TPK%T,TPK%RADR,KVECNPT)/(HENRY(1.92e-3,-1790.,TPK%T,KV& &ECNPT)*TPK%RCH*TPK%T) - TPK%KTR24=KT(0.0015,46.,TPK%T,TPK%RADR,KVECNPT)/(HENRY(1.4e-2,0.,TPK%T,KVECNPT& -&)*TPK%RCH*TPK%T) + TPK%KTR24=KT(0.0015,46.,TPK%T,TPK%RADR,KVECNPT)/(HENRY(1.2e-2,-2400.,TPK%T,KVE& +&CNPT)*TPK%RCH*TPK%T) TPK%KTR25=KT(0.05,62.,TPK%T,TPK%RADR,KVECNPT)/(HENRY(3.8e-2,0.,TPK%T,KVECNPT)*& &TPK%RCH*TPK%T) - TPK%KTR26=KT(0.0037,108.,TPK%T,TPK%RADR,KVECNPT)/(HENRY(2.1,-3400.,TPK%T,KVECN& -&PT)*TPK%RCH*TPK%T) + TPK%KTR26=KT(0.0037,108.,TPK%T,TPK%RADR,KVECNPT)/(HENRY(8.8e-2,-3600.,TPK%T,KV& +&ECNPT)*TPK%RCH*TPK%T) TPK%KTR27=KT(0.05,47.,TPK%T,TPK%RADR,KVECNPT)/(HEFFA(5.0e1,-4880.,1.6e-3,1760.& &,0.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T) - TPK%KTR28=KT(0.054,63.,TPK%T,TPK%RADR,KVECNPT)/(HEFFA(2.1e5,-8700.,2.2e1,0.,0.& -&,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T) + TPK%KTR28=KT(0.054,63.,TPK%T,TPK%RADR,KVECNPT)/(HEFFA(2.1e5,-10500.,2.2e1,0.,0& +&.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T) TPK%KTR29=KT(0.05,79.,TPK%T,TPK%RADR,KVECNPT)/(HEFFA(1.2e4,-6900.,1.26e-6,0.,0& &.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T) TPK%KTR30=KT(0.04,17.,TPK%T,TPK%RADR,KVECNPT)/(HEFFB(6.02e1,-4160.,1.7e-5,4350& @@ -28887,7 +29497,7 @@ END SUBROUTINE SUBSRW6 ! SUBROUTINE SUBSRW7 ! -!Indices 203 a 212 +!Indices 206 a 215 ! TPK%KTR31=KT(0.05,17.,TPK%T,TPK%RADR,KVECNPT)/(HENRY(3.9e1,0.,TPK%T,KVECNPT)*T& &PK%RCH*TPK%T) @@ -28905,8 +29515,8 @@ SUBROUTINE SUBSRW7 &,0.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T) TPK%KTR38=KT(0.03,60.,TPK%T,TPK%RADR,KVECNPT)/(HEFFA(4.1e3,-6200.,1.74e-5,0.,0& &.,0.,TPK%PHR,TPK%T,KVECNPT)*TPK%RCH*TPK%T) - TPK%KTR39=KT(0.05,47.,TPK%T,TPK%RADR,KVECNPT)/(HENRY(2.7e0,-2030.,TPK%T,KVECNP& -&T)*TPK%RCH*TPK%T) + TPK%KTR39=KT(0.05,47.,TPK%T,TPK%RADR,KVECNPT)/(HENRY(2.45e0,-5280.,TPK%T,KVECN& +&PT)*TPK%RCH*TPK%T) TPK%KTR40=KT(0.007,48.,TPK%T,TPK%RADR,KVECNPT)/(HENRY(3.e2,-5280.,TPK%T,KVECNP& &T)*TPK%RCH*TPK%T) ! @@ -28915,7 +29525,7 @@ END SUBROUTINE SUBSRW7 ! SUBROUTINE SUBSRW8 ! -!Indices 213 a 222 +!Indices 216 a 225 ! TPK%KC2=(3.6E+9*exp(-930.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLECCLOUD TPK%KC3=((2.8E+10*10.**(-TPK%PHC)+3.5E+10*exp(-720.*(1./TPK%T-1./298.15))*1.6e& @@ -28941,7 +29551,7 @@ END SUBROUTINE SUBSRW8 ! SUBROUTINE SUBSRW9 ! -!Indices 223 a 232 +!Indices 226 a 235 ! TPK%KC11=1.1E0*1.26e-6/(1.26e-6+10.**(-TPK%PHC)) TPK%KC12=(3.3E+5*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*(10.**(-TPK%PHC))**2./& @@ -28971,7 +29581,7 @@ END SUBROUTINE SUBSRW9 ! SUBROUTINE SUBSRW10 ! -!Indices 233 a 242 +!Indices 236 a 245 ! TPK%KC21=((7.9E+2*exp(-2900.*(1./TPK%T-1./298.15))*1.3e-2*exp(1965.*(1./TPK%T-& &1./298.15))*10.**(-TPK%PHC)+2.5E+7*exp(-2450.*(1./TPK%T-1./298.15))*1.3e-2*exp& @@ -29006,7 +29616,7 @@ END SUBROUTINE SUBSRW10 ! SUBROUTINE SUBSRW11 ! -!Indices 243 a 252 +!Indices 246 a 255 ! TPK%KR2=(3.6E+9*exp(-930.*(1./TPK%T-1./298.15)))/TPK%MOL2MOLECRAIN TPK%KR3=((2.8E+10*10.**(-TPK%PHR)+3.5E+10*exp(-720.*(1./TPK%T-1./298.15))*1.6e& @@ -29032,7 +29642,7 @@ END SUBROUTINE SUBSRW11 ! SUBROUTINE SUBSRW12 ! -!Indices 253 a 262 +!Indices 256 a 265 ! TPK%KR11=1.1E0*1.26e-6/(1.26e-6+10.**(-TPK%PHR)) TPK%KR12=(3.3E+5*1.3e-2*exp(1965.*(1./TPK%T-1./298.15))*(10.**(-TPK%PHR))**2./& @@ -29062,7 +29672,7 @@ END SUBROUTINE SUBSRW12 ! SUBROUTINE SUBSRW13 ! -!Indices 263 a 272 +!Indices 266 a 275 ! TPK%KR21=((7.9E+2*exp(-2900.*(1./TPK%T-1./298.15))*1.3e-2*exp(1965.*(1./TPK%T-& &1./298.15))*10.**(-TPK%PHR)+2.5E+7*exp(-2450.*(1./TPK%T-1./298.15))*1.3e-2*exp& @@ -29188,7 +29798,7 @@ REAL,DIMENSION(:,:,:,:), INTENT(IN) :: PJVALUES ! Tuv coefficient ! parameter for use by subroutine JVALUES, ! contains the actual photolysis rates REAL, DIMENSION(KVECNPT,42) :: ZRATESIO ! TUV photolysis rates at one level -REAL, DIMENSION(KVECNPT,19) :: ZRATES ! photolysis rates of RACM (vector) +REAL, DIMENSION(KVECNPT,19) :: ZRATES ! photolysis rates of ReLACS (vector) INTEGER :: JITPK ! loop counter for J-Value transfer INTEGER :: IDTI,IDTJ INTEGER :: JITPKPLUS @@ -29495,147 +30105,150 @@ PRATE(:,129) = TPK%K129(:) PRATE(:,130) = TPK%K130(:) PRATE(:,131) = TPK%K131(:) PRATE(:,132) = TPK%K132(:) +PRATE(:,133) = TPK%K133(:) +PRATE(:,134) = TPK%K134(:) +PRATE(:,135) = TPK%K135(:) IF (TPK%LUSECHAQ) THEN - PRATE(:,133) = TPK%KTC1(:) - PRATE(:,134) = TPK%KTC2(:) - PRATE(:,135) = TPK%KTC3(:) - PRATE(:,136) = TPK%KTC4(:) - PRATE(:,137) = TPK%KTC5(:) - PRATE(:,138) = TPK%KTC6(:) - PRATE(:,139) = TPK%KTC7(:) - PRATE(:,140) = TPK%KTC8(:) - PRATE(:,141) = TPK%KTC9(:) - PRATE(:,142) = TPK%KTC10(:) - PRATE(:,143) = TPK%KTC11(:) - PRATE(:,144) = TPK%KTC12(:) - PRATE(:,145) = TPK%KTC13(:) - PRATE(:,146) = TPK%KTC14(:) - PRATE(:,147) = TPK%KTC15(:) - PRATE(:,148) = TPK%KTC16(:) - PRATE(:,149) = TPK%KTC17(:) - PRATE(:,150) = TPK%KTC18(:) - PRATE(:,151) = TPK%KTC19(:) - PRATE(:,152) = TPK%KTC20(:) - PRATE(:,153) = TPK%KTC21(:) - PRATE(:,154) = TPK%KTC22(:) - PRATE(:,155) = TPK%KTC23(:) - PRATE(:,156) = TPK%KTC24(:) - PRATE(:,157) = TPK%KTC25(:) - PRATE(:,158) = TPK%KTC26(:) - PRATE(:,159) = TPK%KTC27(:) - PRATE(:,160) = TPK%KTC28(:) - PRATE(:,161) = TPK%KTC29(:) - PRATE(:,162) = TPK%KTC30(:) - PRATE(:,163) = TPK%KTC31(:) - PRATE(:,164) = TPK%KTC32(:) - PRATE(:,165) = TPK%KTC33(:) - PRATE(:,166) = TPK%KTC34(:) - PRATE(:,167) = TPK%KTC35(:) - PRATE(:,168) = TPK%KTC36(:) - PRATE(:,169) = TPK%KTC37(:) - PRATE(:,170) = TPK%KTC38(:) - PRATE(:,171) = TPK%KTC39(:) - PRATE(:,172) = TPK%KTC40(:) - PRATE(:,173) = TPK%KTR1(:) - PRATE(:,174) = TPK%KTR2(:) - PRATE(:,175) = TPK%KTR3(:) - PRATE(:,176) = TPK%KTR4(:) - PRATE(:,177) = TPK%KTR5(:) - PRATE(:,178) = TPK%KTR6(:) - PRATE(:,179) = TPK%KTR7(:) - PRATE(:,180) = TPK%KTR8(:) - PRATE(:,181) = TPK%KTR9(:) - PRATE(:,182) = TPK%KTR10(:) - PRATE(:,183) = TPK%KTR11(:) - PRATE(:,184) = TPK%KTR12(:) - PRATE(:,185) = TPK%KTR13(:) - PRATE(:,186) = TPK%KTR14(:) - PRATE(:,187) = TPK%KTR15(:) - PRATE(:,188) = TPK%KTR16(:) - PRATE(:,189) = TPK%KTR17(:) - PRATE(:,190) = TPK%KTR18(:) - PRATE(:,191) = TPK%KTR19(:) - PRATE(:,192) = TPK%KTR20(:) - PRATE(:,193) = TPK%KTR21(:) - PRATE(:,194) = TPK%KTR22(:) - PRATE(:,195) = TPK%KTR23(:) - PRATE(:,196) = TPK%KTR24(:) - PRATE(:,197) = TPK%KTR25(:) - PRATE(:,198) = TPK%KTR26(:) - PRATE(:,199) = TPK%KTR27(:) - PRATE(:,200) = TPK%KTR28(:) - PRATE(:,201) = TPK%KTR29(:) - PRATE(:,202) = TPK%KTR30(:) - PRATE(:,203) = TPK%KTR31(:) - PRATE(:,204) = TPK%KTR32(:) - PRATE(:,205) = TPK%KTR33(:) - PRATE(:,206) = TPK%KTR34(:) - PRATE(:,207) = TPK%KTR35(:) - PRATE(:,208) = TPK%KTR36(:) - PRATE(:,209) = TPK%KTR37(:) - PRATE(:,210) = TPK%KTR38(:) - PRATE(:,211) = TPK%KTR39(:) - PRATE(:,212) = TPK%KTR40(:) - PRATE(:,213) = TPK%KC1(:) - PRATE(:,214) = TPK%KC2(:) - PRATE(:,215) = TPK%KC3(:) - PRATE(:,216) = TPK%KC4(:) - PRATE(:,217) = TPK%KC5(:) - PRATE(:,218) = TPK%KC6(:) - PRATE(:,219) = TPK%KC7(:) - PRATE(:,220) = TPK%KC8(:) - PRATE(:,221) = TPK%KC9(:) - PRATE(:,222) = TPK%KC10(:) - PRATE(:,223) = TPK%KC11(:) - PRATE(:,224) = TPK%KC12(:) - PRATE(:,225) = TPK%KC13(:) - PRATE(:,226) = TPK%KC14(:) - PRATE(:,227) = TPK%KC15(:) - PRATE(:,228) = TPK%KC16(:) - PRATE(:,229) = TPK%KC17(:) - PRATE(:,230) = TPK%KC18(:) - PRATE(:,231) = TPK%KC19(:) - PRATE(:,232) = TPK%KC20(:) - PRATE(:,233) = TPK%KC21(:) - PRATE(:,234) = TPK%KC22(:) - PRATE(:,235) = TPK%KC23(:) - PRATE(:,236) = TPK%KC24(:) - PRATE(:,237) = TPK%KC25(:) - PRATE(:,238) = TPK%KC26(:) - PRATE(:,239) = TPK%KC27(:) - PRATE(:,240) = TPK%KC28(:) - PRATE(:,241) = TPK%KC29(:) - PRATE(:,242) = TPK%KC30(:) - PRATE(:,243) = TPK%KR1(:) - PRATE(:,244) = TPK%KR2(:) - PRATE(:,245) = TPK%KR3(:) - PRATE(:,246) = TPK%KR4(:) - PRATE(:,247) = TPK%KR5(:) - PRATE(:,248) = TPK%KR6(:) - PRATE(:,249) = TPK%KR7(:) - PRATE(:,250) = TPK%KR8(:) - PRATE(:,251) = TPK%KR9(:) - PRATE(:,252) = TPK%KR10(:) - PRATE(:,253) = TPK%KR11(:) - PRATE(:,254) = TPK%KR12(:) - PRATE(:,255) = TPK%KR13(:) - PRATE(:,256) = TPK%KR14(:) - PRATE(:,257) = TPK%KR15(:) - PRATE(:,258) = TPK%KR16(:) - PRATE(:,259) = TPK%KR17(:) - PRATE(:,260) = TPK%KR18(:) - PRATE(:,261) = TPK%KR19(:) - PRATE(:,262) = TPK%KR20(:) - PRATE(:,263) = TPK%KR21(:) - PRATE(:,264) = TPK%KR22(:) - PRATE(:,265) = TPK%KR23(:) - PRATE(:,266) = TPK%KR24(:) - PRATE(:,267) = TPK%KR25(:) - PRATE(:,268) = TPK%KR26(:) - PRATE(:,269) = TPK%KR27(:) - PRATE(:,270) = TPK%KR28(:) - PRATE(:,271) = TPK%KR29(:) - PRATE(:,272) = TPK%KR30(:) + PRATE(:,136) = TPK%KTC1(:) + PRATE(:,137) = TPK%KTC2(:) + PRATE(:,138) = TPK%KTC3(:) + PRATE(:,139) = TPK%KTC4(:) + PRATE(:,140) = TPK%KTC5(:) + PRATE(:,141) = TPK%KTC6(:) + PRATE(:,142) = TPK%KTC7(:) + PRATE(:,143) = TPK%KTC8(:) + PRATE(:,144) = TPK%KTC9(:) + PRATE(:,145) = TPK%KTC10(:) + PRATE(:,146) = TPK%KTC11(:) + PRATE(:,147) = TPK%KTC12(:) + PRATE(:,148) = TPK%KTC13(:) + PRATE(:,149) = TPK%KTC14(:) + PRATE(:,150) = TPK%KTC15(:) + PRATE(:,151) = TPK%KTC16(:) + PRATE(:,152) = TPK%KTC17(:) + PRATE(:,153) = TPK%KTC18(:) + PRATE(:,154) = TPK%KTC19(:) + PRATE(:,155) = TPK%KTC20(:) + PRATE(:,156) = TPK%KTC21(:) + PRATE(:,157) = TPK%KTC22(:) + PRATE(:,158) = TPK%KTC23(:) + PRATE(:,159) = TPK%KTC24(:) + PRATE(:,160) = TPK%KTC25(:) + PRATE(:,161) = TPK%KTC26(:) + PRATE(:,162) = TPK%KTC27(:) + PRATE(:,163) = TPK%KTC28(:) + PRATE(:,164) = TPK%KTC29(:) + PRATE(:,165) = TPK%KTC30(:) + PRATE(:,166) = TPK%KTC31(:) + PRATE(:,167) = TPK%KTC32(:) + PRATE(:,168) = TPK%KTC33(:) + PRATE(:,169) = TPK%KTC34(:) + PRATE(:,170) = TPK%KTC35(:) + PRATE(:,171) = TPK%KTC36(:) + PRATE(:,172) = TPK%KTC37(:) + PRATE(:,173) = TPK%KTC38(:) + PRATE(:,174) = TPK%KTC39(:) + PRATE(:,175) = TPK%KTC40(:) + PRATE(:,176) = TPK%KTR1(:) + PRATE(:,177) = TPK%KTR2(:) + PRATE(:,178) = TPK%KTR3(:) + PRATE(:,179) = TPK%KTR4(:) + PRATE(:,180) = TPK%KTR5(:) + PRATE(:,181) = TPK%KTR6(:) + PRATE(:,182) = TPK%KTR7(:) + PRATE(:,183) = TPK%KTR8(:) + PRATE(:,184) = TPK%KTR9(:) + PRATE(:,185) = TPK%KTR10(:) + PRATE(:,186) = TPK%KTR11(:) + PRATE(:,187) = TPK%KTR12(:) + PRATE(:,188) = TPK%KTR13(:) + PRATE(:,189) = TPK%KTR14(:) + PRATE(:,190) = TPK%KTR15(:) + PRATE(:,191) = TPK%KTR16(:) + PRATE(:,192) = TPK%KTR17(:) + PRATE(:,193) = TPK%KTR18(:) + PRATE(:,194) = TPK%KTR19(:) + PRATE(:,195) = TPK%KTR20(:) + PRATE(:,196) = TPK%KTR21(:) + PRATE(:,197) = TPK%KTR22(:) + PRATE(:,198) = TPK%KTR23(:) + PRATE(:,199) = TPK%KTR24(:) + PRATE(:,200) = TPK%KTR25(:) + PRATE(:,201) = TPK%KTR26(:) + PRATE(:,202) = TPK%KTR27(:) + PRATE(:,203) = TPK%KTR28(:) + PRATE(:,204) = TPK%KTR29(:) + PRATE(:,205) = TPK%KTR30(:) + PRATE(:,206) = TPK%KTR31(:) + PRATE(:,207) = TPK%KTR32(:) + PRATE(:,208) = TPK%KTR33(:) + PRATE(:,209) = TPK%KTR34(:) + PRATE(:,210) = TPK%KTR35(:) + PRATE(:,211) = TPK%KTR36(:) + PRATE(:,212) = TPK%KTR37(:) + PRATE(:,213) = TPK%KTR38(:) + PRATE(:,214) = TPK%KTR39(:) + PRATE(:,215) = TPK%KTR40(:) + PRATE(:,216) = TPK%KC1(:) + PRATE(:,217) = TPK%KC2(:) + PRATE(:,218) = TPK%KC3(:) + PRATE(:,219) = TPK%KC4(:) + PRATE(:,220) = TPK%KC5(:) + PRATE(:,221) = TPK%KC6(:) + PRATE(:,222) = TPK%KC7(:) + PRATE(:,223) = TPK%KC8(:) + PRATE(:,224) = TPK%KC9(:) + PRATE(:,225) = TPK%KC10(:) + PRATE(:,226) = TPK%KC11(:) + PRATE(:,227) = TPK%KC12(:) + PRATE(:,228) = TPK%KC13(:) + PRATE(:,229) = TPK%KC14(:) + PRATE(:,230) = TPK%KC15(:) + PRATE(:,231) = TPK%KC16(:) + PRATE(:,232) = TPK%KC17(:) + PRATE(:,233) = TPK%KC18(:) + PRATE(:,234) = TPK%KC19(:) + PRATE(:,235) = TPK%KC20(:) + PRATE(:,236) = TPK%KC21(:) + PRATE(:,237) = TPK%KC22(:) + PRATE(:,238) = TPK%KC23(:) + PRATE(:,239) = TPK%KC24(:) + PRATE(:,240) = TPK%KC25(:) + PRATE(:,241) = TPK%KC26(:) + PRATE(:,242) = TPK%KC27(:) + PRATE(:,243) = TPK%KC28(:) + PRATE(:,244) = TPK%KC29(:) + PRATE(:,245) = TPK%KC30(:) + PRATE(:,246) = TPK%KR1(:) + PRATE(:,247) = TPK%KR2(:) + PRATE(:,248) = TPK%KR3(:) + PRATE(:,249) = TPK%KR4(:) + PRATE(:,250) = TPK%KR5(:) + PRATE(:,251) = TPK%KR6(:) + PRATE(:,252) = TPK%KR7(:) + PRATE(:,253) = TPK%KR8(:) + PRATE(:,254) = TPK%KR9(:) + PRATE(:,255) = TPK%KR10(:) + PRATE(:,256) = TPK%KR11(:) + PRATE(:,257) = TPK%KR12(:) + PRATE(:,258) = TPK%KR13(:) + PRATE(:,259) = TPK%KR14(:) + PRATE(:,260) = TPK%KR15(:) + PRATE(:,261) = TPK%KR16(:) + PRATE(:,262) = TPK%KR17(:) + PRATE(:,263) = TPK%KR18(:) + PRATE(:,264) = TPK%KR19(:) + PRATE(:,265) = TPK%KR20(:) + PRATE(:,266) = TPK%KR21(:) + PRATE(:,267) = TPK%KR22(:) + PRATE(:,268) = TPK%KR23(:) + PRATE(:,269) = TPK%KR24(:) + PRATE(:,270) = TPK%KR25(:) + PRATE(:,271) = TPK%KR26(:) + PRATE(:,272) = TPK%KR27(:) + PRATE(:,273) = TPK%KR28(:) + PRATE(:,274) = TPK%KR29(:) + PRATE(:,275) = TPK%KR30(:) END IF RETURN END SUBROUTINE CH_GET_RATES @@ -29808,7 +30421,7 @@ TPK%O3P(:)=(TPK%K001(:)*PCONC(:,JP_NO2)+TPK%K003(:)*PCONC(:,JP_O3)+TPK%K008(:)*P &0.09000*TPK%K080(:)*PCONC(:,JP_BIO)*PCONC(:,JP_O3))/& &(TPK%K018(:)*TPK%O2(:)+TPK%K019(:)*PCONC(:,JP_O3)+TPK%K029(:)*PCONC(:,JP_NO)+& &TPK%K030(:)*PCONC(:,JP_NO2)+TPK%K031(:)*PCONC(:,JP_NO2)+TPK%K054(:)*PCONC(:,JP_BIO)+& - &TPK%K055(:)*PCONC(:,JP_CARBO)) + &TPK%K055(:)*PCONC(:,JP_CARBO)+TPK%K134(:)*PCONC(:,JP_DMS)) ! /END_CODE/ PTERMS(:,:,:) = 0.0 CALL SUBT0 @@ -29886,7 +30499,7 @@ SUBROUTINE SUBT0 PTERMS(:,7,4) = -TPK%K004(:)*PCONC(:,7) ! !PTERMS(OH,K004) = +K004*<HONO> - PTERMS(:,14,4) = +TPK%K004(:)*PCONC(:,7) + PTERMS(:,15,4) = +TPK%K004(:)*PCONC(:,7) ! !PTERMS(NO2,K005) = +K005*<HNO3> PTERMS(:,4,5) = +TPK%K005(:)*PCONC(:,8) @@ -29895,7 +30508,7 @@ SUBROUTINE SUBT0 PTERMS(:,8,5) = -TPK%K005(:)*PCONC(:,8) ! !PTERMS(OH,K005) = +K005*<HNO3> - PTERMS(:,14,5) = +TPK%K005(:)*PCONC(:,8) + PTERMS(:,15,5) = +TPK%K005(:)*PCONC(:,8) ! !PTERMS(NO2,K006) = +0.65*K006*<HNO4> PTERMS(:,4,6) = +0.65*TPK%K006(:)*PCONC(:,9) @@ -29907,10 +30520,10 @@ SUBROUTINE SUBT0 PTERMS(:,9,6) = -TPK%K006(:)*PCONC(:,9) ! !PTERMS(OH,K006) = +0.35*K006*<HNO4> - PTERMS(:,14,6) = +0.35*TPK%K006(:)*PCONC(:,9) + PTERMS(:,15,6) = +0.35*TPK%K006(:)*PCONC(:,9) ! !PTERMS(HO2,K006) = +0.65*K006*<HNO4> - PTERMS(:,15,6) = +0.65*TPK%K006(:)*PCONC(:,9) + PTERMS(:,16,6) = +0.65*TPK%K006(:)*PCONC(:,9) ! !PTERMS(NO,K007) = +K007*<NO3> PTERMS(:,3,7) = +TPK%K007(:)*PCONC(:,5) @@ -29936,64 +30549,64 @@ SUBROUTINE SUBT1 !Indices 21 a 40 ! !PTERMS(OH,K009) = +K009*<H2O2> - PTERMS(:,14,9) = +TPK%K009(:)*PCONC(:,2) + PTERMS(:,15,9) = +TPK%K009(:)*PCONC(:,2) ! !PTERMS(CO,K010) = +K010*<HCHO> - PTERMS(:,13,10) = +TPK%K010(:)*PCONC(:,22) + PTERMS(:,14,10) = +TPK%K010(:)*PCONC(:,23) ! !PTERMS(HCHO,K010) = -K010*<HCHO> - PTERMS(:,22,10) = -TPK%K010(:)*PCONC(:,22) + PTERMS(:,23,10) = -TPK%K010(:)*PCONC(:,23) ! !PTERMS(CO,K011) = +K011*<HCHO> - PTERMS(:,13,11) = +TPK%K011(:)*PCONC(:,22) + PTERMS(:,14,11) = +TPK%K011(:)*PCONC(:,23) ! !PTERMS(HO2,K011) = +K011*<HCHO> - PTERMS(:,15,11) = +TPK%K011(:)*PCONC(:,22) + PTERMS(:,16,11) = +TPK%K011(:)*PCONC(:,23) ! !PTERMS(HCHO,K011) = -K011*<HCHO> - PTERMS(:,22,11) = -TPK%K011(:)*PCONC(:,22) + PTERMS(:,23,11) = -TPK%K011(:)*PCONC(:,23) ! !PTERMS(CO,K012) = +K012*<ALD> - PTERMS(:,13,12) = +TPK%K012(:)*PCONC(:,23) + PTERMS(:,14,12) = +TPK%K012(:)*PCONC(:,24) ! !PTERMS(HO2,K012) = +K012*<ALD> - PTERMS(:,15,12) = +TPK%K012(:)*PCONC(:,23) + PTERMS(:,16,12) = +TPK%K012(:)*PCONC(:,24) ! !PTERMS(ALD,K012) = -K012*<ALD> - PTERMS(:,23,12) = -TPK%K012(:)*PCONC(:,23) + PTERMS(:,24,12) = -TPK%K012(:)*PCONC(:,24) ! !PTERMS(MO2,K012) = +K012*<ALD> - PTERMS(:,32,12) = +TPK%K012(:)*PCONC(:,23) + PTERMS(:,33,12) = +TPK%K012(:)*PCONC(:,24) ! !PTERMS(OH,K013) = +K013*<OP1> - PTERMS(:,14,13) = +TPK%K013(:)*PCONC(:,28) + PTERMS(:,15,13) = +TPK%K013(:)*PCONC(:,29) ! !PTERMS(HO2,K013) = +K013*<OP1> - PTERMS(:,15,13) = +TPK%K013(:)*PCONC(:,28) + PTERMS(:,16,13) = +TPK%K013(:)*PCONC(:,29) ! !PTERMS(HCHO,K013) = +K013*<OP1> - PTERMS(:,22,13) = +TPK%K013(:)*PCONC(:,28) + PTERMS(:,23,13) = +TPK%K013(:)*PCONC(:,29) ! !PTERMS(OP1,K013) = -K013*<OP1> - PTERMS(:,28,13) = -TPK%K013(:)*PCONC(:,28) + PTERMS(:,29,13) = -TPK%K013(:)*PCONC(:,29) ! !PTERMS(OH,K014) = +K014*<OP2> - PTERMS(:,14,14) = +TPK%K014(:)*PCONC(:,29) + PTERMS(:,15,14) = +TPK%K014(:)*PCONC(:,30) ! !PTERMS(HO2,K014) = +0.96205*K014*<OP2> - PTERMS(:,15,14) = +0.96205*TPK%K014(:)*PCONC(:,29) + PTERMS(:,16,14) = +0.96205*TPK%K014(:)*PCONC(:,30) ! !PTERMS(ALD,K014) = +0.96205*K014*<OP2> - PTERMS(:,23,14) = +0.96205*TPK%K014(:)*PCONC(:,29) + PTERMS(:,24,14) = +0.96205*TPK%K014(:)*PCONC(:,30) ! !PTERMS(OP2,K014) = -K014*<OP2> - PTERMS(:,29,14) = -TPK%K014(:)*PCONC(:,29) + PTERMS(:,30,14) = -TPK%K014(:)*PCONC(:,30) ! !PTERMS(MO2,K014) = +0.03795*K014*<OP2> - PTERMS(:,32,14) = +0.03795*TPK%K014(:)*PCONC(:,29) + PTERMS(:,33,14) = +0.03795*TPK%K014(:)*PCONC(:,30) ! !PTERMS(KET,K015) = -K015*<KET> - PTERMS(:,24,15) = -TPK%K015(:)*PCONC(:,24) + PTERMS(:,25,15) = -TPK%K015(:)*PCONC(:,25) ! ! RETURN @@ -30004,40 +30617,40 @@ SUBROUTINE SUBT2 !Indices 41 a 60 ! !PTERMS(ALKAP,K015) = +1.00000*K015*<KET> - PTERMS(:,33,15) = +1.00000*TPK%K015(:)*PCONC(:,24) + PTERMS(:,34,15) = +1.00000*TPK%K015(:)*PCONC(:,25) ! !PTERMS(CARBOP,K015) = +1.00000*K015*<KET> - PTERMS(:,39,15) = +1.00000*TPK%K015(:)*PCONC(:,24) + PTERMS(:,40,15) = +1.00000*TPK%K015(:)*PCONC(:,25) ! !PTERMS(CO,K016) = +0.91924*K016*<CARBO> - PTERMS(:,13,16) = +0.91924*TPK%K016(:)*PCONC(:,25) + PTERMS(:,14,16) = +0.91924*TPK%K016(:)*PCONC(:,26) ! !PTERMS(HO2,K016) = +0.75830*K016*<CARBO> - PTERMS(:,15,16) = +0.75830*TPK%K016(:)*PCONC(:,25) + PTERMS(:,16,16) = +0.75830*TPK%K016(:)*PCONC(:,26) ! !PTERMS(HCHO,K016) = +0.06517*K016*<CARBO> - PTERMS(:,22,16) = +0.06517*TPK%K016(:)*PCONC(:,25) + PTERMS(:,23,16) = +0.06517*TPK%K016(:)*PCONC(:,26) ! !PTERMS(CARBO,K016) = -K016*<CARBO> - PTERMS(:,25,16) = -TPK%K016(:)*PCONC(:,25) + PTERMS(:,26,16) = -TPK%K016(:)*PCONC(:,26) ! !PTERMS(CARBOP,K016) = +0.69622*K016*<CARBO> - PTERMS(:,39,16) = +0.69622*TPK%K016(:)*PCONC(:,25) + PTERMS(:,40,16) = +0.69622*TPK%K016(:)*PCONC(:,26) ! !PTERMS(NO2,K017) = +K017*<ONIT> - PTERMS(:,4,17) = +TPK%K017(:)*PCONC(:,26) + PTERMS(:,4,17) = +TPK%K017(:)*PCONC(:,27) ! !PTERMS(HO2,K017) = +K017*<ONIT> - PTERMS(:,15,17) = +TPK%K017(:)*PCONC(:,26) + PTERMS(:,16,17) = +TPK%K017(:)*PCONC(:,27) ! !PTERMS(ALD,K017) = +0.20*K017*<ONIT> - PTERMS(:,23,17) = +0.20*TPK%K017(:)*PCONC(:,26) + PTERMS(:,24,17) = +0.20*TPK%K017(:)*PCONC(:,27) ! !PTERMS(KET,K017) = +0.80*K017*<ONIT> - PTERMS(:,24,17) = +0.80*TPK%K017(:)*PCONC(:,26) + PTERMS(:,25,17) = +0.80*TPK%K017(:)*PCONC(:,27) ! !PTERMS(ONIT,K017) = -K017*<ONIT> - PTERMS(:,26,17) = -TPK%K017(:)*PCONC(:,26) + PTERMS(:,27,17) = -TPK%K017(:)*PCONC(:,27) ! !PTERMS(O3,K018) = +K018*<O3P>*<O2> PTERMS(:,1,18) = +TPK%K018(:)*TPK%O3P(:)*TPK%O2(:) @@ -30046,22 +30659,22 @@ SUBROUTINE SUBT2 PTERMS(:,1,19) = -TPK%K019(:)*TPK%O3P(:)*PCONC(:,1) ! !PTERMS(OH,K022) = +K022*<O1D>*<H2O> - PTERMS(:,14,22) = +TPK%K022(:)*TPK%O1D(:)*TPK%H2O(:) + PTERMS(:,15,22) = +TPK%K022(:)*TPK%O1D(:)*TPK%H2O(:) ! !PTERMS(O3,K023) = -K023*<O3>*<OH> - PTERMS(:,1,23) = -TPK%K023(:)*PCONC(:,1)*PCONC(:,14) + PTERMS(:,1,23) = -TPK%K023(:)*PCONC(:,1)*PCONC(:,15) ! !PTERMS(OH,K023) = -K023*<O3>*<OH> - PTERMS(:,14,23) = -TPK%K023(:)*PCONC(:,1)*PCONC(:,14) + PTERMS(:,15,23) = -TPK%K023(:)*PCONC(:,1)*PCONC(:,15) ! !PTERMS(HO2,K023) = +K023*<O3>*<OH> - PTERMS(:,15,23) = +TPK%K023(:)*PCONC(:,1)*PCONC(:,14) + PTERMS(:,16,23) = +TPK%K023(:)*PCONC(:,1)*PCONC(:,15) ! !PTERMS(O3,K024) = -K024*<O3>*<HO2> - PTERMS(:,1,24) = -TPK%K024(:)*PCONC(:,1)*PCONC(:,15) + PTERMS(:,1,24) = -TPK%K024(:)*PCONC(:,1)*PCONC(:,16) ! !PTERMS(OH,K024) = +K024*<O3>*<HO2> - PTERMS(:,14,24) = +TPK%K024(:)*PCONC(:,1)*PCONC(:,15) + PTERMS(:,15,24) = +TPK%K024(:)*PCONC(:,1)*PCONC(:,16) ! ! RETURN @@ -30072,34 +30685,34 @@ SUBROUTINE SUBT3 !Indices 61 a 80 ! !PTERMS(HO2,K024) = -K024*<O3>*<HO2> - PTERMS(:,15,24) = -TPK%K024(:)*PCONC(:,1)*PCONC(:,15) + PTERMS(:,16,24) = -TPK%K024(:)*PCONC(:,1)*PCONC(:,16) ! !PTERMS(OH,K025) = -K025*<OH>*<HO2> - PTERMS(:,14,25) = -TPK%K025(:)*PCONC(:,14)*PCONC(:,15) + PTERMS(:,15,25) = -TPK%K025(:)*PCONC(:,15)*PCONC(:,16) ! !PTERMS(HO2,K025) = -K025*<OH>*<HO2> - PTERMS(:,15,25) = -TPK%K025(:)*PCONC(:,14)*PCONC(:,15) + PTERMS(:,16,25) = -TPK%K025(:)*PCONC(:,15)*PCONC(:,16) ! !PTERMS(H2O2,K026) = -K026*<H2O2>*<OH> - PTERMS(:,2,26) = -TPK%K026(:)*PCONC(:,2)*PCONC(:,14) + PTERMS(:,2,26) = -TPK%K026(:)*PCONC(:,2)*PCONC(:,15) ! !PTERMS(OH,K026) = -K026*<H2O2>*<OH> - PTERMS(:,14,26) = -TPK%K026(:)*PCONC(:,2)*PCONC(:,14) + PTERMS(:,15,26) = -TPK%K026(:)*PCONC(:,2)*PCONC(:,15) ! !PTERMS(HO2,K026) = +K026*<H2O2>*<OH> - PTERMS(:,15,26) = +TPK%K026(:)*PCONC(:,2)*PCONC(:,14) + PTERMS(:,16,26) = +TPK%K026(:)*PCONC(:,2)*PCONC(:,15) ! !PTERMS(H2O2,K027) = +K027*<HO2>*<HO2> - PTERMS(:,2,27) = +TPK%K027(:)*PCONC(:,15)*PCONC(:,15) + PTERMS(:,2,27) = +TPK%K027(:)*PCONC(:,16)*PCONC(:,16) ! !PTERMS(HO2,K027) = -K027*<HO2>*<HO2> - PTERMS(:,15,27) = -TPK%K027(:)*PCONC(:,15)*PCONC(:,15) + PTERMS(:,16,27) = -TPK%K027(:)*PCONC(:,16)*PCONC(:,16) ! !PTERMS(H2O2,K028) = +K028*<HO2>*<HO2>*<H2O> - PTERMS(:,2,28) = +TPK%K028(:)*PCONC(:,15)*PCONC(:,15)*TPK%H2O(:) + PTERMS(:,2,28) = +TPK%K028(:)*PCONC(:,16)*PCONC(:,16)*TPK%H2O(:) ! !PTERMS(HO2,K028) = -K028*<HO2>*<HO2>*<H2O> - PTERMS(:,15,28) = -TPK%K028(:)*PCONC(:,15)*PCONC(:,15)*TPK%H2O(:) + PTERMS(:,16,28) = -TPK%K028(:)*PCONC(:,16)*PCONC(:,16)*TPK%H2O(:) ! !PTERMS(NO,K029) = -K029*<O3P>*<NO> PTERMS(:,3,29) = -TPK%K029(:)*TPK%O3P(:)*PCONC(:,3) @@ -30120,16 +30733,16 @@ SUBROUTINE SUBT3 PTERMS(:,5,31) = +TPK%K031(:)*TPK%O3P(:)*PCONC(:,4) ! !PTERMS(NO,K032) = -K032*<OH>*<NO> - PTERMS(:,3,32) = -TPK%K032(:)*PCONC(:,14)*PCONC(:,3) + PTERMS(:,3,32) = -TPK%K032(:)*PCONC(:,15)*PCONC(:,3) ! !PTERMS(HONO,K032) = +K032*<OH>*<NO> - PTERMS(:,7,32) = +TPK%K032(:)*PCONC(:,14)*PCONC(:,3) + PTERMS(:,7,32) = +TPK%K032(:)*PCONC(:,15)*PCONC(:,3) ! !PTERMS(OH,K032) = -K032*<OH>*<NO> - PTERMS(:,14,32) = -TPK%K032(:)*PCONC(:,14)*PCONC(:,3) + PTERMS(:,15,32) = -TPK%K032(:)*PCONC(:,15)*PCONC(:,3) ! !PTERMS(NO2,K033) = -K033*<OH>*<NO2> - PTERMS(:,4,33) = -TPK%K033(:)*PCONC(:,14)*PCONC(:,4) + PTERMS(:,4,33) = -TPK%K033(:)*PCONC(:,15)*PCONC(:,4) ! ! RETURN @@ -30140,43 +30753,43 @@ SUBROUTINE SUBT4 !Indices 81 a 100 ! !PTERMS(HNO3,K033) = +K033*<OH>*<NO2> - PTERMS(:,8,33) = +TPK%K033(:)*PCONC(:,14)*PCONC(:,4) + PTERMS(:,8,33) = +TPK%K033(:)*PCONC(:,15)*PCONC(:,4) ! !PTERMS(OH,K033) = -K033*<OH>*<NO2> - PTERMS(:,14,33) = -TPK%K033(:)*PCONC(:,14)*PCONC(:,4) + PTERMS(:,15,33) = -TPK%K033(:)*PCONC(:,15)*PCONC(:,4) ! !PTERMS(NO2,K034) = +K034*<OH>*<NO3> - PTERMS(:,4,34) = +TPK%K034(:)*PCONC(:,14)*PCONC(:,5) + PTERMS(:,4,34) = +TPK%K034(:)*PCONC(:,15)*PCONC(:,5) ! !PTERMS(NO3,K034) = -K034*<OH>*<NO3> - PTERMS(:,5,34) = -TPK%K034(:)*PCONC(:,14)*PCONC(:,5) + PTERMS(:,5,34) = -TPK%K034(:)*PCONC(:,15)*PCONC(:,5) ! !PTERMS(OH,K034) = -K034*<OH>*<NO3> - PTERMS(:,14,34) = -TPK%K034(:)*PCONC(:,14)*PCONC(:,5) + PTERMS(:,15,34) = -TPK%K034(:)*PCONC(:,15)*PCONC(:,5) ! !PTERMS(HO2,K034) = +K034*<OH>*<NO3> - PTERMS(:,15,34) = +TPK%K034(:)*PCONC(:,14)*PCONC(:,5) + PTERMS(:,16,34) = +TPK%K034(:)*PCONC(:,15)*PCONC(:,5) ! !PTERMS(NO,K035) = -K035*<HO2>*<NO> - PTERMS(:,3,35) = -TPK%K035(:)*PCONC(:,15)*PCONC(:,3) + PTERMS(:,3,35) = -TPK%K035(:)*PCONC(:,16)*PCONC(:,3) ! !PTERMS(NO2,K035) = +K035*<HO2>*<NO> - PTERMS(:,4,35) = +TPK%K035(:)*PCONC(:,15)*PCONC(:,3) + PTERMS(:,4,35) = +TPK%K035(:)*PCONC(:,16)*PCONC(:,3) ! !PTERMS(OH,K035) = +K035*<HO2>*<NO> - PTERMS(:,14,35) = +TPK%K035(:)*PCONC(:,15)*PCONC(:,3) + PTERMS(:,15,35) = +TPK%K035(:)*PCONC(:,16)*PCONC(:,3) ! !PTERMS(HO2,K035) = -K035*<HO2>*<NO> - PTERMS(:,15,35) = -TPK%K035(:)*PCONC(:,15)*PCONC(:,3) + PTERMS(:,16,35) = -TPK%K035(:)*PCONC(:,16)*PCONC(:,3) ! !PTERMS(NO2,K036) = -K036*<HO2>*<NO2> - PTERMS(:,4,36) = -TPK%K036(:)*PCONC(:,15)*PCONC(:,4) + PTERMS(:,4,36) = -TPK%K036(:)*PCONC(:,16)*PCONC(:,4) ! !PTERMS(HNO4,K036) = +K036*<HO2>*<NO2> - PTERMS(:,9,36) = +TPK%K036(:)*PCONC(:,15)*PCONC(:,4) + PTERMS(:,9,36) = +TPK%K036(:)*PCONC(:,16)*PCONC(:,4) ! !PTERMS(HO2,K036) = -K036*<HO2>*<NO2> - PTERMS(:,15,36) = -TPK%K036(:)*PCONC(:,15)*PCONC(:,4) + PTERMS(:,16,36) = -TPK%K036(:)*PCONC(:,16)*PCONC(:,4) ! !PTERMS(NO2,K037) = +K037*<HNO4> PTERMS(:,4,37) = +TPK%K037(:)*PCONC(:,9) @@ -30185,19 +30798,19 @@ SUBROUTINE SUBT4 PTERMS(:,9,37) = -TPK%K037(:)*PCONC(:,9) ! !PTERMS(HO2,K037) = +K037*<HNO4> - PTERMS(:,15,37) = +TPK%K037(:)*PCONC(:,9) + PTERMS(:,16,37) = +TPK%K037(:)*PCONC(:,9) ! !PTERMS(NO2,K038) = +0.7*K038*<HO2>*<NO3> - PTERMS(:,4,38) = +0.7*TPK%K038(:)*PCONC(:,15)*PCONC(:,5) + PTERMS(:,4,38) = +0.7*TPK%K038(:)*PCONC(:,16)*PCONC(:,5) ! !PTERMS(NO3,K038) = -K038*<HO2>*<NO3> - PTERMS(:,5,38) = -TPK%K038(:)*PCONC(:,15)*PCONC(:,5) + PTERMS(:,5,38) = -TPK%K038(:)*PCONC(:,16)*PCONC(:,5) ! !PTERMS(HNO3,K038) = +0.3*K038*<HO2>*<NO3> - PTERMS(:,8,38) = +0.3*TPK%K038(:)*PCONC(:,15)*PCONC(:,5) + PTERMS(:,8,38) = +0.3*TPK%K038(:)*PCONC(:,16)*PCONC(:,5) ! !PTERMS(OH,K038) = +0.7*K038*<HO2>*<NO3> - PTERMS(:,14,38) = +0.7*TPK%K038(:)*PCONC(:,15)*PCONC(:,5) + PTERMS(:,15,38) = +0.7*TPK%K038(:)*PCONC(:,16)*PCONC(:,5) ! ! RETURN @@ -30208,34 +30821,34 @@ SUBROUTINE SUBT5 !Indices 101 a 120 ! !PTERMS(HO2,K038) = -K038*<HO2>*<NO3> - PTERMS(:,15,38) = -TPK%K038(:)*PCONC(:,15)*PCONC(:,5) + PTERMS(:,16,38) = -TPK%K038(:)*PCONC(:,16)*PCONC(:,5) ! !PTERMS(NO2,K039) = +K039*<OH>*<HONO> - PTERMS(:,4,39) = +TPK%K039(:)*PCONC(:,14)*PCONC(:,7) + PTERMS(:,4,39) = +TPK%K039(:)*PCONC(:,15)*PCONC(:,7) ! !PTERMS(HONO,K039) = -K039*<OH>*<HONO> - PTERMS(:,7,39) = -TPK%K039(:)*PCONC(:,14)*PCONC(:,7) + PTERMS(:,7,39) = -TPK%K039(:)*PCONC(:,15)*PCONC(:,7) ! !PTERMS(OH,K039) = -K039*<OH>*<HONO> - PTERMS(:,14,39) = -TPK%K039(:)*PCONC(:,14)*PCONC(:,7) + PTERMS(:,15,39) = -TPK%K039(:)*PCONC(:,15)*PCONC(:,7) ! !PTERMS(NO3,K040) = +K040*<OH>*<HNO3> - PTERMS(:,5,40) = +TPK%K040(:)*PCONC(:,14)*PCONC(:,8) + PTERMS(:,5,40) = +TPK%K040(:)*PCONC(:,15)*PCONC(:,8) ! !PTERMS(HNO3,K040) = -K040*<OH>*<HNO3> - PTERMS(:,8,40) = -TPK%K040(:)*PCONC(:,14)*PCONC(:,8) + PTERMS(:,8,40) = -TPK%K040(:)*PCONC(:,15)*PCONC(:,8) ! !PTERMS(OH,K040) = -K040*<OH>*<HNO3> - PTERMS(:,14,40) = -TPK%K040(:)*PCONC(:,14)*PCONC(:,8) + PTERMS(:,15,40) = -TPK%K040(:)*PCONC(:,15)*PCONC(:,8) ! !PTERMS(NO2,K041) = +K041*<OH>*<HNO4> - PTERMS(:,4,41) = +TPK%K041(:)*PCONC(:,14)*PCONC(:,9) + PTERMS(:,4,41) = +TPK%K041(:)*PCONC(:,15)*PCONC(:,9) ! !PTERMS(HNO4,K041) = -K041*<OH>*<HNO4> - PTERMS(:,9,41) = -TPK%K041(:)*PCONC(:,14)*PCONC(:,9) + PTERMS(:,9,41) = -TPK%K041(:)*PCONC(:,15)*PCONC(:,9) ! !PTERMS(OH,K041) = -K041*<OH>*<HNO4> - PTERMS(:,14,41) = -TPK%K041(:)*PCONC(:,14)*PCONC(:,9) + PTERMS(:,15,41) = -TPK%K041(:)*PCONC(:,15)*PCONC(:,9) ! !PTERMS(O3,K042) = -K042*<O3>*<NO> PTERMS(:,1,42) = -TPK%K042(:)*PCONC(:,1)*PCONC(:,3) @@ -30312,28 +30925,28 @@ SUBROUTINE SUBT6 PTERMS(:,5,49) = -TPK%K049(:)*PCONC(:,5)*PCONC(:,5) ! !PTERMS(NH3,K050) = -K050*<NH3>*<OH> - PTERMS(:,10,50) = -TPK%K050(:)*PCONC(:,10)*PCONC(:,14) + PTERMS(:,10,50) = -TPK%K050(:)*PCONC(:,10)*PCONC(:,15) ! !PTERMS(OH,K050) = -K050*<NH3>*<OH> - PTERMS(:,14,50) = -TPK%K050(:)*PCONC(:,10)*PCONC(:,14) + PTERMS(:,15,50) = -TPK%K050(:)*PCONC(:,10)*PCONC(:,15) ! !PTERMS(OH,K051) = -K051*<OH>*<H2> - PTERMS(:,14,51) = -TPK%K051(:)*PCONC(:,14)*TPK%H2(:) + PTERMS(:,15,51) = -TPK%K051(:)*PCONC(:,15)*TPK%H2(:) ! !PTERMS(HO2,K051) = +K051*<OH>*<H2> - PTERMS(:,15,51) = +TPK%K051(:)*PCONC(:,14)*TPK%H2(:) + PTERMS(:,16,51) = +TPK%K051(:)*PCONC(:,15)*TPK%H2(:) ! !PTERMS(SO2,K052) = -K052*<OH>*<SO2> - PTERMS(:,11,52) = -TPK%K052(:)*PCONC(:,14)*PCONC(:,11) + PTERMS(:,12,52) = -TPK%K052(:)*PCONC(:,15)*PCONC(:,12) ! !PTERMS(SULF,K052) = +K052*<OH>*<SO2> - PTERMS(:,12,52) = +TPK%K052(:)*PCONC(:,14)*PCONC(:,11) + PTERMS(:,13,52) = +TPK%K052(:)*PCONC(:,15)*PCONC(:,12) ! !PTERMS(OH,K052) = -K052*<OH>*<SO2> - PTERMS(:,14,52) = -TPK%K052(:)*PCONC(:,14)*PCONC(:,11) + PTERMS(:,15,52) = -TPK%K052(:)*PCONC(:,15)*PCONC(:,12) ! !PTERMS(HO2,K052) = +K052*<OH>*<SO2> - PTERMS(:,15,52) = +TPK%K052(:)*PCONC(:,14)*PCONC(:,11) + PTERMS(:,16,52) = +TPK%K052(:)*PCONC(:,15)*PCONC(:,12) ! ! RETURN @@ -30344,64 +30957,64 @@ SUBROUTINE SUBT7 !Indices 141 a 160 ! !PTERMS(CO,K053) = -K053*<CO>*<OH> - PTERMS(:,13,53) = -TPK%K053(:)*PCONC(:,13)*PCONC(:,14) + PTERMS(:,14,53) = -TPK%K053(:)*PCONC(:,14)*PCONC(:,15) ! !PTERMS(OH,K053) = -K053*<CO>*<OH> - PTERMS(:,14,53) = -TPK%K053(:)*PCONC(:,13)*PCONC(:,14) + PTERMS(:,15,53) = -TPK%K053(:)*PCONC(:,14)*PCONC(:,15) ! !PTERMS(HO2,K053) = +K053*<CO>*<OH> - PTERMS(:,15,53) = +TPK%K053(:)*PCONC(:,13)*PCONC(:,14) + PTERMS(:,16,53) = +TPK%K053(:)*PCONC(:,14)*PCONC(:,15) ! !PTERMS(CO,K054) = +0.01*K054*<BIO>*<O3P> - PTERMS(:,13,54) = +0.01*TPK%K054(:)*PCONC(:,20)*TPK%O3P(:) + PTERMS(:,14,54) = +0.01*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:) ! !PTERMS(OH,K054) = +0.02*K054*<BIO>*<O3P> - PTERMS(:,14,54) = +0.02*TPK%K054(:)*PCONC(:,20)*TPK%O3P(:) + PTERMS(:,15,54) = +0.02*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:) ! !PTERMS(HO2,K054) = +0.28*K054*<BIO>*<O3P> - PTERMS(:,15,54) = +0.28*TPK%K054(:)*PCONC(:,20)*TPK%O3P(:) + PTERMS(:,16,54) = +0.28*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:) ! !PTERMS(ALKE,K054) = +0.91868*K054*<BIO>*<O3P> - PTERMS(:,19,54) = +0.91868*TPK%K054(:)*PCONC(:,20)*TPK%O3P(:) + PTERMS(:,20,54) = +0.91868*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:) ! !PTERMS(BIO,K054) = -K054*<BIO>*<O3P> - PTERMS(:,20,54) = -TPK%K054(:)*PCONC(:,20)*TPK%O3P(:) + PTERMS(:,21,54) = -TPK%K054(:)*PCONC(:,21)*TPK%O3P(:) ! !PTERMS(HCHO,K054) = +0.05*K054*<BIO>*<O3P> - PTERMS(:,22,54) = +0.05*TPK%K054(:)*PCONC(:,20)*TPK%O3P(:) + PTERMS(:,23,54) = +0.05*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:) ! !PTERMS(CARBO,K054) = +0.13255*K054*<BIO>*<O3P> - PTERMS(:,25,54) = +0.13255*TPK%K054(:)*PCONC(:,20)*TPK%O3P(:) + PTERMS(:,26,54) = +0.13255*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:) ! !PTERMS(XO2,K054) = +0.15*K054*<BIO>*<O3P> - PTERMS(:,41,54) = +0.15*TPK%K054(:)*PCONC(:,20)*TPK%O3P(:) + PTERMS(:,42,54) = +0.15*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:) ! !PTERMS(ALD,K055) = +K055*<CARBO>*<O3P> - PTERMS(:,23,55) = +TPK%K055(:)*PCONC(:,25)*TPK%O3P(:) + PTERMS(:,24,55) = +TPK%K055(:)*PCONC(:,26)*TPK%O3P(:) ! !PTERMS(CARBO,K055) = -K055*<CARBO>*<O3P> - PTERMS(:,25,55) = -TPK%K055(:)*PCONC(:,25)*TPK%O3P(:) + PTERMS(:,26,55) = -TPK%K055(:)*PCONC(:,26)*TPK%O3P(:) ! !PTERMS(OH,K056) = -K056*<CH4>*<OH> - PTERMS(:,14,56) = -TPK%K056(:)*PCONC(:,16)*PCONC(:,14) + PTERMS(:,15,56) = -TPK%K056(:)*PCONC(:,17)*PCONC(:,15) ! !PTERMS(CH4,K056) = -K056*<CH4>*<OH> - PTERMS(:,16,56) = -TPK%K056(:)*PCONC(:,16)*PCONC(:,14) + PTERMS(:,17,56) = -TPK%K056(:)*PCONC(:,17)*PCONC(:,15) ! !PTERMS(MO2,K056) = +K056*<CH4>*<OH> - PTERMS(:,32,56) = +TPK%K056(:)*PCONC(:,16)*PCONC(:,14) + PTERMS(:,33,56) = +TPK%K056(:)*PCONC(:,17)*PCONC(:,15) ! !PTERMS(OH,K057) = -K057*<ETH>*<OH> - PTERMS(:,14,57) = -TPK%K057(:)*PCONC(:,17)*PCONC(:,14) + PTERMS(:,15,57) = -TPK%K057(:)*PCONC(:,18)*PCONC(:,15) ! !PTERMS(ETH,K057) = -K057*<ETH>*<OH> - PTERMS(:,17,57) = -TPK%K057(:)*PCONC(:,17)*PCONC(:,14) + PTERMS(:,18,57) = -TPK%K057(:)*PCONC(:,18)*PCONC(:,15) ! !PTERMS(ALKAP,K057) = +K057*<ETH>*<OH> - PTERMS(:,33,57) = +TPK%K057(:)*PCONC(:,17)*PCONC(:,14) + PTERMS(:,34,57) = +TPK%K057(:)*PCONC(:,18)*PCONC(:,15) ! !PTERMS(CO,K058) = +0.00878*K058*<ALKA>*<OH> - PTERMS(:,13,58) = +0.00878*TPK%K058(:)*PCONC(:,18)*PCONC(:,14) + PTERMS(:,14,58) = +0.00878*TPK%K058(:)*PCONC(:,19)*PCONC(:,15) ! ! RETURN @@ -30412,64 +31025,64 @@ SUBROUTINE SUBT8 !Indices 161 a 180 ! !PTERMS(OH,K058) = -K058*<ALKA>*<OH> - PTERMS(:,14,58) = -TPK%K058(:)*PCONC(:,18)*PCONC(:,14) + PTERMS(:,15,58) = -TPK%K058(:)*PCONC(:,19)*PCONC(:,15) ! !PTERMS(HO2,K058) = +0.12793*K058*<ALKA>*<OH> - PTERMS(:,15,58) = +0.12793*TPK%K058(:)*PCONC(:,18)*PCONC(:,14) + PTERMS(:,16,58) = +0.12793*TPK%K058(:)*PCONC(:,19)*PCONC(:,15) ! !PTERMS(ALKA,K058) = -K058*<ALKA>*<OH> - PTERMS(:,18,58) = -TPK%K058(:)*PCONC(:,18)*PCONC(:,14) + PTERMS(:,19,58) = -TPK%K058(:)*PCONC(:,19)*PCONC(:,15) ! !PTERMS(HCHO,K058) = +0.00140*K058*<ALKA>*<OH> - PTERMS(:,22,58) = +0.00140*TPK%K058(:)*PCONC(:,18)*PCONC(:,14) + PTERMS(:,23,58) = +0.00140*TPK%K058(:)*PCONC(:,19)*PCONC(:,15) ! !PTERMS(ALD,K058) = +0.08173*K058*<ALKA>*<OH> - PTERMS(:,23,58) = +0.08173*TPK%K058(:)*PCONC(:,18)*PCONC(:,14) + PTERMS(:,24,58) = +0.08173*TPK%K058(:)*PCONC(:,19)*PCONC(:,15) ! !PTERMS(KET,K058) = +0.03498*K058*<ALKA>*<OH> - PTERMS(:,24,58) = +0.03498*TPK%K058(:)*PCONC(:,18)*PCONC(:,14) + PTERMS(:,25,58) = +0.03498*TPK%K058(:)*PCONC(:,19)*PCONC(:,15) ! !PTERMS(CARBO,K058) = +0.00835*K058*<ALKA>*<OH> - PTERMS(:,25,58) = +0.00835*TPK%K058(:)*PCONC(:,18)*PCONC(:,14) + PTERMS(:,26,58) = +0.00835*TPK%K058(:)*PCONC(:,19)*PCONC(:,15) ! !PTERMS(ORA1,K058) = +0.00878*K058*<ALKA>*<OH> - PTERMS(:,30,58) = +0.00878*TPK%K058(:)*PCONC(:,18)*PCONC(:,14) + PTERMS(:,31,58) = +0.00878*TPK%K058(:)*PCONC(:,19)*PCONC(:,15) ! !PTERMS(ALKAP,K058) = +0.87811*K058*<ALKA>*<OH> - PTERMS(:,33,58) = +0.87811*TPK%K058(:)*PCONC(:,18)*PCONC(:,14) + PTERMS(:,34,58) = +0.87811*TPK%K058(:)*PCONC(:,19)*PCONC(:,15) ! !PTERMS(OH,K059) = -K059*<ALKE>*<OH> - PTERMS(:,14,59) = -TPK%K059(:)*PCONC(:,19)*PCONC(:,14) + PTERMS(:,15,59) = -TPK%K059(:)*PCONC(:,20)*PCONC(:,15) ! !PTERMS(ALKE,K059) = -K059*<ALKE>*<OH> - PTERMS(:,19,59) = -TPK%K059(:)*PCONC(:,19)*PCONC(:,14) + PTERMS(:,20,59) = -TPK%K059(:)*PCONC(:,20)*PCONC(:,15) ! !PTERMS(ALKEP,K059) = +1.02529*K059*<ALKE>*<OH> - PTERMS(:,34,59) = +1.02529*TPK%K059(:)*PCONC(:,19)*PCONC(:,14) + PTERMS(:,35,59) = +1.02529*TPK%K059(:)*PCONC(:,20)*PCONC(:,15) ! !PTERMS(BIOP,K059) = +0.00000*K059*<ALKE>*<OH> - PTERMS(:,35,59) = +0.00000*TPK%K059(:)*PCONC(:,19)*PCONC(:,14) + PTERMS(:,36,59) = +0.00000*TPK%K059(:)*PCONC(:,20)*PCONC(:,15) ! !PTERMS(OH,K060) = -K060*<BIO>*<OH> - PTERMS(:,14,60) = -TPK%K060(:)*PCONC(:,20)*PCONC(:,14) + PTERMS(:,15,60) = -TPK%K060(:)*PCONC(:,21)*PCONC(:,15) ! !PTERMS(BIO,K060) = -K060*<BIO>*<OH> - PTERMS(:,20,60) = -TPK%K060(:)*PCONC(:,20)*PCONC(:,14) + PTERMS(:,21,60) = -TPK%K060(:)*PCONC(:,21)*PCONC(:,15) ! !PTERMS(BIOP,K060) = +1.00000*K060*<BIO>*<OH> - PTERMS(:,35,60) = +1.00000*TPK%K060(:)*PCONC(:,20)*PCONC(:,14) + PTERMS(:,36,60) = +1.00000*TPK%K060(:)*PCONC(:,21)*PCONC(:,15) ! !PTERMS(OH,K061) = -K061*<ARO>*<OH> - PTERMS(:,14,61) = -TPK%K061(:)*PCONC(:,21)*PCONC(:,14) + PTERMS(:,15,61) = -TPK%K061(:)*PCONC(:,22)*PCONC(:,15) ! !PTERMS(HO2,K061) = +0.10318*K061*<ARO>*<OH> - PTERMS(:,15,61) = +0.10318*TPK%K061(:)*PCONC(:,21)*PCONC(:,14) + PTERMS(:,16,61) = +0.10318*TPK%K061(:)*PCONC(:,22)*PCONC(:,15) ! !PTERMS(ARO,K061) = -K061*<ARO>*<OH> - PTERMS(:,21,61) = -TPK%K061(:)*PCONC(:,21)*PCONC(:,14) + PTERMS(:,22,61) = -TPK%K061(:)*PCONC(:,22)*PCONC(:,15) ! !PTERMS(PHO,K061) = +0.00276*K061*<ARO>*<OH> - PTERMS(:,36,61) = +0.00276*TPK%K061(:)*PCONC(:,21)*PCONC(:,14) + PTERMS(:,37,61) = +0.00276*TPK%K061(:)*PCONC(:,22)*PCONC(:,15) ! ! RETURN @@ -30480,64 +31093,64 @@ SUBROUTINE SUBT9 !Indices 181 a 200 ! !PTERMS(ADD,K061) = +0.93968*K061*<ARO>*<OH> - PTERMS(:,37,61) = +0.93968*TPK%K061(:)*PCONC(:,21)*PCONC(:,14) + PTERMS(:,38,61) = +0.93968*TPK%K061(:)*PCONC(:,22)*PCONC(:,15) ! !PTERMS(XO2,K061) = +0.10318*K061*<ARO>*<OH> - PTERMS(:,41,61) = +0.10318*TPK%K061(:)*PCONC(:,21)*PCONC(:,14) + PTERMS(:,42,61) = +0.10318*TPK%K061(:)*PCONC(:,22)*PCONC(:,15) ! !PTERMS(CO,K062) = +K062*<HCHO>*<OH> - PTERMS(:,13,62) = +TPK%K062(:)*PCONC(:,22)*PCONC(:,14) + PTERMS(:,14,62) = +TPK%K062(:)*PCONC(:,23)*PCONC(:,15) ! !PTERMS(OH,K062) = -K062*<HCHO>*<OH> - PTERMS(:,14,62) = -TPK%K062(:)*PCONC(:,22)*PCONC(:,14) + PTERMS(:,15,62) = -TPK%K062(:)*PCONC(:,23)*PCONC(:,15) ! !PTERMS(HO2,K062) = +K062*<HCHO>*<OH> - PTERMS(:,15,62) = +TPK%K062(:)*PCONC(:,22)*PCONC(:,14) + PTERMS(:,16,62) = +TPK%K062(:)*PCONC(:,23)*PCONC(:,15) ! !PTERMS(HCHO,K062) = -K062*<HCHO>*<OH> - PTERMS(:,22,62) = -TPK%K062(:)*PCONC(:,22)*PCONC(:,14) + PTERMS(:,23,62) = -TPK%K062(:)*PCONC(:,23)*PCONC(:,15) ! !PTERMS(OH,K063) = -K063*<ALD>*<OH> - PTERMS(:,14,63) = -TPK%K063(:)*PCONC(:,23)*PCONC(:,14) + PTERMS(:,15,63) = -TPK%K063(:)*PCONC(:,24)*PCONC(:,15) ! !PTERMS(ALD,K063) = -K063*<ALD>*<OH> - PTERMS(:,23,63) = -TPK%K063(:)*PCONC(:,23)*PCONC(:,14) + PTERMS(:,24,63) = -TPK%K063(:)*PCONC(:,24)*PCONC(:,15) ! !PTERMS(CARBOP,K063) = +1.00000*K063*<ALD>*<OH> - PTERMS(:,39,63) = +1.00000*TPK%K063(:)*PCONC(:,23)*PCONC(:,14) + PTERMS(:,40,63) = +1.00000*TPK%K063(:)*PCONC(:,24)*PCONC(:,15) ! !PTERMS(OH,K064) = -K064*<KET>*<OH> - PTERMS(:,14,64) = -TPK%K064(:)*PCONC(:,24)*PCONC(:,14) + PTERMS(:,15,64) = -TPK%K064(:)*PCONC(:,25)*PCONC(:,15) ! !PTERMS(KET,K064) = -K064*<KET>*<OH> - PTERMS(:,24,64) = -TPK%K064(:)*PCONC(:,24)*PCONC(:,14) + PTERMS(:,25,64) = -TPK%K064(:)*PCONC(:,25)*PCONC(:,15) ! !PTERMS(CARBOP,K064) = +1.00000*K064*<KET>*<OH> - PTERMS(:,39,64) = +1.00000*TPK%K064(:)*PCONC(:,24)*PCONC(:,14) + PTERMS(:,40,64) = +1.00000*TPK%K064(:)*PCONC(:,25)*PCONC(:,15) ! !PTERMS(CO,K065) = +1.01732*K065*<CARBO>*<OH> - PTERMS(:,13,65) = +1.01732*TPK%K065(:)*PCONC(:,25)*PCONC(:,14) + PTERMS(:,14,65) = +1.01732*TPK%K065(:)*PCONC(:,26)*PCONC(:,15) ! !PTERMS(OH,K065) = -K065*<CARBO>*<OH> - PTERMS(:,14,65) = -TPK%K065(:)*PCONC(:,25)*PCONC(:,14) + PTERMS(:,15,65) = -TPK%K065(:)*PCONC(:,26)*PCONC(:,15) ! !PTERMS(HO2,K065) = +0.51208*K065*<CARBO>*<OH> - PTERMS(:,15,65) = +0.51208*TPK%K065(:)*PCONC(:,25)*PCONC(:,14) + PTERMS(:,16,65) = +0.51208*TPK%K065(:)*PCONC(:,26)*PCONC(:,15) ! !PTERMS(HCHO,K065) = +0.00000*K065*<CARBO>*<OH> - PTERMS(:,22,65) = +0.00000*TPK%K065(:)*PCONC(:,25)*PCONC(:,14) + PTERMS(:,23,65) = +0.00000*TPK%K065(:)*PCONC(:,26)*PCONC(:,15) ! !PTERMS(ALD,K065) = +0.06253*K065*<CARBO>*<OH> - PTERMS(:,23,65) = +0.06253*TPK%K065(:)*PCONC(:,25)*PCONC(:,14) + PTERMS(:,24,65) = +0.06253*TPK%K065(:)*PCONC(:,26)*PCONC(:,15) ! !PTERMS(KET,K065) = +0.00853*K065*<CARBO>*<OH> - PTERMS(:,24,65) = +0.00853*TPK%K065(:)*PCONC(:,25)*PCONC(:,14) + PTERMS(:,25,65) = +0.00853*TPK%K065(:)*PCONC(:,26)*PCONC(:,15) ! !PTERMS(CARBO,K065) = -K065*<CARBO>*<OH> - PTERMS(:,25,65) = -TPK%K065(:)*PCONC(:,25)*PCONC(:,14) + PTERMS(:,26,65) = -TPK%K065(:)*PCONC(:,26)*PCONC(:,15) ! !PTERMS(CARBOP,K065) = +0.51419*K065*<CARBO>*<OH> - PTERMS(:,39,65) = +0.51419*TPK%K065(:)*PCONC(:,25)*PCONC(:,14) + PTERMS(:,40,65) = +0.51419*TPK%K065(:)*PCONC(:,26)*PCONC(:,15) ! ! RETURN @@ -30548,64 +31161,64 @@ SUBROUTINE SUBT10 !Indices 201 a 220 ! !PTERMS(XO2,K065) = +0.10162*K065*<CARBO>*<OH> - PTERMS(:,41,65) = +0.10162*TPK%K065(:)*PCONC(:,25)*PCONC(:,14) + PTERMS(:,42,65) = +0.10162*TPK%K065(:)*PCONC(:,26)*PCONC(:,15) ! !PTERMS(OH,K066) = -K066*<ORA1>*<OH> - PTERMS(:,14,66) = -TPK%K066(:)*PCONC(:,30)*PCONC(:,14) + PTERMS(:,15,66) = -TPK%K066(:)*PCONC(:,31)*PCONC(:,15) ! !PTERMS(HO2,K066) = +K066*<ORA1>*<OH> - PTERMS(:,15,66) = +TPK%K066(:)*PCONC(:,30)*PCONC(:,14) + PTERMS(:,16,66) = +TPK%K066(:)*PCONC(:,31)*PCONC(:,15) ! !PTERMS(ORA1,K066) = -K066*<ORA1>*<OH> - PTERMS(:,30,66) = -TPK%K066(:)*PCONC(:,30)*PCONC(:,14) + PTERMS(:,31,66) = -TPK%K066(:)*PCONC(:,31)*PCONC(:,15) ! !PTERMS(OH,K067) = -K067*<ORA2>*<OH> - PTERMS(:,14,67) = -TPK%K067(:)*PCONC(:,31)*PCONC(:,14) + PTERMS(:,15,67) = -TPK%K067(:)*PCONC(:,32)*PCONC(:,15) ! !PTERMS(ORA2,K067) = -K067*<ORA2>*<OH> - PTERMS(:,31,67) = -TPK%K067(:)*PCONC(:,31)*PCONC(:,14) + PTERMS(:,32,67) = -TPK%K067(:)*PCONC(:,32)*PCONC(:,15) ! !PTERMS(OH,K068) = -K068*<OP1>*<OH> - PTERMS(:,14,68) = -TPK%K068(:)*PCONC(:,28)*PCONC(:,14) + PTERMS(:,15,68) = -TPK%K068(:)*PCONC(:,29)*PCONC(:,15) ! !PTERMS(HCHO,K068) = +0.35*K068*<OP1>*<OH> - PTERMS(:,22,68) = +0.35*TPK%K068(:)*PCONC(:,28)*PCONC(:,14) + PTERMS(:,23,68) = +0.35*TPK%K068(:)*PCONC(:,29)*PCONC(:,15) ! !PTERMS(OP1,K068) = -K068*<OP1>*<OH> - PTERMS(:,28,68) = -TPK%K068(:)*PCONC(:,28)*PCONC(:,14) + PTERMS(:,29,68) = -TPK%K068(:)*PCONC(:,29)*PCONC(:,15) ! !PTERMS(MO2,K068) = +0.65*K068*<OP1>*<OH> - PTERMS(:,32,68) = +0.65*TPK%K068(:)*PCONC(:,28)*PCONC(:,14) + PTERMS(:,33,68) = +0.65*TPK%K068(:)*PCONC(:,29)*PCONC(:,15) ! !PTERMS(OH,K069) = -K069*<OP2>*<OH> - PTERMS(:,14,69) = -TPK%K069(:)*PCONC(:,29)*PCONC(:,14) + PTERMS(:,15,69) = -TPK%K069(:)*PCONC(:,30)*PCONC(:,15) ! !PTERMS(HO2,K069) = +0.02915*K069*<OP2>*<OH> - PTERMS(:,15,69) = +0.02915*TPK%K069(:)*PCONC(:,29)*PCONC(:,14) + PTERMS(:,16,69) = +0.02915*TPK%K069(:)*PCONC(:,30)*PCONC(:,15) ! !PTERMS(HCHO,K069) = +0.02915*K069*<OP2>*<OH> - PTERMS(:,22,69) = +0.02915*TPK%K069(:)*PCONC(:,29)*PCONC(:,14) + PTERMS(:,23,69) = +0.02915*TPK%K069(:)*PCONC(:,30)*PCONC(:,15) ! !PTERMS(ALD,K069) = +0.07335*K069*<OP2>*<OH> - PTERMS(:,23,69) = +0.07335*TPK%K069(:)*PCONC(:,29)*PCONC(:,14) + PTERMS(:,24,69) = +0.07335*TPK%K069(:)*PCONC(:,30)*PCONC(:,15) ! !PTERMS(KET,K069) = +0.37591*K069*<OP2>*<OH> - PTERMS(:,24,69) = +0.37591*TPK%K069(:)*PCONC(:,29)*PCONC(:,14) + PTERMS(:,25,69) = +0.37591*TPK%K069(:)*PCONC(:,30)*PCONC(:,15) ! !PTERMS(OP2,K069) = -K069*<OP2>*<OH> - PTERMS(:,29,69) = -TPK%K069(:)*PCONC(:,29)*PCONC(:,14) + PTERMS(:,30,69) = -TPK%K069(:)*PCONC(:,30)*PCONC(:,15) ! !PTERMS(ALKAP,K069) = +0.40341*K069*<OP2>*<OH> - PTERMS(:,33,69) = +0.40341*TPK%K069(:)*PCONC(:,29)*PCONC(:,14) + PTERMS(:,34,69) = +0.40341*TPK%K069(:)*PCONC(:,30)*PCONC(:,15) ! !PTERMS(CARBOP,K069) = +0.05413*K069*<OP2>*<OH> - PTERMS(:,39,69) = +0.05413*TPK%K069(:)*PCONC(:,29)*PCONC(:,14) + PTERMS(:,40,69) = +0.05413*TPK%K069(:)*PCONC(:,30)*PCONC(:,15) ! !PTERMS(XO2,K069) = +0.09333*K069*<OP2>*<OH> - PTERMS(:,41,69) = +0.09333*TPK%K069(:)*PCONC(:,29)*PCONC(:,14) + PTERMS(:,42,69) = +0.09333*TPK%K069(:)*PCONC(:,30)*PCONC(:,15) ! !PTERMS(NO3,K070) = +0.71893*K070*<PAN>*<OH> - PTERMS(:,5,70) = +0.71893*TPK%K070(:)*PCONC(:,27)*PCONC(:,14) + PTERMS(:,5,70) = +0.71893*TPK%K070(:)*PCONC(:,28)*PCONC(:,15) ! ! RETURN @@ -30616,64 +31229,64 @@ SUBROUTINE SUBT11 !Indices 221 a 240 ! !PTERMS(OH,K070) = -K070*<PAN>*<OH> - PTERMS(:,14,70) = -TPK%K070(:)*PCONC(:,27)*PCONC(:,14) + PTERMS(:,15,70) = -TPK%K070(:)*PCONC(:,28)*PCONC(:,15) ! !PTERMS(HO2,K070) = +0.28107*K070*<PAN>*<OH> - PTERMS(:,15,70) = +0.28107*TPK%K070(:)*PCONC(:,27)*PCONC(:,14) + PTERMS(:,16,70) = +0.28107*TPK%K070(:)*PCONC(:,28)*PCONC(:,15) ! !PTERMS(HCHO,K070) = +0.57839*K070*<PAN>*<OH> - PTERMS(:,22,70) = +0.57839*TPK%K070(:)*PCONC(:,27)*PCONC(:,14) + PTERMS(:,23,70) = +0.57839*TPK%K070(:)*PCONC(:,28)*PCONC(:,15) ! !PTERMS(CARBO,K070) = +0.21863*K070*<PAN>*<OH> - PTERMS(:,25,70) = +0.21863*TPK%K070(:)*PCONC(:,27)*PCONC(:,14) + PTERMS(:,26,70) = +0.21863*TPK%K070(:)*PCONC(:,28)*PCONC(:,15) ! !PTERMS(PAN,K070) = -K070*<PAN>*<OH> - PTERMS(:,27,70) = -TPK%K070(:)*PCONC(:,27)*PCONC(:,14) + PTERMS(:,28,70) = -TPK%K070(:)*PCONC(:,28)*PCONC(:,15) ! !PTERMS(XO2,K070) = +K070*<PAN>*<OH> - PTERMS(:,41,70) = +TPK%K070(:)*PCONC(:,27)*PCONC(:,14) + PTERMS(:,42,70) = +TPK%K070(:)*PCONC(:,28)*PCONC(:,15) ! !PTERMS(NO2,K071) = +K071*<ONIT>*<OH> - PTERMS(:,4,71) = +TPK%K071(:)*PCONC(:,26)*PCONC(:,14) + PTERMS(:,4,71) = +TPK%K071(:)*PCONC(:,27)*PCONC(:,15) ! !PTERMS(OH,K071) = -K071*<ONIT>*<OH> - PTERMS(:,14,71) = -TPK%K071(:)*PCONC(:,26)*PCONC(:,14) + PTERMS(:,15,71) = -TPK%K071(:)*PCONC(:,27)*PCONC(:,15) ! !PTERMS(ONIT,K071) = -K071*<ONIT>*<OH> - PTERMS(:,26,71) = -TPK%K071(:)*PCONC(:,26)*PCONC(:,14) + PTERMS(:,27,71) = -TPK%K071(:)*PCONC(:,27)*PCONC(:,15) ! !PTERMS(ALKAP,K071) = +1.00000*K071*<ONIT>*<OH> - PTERMS(:,33,71) = +1.00000*TPK%K071(:)*PCONC(:,26)*PCONC(:,14) + PTERMS(:,34,71) = +1.00000*TPK%K071(:)*PCONC(:,27)*PCONC(:,15) ! !PTERMS(NO3,K072) = -K072*<HCHO>*<NO3> - PTERMS(:,5,72) = -TPK%K072(:)*PCONC(:,22)*PCONC(:,5) + PTERMS(:,5,72) = -TPK%K072(:)*PCONC(:,23)*PCONC(:,5) ! !PTERMS(HNO3,K072) = +K072*<HCHO>*<NO3> - PTERMS(:,8,72) = +TPK%K072(:)*PCONC(:,22)*PCONC(:,5) + PTERMS(:,8,72) = +TPK%K072(:)*PCONC(:,23)*PCONC(:,5) ! !PTERMS(CO,K072) = +K072*<HCHO>*<NO3> - PTERMS(:,13,72) = +TPK%K072(:)*PCONC(:,22)*PCONC(:,5) + PTERMS(:,14,72) = +TPK%K072(:)*PCONC(:,23)*PCONC(:,5) ! !PTERMS(HO2,K072) = +K072*<HCHO>*<NO3> - PTERMS(:,15,72) = +TPK%K072(:)*PCONC(:,22)*PCONC(:,5) + PTERMS(:,16,72) = +TPK%K072(:)*PCONC(:,23)*PCONC(:,5) ! !PTERMS(HCHO,K072) = -K072*<HCHO>*<NO3> - PTERMS(:,22,72) = -TPK%K072(:)*PCONC(:,22)*PCONC(:,5) + PTERMS(:,23,72) = -TPK%K072(:)*PCONC(:,23)*PCONC(:,5) ! !PTERMS(NO3,K073) = -K073*<ALD>*<NO3> - PTERMS(:,5,73) = -TPK%K073(:)*PCONC(:,23)*PCONC(:,5) + PTERMS(:,5,73) = -TPK%K073(:)*PCONC(:,24)*PCONC(:,5) ! !PTERMS(HNO3,K073) = +K073*<ALD>*<NO3> - PTERMS(:,8,73) = +TPK%K073(:)*PCONC(:,23)*PCONC(:,5) + PTERMS(:,8,73) = +TPK%K073(:)*PCONC(:,24)*PCONC(:,5) ! !PTERMS(ALD,K073) = -K073*<ALD>*<NO3> - PTERMS(:,23,73) = -TPK%K073(:)*PCONC(:,23)*PCONC(:,5) + PTERMS(:,24,73) = -TPK%K073(:)*PCONC(:,24)*PCONC(:,5) ! !PTERMS(CARBOP,K073) = +1.00000*K073*<ALD>*<NO3> - PTERMS(:,39,73) = +1.00000*TPK%K073(:)*PCONC(:,23)*PCONC(:,5) + PTERMS(:,40,73) = +1.00000*TPK%K073(:)*PCONC(:,24)*PCONC(:,5) ! !PTERMS(NO2,K074) = +0.10530*K074*<CARBO>*<NO3> - PTERMS(:,4,74) = +0.10530*TPK%K074(:)*PCONC(:,25)*PCONC(:,5) + PTERMS(:,4,74) = +0.10530*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) ! ! RETURN @@ -30684,64 +31297,64 @@ SUBROUTINE SUBT12 !Indices 241 a 260 ! !PTERMS(NO3,K074) = -K074*<CARBO>*<NO3> - PTERMS(:,5,74) = -TPK%K074(:)*PCONC(:,25)*PCONC(:,5) + PTERMS(:,5,74) = -TPK%K074(:)*PCONC(:,26)*PCONC(:,5) ! !PTERMS(HNO3,K074) = +0.91567*K074*<CARBO>*<NO3> - PTERMS(:,8,74) = +0.91567*TPK%K074(:)*PCONC(:,25)*PCONC(:,5) + PTERMS(:,8,74) = +0.91567*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) ! !PTERMS(CO,K074) = +1.33723*K074*<CARBO>*<NO3> - PTERMS(:,13,74) = +1.33723*TPK%K074(:)*PCONC(:,25)*PCONC(:,5) + PTERMS(:,14,74) = +1.33723*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) ! !PTERMS(HO2,K074) = +0.63217*K074*<CARBO>*<NO3> - PTERMS(:,15,74) = +0.63217*TPK%K074(:)*PCONC(:,25)*PCONC(:,5) + PTERMS(:,16,74) = +0.63217*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) ! !PTERMS(ALD,K074) = +0.05265*K074*<CARBO>*<NO3> - PTERMS(:,23,74) = +0.05265*TPK%K074(:)*PCONC(:,25)*PCONC(:,5) + PTERMS(:,24,74) = +0.05265*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) ! !PTERMS(KET,K074) = +0.00632*K074*<CARBO>*<NO3> - PTERMS(:,24,74) = +0.00632*TPK%K074(:)*PCONC(:,25)*PCONC(:,5) + PTERMS(:,25,74) = +0.00632*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) ! !PTERMS(CARBO,K074) = -K074*<CARBO>*<NO3> - PTERMS(:,25,74) = -TPK%K074(:)*PCONC(:,25)*PCONC(:,5) + PTERMS(:,26,74) = -TPK%K074(:)*PCONC(:,26)*PCONC(:,5) ! !PTERMS(CARBOP,K074) = +0.38881*K074*<CARBO>*<NO3> - PTERMS(:,39,74) = +0.38881*TPK%K074(:)*PCONC(:,25)*PCONC(:,5) + PTERMS(:,40,74) = +0.38881*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) ! !PTERMS(OLN,K074) = +0.00000*K074*<CARBO>*<NO3> - PTERMS(:,40,74) = +0.00000*TPK%K074(:)*PCONC(:,25)*PCONC(:,5) + PTERMS(:,41,74) = +0.00000*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) ! !PTERMS(XO2,K074) = +0.10530*K074*<CARBO>*<NO3> - PTERMS(:,41,74) = +0.10530*TPK%K074(:)*PCONC(:,25)*PCONC(:,5) + PTERMS(:,42,74) = +0.10530*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) ! !PTERMS(NO3,K075) = -K075*<ARO>*<NO3> - PTERMS(:,5,75) = -TPK%K075(:)*PCONC(:,21)*PCONC(:,5) + PTERMS(:,5,75) = -TPK%K075(:)*PCONC(:,22)*PCONC(:,5) ! !PTERMS(HNO3,K075) = +K075*<ARO>*<NO3> - PTERMS(:,8,75) = +TPK%K075(:)*PCONC(:,21)*PCONC(:,5) + PTERMS(:,8,75) = +TPK%K075(:)*PCONC(:,22)*PCONC(:,5) ! !PTERMS(ARO,K075) = -K075*<ARO>*<NO3> - PTERMS(:,21,75) = -TPK%K075(:)*PCONC(:,21)*PCONC(:,5) + PTERMS(:,22,75) = -TPK%K075(:)*PCONC(:,22)*PCONC(:,5) ! !PTERMS(PHO,K075) = +K075*<ARO>*<NO3> - PTERMS(:,36,75) = +TPK%K075(:)*PCONC(:,21)*PCONC(:,5) + PTERMS(:,37,75) = +TPK%K075(:)*PCONC(:,22)*PCONC(:,5) ! !PTERMS(NO3,K076) = -K076*<ALKE>*<NO3> - PTERMS(:,5,76) = -TPK%K076(:)*PCONC(:,19)*PCONC(:,5) + PTERMS(:,5,76) = -TPK%K076(:)*PCONC(:,20)*PCONC(:,5) ! !PTERMS(ALKE,K076) = -K076*<ALKE>*<NO3> - PTERMS(:,19,76) = -TPK%K076(:)*PCONC(:,19)*PCONC(:,5) + PTERMS(:,20,76) = -TPK%K076(:)*PCONC(:,20)*PCONC(:,5) ! !PTERMS(CARBO,K076) = +0.00000*K076*<ALKE>*<NO3> - PTERMS(:,25,76) = +0.00000*TPK%K076(:)*PCONC(:,19)*PCONC(:,5) + PTERMS(:,26,76) = +0.00000*TPK%K076(:)*PCONC(:,20)*PCONC(:,5) ! !PTERMS(OLN,K076) = +0.93768*K076*<ALKE>*<NO3> - PTERMS(:,40,76) = +0.93768*TPK%K076(:)*PCONC(:,19)*PCONC(:,5) + PTERMS(:,41,76) = +0.93768*TPK%K076(:)*PCONC(:,20)*PCONC(:,5) ! !PTERMS(NO3,K077) = -K077*<BIO>*<NO3> - PTERMS(:,5,77) = -TPK%K077(:)*PCONC(:,20)*PCONC(:,5) + PTERMS(:,5,77) = -TPK%K077(:)*PCONC(:,21)*PCONC(:,5) ! !PTERMS(BIO,K077) = -K077*<BIO>*<NO3> - PTERMS(:,20,77) = -TPK%K077(:)*PCONC(:,20)*PCONC(:,5) + PTERMS(:,21,77) = -TPK%K077(:)*PCONC(:,21)*PCONC(:,5) ! ! RETURN @@ -30752,64 +31365,64 @@ SUBROUTINE SUBT13 !Indices 261 a 280 ! !PTERMS(CARBO,K077) = +0.91741*K077*<BIO>*<NO3> - PTERMS(:,25,77) = +0.91741*TPK%K077(:)*PCONC(:,20)*PCONC(:,5) + PTERMS(:,26,77) = +0.91741*TPK%K077(:)*PCONC(:,21)*PCONC(:,5) ! !PTERMS(OLN,K077) = +1.00000*K077*<BIO>*<NO3> - PTERMS(:,40,77) = +1.00000*TPK%K077(:)*PCONC(:,20)*PCONC(:,5) + PTERMS(:,41,77) = +1.00000*TPK%K077(:)*PCONC(:,21)*PCONC(:,5) ! !PTERMS(NO2,K078) = +0.40*K078*<PAN>*<NO3> - PTERMS(:,4,78) = +0.40*TPK%K078(:)*PCONC(:,27)*PCONC(:,5) + PTERMS(:,4,78) = +0.40*TPK%K078(:)*PCONC(:,28)*PCONC(:,5) ! !PTERMS(NO3,K078) = -K078*<PAN>*<NO3> - PTERMS(:,5,78) = -TPK%K078(:)*PCONC(:,27)*PCONC(:,5) + PTERMS(:,5,78) = -TPK%K078(:)*PCONC(:,28)*PCONC(:,5) ! !PTERMS(HCHO,K078) = +0.40*K078*<PAN>*<NO3> - PTERMS(:,22,78) = +0.40*TPK%K078(:)*PCONC(:,27)*PCONC(:,5) + PTERMS(:,23,78) = +0.40*TPK%K078(:)*PCONC(:,28)*PCONC(:,5) ! !PTERMS(ONIT,K078) = +0.60*K078*<PAN>*<NO3> - PTERMS(:,26,78) = +0.60*TPK%K078(:)*PCONC(:,27)*PCONC(:,5) + PTERMS(:,27,78) = +0.60*TPK%K078(:)*PCONC(:,28)*PCONC(:,5) ! !PTERMS(PAN,K078) = -K078*<PAN>*<NO3> - PTERMS(:,27,78) = -TPK%K078(:)*PCONC(:,27)*PCONC(:,5) + PTERMS(:,28,78) = -TPK%K078(:)*PCONC(:,28)*PCONC(:,5) ! !PTERMS(XO2,K078) = +K078*<PAN>*<NO3> - PTERMS(:,41,78) = +TPK%K078(:)*PCONC(:,27)*PCONC(:,5) + PTERMS(:,42,78) = +TPK%K078(:)*PCONC(:,28)*PCONC(:,5) ! !PTERMS(O3,K079) = -K079*<ALKE>*<O3> - PTERMS(:,1,79) = -TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,1,79) = -TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(H2O2,K079) = +0.01833*K079*<ALKE>*<O3> - PTERMS(:,2,79) = +0.01833*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,2,79) = +0.01833*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(CO,K079) = +0.35120*K079*<ALKE>*<O3> - PTERMS(:,13,79) = +0.35120*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,14,79) = +0.35120*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(OH,K079) = +0.39435*K079*<ALKE>*<O3> - PTERMS(:,14,79) = +0.39435*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,15,79) = +0.39435*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(HO2,K079) = +0.23451*K079*<ALKE>*<O3> - PTERMS(:,15,79) = +0.23451*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,16,79) = +0.23451*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(CH4,K079) = +0.04300*K079*<ALKE>*<O3> - PTERMS(:,16,79) = +0.04300*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,17,79) = +0.04300*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(ETH,K079) = +0.03196*K079*<ALKE>*<O3> - PTERMS(:,17,79) = +0.03196*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,18,79) = +0.03196*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(ALKE,K079) = -K079*<ALKE>*<O3> - PTERMS(:,19,79) = -TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,20,79) = -TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(HCHO,K079) = +0.48290*K079*<ALKE>*<O3> - PTERMS(:,22,79) = +0.48290*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,23,79) = +0.48290*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(ALD,K079) = +0.51468*K079*<ALKE>*<O3> - PTERMS(:,23,79) = +0.51468*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,24,79) = +0.51468*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(KET,K079) = +0.07377*K079*<ALKE>*<O3> - PTERMS(:,24,79) = +0.07377*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,25,79) = +0.07377*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(CARBO,K079) = +0.00000*K079*<ALKE>*<O3> - PTERMS(:,25,79) = +0.00000*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,26,79) = +0.00000*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! ! RETURN @@ -30820,64 +31433,64 @@ SUBROUTINE SUBT14 !Indices 281 a 300 ! !PTERMS(ORA1,K079) = +0.15343*K079*<ALKE>*<O3> - PTERMS(:,30,79) = +0.15343*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,31,79) = +0.15343*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(ORA2,K079) = +0.08143*K079*<ALKE>*<O3> - PTERMS(:,31,79) = +0.08143*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,32,79) = +0.08143*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(MO2,K079) = +0.13966*K079*<ALKE>*<O3> - PTERMS(:,32,79) = +0.13966*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,33,79) = +0.13966*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(ALKAP,K079) = +0.09815*K079*<ALKE>*<O3> - PTERMS(:,33,79) = +0.09815*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,34,79) = +0.09815*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(CARBOP,K079) = +0.05705*K079*<ALKE>*<O3> - PTERMS(:,39,79) = +0.05705*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,40,79) = +0.05705*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(XO2,K079) = +0.00000*K079*<ALKE>*<O3> - PTERMS(:,41,79) = +0.00000*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,42,79) = +0.00000*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(O3,K080) = -K080*<BIO>*<O3> - PTERMS(:,1,80) = -TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,1,80) = -TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! !PTERMS(H2O2,K080) = +0.00100*K080*<BIO>*<O3> - PTERMS(:,2,80) = +0.00100*TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,2,80) = +0.00100*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! !PTERMS(CO,K080) = +0.36000*K080*<BIO>*<O3> - PTERMS(:,13,80) = +0.36000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,14,80) = +0.36000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! !PTERMS(OH,K080) = +0.28000*K080*<BIO>*<O3> - PTERMS(:,14,80) = +0.28000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,15,80) = +0.28000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! !PTERMS(HO2,K080) = +0.30000*K080*<BIO>*<O3> - PTERMS(:,15,80) = +0.30000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,16,80) = +0.30000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! !PTERMS(ALKE,K080) = +0.37388*K080*<BIO>*<O3> - PTERMS(:,19,80) = +0.37388*TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,20,80) = +0.37388*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! !PTERMS(BIO,K080) = -K080*<BIO>*<O3> - PTERMS(:,20,80) = -TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,21,80) = -TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! !PTERMS(HCHO,K080) = +0.90000*K080*<BIO>*<O3> - PTERMS(:,22,80) = +0.90000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,23,80) = +0.90000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! !PTERMS(ALD,K080) = +0.00000*K080*<BIO>*<O3> - PTERMS(:,23,80) = +0.00000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,24,80) = +0.00000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! !PTERMS(KET,K080) = +0.00000*K080*<BIO>*<O3> - PTERMS(:,24,80) = +0.00000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,25,80) = +0.00000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! !PTERMS(CARBO,K080) = +0.39754*K080*<BIO>*<O3> - PTERMS(:,25,80) = +0.39754*TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,26,80) = +0.39754*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! !PTERMS(ORA1,K080) = +0.15000*K080*<BIO>*<O3> - PTERMS(:,30,80) = +0.15000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,31,80) = +0.15000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! !PTERMS(ORA2,K080) = +0.00000*K080*<BIO>*<O3> - PTERMS(:,31,80) = +0.00000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,32,80) = +0.00000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! !PTERMS(MO2,K080) = +0.03000*K080*<BIO>*<O3> - PTERMS(:,32,80) = +0.03000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,33,80) = +0.03000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! ! RETURN @@ -30888,64 +31501,64 @@ SUBROUTINE SUBT15 !Indices 301 a 320 ! !PTERMS(ALKAP,K080) = +0.00000*K080*<BIO>*<O3> - PTERMS(:,33,80) = +0.00000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,34,80) = +0.00000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! !PTERMS(CARBOP,K080) = +0.17000*K080*<BIO>*<O3> - PTERMS(:,39,80) = +0.17000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,40,80) = +0.17000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! !PTERMS(XO2,K080) = +0.13000*K080*<BIO>*<O3> - PTERMS(:,41,80) = +0.13000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,42,80) = +0.13000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! !PTERMS(O3,K081) = -K081*<CARBO>*<O3> - PTERMS(:,1,81) = -TPK%K081(:)*PCONC(:,25)*PCONC(:,1) + PTERMS(:,1,81) = -TPK%K081(:)*PCONC(:,26)*PCONC(:,1) ! !PTERMS(CO,K081) = +0.64728*K081*<CARBO>*<O3> - PTERMS(:,13,81) = +0.64728*TPK%K081(:)*PCONC(:,25)*PCONC(:,1) + PTERMS(:,14,81) = +0.64728*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) ! !PTERMS(OH,K081) = +0.20595*K081*<CARBO>*<O3> - PTERMS(:,14,81) = +0.20595*TPK%K081(:)*PCONC(:,25)*PCONC(:,1) + PTERMS(:,15,81) = +0.20595*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) ! !PTERMS(HO2,K081) = +0.28441*K081*<CARBO>*<O3> - PTERMS(:,15,81) = +0.28441*TPK%K081(:)*PCONC(:,25)*PCONC(:,1) + PTERMS(:,16,81) = +0.28441*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) ! !PTERMS(HCHO,K081) = +0.00000*K081*<CARBO>*<O3> - PTERMS(:,22,81) = +0.00000*TPK%K081(:)*PCONC(:,25)*PCONC(:,1) + PTERMS(:,23,81) = +0.00000*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) ! !PTERMS(ALD,K081) = +0.15692*K081*<CARBO>*<O3> - PTERMS(:,23,81) = +0.15692*TPK%K081(:)*PCONC(:,25)*PCONC(:,1) + PTERMS(:,24,81) = +0.15692*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) ! !PTERMS(CARBO,K081) = -K081*<CARBO>*<O3> - PTERMS(:,25,81) = -TPK%K081(:)*PCONC(:,25)*PCONC(:,1) + PTERMS(:,26,81) = -TPK%K081(:)*PCONC(:,26)*PCONC(:,1) ! !PTERMS(OP2,K081) = +0.10149*K081*<CARBO>*<O3> - PTERMS(:,29,81) = +0.10149*TPK%K081(:)*PCONC(:,25)*PCONC(:,1) + PTERMS(:,30,81) = +0.10149*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) ! !PTERMS(ORA1,K081) = +0.10788*K081*<CARBO>*<O3> - PTERMS(:,30,81) = +0.10788*TPK%K081(:)*PCONC(:,25)*PCONC(:,1) + PTERMS(:,31,81) = +0.10788*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) ! !PTERMS(ORA2,K081) = +0.20595*K081*<CARBO>*<O3> - PTERMS(:,31,81) = +0.20595*TPK%K081(:)*PCONC(:,25)*PCONC(:,1) + PTERMS(:,32,81) = +0.20595*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) ! !PTERMS(CARBOP,K081) = +0.27460*K081*<CARBO>*<O3> - PTERMS(:,39,81) = +0.27460*TPK%K081(:)*PCONC(:,25)*PCONC(:,1) + PTERMS(:,40,81) = +0.27460*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) ! !PTERMS(O3,K082) = -K082*<PAN>*<O3> - PTERMS(:,1,82) = -TPK%K082(:)*PCONC(:,27)*PCONC(:,1) + PTERMS(:,1,82) = -TPK%K082(:)*PCONC(:,28)*PCONC(:,1) ! !PTERMS(NO2,K082) = +0.70*K082*<PAN>*<O3> - PTERMS(:,4,82) = +0.70*TPK%K082(:)*PCONC(:,27)*PCONC(:,1) + PTERMS(:,4,82) = +0.70*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) ! !PTERMS(CO,K082) = +0.13*K082*<PAN>*<O3> - PTERMS(:,13,82) = +0.13*TPK%K082(:)*PCONC(:,27)*PCONC(:,1) + PTERMS(:,14,82) = +0.13*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) ! !PTERMS(OH,K082) = +0.036*K082*<PAN>*<O3> - PTERMS(:,14,82) = +0.036*TPK%K082(:)*PCONC(:,27)*PCONC(:,1) + PTERMS(:,15,82) = +0.036*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) ! !PTERMS(HO2,K082) = +0.08*K082*<PAN>*<O3> - PTERMS(:,15,82) = +0.08*TPK%K082(:)*PCONC(:,27)*PCONC(:,1) + PTERMS(:,16,82) = +0.08*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) ! !PTERMS(HCHO,K082) = +0.70*K082*<PAN>*<O3> - PTERMS(:,22,82) = +0.70*TPK%K082(:)*PCONC(:,27)*PCONC(:,1) + PTERMS(:,23,82) = +0.70*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) ! ! RETURN @@ -30956,64 +31569,64 @@ SUBROUTINE SUBT16 !Indices 321 a 340 ! !PTERMS(PAN,K082) = -K082*<PAN>*<O3> - PTERMS(:,27,82) = -TPK%K082(:)*PCONC(:,27)*PCONC(:,1) + PTERMS(:,28,82) = -TPK%K082(:)*PCONC(:,28)*PCONC(:,1) ! !PTERMS(ORA1,K082) = +0.11*K082*<PAN>*<O3> - PTERMS(:,30,82) = +0.11*TPK%K082(:)*PCONC(:,27)*PCONC(:,1) + PTERMS(:,31,82) = +0.11*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) ! !PTERMS(CARBOP,K082) = +0.70000*K082*<PAN>*<O3> - PTERMS(:,39,82) = +0.70000*TPK%K082(:)*PCONC(:,27)*PCONC(:,1) + PTERMS(:,40,82) = +0.70000*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) ! !PTERMS(NO2,K083) = -K083*<PHO>*<NO2> - PTERMS(:,4,83) = -TPK%K083(:)*PCONC(:,36)*PCONC(:,4) + PTERMS(:,4,83) = -TPK%K083(:)*PCONC(:,37)*PCONC(:,4) ! !PTERMS(ARO,K083) = +0.10670*K083*<PHO>*<NO2> - PTERMS(:,21,83) = +0.10670*TPK%K083(:)*PCONC(:,36)*PCONC(:,4) + PTERMS(:,22,83) = +0.10670*TPK%K083(:)*PCONC(:,37)*PCONC(:,4) ! !PTERMS(ONIT,K083) = +K083*<PHO>*<NO2> - PTERMS(:,26,83) = +TPK%K083(:)*PCONC(:,36)*PCONC(:,4) + PTERMS(:,27,83) = +TPK%K083(:)*PCONC(:,37)*PCONC(:,4) ! !PTERMS(PHO,K083) = -K083*<PHO>*<NO2> - PTERMS(:,36,83) = -TPK%K083(:)*PCONC(:,36)*PCONC(:,4) + PTERMS(:,37,83) = -TPK%K083(:)*PCONC(:,37)*PCONC(:,4) ! !PTERMS(HO2,K084) = -K084*<PHO>*<HO2> - PTERMS(:,15,84) = -TPK%K084(:)*PCONC(:,36)*PCONC(:,15) + PTERMS(:,16,84) = -TPK%K084(:)*PCONC(:,37)*PCONC(:,16) ! !PTERMS(ARO,K084) = +1.06698*K084*<PHO>*<HO2> - PTERMS(:,21,84) = +1.06698*TPK%K084(:)*PCONC(:,36)*PCONC(:,15) + PTERMS(:,22,84) = +1.06698*TPK%K084(:)*PCONC(:,37)*PCONC(:,16) ! !PTERMS(PHO,K084) = -K084*<PHO>*<HO2> - PTERMS(:,36,84) = -TPK%K084(:)*PCONC(:,36)*PCONC(:,15) + PTERMS(:,37,84) = -TPK%K084(:)*PCONC(:,37)*PCONC(:,16) ! !PTERMS(NO2,K085) = -K085*<ADD>*<NO2> - PTERMS(:,4,85) = -TPK%K085(:)*PCONC(:,37)*PCONC(:,4) + PTERMS(:,4,85) = -TPK%K085(:)*PCONC(:,38)*PCONC(:,4) ! !PTERMS(HONO,K085) = +K085*<ADD>*<NO2> - PTERMS(:,7,85) = +TPK%K085(:)*PCONC(:,37)*PCONC(:,4) + PTERMS(:,7,85) = +TPK%K085(:)*PCONC(:,38)*PCONC(:,4) ! !PTERMS(ARO,K085) = +K085*<ADD>*<NO2> - PTERMS(:,21,85) = +TPK%K085(:)*PCONC(:,37)*PCONC(:,4) + PTERMS(:,22,85) = +TPK%K085(:)*PCONC(:,38)*PCONC(:,4) ! !PTERMS(ADD,K085) = -K085*<ADD>*<NO2> - PTERMS(:,37,85) = -TPK%K085(:)*PCONC(:,37)*PCONC(:,4) + PTERMS(:,38,85) = -TPK%K085(:)*PCONC(:,38)*PCONC(:,4) ! !PTERMS(HO2,K086) = +0.02*K086*<ADD>*<O2> - PTERMS(:,15,86) = +0.02*TPK%K086(:)*PCONC(:,37)*TPK%O2(:) + PTERMS(:,16,86) = +0.02*TPK%K086(:)*PCONC(:,38)*TPK%O2(:) ! !PTERMS(ARO,K086) = +0.02*K086*<ADD>*<O2> - PTERMS(:,21,86) = +0.02*TPK%K086(:)*PCONC(:,37)*TPK%O2(:) + PTERMS(:,22,86) = +0.02*TPK%K086(:)*PCONC(:,38)*TPK%O2(:) ! !PTERMS(ADD,K086) = -K086*<ADD>*<O2> - PTERMS(:,37,86) = -TPK%K086(:)*PCONC(:,37)*TPK%O2(:) + PTERMS(:,38,86) = -TPK%K086(:)*PCONC(:,38)*TPK%O2(:) ! !PTERMS(AROP,K086) = +0.98*K086*<ADD>*<O2> - PTERMS(:,38,86) = +0.98*TPK%K086(:)*PCONC(:,37)*TPK%O2(:) + PTERMS(:,39,86) = +0.98*TPK%K086(:)*PCONC(:,38)*TPK%O2(:) ! !PTERMS(O3,K087) = -K087*<ADD>*<O3> - PTERMS(:,1,87) = -TPK%K087(:)*PCONC(:,37)*PCONC(:,1) + PTERMS(:,1,87) = -TPK%K087(:)*PCONC(:,38)*PCONC(:,1) ! !PTERMS(OH,K087) = +K087*<ADD>*<O3> - PTERMS(:,14,87) = +TPK%K087(:)*PCONC(:,37)*PCONC(:,1) + PTERMS(:,15,87) = +TPK%K087(:)*PCONC(:,38)*PCONC(:,1) ! ! RETURN @@ -31024,64 +31637,64 @@ SUBROUTINE SUBT17 !Indices 341 a 360 ! !PTERMS(ARO,K087) = +K087*<ADD>*<O3> - PTERMS(:,21,87) = +TPK%K087(:)*PCONC(:,37)*PCONC(:,1) + PTERMS(:,22,87) = +TPK%K087(:)*PCONC(:,38)*PCONC(:,1) ! !PTERMS(ADD,K087) = -K087*<ADD>*<O3> - PTERMS(:,37,87) = -TPK%K087(:)*PCONC(:,37)*PCONC(:,1) + PTERMS(:,38,87) = -TPK%K087(:)*PCONC(:,38)*PCONC(:,1) ! !PTERMS(NO2,K088) = -K088*<CARBOP>*<NO2> - PTERMS(:,4,88) = -TPK%K088(:)*PCONC(:,39)*PCONC(:,4) + PTERMS(:,4,88) = -TPK%K088(:)*PCONC(:,40)*PCONC(:,4) ! !PTERMS(PAN,K088) = +1.00000*K088*<CARBOP>*<NO2> - PTERMS(:,27,88) = +1.00000*TPK%K088(:)*PCONC(:,39)*PCONC(:,4) + PTERMS(:,28,88) = +1.00000*TPK%K088(:)*PCONC(:,40)*PCONC(:,4) ! !PTERMS(CARBOP,K088) = -K088*<CARBOP>*<NO2> - PTERMS(:,39,88) = -TPK%K088(:)*PCONC(:,39)*PCONC(:,4) + PTERMS(:,40,88) = -TPK%K088(:)*PCONC(:,40)*PCONC(:,4) ! !PTERMS(NO2,K089) = +K089*<PAN> - PTERMS(:,4,89) = +TPK%K089(:)*PCONC(:,27) + PTERMS(:,4,89) = +TPK%K089(:)*PCONC(:,28) ! !PTERMS(PAN,K089) = -K089*<PAN> - PTERMS(:,27,89) = -TPK%K089(:)*PCONC(:,27) + PTERMS(:,28,89) = -TPK%K089(:)*PCONC(:,28) ! !PTERMS(CARBOP,K089) = +1.00000*K089*<PAN> - PTERMS(:,39,89) = +1.00000*TPK%K089(:)*PCONC(:,27) + PTERMS(:,40,89) = +1.00000*TPK%K089(:)*PCONC(:,28) ! !PTERMS(NO,K090) = -K090*<MO2>*<NO> - PTERMS(:,3,90) = -TPK%K090(:)*PCONC(:,32)*PCONC(:,3) + PTERMS(:,3,90) = -TPK%K090(:)*PCONC(:,33)*PCONC(:,3) ! !PTERMS(NO2,K090) = +K090*<MO2>*<NO> - PTERMS(:,4,90) = +TPK%K090(:)*PCONC(:,32)*PCONC(:,3) + PTERMS(:,4,90) = +TPK%K090(:)*PCONC(:,33)*PCONC(:,3) ! !PTERMS(HO2,K090) = +K090*<MO2>*<NO> - PTERMS(:,15,90) = +TPK%K090(:)*PCONC(:,32)*PCONC(:,3) + PTERMS(:,16,90) = +TPK%K090(:)*PCONC(:,33)*PCONC(:,3) ! !PTERMS(HCHO,K090) = +K090*<MO2>*<NO> - PTERMS(:,22,90) = +TPK%K090(:)*PCONC(:,32)*PCONC(:,3) + PTERMS(:,23,90) = +TPK%K090(:)*PCONC(:,33)*PCONC(:,3) ! !PTERMS(MO2,K090) = -K090*<MO2>*<NO> - PTERMS(:,32,90) = -TPK%K090(:)*PCONC(:,32)*PCONC(:,3) + PTERMS(:,33,90) = -TPK%K090(:)*PCONC(:,33)*PCONC(:,3) ! !PTERMS(NO,K091) = -K091*<ALKAP>*<NO> - PTERMS(:,3,91) = -TPK%K091(:)*PCONC(:,33)*PCONC(:,3) + PTERMS(:,3,91) = -TPK%K091(:)*PCONC(:,34)*PCONC(:,3) ! !PTERMS(NO2,K091) = +0.91541*K091*<ALKAP>*<NO> - PTERMS(:,4,91) = +0.91541*TPK%K091(:)*PCONC(:,33)*PCONC(:,3) + PTERMS(:,4,91) = +0.91541*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) ! !PTERMS(HO2,K091) = +0.74265*K091*<ALKAP>*<NO> - PTERMS(:,15,91) = +0.74265*TPK%K091(:)*PCONC(:,33)*PCONC(:,3) + PTERMS(:,16,91) = +0.74265*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) ! !PTERMS(HCHO,K091) = +0.03002*K091*<ALKAP>*<NO> - PTERMS(:,22,91) = +0.03002*TPK%K091(:)*PCONC(:,33)*PCONC(:,3) + PTERMS(:,23,91) = +0.03002*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) ! !PTERMS(ALD,K091) = +0.33144*K091*<ALKAP>*<NO> - PTERMS(:,23,91) = +0.33144*TPK%K091(:)*PCONC(:,33)*PCONC(:,3) + PTERMS(:,24,91) = +0.33144*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) ! !PTERMS(KET,K091) = +0.54531*K091*<ALKAP>*<NO> - PTERMS(:,24,91) = +0.54531*TPK%K091(:)*PCONC(:,33)*PCONC(:,3) + PTERMS(:,25,91) = +0.54531*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) ! !PTERMS(CARBO,K091) = +0.03407*K091*<ALKAP>*<NO> - PTERMS(:,25,91) = +0.03407*TPK%K091(:)*PCONC(:,33)*PCONC(:,3) + PTERMS(:,26,91) = +0.03407*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) ! ! RETURN @@ -31092,64 +31705,64 @@ SUBROUTINE SUBT18 !Indices 361 a 380 ! !PTERMS(ONIT,K091) = +0.08459*K091*<ALKAP>*<NO> - PTERMS(:,26,91) = +0.08459*TPK%K091(:)*PCONC(:,33)*PCONC(:,3) + PTERMS(:,27,91) = +0.08459*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) ! !PTERMS(MO2,K091) = +0.09016*K091*<ALKAP>*<NO> - PTERMS(:,32,91) = +0.09016*TPK%K091(:)*PCONC(:,33)*PCONC(:,3) + PTERMS(:,33,91) = +0.09016*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) ! !PTERMS(ALKAP,K091) = -K091*<ALKAP>*<NO> - PTERMS(:,33,91) = -TPK%K091(:)*PCONC(:,33)*PCONC(:,3) + PTERMS(:,34,91) = -TPK%K091(:)*PCONC(:,34)*PCONC(:,3) ! !PTERMS(XO2,K091) = +0.13007*K091*<ALKAP>*<NO> - PTERMS(:,41,91) = +0.13007*TPK%K091(:)*PCONC(:,33)*PCONC(:,3) + PTERMS(:,42,91) = +0.13007*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) ! !PTERMS(NO,K092) = -K092*<ALKEP>*<NO> - PTERMS(:,3,92) = -TPK%K092(:)*PCONC(:,34)*PCONC(:,3) + PTERMS(:,3,92) = -TPK%K092(:)*PCONC(:,35)*PCONC(:,3) ! !PTERMS(NO2,K092) = +K092*<ALKEP>*<NO> - PTERMS(:,4,92) = +TPK%K092(:)*PCONC(:,34)*PCONC(:,3) + PTERMS(:,4,92) = +TPK%K092(:)*PCONC(:,35)*PCONC(:,3) ! !PTERMS(HO2,K092) = +K092*<ALKEP>*<NO> - PTERMS(:,15,92) = +TPK%K092(:)*PCONC(:,34)*PCONC(:,3) + PTERMS(:,16,92) = +TPK%K092(:)*PCONC(:,35)*PCONC(:,3) ! !PTERMS(HCHO,K092) = +1.39870*K092*<ALKEP>*<NO> - PTERMS(:,22,92) = +1.39870*TPK%K092(:)*PCONC(:,34)*PCONC(:,3) + PTERMS(:,23,92) = +1.39870*TPK%K092(:)*PCONC(:,35)*PCONC(:,3) ! !PTERMS(ALD,K092) = +0.42125*K092*<ALKEP>*<NO> - PTERMS(:,23,92) = +0.42125*TPK%K092(:)*PCONC(:,34)*PCONC(:,3) + PTERMS(:,24,92) = +0.42125*TPK%K092(:)*PCONC(:,35)*PCONC(:,3) ! !PTERMS(KET,K092) = +0.05220*K092*<ALKEP>*<NO> - PTERMS(:,24,92) = +0.05220*TPK%K092(:)*PCONC(:,34)*PCONC(:,3) + PTERMS(:,25,92) = +0.05220*TPK%K092(:)*PCONC(:,35)*PCONC(:,3) ! !PTERMS(ALKEP,K092) = -K092*<ALKEP>*<NO> - PTERMS(:,34,92) = -TPK%K092(:)*PCONC(:,34)*PCONC(:,3) + PTERMS(:,35,92) = -TPK%K092(:)*PCONC(:,35)*PCONC(:,3) ! !PTERMS(NO,K093) = -K093*<BIOP>*<NO> - PTERMS(:,3,93) = -TPK%K093(:)*PCONC(:,35)*PCONC(:,3) + PTERMS(:,3,93) = -TPK%K093(:)*PCONC(:,36)*PCONC(:,3) ! !PTERMS(NO2,K093) = +0.84700*K093*<BIOP>*<NO> - PTERMS(:,4,93) = +0.84700*TPK%K093(:)*PCONC(:,35)*PCONC(:,3) + PTERMS(:,4,93) = +0.84700*TPK%K093(:)*PCONC(:,36)*PCONC(:,3) ! !PTERMS(HO2,K093) = +0.84700*K093*<BIOP>*<NO> - PTERMS(:,15,93) = +0.84700*TPK%K093(:)*PCONC(:,35)*PCONC(:,3) + PTERMS(:,16,93) = +0.84700*TPK%K093(:)*PCONC(:,36)*PCONC(:,3) ! !PTERMS(ALKE,K093) = +0.37815*K093*<BIOP>*<NO> - PTERMS(:,19,93) = +0.37815*TPK%K093(:)*PCONC(:,35)*PCONC(:,3) + PTERMS(:,20,93) = +0.37815*TPK%K093(:)*PCONC(:,36)*PCONC(:,3) ! !PTERMS(HCHO,K093) = +0.60600*K093*<BIOP>*<NO> - PTERMS(:,22,93) = +0.60600*TPK%K093(:)*PCONC(:,35)*PCONC(:,3) + PTERMS(:,23,93) = +0.60600*TPK%K093(:)*PCONC(:,36)*PCONC(:,3) ! !PTERMS(ALD,K093) = +0.00000*K093*<BIOP>*<NO> - PTERMS(:,23,93) = +0.00000*TPK%K093(:)*PCONC(:,35)*PCONC(:,3) + PTERMS(:,24,93) = +0.00000*TPK%K093(:)*PCONC(:,36)*PCONC(:,3) ! !PTERMS(KET,K093) = +0.00000*K093*<BIOP>*<NO> - PTERMS(:,24,93) = +0.00000*TPK%K093(:)*PCONC(:,35)*PCONC(:,3) + PTERMS(:,25,93) = +0.00000*TPK%K093(:)*PCONC(:,36)*PCONC(:,3) ! !PTERMS(CARBO,K093) = +0.45463*K093*<BIOP>*<NO> - PTERMS(:,25,93) = +0.45463*TPK%K093(:)*PCONC(:,35)*PCONC(:,3) + PTERMS(:,26,93) = +0.45463*TPK%K093(:)*PCONC(:,36)*PCONC(:,3) ! !PTERMS(ONIT,K093) = +0.15300*K093*<BIOP>*<NO> - PTERMS(:,26,93) = +0.15300*TPK%K093(:)*PCONC(:,35)*PCONC(:,3) + PTERMS(:,27,93) = +0.15300*TPK%K093(:)*PCONC(:,36)*PCONC(:,3) ! ! RETURN @@ -31160,64 +31773,64 @@ SUBROUTINE SUBT19 !Indices 381 a 400 ! !PTERMS(BIOP,K093) = -K093*<BIOP>*<NO> - PTERMS(:,35,93) = -TPK%K093(:)*PCONC(:,35)*PCONC(:,3) + PTERMS(:,36,93) = -TPK%K093(:)*PCONC(:,36)*PCONC(:,3) ! !PTERMS(NO,K094) = -K094*<AROP>*<NO> - PTERMS(:,3,94) = -TPK%K094(:)*PCONC(:,38)*PCONC(:,3) + PTERMS(:,3,94) = -TPK%K094(:)*PCONC(:,39)*PCONC(:,3) ! !PTERMS(NO2,K094) = +0.95115*K094*<AROP>*<NO> - PTERMS(:,4,94) = +0.95115*TPK%K094(:)*PCONC(:,38)*PCONC(:,3) + PTERMS(:,4,94) = +0.95115*TPK%K094(:)*PCONC(:,39)*PCONC(:,3) ! !PTERMS(HO2,K094) = +0.95115*K094*<AROP>*<NO> - PTERMS(:,15,94) = +0.95115*TPK%K094(:)*PCONC(:,38)*PCONC(:,3) + PTERMS(:,16,94) = +0.95115*TPK%K094(:)*PCONC(:,39)*PCONC(:,3) ! !PTERMS(CARBO,K094) = +2.06993*K094*<AROP>*<NO> - PTERMS(:,25,94) = +2.06993*TPK%K094(:)*PCONC(:,38)*PCONC(:,3) + PTERMS(:,26,94) = +2.06993*TPK%K094(:)*PCONC(:,39)*PCONC(:,3) ! !PTERMS(ONIT,K094) = +0.04885*K094*<AROP>*<NO> - PTERMS(:,26,94) = +0.04885*TPK%K094(:)*PCONC(:,38)*PCONC(:,3) + PTERMS(:,27,94) = +0.04885*TPK%K094(:)*PCONC(:,39)*PCONC(:,3) ! !PTERMS(AROP,K094) = -K094*<AROP>*<NO> - PTERMS(:,38,94) = -TPK%K094(:)*PCONC(:,38)*PCONC(:,3) + PTERMS(:,39,94) = -TPK%K094(:)*PCONC(:,39)*PCONC(:,3) ! !PTERMS(NO,K095) = -K095*<CARBOP>*<NO> - PTERMS(:,3,95) = -TPK%K095(:)*PCONC(:,39)*PCONC(:,3) + PTERMS(:,3,95) = -TPK%K095(:)*PCONC(:,40)*PCONC(:,3) ! !PTERMS(NO2,K095) = +K095*<CARBOP>*<NO> - PTERMS(:,4,95) = +TPK%K095(:)*PCONC(:,39)*PCONC(:,3) + PTERMS(:,4,95) = +TPK%K095(:)*PCONC(:,40)*PCONC(:,3) ! !PTERMS(HO2,K095) = +0.12334*K095*<CARBOP>*<NO> - PTERMS(:,15,95) = +0.12334*TPK%K095(:)*PCONC(:,39)*PCONC(:,3) + PTERMS(:,16,95) = +0.12334*TPK%K095(:)*PCONC(:,40)*PCONC(:,3) ! !PTERMS(HCHO,K095) = +0.05848*K095*<CARBOP>*<NO> - PTERMS(:,22,95) = +0.05848*TPK%K095(:)*PCONC(:,39)*PCONC(:,3) + PTERMS(:,23,95) = +0.05848*TPK%K095(:)*PCONC(:,40)*PCONC(:,3) ! !PTERMS(ALD,K095) = +0.07368*K095*<CARBOP>*<NO> - PTERMS(:,23,95) = +0.07368*TPK%K095(:)*PCONC(:,39)*PCONC(:,3) + PTERMS(:,24,95) = +0.07368*TPK%K095(:)*PCONC(:,40)*PCONC(:,3) ! !PTERMS(CARBO,K095) = +0.08670*K095*<CARBOP>*<NO> - PTERMS(:,25,95) = +0.08670*TPK%K095(:)*PCONC(:,39)*PCONC(:,3) + PTERMS(:,26,95) = +0.08670*TPK%K095(:)*PCONC(:,40)*PCONC(:,3) ! !PTERMS(MO2,K095) = +0.78134*K095*<CARBOP>*<NO> - PTERMS(:,32,95) = +0.78134*TPK%K095(:)*PCONC(:,39)*PCONC(:,3) + PTERMS(:,33,95) = +0.78134*TPK%K095(:)*PCONC(:,40)*PCONC(:,3) ! !PTERMS(CARBOP,K095) = -K095*<CARBOP>*<NO> - PTERMS(:,39,95) = -TPK%K095(:)*PCONC(:,39)*PCONC(:,3) + PTERMS(:,40,95) = -TPK%K095(:)*PCONC(:,40)*PCONC(:,3) ! !PTERMS(XO2,K095) = +0.02563*K095*<CARBOP>*<NO> - PTERMS(:,41,95) = +0.02563*TPK%K095(:)*PCONC(:,39)*PCONC(:,3) + PTERMS(:,42,95) = +0.02563*TPK%K095(:)*PCONC(:,40)*PCONC(:,3) ! !PTERMS(NO,K096) = -K096*<OLN>*<NO> - PTERMS(:,3,96) = -TPK%K096(:)*PCONC(:,40)*PCONC(:,3) + PTERMS(:,3,96) = -TPK%K096(:)*PCONC(:,41)*PCONC(:,3) ! !PTERMS(NO2,K096) = +1.81599*K096*<OLN>*<NO> - PTERMS(:,4,96) = +1.81599*TPK%K096(:)*PCONC(:,40)*PCONC(:,3) + PTERMS(:,4,96) = +1.81599*TPK%K096(:)*PCONC(:,41)*PCONC(:,3) ! !PTERMS(HO2,K096) = +0.18401*K096*<OLN>*<NO> - PTERMS(:,15,96) = +0.18401*TPK%K096(:)*PCONC(:,40)*PCONC(:,3) + PTERMS(:,16,96) = +0.18401*TPK%K096(:)*PCONC(:,41)*PCONC(:,3) ! !PTERMS(HCHO,K096) = +0.23419*K096*<OLN>*<NO> - PTERMS(:,22,96) = +0.23419*TPK%K096(:)*PCONC(:,40)*PCONC(:,3) + PTERMS(:,23,96) = +0.23419*TPK%K096(:)*PCONC(:,41)*PCONC(:,3) ! ! RETURN @@ -31228,64 +31841,64 @@ SUBROUTINE SUBT20 !Indices 401 a 420 ! !PTERMS(ALD,K096) = +1.01182*K096*<OLN>*<NO> - PTERMS(:,23,96) = +1.01182*TPK%K096(:)*PCONC(:,40)*PCONC(:,3) + PTERMS(:,24,96) = +1.01182*TPK%K096(:)*PCONC(:,41)*PCONC(:,3) ! !PTERMS(KET,K096) = +0.37862*K096*<OLN>*<NO> - PTERMS(:,24,96) = +0.37862*TPK%K096(:)*PCONC(:,40)*PCONC(:,3) + PTERMS(:,25,96) = +0.37862*TPK%K096(:)*PCONC(:,41)*PCONC(:,3) ! !PTERMS(ONIT,K096) = +0.18401*K096*<OLN>*<NO> - PTERMS(:,26,96) = +0.18401*TPK%K096(:)*PCONC(:,40)*PCONC(:,3) + PTERMS(:,27,96) = +0.18401*TPK%K096(:)*PCONC(:,41)*PCONC(:,3) ! !PTERMS(OLN,K096) = -K096*<OLN>*<NO> - PTERMS(:,40,96) = -TPK%K096(:)*PCONC(:,40)*PCONC(:,3) + PTERMS(:,41,96) = -TPK%K096(:)*PCONC(:,41)*PCONC(:,3) ! !PTERMS(HO2,K097) = -K097*<MO2>*<HO2> - PTERMS(:,15,97) = -TPK%K097(:)*PCONC(:,32)*PCONC(:,15) + PTERMS(:,16,97) = -TPK%K097(:)*PCONC(:,33)*PCONC(:,16) ! !PTERMS(OP1,K097) = +K097*<MO2>*<HO2> - PTERMS(:,28,97) = +TPK%K097(:)*PCONC(:,32)*PCONC(:,15) + PTERMS(:,29,97) = +TPK%K097(:)*PCONC(:,33)*PCONC(:,16) ! !PTERMS(MO2,K097) = -K097*<MO2>*<HO2> - PTERMS(:,32,97) = -TPK%K097(:)*PCONC(:,32)*PCONC(:,15) + PTERMS(:,33,97) = -TPK%K097(:)*PCONC(:,33)*PCONC(:,16) ! !PTERMS(HO2,K098) = -K098*<ALKAP>*<HO2> - PTERMS(:,15,98) = -TPK%K098(:)*PCONC(:,33)*PCONC(:,15) + PTERMS(:,16,98) = -TPK%K098(:)*PCONC(:,34)*PCONC(:,16) ! !PTERMS(OP2,K098) = +1.00524*K098*<ALKAP>*<HO2> - PTERMS(:,29,98) = +1.00524*TPK%K098(:)*PCONC(:,33)*PCONC(:,15) + PTERMS(:,30,98) = +1.00524*TPK%K098(:)*PCONC(:,34)*PCONC(:,16) ! !PTERMS(ALKAP,K098) = -K098*<ALKAP>*<HO2> - PTERMS(:,33,98) = -TPK%K098(:)*PCONC(:,33)*PCONC(:,15) + PTERMS(:,34,98) = -TPK%K098(:)*PCONC(:,34)*PCONC(:,16) ! !PTERMS(HO2,K099) = -K099*<ALKEP>*<HO2> - PTERMS(:,15,99) = -TPK%K099(:)*PCONC(:,34)*PCONC(:,15) + PTERMS(:,16,99) = -TPK%K099(:)*PCONC(:,35)*PCONC(:,16) ! !PTERMS(OP2,K099) = +1.00524*K099*<ALKEP>*<HO2> - PTERMS(:,29,99) = +1.00524*TPK%K099(:)*PCONC(:,34)*PCONC(:,15) + PTERMS(:,30,99) = +1.00524*TPK%K099(:)*PCONC(:,35)*PCONC(:,16) ! !PTERMS(ALKEP,K099) = -K099*<ALKEP>*<HO2> - PTERMS(:,34,99) = -TPK%K099(:)*PCONC(:,34)*PCONC(:,15) + PTERMS(:,35,99) = -TPK%K099(:)*PCONC(:,35)*PCONC(:,16) ! !PTERMS(HO2,K0100) = -K0100*<BIOP>*<HO2> - PTERMS(:,15,100) = -TPK%K0100(:)*PCONC(:,35)*PCONC(:,15) + PTERMS(:,16,100) = -TPK%K0100(:)*PCONC(:,36)*PCONC(:,16) ! !PTERMS(OP2,K0100) = +1.00524*K0100*<BIOP>*<HO2> - PTERMS(:,29,100) = +1.00524*TPK%K0100(:)*PCONC(:,35)*PCONC(:,15) + PTERMS(:,30,100) = +1.00524*TPK%K0100(:)*PCONC(:,36)*PCONC(:,16) ! !PTERMS(BIOP,K0100) = -K0100*<BIOP>*<HO2> - PTERMS(:,35,100) = -TPK%K0100(:)*PCONC(:,35)*PCONC(:,15) + PTERMS(:,36,100) = -TPK%K0100(:)*PCONC(:,36)*PCONC(:,16) ! !PTERMS(HO2,K0101) = -K0101*<AROP>*<HO2> - PTERMS(:,15,101) = -TPK%K0101(:)*PCONC(:,38)*PCONC(:,15) + PTERMS(:,16,101) = -TPK%K0101(:)*PCONC(:,39)*PCONC(:,16) ! !PTERMS(OP2,K0101) = +1.00524*K0101*<AROP>*<HO2> - PTERMS(:,29,101) = +1.00524*TPK%K0101(:)*PCONC(:,38)*PCONC(:,15) + PTERMS(:,30,101) = +1.00524*TPK%K0101(:)*PCONC(:,39)*PCONC(:,16) ! !PTERMS(AROP,K0101) = -K0101*<AROP>*<HO2> - PTERMS(:,38,101) = -TPK%K0101(:)*PCONC(:,38)*PCONC(:,15) + PTERMS(:,39,101) = -TPK%K0101(:)*PCONC(:,39)*PCONC(:,16) ! !PTERMS(O3,K0102) = +0.17307*K0102*<CARBOP>*<HO2> - PTERMS(:,1,102) = +0.17307*TPK%K0102(:)*PCONC(:,39)*PCONC(:,15) + PTERMS(:,1,102) = +0.17307*TPK%K0102(:)*PCONC(:,40)*PCONC(:,16) ! ! RETURN @@ -31296,64 +31909,64 @@ SUBROUTINE SUBT21 !Indices 421 a 440 ! !PTERMS(HO2,K0102) = -K0102*<CARBOP>*<HO2> - PTERMS(:,15,102) = -TPK%K0102(:)*PCONC(:,39)*PCONC(:,15) + PTERMS(:,16,102) = -TPK%K0102(:)*PCONC(:,40)*PCONC(:,16) ! !PTERMS(OP2,K0102) = +0.80904*K0102*<CARBOP>*<HO2> - PTERMS(:,29,102) = +0.80904*TPK%K0102(:)*PCONC(:,39)*PCONC(:,15) + PTERMS(:,30,102) = +0.80904*TPK%K0102(:)*PCONC(:,40)*PCONC(:,16) ! !PTERMS(ORA2,K0102) = +0.17307*K0102*<CARBOP>*<HO2> - PTERMS(:,31,102) = +0.17307*TPK%K0102(:)*PCONC(:,39)*PCONC(:,15) + PTERMS(:,32,102) = +0.17307*TPK%K0102(:)*PCONC(:,40)*PCONC(:,16) ! !PTERMS(CARBOP,K0102) = -K0102*<CARBOP>*<HO2> - PTERMS(:,39,102) = -TPK%K0102(:)*PCONC(:,39)*PCONC(:,15) + PTERMS(:,40,102) = -TPK%K0102(:)*PCONC(:,40)*PCONC(:,16) ! !PTERMS(HO2,K103) = -K103*<OLN>*<HO2> - PTERMS(:,15,103) = -TPK%K103(:)*PCONC(:,40)*PCONC(:,15) + PTERMS(:,16,103) = -TPK%K103(:)*PCONC(:,41)*PCONC(:,16) ! !PTERMS(ONIT,K103) = +K103*<OLN>*<HO2> - PTERMS(:,26,103) = +TPK%K103(:)*PCONC(:,40)*PCONC(:,15) + PTERMS(:,27,103) = +TPK%K103(:)*PCONC(:,41)*PCONC(:,16) ! !PTERMS(OLN,K103) = -K103*<OLN>*<HO2> - PTERMS(:,40,103) = -TPK%K103(:)*PCONC(:,40)*PCONC(:,15) + PTERMS(:,41,103) = -TPK%K103(:)*PCONC(:,41)*PCONC(:,16) ! !PTERMS(HO2,K104) = +0.66*K104*<MO2>*<MO2> - PTERMS(:,15,104) = +0.66*TPK%K104(:)*PCONC(:,32)*PCONC(:,32) + PTERMS(:,16,104) = +0.66*TPK%K104(:)*PCONC(:,33)*PCONC(:,33) ! !PTERMS(HCHO,K104) = +1.33*K104*<MO2>*<MO2> - PTERMS(:,22,104) = +1.33*TPK%K104(:)*PCONC(:,32)*PCONC(:,32) + PTERMS(:,23,104) = +1.33*TPK%K104(:)*PCONC(:,33)*PCONC(:,33) ! !PTERMS(MO2,K104) = -K104*<MO2>*<MO2> - PTERMS(:,32,104) = -TPK%K104(:)*PCONC(:,32)*PCONC(:,32) + PTERMS(:,33,104) = -TPK%K104(:)*PCONC(:,33)*PCONC(:,33) ! !PTERMS(HO2,K105) = +0.98383*K105*<ALKAP>*<MO2> - PTERMS(:,15,105) = +0.98383*TPK%K105(:)*PCONC(:,33)*PCONC(:,32) + PTERMS(:,16,105) = +0.98383*TPK%K105(:)*PCONC(:,34)*PCONC(:,33) ! !PTERMS(HCHO,K105) = +0.80556*K105*<ALKAP>*<MO2> - PTERMS(:,22,105) = +0.80556*TPK%K105(:)*PCONC(:,33)*PCONC(:,32) + PTERMS(:,23,105) = +0.80556*TPK%K105(:)*PCONC(:,34)*PCONC(:,33) ! !PTERMS(ALD,K105) = +0.56070*K105*<ALKAP>*<MO2> - PTERMS(:,23,105) = +0.56070*TPK%K105(:)*PCONC(:,33)*PCONC(:,32) + PTERMS(:,24,105) = +0.56070*TPK%K105(:)*PCONC(:,34)*PCONC(:,33) ! !PTERMS(KET,K105) = +0.09673*K105*<ALKAP>*<MO2> - PTERMS(:,24,105) = +0.09673*TPK%K105(:)*PCONC(:,33)*PCONC(:,32) + PTERMS(:,25,105) = +0.09673*TPK%K105(:)*PCONC(:,34)*PCONC(:,33) ! !PTERMS(CARBO,K105) = +0.07976*K105*<ALKAP>*<MO2> - PTERMS(:,25,105) = +0.07976*TPK%K105(:)*PCONC(:,33)*PCONC(:,32) + PTERMS(:,26,105) = +0.07976*TPK%K105(:)*PCONC(:,34)*PCONC(:,33) ! !PTERMS(MO2,K105) = -K105*<ALKAP>*<MO2> - PTERMS(:,32,105) = -TPK%K105(:)*PCONC(:,33)*PCONC(:,32) + PTERMS(:,33,105) = -TPK%K105(:)*PCONC(:,34)*PCONC(:,33) ! !PTERMS(ALKAP,K105) = -K105*<ALKAP>*<MO2> - PTERMS(:,33,105) = -TPK%K105(:)*PCONC(:,33)*PCONC(:,32) + PTERMS(:,34,105) = -TPK%K105(:)*PCONC(:,34)*PCONC(:,33) ! !PTERMS(XO2,K105) = +0.13370*K105*<ALKAP>*<MO2> - PTERMS(:,41,105) = +0.13370*TPK%K105(:)*PCONC(:,33)*PCONC(:,32) + PTERMS(:,42,105) = +0.13370*TPK%K105(:)*PCONC(:,34)*PCONC(:,33) ! !PTERMS(HO2,K106) = +K106*<ALKEP>*<MO2> - PTERMS(:,15,106) = +TPK%K106(:)*PCONC(:,34)*PCONC(:,32) + PTERMS(:,16,106) = +TPK%K106(:)*PCONC(:,35)*PCONC(:,33) ! !PTERMS(HCHO,K106) = +1.42894*K106*<ALKEP>*<MO2> - PTERMS(:,22,106) = +1.42894*TPK%K106(:)*PCONC(:,34)*PCONC(:,32) + PTERMS(:,23,106) = +1.42894*TPK%K106(:)*PCONC(:,35)*PCONC(:,33) ! ! RETURN @@ -31364,64 +31977,64 @@ SUBROUTINE SUBT22 !Indices 441 a 460 ! !PTERMS(ALD,K106) = +0.46413*K106*<ALKEP>*<MO2> - PTERMS(:,23,106) = +0.46413*TPK%K106(:)*PCONC(:,34)*PCONC(:,32) + PTERMS(:,24,106) = +0.46413*TPK%K106(:)*PCONC(:,35)*PCONC(:,33) ! !PTERMS(KET,K106) = +0.03814*K106*<ALKEP>*<MO2> - PTERMS(:,24,106) = +0.03814*TPK%K106(:)*PCONC(:,34)*PCONC(:,32) + PTERMS(:,25,106) = +0.03814*TPK%K106(:)*PCONC(:,35)*PCONC(:,33) ! !PTERMS(MO2,K106) = -K106*<ALKEP>*<MO2> - PTERMS(:,32,106) = -TPK%K106(:)*PCONC(:,34)*PCONC(:,32) + PTERMS(:,33,106) = -TPK%K106(:)*PCONC(:,35)*PCONC(:,33) ! !PTERMS(ALKEP,K106) = -K106*<ALKEP>*<MO2> - PTERMS(:,34,106) = -TPK%K106(:)*PCONC(:,34)*PCONC(:,32) + PTERMS(:,35,106) = -TPK%K106(:)*PCONC(:,35)*PCONC(:,33) ! !PTERMS(HO2,K107) = +1.00000*K107*<BIOP>*<MO2> - PTERMS(:,15,107) = +1.00000*TPK%K107(:)*PCONC(:,35)*PCONC(:,32) + PTERMS(:,16,107) = +1.00000*TPK%K107(:)*PCONC(:,36)*PCONC(:,33) ! !PTERMS(ALKE,K107) = +0.48074*K107*<BIOP>*<MO2> - PTERMS(:,19,107) = +0.48074*TPK%K107(:)*PCONC(:,35)*PCONC(:,32) + PTERMS(:,20,107) = +0.48074*TPK%K107(:)*PCONC(:,36)*PCONC(:,33) ! !PTERMS(HCHO,K107) = +1.09000*K107*<BIOP>*<MO2> - PTERMS(:,22,107) = +1.09000*TPK%K107(:)*PCONC(:,35)*PCONC(:,32) + PTERMS(:,23,107) = +1.09000*TPK%K107(:)*PCONC(:,36)*PCONC(:,33) ! !PTERMS(ALD,K107) = +0.00000*K107*<BIOP>*<MO2> - PTERMS(:,23,107) = +0.00000*TPK%K107(:)*PCONC(:,35)*PCONC(:,32) + PTERMS(:,24,107) = +0.00000*TPK%K107(:)*PCONC(:,36)*PCONC(:,33) ! !PTERMS(KET,K107) = +0.00000*K107*<BIOP>*<MO2> - PTERMS(:,24,107) = +0.00000*TPK%K107(:)*PCONC(:,35)*PCONC(:,32) + PTERMS(:,25,107) = +0.00000*TPK%K107(:)*PCONC(:,36)*PCONC(:,33) ! !PTERMS(CARBO,K107) = +0.56064*K107*<BIOP>*<MO2> - PTERMS(:,25,107) = +0.56064*TPK%K107(:)*PCONC(:,35)*PCONC(:,32) + PTERMS(:,26,107) = +0.56064*TPK%K107(:)*PCONC(:,36)*PCONC(:,33) ! !PTERMS(MO2,K107) = -K107*<BIOP>*<MO2> - PTERMS(:,32,107) = -TPK%K107(:)*PCONC(:,35)*PCONC(:,32) + PTERMS(:,33,107) = -TPK%K107(:)*PCONC(:,36)*PCONC(:,33) ! !PTERMS(BIOP,K107) = -K107*<BIOP>*<MO2> - PTERMS(:,35,107) = -TPK%K107(:)*PCONC(:,35)*PCONC(:,32) + PTERMS(:,36,107) = -TPK%K107(:)*PCONC(:,36)*PCONC(:,33) ! !PTERMS(HO2,K108) = +1.02767*K108*<AROP>*<MO2> - PTERMS(:,15,108) = +1.02767*TPK%K108(:)*PCONC(:,38)*PCONC(:,32) + PTERMS(:,16,108) = +1.02767*TPK%K108(:)*PCONC(:,39)*PCONC(:,33) ! !PTERMS(HCHO,K108) = +K108*<AROP>*<MO2> - PTERMS(:,22,108) = +TPK%K108(:)*PCONC(:,38)*PCONC(:,32) + PTERMS(:,23,108) = +TPK%K108(:)*PCONC(:,39)*PCONC(:,33) ! !PTERMS(CARBO,K108) = +1.99461*K108*<AROP>*<MO2> - PTERMS(:,25,108) = +1.99461*TPK%K108(:)*PCONC(:,38)*PCONC(:,32) + PTERMS(:,26,108) = +1.99461*TPK%K108(:)*PCONC(:,39)*PCONC(:,33) ! !PTERMS(MO2,K108) = -K108*<AROP>*<MO2> - PTERMS(:,32,108) = -TPK%K108(:)*PCONC(:,38)*PCONC(:,32) + PTERMS(:,33,108) = -TPK%K108(:)*PCONC(:,39)*PCONC(:,33) ! !PTERMS(AROP,K108) = -K108*<AROP>*<MO2> - PTERMS(:,38,108) = -TPK%K108(:)*PCONC(:,38)*PCONC(:,32) + PTERMS(:,39,108) = -TPK%K108(:)*PCONC(:,39)*PCONC(:,33) ! !PTERMS(HO2,K109) = +0.82998*K109*<CARBOP>*<MO2> - PTERMS(:,15,109) = +0.82998*TPK%K109(:)*PCONC(:,39)*PCONC(:,32) + PTERMS(:,16,109) = +0.82998*TPK%K109(:)*PCONC(:,40)*PCONC(:,33) ! !PTERMS(HCHO,K109) = +0.95723*K109*<CARBOP>*<MO2> - PTERMS(:,22,109) = +0.95723*TPK%K109(:)*PCONC(:,39)*PCONC(:,32) + PTERMS(:,23,109) = +0.95723*TPK%K109(:)*PCONC(:,40)*PCONC(:,33) ! !PTERMS(ALD,K109) = +0.08295*K109*<CARBOP>*<MO2> - PTERMS(:,23,109) = +0.08295*TPK%K109(:)*PCONC(:,39)*PCONC(:,32) + PTERMS(:,24,109) = +0.08295*TPK%K109(:)*PCONC(:,40)*PCONC(:,33) ! ! RETURN @@ -31432,64 +32045,64 @@ SUBROUTINE SUBT23 !Indices 461 a 480 ! !PTERMS(CARBO,K109) = +0.15387*K109*<CARBOP>*<MO2> - PTERMS(:,25,109) = +0.15387*TPK%K109(:)*PCONC(:,39)*PCONC(:,32) + PTERMS(:,26,109) = +0.15387*TPK%K109(:)*PCONC(:,40)*PCONC(:,33) ! !PTERMS(ORA2,K109) = +0.13684*K109*<CARBOP>*<MO2> - PTERMS(:,31,109) = +0.13684*TPK%K109(:)*PCONC(:,39)*PCONC(:,32) + PTERMS(:,32,109) = +0.13684*TPK%K109(:)*PCONC(:,40)*PCONC(:,33) ! !PTERMS(MO2,K109) = -K109*<CARBOP>*<MO2> - PTERMS(:,32,109) = -TPK%K109(:)*PCONC(:,39)*PCONC(:,32) + PTERMS(:,33,109) = -TPK%K109(:)*PCONC(:,40)*PCONC(:,33) ! !PTERMS(CARBOP,K109) = -K109*<CARBOP>*<MO2> - PTERMS(:,39,109) = -TPK%K109(:)*PCONC(:,39)*PCONC(:,32) + PTERMS(:,40,109) = -TPK%K109(:)*PCONC(:,40)*PCONC(:,33) ! !PTERMS(XO2,K109) = +0.02212*K109*<CARBOP>*<MO2> - PTERMS(:,41,109) = +0.02212*TPK%K109(:)*PCONC(:,39)*PCONC(:,32) + PTERMS(:,42,109) = +0.02212*TPK%K109(:)*PCONC(:,40)*PCONC(:,33) ! !PTERMS(NO2,K110) = +0.32440*K110*<OLN>*<MO2> - PTERMS(:,4,110) = +0.32440*TPK%K110(:)*PCONC(:,40)*PCONC(:,32) + PTERMS(:,4,110) = +0.32440*TPK%K110(:)*PCONC(:,41)*PCONC(:,33) ! !PTERMS(HO2,K110) = +0.67560*K110*<OLN>*<MO2> - PTERMS(:,15,110) = +0.67560*TPK%K110(:)*PCONC(:,40)*PCONC(:,32) + PTERMS(:,16,110) = +0.67560*TPK%K110(:)*PCONC(:,41)*PCONC(:,33) ! !PTERMS(HCHO,K110) = +0.88625*K110*<OLN>*<MO2> - PTERMS(:,22,110) = +0.88625*TPK%K110(:)*PCONC(:,40)*PCONC(:,32) + PTERMS(:,23,110) = +0.88625*TPK%K110(:)*PCONC(:,41)*PCONC(:,33) ! !PTERMS(ALD,K110) = +0.41524*K110*<OLN>*<MO2> - PTERMS(:,23,110) = +0.41524*TPK%K110(:)*PCONC(:,40)*PCONC(:,32) + PTERMS(:,24,110) = +0.41524*TPK%K110(:)*PCONC(:,41)*PCONC(:,33) ! !PTERMS(KET,K110) = +0.09667*K110*<OLN>*<MO2> - PTERMS(:,24,110) = +0.09667*TPK%K110(:)*PCONC(:,40)*PCONC(:,32) + PTERMS(:,25,110) = +0.09667*TPK%K110(:)*PCONC(:,41)*PCONC(:,33) ! !PTERMS(ONIT,K110) = +0.67560*K110*<OLN>*<MO2> - PTERMS(:,26,110) = +0.67560*TPK%K110(:)*PCONC(:,40)*PCONC(:,32) + PTERMS(:,27,110) = +0.67560*TPK%K110(:)*PCONC(:,41)*PCONC(:,33) ! !PTERMS(MO2,K110) = -K110*<OLN>*<MO2> - PTERMS(:,32,110) = -TPK%K110(:)*PCONC(:,40)*PCONC(:,32) + PTERMS(:,33,110) = -TPK%K110(:)*PCONC(:,41)*PCONC(:,33) ! !PTERMS(OLN,K110) = -K110*<OLN>*<MO2> - PTERMS(:,40,110) = -TPK%K110(:)*PCONC(:,40)*PCONC(:,32) + PTERMS(:,41,110) = -TPK%K110(:)*PCONC(:,41)*PCONC(:,33) ! !PTERMS(HO2,K111) = +0.48079*K111*<ALKAP>*<CARBOP> - PTERMS(:,15,111) = +0.48079*TPK%K111(:)*PCONC(:,33)*PCONC(:,39) + PTERMS(:,16,111) = +0.48079*TPK%K111(:)*PCONC(:,34)*PCONC(:,40) ! !PTERMS(HCHO,K111) = +0.07600*K111*<ALKAP>*<CARBOP> - PTERMS(:,22,111) = +0.07600*TPK%K111(:)*PCONC(:,33)*PCONC(:,39) + PTERMS(:,23,111) = +0.07600*TPK%K111(:)*PCONC(:,34)*PCONC(:,40) ! !PTERMS(ALD,K111) = +0.71461*K111*<ALKAP>*<CARBOP> - PTERMS(:,23,111) = +0.71461*TPK%K111(:)*PCONC(:,33)*PCONC(:,39) + PTERMS(:,24,111) = +0.71461*TPK%K111(:)*PCONC(:,34)*PCONC(:,40) ! !PTERMS(KET,K111) = +0.18819*K111*<ALKAP>*<CARBOP> - PTERMS(:,24,111) = +0.18819*TPK%K111(:)*PCONC(:,33)*PCONC(:,39) + PTERMS(:,25,111) = +0.18819*TPK%K111(:)*PCONC(:,34)*PCONC(:,40) ! !PTERMS(CARBO,K111) = +0.06954*K111*<ALKAP>*<CARBOP> - PTERMS(:,25,111) = +0.06954*TPK%K111(:)*PCONC(:,33)*PCONC(:,39) + PTERMS(:,26,111) = +0.06954*TPK%K111(:)*PCONC(:,34)*PCONC(:,40) ! !PTERMS(ORA2,K111) = +0.49810*K111*<ALKAP>*<CARBOP> - PTERMS(:,31,111) = +0.49810*TPK%K111(:)*PCONC(:,33)*PCONC(:,39) + PTERMS(:,32,111) = +0.49810*TPK%K111(:)*PCONC(:,34)*PCONC(:,40) ! !PTERMS(MO2,K111) = +0.51480*K111*<ALKAP>*<CARBOP> - PTERMS(:,32,111) = +0.51480*TPK%K111(:)*PCONC(:,33)*PCONC(:,39) + PTERMS(:,33,111) = +0.51480*TPK%K111(:)*PCONC(:,34)*PCONC(:,40) ! ! RETURN @@ -31500,64 +32113,64 @@ SUBROUTINE SUBT24 !Indices 481 a 500 ! !PTERMS(ALKAP,K111) = -K111*<ALKAP>*<CARBOP> - PTERMS(:,33,111) = -TPK%K111(:)*PCONC(:,33)*PCONC(:,39) + PTERMS(:,34,111) = -TPK%K111(:)*PCONC(:,34)*PCONC(:,40) ! !PTERMS(CARBOP,K111) = -K111*<ALKAP>*<CARBOP> - PTERMS(:,39,111) = -TPK%K111(:)*PCONC(:,33)*PCONC(:,39) + PTERMS(:,40,111) = -TPK%K111(:)*PCONC(:,34)*PCONC(:,40) ! !PTERMS(XO2,K111) = +0.11306*K111*<ALKAP>*<CARBOP> - PTERMS(:,41,111) = +0.11306*TPK%K111(:)*PCONC(:,33)*PCONC(:,39) + PTERMS(:,42,111) = +0.11306*TPK%K111(:)*PCONC(:,34)*PCONC(:,40) ! !PTERMS(HO2,K112) = +0.50078*K112*<ALKEP>*<CARBOP> - PTERMS(:,15,112) = +0.50078*TPK%K112(:)*PCONC(:,34)*PCONC(:,39) + PTERMS(:,16,112) = +0.50078*TPK%K112(:)*PCONC(:,35)*PCONC(:,40) ! !PTERMS(HCHO,K112) = +0.68192*K112*<ALKEP>*<CARBOP> - PTERMS(:,22,112) = +0.68192*TPK%K112(:)*PCONC(:,34)*PCONC(:,39) + PTERMS(:,23,112) = +0.68192*TPK%K112(:)*PCONC(:,35)*PCONC(:,40) ! !PTERMS(ALD,K112) = +0.68374*K112*<ALKEP>*<CARBOP> - PTERMS(:,23,112) = +0.68374*TPK%K112(:)*PCONC(:,34)*PCONC(:,39) + PTERMS(:,24,112) = +0.68374*TPK%K112(:)*PCONC(:,35)*PCONC(:,40) ! !PTERMS(KET,K112) = +0.06579*K112*<ALKEP>*<CARBOP> - PTERMS(:,24,112) = +0.06579*TPK%K112(:)*PCONC(:,34)*PCONC(:,39) + PTERMS(:,25,112) = +0.06579*TPK%K112(:)*PCONC(:,35)*PCONC(:,40) ! !PTERMS(ORA2,K112) = +0.49922*K112*<ALKEP>*<CARBOP> - PTERMS(:,31,112) = +0.49922*TPK%K112(:)*PCONC(:,34)*PCONC(:,39) + PTERMS(:,32,112) = +0.49922*TPK%K112(:)*PCONC(:,35)*PCONC(:,40) ! !PTERMS(MO2,K112) = +0.50078*K112*<ALKEP>*<CARBOP> - PTERMS(:,32,112) = +0.50078*TPK%K112(:)*PCONC(:,34)*PCONC(:,39) + PTERMS(:,33,112) = +0.50078*TPK%K112(:)*PCONC(:,35)*PCONC(:,40) ! !PTERMS(ALKEP,K112) = -K112*<ALKEP>*<CARBOP> - PTERMS(:,34,112) = -TPK%K112(:)*PCONC(:,34)*PCONC(:,39) + PTERMS(:,35,112) = -TPK%K112(:)*PCONC(:,35)*PCONC(:,40) ! !PTERMS(CARBOP,K112) = -K112*<ALKEP>*<CARBOP> - PTERMS(:,39,112) = -TPK%K112(:)*PCONC(:,34)*PCONC(:,39) + PTERMS(:,40,112) = -TPK%K112(:)*PCONC(:,35)*PCONC(:,40) ! !PTERMS(HO2,K113) = +0.50600*K113*<BIOP>*<CARBOP> - PTERMS(:,15,113) = +0.50600*TPK%K113(:)*PCONC(:,35)*PCONC(:,39) + PTERMS(:,16,113) = +0.50600*TPK%K113(:)*PCONC(:,36)*PCONC(:,40) ! !PTERMS(ALKE,K113) = +0.24463*K113*<BIOP>*<CARBOP> - PTERMS(:,19,113) = +0.24463*TPK%K113(:)*PCONC(:,35)*PCONC(:,39) + PTERMS(:,20,113) = +0.24463*TPK%K113(:)*PCONC(:,36)*PCONC(:,40) ! !PTERMS(HCHO,K113) = +0.34000*K113*<BIOP>*<CARBOP> - PTERMS(:,22,113) = +0.34000*TPK%K113(:)*PCONC(:,35)*PCONC(:,39) + PTERMS(:,23,113) = +0.34000*TPK%K113(:)*PCONC(:,36)*PCONC(:,40) ! !PTERMS(ALD,K113) = +0.00000*K113*<BIOP>*<CARBOP> - PTERMS(:,23,113) = +0.00000*TPK%K113(:)*PCONC(:,35)*PCONC(:,39) + PTERMS(:,24,113) = +0.00000*TPK%K113(:)*PCONC(:,36)*PCONC(:,40) ! !PTERMS(KET,K113) = +0.00000*K113*<BIOP>*<CARBOP> - PTERMS(:,24,113) = +0.00000*TPK%K113(:)*PCONC(:,35)*PCONC(:,39) + PTERMS(:,25,113) = +0.00000*TPK%K113(:)*PCONC(:,36)*PCONC(:,40) ! !PTERMS(CARBO,K113) = +0.78591*K113*<BIOP>*<CARBOP> - PTERMS(:,25,113) = +0.78591*TPK%K113(:)*PCONC(:,35)*PCONC(:,39) + PTERMS(:,26,113) = +0.78591*TPK%K113(:)*PCONC(:,36)*PCONC(:,40) ! !PTERMS(ORA2,K113) = +0.49400*K113*<BIOP>*<CARBOP> - PTERMS(:,31,113) = +0.49400*TPK%K113(:)*PCONC(:,35)*PCONC(:,39) + PTERMS(:,32,113) = +0.49400*TPK%K113(:)*PCONC(:,36)*PCONC(:,40) ! !PTERMS(MO2,K113) = +0.50600*K113*<BIOP>*<CARBOP> - PTERMS(:,32,113) = +0.50600*TPK%K113(:)*PCONC(:,35)*PCONC(:,39) + PTERMS(:,33,113) = +0.50600*TPK%K113(:)*PCONC(:,36)*PCONC(:,40) ! !PTERMS(BIOP,K113) = -K113*<BIOP>*<CARBOP> - PTERMS(:,35,113) = -TPK%K113(:)*PCONC(:,35)*PCONC(:,39) + PTERMS(:,36,113) = -TPK%K113(:)*PCONC(:,36)*PCONC(:,40) ! ! RETURN @@ -31568,64 +32181,64 @@ SUBROUTINE SUBT25 !Indices 501 a 520 ! !PTERMS(CARBOP,K113) = -K113*<BIOP>*<CARBOP> - PTERMS(:,39,113) = -TPK%K113(:)*PCONC(:,35)*PCONC(:,39) + PTERMS(:,40,113) = -TPK%K113(:)*PCONC(:,36)*PCONC(:,40) ! !PTERMS(HO2,K114) = +K114*<AROP>*<CARBOP> - PTERMS(:,15,114) = +TPK%K114(:)*PCONC(:,38)*PCONC(:,39) + PTERMS(:,16,114) = +TPK%K114(:)*PCONC(:,39)*PCONC(:,40) ! !PTERMS(CARBO,K114) = +1.99455*K114*<AROP>*<CARBOP> - PTERMS(:,25,114) = +1.99455*TPK%K114(:)*PCONC(:,38)*PCONC(:,39) + PTERMS(:,26,114) = +1.99455*TPK%K114(:)*PCONC(:,39)*PCONC(:,40) ! !PTERMS(MO2,K114) = +K114*<AROP>*<CARBOP> - PTERMS(:,32,114) = +TPK%K114(:)*PCONC(:,38)*PCONC(:,39) + PTERMS(:,33,114) = +TPK%K114(:)*PCONC(:,39)*PCONC(:,40) ! !PTERMS(AROP,K114) = -K114*<AROP>*<CARBOP> - PTERMS(:,38,114) = -TPK%K114(:)*PCONC(:,38)*PCONC(:,39) + PTERMS(:,39,114) = -TPK%K114(:)*PCONC(:,39)*PCONC(:,40) ! !PTERMS(CARBOP,K114) = -K114*<AROP>*<CARBOP> - PTERMS(:,39,114) = -TPK%K114(:)*PCONC(:,38)*PCONC(:,39) + PTERMS(:,40,114) = -TPK%K114(:)*PCONC(:,39)*PCONC(:,40) ! !PTERMS(HO2,K115) = +0.07566*K115*<CARBOP>*<CARBOP> - PTERMS(:,15,115) = +0.07566*TPK%K115(:)*PCONC(:,39)*PCONC(:,39) + PTERMS(:,16,115) = +0.07566*TPK%K115(:)*PCONC(:,40)*PCONC(:,40) ! !PTERMS(HCHO,K115) = +0.03432*K115*<CARBOP>*<CARBOP> - PTERMS(:,22,115) = +0.03432*TPK%K115(:)*PCONC(:,39)*PCONC(:,39) + PTERMS(:,23,115) = +0.03432*TPK%K115(:)*PCONC(:,40)*PCONC(:,40) ! !PTERMS(ALD,K115) = +0.06969*K115*<CARBOP>*<CARBOP> - PTERMS(:,23,115) = +0.06969*TPK%K115(:)*PCONC(:,39)*PCONC(:,39) + PTERMS(:,24,115) = +0.06969*TPK%K115(:)*PCONC(:,40)*PCONC(:,40) ! !PTERMS(KET,K115) = +0.02190*K115*<CARBOP>*<CARBOP> - PTERMS(:,24,115) = +0.02190*TPK%K115(:)*PCONC(:,39)*PCONC(:,39) + PTERMS(:,25,115) = +0.02190*TPK%K115(:)*PCONC(:,40)*PCONC(:,40) ! !PTERMS(CARBO,K115) = +0.10777*K115*<CARBOP>*<CARBOP> - PTERMS(:,25,115) = +0.10777*TPK%K115(:)*PCONC(:,39)*PCONC(:,39) + PTERMS(:,26,115) = +0.10777*TPK%K115(:)*PCONC(:,40)*PCONC(:,40) ! !PTERMS(ORA2,K115) = +0.09955*K115*<CARBOP>*<CARBOP> - PTERMS(:,31,115) = +0.09955*TPK%K115(:)*PCONC(:,39)*PCONC(:,39) + PTERMS(:,32,115) = +0.09955*TPK%K115(:)*PCONC(:,40)*PCONC(:,40) ! !PTERMS(MO2,K115) = +1.66702*K115*<CARBOP>*<CARBOP> - PTERMS(:,32,115) = +1.66702*TPK%K115(:)*PCONC(:,39)*PCONC(:,39) + PTERMS(:,33,115) = +1.66702*TPK%K115(:)*PCONC(:,40)*PCONC(:,40) ! !PTERMS(CARBOP,K115) = -K115*<CARBOP>*<CARBOP> - PTERMS(:,39,115) = -TPK%K115(:)*PCONC(:,39)*PCONC(:,39) + PTERMS(:,40,115) = -TPK%K115(:)*PCONC(:,40)*PCONC(:,40) ! !PTERMS(XO2,K115) = +0.01593*K115*<CARBOP>*<CARBOP> - PTERMS(:,41,115) = +0.01593*TPK%K115(:)*PCONC(:,39)*PCONC(:,39) + PTERMS(:,42,115) = +0.01593*TPK%K115(:)*PCONC(:,40)*PCONC(:,40) ! !PTERMS(NO2,K116) = +0.00000*K116*<OLN>*<CARBOP> - PTERMS(:,4,116) = +0.00000*TPK%K116(:)*PCONC(:,40)*PCONC(:,39) + PTERMS(:,4,116) = +0.00000*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) ! !PTERMS(HO2,K116) = +0.17599*K116*<OLN>*<CARBOP> - PTERMS(:,15,116) = +0.17599*TPK%K116(:)*PCONC(:,40)*PCONC(:,39) + PTERMS(:,16,116) = +0.17599*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) ! !PTERMS(HCHO,K116) = +0.13414*K116*<OLN>*<CARBOP> - PTERMS(:,22,116) = +0.13414*TPK%K116(:)*PCONC(:,40)*PCONC(:,39) + PTERMS(:,23,116) = +0.13414*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) ! !PTERMS(ALD,K116) = +0.42122*K116*<OLN>*<CARBOP> - PTERMS(:,23,116) = +0.42122*TPK%K116(:)*PCONC(:,40)*PCONC(:,39) + PTERMS(:,24,116) = +0.42122*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) ! !PTERMS(KET,K116) = +0.10822*K116*<OLN>*<CARBOP> - PTERMS(:,24,116) = +0.10822*TPK%K116(:)*PCONC(:,40)*PCONC(:,39) + PTERMS(:,25,116) = +0.10822*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) ! ! RETURN @@ -31636,64 +32249,64 @@ SUBROUTINE SUBT26 !Indices 521 a 540 ! !PTERMS(ONIT,K116) = +0.66562*K116*<OLN>*<CARBOP> - PTERMS(:,26,116) = +0.66562*TPK%K116(:)*PCONC(:,40)*PCONC(:,39) + PTERMS(:,27,116) = +0.66562*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) ! !PTERMS(ORA2,K116) = +0.48963*K116*<OLN>*<CARBOP> - PTERMS(:,31,116) = +0.48963*TPK%K116(:)*PCONC(:,40)*PCONC(:,39) + PTERMS(:,32,116) = +0.48963*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) ! !PTERMS(MO2,K116) = +0.51037*K116*<OLN>*<CARBOP> - PTERMS(:,32,116) = +0.51037*TPK%K116(:)*PCONC(:,40)*PCONC(:,39) + PTERMS(:,33,116) = +0.51037*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) ! !PTERMS(CARBOP,K116) = -K116*<OLN>*<CARBOP> - PTERMS(:,39,116) = -TPK%K116(:)*PCONC(:,40)*PCONC(:,39) + PTERMS(:,40,116) = -TPK%K116(:)*PCONC(:,41)*PCONC(:,40) ! !PTERMS(OLN,K116) = -K116*<OLN>*<CARBOP> - PTERMS(:,40,116) = -TPK%K116(:)*PCONC(:,40)*PCONC(:,39) + PTERMS(:,41,116) = -TPK%K116(:)*PCONC(:,41)*PCONC(:,40) ! !PTERMS(HO2,K117) = +K117*<OLN>*<OLN> - PTERMS(:,15,117) = +TPK%K117(:)*PCONC(:,40)*PCONC(:,40) + PTERMS(:,16,117) = +TPK%K117(:)*PCONC(:,41)*PCONC(:,41) ! !PTERMS(ONIT,K117) = +2.00*K117*<OLN>*<OLN> - PTERMS(:,26,117) = +2.00*TPK%K117(:)*PCONC(:,40)*PCONC(:,40) + PTERMS(:,27,117) = +2.00*TPK%K117(:)*PCONC(:,41)*PCONC(:,41) ! !PTERMS(OLN,K117) = -K117*<OLN>*<OLN> - PTERMS(:,40,117) = -TPK%K117(:)*PCONC(:,40)*PCONC(:,40) + PTERMS(:,41,117) = -TPK%K117(:)*PCONC(:,41)*PCONC(:,41) ! !PTERMS(NO2,K118) = +0.00000*K118*<OLN>*<OLN> - PTERMS(:,4,118) = +0.00000*TPK%K118(:)*PCONC(:,40)*PCONC(:,40) + PTERMS(:,4,118) = +0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,41) ! !PTERMS(HO2,K118) = +0.00000*K118*<OLN>*<OLN> - PTERMS(:,15,118) = +0.00000*TPK%K118(:)*PCONC(:,40)*PCONC(:,40) + PTERMS(:,16,118) = +0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,41) ! !PTERMS(HCHO,K118) = +0.00000*K118*<OLN>*<OLN> - PTERMS(:,22,118) = +0.00000*TPK%K118(:)*PCONC(:,40)*PCONC(:,40) + PTERMS(:,23,118) = +0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,41) ! !PTERMS(ALD,K118) = +0.00000*K118*<OLN>*<OLN> - PTERMS(:,23,118) = +0.00000*TPK%K118(:)*PCONC(:,40)*PCONC(:,40) + PTERMS(:,24,118) = +0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,41) ! !PTERMS(KET,K118) = +0.00000*K118*<OLN>*<OLN> - PTERMS(:,24,118) = +0.00000*TPK%K118(:)*PCONC(:,40)*PCONC(:,40) + PTERMS(:,25,118) = +0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,41) ! !PTERMS(ONIT,K118) = +0.00000*K118*<OLN>*<OLN> - PTERMS(:,26,118) = +0.00000*TPK%K118(:)*PCONC(:,40)*PCONC(:,40) + PTERMS(:,27,118) = +0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,41) ! !PTERMS(OLN,K118) = -K118*<OLN>*<OLN> - PTERMS(:,40,118) = -TPK%K118(:)*PCONC(:,40)*PCONC(:,40) + PTERMS(:,41,118) = -TPK%K118(:)*PCONC(:,41)*PCONC(:,41) ! !PTERMS(NO2,K119) = +K119*<MO2>*<NO3> - PTERMS(:,4,119) = +TPK%K119(:)*PCONC(:,32)*PCONC(:,5) + PTERMS(:,4,119) = +TPK%K119(:)*PCONC(:,33)*PCONC(:,5) ! !PTERMS(NO3,K119) = -K119*<MO2>*<NO3> - PTERMS(:,5,119) = -TPK%K119(:)*PCONC(:,32)*PCONC(:,5) + PTERMS(:,5,119) = -TPK%K119(:)*PCONC(:,33)*PCONC(:,5) ! !PTERMS(HO2,K119) = +K119*<MO2>*<NO3> - PTERMS(:,15,119) = +TPK%K119(:)*PCONC(:,32)*PCONC(:,5) + PTERMS(:,16,119) = +TPK%K119(:)*PCONC(:,33)*PCONC(:,5) ! !PTERMS(HCHO,K119) = +K119*<MO2>*<NO3> - PTERMS(:,22,119) = +TPK%K119(:)*PCONC(:,32)*PCONC(:,5) + PTERMS(:,23,119) = +TPK%K119(:)*PCONC(:,33)*PCONC(:,5) ! !PTERMS(MO2,K119) = -K119*<MO2>*<NO3> - PTERMS(:,32,119) = -TPK%K119(:)*PCONC(:,32)*PCONC(:,5) + PTERMS(:,33,119) = -TPK%K119(:)*PCONC(:,33)*PCONC(:,5) ! ! RETURN @@ -31704,64 +32317,64 @@ SUBROUTINE SUBT27 !Indices 541 a 560 ! !PTERMS(NO2,K120) = +K120*<ALKAP>*<NO3> - PTERMS(:,4,120) = +TPK%K120(:)*PCONC(:,33)*PCONC(:,5) + PTERMS(:,4,120) = +TPK%K120(:)*PCONC(:,34)*PCONC(:,5) ! !PTERMS(NO3,K120) = -K120*<ALKAP>*<NO3> - PTERMS(:,5,120) = -TPK%K120(:)*PCONC(:,33)*PCONC(:,5) + PTERMS(:,5,120) = -TPK%K120(:)*PCONC(:,34)*PCONC(:,5) ! !PTERMS(HO2,K120) = +0.81290*K120*<ALKAP>*<NO3> - PTERMS(:,15,120) = +0.81290*TPK%K120(:)*PCONC(:,33)*PCONC(:,5) + PTERMS(:,16,120) = +0.81290*TPK%K120(:)*PCONC(:,34)*PCONC(:,5) ! !PTERMS(HCHO,K120) = +0.03142*K120*<ALKAP>*<NO3> - PTERMS(:,22,120) = +0.03142*TPK%K120(:)*PCONC(:,33)*PCONC(:,5) + PTERMS(:,23,120) = +0.03142*TPK%K120(:)*PCONC(:,34)*PCONC(:,5) ! !PTERMS(ALD,K120) = +0.33743*K120*<ALKAP>*<NO3> - PTERMS(:,23,120) = +0.33743*TPK%K120(:)*PCONC(:,33)*PCONC(:,5) + PTERMS(:,24,120) = +0.33743*TPK%K120(:)*PCONC(:,34)*PCONC(:,5) ! !PTERMS(KET,K120) = +0.62978*K120*<ALKAP>*<NO3> - PTERMS(:,24,120) = +0.62978*TPK%K120(:)*PCONC(:,33)*PCONC(:,5) + PTERMS(:,25,120) = +0.62978*TPK%K120(:)*PCONC(:,34)*PCONC(:,5) ! !PTERMS(CARBO,K120) = +0.03531*K120*<ALKAP>*<NO3> - PTERMS(:,25,120) = +0.03531*TPK%K120(:)*PCONC(:,33)*PCONC(:,5) + PTERMS(:,26,120) = +0.03531*TPK%K120(:)*PCONC(:,34)*PCONC(:,5) ! !PTERMS(MO2,K120) = +0.09731*K120*<ALKAP>*<NO3> - PTERMS(:,32,120) = +0.09731*TPK%K120(:)*PCONC(:,33)*PCONC(:,5) + PTERMS(:,33,120) = +0.09731*TPK%K120(:)*PCONC(:,34)*PCONC(:,5) ! !PTERMS(ALKAP,K120) = -K120*<ALKAP>*<NO3> - PTERMS(:,33,120) = -TPK%K120(:)*PCONC(:,33)*PCONC(:,5) + PTERMS(:,34,120) = -TPK%K120(:)*PCONC(:,34)*PCONC(:,5) ! !PTERMS(XO2,K120) = +0.16271*K120*<ALKAP>*<NO3> - PTERMS(:,41,120) = +0.16271*TPK%K120(:)*PCONC(:,33)*PCONC(:,5) + PTERMS(:,42,120) = +0.16271*TPK%K120(:)*PCONC(:,34)*PCONC(:,5) ! !PTERMS(NO2,K121) = +K121*<ALKEP>*<NO3> - PTERMS(:,4,121) = +TPK%K121(:)*PCONC(:,34)*PCONC(:,5) + PTERMS(:,4,121) = +TPK%K121(:)*PCONC(:,35)*PCONC(:,5) ! !PTERMS(NO3,K121) = -K121*<ALKEP>*<NO3> - PTERMS(:,5,121) = -TPK%K121(:)*PCONC(:,34)*PCONC(:,5) + PTERMS(:,5,121) = -TPK%K121(:)*PCONC(:,35)*PCONC(:,5) ! !PTERMS(HO2,K121) = +K121*<ALKEP>*<NO3> - PTERMS(:,15,121) = +TPK%K121(:)*PCONC(:,34)*PCONC(:,5) + PTERMS(:,16,121) = +TPK%K121(:)*PCONC(:,35)*PCONC(:,5) ! !PTERMS(HCHO,K121) = +1.40909*K121*<ALKEP>*<NO3> - PTERMS(:,22,121) = +1.40909*TPK%K121(:)*PCONC(:,34)*PCONC(:,5) + PTERMS(:,23,121) = +1.40909*TPK%K121(:)*PCONC(:,35)*PCONC(:,5) ! !PTERMS(ALD,K121) = +0.43039*K121*<ALKEP>*<NO3> - PTERMS(:,23,121) = +0.43039*TPK%K121(:)*PCONC(:,34)*PCONC(:,5) + PTERMS(:,24,121) = +0.43039*TPK%K121(:)*PCONC(:,35)*PCONC(:,5) ! !PTERMS(KET,K121) = +0.02051*K121*<ALKEP>*<NO3> - PTERMS(:,24,121) = +0.02051*TPK%K121(:)*PCONC(:,34)*PCONC(:,5) + PTERMS(:,25,121) = +0.02051*TPK%K121(:)*PCONC(:,35)*PCONC(:,5) ! !PTERMS(ALKEP,K121) = -K121*<ALKEP>*<NO3> - PTERMS(:,34,121) = -TPK%K121(:)*PCONC(:,34)*PCONC(:,5) + PTERMS(:,35,121) = -TPK%K121(:)*PCONC(:,35)*PCONC(:,5) ! !PTERMS(NO2,K122) = +K122*<BIOP>*<NO3> - PTERMS(:,4,122) = +TPK%K122(:)*PCONC(:,35)*PCONC(:,5) + PTERMS(:,4,122) = +TPK%K122(:)*PCONC(:,36)*PCONC(:,5) ! !PTERMS(NO3,K122) = -K122*<BIOP>*<NO3> - PTERMS(:,5,122) = -TPK%K122(:)*PCONC(:,35)*PCONC(:,5) + PTERMS(:,5,122) = -TPK%K122(:)*PCONC(:,36)*PCONC(:,5) ! !PTERMS(HO2,K122) = +K122*<BIOP>*<NO3> - PTERMS(:,15,122) = +TPK%K122(:)*PCONC(:,35)*PCONC(:,5) + PTERMS(:,16,122) = +TPK%K122(:)*PCONC(:,36)*PCONC(:,5) ! ! RETURN @@ -31772,64 +32385,64 @@ SUBROUTINE SUBT28 !Indices 561 a 580 ! !PTERMS(ALKE,K122) = +0.42729*K122*<BIOP>*<NO3> - PTERMS(:,19,122) = +0.42729*TPK%K122(:)*PCONC(:,35)*PCONC(:,5) + PTERMS(:,20,122) = +0.42729*TPK%K122(:)*PCONC(:,36)*PCONC(:,5) ! !PTERMS(HCHO,K122) = +0.68600*K122*<BIOP>*<NO3> - PTERMS(:,22,122) = +0.68600*TPK%K122(:)*PCONC(:,35)*PCONC(:,5) + PTERMS(:,23,122) = +0.68600*TPK%K122(:)*PCONC(:,36)*PCONC(:,5) ! !PTERMS(ALD,K122) = +0.00000*K122*<BIOP>*<NO3> - PTERMS(:,23,122) = +0.00000*TPK%K122(:)*PCONC(:,35)*PCONC(:,5) + PTERMS(:,24,122) = +0.00000*TPK%K122(:)*PCONC(:,36)*PCONC(:,5) ! !PTERMS(KET,K122) = +0.00000*K122*<BIOP>*<NO3> - PTERMS(:,24,122) = +0.00000*TPK%K122(:)*PCONC(:,35)*PCONC(:,5) + PTERMS(:,25,122) = +0.00000*TPK%K122(:)*PCONC(:,36)*PCONC(:,5) ! !PTERMS(CARBO,K122) = +0.61160*K122*<BIOP>*<NO3> - PTERMS(:,25,122) = +0.61160*TPK%K122(:)*PCONC(:,35)*PCONC(:,5) + PTERMS(:,26,122) = +0.61160*TPK%K122(:)*PCONC(:,36)*PCONC(:,5) ! !PTERMS(BIOP,K122) = -K122*<BIOP>*<NO3> - PTERMS(:,35,122) = -TPK%K122(:)*PCONC(:,35)*PCONC(:,5) + PTERMS(:,36,122) = -TPK%K122(:)*PCONC(:,36)*PCONC(:,5) ! !PTERMS(NO2,K123) = +K123*<AROP>*<NO3> - PTERMS(:,4,123) = +TPK%K123(:)*PCONC(:,38)*PCONC(:,5) + PTERMS(:,4,123) = +TPK%K123(:)*PCONC(:,39)*PCONC(:,5) ! !PTERMS(NO3,K123) = -K123*<AROP>*<NO3> - PTERMS(:,5,123) = -TPK%K123(:)*PCONC(:,38)*PCONC(:,5) + PTERMS(:,5,123) = -TPK%K123(:)*PCONC(:,39)*PCONC(:,5) ! !PTERMS(HO2,K123) = +K123*<AROP>*<NO3> - PTERMS(:,15,123) = +TPK%K123(:)*PCONC(:,38)*PCONC(:,5) + PTERMS(:,16,123) = +TPK%K123(:)*PCONC(:,39)*PCONC(:,5) ! !PTERMS(CARBO,K123) = +2.81904*K123*<AROP>*<NO3> - PTERMS(:,25,123) = +2.81904*TPK%K123(:)*PCONC(:,38)*PCONC(:,5) + PTERMS(:,26,123) = +2.81904*TPK%K123(:)*PCONC(:,39)*PCONC(:,5) ! !PTERMS(AROP,K123) = -K123*<AROP>*<NO3> - PTERMS(:,38,123) = -TPK%K123(:)*PCONC(:,38)*PCONC(:,5) + PTERMS(:,39,123) = -TPK%K123(:)*PCONC(:,39)*PCONC(:,5) ! !PTERMS(NO2,K124) = +K124*<CARBOP>*<NO3> - PTERMS(:,4,124) = +TPK%K124(:)*PCONC(:,39)*PCONC(:,5) + PTERMS(:,4,124) = +TPK%K124(:)*PCONC(:,40)*PCONC(:,5) ! !PTERMS(NO3,K124) = -K124*<CARBOP>*<NO3> - PTERMS(:,5,124) = -TPK%K124(:)*PCONC(:,39)*PCONC(:,5) + PTERMS(:,5,124) = -TPK%K124(:)*PCONC(:,40)*PCONC(:,5) ! !PTERMS(HO2,K124) = +0.04915*K124*<CARBOP>*<NO3> - PTERMS(:,15,124) = +0.04915*TPK%K124(:)*PCONC(:,39)*PCONC(:,5) + PTERMS(:,16,124) = +0.04915*TPK%K124(:)*PCONC(:,40)*PCONC(:,5) ! !PTERMS(HCHO,K124) = +0.03175*K124*<CARBOP>*<NO3> - PTERMS(:,22,124) = +0.03175*TPK%K124(:)*PCONC(:,39)*PCONC(:,5) + PTERMS(:,23,124) = +0.03175*TPK%K124(:)*PCONC(:,40)*PCONC(:,5) ! !PTERMS(ALD,K124) = +0.02936*K124*<CARBOP>*<NO3> - PTERMS(:,23,124) = +0.02936*TPK%K124(:)*PCONC(:,39)*PCONC(:,5) + PTERMS(:,24,124) = +0.02936*TPK%K124(:)*PCONC(:,40)*PCONC(:,5) ! !PTERMS(CARBO,K124) = +0.03455*K124*<CARBOP>*<NO3> - PTERMS(:,25,124) = +0.03455*TPK%K124(:)*PCONC(:,39)*PCONC(:,5) + PTERMS(:,26,124) = +0.03455*TPK%K124(:)*PCONC(:,40)*PCONC(:,5) ! !PTERMS(MO2,K124) = +0.91910*K124*<CARBOP>*<NO3> - PTERMS(:,32,124) = +0.91910*TPK%K124(:)*PCONC(:,39)*PCONC(:,5) + PTERMS(:,33,124) = +0.91910*TPK%K124(:)*PCONC(:,40)*PCONC(:,5) ! !PTERMS(CARBOP,K124) = -K124*<CARBOP>*<NO3> - PTERMS(:,39,124) = -TPK%K124(:)*PCONC(:,39)*PCONC(:,5) + PTERMS(:,40,124) = -TPK%K124(:)*PCONC(:,40)*PCONC(:,5) ! !PTERMS(XO2,K124) = +0.01021*K124*<CARBOP>*<NO3> - PTERMS(:,41,124) = +0.01021*TPK%K124(:)*PCONC(:,39)*PCONC(:,5) + PTERMS(:,42,124) = +0.01021*TPK%K124(:)*PCONC(:,40)*PCONC(:,5) ! ! RETURN @@ -31840,64 +32453,64 @@ SUBROUTINE SUBT29 !Indices 581 a 600 ! !PTERMS(NO2,K125) = +1.74072*K125*<OLN>*<NO3> - PTERMS(:,4,125) = +1.74072*TPK%K125(:)*PCONC(:,40)*PCONC(:,5) + PTERMS(:,4,125) = +1.74072*TPK%K125(:)*PCONC(:,41)*PCONC(:,5) ! !PTERMS(NO3,K125) = -K125*<OLN>*<NO3> - PTERMS(:,5,125) = -TPK%K125(:)*PCONC(:,40)*PCONC(:,5) + PTERMS(:,5,125) = -TPK%K125(:)*PCONC(:,41)*PCONC(:,5) ! !PTERMS(HO2,K125) = +0.25928*K125*<OLN>*<NO3> - PTERMS(:,15,125) = +0.25928*TPK%K125(:)*PCONC(:,40)*PCONC(:,5) + PTERMS(:,16,125) = +0.25928*TPK%K125(:)*PCONC(:,41)*PCONC(:,5) ! !PTERMS(HCHO,K125) = +0.20740*K125*<OLN>*<NO3> - PTERMS(:,22,125) = +0.20740*TPK%K125(:)*PCONC(:,40)*PCONC(:,5) + PTERMS(:,23,125) = +0.20740*TPK%K125(:)*PCONC(:,41)*PCONC(:,5) ! !PTERMS(ALD,K125) = +0.91850*K125*<OLN>*<NO3> - PTERMS(:,23,125) = +0.91850*TPK%K125(:)*PCONC(:,40)*PCONC(:,5) + PTERMS(:,24,125) = +0.91850*TPK%K125(:)*PCONC(:,41)*PCONC(:,5) ! !PTERMS(KET,K125) = +0.34740*K125*<OLN>*<NO3> - PTERMS(:,24,125) = +0.34740*TPK%K125(:)*PCONC(:,40)*PCONC(:,5) + PTERMS(:,25,125) = +0.34740*TPK%K125(:)*PCONC(:,41)*PCONC(:,5) ! !PTERMS(ONIT,K125) = +0.25928*K125*<OLN>*<NO3> - PTERMS(:,26,125) = +0.25928*TPK%K125(:)*PCONC(:,40)*PCONC(:,5) + PTERMS(:,27,125) = +0.25928*TPK%K125(:)*PCONC(:,41)*PCONC(:,5) ! !PTERMS(OLN,K125) = -K125*<OLN>*<NO3> - PTERMS(:,40,125) = -TPK%K125(:)*PCONC(:,40)*PCONC(:,5) + PTERMS(:,41,125) = -TPK%K125(:)*PCONC(:,41)*PCONC(:,5) ! !PTERMS(HO2,K126) = -K126*<XO2>*<HO2> - PTERMS(:,15,126) = -TPK%K126(:)*PCONC(:,41)*PCONC(:,15) + PTERMS(:,16,126) = -TPK%K126(:)*PCONC(:,42)*PCONC(:,16) ! !PTERMS(OP2,K126) = +1.00524*K126*<XO2>*<HO2> - PTERMS(:,29,126) = +1.00524*TPK%K126(:)*PCONC(:,41)*PCONC(:,15) + PTERMS(:,30,126) = +1.00524*TPK%K126(:)*PCONC(:,42)*PCONC(:,16) ! !PTERMS(XO2,K126) = -K126*<XO2>*<HO2> - PTERMS(:,41,126) = -TPK%K126(:)*PCONC(:,41)*PCONC(:,15) + PTERMS(:,42,126) = -TPK%K126(:)*PCONC(:,42)*PCONC(:,16) ! !PTERMS(HO2,K127) = +K127*<XO2>*<MO2> - PTERMS(:,15,127) = +TPK%K127(:)*PCONC(:,41)*PCONC(:,32) + PTERMS(:,16,127) = +TPK%K127(:)*PCONC(:,42)*PCONC(:,33) ! !PTERMS(HCHO,K127) = +K127*<XO2>*<MO2> - PTERMS(:,22,127) = +TPK%K127(:)*PCONC(:,41)*PCONC(:,32) + PTERMS(:,23,127) = +TPK%K127(:)*PCONC(:,42)*PCONC(:,33) ! !PTERMS(MO2,K127) = -K127*<XO2>*<MO2> - PTERMS(:,32,127) = -TPK%K127(:)*PCONC(:,41)*PCONC(:,32) + PTERMS(:,33,127) = -TPK%K127(:)*PCONC(:,42)*PCONC(:,33) ! !PTERMS(XO2,K127) = -K127*<XO2>*<MO2> - PTERMS(:,41,127) = -TPK%K127(:)*PCONC(:,41)*PCONC(:,32) + PTERMS(:,42,127) = -TPK%K127(:)*PCONC(:,42)*PCONC(:,33) ! !PTERMS(MO2,K128) = +K128*<XO2>*<CARBOP> - PTERMS(:,32,128) = +TPK%K128(:)*PCONC(:,41)*PCONC(:,39) + PTERMS(:,33,128) = +TPK%K128(:)*PCONC(:,42)*PCONC(:,40) ! !PTERMS(CARBOP,K128) = -K128*<XO2>*<CARBOP> - PTERMS(:,39,128) = -TPK%K128(:)*PCONC(:,41)*PCONC(:,39) + PTERMS(:,40,128) = -TPK%K128(:)*PCONC(:,42)*PCONC(:,40) ! !PTERMS(XO2,K128) = -K128*<XO2>*<CARBOP> - PTERMS(:,41,128) = -TPK%K128(:)*PCONC(:,41)*PCONC(:,39) + PTERMS(:,42,128) = -TPK%K128(:)*PCONC(:,42)*PCONC(:,40) ! !PTERMS(XO2,K129) = -K129*<XO2>*<XO2> - PTERMS(:,41,129) = -TPK%K129(:)*PCONC(:,41)*PCONC(:,41) + PTERMS(:,42,129) = -TPK%K129(:)*PCONC(:,42)*PCONC(:,42) ! !PTERMS(NO,K130) = -K130*<XO2>*<NO> - PTERMS(:,3,130) = -TPK%K130(:)*PCONC(:,41)*PCONC(:,3) + PTERMS(:,3,130) = -TPK%K130(:)*PCONC(:,42)*PCONC(:,3) ! ! RETURN @@ -31908,1166 +32521,1193 @@ SUBROUTINE SUBT30 !Indices 601 a 620 ! !PTERMS(NO2,K130) = +K130*<XO2>*<NO> - PTERMS(:,4,130) = +TPK%K130(:)*PCONC(:,41)*PCONC(:,3) + PTERMS(:,4,130) = +TPK%K130(:)*PCONC(:,42)*PCONC(:,3) ! !PTERMS(XO2,K130) = -K130*<XO2>*<NO> - PTERMS(:,41,130) = -TPK%K130(:)*PCONC(:,41)*PCONC(:,3) + PTERMS(:,42,130) = -TPK%K130(:)*PCONC(:,42)*PCONC(:,3) ! !PTERMS(NO2,K131) = +K131*<XO2>*<NO3> - PTERMS(:,4,131) = +TPK%K131(:)*PCONC(:,41)*PCONC(:,5) + PTERMS(:,4,131) = +TPK%K131(:)*PCONC(:,42)*PCONC(:,5) ! !PTERMS(NO3,K131) = -K131*<XO2>*<NO3> - PTERMS(:,5,131) = -TPK%K131(:)*PCONC(:,41)*PCONC(:,5) + PTERMS(:,5,131) = -TPK%K131(:)*PCONC(:,42)*PCONC(:,5) ! !PTERMS(XO2,K131) = -K131*<XO2>*<NO3> - PTERMS(:,41,131) = -TPK%K131(:)*PCONC(:,41)*PCONC(:,5) + PTERMS(:,42,131) = -TPK%K131(:)*PCONC(:,42)*PCONC(:,5) ! !PTERMS(SULF,K132) = -K132*<SULF> - PTERMS(:,12,132) = -TPK%K132(:)*PCONC(:,12) + PTERMS(:,13,132) = -TPK%K132(:)*PCONC(:,13) +! +!PTERMS(NO2,K133) = +K133*<DMS>*<NO3> + PTERMS(:,4,133) = +TPK%K133(:)*PCONC(:,11)*PCONC(:,5) +! +!PTERMS(NO3,K133) = -K133*<DMS>*<NO3> + PTERMS(:,5,133) = -TPK%K133(:)*PCONC(:,11)*PCONC(:,5) +! +!PTERMS(DMS,K133) = -K133*<DMS>*<NO3> + PTERMS(:,11,133) = -TPK%K133(:)*PCONC(:,11)*PCONC(:,5) +! +!PTERMS(SO2,K133) = +K133*<DMS>*<NO3> + PTERMS(:,12,133) = +TPK%K133(:)*PCONC(:,11)*PCONC(:,5) +! +!PTERMS(DMS,K134) = -K134*<DMS>*<O3P> + PTERMS(:,11,134) = -TPK%K134(:)*PCONC(:,11)*TPK%O3P(:) +! +!PTERMS(SO2,K134) = +K134*<DMS>*<O3P> + PTERMS(:,12,134) = +TPK%K134(:)*PCONC(:,11)*TPK%O3P(:) +! +!PTERMS(DMS,K135) = -K135*<DMS>*<OH> + PTERMS(:,11,135) = -TPK%K135(:)*PCONC(:,11)*PCONC(:,15) +! +!PTERMS(SO2,K135) = +0.8*K135*<DMS>*<OH> + PTERMS(:,12,135) = +0.8*TPK%K135(:)*PCONC(:,11)*PCONC(:,15) +! +!PTERMS(OH,K135) = -K135*<DMS>*<OH> + PTERMS(:,15,135) = -TPK%K135(:)*PCONC(:,11)*PCONC(:,15) ! !PTERMS(O3,KTC1) = -KTC1*<O3> - PTERMS(:,1,133) = -TPK%KTC1(:)*PCONC(:,1) + PTERMS(:,1,136) = -TPK%KTC1(:)*PCONC(:,1) ! !PTERMS(WC_O3,KTC1) = +KTC1*<O3> - PTERMS(:,42,133) = +TPK%KTC1(:)*PCONC(:,1) + PTERMS(:,43,136) = +TPK%KTC1(:)*PCONC(:,1) ! !PTERMS(H2O2,KTC2) = -KTC2*<H2O2> - PTERMS(:,2,134) = -TPK%KTC2(:)*PCONC(:,2) + PTERMS(:,2,137) = -TPK%KTC2(:)*PCONC(:,2) ! !PTERMS(WC_H2O2,KTC2) = +KTC2*<H2O2> - PTERMS(:,43,134) = +TPK%KTC2(:)*PCONC(:,2) + PTERMS(:,44,137) = +TPK%KTC2(:)*PCONC(:,2) ! !PTERMS(NO,KTC3) = -KTC3*<NO> - PTERMS(:,3,135) = -TPK%KTC3(:)*PCONC(:,3) + PTERMS(:,3,138) = -TPK%KTC3(:)*PCONC(:,3) +! +! +RETURN +END SUBROUTINE SUBT30 +! +SUBROUTINE SUBT31 +! +!Indices 621 a 640 ! !PTERMS(WC_NO,KTC3) = +KTC3*<NO> - PTERMS(:,44,135) = +TPK%KTC3(:)*PCONC(:,3) + PTERMS(:,45,138) = +TPK%KTC3(:)*PCONC(:,3) ! !PTERMS(NO2,KTC4) = -KTC4*<NO2> - PTERMS(:,4,136) = -TPK%KTC4(:)*PCONC(:,4) + PTERMS(:,4,139) = -TPK%KTC4(:)*PCONC(:,4) ! !PTERMS(WC_NO2,KTC4) = +KTC4*<NO2> - PTERMS(:,45,136) = +TPK%KTC4(:)*PCONC(:,4) + PTERMS(:,46,139) = +TPK%KTC4(:)*PCONC(:,4) ! !PTERMS(NO3,KTC5) = -KTC5*<NO3> - PTERMS(:,5,137) = -TPK%KTC5(:)*PCONC(:,5) + PTERMS(:,5,140) = -TPK%KTC5(:)*PCONC(:,5) ! !PTERMS(WC_NO3,KTC5) = +KTC5*<NO3> - PTERMS(:,46,137) = +TPK%KTC5(:)*PCONC(:,5) + PTERMS(:,47,140) = +TPK%KTC5(:)*PCONC(:,5) ! !PTERMS(N2O5,KTC6) = -KTC6*<N2O5> - PTERMS(:,6,138) = -TPK%KTC6(:)*PCONC(:,6) + PTERMS(:,6,141) = -TPK%KTC6(:)*PCONC(:,6) ! !PTERMS(WC_N2O5,KTC6) = +KTC6*<N2O5> - PTERMS(:,47,138) = +TPK%KTC6(:)*PCONC(:,6) + PTERMS(:,48,141) = +TPK%KTC6(:)*PCONC(:,6) ! !PTERMS(HONO,KTC7) = -KTC7*<HONO> - PTERMS(:,7,139) = -TPK%KTC7(:)*PCONC(:,7) + PTERMS(:,7,142) = -TPK%KTC7(:)*PCONC(:,7) ! !PTERMS(WC_HONO,KTC7) = +KTC7*<HONO> - PTERMS(:,48,139) = +TPK%KTC7(:)*PCONC(:,7) -! -! -RETURN -END SUBROUTINE SUBT30 -! -SUBROUTINE SUBT31 -! -!Indices 621 a 640 + PTERMS(:,49,142) = +TPK%KTC7(:)*PCONC(:,7) ! !PTERMS(HNO3,KTC8) = -KTC8*<HNO3> - PTERMS(:,8,140) = -TPK%KTC8(:)*PCONC(:,8) + PTERMS(:,8,143) = -TPK%KTC8(:)*PCONC(:,8) ! !PTERMS(WC_HNO3,KTC8) = +KTC8*<HNO3> - PTERMS(:,49,140) = +TPK%KTC8(:)*PCONC(:,8) + PTERMS(:,50,143) = +TPK%KTC8(:)*PCONC(:,8) ! !PTERMS(HNO4,KTC9) = -KTC9*<HNO4> - PTERMS(:,9,141) = -TPK%KTC9(:)*PCONC(:,9) + PTERMS(:,9,144) = -TPK%KTC9(:)*PCONC(:,9) ! !PTERMS(WC_HNO4,KTC9) = +KTC9*<HNO4> - PTERMS(:,50,141) = +TPK%KTC9(:)*PCONC(:,9) + PTERMS(:,51,144) = +TPK%KTC9(:)*PCONC(:,9) ! !PTERMS(NH3,KTC10) = -KTC10*<NH3> - PTERMS(:,10,142) = -TPK%KTC10(:)*PCONC(:,10) + PTERMS(:,10,145) = -TPK%KTC10(:)*PCONC(:,10) ! !PTERMS(WC_NH3,KTC10) = +KTC10*<NH3> - PTERMS(:,51,142) = +TPK%KTC10(:)*PCONC(:,10) + PTERMS(:,52,145) = +TPK%KTC10(:)*PCONC(:,10) ! !PTERMS(OH,KTC11) = -KTC11*<OH> - PTERMS(:,14,143) = -TPK%KTC11(:)*PCONC(:,14) + PTERMS(:,15,146) = -TPK%KTC11(:)*PCONC(:,15) ! !PTERMS(WC_OH,KTC11) = +KTC11*<OH> - PTERMS(:,52,143) = +TPK%KTC11(:)*PCONC(:,14) + PTERMS(:,53,146) = +TPK%KTC11(:)*PCONC(:,15) ! !PTERMS(HO2,KTC12) = -KTC12*<HO2> - PTERMS(:,15,144) = -TPK%KTC12(:)*PCONC(:,15) + PTERMS(:,16,147) = -TPK%KTC12(:)*PCONC(:,16) ! !PTERMS(WC_HO2,KTC12) = +KTC12*<HO2> - PTERMS(:,53,144) = +TPK%KTC12(:)*PCONC(:,15) + PTERMS(:,54,147) = +TPK%KTC12(:)*PCONC(:,16) ! !PTERMS(WC_CO2,KTC13) = +KTC13*<CO2> - PTERMS(:,54,145) = +TPK%KTC13(:)*TPK%CO2(:) + PTERMS(:,55,148) = +TPK%KTC13(:)*TPK%CO2(:) +! +! +RETURN +END SUBROUTINE SUBT31 +! +SUBROUTINE SUBT32 +! +!Indices 641 a 660 ! !PTERMS(SO2,KTC14) = -KTC14*<SO2> - PTERMS(:,11,146) = -TPK%KTC14(:)*PCONC(:,11) + PTERMS(:,12,149) = -TPK%KTC14(:)*PCONC(:,12) ! !PTERMS(WC_SO2,KTC14) = +KTC14*<SO2> - PTERMS(:,55,146) = +TPK%KTC14(:)*PCONC(:,11) + PTERMS(:,56,149) = +TPK%KTC14(:)*PCONC(:,12) ! !PTERMS(SULF,KTC15) = -KTC15*<SULF> - PTERMS(:,12,147) = -TPK%KTC15(:)*PCONC(:,12) + PTERMS(:,13,150) = -TPK%KTC15(:)*PCONC(:,13) ! !PTERMS(WC_SULF,KTC15) = +KTC15*<SULF> - PTERMS(:,56,147) = +TPK%KTC15(:)*PCONC(:,12) + PTERMS(:,57,150) = +TPK%KTC15(:)*PCONC(:,13) ! !PTERMS(HCHO,KTC16) = -KTC16*<HCHO> - PTERMS(:,22,148) = -TPK%KTC16(:)*PCONC(:,22) + PTERMS(:,23,151) = -TPK%KTC16(:)*PCONC(:,23) ! !PTERMS(WC_HCHO,KTC16) = +KTC16*<HCHO> - PTERMS(:,57,148) = +TPK%KTC16(:)*PCONC(:,22) + PTERMS(:,58,151) = +TPK%KTC16(:)*PCONC(:,23) ! !PTERMS(ORA1,KTC17) = -KTC17*<ORA1> - PTERMS(:,30,149) = -TPK%KTC17(:)*PCONC(:,30) + PTERMS(:,31,152) = -TPK%KTC17(:)*PCONC(:,31) ! !PTERMS(WC_ORA1,KTC17) = +KTC17*<ORA1> - PTERMS(:,58,149) = +TPK%KTC17(:)*PCONC(:,30) + PTERMS(:,59,152) = +TPK%KTC17(:)*PCONC(:,31) ! !PTERMS(ORA2,KTC18) = -KTC18*<ORA2> - PTERMS(:,31,150) = -TPK%KTC18(:)*PCONC(:,31) -! -! -RETURN -END SUBROUTINE SUBT31 -! -SUBROUTINE SUBT32 -! -!Indices 641 a 660 + PTERMS(:,32,153) = -TPK%KTC18(:)*PCONC(:,32) ! !PTERMS(WC_ORA2,KTC18) = +KTC18*<ORA2> - PTERMS(:,59,150) = +TPK%KTC18(:)*PCONC(:,31) + PTERMS(:,60,153) = +TPK%KTC18(:)*PCONC(:,32) ! !PTERMS(MO2,KTC19) = -KTC19*<MO2> - PTERMS(:,32,151) = -TPK%KTC19(:)*PCONC(:,32) + PTERMS(:,33,154) = -TPK%KTC19(:)*PCONC(:,33) ! !PTERMS(WC_MO2,KTC19) = +KTC19*<MO2> - PTERMS(:,60,151) = +TPK%KTC19(:)*PCONC(:,32) + PTERMS(:,61,154) = +TPK%KTC19(:)*PCONC(:,33) ! !PTERMS(OP1,KTC20) = -KTC20*<OP1> - PTERMS(:,28,152) = -TPK%KTC20(:)*PCONC(:,28) + PTERMS(:,29,155) = -TPK%KTC20(:)*PCONC(:,29) ! !PTERMS(WC_OP1,KTC20) = +KTC20*<OP1> - PTERMS(:,61,152) = +TPK%KTC20(:)*PCONC(:,28) + PTERMS(:,62,155) = +TPK%KTC20(:)*PCONC(:,29) ! !PTERMS(O3,KTC21) = +KTC21*<WC_O3> - PTERMS(:,1,153) = +TPK%KTC21(:)*PCONC(:,42) + PTERMS(:,1,156) = +TPK%KTC21(:)*PCONC(:,43) ! !PTERMS(WC_O3,KTC21) = -KTC21*<WC_O3> - PTERMS(:,42,153) = -TPK%KTC21(:)*PCONC(:,42) + PTERMS(:,43,156) = -TPK%KTC21(:)*PCONC(:,43) ! !PTERMS(H2O2,KTC22) = +KTC22*<WC_H2O2> - PTERMS(:,2,154) = +TPK%KTC22(:)*PCONC(:,43) + PTERMS(:,2,157) = +TPK%KTC22(:)*PCONC(:,44) ! !PTERMS(WC_H2O2,KTC22) = -KTC22*<WC_H2O2> - PTERMS(:,43,154) = -TPK%KTC22(:)*PCONC(:,43) + PTERMS(:,44,157) = -TPK%KTC22(:)*PCONC(:,44) ! !PTERMS(NO,KTC23) = +KTC23*<WC_NO> - PTERMS(:,3,155) = +TPK%KTC23(:)*PCONC(:,44) + PTERMS(:,3,158) = +TPK%KTC23(:)*PCONC(:,45) ! !PTERMS(WC_NO,KTC23) = -KTC23*<WC_NO> - PTERMS(:,44,155) = -TPK%KTC23(:)*PCONC(:,44) + PTERMS(:,45,158) = -TPK%KTC23(:)*PCONC(:,45) +! +! +RETURN +END SUBROUTINE SUBT32 +! +SUBROUTINE SUBT33 +! +!Indices 661 a 680 ! !PTERMS(NO2,KTC24) = +KTC24*<WC_NO2> - PTERMS(:,4,156) = +TPK%KTC24(:)*PCONC(:,45) + PTERMS(:,4,159) = +TPK%KTC24(:)*PCONC(:,46) ! !PTERMS(WC_NO2,KTC24) = -KTC24*<WC_NO2> - PTERMS(:,45,156) = -TPK%KTC24(:)*PCONC(:,45) + PTERMS(:,46,159) = -TPK%KTC24(:)*PCONC(:,46) ! !PTERMS(NO3,KTC25) = +KTC25*<WC_NO3> - PTERMS(:,5,157) = +TPK%KTC25(:)*PCONC(:,46) + PTERMS(:,5,160) = +TPK%KTC25(:)*PCONC(:,47) ! !PTERMS(WC_NO3,KTC25) = -KTC25*<WC_NO3> - PTERMS(:,46,157) = -TPK%KTC25(:)*PCONC(:,46) + PTERMS(:,47,160) = -TPK%KTC25(:)*PCONC(:,47) ! !PTERMS(N2O5,KTC26) = +KTC26*<WC_N2O5> - PTERMS(:,6,158) = +TPK%KTC26(:)*PCONC(:,47) + PTERMS(:,6,161) = +TPK%KTC26(:)*PCONC(:,48) ! !PTERMS(WC_N2O5,KTC26) = -KTC26*<WC_N2O5> - PTERMS(:,47,158) = -TPK%KTC26(:)*PCONC(:,47) + PTERMS(:,48,161) = -TPK%KTC26(:)*PCONC(:,48) ! !PTERMS(HONO,KTC27) = +KTC27*<WC_HONO> - PTERMS(:,7,159) = +TPK%KTC27(:)*PCONC(:,48) + PTERMS(:,7,162) = +TPK%KTC27(:)*PCONC(:,49) ! !PTERMS(WC_HONO,KTC27) = -KTC27*<WC_HONO> - PTERMS(:,48,159) = -TPK%KTC27(:)*PCONC(:,48) + PTERMS(:,49,162) = -TPK%KTC27(:)*PCONC(:,49) ! !PTERMS(HNO3,KTC28) = +KTC28*<WC_HNO3> - PTERMS(:,8,160) = +TPK%KTC28(:)*PCONC(:,49) -! -! -RETURN -END SUBROUTINE SUBT32 -! -SUBROUTINE SUBT33 -! -!Indices 661 a 680 + PTERMS(:,8,163) = +TPK%KTC28(:)*PCONC(:,50) ! !PTERMS(WC_HNO3,KTC28) = -KTC28*<WC_HNO3> - PTERMS(:,49,160) = -TPK%KTC28(:)*PCONC(:,49) + PTERMS(:,50,163) = -TPK%KTC28(:)*PCONC(:,50) ! !PTERMS(HNO4,KTC29) = +KTC29*<WC_HNO4> - PTERMS(:,9,161) = +TPK%KTC29(:)*PCONC(:,50) + PTERMS(:,9,164) = +TPK%KTC29(:)*PCONC(:,51) ! !PTERMS(WC_HNO4,KTC29) = -KTC29*<WC_HNO4> - PTERMS(:,50,161) = -TPK%KTC29(:)*PCONC(:,50) + PTERMS(:,51,164) = -TPK%KTC29(:)*PCONC(:,51) ! !PTERMS(NH3,KTC30) = +KTC30*<WC_NH3> - PTERMS(:,10,162) = +TPK%KTC30(:)*PCONC(:,51) + PTERMS(:,10,165) = +TPK%KTC30(:)*PCONC(:,52) ! !PTERMS(WC_NH3,KTC30) = -KTC30*<WC_NH3> - PTERMS(:,51,162) = -TPK%KTC30(:)*PCONC(:,51) + PTERMS(:,52,165) = -TPK%KTC30(:)*PCONC(:,52) ! !PTERMS(OH,KTC31) = +KTC31*<WC_OH> - PTERMS(:,14,163) = +TPK%KTC31(:)*PCONC(:,52) + PTERMS(:,15,166) = +TPK%KTC31(:)*PCONC(:,53) ! !PTERMS(WC_OH,KTC31) = -KTC31*<WC_OH> - PTERMS(:,52,163) = -TPK%KTC31(:)*PCONC(:,52) + PTERMS(:,53,166) = -TPK%KTC31(:)*PCONC(:,53) ! !PTERMS(HO2,KTC32) = +KTC32*<WC_HO2> - PTERMS(:,15,164) = +TPK%KTC32(:)*PCONC(:,53) + PTERMS(:,16,167) = +TPK%KTC32(:)*PCONC(:,54) ! !PTERMS(WC_HO2,KTC32) = -KTC32*<WC_HO2> - PTERMS(:,53,164) = -TPK%KTC32(:)*PCONC(:,53) + PTERMS(:,54,167) = -TPK%KTC32(:)*PCONC(:,54) ! !PTERMS(WC_CO2,KTC33) = -KTC33*<WC_CO2> - PTERMS(:,54,165) = -TPK%KTC33(:)*PCONC(:,54) + PTERMS(:,55,168) = -TPK%KTC33(:)*PCONC(:,55) ! !PTERMS(SO2,KTC34) = +KTC34*<WC_SO2> - PTERMS(:,11,166) = +TPK%KTC34(:)*PCONC(:,55) + PTERMS(:,12,169) = +TPK%KTC34(:)*PCONC(:,56) +! +! +RETURN +END SUBROUTINE SUBT33 +! +SUBROUTINE SUBT34 +! +!Indices 681 a 700 ! !PTERMS(WC_SO2,KTC34) = -KTC34*<WC_SO2> - PTERMS(:,55,166) = -TPK%KTC34(:)*PCONC(:,55) + PTERMS(:,56,169) = -TPK%KTC34(:)*PCONC(:,56) ! !PTERMS(SULF,KTC35) = +KTC35*<WC_SULF> - PTERMS(:,12,167) = +TPK%KTC35(:)*PCONC(:,56) + PTERMS(:,13,170) = +TPK%KTC35(:)*PCONC(:,57) ! !PTERMS(WC_SULF,KTC35) = -KTC35*<WC_SULF> - PTERMS(:,56,167) = -TPK%KTC35(:)*PCONC(:,56) + PTERMS(:,57,170) = -TPK%KTC35(:)*PCONC(:,57) ! !PTERMS(HCHO,KTC36) = +KTC36*<WC_HCHO> - PTERMS(:,22,168) = +TPK%KTC36(:)*PCONC(:,57) + PTERMS(:,23,171) = +TPK%KTC36(:)*PCONC(:,58) ! !PTERMS(WC_HCHO,KTC36) = -KTC36*<WC_HCHO> - PTERMS(:,57,168) = -TPK%KTC36(:)*PCONC(:,57) + PTERMS(:,58,171) = -TPK%KTC36(:)*PCONC(:,58) ! !PTERMS(ORA1,KTC37) = +KTC37*<WC_ORA1> - PTERMS(:,30,169) = +TPK%KTC37(:)*PCONC(:,58) + PTERMS(:,31,172) = +TPK%KTC37(:)*PCONC(:,59) ! !PTERMS(WC_ORA1,KTC37) = -KTC37*<WC_ORA1> - PTERMS(:,58,169) = -TPK%KTC37(:)*PCONC(:,58) + PTERMS(:,59,172) = -TPK%KTC37(:)*PCONC(:,59) ! !PTERMS(ORA2,KTC38) = +KTC38*<WC_ORA2> - PTERMS(:,31,170) = +TPK%KTC38(:)*PCONC(:,59) + PTERMS(:,32,173) = +TPK%KTC38(:)*PCONC(:,60) ! !PTERMS(WC_ORA2,KTC38) = -KTC38*<WC_ORA2> - PTERMS(:,59,170) = -TPK%KTC38(:)*PCONC(:,59) -! -! -RETURN -END SUBROUTINE SUBT33 -! -SUBROUTINE SUBT34 -! -!Indices 681 a 700 + PTERMS(:,60,173) = -TPK%KTC38(:)*PCONC(:,60) ! !PTERMS(MO2,KTC39) = +KTC39*<WC_MO2> - PTERMS(:,32,171) = +TPK%KTC39(:)*PCONC(:,60) + PTERMS(:,33,174) = +TPK%KTC39(:)*PCONC(:,61) ! !PTERMS(WC_MO2,KTC39) = -KTC39*<WC_MO2> - PTERMS(:,60,171) = -TPK%KTC39(:)*PCONC(:,60) + PTERMS(:,61,174) = -TPK%KTC39(:)*PCONC(:,61) ! !PTERMS(OP1,KTC40) = +KTC40*<WC_OP1> - PTERMS(:,28,172) = +TPK%KTC40(:)*PCONC(:,61) + PTERMS(:,29,175) = +TPK%KTC40(:)*PCONC(:,62) ! !PTERMS(WC_OP1,KTC40) = -KTC40*<WC_OP1> - PTERMS(:,61,172) = -TPK%KTC40(:)*PCONC(:,61) + PTERMS(:,62,175) = -TPK%KTC40(:)*PCONC(:,62) ! !PTERMS(O3,KTR1) = -KTR1*<O3> - PTERMS(:,1,173) = -TPK%KTR1(:)*PCONC(:,1) + PTERMS(:,1,176) = -TPK%KTR1(:)*PCONC(:,1) ! !PTERMS(WR_O3,KTR1) = +KTR1*<O3> - PTERMS(:,67,173) = +TPK%KTR1(:)*PCONC(:,1) + PTERMS(:,68,176) = +TPK%KTR1(:)*PCONC(:,1) ! !PTERMS(H2O2,KTR2) = -KTR2*<H2O2> - PTERMS(:,2,174) = -TPK%KTR2(:)*PCONC(:,2) + PTERMS(:,2,177) = -TPK%KTR2(:)*PCONC(:,2) ! !PTERMS(WR_H2O2,KTR2) = +KTR2*<H2O2> - PTERMS(:,68,174) = +TPK%KTR2(:)*PCONC(:,2) + PTERMS(:,69,177) = +TPK%KTR2(:)*PCONC(:,2) ! !PTERMS(NO,KTR3) = -KTR3*<NO> - PTERMS(:,3,175) = -TPK%KTR3(:)*PCONC(:,3) + PTERMS(:,3,178) = -TPK%KTR3(:)*PCONC(:,3) ! !PTERMS(WR_NO,KTR3) = +KTR3*<NO> - PTERMS(:,69,175) = +TPK%KTR3(:)*PCONC(:,3) + PTERMS(:,70,178) = +TPK%KTR3(:)*PCONC(:,3) ! !PTERMS(NO2,KTR4) = -KTR4*<NO2> - PTERMS(:,4,176) = -TPK%KTR4(:)*PCONC(:,4) + PTERMS(:,4,179) = -TPK%KTR4(:)*PCONC(:,4) +! +! +RETURN +END SUBROUTINE SUBT34 +! +SUBROUTINE SUBT35 +! +!Indices 701 a 720 ! !PTERMS(WR_NO2,KTR4) = +KTR4*<NO2> - PTERMS(:,70,176) = +TPK%KTR4(:)*PCONC(:,4) + PTERMS(:,71,179) = +TPK%KTR4(:)*PCONC(:,4) ! !PTERMS(NO3,KTR5) = -KTR5*<NO3> - PTERMS(:,5,177) = -TPK%KTR5(:)*PCONC(:,5) + PTERMS(:,5,180) = -TPK%KTR5(:)*PCONC(:,5) ! !PTERMS(WR_NO3,KTR5) = +KTR5*<NO3> - PTERMS(:,71,177) = +TPK%KTR5(:)*PCONC(:,5) + PTERMS(:,72,180) = +TPK%KTR5(:)*PCONC(:,5) ! !PTERMS(N2O5,KTR6) = -KTR6*<N2O5> - PTERMS(:,6,178) = -TPK%KTR6(:)*PCONC(:,6) + PTERMS(:,6,181) = -TPK%KTR6(:)*PCONC(:,6) ! !PTERMS(WR_N2O5,KTR6) = +KTR6*<N2O5> - PTERMS(:,72,178) = +TPK%KTR6(:)*PCONC(:,6) + PTERMS(:,73,181) = +TPK%KTR6(:)*PCONC(:,6) ! !PTERMS(HONO,KTR7) = -KTR7*<HONO> - PTERMS(:,7,179) = -TPK%KTR7(:)*PCONC(:,7) + PTERMS(:,7,182) = -TPK%KTR7(:)*PCONC(:,7) ! !PTERMS(WR_HONO,KTR7) = +KTR7*<HONO> - PTERMS(:,73,179) = +TPK%KTR7(:)*PCONC(:,7) + PTERMS(:,74,182) = +TPK%KTR7(:)*PCONC(:,7) ! !PTERMS(HNO3,KTR8) = -KTR8*<HNO3> - PTERMS(:,8,180) = -TPK%KTR8(:)*PCONC(:,8) + PTERMS(:,8,183) = -TPK%KTR8(:)*PCONC(:,8) ! !PTERMS(WR_HNO3,KTR8) = +KTR8*<HNO3> - PTERMS(:,74,180) = +TPK%KTR8(:)*PCONC(:,8) -! -! -RETURN -END SUBROUTINE SUBT34 -! -SUBROUTINE SUBT35 -! -!Indices 701 a 720 + PTERMS(:,75,183) = +TPK%KTR8(:)*PCONC(:,8) ! !PTERMS(HNO4,KTR9) = -KTR9*<HNO4> - PTERMS(:,9,181) = -TPK%KTR9(:)*PCONC(:,9) + PTERMS(:,9,184) = -TPK%KTR9(:)*PCONC(:,9) ! !PTERMS(WR_HNO4,KTR9) = +KTR9*<HNO4> - PTERMS(:,75,181) = +TPK%KTR9(:)*PCONC(:,9) + PTERMS(:,76,184) = +TPK%KTR9(:)*PCONC(:,9) ! !PTERMS(NH3,KTR10) = -KTR10*<NH3> - PTERMS(:,10,182) = -TPK%KTR10(:)*PCONC(:,10) + PTERMS(:,10,185) = -TPK%KTR10(:)*PCONC(:,10) ! !PTERMS(WR_NH3,KTR10) = +KTR10*<NH3> - PTERMS(:,76,182) = +TPK%KTR10(:)*PCONC(:,10) + PTERMS(:,77,185) = +TPK%KTR10(:)*PCONC(:,10) ! !PTERMS(OH,KTR11) = -KTR11*<OH> - PTERMS(:,14,183) = -TPK%KTR11(:)*PCONC(:,14) + PTERMS(:,15,186) = -TPK%KTR11(:)*PCONC(:,15) ! !PTERMS(WR_OH,KTR11) = +KTR11*<OH> - PTERMS(:,77,183) = +TPK%KTR11(:)*PCONC(:,14) + PTERMS(:,78,186) = +TPK%KTR11(:)*PCONC(:,15) ! !PTERMS(HO2,KTR12) = -KTR12*<HO2> - PTERMS(:,15,184) = -TPK%KTR12(:)*PCONC(:,15) + PTERMS(:,16,187) = -TPK%KTR12(:)*PCONC(:,16) ! !PTERMS(WR_HO2,KTR12) = +KTR12*<HO2> - PTERMS(:,78,184) = +TPK%KTR12(:)*PCONC(:,15) + PTERMS(:,79,187) = +TPK%KTR12(:)*PCONC(:,16) ! !PTERMS(WR_CO2,KTR13) = +KTR13*<CO2> - PTERMS(:,79,185) = +TPK%KTR13(:)*TPK%CO2(:) + PTERMS(:,80,188) = +TPK%KTR13(:)*TPK%CO2(:) ! !PTERMS(SO2,KTR14) = -KTR14*<SO2> - PTERMS(:,11,186) = -TPK%KTR14(:)*PCONC(:,11) + PTERMS(:,12,189) = -TPK%KTR14(:)*PCONC(:,12) ! !PTERMS(WR_SO2,KTR14) = +KTR14*<SO2> - PTERMS(:,80,186) = +TPK%KTR14(:)*PCONC(:,11) + PTERMS(:,81,189) = +TPK%KTR14(:)*PCONC(:,12) +! +! +RETURN +END SUBROUTINE SUBT35 +! +SUBROUTINE SUBT36 +! +!Indices 721 a 740 ! !PTERMS(SULF,KTR15) = -KTR15*<SULF> - PTERMS(:,12,187) = -TPK%KTR15(:)*PCONC(:,12) + PTERMS(:,13,190) = -TPK%KTR15(:)*PCONC(:,13) ! !PTERMS(WR_SULF,KTR15) = +KTR15*<SULF> - PTERMS(:,81,187) = +TPK%KTR15(:)*PCONC(:,12) + PTERMS(:,82,190) = +TPK%KTR15(:)*PCONC(:,13) ! !PTERMS(HCHO,KTR16) = -KTR16*<HCHO> - PTERMS(:,22,188) = -TPK%KTR16(:)*PCONC(:,22) + PTERMS(:,23,191) = -TPK%KTR16(:)*PCONC(:,23) ! !PTERMS(WR_HCHO,KTR16) = +KTR16*<HCHO> - PTERMS(:,82,188) = +TPK%KTR16(:)*PCONC(:,22) + PTERMS(:,83,191) = +TPK%KTR16(:)*PCONC(:,23) ! !PTERMS(ORA1,KTR17) = -KTR17*<ORA1> - PTERMS(:,30,189) = -TPK%KTR17(:)*PCONC(:,30) + PTERMS(:,31,192) = -TPK%KTR17(:)*PCONC(:,31) ! !PTERMS(WR_ORA1,KTR17) = +KTR17*<ORA1> - PTERMS(:,83,189) = +TPK%KTR17(:)*PCONC(:,30) + PTERMS(:,84,192) = +TPK%KTR17(:)*PCONC(:,31) ! !PTERMS(ORA2,KTR18) = -KTR18*<ORA2> - PTERMS(:,31,190) = -TPK%KTR18(:)*PCONC(:,31) + PTERMS(:,32,193) = -TPK%KTR18(:)*PCONC(:,32) ! !PTERMS(WR_ORA2,KTR18) = +KTR18*<ORA2> - PTERMS(:,84,190) = +TPK%KTR18(:)*PCONC(:,31) + PTERMS(:,85,193) = +TPK%KTR18(:)*PCONC(:,32) ! !PTERMS(MO2,KTR19) = -KTR19*<MO2> - PTERMS(:,32,191) = -TPK%KTR19(:)*PCONC(:,32) -! -! -RETURN -END SUBROUTINE SUBT35 -! -SUBROUTINE SUBT36 -! -!Indices 721 a 740 + PTERMS(:,33,194) = -TPK%KTR19(:)*PCONC(:,33) ! !PTERMS(WR_MO2,KTR19) = +KTR19*<MO2> - PTERMS(:,85,191) = +TPK%KTR19(:)*PCONC(:,32) + PTERMS(:,86,194) = +TPK%KTR19(:)*PCONC(:,33) ! !PTERMS(OP1,KTR20) = -KTR20*<OP1> - PTERMS(:,28,192) = -TPK%KTR20(:)*PCONC(:,28) + PTERMS(:,29,195) = -TPK%KTR20(:)*PCONC(:,29) ! !PTERMS(WR_OP1,KTR20) = +KTR20*<OP1> - PTERMS(:,86,192) = +TPK%KTR20(:)*PCONC(:,28) + PTERMS(:,87,195) = +TPK%KTR20(:)*PCONC(:,29) ! !PTERMS(O3,KTR21) = +KTR21*<WR_O3> - PTERMS(:,1,193) = +TPK%KTR21(:)*PCONC(:,67) + PTERMS(:,1,196) = +TPK%KTR21(:)*PCONC(:,68) ! !PTERMS(WR_O3,KTR21) = -KTR21*<WR_O3> - PTERMS(:,67,193) = -TPK%KTR21(:)*PCONC(:,67) + PTERMS(:,68,196) = -TPK%KTR21(:)*PCONC(:,68) ! !PTERMS(H2O2,KTR22) = +KTR22*<WR_H2O2> - PTERMS(:,2,194) = +TPK%KTR22(:)*PCONC(:,68) + PTERMS(:,2,197) = +TPK%KTR22(:)*PCONC(:,69) ! !PTERMS(WR_H2O2,KTR22) = -KTR22*<WR_H2O2> - PTERMS(:,68,194) = -TPK%KTR22(:)*PCONC(:,68) + PTERMS(:,69,197) = -TPK%KTR22(:)*PCONC(:,69) ! !PTERMS(NO,KTR23) = +KTR23*<WR_NO> - PTERMS(:,3,195) = +TPK%KTR23(:)*PCONC(:,69) + PTERMS(:,3,198) = +TPK%KTR23(:)*PCONC(:,70) ! !PTERMS(WR_NO,KTR23) = -KTR23*<WR_NO> - PTERMS(:,69,195) = -TPK%KTR23(:)*PCONC(:,69) + PTERMS(:,70,198) = -TPK%KTR23(:)*PCONC(:,70) ! !PTERMS(NO2,KTR24) = +KTR24*<WR_NO2> - PTERMS(:,4,196) = +TPK%KTR24(:)*PCONC(:,70) + PTERMS(:,4,199) = +TPK%KTR24(:)*PCONC(:,71) ! !PTERMS(WR_NO2,KTR24) = -KTR24*<WR_NO2> - PTERMS(:,70,196) = -TPK%KTR24(:)*PCONC(:,70) + PTERMS(:,71,199) = -TPK%KTR24(:)*PCONC(:,71) +! +! +RETURN +END SUBROUTINE SUBT36 +! +SUBROUTINE SUBT37 +! +!Indices 741 a 760 ! !PTERMS(NO3,KTR25) = +KTR25*<WR_NO3> - PTERMS(:,5,197) = +TPK%KTR25(:)*PCONC(:,71) + PTERMS(:,5,200) = +TPK%KTR25(:)*PCONC(:,72) ! !PTERMS(WR_NO3,KTR25) = -KTR25*<WR_NO3> - PTERMS(:,71,197) = -TPK%KTR25(:)*PCONC(:,71) + PTERMS(:,72,200) = -TPK%KTR25(:)*PCONC(:,72) ! !PTERMS(N2O5,KTR26) = +KTR26*<WR_N2O5> - PTERMS(:,6,198) = +TPK%KTR26(:)*PCONC(:,72) + PTERMS(:,6,201) = +TPK%KTR26(:)*PCONC(:,73) ! !PTERMS(WR_N2O5,KTR26) = -KTR26*<WR_N2O5> - PTERMS(:,72,198) = -TPK%KTR26(:)*PCONC(:,72) + PTERMS(:,73,201) = -TPK%KTR26(:)*PCONC(:,73) ! !PTERMS(HONO,KTR27) = +KTR27*<WR_HONO> - PTERMS(:,7,199) = +TPK%KTR27(:)*PCONC(:,73) + PTERMS(:,7,202) = +TPK%KTR27(:)*PCONC(:,74) ! !PTERMS(WR_HONO,KTR27) = -KTR27*<WR_HONO> - PTERMS(:,73,199) = -TPK%KTR27(:)*PCONC(:,73) + PTERMS(:,74,202) = -TPK%KTR27(:)*PCONC(:,74) ! !PTERMS(HNO3,KTR28) = +KTR28*<WR_HNO3> - PTERMS(:,8,200) = +TPK%KTR28(:)*PCONC(:,74) + PTERMS(:,8,203) = +TPK%KTR28(:)*PCONC(:,75) ! !PTERMS(WR_HNO3,KTR28) = -KTR28*<WR_HNO3> - PTERMS(:,74,200) = -TPK%KTR28(:)*PCONC(:,74) + PTERMS(:,75,203) = -TPK%KTR28(:)*PCONC(:,75) ! !PTERMS(HNO4,KTR29) = +KTR29*<WR_HNO4> - PTERMS(:,9,201) = +TPK%KTR29(:)*PCONC(:,75) -! -! -RETURN -END SUBROUTINE SUBT36 -! -SUBROUTINE SUBT37 -! -!Indices 741 a 760 + PTERMS(:,9,204) = +TPK%KTR29(:)*PCONC(:,76) ! !PTERMS(WR_HNO4,KTR29) = -KTR29*<WR_HNO4> - PTERMS(:,75,201) = -TPK%KTR29(:)*PCONC(:,75) + PTERMS(:,76,204) = -TPK%KTR29(:)*PCONC(:,76) ! !PTERMS(NH3,KTR30) = +KTR30*<WR_NH3> - PTERMS(:,10,202) = +TPK%KTR30(:)*PCONC(:,76) + PTERMS(:,10,205) = +TPK%KTR30(:)*PCONC(:,77) ! !PTERMS(WR_NH3,KTR30) = -KTR30*<WR_NH3> - PTERMS(:,76,202) = -TPK%KTR30(:)*PCONC(:,76) + PTERMS(:,77,205) = -TPK%KTR30(:)*PCONC(:,77) ! !PTERMS(OH,KTR31) = +KTR31*<WR_OH> - PTERMS(:,14,203) = +TPK%KTR31(:)*PCONC(:,77) + PTERMS(:,15,206) = +TPK%KTR31(:)*PCONC(:,78) ! !PTERMS(WR_OH,KTR31) = -KTR31*<WR_OH> - PTERMS(:,77,203) = -TPK%KTR31(:)*PCONC(:,77) + PTERMS(:,78,206) = -TPK%KTR31(:)*PCONC(:,78) ! !PTERMS(HO2,KTR32) = +KTR32*<WR_HO2> - PTERMS(:,15,204) = +TPK%KTR32(:)*PCONC(:,78) + PTERMS(:,16,207) = +TPK%KTR32(:)*PCONC(:,79) ! !PTERMS(WR_HO2,KTR32) = -KTR32*<WR_HO2> - PTERMS(:,78,204) = -TPK%KTR32(:)*PCONC(:,78) + PTERMS(:,79,207) = -TPK%KTR32(:)*PCONC(:,79) ! !PTERMS(WR_CO2,KTR33) = -KTR33*<WR_CO2> - PTERMS(:,79,205) = -TPK%KTR33(:)*PCONC(:,79) + PTERMS(:,80,208) = -TPK%KTR33(:)*PCONC(:,80) ! !PTERMS(SO2,KTR34) = +KTR34*<WR_SO2> - PTERMS(:,11,206) = +TPK%KTR34(:)*PCONC(:,80) + PTERMS(:,12,209) = +TPK%KTR34(:)*PCONC(:,81) ! !PTERMS(WR_SO2,KTR34) = -KTR34*<WR_SO2> - PTERMS(:,80,206) = -TPK%KTR34(:)*PCONC(:,80) + PTERMS(:,81,209) = -TPK%KTR34(:)*PCONC(:,81) ! !PTERMS(SULF,KTR35) = +KTR35*<WR_SULF> - PTERMS(:,12,207) = +TPK%KTR35(:)*PCONC(:,81) + PTERMS(:,13,210) = +TPK%KTR35(:)*PCONC(:,82) +! +! +RETURN +END SUBROUTINE SUBT37 +! +SUBROUTINE SUBT38 +! +!Indices 761 a 780 ! !PTERMS(WR_SULF,KTR35) = -KTR35*<WR_SULF> - PTERMS(:,81,207) = -TPK%KTR35(:)*PCONC(:,81) + PTERMS(:,82,210) = -TPK%KTR35(:)*PCONC(:,82) ! !PTERMS(HCHO,KTR36) = +KTR36*<WR_HCHO> - PTERMS(:,22,208) = +TPK%KTR36(:)*PCONC(:,82) + PTERMS(:,23,211) = +TPK%KTR36(:)*PCONC(:,83) ! !PTERMS(WR_HCHO,KTR36) = -KTR36*<WR_HCHO> - PTERMS(:,82,208) = -TPK%KTR36(:)*PCONC(:,82) + PTERMS(:,83,211) = -TPK%KTR36(:)*PCONC(:,83) ! !PTERMS(ORA1,KTR37) = +KTR37*<WR_ORA1> - PTERMS(:,30,209) = +TPK%KTR37(:)*PCONC(:,83) + PTERMS(:,31,212) = +TPK%KTR37(:)*PCONC(:,84) ! !PTERMS(WR_ORA1,KTR37) = -KTR37*<WR_ORA1> - PTERMS(:,83,209) = -TPK%KTR37(:)*PCONC(:,83) + PTERMS(:,84,212) = -TPK%KTR37(:)*PCONC(:,84) ! !PTERMS(ORA2,KTR38) = +KTR38*<WR_ORA2> - PTERMS(:,31,210) = +TPK%KTR38(:)*PCONC(:,84) + PTERMS(:,32,213) = +TPK%KTR38(:)*PCONC(:,85) ! !PTERMS(WR_ORA2,KTR38) = -KTR38*<WR_ORA2> - PTERMS(:,84,210) = -TPK%KTR38(:)*PCONC(:,84) + PTERMS(:,85,213) = -TPK%KTR38(:)*PCONC(:,85) ! !PTERMS(MO2,KTR39) = +KTR39*<WR_MO2> - PTERMS(:,32,211) = +TPK%KTR39(:)*PCONC(:,85) + PTERMS(:,33,214) = +TPK%KTR39(:)*PCONC(:,86) ! !PTERMS(WR_MO2,KTR39) = -KTR39*<WR_MO2> - PTERMS(:,85,211) = -TPK%KTR39(:)*PCONC(:,85) -! -! -RETURN -END SUBROUTINE SUBT37 -! -SUBROUTINE SUBT38 -! -!Indices 761 a 780 + PTERMS(:,86,214) = -TPK%KTR39(:)*PCONC(:,86) ! !PTERMS(OP1,KTR40) = +KTR40*<WR_OP1> - PTERMS(:,28,212) = +TPK%KTR40(:)*PCONC(:,86) + PTERMS(:,29,215) = +TPK%KTR40(:)*PCONC(:,87) ! !PTERMS(WR_OP1,KTR40) = -KTR40*<WR_OP1> - PTERMS(:,86,212) = -TPK%KTR40(:)*PCONC(:,86) + PTERMS(:,87,215) = -TPK%KTR40(:)*PCONC(:,87) ! !PTERMS(WC_H2O2,KC1) = -KC1*<WC_H2O2> - PTERMS(:,43,213) = -TPK%KC1(:)*PCONC(:,43) + PTERMS(:,44,216) = -TPK%KC1(:)*PCONC(:,44) ! !PTERMS(WC_OH,KC1) = +KC1*<WC_H2O2> - PTERMS(:,52,213) = +TPK%KC1(:)*PCONC(:,43) + PTERMS(:,53,216) = +TPK%KC1(:)*PCONC(:,44) ! !PTERMS(WC_H2O2,KC2) = +KC2*<WC_OH>*<WC_OH> - PTERMS(:,43,214) = +TPK%KC2(:)*PCONC(:,52)*PCONC(:,52) + PTERMS(:,44,217) = +TPK%KC2(:)*PCONC(:,53)*PCONC(:,53) ! !PTERMS(WC_OH,KC2) = -KC2*<WC_OH>*<WC_OH> - PTERMS(:,52,214) = -TPK%KC2(:)*PCONC(:,52)*PCONC(:,52) + PTERMS(:,53,217) = -TPK%KC2(:)*PCONC(:,53)*PCONC(:,53) ! !PTERMS(WC_OH,KC3) = -KC3*<WC_OH>*<WC_HO2> - PTERMS(:,52,215) = -TPK%KC3(:)*PCONC(:,52)*PCONC(:,53) + PTERMS(:,53,218) = -TPK%KC3(:)*PCONC(:,53)*PCONC(:,54) ! !PTERMS(WC_HO2,KC3) = -KC3*<WC_OH>*<WC_HO2> - PTERMS(:,53,215) = -TPK%KC3(:)*PCONC(:,52)*PCONC(:,53) + PTERMS(:,54,218) = -TPK%KC3(:)*PCONC(:,53)*PCONC(:,54) ! !PTERMS(WC_H2O2,KC4) = -KC4*<WC_H2O2>*<WC_OH> - PTERMS(:,43,216) = -TPK%KC4(:)*PCONC(:,43)*PCONC(:,52) + PTERMS(:,44,219) = -TPK%KC4(:)*PCONC(:,44)*PCONC(:,53) ! !PTERMS(WC_OH,KC4) = -KC4*<WC_H2O2>*<WC_OH> - PTERMS(:,52,216) = -TPK%KC4(:)*PCONC(:,43)*PCONC(:,52) + PTERMS(:,53,219) = -TPK%KC4(:)*PCONC(:,44)*PCONC(:,53) ! !PTERMS(WC_HO2,KC4) = +KC4*<WC_H2O2>*<WC_OH> - PTERMS(:,53,216) = +TPK%KC4(:)*PCONC(:,43)*PCONC(:,52) + PTERMS(:,54,219) = +TPK%KC4(:)*PCONC(:,44)*PCONC(:,53) +! +! +RETURN +END SUBROUTINE SUBT38 +! +SUBROUTINE SUBT39 +! +!Indices 781 a 800 ! !PTERMS(WC_H2O2,KC5) = +KC5*<WC_HO2>*<WC_HO2> - PTERMS(:,43,217) = +TPK%KC5(:)*PCONC(:,53)*PCONC(:,53) + PTERMS(:,44,220) = +TPK%KC5(:)*PCONC(:,54)*PCONC(:,54) ! !PTERMS(WC_HO2,KC5) = -KC5*<WC_HO2>*<WC_HO2> - PTERMS(:,53,217) = -TPK%KC5(:)*PCONC(:,53)*PCONC(:,53) + PTERMS(:,54,220) = -TPK%KC5(:)*PCONC(:,54)*PCONC(:,54) ! !PTERMS(WC_O3,KC6) = -KC6*<WC_O3>*<WC_HO2> - PTERMS(:,42,218) = -TPK%KC6(:)*PCONC(:,42)*PCONC(:,53) + PTERMS(:,43,221) = -TPK%KC6(:)*PCONC(:,43)*PCONC(:,54) ! !PTERMS(WC_OH,KC6) = +KC6*<WC_O3>*<WC_HO2> - PTERMS(:,52,218) = +TPK%KC6(:)*PCONC(:,42)*PCONC(:,53) + PTERMS(:,53,221) = +TPK%KC6(:)*PCONC(:,43)*PCONC(:,54) ! !PTERMS(WC_HO2,KC6) = -KC6*<WC_O3>*<WC_HO2> - PTERMS(:,53,218) = -TPK%KC6(:)*PCONC(:,42)*PCONC(:,53) + PTERMS(:,54,221) = -TPK%KC6(:)*PCONC(:,43)*PCONC(:,54) ! !PTERMS(WC_OH,KC7) = -KC7*<WC_OH>*<WC_SO2> - PTERMS(:,52,219) = -TPK%KC7(:)*PCONC(:,52)*PCONC(:,55) + PTERMS(:,53,222) = -TPK%KC7(:)*PCONC(:,53)*PCONC(:,56) ! !PTERMS(WC_SO2,KC7) = -KC7*<WC_OH>*<WC_SO2> - PTERMS(:,55,219) = -TPK%KC7(:)*PCONC(:,52)*PCONC(:,55) + PTERMS(:,56,222) = -TPK%KC7(:)*PCONC(:,53)*PCONC(:,56) ! !PTERMS(WC_ASO3,KC7) = +KC7*<WC_OH>*<WC_SO2> - PTERMS(:,62,219) = +TPK%KC7(:)*PCONC(:,52)*PCONC(:,55) + PTERMS(:,63,222) = +TPK%KC7(:)*PCONC(:,53)*PCONC(:,56) ! !PTERMS(WC_NO2,KC8) = +KC8*<WC_HONO>*<WC_OH> - PTERMS(:,45,220) = +TPK%KC8(:)*PCONC(:,48)*PCONC(:,52) -! -! -RETURN -END SUBROUTINE SUBT38 -! -SUBROUTINE SUBT39 -! -!Indices 781 a 800 + PTERMS(:,46,223) = +TPK%KC8(:)*PCONC(:,49)*PCONC(:,53) ! !PTERMS(WC_HONO,KC8) = -KC8*<WC_HONO>*<WC_OH> - PTERMS(:,48,220) = -TPK%KC8(:)*PCONC(:,48)*PCONC(:,52) + PTERMS(:,49,223) = -TPK%KC8(:)*PCONC(:,49)*PCONC(:,53) ! !PTERMS(WC_OH,KC8) = -KC8*<WC_HONO>*<WC_OH> - PTERMS(:,52,220) = -TPK%KC8(:)*PCONC(:,48)*PCONC(:,52) + PTERMS(:,53,223) = -TPK%KC8(:)*PCONC(:,49)*PCONC(:,53) ! !PTERMS(WC_NO2,KC9) = -KC9*<WC_NO2>*<WC_HO2> - PTERMS(:,45,221) = -TPK%KC9(:)*PCONC(:,45)*PCONC(:,53) + PTERMS(:,46,224) = -TPK%KC9(:)*PCONC(:,46)*PCONC(:,54) ! !PTERMS(WC_HNO4,KC9) = +KC9*<WC_NO2>*<WC_HO2> - PTERMS(:,50,221) = +TPK%KC9(:)*PCONC(:,45)*PCONC(:,53) + PTERMS(:,51,224) = +TPK%KC9(:)*PCONC(:,46)*PCONC(:,54) ! !PTERMS(WC_HO2,KC9) = -KC9*<WC_NO2>*<WC_HO2> - PTERMS(:,53,221) = -TPK%KC9(:)*PCONC(:,45)*PCONC(:,53) + PTERMS(:,54,224) = -TPK%KC9(:)*PCONC(:,46)*PCONC(:,54) ! !PTERMS(WC_NO2,KC10) = +KC10*<WC_HNO4> - PTERMS(:,45,222) = +TPK%KC10(:)*PCONC(:,50) + PTERMS(:,46,225) = +TPK%KC10(:)*PCONC(:,51) ! !PTERMS(WC_HNO4,KC10) = -KC10*<WC_HNO4> - PTERMS(:,50,222) = -TPK%KC10(:)*PCONC(:,50) + PTERMS(:,51,225) = -TPK%KC10(:)*PCONC(:,51) ! !PTERMS(WC_HO2,KC10) = +KC10*<WC_HNO4> - PTERMS(:,53,222) = +TPK%KC10(:)*PCONC(:,50) + PTERMS(:,54,225) = +TPK%KC10(:)*PCONC(:,51) ! !PTERMS(WC_HONO,KC11) = +KC11*<WC_HNO4> - PTERMS(:,48,223) = +TPK%KC11(:)*PCONC(:,50) + PTERMS(:,49,226) = +TPK%KC11(:)*PCONC(:,51) ! !PTERMS(WC_HNO4,KC11) = -KC11*<WC_HNO4> - PTERMS(:,50,223) = -TPK%KC11(:)*PCONC(:,50) + PTERMS(:,51,226) = -TPK%KC11(:)*PCONC(:,51) ! !PTERMS(WC_HNO3,KC12) = +KC12*<WC_HNO4>*<WC_SO2> - PTERMS(:,49,224) = +TPK%KC12(:)*PCONC(:,50)*PCONC(:,55) + PTERMS(:,50,227) = +TPK%KC12(:)*PCONC(:,51)*PCONC(:,56) +! +! +RETURN +END SUBROUTINE SUBT39 +! +SUBROUTINE SUBT40 +! +!Indices 801 a 820 ! !PTERMS(WC_HNO4,KC12) = -KC12*<WC_HNO4>*<WC_SO2> - PTERMS(:,50,224) = -TPK%KC12(:)*PCONC(:,50)*PCONC(:,55) + PTERMS(:,51,227) = -TPK%KC12(:)*PCONC(:,51)*PCONC(:,56) ! !PTERMS(WC_SO2,KC12) = -KC12*<WC_HNO4>*<WC_SO2> - PTERMS(:,55,224) = -TPK%KC12(:)*PCONC(:,50)*PCONC(:,55) + PTERMS(:,56,227) = -TPK%KC12(:)*PCONC(:,51)*PCONC(:,56) ! !PTERMS(WC_SULF,KC12) = +KC12*<WC_HNO4>*<WC_SO2> - PTERMS(:,56,224) = +TPK%KC12(:)*PCONC(:,50)*PCONC(:,55) + PTERMS(:,57,227) = +TPK%KC12(:)*PCONC(:,51)*PCONC(:,56) ! !PTERMS(WC_NO2,KC13) = +KC13*<WC_HNO3> - PTERMS(:,45,225) = +TPK%KC13(:)*PCONC(:,49) + PTERMS(:,46,228) = +TPK%KC13(:)*PCONC(:,50) ! !PTERMS(WC_HNO3,KC13) = -KC13*<WC_HNO3> - PTERMS(:,49,225) = -TPK%KC13(:)*PCONC(:,49) + PTERMS(:,50,228) = -TPK%KC13(:)*PCONC(:,50) ! !PTERMS(WC_OH,KC13) = +KC13*<WC_HNO3> - PTERMS(:,52,225) = +TPK%KC13(:)*PCONC(:,49) + PTERMS(:,53,228) = +TPK%KC13(:)*PCONC(:,50) ! !PTERMS(WC_N2O5,KC14) = -KC14*<WC_N2O5> - PTERMS(:,47,226) = -TPK%KC14(:)*PCONC(:,47) + PTERMS(:,48,229) = -TPK%KC14(:)*PCONC(:,48) ! !PTERMS(WC_HNO3,KC14) = +KC14*<WC_N2O5> - PTERMS(:,49,226) = +TPK%KC14(:)*PCONC(:,47) + PTERMS(:,50,229) = +TPK%KC14(:)*PCONC(:,48) ! !PTERMS(WC_NO3,KC15) = -KC15*<WC_NO3>*<WC_SULF> - PTERMS(:,46,227) = -TPK%KC15(:)*PCONC(:,46)*PCONC(:,56) -! -! -RETURN -END SUBROUTINE SUBT39 -! -SUBROUTINE SUBT40 -! -!Indices 801 a 820 + PTERMS(:,47,230) = -TPK%KC15(:)*PCONC(:,47)*PCONC(:,57) ! !PTERMS(WC_HNO3,KC15) = +KC15*<WC_NO3>*<WC_SULF> - PTERMS(:,49,227) = +TPK%KC15(:)*PCONC(:,46)*PCONC(:,56) + PTERMS(:,50,230) = +TPK%KC15(:)*PCONC(:,47)*PCONC(:,57) ! !PTERMS(WC_SULF,KC15) = -KC15*<WC_NO3>*<WC_SULF> - PTERMS(:,56,227) = -TPK%KC15(:)*PCONC(:,46)*PCONC(:,56) + PTERMS(:,57,230) = -TPK%KC15(:)*PCONC(:,47)*PCONC(:,57) ! !PTERMS(WC_ASO4,KC15) = +KC15*<WC_NO3>*<WC_SULF> - PTERMS(:,63,227) = +TPK%KC15(:)*PCONC(:,46)*PCONC(:,56) + PTERMS(:,64,230) = +TPK%KC15(:)*PCONC(:,47)*PCONC(:,57) ! !PTERMS(WC_NO3,KC16) = -KC16*<WC_NO3>*<WC_SO2> - PTERMS(:,46,228) = -TPK%KC16(:)*PCONC(:,46)*PCONC(:,55) + PTERMS(:,47,231) = -TPK%KC16(:)*PCONC(:,47)*PCONC(:,56) ! !PTERMS(WC_HNO3,KC16) = +KC16*<WC_NO3>*<WC_SO2> - PTERMS(:,49,228) = +TPK%KC16(:)*PCONC(:,46)*PCONC(:,55) + PTERMS(:,50,231) = +TPK%KC16(:)*PCONC(:,47)*PCONC(:,56) ! !PTERMS(WC_SO2,KC16) = -KC16*<WC_NO3>*<WC_SO2> - PTERMS(:,55,228) = -TPK%KC16(:)*PCONC(:,46)*PCONC(:,55) + PTERMS(:,56,231) = -TPK%KC16(:)*PCONC(:,47)*PCONC(:,56) ! !PTERMS(WC_ASO3,KC16) = +KC16*<WC_NO3>*<WC_SO2> - PTERMS(:,62,228) = +TPK%KC16(:)*PCONC(:,46)*PCONC(:,55) + PTERMS(:,63,231) = +TPK%KC16(:)*PCONC(:,47)*PCONC(:,56) ! !PTERMS(WC_HO2,KC17) = +2.00*KC17*<WC_MO2>*<WC_MO2> - PTERMS(:,53,229) = +2.00*TPK%KC17(:)*PCONC(:,60)*PCONC(:,60) + PTERMS(:,54,232) = +2.00*TPK%KC17(:)*PCONC(:,61)*PCONC(:,61) ! !PTERMS(WC_HCHO,KC17) = +2.00*KC17*<WC_MO2>*<WC_MO2> - PTERMS(:,57,229) = +2.00*TPK%KC17(:)*PCONC(:,60)*PCONC(:,60) + PTERMS(:,58,232) = +2.00*TPK%KC17(:)*PCONC(:,61)*PCONC(:,61) ! !PTERMS(WC_MO2,KC17) = -KC17*<WC_MO2>*<WC_MO2> - PTERMS(:,60,229) = -TPK%KC17(:)*PCONC(:,60)*PCONC(:,60) + PTERMS(:,61,232) = -TPK%KC17(:)*PCONC(:,61)*PCONC(:,61) ! !PTERMS(WC_SO2,KC18) = -KC18*<WC_MO2>*<WC_SO2> - PTERMS(:,55,230) = -TPK%KC18(:)*PCONC(:,60)*PCONC(:,55) + PTERMS(:,56,233) = -TPK%KC18(:)*PCONC(:,61)*PCONC(:,56) +! +! +RETURN +END SUBROUTINE SUBT40 +! +SUBROUTINE SUBT41 +! +!Indices 821 a 840 ! !PTERMS(WC_MO2,KC18) = -KC18*<WC_MO2>*<WC_SO2> - PTERMS(:,60,230) = -TPK%KC18(:)*PCONC(:,60)*PCONC(:,55) + PTERMS(:,61,233) = -TPK%KC18(:)*PCONC(:,61)*PCONC(:,56) ! !PTERMS(WC_OP1,KC18) = +KC18*<WC_MO2>*<WC_SO2> - PTERMS(:,61,230) = +TPK%KC18(:)*PCONC(:,60)*PCONC(:,55) + PTERMS(:,62,233) = +TPK%KC18(:)*PCONC(:,61)*PCONC(:,56) ! !PTERMS(WC_ASO3,KC18) = +KC18*<WC_MO2>*<WC_SO2> - PTERMS(:,62,230) = +TPK%KC18(:)*PCONC(:,60)*PCONC(:,55) + PTERMS(:,63,233) = +TPK%KC18(:)*PCONC(:,61)*PCONC(:,56) ! !PTERMS(WC_OH,KC19) = -KC19*<WC_HCHO>*<WC_OH> - PTERMS(:,52,231) = -TPK%KC19(:)*PCONC(:,57)*PCONC(:,52) + PTERMS(:,53,234) = -TPK%KC19(:)*PCONC(:,58)*PCONC(:,53) ! !PTERMS(WC_HO2,KC19) = +KC19*<WC_HCHO>*<WC_OH> - PTERMS(:,53,231) = +TPK%KC19(:)*PCONC(:,57)*PCONC(:,52) + PTERMS(:,54,234) = +TPK%KC19(:)*PCONC(:,58)*PCONC(:,53) ! !PTERMS(WC_HCHO,KC19) = -KC19*<WC_HCHO>*<WC_OH> - PTERMS(:,57,231) = -TPK%KC19(:)*PCONC(:,57)*PCONC(:,52) + PTERMS(:,58,234) = -TPK%KC19(:)*PCONC(:,58)*PCONC(:,53) ! !PTERMS(WC_ORA1,KC19) = +KC19*<WC_HCHO>*<WC_OH> - PTERMS(:,58,231) = +TPK%KC19(:)*PCONC(:,57)*PCONC(:,52) + PTERMS(:,59,234) = +TPK%KC19(:)*PCONC(:,58)*PCONC(:,53) ! !PTERMS(WC_OH,KC20) = -KC20*<WC_ORA1>*<WC_OH> - PTERMS(:,52,232) = -TPK%KC20(:)*PCONC(:,58)*PCONC(:,52) + PTERMS(:,53,235) = -TPK%KC20(:)*PCONC(:,59)*PCONC(:,53) ! !PTERMS(WC_HO2,KC20) = +KC20*<WC_ORA1>*<WC_OH> - PTERMS(:,53,232) = +TPK%KC20(:)*PCONC(:,58)*PCONC(:,52) -! -! -RETURN -END SUBROUTINE SUBT40 -! -SUBROUTINE SUBT41 -! -!Indices 821 a 840 + PTERMS(:,54,235) = +TPK%KC20(:)*PCONC(:,59)*PCONC(:,53) ! !PTERMS(WC_CO2,KC20) = +KC20*<WC_ORA1>*<WC_OH> - PTERMS(:,54,232) = +TPK%KC20(:)*PCONC(:,58)*PCONC(:,52) + PTERMS(:,55,235) = +TPK%KC20(:)*PCONC(:,59)*PCONC(:,53) ! !PTERMS(WC_ORA1,KC20) = -KC20*<WC_ORA1>*<WC_OH> - PTERMS(:,58,232) = -TPK%KC20(:)*PCONC(:,58)*PCONC(:,52) + PTERMS(:,59,235) = -TPK%KC20(:)*PCONC(:,59)*PCONC(:,53) ! !PTERMS(WC_SO2,KC21) = -KC21*<WC_SO2>*<WC_HCHO> - PTERMS(:,55,233) = -TPK%KC21(:)*PCONC(:,55)*PCONC(:,57) + PTERMS(:,56,236) = -TPK%KC21(:)*PCONC(:,56)*PCONC(:,58) ! !PTERMS(WC_HCHO,KC21) = -KC21*<WC_SO2>*<WC_HCHO> - PTERMS(:,57,233) = -TPK%KC21(:)*PCONC(:,55)*PCONC(:,57) + PTERMS(:,58,236) = -TPK%KC21(:)*PCONC(:,56)*PCONC(:,58) ! !PTERMS(WC_AHMS,KC21) = +KC21*<WC_SO2>*<WC_HCHO> - PTERMS(:,66,233) = +TPK%KC21(:)*PCONC(:,55)*PCONC(:,57) + PTERMS(:,67,236) = +TPK%KC21(:)*PCONC(:,56)*PCONC(:,58) ! !PTERMS(WC_SO2,KC22) = +KC22*<WC_AHMS> - PTERMS(:,55,234) = +TPK%KC22(:)*PCONC(:,66) + PTERMS(:,56,237) = +TPK%KC22(:)*PCONC(:,67) ! !PTERMS(WC_HCHO,KC22) = +KC22*<WC_AHMS> - PTERMS(:,57,234) = +TPK%KC22(:)*PCONC(:,66) + PTERMS(:,58,237) = +TPK%KC22(:)*PCONC(:,67) ! !PTERMS(WC_AHMS,KC22) = -KC22*<WC_AHMS> - PTERMS(:,66,234) = -TPK%KC22(:)*PCONC(:,66) + PTERMS(:,67,237) = -TPK%KC22(:)*PCONC(:,67) ! !PTERMS(WC_OH,KC23) = -KC23*<WC_AHMS>*<WC_OH> - PTERMS(:,52,235) = -TPK%KC23(:)*PCONC(:,66)*PCONC(:,52) + PTERMS(:,53,238) = -TPK%KC23(:)*PCONC(:,67)*PCONC(:,53) ! !PTERMS(WC_HO2,KC23) = +KC23*<WC_AHMS>*<WC_OH> - PTERMS(:,53,235) = +TPK%KC23(:)*PCONC(:,66)*PCONC(:,52) + PTERMS(:,54,238) = +TPK%KC23(:)*PCONC(:,67)*PCONC(:,53) ! !PTERMS(WC_SO2,KC23) = +KC23*<WC_AHMS>*<WC_OH> - PTERMS(:,55,235) = +TPK%KC23(:)*PCONC(:,66)*PCONC(:,52) + PTERMS(:,56,238) = +TPK%KC23(:)*PCONC(:,67)*PCONC(:,53) +! +! +RETURN +END SUBROUTINE SUBT41 +! +SUBROUTINE SUBT42 +! +!Indices 841 a 860 ! !PTERMS(WC_ORA1,KC23) = +KC23*<WC_AHMS>*<WC_OH> - PTERMS(:,58,235) = +TPK%KC23(:)*PCONC(:,66)*PCONC(:,52) + PTERMS(:,59,238) = +TPK%KC23(:)*PCONC(:,67)*PCONC(:,53) ! !PTERMS(WC_AHMS,KC23) = -KC23*<WC_AHMS>*<WC_OH> - PTERMS(:,66,235) = -TPK%KC23(:)*PCONC(:,66)*PCONC(:,52) + PTERMS(:,67,238) = -TPK%KC23(:)*PCONC(:,67)*PCONC(:,53) ! !PTERMS(WC_ASO3,KC24) = -KC24*<WC_ASO3>*<W_O2> - PTERMS(:,62,236) = -TPK%KC24(:)*PCONC(:,62)*TPK%W_O2(:) + PTERMS(:,63,239) = -TPK%KC24(:)*PCONC(:,63)*TPK%W_O2(:) ! !PTERMS(WC_ASO5,KC24) = +KC24*<WC_ASO3>*<W_O2> - PTERMS(:,64,236) = +TPK%KC24(:)*PCONC(:,62)*TPK%W_O2(:) + PTERMS(:,65,239) = +TPK%KC24(:)*PCONC(:,63)*TPK%W_O2(:) ! !PTERMS(WC_HO2,KC25) = -KC25*<WC_ASO5>*<WC_HO2> - PTERMS(:,53,237) = -TPK%KC25(:)*PCONC(:,64)*PCONC(:,53) + PTERMS(:,54,240) = -TPK%KC25(:)*PCONC(:,65)*PCONC(:,54) ! !PTERMS(WC_ASO5,KC25) = -KC25*<WC_ASO5>*<WC_HO2> - PTERMS(:,64,237) = -TPK%KC25(:)*PCONC(:,64)*PCONC(:,53) + PTERMS(:,65,240) = -TPK%KC25(:)*PCONC(:,65)*PCONC(:,54) ! !PTERMS(WC_AHSO5,KC25) = +KC25*<WC_ASO5>*<WC_HO2> - PTERMS(:,65,237) = +TPK%KC25(:)*PCONC(:,64)*PCONC(:,53) + PTERMS(:,66,240) = +TPK%KC25(:)*PCONC(:,65)*PCONC(:,54) ! !PTERMS(WC_ASO4,KC26) = +KC26*<WC_ASO5>*<WC_ASO5> - PTERMS(:,63,238) = +TPK%KC26(:)*PCONC(:,64)*PCONC(:,64) + PTERMS(:,64,241) = +TPK%KC26(:)*PCONC(:,65)*PCONC(:,65) ! !PTERMS(WC_ASO5,KC26) = -KC26*<WC_ASO5>*<WC_ASO5> - PTERMS(:,64,238) = -TPK%KC26(:)*PCONC(:,64)*PCONC(:,64) -! -! -RETURN -END SUBROUTINE SUBT41 -! -SUBROUTINE SUBT42 -! -!Indices 841 a 860 + PTERMS(:,65,241) = -TPK%KC26(:)*PCONC(:,65)*PCONC(:,65) ! !PTERMS(WC_SO2,KC27) = -KC27*<WC_AHSO5>*<WC_SO2> - PTERMS(:,55,239) = -TPK%KC27(:)*PCONC(:,65)*PCONC(:,55) + PTERMS(:,56,242) = -TPK%KC27(:)*PCONC(:,66)*PCONC(:,56) ! !PTERMS(WC_SULF,KC27) = +2.00*KC27*<WC_AHSO5>*<WC_SO2> - PTERMS(:,56,239) = +2.00*TPK%KC27(:)*PCONC(:,65)*PCONC(:,55) + PTERMS(:,57,242) = +2.00*TPK%KC27(:)*PCONC(:,66)*PCONC(:,56) ! !PTERMS(WC_AHSO5,KC27) = -KC27*<WC_AHSO5>*<WC_SO2> - PTERMS(:,65,239) = -TPK%KC27(:)*PCONC(:,65)*PCONC(:,55) + PTERMS(:,66,242) = -TPK%KC27(:)*PCONC(:,66)*PCONC(:,56) ! !PTERMS(WC_OH,KC28) = +KC28*<WC_ASO4> - PTERMS(:,52,240) = +TPK%KC28(:)*PCONC(:,63) + PTERMS(:,53,243) = +TPK%KC28(:)*PCONC(:,64) ! !PTERMS(WC_SULF,KC28) = +KC28*<WC_ASO4> - PTERMS(:,56,240) = +TPK%KC28(:)*PCONC(:,63) + PTERMS(:,57,243) = +TPK%KC28(:)*PCONC(:,64) ! !PTERMS(WC_ASO4,KC28) = -KC28*<WC_ASO4> - PTERMS(:,63,240) = -TPK%KC28(:)*PCONC(:,63) + PTERMS(:,64,243) = -TPK%KC28(:)*PCONC(:,64) ! !PTERMS(WC_O3,KC29) = -KC29*<WC_SO2>*<WC_O3> - PTERMS(:,42,241) = -TPK%KC29(:)*PCONC(:,55)*PCONC(:,42) + PTERMS(:,43,244) = -TPK%KC29(:)*PCONC(:,56)*PCONC(:,43) ! !PTERMS(WC_SO2,KC29) = -KC29*<WC_SO2>*<WC_O3> - PTERMS(:,55,241) = -TPK%KC29(:)*PCONC(:,55)*PCONC(:,42) + PTERMS(:,56,244) = -TPK%KC29(:)*PCONC(:,56)*PCONC(:,43) ! !PTERMS(WC_SULF,KC29) = +KC29*<WC_SO2>*<WC_O3> - PTERMS(:,56,241) = +TPK%KC29(:)*PCONC(:,55)*PCONC(:,42) + PTERMS(:,57,244) = +TPK%KC29(:)*PCONC(:,56)*PCONC(:,43) ! !PTERMS(WC_H2O2,KC30) = -KC30*<WC_SO2>*<WC_H2O2> - PTERMS(:,43,242) = -TPK%KC30(:)*PCONC(:,55)*PCONC(:,43) + PTERMS(:,44,245) = -TPK%KC30(:)*PCONC(:,56)*PCONC(:,44) ! !PTERMS(WC_SO2,KC30) = -KC30*<WC_SO2>*<WC_H2O2> - PTERMS(:,55,242) = -TPK%KC30(:)*PCONC(:,55)*PCONC(:,43) + PTERMS(:,56,245) = -TPK%KC30(:)*PCONC(:,56)*PCONC(:,44) +! +! +RETURN +END SUBROUTINE SUBT42 +! +SUBROUTINE SUBT43 +! +!Indices 861 a 880 ! !PTERMS(WC_SULF,KC30) = +KC30*<WC_SO2>*<WC_H2O2> - PTERMS(:,56,242) = +TPK%KC30(:)*PCONC(:,55)*PCONC(:,43) + PTERMS(:,57,245) = +TPK%KC30(:)*PCONC(:,56)*PCONC(:,44) ! !PTERMS(WR_H2O2,KR1) = -KR1*<WR_H2O2> - PTERMS(:,68,243) = -TPK%KR1(:)*PCONC(:,68) + PTERMS(:,69,246) = -TPK%KR1(:)*PCONC(:,69) ! !PTERMS(WR_OH,KR1) = +KR1*<WR_H2O2> - PTERMS(:,77,243) = +TPK%KR1(:)*PCONC(:,68) + PTERMS(:,78,246) = +TPK%KR1(:)*PCONC(:,69) ! !PTERMS(WR_H2O2,KR2) = +KR2*<WR_OH>*<WR_OH> - PTERMS(:,68,244) = +TPK%KR2(:)*PCONC(:,77)*PCONC(:,77) + PTERMS(:,69,247) = +TPK%KR2(:)*PCONC(:,78)*PCONC(:,78) ! !PTERMS(WR_OH,KR2) = -KR2*<WR_OH>*<WR_OH> - PTERMS(:,77,244) = -TPK%KR2(:)*PCONC(:,77)*PCONC(:,77) + PTERMS(:,78,247) = -TPK%KR2(:)*PCONC(:,78)*PCONC(:,78) ! !PTERMS(WR_OH,KR3) = -KR3*<WR_OH>*<WR_HO2> - PTERMS(:,77,245) = -TPK%KR3(:)*PCONC(:,77)*PCONC(:,78) + PTERMS(:,78,248) = -TPK%KR3(:)*PCONC(:,78)*PCONC(:,79) ! !PTERMS(WR_HO2,KR3) = -KR3*<WR_OH>*<WR_HO2> - PTERMS(:,78,245) = -TPK%KR3(:)*PCONC(:,77)*PCONC(:,78) + PTERMS(:,79,248) = -TPK%KR3(:)*PCONC(:,78)*PCONC(:,79) ! !PTERMS(WR_H2O2,KR4) = -KR4*<WR_H2O2>*<WR_OH> - PTERMS(:,68,246) = -TPK%KR4(:)*PCONC(:,68)*PCONC(:,77) + PTERMS(:,69,249) = -TPK%KR4(:)*PCONC(:,69)*PCONC(:,78) ! !PTERMS(WR_OH,KR4) = -KR4*<WR_H2O2>*<WR_OH> - PTERMS(:,77,246) = -TPK%KR4(:)*PCONC(:,68)*PCONC(:,77) -! -! -RETURN -END SUBROUTINE SUBT42 -! -SUBROUTINE SUBT43 -! -!Indices 861 a 880 + PTERMS(:,78,249) = -TPK%KR4(:)*PCONC(:,69)*PCONC(:,78) ! !PTERMS(WR_HO2,KR4) = +KR4*<WR_H2O2>*<WR_OH> - PTERMS(:,78,246) = +TPK%KR4(:)*PCONC(:,68)*PCONC(:,77) + PTERMS(:,79,249) = +TPK%KR4(:)*PCONC(:,69)*PCONC(:,78) ! !PTERMS(WR_H2O2,KR5) = +KR5*<WR_HO2>*<WR_HO2> - PTERMS(:,68,247) = +TPK%KR5(:)*PCONC(:,78)*PCONC(:,78) + PTERMS(:,69,250) = +TPK%KR5(:)*PCONC(:,79)*PCONC(:,79) ! !PTERMS(WR_HO2,KR5) = -KR5*<WR_HO2>*<WR_HO2> - PTERMS(:,78,247) = -TPK%KR5(:)*PCONC(:,78)*PCONC(:,78) + PTERMS(:,79,250) = -TPK%KR5(:)*PCONC(:,79)*PCONC(:,79) ! !PTERMS(WR_O3,KR6) = -KR6*<WR_O3>*<WR_HO2> - PTERMS(:,67,248) = -TPK%KR6(:)*PCONC(:,67)*PCONC(:,78) + PTERMS(:,68,251) = -TPK%KR6(:)*PCONC(:,68)*PCONC(:,79) ! !PTERMS(WR_OH,KR6) = +KR6*<WR_O3>*<WR_HO2> - PTERMS(:,77,248) = +TPK%KR6(:)*PCONC(:,67)*PCONC(:,78) + PTERMS(:,78,251) = +TPK%KR6(:)*PCONC(:,68)*PCONC(:,79) ! !PTERMS(WR_HO2,KR6) = -KR6*<WR_O3>*<WR_HO2> - PTERMS(:,78,248) = -TPK%KR6(:)*PCONC(:,67)*PCONC(:,78) + PTERMS(:,79,251) = -TPK%KR6(:)*PCONC(:,68)*PCONC(:,79) ! !PTERMS(WR_OH,KR7) = -KR7*<WR_OH>*<WR_SO2> - PTERMS(:,77,249) = -TPK%KR7(:)*PCONC(:,77)*PCONC(:,80) + PTERMS(:,78,252) = -TPK%KR7(:)*PCONC(:,78)*PCONC(:,81) ! !PTERMS(WR_SO2,KR7) = -KR7*<WR_OH>*<WR_SO2> - PTERMS(:,80,249) = -TPK%KR7(:)*PCONC(:,77)*PCONC(:,80) + PTERMS(:,81,252) = -TPK%KR7(:)*PCONC(:,78)*PCONC(:,81) ! !PTERMS(WR_ASO3,KR7) = +KR7*<WR_OH>*<WR_SO2> - PTERMS(:,87,249) = +TPK%KR7(:)*PCONC(:,77)*PCONC(:,80) + PTERMS(:,88,252) = +TPK%KR7(:)*PCONC(:,78)*PCONC(:,81) ! !PTERMS(WR_NO2,KR8) = +KR8*<WR_HONO>*<WR_OH> - PTERMS(:,70,250) = +TPK%KR8(:)*PCONC(:,73)*PCONC(:,77) + PTERMS(:,71,253) = +TPK%KR8(:)*PCONC(:,74)*PCONC(:,78) ! !PTERMS(WR_HONO,KR8) = -KR8*<WR_HONO>*<WR_OH> - PTERMS(:,73,250) = -TPK%KR8(:)*PCONC(:,73)*PCONC(:,77) + PTERMS(:,74,253) = -TPK%KR8(:)*PCONC(:,74)*PCONC(:,78) +! +! +RETURN +END SUBROUTINE SUBT43 +! +SUBROUTINE SUBT44 +! +!Indices 881 a 900 ! !PTERMS(WR_OH,KR8) = -KR8*<WR_HONO>*<WR_OH> - PTERMS(:,77,250) = -TPK%KR8(:)*PCONC(:,73)*PCONC(:,77) + PTERMS(:,78,253) = -TPK%KR8(:)*PCONC(:,74)*PCONC(:,78) ! !PTERMS(WR_NO2,KR9) = -KR9*<WR_NO2>*<WR_HO2> - PTERMS(:,70,251) = -TPK%KR9(:)*PCONC(:,70)*PCONC(:,78) + PTERMS(:,71,254) = -TPK%KR9(:)*PCONC(:,71)*PCONC(:,79) ! !PTERMS(WR_HNO4,KR9) = +KR9*<WR_NO2>*<WR_HO2> - PTERMS(:,75,251) = +TPK%KR9(:)*PCONC(:,70)*PCONC(:,78) + PTERMS(:,76,254) = +TPK%KR9(:)*PCONC(:,71)*PCONC(:,79) ! !PTERMS(WR_HO2,KR9) = -KR9*<WR_NO2>*<WR_HO2> - PTERMS(:,78,251) = -TPK%KR9(:)*PCONC(:,70)*PCONC(:,78) + PTERMS(:,79,254) = -TPK%KR9(:)*PCONC(:,71)*PCONC(:,79) ! !PTERMS(WR_NO2,KR10) = +KR10*<WR_HNO4> - PTERMS(:,70,252) = +TPK%KR10(:)*PCONC(:,75) + PTERMS(:,71,255) = +TPK%KR10(:)*PCONC(:,76) ! !PTERMS(WR_HNO4,KR10) = -KR10*<WR_HNO4> - PTERMS(:,75,252) = -TPK%KR10(:)*PCONC(:,75) + PTERMS(:,76,255) = -TPK%KR10(:)*PCONC(:,76) ! !PTERMS(WR_HO2,KR10) = +KR10*<WR_HNO4> - PTERMS(:,78,252) = +TPK%KR10(:)*PCONC(:,75) + PTERMS(:,79,255) = +TPK%KR10(:)*PCONC(:,76) ! !PTERMS(WR_HONO,KR11) = +KR11*<WR_HNO4> - PTERMS(:,73,253) = +TPK%KR11(:)*PCONC(:,75) + PTERMS(:,74,256) = +TPK%KR11(:)*PCONC(:,76) ! !PTERMS(WR_HNO4,KR11) = -KR11*<WR_HNO4> - PTERMS(:,75,253) = -TPK%KR11(:)*PCONC(:,75) -! -! -RETURN -END SUBROUTINE SUBT43 -! -SUBROUTINE SUBT44 -! -!Indices 881 a 900 + PTERMS(:,76,256) = -TPK%KR11(:)*PCONC(:,76) ! !PTERMS(WR_HNO3,KR12) = +KR12*<WR_HNO4>*<WR_SO2> - PTERMS(:,74,254) = +TPK%KR12(:)*PCONC(:,75)*PCONC(:,80) + PTERMS(:,75,257) = +TPK%KR12(:)*PCONC(:,76)*PCONC(:,81) ! !PTERMS(WR_HNO4,KR12) = -KR12*<WR_HNO4>*<WR_SO2> - PTERMS(:,75,254) = -TPK%KR12(:)*PCONC(:,75)*PCONC(:,80) + PTERMS(:,76,257) = -TPK%KR12(:)*PCONC(:,76)*PCONC(:,81) ! !PTERMS(WR_SO2,KR12) = -KR12*<WR_HNO4>*<WR_SO2> - PTERMS(:,80,254) = -TPK%KR12(:)*PCONC(:,75)*PCONC(:,80) + PTERMS(:,81,257) = -TPK%KR12(:)*PCONC(:,76)*PCONC(:,81) ! !PTERMS(WR_SULF,KR12) = +KR12*<WR_HNO4>*<WR_SO2> - PTERMS(:,81,254) = +TPK%KR12(:)*PCONC(:,75)*PCONC(:,80) + PTERMS(:,82,257) = +TPK%KR12(:)*PCONC(:,76)*PCONC(:,81) ! !PTERMS(WR_NO2,KR13) = +KR13*<WR_HNO3> - PTERMS(:,70,255) = +TPK%KR13(:)*PCONC(:,74) + PTERMS(:,71,258) = +TPK%KR13(:)*PCONC(:,75) ! !PTERMS(WR_HNO3,KR13) = -KR13*<WR_HNO3> - PTERMS(:,74,255) = -TPK%KR13(:)*PCONC(:,74) + PTERMS(:,75,258) = -TPK%KR13(:)*PCONC(:,75) ! !PTERMS(WR_OH,KR13) = +KR13*<WR_HNO3> - PTERMS(:,77,255) = +TPK%KR13(:)*PCONC(:,74) + PTERMS(:,78,258) = +TPK%KR13(:)*PCONC(:,75) ! !PTERMS(WR_N2O5,KR14) = -KR14*<WR_N2O5> - PTERMS(:,72,256) = -TPK%KR14(:)*PCONC(:,72) + PTERMS(:,73,259) = -TPK%KR14(:)*PCONC(:,73) ! !PTERMS(WR_HNO3,KR14) = +KR14*<WR_N2O5> - PTERMS(:,74,256) = +TPK%KR14(:)*PCONC(:,72) + PTERMS(:,75,259) = +TPK%KR14(:)*PCONC(:,73) ! !PTERMS(WR_NO3,KR15) = -KR15*<WR_NO3>*<WR_SULF> - PTERMS(:,71,257) = -TPK%KR15(:)*PCONC(:,71)*PCONC(:,81) + PTERMS(:,72,260) = -TPK%KR15(:)*PCONC(:,72)*PCONC(:,82) ! !PTERMS(WR_HNO3,KR15) = +KR15*<WR_NO3>*<WR_SULF> - PTERMS(:,74,257) = +TPK%KR15(:)*PCONC(:,71)*PCONC(:,81) + PTERMS(:,75,260) = +TPK%KR15(:)*PCONC(:,72)*PCONC(:,82) +! +! +RETURN +END SUBROUTINE SUBT44 +! +SUBROUTINE SUBT45 +! +!Indices 901 a 920 ! !PTERMS(WR_SULF,KR15) = -KR15*<WR_NO3>*<WR_SULF> - PTERMS(:,81,257) = -TPK%KR15(:)*PCONC(:,71)*PCONC(:,81) + PTERMS(:,82,260) = -TPK%KR15(:)*PCONC(:,72)*PCONC(:,82) ! !PTERMS(WR_ASO4,KR15) = +KR15*<WR_NO3>*<WR_SULF> - PTERMS(:,88,257) = +TPK%KR15(:)*PCONC(:,71)*PCONC(:,81) + PTERMS(:,89,260) = +TPK%KR15(:)*PCONC(:,72)*PCONC(:,82) ! !PTERMS(WR_NO3,KR16) = -KR16*<WR_NO3>*<WR_SO2> - PTERMS(:,71,258) = -TPK%KR16(:)*PCONC(:,71)*PCONC(:,80) + PTERMS(:,72,261) = -TPK%KR16(:)*PCONC(:,72)*PCONC(:,81) ! !PTERMS(WR_HNO3,KR16) = +KR16*<WR_NO3>*<WR_SO2> - PTERMS(:,74,258) = +TPK%KR16(:)*PCONC(:,71)*PCONC(:,80) + PTERMS(:,75,261) = +TPK%KR16(:)*PCONC(:,72)*PCONC(:,81) ! !PTERMS(WR_SO2,KR16) = -KR16*<WR_NO3>*<WR_SO2> - PTERMS(:,80,258) = -TPK%KR16(:)*PCONC(:,71)*PCONC(:,80) + PTERMS(:,81,261) = -TPK%KR16(:)*PCONC(:,72)*PCONC(:,81) ! !PTERMS(WR_ASO3,KR16) = +KR16*<WR_NO3>*<WR_SO2> - PTERMS(:,87,258) = +TPK%KR16(:)*PCONC(:,71)*PCONC(:,80) + PTERMS(:,88,261) = +TPK%KR16(:)*PCONC(:,72)*PCONC(:,81) ! !PTERMS(WR_HO2,KR17) = +2.00*KR17*<WR_MO2>*<WR_MO2> - PTERMS(:,78,259) = +2.00*TPK%KR17(:)*PCONC(:,85)*PCONC(:,85) + PTERMS(:,79,262) = +2.00*TPK%KR17(:)*PCONC(:,86)*PCONC(:,86) ! !PTERMS(WR_HCHO,KR17) = +2.00*KR17*<WR_MO2>*<WR_MO2> - PTERMS(:,82,259) = +2.00*TPK%KR17(:)*PCONC(:,85)*PCONC(:,85) + PTERMS(:,83,262) = +2.00*TPK%KR17(:)*PCONC(:,86)*PCONC(:,86) ! !PTERMS(WR_MO2,KR17) = -KR17*<WR_MO2>*<WR_MO2> - PTERMS(:,85,259) = -TPK%KR17(:)*PCONC(:,85)*PCONC(:,85) -! -! -RETURN -END SUBROUTINE SUBT44 -! -SUBROUTINE SUBT45 -! -!Indices 901 a 920 + PTERMS(:,86,262) = -TPK%KR17(:)*PCONC(:,86)*PCONC(:,86) ! !PTERMS(WR_SO2,KR18) = -KR18*<WR_MO2>*<WR_SO2> - PTERMS(:,80,260) = -TPK%KR18(:)*PCONC(:,85)*PCONC(:,80) + PTERMS(:,81,263) = -TPK%KR18(:)*PCONC(:,86)*PCONC(:,81) ! !PTERMS(WR_MO2,KR18) = -KR18*<WR_MO2>*<WR_SO2> - PTERMS(:,85,260) = -TPK%KR18(:)*PCONC(:,85)*PCONC(:,80) + PTERMS(:,86,263) = -TPK%KR18(:)*PCONC(:,86)*PCONC(:,81) ! !PTERMS(WR_OP1,KR18) = +KR18*<WR_MO2>*<WR_SO2> - PTERMS(:,86,260) = +TPK%KR18(:)*PCONC(:,85)*PCONC(:,80) + PTERMS(:,87,263) = +TPK%KR18(:)*PCONC(:,86)*PCONC(:,81) ! !PTERMS(WR_ASO3,KR18) = +KR18*<WR_MO2>*<WR_SO2> - PTERMS(:,87,260) = +TPK%KR18(:)*PCONC(:,85)*PCONC(:,80) + PTERMS(:,88,263) = +TPK%KR18(:)*PCONC(:,86)*PCONC(:,81) ! !PTERMS(WR_OH,KR19) = -KR19*<WR_HCHO>*<WR_OH> - PTERMS(:,77,261) = -TPK%KR19(:)*PCONC(:,82)*PCONC(:,77) + PTERMS(:,78,264) = -TPK%KR19(:)*PCONC(:,83)*PCONC(:,78) ! !PTERMS(WR_HO2,KR19) = +KR19*<WR_HCHO>*<WR_OH> - PTERMS(:,78,261) = +TPK%KR19(:)*PCONC(:,82)*PCONC(:,77) + PTERMS(:,79,264) = +TPK%KR19(:)*PCONC(:,83)*PCONC(:,78) ! !PTERMS(WR_HCHO,KR19) = -KR19*<WR_HCHO>*<WR_OH> - PTERMS(:,82,261) = -TPK%KR19(:)*PCONC(:,82)*PCONC(:,77) + PTERMS(:,83,264) = -TPK%KR19(:)*PCONC(:,83)*PCONC(:,78) ! !PTERMS(WR_ORA1,KR19) = +KR19*<WR_HCHO>*<WR_OH> - PTERMS(:,83,261) = +TPK%KR19(:)*PCONC(:,82)*PCONC(:,77) + PTERMS(:,84,264) = +TPK%KR19(:)*PCONC(:,83)*PCONC(:,78) ! !PTERMS(WR_OH,KR20) = -KR20*<WR_ORA1>*<WR_OH> - PTERMS(:,77,262) = -TPK%KR20(:)*PCONC(:,83)*PCONC(:,77) + PTERMS(:,78,265) = -TPK%KR20(:)*PCONC(:,84)*PCONC(:,78) ! !PTERMS(WR_HO2,KR20) = +KR20*<WR_ORA1>*<WR_OH> - PTERMS(:,78,262) = +TPK%KR20(:)*PCONC(:,83)*PCONC(:,77) + PTERMS(:,79,265) = +TPK%KR20(:)*PCONC(:,84)*PCONC(:,78) ! !PTERMS(WR_CO2,KR20) = +KR20*<WR_ORA1>*<WR_OH> - PTERMS(:,79,262) = +TPK%KR20(:)*PCONC(:,83)*PCONC(:,77) + PTERMS(:,80,265) = +TPK%KR20(:)*PCONC(:,84)*PCONC(:,78) +! +! +RETURN +END SUBROUTINE SUBT45 +! +SUBROUTINE SUBT46 +! +!Indices 921 a 940 ! !PTERMS(WR_ORA1,KR20) = -KR20*<WR_ORA1>*<WR_OH> - PTERMS(:,83,262) = -TPK%KR20(:)*PCONC(:,83)*PCONC(:,77) + PTERMS(:,84,265) = -TPK%KR20(:)*PCONC(:,84)*PCONC(:,78) ! !PTERMS(WR_SO2,KR21) = -KR21*<WR_SO2>*<WR_HCHO> - PTERMS(:,80,263) = -TPK%KR21(:)*PCONC(:,80)*PCONC(:,82) + PTERMS(:,81,266) = -TPK%KR21(:)*PCONC(:,81)*PCONC(:,83) ! !PTERMS(WR_HCHO,KR21) = -KR21*<WR_SO2>*<WR_HCHO> - PTERMS(:,82,263) = -TPK%KR21(:)*PCONC(:,80)*PCONC(:,82) + PTERMS(:,83,266) = -TPK%KR21(:)*PCONC(:,81)*PCONC(:,83) ! !PTERMS(WR_AHMS,KR21) = +KR21*<WR_SO2>*<WR_HCHO> - PTERMS(:,91,263) = +TPK%KR21(:)*PCONC(:,80)*PCONC(:,82) + PTERMS(:,92,266) = +TPK%KR21(:)*PCONC(:,81)*PCONC(:,83) ! !PTERMS(WR_SO2,KR22) = +KR22*<WR_AHMS> - PTERMS(:,80,264) = +TPK%KR22(:)*PCONC(:,91) + PTERMS(:,81,267) = +TPK%KR22(:)*PCONC(:,92) ! !PTERMS(WR_HCHO,KR22) = +KR22*<WR_AHMS> - PTERMS(:,82,264) = +TPK%KR22(:)*PCONC(:,91) + PTERMS(:,83,267) = +TPK%KR22(:)*PCONC(:,92) ! !PTERMS(WR_AHMS,KR22) = -KR22*<WR_AHMS> - PTERMS(:,91,264) = -TPK%KR22(:)*PCONC(:,91) + PTERMS(:,92,267) = -TPK%KR22(:)*PCONC(:,92) ! !PTERMS(WR_OH,KR23) = -KR23*<WR_AHMS>*<WR_OH> - PTERMS(:,77,265) = -TPK%KR23(:)*PCONC(:,91)*PCONC(:,77) + PTERMS(:,78,268) = -TPK%KR23(:)*PCONC(:,92)*PCONC(:,78) ! !PTERMS(WR_HO2,KR23) = +KR23*<WR_AHMS>*<WR_OH> - PTERMS(:,78,265) = +TPK%KR23(:)*PCONC(:,91)*PCONC(:,77) -! -! -RETURN -END SUBROUTINE SUBT45 -! -SUBROUTINE SUBT46 -! -!Indices 921 a 940 + PTERMS(:,79,268) = +TPK%KR23(:)*PCONC(:,92)*PCONC(:,78) ! !PTERMS(WR_SO2,KR23) = +KR23*<WR_AHMS>*<WR_OH> - PTERMS(:,80,265) = +TPK%KR23(:)*PCONC(:,91)*PCONC(:,77) + PTERMS(:,81,268) = +TPK%KR23(:)*PCONC(:,92)*PCONC(:,78) ! !PTERMS(WR_ORA1,KR23) = +KR23*<WR_AHMS>*<WR_OH> - PTERMS(:,83,265) = +TPK%KR23(:)*PCONC(:,91)*PCONC(:,77) + PTERMS(:,84,268) = +TPK%KR23(:)*PCONC(:,92)*PCONC(:,78) ! !PTERMS(WR_AHMS,KR23) = -KR23*<WR_AHMS>*<WR_OH> - PTERMS(:,91,265) = -TPK%KR23(:)*PCONC(:,91)*PCONC(:,77) + PTERMS(:,92,268) = -TPK%KR23(:)*PCONC(:,92)*PCONC(:,78) ! !PTERMS(WR_ASO3,KR24) = -KR24*<WR_ASO3>*<W_O2> - PTERMS(:,87,266) = -TPK%KR24(:)*PCONC(:,87)*TPK%W_O2(:) + PTERMS(:,88,269) = -TPK%KR24(:)*PCONC(:,88)*TPK%W_O2(:) ! !PTERMS(WR_ASO5,KR24) = +KR24*<WR_ASO3>*<W_O2> - PTERMS(:,89,266) = +TPK%KR24(:)*PCONC(:,87)*TPK%W_O2(:) + PTERMS(:,90,269) = +TPK%KR24(:)*PCONC(:,88)*TPK%W_O2(:) ! !PTERMS(WR_HO2,KR25) = -KR25*<WR_ASO5>*<WR_HO2> - PTERMS(:,78,267) = -TPK%KR25(:)*PCONC(:,89)*PCONC(:,78) + PTERMS(:,79,270) = -TPK%KR25(:)*PCONC(:,90)*PCONC(:,79) ! !PTERMS(WR_ASO5,KR25) = -KR25*<WR_ASO5>*<WR_HO2> - PTERMS(:,89,267) = -TPK%KR25(:)*PCONC(:,89)*PCONC(:,78) + PTERMS(:,90,270) = -TPK%KR25(:)*PCONC(:,90)*PCONC(:,79) ! !PTERMS(WR_AHSO5,KR25) = +KR25*<WR_ASO5>*<WR_HO2> - PTERMS(:,90,267) = +TPK%KR25(:)*PCONC(:,89)*PCONC(:,78) + PTERMS(:,91,270) = +TPK%KR25(:)*PCONC(:,90)*PCONC(:,79) ! !PTERMS(WR_ASO4,KR26) = +KR26*<WR_ASO5>*<WR_ASO5> - PTERMS(:,88,268) = +TPK%KR26(:)*PCONC(:,89)*PCONC(:,89) + PTERMS(:,89,271) = +TPK%KR26(:)*PCONC(:,90)*PCONC(:,90) ! !PTERMS(WR_ASO5,KR26) = -KR26*<WR_ASO5>*<WR_ASO5> - PTERMS(:,89,268) = -TPK%KR26(:)*PCONC(:,89)*PCONC(:,89) + PTERMS(:,90,271) = -TPK%KR26(:)*PCONC(:,90)*PCONC(:,90) ! !PTERMS(WR_SO2,KR27) = -KR27*<WR_AHSO5>*<WR_SO2> - PTERMS(:,80,269) = -TPK%KR27(:)*PCONC(:,90)*PCONC(:,80) + PTERMS(:,81,272) = -TPK%KR27(:)*PCONC(:,91)*PCONC(:,81) +! +! +RETURN +END SUBROUTINE SUBT46 +! +SUBROUTINE SUBT47 +! +!Indices 941 a 951 ! !PTERMS(WR_SULF,KR27) = +2.00*KR27*<WR_AHSO5>*<WR_SO2> - PTERMS(:,81,269) = +2.00*TPK%KR27(:)*PCONC(:,90)*PCONC(:,80) + PTERMS(:,82,272) = +2.00*TPK%KR27(:)*PCONC(:,91)*PCONC(:,81) ! !PTERMS(WR_AHSO5,KR27) = -KR27*<WR_AHSO5>*<WR_SO2> - PTERMS(:,90,269) = -TPK%KR27(:)*PCONC(:,90)*PCONC(:,80) + PTERMS(:,91,272) = -TPK%KR27(:)*PCONC(:,91)*PCONC(:,81) ! !PTERMS(WR_OH,KR28) = +KR28*<WR_ASO4> - PTERMS(:,77,270) = +TPK%KR28(:)*PCONC(:,88) + PTERMS(:,78,273) = +TPK%KR28(:)*PCONC(:,89) ! !PTERMS(WR_SULF,KR28) = +KR28*<WR_ASO4> - PTERMS(:,81,270) = +TPK%KR28(:)*PCONC(:,88) + PTERMS(:,82,273) = +TPK%KR28(:)*PCONC(:,89) ! !PTERMS(WR_ASO4,KR28) = -KR28*<WR_ASO4> - PTERMS(:,88,270) = -TPK%KR28(:)*PCONC(:,88) + PTERMS(:,89,273) = -TPK%KR28(:)*PCONC(:,89) ! !PTERMS(WR_O3,KR29) = -KR29*<WR_SO2>*<WR_O3> - PTERMS(:,67,271) = -TPK%KR29(:)*PCONC(:,80)*PCONC(:,67) + PTERMS(:,68,274) = -TPK%KR29(:)*PCONC(:,81)*PCONC(:,68) ! !PTERMS(WR_SO2,KR29) = -KR29*<WR_SO2>*<WR_O3> - PTERMS(:,80,271) = -TPK%KR29(:)*PCONC(:,80)*PCONC(:,67) + PTERMS(:,81,274) = -TPK%KR29(:)*PCONC(:,81)*PCONC(:,68) ! !PTERMS(WR_SULF,KR29) = +KR29*<WR_SO2>*<WR_O3> - PTERMS(:,81,271) = +TPK%KR29(:)*PCONC(:,80)*PCONC(:,67) + PTERMS(:,82,274) = +TPK%KR29(:)*PCONC(:,81)*PCONC(:,68) ! !PTERMS(WR_H2O2,KR30) = -KR30*<WR_SO2>*<WR_H2O2> - PTERMS(:,68,272) = -TPK%KR30(:)*PCONC(:,80)*PCONC(:,68) -! -! -RETURN -END SUBROUTINE SUBT46 -! -SUBROUTINE SUBT47 -! -!Indices 941 a 942 + PTERMS(:,69,275) = -TPK%KR30(:)*PCONC(:,81)*PCONC(:,69) ! !PTERMS(WR_SO2,KR30) = -KR30*<WR_SO2>*<WR_H2O2> - PTERMS(:,80,272) = -TPK%KR30(:)*PCONC(:,80)*PCONC(:,68) + PTERMS(:,81,275) = -TPK%KR30(:)*PCONC(:,81)*PCONC(:,69) ! !PTERMS(WR_SULF,KR30) = +KR30*<WR_SO2>*<WR_H2O2> - PTERMS(:,81,272) = +TPK%KR30(:)*PCONC(:,80)*PCONC(:,68) + PTERMS(:,82,275) = +TPK%KR30(:)*PCONC(:,81)*PCONC(:,69) ! ! RETURN @@ -33159,7 +33799,7 @@ TPK%O3P(:)=(TPK%K001(:)*PCONC(:,JP_NO2)+TPK%K003(:)*PCONC(:,JP_O3)+TPK%K008(:)*P &0.09000*TPK%K080(:)*PCONC(:,JP_BIO)*PCONC(:,JP_O3))/& &(TPK%K018(:)*TPK%O2(:)+TPK%K019(:)*PCONC(:,JP_O3)+TPK%K029(:)*PCONC(:,JP_NO)+& &TPK%K030(:)*PCONC(:,JP_NO2)+TPK%K031(:)*PCONC(:,JP_NO2)+TPK%K054(:)*PCONC(:,JP_BIO)+& - &TPK%K055(:)*PCONC(:,JP_CARBO)) + &TPK%K055(:)*PCONC(:,JP_CARBO)+TPK%K134(:)*PCONC(:,JP_DMS)) ! /END_CODE/ PTERMS(:,:,:) = 0.0 CALL SUBT0 @@ -33220,7 +33860,7 @@ SUBROUTINE SUBT0 PTERMS(:,7,4) = -TPK%K004(:)*PCONC(:,7) ! !PTERMS(OH,K004) = +K004*<HONO> - PTERMS(:,14,4) = +TPK%K004(:)*PCONC(:,7) + PTERMS(:,15,4) = +TPK%K004(:)*PCONC(:,7) ! !PTERMS(NO2,K005) = +K005*<HNO3> PTERMS(:,4,5) = +TPK%K005(:)*PCONC(:,8) @@ -33229,7 +33869,7 @@ SUBROUTINE SUBT0 PTERMS(:,8,5) = -TPK%K005(:)*PCONC(:,8) ! !PTERMS(OH,K005) = +K005*<HNO3> - PTERMS(:,14,5) = +TPK%K005(:)*PCONC(:,8) + PTERMS(:,15,5) = +TPK%K005(:)*PCONC(:,8) ! !PTERMS(NO2,K006) = +0.65*K006*<HNO4> PTERMS(:,4,6) = +0.65*TPK%K006(:)*PCONC(:,9) @@ -33241,10 +33881,10 @@ SUBROUTINE SUBT0 PTERMS(:,9,6) = -TPK%K006(:)*PCONC(:,9) ! !PTERMS(OH,K006) = +0.35*K006*<HNO4> - PTERMS(:,14,6) = +0.35*TPK%K006(:)*PCONC(:,9) + PTERMS(:,15,6) = +0.35*TPK%K006(:)*PCONC(:,9) ! !PTERMS(HO2,K006) = +0.65*K006*<HNO4> - PTERMS(:,15,6) = +0.65*TPK%K006(:)*PCONC(:,9) + PTERMS(:,16,6) = +0.65*TPK%K006(:)*PCONC(:,9) ! !PTERMS(NO,K007) = +K007*<NO3> PTERMS(:,3,7) = +TPK%K007(:)*PCONC(:,5) @@ -33270,64 +33910,64 @@ SUBROUTINE SUBT1 !Indices 21 a 40 ! !PTERMS(OH,K009) = +K009*<H2O2> - PTERMS(:,14,9) = +TPK%K009(:)*PCONC(:,2) + PTERMS(:,15,9) = +TPK%K009(:)*PCONC(:,2) ! !PTERMS(CO,K010) = +K010*<HCHO> - PTERMS(:,13,10) = +TPK%K010(:)*PCONC(:,22) + PTERMS(:,14,10) = +TPK%K010(:)*PCONC(:,23) ! !PTERMS(HCHO,K010) = -K010*<HCHO> - PTERMS(:,22,10) = -TPK%K010(:)*PCONC(:,22) + PTERMS(:,23,10) = -TPK%K010(:)*PCONC(:,23) ! !PTERMS(CO,K011) = +K011*<HCHO> - PTERMS(:,13,11) = +TPK%K011(:)*PCONC(:,22) + PTERMS(:,14,11) = +TPK%K011(:)*PCONC(:,23) ! !PTERMS(HO2,K011) = +K011*<HCHO> - PTERMS(:,15,11) = +TPK%K011(:)*PCONC(:,22) + PTERMS(:,16,11) = +TPK%K011(:)*PCONC(:,23) ! !PTERMS(HCHO,K011) = -K011*<HCHO> - PTERMS(:,22,11) = -TPK%K011(:)*PCONC(:,22) + PTERMS(:,23,11) = -TPK%K011(:)*PCONC(:,23) ! !PTERMS(CO,K012) = +K012*<ALD> - PTERMS(:,13,12) = +TPK%K012(:)*PCONC(:,23) + PTERMS(:,14,12) = +TPK%K012(:)*PCONC(:,24) ! !PTERMS(HO2,K012) = +K012*<ALD> - PTERMS(:,15,12) = +TPK%K012(:)*PCONC(:,23) + PTERMS(:,16,12) = +TPK%K012(:)*PCONC(:,24) ! !PTERMS(ALD,K012) = -K012*<ALD> - PTERMS(:,23,12) = -TPK%K012(:)*PCONC(:,23) + PTERMS(:,24,12) = -TPK%K012(:)*PCONC(:,24) ! !PTERMS(MO2,K012) = +K012*<ALD> - PTERMS(:,32,12) = +TPK%K012(:)*PCONC(:,23) + PTERMS(:,33,12) = +TPK%K012(:)*PCONC(:,24) ! !PTERMS(OH,K013) = +K013*<OP1> - PTERMS(:,14,13) = +TPK%K013(:)*PCONC(:,28) + PTERMS(:,15,13) = +TPK%K013(:)*PCONC(:,29) ! !PTERMS(HO2,K013) = +K013*<OP1> - PTERMS(:,15,13) = +TPK%K013(:)*PCONC(:,28) + PTERMS(:,16,13) = +TPK%K013(:)*PCONC(:,29) ! !PTERMS(HCHO,K013) = +K013*<OP1> - PTERMS(:,22,13) = +TPK%K013(:)*PCONC(:,28) + PTERMS(:,23,13) = +TPK%K013(:)*PCONC(:,29) ! !PTERMS(OP1,K013) = -K013*<OP1> - PTERMS(:,28,13) = -TPK%K013(:)*PCONC(:,28) + PTERMS(:,29,13) = -TPK%K013(:)*PCONC(:,29) ! !PTERMS(OH,K014) = +K014*<OP2> - PTERMS(:,14,14) = +TPK%K014(:)*PCONC(:,29) + PTERMS(:,15,14) = +TPK%K014(:)*PCONC(:,30) ! !PTERMS(HO2,K014) = +0.96205*K014*<OP2> - PTERMS(:,15,14) = +0.96205*TPK%K014(:)*PCONC(:,29) + PTERMS(:,16,14) = +0.96205*TPK%K014(:)*PCONC(:,30) ! !PTERMS(ALD,K014) = +0.96205*K014*<OP2> - PTERMS(:,23,14) = +0.96205*TPK%K014(:)*PCONC(:,29) + PTERMS(:,24,14) = +0.96205*TPK%K014(:)*PCONC(:,30) ! !PTERMS(OP2,K014) = -K014*<OP2> - PTERMS(:,29,14) = -TPK%K014(:)*PCONC(:,29) + PTERMS(:,30,14) = -TPK%K014(:)*PCONC(:,30) ! !PTERMS(MO2,K014) = +0.03795*K014*<OP2> - PTERMS(:,32,14) = +0.03795*TPK%K014(:)*PCONC(:,29) + PTERMS(:,33,14) = +0.03795*TPK%K014(:)*PCONC(:,30) ! !PTERMS(KET,K015) = -K015*<KET> - PTERMS(:,24,15) = -TPK%K015(:)*PCONC(:,24) + PTERMS(:,25,15) = -TPK%K015(:)*PCONC(:,25) ! ! RETURN @@ -33338,40 +33978,40 @@ SUBROUTINE SUBT2 !Indices 41 a 60 ! !PTERMS(ALKAP,K015) = +1.00000*K015*<KET> - PTERMS(:,33,15) = +1.00000*TPK%K015(:)*PCONC(:,24) + PTERMS(:,34,15) = +1.00000*TPK%K015(:)*PCONC(:,25) ! !PTERMS(CARBOP,K015) = +1.00000*K015*<KET> - PTERMS(:,39,15) = +1.00000*TPK%K015(:)*PCONC(:,24) + PTERMS(:,40,15) = +1.00000*TPK%K015(:)*PCONC(:,25) ! !PTERMS(CO,K016) = +0.91924*K016*<CARBO> - PTERMS(:,13,16) = +0.91924*TPK%K016(:)*PCONC(:,25) + PTERMS(:,14,16) = +0.91924*TPK%K016(:)*PCONC(:,26) ! !PTERMS(HO2,K016) = +0.75830*K016*<CARBO> - PTERMS(:,15,16) = +0.75830*TPK%K016(:)*PCONC(:,25) + PTERMS(:,16,16) = +0.75830*TPK%K016(:)*PCONC(:,26) ! !PTERMS(HCHO,K016) = +0.06517*K016*<CARBO> - PTERMS(:,22,16) = +0.06517*TPK%K016(:)*PCONC(:,25) + PTERMS(:,23,16) = +0.06517*TPK%K016(:)*PCONC(:,26) ! !PTERMS(CARBO,K016) = -K016*<CARBO> - PTERMS(:,25,16) = -TPK%K016(:)*PCONC(:,25) + PTERMS(:,26,16) = -TPK%K016(:)*PCONC(:,26) ! !PTERMS(CARBOP,K016) = +0.69622*K016*<CARBO> - PTERMS(:,39,16) = +0.69622*TPK%K016(:)*PCONC(:,25) + PTERMS(:,40,16) = +0.69622*TPK%K016(:)*PCONC(:,26) ! !PTERMS(NO2,K017) = +K017*<ONIT> - PTERMS(:,4,17) = +TPK%K017(:)*PCONC(:,26) + PTERMS(:,4,17) = +TPK%K017(:)*PCONC(:,27) ! !PTERMS(HO2,K017) = +K017*<ONIT> - PTERMS(:,15,17) = +TPK%K017(:)*PCONC(:,26) + PTERMS(:,16,17) = +TPK%K017(:)*PCONC(:,27) ! !PTERMS(ALD,K017) = +0.20*K017*<ONIT> - PTERMS(:,23,17) = +0.20*TPK%K017(:)*PCONC(:,26) + PTERMS(:,24,17) = +0.20*TPK%K017(:)*PCONC(:,27) ! !PTERMS(KET,K017) = +0.80*K017*<ONIT> - PTERMS(:,24,17) = +0.80*TPK%K017(:)*PCONC(:,26) + PTERMS(:,25,17) = +0.80*TPK%K017(:)*PCONC(:,27) ! !PTERMS(ONIT,K017) = -K017*<ONIT> - PTERMS(:,26,17) = -TPK%K017(:)*PCONC(:,26) + PTERMS(:,27,17) = -TPK%K017(:)*PCONC(:,27) ! !PTERMS(O3,K018) = +K018*<O3P>*<O2> PTERMS(:,1,18) = +TPK%K018(:)*TPK%O3P(:)*TPK%O2(:) @@ -33380,22 +34020,22 @@ SUBROUTINE SUBT2 PTERMS(:,1,19) = -TPK%K019(:)*TPK%O3P(:)*PCONC(:,1) ! !PTERMS(OH,K022) = +K022*<O1D>*<H2O> - PTERMS(:,14,22) = +TPK%K022(:)*TPK%O1D(:)*TPK%H2O(:) + PTERMS(:,15,22) = +TPK%K022(:)*TPK%O1D(:)*TPK%H2O(:) ! !PTERMS(O3,K023) = -K023*<O3>*<OH> - PTERMS(:,1,23) = -TPK%K023(:)*PCONC(:,1)*PCONC(:,14) + PTERMS(:,1,23) = -TPK%K023(:)*PCONC(:,1)*PCONC(:,15) ! !PTERMS(OH,K023) = -K023*<O3>*<OH> - PTERMS(:,14,23) = -TPK%K023(:)*PCONC(:,1)*PCONC(:,14) + PTERMS(:,15,23) = -TPK%K023(:)*PCONC(:,1)*PCONC(:,15) ! !PTERMS(HO2,K023) = +K023*<O3>*<OH> - PTERMS(:,15,23) = +TPK%K023(:)*PCONC(:,1)*PCONC(:,14) + PTERMS(:,16,23) = +TPK%K023(:)*PCONC(:,1)*PCONC(:,15) ! !PTERMS(O3,K024) = -K024*<O3>*<HO2> - PTERMS(:,1,24) = -TPK%K024(:)*PCONC(:,1)*PCONC(:,15) + PTERMS(:,1,24) = -TPK%K024(:)*PCONC(:,1)*PCONC(:,16) ! !PTERMS(OH,K024) = +K024*<O3>*<HO2> - PTERMS(:,14,24) = +TPK%K024(:)*PCONC(:,1)*PCONC(:,15) + PTERMS(:,15,24) = +TPK%K024(:)*PCONC(:,1)*PCONC(:,16) ! ! RETURN @@ -33406,34 +34046,34 @@ SUBROUTINE SUBT3 !Indices 61 a 80 ! !PTERMS(HO2,K024) = -K024*<O3>*<HO2> - PTERMS(:,15,24) = -TPK%K024(:)*PCONC(:,1)*PCONC(:,15) + PTERMS(:,16,24) = -TPK%K024(:)*PCONC(:,1)*PCONC(:,16) ! !PTERMS(OH,K025) = -K025*<OH>*<HO2> - PTERMS(:,14,25) = -TPK%K025(:)*PCONC(:,14)*PCONC(:,15) + PTERMS(:,15,25) = -TPK%K025(:)*PCONC(:,15)*PCONC(:,16) ! !PTERMS(HO2,K025) = -K025*<OH>*<HO2> - PTERMS(:,15,25) = -TPK%K025(:)*PCONC(:,14)*PCONC(:,15) + PTERMS(:,16,25) = -TPK%K025(:)*PCONC(:,15)*PCONC(:,16) ! !PTERMS(H2O2,K026) = -K026*<H2O2>*<OH> - PTERMS(:,2,26) = -TPK%K026(:)*PCONC(:,2)*PCONC(:,14) + PTERMS(:,2,26) = -TPK%K026(:)*PCONC(:,2)*PCONC(:,15) ! !PTERMS(OH,K026) = -K026*<H2O2>*<OH> - PTERMS(:,14,26) = -TPK%K026(:)*PCONC(:,2)*PCONC(:,14) + PTERMS(:,15,26) = -TPK%K026(:)*PCONC(:,2)*PCONC(:,15) ! !PTERMS(HO2,K026) = +K026*<H2O2>*<OH> - PTERMS(:,15,26) = +TPK%K026(:)*PCONC(:,2)*PCONC(:,14) + PTERMS(:,16,26) = +TPK%K026(:)*PCONC(:,2)*PCONC(:,15) ! !PTERMS(H2O2,K027) = +K027*<HO2>*<HO2> - PTERMS(:,2,27) = +TPK%K027(:)*PCONC(:,15)*PCONC(:,15) + PTERMS(:,2,27) = +TPK%K027(:)*PCONC(:,16)*PCONC(:,16) ! !PTERMS(HO2,K027) = -K027*<HO2>*<HO2> - PTERMS(:,15,27) = -TPK%K027(:)*PCONC(:,15)*PCONC(:,15) + PTERMS(:,16,27) = -TPK%K027(:)*PCONC(:,16)*PCONC(:,16) ! !PTERMS(H2O2,K028) = +K028*<HO2>*<HO2>*<H2O> - PTERMS(:,2,28) = +TPK%K028(:)*PCONC(:,15)*PCONC(:,15)*TPK%H2O(:) + PTERMS(:,2,28) = +TPK%K028(:)*PCONC(:,16)*PCONC(:,16)*TPK%H2O(:) ! !PTERMS(HO2,K028) = -K028*<HO2>*<HO2>*<H2O> - PTERMS(:,15,28) = -TPK%K028(:)*PCONC(:,15)*PCONC(:,15)*TPK%H2O(:) + PTERMS(:,16,28) = -TPK%K028(:)*PCONC(:,16)*PCONC(:,16)*TPK%H2O(:) ! !PTERMS(NO,K029) = -K029*<O3P>*<NO> PTERMS(:,3,29) = -TPK%K029(:)*TPK%O3P(:)*PCONC(:,3) @@ -33454,16 +34094,16 @@ SUBROUTINE SUBT3 PTERMS(:,5,31) = +TPK%K031(:)*TPK%O3P(:)*PCONC(:,4) ! !PTERMS(NO,K032) = -K032*<OH>*<NO> - PTERMS(:,3,32) = -TPK%K032(:)*PCONC(:,14)*PCONC(:,3) + PTERMS(:,3,32) = -TPK%K032(:)*PCONC(:,15)*PCONC(:,3) ! !PTERMS(HONO,K032) = +K032*<OH>*<NO> - PTERMS(:,7,32) = +TPK%K032(:)*PCONC(:,14)*PCONC(:,3) + PTERMS(:,7,32) = +TPK%K032(:)*PCONC(:,15)*PCONC(:,3) ! !PTERMS(OH,K032) = -K032*<OH>*<NO> - PTERMS(:,14,32) = -TPK%K032(:)*PCONC(:,14)*PCONC(:,3) + PTERMS(:,15,32) = -TPK%K032(:)*PCONC(:,15)*PCONC(:,3) ! !PTERMS(NO2,K033) = -K033*<OH>*<NO2> - PTERMS(:,4,33) = -TPK%K033(:)*PCONC(:,14)*PCONC(:,4) + PTERMS(:,4,33) = -TPK%K033(:)*PCONC(:,15)*PCONC(:,4) ! ! RETURN @@ -33474,43 +34114,43 @@ SUBROUTINE SUBT4 !Indices 81 a 100 ! !PTERMS(HNO3,K033) = +K033*<OH>*<NO2> - PTERMS(:,8,33) = +TPK%K033(:)*PCONC(:,14)*PCONC(:,4) + PTERMS(:,8,33) = +TPK%K033(:)*PCONC(:,15)*PCONC(:,4) ! !PTERMS(OH,K033) = -K033*<OH>*<NO2> - PTERMS(:,14,33) = -TPK%K033(:)*PCONC(:,14)*PCONC(:,4) + PTERMS(:,15,33) = -TPK%K033(:)*PCONC(:,15)*PCONC(:,4) ! !PTERMS(NO2,K034) = +K034*<OH>*<NO3> - PTERMS(:,4,34) = +TPK%K034(:)*PCONC(:,14)*PCONC(:,5) + PTERMS(:,4,34) = +TPK%K034(:)*PCONC(:,15)*PCONC(:,5) ! !PTERMS(NO3,K034) = -K034*<OH>*<NO3> - PTERMS(:,5,34) = -TPK%K034(:)*PCONC(:,14)*PCONC(:,5) + PTERMS(:,5,34) = -TPK%K034(:)*PCONC(:,15)*PCONC(:,5) ! !PTERMS(OH,K034) = -K034*<OH>*<NO3> - PTERMS(:,14,34) = -TPK%K034(:)*PCONC(:,14)*PCONC(:,5) + PTERMS(:,15,34) = -TPK%K034(:)*PCONC(:,15)*PCONC(:,5) ! !PTERMS(HO2,K034) = +K034*<OH>*<NO3> - PTERMS(:,15,34) = +TPK%K034(:)*PCONC(:,14)*PCONC(:,5) + PTERMS(:,16,34) = +TPK%K034(:)*PCONC(:,15)*PCONC(:,5) ! !PTERMS(NO,K035) = -K035*<HO2>*<NO> - PTERMS(:,3,35) = -TPK%K035(:)*PCONC(:,15)*PCONC(:,3) + PTERMS(:,3,35) = -TPK%K035(:)*PCONC(:,16)*PCONC(:,3) ! !PTERMS(NO2,K035) = +K035*<HO2>*<NO> - PTERMS(:,4,35) = +TPK%K035(:)*PCONC(:,15)*PCONC(:,3) + PTERMS(:,4,35) = +TPK%K035(:)*PCONC(:,16)*PCONC(:,3) ! !PTERMS(OH,K035) = +K035*<HO2>*<NO> - PTERMS(:,14,35) = +TPK%K035(:)*PCONC(:,15)*PCONC(:,3) + PTERMS(:,15,35) = +TPK%K035(:)*PCONC(:,16)*PCONC(:,3) ! !PTERMS(HO2,K035) = -K035*<HO2>*<NO> - PTERMS(:,15,35) = -TPK%K035(:)*PCONC(:,15)*PCONC(:,3) + PTERMS(:,16,35) = -TPK%K035(:)*PCONC(:,16)*PCONC(:,3) ! !PTERMS(NO2,K036) = -K036*<HO2>*<NO2> - PTERMS(:,4,36) = -TPK%K036(:)*PCONC(:,15)*PCONC(:,4) + PTERMS(:,4,36) = -TPK%K036(:)*PCONC(:,16)*PCONC(:,4) ! !PTERMS(HNO4,K036) = +K036*<HO2>*<NO2> - PTERMS(:,9,36) = +TPK%K036(:)*PCONC(:,15)*PCONC(:,4) + PTERMS(:,9,36) = +TPK%K036(:)*PCONC(:,16)*PCONC(:,4) ! !PTERMS(HO2,K036) = -K036*<HO2>*<NO2> - PTERMS(:,15,36) = -TPK%K036(:)*PCONC(:,15)*PCONC(:,4) + PTERMS(:,16,36) = -TPK%K036(:)*PCONC(:,16)*PCONC(:,4) ! !PTERMS(NO2,K037) = +K037*<HNO4> PTERMS(:,4,37) = +TPK%K037(:)*PCONC(:,9) @@ -33519,19 +34159,19 @@ SUBROUTINE SUBT4 PTERMS(:,9,37) = -TPK%K037(:)*PCONC(:,9) ! !PTERMS(HO2,K037) = +K037*<HNO4> - PTERMS(:,15,37) = +TPK%K037(:)*PCONC(:,9) + PTERMS(:,16,37) = +TPK%K037(:)*PCONC(:,9) ! !PTERMS(NO2,K038) = +0.7*K038*<HO2>*<NO3> - PTERMS(:,4,38) = +0.7*TPK%K038(:)*PCONC(:,15)*PCONC(:,5) + PTERMS(:,4,38) = +0.7*TPK%K038(:)*PCONC(:,16)*PCONC(:,5) ! !PTERMS(NO3,K038) = -K038*<HO2>*<NO3> - PTERMS(:,5,38) = -TPK%K038(:)*PCONC(:,15)*PCONC(:,5) + PTERMS(:,5,38) = -TPK%K038(:)*PCONC(:,16)*PCONC(:,5) ! !PTERMS(HNO3,K038) = +0.3*K038*<HO2>*<NO3> - PTERMS(:,8,38) = +0.3*TPK%K038(:)*PCONC(:,15)*PCONC(:,5) + PTERMS(:,8,38) = +0.3*TPK%K038(:)*PCONC(:,16)*PCONC(:,5) ! !PTERMS(OH,K038) = +0.7*K038*<HO2>*<NO3> - PTERMS(:,14,38) = +0.7*TPK%K038(:)*PCONC(:,15)*PCONC(:,5) + PTERMS(:,15,38) = +0.7*TPK%K038(:)*PCONC(:,16)*PCONC(:,5) ! ! RETURN @@ -33542,34 +34182,34 @@ SUBROUTINE SUBT5 !Indices 101 a 120 ! !PTERMS(HO2,K038) = -K038*<HO2>*<NO3> - PTERMS(:,15,38) = -TPK%K038(:)*PCONC(:,15)*PCONC(:,5) + PTERMS(:,16,38) = -TPK%K038(:)*PCONC(:,16)*PCONC(:,5) ! !PTERMS(NO2,K039) = +K039*<OH>*<HONO> - PTERMS(:,4,39) = +TPK%K039(:)*PCONC(:,14)*PCONC(:,7) + PTERMS(:,4,39) = +TPK%K039(:)*PCONC(:,15)*PCONC(:,7) ! !PTERMS(HONO,K039) = -K039*<OH>*<HONO> - PTERMS(:,7,39) = -TPK%K039(:)*PCONC(:,14)*PCONC(:,7) + PTERMS(:,7,39) = -TPK%K039(:)*PCONC(:,15)*PCONC(:,7) ! !PTERMS(OH,K039) = -K039*<OH>*<HONO> - PTERMS(:,14,39) = -TPK%K039(:)*PCONC(:,14)*PCONC(:,7) + PTERMS(:,15,39) = -TPK%K039(:)*PCONC(:,15)*PCONC(:,7) ! !PTERMS(NO3,K040) = +K040*<OH>*<HNO3> - PTERMS(:,5,40) = +TPK%K040(:)*PCONC(:,14)*PCONC(:,8) + PTERMS(:,5,40) = +TPK%K040(:)*PCONC(:,15)*PCONC(:,8) ! !PTERMS(HNO3,K040) = -K040*<OH>*<HNO3> - PTERMS(:,8,40) = -TPK%K040(:)*PCONC(:,14)*PCONC(:,8) + PTERMS(:,8,40) = -TPK%K040(:)*PCONC(:,15)*PCONC(:,8) ! !PTERMS(OH,K040) = -K040*<OH>*<HNO3> - PTERMS(:,14,40) = -TPK%K040(:)*PCONC(:,14)*PCONC(:,8) + PTERMS(:,15,40) = -TPK%K040(:)*PCONC(:,15)*PCONC(:,8) ! !PTERMS(NO2,K041) = +K041*<OH>*<HNO4> - PTERMS(:,4,41) = +TPK%K041(:)*PCONC(:,14)*PCONC(:,9) + PTERMS(:,4,41) = +TPK%K041(:)*PCONC(:,15)*PCONC(:,9) ! !PTERMS(HNO4,K041) = -K041*<OH>*<HNO4> - PTERMS(:,9,41) = -TPK%K041(:)*PCONC(:,14)*PCONC(:,9) + PTERMS(:,9,41) = -TPK%K041(:)*PCONC(:,15)*PCONC(:,9) ! !PTERMS(OH,K041) = -K041*<OH>*<HNO4> - PTERMS(:,14,41) = -TPK%K041(:)*PCONC(:,14)*PCONC(:,9) + PTERMS(:,15,41) = -TPK%K041(:)*PCONC(:,15)*PCONC(:,9) ! !PTERMS(O3,K042) = -K042*<O3>*<NO> PTERMS(:,1,42) = -TPK%K042(:)*PCONC(:,1)*PCONC(:,3) @@ -33646,28 +34286,28 @@ SUBROUTINE SUBT6 PTERMS(:,5,49) = -TPK%K049(:)*PCONC(:,5)*PCONC(:,5) ! !PTERMS(NH3,K050) = -K050*<NH3>*<OH> - PTERMS(:,10,50) = -TPK%K050(:)*PCONC(:,10)*PCONC(:,14) + PTERMS(:,10,50) = -TPK%K050(:)*PCONC(:,10)*PCONC(:,15) ! !PTERMS(OH,K050) = -K050*<NH3>*<OH> - PTERMS(:,14,50) = -TPK%K050(:)*PCONC(:,10)*PCONC(:,14) + PTERMS(:,15,50) = -TPK%K050(:)*PCONC(:,10)*PCONC(:,15) ! !PTERMS(OH,K051) = -K051*<OH>*<H2> - PTERMS(:,14,51) = -TPK%K051(:)*PCONC(:,14)*TPK%H2(:) + PTERMS(:,15,51) = -TPK%K051(:)*PCONC(:,15)*TPK%H2(:) ! !PTERMS(HO2,K051) = +K051*<OH>*<H2> - PTERMS(:,15,51) = +TPK%K051(:)*PCONC(:,14)*TPK%H2(:) + PTERMS(:,16,51) = +TPK%K051(:)*PCONC(:,15)*TPK%H2(:) ! !PTERMS(SO2,K052) = -K052*<OH>*<SO2> - PTERMS(:,11,52) = -TPK%K052(:)*PCONC(:,14)*PCONC(:,11) + PTERMS(:,12,52) = -TPK%K052(:)*PCONC(:,15)*PCONC(:,12) ! !PTERMS(SULF,K052) = +K052*<OH>*<SO2> - PTERMS(:,12,52) = +TPK%K052(:)*PCONC(:,14)*PCONC(:,11) + PTERMS(:,13,52) = +TPK%K052(:)*PCONC(:,15)*PCONC(:,12) ! !PTERMS(OH,K052) = -K052*<OH>*<SO2> - PTERMS(:,14,52) = -TPK%K052(:)*PCONC(:,14)*PCONC(:,11) + PTERMS(:,15,52) = -TPK%K052(:)*PCONC(:,15)*PCONC(:,12) ! !PTERMS(HO2,K052) = +K052*<OH>*<SO2> - PTERMS(:,15,52) = +TPK%K052(:)*PCONC(:,14)*PCONC(:,11) + PTERMS(:,16,52) = +TPK%K052(:)*PCONC(:,15)*PCONC(:,12) ! ! RETURN @@ -33678,64 +34318,64 @@ SUBROUTINE SUBT7 !Indices 141 a 160 ! !PTERMS(CO,K053) = -K053*<CO>*<OH> - PTERMS(:,13,53) = -TPK%K053(:)*PCONC(:,13)*PCONC(:,14) + PTERMS(:,14,53) = -TPK%K053(:)*PCONC(:,14)*PCONC(:,15) ! !PTERMS(OH,K053) = -K053*<CO>*<OH> - PTERMS(:,14,53) = -TPK%K053(:)*PCONC(:,13)*PCONC(:,14) + PTERMS(:,15,53) = -TPK%K053(:)*PCONC(:,14)*PCONC(:,15) ! !PTERMS(HO2,K053) = +K053*<CO>*<OH> - PTERMS(:,15,53) = +TPK%K053(:)*PCONC(:,13)*PCONC(:,14) + PTERMS(:,16,53) = +TPK%K053(:)*PCONC(:,14)*PCONC(:,15) ! !PTERMS(CO,K054) = +0.01*K054*<BIO>*<O3P> - PTERMS(:,13,54) = +0.01*TPK%K054(:)*PCONC(:,20)*TPK%O3P(:) + PTERMS(:,14,54) = +0.01*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:) ! !PTERMS(OH,K054) = +0.02*K054*<BIO>*<O3P> - PTERMS(:,14,54) = +0.02*TPK%K054(:)*PCONC(:,20)*TPK%O3P(:) + PTERMS(:,15,54) = +0.02*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:) ! !PTERMS(HO2,K054) = +0.28*K054*<BIO>*<O3P> - PTERMS(:,15,54) = +0.28*TPK%K054(:)*PCONC(:,20)*TPK%O3P(:) + PTERMS(:,16,54) = +0.28*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:) ! !PTERMS(ALKE,K054) = +0.91868*K054*<BIO>*<O3P> - PTERMS(:,19,54) = +0.91868*TPK%K054(:)*PCONC(:,20)*TPK%O3P(:) + PTERMS(:,20,54) = +0.91868*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:) ! !PTERMS(BIO,K054) = -K054*<BIO>*<O3P> - PTERMS(:,20,54) = -TPK%K054(:)*PCONC(:,20)*TPK%O3P(:) + PTERMS(:,21,54) = -TPK%K054(:)*PCONC(:,21)*TPK%O3P(:) ! !PTERMS(HCHO,K054) = +0.05*K054*<BIO>*<O3P> - PTERMS(:,22,54) = +0.05*TPK%K054(:)*PCONC(:,20)*TPK%O3P(:) + PTERMS(:,23,54) = +0.05*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:) ! !PTERMS(CARBO,K054) = +0.13255*K054*<BIO>*<O3P> - PTERMS(:,25,54) = +0.13255*TPK%K054(:)*PCONC(:,20)*TPK%O3P(:) + PTERMS(:,26,54) = +0.13255*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:) ! !PTERMS(XO2,K054) = +0.15*K054*<BIO>*<O3P> - PTERMS(:,41,54) = +0.15*TPK%K054(:)*PCONC(:,20)*TPK%O3P(:) + PTERMS(:,42,54) = +0.15*TPK%K054(:)*PCONC(:,21)*TPK%O3P(:) ! !PTERMS(ALD,K055) = +K055*<CARBO>*<O3P> - PTERMS(:,23,55) = +TPK%K055(:)*PCONC(:,25)*TPK%O3P(:) + PTERMS(:,24,55) = +TPK%K055(:)*PCONC(:,26)*TPK%O3P(:) ! !PTERMS(CARBO,K055) = -K055*<CARBO>*<O3P> - PTERMS(:,25,55) = -TPK%K055(:)*PCONC(:,25)*TPK%O3P(:) + PTERMS(:,26,55) = -TPK%K055(:)*PCONC(:,26)*TPK%O3P(:) ! !PTERMS(OH,K056) = -K056*<CH4>*<OH> - PTERMS(:,14,56) = -TPK%K056(:)*PCONC(:,16)*PCONC(:,14) + PTERMS(:,15,56) = -TPK%K056(:)*PCONC(:,17)*PCONC(:,15) ! !PTERMS(CH4,K056) = -K056*<CH4>*<OH> - PTERMS(:,16,56) = -TPK%K056(:)*PCONC(:,16)*PCONC(:,14) + PTERMS(:,17,56) = -TPK%K056(:)*PCONC(:,17)*PCONC(:,15) ! !PTERMS(MO2,K056) = +K056*<CH4>*<OH> - PTERMS(:,32,56) = +TPK%K056(:)*PCONC(:,16)*PCONC(:,14) + PTERMS(:,33,56) = +TPK%K056(:)*PCONC(:,17)*PCONC(:,15) ! !PTERMS(OH,K057) = -K057*<ETH>*<OH> - PTERMS(:,14,57) = -TPK%K057(:)*PCONC(:,17)*PCONC(:,14) + PTERMS(:,15,57) = -TPK%K057(:)*PCONC(:,18)*PCONC(:,15) ! !PTERMS(ETH,K057) = -K057*<ETH>*<OH> - PTERMS(:,17,57) = -TPK%K057(:)*PCONC(:,17)*PCONC(:,14) + PTERMS(:,18,57) = -TPK%K057(:)*PCONC(:,18)*PCONC(:,15) ! !PTERMS(ALKAP,K057) = +K057*<ETH>*<OH> - PTERMS(:,33,57) = +TPK%K057(:)*PCONC(:,17)*PCONC(:,14) + PTERMS(:,34,57) = +TPK%K057(:)*PCONC(:,18)*PCONC(:,15) ! !PTERMS(CO,K058) = +0.00878*K058*<ALKA>*<OH> - PTERMS(:,13,58) = +0.00878*TPK%K058(:)*PCONC(:,18)*PCONC(:,14) + PTERMS(:,14,58) = +0.00878*TPK%K058(:)*PCONC(:,19)*PCONC(:,15) ! ! RETURN @@ -33746,64 +34386,64 @@ SUBROUTINE SUBT8 !Indices 161 a 180 ! !PTERMS(OH,K058) = -K058*<ALKA>*<OH> - PTERMS(:,14,58) = -TPK%K058(:)*PCONC(:,18)*PCONC(:,14) + PTERMS(:,15,58) = -TPK%K058(:)*PCONC(:,19)*PCONC(:,15) ! !PTERMS(HO2,K058) = +0.12793*K058*<ALKA>*<OH> - PTERMS(:,15,58) = +0.12793*TPK%K058(:)*PCONC(:,18)*PCONC(:,14) + PTERMS(:,16,58) = +0.12793*TPK%K058(:)*PCONC(:,19)*PCONC(:,15) ! !PTERMS(ALKA,K058) = -K058*<ALKA>*<OH> - PTERMS(:,18,58) = -TPK%K058(:)*PCONC(:,18)*PCONC(:,14) + PTERMS(:,19,58) = -TPK%K058(:)*PCONC(:,19)*PCONC(:,15) ! !PTERMS(HCHO,K058) = +0.00140*K058*<ALKA>*<OH> - PTERMS(:,22,58) = +0.00140*TPK%K058(:)*PCONC(:,18)*PCONC(:,14) + PTERMS(:,23,58) = +0.00140*TPK%K058(:)*PCONC(:,19)*PCONC(:,15) ! !PTERMS(ALD,K058) = +0.08173*K058*<ALKA>*<OH> - PTERMS(:,23,58) = +0.08173*TPK%K058(:)*PCONC(:,18)*PCONC(:,14) + PTERMS(:,24,58) = +0.08173*TPK%K058(:)*PCONC(:,19)*PCONC(:,15) ! !PTERMS(KET,K058) = +0.03498*K058*<ALKA>*<OH> - PTERMS(:,24,58) = +0.03498*TPK%K058(:)*PCONC(:,18)*PCONC(:,14) + PTERMS(:,25,58) = +0.03498*TPK%K058(:)*PCONC(:,19)*PCONC(:,15) ! !PTERMS(CARBO,K058) = +0.00835*K058*<ALKA>*<OH> - PTERMS(:,25,58) = +0.00835*TPK%K058(:)*PCONC(:,18)*PCONC(:,14) + PTERMS(:,26,58) = +0.00835*TPK%K058(:)*PCONC(:,19)*PCONC(:,15) ! !PTERMS(ORA1,K058) = +0.00878*K058*<ALKA>*<OH> - PTERMS(:,30,58) = +0.00878*TPK%K058(:)*PCONC(:,18)*PCONC(:,14) + PTERMS(:,31,58) = +0.00878*TPK%K058(:)*PCONC(:,19)*PCONC(:,15) ! !PTERMS(ALKAP,K058) = +0.87811*K058*<ALKA>*<OH> - PTERMS(:,33,58) = +0.87811*TPK%K058(:)*PCONC(:,18)*PCONC(:,14) + PTERMS(:,34,58) = +0.87811*TPK%K058(:)*PCONC(:,19)*PCONC(:,15) ! !PTERMS(OH,K059) = -K059*<ALKE>*<OH> - PTERMS(:,14,59) = -TPK%K059(:)*PCONC(:,19)*PCONC(:,14) + PTERMS(:,15,59) = -TPK%K059(:)*PCONC(:,20)*PCONC(:,15) ! !PTERMS(ALKE,K059) = -K059*<ALKE>*<OH> - PTERMS(:,19,59) = -TPK%K059(:)*PCONC(:,19)*PCONC(:,14) + PTERMS(:,20,59) = -TPK%K059(:)*PCONC(:,20)*PCONC(:,15) ! !PTERMS(ALKEP,K059) = +1.02529*K059*<ALKE>*<OH> - PTERMS(:,34,59) = +1.02529*TPK%K059(:)*PCONC(:,19)*PCONC(:,14) + PTERMS(:,35,59) = +1.02529*TPK%K059(:)*PCONC(:,20)*PCONC(:,15) ! !PTERMS(BIOP,K059) = +0.00000*K059*<ALKE>*<OH> - PTERMS(:,35,59) = +0.00000*TPK%K059(:)*PCONC(:,19)*PCONC(:,14) + PTERMS(:,36,59) = +0.00000*TPK%K059(:)*PCONC(:,20)*PCONC(:,15) ! !PTERMS(OH,K060) = -K060*<BIO>*<OH> - PTERMS(:,14,60) = -TPK%K060(:)*PCONC(:,20)*PCONC(:,14) + PTERMS(:,15,60) = -TPK%K060(:)*PCONC(:,21)*PCONC(:,15) ! !PTERMS(BIO,K060) = -K060*<BIO>*<OH> - PTERMS(:,20,60) = -TPK%K060(:)*PCONC(:,20)*PCONC(:,14) + PTERMS(:,21,60) = -TPK%K060(:)*PCONC(:,21)*PCONC(:,15) ! !PTERMS(BIOP,K060) = +1.00000*K060*<BIO>*<OH> - PTERMS(:,35,60) = +1.00000*TPK%K060(:)*PCONC(:,20)*PCONC(:,14) + PTERMS(:,36,60) = +1.00000*TPK%K060(:)*PCONC(:,21)*PCONC(:,15) ! !PTERMS(OH,K061) = -K061*<ARO>*<OH> - PTERMS(:,14,61) = -TPK%K061(:)*PCONC(:,21)*PCONC(:,14) + PTERMS(:,15,61) = -TPK%K061(:)*PCONC(:,22)*PCONC(:,15) ! !PTERMS(HO2,K061) = +0.10318*K061*<ARO>*<OH> - PTERMS(:,15,61) = +0.10318*TPK%K061(:)*PCONC(:,21)*PCONC(:,14) + PTERMS(:,16,61) = +0.10318*TPK%K061(:)*PCONC(:,22)*PCONC(:,15) ! !PTERMS(ARO,K061) = -K061*<ARO>*<OH> - PTERMS(:,21,61) = -TPK%K061(:)*PCONC(:,21)*PCONC(:,14) + PTERMS(:,22,61) = -TPK%K061(:)*PCONC(:,22)*PCONC(:,15) ! !PTERMS(PHO,K061) = +0.00276*K061*<ARO>*<OH> - PTERMS(:,36,61) = +0.00276*TPK%K061(:)*PCONC(:,21)*PCONC(:,14) + PTERMS(:,37,61) = +0.00276*TPK%K061(:)*PCONC(:,22)*PCONC(:,15) ! ! RETURN @@ -33814,64 +34454,64 @@ SUBROUTINE SUBT9 !Indices 181 a 200 ! !PTERMS(ADD,K061) = +0.93968*K061*<ARO>*<OH> - PTERMS(:,37,61) = +0.93968*TPK%K061(:)*PCONC(:,21)*PCONC(:,14) + PTERMS(:,38,61) = +0.93968*TPK%K061(:)*PCONC(:,22)*PCONC(:,15) ! !PTERMS(XO2,K061) = +0.10318*K061*<ARO>*<OH> - PTERMS(:,41,61) = +0.10318*TPK%K061(:)*PCONC(:,21)*PCONC(:,14) + PTERMS(:,42,61) = +0.10318*TPK%K061(:)*PCONC(:,22)*PCONC(:,15) ! !PTERMS(CO,K062) = +K062*<HCHO>*<OH> - PTERMS(:,13,62) = +TPK%K062(:)*PCONC(:,22)*PCONC(:,14) + PTERMS(:,14,62) = +TPK%K062(:)*PCONC(:,23)*PCONC(:,15) ! !PTERMS(OH,K062) = -K062*<HCHO>*<OH> - PTERMS(:,14,62) = -TPK%K062(:)*PCONC(:,22)*PCONC(:,14) + PTERMS(:,15,62) = -TPK%K062(:)*PCONC(:,23)*PCONC(:,15) ! !PTERMS(HO2,K062) = +K062*<HCHO>*<OH> - PTERMS(:,15,62) = +TPK%K062(:)*PCONC(:,22)*PCONC(:,14) + PTERMS(:,16,62) = +TPK%K062(:)*PCONC(:,23)*PCONC(:,15) ! !PTERMS(HCHO,K062) = -K062*<HCHO>*<OH> - PTERMS(:,22,62) = -TPK%K062(:)*PCONC(:,22)*PCONC(:,14) + PTERMS(:,23,62) = -TPK%K062(:)*PCONC(:,23)*PCONC(:,15) ! !PTERMS(OH,K063) = -K063*<ALD>*<OH> - PTERMS(:,14,63) = -TPK%K063(:)*PCONC(:,23)*PCONC(:,14) + PTERMS(:,15,63) = -TPK%K063(:)*PCONC(:,24)*PCONC(:,15) ! !PTERMS(ALD,K063) = -K063*<ALD>*<OH> - PTERMS(:,23,63) = -TPK%K063(:)*PCONC(:,23)*PCONC(:,14) + PTERMS(:,24,63) = -TPK%K063(:)*PCONC(:,24)*PCONC(:,15) ! !PTERMS(CARBOP,K063) = +1.00000*K063*<ALD>*<OH> - PTERMS(:,39,63) = +1.00000*TPK%K063(:)*PCONC(:,23)*PCONC(:,14) + PTERMS(:,40,63) = +1.00000*TPK%K063(:)*PCONC(:,24)*PCONC(:,15) ! !PTERMS(OH,K064) = -K064*<KET>*<OH> - PTERMS(:,14,64) = -TPK%K064(:)*PCONC(:,24)*PCONC(:,14) + PTERMS(:,15,64) = -TPK%K064(:)*PCONC(:,25)*PCONC(:,15) ! !PTERMS(KET,K064) = -K064*<KET>*<OH> - PTERMS(:,24,64) = -TPK%K064(:)*PCONC(:,24)*PCONC(:,14) + PTERMS(:,25,64) = -TPK%K064(:)*PCONC(:,25)*PCONC(:,15) ! !PTERMS(CARBOP,K064) = +1.00000*K064*<KET>*<OH> - PTERMS(:,39,64) = +1.00000*TPK%K064(:)*PCONC(:,24)*PCONC(:,14) + PTERMS(:,40,64) = +1.00000*TPK%K064(:)*PCONC(:,25)*PCONC(:,15) ! !PTERMS(CO,K065) = +1.01732*K065*<CARBO>*<OH> - PTERMS(:,13,65) = +1.01732*TPK%K065(:)*PCONC(:,25)*PCONC(:,14) + PTERMS(:,14,65) = +1.01732*TPK%K065(:)*PCONC(:,26)*PCONC(:,15) ! !PTERMS(OH,K065) = -K065*<CARBO>*<OH> - PTERMS(:,14,65) = -TPK%K065(:)*PCONC(:,25)*PCONC(:,14) + PTERMS(:,15,65) = -TPK%K065(:)*PCONC(:,26)*PCONC(:,15) ! !PTERMS(HO2,K065) = +0.51208*K065*<CARBO>*<OH> - PTERMS(:,15,65) = +0.51208*TPK%K065(:)*PCONC(:,25)*PCONC(:,14) + PTERMS(:,16,65) = +0.51208*TPK%K065(:)*PCONC(:,26)*PCONC(:,15) ! !PTERMS(HCHO,K065) = +0.00000*K065*<CARBO>*<OH> - PTERMS(:,22,65) = +0.00000*TPK%K065(:)*PCONC(:,25)*PCONC(:,14) + PTERMS(:,23,65) = +0.00000*TPK%K065(:)*PCONC(:,26)*PCONC(:,15) ! !PTERMS(ALD,K065) = +0.06253*K065*<CARBO>*<OH> - PTERMS(:,23,65) = +0.06253*TPK%K065(:)*PCONC(:,25)*PCONC(:,14) + PTERMS(:,24,65) = +0.06253*TPK%K065(:)*PCONC(:,26)*PCONC(:,15) ! !PTERMS(KET,K065) = +0.00853*K065*<CARBO>*<OH> - PTERMS(:,24,65) = +0.00853*TPK%K065(:)*PCONC(:,25)*PCONC(:,14) + PTERMS(:,25,65) = +0.00853*TPK%K065(:)*PCONC(:,26)*PCONC(:,15) ! !PTERMS(CARBO,K065) = -K065*<CARBO>*<OH> - PTERMS(:,25,65) = -TPK%K065(:)*PCONC(:,25)*PCONC(:,14) + PTERMS(:,26,65) = -TPK%K065(:)*PCONC(:,26)*PCONC(:,15) ! !PTERMS(CARBOP,K065) = +0.51419*K065*<CARBO>*<OH> - PTERMS(:,39,65) = +0.51419*TPK%K065(:)*PCONC(:,25)*PCONC(:,14) + PTERMS(:,40,65) = +0.51419*TPK%K065(:)*PCONC(:,26)*PCONC(:,15) ! ! RETURN @@ -33882,64 +34522,64 @@ SUBROUTINE SUBT10 !Indices 201 a 220 ! !PTERMS(XO2,K065) = +0.10162*K065*<CARBO>*<OH> - PTERMS(:,41,65) = +0.10162*TPK%K065(:)*PCONC(:,25)*PCONC(:,14) + PTERMS(:,42,65) = +0.10162*TPK%K065(:)*PCONC(:,26)*PCONC(:,15) ! !PTERMS(OH,K066) = -K066*<ORA1>*<OH> - PTERMS(:,14,66) = -TPK%K066(:)*PCONC(:,30)*PCONC(:,14) + PTERMS(:,15,66) = -TPK%K066(:)*PCONC(:,31)*PCONC(:,15) ! !PTERMS(HO2,K066) = +K066*<ORA1>*<OH> - PTERMS(:,15,66) = +TPK%K066(:)*PCONC(:,30)*PCONC(:,14) + PTERMS(:,16,66) = +TPK%K066(:)*PCONC(:,31)*PCONC(:,15) ! !PTERMS(ORA1,K066) = -K066*<ORA1>*<OH> - PTERMS(:,30,66) = -TPK%K066(:)*PCONC(:,30)*PCONC(:,14) + PTERMS(:,31,66) = -TPK%K066(:)*PCONC(:,31)*PCONC(:,15) ! !PTERMS(OH,K067) = -K067*<ORA2>*<OH> - PTERMS(:,14,67) = -TPK%K067(:)*PCONC(:,31)*PCONC(:,14) + PTERMS(:,15,67) = -TPK%K067(:)*PCONC(:,32)*PCONC(:,15) ! !PTERMS(ORA2,K067) = -K067*<ORA2>*<OH> - PTERMS(:,31,67) = -TPK%K067(:)*PCONC(:,31)*PCONC(:,14) + PTERMS(:,32,67) = -TPK%K067(:)*PCONC(:,32)*PCONC(:,15) ! !PTERMS(OH,K068) = -K068*<OP1>*<OH> - PTERMS(:,14,68) = -TPK%K068(:)*PCONC(:,28)*PCONC(:,14) + PTERMS(:,15,68) = -TPK%K068(:)*PCONC(:,29)*PCONC(:,15) ! !PTERMS(HCHO,K068) = +0.35*K068*<OP1>*<OH> - PTERMS(:,22,68) = +0.35*TPK%K068(:)*PCONC(:,28)*PCONC(:,14) + PTERMS(:,23,68) = +0.35*TPK%K068(:)*PCONC(:,29)*PCONC(:,15) ! !PTERMS(OP1,K068) = -K068*<OP1>*<OH> - PTERMS(:,28,68) = -TPK%K068(:)*PCONC(:,28)*PCONC(:,14) + PTERMS(:,29,68) = -TPK%K068(:)*PCONC(:,29)*PCONC(:,15) ! !PTERMS(MO2,K068) = +0.65*K068*<OP1>*<OH> - PTERMS(:,32,68) = +0.65*TPK%K068(:)*PCONC(:,28)*PCONC(:,14) + PTERMS(:,33,68) = +0.65*TPK%K068(:)*PCONC(:,29)*PCONC(:,15) ! !PTERMS(OH,K069) = -K069*<OP2>*<OH> - PTERMS(:,14,69) = -TPK%K069(:)*PCONC(:,29)*PCONC(:,14) + PTERMS(:,15,69) = -TPK%K069(:)*PCONC(:,30)*PCONC(:,15) ! !PTERMS(HO2,K069) = +0.02915*K069*<OP2>*<OH> - PTERMS(:,15,69) = +0.02915*TPK%K069(:)*PCONC(:,29)*PCONC(:,14) + PTERMS(:,16,69) = +0.02915*TPK%K069(:)*PCONC(:,30)*PCONC(:,15) ! !PTERMS(HCHO,K069) = +0.02915*K069*<OP2>*<OH> - PTERMS(:,22,69) = +0.02915*TPK%K069(:)*PCONC(:,29)*PCONC(:,14) + PTERMS(:,23,69) = +0.02915*TPK%K069(:)*PCONC(:,30)*PCONC(:,15) ! !PTERMS(ALD,K069) = +0.07335*K069*<OP2>*<OH> - PTERMS(:,23,69) = +0.07335*TPK%K069(:)*PCONC(:,29)*PCONC(:,14) + PTERMS(:,24,69) = +0.07335*TPK%K069(:)*PCONC(:,30)*PCONC(:,15) ! !PTERMS(KET,K069) = +0.37591*K069*<OP2>*<OH> - PTERMS(:,24,69) = +0.37591*TPK%K069(:)*PCONC(:,29)*PCONC(:,14) + PTERMS(:,25,69) = +0.37591*TPK%K069(:)*PCONC(:,30)*PCONC(:,15) ! !PTERMS(OP2,K069) = -K069*<OP2>*<OH> - PTERMS(:,29,69) = -TPK%K069(:)*PCONC(:,29)*PCONC(:,14) + PTERMS(:,30,69) = -TPK%K069(:)*PCONC(:,30)*PCONC(:,15) ! !PTERMS(ALKAP,K069) = +0.40341*K069*<OP2>*<OH> - PTERMS(:,33,69) = +0.40341*TPK%K069(:)*PCONC(:,29)*PCONC(:,14) + PTERMS(:,34,69) = +0.40341*TPK%K069(:)*PCONC(:,30)*PCONC(:,15) ! !PTERMS(CARBOP,K069) = +0.05413*K069*<OP2>*<OH> - PTERMS(:,39,69) = +0.05413*TPK%K069(:)*PCONC(:,29)*PCONC(:,14) + PTERMS(:,40,69) = +0.05413*TPK%K069(:)*PCONC(:,30)*PCONC(:,15) ! !PTERMS(XO2,K069) = +0.09333*K069*<OP2>*<OH> - PTERMS(:,41,69) = +0.09333*TPK%K069(:)*PCONC(:,29)*PCONC(:,14) + PTERMS(:,42,69) = +0.09333*TPK%K069(:)*PCONC(:,30)*PCONC(:,15) ! !PTERMS(NO3,K070) = +0.71893*K070*<PAN>*<OH> - PTERMS(:,5,70) = +0.71893*TPK%K070(:)*PCONC(:,27)*PCONC(:,14) + PTERMS(:,5,70) = +0.71893*TPK%K070(:)*PCONC(:,28)*PCONC(:,15) ! ! RETURN @@ -33950,64 +34590,64 @@ SUBROUTINE SUBT11 !Indices 221 a 240 ! !PTERMS(OH,K070) = -K070*<PAN>*<OH> - PTERMS(:,14,70) = -TPK%K070(:)*PCONC(:,27)*PCONC(:,14) + PTERMS(:,15,70) = -TPK%K070(:)*PCONC(:,28)*PCONC(:,15) ! !PTERMS(HO2,K070) = +0.28107*K070*<PAN>*<OH> - PTERMS(:,15,70) = +0.28107*TPK%K070(:)*PCONC(:,27)*PCONC(:,14) + PTERMS(:,16,70) = +0.28107*TPK%K070(:)*PCONC(:,28)*PCONC(:,15) ! !PTERMS(HCHO,K070) = +0.57839*K070*<PAN>*<OH> - PTERMS(:,22,70) = +0.57839*TPK%K070(:)*PCONC(:,27)*PCONC(:,14) + PTERMS(:,23,70) = +0.57839*TPK%K070(:)*PCONC(:,28)*PCONC(:,15) ! !PTERMS(CARBO,K070) = +0.21863*K070*<PAN>*<OH> - PTERMS(:,25,70) = +0.21863*TPK%K070(:)*PCONC(:,27)*PCONC(:,14) + PTERMS(:,26,70) = +0.21863*TPK%K070(:)*PCONC(:,28)*PCONC(:,15) ! !PTERMS(PAN,K070) = -K070*<PAN>*<OH> - PTERMS(:,27,70) = -TPK%K070(:)*PCONC(:,27)*PCONC(:,14) + PTERMS(:,28,70) = -TPK%K070(:)*PCONC(:,28)*PCONC(:,15) ! !PTERMS(XO2,K070) = +K070*<PAN>*<OH> - PTERMS(:,41,70) = +TPK%K070(:)*PCONC(:,27)*PCONC(:,14) + PTERMS(:,42,70) = +TPK%K070(:)*PCONC(:,28)*PCONC(:,15) ! !PTERMS(NO2,K071) = +K071*<ONIT>*<OH> - PTERMS(:,4,71) = +TPK%K071(:)*PCONC(:,26)*PCONC(:,14) + PTERMS(:,4,71) = +TPK%K071(:)*PCONC(:,27)*PCONC(:,15) ! !PTERMS(OH,K071) = -K071*<ONIT>*<OH> - PTERMS(:,14,71) = -TPK%K071(:)*PCONC(:,26)*PCONC(:,14) + PTERMS(:,15,71) = -TPK%K071(:)*PCONC(:,27)*PCONC(:,15) ! !PTERMS(ONIT,K071) = -K071*<ONIT>*<OH> - PTERMS(:,26,71) = -TPK%K071(:)*PCONC(:,26)*PCONC(:,14) + PTERMS(:,27,71) = -TPK%K071(:)*PCONC(:,27)*PCONC(:,15) ! !PTERMS(ALKAP,K071) = +1.00000*K071*<ONIT>*<OH> - PTERMS(:,33,71) = +1.00000*TPK%K071(:)*PCONC(:,26)*PCONC(:,14) + PTERMS(:,34,71) = +1.00000*TPK%K071(:)*PCONC(:,27)*PCONC(:,15) ! !PTERMS(NO3,K072) = -K072*<HCHO>*<NO3> - PTERMS(:,5,72) = -TPK%K072(:)*PCONC(:,22)*PCONC(:,5) + PTERMS(:,5,72) = -TPK%K072(:)*PCONC(:,23)*PCONC(:,5) ! !PTERMS(HNO3,K072) = +K072*<HCHO>*<NO3> - PTERMS(:,8,72) = +TPK%K072(:)*PCONC(:,22)*PCONC(:,5) + PTERMS(:,8,72) = +TPK%K072(:)*PCONC(:,23)*PCONC(:,5) ! !PTERMS(CO,K072) = +K072*<HCHO>*<NO3> - PTERMS(:,13,72) = +TPK%K072(:)*PCONC(:,22)*PCONC(:,5) + PTERMS(:,14,72) = +TPK%K072(:)*PCONC(:,23)*PCONC(:,5) ! !PTERMS(HO2,K072) = +K072*<HCHO>*<NO3> - PTERMS(:,15,72) = +TPK%K072(:)*PCONC(:,22)*PCONC(:,5) + PTERMS(:,16,72) = +TPK%K072(:)*PCONC(:,23)*PCONC(:,5) ! !PTERMS(HCHO,K072) = -K072*<HCHO>*<NO3> - PTERMS(:,22,72) = -TPK%K072(:)*PCONC(:,22)*PCONC(:,5) + PTERMS(:,23,72) = -TPK%K072(:)*PCONC(:,23)*PCONC(:,5) ! !PTERMS(NO3,K073) = -K073*<ALD>*<NO3> - PTERMS(:,5,73) = -TPK%K073(:)*PCONC(:,23)*PCONC(:,5) + PTERMS(:,5,73) = -TPK%K073(:)*PCONC(:,24)*PCONC(:,5) ! !PTERMS(HNO3,K073) = +K073*<ALD>*<NO3> - PTERMS(:,8,73) = +TPK%K073(:)*PCONC(:,23)*PCONC(:,5) + PTERMS(:,8,73) = +TPK%K073(:)*PCONC(:,24)*PCONC(:,5) ! !PTERMS(ALD,K073) = -K073*<ALD>*<NO3> - PTERMS(:,23,73) = -TPK%K073(:)*PCONC(:,23)*PCONC(:,5) + PTERMS(:,24,73) = -TPK%K073(:)*PCONC(:,24)*PCONC(:,5) ! !PTERMS(CARBOP,K073) = +1.00000*K073*<ALD>*<NO3> - PTERMS(:,39,73) = +1.00000*TPK%K073(:)*PCONC(:,23)*PCONC(:,5) + PTERMS(:,40,73) = +1.00000*TPK%K073(:)*PCONC(:,24)*PCONC(:,5) ! !PTERMS(NO2,K074) = +0.10530*K074*<CARBO>*<NO3> - PTERMS(:,4,74) = +0.10530*TPK%K074(:)*PCONC(:,25)*PCONC(:,5) + PTERMS(:,4,74) = +0.10530*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) ! ! RETURN @@ -34018,64 +34658,64 @@ SUBROUTINE SUBT12 !Indices 241 a 260 ! !PTERMS(NO3,K074) = -K074*<CARBO>*<NO3> - PTERMS(:,5,74) = -TPK%K074(:)*PCONC(:,25)*PCONC(:,5) + PTERMS(:,5,74) = -TPK%K074(:)*PCONC(:,26)*PCONC(:,5) ! !PTERMS(HNO3,K074) = +0.91567*K074*<CARBO>*<NO3> - PTERMS(:,8,74) = +0.91567*TPK%K074(:)*PCONC(:,25)*PCONC(:,5) + PTERMS(:,8,74) = +0.91567*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) ! !PTERMS(CO,K074) = +1.33723*K074*<CARBO>*<NO3> - PTERMS(:,13,74) = +1.33723*TPK%K074(:)*PCONC(:,25)*PCONC(:,5) + PTERMS(:,14,74) = +1.33723*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) ! !PTERMS(HO2,K074) = +0.63217*K074*<CARBO>*<NO3> - PTERMS(:,15,74) = +0.63217*TPK%K074(:)*PCONC(:,25)*PCONC(:,5) + PTERMS(:,16,74) = +0.63217*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) ! !PTERMS(ALD,K074) = +0.05265*K074*<CARBO>*<NO3> - PTERMS(:,23,74) = +0.05265*TPK%K074(:)*PCONC(:,25)*PCONC(:,5) + PTERMS(:,24,74) = +0.05265*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) ! !PTERMS(KET,K074) = +0.00632*K074*<CARBO>*<NO3> - PTERMS(:,24,74) = +0.00632*TPK%K074(:)*PCONC(:,25)*PCONC(:,5) + PTERMS(:,25,74) = +0.00632*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) ! !PTERMS(CARBO,K074) = -K074*<CARBO>*<NO3> - PTERMS(:,25,74) = -TPK%K074(:)*PCONC(:,25)*PCONC(:,5) + PTERMS(:,26,74) = -TPK%K074(:)*PCONC(:,26)*PCONC(:,5) ! !PTERMS(CARBOP,K074) = +0.38881*K074*<CARBO>*<NO3> - PTERMS(:,39,74) = +0.38881*TPK%K074(:)*PCONC(:,25)*PCONC(:,5) + PTERMS(:,40,74) = +0.38881*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) ! !PTERMS(OLN,K074) = +0.00000*K074*<CARBO>*<NO3> - PTERMS(:,40,74) = +0.00000*TPK%K074(:)*PCONC(:,25)*PCONC(:,5) + PTERMS(:,41,74) = +0.00000*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) ! !PTERMS(XO2,K074) = +0.10530*K074*<CARBO>*<NO3> - PTERMS(:,41,74) = +0.10530*TPK%K074(:)*PCONC(:,25)*PCONC(:,5) + PTERMS(:,42,74) = +0.10530*TPK%K074(:)*PCONC(:,26)*PCONC(:,5) ! !PTERMS(NO3,K075) = -K075*<ARO>*<NO3> - PTERMS(:,5,75) = -TPK%K075(:)*PCONC(:,21)*PCONC(:,5) + PTERMS(:,5,75) = -TPK%K075(:)*PCONC(:,22)*PCONC(:,5) ! !PTERMS(HNO3,K075) = +K075*<ARO>*<NO3> - PTERMS(:,8,75) = +TPK%K075(:)*PCONC(:,21)*PCONC(:,5) + PTERMS(:,8,75) = +TPK%K075(:)*PCONC(:,22)*PCONC(:,5) ! !PTERMS(ARO,K075) = -K075*<ARO>*<NO3> - PTERMS(:,21,75) = -TPK%K075(:)*PCONC(:,21)*PCONC(:,5) + PTERMS(:,22,75) = -TPK%K075(:)*PCONC(:,22)*PCONC(:,5) ! !PTERMS(PHO,K075) = +K075*<ARO>*<NO3> - PTERMS(:,36,75) = +TPK%K075(:)*PCONC(:,21)*PCONC(:,5) + PTERMS(:,37,75) = +TPK%K075(:)*PCONC(:,22)*PCONC(:,5) ! !PTERMS(NO3,K076) = -K076*<ALKE>*<NO3> - PTERMS(:,5,76) = -TPK%K076(:)*PCONC(:,19)*PCONC(:,5) + PTERMS(:,5,76) = -TPK%K076(:)*PCONC(:,20)*PCONC(:,5) ! !PTERMS(ALKE,K076) = -K076*<ALKE>*<NO3> - PTERMS(:,19,76) = -TPK%K076(:)*PCONC(:,19)*PCONC(:,5) + PTERMS(:,20,76) = -TPK%K076(:)*PCONC(:,20)*PCONC(:,5) ! !PTERMS(CARBO,K076) = +0.00000*K076*<ALKE>*<NO3> - PTERMS(:,25,76) = +0.00000*TPK%K076(:)*PCONC(:,19)*PCONC(:,5) + PTERMS(:,26,76) = +0.00000*TPK%K076(:)*PCONC(:,20)*PCONC(:,5) ! !PTERMS(OLN,K076) = +0.93768*K076*<ALKE>*<NO3> - PTERMS(:,40,76) = +0.93768*TPK%K076(:)*PCONC(:,19)*PCONC(:,5) + PTERMS(:,41,76) = +0.93768*TPK%K076(:)*PCONC(:,20)*PCONC(:,5) ! !PTERMS(NO3,K077) = -K077*<BIO>*<NO3> - PTERMS(:,5,77) = -TPK%K077(:)*PCONC(:,20)*PCONC(:,5) + PTERMS(:,5,77) = -TPK%K077(:)*PCONC(:,21)*PCONC(:,5) ! !PTERMS(BIO,K077) = -K077*<BIO>*<NO3> - PTERMS(:,20,77) = -TPK%K077(:)*PCONC(:,20)*PCONC(:,5) + PTERMS(:,21,77) = -TPK%K077(:)*PCONC(:,21)*PCONC(:,5) ! ! RETURN @@ -34086,64 +34726,64 @@ SUBROUTINE SUBT13 !Indices 261 a 280 ! !PTERMS(CARBO,K077) = +0.91741*K077*<BIO>*<NO3> - PTERMS(:,25,77) = +0.91741*TPK%K077(:)*PCONC(:,20)*PCONC(:,5) + PTERMS(:,26,77) = +0.91741*TPK%K077(:)*PCONC(:,21)*PCONC(:,5) ! !PTERMS(OLN,K077) = +1.00000*K077*<BIO>*<NO3> - PTERMS(:,40,77) = +1.00000*TPK%K077(:)*PCONC(:,20)*PCONC(:,5) + PTERMS(:,41,77) = +1.00000*TPK%K077(:)*PCONC(:,21)*PCONC(:,5) ! !PTERMS(NO2,K078) = +0.40*K078*<PAN>*<NO3> - PTERMS(:,4,78) = +0.40*TPK%K078(:)*PCONC(:,27)*PCONC(:,5) + PTERMS(:,4,78) = +0.40*TPK%K078(:)*PCONC(:,28)*PCONC(:,5) ! !PTERMS(NO3,K078) = -K078*<PAN>*<NO3> - PTERMS(:,5,78) = -TPK%K078(:)*PCONC(:,27)*PCONC(:,5) + PTERMS(:,5,78) = -TPK%K078(:)*PCONC(:,28)*PCONC(:,5) ! !PTERMS(HCHO,K078) = +0.40*K078*<PAN>*<NO3> - PTERMS(:,22,78) = +0.40*TPK%K078(:)*PCONC(:,27)*PCONC(:,5) + PTERMS(:,23,78) = +0.40*TPK%K078(:)*PCONC(:,28)*PCONC(:,5) ! !PTERMS(ONIT,K078) = +0.60*K078*<PAN>*<NO3> - PTERMS(:,26,78) = +0.60*TPK%K078(:)*PCONC(:,27)*PCONC(:,5) + PTERMS(:,27,78) = +0.60*TPK%K078(:)*PCONC(:,28)*PCONC(:,5) ! !PTERMS(PAN,K078) = -K078*<PAN>*<NO3> - PTERMS(:,27,78) = -TPK%K078(:)*PCONC(:,27)*PCONC(:,5) + PTERMS(:,28,78) = -TPK%K078(:)*PCONC(:,28)*PCONC(:,5) ! !PTERMS(XO2,K078) = +K078*<PAN>*<NO3> - PTERMS(:,41,78) = +TPK%K078(:)*PCONC(:,27)*PCONC(:,5) + PTERMS(:,42,78) = +TPK%K078(:)*PCONC(:,28)*PCONC(:,5) ! !PTERMS(O3,K079) = -K079*<ALKE>*<O3> - PTERMS(:,1,79) = -TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,1,79) = -TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(H2O2,K079) = +0.01833*K079*<ALKE>*<O3> - PTERMS(:,2,79) = +0.01833*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,2,79) = +0.01833*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(CO,K079) = +0.35120*K079*<ALKE>*<O3> - PTERMS(:,13,79) = +0.35120*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,14,79) = +0.35120*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(OH,K079) = +0.39435*K079*<ALKE>*<O3> - PTERMS(:,14,79) = +0.39435*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,15,79) = +0.39435*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(HO2,K079) = +0.23451*K079*<ALKE>*<O3> - PTERMS(:,15,79) = +0.23451*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,16,79) = +0.23451*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(CH4,K079) = +0.04300*K079*<ALKE>*<O3> - PTERMS(:,16,79) = +0.04300*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,17,79) = +0.04300*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(ETH,K079) = +0.03196*K079*<ALKE>*<O3> - PTERMS(:,17,79) = +0.03196*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,18,79) = +0.03196*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(ALKE,K079) = -K079*<ALKE>*<O3> - PTERMS(:,19,79) = -TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,20,79) = -TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(HCHO,K079) = +0.48290*K079*<ALKE>*<O3> - PTERMS(:,22,79) = +0.48290*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,23,79) = +0.48290*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(ALD,K079) = +0.51468*K079*<ALKE>*<O3> - PTERMS(:,23,79) = +0.51468*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,24,79) = +0.51468*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(KET,K079) = +0.07377*K079*<ALKE>*<O3> - PTERMS(:,24,79) = +0.07377*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,25,79) = +0.07377*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(CARBO,K079) = +0.00000*K079*<ALKE>*<O3> - PTERMS(:,25,79) = +0.00000*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,26,79) = +0.00000*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! ! RETURN @@ -34154,64 +34794,64 @@ SUBROUTINE SUBT14 !Indices 281 a 300 ! !PTERMS(ORA1,K079) = +0.15343*K079*<ALKE>*<O3> - PTERMS(:,30,79) = +0.15343*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,31,79) = +0.15343*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(ORA2,K079) = +0.08143*K079*<ALKE>*<O3> - PTERMS(:,31,79) = +0.08143*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,32,79) = +0.08143*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(MO2,K079) = +0.13966*K079*<ALKE>*<O3> - PTERMS(:,32,79) = +0.13966*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,33,79) = +0.13966*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(ALKAP,K079) = +0.09815*K079*<ALKE>*<O3> - PTERMS(:,33,79) = +0.09815*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,34,79) = +0.09815*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(CARBOP,K079) = +0.05705*K079*<ALKE>*<O3> - PTERMS(:,39,79) = +0.05705*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,40,79) = +0.05705*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(XO2,K079) = +0.00000*K079*<ALKE>*<O3> - PTERMS(:,41,79) = +0.00000*TPK%K079(:)*PCONC(:,19)*PCONC(:,1) + PTERMS(:,42,79) = +0.00000*TPK%K079(:)*PCONC(:,20)*PCONC(:,1) ! !PTERMS(O3,K080) = -K080*<BIO>*<O3> - PTERMS(:,1,80) = -TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,1,80) = -TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! !PTERMS(H2O2,K080) = +0.00100*K080*<BIO>*<O3> - PTERMS(:,2,80) = +0.00100*TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,2,80) = +0.00100*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! !PTERMS(CO,K080) = +0.36000*K080*<BIO>*<O3> - PTERMS(:,13,80) = +0.36000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,14,80) = +0.36000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! !PTERMS(OH,K080) = +0.28000*K080*<BIO>*<O3> - PTERMS(:,14,80) = +0.28000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,15,80) = +0.28000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! !PTERMS(HO2,K080) = +0.30000*K080*<BIO>*<O3> - PTERMS(:,15,80) = +0.30000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,16,80) = +0.30000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! !PTERMS(ALKE,K080) = +0.37388*K080*<BIO>*<O3> - PTERMS(:,19,80) = +0.37388*TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,20,80) = +0.37388*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! !PTERMS(BIO,K080) = -K080*<BIO>*<O3> - PTERMS(:,20,80) = -TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,21,80) = -TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! !PTERMS(HCHO,K080) = +0.90000*K080*<BIO>*<O3> - PTERMS(:,22,80) = +0.90000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,23,80) = +0.90000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! !PTERMS(ALD,K080) = +0.00000*K080*<BIO>*<O3> - PTERMS(:,23,80) = +0.00000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,24,80) = +0.00000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! !PTERMS(KET,K080) = +0.00000*K080*<BIO>*<O3> - PTERMS(:,24,80) = +0.00000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,25,80) = +0.00000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! !PTERMS(CARBO,K080) = +0.39754*K080*<BIO>*<O3> - PTERMS(:,25,80) = +0.39754*TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,26,80) = +0.39754*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! !PTERMS(ORA1,K080) = +0.15000*K080*<BIO>*<O3> - PTERMS(:,30,80) = +0.15000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,31,80) = +0.15000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! !PTERMS(ORA2,K080) = +0.00000*K080*<BIO>*<O3> - PTERMS(:,31,80) = +0.00000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,32,80) = +0.00000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! !PTERMS(MO2,K080) = +0.03000*K080*<BIO>*<O3> - PTERMS(:,32,80) = +0.03000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,33,80) = +0.03000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! ! RETURN @@ -34222,64 +34862,64 @@ SUBROUTINE SUBT15 !Indices 301 a 320 ! !PTERMS(ALKAP,K080) = +0.00000*K080*<BIO>*<O3> - PTERMS(:,33,80) = +0.00000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,34,80) = +0.00000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! !PTERMS(CARBOP,K080) = +0.17000*K080*<BIO>*<O3> - PTERMS(:,39,80) = +0.17000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,40,80) = +0.17000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! !PTERMS(XO2,K080) = +0.13000*K080*<BIO>*<O3> - PTERMS(:,41,80) = +0.13000*TPK%K080(:)*PCONC(:,20)*PCONC(:,1) + PTERMS(:,42,80) = +0.13000*TPK%K080(:)*PCONC(:,21)*PCONC(:,1) ! !PTERMS(O3,K081) = -K081*<CARBO>*<O3> - PTERMS(:,1,81) = -TPK%K081(:)*PCONC(:,25)*PCONC(:,1) + PTERMS(:,1,81) = -TPK%K081(:)*PCONC(:,26)*PCONC(:,1) ! !PTERMS(CO,K081) = +0.64728*K081*<CARBO>*<O3> - PTERMS(:,13,81) = +0.64728*TPK%K081(:)*PCONC(:,25)*PCONC(:,1) + PTERMS(:,14,81) = +0.64728*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) ! !PTERMS(OH,K081) = +0.20595*K081*<CARBO>*<O3> - PTERMS(:,14,81) = +0.20595*TPK%K081(:)*PCONC(:,25)*PCONC(:,1) + PTERMS(:,15,81) = +0.20595*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) ! !PTERMS(HO2,K081) = +0.28441*K081*<CARBO>*<O3> - PTERMS(:,15,81) = +0.28441*TPK%K081(:)*PCONC(:,25)*PCONC(:,1) + PTERMS(:,16,81) = +0.28441*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) ! !PTERMS(HCHO,K081) = +0.00000*K081*<CARBO>*<O3> - PTERMS(:,22,81) = +0.00000*TPK%K081(:)*PCONC(:,25)*PCONC(:,1) + PTERMS(:,23,81) = +0.00000*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) ! !PTERMS(ALD,K081) = +0.15692*K081*<CARBO>*<O3> - PTERMS(:,23,81) = +0.15692*TPK%K081(:)*PCONC(:,25)*PCONC(:,1) + PTERMS(:,24,81) = +0.15692*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) ! !PTERMS(CARBO,K081) = -K081*<CARBO>*<O3> - PTERMS(:,25,81) = -TPK%K081(:)*PCONC(:,25)*PCONC(:,1) + PTERMS(:,26,81) = -TPK%K081(:)*PCONC(:,26)*PCONC(:,1) ! !PTERMS(OP2,K081) = +0.10149*K081*<CARBO>*<O3> - PTERMS(:,29,81) = +0.10149*TPK%K081(:)*PCONC(:,25)*PCONC(:,1) + PTERMS(:,30,81) = +0.10149*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) ! !PTERMS(ORA1,K081) = +0.10788*K081*<CARBO>*<O3> - PTERMS(:,30,81) = +0.10788*TPK%K081(:)*PCONC(:,25)*PCONC(:,1) + PTERMS(:,31,81) = +0.10788*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) ! !PTERMS(ORA2,K081) = +0.20595*K081*<CARBO>*<O3> - PTERMS(:,31,81) = +0.20595*TPK%K081(:)*PCONC(:,25)*PCONC(:,1) + PTERMS(:,32,81) = +0.20595*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) ! !PTERMS(CARBOP,K081) = +0.27460*K081*<CARBO>*<O3> - PTERMS(:,39,81) = +0.27460*TPK%K081(:)*PCONC(:,25)*PCONC(:,1) + PTERMS(:,40,81) = +0.27460*TPK%K081(:)*PCONC(:,26)*PCONC(:,1) ! !PTERMS(O3,K082) = -K082*<PAN>*<O3> - PTERMS(:,1,82) = -TPK%K082(:)*PCONC(:,27)*PCONC(:,1) + PTERMS(:,1,82) = -TPK%K082(:)*PCONC(:,28)*PCONC(:,1) ! !PTERMS(NO2,K082) = +0.70*K082*<PAN>*<O3> - PTERMS(:,4,82) = +0.70*TPK%K082(:)*PCONC(:,27)*PCONC(:,1) + PTERMS(:,4,82) = +0.70*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) ! !PTERMS(CO,K082) = +0.13*K082*<PAN>*<O3> - PTERMS(:,13,82) = +0.13*TPK%K082(:)*PCONC(:,27)*PCONC(:,1) + PTERMS(:,14,82) = +0.13*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) ! !PTERMS(OH,K082) = +0.036*K082*<PAN>*<O3> - PTERMS(:,14,82) = +0.036*TPK%K082(:)*PCONC(:,27)*PCONC(:,1) + PTERMS(:,15,82) = +0.036*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) ! !PTERMS(HO2,K082) = +0.08*K082*<PAN>*<O3> - PTERMS(:,15,82) = +0.08*TPK%K082(:)*PCONC(:,27)*PCONC(:,1) + PTERMS(:,16,82) = +0.08*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) ! !PTERMS(HCHO,K082) = +0.70*K082*<PAN>*<O3> - PTERMS(:,22,82) = +0.70*TPK%K082(:)*PCONC(:,27)*PCONC(:,1) + PTERMS(:,23,82) = +0.70*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) ! ! RETURN @@ -34290,64 +34930,64 @@ SUBROUTINE SUBT16 !Indices 321 a 340 ! !PTERMS(PAN,K082) = -K082*<PAN>*<O3> - PTERMS(:,27,82) = -TPK%K082(:)*PCONC(:,27)*PCONC(:,1) + PTERMS(:,28,82) = -TPK%K082(:)*PCONC(:,28)*PCONC(:,1) ! !PTERMS(ORA1,K082) = +0.11*K082*<PAN>*<O3> - PTERMS(:,30,82) = +0.11*TPK%K082(:)*PCONC(:,27)*PCONC(:,1) + PTERMS(:,31,82) = +0.11*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) ! !PTERMS(CARBOP,K082) = +0.70000*K082*<PAN>*<O3> - PTERMS(:,39,82) = +0.70000*TPK%K082(:)*PCONC(:,27)*PCONC(:,1) + PTERMS(:,40,82) = +0.70000*TPK%K082(:)*PCONC(:,28)*PCONC(:,1) ! !PTERMS(NO2,K083) = -K083*<PHO>*<NO2> - PTERMS(:,4,83) = -TPK%K083(:)*PCONC(:,36)*PCONC(:,4) + PTERMS(:,4,83) = -TPK%K083(:)*PCONC(:,37)*PCONC(:,4) ! !PTERMS(ARO,K083) = +0.10670*K083*<PHO>*<NO2> - PTERMS(:,21,83) = +0.10670*TPK%K083(:)*PCONC(:,36)*PCONC(:,4) + PTERMS(:,22,83) = +0.10670*TPK%K083(:)*PCONC(:,37)*PCONC(:,4) ! !PTERMS(ONIT,K083) = +K083*<PHO>*<NO2> - PTERMS(:,26,83) = +TPK%K083(:)*PCONC(:,36)*PCONC(:,4) + PTERMS(:,27,83) = +TPK%K083(:)*PCONC(:,37)*PCONC(:,4) ! !PTERMS(PHO,K083) = -K083*<PHO>*<NO2> - PTERMS(:,36,83) = -TPK%K083(:)*PCONC(:,36)*PCONC(:,4) + PTERMS(:,37,83) = -TPK%K083(:)*PCONC(:,37)*PCONC(:,4) ! !PTERMS(HO2,K084) = -K084*<PHO>*<HO2> - PTERMS(:,15,84) = -TPK%K084(:)*PCONC(:,36)*PCONC(:,15) + PTERMS(:,16,84) = -TPK%K084(:)*PCONC(:,37)*PCONC(:,16) ! !PTERMS(ARO,K084) = +1.06698*K084*<PHO>*<HO2> - PTERMS(:,21,84) = +1.06698*TPK%K084(:)*PCONC(:,36)*PCONC(:,15) + PTERMS(:,22,84) = +1.06698*TPK%K084(:)*PCONC(:,37)*PCONC(:,16) ! !PTERMS(PHO,K084) = -K084*<PHO>*<HO2> - PTERMS(:,36,84) = -TPK%K084(:)*PCONC(:,36)*PCONC(:,15) + PTERMS(:,37,84) = -TPK%K084(:)*PCONC(:,37)*PCONC(:,16) ! !PTERMS(NO2,K085) = -K085*<ADD>*<NO2> - PTERMS(:,4,85) = -TPK%K085(:)*PCONC(:,37)*PCONC(:,4) + PTERMS(:,4,85) = -TPK%K085(:)*PCONC(:,38)*PCONC(:,4) ! !PTERMS(HONO,K085) = +K085*<ADD>*<NO2> - PTERMS(:,7,85) = +TPK%K085(:)*PCONC(:,37)*PCONC(:,4) + PTERMS(:,7,85) = +TPK%K085(:)*PCONC(:,38)*PCONC(:,4) ! !PTERMS(ARO,K085) = +K085*<ADD>*<NO2> - PTERMS(:,21,85) = +TPK%K085(:)*PCONC(:,37)*PCONC(:,4) + PTERMS(:,22,85) = +TPK%K085(:)*PCONC(:,38)*PCONC(:,4) ! !PTERMS(ADD,K085) = -K085*<ADD>*<NO2> - PTERMS(:,37,85) = -TPK%K085(:)*PCONC(:,37)*PCONC(:,4) + PTERMS(:,38,85) = -TPK%K085(:)*PCONC(:,38)*PCONC(:,4) ! !PTERMS(HO2,K086) = +0.02*K086*<ADD>*<O2> - PTERMS(:,15,86) = +0.02*TPK%K086(:)*PCONC(:,37)*TPK%O2(:) + PTERMS(:,16,86) = +0.02*TPK%K086(:)*PCONC(:,38)*TPK%O2(:) ! !PTERMS(ARO,K086) = +0.02*K086*<ADD>*<O2> - PTERMS(:,21,86) = +0.02*TPK%K086(:)*PCONC(:,37)*TPK%O2(:) + PTERMS(:,22,86) = +0.02*TPK%K086(:)*PCONC(:,38)*TPK%O2(:) ! !PTERMS(ADD,K086) = -K086*<ADD>*<O2> - PTERMS(:,37,86) = -TPK%K086(:)*PCONC(:,37)*TPK%O2(:) + PTERMS(:,38,86) = -TPK%K086(:)*PCONC(:,38)*TPK%O2(:) ! !PTERMS(AROP,K086) = +0.98*K086*<ADD>*<O2> - PTERMS(:,38,86) = +0.98*TPK%K086(:)*PCONC(:,37)*TPK%O2(:) + PTERMS(:,39,86) = +0.98*TPK%K086(:)*PCONC(:,38)*TPK%O2(:) ! !PTERMS(O3,K087) = -K087*<ADD>*<O3> - PTERMS(:,1,87) = -TPK%K087(:)*PCONC(:,37)*PCONC(:,1) + PTERMS(:,1,87) = -TPK%K087(:)*PCONC(:,38)*PCONC(:,1) ! !PTERMS(OH,K087) = +K087*<ADD>*<O3> - PTERMS(:,14,87) = +TPK%K087(:)*PCONC(:,37)*PCONC(:,1) + PTERMS(:,15,87) = +TPK%K087(:)*PCONC(:,38)*PCONC(:,1) ! ! RETURN @@ -34358,64 +34998,64 @@ SUBROUTINE SUBT17 !Indices 341 a 360 ! !PTERMS(ARO,K087) = +K087*<ADD>*<O3> - PTERMS(:,21,87) = +TPK%K087(:)*PCONC(:,37)*PCONC(:,1) + PTERMS(:,22,87) = +TPK%K087(:)*PCONC(:,38)*PCONC(:,1) ! !PTERMS(ADD,K087) = -K087*<ADD>*<O3> - PTERMS(:,37,87) = -TPK%K087(:)*PCONC(:,37)*PCONC(:,1) + PTERMS(:,38,87) = -TPK%K087(:)*PCONC(:,38)*PCONC(:,1) ! !PTERMS(NO2,K088) = -K088*<CARBOP>*<NO2> - PTERMS(:,4,88) = -TPK%K088(:)*PCONC(:,39)*PCONC(:,4) + PTERMS(:,4,88) = -TPK%K088(:)*PCONC(:,40)*PCONC(:,4) ! !PTERMS(PAN,K088) = +1.00000*K088*<CARBOP>*<NO2> - PTERMS(:,27,88) = +1.00000*TPK%K088(:)*PCONC(:,39)*PCONC(:,4) + PTERMS(:,28,88) = +1.00000*TPK%K088(:)*PCONC(:,40)*PCONC(:,4) ! !PTERMS(CARBOP,K088) = -K088*<CARBOP>*<NO2> - PTERMS(:,39,88) = -TPK%K088(:)*PCONC(:,39)*PCONC(:,4) + PTERMS(:,40,88) = -TPK%K088(:)*PCONC(:,40)*PCONC(:,4) ! !PTERMS(NO2,K089) = +K089*<PAN> - PTERMS(:,4,89) = +TPK%K089(:)*PCONC(:,27) + PTERMS(:,4,89) = +TPK%K089(:)*PCONC(:,28) ! !PTERMS(PAN,K089) = -K089*<PAN> - PTERMS(:,27,89) = -TPK%K089(:)*PCONC(:,27) + PTERMS(:,28,89) = -TPK%K089(:)*PCONC(:,28) ! !PTERMS(CARBOP,K089) = +1.00000*K089*<PAN> - PTERMS(:,39,89) = +1.00000*TPK%K089(:)*PCONC(:,27) + PTERMS(:,40,89) = +1.00000*TPK%K089(:)*PCONC(:,28) ! !PTERMS(NO,K090) = -K090*<MO2>*<NO> - PTERMS(:,3,90) = -TPK%K090(:)*PCONC(:,32)*PCONC(:,3) + PTERMS(:,3,90) = -TPK%K090(:)*PCONC(:,33)*PCONC(:,3) ! !PTERMS(NO2,K090) = +K090*<MO2>*<NO> - PTERMS(:,4,90) = +TPK%K090(:)*PCONC(:,32)*PCONC(:,3) + PTERMS(:,4,90) = +TPK%K090(:)*PCONC(:,33)*PCONC(:,3) ! !PTERMS(HO2,K090) = +K090*<MO2>*<NO> - PTERMS(:,15,90) = +TPK%K090(:)*PCONC(:,32)*PCONC(:,3) + PTERMS(:,16,90) = +TPK%K090(:)*PCONC(:,33)*PCONC(:,3) ! !PTERMS(HCHO,K090) = +K090*<MO2>*<NO> - PTERMS(:,22,90) = +TPK%K090(:)*PCONC(:,32)*PCONC(:,3) + PTERMS(:,23,90) = +TPK%K090(:)*PCONC(:,33)*PCONC(:,3) ! !PTERMS(MO2,K090) = -K090*<MO2>*<NO> - PTERMS(:,32,90) = -TPK%K090(:)*PCONC(:,32)*PCONC(:,3) + PTERMS(:,33,90) = -TPK%K090(:)*PCONC(:,33)*PCONC(:,3) ! !PTERMS(NO,K091) = -K091*<ALKAP>*<NO> - PTERMS(:,3,91) = -TPK%K091(:)*PCONC(:,33)*PCONC(:,3) + PTERMS(:,3,91) = -TPK%K091(:)*PCONC(:,34)*PCONC(:,3) ! !PTERMS(NO2,K091) = +0.91541*K091*<ALKAP>*<NO> - PTERMS(:,4,91) = +0.91541*TPK%K091(:)*PCONC(:,33)*PCONC(:,3) + PTERMS(:,4,91) = +0.91541*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) ! !PTERMS(HO2,K091) = +0.74265*K091*<ALKAP>*<NO> - PTERMS(:,15,91) = +0.74265*TPK%K091(:)*PCONC(:,33)*PCONC(:,3) + PTERMS(:,16,91) = +0.74265*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) ! !PTERMS(HCHO,K091) = +0.03002*K091*<ALKAP>*<NO> - PTERMS(:,22,91) = +0.03002*TPK%K091(:)*PCONC(:,33)*PCONC(:,3) + PTERMS(:,23,91) = +0.03002*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) ! !PTERMS(ALD,K091) = +0.33144*K091*<ALKAP>*<NO> - PTERMS(:,23,91) = +0.33144*TPK%K091(:)*PCONC(:,33)*PCONC(:,3) + PTERMS(:,24,91) = +0.33144*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) ! !PTERMS(KET,K091) = +0.54531*K091*<ALKAP>*<NO> - PTERMS(:,24,91) = +0.54531*TPK%K091(:)*PCONC(:,33)*PCONC(:,3) + PTERMS(:,25,91) = +0.54531*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) ! !PTERMS(CARBO,K091) = +0.03407*K091*<ALKAP>*<NO> - PTERMS(:,25,91) = +0.03407*TPK%K091(:)*PCONC(:,33)*PCONC(:,3) + PTERMS(:,26,91) = +0.03407*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) ! ! RETURN @@ -34426,64 +35066,64 @@ SUBROUTINE SUBT18 !Indices 361 a 380 ! !PTERMS(ONIT,K091) = +0.08459*K091*<ALKAP>*<NO> - PTERMS(:,26,91) = +0.08459*TPK%K091(:)*PCONC(:,33)*PCONC(:,3) + PTERMS(:,27,91) = +0.08459*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) ! !PTERMS(MO2,K091) = +0.09016*K091*<ALKAP>*<NO> - PTERMS(:,32,91) = +0.09016*TPK%K091(:)*PCONC(:,33)*PCONC(:,3) + PTERMS(:,33,91) = +0.09016*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) ! !PTERMS(ALKAP,K091) = -K091*<ALKAP>*<NO> - PTERMS(:,33,91) = -TPK%K091(:)*PCONC(:,33)*PCONC(:,3) + PTERMS(:,34,91) = -TPK%K091(:)*PCONC(:,34)*PCONC(:,3) ! !PTERMS(XO2,K091) = +0.13007*K091*<ALKAP>*<NO> - PTERMS(:,41,91) = +0.13007*TPK%K091(:)*PCONC(:,33)*PCONC(:,3) + PTERMS(:,42,91) = +0.13007*TPK%K091(:)*PCONC(:,34)*PCONC(:,3) ! !PTERMS(NO,K092) = -K092*<ALKEP>*<NO> - PTERMS(:,3,92) = -TPK%K092(:)*PCONC(:,34)*PCONC(:,3) + PTERMS(:,3,92) = -TPK%K092(:)*PCONC(:,35)*PCONC(:,3) ! !PTERMS(NO2,K092) = +K092*<ALKEP>*<NO> - PTERMS(:,4,92) = +TPK%K092(:)*PCONC(:,34)*PCONC(:,3) + PTERMS(:,4,92) = +TPK%K092(:)*PCONC(:,35)*PCONC(:,3) ! !PTERMS(HO2,K092) = +K092*<ALKEP>*<NO> - PTERMS(:,15,92) = +TPK%K092(:)*PCONC(:,34)*PCONC(:,3) + PTERMS(:,16,92) = +TPK%K092(:)*PCONC(:,35)*PCONC(:,3) ! !PTERMS(HCHO,K092) = +1.39870*K092*<ALKEP>*<NO> - PTERMS(:,22,92) = +1.39870*TPK%K092(:)*PCONC(:,34)*PCONC(:,3) + PTERMS(:,23,92) = +1.39870*TPK%K092(:)*PCONC(:,35)*PCONC(:,3) ! !PTERMS(ALD,K092) = +0.42125*K092*<ALKEP>*<NO> - PTERMS(:,23,92) = +0.42125*TPK%K092(:)*PCONC(:,34)*PCONC(:,3) + PTERMS(:,24,92) = +0.42125*TPK%K092(:)*PCONC(:,35)*PCONC(:,3) ! !PTERMS(KET,K092) = +0.05220*K092*<ALKEP>*<NO> - PTERMS(:,24,92) = +0.05220*TPK%K092(:)*PCONC(:,34)*PCONC(:,3) + PTERMS(:,25,92) = +0.05220*TPK%K092(:)*PCONC(:,35)*PCONC(:,3) ! !PTERMS(ALKEP,K092) = -K092*<ALKEP>*<NO> - PTERMS(:,34,92) = -TPK%K092(:)*PCONC(:,34)*PCONC(:,3) + PTERMS(:,35,92) = -TPK%K092(:)*PCONC(:,35)*PCONC(:,3) ! !PTERMS(NO,K093) = -K093*<BIOP>*<NO> - PTERMS(:,3,93) = -TPK%K093(:)*PCONC(:,35)*PCONC(:,3) + PTERMS(:,3,93) = -TPK%K093(:)*PCONC(:,36)*PCONC(:,3) ! !PTERMS(NO2,K093) = +0.84700*K093*<BIOP>*<NO> - PTERMS(:,4,93) = +0.84700*TPK%K093(:)*PCONC(:,35)*PCONC(:,3) + PTERMS(:,4,93) = +0.84700*TPK%K093(:)*PCONC(:,36)*PCONC(:,3) ! !PTERMS(HO2,K093) = +0.84700*K093*<BIOP>*<NO> - PTERMS(:,15,93) = +0.84700*TPK%K093(:)*PCONC(:,35)*PCONC(:,3) + PTERMS(:,16,93) = +0.84700*TPK%K093(:)*PCONC(:,36)*PCONC(:,3) ! !PTERMS(ALKE,K093) = +0.37815*K093*<BIOP>*<NO> - PTERMS(:,19,93) = +0.37815*TPK%K093(:)*PCONC(:,35)*PCONC(:,3) + PTERMS(:,20,93) = +0.37815*TPK%K093(:)*PCONC(:,36)*PCONC(:,3) ! !PTERMS(HCHO,K093) = +0.60600*K093*<BIOP>*<NO> - PTERMS(:,22,93) = +0.60600*TPK%K093(:)*PCONC(:,35)*PCONC(:,3) + PTERMS(:,23,93) = +0.60600*TPK%K093(:)*PCONC(:,36)*PCONC(:,3) ! !PTERMS(ALD,K093) = +0.00000*K093*<BIOP>*<NO> - PTERMS(:,23,93) = +0.00000*TPK%K093(:)*PCONC(:,35)*PCONC(:,3) + PTERMS(:,24,93) = +0.00000*TPK%K093(:)*PCONC(:,36)*PCONC(:,3) ! !PTERMS(KET,K093) = +0.00000*K093*<BIOP>*<NO> - PTERMS(:,24,93) = +0.00000*TPK%K093(:)*PCONC(:,35)*PCONC(:,3) + PTERMS(:,25,93) = +0.00000*TPK%K093(:)*PCONC(:,36)*PCONC(:,3) ! !PTERMS(CARBO,K093) = +0.45463*K093*<BIOP>*<NO> - PTERMS(:,25,93) = +0.45463*TPK%K093(:)*PCONC(:,35)*PCONC(:,3) + PTERMS(:,26,93) = +0.45463*TPK%K093(:)*PCONC(:,36)*PCONC(:,3) ! !PTERMS(ONIT,K093) = +0.15300*K093*<BIOP>*<NO> - PTERMS(:,26,93) = +0.15300*TPK%K093(:)*PCONC(:,35)*PCONC(:,3) + PTERMS(:,27,93) = +0.15300*TPK%K093(:)*PCONC(:,36)*PCONC(:,3) ! ! RETURN @@ -34494,64 +35134,64 @@ SUBROUTINE SUBT19 !Indices 381 a 400 ! !PTERMS(BIOP,K093) = -K093*<BIOP>*<NO> - PTERMS(:,35,93) = -TPK%K093(:)*PCONC(:,35)*PCONC(:,3) + PTERMS(:,36,93) = -TPK%K093(:)*PCONC(:,36)*PCONC(:,3) ! !PTERMS(NO,K094) = -K094*<AROP>*<NO> - PTERMS(:,3,94) = -TPK%K094(:)*PCONC(:,38)*PCONC(:,3) + PTERMS(:,3,94) = -TPK%K094(:)*PCONC(:,39)*PCONC(:,3) ! !PTERMS(NO2,K094) = +0.95115*K094*<AROP>*<NO> - PTERMS(:,4,94) = +0.95115*TPK%K094(:)*PCONC(:,38)*PCONC(:,3) + PTERMS(:,4,94) = +0.95115*TPK%K094(:)*PCONC(:,39)*PCONC(:,3) ! !PTERMS(HO2,K094) = +0.95115*K094*<AROP>*<NO> - PTERMS(:,15,94) = +0.95115*TPK%K094(:)*PCONC(:,38)*PCONC(:,3) + PTERMS(:,16,94) = +0.95115*TPK%K094(:)*PCONC(:,39)*PCONC(:,3) ! !PTERMS(CARBO,K094) = +2.06993*K094*<AROP>*<NO> - PTERMS(:,25,94) = +2.06993*TPK%K094(:)*PCONC(:,38)*PCONC(:,3) + PTERMS(:,26,94) = +2.06993*TPK%K094(:)*PCONC(:,39)*PCONC(:,3) ! !PTERMS(ONIT,K094) = +0.04885*K094*<AROP>*<NO> - PTERMS(:,26,94) = +0.04885*TPK%K094(:)*PCONC(:,38)*PCONC(:,3) + PTERMS(:,27,94) = +0.04885*TPK%K094(:)*PCONC(:,39)*PCONC(:,3) ! !PTERMS(AROP,K094) = -K094*<AROP>*<NO> - PTERMS(:,38,94) = -TPK%K094(:)*PCONC(:,38)*PCONC(:,3) + PTERMS(:,39,94) = -TPK%K094(:)*PCONC(:,39)*PCONC(:,3) ! !PTERMS(NO,K095) = -K095*<CARBOP>*<NO> - PTERMS(:,3,95) = -TPK%K095(:)*PCONC(:,39)*PCONC(:,3) + PTERMS(:,3,95) = -TPK%K095(:)*PCONC(:,40)*PCONC(:,3) ! !PTERMS(NO2,K095) = +K095*<CARBOP>*<NO> - PTERMS(:,4,95) = +TPK%K095(:)*PCONC(:,39)*PCONC(:,3) + PTERMS(:,4,95) = +TPK%K095(:)*PCONC(:,40)*PCONC(:,3) ! !PTERMS(HO2,K095) = +0.12334*K095*<CARBOP>*<NO> - PTERMS(:,15,95) = +0.12334*TPK%K095(:)*PCONC(:,39)*PCONC(:,3) + PTERMS(:,16,95) = +0.12334*TPK%K095(:)*PCONC(:,40)*PCONC(:,3) ! !PTERMS(HCHO,K095) = +0.05848*K095*<CARBOP>*<NO> - PTERMS(:,22,95) = +0.05848*TPK%K095(:)*PCONC(:,39)*PCONC(:,3) + PTERMS(:,23,95) = +0.05848*TPK%K095(:)*PCONC(:,40)*PCONC(:,3) ! !PTERMS(ALD,K095) = +0.07368*K095*<CARBOP>*<NO> - PTERMS(:,23,95) = +0.07368*TPK%K095(:)*PCONC(:,39)*PCONC(:,3) + PTERMS(:,24,95) = +0.07368*TPK%K095(:)*PCONC(:,40)*PCONC(:,3) ! !PTERMS(CARBO,K095) = +0.08670*K095*<CARBOP>*<NO> - PTERMS(:,25,95) = +0.08670*TPK%K095(:)*PCONC(:,39)*PCONC(:,3) + PTERMS(:,26,95) = +0.08670*TPK%K095(:)*PCONC(:,40)*PCONC(:,3) ! !PTERMS(MO2,K095) = +0.78134*K095*<CARBOP>*<NO> - PTERMS(:,32,95) = +0.78134*TPK%K095(:)*PCONC(:,39)*PCONC(:,3) + PTERMS(:,33,95) = +0.78134*TPK%K095(:)*PCONC(:,40)*PCONC(:,3) ! !PTERMS(CARBOP,K095) = -K095*<CARBOP>*<NO> - PTERMS(:,39,95) = -TPK%K095(:)*PCONC(:,39)*PCONC(:,3) + PTERMS(:,40,95) = -TPK%K095(:)*PCONC(:,40)*PCONC(:,3) ! !PTERMS(XO2,K095) = +0.02563*K095*<CARBOP>*<NO> - PTERMS(:,41,95) = +0.02563*TPK%K095(:)*PCONC(:,39)*PCONC(:,3) + PTERMS(:,42,95) = +0.02563*TPK%K095(:)*PCONC(:,40)*PCONC(:,3) ! !PTERMS(NO,K096) = -K096*<OLN>*<NO> - PTERMS(:,3,96) = -TPK%K096(:)*PCONC(:,40)*PCONC(:,3) + PTERMS(:,3,96) = -TPK%K096(:)*PCONC(:,41)*PCONC(:,3) ! !PTERMS(NO2,K096) = +1.81599*K096*<OLN>*<NO> - PTERMS(:,4,96) = +1.81599*TPK%K096(:)*PCONC(:,40)*PCONC(:,3) + PTERMS(:,4,96) = +1.81599*TPK%K096(:)*PCONC(:,41)*PCONC(:,3) ! !PTERMS(HO2,K096) = +0.18401*K096*<OLN>*<NO> - PTERMS(:,15,96) = +0.18401*TPK%K096(:)*PCONC(:,40)*PCONC(:,3) + PTERMS(:,16,96) = +0.18401*TPK%K096(:)*PCONC(:,41)*PCONC(:,3) ! !PTERMS(HCHO,K096) = +0.23419*K096*<OLN>*<NO> - PTERMS(:,22,96) = +0.23419*TPK%K096(:)*PCONC(:,40)*PCONC(:,3) + PTERMS(:,23,96) = +0.23419*TPK%K096(:)*PCONC(:,41)*PCONC(:,3) ! ! RETURN @@ -34562,64 +35202,64 @@ SUBROUTINE SUBT20 !Indices 401 a 420 ! !PTERMS(ALD,K096) = +1.01182*K096*<OLN>*<NO> - PTERMS(:,23,96) = +1.01182*TPK%K096(:)*PCONC(:,40)*PCONC(:,3) + PTERMS(:,24,96) = +1.01182*TPK%K096(:)*PCONC(:,41)*PCONC(:,3) ! !PTERMS(KET,K096) = +0.37862*K096*<OLN>*<NO> - PTERMS(:,24,96) = +0.37862*TPK%K096(:)*PCONC(:,40)*PCONC(:,3) + PTERMS(:,25,96) = +0.37862*TPK%K096(:)*PCONC(:,41)*PCONC(:,3) ! !PTERMS(ONIT,K096) = +0.18401*K096*<OLN>*<NO> - PTERMS(:,26,96) = +0.18401*TPK%K096(:)*PCONC(:,40)*PCONC(:,3) + PTERMS(:,27,96) = +0.18401*TPK%K096(:)*PCONC(:,41)*PCONC(:,3) ! !PTERMS(OLN,K096) = -K096*<OLN>*<NO> - PTERMS(:,40,96) = -TPK%K096(:)*PCONC(:,40)*PCONC(:,3) + PTERMS(:,41,96) = -TPK%K096(:)*PCONC(:,41)*PCONC(:,3) ! !PTERMS(HO2,K097) = -K097*<MO2>*<HO2> - PTERMS(:,15,97) = -TPK%K097(:)*PCONC(:,32)*PCONC(:,15) + PTERMS(:,16,97) = -TPK%K097(:)*PCONC(:,33)*PCONC(:,16) ! !PTERMS(OP1,K097) = +K097*<MO2>*<HO2> - PTERMS(:,28,97) = +TPK%K097(:)*PCONC(:,32)*PCONC(:,15) + PTERMS(:,29,97) = +TPK%K097(:)*PCONC(:,33)*PCONC(:,16) ! !PTERMS(MO2,K097) = -K097*<MO2>*<HO2> - PTERMS(:,32,97) = -TPK%K097(:)*PCONC(:,32)*PCONC(:,15) + PTERMS(:,33,97) = -TPK%K097(:)*PCONC(:,33)*PCONC(:,16) ! !PTERMS(HO2,K098) = -K098*<ALKAP>*<HO2> - PTERMS(:,15,98) = -TPK%K098(:)*PCONC(:,33)*PCONC(:,15) + PTERMS(:,16,98) = -TPK%K098(:)*PCONC(:,34)*PCONC(:,16) ! !PTERMS(OP2,K098) = +1.00524*K098*<ALKAP>*<HO2> - PTERMS(:,29,98) = +1.00524*TPK%K098(:)*PCONC(:,33)*PCONC(:,15) + PTERMS(:,30,98) = +1.00524*TPK%K098(:)*PCONC(:,34)*PCONC(:,16) ! !PTERMS(ALKAP,K098) = -K098*<ALKAP>*<HO2> - PTERMS(:,33,98) = -TPK%K098(:)*PCONC(:,33)*PCONC(:,15) + PTERMS(:,34,98) = -TPK%K098(:)*PCONC(:,34)*PCONC(:,16) ! !PTERMS(HO2,K099) = -K099*<ALKEP>*<HO2> - PTERMS(:,15,99) = -TPK%K099(:)*PCONC(:,34)*PCONC(:,15) + PTERMS(:,16,99) = -TPK%K099(:)*PCONC(:,35)*PCONC(:,16) ! !PTERMS(OP2,K099) = +1.00524*K099*<ALKEP>*<HO2> - PTERMS(:,29,99) = +1.00524*TPK%K099(:)*PCONC(:,34)*PCONC(:,15) + PTERMS(:,30,99) = +1.00524*TPK%K099(:)*PCONC(:,35)*PCONC(:,16) ! !PTERMS(ALKEP,K099) = -K099*<ALKEP>*<HO2> - PTERMS(:,34,99) = -TPK%K099(:)*PCONC(:,34)*PCONC(:,15) + PTERMS(:,35,99) = -TPK%K099(:)*PCONC(:,35)*PCONC(:,16) ! !PTERMS(HO2,K0100) = -K0100*<BIOP>*<HO2> - PTERMS(:,15,100) = -TPK%K0100(:)*PCONC(:,35)*PCONC(:,15) + PTERMS(:,16,100) = -TPK%K0100(:)*PCONC(:,36)*PCONC(:,16) ! !PTERMS(OP2,K0100) = +1.00524*K0100*<BIOP>*<HO2> - PTERMS(:,29,100) = +1.00524*TPK%K0100(:)*PCONC(:,35)*PCONC(:,15) + PTERMS(:,30,100) = +1.00524*TPK%K0100(:)*PCONC(:,36)*PCONC(:,16) ! !PTERMS(BIOP,K0100) = -K0100*<BIOP>*<HO2> - PTERMS(:,35,100) = -TPK%K0100(:)*PCONC(:,35)*PCONC(:,15) + PTERMS(:,36,100) = -TPK%K0100(:)*PCONC(:,36)*PCONC(:,16) ! !PTERMS(HO2,K0101) = -K0101*<AROP>*<HO2> - PTERMS(:,15,101) = -TPK%K0101(:)*PCONC(:,38)*PCONC(:,15) + PTERMS(:,16,101) = -TPK%K0101(:)*PCONC(:,39)*PCONC(:,16) ! !PTERMS(OP2,K0101) = +1.00524*K0101*<AROP>*<HO2> - PTERMS(:,29,101) = +1.00524*TPK%K0101(:)*PCONC(:,38)*PCONC(:,15) + PTERMS(:,30,101) = +1.00524*TPK%K0101(:)*PCONC(:,39)*PCONC(:,16) ! !PTERMS(AROP,K0101) = -K0101*<AROP>*<HO2> - PTERMS(:,38,101) = -TPK%K0101(:)*PCONC(:,38)*PCONC(:,15) + PTERMS(:,39,101) = -TPK%K0101(:)*PCONC(:,39)*PCONC(:,16) ! !PTERMS(O3,K0102) = +0.17307*K0102*<CARBOP>*<HO2> - PTERMS(:,1,102) = +0.17307*TPK%K0102(:)*PCONC(:,39)*PCONC(:,15) + PTERMS(:,1,102) = +0.17307*TPK%K0102(:)*PCONC(:,40)*PCONC(:,16) ! ! RETURN @@ -34630,64 +35270,64 @@ SUBROUTINE SUBT21 !Indices 421 a 440 ! !PTERMS(HO2,K0102) = -K0102*<CARBOP>*<HO2> - PTERMS(:,15,102) = -TPK%K0102(:)*PCONC(:,39)*PCONC(:,15) + PTERMS(:,16,102) = -TPK%K0102(:)*PCONC(:,40)*PCONC(:,16) ! !PTERMS(OP2,K0102) = +0.80904*K0102*<CARBOP>*<HO2> - PTERMS(:,29,102) = +0.80904*TPK%K0102(:)*PCONC(:,39)*PCONC(:,15) + PTERMS(:,30,102) = +0.80904*TPK%K0102(:)*PCONC(:,40)*PCONC(:,16) ! !PTERMS(ORA2,K0102) = +0.17307*K0102*<CARBOP>*<HO2> - PTERMS(:,31,102) = +0.17307*TPK%K0102(:)*PCONC(:,39)*PCONC(:,15) + PTERMS(:,32,102) = +0.17307*TPK%K0102(:)*PCONC(:,40)*PCONC(:,16) ! !PTERMS(CARBOP,K0102) = -K0102*<CARBOP>*<HO2> - PTERMS(:,39,102) = -TPK%K0102(:)*PCONC(:,39)*PCONC(:,15) + PTERMS(:,40,102) = -TPK%K0102(:)*PCONC(:,40)*PCONC(:,16) ! !PTERMS(HO2,K103) = -K103*<OLN>*<HO2> - PTERMS(:,15,103) = -TPK%K103(:)*PCONC(:,40)*PCONC(:,15) + PTERMS(:,16,103) = -TPK%K103(:)*PCONC(:,41)*PCONC(:,16) ! !PTERMS(ONIT,K103) = +K103*<OLN>*<HO2> - PTERMS(:,26,103) = +TPK%K103(:)*PCONC(:,40)*PCONC(:,15) + PTERMS(:,27,103) = +TPK%K103(:)*PCONC(:,41)*PCONC(:,16) ! !PTERMS(OLN,K103) = -K103*<OLN>*<HO2> - PTERMS(:,40,103) = -TPK%K103(:)*PCONC(:,40)*PCONC(:,15) + PTERMS(:,41,103) = -TPK%K103(:)*PCONC(:,41)*PCONC(:,16) ! !PTERMS(HO2,K104) = +0.66*K104*<MO2>*<MO2> - PTERMS(:,15,104) = +0.66*TPK%K104(:)*PCONC(:,32)*PCONC(:,32) + PTERMS(:,16,104) = +0.66*TPK%K104(:)*PCONC(:,33)*PCONC(:,33) ! !PTERMS(HCHO,K104) = +1.33*K104*<MO2>*<MO2> - PTERMS(:,22,104) = +1.33*TPK%K104(:)*PCONC(:,32)*PCONC(:,32) + PTERMS(:,23,104) = +1.33*TPK%K104(:)*PCONC(:,33)*PCONC(:,33) ! !PTERMS(MO2,K104) = -K104*<MO2>*<MO2> - PTERMS(:,32,104) = -TPK%K104(:)*PCONC(:,32)*PCONC(:,32) + PTERMS(:,33,104) = -TPK%K104(:)*PCONC(:,33)*PCONC(:,33) ! !PTERMS(HO2,K105) = +0.98383*K105*<ALKAP>*<MO2> - PTERMS(:,15,105) = +0.98383*TPK%K105(:)*PCONC(:,33)*PCONC(:,32) + PTERMS(:,16,105) = +0.98383*TPK%K105(:)*PCONC(:,34)*PCONC(:,33) ! !PTERMS(HCHO,K105) = +0.80556*K105*<ALKAP>*<MO2> - PTERMS(:,22,105) = +0.80556*TPK%K105(:)*PCONC(:,33)*PCONC(:,32) + PTERMS(:,23,105) = +0.80556*TPK%K105(:)*PCONC(:,34)*PCONC(:,33) ! !PTERMS(ALD,K105) = +0.56070*K105*<ALKAP>*<MO2> - PTERMS(:,23,105) = +0.56070*TPK%K105(:)*PCONC(:,33)*PCONC(:,32) + PTERMS(:,24,105) = +0.56070*TPK%K105(:)*PCONC(:,34)*PCONC(:,33) ! !PTERMS(KET,K105) = +0.09673*K105*<ALKAP>*<MO2> - PTERMS(:,24,105) = +0.09673*TPK%K105(:)*PCONC(:,33)*PCONC(:,32) + PTERMS(:,25,105) = +0.09673*TPK%K105(:)*PCONC(:,34)*PCONC(:,33) ! !PTERMS(CARBO,K105) = +0.07976*K105*<ALKAP>*<MO2> - PTERMS(:,25,105) = +0.07976*TPK%K105(:)*PCONC(:,33)*PCONC(:,32) + PTERMS(:,26,105) = +0.07976*TPK%K105(:)*PCONC(:,34)*PCONC(:,33) ! !PTERMS(MO2,K105) = -K105*<ALKAP>*<MO2> - PTERMS(:,32,105) = -TPK%K105(:)*PCONC(:,33)*PCONC(:,32) + PTERMS(:,33,105) = -TPK%K105(:)*PCONC(:,34)*PCONC(:,33) ! !PTERMS(ALKAP,K105) = -K105*<ALKAP>*<MO2> - PTERMS(:,33,105) = -TPK%K105(:)*PCONC(:,33)*PCONC(:,32) + PTERMS(:,34,105) = -TPK%K105(:)*PCONC(:,34)*PCONC(:,33) ! !PTERMS(XO2,K105) = +0.13370*K105*<ALKAP>*<MO2> - PTERMS(:,41,105) = +0.13370*TPK%K105(:)*PCONC(:,33)*PCONC(:,32) + PTERMS(:,42,105) = +0.13370*TPK%K105(:)*PCONC(:,34)*PCONC(:,33) ! !PTERMS(HO2,K106) = +K106*<ALKEP>*<MO2> - PTERMS(:,15,106) = +TPK%K106(:)*PCONC(:,34)*PCONC(:,32) + PTERMS(:,16,106) = +TPK%K106(:)*PCONC(:,35)*PCONC(:,33) ! !PTERMS(HCHO,K106) = +1.42894*K106*<ALKEP>*<MO2> - PTERMS(:,22,106) = +1.42894*TPK%K106(:)*PCONC(:,34)*PCONC(:,32) + PTERMS(:,23,106) = +1.42894*TPK%K106(:)*PCONC(:,35)*PCONC(:,33) ! ! RETURN @@ -34698,64 +35338,64 @@ SUBROUTINE SUBT22 !Indices 441 a 460 ! !PTERMS(ALD,K106) = +0.46413*K106*<ALKEP>*<MO2> - PTERMS(:,23,106) = +0.46413*TPK%K106(:)*PCONC(:,34)*PCONC(:,32) + PTERMS(:,24,106) = +0.46413*TPK%K106(:)*PCONC(:,35)*PCONC(:,33) ! !PTERMS(KET,K106) = +0.03814*K106*<ALKEP>*<MO2> - PTERMS(:,24,106) = +0.03814*TPK%K106(:)*PCONC(:,34)*PCONC(:,32) + PTERMS(:,25,106) = +0.03814*TPK%K106(:)*PCONC(:,35)*PCONC(:,33) ! !PTERMS(MO2,K106) = -K106*<ALKEP>*<MO2> - PTERMS(:,32,106) = -TPK%K106(:)*PCONC(:,34)*PCONC(:,32) + PTERMS(:,33,106) = -TPK%K106(:)*PCONC(:,35)*PCONC(:,33) ! !PTERMS(ALKEP,K106) = -K106*<ALKEP>*<MO2> - PTERMS(:,34,106) = -TPK%K106(:)*PCONC(:,34)*PCONC(:,32) + PTERMS(:,35,106) = -TPK%K106(:)*PCONC(:,35)*PCONC(:,33) ! !PTERMS(HO2,K107) = +1.00000*K107*<BIOP>*<MO2> - PTERMS(:,15,107) = +1.00000*TPK%K107(:)*PCONC(:,35)*PCONC(:,32) + PTERMS(:,16,107) = +1.00000*TPK%K107(:)*PCONC(:,36)*PCONC(:,33) ! !PTERMS(ALKE,K107) = +0.48074*K107*<BIOP>*<MO2> - PTERMS(:,19,107) = +0.48074*TPK%K107(:)*PCONC(:,35)*PCONC(:,32) + PTERMS(:,20,107) = +0.48074*TPK%K107(:)*PCONC(:,36)*PCONC(:,33) ! !PTERMS(HCHO,K107) = +1.09000*K107*<BIOP>*<MO2> - PTERMS(:,22,107) = +1.09000*TPK%K107(:)*PCONC(:,35)*PCONC(:,32) + PTERMS(:,23,107) = +1.09000*TPK%K107(:)*PCONC(:,36)*PCONC(:,33) ! !PTERMS(ALD,K107) = +0.00000*K107*<BIOP>*<MO2> - PTERMS(:,23,107) = +0.00000*TPK%K107(:)*PCONC(:,35)*PCONC(:,32) + PTERMS(:,24,107) = +0.00000*TPK%K107(:)*PCONC(:,36)*PCONC(:,33) ! !PTERMS(KET,K107) = +0.00000*K107*<BIOP>*<MO2> - PTERMS(:,24,107) = +0.00000*TPK%K107(:)*PCONC(:,35)*PCONC(:,32) + PTERMS(:,25,107) = +0.00000*TPK%K107(:)*PCONC(:,36)*PCONC(:,33) ! !PTERMS(CARBO,K107) = +0.56064*K107*<BIOP>*<MO2> - PTERMS(:,25,107) = +0.56064*TPK%K107(:)*PCONC(:,35)*PCONC(:,32) + PTERMS(:,26,107) = +0.56064*TPK%K107(:)*PCONC(:,36)*PCONC(:,33) ! !PTERMS(MO2,K107) = -K107*<BIOP>*<MO2> - PTERMS(:,32,107) = -TPK%K107(:)*PCONC(:,35)*PCONC(:,32) + PTERMS(:,33,107) = -TPK%K107(:)*PCONC(:,36)*PCONC(:,33) ! !PTERMS(BIOP,K107) = -K107*<BIOP>*<MO2> - PTERMS(:,35,107) = -TPK%K107(:)*PCONC(:,35)*PCONC(:,32) + PTERMS(:,36,107) = -TPK%K107(:)*PCONC(:,36)*PCONC(:,33) ! !PTERMS(HO2,K108) = +1.02767*K108*<AROP>*<MO2> - PTERMS(:,15,108) = +1.02767*TPK%K108(:)*PCONC(:,38)*PCONC(:,32) + PTERMS(:,16,108) = +1.02767*TPK%K108(:)*PCONC(:,39)*PCONC(:,33) ! !PTERMS(HCHO,K108) = +K108*<AROP>*<MO2> - PTERMS(:,22,108) = +TPK%K108(:)*PCONC(:,38)*PCONC(:,32) + PTERMS(:,23,108) = +TPK%K108(:)*PCONC(:,39)*PCONC(:,33) ! !PTERMS(CARBO,K108) = +1.99461*K108*<AROP>*<MO2> - PTERMS(:,25,108) = +1.99461*TPK%K108(:)*PCONC(:,38)*PCONC(:,32) + PTERMS(:,26,108) = +1.99461*TPK%K108(:)*PCONC(:,39)*PCONC(:,33) ! !PTERMS(MO2,K108) = -K108*<AROP>*<MO2> - PTERMS(:,32,108) = -TPK%K108(:)*PCONC(:,38)*PCONC(:,32) + PTERMS(:,33,108) = -TPK%K108(:)*PCONC(:,39)*PCONC(:,33) ! !PTERMS(AROP,K108) = -K108*<AROP>*<MO2> - PTERMS(:,38,108) = -TPK%K108(:)*PCONC(:,38)*PCONC(:,32) + PTERMS(:,39,108) = -TPK%K108(:)*PCONC(:,39)*PCONC(:,33) ! !PTERMS(HO2,K109) = +0.82998*K109*<CARBOP>*<MO2> - PTERMS(:,15,109) = +0.82998*TPK%K109(:)*PCONC(:,39)*PCONC(:,32) + PTERMS(:,16,109) = +0.82998*TPK%K109(:)*PCONC(:,40)*PCONC(:,33) ! !PTERMS(HCHO,K109) = +0.95723*K109*<CARBOP>*<MO2> - PTERMS(:,22,109) = +0.95723*TPK%K109(:)*PCONC(:,39)*PCONC(:,32) + PTERMS(:,23,109) = +0.95723*TPK%K109(:)*PCONC(:,40)*PCONC(:,33) ! !PTERMS(ALD,K109) = +0.08295*K109*<CARBOP>*<MO2> - PTERMS(:,23,109) = +0.08295*TPK%K109(:)*PCONC(:,39)*PCONC(:,32) + PTERMS(:,24,109) = +0.08295*TPK%K109(:)*PCONC(:,40)*PCONC(:,33) ! ! RETURN @@ -34766,64 +35406,64 @@ SUBROUTINE SUBT23 !Indices 461 a 480 ! !PTERMS(CARBO,K109) = +0.15387*K109*<CARBOP>*<MO2> - PTERMS(:,25,109) = +0.15387*TPK%K109(:)*PCONC(:,39)*PCONC(:,32) + PTERMS(:,26,109) = +0.15387*TPK%K109(:)*PCONC(:,40)*PCONC(:,33) ! !PTERMS(ORA2,K109) = +0.13684*K109*<CARBOP>*<MO2> - PTERMS(:,31,109) = +0.13684*TPK%K109(:)*PCONC(:,39)*PCONC(:,32) + PTERMS(:,32,109) = +0.13684*TPK%K109(:)*PCONC(:,40)*PCONC(:,33) ! !PTERMS(MO2,K109) = -K109*<CARBOP>*<MO2> - PTERMS(:,32,109) = -TPK%K109(:)*PCONC(:,39)*PCONC(:,32) + PTERMS(:,33,109) = -TPK%K109(:)*PCONC(:,40)*PCONC(:,33) ! !PTERMS(CARBOP,K109) = -K109*<CARBOP>*<MO2> - PTERMS(:,39,109) = -TPK%K109(:)*PCONC(:,39)*PCONC(:,32) + PTERMS(:,40,109) = -TPK%K109(:)*PCONC(:,40)*PCONC(:,33) ! !PTERMS(XO2,K109) = +0.02212*K109*<CARBOP>*<MO2> - PTERMS(:,41,109) = +0.02212*TPK%K109(:)*PCONC(:,39)*PCONC(:,32) + PTERMS(:,42,109) = +0.02212*TPK%K109(:)*PCONC(:,40)*PCONC(:,33) ! !PTERMS(NO2,K110) = +0.32440*K110*<OLN>*<MO2> - PTERMS(:,4,110) = +0.32440*TPK%K110(:)*PCONC(:,40)*PCONC(:,32) + PTERMS(:,4,110) = +0.32440*TPK%K110(:)*PCONC(:,41)*PCONC(:,33) ! !PTERMS(HO2,K110) = +0.67560*K110*<OLN>*<MO2> - PTERMS(:,15,110) = +0.67560*TPK%K110(:)*PCONC(:,40)*PCONC(:,32) + PTERMS(:,16,110) = +0.67560*TPK%K110(:)*PCONC(:,41)*PCONC(:,33) ! !PTERMS(HCHO,K110) = +0.88625*K110*<OLN>*<MO2> - PTERMS(:,22,110) = +0.88625*TPK%K110(:)*PCONC(:,40)*PCONC(:,32) + PTERMS(:,23,110) = +0.88625*TPK%K110(:)*PCONC(:,41)*PCONC(:,33) ! !PTERMS(ALD,K110) = +0.41524*K110*<OLN>*<MO2> - PTERMS(:,23,110) = +0.41524*TPK%K110(:)*PCONC(:,40)*PCONC(:,32) + PTERMS(:,24,110) = +0.41524*TPK%K110(:)*PCONC(:,41)*PCONC(:,33) ! !PTERMS(KET,K110) = +0.09667*K110*<OLN>*<MO2> - PTERMS(:,24,110) = +0.09667*TPK%K110(:)*PCONC(:,40)*PCONC(:,32) + PTERMS(:,25,110) = +0.09667*TPK%K110(:)*PCONC(:,41)*PCONC(:,33) ! !PTERMS(ONIT,K110) = +0.67560*K110*<OLN>*<MO2> - PTERMS(:,26,110) = +0.67560*TPK%K110(:)*PCONC(:,40)*PCONC(:,32) + PTERMS(:,27,110) = +0.67560*TPK%K110(:)*PCONC(:,41)*PCONC(:,33) ! !PTERMS(MO2,K110) = -K110*<OLN>*<MO2> - PTERMS(:,32,110) = -TPK%K110(:)*PCONC(:,40)*PCONC(:,32) + PTERMS(:,33,110) = -TPK%K110(:)*PCONC(:,41)*PCONC(:,33) ! !PTERMS(OLN,K110) = -K110*<OLN>*<MO2> - PTERMS(:,40,110) = -TPK%K110(:)*PCONC(:,40)*PCONC(:,32) + PTERMS(:,41,110) = -TPK%K110(:)*PCONC(:,41)*PCONC(:,33) ! !PTERMS(HO2,K111) = +0.48079*K111*<ALKAP>*<CARBOP> - PTERMS(:,15,111) = +0.48079*TPK%K111(:)*PCONC(:,33)*PCONC(:,39) + PTERMS(:,16,111) = +0.48079*TPK%K111(:)*PCONC(:,34)*PCONC(:,40) ! !PTERMS(HCHO,K111) = +0.07600*K111*<ALKAP>*<CARBOP> - PTERMS(:,22,111) = +0.07600*TPK%K111(:)*PCONC(:,33)*PCONC(:,39) + PTERMS(:,23,111) = +0.07600*TPK%K111(:)*PCONC(:,34)*PCONC(:,40) ! !PTERMS(ALD,K111) = +0.71461*K111*<ALKAP>*<CARBOP> - PTERMS(:,23,111) = +0.71461*TPK%K111(:)*PCONC(:,33)*PCONC(:,39) + PTERMS(:,24,111) = +0.71461*TPK%K111(:)*PCONC(:,34)*PCONC(:,40) ! !PTERMS(KET,K111) = +0.18819*K111*<ALKAP>*<CARBOP> - PTERMS(:,24,111) = +0.18819*TPK%K111(:)*PCONC(:,33)*PCONC(:,39) + PTERMS(:,25,111) = +0.18819*TPK%K111(:)*PCONC(:,34)*PCONC(:,40) ! !PTERMS(CARBO,K111) = +0.06954*K111*<ALKAP>*<CARBOP> - PTERMS(:,25,111) = +0.06954*TPK%K111(:)*PCONC(:,33)*PCONC(:,39) + PTERMS(:,26,111) = +0.06954*TPK%K111(:)*PCONC(:,34)*PCONC(:,40) ! !PTERMS(ORA2,K111) = +0.49810*K111*<ALKAP>*<CARBOP> - PTERMS(:,31,111) = +0.49810*TPK%K111(:)*PCONC(:,33)*PCONC(:,39) + PTERMS(:,32,111) = +0.49810*TPK%K111(:)*PCONC(:,34)*PCONC(:,40) ! !PTERMS(MO2,K111) = +0.51480*K111*<ALKAP>*<CARBOP> - PTERMS(:,32,111) = +0.51480*TPK%K111(:)*PCONC(:,33)*PCONC(:,39) + PTERMS(:,33,111) = +0.51480*TPK%K111(:)*PCONC(:,34)*PCONC(:,40) ! ! RETURN @@ -34834,64 +35474,64 @@ SUBROUTINE SUBT24 !Indices 481 a 500 ! !PTERMS(ALKAP,K111) = -K111*<ALKAP>*<CARBOP> - PTERMS(:,33,111) = -TPK%K111(:)*PCONC(:,33)*PCONC(:,39) + PTERMS(:,34,111) = -TPK%K111(:)*PCONC(:,34)*PCONC(:,40) ! !PTERMS(CARBOP,K111) = -K111*<ALKAP>*<CARBOP> - PTERMS(:,39,111) = -TPK%K111(:)*PCONC(:,33)*PCONC(:,39) + PTERMS(:,40,111) = -TPK%K111(:)*PCONC(:,34)*PCONC(:,40) ! !PTERMS(XO2,K111) = +0.11306*K111*<ALKAP>*<CARBOP> - PTERMS(:,41,111) = +0.11306*TPK%K111(:)*PCONC(:,33)*PCONC(:,39) + PTERMS(:,42,111) = +0.11306*TPK%K111(:)*PCONC(:,34)*PCONC(:,40) ! !PTERMS(HO2,K112) = +0.50078*K112*<ALKEP>*<CARBOP> - PTERMS(:,15,112) = +0.50078*TPK%K112(:)*PCONC(:,34)*PCONC(:,39) + PTERMS(:,16,112) = +0.50078*TPK%K112(:)*PCONC(:,35)*PCONC(:,40) ! !PTERMS(HCHO,K112) = +0.68192*K112*<ALKEP>*<CARBOP> - PTERMS(:,22,112) = +0.68192*TPK%K112(:)*PCONC(:,34)*PCONC(:,39) + PTERMS(:,23,112) = +0.68192*TPK%K112(:)*PCONC(:,35)*PCONC(:,40) ! !PTERMS(ALD,K112) = +0.68374*K112*<ALKEP>*<CARBOP> - PTERMS(:,23,112) = +0.68374*TPK%K112(:)*PCONC(:,34)*PCONC(:,39) + PTERMS(:,24,112) = +0.68374*TPK%K112(:)*PCONC(:,35)*PCONC(:,40) ! !PTERMS(KET,K112) = +0.06579*K112*<ALKEP>*<CARBOP> - PTERMS(:,24,112) = +0.06579*TPK%K112(:)*PCONC(:,34)*PCONC(:,39) + PTERMS(:,25,112) = +0.06579*TPK%K112(:)*PCONC(:,35)*PCONC(:,40) ! !PTERMS(ORA2,K112) = +0.49922*K112*<ALKEP>*<CARBOP> - PTERMS(:,31,112) = +0.49922*TPK%K112(:)*PCONC(:,34)*PCONC(:,39) + PTERMS(:,32,112) = +0.49922*TPK%K112(:)*PCONC(:,35)*PCONC(:,40) ! !PTERMS(MO2,K112) = +0.50078*K112*<ALKEP>*<CARBOP> - PTERMS(:,32,112) = +0.50078*TPK%K112(:)*PCONC(:,34)*PCONC(:,39) + PTERMS(:,33,112) = +0.50078*TPK%K112(:)*PCONC(:,35)*PCONC(:,40) ! !PTERMS(ALKEP,K112) = -K112*<ALKEP>*<CARBOP> - PTERMS(:,34,112) = -TPK%K112(:)*PCONC(:,34)*PCONC(:,39) + PTERMS(:,35,112) = -TPK%K112(:)*PCONC(:,35)*PCONC(:,40) ! !PTERMS(CARBOP,K112) = -K112*<ALKEP>*<CARBOP> - PTERMS(:,39,112) = -TPK%K112(:)*PCONC(:,34)*PCONC(:,39) + PTERMS(:,40,112) = -TPK%K112(:)*PCONC(:,35)*PCONC(:,40) ! !PTERMS(HO2,K113) = +0.50600*K113*<BIOP>*<CARBOP> - PTERMS(:,15,113) = +0.50600*TPK%K113(:)*PCONC(:,35)*PCONC(:,39) + PTERMS(:,16,113) = +0.50600*TPK%K113(:)*PCONC(:,36)*PCONC(:,40) ! !PTERMS(ALKE,K113) = +0.24463*K113*<BIOP>*<CARBOP> - PTERMS(:,19,113) = +0.24463*TPK%K113(:)*PCONC(:,35)*PCONC(:,39) + PTERMS(:,20,113) = +0.24463*TPK%K113(:)*PCONC(:,36)*PCONC(:,40) ! !PTERMS(HCHO,K113) = +0.34000*K113*<BIOP>*<CARBOP> - PTERMS(:,22,113) = +0.34000*TPK%K113(:)*PCONC(:,35)*PCONC(:,39) + PTERMS(:,23,113) = +0.34000*TPK%K113(:)*PCONC(:,36)*PCONC(:,40) ! !PTERMS(ALD,K113) = +0.00000*K113*<BIOP>*<CARBOP> - PTERMS(:,23,113) = +0.00000*TPK%K113(:)*PCONC(:,35)*PCONC(:,39) + PTERMS(:,24,113) = +0.00000*TPK%K113(:)*PCONC(:,36)*PCONC(:,40) ! !PTERMS(KET,K113) = +0.00000*K113*<BIOP>*<CARBOP> - PTERMS(:,24,113) = +0.00000*TPK%K113(:)*PCONC(:,35)*PCONC(:,39) + PTERMS(:,25,113) = +0.00000*TPK%K113(:)*PCONC(:,36)*PCONC(:,40) ! !PTERMS(CARBO,K113) = +0.78591*K113*<BIOP>*<CARBOP> - PTERMS(:,25,113) = +0.78591*TPK%K113(:)*PCONC(:,35)*PCONC(:,39) + PTERMS(:,26,113) = +0.78591*TPK%K113(:)*PCONC(:,36)*PCONC(:,40) ! !PTERMS(ORA2,K113) = +0.49400*K113*<BIOP>*<CARBOP> - PTERMS(:,31,113) = +0.49400*TPK%K113(:)*PCONC(:,35)*PCONC(:,39) + PTERMS(:,32,113) = +0.49400*TPK%K113(:)*PCONC(:,36)*PCONC(:,40) ! !PTERMS(MO2,K113) = +0.50600*K113*<BIOP>*<CARBOP> - PTERMS(:,32,113) = +0.50600*TPK%K113(:)*PCONC(:,35)*PCONC(:,39) + PTERMS(:,33,113) = +0.50600*TPK%K113(:)*PCONC(:,36)*PCONC(:,40) ! !PTERMS(BIOP,K113) = -K113*<BIOP>*<CARBOP> - PTERMS(:,35,113) = -TPK%K113(:)*PCONC(:,35)*PCONC(:,39) + PTERMS(:,36,113) = -TPK%K113(:)*PCONC(:,36)*PCONC(:,40) ! ! RETURN @@ -34902,64 +35542,64 @@ SUBROUTINE SUBT25 !Indices 501 a 520 ! !PTERMS(CARBOP,K113) = -K113*<BIOP>*<CARBOP> - PTERMS(:,39,113) = -TPK%K113(:)*PCONC(:,35)*PCONC(:,39) + PTERMS(:,40,113) = -TPK%K113(:)*PCONC(:,36)*PCONC(:,40) ! !PTERMS(HO2,K114) = +K114*<AROP>*<CARBOP> - PTERMS(:,15,114) = +TPK%K114(:)*PCONC(:,38)*PCONC(:,39) + PTERMS(:,16,114) = +TPK%K114(:)*PCONC(:,39)*PCONC(:,40) ! !PTERMS(CARBO,K114) = +1.99455*K114*<AROP>*<CARBOP> - PTERMS(:,25,114) = +1.99455*TPK%K114(:)*PCONC(:,38)*PCONC(:,39) + PTERMS(:,26,114) = +1.99455*TPK%K114(:)*PCONC(:,39)*PCONC(:,40) ! !PTERMS(MO2,K114) = +K114*<AROP>*<CARBOP> - PTERMS(:,32,114) = +TPK%K114(:)*PCONC(:,38)*PCONC(:,39) + PTERMS(:,33,114) = +TPK%K114(:)*PCONC(:,39)*PCONC(:,40) ! !PTERMS(AROP,K114) = -K114*<AROP>*<CARBOP> - PTERMS(:,38,114) = -TPK%K114(:)*PCONC(:,38)*PCONC(:,39) + PTERMS(:,39,114) = -TPK%K114(:)*PCONC(:,39)*PCONC(:,40) ! !PTERMS(CARBOP,K114) = -K114*<AROP>*<CARBOP> - PTERMS(:,39,114) = -TPK%K114(:)*PCONC(:,38)*PCONC(:,39) + PTERMS(:,40,114) = -TPK%K114(:)*PCONC(:,39)*PCONC(:,40) ! !PTERMS(HO2,K115) = +0.07566*K115*<CARBOP>*<CARBOP> - PTERMS(:,15,115) = +0.07566*TPK%K115(:)*PCONC(:,39)*PCONC(:,39) + PTERMS(:,16,115) = +0.07566*TPK%K115(:)*PCONC(:,40)*PCONC(:,40) ! !PTERMS(HCHO,K115) = +0.03432*K115*<CARBOP>*<CARBOP> - PTERMS(:,22,115) = +0.03432*TPK%K115(:)*PCONC(:,39)*PCONC(:,39) + PTERMS(:,23,115) = +0.03432*TPK%K115(:)*PCONC(:,40)*PCONC(:,40) ! !PTERMS(ALD,K115) = +0.06969*K115*<CARBOP>*<CARBOP> - PTERMS(:,23,115) = +0.06969*TPK%K115(:)*PCONC(:,39)*PCONC(:,39) + PTERMS(:,24,115) = +0.06969*TPK%K115(:)*PCONC(:,40)*PCONC(:,40) ! !PTERMS(KET,K115) = +0.02190*K115*<CARBOP>*<CARBOP> - PTERMS(:,24,115) = +0.02190*TPK%K115(:)*PCONC(:,39)*PCONC(:,39) + PTERMS(:,25,115) = +0.02190*TPK%K115(:)*PCONC(:,40)*PCONC(:,40) ! !PTERMS(CARBO,K115) = +0.10777*K115*<CARBOP>*<CARBOP> - PTERMS(:,25,115) = +0.10777*TPK%K115(:)*PCONC(:,39)*PCONC(:,39) + PTERMS(:,26,115) = +0.10777*TPK%K115(:)*PCONC(:,40)*PCONC(:,40) ! !PTERMS(ORA2,K115) = +0.09955*K115*<CARBOP>*<CARBOP> - PTERMS(:,31,115) = +0.09955*TPK%K115(:)*PCONC(:,39)*PCONC(:,39) + PTERMS(:,32,115) = +0.09955*TPK%K115(:)*PCONC(:,40)*PCONC(:,40) ! !PTERMS(MO2,K115) = +1.66702*K115*<CARBOP>*<CARBOP> - PTERMS(:,32,115) = +1.66702*TPK%K115(:)*PCONC(:,39)*PCONC(:,39) + PTERMS(:,33,115) = +1.66702*TPK%K115(:)*PCONC(:,40)*PCONC(:,40) ! !PTERMS(CARBOP,K115) = -K115*<CARBOP>*<CARBOP> - PTERMS(:,39,115) = -TPK%K115(:)*PCONC(:,39)*PCONC(:,39) + PTERMS(:,40,115) = -TPK%K115(:)*PCONC(:,40)*PCONC(:,40) ! !PTERMS(XO2,K115) = +0.01593*K115*<CARBOP>*<CARBOP> - PTERMS(:,41,115) = +0.01593*TPK%K115(:)*PCONC(:,39)*PCONC(:,39) + PTERMS(:,42,115) = +0.01593*TPK%K115(:)*PCONC(:,40)*PCONC(:,40) ! !PTERMS(NO2,K116) = +0.00000*K116*<OLN>*<CARBOP> - PTERMS(:,4,116) = +0.00000*TPK%K116(:)*PCONC(:,40)*PCONC(:,39) + PTERMS(:,4,116) = +0.00000*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) ! !PTERMS(HO2,K116) = +0.17599*K116*<OLN>*<CARBOP> - PTERMS(:,15,116) = +0.17599*TPK%K116(:)*PCONC(:,40)*PCONC(:,39) + PTERMS(:,16,116) = +0.17599*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) ! !PTERMS(HCHO,K116) = +0.13414*K116*<OLN>*<CARBOP> - PTERMS(:,22,116) = +0.13414*TPK%K116(:)*PCONC(:,40)*PCONC(:,39) + PTERMS(:,23,116) = +0.13414*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) ! !PTERMS(ALD,K116) = +0.42122*K116*<OLN>*<CARBOP> - PTERMS(:,23,116) = +0.42122*TPK%K116(:)*PCONC(:,40)*PCONC(:,39) + PTERMS(:,24,116) = +0.42122*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) ! !PTERMS(KET,K116) = +0.10822*K116*<OLN>*<CARBOP> - PTERMS(:,24,116) = +0.10822*TPK%K116(:)*PCONC(:,40)*PCONC(:,39) + PTERMS(:,25,116) = +0.10822*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) ! ! RETURN @@ -34970,64 +35610,64 @@ SUBROUTINE SUBT26 !Indices 521 a 540 ! !PTERMS(ONIT,K116) = +0.66562*K116*<OLN>*<CARBOP> - PTERMS(:,26,116) = +0.66562*TPK%K116(:)*PCONC(:,40)*PCONC(:,39) + PTERMS(:,27,116) = +0.66562*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) ! !PTERMS(ORA2,K116) = +0.48963*K116*<OLN>*<CARBOP> - PTERMS(:,31,116) = +0.48963*TPK%K116(:)*PCONC(:,40)*PCONC(:,39) + PTERMS(:,32,116) = +0.48963*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) ! !PTERMS(MO2,K116) = +0.51037*K116*<OLN>*<CARBOP> - PTERMS(:,32,116) = +0.51037*TPK%K116(:)*PCONC(:,40)*PCONC(:,39) + PTERMS(:,33,116) = +0.51037*TPK%K116(:)*PCONC(:,41)*PCONC(:,40) ! !PTERMS(CARBOP,K116) = -K116*<OLN>*<CARBOP> - PTERMS(:,39,116) = -TPK%K116(:)*PCONC(:,40)*PCONC(:,39) + PTERMS(:,40,116) = -TPK%K116(:)*PCONC(:,41)*PCONC(:,40) ! !PTERMS(OLN,K116) = -K116*<OLN>*<CARBOP> - PTERMS(:,40,116) = -TPK%K116(:)*PCONC(:,40)*PCONC(:,39) + PTERMS(:,41,116) = -TPK%K116(:)*PCONC(:,41)*PCONC(:,40) ! !PTERMS(HO2,K117) = +K117*<OLN>*<OLN> - PTERMS(:,15,117) = +TPK%K117(:)*PCONC(:,40)*PCONC(:,40) + PTERMS(:,16,117) = +TPK%K117(:)*PCONC(:,41)*PCONC(:,41) ! !PTERMS(ONIT,K117) = +2.00*K117*<OLN>*<OLN> - PTERMS(:,26,117) = +2.00*TPK%K117(:)*PCONC(:,40)*PCONC(:,40) + PTERMS(:,27,117) = +2.00*TPK%K117(:)*PCONC(:,41)*PCONC(:,41) ! !PTERMS(OLN,K117) = -K117*<OLN>*<OLN> - PTERMS(:,40,117) = -TPK%K117(:)*PCONC(:,40)*PCONC(:,40) + PTERMS(:,41,117) = -TPK%K117(:)*PCONC(:,41)*PCONC(:,41) ! !PTERMS(NO2,K118) = +0.00000*K118*<OLN>*<OLN> - PTERMS(:,4,118) = +0.00000*TPK%K118(:)*PCONC(:,40)*PCONC(:,40) + PTERMS(:,4,118) = +0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,41) ! !PTERMS(HO2,K118) = +0.00000*K118*<OLN>*<OLN> - PTERMS(:,15,118) = +0.00000*TPK%K118(:)*PCONC(:,40)*PCONC(:,40) + PTERMS(:,16,118) = +0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,41) ! !PTERMS(HCHO,K118) = +0.00000*K118*<OLN>*<OLN> - PTERMS(:,22,118) = +0.00000*TPK%K118(:)*PCONC(:,40)*PCONC(:,40) + PTERMS(:,23,118) = +0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,41) ! !PTERMS(ALD,K118) = +0.00000*K118*<OLN>*<OLN> - PTERMS(:,23,118) = +0.00000*TPK%K118(:)*PCONC(:,40)*PCONC(:,40) + PTERMS(:,24,118) = +0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,41) ! !PTERMS(KET,K118) = +0.00000*K118*<OLN>*<OLN> - PTERMS(:,24,118) = +0.00000*TPK%K118(:)*PCONC(:,40)*PCONC(:,40) + PTERMS(:,25,118) = +0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,41) ! !PTERMS(ONIT,K118) = +0.00000*K118*<OLN>*<OLN> - PTERMS(:,26,118) = +0.00000*TPK%K118(:)*PCONC(:,40)*PCONC(:,40) + PTERMS(:,27,118) = +0.00000*TPK%K118(:)*PCONC(:,41)*PCONC(:,41) ! !PTERMS(OLN,K118) = -K118*<OLN>*<OLN> - PTERMS(:,40,118) = -TPK%K118(:)*PCONC(:,40)*PCONC(:,40) + PTERMS(:,41,118) = -TPK%K118(:)*PCONC(:,41)*PCONC(:,41) ! !PTERMS(NO2,K119) = +K119*<MO2>*<NO3> - PTERMS(:,4,119) = +TPK%K119(:)*PCONC(:,32)*PCONC(:,5) + PTERMS(:,4,119) = +TPK%K119(:)*PCONC(:,33)*PCONC(:,5) ! !PTERMS(NO3,K119) = -K119*<MO2>*<NO3> - PTERMS(:,5,119) = -TPK%K119(:)*PCONC(:,32)*PCONC(:,5) + PTERMS(:,5,119) = -TPK%K119(:)*PCONC(:,33)*PCONC(:,5) ! !PTERMS(HO2,K119) = +K119*<MO2>*<NO3> - PTERMS(:,15,119) = +TPK%K119(:)*PCONC(:,32)*PCONC(:,5) + PTERMS(:,16,119) = +TPK%K119(:)*PCONC(:,33)*PCONC(:,5) ! !PTERMS(HCHO,K119) = +K119*<MO2>*<NO3> - PTERMS(:,22,119) = +TPK%K119(:)*PCONC(:,32)*PCONC(:,5) + PTERMS(:,23,119) = +TPK%K119(:)*PCONC(:,33)*PCONC(:,5) ! !PTERMS(MO2,K119) = -K119*<MO2>*<NO3> - PTERMS(:,32,119) = -TPK%K119(:)*PCONC(:,32)*PCONC(:,5) + PTERMS(:,33,119) = -TPK%K119(:)*PCONC(:,33)*PCONC(:,5) ! ! RETURN @@ -35038,64 +35678,64 @@ SUBROUTINE SUBT27 !Indices 541 a 560 ! !PTERMS(NO2,K120) = +K120*<ALKAP>*<NO3> - PTERMS(:,4,120) = +TPK%K120(:)*PCONC(:,33)*PCONC(:,5) + PTERMS(:,4,120) = +TPK%K120(:)*PCONC(:,34)*PCONC(:,5) ! !PTERMS(NO3,K120) = -K120*<ALKAP>*<NO3> - PTERMS(:,5,120) = -TPK%K120(:)*PCONC(:,33)*PCONC(:,5) + PTERMS(:,5,120) = -TPK%K120(:)*PCONC(:,34)*PCONC(:,5) ! !PTERMS(HO2,K120) = +0.81290*K120*<ALKAP>*<NO3> - PTERMS(:,15,120) = +0.81290*TPK%K120(:)*PCONC(:,33)*PCONC(:,5) + PTERMS(:,16,120) = +0.81290*TPK%K120(:)*PCONC(:,34)*PCONC(:,5) ! !PTERMS(HCHO,K120) = +0.03142*K120*<ALKAP>*<NO3> - PTERMS(:,22,120) = +0.03142*TPK%K120(:)*PCONC(:,33)*PCONC(:,5) + PTERMS(:,23,120) = +0.03142*TPK%K120(:)*PCONC(:,34)*PCONC(:,5) ! !PTERMS(ALD,K120) = +0.33743*K120*<ALKAP>*<NO3> - PTERMS(:,23,120) = +0.33743*TPK%K120(:)*PCONC(:,33)*PCONC(:,5) + PTERMS(:,24,120) = +0.33743*TPK%K120(:)*PCONC(:,34)*PCONC(:,5) ! !PTERMS(KET,K120) = +0.62978*K120*<ALKAP>*<NO3> - PTERMS(:,24,120) = +0.62978*TPK%K120(:)*PCONC(:,33)*PCONC(:,5) + PTERMS(:,25,120) = +0.62978*TPK%K120(:)*PCONC(:,34)*PCONC(:,5) ! !PTERMS(CARBO,K120) = +0.03531*K120*<ALKAP>*<NO3> - PTERMS(:,25,120) = +0.03531*TPK%K120(:)*PCONC(:,33)*PCONC(:,5) + PTERMS(:,26,120) = +0.03531*TPK%K120(:)*PCONC(:,34)*PCONC(:,5) ! !PTERMS(MO2,K120) = +0.09731*K120*<ALKAP>*<NO3> - PTERMS(:,32,120) = +0.09731*TPK%K120(:)*PCONC(:,33)*PCONC(:,5) + PTERMS(:,33,120) = +0.09731*TPK%K120(:)*PCONC(:,34)*PCONC(:,5) ! !PTERMS(ALKAP,K120) = -K120*<ALKAP>*<NO3> - PTERMS(:,33,120) = -TPK%K120(:)*PCONC(:,33)*PCONC(:,5) + PTERMS(:,34,120) = -TPK%K120(:)*PCONC(:,34)*PCONC(:,5) ! !PTERMS(XO2,K120) = +0.16271*K120*<ALKAP>*<NO3> - PTERMS(:,41,120) = +0.16271*TPK%K120(:)*PCONC(:,33)*PCONC(:,5) + PTERMS(:,42,120) = +0.16271*TPK%K120(:)*PCONC(:,34)*PCONC(:,5) ! !PTERMS(NO2,K121) = +K121*<ALKEP>*<NO3> - PTERMS(:,4,121) = +TPK%K121(:)*PCONC(:,34)*PCONC(:,5) + PTERMS(:,4,121) = +TPK%K121(:)*PCONC(:,35)*PCONC(:,5) ! !PTERMS(NO3,K121) = -K121*<ALKEP>*<NO3> - PTERMS(:,5,121) = -TPK%K121(:)*PCONC(:,34)*PCONC(:,5) + PTERMS(:,5,121) = -TPK%K121(:)*PCONC(:,35)*PCONC(:,5) ! !PTERMS(HO2,K121) = +K121*<ALKEP>*<NO3> - PTERMS(:,15,121) = +TPK%K121(:)*PCONC(:,34)*PCONC(:,5) + PTERMS(:,16,121) = +TPK%K121(:)*PCONC(:,35)*PCONC(:,5) ! !PTERMS(HCHO,K121) = +1.40909*K121*<ALKEP>*<NO3> - PTERMS(:,22,121) = +1.40909*TPK%K121(:)*PCONC(:,34)*PCONC(:,5) + PTERMS(:,23,121) = +1.40909*TPK%K121(:)*PCONC(:,35)*PCONC(:,5) ! !PTERMS(ALD,K121) = +0.43039*K121*<ALKEP>*<NO3> - PTERMS(:,23,121) = +0.43039*TPK%K121(:)*PCONC(:,34)*PCONC(:,5) + PTERMS(:,24,121) = +0.43039*TPK%K121(:)*PCONC(:,35)*PCONC(:,5) ! !PTERMS(KET,K121) = +0.02051*K121*<ALKEP>*<NO3> - PTERMS(:,24,121) = +0.02051*TPK%K121(:)*PCONC(:,34)*PCONC(:,5) + PTERMS(:,25,121) = +0.02051*TPK%K121(:)*PCONC(:,35)*PCONC(:,5) ! !PTERMS(ALKEP,K121) = -K121*<ALKEP>*<NO3> - PTERMS(:,34,121) = -TPK%K121(:)*PCONC(:,34)*PCONC(:,5) + PTERMS(:,35,121) = -TPK%K121(:)*PCONC(:,35)*PCONC(:,5) ! !PTERMS(NO2,K122) = +K122*<BIOP>*<NO3> - PTERMS(:,4,122) = +TPK%K122(:)*PCONC(:,35)*PCONC(:,5) + PTERMS(:,4,122) = +TPK%K122(:)*PCONC(:,36)*PCONC(:,5) ! !PTERMS(NO3,K122) = -K122*<BIOP>*<NO3> - PTERMS(:,5,122) = -TPK%K122(:)*PCONC(:,35)*PCONC(:,5) + PTERMS(:,5,122) = -TPK%K122(:)*PCONC(:,36)*PCONC(:,5) ! !PTERMS(HO2,K122) = +K122*<BIOP>*<NO3> - PTERMS(:,15,122) = +TPK%K122(:)*PCONC(:,35)*PCONC(:,5) + PTERMS(:,16,122) = +TPK%K122(:)*PCONC(:,36)*PCONC(:,5) ! ! RETURN @@ -35106,64 +35746,64 @@ SUBROUTINE SUBT28 !Indices 561 a 580 ! !PTERMS(ALKE,K122) = +0.42729*K122*<BIOP>*<NO3> - PTERMS(:,19,122) = +0.42729*TPK%K122(:)*PCONC(:,35)*PCONC(:,5) + PTERMS(:,20,122) = +0.42729*TPK%K122(:)*PCONC(:,36)*PCONC(:,5) ! !PTERMS(HCHO,K122) = +0.68600*K122*<BIOP>*<NO3> - PTERMS(:,22,122) = +0.68600*TPK%K122(:)*PCONC(:,35)*PCONC(:,5) + PTERMS(:,23,122) = +0.68600*TPK%K122(:)*PCONC(:,36)*PCONC(:,5) ! !PTERMS(ALD,K122) = +0.00000*K122*<BIOP>*<NO3> - PTERMS(:,23,122) = +0.00000*TPK%K122(:)*PCONC(:,35)*PCONC(:,5) + PTERMS(:,24,122) = +0.00000*TPK%K122(:)*PCONC(:,36)*PCONC(:,5) ! !PTERMS(KET,K122) = +0.00000*K122*<BIOP>*<NO3> - PTERMS(:,24,122) = +0.00000*TPK%K122(:)*PCONC(:,35)*PCONC(:,5) + PTERMS(:,25,122) = +0.00000*TPK%K122(:)*PCONC(:,36)*PCONC(:,5) ! !PTERMS(CARBO,K122) = +0.61160*K122*<BIOP>*<NO3> - PTERMS(:,25,122) = +0.61160*TPK%K122(:)*PCONC(:,35)*PCONC(:,5) + PTERMS(:,26,122) = +0.61160*TPK%K122(:)*PCONC(:,36)*PCONC(:,5) ! !PTERMS(BIOP,K122) = -K122*<BIOP>*<NO3> - PTERMS(:,35,122) = -TPK%K122(:)*PCONC(:,35)*PCONC(:,5) + PTERMS(:,36,122) = -TPK%K122(:)*PCONC(:,36)*PCONC(:,5) ! !PTERMS(NO2,K123) = +K123*<AROP>*<NO3> - PTERMS(:,4,123) = +TPK%K123(:)*PCONC(:,38)*PCONC(:,5) + PTERMS(:,4,123) = +TPK%K123(:)*PCONC(:,39)*PCONC(:,5) ! !PTERMS(NO3,K123) = -K123*<AROP>*<NO3> - PTERMS(:,5,123) = -TPK%K123(:)*PCONC(:,38)*PCONC(:,5) + PTERMS(:,5,123) = -TPK%K123(:)*PCONC(:,39)*PCONC(:,5) ! !PTERMS(HO2,K123) = +K123*<AROP>*<NO3> - PTERMS(:,15,123) = +TPK%K123(:)*PCONC(:,38)*PCONC(:,5) + PTERMS(:,16,123) = +TPK%K123(:)*PCONC(:,39)*PCONC(:,5) ! !PTERMS(CARBO,K123) = +2.81904*K123*<AROP>*<NO3> - PTERMS(:,25,123) = +2.81904*TPK%K123(:)*PCONC(:,38)*PCONC(:,5) + PTERMS(:,26,123) = +2.81904*TPK%K123(:)*PCONC(:,39)*PCONC(:,5) ! !PTERMS(AROP,K123) = -K123*<AROP>*<NO3> - PTERMS(:,38,123) = -TPK%K123(:)*PCONC(:,38)*PCONC(:,5) + PTERMS(:,39,123) = -TPK%K123(:)*PCONC(:,39)*PCONC(:,5) ! !PTERMS(NO2,K124) = +K124*<CARBOP>*<NO3> - PTERMS(:,4,124) = +TPK%K124(:)*PCONC(:,39)*PCONC(:,5) + PTERMS(:,4,124) = +TPK%K124(:)*PCONC(:,40)*PCONC(:,5) ! !PTERMS(NO3,K124) = -K124*<CARBOP>*<NO3> - PTERMS(:,5,124) = -TPK%K124(:)*PCONC(:,39)*PCONC(:,5) + PTERMS(:,5,124) = -TPK%K124(:)*PCONC(:,40)*PCONC(:,5) ! !PTERMS(HO2,K124) = +0.04915*K124*<CARBOP>*<NO3> - PTERMS(:,15,124) = +0.04915*TPK%K124(:)*PCONC(:,39)*PCONC(:,5) + PTERMS(:,16,124) = +0.04915*TPK%K124(:)*PCONC(:,40)*PCONC(:,5) ! !PTERMS(HCHO,K124) = +0.03175*K124*<CARBOP>*<NO3> - PTERMS(:,22,124) = +0.03175*TPK%K124(:)*PCONC(:,39)*PCONC(:,5) + PTERMS(:,23,124) = +0.03175*TPK%K124(:)*PCONC(:,40)*PCONC(:,5) ! !PTERMS(ALD,K124) = +0.02936*K124*<CARBOP>*<NO3> - PTERMS(:,23,124) = +0.02936*TPK%K124(:)*PCONC(:,39)*PCONC(:,5) + PTERMS(:,24,124) = +0.02936*TPK%K124(:)*PCONC(:,40)*PCONC(:,5) ! !PTERMS(CARBO,K124) = +0.03455*K124*<CARBOP>*<NO3> - PTERMS(:,25,124) = +0.03455*TPK%K124(:)*PCONC(:,39)*PCONC(:,5) + PTERMS(:,26,124) = +0.03455*TPK%K124(:)*PCONC(:,40)*PCONC(:,5) ! !PTERMS(MO2,K124) = +0.91910*K124*<CARBOP>*<NO3> - PTERMS(:,32,124) = +0.91910*TPK%K124(:)*PCONC(:,39)*PCONC(:,5) + PTERMS(:,33,124) = +0.91910*TPK%K124(:)*PCONC(:,40)*PCONC(:,5) ! !PTERMS(CARBOP,K124) = -K124*<CARBOP>*<NO3> - PTERMS(:,39,124) = -TPK%K124(:)*PCONC(:,39)*PCONC(:,5) + PTERMS(:,40,124) = -TPK%K124(:)*PCONC(:,40)*PCONC(:,5) ! !PTERMS(XO2,K124) = +0.01021*K124*<CARBOP>*<NO3> - PTERMS(:,41,124) = +0.01021*TPK%K124(:)*PCONC(:,39)*PCONC(:,5) + PTERMS(:,42,124) = +0.01021*TPK%K124(:)*PCONC(:,40)*PCONC(:,5) ! ! RETURN @@ -35174,64 +35814,64 @@ SUBROUTINE SUBT29 !Indices 581 a 600 ! !PTERMS(NO2,K125) = +1.74072*K125*<OLN>*<NO3> - PTERMS(:,4,125) = +1.74072*TPK%K125(:)*PCONC(:,40)*PCONC(:,5) + PTERMS(:,4,125) = +1.74072*TPK%K125(:)*PCONC(:,41)*PCONC(:,5) ! !PTERMS(NO3,K125) = -K125*<OLN>*<NO3> - PTERMS(:,5,125) = -TPK%K125(:)*PCONC(:,40)*PCONC(:,5) + PTERMS(:,5,125) = -TPK%K125(:)*PCONC(:,41)*PCONC(:,5) ! !PTERMS(HO2,K125) = +0.25928*K125*<OLN>*<NO3> - PTERMS(:,15,125) = +0.25928*TPK%K125(:)*PCONC(:,40)*PCONC(:,5) + PTERMS(:,16,125) = +0.25928*TPK%K125(:)*PCONC(:,41)*PCONC(:,5) ! !PTERMS(HCHO,K125) = +0.20740*K125*<OLN>*<NO3> - PTERMS(:,22,125) = +0.20740*TPK%K125(:)*PCONC(:,40)*PCONC(:,5) + PTERMS(:,23,125) = +0.20740*TPK%K125(:)*PCONC(:,41)*PCONC(:,5) ! !PTERMS(ALD,K125) = +0.91850*K125*<OLN>*<NO3> - PTERMS(:,23,125) = +0.91850*TPK%K125(:)*PCONC(:,40)*PCONC(:,5) + PTERMS(:,24,125) = +0.91850*TPK%K125(:)*PCONC(:,41)*PCONC(:,5) ! !PTERMS(KET,K125) = +0.34740*K125*<OLN>*<NO3> - PTERMS(:,24,125) = +0.34740*TPK%K125(:)*PCONC(:,40)*PCONC(:,5) + PTERMS(:,25,125) = +0.34740*TPK%K125(:)*PCONC(:,41)*PCONC(:,5) ! !PTERMS(ONIT,K125) = +0.25928*K125*<OLN>*<NO3> - PTERMS(:,26,125) = +0.25928*TPK%K125(:)*PCONC(:,40)*PCONC(:,5) + PTERMS(:,27,125) = +0.25928*TPK%K125(:)*PCONC(:,41)*PCONC(:,5) ! !PTERMS(OLN,K125) = -K125*<OLN>*<NO3> - PTERMS(:,40,125) = -TPK%K125(:)*PCONC(:,40)*PCONC(:,5) + PTERMS(:,41,125) = -TPK%K125(:)*PCONC(:,41)*PCONC(:,5) ! !PTERMS(HO2,K126) = -K126*<XO2>*<HO2> - PTERMS(:,15,126) = -TPK%K126(:)*PCONC(:,41)*PCONC(:,15) + PTERMS(:,16,126) = -TPK%K126(:)*PCONC(:,42)*PCONC(:,16) ! !PTERMS(OP2,K126) = +1.00524*K126*<XO2>*<HO2> - PTERMS(:,29,126) = +1.00524*TPK%K126(:)*PCONC(:,41)*PCONC(:,15) + PTERMS(:,30,126) = +1.00524*TPK%K126(:)*PCONC(:,42)*PCONC(:,16) ! !PTERMS(XO2,K126) = -K126*<XO2>*<HO2> - PTERMS(:,41,126) = -TPK%K126(:)*PCONC(:,41)*PCONC(:,15) + PTERMS(:,42,126) = -TPK%K126(:)*PCONC(:,42)*PCONC(:,16) ! !PTERMS(HO2,K127) = +K127*<XO2>*<MO2> - PTERMS(:,15,127) = +TPK%K127(:)*PCONC(:,41)*PCONC(:,32) + PTERMS(:,16,127) = +TPK%K127(:)*PCONC(:,42)*PCONC(:,33) ! !PTERMS(HCHO,K127) = +K127*<XO2>*<MO2> - PTERMS(:,22,127) = +TPK%K127(:)*PCONC(:,41)*PCONC(:,32) + PTERMS(:,23,127) = +TPK%K127(:)*PCONC(:,42)*PCONC(:,33) ! !PTERMS(MO2,K127) = -K127*<XO2>*<MO2> - PTERMS(:,32,127) = -TPK%K127(:)*PCONC(:,41)*PCONC(:,32) + PTERMS(:,33,127) = -TPK%K127(:)*PCONC(:,42)*PCONC(:,33) ! !PTERMS(XO2,K127) = -K127*<XO2>*<MO2> - PTERMS(:,41,127) = -TPK%K127(:)*PCONC(:,41)*PCONC(:,32) + PTERMS(:,42,127) = -TPK%K127(:)*PCONC(:,42)*PCONC(:,33) ! !PTERMS(MO2,K128) = +K128*<XO2>*<CARBOP> - PTERMS(:,32,128) = +TPK%K128(:)*PCONC(:,41)*PCONC(:,39) + PTERMS(:,33,128) = +TPK%K128(:)*PCONC(:,42)*PCONC(:,40) ! !PTERMS(CARBOP,K128) = -K128*<XO2>*<CARBOP> - PTERMS(:,39,128) = -TPK%K128(:)*PCONC(:,41)*PCONC(:,39) + PTERMS(:,40,128) = -TPK%K128(:)*PCONC(:,42)*PCONC(:,40) ! !PTERMS(XO2,K128) = -K128*<XO2>*<CARBOP> - PTERMS(:,41,128) = -TPK%K128(:)*PCONC(:,41)*PCONC(:,39) + PTERMS(:,42,128) = -TPK%K128(:)*PCONC(:,42)*PCONC(:,40) ! !PTERMS(XO2,K129) = -K129*<XO2>*<XO2> - PTERMS(:,41,129) = -TPK%K129(:)*PCONC(:,41)*PCONC(:,41) + PTERMS(:,42,129) = -TPK%K129(:)*PCONC(:,42)*PCONC(:,42) ! !PTERMS(NO,K130) = -K130*<XO2>*<NO> - PTERMS(:,3,130) = -TPK%K130(:)*PCONC(:,41)*PCONC(:,3) + PTERMS(:,3,130) = -TPK%K130(:)*PCONC(:,42)*PCONC(:,3) ! ! RETURN @@ -35239,25 +35879,52 @@ END SUBROUTINE SUBT29 ! SUBROUTINE SUBT30 ! -!Indices 601 a 606 +!Indices 601 a 615 ! !PTERMS(NO2,K130) = +K130*<XO2>*<NO> - PTERMS(:,4,130) = +TPK%K130(:)*PCONC(:,41)*PCONC(:,3) + PTERMS(:,4,130) = +TPK%K130(:)*PCONC(:,42)*PCONC(:,3) ! !PTERMS(XO2,K130) = -K130*<XO2>*<NO> - PTERMS(:,41,130) = -TPK%K130(:)*PCONC(:,41)*PCONC(:,3) + PTERMS(:,42,130) = -TPK%K130(:)*PCONC(:,42)*PCONC(:,3) ! !PTERMS(NO2,K131) = +K131*<XO2>*<NO3> - PTERMS(:,4,131) = +TPK%K131(:)*PCONC(:,41)*PCONC(:,5) + PTERMS(:,4,131) = +TPK%K131(:)*PCONC(:,42)*PCONC(:,5) ! !PTERMS(NO3,K131) = -K131*<XO2>*<NO3> - PTERMS(:,5,131) = -TPK%K131(:)*PCONC(:,41)*PCONC(:,5) + PTERMS(:,5,131) = -TPK%K131(:)*PCONC(:,42)*PCONC(:,5) ! !PTERMS(XO2,K131) = -K131*<XO2>*<NO3> - PTERMS(:,41,131) = -TPK%K131(:)*PCONC(:,41)*PCONC(:,5) + PTERMS(:,42,131) = -TPK%K131(:)*PCONC(:,42)*PCONC(:,5) ! !PTERMS(SULF,K132) = -K132*<SULF> - PTERMS(:,12,132) = -TPK%K132(:)*PCONC(:,12) + PTERMS(:,13,132) = -TPK%K132(:)*PCONC(:,13) +! +!PTERMS(NO2,K133) = +K133*<DMS>*<NO3> + PTERMS(:,4,133) = +TPK%K133(:)*PCONC(:,11)*PCONC(:,5) +! +!PTERMS(NO3,K133) = -K133*<DMS>*<NO3> + PTERMS(:,5,133) = -TPK%K133(:)*PCONC(:,11)*PCONC(:,5) +! +!PTERMS(DMS,K133) = -K133*<DMS>*<NO3> + PTERMS(:,11,133) = -TPK%K133(:)*PCONC(:,11)*PCONC(:,5) +! +!PTERMS(SO2,K133) = +K133*<DMS>*<NO3> + PTERMS(:,12,133) = +TPK%K133(:)*PCONC(:,11)*PCONC(:,5) +! +!PTERMS(DMS,K134) = -K134*<DMS>*<O3P> + PTERMS(:,11,134) = -TPK%K134(:)*PCONC(:,11)*TPK%O3P(:) +! +!PTERMS(SO2,K134) = +K134*<DMS>*<O3P> + PTERMS(:,12,134) = +TPK%K134(:)*PCONC(:,11)*TPK%O3P(:) +! +!PTERMS(DMS,K135) = -K135*<DMS>*<OH> + PTERMS(:,11,135) = -TPK%K135(:)*PCONC(:,11)*PCONC(:,15) +! +!PTERMS(SO2,K135) = +0.8*K135*<DMS>*<OH> + PTERMS(:,12,135) = +0.8*TPK%K135(:)*PCONC(:,11)*PCONC(:,15) +! +!PTERMS(OH,K135) = -K135*<DMS>*<OH> + PTERMS(:,15,135) = -TPK%K135(:)*PCONC(:,11)*PCONC(:,15) ! ! RETURN @@ -35371,7 +36038,7 @@ CONTAINS !! !! EXTERNAL !! -------- -use mode_msg +!! none !! !! IMPLICIT ARGUMENTS !! ------------------ @@ -35381,8 +36048,8 @@ use mode_msg !! ------------------ IMPLICIT NONE ! check if output array is large enough -IF (KINDEXDIM.LT.942) THEN - call Print_msg( NVERB_FATAL, 'GEN', 'CH_NONZEROTERMS_AQ', 'array KINDEX is too small' ) +IF (KINDEXDIM.LT.951) THEN + STOP 'CH_NONZEROTERMS ERROR: array KINDEX is too small!' END IF KINDEX(1, 1)=3 KINDEX(2, 1)=1 @@ -35396,13 +36063,13 @@ END IF KINDEX(2, 5)=4 KINDEX(1, 6)=7 KINDEX(2, 6)=4 - KINDEX(1, 7)=14 + KINDEX(1, 7)=15 KINDEX(2, 7)=4 KINDEX(1, 8)=4 KINDEX(2, 8)=5 KINDEX(1, 9)=8 KINDEX(2, 9)=5 - KINDEX(1, 10)=14 + KINDEX(1, 10)=15 KINDEX(2, 10)=5 KINDEX(1, 11)=4 KINDEX(2, 11)=6 @@ -35410,9 +36077,9 @@ END IF KINDEX(2, 12)=6 KINDEX(1, 13)=9 KINDEX(2, 13)=6 - KINDEX(1, 14)=14 + KINDEX(1, 14)=15 KINDEX(2, 14)=6 - KINDEX(1, 15)=15 + KINDEX(1, 15)=16 KINDEX(2, 15)=6 KINDEX(1, 16)=3 KINDEX(2, 16)=7 @@ -35424,105 +36091,105 @@ END IF KINDEX(2, 19)=8 KINDEX(1, 20)=2 KINDEX(2, 20)=9 - KINDEX(1, 21)=14 + KINDEX(1, 21)=15 KINDEX(2, 21)=9 - KINDEX(1, 22)=13 + KINDEX(1, 22)=14 KINDEX(2, 22)=10 - KINDEX(1, 23)=22 + KINDEX(1, 23)=23 KINDEX(2, 23)=10 - KINDEX(1, 24)=13 + KINDEX(1, 24)=14 KINDEX(2, 24)=11 - KINDEX(1, 25)=15 + KINDEX(1, 25)=16 KINDEX(2, 25)=11 - KINDEX(1, 26)=22 + KINDEX(1, 26)=23 KINDEX(2, 26)=11 - KINDEX(1, 27)=13 + KINDEX(1, 27)=14 KINDEX(2, 27)=12 - KINDEX(1, 28)=15 + KINDEX(1, 28)=16 KINDEX(2, 28)=12 - KINDEX(1, 29)=23 + KINDEX(1, 29)=24 KINDEX(2, 29)=12 - KINDEX(1, 30)=32 + KINDEX(1, 30)=33 KINDEX(2, 30)=12 - KINDEX(1, 31)=14 + KINDEX(1, 31)=15 KINDEX(2, 31)=13 - KINDEX(1, 32)=15 + KINDEX(1, 32)=16 KINDEX(2, 32)=13 - KINDEX(1, 33)=22 + KINDEX(1, 33)=23 KINDEX(2, 33)=13 - KINDEX(1, 34)=28 + KINDEX(1, 34)=29 KINDEX(2, 34)=13 - KINDEX(1, 35)=14 + KINDEX(1, 35)=15 KINDEX(2, 35)=14 - KINDEX(1, 36)=15 + KINDEX(1, 36)=16 KINDEX(2, 36)=14 - KINDEX(1, 37)=23 + KINDEX(1, 37)=24 KINDEX(2, 37)=14 - KINDEX(1, 38)=29 + KINDEX(1, 38)=30 KINDEX(2, 38)=14 - KINDEX(1, 39)=32 + KINDEX(1, 39)=33 KINDEX(2, 39)=14 - KINDEX(1, 40)=24 + KINDEX(1, 40)=25 KINDEX(2, 40)=15 - KINDEX(1, 41)=33 + KINDEX(1, 41)=34 KINDEX(2, 41)=15 - KINDEX(1, 42)=39 + KINDEX(1, 42)=40 KINDEX(2, 42)=15 - KINDEX(1, 43)=13 + KINDEX(1, 43)=14 KINDEX(2, 43)=16 - KINDEX(1, 44)=15 + KINDEX(1, 44)=16 KINDEX(2, 44)=16 - KINDEX(1, 45)=22 + KINDEX(1, 45)=23 KINDEX(2, 45)=16 - KINDEX(1, 46)=25 + KINDEX(1, 46)=26 KINDEX(2, 46)=16 - KINDEX(1, 47)=39 + KINDEX(1, 47)=40 KINDEX(2, 47)=16 KINDEX(1, 48)=4 KINDEX(2, 48)=17 - KINDEX(1, 49)=15 + KINDEX(1, 49)=16 KINDEX(2, 49)=17 - KINDEX(1, 50)=23 + KINDEX(1, 50)=24 KINDEX(2, 50)=17 - KINDEX(1, 51)=24 + KINDEX(1, 51)=25 KINDEX(2, 51)=17 - KINDEX(1, 52)=26 + KINDEX(1, 52)=27 KINDEX(2, 52)=17 KINDEX(1, 53)=1 KINDEX(2, 53)=18 KINDEX(1, 54)=1 KINDEX(2, 54)=19 - KINDEX(1, 55)=14 + KINDEX(1, 55)=15 KINDEX(2, 55)=22 KINDEX(1, 56)=1 KINDEX(2, 56)=23 - KINDEX(1, 57)=14 + KINDEX(1, 57)=15 KINDEX(2, 57)=23 - KINDEX(1, 58)=15 + KINDEX(1, 58)=16 KINDEX(2, 58)=23 KINDEX(1, 59)=1 KINDEX(2, 59)=24 - KINDEX(1, 60)=14 + KINDEX(1, 60)=15 KINDEX(2, 60)=24 - KINDEX(1, 61)=15 + KINDEX(1, 61)=16 KINDEX(2, 61)=24 - KINDEX(1, 62)=14 + KINDEX(1, 62)=15 KINDEX(2, 62)=25 - KINDEX(1, 63)=15 + KINDEX(1, 63)=16 KINDEX(2, 63)=25 KINDEX(1, 64)=2 KINDEX(2, 64)=26 - KINDEX(1, 65)=14 + KINDEX(1, 65)=15 KINDEX(2, 65)=26 - KINDEX(1, 66)=15 + KINDEX(1, 66)=16 KINDEX(2, 66)=26 KINDEX(1, 67)=2 KINDEX(2, 67)=27 - KINDEX(1, 68)=15 + KINDEX(1, 68)=16 KINDEX(2, 68)=27 KINDEX(1, 69)=2 KINDEX(2, 69)=28 - KINDEX(1, 70)=15 + KINDEX(1, 70)=16 KINDEX(2, 70)=28 KINDEX(1, 71)=3 KINDEX(2, 71)=29 @@ -35540,41 +36207,41 @@ END IF KINDEX(2, 77)=32 KINDEX(1, 78)=7 KINDEX(2, 78)=32 - KINDEX(1, 79)=14 + KINDEX(1, 79)=15 KINDEX(2, 79)=32 KINDEX(1, 80)=4 KINDEX(2, 80)=33 KINDEX(1, 81)=8 KINDEX(2, 81)=33 - KINDEX(1, 82)=14 + KINDEX(1, 82)=15 KINDEX(2, 82)=33 KINDEX(1, 83)=4 KINDEX(2, 83)=34 KINDEX(1, 84)=5 KINDEX(2, 84)=34 - KINDEX(1, 85)=14 + KINDEX(1, 85)=15 KINDEX(2, 85)=34 - KINDEX(1, 86)=15 + KINDEX(1, 86)=16 KINDEX(2, 86)=34 KINDEX(1, 87)=3 KINDEX(2, 87)=35 KINDEX(1, 88)=4 KINDEX(2, 88)=35 - KINDEX(1, 89)=14 + KINDEX(1, 89)=15 KINDEX(2, 89)=35 - KINDEX(1, 90)=15 + KINDEX(1, 90)=16 KINDEX(2, 90)=35 KINDEX(1, 91)=4 KINDEX(2, 91)=36 KINDEX(1, 92)=9 KINDEX(2, 92)=36 - KINDEX(1, 93)=15 + KINDEX(1, 93)=16 KINDEX(2, 93)=36 KINDEX(1, 94)=4 KINDEX(2, 94)=37 KINDEX(1, 95)=9 KINDEX(2, 95)=37 - KINDEX(1, 96)=15 + KINDEX(1, 96)=16 KINDEX(2, 96)=37 KINDEX(1, 97)=4 KINDEX(2, 97)=38 @@ -35582,27 +36249,27 @@ END IF KINDEX(2, 98)=38 KINDEX(1, 99)=8 KINDEX(2, 99)=38 - KINDEX(1, 100)=14 + KINDEX(1, 100)=15 KINDEX(2, 100)=38 - KINDEX(1, 101)=15 + KINDEX(1, 101)=16 KINDEX(2, 101)=38 KINDEX(1, 102)=4 KINDEX(2, 102)=39 KINDEX(1, 103)=7 KINDEX(2, 103)=39 - KINDEX(1, 104)=14 + KINDEX(1, 104)=15 KINDEX(2, 104)=39 KINDEX(1, 105)=5 KINDEX(2, 105)=40 KINDEX(1, 106)=8 KINDEX(2, 106)=40 - KINDEX(1, 107)=14 + KINDEX(1, 107)=15 KINDEX(2, 107)=40 KINDEX(1, 108)=4 KINDEX(2, 108)=41 KINDEX(1, 109)=9 KINDEX(2, 109)=41 - KINDEX(1, 110)=14 + KINDEX(1, 110)=15 KINDEX(2, 110)=41 KINDEX(1, 111)=1 KINDEX(2, 111)=42 @@ -35650,217 +36317,217 @@ END IF KINDEX(2, 132)=49 KINDEX(1, 133)=10 KINDEX(2, 133)=50 - KINDEX(1, 134)=14 + KINDEX(1, 134)=15 KINDEX(2, 134)=50 - KINDEX(1, 135)=14 + KINDEX(1, 135)=15 KINDEX(2, 135)=51 - KINDEX(1, 136)=15 + KINDEX(1, 136)=16 KINDEX(2, 136)=51 - KINDEX(1, 137)=11 + KINDEX(1, 137)=12 KINDEX(2, 137)=52 - KINDEX(1, 138)=12 + KINDEX(1, 138)=13 KINDEX(2, 138)=52 - KINDEX(1, 139)=14 + KINDEX(1, 139)=15 KINDEX(2, 139)=52 - KINDEX(1, 140)=15 + KINDEX(1, 140)=16 KINDEX(2, 140)=52 - KINDEX(1, 141)=13 + KINDEX(1, 141)=14 KINDEX(2, 141)=53 - KINDEX(1, 142)=14 + KINDEX(1, 142)=15 KINDEX(2, 142)=53 - KINDEX(1, 143)=15 + KINDEX(1, 143)=16 KINDEX(2, 143)=53 - KINDEX(1, 144)=13 + KINDEX(1, 144)=14 KINDEX(2, 144)=54 - KINDEX(1, 145)=14 + KINDEX(1, 145)=15 KINDEX(2, 145)=54 - KINDEX(1, 146)=15 + KINDEX(1, 146)=16 KINDEX(2, 146)=54 - KINDEX(1, 147)=19 + KINDEX(1, 147)=20 KINDEX(2, 147)=54 - KINDEX(1, 148)=20 + KINDEX(1, 148)=21 KINDEX(2, 148)=54 - KINDEX(1, 149)=22 + KINDEX(1, 149)=23 KINDEX(2, 149)=54 - KINDEX(1, 150)=25 + KINDEX(1, 150)=26 KINDEX(2, 150)=54 - KINDEX(1, 151)=41 + KINDEX(1, 151)=42 KINDEX(2, 151)=54 - KINDEX(1, 152)=23 + KINDEX(1, 152)=24 KINDEX(2, 152)=55 - KINDEX(1, 153)=25 + KINDEX(1, 153)=26 KINDEX(2, 153)=55 - KINDEX(1, 154)=14 + KINDEX(1, 154)=15 KINDEX(2, 154)=56 - KINDEX(1, 155)=16 + KINDEX(1, 155)=17 KINDEX(2, 155)=56 - KINDEX(1, 156)=32 + KINDEX(1, 156)=33 KINDEX(2, 156)=56 - KINDEX(1, 157)=14 + KINDEX(1, 157)=15 KINDEX(2, 157)=57 - KINDEX(1, 158)=17 + KINDEX(1, 158)=18 KINDEX(2, 158)=57 - KINDEX(1, 159)=33 + KINDEX(1, 159)=34 KINDEX(2, 159)=57 - KINDEX(1, 160)=13 + KINDEX(1, 160)=14 KINDEX(2, 160)=58 - KINDEX(1, 161)=14 + KINDEX(1, 161)=15 KINDEX(2, 161)=58 - KINDEX(1, 162)=15 + KINDEX(1, 162)=16 KINDEX(2, 162)=58 - KINDEX(1, 163)=18 + KINDEX(1, 163)=19 KINDEX(2, 163)=58 - KINDEX(1, 164)=22 + KINDEX(1, 164)=23 KINDEX(2, 164)=58 - KINDEX(1, 165)=23 + KINDEX(1, 165)=24 KINDEX(2, 165)=58 - KINDEX(1, 166)=24 + KINDEX(1, 166)=25 KINDEX(2, 166)=58 - KINDEX(1, 167)=25 + KINDEX(1, 167)=26 KINDEX(2, 167)=58 - KINDEX(1, 168)=30 + KINDEX(1, 168)=31 KINDEX(2, 168)=58 - KINDEX(1, 169)=33 + KINDEX(1, 169)=34 KINDEX(2, 169)=58 - KINDEX(1, 170)=14 + KINDEX(1, 170)=15 KINDEX(2, 170)=59 - KINDEX(1, 171)=19 + KINDEX(1, 171)=20 KINDEX(2, 171)=59 - KINDEX(1, 172)=34 + KINDEX(1, 172)=35 KINDEX(2, 172)=59 - KINDEX(1, 173)=35 + KINDEX(1, 173)=36 KINDEX(2, 173)=59 - KINDEX(1, 174)=14 + KINDEX(1, 174)=15 KINDEX(2, 174)=60 - KINDEX(1, 175)=20 + KINDEX(1, 175)=21 KINDEX(2, 175)=60 - KINDEX(1, 176)=35 + KINDEX(1, 176)=36 KINDEX(2, 176)=60 - KINDEX(1, 177)=14 + KINDEX(1, 177)=15 KINDEX(2, 177)=61 - KINDEX(1, 178)=15 + KINDEX(1, 178)=16 KINDEX(2, 178)=61 - KINDEX(1, 179)=21 + KINDEX(1, 179)=22 KINDEX(2, 179)=61 - KINDEX(1, 180)=36 + KINDEX(1, 180)=37 KINDEX(2, 180)=61 - KINDEX(1, 181)=37 + KINDEX(1, 181)=38 KINDEX(2, 181)=61 - KINDEX(1, 182)=41 + KINDEX(1, 182)=42 KINDEX(2, 182)=61 - KINDEX(1, 183)=13 + KINDEX(1, 183)=14 KINDEX(2, 183)=62 - KINDEX(1, 184)=14 + KINDEX(1, 184)=15 KINDEX(2, 184)=62 - KINDEX(1, 185)=15 + KINDEX(1, 185)=16 KINDEX(2, 185)=62 - KINDEX(1, 186)=22 + KINDEX(1, 186)=23 KINDEX(2, 186)=62 - KINDEX(1, 187)=14 + KINDEX(1, 187)=15 KINDEX(2, 187)=63 - KINDEX(1, 188)=23 + KINDEX(1, 188)=24 KINDEX(2, 188)=63 - KINDEX(1, 189)=39 + KINDEX(1, 189)=40 KINDEX(2, 189)=63 - KINDEX(1, 190)=14 + KINDEX(1, 190)=15 KINDEX(2, 190)=64 - KINDEX(1, 191)=24 + KINDEX(1, 191)=25 KINDEX(2, 191)=64 - KINDEX(1, 192)=39 + KINDEX(1, 192)=40 KINDEX(2, 192)=64 - KINDEX(1, 193)=13 + KINDEX(1, 193)=14 KINDEX(2, 193)=65 - KINDEX(1, 194)=14 + KINDEX(1, 194)=15 KINDEX(2, 194)=65 - KINDEX(1, 195)=15 + KINDEX(1, 195)=16 KINDEX(2, 195)=65 - KINDEX(1, 196)=22 + KINDEX(1, 196)=23 KINDEX(2, 196)=65 - KINDEX(1, 197)=23 + KINDEX(1, 197)=24 KINDEX(2, 197)=65 - KINDEX(1, 198)=24 + KINDEX(1, 198)=25 KINDEX(2, 198)=65 - KINDEX(1, 199)=25 + KINDEX(1, 199)=26 KINDEX(2, 199)=65 - KINDEX(1, 200)=39 + KINDEX(1, 200)=40 KINDEX(2, 200)=65 - KINDEX(1, 201)=41 + KINDEX(1, 201)=42 KINDEX(2, 201)=65 - KINDEX(1, 202)=14 + KINDEX(1, 202)=15 KINDEX(2, 202)=66 - KINDEX(1, 203)=15 + KINDEX(1, 203)=16 KINDEX(2, 203)=66 - KINDEX(1, 204)=30 + KINDEX(1, 204)=31 KINDEX(2, 204)=66 - KINDEX(1, 205)=14 + KINDEX(1, 205)=15 KINDEX(2, 205)=67 - KINDEX(1, 206)=31 + KINDEX(1, 206)=32 KINDEX(2, 206)=67 - KINDEX(1, 207)=14 + KINDEX(1, 207)=15 KINDEX(2, 207)=68 - KINDEX(1, 208)=22 + KINDEX(1, 208)=23 KINDEX(2, 208)=68 - KINDEX(1, 209)=28 + KINDEX(1, 209)=29 KINDEX(2, 209)=68 - KINDEX(1, 210)=32 + KINDEX(1, 210)=33 KINDEX(2, 210)=68 - KINDEX(1, 211)=14 + KINDEX(1, 211)=15 KINDEX(2, 211)=69 - KINDEX(1, 212)=15 + KINDEX(1, 212)=16 KINDEX(2, 212)=69 - KINDEX(1, 213)=22 + KINDEX(1, 213)=23 KINDEX(2, 213)=69 - KINDEX(1, 214)=23 + KINDEX(1, 214)=24 KINDEX(2, 214)=69 - KINDEX(1, 215)=24 + KINDEX(1, 215)=25 KINDEX(2, 215)=69 - KINDEX(1, 216)=29 + KINDEX(1, 216)=30 KINDEX(2, 216)=69 - KINDEX(1, 217)=33 + KINDEX(1, 217)=34 KINDEX(2, 217)=69 - KINDEX(1, 218)=39 + KINDEX(1, 218)=40 KINDEX(2, 218)=69 - KINDEX(1, 219)=41 + KINDEX(1, 219)=42 KINDEX(2, 219)=69 KINDEX(1, 220)=5 KINDEX(2, 220)=70 - KINDEX(1, 221)=14 + KINDEX(1, 221)=15 KINDEX(2, 221)=70 - KINDEX(1, 222)=15 + KINDEX(1, 222)=16 KINDEX(2, 222)=70 - KINDEX(1, 223)=22 + KINDEX(1, 223)=23 KINDEX(2, 223)=70 - KINDEX(1, 224)=25 + KINDEX(1, 224)=26 KINDEX(2, 224)=70 - KINDEX(1, 225)=27 + KINDEX(1, 225)=28 KINDEX(2, 225)=70 - KINDEX(1, 226)=41 + KINDEX(1, 226)=42 KINDEX(2, 226)=70 KINDEX(1, 227)=4 KINDEX(2, 227)=71 - KINDEX(1, 228)=14 + KINDEX(1, 228)=15 KINDEX(2, 228)=71 - KINDEX(1, 229)=26 + KINDEX(1, 229)=27 KINDEX(2, 229)=71 - KINDEX(1, 230)=33 + KINDEX(1, 230)=34 KINDEX(2, 230)=71 KINDEX(1, 231)=5 KINDEX(2, 231)=72 KINDEX(1, 232)=8 KINDEX(2, 232)=72 - KINDEX(1, 233)=13 + KINDEX(1, 233)=14 KINDEX(2, 233)=72 - KINDEX(1, 234)=15 + KINDEX(1, 234)=16 KINDEX(2, 234)=72 - KINDEX(1, 235)=22 + KINDEX(1, 235)=23 KINDEX(2, 235)=72 KINDEX(1, 236)=5 KINDEX(2, 236)=73 KINDEX(1, 237)=8 KINDEX(2, 237)=73 - KINDEX(1, 238)=23 + KINDEX(1, 238)=24 KINDEX(2, 238)=73 - KINDEX(1, 239)=39 + KINDEX(1, 239)=40 KINDEX(2, 239)=73 KINDEX(1, 240)=4 KINDEX(2, 240)=74 @@ -35868,1406 +36535,1424 @@ END IF KINDEX(2, 241)=74 KINDEX(1, 242)=8 KINDEX(2, 242)=74 - KINDEX(1, 243)=13 + KINDEX(1, 243)=14 KINDEX(2, 243)=74 - KINDEX(1, 244)=15 + KINDEX(1, 244)=16 KINDEX(2, 244)=74 - KINDEX(1, 245)=23 + KINDEX(1, 245)=24 KINDEX(2, 245)=74 - KINDEX(1, 246)=24 + KINDEX(1, 246)=25 KINDEX(2, 246)=74 - KINDEX(1, 247)=25 + KINDEX(1, 247)=26 KINDEX(2, 247)=74 - KINDEX(1, 248)=39 + KINDEX(1, 248)=40 KINDEX(2, 248)=74 - KINDEX(1, 249)=40 + KINDEX(1, 249)=41 KINDEX(2, 249)=74 - KINDEX(1, 250)=41 + KINDEX(1, 250)=42 KINDEX(2, 250)=74 KINDEX(1, 251)=5 KINDEX(2, 251)=75 KINDEX(1, 252)=8 KINDEX(2, 252)=75 - KINDEX(1, 253)=21 + KINDEX(1, 253)=22 KINDEX(2, 253)=75 - KINDEX(1, 254)=36 + KINDEX(1, 254)=37 KINDEX(2, 254)=75 KINDEX(1, 255)=5 KINDEX(2, 255)=76 - KINDEX(1, 256)=19 + KINDEX(1, 256)=20 KINDEX(2, 256)=76 - KINDEX(1, 257)=25 + KINDEX(1, 257)=26 KINDEX(2, 257)=76 - KINDEX(1, 258)=40 + KINDEX(1, 258)=41 KINDEX(2, 258)=76 KINDEX(1, 259)=5 KINDEX(2, 259)=77 - KINDEX(1, 260)=20 + KINDEX(1, 260)=21 KINDEX(2, 260)=77 - KINDEX(1, 261)=25 + KINDEX(1, 261)=26 KINDEX(2, 261)=77 - KINDEX(1, 262)=40 + KINDEX(1, 262)=41 KINDEX(2, 262)=77 KINDEX(1, 263)=4 KINDEX(2, 263)=78 KINDEX(1, 264)=5 KINDEX(2, 264)=78 - KINDEX(1, 265)=22 + KINDEX(1, 265)=23 KINDEX(2, 265)=78 - KINDEX(1, 266)=26 + KINDEX(1, 266)=27 KINDEX(2, 266)=78 - KINDEX(1, 267)=27 + KINDEX(1, 267)=28 KINDEX(2, 267)=78 - KINDEX(1, 268)=41 + KINDEX(1, 268)=42 KINDEX(2, 268)=78 KINDEX(1, 269)=1 KINDEX(2, 269)=79 KINDEX(1, 270)=2 KINDEX(2, 270)=79 - KINDEX(1, 271)=13 + KINDEX(1, 271)=14 KINDEX(2, 271)=79 - KINDEX(1, 272)=14 + KINDEX(1, 272)=15 KINDEX(2, 272)=79 - KINDEX(1, 273)=15 + KINDEX(1, 273)=16 KINDEX(2, 273)=79 - KINDEX(1, 274)=16 + KINDEX(1, 274)=17 KINDEX(2, 274)=79 - KINDEX(1, 275)=17 + KINDEX(1, 275)=18 KINDEX(2, 275)=79 - KINDEX(1, 276)=19 + KINDEX(1, 276)=20 KINDEX(2, 276)=79 - KINDEX(1, 277)=22 + KINDEX(1, 277)=23 KINDEX(2, 277)=79 - KINDEX(1, 278)=23 + KINDEX(1, 278)=24 KINDEX(2, 278)=79 - KINDEX(1, 279)=24 + KINDEX(1, 279)=25 KINDEX(2, 279)=79 - KINDEX(1, 280)=25 + KINDEX(1, 280)=26 KINDEX(2, 280)=79 - KINDEX(1, 281)=30 + KINDEX(1, 281)=31 KINDEX(2, 281)=79 - KINDEX(1, 282)=31 + KINDEX(1, 282)=32 KINDEX(2, 282)=79 - KINDEX(1, 283)=32 + KINDEX(1, 283)=33 KINDEX(2, 283)=79 - KINDEX(1, 284)=33 + KINDEX(1, 284)=34 KINDEX(2, 284)=79 - KINDEX(1, 285)=39 + KINDEX(1, 285)=40 KINDEX(2, 285)=79 - KINDEX(1, 286)=41 + KINDEX(1, 286)=42 KINDEX(2, 286)=79 KINDEX(1, 287)=1 KINDEX(2, 287)=80 KINDEX(1, 288)=2 KINDEX(2, 288)=80 - KINDEX(1, 289)=13 + KINDEX(1, 289)=14 KINDEX(2, 289)=80 - KINDEX(1, 290)=14 + KINDEX(1, 290)=15 KINDEX(2, 290)=80 - KINDEX(1, 291)=15 + KINDEX(1, 291)=16 KINDEX(2, 291)=80 - KINDEX(1, 292)=19 + KINDEX(1, 292)=20 KINDEX(2, 292)=80 - KINDEX(1, 293)=20 + KINDEX(1, 293)=21 KINDEX(2, 293)=80 - KINDEX(1, 294)=22 + KINDEX(1, 294)=23 KINDEX(2, 294)=80 - KINDEX(1, 295)=23 + KINDEX(1, 295)=24 KINDEX(2, 295)=80 - KINDEX(1, 296)=24 + KINDEX(1, 296)=25 KINDEX(2, 296)=80 - KINDEX(1, 297)=25 + KINDEX(1, 297)=26 KINDEX(2, 297)=80 - KINDEX(1, 298)=30 + KINDEX(1, 298)=31 KINDEX(2, 298)=80 - KINDEX(1, 299)=31 + KINDEX(1, 299)=32 KINDEX(2, 299)=80 - KINDEX(1, 300)=32 + KINDEX(1, 300)=33 KINDEX(2, 300)=80 - KINDEX(1, 301)=33 + KINDEX(1, 301)=34 KINDEX(2, 301)=80 - KINDEX(1, 302)=39 + KINDEX(1, 302)=40 KINDEX(2, 302)=80 - KINDEX(1, 303)=41 + KINDEX(1, 303)=42 KINDEX(2, 303)=80 KINDEX(1, 304)=1 KINDEX(2, 304)=81 - KINDEX(1, 305)=13 + KINDEX(1, 305)=14 KINDEX(2, 305)=81 - KINDEX(1, 306)=14 + KINDEX(1, 306)=15 KINDEX(2, 306)=81 - KINDEX(1, 307)=15 + KINDEX(1, 307)=16 KINDEX(2, 307)=81 - KINDEX(1, 308)=22 + KINDEX(1, 308)=23 KINDEX(2, 308)=81 - KINDEX(1, 309)=23 + KINDEX(1, 309)=24 KINDEX(2, 309)=81 - KINDEX(1, 310)=25 + KINDEX(1, 310)=26 KINDEX(2, 310)=81 - KINDEX(1, 311)=29 + KINDEX(1, 311)=30 KINDEX(2, 311)=81 - KINDEX(1, 312)=30 + KINDEX(1, 312)=31 KINDEX(2, 312)=81 - KINDEX(1, 313)=31 + KINDEX(1, 313)=32 KINDEX(2, 313)=81 - KINDEX(1, 314)=39 + KINDEX(1, 314)=40 KINDEX(2, 314)=81 KINDEX(1, 315)=1 KINDEX(2, 315)=82 KINDEX(1, 316)=4 KINDEX(2, 316)=82 - KINDEX(1, 317)=13 + KINDEX(1, 317)=14 KINDEX(2, 317)=82 - KINDEX(1, 318)=14 + KINDEX(1, 318)=15 KINDEX(2, 318)=82 - KINDEX(1, 319)=15 + KINDEX(1, 319)=16 KINDEX(2, 319)=82 - KINDEX(1, 320)=22 + KINDEX(1, 320)=23 KINDEX(2, 320)=82 - KINDEX(1, 321)=27 + KINDEX(1, 321)=28 KINDEX(2, 321)=82 - KINDEX(1, 322)=30 + KINDEX(1, 322)=31 KINDEX(2, 322)=82 - KINDEX(1, 323)=39 + KINDEX(1, 323)=40 KINDEX(2, 323)=82 KINDEX(1, 324)=4 KINDEX(2, 324)=83 - KINDEX(1, 325)=21 + KINDEX(1, 325)=22 KINDEX(2, 325)=83 - KINDEX(1, 326)=26 + KINDEX(1, 326)=27 KINDEX(2, 326)=83 - KINDEX(1, 327)=36 + KINDEX(1, 327)=37 KINDEX(2, 327)=83 - KINDEX(1, 328)=15 + KINDEX(1, 328)=16 KINDEX(2, 328)=84 - KINDEX(1, 329)=21 + KINDEX(1, 329)=22 KINDEX(2, 329)=84 - KINDEX(1, 330)=36 + KINDEX(1, 330)=37 KINDEX(2, 330)=84 KINDEX(1, 331)=4 KINDEX(2, 331)=85 KINDEX(1, 332)=7 KINDEX(2, 332)=85 - KINDEX(1, 333)=21 + KINDEX(1, 333)=22 KINDEX(2, 333)=85 - KINDEX(1, 334)=37 + KINDEX(1, 334)=38 KINDEX(2, 334)=85 - KINDEX(1, 335)=15 + KINDEX(1, 335)=16 KINDEX(2, 335)=86 - KINDEX(1, 336)=21 + KINDEX(1, 336)=22 KINDEX(2, 336)=86 - KINDEX(1, 337)=37 + KINDEX(1, 337)=38 KINDEX(2, 337)=86 - KINDEX(1, 338)=38 + KINDEX(1, 338)=39 KINDEX(2, 338)=86 KINDEX(1, 339)=1 KINDEX(2, 339)=87 - KINDEX(1, 340)=14 + KINDEX(1, 340)=15 KINDEX(2, 340)=87 - KINDEX(1, 341)=21 + KINDEX(1, 341)=22 KINDEX(2, 341)=87 - KINDEX(1, 342)=37 + KINDEX(1, 342)=38 KINDEX(2, 342)=87 KINDEX(1, 343)=4 KINDEX(2, 343)=88 - KINDEX(1, 344)=27 + KINDEX(1, 344)=28 KINDEX(2, 344)=88 - KINDEX(1, 345)=39 + KINDEX(1, 345)=40 KINDEX(2, 345)=88 KINDEX(1, 346)=4 KINDEX(2, 346)=89 - KINDEX(1, 347)=27 + KINDEX(1, 347)=28 KINDEX(2, 347)=89 - KINDEX(1, 348)=39 + KINDEX(1, 348)=40 KINDEX(2, 348)=89 KINDEX(1, 349)=3 KINDEX(2, 349)=90 KINDEX(1, 350)=4 KINDEX(2, 350)=90 - KINDEX(1, 351)=15 + KINDEX(1, 351)=16 KINDEX(2, 351)=90 - KINDEX(1, 352)=22 + KINDEX(1, 352)=23 KINDEX(2, 352)=90 - KINDEX(1, 353)=32 + KINDEX(1, 353)=33 KINDEX(2, 353)=90 KINDEX(1, 354)=3 KINDEX(2, 354)=91 KINDEX(1, 355)=4 KINDEX(2, 355)=91 - KINDEX(1, 356)=15 + KINDEX(1, 356)=16 KINDEX(2, 356)=91 - KINDEX(1, 357)=22 + KINDEX(1, 357)=23 KINDEX(2, 357)=91 - KINDEX(1, 358)=23 + KINDEX(1, 358)=24 KINDEX(2, 358)=91 - KINDEX(1, 359)=24 + KINDEX(1, 359)=25 KINDEX(2, 359)=91 - KINDEX(1, 360)=25 + KINDEX(1, 360)=26 KINDEX(2, 360)=91 - KINDEX(1, 361)=26 + KINDEX(1, 361)=27 KINDEX(2, 361)=91 - KINDEX(1, 362)=32 + KINDEX(1, 362)=33 KINDEX(2, 362)=91 - KINDEX(1, 363)=33 + KINDEX(1, 363)=34 KINDEX(2, 363)=91 - KINDEX(1, 364)=41 + KINDEX(1, 364)=42 KINDEX(2, 364)=91 KINDEX(1, 365)=3 KINDEX(2, 365)=92 KINDEX(1, 366)=4 KINDEX(2, 366)=92 - KINDEX(1, 367)=15 + KINDEX(1, 367)=16 KINDEX(2, 367)=92 - KINDEX(1, 368)=22 + KINDEX(1, 368)=23 KINDEX(2, 368)=92 - KINDEX(1, 369)=23 + KINDEX(1, 369)=24 KINDEX(2, 369)=92 - KINDEX(1, 370)=24 + KINDEX(1, 370)=25 KINDEX(2, 370)=92 - KINDEX(1, 371)=34 + KINDEX(1, 371)=35 KINDEX(2, 371)=92 KINDEX(1, 372)=3 KINDEX(2, 372)=93 KINDEX(1, 373)=4 KINDEX(2, 373)=93 - KINDEX(1, 374)=15 + KINDEX(1, 374)=16 KINDEX(2, 374)=93 - KINDEX(1, 375)=19 + KINDEX(1, 375)=20 KINDEX(2, 375)=93 - KINDEX(1, 376)=22 + KINDEX(1, 376)=23 KINDEX(2, 376)=93 - KINDEX(1, 377)=23 + KINDEX(1, 377)=24 KINDEX(2, 377)=93 - KINDEX(1, 378)=24 + KINDEX(1, 378)=25 KINDEX(2, 378)=93 - KINDEX(1, 379)=25 + KINDEX(1, 379)=26 KINDEX(2, 379)=93 - KINDEX(1, 380)=26 + KINDEX(1, 380)=27 KINDEX(2, 380)=93 - KINDEX(1, 381)=35 + KINDEX(1, 381)=36 KINDEX(2, 381)=93 KINDEX(1, 382)=3 KINDEX(2, 382)=94 KINDEX(1, 383)=4 KINDEX(2, 383)=94 - KINDEX(1, 384)=15 + KINDEX(1, 384)=16 KINDEX(2, 384)=94 - KINDEX(1, 385)=25 + KINDEX(1, 385)=26 KINDEX(2, 385)=94 - KINDEX(1, 386)=26 + KINDEX(1, 386)=27 KINDEX(2, 386)=94 - KINDEX(1, 387)=38 + KINDEX(1, 387)=39 KINDEX(2, 387)=94 KINDEX(1, 388)=3 KINDEX(2, 388)=95 KINDEX(1, 389)=4 KINDEX(2, 389)=95 - KINDEX(1, 390)=15 + KINDEX(1, 390)=16 KINDEX(2, 390)=95 - KINDEX(1, 391)=22 + KINDEX(1, 391)=23 KINDEX(2, 391)=95 - KINDEX(1, 392)=23 + KINDEX(1, 392)=24 KINDEX(2, 392)=95 - KINDEX(1, 393)=25 + KINDEX(1, 393)=26 KINDEX(2, 393)=95 - KINDEX(1, 394)=32 + KINDEX(1, 394)=33 KINDEX(2, 394)=95 - KINDEX(1, 395)=39 + KINDEX(1, 395)=40 KINDEX(2, 395)=95 - KINDEX(1, 396)=41 + KINDEX(1, 396)=42 KINDEX(2, 396)=95 KINDEX(1, 397)=3 KINDEX(2, 397)=96 KINDEX(1, 398)=4 KINDEX(2, 398)=96 - KINDEX(1, 399)=15 + KINDEX(1, 399)=16 KINDEX(2, 399)=96 - KINDEX(1, 400)=22 + KINDEX(1, 400)=23 KINDEX(2, 400)=96 - KINDEX(1, 401)=23 + KINDEX(1, 401)=24 KINDEX(2, 401)=96 - KINDEX(1, 402)=24 + KINDEX(1, 402)=25 KINDEX(2, 402)=96 - KINDEX(1, 403)=26 + KINDEX(1, 403)=27 KINDEX(2, 403)=96 - KINDEX(1, 404)=40 + KINDEX(1, 404)=41 KINDEX(2, 404)=96 - KINDEX(1, 405)=15 + KINDEX(1, 405)=16 KINDEX(2, 405)=97 - KINDEX(1, 406)=28 + KINDEX(1, 406)=29 KINDEX(2, 406)=97 - KINDEX(1, 407)=32 + KINDEX(1, 407)=33 KINDEX(2, 407)=97 - KINDEX(1, 408)=15 + KINDEX(1, 408)=16 KINDEX(2, 408)=98 - KINDEX(1, 409)=29 + KINDEX(1, 409)=30 KINDEX(2, 409)=98 - KINDEX(1, 410)=33 + KINDEX(1, 410)=34 KINDEX(2, 410)=98 - KINDEX(1, 411)=15 + KINDEX(1, 411)=16 KINDEX(2, 411)=99 - KINDEX(1, 412)=29 + KINDEX(1, 412)=30 KINDEX(2, 412)=99 - KINDEX(1, 413)=34 + KINDEX(1, 413)=35 KINDEX(2, 413)=99 - KINDEX(1, 414)=15 + KINDEX(1, 414)=16 KINDEX(2, 414)=100 - KINDEX(1, 415)=29 + KINDEX(1, 415)=30 KINDEX(2, 415)=100 - KINDEX(1, 416)=35 + KINDEX(1, 416)=36 KINDEX(2, 416)=100 - KINDEX(1, 417)=15 + KINDEX(1, 417)=16 KINDEX(2, 417)=101 - KINDEX(1, 418)=29 + KINDEX(1, 418)=30 KINDEX(2, 418)=101 - KINDEX(1, 419)=38 + KINDEX(1, 419)=39 KINDEX(2, 419)=101 KINDEX(1, 420)=1 KINDEX(2, 420)=102 - KINDEX(1, 421)=15 + KINDEX(1, 421)=16 KINDEX(2, 421)=102 - KINDEX(1, 422)=29 + KINDEX(1, 422)=30 KINDEX(2, 422)=102 - KINDEX(1, 423)=31 + KINDEX(1, 423)=32 KINDEX(2, 423)=102 - KINDEX(1, 424)=39 + KINDEX(1, 424)=40 KINDEX(2, 424)=102 - KINDEX(1, 425)=15 + KINDEX(1, 425)=16 KINDEX(2, 425)=103 - KINDEX(1, 426)=26 + KINDEX(1, 426)=27 KINDEX(2, 426)=103 - KINDEX(1, 427)=40 + KINDEX(1, 427)=41 KINDEX(2, 427)=103 - KINDEX(1, 428)=15 + KINDEX(1, 428)=16 KINDEX(2, 428)=104 - KINDEX(1, 429)=22 + KINDEX(1, 429)=23 KINDEX(2, 429)=104 - KINDEX(1, 430)=32 + KINDEX(1, 430)=33 KINDEX(2, 430)=104 - KINDEX(1, 431)=15 + KINDEX(1, 431)=16 KINDEX(2, 431)=105 - KINDEX(1, 432)=22 + KINDEX(1, 432)=23 KINDEX(2, 432)=105 - KINDEX(1, 433)=23 + KINDEX(1, 433)=24 KINDEX(2, 433)=105 - KINDEX(1, 434)=24 + KINDEX(1, 434)=25 KINDEX(2, 434)=105 - KINDEX(1, 435)=25 + KINDEX(1, 435)=26 KINDEX(2, 435)=105 - KINDEX(1, 436)=32 + KINDEX(1, 436)=33 KINDEX(2, 436)=105 - KINDEX(1, 437)=33 + KINDEX(1, 437)=34 KINDEX(2, 437)=105 - KINDEX(1, 438)=41 + KINDEX(1, 438)=42 KINDEX(2, 438)=105 - KINDEX(1, 439)=15 + KINDEX(1, 439)=16 KINDEX(2, 439)=106 - KINDEX(1, 440)=22 + KINDEX(1, 440)=23 KINDEX(2, 440)=106 - KINDEX(1, 441)=23 + KINDEX(1, 441)=24 KINDEX(2, 441)=106 - KINDEX(1, 442)=24 + KINDEX(1, 442)=25 KINDEX(2, 442)=106 - KINDEX(1, 443)=32 + KINDEX(1, 443)=33 KINDEX(2, 443)=106 - KINDEX(1, 444)=34 + KINDEX(1, 444)=35 KINDEX(2, 444)=106 - KINDEX(1, 445)=15 + KINDEX(1, 445)=16 KINDEX(2, 445)=107 - KINDEX(1, 446)=19 + KINDEX(1, 446)=20 KINDEX(2, 446)=107 - KINDEX(1, 447)=22 + KINDEX(1, 447)=23 KINDEX(2, 447)=107 - KINDEX(1, 448)=23 + KINDEX(1, 448)=24 KINDEX(2, 448)=107 - KINDEX(1, 449)=24 + KINDEX(1, 449)=25 KINDEX(2, 449)=107 - KINDEX(1, 450)=25 + KINDEX(1, 450)=26 KINDEX(2, 450)=107 - KINDEX(1, 451)=32 + KINDEX(1, 451)=33 KINDEX(2, 451)=107 - KINDEX(1, 452)=35 + KINDEX(1, 452)=36 KINDEX(2, 452)=107 - KINDEX(1, 453)=15 + KINDEX(1, 453)=16 KINDEX(2, 453)=108 - KINDEX(1, 454)=22 + KINDEX(1, 454)=23 KINDEX(2, 454)=108 - KINDEX(1, 455)=25 + KINDEX(1, 455)=26 KINDEX(2, 455)=108 - KINDEX(1, 456)=32 + KINDEX(1, 456)=33 KINDEX(2, 456)=108 - KINDEX(1, 457)=38 + KINDEX(1, 457)=39 KINDEX(2, 457)=108 - KINDEX(1, 458)=15 + KINDEX(1, 458)=16 KINDEX(2, 458)=109 - KINDEX(1, 459)=22 + KINDEX(1, 459)=23 KINDEX(2, 459)=109 - KINDEX(1, 460)=23 + KINDEX(1, 460)=24 KINDEX(2, 460)=109 - KINDEX(1, 461)=25 + KINDEX(1, 461)=26 KINDEX(2, 461)=109 - KINDEX(1, 462)=31 + KINDEX(1, 462)=32 KINDEX(2, 462)=109 - KINDEX(1, 463)=32 + KINDEX(1, 463)=33 KINDEX(2, 463)=109 - KINDEX(1, 464)=39 + KINDEX(1, 464)=40 KINDEX(2, 464)=109 - KINDEX(1, 465)=41 + KINDEX(1, 465)=42 KINDEX(2, 465)=109 KINDEX(1, 466)=4 KINDEX(2, 466)=110 - KINDEX(1, 467)=15 + KINDEX(1, 467)=16 KINDEX(2, 467)=110 - KINDEX(1, 468)=22 + KINDEX(1, 468)=23 KINDEX(2, 468)=110 - KINDEX(1, 469)=23 + KINDEX(1, 469)=24 KINDEX(2, 469)=110 - KINDEX(1, 470)=24 + KINDEX(1, 470)=25 KINDEX(2, 470)=110 - KINDEX(1, 471)=26 + KINDEX(1, 471)=27 KINDEX(2, 471)=110 - KINDEX(1, 472)=32 + KINDEX(1, 472)=33 KINDEX(2, 472)=110 - KINDEX(1, 473)=40 + KINDEX(1, 473)=41 KINDEX(2, 473)=110 - KINDEX(1, 474)=15 + KINDEX(1, 474)=16 KINDEX(2, 474)=111 - KINDEX(1, 475)=22 + KINDEX(1, 475)=23 KINDEX(2, 475)=111 - KINDEX(1, 476)=23 + KINDEX(1, 476)=24 KINDEX(2, 476)=111 - KINDEX(1, 477)=24 + KINDEX(1, 477)=25 KINDEX(2, 477)=111 - KINDEX(1, 478)=25 + KINDEX(1, 478)=26 KINDEX(2, 478)=111 - KINDEX(1, 479)=31 + KINDEX(1, 479)=32 KINDEX(2, 479)=111 - KINDEX(1, 480)=32 + KINDEX(1, 480)=33 KINDEX(2, 480)=111 - KINDEX(1, 481)=33 + KINDEX(1, 481)=34 KINDEX(2, 481)=111 - KINDEX(1, 482)=39 + KINDEX(1, 482)=40 KINDEX(2, 482)=111 - KINDEX(1, 483)=41 + KINDEX(1, 483)=42 KINDEX(2, 483)=111 - KINDEX(1, 484)=15 + KINDEX(1, 484)=16 KINDEX(2, 484)=112 - KINDEX(1, 485)=22 + KINDEX(1, 485)=23 KINDEX(2, 485)=112 - KINDEX(1, 486)=23 + KINDEX(1, 486)=24 KINDEX(2, 486)=112 - KINDEX(1, 487)=24 + KINDEX(1, 487)=25 KINDEX(2, 487)=112 - KINDEX(1, 488)=31 + KINDEX(1, 488)=32 KINDEX(2, 488)=112 - KINDEX(1, 489)=32 + KINDEX(1, 489)=33 KINDEX(2, 489)=112 - KINDEX(1, 490)=34 + KINDEX(1, 490)=35 KINDEX(2, 490)=112 - KINDEX(1, 491)=39 + KINDEX(1, 491)=40 KINDEX(2, 491)=112 - KINDEX(1, 492)=15 + KINDEX(1, 492)=16 KINDEX(2, 492)=113 - KINDEX(1, 493)=19 + KINDEX(1, 493)=20 KINDEX(2, 493)=113 - KINDEX(1, 494)=22 + KINDEX(1, 494)=23 KINDEX(2, 494)=113 - KINDEX(1, 495)=23 + KINDEX(1, 495)=24 KINDEX(2, 495)=113 - KINDEX(1, 496)=24 + KINDEX(1, 496)=25 KINDEX(2, 496)=113 - KINDEX(1, 497)=25 + KINDEX(1, 497)=26 KINDEX(2, 497)=113 - KINDEX(1, 498)=31 + KINDEX(1, 498)=32 KINDEX(2, 498)=113 - KINDEX(1, 499)=32 + KINDEX(1, 499)=33 KINDEX(2, 499)=113 - KINDEX(1, 500)=35 + KINDEX(1, 500)=36 KINDEX(2, 500)=113 - KINDEX(1, 501)=39 + KINDEX(1, 501)=40 KINDEX(2, 501)=113 - KINDEX(1, 502)=15 + KINDEX(1, 502)=16 KINDEX(2, 502)=114 - KINDEX(1, 503)=25 + KINDEX(1, 503)=26 KINDEX(2, 503)=114 - KINDEX(1, 504)=32 + KINDEX(1, 504)=33 KINDEX(2, 504)=114 - KINDEX(1, 505)=38 + KINDEX(1, 505)=39 KINDEX(2, 505)=114 - KINDEX(1, 506)=39 + KINDEX(1, 506)=40 KINDEX(2, 506)=114 - KINDEX(1, 507)=15 + KINDEX(1, 507)=16 KINDEX(2, 507)=115 - KINDEX(1, 508)=22 + KINDEX(1, 508)=23 KINDEX(2, 508)=115 - KINDEX(1, 509)=23 + KINDEX(1, 509)=24 KINDEX(2, 509)=115 - KINDEX(1, 510)=24 + KINDEX(1, 510)=25 KINDEX(2, 510)=115 - KINDEX(1, 511)=25 + KINDEX(1, 511)=26 KINDEX(2, 511)=115 - KINDEX(1, 512)=31 + KINDEX(1, 512)=32 KINDEX(2, 512)=115 - KINDEX(1, 513)=32 + KINDEX(1, 513)=33 KINDEX(2, 513)=115 - KINDEX(1, 514)=39 + KINDEX(1, 514)=40 KINDEX(2, 514)=115 - KINDEX(1, 515)=41 + KINDEX(1, 515)=42 KINDEX(2, 515)=115 KINDEX(1, 516)=4 KINDEX(2, 516)=116 - KINDEX(1, 517)=15 + KINDEX(1, 517)=16 KINDEX(2, 517)=116 - KINDEX(1, 518)=22 + KINDEX(1, 518)=23 KINDEX(2, 518)=116 - KINDEX(1, 519)=23 + KINDEX(1, 519)=24 KINDEX(2, 519)=116 - KINDEX(1, 520)=24 + KINDEX(1, 520)=25 KINDEX(2, 520)=116 - KINDEX(1, 521)=26 + KINDEX(1, 521)=27 KINDEX(2, 521)=116 - KINDEX(1, 522)=31 + KINDEX(1, 522)=32 KINDEX(2, 522)=116 - KINDEX(1, 523)=32 + KINDEX(1, 523)=33 KINDEX(2, 523)=116 - KINDEX(1, 524)=39 + KINDEX(1, 524)=40 KINDEX(2, 524)=116 - KINDEX(1, 525)=40 + KINDEX(1, 525)=41 KINDEX(2, 525)=116 - KINDEX(1, 526)=15 + KINDEX(1, 526)=16 KINDEX(2, 526)=117 - KINDEX(1, 527)=26 + KINDEX(1, 527)=27 KINDEX(2, 527)=117 - KINDEX(1, 528)=40 + KINDEX(1, 528)=41 KINDEX(2, 528)=117 KINDEX(1, 529)=4 KINDEX(2, 529)=118 - KINDEX(1, 530)=15 + KINDEX(1, 530)=16 KINDEX(2, 530)=118 - KINDEX(1, 531)=22 + KINDEX(1, 531)=23 KINDEX(2, 531)=118 - KINDEX(1, 532)=23 + KINDEX(1, 532)=24 KINDEX(2, 532)=118 - KINDEX(1, 533)=24 + KINDEX(1, 533)=25 KINDEX(2, 533)=118 - KINDEX(1, 534)=26 + KINDEX(1, 534)=27 KINDEX(2, 534)=118 - KINDEX(1, 535)=40 + KINDEX(1, 535)=41 KINDEX(2, 535)=118 KINDEX(1, 536)=4 KINDEX(2, 536)=119 KINDEX(1, 537)=5 KINDEX(2, 537)=119 - KINDEX(1, 538)=15 + KINDEX(1, 538)=16 KINDEX(2, 538)=119 - KINDEX(1, 539)=22 + KINDEX(1, 539)=23 KINDEX(2, 539)=119 - KINDEX(1, 540)=32 + KINDEX(1, 540)=33 KINDEX(2, 540)=119 KINDEX(1, 541)=4 KINDEX(2, 541)=120 KINDEX(1, 542)=5 KINDEX(2, 542)=120 - KINDEX(1, 543)=15 + KINDEX(1, 543)=16 KINDEX(2, 543)=120 - KINDEX(1, 544)=22 + KINDEX(1, 544)=23 KINDEX(2, 544)=120 - KINDEX(1, 545)=23 + KINDEX(1, 545)=24 KINDEX(2, 545)=120 - KINDEX(1, 546)=24 + KINDEX(1, 546)=25 KINDEX(2, 546)=120 - KINDEX(1, 547)=25 + KINDEX(1, 547)=26 KINDEX(2, 547)=120 - KINDEX(1, 548)=32 + KINDEX(1, 548)=33 KINDEX(2, 548)=120 - KINDEX(1, 549)=33 + KINDEX(1, 549)=34 KINDEX(2, 549)=120 - KINDEX(1, 550)=41 + KINDEX(1, 550)=42 KINDEX(2, 550)=120 KINDEX(1, 551)=4 KINDEX(2, 551)=121 KINDEX(1, 552)=5 KINDEX(2, 552)=121 - KINDEX(1, 553)=15 + KINDEX(1, 553)=16 KINDEX(2, 553)=121 - KINDEX(1, 554)=22 + KINDEX(1, 554)=23 KINDEX(2, 554)=121 - KINDEX(1, 555)=23 + KINDEX(1, 555)=24 KINDEX(2, 555)=121 - KINDEX(1, 556)=24 + KINDEX(1, 556)=25 KINDEX(2, 556)=121 - KINDEX(1, 557)=34 + KINDEX(1, 557)=35 KINDEX(2, 557)=121 KINDEX(1, 558)=4 KINDEX(2, 558)=122 KINDEX(1, 559)=5 KINDEX(2, 559)=122 - KINDEX(1, 560)=15 + KINDEX(1, 560)=16 KINDEX(2, 560)=122 - KINDEX(1, 561)=19 + KINDEX(1, 561)=20 KINDEX(2, 561)=122 - KINDEX(1, 562)=22 + KINDEX(1, 562)=23 KINDEX(2, 562)=122 - KINDEX(1, 563)=23 + KINDEX(1, 563)=24 KINDEX(2, 563)=122 - KINDEX(1, 564)=24 + KINDEX(1, 564)=25 KINDEX(2, 564)=122 - KINDEX(1, 565)=25 + KINDEX(1, 565)=26 KINDEX(2, 565)=122 - KINDEX(1, 566)=35 + KINDEX(1, 566)=36 KINDEX(2, 566)=122 KINDEX(1, 567)=4 KINDEX(2, 567)=123 KINDEX(1, 568)=5 KINDEX(2, 568)=123 - KINDEX(1, 569)=15 + KINDEX(1, 569)=16 KINDEX(2, 569)=123 - KINDEX(1, 570)=25 + KINDEX(1, 570)=26 KINDEX(2, 570)=123 - KINDEX(1, 571)=38 + KINDEX(1, 571)=39 KINDEX(2, 571)=123 KINDEX(1, 572)=4 KINDEX(2, 572)=124 KINDEX(1, 573)=5 KINDEX(2, 573)=124 - KINDEX(1, 574)=15 + KINDEX(1, 574)=16 KINDEX(2, 574)=124 - KINDEX(1, 575)=22 + KINDEX(1, 575)=23 KINDEX(2, 575)=124 - KINDEX(1, 576)=23 + KINDEX(1, 576)=24 KINDEX(2, 576)=124 - KINDEX(1, 577)=25 + KINDEX(1, 577)=26 KINDEX(2, 577)=124 - KINDEX(1, 578)=32 + KINDEX(1, 578)=33 KINDEX(2, 578)=124 - KINDEX(1, 579)=39 + KINDEX(1, 579)=40 KINDEX(2, 579)=124 - KINDEX(1, 580)=41 + KINDEX(1, 580)=42 KINDEX(2, 580)=124 KINDEX(1, 581)=4 KINDEX(2, 581)=125 KINDEX(1, 582)=5 KINDEX(2, 582)=125 - KINDEX(1, 583)=15 + KINDEX(1, 583)=16 KINDEX(2, 583)=125 - KINDEX(1, 584)=22 + KINDEX(1, 584)=23 KINDEX(2, 584)=125 - KINDEX(1, 585)=23 + KINDEX(1, 585)=24 KINDEX(2, 585)=125 - KINDEX(1, 586)=24 + KINDEX(1, 586)=25 KINDEX(2, 586)=125 - KINDEX(1, 587)=26 + KINDEX(1, 587)=27 KINDEX(2, 587)=125 - KINDEX(1, 588)=40 + KINDEX(1, 588)=41 KINDEX(2, 588)=125 - KINDEX(1, 589)=15 + KINDEX(1, 589)=16 KINDEX(2, 589)=126 - KINDEX(1, 590)=29 + KINDEX(1, 590)=30 KINDEX(2, 590)=126 - KINDEX(1, 591)=41 + KINDEX(1, 591)=42 KINDEX(2, 591)=126 - KINDEX(1, 592)=15 + KINDEX(1, 592)=16 KINDEX(2, 592)=127 - KINDEX(1, 593)=22 + KINDEX(1, 593)=23 KINDEX(2, 593)=127 - KINDEX(1, 594)=32 + KINDEX(1, 594)=33 KINDEX(2, 594)=127 - KINDEX(1, 595)=41 + KINDEX(1, 595)=42 KINDEX(2, 595)=127 - KINDEX(1, 596)=32 + KINDEX(1, 596)=33 KINDEX(2, 596)=128 - KINDEX(1, 597)=39 + KINDEX(1, 597)=40 KINDEX(2, 597)=128 - KINDEX(1, 598)=41 + KINDEX(1, 598)=42 KINDEX(2, 598)=128 - KINDEX(1, 599)=41 + KINDEX(1, 599)=42 KINDEX(2, 599)=129 KINDEX(1, 600)=3 KINDEX(2, 600)=130 KINDEX(1, 601)=4 KINDEX(2, 601)=130 - KINDEX(1, 602)=41 + KINDEX(1, 602)=42 KINDEX(2, 602)=130 KINDEX(1, 603)=4 KINDEX(2, 603)=131 KINDEX(1, 604)=5 KINDEX(2, 604)=131 - KINDEX(1, 605)=41 + KINDEX(1, 605)=42 KINDEX(2, 605)=131 - KINDEX(1, 606)=12 + KINDEX(1, 606)=13 KINDEX(2, 606)=132 - KINDEX(1, 607)=1 + KINDEX(1, 607)=4 KINDEX(2, 607)=133 - KINDEX(1, 608)=42 + KINDEX(1, 608)=5 KINDEX(2, 608)=133 - KINDEX(1, 609)=2 - KINDEX(2, 609)=134 - KINDEX(1, 610)=43 - KINDEX(2, 610)=134 - KINDEX(1, 611)=3 - KINDEX(2, 611)=135 - KINDEX(1, 612)=44 - KINDEX(2, 612)=135 - KINDEX(1, 613)=4 - KINDEX(2, 613)=136 - KINDEX(1, 614)=45 - KINDEX(2, 614)=136 - KINDEX(1, 615)=5 - KINDEX(2, 615)=137 - KINDEX(1, 616)=46 - KINDEX(2, 616)=137 - KINDEX(1, 617)=6 - KINDEX(2, 617)=138 - KINDEX(1, 618)=47 - KINDEX(2, 618)=138 - KINDEX(1, 619)=7 - KINDEX(2, 619)=139 - KINDEX(1, 620)=48 - KINDEX(2, 620)=139 - KINDEX(1, 621)=8 - KINDEX(2, 621)=140 - KINDEX(1, 622)=49 - KINDEX(2, 622)=140 - KINDEX(1, 623)=9 - KINDEX(2, 623)=141 - KINDEX(1, 624)=50 - KINDEX(2, 624)=141 - KINDEX(1, 625)=10 - KINDEX(2, 625)=142 - KINDEX(1, 626)=51 - KINDEX(2, 626)=142 - KINDEX(1, 627)=14 - KINDEX(2, 627)=143 - KINDEX(1, 628)=52 - KINDEX(2, 628)=143 - KINDEX(1, 629)=15 - KINDEX(2, 629)=144 - KINDEX(1, 630)=53 - KINDEX(2, 630)=144 - KINDEX(1, 631)=54 - KINDEX(2, 631)=145 - KINDEX(1, 632)=11 - KINDEX(2, 632)=146 - KINDEX(1, 633)=55 - KINDEX(2, 633)=146 - KINDEX(1, 634)=12 - KINDEX(2, 634)=147 - KINDEX(1, 635)=56 - KINDEX(2, 635)=147 - KINDEX(1, 636)=22 - KINDEX(2, 636)=148 - KINDEX(1, 637)=57 - KINDEX(2, 637)=148 - KINDEX(1, 638)=30 - KINDEX(2, 638)=149 - KINDEX(1, 639)=58 - KINDEX(2, 639)=149 - KINDEX(1, 640)=31 - KINDEX(2, 640)=150 - KINDEX(1, 641)=59 - KINDEX(2, 641)=150 - KINDEX(1, 642)=32 - KINDEX(2, 642)=151 - KINDEX(1, 643)=60 - KINDEX(2, 643)=151 - KINDEX(1, 644)=28 - KINDEX(2, 644)=152 - KINDEX(1, 645)=61 - KINDEX(2, 645)=152 - KINDEX(1, 646)=1 - KINDEX(2, 646)=153 - KINDEX(1, 647)=42 - KINDEX(2, 647)=153 - KINDEX(1, 648)=2 - KINDEX(2, 648)=154 - KINDEX(1, 649)=43 - KINDEX(2, 649)=154 - KINDEX(1, 650)=3 - KINDEX(2, 650)=155 - KINDEX(1, 651)=44 - KINDEX(2, 651)=155 - KINDEX(1, 652)=4 - KINDEX(2, 652)=156 - KINDEX(1, 653)=45 - KINDEX(2, 653)=156 - KINDEX(1, 654)=5 - KINDEX(2, 654)=157 - KINDEX(1, 655)=46 - KINDEX(2, 655)=157 - KINDEX(1, 656)=6 - KINDEX(2, 656)=158 - KINDEX(1, 657)=47 - KINDEX(2, 657)=158 - KINDEX(1, 658)=7 - KINDEX(2, 658)=159 - KINDEX(1, 659)=48 - KINDEX(2, 659)=159 - KINDEX(1, 660)=8 - KINDEX(2, 660)=160 - KINDEX(1, 661)=49 - KINDEX(2, 661)=160 - KINDEX(1, 662)=9 - KINDEX(2, 662)=161 - KINDEX(1, 663)=50 - KINDEX(2, 663)=161 - KINDEX(1, 664)=10 - KINDEX(2, 664)=162 - KINDEX(1, 665)=51 - KINDEX(2, 665)=162 - KINDEX(1, 666)=14 - KINDEX(2, 666)=163 - KINDEX(1, 667)=52 - KINDEX(2, 667)=163 - KINDEX(1, 668)=15 - KINDEX(2, 668)=164 - KINDEX(1, 669)=53 - KINDEX(2, 669)=164 - KINDEX(1, 670)=54 - KINDEX(2, 670)=165 - KINDEX(1, 671)=11 - KINDEX(2, 671)=166 - KINDEX(1, 672)=55 - KINDEX(2, 672)=166 - KINDEX(1, 673)=12 - KINDEX(2, 673)=167 - KINDEX(1, 674)=56 - KINDEX(2, 674)=167 - KINDEX(1, 675)=22 - KINDEX(2, 675)=168 - KINDEX(1, 676)=57 - KINDEX(2, 676)=168 - KINDEX(1, 677)=30 - KINDEX(2, 677)=169 - KINDEX(1, 678)=58 - KINDEX(2, 678)=169 - KINDEX(1, 679)=31 - KINDEX(2, 679)=170 - KINDEX(1, 680)=59 - KINDEX(2, 680)=170 - KINDEX(1, 681)=32 - KINDEX(2, 681)=171 - KINDEX(1, 682)=60 - KINDEX(2, 682)=171 - KINDEX(1, 683)=28 - KINDEX(2, 683)=172 - KINDEX(1, 684)=61 - KINDEX(2, 684)=172 - KINDEX(1, 685)=1 - KINDEX(2, 685)=173 - KINDEX(1, 686)=67 - KINDEX(2, 686)=173 - KINDEX(1, 687)=2 - KINDEX(2, 687)=174 - KINDEX(1, 688)=68 - KINDEX(2, 688)=174 - KINDEX(1, 689)=3 - KINDEX(2, 689)=175 - KINDEX(1, 690)=69 - KINDEX(2, 690)=175 - KINDEX(1, 691)=4 - KINDEX(2, 691)=176 - KINDEX(1, 692)=70 - KINDEX(2, 692)=176 - KINDEX(1, 693)=5 - KINDEX(2, 693)=177 - KINDEX(1, 694)=71 - KINDEX(2, 694)=177 - KINDEX(1, 695)=6 - KINDEX(2, 695)=178 - KINDEX(1, 696)=72 - KINDEX(2, 696)=178 - KINDEX(1, 697)=7 - KINDEX(2, 697)=179 - KINDEX(1, 698)=73 - KINDEX(2, 698)=179 - KINDEX(1, 699)=8 - KINDEX(2, 699)=180 - KINDEX(1, 700)=74 - KINDEX(2, 700)=180 - KINDEX(1, 701)=9 - KINDEX(2, 701)=181 - KINDEX(1, 702)=75 - KINDEX(2, 702)=181 - KINDEX(1, 703)=10 - KINDEX(2, 703)=182 - KINDEX(1, 704)=76 - KINDEX(2, 704)=182 - KINDEX(1, 705)=14 - KINDEX(2, 705)=183 - KINDEX(1, 706)=77 - KINDEX(2, 706)=183 - KINDEX(1, 707)=15 - KINDEX(2, 707)=184 - KINDEX(1, 708)=78 - KINDEX(2, 708)=184 - KINDEX(1, 709)=79 - KINDEX(2, 709)=185 - KINDEX(1, 710)=11 - KINDEX(2, 710)=186 - KINDEX(1, 711)=80 - KINDEX(2, 711)=186 - KINDEX(1, 712)=12 - KINDEX(2, 712)=187 - KINDEX(1, 713)=81 - KINDEX(2, 713)=187 - KINDEX(1, 714)=22 - KINDEX(2, 714)=188 - KINDEX(1, 715)=82 - KINDEX(2, 715)=188 - KINDEX(1, 716)=30 - KINDEX(2, 716)=189 - KINDEX(1, 717)=83 - KINDEX(2, 717)=189 - KINDEX(1, 718)=31 - KINDEX(2, 718)=190 - KINDEX(1, 719)=84 - KINDEX(2, 719)=190 - KINDEX(1, 720)=32 - KINDEX(2, 720)=191 - KINDEX(1, 721)=85 - KINDEX(2, 721)=191 - KINDEX(1, 722)=28 - KINDEX(2, 722)=192 - KINDEX(1, 723)=86 - KINDEX(2, 723)=192 - KINDEX(1, 724)=1 - KINDEX(2, 724)=193 - KINDEX(1, 725)=67 - KINDEX(2, 725)=193 - KINDEX(1, 726)=2 - KINDEX(2, 726)=194 - KINDEX(1, 727)=68 - KINDEX(2, 727)=194 - KINDEX(1, 728)=3 - KINDEX(2, 728)=195 - KINDEX(1, 729)=69 - KINDEX(2, 729)=195 - KINDEX(1, 730)=4 - KINDEX(2, 730)=196 - KINDEX(1, 731)=70 - KINDEX(2, 731)=196 - KINDEX(1, 732)=5 - KINDEX(2, 732)=197 - KINDEX(1, 733)=71 - KINDEX(2, 733)=197 - KINDEX(1, 734)=6 - KINDEX(2, 734)=198 - KINDEX(1, 735)=72 - KINDEX(2, 735)=198 - KINDEX(1, 736)=7 - KINDEX(2, 736)=199 - KINDEX(1, 737)=73 - KINDEX(2, 737)=199 - KINDEX(1, 738)=8 - KINDEX(2, 738)=200 - KINDEX(1, 739)=74 - KINDEX(2, 739)=200 - KINDEX(1, 740)=9 - KINDEX(2, 740)=201 - KINDEX(1, 741)=75 - KINDEX(2, 741)=201 - KINDEX(1, 742)=10 - KINDEX(2, 742)=202 - KINDEX(1, 743)=76 - KINDEX(2, 743)=202 - KINDEX(1, 744)=14 - KINDEX(2, 744)=203 - KINDEX(1, 745)=77 - KINDEX(2, 745)=203 - KINDEX(1, 746)=15 - KINDEX(2, 746)=204 - KINDEX(1, 747)=78 - KINDEX(2, 747)=204 - KINDEX(1, 748)=79 - KINDEX(2, 748)=205 - KINDEX(1, 749)=11 - KINDEX(2, 749)=206 - KINDEX(1, 750)=80 - KINDEX(2, 750)=206 - KINDEX(1, 751)=12 - KINDEX(2, 751)=207 - KINDEX(1, 752)=81 - KINDEX(2, 752)=207 - KINDEX(1, 753)=22 - KINDEX(2, 753)=208 - KINDEX(1, 754)=82 - KINDEX(2, 754)=208 - KINDEX(1, 755)=30 - KINDEX(2, 755)=209 - KINDEX(1, 756)=83 - KINDEX(2, 756)=209 - KINDEX(1, 757)=31 - KINDEX(2, 757)=210 - KINDEX(1, 758)=84 - KINDEX(2, 758)=210 - KINDEX(1, 759)=32 - KINDEX(2, 759)=211 - KINDEX(1, 760)=85 - KINDEX(2, 760)=211 - KINDEX(1, 761)=28 - KINDEX(2, 761)=212 - KINDEX(1, 762)=86 - KINDEX(2, 762)=212 - KINDEX(1, 763)=43 - KINDEX(2, 763)=213 - KINDEX(1, 764)=52 - KINDEX(2, 764)=213 - KINDEX(1, 765)=43 - KINDEX(2, 765)=214 - KINDEX(1, 766)=52 - KINDEX(2, 766)=214 - KINDEX(1, 767)=52 - KINDEX(2, 767)=215 - KINDEX(1, 768)=53 - KINDEX(2, 768)=215 - KINDEX(1, 769)=43 - KINDEX(2, 769)=216 - KINDEX(1, 770)=52 - KINDEX(2, 770)=216 - KINDEX(1, 771)=53 - KINDEX(2, 771)=216 - KINDEX(1, 772)=43 - KINDEX(2, 772)=217 + KINDEX(1, 609)=11 + KINDEX(2, 609)=133 + KINDEX(1, 610)=12 + KINDEX(2, 610)=133 + KINDEX(1, 611)=11 + KINDEX(2, 611)=134 + KINDEX(1, 612)=12 + KINDEX(2, 612)=134 + KINDEX(1, 613)=11 + KINDEX(2, 613)=135 + KINDEX(1, 614)=12 + KINDEX(2, 614)=135 + KINDEX(1, 615)=15 + KINDEX(2, 615)=135 + KINDEX(1, 616)=1 + KINDEX(2, 616)=136 + KINDEX(1, 617)=43 + KINDEX(2, 617)=136 + KINDEX(1, 618)=2 + KINDEX(2, 618)=137 + KINDEX(1, 619)=44 + KINDEX(2, 619)=137 + KINDEX(1, 620)=3 + KINDEX(2, 620)=138 + KINDEX(1, 621)=45 + KINDEX(2, 621)=138 + KINDEX(1, 622)=4 + KINDEX(2, 622)=139 + KINDEX(1, 623)=46 + KINDEX(2, 623)=139 + KINDEX(1, 624)=5 + KINDEX(2, 624)=140 + KINDEX(1, 625)=47 + KINDEX(2, 625)=140 + KINDEX(1, 626)=6 + KINDEX(2, 626)=141 + KINDEX(1, 627)=48 + KINDEX(2, 627)=141 + KINDEX(1, 628)=7 + KINDEX(2, 628)=142 + KINDEX(1, 629)=49 + KINDEX(2, 629)=142 + KINDEX(1, 630)=8 + KINDEX(2, 630)=143 + KINDEX(1, 631)=50 + KINDEX(2, 631)=143 + KINDEX(1, 632)=9 + KINDEX(2, 632)=144 + KINDEX(1, 633)=51 + KINDEX(2, 633)=144 + KINDEX(1, 634)=10 + KINDEX(2, 634)=145 + KINDEX(1, 635)=52 + KINDEX(2, 635)=145 + KINDEX(1, 636)=15 + KINDEX(2, 636)=146 + KINDEX(1, 637)=53 + KINDEX(2, 637)=146 + KINDEX(1, 638)=16 + KINDEX(2, 638)=147 + KINDEX(1, 639)=54 + KINDEX(2, 639)=147 + KINDEX(1, 640)=55 + KINDEX(2, 640)=148 + KINDEX(1, 641)=12 + KINDEX(2, 641)=149 + KINDEX(1, 642)=56 + KINDEX(2, 642)=149 + KINDEX(1, 643)=13 + KINDEX(2, 643)=150 + KINDEX(1, 644)=57 + KINDEX(2, 644)=150 + KINDEX(1, 645)=23 + KINDEX(2, 645)=151 + KINDEX(1, 646)=58 + KINDEX(2, 646)=151 + KINDEX(1, 647)=31 + KINDEX(2, 647)=152 + KINDEX(1, 648)=59 + KINDEX(2, 648)=152 + KINDEX(1, 649)=32 + KINDEX(2, 649)=153 + KINDEX(1, 650)=60 + KINDEX(2, 650)=153 + KINDEX(1, 651)=33 + KINDEX(2, 651)=154 + KINDEX(1, 652)=61 + KINDEX(2, 652)=154 + KINDEX(1, 653)=29 + KINDEX(2, 653)=155 + KINDEX(1, 654)=62 + KINDEX(2, 654)=155 + KINDEX(1, 655)=1 + KINDEX(2, 655)=156 + KINDEX(1, 656)=43 + KINDEX(2, 656)=156 + KINDEX(1, 657)=2 + KINDEX(2, 657)=157 + KINDEX(1, 658)=44 + KINDEX(2, 658)=157 + KINDEX(1, 659)=3 + KINDEX(2, 659)=158 + KINDEX(1, 660)=45 + KINDEX(2, 660)=158 + KINDEX(1, 661)=4 + KINDEX(2, 661)=159 + KINDEX(1, 662)=46 + KINDEX(2, 662)=159 + KINDEX(1, 663)=5 + KINDEX(2, 663)=160 + KINDEX(1, 664)=47 + KINDEX(2, 664)=160 + KINDEX(1, 665)=6 + KINDEX(2, 665)=161 + KINDEX(1, 666)=48 + KINDEX(2, 666)=161 + KINDEX(1, 667)=7 + KINDEX(2, 667)=162 + KINDEX(1, 668)=49 + KINDEX(2, 668)=162 + KINDEX(1, 669)=8 + KINDEX(2, 669)=163 + KINDEX(1, 670)=50 + KINDEX(2, 670)=163 + KINDEX(1, 671)=9 + KINDEX(2, 671)=164 + KINDEX(1, 672)=51 + KINDEX(2, 672)=164 + KINDEX(1, 673)=10 + KINDEX(2, 673)=165 + KINDEX(1, 674)=52 + KINDEX(2, 674)=165 + KINDEX(1, 675)=15 + KINDEX(2, 675)=166 + KINDEX(1, 676)=53 + KINDEX(2, 676)=166 + KINDEX(1, 677)=16 + KINDEX(2, 677)=167 + KINDEX(1, 678)=54 + KINDEX(2, 678)=167 + KINDEX(1, 679)=55 + KINDEX(2, 679)=168 + KINDEX(1, 680)=12 + KINDEX(2, 680)=169 + KINDEX(1, 681)=56 + KINDEX(2, 681)=169 + KINDEX(1, 682)=13 + KINDEX(2, 682)=170 + KINDEX(1, 683)=57 + KINDEX(2, 683)=170 + KINDEX(1, 684)=23 + KINDEX(2, 684)=171 + KINDEX(1, 685)=58 + KINDEX(2, 685)=171 + KINDEX(1, 686)=31 + KINDEX(2, 686)=172 + KINDEX(1, 687)=59 + KINDEX(2, 687)=172 + KINDEX(1, 688)=32 + KINDEX(2, 688)=173 + KINDEX(1, 689)=60 + KINDEX(2, 689)=173 + KINDEX(1, 690)=33 + KINDEX(2, 690)=174 + KINDEX(1, 691)=61 + KINDEX(2, 691)=174 + KINDEX(1, 692)=29 + KINDEX(2, 692)=175 + KINDEX(1, 693)=62 + KINDEX(2, 693)=175 + KINDEX(1, 694)=1 + KINDEX(2, 694)=176 + KINDEX(1, 695)=68 + KINDEX(2, 695)=176 + KINDEX(1, 696)=2 + KINDEX(2, 696)=177 + KINDEX(1, 697)=69 + KINDEX(2, 697)=177 + KINDEX(1, 698)=3 + KINDEX(2, 698)=178 + KINDEX(1, 699)=70 + KINDEX(2, 699)=178 + KINDEX(1, 700)=4 + KINDEX(2, 700)=179 + KINDEX(1, 701)=71 + KINDEX(2, 701)=179 + KINDEX(1, 702)=5 + KINDEX(2, 702)=180 + KINDEX(1, 703)=72 + KINDEX(2, 703)=180 + KINDEX(1, 704)=6 + KINDEX(2, 704)=181 + KINDEX(1, 705)=73 + KINDEX(2, 705)=181 + KINDEX(1, 706)=7 + KINDEX(2, 706)=182 + KINDEX(1, 707)=74 + KINDEX(2, 707)=182 + KINDEX(1, 708)=8 + KINDEX(2, 708)=183 + KINDEX(1, 709)=75 + KINDEX(2, 709)=183 + KINDEX(1, 710)=9 + KINDEX(2, 710)=184 + KINDEX(1, 711)=76 + KINDEX(2, 711)=184 + KINDEX(1, 712)=10 + KINDEX(2, 712)=185 + KINDEX(1, 713)=77 + KINDEX(2, 713)=185 + KINDEX(1, 714)=15 + KINDEX(2, 714)=186 + KINDEX(1, 715)=78 + KINDEX(2, 715)=186 + KINDEX(1, 716)=16 + KINDEX(2, 716)=187 + KINDEX(1, 717)=79 + KINDEX(2, 717)=187 + KINDEX(1, 718)=80 + KINDEX(2, 718)=188 + KINDEX(1, 719)=12 + KINDEX(2, 719)=189 + KINDEX(1, 720)=81 + KINDEX(2, 720)=189 + KINDEX(1, 721)=13 + KINDEX(2, 721)=190 + KINDEX(1, 722)=82 + KINDEX(2, 722)=190 + KINDEX(1, 723)=23 + KINDEX(2, 723)=191 + KINDEX(1, 724)=83 + KINDEX(2, 724)=191 + KINDEX(1, 725)=31 + KINDEX(2, 725)=192 + KINDEX(1, 726)=84 + KINDEX(2, 726)=192 + KINDEX(1, 727)=32 + KINDEX(2, 727)=193 + KINDEX(1, 728)=85 + KINDEX(2, 728)=193 + KINDEX(1, 729)=33 + KINDEX(2, 729)=194 + KINDEX(1, 730)=86 + KINDEX(2, 730)=194 + KINDEX(1, 731)=29 + KINDEX(2, 731)=195 + KINDEX(1, 732)=87 + KINDEX(2, 732)=195 + KINDEX(1, 733)=1 + KINDEX(2, 733)=196 + KINDEX(1, 734)=68 + KINDEX(2, 734)=196 + KINDEX(1, 735)=2 + KINDEX(2, 735)=197 + KINDEX(1, 736)=69 + KINDEX(2, 736)=197 + KINDEX(1, 737)=3 + KINDEX(2, 737)=198 + KINDEX(1, 738)=70 + KINDEX(2, 738)=198 + KINDEX(1, 739)=4 + KINDEX(2, 739)=199 + KINDEX(1, 740)=71 + KINDEX(2, 740)=199 + KINDEX(1, 741)=5 + KINDEX(2, 741)=200 + KINDEX(1, 742)=72 + KINDEX(2, 742)=200 + KINDEX(1, 743)=6 + KINDEX(2, 743)=201 + KINDEX(1, 744)=73 + KINDEX(2, 744)=201 + KINDEX(1, 745)=7 + KINDEX(2, 745)=202 + KINDEX(1, 746)=74 + KINDEX(2, 746)=202 + KINDEX(1, 747)=8 + KINDEX(2, 747)=203 + KINDEX(1, 748)=75 + KINDEX(2, 748)=203 + KINDEX(1, 749)=9 + KINDEX(2, 749)=204 + KINDEX(1, 750)=76 + KINDEX(2, 750)=204 + KINDEX(1, 751)=10 + KINDEX(2, 751)=205 + KINDEX(1, 752)=77 + KINDEX(2, 752)=205 + KINDEX(1, 753)=15 + KINDEX(2, 753)=206 + KINDEX(1, 754)=78 + KINDEX(2, 754)=206 + KINDEX(1, 755)=16 + KINDEX(2, 755)=207 + KINDEX(1, 756)=79 + KINDEX(2, 756)=207 + KINDEX(1, 757)=80 + KINDEX(2, 757)=208 + KINDEX(1, 758)=12 + KINDEX(2, 758)=209 + KINDEX(1, 759)=81 + KINDEX(2, 759)=209 + KINDEX(1, 760)=13 + KINDEX(2, 760)=210 + KINDEX(1, 761)=82 + KINDEX(2, 761)=210 + KINDEX(1, 762)=23 + KINDEX(2, 762)=211 + KINDEX(1, 763)=83 + KINDEX(2, 763)=211 + KINDEX(1, 764)=31 + KINDEX(2, 764)=212 + KINDEX(1, 765)=84 + KINDEX(2, 765)=212 + KINDEX(1, 766)=32 + KINDEX(2, 766)=213 + KINDEX(1, 767)=85 + KINDEX(2, 767)=213 + KINDEX(1, 768)=33 + KINDEX(2, 768)=214 + KINDEX(1, 769)=86 + KINDEX(2, 769)=214 + KINDEX(1, 770)=29 + KINDEX(2, 770)=215 + KINDEX(1, 771)=87 + KINDEX(2, 771)=215 + KINDEX(1, 772)=44 + KINDEX(2, 772)=216 KINDEX(1, 773)=53 - KINDEX(2, 773)=217 - KINDEX(1, 774)=42 - KINDEX(2, 774)=218 - KINDEX(1, 775)=52 - KINDEX(2, 775)=218 + KINDEX(2, 773)=216 + KINDEX(1, 774)=44 + KINDEX(2, 774)=217 + KINDEX(1, 775)=53 + KINDEX(2, 775)=217 KINDEX(1, 776)=53 KINDEX(2, 776)=218 - KINDEX(1, 777)=52 - KINDEX(2, 777)=219 - KINDEX(1, 778)=55 + KINDEX(1, 777)=54 + KINDEX(2, 777)=218 + KINDEX(1, 778)=44 KINDEX(2, 778)=219 - KINDEX(1, 779)=62 + KINDEX(1, 779)=53 KINDEX(2, 779)=219 - KINDEX(1, 780)=45 - KINDEX(2, 780)=220 - KINDEX(1, 781)=48 + KINDEX(1, 780)=54 + KINDEX(2, 780)=219 + KINDEX(1, 781)=44 KINDEX(2, 781)=220 - KINDEX(1, 782)=52 + KINDEX(1, 782)=54 KINDEX(2, 782)=220 - KINDEX(1, 783)=45 + KINDEX(1, 783)=43 KINDEX(2, 783)=221 - KINDEX(1, 784)=50 + KINDEX(1, 784)=53 KINDEX(2, 784)=221 - KINDEX(1, 785)=53 + KINDEX(1, 785)=54 KINDEX(2, 785)=221 - KINDEX(1, 786)=45 + KINDEX(1, 786)=53 KINDEX(2, 786)=222 - KINDEX(1, 787)=50 + KINDEX(1, 787)=56 KINDEX(2, 787)=222 - KINDEX(1, 788)=53 + KINDEX(1, 788)=63 KINDEX(2, 788)=222 - KINDEX(1, 789)=48 + KINDEX(1, 789)=46 KINDEX(2, 789)=223 - KINDEX(1, 790)=50 + KINDEX(1, 790)=49 KINDEX(2, 790)=223 - KINDEX(1, 791)=49 - KINDEX(2, 791)=224 - KINDEX(1, 792)=50 + KINDEX(1, 791)=53 + KINDEX(2, 791)=223 + KINDEX(1, 792)=46 KINDEX(2, 792)=224 - KINDEX(1, 793)=55 + KINDEX(1, 793)=51 KINDEX(2, 793)=224 - KINDEX(1, 794)=56 + KINDEX(1, 794)=54 KINDEX(2, 794)=224 - KINDEX(1, 795)=45 + KINDEX(1, 795)=46 KINDEX(2, 795)=225 - KINDEX(1, 796)=49 + KINDEX(1, 796)=51 KINDEX(2, 796)=225 - KINDEX(1, 797)=52 + KINDEX(1, 797)=54 KINDEX(2, 797)=225 - KINDEX(1, 798)=47 + KINDEX(1, 798)=49 KINDEX(2, 798)=226 - KINDEX(1, 799)=49 + KINDEX(1, 799)=51 KINDEX(2, 799)=226 - KINDEX(1, 800)=46 + KINDEX(1, 800)=50 KINDEX(2, 800)=227 - KINDEX(1, 801)=49 + KINDEX(1, 801)=51 KINDEX(2, 801)=227 KINDEX(1, 802)=56 KINDEX(2, 802)=227 - KINDEX(1, 803)=63 + KINDEX(1, 803)=57 KINDEX(2, 803)=227 KINDEX(1, 804)=46 KINDEX(2, 804)=228 - KINDEX(1, 805)=49 + KINDEX(1, 805)=50 KINDEX(2, 805)=228 - KINDEX(1, 806)=55 + KINDEX(1, 806)=53 KINDEX(2, 806)=228 - KINDEX(1, 807)=62 - KINDEX(2, 807)=228 - KINDEX(1, 808)=53 + KINDEX(1, 807)=48 + KINDEX(2, 807)=229 + KINDEX(1, 808)=50 KINDEX(2, 808)=229 - KINDEX(1, 809)=57 - KINDEX(2, 809)=229 - KINDEX(1, 810)=60 - KINDEX(2, 810)=229 - KINDEX(1, 811)=55 + KINDEX(1, 809)=47 + KINDEX(2, 809)=230 + KINDEX(1, 810)=50 + KINDEX(2, 810)=230 + KINDEX(1, 811)=57 KINDEX(2, 811)=230 - KINDEX(1, 812)=60 + KINDEX(1, 812)=64 KINDEX(2, 812)=230 - KINDEX(1, 813)=61 - KINDEX(2, 813)=230 - KINDEX(1, 814)=62 - KINDEX(2, 814)=230 - KINDEX(1, 815)=52 + KINDEX(1, 813)=47 + KINDEX(2, 813)=231 + KINDEX(1, 814)=50 + KINDEX(2, 814)=231 + KINDEX(1, 815)=56 KINDEX(2, 815)=231 - KINDEX(1, 816)=53 + KINDEX(1, 816)=63 KINDEX(2, 816)=231 - KINDEX(1, 817)=57 - KINDEX(2, 817)=231 + KINDEX(1, 817)=54 + KINDEX(2, 817)=232 KINDEX(1, 818)=58 - KINDEX(2, 818)=231 - KINDEX(1, 819)=52 + KINDEX(2, 818)=232 + KINDEX(1, 819)=61 KINDEX(2, 819)=232 - KINDEX(1, 820)=53 - KINDEX(2, 820)=232 - KINDEX(1, 821)=54 - KINDEX(2, 821)=232 - KINDEX(1, 822)=58 - KINDEX(2, 822)=232 - KINDEX(1, 823)=55 + KINDEX(1, 820)=56 + KINDEX(2, 820)=233 + KINDEX(1, 821)=61 + KINDEX(2, 821)=233 + KINDEX(1, 822)=62 + KINDEX(2, 822)=233 + KINDEX(1, 823)=63 KINDEX(2, 823)=233 - KINDEX(1, 824)=57 - KINDEX(2, 824)=233 - KINDEX(1, 825)=66 - KINDEX(2, 825)=233 - KINDEX(1, 826)=55 + KINDEX(1, 824)=53 + KINDEX(2, 824)=234 + KINDEX(1, 825)=54 + KINDEX(2, 825)=234 + KINDEX(1, 826)=58 KINDEX(2, 826)=234 - KINDEX(1, 827)=57 + KINDEX(1, 827)=59 KINDEX(2, 827)=234 - KINDEX(1, 828)=66 - KINDEX(2, 828)=234 - KINDEX(1, 829)=52 + KINDEX(1, 828)=53 + KINDEX(2, 828)=235 + KINDEX(1, 829)=54 KINDEX(2, 829)=235 - KINDEX(1, 830)=53 + KINDEX(1, 830)=55 KINDEX(2, 830)=235 - KINDEX(1, 831)=55 + KINDEX(1, 831)=59 KINDEX(2, 831)=235 - KINDEX(1, 832)=58 - KINDEX(2, 832)=235 - KINDEX(1, 833)=66 - KINDEX(2, 833)=235 - KINDEX(1, 834)=62 + KINDEX(1, 832)=56 + KINDEX(2, 832)=236 + KINDEX(1, 833)=58 + KINDEX(2, 833)=236 + KINDEX(1, 834)=67 KINDEX(2, 834)=236 - KINDEX(1, 835)=64 - KINDEX(2, 835)=236 - KINDEX(1, 836)=53 + KINDEX(1, 835)=56 + KINDEX(2, 835)=237 + KINDEX(1, 836)=58 KINDEX(2, 836)=237 - KINDEX(1, 837)=64 + KINDEX(1, 837)=67 KINDEX(2, 837)=237 - KINDEX(1, 838)=65 - KINDEX(2, 838)=237 - KINDEX(1, 839)=63 + KINDEX(1, 838)=53 + KINDEX(2, 838)=238 + KINDEX(1, 839)=54 KINDEX(2, 839)=238 - KINDEX(1, 840)=64 + KINDEX(1, 840)=56 KINDEX(2, 840)=238 - KINDEX(1, 841)=55 - KINDEX(2, 841)=239 - KINDEX(1, 842)=56 - KINDEX(2, 842)=239 - KINDEX(1, 843)=65 + KINDEX(1, 841)=59 + KINDEX(2, 841)=238 + KINDEX(1, 842)=67 + KINDEX(2, 842)=238 + KINDEX(1, 843)=63 KINDEX(2, 843)=239 - KINDEX(1, 844)=52 - KINDEX(2, 844)=240 - KINDEX(1, 845)=56 + KINDEX(1, 844)=65 + KINDEX(2, 844)=239 + KINDEX(1, 845)=54 KINDEX(2, 845)=240 - KINDEX(1, 846)=63 + KINDEX(1, 846)=65 KINDEX(2, 846)=240 - KINDEX(1, 847)=42 - KINDEX(2, 847)=241 - KINDEX(1, 848)=55 + KINDEX(1, 847)=66 + KINDEX(2, 847)=240 + KINDEX(1, 848)=64 KINDEX(2, 848)=241 - KINDEX(1, 849)=56 + KINDEX(1, 849)=65 KINDEX(2, 849)=241 - KINDEX(1, 850)=43 + KINDEX(1, 850)=56 KINDEX(2, 850)=242 - KINDEX(1, 851)=55 + KINDEX(1, 851)=57 KINDEX(2, 851)=242 - KINDEX(1, 852)=56 + KINDEX(1, 852)=66 KINDEX(2, 852)=242 - KINDEX(1, 853)=68 + KINDEX(1, 853)=53 KINDEX(2, 853)=243 - KINDEX(1, 854)=77 + KINDEX(1, 854)=57 KINDEX(2, 854)=243 - KINDEX(1, 855)=68 - KINDEX(2, 855)=244 - KINDEX(1, 856)=77 + KINDEX(1, 855)=64 + KINDEX(2, 855)=243 + KINDEX(1, 856)=43 KINDEX(2, 856)=244 - KINDEX(1, 857)=77 - KINDEX(2, 857)=245 - KINDEX(1, 858)=78 - KINDEX(2, 858)=245 - KINDEX(1, 859)=68 - KINDEX(2, 859)=246 - KINDEX(1, 860)=77 - KINDEX(2, 860)=246 - KINDEX(1, 861)=78 - KINDEX(2, 861)=246 - KINDEX(1, 862)=68 - KINDEX(2, 862)=247 + KINDEX(1, 857)=56 + KINDEX(2, 857)=244 + KINDEX(1, 858)=57 + KINDEX(2, 858)=244 + KINDEX(1, 859)=44 + KINDEX(2, 859)=245 + KINDEX(1, 860)=56 + KINDEX(2, 860)=245 + KINDEX(1, 861)=57 + KINDEX(2, 861)=245 + KINDEX(1, 862)=69 + KINDEX(2, 862)=246 KINDEX(1, 863)=78 - KINDEX(2, 863)=247 - KINDEX(1, 864)=67 - KINDEX(2, 864)=248 - KINDEX(1, 865)=77 - KINDEX(2, 865)=248 + KINDEX(2, 863)=246 + KINDEX(1, 864)=69 + KINDEX(2, 864)=247 + KINDEX(1, 865)=78 + KINDEX(2, 865)=247 KINDEX(1, 866)=78 KINDEX(2, 866)=248 - KINDEX(1, 867)=77 - KINDEX(2, 867)=249 - KINDEX(1, 868)=80 + KINDEX(1, 867)=79 + KINDEX(2, 867)=248 + KINDEX(1, 868)=69 KINDEX(2, 868)=249 - KINDEX(1, 869)=87 + KINDEX(1, 869)=78 KINDEX(2, 869)=249 - KINDEX(1, 870)=70 - KINDEX(2, 870)=250 - KINDEX(1, 871)=73 + KINDEX(1, 870)=79 + KINDEX(2, 870)=249 + KINDEX(1, 871)=69 KINDEX(2, 871)=250 - KINDEX(1, 872)=77 + KINDEX(1, 872)=79 KINDEX(2, 872)=250 - KINDEX(1, 873)=70 + KINDEX(1, 873)=68 KINDEX(2, 873)=251 - KINDEX(1, 874)=75 + KINDEX(1, 874)=78 KINDEX(2, 874)=251 - KINDEX(1, 875)=78 + KINDEX(1, 875)=79 KINDEX(2, 875)=251 - KINDEX(1, 876)=70 + KINDEX(1, 876)=78 KINDEX(2, 876)=252 - KINDEX(1, 877)=75 + KINDEX(1, 877)=81 KINDEX(2, 877)=252 - KINDEX(1, 878)=78 + KINDEX(1, 878)=88 KINDEX(2, 878)=252 - KINDEX(1, 879)=73 + KINDEX(1, 879)=71 KINDEX(2, 879)=253 - KINDEX(1, 880)=75 + KINDEX(1, 880)=74 KINDEX(2, 880)=253 - KINDEX(1, 881)=74 - KINDEX(2, 881)=254 - KINDEX(1, 882)=75 + KINDEX(1, 881)=78 + KINDEX(2, 881)=253 + KINDEX(1, 882)=71 KINDEX(2, 882)=254 - KINDEX(1, 883)=80 + KINDEX(1, 883)=76 KINDEX(2, 883)=254 - KINDEX(1, 884)=81 + KINDEX(1, 884)=79 KINDEX(2, 884)=254 - KINDEX(1, 885)=70 + KINDEX(1, 885)=71 KINDEX(2, 885)=255 - KINDEX(1, 886)=74 + KINDEX(1, 886)=76 KINDEX(2, 886)=255 - KINDEX(1, 887)=77 + KINDEX(1, 887)=79 KINDEX(2, 887)=255 - KINDEX(1, 888)=72 + KINDEX(1, 888)=74 KINDEX(2, 888)=256 - KINDEX(1, 889)=74 + KINDEX(1, 889)=76 KINDEX(2, 889)=256 - KINDEX(1, 890)=71 + KINDEX(1, 890)=75 KINDEX(2, 890)=257 - KINDEX(1, 891)=74 + KINDEX(1, 891)=76 KINDEX(2, 891)=257 KINDEX(1, 892)=81 KINDEX(2, 892)=257 - KINDEX(1, 893)=88 + KINDEX(1, 893)=82 KINDEX(2, 893)=257 KINDEX(1, 894)=71 KINDEX(2, 894)=258 - KINDEX(1, 895)=74 + KINDEX(1, 895)=75 KINDEX(2, 895)=258 - KINDEX(1, 896)=80 + KINDEX(1, 896)=78 KINDEX(2, 896)=258 - KINDEX(1, 897)=87 - KINDEX(2, 897)=258 - KINDEX(1, 898)=78 + KINDEX(1, 897)=73 + KINDEX(2, 897)=259 + KINDEX(1, 898)=75 KINDEX(2, 898)=259 - KINDEX(1, 899)=82 - KINDEX(2, 899)=259 - KINDEX(1, 900)=85 - KINDEX(2, 900)=259 - KINDEX(1, 901)=80 + KINDEX(1, 899)=72 + KINDEX(2, 899)=260 + KINDEX(1, 900)=75 + KINDEX(2, 900)=260 + KINDEX(1, 901)=82 KINDEX(2, 901)=260 - KINDEX(1, 902)=85 + KINDEX(1, 902)=89 KINDEX(2, 902)=260 - KINDEX(1, 903)=86 - KINDEX(2, 903)=260 - KINDEX(1, 904)=87 - KINDEX(2, 904)=260 - KINDEX(1, 905)=77 + KINDEX(1, 903)=72 + KINDEX(2, 903)=261 + KINDEX(1, 904)=75 + KINDEX(2, 904)=261 + KINDEX(1, 905)=81 KINDEX(2, 905)=261 - KINDEX(1, 906)=78 + KINDEX(1, 906)=88 KINDEX(2, 906)=261 - KINDEX(1, 907)=82 - KINDEX(2, 907)=261 + KINDEX(1, 907)=79 + KINDEX(2, 907)=262 KINDEX(1, 908)=83 - KINDEX(2, 908)=261 - KINDEX(1, 909)=77 + KINDEX(2, 908)=262 + KINDEX(1, 909)=86 KINDEX(2, 909)=262 - KINDEX(1, 910)=78 - KINDEX(2, 910)=262 - KINDEX(1, 911)=79 - KINDEX(2, 911)=262 - KINDEX(1, 912)=83 - KINDEX(2, 912)=262 - KINDEX(1, 913)=80 + KINDEX(1, 910)=81 + KINDEX(2, 910)=263 + KINDEX(1, 911)=86 + KINDEX(2, 911)=263 + KINDEX(1, 912)=87 + KINDEX(2, 912)=263 + KINDEX(1, 913)=88 KINDEX(2, 913)=263 - KINDEX(1, 914)=82 - KINDEX(2, 914)=263 - KINDEX(1, 915)=91 - KINDEX(2, 915)=263 - KINDEX(1, 916)=80 + KINDEX(1, 914)=78 + KINDEX(2, 914)=264 + KINDEX(1, 915)=79 + KINDEX(2, 915)=264 + KINDEX(1, 916)=83 KINDEX(2, 916)=264 - KINDEX(1, 917)=82 + KINDEX(1, 917)=84 KINDEX(2, 917)=264 - KINDEX(1, 918)=91 - KINDEX(2, 918)=264 - KINDEX(1, 919)=77 + KINDEX(1, 918)=78 + KINDEX(2, 918)=265 + KINDEX(1, 919)=79 KINDEX(2, 919)=265 - KINDEX(1, 920)=78 + KINDEX(1, 920)=80 KINDEX(2, 920)=265 - KINDEX(1, 921)=80 + KINDEX(1, 921)=84 KINDEX(2, 921)=265 - KINDEX(1, 922)=83 - KINDEX(2, 922)=265 - KINDEX(1, 923)=91 - KINDEX(2, 923)=265 - KINDEX(1, 924)=87 + KINDEX(1, 922)=81 + KINDEX(2, 922)=266 + KINDEX(1, 923)=83 + KINDEX(2, 923)=266 + KINDEX(1, 924)=92 KINDEX(2, 924)=266 - KINDEX(1, 925)=89 - KINDEX(2, 925)=266 - KINDEX(1, 926)=78 + KINDEX(1, 925)=81 + KINDEX(2, 925)=267 + KINDEX(1, 926)=83 KINDEX(2, 926)=267 - KINDEX(1, 927)=89 + KINDEX(1, 927)=92 KINDEX(2, 927)=267 - KINDEX(1, 928)=90 - KINDEX(2, 928)=267 - KINDEX(1, 929)=88 + KINDEX(1, 928)=78 + KINDEX(2, 928)=268 + KINDEX(1, 929)=79 KINDEX(2, 929)=268 - KINDEX(1, 930)=89 + KINDEX(1, 930)=81 KINDEX(2, 930)=268 - KINDEX(1, 931)=80 - KINDEX(2, 931)=269 - KINDEX(1, 932)=81 - KINDEX(2, 932)=269 - KINDEX(1, 933)=90 + KINDEX(1, 931)=84 + KINDEX(2, 931)=268 + KINDEX(1, 932)=92 + KINDEX(2, 932)=268 + KINDEX(1, 933)=88 KINDEX(2, 933)=269 - KINDEX(1, 934)=77 - KINDEX(2, 934)=270 - KINDEX(1, 935)=81 + KINDEX(1, 934)=90 + KINDEX(2, 934)=269 + KINDEX(1, 935)=79 KINDEX(2, 935)=270 - KINDEX(1, 936)=88 + KINDEX(1, 936)=90 KINDEX(2, 936)=270 - KINDEX(1, 937)=67 - KINDEX(2, 937)=271 - KINDEX(1, 938)=80 + KINDEX(1, 937)=91 + KINDEX(2, 937)=270 + KINDEX(1, 938)=89 KINDEX(2, 938)=271 - KINDEX(1, 939)=81 + KINDEX(1, 939)=90 KINDEX(2, 939)=271 - KINDEX(1, 940)=68 + KINDEX(1, 940)=81 KINDEX(2, 940)=272 - KINDEX(1, 941)=80 + KINDEX(1, 941)=82 KINDEX(2, 941)=272 - KINDEX(1, 942)=81 + KINDEX(1, 942)=91 KINDEX(2, 942)=272 + KINDEX(1, 943)=78 + KINDEX(2, 943)=273 + KINDEX(1, 944)=82 + KINDEX(2, 944)=273 + KINDEX(1, 945)=89 + KINDEX(2, 945)=273 + KINDEX(1, 946)=68 + KINDEX(2, 946)=274 + KINDEX(1, 947)=81 + KINDEX(2, 947)=274 + KINDEX(1, 948)=82 + KINDEX(2, 948)=274 + KINDEX(1, 949)=69 + KINDEX(2, 949)=275 + KINDEX(1, 950)=81 + KINDEX(2, 950)=275 + KINDEX(1, 951)=82 + KINDEX(2, 951)=275 RETURN END SUBROUTINE CH_NONZEROTERMS_AQ !! @@ -37307,7 +37992,7 @@ END SUBROUTINE CH_NONZEROTERMS_AQ !! !! EXTERNAL !! -------- -use mode_msg +!! none !! !! IMPLICIT ARGUMENTS !! ------------------ @@ -37317,8 +38002,8 @@ use mode_msg !! ------------------ IMPLICIT NONE ! check if output array is large enough -IF (KINDEXDIM.LT.606) THEN - call Print_msg( NVERB_FATAL, 'GEN', 'CH_NONZEROTERMS_GAZ', 'array KINDEX is too small' ) +IF (KINDEXDIM.LT.615) THEN + STOP 'CH_NONZEROTERMS ERROR: array KINDEX is too small!' END IF KINDEX(1, 1)=3 KINDEX(2, 1)=1 @@ -37332,13 +38017,13 @@ END IF KINDEX(2, 5)=4 KINDEX(1, 6)=7 KINDEX(2, 6)=4 - KINDEX(1, 7)=14 + KINDEX(1, 7)=15 KINDEX(2, 7)=4 KINDEX(1, 8)=4 KINDEX(2, 8)=5 KINDEX(1, 9)=8 KINDEX(2, 9)=5 - KINDEX(1, 10)=14 + KINDEX(1, 10)=15 KINDEX(2, 10)=5 KINDEX(1, 11)=4 KINDEX(2, 11)=6 @@ -37346,9 +38031,9 @@ END IF KINDEX(2, 12)=6 KINDEX(1, 13)=9 KINDEX(2, 13)=6 - KINDEX(1, 14)=14 + KINDEX(1, 14)=15 KINDEX(2, 14)=6 - KINDEX(1, 15)=15 + KINDEX(1, 15)=16 KINDEX(2, 15)=6 KINDEX(1, 16)=3 KINDEX(2, 16)=7 @@ -37360,105 +38045,105 @@ END IF KINDEX(2, 19)=8 KINDEX(1, 20)=2 KINDEX(2, 20)=9 - KINDEX(1, 21)=14 + KINDEX(1, 21)=15 KINDEX(2, 21)=9 - KINDEX(1, 22)=13 + KINDEX(1, 22)=14 KINDEX(2, 22)=10 - KINDEX(1, 23)=22 + KINDEX(1, 23)=23 KINDEX(2, 23)=10 - KINDEX(1, 24)=13 + KINDEX(1, 24)=14 KINDEX(2, 24)=11 - KINDEX(1, 25)=15 + KINDEX(1, 25)=16 KINDEX(2, 25)=11 - KINDEX(1, 26)=22 + KINDEX(1, 26)=23 KINDEX(2, 26)=11 - KINDEX(1, 27)=13 + KINDEX(1, 27)=14 KINDEX(2, 27)=12 - KINDEX(1, 28)=15 + KINDEX(1, 28)=16 KINDEX(2, 28)=12 - KINDEX(1, 29)=23 + KINDEX(1, 29)=24 KINDEX(2, 29)=12 - KINDEX(1, 30)=32 + KINDEX(1, 30)=33 KINDEX(2, 30)=12 - KINDEX(1, 31)=14 + KINDEX(1, 31)=15 KINDEX(2, 31)=13 - KINDEX(1, 32)=15 + KINDEX(1, 32)=16 KINDEX(2, 32)=13 - KINDEX(1, 33)=22 + KINDEX(1, 33)=23 KINDEX(2, 33)=13 - KINDEX(1, 34)=28 + KINDEX(1, 34)=29 KINDEX(2, 34)=13 - KINDEX(1, 35)=14 + KINDEX(1, 35)=15 KINDEX(2, 35)=14 - KINDEX(1, 36)=15 + KINDEX(1, 36)=16 KINDEX(2, 36)=14 - KINDEX(1, 37)=23 + KINDEX(1, 37)=24 KINDEX(2, 37)=14 - KINDEX(1, 38)=29 + KINDEX(1, 38)=30 KINDEX(2, 38)=14 - KINDEX(1, 39)=32 + KINDEX(1, 39)=33 KINDEX(2, 39)=14 - KINDEX(1, 40)=24 + KINDEX(1, 40)=25 KINDEX(2, 40)=15 - KINDEX(1, 41)=33 + KINDEX(1, 41)=34 KINDEX(2, 41)=15 - KINDEX(1, 42)=39 + KINDEX(1, 42)=40 KINDEX(2, 42)=15 - KINDEX(1, 43)=13 + KINDEX(1, 43)=14 KINDEX(2, 43)=16 - KINDEX(1, 44)=15 + KINDEX(1, 44)=16 KINDEX(2, 44)=16 - KINDEX(1, 45)=22 + KINDEX(1, 45)=23 KINDEX(2, 45)=16 - KINDEX(1, 46)=25 + KINDEX(1, 46)=26 KINDEX(2, 46)=16 - KINDEX(1, 47)=39 + KINDEX(1, 47)=40 KINDEX(2, 47)=16 KINDEX(1, 48)=4 KINDEX(2, 48)=17 - KINDEX(1, 49)=15 + KINDEX(1, 49)=16 KINDEX(2, 49)=17 - KINDEX(1, 50)=23 + KINDEX(1, 50)=24 KINDEX(2, 50)=17 - KINDEX(1, 51)=24 + KINDEX(1, 51)=25 KINDEX(2, 51)=17 - KINDEX(1, 52)=26 + KINDEX(1, 52)=27 KINDEX(2, 52)=17 KINDEX(1, 53)=1 KINDEX(2, 53)=18 KINDEX(1, 54)=1 KINDEX(2, 54)=19 - KINDEX(1, 55)=14 + KINDEX(1, 55)=15 KINDEX(2, 55)=22 KINDEX(1, 56)=1 KINDEX(2, 56)=23 - KINDEX(1, 57)=14 + KINDEX(1, 57)=15 KINDEX(2, 57)=23 - KINDEX(1, 58)=15 + KINDEX(1, 58)=16 KINDEX(2, 58)=23 KINDEX(1, 59)=1 KINDEX(2, 59)=24 - KINDEX(1, 60)=14 + KINDEX(1, 60)=15 KINDEX(2, 60)=24 - KINDEX(1, 61)=15 + KINDEX(1, 61)=16 KINDEX(2, 61)=24 - KINDEX(1, 62)=14 + KINDEX(1, 62)=15 KINDEX(2, 62)=25 - KINDEX(1, 63)=15 + KINDEX(1, 63)=16 KINDEX(2, 63)=25 KINDEX(1, 64)=2 KINDEX(2, 64)=26 - KINDEX(1, 65)=14 + KINDEX(1, 65)=15 KINDEX(2, 65)=26 - KINDEX(1, 66)=15 + KINDEX(1, 66)=16 KINDEX(2, 66)=26 KINDEX(1, 67)=2 KINDEX(2, 67)=27 - KINDEX(1, 68)=15 + KINDEX(1, 68)=16 KINDEX(2, 68)=27 KINDEX(1, 69)=2 KINDEX(2, 69)=28 - KINDEX(1, 70)=15 + KINDEX(1, 70)=16 KINDEX(2, 70)=28 KINDEX(1, 71)=3 KINDEX(2, 71)=29 @@ -37476,41 +38161,41 @@ END IF KINDEX(2, 77)=32 KINDEX(1, 78)=7 KINDEX(2, 78)=32 - KINDEX(1, 79)=14 + KINDEX(1, 79)=15 KINDEX(2, 79)=32 KINDEX(1, 80)=4 KINDEX(2, 80)=33 KINDEX(1, 81)=8 KINDEX(2, 81)=33 - KINDEX(1, 82)=14 + KINDEX(1, 82)=15 KINDEX(2, 82)=33 KINDEX(1, 83)=4 KINDEX(2, 83)=34 KINDEX(1, 84)=5 KINDEX(2, 84)=34 - KINDEX(1, 85)=14 + KINDEX(1, 85)=15 KINDEX(2, 85)=34 - KINDEX(1, 86)=15 + KINDEX(1, 86)=16 KINDEX(2, 86)=34 KINDEX(1, 87)=3 KINDEX(2, 87)=35 KINDEX(1, 88)=4 KINDEX(2, 88)=35 - KINDEX(1, 89)=14 + KINDEX(1, 89)=15 KINDEX(2, 89)=35 - KINDEX(1, 90)=15 + KINDEX(1, 90)=16 KINDEX(2, 90)=35 KINDEX(1, 91)=4 KINDEX(2, 91)=36 KINDEX(1, 92)=9 KINDEX(2, 92)=36 - KINDEX(1, 93)=15 + KINDEX(1, 93)=16 KINDEX(2, 93)=36 KINDEX(1, 94)=4 KINDEX(2, 94)=37 KINDEX(1, 95)=9 KINDEX(2, 95)=37 - KINDEX(1, 96)=15 + KINDEX(1, 96)=16 KINDEX(2, 96)=37 KINDEX(1, 97)=4 KINDEX(2, 97)=38 @@ -37518,27 +38203,27 @@ END IF KINDEX(2, 98)=38 KINDEX(1, 99)=8 KINDEX(2, 99)=38 - KINDEX(1, 100)=14 + KINDEX(1, 100)=15 KINDEX(2, 100)=38 - KINDEX(1, 101)=15 + KINDEX(1, 101)=16 KINDEX(2, 101)=38 KINDEX(1, 102)=4 KINDEX(2, 102)=39 KINDEX(1, 103)=7 KINDEX(2, 103)=39 - KINDEX(1, 104)=14 + KINDEX(1, 104)=15 KINDEX(2, 104)=39 KINDEX(1, 105)=5 KINDEX(2, 105)=40 KINDEX(1, 106)=8 KINDEX(2, 106)=40 - KINDEX(1, 107)=14 + KINDEX(1, 107)=15 KINDEX(2, 107)=40 KINDEX(1, 108)=4 KINDEX(2, 108)=41 KINDEX(1, 109)=9 KINDEX(2, 109)=41 - KINDEX(1, 110)=14 + KINDEX(1, 110)=15 KINDEX(2, 110)=41 KINDEX(1, 111)=1 KINDEX(2, 111)=42 @@ -37586,217 +38271,217 @@ END IF KINDEX(2, 132)=49 KINDEX(1, 133)=10 KINDEX(2, 133)=50 - KINDEX(1, 134)=14 + KINDEX(1, 134)=15 KINDEX(2, 134)=50 - KINDEX(1, 135)=14 + KINDEX(1, 135)=15 KINDEX(2, 135)=51 - KINDEX(1, 136)=15 + KINDEX(1, 136)=16 KINDEX(2, 136)=51 - KINDEX(1, 137)=11 + KINDEX(1, 137)=12 KINDEX(2, 137)=52 - KINDEX(1, 138)=12 + KINDEX(1, 138)=13 KINDEX(2, 138)=52 - KINDEX(1, 139)=14 + KINDEX(1, 139)=15 KINDEX(2, 139)=52 - KINDEX(1, 140)=15 + KINDEX(1, 140)=16 KINDEX(2, 140)=52 - KINDEX(1, 141)=13 + KINDEX(1, 141)=14 KINDEX(2, 141)=53 - KINDEX(1, 142)=14 + KINDEX(1, 142)=15 KINDEX(2, 142)=53 - KINDEX(1, 143)=15 + KINDEX(1, 143)=16 KINDEX(2, 143)=53 - KINDEX(1, 144)=13 + KINDEX(1, 144)=14 KINDEX(2, 144)=54 - KINDEX(1, 145)=14 + KINDEX(1, 145)=15 KINDEX(2, 145)=54 - KINDEX(1, 146)=15 + KINDEX(1, 146)=16 KINDEX(2, 146)=54 - KINDEX(1, 147)=19 + KINDEX(1, 147)=20 KINDEX(2, 147)=54 - KINDEX(1, 148)=20 + KINDEX(1, 148)=21 KINDEX(2, 148)=54 - KINDEX(1, 149)=22 + KINDEX(1, 149)=23 KINDEX(2, 149)=54 - KINDEX(1, 150)=25 + KINDEX(1, 150)=26 KINDEX(2, 150)=54 - KINDEX(1, 151)=41 + KINDEX(1, 151)=42 KINDEX(2, 151)=54 - KINDEX(1, 152)=23 + KINDEX(1, 152)=24 KINDEX(2, 152)=55 - KINDEX(1, 153)=25 + KINDEX(1, 153)=26 KINDEX(2, 153)=55 - KINDEX(1, 154)=14 + KINDEX(1, 154)=15 KINDEX(2, 154)=56 - KINDEX(1, 155)=16 + KINDEX(1, 155)=17 KINDEX(2, 155)=56 - KINDEX(1, 156)=32 + KINDEX(1, 156)=33 KINDEX(2, 156)=56 - KINDEX(1, 157)=14 + KINDEX(1, 157)=15 KINDEX(2, 157)=57 - KINDEX(1, 158)=17 + KINDEX(1, 158)=18 KINDEX(2, 158)=57 - KINDEX(1, 159)=33 + KINDEX(1, 159)=34 KINDEX(2, 159)=57 - KINDEX(1, 160)=13 + KINDEX(1, 160)=14 KINDEX(2, 160)=58 - KINDEX(1, 161)=14 + KINDEX(1, 161)=15 KINDEX(2, 161)=58 - KINDEX(1, 162)=15 + KINDEX(1, 162)=16 KINDEX(2, 162)=58 - KINDEX(1, 163)=18 + KINDEX(1, 163)=19 KINDEX(2, 163)=58 - KINDEX(1, 164)=22 + KINDEX(1, 164)=23 KINDEX(2, 164)=58 - KINDEX(1, 165)=23 + KINDEX(1, 165)=24 KINDEX(2, 165)=58 - KINDEX(1, 166)=24 + KINDEX(1, 166)=25 KINDEX(2, 166)=58 - KINDEX(1, 167)=25 + KINDEX(1, 167)=26 KINDEX(2, 167)=58 - KINDEX(1, 168)=30 + KINDEX(1, 168)=31 KINDEX(2, 168)=58 - KINDEX(1, 169)=33 + KINDEX(1, 169)=34 KINDEX(2, 169)=58 - KINDEX(1, 170)=14 + KINDEX(1, 170)=15 KINDEX(2, 170)=59 - KINDEX(1, 171)=19 + KINDEX(1, 171)=20 KINDEX(2, 171)=59 - KINDEX(1, 172)=34 + KINDEX(1, 172)=35 KINDEX(2, 172)=59 - KINDEX(1, 173)=35 + KINDEX(1, 173)=36 KINDEX(2, 173)=59 - KINDEX(1, 174)=14 + KINDEX(1, 174)=15 KINDEX(2, 174)=60 - KINDEX(1, 175)=20 + KINDEX(1, 175)=21 KINDEX(2, 175)=60 - KINDEX(1, 176)=35 + KINDEX(1, 176)=36 KINDEX(2, 176)=60 - KINDEX(1, 177)=14 + KINDEX(1, 177)=15 KINDEX(2, 177)=61 - KINDEX(1, 178)=15 + KINDEX(1, 178)=16 KINDEX(2, 178)=61 - KINDEX(1, 179)=21 + KINDEX(1, 179)=22 KINDEX(2, 179)=61 - KINDEX(1, 180)=36 + KINDEX(1, 180)=37 KINDEX(2, 180)=61 - KINDEX(1, 181)=37 + KINDEX(1, 181)=38 KINDEX(2, 181)=61 - KINDEX(1, 182)=41 + KINDEX(1, 182)=42 KINDEX(2, 182)=61 - KINDEX(1, 183)=13 + KINDEX(1, 183)=14 KINDEX(2, 183)=62 - KINDEX(1, 184)=14 + KINDEX(1, 184)=15 KINDEX(2, 184)=62 - KINDEX(1, 185)=15 + KINDEX(1, 185)=16 KINDEX(2, 185)=62 - KINDEX(1, 186)=22 + KINDEX(1, 186)=23 KINDEX(2, 186)=62 - KINDEX(1, 187)=14 + KINDEX(1, 187)=15 KINDEX(2, 187)=63 - KINDEX(1, 188)=23 + KINDEX(1, 188)=24 KINDEX(2, 188)=63 - KINDEX(1, 189)=39 + KINDEX(1, 189)=40 KINDEX(2, 189)=63 - KINDEX(1, 190)=14 + KINDEX(1, 190)=15 KINDEX(2, 190)=64 - KINDEX(1, 191)=24 + KINDEX(1, 191)=25 KINDEX(2, 191)=64 - KINDEX(1, 192)=39 + KINDEX(1, 192)=40 KINDEX(2, 192)=64 - KINDEX(1, 193)=13 + KINDEX(1, 193)=14 KINDEX(2, 193)=65 - KINDEX(1, 194)=14 + KINDEX(1, 194)=15 KINDEX(2, 194)=65 - KINDEX(1, 195)=15 + KINDEX(1, 195)=16 KINDEX(2, 195)=65 - KINDEX(1, 196)=22 + KINDEX(1, 196)=23 KINDEX(2, 196)=65 - KINDEX(1, 197)=23 + KINDEX(1, 197)=24 KINDEX(2, 197)=65 - KINDEX(1, 198)=24 + KINDEX(1, 198)=25 KINDEX(2, 198)=65 - KINDEX(1, 199)=25 + KINDEX(1, 199)=26 KINDEX(2, 199)=65 - KINDEX(1, 200)=39 + KINDEX(1, 200)=40 KINDEX(2, 200)=65 - KINDEX(1, 201)=41 + KINDEX(1, 201)=42 KINDEX(2, 201)=65 - KINDEX(1, 202)=14 + KINDEX(1, 202)=15 KINDEX(2, 202)=66 - KINDEX(1, 203)=15 + KINDEX(1, 203)=16 KINDEX(2, 203)=66 - KINDEX(1, 204)=30 + KINDEX(1, 204)=31 KINDEX(2, 204)=66 - KINDEX(1, 205)=14 + KINDEX(1, 205)=15 KINDEX(2, 205)=67 - KINDEX(1, 206)=31 + KINDEX(1, 206)=32 KINDEX(2, 206)=67 - KINDEX(1, 207)=14 + KINDEX(1, 207)=15 KINDEX(2, 207)=68 - KINDEX(1, 208)=22 + KINDEX(1, 208)=23 KINDEX(2, 208)=68 - KINDEX(1, 209)=28 + KINDEX(1, 209)=29 KINDEX(2, 209)=68 - KINDEX(1, 210)=32 + KINDEX(1, 210)=33 KINDEX(2, 210)=68 - KINDEX(1, 211)=14 + KINDEX(1, 211)=15 KINDEX(2, 211)=69 - KINDEX(1, 212)=15 + KINDEX(1, 212)=16 KINDEX(2, 212)=69 - KINDEX(1, 213)=22 + KINDEX(1, 213)=23 KINDEX(2, 213)=69 - KINDEX(1, 214)=23 + KINDEX(1, 214)=24 KINDEX(2, 214)=69 - KINDEX(1, 215)=24 + KINDEX(1, 215)=25 KINDEX(2, 215)=69 - KINDEX(1, 216)=29 + KINDEX(1, 216)=30 KINDEX(2, 216)=69 - KINDEX(1, 217)=33 + KINDEX(1, 217)=34 KINDEX(2, 217)=69 - KINDEX(1, 218)=39 + KINDEX(1, 218)=40 KINDEX(2, 218)=69 - KINDEX(1, 219)=41 + KINDEX(1, 219)=42 KINDEX(2, 219)=69 KINDEX(1, 220)=5 KINDEX(2, 220)=70 - KINDEX(1, 221)=14 + KINDEX(1, 221)=15 KINDEX(2, 221)=70 - KINDEX(1, 222)=15 + KINDEX(1, 222)=16 KINDEX(2, 222)=70 - KINDEX(1, 223)=22 + KINDEX(1, 223)=23 KINDEX(2, 223)=70 - KINDEX(1, 224)=25 + KINDEX(1, 224)=26 KINDEX(2, 224)=70 - KINDEX(1, 225)=27 + KINDEX(1, 225)=28 KINDEX(2, 225)=70 - KINDEX(1, 226)=41 + KINDEX(1, 226)=42 KINDEX(2, 226)=70 KINDEX(1, 227)=4 KINDEX(2, 227)=71 - KINDEX(1, 228)=14 + KINDEX(1, 228)=15 KINDEX(2, 228)=71 - KINDEX(1, 229)=26 + KINDEX(1, 229)=27 KINDEX(2, 229)=71 - KINDEX(1, 230)=33 + KINDEX(1, 230)=34 KINDEX(2, 230)=71 KINDEX(1, 231)=5 KINDEX(2, 231)=72 KINDEX(1, 232)=8 KINDEX(2, 232)=72 - KINDEX(1, 233)=13 + KINDEX(1, 233)=14 KINDEX(2, 233)=72 - KINDEX(1, 234)=15 + KINDEX(1, 234)=16 KINDEX(2, 234)=72 - KINDEX(1, 235)=22 + KINDEX(1, 235)=23 KINDEX(2, 235)=72 KINDEX(1, 236)=5 KINDEX(2, 236)=73 KINDEX(1, 237)=8 KINDEX(2, 237)=73 - KINDEX(1, 238)=23 + KINDEX(1, 238)=24 KINDEX(2, 238)=73 - KINDEX(1, 239)=39 + KINDEX(1, 239)=40 KINDEX(2, 239)=73 KINDEX(1, 240)=4 KINDEX(2, 240)=74 @@ -37804,734 +38489,752 @@ END IF KINDEX(2, 241)=74 KINDEX(1, 242)=8 KINDEX(2, 242)=74 - KINDEX(1, 243)=13 + KINDEX(1, 243)=14 KINDEX(2, 243)=74 - KINDEX(1, 244)=15 + KINDEX(1, 244)=16 KINDEX(2, 244)=74 - KINDEX(1, 245)=23 + KINDEX(1, 245)=24 KINDEX(2, 245)=74 - KINDEX(1, 246)=24 + KINDEX(1, 246)=25 KINDEX(2, 246)=74 - KINDEX(1, 247)=25 + KINDEX(1, 247)=26 KINDEX(2, 247)=74 - KINDEX(1, 248)=39 + KINDEX(1, 248)=40 KINDEX(2, 248)=74 - KINDEX(1, 249)=40 + KINDEX(1, 249)=41 KINDEX(2, 249)=74 - KINDEX(1, 250)=41 + KINDEX(1, 250)=42 KINDEX(2, 250)=74 KINDEX(1, 251)=5 KINDEX(2, 251)=75 KINDEX(1, 252)=8 KINDEX(2, 252)=75 - KINDEX(1, 253)=21 + KINDEX(1, 253)=22 KINDEX(2, 253)=75 - KINDEX(1, 254)=36 + KINDEX(1, 254)=37 KINDEX(2, 254)=75 KINDEX(1, 255)=5 KINDEX(2, 255)=76 - KINDEX(1, 256)=19 + KINDEX(1, 256)=20 KINDEX(2, 256)=76 - KINDEX(1, 257)=25 + KINDEX(1, 257)=26 KINDEX(2, 257)=76 - KINDEX(1, 258)=40 + KINDEX(1, 258)=41 KINDEX(2, 258)=76 KINDEX(1, 259)=5 KINDEX(2, 259)=77 - KINDEX(1, 260)=20 + KINDEX(1, 260)=21 KINDEX(2, 260)=77 - KINDEX(1, 261)=25 + KINDEX(1, 261)=26 KINDEX(2, 261)=77 - KINDEX(1, 262)=40 + KINDEX(1, 262)=41 KINDEX(2, 262)=77 KINDEX(1, 263)=4 KINDEX(2, 263)=78 KINDEX(1, 264)=5 KINDEX(2, 264)=78 - KINDEX(1, 265)=22 + KINDEX(1, 265)=23 KINDEX(2, 265)=78 - KINDEX(1, 266)=26 + KINDEX(1, 266)=27 KINDEX(2, 266)=78 - KINDEX(1, 267)=27 + KINDEX(1, 267)=28 KINDEX(2, 267)=78 - KINDEX(1, 268)=41 + KINDEX(1, 268)=42 KINDEX(2, 268)=78 KINDEX(1, 269)=1 KINDEX(2, 269)=79 KINDEX(1, 270)=2 KINDEX(2, 270)=79 - KINDEX(1, 271)=13 + KINDEX(1, 271)=14 KINDEX(2, 271)=79 - KINDEX(1, 272)=14 + KINDEX(1, 272)=15 KINDEX(2, 272)=79 - KINDEX(1, 273)=15 + KINDEX(1, 273)=16 KINDEX(2, 273)=79 - KINDEX(1, 274)=16 + KINDEX(1, 274)=17 KINDEX(2, 274)=79 - KINDEX(1, 275)=17 + KINDEX(1, 275)=18 KINDEX(2, 275)=79 - KINDEX(1, 276)=19 + KINDEX(1, 276)=20 KINDEX(2, 276)=79 - KINDEX(1, 277)=22 + KINDEX(1, 277)=23 KINDEX(2, 277)=79 - KINDEX(1, 278)=23 + KINDEX(1, 278)=24 KINDEX(2, 278)=79 - KINDEX(1, 279)=24 + KINDEX(1, 279)=25 KINDEX(2, 279)=79 - KINDEX(1, 280)=25 + KINDEX(1, 280)=26 KINDEX(2, 280)=79 - KINDEX(1, 281)=30 + KINDEX(1, 281)=31 KINDEX(2, 281)=79 - KINDEX(1, 282)=31 + KINDEX(1, 282)=32 KINDEX(2, 282)=79 - KINDEX(1, 283)=32 + KINDEX(1, 283)=33 KINDEX(2, 283)=79 - KINDEX(1, 284)=33 + KINDEX(1, 284)=34 KINDEX(2, 284)=79 - KINDEX(1, 285)=39 + KINDEX(1, 285)=40 KINDEX(2, 285)=79 - KINDEX(1, 286)=41 + KINDEX(1, 286)=42 KINDEX(2, 286)=79 KINDEX(1, 287)=1 KINDEX(2, 287)=80 KINDEX(1, 288)=2 KINDEX(2, 288)=80 - KINDEX(1, 289)=13 + KINDEX(1, 289)=14 KINDEX(2, 289)=80 - KINDEX(1, 290)=14 + KINDEX(1, 290)=15 KINDEX(2, 290)=80 - KINDEX(1, 291)=15 + KINDEX(1, 291)=16 KINDEX(2, 291)=80 - KINDEX(1, 292)=19 + KINDEX(1, 292)=20 KINDEX(2, 292)=80 - KINDEX(1, 293)=20 + KINDEX(1, 293)=21 KINDEX(2, 293)=80 - KINDEX(1, 294)=22 + KINDEX(1, 294)=23 KINDEX(2, 294)=80 - KINDEX(1, 295)=23 + KINDEX(1, 295)=24 KINDEX(2, 295)=80 - KINDEX(1, 296)=24 + KINDEX(1, 296)=25 KINDEX(2, 296)=80 - KINDEX(1, 297)=25 + KINDEX(1, 297)=26 KINDEX(2, 297)=80 - KINDEX(1, 298)=30 + KINDEX(1, 298)=31 KINDEX(2, 298)=80 - KINDEX(1, 299)=31 + KINDEX(1, 299)=32 KINDEX(2, 299)=80 - KINDEX(1, 300)=32 + KINDEX(1, 300)=33 KINDEX(2, 300)=80 - KINDEX(1, 301)=33 + KINDEX(1, 301)=34 KINDEX(2, 301)=80 - KINDEX(1, 302)=39 + KINDEX(1, 302)=40 KINDEX(2, 302)=80 - KINDEX(1, 303)=41 + KINDEX(1, 303)=42 KINDEX(2, 303)=80 KINDEX(1, 304)=1 KINDEX(2, 304)=81 - KINDEX(1, 305)=13 + KINDEX(1, 305)=14 KINDEX(2, 305)=81 - KINDEX(1, 306)=14 + KINDEX(1, 306)=15 KINDEX(2, 306)=81 - KINDEX(1, 307)=15 + KINDEX(1, 307)=16 KINDEX(2, 307)=81 - KINDEX(1, 308)=22 + KINDEX(1, 308)=23 KINDEX(2, 308)=81 - KINDEX(1, 309)=23 + KINDEX(1, 309)=24 KINDEX(2, 309)=81 - KINDEX(1, 310)=25 + KINDEX(1, 310)=26 KINDEX(2, 310)=81 - KINDEX(1, 311)=29 + KINDEX(1, 311)=30 KINDEX(2, 311)=81 - KINDEX(1, 312)=30 + KINDEX(1, 312)=31 KINDEX(2, 312)=81 - KINDEX(1, 313)=31 + KINDEX(1, 313)=32 KINDEX(2, 313)=81 - KINDEX(1, 314)=39 + KINDEX(1, 314)=40 KINDEX(2, 314)=81 KINDEX(1, 315)=1 KINDEX(2, 315)=82 KINDEX(1, 316)=4 KINDEX(2, 316)=82 - KINDEX(1, 317)=13 + KINDEX(1, 317)=14 KINDEX(2, 317)=82 - KINDEX(1, 318)=14 + KINDEX(1, 318)=15 KINDEX(2, 318)=82 - KINDEX(1, 319)=15 + KINDEX(1, 319)=16 KINDEX(2, 319)=82 - KINDEX(1, 320)=22 + KINDEX(1, 320)=23 KINDEX(2, 320)=82 - KINDEX(1, 321)=27 + KINDEX(1, 321)=28 KINDEX(2, 321)=82 - KINDEX(1, 322)=30 + KINDEX(1, 322)=31 KINDEX(2, 322)=82 - KINDEX(1, 323)=39 + KINDEX(1, 323)=40 KINDEX(2, 323)=82 KINDEX(1, 324)=4 KINDEX(2, 324)=83 - KINDEX(1, 325)=21 + KINDEX(1, 325)=22 KINDEX(2, 325)=83 - KINDEX(1, 326)=26 + KINDEX(1, 326)=27 KINDEX(2, 326)=83 - KINDEX(1, 327)=36 + KINDEX(1, 327)=37 KINDEX(2, 327)=83 - KINDEX(1, 328)=15 + KINDEX(1, 328)=16 KINDEX(2, 328)=84 - KINDEX(1, 329)=21 + KINDEX(1, 329)=22 KINDEX(2, 329)=84 - KINDEX(1, 330)=36 + KINDEX(1, 330)=37 KINDEX(2, 330)=84 KINDEX(1, 331)=4 KINDEX(2, 331)=85 KINDEX(1, 332)=7 KINDEX(2, 332)=85 - KINDEX(1, 333)=21 + KINDEX(1, 333)=22 KINDEX(2, 333)=85 - KINDEX(1, 334)=37 + KINDEX(1, 334)=38 KINDEX(2, 334)=85 - KINDEX(1, 335)=15 + KINDEX(1, 335)=16 KINDEX(2, 335)=86 - KINDEX(1, 336)=21 + KINDEX(1, 336)=22 KINDEX(2, 336)=86 - KINDEX(1, 337)=37 + KINDEX(1, 337)=38 KINDEX(2, 337)=86 - KINDEX(1, 338)=38 + KINDEX(1, 338)=39 KINDEX(2, 338)=86 KINDEX(1, 339)=1 KINDEX(2, 339)=87 - KINDEX(1, 340)=14 + KINDEX(1, 340)=15 KINDEX(2, 340)=87 - KINDEX(1, 341)=21 + KINDEX(1, 341)=22 KINDEX(2, 341)=87 - KINDEX(1, 342)=37 + KINDEX(1, 342)=38 KINDEX(2, 342)=87 KINDEX(1, 343)=4 KINDEX(2, 343)=88 - KINDEX(1, 344)=27 + KINDEX(1, 344)=28 KINDEX(2, 344)=88 - KINDEX(1, 345)=39 + KINDEX(1, 345)=40 KINDEX(2, 345)=88 KINDEX(1, 346)=4 KINDEX(2, 346)=89 - KINDEX(1, 347)=27 + KINDEX(1, 347)=28 KINDEX(2, 347)=89 - KINDEX(1, 348)=39 + KINDEX(1, 348)=40 KINDEX(2, 348)=89 KINDEX(1, 349)=3 KINDEX(2, 349)=90 KINDEX(1, 350)=4 KINDEX(2, 350)=90 - KINDEX(1, 351)=15 + KINDEX(1, 351)=16 KINDEX(2, 351)=90 - KINDEX(1, 352)=22 + KINDEX(1, 352)=23 KINDEX(2, 352)=90 - KINDEX(1, 353)=32 + KINDEX(1, 353)=33 KINDEX(2, 353)=90 KINDEX(1, 354)=3 KINDEX(2, 354)=91 KINDEX(1, 355)=4 KINDEX(2, 355)=91 - KINDEX(1, 356)=15 + KINDEX(1, 356)=16 KINDEX(2, 356)=91 - KINDEX(1, 357)=22 + KINDEX(1, 357)=23 KINDEX(2, 357)=91 - KINDEX(1, 358)=23 + KINDEX(1, 358)=24 KINDEX(2, 358)=91 - KINDEX(1, 359)=24 + KINDEX(1, 359)=25 KINDEX(2, 359)=91 - KINDEX(1, 360)=25 + KINDEX(1, 360)=26 KINDEX(2, 360)=91 - KINDEX(1, 361)=26 + KINDEX(1, 361)=27 KINDEX(2, 361)=91 - KINDEX(1, 362)=32 + KINDEX(1, 362)=33 KINDEX(2, 362)=91 - KINDEX(1, 363)=33 + KINDEX(1, 363)=34 KINDEX(2, 363)=91 - KINDEX(1, 364)=41 + KINDEX(1, 364)=42 KINDEX(2, 364)=91 KINDEX(1, 365)=3 KINDEX(2, 365)=92 KINDEX(1, 366)=4 KINDEX(2, 366)=92 - KINDEX(1, 367)=15 + KINDEX(1, 367)=16 KINDEX(2, 367)=92 - KINDEX(1, 368)=22 + KINDEX(1, 368)=23 KINDEX(2, 368)=92 - KINDEX(1, 369)=23 + KINDEX(1, 369)=24 KINDEX(2, 369)=92 - KINDEX(1, 370)=24 + KINDEX(1, 370)=25 KINDEX(2, 370)=92 - KINDEX(1, 371)=34 + KINDEX(1, 371)=35 KINDEX(2, 371)=92 KINDEX(1, 372)=3 KINDEX(2, 372)=93 KINDEX(1, 373)=4 KINDEX(2, 373)=93 - KINDEX(1, 374)=15 + KINDEX(1, 374)=16 KINDEX(2, 374)=93 - KINDEX(1, 375)=19 + KINDEX(1, 375)=20 KINDEX(2, 375)=93 - KINDEX(1, 376)=22 + KINDEX(1, 376)=23 KINDEX(2, 376)=93 - KINDEX(1, 377)=23 + KINDEX(1, 377)=24 KINDEX(2, 377)=93 - KINDEX(1, 378)=24 + KINDEX(1, 378)=25 KINDEX(2, 378)=93 - KINDEX(1, 379)=25 + KINDEX(1, 379)=26 KINDEX(2, 379)=93 - KINDEX(1, 380)=26 + KINDEX(1, 380)=27 KINDEX(2, 380)=93 - KINDEX(1, 381)=35 + KINDEX(1, 381)=36 KINDEX(2, 381)=93 KINDEX(1, 382)=3 KINDEX(2, 382)=94 KINDEX(1, 383)=4 KINDEX(2, 383)=94 - KINDEX(1, 384)=15 + KINDEX(1, 384)=16 KINDEX(2, 384)=94 - KINDEX(1, 385)=25 + KINDEX(1, 385)=26 KINDEX(2, 385)=94 - KINDEX(1, 386)=26 + KINDEX(1, 386)=27 KINDEX(2, 386)=94 - KINDEX(1, 387)=38 + KINDEX(1, 387)=39 KINDEX(2, 387)=94 KINDEX(1, 388)=3 KINDEX(2, 388)=95 KINDEX(1, 389)=4 KINDEX(2, 389)=95 - KINDEX(1, 390)=15 + KINDEX(1, 390)=16 KINDEX(2, 390)=95 - KINDEX(1, 391)=22 + KINDEX(1, 391)=23 KINDEX(2, 391)=95 - KINDEX(1, 392)=23 + KINDEX(1, 392)=24 KINDEX(2, 392)=95 - KINDEX(1, 393)=25 + KINDEX(1, 393)=26 KINDEX(2, 393)=95 - KINDEX(1, 394)=32 + KINDEX(1, 394)=33 KINDEX(2, 394)=95 - KINDEX(1, 395)=39 + KINDEX(1, 395)=40 KINDEX(2, 395)=95 - KINDEX(1, 396)=41 + KINDEX(1, 396)=42 KINDEX(2, 396)=95 KINDEX(1, 397)=3 KINDEX(2, 397)=96 KINDEX(1, 398)=4 KINDEX(2, 398)=96 - KINDEX(1, 399)=15 + KINDEX(1, 399)=16 KINDEX(2, 399)=96 - KINDEX(1, 400)=22 + KINDEX(1, 400)=23 KINDEX(2, 400)=96 - KINDEX(1, 401)=23 + KINDEX(1, 401)=24 KINDEX(2, 401)=96 - KINDEX(1, 402)=24 + KINDEX(1, 402)=25 KINDEX(2, 402)=96 - KINDEX(1, 403)=26 + KINDEX(1, 403)=27 KINDEX(2, 403)=96 - KINDEX(1, 404)=40 + KINDEX(1, 404)=41 KINDEX(2, 404)=96 - KINDEX(1, 405)=15 + KINDEX(1, 405)=16 KINDEX(2, 405)=97 - KINDEX(1, 406)=28 + KINDEX(1, 406)=29 KINDEX(2, 406)=97 - KINDEX(1, 407)=32 + KINDEX(1, 407)=33 KINDEX(2, 407)=97 - KINDEX(1, 408)=15 + KINDEX(1, 408)=16 KINDEX(2, 408)=98 - KINDEX(1, 409)=29 + KINDEX(1, 409)=30 KINDEX(2, 409)=98 - KINDEX(1, 410)=33 + KINDEX(1, 410)=34 KINDEX(2, 410)=98 - KINDEX(1, 411)=15 + KINDEX(1, 411)=16 KINDEX(2, 411)=99 - KINDEX(1, 412)=29 + KINDEX(1, 412)=30 KINDEX(2, 412)=99 - KINDEX(1, 413)=34 + KINDEX(1, 413)=35 KINDEX(2, 413)=99 - KINDEX(1, 414)=15 + KINDEX(1, 414)=16 KINDEX(2, 414)=100 - KINDEX(1, 415)=29 + KINDEX(1, 415)=30 KINDEX(2, 415)=100 - KINDEX(1, 416)=35 + KINDEX(1, 416)=36 KINDEX(2, 416)=100 - KINDEX(1, 417)=15 + KINDEX(1, 417)=16 KINDEX(2, 417)=101 - KINDEX(1, 418)=29 + KINDEX(1, 418)=30 KINDEX(2, 418)=101 - KINDEX(1, 419)=38 + KINDEX(1, 419)=39 KINDEX(2, 419)=101 KINDEX(1, 420)=1 KINDEX(2, 420)=102 - KINDEX(1, 421)=15 + KINDEX(1, 421)=16 KINDEX(2, 421)=102 - KINDEX(1, 422)=29 + KINDEX(1, 422)=30 KINDEX(2, 422)=102 - KINDEX(1, 423)=31 + KINDEX(1, 423)=32 KINDEX(2, 423)=102 - KINDEX(1, 424)=39 + KINDEX(1, 424)=40 KINDEX(2, 424)=102 - KINDEX(1, 425)=15 + KINDEX(1, 425)=16 KINDEX(2, 425)=103 - KINDEX(1, 426)=26 + KINDEX(1, 426)=27 KINDEX(2, 426)=103 - KINDEX(1, 427)=40 + KINDEX(1, 427)=41 KINDEX(2, 427)=103 - KINDEX(1, 428)=15 + KINDEX(1, 428)=16 KINDEX(2, 428)=104 - KINDEX(1, 429)=22 + KINDEX(1, 429)=23 KINDEX(2, 429)=104 - KINDEX(1, 430)=32 + KINDEX(1, 430)=33 KINDEX(2, 430)=104 - KINDEX(1, 431)=15 + KINDEX(1, 431)=16 KINDEX(2, 431)=105 - KINDEX(1, 432)=22 + KINDEX(1, 432)=23 KINDEX(2, 432)=105 - KINDEX(1, 433)=23 + KINDEX(1, 433)=24 KINDEX(2, 433)=105 - KINDEX(1, 434)=24 + KINDEX(1, 434)=25 KINDEX(2, 434)=105 - KINDEX(1, 435)=25 + KINDEX(1, 435)=26 KINDEX(2, 435)=105 - KINDEX(1, 436)=32 + KINDEX(1, 436)=33 KINDEX(2, 436)=105 - KINDEX(1, 437)=33 + KINDEX(1, 437)=34 KINDEX(2, 437)=105 - KINDEX(1, 438)=41 + KINDEX(1, 438)=42 KINDEX(2, 438)=105 - KINDEX(1, 439)=15 + KINDEX(1, 439)=16 KINDEX(2, 439)=106 - KINDEX(1, 440)=22 + KINDEX(1, 440)=23 KINDEX(2, 440)=106 - KINDEX(1, 441)=23 + KINDEX(1, 441)=24 KINDEX(2, 441)=106 - KINDEX(1, 442)=24 + KINDEX(1, 442)=25 KINDEX(2, 442)=106 - KINDEX(1, 443)=32 + KINDEX(1, 443)=33 KINDEX(2, 443)=106 - KINDEX(1, 444)=34 + KINDEX(1, 444)=35 KINDEX(2, 444)=106 - KINDEX(1, 445)=15 + KINDEX(1, 445)=16 KINDEX(2, 445)=107 - KINDEX(1, 446)=19 + KINDEX(1, 446)=20 KINDEX(2, 446)=107 - KINDEX(1, 447)=22 + KINDEX(1, 447)=23 KINDEX(2, 447)=107 - KINDEX(1, 448)=23 + KINDEX(1, 448)=24 KINDEX(2, 448)=107 - KINDEX(1, 449)=24 + KINDEX(1, 449)=25 KINDEX(2, 449)=107 - KINDEX(1, 450)=25 + KINDEX(1, 450)=26 KINDEX(2, 450)=107 - KINDEX(1, 451)=32 + KINDEX(1, 451)=33 KINDEX(2, 451)=107 - KINDEX(1, 452)=35 + KINDEX(1, 452)=36 KINDEX(2, 452)=107 - KINDEX(1, 453)=15 + KINDEX(1, 453)=16 KINDEX(2, 453)=108 - KINDEX(1, 454)=22 + KINDEX(1, 454)=23 KINDEX(2, 454)=108 - KINDEX(1, 455)=25 + KINDEX(1, 455)=26 KINDEX(2, 455)=108 - KINDEX(1, 456)=32 + KINDEX(1, 456)=33 KINDEX(2, 456)=108 - KINDEX(1, 457)=38 + KINDEX(1, 457)=39 KINDEX(2, 457)=108 - KINDEX(1, 458)=15 + KINDEX(1, 458)=16 KINDEX(2, 458)=109 - KINDEX(1, 459)=22 + KINDEX(1, 459)=23 KINDEX(2, 459)=109 - KINDEX(1, 460)=23 + KINDEX(1, 460)=24 KINDEX(2, 460)=109 - KINDEX(1, 461)=25 + KINDEX(1, 461)=26 KINDEX(2, 461)=109 - KINDEX(1, 462)=31 + KINDEX(1, 462)=32 KINDEX(2, 462)=109 - KINDEX(1, 463)=32 + KINDEX(1, 463)=33 KINDEX(2, 463)=109 - KINDEX(1, 464)=39 + KINDEX(1, 464)=40 KINDEX(2, 464)=109 - KINDEX(1, 465)=41 + KINDEX(1, 465)=42 KINDEX(2, 465)=109 KINDEX(1, 466)=4 KINDEX(2, 466)=110 - KINDEX(1, 467)=15 + KINDEX(1, 467)=16 KINDEX(2, 467)=110 - KINDEX(1, 468)=22 + KINDEX(1, 468)=23 KINDEX(2, 468)=110 - KINDEX(1, 469)=23 + KINDEX(1, 469)=24 KINDEX(2, 469)=110 - KINDEX(1, 470)=24 + KINDEX(1, 470)=25 KINDEX(2, 470)=110 - KINDEX(1, 471)=26 + KINDEX(1, 471)=27 KINDEX(2, 471)=110 - KINDEX(1, 472)=32 + KINDEX(1, 472)=33 KINDEX(2, 472)=110 - KINDEX(1, 473)=40 + KINDEX(1, 473)=41 KINDEX(2, 473)=110 - KINDEX(1, 474)=15 + KINDEX(1, 474)=16 KINDEX(2, 474)=111 - KINDEX(1, 475)=22 + KINDEX(1, 475)=23 KINDEX(2, 475)=111 - KINDEX(1, 476)=23 + KINDEX(1, 476)=24 KINDEX(2, 476)=111 - KINDEX(1, 477)=24 + KINDEX(1, 477)=25 KINDEX(2, 477)=111 - KINDEX(1, 478)=25 + KINDEX(1, 478)=26 KINDEX(2, 478)=111 - KINDEX(1, 479)=31 + KINDEX(1, 479)=32 KINDEX(2, 479)=111 - KINDEX(1, 480)=32 + KINDEX(1, 480)=33 KINDEX(2, 480)=111 - KINDEX(1, 481)=33 + KINDEX(1, 481)=34 KINDEX(2, 481)=111 - KINDEX(1, 482)=39 + KINDEX(1, 482)=40 KINDEX(2, 482)=111 - KINDEX(1, 483)=41 + KINDEX(1, 483)=42 KINDEX(2, 483)=111 - KINDEX(1, 484)=15 + KINDEX(1, 484)=16 KINDEX(2, 484)=112 - KINDEX(1, 485)=22 + KINDEX(1, 485)=23 KINDEX(2, 485)=112 - KINDEX(1, 486)=23 + KINDEX(1, 486)=24 KINDEX(2, 486)=112 - KINDEX(1, 487)=24 + KINDEX(1, 487)=25 KINDEX(2, 487)=112 - KINDEX(1, 488)=31 + KINDEX(1, 488)=32 KINDEX(2, 488)=112 - KINDEX(1, 489)=32 + KINDEX(1, 489)=33 KINDEX(2, 489)=112 - KINDEX(1, 490)=34 + KINDEX(1, 490)=35 KINDEX(2, 490)=112 - KINDEX(1, 491)=39 + KINDEX(1, 491)=40 KINDEX(2, 491)=112 - KINDEX(1, 492)=15 + KINDEX(1, 492)=16 KINDEX(2, 492)=113 - KINDEX(1, 493)=19 + KINDEX(1, 493)=20 KINDEX(2, 493)=113 - KINDEX(1, 494)=22 + KINDEX(1, 494)=23 KINDEX(2, 494)=113 - KINDEX(1, 495)=23 + KINDEX(1, 495)=24 KINDEX(2, 495)=113 - KINDEX(1, 496)=24 + KINDEX(1, 496)=25 KINDEX(2, 496)=113 - KINDEX(1, 497)=25 + KINDEX(1, 497)=26 KINDEX(2, 497)=113 - KINDEX(1, 498)=31 + KINDEX(1, 498)=32 KINDEX(2, 498)=113 - KINDEX(1, 499)=32 + KINDEX(1, 499)=33 KINDEX(2, 499)=113 - KINDEX(1, 500)=35 + KINDEX(1, 500)=36 KINDEX(2, 500)=113 - KINDEX(1, 501)=39 + KINDEX(1, 501)=40 KINDEX(2, 501)=113 - KINDEX(1, 502)=15 + KINDEX(1, 502)=16 KINDEX(2, 502)=114 - KINDEX(1, 503)=25 + KINDEX(1, 503)=26 KINDEX(2, 503)=114 - KINDEX(1, 504)=32 + KINDEX(1, 504)=33 KINDEX(2, 504)=114 - KINDEX(1, 505)=38 + KINDEX(1, 505)=39 KINDEX(2, 505)=114 - KINDEX(1, 506)=39 + KINDEX(1, 506)=40 KINDEX(2, 506)=114 - KINDEX(1, 507)=15 + KINDEX(1, 507)=16 KINDEX(2, 507)=115 - KINDEX(1, 508)=22 + KINDEX(1, 508)=23 KINDEX(2, 508)=115 - KINDEX(1, 509)=23 + KINDEX(1, 509)=24 KINDEX(2, 509)=115 - KINDEX(1, 510)=24 + KINDEX(1, 510)=25 KINDEX(2, 510)=115 - KINDEX(1, 511)=25 + KINDEX(1, 511)=26 KINDEX(2, 511)=115 - KINDEX(1, 512)=31 + KINDEX(1, 512)=32 KINDEX(2, 512)=115 - KINDEX(1, 513)=32 + KINDEX(1, 513)=33 KINDEX(2, 513)=115 - KINDEX(1, 514)=39 + KINDEX(1, 514)=40 KINDEX(2, 514)=115 - KINDEX(1, 515)=41 + KINDEX(1, 515)=42 KINDEX(2, 515)=115 KINDEX(1, 516)=4 KINDEX(2, 516)=116 - KINDEX(1, 517)=15 + KINDEX(1, 517)=16 KINDEX(2, 517)=116 - KINDEX(1, 518)=22 + KINDEX(1, 518)=23 KINDEX(2, 518)=116 - KINDEX(1, 519)=23 + KINDEX(1, 519)=24 KINDEX(2, 519)=116 - KINDEX(1, 520)=24 + KINDEX(1, 520)=25 KINDEX(2, 520)=116 - KINDEX(1, 521)=26 + KINDEX(1, 521)=27 KINDEX(2, 521)=116 - KINDEX(1, 522)=31 + KINDEX(1, 522)=32 KINDEX(2, 522)=116 - KINDEX(1, 523)=32 + KINDEX(1, 523)=33 KINDEX(2, 523)=116 - KINDEX(1, 524)=39 + KINDEX(1, 524)=40 KINDEX(2, 524)=116 - KINDEX(1, 525)=40 + KINDEX(1, 525)=41 KINDEX(2, 525)=116 - KINDEX(1, 526)=15 + KINDEX(1, 526)=16 KINDEX(2, 526)=117 - KINDEX(1, 527)=26 + KINDEX(1, 527)=27 KINDEX(2, 527)=117 - KINDEX(1, 528)=40 + KINDEX(1, 528)=41 KINDEX(2, 528)=117 KINDEX(1, 529)=4 KINDEX(2, 529)=118 - KINDEX(1, 530)=15 + KINDEX(1, 530)=16 KINDEX(2, 530)=118 - KINDEX(1, 531)=22 + KINDEX(1, 531)=23 KINDEX(2, 531)=118 - KINDEX(1, 532)=23 + KINDEX(1, 532)=24 KINDEX(2, 532)=118 - KINDEX(1, 533)=24 + KINDEX(1, 533)=25 KINDEX(2, 533)=118 - KINDEX(1, 534)=26 + KINDEX(1, 534)=27 KINDEX(2, 534)=118 - KINDEX(1, 535)=40 + KINDEX(1, 535)=41 KINDEX(2, 535)=118 KINDEX(1, 536)=4 KINDEX(2, 536)=119 KINDEX(1, 537)=5 KINDEX(2, 537)=119 - KINDEX(1, 538)=15 + KINDEX(1, 538)=16 KINDEX(2, 538)=119 - KINDEX(1, 539)=22 + KINDEX(1, 539)=23 KINDEX(2, 539)=119 - KINDEX(1, 540)=32 + KINDEX(1, 540)=33 KINDEX(2, 540)=119 KINDEX(1, 541)=4 KINDEX(2, 541)=120 KINDEX(1, 542)=5 KINDEX(2, 542)=120 - KINDEX(1, 543)=15 + KINDEX(1, 543)=16 KINDEX(2, 543)=120 - KINDEX(1, 544)=22 + KINDEX(1, 544)=23 KINDEX(2, 544)=120 - KINDEX(1, 545)=23 + KINDEX(1, 545)=24 KINDEX(2, 545)=120 - KINDEX(1, 546)=24 + KINDEX(1, 546)=25 KINDEX(2, 546)=120 - KINDEX(1, 547)=25 + KINDEX(1, 547)=26 KINDEX(2, 547)=120 - KINDEX(1, 548)=32 + KINDEX(1, 548)=33 KINDEX(2, 548)=120 - KINDEX(1, 549)=33 + KINDEX(1, 549)=34 KINDEX(2, 549)=120 - KINDEX(1, 550)=41 + KINDEX(1, 550)=42 KINDEX(2, 550)=120 KINDEX(1, 551)=4 KINDEX(2, 551)=121 KINDEX(1, 552)=5 KINDEX(2, 552)=121 - KINDEX(1, 553)=15 + KINDEX(1, 553)=16 KINDEX(2, 553)=121 - KINDEX(1, 554)=22 + KINDEX(1, 554)=23 KINDEX(2, 554)=121 - KINDEX(1, 555)=23 + KINDEX(1, 555)=24 KINDEX(2, 555)=121 - KINDEX(1, 556)=24 + KINDEX(1, 556)=25 KINDEX(2, 556)=121 - KINDEX(1, 557)=34 + KINDEX(1, 557)=35 KINDEX(2, 557)=121 KINDEX(1, 558)=4 KINDEX(2, 558)=122 KINDEX(1, 559)=5 KINDEX(2, 559)=122 - KINDEX(1, 560)=15 + KINDEX(1, 560)=16 KINDEX(2, 560)=122 - KINDEX(1, 561)=19 + KINDEX(1, 561)=20 KINDEX(2, 561)=122 - KINDEX(1, 562)=22 + KINDEX(1, 562)=23 KINDEX(2, 562)=122 - KINDEX(1, 563)=23 + KINDEX(1, 563)=24 KINDEX(2, 563)=122 - KINDEX(1, 564)=24 + KINDEX(1, 564)=25 KINDEX(2, 564)=122 - KINDEX(1, 565)=25 + KINDEX(1, 565)=26 KINDEX(2, 565)=122 - KINDEX(1, 566)=35 + KINDEX(1, 566)=36 KINDEX(2, 566)=122 KINDEX(1, 567)=4 KINDEX(2, 567)=123 KINDEX(1, 568)=5 KINDEX(2, 568)=123 - KINDEX(1, 569)=15 + KINDEX(1, 569)=16 KINDEX(2, 569)=123 - KINDEX(1, 570)=25 + KINDEX(1, 570)=26 KINDEX(2, 570)=123 - KINDEX(1, 571)=38 + KINDEX(1, 571)=39 KINDEX(2, 571)=123 KINDEX(1, 572)=4 KINDEX(2, 572)=124 KINDEX(1, 573)=5 KINDEX(2, 573)=124 - KINDEX(1, 574)=15 + KINDEX(1, 574)=16 KINDEX(2, 574)=124 - KINDEX(1, 575)=22 + KINDEX(1, 575)=23 KINDEX(2, 575)=124 - KINDEX(1, 576)=23 + KINDEX(1, 576)=24 KINDEX(2, 576)=124 - KINDEX(1, 577)=25 + KINDEX(1, 577)=26 KINDEX(2, 577)=124 - KINDEX(1, 578)=32 + KINDEX(1, 578)=33 KINDEX(2, 578)=124 - KINDEX(1, 579)=39 + KINDEX(1, 579)=40 KINDEX(2, 579)=124 - KINDEX(1, 580)=41 + KINDEX(1, 580)=42 KINDEX(2, 580)=124 KINDEX(1, 581)=4 KINDEX(2, 581)=125 KINDEX(1, 582)=5 KINDEX(2, 582)=125 - KINDEX(1, 583)=15 + KINDEX(1, 583)=16 KINDEX(2, 583)=125 - KINDEX(1, 584)=22 + KINDEX(1, 584)=23 KINDEX(2, 584)=125 - KINDEX(1, 585)=23 + KINDEX(1, 585)=24 KINDEX(2, 585)=125 - KINDEX(1, 586)=24 + KINDEX(1, 586)=25 KINDEX(2, 586)=125 - KINDEX(1, 587)=26 + KINDEX(1, 587)=27 KINDEX(2, 587)=125 - KINDEX(1, 588)=40 + KINDEX(1, 588)=41 KINDEX(2, 588)=125 - KINDEX(1, 589)=15 + KINDEX(1, 589)=16 KINDEX(2, 589)=126 - KINDEX(1, 590)=29 + KINDEX(1, 590)=30 KINDEX(2, 590)=126 - KINDEX(1, 591)=41 + KINDEX(1, 591)=42 KINDEX(2, 591)=126 - KINDEX(1, 592)=15 + KINDEX(1, 592)=16 KINDEX(2, 592)=127 - KINDEX(1, 593)=22 + KINDEX(1, 593)=23 KINDEX(2, 593)=127 - KINDEX(1, 594)=32 + KINDEX(1, 594)=33 KINDEX(2, 594)=127 - KINDEX(1, 595)=41 + KINDEX(1, 595)=42 KINDEX(2, 595)=127 - KINDEX(1, 596)=32 + KINDEX(1, 596)=33 KINDEX(2, 596)=128 - KINDEX(1, 597)=39 + KINDEX(1, 597)=40 KINDEX(2, 597)=128 - KINDEX(1, 598)=41 + KINDEX(1, 598)=42 KINDEX(2, 598)=128 - KINDEX(1, 599)=41 + KINDEX(1, 599)=42 KINDEX(2, 599)=129 KINDEX(1, 600)=3 KINDEX(2, 600)=130 KINDEX(1, 601)=4 KINDEX(2, 601)=130 - KINDEX(1, 602)=41 + KINDEX(1, 602)=42 KINDEX(2, 602)=130 KINDEX(1, 603)=4 KINDEX(2, 603)=131 KINDEX(1, 604)=5 KINDEX(2, 604)=131 - KINDEX(1, 605)=41 + KINDEX(1, 605)=42 KINDEX(2, 605)=131 - KINDEX(1, 606)=12 + KINDEX(1, 606)=13 KINDEX(2, 606)=132 + KINDEX(1, 607)=4 + KINDEX(2, 607)=133 + KINDEX(1, 608)=5 + KINDEX(2, 608)=133 + KINDEX(1, 609)=11 + KINDEX(2, 609)=133 + KINDEX(1, 610)=12 + KINDEX(2, 610)=133 + KINDEX(1, 611)=11 + KINDEX(2, 611)=134 + KINDEX(1, 612)=12 + KINDEX(2, 612)=134 + KINDEX(1, 613)=11 + KINDEX(2, 613)=135 + KINDEX(1, 614)=12 + KINDEX(2, 614)=135 + KINDEX(1, 615)=15 + KINDEX(2, 615)=135 RETURN END SUBROUTINE CH_NONZEROTERMS_GAZ !! @@ -38645,7 +39348,7 @@ CONTAINS !! !! EXTERNAL !! -------- -use mode_msg +!! none !! !! IMPLICIT ARGUMENTS !! ------------------ @@ -38663,8 +39366,8 @@ IMPLICIT NONE !! EXECUTABLE STATEMENTS !! --------------------- ! check if output array is large enough -IF (KSPARSEDIM.LT.745) THEN - call Print_msg( NVERB_FATAL, 'GEN', 'CH_SPARSE_AQ', 'array KSPARSE is too small' ) +IF (KSPARSEDIM.LT.753) THEN + STOP 'CH_SPARSE ERROR: array KSPARSE is too small!' END IF !O3/O3 KSPARSE(1, 1)=1 @@ -38677,34 +39380,34 @@ END IF KSPARSE(2, 3)=4 !O3/OH KSPARSE(1, 4)=1 - KSPARSE(2, 4)=14 + KSPARSE(2, 4)=15 !O3/HO2 KSPARSE(1, 5)=1 - KSPARSE(2, 5)=15 + KSPARSE(2, 5)=16 !O3/ALKE KSPARSE(1, 6)=1 - KSPARSE(2, 6)=19 + KSPARSE(2, 6)=20 !O3/BIO KSPARSE(1, 7)=1 - KSPARSE(2, 7)=20 + KSPARSE(2, 7)=21 !O3/CARBO KSPARSE(1, 8)=1 - KSPARSE(2, 8)=25 + KSPARSE(2, 8)=26 !O3/PAN KSPARSE(1, 9)=1 - KSPARSE(2, 9)=27 + KSPARSE(2, 9)=28 !O3/ADD KSPARSE(1, 10)=1 - KSPARSE(2, 10)=37 + KSPARSE(2, 10)=38 !O3/CARBOP KSPARSE(1, 11)=1 - KSPARSE(2, 11)=39 + KSPARSE(2, 11)=40 !O3/WC_O3 KSPARSE(1, 12)=1 - KSPARSE(2, 12)=42 + KSPARSE(2, 12)=43 !O3/WR_O3 KSPARSE(1, 13)=1 - KSPARSE(2, 13)=67 + KSPARSE(2, 13)=68 !H2O2/O3 KSPARSE(1, 14)=2 KSPARSE(2, 14)=1 @@ -38713,22 +39416,22 @@ END IF KSPARSE(2, 15)=2 !H2O2/OH KSPARSE(1, 16)=2 - KSPARSE(2, 16)=14 + KSPARSE(2, 16)=15 !H2O2/HO2 KSPARSE(1, 17)=2 - KSPARSE(2, 17)=15 + KSPARSE(2, 17)=16 !H2O2/ALKE KSPARSE(1, 18)=2 - KSPARSE(2, 18)=19 + KSPARSE(2, 18)=20 !H2O2/BIO KSPARSE(1, 19)=2 - KSPARSE(2, 19)=20 + KSPARSE(2, 19)=21 !H2O2/WC_H2O2 KSPARSE(1, 20)=2 - KSPARSE(2, 20)=43 + KSPARSE(2, 20)=44 !H2O2/WR_H2O2 KSPARSE(1, 21)=2 - KSPARSE(2, 21)=68 + KSPARSE(2, 21)=69 !NO/O3 KSPARSE(1, 22)=3 KSPARSE(2, 22)=1 @@ -38746,40 +39449,40 @@ END IF KSPARSE(2, 26)=7 !NO/OH KSPARSE(1, 27)=3 - KSPARSE(2, 27)=14 + KSPARSE(2, 27)=15 !NO/HO2 KSPARSE(1, 28)=3 - KSPARSE(2, 28)=15 + KSPARSE(2, 28)=16 !NO/MO2 KSPARSE(1, 29)=3 - KSPARSE(2, 29)=32 + KSPARSE(2, 29)=33 !NO/ALKAP KSPARSE(1, 30)=3 - KSPARSE(2, 30)=33 + KSPARSE(2, 30)=34 !NO/ALKEP KSPARSE(1, 31)=3 - KSPARSE(2, 31)=34 + KSPARSE(2, 31)=35 !NO/BIOP KSPARSE(1, 32)=3 - KSPARSE(2, 32)=35 + KSPARSE(2, 32)=36 !NO/AROP KSPARSE(1, 33)=3 - KSPARSE(2, 33)=38 + KSPARSE(2, 33)=39 !NO/CARBOP KSPARSE(1, 34)=3 - KSPARSE(2, 34)=39 + KSPARSE(2, 34)=40 !NO/OLN KSPARSE(1, 35)=3 - KSPARSE(2, 35)=40 + KSPARSE(2, 35)=41 !NO/XO2 KSPARSE(1, 36)=3 - KSPARSE(2, 36)=41 + KSPARSE(2, 36)=42 !NO/WC_NO KSPARSE(1, 37)=3 - KSPARSE(2, 37)=44 + KSPARSE(2, 37)=45 !NO/WR_NO KSPARSE(1, 38)=3 - KSPARSE(2, 38)=69 + KSPARSE(2, 38)=70 !NO2/O3 KSPARSE(1, 39)=4 KSPARSE(2, 39)=1 @@ -38804,2104 +39507,2128 @@ END IF !NO2/HNO4 KSPARSE(1, 46)=4 KSPARSE(2, 46)=9 -!NO2/OH +!NO2/DMS KSPARSE(1, 47)=4 - KSPARSE(2, 47)=14 -!NO2/HO2 + KSPARSE(2, 47)=11 +!NO2/OH KSPARSE(1, 48)=4 KSPARSE(2, 48)=15 -!NO2/CARBO +!NO2/HO2 KSPARSE(1, 49)=4 - KSPARSE(2, 49)=25 -!NO2/ONIT + KSPARSE(2, 49)=16 +!NO2/CARBO KSPARSE(1, 50)=4 KSPARSE(2, 50)=26 -!NO2/PAN +!NO2/ONIT KSPARSE(1, 51)=4 KSPARSE(2, 51)=27 -!NO2/MO2 +!NO2/PAN KSPARSE(1, 52)=4 - KSPARSE(2, 52)=32 -!NO2/ALKAP + KSPARSE(2, 52)=28 +!NO2/MO2 KSPARSE(1, 53)=4 KSPARSE(2, 53)=33 -!NO2/ALKEP +!NO2/ALKAP KSPARSE(1, 54)=4 KSPARSE(2, 54)=34 -!NO2/BIOP +!NO2/ALKEP KSPARSE(1, 55)=4 KSPARSE(2, 55)=35 -!NO2/PHO +!NO2/BIOP KSPARSE(1, 56)=4 KSPARSE(2, 56)=36 -!NO2/ADD +!NO2/PHO KSPARSE(1, 57)=4 KSPARSE(2, 57)=37 -!NO2/AROP +!NO2/ADD KSPARSE(1, 58)=4 KSPARSE(2, 58)=38 -!NO2/CARBOP +!NO2/AROP KSPARSE(1, 59)=4 KSPARSE(2, 59)=39 -!NO2/OLN +!NO2/CARBOP KSPARSE(1, 60)=4 KSPARSE(2, 60)=40 -!NO2/XO2 +!NO2/OLN KSPARSE(1, 61)=4 KSPARSE(2, 61)=41 -!NO2/WC_NO2 +!NO2/XO2 KSPARSE(1, 62)=4 - KSPARSE(2, 62)=45 -!NO2/WR_NO2 + KSPARSE(2, 62)=42 +!NO2/WC_NO2 KSPARSE(1, 63)=4 - KSPARSE(2, 63)=70 + KSPARSE(2, 63)=46 +!NO2/WR_NO2 + KSPARSE(1, 64)=4 + KSPARSE(2, 64)=71 !NO3/O3 - KSPARSE(1, 64)=5 - KSPARSE(2, 64)=1 -!NO3/NO KSPARSE(1, 65)=5 - KSPARSE(2, 65)=3 -!NO3/NO2 + KSPARSE(2, 65)=1 +!NO3/NO KSPARSE(1, 66)=5 - KSPARSE(2, 66)=4 -!NO3/NO3 + KSPARSE(2, 66)=3 +!NO3/NO2 KSPARSE(1, 67)=5 - KSPARSE(2, 67)=5 -!NO3/N2O5 + KSPARSE(2, 67)=4 +!NO3/NO3 KSPARSE(1, 68)=5 - KSPARSE(2, 68)=6 -!NO3/HNO3 + KSPARSE(2, 68)=5 +!NO3/N2O5 KSPARSE(1, 69)=5 - KSPARSE(2, 69)=8 -!NO3/HNO4 + KSPARSE(2, 69)=6 +!NO3/HNO3 KSPARSE(1, 70)=5 - KSPARSE(2, 70)=9 -!NO3/OH + KSPARSE(2, 70)=8 +!NO3/HNO4 KSPARSE(1, 71)=5 - KSPARSE(2, 71)=14 -!NO3/HO2 + KSPARSE(2, 71)=9 +!NO3/DMS KSPARSE(1, 72)=5 - KSPARSE(2, 72)=15 -!NO3/ALKE + KSPARSE(2, 72)=11 +!NO3/OH KSPARSE(1, 73)=5 - KSPARSE(2, 73)=19 -!NO3/BIO + KSPARSE(2, 73)=15 +!NO3/HO2 KSPARSE(1, 74)=5 - KSPARSE(2, 74)=20 -!NO3/ARO + KSPARSE(2, 74)=16 +!NO3/ALKE KSPARSE(1, 75)=5 - KSPARSE(2, 75)=21 -!NO3/HCHO + KSPARSE(2, 75)=20 +!NO3/BIO KSPARSE(1, 76)=5 - KSPARSE(2, 76)=22 -!NO3/ALD + KSPARSE(2, 76)=21 +!NO3/ARO KSPARSE(1, 77)=5 - KSPARSE(2, 77)=23 -!NO3/CARBO + KSPARSE(2, 77)=22 +!NO3/HCHO KSPARSE(1, 78)=5 - KSPARSE(2, 78)=25 -!NO3/PAN + KSPARSE(2, 78)=23 +!NO3/ALD KSPARSE(1, 79)=5 - KSPARSE(2, 79)=27 -!NO3/MO2 + KSPARSE(2, 79)=24 +!NO3/CARBO KSPARSE(1, 80)=5 - KSPARSE(2, 80)=32 -!NO3/ALKAP + KSPARSE(2, 80)=26 +!NO3/PAN KSPARSE(1, 81)=5 - KSPARSE(2, 81)=33 -!NO3/ALKEP + KSPARSE(2, 81)=28 +!NO3/MO2 KSPARSE(1, 82)=5 - KSPARSE(2, 82)=34 -!NO3/BIOP + KSPARSE(2, 82)=33 +!NO3/ALKAP KSPARSE(1, 83)=5 - KSPARSE(2, 83)=35 -!NO3/AROP + KSPARSE(2, 83)=34 +!NO3/ALKEP KSPARSE(1, 84)=5 - KSPARSE(2, 84)=38 -!NO3/CARBOP + KSPARSE(2, 84)=35 +!NO3/BIOP KSPARSE(1, 85)=5 - KSPARSE(2, 85)=39 -!NO3/OLN + KSPARSE(2, 85)=36 +!NO3/AROP KSPARSE(1, 86)=5 - KSPARSE(2, 86)=40 -!NO3/XO2 + KSPARSE(2, 86)=39 +!NO3/CARBOP KSPARSE(1, 87)=5 - KSPARSE(2, 87)=41 -!NO3/WC_NO3 + KSPARSE(2, 87)=40 +!NO3/OLN KSPARSE(1, 88)=5 - KSPARSE(2, 88)=46 -!NO3/WR_NO3 + KSPARSE(2, 88)=41 +!NO3/XO2 KSPARSE(1, 89)=5 - KSPARSE(2, 89)=71 + KSPARSE(2, 89)=42 +!NO3/WC_NO3 + KSPARSE(1, 90)=5 + KSPARSE(2, 90)=47 +!NO3/WR_NO3 + KSPARSE(1, 91)=5 + KSPARSE(2, 91)=72 !N2O5/NO2 - KSPARSE(1, 90)=6 - KSPARSE(2, 90)=4 + KSPARSE(1, 92)=6 + KSPARSE(2, 92)=4 !N2O5/NO3 - KSPARSE(1, 91)=6 - KSPARSE(2, 91)=5 + KSPARSE(1, 93)=6 + KSPARSE(2, 93)=5 !N2O5/N2O5 - KSPARSE(1, 92)=6 - KSPARSE(2, 92)=6 + KSPARSE(1, 94)=6 + KSPARSE(2, 94)=6 !N2O5/WC_N2O5 - KSPARSE(1, 93)=6 - KSPARSE(2, 93)=47 + KSPARSE(1, 95)=6 + KSPARSE(2, 95)=48 !N2O5/WR_N2O5 - KSPARSE(1, 94)=6 - KSPARSE(2, 94)=72 + KSPARSE(1, 96)=6 + KSPARSE(2, 96)=73 !HONO/NO - KSPARSE(1, 95)=7 - KSPARSE(2, 95)=3 + KSPARSE(1, 97)=7 + KSPARSE(2, 97)=3 !HONO/NO2 - KSPARSE(1, 96)=7 - KSPARSE(2, 96)=4 + KSPARSE(1, 98)=7 + KSPARSE(2, 98)=4 !HONO/HONO - KSPARSE(1, 97)=7 - KSPARSE(2, 97)=7 + KSPARSE(1, 99)=7 + KSPARSE(2, 99)=7 !HONO/OH - KSPARSE(1, 98)=7 - KSPARSE(2, 98)=14 + KSPARSE(1, 100)=7 + KSPARSE(2, 100)=15 !HONO/ADD - KSPARSE(1, 99)=7 - KSPARSE(2, 99)=37 + KSPARSE(1, 101)=7 + KSPARSE(2, 101)=38 !HONO/WC_HONO - KSPARSE(1, 100)=7 - KSPARSE(2, 100)=48 + KSPARSE(1, 102)=7 + KSPARSE(2, 102)=49 !HONO/WR_HONO - KSPARSE(1, 101)=7 - KSPARSE(2, 101)=73 + KSPARSE(1, 103)=7 + KSPARSE(2, 103)=74 !HNO3/NO2 - KSPARSE(1, 102)=8 - KSPARSE(2, 102)=4 + KSPARSE(1, 104)=8 + KSPARSE(2, 104)=4 !HNO3/NO3 - KSPARSE(1, 103)=8 - KSPARSE(2, 103)=5 + KSPARSE(1, 105)=8 + KSPARSE(2, 105)=5 !HNO3/HNO3 - KSPARSE(1, 104)=8 - KSPARSE(2, 104)=8 + KSPARSE(1, 106)=8 + KSPARSE(2, 106)=8 !HNO3/OH - KSPARSE(1, 105)=8 - KSPARSE(2, 105)=14 + KSPARSE(1, 107)=8 + KSPARSE(2, 107)=15 !HNO3/HO2 - KSPARSE(1, 106)=8 - KSPARSE(2, 106)=15 + KSPARSE(1, 108)=8 + KSPARSE(2, 108)=16 !HNO3/ARO - KSPARSE(1, 107)=8 - KSPARSE(2, 107)=21 + KSPARSE(1, 109)=8 + KSPARSE(2, 109)=22 !HNO3/HCHO - KSPARSE(1, 108)=8 - KSPARSE(2, 108)=22 + KSPARSE(1, 110)=8 + KSPARSE(2, 110)=23 !HNO3/ALD - KSPARSE(1, 109)=8 - KSPARSE(2, 109)=23 + KSPARSE(1, 111)=8 + KSPARSE(2, 111)=24 !HNO3/CARBO - KSPARSE(1, 110)=8 - KSPARSE(2, 110)=25 + KSPARSE(1, 112)=8 + KSPARSE(2, 112)=26 !HNO3/WC_HNO3 - KSPARSE(1, 111)=8 - KSPARSE(2, 111)=49 + KSPARSE(1, 113)=8 + KSPARSE(2, 113)=50 !HNO3/WR_HNO3 - KSPARSE(1, 112)=8 - KSPARSE(2, 112)=74 + KSPARSE(1, 114)=8 + KSPARSE(2, 114)=75 !HNO4/NO2 - KSPARSE(1, 113)=9 - KSPARSE(2, 113)=4 + KSPARSE(1, 115)=9 + KSPARSE(2, 115)=4 !HNO4/HNO4 - KSPARSE(1, 114)=9 - KSPARSE(2, 114)=9 + KSPARSE(1, 116)=9 + KSPARSE(2, 116)=9 !HNO4/OH - KSPARSE(1, 115)=9 - KSPARSE(2, 115)=14 + KSPARSE(1, 117)=9 + KSPARSE(2, 117)=15 !HNO4/HO2 - KSPARSE(1, 116)=9 - KSPARSE(2, 116)=15 + KSPARSE(1, 118)=9 + KSPARSE(2, 118)=16 !HNO4/WC_HNO4 - KSPARSE(1, 117)=9 - KSPARSE(2, 117)=50 + KSPARSE(1, 119)=9 + KSPARSE(2, 119)=51 !HNO4/WR_HNO4 - KSPARSE(1, 118)=9 - KSPARSE(2, 118)=75 + KSPARSE(1, 120)=9 + KSPARSE(2, 120)=76 !NH3/NH3 - KSPARSE(1, 119)=10 - KSPARSE(2, 119)=10 + KSPARSE(1, 121)=10 + KSPARSE(2, 121)=10 !NH3/OH - KSPARSE(1, 120)=10 - KSPARSE(2, 120)=14 + KSPARSE(1, 122)=10 + KSPARSE(2, 122)=15 !NH3/WC_NH3 - KSPARSE(1, 121)=10 - KSPARSE(2, 121)=51 + KSPARSE(1, 123)=10 + KSPARSE(2, 123)=52 !NH3/WR_NH3 - KSPARSE(1, 122)=10 - KSPARSE(2, 122)=76 + KSPARSE(1, 124)=10 + KSPARSE(2, 124)=77 +!DMS/NO3 + KSPARSE(1, 125)=11 + KSPARSE(2, 125)=5 +!DMS/DMS + KSPARSE(1, 126)=11 + KSPARSE(2, 126)=11 +!DMS/OH + KSPARSE(1, 127)=11 + KSPARSE(2, 127)=15 +!SO2/NO3 + KSPARSE(1, 128)=12 + KSPARSE(2, 128)=5 +!SO2/DMS + KSPARSE(1, 129)=12 + KSPARSE(2, 129)=11 !SO2/SO2 - KSPARSE(1, 123)=11 - KSPARSE(2, 123)=11 + KSPARSE(1, 130)=12 + KSPARSE(2, 130)=12 !SO2/OH - KSPARSE(1, 124)=11 - KSPARSE(2, 124)=14 + KSPARSE(1, 131)=12 + KSPARSE(2, 131)=15 !SO2/WC_SO2 - KSPARSE(1, 125)=11 - KSPARSE(2, 125)=55 + KSPARSE(1, 132)=12 + KSPARSE(2, 132)=56 !SO2/WR_SO2 - KSPARSE(1, 126)=11 - KSPARSE(2, 126)=80 + KSPARSE(1, 133)=12 + KSPARSE(2, 133)=81 !SULF/SO2 - KSPARSE(1, 127)=12 - KSPARSE(2, 127)=11 + KSPARSE(1, 134)=13 + KSPARSE(2, 134)=12 !SULF/SULF - KSPARSE(1, 128)=12 - KSPARSE(2, 128)=12 + KSPARSE(1, 135)=13 + KSPARSE(2, 135)=13 !SULF/OH - KSPARSE(1, 129)=12 - KSPARSE(2, 129)=14 + KSPARSE(1, 136)=13 + KSPARSE(2, 136)=15 !SULF/WC_SULF - KSPARSE(1, 130)=12 - KSPARSE(2, 130)=56 + KSPARSE(1, 137)=13 + KSPARSE(2, 137)=57 !SULF/WR_SULF - KSPARSE(1, 131)=12 - KSPARSE(2, 131)=81 + KSPARSE(1, 138)=13 + KSPARSE(2, 138)=82 !CO/O3 - KSPARSE(1, 132)=13 - KSPARSE(2, 132)=1 + KSPARSE(1, 139)=14 + KSPARSE(2, 139)=1 !CO/NO3 - KSPARSE(1, 133)=13 - KSPARSE(2, 133)=5 + KSPARSE(1, 140)=14 + KSPARSE(2, 140)=5 !CO/CO - KSPARSE(1, 134)=13 - KSPARSE(2, 134)=13 + KSPARSE(1, 141)=14 + KSPARSE(2, 141)=14 !CO/OH - KSPARSE(1, 135)=13 - KSPARSE(2, 135)=14 + KSPARSE(1, 142)=14 + KSPARSE(2, 142)=15 !CO/ALKA - KSPARSE(1, 136)=13 - KSPARSE(2, 136)=18 + KSPARSE(1, 143)=14 + KSPARSE(2, 143)=19 !CO/ALKE - KSPARSE(1, 137)=13 - KSPARSE(2, 137)=19 + KSPARSE(1, 144)=14 + KSPARSE(2, 144)=20 !CO/BIO - KSPARSE(1, 138)=13 - KSPARSE(2, 138)=20 + KSPARSE(1, 145)=14 + KSPARSE(2, 145)=21 !CO/HCHO - KSPARSE(1, 139)=13 - KSPARSE(2, 139)=22 + KSPARSE(1, 146)=14 + KSPARSE(2, 146)=23 !CO/ALD - KSPARSE(1, 140)=13 - KSPARSE(2, 140)=23 + KSPARSE(1, 147)=14 + KSPARSE(2, 147)=24 !CO/CARBO - KSPARSE(1, 141)=13 - KSPARSE(2, 141)=25 + KSPARSE(1, 148)=14 + KSPARSE(2, 148)=26 !CO/PAN - KSPARSE(1, 142)=13 - KSPARSE(2, 142)=27 + KSPARSE(1, 149)=14 + KSPARSE(2, 149)=28 !OH/O3 - KSPARSE(1, 143)=14 - KSPARSE(2, 143)=1 + KSPARSE(1, 150)=15 + KSPARSE(2, 150)=1 !OH/H2O2 - KSPARSE(1, 144)=14 - KSPARSE(2, 144)=2 + KSPARSE(1, 151)=15 + KSPARSE(2, 151)=2 !OH/NO - KSPARSE(1, 145)=14 - KSPARSE(2, 145)=3 + KSPARSE(1, 152)=15 + KSPARSE(2, 152)=3 !OH/NO2 - KSPARSE(1, 146)=14 - KSPARSE(2, 146)=4 + KSPARSE(1, 153)=15 + KSPARSE(2, 153)=4 !OH/NO3 - KSPARSE(1, 147)=14 - KSPARSE(2, 147)=5 + KSPARSE(1, 154)=15 + KSPARSE(2, 154)=5 !OH/HONO - KSPARSE(1, 148)=14 - KSPARSE(2, 148)=7 + KSPARSE(1, 155)=15 + KSPARSE(2, 155)=7 !OH/HNO3 - KSPARSE(1, 149)=14 - KSPARSE(2, 149)=8 + KSPARSE(1, 156)=15 + KSPARSE(2, 156)=8 !OH/HNO4 - KSPARSE(1, 150)=14 - KSPARSE(2, 150)=9 + KSPARSE(1, 157)=15 + KSPARSE(2, 157)=9 !OH/NH3 - KSPARSE(1, 151)=14 - KSPARSE(2, 151)=10 + KSPARSE(1, 158)=15 + KSPARSE(2, 158)=10 +!OH/DMS + KSPARSE(1, 159)=15 + KSPARSE(2, 159)=11 !OH/SO2 - KSPARSE(1, 152)=14 - KSPARSE(2, 152)=11 + KSPARSE(1, 160)=15 + KSPARSE(2, 160)=12 !OH/CO - KSPARSE(1, 153)=14 - KSPARSE(2, 153)=13 + KSPARSE(1, 161)=15 + KSPARSE(2, 161)=14 !OH/OH - KSPARSE(1, 154)=14 - KSPARSE(2, 154)=14 + KSPARSE(1, 162)=15 + KSPARSE(2, 162)=15 !OH/HO2 - KSPARSE(1, 155)=14 - KSPARSE(2, 155)=15 + KSPARSE(1, 163)=15 + KSPARSE(2, 163)=16 !OH/CH4 - KSPARSE(1, 156)=14 - KSPARSE(2, 156)=16 + KSPARSE(1, 164)=15 + KSPARSE(2, 164)=17 !OH/ETH - KSPARSE(1, 157)=14 - KSPARSE(2, 157)=17 + KSPARSE(1, 165)=15 + KSPARSE(2, 165)=18 !OH/ALKA - KSPARSE(1, 158)=14 - KSPARSE(2, 158)=18 + KSPARSE(1, 166)=15 + KSPARSE(2, 166)=19 !OH/ALKE - KSPARSE(1, 159)=14 - KSPARSE(2, 159)=19 + KSPARSE(1, 167)=15 + KSPARSE(2, 167)=20 !OH/BIO - KSPARSE(1, 160)=14 - KSPARSE(2, 160)=20 + KSPARSE(1, 168)=15 + KSPARSE(2, 168)=21 !OH/ARO - KSPARSE(1, 161)=14 - KSPARSE(2, 161)=21 + KSPARSE(1, 169)=15 + KSPARSE(2, 169)=22 !OH/HCHO - KSPARSE(1, 162)=14 - KSPARSE(2, 162)=22 + KSPARSE(1, 170)=15 + KSPARSE(2, 170)=23 !OH/ALD - KSPARSE(1, 163)=14 - KSPARSE(2, 163)=23 + KSPARSE(1, 171)=15 + KSPARSE(2, 171)=24 !OH/KET - KSPARSE(1, 164)=14 - KSPARSE(2, 164)=24 + KSPARSE(1, 172)=15 + KSPARSE(2, 172)=25 !OH/CARBO - KSPARSE(1, 165)=14 - KSPARSE(2, 165)=25 + KSPARSE(1, 173)=15 + KSPARSE(2, 173)=26 !OH/ONIT - KSPARSE(1, 166)=14 - KSPARSE(2, 166)=26 + KSPARSE(1, 174)=15 + KSPARSE(2, 174)=27 !OH/PAN - KSPARSE(1, 167)=14 - KSPARSE(2, 167)=27 + KSPARSE(1, 175)=15 + KSPARSE(2, 175)=28 !OH/OP1 - KSPARSE(1, 168)=14 - KSPARSE(2, 168)=28 + KSPARSE(1, 176)=15 + KSPARSE(2, 176)=29 !OH/OP2 - KSPARSE(1, 169)=14 - KSPARSE(2, 169)=29 + KSPARSE(1, 177)=15 + KSPARSE(2, 177)=30 !OH/ORA1 - KSPARSE(1, 170)=14 - KSPARSE(2, 170)=30 + KSPARSE(1, 178)=15 + KSPARSE(2, 178)=31 !OH/ORA2 - KSPARSE(1, 171)=14 - KSPARSE(2, 171)=31 + KSPARSE(1, 179)=15 + KSPARSE(2, 179)=32 !OH/ADD - KSPARSE(1, 172)=14 - KSPARSE(2, 172)=37 + KSPARSE(1, 180)=15 + KSPARSE(2, 180)=38 !OH/WC_OH - KSPARSE(1, 173)=14 - KSPARSE(2, 173)=52 + KSPARSE(1, 181)=15 + KSPARSE(2, 181)=53 !OH/WR_OH - KSPARSE(1, 174)=14 - KSPARSE(2, 174)=77 + KSPARSE(1, 182)=15 + KSPARSE(2, 182)=78 !HO2/O3 - KSPARSE(1, 175)=15 - KSPARSE(2, 175)=1 + KSPARSE(1, 183)=16 + KSPARSE(2, 183)=1 !HO2/H2O2 - KSPARSE(1, 176)=15 - KSPARSE(2, 176)=2 + KSPARSE(1, 184)=16 + KSPARSE(2, 184)=2 !HO2/NO - KSPARSE(1, 177)=15 - KSPARSE(2, 177)=3 + KSPARSE(1, 185)=16 + KSPARSE(2, 185)=3 !HO2/NO2 - KSPARSE(1, 178)=15 - KSPARSE(2, 178)=4 + KSPARSE(1, 186)=16 + KSPARSE(2, 186)=4 !HO2/NO3 - KSPARSE(1, 179)=15 - KSPARSE(2, 179)=5 + KSPARSE(1, 187)=16 + KSPARSE(2, 187)=5 !HO2/HNO4 - KSPARSE(1, 180)=15 - KSPARSE(2, 180)=9 + KSPARSE(1, 188)=16 + KSPARSE(2, 188)=9 !HO2/SO2 - KSPARSE(1, 181)=15 - KSPARSE(2, 181)=11 + KSPARSE(1, 189)=16 + KSPARSE(2, 189)=12 !HO2/CO - KSPARSE(1, 182)=15 - KSPARSE(2, 182)=13 + KSPARSE(1, 190)=16 + KSPARSE(2, 190)=14 !HO2/OH - KSPARSE(1, 183)=15 - KSPARSE(2, 183)=14 + KSPARSE(1, 191)=16 + KSPARSE(2, 191)=15 !HO2/HO2 - KSPARSE(1, 184)=15 - KSPARSE(2, 184)=15 + KSPARSE(1, 192)=16 + KSPARSE(2, 192)=16 !HO2/ALKA - KSPARSE(1, 185)=15 - KSPARSE(2, 185)=18 + KSPARSE(1, 193)=16 + KSPARSE(2, 193)=19 !HO2/ALKE - KSPARSE(1, 186)=15 - KSPARSE(2, 186)=19 + KSPARSE(1, 194)=16 + KSPARSE(2, 194)=20 !HO2/BIO - KSPARSE(1, 187)=15 - KSPARSE(2, 187)=20 + KSPARSE(1, 195)=16 + KSPARSE(2, 195)=21 !HO2/ARO - KSPARSE(1, 188)=15 - KSPARSE(2, 188)=21 + KSPARSE(1, 196)=16 + KSPARSE(2, 196)=22 !HO2/HCHO - KSPARSE(1, 189)=15 - KSPARSE(2, 189)=22 + KSPARSE(1, 197)=16 + KSPARSE(2, 197)=23 !HO2/ALD - KSPARSE(1, 190)=15 - KSPARSE(2, 190)=23 + KSPARSE(1, 198)=16 + KSPARSE(2, 198)=24 !HO2/CARBO - KSPARSE(1, 191)=15 - KSPARSE(2, 191)=25 + KSPARSE(1, 199)=16 + KSPARSE(2, 199)=26 !HO2/ONIT - KSPARSE(1, 192)=15 - KSPARSE(2, 192)=26 + KSPARSE(1, 200)=16 + KSPARSE(2, 200)=27 !HO2/PAN - KSPARSE(1, 193)=15 - KSPARSE(2, 193)=27 + KSPARSE(1, 201)=16 + KSPARSE(2, 201)=28 !HO2/OP1 - KSPARSE(1, 194)=15 - KSPARSE(2, 194)=28 + KSPARSE(1, 202)=16 + KSPARSE(2, 202)=29 !HO2/OP2 - KSPARSE(1, 195)=15 - KSPARSE(2, 195)=29 + KSPARSE(1, 203)=16 + KSPARSE(2, 203)=30 !HO2/ORA1 - KSPARSE(1, 196)=15 - KSPARSE(2, 196)=30 + KSPARSE(1, 204)=16 + KSPARSE(2, 204)=31 !HO2/MO2 - KSPARSE(1, 197)=15 - KSPARSE(2, 197)=32 + KSPARSE(1, 205)=16 + KSPARSE(2, 205)=33 !HO2/ALKAP - KSPARSE(1, 198)=15 - KSPARSE(2, 198)=33 + KSPARSE(1, 206)=16 + KSPARSE(2, 206)=34 !HO2/ALKEP - KSPARSE(1, 199)=15 - KSPARSE(2, 199)=34 + KSPARSE(1, 207)=16 + KSPARSE(2, 207)=35 !HO2/BIOP - KSPARSE(1, 200)=15 - KSPARSE(2, 200)=35 + KSPARSE(1, 208)=16 + KSPARSE(2, 208)=36 !HO2/PHO - KSPARSE(1, 201)=15 - KSPARSE(2, 201)=36 + KSPARSE(1, 209)=16 + KSPARSE(2, 209)=37 !HO2/ADD - KSPARSE(1, 202)=15 - KSPARSE(2, 202)=37 + KSPARSE(1, 210)=16 + KSPARSE(2, 210)=38 !HO2/AROP - KSPARSE(1, 203)=15 - KSPARSE(2, 203)=38 + KSPARSE(1, 211)=16 + KSPARSE(2, 211)=39 !HO2/CARBOP - KSPARSE(1, 204)=15 - KSPARSE(2, 204)=39 + KSPARSE(1, 212)=16 + KSPARSE(2, 212)=40 !HO2/OLN - KSPARSE(1, 205)=15 - KSPARSE(2, 205)=40 + KSPARSE(1, 213)=16 + KSPARSE(2, 213)=41 !HO2/XO2 - KSPARSE(1, 206)=15 - KSPARSE(2, 206)=41 + KSPARSE(1, 214)=16 + KSPARSE(2, 214)=42 !HO2/WC_HO2 - KSPARSE(1, 207)=15 - KSPARSE(2, 207)=53 + KSPARSE(1, 215)=16 + KSPARSE(2, 215)=54 !HO2/WR_HO2 - KSPARSE(1, 208)=15 - KSPARSE(2, 208)=78 + KSPARSE(1, 216)=16 + KSPARSE(2, 216)=79 !CH4/O3 - KSPARSE(1, 209)=16 - KSPARSE(2, 209)=1 + KSPARSE(1, 217)=17 + KSPARSE(2, 217)=1 !CH4/OH - KSPARSE(1, 210)=16 - KSPARSE(2, 210)=14 + KSPARSE(1, 218)=17 + KSPARSE(2, 218)=15 !CH4/CH4 - KSPARSE(1, 211)=16 - KSPARSE(2, 211)=16 + KSPARSE(1, 219)=17 + KSPARSE(2, 219)=17 !CH4/ALKE - KSPARSE(1, 212)=16 - KSPARSE(2, 212)=19 + KSPARSE(1, 220)=17 + KSPARSE(2, 220)=20 !ETH/O3 - KSPARSE(1, 213)=17 - KSPARSE(2, 213)=1 + KSPARSE(1, 221)=18 + KSPARSE(2, 221)=1 !ETH/OH - KSPARSE(1, 214)=17 - KSPARSE(2, 214)=14 + KSPARSE(1, 222)=18 + KSPARSE(2, 222)=15 !ETH/ETH - KSPARSE(1, 215)=17 - KSPARSE(2, 215)=17 + KSPARSE(1, 223)=18 + KSPARSE(2, 223)=18 !ETH/ALKE - KSPARSE(1, 216)=17 - KSPARSE(2, 216)=19 + KSPARSE(1, 224)=18 + KSPARSE(2, 224)=20 !ALKA/OH - KSPARSE(1, 217)=18 - KSPARSE(2, 217)=14 + KSPARSE(1, 225)=19 + KSPARSE(2, 225)=15 !ALKA/ALKA - KSPARSE(1, 218)=18 - KSPARSE(2, 218)=18 + KSPARSE(1, 226)=19 + KSPARSE(2, 226)=19 !ALKE/O3 - KSPARSE(1, 219)=19 - KSPARSE(2, 219)=1 + KSPARSE(1, 227)=20 + KSPARSE(2, 227)=1 !ALKE/NO - KSPARSE(1, 220)=19 - KSPARSE(2, 220)=3 + KSPARSE(1, 228)=20 + KSPARSE(2, 228)=3 !ALKE/NO3 - KSPARSE(1, 221)=19 - KSPARSE(2, 221)=5 + KSPARSE(1, 229)=20 + KSPARSE(2, 229)=5 !ALKE/OH - KSPARSE(1, 222)=19 - KSPARSE(2, 222)=14 + KSPARSE(1, 230)=20 + KSPARSE(2, 230)=15 !ALKE/ALKE - KSPARSE(1, 223)=19 - KSPARSE(2, 223)=19 + KSPARSE(1, 231)=20 + KSPARSE(2, 231)=20 !ALKE/BIO - KSPARSE(1, 224)=19 - KSPARSE(2, 224)=20 + KSPARSE(1, 232)=20 + KSPARSE(2, 232)=21 !ALKE/MO2 - KSPARSE(1, 225)=19 - KSPARSE(2, 225)=32 + KSPARSE(1, 233)=20 + KSPARSE(2, 233)=33 !ALKE/BIOP - KSPARSE(1, 226)=19 - KSPARSE(2, 226)=35 + KSPARSE(1, 234)=20 + KSPARSE(2, 234)=36 !ALKE/CARBOP - KSPARSE(1, 227)=19 - KSPARSE(2, 227)=39 + KSPARSE(1, 235)=20 + KSPARSE(2, 235)=40 !BIO/O3 - KSPARSE(1, 228)=20 - KSPARSE(2, 228)=1 + KSPARSE(1, 236)=21 + KSPARSE(2, 236)=1 !BIO/NO3 - KSPARSE(1, 229)=20 - KSPARSE(2, 229)=5 + KSPARSE(1, 237)=21 + KSPARSE(2, 237)=5 !BIO/OH - KSPARSE(1, 230)=20 - KSPARSE(2, 230)=14 + KSPARSE(1, 238)=21 + KSPARSE(2, 238)=15 !BIO/BIO - KSPARSE(1, 231)=20 - KSPARSE(2, 231)=20 + KSPARSE(1, 239)=21 + KSPARSE(2, 239)=21 !ARO/O3 - KSPARSE(1, 232)=21 - KSPARSE(2, 232)=1 + KSPARSE(1, 240)=22 + KSPARSE(2, 240)=1 !ARO/NO2 - KSPARSE(1, 233)=21 - KSPARSE(2, 233)=4 + KSPARSE(1, 241)=22 + KSPARSE(2, 241)=4 !ARO/NO3 - KSPARSE(1, 234)=21 - KSPARSE(2, 234)=5 + KSPARSE(1, 242)=22 + KSPARSE(2, 242)=5 !ARO/OH - KSPARSE(1, 235)=21 - KSPARSE(2, 235)=14 + KSPARSE(1, 243)=22 + KSPARSE(2, 243)=15 !ARO/HO2 - KSPARSE(1, 236)=21 - KSPARSE(2, 236)=15 + KSPARSE(1, 244)=22 + KSPARSE(2, 244)=16 !ARO/ARO - KSPARSE(1, 237)=21 - KSPARSE(2, 237)=21 + KSPARSE(1, 245)=22 + KSPARSE(2, 245)=22 !ARO/PHO - KSPARSE(1, 238)=21 - KSPARSE(2, 238)=36 + KSPARSE(1, 246)=22 + KSPARSE(2, 246)=37 !ARO/ADD - KSPARSE(1, 239)=21 - KSPARSE(2, 239)=37 + KSPARSE(1, 247)=22 + KSPARSE(2, 247)=38 !HCHO/O3 - KSPARSE(1, 240)=22 - KSPARSE(2, 240)=1 + KSPARSE(1, 248)=23 + KSPARSE(2, 248)=1 !HCHO/NO - KSPARSE(1, 241)=22 - KSPARSE(2, 241)=3 + KSPARSE(1, 249)=23 + KSPARSE(2, 249)=3 !HCHO/NO3 - KSPARSE(1, 242)=22 - KSPARSE(2, 242)=5 + KSPARSE(1, 250)=23 + KSPARSE(2, 250)=5 !HCHO/OH - KSPARSE(1, 243)=22 - KSPARSE(2, 243)=14 + KSPARSE(1, 251)=23 + KSPARSE(2, 251)=15 !HCHO/ALKA - KSPARSE(1, 244)=22 - KSPARSE(2, 244)=18 + KSPARSE(1, 252)=23 + KSPARSE(2, 252)=19 !HCHO/ALKE - KSPARSE(1, 245)=22 - KSPARSE(2, 245)=19 + KSPARSE(1, 253)=23 + KSPARSE(2, 253)=20 !HCHO/BIO - KSPARSE(1, 246)=22 - KSPARSE(2, 246)=20 + KSPARSE(1, 254)=23 + KSPARSE(2, 254)=21 !HCHO/HCHO - KSPARSE(1, 247)=22 - KSPARSE(2, 247)=22 + KSPARSE(1, 255)=23 + KSPARSE(2, 255)=23 !HCHO/CARBO - KSPARSE(1, 248)=22 - KSPARSE(2, 248)=25 + KSPARSE(1, 256)=23 + KSPARSE(2, 256)=26 !HCHO/PAN - KSPARSE(1, 249)=22 - KSPARSE(2, 249)=27 + KSPARSE(1, 257)=23 + KSPARSE(2, 257)=28 !HCHO/OP1 - KSPARSE(1, 250)=22 - KSPARSE(2, 250)=28 + KSPARSE(1, 258)=23 + KSPARSE(2, 258)=29 !HCHO/OP2 - KSPARSE(1, 251)=22 - KSPARSE(2, 251)=29 + KSPARSE(1, 259)=23 + KSPARSE(2, 259)=30 !HCHO/MO2 - KSPARSE(1, 252)=22 - KSPARSE(2, 252)=32 + KSPARSE(1, 260)=23 + KSPARSE(2, 260)=33 !HCHO/ALKAP - KSPARSE(1, 253)=22 - KSPARSE(2, 253)=33 + KSPARSE(1, 261)=23 + KSPARSE(2, 261)=34 !HCHO/ALKEP - KSPARSE(1, 254)=22 - KSPARSE(2, 254)=34 + KSPARSE(1, 262)=23 + KSPARSE(2, 262)=35 !HCHO/BIOP - KSPARSE(1, 255)=22 - KSPARSE(2, 255)=35 + KSPARSE(1, 263)=23 + KSPARSE(2, 263)=36 !HCHO/AROP - KSPARSE(1, 256)=22 - KSPARSE(2, 256)=38 + KSPARSE(1, 264)=23 + KSPARSE(2, 264)=39 !HCHO/CARBOP - KSPARSE(1, 257)=22 - KSPARSE(2, 257)=39 + KSPARSE(1, 265)=23 + KSPARSE(2, 265)=40 !HCHO/OLN - KSPARSE(1, 258)=22 - KSPARSE(2, 258)=40 + KSPARSE(1, 266)=23 + KSPARSE(2, 266)=41 !HCHO/XO2 - KSPARSE(1, 259)=22 - KSPARSE(2, 259)=41 + KSPARSE(1, 267)=23 + KSPARSE(2, 267)=42 !HCHO/WC_HCHO - KSPARSE(1, 260)=22 - KSPARSE(2, 260)=57 + KSPARSE(1, 268)=23 + KSPARSE(2, 268)=58 !HCHO/WR_HCHO - KSPARSE(1, 261)=22 - KSPARSE(2, 261)=82 + KSPARSE(1, 269)=23 + KSPARSE(2, 269)=83 !ALD/O3 - KSPARSE(1, 262)=23 - KSPARSE(2, 262)=1 + KSPARSE(1, 270)=24 + KSPARSE(2, 270)=1 !ALD/NO - KSPARSE(1, 263)=23 - KSPARSE(2, 263)=3 + KSPARSE(1, 271)=24 + KSPARSE(2, 271)=3 !ALD/NO3 - KSPARSE(1, 264)=23 - KSPARSE(2, 264)=5 + KSPARSE(1, 272)=24 + KSPARSE(2, 272)=5 !ALD/OH - KSPARSE(1, 265)=23 - KSPARSE(2, 265)=14 + KSPARSE(1, 273)=24 + KSPARSE(2, 273)=15 !ALD/ALKA - KSPARSE(1, 266)=23 - KSPARSE(2, 266)=18 + KSPARSE(1, 274)=24 + KSPARSE(2, 274)=19 !ALD/ALKE - KSPARSE(1, 267)=23 - KSPARSE(2, 267)=19 + KSPARSE(1, 275)=24 + KSPARSE(2, 275)=20 !ALD/BIO - KSPARSE(1, 268)=23 - KSPARSE(2, 268)=20 + KSPARSE(1, 276)=24 + KSPARSE(2, 276)=21 !ALD/ALD - KSPARSE(1, 269)=23 - KSPARSE(2, 269)=23 + KSPARSE(1, 277)=24 + KSPARSE(2, 277)=24 !ALD/CARBO - KSPARSE(1, 270)=23 - KSPARSE(2, 270)=25 + KSPARSE(1, 278)=24 + KSPARSE(2, 278)=26 !ALD/ONIT - KSPARSE(1, 271)=23 - KSPARSE(2, 271)=26 + KSPARSE(1, 279)=24 + KSPARSE(2, 279)=27 !ALD/OP2 - KSPARSE(1, 272)=23 - KSPARSE(2, 272)=29 + KSPARSE(1, 280)=24 + KSPARSE(2, 280)=30 !ALD/MO2 - KSPARSE(1, 273)=23 - KSPARSE(2, 273)=32 + KSPARSE(1, 281)=24 + KSPARSE(2, 281)=33 !ALD/ALKAP - KSPARSE(1, 274)=23 - KSPARSE(2, 274)=33 + KSPARSE(1, 282)=24 + KSPARSE(2, 282)=34 !ALD/ALKEP - KSPARSE(1, 275)=23 - KSPARSE(2, 275)=34 + KSPARSE(1, 283)=24 + KSPARSE(2, 283)=35 !ALD/BIOP - KSPARSE(1, 276)=23 - KSPARSE(2, 276)=35 + KSPARSE(1, 284)=24 + KSPARSE(2, 284)=36 !ALD/CARBOP - KSPARSE(1, 277)=23 - KSPARSE(2, 277)=39 + KSPARSE(1, 285)=24 + KSPARSE(2, 285)=40 !ALD/OLN - KSPARSE(1, 278)=23 - KSPARSE(2, 278)=40 + KSPARSE(1, 286)=24 + KSPARSE(2, 286)=41 !KET/O3 - KSPARSE(1, 279)=24 - KSPARSE(2, 279)=1 + KSPARSE(1, 287)=25 + KSPARSE(2, 287)=1 !KET/NO - KSPARSE(1, 280)=24 - KSPARSE(2, 280)=3 + KSPARSE(1, 288)=25 + KSPARSE(2, 288)=3 !KET/NO3 - KSPARSE(1, 281)=24 - KSPARSE(2, 281)=5 + KSPARSE(1, 289)=25 + KSPARSE(2, 289)=5 !KET/OH - KSPARSE(1, 282)=24 - KSPARSE(2, 282)=14 + KSPARSE(1, 290)=25 + KSPARSE(2, 290)=15 !KET/ALKA - KSPARSE(1, 283)=24 - KSPARSE(2, 283)=18 + KSPARSE(1, 291)=25 + KSPARSE(2, 291)=19 !KET/ALKE - KSPARSE(1, 284)=24 - KSPARSE(2, 284)=19 + KSPARSE(1, 292)=25 + KSPARSE(2, 292)=20 !KET/BIO - KSPARSE(1, 285)=24 - KSPARSE(2, 285)=20 + KSPARSE(1, 293)=25 + KSPARSE(2, 293)=21 !KET/KET - KSPARSE(1, 286)=24 - KSPARSE(2, 286)=24 + KSPARSE(1, 294)=25 + KSPARSE(2, 294)=25 !KET/CARBO - KSPARSE(1, 287)=24 - KSPARSE(2, 287)=25 + KSPARSE(1, 295)=25 + KSPARSE(2, 295)=26 !KET/ONIT - KSPARSE(1, 288)=24 - KSPARSE(2, 288)=26 + KSPARSE(1, 296)=25 + KSPARSE(2, 296)=27 !KET/OP2 - KSPARSE(1, 289)=24 - KSPARSE(2, 289)=29 + KSPARSE(1, 297)=25 + KSPARSE(2, 297)=30 !KET/MO2 - KSPARSE(1, 290)=24 - KSPARSE(2, 290)=32 + KSPARSE(1, 298)=25 + KSPARSE(2, 298)=33 !KET/ALKAP - KSPARSE(1, 291)=24 - KSPARSE(2, 291)=33 + KSPARSE(1, 299)=25 + KSPARSE(2, 299)=34 !KET/ALKEP - KSPARSE(1, 292)=24 - KSPARSE(2, 292)=34 + KSPARSE(1, 300)=25 + KSPARSE(2, 300)=35 !KET/BIOP - KSPARSE(1, 293)=24 - KSPARSE(2, 293)=35 + KSPARSE(1, 301)=25 + KSPARSE(2, 301)=36 !KET/CARBOP - KSPARSE(1, 294)=24 - KSPARSE(2, 294)=39 + KSPARSE(1, 302)=25 + KSPARSE(2, 302)=40 !KET/OLN - KSPARSE(1, 295)=24 - KSPARSE(2, 295)=40 + KSPARSE(1, 303)=25 + KSPARSE(2, 303)=41 !CARBO/O3 - KSPARSE(1, 296)=25 - KSPARSE(2, 296)=1 + KSPARSE(1, 304)=26 + KSPARSE(2, 304)=1 !CARBO/NO - KSPARSE(1, 297)=25 - KSPARSE(2, 297)=3 + KSPARSE(1, 305)=26 + KSPARSE(2, 305)=3 !CARBO/NO3 - KSPARSE(1, 298)=25 - KSPARSE(2, 298)=5 + KSPARSE(1, 306)=26 + KSPARSE(2, 306)=5 !CARBO/OH - KSPARSE(1, 299)=25 - KSPARSE(2, 299)=14 + KSPARSE(1, 307)=26 + KSPARSE(2, 307)=15 !CARBO/ALKA - KSPARSE(1, 300)=25 - KSPARSE(2, 300)=18 + KSPARSE(1, 308)=26 + KSPARSE(2, 308)=19 !CARBO/ALKE - KSPARSE(1, 301)=25 - KSPARSE(2, 301)=19 + KSPARSE(1, 309)=26 + KSPARSE(2, 309)=20 !CARBO/BIO - KSPARSE(1, 302)=25 - KSPARSE(2, 302)=20 + KSPARSE(1, 310)=26 + KSPARSE(2, 310)=21 !CARBO/CARBO - KSPARSE(1, 303)=25 - KSPARSE(2, 303)=25 + KSPARSE(1, 311)=26 + KSPARSE(2, 311)=26 !CARBO/PAN - KSPARSE(1, 304)=25 - KSPARSE(2, 304)=27 + KSPARSE(1, 312)=26 + KSPARSE(2, 312)=28 !CARBO/MO2 - KSPARSE(1, 305)=25 - KSPARSE(2, 305)=32 + KSPARSE(1, 313)=26 + KSPARSE(2, 313)=33 !CARBO/ALKAP - KSPARSE(1, 306)=25 - KSPARSE(2, 306)=33 + KSPARSE(1, 314)=26 + KSPARSE(2, 314)=34 !CARBO/BIOP - KSPARSE(1, 307)=25 - KSPARSE(2, 307)=35 + KSPARSE(1, 315)=26 + KSPARSE(2, 315)=36 !CARBO/AROP - KSPARSE(1, 308)=25 - KSPARSE(2, 308)=38 + KSPARSE(1, 316)=26 + KSPARSE(2, 316)=39 !CARBO/CARBOP - KSPARSE(1, 309)=25 - KSPARSE(2, 309)=39 + KSPARSE(1, 317)=26 + KSPARSE(2, 317)=40 !ONIT/NO - KSPARSE(1, 310)=26 - KSPARSE(2, 310)=3 + KSPARSE(1, 318)=27 + KSPARSE(2, 318)=3 !ONIT/NO2 - KSPARSE(1, 311)=26 - KSPARSE(2, 311)=4 + KSPARSE(1, 319)=27 + KSPARSE(2, 319)=4 !ONIT/NO3 - KSPARSE(1, 312)=26 - KSPARSE(2, 312)=5 + KSPARSE(1, 320)=27 + KSPARSE(2, 320)=5 !ONIT/OH - KSPARSE(1, 313)=26 - KSPARSE(2, 313)=14 + KSPARSE(1, 321)=27 + KSPARSE(2, 321)=15 !ONIT/HO2 - KSPARSE(1, 314)=26 - KSPARSE(2, 314)=15 + KSPARSE(1, 322)=27 + KSPARSE(2, 322)=16 !ONIT/ONIT - KSPARSE(1, 315)=26 - KSPARSE(2, 315)=26 + KSPARSE(1, 323)=27 + KSPARSE(2, 323)=27 !ONIT/PAN - KSPARSE(1, 316)=26 - KSPARSE(2, 316)=27 + KSPARSE(1, 324)=27 + KSPARSE(2, 324)=28 !ONIT/MO2 - KSPARSE(1, 317)=26 - KSPARSE(2, 317)=32 + KSPARSE(1, 325)=27 + KSPARSE(2, 325)=33 !ONIT/ALKAP - KSPARSE(1, 318)=26 - KSPARSE(2, 318)=33 + KSPARSE(1, 326)=27 + KSPARSE(2, 326)=34 !ONIT/BIOP - KSPARSE(1, 319)=26 - KSPARSE(2, 319)=35 + KSPARSE(1, 327)=27 + KSPARSE(2, 327)=36 !ONIT/PHO - KSPARSE(1, 320)=26 - KSPARSE(2, 320)=36 + KSPARSE(1, 328)=27 + KSPARSE(2, 328)=37 !ONIT/AROP - KSPARSE(1, 321)=26 - KSPARSE(2, 321)=38 + KSPARSE(1, 329)=27 + KSPARSE(2, 329)=39 !ONIT/CARBOP - KSPARSE(1, 322)=26 - KSPARSE(2, 322)=39 + KSPARSE(1, 330)=27 + KSPARSE(2, 330)=40 !ONIT/OLN - KSPARSE(1, 323)=26 - KSPARSE(2, 323)=40 + KSPARSE(1, 331)=27 + KSPARSE(2, 331)=41 !PAN/O3 - KSPARSE(1, 324)=27 - KSPARSE(2, 324)=1 + KSPARSE(1, 332)=28 + KSPARSE(2, 332)=1 !PAN/NO2 - KSPARSE(1, 325)=27 - KSPARSE(2, 325)=4 + KSPARSE(1, 333)=28 + KSPARSE(2, 333)=4 !PAN/NO3 - KSPARSE(1, 326)=27 - KSPARSE(2, 326)=5 + KSPARSE(1, 334)=28 + KSPARSE(2, 334)=5 !PAN/OH - KSPARSE(1, 327)=27 - KSPARSE(2, 327)=14 + KSPARSE(1, 335)=28 + KSPARSE(2, 335)=15 !PAN/PAN - KSPARSE(1, 328)=27 - KSPARSE(2, 328)=27 + KSPARSE(1, 336)=28 + KSPARSE(2, 336)=28 !PAN/CARBOP - KSPARSE(1, 329)=27 - KSPARSE(2, 329)=39 + KSPARSE(1, 337)=28 + KSPARSE(2, 337)=40 !OP1/OH - KSPARSE(1, 330)=28 - KSPARSE(2, 330)=14 + KSPARSE(1, 338)=29 + KSPARSE(2, 338)=15 !OP1/HO2 - KSPARSE(1, 331)=28 - KSPARSE(2, 331)=15 + KSPARSE(1, 339)=29 + KSPARSE(2, 339)=16 !OP1/OP1 - KSPARSE(1, 332)=28 - KSPARSE(2, 332)=28 + KSPARSE(1, 340)=29 + KSPARSE(2, 340)=29 !OP1/MO2 - KSPARSE(1, 333)=28 - KSPARSE(2, 333)=32 + KSPARSE(1, 341)=29 + KSPARSE(2, 341)=33 !OP1/WC_OP1 - KSPARSE(1, 334)=28 - KSPARSE(2, 334)=61 + KSPARSE(1, 342)=29 + KSPARSE(2, 342)=62 !OP1/WR_OP1 - KSPARSE(1, 335)=28 - KSPARSE(2, 335)=86 + KSPARSE(1, 343)=29 + KSPARSE(2, 343)=87 !OP2/O3 - KSPARSE(1, 336)=29 - KSPARSE(2, 336)=1 + KSPARSE(1, 344)=30 + KSPARSE(2, 344)=1 !OP2/OH - KSPARSE(1, 337)=29 - KSPARSE(2, 337)=14 + KSPARSE(1, 345)=30 + KSPARSE(2, 345)=15 !OP2/HO2 - KSPARSE(1, 338)=29 - KSPARSE(2, 338)=15 + KSPARSE(1, 346)=30 + KSPARSE(2, 346)=16 !OP2/CARBO - KSPARSE(1, 339)=29 - KSPARSE(2, 339)=25 + KSPARSE(1, 347)=30 + KSPARSE(2, 347)=26 !OP2/OP2 - KSPARSE(1, 340)=29 - KSPARSE(2, 340)=29 + KSPARSE(1, 348)=30 + KSPARSE(2, 348)=30 !OP2/ALKAP - KSPARSE(1, 341)=29 - KSPARSE(2, 341)=33 + KSPARSE(1, 349)=30 + KSPARSE(2, 349)=34 !OP2/ALKEP - KSPARSE(1, 342)=29 - KSPARSE(2, 342)=34 + KSPARSE(1, 350)=30 + KSPARSE(2, 350)=35 !OP2/BIOP - KSPARSE(1, 343)=29 - KSPARSE(2, 343)=35 + KSPARSE(1, 351)=30 + KSPARSE(2, 351)=36 !OP2/AROP - KSPARSE(1, 344)=29 - KSPARSE(2, 344)=38 + KSPARSE(1, 352)=30 + KSPARSE(2, 352)=39 !OP2/CARBOP - KSPARSE(1, 345)=29 - KSPARSE(2, 345)=39 + KSPARSE(1, 353)=30 + KSPARSE(2, 353)=40 !OP2/XO2 - KSPARSE(1, 346)=29 - KSPARSE(2, 346)=41 + KSPARSE(1, 354)=30 + KSPARSE(2, 354)=42 !ORA1/O3 - KSPARSE(1, 347)=30 - KSPARSE(2, 347)=1 + KSPARSE(1, 355)=31 + KSPARSE(2, 355)=1 !ORA1/OH - KSPARSE(1, 348)=30 - KSPARSE(2, 348)=14 + KSPARSE(1, 356)=31 + KSPARSE(2, 356)=15 !ORA1/ALKA - KSPARSE(1, 349)=30 - KSPARSE(2, 349)=18 + KSPARSE(1, 357)=31 + KSPARSE(2, 357)=19 !ORA1/ALKE - KSPARSE(1, 350)=30 - KSPARSE(2, 350)=19 + KSPARSE(1, 358)=31 + KSPARSE(2, 358)=20 !ORA1/BIO - KSPARSE(1, 351)=30 - KSPARSE(2, 351)=20 + KSPARSE(1, 359)=31 + KSPARSE(2, 359)=21 !ORA1/CARBO - KSPARSE(1, 352)=30 - KSPARSE(2, 352)=25 + KSPARSE(1, 360)=31 + KSPARSE(2, 360)=26 !ORA1/PAN - KSPARSE(1, 353)=30 - KSPARSE(2, 353)=27 + KSPARSE(1, 361)=31 + KSPARSE(2, 361)=28 !ORA1/ORA1 - KSPARSE(1, 354)=30 - KSPARSE(2, 354)=30 + KSPARSE(1, 362)=31 + KSPARSE(2, 362)=31 !ORA1/WC_ORA1 - KSPARSE(1, 355)=30 - KSPARSE(2, 355)=58 + KSPARSE(1, 363)=31 + KSPARSE(2, 363)=59 !ORA1/WR_ORA1 - KSPARSE(1, 356)=30 - KSPARSE(2, 356)=83 + KSPARSE(1, 364)=31 + KSPARSE(2, 364)=84 !ORA2/O3 - KSPARSE(1, 357)=31 - KSPARSE(2, 357)=1 + KSPARSE(1, 365)=32 + KSPARSE(2, 365)=1 !ORA2/OH - KSPARSE(1, 358)=31 - KSPARSE(2, 358)=14 + KSPARSE(1, 366)=32 + KSPARSE(2, 366)=15 !ORA2/HO2 - KSPARSE(1, 359)=31 - KSPARSE(2, 359)=15 + KSPARSE(1, 367)=32 + KSPARSE(2, 367)=16 !ORA2/ALKE - KSPARSE(1, 360)=31 - KSPARSE(2, 360)=19 + KSPARSE(1, 368)=32 + KSPARSE(2, 368)=20 !ORA2/BIO - KSPARSE(1, 361)=31 - KSPARSE(2, 361)=20 + KSPARSE(1, 369)=32 + KSPARSE(2, 369)=21 !ORA2/CARBO - KSPARSE(1, 362)=31 - KSPARSE(2, 362)=25 + KSPARSE(1, 370)=32 + KSPARSE(2, 370)=26 !ORA2/ORA2 - KSPARSE(1, 363)=31 - KSPARSE(2, 363)=31 + KSPARSE(1, 371)=32 + KSPARSE(2, 371)=32 !ORA2/MO2 - KSPARSE(1, 364)=31 - KSPARSE(2, 364)=32 + KSPARSE(1, 372)=32 + KSPARSE(2, 372)=33 !ORA2/ALKAP - KSPARSE(1, 365)=31 - KSPARSE(2, 365)=33 + KSPARSE(1, 373)=32 + KSPARSE(2, 373)=34 !ORA2/ALKEP - KSPARSE(1, 366)=31 - KSPARSE(2, 366)=34 + KSPARSE(1, 374)=32 + KSPARSE(2, 374)=35 !ORA2/BIOP - KSPARSE(1, 367)=31 - KSPARSE(2, 367)=35 + KSPARSE(1, 375)=32 + KSPARSE(2, 375)=36 !ORA2/CARBOP - KSPARSE(1, 368)=31 - KSPARSE(2, 368)=39 + KSPARSE(1, 376)=32 + KSPARSE(2, 376)=40 !ORA2/OLN - KSPARSE(1, 369)=31 - KSPARSE(2, 369)=40 + KSPARSE(1, 377)=32 + KSPARSE(2, 377)=41 !ORA2/WC_ORA2 - KSPARSE(1, 370)=31 - KSPARSE(2, 370)=59 + KSPARSE(1, 378)=32 + KSPARSE(2, 378)=60 !ORA2/WR_ORA2 - KSPARSE(1, 371)=31 - KSPARSE(2, 371)=84 + KSPARSE(1, 379)=32 + KSPARSE(2, 379)=85 !MO2/O3 - KSPARSE(1, 372)=32 - KSPARSE(2, 372)=1 + KSPARSE(1, 380)=33 + KSPARSE(2, 380)=1 !MO2/NO - KSPARSE(1, 373)=32 - KSPARSE(2, 373)=3 + KSPARSE(1, 381)=33 + KSPARSE(2, 381)=3 !MO2/NO3 - KSPARSE(1, 374)=32 - KSPARSE(2, 374)=5 + KSPARSE(1, 382)=33 + KSPARSE(2, 382)=5 !MO2/OH - KSPARSE(1, 375)=32 - KSPARSE(2, 375)=14 + KSPARSE(1, 383)=33 + KSPARSE(2, 383)=15 !MO2/HO2 - KSPARSE(1, 376)=32 - KSPARSE(2, 376)=15 + KSPARSE(1, 384)=33 + KSPARSE(2, 384)=16 !MO2/CH4 - KSPARSE(1, 377)=32 - KSPARSE(2, 377)=16 + KSPARSE(1, 385)=33 + KSPARSE(2, 385)=17 !MO2/ALKE - KSPARSE(1, 378)=32 - KSPARSE(2, 378)=19 + KSPARSE(1, 386)=33 + KSPARSE(2, 386)=20 !MO2/BIO - KSPARSE(1, 379)=32 - KSPARSE(2, 379)=20 + KSPARSE(1, 387)=33 + KSPARSE(2, 387)=21 !MO2/ALD - KSPARSE(1, 380)=32 - KSPARSE(2, 380)=23 + KSPARSE(1, 388)=33 + KSPARSE(2, 388)=24 !MO2/OP1 - KSPARSE(1, 381)=32 - KSPARSE(2, 381)=28 + KSPARSE(1, 389)=33 + KSPARSE(2, 389)=29 !MO2/OP2 - KSPARSE(1, 382)=32 - KSPARSE(2, 382)=29 + KSPARSE(1, 390)=33 + KSPARSE(2, 390)=30 !MO2/MO2 - KSPARSE(1, 383)=32 - KSPARSE(2, 383)=32 + KSPARSE(1, 391)=33 + KSPARSE(2, 391)=33 !MO2/ALKAP - KSPARSE(1, 384)=32 - KSPARSE(2, 384)=33 + KSPARSE(1, 392)=33 + KSPARSE(2, 392)=34 !MO2/ALKEP - KSPARSE(1, 385)=32 - KSPARSE(2, 385)=34 + KSPARSE(1, 393)=33 + KSPARSE(2, 393)=35 !MO2/BIOP - KSPARSE(1, 386)=32 - KSPARSE(2, 386)=35 + KSPARSE(1, 394)=33 + KSPARSE(2, 394)=36 !MO2/AROP - KSPARSE(1, 387)=32 - KSPARSE(2, 387)=38 + KSPARSE(1, 395)=33 + KSPARSE(2, 395)=39 !MO2/CARBOP - KSPARSE(1, 388)=32 - KSPARSE(2, 388)=39 + KSPARSE(1, 396)=33 + KSPARSE(2, 396)=40 !MO2/OLN - KSPARSE(1, 389)=32 - KSPARSE(2, 389)=40 + KSPARSE(1, 397)=33 + KSPARSE(2, 397)=41 !MO2/XO2 - KSPARSE(1, 390)=32 - KSPARSE(2, 390)=41 + KSPARSE(1, 398)=33 + KSPARSE(2, 398)=42 !MO2/WC_MO2 - KSPARSE(1, 391)=32 - KSPARSE(2, 391)=60 + KSPARSE(1, 399)=33 + KSPARSE(2, 399)=61 !MO2/WR_MO2 - KSPARSE(1, 392)=32 - KSPARSE(2, 392)=85 + KSPARSE(1, 400)=33 + KSPARSE(2, 400)=86 !ALKAP/O3 - KSPARSE(1, 393)=33 - KSPARSE(2, 393)=1 + KSPARSE(1, 401)=34 + KSPARSE(2, 401)=1 !ALKAP/NO - KSPARSE(1, 394)=33 - KSPARSE(2, 394)=3 + KSPARSE(1, 402)=34 + KSPARSE(2, 402)=3 !ALKAP/NO3 - KSPARSE(1, 395)=33 - KSPARSE(2, 395)=5 + KSPARSE(1, 403)=34 + KSPARSE(2, 403)=5 !ALKAP/OH - KSPARSE(1, 396)=33 - KSPARSE(2, 396)=14 + KSPARSE(1, 404)=34 + KSPARSE(2, 404)=15 !ALKAP/HO2 - KSPARSE(1, 397)=33 - KSPARSE(2, 397)=15 + KSPARSE(1, 405)=34 + KSPARSE(2, 405)=16 !ALKAP/ETH - KSPARSE(1, 398)=33 - KSPARSE(2, 398)=17 + KSPARSE(1, 406)=34 + KSPARSE(2, 406)=18 !ALKAP/ALKA - KSPARSE(1, 399)=33 - KSPARSE(2, 399)=18 + KSPARSE(1, 407)=34 + KSPARSE(2, 407)=19 !ALKAP/ALKE - KSPARSE(1, 400)=33 - KSPARSE(2, 400)=19 + KSPARSE(1, 408)=34 + KSPARSE(2, 408)=20 !ALKAP/BIO - KSPARSE(1, 401)=33 - KSPARSE(2, 401)=20 + KSPARSE(1, 409)=34 + KSPARSE(2, 409)=21 !ALKAP/KET - KSPARSE(1, 402)=33 - KSPARSE(2, 402)=24 + KSPARSE(1, 410)=34 + KSPARSE(2, 410)=25 !ALKAP/ONIT - KSPARSE(1, 403)=33 - KSPARSE(2, 403)=26 + KSPARSE(1, 411)=34 + KSPARSE(2, 411)=27 !ALKAP/OP2 - KSPARSE(1, 404)=33 - KSPARSE(2, 404)=29 + KSPARSE(1, 412)=34 + KSPARSE(2, 412)=30 !ALKAP/MO2 - KSPARSE(1, 405)=33 - KSPARSE(2, 405)=32 + KSPARSE(1, 413)=34 + KSPARSE(2, 413)=33 !ALKAP/ALKAP - KSPARSE(1, 406)=33 - KSPARSE(2, 406)=33 + KSPARSE(1, 414)=34 + KSPARSE(2, 414)=34 !ALKAP/CARBOP - KSPARSE(1, 407)=33 - KSPARSE(2, 407)=39 + KSPARSE(1, 415)=34 + KSPARSE(2, 415)=40 !ALKEP/NO - KSPARSE(1, 408)=34 - KSPARSE(2, 408)=3 + KSPARSE(1, 416)=35 + KSPARSE(2, 416)=3 !ALKEP/NO3 - KSPARSE(1, 409)=34 - KSPARSE(2, 409)=5 + KSPARSE(1, 417)=35 + KSPARSE(2, 417)=5 !ALKEP/OH - KSPARSE(1, 410)=34 - KSPARSE(2, 410)=14 + KSPARSE(1, 418)=35 + KSPARSE(2, 418)=15 !ALKEP/HO2 - KSPARSE(1, 411)=34 - KSPARSE(2, 411)=15 + KSPARSE(1, 419)=35 + KSPARSE(2, 419)=16 !ALKEP/ALKE - KSPARSE(1, 412)=34 - KSPARSE(2, 412)=19 + KSPARSE(1, 420)=35 + KSPARSE(2, 420)=20 !ALKEP/MO2 - KSPARSE(1, 413)=34 - KSPARSE(2, 413)=32 + KSPARSE(1, 421)=35 + KSPARSE(2, 421)=33 !ALKEP/ALKEP - KSPARSE(1, 414)=34 - KSPARSE(2, 414)=34 + KSPARSE(1, 422)=35 + KSPARSE(2, 422)=35 !ALKEP/CARBOP - KSPARSE(1, 415)=34 - KSPARSE(2, 415)=39 + KSPARSE(1, 423)=35 + KSPARSE(2, 423)=40 !BIOP/NO - KSPARSE(1, 416)=35 - KSPARSE(2, 416)=3 + KSPARSE(1, 424)=36 + KSPARSE(2, 424)=3 !BIOP/NO3 - KSPARSE(1, 417)=35 - KSPARSE(2, 417)=5 + KSPARSE(1, 425)=36 + KSPARSE(2, 425)=5 !BIOP/OH - KSPARSE(1, 418)=35 - KSPARSE(2, 418)=14 + KSPARSE(1, 426)=36 + KSPARSE(2, 426)=15 !BIOP/HO2 - KSPARSE(1, 419)=35 - KSPARSE(2, 419)=15 + KSPARSE(1, 427)=36 + KSPARSE(2, 427)=16 !BIOP/ALKE - KSPARSE(1, 420)=35 - KSPARSE(2, 420)=19 + KSPARSE(1, 428)=36 + KSPARSE(2, 428)=20 !BIOP/BIO - KSPARSE(1, 421)=35 - KSPARSE(2, 421)=20 + KSPARSE(1, 429)=36 + KSPARSE(2, 429)=21 !BIOP/MO2 - KSPARSE(1, 422)=35 - KSPARSE(2, 422)=32 + KSPARSE(1, 430)=36 + KSPARSE(2, 430)=33 !BIOP/BIOP - KSPARSE(1, 423)=35 - KSPARSE(2, 423)=35 + KSPARSE(1, 431)=36 + KSPARSE(2, 431)=36 !BIOP/CARBOP - KSPARSE(1, 424)=35 - KSPARSE(2, 424)=39 + KSPARSE(1, 432)=36 + KSPARSE(2, 432)=40 !PHO/NO2 - KSPARSE(1, 425)=36 - KSPARSE(2, 425)=4 + KSPARSE(1, 433)=37 + KSPARSE(2, 433)=4 !PHO/NO3 - KSPARSE(1, 426)=36 - KSPARSE(2, 426)=5 + KSPARSE(1, 434)=37 + KSPARSE(2, 434)=5 !PHO/OH - KSPARSE(1, 427)=36 - KSPARSE(2, 427)=14 + KSPARSE(1, 435)=37 + KSPARSE(2, 435)=15 !PHO/HO2 - KSPARSE(1, 428)=36 - KSPARSE(2, 428)=15 + KSPARSE(1, 436)=37 + KSPARSE(2, 436)=16 !PHO/ARO - KSPARSE(1, 429)=36 - KSPARSE(2, 429)=21 + KSPARSE(1, 437)=37 + KSPARSE(2, 437)=22 !PHO/PHO - KSPARSE(1, 430)=36 - KSPARSE(2, 430)=36 + KSPARSE(1, 438)=37 + KSPARSE(2, 438)=37 !ADD/O3 - KSPARSE(1, 431)=37 - KSPARSE(2, 431)=1 + KSPARSE(1, 439)=38 + KSPARSE(2, 439)=1 !ADD/NO2 - KSPARSE(1, 432)=37 - KSPARSE(2, 432)=4 + KSPARSE(1, 440)=38 + KSPARSE(2, 440)=4 !ADD/OH - KSPARSE(1, 433)=37 - KSPARSE(2, 433)=14 + KSPARSE(1, 441)=38 + KSPARSE(2, 441)=15 !ADD/ARO - KSPARSE(1, 434)=37 - KSPARSE(2, 434)=21 + KSPARSE(1, 442)=38 + KSPARSE(2, 442)=22 !ADD/ADD - KSPARSE(1, 435)=37 - KSPARSE(2, 435)=37 + KSPARSE(1, 443)=38 + KSPARSE(2, 443)=38 !AROP/NO - KSPARSE(1, 436)=38 - KSPARSE(2, 436)=3 + KSPARSE(1, 444)=39 + KSPARSE(2, 444)=3 !AROP/NO3 - KSPARSE(1, 437)=38 - KSPARSE(2, 437)=5 + KSPARSE(1, 445)=39 + KSPARSE(2, 445)=5 !AROP/HO2 - KSPARSE(1, 438)=38 - KSPARSE(2, 438)=15 + KSPARSE(1, 446)=39 + KSPARSE(2, 446)=16 !AROP/MO2 - KSPARSE(1, 439)=38 - KSPARSE(2, 439)=32 + KSPARSE(1, 447)=39 + KSPARSE(2, 447)=33 !AROP/ADD - KSPARSE(1, 440)=38 - KSPARSE(2, 440)=37 + KSPARSE(1, 448)=39 + KSPARSE(2, 448)=38 !AROP/AROP - KSPARSE(1, 441)=38 - KSPARSE(2, 441)=38 + KSPARSE(1, 449)=39 + KSPARSE(2, 449)=39 !AROP/CARBOP - KSPARSE(1, 442)=38 - KSPARSE(2, 442)=39 + KSPARSE(1, 450)=39 + KSPARSE(2, 450)=40 !CARBOP/O3 - KSPARSE(1, 443)=39 - KSPARSE(2, 443)=1 + KSPARSE(1, 451)=40 + KSPARSE(2, 451)=1 !CARBOP/NO - KSPARSE(1, 444)=39 - KSPARSE(2, 444)=3 + KSPARSE(1, 452)=40 + KSPARSE(2, 452)=3 !CARBOP/NO2 - KSPARSE(1, 445)=39 - KSPARSE(2, 445)=4 + KSPARSE(1, 453)=40 + KSPARSE(2, 453)=4 !CARBOP/NO3 - KSPARSE(1, 446)=39 - KSPARSE(2, 446)=5 + KSPARSE(1, 454)=40 + KSPARSE(2, 454)=5 !CARBOP/OH - KSPARSE(1, 447)=39 - KSPARSE(2, 447)=14 + KSPARSE(1, 455)=40 + KSPARSE(2, 455)=15 !CARBOP/HO2 - KSPARSE(1, 448)=39 - KSPARSE(2, 448)=15 + KSPARSE(1, 456)=40 + KSPARSE(2, 456)=16 !CARBOP/ALKE - KSPARSE(1, 449)=39 - KSPARSE(2, 449)=19 + KSPARSE(1, 457)=40 + KSPARSE(2, 457)=20 !CARBOP/BIO - KSPARSE(1, 450)=39 - KSPARSE(2, 450)=20 + KSPARSE(1, 458)=40 + KSPARSE(2, 458)=21 !CARBOP/ALD - KSPARSE(1, 451)=39 - KSPARSE(2, 451)=23 + KSPARSE(1, 459)=40 + KSPARSE(2, 459)=24 !CARBOP/KET - KSPARSE(1, 452)=39 - KSPARSE(2, 452)=24 + KSPARSE(1, 460)=40 + KSPARSE(2, 460)=25 !CARBOP/CARBO - KSPARSE(1, 453)=39 - KSPARSE(2, 453)=25 + KSPARSE(1, 461)=40 + KSPARSE(2, 461)=26 !CARBOP/PAN - KSPARSE(1, 454)=39 - KSPARSE(2, 454)=27 + KSPARSE(1, 462)=40 + KSPARSE(2, 462)=28 !CARBOP/OP2 - KSPARSE(1, 455)=39 - KSPARSE(2, 455)=29 + KSPARSE(1, 463)=40 + KSPARSE(2, 463)=30 !CARBOP/MO2 - KSPARSE(1, 456)=39 - KSPARSE(2, 456)=32 + KSPARSE(1, 464)=40 + KSPARSE(2, 464)=33 !CARBOP/ALKAP - KSPARSE(1, 457)=39 - KSPARSE(2, 457)=33 + KSPARSE(1, 465)=40 + KSPARSE(2, 465)=34 !CARBOP/ALKEP - KSPARSE(1, 458)=39 - KSPARSE(2, 458)=34 + KSPARSE(1, 466)=40 + KSPARSE(2, 466)=35 !CARBOP/BIOP - KSPARSE(1, 459)=39 - KSPARSE(2, 459)=35 + KSPARSE(1, 467)=40 + KSPARSE(2, 467)=36 !CARBOP/AROP - KSPARSE(1, 460)=39 - KSPARSE(2, 460)=38 + KSPARSE(1, 468)=40 + KSPARSE(2, 468)=39 !CARBOP/CARBOP - KSPARSE(1, 461)=39 - KSPARSE(2, 461)=39 + KSPARSE(1, 469)=40 + KSPARSE(2, 469)=40 !CARBOP/OLN - KSPARSE(1, 462)=39 - KSPARSE(2, 462)=40 + KSPARSE(1, 470)=40 + KSPARSE(2, 470)=41 !CARBOP/XO2 - KSPARSE(1, 463)=39 - KSPARSE(2, 463)=41 + KSPARSE(1, 471)=40 + KSPARSE(2, 471)=42 !OLN/NO - KSPARSE(1, 464)=40 - KSPARSE(2, 464)=3 + KSPARSE(1, 472)=41 + KSPARSE(2, 472)=3 !OLN/NO3 - KSPARSE(1, 465)=40 - KSPARSE(2, 465)=5 + KSPARSE(1, 473)=41 + KSPARSE(2, 473)=5 !OLN/HO2 - KSPARSE(1, 466)=40 - KSPARSE(2, 466)=15 + KSPARSE(1, 474)=41 + KSPARSE(2, 474)=16 !OLN/ALKE - KSPARSE(1, 467)=40 - KSPARSE(2, 467)=19 + KSPARSE(1, 475)=41 + KSPARSE(2, 475)=20 !OLN/BIO - KSPARSE(1, 468)=40 - KSPARSE(2, 468)=20 + KSPARSE(1, 476)=41 + KSPARSE(2, 476)=21 !OLN/CARBO - KSPARSE(1, 469)=40 - KSPARSE(2, 469)=25 + KSPARSE(1, 477)=41 + KSPARSE(2, 477)=26 !OLN/MO2 - KSPARSE(1, 470)=40 - KSPARSE(2, 470)=32 + KSPARSE(1, 478)=41 + KSPARSE(2, 478)=33 !OLN/CARBOP - KSPARSE(1, 471)=40 - KSPARSE(2, 471)=39 + KSPARSE(1, 479)=41 + KSPARSE(2, 479)=40 !OLN/OLN - KSPARSE(1, 472)=40 - KSPARSE(2, 472)=40 + KSPARSE(1, 480)=41 + KSPARSE(2, 480)=41 !XO2/O3 - KSPARSE(1, 473)=41 - KSPARSE(2, 473)=1 + KSPARSE(1, 481)=42 + KSPARSE(2, 481)=1 !XO2/NO - KSPARSE(1, 474)=41 - KSPARSE(2, 474)=3 + KSPARSE(1, 482)=42 + KSPARSE(2, 482)=3 !XO2/NO3 - KSPARSE(1, 475)=41 - KSPARSE(2, 475)=5 + KSPARSE(1, 483)=42 + KSPARSE(2, 483)=5 !XO2/OH - KSPARSE(1, 476)=41 - KSPARSE(2, 476)=14 + KSPARSE(1, 484)=42 + KSPARSE(2, 484)=15 !XO2/HO2 - KSPARSE(1, 477)=41 - KSPARSE(2, 477)=15 + KSPARSE(1, 485)=42 + KSPARSE(2, 485)=16 !XO2/ALKE - KSPARSE(1, 478)=41 - KSPARSE(2, 478)=19 + KSPARSE(1, 486)=42 + KSPARSE(2, 486)=20 !XO2/BIO - KSPARSE(1, 479)=41 - KSPARSE(2, 479)=20 + KSPARSE(1, 487)=42 + KSPARSE(2, 487)=21 !XO2/ARO - KSPARSE(1, 480)=41 - KSPARSE(2, 480)=21 + KSPARSE(1, 488)=42 + KSPARSE(2, 488)=22 !XO2/CARBO - KSPARSE(1, 481)=41 - KSPARSE(2, 481)=25 + KSPARSE(1, 489)=42 + KSPARSE(2, 489)=26 !XO2/PAN - KSPARSE(1, 482)=41 - KSPARSE(2, 482)=27 + KSPARSE(1, 490)=42 + KSPARSE(2, 490)=28 !XO2/OP2 - KSPARSE(1, 483)=41 - KSPARSE(2, 483)=29 + KSPARSE(1, 491)=42 + KSPARSE(2, 491)=30 !XO2/MO2 - KSPARSE(1, 484)=41 - KSPARSE(2, 484)=32 + KSPARSE(1, 492)=42 + KSPARSE(2, 492)=33 !XO2/ALKAP - KSPARSE(1, 485)=41 - KSPARSE(2, 485)=33 + KSPARSE(1, 493)=42 + KSPARSE(2, 493)=34 !XO2/CARBOP - KSPARSE(1, 486)=41 - KSPARSE(2, 486)=39 + KSPARSE(1, 494)=42 + KSPARSE(2, 494)=40 !XO2/XO2 - KSPARSE(1, 487)=41 - KSPARSE(2, 487)=41 + KSPARSE(1, 495)=42 + KSPARSE(2, 495)=42 !WC_O3/O3 - KSPARSE(1, 488)=42 - KSPARSE(2, 488)=1 + KSPARSE(1, 496)=43 + KSPARSE(2, 496)=1 !WC_O3/WC_O3 - KSPARSE(1, 489)=42 - KSPARSE(2, 489)=42 + KSPARSE(1, 497)=43 + KSPARSE(2, 497)=43 !WC_O3/WC_HO2 - KSPARSE(1, 490)=42 - KSPARSE(2, 490)=53 + KSPARSE(1, 498)=43 + KSPARSE(2, 498)=54 !WC_O3/WC_SO2 - KSPARSE(1, 491)=42 - KSPARSE(2, 491)=55 + KSPARSE(1, 499)=43 + KSPARSE(2, 499)=56 !WC_H2O2/H2O2 - KSPARSE(1, 492)=43 - KSPARSE(2, 492)=2 + KSPARSE(1, 500)=44 + KSPARSE(2, 500)=2 !WC_H2O2/WC_H2O2 - KSPARSE(1, 493)=43 - KSPARSE(2, 493)=43 + KSPARSE(1, 501)=44 + KSPARSE(2, 501)=44 !WC_H2O2/WC_OH - KSPARSE(1, 494)=43 - KSPARSE(2, 494)=52 + KSPARSE(1, 502)=44 + KSPARSE(2, 502)=53 !WC_H2O2/WC_HO2 - KSPARSE(1, 495)=43 - KSPARSE(2, 495)=53 + KSPARSE(1, 503)=44 + KSPARSE(2, 503)=54 !WC_H2O2/WC_SO2 - KSPARSE(1, 496)=43 - KSPARSE(2, 496)=55 + KSPARSE(1, 504)=44 + KSPARSE(2, 504)=56 !WC_NO/NO - KSPARSE(1, 497)=44 - KSPARSE(2, 497)=3 + KSPARSE(1, 505)=45 + KSPARSE(2, 505)=3 !WC_NO/WC_NO - KSPARSE(1, 498)=44 - KSPARSE(2, 498)=44 + KSPARSE(1, 506)=45 + KSPARSE(2, 506)=45 !WC_NO2/NO2 - KSPARSE(1, 499)=45 - KSPARSE(2, 499)=4 + KSPARSE(1, 507)=46 + KSPARSE(2, 507)=4 !WC_NO2/WC_NO2 - KSPARSE(1, 500)=45 - KSPARSE(2, 500)=45 + KSPARSE(1, 508)=46 + KSPARSE(2, 508)=46 !WC_NO2/WC_HONO - KSPARSE(1, 501)=45 - KSPARSE(2, 501)=48 + KSPARSE(1, 509)=46 + KSPARSE(2, 509)=49 !WC_NO2/WC_HNO3 - KSPARSE(1, 502)=45 - KSPARSE(2, 502)=49 + KSPARSE(1, 510)=46 + KSPARSE(2, 510)=50 !WC_NO2/WC_HNO4 - KSPARSE(1, 503)=45 - KSPARSE(2, 503)=50 + KSPARSE(1, 511)=46 + KSPARSE(2, 511)=51 !WC_NO2/WC_OH - KSPARSE(1, 504)=45 - KSPARSE(2, 504)=52 + KSPARSE(1, 512)=46 + KSPARSE(2, 512)=53 !WC_NO2/WC_HO2 - KSPARSE(1, 505)=45 - KSPARSE(2, 505)=53 + KSPARSE(1, 513)=46 + KSPARSE(2, 513)=54 !WC_NO3/NO3 - KSPARSE(1, 506)=46 - KSPARSE(2, 506)=5 + KSPARSE(1, 514)=47 + KSPARSE(2, 514)=5 !WC_NO3/WC_NO3 - KSPARSE(1, 507)=46 - KSPARSE(2, 507)=46 + KSPARSE(1, 515)=47 + KSPARSE(2, 515)=47 !WC_NO3/WC_SO2 - KSPARSE(1, 508)=46 - KSPARSE(2, 508)=55 + KSPARSE(1, 516)=47 + KSPARSE(2, 516)=56 !WC_NO3/WC_SULF - KSPARSE(1, 509)=46 - KSPARSE(2, 509)=56 + KSPARSE(1, 517)=47 + KSPARSE(2, 517)=57 !WC_N2O5/N2O5 - KSPARSE(1, 510)=47 - KSPARSE(2, 510)=6 + KSPARSE(1, 518)=48 + KSPARSE(2, 518)=6 !WC_N2O5/WC_N2O5 - KSPARSE(1, 511)=47 - KSPARSE(2, 511)=47 + KSPARSE(1, 519)=48 + KSPARSE(2, 519)=48 !WC_HONO/HONO - KSPARSE(1, 512)=48 - KSPARSE(2, 512)=7 + KSPARSE(1, 520)=49 + KSPARSE(2, 520)=7 !WC_HONO/WC_HONO - KSPARSE(1, 513)=48 - KSPARSE(2, 513)=48 + KSPARSE(1, 521)=49 + KSPARSE(2, 521)=49 !WC_HONO/WC_HNO4 - KSPARSE(1, 514)=48 - KSPARSE(2, 514)=50 + KSPARSE(1, 522)=49 + KSPARSE(2, 522)=51 !WC_HONO/WC_OH - KSPARSE(1, 515)=48 - KSPARSE(2, 515)=52 + KSPARSE(1, 523)=49 + KSPARSE(2, 523)=53 !WC_HNO3/HNO3 - KSPARSE(1, 516)=49 - KSPARSE(2, 516)=8 + KSPARSE(1, 524)=50 + KSPARSE(2, 524)=8 !WC_HNO3/WC_NO3 - KSPARSE(1, 517)=49 - KSPARSE(2, 517)=46 + KSPARSE(1, 525)=50 + KSPARSE(2, 525)=47 !WC_HNO3/WC_N2O5 - KSPARSE(1, 518)=49 - KSPARSE(2, 518)=47 + KSPARSE(1, 526)=50 + KSPARSE(2, 526)=48 !WC_HNO3/WC_HNO3 - KSPARSE(1, 519)=49 - KSPARSE(2, 519)=49 + KSPARSE(1, 527)=50 + KSPARSE(2, 527)=50 !WC_HNO3/WC_HNO4 - KSPARSE(1, 520)=49 - KSPARSE(2, 520)=50 + KSPARSE(1, 528)=50 + KSPARSE(2, 528)=51 !WC_HNO3/WC_SO2 - KSPARSE(1, 521)=49 - KSPARSE(2, 521)=55 + KSPARSE(1, 529)=50 + KSPARSE(2, 529)=56 !WC_HNO3/WC_SULF - KSPARSE(1, 522)=49 - KSPARSE(2, 522)=56 + KSPARSE(1, 530)=50 + KSPARSE(2, 530)=57 !WC_HNO4/HNO4 - KSPARSE(1, 523)=50 - KSPARSE(2, 523)=9 + KSPARSE(1, 531)=51 + KSPARSE(2, 531)=9 !WC_HNO4/WC_NO2 - KSPARSE(1, 524)=50 - KSPARSE(2, 524)=45 + KSPARSE(1, 532)=51 + KSPARSE(2, 532)=46 !WC_HNO4/WC_HNO4 - KSPARSE(1, 525)=50 - KSPARSE(2, 525)=50 + KSPARSE(1, 533)=51 + KSPARSE(2, 533)=51 !WC_HNO4/WC_HO2 - KSPARSE(1, 526)=50 - KSPARSE(2, 526)=53 + KSPARSE(1, 534)=51 + KSPARSE(2, 534)=54 !WC_HNO4/WC_SO2 - KSPARSE(1, 527)=50 - KSPARSE(2, 527)=55 + KSPARSE(1, 535)=51 + KSPARSE(2, 535)=56 !WC_NH3/NH3 - KSPARSE(1, 528)=51 - KSPARSE(2, 528)=10 + KSPARSE(1, 536)=52 + KSPARSE(2, 536)=10 !WC_NH3/WC_NH3 - KSPARSE(1, 529)=51 - KSPARSE(2, 529)=51 + KSPARSE(1, 537)=52 + KSPARSE(2, 537)=52 !WC_OH/OH - KSPARSE(1, 530)=52 - KSPARSE(2, 530)=14 + KSPARSE(1, 538)=53 + KSPARSE(2, 538)=15 !WC_OH/WC_O3 - KSPARSE(1, 531)=52 - KSPARSE(2, 531)=42 + KSPARSE(1, 539)=53 + KSPARSE(2, 539)=43 !WC_OH/WC_H2O2 - KSPARSE(1, 532)=52 - KSPARSE(2, 532)=43 + KSPARSE(1, 540)=53 + KSPARSE(2, 540)=44 !WC_OH/WC_HONO - KSPARSE(1, 533)=52 - KSPARSE(2, 533)=48 + KSPARSE(1, 541)=53 + KSPARSE(2, 541)=49 !WC_OH/WC_HNO3 - KSPARSE(1, 534)=52 - KSPARSE(2, 534)=49 + KSPARSE(1, 542)=53 + KSPARSE(2, 542)=50 !WC_OH/WC_OH - KSPARSE(1, 535)=52 - KSPARSE(2, 535)=52 + KSPARSE(1, 543)=53 + KSPARSE(2, 543)=53 !WC_OH/WC_HO2 - KSPARSE(1, 536)=52 - KSPARSE(2, 536)=53 + KSPARSE(1, 544)=53 + KSPARSE(2, 544)=54 !WC_OH/WC_SO2 - KSPARSE(1, 537)=52 - KSPARSE(2, 537)=55 + KSPARSE(1, 545)=53 + KSPARSE(2, 545)=56 !WC_OH/WC_HCHO - KSPARSE(1, 538)=52 - KSPARSE(2, 538)=57 + KSPARSE(1, 546)=53 + KSPARSE(2, 546)=58 !WC_OH/WC_ORA1 - KSPARSE(1, 539)=52 - KSPARSE(2, 539)=58 + KSPARSE(1, 547)=53 + KSPARSE(2, 547)=59 !WC_OH/WC_ASO4 - KSPARSE(1, 540)=52 - KSPARSE(2, 540)=63 + KSPARSE(1, 548)=53 + KSPARSE(2, 548)=64 !WC_OH/WC_AHMS - KSPARSE(1, 541)=52 - KSPARSE(2, 541)=66 + KSPARSE(1, 549)=53 + KSPARSE(2, 549)=67 !WC_HO2/HO2 - KSPARSE(1, 542)=53 - KSPARSE(2, 542)=15 + KSPARSE(1, 550)=54 + KSPARSE(2, 550)=16 !WC_HO2/WC_O3 - KSPARSE(1, 543)=53 - KSPARSE(2, 543)=42 + KSPARSE(1, 551)=54 + KSPARSE(2, 551)=43 !WC_HO2/WC_H2O2 - KSPARSE(1, 544)=53 - KSPARSE(2, 544)=43 + KSPARSE(1, 552)=54 + KSPARSE(2, 552)=44 !WC_HO2/WC_NO2 - KSPARSE(1, 545)=53 - KSPARSE(2, 545)=45 + KSPARSE(1, 553)=54 + KSPARSE(2, 553)=46 !WC_HO2/WC_HNO4 - KSPARSE(1, 546)=53 - KSPARSE(2, 546)=50 + KSPARSE(1, 554)=54 + KSPARSE(2, 554)=51 !WC_HO2/WC_OH - KSPARSE(1, 547)=53 - KSPARSE(2, 547)=52 + KSPARSE(1, 555)=54 + KSPARSE(2, 555)=53 !WC_HO2/WC_HO2 - KSPARSE(1, 548)=53 - KSPARSE(2, 548)=53 + KSPARSE(1, 556)=54 + KSPARSE(2, 556)=54 !WC_HO2/WC_HCHO - KSPARSE(1, 549)=53 - KSPARSE(2, 549)=57 + KSPARSE(1, 557)=54 + KSPARSE(2, 557)=58 !WC_HO2/WC_ORA1 - KSPARSE(1, 550)=53 - KSPARSE(2, 550)=58 + KSPARSE(1, 558)=54 + KSPARSE(2, 558)=59 !WC_HO2/WC_MO2 - KSPARSE(1, 551)=53 - KSPARSE(2, 551)=60 + KSPARSE(1, 559)=54 + KSPARSE(2, 559)=61 !WC_HO2/WC_ASO5 - KSPARSE(1, 552)=53 - KSPARSE(2, 552)=64 + KSPARSE(1, 560)=54 + KSPARSE(2, 560)=65 !WC_HO2/WC_AHMS - KSPARSE(1, 553)=53 - KSPARSE(2, 553)=66 + KSPARSE(1, 561)=54 + KSPARSE(2, 561)=67 !WC_CO2/WC_OH - KSPARSE(1, 554)=54 - KSPARSE(2, 554)=52 + KSPARSE(1, 562)=55 + KSPARSE(2, 562)=53 !WC_CO2/WC_CO2 - KSPARSE(1, 555)=54 - KSPARSE(2, 555)=54 + KSPARSE(1, 563)=55 + KSPARSE(2, 563)=55 !WC_CO2/WC_ORA1 - KSPARSE(1, 556)=54 - KSPARSE(2, 556)=58 + KSPARSE(1, 564)=55 + KSPARSE(2, 564)=59 !WC_SO2/SO2 - KSPARSE(1, 557)=55 - KSPARSE(2, 557)=11 + KSPARSE(1, 565)=56 + KSPARSE(2, 565)=12 !WC_SO2/WC_O3 - KSPARSE(1, 558)=55 - KSPARSE(2, 558)=42 + KSPARSE(1, 566)=56 + KSPARSE(2, 566)=43 !WC_SO2/WC_H2O2 - KSPARSE(1, 559)=55 - KSPARSE(2, 559)=43 + KSPARSE(1, 567)=56 + KSPARSE(2, 567)=44 !WC_SO2/WC_NO3 - KSPARSE(1, 560)=55 - KSPARSE(2, 560)=46 + KSPARSE(1, 568)=56 + KSPARSE(2, 568)=47 !WC_SO2/WC_HNO4 - KSPARSE(1, 561)=55 - KSPARSE(2, 561)=50 + KSPARSE(1, 569)=56 + KSPARSE(2, 569)=51 !WC_SO2/WC_OH - KSPARSE(1, 562)=55 - KSPARSE(2, 562)=52 + KSPARSE(1, 570)=56 + KSPARSE(2, 570)=53 !WC_SO2/WC_SO2 - KSPARSE(1, 563)=55 - KSPARSE(2, 563)=55 + KSPARSE(1, 571)=56 + KSPARSE(2, 571)=56 !WC_SO2/WC_HCHO - KSPARSE(1, 564)=55 - KSPARSE(2, 564)=57 + KSPARSE(1, 572)=56 + KSPARSE(2, 572)=58 !WC_SO2/WC_MO2 - KSPARSE(1, 565)=55 - KSPARSE(2, 565)=60 + KSPARSE(1, 573)=56 + KSPARSE(2, 573)=61 !WC_SO2/WC_AHSO5 - KSPARSE(1, 566)=55 - KSPARSE(2, 566)=65 + KSPARSE(1, 574)=56 + KSPARSE(2, 574)=66 !WC_SO2/WC_AHMS - KSPARSE(1, 567)=55 - KSPARSE(2, 567)=66 + KSPARSE(1, 575)=56 + KSPARSE(2, 575)=67 !WC_SULF/SULF - KSPARSE(1, 568)=56 - KSPARSE(2, 568)=12 + KSPARSE(1, 576)=57 + KSPARSE(2, 576)=13 !WC_SULF/WC_O3 - KSPARSE(1, 569)=56 - KSPARSE(2, 569)=42 + KSPARSE(1, 577)=57 + KSPARSE(2, 577)=43 !WC_SULF/WC_H2O2 - KSPARSE(1, 570)=56 - KSPARSE(2, 570)=43 + KSPARSE(1, 578)=57 + KSPARSE(2, 578)=44 !WC_SULF/WC_NO3 - KSPARSE(1, 571)=56 - KSPARSE(2, 571)=46 + KSPARSE(1, 579)=57 + KSPARSE(2, 579)=47 !WC_SULF/WC_HNO4 - KSPARSE(1, 572)=56 - KSPARSE(2, 572)=50 + KSPARSE(1, 580)=57 + KSPARSE(2, 580)=51 !WC_SULF/WC_SO2 - KSPARSE(1, 573)=56 - KSPARSE(2, 573)=55 + KSPARSE(1, 581)=57 + KSPARSE(2, 581)=56 !WC_SULF/WC_SULF - KSPARSE(1, 574)=56 - KSPARSE(2, 574)=56 + KSPARSE(1, 582)=57 + KSPARSE(2, 582)=57 !WC_SULF/WC_ASO4 - KSPARSE(1, 575)=56 - KSPARSE(2, 575)=63 + KSPARSE(1, 583)=57 + KSPARSE(2, 583)=64 !WC_SULF/WC_AHSO5 - KSPARSE(1, 576)=56 - KSPARSE(2, 576)=65 + KSPARSE(1, 584)=57 + KSPARSE(2, 584)=66 !WC_HCHO/HCHO - KSPARSE(1, 577)=57 - KSPARSE(2, 577)=22 + KSPARSE(1, 585)=58 + KSPARSE(2, 585)=23 !WC_HCHO/WC_OH - KSPARSE(1, 578)=57 - KSPARSE(2, 578)=52 + KSPARSE(1, 586)=58 + KSPARSE(2, 586)=53 !WC_HCHO/WC_SO2 - KSPARSE(1, 579)=57 - KSPARSE(2, 579)=55 + KSPARSE(1, 587)=58 + KSPARSE(2, 587)=56 !WC_HCHO/WC_HCHO - KSPARSE(1, 580)=57 - KSPARSE(2, 580)=57 + KSPARSE(1, 588)=58 + KSPARSE(2, 588)=58 !WC_HCHO/WC_MO2 - KSPARSE(1, 581)=57 - KSPARSE(2, 581)=60 + KSPARSE(1, 589)=58 + KSPARSE(2, 589)=61 !WC_HCHO/WC_AHMS - KSPARSE(1, 582)=57 - KSPARSE(2, 582)=66 + KSPARSE(1, 590)=58 + KSPARSE(2, 590)=67 !WC_ORA1/ORA1 - KSPARSE(1, 583)=58 - KSPARSE(2, 583)=30 + KSPARSE(1, 591)=59 + KSPARSE(2, 591)=31 !WC_ORA1/WC_OH - KSPARSE(1, 584)=58 - KSPARSE(2, 584)=52 + KSPARSE(1, 592)=59 + KSPARSE(2, 592)=53 !WC_ORA1/WC_HCHO - KSPARSE(1, 585)=58 - KSPARSE(2, 585)=57 + KSPARSE(1, 593)=59 + KSPARSE(2, 593)=58 !WC_ORA1/WC_ORA1 - KSPARSE(1, 586)=58 - KSPARSE(2, 586)=58 + KSPARSE(1, 594)=59 + KSPARSE(2, 594)=59 !WC_ORA1/WC_AHMS - KSPARSE(1, 587)=58 - KSPARSE(2, 587)=66 + KSPARSE(1, 595)=59 + KSPARSE(2, 595)=67 !WC_ORA2/ORA2 - KSPARSE(1, 588)=59 - KSPARSE(2, 588)=31 + KSPARSE(1, 596)=60 + KSPARSE(2, 596)=32 !WC_ORA2/WC_ORA2 - KSPARSE(1, 589)=59 - KSPARSE(2, 589)=59 + KSPARSE(1, 597)=60 + KSPARSE(2, 597)=60 !WC_MO2/MO2 - KSPARSE(1, 590)=60 - KSPARSE(2, 590)=32 + KSPARSE(1, 598)=61 + KSPARSE(2, 598)=33 !WC_MO2/WC_SO2 - KSPARSE(1, 591)=60 - KSPARSE(2, 591)=55 + KSPARSE(1, 599)=61 + KSPARSE(2, 599)=56 !WC_MO2/WC_MO2 - KSPARSE(1, 592)=60 - KSPARSE(2, 592)=60 + KSPARSE(1, 600)=61 + KSPARSE(2, 600)=61 !WC_OP1/OP1 - KSPARSE(1, 593)=61 - KSPARSE(2, 593)=28 + KSPARSE(1, 601)=62 + KSPARSE(2, 601)=29 !WC_OP1/WC_SO2 - KSPARSE(1, 594)=61 - KSPARSE(2, 594)=55 + KSPARSE(1, 602)=62 + KSPARSE(2, 602)=56 !WC_OP1/WC_MO2 - KSPARSE(1, 595)=61 - KSPARSE(2, 595)=60 + KSPARSE(1, 603)=62 + KSPARSE(2, 603)=61 !WC_OP1/WC_OP1 - KSPARSE(1, 596)=61 - KSPARSE(2, 596)=61 + KSPARSE(1, 604)=62 + KSPARSE(2, 604)=62 !WC_ASO3/WC_NO3 - KSPARSE(1, 597)=62 - KSPARSE(2, 597)=46 + KSPARSE(1, 605)=63 + KSPARSE(2, 605)=47 !WC_ASO3/WC_OH - KSPARSE(1, 598)=62 - KSPARSE(2, 598)=52 + KSPARSE(1, 606)=63 + KSPARSE(2, 606)=53 !WC_ASO3/WC_SO2 - KSPARSE(1, 599)=62 - KSPARSE(2, 599)=55 + KSPARSE(1, 607)=63 + KSPARSE(2, 607)=56 !WC_ASO3/WC_MO2 - KSPARSE(1, 600)=62 - KSPARSE(2, 600)=60 + KSPARSE(1, 608)=63 + KSPARSE(2, 608)=61 !WC_ASO3/WC_ASO3 - KSPARSE(1, 601)=62 - KSPARSE(2, 601)=62 + KSPARSE(1, 609)=63 + KSPARSE(2, 609)=63 !WC_ASO4/WC_NO3 - KSPARSE(1, 602)=63 - KSPARSE(2, 602)=46 + KSPARSE(1, 610)=64 + KSPARSE(2, 610)=47 !WC_ASO4/WC_SULF - KSPARSE(1, 603)=63 - KSPARSE(2, 603)=56 + KSPARSE(1, 611)=64 + KSPARSE(2, 611)=57 !WC_ASO4/WC_ASO4 - KSPARSE(1, 604)=63 - KSPARSE(2, 604)=63 + KSPARSE(1, 612)=64 + KSPARSE(2, 612)=64 !WC_ASO4/WC_ASO5 - KSPARSE(1, 605)=63 - KSPARSE(2, 605)=64 + KSPARSE(1, 613)=64 + KSPARSE(2, 613)=65 !WC_ASO5/WC_HO2 - KSPARSE(1, 606)=64 - KSPARSE(2, 606)=53 + KSPARSE(1, 614)=65 + KSPARSE(2, 614)=54 !WC_ASO5/WC_ASO3 - KSPARSE(1, 607)=64 - KSPARSE(2, 607)=62 + KSPARSE(1, 615)=65 + KSPARSE(2, 615)=63 !WC_ASO5/WC_ASO5 - KSPARSE(1, 608)=64 - KSPARSE(2, 608)=64 + KSPARSE(1, 616)=65 + KSPARSE(2, 616)=65 !WC_AHSO5/WC_HO2 - KSPARSE(1, 609)=65 - KSPARSE(2, 609)=53 + KSPARSE(1, 617)=66 + KSPARSE(2, 617)=54 !WC_AHSO5/WC_SO2 - KSPARSE(1, 610)=65 - KSPARSE(2, 610)=55 + KSPARSE(1, 618)=66 + KSPARSE(2, 618)=56 !WC_AHSO5/WC_ASO5 - KSPARSE(1, 611)=65 - KSPARSE(2, 611)=64 + KSPARSE(1, 619)=66 + KSPARSE(2, 619)=65 !WC_AHSO5/WC_AHSO5 - KSPARSE(1, 612)=65 - KSPARSE(2, 612)=65 + KSPARSE(1, 620)=66 + KSPARSE(2, 620)=66 !WC_AHMS/WC_OH - KSPARSE(1, 613)=66 - KSPARSE(2, 613)=52 + KSPARSE(1, 621)=67 + KSPARSE(2, 621)=53 !WC_AHMS/WC_SO2 - KSPARSE(1, 614)=66 - KSPARSE(2, 614)=55 + KSPARSE(1, 622)=67 + KSPARSE(2, 622)=56 !WC_AHMS/WC_HCHO - KSPARSE(1, 615)=66 - KSPARSE(2, 615)=57 + KSPARSE(1, 623)=67 + KSPARSE(2, 623)=58 !WC_AHMS/WC_AHMS - KSPARSE(1, 616)=66 - KSPARSE(2, 616)=66 + KSPARSE(1, 624)=67 + KSPARSE(2, 624)=67 !WR_O3/O3 - KSPARSE(1, 617)=67 - KSPARSE(2, 617)=1 + KSPARSE(1, 625)=68 + KSPARSE(2, 625)=1 !WR_O3/WR_O3 - KSPARSE(1, 618)=67 - KSPARSE(2, 618)=67 + KSPARSE(1, 626)=68 + KSPARSE(2, 626)=68 !WR_O3/WR_HO2 - KSPARSE(1, 619)=67 - KSPARSE(2, 619)=78 + KSPARSE(1, 627)=68 + KSPARSE(2, 627)=79 !WR_O3/WR_SO2 - KSPARSE(1, 620)=67 - KSPARSE(2, 620)=80 + KSPARSE(1, 628)=68 + KSPARSE(2, 628)=81 !WR_H2O2/H2O2 - KSPARSE(1, 621)=68 - KSPARSE(2, 621)=2 + KSPARSE(1, 629)=69 + KSPARSE(2, 629)=2 !WR_H2O2/WR_H2O2 - KSPARSE(1, 622)=68 - KSPARSE(2, 622)=68 + KSPARSE(1, 630)=69 + KSPARSE(2, 630)=69 !WR_H2O2/WR_OH - KSPARSE(1, 623)=68 - KSPARSE(2, 623)=77 + KSPARSE(1, 631)=69 + KSPARSE(2, 631)=78 !WR_H2O2/WR_HO2 - KSPARSE(1, 624)=68 - KSPARSE(2, 624)=78 + KSPARSE(1, 632)=69 + KSPARSE(2, 632)=79 !WR_H2O2/WR_SO2 - KSPARSE(1, 625)=68 - KSPARSE(2, 625)=80 + KSPARSE(1, 633)=69 + KSPARSE(2, 633)=81 !WR_NO/NO - KSPARSE(1, 626)=69 - KSPARSE(2, 626)=3 + KSPARSE(1, 634)=70 + KSPARSE(2, 634)=3 !WR_NO/WR_NO - KSPARSE(1, 627)=69 - KSPARSE(2, 627)=69 + KSPARSE(1, 635)=70 + KSPARSE(2, 635)=70 !WR_NO2/NO2 - KSPARSE(1, 628)=70 - KSPARSE(2, 628)=4 + KSPARSE(1, 636)=71 + KSPARSE(2, 636)=4 !WR_NO2/WR_NO2 - KSPARSE(1, 629)=70 - KSPARSE(2, 629)=70 + KSPARSE(1, 637)=71 + KSPARSE(2, 637)=71 !WR_NO2/WR_HONO - KSPARSE(1, 630)=70 - KSPARSE(2, 630)=73 + KSPARSE(1, 638)=71 + KSPARSE(2, 638)=74 !WR_NO2/WR_HNO3 - KSPARSE(1, 631)=70 - KSPARSE(2, 631)=74 + KSPARSE(1, 639)=71 + KSPARSE(2, 639)=75 !WR_NO2/WR_HNO4 - KSPARSE(1, 632)=70 - KSPARSE(2, 632)=75 + KSPARSE(1, 640)=71 + KSPARSE(2, 640)=76 !WR_NO2/WR_OH - KSPARSE(1, 633)=70 - KSPARSE(2, 633)=77 + KSPARSE(1, 641)=71 + KSPARSE(2, 641)=78 !WR_NO2/WR_HO2 - KSPARSE(1, 634)=70 - KSPARSE(2, 634)=78 + KSPARSE(1, 642)=71 + KSPARSE(2, 642)=79 !WR_NO3/NO3 - KSPARSE(1, 635)=71 - KSPARSE(2, 635)=5 + KSPARSE(1, 643)=72 + KSPARSE(2, 643)=5 !WR_NO3/WR_NO3 - KSPARSE(1, 636)=71 - KSPARSE(2, 636)=71 + KSPARSE(1, 644)=72 + KSPARSE(2, 644)=72 !WR_NO3/WR_SO2 - KSPARSE(1, 637)=71 - KSPARSE(2, 637)=80 + KSPARSE(1, 645)=72 + KSPARSE(2, 645)=81 !WR_NO3/WR_SULF - KSPARSE(1, 638)=71 - KSPARSE(2, 638)=81 + KSPARSE(1, 646)=72 + KSPARSE(2, 646)=82 !WR_N2O5/N2O5 - KSPARSE(1, 639)=72 - KSPARSE(2, 639)=6 + KSPARSE(1, 647)=73 + KSPARSE(2, 647)=6 !WR_N2O5/WR_N2O5 - KSPARSE(1, 640)=72 - KSPARSE(2, 640)=72 + KSPARSE(1, 648)=73 + KSPARSE(2, 648)=73 !WR_HONO/HONO - KSPARSE(1, 641)=73 - KSPARSE(2, 641)=7 + KSPARSE(1, 649)=74 + KSPARSE(2, 649)=7 !WR_HONO/WR_HONO - KSPARSE(1, 642)=73 - KSPARSE(2, 642)=73 + KSPARSE(1, 650)=74 + KSPARSE(2, 650)=74 !WR_HONO/WR_HNO4 - KSPARSE(1, 643)=73 - KSPARSE(2, 643)=75 + KSPARSE(1, 651)=74 + KSPARSE(2, 651)=76 !WR_HONO/WR_OH - KSPARSE(1, 644)=73 - KSPARSE(2, 644)=77 + KSPARSE(1, 652)=74 + KSPARSE(2, 652)=78 !WR_HNO3/HNO3 - KSPARSE(1, 645)=74 - KSPARSE(2, 645)=8 + KSPARSE(1, 653)=75 + KSPARSE(2, 653)=8 !WR_HNO3/WR_NO3 - KSPARSE(1, 646)=74 - KSPARSE(2, 646)=71 + KSPARSE(1, 654)=75 + KSPARSE(2, 654)=72 !WR_HNO3/WR_N2O5 - KSPARSE(1, 647)=74 - KSPARSE(2, 647)=72 + KSPARSE(1, 655)=75 + KSPARSE(2, 655)=73 !WR_HNO3/WR_HNO3 - KSPARSE(1, 648)=74 - KSPARSE(2, 648)=74 + KSPARSE(1, 656)=75 + KSPARSE(2, 656)=75 !WR_HNO3/WR_HNO4 - KSPARSE(1, 649)=74 - KSPARSE(2, 649)=75 + KSPARSE(1, 657)=75 + KSPARSE(2, 657)=76 !WR_HNO3/WR_SO2 - KSPARSE(1, 650)=74 - KSPARSE(2, 650)=80 + KSPARSE(1, 658)=75 + KSPARSE(2, 658)=81 !WR_HNO3/WR_SULF - KSPARSE(1, 651)=74 - KSPARSE(2, 651)=81 + KSPARSE(1, 659)=75 + KSPARSE(2, 659)=82 !WR_HNO4/HNO4 - KSPARSE(1, 652)=75 - KSPARSE(2, 652)=9 + KSPARSE(1, 660)=76 + KSPARSE(2, 660)=9 !WR_HNO4/WR_NO2 - KSPARSE(1, 653)=75 - KSPARSE(2, 653)=70 + KSPARSE(1, 661)=76 + KSPARSE(2, 661)=71 !WR_HNO4/WR_HNO4 - KSPARSE(1, 654)=75 - KSPARSE(2, 654)=75 + KSPARSE(1, 662)=76 + KSPARSE(2, 662)=76 !WR_HNO4/WR_HO2 - KSPARSE(1, 655)=75 - KSPARSE(2, 655)=78 + KSPARSE(1, 663)=76 + KSPARSE(2, 663)=79 !WR_HNO4/WR_SO2 - KSPARSE(1, 656)=75 - KSPARSE(2, 656)=80 + KSPARSE(1, 664)=76 + KSPARSE(2, 664)=81 !WR_NH3/NH3 - KSPARSE(1, 657)=76 - KSPARSE(2, 657)=10 + KSPARSE(1, 665)=77 + KSPARSE(2, 665)=10 !WR_NH3/WR_NH3 - KSPARSE(1, 658)=76 - KSPARSE(2, 658)=76 + KSPARSE(1, 666)=77 + KSPARSE(2, 666)=77 !WR_OH/OH - KSPARSE(1, 659)=77 - KSPARSE(2, 659)=14 + KSPARSE(1, 667)=78 + KSPARSE(2, 667)=15 !WR_OH/WR_O3 - KSPARSE(1, 660)=77 - KSPARSE(2, 660)=67 + KSPARSE(1, 668)=78 + KSPARSE(2, 668)=68 !WR_OH/WR_H2O2 - KSPARSE(1, 661)=77 - KSPARSE(2, 661)=68 + KSPARSE(1, 669)=78 + KSPARSE(2, 669)=69 !WR_OH/WR_HONO - KSPARSE(1, 662)=77 - KSPARSE(2, 662)=73 + KSPARSE(1, 670)=78 + KSPARSE(2, 670)=74 !WR_OH/WR_HNO3 - KSPARSE(1, 663)=77 - KSPARSE(2, 663)=74 + KSPARSE(1, 671)=78 + KSPARSE(2, 671)=75 !WR_OH/WR_OH - KSPARSE(1, 664)=77 - KSPARSE(2, 664)=77 + KSPARSE(1, 672)=78 + KSPARSE(2, 672)=78 !WR_OH/WR_HO2 - KSPARSE(1, 665)=77 - KSPARSE(2, 665)=78 + KSPARSE(1, 673)=78 + KSPARSE(2, 673)=79 !WR_OH/WR_SO2 - KSPARSE(1, 666)=77 - KSPARSE(2, 666)=80 + KSPARSE(1, 674)=78 + KSPARSE(2, 674)=81 !WR_OH/WR_HCHO - KSPARSE(1, 667)=77 - KSPARSE(2, 667)=82 + KSPARSE(1, 675)=78 + KSPARSE(2, 675)=83 !WR_OH/WR_ORA1 - KSPARSE(1, 668)=77 - KSPARSE(2, 668)=83 + KSPARSE(1, 676)=78 + KSPARSE(2, 676)=84 !WR_OH/WR_ASO4 - KSPARSE(1, 669)=77 - KSPARSE(2, 669)=88 + KSPARSE(1, 677)=78 + KSPARSE(2, 677)=89 !WR_OH/WR_AHMS - KSPARSE(1, 670)=77 - KSPARSE(2, 670)=91 + KSPARSE(1, 678)=78 + KSPARSE(2, 678)=92 !WR_HO2/HO2 - KSPARSE(1, 671)=78 - KSPARSE(2, 671)=15 + KSPARSE(1, 679)=79 + KSPARSE(2, 679)=16 !WR_HO2/WR_O3 - KSPARSE(1, 672)=78 - KSPARSE(2, 672)=67 + KSPARSE(1, 680)=79 + KSPARSE(2, 680)=68 !WR_HO2/WR_H2O2 - KSPARSE(1, 673)=78 - KSPARSE(2, 673)=68 + KSPARSE(1, 681)=79 + KSPARSE(2, 681)=69 !WR_HO2/WR_NO2 - KSPARSE(1, 674)=78 - KSPARSE(2, 674)=70 + KSPARSE(1, 682)=79 + KSPARSE(2, 682)=71 !WR_HO2/WR_HNO4 - KSPARSE(1, 675)=78 - KSPARSE(2, 675)=75 + KSPARSE(1, 683)=79 + KSPARSE(2, 683)=76 !WR_HO2/WR_OH - KSPARSE(1, 676)=78 - KSPARSE(2, 676)=77 + KSPARSE(1, 684)=79 + KSPARSE(2, 684)=78 !WR_HO2/WR_HO2 - KSPARSE(1, 677)=78 - KSPARSE(2, 677)=78 + KSPARSE(1, 685)=79 + KSPARSE(2, 685)=79 !WR_HO2/WR_HCHO - KSPARSE(1, 678)=78 - KSPARSE(2, 678)=82 + KSPARSE(1, 686)=79 + KSPARSE(2, 686)=83 !WR_HO2/WR_ORA1 - KSPARSE(1, 679)=78 - KSPARSE(2, 679)=83 + KSPARSE(1, 687)=79 + KSPARSE(2, 687)=84 !WR_HO2/WR_MO2 - KSPARSE(1, 680)=78 - KSPARSE(2, 680)=85 + KSPARSE(1, 688)=79 + KSPARSE(2, 688)=86 !WR_HO2/WR_ASO5 - KSPARSE(1, 681)=78 - KSPARSE(2, 681)=89 + KSPARSE(1, 689)=79 + KSPARSE(2, 689)=90 !WR_HO2/WR_AHMS - KSPARSE(1, 682)=78 - KSPARSE(2, 682)=91 + KSPARSE(1, 690)=79 + KSPARSE(2, 690)=92 !WR_CO2/WR_OH - KSPARSE(1, 683)=79 - KSPARSE(2, 683)=77 + KSPARSE(1, 691)=80 + KSPARSE(2, 691)=78 !WR_CO2/WR_CO2 - KSPARSE(1, 684)=79 - KSPARSE(2, 684)=79 + KSPARSE(1, 692)=80 + KSPARSE(2, 692)=80 !WR_CO2/WR_ORA1 - KSPARSE(1, 685)=79 - KSPARSE(2, 685)=83 + KSPARSE(1, 693)=80 + KSPARSE(2, 693)=84 !WR_SO2/SO2 - KSPARSE(1, 686)=80 - KSPARSE(2, 686)=11 + KSPARSE(1, 694)=81 + KSPARSE(2, 694)=12 !WR_SO2/WR_O3 - KSPARSE(1, 687)=80 - KSPARSE(2, 687)=67 + KSPARSE(1, 695)=81 + KSPARSE(2, 695)=68 !WR_SO2/WR_H2O2 - KSPARSE(1, 688)=80 - KSPARSE(2, 688)=68 + KSPARSE(1, 696)=81 + KSPARSE(2, 696)=69 !WR_SO2/WR_NO3 - KSPARSE(1, 689)=80 - KSPARSE(2, 689)=71 + KSPARSE(1, 697)=81 + KSPARSE(2, 697)=72 !WR_SO2/WR_HNO4 - KSPARSE(1, 690)=80 - KSPARSE(2, 690)=75 + KSPARSE(1, 698)=81 + KSPARSE(2, 698)=76 !WR_SO2/WR_OH - KSPARSE(1, 691)=80 - KSPARSE(2, 691)=77 + KSPARSE(1, 699)=81 + KSPARSE(2, 699)=78 !WR_SO2/WR_SO2 - KSPARSE(1, 692)=80 - KSPARSE(2, 692)=80 + KSPARSE(1, 700)=81 + KSPARSE(2, 700)=81 !WR_SO2/WR_HCHO - KSPARSE(1, 693)=80 - KSPARSE(2, 693)=82 + KSPARSE(1, 701)=81 + KSPARSE(2, 701)=83 !WR_SO2/WR_MO2 - KSPARSE(1, 694)=80 - KSPARSE(2, 694)=85 + KSPARSE(1, 702)=81 + KSPARSE(2, 702)=86 !WR_SO2/WR_AHSO5 - KSPARSE(1, 695)=80 - KSPARSE(2, 695)=90 + KSPARSE(1, 703)=81 + KSPARSE(2, 703)=91 !WR_SO2/WR_AHMS - KSPARSE(1, 696)=80 - KSPARSE(2, 696)=91 + KSPARSE(1, 704)=81 + KSPARSE(2, 704)=92 !WR_SULF/SULF - KSPARSE(1, 697)=81 - KSPARSE(2, 697)=12 + KSPARSE(1, 705)=82 + KSPARSE(2, 705)=13 !WR_SULF/WR_O3 - KSPARSE(1, 698)=81 - KSPARSE(2, 698)=67 + KSPARSE(1, 706)=82 + KSPARSE(2, 706)=68 !WR_SULF/WR_H2O2 - KSPARSE(1, 699)=81 - KSPARSE(2, 699)=68 + KSPARSE(1, 707)=82 + KSPARSE(2, 707)=69 !WR_SULF/WR_NO3 - KSPARSE(1, 700)=81 - KSPARSE(2, 700)=71 + KSPARSE(1, 708)=82 + KSPARSE(2, 708)=72 !WR_SULF/WR_HNO4 - KSPARSE(1, 701)=81 - KSPARSE(2, 701)=75 + KSPARSE(1, 709)=82 + KSPARSE(2, 709)=76 !WR_SULF/WR_SO2 - KSPARSE(1, 702)=81 - KSPARSE(2, 702)=80 + KSPARSE(1, 710)=82 + KSPARSE(2, 710)=81 !WR_SULF/WR_SULF - KSPARSE(1, 703)=81 - KSPARSE(2, 703)=81 + KSPARSE(1, 711)=82 + KSPARSE(2, 711)=82 !WR_SULF/WR_ASO4 - KSPARSE(1, 704)=81 - KSPARSE(2, 704)=88 + KSPARSE(1, 712)=82 + KSPARSE(2, 712)=89 !WR_SULF/WR_AHSO5 - KSPARSE(1, 705)=81 - KSPARSE(2, 705)=90 + KSPARSE(1, 713)=82 + KSPARSE(2, 713)=91 !WR_HCHO/HCHO - KSPARSE(1, 706)=82 - KSPARSE(2, 706)=22 + KSPARSE(1, 714)=83 + KSPARSE(2, 714)=23 !WR_HCHO/WR_OH - KSPARSE(1, 707)=82 - KSPARSE(2, 707)=77 + KSPARSE(1, 715)=83 + KSPARSE(2, 715)=78 !WR_HCHO/WR_SO2 - KSPARSE(1, 708)=82 - KSPARSE(2, 708)=80 + KSPARSE(1, 716)=83 + KSPARSE(2, 716)=81 !WR_HCHO/WR_HCHO - KSPARSE(1, 709)=82 - KSPARSE(2, 709)=82 + KSPARSE(1, 717)=83 + KSPARSE(2, 717)=83 !WR_HCHO/WR_MO2 - KSPARSE(1, 710)=82 - KSPARSE(2, 710)=85 + KSPARSE(1, 718)=83 + KSPARSE(2, 718)=86 !WR_HCHO/WR_AHMS - KSPARSE(1, 711)=82 - KSPARSE(2, 711)=91 + KSPARSE(1, 719)=83 + KSPARSE(2, 719)=92 !WR_ORA1/ORA1 - KSPARSE(1, 712)=83 - KSPARSE(2, 712)=30 + KSPARSE(1, 720)=84 + KSPARSE(2, 720)=31 !WR_ORA1/WR_OH - KSPARSE(1, 713)=83 - KSPARSE(2, 713)=77 + KSPARSE(1, 721)=84 + KSPARSE(2, 721)=78 !WR_ORA1/WR_HCHO - KSPARSE(1, 714)=83 - KSPARSE(2, 714)=82 + KSPARSE(1, 722)=84 + KSPARSE(2, 722)=83 !WR_ORA1/WR_ORA1 - KSPARSE(1, 715)=83 - KSPARSE(2, 715)=83 + KSPARSE(1, 723)=84 + KSPARSE(2, 723)=84 !WR_ORA1/WR_AHMS - KSPARSE(1, 716)=83 - KSPARSE(2, 716)=91 + KSPARSE(1, 724)=84 + KSPARSE(2, 724)=92 !WR_ORA2/ORA2 - KSPARSE(1, 717)=84 - KSPARSE(2, 717)=31 + KSPARSE(1, 725)=85 + KSPARSE(2, 725)=32 !WR_ORA2/WR_ORA2 - KSPARSE(1, 718)=84 - KSPARSE(2, 718)=84 + KSPARSE(1, 726)=85 + KSPARSE(2, 726)=85 !WR_MO2/MO2 - KSPARSE(1, 719)=85 - KSPARSE(2, 719)=32 + KSPARSE(1, 727)=86 + KSPARSE(2, 727)=33 !WR_MO2/WR_SO2 - KSPARSE(1, 720)=85 - KSPARSE(2, 720)=80 + KSPARSE(1, 728)=86 + KSPARSE(2, 728)=81 !WR_MO2/WR_MO2 - KSPARSE(1, 721)=85 - KSPARSE(2, 721)=85 + KSPARSE(1, 729)=86 + KSPARSE(2, 729)=86 !WR_OP1/OP1 - KSPARSE(1, 722)=86 - KSPARSE(2, 722)=28 + KSPARSE(1, 730)=87 + KSPARSE(2, 730)=29 !WR_OP1/WR_SO2 - KSPARSE(1, 723)=86 - KSPARSE(2, 723)=80 + KSPARSE(1, 731)=87 + KSPARSE(2, 731)=81 !WR_OP1/WR_MO2 - KSPARSE(1, 724)=86 - KSPARSE(2, 724)=85 + KSPARSE(1, 732)=87 + KSPARSE(2, 732)=86 !WR_OP1/WR_OP1 - KSPARSE(1, 725)=86 - KSPARSE(2, 725)=86 + KSPARSE(1, 733)=87 + KSPARSE(2, 733)=87 !WR_ASO3/WR_NO3 - KSPARSE(1, 726)=87 - KSPARSE(2, 726)=71 + KSPARSE(1, 734)=88 + KSPARSE(2, 734)=72 !WR_ASO3/WR_OH - KSPARSE(1, 727)=87 - KSPARSE(2, 727)=77 + KSPARSE(1, 735)=88 + KSPARSE(2, 735)=78 !WR_ASO3/WR_SO2 - KSPARSE(1, 728)=87 - KSPARSE(2, 728)=80 + KSPARSE(1, 736)=88 + KSPARSE(2, 736)=81 !WR_ASO3/WR_MO2 - KSPARSE(1, 729)=87 - KSPARSE(2, 729)=85 + KSPARSE(1, 737)=88 + KSPARSE(2, 737)=86 !WR_ASO3/WR_ASO3 - KSPARSE(1, 730)=87 - KSPARSE(2, 730)=87 + KSPARSE(1, 738)=88 + KSPARSE(2, 738)=88 !WR_ASO4/WR_NO3 - KSPARSE(1, 731)=88 - KSPARSE(2, 731)=71 + KSPARSE(1, 739)=89 + KSPARSE(2, 739)=72 !WR_ASO4/WR_SULF - KSPARSE(1, 732)=88 - KSPARSE(2, 732)=81 + KSPARSE(1, 740)=89 + KSPARSE(2, 740)=82 !WR_ASO4/WR_ASO4 - KSPARSE(1, 733)=88 - KSPARSE(2, 733)=88 + KSPARSE(1, 741)=89 + KSPARSE(2, 741)=89 !WR_ASO4/WR_ASO5 - KSPARSE(1, 734)=88 - KSPARSE(2, 734)=89 + KSPARSE(1, 742)=89 + KSPARSE(2, 742)=90 !WR_ASO5/WR_HO2 - KSPARSE(1, 735)=89 - KSPARSE(2, 735)=78 + KSPARSE(1, 743)=90 + KSPARSE(2, 743)=79 !WR_ASO5/WR_ASO3 - KSPARSE(1, 736)=89 - KSPARSE(2, 736)=87 + KSPARSE(1, 744)=90 + KSPARSE(2, 744)=88 !WR_ASO5/WR_ASO5 - KSPARSE(1, 737)=89 - KSPARSE(2, 737)=89 + KSPARSE(1, 745)=90 + KSPARSE(2, 745)=90 !WR_AHSO5/WR_HO2 - KSPARSE(1, 738)=90 - KSPARSE(2, 738)=78 + KSPARSE(1, 746)=91 + KSPARSE(2, 746)=79 !WR_AHSO5/WR_SO2 - KSPARSE(1, 739)=90 - KSPARSE(2, 739)=80 + KSPARSE(1, 747)=91 + KSPARSE(2, 747)=81 !WR_AHSO5/WR_ASO5 - KSPARSE(1, 740)=90 - KSPARSE(2, 740)=89 + KSPARSE(1, 748)=91 + KSPARSE(2, 748)=90 !WR_AHSO5/WR_AHSO5 - KSPARSE(1, 741)=90 - KSPARSE(2, 741)=90 + KSPARSE(1, 749)=91 + KSPARSE(2, 749)=91 !WR_AHMS/WR_OH - KSPARSE(1, 742)=91 - KSPARSE(2, 742)=77 + KSPARSE(1, 750)=92 + KSPARSE(2, 750)=78 !WR_AHMS/WR_SO2 - KSPARSE(1, 743)=91 - KSPARSE(2, 743)=80 + KSPARSE(1, 751)=92 + KSPARSE(2, 751)=81 !WR_AHMS/WR_HCHO - KSPARSE(1, 744)=91 - KSPARSE(2, 744)=82 + KSPARSE(1, 752)=92 + KSPARSE(2, 752)=83 !WR_AHMS/WR_AHMS - KSPARSE(1, 745)=91 - KSPARSE(2, 745)=91 -KSPARSEDIM = 745 + KSPARSE(1, 753)=92 + KSPARSE(2, 753)=92 +KSPARSEDIM = 753 RETURN END SUBROUTINE CH_SPARSE_AQ !! @@ -40937,7 +41664,7 @@ END SUBROUTINE CH_SPARSE_AQ !! !! EXTERNAL !! -------- -use mode_msg +!! none !! !! IMPLICIT ARGUMENTS !! ------------------ @@ -40955,8 +41682,8 @@ IMPLICIT NONE !! EXECUTABLE STATEMENTS !! --------------------- ! check if output array is large enough -IF (KSPARSEDIM.LT.449) THEN - call Print_msg( NVERB_FATAL, 'GEN', 'CH_SPARSE_GAZ', 'array KSPARSE is too small' ) +IF (KSPARSEDIM.LT.457) THEN + STOP 'CH_SPARSE ERROR: array KSPARSE is too small!' END IF !O3/O3 KSPARSE(1, 1)=1 @@ -40969,28 +41696,28 @@ END IF KSPARSE(2, 3)=4 !O3/OH KSPARSE(1, 4)=1 - KSPARSE(2, 4)=14 + KSPARSE(2, 4)=15 !O3/HO2 KSPARSE(1, 5)=1 - KSPARSE(2, 5)=15 + KSPARSE(2, 5)=16 !O3/ALKE KSPARSE(1, 6)=1 - KSPARSE(2, 6)=19 + KSPARSE(2, 6)=20 !O3/BIO KSPARSE(1, 7)=1 - KSPARSE(2, 7)=20 + KSPARSE(2, 7)=21 !O3/CARBO KSPARSE(1, 8)=1 - KSPARSE(2, 8)=25 + KSPARSE(2, 8)=26 !O3/PAN KSPARSE(1, 9)=1 - KSPARSE(2, 9)=27 + KSPARSE(2, 9)=28 !O3/ADD KSPARSE(1, 10)=1 - KSPARSE(2, 10)=37 + KSPARSE(2, 10)=38 !O3/CARBOP KSPARSE(1, 11)=1 - KSPARSE(2, 11)=39 + KSPARSE(2, 11)=40 !H2O2/O3 KSPARSE(1, 12)=2 KSPARSE(2, 12)=1 @@ -40999,16 +41726,16 @@ END IF KSPARSE(2, 13)=2 !H2O2/OH KSPARSE(1, 14)=2 - KSPARSE(2, 14)=14 + KSPARSE(2, 14)=15 !H2O2/HO2 KSPARSE(1, 15)=2 - KSPARSE(2, 15)=15 + KSPARSE(2, 15)=16 !H2O2/ALKE KSPARSE(1, 16)=2 - KSPARSE(2, 16)=19 + KSPARSE(2, 16)=20 !H2O2/BIO KSPARSE(1, 17)=2 - KSPARSE(2, 17)=20 + KSPARSE(2, 17)=21 !NO/O3 KSPARSE(1, 18)=3 KSPARSE(2, 18)=1 @@ -41026,34 +41753,34 @@ END IF KSPARSE(2, 22)=7 !NO/OH KSPARSE(1, 23)=3 - KSPARSE(2, 23)=14 + KSPARSE(2, 23)=15 !NO/HO2 KSPARSE(1, 24)=3 - KSPARSE(2, 24)=15 + KSPARSE(2, 24)=16 !NO/MO2 KSPARSE(1, 25)=3 - KSPARSE(2, 25)=32 + KSPARSE(2, 25)=33 !NO/ALKAP KSPARSE(1, 26)=3 - KSPARSE(2, 26)=33 + KSPARSE(2, 26)=34 !NO/ALKEP KSPARSE(1, 27)=3 - KSPARSE(2, 27)=34 + KSPARSE(2, 27)=35 !NO/BIOP KSPARSE(1, 28)=3 - KSPARSE(2, 28)=35 + KSPARSE(2, 28)=36 !NO/AROP KSPARSE(1, 29)=3 - KSPARSE(2, 29)=38 + KSPARSE(2, 29)=39 !NO/CARBOP KSPARSE(1, 30)=3 - KSPARSE(2, 30)=39 + KSPARSE(2, 30)=40 !NO/OLN KSPARSE(1, 31)=3 - KSPARSE(2, 31)=40 + KSPARSE(2, 31)=41 !NO/XO2 KSPARSE(1, 32)=3 - KSPARSE(2, 32)=41 + KSPARSE(2, 32)=42 !NO2/O3 KSPARSE(1, 33)=4 KSPARSE(2, 33)=1 @@ -41078,1234 +41805,1258 @@ END IF !NO2/HNO4 KSPARSE(1, 40)=4 KSPARSE(2, 40)=9 -!NO2/OH +!NO2/DMS KSPARSE(1, 41)=4 - KSPARSE(2, 41)=14 -!NO2/HO2 + KSPARSE(2, 41)=11 +!NO2/OH KSPARSE(1, 42)=4 KSPARSE(2, 42)=15 -!NO2/CARBO +!NO2/HO2 KSPARSE(1, 43)=4 - KSPARSE(2, 43)=25 -!NO2/ONIT + KSPARSE(2, 43)=16 +!NO2/CARBO KSPARSE(1, 44)=4 KSPARSE(2, 44)=26 -!NO2/PAN +!NO2/ONIT KSPARSE(1, 45)=4 KSPARSE(2, 45)=27 -!NO2/MO2 +!NO2/PAN KSPARSE(1, 46)=4 - KSPARSE(2, 46)=32 -!NO2/ALKAP + KSPARSE(2, 46)=28 +!NO2/MO2 KSPARSE(1, 47)=4 KSPARSE(2, 47)=33 -!NO2/ALKEP +!NO2/ALKAP KSPARSE(1, 48)=4 KSPARSE(2, 48)=34 -!NO2/BIOP +!NO2/ALKEP KSPARSE(1, 49)=4 KSPARSE(2, 49)=35 -!NO2/PHO +!NO2/BIOP KSPARSE(1, 50)=4 KSPARSE(2, 50)=36 -!NO2/ADD +!NO2/PHO KSPARSE(1, 51)=4 KSPARSE(2, 51)=37 -!NO2/AROP +!NO2/ADD KSPARSE(1, 52)=4 KSPARSE(2, 52)=38 -!NO2/CARBOP +!NO2/AROP KSPARSE(1, 53)=4 KSPARSE(2, 53)=39 -!NO2/OLN +!NO2/CARBOP KSPARSE(1, 54)=4 KSPARSE(2, 54)=40 -!NO2/XO2 +!NO2/OLN KSPARSE(1, 55)=4 KSPARSE(2, 55)=41 +!NO2/XO2 + KSPARSE(1, 56)=4 + KSPARSE(2, 56)=42 !NO3/O3 - KSPARSE(1, 56)=5 - KSPARSE(2, 56)=1 -!NO3/NO KSPARSE(1, 57)=5 - KSPARSE(2, 57)=3 -!NO3/NO2 + KSPARSE(2, 57)=1 +!NO3/NO KSPARSE(1, 58)=5 - KSPARSE(2, 58)=4 -!NO3/NO3 + KSPARSE(2, 58)=3 +!NO3/NO2 KSPARSE(1, 59)=5 - KSPARSE(2, 59)=5 -!NO3/N2O5 + KSPARSE(2, 59)=4 +!NO3/NO3 KSPARSE(1, 60)=5 - KSPARSE(2, 60)=6 -!NO3/HNO3 + KSPARSE(2, 60)=5 +!NO3/N2O5 KSPARSE(1, 61)=5 - KSPARSE(2, 61)=8 -!NO3/HNO4 + KSPARSE(2, 61)=6 +!NO3/HNO3 KSPARSE(1, 62)=5 - KSPARSE(2, 62)=9 -!NO3/OH + KSPARSE(2, 62)=8 +!NO3/HNO4 KSPARSE(1, 63)=5 - KSPARSE(2, 63)=14 -!NO3/HO2 + KSPARSE(2, 63)=9 +!NO3/DMS KSPARSE(1, 64)=5 - KSPARSE(2, 64)=15 -!NO3/ALKE + KSPARSE(2, 64)=11 +!NO3/OH KSPARSE(1, 65)=5 - KSPARSE(2, 65)=19 -!NO3/BIO + KSPARSE(2, 65)=15 +!NO3/HO2 KSPARSE(1, 66)=5 - KSPARSE(2, 66)=20 -!NO3/ARO + KSPARSE(2, 66)=16 +!NO3/ALKE KSPARSE(1, 67)=5 - KSPARSE(2, 67)=21 -!NO3/HCHO + KSPARSE(2, 67)=20 +!NO3/BIO KSPARSE(1, 68)=5 - KSPARSE(2, 68)=22 -!NO3/ALD + KSPARSE(2, 68)=21 +!NO3/ARO KSPARSE(1, 69)=5 - KSPARSE(2, 69)=23 -!NO3/CARBO + KSPARSE(2, 69)=22 +!NO3/HCHO KSPARSE(1, 70)=5 - KSPARSE(2, 70)=25 -!NO3/PAN + KSPARSE(2, 70)=23 +!NO3/ALD KSPARSE(1, 71)=5 - KSPARSE(2, 71)=27 -!NO3/MO2 + KSPARSE(2, 71)=24 +!NO3/CARBO KSPARSE(1, 72)=5 - KSPARSE(2, 72)=32 -!NO3/ALKAP + KSPARSE(2, 72)=26 +!NO3/PAN KSPARSE(1, 73)=5 - KSPARSE(2, 73)=33 -!NO3/ALKEP + KSPARSE(2, 73)=28 +!NO3/MO2 KSPARSE(1, 74)=5 - KSPARSE(2, 74)=34 -!NO3/BIOP + KSPARSE(2, 74)=33 +!NO3/ALKAP KSPARSE(1, 75)=5 - KSPARSE(2, 75)=35 -!NO3/AROP + KSPARSE(2, 75)=34 +!NO3/ALKEP KSPARSE(1, 76)=5 - KSPARSE(2, 76)=38 -!NO3/CARBOP + KSPARSE(2, 76)=35 +!NO3/BIOP KSPARSE(1, 77)=5 - KSPARSE(2, 77)=39 -!NO3/OLN + KSPARSE(2, 77)=36 +!NO3/AROP KSPARSE(1, 78)=5 - KSPARSE(2, 78)=40 -!NO3/XO2 + KSPARSE(2, 78)=39 +!NO3/CARBOP KSPARSE(1, 79)=5 - KSPARSE(2, 79)=41 + KSPARSE(2, 79)=40 +!NO3/OLN + KSPARSE(1, 80)=5 + KSPARSE(2, 80)=41 +!NO3/XO2 + KSPARSE(1, 81)=5 + KSPARSE(2, 81)=42 !N2O5/NO2 - KSPARSE(1, 80)=6 - KSPARSE(2, 80)=4 + KSPARSE(1, 82)=6 + KSPARSE(2, 82)=4 !N2O5/NO3 - KSPARSE(1, 81)=6 - KSPARSE(2, 81)=5 + KSPARSE(1, 83)=6 + KSPARSE(2, 83)=5 !N2O5/N2O5 - KSPARSE(1, 82)=6 - KSPARSE(2, 82)=6 + KSPARSE(1, 84)=6 + KSPARSE(2, 84)=6 !HONO/NO - KSPARSE(1, 83)=7 - KSPARSE(2, 83)=3 + KSPARSE(1, 85)=7 + KSPARSE(2, 85)=3 !HONO/NO2 - KSPARSE(1, 84)=7 - KSPARSE(2, 84)=4 + KSPARSE(1, 86)=7 + KSPARSE(2, 86)=4 !HONO/HONO - KSPARSE(1, 85)=7 - KSPARSE(2, 85)=7 + KSPARSE(1, 87)=7 + KSPARSE(2, 87)=7 !HONO/OH - KSPARSE(1, 86)=7 - KSPARSE(2, 86)=14 + KSPARSE(1, 88)=7 + KSPARSE(2, 88)=15 !HONO/ADD - KSPARSE(1, 87)=7 - KSPARSE(2, 87)=37 + KSPARSE(1, 89)=7 + KSPARSE(2, 89)=38 !HNO3/NO2 - KSPARSE(1, 88)=8 - KSPARSE(2, 88)=4 + KSPARSE(1, 90)=8 + KSPARSE(2, 90)=4 !HNO3/NO3 - KSPARSE(1, 89)=8 - KSPARSE(2, 89)=5 + KSPARSE(1, 91)=8 + KSPARSE(2, 91)=5 !HNO3/HNO3 - KSPARSE(1, 90)=8 - KSPARSE(2, 90)=8 + KSPARSE(1, 92)=8 + KSPARSE(2, 92)=8 !HNO3/OH - KSPARSE(1, 91)=8 - KSPARSE(2, 91)=14 + KSPARSE(1, 93)=8 + KSPARSE(2, 93)=15 !HNO3/HO2 - KSPARSE(1, 92)=8 - KSPARSE(2, 92)=15 + KSPARSE(1, 94)=8 + KSPARSE(2, 94)=16 !HNO3/ARO - KSPARSE(1, 93)=8 - KSPARSE(2, 93)=21 + KSPARSE(1, 95)=8 + KSPARSE(2, 95)=22 !HNO3/HCHO - KSPARSE(1, 94)=8 - KSPARSE(2, 94)=22 + KSPARSE(1, 96)=8 + KSPARSE(2, 96)=23 !HNO3/ALD - KSPARSE(1, 95)=8 - KSPARSE(2, 95)=23 + KSPARSE(1, 97)=8 + KSPARSE(2, 97)=24 !HNO3/CARBO - KSPARSE(1, 96)=8 - KSPARSE(2, 96)=25 + KSPARSE(1, 98)=8 + KSPARSE(2, 98)=26 !HNO4/NO2 - KSPARSE(1, 97)=9 - KSPARSE(2, 97)=4 + KSPARSE(1, 99)=9 + KSPARSE(2, 99)=4 !HNO4/HNO4 - KSPARSE(1, 98)=9 - KSPARSE(2, 98)=9 + KSPARSE(1, 100)=9 + KSPARSE(2, 100)=9 !HNO4/OH - KSPARSE(1, 99)=9 - KSPARSE(2, 99)=14 + KSPARSE(1, 101)=9 + KSPARSE(2, 101)=15 !HNO4/HO2 - KSPARSE(1, 100)=9 - KSPARSE(2, 100)=15 + KSPARSE(1, 102)=9 + KSPARSE(2, 102)=16 !NH3/NH3 - KSPARSE(1, 101)=10 - KSPARSE(2, 101)=10 + KSPARSE(1, 103)=10 + KSPARSE(2, 103)=10 !NH3/OH - KSPARSE(1, 102)=10 - KSPARSE(2, 102)=14 + KSPARSE(1, 104)=10 + KSPARSE(2, 104)=15 +!DMS/NO3 + KSPARSE(1, 105)=11 + KSPARSE(2, 105)=5 +!DMS/DMS + KSPARSE(1, 106)=11 + KSPARSE(2, 106)=11 +!DMS/OH + KSPARSE(1, 107)=11 + KSPARSE(2, 107)=15 +!SO2/NO3 + KSPARSE(1, 108)=12 + KSPARSE(2, 108)=5 +!SO2/DMS + KSPARSE(1, 109)=12 + KSPARSE(2, 109)=11 !SO2/SO2 - KSPARSE(1, 103)=11 - KSPARSE(2, 103)=11 + KSPARSE(1, 110)=12 + KSPARSE(2, 110)=12 !SO2/OH - KSPARSE(1, 104)=11 - KSPARSE(2, 104)=14 + KSPARSE(1, 111)=12 + KSPARSE(2, 111)=15 !SULF/SO2 - KSPARSE(1, 105)=12 - KSPARSE(2, 105)=11 + KSPARSE(1, 112)=13 + KSPARSE(2, 112)=12 !SULF/SULF - KSPARSE(1, 106)=12 - KSPARSE(2, 106)=12 + KSPARSE(1, 113)=13 + KSPARSE(2, 113)=13 !SULF/OH - KSPARSE(1, 107)=12 - KSPARSE(2, 107)=14 + KSPARSE(1, 114)=13 + KSPARSE(2, 114)=15 !CO/O3 - KSPARSE(1, 108)=13 - KSPARSE(2, 108)=1 + KSPARSE(1, 115)=14 + KSPARSE(2, 115)=1 !CO/NO3 - KSPARSE(1, 109)=13 - KSPARSE(2, 109)=5 + KSPARSE(1, 116)=14 + KSPARSE(2, 116)=5 !CO/CO - KSPARSE(1, 110)=13 - KSPARSE(2, 110)=13 + KSPARSE(1, 117)=14 + KSPARSE(2, 117)=14 !CO/OH - KSPARSE(1, 111)=13 - KSPARSE(2, 111)=14 + KSPARSE(1, 118)=14 + KSPARSE(2, 118)=15 !CO/ALKA - KSPARSE(1, 112)=13 - KSPARSE(2, 112)=18 + KSPARSE(1, 119)=14 + KSPARSE(2, 119)=19 !CO/ALKE - KSPARSE(1, 113)=13 - KSPARSE(2, 113)=19 + KSPARSE(1, 120)=14 + KSPARSE(2, 120)=20 !CO/BIO - KSPARSE(1, 114)=13 - KSPARSE(2, 114)=20 + KSPARSE(1, 121)=14 + KSPARSE(2, 121)=21 !CO/HCHO - KSPARSE(1, 115)=13 - KSPARSE(2, 115)=22 + KSPARSE(1, 122)=14 + KSPARSE(2, 122)=23 !CO/ALD - KSPARSE(1, 116)=13 - KSPARSE(2, 116)=23 + KSPARSE(1, 123)=14 + KSPARSE(2, 123)=24 !CO/CARBO - KSPARSE(1, 117)=13 - KSPARSE(2, 117)=25 + KSPARSE(1, 124)=14 + KSPARSE(2, 124)=26 !CO/PAN - KSPARSE(1, 118)=13 - KSPARSE(2, 118)=27 + KSPARSE(1, 125)=14 + KSPARSE(2, 125)=28 !OH/O3 - KSPARSE(1, 119)=14 - KSPARSE(2, 119)=1 + KSPARSE(1, 126)=15 + KSPARSE(2, 126)=1 !OH/H2O2 - KSPARSE(1, 120)=14 - KSPARSE(2, 120)=2 + KSPARSE(1, 127)=15 + KSPARSE(2, 127)=2 !OH/NO - KSPARSE(1, 121)=14 - KSPARSE(2, 121)=3 + KSPARSE(1, 128)=15 + KSPARSE(2, 128)=3 !OH/NO2 - KSPARSE(1, 122)=14 - KSPARSE(2, 122)=4 + KSPARSE(1, 129)=15 + KSPARSE(2, 129)=4 !OH/NO3 - KSPARSE(1, 123)=14 - KSPARSE(2, 123)=5 + KSPARSE(1, 130)=15 + KSPARSE(2, 130)=5 !OH/HONO - KSPARSE(1, 124)=14 - KSPARSE(2, 124)=7 + KSPARSE(1, 131)=15 + KSPARSE(2, 131)=7 !OH/HNO3 - KSPARSE(1, 125)=14 - KSPARSE(2, 125)=8 + KSPARSE(1, 132)=15 + KSPARSE(2, 132)=8 !OH/HNO4 - KSPARSE(1, 126)=14 - KSPARSE(2, 126)=9 + KSPARSE(1, 133)=15 + KSPARSE(2, 133)=9 !OH/NH3 - KSPARSE(1, 127)=14 - KSPARSE(2, 127)=10 + KSPARSE(1, 134)=15 + KSPARSE(2, 134)=10 +!OH/DMS + KSPARSE(1, 135)=15 + KSPARSE(2, 135)=11 !OH/SO2 - KSPARSE(1, 128)=14 - KSPARSE(2, 128)=11 + KSPARSE(1, 136)=15 + KSPARSE(2, 136)=12 !OH/CO - KSPARSE(1, 129)=14 - KSPARSE(2, 129)=13 + KSPARSE(1, 137)=15 + KSPARSE(2, 137)=14 !OH/OH - KSPARSE(1, 130)=14 - KSPARSE(2, 130)=14 + KSPARSE(1, 138)=15 + KSPARSE(2, 138)=15 !OH/HO2 - KSPARSE(1, 131)=14 - KSPARSE(2, 131)=15 + KSPARSE(1, 139)=15 + KSPARSE(2, 139)=16 !OH/CH4 - KSPARSE(1, 132)=14 - KSPARSE(2, 132)=16 + KSPARSE(1, 140)=15 + KSPARSE(2, 140)=17 !OH/ETH - KSPARSE(1, 133)=14 - KSPARSE(2, 133)=17 + KSPARSE(1, 141)=15 + KSPARSE(2, 141)=18 !OH/ALKA - KSPARSE(1, 134)=14 - KSPARSE(2, 134)=18 + KSPARSE(1, 142)=15 + KSPARSE(2, 142)=19 !OH/ALKE - KSPARSE(1, 135)=14 - KSPARSE(2, 135)=19 + KSPARSE(1, 143)=15 + KSPARSE(2, 143)=20 !OH/BIO - KSPARSE(1, 136)=14 - KSPARSE(2, 136)=20 + KSPARSE(1, 144)=15 + KSPARSE(2, 144)=21 !OH/ARO - KSPARSE(1, 137)=14 - KSPARSE(2, 137)=21 + KSPARSE(1, 145)=15 + KSPARSE(2, 145)=22 !OH/HCHO - KSPARSE(1, 138)=14 - KSPARSE(2, 138)=22 + KSPARSE(1, 146)=15 + KSPARSE(2, 146)=23 !OH/ALD - KSPARSE(1, 139)=14 - KSPARSE(2, 139)=23 + KSPARSE(1, 147)=15 + KSPARSE(2, 147)=24 !OH/KET - KSPARSE(1, 140)=14 - KSPARSE(2, 140)=24 + KSPARSE(1, 148)=15 + KSPARSE(2, 148)=25 !OH/CARBO - KSPARSE(1, 141)=14 - KSPARSE(2, 141)=25 + KSPARSE(1, 149)=15 + KSPARSE(2, 149)=26 !OH/ONIT - KSPARSE(1, 142)=14 - KSPARSE(2, 142)=26 + KSPARSE(1, 150)=15 + KSPARSE(2, 150)=27 !OH/PAN - KSPARSE(1, 143)=14 - KSPARSE(2, 143)=27 + KSPARSE(1, 151)=15 + KSPARSE(2, 151)=28 !OH/OP1 - KSPARSE(1, 144)=14 - KSPARSE(2, 144)=28 + KSPARSE(1, 152)=15 + KSPARSE(2, 152)=29 !OH/OP2 - KSPARSE(1, 145)=14 - KSPARSE(2, 145)=29 + KSPARSE(1, 153)=15 + KSPARSE(2, 153)=30 !OH/ORA1 - KSPARSE(1, 146)=14 - KSPARSE(2, 146)=30 + KSPARSE(1, 154)=15 + KSPARSE(2, 154)=31 !OH/ORA2 - KSPARSE(1, 147)=14 - KSPARSE(2, 147)=31 + KSPARSE(1, 155)=15 + KSPARSE(2, 155)=32 !OH/ADD - KSPARSE(1, 148)=14 - KSPARSE(2, 148)=37 + KSPARSE(1, 156)=15 + KSPARSE(2, 156)=38 !HO2/O3 - KSPARSE(1, 149)=15 - KSPARSE(2, 149)=1 + KSPARSE(1, 157)=16 + KSPARSE(2, 157)=1 !HO2/H2O2 - KSPARSE(1, 150)=15 - KSPARSE(2, 150)=2 + KSPARSE(1, 158)=16 + KSPARSE(2, 158)=2 !HO2/NO - KSPARSE(1, 151)=15 - KSPARSE(2, 151)=3 + KSPARSE(1, 159)=16 + KSPARSE(2, 159)=3 !HO2/NO2 - KSPARSE(1, 152)=15 - KSPARSE(2, 152)=4 + KSPARSE(1, 160)=16 + KSPARSE(2, 160)=4 !HO2/NO3 - KSPARSE(1, 153)=15 - KSPARSE(2, 153)=5 + KSPARSE(1, 161)=16 + KSPARSE(2, 161)=5 !HO2/HNO4 - KSPARSE(1, 154)=15 - KSPARSE(2, 154)=9 + KSPARSE(1, 162)=16 + KSPARSE(2, 162)=9 !HO2/SO2 - KSPARSE(1, 155)=15 - KSPARSE(2, 155)=11 + KSPARSE(1, 163)=16 + KSPARSE(2, 163)=12 !HO2/CO - KSPARSE(1, 156)=15 - KSPARSE(2, 156)=13 + KSPARSE(1, 164)=16 + KSPARSE(2, 164)=14 !HO2/OH - KSPARSE(1, 157)=15 - KSPARSE(2, 157)=14 + KSPARSE(1, 165)=16 + KSPARSE(2, 165)=15 !HO2/HO2 - KSPARSE(1, 158)=15 - KSPARSE(2, 158)=15 + KSPARSE(1, 166)=16 + KSPARSE(2, 166)=16 !HO2/ALKA - KSPARSE(1, 159)=15 - KSPARSE(2, 159)=18 + KSPARSE(1, 167)=16 + KSPARSE(2, 167)=19 !HO2/ALKE - KSPARSE(1, 160)=15 - KSPARSE(2, 160)=19 + KSPARSE(1, 168)=16 + KSPARSE(2, 168)=20 !HO2/BIO - KSPARSE(1, 161)=15 - KSPARSE(2, 161)=20 + KSPARSE(1, 169)=16 + KSPARSE(2, 169)=21 !HO2/ARO - KSPARSE(1, 162)=15 - KSPARSE(2, 162)=21 + KSPARSE(1, 170)=16 + KSPARSE(2, 170)=22 !HO2/HCHO - KSPARSE(1, 163)=15 - KSPARSE(2, 163)=22 + KSPARSE(1, 171)=16 + KSPARSE(2, 171)=23 !HO2/ALD - KSPARSE(1, 164)=15 - KSPARSE(2, 164)=23 + KSPARSE(1, 172)=16 + KSPARSE(2, 172)=24 !HO2/CARBO - KSPARSE(1, 165)=15 - KSPARSE(2, 165)=25 + KSPARSE(1, 173)=16 + KSPARSE(2, 173)=26 !HO2/ONIT - KSPARSE(1, 166)=15 - KSPARSE(2, 166)=26 + KSPARSE(1, 174)=16 + KSPARSE(2, 174)=27 !HO2/PAN - KSPARSE(1, 167)=15 - KSPARSE(2, 167)=27 + KSPARSE(1, 175)=16 + KSPARSE(2, 175)=28 !HO2/OP1 - KSPARSE(1, 168)=15 - KSPARSE(2, 168)=28 + KSPARSE(1, 176)=16 + KSPARSE(2, 176)=29 !HO2/OP2 - KSPARSE(1, 169)=15 - KSPARSE(2, 169)=29 + KSPARSE(1, 177)=16 + KSPARSE(2, 177)=30 !HO2/ORA1 - KSPARSE(1, 170)=15 - KSPARSE(2, 170)=30 + KSPARSE(1, 178)=16 + KSPARSE(2, 178)=31 !HO2/MO2 - KSPARSE(1, 171)=15 - KSPARSE(2, 171)=32 + KSPARSE(1, 179)=16 + KSPARSE(2, 179)=33 !HO2/ALKAP - KSPARSE(1, 172)=15 - KSPARSE(2, 172)=33 + KSPARSE(1, 180)=16 + KSPARSE(2, 180)=34 !HO2/ALKEP - KSPARSE(1, 173)=15 - KSPARSE(2, 173)=34 + KSPARSE(1, 181)=16 + KSPARSE(2, 181)=35 !HO2/BIOP - KSPARSE(1, 174)=15 - KSPARSE(2, 174)=35 + KSPARSE(1, 182)=16 + KSPARSE(2, 182)=36 !HO2/PHO - KSPARSE(1, 175)=15 - KSPARSE(2, 175)=36 + KSPARSE(1, 183)=16 + KSPARSE(2, 183)=37 !HO2/ADD - KSPARSE(1, 176)=15 - KSPARSE(2, 176)=37 + KSPARSE(1, 184)=16 + KSPARSE(2, 184)=38 !HO2/AROP - KSPARSE(1, 177)=15 - KSPARSE(2, 177)=38 + KSPARSE(1, 185)=16 + KSPARSE(2, 185)=39 !HO2/CARBOP - KSPARSE(1, 178)=15 - KSPARSE(2, 178)=39 + KSPARSE(1, 186)=16 + KSPARSE(2, 186)=40 !HO2/OLN - KSPARSE(1, 179)=15 - KSPARSE(2, 179)=40 + KSPARSE(1, 187)=16 + KSPARSE(2, 187)=41 !HO2/XO2 - KSPARSE(1, 180)=15 - KSPARSE(2, 180)=41 + KSPARSE(1, 188)=16 + KSPARSE(2, 188)=42 !CH4/O3 - KSPARSE(1, 181)=16 - KSPARSE(2, 181)=1 + KSPARSE(1, 189)=17 + KSPARSE(2, 189)=1 !CH4/OH - KSPARSE(1, 182)=16 - KSPARSE(2, 182)=14 + KSPARSE(1, 190)=17 + KSPARSE(2, 190)=15 !CH4/CH4 - KSPARSE(1, 183)=16 - KSPARSE(2, 183)=16 + KSPARSE(1, 191)=17 + KSPARSE(2, 191)=17 !CH4/ALKE - KSPARSE(1, 184)=16 - KSPARSE(2, 184)=19 + KSPARSE(1, 192)=17 + KSPARSE(2, 192)=20 !ETH/O3 - KSPARSE(1, 185)=17 - KSPARSE(2, 185)=1 + KSPARSE(1, 193)=18 + KSPARSE(2, 193)=1 !ETH/OH - KSPARSE(1, 186)=17 - KSPARSE(2, 186)=14 + KSPARSE(1, 194)=18 + KSPARSE(2, 194)=15 !ETH/ETH - KSPARSE(1, 187)=17 - KSPARSE(2, 187)=17 + KSPARSE(1, 195)=18 + KSPARSE(2, 195)=18 !ETH/ALKE - KSPARSE(1, 188)=17 - KSPARSE(2, 188)=19 + KSPARSE(1, 196)=18 + KSPARSE(2, 196)=20 !ALKA/OH - KSPARSE(1, 189)=18 - KSPARSE(2, 189)=14 + KSPARSE(1, 197)=19 + KSPARSE(2, 197)=15 !ALKA/ALKA - KSPARSE(1, 190)=18 - KSPARSE(2, 190)=18 + KSPARSE(1, 198)=19 + KSPARSE(2, 198)=19 !ALKE/O3 - KSPARSE(1, 191)=19 - KSPARSE(2, 191)=1 + KSPARSE(1, 199)=20 + KSPARSE(2, 199)=1 !ALKE/NO - KSPARSE(1, 192)=19 - KSPARSE(2, 192)=3 + KSPARSE(1, 200)=20 + KSPARSE(2, 200)=3 !ALKE/NO3 - KSPARSE(1, 193)=19 - KSPARSE(2, 193)=5 + KSPARSE(1, 201)=20 + KSPARSE(2, 201)=5 !ALKE/OH - KSPARSE(1, 194)=19 - KSPARSE(2, 194)=14 + KSPARSE(1, 202)=20 + KSPARSE(2, 202)=15 !ALKE/ALKE - KSPARSE(1, 195)=19 - KSPARSE(2, 195)=19 + KSPARSE(1, 203)=20 + KSPARSE(2, 203)=20 !ALKE/BIO - KSPARSE(1, 196)=19 - KSPARSE(2, 196)=20 + KSPARSE(1, 204)=20 + KSPARSE(2, 204)=21 !ALKE/MO2 - KSPARSE(1, 197)=19 - KSPARSE(2, 197)=32 + KSPARSE(1, 205)=20 + KSPARSE(2, 205)=33 !ALKE/BIOP - KSPARSE(1, 198)=19 - KSPARSE(2, 198)=35 + KSPARSE(1, 206)=20 + KSPARSE(2, 206)=36 !ALKE/CARBOP - KSPARSE(1, 199)=19 - KSPARSE(2, 199)=39 + KSPARSE(1, 207)=20 + KSPARSE(2, 207)=40 !BIO/O3 - KSPARSE(1, 200)=20 - KSPARSE(2, 200)=1 + KSPARSE(1, 208)=21 + KSPARSE(2, 208)=1 !BIO/NO3 - KSPARSE(1, 201)=20 - KSPARSE(2, 201)=5 + KSPARSE(1, 209)=21 + KSPARSE(2, 209)=5 !BIO/OH - KSPARSE(1, 202)=20 - KSPARSE(2, 202)=14 + KSPARSE(1, 210)=21 + KSPARSE(2, 210)=15 !BIO/BIO - KSPARSE(1, 203)=20 - KSPARSE(2, 203)=20 + KSPARSE(1, 211)=21 + KSPARSE(2, 211)=21 !ARO/O3 - KSPARSE(1, 204)=21 - KSPARSE(2, 204)=1 + KSPARSE(1, 212)=22 + KSPARSE(2, 212)=1 !ARO/NO2 - KSPARSE(1, 205)=21 - KSPARSE(2, 205)=4 + KSPARSE(1, 213)=22 + KSPARSE(2, 213)=4 !ARO/NO3 - KSPARSE(1, 206)=21 - KSPARSE(2, 206)=5 + KSPARSE(1, 214)=22 + KSPARSE(2, 214)=5 !ARO/OH - KSPARSE(1, 207)=21 - KSPARSE(2, 207)=14 + KSPARSE(1, 215)=22 + KSPARSE(2, 215)=15 !ARO/HO2 - KSPARSE(1, 208)=21 - KSPARSE(2, 208)=15 + KSPARSE(1, 216)=22 + KSPARSE(2, 216)=16 !ARO/ARO - KSPARSE(1, 209)=21 - KSPARSE(2, 209)=21 + KSPARSE(1, 217)=22 + KSPARSE(2, 217)=22 !ARO/PHO - KSPARSE(1, 210)=21 - KSPARSE(2, 210)=36 + KSPARSE(1, 218)=22 + KSPARSE(2, 218)=37 !ARO/ADD - KSPARSE(1, 211)=21 - KSPARSE(2, 211)=37 + KSPARSE(1, 219)=22 + KSPARSE(2, 219)=38 !HCHO/O3 - KSPARSE(1, 212)=22 - KSPARSE(2, 212)=1 + KSPARSE(1, 220)=23 + KSPARSE(2, 220)=1 !HCHO/NO - KSPARSE(1, 213)=22 - KSPARSE(2, 213)=3 + KSPARSE(1, 221)=23 + KSPARSE(2, 221)=3 !HCHO/NO3 - KSPARSE(1, 214)=22 - KSPARSE(2, 214)=5 + KSPARSE(1, 222)=23 + KSPARSE(2, 222)=5 !HCHO/OH - KSPARSE(1, 215)=22 - KSPARSE(2, 215)=14 + KSPARSE(1, 223)=23 + KSPARSE(2, 223)=15 !HCHO/ALKA - KSPARSE(1, 216)=22 - KSPARSE(2, 216)=18 + KSPARSE(1, 224)=23 + KSPARSE(2, 224)=19 !HCHO/ALKE - KSPARSE(1, 217)=22 - KSPARSE(2, 217)=19 + KSPARSE(1, 225)=23 + KSPARSE(2, 225)=20 !HCHO/BIO - KSPARSE(1, 218)=22 - KSPARSE(2, 218)=20 + KSPARSE(1, 226)=23 + KSPARSE(2, 226)=21 !HCHO/HCHO - KSPARSE(1, 219)=22 - KSPARSE(2, 219)=22 + KSPARSE(1, 227)=23 + KSPARSE(2, 227)=23 !HCHO/CARBO - KSPARSE(1, 220)=22 - KSPARSE(2, 220)=25 + KSPARSE(1, 228)=23 + KSPARSE(2, 228)=26 !HCHO/PAN - KSPARSE(1, 221)=22 - KSPARSE(2, 221)=27 + KSPARSE(1, 229)=23 + KSPARSE(2, 229)=28 !HCHO/OP1 - KSPARSE(1, 222)=22 - KSPARSE(2, 222)=28 + KSPARSE(1, 230)=23 + KSPARSE(2, 230)=29 !HCHO/OP2 - KSPARSE(1, 223)=22 - KSPARSE(2, 223)=29 + KSPARSE(1, 231)=23 + KSPARSE(2, 231)=30 !HCHO/MO2 - KSPARSE(1, 224)=22 - KSPARSE(2, 224)=32 + KSPARSE(1, 232)=23 + KSPARSE(2, 232)=33 !HCHO/ALKAP - KSPARSE(1, 225)=22 - KSPARSE(2, 225)=33 + KSPARSE(1, 233)=23 + KSPARSE(2, 233)=34 !HCHO/ALKEP - KSPARSE(1, 226)=22 - KSPARSE(2, 226)=34 + KSPARSE(1, 234)=23 + KSPARSE(2, 234)=35 !HCHO/BIOP - KSPARSE(1, 227)=22 - KSPARSE(2, 227)=35 + KSPARSE(1, 235)=23 + KSPARSE(2, 235)=36 !HCHO/AROP - KSPARSE(1, 228)=22 - KSPARSE(2, 228)=38 + KSPARSE(1, 236)=23 + KSPARSE(2, 236)=39 !HCHO/CARBOP - KSPARSE(1, 229)=22 - KSPARSE(2, 229)=39 + KSPARSE(1, 237)=23 + KSPARSE(2, 237)=40 !HCHO/OLN - KSPARSE(1, 230)=22 - KSPARSE(2, 230)=40 + KSPARSE(1, 238)=23 + KSPARSE(2, 238)=41 !HCHO/XO2 - KSPARSE(1, 231)=22 - KSPARSE(2, 231)=41 + KSPARSE(1, 239)=23 + KSPARSE(2, 239)=42 !ALD/O3 - KSPARSE(1, 232)=23 - KSPARSE(2, 232)=1 + KSPARSE(1, 240)=24 + KSPARSE(2, 240)=1 !ALD/NO - KSPARSE(1, 233)=23 - KSPARSE(2, 233)=3 + KSPARSE(1, 241)=24 + KSPARSE(2, 241)=3 !ALD/NO3 - KSPARSE(1, 234)=23 - KSPARSE(2, 234)=5 + KSPARSE(1, 242)=24 + KSPARSE(2, 242)=5 !ALD/OH - KSPARSE(1, 235)=23 - KSPARSE(2, 235)=14 + KSPARSE(1, 243)=24 + KSPARSE(2, 243)=15 !ALD/ALKA - KSPARSE(1, 236)=23 - KSPARSE(2, 236)=18 + KSPARSE(1, 244)=24 + KSPARSE(2, 244)=19 !ALD/ALKE - KSPARSE(1, 237)=23 - KSPARSE(2, 237)=19 + KSPARSE(1, 245)=24 + KSPARSE(2, 245)=20 !ALD/BIO - KSPARSE(1, 238)=23 - KSPARSE(2, 238)=20 + KSPARSE(1, 246)=24 + KSPARSE(2, 246)=21 !ALD/ALD - KSPARSE(1, 239)=23 - KSPARSE(2, 239)=23 + KSPARSE(1, 247)=24 + KSPARSE(2, 247)=24 !ALD/CARBO - KSPARSE(1, 240)=23 - KSPARSE(2, 240)=25 + KSPARSE(1, 248)=24 + KSPARSE(2, 248)=26 !ALD/ONIT - KSPARSE(1, 241)=23 - KSPARSE(2, 241)=26 + KSPARSE(1, 249)=24 + KSPARSE(2, 249)=27 !ALD/OP2 - KSPARSE(1, 242)=23 - KSPARSE(2, 242)=29 + KSPARSE(1, 250)=24 + KSPARSE(2, 250)=30 !ALD/MO2 - KSPARSE(1, 243)=23 - KSPARSE(2, 243)=32 + KSPARSE(1, 251)=24 + KSPARSE(2, 251)=33 !ALD/ALKAP - KSPARSE(1, 244)=23 - KSPARSE(2, 244)=33 + KSPARSE(1, 252)=24 + KSPARSE(2, 252)=34 !ALD/ALKEP - KSPARSE(1, 245)=23 - KSPARSE(2, 245)=34 + KSPARSE(1, 253)=24 + KSPARSE(2, 253)=35 !ALD/BIOP - KSPARSE(1, 246)=23 - KSPARSE(2, 246)=35 + KSPARSE(1, 254)=24 + KSPARSE(2, 254)=36 !ALD/CARBOP - KSPARSE(1, 247)=23 - KSPARSE(2, 247)=39 + KSPARSE(1, 255)=24 + KSPARSE(2, 255)=40 !ALD/OLN - KSPARSE(1, 248)=23 - KSPARSE(2, 248)=40 + KSPARSE(1, 256)=24 + KSPARSE(2, 256)=41 !KET/O3 - KSPARSE(1, 249)=24 - KSPARSE(2, 249)=1 + KSPARSE(1, 257)=25 + KSPARSE(2, 257)=1 !KET/NO - KSPARSE(1, 250)=24 - KSPARSE(2, 250)=3 + KSPARSE(1, 258)=25 + KSPARSE(2, 258)=3 !KET/NO3 - KSPARSE(1, 251)=24 - KSPARSE(2, 251)=5 + KSPARSE(1, 259)=25 + KSPARSE(2, 259)=5 !KET/OH - KSPARSE(1, 252)=24 - KSPARSE(2, 252)=14 + KSPARSE(1, 260)=25 + KSPARSE(2, 260)=15 !KET/ALKA - KSPARSE(1, 253)=24 - KSPARSE(2, 253)=18 + KSPARSE(1, 261)=25 + KSPARSE(2, 261)=19 !KET/ALKE - KSPARSE(1, 254)=24 - KSPARSE(2, 254)=19 + KSPARSE(1, 262)=25 + KSPARSE(2, 262)=20 !KET/BIO - KSPARSE(1, 255)=24 - KSPARSE(2, 255)=20 + KSPARSE(1, 263)=25 + KSPARSE(2, 263)=21 !KET/KET - KSPARSE(1, 256)=24 - KSPARSE(2, 256)=24 + KSPARSE(1, 264)=25 + KSPARSE(2, 264)=25 !KET/CARBO - KSPARSE(1, 257)=24 - KSPARSE(2, 257)=25 + KSPARSE(1, 265)=25 + KSPARSE(2, 265)=26 !KET/ONIT - KSPARSE(1, 258)=24 - KSPARSE(2, 258)=26 + KSPARSE(1, 266)=25 + KSPARSE(2, 266)=27 !KET/OP2 - KSPARSE(1, 259)=24 - KSPARSE(2, 259)=29 + KSPARSE(1, 267)=25 + KSPARSE(2, 267)=30 !KET/MO2 - KSPARSE(1, 260)=24 - KSPARSE(2, 260)=32 + KSPARSE(1, 268)=25 + KSPARSE(2, 268)=33 !KET/ALKAP - KSPARSE(1, 261)=24 - KSPARSE(2, 261)=33 + KSPARSE(1, 269)=25 + KSPARSE(2, 269)=34 !KET/ALKEP - KSPARSE(1, 262)=24 - KSPARSE(2, 262)=34 + KSPARSE(1, 270)=25 + KSPARSE(2, 270)=35 !KET/BIOP - KSPARSE(1, 263)=24 - KSPARSE(2, 263)=35 + KSPARSE(1, 271)=25 + KSPARSE(2, 271)=36 !KET/CARBOP - KSPARSE(1, 264)=24 - KSPARSE(2, 264)=39 + KSPARSE(1, 272)=25 + KSPARSE(2, 272)=40 !KET/OLN - KSPARSE(1, 265)=24 - KSPARSE(2, 265)=40 + KSPARSE(1, 273)=25 + KSPARSE(2, 273)=41 !CARBO/O3 - KSPARSE(1, 266)=25 - KSPARSE(2, 266)=1 + KSPARSE(1, 274)=26 + KSPARSE(2, 274)=1 !CARBO/NO - KSPARSE(1, 267)=25 - KSPARSE(2, 267)=3 + KSPARSE(1, 275)=26 + KSPARSE(2, 275)=3 !CARBO/NO3 - KSPARSE(1, 268)=25 - KSPARSE(2, 268)=5 + KSPARSE(1, 276)=26 + KSPARSE(2, 276)=5 !CARBO/OH - KSPARSE(1, 269)=25 - KSPARSE(2, 269)=14 + KSPARSE(1, 277)=26 + KSPARSE(2, 277)=15 !CARBO/ALKA - KSPARSE(1, 270)=25 - KSPARSE(2, 270)=18 + KSPARSE(1, 278)=26 + KSPARSE(2, 278)=19 !CARBO/ALKE - KSPARSE(1, 271)=25 - KSPARSE(2, 271)=19 + KSPARSE(1, 279)=26 + KSPARSE(2, 279)=20 !CARBO/BIO - KSPARSE(1, 272)=25 - KSPARSE(2, 272)=20 + KSPARSE(1, 280)=26 + KSPARSE(2, 280)=21 !CARBO/CARBO - KSPARSE(1, 273)=25 - KSPARSE(2, 273)=25 + KSPARSE(1, 281)=26 + KSPARSE(2, 281)=26 !CARBO/PAN - KSPARSE(1, 274)=25 - KSPARSE(2, 274)=27 + KSPARSE(1, 282)=26 + KSPARSE(2, 282)=28 !CARBO/MO2 - KSPARSE(1, 275)=25 - KSPARSE(2, 275)=32 + KSPARSE(1, 283)=26 + KSPARSE(2, 283)=33 !CARBO/ALKAP - KSPARSE(1, 276)=25 - KSPARSE(2, 276)=33 + KSPARSE(1, 284)=26 + KSPARSE(2, 284)=34 !CARBO/BIOP - KSPARSE(1, 277)=25 - KSPARSE(2, 277)=35 + KSPARSE(1, 285)=26 + KSPARSE(2, 285)=36 !CARBO/AROP - KSPARSE(1, 278)=25 - KSPARSE(2, 278)=38 + KSPARSE(1, 286)=26 + KSPARSE(2, 286)=39 !CARBO/CARBOP - KSPARSE(1, 279)=25 - KSPARSE(2, 279)=39 + KSPARSE(1, 287)=26 + KSPARSE(2, 287)=40 !ONIT/NO - KSPARSE(1, 280)=26 - KSPARSE(2, 280)=3 + KSPARSE(1, 288)=27 + KSPARSE(2, 288)=3 !ONIT/NO2 - KSPARSE(1, 281)=26 - KSPARSE(2, 281)=4 + KSPARSE(1, 289)=27 + KSPARSE(2, 289)=4 !ONIT/NO3 - KSPARSE(1, 282)=26 - KSPARSE(2, 282)=5 + KSPARSE(1, 290)=27 + KSPARSE(2, 290)=5 !ONIT/OH - KSPARSE(1, 283)=26 - KSPARSE(2, 283)=14 + KSPARSE(1, 291)=27 + KSPARSE(2, 291)=15 !ONIT/HO2 - KSPARSE(1, 284)=26 - KSPARSE(2, 284)=15 + KSPARSE(1, 292)=27 + KSPARSE(2, 292)=16 !ONIT/ONIT - KSPARSE(1, 285)=26 - KSPARSE(2, 285)=26 + KSPARSE(1, 293)=27 + KSPARSE(2, 293)=27 !ONIT/PAN - KSPARSE(1, 286)=26 - KSPARSE(2, 286)=27 + KSPARSE(1, 294)=27 + KSPARSE(2, 294)=28 !ONIT/MO2 - KSPARSE(1, 287)=26 - KSPARSE(2, 287)=32 + KSPARSE(1, 295)=27 + KSPARSE(2, 295)=33 !ONIT/ALKAP - KSPARSE(1, 288)=26 - KSPARSE(2, 288)=33 + KSPARSE(1, 296)=27 + KSPARSE(2, 296)=34 !ONIT/BIOP - KSPARSE(1, 289)=26 - KSPARSE(2, 289)=35 + KSPARSE(1, 297)=27 + KSPARSE(2, 297)=36 !ONIT/PHO - KSPARSE(1, 290)=26 - KSPARSE(2, 290)=36 + KSPARSE(1, 298)=27 + KSPARSE(2, 298)=37 !ONIT/AROP - KSPARSE(1, 291)=26 - KSPARSE(2, 291)=38 + KSPARSE(1, 299)=27 + KSPARSE(2, 299)=39 !ONIT/CARBOP - KSPARSE(1, 292)=26 - KSPARSE(2, 292)=39 + KSPARSE(1, 300)=27 + KSPARSE(2, 300)=40 !ONIT/OLN - KSPARSE(1, 293)=26 - KSPARSE(2, 293)=40 + KSPARSE(1, 301)=27 + KSPARSE(2, 301)=41 !PAN/O3 - KSPARSE(1, 294)=27 - KSPARSE(2, 294)=1 + KSPARSE(1, 302)=28 + KSPARSE(2, 302)=1 !PAN/NO2 - KSPARSE(1, 295)=27 - KSPARSE(2, 295)=4 + KSPARSE(1, 303)=28 + KSPARSE(2, 303)=4 !PAN/NO3 - KSPARSE(1, 296)=27 - KSPARSE(2, 296)=5 + KSPARSE(1, 304)=28 + KSPARSE(2, 304)=5 !PAN/OH - KSPARSE(1, 297)=27 - KSPARSE(2, 297)=14 + KSPARSE(1, 305)=28 + KSPARSE(2, 305)=15 !PAN/PAN - KSPARSE(1, 298)=27 - KSPARSE(2, 298)=27 + KSPARSE(1, 306)=28 + KSPARSE(2, 306)=28 !PAN/CARBOP - KSPARSE(1, 299)=27 - KSPARSE(2, 299)=39 + KSPARSE(1, 307)=28 + KSPARSE(2, 307)=40 !OP1/OH - KSPARSE(1, 300)=28 - KSPARSE(2, 300)=14 + KSPARSE(1, 308)=29 + KSPARSE(2, 308)=15 !OP1/HO2 - KSPARSE(1, 301)=28 - KSPARSE(2, 301)=15 + KSPARSE(1, 309)=29 + KSPARSE(2, 309)=16 !OP1/OP1 - KSPARSE(1, 302)=28 - KSPARSE(2, 302)=28 + KSPARSE(1, 310)=29 + KSPARSE(2, 310)=29 !OP1/MO2 - KSPARSE(1, 303)=28 - KSPARSE(2, 303)=32 + KSPARSE(1, 311)=29 + KSPARSE(2, 311)=33 !OP2/O3 - KSPARSE(1, 304)=29 - KSPARSE(2, 304)=1 + KSPARSE(1, 312)=30 + KSPARSE(2, 312)=1 !OP2/OH - KSPARSE(1, 305)=29 - KSPARSE(2, 305)=14 + KSPARSE(1, 313)=30 + KSPARSE(2, 313)=15 !OP2/HO2 - KSPARSE(1, 306)=29 - KSPARSE(2, 306)=15 + KSPARSE(1, 314)=30 + KSPARSE(2, 314)=16 !OP2/CARBO - KSPARSE(1, 307)=29 - KSPARSE(2, 307)=25 + KSPARSE(1, 315)=30 + KSPARSE(2, 315)=26 !OP2/OP2 - KSPARSE(1, 308)=29 - KSPARSE(2, 308)=29 + KSPARSE(1, 316)=30 + KSPARSE(2, 316)=30 !OP2/ALKAP - KSPARSE(1, 309)=29 - KSPARSE(2, 309)=33 + KSPARSE(1, 317)=30 + KSPARSE(2, 317)=34 !OP2/ALKEP - KSPARSE(1, 310)=29 - KSPARSE(2, 310)=34 + KSPARSE(1, 318)=30 + KSPARSE(2, 318)=35 !OP2/BIOP - KSPARSE(1, 311)=29 - KSPARSE(2, 311)=35 + KSPARSE(1, 319)=30 + KSPARSE(2, 319)=36 !OP2/AROP - KSPARSE(1, 312)=29 - KSPARSE(2, 312)=38 + KSPARSE(1, 320)=30 + KSPARSE(2, 320)=39 !OP2/CARBOP - KSPARSE(1, 313)=29 - KSPARSE(2, 313)=39 + KSPARSE(1, 321)=30 + KSPARSE(2, 321)=40 !OP2/XO2 - KSPARSE(1, 314)=29 - KSPARSE(2, 314)=41 + KSPARSE(1, 322)=30 + KSPARSE(2, 322)=42 !ORA1/O3 - KSPARSE(1, 315)=30 - KSPARSE(2, 315)=1 + KSPARSE(1, 323)=31 + KSPARSE(2, 323)=1 !ORA1/OH - KSPARSE(1, 316)=30 - KSPARSE(2, 316)=14 + KSPARSE(1, 324)=31 + KSPARSE(2, 324)=15 !ORA1/ALKA - KSPARSE(1, 317)=30 - KSPARSE(2, 317)=18 + KSPARSE(1, 325)=31 + KSPARSE(2, 325)=19 !ORA1/ALKE - KSPARSE(1, 318)=30 - KSPARSE(2, 318)=19 + KSPARSE(1, 326)=31 + KSPARSE(2, 326)=20 !ORA1/BIO - KSPARSE(1, 319)=30 - KSPARSE(2, 319)=20 + KSPARSE(1, 327)=31 + KSPARSE(2, 327)=21 !ORA1/CARBO - KSPARSE(1, 320)=30 - KSPARSE(2, 320)=25 + KSPARSE(1, 328)=31 + KSPARSE(2, 328)=26 !ORA1/PAN - KSPARSE(1, 321)=30 - KSPARSE(2, 321)=27 + KSPARSE(1, 329)=31 + KSPARSE(2, 329)=28 !ORA1/ORA1 - KSPARSE(1, 322)=30 - KSPARSE(2, 322)=30 + KSPARSE(1, 330)=31 + KSPARSE(2, 330)=31 !ORA2/O3 - KSPARSE(1, 323)=31 - KSPARSE(2, 323)=1 + KSPARSE(1, 331)=32 + KSPARSE(2, 331)=1 !ORA2/OH - KSPARSE(1, 324)=31 - KSPARSE(2, 324)=14 + KSPARSE(1, 332)=32 + KSPARSE(2, 332)=15 !ORA2/HO2 - KSPARSE(1, 325)=31 - KSPARSE(2, 325)=15 + KSPARSE(1, 333)=32 + KSPARSE(2, 333)=16 !ORA2/ALKE - KSPARSE(1, 326)=31 - KSPARSE(2, 326)=19 + KSPARSE(1, 334)=32 + KSPARSE(2, 334)=20 !ORA2/BIO - KSPARSE(1, 327)=31 - KSPARSE(2, 327)=20 + KSPARSE(1, 335)=32 + KSPARSE(2, 335)=21 !ORA2/CARBO - KSPARSE(1, 328)=31 - KSPARSE(2, 328)=25 + KSPARSE(1, 336)=32 + KSPARSE(2, 336)=26 !ORA2/ORA2 - KSPARSE(1, 329)=31 - KSPARSE(2, 329)=31 + KSPARSE(1, 337)=32 + KSPARSE(2, 337)=32 !ORA2/MO2 - KSPARSE(1, 330)=31 - KSPARSE(2, 330)=32 + KSPARSE(1, 338)=32 + KSPARSE(2, 338)=33 !ORA2/ALKAP - KSPARSE(1, 331)=31 - KSPARSE(2, 331)=33 + KSPARSE(1, 339)=32 + KSPARSE(2, 339)=34 !ORA2/ALKEP - KSPARSE(1, 332)=31 - KSPARSE(2, 332)=34 + KSPARSE(1, 340)=32 + KSPARSE(2, 340)=35 !ORA2/BIOP - KSPARSE(1, 333)=31 - KSPARSE(2, 333)=35 + KSPARSE(1, 341)=32 + KSPARSE(2, 341)=36 !ORA2/CARBOP - KSPARSE(1, 334)=31 - KSPARSE(2, 334)=39 + KSPARSE(1, 342)=32 + KSPARSE(2, 342)=40 !ORA2/OLN - KSPARSE(1, 335)=31 - KSPARSE(2, 335)=40 + KSPARSE(1, 343)=32 + KSPARSE(2, 343)=41 !MO2/O3 - KSPARSE(1, 336)=32 - KSPARSE(2, 336)=1 + KSPARSE(1, 344)=33 + KSPARSE(2, 344)=1 !MO2/NO - KSPARSE(1, 337)=32 - KSPARSE(2, 337)=3 + KSPARSE(1, 345)=33 + KSPARSE(2, 345)=3 !MO2/NO3 - KSPARSE(1, 338)=32 - KSPARSE(2, 338)=5 + KSPARSE(1, 346)=33 + KSPARSE(2, 346)=5 !MO2/OH - KSPARSE(1, 339)=32 - KSPARSE(2, 339)=14 + KSPARSE(1, 347)=33 + KSPARSE(2, 347)=15 !MO2/HO2 - KSPARSE(1, 340)=32 - KSPARSE(2, 340)=15 + KSPARSE(1, 348)=33 + KSPARSE(2, 348)=16 !MO2/CH4 - KSPARSE(1, 341)=32 - KSPARSE(2, 341)=16 + KSPARSE(1, 349)=33 + KSPARSE(2, 349)=17 !MO2/ALKE - KSPARSE(1, 342)=32 - KSPARSE(2, 342)=19 + KSPARSE(1, 350)=33 + KSPARSE(2, 350)=20 !MO2/BIO - KSPARSE(1, 343)=32 - KSPARSE(2, 343)=20 + KSPARSE(1, 351)=33 + KSPARSE(2, 351)=21 !MO2/ALD - KSPARSE(1, 344)=32 - KSPARSE(2, 344)=23 + KSPARSE(1, 352)=33 + KSPARSE(2, 352)=24 !MO2/OP1 - KSPARSE(1, 345)=32 - KSPARSE(2, 345)=28 + KSPARSE(1, 353)=33 + KSPARSE(2, 353)=29 !MO2/OP2 - KSPARSE(1, 346)=32 - KSPARSE(2, 346)=29 + KSPARSE(1, 354)=33 + KSPARSE(2, 354)=30 !MO2/MO2 - KSPARSE(1, 347)=32 - KSPARSE(2, 347)=32 + KSPARSE(1, 355)=33 + KSPARSE(2, 355)=33 !MO2/ALKAP - KSPARSE(1, 348)=32 - KSPARSE(2, 348)=33 + KSPARSE(1, 356)=33 + KSPARSE(2, 356)=34 !MO2/ALKEP - KSPARSE(1, 349)=32 - KSPARSE(2, 349)=34 + KSPARSE(1, 357)=33 + KSPARSE(2, 357)=35 !MO2/BIOP - KSPARSE(1, 350)=32 - KSPARSE(2, 350)=35 + KSPARSE(1, 358)=33 + KSPARSE(2, 358)=36 !MO2/AROP - KSPARSE(1, 351)=32 - KSPARSE(2, 351)=38 + KSPARSE(1, 359)=33 + KSPARSE(2, 359)=39 !MO2/CARBOP - KSPARSE(1, 352)=32 - KSPARSE(2, 352)=39 + KSPARSE(1, 360)=33 + KSPARSE(2, 360)=40 !MO2/OLN - KSPARSE(1, 353)=32 - KSPARSE(2, 353)=40 + KSPARSE(1, 361)=33 + KSPARSE(2, 361)=41 !MO2/XO2 - KSPARSE(1, 354)=32 - KSPARSE(2, 354)=41 + KSPARSE(1, 362)=33 + KSPARSE(2, 362)=42 !ALKAP/O3 - KSPARSE(1, 355)=33 - KSPARSE(2, 355)=1 + KSPARSE(1, 363)=34 + KSPARSE(2, 363)=1 !ALKAP/NO - KSPARSE(1, 356)=33 - KSPARSE(2, 356)=3 + KSPARSE(1, 364)=34 + KSPARSE(2, 364)=3 !ALKAP/NO3 - KSPARSE(1, 357)=33 - KSPARSE(2, 357)=5 + KSPARSE(1, 365)=34 + KSPARSE(2, 365)=5 !ALKAP/OH - KSPARSE(1, 358)=33 - KSPARSE(2, 358)=14 + KSPARSE(1, 366)=34 + KSPARSE(2, 366)=15 !ALKAP/HO2 - KSPARSE(1, 359)=33 - KSPARSE(2, 359)=15 + KSPARSE(1, 367)=34 + KSPARSE(2, 367)=16 !ALKAP/ETH - KSPARSE(1, 360)=33 - KSPARSE(2, 360)=17 + KSPARSE(1, 368)=34 + KSPARSE(2, 368)=18 !ALKAP/ALKA - KSPARSE(1, 361)=33 - KSPARSE(2, 361)=18 + KSPARSE(1, 369)=34 + KSPARSE(2, 369)=19 !ALKAP/ALKE - KSPARSE(1, 362)=33 - KSPARSE(2, 362)=19 + KSPARSE(1, 370)=34 + KSPARSE(2, 370)=20 !ALKAP/BIO - KSPARSE(1, 363)=33 - KSPARSE(2, 363)=20 + KSPARSE(1, 371)=34 + KSPARSE(2, 371)=21 !ALKAP/KET - KSPARSE(1, 364)=33 - KSPARSE(2, 364)=24 + KSPARSE(1, 372)=34 + KSPARSE(2, 372)=25 !ALKAP/ONIT - KSPARSE(1, 365)=33 - KSPARSE(2, 365)=26 + KSPARSE(1, 373)=34 + KSPARSE(2, 373)=27 !ALKAP/OP2 - KSPARSE(1, 366)=33 - KSPARSE(2, 366)=29 + KSPARSE(1, 374)=34 + KSPARSE(2, 374)=30 !ALKAP/MO2 - KSPARSE(1, 367)=33 - KSPARSE(2, 367)=32 + KSPARSE(1, 375)=34 + KSPARSE(2, 375)=33 !ALKAP/ALKAP - KSPARSE(1, 368)=33 - KSPARSE(2, 368)=33 + KSPARSE(1, 376)=34 + KSPARSE(2, 376)=34 !ALKAP/CARBOP - KSPARSE(1, 369)=33 - KSPARSE(2, 369)=39 + KSPARSE(1, 377)=34 + KSPARSE(2, 377)=40 !ALKEP/NO - KSPARSE(1, 370)=34 - KSPARSE(2, 370)=3 + KSPARSE(1, 378)=35 + KSPARSE(2, 378)=3 !ALKEP/NO3 - KSPARSE(1, 371)=34 - KSPARSE(2, 371)=5 + KSPARSE(1, 379)=35 + KSPARSE(2, 379)=5 !ALKEP/OH - KSPARSE(1, 372)=34 - KSPARSE(2, 372)=14 + KSPARSE(1, 380)=35 + KSPARSE(2, 380)=15 !ALKEP/HO2 - KSPARSE(1, 373)=34 - KSPARSE(2, 373)=15 + KSPARSE(1, 381)=35 + KSPARSE(2, 381)=16 !ALKEP/ALKE - KSPARSE(1, 374)=34 - KSPARSE(2, 374)=19 + KSPARSE(1, 382)=35 + KSPARSE(2, 382)=20 !ALKEP/MO2 - KSPARSE(1, 375)=34 - KSPARSE(2, 375)=32 + KSPARSE(1, 383)=35 + KSPARSE(2, 383)=33 !ALKEP/ALKEP - KSPARSE(1, 376)=34 - KSPARSE(2, 376)=34 + KSPARSE(1, 384)=35 + KSPARSE(2, 384)=35 !ALKEP/CARBOP - KSPARSE(1, 377)=34 - KSPARSE(2, 377)=39 + KSPARSE(1, 385)=35 + KSPARSE(2, 385)=40 !BIOP/NO - KSPARSE(1, 378)=35 - KSPARSE(2, 378)=3 + KSPARSE(1, 386)=36 + KSPARSE(2, 386)=3 !BIOP/NO3 - KSPARSE(1, 379)=35 - KSPARSE(2, 379)=5 + KSPARSE(1, 387)=36 + KSPARSE(2, 387)=5 !BIOP/OH - KSPARSE(1, 380)=35 - KSPARSE(2, 380)=14 + KSPARSE(1, 388)=36 + KSPARSE(2, 388)=15 !BIOP/HO2 - KSPARSE(1, 381)=35 - KSPARSE(2, 381)=15 + KSPARSE(1, 389)=36 + KSPARSE(2, 389)=16 !BIOP/ALKE - KSPARSE(1, 382)=35 - KSPARSE(2, 382)=19 + KSPARSE(1, 390)=36 + KSPARSE(2, 390)=20 !BIOP/BIO - KSPARSE(1, 383)=35 - KSPARSE(2, 383)=20 + KSPARSE(1, 391)=36 + KSPARSE(2, 391)=21 !BIOP/MO2 - KSPARSE(1, 384)=35 - KSPARSE(2, 384)=32 + KSPARSE(1, 392)=36 + KSPARSE(2, 392)=33 !BIOP/BIOP - KSPARSE(1, 385)=35 - KSPARSE(2, 385)=35 + KSPARSE(1, 393)=36 + KSPARSE(2, 393)=36 !BIOP/CARBOP - KSPARSE(1, 386)=35 - KSPARSE(2, 386)=39 + KSPARSE(1, 394)=36 + KSPARSE(2, 394)=40 !PHO/NO2 - KSPARSE(1, 387)=36 - KSPARSE(2, 387)=4 + KSPARSE(1, 395)=37 + KSPARSE(2, 395)=4 !PHO/NO3 - KSPARSE(1, 388)=36 - KSPARSE(2, 388)=5 + KSPARSE(1, 396)=37 + KSPARSE(2, 396)=5 !PHO/OH - KSPARSE(1, 389)=36 - KSPARSE(2, 389)=14 + KSPARSE(1, 397)=37 + KSPARSE(2, 397)=15 !PHO/HO2 - KSPARSE(1, 390)=36 - KSPARSE(2, 390)=15 + KSPARSE(1, 398)=37 + KSPARSE(2, 398)=16 !PHO/ARO - KSPARSE(1, 391)=36 - KSPARSE(2, 391)=21 + KSPARSE(1, 399)=37 + KSPARSE(2, 399)=22 !PHO/PHO - KSPARSE(1, 392)=36 - KSPARSE(2, 392)=36 + KSPARSE(1, 400)=37 + KSPARSE(2, 400)=37 !ADD/O3 - KSPARSE(1, 393)=37 - KSPARSE(2, 393)=1 + KSPARSE(1, 401)=38 + KSPARSE(2, 401)=1 !ADD/NO2 - KSPARSE(1, 394)=37 - KSPARSE(2, 394)=4 + KSPARSE(1, 402)=38 + KSPARSE(2, 402)=4 !ADD/OH - KSPARSE(1, 395)=37 - KSPARSE(2, 395)=14 + KSPARSE(1, 403)=38 + KSPARSE(2, 403)=15 !ADD/ARO - KSPARSE(1, 396)=37 - KSPARSE(2, 396)=21 + KSPARSE(1, 404)=38 + KSPARSE(2, 404)=22 !ADD/ADD - KSPARSE(1, 397)=37 - KSPARSE(2, 397)=37 + KSPARSE(1, 405)=38 + KSPARSE(2, 405)=38 !AROP/NO - KSPARSE(1, 398)=38 - KSPARSE(2, 398)=3 + KSPARSE(1, 406)=39 + KSPARSE(2, 406)=3 !AROP/NO3 - KSPARSE(1, 399)=38 - KSPARSE(2, 399)=5 + KSPARSE(1, 407)=39 + KSPARSE(2, 407)=5 !AROP/HO2 - KSPARSE(1, 400)=38 - KSPARSE(2, 400)=15 + KSPARSE(1, 408)=39 + KSPARSE(2, 408)=16 !AROP/MO2 - KSPARSE(1, 401)=38 - KSPARSE(2, 401)=32 + KSPARSE(1, 409)=39 + KSPARSE(2, 409)=33 !AROP/ADD - KSPARSE(1, 402)=38 - KSPARSE(2, 402)=37 + KSPARSE(1, 410)=39 + KSPARSE(2, 410)=38 !AROP/AROP - KSPARSE(1, 403)=38 - KSPARSE(2, 403)=38 + KSPARSE(1, 411)=39 + KSPARSE(2, 411)=39 !AROP/CARBOP - KSPARSE(1, 404)=38 - KSPARSE(2, 404)=39 + KSPARSE(1, 412)=39 + KSPARSE(2, 412)=40 !CARBOP/O3 - KSPARSE(1, 405)=39 - KSPARSE(2, 405)=1 + KSPARSE(1, 413)=40 + KSPARSE(2, 413)=1 !CARBOP/NO - KSPARSE(1, 406)=39 - KSPARSE(2, 406)=3 + KSPARSE(1, 414)=40 + KSPARSE(2, 414)=3 !CARBOP/NO2 - KSPARSE(1, 407)=39 - KSPARSE(2, 407)=4 + KSPARSE(1, 415)=40 + KSPARSE(2, 415)=4 !CARBOP/NO3 - KSPARSE(1, 408)=39 - KSPARSE(2, 408)=5 + KSPARSE(1, 416)=40 + KSPARSE(2, 416)=5 !CARBOP/OH - KSPARSE(1, 409)=39 - KSPARSE(2, 409)=14 + KSPARSE(1, 417)=40 + KSPARSE(2, 417)=15 !CARBOP/HO2 - KSPARSE(1, 410)=39 - KSPARSE(2, 410)=15 + KSPARSE(1, 418)=40 + KSPARSE(2, 418)=16 !CARBOP/ALKE - KSPARSE(1, 411)=39 - KSPARSE(2, 411)=19 + KSPARSE(1, 419)=40 + KSPARSE(2, 419)=20 !CARBOP/BIO - KSPARSE(1, 412)=39 - KSPARSE(2, 412)=20 + KSPARSE(1, 420)=40 + KSPARSE(2, 420)=21 !CARBOP/ALD - KSPARSE(1, 413)=39 - KSPARSE(2, 413)=23 + KSPARSE(1, 421)=40 + KSPARSE(2, 421)=24 !CARBOP/KET - KSPARSE(1, 414)=39 - KSPARSE(2, 414)=24 + KSPARSE(1, 422)=40 + KSPARSE(2, 422)=25 !CARBOP/CARBO - KSPARSE(1, 415)=39 - KSPARSE(2, 415)=25 + KSPARSE(1, 423)=40 + KSPARSE(2, 423)=26 !CARBOP/PAN - KSPARSE(1, 416)=39 - KSPARSE(2, 416)=27 + KSPARSE(1, 424)=40 + KSPARSE(2, 424)=28 !CARBOP/OP2 - KSPARSE(1, 417)=39 - KSPARSE(2, 417)=29 + KSPARSE(1, 425)=40 + KSPARSE(2, 425)=30 !CARBOP/MO2 - KSPARSE(1, 418)=39 - KSPARSE(2, 418)=32 + KSPARSE(1, 426)=40 + KSPARSE(2, 426)=33 !CARBOP/ALKAP - KSPARSE(1, 419)=39 - KSPARSE(2, 419)=33 + KSPARSE(1, 427)=40 + KSPARSE(2, 427)=34 !CARBOP/ALKEP - KSPARSE(1, 420)=39 - KSPARSE(2, 420)=34 + KSPARSE(1, 428)=40 + KSPARSE(2, 428)=35 !CARBOP/BIOP - KSPARSE(1, 421)=39 - KSPARSE(2, 421)=35 + KSPARSE(1, 429)=40 + KSPARSE(2, 429)=36 !CARBOP/AROP - KSPARSE(1, 422)=39 - KSPARSE(2, 422)=38 + KSPARSE(1, 430)=40 + KSPARSE(2, 430)=39 !CARBOP/CARBOP - KSPARSE(1, 423)=39 - KSPARSE(2, 423)=39 + KSPARSE(1, 431)=40 + KSPARSE(2, 431)=40 !CARBOP/OLN - KSPARSE(1, 424)=39 - KSPARSE(2, 424)=40 + KSPARSE(1, 432)=40 + KSPARSE(2, 432)=41 !CARBOP/XO2 - KSPARSE(1, 425)=39 - KSPARSE(2, 425)=41 + KSPARSE(1, 433)=40 + KSPARSE(2, 433)=42 !OLN/NO - KSPARSE(1, 426)=40 - KSPARSE(2, 426)=3 + KSPARSE(1, 434)=41 + KSPARSE(2, 434)=3 !OLN/NO3 - KSPARSE(1, 427)=40 - KSPARSE(2, 427)=5 + KSPARSE(1, 435)=41 + KSPARSE(2, 435)=5 !OLN/HO2 - KSPARSE(1, 428)=40 - KSPARSE(2, 428)=15 + KSPARSE(1, 436)=41 + KSPARSE(2, 436)=16 !OLN/ALKE - KSPARSE(1, 429)=40 - KSPARSE(2, 429)=19 + KSPARSE(1, 437)=41 + KSPARSE(2, 437)=20 !OLN/BIO - KSPARSE(1, 430)=40 - KSPARSE(2, 430)=20 + KSPARSE(1, 438)=41 + KSPARSE(2, 438)=21 !OLN/CARBO - KSPARSE(1, 431)=40 - KSPARSE(2, 431)=25 + KSPARSE(1, 439)=41 + KSPARSE(2, 439)=26 !OLN/MO2 - KSPARSE(1, 432)=40 - KSPARSE(2, 432)=32 + KSPARSE(1, 440)=41 + KSPARSE(2, 440)=33 !OLN/CARBOP - KSPARSE(1, 433)=40 - KSPARSE(2, 433)=39 + KSPARSE(1, 441)=41 + KSPARSE(2, 441)=40 !OLN/OLN - KSPARSE(1, 434)=40 - KSPARSE(2, 434)=40 + KSPARSE(1, 442)=41 + KSPARSE(2, 442)=41 !XO2/O3 - KSPARSE(1, 435)=41 - KSPARSE(2, 435)=1 + KSPARSE(1, 443)=42 + KSPARSE(2, 443)=1 !XO2/NO - KSPARSE(1, 436)=41 - KSPARSE(2, 436)=3 + KSPARSE(1, 444)=42 + KSPARSE(2, 444)=3 !XO2/NO3 - KSPARSE(1, 437)=41 - KSPARSE(2, 437)=5 + KSPARSE(1, 445)=42 + KSPARSE(2, 445)=5 !XO2/OH - KSPARSE(1, 438)=41 - KSPARSE(2, 438)=14 + KSPARSE(1, 446)=42 + KSPARSE(2, 446)=15 !XO2/HO2 - KSPARSE(1, 439)=41 - KSPARSE(2, 439)=15 + KSPARSE(1, 447)=42 + KSPARSE(2, 447)=16 !XO2/ALKE - KSPARSE(1, 440)=41 - KSPARSE(2, 440)=19 + KSPARSE(1, 448)=42 + KSPARSE(2, 448)=20 !XO2/BIO - KSPARSE(1, 441)=41 - KSPARSE(2, 441)=20 + KSPARSE(1, 449)=42 + KSPARSE(2, 449)=21 !XO2/ARO - KSPARSE(1, 442)=41 - KSPARSE(2, 442)=21 + KSPARSE(1, 450)=42 + KSPARSE(2, 450)=22 !XO2/CARBO - KSPARSE(1, 443)=41 - KSPARSE(2, 443)=25 + KSPARSE(1, 451)=42 + KSPARSE(2, 451)=26 !XO2/PAN - KSPARSE(1, 444)=41 - KSPARSE(2, 444)=27 + KSPARSE(1, 452)=42 + KSPARSE(2, 452)=28 !XO2/OP2 - KSPARSE(1, 445)=41 - KSPARSE(2, 445)=29 + KSPARSE(1, 453)=42 + KSPARSE(2, 453)=30 !XO2/MO2 - KSPARSE(1, 446)=41 - KSPARSE(2, 446)=32 + KSPARSE(1, 454)=42 + KSPARSE(2, 454)=33 !XO2/ALKAP - KSPARSE(1, 447)=41 - KSPARSE(2, 447)=33 + KSPARSE(1, 455)=42 + KSPARSE(2, 455)=34 !XO2/CARBOP - KSPARSE(1, 448)=41 - KSPARSE(2, 448)=39 + KSPARSE(1, 456)=42 + KSPARSE(2, 456)=40 !XO2/XO2 - KSPARSE(1, 449)=41 - KSPARSE(2, 449)=41 -KSPARSEDIM = 449 + KSPARSE(1, 457)=42 + KSPARSE(2, 457)=42 +KSPARSEDIM = 457 RETURN END SUBROUTINE CH_SPARSE_GAZ ! diff --git a/src/MNH/ch_aer_driver.f90 b/src/MNH/ch_aer_driver.f90 index 819eb0ae1..2b0537ab7 100644 --- a/src/MNH/ch_aer_driver.f90 +++ b/src/MNH/ch_aer_driver.f90 @@ -8,23 +8,30 @@ ! INTERFACE ! -SUBROUTINE CH_AER_DRIVER(PM, PSIG0, PRG0, PN0, PCTOTG, PCTOTA,& - PCCTOT, PDTACT, PSEDA,& - PMU, PLAMBDA, PRHOP0, POM, PSO4RAT, & - PRV, PDENAIR, PPRESSURE, PTEMP, PRC, PMASK,& - PTIME, PSOLORG) +SUBROUTINE CH_AER_DRIVER(PM, PLNSIG, PRG, PN, PCTOTG, PCTOTA, & + PCCTOT, PDTACT, PSEDA, & + PRHOP, PSO4RAT, & + PRV, PDENAIR, PPRESSURE, PTEMP, PRC, PMASK, & + PTIME, PSOLORG, & + PJNUC, PJ2RAT, PMBEG, PMINT, PMEND, & + PDMINTRA, PDMINTER, PDMCOND, PDMNUCL, PDMMERG, & + PCONC_MASS, PCOND_MASS_I, PCOND_MASS_J, PNUCL_MASS) IMPLICIT NONE -REAL, INTENT(IN) :: PDTACT, PTIME -REAL, DIMENSION(:,:), INTENT(INOUT) :: PRHOP0, POM -REAL, DIMENSION(:), INTENT(INOUT) :: PLAMBDA, PMU, PSO4RAT -REAL, DIMENSION(:,:), INTENT(INOUT) :: PM -REAL, DIMENSION(:,:), INTENT(INOUT) :: PSIG0, PRG0, PN0 -REAL, DIMENSION(:,:), INTENT(INOUT) :: PCTOTG -REAL, DIMENSION(:,:), INTENT(INOUT) :: PSOLORG -REAL, DIMENSION(:,:), INTENT(INOUT) :: PSEDA -REAL, DIMENSION(:,:), INTENT(INOUT) :: PMASK -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCTOTA, PCCTOT -REAL, DIMENSION(:), INTENT(IN) :: PRV, PDENAIR, PPRESSURE, PTEMP, PRC +REAL, INTENT(IN) :: PDTACT, PTIME +REAL, DIMENSION(:,:), INTENT(INOUT) :: PRHOP +REAL, DIMENSION(:), INTENT(INOUT) :: PSO4RAT +REAL, DIMENSION(:,:), INTENT(INOUT) :: PM +REAL, DIMENSION(:,:), INTENT(INOUT) :: PLNSIG, PRG, PN +REAL, DIMENSION(:,:), INTENT(INOUT) :: PCTOTG +REAL, DIMENSION(:,:), INTENT(INOUT) :: PSOLORG +REAL, DIMENSION(:,:), INTENT(INOUT) :: PSEDA +REAL, DIMENSION(:,:), INTENT(INOUT) :: PMASK +REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCTOTA, PCCTOT +REAL, DIMENSION(:), INTENT(IN) :: PRV, PDENAIR, PPRESSURE, PTEMP, PRC +REAL, DIMENSION(:), INTENT(INOUT) :: PJNUC, PJ2RAT +REAL, DIMENSION(:,:), INTENT(INOUT) :: PMBEG,PMINT,PMEND +REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMINTRA,PDMINTER,PDMCOND,PDMNUCL,PDMMERG +REAL, DIMENSION(:), INTENT(INOUT) :: PCONC_MASS,PCOND_MASS_I,PCOND_MASS_J,PNUCL_MASS END SUBROUTINE CH_AER_DRIVER ! END INTERFACE @@ -32,17 +39,31 @@ END INTERFACE END MODULE MODI_CH_AER_DRIVER ! !##################################################################################### -SUBROUTINE CH_AER_DRIVER(PM, PSIG0, PRG0, PN0, PCTOTG, PCTOTA,& - PCCTOT, PDTACT, PSEDA,& - PMU, PLAMBDA, PRHOP0, POM, PSO4RAT, & - PRV, PDENAIR, PPRESSURE, PTEMP, PRC, PMASK,& - PTIME, PSOLORG) +SUBROUTINE CH_AER_DRIVER(PM, PLNSIG, PRG, PN, PCTOTG, PCTOTA, & + PCCTOT, PDTACT, PSEDA, & + PRHOP, PSO4RAT, & + PRV, PDENAIR, PPRESSURE, PTEMP, PRC, PMASK, & + PTIME, PSOLORG, & + PJNUC,PJ2RAT,PMBEG,PMINT,PMEND, & + PDMINTRA,PDMINTER,PDMCOND,PDMNUCL,PDMMERG, & + PCONC_MASS,PCOND_MASS_I,PCOND_MASS_J,PNUCL_MASS) !##################################################################################### !! !! PURPOSE !! ------- +!! Compute the right hand side of the moment equations and solve the moment equations !! -!! compute the right hand side of the moment equations +!! EXTERNAL +!! -------- +!! Subroutine CH_AER_COAG : compute coagulation moment tendency terms +!! Subroutine CH_AER_COND : compute condensation from CMAQ model +!! Subroutine CH_AER_NUCL : compute nucleation rate +!! Subroutine CH_AER_MODE_MERGING : adjust tendency terms in case of mode i > mode j +!! Subroutine CH_AER_SOLV : solve moment equations +!! +!! IMPLICIT ARGUMENTS +!! ------------------ +!! MODD_CH_AEROSOL !! !! REFERENCE !! --------- @@ -54,124 +75,283 @@ SUBROUTINE CH_AER_DRIVER(PM, PSIG0, PRG0, PN0, PCTOTG, PCTOTA,& !! !! MODIFICATIONS !! ------------- -!! Original -!! M.Leriche 2015 Calcul de la fraction massique entre les modes -!! M.Leriche 08/16 suppress moments index declaration already in modd_aerosol -!! -!! EXTERNAL -!! -------- +!! Original +!! M. Leriche (??/2015) Calcul de la fraction massique entre les modes +!! M. Leriche (08/2016) Suppress moments index declaration already in modd_aerosol +!! J. Pianezze (06/2018) ... +!------------------------------------------------------------------------------- +! +! * 0. DECLARATIONS +! ------------ +! USE MODI_CH_AER_COAG -USE MODI_CH_AER_GROWTH +USE MODI_CH_AER_COND +USE MODI_CH_AER_NUCL +USE MODI_CH_AER_MODE_MERGING USE MODI_CH_AER_SOLV -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -USE MODD_CH_AEROSOL ! +USE MODD_CH_AEROSOL +USE MODD_CONF, ONLY : NVERB +USE MODD_CST, ONLY : XAVOGADRO ! IMPLICIT NONE -! Declaration arguments -REAL, INTENT(IN) :: PDTACT, PTIME -REAL, DIMENSION(:,:), INTENT(INOUT) :: PRHOP0, POM -REAL, DIMENSION(:), INTENT(INOUT) :: PLAMBDA, PMU, PSO4RAT -REAL, DIMENSION(:,:), INTENT(INOUT) :: PM -REAL, DIMENSION(:,:), INTENT(INOUT) :: PSIG0, PRG0, PN0 -REAL, DIMENSION(:,:), INTENT(INOUT) :: PCTOTG -REAL, DIMENSION(:,:), INTENT(INOUT) :: PSOLORG -REAL, DIMENSION(:,:), INTENT(INOUT) :: PSEDA -REAL, DIMENSION(:,:), INTENT(INOUT) :: PMASK -REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCTOTA, PCCTOT -REAL, DIMENSION(:), INTENT(IN) :: PRV, PDENAIR, PPRESSURE, PTEMP, PRC -! -! Declarations variables internes -! -INTEGER :: II, JI, JJ - -! Variables utilisees pour le tranfert de moment de chaque espece -! pour la condensation -!---------------------------------------------------------------- - -REAL, DIMENSION(SIZE(PM,1),(JPMODE)*3) :: ZDMINTRA,ZDMINTER,ZDMCOND - -REAL :: ZGASMW ! Molecular weight of background - ! gas (g/mol) -REAL, DIMENSION(SIZE(PM,1)) :: ZPGAS ! background gas pressure (Pa) -REAL, DIMENSION(SIZE(PM,1)) :: ZRH,PSAT ! Relative humidity -REAL :: ZDT ! Pas de temps -REAL, DIMENSION(SIZE(PM,1)) :: ZPKM, ZPKH2O, ZSUM - -!----------------------------------------------------------------------------- - -ZDT=PDTACT - -!************************************************************* -! Calcul de la fraction massique entre les modes -!************************************************************* -ZSUM (:) = 0. -DO JI=1,JPMODE - DO JJ=1,NSP+NCARB+NSOA - ZSUM (:) = ZSUM (:) + PCTOTA(:,JJ,JI) - ENDDO +! +! * 0.1 declarations of arguments +! +REAL, INTENT(IN) :: PDTACT, PTIME +REAL, DIMENSION(:,:), INTENT(INOUT) :: PRHOP +REAL, DIMENSION(:), INTENT(INOUT) :: PSO4RAT +REAL, DIMENSION(:,:), INTENT(INOUT) :: PM +REAL, DIMENSION(:,:), INTENT(INOUT) :: PLNSIG, PRG, PN +REAL, DIMENSION(:,:), INTENT(INOUT) :: PCTOTG +REAL, DIMENSION(:,:), INTENT(INOUT) :: PSOLORG +REAL, DIMENSION(:,:), INTENT(INOUT) :: PSEDA +REAL, DIMENSION(:,:), INTENT(INOUT) :: PMASK +REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCTOTA, PCCTOT +REAL, DIMENSION(:), INTENT(IN) :: PRV, PDENAIR, PPRESSURE, PTEMP, PRC +REAL, DIMENSION(:), INTENT(INOUT) :: PJNUC, PJ2RAT +REAL, DIMENSION(:,:), INTENT(INOUT) :: PMBEG,PMINT,PMEND +REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMINTRA,PDMINTER,PDMCOND,PDMNUCL,PDMMERG +REAL, DIMENSION(:), INTENT(INOUT) :: PCONC_MASS,PCOND_MASS_I,PCOND_MASS_J,PNUCL_MASS +! +! * 0.2 declarations of local variables +! +INTEGER :: JI, JJ +! +REAL :: ZGASMW ! Molecular weight of background gas (g/mol) +REAL, DIMENSION(SIZE(PM,1)) :: ZRH,ZPSAT ! Relative humidity, ? +REAL, DIMENSION(SIZE(PM,1)) :: ZPKM, ZPKH2O +REAL, DIMENSION(SIZE(PM,1)) :: ZMU, ZLAMBDA +! +REAL, DIMENSION(SIZE(PM,1)) :: ZDMNDT, ZDM3DT, ZDM6DT, ZDMN3DT, ZDMN6DT +REAL, DIMENSION(SIZE(PM,1),JPMODE) :: ZDMC0DT, ZDMC3DT, ZDMC6DT +REAL, DIMENSION(SIZE(PM,1),3*JPMODE) :: ZDMGROW +REAL, DIMENSION(SIZE(PM,1)) :: ZSULF +! +!------------------------------------------------------------------------------- +! +! * 1. INITIALIZATION +! -------------- +! +PDMINTRA(:,:) = 0.0 +PDMINTER(:,:) = 0.0 +PDMCOND(:,:) = 0.0 +PDMNUCL(:,:) = 0.0 +PDMMERG(:,:) = 0.0 +! +ZDMGROW(:,:) = 0.0 +! +ZDMC0DT(:,:) = 0.0 +ZDMC3DT(:,:) = 0.0 +ZDMC6DT(:,:) = 0.0 +! +ZDMN3DT(:) = 0.0 +ZDMN6DT(:) = 0.0 +! +! * Compute relative humidity +! +ZPKM (:) = 1E-3*PDENAIR(:) * XAVOGADRO / 28.9644 +ZPKH2O(:) = ZPKM(:)*1.6077*PRV(:) +ZPSAT (:) = 0.611*EXP(17.2694*(PTEMP(:)-273.16)/(PTEMP(:)-35.86)) +ZPSAT (:) = ZPSAT(:)*1000. +ZRH (:) = (ZPKH2O(:)/(ZPKM(:)*1.6077))*PPRESSURE(:)/& + & (0.622+(ZPKH2O(:)/(ZPKM(:)*1.6077)))/ZPSAT(:) +ZGASMW = 29.0 +! +! * gas viscosity +ZMU(:) = 0.003661*PTEMP(:) +ZMU(:) = 0.0066164*ZMU(:)*sqrt(ZMU(:))/(PTEMP(:)+114.d0) +! * mean free path +ZLAMBDA(:)=ZMU(:)/PDENAIR(:)*sqrt(1.89d-4*ZGASMW/PTEMP(:))*1.e6 +! +! +! [ug.m-3.s-1] = [molec.cm-3.s-1] * *XH2SO4 / (XAVOGADRO*1.E-12) +PSO4RAT(:) = PSO4RAT(:) * XH2SO4 / (XAVOGADRO*1.E-12) +! +! ZSULF [ug.m-3.s-1] = production rate of sulfuric acid +ZSULF(:) = PSO4RAT(:) +! +! Stock value for diag +PCONC_MASS(:) = ZSULF(:) * PDTACT +! +!------------------------------------------------------- +! +! * 2. COMPUTE COAGULATION TERMS +! ------------------------------------------ +! +IF (LCOAGULATION) THEN + CALL CH_AER_COAG(PM, PLNSIG, PRG, PN, PDMINTRA, PDMINTER, & + PTEMP, ZMU, ZLAMBDA, PRHOP ) +ELSE + PDMINTRA(:,:) = 0.0 + PDMINTER(:,:) = 0.0 +ENDIF +! +!------------------------------------------------------- +! +! * 3. COMPUTE NUCLEATION +! -------------------------------------------- +! +! +! * 2.0 Compute sulfuric acid concentration available for nucleation +! ----------------------------------------------------------- +! +! dC / dt = P - Cs / time +! +CALL CH_AER_COND(PM, PLNSIG, PRG, PPRESSURE, PTEMP, & + ZDMC3DT, ZDMC6DT ) +! +ZSULF(:) = ZSULF(:) / (ZDMC3DT(:,1)+ZDMC3DT(:,2)) +! +! +!* 2.1 NUCLEATION +! ---------- +! +! +IF (CNUCLEATION == 'NONE') THEN + PJNUC = 0.0 +ELSE + CALL CH_AER_NUCL(ZRH,PTEMP,ZSULF,PJNUC,PJ2RAT) +END IF +! +! Convert nucleation rate +! [ug.m-3.s-1] = [molec.cm-3.s-1] * XH2SO4 / (XAVOGADRO*1.E-12) +! +ZDMNDT(:) = PJNUC(:) * XH2SO4 / (XAVOGADRO*1.E-12) +! +! H2SO4 final [ug.m-3] = H2SO4 initial [ug.m-3] +! - H2SO4 rate consumed by nucleation [ug.m-3.s-1] * Time step [s] +! +DO JI=1, SIZE(PM(:,1)) + ! + IF ( ZDMNDT(JI) .GT. PSO4RAT(JI) ) THEN + ! + ZDMNDT(JI) = PSO4RAT(JI) + PJNUC (JI) = ZDMNDT (JI) / XH2SO4 * (XAVOGADRO*1.E-12) + ! + END IF ENDDO -POM(:,:) = 0. +! +ZSULF(:) = (PSO4RAT(:)-ZDMNDT(:)) * PDTACT +! +PNUCL_MASS(:) = ZDMNDT(:) * PDTACT +! +! +! Update moment tendencies for nucleation +! +PDMNUCL(:,NM0(1)) = ZDMNDT(:)/(XFAC(JP_AER_SO4)*( (XRADIUS_NUCL)**3)*EXP(4.5 * LOG(XSIGMA_NUCL)**2)) +PDMNUCL(:,NM3(1)) = ZDMNDT(:)/XFAC(JP_AER_SO4) +PDMNUCL(:,NM6(1)) = PDMNUCL(:,NM0(1))*( (XRADIUS_NUCL)**6*EXP(18.*LOG(XSIGMA_NUCL)**2)) +PDMNUCL(:,NM0(2)) = 0.0 +PDMNUCL(:,NM3(2)) = 0.0 +PDMNUCL(:,NM6(2)) = 0.0 +! +!------------------------------------------------------- +! +! * 3. COMPUTE CONDENSATION +! -------------------- +! +! +IF (LCONDENSATION) THEN + ! + ! Update dM0_cond / dt + PDMCOND(:,NM0(1)) = 0.0 + PDMCOND(:,NM0(2)) = 0.0 + ! + ! Update of dM3_cond/dt from new dMass_cond/dt + ! + PDMCOND(:,NM3(1)) = (ZSULF(:)/PDTACT) / XFAC(JP_AER_SO4) * (ZDMC3DT(:,1) / (ZDMC3DT(:,1)+ZDMC3DT(:,2) )) + PDMCOND(:,NM3(2)) = (ZSULF(:)/PDTACT) / XFAC(JP_AER_SO4) * (ZDMC3DT(:,2) / (ZDMC3DT(:,1)+ZDMC3DT(:,2) )) + ! + ! Compute dM0_cond/dt --> usefull for calculation of dM6_cond/dt + ! + ZDMC0DT(:,1) = PDMCOND(:,NM3(1)) / (( (PRG(:,1))**3 ) * EXP(4.5 * PLNSIG(:,1)**2)) + ZDMC0DT(:,2) = PDMCOND(:,NM3(2)) / (( (PRG(:,2))**3 ) * EXP(4.5 * PLNSIG(:,2)**2)) + ! + PDMCOND(:,NM6(1)) = ZDMC0DT(:,1) * (( (PRG(:,1))**6 ) * EXP(18. * PLNSIG(:,1)**2)) + PDMCOND(:,NM6(2)) = ZDMC0DT(:,2) * (( (PRG(:,2))**6 ) * EXP(18. * PLNSIG(:,2)**2)) + ! +ELSE + ! + ZDMC0DT(:,:) = 0.0 + ZDMC3DT(:,:) = 0.0 + ZDMC6DT(:,:) = 0.0 + PDMCOND(:,:) = 0.0 + ! +ENDIF +! +! Stock new values of condensated mass for diagnostic +! +! [ug.m-3] = [um3.m-3.s-1]*[s]*XFAC +PCOND_MASS_I(:) = PDMCOND(:,NM3(1)) * PDTACT * XFAC(JP_AER_SO4) +PCOND_MASS_J(:) = PDMCOND(:,NM3(2)) * PDTACT * XFAC(JP_AER_SO4) +! +!------------------------------------------------------------------------------- +! +! * 4. MODE MERGING +! ------------ +! +! This code implements Section 1.5 of Binkowski and Roselle (2003). +! If the Aitken mode mass is growing faster than accumulation mode +! mass and the Aitken mode number concentration exceeds the +! accumulation mode number concentration, then moments tendency +! are adjusted. +! +IF (LMODE_MERGING) THEN + ZDMGROW(:,NM0(1)) = PDMCOND(:,NM0(1)) + PDMINTER(:,NM0(1)) + PDMINTRA(:,NM0(1)) + ZDMGROW(:,NM3(1)) = PDMCOND(:,NM3(1)) + PDMINTER(:,NM3(1)) + PDMINTRA(:,NM3(1)) + ZDMGROW(:,NM6(1)) = PDMCOND(:,NM6(1)) + PDMINTER(:,NM6(1)) + PDMINTRA(:,NM6(1)) + ZDMGROW(:,NM0(2)) = PDMCOND(:,NM0(2)) + PDMINTER(:,NM0(2)) + PDMINTRA(:,NM0(2)) + ZDMGROW(:,NM3(2)) = PDMCOND(:,NM3(2)) + PDMINTER(:,NM3(2)) + PDMINTRA(:,NM3(2)) + ZDMGROW(:,NM6(2)) = PDMCOND(:,NM6(2)) + PDMINTER(:,NM6(2)) + PDMINTRA(:,NM6(2)) + CALL CH_AER_MODE_MERGING(PM, PLNSIG, PRG, ZDMGROW, PDMMERG) +ELSE + PDMMERG(:,:)=0.0 +ENDIF +! +!------------------------------------------------------------------------------- +! +! * 5. UPDATE OF SULFURIC ACID CONCENTRATION +! ------------------------------------- +! +PCTOTG(:,JP_AER_SO4g)=PCTOTG(:,JP_AER_SO4g)-PCOND_MASS_I(:)-PCOND_MASS_J(:)-PNUCL_MASS(:) +! +!------------------------------------------------------- +! +! * 6. MASK DIFFERENT TERMS +! -------------------- +! +! DIRE A QUOI SERVENT CES MASKS.... ? +! DO JI=1,JPMODE - DO JJ=1,NSP+NCARB+NSOA - POM(:,JI) = POM(:,JI) + PCTOTA(:,JJ,JI) / ZSUM (:) - ENDDO -ENDDO - - -!****************************************************** -! Thermodynamic variables initialization -! from Meso-NHC -!****************************************************** - -ZPKM(:) = 1E-3*PDENAIR(:) * 6.0221367E+23 / 28.9644 -ZPKH2O(:) = ZPKM(:)*1.6077*PRV(:) -PSAT(:)=0.611*EXP(17.2694*(PTEMP(:)-273.16)/(PTEMP(:)-35.86)) -PSAT(:)=PSAT(:)*1000. -ZRH(:)=(ZPKH2O(:)/(ZPKM(:)*1.6077))*PPRESSURE(:)/& - &(0.622+(ZPKH2O(:)/(ZPKM(:)*1.6077)))/PSAT(:) - -ZPGAS(:)=PPRESSURE(:) -ZGASMW=29. - -!****************************************************** -! calculate gas viscosity and mean free path -!****************************************************** -PMU(:)=0.003661*PTEMP(:) -PMU(:)=.0066164*PMU(:)*sqrt(PMU(:))/(PTEMP(:)+114.d0) - -PLAMBDA(:)=PMU(:)/PDENAIR(:)*sqrt(1.89d-4*ZGASMW/PTEMP(:))*1.e6 - -CALL CH_AER_COAG(PM, PSIG0, PRG0, PN0,ZDMINTRA,ZDMINTER,& - PTEMP,PMU,PLAMBDA,PRHOP0) - - -CALL CH_AER_GROWTH(PM, PSIG0, PRG0, ZDMCOND,PDENAIR,ZGASMW,& - ZPGAS,PTEMP,ZRH,POM,PSO4RAT,PDTACT) - -DO II=1,JPMODE -ZDMINTRA(:,NM0(II)) = ZDMINTRA(:,NM0(II)) * PMASK(:,II) -ZDMINTRA(:,NM3(II)) = ZDMINTRA(:,NM3(II)) * PMASK(:,II) -ZDMINTRA(:,NM6(II)) = ZDMINTRA(:,NM6(II)) * PMASK(:,II) -ZDMINTER(:,NM0(II)) = ZDMINTER(:,NM0(II)) * PMASK(:,II) -ZDMINTER(:,NM3(II)) = ZDMINTER(:,NM3(II)) * PMASK(:,II) -ZDMINTER(:,NM6(II)) = ZDMINTER(:,NM6(II)) * PMASK(:,II) -ZDMCOND(:,NM0(II)) = ZDMCOND(:,NM0(II)) * PMASK(:,II) -ZDMCOND(:,NM3(II)) = ZDMCOND(:,NM3(II)) * PMASK(:,II) -ZDMCOND(:,NM6(II)) = ZDMCOND(:,NM6(II)) * PMASK(:,II) -POM(:,II) = POM(:,II) * PMASK(:,II) -PSEDA(:,NM0(II)) = PSEDA(:,NM0(II)) * PMASK(:,II) -PSEDA(:,NM3(II)) = PSEDA(:,NM3(II)) * PMASK(:,II) -PSEDA(:,NM6(II)) = PSEDA(:,NM6(II)) * PMASK(:,II) + PDMINTRA(:,NM0(JI)) = PDMINTRA(:,NM0(JI)) * PMASK(:,JI) + PDMINTRA(:,NM3(JI)) = PDMINTRA(:,NM3(JI)) * PMASK(:,JI) + PDMINTRA(:,NM6(JI)) = PDMINTRA(:,NM6(JI)) * PMASK(:,JI) + PDMINTER(:,NM0(JI)) = PDMINTER(:,NM0(JI)) * PMASK(:,JI) + PDMINTER(:,NM3(JI)) = PDMINTER(:,NM3(JI)) * PMASK(:,JI) + PDMINTER(:,NM6(JI)) = PDMINTER(:,NM6(JI)) * PMASK(:,JI) + PDMCOND (:,NM0(JI)) = PDMCOND (:,NM0(JI)) * PMASK(:,JI) + PDMCOND (:,NM3(JI)) = PDMCOND (:,NM3(JI)) * PMASK(:,JI) + PDMCOND (:,NM6(JI)) = PDMCOND (:,NM6(JI)) * PMASK(:,JI) + PDMNUCL (:,NM0(JI)) = PDMNUCL (:,NM0(JI)) * PMASK(:,JI) + PDMNUCL (:,NM3(JI)) = PDMNUCL (:,NM3(JI)) * PMASK(:,JI) + PDMNUCL (:,NM6(JI)) = PDMNUCL (:,NM6(JI)) * PMASK(:,JI) + PDMMERG (:,NM0(JI)) = PDMMERG (:,NM0(JI)) * PMASK(:,JI) + PDMMERG (:,NM3(JI)) = PDMMERG (:,NM3(JI)) * PMASK(:,JI) + PDMMERG (:,NM6(JI)) = PDMMERG (:,NM6(JI)) * PMASK(:,JI) + PSEDA (:,NM0(JI)) = PSEDA (:,NM0(JI)) * PMASK(:,JI) + PSEDA (:,NM3(JI)) = PSEDA (:,NM3(JI)) * PMASK(:,JI) + PSEDA (:,NM6(JI)) = PSEDA (:,NM6(JI)) * PMASK(:,JI) END DO - - -CALL CH_AER_SOLV(PM, PSIG0, PRG0, PN0,PCTOTG, PCTOTA, PCCTOT, & - ZDMINTRA,ZDMINTER,ZDMCOND,PSEDA,ZDT,POM,& - PRV, PDENAIR, PPRESSURE, PTEMP, PRC, PTIME, PSOLORG) - - +! +!------------------------------------------------------- +! +! * 7. SOLVE MOMENT EQUATIONS +! ---------------------- +! +CALL CH_AER_SOLV(PM, PLNSIG, PRG, PN, PCTOTG, PCTOTA, PCCTOT, & + PDMINTRA, PDMINTER, PDMCOND, PDMNUCL, PDMMERG, PSEDA, & + PDTACT, PRV, PDENAIR, PPRESSURE, PTEMP, PRC, PTIME, & + PSOLORG, PMBEG, PMINT, PMEND) +! END SUBROUTINE CH_AER_DRIVER diff --git a/src/MNH/ch_aer_eqm_initn.f90 b/src/MNH/ch_aer_eqm_initn.f90 index 59447b812..0759d63ce 100644 --- a/src/MNH/ch_aer_eqm_initn.f90 +++ b/src/MNH/ch_aer_eqm_initn.f90 @@ -53,7 +53,7 @@ END MODULE MODI_CH_AER_EQM_INIT_n USE MODD_CH_AEROSOL USE MODD_CSTS_DUST, ONLY : XDENSITY_DUST USE MODD_CH_AERO_n -USE MODD_CH_M9_n, ONLY : CNAMES +USE MODD_CH_M9_n, ONLY : CNAMES, NEQ USE MODD_CH_MNHC_n, ONLY : LCH_INIT_FIELD USE MODD_NSV USE MODD_CONF @@ -131,6 +131,10 @@ IF (.NOT.(ASSOCIATED(XSOLORG))) THEN ALLOCATE(XSOLORG(SIZE(PCHEM,1),SIZE(PCHEM,2),SIZE(PCHEM,3),10)) XSOLORG(:,:,:,:) = 0. END IF +IF (.NOT.(ALLOCATED(XFAC))) ALLOCATE(XFAC(NSP+NSOA+NCARB)) +IF (.NOT.(ALLOCATED(XRHOI))) ALLOCATE(XRHOI(NSP+NSOA+NCARB)) +IF (.NOT.(ASSOCIATED(XFRAC))) ALLOCATE(XFRAC(SIZE(PCHEM,1),SIZE(PCHEM,2),SIZE(PCHEM,3),NEQ)) +IF (.NOT.(ASSOCIATED(XSEDA))) ALLOCATE(XSEDA(SIZE(PCHEM,1),SIZE(PCHEM,2),SIZE(PCHEM,3),JPMODE*3)) ! ! Default values of molar mass @@ -170,8 +174,8 @@ ELSE ZINIRADIUSI = XINIRADIUSI ZINIRADIUSJ = XINIRADIUSJ END IF -ZMINRGI = ZINIRADIUSI * XCOEFRADIMIN -ZMINRGJ = ZINIRADIUSJ * XCOEFRADJMIN +ZMINRGI = ZINIRADIUSI ! * XCOEFRADIMIN +ZMINRGJ = ZINIRADIUSJ ! * XCOEFRADJMIN ! Aerosol Density @@ -401,19 +405,17 @@ XSVMIN(NSV_CHEMBEG-1+JP_CH_CO) = 1E-10 ZRHODREFMIN = MAX_ll( PRHODREF(:,:,:), IINFO_ll) ZMASS = XN0IMIN * ((ZMINRGI**3)*EXP(4.5 * (LOG(XSIGIMIN))**2)) ZM6MIN = XN0IMIN * ((ZMINRGI**6)*EXP(18. * (LOG(XSIGIMIN))**2)) -XSVMIN(NSV_AERBEG-1+JP_CH_BCi) = ZMASS * XFAC(JP_AER_BC) * 6.0221367E+11/(ZDEN2MOL*12.*ZRHODREFMIN) -XSVMIN(NSV_AERBEG-1+JP_CH_DSTi) = ZMASS * XFAC(JP_AER_DST) * 6.0221367E+11/(ZDEN2MOL*12.*ZRHODREFMIN) +XSVMIN(NSV_AERBEG-1+JP_CH_BCi) = 0.5*ZMASS * XFAC(JP_AER_BC) * 6.0221367E+11/(ZDEN2MOL*12.*ZRHODREFMIN) +XSVMIN(NSV_AERBEG-1+JP_CH_OCi) = 0.5*ZMASS * XFAC(JP_AER_OC) * 6.0221367E+11/(ZDEN2MOL*12.*ZRHODREFMIN) XSVMIN(NSV_AERBEG-1+JP_CH_M0i) = XN0IMIN * 1E-6 / (ZDEN2MOL*ZRHODREFMIN) IF (LVARSIGI) XSVMIN(NSV_AERBEG-1+JP_CH_M6i) = ZM6MIN / (ZDEN2MOL*ZRHODREFMIN) ! ! For j mode ZMASS = XN0JMIN * ((ZMINRGJ**3)*EXP(4.5 * (LOG(XSIGJMIN))**2)) ZM6MIN = XN0JMIN * ((ZMINRGJ**6)*EXP(18. * (LOG(XSIGJMIN))**2)) -XSVMIN(NSV_AERBEG-1+JP_CH_BCj) = ZMASS * XFAC(JP_AER_BC) * 6.0221367E+11/(ZDEN2MOL*12.*ZRHODREFMIN) -XSVMIN(NSV_AERBEG-1+JP_CH_DSTj) = ZMASS * XFAC(JP_AER_DST) * 6.0221367E+11/(ZDEN2MOL*12.*ZRHODREFMIN) +XSVMIN(NSV_AERBEG-1+JP_CH_BCj) = 0.5*ZMASS * XFAC(JP_AER_BC) * 6.0221367E+11/(ZDEN2MOL*12.*ZRHODREFMIN) +XSVMIN(NSV_AERBEG-1+JP_CH_OCj) = 0.5*ZMASS * XFAC(JP_AER_OC) * 6.0221367E+11/(ZDEN2MOL*12.*ZRHODREFMIN) XSVMIN(NSV_AERBEG-1+JP_CH_M0j) = XN0JMIN * 1E-6 / (ZDEN2MOL*ZRHODREFMIN) IF (LVARSIGJ) XSVMIN(NSV_AERBEG-1+JP_CH_M6j) = ZM6MIN / (ZDEN2MOL*ZRHODREFMIN) ! -XSVMIN(NSV_AERBEG:NSV_AEREND) = 0. -! END SUBROUTINE CH_AER_EQM_INIT_n diff --git a/src/MNH/ch_aer_growth.f90 b/src/MNH/ch_aer_growth.f90 index 855ef7440..2417a53af 100644 --- a/src/MNH/ch_aer_growth.f90 +++ b/src/MNH/ch_aer_growth.f90 @@ -12,265 +12,15 @@ MODULE MODI_CH_AER_GROWTH !! ######################### !! -INTERFACE -!! -SUBROUTINE CH_AER_GROWTH(PM,PSIG0, PRG0, PDMCOND,PDENAIR,PGASMW,PPGAS,PTGAS,PRH, POM,& - PSO4RAT, PDT) -IMPLICIT NONE -REAL, DIMENSION(:,:), INTENT(INOUT) :: PM -REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMCOND, POM -REAL, DIMENSION(:), INTENT(IN) :: PDENAIR,PPGAS,PTGAS -REAL, DIMENSION(:), INTENT(INOUT) :: PRH, PSO4RAT -REAL, DIMENSION(:,:), INTENT(INOUT) :: PSIG0, PRG0 -REAL, INTENT(INOUT) :: PGASMW -REAL, INTENT(IN) :: PDT -END SUBROUTINE CH_AER_GROWTH -!! -END INTERFACE !! END MODULE MODI_CH_AER_GROWTH !! !! ############################################## - SUBROUTINE CH_AER_GROWTH(PM,PSIG0, PRG0, PDMCOND,PDENAIR,& - PGASMW,PPGAS,PTGAS,PRH, POM,& - PSO4RAT, PDT) + SUBROUTINE CH_AER_GROWTH() !! ############################################## !! !! PURPOSE !! ------- !! -!! This routine computes the rate of change due to condensation -!! and homogene nucleation -!! -!!************************************************************* -!! -!! Sans test pour savoir si toute la vapeur est utilisee -!! -!! REFERENCE -!! --------- -!! none -!! -!! AUTHOR -!! ------ -!! Vincent Crassier (LA) -!! -!! MODIFICATIONS -!! ------------- -!! Tulet P. ajout nucleation Kulmala, 1998 -!! -!************************************************************* -! Entry variables: -! -! PM(JPIN) -Array of moments -! ZT -Present time in the scheme -! -!************************************************************* -! Exit variables: -! -! ZCOEFM(JPIN) -Array of moment variation due to condensation -! and homogeneous nucleation -! -!************************************************************* -! Variables used during the condensation calculation -! -! ZALPHA - accomodation coefficient -! ZCBAR - kinetic velocity of vapor molecules (m/s) -! ZDV - vapor diffusivity (m2/s) -! ZPSIT - size-independant component of the growth law -! ZSATUR - saturation ratio of condensed species -!************************************************************* -! Variables used during nucleation calculation -! -! ZCCRIT -Critical concentration for production of new -! particles (kg/m3) -! ZC0 -Initial monomer concentration (kg/m3) -! ZG0 -Critical cluster number -! ZP -Rate of gas phase production of sulfuric acid -! concentration C (kg/m3) -! ZSURTEN -Surface tension (N/m) -! ZTHETA -Dimensionless surface energy -! ZW0 -Dimensionless energy barrier to nucleation -! ************************************************************ -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -USE MODD_CH_AEROSOL -USE MODI_CH_AER_NUCL -USE MODD_CST, ONLY : XPI -!! -IMPLICIT NONE -! -! -!* 0.1 Declarations of arguments -! -REAL, DIMENSION(:,:), INTENT(INOUT) :: PM -REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMCOND, POM -REAL, DIMENSION(:), INTENT(IN) :: PDENAIR,PPGAS,PTGAS -REAL, DIMENSION(:), INTENT(INOUT) :: PRH, PSO4RAT -REAL, DIMENSION(:,:), INTENT(INOUT) :: PSIG0, PRG0 -REAL, INTENT(INOUT) :: PGASMW -REAL, INTENT(IN) :: PDT -! -!* 0.2 Declarations of local variables -! -INTEGER :: JI,JJ - -REAL, DIMENSION(SIZE(PM,1),JPMODE,2) :: ZRIK -REAL, DIMENSION(SIZE(PM,1)) :: ZRG,ZLN2S - -REAL, DIMENSION(SIZE(PM,1)) :: ZRIKNC,ZRIKFM -REAL, DIMENSION(SIZE(PM,1)) :: ZSIGGAS,ZSIGAIR -REAL, DIMENSION(SIZE(PM,1)) :: ZSIG -REAL, DIMENSION(SIZE(PM,1)) :: ZCBAR -REAL, DIMENSION(SIZE(PM,1),(JPMODE)*3) :: ZMOM -REAL, DIMENSION(SIZE(PM,1)) :: ZCCRIT -REAL, DIMENSION(SIZE(PM,1)) :: ZDTD,ZTINF,ZCSO4SS -REAL, DIMENSION(SIZE(PM,1)) :: ZDMDT,ZDNDT,ZDM3DT,ZDM6DT -REAL, DIMENSION(SIZE(PM,1)) :: ZAL, ZJA, ZSULF - -REAL :: ZDV,ZALPHA - -REAL :: ZMSO4 - -ZALPHA=0.05 -ZMSO4 = 98. -PDMCOND(:,:)=0.d0 -! -!------------------------------------------------------------------------------- -! -! Pour l'instant seul H2SO4 peut nucleer, d'une part -! de facon homogene (creation de nouvelles particules) -! d'autre part de facon heterogene (sur les particules -! d'aerosol deja existante) - -!******************************************************* -! Compute the binary diffusivity of the gaseous species -!******************************************************* -ZSIGAIR(:)=(PGASMW/1000.*3./(6.023e23*4.*XPI*PDENAIR(:)))**(1./3.) - -ZSIGGAS(:)=(ZMSO4/1000.*3./(6.023e23*4.*XPI*XRHOI(2)))**(1./3.) -ZSIG(:)=(ZSIGGAS(:)+ZSIGAIR(:))/2. -ZCBAR(:)=SQRT(8.*PTGAS(:)*8.31441/(XPI*ZMSO4*1.e-3)) -ZDV=0.08e-4 - -!************************* -! Compute the Omega terms -!************************* - -DO JI=1,JPMODE - - ZRG(:)=PRG0(:,JI)*1.e-6 - ZLN2S(:)=PSIG0(:,JI)**2 - - DO JJ=1,6 - - ZMOM(:,JJ)=PM(:,NM0(JI))*ZRG(:)**JJ*exp(real(JJ)**2*ZLN2S(:)/2.) - - ENDDO - - - ZRIKFM(:)=XPI*ZALPHA*ZCBAR(:)/8.*ZMOM(:,2) - ZRIKNC(:)=XPI*ZDV/2.*ZMOM(:,1) - - ZRIK(:,JI,1)=ZRIKFM(:)*(ZRIKNC(:)/(ZRIKFM(:)+ZRIKNC(:))) - - ZRIKFM(:)=XPI*ZALPHA*ZCBAR(:)/8.*ZMOM(:,5) - ZRIKNC(:)=XPI*ZDV/2.*ZMOM(:,4) - - ZRIK(:,JI,2)=ZRIKFM(:)*(ZRIKNC(:)/(ZRIKFM(:)+ZRIKNC(:))) - -ENDDO -POM(:,1)=(ZRIK(:,1,1)/(ZRIK(:,1,1)+ZRIK(:,2,1))) -POM(:,2)=(ZRIK(:,2,1)/(ZRIK(:,1,1)+ZRIK(:,2,1))) -! -IF (CNUCLEATION=='KERMINEN') THEN -!****************************************************************** -! Debut de la partie nucleation homogene en utilisant l'approche de -! Kerminen et Wexler (1994) -!****************************************************************** - - ZCCRIT(:)=0.16*exp(0.1*PTGAS(:)-3.5*PRH(:)-27.7) -!KS: suppress nucleation -! ZCCRIT(:)=1E20 - -! ZTINF, the time constant for particles to condense onto -! existing particles is given by Tinf=1/(dM3i/dt+dm3j/dt) -! where M3i and M3j are in third moment par CM3 - - ZDTD(:)=8.*(ZRIK(:,1,1)+ZRIK(:,2,1)) - ZTINF(:)=1./ZDTD(:) - - ZCSO4SS(:)=PSO4RAT(:)*(ZMSO4/6.0221367E+11)*ZTINF(:) - - DO JI = 1,SIZE(PM,1) - - IF (ZCSO4SS(JI) <= ZCCRIT(JI)) THEN !No nucleation - ZDNDT(JI)=0. - ZDMDT(JI)=0. - ZDM6DT(JI)=0. - ELSE !Calculate nucleation - -! Nucleation of particles from excess mass concentration of sulfuric acid -! above critical mass concentration of sulfuric acid -! and condensation of the remaining mass - - ZDMDT(JI)=ZDTD(JI)*(ZCSO4SS(JI)-ZCCRIT(JI)) -! Les nouvelles particules fraichement crees sont inclues dans le mode -! d'aitken avec les parametres d'initialisation au niveau de la distribution - ZDNDT(JI)=ZDMDT(JI)*1.e-18/XFAC(JP_AER_SO4)/((0.0025e-6)**3*exp(9./2.*log(1.5)**2)) - ZDM6DT(JI)=ZDNDT(JI)*(0.0025)**6*exp(18.*log(1.5)**2) -! write(*,*) 'Nucleation: ','DNDT= ',ZDNDT,' DM6DT= ',ZDM6DT - - ENDIF - - ENDDO -ELSE - ZDNDT(:)=0. - ZDMDT(:)=0. - ZDM6DT(:)=0. -ENDIF -! -IF (CNUCLEATION=='KULMALA') THEN -! compute nucleation rate -! - ZSULF(:) = PSO4RAT(:) * PDT -! - CALL CH_AER_NUCL(PRH,PTGAS,ZSULF,ZJA,ZAL,SIZE(PSO4RAT,1)) -! -! new mass in molec.cm-3.s-1 - ZDMDT(:)= ZAL(:)*ZJA(:) -! convert into microgram.m-3.s-1 - ZDMDT(:)= ZDMDT(:) * ZMSO4/6.0221367E+11 -! -! Les nouvelles particules fraichement crees sont inclues dans le mode -! d'aitken avec les parametres d'initialisation au niveau de la distribution -! - ZDNDT(:) = ZDMDT(:)/(XFAC(JP_AER_SO4)*(PRG0(:,1)**3)*EXP(4.5 * PSIG0(:,1)**2)) - ZDM6DT(:) = ZDNDT(:)*(PRG0(:,1)**6*EXP(18.*PSIG0(:,1)**2)) - -ELSE - ZDNDT(:)=0. - ZDMDT(:)=0. - ZDM6DT(:)=0. -ENDIF -! -! condensation des sulfates -ZDM3DT(:)=PSO4RAT(:)*(ZMSO4/6.0221367E+11)/XFAC(JP_AER_SO4)*1.e-18 -! -! Enlever la quantite de 3e moment deja consommee pour la nucleation homogene -ZDM3DT(:)=ZDM3DT(:)-ZDMDT(:)/XFAC(JP_AER_SO4)*1.e-18 -! -! -PDMCOND(:,1)=ZDNDT(:) -PDMCOND(:,2)=ZDMDT(:)/XFAC(JP_AER_SO4) -PDMCOND(:,3)=ZDM6DT(:) -! -DO JI=1,JPMODE - PDMCOND(:,NM3(JI))=PDMCOND(:,NM3(JI))+ZDM3DT(:)*POM(:,JI)*1.e18 - PDMCOND(:,NM6(JI))=PDMCOND(:,NM6(JI))+ZDM3DT(:)*POM(:,JI)*ZRIK(:,JI,2)/ZRIK(:,JI,1)*1.e36 - -ENDDO -! END SUBROUTINE CH_AER_GROWTH diff --git a/src/MNH/ch_aer_mineral.f90 b/src/MNH/ch_aer_mineral.f90 index bdb08046e..646453544 100644 --- a/src/MNH/ch_aer_mineral.f90 +++ b/src/MNH/ch_aer_mineral.f90 @@ -2,69 +2,64 @@ !ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence !ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt !ORILAM_LIC for details. -!----------------------------------------------------------------- -!--------------- special set of characters for RCS information -!----------------------------------------------------------------- -! $Source$ $Revision$ -! MASDEV4_7 chimie 2006/05/18 13:07:25 -!----------------------------------------------------------------- -!! ####################### +!! ########################## MODULE MODI_CH_AER_MINERAL -!! ####################### +!! ########################## !! INTERFACE -! +!! SUBROUTINE CH_AER_MINERAL(PCTOTG, PCTOTA, PRV, PDENAIR, PPRESSURE, PTEMP, PRC, POM,& - PCCTOT,PSIG0, PRG0, PDT) + PCCTOT) IMPLICIT NONE REAL, DIMENSION(:,:), INTENT(INOUT) :: PCTOTG, POM REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCTOTA, PCCTOT REAL, DIMENSION(:), INTENT(IN) :: PRV, PDENAIR, PPRESSURE, PTEMP, PRC -REAL, DIMENSION(:,:), INTENT(INOUT) :: PSIG0, PRG0 -REAL, INTENT(IN) :: PDT -! +!! END SUBROUTINE CH_AER_MINERAL -! +!! END INTERFACE -! +!! END MODULE MODI_CH_AER_MINERAL !! !! -!########################################################################################## - SUBROUTINE CH_AER_MINERAL(PCTOTG, PCTOTA, PRV, PDENAIR, PPRESSURE, PTEMP, PRC, POM,& - PCCTOT,PSIG0, PRG0,PDT) -!########################################################################################### +!! ##################################################################################### + SUBROUTINE CH_AER_MINERAL(PCTOTG, PCTOTA, PRV, PDENAIR, PPRESSURE, PTEMP, PRC, POM, & + PCCTOT) +!! ##################################################################################### !! !! PURPOSE !! ------- !! solve the mineral thermodynamic balance !! -!! REFERENCE -!! --------- -!! none +!! REFERENCE +!! --------- +!! None !! -!! AUTHOR -!! ------ -!! P. Tulet (GMEI) +!! AUTHOR +!! ------ +!! P. Tulet (GMEI) !! -!! MODIFICATIONS -!! ------------- +!! MODIFICATIONS +!! ------------- !! -!! EXTERNAL -!! -------- -!! None +!! EXTERNAL +!! -------- +!! None !! !------------------------------------------------------------------------------- ! +!* 0. DECLARATIONS +! ------------ +! USE MODD_CH_AEROSOL USE MODI_CH_NNARES USE MODI_CH_ARES USE MODI_CH_ISOROPIA USE MODI_CH_AER_THERMO USE MODI_CH_AER_EQSAM -USE MODD_CST, ONLY : XMNH_TINY -!USE MODI_CH_AER_DIFF -!! +USE MODD_CST, ONLY : XMNH_TINY +USE MODD_CONF, ONLY : NVERB +! IMPLICIT NONE ! !* 0.1 Declarations of arguments @@ -72,38 +67,40 @@ IMPLICIT NONE REAL, DIMENSION(:,:), INTENT(INOUT) :: PCTOTG, POM REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCTOTA, PCCTOT REAL, DIMENSION(:), INTENT(IN) :: PRV, PDENAIR, PPRESSURE, PTEMP, PRC -REAL, DIMENSION(:,:), INTENT(INOUT) :: PSIG0, PRG0 -REAL, INTENT(IN) :: PDT ! !* 0.2 Declarations of local variables ! INTEGER :: JI,JJ -REAL, DIMENSION(SIZE(PCTOTA,1),NSP,JPMODE) :: ZFRAC -REAL, DIMENSION(SIZE(PCTOTA,1),NSP) :: ZTOT,ZTOTNEW, ZTOTGNEW +REAL, DIMENSION(SIZE(PCTOTA,1),NSP,JPMODE) :: ZFRAC +REAL, DIMENSION(SIZE(PCTOTA,1),NSP) :: ZTOT,ZTOTNEW, ZTOTGNEW REAL, DIMENSION(SIZE(PCTOTA,1),NSP+NCARB+NSOA) :: ZDEL -REAL, DIMENSION(SIZE(PCTOTA,1),6) :: ZAER -REAL, DIMENSION(SIZE(PCTOTA,1)) :: ZPKM, ZPKH2O, ZSAT, ZRH - -!***************************************************************** -!***************************************************************** -! SOLVEUR DE L'EQUILIBRE CHIMIQUE MINERAL -!***************************************************************** -!***************************************************************** - -ZPKM(:) = 1E-3*PDENAIR(:) * 6.0221367E+23 / 28.9644 -ZPKH2O(:) = ZPKM(:)*1.6077*PRV(:) +REAL, DIMENSION(SIZE(PCTOTA,1),6) :: ZAER +REAL, DIMENSION(SIZE(PCTOTA,1)) :: ZPKM, ZPKH2O, ZSAT, ZRH +! +!------------------------------------------------------------------------------- +! +!* 1. INITIALIZATION +! -------------- +! +ZPKM (:) = 1E-3 * PDENAIR(:) * 6.0221367E+23 / 28.9644 +ZPKH2O(:) = ZPKM(:) * 1.6077 * PRV(:) ! ! compute relative humidity -ZSAT(:)=0.611*EXP(17.2694*(PTEMP(:)-273.16)/(PTEMP(:)-35.86)) -ZSAT(:)=ZSAT(:)*1000. -ZRH(:)=(ZPKH2O(:)/(ZPKM(:)*1.6077))*PPRESSURE(:)/& - &(0.622+(ZPKH2O(:)/(ZPKM(:)*1.6077)))/ZSAT(:) -ZRH(:) = MIN(0.95, MAX(ZRH(:), .1)) ! until 0.95 thermodynamic code is not valid +ZSAT(:) = 0.611*EXP(17.2694*(PTEMP(:)-273.16)/(PTEMP(:)-35.86)) +ZSAT(:) = ZSAT(:)*1000. +ZRH (:) = (ZPKH2O(:)/(ZPKM(:)*1.6077))*PPRESSURE(:)/& + & (0.622+(ZPKH2O(:)/(ZPKM(:)*1.6077)))/ZSAT(:) +ZRH(:) = MIN(0.95, MAX(ZRH(:), .1)) ! until 0.95 thermodynamic code is not valid ! ! Mass need to be positive -PCTOTA(:,:,:)= MAX (PCTOTA(:,:,:),0.) -PCTOTG(:,:)= MAX (PCTOTG(:,:),0.) -ZTOTGNEW(:,:)= 0. +PCTOTA(:,:,:) = MAX(PCTOTA(:,:,:),0.) +PCTOTG(:,:) = MAX(PCTOTG(:,:), 0.) +ZTOTGNEW(:,:) = 0. +! +!------------------------------------------------------------------------------- +! +!* 2. COMPUTE MINERAL CHEMICAL EQUILIBRIUM +! ------------------------------------ ! !****************************************************************** ! Calcul de la repartition des differentes especes entre les modes @@ -112,9 +109,12 @@ ZTOTGNEW(:,:)= 0. DO JI=1,NSP ZTOTNEW(:,JI)=0. ZTOT(:,JI)=PCTOTA(:,JI,1)+PCTOTA(:,JI,2) - ZTOT(:,JI) = MAX(ZTOT(:,JI),1.E-40) + ZTOT(:,JI) = MAX(ZTOT(:,JI),1.E-40) ZFRAC(:,JI,1)=PCTOTA(:,JI,1)/(ZTOT(:,JI)+1E-25) ZFRAC(:,JI,2)=1.-ZFRAC(:,JI,1) + ! use SO4 fraction for all species (clean this up later) + ZFRAC(:,JI,1)=ZFRAC(:,1,1) + ZFRAC(:,JI,2)=1.-ZFRAC(:,JI,1) ENDDO ! ZTOTNEW(:,:) = ZTOT(:,:) @@ -193,9 +193,9 @@ ELSE IF (CMINERAL == 'EQSAM') THEN ! ELSE -PRINT *,' WARNING WARNING WARNING WARNING WARNING WARNING' -PRINT *,' PAS D EQUILIBRE THERMODYNAMIQUE ENTRE LES MINERAUX' -PRINT *,' WARNING WARNING WARNING WARNING WARNING WARNING' +IF (NVERB==10) PRINT *,' WARNING WARNING WARNING WARNING WARNING WARNING' +IF (NVERB==10) PRINT *,' PAS D EQUILIBRE THERMODYNAMIQUE ENTRE LES MINERAUX' +IF (NVERB==10) PRINT *,' WARNING WARNING WARNING WARNING WARNING WARNING' ZTOTNEW(:,:) = MAX(0.,ZTOT(:,:)) ENDIF @@ -209,16 +209,18 @@ ZDEL(:,1:NSP)=ZTOTNEW(:,1:NSP)-ZTOT(:,1:NSP) ! ! Calcul de la nouvelle composition chimique ! de chacun des modes apres equilibre chimique +! DO JI=1,JPMODE DO JJ=1,NSP - !PCTOTA(:,JJ,JI)=MAX(XMNH_TINY,PCTOTA(:,JJ,JI)+ZFRAC(:,JJ,JI)*ZDEL(:,JJ)) + PCTOTA(:,JJ,JI)=MAX(XMNH_TINY,PCTOTA(:,JJ,JI)+ZFRAC(:,JJ,JI)*ZDEL(:,JJ)) ! répartition entre les modes en fonction de la surface des aerosols (facteur ! omega) ! PCTOTA(:,JJ,JI)=MAX(XMNH_TINY,PCTOTA(:,JJ,JI)+ZDEL(:,JJ)*POM(:,JI)) - PCTOTA(:,JJ,JI)=MAX(XMNH_TINY,ZTOTNEW(:,JJ)*POM(:,JI)) + ! PCTOTA(:,JJ,JI)=MAX(XMNH_TINY,ZTOTNEW(:,JJ)*POM(:,JI)) ENDDO -ENDDO + !PCTOTA(:,JP_AER_SO4,JI) = ZCTOTA(:,JP_AER_SO4,JI) +ENDDO ! DO JJ=1,NSP PCTOTG(:,JJ)=MAX(XMNH_TINY,PCTOTG(:,JJ)-ZDEL(:,JJ)) diff --git a/src/MNH/ch_aer_nucl.f90 b/src/MNH/ch_aer_nucl.f90 index 738f80a9c..9f566ed1d 100644 --- a/src/MNH/ch_aer_nucl.f90 +++ b/src/MNH/ch_aer_nucl.f90 @@ -2,26 +2,19 @@ !ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence !ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt !ORILAM_LIC for details. -!----------------------------------------------------------------- -!--------------- special set of characters for RCS information -!----------------------------------------------------------------- -! $Source$ $Revision$ -! MASDEV4_7 chimie 2006/05/18 13:07:25 -!----------------------------------------------------------------- -!! ################################ -MODULE MODI_CH_AER_NUCL -!! ################################ +!! ######################### + MODULE MODI_CH_AER_NUCL +!! ######################### !! INTERFACE !! - SUBROUTINE CH_AER_NUCL(ZRH,ZT,ZCONC,ZJ,ZAL,KVECNPT) + SUBROUTINE CH_AER_NUCL(PRH,PTEMP,PSULF,PJNUC,PJ2RAT) IMPLICIT NONE !! -REAL, DIMENSION(:), INTENT(INOUT) :: ZJ,ZAL -REAL, DIMENSION(:), INTENT(IN) :: ZRH,ZT -REAL, DIMENSION(:), INTENT(INOUT) :: ZCONC -INTEGER, INTENT(IN) :: KVECNPT - !! + REAL, DIMENSION(:), INTENT(IN) :: PRH,PTEMP + REAL, DIMENSION(:), INTENT(INOUT) :: PSULF + REAL, DIMENSION(:), INTENT(INOUT) :: PJNUC + REAL, DIMENSION(:), INTENT(INOUT) :: PJ2RAT !! END SUBROUTINE CH_AER_NUCL !! @@ -29,95 +22,228 @@ END INTERFACE !! END MODULE MODI_CH_AER_NUCL !! -!! ######################################################################### -SUBROUTINE CH_AER_NUCL(ZRH,ZT,ZCONC,ZJ,ZAL,KVECNPT) -!########################################################### -! -!! -!! +!! ############################################## + SUBROUTINE CH_AER_NUCL(PRH,PTEMP,PSULF,PJNUC,PJ2RAT) +!! ############################################## +!! +!! PURPOSE +!! ------- +!! +!! METHOD +!! ------ +!! +!! EXTERNAL +!! -------- +!! Subroutine CH_AER_KULMALA : compute nucleation rate from Kulmala et al. 1998 parametrization +!! Subroutine CH_AER_VEHKAMAKI : compute nucleation rate from Vehkamaki et al. 2002 parametrization +!! Subroutine CH_AER_MAATTANEN_NEUTRAL : compute nucleation rate from Neural Maattanen et al. 2018 parametrization +!! Subroutine CH_AER_MAATTANEN_IONIND : compute nucleation rate from Ion-induced Maattanen et al. 2018 parametrization +!! +!! IMPLICIT ARGUMENTS +!! ------------------ +!! USE MODD_CH_AEROSOL !! -!! PURPOSE -!! ------- -!! -!! compute nucleation rate for binary sulfate/H2O -!! (Kulmala 1998) +!! REFERENCE +!! --------- !! -!! AUTHOR -!! ------ -!! F.Cousin * Laboratoire d'Aerologie* +!! AUTHOR +!! ------ +!! Brice Foucart & Joris Pianezze (LACy) !! -!! MODIFICATIONS -!! ------------- -!! P. Tulet 05/01/04 -!! M.Leriche 2015 : correction bug -!---------------------------------------------------------------------------- +!! MODIFICATIONS +!! ------------- +!! Original 06/2018 +!! +!------------------------------------------------------------------------------- ! -!* 0. DECLARATIONS -! ------------ +!* 0. DECLARATIONS +! ------------ +! +USE MODD_CST, ONLY : XAVOGADRO +USE MODI_CH_AER_KULMALA +USE MODI_CH_AER_VEHKAMAKI +USE MODI_CH_AER_MAATTANEN_NEUTRAL +USE MODI_CH_AER_MAATTANEN_IONIND +USE MODI_CH_AER_MODE_MERGING +! +USE MODD_CH_AEROSOL +USE MODD_CONF, ONLY : NVERB ! -! IMPLICIT NONE ! -!* 0.1 Declarations of dummy arguments : +!* 0.1 Declarations of arguments ! -REAL, DIMENSION(:), INTENT(INOUT) :: ZJ,ZAL -REAL, DIMENSION(:), INTENT(IN) :: ZRH,ZT -REAL, DIMENSION(:), INTENT(INOUT) :: ZCONC -INTEGER, INTENT(IN) :: KVECNPT -INTEGER :: II -REAL, DIMENSION(KVECNPT) :: RA,XH2O,PVH2O,PVH2SO4,KHI,SIG,XNSULFC,XNSULF -REAL :: Kb,TC,T0 - - -Kb=1.381E-23 -TC = 905.15 -T0 = 360.15 -! 1. Saturation vapor pressure for water (N/m2, T in K) -! (Preining et al, 1981) -PVH2O(:) = EXP(77.344913-7235.4247/ZT(:)-8.2*LOG(ZT(:))+0.0057113*ZT(:)) -! 2. Water concentration (molec/cm3) -XH2O(:) = ZRH(:)*PVH2O(:)/(Kb*ZT(:))/1.E6 - -ZJ(:)=0. -ZAL(:)=0. -RA(:)=0. - -WHERE(((ZT(:)>=223.).OR.(ZT(:)<=298)).AND.(ZRH(:)>=0.1)) -! 1. Saturation vapor pressure for water (N/m2, T in K) -! (Preining et al, 1981) - PVH2O(:) = EXP(77.344913-7235.4247/ZT(:)-8.2*LOG(ZT(:))+0.0057113*ZT(:)) -! 2. Water concentration (molec/cm3) - XH2O(:) = ZRH(:)*PVH2O(:)/(Kb*ZT(:))/1.E6 -! 3. Saturation vapor pressure for H2SO4 -! (Kulmala et al 1990, Seinfeld 577p) -!PVH2SO4 = 1./T-1./T0+0.38*T0*(1./T-1./T0)/(TC-T0) -!PVH2SO4 = PVH2SO4 + 0.38/(TC-T0)*LOG(T/T0) -!PVH2SO4 = -10156.0*PVH2SO4 - 0.414 -!PVH2SO4= EXP(PVH2SO4) - PVH2SO4(:)=EXP(-10156./T0+16.259+10156.*(-1./ZT(:)+1./T0+0.38/(TC-T0)*& - (1.+LOG(T0/ZT(:))-T0/ZT(:))))*101325. - -! 4. Relative Acidity - RA(:)=ZCONC(:)*1.E6*(Kb*ZT(:))/PVH2SO4(:) - -END WHERE -! 5. H2SO4 mole fraction in the critical nucleous - DO II=1,SIZE(ZCONC,1) - IF((ZCONC(II)>0.).AND.(XH2O(II)>0.).AND.(RA(II)/=0.)) THEN - ZAL(II)=1.2233-0.0154*RA(II)/(RA(II)+ZRH(II))+0.0102*& - LOG(ZCONC(II))-0.0415*LOG(XH2O(II))+0.0016*ZT(II) - END IF - END DO - -WHERE(((ZT(:)>=223.).OR.(ZT(:)<=298)).AND.(ZRH(:)>=0.1).AND.ZAL(:)/=0.) - ! 6. Sulfuric nucleation rate (molec/cm3/s) - XNSULFC(:)=EXP(-14.5125+0.1335*ZT(:)-10.5462*ZRH(:)+1958.4*ZRH(:)/ZT(:)) - SIG(:) = 1.+(ZT(:)-273.15)/273.15 - XNSULF(:)=LOG(ZCONC(:)/XNSULFC(:)) - KHI(:)=25.1289*XNSULF(:)-4890.8*XNSULF(:)/ZT(:)-1743.3/ZT(:)-2.2479*SIG(:)*XNSULF(:)*ZRH(:)+& - 7643.4*ZAL(:)/ZT(:)-1.9712*ZAL(:)*SIG(:)/ZRH(:) - ZJ(:)=EXP(KHI(:)) -END WHERE +REAL, DIMENSION(:), INTENT(IN) :: PRH,PTEMP +REAL, DIMENSION(:), INTENT(INOUT) :: PSULF +REAL, DIMENSION(:), INTENT(INOUT) :: PJNUC +REAL, DIMENSION(:), INTENT(INOUT) :: PJ2RAT +! +!* 0.2 Declarations of local variables +! +REAL, DIMENSION(SIZE(PSULF,1)) :: ZRCN, ZRCI ! Critical cluster in m (neutral and ion-ind) +REAL, DIMENSION(SIZE(PSULF,1)) :: ZRCN2, ZRCI2 ! Diameter of critical cluster in nm (neutral and ion-ind) +REAL, DIMENSION(SIZE(PSULF,1)) :: ZLKKN, ZLKKI ! Final scaling factor from Lehtinen et al., 2007 (neutral and ion-ind) +REAL, DIMENSION(SIZE(PSULF,1)) :: ZJNUCN, ZJNUCI ! Nucleation rate in part.cm-3.s-1 (neutral and ion-ind) +REAL, DIMENSION(SIZE(PSULF,1)) :: ZJ2RATN, ZJ2RATI ! Nucleation rate for 2 nm in part.cm-3.s-1 (neutral and ion-ind) +REAL, DIMENSION(SIZE(PSULF,1)) :: ZSULF ! Sulfuric acid concentration in molec.cm-3 +REAL, DIMENSION(SIZE(PSULF,1)) :: ZGR ! Particle Growth Rate according to Nieminen et al., 2010 (nm.h-1) +REAL, DIMENSION(SIZE(PSULF,1)) :: ZGAMMA ! Gamma +REAL :: ZCS ! Typical CS value in atmosphere in 1/h +REAL :: ZMAV ! Average m-value according to Lehtinen et al., 2007 +REAL :: ZTSIZE ! Target size (in geometric diameter = mobility diameter -0.3nm). +! +!------------------------------------------------------------------------------- +! +!* 1. DEFINE VARIABLES FOR J2 (particle formation rate) +! ----------------------------------------------- +! +! [ Please, note that these calculations can fe found in the supplementary Fortran code of Maattanen et al., 2018 ] +! +! a) H2SO4 conversion from ug.m-3 to molec.cm-3 +! +!ZSULF(:) = PSULF(:)*(XAVOGADRO*1.E-12) / XH2SO4 +! +! b) Growth rate calculation +! +!ZMAV = -1.6 ! It can also be calculated +! +! +!ZGR(:) = ZSULF(:) / (661.1 * (PRH(:) * 100)**2 - 1.129E5 * (PRH(:)*100) + 1.549E7) +! +! +! c) Condensation sink imposition +! +!ZCS = 22. ! It can also be calculated +! +! d) Target size (here 2 so 2 - 0.3 = 1.7) +! +!ZTSIZE = 1.7 ! We want a J2nm so 2nm -0.3 = 1.7 nm +! +! +!* 2. NUCLEATION PARAMETRIZATIONS +! --------------------------- +! +! [ Please, note that Kulmala et al., 1998 and Vehkamaki et al., 2002 are neutral parametrizations ] +! +! +!IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_NUCL PSULF (deb) =',PSULF +! +IF (CNUCLEATION == 'KULMALA') THEN + ! + CALL CH_AER_KULMALA(PRH, PTEMP, PSULF, PJNUC, ZRCN) + ! + ! J2 (J2RAT) calculation for Kulmala: + ! + !ZRCN2(:) = 2. * ZRCN(:) * 1.E9 + ! + !ZGAMMA(:) = max( 0.0, 1.0 / (ZMAV+1) * ((ZTSIZE /(ZRCN2(:)))**(ZMAV+1) -1) ) + ! + !ZLKKN(:) = exp(-ZGAMMA(:) * ZRCN2(:) * ZCS / ZGR(:)) ! Final scaling factor + ! + !PJ2RAT(:) = PJNUC(:) * ZLKKN(:) + ! +ELSE IF (CNUCLEATION == 'VEHKAMAKI') THEN + ! + CALL CH_AER_VEHKAMAKI(PRH, PTEMP, PSULF, PJNUC, ZRCN) + ! + ! J2 (J2RAT) calculation for Vehkamaki: + ! + !ZRCN2(:) = 2. * ZRCN(:) * 1.E9 + ! + !ZGAMMA(:) = max( 0.0, 1.0 / (ZMAV+1) * ((ZTSIZE /(ZRCN2(:)))**(ZMAV+1) -1) ) + ! + !ZLKKN(:) = exp(-ZGAMMA(:) * ZRCN2(:) * ZCS / ZGR(:)) ! Final scaling factor + ! + !PJ2RAT(:) = PJNUC(:) * ZLKKN(:) + ! +ELSE IF (CNUCLEATION == 'MAATTANEN_NEUTRAL') THEN + ! + ! Define ZJNUCN + ! + ZJNUCN(:) = PJNUC(:) + ! + CALL CH_AER_MAATTANEN_NEUTRAL(PRH, PTEMP, PSULF, ZJNUCN, ZRCN) + ! + PJNUC(:) = ZJNUCN(:) + ! + ! J2 (J2RAT) calculation for Maattanen neutral: + ! + !ZRCN2(:) = 2. * ZRCN(:) * 1.E9 + ! + !ZGAMMA(:) = max( 0.0, 1.0 / (ZMAV+1) * ((ZTSIZE /(ZRCN2(:)))**(ZMAV+1) -1) ) + ! + !ZLKKN(:) = exp(-ZGAMMA(:) * ZRCN2(:) * ZCS / ZGR(:)) ! Final scaling factor + ! + !PJ2RAT(:) = PJNUC(:) * ZLKKN(:) + ! +ELSE IF (CNUCLEATION == 'MAATTANEN_IONIND') THEN + ! + ! Define ZJNUCI + ! + ZJNUCI(:) = PJNUC(:) + ! + CALL CH_AER_MAATTANEN_IONIND(PRH, PTEMP, PSULF, ZJNUCI, ZRCI) + ! + PJNUC(:) = ZJNUCI(:) + ! + ! J2 (J2RAT) calculation for Maattanen ion-ind: + ! + !ZRCI2(:) = 2. * ZRCI(:) * 1.E9 + ! + !ZGAMMA(:) = max( 0.0, 1.0 / (ZMAV+1) * ((ZTSIZE /(ZRCI2(:)))**(ZMAV+1) -1) ) + ! + !ZLKKI(:) = exp(-ZGAMMA(:) * ZRCI2(:) * ZCS / ZGR(:)) ! Final scaling factor + ! + !PJ2RAT(:) = PJNUC(:) * ZLKKI(:) + ! +ELSE IF (CNUCLEATION == 'MAATTANEN_BOTH') THEN + ! + ! Define ZJNUCN + ! + ZJNUCN(:) = PJNUC(:) + ! + CALL CH_AER_MAATTANEN_NEUTRAL(PRH, PTEMP, PSULF, ZJNUCN, ZRCN) + ! + ! J2 (J2RAT) calculation for Maattanen neutral: + ! + !ZRCN2(:) = 2. * ZRCN(:) * 1.E9 + ! + !ZGAMMA(:) = max( 0.0, 1.0 / (ZMAV+1) * ((ZTSIZE /(ZRCN2(:)))**(ZMAV+1) -1) ) + ! + !ZLKKN(:) = exp(-ZGAMMA(:) * ZRCN2(:) * ZCS / ZGR(:)) ! Final scaling factor + ! + !ZJ2RATN(:) = ZJNUCN(:) * ZLKKN(:) + ! + ! Define ZJNUCI + ! + ZJNUCI(:) = PJNUC(:) + ! + CALL CH_AER_MAATTANEN_IONIND(PRH, PTEMP, PSULF, ZJNUCI, ZRCI) + ! + ! J2 (J2RAT) calculation for Maattanen ion-ind: + ! + !ZRCI2(:) = 2. * ZRCI(:) * 1.E9 + ! + !ZGAMMA(:) = max( 0.0, 1.0 / (ZMAV+1) * ((ZTSIZE /(ZRCI2(:)))**(ZMAV+1) -1) ) + ! + !ZLKKI(:) = exp(-ZGAMMA(:) * ZRCI2(:) * ZCS / ZGR(:)) ! Final scaling factor + ! + !ZJ2RATI(:) = ZJNUCI(:) * ZLKKI(:) + ! + ! New particle formation rates addition + ! + PJNUC(:) = ZJNUCN(:) + ZJNUCI(:) + ! + !PJ2RAT(:) = ZJ2RATN(:) + ZJ2RATI(:) + ! +END IF +! +PJ2RAT(:) = 1E-7 +! +IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_NUCL PJNUC =',PJNUC +IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_NUCL PSULF (fin) =',PSULF +IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_NUCL ZJNUCI =',ZJNUCI +IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_NUCL ZJNUCN =',ZJNUCN -RETURN +! END SUBROUTINE CH_AER_NUCL diff --git a/src/MNH/ch_aer_solv.f90 b/src/MNH/ch_aer_solv.f90 index 22d84df38..e64c026e9 100644 --- a/src/MNH/ch_aer_solv.f90 +++ b/src/MNH/ch_aer_solv.f90 @@ -14,24 +14,25 @@ !! INTERFACE !! -SUBROUTINE CH_AER_SOLV(PM, PSIG0, PRG0, PN0,PCTOTG, PCTOTA, PCCTOT, & - PDMINTRA,PDMINTER,PDMCOND, PSEDA,PDT,& - POM, PRV, PDENAIR, PPRESSURE, PTEMP, PRC, PTIME,PSOLORG) +SUBROUTINE CH_AER_SOLV(PM, PLNSIG, PRG, PN,PCTOTG, PCTOTA, PCCTOT, & + PDMINTRA,PDMINTER,PDMCOND, PDMNUCL, PDMMERG, PSEDA,PDT, & + PRV, PDENAIR, PPRESSURE, PTEMP, PRC, PTIME,PSOLORG, & + PMBEG,PMINT,PMEND) IMPLICIT NONE REAL, DIMENSION(:,:), INTENT(INOUT) :: PM -REAL, DIMENSION(:,:), INTENT(INOUT) :: POM REAL, DIMENSION(:,:), INTENT(INOUT) :: PSEDA REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMINTRA REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMINTER REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMCOND -REAL, DIMENSION(:,:), INTENT(INOUT) :: PSIG0, PRG0, PN0 +REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMNUCL +REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMMERG +REAL, DIMENSION(:,:), INTENT(INOUT) :: PLNSIG, PRG, PN REAL, DIMENSION(:,:), INTENT(INOUT) :: PCTOTG REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCTOTA, PCCTOT REAL, DIMENSION(:,:), INTENT(INOUT) :: PSOLORG REAL, INTENT(IN) :: PDT, PTIME REAL, DIMENSION(:), INTENT(IN) :: PRV, PDENAIR, PPRESSURE, PTEMP, PRC - - +REAL, DIMENSION(:,:), INTENT(INOUT) :: PMBEG,PMINT,PMEND END SUBROUTINE CH_AER_SOLV !! END INTERFACE @@ -39,9 +40,10 @@ END INTERFACE END MODULE MODI_CH_AER_SOLV !! !! ############################################################################## - SUBROUTINE CH_AER_SOLV(PM, PSIG0, PRG0, PN0,PCTOTG, PCTOTA, PCCTOT, & - PDMINTRA,PDMINTER,PDMCOND,PSEDA, PDT, POM, & - PRV, PDENAIR, PPRESSURE, PTEMP, PRC, PTIME,PSOLORG) + SUBROUTINE CH_AER_SOLV(PM, PLNSIG, PRG, PN,PCTOTG, PCTOTA, PCCTOT, & + PDMINTRA,PDMINTER,PDMCOND,PDMNUCL,PDMMERG,PSEDA, PDT, & + PRV, PDENAIR, PPRESSURE, PTEMP, PRC, PTIME,PSOLORG, & + PMBEG,PMINT,PMEND) !! ############################################################################## !! !! PURPOSE @@ -66,6 +68,7 @@ END MODULE MODI_CH_AER_SOLV !! M. Leriche 08/16 suppress moments index declaration already in modd_aerosol !! M. Leriche 08/16 add an other particular case for the M0 resolution to !! avoid a division by zero (when ZK = 1) +!! J. Pianezze : 10/2018 add comments and simplification !! !! EXTERNAL !! -------- @@ -76,181 +79,183 @@ END MODULE MODI_CH_AER_SOLV ! ------------ ! USE MODD_CH_AEROSOL -USE MODD_CST, ONLY : XMNH_TINY +USE MODD_CST, ONLY : XMNH_TINY +USE MODD_CONF, ONLY : NVERB USE MODI_CH_AER_MINERAL USE MODI_CH_AER_ORGANIC USE MODI_CH_AER_MPMPO ! -! IMPLICIT NONE ! !* 0.1 declarations of arguments ! REAL, DIMENSION(:,:), INTENT(INOUT) :: PM -REAL, DIMENSION(:,:), INTENT(INOUT) :: POM REAL, DIMENSION(:,:), INTENT(INOUT) :: PSEDA REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMINTRA REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMINTER REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMCOND -REAL, DIMENSION(:,:), INTENT(INOUT) :: PSIG0, PRG0, PN0 +REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMNUCL +REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMMERG +REAL, DIMENSION(:,:), INTENT(INOUT) :: PLNSIG, PRG, PN REAL, DIMENSION(:,:), INTENT(INOUT) :: PCTOTG REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCTOTA, PCCTOT REAL, INTENT(IN) :: PDT, PTIME REAL, DIMENSION(:), INTENT(IN) :: PRV, PDENAIR, PPRESSURE, PTEMP, PRC REAL, DIMENSION(:,:), INTENT(INOUT) :: PSOLORG +REAL, DIMENSION(:,:), INTENT(INOUT) :: PMBEG,PMINT,PMEND ! !* 0.2 declarations of local variables ! -INTEGER :: JI,JJ,JK, JN, IDT -REAL, DIMENSION(SIZE(PM,1)) :: ZSUM -REAL, DIMENSION(SIZE(PM,1),JPMODE) :: ZNEWM, ZMASK -REAL, DIMENSION(SIZE(PM,1)) :: ZSIGMA - -REAL, DIMENSION(SIZE(PM,1)) :: ZA,ZB,ZC,ZD -REAL, DIMENSION(SIZE(PM,1)) :: ZCONST1,ZCONST2 -REAL, DIMENSION(SIZE(PM,1)) :: Z0,ZK,ZKEXP - -REAL, SAVE, DIMENSION(JPMODE*3) :: ZPMIN -REAL, SAVE, DIMENSION(JPMODE) :: ZRATIOBC, ZRATIOOC -REAL :: ZINIRADIUSI, ZINIRADIUSJ -REAL, SAVE, DIMENSION(JPMODE) :: ZRGMIN, ZRGMAX -LOGICAL, SAVE :: GPHYSLIM = .TRUE. ! flag +INTEGER :: JI,JJ,JK, JN, IDT +REAL, DIMENSION(SIZE(PM,1)) :: ZSUM +REAL, DIMENSION(SIZE(PM,1),JPMODE) :: ZOM,ZMASK +REAL, DIMENSION(SIZE(PM,1)) :: ZSIGMA +! +REAL, DIMENSION(SIZE(PM,1)) :: ZA,ZB,ZC,ZD +REAL, DIMENSION(SIZE(PM,1)) :: ZCONST1,ZCONST2 +REAL, DIMENSION(SIZE(PM,1)) :: Z0,ZK,ZKEXP +! +REAL, SAVE, DIMENSION(JPMODE*3) :: ZPMIN +REAL, SAVE, DIMENSION(JPMODE) :: ZRATIOBC, ZRATIOOC +REAL :: ZINIRADIUSI, ZINIRADIUSJ ! !------------------------------------------------------------------------------- ! +!* 1. INITIALIZATION +! -------------- +! +PMBEG(:,:)=PM(:,:) +! +IF (CRGUNIT=="MASS") THEN + ZINIRADIUSI = XINIRADIUSI * EXP(-3.*(LOG(XINISIGI))**2) + ZINIRADIUSJ = XINIRADIUSJ * EXP(-3.*(LOG(XINISIGJ))**2) +ELSE + ZINIRADIUSI = XINIRADIUSI + ZINIRADIUSJ = XINIRADIUSJ +END IF +! +ZPMIN(1) = XN0IMIN +ZPMIN(2) = ZPMIN(1) * (ZINIRADIUSI**3)*EXP(4.5 * LOG(XINISIGI)**2) +ZPMIN(3) = ZPMIN(1) * (ZINIRADIUSI**6)*EXP(18. * LOG(XINISIGI)**2) +! +ZPMIN(4) = XN0JMIN +ZPMIN(5) = ZPMIN(4) * (ZINIRADIUSJ**3)*EXP(4.5 * LOG(XINISIGJ)**2) +ZPMIN(6) = ZPMIN(4) * (ZINIRADIUSJ**6)*EXP(18. * LOG(XINISIGJ)**2) +! +!------------------------------------------------------------------------------- +! +!* 2. SOLVE MOMENT DYNAMIC EQUATIONS +! ------------------------------ +! +DO JI=1,JPMODE ! - IF (CRGUNIT=="MASS") THEN - ZINIRADIUSI = XINIRADIUSI * EXP(-3.*(LOG(XINISIGI))**2) - ZINIRADIUSJ = XINIRADIUSJ * EXP(-3.*(LOG(XINISIGJ))**2) - ELSE - ZINIRADIUSI = XINIRADIUSI - ZINIRADIUSJ = XINIRADIUSJ - END IF + !* 2.1 MOMENT 0 + ! + !************************************************************* + ! Resolution du moment d'ordre 0: pour cela il faut resoudre + ! une equation differentielle du type dY/dt=-AY^2-BY+C + ! these Crassier page 42 + !************************************************************* ! - ZPMIN(1) = XN0IMIN - ZPMIN(2) = ZPMIN(1) * (ZINIRADIUSI**3)*EXP(4.5 * LOG(XSIGIMIN)**2) - ZPMIN(3) = ZPMIN(1) * (ZINIRADIUSI**6)*EXP(18. * LOG(XSIGIMIN)**2) + ! Pour la resolution plusieurs cas particuliers seront traites + ZA(:) = 0.0 + ZB(:) = 0.0 + ZC(:) = 0.0 + ZA(:) = -PDMINTRA(:,NM0(JI)) / (PM(:,NM0(JI))**2.0) + ZB(:) = -PDMINTER(:,NM0(JI)) / PM(:,NM0(JI)) + ZC(:) = PDMCOND (:,NM0(JI)) + PDMNUCL(:,NM0(JI)) ! - ZPMIN(4) = XN0JMIN - ZPMIN(5) = ZPMIN(4) * (ZINIRADIUSJ**3)*EXP(4.5 * LOG(XSIGJMIN)**2) - ZPMIN(6) = ZPMIN(4) * (ZINIRADIUSJ**6)*EXP(18. * LOG(XSIGJMIN)**2) + DO JK=1,SIZE(PM,1) + IF ( (ZA(JK) == 0.) .AND. (ZB(JK) == 0.) ) THEN + IF (NVERB .GE. 10) WRITE(*,*) '~~~ CH_AER_SOLV 1.1 : IF 2' + PM(JK,NM0(JI)) = PM(JK,NM0(JI)) + ZC(JK) * PDT + ELSE IF ((ZB(JK) == 0. .AND. ZC(JK)/PM(JK,NM0(JI)) <= 1.e-10).OR. & + (ZC(JK) <= 1.e-10 .AND. ZB(JK)/ZA(JK) <= 1.e-3)) THEN + IF (NVERB .GE. 10) WRITE(*,*) '~~~ CH_AER_SOLV 1.1 : IF 1' + ! type dY/dt=-AY^2 + Z0(JK)=PM(JK,NM0(JI)) + PM(JK,NM0(JI))=Z0(JK)/(1.+ZA(JK)*Z0(JK)*PDT) + ELSE + IF (NVERB .GE. 10) WRITE(*,*) '~~~ CH_AER_SOLV 1.1 : IF 3' + ZCONST1(JK)=ZB(JK)/(2.*ZA(JK)) + Z0(JK)=PM(JK,NM0(JI))+ZCONST1(JK) + IF (((ZB(JK)**2+4.*ZA(JK)*ZC(JK))) < 0.) THEN + ZD(JK)=SQRT(ABS(ZB(JK)**2+4.*ZA(JK)*ZC(JK))) + PM(JK,NM0(JI))=-ZCONST1(JK)+ZD(JK)*TAN(ATAN(Z0(JK)/ZD(JK))-ZA(JK)*ZD(JK)*PDT) + ELSE + ZD(JK)=SQRT(ZB(JK)**2+4.*ZA(JK)*ZC(JK)) + ZCONST2(JK)=ZD(JK)/(2.*ABS(ZA(JK))) + ZKEXP(JK)=EXP(-2.*ZA(JK)*ZCONST2(JK)*PDT) + ZK(JK)=(Z0(JK)-ZCONST2(JK))/(Z0(JK)+ZCONST2(JK))*ZKEXP(JK) + PM(JK,NM0(JI))=-ZCONST1(JK)+ZCONST2(JK)*(1.+ZK(JK))/(1.-ZK(JK)) + ENDIF + ENDIF + ENDDO + ! + PM(:,NM0(JI)) = PM(:,NM0(JI)) + (PDMMERG(:,NM0(JI)) + PSEDA(:,NM0(JI))) * PDT + PM(:,NM0(JI))= MAX(PM(:,NM0(JI)), XMNH_TINY ) + ! + !************************************************************* + ! Resolution du moment d'ordre 3 + ! eq. diff. de type dY/dt = K + !************************************************************* + ! + PM(:,NM3(JI))=PM(:,NM3(JI))+ & + (PDMINTRA(:,NM3(JI))+PDMINTER(:,NM3(JI))+PDMCOND(:,NM3(JI))+& + PDMNUCL(:,NM3(JI))+PDMMERG(:,NM3(JI))+PSEDA(:,NM3(JI)))*PDT + ! + PM(:,NM3(JI))= MAX(PM(:,NM3(JI)), XMNH_TINY) + ! + !************************************************************* + ! Resolution du moment d'ordre 6 + ! eq. diff. de type dY/dt = K + !************************************************************* + ! + PM(:,NM6(JI))=PM(:,NM6(JI))+ & + (PDMINTRA(:,NM6(JI))+PDMINTER(:,NM6(JI))+PDMCOND(:,NM6(JI))+& + PDMNUCL(:,NM6(JI))+PDMMERG(:,NM6(JI))+PSEDA(:,NM6(JI)) )*PDT + ! + PM(:,NM6(JI))= MAX(PM(:,NM6(JI)), XMNH_TINY) ! -!write(*,*) -!write(*,*) '******************************************' -!write(*,*) ' Debut Solveur Aerosol ' -!write(*,*) '******************************************' -!write(*,*) -!write(*,*) 'Pas de temps:',PDT,'s' - -!***************************************************************** -!***************************************************************** -! SOLVEUR DE lA PARTIE MICROPHYSIQUE -!***************************************************************** -!***************************************************************** -! -DO JI=1,JPMODE - -!************************************************************* -! Resolution du moment d'ordre 0: pour cela il faut resoudre -! une equation differentielle du type dY/dt=-AY^2-BY+C -!************************************************************* - - -! Pour la resolution plusieurs cas particuliers seront traites -ZA(:)=0. -ZB(:)=0. -ZC(:)=0. -ZA(:)=PDMINTRA(:,NM0(JI)) -ZB(:)=PDMINTER(:,NM0(JI)) -ZC(:)=PDMCOND(:,NM0(JI)) - - -DO JK=1,SIZE(PM,1) - IF ((ZB(JK) == 0. .AND. ZC(JK)/PM(JK,NM0(JI)) <= 1.e-10).OR. & - (ZC(JK) <= 1.e-10 .AND. ZB(JK)/ZA(JK) <= 1.e-3)) THEN -! type dY/dt=-AY^2 - Z0(JK)=PM(JK,NM0(JI)) - PM(JK,NM0(JI))=Z0(JK)/(1.+ZA(JK)*Z0(JK)*PDT) - ELSE - ZCONST1(JK)=ZB(JK)/(2.*ZA(JK)) - Z0(JK)=PM(JK,NM0(JI))+ZCONST1(JK) - IF (((ZB(JK)**2+4.*ZA(JK)*ZC(JK))) < 0.) THEN - ZD(JK)=SQRT(ABS(ZB(JK)**2+4.*ZA(JK)*ZC(JK))) - PM(JK,NM0(JI))=-ZCONST1(JK)+ZD(JK)*TAN(ATAN(Z0(JK)/ZD(JK))-ZA(JK)*ZD(JK)*PDT) - ELSE - ZD(JK)=SQRT(ZB(JK)**2+4.*ZA(JK)*ZC(JK)) - ZCONST2(JK)=ZD(JK)/(2.*ABS(ZA(JK))) - ZKEXP(JK)=EXP(-2.*ZA(JK)*ZCONST2(JK)*PDT) - ZK(JK)=(Z0(JK)-ZCONST2(JK))/(Z0(JK)+ZCONST2(JK))*ZKEXP(JK) - PM(JK,NM0(JI))=-ZCONST1(JK)+ZCONST2(JK)*(1.+ZK(JK))/(1.-ZK(JK)) - ENDIF - ENDIF -ENDDO - - ! Sedimentation for particules number - -PM(:,NM0(JI))= PM(:,NM0(JI)) + PSEDA(:,NM0(JI)) * PDT -PM(:,NM0(JI))= MAX(PM(:,NM0(JI)), XMNH_TINY ) - - -!************************************************************* -! Resolution du moment d'ordre 3 -!************************************************************* - -PM(:,NM3(JI))=PM(:,NM3(JI))+ & - (PDMINTRA(:,NM3(JI))+PDMINTER(:,NM3(JI))+PDMCOND(:,NM3(JI))+& - PSEDA(:,NM3(JI)))*PDT -PM(:,NM3(JI))= MAX(PM(:,NM3(JI)), XMNH_TINY) - -!************************************************************* -! Resolution du moment d'ordre 6 -!************************************************************* - -PM(:,NM6(JI))=PM(:,NM6(JI))+ (PM(:,NM0(JI))**2*PDMINTRA(:,NM6(JI))+& - PDMINTER(:,NM6(JI))+PDMCOND(:,NM6(JI)) + PSEDA(:,NM6(JI)) )*PDT - -PM(:,NM6(JI))= MAX(PM(:,NM6(JI)), XMNH_TINY) ENDDO - - -!***************************************************************** -!***************************************************************** -! SOLVEUR DE L'EQUILIBRE CHIMIQUE (MARS sera utilise) -!***************************************************************** -!***************************************************************** - +! +!------------------------------------------------------------------------------- +! +!* 3. CHEMICAL EQUILIBRIUM +! -------------------- +! !****************************************************************** ! Calcul de la variation de concentration des differents ! composes pour trouver le nouveau moment d'ordre 3 !****************************************************************** - +! DO JI=1,JPMODE - -! Coagulation intermodale -!------------------------- - -DO JJ=1,NSP+NCARB+NSOA - - PCTOTA(:,JJ,JI)=PCTOTA(:,JJ,JI) & + ! + ! Coagulation intermodale + !------------------------- + ! + DO JJ=1,NSP+NCARB+NSOA + ! + PCTOTA(:,JJ,JI)=PCTOTA(:,JJ,JI) & +(PCCTOT(:,JJ,1)*PDMINTER(:,NM3(JI)) + PCCTOT(:,JJ,JI)* PDMINTRA(:,NM3(JI))) & *XFAC(JJ)*PDT - -! Sedimentation -!-------------- - PCTOTA(:,JJ,JI)= PCTOTA(:,JJ,JI) + PCCTOT(:,JJ,JI)*PSEDA(:,NM3(JI))*XFAC(JJ)*PDT - PCTOTA(:,JJ,JI)= MAX(PCTOTA(:,JJ,JI), XMNH_TINY) - - -ENDDO + ! + ! Sedimentation + !-------------- + PCTOTA(:,JJ,JI)= PCTOTA(:,JJ,JI) + PCCTOT(:,JJ,JI)*PSEDA(:,NM3(JI))*XFAC(JJ)*PDT + PCTOTA(:,JJ,JI)= MAX(PCTOTA(:,JJ,JI), XMNH_TINY) + ! + ENDDO + ! ENDDO - +! ! H2SO4 Condensation + Nucleation !--------------------------------- - - PCTOTA(:,JP_AER_SO4,1)=PCTOTA(:,JP_AER_SO4,1) & - +PDMCOND(:,NM3(1))*XFAC(JP_AER_SO4)*PDT - PCTOTA(:,JP_AER_SO4,2)=PCTOTA(:,JP_AER_SO4,2) & - +PDMCOND(:,NM3(2))*XFAC(JP_AER_SO4)*PDT +! +PCTOTA(:,JP_AER_SO4,1)=PCTOTA(:,JP_AER_SO4,1) & + +(PDMCOND(:,NM3(1))+PDMNUCL(:,NM3(1))+PDMMERG(:,NM3(1)))*XFAC(JP_AER_SO4)*PDT +PCTOTA(:,JP_AER_SO4,2)=PCTOTA(:,JP_AER_SO4,2) & + +(PDMCOND(:,NM3(2))+PDMNUCL(:,NM3(2))+PDMMERG(:,NM3(2)))*XFAC(JP_AER_SO4)*PDT ! !************************************************************* ! Calcul de la fraction massique entre les modes @@ -261,141 +266,152 @@ DO JI=1,JPMODE ZSUM (:) = ZSUM (:) + PCTOTA(:,JJ,JI) ENDDO ENDDO -POM(:,:) = 0. +ZOM(:,:) = 0. DO JI=1,JPMODE DO JJ=1,NSP+NCARB+NSOA - POM(:,JI) = POM(:,JI) + PCTOTA(:,JJ,JI) / ZSUM (:) + ZOM(:,JI) = ZOM(:,JI) + PCTOTA(:,JJ,JI) / ZSUM (:) ENDDO ENDDO - - +! ! Equilibre mineraux !------------------- - +! IDT = INT(MAX(5.*PDT,1.)) +! IF ((PDT .GT. 0.).AND.( MOD(INT(PTIME) , IDT) .EQ. 0)) THEN -!IF (PDT .GT. 0.) THEN - CALL CH_AER_MINERAL(PCTOTG, PCTOTA,PRV, PDENAIR, PPRESSURE, PTEMP, PRC, POM,& - PCCTOT,PSIG0, PRG0, PDT) - -! Equilibre Organiques -!--------------------- - + CALL CH_AER_MINERAL(PCTOTG, PCTOTA,PRV, PDENAIR, PPRESSURE, PTEMP, PRC, ZOM,& + PCCTOT) + ! + ! Equilibre Organiques + !--------------------- + ! IF (NSOA .EQ. 10) CALL CH_AER_ORGANIC(PCTOTG, PCTOTA,PRV, PDENAIR, & PPRESSURE, PTEMP,& - PRC, POM, PCCTOT,PSIG0, PRG0, PDT, PSOLORG) + PRC, ZOM, PCCTOT,PLNSIG, PRG, PDT, PSOLORG) + ! END IF - -! Mass need to be positive -PCTOTA(:,:,:)= MAX (PCTOTA(:,:,:),0.) -PCTOTG(:,:)= MAX (PCTOTG(:,:),0.) - +! +! Forced mass need to be positive +PCTOTA(:,:,:) = MAX(PCTOTA(:,:,:), 0.0) +PCTOTG(:,:) = MAX(PCTOTG(:,:) , 0.0) +! DO JI=1,JPMODE ZSUM(:)=0. DO JJ=1,NSP+NCARB+NSOA - ZSUM(:)=ZSUM(:)+PCTOTA(:,JJ,JI)/XRHOI(JJ) + ZSUM(:)=ZSUM(:)+PCTOTA(:,JJ,JI)/XRHOI(JJ) ENDDO - + ! DO JJ=1,NSP+NCARB+NSOA - PCCTOT(:,JJ,JI)=PCTOTA(:,JJ,JI)/XRHOI(JJ)/ZSUM(:) - + PCCTOT(:,JJ,JI)=PCTOTA(:,JJ,JI)/XRHOI(JJ)/ZSUM(:) ENDDO ENDDO - +! +PMINT(:,:)=PM(:,:) +! +! +!------------------------------------------------------------------------------- +! +!* 4. ADJUSTEMENT OF AEROSOL DISTRIBUTION AFTER CHEMICAL EQUILIBRIUM +! -------------------------------------------------------------- +! +! !****************************************************************************** ! Calcul des nouveaux moments d'ordre 3 et 6 ! Le moment d'ordre 3 est recalcule a partir de la composition de chaque mode ! Le moment d'ordre 6 est calcule pour garder sigma constant pendant l'equilibre chimique !****************************************************************************** -DO JN=1,JPMODE ! - +! 4.1 COMPUTATION OF THE NEW SIGMA +! ---------------------------- +! +DO JN=1,JPMODE + ! IF (JN .EQ. 1) THEN - + ! IF (LVARSIGI) THEN ! variable dispersion for mode 1 - - ZSIGMA(:)=PM(:,NM3(JN))**2./(PM(:,NM0(JN))*PM(:,NM6(JN))) - ZSIGMA(:)=MIN(1-1E-10,ZSIGMA(:)) - ZSIGMA(:)=MAX(1E-10,ZSIGMA(:)) - ZSIGMA(:)= LOG(ZSIGMA(:)) - ZSIGMA(:)= EXP(1./3.*SQRT(-ZSIGMA(:))) + ! + ZSIGMA(:) = PM(:,NM3(JN))**2./(PM(:,NM0(JN))*PM(:,NM6(JN))) + ZSIGMA(:) = MIN(1-1E-10,ZSIGMA(:)) + ZSIGMA(:) = MAX(1E-10,ZSIGMA(:)) + ZSIGMA(:) = LOG(ZSIGMA(:)) + ZSIGMA(:) = EXP(1./3.*SQRT(-ZSIGMA(:))) + ! WHERE (ZSIGMA(:) > XSIGIMAX) - ZSIGMA(:) = XSIGIMAX + ZSIGMA(:) = XSIGIMAX END WHERE + ! WHERE (ZSIGMA(:) < XSIGIMIN) - ZSIGMA(:) = XSIGIMIN + ZSIGMA(:) = XSIGIMIN END WHERE - + ! ELSE ! fixed dispersion for mode 1 ZSIGMA(:) = XINISIGI END IF END IF -! + ! IF (JN .EQ. 2) THEN - + ! IF (LVARSIGJ) THEN ! variable dispersion for mode 2 - - ZSIGMA(:)=PM(:,NM3(JN))**2./(PM(:,NM0(JN))*PM(:,NM6(JN))) - ZSIGMA(:)=MIN(1-1E-10,ZSIGMA(:)) - ZSIGMA(:)=MAX(1E-10,ZSIGMA(:)) - ZSIGMA(:)= LOG(ZSIGMA(:)) - ZSIGMA(:)= EXP(1./3.*SQRT(-ZSIGMA(:))) + ! + ZSIGMA(:) = PM(:,NM3(JN))**2./(PM(:,NM0(JN))*PM(:,NM6(JN))) + ZSIGMA(:) = MIN(1-1E-10,ZSIGMA(:)) + ZSIGMA(:) = MAX(1E-10,ZSIGMA(:)) + ZSIGMA(:) = LOG(ZSIGMA(:)) + ZSIGMA(:) = EXP(1./3.*SQRT(-ZSIGMA(:))) + ! WHERE (ZSIGMA(:) > XSIGJMAX) - ZSIGMA(:) = XSIGJMAX + ZSIGMA(:) = XSIGJMAX END WHERE + ! WHERE (ZSIGMA(:) < XSIGJMIN) - ZSIGMA(:) = XSIGJMIN + ZSIGMA(:) = XSIGJMIN END WHERE - + ! ELSE ! fixed dispersion for mode 2 ZSIGMA(:) = XINISIGJ END IF END IF - - PSIG0(:,JN) = LOG(ZSIGMA(:)) - - PN0(:,JN) = PM(:,NM0(JN)) - + ! + PLNSIG(:,JN) = LOG(ZSIGMA(:)) + ! END DO - +! +! +! 4.2 COMPUTATION OF THE MOMENT 3 AFTER CHEMICAL EQUILIBRIUM +! ------------------------------------------------------ +! DO JN=1,JPMODE -! Calcul du nouveau moment d'ordre 3 - ZNEWM(:,JN)=0. + ZSUM(:)=0.0 DO JJ=1,NSP+NCARB+NSOA - PCTOTA(:,JJ,JN) = MAX(PCTOTA(:,JJ,JN),0.) - ZNEWM(:,JN)=ZNEWM(:,JN)+PCTOTA(:,JJ,JN)/XFAC(JJ) + ZSUM(:) = ZSUM(:)+PCTOTA(:,JJ,JN)/XFAC(JJ) ENDDO - PM(:,NM3(JN))=ZNEWM(:,JN) + PM(:,NM3(JN))=ZSUM(:) END DO - +! +! +! 4.2 COMPUTATION OF THE MOMENT 6 AFTER CHEMICAL EQUILIBRIUM +! ------------------------------------------------------ +! DO JN=1,JPMODE PM(:,NM6(JN)) = PM(:,NM0(JN)) & - * ( (PM(:,NM3(JN))/PM(:,NM0(JN)))**(1./3.) * exp(-(3./2.)*PSIG0(:,JN)**2))**6 & - * exp(18.*PSIG0(:,JN)**2) - - PRG0(:,JN)= (PM(:,NM3(JN))**4/(PM(:,NM6(JN)) * PM(:,NM0(JN))**3))**(1./6.) + * ( (PM(:,NM3(JN))/PM(:,NM0(JN)))**(1./3.) * EXP(-(3./2.)*PLNSIG(:,JN)**2))**6 & + * EXP(18.*PLNSIG(:,JN)**2) ENDDO +! +!------------------------------------------------------------------------------- +! +!* 5. TO AVOID VALUES BELOW MINIMUM REQUIRED +! -------------------------------------- +! !************************************************************* ! Blindages pour valeurs inferieurs au mininmum accepte !************************************************************* -! ratio selon ch_aer_reallfin.f90 ((modifiable) -ZRATIOBC(1) = 5.84E-3 / (5.84E-3+2.336E-2) -ZRATIOOC(1) = 2.336E-2 / (5.84E-3+2.336E-2) -ZRATIOBC(2) = 1.46E-3 / (1.46E-3+5.84E-3) -ZRATIOOC(2) = 5.84E-3 / (1.46E-3+5.84E-3) -ZRGMIN(1) = ZINIRADIUSI / XCOEFRADIMIN -ZRGMIN(2) = ZINIRADIUSJ / XCOEFRADJMIN -ZRGMAX(1) = XCOEFRADIMAX * ZINIRADIUSI -ZRGMAX(2) = XCOEFRADJMAX * ZINIRADIUSJ - +! DO JN=1,JPMODE ZMASK(:,JN) = 1. WHERE ((PM(:,NM0(JN)) .LT. ZPMIN(NM0(JN))).OR.& (PM(:,NM3(JN)) .LT. ZPMIN(NM3(JN))).OR.& (PM(:,NM6(JN)) .LT. ZPMIN(NM6(JN)))) -! (PM(:,NM6(JN)) .LE. ZPMIN(NM6(JN))).OR.& -! (PRG0(:,JN)) .LE. ZRGMIN(JN).OR.& -! (PRG0(:,JN)) .GT. ZRGMAX(JN)) PM(:,NM0(JN)) = ZPMIN(NM0(JN)) PM(:,NM3(JN)) = ZPMIN(NM3(JN)) @@ -407,11 +423,12 @@ DO JN=1,JPMODE PCTOTA(:,JJ,JN) = PCTOTA(:,JJ,JN) * ZMASK(:,JN) ENDDO WHERE (ZMASK(:,JN) == 0.) - PCTOTA(:,JP_AER_BC,JN) = ZRATIOBC(JN) * ZPMIN(NM3(JN)) * XFAC(JP_AER_BC) - PCTOTA(:,JP_AER_OC,JN) = ZRATIOOC(JN) * ZPMIN(NM3(JN)) * XFAC(JP_AER_OC) + PCTOTA(:,JP_AER_BC,JN) = 0.5 * ZPMIN(NM3(JN)) * XFAC(JP_AER_BC) + PCTOTA(:,JP_AER_OC,JN) = 0.5 * ZPMIN(NM3(JN)) * XFAC(JP_AER_OC) END WHERE - + ! ENDDO ! +PMEND(:,:)=PM(:,:) ! END SUBROUTINE CH_AER_SOLV diff --git a/src/MNH/ch_ini_orilam.f90 b/src/MNH/ch_ini_orilam.f90 index a317f49cb..38a1f31f7 100644 --- a/src/MNH/ch_ini_orilam.f90 +++ b/src/MNH/ch_ini_orilam.f90 @@ -1,18 +1,18 @@ -!ORILAM_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier +!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier !ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence !ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt !ORILAM_LIC for details. -!----------------------------------------------------------------- -!! ########################### +!! ######################### MODULE MODI_CH_INI_ORILAM -!! ########################### +!! ######################### !! INTERFACE - SUBROUTINE CH_INI_ORILAM(PM, PSIG0, PRG0, PN0,PCTOTG, PCTOTA, PCCTOT, & - PSEDA, POM, PRHOP0, PAERO,PCHEM,PRV, PDENAIR,& - PPRESSURE, PTEMP, PRC, PFRAC, PMI, GSCHEME) +!! +SUBROUTINE CH_INI_ORILAM(PM, PSIG0, PRG0, PN0,PCTOTG, PCTOTA, PCCTOT, & + PSEDA, PRHOP0, PAERO,PCHEM,PRV, PDENAIR, & + PPRESSURE, PTEMP, PRC, PFRAC, PMI, GSCHEME ) IMPLICIT NONE -REAL, DIMENSION(:,:), INTENT(INOUT) :: PM, POM +REAL, DIMENSION(:,:), INTENT(INOUT) :: PM REAL, DIMENSION(:,:), INTENT(INOUT) :: PSEDA REAL, DIMENSION(:,:), INTENT(INOUT) :: PSIG0, PRG0, PN0 REAL, DIMENSION(:,:), INTENT(INOUT) :: PCTOTG @@ -23,28 +23,25 @@ REAL, DIMENSION(:,:), INTENT(INOUT) :: PFRAC REAL, DIMENSION(:,:), INTENT(INOUT) :: PMI REAL, DIMENSION(:), INTENT(IN) :: PRV, PDENAIR, PPRESSURE, PTEMP, PRC CHARACTER(LEN=10), INTENT(IN) :: GSCHEME - - - END SUBROUTINE CH_INI_ORILAM +!! END INTERFACE !! END MODULE MODI_CH_INI_ORILAM !! -!! -!! ########################################## +!! ####################################################################### SUBROUTINE CH_INI_ORILAM(PM, PSIG0, PRG0, PN0,PCTOTG, PCTOTA, PCCTOT, & - PSEDA, POM, PRHOP0, PAERO, PCHEM, PRV, PDENAIR,& - PPRESSURE, PTEMP, PRC, PFRAC, PMI, GSCHEME) -!! ########################################## + PSEDA, PRHOP0, PAERO, PCHEM, PRV, PDENAIR, & + PPRESSURE, PTEMP, PRC, PFRAC, PMI, GSCHEME ) +!! ####################################################################### !! !! PURPOSE !! ------- -!! initialize the aerosol variables (vectorwise) by calling NNARES +!! initialize the aerosol variables (vectorwise) by calling NNARES !! !! METHOD !! ------- -!! call the solver with zero coag/growth/cond terms +!! call the solver with zero coag/growth/cond terms !! then only ares should be active and we won't need to recode everyting !! here ;-) !! @@ -59,39 +56,36 @@ END MODULE MODI_CH_INI_ORILAM !! MODIFICATIONS !! ------------- !! Original -! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg -!! +!! !! EXTERNAL !! -------- !! -!! IMPLICIT ARGUMENTS -!! ------------------ -USE MODD_CH_AEROSOL -USE MODD_CH_M9_n, ONLY : CNAMES -USE MODD_CST, ONLY : & - XPI & !Definition of pi - ,XBOLTZ & ! Boltzman constant - ,XAVOGADRO & ![molec/mol] avogadros number - ,XG & ! Gravity constant - ,XP00 & ! Reference pressure - ,XMD & ![kg/mol] molar weight of air - ,XRD & ! Gaz constant for dry air - ,XCPD ! Cpd (dry air) -USE MODD_CSTS_DUST, ONLY : XDENSITY_DUST +!------------------------------------------------------------------------------- ! -use mode_msg +!* 0. DECLARATIONS +! ------------ ! USE MODI_CH_AER_SOLV USE MODI_CH_AER_TRANS -! -!* 0. DECLARATIONS -! ------------ +USE MODD_CH_AEROSOL +USE MODD_CSTS_DUST, ONLY : XDENSITY_DUST +USE MODD_CH_M9_n, ONLY : CNAMES +USE MODD_CST, ONLY : & + XPI & ! Definition of pi + ,XBOLTZ & ! Boltzman constant + ,XAVOGADRO & ! [molec/mol] avogadros number + ,XG & ! Gravity constant + ,XP00 & ! Reference pressure + ,XMD & ! [kg/mol] molar weight of air + ,XRD & ! Gaz constant for dry air + ,XCPD ! Cpd (dry air) +USE MODD_CONF, ONLY : NVERB ! IMPLICIT NONE ! !* 0.1 declarations of arguments ! -REAL, DIMENSION(:,:), INTENT(INOUT) :: PM, POM +REAL, DIMENSION(:,:), INTENT(INOUT) :: PM REAL, DIMENSION(:,:), INTENT(INOUT) :: PSEDA REAL, DIMENSION(:,:), INTENT(INOUT) :: PSIG0, PRG0, PN0 REAL, DIMENSION(:,:), INTENT(INOUT) :: PCTOTG @@ -105,32 +99,43 @@ CHARACTER(LEN=10), INTENT(IN) :: GSCHEME ! !* 0.2 declarations of local variables ! -character(len=10) :: yspec ! String for error message -REAL, DIMENSION(SIZE(PM,1),(JPMODE)*3) :: ZDMINTRA, ZDMINTER, ZDMCOND +REAL, DIMENSION(SIZE(PM,1),(JPMODE)*3) :: ZDMINTRA, ZDMINTER, ZDMCOND, ZDMNUCL, ZDMMERG REAL, DIMENSION(SIZE(PM,1),JPMODE) :: ZMASK, ZSOLORG - +REAL, DIMENSION(SIZE(PM,1),(JPMODE)*3) :: ZMBEG, ZMINT, ZMEND +! INTEGER :: JJ, JI ! -POM(:,:) = 0. +!------------------------------------------------------------------------------- +! +!* 1. INITIALIZATION +! -------------- +! PFRAC(:,:) = 0. PSEDA(:,:) = 0. ZDMINTRA(:,:) = 0. ZDMINTER(:,:) = 0. ZDMCOND(:,:) = 0. +ZDMNUCL(:,:) = 0. +ZDMMERG(:,:) = 0. ZSOLORG(:,:) = 0. ZMASK(:,:) = 1. +ZMBEG(:,:) = 0. +ZMINT(:,:) = 0. +ZMEND(:,:) = 0. ! ! Initialization of constants -XPI = 2.*ASIN(1.) -XBOLTZ = 1.380658E-23 +! +XPI = 2.*ASIN(1.) +XBOLTZ = 1.380658E-23 XAVOGADRO = 6.0221367E+23 -XG = 9.80665 -XP00 = 1.E5 -XMD = 28.9644E-3 -XRD = XAVOGADRO * XBOLTZ / XMD -XCPD = 7.* XRD /2. +XG = 9.80665 +XP00 = 1.E5 +XMD = 28.9644E-3 +XRD = XAVOGADRO * XBOLTZ / XMD +XCPD = 7.* XRD /2. ! ! Moments index +! NM0(1) = 1 NM3(1) = 2 NM6(1) = 3 @@ -140,19 +145,23 @@ NM6(2) = 6 ! ! Aerosol Density ! Cf Ackermann (all to black carbon except water) -XRHOI(:) = 1.8e3 +XRHOI(:) = 1.8e3 XRHOI(JP_AER_H2O) = 1.0e3 ! water XRHOI(JP_AER_DST) = XDENSITY_DUST ! water ! +! Facteur de conversion : +! [um3_aer/m3_air] = [ug_aer/m3_air] / XFAC DO JJ=1,NSP+NCARB+NSOA - XFAC(JJ)=(4./3.)*XPI*XRHOI(JJ)*1.e-9 + XFAC(JJ)=(4./3.)*XPI*XRHOI(JJ)*1.E-9 ENDDO ! ! verify that all array elements are defined DO JI = 1, SIZE(XRHOI) IF (XRHOI(JI) .LE. 0.0) THEN - write( yspec, '( I10 )' ) JI - call Print_msg( NVERB_FATAL, 'GEN', 'CH_AER_MOD_INIT', 'density for species '//trim(yspec)//' not defined' ) + PRINT *, 'CH_AER_MOD_INIT ERROR: density for species ', JI, ' not defined' + ! callabortstop + CALL ABORT + STOP 'CH_AER_MOD_INIT ERROR: density not defined' END IF ENDDO ! @@ -161,107 +170,118 @@ ENDDO JP_CH_SO42M = 0 ! unuse in many schemes ! DO JJ=1,SIZE(CNAMES) -! for heterogeneous chemistry -IF (CNAMES(JJ) == "O3") JP_CH_O3 = JJ -IF (CNAMES(JJ) == "SO2") JP_CH_SO2 = JJ -IF (CNAMES(JJ) == "SO42M") JP_CH_SO42M = JJ -IF (CNAMES(JJ) == "H2O2") JP_CH_H2O2 = JJ - -! Inorganics -IF (CNAMES(JJ) == "HNO3") JP_CH_HNO3 = JJ -IF (CNAMES(JJ) == "NH3") JP_CH_NH3 = JJ -IF ((CNAMES(JJ) == "H2SO4").OR.(CNAMES(JJ) == "SULF")) JP_CH_H2SO4 = JJ - -! SOA group 1 -IF (CNAMES(JJ) == "URG1") JP_CH_URG1 = JJ -IF (CNAMES(JJ) == "UR21") JP_CH_UR21 = JJ -IF (CNAMES(JJ) == "UR28") JP_CH_UR28 = JJ - -! SOA group 2 -IF (CNAMES(JJ) == "URG2") JP_CH_URG2 = JJ -IF (CNAMES(JJ) == "RPG2") JP_CH_RPG2 = JJ -IF (CNAMES(JJ) == "RP18") JP_CH_RP18 = JJ -IF (CNAMES(JJ) == "UR29") JP_CH_UR29 = JJ -IF (CNAMES(JJ) == "UR30") JP_CH_UR30 = JJ -IF (CNAMES(JJ) == "RP13") JP_CH_RP13 = JJ -IF (CNAMES(JJ) == "RP17") JP_CH_RP17 = JJ - -! SOA group 3 -IF (CNAMES(JJ) == "RPG3") JP_CH_RPG3 = JJ -IF (CNAMES(JJ) == "RPR9") JP_CH_RPR9 = JJ -IF (CNAMES(JJ) == "RP12") JP_CH_RP12 = JJ - -! SOA group 4 -IF (CNAMES(JJ) == "URG4") JP_CH_URG4 = JJ -IF (CNAMES(JJ) == "UR8") JP_CH_UR8 = JJ ! only for MPMPO (for PUN it is group 10) -IF (CNAMES(JJ) == "UR3") JP_CH_UR3 = JJ -IF (CNAMES(JJ) == "UR23") JP_CH_UR23 = JJ - -! SOA group 5 -IF (CNAMES(JJ) == "UR17") JP_CH_UR17 = JJ -IF (CNAMES(JJ) == "AP7") JP_CH_AP7 = JJ -IF (CNAMES(JJ) == "UR7") JP_CH_UR7 = JJ ! only for MPMPO (for PUN it is group 10) -IF (CNAMES(JJ) == "RPR3") JP_CH_RPR3 = JJ ! only for PUN (for MPMPO it is not a SOA precursor) - -! SOA group 6 -IF (CNAMES(JJ) == "URG6") JP_CH_URG6 = JJ -IF (CNAMES(JJ) == "ARAC") JP_CH_ARAC = JJ -IF (CNAMES(JJ) == "UR22") JP_CH_UR22 = JJ ! only for PUN (for MPMPO it is not a SOA precursor) -IF (CNAMES(JJ) == "UR31") JP_CH_UR31 = JJ -IF (CNAMES(JJ) == "AP1") JP_CH_AP1 = JJ -IF (CNAMES(JJ) == "AP6") JP_CH_AP6 = JJ - -! SOA group 7 -IF (CNAMES(JJ) == "URG7") JP_CH_URG7 = JJ -IF (CNAMES(JJ) == "RPG7") JP_CH_RPG7 = JJ -IF (CNAMES(JJ) == "RPR7") JP_CH_RPR7 = JJ -IF (CNAMES(JJ) == "RPR4") JP_CH_RPR4 = JJ ! only for PUN (for MPMPO it is not a SOA precursor) -IF (CNAMES(JJ) == "RP14") JP_CH_RP14 = JJ ! only for PUN (for MPMPO it is not a SOA precursor) -IF (CNAMES(JJ) == "RP19") JP_CH_RP19 = JJ ! only for PUN (for MPMPO it is not a SOA precursor) -IF (CNAMES(JJ) == "ADAC") JP_CH_ADAC = JJ -IF (CNAMES(JJ) == "UR2") JP_CH_UR2 = JJ -IF (CNAMES(JJ) == "UR14") JP_CH_UR14 = JJ -IF (CNAMES(JJ) == "UR27") JP_CH_UR27 = JJ - -! SOA group 8 -IF (CNAMES(JJ) == "URG8") JP_CH_URG8 = JJ -IF (CNAMES(JJ) == "UR19") JP_CH_UR19 = JJ ! only for MPMPO (for PUN it is not a SOA precursor) -IF (CNAMES(JJ) == "UR11") JP_CH_UR11 = JJ -IF (CNAMES(JJ) == "UR15") JP_CH_UR15 = JJ -IF (CNAMES(JJ) == "AP10") JP_CH_AP10 = JJ - -! SOA group 9 -IF (CNAMES(JJ) == "URG9") JP_CH_URG9 = JJ -IF (CNAMES(JJ) == "UR20") JP_CH_UR20 = JJ -IF (CNAMES(JJ) == "UR34") JP_CH_UR34 = JJ -IF (CNAMES(JJ) == "AP11") JP_CH_AP11 = JJ -IF (CNAMES(JJ) == "AP12") JP_CH_AP12 = JJ -IF (CNAMES(JJ) == "UR26") JP_CH_UR26 = JJ - -! SOA group 10 -IF (CNAMES(JJ) == "URG10") JP_CH_URG10 = JJ -IF (CNAMES(JJ) == "PAN8") JP_CH_PAN8 = JJ ! only for PUN (for MPMPO it is not a SOA precursor) -IF (CNAMES(JJ) == "UR5") JP_CH_UR5 = JJ -IF (CNAMES(JJ) == "UR6") JP_CH_UR6 = JJ -IF (CNAMES(JJ) == "UR7") JP_CH_UR7 = JJ -IF (CNAMES(JJ) == "UR8") JP_CH_UR8 = JJ -IF (CNAMES(JJ) == "AP8") JP_CH_AP8 = JJ - + ! + ! for heterogeneous chemistry + ! + IF (CNAMES(JJ) == "O3") JP_CH_O3 = JJ + IF (CNAMES(JJ) == "SO2") JP_CH_SO2 = JJ + IF (CNAMES(JJ) == "SO42M") JP_CH_SO42M = JJ + IF (CNAMES(JJ) == "H2O2") JP_CH_H2O2 = JJ + ! + ! Inorganics + ! + IF (CNAMES(JJ) == "HNO3") JP_CH_HNO3 = JJ + IF (CNAMES(JJ) == "NH3") JP_CH_NH3 = JJ + IF ((CNAMES(JJ) == "H2SO4").OR.(CNAMES(JJ) == "SULF")) JP_CH_H2SO4 = JJ + ! + ! SOA group 1 + ! + IF (CNAMES(JJ) == "URG1") JP_CH_URG1 = JJ + IF (CNAMES(JJ) == "UR21") JP_CH_UR21 = JJ + IF (CNAMES(JJ) == "UR28") JP_CH_UR28 = JJ + ! + ! SOA group 2 + ! + IF (CNAMES(JJ) == "URG2") JP_CH_URG2 = JJ + IF (CNAMES(JJ) == "RPG2") JP_CH_RPG2 = JJ + IF (CNAMES(JJ) == "RP18") JP_CH_RP18 = JJ + IF (CNAMES(JJ) == "UR29") JP_CH_UR29 = JJ + IF (CNAMES(JJ) == "UR30") JP_CH_UR30 = JJ + IF (CNAMES(JJ) == "RP13") JP_CH_RP13 = JJ + IF (CNAMES(JJ) == "RP17") JP_CH_RP17 = JJ + ! + ! SOA group 3 + ! + IF (CNAMES(JJ) == "RPG3") JP_CH_RPG3 = JJ + IF (CNAMES(JJ) == "RPR9") JP_CH_RPR9 = JJ + IF (CNAMES(JJ) == "RP12") JP_CH_RP12 = JJ + ! + ! SOA group 4 + ! + IF (CNAMES(JJ) == "URG4") JP_CH_URG4 = JJ + IF (CNAMES(JJ) == "UR8") JP_CH_UR8 = JJ ! only for MPMPO (for PUN it is group 10) + IF (CNAMES(JJ) == "UR3") JP_CH_UR3 = JJ + IF (CNAMES(JJ) == "UR23") JP_CH_UR23 = JJ + ! + ! SOA group 5 + ! + IF (CNAMES(JJ) == "UR17") JP_CH_UR17 = JJ + IF (CNAMES(JJ) == "AP7") JP_CH_AP7 = JJ + IF (CNAMES(JJ) == "UR7") JP_CH_UR7 = JJ ! only for MPMPO (for PUN it is group 10) + IF (CNAMES(JJ) == "RPR3") JP_CH_RPR3 = JJ ! only for PUN (for MPMPO it is not a SOA precursor) + ! + ! SOA group 6 + ! + IF (CNAMES(JJ) == "URG6") JP_CH_URG6 = JJ + IF (CNAMES(JJ) == "ARAC") JP_CH_ARAC = JJ + IF (CNAMES(JJ) == "UR22") JP_CH_UR22 = JJ ! only for PUN (for MPMPO it is not a SOA precursor) + IF (CNAMES(JJ) == "UR31") JP_CH_UR31 = JJ + IF (CNAMES(JJ) == "AP1") JP_CH_AP1 = JJ + IF (CNAMES(JJ) == "AP6") JP_CH_AP6 = JJ + ! + ! SOA group 7 + ! + IF (CNAMES(JJ) == "URG7") JP_CH_URG7 = JJ + IF (CNAMES(JJ) == "RPG7") JP_CH_RPG7 = JJ + IF (CNAMES(JJ) == "RPR7") JP_CH_RPR7 = JJ + IF (CNAMES(JJ) == "RPR4") JP_CH_RPR4 = JJ ! only for PUN (for MPMPO it is not a SOA precursor) + IF (CNAMES(JJ) == "RP14") JP_CH_RP14 = JJ ! only for PUN (for MPMPO it is not a SOA precursor) + IF (CNAMES(JJ) == "RP19") JP_CH_RP19 = JJ ! only for PUN (for MPMPO it is not a SOA precursor) + IF (CNAMES(JJ) == "ADAC") JP_CH_ADAC = JJ + IF (CNAMES(JJ) == "UR2") JP_CH_UR2 = JJ + IF (CNAMES(JJ) == "UR14") JP_CH_UR14 = JJ + IF (CNAMES(JJ) == "UR27") JP_CH_UR27 = JJ + ! + ! SOA group 8 + ! + IF (CNAMES(JJ) == "URG8") JP_CH_URG8 = JJ + IF (CNAMES(JJ) == "UR19") JP_CH_UR19 = JJ ! only for MPMPO (for PUN it is not a SOA precursor) + IF (CNAMES(JJ) == "UR11") JP_CH_UR11 = JJ + IF (CNAMES(JJ) == "UR15") JP_CH_UR15 = JJ + IF (CNAMES(JJ) == "AP10") JP_CH_AP10 = JJ + ! + ! SOA group 9 + ! + IF (CNAMES(JJ) == "URG9") JP_CH_URG9 = JJ + IF (CNAMES(JJ) == "UR20") JP_CH_UR20 = JJ + IF (CNAMES(JJ) == "UR34") JP_CH_UR34 = JJ + IF (CNAMES(JJ) == "AP11") JP_CH_AP11 = JJ + IF (CNAMES(JJ) == "AP12") JP_CH_AP12 = JJ + IF (CNAMES(JJ) == "UR26") JP_CH_UR26 = JJ + ! + ! SOA group 10 + ! + IF (CNAMES(JJ) == "URG10") JP_CH_URG10 = JJ + IF (CNAMES(JJ) == "PAN8") JP_CH_PAN8 = JJ ! only for PUN (for MPMPO it is not a SOA precursor) + IF (CNAMES(JJ) == "UR5") JP_CH_UR5 = JJ + IF (CNAMES(JJ) == "UR6") JP_CH_UR6 = JJ + IF (CNAMES(JJ) == "UR7") JP_CH_UR7 = JJ + IF (CNAMES(JJ) == "UR8") JP_CH_UR8 = JJ + IF (CNAMES(JJ) == "AP8") JP_CH_AP8 = JJ + ! END DO ! -! !* 0.4 initialization aerosol solveur -CALL CH_AER_TRANS(0, PM, PSIG0, PRG0, PN0, PRHOP0, PAERO,& +! +CALL CH_AER_TRANS(0, PM, PSIG0, PRG0, PN0, PRHOP0, PAERO, & PCHEM, PCTOTG, PCTOTA, PCCTOT, PFRAC, PMI, ZMASK, GSCHEME ) - -CALL CH_AER_SOLV(PM,PSIG0, PRG0, PN0, PCTOTG, PCTOTA, PCCTOT, & - ZDMINTRA,ZDMINTER,ZDMCOND,PSEDA,0.,POM,& - PRV, PDENAIR, PPRESSURE, PTEMP, PRC, 0., ZSOLORG) - -CALL CH_AER_TRANS(1, PM, PSIG0, PRG0, PN0, PRHOP0, PAERO,& - PCHEM, PCTOTG, PCTOTA, PCCTOT, PFRAC, PMI, ZMASK, GSCHEME) - ! -RETURN +CALL CH_AER_SOLV(PM,PSIG0, PRG0, PN0, PCTOTG, PCTOTA, PCCTOT, & + ZDMINTRA,ZDMINTER,ZDMCOND,ZDMNUCL,ZDMMERG,PSEDA,0., & + PRV, PDENAIR, PPRESSURE, PTEMP, PRC, 0., ZSOLORG, & + ZMBEG,ZMINT,ZMEND ) +! +CALL CH_AER_TRANS(1, PM, PSIG0, PRG0, PN0, PRHOP0, PAERO, & + PCHEM, PCTOTG, PCTOTA, PCCTOT, PFRAC, PMI, ZMASK, GSCHEME) ! END SUBROUTINE CH_INI_ORILAM diff --git a/src/MNH/ch_init_fieldn.f90 b/src/MNH/ch_init_fieldn.f90 index e71d31f36..4c9853b05 100644 --- a/src/MNH/ch_init_fieldn.f90 +++ b/src/MNH/ch_init_fieldn.f90 @@ -71,6 +71,7 @@ END MODULE MODI_CH_INIT_FIELD_n !! 04/06/07 (M. Leriche & JP Pinty) add pH initialization !! 20/04/10 (M. Leriche) remove pH initialization to ini_modeln ! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine +! P. Tulet 20/05/2021: correction for CON to MIX transformation unit (aerosols only) !! !! EXTERNAL !! -------- @@ -83,6 +84,7 @@ USE MODI_CH_FIELD_VALUE_n ! returns value of chemical species at each grid point USE MODI_CH_INIT_CONST_n USE MODI_CH_AER_EQM_INIT_n USE MODE_ll +USE MODE_AERO_PSD !! !! IMPLICIT ARGUMENTS !! ------------------ @@ -232,6 +234,40 @@ IF (LORILAM) THEN IF (.NOT.(ASSOCIATED(XMI))) THEN ALLOCATE(XMI(SIZE(XSVT,1),SIZE(XSVT,2),IKU,NSP+NCARB+NSOA)) END IF + IF (.NOT.(ASSOCIATED(XJNUC))) ALLOCATE(XJNUC(SIZE(XSVT,1),SIZE(XSVT,2),IKU)) + IF (.NOT.(ASSOCIATED(XJ2RAT))) ALLOCATE(XJ2RAT(SIZE(XSVT,1),SIZE(XSVT,2),IKU)) + IF (.NOT.(ASSOCIATED(XCONC_MASS))) ALLOCATE(XCONC_MASS(SIZE(XSVT,1),SIZE(XSVT,2),IKU)) + IF (.NOT.(ASSOCIATED(XCOND_MASS_I))) ALLOCATE(XCOND_MASS_I(SIZE(XSVT,1),SIZE(XSVT,2),IKU)) + IF (.NOT.(ASSOCIATED(XCOND_MASS_J))) ALLOCATE(XCOND_MASS_J(SIZE(XSVT,1),SIZE(XSVT,2),IKU)) + IF (.NOT.(ASSOCIATED(XNUCL_MASS))) ALLOCATE(XNUCL_MASS(SIZE(XSVT,1),SIZE(XSVT,2),IKU)) + + IF (.NOT.(ASSOCIATED(XMBEG))) ALLOCATE(XMBEG(SIZE(XSVT,1),SIZE(XSVT,2),IKU,JPIN)) + IF (.NOT.(ASSOCIATED(XMINT))) ALLOCATE(XMINT(SIZE(XSVT,1),SIZE(XSVT,2),IKU,JPIN)) + IF (.NOT.(ASSOCIATED(XMEND))) ALLOCATE(XMEND(SIZE(XSVT,1),SIZE(XSVT,2),IKU,JPIN)) + + IF (.NOT.(ASSOCIATED(XDMINTRA))) ALLOCATE(XDMINTRA(SIZE(XSVT,1),SIZE(XSVT,2),IKU,JPIN)) + IF (.NOT.(ASSOCIATED(XDMINTER))) ALLOCATE(XDMINTER(SIZE(XSVT,1),SIZE(XSVT,2),IKU,JPIN)) + IF (.NOT.(ASSOCIATED(XDMCOND))) ALLOCATE(XDMCOND(SIZE(XSVT,1),SIZE(XSVT,2),IKU,JPIN)) + IF (.NOT.(ASSOCIATED(XDMNUCL))) ALLOCATE(XDMNUCL(SIZE(XSVT,1),SIZE(XSVT,2),IKU,JPIN)) + IF (.NOT.(ASSOCIATED(XDMMERG))) ALLOCATE(XDMMERG(SIZE(XSVT,1),SIZE(XSVT,2),IKU,JPIN)) + ! + XJNUC(:,:,:) = 1.0E-7 + XJ2RAT(:,:,:) = 0. + XCONC_MASS(:,:,:) = 0. + XCOND_MASS_I(:,:,:) = 0. + XCOND_MASS_J(:,:,:) = 0. + XNUCL_MASS(:,:,:) = 0. + ! + XMBEG(:,:,:,:) = 0. + XMINT(:,:,:,:) = 0. + XMEND(:,:,:,:) = 0. + ! + XDMINTRA(:,:,:,:) = 0. + XDMINTER(:,:,:,:) = 0. + XDMCOND(:,:,:,:) = 0. + XDMNUCL(:,:,:,:) = 0. + XDMMERG(:,:,:,:) = 0. + END IF ! !* print info for user @@ -268,6 +304,12 @@ IF ((LCH_INIT_FIELD).AND.(CPROGRAM/='DIAG ')) THEN DO JK=1,JPVEXT XSVT(:,:,IKB-JPVEXT,JN) = XSVT(:,:,IKB,JN) XSVT(:,:,IKE+JPVEXT,JN) = XSVT(:,:,IKE,JN) + + XSVT(IIB-JPHEXT,:,:,JN) = XSVT(IIB,:,:,JN) + XSVT(IIU,:,:,JN) = XSVT(IIU-JPHEXT,:,:,JN) + + XSVT(:,IJB-JPHEXT,:,JN) = XSVT(:,IJB,:,JN) + XSVT(:,IJU,:,JN) = XSVT(:,IJU-JPHEXT,:,JN) END DO END DO ! @@ -310,17 +352,22 @@ IF ((LCH_INIT_FIELD).AND.(CPROGRAM/='DIAG ')) THEN DO JK=1,JPVEXT XSVT(:,:,IKB-JPVEXT,JN) = XSVT(:,:,IKB,JN) XSVT(:,:,IKE+JPVEXT,JN) = XSVT(:,:,IKE,JN) + + XSVT(IIB-JPHEXT,:,:,JN) = XSVT(IIB,:,:,JN) + XSVT(IIU,:,:,JN) = XSVT(IIU-JPHEXT,:,:,JN) + + XSVT(:,IJB-JPHEXT,:,JN) = XSVT(:,IJB,:,JN) + XSVT(:,IJU,:,JN) = XSVT(:,IJU-JPHEXT,:,JN) END DO END DO ! IF (YUNIT .EQ. "CON") THEN - WRITE(KLUOUT,*) "CH_INIT_FIELD_n (ORILAM): converting initial values to mixing ratio" - DO JN = NSV_AERBEG,NSV_AEREND - XSVT(:,:,:,JN) = XSVT(:,:,:,JN)/(XRHODREF(:,:,:)*ZDEN2MOL) - ENDDO + WRITE(KLUOUT,*) "CH_INIT_FIELD_n (ORILAM): converting initial values µg/m3 to mixing ratio" + CALL CON2MIX (XSVT(:,:,:,NSV_AERBEG:NSV_AEREND), XRHODREF) ELSE WRITE(KLUOUT,*)"CH_INIT_FIELD_n (ORILAM): initial values are used as is (mixing ratio)" ENDIF + ! ENDIF !LORILAM ! diff --git a/src/MNH/ch_monitorn.f90 b/src/MNH/ch_monitorn.f90 index eee756dfb..be5f6033e 100644 --- a/src/MNH/ch_monitorn.f90 +++ b/src/MNH/ch_monitorn.f90 @@ -1,23 +1,22 @@ -!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier !MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt +!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt !MNH_LIC for details. version 1. -!----------------------------------------------------------------- !! ######################## MODULE MODI_CH_MONITOR_n !! ######################## !! -! +!! INTERFACE !! SUBROUTINE CH_MONITOR_n(PWETDEPAER, KTCOUNT,PTSTEP, KLUOUT, KVERB) IMPLICIT NONE -REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PWETDEPAER ! tendency of aerosol wet depostion -INTEGER, INTENT(IN) :: KTCOUNT ! iteration count -REAL, INTENT(IN) :: PTSTEP ! Double timestep except - ! for the first time step (single one) -INTEGER, INTENT(IN) :: KLUOUT ! unit for output listing count -INTEGER, INTENT(IN) :: KVERB ! verbosity level +REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PWETDEPAER ! tendency of aerosol wet depostion +INTEGER, INTENT(IN) :: KTCOUNT ! iteration count +REAL, INTENT(IN) :: PTSTEP ! Double timestep except + ! for the first time step (single one) +INTEGER, INTENT(IN) :: KLUOUT ! unit for output listing count +INTEGER, INTENT(IN) :: KVERB ! verbosity level END SUBROUTINE CH_MONITOR_n !! END INTERFACE @@ -28,8 +27,6 @@ END MODULE MODI_CH_MONITOR_n SUBROUTINE CH_MONITOR_n(PWETDEPAER, KTCOUNT,PTSTEP, KLUOUT, KVERB) !! ####################################################### !! -!!*** *CH_MONITOR_n* monitor of the chemical module -!! !! PURPOSE !! ------- !! The purpose of this subroutine is to control the chemical module @@ -111,9 +108,7 @@ END MODULE MODI_CH_MONITOR_n !! 11/12/15 (M. Leriche & P. Tulet) add ch_init_ice initialise index for ice chem. !! 18/01/16 (M Leriche) for sedimentation fusion C2R2 and khko !! 15/02/16 (M Leriche) call ch_init_rosenbrock only one time -!! 20/01/17 (G.Delautier) bug if CPROGRAM/=DIAG !! 01/10/17 (C.Lac) add correction of negativity -!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O ! P. Wautelet 12/02/2019: bugfix: ZINPRR was not initialized all the time ! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg ! P. Wautelet 02/2020: use the new data structures and subroutines for budgets @@ -122,10 +117,12 @@ END MODULE MODI_CH_MONITOR_n !! -------- USE MODI_CH_METEO_TRANS_KESS USE MODI_CH_METEO_TRANS_C2R2 +USE MODI_CH_METEO_TRANS_LIMA USE MODI_CH_SET_RATES USE MODI_CH_SET_PHOTO_RATES USE MODI_CH_SOLVER_n USE MODI_CH_UPDATE_JVALUES +use modd_budget, only: lbudget_sv, NBUDGET_SV1, tbudgets USE MODI_CH_INIT_ICE USE MODI_CH_AQUEOUS_TMICICE USE MODI_CH_AQUEOUS_TMICKESS @@ -161,7 +158,7 @@ USE MODD_NSV, ONLY : NSV_CHEMBEG,NSV_CHEMEND,NSV_CHEM,& ! index for chemical SV NSV_CHACBEG,NSV_CHACEND,NSV_CHAC,& ! index for aqueous SV NSV_CHGSBEG,NSV_CHGSEND, & ! index for gas phase SV NSV_CHICBEG,NSV_CHICEND, & ! index for ice phase SV - NSV_C2R2BEG, & ! index for number concentration + NSV_C2R2BEG,NSV_LIMA_NC,NSV_LIMA_NR, & ! index for number concentration NSV_AERBEG, NSV_AEREND, NSV_AER, & ! index for aerosols SV XSVMIN ! @@ -218,7 +215,7 @@ USE MODD_TIME, ONLY: TDTEXP ! USE MODD_TIME_n, ONLY: TDTCUR ! Current Time and Date ! -USE MODD_CONF, ONLY: CPROGRAM, L1D +USE MODD_CONF, ONLY: CPROGRAM, L1D, NVERB USE MODD_PARAM_n, ONLY: CCLOUD ! USE MODD_PARAMETERS,ONLY: JPHEXT, &! number of horizontal External points @@ -294,17 +291,17 @@ IMPLICIT NONE ! !* 0.1 declarations of arguments ! -REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PWETDEPAER ! tendency of aerosol wet depostion -INTEGER, INTENT(IN) :: KTCOUNT ! iteration count -REAL, INTENT(IN) :: PTSTEP ! Double timestep except - ! for the first time step (single one) -INTEGER, INTENT(IN) :: KLUOUT ! unit for output listing count -INTEGER, INTENT(IN) :: KVERB ! verbosity level +REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PWETDEPAER ! tendency of aerosol wet depostion +INTEGER, INTENT(IN) :: KTCOUNT ! iteration count +REAL, INTENT(IN) :: PTSTEP ! Double timestep except + ! for the first time step (single one) +INTEGER, INTENT(IN) :: KLUOUT ! unit for output listing count +INTEGER, INTENT(IN) :: KVERB ! verbosity level ! !* 0.2 declarations of local variables ! INTEGER :: JI,JJ,JK,JL,JM,JN ! loop counters -REAL :: ZDTSOLVER ! timestep for the solver +REAL :: ZDTSOLVER ! timestep for the solver ! REAL, DIMENSION(:,:), ALLOCATABLE :: ZCHEM, ZOLDCHEM, ZNEWCHEM REAL, DIMENSION(:,:), ALLOCATABLE :: ZAERO, ZOLDAERO, ZNEWAERO @@ -380,18 +377,22 @@ INTEGER :: IMI ! model index !------------------------------------------------------------------------------- ! variables for the aerosol module ! -REAL :: ZTIME ! current time -REAL, ALLOCATABLE, DIMENSION(:,:) :: ZM, ZSIG0, ZN0, ZRG0, & ! work array - ZCTOTG, ZSEDA, ZFRAC, ZMI ! for aerosols +REAL :: ZTIME ! current time +REAL, ALLOCATABLE, DIMENSION(:,:) :: ZM, ZLNSIG, ZN, ZRG, & ! work array + ZCTOTG, ZSEDA, ZFRAC, ZMI, & ! for aerosols + ZMBEG,ZMINT,ZMEND,& + ZDMINTRA,ZDMINTER,ZDMCOND,ZDMNUCL,ZDMMERG REAL, ALLOCATABLE, DIMENSION(:,:,:) :: ZCTOTA, ZCCTOT ! first dimension is vectorization, ! second dim. are the modes*moments +REAL, ALLOCATABLE, DIMENSION(:) :: ZCONC_MASS,ZCOND_MASS_I,ZCOND_MASS_J,ZNUCL_MASS REAL, DIMENSION(:), ALLOCATABLE :: ZRV, ZDENAIR, ZPRESSURE, ZTEMP, ZRC -REAL, DIMENSION(:,:), ALLOCATABLE :: ZRHOP0, ZOM, ZSOLORG -REAL, DIMENSION(:), ALLOCATABLE :: ZLAMBDA, ZMU, ZSO4RAT +REAL, DIMENSION(:,:), ALLOCATABLE :: ZRHOP, ZSOLORG +REAL, DIMENSION(:), ALLOCATABLE :: ZSO4RAT +REAL, DIMENSION(:), ALLOCATABLE :: ZJNUC, ZJ2RAT -REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZSVT -REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZCWETAERO +REAL,DIMENSION(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),SIZE(XSVT,4)) :: ZSVT +REAL,DIMENSION(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),NSV_AER) :: ZCWETAERO ! !------------------------------------------------------------------------------- ! variables for AQueous/NAQueous cases @@ -405,13 +406,16 @@ REAL, DIMENSION(SIZE(XRT,1), SIZE(XRT,2)) :: ZINPRR! Rain instant precip ! ! get model index IMI = GET_CURRENT_MODEL_INDEX() - +! if ( lbudget_sv ) then do jsv = nsv_chembeg, nsv_chemend call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jsv), 'CHEM', xrsvs(:, :, :, jsv) ) enddo + do jsv = nsv_aerbeg, nsv_aerend + call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jsv), 'AER', xrsvs(:, :, :, jsv) ) + enddo endif -! + !* 1. PREPARE MONITOR ! --------------- ! @@ -608,15 +612,15 @@ ZDTSOLVER = PTSTEP / NCH_SUBSTEPS ! ! IF (LORILAM) THEN - ALLOCATE( ZSVT(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),SIZE(XSVT,4)) ) - IF (CPROGRAM /='DIAG ') THEN - DO JSV = 1, SIZE(XSVT,4) - ZSVT(:,:,:,JSV) = XRSVS(:,:,:,JSV) *PTSTEP / XRHODJ(:,:,:) - END DO + + IF (CPROGRAM/='DIAG ') THEN + DO JSV = 1, SIZE(XSVT,4) + ZSVT(:,:,:,JSV) = XRSVS(:,:,:,JSV) *PTSTEP / XRHODJ(:,:,:) + END DO ELSE - DO JSV = 1, SIZE(XSVT,4) - ZSVT(:,:,:,JSV) = XSVT(:,:,:,JSV) - END DO + DO JSV = 1, SIZE(XSVT,4) + ZSVT(:,:,:,JSV) = XSVT(:,:,:,JSV) + END DO END IF ZSVT(:,:,:,NSV_CHEMBEG:NSV_CHEMEND) = MAX(ZSVT(:,:,:,NSV_CHEMBEG:NSV_CHEMEND), XMNH_TINY) ZSVT(:,:,:,NSV_AERBEG:NSV_AEREND) = MAX(ZSVT(:,:,:,NSV_AERBEG:NSV_AEREND), XMNH_TINY) @@ -641,10 +645,13 @@ SELECT CASE (CCH_TDISCRETIZATION) IF (KVERB >= 10) WRITE(KLUOUT,*) "CH_MONITOR_n: using LAGGED option" CASE DEFAULT ! the following line should never be reached: - call Print_msg( NVERB_FATAL, 'GEN', 'CH_MONITOR_n', 'invalid CCH_TDISCRETIZATION option ('//trim(CCH_TDISCRETIZATION)//')' ) + ! callabortstop + CALL ABORT + STOP "CH_MONITOR_n: CCH_TDISCRETIZATION option not valid" END SELECT ! ! +IF (LEN_TRIM(CSPEC_BU_DIAG)/=0.OR.LEN_TRIM(CSPEC_DIAG)/=0) GSPLIT=.FALSE. ! Modif. for DIAG IF (CPROGRAM=='DIAG ') GSPLIT=.FALSE. ! Modif. for DIAG ! ! @@ -680,16 +687,21 @@ IF (LORILAM) THEN ALLOCATE(ZOLDAERO(ISVECNPT,NSV_AER)) ALLOCATE(ZM(ISVECNPT,JPIN)) ALLOCATE(ZSEDA(ISVECNPT,JPIN)) - ALLOCATE(ZRHOP0(ISVECNPT,JPMODE)) - ALLOCATE(ZSIG0(ISVECNPT,JPMODE)) - ALLOCATE(ZRG0(ISVECNPT,JPMODE)) - ALLOCATE(ZN0(ISVECNPT,JPMODE)) + ALLOCATE(ZMBEG(ISVECNPT,JPIN)) + ALLOCATE(ZMINT(ISVECNPT,JPIN)) + ALLOCATE(ZMEND(ISVECNPT,JPIN)) + ALLOCATE(ZDMINTRA(ISVECNPT,JPIN)) + ALLOCATE(ZDMINTER(ISVECNPT,JPIN)) + ALLOCATE(ZDMCOND(ISVECNPT,JPIN)) + ALLOCATE(ZDMNUCL(ISVECNPT,JPIN)) + ALLOCATE(ZDMMERG(ISVECNPT,JPIN)) + ALLOCATE(ZRHOP(ISVECNPT,JPMODE)) + ALLOCATE(ZLNSIG(ISVECNPT,JPMODE)) + ALLOCATE(ZRG(ISVECNPT,JPMODE)) + ALLOCATE(ZN(ISVECNPT,JPMODE)) ALLOCATE(ZCTOTA(ISVECNPT,NSP+NCARB+NSOA,JPMODE)) ALLOCATE(ZCCTOT(ISVECNPT,NSP+NCARB+NSOA,JPMODE)) ALLOCATE(ZCTOTG(ISVECNPT,NSP+NCARB+NSOA)) - ALLOCATE(ZMU(ISVECNPT)) - ALLOCATE(ZLAMBDA(ISVECNPT)) - ALLOCATE(ZOM(ISVECNPT,JPMODE)) ALLOCATE(ZSO4RAT(ISVECNPT)) ALLOCATE(ZRV(ISVECNPT)) ALLOCATE(ZRC(ISVECNPT)) @@ -701,6 +713,12 @@ IF (LORILAM) THEN ALLOCATE(ZSOLORG(ISVECNPT,NSOA)) ALLOCATE(XSURF(ISVECNPT,JPMODE)) ALLOCATE(XDP(ISVECNPT,JPMODE)) + ALLOCATE(ZJNUC(ISVECNPT)) + ALLOCATE(ZJ2RAT(ISVECNPT)) + ALLOCATE(ZCONC_MASS(ISVECNPT)) + ALLOCATE(ZCOND_MASS_I(ISVECNPT)) + ALLOCATE(ZCOND_MASS_J(ISVECNPT)) + ALLOCATE(ZNUCL_MASS(ISVECNPT)) END IF ! !------------------------------------------------------------------------------- @@ -716,6 +734,11 @@ IF (KTCOUNT==1 .OR. & IF (.NOT.ASSOCIATED(XJVALUES)) & ALLOCATE(XJVALUES(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPJVMAX)) XJVALUES(:,:,:,:) = 0. + + IF (NVERB .GE. 20) THEN + WRITE(*,*) 'min max XALBUV =', MINVAL(XALBUV), MAXVAL(XALBUV) + ENDIF + CALL CH_UPDATE_JVALUES(KLUOUT, XZENITH, XRT, & XALBUV, XZS, XZZ, XLAT0, XLON0, & SIZE(XZZ,1), SIZE(XZZ,2), SIZE(XZZ,3), NRR, & @@ -735,10 +758,20 @@ ISTCOUNT = ISTCOUNT + 1 !* 3.1 sedimentation term and wet deposition for aerosols tendency (XSEDA) ! IF (LORILAM) THEN - ZTIME = TDTCUR%xtime ! need for ch_orilam - XSEDA(:,:,:,:) = 0. - ZSEDA(:,:) = 0. -! dry sedimentation + ZTIME = TDTCUR%xtime ! need for ch_orilam + XSEDA(:,:,:,:) = 0.0 + ZSEDA(:,:) = 0.0 + ZMBEG(:,:) = 0.0 + ZMINT(:,:) = 0.0 + ZMEND(:,:) = 0.0 + ZDMINTRA(:,:) = 0.0 + ZDMINTER(:,:) = 0.0 + ZDMCOND(:,:) = 0.0 + ZDMNUCL(:,:) = 0.0 + ZDMMERG(:,:) = 0.0 + ! + ! dry sedimentation + ! IF ((LSEDIMAERO).AND.(CPROGRAM/='DIAG ')) THEN CALL CH_AER_SEDIM_n(PTSTEP, & ZSVT(IIB:IIE,IJB:IJE,IKB:IKE,NSV_AERBEG:NSV_AEREND), & @@ -748,7 +781,6 @@ IF (LORILAM) THEN ENDIF ! implicit wet deposition IF ((LCH_CONV_SCAV).AND.(CPROGRAM/='DIAG ')) THEN - ALLOCATE( ZCWETAERO(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),NSV_AER) ) DO JN=1,NSV_AER ZCWETAERO(:,:,:,JN) = (XRSVS(:,:,:,JN+NSV_AERBEG-1)+PWETDEPAER(:,:,:,JN))*PTSTEP / XRHODJ(:,:,:) END DO @@ -757,7 +789,6 @@ IF (LORILAM) THEN CALL CH_AER_WETDEP_n(PTSTEP, ZSVT(IIB:IIE,IJB:IJE,IKB:IKE,NSV_AERBEG:NSV_AEREND), & ZCWETAERO(IIB:IIE,IJB:IJE,IKB:IKE,:), XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), & XSEDA(IIB:IIE,IJB:IJE,IKB:IKE,:)) - DEALLOCATE( ZCWETAERO ) ENDIF ! explicit wet deposition IF ((LDEPOS_AER(IMI)).AND.(CPROGRAM/='DIAG ')) THEN @@ -779,8 +810,6 @@ IF (LORILAM) THEN DO JSV = 1, SIZE(XSVT,4) XRSVS(:,:,:,JSV) = ZSVT(:,:,:,JSV) * XRHODJ(:,:,:) / PTSTEP END DO - - DEALLOCATE( ZSVT ) ENDIF ! !* 3.2 check where aqueous concentration>0 + micropÄ¥ysics term @@ -861,9 +890,8 @@ IF (LUSECHAQ.AND.(NRRL>=2) ) THEN XSVT(:,:,:,NSV_CHACBEG+NEQAQ/2:NSV_CHACEND), & XRSVS(:,:,:,NSV_CHACBEG+NEQAQ/2:NSV_CHACEND),& ZINPRR(:,:) ) + END SELECT - ELSE - ZINPRR(:,:) = 0. END IF ELSE IF (LUSECHAQ.AND.(NRRL==1) ) THEN CALL CH_AQUEOUS_CHECK (PTSTEP, XRHODREF, XRHODJ, XRRS, XRSVS, NRRL, & @@ -891,6 +919,12 @@ DO JL=1,ISVECNMASK IF (LORILAM) THEN ZRV(:) = 0. ZRC(:) = 0. + ZJNUC(:) = 0. + ZJ2RAT(:) = 0. + ZCONC_MASS = 0. + ZCOND_MASS_I = 0. + ZCOND_MASS_J = 0. + ZNUCL_MASS = 0. !ocl novrec !cdir nodep DO JM=0,ISVECNPT-1 @@ -912,9 +946,9 @@ DO JL=1,ISVECNMASK ZMI(JM+1,:) = XMI(JI, JJ, JK, :) !Moments (ppp) ZM(JM+1,:) = XM3D(JI,JJ,JK,:) - ZSIG0(JM+1,:) = LOG(XSIG3D(JI,JJ,JK,:)) - ZRG0(JM+1,:) = XRG3D(JI,JJ,JK,:) - ZN0(JM+1,:) = XN3D(JI,JJ,JK,:) + ZLNSIG(JM+1,:) = LOG(XSIG3D(JI,JJ,JK,:)) + ZRG(JM+1,:) = XRG3D(JI,JJ,JK,:) + ZN(JM+1,:) = XN3D(JI,JJ,JK,:) IF (NSOA > 0) ZSOLORG(JM+1,:) = XSOLORG(JI,JJ,JK,:) ENDDO DO JN = 1, NSV_AER @@ -937,8 +971,8 @@ DO JL=1,ISVECNMASK ! !* initialize aerosol surface and aerosol diameter ! - CALL CH_AER_SURF(ZM, ZRG0, ZSIG0, XSURF) ! Compute aerosol surface (m2/cc) - XDP(:,:) = 2.E-6 * ZRG0(:,:) ! Mean diameter in meter + CALL CH_AER_SURF(ZM, ZRG, ZLNSIG, XSURF) ! Compute aerosol surface (m2/cc) + XDP(:,:) = 2.E-6 * ZRG(:,:) ! Mean diameter in meter END IF ! ! @@ -1024,6 +1058,20 @@ DO JL=1,ISVECNMASK TDTCUR%nyear, XLAT,XLON, XLAT0, XLON0, LUSERV, & LUSERC, LUSERR, KLUOUT, CCLOUD ) ENDIF + CASE ('LIMA') !add cloud and rain C. for mean radius + IF (GSPLIT) THEN ! LWC and LWR computed from tendencies + CALL CH_METEO_TRANS_LIMA(JL, XRHODJ, XRHODREF, XRRS, XRSVS(:,:,:,NSV_LIMA_NC), & + XRSVS(:,:,:,NSV_LIMA_NR), XTHT, XPABST, ISVECNPT, & + ISVECMASK, TZM, TDTCUR%nday, TDTCUR%nmonth, & + TDTCUR%nyear, XLAT,XLON, XLAT0, XLON0, LUSERV, & + LUSERC, LUSERR, KLUOUT, CCLOUD, PTSTEP ) + ELSE + CALL CH_METEO_TRANS_LIMA(JL, XRHODJ, XRHODREF, XRT, XSVT(:,:,:,NSV_LIMA_NC), & + XSVT(:,:,:,NSV_LIMA_NR), XTHT, XPABST, ISVECNPT, & + ISVECMASK, TZM, TDTCUR%nday, TDTCUR%nmonth, & + TDTCUR%nyear, XLAT,XLON, XLAT0, XLON0, LUSERV, & + LUSERC, LUSERR, KLUOUT, CCLOUD ) + ENDIF END SELECT ! !* 4.3 calculate reaction and photolysis rates and current pH value @@ -1061,8 +1109,8 @@ DO JL=1,ISVECNMASK ! IF (LORILAM) THEN IF (KTCOUNT == 1) THEN - CALL CH_INI_ORILAM(ZM, ZSIG0, ZRG0, ZN0, ZCTOTG, ZCTOTA, ZCCTOT, & - ZSEDA, ZOM, ZRHOP0, ZAERO, ZCHEM, ZRV, ZDENAIR, & + CALL CH_INI_ORILAM(ZM, ZLNSIG, ZRG, ZN, ZCTOTG, ZCTOTA, ZCCTOT, & + ZSEDA, ZRHOP, ZAERO, ZCHEM, ZRV, ZDENAIR, & ZPRESSURE, ZTEMP, ZRC, ZFRAC, ZMI,CCH_SCHEME) END IF ! transfer non-volatile species from aerosol to gas-phase variables @@ -1089,13 +1137,16 @@ DO JL=1,ISVECNMASK !* 4.6 solve aerosol system ! IF (LORILAM) THEN - ZSO4RAT(:) = (ZNEWCHEM(:,JP_CH_H2SO4)-ZOLDCHEM(:,JP_CH_H2SO4)) / PTSTEP + !ZSO4RAT(:) = (ZNEWCHEM(:,JP_CH_H2SO4)-ZOLDCHEM(:,JP_CH_H2SO4)) / PTSTEP + ZSO4RAT(:) = (ZNEWCHEM(:,JP_CH_H2SO4)) / PTSTEP ZOLDAERO(:,:) = ZAERO(:,:) - CALL CH_ORILAM(ZAERO,ZNEWCHEM, ZM, ZSIG0, ZRG0, ZN0, ZCTOTG, & + CALL CH_ORILAM(ZAERO,ZNEWCHEM, ZM, ZLNSIG, ZRG, ZN, ZCTOTG, & ZCTOTA, ZCCTOT, PTSTEP, ZSEDA, & - ZMU, ZLAMBDA, ZRHOP0, ZOM, ZSO4RAT, & + ZRHOP, ZSO4RAT, & ZRV, ZDENAIR,ZPRESSURE, ZTEMP, ZRC, ZFRAC, ZMI, & - ZTIME,CCH_SCHEME,ZSOLORG ) + ZTIME,CCH_SCHEME,ZSOLORG, ZJNUC, ZJ2RAT, ZMBEG,ZMINT,ZMEND,& + ZDMINTRA,ZDMINTER,ZDMCOND,ZDMNUCL,ZDMMERG,& + ZCONC_MASS,ZCOND_MASS_I,ZCOND_MASS_J,ZNUCL_MASS) ZNEWAERO(:,:) = ZAERO(:,:) ! !* 4.7 return results to MesoNH scalar variables - aerosols @@ -1108,14 +1159,29 @@ DO JL=1,ISVECNMASK JJ=JM/IDTI-IDTJ*(JM/(IDTI*IDTJ))+ISVECMASK(3,JL) JK=JM/(IDTI*IDTJ)-IDTK*(JM/(IDTI*IDTJ*IDTK))+ISVECMASK(5,JL) ! - XSIG3D(JI,JJ,JK,:) = EXP(ZSIG0(JM+1,:)) - XRG3D(JI,JJ,JK,:) = ZRG0(JM+1,:) - XN3D(JI,JJ,JK,:) = ZN0(JM+1,:) - XRHOP3D(JI,JJ,JK,:) = ZRHOP0(JM+1,:) + XSIG3D(JI,JJ,JK,:) = EXP(ZLNSIG(JM+1,:)) + XRG3D(JI,JJ,JK,:) = ZRG(JM+1,:) + XN3D(JI,JJ,JK,:) = ZN(JM+1,:) + XRHOP3D(JI,JJ,JK,:) = ZRHOP(JM+1,:) XCTOTA3D(JI,JJ,JK,:,:) = ZCTOTA(JM+1,:,:) XM3D(JI,JJ,JK,:) = ZM(JM+1,:) XFRAC(JI,JJ,JK,:) = ZFRAC(JM+1,:) XMI(JI,JJ,JK,:) = ZMI(JM+1,:) + ! + XJNUC(JI,JJ,JK) = ZJNUC(JM+1) + XJ2RAT(JI,JJ,JK) = ZJ2RAT(JM+1) + XCONC_MASS(JI,JJ,JK) = ZCONC_MASS(JM+1) + XCOND_MASS_I(JI,JJ,JK) = ZCOND_MASS_I(JM+1) + XCOND_MASS_J(JI,JJ,JK) = ZCOND_MASS_J(JM+1) + XNUCL_MASS(JI,JJ,JK) = ZNUCL_MASS(JM+1) + XMBEG(JI,JJ,JK,:) = ZMBEG(JM+1,:) + XMINT(JI,JJ,JK,:) = ZMINT(JM+1,:) + XMEND(JI,JJ,JK,:) = ZMEND(JM+1,:) + XDMINTRA(JI,JJ,JK,:) = ZDMINTRA(JM+1,:) + XDMINTER(JI,JJ,JK,:) = ZDMINTER(JM+1,:) + XDMCOND(JI,JJ,JK,:) = ZDMCOND(JM+1,:) + XDMNUCL(JI,JJ,JK,:) = ZDMNUCL(JM+1,:) + XDMMERG(JI,JJ,JK,:) = ZDMMERG(JM+1,:) END DO DO JN = 1, NSV_AER !Vectorization: @@ -1295,8 +1361,12 @@ if ( lbudget_sv ) then do jsv = nsv_chembeg, nsv_chemend call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jsv), 'CHEM', xrsvs(:, :, :, jsv) ) enddo + do jsv = nsv_aerbeg, nsv_aerend + call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jsv), 'AER', xrsvs(:, :, :, jsv) ) + enddo endif +! !---------------------------------------------------------------------- ! IF ((CPROGRAM =='DIAG ').OR.(L1D)) THEN @@ -1328,16 +1398,13 @@ IF (LORILAM) THEN DEALLOCATE(ZOLDAERO) DEALLOCATE(ZM) DEALLOCATE(ZSEDA) - DEALLOCATE(ZN0) - DEALLOCATE(ZRG0) - DEALLOCATE(ZSIG0) - DEALLOCATE(ZRHOP0) + DEALLOCATE(ZN) + DEALLOCATE(ZRG) + DEALLOCATE(ZLNSIG) + DEALLOCATE(ZRHOP) DEALLOCATE(ZCTOTA) DEALLOCATE(ZCCTOT) DEALLOCATE(ZCTOTG) - DEALLOCATE(ZMU) - DEALLOCATE(ZLAMBDA) - DEALLOCATE(ZOM) DEALLOCATE(ZSO4RAT) DEALLOCATE(ZRV) DEALLOCATE(ZRC) @@ -1349,6 +1416,14 @@ IF (LORILAM) THEN DEALLOCATE(ZSOLORG) DEALLOCATE(XDP) DEALLOCATE(XSURF) + DEALLOCATE(ZMBEG) + DEALLOCATE(ZMINT) + DEALLOCATE(ZMEND) + DEALLOCATE(ZDMINTRA) + DEALLOCATE(ZDMINTER) + DEALLOCATE(ZDMCOND) + DEALLOCATE(ZDMNUCL) + DEALLOCATE(ZDMMERG) END IF !------------------------------------------------------------------------------- ! diff --git a/src/MNH/ch_orilam.f90 b/src/MNH/ch_orilam.f90 index 3e4e1219d..22c7764e7 100644 --- a/src/MNH/ch_orilam.f90 +++ b/src/MNH/ch_orilam.f90 @@ -3,28 +3,28 @@ !ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt !ORILAM_LIC for details. !----------------------------------------------------------------- -!--------------- special set of characters for RCS information -!----------------------------------------------------------------- -! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/ch_orilam.f90,v $ $Revision: 1.1.2.1.2.1.18.1 $ -! MASDEV4_7 chimie 2007/03/02 13:59:37 -!----------------------------------------------------------------- -!! ######################### +!! ##################### MODULE MODI_CH_ORILAM -!! ######################### +!! ##################### !! INTERFACE !! -SUBROUTINE CH_ORILAM(PAERO, PCHEM, PM, PSIG0, PRG0, PN0, PCTOTG, PCTOTA,& - PCCTOT, PDTACT, PSEDA,& - PMU, PLAMBDA, PRHOP0, POM, PSO4RAT, & - PRV, PDENAIR, PPRESSURE, PTEMP, PRC, PFRAC, PMI,& - PTIME, GSCHEME, PSOLORG) +SUBROUTINE CH_ORILAM(PAERO, PCHEM, PM, PLNSIG, PRG, PN, PCTOTG, PCTOTA, & + PCCTOT, PDTACT, PSEDA, & + PRHOP, PSO4RAT, & + PRV, PDENAIR, PPRESSURE, PTEMP, PRC, PFRAC, PMI, & + PTIME, GSCHEME, PSOLORG, & + PJNUC,PJ2RAT,PMBEG,PMINT,PMEND,PDMINTRA, & + PDMINTER,PDMCOND,PDMNUCL,PDMMERG, & + PCONC_MASS,PCOND_MASS_I,PCOND_MASS_J,PNUCL_MASS) +!! IMPLICIT NONE REAL, INTENT(IN) :: PDTACT, PTIME -REAL, DIMENSION(:,:), INTENT(INOUT) :: PRHOP0, POM -REAL, DIMENSION(:), INTENT(INOUT) :: PLAMBDA, PMU, PSO4RAT +REAL, DIMENSION(:,:), INTENT(INOUT) :: PRHOP +REAL, DIMENSION(:), INTENT(INOUT) :: PSO4RAT +REAL, DIMENSION(:), INTENT(INOUT) :: PJNUC, PJ2RAT REAL, DIMENSION(:,:), INTENT(INOUT) :: PM -REAL, DIMENSION(:,:), INTENT(INOUT) :: PSIG0, PRG0, PN0 +REAL, DIMENSION(:,:), INTENT(INOUT) :: PLNSIG, PRG, PN REAL, DIMENSION(:,:), INTENT(INOUT) :: PCTOTG REAL, DIMENSION(:,:), INTENT(INOUT) :: PSEDA REAL, DIMENSION(:,:), INTENT(INOUT) :: PCHEM @@ -35,35 +35,30 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCTOTA, PCCTOT REAL, DIMENSION(:,:), INTENT(INOUT) :: PSOLORG REAL, DIMENSION(:), INTENT(IN) :: PRV, PDENAIR, PPRESSURE, PTEMP, PRC CHARACTER(LEN=10), INTENT(IN) :: GSCHEME - - +REAL, DIMENSION(:,:), INTENT(INOUT) :: PMBEG,PMINT,PMEND +REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMINTRA,PDMINTER,PDMCOND,PDMNUCL,PDMMERG +REAL, DIMENSION(:), INTENT(INOUT) :: PCONC_MASS,PCOND_MASS_I,PCOND_MASS_J,PNUCL_MASS +!! END SUBROUTINE CH_ORILAM !! END INTERFACE !! END MODULE MODI_CH_ORILAM !! -!! ##################################################################################### -SUBROUTINE CH_ORILAM(PAERO, PCHEM, PM, PSIG0, PRG0, PN0, PCTOTG, PCTOTA,& - PCCTOT, PDTACT, PSEDA,& - PMU, PLAMBDA, PRHOP0, POM, PSO4RAT, & - PRV, PDENAIR, PPRESSURE, PTEMP, PRC, PFRAC, PMI,& - PTIME, GSCHEME, PSOLORG) -!! ##################################################################################### +!! ####################################################################### +SUBROUTINE CH_ORILAM(PAERO, PCHEM, PM, PLNSIG, PRG, PN, PCTOTG, PCTOTA, & + PCCTOT, PDTACT, PSEDA, & + PRHOP, PSO4RAT, & + PRV, PDENAIR, PPRESSURE, PTEMP, PRC, PFRAC, PMI, & + PTIME, GSCHEME, PSOLORG, & + PJNUC, PJ2RAT, PMBEG, PMINT, PMEND, PDMINTRA, & + PDMINTER, PDMCOND, PDMNUCL, PDMMERG, & + PCONC_MASS, PCOND_MASS_I, PCOND_MASS_J, PNUCL_MASS) +!! ####################################################################### !! !! PURPOSE !! ------- -!! !! ORILAM aerosol Code -!! -!! -!! Inputs: -!! PCHEM : Chemical (gaseous and aerosol) species (in molec./cm3) -!! PSEDA : Moments -!! -!! Outputs: -!! -!! !! !! REFERENCE !! --------- @@ -84,56 +79,77 @@ SUBROUTINE CH_ORILAM(PAERO, PCHEM, PM, PSIG0, PRG0, PN0, PCTOTG, PCTOTA,& !! !! EXTERNAL !! -------- -USE MODI_CH_AER_TRANS -USE MODI_CH_AER_DRIVER - +!! MODI_CH_AER_TRANS +!! MODI_CH_AER_DRIVER !! -!! IMPLICIT ARGUMENTS -!! ------------------ +!! IMPLICIT ARGUMENTS +!! ------------------ +!! MODD_CH_AEROSOL !! -USE MODD_CH_AEROSOL -! !------------------------------------------------------------------------------- ! !* 0. DECLARATIONS ! ------------ ! +USE MODI_CH_AER_TRANS +USE MODI_CH_AER_DRIVER +! +USE MODD_CH_AEROSOL +! IMPLICIT NONE +! +! +!* 0.1 declarations of arguments +! REAL, INTENT(IN) :: PDTACT, PTIME REAL, DIMENSION(:,:), INTENT(INOUT) :: PM -REAL, DIMENSION(:,:), INTENT(INOUT) :: PRHOP0, POM -REAL, DIMENSION(:), INTENT(INOUT) :: PLAMBDA, PMU, PSO4RAT +REAL, DIMENSION(:,:), INTENT(INOUT) :: PRHOP +REAL, DIMENSION(:), INTENT(INOUT) :: PSO4RAT +REAL, DIMENSION(:), INTENT(INOUT) :: PJNUC, PJ2RAT REAL, DIMENSION(:,:), INTENT(INOUT) :: PSEDA REAL, DIMENSION(:,:), INTENT(INOUT) :: PCHEM REAL, DIMENSION(:,:), INTENT(INOUT) :: PAERO REAL, DIMENSION(:,:), INTENT(INOUT) :: PFRAC REAL, DIMENSION(:,:), INTENT(INOUT) :: PMI -REAL, DIMENSION(:,:), INTENT(INOUT) :: PSIG0, PRG0, PN0 +REAL, DIMENSION(:,:), INTENT(INOUT) :: PLNSIG, PRG, PN REAL, DIMENSION(:,:), INTENT(INOUT) :: PCTOTG REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCTOTA, PCCTOT REAL, DIMENSION(:,:), INTENT(INOUT) :: PSOLORG REAL, DIMENSION(:), INTENT(IN) :: PRV, PDENAIR, PPRESSURE, PTEMP, PRC CHARACTER(LEN=10), INTENT(IN) :: GSCHEME - +REAL, DIMENSION(:,:), INTENT(INOUT) :: PMBEG,PMINT,PMEND +REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMINTRA,PDMINTER,PDMCOND,PDMNUCL,PDMMERG +REAL, DIMENSION(:), INTENT(INOUT) :: PCONC_MASS,PCOND_MASS_I,PCOND_MASS_J,PNUCL_MASS +! +!* 0.2 declarations of local variables +! REAL, DIMENSION(SIZE(PAERO,1),JPMODE) :: ZMASK +REAL, DIMENSION(SIZE(PAERO,1)) :: ZSULF ! !------------------------------------------------------------------------------- -!initialize ZMASK +! +!* 1. COMPUTATION +! ----------- +! ZMASK(:,:) = 1. ! -! transfer gas phase variables into aerosol variables -CALL CH_AER_TRANS(0, PM, PSIG0, PRG0, PN0, PRHOP0,PAERO, PCHEM, PCTOTG, PCTOTA, PCCTOT,& - PFRAC, PMI, ZMASK,GSCHEME) - -! integrate aerosol variables -CALL CH_AER_DRIVER(PM,PSIG0, PRG0, PN0, PCTOTG, PCTOTA, PCCTOT, & - PDTACT, PSEDA, PMU, PLAMBDA, PRHOP0, POM, PSO4RAT, & +!* 1.1 transfer gas phase variables into aerosol variables +! +CALL CH_AER_TRANS(0, PM, PLNSIG, PRG, PN, PRHOP,PAERO, PCHEM, PCTOTG, PCTOTA, PCCTOT, & + PFRAC, PMI, ZMASK, GSCHEME) +! +!* 1.2 integrate aerosol variables +! +CALL CH_AER_DRIVER(PM,PLNSIG, PRG, PN, PCTOTG, PCTOTA, PCCTOT, & + PDTACT, PSEDA, PRHOP, PSO4RAT, & PRV, PDENAIR, PPRESSURE, PTEMP, PRC, ZMASK, PTIME, & - PSOLORG) + PSOLORG,PJNUC,PJ2RAT,PMBEG,PMINT,PMEND,PDMINTRA, & + PDMINTER,PDMCOND,PDMNUCL,PDMMERG, & + PCONC_MASS,PCOND_MASS_I,PCOND_MASS_J,PNUCL_MASS ) ! -! transfer aerosol variables back into gas phase variables - CALL CH_AER_TRANS(1, PM, PSIG0, PRG0, PN0, PRHOP0, PAERO, PCHEM, PCTOTG, PCTOTA, PCCTOT,& - PFRAC, PMI, ZMASK,GSCHEME) +!* 1.3 transfer aerosol variables back into gas phase variables ! +CALL CH_AER_TRANS(1, PM, PLNSIG, PRG, PN, PRHOP, PAERO, PCHEM, PCTOTG, PCTOTA, PCCTOT, & + PFRAC, PMI, ZMASK,GSCHEME) ! END SUBROUTINE CH_ORILAM diff --git a/src/MNH/default_desfmn.f90 b/src/MNH/default_desfmn.f90 index c1be2c51e..8324b19c6 100644 --- a/src/MNH/default_desfmn.f90 +++ b/src/MNH/default_desfmn.f90 @@ -219,6 +219,7 @@ END MODULE MODI_DEFAULT_DESFM_n ! Q. Rodier 06/2021: modify default value to LGZ=F (grey-zone corr.), LSEDI and OSEDC=T (LIMA sedimentation) ! F. Couvreux 06/2021: add LRELAX_UVMEAN_FRC ! Q. Rodier 07/2021: modify XPOND=1 +! C. Barthe 03/2022: add CIBU and RDSF options in LIMA !------------------------------------------------------------------------------- ! !* 0. DECLARATIONS @@ -288,6 +289,7 @@ USE MODD_PARAM_LIMA, ONLY : LCOLD, LNUCL, LSEDI, LHHONI, LSNOW, LHAIL, LMEYERS, YACTEMP_CCN=>XACTEMP_CCN, YAERDIFF=>XAERDIFF, & YAERHEIGHT=>XAERHEIGHT, & LSCAV, LAERO_MASS, NPHILLIPS, & + LCIBU, XNDEBRIS_CIBU, LRDSF, & ODEPOC=>LDEPOC, OVDEPOC=>XVDEPOC, OACTTKE=>LACTTKE, & LPTSPLIT, L_LFEEDBACKT=>LFEEDBACKT, L_NMAXITER=>NMAXITER, & L_XMRSTEP=>XMRSTEP, L_XTSTEP_TS=>XTSTEP_TS @@ -1039,6 +1041,9 @@ IF (KMI == 1) THEN XIFN_CONC(:) = 100. NMOD_IMM = 0 NPHILLIPS=8 + LCIBU = .FALSE. + XNDEBRIS_CIBU = 50.0 + LRDSF = .FALSE. ENDIF ! !------------------------------------------------------------------------------- diff --git a/src/MNH/endstep.f90 b/src/MNH/endstep.f90 index d08270286..e5e616fed 100644 --- a/src/MNH/endstep.f90 +++ b/src/MNH/endstep.f90 @@ -192,6 +192,7 @@ END MODULE MODI_ENDSTEP !! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1 !! 02/2019 (S. Bielli) Sea salt : significant sea wave height influences salt emission; 5 salt modes ! P. Wautelet 02/2020: use the new data structures and subroutines for budgets +! P. Wautelet 02/2022: add sea salt !------------------------------------------------------------------------------ ! !* 0. DECLARATIONS @@ -208,12 +209,14 @@ USE MODD_CH_AEROSOL, ONLY: LORILAM USE MODD_CONF USE MODD_CTURB USE MODD_DUST, ONLY: LDUST +USE MODD_SALT, ONLY: LSALT USE MODD_DYN USE MODD_GRID_n USE MODD_LBC_n, ONLY: CLBCX, CLBCY USE MODD_NSV, ONLY: XSVMIN, NSV_CHEMBEG, NSV_CHEMEND, & NSV_AERBEG, NSV_AEREND,& NSV_DSTBEG, NSV_DSTEND,& + NSV_SLTBEG, NSV_SLTEND,& NSV_SNWBEG, NSV_SNWEND USE MODD_PARAM_C2R2, ONLY: LACTIT USE MODD_PARAM_LIMA, ONLY: LACTIT_LIMA=>LACTIT @@ -516,7 +519,24 @@ END IF ! !------------------------------------------------------------------------------ ! -!* 10. STORAGE IN BUDGET ARRAYS +!* 9. MINIMUM VALUE FOR SEA SALTS +! +IF (LSALT) THEN + IF ((SIZE(PLBXSVM,4) > NSV_SLTEND-1).AND.(SIZE(PLBXSVM,1) /= 0)) THEN + DO JSV=NSV_SLTBEG, NSV_SLTEND + PLBXSVM(:,:,:,JSV) = MAX(PLBXSVM(:,:,:,JSV), XSVMIN(JSV)) + END DO + END IF + IF ((SIZE(PLBYSVM,4) > NSV_SLTEND-1).AND.(SIZE(PLBYSVM,1) /= 0)) THEN + DO JSV=NSV_SLTBEG, NSV_SLTEND + PLBYSVM(:,:,:,JSV) = MAX(PLBYSVM(:,:,:,JSV), XSVMIN(JSV)) + END DO + END IF +END IF +! +!------------------------------------------------------------------------------ +! +!* 11. STORAGE IN BUDGET ARRAYS ! IF (LBU_ENABLE) THEN !Division by nbustep to compute average on the selected time period @@ -637,7 +657,7 @@ END IF ! !------------------------------------------------------------------------------ ! -!* 11. COMPUTATION OF PHASE VELOCITY +!* 12. COMPUTATION OF PHASE VELOCITY ! ----------------------------- ! ! It is temporarily set to a constant value diff --git a/src/MNH/ground_paramn.f90 b/src/MNH/ground_paramn.f90 index b504d4b1b..876a976d4 100644 --- a/src/MNH/ground_paramn.f90 +++ b/src/MNH/ground_paramn.f90 @@ -130,6 +130,7 @@ USE MODD_CST, ONLY : XP00, XCPD, XRD, XRV,XRHOLW, XDAY, XPI, XLVTT, XMD, USE MODD_PARAMETERS, ONLY : JPVEXT, XUNDEF USE MODD_DYN_n, ONLY : XTSTEP USE MODD_CH_MNHC_n, ONLY : LUSECHEM +USE MODD_CH_M9_n, ONLY : CNAMES USE MODD_FIELD_n, ONLY : XUT, XVT, XWT, XTHT, XRT, XPABST, XSVT, XTKET, XZWS USE MODD_METRICS_n, ONLY : XDXX, XDYY, XDZZ USE MODD_DIM_n, ONLY : NKMAX @@ -588,6 +589,7 @@ END IF ! ! Call to surface schemes ! + CALL COUPLING_SURF_ATM_n(YSURF_CUR,'MESONH', 'E',ZTIMEC, & XTSTEP, TDTCUR%nyear, TDTCUR%nmonth, TDTCUR%nday, TDTCUR%xtime, & IDIM1D,KSV_SURF,SIZE(XSW_BANDS), & @@ -684,7 +686,7 @@ END IF IF (LUSECHEM) THEN DO JSV=NSV_CHEMBEG,NSV_CHEMEND PSFSV(:,:,JSV) = ZSFTS(:,:,JSV) * XMD / ( XAVOGADRO * XRHODREF(:,:,IKB)) - IF ((LCHEMDIAG).AND.(CPROGRAM == 'DIAG ')) XCHFLX(:,:,JSV) = PSFSV(:,:,JSV) + IF ((LCHEMDIAG).AND.(CPROGRAM == 'DIAG ')) XCHFLX(:,:,JSV-NSV_CHEMBEG+1) = PSFSV(:,:,JSV) END DO ELSE PSFSV(:,:,NSV_CHEMBEG:NSV_CHEMEND) = 0. diff --git a/src/MNH/ini_budget.f90 b/src/MNH/ini_budget.f90 index 3152cb6e5..20cdbb4a4 100644 --- a/src/MNH/ini_budget.f90 +++ b/src/MNH/ini_budget.f90 @@ -208,6 +208,7 @@ end subroutine Budget_preallocate ! P. Wautelet 02/03/2021: budgets: add terms for blowing snow ! P. Wautelet 04/03/2021: budgets: add terms for drag due to buildings ! P. Wautelet 17/03/2021: choose source terms for budgets with character strings instead of multiple integer variables +! C. Barthe 14/03/2022: budgets: add terms for CIBU and RDSF in LIMA !------------------------------------------------------------------------------- ! !* 0. DECLARATIONS @@ -248,7 +249,7 @@ use modd_param_lima, only: laero_mass_lima => laero_mass, lacti_lima => lacti, lhail_lima => lhail, lhhoni_lima => lhhoni, lmeyers_lima => lmeyers, lnucl_lima => lnucl, & lptsplit, & lrain_lima => lrain, lscav_lima => lscav, lsedc_lima => lsedc, lsedi_lima => lsedi, & - lsnow_lima => lsnow, lspro_lima => lspro, lwarm_lima => lwarm, & + lsnow_lima => lsnow, lspro_lima => lspro, lwarm_lima => lwarm, lcibu, lrdsf, & nmod_ccn, nmod_ifn, nmod_imm use modd_ref, only: lcouples use modd_salt, only: lsalt @@ -2264,12 +2265,22 @@ if ( tbudgets(NBUDGET_RI)%lenabled ) then tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) + tzsource%cmnhname = 'CIBU' + tzsource%clongname = 'ice multiplication process due to ice collisional breakup' + tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lcold_lima .and. lwarm_lima .and. lsnow_lima .and. lcibu ) + call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) + tzsource%cmnhname = 'CFRZ' tzsource%clongname = 'conversion freezing of rain' tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) & .or. hcloud(1:3) == 'ICE' call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) + tzsource%cmnhname = 'RDSF' + tzsource%clongname = 'ice multiplication process following rain contact freezing' + tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lcold_lima .and. lwarm_lima .and. lsnow_lima .and. lrdsf ) + call Budget_source_add( tbudgets(NBUDGET_RI), tzsource ) + tzsource%cmnhname = 'WETG' tzsource%clongname = 'wet growth of graupel' tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) & @@ -2463,6 +2474,11 @@ if ( tbudgets(NBUDGET_RS)%lenabled ) then tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. (lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) call Budget_source_add( tbudgets(NBUDGET_RS), tzsource ) + tzsource%cmnhname = 'CIBU' + tzsource%clongname = 'ice multiplication process due to ice collisional breakup' + tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lcold_lima .and. lwarm_lima .and. lsnow_lima .and. lcibu ) + call Budget_source_add( tbudgets(NBUDGET_RS), tzsource ) + tzsource%cmnhname = 'ACC' tzsource%clongname = 'accretion of rain on snow' tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima & @@ -2651,6 +2667,11 @@ if ( tbudgets(NBUDGET_RG)%lenabled ) then .or. hcloud(1:3) == 'ICE' call Budget_source_add( tbudgets(NBUDGET_RG), tzsource ) + tzsource%cmnhname = 'RDSF' + tzsource%clongname = 'ice multiplication process following rain contact freezing' + tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lcold_lima .and. lwarm_lima .and. lsnow_lima .and. lrdsf ) + call Budget_source_add( tbudgets(NBUDGET_RG), tzsource ) + tzsource%cmnhname = 'WETG' tzsource%clongname = 'wet growth of graupel' tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (lcold_lima .and. lwarm_lima .and. lsnow_lima) ) ) & @@ -3422,11 +3443,21 @@ SV_BUDGETS: do jsv = 1, ksv tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) call Budget_source_add( tbudgets(ibudget), tzsource ) + tzsource%cmnhname = 'CIBU' + tzsource%clongname = 'ice multiplication process due to ice collisional breakup' + tzsource%lavailable = .not.lptsplit .and. lcold_lima .and. lwarm_lima .and. lsnow_lima .and. lcibu + call Budget_source_add( tbudgets(ibudget), tzsource ) + tzsource%cmnhname = 'CFRZ' tzsource%clongname = 'conversion freezing of rain' tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) call Budget_source_add( tbudgets(ibudget), tzsource ) + tzsource%cmnhname = 'RDSF' + tzsource%clongname = 'ice multiplication process following rain contact freezing' + tzsource%lavailable = .not.lptsplit .and. lcold_lima .and. lwarm_lima .and. lsnow_lima .and. lrdsf + call Budget_source_add( tbudgets(ibudget), tzsource ) + tzsource%cmnhname = 'WETG' tzsource%clongname = 'wet growth of graupel' tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) diff --git a/src/MNH/ini_lb.f90 b/src/MNH/ini_lb.f90 index b4d44b50a..e72201af0 100644 --- a/src/MNH/ini_lb.f90 +++ b/src/MNH/ini_lb.f90 @@ -1,4 +1,4 @@ -!MNH_LIC Copyright 1998-2020 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC Copyright 1998-2021 CNRS, Meteo-France and Universite Paul Sabatier !MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence !MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt !MNH_LIC for details. version 1. @@ -685,11 +685,20 @@ IF (CCLOUD=='LIMA' ) THEN TZFIELD%LTIMEDEP = .TRUE. ! DO JSV = NSV_LIMA_CCN_FREE,NSV_LIMA_CCN_FREE+NMOD_CCN-1 + SELECT CASE(HGETSVM(JSV)) CASE ('READ') WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_CCN_FREE + 1) IF ( KSIZELBXSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CLIMA_WARM_NAMES(3))//INDICE) + IF ( TPINIFILE%NMNHVERSION(1) < 5 & + .OR. ( TPINIFILE%NMNHVERSION(1) == 5 .AND. TPINIFILE%NMNHVERSION(2) < 5 ) & + .OR. ( TPINIFILE%NMNHVERSION(1) == 5 .AND. TPINIFILE%NMNHVERSION(2) == 5 & + .AND. TPINIFILE%NMNHVERSION(3) < 1 ) ) THEN + !TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CLIMA_WARM_NAMES(3))//INDICE) + TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CLIMA_WARM_NAMES(3)))//INDICE + ELSE + TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CLIMA_WARM_NAMES(3)))//INDICE + END IF TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) TZFIELD%CLBTYPE = 'LBX' WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV @@ -706,9 +715,19 @@ IF (CCLOUD=='LIMA' ) THEN END IF END IF END IF + + ! IF (KSIZELBYSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CLIMA_WARM_NAMES(3))//INDICE) + IF ( TPINIFILE%NMNHVERSION(1) < 5 & + .OR. ( TPINIFILE%NMNHVERSION(1) == 5 .AND. TPINIFILE%NMNHVERSION(2) < 5 ) & + .OR. ( TPINIFILE%NMNHVERSION(1) == 5 .AND. TPINIFILE%NMNHVERSION(2) == 5 & + .AND. TPINIFILE%NMNHVERSION(3) < 1 ) ) THEN + ! TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CLIMA_WARM_NAMES(3))//INDICE) + TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CLIMA_WARM_NAMES(3)))//INDICE + ELSE + TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CLIMA_WARM_NAMES(3)))//INDICE + END IF TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) TZFIELD%CLBTYPE = 'LBY' WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV @@ -746,7 +765,15 @@ IF (CCLOUD=='LIMA' ) THEN CASE ('READ') WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_IFN_FREE + 1) IF ( KSIZELBXSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CLIMA_COLD_NAMES(2))//INDICE) + IF ( TPINIFILE%NMNHVERSION(1) < 5 & + .OR. ( TPINIFILE%NMNHVERSION(1) == 5 .AND. TPINIFILE%NMNHVERSION(2) < 5 ) & + .OR. ( TPINIFILE%NMNHVERSION(1) == 5 .AND. TPINIFILE%NMNHVERSION(2) == 5 & + .AND. TPINIFILE%NMNHVERSION(3) < 1 ) ) THEN + !TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CLIMA_COLD_NAMES(2))//INDICE) + TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CLIMA_COLD_NAMES(2)))//INDICE + ELSE + TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CLIMA_COLD_NAMES(2)))//INDICE + END IF TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) TZFIELD%CLBTYPE = 'LBX' WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV @@ -765,7 +792,15 @@ IF (CCLOUD=='LIMA' ) THEN END IF ! IF (KSIZELBYSV_ll /= 0 ) THEN - TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CLIMA_COLD_NAMES(2))//INDICE) + IF ( TPINIFILE%NMNHVERSION(1) < 5 & + .OR. ( TPINIFILE%NMNHVERSION(1) == 5 .AND. TPINIFILE%NMNHVERSION(2) < 5 ) & + .OR. ( TPINIFILE%NMNHVERSION(1) == 5 .AND. TPINIFILE%NMNHVERSION(2) == 5 & + .AND. TPINIFILE%NMNHVERSION(3) < 1 ) ) THEN + !TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CLIMA_COLD_NAMES(2))//INDICE) + TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CLIMA_COLD_NAMES(2)))//INDICE + ELSE + TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CLIMA_COLD_NAMES(2)))//INDICE + END IF TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) TZFIELD%CLBTYPE = 'LBY' WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV @@ -1632,5 +1667,6 @@ IF (OLSOURCE) THEN END DO ! ENDIF + ! END SUBROUTINE INI_LB diff --git a/src/MNH/ini_lima_cold_mixed.f90 b/src/MNH/ini_lima_cold_mixed.f90 index cb427cdb4..bd43aa295 100644 --- a/src/MNH/ini_lima_cold_mixed.f90 +++ b/src/MNH/ini_lima_cold_mixed.f90 @@ -41,6 +41,7 @@ END MODULE MODI_INI_LIMA_COLD_MIXED !! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O ! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg ! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function +! C. Barthe 14/03/2022: add CIBU and RDSF ! !------------------------------------------------------------------------------- ! @@ -124,7 +125,21 @@ REAL :: PWETLBDAH_MAX,PWETLBDAH_MIN INTEGER :: KWETLBDAS,KWETLBDAG,KWETLBDAH ! REAL :: ZFAC_ZRNIC ! Zrnic factor used to decrease Long Kernels -! +! +REAL :: ZBOUND_CIBU_SMIN ! XDCSLIM*Lbda_s : lower & upper bound used +REAL :: ZBOUND_CIBU_SMAX ! in the tabulated function +REAL :: ZBOUND_CIBU_GMIN ! XDCGLIM*Lbda_g : lower & upper bound used +REAL :: ZBOUND_CIBU_GMAX ! in the tabulated function +REAL :: ZRATE_S ! Geometrical growth of Lbda_s in the tabulated function +REAL :: ZRATE_G ! Geometrical growth of Lbda_g in the tabulated function +! +REAL :: ZBOUND_RDSF_RMIN ! XDCRLIM*Lbda_r : lower & upper bound used +REAL :: ZBOUND_RDSF_RMAX ! in the tabulated function +REAL :: ZRATE_R ! Geometrical growth of Lbda_r in the tabulated function +REAL :: ZKHI_LWM ! Coefficient of Lawson et al. (2015) +! +REAL :: ZRHOIW ! ice density +! !------------------------------------------------------------------------------- ! ! @@ -872,7 +887,108 @@ IF (GFLAG) THEN WRITE(UNIT=ILUOUT0,FMT='(" conversion-melting of the aggregates")') WRITE(UNIT=ILUOUT0,FMT='(" Conv. factor XFSCVMG=",E13.6)') XFSCVMG END IF -! +! +! +!* 7.4 Constants for Ice-Ice collision process (CIBU) +! +XDCSLIM_CIBU_MIN = 2.0E-4 ! D_cs lim min +XDCSLIM_CIBU_MAX = 1.0E-3 ! D_cs lim max +XDCGLIM_CIBU_MIN = 2.0E-3 ! D_cg lim min +! +GFLAG = .TRUE. +IF (GFLAG) THEN + WRITE(UNIT=ILUOUT0,FMT='(" Ice-ice collision process")') + WRITE(UNIT=ILUOUT0,FMT='(" D_cs^lim min-max =",E13.6)') XDCSLIM_CIBU_MIN,XDCSLIM_CIBU_MAX + WRITE(UNIT=ILUOUT0,FMT='(" D_cg^lim min =",E13.6)') XDCGLIM_CIBU_MIN +END IF +! +NGAMINC = 80 +! +!Note : Boundaries are rounded at 5.0 or 1.0 (down for Bound_min and up for Bound_max) +XGAMINC_BOUND_CIBU_SMIN = 1.0E-5 ! Minimal value of (Lbda_s * D_cs^lim)**alpha) 0.2 mm +XGAMINC_BOUND_CIBU_SMAX = 5.0E-3 ! Maximal value of (Lbda_s * D_cs^lim)**alpha) 1 mm +XGAMINC_BOUND_CIBU_SMIN = 1.0E-5 ! Minimal value of (Lbda_s * D_cs^lim)**alpha) 0.2 mm +XGAMINC_BOUND_CIBU_SMAX = 5.0E+2 ! Maximal value of (Lbda_s * D_cs^lim)**alpha) 1 mm +ZRATE_S = EXP(LOG(XGAMINC_BOUND_CIBU_SMAX/XGAMINC_BOUND_CIBU_SMIN)/FLOAT(NGAMINC-1)) +! +XGAMINC_BOUND_CIBU_GMIN = 1.0E-1 ! Minimal value of (Lbda_g * D_cg^lim)**alpha) 2 mm +XGAMINC_BOUND_CIBU_GMAX = 1.0E0 ! Maximal value of (Lbda_g * D_cg^lim)**alpha) 2 mm +XGAMINC_BOUND_CIBU_GMIN = 1.0E-1 ! Minimal value of (Lbda_g * D_cg^lim)**alpha) 2 mm +XGAMINC_BOUND_CIBU_GMAX = 5.0E+1 ! Maximal value of (Lbda_g * D_cg^lim)**alpha) 2 mm +ZRATE_G = EXP(LOG(XGAMINC_BOUND_CIBU_GMAX/XGAMINC_BOUND_CIBU_GMIN)/FLOAT(NGAMINC-1)) +! +ALLOCATE( XGAMINC_CIBU_S(4,NGAMINC) ) +ALLOCATE( XGAMINC_CIBU_G(2,NGAMINC) ) +! +DO J1 = 1, NGAMINC + ZBOUND_CIBU_SMIN = XGAMINC_BOUND_CIBU_SMIN * ZRATE_S**(J1-1) + ZBOUND_CIBU_GMIN = XGAMINC_BOUND_CIBU_GMIN * ZRATE_G**(J1-1) +! +! For ZNI_CIBU + XGAMINC_CIBU_S(1,J1) = GAMMA_INC(XNUS,ZBOUND_CIBU_SMIN) + XGAMINC_CIBU_S(2,J1) = GAMMA_INC(XNUS+(XDS/XALPHAS),ZBOUND_CIBU_SMIN) +! + XGAMINC_CIBU_G(1,J1) = GAMMA_INC(XNUG+((2.0+XDG)/XALPHAG),ZBOUND_CIBU_GMIN) + XGAMINC_CIBU_G(2,J1) = GAMMA_INC(XNUG+(2.0/XALPHAG),ZBOUND_CIBU_GMIN) +! +! For ZRI_CIBU + XGAMINC_CIBU_S(3,J1) = GAMMA_INC(XNUS+(XBS/XALPHAS),ZBOUND_CIBU_SMIN) + XGAMINC_CIBU_S(4,J1) = GAMMA_INC(XNUS+((XBS+XDS)/XALPHAS),ZBOUND_CIBU_SMIN) +END DO +! +XCIBUINTP_S = XALPHAS / LOG(ZRATE_S) +XCIBUINTP1_S = 1.0 + XCIBUINTP_S * LOG(XDCSLIM_CIBU_MIN/(XGAMINC_BOUND_CIBU_SMIN)**(1.0/XALPHAS)) +XCIBUINTP2_S = 1.0 + XCIBUINTP_S * LOG(XDCSLIM_CIBU_MAX/(XGAMINC_BOUND_CIBU_SMIN)**(1.0/XALPHAS)) +! +XCIBUINTP_G = XALPHAG / LOG(ZRATE_G) +XCIBUINTP1_G = 1.0 + XCIBUINTP_G * LOG(XDCGLIM_CIBU_MIN/(XGAMINC_BOUND_CIBU_GMIN)**(1.0/XALPHAG)) +! +! For ZNI_CIBU +XFACTOR_CIBU_NI = (XPI / 4.0) * XCCG * XCCS * (ZRHO00**XCEXVT) +XMOMGG_CIBU_1 = MOMG(XALPHAG,XNUG,2.0+XDG) +XMOMGG_CIBU_2 = MOMG(XALPHAG,XNUG,2.0) +XMOMGS_CIBU_1 = MOMG(XALPHAS,XNUS,XDS) +! +! For ZRI_CIBU +XFACTOR_CIBU_RI = XAS * (XPI / 4.0) * XCCG * XCCS * (ZRHO00**XCEXVT) +XMOMGS_CIBU_2 = MOMG(XALPHAS,XNUS,XBS) +XMOMGS_CIBU_3 = MOMG(XALPHAS,XNUS,XBS+XDS) +! +! +!* 7.5 Constants for raindrop shattering by freezing process (RDSF) +! +XDCRLIM_RDSF_MIN = 0.1E-3 ! D_cr lim min +! +GFLAG = .TRUE. +IF (GFLAG) THEN + WRITE(UNIT=ILUOUT0,FMT='(" Ice-rain collision process")') + WRITE(UNIT=ILUOUT0,FMT='(" D_cr^lim min =",E13.6)') XDCRLIM_RDSF_MIN +END IF +! +NGAMINC = 80 +! +XGAMINC_BOUND_RDSF_RMIN = 1.0E-5 ! Minimal value of (Lbda_r * D_cr^lim)**alpha) 0.1 mm +XGAMINC_BOUND_RDSF_RMAX = 5.0E-3 ! Maximal value of (Lbda_r * D_cr^lim)**alpha) 1 mm +ZRATE_R = EXP(LOG(XGAMINC_BOUND_RDSF_RMAX/XGAMINC_BOUND_RDSF_RMIN)/FLOAT(NGAMINC-1)) +! +ALLOCATE( XGAMINC_RDSF_R(NGAMINC) ) +! +DO J1 = 1, NGAMINC + ZBOUND_RDSF_RMIN = XGAMINC_BOUND_RDSF_RMIN * ZRATE_R**(J1-1) +! +! For ZNI_RDSF + XGAMINC_RDSF_R(J1) = GAMMA_INC(XNUR+((6.0+XDR)/XALPHAR),ZBOUND_RDSF_RMIN) +END DO +! +XRDSFINTP_R = XALPHAR / LOG(ZRATE_R) +XRDSFINTP1_R = 1.0 + XRDSFINTP_R * LOG( XDCRLIM_RDSF_MIN/(XGAMINC_BOUND_RDSF_RMIN)**(1.0/XALPHAR) ) +! +! For ZNI_RDSF +ZKHI_LWM = 2.5E13 ! Coeff. in Lawson-Woods-Morrison for the number of splinters + ! N_DF = XKHI_LWM * D_R**4 +XFACTOR_RDSF_NI = ZKHI_LWM * (XPI / 4.0) * XCR * (ZRHO00**XCEXVT) +XMOMGR_RDSF = MOMG(XALPHAR,XNUR,6.0+XDR) +! !------------------------------------------------------------------------------- ! ! diff --git a/src/MNH/ini_modeln.f90 b/src/MNH/ini_modeln.f90 index 48b3a7348..d7f99b15d 100644 --- a/src/MNH/ini_modeln.f90 +++ b/src/MNH/ini_modeln.f90 @@ -712,7 +712,6 @@ END IF ! ! CALL UPDATE_NSV(KMI) -! !------------------------------------------------------------------------------- ! !* 3. ALLOCATE MEMORY @@ -1913,7 +1912,7 @@ CALL READ_FIELD(KMI,TPINIFILE,IIU,IJU,IKU, & NSIZELBXR_ll,NSIZELBYR_ll,NSIZELBXSV_ll,NSIZELBYSV_ll, & XUM,XVM,XWM,XDUM,XDVM,XDWM, & XUT,XVT,XWT,XTHT,XPABST,XTKET,XRTKEMS, & - XRT,XSVT,XZWS,XCIT,XDRYMASST, & + XRT,XSVT,XZWS,XCIT,XDRYMASST, XDRYMASSS, & XSIGS,XSRCT,XCLDFR,XBL_DEPTH,XSBL_DEPTH,XWTHVMF,XPHC,XPHR, & XLSUM,XLSVM,XLSWM,XLSTHM,XLSRVM,XLSZWSM, & XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM, & diff --git a/src/MNH/ini_nsv.f90 b/src/MNH/ini_nsv.f90 index c49362598..9ea8633fc 100644 --- a/src/MNH/ini_nsv.f90 +++ b/src/MNH/ini_nsv.f90 @@ -726,7 +726,7 @@ END IF ! Initialize scalar variable names for salt IF ( LSALT ) THEN - IF ( NMODE_SLT < 1 .OR. NMODE_SLT > 5 ) CALL Print_msg( NVERB_FATAL, 'GEN', 'INI_NSV', 'NMODE_SLT must in the 1 to 5 interval' ) + IF ( NMODE_SLT < 1 .OR. NMODE_SLT > 8 ) CALL Print_msg( NVERB_FATAL, 'GEN', 'INI_NSV', 'NMODE_SLT must in the 1 to 8 interval' ) IF( .NOT. ALLOCATED( CSALTNAMES ) ) THEN IMOMENTS = ( NSV_SLTEND_A(KMI) - NSV_SLTBEG_A(KMI) + 1 ) / NMODE_SLT diff --git a/src/MNH/ini_prog_var.f90 b/src/MNH/ini_prog_var.f90 index 1f099672e..24a1b3c83 100644 --- a/src/MNH/ini_prog_var.f90 +++ b/src/MNH/ini_prog_var.f90 @@ -124,6 +124,10 @@ USE MODD_PARAM_n USE MODD_PARAMETERS USE MODD_SALT USE MODD_TURB_n +!UPG*PT +USE MODD_REF_n, ONLY : XRHODREF +USE MODD_CH_AERO_n +!UPG*PT ! USE MODE_IO_FIELD_READ, only: IO_Field_read USE MODE_IO_FILE, ONLY: IO_File_close, IO_File_open @@ -131,6 +135,10 @@ USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list USE MODE_MODELN_HANDLER USE MODE_MSG USE MODE_POS +!UPG*PT +USE MODE_DUST_PSD +USE MODE_SALT_PSD +!UPG*PT use mode_tools_ll, only: GET_INDICE_ll ! USE MODI_PGDFILTER @@ -248,9 +256,10 @@ IF(PRESENT(HCHEMFILE)) THEN !callabortstop CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_PROG_VAR','') END IF ! IIMAX - IF (.NOT.LDUST) THEN +!! UPG*PT pourquoi LDUST intervient ici ?? +!! IF (.NOT.LDUST) THEN LUSECHEM = .TRUE. - END IF +!! END IF IF (LORILAM) THEN CALL POSNAM(ILUDES,'NAM_CH_ORILAM',GFOUND,ILUOUT) IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_CH_ORILAM) @@ -272,7 +281,8 @@ IF(PRESENT(HCHEMFILE)) THEN ALLOCATE(XSVT(IIU,IJU,IKU,NSV)) ! Read scalars in chem file - IF (.NOT.LDUST) THEN +!! UPG*PT ??? +!! IF (.NOT.LDUST) THEN TZFIELD%CSTDNAME = '' TZFIELD%CUNITS = 'ppp' TZFIELD%CDIR = 'XY' @@ -295,7 +305,7 @@ IF(PRESENT(HCHEMFILE)) THEN LUSECHEM=.FALSE. NEQ = 0 END IF - END IF +!! END IF IF (LORILAM) THEN TZFIELD%CSTDNAME = '' @@ -337,6 +347,7 @@ IF(PRESENT(HCHEMFILE)) THEN END IF !IRESP END DO ! JSV END IF ! ldepos_aer + END IF ! lorilam IF (LDUST) THEN diff --git a/src/MNH/init_salt.f90 b/src/MNH/init_salt.f90 index 8576133e9..ab14998b3 100644 --- a/src/MNH/init_salt.f90 +++ b/src/MNH/init_salt.f90 @@ -24,26 +24,28 @@ !! AUTHOR !! ------ !! Marine Claeys (CNRM) -!! -!! MODIFICATIONS -!! ------------- -!! -!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes -! + + USE MODD_SALT ! IMPLICIT NONE -IF(NMODE_SLT == 5) THEN - -!JPSALTORDER = (/5, 4, 3, 2, 1 /) +! Default NMODE_SLT == 5 !Initial dry number median radius (um) from Ova et al., 2014 -XINIRADIUS_SLT= (/0.009, 0.021, 0.045, 0.115, 0.415/) +XINIRADIUS_SLT= (/0.009, 0.021, 0.045, 0.115, 0.415,0.0,0.0,0.0/) !Initial, standard deviation from Ova et al., 2014 -XINISIG_SLT = (/ 1.37, 1.5, 1.42, 1.53, 1.85 /) +XINISIG_SLT = (/ 1.37, 1.5, 1.42, 1.53, 1.85, 0.0, 0.0, 0.0 /) !Minimum allowed number concentration for any mode (#/m3) -XN0MIN_SLT = (/1. , 1., 1., 1., 1. /) +XN0MIN_SLT = (/1.e1 , 1.e1, 1.e1, 1., 1.e-4, 0.0, 0.0, 0.0 /) +IF ( NMODE_SLT == 8) THEN +!JPSALTORDER = (/5, 4, 3, 2, 1 /) +!Initial dry number median radius (um) from Ova et al., 2014 + MB21 (Bruch et al., 2022). +XINIRADIUS_SLT= (/0.009, 0.021, 0.045, 0.115, 0.415,2.5, 7.0, 25.0/) +!Initial, standard deviation from Ova et al., 2014 +XINISIG_SLT = (/ 1.37, 1.5, 1.42, 1.53, 1.85,1.7, 1.8, 2.1 /) +!Minimum allowed number concentration for any mode (#/m3) +XN0MIN_SLT = (/1.e1 , 1.e1, 1.e1, 1., 1.e-4,1.e-20 , 1.e-20, 1.e-20 /) ELSE IF ( NMODE_SLT == 3) THEN @@ -51,23 +53,15 @@ ELSE IF ( NMODE_SLT == 3) THEN !This means that if a user choses 1 mode it will have characteristics of mode 2 !2 modes will be mode 2 & 3, whereas 3 modes will modes 1, 2 and 3 !JPSALTORDER = (/3, 2, 1, 4, 5/) -! - !Initial dry number median radius (um) from Vignati et al., 2001 - ! XINIRADIUS_SLT= (/0.2, 2., 12./) - !Initial, standard deviation from Vignati et al., 2001 - ! XINISIG_SLT = (/1.9, 2., 3./) - !Minimum allowed number concentration for any mode (#/m3) - ! XN0MIN_SLT = (/1.e1 , 1. , 1.e-4 /) - - -!Pour 3 modes Schultz +! !Initial dry number median radius (um) from Schultz et al., 2004 - XINIRADIUS_SLT= 0.5*(/0.28, 2.25, 15.32, 0., 0. /) + XINIRADIUS_SLT= 0.5*(/0.28, 2.25, 15.32, 0., 0.,0.,0.,0. /) !Initial, standard deviation from Schultz et al., 2004 - XINISIG_SLT = (/1.9, 2., 2., 0., 0./) + XINISIG_SLT = (/1.9, 2., 2., 0., 0.,0.,0.,0./) !Minimum allowed number concentration for any mode (#/m3) - XN0MIN_SLT = (/1.e1 , 1. , 1.e-4, 0., 0. /) + XN0MIN_SLT = (/1.e1 , 1. , 1.e-4, 0., 0.,0.,0.,0. /) ! + END IF diff --git a/src/MNH/lima_mixed_fast_processes.f90 b/src/MNH/lima_mixed_fast_processes.f90 index 09c86c8a2..525ea3dfb 100644 --- a/src/MNH/lima_mixed_fast_processes.f90 +++ b/src/MNH/lima_mixed_fast_processes.f90 @@ -8,58 +8,58 @@ ! ##################################### ! INTERFACE - SUBROUTINE LIMA_MIXED_FAST_PROCESSES (ZRHODREF, ZZT, ZPRES, PTSTEP, & - ZLSFACT, ZLVFACT, ZKA, ZDV, ZCJ, & - ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, & - ZRHT, ZCCT, ZCRT, ZCIT, & - ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZRHS, & - ZTHS, ZCCS, ZCRS, ZCIS, & - ZLBDAC, ZLBDAR, ZLBDAS, ZLBDAG, ZLBDAH, & + SUBROUTINE LIMA_MIXED_FAST_PROCESSES (PRHODREF, PZT, PPRES, PTSTEP, & + PLSFACT, PLVFACT, PKA, PDV, PCJ, & + PRVT1D, PRCT1D, PRRT1D, PRIT1D, PRST1D, & + PRGT1D, PRTH1D, PCCT1D, PCRT1D, PCIT1D, & + PRCS1D, PRRS1D, PRIS1D, PRSS1D, PRGS1D, & + PRHS1D, PTHS1D, PCCS1D, PCRS1D, PCIS1D, & + PLBDAC, PLBDAR, PLBDAS, PLBDAG, PLBDAH, & PRHODJ1D, GMICRO, PRHODJ, KMI, PTHS, & PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, & PCCS, PCRS, PCIS ) ! -REAL, DIMENSION(:), INTENT(IN) :: ZRHODREF ! RHO Dry REFerence -REAL, DIMENSION(:), INTENT(IN) :: ZZT ! Temperature -REAL, DIMENSION(:), INTENT(IN) :: ZPRES ! Pressure +REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! RHO Dry REFerence +REAL, DIMENSION(:), INTENT(IN) :: PZT ! Temperature +REAL, DIMENSION(:), INTENT(IN) :: PPRES ! Pressure REAL, INTENT(IN) :: PTSTEP ! Time step ! -REAL, DIMENSION(:), INTENT(IN) :: ZLSFACT ! L_s/(Pi_ref*C_ph) -REAL, DIMENSION(:), INTENT(IN) :: ZLVFACT ! L_v/(Pi_ref*C_ph) -REAL, DIMENSION(:), INTENT(IN) :: ZKA ! Thermal conductivity of the air -REAL, DIMENSION(:), INTENT(IN) :: ZDV ! Diffusivity of water vapor in the air -REAL, DIMENSION(:), INTENT(IN) :: ZCJ ! Ventilation coefficient ? -! -REAL, DIMENSION(:), INTENT(IN) :: ZRVT ! Water vapor m.r. at t -REAL, DIMENSION(:), INTENT(IN) :: ZRCT ! Cloud water m.r. at t -REAL, DIMENSION(:), INTENT(IN) :: ZRRT ! Rain water m.r. at t -REAL, DIMENSION(:), INTENT(IN) :: ZRIT ! Pristine ice m.r. at t -REAL, DIMENSION(:), INTENT(IN) :: ZRST ! Snow/aggregate m.r. at t -REAL, DIMENSION(:), INTENT(IN) :: ZRGT ! Graupel m.r. at t -REAL, DIMENSION(:), INTENT(IN) :: ZRHT ! Hail m.r. at t -! -REAL, DIMENSION(:), INTENT(IN) :: ZCCT ! Cloud water conc. at t -REAL, DIMENSION(:), INTENT(IN) :: ZCRT ! Rain water conc. at t -REAL, DIMENSION(:), INTENT(IN) :: ZCIT ! Pristine ice conc. at t -! -REAL, DIMENSION(:), INTENT(INOUT) :: ZRCS ! Cloud water m.r. source -REAL, DIMENSION(:), INTENT(INOUT) :: ZRRS ! Rain water m.r. source -REAL, DIMENSION(:), INTENT(INOUT) :: ZRIS ! Pristine ice m.r. source -REAL, DIMENSION(:), INTENT(INOUT) :: ZRSS ! Snow/aggregate m.r. source -REAL, DIMENSION(:), INTENT(INOUT) :: ZRGS ! Graupel/hail m.r. source -REAL, DIMENSION(:), INTENT(INOUT) :: ZRHS ! Hail m.r. source -! -REAL, DIMENSION(:), INTENT(INOUT) :: ZTHS ! Theta source -! -REAL, DIMENSION(:), INTENT(INOUT) :: ZCCS ! Cloud water conc. source -REAL, DIMENSION(:), INTENT(INOUT) :: ZCRS ! Rain water conc. source -REAL, DIMENSION(:), INTENT(INOUT) :: ZCIS ! Pristine ice conc. source -! -REAL, DIMENSION(:), INTENT(IN) :: ZLBDAC ! Slope param of the cloud droplet distr. -REAL, DIMENSION(:), INTENT(IN) :: ZLBDAR ! Slope param of the raindrop distr -REAL, DIMENSION(:), INTENT(IN) :: ZLBDAS ! Slope param of the aggregate distr. -REAL, DIMENSION(:), INTENT(IN) :: ZLBDAG ! Slope param of the graupel distr. -REAL, DIMENSION(:), INTENT(IN) :: ZLBDAH ! Slope param of the hail distr. +REAL, DIMENSION(:), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph) +REAL, DIMENSION(:), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph) +REAL, DIMENSION(:), INTENT(IN) :: PKA ! Thermal conductivity of the air +REAL, DIMENSION(:), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air +REAL, DIMENSION(:), INTENT(IN) :: PCJ ! Ventilation coefficient ? +! +REAL, DIMENSION(:), INTENT(IN) :: PRVT1D ! Water vapor m.r. at t +REAL, DIMENSION(:), INTENT(IN) :: PRCT1D ! Cloud water m.r. at t +REAL, DIMENSION(:), INTENT(IN) :: PRRT1D ! Rain water m.r. at t +REAL, DIMENSION(:), INTENT(IN) :: PRIT1D ! Pristine ice m.r. at t +REAL, DIMENSION(:), INTENT(IN) :: PRST1D ! Snow/aggregate m.r. at t +REAL, DIMENSION(:), INTENT(IN) :: PRGT1D ! Graupel m.r. at t +REAL, DIMENSION(:), INTENT(IN) :: PRTH1D ! Hail m.r. at t +! +REAL, DIMENSION(:), INTENT(IN) :: PCCT1D ! Cloud water conc. at t +REAL, DIMENSION(:), INTENT(IN) :: PCRT1D ! Rain water conc. at t +REAL, DIMENSION(:), INTENT(IN) :: PCIT1D ! Pristine ice conc. at t +! +REAL, DIMENSION(:), INTENT(INOUT) :: PRCS1D ! Cloud water m.r. source +REAL, DIMENSION(:), INTENT(INOUT) :: PRRS1D ! Rain water m.r. source +REAL, DIMENSION(:), INTENT(INOUT) :: PRIS1D ! Pristine ice m.r. source +REAL, DIMENSION(:), INTENT(INOUT) :: PRSS1D ! Snow/aggregate m.r. source +REAL, DIMENSION(:), INTENT(INOUT) :: PRGS1D ! Graupel/hail m.r. source +REAL, DIMENSION(:), INTENT(INOUT) :: PRHS1D ! Hail m.r. source +! +REAL, DIMENSION(:), INTENT(INOUT) :: PTHS1D ! Theta source +! +REAL, DIMENSION(:), INTENT(INOUT) :: PCCS1D ! Cloud water conc. source +REAL, DIMENSION(:), INTENT(INOUT) :: PCRS1D ! Rain water conc. source +REAL, DIMENSION(:), INTENT(INOUT) :: PCIS1D ! Pristine ice conc. source +! +REAL, DIMENSION(:), INTENT(IN) :: PLBDAC ! Slope param of the cloud droplet distr. +REAL, DIMENSION(:), INTENT(IN) :: PLBDAR ! Slope param of the raindrop distr +REAL, DIMENSION(:), INTENT(IN) :: PLBDAS ! Slope param of the aggregate distr. +REAL, DIMENSION(:), INTENT(IN) :: PLBDAG ! Slope param of the graupel distr. +REAL, DIMENSION(:), INTENT(IN) :: PLBDAH ! Slope param of the hail distr. ! ! used for budget storage REAL, DIMENSION(:), INTENT(IN) :: PRHODJ1D @@ -81,18 +81,18 @@ END SUBROUTINE LIMA_MIXED_FAST_PROCESSES END INTERFACE END MODULE MODI_LIMA_MIXED_FAST_PROCESSES ! -! ####################################################################### - SUBROUTINE LIMA_MIXED_FAST_PROCESSES (ZRHODREF, ZZT, ZPRES, PTSTEP, & - ZLSFACT, ZLVFACT, ZKA, ZDV, ZCJ, & - ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, & - ZRHT, ZCCT, ZCRT, ZCIT, & - ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZRHS, & - ZTHS, ZCCS, ZCRS, ZCIS, & - ZLBDAC, ZLBDAR, ZLBDAS, ZLBDAG, ZLBDAH, & +! ############################################################################### + SUBROUTINE LIMA_MIXED_FAST_PROCESSES (PRHODREF, PZT, PPRES, PTSTEP, & + PLSFACT, PLVFACT, PKA, PDV, PCJ, & + PRVT1D, PRCT1D, PRRT1D, PRIT1D, PRST1D, & + PRGT1D, PRTH1D, PCCT1D, PCRT1D, PCIT1D, & + PRCS1D, PRRS1D, PRIS1D, PRSS1D, PRGS1D, & + PRHS1D, PTHS1D, PCCS1D, PCRS1D, PCIS1D, & + PLBDAC, PLBDAR, PLBDAS, PLBDAG, PLBDAH, & PRHODJ1D, GMICRO, PRHODJ, KMI, PTHS, & PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, & PCCS, PCRS, PCIS ) -! ####################################################################### +! ############################################################################### ! !! !! PURPOSE @@ -142,6 +142,10 @@ END MODULE MODI_LIMA_MIXED_FAST_PROCESSES !! C. Barthe * LACy * jan. 2014 add budgets ! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function ! P. Wautelet 03/2020: use the new data structures and subroutines for budgets +! C. Barthe 14/03/2022: - add CIBU (from T. Hoarau's work) and RDSF (from J.P. Pinty's work) +! - change the name of some arguments to match the DOCTOR norm +! - change conditions for HMG to occur +! !------------------------------------------------------------------------------- ! !* 0. DECLARATIONS @@ -156,6 +160,7 @@ USE MODD_NSV USE MODD_PARAM_LIMA USE MODD_PARAM_LIMA_COLD USE MODD_PARAM_LIMA_MIXED +USE MODD_PARAM_LIMA_WARM, ONLY : XDR use mode_budget, only: Budget_store_init, Budget_store_end @@ -163,47 +168,47 @@ IMPLICIT NONE ! !* 0.1 Declarations of dummy arguments : ! -REAL, DIMENSION(:), INTENT(IN) :: ZRHODREF ! RHO Dry REFerence -REAL, DIMENSION(:), INTENT(IN) :: ZZT ! Temperature -REAL, DIMENSION(:), INTENT(IN) :: ZPRES ! Pressure +REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! RHO Dry REFerence +REAL, DIMENSION(:), INTENT(IN) :: PZT ! Temperature +REAL, DIMENSION(:), INTENT(IN) :: PPRES ! Pressure REAL, INTENT(IN) :: PTSTEP ! Time step ! -REAL, DIMENSION(:), INTENT(IN) :: ZLSFACT ! L_s/(Pi_ref*C_ph) -REAL, DIMENSION(:), INTENT(IN) :: ZLVFACT ! L_v/(Pi_ref*C_ph) -REAL, DIMENSION(:), INTENT(IN) :: ZKA ! Thermal conductivity of the air -REAL, DIMENSION(:), INTENT(IN) :: ZDV ! Diffusivity of water vapor in the air -REAL, DIMENSION(:), INTENT(IN) :: ZCJ ! Ventilation coefficient ? -! -REAL, DIMENSION(:), INTENT(IN) :: ZRVT ! Water vapor m.r. at t -REAL, DIMENSION(:), INTENT(IN) :: ZRCT ! Cloud water m.r. at t -REAL, DIMENSION(:), INTENT(IN) :: ZRRT ! Rain water m.r. at t -REAL, DIMENSION(:), INTENT(IN) :: ZRIT ! Pristine ice m.r. at t -REAL, DIMENSION(:), INTENT(IN) :: ZRST ! Snow/aggregate m.r. at t -REAL, DIMENSION(:), INTENT(IN) :: ZRGT ! Graupel/hail m.r. at t -REAL, DIMENSION(:), INTENT(IN) :: ZRHT ! Hail m.r. at t -! -REAL, DIMENSION(:), INTENT(IN) :: ZCCT ! Cloud water conc. at t -REAL, DIMENSION(:), INTENT(IN) :: ZCRT ! Rain water conc. at t -REAL, DIMENSION(:), INTENT(IN) :: ZCIT ! Pristine ice conc. at t -! -REAL, DIMENSION(:), INTENT(INOUT) :: ZRCS ! Cloud water m.r. source -REAL, DIMENSION(:), INTENT(INOUT) :: ZRRS ! Rain water m.r. source -REAL, DIMENSION(:), INTENT(INOUT) :: ZRIS ! Pristine ice m.r. source -REAL, DIMENSION(:), INTENT(INOUT) :: ZRSS ! Snow/aggregate m.r. source -REAL, DIMENSION(:), INTENT(INOUT) :: ZRGS ! Graupel/hail m.r. source -REAL, DIMENSION(:), INTENT(INOUT) :: ZRHS ! Hail m.r. source -! -REAL, DIMENSION(:), INTENT(INOUT) :: ZTHS ! Theta source -! -REAL, DIMENSION(:), INTENT(INOUT) :: ZCCS ! Cloud water conc. source -REAL, DIMENSION(:), INTENT(INOUT) :: ZCRS ! Rain water conc. source -REAL, DIMENSION(:), INTENT(INOUT) :: ZCIS ! Pristine ice conc. source -! -REAL, DIMENSION(:), INTENT(IN) :: ZLBDAC ! Slope param of the cloud droplet distr. -REAL, DIMENSION(:), INTENT(IN) :: ZLBDAR ! Slope param of the raindrop distr -REAL, DIMENSION(:), INTENT(IN) :: ZLBDAS ! Slope param of the aggregate distr. -REAL, DIMENSION(:), INTENT(IN) :: ZLBDAG ! Slope param of the graupel distr. -REAL, DIMENSION(:), INTENT(IN) :: ZLBDAH ! Slope param of the hail distr. +REAL, DIMENSION(:), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph) +REAL, DIMENSION(:), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph) +REAL, DIMENSION(:), INTENT(IN) :: PKA ! Thermal conductivity of the air +REAL, DIMENSION(:), INTENT(IN) :: PDV ! Diffusivity of water vapor in the air +REAL, DIMENSION(:), INTENT(IN) :: PCJ ! Ventilation coefficient ? +! +REAL, DIMENSION(:), INTENT(IN) :: PRVT1D ! Water vapor m.r. at t +REAL, DIMENSION(:), INTENT(IN) :: PRCT1D ! Cloud water m.r. at t +REAL, DIMENSION(:), INTENT(IN) :: PRRT1D ! Rain water m.r. at t +REAL, DIMENSION(:), INTENT(IN) :: PRIT1D ! Pristine ice m.r. at t +REAL, DIMENSION(:), INTENT(IN) :: PRST1D ! Snow/aggregate m.r. at t +REAL, DIMENSION(:), INTENT(IN) :: PRGT1D ! Graupel/hail m.r. at t +REAL, DIMENSION(:), INTENT(IN) :: PRTH1D ! Hail m.r. at t +! +REAL, DIMENSION(:), INTENT(IN) :: PCCT1D ! Cloud water conc. at t +REAL, DIMENSION(:), INTENT(IN) :: PCRT1D ! Rain water conc. at t +REAL, DIMENSION(:), INTENT(IN) :: PCIT1D ! Pristine ice conc. at t +! +REAL, DIMENSION(:), INTENT(INOUT) :: PRCS1D ! Cloud water m.r. source +REAL, DIMENSION(:), INTENT(INOUT) :: PRRS1D ! Rain water m.r. source +REAL, DIMENSION(:), INTENT(INOUT) :: PRIS1D ! Pristine ice m.r. source +REAL, DIMENSION(:), INTENT(INOUT) :: PRSS1D ! Snow/aggregate m.r. source +REAL, DIMENSION(:), INTENT(INOUT) :: PRGS1D ! Graupel/hail m.r. source +REAL, DIMENSION(:), INTENT(INOUT) :: PRHS1D ! Hail m.r. source +! +REAL, DIMENSION(:), INTENT(INOUT) :: PTHS1D ! Theta source +! +REAL, DIMENSION(:), INTENT(INOUT) :: PCCS1D ! Cloud water conc. source +REAL, DIMENSION(:), INTENT(INOUT) :: PCRS1D ! Rain water conc. source +REAL, DIMENSION(:), INTENT(INOUT) :: PCIS1D ! Pristine ice conc. source +! +REAL, DIMENSION(:), INTENT(IN) :: PLBDAC ! Slope param of the cloud droplet distr. +REAL, DIMENSION(:), INTENT(IN) :: PLBDAR ! Slope param of the raindrop distr +REAL, DIMENSION(:), INTENT(IN) :: PLBDAS ! Slope param of the aggregate distr. +REAL, DIMENSION(:), INTENT(IN) :: PLBDAG ! Slope param of the graupel distr. +REAL, DIMENSION(:), INTENT(IN) :: PLBDAH ! Slope param of the hail distr. ! ! used for budget storage REAL, DIMENSION(:), INTENT(IN) :: PRHODJ1D @@ -224,17 +229,61 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIS ! !* 0.2 Declarations of local variables : ! -LOGICAL, DIMENSION(SIZE(ZZT)) :: GRIM, GACC, GDRY, GWET, GHAIL ! Test where to compute +LOGICAL, DIMENSION(SIZE(PZT)) :: GRIM, GACC, GDRY, GWET, GHAIL ! Test where to compute INTEGER :: IGRIM, IGACC, IGDRY, IGWET, IHAIL INTEGER :: JJ INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1,IVEC2 ! Vectors of indices REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1,ZVEC2, ZVEC3 ! Work vectors -REAL, DIMENSION(SIZE(ZZT)) :: ZZW, ZZX -REAL, DIMENSION(SIZE(ZZT)) :: ZRDRYG, ZRWETG -REAL, DIMENSION(SIZE(ZZT),7) :: ZZW1 +REAL, DIMENSION(SIZE(PZT)) :: ZZW, ZZX +REAL, DIMENSION(SIZE(PZT)) :: ZRDRYG, ZRWETG +REAL, DIMENSION(SIZE(PZT),7) :: ZZW1 REAL :: NHAIL REAL :: ZTHRH, ZTHRC ! +! Variables for CIBU +LOGICAL, DIMENSION(SIZE(PZT)) :: GCIBU ! Test where to compute collision process +LOGICAL, SAVE :: GFIRSTCALL = .TRUE. ! control switch for the first call +! +INTEGER :: ICIBU +INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC2_S1,IVEC2_S2 ! Snow indice vector +INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC2_G ! Graupel indice vector +INTEGER, PARAMETER :: I_SEED_PARAM = 26032012 +INTEGER, DIMENSION(:), ALLOCATABLE :: I_SEED +INTEGER :: NI_SEED +! +REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1_S, ZVEC1_S1, ZVEC1_S2, & ! Work vectors + ZVEC1_S3, ZVEC1_S4, & + ZVEC1_S11, ZVEC1_S12, & ! for snow + ZVEC1_S21, ZVEC1_S22, & + ZVEC1_S31, ZVEC1_S32, & + ZVEC1_S41, ZVEC1_S42, & + ZVEC2_S1, ZVEC2_S2 +REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1_G, ZVEC1_G1, ZVEC1_G2, & ! Work vectors + ZVEC2_G ! for graupel +REAL, DIMENSION(:), ALLOCATABLE :: ZINTG_SNOW_1, & ! incomplete gamma function + ZINTG_SNOW_2, & ! for snow + ZINTG_SNOW_3, & + ZINTG_SNOW_4 +REAL, DIMENSION(:), ALLOCATABLE :: ZINTG_GRAUPEL_1, & ! incomplete gamma + ZINTG_GRAUPEL_2 ! function for graupel +REAL, DIMENSION(:), ALLOCATABLE :: ZNI_CIBU, ZRI_CIBU ! CIBU rates +REAL, DIMENSION(:), ALLOCATABLE :: ZFRAGMENTS, ZHARVEST, ZFRAG_CIBU +REAL :: ZFACT1_XNDEBRIS, ZFACT2_XNDEBRIS +! +LOGICAL, DIMENSION(SIZE(PZT)) :: GRDSF ! Test where to compute collision process +INTEGER :: IRDSF +REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1_R ! Work vectors for rain +REAL, DIMENSION(:), ALLOCATABLE :: ZVEC1_R1 ! Work vectors for rain +REAL, DIMENSION(:), ALLOCATABLE :: ZVEC2_R ! Work vectors for rain +INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC2_R ! Rain indice vector +REAL, DIMENSION(:), ALLOCATABLE :: ZINTG_RAIN ! incomplete gamma function for rain +REAL, DIMENSION(:), ALLOCATABLE :: ZNI_RDSF,ZRI_RDSF ! RDSF rates +! +REAL, DIMENSION(:), ALLOCATABLE :: ZAUX ! used to distribute +REAL, DIMENSION(:,:), ALLOCATABLE :: ZFACT ! the total concentration in each shape +REAL, DIMENSION(:), ALLOCATABLE :: ZONEOVER_VAR ! for optimization +! +! !------------------------------------------------------------------------------- ! ! ################# @@ -249,349 +298,648 @@ SNOW: IF (LSNOW) THEN ! ZZW1(:,:) = 0.0 ! -GRIM(:) = (ZRCT(:)>XRTMIN(2)) .AND. (ZRST(:)>XRTMIN(5)) .AND. (ZRCS(:)>XRTMIN(2)/PTSTEP) .AND. (ZZT(:)<XTT) +GRIM(:) = (PRCT1D(:)>XRTMIN(2)) .AND. (PRST1D(:)>XRTMIN(5)) .AND. (PRCS1D(:)>XRTMIN(2)/PTSTEP) .AND. (PZT(:)<XTT) IGRIM = COUNT( GRIM(:) ) ! IF( IGRIM>0 ) THEN if ( nbumod == kmi .and. lbu_enable ) then if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'RIM', & - Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'RIM', & - Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prcs1d(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'RIM', & - Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'RIM', & - Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'RIM', & - Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pccs1d(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) ) end if ! ! 1.1.0 allocations ! - ALLOCATE(ZVEC1(IGRIM)) - ALLOCATE(ZVEC2(IGRIM)) - ALLOCATE(IVEC1(IGRIM)) - ALLOCATE(IVEC2(IGRIM)) + ALLOCATE(ZVEC1(IGRIM)) + ALLOCATE(ZVEC2(IGRIM)) + ALLOCATE(IVEC1(IGRIM)) + ALLOCATE(IVEC2(IGRIM)) ! -! 1.1.1 select the ZLBDAS +! 1.1.1 select the PLBDAS ! - ZVEC1(:) = PACK( ZLBDAS(:),MASK=GRIM(:) ) + ZVEC1(:) = PACK( PLBDAS(:),MASK=GRIM(:) ) ! -! 1.1.2 find the next lower indice for the ZLBDAS in the geometrical +! 1.1.2 find the next lower indice for the PLBDAS in the geometrical ! set of Lbda_s used to tabulate some moments of the incomplete ! gamma function ! - ZVEC2(1:IGRIM) = MAX( 1.0001, MIN( REAL(NGAMINC)-0.0001, & + ZVEC2(1:IGRIM) = MAX( 1.0001, MIN( REAL(NGAMINC)-0.0001, & XRIMINTP1 * LOG( ZVEC1(1:IGRIM) ) + XRIMINTP2 ) ) - IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) ) - ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - REAL( IVEC2(1:IGRIM) ) + IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) ) + ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - REAL( IVEC2(1:IGRIM) ) ! ! 1.1.3 perform the linear interpolation of the normalized ! "2+XDS"-moment of the incomplete gamma function ! - ZVEC1(1:IGRIM) = XGAMINC_RIM1( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) & - - XGAMINC_RIM1( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0) - ZZW(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GRIM,FIELD=0.0 ) + ZVEC1(1:IGRIM) = XGAMINC_RIM1( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) & + - XGAMINC_RIM1( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0) + ZZW(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GRIM,FIELD=0.0 ) ! ! 1.1.4 riming of the small sized aggregates ! - WHERE ( GRIM(:) ) - ZZW1(:,1) = MIN( ZRCS(:), & - XCRIMSS * ZZW(:) * ZRCT(:) & ! RCRIMSS - * ZLBDAS(:)**XEXCRIMSS & - * ZRHODREF(:)**(-XCEXVT) ) - ZRCS(:) = ZRCS(:) - ZZW1(:,1) - ZRSS(:) = ZRSS(:) + ZZW1(:,1) - ZTHS(:) = ZTHS(:) + ZZW1(:,1)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RCRIMSS)) + WHERE ( GRIM(:) ) + ZZW1(:,1) = MIN( PRCS1D(:), & + XCRIMSS * ZZW(:) * PRCT1D(:) & ! RCRIMSS + * PLBDAS(:)**XEXCRIMSS & + * PRHODREF(:)**(-XCEXVT) ) + PRCS1D(:) = PRCS1D(:) - ZZW1(:,1) + PRSS1D(:) = PRSS1D(:) + ZZW1(:,1) + PTHS1D(:) = PTHS1D(:) + ZZW1(:,1) * (PLSFACT(:) - PLVFACT(:)) ! f(L_f*(RCRIMSS)) ! - ZCCS(:) = MAX( ZCCS(:)-ZZW1(:,1)*(ZCCT(:)/ZRCT(:)),0.0 ) ! Lambda_c**3 - END WHERE + PCCS1D(:) = MAX( PCCS1D(:)-ZZW1(:,1)*(PCCT1D(:)/PRCT1D(:)),0.0 ) ! Lambda_c**3 + END WHERE ! ! 1.1.5 perform the linear interpolation of the normalized ! "XBS"-moment of the incomplete gamma function ! - ZVEC1(1:IGRIM) = XGAMINC_RIM2( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) & - - XGAMINC_RIM2( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0) - ZZW(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GRIM,FIELD=0.0 ) + ZVEC1(1:IGRIM) = XGAMINC_RIM2( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) & + - XGAMINC_RIM2( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0) + ZZW(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GRIM,FIELD=0.0 ) ! ! 1.1.6 riming-conversion of the large sized aggregates into graupeln ! -! - WHERE ( GRIM(:) .AND. (ZRSS(:)>XRTMIN(5)/PTSTEP) ) - ZZW1(:,2) = MIN( ZRCS(:), & - XCRIMSG * ZRCT(:) & ! RCRIMSG - * ZLBDAS(:)**XEXCRIMSG & - * ZRHODREF(:)**(-XCEXVT) & - - ZZW1(:,1) ) - ZZW1(:,3) = MIN( ZRSS(:), & - XSRIMCG * ZLBDAS(:)**XEXSRIMCG & ! RSRIMCG - * (1.0 - ZZW(:) )/(PTSTEP*ZRHODREF(:))) - ZRCS(:) = ZRCS(:) - ZZW1(:,2) - ZRSS(:) = ZRSS(:) - ZZW1(:,3) - ZRGS(:) = ZRGS(:) + ZZW1(:,2) + ZZW1(:,3) - ZTHS(:) = ZTHS(:) + ZZW1(:,2)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RCRIMSG)) -! - ZCCS(:) = MAX( ZCCS(:)-ZZW1(:,2)*(ZCCT(:)/ZRCT(:)),0.0 ) ! Lambda_c**3 - END WHERE - DEALLOCATE(IVEC2) - DEALLOCATE(IVEC1) - DEALLOCATE(ZVEC2) - DEALLOCATE(ZVEC1) - + WHERE ( GRIM(:) .AND. (PRSS1D(:)>XRTMIN(5)/PTSTEP) ) + ZZW1(:,2) = MIN( PRCS1D(:), & + XCRIMSG * PRCT1D(:) & ! RCRIMSG + * PLBDAS(:)**XEXCRIMSG & + * PRHODREF(:)**(-XCEXVT) & + - ZZW1(:,1) ) + ZZW1(:,3) = MIN( PRSS1D(:), & + XSRIMCG * PLBDAS(:)**XEXSRIMCG & ! RSRIMCG + * (1.0 - ZZW(:) )/(PTSTEP*PRHODREF(:))) + PRCS1D(:) = PRCS1D(:) - ZZW1(:,2) + PRSS1D(:) = PRSS1D(:) - ZZW1(:,3) + PRGS1D(:) = PRGS1D(:) + ZZW1(:,2) + ZZW1(:,3) + PTHS1D(:) = PTHS1D(:) + ZZW1(:,2) * (PLSFACT(:) - PLVFACT(:)) ! f(L_f*(RCRIMSG)) + ! + PCCS1D(:) = MAX( PCCS1D(:)-ZZW1(:,2)*(PCCT1D(:)/PRCT1D(:)),0.0 ) ! Lambda_c**3 + END WHERE + DEALLOCATE(IVEC2) + DEALLOCATE(IVEC1) + DEALLOCATE(ZVEC2) + DEALLOCATE(ZVEC1) + ! ! Budget storage if ( nbumod == kmi .and. lbu_enable ) then if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'RIM', & - Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'RIM', & - Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prcs1d(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'RIM', & - Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'RIM', & - Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'RIM', & - Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pccs1d(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) ) end if END IF ! +! !* 1.2 Hallett-Mossop ice multiplication process due to snow riming ! ----------------------------------------------------------------- ! -! -GRIM(:) = (ZZT(:)<XHMTMAX) .AND. (ZZT(:)>XHMTMIN) & - .AND. (ZRST(:)>XRTMIN(5)) .AND. (ZRCT(:)>XRTMIN(2)) +GRIM(:) = (PZT(:)<XHMTMAX) .AND. (PZT(:)>XHMTMIN) & + .AND. (PRST1D(:)>XRTMIN(5)) .AND. (PRCT1D(:)>XRTMIN(2)) IGRIM = COUNT( GRIM(:) ) IF( IGRIM>0 ) THEN ! Budget storage if ( nbumod == kmi .and. lbu_enable ) then if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HMS', & - Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'HMS', & - Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HMS', & - Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) end if - ALLOCATE(ZVEC1(IGRIM)) - ALLOCATE(ZVEC2(IGRIM)) - ALLOCATE(IVEC2(IGRIM)) -! - ZVEC1(:) = PACK( ZLBDAC(:),MASK=GRIM(:) ) - ZVEC2(1:IGRIM) = MAX( 1.0001, MIN( REAL(NGAMINC)-0.0001, & - XHMLINTP1 * LOG( ZVEC1(1:IGRIM) ) + XHMLINTP2 ) ) - IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) ) - ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - REAL( IVEC2(1:IGRIM) ) - ZVEC1(1:IGRIM) = XGAMINC_HMC( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) & - - XGAMINC_HMC( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0) - ZZX(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GRIM,FIELD=0.0 ) ! Large droplets -! - WHERE ( GRIM(:) .AND. ZZX(:)<0.99 ) - ZZW1(:,5) = (ZZW1(:,1)+ZZW1(:,2))*(ZCCT(:)/ZRCT(:))*(1.0-ZZX(:))* & - XHM_FACTS* & - MAX( 0.0, MIN( (ZZT(:)-XHMTMIN)/3.0,(XHMTMAX-ZZT(:))/2.0 ) ) ! CCHMSI - ZCIS(:) = ZCIS(:) + ZZW1(:,5) -! - ZZW1(:,6) = ZZW1(:,5) * XMNU0 ! RCHMSI - ZRIS(:) = ZRIS(:) + ZZW1(:,6) - ZRSS(:) = ZRSS(:) - ZZW1(:,6) - END WHERE - DEALLOCATE(IVEC2) - DEALLOCATE(ZVEC2) - DEALLOCATE(ZVEC1) - + ALLOCATE(ZVEC1(IGRIM)) + ALLOCATE(ZVEC2(IGRIM)) + ALLOCATE(IVEC2(IGRIM)) +! + ZVEC1(:) = PACK( PLBDAC(:),MASK=GRIM(:) ) + ZVEC2(1:IGRIM) = MAX( 1.0001, MIN( REAL(NGAMINC)-0.0001, & + XHMLINTP1 * LOG( ZVEC1(1:IGRIM) ) + XHMLINTP2 ) ) + IVEC2(1:IGRIM) = INT( ZVEC2(1:IGRIM) ) + ZVEC2(1:IGRIM) = ZVEC2(1:IGRIM) - REAL( IVEC2(1:IGRIM) ) + ZVEC1(1:IGRIM) = XGAMINC_HMC( IVEC2(1:IGRIM)+1 )* ZVEC2(1:IGRIM) & + - XGAMINC_HMC( IVEC2(1:IGRIM) )*(ZVEC2(1:IGRIM) - 1.0) + ZZX(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GRIM,FIELD=0.0 ) ! Large droplets +! + WHERE ( GRIM(:) .AND. ZZX(:)<0.99 ) + ZZW1(:,5) = (ZZW1(:,1)+ZZW1(:,2))*(PCCT1D(:)/PRCT1D(:))*(1.0-ZZX(:))* & + XHM_FACTS* & + MAX( 0.0, MIN( (PZT(:)-XHMTMIN)/3.0,(XHMTMAX-PZT(:))/2.0 ) ) ! CCHMSI + PCIS1D(:) = PCIS1D(:) + ZZW1(:,5) +! + ZZW1(:,6) = ZZW1(:,5) * XMNU0 ! RCHMSI + PRIS1D(:) = PRIS1D(:) + ZZW1(:,6) + PRSS1D(:) = PRSS1D(:) - ZZW1(:,6) + END WHERE + DEALLOCATE(IVEC2) + DEALLOCATE(ZVEC2) + DEALLOCATE(ZVEC1) + ! ! Budget storage if ( nbumod == kmi .and. lbu_enable ) then if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HMS', & - Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'HMS', & - Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HMS', & - Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) end if END IF ! ! -!* 1.3 Rain accretion onto the aggregates +!* 1.3 Ice multiplication process due to ice-ice collisions +! --------------------------------------------------------- +! +GCIBU(:) = LCIBU .AND. (PRST1D(:)>XRTMIN(5)) .AND. (PRGT1D(:)>XRTMIN(6)) +ICIBU = COUNT( GCIBU(:) ) +! +IF (ICIBU > 0) THEN +! + ! Budget storage + if ( nbumod == kmi .and. lbu_enable ) then + if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CIBU', & + Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) + if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'CIBU', & + Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) + if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CIBU', & + Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) + end if +! +! 1.3.0 randomization of XNDEBRIS_CIBU values +! + IF (GFIRSTCALL) THEN + CALL RANDOM_SEED(SIZE=NI_SEED) ! get size of seed + ALLOCATE(I_SEED(NI_SEED)) + I_SEED(:) = I_SEED_PARAM ! + CALL RANDOM_SEED(PUT=I_SEED) + GFIRSTCALL = .FALSE. + END IF +! + ALLOCATE(ZFRAGMENTS(ICIBU)) +! + IF (XNDEBRIS_CIBU >= 0.0) THEN + ZFRAGMENTS(:) = XNDEBRIS_CIBU + ELSE +! +! Mantissa gives the mean value (randomization around 10**MANTISSA) +! First digit after the comma provides the full range around 10**MANTISSA +! + ALLOCATE(ZHARVEST(ICIBU)) +! + ZFACT1_XNDEBRIS = AINT(XNDEBRIS_CIBU) + ZFACT2_XNDEBRIS = ABS(ANINT(10.0*(XNDEBRIS_CIBU - ZFACT1_XNDEBRIS))) +! + CALL RANDOM_NUMBER(ZHARVEST(:)) +! + ZFRAGMENTS(:) = 10.0**(ZFACT2_XNDEBRIS*ZHARVEST(:) + ZFACT1_XNDEBRIS) +! + DEALLOCATE(ZHARVEST) +! +! ZFRAGMENTS is a random variable containing the number of fragments per collision +! For XNDEBRIS_CIBU=-1.2345 => ZFRAGMENTS(:) = 10.0**(2.0*RANDOM_NUMBER(ZHARVEST(:)) - 1.0) +! and ZFRAGMENTS=[0.1, 10.0] centered around 1.0 +! + END IF +! +! +! 1.3.1 To compute the partial integration of snow gamma function +! +! 1.3.1.0 allocations +! + ALLOCATE(ZVEC1_S(ICIBU)) + ALLOCATE(ZVEC1_S1(ICIBU)) + ALLOCATE(ZVEC1_S2(ICIBU)) + ALLOCATE(ZVEC1_S3(ICIBU)) + ALLOCATE(ZVEC1_S4(ICIBU)) + ALLOCATE(ZVEC1_S11(ICIBU)) + ALLOCATE(ZVEC1_S12(ICIBU)) + ALLOCATE(ZVEC1_S21(ICIBU)) + ALLOCATE(ZVEC1_S22(ICIBU)) + ALLOCATE(ZVEC1_S31(ICIBU)) + ALLOCATE(ZVEC1_S32(ICIBU)) + ALLOCATE(ZVEC1_S41(ICIBU)) + ALLOCATE(ZVEC1_S42(ICIBU)) + ALLOCATE(ZVEC2_S1(ICIBU)) + ALLOCATE(IVEC2_S1(ICIBU)) + ALLOCATE(ZVEC2_S2(ICIBU)) + ALLOCATE(IVEC2_S2(ICIBU)) +! +! +! 1.3.1.1 select the PLBDAS +! + ZVEC1_S(:) = PACK( PLBDAS(:),MASK=GCIBU(:) ) +! +! +! 1.3.1.2 find the next lower indice for the PLBDAS in the +! geometrical set of Lbda_s used to tabulate some moments of the +! incomplete gamma function, for boundary 1 (0.2 mm) +! + ZVEC2_S1(1:ICIBU) = MAX( 1.0001, MIN( FLOAT(NGAMINC)-0.0001,XCIBUINTP_S & + * LOG( ZVEC1_S(1:ICIBU) ) + XCIBUINTP1_S ) ) + IVEC2_S1(1:ICIBU) = INT( ZVEC2_S1(1:ICIBU) ) + ZVEC2_S1(1:ICIBU) = ZVEC2_S1(1:ICIBU) - FLOAT( IVEC2_S1(1:ICIBU) ) +! +! +! 1.3.1.3 find the next lower indice for the PLBDAS in the +! geometrical set of Lbda_s used to tabulate some moments of the +! incomplete gamma function, for boundary 2 (1 mm) +! + ZVEC2_S2(1:ICIBU) = MAX( 1.0001, MIN( FLOAT(NGAMINC)-0.0001,XCIBUINTP_S & + * LOG( ZVEC1_S(1:ICIBU) ) + XCIBUINTP2_S ) ) + IVEC2_S2(1:ICIBU) = INT( ZVEC2_S2(1:ICIBU) ) + ZVEC2_S2(1:ICIBU) = ZVEC2_S2(1:ICIBU) - FLOAT( IVEC2_S2(1:ICIBU) ) +! +! +! 1.3.1.4 perform the linear interpolation of the +! normalized "0"-moment of the incomplete gamma function +! +! For lower boundary (0.2 mm) + ZVEC1_S11(1:ICIBU) = XGAMINC_CIBU_S(1,IVEC2_S1(1:ICIBU)+1) * ZVEC2_S1(1:ICIBU) & + - XGAMINC_CIBU_S(1,IVEC2_S1(1:ICIBU)) * (ZVEC2_S1(1:ICIBU)-1.0) +! +! For upper boundary (1 mm) + ZVEC1_S12(1:ICIBU) = XGAMINC_CIBU_S(1,IVEC2_S2(1:ICIBU)+1) * ZVEC2_S2(1:ICIBU) & + - XGAMINC_CIBU_S(1,IVEC2_S2(1:ICIBU)) * (ZVEC2_S2(1:ICIBU)-1.0) +! +! Computation of spectrum from 0.2 mm to 1 mm + ZVEC1_S1(1:ICIBU) = ZVEC1_S12(1:ICIBU) - ZVEC1_S11(1:ICIBU) +! +! +! 1.3.1.5 perform the linear interpolation of the +! normalized "XDS"-moment of the incomplete gamma function +! +! For lower boundary (0.2 mm) + ZVEC1_S21(1:ICIBU) = XGAMINC_CIBU_S(2,IVEC2_S1(1:ICIBU)+1) * ZVEC2_S1(1:ICIBU) & + - XGAMINC_CIBU_S(2,IVEC2_S1(1:ICIBU)) * (ZVEC2_S1(1:ICIBU)-1.0) +! +! For upper boundary (1 mm) + ZVEC1_S22(1:ICIBU) = XGAMINC_CIBU_S(2,IVEC2_S2(1:ICIBU)+1) * ZVEC2_S2(1:ICIBU) & + - XGAMINC_CIBU_S(2,IVEC2_S2(1:ICIBU)) * (ZVEC2_S2(1:ICIBU)-1.0) +! +! From 0.2 mm to 1 mm we need + ZVEC1_S2(1:ICIBU) = XMOMGS_CIBU_1 * (ZVEC1_S22(1:ICIBU) - ZVEC1_S21(1:ICIBU)) +! +! For lower boundary (0.2 mm) + ZVEC1_S31(1:ICIBU) = XGAMINC_CIBU_S(3,IVEC2_S1(1:ICIBU)+1) * ZVEC2_S1(1:ICIBU) & + - XGAMINC_CIBU_S(3,IVEC2_S1(1:ICIBU)) * (ZVEC2_S1(1:ICIBU)-1.0) +! +! For upper boundary (1 mm) + ZVEC1_S32(1:ICIBU) = XGAMINC_CIBU_S(3,IVEC2_S2(1:ICIBU)+1) * ZVEC2_S2(1:ICIBU) & + - XGAMINC_CIBU_S(3,IVEC2_S2(1:ICIBU)) * (ZVEC2_S2(1:ICIBU)-1.0) +! +! From 0.2 mm to 1 mm we need + ZVEC1_S3(1:ICIBU) = XMOMGS_CIBU_2 * (ZVEC1_S32(1:ICIBU) - ZVEC1_S31(1:ICIBU)) +! +! +! 1.3.1.6 perform the linear interpolation of the +! normalized "XBS+XDS"-moment of the incomplete gamma function +! +! For lower boundary (0.2 mm) + ZVEC1_S41(1:ICIBU) = XGAMINC_CIBU_S(4,IVEC2_S1(1:ICIBU)+1) * ZVEC2_S1(1:ICIBU) & + - XGAMINC_CIBU_S(4,IVEC2_S1(1:ICIBU)) * (ZVEC2_S1(1:ICIBU)-1.0) +! +! For upper boundary (1 mm) + ZVEC1_S42(1:ICIBU) = XGAMINC_CIBU_S(4,IVEC2_S2(1:ICIBU)+1) * ZVEC2_S2(1:ICIBU) & + - XGAMINC_CIBU_S(4,IVEC2_S2(1:ICIBU)) * (ZVEC2_S2(1:ICIBU)-1.0) +! +! From 0.2 mm to 1 mm we need + ZVEC1_S4(1:ICIBU) = XMOMGS_CIBU_3 * (ZVEC1_S42(1:ICIBU) - ZVEC1_S41(1:ICIBU)) +! + ALLOCATE(ZINTG_SNOW_1(SIZE(PZT))) + ALLOCATE(ZINTG_SNOW_2(SIZE(PZT))) + ALLOCATE(ZINTG_SNOW_3(SIZE(PZT))) + ALLOCATE(ZINTG_SNOW_4(SIZE(PZT))) +! + ZINTG_SNOW_1(:) = UNPACK ( VECTOR=ZVEC1_S1(:),MASK=GCIBU,FIELD=0.0 ) + ZINTG_SNOW_2(:) = UNPACK ( VECTOR=ZVEC1_S2(:),MASK=GCIBU,FIELD=0.0 ) + ZINTG_SNOW_3(:) = UNPACK ( VECTOR=ZVEC1_S3(:),MASK=GCIBU,FIELD=0.0 ) + ZINTG_SNOW_4(:) = UNPACK ( VECTOR=ZVEC1_S4(:),MASK=GCIBU,FIELD=0.0 ) +! +! +! 1.3.2 Compute the partial integration of graupel gamma function +! +! 1.3.2.0 allocations +! + ALLOCATE(ZVEC1_G(ICIBU)) + ALLOCATE(ZVEC1_G1(ICIBU)) + ALLOCATE(ZVEC1_G2(ICIBU)) + ALLOCATE(ZVEC2_G(ICIBU)) + ALLOCATE(IVEC2_G(ICIBU)) +! +! +! 1.3.2.1 select the PLBDAG +! + ZVEC1_G(:) = PACK( PLBDAG(:),MASK=GCIBU(:) ) +! +! +! 1.3.2.2 find the next lower indice for the PLBDAG in the +! geometrical set of Lbda_g used to tabulate some moments of the +! incomplete gamma function, for the "2mm" boundary +! + ZVEC2_G(1:ICIBU) = MAX( 1.0001, MIN( FLOAT(NGAMINC)-0.0001,XCIBUINTP_G & + * LOG( ZVEC1_G(1:ICIBU) ) + XCIBUINTP1_G ) ) + IVEC2_G(1:ICIBU) = INT( ZVEC2_G(1:ICIBU) ) + ZVEC2_G(1:ICIBU) = ZVEC2_G(1:ICIBU) - FLOAT( IVEC2_G(1:ICIBU) ) +! +! +! 1.3.2.3 perform the linear interpolation of the +! normalized "2+XDG"-moment of the incomplete gamma function +! + ZVEC1_G1(1:ICIBU) = XGAMINC_CIBU_G(1,IVEC2_G(1:ICIBU)+1) * ZVEC2_G(1:ICIBU) & + - XGAMINC_CIBU_G(1,IVEC2_G(1:ICIBU)) * (ZVEC2_G(1:ICIBU)-1.0) +! +! From 2 mm to infinity we need + ZVEC1_G1(1:ICIBU) = XMOMGG_CIBU_1 * (1.0 - ZVEC1_G1(1:ICIBU)) +! +! +! 1.3.2.4 perform the linear interpolation of the +! normalized "2.0"-moment of the incomplete gamma function +! + ZVEC1_G2(1:ICIBU) = XGAMINC_CIBU_G(2,IVEC2_G(1:ICIBU)+1) * ZVEC2_G(1:ICIBU) & + - XGAMINC_CIBU_G(2,IVEC2_G(1:ICIBU)) * (ZVEC2_G(1:ICIBU)-1.0) +! +! From 2 mm to infinity we need + ZVEC1_G2(1:ICIBU) = XMOMGG_CIBU_2 * (1.0 - ZVEC1_G2(1:ICIBU)) +! +! + ALLOCATE(ZINTG_GRAUPEL_1(SIZE(PZT))) + ALLOCATE(ZINTG_GRAUPEL_2(SIZE(PZT))) +! + ZINTG_GRAUPEL_1(:) = UNPACK ( VECTOR=ZVEC1_G1(:),MASK=GCIBU,FIELD=0.0 ) + ZINTG_GRAUPEL_2(:) = UNPACK ( VECTOR=ZVEC1_G2(:),MASK=GCIBU,FIELD=0.0 ) +! +! +! 1.3.3 To compute final "CIBU" contributions +! + ALLOCATE(ZNI_CIBU(SIZE(PZT))) + ALLOCATE(ZFRAG_CIBU(SIZE(PZT))) +! + ZFRAG_CIBU(:) = UNPACK ( VECTOR=ZFRAGMENTS(:),MASK=GCIBU,FIELD=0.0 ) + ZNI_CIBU(:) = ZFRAG_CIBU(:) * (XFACTOR_CIBU_NI / (PRHODREF(:)**(XCEXVT-1.0))) * & + (XCG * ZINTG_GRAUPEL_1(:) * ZINTG_SNOW_1(:) * & + PLBDAS(:)**(XCXS) * PLBDAG(:)**(XCXG-(XDG+2.0)) & + - XCS * ZINTG_GRAUPEL_2(:) * ZINTG_SNOW_2(:) * & + PLBDAS(:)**(XCXS-XDS) * PLBDAG(:)**(XCXG-2.0) ) + PCIS1D(:) = PCIS1D(:) + MAX(ZNI_CIBU(:), 0.) +! + DEALLOCATE(ZFRAG_CIBU) + DEALLOCATE(ZFRAGMENTS) +! +! Max value of rs removed by CIBU + ALLOCATE(ZRI_CIBU(SIZE(PZT))) + ZRI_CIBU(:) = (XFACTOR_CIBU_RI / (PRHODREF(:)**(XCEXVT+1.0))) * & + (XCG * ZINTG_GRAUPEL_1(:) * ZINTG_SNOW_3(:) * & + PLBDAS(:)**(XCXS-XBS) * PLBDAG(:)**(XCXG-(XDG+2.0)) & + - XCS * ZINTG_GRAUPEL_2(:) * ZINTG_SNOW_4(:) * & + PLBDAS(:)**(XCXS-(XBS+XDS)) * PLBDAG(:)**(XCXG-2.0)) +! +! The value of rs removed by CIBU is determined by the mean mass of pristine ice + WHERE( PRIT1D(:)>XRTMIN(4) .AND. PCIT1D(:)>XCTMIN(4) ) + ZRI_CIBU(:) = MIN( ZRI_CIBU(:), PRSS1D(:), ZNI_CIBU(:)*PRIT1D(:)/PCIT1D(:) ) + ELSE WHERE + ZRI_CIBU(:) = MIN( ZRI_CIBU(:), PRSS1D(:), MAX( ZNI_CIBU(:)*XMNU0,XRTMIN(4) ) ) + END WHERE +! + PRIS1D(:) = PRIS1D(:) + MAX(ZRI_CIBU(:), 0.) ! + PRSS1D(:) = PRSS1D(:) - MAX(ZRI_CIBU(:), 0.) ! +! + DEALLOCATE(ZVEC1_S) + DEALLOCATE(ZVEC1_S1) + DEALLOCATE(ZVEC1_S2) + DEALLOCATE(ZVEC1_S3) + DEALLOCATE(ZVEC1_S4) + DEALLOCATE(ZVEC1_S11) + DEALLOCATE(ZVEC1_S12) + DEALLOCATE(ZVEC1_S21) + DEALLOCATE(ZVEC1_S22) + DEALLOCATE(ZVEC1_S31) + DEALLOCATE(ZVEC1_S32) + DEALLOCATE(ZVEC1_S41) + DEALLOCATE(ZVEC1_S42) + DEALLOCATE(ZVEC2_S1) + DEALLOCATE(IVEC2_S1) + DEALLOCATE(ZVEC2_S2) + DEALLOCATE(IVEC2_S2) + DEALLOCATE(ZVEC1_G) + DEALLOCATE(ZVEC1_G1) + DEALLOCATE(ZVEC1_G2) + DEALLOCATE(ZVEC2_G) + DEALLOCATE(IVEC2_G) + DEALLOCATE(ZINTG_SNOW_1) + DEALLOCATE(ZINTG_SNOW_2) + DEALLOCATE(ZINTG_SNOW_3) + DEALLOCATE(ZINTG_SNOW_4) + DEALLOCATE(ZINTG_GRAUPEL_1) + DEALLOCATE(ZINTG_GRAUPEL_2) + DEALLOCATE(ZNI_CIBU) + DEALLOCATE(ZRI_CIBU) + ! + ! Budget storage + if ( nbumod == kmi .and. lbu_enable ) then + if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CIBU', & + Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) + if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'CIBU', & + Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) + if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CIBU', & + Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) + end if +END IF +! +! +!* 1.4 Rain accretion onto the aggregates ! --------------------------------------- ! ! ZZW1(:,2:3) = 0.0 -GACC(:) = (ZRRT(:)>XRTMIN(3)) .AND. (ZRST(:)>XRTMIN(5)) .AND. (ZRRS(:)>XRTMIN(3)/PTSTEP) .AND. (ZZT(:)<XTT) +GACC(:) = (PRRT1D(:)>XRTMIN(3)) .AND. (PRST1D(:)>XRTMIN(5)) .AND. (PRRS1D(:)>XRTMIN(3)/PTSTEP) .AND. (PZT(:)<XTT) IGACC = COUNT( GACC(:) ) ! IF( IGACC>0 .AND. LRAIN) THEN ! Budget storage if ( nbumod == kmi .and. lbu_enable ) then if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'ACC', & - Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'ACC', & - Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'ACC', & - Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'ACC', & - Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'ACC', & - Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) end if ! -! 1.3.0 allocations +! 1.4.0 allocations ! - ALLOCATE(ZVEC1(IGACC)) - ALLOCATE(ZVEC2(IGACC)) - ALLOCATE(ZVEC3(IGACC)) - ALLOCATE(IVEC1(IGACC)) - ALLOCATE(IVEC2(IGACC)) + ALLOCATE(ZVEC1(IGACC)) + ALLOCATE(ZVEC2(IGACC)) + ALLOCATE(ZVEC3(IGACC)) + ALLOCATE(IVEC1(IGACC)) + ALLOCATE(IVEC2(IGACC)) ! -! 1.3.1 select the (ZLBDAS,ZLBDAR) couplet +! 1.4.1 select the (PLBDAS,PLBDAR) couplet ! - ZVEC1(:) = PACK( ZLBDAS(:),MASK=GACC(:) ) - ZVEC2(:) = PACK( ZLBDAR(:),MASK=GACC(:) ) + ZVEC1(:) = PACK( PLBDAS(:),MASK=GACC(:) ) + ZVEC2(:) = PACK( PLBDAR(:),MASK=GACC(:) ) ! -! 1.3.2 find the next lower indice for the ZLBDAS and for the ZLBDAR +! 1.4.2 find the next lower indice for the PLBDAS and for the PLBDAR ! in the geometrical set of (Lbda_s,Lbda_r) couplet use to ! tabulate the RACCSS-kernel ! - ZVEC1(1:IGACC) = MAX( 1.0001, MIN( REAL(NACCLBDAS)-0.0001, & - XACCINTP1S * LOG( ZVEC1(1:IGACC) ) + XACCINTP2S ) ) - IVEC1(1:IGACC) = INT( ZVEC1(1:IGACC) ) - ZVEC1(1:IGACC) = ZVEC1(1:IGACC) - REAL( IVEC1(1:IGACC) ) + ZVEC1(1:IGACC) = MAX( 1.0001, MIN( REAL(NACCLBDAS)-0.0001, & + XACCINTP1S * LOG( ZVEC1(1:IGACC) ) + XACCINTP2S ) ) + IVEC1(1:IGACC) = INT( ZVEC1(1:IGACC) ) + ZVEC1(1:IGACC) = ZVEC1(1:IGACC) - REAL( IVEC1(1:IGACC) ) ! - ZVEC2(1:IGACC) = MAX( 1.0001, MIN( REAL(NACCLBDAR)-0.0001, & - XACCINTP1R * LOG( ZVEC2(1:IGACC) ) + XACCINTP2R ) ) - IVEC2(1:IGACC) = INT( ZVEC2(1:IGACC) ) - ZVEC2(1:IGACC) = ZVEC2(1:IGACC) - REAL( IVEC2(1:IGACC) ) + ZVEC2(1:IGACC) = MAX( 1.0001, MIN( REAL(NACCLBDAR)-0.0001, & + XACCINTP1R * LOG( ZVEC2(1:IGACC) ) + XACCINTP2R ) ) + IVEC2(1:IGACC) = INT( ZVEC2(1:IGACC) ) + ZVEC2(1:IGACC) = ZVEC2(1:IGACC) - REAL( IVEC2(1:IGACC) ) ! -! 1.3.3 perform the bilinear interpolation of the normalized +! 1.4.3 perform the bilinear interpolation of the normalized ! RACCSS-kernel ! - DO JJ = 1,IGACC - ZVEC3(JJ) = ( XKER_RACCSS(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) & - - XKER_RACCSS(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) & - * ZVEC1(JJ) & - - ( XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) & - - XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) & - * (ZVEC1(JJ) - 1.0) - END DO - ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GACC,FIELD=0.0 ) -! -! 1.3.4 raindrop accretion on the small sized aggregates -! - WHERE ( GACC(:) ) - ZZW1(:,2) = ZCRT(:) * & !! coef of RRACCS - XFRACCSS*( ZLBDAS(:)**XCXS )*( ZRHODREF(:)**(-XCEXVT-1.) ) & - *( XLBRACCS1/((ZLBDAS(:)**2) ) + & - XLBRACCS2/( ZLBDAS(:) * ZLBDAR(:) ) + & - XLBRACCS3/( (ZLBDAR(:)**2)) )/ZLBDAR(:)**3 - ZZW1(:,4) = MIN( ZRRS(:),ZZW1(:,2)*ZZW(:) ) ! RRACCSS - ZRRS(:) = ZRRS(:) - ZZW1(:,4) - ZRSS(:) = ZRSS(:) + ZZW1(:,4) - ZTHS(:) = ZTHS(:) + ZZW1(:,4)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RRACCSS)) -! - ZCRS(:) = MAX( ZCRS(:)-ZZW1(:,4)*(ZCRT(:)/ZRRT(:)),0.0 ) ! Lambda_r**3 - END WHERE -! -! 1.3.4b perform the bilinear interpolation of the normalized + DO JJ = 1,IGACC + ZVEC3(JJ) = ( XKER_RACCSS(IVEC1(JJ)+1,IVEC2(JJ)+1) * ZVEC2(JJ) & + - XKER_RACCSS(IVEC1(JJ)+1,IVEC2(JJ) ) * (ZVEC2(JJ) - 1.0) ) & + * ZVEC1(JJ) & + - ( XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ)+1) * ZVEC2(JJ) & + - XKER_RACCSS(IVEC1(JJ) ,IVEC2(JJ) ) * (ZVEC2(JJ) - 1.0) ) & + * (ZVEC1(JJ) - 1.0) + END DO + ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GACC,FIELD=0.0 ) +! +! 1.4.4 raindrop accretion on the small sized aggregates +! + WHERE ( GACC(:) ) + ZZW1(:,2) = PCRT1D(:) * & !! coef of RRACCS + XFRACCSS*( PLBDAS(:)**XCXS )*( PRHODREF(:)**(-XCEXVT-1.) ) & + *( XLBRACCS1/((PLBDAS(:)**2) ) + & + XLBRACCS2/( PLBDAS(:) * PLBDAR(:) ) + & + XLBRACCS3/( (PLBDAR(:)**2)) )/PLBDAR(:)**3 + ZZW1(:,4) = MIN( PRRS1D(:),ZZW1(:,2)*ZZW(:) ) ! RRACCSS + PRRS1D(:) = PRRS1D(:) - ZZW1(:,4) + PRSS1D(:) = PRSS1D(:) + ZZW1(:,4) + PTHS1D(:) = PTHS1D(:) + ZZW1(:,4) * (PLSFACT(:) - PLVFACT(:)) ! f(L_f*(RRACCSS)) +! + PCRS1D(:) = MAX( PCRS1D(:)-ZZW1(:,4)*(PCRT1D(:)/PRRT1D(:)),0.0 ) ! Lambda_r**3 + END WHERE +! +! 1.4.4b perform the bilinear interpolation of the normalized ! RACCS-kernel ! - DO JJ = 1,IGACC - ZVEC3(JJ) = ( XKER_RACCS(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) & - - XKER_RACCS(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) & - * ZVEC1(JJ) & - - ( XKER_RACCS(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) & - - XKER_RACCS(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) & - * (ZVEC1(JJ) - 1.0) - END DO - ZZW1(:,2) = ZZW1(:,2)*UNPACK( VECTOR=ZVEC3(:),MASK=GACC(:),FIELD=0.0 ) !! RRACCS -! -! 1.3.5 perform the bilinear interpolation of the normalized + DO JJ = 1,IGACC + ZVEC3(JJ) = ( XKER_RACCS(IVEC1(JJ)+1,IVEC2(JJ)+1) * ZVEC2(JJ) & + - XKER_RACCS(IVEC1(JJ)+1,IVEC2(JJ) ) * (ZVEC2(JJ) - 1.0) ) & + * ZVEC1(JJ) & + - ( XKER_RACCS(IVEC1(JJ) ,IVEC2(JJ)+1) * ZVEC2(JJ) & + - XKER_RACCS(IVEC1(JJ) ,IVEC2(JJ) ) * (ZVEC2(JJ) - 1.0) ) & + * (ZVEC1(JJ) - 1.0) + END DO + ZZW1(:,2) = ZZW1(:,2)*UNPACK( VECTOR=ZVEC3(:),MASK=GACC(:),FIELD=0.0 ) !! RRACCS +! +! 1.4.5 perform the bilinear interpolation of the normalized ! SACCRG-kernel ! - DO JJ = 1,IGACC - ZVEC3(JJ) = ( XKER_SACCRG(IVEC2(JJ)+1,IVEC1(JJ)+1)* ZVEC1(JJ) & - - XKER_SACCRG(IVEC2(JJ)+1,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) & - * ZVEC2(JJ) & - - ( XKER_SACCRG(IVEC2(JJ) ,IVEC1(JJ)+1)* ZVEC1(JJ) & - - XKER_SACCRG(IVEC2(JJ) ,IVEC1(JJ) )*(ZVEC1(JJ) - 1.0) ) & - * (ZVEC2(JJ) - 1.0) - END DO - ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GACC,FIELD=0.0 ) -! -! 1.3.6 raindrop accretion-conversion of the large sized aggregates + DO JJ = 1,IGACC + ZVEC3(JJ) = ( XKER_SACCRG(IVEC2(JJ)+1,IVEC1(JJ)+1) * ZVEC1(JJ) & + - XKER_SACCRG(IVEC2(JJ)+1,IVEC1(JJ) ) * (ZVEC1(JJ) - 1.0) ) & + * ZVEC2(JJ) & + - ( XKER_SACCRG(IVEC2(JJ) ,IVEC1(JJ)+1) * ZVEC1(JJ) & + - XKER_SACCRG(IVEC2(JJ) ,IVEC1(JJ) ) * (ZVEC1(JJ) - 1.0) ) & + * (ZVEC2(JJ) - 1.0) + END DO + ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GACC,FIELD=0.0 ) +! +! 1.4.6 raindrop accretion-conversion of the large sized aggregates ! into graupeln ! - WHERE ( GACC(:) .AND. (ZRSS(:)>XRTMIN(5)/PTSTEP) ) - ZZW1(:,2) = MAX( MIN( ZRRS(:),ZZW1(:,2)-ZZW1(:,4) ) , 0. ) ! RRACCSG - ZZW1(:,3) = MIN( ZRSS(:),XFSACCRG*ZZW(:)* & ! RSACCRG - ( ZLBDAS(:)**(XCXS-XBS) )*( ZRHODREF(:)**(-XCEXVT-1.) ) & - *( XLBSACCR1/((ZLBDAR(:)**2) ) + & - XLBSACCR2/( ZLBDAR(:) * ZLBDAS(:) ) + & - XLBSACCR3/( (ZLBDAS(:)**2)) ) ) - ZRRS(:) = ZRRS(:) - ZZW1(:,2) - ZRSS(:) = ZRSS(:) - ZZW1(:,3) - ZRGS(:) = ZRGS(:) + ZZW1(:,2)+ZZW1(:,3) - ZTHS(:) = ZTHS(:) + ZZW1(:,2)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(RRACCSG)) -! - ZCRS(:) = MAX( ZCRS(:)-ZZW1(:,2)*(ZCRT(:)/ZRRT(:)),0.0 ) ! Lambda_r**3 - END WHERE - DEALLOCATE(IVEC2) - DEALLOCATE(IVEC1) - DEALLOCATE(ZVEC3) - DEALLOCATE(ZVEC2) - DEALLOCATE(ZVEC1) - + WHERE ( GACC(:) .AND. (PRSS1D(:)>XRTMIN(5)/PTSTEP) ) + ZZW1(:,2) = MAX( MIN( PRRS1D(:),ZZW1(:,2)-ZZW1(:,4) ) , 0. ) ! RRACCSG + ZZW1(:,3) = MIN( PRSS1D(:),XFSACCRG*ZZW(:)* & ! RSACCRG + ( PLBDAS(:)**(XCXS-XBS) )*( PRHODREF(:)**(-XCEXVT-1.) ) & + *( XLBSACCR1/((PLBDAR(:)**2) ) + & + XLBSACCR2/( PLBDAR(:) * PLBDAS(:) ) + & + XLBSACCR3/( (PLBDAS(:)**2)) ) ) + PRRS1D(:) = PRRS1D(:) - ZZW1(:,2) + PRSS1D(:) = PRSS1D(:) - ZZW1(:,3) + PRGS1D(:) = PRGS1D(:) + ZZW1(:,2) + ZZW1(:,3) + PTHS1D(:) = PTHS1D(:) + ZZW1(:,2) * (PLSFACT(:) - PLVFACT(:)) ! f(L_f*(RRACCSG)) +! + PCRS1D(:) = MAX( PCRS1D(:)-ZZW1(:,2)*(PCRT1D(:)/PRRT1D(:)),0.0 ) ! Lambda_r**3 + END WHERE + DEALLOCATE(IVEC2) + DEALLOCATE(IVEC1) + DEALLOCATE(ZVEC3) + DEALLOCATE(ZVEC2) + DEALLOCATE(ZVEC1) + ! ! Budget storage if ( nbumod == kmi .and. lbu_enable ) then if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'ACC', & - Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'ACC', & - Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'ACC', & - Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'ACC', & - Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'ACC', & - Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) end if END IF ! -!* 1.4 Conversion-Melting of the aggregates +! +!* 1.5 Conversion-Melting of the aggregates ! ----------------------------------------- ! if ( nbumod == kmi .and. lbu_enable ) then if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'CMEL', & - Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'CMEL', & - Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) end if - +! ZZW(:) = 0.0 -WHERE( (ZRST(:)>XRTMIN(5)) .AND. (ZRSS(:)>XRTMIN(5)/PTSTEP) .AND. (ZZT(:)>XTT) ) - ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure - ZZW(:) = ZKA(:)*(XTT-ZZT(:)) + & - ( ZDV(:)*(XLVTT + ( XCPV - XCL ) * ( ZZT(:) - XTT )) & - *(XESTT-ZZW(:))/(XRV*ZZT(:)) ) +WHERE( (PRST1D(:)>XRTMIN(5)) .AND. (PRSS1D(:)>XRTMIN(5)/PTSTEP) .AND. (PZT(:)>XTT) ) + ZZW(:) = PRVT1D(:) * PPRES(:) / ((XMV / XMD) + PRVT1D(:)) ! Vapor pressure + ZZW(:) = PKA(:) * (XTT - PZT(:)) + & + ( PDV(:) * (XLVTT + ( XCPV - XCL ) * ( PZT(:) - XTT )) & + * (XESTT-ZZW(:))/(XRV*PZT(:)) ) ! ! compute RSMLT ! - ZZW(:) = MIN( ZRSS(:), XFSCVMG*MAX( 0.0,( -ZZW(:) * & - ( X0DEPS* ZLBDAS(:)**XEX0DEPS + & - X1DEPS*ZCJ(:)*ZLBDAS(:)**XEX1DEPS ) - & - ( ZZW1(:,1)+ZZW1(:,4) ) * & - ( ZRHODREF(:)*XCL*(XTT-ZZT(:))) ) / & - ( ZRHODREF(:)*XLMTT ) ) ) + ZZW(:) = MIN( PRSS1D(:), XFSCVMG*MAX( 0.0,( -ZZW(:) * & + ( X0DEPS* PLBDAS(:)**XEX0DEPS + & + X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS ) - & + ( ZZW1(:,1)+ZZW1(:,4) ) * & + ( PRHODREF(:)*XCL*(XTT-PZT(:))) ) / & + ( PRHODREF(:)*XLMTT ) ) ) ! ! note that RSCVMG = RSMLT*XFSCVMG but no heat is exchanged (at the rate RSMLT) ! because the graupeln produced by this process are still icy!!! ! - ZRSS(:) = ZRSS(:) - ZZW(:) - ZRGS(:) = ZRGS(:) + ZZW(:) + PRSS1D(:) = PRSS1D(:) - ZZW(:) + PRGS1D(:) = PRGS1D(:) + ZZW(:) END WHERE ! ! Budget storage if ( nbumod == kmi .and. lbu_enable ) then if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'CMEL', & - Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'CMEL', & - Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) end if END IF SNOW @@ -608,311 +956,395 @@ END IF SNOW ! if ( nbumod == kmi .and. lbu_enable ) then if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'CFRZ', & - Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'CFRZ', & - Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CFRZ', & - Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'CFRZ', & - Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'CFRZ', & - Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CFRZ', & - Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) end if ZZW1(:,3:4) = 0.0 -WHERE( (ZRIT(:)>XRTMIN(4)) .AND. (ZRRT(:)>XRTMIN(3)) .AND. (ZRIS(:)>XRTMIN(4)/PTSTEP) .AND. (ZRRS(:)>XRTMIN(3)/PTSTEP) ) - ZZW1(:,3) = MIN( ZRIS(:),XICFRR * ZRIT(:) * ZCRT(:) & ! RICFRRG - * ZLBDAR(:)**XEXICFRR & - * ZRHODREF(:)**(-XCEXVT-1.0) ) -! - ZZW1(:,4) = MIN( ZRRS(:),XRCFRI * ZCIT(:) * ZCRT(:) & ! RRCFRIG - * ZLBDAR(:)**XEXRCFRI & - * ZRHODREF(:)**(-XCEXVT-2.0) ) - ZRIS(:) = ZRIS(:) - ZZW1(:,3) - ZRRS(:) = ZRRS(:) - ZZW1(:,4) - ZRGS(:) = ZRGS(:) + ZZW1(:,3)+ZZW1(:,4) - ZTHS(:) = ZTHS(:) + ZZW1(:,4)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*RRCFRIG) -! - ZCIS(:) = MAX( ZCIS(:)-ZZW1(:,3)*(ZCIT(:)/ZRIT(:)),0.0 ) ! CICFRRG - ZCRS(:) = MAX( ZCRS(:)-ZZW1(:,4)*(ZCRT(:)/ZRRT(:)),0.0 ) ! CRCFRIG +WHERE( (PRIT1D(:)>XRTMIN(4)) .AND. (PRRT1D(:)>XRTMIN(3)) .AND. (PRIS1D(:)>XRTMIN(4)/PTSTEP) .AND. (PRRS1D(:)>XRTMIN(3)/PTSTEP) ) + ZZW1(:,3) = MIN( PRIS1D(:),XICFRR * PRIT1D(:) * PCRT1D(:) & ! RICFRRG + * PLBDAR(:)**XEXICFRR & + * PRHODREF(:)**(-XCEXVT-1.0) ) +! + ZZW1(:,4) = MIN( PRRS1D(:),XRCFRI * PCIT1D(:) * PCRT1D(:) & ! RRCFRIG + * PLBDAR(:)**XEXRCFRI & + * PRHODREF(:)**(-XCEXVT-2.0) ) + PRIS1D(:) = PRIS1D(:) - ZZW1(:,3) + PRRS1D(:) = PRRS1D(:) - ZZW1(:,4) + PRGS1D(:) = PRGS1D(:) + ZZW1(:,3) + ZZW1(:,4) + PTHS1D(:) = PTHS1D(:) + ZZW1(:,4) * (PLSFACT(:) - PLVFACT(:)) ! f(L_f*RRCFRIG) +! + PCIS1D(:) = MAX( PCIS1D(:)-ZZW1(:,3)*(PCIT1D(:)/PRIT1D(:)),0.0 ) ! CICFRRG + PCRS1D(:) = MAX( PCRS1D(:)-ZZW1(:,4)*(PCRT1D(:)/PRRT1D(:)),0.0 ) ! CRCFRIG END WHERE - +! if ( nbumod == kmi .and. lbu_enable ) then if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'CFRZ', & - Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'CFRZ', & - Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CFRZ', & - Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'CFRZ', & - Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'CFRZ', & - Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CFRZ', & - Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) end if ! -!* 2.2 Compute the Dry growth case +! +!* 2.2 Ice multiplication process following rain contact freezing +! --------------------------------------------------------------- +! +GRDSF(:) = LRDSF .AND. (PRIT1D(:)>0.0) .AND. (PRRT1D(:)>0.0) .AND. & + (PRIS1D(:)>0.0) .AND. (PRRS1D(:)>0.0) +IRDSF = COUNT( GRDSF(:) ) +! +IF (IRDSF > 0) THEN +! + ! Budget storage + if ( nbumod == kmi .and. lbu_enable ) then + if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'RDSF', & + Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) + if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'RDSF', & + Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) + if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'RDSF', & + Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) + end if +! + ALLOCATE(ZVEC1_R(IRDSF)) + ALLOCATE(ZVEC1_R1(IRDSF)) + ALLOCATE(ZVEC2_R(IRDSF)) + ALLOCATE(IVEC2_R(IRDSF)) +! +!* 2.2.1 select the ZLBDAR +! + ZVEC1_R(:) = PACK( PLBDAR(:),MASK=GRDSF(:) ) +! +!* 2.2.2 find the next lower indice for the ZLBDAR in the +! geometrical set of Lbda_r used to tabulate some moments of the +! incomplete gamma function, for the lower boundary (0.1 mm) +! + ZVEC2_R(1:IRDSF) = MAX( 1.00001, MIN( FLOAT(NGAMINC)-0.00001,XRDSFINTP_R & + * LOG( ZVEC1_R(1:IRDSF) ) + XRDSFINTP1_R ) ) + IVEC2_R(1:IRDSF) = INT( ZVEC2_R(1:IRDSF) ) + ZVEC2_R(1:IRDSF) = ZVEC2_R(1:IRDSF) - FLOAT( IVEC2_R(1:IRDSF) ) +! +!* 2.2.3 perform the linear interpolation of the +! normalized "2+XDR"-moment of the incomplete gamma function +! + ZVEC1_R1(1:IRDSF) = XGAMINC_RDSF_R(IVEC2_R(1:IRDSF)+1) * ZVEC2_R(1:IRDSF) & + - XGAMINC_RDSF_R(IVEC2_R(1:IRDSF)) * (ZVEC2_R(1:IRDSF) - 1.0) +! +! From 0.1 mm to infinity we need + ZVEC1_R1(1:IRDSF) = XMOMGR_RDSF * (1.0 - ZVEC1_R1(1:IRDSF)) +! + ALLOCATE(ZINTG_RAIN(SIZE(PZT))) + ZINTG_RAIN(:) = UNPACK ( VECTOR=ZVEC1_R1(:),MASK=GRDSF,FIELD=0.0 ) +! +!* 2.2.4 To compute final "RDSF" contributions +! + ALLOCATE(ZNI_RDSF(SIZE(PZT))) + ZNI_RDSF(:) = (XFACTOR_RDSF_NI / (PRHODREF(:)**(XCEXVT-1.0))) * ( & + PCIT1D(:) * PCRT1D(:) * ZINTG_RAIN(:) * PLBDAR(:)**(-(XDR+6.0)) ) +! + PCIS1D(:) = PCIS1D(:) + ZNI_RDSF(:) +! +! The value of rg removed by RDSF is determined by the mean mass of pristine ice + ALLOCATE(ZRI_RDSF(SIZE(PZT))) + ZRI_RDSF(:) = MIN( PRGS1D(:), MAX( ZNI_RDSF(:)*XMNU0,XRTMIN(5) ) ) +! + PRIS1D(:) = PRIS1D(:) + ZRI_RDSF(:) + PRGS1D(:) = PRGS1D(:) - ZRI_RDSF(:) +! + DEALLOCATE(ZINTG_RAIN) + DEALLOCATE(ZVEC1_R) + DEALLOCATE(ZVEC1_R1) + DEALLOCATE(ZVEC2_R) + DEALLOCATE(IVEC2_R) + DEALLOCATE(ZNI_RDSF) + DEALLOCATE(ZRI_RDSF) + ! + ! Budget storage + if ( nbumod == kmi .and. lbu_enable ) then + if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'RDSF', & + Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) + if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RG), 'RDSF', & + Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) + if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'RDSF', & + Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) + end if +ENDIF +! +! +!* 2.3 Compute the Dry growth case ! -------------------------------- +! if ( nbumod == kmi .and. lbu_enable ) then if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'WETG', & - Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'WETG', & - Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prcs1d(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'WETG', & - Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'WETG', & - Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'WETG', & - Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'WETG', & - Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'WETG', & - Unpack( zrhs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prhs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_sv ) then call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'WETG', & - Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pccs1d(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'WETG', & - Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'WETG', & - Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) end if end if ! ZZW1(:,:) = 0.0 -WHERE( ((ZRCT(:)>XRTMIN(2)) .AND. (ZRGT(:)>XRTMIN(6)) .AND. (ZRCS(:)>XRTMIN(2)/PTSTEP)) .OR. & - ((ZRIT(:)>XRTMIN(4)) .AND. (ZRGT(:)>XRTMIN(6)) .AND. (ZRIS(:)>XRTMIN(4)/PTSTEP)) ) - ZZW(:) = ZLBDAG(:)**(XCXG-XDG-2.0) * ZRHODREF(:)**(-XCEXVT) - ZZW1(:,1) = MIN( ZRCS(:),XFCDRYG * ZRCT(:) * ZZW(:) ) ! RCDRYG - ZZW1(:,2) = MIN( ZRIS(:),XFIDRYG * EXP( XCOLEXIG*(ZZT(:)-XTT) ) & - * ZRIT(:) * ZZW(:) ) ! RIDRYG +WHERE( ((PRCT1D(:)>XRTMIN(2)) .AND. (PRGT1D(:)>XRTMIN(6)) .AND. (PRCS1D(:)>XRTMIN(2)/PTSTEP)) .OR. & + ((PRIT1D(:)>XRTMIN(4)) .AND. (PRGT1D(:)>XRTMIN(6)) .AND. (PRIS1D(:)>XRTMIN(4)/PTSTEP)) ) + ZZW(:) = PLBDAG(:)**(XCXG-XDG-2.0) * PRHODREF(:)**(-XCEXVT) + ZZW1(:,1) = MIN( PRCS1D(:),XFCDRYG * PRCT1D(:) * ZZW(:) ) ! RCDRYG + ZZW1(:,2) = MIN( PRIS1D(:),XFIDRYG * EXP( XCOLEXIG*(PZT(:)-XTT) ) & + * PRIT1D(:) * ZZW(:) ) ! RIDRYG END WHERE ! -!* 2.2.1 accretion of aggregates on the graupeln +!* 2.3.1 accretion of aggregates on the graupeln ! ---------------------------------------------- ! -GDRY(:) = (ZRST(:)>XRTMIN(5)) .AND. (ZRGT(:)>XRTMIN(6)) .AND. (ZRSS(:)>XRTMIN(5)/PTSTEP) +GDRY(:) = (PRST1D(:)>XRTMIN(5)) .AND. (PRGT1D(:)>XRTMIN(6)) .AND. (PRSS1D(:)>XRTMIN(5)/PTSTEP) IGDRY = COUNT( GDRY(:) ) ! IF( IGDRY>0 ) THEN ! -!* 2.2.2 allocations +!* 2.3.2 allocations ! - ALLOCATE(ZVEC1(IGDRY)) - ALLOCATE(ZVEC2(IGDRY)) - ALLOCATE(ZVEC3(IGDRY)) - ALLOCATE(IVEC1(IGDRY)) - ALLOCATE(IVEC2(IGDRY)) + ALLOCATE(ZVEC1(IGDRY)) + ALLOCATE(ZVEC2(IGDRY)) + ALLOCATE(ZVEC3(IGDRY)) + ALLOCATE(IVEC1(IGDRY)) + ALLOCATE(IVEC2(IGDRY)) ! -!* 2.2.3 select the (ZLBDAG,ZLBDAS) couplet +!* 2.3.3 select the (PLBDAG,PLBDAS) couplet ! - ZVEC1(:) = PACK( ZLBDAG(:),MASK=GDRY(:) ) - ZVEC2(:) = PACK( ZLBDAS(:),MASK=GDRY(:) ) + ZVEC1(:) = PACK( PLBDAG(:),MASK=GDRY(:) ) + ZVEC2(:) = PACK( PLBDAS(:),MASK=GDRY(:) ) ! -!* 2.2.4 find the next lower indice for the ZLBDAG and for the ZLBDAS +!* 2.3.4 find the next lower indice for the PLBDAG and for the PLBDAS ! in the geometrical set of (Lbda_g,Lbda_s) couplet use to ! tabulate the SDRYG-kernel ! - ZVEC1(1:IGDRY) = MAX( 1.0001, MIN( REAL(NDRYLBDAG)-0.0001, & - XDRYINTP1G * LOG( ZVEC1(1:IGDRY) ) + XDRYINTP2G ) ) - IVEC1(1:IGDRY) = INT( ZVEC1(1:IGDRY) ) - ZVEC1(1:IGDRY) = ZVEC1(1:IGDRY) - REAL( IVEC1(1:IGDRY) ) + ZVEC1(1:IGDRY) = MAX( 1.0001, MIN( REAL(NDRYLBDAG)-0.0001, & + XDRYINTP1G * LOG( ZVEC1(1:IGDRY) ) + XDRYINTP2G ) ) + IVEC1(1:IGDRY) = INT( ZVEC1(1:IGDRY) ) + ZVEC1(1:IGDRY) = ZVEC1(1:IGDRY) - REAL( IVEC1(1:IGDRY) ) ! - ZVEC2(1:IGDRY) = MAX( 1.0001, MIN( REAL(NDRYLBDAS)-0.0001, & - XDRYINTP1S * LOG( ZVEC2(1:IGDRY) ) + XDRYINTP2S ) ) - IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) ) - ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - REAL( IVEC2(1:IGDRY) ) + ZVEC2(1:IGDRY) = MAX( 1.0001, MIN( REAL(NDRYLBDAS)-0.0001, & + XDRYINTP1S * LOG( ZVEC2(1:IGDRY) ) + XDRYINTP2S ) ) + IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) ) + ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - REAL( IVEC2(1:IGDRY) ) ! -!* 2.2.5 perform the bilinear interpolation of the normalized +!* 2.3.5 perform the bilinear interpolation of the normalized ! SDRYG-kernel ! - DO JJ = 1,IGDRY - ZVEC3(JJ) = ( XKER_SDRYG(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) & - - XKER_SDRYG(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) & - * ZVEC1(JJ) & - - ( XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) & - - XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) & - * (ZVEC1(JJ) - 1.0) - END DO - ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GDRY,FIELD=0.0 ) -! - WHERE( GDRY(:) ) - ZZW1(:,3) = MIN( ZRSS(:),XFSDRYG*ZZW(:) & ! RSDRYG - * EXP( XCOLEXSG*(ZZT(:)-XTT) ) & - *( ZLBDAS(:)**(XCXS-XBS) )*( ZLBDAG(:)**XCXG ) & - *( ZRHODREF(:)**(-XCEXVT-1.) ) & - *( XLBSDRYG1/( ZLBDAG(:)**2 ) + & - XLBSDRYG2/( ZLBDAG(:) * ZLBDAS(:) ) + & - XLBSDRYG3/( ZLBDAS(:)**2) ) ) - END WHERE - DEALLOCATE(IVEC2) - DEALLOCATE(IVEC1) - DEALLOCATE(ZVEC3) - DEALLOCATE(ZVEC2) - DEALLOCATE(ZVEC1) + DO JJ = 1,IGDRY + ZVEC3(JJ) = ( XKER_SDRYG(IVEC1(JJ)+1,IVEC2(JJ)+1) * ZVEC2(JJ) & + - XKER_SDRYG(IVEC1(JJ)+1,IVEC2(JJ) ) * (ZVEC2(JJ) - 1.0) ) & + * ZVEC1(JJ) & + - ( XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ)+1) * ZVEC2(JJ) & + - XKER_SDRYG(IVEC1(JJ) ,IVEC2(JJ) ) * (ZVEC2(JJ) - 1.0) ) & + * (ZVEC1(JJ) - 1.0) + END DO + ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GDRY,FIELD=0.0 ) +! + WHERE( GDRY(:) ) + ZZW1(:,3) = MIN( PRSS1D(:),XFSDRYG*ZZW(:) & ! RSDRYG + * EXP( XCOLEXSG*(PZT(:)-XTT) ) & + *( PLBDAS(:)**(XCXS-XBS) )*( PLBDAG(:)**XCXG ) & + *( PRHODREF(:)**(-XCEXVT-1.) ) & + *( XLBSDRYG1/( PLBDAG(:)**2 ) + & + XLBSDRYG2/( PLBDAG(:) * PLBDAS(:) ) + & + XLBSDRYG3/( PLBDAS(:)**2) ) ) + END WHERE + DEALLOCATE(IVEC2) + DEALLOCATE(IVEC1) + DEALLOCATE(ZVEC3) + DEALLOCATE(ZVEC2) + DEALLOCATE(ZVEC1) END IF ! -!* 2.2.6 accretion of raindrops on the graupeln +!* 2.3.6 accretion of raindrops on the graupeln ! --------------------------------------------- ! -GDRY(:) = (ZRRT(:)>XRTMIN(3)) .AND. (ZRGT(:)>XRTMIN(6)) .AND. (ZRRS(:)>XRTMIN(3)) +GDRY(:) = (PRRT1D(:)>XRTMIN(3)) .AND. (PRGT1D(:)>XRTMIN(6)) .AND. (PRRS1D(:)>XRTMIN(3)) IGDRY = COUNT( GDRY(:) ) ! IF( IGDRY>0 ) THEN ! -!* 2.2.7 allocations +!* 2.3.7 allocations ! - ALLOCATE(ZVEC1(IGDRY)) - ALLOCATE(ZVEC2(IGDRY)) - ALLOCATE(ZVEC3(IGDRY)) - ALLOCATE(IVEC1(IGDRY)) - ALLOCATE(IVEC2(IGDRY)) + ALLOCATE(ZVEC1(IGDRY)) + ALLOCATE(ZVEC2(IGDRY)) + ALLOCATE(ZVEC3(IGDRY)) + ALLOCATE(IVEC1(IGDRY)) + ALLOCATE(IVEC2(IGDRY)) ! -!* 2.2.8 select the (ZLBDAG,ZLBDAR) couplet +!* 2.3.8 select the (PLBDAG,PLBDAR) couplet ! - ZVEC1(:) = PACK( ZLBDAG(:),MASK=GDRY(:) ) - ZVEC2(:) = PACK( ZLBDAR(:),MASK=GDRY(:) ) + ZVEC1(:) = PACK( PLBDAG(:),MASK=GDRY(:) ) + ZVEC2(:) = PACK( PLBDAR(:),MASK=GDRY(:) ) ! -!* 2.2.9 find the next lower indice for the ZLBDAG and for the ZLBDAR +!* 2.3.9 find the next lower indice for the PLBDAG and for the PLBDAR ! in the geometrical set of (Lbda_g,Lbda_r) couplet use to ! tabulate the RDRYG-kernel ! - ZVEC1(1:IGDRY) = MAX( 1.0001, MIN( REAL(NDRYLBDAG)-0.0001, & - XDRYINTP1G * LOG( ZVEC1(1:IGDRY) ) + XDRYINTP2G ) ) - IVEC1(1:IGDRY) = INT( ZVEC1(1:IGDRY) ) - ZVEC1(1:IGDRY) = ZVEC1(1:IGDRY) - REAL( IVEC1(1:IGDRY) ) + ZVEC1(1:IGDRY) = MAX( 1.0001, MIN( REAL(NDRYLBDAG)-0.0001, & + XDRYINTP1G * LOG( ZVEC1(1:IGDRY) ) + XDRYINTP2G ) ) + IVEC1(1:IGDRY) = INT( ZVEC1(1:IGDRY) ) + ZVEC1(1:IGDRY) = ZVEC1(1:IGDRY) - REAL( IVEC1(1:IGDRY) ) ! - ZVEC2(1:IGDRY) = MAX( 1.0001, MIN( REAL(NDRYLBDAR)-0.0001, & - XDRYINTP1R * LOG( ZVEC2(1:IGDRY) ) + XDRYINTP2R ) ) - IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) ) - ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - REAL( IVEC2(1:IGDRY) ) + ZVEC2(1:IGDRY) = MAX( 1.0001, MIN( REAL(NDRYLBDAR)-0.0001, & + XDRYINTP1R * LOG( ZVEC2(1:IGDRY) ) + XDRYINTP2R ) ) + IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) ) + ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - REAL( IVEC2(1:IGDRY) ) ! -!* 2.2.10 perform the bilinear interpolation of the normalized +!* 2.3.10 perform the bilinear interpolation of the normalized ! RDRYG-kernel ! - DO JJ = 1,IGDRY - ZVEC3(JJ) = ( XKER_RDRYG(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) & - - XKER_RDRYG(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) & - * ZVEC1(JJ) & - - ( XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) & - - XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) & - * (ZVEC1(JJ) - 1.0) - END DO - ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GDRY,FIELD=0.0 ) -! - WHERE( GDRY(:) ) - ZZW1(:,4) = MIN( ZRRS(:),XFRDRYG*ZZW(:) * ZCRT(:) & ! RRDRYG - *( ZLBDAR(:)**(-3) )*( ZLBDAG(:)**XCXG ) & - *( ZRHODREF(:)**(-XCEXVT-1.) ) & - *( XLBRDRYG1/( ZLBDAG(:)**2 ) + & - XLBRDRYG2/( ZLBDAG(:) * ZLBDAR(:) ) + & - XLBRDRYG3/( ZLBDAR(:)**2) ) ) - END WHERE - DEALLOCATE(IVEC2) - DEALLOCATE(IVEC1) - DEALLOCATE(ZVEC3) - DEALLOCATE(ZVEC2) - DEALLOCATE(ZVEC1) + DO JJ = 1,IGDRY + ZVEC3(JJ) = ( XKER_RDRYG(IVEC1(JJ)+1,IVEC2(JJ)+1) * ZVEC2(JJ) & + - XKER_RDRYG(IVEC1(JJ)+1,IVEC2(JJ) ) * (ZVEC2(JJ) - 1.0) ) & + * ZVEC1(JJ) & + - ( XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ)+1) * ZVEC2(JJ) & + - XKER_RDRYG(IVEC1(JJ) ,IVEC2(JJ) ) * (ZVEC2(JJ) - 1.0) ) & + * (ZVEC1(JJ) - 1.0) + END DO + ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GDRY,FIELD=0.0 ) +! + WHERE( GDRY(:) ) + ZZW1(:,4) = MIN( PRRS1D(:),XFRDRYG*ZZW(:) * PCRT1D(:) & ! RRDRYG + *( PLBDAR(:)**(-3) )*( PLBDAG(:)**XCXG ) & + *( PRHODREF(:)**(-XCEXVT-1.) ) & + *( XLBRDRYG1/( PLBDAG(:)**2 ) + & + XLBRDRYG2/( PLBDAG(:) * PLBDAR(:) ) + & + XLBRDRYG3/( PLBDAR(:)**2) ) ) + END WHERE + DEALLOCATE(IVEC2) + DEALLOCATE(IVEC1) + DEALLOCATE(ZVEC3) + DEALLOCATE(ZVEC2) + DEALLOCATE(ZVEC1) END IF ! ZRDRYG(:) = ZZW1(:,1) + ZZW1(:,2) + ZZW1(:,3) + ZZW1(:,4) ! ! -!* 2.3 Compute the Wet growth case +!* 2.4 Compute the Wet growth case ! -------------------------------- ! -! ZZW(:) = 0.0 ZRWETG(:) = 0.0 -WHERE( ZRGT(:)>XRTMIN(6) ) - ZZW1(:,5) = MIN( ZRIS(:), & - ZZW1(:,2) / (XCOLIG*EXP(XCOLEXIG*(ZZT(:)-XTT)) ) ) ! RIWETG - ZZW1(:,6) = MIN( ZRSS(:), & - ZZW1(:,3) / (XCOLSG*EXP(XCOLEXSG*(ZZT(:)-XTT)) ) ) ! RSWETG +WHERE( PRGT1D(:)>XRTMIN(6) ) + ZZW1(:,5) = MIN( PRIS1D(:), & + ZZW1(:,2) / (XCOLIG*EXP(XCOLEXIG*(PZT(:)-XTT)) ) ) ! RIWETG + ZZW1(:,6) = MIN( PRSS1D(:), & + ZZW1(:,3) / (XCOLSG*EXP(XCOLEXSG*(PZT(:)-XTT)) ) ) ! RSWETG ! - ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure - ZZW(:) = ZKA(:)*(XTT-ZZT(:)) + & - ( ZDV(:)*(XLVTT + ( XCPV - XCL ) * ( ZZT(:) - XTT )) & - *(XESTT-ZZW(:))/(XRV*ZZT(:)) ) + ZZW(:) = PRVT1D(:)*PPRES(:)/((XMV/XMD)+PRVT1D(:)) ! Vapor pressure + ZZW(:) = PKA(:)*(XTT-PZT(:)) + & + ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PZT(:) - XTT )) & + *(XESTT-ZZW(:))/(XRV*PZT(:)) ) ! ! compute RWETG ! - ZRWETG(:) = MAX( 0.0, & - ( ZZW(:) * ( X0DEPG* ZLBDAG(:)**XEX0DEPG + & - X1DEPG*ZCJ(:)*ZLBDAG(:)**XEX1DEPG ) + & - ( ZZW1(:,5)+ZZW1(:,6) ) * & - ( ZRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-ZZT(:))) ) ) / & - ( ZRHODREF(:)*(XLMTT-XCL*(XTT-ZZT(:))) ) ) + ZRWETG(:) = MAX( 0.0, & + ( ZZW(:) * ( X0DEPG* PLBDAG(:)**XEX0DEPG + & + X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG ) + & + ( ZZW1(:,5)+ZZW1(:,6) ) * & + ( PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PZT(:))) ) ) / & + ( PRHODREF(:)*(XLMTT-XCL*(XTT-PZT(:))) ) ) END WHERE ! ! -!* 2.4 Select Wet or Dry case +!* 2.5 Select Wet or Dry case ! --------------------------- ! -! ! Wet case and partial conversion to hail ! ZZW(:) = 0.0 NHAIL = 0. IF (LHAIL) NHAIL = 1. -WHERE( ZRGT(:)>XRTMIN(6) .AND. ZZT(:)<XTT & +WHERE( PRGT1D(:)>XRTMIN(6) .AND. PZT(:)<XTT & .AND. ZRDRYG(:)>=ZRWETG(:) .AND. ZRWETG(:)>0.0 ) ! - ZZW(:) = ZRWETG(:) - ZZW1(:,5) - ZZW1(:,6) ! RCWETG+RRWETG + ZZW(:) = ZRWETG(:) - ZZW1(:,5) - ZZW1(:,6) ! RCWETG+RRWETG ! ! limitation of the available rainwater mixing ratio (RRWETH < RRS !) ! - ZZW1(:,7) = MAX( 0.0,MIN( ZZW(:),ZRRS(:)+ZZW1(:,1) ) ) - ZZX(:) = ZZW1(:,7) / ZZW(:) - ZZW1(:,5) = ZZW1(:,5)*ZZX(:) - ZZW1(:,6) = ZZW1(:,6)*ZZX(:) - ZRWETG(:) = ZZW1(:,7) + ZZW1(:,5) + ZZW1(:,6) + ZZW1(:,7) = MAX( 0.0,MIN( ZZW(:),PRRS1D(:)+ZZW1(:,1) ) ) + ZZX(:) = ZZW1(:,7) / ZZW(:) + ZZW1(:,5) = ZZW1(:,5)*ZZX(:) + ZZW1(:,6) = ZZW1(:,6)*ZZX(:) + ZRWETG(:) = ZZW1(:,7) + ZZW1(:,5) + ZZW1(:,6) ! - ZRCS(:) = ZRCS(:) - ZZW1(:,1) - ZRIS(:) = ZRIS(:) - ZZW1(:,5) - ZRSS(:) = ZRSS(:) - ZZW1(:,6) + PRCS1D(:) = PRCS1D(:) - ZZW1(:,1) + PRIS1D(:) = PRIS1D(:) - ZZW1(:,5) + PRSS1D(:) = PRSS1D(:) - ZZW1(:,6) ! ! assume a linear percent of conversion of graupel into hail ! - ZRGS(:) = ZRGS(:) + ZRWETG(:) - ZZW(:) = ZRGS(:)*ZRDRYG(:)*NHAIL/(ZRWETG(:)+ZRDRYG(:)) - ZRGS(:) = ZRGS(:) - ZZW(:) - ZRHS(:) = ZRHS(:) + ZZW(:) - ZRRS(:) = MAX( 0.0,ZRRS(:) - ZZW1(:,7) + ZZW1(:,1) ) - ZTHS(:) = ZTHS(:) + ZZW1(:,7)*(ZLSFACT(:)-ZLVFACT(:)) - ! f(L_f*(RCWETG+RRWETG)) -! - ZCCS(:) = MAX( ZCCS(:)-ZZW1(:,1)*(ZCCT(:)/MAX(ZRCT(:),XRTMIN(2))),0.0 ) - ZCIS(:) = MAX( ZCIS(:)-ZZW1(:,5)*(ZCIT(:)/MAX(ZRIT(:),XRTMIN(4))),0.0 ) - ZCRS(:) = MAX( ZCRS(:)-MAX( ZZW1(:,7)-ZZW1(:,1),0.0 ) & - *(ZCRT(:)/MAX(ZRRT(:),XRTMIN(3))),0.0 ) + PRGS1D(:) = PRGS1D(:) + ZRWETG(:) + ZZW(:) = PRGS1D(:)*ZRDRYG(:)*NHAIL/(ZRWETG(:)+ZRDRYG(:)) + PRGS1D(:) = PRGS1D(:) - ZZW(:) + PRHS1D(:) = PRHS1D(:) + ZZW(:) + PRRS1D(:) = MAX( 0.0,PRRS1D(:) - ZZW1(:,7) + ZZW1(:,1) ) + PTHS1D(:) = PTHS1D(:) + ZZW1(:,7) * (PLSFACT(:) - PLVFACT(:)) + ! f(L_f*(RCWETG+RRWETG)) +! + PCCS1D(:) = MAX( PCCS1D(:)-ZZW1(:,1)*(PCCT1D(:)/MAX(PRCT1D(:),XRTMIN(2))),0.0 ) + PCIS1D(:) = MAX( PCIS1D(:)-ZZW1(:,5)*(PCIT1D(:)/MAX(PRIT1D(:),XRTMIN(4))),0.0 ) + PCRS1D(:) = MAX( PCRS1D(:)-MAX( ZZW1(:,7)-ZZW1(:,1),0.0 ) & + *(PCRT1D(:)/MAX(PRRT1D(:),XRTMIN(3))),0.0 ) END WHERE ! ! Budget storage if ( nbumod == kmi .and. lbu_enable ) then if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'WETG', & - Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'WETG', & - Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prcs1d(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'WETG', & - Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'WETG', & - Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'WETG', & - Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'WETG', & - Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'WETG', & - Unpack( zrhs(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prhs1d(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_sv ) then call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'WETG', & - Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pccs1d(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'WETG', & - Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'WETG', & - Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) end if end if ! @@ -920,168 +1352,171 @@ end if ! if ( nbumod == kmi .and. lbu_enable ) then if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'DRYG', & - Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DRYG', & - Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prcs1d(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'DRYG', & - Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'DRYG', & - Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'DRYG', & - Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'DRYG', & - Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_sv ) then call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'DRYG', & - Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pccs1d(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'DRYG', & - Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'DRYG', & - Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) end if end if - -WHERE( ZRGT(:)>XRTMIN(6) .AND. ZZT(:)<XTT & +! +WHERE( PRGT1D(:)>XRTMIN(6) .AND. PZT(:)<XTT & .AND. ZRDRYG(:)<ZRWETG(:) .AND. ZRDRYG(:)>0.0 ) ! case - ZRCS(:) = ZRCS(:) - ZZW1(:,1) - ZRIS(:) = ZRIS(:) - ZZW1(:,2) - ZRSS(:) = ZRSS(:) - ZZW1(:,3) - ZRRS(:) = ZRRS(:) - ZZW1(:,4) - ZRGS(:) = ZRGS(:) + ZRDRYG(:) - ZTHS(:) = ZTHS(:) + (ZZW1(:,1)+ZZW1(:,4))*(ZLSFACT(:)-ZLVFACT(:)) ! - ! f(L_f*(RCDRYG+RRDRYG)) -! - ZCCS(:) = MAX( ZCCS(:)-ZZW1(:,1)*(ZCCT(:)/MAX(ZRCT(:),XRTMIN(2))),0.0 ) - ZCIS(:) = MAX( ZCIS(:)-ZZW1(:,2)*(ZCIT(:)/MAX(ZRIT(:),XRTMIN(4))),0.0 ) - ZCRS(:) = MAX( ZCRS(:)-ZZW1(:,4)*(ZCRT(:)/MAX(ZRRT(:),XRTMIN(3))),0.0 ) - ! Approximate rates + PRCS1D(:) = PRCS1D(:) - ZZW1(:,1) + PRIS1D(:) = PRIS1D(:) - ZZW1(:,2) + PRSS1D(:) = PRSS1D(:) - ZZW1(:,3) + PRRS1D(:) = PRRS1D(:) - ZZW1(:,4) + PRGS1D(:) = PRGS1D(:) + ZRDRYG(:) + PTHS1D(:) = PTHS1D(:) + (ZZW1(:,1)+ZZW1(:,4)) * (PLSFACT(:) - PLVFACT(:)) ! + ! f(L_f*(RCDRYG+RRDRYG)) +! + PCCS1D(:) = MAX( PCCS1D(:)-ZZW1(:,1)*(PCCT1D(:)/MAX(PRCT1D(:),XRTMIN(2))),0.0 ) + PCIS1D(:) = MAX( PCIS1D(:)-ZZW1(:,2)*(PCIT1D(:)/MAX(PRIT1D(:),XRTMIN(4))),0.0 ) + PCRS1D(:) = MAX( PCRS1D(:)-ZZW1(:,4)*(PCRT1D(:)/MAX(PRRT1D(:),XRTMIN(3))),0.0 ) + ! Approximate rates END WHERE ! ! Budget storage if ( nbumod == kmi .and. lbu_enable ) then if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'DRYG', & - Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DRYG', & - Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prcs1d(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'DRYG', & - Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'DRYG', & - Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'DRYG', & - Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'DRYG', & - Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_sv ) then call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'DRYG', & - Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pccs1d(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'DRYG', & - Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'DRYG', & - Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) end if end if ! ! -!* 2.5 Hallett-Mossop ice multiplication process due to graupel riming +!* 2.6 Hallett-Mossop ice multiplication process due to graupel riming ! -------------------------------------------------------------------- ! if ( nbumod == kmi .and. lbu_enable ) then if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HMG', & - Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'HMG', & - Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HMG', & - Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) end if -GDRY(:) = (ZZT(:)<XHMTMAX) .AND. (ZZT(:)>XHMTMIN) .AND. (ZRDRYG(:)<ZZW(:))& - .AND. (ZRGT(:)>XRTMIN(6)) .AND. (ZRCT(:)>XRTMIN(2)) +!GDRY(:) = (PZT(:)<XHMTMAX) .AND. (PZT(:)>XHMTMIN) .AND. (ZRDRYG(:)<ZZW(:))& +! .AND. (PRGT1D(:)>XRTMIN(6)) .AND. (PRCT1D(:)>XRTMIN(2)) +GDRY(:) = (PZT(:)<XHMTMAX) .AND. (PZT(:)>XHMTMIN) .AND. (ZRDRYG(:)<ZRWETG(:))& + .AND. (PRGT1D(:)>XRTMIN(6)) .AND. (PRCT1D(:)>XRTMIN(2)) +! IGDRY = COUNT( GDRY(:) ) IF( IGDRY>0 ) THEN - ALLOCATE(ZVEC1(IGDRY)) - ALLOCATE(ZVEC2(IGDRY)) - ALLOCATE(IVEC2(IGDRY)) -! - ZVEC1(:) = PACK( ZLBDAC(:),MASK=GDRY(:) ) - ZVEC2(1:IGDRY) = MAX( 1.0001, MIN( REAL(NGAMINC)-0.0001, & - XHMLINTP1 * LOG( ZVEC1(1:IGDRY) ) + XHMLINTP2 ) ) - IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) ) - ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - REAL( IVEC2(1:IGDRY) ) - ZVEC1(1:IGDRY) = XGAMINC_HMC( IVEC2(1:IGDRY)+1 )* ZVEC2(1:IGDRY) & - - XGAMINC_HMC( IVEC2(1:IGDRY) )*(ZVEC2(1:IGDRY) - 1.0) - ZZX(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GDRY,FIELD=0.0 ) ! Large droplets -! - WHERE ( GDRY(:) .AND. ZZX(:)<0.99 ) ! Dry case - ZZW1(:,5) = ZZW1(:,1)*(ZCCT(:)/ZRCT(:))*(1.0-ZZX(:))*XHM_FACTG* & - MAX( 0.0, MIN( (ZZT(:)-XHMTMIN)/3.0,(XHMTMAX-ZZT(:))/2.0 ) ) ! CCHMGI - ZCIS(:) = ZCIS(:) + ZZW1(:,5) -! - ZZW1(:,6) = ZZW1(:,5) * XMNU0 ! RCHMGI - ZRIS(:) = ZRIS(:) + ZZW1(:,6) - ZRGS(:) = ZRGS(:) - ZZW1(:,6) - END WHERE - DEALLOCATE(IVEC2) - DEALLOCATE(ZVEC2) - DEALLOCATE(ZVEC1) + ALLOCATE(ZVEC1(IGDRY)) + ALLOCATE(ZVEC2(IGDRY)) + ALLOCATE(IVEC2(IGDRY)) +! + ZVEC1(:) = PACK( PLBDAC(:),MASK=GDRY(:) ) + ZVEC2(1:IGDRY) = MAX( 1.0001, MIN( REAL(NGAMINC)-0.0001, & + XHMLINTP1 * LOG( ZVEC1(1:IGDRY) ) + XHMLINTP2 ) ) + IVEC2(1:IGDRY) = INT( ZVEC2(1:IGDRY) ) + ZVEC2(1:IGDRY) = ZVEC2(1:IGDRY) - REAL( IVEC2(1:IGDRY) ) + ZVEC1(1:IGDRY) = XGAMINC_HMC( IVEC2(1:IGDRY)+1 )* ZVEC2(1:IGDRY) & + - XGAMINC_HMC( IVEC2(1:IGDRY) )*(ZVEC2(1:IGDRY) - 1.0) + ZZX(:) = UNPACK( VECTOR=ZVEC1(:),MASK=GDRY,FIELD=0.0 ) ! Large droplets +! + WHERE ( GDRY(:) .AND. ZZX(:)<0.99 ) ! Dry case + ZZW1(:,5) = ZZW1(:,1)*(PCCT1D(:)/PRCT1D(:))*(1.0-ZZX(:))*XHM_FACTG* & + MAX( 0.0, MIN( (PZT(:)-XHMTMIN)/3.0,(XHMTMAX-PZT(:))/2.0 ) ) ! CCHMGI + PCIS1D(:) = PCIS1D(:) + ZZW1(:,5) +! + ZZW1(:,6) = ZZW1(:,5) * XMNU0 ! RCHMGI + PRIS1D(:) = PRIS1D(:) + ZZW1(:,6) + PRGS1D(:) = PRGS1D(:) - ZZW1(:,6) + END WHERE + DEALLOCATE(IVEC2) + DEALLOCATE(ZVEC2) + DEALLOCATE(ZVEC1) END IF ! ! Budget storage if ( nbumod == kmi .and. lbu_enable ) then if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HMG', & - Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'HMG', & - Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HMG', & - Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) end if ! -!* 2.6 Melting of the graupeln +!* 2.7 Melting of the graupeln ! ---------------------------- ! if ( nbumod == kmi .and. lbu_enable ) then if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'GMLT', & - Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'GMLT', & - Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'GMLT', & - Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'GMLT', & - Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) end if ZZW(:) = 0.0 -WHERE( (ZRGT(:)>XRTMIN(6)) .AND. (ZRGS(:)>XRTMIN(6)/PTSTEP) .AND. (ZZT(:)>XTT) ) - ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure - ZZW(:) = ZKA(:)*(XTT-ZZT(:)) + & - ( ZDV(:)*(XLVTT + ( XCPV - XCL ) * ( ZZT(:) - XTT )) & - *(XESTT-ZZW(:))/(XRV*ZZT(:)) ) +WHERE( (PRGT1D(:)>XRTMIN(6)) .AND. (PRGS1D(:)>XRTMIN(6)/PTSTEP) .AND. (PZT(:)>XTT) ) + ZZW(:) = PRVT1D(:)*PPRES(:)/((XMV/XMD)+PRVT1D(:)) ! Vapor pressure + ZZW(:) = PKA(:)*(XTT-PZT(:)) + & + ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PZT(:) - XTT )) & + *(XESTT-ZZW(:))/(XRV*PZT(:)) ) ! ! compute RGMLTR ! - ZZW(:) = MIN( ZRGS(:), MAX( 0.0,( -ZZW(:) * & - ( X0DEPG* ZLBDAG(:)**XEX0DEPG + & - X1DEPG*ZCJ(:)*ZLBDAG(:)**XEX1DEPG ) - & - ( ZZW1(:,1)+ZZW1(:,4) ) * & - ( ZRHODREF(:)*XCL*(XTT-ZZT(:))) ) / & - ( ZRHODREF(:)*XLMTT ) ) ) - ZRRS(:) = ZRRS(:) + ZZW(:) - ZRGS(:) = ZRGS(:) - ZZW(:) - ZTHS(:) = ZTHS(:) - ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(-RGMLTR)) -! -! ZCRS(:) = MAX( ZCRS(:) + ZZW(:)*(XCCG*ZLBDAG(:)**XCXG/ZRGT(:)),0.0 ) - ZCRS(:) = ZCRS(:) + ZZW(:)*5.0E6 ! obtained after averaging - ! Dshed=1mm and 500 microns + ZZW(:) = MIN( PRGS1D(:), MAX( 0.0,( -ZZW(:) * & + ( X0DEPG* PLBDAG(:)**XEX0DEPG + & + X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG ) - & + ( ZZW1(:,1)+ZZW1(:,4) ) * & + ( PRHODREF(:)*XCL*(XTT-PZT(:))) ) / & + ( PRHODREF(:)*XLMTT ) ) ) + PRRS1D(:) = PRRS1D(:) + ZZW(:) + PRGS1D(:) = PRGS1D(:) - ZZW(:) + PTHS1D(:) = PTHS1D(:) - ZZW(:) * (PLSFACT(:) - PLVFACT(:)) ! f(L_f*(-RGMLTR)) +! +! PCRS1D(:) = MAX( PCRS1D(:) + ZZW(:)*(XCCG*PLBDAG(:)**XCXG/PRGT1D(:)),0.0 ) + PCRS1D(:) = PCRS1D(:) + ZZW(:)*5.0E6 ! obtained after averaging + ! Dshed=1mm and 500 microns END WHERE ! if ( nbumod == kmi .and. lbu_enable ) then if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'GMLT', & - Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'GMLT', & - Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'GMLT', & - Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'GMLT', & - Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) end if ! ! @@ -1094,7 +1529,7 @@ end if ! HAIL: IF (LHAIL) THEN ! -GHAIL(:) = ZRHT(:)>XRTMIN(7) +GHAIL(:) = PRTH1D(:)>XRTMIN(7) IHAIL = COUNT(GHAIL(:)) ! IF( IHAIL>0 ) THEN @@ -1104,233 +1539,235 @@ IF( IHAIL>0 ) THEN ! if ( nbumod == kmi .and. lbu_enable ) then if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'WETH', & - Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'WETH', & - Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prcs1d(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'WETH', & - Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'WETH', & - Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'WETH', & - Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'WETH', & - Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'WETH', & - Unpack( zrhs(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prhs1d(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_sv ) then call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'WETH', & - Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pccs1d(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'WETH', & - Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'WETH', & - Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) end if end if - ZZW1(:,:) = 0.0 - WHERE( GHAIL(:) .AND. ( (ZRCT(:)>XRTMIN(2) .AND. ZRCS(:)>XRTMIN(2)/PTSTEP) .OR. & - (ZRIT(:)>XRTMIN(4) .AND. ZRIS(:)>XRTMIN(4)/PTSTEP) ) ) - ZZW(:) = ZLBDAH(:)**(XCXH-XDH-2.0) * ZRHODREF(:)**(-XCEXVT) - ZZW1(:,1) = MIN( ZRCS(:),XFWETH * ZRCT(:) * ZZW(:) ) ! RCWETH - ZZW1(:,2) = MIN( ZRIS(:),XFWETH * ZRIT(:) * ZZW(:) ) ! RIWETH - END WHERE + ZZW1(:,:) = 0.0 + WHERE( GHAIL(:) .AND. ( (PRCT1D(:)>XRTMIN(2) .AND. PRCS1D(:)>XRTMIN(2)/PTSTEP) .OR. & + (PRIT1D(:)>XRTMIN(4) .AND. PRIS1D(:)>XRTMIN(4)/PTSTEP) ) ) + ZZW(:) = PLBDAH(:)**(XCXH-XDH-2.0) * PRHODREF(:)**(-XCEXVT) + ZZW1(:,1) = MIN( PRCS1D(:),XFWETH * PRCT1D(:) * ZZW(:) ) ! RCWETH + ZZW1(:,2) = MIN( PRIS1D(:),XFWETH * PRIT1D(:) * ZZW(:) ) ! RIWETH + END WHERE ! !* 3.1.1 accretion of aggregates on the hailstones ! ------------------------------------------------ ! - GWET(:) = GHAIL(:) .AND. (ZRST(:)>XRTMIN(5) .AND. ZRSS(:)>XRTMIN(5)/PTSTEP) - IGWET = COUNT( GWET(:) ) + GWET(:) = GHAIL(:) .AND. (PRST1D(:)>XRTMIN(5) .AND. PRSS1D(:)>XRTMIN(5)/PTSTEP) + IGWET = COUNT( GWET(:) ) ! - IF( IGWET>0 ) THEN + IF( IGWET>0 ) THEN ! !* 3.1.2 allocations ! - ALLOCATE(ZVEC1(IGWET)) - ALLOCATE(ZVEC2(IGWET)) - ALLOCATE(ZVEC3(IGWET)) - ALLOCATE(IVEC1(IGWET)) - ALLOCATE(IVEC2(IGWET)) + ALLOCATE(ZVEC1(IGWET)) + ALLOCATE(ZVEC2(IGWET)) + ALLOCATE(ZVEC3(IGWET)) + ALLOCATE(IVEC1(IGWET)) + ALLOCATE(IVEC2(IGWET)) ! -!* 3.1.3 select the (ZLBDAH,ZLBDAS) couplet +!* 3.1.3 select the (PLBDAH,PLBDAS) couplet ! - ZVEC1(:) = PACK( ZLBDAH(:),MASK=GWET(:) ) - ZVEC2(:) = PACK( ZLBDAS(:),MASK=GWET(:) ) + ZVEC1(:) = PACK( PLBDAH(:),MASK=GWET(:) ) + ZVEC2(:) = PACK( PLBDAS(:),MASK=GWET(:) ) ! -!* 3.1.4 find the next lower indice for the ZLBDAG and for the ZLBDAS +!* 3.1.4 find the next lower indice for the PLBDAG and for the PLBDAS ! in the geometrical set of (Lbda_h,Lbda_s) couplet use to ! tabulate the SWETH-kernel ! - ZVEC1(1:IGWET) = MAX( 1.0001, MIN( REAL(NWETLBDAH)-0.0001, & - XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) ) - IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) ) - ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) ) + ZVEC1(1:IGWET) = MAX( 1.0001, MIN( REAL(NWETLBDAH)-0.0001, & + XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) ) + IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) ) + ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) ) ! - ZVEC2(1:IGWET) = MAX( 1.0001, MIN( REAL(NWETLBDAS)-0.0001, & - XWETINTP1S * LOG( ZVEC2(1:IGWET) ) + XWETINTP2S ) ) - IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) ) - ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( IVEC2(1:IGWET) ) + ZVEC2(1:IGWET) = MAX( 1.0001, MIN( REAL(NWETLBDAS)-0.0001, & + XWETINTP1S * LOG( ZVEC2(1:IGWET) ) + XWETINTP2S ) ) + IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) ) + ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( IVEC2(1:IGWET) ) ! !* 3.1.5 perform the bilinear interpolation of the normalized ! SWETH-kernel ! - DO JJ = 1,IGWET - ZVEC3(JJ) = ( XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) & - - XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) & - * ZVEC1(JJ) & - - ( XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) & - - XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) & - * (ZVEC1(JJ) - 1.0) - END DO - ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GWET,FIELD=0.0 ) -! - WHERE( GWET(:) ) - ZZW1(:,3) = MIN( ZRSS(:),XFSWETH*ZZW(:) & ! RSWETH - *( ZLBDAS(:)**(XCXS-XBS) )*( ZLBDAH(:)**XCXH ) & - *( ZRHODREF(:)**(-XCEXVT-1.) ) & - *( XLBSWETH1/( ZLBDAH(:)**2 ) + & - XLBSWETH2/( ZLBDAH(:) * ZLBDAS(:) ) + & - XLBSWETH3/( ZLBDAS(:)**2) ) ) - END WHERE - DEALLOCATE(IVEC2) - DEALLOCATE(IVEC1) - DEALLOCATE(ZVEC3) - DEALLOCATE(ZVEC2) - DEALLOCATE(ZVEC1) - END IF + DO JJ = 1,IGWET + ZVEC3(JJ) = ( XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ)+1) * ZVEC2(JJ) & + - XKER_SWETH(IVEC1(JJ)+1,IVEC2(JJ) ) * (ZVEC2(JJ) - 1.0) ) & + * ZVEC1(JJ) & + - ( XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ)+1) * ZVEC2(JJ) & + - XKER_SWETH(IVEC1(JJ) ,IVEC2(JJ) ) * (ZVEC2(JJ) - 1.0) ) & + * (ZVEC1(JJ) - 1.0) + END DO + ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GWET,FIELD=0.0 ) +! + WHERE( GWET(:) ) + ZZW1(:,3) = MIN( PRSS1D(:),XFSWETH*ZZW(:) & ! RSWETH + *( PLBDAS(:)**(XCXS-XBS) )*( PLBDAH(:)**XCXH ) & + *( PRHODREF(:)**(-XCEXVT-1.) ) & + *( XLBSWETH1/( PLBDAH(:)**2 ) + & + XLBSWETH2/( PLBDAH(:) * PLBDAS(:) ) + & + XLBSWETH3/( PLBDAS(:)**2) ) ) + END WHERE + DEALLOCATE(IVEC2) + DEALLOCATE(IVEC1) + DEALLOCATE(ZVEC3) + DEALLOCATE(ZVEC2) + DEALLOCATE(ZVEC1) + END IF ! !* 3.1.6 accretion of graupeln on the hailstones ! ---------------------------------------------- ! - GWET(:) = GHAIL(:) .AND. (ZRGT(:)>XRTMIN(6) .AND. ZRGS(:)>XRTMIN(6)/PTSTEP) - IGWET = COUNT( GWET(:) ) + GWET(:) = GHAIL(:) .AND. (PRGT1D(:)>XRTMIN(6) .AND. PRGS1D(:)>XRTMIN(6)/PTSTEP) + IGWET = COUNT( GWET(:) ) ! - IF( IGWET>0 ) THEN + IF( IGWET>0 ) THEN ! !* 3.1.7 allocations ! - ALLOCATE(ZVEC1(IGWET)) - ALLOCATE(ZVEC2(IGWET)) - ALLOCATE(ZVEC3(IGWET)) - ALLOCATE(IVEC1(IGWET)) - ALLOCATE(IVEC2(IGWET)) + ALLOCATE(ZVEC1(IGWET)) + ALLOCATE(ZVEC2(IGWET)) + ALLOCATE(ZVEC3(IGWET)) + ALLOCATE(IVEC1(IGWET)) + ALLOCATE(IVEC2(IGWET)) ! -!* 3.1.8 select the (ZLBDAH,ZLBDAG) couplet +!* 3.1.8 select the (PLBDAH,PLBDAG) couplet ! - ZVEC1(:) = PACK( ZLBDAH(:),MASK=GWET(:) ) - ZVEC2(:) = PACK( ZLBDAG(:),MASK=GWET(:) ) + ZVEC1(:) = PACK( PLBDAH(:),MASK=GWET(:) ) + ZVEC2(:) = PACK( PLBDAG(:),MASK=GWET(:) ) ! -!* 3.1.9 find the next lower indice for the ZLBDAH and for the ZLBDAG +!* 3.1.9 find the next lower indice for the PLBDAH and for the PLBDAG ! in the geometrical set of (Lbda_h,Lbda_g) couplet use to ! tabulate the GWETH-kernel ! - ZVEC1(1:IGWET) = MAX( 1.0001, MIN( REAL(NWETLBDAG)-0.0001, & - XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) ) - IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) ) - ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) ) + ZVEC1(1:IGWET) = MAX( 1.0001, MIN( REAL(NWETLBDAG)-0.0001, & + XWETINTP1H * LOG( ZVEC1(1:IGWET) ) + XWETINTP2H ) ) + IVEC1(1:IGWET) = INT( ZVEC1(1:IGWET) ) + ZVEC1(1:IGWET) = ZVEC1(1:IGWET) - REAL( IVEC1(1:IGWET) ) ! - ZVEC2(1:IGWET) = MAX( 1.0001, MIN( REAL(NWETLBDAG)-0.0001, & - XWETINTP1G * LOG( ZVEC2(1:IGWET) ) + XWETINTP2G ) ) - IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) ) - ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( IVEC2(1:IGWET) ) + ZVEC2(1:IGWET) = MAX( 1.0001, MIN( REAL(NWETLBDAG)-0.0001, & + XWETINTP1G * LOG( ZVEC2(1:IGWET) ) + XWETINTP2G ) ) + IVEC2(1:IGWET) = INT( ZVEC2(1:IGWET) ) + ZVEC2(1:IGWET) = ZVEC2(1:IGWET) - REAL( IVEC2(1:IGWET) ) ! !* 3.1.10 perform the bilinear interpolation of the normalized ! GWETH-kernel ! - DO JJ = 1,IGWET - ZVEC3(JJ) = ( XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ)+1)* ZVEC2(JJ) & - - XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) & - * ZVEC1(JJ) & - - ( XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ)+1)* ZVEC2(JJ) & - - XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ) )*(ZVEC2(JJ) - 1.0) ) & - * (ZVEC1(JJ) - 1.0) - END DO - ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GWET,FIELD=0.0 ) -! - WHERE( GWET(:) ) - ZZW1(:,5) = MAX(MIN( ZRGS(:),XFGWETH*ZZW(:) & ! RGWETH - *( ZLBDAG(:)**(XCXG-XBG) )*( ZLBDAH(:)**XCXH ) & - *( ZRHODREF(:)**(-XCEXVT-1.) ) & - *( XLBGWETH1/( ZLBDAH(:)**2 ) + & - XLBGWETH2/( ZLBDAH(:) * ZLBDAG(:) ) + & - XLBGWETH3/( ZLBDAG(:)**2) ) ),0. ) - END WHERE - DEALLOCATE(IVEC2) - DEALLOCATE(IVEC1) - DEALLOCATE(ZVEC3) - DEALLOCATE(ZVEC2) - DEALLOCATE(ZVEC1) - END IF + DO JJ = 1,IGWET + ZVEC3(JJ) = ( XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ)+1) * ZVEC2(JJ) & + - XKER_GWETH(IVEC1(JJ)+1,IVEC2(JJ) ) * (ZVEC2(JJ) - 1.0) ) & + * ZVEC1(JJ) & + - ( XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ)+1) * ZVEC2(JJ) & + - XKER_GWETH(IVEC1(JJ) ,IVEC2(JJ) ) * (ZVEC2(JJ) - 1.0) ) & + * (ZVEC1(JJ) - 1.0) + END DO + ZZW(:) = UNPACK( VECTOR=ZVEC3(:),MASK=GWET,FIELD=0.0 ) +! + WHERE( GWET(:) ) + ZZW1(:,5) = MAX(MIN( PRGS1D(:),XFGWETH*ZZW(:) & ! RGWETH + *( PLBDAG(:)**(XCXG-XBG) )*( PLBDAH(:)**XCXH ) & + *( PRHODREF(:)**(-XCEXVT-1.) ) & + *( XLBGWETH1/( PLBDAH(:)**2 ) + & + XLBGWETH2/( PLBDAH(:) * PLBDAG(:) ) + & + XLBGWETH3/( PLBDAG(:)**2) ) ),0. ) + END WHERE + DEALLOCATE(IVEC2) + DEALLOCATE(IVEC1) + DEALLOCATE(ZVEC3) + DEALLOCATE(ZVEC2) + DEALLOCATE(ZVEC1) + END IF +! ! !* 3.2 compute the Wet growth of hail ! ------------------------------------- ! - ZZW(:) = 0.0 - WHERE( GHAIL(:) .AND. ZZT(:)<XTT ) - ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure - ZZW(:) = ZKA(:)*(XTT-ZZT(:)) + & - ( ZDV(:)*(XLVTT + ( XCPV - XCL ) * ( ZZT(:) - XTT )) & - *(XESTT-ZZW(:))/(XRV*ZZT(:)) ) + ZZW(:) = 0.0 + WHERE( GHAIL(:) .AND. PZT(:)<XTT ) + ZZW(:) = PRVT1D(:) * PPRES(:) / ((XMV / XMD) + PRVT1D(:)) ! Vapor pressure + ZZW(:) = PKA(:) * (XTT - PZT(:)) + & + ( PDV(:) * (XLVTT + ( XCPV - XCL ) * ( PZT(:) - XTT )) & + * (XESTT-ZZW(:))/(XRV*PZT(:)) ) ! ! compute RWETH ! - ZZW(:) = MAX(0., ( ZZW(:) * ( X0DEPH* ZLBDAH(:)**XEX0DEPH + & - X1DEPH*ZCJ(:)*ZLBDAH(:)**XEX1DEPH ) + & - ( ZZW1(:,2)+ZZW1(:,3)+ZZW1(:,5) ) * & - ( ZRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-ZZT(:))) ) ) / & - ( ZRHODREF(:)*(XLMTT-XCL*(XTT-ZZT(:))) ) ) + ZZW(:) = MAX(0., ( ZZW(:) * ( X0DEPH* PLBDAH(:)**XEX0DEPH + & + X1DEPH*PCJ(:)*PLBDAH(:)**XEX1DEPH ) + & + ( ZZW1(:,2)+ZZW1(:,3)+ZZW1(:,5) ) * & + ( PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PZT(:))) ) ) / & + ( PRHODREF(:)*(XLMTT-XCL*(XTT-PZT(:))) ) ) ! - ZZW1(:,6) = MAX( ZZW(:) - ZZW1(:,2) - ZZW1(:,3) - ZZW1(:,5),0.) ! RCWETH+RRWETH - END WHERE - WHERE ( GHAIL(:) .AND. ZZT(:)<XTT .AND. ZZW1(:,6)/=0.) + ZZW1(:,6) = MAX( ZZW(:) - ZZW1(:,2) - ZZW1(:,3) - ZZW1(:,5),0.) ! RCWETH+RRWETH + END WHERE + ! + WHERE ( GHAIL(:) .AND. PZT(:)<XTT .AND. ZZW1(:,6)/=0.) ! ! limitation of the available rainwater mixing ratio (RRWETH < RRS !) ! - ZZW1(:,4) = MAX( 0.0,MIN( ZZW1(:,6),ZRRS(:)+ZZW1(:,1) ) ) - ZZX(:) = ZZW1(:,4) / ZZW1(:,6) - ZZW1(:,2) = ZZW1(:,2)*ZZX(:) - ZZW1(:,3) = ZZW1(:,3)*ZZX(:) - ZZW1(:,5) = ZZW1(:,5)*ZZX(:) - ZZW(:) = ZZW1(:,4) + ZZW1(:,2) + ZZW1(:,3) + ZZW1(:,5) + ZZW1(:,4) = MAX( 0.0,MIN( ZZW1(:,6),PRRS1D(:)+ZZW1(:,1) ) ) + ZZX(:) = ZZW1(:,4) / ZZW1(:,6) + ZZW1(:,2) = ZZW1(:,2) * ZZX(:) + ZZW1(:,3) = ZZW1(:,3) * ZZX(:) + ZZW1(:,5) = ZZW1(:,5) * ZZX(:) + ZZW(:) = ZZW1(:,4) + ZZW1(:,2) + ZZW1(:,3) + ZZW1(:,5) ! !* 3.2.1 integrate the Wet growth of hail ! - ZRCS(:) = ZRCS(:) - ZZW1(:,1) - ZRIS(:) = ZRIS(:) - ZZW1(:,2) - ZRSS(:) = ZRSS(:) - ZZW1(:,3) - ZRGS(:) = ZRGS(:) - ZZW1(:,5) - ZRHS(:) = ZRHS(:) + ZZW(:) - ZRRS(:) = MAX( 0.0,ZRRS(:) - ZZW1(:,4) + ZZW1(:,1) ) - ZTHS(:) = ZTHS(:) + ZZW1(:,4)*(ZLSFACT(:)-ZLVFACT(:)) - ! f(L_f*(RCWETH+RRWETH)) -! - ZCCS(:) = MAX( ZCCS(:)-ZZW1(:,1)*(ZCCT(:)/MAX(ZRCT(:),XRTMIN(2))),0.0 ) - ZCIS(:) = MAX( ZCIS(:)-ZZW1(:,2)*(ZCIT(:)/MAX(ZRIT(:),XRTMIN(4))),0.0 ) - ZCRS(:) = MAX( ZCRS(:)-MAX( ZZW1(:,4)-ZZW1(:,1),0.0 ) & - *(ZCRT(:)/MAX(ZRRT(:),XRTMIN(3))),0.0 ) - END WHERE - + PRCS1D(:) = PRCS1D(:) - ZZW1(:,1) + PRIS1D(:) = PRIS1D(:) - ZZW1(:,2) + PRSS1D(:) = PRSS1D(:) - ZZW1(:,3) + PRGS1D(:) = PRGS1D(:) - ZZW1(:,5) + PRHS1D(:) = PRHS1D(:) + ZZW(:) + PRRS1D(:) = MAX( 0.0,PRRS1D(:) - ZZW1(:,4) + ZZW1(:,1) ) + PTHS1D(:) = PTHS1D(:) + ZZW1(:,4) * (PLSFACT(:) - PLVFACT(:)) + ! f(L_f*(RCWETH+RRWETH)) +! + PCCS1D(:) = MAX( PCCS1D(:)-ZZW1(:,1)*(PCCT1D(:)/MAX(PRCT1D(:),XRTMIN(2))),0.0 ) + PCIS1D(:) = MAX( PCIS1D(:)-ZZW1(:,2)*(PCIT1D(:)/MAX(PRIT1D(:),XRTMIN(4))),0.0 ) + PCRS1D(:) = MAX( PCRS1D(:)-MAX( ZZW1(:,4)-ZZW1(:,1),0.0 ) & + *(PCRT1D(:)/MAX(PRRT1D(:),XRTMIN(3))),0.0 ) + END WHERE +! if ( nbumod == kmi .and. lbu_enable ) then if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'WETH', & - Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'WETH', & - Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prcs1d(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'WETH', & - Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'WETH', & - Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pris1d(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'WETH', & - Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prss1d(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'WETH', & - Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'WETH', & - Unpack( zrhs(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prhs1d(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_sv ) then call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'WETH', & - Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pccs1d(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'WETH', & - Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'WETH', & - Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pcis1d(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) ) end if end if END IF ! IHAIL>0 @@ -1344,81 +1781,81 @@ END IF ! IHAIL>0 IF ( IHAIL>0 ) THEN if ( nbumod == kmi .and. lbu_enable ) then if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'COHG', & - Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'COHG', & - Unpack( zrhs(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prhs1d(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) ) end if - - ZTHRH=0.01E-3 - ZTHRC=0.001E-3 - ZZW(:) = 0.0 - WHERE( ZRHT(:)<ZTHRH .AND. ZRCT(:)<ZTHRC .AND. ZZT(:)<XTT ) - ZZW(:) = MIN( 1.0,MAX( 0.0,1.0-(ZRCT(:)/ZTHRC) ) ) +! + ZTHRH = 0.01E-3 + ZTHRC = 0.001E-3 + ZZW(:) = 0.0 +! + WHERE( PRTH1D(:)<ZTHRH .AND. PRCT1D(:)<ZTHRC .AND. PZT(:)<XTT ) + ZZW(:) = MIN( 1.0,MAX( 0.0,1.0-(PRCT1D(:)/ZTHRC) ) ) ! ! assume a linear percent conversion rate of hail into graupel ! - ZZW(:) = ZRHS(:)*ZZW(:) - ZRGS(:) = ZRGS(:) + ZZW(:) ! partial conversion - ZRHS(:) = ZRHS(:) - ZZW(:) ! of hail into graupel + ZZW(:) = PRHS1D(:) * ZZW(:) + PRGS1D(:) = PRGS1D(:) + ZZW(:) ! partial conversion + PRHS1D(:) = PRHS1D(:) - ZZW(:) ! of hail into graupel + END WHERE ! - END WHERE - if ( nbumod == kmi .and. lbu_enable ) then if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'COHG', & - Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prgs1d(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'COHG', & - Unpack( zrhs(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prhs1d(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) ) end if END IF ! +! !* 3.4 Melting of the hailstones ! IF ( IHAIL>0 ) THEN if ( nbumod == kmi .and. lbu_enable ) then if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HMLT', & - Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'HMLT', & - Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'HMLT', & - Unpack( zrhs(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prhs1d(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'HMLT', & - Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) end if - - ZZW(:) = 0.0 - WHERE( GHAIL(:) .AND. (ZRHS(:)>XRTMIN(7)/PTSTEP) .AND. (ZRHT(:)>XRTMIN(7)) .AND. (ZZT(:)>XTT) ) - ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure - ZZW(:) = ZKA(:)*(XTT-ZZT(:)) + & - ( ZDV(:)*(XLVTT + ( XCPV - XCL ) * ( ZZT(:) - XTT )) & - *(XESTT-ZZW(:))/(XRV*ZZT(:)) ) +! + ZZW(:) = 0.0 + WHERE( GHAIL(:) .AND. (PRHS1D(:)>XRTMIN(7)/PTSTEP) .AND. (PRTH1D(:)>XRTMIN(7)) .AND. (PZT(:)>XTT) ) + ZZW(:) = PRVT1D(:) * PPRES(:) / ((XMV / XMD) + PRVT1D(:)) ! Vapor pressure + ZZW(:) = PKA(:) * (XTT - PZT(:)) + & + ( PDV(:) * (XLVTT + ( XCPV - XCL ) * ( PZT(:) - XTT )) & + * (XESTT - ZZW(:)) / (XRV * PZT(:)) ) ! ! compute RHMLTR ! - ZZW(:) = MIN( ZRHS(:), MAX( 0.0,( -ZZW(:) * & - ( X0DEPH* ZLBDAH(:)**XEX0DEPH + & - X1DEPH*ZCJ(:)*ZLBDAH(:)**XEX1DEPH ) - & - ZZW1(:,6)*( ZRHODREF(:)*XCL*(XTT-ZZT(:))) ) / & - ( ZRHODREF(:)*XLMTT ) ) ) - ZRRS(:) = ZRRS(:) + ZZW(:) - ZRHS(:) = ZRHS(:) - ZZW(:) - ZTHS(:) = ZTHS(:) - ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)) ! f(L_f*(-RHMLTR)) + ZZW(:) = MIN( PRHS1D(:), MAX( 0.0,( -ZZW(:) * & + ( X0DEPH* PLBDAH(:)**XEX0DEPH + & + X1DEPH*PCJ(:)*PLBDAH(:)**XEX1DEPH ) - & + ZZW1(:,6)*( PRHODREF(:)*XCL*(XTT-PZT(:))) ) / & + ( PRHODREF(:)*XLMTT ) ) ) + PRRS1D(:) = PRRS1D(:) + ZZW(:) + PRHS1D(:) = PRHS1D(:) - ZZW(:) + PTHS1D(:) = PTHS1D(:) - ZZW(:) * (PLSFACT(:) - PLVFACT(:)) ! f(L_f*(-RHMLTR)) ! - ZCRS(:) = MAX( ZCRS(:) + ZZW(:)*(XCCH*ZLBDAH(:)**XCXH/ZRHT(:)),0.0 ) + PCRS1D(:) = MAX( PCRS1D(:) + ZZW(:)*(XCCH*PLBDAH(:)**XCXH/PRTH1D(:)),0.0 ) + END WHERE ! - END WHERE - if ( nbumod == kmi .and. lbu_enable ) then if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HMLT', & - Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pths1d(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'HMLT', & - Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prrs1d(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'HMLT', & - Unpack( zrhs(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( prhs1d(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) ) if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'HMLT', & - Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) + Unpack( pcrs1d(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) ) end if END IF - +! END IF HAIL ! !------------------------------------------------------------------------------ diff --git a/src/MNH/mnh_oasis_recv.F90 b/src/MNH/mnh_oasis_recv.F90 index 7050f2d5f..0295401a5 100644 --- a/src/MNH/mnh_oasis_recv.F90 +++ b/src/MNH/mnh_oasis_recv.F90 @@ -241,6 +241,7 @@ GRECV_FLOOD=(GRECV_LAND.AND.LCPL_FLOOD) IF(GRECV_SEA.OR.GRECV_FLOOD)THEN CALL UPDATE_ESM_SURF_ATM_n(YSURF_CUR%FM%F, YSURF_CUR%IM, YSURF_CUR%SM%S, & YSURF_CUR%U, YSURF_CUR%WM%W, & + YSURF_CUR%TM, YSURF_CUR%GDM, YSURF_CUR%GRM, & HPROGRAM, KI, KSW, PZENITH(:), PSW_BANDS, & PTSRAD(:), PDIR_ALB(:,:), & PSCA_ALB(:,:), PEMIS(:), & diff --git a/src/MNH/modd_ch_aeron.f90 b/src/MNH/modd_ch_aeron.f90 index 2d45e9460..121c2373d 100644 --- a/src/MNH/modd_ch_aeron.f90 +++ b/src/MNH/modd_ch_aeron.f90 @@ -2,126 +2,143 @@ !ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence !ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt !ORILAM_LIC for details. -!----------------------------------------------------------------- -!--------------- special set of characters for RCS information -!----------------------------------------------------------------- -! $Source$ $Revision$ $Date$ -!----------------------------------------------------------------- -!! ###################### +!! ##################### MODULE MODD_CH_AERO_n -!! ###################### +!! ##################### !! !! PURPOSE !! ------- -!! !! declaration of variables and types for the aerosol system !! !! METHOD !! ------ !! -!! !! REFERENCE !! --------- !! none !! -!! !! AUTHOR !! ------ !! P. Tulet (LA) !! -!! !! MODIFICATIONS !! ------------- !! (30-01-01) P.Tulet (LA) * modifications for secondary biogenics aerosols !! -!!-------------------------------------------------------------------- -!! DECLARATIONS -!! ------------ +!------------------------------------------------------------------------------- +! +!* 0. DECLARATIONS +! ------------ +! USE MODD_PARAMETERS, ONLY: JPMODELMAX -IMPLICIT NONE - -TYPE CH_AERO_t ! -!* normalisation parameters +IMPLICIT NONE ! - REAL, DIMENSION(:,:), POINTER :: XN0=>NULL() ! Number concentration - REAL, DIMENSION(:,:), POINTER :: XRG0=>NULL() ! Geometric mean size - REAL, DIMENSION(:,:), POINTER :: XSIG0=>NULL() ! Dispersion ln(sigma) - REAL, DIMENSION(:,:,:,:), POINTER :: XN3D=>NULL() ! Number concentration - REAL, DIMENSION(:,:,:,:), POINTER :: XRG3D=>NULL() ! Geometric mean size - REAL, DIMENSION(:,:,:,:), POINTER :: XSIG3D=>NULL() ! dispersion (sigma) - REAL, DIMENSION(:,:,:,:), POINTER :: XM3D=>NULL() ! moments - REAL, DIMENSION(:,:,:,:), POINTER :: XSEDA=>NULL() ! sedimentation - REAL, DIMENSION(:,:,:), POINTER :: XVDEPAERO=>NULL() ! aerosol dry deposition +TYPE CH_AERO_t + ! + !* normalisation parameters + ! + REAL, DIMENSION(:,:), POINTER :: XN0=>NULL() ! Number concentration + REAL, DIMENSION(:,:), POINTER :: XRG0=>NULL() ! Geometric mean size + REAL, DIMENSION(:,:), POINTER :: XSIG0=>NULL() ! Dispersion ln(sigma) + REAL, DIMENSION(:,:,:,:), POINTER :: XN3D=>NULL() ! Number concentration + REAL, DIMENSION(:,:,:,:), POINTER :: XRG3D=>NULL() ! Geometric mean size + REAL, DIMENSION(:,:,:,:), POINTER :: XSIG3D=>NULL() ! dispersion (sigma) + REAL, DIMENSION(:,:,:,:), POINTER :: XM3D=>NULL() ! moments + REAL, DIMENSION(:,:,:,:), POINTER :: XSEDA=>NULL() ! sedimentation + REAL, DIMENSION(:,:,:), POINTER :: XVDEPAERO=>NULL() ! aerosol dry deposition REAL, DIMENSION(:,:,:,:,:), POINTER :: XCTOTA3D=>NULL() ! Total concentration of species -! - REAL, DIMENSION(:,:,:), POINTER :: XFTEST=>NULL() - REAL, DIMENSION(:,:,:), POINTER :: XCTOTA=>NULL() ! Total concentration of species - ! (HNO3, ! H2SO4, NH3) present in - ! each of the aerosol mode (ug/m3) - REAL, DIMENSION(:,:,:), POINTER :: XCCTOT=>NULL() ! Composition of 3rd Moment (%) - REAL, DIMENSION(:,:), POINTER :: XCTOTG=>NULL() ! Total concentration of volatile - ! species (HNO3, NH3) (ug/m3) in - ! the air - REAL, DIMENSION(:,:,:,:), POINTER :: XFRAC=>NULL() ! Gas fraction into organic species - REAL, DIMENSION(:,:,:,:), POINTER :: XMI=>NULL() ! Molar mass of aerosol species (g/mol) - REAL, DIMENSION(:,:,:,:), POINTER :: XSOLORG=>NULL() ! Solubility fraction of SOA (%) - REAL, DIMENSION(:,:), POINTER :: XRHOP0=>NULL() ! Condensed phase density (kg/m3) - REAL, DIMENSION(:,:,:,:), POINTER :: XRHOP3D=>NULL() ! Condensed phase density (kg/m3) - REAL, DIMENSION(:), POINTER :: XLAMBDA=>NULL() ! Mean free path of background + ! + REAL, DIMENSION(:,:,:), POINTER :: XFTEST=>NULL() + REAL, DIMENSION(:,:,:), POINTER :: XCTOTA=>NULL() ! Total concentration of species + ! (HNO3, ! H2SO4, NH3) present in + ! each of the aerosol mode (ug/m3) + REAL, DIMENSION(:,:,:), POINTER :: XCCTOT=>NULL() ! Composition of 3rd Moment (%) + REAL, DIMENSION(:,:), POINTER :: XCTOTG=>NULL() ! Total concentration of volatile + ! species (HNO3, NH3) (ug/m3) in + ! the air + REAL, DIMENSION(:,:,:,:), POINTER :: XFRAC=>NULL() ! Gas fraction into organic species + REAL, DIMENSION(:,:,:,:), POINTER :: XMI=>NULL() ! Molar mass of aerosol species (g/mol) + REAL, DIMENSION(:,:,:,:), POINTER :: XSOLORG=>NULL() ! Solubility fraction of SOA (%) + REAL, DIMENSION(:,:), POINTER :: XRHOP0=>NULL() ! Condensed phase density (kg/m3) + REAL, DIMENSION(:,:,:,:), POINTER :: XRHOP3D=>NULL() ! Condensed phase density (kg/m3) + REAL, DIMENSION(:), POINTER :: XLAMBDA=>NULL() ! Mean free path of background ! gas molecules - REAL, DIMENSION(:), POINTER :: XMU=>NULL() ! Gas viscosity (kg/(ms)) -! -!-------------------------------------------------------------------------- -! -!* Growth parameters -! + REAL, DIMENSION(:), POINTER :: XMU=>NULL() ! gas viscosity (kg/(ms)) + REAL, DIMENSION(:,:,:), POINTER :: XJNUC=>NULL() ! nucleation rate (molec.cm-3.s-1) + REAL, DIMENSION(:,:,:), POINTER :: XJ2RAT=>NULL() ! particle formation rate for 2 nm + REAL, DIMENSION(:,:,:), POINTER :: XCONC_MASS=>NULL() ! available mass (ug.m-3) + REAL, DIMENSION(:,:,:), POINTER :: XCOND_MASS_I=>NULL() ! condensated mass mode i (ug.m-3) + REAL, DIMENSION(:,:,:), POINTER :: XCOND_MASS_J=>NULL() ! condensated mass mode j (ug.m-3) + REAL, DIMENSION(:,:,:), POINTER :: XNUCL_MASS=>NULL() ! nucleation mass (ug.m-3) + ! + REAL, DIMENSION(:,:,:,:), POINTER :: XMBEG=>NULL() + REAL, DIMENSION(:,:,:,:), POINTER :: XMINT=>NULL() + REAL, DIMENSION(:,:,:,:), POINTER :: XMEND=>NULL() + ! + REAL, DIMENSION(:,:,:,:), POINTER :: XDMINTRA=>NULL() + REAL, DIMENSION(:,:,:,:), POINTER :: XDMINTER=>NULL() + REAL, DIMENSION(:,:,:,:), POINTER :: XDMCOND=>NULL() + REAL, DIMENSION(:,:,:,:), POINTER :: XDMNUCL=>NULL() + REAL, DIMENSION(:,:,:,:), POINTER :: XDMMERG=>NULL() + ! + !* Growth parameters + ! REAL, DIMENSION(:,:), POINTER :: XOM=>NULL() - -! -!---------------------------------------------------------------------------- -! -!* Nucleation/cond. growth parameters -! + ! + !* Nucleation/cond. growth parameters + ! REAL, DIMENSION(:), POINTER :: XSO4RAT=>NULL() ! Rate of gas phase production of ! sulfuric acid (molec./cm3/s) -! -!---------------------------------------------------------------------------- -! + ! LOGICAL :: GSEDFIX = .TRUE. ! flag used in CH_AER_SEDIM_n routine -! + ! END TYPE CH_AERO_t - +! TYPE(CH_AERO_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: CH_AERO_MODEL - -REAL, DIMENSION(:,:), POINTER :: XN0=>NULL() -REAL, DIMENSION(:,:), POINTER :: XRG0=>NULL() -REAL, DIMENSION(:,:), POINTER :: XSIG0=>NULL() -REAL, DIMENSION(:,:,:,:), POINTER :: XN3D=>NULL() -REAL, DIMENSION(:,:,:,:), POINTER :: XRG3D=>NULL() -REAL, DIMENSION(:,:,:,:), POINTER :: XSIG3D=>NULL() -REAL, DIMENSION(:,:,:,:), POINTER :: XM3D=>NULL() -REAL, DIMENSION(:,:,:,:), POINTER :: XSEDA=>NULL() -REAL, DIMENSION(:,:,:), POINTER :: XVDEPAERO=>NULL() +! +REAL, DIMENSION(:,:), POINTER :: XN0=>NULL() +REAL, DIMENSION(:,:), POINTER :: XRG0=>NULL() +REAL, DIMENSION(:,:), POINTER :: XSIG0=>NULL() +REAL, DIMENSION(:,:,:,:), POINTER :: XN3D=>NULL() +REAL, DIMENSION(:,:,:,:), POINTER :: XRG3D=>NULL() +REAL, DIMENSION(:,:,:,:), POINTER :: XSIG3D=>NULL() +REAL, DIMENSION(:,:,:,:), POINTER :: XM3D=>NULL() +REAL, DIMENSION(:,:,:,:), POINTER :: XSEDA=>NULL() +REAL, DIMENSION(:,:,:), POINTER :: XVDEPAERO=>NULL() REAL, DIMENSION(:,:,:,:,:), POINTER :: XCTOTA3D=>NULL() -REAL, DIMENSION(:,:,:), POINTER :: XFTEST=>NULL() -REAL, DIMENSION(:,:,:), POINTER :: XCTOTA=>NULL() -REAL, DIMENSION(:,:,:), POINTER :: XCCTOT=>NULL() -REAL, DIMENSION(:,:), POINTER :: XCTOTG=>NULL() -REAL, DIMENSION(:,:,:,:), POINTER :: XFRAC=>NULL() -REAL, DIMENSION(:,:,:,:), POINTER :: XMI=>NULL() -REAL, DIMENSION(:,:,:,:), POINTER :: XSOLORG=>NULL() -REAL, DIMENSION(:,:), POINTER :: XRHOP0=>NULL() -REAL, DIMENSION(:,:,:,:), POINTER :: XRHOP3D=>NULL() -REAL, DIMENSION(:), POINTER :: XLAMBDA=>NULL() -REAL, DIMENSION(:), POINTER :: XMU=>NULL() -REAL, DIMENSION(:,:), POINTER :: XOM=>NULL() -REAL, DIMENSION(:), POINTER :: XSO4RAT=>NULL() -LOGICAL, POINTER :: GSEDFIX=>NULL() - +REAL, DIMENSION(:,:,:), POINTER :: XFTEST=>NULL() +REAL, DIMENSION(:,:,:), POINTER :: XCTOTA=>NULL() +REAL, DIMENSION(:,:,:), POINTER :: XCCTOT=>NULL() +REAL, DIMENSION(:,:), POINTER :: XCTOTG=>NULL() +REAL, DIMENSION(:,:,:,:), POINTER :: XFRAC=>NULL() +REAL, DIMENSION(:,:,:,:), POINTER :: XMI=>NULL() +REAL, DIMENSION(:,:,:,:), POINTER :: XSOLORG=>NULL() +REAL, DIMENSION(:,:), POINTER :: XRHOP0=>NULL() +REAL, DIMENSION(:,:,:,:), POINTER :: XRHOP3D=>NULL() +REAL, DIMENSION(:), POINTER :: XLAMBDA=>NULL() +REAL, DIMENSION(:), POINTER :: XMU=>NULL() +REAL, DIMENSION(:,:), POINTER :: XOM=>NULL() +REAL, DIMENSION(:), POINTER :: XSO4RAT=>NULL() +LOGICAL, POINTER :: GSEDFIX=>NULL() +REAL, DIMENSION(:,:,:), POINTER :: XJNUC=>NULL() +REAL, DIMENSION(:,:,:), POINTER :: XJ2RAT=>NULL() +REAL, DIMENSION(:,:,:), POINTER :: XCONC_MASS=>NULL() ! Available mass (ug.m-3) +REAL, DIMENSION(:,:,:), POINTER :: XCOND_MASS_I=>NULL() ! Condensated mass mode i (ug.m-3) +REAL, DIMENSION(:,:,:), POINTER :: XCOND_MASS_J=>NULL() ! Condensated mass mode j (ug.m-3) +REAL, DIMENSION(:,:,:), POINTER :: XNUCL_MASS=>NULL() ! Nucleation mass (ug.m-3) +REAL, DIMENSION(:,:,:,:), POINTER :: XMBEG=>NULL() +REAL, DIMENSION(:,:,:,:), POINTER :: XMINT=>NULL() +REAL, DIMENSION(:,:,:,:), POINTER :: XMEND=>NULL() +REAL, DIMENSION(:,:,:,:), POINTER :: XDMINTRA=>NULL() +REAL, DIMENSION(:,:,:,:), POINTER :: XDMINTER=>NULL() +REAL, DIMENSION(:,:,:,:), POINTER :: XDMCOND=>NULL() +REAL, DIMENSION(:,:,:,:), POINTER :: XDMNUCL=>NULL() +REAL, DIMENSION(:,:,:,:), POINTER :: XDMMERG=>NULL() +! CONTAINS - +! SUBROUTINE CH_AERO_GOTO_MODEL(KFROM, KTO) INTEGER, INTENT(IN) :: KFROM, KTO ! @@ -149,6 +166,20 @@ CH_AERO_MODEL(KFROM)%XLAMBDA=>XLAMBDA CH_AERO_MODEL(KFROM)%XMU=>XMU CH_AERO_MODEL(KFROM)%XOM=>XOM CH_AERO_MODEL(KFROM)%XSO4RAT=>XSO4RAT +CH_AERO_MODEL(KFROM)%XJNUC=>XJNUC +CH_AERO_MODEL(KFROM)%XJ2RAT=>XJ2RAT +CH_AERO_MODEL(KFROM)%XCONC_MASS=>XCONC_MASS +CH_AERO_MODEL(KFROM)%XCOND_MASS_I=>XCOND_MASS_I +CH_AERO_MODEL(KFROM)%XCOND_MASS_J=>XCOND_MASS_J +CH_AERO_MODEL(KFROM)%XNUCL_MASS=>XNUCL_MASS +CH_AERO_MODEL(KFROM)%XMBEG=>XMBEG +CH_AERO_MODEL(KFROM)%XMINT=>XMINT +CH_AERO_MODEL(KFROM)%XMEND=>XMEND +CH_AERO_MODEL(KFROM)%XDMINTRA=>XDMINTRA +CH_AERO_MODEL(KFROM)%XDMINTER=>XDMINTER +CH_AERO_MODEL(KFROM)%XDMCOND=>XDMCOND +CH_AERO_MODEL(KFROM)%XDMNUCL=>XDMNUCL +CH_AERO_MODEL(KFROM)%XDMMERG=>XDMMERG ! ! Current model is set to model KTO XN0=>CH_AERO_MODEL(KTO)%XN0 @@ -175,6 +206,20 @@ XMU=>CH_AERO_MODEL(KTO)%XMU XOM=>CH_AERO_MODEL(KTO)%XOM XSO4RAT=>CH_AERO_MODEL(KTO)%XSO4RAT GSEDFIX=>CH_AERO_MODEL(KTO)%GSEDFIX +XJNUC=>CH_AERO_MODEL(KTO)%XJNUC +XJ2RAT=>CH_AERO_MODEL(KTO)%XJ2RAT +XCONC_MASS=>CH_AERO_MODEL(KTO)%XCONC_MASS +XCOND_MASS_I=>CH_AERO_MODEL(KTO)%XCOND_MASS_I +XCOND_MASS_J=>CH_AERO_MODEL(KTO)%XCOND_MASS_J +XNUCL_MASS=>CH_AERO_MODEL(KTO)%XNUCL_MASS +XMBEG=>CH_AERO_MODEL(KTO)%XMBEG +XMINT=>CH_AERO_MODEL(KTO)%XMINT +XMEND=>CH_AERO_MODEL(KTO)%XMEND +XDMINTRA=>CH_AERO_MODEL(KTO)%XDMINTRA +XDMINTER=>CH_AERO_MODEL(KTO)%XDMINTER +XDMCOND=>CH_AERO_MODEL(KTO)%XDMCOND +XDMNUCL=>CH_AERO_MODEL(KTO)%XDMNUCL +XDMMERG=>CH_AERO_MODEL(KTO)%XDMMERG END SUBROUTINE CH_AERO_GOTO_MODEL - +! END MODULE MODD_CH_AERO_n diff --git a/src/MNH/modd_ch_aerosol.f90 b/src/MNH/modd_ch_aerosol.f90 index defa8f71a..78e61cb5f 100644 --- a/src/MNH/modd_ch_aerosol.f90 +++ b/src/MNH/modd_ch_aerosol.f90 @@ -1,8 +1,7 @@ -!ORILAM_LIC Copyright 2006-2021 CNRS, Meteo-France and Universite Paul Sabatier +!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier !ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence !ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt !ORILAM_LIC for details. -!----------------------------------------------------------------- !! ###################### MODULE MODD_CH_AEROSOL !! ###################### @@ -30,23 +29,17 @@ !! ------------- !! (30-01-01) P.Tulet (LA) * modifications for secondary biogenics aerosols !! (25-08-16) M.Leriche (LA) * NM6_AER is now in SAVE and assign in ini_nsv -! P. Wautelet 07/06/2019: allocate weights only when needed -! P. Wautelet 09/03/2021: simplify allocation of scalar variable names -!!-------------------------------------------------------------------- -!! DECLARATIONS -!! ------------ +!! +!------------------------------------------------------------------------------- +! +!* 0. DECLARATIONS +! ------------ +! USE MODD_PARAMETERS, ONLY: JPMODELMAX, JPSVNAMELGTMAX ! IMPLICIT NONE ! ! aerosol mode parameters -! -LOGICAL :: LORILAM = .FALSE. ! switch to active aerosols fluxes -LOGICAL :: LINITPM = .TRUE. ! switch to initialize BC -LOGICAL :: LAERINIT = .FALSE. ! switch to initialize aerosols - -LOGICAL,DIMENSION(JPMODELMAX) :: LDEPOS_AER = .FALSE. ! switch to AER wet depositon - ! and OC from CO concentration (real_case) INTEGER, PARAMETER :: JPMODE=2 ! number of modes INTEGER, PARAMETER :: JPIN=JPMODE*3 ! number of differential equations @@ -56,6 +49,14 @@ CHARACTER(LEN=JPSVNAMELGTMAX), DIMENSION(JPMODE*2), PARAMETER :: CDEAERNAMES = & (/'DEAERM31C','DEAERM32C' & ,'DEAERM31R','DEAERM32R' /) ! + +LOGICAL :: LORILAM = .FALSE. ! switch to active aerosols fluxes +LOGICAL :: LINITPM = .TRUE. ! switch to initialize BC +LOGICAL :: LAERINIT = .FALSE. ! switch to initialize aerosols +! +LOGICAL,DIMENSION(JPMODELMAX) :: LDEPOS_AER = .FALSE. ! switch to AER wet depositon + ! and OC from CO concentration (real_case) +! !* indices of Aerosol chemical parameters ! INTEGER, PARAMETER :: NSP=4 ! number of chemical species @@ -74,7 +75,7 @@ INTEGER, PARAMETER :: NCARB=3 ! number of chemically inert species INTEGER, PARAMETER :: JP_AER_OC = 5 INTEGER, PARAMETER :: JP_AER_BC = 6 INTEGER, PARAMETER :: JP_AER_DST = 7 - +! INTEGER :: NSOA = 10 ! number of condensable species that may form ! secondary aerosols INTEGER, SAVE :: NM6_AER ! number of mode for which M6 is computed define in ini_sv @@ -89,23 +90,23 @@ INTEGER :: JP_AER_SOA7 = 14 INTEGER :: JP_AER_SOA8 = 15 INTEGER :: JP_AER_SOA9 = 16 INTEGER :: JP_AER_SOA10 = 17 - +! CHARACTER(LEN=32),DIMENSION(:), ALLOCATABLE :: CAERONAMES - -INTEGER :: JP_CH_SO4I = 1 -INTEGER :: JP_CH_SO4J = 2 -INTEGER :: JP_CH_NO3I = 3 -INTEGER :: JP_CH_NO3J = 4 -INTEGER :: JP_CH_NH3I = 5 -INTEGER :: JP_CH_NH3J = 6 -INTEGER :: JP_CH_H2OI = 7 -INTEGER :: JP_CH_H2OJ = 8 -INTEGER :: JP_CH_OCI = 9 -INTEGER :: JP_CH_OCJ = 10 -INTEGER :: JP_CH_BCI = 11 -INTEGER :: JP_CH_BCJ = 12 -INTEGER :: JP_CH_DSTI = 13 -INTEGER :: JP_CH_DSTJ = 14 +! +INTEGER :: JP_CH_SO4I = 1 +INTEGER :: JP_CH_SO4J = 2 +INTEGER :: JP_CH_NO3I = 3 +INTEGER :: JP_CH_NO3J = 4 +INTEGER :: JP_CH_NH3I = 5 +INTEGER :: JP_CH_NH3J = 6 +INTEGER :: JP_CH_H2OI = 7 +INTEGER :: JP_CH_H2OJ = 8 +INTEGER :: JP_CH_OCI = 9 +INTEGER :: JP_CH_OCJ = 10 +INTEGER :: JP_CH_BCI = 11 +INTEGER :: JP_CH_BCJ = 12 +INTEGER :: JP_CH_DSTI = 13 +INTEGER :: JP_CH_DSTJ = 14 INTEGER :: JP_CH_SOA1I = 15 INTEGER :: JP_CH_SOA1J = 16 INTEGER :: JP_CH_SOA2I = 17 @@ -126,106 +127,106 @@ INTEGER :: JP_CH_SOA9I = 31 INTEGER :: JP_CH_SOA9J = 32 INTEGER :: JP_CH_SOA10I = 33 INTEGER :: JP_CH_SOA10J = 34 -INTEGER :: JP_CH_M0I = 35 -INTEGER :: JP_CH_M0J = 36 -INTEGER :: JP_CH_M6I = 37 -INTEGER :: JP_CH_M6J = 38 - -!INTEGER, PARAMETER :: JPNN=NSP+NSOA+NCARB - +INTEGER :: JP_CH_M0I = 35 +INTEGER :: JP_CH_M0J = 36 +INTEGER :: JP_CH_M6I = 37 +INTEGER :: JP_CH_M6J = 38 +! ! Index for gas species which interact with aerosols -INTEGER :: JP_CH_HNO3, JP_CH_H2SO4, JP_CH_NH3, JP_CH_O3, JP_CH_CO, & - JP_CH_URG1, JP_CH_URG2, JP_CH_RPG2, JP_CH_RP18, JP_CH_UR26,& - JP_CH_RPG3, JP_CH_URG4, JP_CH_UR8, JP_CH_UR17, JP_CH_UR7, JP_CH_URG6, & +INTEGER :: JP_CH_HNO3, JP_CH_H2SO4, JP_CH_NH3, JP_CH_O3, JP_CH_CO, & + JP_CH_URG1, JP_CH_URG2, JP_CH_RPG2, JP_CH_RP18, JP_CH_UR26, & + JP_CH_RPG3, JP_CH_URG4, JP_CH_UR8, JP_CH_UR17, JP_CH_UR7, JP_CH_URG6, & JP_CH_ARAC, JP_CH_URG7, JP_CH_RPG7, JP_CH_RPR7, JP_CH_URG8, JP_CH_UR19, & JP_CH_URG9, JP_CH_URG10, JP_CH_PAN8, JP_CH_UR22, JP_CH_RPR4, JP_CH_AP7, & - JP_CH_RPR3, JP_CH_UR21, JP_CH_UR28, JP_CH_UR29, JP_CH_UR30, & - JP_CH_RPR9, JP_CH_RP12, JP_CH_UR3, JP_CH_UR23, JP_CH_UR31, JP_CH_AP1, & - JP_CH_AP6, JP_CH_ADAC, JP_CH_UR2, JP_CH_UR14, JP_CH_UR27, JP_CH_RP14, & + JP_CH_RPR3, JP_CH_UR21, JP_CH_UR28, JP_CH_UR29, JP_CH_UR30, & + JP_CH_RPR9, JP_CH_RP12, JP_CH_UR3, JP_CH_UR23, JP_CH_UR31, JP_CH_AP1, & + JP_CH_AP6, JP_CH_ADAC, JP_CH_UR2, JP_CH_UR14, JP_CH_UR27, JP_CH_RP14, & JP_CH_RP19, JP_CH_UR11, JP_CH_UR15, JP_CH_AP10, JP_CH_UR20, JP_CH_UR34, & - JP_CH_AP11, JP_CH_AP12, JP_CH_UR5, JP_CH_UR6, JP_CH_AP8, JP_CH_RP17,& + JP_CH_AP11, JP_CH_AP12, JP_CH_UR5, JP_CH_UR6, JP_CH_AP8, JP_CH_RP17, & JP_CH_RP13 - +! INTEGER :: JP_CH_H2O2, JP_CH_SO2, JP_CH_SO42M ! -REAL, SAVE, DIMENSION(:), ALLOCATABLE :: XRHOI ! volumar mass of species i (kg/m3) - -REAL, SAVE, DIMENSION(:), ALLOCATABLE :: XFAC ! conversion factor um3/m3 -> ug/cm3 - ! for each chemical species - - -! Molar mass of each aerosols parents (in kg/mol) -REAL, PARAMETER :: XHNO3=63.01287 -REAL, PARAMETER :: XH2SO4=98.079 -REAL, PARAMETER :: XNH3 =17.03061 -REAL, PARAMETER :: XURG1=88. -REAL, PARAMETER :: XURG2=1.76981E+02 -REAL, PARAMETER :: XRPG2=1.68000E+02 -REAL, PARAMETER :: XRP18=1.84000E+02 -REAL, PARAMETER :: XRPG3=1.53772E+02 -REAL, PARAMETER :: XURG4=1.95867E+02 -REAL, PARAMETER :: XUR17=1.72000E+02 -REAL, PARAMETER :: XRPR3=1.86000E+02 -REAL, PARAMETER :: XAP7 =2.33000E+02 -REAL, PARAMETER :: XURG6=1.89153E+02 -REAL, PARAMETER :: XUR22=2.12000E+02 -REAL, PARAMETER :: XURG7=1.56781E+02 -REAL, PARAMETER :: XADAC=1.56781E+02 -REAL, PARAMETER :: XRPR4=1.67000E+02 -REAL, PARAMETER :: XRPR7=1.50000E+02 -REAL, PARAMETER :: XRPG7=1.96059E+02 -REAL, PARAMETER :: XURG8=1.73777E+02 -REAL, PARAMETER :: XURG9=2.61676E+02 -REAL, PARAMETER :: XUR26=1.68000E+02 -REAL, PARAMETER :: XURG10=2.14834E+02 -REAL, PARAMETER :: XUR7=1.68000E+02 -REAL, PARAMETER :: XUR8=1.84000E+02 -REAL, PARAMETER :: XPAN8=2.63000E+02 -REAL, PARAMETER :: XARAC=1.66000E+02 -REAL, PARAMETER :: XUR19=1.70000E+02 -REAL, PARAMETER :: XUR21=88. -REAL, PARAMETER :: XUR28=90. -REAL, PARAMETER :: XUR29=186.0 -REAL, PARAMETER :: XUR30=200.0 -REAL, PARAMETER :: XRP13=168. -REAL, PARAMETER :: XRP17=170.0 -REAL, PARAMETER :: XRPR9=154.0 -REAL, PARAMETER :: XRP12=152.0 -REAL, PARAMETER :: XUR3=202.0 -REAL, PARAMETER :: XUR23=144.0 -REAL, PARAMETER :: XUR31=220.0 -REAL, PARAMETER :: XAP1=183.0 -REAL, PARAMETER :: XAP6=197.0 -REAL, PARAMETER :: XRP14=188.0 -REAL, PARAMETER :: XRP19=204.0 -REAL, PARAMETER :: XUR2=152.0 -REAL, PARAMETER :: XUR14=181.0 -REAL, PARAMETER :: XUR27=164.0 -REAL, PARAMETER :: XUR11=172.0 -REAL, PARAMETER :: XUR15=201.0 -REAL, PARAMETER :: XAP10=217.0 -REAL, PARAMETER :: XUR20=256.0 -REAL, PARAMETER :: XUR34=240.0 -REAL, PARAMETER :: XAP11=287.0 -REAL, PARAMETER :: XAP12=303.0 -REAL, PARAMETER :: XUR5=170.0 -REAL, PARAMETER :: XUR6=170.0 -REAL, PARAMETER :: XAP8=215.0 - - +! volumar mass of species i [kg/m3] +REAL, SAVE, DIMENSION(:), ALLOCATABLE :: XRHOI +! +! conversion factor : +! ------------------- +! moment3 [um3_aer/m3_air] = conc[ug_aer/m3_air]/XFAC +! +REAL, SAVE, DIMENSION(:), ALLOCATABLE :: XFAC +! +! Molar mass of each aerosols parents [g/mol] +REAL, PARAMETER :: XHNO3 = 63.01287 +REAL, PARAMETER :: XH2SO4 = 98.079 +REAL, PARAMETER :: XNH3 = 17.03061 +REAL, PARAMETER :: XURG1 = 88. +REAL, PARAMETER :: XURG2 = 1.76981E+02 +REAL, PARAMETER :: XRPG2 = 1.68000E+02 +REAL, PARAMETER :: XRP18 = 1.84000E+02 +REAL, PARAMETER :: XRPG3 = 1.53772E+02 +REAL, PARAMETER :: XURG4 = 1.95867E+02 +REAL, PARAMETER :: XUR17 = 1.72000E+02 +REAL, PARAMETER :: XRPR3 = 1.86000E+02 +REAL, PARAMETER :: XAP7 = 2.33000E+02 +REAL, PARAMETER :: XURG6 = 1.89153E+02 +REAL, PARAMETER :: XUR22 = 2.12000E+02 +REAL, PARAMETER :: XURG7 = 1.56781E+02 +REAL, PARAMETER :: XADAC = 1.56781E+02 +REAL, PARAMETER :: XRPR4 = 1.67000E+02 +REAL, PARAMETER :: XRPR7 = 1.50000E+02 +REAL, PARAMETER :: XRPG7 = 1.96059E+02 +REAL, PARAMETER :: XURG8 = 1.73777E+02 +REAL, PARAMETER :: XURG9 = 2.61676E+02 +REAL, PARAMETER :: XUR26 = 1.68000E+02 +REAL, PARAMETER :: XURG10 = 2.14834E+02 +REAL, PARAMETER :: XUR7 = 1.68000E+02 +REAL, PARAMETER :: XUR8 = 1.84000E+02 +REAL, PARAMETER :: XPAN8 = 2.63000E+02 +REAL, PARAMETER :: XARAC = 1.66000E+02 +REAL, PARAMETER :: XUR19 = 1.70000E+02 +REAL, PARAMETER :: XUR21 = 88. +REAL, PARAMETER :: XUR28 = 90. +REAL, PARAMETER :: XUR29 = 186.0 +REAL, PARAMETER :: XUR30 = 200.0 +REAL, PARAMETER :: XRP13 = 168. +REAL, PARAMETER :: XRP17 = 170.0 +REAL, PARAMETER :: XRPR9 = 154.0 +REAL, PARAMETER :: XRP12 = 152.0 +REAL, PARAMETER :: XUR3 = 202.0 +REAL, PARAMETER :: XUR23 = 144.0 +REAL, PARAMETER :: XUR31 = 220.0 +REAL, PARAMETER :: XAP1 = 183.0 +REAL, PARAMETER :: XAP6 = 197.0 +REAL, PARAMETER :: XRP14 = 188.0 +REAL, PARAMETER :: XRP19 = 204.0 +REAL, PARAMETER :: XUR2 = 152.0 +REAL, PARAMETER :: XUR14 = 181.0 +REAL, PARAMETER :: XUR27 = 164.0 +REAL, PARAMETER :: XUR11 = 172.0 +REAL, PARAMETER :: XUR15 = 201.0 +REAL, PARAMETER :: XAP10 = 217.0 +REAL, PARAMETER :: XUR20 = 256.0 +REAL, PARAMETER :: XUR34 = 240.0 +REAL, PARAMETER :: XAP11 = 287.0 +REAL, PARAMETER :: XAP12 = 303.0 +REAL, PARAMETER :: XUR5 = 170.0 +REAL, PARAMETER :: XUR6 = 170.0 +REAL, PARAMETER :: XAP8 = 215.0 +! !---------------------------------------------------------------------------- ! REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: XSURF REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: XDP - +! ! Declaration for the Bessagnet tabulation REAL, SAVE, DIMENSION(:), ALLOCATABLE :: rhi REAL, SAVE, DIMENSION(:), ALLOCATABLE :: tempi REAL, SAVE, DIMENSION(:), ALLOCATABLE :: zsu, znh, zni REAL, SAVE, DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: zf - +! ! Declaration of the neuronal coefficients - +! ! .. weights REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: W1IJA,W1JKA,W2IJA,W2JKA REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: W1IJB,W1JKB,W2IJB,W2JKB @@ -234,40 +235,44 @@ REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: X1MINA,X1MAXA,X1MODA,X2MINA,X2MAXA,X2 REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: X1MINB,X1MAXB,X1MODB,X2MINB,X2MAXB,X2MODB REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: X1MINC,X1MAXC,X1MODC,X2MINC,X2MAXC,X2MODC +! ! .. counters and indices INTEGER, SAVE :: I1IA,J1JA,K1KA,I2IA,J2JA,K2KA INTEGER, SAVE :: I1IB,J1JB,K1KB,I2IB,J2JB,K2KB INTEGER, SAVE :: I1IC,J1JC,K1KC,I2IC,J2JC,K2KC - +! !---------------------------------------------------------------------------- -! aerosol lognormal parameterization -CHARACTER(LEN=4) :: CRGUNIT = 'NUMB' ! type of log-normal geometric mean radius -! !given in namelist (mass on number) - -LOGICAL :: LVARSIGI = .FALSE. ! switch to active pronostic dispersion for I mode -LOGICAL :: LVARSIGJ = .FALSE. ! switch to active pronostic dispersion for J mode -LOGICAL :: LVARSIGK = .FALSE. ! switch to active pronostic dispersion for J mode -LOGICAL :: LHETEROSO4 = .FALSE. ! switch to active sulfates heteronegeous - ! production -LOGICAL :: LRGFIX = .FALSE. ! switch to active aerosol sedimentation -LOGICAL :: LSEDIMAERO = .FALSE. ! switch to active aerosol sedimentation -REAL :: XN0IMIN = 1.E6 ! minimum particule number value for I mode / m3 -REAL :: XN0JMIN = 0.01E6 ! minimum particule number value for J mode / m3 -REAL :: XINIRADIUSI= 0.039 ! mean radius initialization for I mode (um) -REAL :: XINIRADIUSJ= 0.321 ! mean radius initialization for J mode (um) -REAL :: XINISIGI = 1.75 ! dispersion initialization for I mode -REAL :: XINISIGJ = 1.76 ! dispersion initialization for J mode -REAL :: XSIGIMIN = 1.10 ! minimum dispersion value for I mode -REAL :: XSIGJMIN = 1.10 ! minimum dispersion value for J mode -REAL :: XSIGIMAX = 3.60 ! maximum dispersion value for I mode -REAL :: XSIGJMAX = 3.60 ! maximum dispersion value for J mode -REAL :: XCOEFRADIMAX = 30. ! maximum increasement for Rg mode I -REAL :: XCOEFRADIMIN = 3. ! maximum decreasement for Rg mode I -REAL :: XCOEFRADJMAX = 30. ! maximum increasement for Rg mode J -REAL :: XCOEFRADJMIN = 10. ! maximum decreasement for Rg mode J -CHARACTER(LEN=5) :: CMINERAL = "NONE" ! mineral equilibrium scheme -CHARACTER(LEN=5) :: CORGANIC = "NONE" ! organic equilibrium scheme -CHARACTER(LEN=80) :: CNUCLEATION = "NONE" ! sulfates nucleation scheme +! aerosol lognormal parameterizations ! +CHARACTER(LEN=4) :: CRGUNIT = 'NUMB' ! type of log-normal geometric mean radius +! ! given in namelist (mass on number) +LOGICAL :: LVARSIGI = .FALSE. ! switch to active pronostic dispersion for I mode +LOGICAL :: LVARSIGJ = .FALSE. ! switch to active pronostic dispersion for J mode +LOGICAL :: LVARSIGK = .FALSE. ! switch to active pronostic dispersion for K mode, not used +LOGICAL :: LHETEROSO4 = .FALSE. ! switch to active sulfates heteronegeous production +LOGICAL :: LRGFIX = .FALSE. ! switch to active aerosol sedimentation +LOGICAL :: LSEDIMAERO = .FALSE. ! switch to active aerosol sedimentation +REAL :: XN0IMIN = 1.E4 ! minimum particule number value for I mode / m3 +REAL :: XN0JMIN = 0.01E4 ! minimum particule number value for J mode / m3 +REAL :: XINIRADIUSI = 0.030 ! mean radius initialization for I mode (um) +REAL :: XINIRADIUSJ = 0.200 ! mean radius initialization for J mode (um) +REAL :: XINISIGI = 1.75 ! dispersion initialization for I mode +REAL :: XINISIGJ = 1.76 ! dispersion initialization for J mode +REAL :: XSIGIMIN = 1.10 ! minimum dispersion value for I mode +REAL :: XSIGJMIN = 1.10 ! minimum dispersion value for J mode +REAL :: XSIGIMAX = 3.60 ! maximum dispersion value for I mode +REAL :: XSIGJMAX = 3.60 ! maximum dispersion value for J mode +REAL :: XCOEFRADIMAX = 30. ! maximum increasement for Rg mode I +REAL :: XCOEFRADIMIN = 10. ! maximum decreasement for Rg mode I +REAL :: XCOEFRADJMAX = 30. ! maximum increasement for Rg mode J +REAL :: XCOEFRADJMIN = 10. ! maximum decreasement for Rg mode J +REAL :: XRADIUS_NUCL = 2E-3 ! Radius of new particles created by nucleation [um] +REAL :: XSIGMA_NUCL = 1.5 ! Sigma of new particles created by nucleation [um] +CHARACTER(LEN=5) :: CMINERAL = "NONE" ! mineral equilibrium scheme +CHARACTER(LEN=5) :: CORGANIC = "NONE" ! organic equilibrium scheme +CHARACTER(LEN=80) :: CNUCLEATION = "NONE" ! sulfates nucleation scheme +LOGICAL :: LCONDENSATION = .TRUE. ! sulfates condensation scheme +LOGICAL :: LCOAGULATION = .TRUE. ! coagulation scheme +LOGICAL :: LMODE_MERGING = .TRUE. ! mode merging ! END MODULE MODD_CH_AEROSOL diff --git a/src/MNH/modd_csts_salt.f90 b/src/MNH/modd_csts_salt.f90 index 9db26edac..7e8cbfe45 100644 --- a/src/MNH/modd_csts_salt.f90 +++ b/src/MNH/modd_csts_salt.f90 @@ -44,7 +44,8 @@ IMPLICIT NONE ! !densité salt a introduire ! ++ PIERRE / MARINE SSA DUST - MODIF ++ -REAL, PARAMETER :: XDENSITY_SALT = 2.2e3 ![kg/m3] density of dust +REAL, PARAMETER :: XDENSITY_DRYSALT = 2.160e3 ![kg/m3] density of sea salt (dry NaCl 2.160E3) +REAL, PARAMETER :: XDENSITY_SALT = 1.173e3 ![kg/m3] density of wet sea salt (Saltwater at RH80: 1.17e3) ! -- PIERRE / MARINE SSA DUST - MODIF -- REAL, PARAMETER :: XMOLARWEIGHT_SALT = 58.e-3 ![kg/mol] molar weight dust REAL, PARAMETER :: XM3TOUM3_SALT = 1.d18 ![um3/m3] conversion factor diff --git a/src/MNH/modd_dust.f90 b/src/MNH/modd_dust.f90 index a99fc6f4e..540de108e 100644 --- a/src/MNH/modd_dust.f90 +++ b/src/MNH/modd_dust.f90 @@ -33,7 +33,7 @@ !! !! MODIFICATIONS !! ------------- -!! +!! T. Hoarau 03/2019 add a switch for initialisation from MACC !!-------------------------------------------------------------------- !! DECLARATIONS !! ------------ @@ -42,9 +42,10 @@ USE MODD_PARAMETERS, ONLY: JPMODELMAX IMPLICIT NONE ! LOGICAL :: LDUST = .FALSE. ! switch to active pronostic dusts +LOGICAL :: LDSTCAMS = .FALSE. ! switch to active pronostic dusts from MACC LOGICAL :: LDSTINIT = .FALSE. ! switch to initialize pronostic dusts LOGICAL :: LDSTPRES = .FALSE. ! switch to know if pronostic dusts exist -LOGICAL,DIMENSION(JPMODELMAX) :: LDEPOS_DST = .FALSE. ! switch to DST wet depositon +LOGICAL,DIMENSION(JPMODELMAX) :: LDEPOS_DST = .FALSE. ! switch to DST wet deposition INTEGER :: NMODE_DST= 3 ! number of dust modes (max 3; default = 3) ! CHARACTER(LEN=6),DIMENSION(:),ALLOCATABLE :: CDUSTNAMES diff --git a/src/MNH/modd_param_lima.f90 b/src/MNH/modd_param_lima.f90 index 66156a056..8e9c1c428 100644 --- a/src/MNH/modd_param_lima.f90 +++ b/src/MNH/modd_param_lima.f90 @@ -31,6 +31,7 @@ !! MODIFICATIONS !! ------------- !! Original ??/??/13 +!! C. Barthe 14/03/2022 add CIBU and RDSF !! !------------------------------------------------------------------------------- ! @@ -58,6 +59,8 @@ LOGICAL, SAVE :: LHHONI ! TRUE to enable freezing of haze partic LOGICAL, SAVE :: LSNOW ! TRUE to enable snow and graupel LOGICAL, SAVE :: LHAIL ! TRUE to enable hail LOGICAL, SAVE :: LMEYERS ! TRUE to use Meyers nucleation +LOGICAL, SAVE :: LCIBU ! TRUE to use collisional ice breakup +LOGICAL, SAVE :: LRDSF ! TRUE to use rain drop shattering by freezing ! ! 1.2 IFN initialisation ! @@ -83,8 +86,8 @@ REAL, DIMENSION(:), SAVE, ALLOCATABLE :: XFRAC_REF ! AP compostion in P CHARACTER(LEN=4), SAVE :: CPRISTINE_ICE_LIMA ! Pristine type PLAT, COLU or BURO CHARACTER(LEN=4), SAVE :: CHEVRIMED_ICE_LIMA ! Heavily rimed type GRAU or HAIL REAL,SAVE :: XALPHAI,XNUI, & ! Pristine ice distribution parameters - XALPHAS,XNUS, & ! Snow/aggregate distribution parameters - XALPHAG,XNUG ! Graupel distribution parameters + XALPHAS,XNUS, & ! Snow/aggregate distribution parameters + XALPHAG,XNUG ! Graupel distribution parameters ! ! 1.4 Phillips (2013) nucleation parameterization ! @@ -113,6 +116,11 @@ REAL,SAVE :: XFACTNUC_DEP,XFACTNUC_CON ! Amplification factor for IN conc. ! DEP refers to DEPosition mode ! CON refers to CONtact mode ! +! 1.6 Collisional Ice Break Up parameterization +! +REAL,SAVE :: XNDEBRIS_CIBU ! Number of ice crystal debris produced + ! by the break up of aggregate particles +! !------------------------------------------------------------------------------- ! ! diff --git a/src/MNH/modd_param_lima_cold.f90 b/src/MNH/modd_param_lima_cold.f90 index 64494219e..9db92526b 100644 --- a/src/MNH/modd_param_lima_cold.f90 +++ b/src/MNH/modd_param_lima_cold.f90 @@ -19,6 +19,7 @@ !! MODIFICATIONS !! ------------- !! Original ??/??/13 +!! C. Barthe 14/03/2022 add CIBU and RDSF !! !------------------------------------------------------------------------------- USE MODD_PARAMETERS, ONLY: JPSVNAMELGTMAX @@ -72,11 +73,11 @@ CHARACTER(LEN=JPSVNAMELGTMAX),DIMENSION(5),PARAMETER & ! --------------------- ! REAL,SAVE :: XFSEDRI,XFSEDCI, & ! Constants for sedimentation - XFSEDS, XEXSEDS ! fluxes of ice and snow + XFSEDS, XEXSEDS ! fluxes of ice and snow ! REAL,SAVE :: XNUC_DEP,XEXSI_DEP,XEX_DEP, & ! Constants for heterogeneous - XNUC_CON,XEXTT_CON,XEX_CON, & ! ice nucleation : DEP et CON - XMNU0 ! mass of nucleated ice crystal + XNUC_CON,XEXTT_CON,XEX_CON, & ! ice nucleation : DEP et CON + XMNU0 ! mass of nucleated ice crystal ! REAL,SAVE :: XRHOI_HONH,XCEXP_DIFVAP_HONH, & ! Constants for homogeneous XCOEF_DIFVAP_HONH,XRCOEF_HONH, & ! haze freezing : HHONI @@ -86,7 +87,7 @@ REAL,SAVE :: XRHOI_HONH,XCEXP_DIFVAP_HONH, & ! Constants for homogeneous XC1_HONH,XC2_HONH,XC3_HONH ! REAL,SAVE :: XC_HONC,XR_HONC, & ! Constants for homogeneous - XTEXP1_HONC,XTEXP2_HONC, & ! droplet freezing : CHONI + XTEXP1_HONC,XTEXP2_HONC, & ! droplet freezing : CHONI XTEXP3_HONC,XTEXP4_HONC, & XTEXP5_HONC ! @@ -97,7 +98,7 @@ REAL,SAVE :: XCSCNVI_MAX, XLBDASCNVI_MAX, & XR0DEPSI,XR1DEPSI ! pristine ice : SCNVI ! REAL,SAVE :: XSCFAC, & ! Constants for the Bergeron - X0DEPI,X2DEPI, & ! Findeisen process and + X0DEPI,X2DEPI, & ! Findeisen process and X0DEPS,X1DEPS,XEX0DEPS,XEX1DEPS ! deposition ! REAL,SAVE :: XDICNVS_LIM, XLBDAICNVS_LIM, & ! Constants for pristine ice @@ -105,7 +106,7 @@ REAL,SAVE :: XDICNVS_LIM, XLBDAICNVS_LIM, & ! Constants for pristine ice XR0DEPIS,XR1DEPIS ! snow : ICNVS ! REAL,SAVE :: XCOLEXIS, & ! Constants for snow - XAGGS_CLARGE1,XAGGS_CLARGE2, & ! aggregation : AGG + XAGGS_CLARGE1,XAGGS_CLARGE2, & ! aggregation : AGG XAGGS_RLARGE1,XAGGS_RLARGE2 ! !?????????????????? @@ -123,6 +124,40 @@ REAL,SAVE :: XCONCI_MAX ! Limitation of the pristine ! ice concentration (init and grid-nesting) REAL,SAVE :: XFREFFI ! Factor to compute the cloud ice effective radius ! +! +! Constants for ice-ice collision : CIBU +! +REAL, SAVE :: XDCSLIM_CIBU_MIN, & ! aggregates min diam. : 0.2 mm + XDCSLIM_CIBU_MAX, & ! aggregates max diam. : 1.0 mm + XDCGLIM_CIBU_MIN, & ! graupel min diam. : 2 mm + XGAMINC_BOUND_CIBU_SMIN, & ! Min val. of Lbda_s*dlim + XGAMINC_BOUND_CIBU_SMAX, & ! Max val. of Lbda_s*dlim + XGAMINC_BOUND_CIBU_GMIN, & ! Min val. of Lbda_g*dlim + XGAMINC_BOUND_CIBU_GMAX, & ! Max val. of Lbda_g*dlim + XCIBUINTP_S,XCIBUINTP1_S, & ! + XCIBUINTP2_S, & ! + XCIBUINTP_G,XCIBUINTP1_G, & ! + XFACTOR_CIBU_NI,XFACTOR_CIBU_RI, & ! Factor for final CIBU Eq. + XMOMGG_CIBU_1,XMOMGG_CIBU_2, & ! Moment computation + XMOMGS_CIBU_1,XMOMGS_CIBU_2, & + XMOMGS_CIBU_3 +! +REAL, DIMENSION(:,:), SAVE, ALLOCATABLE & + :: XGAMINC_CIBU_S, & ! Tab.incomplete Gamma function + XGAMINC_CIBU_G ! Tab.incomplete Gamma function +! +! Constants for raindrop shattering : RDSF +! +REAL, SAVE :: XDCRLIM_RDSF_MIN, & ! Raindrops min diam. : 0.2 mm + XGAMINC_BOUND_RDSF_RMIN, & ! Min val. of Lbda_r*dlim + XGAMINC_BOUND_RDSF_RMAX, & ! Max val. of Lbda_r*dlim + XRDSFINTP_R,XRDSFINTP1_R, & ! + XFACTOR_RDSF_NI, & ! Factor for final RDSF Eq. + XMOMGR_RDSF +! +REAL, DIMENSION(:), SAVE, ALLOCATABLE & + :: XGAMINC_RDSF_R ! Tab.incomplete Gamma function +! !------------------------------------------------------------------------------- ! END MODULE MODD_PARAM_LIMA_COLD diff --git a/src/MNH/modd_prep_real.f90 b/src/MNH/modd_prep_real.f90 index 6933ae26a..8fdd4cebd 100644 --- a/src/MNH/modd_prep_real.f90 +++ b/src/MNH/modd_prep_real.f90 @@ -78,6 +78,9 @@ REAL,DIMENSION(:,:,:), ALLOCATABLE :: XPMHP_LS ! pressure minus hyd. pressure REAL,DIMENSION(:,:,:), ALLOCATABLE :: XTHV_LS ! virtual potential temperature REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: XR_LS ! water mixing ratios REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: XSV_LS ! scalar mixing ratios +!UPG*PT +REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: XSV_LS_LIMA ! scalar mixing ratios for lima +!UPG*PT REAL,DIMENSION(:,:,:), ALLOCATABLE :: XHU_LS ! relative humidity REAL,DIMENSION(:,:,:), ALLOCATABLE :: XTKE_LS ! turbulence kinetic energy REAL,DIMENSION(:,:,:), ALLOCATABLE :: XU_LS ! pseudo zonal wind component diff --git a/src/MNH/modd_salt.f90 b/src/MNH/modd_salt.f90 index 769ca39f1..e111b15db 100644 --- a/src/MNH/modd_salt.f90 +++ b/src/MNH/modd_salt.f90 @@ -35,16 +35,16 @@ !! ------------- !! !! 2014 P.Tulet modif XINIRADIUS_SLT and XN0MIN_SLT -!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes !! USE MODD_PARAMETERS, ONLY: JPMODELMAX +!USE MODD_SLT_n, ONLY : SLT_t !!-------------------------------------------------------------------- !! DECLARATIONS !! ------------ IMPLICIT NONE ! ! ++ PIERRE / MARINE SSA DUST - MODIF ++ -LOGICAL :: LSLTMACC = .FALSE. ! switch to active pronostic sea salts from MACC +LOGICAL :: LSLTCAMS = .FALSE. ! switch to active pronostic sea salts from CAMS LOGICAL :: LSALT = .FALSE. ! switch to active pronostic sea salts LOGICAL :: LONLY = .FALSE. LOGICAL :: LREAD_ONLY_HS_MACC = .FALSE. @@ -52,37 +52,39 @@ LOGICAL :: LSLTINIT = .FALSE. ! switch to initialize pronostic sea salts LOGICAL :: LSLTPRES = .FALSE. ! switch to know if pronostic salts exist LOGICAL,DIMENSION(JPMODELMAX) :: LDEPOS_SLT = .FALSE. ! switch to SLT wet depositon -!INTEGER :: NMODE_SLT= 3 ! number of sea salt modes (max 3; default = 3) -INTEGER :: NMODE_SLT= 5 ! number of sea salt modes (max 5; default = 3) -! CHARACTER(LEN=9),DIMENSION(:),ALLOCATABLE :: CDESLTNAMES CHARACTER(LEN=6),DIMENSION(:), ALLOCATABLE :: CSALTNAMES -CHARACTER(LEN=9),DIMENSION(10), PARAMETER :: YPDESLT_INI = & - (/'DESLTM31C','DESLTM32C','DESLTM33C','DESLTM34C', 'DESLTM35C', & - 'DESLTM31R','DESLTM32R','DESLTM33R', 'DESLTM34R','DESLTM35R' /) +CHARACTER(LEN=9),DIMENSION(16), PARAMETER :: YPDESLT_INI = & + (/'DESLTM31C','DESLTM32C','DESLTM33C','DESLTM34C', 'DESLTM35C','DESLTM36C', & + 'DESLTM37C','DESLTM38C',& + 'DESLTM31R','DESLTM32R','DESLTM33R', 'DESLTM34R','DESLTM35R','DESLTM36R','DESLTM37R','DESLTM38R' /) -CHARACTER(LEN=6),DIMENSION(15), PARAMETER :: YPSALT_INI = & +CHARACTER(LEN=6),DIMENSION(24), PARAMETER :: YPSALT_INI = & (/'SLTM01','SLTM31','SLTM61',& 'SLTM02','SLTM32','SLTM62',& 'SLTM03','SLTM33','SLTM63',& 'SLTM04','SLTM34','SLTM64',& - 'SLTM05','SLTM35','SLTM65' /) + 'SLTM05','SLTM35','SLTM65',& + 'SLTM06','SLTM36','SLTM66',& + 'SLTM07','SLTM37','SLTM67',& + 'SLTM08','SLTM38','SLTM68'/) + -INTEGER, DIMENSION(5),PARAMETER :: JPSALTORDER = (/1, 2, 3, 4, 5/) +INTEGER, DIMENSION(8),PARAMETER :: JPSALTORDER = (/1,2,3,4,5,6,7,8/) +INTEGER :: NMODE_SLT= 8 ! number of sea salt modes (default = 8) !Test Thomas (definir rayons et sigma ici si on veut desactiver initialisation MACC) !REAL, DIMENSION(5) :: XINIRADIUS_SLT,XINISIG_SLT,XN0MIN_SLT !Initial dry number median radius (um) from Ova et al., 2014 -REAL,DIMENSION(5) :: XINIRADIUS_SLT= (/0.009, 0.021, 0.045, 0.115, 0.415/) +REAL,DIMENSION(8) :: XINIRADIUS_SLT= (/0.009, 0.021, 0.045, 0.115,0.415,2.5, 7.0, 20.0/) !Initial, standard deviation from Ova et al., 2014 -REAL,DIMENSION(5) :: XINISIG_SLT = (/ 1.37, 1.5, 1.42, 1.53, 1.85 /) -!Minimum allowed number concentration for any mode (#/m3) -REAL,DIMENSION(5) :: XN0MIN_SLT = (/1. , 1., 1., 1., 1. /) +REAL,DIMENSION(8) :: XINISIG_SLT = (/ 1.37, 1.5, 1.42, 1.53, 1.85,1.7,1.8, 2.9 /) +!Minimum allowed number concentration for any mode (#/m3) +REAL,DIMENSION(8) :: XN0MIN_SLT = (/1.e1 , 1.e1, 1.e1, 1., 1.e-4,1.e-20, 1.e-20,1.e-20 /) !Test Thomas - REAL, DIMENSION(:,:,:), ALLOCATABLE :: XSLTMSS ! [kg/m3] total mass concentration of sea salt ! ! aerosol lognormal parameterization diff --git a/src/MNH/mode_aero_psd.f90 b/src/MNH/mode_aero_psd.f90 index cb09f5461..7a18e4515 100644 --- a/src/MNH/mode_aero_psd.f90 +++ b/src/MNH/mode_aero_psd.f90 @@ -17,11 +17,14 @@ MODULE MODE_AERO_PSD !! to understandable aerosol variables, e.g. #/m3, kg/m3, sigma, R_{n} USE MODD_CH_AEROSOL +USE MODD_CONF, ONLY : CPROGRAM +USE MODD_CH_MNHC_n, ONLY : LCH_INIT_FIELD USE MODD_CST, ONLY : & XPI & !Definition of pi ,XAVOGADRO & ![molec/mol] avogadros number ,XMD ![kg/mol] molar weight of air USE MODD_CST, ONLY : XMNH_TINY +USE MODD_CSTS_DUST, ONLY : XDENSITY_DUST ! IMPLICIT NONE ! @@ -91,16 +94,17 @@ REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(IN) :: PMI ! molecular weight !* 0.2 declarations local variables ! REAL, DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3),NSP+NCARB+NSOA):: ZMI ! [g/mol] molar weight of aerosol -REAL :: ZRGMIN ! [um] minimum radius accepted REAL,DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3),SIZE(PSVT,4)) :: ZSV ! [aerosol concentration] REAL,DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3)) :: ZSIGMA ! [-] standard deviation REAL,DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),NSP+NCARB+NSOA,JPMODE):: ZCTOTA REAL,DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),JPMODE*3) :: ZM +REAL,DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),JPMODE) :: ZMASK, ZRG -REAL,DIMENSION(NSP+NCARB+NSOA) :: ZFAC ! M3 / mass conversion factor +REAL,DIMENSION(NSP+NCARB+NSOA) :: ZFAC ! M3 / mass conversion factor +REAL,DIMENSION(NSP+NCARB+NSOA) :: ZRHOI ! aerosol density REAL :: ZDEN2MOL REAL,DIMENSION(JPMODE*3) :: ZPMIN ! [aerosol units] minimum values for N, sigma, M -INTEGER :: JJ, JN ! [idx] loop counters +INTEGER :: JI,JJ,JK,JSV, JN ! [idx] loop counters REAL :: ZINIRADIUSI, ZINIRADIUSJ ! !------------------------------------------------------------------------------- @@ -114,20 +118,29 @@ ELSE ZINIRADIUSI = XINIRADIUSI ZINIRADIUSJ = XINIRADIUSJ END IF - +! Moments index +NM0(1) = 1 +NM3(1) = 2 +NM6(1) = 3 +NM0(2) = 4 +NM3(2) = 5 +NM6(2) = 6 !Get minimum values possible ZPMIN(1) = XN0IMIN - ZRGMIN = XCOEFRADIMIN * ZINIRADIUSI - ZPMIN(2) = ZPMIN(1) * (ZRGMIN**3)*EXP(4.5 * LOG(XSIGIMIN)**2) - ZPMIN(3) = ZPMIN(1) * (ZRGMIN**6)*EXP(18. * LOG(XSIGIMIN)**2) + ZPMIN(2) = ZPMIN(1) * (ZINIRADIUSI**3)*EXP(4.5 * LOG(XINISIGI)**2) + ZPMIN(3) = ZPMIN(1) * (ZINIRADIUSI**6)*EXP(18. * LOG(XINISIGI)**2) ZPMIN(4) = XN0JMIN - ZRGMIN = XCOEFRADJMIN * ZINIRADIUSJ - ZPMIN(5) = ZPMIN(4) * (ZRGMIN**3)*EXP(4.5 * LOG(XSIGJMIN)**2) - ZPMIN(6) = ZPMIN(4) * (ZRGMIN**6)*EXP(18. * LOG(XSIGJMIN)**2) + ZPMIN(5) = ZPMIN(4) * (ZINIRADIUSJ**3)*EXP(4.5 * LOG(XINISIGJ)**2) + ZPMIN(6) = ZPMIN(4) * (ZINIRADIUSJ**6)*EXP(18. * LOG(XINISIGJ)**2) +! Cf Ackermann (all to black carbon except water) !Set molecular weightn g/mol +ZRHOI(:) = 1.8e3 +ZRHOI(JP_AER_H2O) = 1.0e3 ! water +ZRHOI(JP_AER_DST) = XDENSITY_DUST ! dusts + IF(PRESENT(PMI)) THEN ZMI(:,:,:,:) = PMI(:,:,:,:) ELSE @@ -137,6 +150,7 @@ ELSE ZMI(:,:,:,JP_AER_NH3) = 17. ZMI(:,:,:,JP_AER_H2O) = 18. ZMI(:,:,:,JP_AER_BC) = 12. + ZMI(:,:,:,JP_AER_DST) = 100. IF (NSOA .EQ. 10) THEN ZMI(:,:,:,JP_AER_SOA1) = 88. ZMI(:,:,:,JP_AER_SOA2) = 180. @@ -156,9 +170,10 @@ ZDEN2MOL = 1E-6 * XAVOGADRO / XMD DO JJ=1, SIZE(PSVT,4) ZSV(:,:,:,JJ) = PSVT(:,:,:,JJ) * ZDEN2MOL * PRHODREF(:,:,:) ENDDO +ZSV(:,:,:,:) = MAX(ZSV(:,:,:,:), XMNH_TINY) ! DO JJ=1,NSP+NCARB+NSOA - ZFAC(JJ)=(4./3.)*XPI*XRHOI(JJ)*1.e-9 + ZFAC(JJ)=(4./3.)*XPI*ZRHOI(JJ)*1.e-9 ENDDO ! !------------------------------------------------------------------------------- @@ -188,6 +203,9 @@ ZCTOTA(:,:,:,:,:) = 0. ! primary black carbon ZCTOTA(:,:,:,JP_AER_BC,1) = ZSV(:,:,:,JP_CH_BCi)*ZMI(:,:,:,JP_AER_BC)/6.0221367E+11 ZCTOTA(:,:,:,JP_AER_BC,2) = ZSV(:,:,:,JP_CH_BCj)*ZMI(:,:,:,JP_AER_BC)/6.0221367E+11 +!dust + ZCTOTA(:,:,:,JP_AER_DST,1) = ZSV(:,:,:,JP_CH_DSTi)*ZMI(:,:,:,JP_AER_DST)/6.0221367E+11 + ZCTOTA(:,:,:,JP_AER_DST,2) = ZSV(:,:,:,JP_CH_DSTj)*ZMI(:,:,:,JP_AER_DST)/6.0221367E+11 ! IF (NSOA .EQ. 10) THEN ZCTOTA(:,:,:,JP_AER_SOA1,1) = ZSV(:,:,:,JP_CH_SOA1i)*ZMI(:,:,:,JP_AER_SOA1)/6.0221367E+11 @@ -228,14 +246,22 @@ ENDDO ! !* 4 set moment 0 ! - ZM(:,:,:,1)= MAX(ZSV(:,:,:,JP_CH_M0i) * 1E+6, XMNH_TINY) ! molec_{aer}/m3_{air} - ZM(:,:,:,4)= MAX(ZSV(:,:,:,JP_CH_M0j) * 1E+6, XMNH_TINY) ! molec_{aer}/m3_{air} +IF ((CPROGRAM=="REAL ").OR.(CPROGRAM=="IDEAL ")) THEN + ZM(:,:,:,1)= ZM(:,:,:,2) / ((ZINIRADIUSI**3)*EXP(4.5 * LOG(XINISIGI)**2)) + ZM(:,:,:,4)= ZM(:,:,:,5) / ((ZINIRADIUSJ**3)*EXP(4.5 * LOG(XINISIGJ)**2)) +ELSE + ZM(:,:,:,1)= MAX(ZSV(:,:,:,JP_CH_M0i) * 1E+6, XMNH_TINY) ! molec_{aer}/m3_{air} + ZM(:,:,:,4)= MAX(ZSV(:,:,:,JP_CH_M0j) * 1E+6, XMNH_TINY) ! molec_{aer}/m3_{air} +END IF ! !------------------------------------------------------------------------------- ! !* 5 set moment 6 ==> um6_{aer}/m3_{air} ! IF (LVARSIGI) THEN ! set M6 variable standard deviation + IF ((CPROGRAM=="REAL ").OR.(CPROGRAM=="IDEAL ")) THEN + ZM(:,:,:,3)= ZM(:,:,:,1) * (ZINIRADIUSJ**6)*EXP(18. * LOG(XINISIGJ)**2) + ELSE ZM(:,:,:,3) = MAX(ZSV(:,:,:,JP_CH_M6i), XMNH_TINY) ZSIGMA(:,:,:)=ZM(:,:,:,2)**2/(ZM(:,:,:,1)*ZM(:,:,:,3)) @@ -243,17 +269,13 @@ IF (LVARSIGI) THEN ! set M6 variable standard deviation ZSIGMA(:,:,:)=MAX(1E-10,ZSIGMA(:,:,:)) ZSIGMA(:,:,:)= LOG(ZSIGMA(:,:,:)) ZSIGMA(:,:,:)= EXP(1./3.*SQRT(-ZSIGMA(:,:,:))) - WHERE (ZSIGMA(:,:,:) > XSIGIMAX) - ZSIGMA(:,:,:) = XSIGIMAX - END WHERE - WHERE (ZSIGMA(:,:,:) < XSIGIMIN) - ZSIGMA(:,:,:) = XSIGIMIN - END WHERE + ZM(:,:,:,3) = ZM(:,:,:,1) & * ( (ZM(:,:,:,2)/ZM(:,:,:,1))**(1./3.) & * exp(-(3./2.)*log(ZSIGMA(:,:,:))**2))**6 & * exp(18.*log(ZSIGMA(:,:,:))**2) + END IF IF(PRESENT(PSIG3D)) PSIG3D(:,:,:,1) = ZSIGMA(:,:,:) ELSE ! fixed standard deviation @@ -266,6 +288,9 @@ ELSE ! fixed standard deviation END IF IF (LVARSIGJ) THEN ! set M6 variable standard deviation + IF ((CPROGRAM=="REAL ").OR.(CPROGRAM=="IDEAL ")) THEN + ZM(:,:,:,6)= ZM(:,:,:,4) * (ZINIRADIUSJ**6)*EXP(18. * LOG(XINISIGJ)**2) + ELSE ZM(:,:,:,6) = MAX(ZSV(:,:,:,JP_CH_M6j), XMNH_TINY) ZSIGMA(:,:,:)=ZM(:,:,:,5)**2/(ZM(:,:,:,4)*ZM(:,:,:,6)) @@ -273,17 +298,12 @@ IF (LVARSIGJ) THEN ! set M6 variable standard deviation ZSIGMA(:,:,:)=MAX(1E-10,ZSIGMA(:,:,:)) ZSIGMA(:,:,:)= LOG(ZSIGMA(:,:,:)) ZSIGMA(:,:,:)= EXP(1./3.*SQRT(-ZSIGMA(:,:,:))) - WHERE (ZSIGMA(:,:,:) > XSIGJMAX) - ZSIGMA(:,:,:) = XSIGJMAX - END WHERE - WHERE (ZSIGMA(:,:,:) < XSIGJMIN) - ZSIGMA(:,:,:) = XSIGJMIN - END WHERE ZM(:,:,:,6) = ZM(:,:,:,4) & * ( (ZM(:,:,:,5)/ZM(:,:,:,4))**(1./3.) & * exp(-(3./2.)*log(ZSIGMA(:,:,:))**2))**6 & * exp(18.*log(ZSIGMA(:,:,:))**2) + END IF IF(PRESENT(PSIG3D)) PSIG3D(:,:,:,2) = ZSIGMA(:,:,:) @@ -304,6 +324,10 @@ END IF DO JN=1,JPMODE IF(PRESENT(PN3D)) PN3D(:,:,:,JN) = ZM(:,:,:,NM0(JN)) + ZRG(:,:,:,JN) = (ZM(:,:,:,NM3(JN))**4. & + / (ZM(:,:,:,NM6(JN))*ZM(:,:,:,NM0(JN))**3.))**(1./6.) + + IF(PRESENT(PRG3D)) PRG3D(:,:,:,JN)=(ZM(:,:,:,NM3(JN))**4. & / (ZM(:,:,:,NM6(JN))*ZM(:,:,:,NM0(JN))**3.))**(1./6.) @@ -315,6 +339,223 @@ IF(PRESENT(PM3D)) PM3D(:,:,:,:) = ZM(:,:,:,:) ! END SUBROUTINE PPP2AERO ! +! ############################################################ + SUBROUTINE CON2MIX (PSVT & !I [µg/m3] O [ppp] input scalar variables (moment of distribution) + ,PRHODREF ) !I [kg/m3] density of air + +! +!! PURPOSE +!! ------- +!! conversion from µg/m3 to moments (ppp) to init aerosol profile (ch_init_field) +!! +!! REFERENCE +!! --------- +!! none +!! +!! AUTHOR +!! ------ +!! Pierre TULET (LA) +!! +!! EXTERNAL +!! -------- +!! + IMPLICIT NONE +!! +REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT !I [#/molec_{air}] first moment + !I [molec_{aer}/molec_{air} 3rd moment + !I [um6/molec_{air}*(cm3/m3)] 6th moment +REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF !I [kg/m3] density of air + +!* 0.2 declarations local variables +! +REAL,DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3), JPMODE*3) :: ZM ! aerosols moments +REAL,DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),NSP+NCARB+NSOA,JPMODE):: ZCTOTA + +REAL,DIMENSION(NSP+NCARB+NSOA) :: ZFAC ! M3 / mass conversion factor +REAL,DIMENSION(NSP+NCARB+NSOA) :: ZRHOI ! aerosol density +REAL,DIMENSION(NSP+NCARB+NSOA) :: ZMI ! molecular weight +INTEGER :: JJ ! [idx] loop counters +REAL :: ZDEN2MOL +REAL :: ZINIRADIUSI, ZINIRADIUSJ +! +!------------------------------------------------------------------------------- +! +! 1. initialisation + +ZRHOI(:) = 1.8e3 +ZRHOI(JP_AER_H2O) = 1.0e3 ! water +ZRHOI(JP_AER_DST) = XDENSITY_DUST ! dusts +ZMI(:) = 250. +ZMI(JP_AER_SO4) = 98. +ZMI(JP_AER_NO3) = 63. +ZMI(JP_AER_NH3) = 17. +ZMI(JP_AER_H2O) = 18. +ZMI(JP_AER_BC) = 12. +ZMI(JP_AER_DST) = 100. +IF (NSOA .EQ. 10) THEN + ZMI(JP_AER_SOA1) = 88. + ZMI(JP_AER_SOA2) = 180. + ZMI(JP_AER_SOA3) = 1.5374857E2 + ZMI(JP_AER_SOA4) = 1.9586780E2 + ZMI(JP_AER_SOA5) = 195. + ZMI(JP_AER_SOA6) = 195. + ZMI(JP_AER_SOA7) = 165. + ZMI(JP_AER_SOA8) = 195. + ZMI(JP_AER_SOA9) = 270. + ZMI(JP_AER_SOA10) = 210. +END IF + + +IF (CRGUNIT=="MASS") THEN + ZINIRADIUSI = XINIRADIUSI * EXP(-3.*(LOG(XINISIGI))**2) + ZINIRADIUSJ = XINIRADIUSJ * EXP(-3.*(LOG(XINISIGJ))**2) +ELSE + ZINIRADIUSI = XINIRADIUSI + ZINIRADIUSJ = XINIRADIUSJ +END IF + +! conversion into mol.cm-3 +ZDEN2MOL = 1E-6 * XAVOGADRO / XMD + + +DO JJ=1,NSP+NCARB+NSOA + ZFAC(JJ)=(4./3.)*XPI*ZRHOI(JJ)*1.e-9 +ENDDO +! +! inorganic phase + ZCTOTA(:,:,:,JP_AER_SO4,1) = PSVT(:,:,:,JP_CH_SO4i) + ZCTOTA(:,:,:,JP_AER_SO4,2) = PSVT(:,:,:,JP_CH_SO4j) + ZCTOTA(:,:,:,JP_AER_NO3,1) = PSVT(:,:,:,JP_CH_NO3i) + ZCTOTA(:,:,:,JP_AER_NO3,2) = PSVT(:,:,:,JP_CH_NO3j) + ZCTOTA(:,:,:,JP_AER_NH3,1) = PSVT(:,:,:,JP_CH_NH3i) + ZCTOTA(:,:,:,JP_AER_NH3,2) = PSVT(:,:,:,JP_CH_NH3j) +! +! water + ZCTOTA(:,:,:,JP_AER_H2O,1) = PSVT(:,:,:,JP_CH_H2Oi) + ZCTOTA(:,:,:,JP_AER_H2O,2) = PSVT(:,:,:,JP_CH_H2Oj) +! +! primary organic carbon + ZCTOTA(:,:,:,JP_AER_OC,1) = PSVT(:,:,:,JP_CH_OCi) + ZCTOTA(:,:,:,JP_AER_OC,2) = PSVT(:,:,:,JP_CH_OCj) +! +! primary black carbon + ZCTOTA(:,:,:,JP_AER_BC,1) = PSVT(:,:,:,JP_CH_BCi) + ZCTOTA(:,:,:,JP_AER_BC,2) = PSVT(:,:,:,JP_CH_BCj) +!dust + ZCTOTA(:,:,:,JP_AER_DST,1) = PSVT(:,:,:,JP_CH_DSTi) + ZCTOTA(:,:,:,JP_AER_DST,2) = PSVT(:,:,:,JP_CH_DSTj) +! + IF (NSOA .EQ. 10) THEN + ZCTOTA(:,:,:,JP_AER_SOA1,1) = PSVT(:,:,:,JP_CH_SOA1i) + ZCTOTA(:,:,:,JP_AER_SOA1,2) = PSVT(:,:,:,JP_CH_SOA1j) + ZCTOTA(:,:,:,JP_AER_SOA2,1) = PSVT(:,:,:,JP_CH_SOA2i) + ZCTOTA(:,:,:,JP_AER_SOA2,2) = PSVT(:,:,:,JP_CH_SOA2j) + ZCTOTA(:,:,:,JP_AER_SOA3,1) = PSVT(:,:,:,JP_CH_SOA3i) + ZCTOTA(:,:,:,JP_AER_SOA3,2) = PSVT(:,:,:,JP_CH_SOA3j) + ZCTOTA(:,:,:,JP_AER_SOA4,1) = PSVT(:,:,:,JP_CH_SOA4i) + ZCTOTA(:,:,:,JP_AER_SOA4,2) = PSVT(:,:,:,JP_CH_SOA4j) + ZCTOTA(:,:,:,JP_AER_SOA5,1) = PSVT(:,:,:,JP_CH_SOA5i) + ZCTOTA(:,:,:,JP_AER_SOA5,2) = PSVT(:,:,:,JP_CH_SOA5j) + + ZCTOTA(:,:,:,JP_AER_SOA6,1) = PSVT(:,:,:,JP_CH_SOA6i) + ZCTOTA(:,:,:,JP_AER_SOA6,2) = PSVT(:,:,:,JP_CH_SOA6j) + ZCTOTA(:,:,:,JP_AER_SOA7,1) = PSVT(:,:,:,JP_CH_SOA7i) + ZCTOTA(:,:,:,JP_AER_SOA7,2) = PSVT(:,:,:,JP_CH_SOA7j) + ZCTOTA(:,:,:,JP_AER_SOA8,1) = PSVT(:,:,:,JP_CH_SOA8i) + ZCTOTA(:,:,:,JP_AER_SOA8,2) = PSVT(:,:,:,JP_CH_SOA8j) + ZCTOTA(:,:,:,JP_AER_SOA9,1) = PSVT(:,:,:,JP_CH_SOA9i) + ZCTOTA(:,:,:,JP_AER_SOA9,2) = PSVT(:,:,:,JP_CH_SOA9j) + ZCTOTA(:,:,:,JP_AER_SOA10,1) = PSVT(:,:,:,JP_CH_SOA10i) + ZCTOTA(:,:,:,JP_AER_SOA10,2) = PSVT(:,:,:,JP_CH_SOA10j) + END IF + ZCTOTA(:,:,:,:,:) = MAX(ZCTOTA(:,:,:,:,:),XMNH_TINY) + +! +!* 3 calculate moment 3 from total aerosol mass +! +ZM(:,:,:,2) = 0. +ZM(:,:,:,5) = 0. + DO JJ = 1,NSP+NCARB+NSOA + ZM(:,:,:,2) = ZM(:,:,:,2)+ZCTOTA(:,:,:,JJ,1)/ZFAC(JJ) + ZM(:,:,:,5) = ZM(:,:,:,5)+ZCTOTA(:,:,:,JJ,2)/ZFAC(JJ) + ENDDO +! +! +!* 4 calculate moment 0 from dispersion and mean radius +! +ZM(:,:,:,1)= ZM(:,:,:,2)/ & + ( (ZINIRADIUSI**3)*EXP(4.5 * LOG(XINISIGI)**2) ) + +ZM(:,:,:,4)= ZM(:,:,:,5)/ & + ( (ZINIRADIUSJ**3)*EXP(4.5 * LOG(XINISIGJ)**2) ) +! + +!* 5 calculate moment 6 from dispersion and mean radius +! +ZM(:,:,:,3) = ZM(:,:,:,1)*(ZINIRADIUSI**6) * EXP(18 *(LOG(XINISIGI))**2) +ZM(:,:,:,6) = ZM(:,:,:,4)*(ZINIRADIUSJ**6) * EXP(18 *(LOG(XINISIGJ))**2) + +!* 6 return to ppp +! inorganic phase + PSVT(:,:,:,JP_CH_SO4i) = ZCTOTA(:,:,:,JP_AER_SO4,1)*6.0221367E+11/ZMI(JP_AER_SO4) + PSVT(:,:,:,JP_CH_SO4j) = ZCTOTA(:,:,:,JP_AER_SO4,2)*6.0221367E+11/ZMI(JP_AER_SO4) + PSVT(:,:,:,JP_CH_NO3i) = ZCTOTA(:,:,:,JP_AER_NO3,1)*6.0221367E+11/ZMI(JP_AER_NO3) + PSVT(:,:,:,JP_CH_NO3j) = ZCTOTA(:,:,:,JP_AER_NO3,2)*6.0221367E+11/ZMI(JP_AER_NO3) + PSVT(:,:,:,JP_CH_NH3i) = ZCTOTA(:,:,:,JP_AER_NH3,1)*6.0221367E+11/ZMI(JP_AER_NH3) + PSVT(:,:,:,JP_CH_NH3j) = ZCTOTA(:,:,:,JP_AER_NH3,2)*6.0221367E+11/ZMI(JP_AER_NH3) +! +! water + PSVT(:,:,:,JP_CH_H2Oi) = ZCTOTA(:,:,:,JP_AER_H2O,1)*6.0221367E+11/ZMI(JP_AER_H2O) + PSVT(:,:,:,JP_CH_H2Oj) = ZCTOTA(:,:,:,JP_AER_H2O,2)*6.0221367E+11/ZMI(JP_AER_H2O) +! +! primary organic carbon + PSVT(:,:,:,JP_CH_OCi) = ZCTOTA(:,:,:,JP_AER_OC,1)*6.0221367E+11/ZMI(JP_AER_OC) + PSVT(:,:,:,JP_CH_OCj) = ZCTOTA(:,:,:,JP_AER_OC,2)*6.0221367E+11/ZMI(JP_AER_OC) +! +! primary black carbon + PSVT(:,:,:,JP_CH_BCi) = ZCTOTA(:,:,:,JP_AER_BC,1)*6.0221367E+11/ZMI(JP_AER_BC) + PSVT(:,:,:,JP_CH_BCj) = ZCTOTA(:,:,:,JP_AER_BC,2)*6.0221367E+11/ZMI(JP_AER_BC) +!dust + PSVT(:,:,:,JP_CH_DSTi) = ZCTOTA(:,:,:,JP_AER_DST,1)*6.0221367E+11/ZMI(JP_AER_DST) + PSVT(:,:,:,JP_CH_DSTj) = ZCTOTA(:,:,:,JP_AER_DST,2)*6.0221367E+11/ZMI(JP_AER_DST) +! + IF (NSOA .EQ. 10) THEN + PSVT(:,:,:,JP_CH_SOA1i) = ZCTOTA(:,:,:,JP_AER_SOA1,1)*6.0221367E+11/ZMI(JP_AER_SOA1) + PSVT(:,:,:,JP_CH_SOA1j) = ZCTOTA(:,:,:,JP_AER_SOA1,2)*6.0221367E+11/ZMI(JP_AER_SOA1) + PSVT(:,:,:,JP_CH_SOA2i) = ZCTOTA(:,:,:,JP_AER_SOA2,1)*6.0221367E+11/ZMI(JP_AER_SOA2) + PSVT(:,:,:,JP_CH_SOA2j) = ZCTOTA(:,:,:,JP_AER_SOA2,2)*6.0221367E+11/ZMI(JP_AER_SOA2) + PSVT(:,:,:,JP_CH_SOA3i) = ZCTOTA(:,:,:,JP_AER_SOA3,1)*6.0221367E+11/ZMI(JP_AER_SOA3) + PSVT(:,:,:,JP_CH_SOA3j) = ZCTOTA(:,:,:,JP_AER_SOA3,2)*6.0221367E+11/ZMI(JP_AER_SOA3) + PSVT(:,:,:,JP_CH_SOA4i) = ZCTOTA(:,:,:,JP_AER_SOA4,1)*6.0221367E+11/ZMI(JP_AER_SOA4) + PSVT(:,:,:,JP_CH_SOA4j) = ZCTOTA(:,:,:,JP_AER_SOA4,2)*6.0221367E+11/ZMI(JP_AER_SOA4) + PSVT(:,:,:,JP_CH_SOA5i) = ZCTOTA(:,:,:,JP_AER_SOA5,1)*6.0221367E+11/ZMI(JP_AER_SOA5) + PSVT(:,:,:,JP_CH_SOA5j) = ZCTOTA(:,:,:,JP_AER_SOA5,2)*6.0221367E+11/ZMI(JP_AER_SOA5) + PSVT(:,:,:,JP_CH_SOA6i) = ZCTOTA(:,:,:,JP_AER_SOA6,1)*6.0221367E+11/ZMI(JP_AER_SOA6) + PSVT(:,:,:,JP_CH_SOA6j) = ZCTOTA(:,:,:,JP_AER_SOA6,2)*6.0221367E+11/ZMI(JP_AER_SOA6) + PSVT(:,:,:,JP_CH_SOA7i) = ZCTOTA(:,:,:,JP_AER_SOA7,1)*6.0221367E+11/ZMI(JP_AER_SOA7) + PSVT(:,:,:,JP_CH_SOA7j) = ZCTOTA(:,:,:,JP_AER_SOA7,2)*6.0221367E+11/ZMI(JP_AER_SOA7) + PSVT(:,:,:,JP_CH_SOA8i) = ZCTOTA(:,:,:,JP_AER_SOA8,1)*6.0221367E+11/ZMI(JP_AER_SOA8) + PSVT(:,:,:,JP_CH_SOA8j) = ZCTOTA(:,:,:,JP_AER_SOA8,2)*6.0221367E+11/ZMI(JP_AER_SOA8) + PSVT(:,:,:,JP_CH_SOA9i) = ZCTOTA(:,:,:,JP_AER_SOA9,1)*6.0221367E+11/ZMI(JP_AER_SOA9) + PSVT(:,:,:,JP_CH_SOA9j) = ZCTOTA(:,:,:,JP_AER_SOA9,2)*6.0221367E+11/ZMI(JP_AER_SOA9) + PSVT(:,:,:,JP_CH_SOA10i) = ZCTOTA(:,:,:,JP_AER_SOA10,1)*6.0221367E+11/ZMI(JP_AER_SOA10) + PSVT(:,:,:,JP_CH_SOA10j) = ZCTOTA(:,:,:,JP_AER_SOA10,2)*6.0221367E+11/ZMI(JP_AER_SOA10) + END IF + +! +PSVT(:,:,:,JP_CH_M0i) = ZM(:,:,:,1) * 1E-6 +PSVT(:,:,:,JP_CH_M0j) = ZM(:,:,:,4) * 1E-6 + +IF (LVARSIGI) PSVT(:,:,:,JP_CH_M6i) = ZM(:,:,:,3) +IF (LVARSIGJ) PSVT(:,:,:,JP_CH_M6j) = ZM(:,:,:,6) + +DO JJ=1,SIZE(PSVT,4) + PSVT(:,:,:,JJ) = PSVT(:,:,:,JJ) / (ZDEN2MOL * PRHODREF(:,:,:)) +ENDDO + + +END SUBROUTINE CON2MIX + ! ############################################################ SUBROUTINE AERO2PPP( & PSVT & !IO [ppp] input scalar variables (moment of distribution) @@ -367,12 +608,12 @@ REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(IN) :: PMI !O molecular weight !* 0.2 declarations local variables ! REAL,DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),NSP+NCARB+NSOA) :: ZMI ! [g/mol] molar weight of aerosol -REAL :: ZRGMIN ! [um] minimum radius accepted REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZM ! [aerosol units] local array which goes to output later REAL,DIMENSION(JPMODE*3) :: ZPMIN ! [aerosol units] minimum values for N, sigma, M REAL,DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),NSP+NCARB+NSOA,JPMODE):: ZCTOTA REAL,DIMENSION(NSP+NCARB+NSOA) :: ZFAC ! M3 / mass conversion factor +REAL,DIMENSION(NSP+NCARB+NSOA) :: ZRHOI ! aerosol density INTEGER :: JJ ! [idx] loop counters REAL :: ZDEN2MOL REAL :: ZINIRADIUSI, ZINIRADIUSJ @@ -393,13 +634,11 @@ END IF !Get minimum values possible ZPMIN(1) = XN0IMIN -ZRGMIN = ZINIRADIUSI -ZPMIN(2) = ZPMIN(1) * (ZRGMIN**3)*EXP(4.5 * LOG(XSIGIMIN)**2) -ZPMIN(3) = ZPMIN(1) * (ZRGMIN**6)*EXP(18. * LOG(XSIGIMIN)**2) +ZPMIN(2) = ZPMIN(1) * (ZINIRADIUSI**3)*EXP(4.5 * LOG(XINISIGI)**2) +ZPMIN(3) = ZPMIN(1) * (ZINIRADIUSI**6)*EXP(18. * LOG(XINISIGI)**2) ZPMIN(4) = XN0JMIN -ZRGMIN = ZINIRADIUSJ -ZPMIN(5) = ZPMIN(4) * (ZRGMIN**3)*EXP(4.5 * LOG(XSIGJMIN)**2) -ZPMIN(6) = ZPMIN(4) * (ZRGMIN**6)*EXP(18. * LOG(XSIGJMIN)**2) +ZPMIN(5) = ZPMIN(4) * (ZINIRADIUSJ**3)*EXP(4.5 * LOG(XINISIGJ)**2) +ZPMIN(6) = ZPMIN(4) * (ZINIRADIUSJ**6)*EXP(18. * LOG(XINISIGJ)**2) ALLOCATE (ZM(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3), JPMODE*3)) @@ -435,7 +674,7 @@ DO JJ=1, SIZE(PSVT, 4) ENDDO ! DO JJ=1,NSP+NCARB+NSOA - ZFAC(JJ)=(4./3.)*XPI*XRHOI(JJ)*1.e-9 + ZFAC(JJ)=(4./3.)*XPI*ZRHOI(JJ)*1.e-9 ENDDO ! ! @@ -500,8 +739,8 @@ ZCTOTA(:,:,:,:,:) = 0. ZM(:,:,:,2) = ZM(:,:,:,2)+ZCTOTA(:,:,:,JJ,1)/ZFAC(JJ) ZM(:,:,:,5) = ZM(:,:,:,5)+ZCTOTA(:,:,:,JJ,2)/ZFAC(JJ) ENDDO - ZM(:,:,:,2) = MAX(ZM(:,:,:,2), ZPMIN(2)) - ZM(:,:,:,5) = MAX(ZM(:,:,:,5), ZPMIN(5)) +! ZM(:,:,:,2) = MAX(ZM(:,:,:,2), ZPMIN(2)) +! ZM(:,:,:,5) = MAX(ZM(:,:,:,5), ZPMIN(5)) ! ! !* 4 calculate moment 0 from dispersion and mean radius @@ -597,17 +836,19 @@ REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PM1D !O moments 0,3 and ! !* 0.2 declarations local variables ! -REAL, DIMENSION(SIZE(PSVT,1),NSP+NCARB+NSOA) :: ZMI ! [kg/mol] molar weight of aerosol -REAL :: ZRGMIN ! [um] minimum radius accepted -REAL,DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2)) :: ZSV ! [aerosol concentration] -REAL,DIMENSION(SIZE(PSVT,1)) :: ZSIGMA ! [-] standard deviation +REAL, DIMENSION(SIZE(PSVT,1),NSP+NCARB+NSOA) :: ZMI ! [kg/mol] molar weight of aerosol +REAL,DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2)) :: ZSV ! [aerosol concentration] +REAL,DIMENSION(SIZE(PSVT,1)) :: ZSIGMA ! [-] standard deviation +REAL,DIMENSION(SIZE(PSVT,1),JPMODE) :: ZMASK REAL,DIMENSION(SIZE(PSVT,1),NSP+NCARB+NSOA,JPMODE):: ZCTOTA REAL,DIMENSION(SIZE(PSVT,1),JPMODE*3) :: ZM -REAL,DIMENSION(NSP+NCARB+NSOA) :: ZFAC ! M3 / mass conversion factor +REAL,DIMENSION(NSP+NCARB+NSOA) :: ZFAC ! M3 / mass conversion factor +REAL,DIMENSION(NSP+NCARB+NSOA) :: ZRHOI ! aerosol density REAL :: ZDEN2MOL -REAL,DIMENSION(JPMODE*3) :: ZPMIN ! [aerosol units] minimum values for N, sigma, M -INTEGER :: JJ, JN ! [idx] loop counters +REAL,DIMENSION(JPMODE*3) :: ZPMIN ! [aerosol units] minimum values for N, sigma, M +REAL,DIMENSION(JPMODE) :: ZRATIOBC, ZRATIOOC +INTEGER :: JJ, JN ! [idx] loop counters REAL :: ZINIRADIUSI, ZINIRADIUSJ ! !------------------------------------------------------------------------------- @@ -626,14 +867,12 @@ END IF !Get minimum values possible ZPMIN(1) = XN0IMIN - ZRGMIN = XCOEFRADIMIN * ZINIRADIUSI - ZPMIN(2) = ZPMIN(1) * (ZRGMIN**3)*EXP(4.5 * LOG(XSIGIMIN)**2) - ZPMIN(3) = ZPMIN(1) * (ZRGMIN**6)*EXP(18. * LOG(XSIGIMIN)**2) + ZPMIN(2) = ZPMIN(1) * (ZINIRADIUSI**3)*EXP(4.5 * LOG(XINISIGI)**2) + ZPMIN(3) = ZPMIN(1) * (ZINIRADIUSI**6)*EXP(18. * LOG(XINISIGI)**2) ZPMIN(4) = XN0JMIN - ZRGMIN = XCOEFRADJMIN * ZINIRADIUSJ - ZPMIN(5) = ZPMIN(4) * (ZRGMIN**3)*EXP(4.5 * LOG(XSIGJMIN)**2) - ZPMIN(6) = ZPMIN(4) * (ZRGMIN**6)*EXP(18. * LOG(XSIGJMIN)**2) + ZPMIN(5) = ZPMIN(4) * (ZINIRADIUSJ**3)*EXP(4.5 * LOG(XINISIGJ)**2) + ZPMIN(6) = ZPMIN(4) * (ZINIRADIUSJ**6)*EXP(18. * LOG(XINISIGJ)**2) !Set molecular weightn g/mol IF(PRESENT(PMI)) THEN @@ -667,7 +906,7 @@ DO JJ=1, SIZE(PSVT,2) ENDDO ! DO JJ=1,NSP+NCARB+NSOA - ZFAC(JJ)=(4./3.)*XPI*XRHOI(JJ)*1.e-9 + ZFAC(JJ)=(4./3.)*XPI*ZRHOI(JJ)*1.e-9 ENDDO ! !------------------------------------------------------------------------------- @@ -811,6 +1050,28 @@ END IF !* 6 calculate modal parameters from moments ! DO JN=1,JPMODE +!************************************************************* +! Blindages pour valeurs inferieurs au mininmum accepte +!************************************************************* + ZMASK(:,JN) = 1. + WHERE ((ZM(:,NM0(JN)) .LT. ZPMIN(NM0(JN))).OR.& + (ZM(:,NM3(JN)) .LT. ZPMIN(NM3(JN))).OR.& + (ZM(:,NM6(JN)) .LT. ZPMIN(NM6(JN)))) + + ZM(:,NM0(JN)) = ZPMIN(NM0(JN)) + ZM(:,NM3(JN)) = ZPMIN(NM3(JN)) + ZM(:,NM6(JN)) = ZPMIN(NM6(JN)) + + ZMASK(:,JN) = 0. + END WHERE + DO JJ=1,NSP+NCARB+NSOA + ZCTOTA(:,JJ,JN) = ZCTOTA(:,JJ,JN) * ZMASK(:,JN) + ENDDO + WHERE (ZMASK(:,JN) == 0.) + ZCTOTA(:,JP_AER_BC,JN) = 0.5 * ZPMIN(NM3(JN)) * ZFAC(JP_AER_BC) + ZCTOTA(:,JP_AER_OC,JN) = 0.5 * ZPMIN(NM3(JN)) * ZFAC(JP_AER_OC) + END WHERE + ! IF(PRESENT(PN1D)) PN1D(:,JN) = ZM(:,NM0(JN)) IF(PRESENT(PRG1D)) PRG1D(:,JN)=(ZM(:,NM3(JN))**4. & diff --git a/src/MNH/mode_dust_psd.f90 b/src/MNH/mode_dust_psd.f90 index 70e078f5e..016abf4f5 100644 --- a/src/MNH/mode_dust_psd.f90 +++ b/src/MNH/mode_dust_psd.f90 @@ -135,7 +135,8 @@ ALLOCATE (ZRG(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3))) ALLOCATE (ZSV(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3), SIZE(PSVT,4))) ALLOCATE (ZINIRADIUS(NMODE_DST)) -ZSV(:,:,:,:) = MAX(PSVT(:,:,:,:), XMNH_TINY) +!ZSV(:,:,:,:) = MAX(PSVT(:,:,:,:), XMNH_TINY) +ZSV(:,:,:,:) = PSVT(:,:,:,:) DO JN=1,NMODE_DST IMODEIDX = JPDUSTORDER(JN) @@ -154,7 +155,8 @@ DO JN=1,NMODE_DST ZMMIN(NM0(JN)) = XN0MIN(IMODEIDX) ZRGMIN = ZINIRADIUS(JN) IF (LVARSIG) THEN - ZSIGMIN = XSIGMIN +! ZSIGMIN = XSIGMIN + ZSIGMIN = XINISIG(IMODEIDX) ELSE ZSIGMIN = XINISIG(IMODEIDX) ENDIF @@ -188,7 +190,7 @@ DO JN=1,NMODE_DST * XM3TOUM3 & !==>um3_{aer}/m3_{air} / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment) !Limit mass concentration to minimum value - ZM(:,:,:,NM3(JN)) = MAX(ZM(:,:,:,NM3(JN)), ZMMIN(NM3(JN))) +! ZM(:,:,:,NM3(JN)) = MAX(ZM(:,:,:,NM3(JN)), ZMMIN(NM3(JN))) ! ZM(:,:,:,NM6(JN)) = ZSV(:,:,:,3+(JN-1)*3) & !um6/molec_{air}*(cm3/m3) * 1.d-6 & !==> um6/molec_{air} @@ -196,7 +198,7 @@ DO JN=1,NMODE_DST / XMD & !==> um6/kg_{air} * PRHODREF(:,:,:) !==> um6/m3_{air} !Limit m6 concentration to minimum value - ZM(:,:,:,NM6(JN)) = MAX(ZM(:,:,:,NM6(JN)), ZMMIN(NM6(JN))) +! ZM(:,:,:,NM6(JN)) = MAX(ZM(:,:,:,NM6(JN)), ZMMIN(NM6(JN))) ! !Get sigma (only if sigma is allowed to vary) !Get intermediate values for sigma M3^2/(M0*M6) (ORILAM paper, eqn 8) @@ -235,7 +237,7 @@ DO JN=1,NMODE_DST * XM3TOUM3 & !==>um3_{aer}/m3_{air} / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment) - ZM(:,:,:,NM3(JN)) = MAX(ZM(:,:,:,NM3(JN)), ZMMIN(NM3(JN))) +! ZM(:,:,:,NM3(JN)) = MAX(ZM(:,:,:,NM3(JN)), ZMMIN(NM3(JN))) ZM(:,:,:,NM0(JN))= ZM(:,:,:,NM3(JN))/& ((ZINIRADIUS(JN)**3)*EXP(4.5 * LOG(XINISIG(JPDUSTORDER(JN)))**2)) @@ -258,15 +260,15 @@ DO JN=1,NMODE_DST * PRHODREF(:,:,:) !==>#/m3 ! Limit concentration to minimum values - WHERE ((ZM(:,:,:,NM0(JN)) < ZMMIN(NM0(JN)) ).OR. & - (ZM(:,:,:,NM3(JN)) < ZMMIN(NM3(JN)) )) - ZM(:,:,:,NM0(JN)) = ZMMIN(NM0(JN)) - ZM(:,:,:,NM3(JN)) = ZMMIN(NM3(JN)) - PSVT(:,:,:,1+(JN-1)*2) = ZM(:,:,:,NM0(JN)) * XMD / & - (XAVOGADRO * PRHODREF(:,:,:) ) - PSVT(:,:,:,2+(JN-1)*2) = ZM(:,:,:,NM3(JN)) * XMD * XPI * 4./3. * ZRHOI / & - (ZMI*PRHODREF(:,:,:)*XM3TOUM3) - ENDWHERE +! WHERE ((ZM(:,:,:,NM0(JN)) < ZMMIN(NM0(JN)) ).OR. & +! (ZM(:,:,:,NM3(JN)) < ZMMIN(NM3(JN)) )) +! ZM(:,:,:,NM0(JN)) = ZMMIN(NM0(JN)) +! ZM(:,:,:,NM3(JN)) = ZMMIN(NM3(JN)) +! PSVT(:,:,:,1+(JN-1)*2) = ZM(:,:,:,NM0(JN)) * XMD / & +! (XAVOGADRO * PRHODREF(:,:,:) ) +! PSVT(:,:,:,2+(JN-1)*2) = ZM(:,:,:,NM3(JN)) * XMD * XPI * 4./3. * ZRHOI / & +! (ZMI*PRHODREF(:,:,:)*XM3TOUM3) +! ENDWHERE END IF ! @@ -413,7 +415,7 @@ END SUBROUTINE PPP2DUST ! ! PSVT need to be positive - PSVT(:,:,:,:) = MAX(PSVT(:,:,:,:), XMNH_TINY) +! PSVT(:,:,:,:) = MAX(PSVT(:,:,:,:), XMNH_TINY) DO JN=1,NMODE_DST IMODEIDX = JPDUSTORDER(JN) @@ -433,7 +435,8 @@ END SUBROUTINE PPP2DUST ZMMIN(NM0(JN)) = XN0MIN(IMODEIDX) ZRGMIN = ZINIRADIUS(JN) IF (LVARSIG) THEN - ZSIGMIN = XSIGMIN + ZSIGMIN = XINISIG(IMODEIDX) + ! ZSIGMIN = XSIGMIN ELSE ZSIGMIN = XINISIG(IMODEIDX) ENDIF @@ -465,7 +468,7 @@ END SUBROUTINE PPP2DUST * (1.d0/ZRHOI) & !==>m3_{aer}/m3_{air} * XM3TOUM3 & !==>um3_{aer}/m3_{air} / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment) - ZM(:,:,:,NM3(JN)) = MAX(ZM(:,:,:,NM3(JN)), ZMMIN(NM3(JN))) + ! ZM(:,:,:,NM3(JN)) = MAX(ZM(:,:,:,NM3(JN)), ZMMIN(NM3(JN))) ELSE ZM(:,:,:,NM3(JN)) = & PSVT(:,:,:,2+(JN-1)*2) & !molec_{aer}/molec_{aer} @@ -485,23 +488,23 @@ END SUBROUTINE PPP2DUST ZM(:,:,:,NM6(JN)) = ZM(:,:,:,NM0(JN)) * (PRG3D(:,:,:,JN)**6) * & EXP(18 *(LOG(PSIG3D(:,:,:,JN)))**2) - IF (LVARSIG) THEN - WHERE ((ZM(:,:,:,NM0(JN)) .LT. ZMMIN(NM0(JN))).OR.& - (ZM(:,:,:,NM3(JN)) .LT. ZMMIN(NM3(JN))).OR.& - (ZM(:,:,:,NM6(JN)) .LT. ZMMIN(NM6(JN)))) - ZM(:,:,:,NM0(JN)) = ZMMIN(NM0(JN)) - ZM(:,:,:,NM3(JN)) = ZMMIN(NM3(JN)) - ZM(:,:,:,NM6(JN)) = ZMMIN(NM6(JN)) - END WHERE - - ELSE IF (.NOT.(LRGFIX_DST)) THEN - - WHERE ((ZM(:,:,:,NM0(JN)) .LT. ZMMIN(NM0(JN))).OR.& - (ZM(:,:,:,NM3(JN)) .LT. ZMMIN(NM3(JN)))) - ZM(:,:,:,NM0(JN)) = ZMMIN(NM0(JN)) - ZM(:,:,:,NM3(JN)) = ZMMIN(NM3(JN)) - END WHERE - ENDIF +! IF (LVARSIG) THEN +! WHERE ((ZM(:,:,:,NM0(JN)) .LT. ZMMIN(NM0(JN))).OR.& +! (ZM(:,:,:,NM3(JN)) .LT. ZMMIN(NM3(JN))).OR.& +! (ZM(:,:,:,NM6(JN)) .LT. ZMMIN(NM6(JN)))) +! ZM(:,:,:,NM0(JN)) = ZMMIN(NM0(JN)) +! ZM(:,:,:,NM3(JN)) = ZMMIN(NM3(JN)) +! ZM(:,:,:,NM6(JN)) = ZMMIN(NM6(JN)) +! END WHERE +! +! ELSE IF (.NOT.(LRGFIX_DST)) THEN +! +! WHERE ((ZM(:,:,:,NM0(JN)) .LT. ZMMIN(NM0(JN))).OR.& +! (ZM(:,:,:,NM3(JN)) .LT. ZMMIN(NM3(JN)))) +! ZM(:,:,:,NM0(JN)) = ZMMIN(NM0(JN)) +! ZM(:,:,:,NM3(JN)) = ZMMIN(NM3(JN)) +! END WHERE +! ENDIF ! return to concentration #/m3 => (#/molec_{air} @@ -629,7 +632,8 @@ ALLOCATE (ZRG(SIZE(PSVT,1))) ALLOCATE (ZSV(SIZE(PSVT,1),SIZE(PSVT,2))) ALLOCATE (ZINIRADIUS(NMODE_DST)) -ZSV(:,:) = MAX(PSVT(:,:), XMNH_TINY) +!ZSV(:,:) = MAX(PSVT(:,:), XMNH_TINY) +ZSV(:,:) = PSVT(:,:) DO JN=1,NMODE_DST IMODEIDX = JPDUSTORDER(JN) @@ -648,7 +652,8 @@ DO JN=1,NMODE_DST ZMMIN(NM0(JN)) = XN0MIN(IMODEIDX) ZRGMIN = ZINIRADIUS(JN) IF (LVARSIG) THEN - ZSIGMIN = XSIGMIN + !ZSIGMIN = XSIGMIN + ZSIGMIN = XINISIG(IMODEIDX) ELSE ZSIGMIN = XINISIG(IMODEIDX) ENDIF @@ -682,7 +687,7 @@ DO JN=1,NMODE_DST * XM3TOUM3 & !==>um3_{aer}/m3_{air} / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment) !Limit mass concentration to minimum value - ZM(:,NM3(JN)) = MAX(ZM(:,NM3(JN)), ZMMIN(NM3(JN))) +! ZM(:,NM3(JN)) = MAX(ZM(:,NM3(JN)), ZMMIN(NM3(JN))) ! ZM(:,NM6(JN)) = ZSV(:,3+(JN-1)*3) & !um6/molec_{air}*(cm3/m3) * 1.d-6 & !==> um6/molec_{air} @@ -690,7 +695,7 @@ DO JN=1,NMODE_DST / XMD & !==> um6/kg_{air} * PRHODREF(:) !==> um6/m3_{air} !Limit m6 concentration to minimum value - ZM(:,NM6(JN)) = MAX(ZM(:,NM6(JN)), ZMMIN(NM6(JN))) +! ZM(:,NM6(JN)) = MAX(ZM(:,NM6(JN)), ZMMIN(NM6(JN))) ! !Get sigma (only if sigma is allowed to vary) !Get intermediate values for sigma M3^2/(M0*M6) (ORILAM paper, eqn 8) @@ -729,7 +734,7 @@ DO JN=1,NMODE_DST * XM3TOUM3 & !==>um3_{aer}/m3_{air} / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment) - ZM(:,NM3(JN)) = MAX(ZM(:,NM3(JN)), ZMMIN(NM3(JN))) +! ZM(:,NM3(JN)) = MAX(ZM(:,NM3(JN)), ZMMIN(NM3(JN))) ZM(:,NM0(JN))= ZM(:,NM3(JN))/& ((ZINIRADIUS(JN)**3)*EXP(4.5 * LOG(XINISIG(JPDUSTORDER(JN)))**2)) @@ -752,15 +757,15 @@ DO JN=1,NMODE_DST * PRHODREF(:) !==>#/m3 ! Limit concentration to minimum values - WHERE ((ZM(:,NM0(JN)) < ZMMIN(NM0(JN)) ).OR. & - (ZM(:,NM3(JN)) < ZMMIN(NM3(JN)) )) - ZM(:,NM0(JN)) = ZMMIN(NM0(JN)) - ZM(:,NM3(JN)) = ZMMIN(NM3(JN)) - PSVT(:,1+(JN-1)*2) = ZM(:,NM0(JN)) * XMD / & - (XAVOGADRO * PRHODREF(:) ) - PSVT(:,2+(JN-1)*2) = ZM(:,NM3(JN)) * XMD * XPI * 4./3. * ZRHOI / & - (ZMI*PRHODREF(:)*XM3TOUM3) - ENDWHERE +! WHERE ((ZM(:,NM0(JN)) < ZMMIN(NM0(JN)) ).OR. & +! (ZM(:,NM3(JN)) < ZMMIN(NM3(JN)) )) +! ZM(:,NM0(JN)) = ZMMIN(NM0(JN)) +! ZM(:,NM3(JN)) = ZMMIN(NM3(JN)) +! PSVT(:,1+(JN-1)*2) = ZM(:,NM0(JN)) * XMD / & +! (XAVOGADRO * PRHODREF(:) ) +! PSVT(:,2+(JN-1)*2) = ZM(:,NM3(JN)) * XMD * XPI * 4./3. * ZRHOI / & +! (ZMI*PRHODREF(:)*XM3TOUM3) +! ENDWHERE END IF ! diff --git a/src/MNH/mode_salt_psd.f90 b/src/MNH/mode_salt_psd.f90 index dc5a8611e..1a4a9e799 100644 --- a/src/MNH/mode_salt_psd.f90 +++ b/src/MNH/mode_salt_psd.f90 @@ -140,12 +140,9 @@ ALLOCATE (ZRG(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3))) ALLOCATE (ZSV(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3), SIZE(PSVT,4))) ALLOCATE (ZINIRADIUS(NMODE_SLT)) -ZSV(:,:,:,:) = MAX(PSVT(:,:,:,:), XMNH_TINY) - -! ++ JORIS DBG ++ +ZSV(:,:,:,:) = PSVT(:,:,:,:) ZRG(:,:,:)= XMNH_TINY ZM(:,:,:,:)= XMNH_TINY -! -- JORIS DBG -- DO JN=1,NMODE_SLT IMODEIDX = JPSALTORDER(JN) @@ -164,7 +161,8 @@ DO JN=1,NMODE_SLT ZMMIN(NM0(JN)) = XN0MIN_SLT(IMODEIDX) ZRGMIN = ZINIRADIUS(JN) IF (LVARSIG_SLT) THEN - ZSIGMIN = XSIGMIN_SLT + ZSIGMIN = XINISIG_SLT(IMODEIDX) + ! ZSIGMIN = XSIGMIN_SLT ELSE ZSIGMIN = XINISIG_SLT(IMODEIDX) ENDIF @@ -197,8 +195,6 @@ DO JN=1,NMODE_SLT * (1.d0/ZRHOI) & !==>m3_{aer}/m3_{air} * XM3TOUM3_SALT & !==>um3_{aer}/m3_{air} / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment) - !Limit mass concentration to minimum value - ZM(:,:,:,NM3(JN)) = MAX(ZM(:,:,:,NM3(JN)), ZMMIN(NM3(JN))) ! ZM(:,:,:,NM6(JN)) = ZSV(:,:,:,3+(JN-1)*3) & !um6/molec_{air}*(cm3/m3) * 1.d-6 & !==> um6/molec_{air} @@ -206,7 +202,7 @@ DO JN=1,NMODE_SLT / XMD & !==> um6/kg_{air} * PRHODREF(:,:,:) !==> um6/m3_{air} !Limit m6 concentration to minimum value - ZM(:,:,:,NM6(JN)) = MAX(ZM(:,:,:,NM6(JN)), ZMMIN(NM6(JN))) +! ZM(:,:,:,NM6(JN)) = MAX(ZM(:,:,:,NM6(JN)), ZMMIN(NM6(JN))) ! !Get sigma (only if sigma is allowed to vary) !Get intermediate values for sigma M3^2/(M0*M6) (ORILAM paper, eqn 8) @@ -244,7 +240,7 @@ DO JN=1,NMODE_SLT * (1.d0/ZRHOI) & !==>m3_{aer}/m3_{air} * XM3TOUM3_SALT & !==>um3_{aer}/m3_{air} / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment) - ZM(:,:,:,NM3(JN)) = MAX(ZM(:,:,:,NM3(JN)), ZMMIN(NM3(JN))) +! ZM(:,:,:,NM3(JN)) = MAX(ZM(:,:,:,NM3(JN)), ZMMIN(NM3(JN))) !Modif salt/dust 5.1. beg PSVT(:,:,:,JN) = ZM(:,:,:,NM3(JN)) * XMD * XPI * 4./3. * ZRHOI / & (ZMI*PRHODREF(:,:,:)*XM3TOUM3_SALT) @@ -265,6 +261,7 @@ DO JN=1,NMODE_SLT / (XPI * 4./3.) !==>um3_{aer}/m3_{air} (volume ==> 3rd moment) + !Get number concentration (#/molec_{air}==>#/m3) ZM(:,:,:,NM0(JN))= & ZSV(:,:,:,1+(JN-1)*2) & !#/molec_{air} @@ -272,17 +269,6 @@ DO JN=1,NMODE_SLT / XMD & !==>#/kg_{air} * PRHODREF(:,:,:) !==>#/m3 - ! Limit concentration to minimum values - WHERE ((ZM(:,:,:,NM0(JN)) < ZMMIN(NM0(JN)) ).OR. & - (ZM(:,:,:,NM3(JN)) < ZMMIN(NM3(JN)) )) - ZM(:,:,:,NM0(JN)) = ZMMIN(NM0(JN)) - ZM(:,:,:,NM3(JN)) = ZMMIN(NM3(JN)) - PSVT(:,:,:,1+(JN-1)*2) = ZM(:,:,:,NM0(JN)) * XMD / & - (XAVOGADRO * PRHODREF(:,:,:) ) - PSVT(:,:,:,2+(JN-1)*2) = ZM(:,:,:,NM3(JN)) * XMD * XPI * 4./3. * ZRHOI / & - (ZMI*PRHODREF(:,:,:)*XM3TOUM3_SALT) - ENDWHERE - END IF ZM(:,:,:,NM6(JN)) = ZM(:,:,:,NM0(JN)) & @@ -315,7 +301,7 @@ DO JN=1,NMODE_SLT /(ZM(:,:,:,NM6(JN))*ZM(:,:,:,NM0(JN))*ZM(:,:,:,NM0(JN))*ZM(:,:,:,NM0(JN))) & ) & ** XSIXTH_SALT - !ZRG(:,:,:)=MIN(ZRG(:,:,:),ZINIRADIUS(JN)) + !Give the sigma-values to the passed array IF(PRESENT(PSIG3D)) PSIG3D(:,:,:,JN) = ZSIGMA(:,:,:) ! @@ -441,12 +427,6 @@ END SUBROUTINE PPP2SALT !Set molecular weight of sea salt !NOTE THAT THIS IS NOW IN KG ZMI = XMOLARWEIGHT_SALT ! - - ! PSVT need to be positive -!Modif salt/dust 5.1. beg -! PSVT(:,:,:,:) = MAX(PSVT(:,:,:,:), XMNH_TINY) -!Modif salt/dust 5.1. end - DO JN=1,NMODE_SLT IMODEIDX = JPSALTORDER(JN) !Calculations here are for one mode only @@ -465,7 +445,8 @@ END SUBROUTINE PPP2SALT ZMMIN(NM0(JN)) = XN0MIN_SLT(IMODEIDX) ZRGMIN = ZINIRADIUS(JN) IF (LVARSIG_SLT) THEN - ZSIGMIN = XSIGMIN_SLT + ZSIGMIN = XINISIG_SLT(IMODEIDX) +! ZSIGMIN = XSIGMIN_SLT ELSE ZSIGMIN = XINISIG_SLT(IMODEIDX) ENDIF @@ -517,22 +498,22 @@ END SUBROUTINE PPP2SALT ZM(:,:,:,NM6(JN)) = ZM(:,:,:,NM0(JN)) * (PRG3D(:,:,:,JN)**6) * & EXP(18 *(LOG(PSIG3D(:,:,:,JN)))**2) - IF (LVARSIG_SLT) THEN - WHERE ((ZM(:,:,:,NM0(JN)) .LT. ZMMIN(NM0(JN))).OR.& - (ZM(:,:,:,NM3(JN)) .LT. ZMMIN(NM3(JN))).OR.& - (ZM(:,:,:,NM6(JN)) .LT. ZMMIN(NM6(JN)))) - ZM(:,:,:,NM0(JN)) = ZMMIN(NM0(JN)) - ZM(:,:,:,NM3(JN)) = ZMMIN(NM3(JN)) - ZM(:,:,:,NM6(JN)) = ZMMIN(NM6(JN)) - END WHERE - ELSE IF (.NOT.(LRGFIX_SLT)) THEN - - WHERE ((ZM(:,:,:,NM0(JN)) .LT. ZMMIN(NM0(JN))).OR.& - (ZM(:,:,:,NM3(JN)) .LT. ZMMIN(NM3(JN)))) - ZM(:,:,:,NM0(JN)) = ZMMIN(NM0(JN)) - ZM(:,:,:,NM3(JN)) = ZMMIN(NM3(JN)) - END WHERE - ENDIF +! IF (LVARSIG_SLT) THEN +! WHERE ((ZM(:,:,:,NM0(JN)) .LT. ZMMIN(NM0(JN))).OR.& +! (ZM(:,:,:,NM3(JN)) .LT. ZMMIN(NM3(JN))).OR.& +! (ZM(:,:,:,NM6(JN)) .LT. ZMMIN(NM6(JN)))) +! ZM(:,:,:,NM0(JN)) = ZMMIN(NM0(JN)) +! ZM(:,:,:,NM3(JN)) = ZMMIN(NM3(JN)) +! ZM(:,:,:,NM6(JN)) = ZMMIN(NM6(JN)) +! END WHERE +! ELSE IF (.NOT.(LRGFIX_SLT)) THEN + +! WHERE ((ZM(:,:,:,NM0(JN)) .LT. ZMMIN(NM0(JN))).OR.& +! (ZM(:,:,:,NM3(JN)) .LT. ZMMIN(NM3(JN)))) +! ZM(:,:,:,NM0(JN)) = ZMMIN(NM0(JN)) +! ZM(:,:,:,NM3(JN)) = ZMMIN(NM3(JN)) +! END WHERE +! ENDIF ! return to concentration #/m3 => (#/molec_{air} diff --git a/src/MNH/modeln.f90 b/src/MNH/modeln.f90 index ea53387a5..a7a507828 100644 --- a/src/MNH/modeln.f90 +++ b/src/MNH/modeln.f90 @@ -272,6 +272,7 @@ END MODULE MODI_MODEL_n ! T. Nagel 01/02/2021: add turbulence recycling ! P. Wautelet 19/02/2021: add NEGA2 term for SV budgets ! J.L. Redelsperger 03/2021: add Call NHOA_COUPLN (coupling O & A LES version) +! C. Barthe 07/04/2022: deallocation of ZSEA !!------------------------------------------------------------------------------- ! !* 0. DECLARATIONS @@ -2124,6 +2125,7 @@ IF (LPROFILER) & XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, XTSRAD, XPABST, & XAER, XCLDFR, XCIT,PSEA=ZSEA(:,:)) ! +IF (ALLOCATED(ZSEA)) DEALLOCATE (ZSEA) ! CALL SECOND_MNH2(ZTIME2) ! diff --git a/src/MNH/modn_ch_orilam.f90 b/src/MNH/modn_ch_orilam.f90 index f8bd5d35e..5fad03c52 100644 --- a/src/MNH/modn_ch_orilam.f90 +++ b/src/MNH/modn_ch_orilam.f90 @@ -12,42 +12,43 @@ MODULE MODN_CH_ORILAM !! ##################### !! -!!*** *MODN_CH_ORILAM* -!! !! PURPOSE !! ------- -! Namelist for ORILAM aerosol scheme parameters +!! Namelist for ORILAM aerosol scheme parameters !! -!!** AUTHOR +!! AUTHOR !! ------ !! P. Tulet *CNRM* -! +!! !! MODIFICATIONS !! ------------- -!! Original 24/02/05 -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -USE MODD_CH_AEROSOL, ONLY: LORILAM, XN0IMIN, XN0JMIN, LSEDIMAERO, LAERINIT,& - LHETEROSO4, CNUCLEATION, XINISIGI, XINISIGJ, & - XINIRADIUSI, XINIRADIUSJ, LVARSIGI,& - LVARSIGJ, CMINERAL, CORGANIC,& - XSIGIMIN, XSIGIMAX,XSIGJMIN, XSIGJMAX, & - XCOEFRADIMAX, XCOEFRADIMIN, XCOEFRADJMAX, XCOEFRADJMIN,& - CRGUNIT, LRGFIX, LDEPOS_AER +!! Original 24/02/2005 !! !----------------------------------------------------------------------------- ! !* 0. DECLARATIONS ! ----------------- +! +USE MODD_CH_AEROSOL, ONLY: LORILAM, XN0IMIN, XN0JMIN, LSEDIMAERO, LAERINIT, & + LHETEROSO4, CNUCLEATION, LCONDENSATION, LMODE_MERGING, & + XRADIUS_NUCL, XSIGMA_NUCL, & + LCOAGULATION, XINISIGI, XINISIGJ, & + XINIRADIUSI, XINIRADIUSJ, LVARSIGI, & + LVARSIGJ, CMINERAL, CORGANIC, & + XSIGIMIN, XSIGIMAX,XSIGJMIN, XSIGJMAX, & + XCOEFRADIMAX, XCOEFRADIMIN, XCOEFRADJMAX, XCOEFRADJMIN, & + CRGUNIT, LRGFIX, LDEPOS_AER +! IMPLICIT NONE -SAVE -NAMELIST /NAM_CH_ORILAM/ LORILAM, XN0IMIN, XN0JMIN, LSEDIMAERO, LAERINIT, & - LHETEROSO4, CNUCLEATION, XINISIGI, XINISIGJ, & - XINIRADIUSI, XINIRADIUSJ, LVARSIGI,& - LVARSIGJ, CMINERAL, CORGANIC, & - XSIGIMIN, XSIGIMAX,XSIGJMIN, XSIGJMAX, & - XCOEFRADIMAX, XCOEFRADIMIN, XCOEFRADJMAX, XCOEFRADJMIN,& +! +NAMELIST /NAM_CH_ORILAM/ LORILAM, XN0IMIN, XN0JMIN, LSEDIMAERO, LAERINIT, & + LHETEROSO4, CNUCLEATION, LCONDENSATION, LMODE_MERGING, & + XRADIUS_NUCL, XSIGMA_NUCL, & + LCOAGULATION, XINISIGI, XINISIGJ, & + XINIRADIUSI, XINIRADIUSJ, LVARSIGI, & + LVARSIGJ, CMINERAL, CORGANIC, & + XSIGIMIN, XSIGIMAX,XSIGJMIN, XSIGJMAX, & + XCOEFRADIMAX, XCOEFRADIMIN, XCOEFRADJMAX, XCOEFRADJMIN, & CRGUNIT, LRGFIX, LDEPOS_AER ! diff --git a/src/MNH/modn_param_lima.f90 b/src/MNH/modn_param_lima.f90 index f86b1add0..c42f00675 100644 --- a/src/MNH/modn_param_lima.f90 +++ b/src/MNH/modn_param_lima.f90 @@ -23,7 +23,7 @@ NAMELIST/NAM_PARAM_LIMA/LCOLD, LNUCL, LSEDI, LSNOW, LHAIL, LHHONI, LMEYERS,& CPRISTINE_ICE_LIMA, CHEVRIMED_ICE_LIMA, & XALPHAI, XNUI, XALPHAS, XNUS, XALPHAG, XNUG, & XFACTNUC_DEP, XFACTNUC_CON, NPHILLIPS, & -! + LCIBU, XNDEBRIS_CIBU, LRDSF, & LWARM, LACTI, LRAIN, LSEDC, LACTIT, LBOUND, LSPRO, & LADJ, & NMOD_CCN, XCCN_CONC, & diff --git a/src/MNH/prep_ideal_case.f90 b/src/MNH/prep_ideal_case.f90 index 370e21412..016f888a5 100644 --- a/src/MNH/prep_ideal_case.f90 +++ b/src/MNH/prep_ideal_case.f90 @@ -409,6 +409,11 @@ USE MODI_PGD_SURF_ATM USE MODI_ICE_ADJUST_BIS USE MODI_WRITE_PGD_SURF_ATM_n USE MODI_PREP_SURF_MNH +!UPG*PT +USE MODI_INIT_SALT +USE MODI_AER2LIMA +USE MODD_PARAM_LIMA +!UPG*PT ! !JUAN USE MODE_SPLITTINGZ_ll @@ -715,6 +720,11 @@ IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_IBM_LSF ) CALL INI_FIELD_LIST(1) ! CALL INI_FIELD_SCALARS() +!UPG*PT +! Sea salt +CALL INIT_SALT +!UPG*PT + ! IF( LEN_TRIM(CPGD_FILE) /= 0 ) THEN ! open the PGD_FILE @@ -1730,6 +1740,11 @@ CALL IO_File_close(TZEXPREFILE) ! Close the EXPRE file ! IF ( LCH_INIT_FIELD ) CALL CH_INIT_FIELD_n(1, NLUOUT, NVERB) ! +!UPG*PT +! Initialization LIMA variables by ORILAM +IF (CCLOUD == 'LIMA' .AND. ((LORILAM).OR.(LDUST).OR.(LSALT))) & + CALL AER2LIMA(XSVT, XRHODREF, XRT(:,:,:,1), XPABST, XTHT, XZZ) +!UPG*PT !------------------------------------------------------------------------------- ! !* 7. INITIALIZE LEVELSET FOR IBM diff --git a/src/MNH/prep_real_case.f90 b/src/MNH/prep_real_case.f90 index 2796da451..7d8dc30d5 100644 --- a/src/MNH/prep_real_case.f90 +++ b/src/MNH/prep_real_case.f90 @@ -391,19 +391,25 @@ ! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine ! T.Nagel 02/2021: add IBM ! P. Wautelet 06/07/2021: use FINALIZE_MNH +!! M. Leriche 26/01/2022: add reading of CAMS reanalysis for chemistry +!! and/or for LIMA !------------------------------------------------------------------------------- ! !* 0. DECLARATIONS ! ------------ ! -USE MODD_CH_AEROSOL, ONLY: LORILAM, LINITPM, XINIRADIUSI, XINIRADIUSJ, & - XINISIGI, XINISIGJ, XN0IMIN, XN0JMIN, CRGUNIT +USE MODD_CH_M9_n USE MODD_CH_MNHC_n, ONLY: LUSECHAQ_n=>LUSECHAQ,LUSECHIC_n=>LUSECHIC, LUSECHEM_n=>LUSECHEM USE MODD_CONF USE MODD_CONF_n USE MODD_CST USE MODD_DIM_n -USE MODD_DUST, ONLY: LDUST, NMODE_DST, CRGUNITD, XINISIG, XINIRADIUS, XN0MIN +!UPG*PT +USE MODD_CH_AEROSOL +USE MODD_DUST, ONLY: LDUST, NMODE_DST, CRGUNITD, XINISIG, XINIRADIUS, XN0MIN,& + LDSTCAMS +!UPG*PT + USE MODD_DYN_n, CPRESOPT_n=>CPRESOPT, LRES_n=>LRES, XRES_n=>XRES , NITR_n=>NITR USE MODD_FIELD_n USE MODD_GR_FIELD_n @@ -425,7 +431,11 @@ USE MODD_PARAMETERS USE MODD_PARAM_n USE MODD_PREP_REAL USE MODD_REF_n -USE MODD_SALT, ONLY: LSALT, NMODE_SLT, CRGUNITS, XINISIG_SLT, XINIRADIUS_SLT, XN0MIN_SLT +!UPG*PT +USE MODD_SALT, ONLY: LSALT, NMODE_SLT, CRGUNITS, XINISIG_SLT, XINIRADIUS_SLT, XN0MIN_SLT,& + LSLTCAMS +USE MODD_CH_AERO_n, ONLY: XM3D, XRHOP3D, XSIG3D, XRG3D, XN3D, XCTOTA3D +!UPG*PT USE MODD_TURB_n ! USE MODE_EXTRAPOL @@ -464,8 +474,15 @@ USE MODI_PRESSURE_IN_PREP USE MODI_READ_ALL_DATA_GRIB_CASE USE MODI_READ_ALL_DATA_MESONH_CASE USE MODI_READ_ALL_NAMELISTS -USE MODI_READ_CAMS_DATA_NETCDF_CASE -USE MODI_READ_CHEM_DATA_NETCDF_CASE +!UPG*PT +!USE MODI_READ_CAMS_DATA_NETCDF_CASE +!USE MODI_READ_CHEM_DATA_NETCDF_CASE +USE MODI_READ_CHEM_DATA_MOZART_CASE +USE MODI_READ_CHEM_DATA_CAMS_CASE +USE MODI_READ_LIMA_DATA_NETCDF_CASE +USE MODI_AER2LIMA +USE MODI_CH_AER_EQM_INIT_n +!UPG*PT USE MODI_READ_VER_GRID USE MODI_SECOND_MNH USE MODI_SET_REF @@ -492,8 +509,12 @@ CHARACTER(LEN=28) :: YATMFILE ! name of the Atmospheric file CHARACTER(LEN=6) :: YATMFILETYPE! type of the Atmospheric file CHARACTER(LEN=28) :: YCHEMFILE ! name of the Chemical file CHARACTER(LEN=6) :: YCHEMFILETYPE! type of the Chemical file -CHARACTER(LEN=28) :: YCAMSFILE ! name of the input CAMS file -CHARACTER(LEN=6) :: YCAMSFILETYPE! type of the input CAMS file +!UP*PT +!CHARACTER(LEN=28) :: YCAMSFILE ! name of the input CAMS file +!CHARACTER(LEN=6) :: YCAMSFILETYPE! type of the input CAMS file +CHARACTER(LEN=28) :: YLIMAFILE ! name of the input MACC file +CHARACTER(LEN=6) :: YLIMAFILETYPE! type of the input MACC file +!UP*PT CHARACTER(LEN=28) :: YSURFFILE ! name of the Surface file CHARACTER(LEN=6) :: YSURFFILETYPE! type of the Surface file CHARACTER(LEN=28) :: YPGDFILE ! name of the physiographic data @@ -529,6 +550,7 @@ INTEGER :: JRR ! loop counter for moist var. LOGICAL :: LUSECHAQ LOGICAL :: LUSECHIC LOGICAL :: LUSECHEM +INTEGER :: JN ! TYPE(TFILEDATA),POINTER :: TZATMFILE => NULL() TYPE(TFILEDATA),POINTER :: TZPRE_REAL1FILE => NULL() @@ -550,7 +572,11 @@ XANGCONV0, XANGCONV1000, XANGCONV2000, & NAMELIST/NAM_AERO_CONF/ LORILAM, LINITPM, LDUST, XINIRADIUSI, XINIRADIUSJ,& XINISIGI, XINISIGJ, XN0IMIN, XN0JMIN, CRGUNIT, CRGUNITD,& LSALT, CRGUNITS, NMODE_DST, XINISIG, XINIRADIUS, XN0MIN,& - XINISIG_SLT, XINIRADIUS_SLT, XN0MIN_SLT, NMODE_SLT +!UPG*PT + XINISIG_SLT, XINIRADIUS_SLT, XN0MIN_SLT, NMODE_SLT, & + LDSTCAMS, LSLTCAMS,CACTCCN,CCLOUD, NMOD_IFN, NMOD_CCN +!UPG*PT + NAMELIST/NAM_CH_CONF/ LUSECHAQ,LUSECHIC,LUSECHEM ! NAMELIST/NAM_IBM_LSF/ LIBM_LSF, CIBM_TYPE, NIBM_SMOOTH, XIBM_SMOOTH @@ -559,6 +585,12 @@ NAMELIST/NAM_IBM_LSF/ LIBM_LSF, CIBM_TYPE, NIBM_SMOOTH, XIBM_SMOOTH INTEGER :: II, IJ, IGRID, ILENGTH CHARACTER (LEN=100) :: HCOMMENT TYPE(LIST_ll), POINTER :: TZFIELDS_ll=>NULL() ! list of fields to exchange +!UPG*PT +REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBXRHO, ZLBYRHO +REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBXZZ, ZLBYZZ +REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLBXPABST, ZLBYPABST +INTEGER :: ILBX,ILBY,IIB,IJB,IIE,IJE +!UPG*PT !------------------------------------------------------------------------------- ! @@ -595,7 +627,10 @@ CALL OPEN_PRC_FILES(TZPRE_REAL1FILE,YATMFILE, YATMFILETYPE,TZATMFILE & ,YCHEMFILE,YCHEMFILETYPE & ,YSURFFILE,YSURFFILETYPE & ,YPGDFILE,TPGDFILE & - ,YCAMSFILE,YCAMSFILETYPE) +!UPG*PT +! ,YCAMSFILE,YCAMSFILETYPE) + ,YLIMAFILE,YLIMAFILETYPE) +!UPG*PT ILUOUT0 = TLUOUT0%NLU TLUOUT => TLUOUT0 ! @@ -761,27 +796,57 @@ ELSE L2D=.FALSE. END IF ! +! UPG*PT !* 5.1 reading of the input chemical data ! +!IF(LEN_TRIM(YCHEMFILE)>0)THEN +! ! read again Nam_aero_conf +! CALL POSNAM(IPRE_REAL1,'NAM_AERO_CONF',GFOUND,ILUOUT0) +! IF (GFOUND) READ(IPRE_REAL1,NAM_AERO_CONF) +! IF(YCHEMFILETYPE=='GRIBEX') & +! CALL READ_ALL_DATA_GRIB_CASE('CHEM',TZPRE_REAL1FILE,YCHEMFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL) +! IF (YCHEMFILETYPE=='NETCDF') & +! CALL READ_CHEM_DATA_NETCDF_CASE(TZPRE_REAL1FILE,YCHEMFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL) +!END IF +! +!* 5.2 reading the input CAMS data +! +!IF(LEN_TRIM(YCAMSFILE)>0)THEN +! IF(YCAMSFILETYPE=='NETCDF') THEN +! CALL READ_CAMS_DATA_NETCDF_CASE(TZPRE_REAL1FILE,YCAMSFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL) +! ELSE +! CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_REAL_CASE','CANNOT READ CAMS GRIB FILES YET') +! END IF +!END IF +!* 5.1 reading CAMS or MACC files for init LIMA +! +IF(LEN_TRIM(YLIMAFILE)>0)THEN + IF(YLIMAFILETYPE=='NETCDF') THEN + CALL READ_LIMA_DATA_NETCDF_CASE(TZPRE_REAL1FILE,YLIMAFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL) + ELSE + WRITE(ILUOUT0,FMT=*) + !callabortstop + CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_REAL_CASE','Pb in MACC/CAMS file') + STOP + END IF +END IF +! +!* 5.2 reading of the input chemical data + dusts + salts if needed +! IF(LEN_TRIM(YCHEMFILE)>0)THEN ! read again Nam_aero_conf CALL POSNAM(IPRE_REAL1,'NAM_AERO_CONF',GFOUND,ILUOUT0) IF (GFOUND) READ(IPRE_REAL1,NAM_AERO_CONF) IF(YCHEMFILETYPE=='GRIBEX') & CALL READ_ALL_DATA_GRIB_CASE('CHEM',TZPRE_REAL1FILE,YCHEMFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL) - IF (YCHEMFILETYPE=='NETCDF') & - CALL READ_CHEM_DATA_NETCDF_CASE(TZPRE_REAL1FILE,YCHEMFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL) -END IF -! -!* 5.2 reading the input CAMS data -! -IF(LEN_TRIM(YCAMSFILE)>0)THEN - IF(YCAMSFILETYPE=='NETCDF') THEN - CALL READ_CAMS_DATA_NETCDF_CASE(TZPRE_REAL1FILE,YCAMSFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL) - ELSE - CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_REAL_CASE','CANNOT READ CAMS GRIB FILES YET') - END IF + IF (YCHEMFILETYPE=='MOZART') & + CALL READ_CHEM_DATA_MOZART_CASE(TZPRE_REAL1FILE,YCHEMFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL) + IF (YCHEMFILETYPE=='CAMSEU') & + CALL READ_CHEM_DATA_CAMS_CASE(TZPRE_REAL1FILE,YCHEMFILE,TPGDFILE,ZHORI,NVERB, & + LDUMMY_REAL,LUSECHEM) END IF + +!UPG*PT ! CALL IO_File_close(TZPRE_REAL1FILE) ! @@ -921,10 +986,23 @@ END IF IF (LEN_TRIM(YCHEMFILE)>0 .AND. YCHEMFILETYPE=='GRIBEX') THEN CALL VER_PREP_GRIBEX_CASE('CHEM',ZDG) END IF -IF ((LEN_TRIM(YCHEMFILE)>0 .AND. YCHEMFILETYPE=='NETCDF') .OR. & - (LEN_TRIM(YCAMSFILE)>0 .AND. YCAMSFILETYPE=='NETCDF')) THEN - CALL VER_PREP_NETCDF_CASE(ZDG) +!UPG*PT +!IF ((LEN_TRIM(YCHEMFILE)>0 .AND. YCHEMFILETYPE=='NETCDF') .OR. & +! (LEN_TRIM(YCAMSFILE)>0 .AND. YCAMSFILETYPE=='NETCDF')) THEN +! CALL VER_PREP_NETCDF_CASE(ZDG) +!END IF +IF (LEN_TRIM(YCHEMFILE)>0 .AND. ((YCHEMFILETYPE=='MOZART').OR. & + (YCHEMFILETYPE=='CAMSEU'))) THEN + CALL VER_PREP_NETCDF_CASE(ZDG,XSV_LS) + + DEALLOCATE(XSV_LS) +END IF +! +IF (LEN_TRIM(YLIMAFILE)>0 .AND. YLIMAFILETYPE=='NETCDF') THEN + CALL VER_PREP_NETCDF_CASE(ZDG,XSV_LS_LIMA) + DEALLOCATE(XSV_LS_LIMA) END IF +!UPG*PT ! CALL SECOND_MNH(ZTIME2) ZPREP = ZTIME2 - ZTIME1 - ZDG @@ -1011,13 +1089,77 @@ IF(LEN_TRIM(YCHEMFILE)>0 .AND. YCHEMFILETYPE=='MESONH')THEN LHORELAX_SVAER = (NSV_AER > 0) ELSE ! -IF (LEN_TRIM(YCAMSFILE)>0 .AND. YCAMSFILETYPE=='NETCDF') THEN +!UPG*PT +!IF (LEN_TRIM(YCAMSFILE)>0 .AND. YCAMSFILETYPE=='NETCDF') THEN +IF (LEN_TRIM(YLIMAFILE)>0 .AND. YLIMAFILETYPE=='NETCDF') THEN +!UPG*PT CALL LIMA_MIXRAT_TO_NCONC(XPABST, XTHT, XRT(:,:,:,1), XSV_MX) END IF ! CALL INI_PROG_VAR(XTKE_MX,XSV_MX) END IF ! + +! Initialization of ORILAM variables +IF (LORILAM) THEN + IF (.NOT.(ASSOCIATED(XN3D))) ALLOCATE(XN3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE)) + IF (.NOT.(ASSOCIATED(XRG3D))) ALLOCATE(XRG3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE)) + IF (.NOT.(ASSOCIATED(XSIG3D))) ALLOCATE(XSIG3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE)) + IF (.NOT.(ASSOCIATED(XRHOP3D))) ALLOCATE(XRHOP3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE)) + IF (.NOT.(ASSOCIATED(XM3D))) ALLOCATE(XM3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE*3)) + IF (.NOT.(ASSOCIATED(XCTOTA3D))) & + ALLOCATE(XCTOTA3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),NSP+NCARB+NSOA,JPMODE)) + + CALL CH_AER_EQM_INIT_n(XSVT(:,:,:,NSV_CHEMBEG:NSV_CHEMEND),& + XSVT(:,:,:,NSV_AERBEG:NSV_AEREND),& + XM3D,XRHOP3D,XSIG3D,& + XRG3D,XN3D, XRHODREF, XCTOTA3D) +END IF +! +! Initialization LIMA variables by ORILAM +IF (CCLOUD == 'LIMA' .AND. ((LORILAM).OR.(LDUST).OR.(LSALT))) THEN + + ! Init LIMA by ORILAM + CALL AER2LIMA(XSVT, XRHODREF, XRT(:,:,:,1), XPABST, XTHT,XZZ) + + ! Init LB LIMA by ORILAM + ALLOCATE(ZLBXRHO(SIZE(XLBXSVM,1), SIZE(XLBXSVM,2), SIZE(XLBXSVM,3))) + ALLOCATE(ZLBYRHO(SIZE(XLBYSVM,1), SIZE(XLBYSVM,2), SIZE(XLBYSVM,3))) + ALLOCATE(ZLBXPABST(SIZE(XLBXSVM,1), SIZE(XLBXSVM,2), SIZE(XLBXSVM,3))) + ALLOCATE(ZLBYPABST(SIZE(XLBYSVM,1), SIZE(XLBYSVM,2), SIZE(XLBYSVM,3))) + ALLOCATE(ZLBXZZ(SIZE(XLBXSVM,1), SIZE(XLBXSVM,2), SIZE(XLBXSVM,3))) + ALLOCATE(ZLBYZZ(SIZE(XLBYSVM,1), SIZE(XLBYSVM,2), SIZE(XLBYSVM,3))) + + ILBX=SIZE(XLBXSVM,1)/2-JPHEXT + ILBY=SIZE(XLBYSVM,2)/2-JPHEXT + + CALL GET_INDICE_ll (IIB,IJB,IIE,IJE) + + ZLBXRHO(1:ILBX+1,:,:) = XRHODREF(IIB-1:IIB-1+ILBX,:,:) + ZLBXRHO(ILBX+2:2*ILBX+2,:,:) = XRHODREF(IIE+1-ILBX:IIE+1,:,:) + ZLBYRHO(:,1:ILBY+1,:) = XRHODREF(:,IJB-1:IJB-1+ILBY,:) + ZLBYRHO(:,ILBY+2:2*ILBY+2,:) = XRHODREF(:,IJE+1-ILBY:IJE+1,:) + ZLBXPABST(1:ILBX+1,:,:) = XPABST(IIB-1:IIB-1+ILBX,:,:) + ZLBXPABST(ILBX+2:2*ILBX+2,:,:) = XPABST(IIE+1-ILBX:IIE+1,:,:) + ZLBYPABST(:,1:ILBY+1,:) = XPABST(:,IJB-1:IJB-1+ILBY,:) + ZLBYPABST(:,ILBY+2:2*ILBY+2,:) = XPABST(:,IJE+1-ILBY:IJE+1,:) + ZLBXZZ(1:ILBX+1,:,:) = XZZ(IIB-1:IIB-1+ILBX,:,:) + ZLBXZZ(ILBX+2:2*ILBX+2,:,:) = XZZ(IIE+1-ILBX:IIE+1,:,:) + ZLBYZZ(:,1:ILBY+1,:) = XZZ(:,IJB-1:IJB-1+ILBY,:) + ZLBYZZ(:,ILBY+2:2*ILBY+2,:) = XZZ(:,IJE+1-ILBY:IJE+1,:) + + CALL AER2LIMA(XLBXSVM, ZLBXRHO, XLBXRM(:,:,:,1), ZLBXPABST, XLBXTHM, ZLBXZZ) + CALL AER2LIMA(XLBYSVM, ZLBYRHO, XLBYRM(:,:,:,1), ZLBYPABST, XLBYTHM, ZLBYZZ) + + DEALLOCATE(ZLBXRHO) + DEALLOCATE(ZLBYRHO) + DEALLOCATE(ZLBXPABST) + DEALLOCATE(ZLBYPABST) + DEALLOCATE(ZLBXZZ) + DEALLOCATE(ZLBYZZ) + +END IF +! IF (ALLOCATED(XSV_MX)) DEALLOCATE(XSV_MX) IF (ALLOCATED(XTKE_MX)) DEALLOCATE(XTKE_MX) ! diff --git a/src/MNH/rain_ice_elec.f90 b/src/MNH/rain_ice_elec.f90 index 69721492d..a73a0250c 100644 --- a/src/MNH/rain_ice_elec.f90 +++ b/src/MNH/rain_ice_elec.f90 @@ -198,6 +198,7 @@ END MODULE MODI_RAIN_ICE_ELEC ! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90 ! P. Wautelet 03/2020: use the new data structures and subroutines for budgets ! P .Wautelet 09/03/2020: add missing budgets for electricity +! C. Barthe 07/04/2022: correction of budget for CMEL !------------------------------------------------------------------------------- ! !* 0. DECLARATIONS @@ -3227,7 +3228,7 @@ IMPLICIT NONE if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'CMEL', & Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) - if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'CMEL', & + if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'CMEL', & Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) ) if ( lbudget_sv ) then call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'CMEL', & diff --git a/src/MNH/read_exsegn.f90 b/src/MNH/read_exsegn.f90 index a8c847c3f..623a7cd4e 100644 --- a/src/MNH/read_exsegn.f90 +++ b/src/MNH/read_exsegn.f90 @@ -1286,28 +1286,30 @@ SELECT CASE ( CCLOUD ) WRITE(UNIT=ILUOUT,FMT=*) ' WITH A 2-MOMENT MICROPHYSICAL SCHEME "LIMA"' END IF - IF (LUSECHEM ) THEN - WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE BOTH LIMA MICROPHYS. SCHEME AND CHEMISTRY' - WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT YET AVAILABLE. SET LUSECHEM ' - WRITE(UNIT=ILUOUT,FMT=*) 'TO FALSE OR CCLOUD TO "ICE3" ' - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') - END IF - IF (LDUST ) THEN - WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE BOTH LIMA MICROPHYS. SCHEME AND DUSTS ' - WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT YET AVAILABLE. SET LDUST ' - WRITE(UNIT=ILUOUT,FMT=*) 'TO FALSE OR CCLOUD TO "ICE3" ' - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') - END IF - IF (LSALT ) THEN - WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE BOTH LIMA MICROPHYS. SCHEME AND SEA SALTS ' - WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT YET AVAILABLE. SET LSALT ' - WRITE(UNIT=ILUOUT,FMT=*) 'TO FALSE OR CCLOUD TO "ICE3" ' - !callabortstop - CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') - END IF -! +!UPG*PT +! IF (LUSECHEM ) THEN +! WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE BOTH LIMA MICROPHYS. SCHEME AND CHEMISTRY' +! WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT YET AVAILABLE. SET LUSECHEM ' +! WRITE(UNIT=ILUOUT,FMT=*) 'TO FALSE OR CCLOUD TO "ICE3" ' +! !callabortstop +! CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') +! END IF +! IF (LDUST ) THEN +! WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE BOTH LIMA MICROPHYS. SCHEME AND DUSTS ' +! WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT YET AVAILABLE. SET LDUST ' +! WRITE(UNIT=ILUOUT,FMT=*) 'TO FALSE OR CCLOUD TO "ICE3" ' +! !callabortstop +! CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') +! END IF +! IF (LSALT ) THEN +! WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE BOTH LIMA MICROPHYS. SCHEME AND SEA SALTS ' +! WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT YET AVAILABLE. SET LSALT ' +! WRITE(UNIT=ILUOUT,FMT=*) 'TO FALSE OR CCLOUD TO "ICE3" ' +! !callabortstop +! CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') +! END IF +! +!UPG*PT END SELECT ! LUSERV_G(KMI) = LUSERV @@ -1861,12 +1863,14 @@ IF (LDUST) THEN END IF IF (LDEPOS_DST(KMI)) THEN + !UPG *PT IF((CCLOUD /= 'ICE3').AND.(CCLOUD /= 'ICE4').AND.(CCLOUD /= 'KESS')& - .AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND. & + .AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND.(CCLOUD /= 'LIMA').AND. & (CPROGRAM/='SPAWN').AND.(CPROGRAM/='REAL')) THEN WRITE(UNIT=ILUOUT,FMT=9003) KMI WRITE(UNIT=ILUOUT,FMT='("ERROR: WET DEPOSITION OF DUST IS ONLY CODED FOR THE",/,& - & "MICROPHYSICAL SCHEME as ICE3, ICE4, KESS, KHKO and C2R2")') + & "MICROPHYSICAL SCHEME as ICE3, ICE4, KESS, KHKO, LIMA and C2R2")') + !UPG *PT !callabortstop CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') END IF @@ -1908,12 +1912,15 @@ IF (LSALT) THEN END IF IF (LDEPOS_SLT(KMI)) THEN + !UPG*PT IF((CCLOUD /= 'ICE3').AND.(CCLOUD /= 'ICE4').AND.(CCLOUD /= 'KESS')& - .AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND. & + !.AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND. & + .AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND.(CCLOUD /= 'LIMA').AND. & (CPROGRAM/='SPAWN').AND.(CPROGRAM/='REAL')) THEN WRITE(UNIT=ILUOUT,FMT=9003) KMI WRITE(UNIT=ILUOUT,FMT='("ERROR: WET DEPOSITION OF SEA SALT AEROSOLS IS ONLY CODED FOR THE",/,& - & "MICROPHYSICAL SCHEME as ICE3, ICE4, KESS, KHKO and C2R2")') + & "MICROPHYSICAL SCHEME as ICE3, ICE4, KESS, KHKO, LIMA and C2R2")') + !UPG*PT !callabortstop CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') END IF @@ -1929,9 +1936,9 @@ IF (LSALT) THEN CGETSVT(NSV_SLTDEPBEG:NSV_SLTDEPEND)='INIT' END IF END IF - IF(NMODE_SLT.GT.5 .OR. NMODE_SLT.LT.1) THEN + IF(NMODE_SLT.GT.8 .OR. NMODE_SLT.LT.1) THEN WRITE(UNIT=ILUOUT,FMT=9003) KMI - WRITE(UNIT=ILUOUT,FMT='("SALT MODES MUST BE BETWEEN 1 and 5 ")') + WRITE(UNIT=ILUOUT,FMT='("SALT MODES MUST BE BETWEEN 1 and 8 ")') !callabortstop CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') END IF @@ -1952,12 +1959,15 @@ IF (LORILAM) THEN END IF IF (LDEPOS_AER(KMI)) THEN + !UPG*PT IF((CCLOUD /= 'ICE3').AND.(CCLOUD /= 'ICE4').AND.(CCLOUD /= 'KESS')& - .AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND. & + .AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND.(CCLOUD /= 'LIMA').AND. & + !.AND.(CCLOUD /= 'KHKO').AND.(CCLOUD /= 'C2R2').AND. & (CPROGRAM/='SPAWN').AND.(CPROGRAM/='REAL')) THEN WRITE(UNIT=ILUOUT,FMT=9003) KMI WRITE(UNIT=ILUOUT,FMT='("ERROR: WET DEPOSITION OF ORILAM AEROSOLS IS ONLY CODED FOR THE",/,& - & "MICROPHYSICAL SCHEME as ICE3, ICE4, KESS, KHKO and C2R2")') + & "MICROPHYSICAL SCHEME as ICE3, ICE4, KESS, KHKO, LIMA and C2R2")') + !UPG*PT !callabortstop CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','') END IF diff --git a/src/MNH/read_field.f90 b/src/MNH/read_field.f90 index 1f8d4b3ca..f7ccb114e 100644 --- a/src/MNH/read_field.f90 +++ b/src/MNH/read_field.f90 @@ -18,7 +18,7 @@ INTERFACE KSIZELBXR_ll,KSIZELBYR_ll,KSIZELBXSV_ll,KSIZELBYSV_ll, & PUM,PVM,PWM,PDUM,PDVM,PDWM, & PUT,PVT,PWT,PTHT,PPABST,PTKET,PRTKEMS, & - PRT,PSVT,PZWS,PCIT,PDRYMASST, & + PRT,PSVT,PZWS,PCIT,PDRYMASST,PDRYMASSS, & PSIGS,PSRCT,PCLDFR,PBL_DEPTH,PSBL_DEPTH,PWTHVMF,PPHC,PPHR, & PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM, PLSZWSM, & PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, & @@ -81,6 +81,7 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCT ! turbulent flux ! <s'Rc'> at t REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCIT ! ice conc. at t REAL, INTENT(OUT) :: PDRYMASST ! Md(t) +REAL, INTENT(OUT) :: PDRYMASSS ! d Md(t) / dt REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS ! =sqrt(<s's'>) for the ! Subgrid Condensation REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! cloud fraction @@ -141,7 +142,7 @@ END MODULE MODI_READ_FIELD KSIZELBXR_ll,KSIZELBYR_ll,KSIZELBXSV_ll,KSIZELBYSV_ll, & PUM,PVM,PWM,PDUM,PDVM,PDWM, & PUT,PVT,PWT,PTHT,PPABST,PTKET,PRTKEMS, & - PRT,PSVT,PZWS,PCIT,PDRYMASST, & + PRT,PSVT,PZWS,PCIT,PDRYMASST,PDRYMASSS, & PSIGS,PSRCT,PCLDFR,PBL_DEPTH,PSBL_DEPTH,PWTHVMF,PPHC,PPHR, & PLSUM,PLSVM,PLSWM,PLSTHM,PLSRVM,PLSZWSM, & PLBXUM,PLBXVM,PLBXWM,PLBXTHM,PLBXTKEM,PLBXRM,PLBXSVM, & @@ -361,6 +362,7 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCT ! turbulent flux ! <s'Rc'> at t REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCIT ! ice conc. at t REAL, INTENT(OUT) :: PDRYMASST ! Md(t) +REAL, INTENT(OUT) :: PDRYMASSS ! d Md(t) / dt REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS ! =sqrt(<s's'>) for the ! Subgrid Condensation REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! cloud fraction @@ -1464,6 +1466,11 @@ CALL INI_LB(TPINIFILE,GLSOURCE,ISV, & !* 2.3 Some special variables: ! CALL IO_Field_read(TPINIFILE,'DRYMASST',PDRYMASST) ! dry mass +IF (CCONF=='RESTA') THEN + CALL IO_Field_read(TPINIFILE,'DRYMASSS',PDRYMASSS) ! dry mass tendency +ELSE + PDRYMASSS=XUNDEF ! should not be used +END IF ! SELECT CASE(HGETSRCT) ! turbulent flux SRC at time t CASE('READ') diff --git a/src/MNH/resolved_cloud.f90 b/src/MNH/resolved_cloud.f90 index 30616e6c5..dce56fa74 100644 --- a/src/MNH/resolved_cloud.f90 +++ b/src/MNH/resolved_cloud.f90 @@ -288,11 +288,14 @@ END MODULE MODI_RESOLVED_CLOUD USE MODD_CH_AEROSOL, ONLY: LORILAM USE MODD_DUST, ONLY: LDUST use modd_cst, only: xcpd, xrd, xp00, xrholw -USE MODD_DUST , ONLY: LDUST USE MODD_IO, ONLY: TFILEDATA -USE MODD_NSV, ONLY: NSV_C1R3END, NSV_C2R2BEG, NSV_C2R2END, & - NSV_LIMA_BEG, NSV_LIMA_END, NSV_LIMA_CCN_FREE, NSV_LIMA_IFN_FREE, & - NSV_LIMA_NC, NSV_LIMA_NI, NSV_LIMA_NR +!UPG*PT +USE MODD_NSV +!USE MODD_NSV, ONLY: NSV_C1R3END, NSV_C2R2BEG, NSV_C2R2END, & +! NSV_LIMA_BEG, NSV_LIMA_END, NSV_LIMA_CCN_FREE, NSV_LIMA_IFN_FREE, & +! NSV_LIMA_NC, NSV_LIMA_NI, NSV_LIMA_NR +! NSV_LIMA_NC, NSV_LIMA_NI, NSV_LIMA_NR +!UPG*PT USE MODD_PARAM_C2R2, ONLY: LSUPSAT USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT USE MODD_PARAM_ICE, ONLY: CSEDIM, LADJ_BEFORE, LADJ_AFTER, CFRAC_ICE_ADJUST, LRED @@ -321,6 +324,9 @@ USE MODI_RAIN_ICE USE MODI_RAIN_ICE_RED USE MODI_SHUMAN USE MODI_SLOW_TERMS +!UPG*PT +USE MODI_AER2LIMA +!UPG*PT ! IMPLICIT NONE ! @@ -450,7 +456,8 @@ INTEGER :: IKB ! INTEGER :: IKE ! INTEGER :: IKU INTEGER :: IINFO_ll ! return code of parallel routine -INTEGER :: JK,JI,JL + +INTEGER :: JK,JI,JL,II ! ! ! @@ -467,6 +474,10 @@ REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZZZ INTEGER :: ISVBEG ! first scalar index for microphysics INTEGER :: ISVEND ! last scalar index for microphysics REAL, DIMENSION(:), ALLOCATABLE :: ZRSMIN ! Minimum value for tendencies +!UPG*PT +REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSVT ! scalar variable for microphysics only +!UPG*PT + LOGICAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: LLMICRO ! mask to limit computation REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3), KRR) :: ZFPR ! @@ -501,11 +512,61 @@ ELSE IF (HCLOUD == 'C3R5') THEN ISVEND = NSV_C1R3END ELSE IF (HCLOUD == 'LIMA') THEN ISVBEG = NSV_LIMA_BEG - ISVEND = NSV_LIMA_END +!UPG*PT + IF (.NOT. LDUST .AND. .NOT. LSALT .AND. .NOT. LORILAM) THEN + ISVEND = NSV_LIMA_END + ELSE + IF (LORILAM) THEN + ISVEND = NSV_AEREND + END IF + IF (LDUST) THEN + ISVEND = NSV_DSTEND + END IF + IF (LSALT) THEN + ISVEND = NSV_SLTEND + END IF + END IF ELSE ISVBEG = 0 - ISVEND = -1 + ISVEND = 0 +END IF +! +! +! +!* 1. From ORILAM to LIMA: +! +IF (HCLOUD == 'LIMA') THEN +!IF (HCLOUD == 'LIMA' .AND. ((LORILAM).OR.(LDUST).OR.(LSALT))) THEN +! ORILAM : tendance s --> variable instant t +ALLOCATE(ZSVT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3),NSV)) + DO II = 1, NSV + ZSVT(:,:,:,II) = PSVS(:,:,:,II) * PTSTEP / PRHODJ(:,:,:) + END DO + +CALL AER2LIMA(ZSVT(IIB:IIE,IJB:IJE,IKB:IKE,:),& + PRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), & + PRT(IIB:IIE,IJB:IJE,IKB:IKE,1),& + PPABST(IIB:IIE,IJB:IJE,IKB:IKE),& + PTHT(IIB:IIE,IJB:IJE,IKB:IKE), & + PZZ(IIB:IIE,IJB:IJE,IKB:IKE)) + +! LIMA : variable instant t --> tendance s + PSVS(:,:,:,NSV_LIMA_CCN_FREE) = ZSVT(:,:,:,NSV_LIMA_CCN_FREE) * & + PRHODJ(:,:,:) / PTSTEP + PSVS(:,:,:,NSV_LIMA_CCN_FREE+1) = ZSVT(:,:,:,NSV_LIMA_CCN_FREE+1) * & + PRHODJ(:,:,:) / PTSTEP + PSVS(:,:,:,NSV_LIMA_CCN_FREE+2) = ZSVT(:,:,:,NSV_LIMA_CCN_FREE+2) * & + PRHODJ(:,:,:) / PTSTEP + + PSVS(:,:,:,NSV_LIMA_IFN_FREE) = ZSVT(:,:,:,NSV_LIMA_IFN_FREE) * & + PRHODJ(:,:,:) / PTSTEP + PSVS(:,:,:,NSV_LIMA_IFN_FREE+1) = ZSVT(:,:,:,NSV_LIMA_IFN_FREE+1) * & + PRHODJ(:,:,:) / PTSTEP + +DEALLOCATE(ZSVT) END IF + +!UPG*PT ! IF (HCLOUD(1:3)=='ICE' .AND. LRED) THEN ALLOCATE(ZRSMIN(SIZE(XRTMIN))) diff --git a/src/MNH/saltlfin.f90 b/src/MNH/saltlfin.f90 index e99be7c7a..76b538358 100644 --- a/src/MNH/saltlfin.f90 +++ b/src/MNH/saltlfin.f90 @@ -48,9 +48,9 @@ END MODULE MODI_SALTLFI_n !! !! MODIFICATIONS !! ------------- +!! none +!! !! 2014 P.Tulet modif calcul ZM -!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes - !! EXTERNAL !! -------- !! None @@ -101,7 +101,7 @@ INTEGER :: IMOMENTS !-Marine INTEGER :: JI, JJ, JN, JK ! loop counter INTEGER :: IMODEIDX ! index mode -REAL, PARAMETER :: ZN_SALT=1E4 ! multiplcative factor for X0MIN +REAL, PARAMETER :: ZN_SALT=0.1 ! particles of sea salt/cm3 {air} REAL, PARAMETER :: ZCLM=800. ! Marine Salt layer (m) REAL :: ZN_SALTN ! @@ -160,14 +160,12 @@ DO JN = 1, NMODE_SLT ZINISIGMA(JN) = XINISIG_SLT(IMODEIDX) ! ZMMIN(IM0(JN)) = XN0MIN_SLT(IMODEIDX) -! ZRGMIN = XCOEFRADMIN * ZINIRADIUS(JN) ZRGMIN = ZINIRADIUS(JN) ZMMIN(IM3(JN)) = XN0MIN_SLT(IMODEIDX) * (ZRGMIN**3)*EXP(4.5 * LOG(ZINISIGMA(JN))**2) ZMMIN(IM6(JN)) = XN0MIN_SLT(IMODEIDX) * (ZRGMIN**6)*EXP(18. * LOG(ZINISIGMA(JN))**2) ENDDO ! ! -!XDENSITY_SALT est fixé dans modd_csts_salt.f90 ZRHOI = XDENSITY_SALT ZMI = XMOLARWEIGHT_SALT ZDEN2MOL = 1E-6 * XAVOGADRO / XMD @@ -182,18 +180,19 @@ DO JN=1,NMODE_SLT !+Marine : (reprendre XN0MIN_SLT de modd_salt.f90). ! Pas plus simple de fixer une dimension à ZN_SALT qui dépend de JN pour ne pas ! avoir à rappeler le schéma d'émission? - IF(NMODE_SLT == 5)THEN - IF (JN == 1) ZN_SALTN = XN0MIN_SLT(JPSALTORDER(JN)) * ZN_SALT - IF (JN == 2) ZN_SALTN = XN0MIN_SLT(JPSALTORDER(JN)) * ZN_SALT - IF (JN == 3) ZN_SALTN = XN0MIN_SLT(JPSALTORDER(JN)) * ZN_SALT - IF (JN == 4) ZN_SALTN = XN0MIN_SLT(JPSALTORDER(JN)) * ZN_SALT - IF (JN == 5) ZN_SALTN = XN0MIN_SLT(JPSALTORDER(JN)) * ZN_SALT - ELSE - IF (JN == 1) ZN_SALTN = XN0MIN_SLT(JPSALTORDER(JN)) * ZN_SALT - IF (JN == 2) ZN_SALTN = XN0MIN_SLT(JPSALTORDER(JN)) * ZN_SALT - IF (JN == 3) ZN_SALTN = XN0MIN_SLT(JPSALTORDER(JN)) * ZN_SALT - END IF + + IF (JN == 1) ZN_SALTN = XN0MIN_SLT(JPSALTORDER(JN)) * ZN_SALT *1E6 + IF (JN == 2) ZN_SALTN = XN0MIN_SLT(JPSALTORDER(JN)) * ZN_SALT *1E6 + IF (JN == 3) ZN_SALTN = XN0MIN_SLT(JPSALTORDER(JN)) * ZN_SALT *1E6 + IF (JN == 4) ZN_SALTN = XN0MIN_SLT(JPSALTORDER(JN)) * ZN_SALT *1E6 + IF (JN == 5) ZN_SALTN = XN0MIN_SLT(JPSALTORDER(JN)) * ZN_SALT *1E6 + IF (JN == 6) ZN_SALTN = XN0MIN_SLT(JPSALTORDER(JN)) * ZN_SALT *1E6 + IF (JN == 7) ZN_SALTN = XN0MIN_SLT(JPSALTORDER(JN)) * ZN_SALT *1E6 + IF (JN == 8) ZN_SALTN = XN0MIN_SLT(JPSALTORDER(JN)) * ZN_SALT *1E6 + + !-Marine + DO JK=1, SIZE(PSV,3) DO JJ=1, SIZE(PSV,2) DO JI=1, SIZE(PSV,1) diff --git a/src/MNH/set_mask.f90 b/src/MNH/set_mask.f90 index 36300b07e..b4077f482 100644 --- a/src/MNH/set_mask.f90 +++ b/src/MNH/set_mask.f90 @@ -1,8 +1,13 @@ -!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier !MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence -!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt +!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt !MNH_LIC for details. version 1. !----------------------------------------------------------------- +!--------------- special set of characters for RCS information +!----------------------------------------------------------------- +! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/set_mask.f90,v $ $Revision: 1.2.2.1.2.1.18.2 $ +! MASDEV4_7 budget 2006/09/08 10:35:15 +!----------------------------------------------------------------- ! ################### SUBROUTINE SET_MASK ! ################### @@ -21,7 +26,7 @@ !! According to each criterion associated to one zone, the mask is !! set to TRUE at each point where the criterion is confirmed, at each !! time step of the model. Finally, The number of occurence of this criteria is -!! increased by 1 and stored in the array NBUSURF. +!! increased by 1 and stored in the array XBUSURF. !! Caution : The mask is defined on the inner domain. !! !! @@ -34,7 +39,7 @@ !! Module MODD_BUDGET !! LBU_MASK : logical array mask defining the zones !! NBUTIME : number of the budget step -!! NBUSURF : mask tracer array (surface array) +!! XBUSURF : mask tracer array (surface array) !! !! REFERENCE !! --------- @@ -60,8 +65,13 @@ ! USE MODD_BUDGET USE MODE_ll -USE MODD_FIELD_n , ONLY : XWT , XRT +USE MODD_FIELD_n, ONLY : XWT, XRT ! +USE MODD_PRECIP_n, ONLY : XINPRR +USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT +USE MODD_REF_n, ONLY : XRHODREF +USE MODD_GRID_n, ONLY : XZZ +USE MODD_CST, ONLY : XRHOLW ! IMPLICIT NONE ! @@ -72,6 +82,15 @@ INTEGER :: IIB,IJB ! Lower bounds of the physical ! sub-domain in x and y directions INTEGER :: IIE,IJE ! Upper bounds of the physical ! sub-domain in x and y directions +! +INTEGER :: IKB, IKE +INTEGER :: IIU, IJU ! Array sizes in i,j directions +! +REAL, DIMENSION(:,:), ALLOCATABLE :: ZTHIC, ZTHRW, ZTHCW, ZTHSN, ZTHGR +REAL, DIMENSION(:,:), ALLOCATABLE :: ZTH_LIQ, ZTH_ICE +REAL, DIMENSION(:,:), ALLOCATABLE :: ZDUM +INTEGER :: JK ! loop index +! !------------------------------------------------------------------------------- ! !* 1. COMPUTES THE PHYSICAL SUBDOMAIN BOUNDS @@ -88,12 +107,65 @@ LBU_MASK(:,:,:)=.FALSE. !============================================================================== ! Change the following lines to set the criterion for each of the NBUMASK masks ! -! 1st mask on vertical velocity at level k=10 -LBU_MASK(IIB:IIE,IJB:IJE,1)=XWT(IIB:IIE,IJB:IJE,10)>0. -! -!2rd mask on rain mixing ratio at level k=2 -IF (NBUMASK>=2) & - LBU_MASK(IIB:IIE,IJB:IJE,2)=XRT(IIB:IIE,IJB:IJE,2,3)>1.E-8 +IKB = 1 + JPVEXT +IKE = SIZE(XRHODREF,3) - JPVEXT +IIU = IIE + JPHEXT +IJU = IJE + JPHEXT +! +ALLOCATE(ZTHIC(IIU,IJU)) ; ZTHIC(:,:) = 0.0 +ALLOCATE(ZTHRW(IIU,IJU)) ; ZTHRW(:,:) = 0.0 +ALLOCATE(ZTHCW(IIU,IJU)) ; ZTHCW(:,:) = 0.0 +ALLOCATE(ZTHSN(IIU,IJU)) ; ZTHSN(:,:) = 0.0 +ALLOCATE(ZTHGR(IIU,IJU)) ; ZTHGR(:,:) = 0.0 +ALLOCATE(ZDUM(IIU,IJU)) ; ZDUM(:,:) = 0.0 +! +DO JK = IKB, IKE + ZDUM(:,:) = XRHODREF(:,:,JK) * (XZZ(:,:,JK+1) - XZZ(:,:,JK)) / XRHOLW + ZTHIC(:,:) = ZTHIC(:,:) + XRT(:,:,JK,4) * ZDUM(:,:) + ZTHRW(:,:) = ZTHRW(:,:) + XRT(:,:,JK,3) * ZDUM(:,:) + ZTHCW(:,:) = ZTHCW(:,:) + XRT(:,:,JK,2) * ZDUM(:,:) + ZTHSN(:,:) = ZTHSN(:,:) + XRT(:,:,JK,5) * ZDUM(:,:) + ZTHGR(:,:) = ZTHGR(:,:) + XRT(:,:,JK,6) * ZDUM(:,:) +END DO +! +! m --> mm +ZTHIC(:,:) = ZTHIC(:,:) * 1000. +ZTHRW(:,:) = ZTHRW(:,:) * 1000. +ZTHCW(:,:) = ZTHCW(:,:) * 1000. +ZTHSN(:,:) = ZTHSN(:,:) * 1000. +ZTHGR(:,:) = ZTHGR(:,:) * 1000. +! +ALLOCATE(ZTH_LIQ(IIU,IJU)) ; ZTH_LIQ(:,:) = 0.0 +ALLOCATE(ZTH_ICE(IIU,IJU)) ; ZTH_ICE(:,:) = 0.0 +! +ZTH_LIQ(:,:) = ZTHCW(:,:) + ZTHRW(:,:) +ZTH_ICE(:,:) = ZTHIC(:,:) + ZTHSN(:,:) + ZTHGR(:,:) +!print*, nbutime, ' - min-max inprr = ', minval(xinprr*3600.), maxval(xinprr*3600.) +!print*, nbutime, ' - min-max zth_liq = ', minval(zth_liq), maxval(zth_liq) +!print*, nbutime, ' - min-max zth_ice = ', minval(zth_ice), maxval(zth_ice) +! +LBU_MASK(IIB:IIE,IJB:IJE,1) = (XINPRR(IIB:IIE,IJB:IJE)*3.6E6) >= 5. +!LBU_MASK(IIB:IIE,IJB:IJE,2) = .NOT.(LBU_MASK(IIB:IIE,IJB:IJE,1)) .AND. & +! (XINPRR(IIB:IIE,IJB:IJE)*3.6E6) >= 0.5 .AND. & +! ZTH_LIQ(IIB:IIE,IJB:IJE) >= 0.01 .AND. & +! ZTH_ICE(IIB:IIE,IJB:IJE) >= 0.1 +LBU_MASK(IIB:IIE,IJB:IJE,2) = .NOT.(LBU_MASK(IIB:IIE,IJB:IJE,1)) .AND. & + ((XINPRR(IIB:IIE,IJB:IJE)*3.6E6) >= 0.5 .OR. & + ZTH_LIQ(IIB:IIE,IJB:IJE) >= 0.01 .AND. & + ZTH_ICE(IIB:IIE,IJB:IJE) >= 0.1) +LBU_MASK(IIB:IIE,IJB:IJE,3) = .NOT.(LBU_MASK(IIB:IIE,IJB:IJE,1)) .AND. & + .NOT.(LBU_MASK(IIB:IIE,IJB:IJE,2)) .AND. & + ZTH_LIQ(IIB:IIE,IJB:IJE) < 0.01 .AND. & + ZTH_ICE(IIB:IIE,IJB:IJE) >= 0.01 +! +DEALLOCATE(ZTHIC) +DEALLOCATE(ZTHRW) +DEALLOCATE(ZTHCW) +DEALLOCATE(ZTHSN) +DEALLOCATE(ZTHGR) +DEALLOCATE(ZTH_LIQ) +DEALLOCATE(ZTH_ICE) +DEALLOCATE(ZDUM) ! !============================================================================== ! @@ -101,7 +173,7 @@ IF (NBUMASK>=2) & ! ------------------------- ! WHERE (LBU_MASK(:,:,:)) - NBUSURF(:,:,:,NBUTIME) = NBUSURF(:,:,:,NBUTIME) + 1 + NBUSURF(:,:,:,NBUTIME)=NBUSURF(:,:,:,NBUTIME)+1 END WHERE ! !------------------------------------------------------------------------------- diff --git a/src/MNH/ver_prep_netcdf_case.f90 b/src/MNH/ver_prep_netcdf_case.f90 index c17a1c963..9cc6fab58 100644 --- a/src/MNH/ver_prep_netcdf_case.f90 +++ b/src/MNH/ver_prep_netcdf_case.f90 @@ -7,15 +7,16 @@ MODULE MODI_VER_PREP_NETCDF_CASE ! ################################ INTERFACE - SUBROUTINE VER_PREP_NETCDF_CASE(PDIAG) + SUBROUTINE VER_PREP_NETCDF_CASE(PDIAG, PSV_LS) ! -REAL, INTENT(OUT) :: PDIAG ! diagnostics computing time +REAL, INTENT(OUT) :: PDIAG ! diagnostics computing time +REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSV_LS ! sv var. ! END SUBROUTINE VER_PREP_NETCDF_CASE END INTERFACE END MODULE MODI_VER_PREP_NETCDF_CASE ! #################################################################### - SUBROUTINE VER_PREP_NETCDF_CASE(PDIAG) + SUBROUTINE VER_PREP_NETCDF_CASE(PDIAG, PSV_LS) ! #################################################################### ! !!**** *VER_PREP_NETCDF_CASE* - monitors the preparation to orographic change @@ -85,6 +86,8 @@ END MODULE MODI_VER_PREP_NETCDF_CASE !! Oct 2017 (J.Escobar) minor, missing USE MODI_SECOND_MNH !! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O !! Mars 2019 (Q. Rodier): missing SECOND_MNH(ZTIME1) +!! Fevruary 2021 (M. Leriche) : XSV_LS in argument to avoid +!! duplicate the routine !------------------------------------------------------------------------------- ! !* 0. DECLARATIONS @@ -112,7 +115,8 @@ IMPLICIT NONE !* 0.1 Declaration of arguments ! ------------------------ ! -REAL, INTENT(OUT) :: PDIAG ! diagnostics computing time +REAL, INTENT(OUT) :: PDIAG ! diagnostics computing time +REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSV_LS ! sv var. ! !* 0.2 Declaration of local variables ! ------------------------------ @@ -167,7 +171,7 @@ CALL SECOND_MNH(ZTIME1) ! vertical interpolation programs with all ILU physical points ! ALLOCATE(ZZMASS_LS(IIU,IJU,ILU+2*JPVEXT)) -ALLOCATE(ZSV_LS(IIU,IJU,ILU+2*JPVEXT,SIZE(XSV_LS,4))) +ALLOCATE(ZSV_LS(IIU,IJU,ILU+2*JPVEXT,SIZE(PSV_LS,4))) ! ZZMASS_LS (:,:,JPVEXT+1:JPVEXT+ILU) = XZMASS_SV_LS(:,:,:) DO JK=1,JPVEXT @@ -178,8 +182,8 @@ END DO !ZSV_LS = XUNDEF ZSV_LS = -999. ! -DO JSV=1,SIZE(XSV_LS,4) - ZSV_LS (:,:,JPVEXT+1:JPVEXT+ILU,JSV) = XSV_LS (:,:,:,JSV) +DO JSV=1,SIZE(PSV_LS,4) + ZSV_LS (:,:,JPVEXT+1:JPVEXT+ILU,JSV) = PSV_LS (:,:,:,JSV) END DO ! CALL VER_INTERP_TO_MIXED_GRID('CHEM',.TRUE.,XZS_SV_LS,XZS_SV_LS,& @@ -209,7 +213,6 @@ PDIAG = ZTIME2 - ZTIME1 DEALLOCATE(XTHV_SV_LS) DEALLOCATE(XR_SV_LS) DEALLOCATE(XHU_SV_LS) - DEALLOCATE(XSV_LS) ! ! !------------------------------------------------------------------------------- diff --git a/src/MNH/write_lbn.f90 b/src/MNH/write_lbn.f90 index dc3fd036f..b06f5bc8e 100644 --- a/src/MNH/write_lbn.f90 +++ b/src/MNH/write_lbn.f90 @@ -381,7 +381,7 @@ IF (NSV >=1) THEN DO JSV = NSV_LIMA_CCN_FREE,NSV_LIMA_CCN_FREE+NMOD_CCN-1 WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_CCN_FREE + 1) IF(NSIZELBXSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CLIMA_WARM_NAMES(3))//INDICE) + TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CLIMA_WARM_NAMES(3)))//INDICE TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) TZFIELD%CLBTYPE = 'LBX' WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV @@ -389,7 +389,7 @@ IF (NSV >=1) THEN END IF ! IF(NSIZELBYSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CLIMA_WARM_NAMES(3))//INDICE) + TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CLIMA_WARM_NAMES(3)))//INDICE TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) TZFIELD%CLBTYPE = 'LBY' WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV @@ -400,7 +400,7 @@ IF (NSV >=1) THEN DO JSV = NSV_LIMA_IFN_FREE,NSV_LIMA_IFN_FREE+NMOD_IFN-1 WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_IFN_FREE + 1) IF(NSIZELBXSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CLIMA_COLD_NAMES(2))//INDICE) + TZFIELD%CMNHNAME = 'LBX_'//TRIM(UPCASE(CLIMA_COLD_NAMES(2)))//INDICE TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) TZFIELD%CLBTYPE = 'LBX' WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV @@ -408,7 +408,7 @@ IF (NSV >=1) THEN END IF ! IF(NSIZELBYSV_ll /= 0) THEN - TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CLIMA_COLD_NAMES(2))//INDICE) + TZFIELD%CMNHNAME = 'LBY_'//TRIM(UPCASE(CLIMA_COLD_NAMES(2)))//INDICE TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME) TZFIELD%CLBTYPE = 'LBY' WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV @@ -597,7 +597,7 @@ IF (NSV >=1) THEN XLBXSVM(:,:,:,NSV_DSTDEPBEG:NSV_DSTDEPEND) = MAX(XLBXSVM(:,:,:,NSV_DSTDEPBEG:NSV_DSTDEPEND), 0.) IF (LDEPOS_DST(IMI).AND.(NSIZELBYSV_ll /= 0)) & XLBYSVM(:,:,:,NSV_DSTDEPBEG:NSV_DSTDEPEND) = MAX(XLBYSVM(:,:,:,NSV_DSTDEPBEG:NSV_DSTDEPEND), 0.) - IF ((LDSTINIT).OR.(LDSTPRES)) THEN ! GRIBEX case (dust initialization) + IF ((LDSTINIT).AND.(.NOT.LDSTCAMS)) THEN ! GRIBEX case (dust initialization) IF ((NSIZELBXSV_ll /= 0).AND.(CPROGRAM == 'REAL ').AND.(NSV_DST > 1)) THEN CALL DUSTLFI_n(XLBXSVM(:,:,:,NSV_DSTBEG:NSV_DSTEND), ZRHODREFX) END IF @@ -684,7 +684,7 @@ IF (NSV >=1) THEN XLBXSVM(:,:,:,NSV_SLTDEPBEG:NSV_SLTDEPEND) = MAX(XLBXSVM(:,:,:,NSV_SLTDEPBEG:NSV_SLTDEPEND), 0.) IF (LDEPOS_SLT(IMI).AND.(NSIZELBYSV_ll /= 0)) & XLBYSVM(:,:,:,NSV_SLTDEPBEG:NSV_SLTDEPEND) = MAX(XLBYSVM(:,:,:,NSV_SLTDEPBEG:NSV_SLTDEPEND), 0.) - IF ((LSLTINIT).OR.(LSLTPRES)) THEN ! GRIBEX case (dust initialization) + IF ((LSLTINIT).AND.(.NOT.LSLTCAMS)) THEN ! GRIBEX case (dust initialization) IF ((NSIZELBXSV_ll /= 0).AND.(CPROGRAM == 'REAL ').AND.(NSV_SLT > 1)) THEN CALL SALTLFI_n(XLBXSVM(:,:,:,NSV_SLTBEG:NSV_SLTEND), ZRHODREFX, ZLBXZZ) END IF diff --git a/src/MNH/write_lfifm1_for_diag.f90 b/src/MNH/write_lfifm1_for_diag.f90 index 60240e9ca..54c450494 100644 --- a/src/MNH/write_lfifm1_for_diag.f90 +++ b/src/MNH/write_lfifm1_for_diag.f90 @@ -1904,13 +1904,13 @@ IF ((LCHEMDIAG).AND.(LORILAM).AND.(LUSECHEM)) THEN CALL PPP2AERO(XSVT(:,:,:,NSV_AERBEG:NSV_AEREND), XRHODREF, & PSIG3D=XSIG3D, PRG3D=XRG3D, PN3D=XN3D, PCTOTA=ZPTOTA) DO JJ=1,JPMODE - TZFIELD%CMNHNAME = 'RGA' + WRITE(TZFIELD%CMNHNAME,'(A3,I1)')'RGA',JJ TZFIELD%CLONGNAME = 'RGA' TZFIELD%CUNITS = 'um' WRITE(TZFIELD%CCOMMENT,'(A21,I1)')'RG (nb) AEROSOL MODE ',JJ CALL IO_Field_write(TPFILE,TZFIELD,XRG3D(:,:,:,JJ)) ! - TZFIELD%CMNHNAME = 'RGAM' + WRITE(TZFIELD%CMNHNAME,'(A4,I1)')'RGAM',JJ TZFIELD%CLONGNAME = 'RGAM' TZFIELD%CUNITS = 'um' WRITE(TZFIELD%CCOMMENT,'(A20,I1)')'RG (m) AEROSOL MODE ',JJ diff --git a/src/MNH/write_lfin.f90 b/src/MNH/write_lfin.f90 index ea08bd41d..36d37ac65 100644 --- a/src/MNH/write_lfin.f90 +++ b/src/MNH/write_lfin.f90 @@ -238,6 +238,8 @@ USE MODD_FOREFIRE #endif USE MODD_CONDSAMP USE MODD_CH_AEROSOL +USE MODD_CH_AERO_n +USE MODE_AERO_PSD USE MODD_BLOWSNOW USE MODD_BLOWSNOW_n USE MODD_PAST_FIELD_n @@ -1368,6 +1370,15 @@ IF (NSV >=1) THEN IF (JSV==NSV_AEREND) WRITE(ILUOUT,*)'MNHC: write_lfin:NSV_AEREND ',JSV YCHNAMES(JSV-JSA)= TZFIELD%CMNHNAME(1:LEN_TRIM(TZFIELD%CMNHNAME)-1) END DO + IF (.NOT.(ASSOCIATED(XN3D))) & + ALLOCATE(XN3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE)) + IF (.NOT.(ASSOCIATED(XRG3D))) & + ALLOCATE(XRG3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE)) + IF (.NOT.(ASSOCIATED(XSIG3D))) & + ALLOCATE(XSIG3D(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPMODE)) + CALL PPP2AERO(XSVT(:,:,:,NSV_AERBEG:NSV_AEREND), XRHODREF, & + PSIG3D=XSIG3D, PRG3D=XRG3D, PN3D=XN3D) + END IF IF (LDEPOS_AER(IMI)) THEN TZFIELD%CSTDNAME = '' @@ -1391,7 +1402,9 @@ IF (NSV >=1) THEN END IF ! dust scalar variables IF (LDUST) THEN - IF ((CPROGRAM == 'REAL ').AND.(NSV_DST > 1).AND.(IMI==1).AND.(LDSTINIT)) & +! IF ((CPROGRAM == 'REAL ').AND.(NSV_DST > 1).AND.(IMI==1).AND.(LDSTINIT)) & + IF ((CPROGRAM == 'REAL ').AND.(NSV_DST > 1).AND.(IMI==1).AND.(LDSTINIT).AND.(.NOT.LDSTCAMS)) & +!UPG*PT CALL DUSTLFI_n(XSVT(:,:,:,NSV_DSTBEG:NSV_DSTEND), XRHODREF) IF ((CPROGRAM == 'IDEAL ').AND.(NSV_DST > 1).AND.(IMI==1)) & CALL DUSTLFI_n(XSVT(:,:,:,NSV_DSTBEG:NSV_DSTEND), XRHODREF) @@ -1438,7 +1451,10 @@ IF (NSV >=1) THEN ENDIF ! sea salt scalar variables IF (LSALT) THEN - IF ((CPROGRAM == 'REAL ').AND.(NSV_SLT > 1).AND.(IMI==1).AND.(LSLTINIT)) & +!UPG*PT +! IF ((CPROGRAM == 'REAL ').AND.(NSV_SLT > 1).AND.(IMI==1).AND.(LSLTINIT)) & + IF ((CPROGRAM == 'REAL ').AND.(NSV_SLT > 1).AND.(IMI==1).AND.(LSLTINIT).AND.(.NOT.LSLTCAMS)) & +!UPG*PT CALL SALTLFI_n(XSVT(:,:,:,NSV_SLTBEG:NSV_SLTEND), XRHODREF, XZZ) IF ((CPROGRAM == 'IDEAL ').AND.(NSV_SLT > 1).AND.(IMI==1)) & CALL SALTLFI_n(XSVT(:,:,:,NSV_SLTBEG:NSV_SLTEND), XRHODREF, XZZ) diff --git a/src/SURFEX/allocate_physio.F90 b/src/SURFEX/allocate_physio.F90 index 745a7d007..371a45d76 100644 --- a/src/SURFEX/allocate_physio.F90 +++ b/src/SURFEX/allocate_physio.F90 @@ -33,7 +33,6 @@ !! ------------- !! Original xx/xxxx !! Modified 10/2014 P. Samuelsson MEB -!! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree ! ! USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t @@ -78,6 +77,7 @@ ALLOCATE(PK%XDG (ISIZE,IO%NGROUND_LAYER)) ALLOCATE(PK%XD_ICE (ISIZE )) ! ALLOCATE(PEK%XLAI (ISIZE )) +ALLOCATE(PEK%XLAIp (ISIZE )) ALLOCATE(PEK%XVEG (ISIZE )) ALLOCATE(PEK%XZ0 (ISIZE )) ALLOCATE(PEK%XEMIS (ISIZE )) @@ -100,7 +100,11 @@ ELSE ENDIF ! - vegetation: Ags parameters ('AGS', 'LAI', 'AST', 'LST', 'NIT' options) ! -ALLOCATE(PK%XH_TREE (ISIZE )) +IF (IO%CPHOTO/='NON'.OR.LTREEDRAG) THEN + ALLOCATE(PK%XH_TREE (ISIZE )) +ELSE + ALLOCATE(PK%XH_TREE (0 )) +ENDIF ! IF (IO%CPHOTO/='NON') THEN ALLOCATE(PK%XRE25 (ISIZE )) diff --git a/src/SURFEX/allocate_teb_veg_pgd.F90 b/src/SURFEX/allocate_teb_veg_pgd.F90 index 8c56e3e0c..32bbfd37d 100644 --- a/src/SURFEX/allocate_teb_veg_pgd.F90 +++ b/src/SURFEX/allocate_teb_veg_pgd.F90 @@ -34,6 +34,7 @@ IF (LHOOK) CALL DR_HOOK('ALLOCATE_TEB_VEG_PGD',0,ZHOOK_HANDLE) ! - Physiographic field that can evolve prognostically ! ALLOCATE(PEK%XLAI (KLU)) +ALLOCATE(PEK%XLAIp (KLU)) ALLOCATE(PEK%XVEG (KLU)) ALLOCATE(PEK%XEMIS (KLU)) ALLOCATE(PEK%XZ0 (KLU)) diff --git a/src/SURFEX/compute_isba_parameters.F90 b/src/SURFEX/compute_isba_parameters.F90 index 39fb20dde..f0a61e85b 100644 --- a/src/SURFEX/compute_isba_parameters.F90 +++ b/src/SURFEX/compute_isba_parameters.F90 @@ -518,6 +518,7 @@ IF (KSV /= 0) THEN DO JP = 1,IO%NPATCH ! DSTK => NDST%AL(JP) + PK => NP%AL(JP) ! IF (CHI%SVI%NDSTEQ >=1) THEN ! diff --git a/src/SURFEX/convert_patch_isba.F90 b/src/SURFEX/convert_patch_isba.F90 index b04278c20..a70257224 100644 --- a/src/SURFEX/convert_patch_isba.F90 +++ b/src/SURFEX/convert_patch_isba.F90 @@ -215,6 +215,16 @@ IF (OFIX) THEN CALL AV_PGD_1P(DTCO, PK%XZ0_O_Z0H,PCOVER,XDATA_Z0_O_Z0H,YNAT,'ARI',OCOVER,& PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) ENDIF +! + IF (IO%CPHOTO/='NON'.OR.LTREEDRAG) THEN + IF (GDATA .AND. ANY(DTV%LDATA_H_TREE)) THEN + CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & + PK%XH_TREE,DTV%XPAR_VEGTYPE,DTV%XPAR_H_TREE,YTREE,'ARI',PK%NR_P,IO%NPATCH,KPATCH) + ELSE + CALL AV_PGD_1P(DTCO, PK%XH_TREE,PCOVER,XDATA_H_TREE(:,:),YTREE,'ARI',OCOVER,& + PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC) + ENDIF + ENDIF ! IF (GDATA .AND. ANY(DTV%LDATA_H_TREE)) THEN CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, & diff --git a/src/SURFEX/coupling_isban.F90 b/src/SURFEX/coupling_isban.F90 index 45e5eea8f..044da5c75 100644 --- a/src/SURFEX/coupling_isban.F90 +++ b/src/SURFEX/coupling_isban.F90 @@ -11,7 +11,7 @@ SUBROUTINE COUPLING_ISBA_n (DTCO, UG, U, USS, NAG, CHI, NCHI, MGN, MSF, DTI, ID PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, & PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, & PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, PPEW_B_COEF, & - PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, HTEST ) + PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, HTEST ) ! ############################################################################### ! !!**** *COUPLING_ISBA_n * - Driver for ISBA time step @@ -257,7 +257,8 @@ REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF - CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK' +CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK' + ! ! !* 0.2 declarations of local variables @@ -567,6 +568,22 @@ ENDIF ZSFCO2_TILE, ZSFU_TILE, ZSFV_TILE, PSFTH, PSFTQ,& PSFTS, PSFCO2, PSFU, PSFV ) ! +! Get output megan flux if megan is activated + + +IF (CHI%SVI%NBEQ>0 .AND. CHI%LCH_BIO_FLUX) THEN + IF (TRIM(CHI%CPARAMBVOC) == 'MEGAN') THEN + ! Get output Isoprene flux + DO II=1,SIZE(MGN%XBIOFLX,1) + IF ((S%XPATCH(II,1) + S%XPATCH(II,2) + S%XPATCH(II,3)) .LT. 1.) THEN + MGN%XBIOFLX(II) = PSFTS(II,MGN%NBIO)/(1. - S%XPATCH(II,1) - S%XPATCH(II,2) - S%XPATCH(II,3)) + ELSE + MGN%XBIOFLX(:) = PSFTS(:,MGN%NBIO) + ENDIF + ENDDO + ENDIF +ENDIF + ! !------------------------------------------------------------------------------- !Physical properties see by the atmosphere in order to close the energy budget @@ -705,7 +722,8 @@ REAL, DIMENSION(PK%NSIZE_P) :: ZP_TRAD ! radiative temperature REAL, DIMENSION(PK%NSIZE_P) :: ZP_TSURF ! surface effective temperature (K) REAL, DIMENSION(PK%NSIZE_P) :: ZP_Z0 ! roughness length for momentum (m) REAL, DIMENSION(PK%NSIZE_P) :: ZP_Z0H ! roughness length for heat (m) -REAL, DIMENSION(PK%NSIZE_P) :: ZP_QSURF ! specific humidity at surface (kg/kg) +REAL, DIMENSION(PK%NSIZE_P):: ZP_QSURF ! specific humidity at surface (kg/kg) +REAL, DIMENSION(PK%NSIZE_P) :: ZP_TEMP, ZP_PAR ! !* other forcing variables (packed for each patch) ! @@ -730,6 +748,7 @@ REAL, DIMENSION(PK%NSIZE_P) :: ZP_FFVNOS !Floodplain fraction over vegetation ! REAL, DIMENSION(:,:),ALLOCATABLE :: ZP_PFT REAL, DIMENSION(:,:),ALLOCATABLE :: ZP_EF +REAL, DIMENSION(:), ALLOCATABLE :: ZP_T24, ZP_PFD24 INTEGER, DIMENSION(PK%NSIZE_P) :: IP_SLTYP ! REAL, DIMENSION(PK%NSIZE_P,IO%NNBIOMASS) :: ZP_RESP_BIOMASS_INST ! instantaneous biomass respiration (kgCO2/kgair m/s) @@ -787,6 +806,16 @@ IF (ASSOCIATED(MGN%XEF)) THEN ELSE ALLOCATE(ZP_EF(0,0)) ENDIF +IF (ASSOCIATED(MGN%XPPFD24)) THEN + ALLOCATE(ZP_PFD24(PK%NSIZE_P)) +ELSE + ALLOCATE(ZP_PFD24(0)) +ENDIF +IF (ASSOCIATED(MGN%XT24)) THEN + ALLOCATE(ZP_T24(PK%NSIZE_P)) +ELSE + ALLOCATE(ZP_T24(0)) +ENDIF !-------------------------------------------------------------------------------------- ! ! Pack isba forcing outputs @@ -827,7 +856,10 @@ IF (IO%NPATCH==1) THEN ZP_PFT(:,:) = MGN%XPFT (:,:) ZP_EF(:,:) = MGN%XEF (:,:) IP_SLTYP(:) = MGN%NSLTYP (:) + ZP_PFD24(:) = MGN%XPPFD24 (:) + ZP_T24(:) = MGN%XT24 (:) END IF + ZP_RNSHADE(:) = ZRNSHADE (:) ZP_RNSUNLIT(:) = ZRNSUNLIT (:) @@ -890,6 +922,8 @@ ELSE ZP_PFT(:,JJ) = MGN%XPFT (:,JI) ZP_EF(:,JJ) = MGN%XEF (:,JI) IP_SLTYP(JJ) = MGN%NSLTYP (JI) + ZP_PFD24(JJ) = MGN%XPPFD24 (JI) + ZP_T24(JJ) = MGN%XT24 (JI) ENDDO END IF DO JJ=1,PK%NSIZE_P @@ -1160,12 +1194,14 @@ IF (CHI%SVI%NBEQ>0 .AND. CHI%LCH_BIO_FLUX) THEN GBK%XIACAN = 0. END WHERE !UPG*PT + IBEG = CHI%SVI%NSV_CHSBEG + IEND = CHI%SVI%NSV_CHSEND - CALL COUPLING_MEGAN_n(MGN, CHI, GK, PEK, & - KYEAR, KMONTH, KDAY, PTIME, IO%LTR_ML, & - IP_SLTYP, ZP_PFT, ZP_EF, & + CALL COUPLING_MEGAN_n(MGN, CHI, GK, PEK, PTSTEP, & + KYEAR, KMONTH, KDAY, PTIME, S%TTIME%TIME, IO%LTR_ML, & + IP_SLTYP, ZP_PFT, ZP_EF, ZP_PFD24, ZP_T24, & ZP_TA, GBK%XIACAN, ZP_TRAD, ZP_RNSUNLIT, ZP_RNSHADE, & - ZP_WIND, ZP_PA, ZP_QA, ZP_SFTS) + ZP_WIND, ZP_PA, ZP_QA, ZP_SFTS(:,IBEG:IEND)) END IF ENDIF @@ -1393,7 +1429,7 @@ IF (CHI%SVI%NDSTEQ>0) THEN IF (IMOMENT == 1) THEN DSTK%XSFDST(:,JSV) = ZSFTS_TILE(:,NDST_MDEBEG+JSV-1,JP) ELSE - DSTK%XSFDST(:,JSV) = ZSFTS_TILE(:,NDST_MDEBEG+(JSV-1)*IMOMENT+1,JP) + DSTK%XSFDST(:,JSV) = ZSFTS_TILE(PK%NR_P,NDST_MDEBEG+(JSV-1)*IMOMENT+1,JP) END IF DSTK%XSFDSTM(:,JSV) = DSTK%XSFDSTM(:,JSV) + DSTK%XSFDST(:,JSV) * PTSTEP diff --git a/src/SURFEX/coupling_megann.F90 b/src/SURFEX/coupling_megann.F90 index 88bb6fd8a..11b5991bb 100644 --- a/src/SURFEX/coupling_megann.F90 +++ b/src/SURFEX/coupling_megann.F90 @@ -3,9 +3,9 @@ !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt !SFX_LIC for details. version 1. ! ############################### - SUBROUTINE COUPLING_MEGAN_n(MGN, CHI, GK, PEK, & - KYEAR, KMONTH, KDAY, PTIME, OTR_ML, & - KSLTYP, PPFT, PEF, & + SUBROUTINE COUPLING_MEGAN_n(MGN, CHI, GK, PEK, PTSTEP, & + KYEAR, KMONTH, KDAY, PTIME, PTIME2, OTR_ML, & + KSLTYP, PPFT, PEF, PPFD24, PT24, & PTEMP, PIACAN, PLEAFT, PRN_SUNLIT, PRN_SHADE, & PWIND, PPRES, PQV, PSFTS) ! ############################### @@ -30,6 +30,7 @@ !! Original: 25/10/2014 !! Modified: 06/07/2017, J. Pianezze, adaptation for SurfEx v8.0 !! Modified: 06/07/2018, P. Tulet, correction for T leaf +!! Modified: 06/02/2021, S. Oumami, off-line & daily averages use !! !! EXTERNAL !! -------- @@ -42,7 +43,7 @@ USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t USE MODD_ISBA_n, ONLY: ISBA_PE_t USE MODD_SFX_GRID_n, ONLY: GRID_t ! -USE MODD_CSTS, ONLY : XAVOGADRO +USE MODD_CSTS, ONLY : XAVOGADRO, XDAY ! #ifdef MNH_MEGAN USE MODD_MEGAN @@ -69,19 +70,23 @@ INTEGER, INTENT(IN) :: KYEAR ! I current year (UTC) INTEGER, INTENT(IN) :: KMONTH ! I current month (UTC) INTEGER, INTENT(IN) :: KDAY ! I current day (UTC) REAL, INTENT(IN) :: PTIME ! I current time since midnight (UTC, s) +REAL, INTENT(IN) :: PTIME2 ! Time since simulation begin (s) LOGICAL, INTENT(IN) :: OTR_ML ! new radiation for leaves temperatures +REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step (s) ! REAL, DIMENSION(:), INTENT(IN) :: PTEMP ! I Air temperature (K) -REAL, DIMENSION(:,:),INTENT(IN) :: PIACAN ! I PAR (umol/m2.s) +REAL, DIMENSION(:,:),INTENT(IN) :: PIACAN ! I PAR (W/m2) REAL, DIMENSION(:), INTENT(IN) :: PLEAFT ! I Leaf temperature (K) REAL, DIMENSION(:), INTENT(IN) :: PRN_SUNLIT! I Leaf RN REAL, DIMENSION(:), INTENT(IN) :: PRN_SHADE ! I Leaf RN +REAL, DIMENSION(:), INTENT(INOUT) :: PPFD24 +REAL, DIMENSION(:), INTENT(INOUT) :: PT24 REAL, DIMENSION(:), INTENT(IN) :: PWIND REAL, DIMENSION(:), INTENT(IN) :: PPRES ! I Atmospheric pressure (Pa) REAL, DIMENSION(:), INTENT(IN) :: PQV ! I Air humidity (kg/kg) -REAL, DIMENSION(:,:),INTENT(IN) :: PPFT, PEF -INTEGER, DIMENSION(:), INTENT(IN) :: KSLTYP -REAL, DIMENSION(:,:), INTENT(INOUT) :: PSFTS ! O Scalar flux in molecules/m2/s +REAL, DIMENSION(:,:),INTENT(IN) :: PPFT, PEF +INTEGER, DIMENSION(:), INTENT(IN) :: KSLTYP +REAL, DIMENSION(:,:),INTENT(INOUT) :: PSFTS ! O Scalar flux in molecules/m2/s #ifdef MNH_MEGAN !* 0.1 Declaration of local variables ! @@ -99,14 +104,17 @@ REAL, DIMENSION(SIZE(PTEMP)) :: ZCFNO ! NO correction factor REAL, DIMENSION(SIZE(PTEMP)) :: ZCFNOG ! NO correction factor for grass REAL, DIMENSION(N_MGN_SPC,SIZE(PTEMP)) :: ZCFSPEC ! Output emission buffer REAL, DIMENSION(MGN%NVARS3D,SIZE(PTEMP)) :: ZFLUX ! Output emission megan flux +REAL, DIMENSION(SIZE(PTEMP)) :: ZD_TEMP, ZTSUM ! Daily temperature (K) and daily sum temperature + ! REAL :: ZDI ! Drought Index (0 normal, -2 moderate drought, -3 severe drought, -4 extreme drought) REAL :: ZREC_ADJ ! Rain adjustment factor -REAL :: ZD_TEMP ! Daily temperature (K) -REAL :: ZD_PPFD ! Daily PAR (umol/m2.s) ! INTEGER,DIMENSION(SIZE(PTEMP)) :: ISLTYP !Soil category (function of silt, clay and sand)) INTEGER :: JSV, JSM +INTEGER, SAVE :: ICOUNTNEW, ICOUNT, INB_COUNT +LOGICAL, SAVE :: GFIRSTCALL = .TRUE. + ! ! Input parameters ZHOUR = FLOAT(INT(PTIME/3600.)) @@ -121,19 +129,23 @@ ZLAIC(:) = MIN(MAX(0.001,PEK%XLAI(:)),8.) ! ZDI = MGN%XDROUGHT ZREC_ADJ = MGN%XMODPREC -ZD_TEMP = MGN%XDAILYTEMP -ZD_PPFD = MGN%XDAILYPAR -! ZCFNO = 0. ZCFNOG = 0. ZCFSPEC = 0. -! + +! Compute PAR from the entire canopy and conversion W/m2 in micromol/m²/s ZPFD(:) = 0. -! Compute PAR from the entire canopy DO JSM = 1,SIZE(PIACAN,2) - ZPFD(:) = ZPFD(:) + PIACAN(:, JSM) + ZPFD(:) = ZPFD(:) + PIACAN(:, JSM) * 4.6 END DO -! + + +!INB_COUNT=INB_COUNT+1 +!ICOUNTNEW = INT(INB_COUNT*PTSTEP/XDAY) + +PT24(:) = PT24(:)*XDAY / (XDAY + PTSTEP) + PTEMP(:)* PTSTEP / (XDAY + PTSTEP) +PPFD24(:) = PPFD24(:)*XDAY / (XDAY + PTSTEP) + ZPFD(:)*PTSTEP / (XDAY + PTSTEP) + ! UPG*PT en attendat un calcul propre. Temperature des feuilles à l'ombre egale a la ! température de l'air. La temparature des feuilles au soleil egale a la valeur ! max entre la temperature de l'air et la temperaure radiative. @@ -167,7 +179,8 @@ ZLSHT(:) = PTEMP(:) ! 19: STRESS ! 20: OTHER ! -CALL EMPROC(ITIME, IDATE, ZD_PPFD, ZD_TEMP, ZDI, ZREC_ADJ, & + +CALL EMPROC(ITIME, IDATE, PPFD24, PT24, ZDI, ZREC_ADJ, & GK%XLAT, GK%XLON, ZLAIC, ZLAIC, PTEMP, & ZPFD, PWIND, PPRES, PQV, KSLTYP, & PEK%XWG(:,1), PEK%XTG(:,1), PPFT, & diff --git a/src/SURFEX/coupling_seaflux_orogn.F90 b/src/SURFEX/coupling_seaflux_orogn.F90 index 5d222e848..5a2bbe3b4 100644 --- a/src/SURFEX/coupling_seaflux_orogn.F90 +++ b/src/SURFEX/coupling_seaflux_orogn.F90 @@ -42,10 +42,11 @@ SUBROUTINE COUPLING_SEAFLUX_OROG_n (SM, DST, SLT, HPROGRAM, HCOUPLING, PTIMEC, P !!------------------------------------------------------------- ! ! -USE MODD_SURFEX_n, ONLY : SEAFLUX_MODEL_t +USE MODD_SURFEX_n, ONLY : SEAFLUX_MODEL_t, SURFEX_t ! USE MODD_DST_n, ONLY : DST_t USE MODD_SLT_n, ONLY : SLT_t +USE MODD_DMS_n, ONLY : DMS_t ! ! USE MODD_SURF_PAR, ONLY : XUNDEF @@ -198,7 +199,7 @@ ELSE ENDIF ! CALL COUPLING_SEAFLUX_SBL_n(SM%CHS, SM%DTS, SM%SD, SM%O, SM%OR, SM%G, SM%S, SM%SB, & - DST, SLT, HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, & + DST, SLT, SM%DMS, HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, & KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, & PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PU, PV, & ZQA, ZTA, ZRHOA, PSV, PCO2, HSV, ZRAIN, ZSNOW, ZLW, & diff --git a/src/SURFEX/coupling_seaflux_sbln.F90 b/src/SURFEX/coupling_seaflux_sbln.F90 index 53aa72d42..2d4148ff3 100644 --- a/src/SURFEX/coupling_seaflux_sbln.F90 +++ b/src/SURFEX/coupling_seaflux_sbln.F90 @@ -3,7 +3,7 @@ !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt !SFX_LIC for details. version 1. ! ############################################################################### -SUBROUTINE COUPLING_SEAFLUX_SBL_n (CHS, DTS, DGS, O, OR, G, S, SB, DST, SLT, & +SUBROUTINE COUPLING_SEAFLUX_SBL_n (CHS, DTS, DGS, O, OR, G, S, SB, DST, SLT, DMS, & HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, & KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, & PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, & @@ -53,6 +53,7 @@ USE MODD_CANOPY_n, ONLY : CANOPY_t ! USE MODD_DST_n, ONLY : DST_t USE MODD_SLT_n, ONLY : SLT_t +USE MODD_DMS_n, ONLY : DMS_t ! USE MODD_SURF_PAR, ONLY : XUNDEF USE MODD_CSTS, ONLY : XCPD @@ -84,6 +85,7 @@ TYPE(SEAFLUX_t), INTENT(INOUT) :: S TYPE(CANOPY_t), INTENT(INOUT) :: SB TYPE(DST_t), INTENT(INOUT) :: DST TYPE(SLT_t), INTENT(INOUT) :: SLT +TYPE(DMS_t), INTENT(INOUT) :: DMS ! CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes CHARACTER(LEN=1), INTENT(IN) :: HCOUPLING ! type of coupling @@ -298,7 +300,7 @@ END IF !* 2. Call of SEAFLUX ! ------------ ! - CALL COUPLING_SEAFLUX_n(CHS, DTS, DGS, O, OR, G, S, DST, SLT, HPROGRAM, GCOUPLING, & + CALL COUPLING_SEAFLUX_n(CHS, DTS, DGS, O, OR, G, S, DST, SLT, DMS, HPROGRAM, GCOUPLING, & PTIMEC, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, & PTSUN, PZENITH, PZENITH2, PAZIM, ZZREF, ZUREF, ZU, ZV, ZQA, ZTA, PRHOA, & PSV, PCO2, HSV, PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, ZPA,& diff --git a/src/SURFEX/coupling_seafluxn.F90 b/src/SURFEX/coupling_seafluxn.F90 index 612b8df12..ff9a36c6a 100644 --- a/src/SURFEX/coupling_seafluxn.F90 +++ b/src/SURFEX/coupling_seafluxn.F90 @@ -3,7 +3,7 @@ !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt !SFX_LIC for details. version 1. ! ############################################################################### -SUBROUTINE COUPLING_SEAFLUX_n (CHS, DTS, DGS, O, OR, G, S, DST, SLT, & +SUBROUTINE COUPLING_SEAFLUX_n (CHS, DTS, DGS, O, OR, G, S, DST, SLT, DMS, & HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, & KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, & PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, & @@ -65,10 +65,11 @@ USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t ! USE MODD_DST_n, ONLY : DST_t USE MODD_SLT_n, ONLY : SLT_t +USE MODD_DMS_n, ONLY : DMS_t ! USE MODD_REPROD_OPER, ONLY : CIMPLICIT_WIND ! -USE MODD_CSTS, ONLY : XRD, XCPD, XP00, XTT, XTTS, XTTSI, XDAY +USE MODD_CSTS, ONLY : XRD, XCPD, XP00, XTT, XTTS, XTTSI, XDAY, XAVOGADRO USE MODD_SURF_PAR, ONLY : XUNDEF USE MODD_SFX_OASIS, ONLY : LCPL_WAVE, LCPL_SEA, LCPL_SEAICE USE MODD_WATER_PAR, ONLY : XEMISWAT, XEMISWATICE @@ -125,6 +126,7 @@ TYPE(GRID_t), INTENT(INOUT) :: G TYPE(SEAFLUX_t), INTENT(INOUT) :: S TYPE(DST_t), INTENT(INOUT) :: DST TYPE(SLT_t), INTENT(INOUT) :: SLT +TYPE(DMS_t), INTENT(INOUT) :: DMS ! CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes CHARACTER(LEN=1), INTENT(IN) :: HCOUPLING ! type of coupling @@ -245,6 +247,8 @@ REAL, DIMENSION(KI) :: ZTP ! peak period ! REAL, DIMENSION(KI) :: ZSST ! XSST corrected for anomalously low values (which actually are sea-ice temp) REAL, DIMENSION(KI) :: ZMASK ! A mask for diagnosing where seaice exists (or, for coupling_iceflux, may appear) +REAL, DIMENSION(KI) :: DMS_WATER ! DMS oceanic content (mol m-3) based on Lana et al. 2011 database +REAL, DIMENSION(KI) :: ZFLUX_DMS ! DMS flux ! REAL :: ZCONVERTFACM0_SLT, ZCONVERTFACM0_DST REAL :: ZCONVERTFACM3_SLT, ZCONVERTFACM3_DST @@ -260,8 +264,10 @@ INTEGER :: IBEG, IEND INTEGER :: ISLT, IDST, JSV, IMOMENT ! number of sea salt, dust variables ! INTEGER :: ILUOUT +INTEGER :: JP_DMS ! REAL(KIND=JPRB) :: ZHOOK_HANDLE + !------------------------------------------------------------------------------------- ! Preliminaries: !------------------------------------------------------------------------------------- @@ -489,7 +495,8 @@ PSFCO2(:) = - ZWIND(:)**2 * 1.13E-3 * 8.7 * 44.E-3 / ( 365*24*3600 ) !------------------------------------------------------------------------------------- ! IF (CHS%SVS%NBEQ>0.AND.(KI.GT.0)) THEN - ! +! + IF (CHS%CCH_DRY_DEP == "WES89") THEN ! IBEG = CHS%SVS%NSV_CHSBEG @@ -508,6 +515,7 @@ IF (CHS%SVS%NBEQ>0.AND.(KI.GT.0)) THEN CALL CH_AER_DEP(PSV(:,IBEG:IEND),PSFTS(:,IBEG:IEND),ZUSTAR,ZRESA_SEA,PTA,PRHOA) ! END IF + ! ELSE ! @@ -519,6 +527,25 @@ IF (CHS%SVS%NBEQ>0.AND.(KI.GT.0)) THEN ! ENDIF ! +! DMS flux +DMS_WATER(:) = DMS%XDMS(:) ! nmol.dm-3 +DMS_WATER(:) = DMS_WATER(:) *1E-6*XAVOGADRO ! molec. m-3 +JP_DMS = 0 +DO JSV=CHS%SVS%NSV_CHSBEG,CHS%SVS%NSV_CHSEND + IF (TRIM(CHS%SVS%CSV(JSV)) == "DMS") JP_DMS=JSV +ENDDO + +IF (JP_DMS .GT. 0) THEN + ZFLUX_DMS(:) = 0. + CALL COUPLING_DMS_n(SIZE(ZUSTAR,1),& !! number of sea points + ZWIND,& !! wind velocity (m s-1) + S%XSST,& !! sea surface temperature (K) + DMS_WATER,& !! DMS oceanic content (mol m-3) + ZFLUX_DMS) !! DMS emission flux (mol m-2 s-1) + PSFTS(:,JP_DMS) = PSFTS(:,JP_DMS) + ZFLUX_DMS(:) + +ENDIF ! DMS + ENDIF ! IF (CHS%SVS%NDSTEQ>0.AND.(KI.GT.0)) THEN @@ -549,6 +576,7 @@ IF (CHS%SVS%NSLTEQ>0.AND.(KI.GT.0)) THEN ! IBEG = CHS%SVS%NSV_SLTBEG IEND = CHS%SVS%NSV_SLTEND + ! ISLT = IEND - IBEG + 1 ! @@ -560,6 +588,7 @@ IF (CHS%SVS%NSLTEQ>0.AND.(KI.GT.0)) THEN S%XSST, & ZUSTAR, & PSFTS(:,IBEG:IEND) ) + ! CALL DSLT_DEP(PSV(:,IBEG:IEND), PSFTS(:,IBEG:IEND), ZUSTAR, ZRESA_SEA, PTA, & PRHOA, SLT%XEMISSIG_SLT, SLT%XEMISRADIUS_SLT, JPMODE_SLT, & diff --git a/src/SURFEX/coupling_sltn.F90 b/src/SURFEX/coupling_sltn.F90 index 4437552ac..3db0c7b1a 100644 --- a/src/SURFEX/coupling_sltn.F90 +++ b/src/SURFEX/coupling_sltn.F90 @@ -18,11 +18,9 @@ SUBROUTINE COUPLING_SLT_n (SLT, & !PURPOSE !------- ! Compute sea salt emission upon Vignatti et al, 2001 -! ++ PIERRE / MARINE SSA - MODIF ++ ! Compute sea salt emission upon Ovadnevaite et al, 2014 -! -- PIERRE / MARINE SSA - MODIF -- +! Compute sea salt emission upon Ovadnevaite et al, 2014 and Bruch et al. 2021 ! -!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes !AUTHOR !------- ! P. Tulet @@ -50,6 +48,8 @@ REAL, DIMENSION(KI,KSLT), INTENT(OUT) :: PSFSLT !Out: kg/m2/s (index #2) REAL, DIMENSION(KI), INTENT(INOUT) :: PWHEIGHT !Significant height of wind-generated waves (in ECMWF analyses) REAL, DIMENSION(KI), INTENT(IN) :: PUSTAR !Friction velocity (ecmwf?) : Unite: m.s^(-2)? REAL, DIMENSION(KI), INTENT(IN) :: PSST ! Sea surface temperature (K) +REAL, DIMENSION(KI) :: MSS ! Variance de Pente de vague +REAL, DIMENSION(KI) :: PWIND12 ! Vent 12m ! -- PIERRE / MARINE SSA - MODIF -- !LOCAL VARIABLES @@ -156,17 +156,13 @@ ZCONVERTFACM3_SLT = 4./3.*XPI*XDENSITY_SLT / 1.d18 PSFSLT(:,:)=0.d0 ! !+ Marine -IF (CEMISPARAM_SLT .eq. "Ova14") THEN ! Rajouter Ova14 dans fichier initialisation +IF ((CEMISPARAM_SLT .eq. "Ova14").OR.(CEMISPARAM_SLT .eq. "OvB21a").OR.(CEMISPARAM_SLT .eq. "OvB21b")) THEN ! Rajouter Ova14 dans fichier initialisation ZHVAGUE(:) = 0. DO II = 1, 8 -!++cb++19/10/16 modif de la formule : + de vent => vagues + hautes -! WHERE ((PWIND(:) .GT. VVENT(II)).AND.(PWIND(:) .LT. VVENT(II+1))) WHERE ((PWIND(:) .GT. VVENT(II)).AND.(PWIND(:) .LT. VVENT(II+1))) -! ZHVAGUE(:) = HVAGUE(II) + (VVENT(II+1) - PWIND(:)) * & ZHVAGUE(:) = HVAGUE(II) + (PWIND(:) - VVENT(II+1)) * & (HVAGUE(II+1) - HVAGUE(II)) / & (VVENT(II+1) - VVENT(II)) -!--cb-- ENDWHERE ENDDO @@ -183,9 +179,16 @@ IF (CEMISPARAM_SLT .eq. "Ova14") THEN ! Rajouter Ova14 dans fichier initialisati ! Unite : m².s^(-1) Pour une salinite = 35g/kg. ! En mer Mediterranee = 38.5g/kg (Lewis and Schwartz) -! Initialisation des valeurs de ZVISCO, ZREYNOLDS +! Initialisation des valeurs de ZVISCO, ZREYNOLDS Variance de pente vague vent +! 12m ZVISCO(:) = 0. ZREYNOLDS(:) = 0. + MSS(:) = 0. + PWIND12(:) = 0. + PWIND12(:)=PWIND(:)+(PUSTAR(:)/0.4)*LOG(12.5/10.0) + MSS(:)=(0.003+(0.00512*PWIND12(:)))*(0.666) ! Correction factor + ! to convert tunnel to + ! Cox and munk MSS ! Tableau d'interpolation pour calculer ZNUWATER en fonction de la SST ! Cas ou 0 < SST < 10 C @@ -214,17 +217,14 @@ IF (CEMISPARAM_SLT .eq. "Ova14") THEN ! Rajouter Ova14 dans fichier initialisati ! Calcul du nombre de Reynolds ZREYNOLDS(:) = (PUSTAR(:) * PWHEIGHT(:)) / ZVISCO(:) - ! Calcul du flux en nombre pour chaque mode ! Ovadnevaite et al. 2014 !!!!! Total number flux, Unite ZSDSLT_MDE ne correspond pas au total number !flux mais au size dependent SSA production flux - -! Ecrire equation integration pour chaque mode - !Condition d'emission : ZREYNOLDS > 1E5 + ZSFSLT_MDE(:,:) = 0. WHERE (ZREYNOLDS(:) > 1.E5) ZSFSLT_MDE(:,1) = 104.51 * ( ZREYNOLDS(:) - 1.E5)**0.556 ZSFSLT_MDE(:,2) = 0.044 * ( ZREYNOLDS(:) - 1.E5)**1.08 @@ -235,29 +235,30 @@ IF (CEMISPARAM_SLT .eq. "Ova14") THEN ! Rajouter Ova14 dans fichier initialisati ZSFSLT_MDE(:,5) = 0.52 * ( ZREYNOLDS(:) - 2.E5)**0.87 ENDWHERE - - - WHERE (ZREYNOLDS(:) <= 1.E5) + WHERE (ZREYNOLDS(:) <= 1.E5) ZSFSLT_MDE(:,1) = 1.E-10 ZSFSLT_MDE(:,2) = 1.E-10 ZSFSLT_MDE(:,3) = 1.E-10 ZSFSLT_MDE(:,4) = 1.E-10 - ENDWHERE - WHERE (ZREYNOLDS(:) <= 2.E5) ZSFSLT_MDE(:,5) = 1.E-10 ENDWHERE -! Controle avec des valeurs limites , Pas besoin de la conversion 1E4 pour Ova -! car deja en m-2 - ZSFSLT_MDE(:,1) = MAX(ZSFSLT_MDE(:,1) , 1.E-10) - ZSFSLT_MDE(:,2) = MAX(ZSFSLT_MDE(:,2) , 1.E-10) - ZSFSLT_MDE(:,3) = MAX(ZSFSLT_MDE(:,3) , 1.E-10) - ZSFSLT_MDE(:,4) = MAX(ZSFSLT_MDE(:,4) , 1.E-10) - ZSFSLT_MDE(:,5) = MAX(ZSFSLT_MDE(:,5) , 1.E-10) -!- Marine + ! Wave slope variance dependent SSGF (Bruch et al., 2021) - In #/m2/um/s + IF ((CEMISPARAM_SLT .eq. "OvB21a").AND.(JPMODE_SLT >= 6)) ZSFSLT_MDE(:,6)=(5.3824*10**6) * (MSS(:))**2.45 + IF ((CEMISPARAM_SLT .eq. "OvB21a").AND.(JPMODE_SLT >= 7)) ZSFSLT_MDE(:,7)=(1.9424*10**6) * (MSS(:))**2.30 + IF ((CEMISPARAM_SLT .eq. "OvB21a").AND.(JPMODE_SLT == 8)) ZSFSLT_MDE(:,8)=(1.3153*10**5) * (MSS(:))**2.39 + + ! Wave slope variance, wave age, and Rb dependent SSGF, (Bruch et al. 2021) - In #/m2/um/s + IF ((CEMISPARAM_SLT .eq. "OvB21b").AND.(JPMODE_SLT >= 6)) ZSFSLT_MDE(:,6)=(47.6139) * & + (((MSS(:)*PUSTAR(:)**3)*(1/(9.8*1.8*1e-5))))**0.92 + IF ((CEMISPARAM_SLT .eq. "OvB21b").AND.(JPMODE_SLT >= 7)) ZSFSLT_MDE(:,7)=(1.6849) * & + (((MSS(:)*PUSTAR(:)**3)*(1/(9.8*1.8*1e-5))))**1.41 + IF ((CEMISPARAM_SLT .eq. "OvB21b").AND.(JPMODE_SLT == 8)) ZSFSLT_MDE(:,8)=(0.4481) * & + (((MSS(:)*PUSTAR(:)**3)*(1/(9.8*1.8*1e-5))))**1.11 + ELSEIF (CEMISPARAM_SLT .eq. "Vig01") THEN -! Vignatti et al. 2001 (in particles.cm-2.s-1) : en #.cm-3 en fait +! Vignatti et al. 2001 (in particles.cm-2.s-1) ZSFSLT_MDE(:,1) = 10.**(0.09 *PWIND(:) + 0.283) ! fine mode ZSFSLT_MDE(:,2) = 10.**(0.0422*PWIND(:) + 0.288) ! median mode ZSFSLT_MDE(:,3) = 10.**(0.069 *PWIND(:) - 3.5) ! coarse mode @@ -267,24 +268,6 @@ ELSEIF (CEMISPARAM_SLT .eq. "Vig01") THEN ZSFSLT_MDE(:,2) = MAX(ZSFSLT_MDE(:,2) * 1.E4, 1.E-10) ZSFSLT_MDE(:,3) = MAX(ZSFSLT_MDE(:,3) * 1.E4, 1.E-10) ! -ELSEIF (CEMISPARAM_SLT .eq. "Sch04") THEN! Use Schultz et al., 2004 - WCL(:) = INT(PWIND(:)) - WCL(:) = MAX (0, MIN(WCL(:), 39)) - - DZSPEED(:) = MAX(0., MIN(PWIND(:) - FLOAT(WCL(:)), 1.)) - ! - ! Flux given in particles.m-2 s-1 - ! - DO JI = 1, KI - !plm-gfortran - ZSFSLT_MDE(JI,1) = NUMB1FLUX(WCL(JI)) + & - (NUMB1FLUX(WCL(JI)+1)-NUMB1FLUX(WCL(JI)))*DZSPEED(JI) - ZSFSLT_MDE(JI,2) = NUMB2FLUX(WCL(JI)) + & - (NUMB2FLUX(WCL(JI)+1)-NUMB2FLUX(WCL(JI)))*DZSPEED(JI) - ZSFSLT_MDE(JI,3) = NUMB3FLUX(WCL(JI)) + & - (NUMB3FLUX(WCL(JI)+1)-NUMB3FLUX(WCL(JI)))*DZSPEED(JI) - !plm-gfortran - END DO END IF ! DO JN = 1, JPMODE_SLT @@ -292,7 +275,6 @@ DO JN = 1, JPMODE_SLT ! convert particles.m-2 s-1 into kg.m-2.s-1 ! N'est calculé que pour le moment 3 (en masse), la conversion pour les autres ! flux de moments se fait plus tard (mode_dslt_surf.F90 MASSFLUX2MOMENTFLUX) -!+Marine ! IF (LVARSIG_SLT) THEN ! cas 3 moment @@ -313,7 +295,6 @@ DO JN = 1, JPMODE_SLT * ((SLT%XEMISRADIUS_SLT(JN)**3) & * EXP(4.5 * LOG(SLT%XEMISSIG_SLT(JN))**2)) & * ZCONVERTFACM3_SLT -! -- PIERRE / MARINE SSA - MODIF -- END IF END DO diff --git a/src/SURFEX/coupling_tebn.F90 b/src/SURFEX/coupling_tebn.F90 index 5f7072ea3..0a28e679e 100644 --- a/src/SURFEX/coupling_tebn.F90 +++ b/src/SURFEX/coupling_tebn.F90 @@ -951,14 +951,11 @@ IF (CHT%SVT%NBEQ>0) THEN ENDIF IF (CHT%SVT%NDSTEQ>0) THEN - ! Blindage à enlever lorsque que TEB aura été corrigé - ZUSTAR(:) = MIN(ZUSTAR(:), 10.) - ZRESA (:) = MAX(ZRESA(:), 10.) ! IBEG = CHT%SVT%NSV_DSTBEG IEND = CHT%SVT%NSV_DSTEND ! - CALL DSLT_DEP(PSV(:,IBEG:IEND), PSFTS(:,IBEG:IEND), ZUSTAR, ZRESA, PTA, PRHOA, & + CALL DSLT_DEP(PSV(:,IBEG:IEND), PSFTS(:,IBEG:IEND), ZAVG_USTAR, ZAVG_RESA, PTA, PRHOA, & DST%XEMISSIG_DST, DST%XEMISRADIUS_DST, JPMODE_DST, XDENSITY_DST, & XMOLARWEIGHT_DST, ZCONVERTFACM0_DST, ZCONVERTFACM6_DST, & ZCONVERTFACM3_DST, LVARSIG_DST, LRGFIX_DST, CVERMOD ) @@ -979,7 +976,7 @@ IF (CHT%SVT%NSLTEQ>0) THEN IBEG = CHT%SVT%NSV_SLTBEG IEND = CHT%SVT%NSV_SLTEND ! - CALL DSLT_DEP(PSV(:,IBEG:IEND), PSFTS(:,IBEG:IEND), ZUSTAR, ZRESA, PTA, PRHOA, & + CALL DSLT_DEP(PSV(:,IBEG:IEND), PSFTS(:,IBEG:IEND), ZAVG_USTAR, ZAVG_RESA, PTA, PRHOA, & SLT%XEMISSIG_SLT, SLT%XEMISRADIUS_SLT, JPMODE_SLT, XDENSITY_SLT, & XMOLARWEIGHT_SLT, ZCONVERTFACM0_SLT, ZCONVERTFACM6_SLT, & ZCONVERTFACM3_SLT, LVARSIG_SLT, LRGFIX_SLT, CVERMOD ) @@ -994,6 +991,7 @@ IF (CHT%SVT%NSLTEQ>0) THEN ZCONVERTFACM6_SLT, & ZCONVERTFACM3_SLT, & LVARSIG_SLT, LRGFIX_SLT ) + ENDIF ! ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/src/SURFEX/get_vegtype_2_patch_mask.F90 b/src/SURFEX/get_vegtype_2_patch_mask.F90 index 93ea7f1b5..3c15e31c4 100644 --- a/src/SURFEX/get_vegtype_2_patch_mask.F90 +++ b/src/SURFEX/get_vegtype_2_patch_mask.F90 @@ -63,8 +63,9 @@ IF (LHOOK) CALL DR_HOOK('GET_VEGTYPE_2_PATCH_MASK',0,ZHOOK_HANDLE) KMASK(:) = 0 KK=1 !First point of vegetation-vector + DO JJ=1,KSIZE_PATCH !Number of points in the patch in question - II=KMASK_PATCH_NATURE(JJ) !Nature-index corresponding to the point in question + II=JJ !KMASK_PATCH_NATURE(JJ) !Nature-index corresponding to the point in question IF(PVEGTYPE_PATCH(II,KVEGTYPE)>0.)THEN KMASK(KK)=JJ KK=KK+1 diff --git a/src/SURFEX/init_megann.F90 b/src/SURFEX/init_megann.F90 index ee3b097f8..6996a37b1 100644 --- a/src/SURFEX/init_megann.F90 +++ b/src/SURFEX/init_megann.F90 @@ -40,10 +40,7 @@ USE MODD_MEGAN_n, ONLY : MEGAN_t USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_P_t, ISBA_K_t, ISBA_NP_t ! -USE MODD_DATA_COVER_PAR, ONLY : NVT_C4, NVT_TRBE, NVT_TRBD, NVT_TEBE, & - NVT_TEBD, NVT_TENE, NVT_BOBD, NVT_BONE, NVT_BOND, & - NVT_BOGR, NVT_SHRB, NVT_GRAS, NVT_TROG, NVT_C3, & - NVT_NO, NVT_ROCK, NVT_SNOW, NVT_IRR, NVT_PARK +USE MODD_DATA_COVER_PAR ! USE MODD_SURF_PAR, ONLY : XUNDEF USE MODD_DATA_COVER, ONLY : XDATA_LAI @@ -94,9 +91,15 @@ REAL,DIMENSION(SIZE(K%XCLAY,1)) :: ZLAI ! ALLOCATE(MGN%XPFT (N_MGN_PFT,SIZE(K%XCLAY,1))) ALLOCATE(MGN%XEF (N_MGN_SPC,SIZE(K%XCLAY,1))) +ALLOCATE(MGN%XLAI (SIZE(K%XCLAY,1))) ALLOCATE(MGN%NSLTYP (SIZE(K%XCLAY,1))) ALLOCATE(MGN%XBIOFLX(SIZE(K%XCLAY,1))) +ALLOCATE(MGN%XT24(SIZE(K%XCLAY,1))) +ALLOCATE(MGN%XPPFD24(SIZE(K%XCLAY,1))) MGN%XBIOFLX(:) = 0. +MGN%XT24(:) = MGN%XDAILYTEMP +MGN%XPPFD24(:) = MGN%XDAILYPAR + ! ! Prepare the mechanism conversion between Megan and MesoNH MGN%CMECHANISM = "RELACS2" ! scheme default in MesoNH @@ -313,134 +316,91 @@ ENDDO ! ! 1 Needleleaf evergreen temperate tree ! ------------------------------------- -! utilisation de la classe NVT_CONI pour 30 < LAT < 60 -WHERE ((PLAT(:) .GE. 30.) .AND. (PLAT(:) .LT. 60.)) - MGN%XPFT(1,:) = S%XVEGTYPE(:,NVT_TENE) -END WHERE -WHERE ((PLAT(:) .LE. -30.) .AND. (PLAT(:) .GT. -60.)) - MGN%XPFT(1,:) = S%XVEGTYPE(:,NVT_TENE) -END WHERE +! utilisation de la classe NVT_TENE +MGN%XPFT(1,:) = S%XVEGTYPE(:,NVT_TENE) ! ! 2 Needleleaf evergreen boreal tree ! ------------------------------------- -!utilisation de la classe NVT_CONI pour LAT > 60 -WHERE ((PLAT(:) .GE. 60.) .OR. (PLAT(:) .LE. -60.)) - MGN%XPFT(2,:) = S%XVEGTYPE(:,NVT_BONE) -END WHERE +!utilisation de la classe NVT_BONE +MGN%XPFT(2,:) = S%XVEGTYPE(:,NVT_BONE) ! !3 Needleleaf deciduous boreal tree ! ------------------------------------- -!utilisation de la classe NVT_TREE pour LAT > 60 -WHERE ((PLAT(:) .GE. 60.) .OR. (PLAT(:) .LE. -60.)) - MGN%XPFT(3,:) = S%XVEGTYPE(:,NVT_BOND) -END WHERE +!utilisation de la classe NVT_BOND +MGN%XPFT(3,:) = S%XVEGTYPE(:,NVT_BOND) ! !4 Broadleaf evergreen tropical tree ! ------------------------------------- -!utilisation de la classe NVT_EVER pour -30 < LAT < 30 -! et une hauteur d'arbre supérieur à 3 m -WHERE (((PLAT(:) .GE. -30.) .AND. (PLAT(:) .LE. 30.)).AND.& - (ZH_TREE(:,IP_TRBE) .GE. 3.).AND.(ZH_TREE(:,IP_TRBE) .NE. XUNDEF)) +!utilisation de la classe NVT_TRBE MGN%XPFT(4,:) = S%XVEGTYPE(:,NVT_TRBE) -END WHERE ! !5 Broadleaf evergreen temperate tree ! ------------------------------------- -! utilisation de la classe NVT_EVER pour 30 < LAT < 60 -! et une hauteur d'arbre supérieur à 3 m. -WHERE (((PLAT(:) .GE. 30.) .AND. (PLAT(:) .LT. 60.)).AND.& - (ZH_TREE(:,IP_TEBE) .GE. 3.).AND.(ZH_TREE(:,IP_TEBE) .NE. XUNDEF)) -MGN%XPFT(5,:) = S%XVEGTYPE(:,NVT_TEBE) -END WHERE -WHERE (((PLAT(:) .LE. -30.) .AND. (PLAT(:) .GT. -60.)).AND.& - (ZH_TREE(:,IP_TEBE) .GE. 3.).AND.(ZH_TREE(:,IP_TEBE) .NE. XUNDEF)) MGN%XPFT(5,:) = S%XVEGTYPE(:,NVT_TEBE) -END WHERE ! !6 Broadleaf deciduous tropical tree ! ------------------------------------- -!utilisation de la classe NVT_TREE pour -30 < LAT < 30 -WHERE ((PLAT(:) .GE. -30.) .AND. (PLAT(:) .LE. 30.)) MGN%XPFT(6,:) = S%XVEGTYPE(:,NVT_TRBD) -END WHERE ! !7 Broadleaf deciduous temperate tree ! ------------------------------------- -!utilisation de la classe NVT_TREE pour 30 < LAT < 60 -! en utilisant une hauteur d'arbre supérieur à 3 m -WHERE (((PLAT(:) .GE. 30.) .AND. (PLAT(:) .LT. 60.)).AND.& - (ZH_TREE(:,IP_TEBD) .GE. 3.).AND.(ZH_TREE(:,IP_TEBD) .NE. XUNDEF)) -MGN%XPFT(7,:) = S%XVEGTYPE(:,NVT_TEBD) -END WHERE -WHERE (((PLAT(:) .LE. -30.) .AND. (PLAT(:) .GT. -60.)).AND.& - (ZH_TREE(:,IP_TEBD) .GE. 3.).AND.(ZH_TREE(:,IP_TEBD) .NE. XUNDEF)) MGN%XPFT(7,:) = S%XVEGTYPE(:,NVT_TEBD) -END WHERE ! !8 Broadleaf deciduous boreal tree ! ------------------------------------- -!utilisation de la classe NVT_TREE pour LAT > 60 -WHERE (((PLAT(:) .GE. 60.) .OR. (PLAT(:) .LE. -60.)).AND.& - (ZH_TREE(:,IP_BOBD) .GE. 3.).AND.(ZH_TREE(:,IP_BOBD) .NE. XUNDEF)) MGN%XPFT(8,:) = S%XVEGTYPE(:,NVT_BOBD) -END WHERE ! !9 Broadleaf evergreen shrub ! ------------------------------------- -!utilisation de la classe NVT_EVER pour une hauteur d'arbre inférieure à 3 m -WHERE (ZH_TREE(:,IP_SHRB) .LT. 3.) +!utilisation de la classe NVT_SHBR pour -30 < LAT < 30 +WHERE (((PLAT(:) .GE. -30.) .AND. (PLAT(:) .LE. 30.))) MGN%XPFT(9,:) = S%XVEGTYPE(:,NVT_SHRB) +ELSE WHERE +MGN%XPFT(9,:) = 0. END WHERE ! !10 Broadleaf deciduous temperate shrub ! ------------------------------------- -!utilisation de la classe NVT_TREE pour une hauteur d'arbre inférieure à 3 m -! et pour 30 < LAT < 60 -WHERE ((ZH_TREE(:,IP_SHRB) .LT. 3.) .AND. (ZH_TREE(:,IP_SHRB).NE. XUNDEF) .AND. & - ((PLAT(:) .GE. 30.) .AND. (PLAT(:) .LT. 60.))) -MGN%XPFT(10,:) = S%XVEGTYPE(:,NVT_SHRB) -END WHERE -WHERE ((ZH_TREE(:,IP_SHRB) .LT. 3.) .AND. (ZH_TREE(:,IP_SHRB).NE. XUNDEF) .AND. & +!utilisation de la classe NVT_SHBR pour 30 < LAT < 60 +WHERE (((PLAT(:) .GE. 30.) .AND. (PLAT(:) .LT. 60.)).OR.& ((PLAT(:) .LE. -30.) .AND. (PLAT(:) .GT. -60.))) MGN%XPFT(10,:) = S%XVEGTYPE(:,NVT_SHRB) +ELSE WHERE +MGN%XPFT(10,:) = 0. END WHERE ! !11 Broadleaf deciduous boreal_shrub ! ------------------------------------- -!utilisation de la classe NVT_TREE pour une hauteur d'arbre inférieure à 3 m -! et pour LAT > 60 -WHERE ((ZH_TREE(:,IP_SHRB) .LT. 3.) .AND. (ZH_TREE(:,IP_SHRB).NE. XUNDEF) .AND. & - ((PLAT(:) .GE. 60.) .OR. (PLAT(:) .LE. -60.))) +!utilisation de la classe NVT_SHBR pour LAT > 60 +WHERE (((PLAT(:) .GE. 60.) .OR. (PLAT(:) .LE. -60.))) MGN%XPFT(11,:) = S%XVEGTYPE(:,NVT_SHRB) +ELSE WHERE +MGN%XPFT(11,:) = 0. END WHERE ! !12 C3 arctic grass ! ------------------------------------- -!utilisation de la classe NVT_GRAS + NVT_PARK pour LAT > 60 -WHERE ((PLAT(:) .GE. 60.) .OR. (PLAT(:) .LE. -60.)) -MGN%XPFT(12,:) = S%XVEGTYPE(:,NVT_GRAS) + S%XVEGTYPE(:,NVT_PARK) -ELSEWHERE +MGN%XPFT(12,:) = S%XVEGTYPE(:,NVT_BOGR) ! !13 C3 non-arctic grass ! ------------------------------------- -!utilisation de la classe NVT_GRAS + NVT_PARK ailleur -MGN%XPFT(13,:) = S%XVEGTYPE(:,NVT_GRAS) + S%XVEGTYPE(:,NVT_PARK) -END WHERE +MGN%XPFT(13,:) = S%XVEGTYPE(:,NVT_GRAS) ! !14 C4 grass ! ------------------------------------- -! utilisation de la classe NVT_TROG MGN%XPFT(14,:) = S%XVEGTYPE(:,NVT_TROG) ! !15 Corn ! ------------------------------------- -! utilisation de la classe NVT_C4 MGN%XPFT(15,:) = S%XVEGTYPE(:,NVT_C4) ! !16 Wheat ! ------------------------------------- -! utilisation de la classe NVT_C3 +IF (NVT_C3W .NE. 0 ) THEN ! use ecoclimap_sg +MGN%XPFT(16,:) = S%XVEGTYPE(:,NVT_C3W) + S%XVEGTYPE(:,NVT_C3S) +ELSE ! use ecaclimap2.0 MGN%XPFT(16,:) = S%XVEGTYPE(:,NVT_C3) +END IF ! ! Emission factor MGN%XEF(:,:) = 0. @@ -499,7 +459,6 @@ DO JSV=1, MSF%NMEGAN_NBR IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "EFBIDER") MGN%XEF(18,:) = PMEGAN_FIELDS(:,JSV) IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "EFSTRESS") MGN%XEF(19,:) = PMEGAN_FIELDS(:,JSV) IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "EFOTHER") MGN%XEF(20,:) = PMEGAN_FIELDS(:,JSV) -! IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "LAI") PLAI(:,1) = PMEGAN_FIELDS(:,JSV) IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT1") MGN%XPFT(1,:) = PMEGAN_FIELDS(:,JSV) IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT2") MGN%XPFT(2,:) = PMEGAN_FIELDS(:,JSV) IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT3") MGN%XPFT(3,:) = PMEGAN_FIELDS(:,JSV) @@ -516,6 +475,7 @@ DO JSV=1, MSF%NMEGAN_NBR IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT14") MGN%XPFT(14,:) = PMEGAN_FIELDS(:,JSV) IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT15") MGN%XPFT(15,:) = PMEGAN_FIELDS(:,JSV) IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "PFT16") MGN%XPFT(16,:) = PMEGAN_FIELDS(:,JSV) + IF (TRIM(MSF%CMEGAN_NAME(JSV)) == "LAI") MGN%XLAI(:) = PMEGAN_FIELDS(:,JSV) END DO #endif diff --git a/src/SURFEX/init_slt.F90 b/src/SURFEX/init_slt.F90 index 44e1e1bf9..2182cbeb8 100644 --- a/src/SURFEX/init_slt.F90 +++ b/src/SURFEX/init_slt.F90 @@ -5,36 +5,7 @@ SUBROUTINE INIT_SLT (SLT, & HPROGRAM &! Program calling unit ) -! ###################################################################### -! -!!**** *INIT_SLT* - -!! -!! PURPOSE -!! ------- -! -!!** METHOD -!! ------ -!! !! -!! EXTERNAL -!! -------- -!! -!! IMPLICIT ARGUMENTS -!! ------------------ -!! -!! REFERENCE -!! --------- -!! -!! -!! AUTHOR -!! ------ -!! ? -!! -!! MODIFICATIONS -!! ------------- -!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes -!! -!------------------------------------------------------------------------------ -! + ! USE MODD_SLT_n, ONLY : SLT_t ! @@ -57,39 +28,39 @@ INTEGER :: JMODE ! Counter for sea salt modes INTEGER :: JMODE_IDX ! Index for sea salt modes REAL(KIND=JPRB) :: ZHOOK_HANDLE + !get output listing unit IF (LHOOK) CALL DR_HOOK('INIT_SLT',0,ZHOOK_HANDLE) ! !Allocate memory for the real values which will be used by the model -ALLOCATE(SLT%XEMISRADIUS_SLT(NSLTMDE)) -ALLOCATE(SLT%XEMISSIG_SLT (NSLTMDE)) ! !Get initial size distributions. This is cut and pasted !from dead routine dstpsd.F90 !Check for different source parameterizations +! Default : CEMISPARAM_SLT.eq."Ova14" -IF (CEMISPARAM_SLT.eq."Ova14") THEN NSLTMDE = 5 -! JORDER_SLT = (/3,2,1,4,5/) !Salt modes in order of importance CRGUNITS = 'NUMB' - XEMISRADIUS_INI_SLT = (/0.009, 0.021, 0.045, 0.115, 0.415/) - XEMISSIG_INI_SLT = (/1.37, 1.5, 1.42, 1.53, 1.85/) + XEMISRADIUS_INI_SLT = (/0.009, 0.021, 0.045, 0.115, 0.415, 0.0, 0.0, 0.0/) + XEMISSIG_INI_SLT = (/1.37, 1.5, 1.42, 1.53, 1.85,0.,0.,0./) + +IF ((CEMISPARAM_SLT.eq."OvB21a").OR.(CEMISPARAM_SLT.eq."OvB21b")) THEN + NSLTMDE = 8 + CRGUNITS = 'NUMB' + XEMISRADIUS_INI_SLT = (/0.009, 0.021, 0.045, 0.115, 0.415, 2.5, 7.0, 25.0/) + XEMISSIG_INI_SLT = (/1.37, 1.5, 1.42, 1.53,1.70,1.80, 1.85, 2.1/) + -ELSE IF(CEMISPARAM_SLT.eq."Vig01") THEN +ELSE IF (CEMISPARAM_SLT.eq."Vig01") THEN NSLTMDE = 5 ! JORDER_SLT = (/3,2,1,4,5/) !Salt modes in order of importance, only three modes CRGUNITS = 'NUMB' - XEMISRADIUS_INI_SLT = (/ 0.2, 2.0, 12.,0.,0. /) ! [um] Number median radius Viganati et al., 2001 - XEMISSIG_INI_SLT = (/ 1.9, 2.0, 3.00,0.,0. /) ! [frc] Geometric standard deviation Viganati et al., 2001 - -ELSE IF(CEMISPARAM_SLT.eq."Sch04") THEN ! use default of Schultz et al, 2004 - NSLTMDE = 5 -! JORDER_SLT = (/3,2,1,4,5/), only three modes - CRGUNITS = 'MASS' - XEMISRADIUS_INI_SLT = 0.5*(/0.28, 2.25, 15.32, 0., 0./)! [um] Mass median radius - XEMISSIG_INI_SLT = (/1.59, 2.00, 2.00, 0., 0./) ! [frc] Geometric standard deviation - + XEMISRADIUS_INI_SLT = (/ 0.2, 2.0, 12.,0.,0.,0.,0.,0. /) ! [um] Number median radius Viganati et al., 2001 + XEMISSIG_INI_SLT = (/ 1.9, 2.0, 3.00,0.,0.,0.,0.,0. /) ! [frc] Geometric standard deviation Viganati et al., 2001 ENDIF + +ALLOCATE(SLT%XEMISRADIUS_SLT(NSLTMDE)) +ALLOCATE(SLT%XEMISSIG_SLT (NSLTMDE)) ! DO JMODE=1,NSLTMDE ! diff --git a/src/SURFEX/init_surf_atmn.F90 b/src/SURFEX/init_surf_atmn.F90 index 2c6c776dc..79f682052 100644 --- a/src/SURFEX/init_surf_atmn.F90 +++ b/src/SURFEX/init_surf_atmn.F90 @@ -56,6 +56,8 @@ SUBROUTINE INIT_SURF_ATM_n (YSC, HPROGRAM,HINIT, OLAND_USE, & !! M.Leriche & V. Masson 05/16 bug in write emis fields for nest !! (P.Tulet & M.Leriche) 06/2016 add MEGAN coupling !! J.Escoabr 01/2019 integrate bypass fo albedo pb > 1.0 from Florian Pantillon (Sep 2011) +!! (P.Tulet) 06/2021 add DMS chemical fluxes + !------------------------------------------------------------------------------- ! !* 0. DECLARATIONS @@ -64,6 +66,8 @@ SUBROUTINE INIT_SURF_ATM_n (YSC, HPROGRAM,HINIT, OLAND_USE, & USE MODD_TYPE_DATE_SURF, ONLY : DATE ! USE MODD_SURFEX_n, ONLY : SURFEX_t +USE MODD_DMS_n, ONLY : DMS_t + ! USE MODD_SURF_ATM, ONLY : XCO2UNCPL ! @@ -129,6 +133,10 @@ USE MODI_READ_LECOCLIMAP USE MODI_SURF_VERSION USE MODI_GET_LUOUT USE MODI_SET_SURFEX_FILEIN +!UPG*PT +USE MODI_INIT_SLT +USE MODI_READ_DMS_n +!UPG*PT ! USE MODI_INIT_CPL_GCM_n USE MODI_READ_MEGAN_n @@ -213,6 +221,7 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZP_TSRAD ! radiative temperature REAL, DIMENSION(:), ALLOCATABLE :: ZP_TSURF ! surface effective temperature ! REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_MEGAN_FIELDS +REAL, DIMENSION(:,:), ALLOCATABLE :: ZP_DMS_FIELDS ! REAL, DIMENSION(:), ALLOCATABLE :: ZZ0VEG REAL :: XTIME0 @@ -222,6 +231,7 @@ INTEGER :: ISIZE_FULL REAL(KIND=JPRB) :: ZHOOK_HANDLE ! INTEGER :: JJ +CHARACTER(LEN=6), DIMENSION(:),POINTER :: CNAMES !------------------------------------------------------------------------------- ! IF (LHOOK) CALL DR_HOOK('INIT_SURF_ATM_N',0,ZHOOK_HANDLE) @@ -249,7 +259,7 @@ IF (LNAM_READ) THEN ! 0.1. Hard defaults ! CALL DEFAULT_SSO(YSC%USS%CROUGH, YSC%USS%XFRACZ0, YSC%USS%XCOEFBE) - CALL DEFAULT_CH_SURF_ATM(YSC%CHU%CCHEM_SURF_FILE, YSC%CHU%LCH_SURF_EMIS) + CALL DEFAULT_CH_SURF_ATM(YSC%CHU%CCHEM_SURF_FILE, YSC%CHU%LCH_EMIS) CALL DEFAULT_DIAG_SURF_ATM(YSC%DUO%N2M, YSC%DUO%LT2MMW, YSC%DUO%LSURF_BUDGET,& YSC%DUO%L2M_MIN_ZS, YSC%DUO%LRAD_BUDGET, YSC%DUO%LCOEF,& YSC%DUO%LSURF_VARS, YSC%DUO%LSURF_BUDGETC, & @@ -400,10 +410,11 @@ ENDIF CALL INIT_CHEMICAL_n(ILUOUT, KSV, HSV, YSC%SV, & YSC%CHU%CCH_NAMES, YSC%CHU%CAER_NAMES ) ! -! 2.4 Initialize Chemical Emissions +! 2.4.1 Initialize Chemical Emissions ! - CALL READ_SURF(HPROGRAM,'CH_EMIS',YSC%CHU%LCH_EMIS,IRESP) +CALL READ_SURF(HPROGRAM,'CH_EMIS',YSC%CHU%LCH_EMIS,IRESP) ! + IF (YSC%CHU%LCH_EMIS) THEN ! IF ( IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3 ) THEN @@ -411,16 +422,32 @@ IF (YSC%CHU%LCH_EMIS) THEN ELSE CALL READ_SURF(HPROGRAM,'CH_EMIS_OPT',YSC%CHU%CCH_EMIS,IRESP) END IF - ! + IF (KSV == 0) THEN ! case prep_nest_pgd + CNAMES => YSC%SV%CSV + ELSE IF (YSC%SV%NSV_AEREND < 0) THEN ! case gas chemistry without aerosols + CNAMES => YSC%SV%CSV(YSC%SV%NSV_CHSBEG:YSC%SV%NSV_CHSEND) + ELSE IF (YSC%SV%NSV_AEREND > YSC%SV%NSV_CHSEND) THEN ! case gas and aerosols chemistry + CNAMES => YSC%SV%CSV(YSC%SV%NSV_CHSBEG:YSC%SV%NSV_AEREND) + ELSE + END IF + IF (YSC%CHU%CCH_EMIS=='AGGR') THEN - CALL CH_INIT_EMISSION_n(YSC%CHE, YSC%CHU%XCONVERSION, YSC%SV%CSV, & + CALL CH_INIT_EMISSION_n(YSC%CHE, YSC%CHU%XCONVERSION, CNAMES, & HPROGRAM,YSC%U%NSIZE_FULL,HINIT,PRHOA,YSC%CHU%CCHEM_SURF_FILE) - ELSE - CALL CH_INIT_SNAP_n(YSC%CHN, YSC%SV%CSV, & + ELSE IF (YSC%CHU%CCH_EMIS=='SNAP') THEN + CALL CH_INIT_SNAP_n(YSC%CHN, CNAMES, & HPROGRAM,YSC%U%NSIZE_FULL,HINIT,PRHOA,YSC%CHU%CCHEM_SURF_FILE) END IF ! ENDIF +! +! 2.4.2 Initialize sea salt aerosols distribution +! + +IF (YSC%SV%NSLTEQ >=1) THEN + CALL INIT_SLT(YSC%SLT, HPROGRAM) +END IF + ! !* 2.5 Initialization of dry deposition scheme (chemistry) ! @@ -460,6 +487,17 @@ DEALLOCATE(ZZ0VEG) IF (YSC%CHU%LCH_BIOEMIS) THEN CALL READ_MEGAN_n(YSC%IM%MSF, YSC%U, HPROGRAM) ENDIF + + +!* 2.9 DMS fields +! + CALL READ_SURF (HPROGRAM,'CH_DMSEMIS',YSC%CHU%LCH_DMSEMIS,IRESP) +! +IF (YSC%CHU%LCH_DMSEMIS) THEN + CALL READ_DMS_n(YSC%SM%DSF, YSC%U, HPROGRAM) +ENDIF +! + ! ! End of IO ! @@ -559,6 +597,17 @@ IF (YSC%U%NDIM_SEA>0) & KYEAR,KMONTH,KDAY,PTIME, HATMFILE,HATMFILETYPE, & 'OK' ) ! +! +IF (KMONTH <= 12) THEN +ALLOCATE(YSC%SM%DMS%XDMS(SIZE(ZP_DMS_FIELDS,1)) ) +IF (SIZE(ZP_DMS_FIELDS,2)==12) THEN + YSC%SM%DMS%XDMS(:) = ZP_DMS_FIELDS(:,KMONTH) +ELSE IF (SIZE(ZP_DMS_FIELDS,2)==1) THEN + YSC%SM%DMS%XDMS(:) = ZP_DMS_FIELDS(:,1) +ELSE + YSC%SM%DMS%XDMS(:) = 0. +END IF +END IF ! CALL UNPACK_SURF_INIT_ARG(JTILE,YSC%U%NSIZE_SEA,YSC%U%NR_SEA) ! @@ -700,6 +749,7 @@ ALLOCATE(ZP_ZENITH (KSIZE)) ALLOCATE(ZP_AZIM (KSIZE)) ! ALLOCATE(ZP_MEGAN_FIELDS (KSIZE,YSC%IM%MSF%NMEGAN_NBR)) +ALLOCATE(ZP_DMS_FIELDS (KSIZE,YSC%SM%DSF%NDMS_NBR)) ! ! output arguments: ! @@ -720,6 +770,7 @@ IF (KSIZE>0) THEN ZP_TSRAD = XUNDEF ZP_TSURF = XUNDEF ZP_MEGAN_FIELDS = 0. + ZP_DMS_FIELDS = 0. END IF ! DO JJ=1,KSIZE @@ -750,6 +801,14 @@ DO JJ=1,KSIZE END IF END IF END IF + IF ( YSC%SM%DSF%NDMS_NBR>0 ) THEN + IF ( ASSOCIATED(YSC%SM%DSF%XDMS_FIELDS)) THEN + IF ( SIZE(YSC%SM%DSF%XDMS_FIELDS,1)>0 ) THEN + ZP_DMS_FIELDS (JJ,:) = YSC%SM%DSF%XDMS_FIELDS(KMASK(JJ),:) + END IF + END IF + END IF + ENDDO IF (LHOOK) CALL DR_HOOK('PACK_SURF_INIT_ARG',1,ZHOOK_HANDLE) ! @@ -789,6 +848,7 @@ DEALLOCATE(ZP_EMIS ) DEALLOCATE(ZP_TSRAD ) DEALLOCATE(ZP_TSURF ) DEALLOCATE(ZP_MEGAN_FIELDS ) +DEALLOCATE(ZP_DMS_FIELDS ) IF (LHOOK) CALL DR_HOOK('UNPACK_SURF_INIT_ARG',1,ZHOOK_HANDLE) ! END SUBROUTINE UNPACK_SURF_INIT_ARG diff --git a/src/SURFEX/modd_ch_surfn.F90 b/src/SURFEX/modd_ch_surfn.F90 index 66f8d7da5..6114c9132 100644 --- a/src/SURFEX/modd_ch_surfn.F90 +++ b/src/SURFEX/modd_ch_surfn.F90 @@ -49,6 +49,9 @@ TYPE CH_SURF_t CHARACTER(LEN=4) :: CCH_BIOEMIS ! Option for MEGAN coupling activation ! 'NONE' : no coupling with MEGAN ! 'MEGA' : activate MEGAN coupling + CHARACTER(LEN=4) :: CCH_DMSEMIS ! Option for DMS fluxes activation + ! 'NONE' : no coupling with MEGAN + ! 'DMSDATA' : activate DMS fluxes CHARACTER(LEN=6), DIMENSION(:), POINTER :: CCH_NAMES ! NAME OF CHEMICAL CHARACTER(LEN=6), DIMENSION(:), POINTER :: CAER_NAMES ! NAME OF AEROSOL SPECIES ! SPECIES (FOR DIAG ONLY) @@ -63,6 +66,8 @@ TYPE CH_SURF_t ! are present in the file LOGICAL :: LCH_BIOEMIS ! T : megan emissions ! are present in the file + LOGICAL :: LCH_DMSEMIS ! T : dms data + ! are present in the file ! END TYPE CH_SURF_t @@ -77,12 +82,14 @@ IF (LHOOK) CALL DR_HOOK("MODD_CH_SURF_N:CH_SURF_INIT",0,ZHOOK_HANDLE) NULLIFY(YCH_SURF%CCH_NAMES) NULLIFY(YCH_SURF%CAER_NAMES) NULLIFY(YCH_SURF%XCONVERSION) -YCH_SURF%CCH_EMIS=' ' -YCH_SURF%CCH_BIOEMIS=' ' -YCH_SURF%CCHEM_SURF_FILE=' ' +YCH_SURF%CCH_EMIS='NONE' +YCH_SURF%CCH_BIOEMIS='NONE' +YCH_SURF%CCH_DMSEMIS='NONE' +YCH_SURF%CCHEM_SURF_FILE='EXSEG1.nam' YCH_SURF%LCH_SURF_EMIS=.FALSE. YCH_SURF%LCH_EMIS=.FALSE. YCH_SURF%LCH_BIOEMIS=.FALSE. +YCH_SURF%LCH_DMSEMIS=.FALSE. IF (LHOOK) CALL DR_HOOK("MODD_CH_SURF_N:CH_SURF_INIT",1,ZHOOK_HANDLE) END SUBROUTINE CH_SURF_INIT diff --git a/src/SURFEX/modd_isban.F90 b/src/SURFEX/modd_isban.F90 index ebab9b6f0..3c996c9c9 100644 --- a/src/SURFEX/modd_isban.F90 +++ b/src/SURFEX/modd_isban.F90 @@ -415,6 +415,7 @@ REAL, POINTER, DIMENSION(:) :: XSNOWFREE_ALB_SOIL! snow free albedo for soil REAL, POINTER, DIMENSION(:) :: XVEG ! vegetation cover fraction (-) ! REAL, POINTER, DIMENSION(:) :: XLAI ! Leaf Area Index (m2/m2) +REAL, POINTER, DIMENSION(:) :: XLAIp ! Leaf Area Index previous (m2/m2) ! REAL, POINTER, DIMENSION(:) :: XEMIS ! surface emissivity (-) REAL, POINTER, DIMENSION(:) :: XZ0 ! surface roughness length (m) @@ -675,7 +676,8 @@ TYPE(ISBA_PE_t), INTENT(INOUT) :: YISBA_PE REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_PE_INIT",0,ZHOOK_HANDLE) ! -NULLIFY(YISBA_PE%XLAI) +NULLIFY(YISBA_PE%XLAI) +NULLIFY(YISBA_PE%XLAIp) NULLIFY(YISBA_PE%XVEG) NULLIFY(YISBA_PE%XEMIS) NULLIFY(YISBA_PE%XZ0) diff --git a/src/SURFEX/modd_megann.F90 b/src/SURFEX/modd_megann.F90 index 3f1e4e1c6..b862c93b7 100644 --- a/src/SURFEX/modd_megann.F90 +++ b/src/SURFEX/modd_megann.F90 @@ -63,6 +63,7 @@ TYPE MEGAN_t REAL :: XMODPREC ! Precipitation correction factor (megan) REAL, POINTER, DIMENSION(:,:) :: XEF ! efficiency factor REAL, POINTER, DIMENSION(:,:) :: XPFT ! PFT factor (veg type) + REAL, POINTER, DIMENSION(:) :: XLAI ! Total LAI for MEGAN INTEGER, POINTER, DIMENSION(:) :: NSLTYP ! USDA soil number category CHARACTER(LEN=16), POINTER, DIMENSION(:) :: CVNAME3D ! name of the scheme species CHARACTER(LEN=16), POINTER, DIMENSION(:) :: CMECH_SPC ! name of the scheme species @@ -70,18 +71,24 @@ TYPE MEGAN_t INTEGER, POINTER, DIMENSION(:) :: NMECH_MAP ! index map the mecanisum species REAL, POINTER, DIMENSION(:) :: XCONV_FAC ! conversion factor of species REAL, POINTER, DIMENSION(:) :: XMECH_MWT ! molecular weight of species - REAL, POINTER, DIMENSION(:) ::XBIOFLX ! molecular weight of species + REAL, POINTER, DIMENSION(:) :: XBIOFLX ! molecular weight of species + REAL, POINTER, DIMENSION(:) :: XT24 !! average T over the past 24h + REAL, POINTER, DIMENSION(:) :: XPPFD24 !! average PAR over the past 24h + REAL, POINTER, DIMENSION(:) :: XPPFD !! par + ! END TYPE MEGAN_t CONTAINS ! + SUBROUTINE MEGAN_INIT(YMEGAN) TYPE(MEGAN_t), INTENT(INOUT) :: YMEGAN REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK("MODD_MEGAN_n:MEGAN_INIT",0,ZHOOK_HANDLE) NULLIFY(YMEGAN%XEF) NULLIFY(YMEGAN%XPFT) +NULLIFY(YMEGAN%XLAI) NULLIFY(YMEGAN%NSLTYP) NULLIFY(YMEGAN%CVNAME3D) NULLIFY(YMEGAN%CMECH_SPC) @@ -90,6 +97,9 @@ NULLIFY(YMEGAN%NMECH_MAP) NULLIFY(YMEGAN%XCONV_FAC) NULLIFY(YMEGAN%XMECH_MWT) NULLIFY(YMEGAN%XBIOFLX) +NULLIFY(YMEGAN%XPPFD24) +NULLIFY(YMEGAN%XT24) +NULLIFY(YMEGAN%XPPFD) YMEGAN%NBIO=0 YMEGAN%NALKA=0 YMEGAN%NALKE=0 @@ -189,6 +199,7 @@ YMEGAN%XDROUGHT=0. YMEGAN%XDAILYPAR=150. YMEGAN%XDAILYTEMP=293. YMEGAN%XMODPREC=0. + IF (LHOOK) CALL DR_HOOK("MODD_MEGAN_n:MEGAN_INIT",1,ZHOOK_HANDLE) END SUBROUTINE MEGAN_INIT diff --git a/src/SURFEX/modd_slt_surf.F90 b/src/SURFEX/modd_slt_surf.F90 index 5a1c91c90..73b5afe64 100644 --- a/src/SURFEX/modd_slt_surf.F90 +++ b/src/SURFEX/modd_slt_surf.F90 @@ -11,16 +11,17 @@ MODULE MODD_SLT_SURF IMPLICIT NONE ! -REAL, PARAMETER :: XDENSITY_SLT = 2.1e3 ! [kg/m3] density of sea salt +REAL, PARAMETER :: XDENSITY_DRYSLT = 2.16e3 ! [kg/m3] density of dry sea salt +REAL, PARAMETER :: XDENSITY_SLT = 1.17e3 ! [kg/m3] density of wet sea salt REAL, PARAMETER :: XMOLARWEIGHT_SLT = 58.e-3 ! [kg/mol] molar weight sea salt ! -INTEGER, PARAMETER :: NEMISMODES_MAX=5 -INTEGER, DIMENSION(NEMISMODES_MAX), PARAMETER :: JORDER_SLT=(/1,2,3,4,5/) !Dust modes in order of importance +INTEGER, PARAMETER :: NEMISMODES_MAX=8 +INTEGER, DIMENSION(NEMISMODES_MAX), PARAMETER :: JORDER_SLT=(/1,2,3,4,5,6,7,8/) !Dust modes in order of importance !Set emission related parameters REAL,DIMENSION(NEMISMODES_MAX) :: XEMISRADIUS_INI_SLT ! number madian radius initialization for sea salt mode (um) REAL,DIMENSION(NEMISMODES_MAX) :: XEMISSIG_INI_SLT ! dispersion initialization for sea salt mode ! - CHARACTER(LEN=5) :: CEMISPARAM_SLT ! Reference to paper where emission parameterization is proposed +CHARACTER(LEN=6) :: CEMISPARAM_SLT ! Reference to paper where emission parameterization is proposed INTEGER :: JPMODE_SLT ! number of sea salt modes (max 3; default = 1) LOGICAL :: LVARSIG_SLT ! switch to active pronostic dispersion for all modes LOGICAL :: LRGFIX_SLT ! switch to active pronostic mean radius for all modes diff --git a/src/SURFEX/modd_surfexn.F90 b/src/SURFEX/modd_surfexn.F90 index 98c87269b..34ee38cf9 100644 --- a/src/SURFEX/modd_surfexn.F90 +++ b/src/SURFEX/modd_surfexn.F90 @@ -62,6 +62,8 @@ USE MODD_TEB_n, ONLY : TEB_NP_t USE MODD_MEGAN_n, ONLY : MEGAN_t USE MODD_MEGAN_SURF_FIELDS_n, ONLY : MEGAN_SURF_FIELDS_t ! +USE MODD_DMS_n, ONLY : DMS_t +USE MODD_DMS_SURF_FIELDS_n, ONLY : DMS_SURF_FIELDS_t !--------------------------------------------------------------------------- ! TYPE FLAKE_MODEL_t @@ -120,6 +122,9 @@ TYPE(SEAFLUX_t) :: S TYPE(OCEAN_t) :: O TYPE(OCEAN_REL_t) :: OR ! +TYPE(DMS_t) :: DMS +TYPE(DMS_SURF_FIELDS_t) :: DSF + END TYPE SEAFLUX_MODEL_t ! !-------------------------------------------------- diff --git a/src/SURFEX/modn_surf_atmn.F90 b/src/SURFEX/modn_surf_atmn.F90 index 2f5a43c7d..f5e3ff9ab 100644 --- a/src/SURFEX/modn_surf_atmn.F90 +++ b/src/SURFEX/modn_surf_atmn.F90 @@ -44,7 +44,7 @@ USE PARKIND1 ,ONLY : JPRB IMPLICIT NONE ! CHARACTER(LEN=28), SAVE :: CCHEM_SURF_FILE -LOGICAL, SAVE :: LCH_SURF_EMIS +LOGICAL, SAVE :: LCH_EMIS, LCH_DMSEMIS, LCH_SURF_EMIS LOGICAL :: LFRAC REAL :: XDIAG_TSTEP INTEGER :: N2M @@ -64,7 +64,7 @@ LOGICAL :: LRESETCUMUL CHARACTER(LEN=LEN_HREC), DIMENSION(4000) :: CSELECT ! NAMELIST/NAM_CH_CONTROLn/CCHEM_SURF_FILE -NAMELIST/NAM_CH_SURFn/LCH_SURF_EMIS +NAMELIST/NAM_CH_SURFn/LCH_EMIS, LCH_DMSEMIS, LCH_SURF_EMIS NAMELIST/NAM_DIAG_SURF_ATMn/LFRAC, LDIAG_GRID, LT2MMW NAMELIST/NAM_DIAG_SURFn/N2M, L2M_MIN_ZS, LSURF_BUDGET, LRAD_BUDGET, LSURF_BUDGETC, & LRESET_BUDGETC, LCOEF, LSURF_VARS @@ -114,7 +114,9 @@ SUBROUTINE INIT_NAM_CH_SURFn (CHU) REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:INIT_NAM_CH_SURFN',0,ZHOOK_HANDLE) + LCH_EMIS = CHU%LCH_EMIS LCH_SURF_EMIS = CHU%LCH_SURF_EMIS + LCH_DMSEMIS = CHU%LCH_DMSEMIS IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:INIT_NAM_CH_SURFN',1,ZHOOK_HANDLE) END SUBROUTINE INIT_NAM_CH_SURFn @@ -129,7 +131,9 @@ SUBROUTINE UPDATE_NAM_CH_SURFn (CHU) REAL(KIND=JPRB) :: ZHOOK_HANDLE IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:UPDATE_NAM_CH_SURFN',0,ZHOOK_HANDLE) + CHU%LCH_EMIS = LCH_EMIS CHU%LCH_SURF_EMIS = LCH_SURF_EMIS + CHU%LCH_DMSEMIS = LCH_DMSEMIS IF (LHOOK) CALL DR_HOOK('MODN_SURF_ATM_N:UPDATE_NAM_CH_SURFN',1,ZHOOK_HANDLE) END SUBROUTINE UPDATE_NAM_CH_SURFn diff --git a/src/SURFEX/pgd_surf_atm.F90 b/src/SURFEX/pgd_surf_atm.F90 index 412f22a84..98539d816 100644 --- a/src/SURFEX/pgd_surf_atm.F90 +++ b/src/SURFEX/pgd_surf_atm.F90 @@ -76,6 +76,7 @@ USE MODI_PGD_CHEMISTRY_SNAP USE MODI_WRITE_COVER_TEX_END USE MODI_INIT_READ_DATA_COVER USE MODI_PGD_MEGAN +USE MODI_PGD_DMS ! USE YOMHOOK ,ONLY : LHOOK, DR_HOOK USE PARKIND1 ,ONLY : JPRB @@ -223,7 +224,7 @@ IF (YSC%U%NDIM_SEA>0) CALL PGD_SEA(YSC%DTCO, YSC%SM%DTS, YSC%SM%G, YSC%SM%S, & !* 10. Chemical Emission fields ! ------------------------ ! - CALL READ_NAM_PGD_CHEMISTRY(HPROGRAM,YSC%CHU%CCH_EMIS,YSC%CHU%CCH_BIOEMIS) + CALL READ_NAM_PGD_CHEMISTRY(HPROGRAM,YSC%CHU%CCH_EMIS,YSC%CHU%CCH_BIOEMIS,YSC%CHU%CCH_DMSEMIS) IF (YSC%CHU%CCH_EMIS=='SNAP') THEN CALL PGD_CHEMISTRY_SNAP(YSC%CHN, YSC%DTCO, YSC%UG, YSC%U, YSC%USS, & HPROGRAM,YSC%CHU%LCH_EMIS) @@ -235,6 +236,10 @@ IF (YSC%CHU%CCH_BIOEMIS=='MEGA') THEN CALL PGD_MEGAN(YSC%DTCO, YSC%UG, YSC%U, YSC%USS, YSC%IM%MSF, & HPROGRAM,YSC%CHU%LCH_BIOEMIS) ENDIF +IF (YSC%CHU%CCH_DMSEMIS=='DMSD') THEN + CALL PGD_DMS(YSC%DTCO, YSC%UG, YSC%U, YSC%USS, YSC%SM%DSF, & + HPROGRAM,YSC%CHU%LCH_DMSEMIS) +ENDIF !_______________________________________________________________________________ ! !* 11. Writing in cover latex file diff --git a/src/SURFEX/put_sfxcpln.F90 b/src/SURFEX/put_sfxcpln.F90 index 99066282d..f1f2df37c 100644 --- a/src/SURFEX/put_sfxcpln.F90 +++ b/src/SURFEX/put_sfxcpln.F90 @@ -3,7 +3,7 @@ !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt !SFX_LIC for details. version 1. ! ######### -SUBROUTINE PUT_SFXCPL_n (F, IM, S, U, W, & +SUBROUTINE PUT_SFXCPL_n (F, IM, S, U, W, TM, GDM, GRM, & HPROGRAM,KI,KSW,PSW_BANDS,PZENITH, & PLAND_WTD,PLAND_FWTD,PLAND_FFLOOD, & PLAND_PIFLOOD,PSEA_SST,PSEA_UCU, & @@ -49,7 +49,8 @@ SUBROUTINE PUT_SFXCPL_n (F, IM, S, U, W, & ! ------------ ! USE MODD_FLAKE_n, ONLY : FLAKE_t -USE MODD_SURFEX_n, ONLY : ISBA_MODEL_t +USE MODD_SURFEX_n, ONLY : ISBA_MODEL_t, TEB_MODEL_t, & + TEB_GARDEN_MODEL_t,TEB_GREENROOF_MODEL_t USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t USE MODD_WATFLUX_n, ONLY : WATFLUX_t @@ -83,6 +84,9 @@ TYPE(ISBA_MODEL_t), INTENT(INOUT) :: IM TYPE(SEAFLUX_t), INTENT(INOUT) :: S TYPE(SURF_ATM_t), INTENT(INOUT) :: U TYPE(WATFLUX_t), INTENT(INOUT) :: W +TYPE(TEB_MODEL_t), INTENT(INOUT) :: TM +TYPE(TEB_GARDEN_MODEL_t), INTENT(INOUT) :: GDM +TYPE(TEB_GREENROOF_MODEL_t), INTENT(INOUT) :: GRM ! CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM INTEGER, INTENT(IN) :: KI ! number of points @@ -174,8 +178,8 @@ ENDIF !------------------------------------------------------------------------------- ! IF(LCPL_SEA.OR.LCPL_FLOOD)THEN - CALL UPDATE_ESM_SURF_ATM_n(F, IM, S, U, W, HPROGRAM, KI, KSW, PZENITH, PSW_BANDS, & - PTSRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF ) + CALL UPDATE_ESM_SURF_ATM_n(F, IM, S, U, W, TM, GDM, GRM, HPROGRAM, KI, KSW, PZENITH, & + PSW_BANDS, PTSRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF ) ENDIF ! !------------------------------------------------------------------------------- diff --git a/src/SURFEX/read_nam_pgd_chemistry.F90 b/src/SURFEX/read_nam_pgd_chemistry.F90 index 30abbf33b..97115b11a 100644 --- a/src/SURFEX/read_nam_pgd_chemistry.F90 +++ b/src/SURFEX/read_nam_pgd_chemistry.F90 @@ -3,7 +3,7 @@ !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt !SFX_LIC for details. version 1. ! ######### - SUBROUTINE READ_NAM_PGD_CHEMISTRY(HPROGRAM, HCH_EMIS, HCH_BIOEMIS ) + SUBROUTINE READ_NAM_PGD_CHEMISTRY(HPROGRAM, HCH_EMIS, HCH_BIOEMIS, HCH_DMSEMIS) ! ############################################################## ! !!**** *READ_NAM_PGD_CHEMISTRY* reads namelist for CHEMISTRY @@ -34,6 +34,7 @@ !! !! Original 09/2011 !! M. Leriche 06/17 add coupling MEGAN +!! P. Tulet 06/21 add DMS data base !---------------------------------------------------------------------------- ! !* 0. DECLARATION @@ -59,6 +60,7 @@ IMPLICIT NONE CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program CHARACTER(LEN=4), INTENT(OUT) :: HCH_EMIS ! Option for emissions computations CHARACTER(LEN=4), INTENT(OUT) :: HCH_BIOEMIS ! Option for activating MEGAN coupling +CHARACTER(LEN=4), INTENT(OUT) :: HCH_DMSEMIS ! Option for activating DMS fluxes ! !* 0.2 Declaration of local variables ! ------------------------------ @@ -72,9 +74,10 @@ LOGICAL :: GFOUND ! flag when namelist is present ! CHARACTER(LEN=4) :: CCH_EMIS CHARACTER(LEN=4) :: CCH_BIOEMIS +CHARACTER(LEN=4) :: CCH_DMSEMIS REAL(KIND=JPRB) :: ZHOOK_HANDLE ! -NAMELIST/NAM_CH_EMISSIONS/ CCH_EMIS, CCH_BIOEMIS +NAMELIST/NAM_CH_EMISSIONS/ CCH_EMIS, CCH_BIOEMIS, CCH_DMSEMIS ! !------------------------------------------------------------------------------- ! @@ -84,6 +87,7 @@ NAMELIST/NAM_CH_EMISSIONS/ CCH_EMIS, CCH_BIOEMIS IF (LHOOK) CALL DR_HOOK('READ_NAM_PGD_CHEMISTRY',0,ZHOOK_HANDLE) CCH_EMIS = 'NONE' CCH_BIOEMIS = 'NONE' +CCH_DMSEMIS = 'NONE' ! CALL GET_LUOUT(HPROGRAM,ILUOUT) ! @@ -99,6 +103,7 @@ IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_CH_EMISSIONS) ! CALL TEST_NAM_VAR_SURF(ILUOUT,'CCH_EMIS',CCH_EMIS,'NONE','AGGR','SNAP') CALL TEST_NAM_VAR_SURF(ILUOUT,'CCH_BIOEMIS',CCH_BIOEMIS,'NONE','MEGA') +CALL TEST_NAM_VAR_SURF(ILUOUT,'CCH_DMSEMIS',CCH_DMSEMIS,'NONE','DMSD') ! CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM) ! @@ -106,6 +111,7 @@ CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM) ! HCH_EMIS = CCH_EMIS HCH_BIOEMIS = CCH_BIOEMIS +HCH_DMSEMIS = CCH_DMSEMIS ! IF (LHOOK) CALL DR_HOOK('READ_NAM_PGD_CHEMISTRY',1,ZHOOK_HANDLE) ! diff --git a/src/SURFEX/surfex_alloc.F90 b/src/SURFEX/surfex_alloc.F90 index 41b4953c3..ca482ecd3 100644 --- a/src/SURFEX/surfex_alloc.F90 +++ b/src/SURFEX/surfex_alloc.F90 @@ -66,6 +66,9 @@ USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_INIT USE MODD_ISBA_n, ONLY : ISBA_S_INIT, ISBA_K_INIT, ISBA_P_INIT, & ISBA_NK_INIT, ISBA_NP_INIT, ISBA_NPE_INIT ! +USE MODD_DMS_n, ONLY : DMS_INIT +USE MODD_DMS_SURF_FIELDS_n, ONLY : DMS_SURF_FIELDS_INIT + USE MODD_MEGAN_n, ONLY : MEGAN_INIT USE MODD_MEGAN_SURF_FIELDS_n, ONLY : MEGAN_SURF_FIELDS_INIT ! @@ -156,6 +159,9 @@ IF (LHOOK) CALL DR_HOOK("SURFEX_ALLOC",0,ZHOOK_HANDLE) CALL MEGAN_INIT(YDSURFEX%IM%MGN) CALL MEGAN_SURF_FIELDS_INIT(YDSURFEX%IM%MSF) ! + CALL DMS_INIT(YDSURFEX%SM%DMS) + CALL DMS_SURF_FIELDS_INIT(YDSURFEX%SM%DSF) + ! CALL DIAG_NP_INIT(YDSURFEX%GDM%VD%ND,NTEB_PATCH_MAX) CALL DIAG_EVAP_ISBA_NP_INIT(YDSURFEX%GDM%VD%NDE,NTEB_PATCH_MAX) CALL DIAG_EVAP_ISBA_NP_INIT(YDSURFEX%GDM%VD%NDEC,NTEB_PATCH_MAX) diff --git a/src/SURFEX/update_esm_surf_atmn.F90 b/src/SURFEX/update_esm_surf_atmn.F90 index f935bf35c..6d1ec2612 100644 --- a/src/SURFEX/update_esm_surf_atmn.F90 +++ b/src/SURFEX/update_esm_surf_atmn.F90 @@ -3,8 +3,8 @@ !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt !SFX_LIC for details. version 1. ! ################################################################################# -SUBROUTINE UPDATE_ESM_SURF_ATM_n (F, IM, S, U, W, HPROGRAM, KI, KSW, PZENITH, PSW_BANDS, & - PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF ) +SUBROUTINE UPDATE_ESM_SURF_ATM_n (F, IM, S, U, W, TM, GDM, GRM, HPROGRAM, KI, KSW, PZENITH, & + PSW_BANDS, PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF ) ! ################################################################################# ! !!**** *UPDATE_ESM_SURF_ATM_n * - Routine to update radiative properties in Earth @@ -30,14 +30,17 @@ SUBROUTINE UPDATE_ESM_SURF_ATM_n (F, IM, S, U, W, HPROGRAM, KI, KSW, PZENITH, PS !! ------------- !! Original 09/2009 !! B. Decharme 06/2013 new coupling variables +!! C. Lebeaupin 01/2020 add teb option +!! !!------------------------------------------------------------- ! ! -USE MODD_FLAKE_n, ONLY : FLAKE_t -USE MODD_SURFEX_n, ONLY : ISBA_MODEL_t -USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t -USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t -USE MODD_WATFLUX_n, ONLY : WATFLUX_t +USE MODD_FLAKE_n, ONLY : FLAKE_t +USE MODD_SURFEX_n, ONLY : ISBA_MODEL_t,TEB_MODEL_t, & + TEB_GARDEN_MODEL_t,TEB_GREENROOF_MODEL_t +USE MODD_SEAFLUX_n, ONLY : SEAFLUX_t +USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t +USE MODD_WATFLUX_n, ONLY : WATFLUX_t ! USE MODD_SURF_PAR, ONLY : XUNDEF ! @@ -56,23 +59,28 @@ USE MODI_UPDATE_ESM_ISBA_n USE MODI_UPDATE_ESM_SEAFLUX_n USE MODI_UPDATE_ESM_WATFLUX_n USE MODI_UPDATE_ESM_FLAKE_n +USE MODI_UPDATE_ESM_TEB_n ! IMPLICIT NONE ! !* 0.1 declarations of arguments ! ! -TYPE(FLAKE_t), INTENT(INOUT) :: F +TYPE(FLAKE_t), INTENT(INOUT) :: F TYPE(ISBA_MODEL_t), INTENT(INOUT) :: IM -TYPE(SEAFLUX_t), INTENT(INOUT) :: S -TYPE(SURF_ATM_t), INTENT(INOUT) :: U -TYPE(WATFLUX_t), INTENT(INOUT) :: W +TYPE(SEAFLUX_t), INTENT(INOUT) :: S +TYPE(SURF_ATM_t), INTENT(INOUT) :: U +TYPE(WATFLUX_t), INTENT(INOUT) :: W +TYPE(TEB_MODEL_t), INTENT(INOUT) :: TM +TYPE(TEB_GARDEN_MODEL_t), INTENT(INOUT) :: GDM +TYPE(TEB_GREENROOF_MODEL_t), INTENT(INOUT) :: GRM + ! - CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes + CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes INTEGER, INTENT(IN) :: KI ! number of points INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands -REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! zenithal angle (radian from the vertical) -REAL, DIMENSION(KSW), INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m) +REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! zenithal angle (radian from the vertical) +REAL, DIMENSION(KSW), INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m) ! REAL, DIMENSION(KI), INTENT(OUT) :: PTRAD ! radiative temperature (K) REAL, DIMENSION(KI,KSW),INTENT(OUT) :: PDIR_ALB ! direct albedo for each spectral band (-) @@ -108,7 +116,9 @@ GNATURE = (U%NSIZE_NATURE >0 .AND. U%CNATURE/='NONE') ! GTOWN = U%NSIZE_TOWN >0 IF(GTOWN)THEN - CALL ABOR1_SFX('UPDATE_ESM_SURF_ATM_n: TOWN SCHEME NOT YET AVAILABLE FOR EARTH SYSTEM MODEL') + IF ((HPROGRAM/='OFFLIN').AND.(HPROGRAM/='MESONH').AND.(HPROGRAM/='AROME ')) THEN + CALL ABOR1_SFX('UPDATE_ESM_SURF_ATM_n: TOWN SCHEME NOT YET AVAILABLE FOR EARTH SYSTEM MODEL') + ENDIF ENDIF ! ! Tile counter: @@ -175,17 +185,16 @@ ENDIF ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! URBAN Tile calculations: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Not yet implemented ! -!JTILE = JTILE + 1 +JTILE = JTILE + 1 ! -!IF(GTOWN)THEN +IF(GTOWN)THEN ! -! ZFRAC_TILE(:,JTILE) = XTOWN(:) + ZFRAC_TILE(:,JTILE) = U%XTOWN(:) ! -! CALL TREAT_SURF(NSIZE_TOWN,NR_TOWN,JTILE) + CALL TREAT_SURF(U%NSIZE_TOWN,U%NR_TOWN,JTILE) ! -!ENDIF +ENDIF ! ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! Grid box average radiative properties: @@ -265,13 +274,15 @@ ELSEIF (KTILE==3) THEN CALL ABOR1_SFX('UPDATE_ESM_SURF_ATM_n: NATURE SCHEME MUST BE ACTIVATED FOR EARTH SYSTEM MODEL') ENDIF ! -!ELSEIF (KTILE==4) THEN -! ! -! IF (CTOWN=='TEB ') THEN -! CALL UPDATE_ESM_TEB_n(NSIZE_SEA,KSW,ZP_ZENITH,ZP_TRAD,ZP_DIR_ALB,ZP_SCA_ALB,ZP_EMIS,ZP_TSURF) -! ELSE -! CALL ABOR1_SFX('UPDATE_ESM_SURF_ATM_n: TEB SCHEME MUST BE ACTIVATED FOR EARTH SYSTEM MODEL') -! ENDIF +ELSEIF (KTILE==4) THEN + ! + IF (U%CTOWN=='TEB ') THEN + CALL UPDATE_ESM_TEB_n(TM%TOP, TM%TPN, TM%NT, TM%NB, GDM, GRM, U%NSIZE_TOWN, & + KSW,ZP_ZENITH,PSW_BANDS,ZP_DIR_ALB,ZP_SCA_ALB,& + ZP_EMIS,ZP_TRAD,ZP_TSURF) + ELSE + CALL ABOR1_SFX('UPDATE_ESM_SURF_ATM_n: TEB SCHEME MUST BE ACTIVATED FOR EARTH SYSTEM MODEL') + ENDIF ! ! ENDIF ! diff --git a/src/SURFEX/write_diag_pgd_isban.F90 b/src/SURFEX/write_diag_pgd_isban.F90 index 96417bb19..a3d13829f 100644 --- a/src/SURFEX/write_diag_pgd_isban.F90 +++ b/src/SURFEX/write_diag_pgd_isban.F90 @@ -142,6 +142,20 @@ IF (IO%CPHOTO=='NON' .OR. IO%CPHOTO=='AST') THEN ! ENDIF ! +!* Leaf Area Index previous +! +IF (IO%CPHOTO=='NON' .OR. IO%CPHOTO=='AST') THEN + ! + YRECFM='LAIp' + YCOMMENT='leaf area index previous (-)' + ! + DO JP = 1,IO%NPATCH + CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& + NP%AL(JP)%NR_P,NPE%AL(JP)%XLAIp(:),ILU,S%XWORK_WR) + ENDDO + ! +ENDIF + !------------------------------------------------------------------------------- ! !* Vegetation fraction diff --git a/src/SURFEX/write_diag_seb_isban.F90 b/src/SURFEX/write_diag_seb_isban.F90 index 578764bfa..620b40f7c 100644 --- a/src/SURFEX/write_diag_seb_isban.F90 +++ b/src/SURFEX/write_diag_seb_isban.F90 @@ -661,18 +661,20 @@ IF (CHI%LCH_NO_FLUX) THEN END IF END IF ! -IF (CHI%SVI%NDSTEQ > 0)THEN - ! - DO JSV = 1,NDSTMDE ! for all dust modes - WRITE(YRECFM,'(A5,I3.3)')'F_DST',JSV - YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDST%AL(JP)%XSFDST(:,JSV),ISIZE,S%XWORK_WR) - ENDDO - END DO - ! -ENDIF +!UPG*PT - cette ecriture ne fonctionne pas chez moi. Testée ?? +!IF (CHI%SVI%NDSTEQ > 0)THEN +! ! +! DO JSV = 1,NDSTMDE ! for all dust modes +! WRITE(YRECFM,'(A5,I3.3)')'F_DST',JSV +! YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)' +! DO JP = 1,IO%NPATCH +! CALL WRITE_FIELD_1D_PATCH(DUO%CSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& +! NP%AL(JP)%NR_P,NDST%AL(JP)%XSFDST(:,JSV),ISIZE,S%XWORK_WR) +! ENDDO +! END DO +! ! +!ENDIF +!UPG*PT ! ! ! Blowing snow variables diff --git a/src/SURFEX/write_pgd_surf_atmn.F90 b/src/SURFEX/write_pgd_surf_atmn.F90 index 116cdfc7f..9c6df17d0 100644 --- a/src/SURFEX/write_pgd_surf_atmn.F90 +++ b/src/SURFEX/write_pgd_surf_atmn.F90 @@ -34,6 +34,7 @@ !! ------------- !! Original 05/2011 according to previous write_surf_atmn.f90 !! P.Tulet & M. Leriche 06/2017 add coupling MEGAN +!! P.Tulet 2021 DMS field data !------------------------------------------------------------------------------- ! !* 0. DECLARATIONS @@ -64,6 +65,7 @@ USE MODI_WRITESURF_DUMMY_n USE MODI_WRITESURF_SNAP_n USE MODI_WRITESURF_CH_EMIS_n USE MODI_WRITESURF_MEGAN_n +USE MODI_WRITESURF_DMS_n ! USE MODI_WRITE_GRID ! @@ -151,10 +153,11 @@ IF (YSC%CHU%LCH_EMIS) THEN END IF ! ! MEGAN coupling + +IF (YSC%U%NDIM_NATURE>0) THEN YCOMMENT='CH_BIOEMIS' CALL WRITE_SURF(YSC%DUO%CSELECT, HPROGRAM,'CH_BIOEMIS',YSC%CHU%LCH_BIOEMIS,IRESP,HCOMMENT=YCOMMENT) -IF (YSC%CHU%LCH_BIOEMIS) THEN - CALL WRITESURF_MEGAN_n(YSC%DUO%CSELECT, YSC%IM%MSF, HPROGRAM) + IF (YSC%CHU%LCH_BIOEMIS) CALL WRITESURF_MEGAN_n(YSC%DUO%CSELECT, YSC%IM%MSF, HPROGRAM) ENDIF ! IF (YSC%CHU%LCH_EMIS) THEN @@ -165,6 +168,13 @@ IF (YSC%CHU%LCH_EMIS) THEN ENDIF ENDIF ! +! DMS fluxes +IF (YSC%U%NDIM_SEA>0) THEN + YCOMMENT='CH_DMSEMIS' + CALL WRITE_SURF(YSC%DUO%CSELECT, HPROGRAM,'CH_DMSEMIS',YSC%CHU%LCH_DMSEMIS,IRESP,HCOMMENT=YCOMMENT) + IF (YSC%CHU%LCH_DMSEMIS) CALL WRITESURF_DMS_n(YSC%DUO%CSELECT, YSC%SM%DSF, HPROGRAM) +ENDIF + ! End of IO ! CALL END_IO_SURF_n(HPROGRAM) diff --git a/src/SURFEX/writesurf_isban.F90 b/src/SURFEX/writesurf_isban.F90 index d991d9417..5bf478d24 100644 --- a/src/SURFEX/writesurf_isban.F90 +++ b/src/SURFEX/writesurf_isban.F90 @@ -520,16 +520,19 @@ IF (IO%CRESPSL=='CNT') THEN ENDIF ! ! -IF (CHI%SVI%NDSTEQ > 0)THEN - DO JSV = 1,NDSTMDE ! for all dust modes - WRITE(YRECFM,'(A6,I3.3)')'F_DSTM',JSV - YCOMMENT='X_Y_'//YRECFM//' (kg/m2)' - DO JP = 1,IO%NPATCH - CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& - NP%AL(JP)%NR_P,NDST%AL(JP)%XSFDSTM(:,JSV),KI,S%XWORK_WR) - ENDDO - END DO -ENDIF +!UPG*PT +! Je ne sais pas qui a codé cette ecriture mais chez moi ca plante. Pourtant XSFDSTM est bien calculé dans coupling_isban +!IF (CHI%SVI%NDSTEQ > 0)THEN +! DO JSV = 1,NDSTMDE ! for all dust modes +! WRITE(YRECFM,'(A6,I3.3)')'F_DSTM',JSV +! YCOMMENT='X_Y_'//YRECFM//' (kg/m2)' +! DO JP = 1,IO%NPATCH +! CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,& +! NP%AL(JP)%NR_P,NDST%AL(JP)%XSFDSTM(:,JSV),KI,S%XWORK_WR) +! ENDDO +! END DO +!ENDIF +!UPG*PT ! !------------------------------------------------------------------------------- -- GitLab