diff --git a/.gitmodules b/.gitmodules index 0f20704b75..4934766065 100644 --- a/.gitmodules +++ b/.gitmodules @@ -80,7 +80,7 @@ url = https://github.com/MPAS-Dev/MPAS-Model.git fxrequired = AlwaysRequired fxsparse = ../.mpas_sparse_checkout - fxtag = b8c33daa + fxtag = v8.2.1 fxDONOTUSEurl = https://github.com/MPAS-Dev/MPAS-Model.git [submodule "cosp2"] @@ -182,7 +182,7 @@ fxDONOTUSEurl = https://github.com/ESCOMP/CESM_CICE [submodule "clm"] path = components/clm url = https://github.com/ESCOMP/CTSM -fxtag = ctsm5.2.009 +fxtag = ctsm5.2.027 fxrequired = ToplevelRequired fxDONOTUSEurl = https://github.com/ESCOMP/CTSM @@ -192,4 +192,3 @@ url = https://github.com/ESCOMP/FMS_interface fxtag = fi_240516 fxrequired = ToplevelRequired fxDONOTUSEurl = https://github.com/ESCOMP/FMS_interface - diff --git a/bld/build-namelist b/bld/build-namelist index 0b3262c84d..a96d1f4514 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -578,6 +578,14 @@ if ($cfg->get('debug')) { my $prescribe_aerosols = $TRUE; if ($simple_phys) {$prescribe_aerosols = $FALSE;} +# CTSM Dust emissions scheme +my $soil_erod_atm = $FALSE; +add_default($nl, 'dust_emis_method'); +if ( $nl->get_value('dust_emis_method') =~ /Zender/ ) { + add_default($nl, 'zender_soil_erod_source'); + if ($nl->get_value('zender_soil_erod_source') =~ /atm/) {$soil_erod_atm = $TRUE;} +} + # Chemistry deposition lists if ( ($chem ne 'none') or ( $prog_species ) ){ my $chem_proc_src = $cfg->get('chem_proc_src'); @@ -600,8 +608,9 @@ if ( ($chem ne 'none') or ( $prog_species ) ){ ($aer_wetdep_list =~ /ncl/i || $aer_wetdep_list =~ /sslt/i)) { $prescribe_aerosols = $FALSE; } - - add_default($nl, 'aer_wetdep_list', 'val'=>$aer_wetdep_list ); + if ($chem !~ /_mam/) { + add_default($nl, 'aer_wetdep_list', 'val'=>$aer_wetdep_list ); + } if (!($chem =~ /_mam/)) { if (!defined $nl->get_value('aer_sol_facti')) { @@ -756,7 +765,7 @@ if ($rad_pkg =~ /rrtmg/ or $chem =~ /waccm/) { elsif (!$simple_phys) { if ($chem eq 'none' and !($prog_species =~ /SO4/) ) { # Spectral solar data is needed for photolysis - # this preserves the default cam3 and cam4 configurations which do not have chemistry + # this preserves the default cam4 configuration which does not have chemistry unless (defined $nl->get_value('solar_irrad_data_file')) { add_default($nl, 'solar_const'); } @@ -835,17 +844,8 @@ if ($test_tracer_num > 0) { if ($cfg->get('age_of_air_trcs')) { add_default($nl, 'aoa_tracers_flag', 'val'=>'.true.'); } -# If phys option is "cam3" then turn on the CAM3 prescribed ozone and aerosols -if ($phys eq 'cam3' and !$aqua_mode) { - add_default($nl, 'cam3_ozone_data_on', 'val'=>'.true.'); - add_default($nl, 'cam3_aero_data_on', 'val'=>'.true.'); -} - # Defaults for radiatively active constituents -my $cam3_ozone_data = $FALSE; -my $cam3_aero_data = $FALSE; - my $moz_ozone_data = $FALSE; if (!$rad_prog_ozone) { $moz_ozone_data = $TRUE; @@ -856,24 +856,6 @@ if (!($rad_prog_ocarb) or !($rad_prog_bcarb) or !($rad_prog_sulf) or !($rad_prog $moz_aero_data = $TRUE; } -# CAM3 prescribed ozone only by request -if (defined $nl->get_value('cam3_ozone_data_on') and - $nl->get_value('cam3_ozone_data_on') =~ /$TRUE/io) { - add_default($nl, 'bndtvo'); - $cam3_ozone_data = $TRUE; - $moz_ozone_data = $FALSE; -} - -# CAM3 prescribed aerosols only by request -if (defined $nl->get_value('cam3_aero_data_on') and - $nl->get_value('cam3_aero_data_on') =~ /$TRUE/io) { - - # CAM3 aerosol mass climatology dataset (horizontal resolution dependent) - add_default($nl, 'bndtvaer'); - $cam3_aero_data = $TRUE; - $moz_aero_data = $FALSE; -} - if ($chem_rad_passive or $aqua_mode) { add_default($nl, 'atm_dep_flux', 'val'=>'.false.'); } @@ -922,8 +904,6 @@ if ($rad_prog_ozone) { add_default($nl, 'prescribed_ozone_type'); add_default($nl, 'prescribed_ozone_cycle_yr'); } -} elsif ($cam3_ozone_data =~ /$TRUE/io) { - $radval .= ",'N:O3:O3'"; } else { die "ERROR: can not set ozone rad_climate specification\n"; } @@ -1110,9 +1090,6 @@ if ($aer_model eq 'mam' ) { } elsif ($moz_aero_data =~ /$TRUE/io) { push(@aero_names, "sulf"); push(@aerosources, "N:" ); - } elsif ($cam3_aero_data =~ /$TRUE/io) { - push(@aero_names, "cam3_sul" ); - push(@aerosources, "N:" ); } else { die "ERROR: can not set sulf rad_climate specification\n"; } @@ -1123,9 +1100,6 @@ if ($aer_model eq 'mam' ) { } elsif ($moz_aero_data =~ /$TRUE/io) { push(@aero_names, "dust1", "dust2", "dust3", "dust4"); push(@aerosources, "N:", "N:", "N:", "N:" ); - } elsif ($cam3_aero_data =~ /$TRUE/io) { - push(@aero_names, "cam3_dust1", "cam3_dust2", "cam3_dust3", "cam3_dust4" ); - push(@aerosources, "N:", "N:", "N:", "N:" ); } else { die "ERROR: can not set dust rad_climate specification\n"; } @@ -1136,9 +1110,6 @@ if ($aer_model eq 'mam' ) { } elsif ($moz_aero_data =~ /$TRUE/io) { push(@aero_names, "bcar1", "bcar2"); push(@aerosources, "N:", "N:" ); - } elsif ($cam3_aero_data =~ /$TRUE/io) { - push(@aero_names, "cam3_bcpho", "cam3_bcphi"); - push(@aerosources, "N:", "N:" ); } else { die "ERROR: can not set black carbon rad_climate specification\n"; } @@ -1149,9 +1120,6 @@ if ($aer_model eq 'mam' ) { } elsif ($moz_aero_data =~ /$TRUE/io) { push(@aero_names, "ocar1", "ocar2"); push(@aerosources, "N:", "N:" ); - } elsif ($cam3_aero_data =~ /$TRUE/io) { - push(@aero_names, "cam3_ocpho", "cam3_ocphi"); - push(@aerosources, "N:", "N:" ); } else { die "ERROR: can not set organic carbon rad_climate specification\n"; } @@ -1172,9 +1140,6 @@ if ($aer_model eq 'mam' ) { push(@aero_names, "SSLTA", "SSLTC"); push(@aerosources, "N:", "N:"); } - } elsif ($cam3_aero_data =~ /$TRUE/io ) { - push(@aero_names, "cam3_ssam", "cam3_sscm"); - push(@aerosources, "N:", "N:" ); } else { die "ERROR: can not set sslt rad_climate specification\n"; } @@ -1195,7 +1160,7 @@ if ( $prescribed_aero_model ne 'none' ) { # Prescribed aerosol deposition fluxes. # Not needed if in aquaplanet mode. - if ( (($moz_aero_data =~ /$TRUE/io) or ($cam3_aero_data =~ /$TRUE/io)) and !$aqua_mode ) { + if ( $moz_aero_data =~ /$TRUE/io and !$aqua_mode ) { # If user has not set aerodep_flx_file, then use defaults unless (defined $nl->get_value('aerodep_flx_file')) { my @settings = ('aerodep_flx_datapath', 'aerodep_flx_file', 'aerodep_flx_type', @@ -1801,7 +1766,7 @@ if ( $prog_species ) { add_default($nl, 'ghg_chem', 'val'=>".true."); add_default($nl, 'bndtvg'); } - if ( $prog_species =~ /DST/ ) { + if ( $prog_species =~ /DST/ and $soil_erod_atm =~ /$TRUE/) { add_default($nl, 'soil_erod_file' ); } @@ -2091,9 +2056,11 @@ if ($chem =~ /geoschem/) { add_default($nl, 'flbc_cycle_yr', 'val'=>'2000'); } - my @files; # Datasets - @files = ( 'soil_erod_file', 'flbc_file' ); + my @files = ( 'flbc_file' ); + if ($soil_erod_atm =~ /$TRUE/) { + @files = ( @files, 'soil_erod_file' ); + } foreach my $file (@files) { add_default($nl, $file); } @@ -2132,12 +2099,15 @@ if ($chem =~ /trop_mozart/ or $chem =~ /trop_strat/ or $chem =~ /waccm_tsmlt/) { my @files; # Datasets if ($chem =~ /trop_strat/ or $chem =~ /waccm_tsmlt/) { - @files = ( 'soil_erod_file', 'flbc_file', + @files = ( 'flbc_file', 'xs_coef_file','xs_short_file','xs_long_file', 'rsf_file' ); } else { - @files = ( 'soil_erod_file', 'flbc_file', + @files = ( 'flbc_file', 'xs_coef_file','xs_short_file','xs_long_file', 'rsf_file', 'exo_coldens_file', 'sulf_file' ); } + if ($soil_erod_atm =~ /$TRUE/) { + @files = ( @files, 'soil_erod_file' ); + } foreach my $file (@files) { add_default($nl, $file); } @@ -2235,8 +2205,10 @@ if ($chem eq 'trop_mam3') { add_default($nl, 'flbc_list', 'val'=>"' '"); # Datasets - my @files = ('soil_erod_file', - 'xs_long_file', 'rsf_file', 'exo_coldens_file' ); + my @files = ( 'xs_long_file', 'rsf_file', 'exo_coldens_file' ); + if ($soil_erod_atm =~ /$TRUE/) { + @files = ( @files, 'soil_erod_file' ); + } foreach my $file (@files) { add_default($nl, $file); } @@ -2740,8 +2712,10 @@ if (($chem eq 'trop_mam4') or ($chem eq 'waccm_sc_mam4') or ($chem eq 'ghg_mam4' add_default($nl, 'flbc_list', 'val'=>"' '"); # Datasets - my @files = ('soil_erod_file', - 'xs_long_file', 'rsf_file', 'exo_coldens_file' ); + my @files = ('xs_long_file', 'rsf_file', 'exo_coldens_file' ); + if ($soil_erod_atm =~ /$TRUE/) { + @files = ( @files, 'soil_erod_file' ); + } foreach my $file (@files) { add_default($nl, $file); } @@ -2829,8 +2803,10 @@ if ($chem eq 'trop_mam7') { add_default($nl, 'flbc_list', 'val'=>"' '"); # Datasets - my @files = ('soil_erod_file', - 'xs_long_file', 'rsf_file', 'exo_coldens_file' ); + my @files = ('xs_long_file', 'rsf_file', 'exo_coldens_file' ); + if ($soil_erod_atm =~ /$TRUE/) { + @files = ( @files, 'soil_erod_file' ); + } foreach my $file (@files) { add_default($nl, $file); } @@ -2889,8 +2865,10 @@ if ($chem =~ /waccm_ma/ or $chem =~ /waccm_tsmlt/) { 'photon_file', 'electron_file', 'igrf_geomag_coefs_file', 'euvac_file', 'solar_parms_data_file', 'depvel_lnd_file', - 'xs_coef_file', 'xs_short_file','xs_long_file', 'rsf_file', - 'soil_erod_file' ); + 'xs_coef_file', 'xs_short_file','xs_long_file', 'rsf_file' ); + if ($soil_erod_atm =~ /$TRUE/) { + @files = ( @files, 'soil_erod_file' ); + } if (!$waccmx) { @files = (@files, 'tgcm_ubc_file', 'snoe_ubc_file' ); } @@ -3203,9 +3181,10 @@ if (($chem ne 'none') and ($chem ne 'terminator') and !($chem =~ /geoschem/)) { # Deep convection scheme add_default($nl, 'deep_scheme'); +my $deep_scheme = $nl->get_value('deep_scheme'); # Aerosol convective processes -if (($phys =~ /cam6/ or $phys =~ /cam7/) and $nl->get_value('deep_scheme') =~ /ZM/) { +if (($phys =~ /cam6/ or $phys =~ /cam7/) and $deep_scheme =~ /ZM/) { add_default($nl, 'convproc_do_aer', 'val'=>'.true.'); add_default($nl, 'convproc_do_evaprain_atonce', 'val'=>'.true.'); add_default($nl, 'convproc_pom_spechygro', 'val'=>'0.2D0'); @@ -3213,7 +3192,7 @@ if (($phys =~ /cam6/ or $phys =~ /cam7/) and $nl->get_value('deep_scheme') =~ /Z } # cam7 specific namelists -if ($phys =~ /cam7/ and $nl->get_value('deep_scheme') =~ /ZM/) { +if ($phys =~ /cam7/ and $deep_scheme =~ /ZM/) { add_default($nl, 'zmconv_parcel_pbl', 'val'=>'.true.'); } else { add_default($nl, 'zmconv_parcel_pbl', 'val'=>'.false.'); @@ -3753,19 +3732,15 @@ if ($cfg->get('microphys') eq 'rk') { } # Dust emissions tuning factor -# If dust is prognostic ==> supply the tuning factor -if ( length($nl->get_value('soil_erod_file'))>0 ) { - # check whether turbulent mountain stress parameterization is on - if ($nl->get_value('do_tms') =~ /$TRUE/io) { - add_default($nl, 'dust_emis_fact', 'tms'=>'1'); +# check whether turbulent mountain stress parameterization is on +if ($nl->get_value('do_tms') =~ /$TRUE/io) { + add_default($nl, 'dust_emis_fact', 'tms'=>'1'); +} else { + if ($chem =~ /trop_strat/ or $chem =~ /geoschem/ or $chem =~ /waccm_ma/ or $chem =~ /waccm_tsmlt/ or $chem =~ /trop_mozart/) { + add_default($nl, 'dust_emis_fact', 'ver'=>'chem'); } else { - if ($chem =~ /trop_strat/ or $chem =~ /geoschem/ or $chem =~ /waccm_ma/ or $chem =~ /waccm_tsmlt/ or $chem =~ /trop_mozart/) { - add_default($nl, 'dust_emis_fact', 'ver'=>'chem'); - } - else { - add_default($nl, 'dust_emis_fact'); - } + add_default($nl, 'dust_emis_fact'); } } if (chem_has_species($cfg, 'NO')) { @@ -3831,12 +3806,13 @@ if (!$simple_phys) { add_default($nl, 'gw_rdg_do_divstream' , 'val'=>'.true.'); } +my $use_gw_convect_dp = '.false.'; if ($waccm_phys or (!$simple_phys and $cfg->get('model_top') eq 'mt')) { # Spectral gravity waves are part of WACCM physics, and also drive the # QBO in the high vertical resolution configuration. add_default($nl, 'use_gw_front' , 'val'=>'.true.'); - add_default($nl, 'use_gw_convect_dp', 'val'=>'.true.'); + $use_gw_convect_dp = '.true.'; my $hdepth_scaling = '0.25D0' ; my $qbo_forcing = '.false.'; if ($dyn eq 'fv') { @@ -3858,12 +3834,16 @@ if ($waccm_phys or } elsif ($phys =~ /cam7/) { # cam7 settings for model_top = 'lt' add_default($nl, 'use_gw_front' , 'val'=>'.true.'); - add_default($nl, 'use_gw_convect_dp', 'val'=>'.true.'); + $use_gw_convect_dp = '.true.'; add_default($nl, 'gw_qbo_hdepth_scaling', 'val'=>'1.0D0'); } else { add_default($nl, 'use_gw_front' , 'val'=>'.false.'); - add_default($nl, 'use_gw_convect_dp', 'val'=>'.false.'); } +# Check if deep convection scheme used. If not set use_gw_convect_dp=.false. +if ($deep_scheme =~ /off/) { + $use_gw_convect_dp = '.false.'; +} +add_default($nl, 'use_gw_convect_dp', 'val'=>$use_gw_convect_dp); # We need a lot of logic to use these below, so make flags for them. my $do_gw_oro = ($nl->get_value('use_gw_oro') =~ /$TRUE/io); @@ -3877,10 +3857,6 @@ my $do_gw_rdg_gamma = ($nl->get_value('use_gw_rdg_gamma') =~ /$TRUE/io); my $do_divstream = ($nl->get_value('gw_rdg_do_divstream') =~ /$TRUE/io); -if (!$simple_phys) { - # GW option used only for backwards compatibility with CAM3. - add_default($nl, 'fcrit2', 'val'=>'1.0'); -} # Mid-scale wavelength settings. if ($do_gw_front or $do_gw_convect_dp or $do_gw_convect_sh) { add_default($nl, 'pgwv'); @@ -4474,7 +4450,7 @@ my %nl_group = (); foreach my $name (@nl_groups) { $nl_group{$name} = ''; } # Dry deposition, MEGAN VOC emis and ozone namelists -@comp_groups = qw(drydep_inparm megan_emis_nl fire_emis_nl carma_inparm ndep_inparm ozone_coupling_nl lightning_coupling_nl); +@comp_groups = qw(drydep_inparm megan_emis_nl fire_emis_nl carma_inparm ndep_inparm ozone_coupling_nl lightning_coupling_nl dust_emis_inparm); $outfile = "$opts{'dir'}/drv_flds_in"; $nl->write($outfile, 'groups'=>\@comp_groups); diff --git a/bld/config_files/definition.xml b/bld/config_files/definition.xml index 6a4a5436fb..0b7b6bca45 100644 --- a/bld/config_files/definition.xml +++ b/bld/config_files/definition.xml @@ -57,8 +57,8 @@ Option to turn on waccmx thermosphere/ionosphere extension: 0 => no, 1 => yes Ionosphere model used in WACCMX. - -Physics package: cam3, cam4, cam5, cam6, cam7, held_suarez, adiabatic, kessler, tj2016, grayrad, spcam_sam1mom, spcam_m2005. + +Physics package: cam4, cam5, cam6, cam7, held_suarez, adiabatic, kessler, tj2016, grayrad, spcam_sam1mom, spcam_m2005. Switch to turn on Harmonized Emissions Component (HEMCO) for chemistry: 0 => no, 1 => yes. @@ -93,7 +93,7 @@ PBL package: uw (University of Washington), hb (Holtslag and Boville), hbr Radiative transfer calculation: -camrt (CAM3 and CAM4 RT package), rrtmg (RRTMG package from AER), rrtmgp (updated version). +camrt (CAM4 RT package), rrtmg (RRTMG package from AER), rrtmgp (updated version). CARMA sectional microphysics: diff --git a/bld/configure b/bld/configure index 8e21a98fd8..707fe16e74 100755 --- a/bld/configure +++ b/bld/configure @@ -97,7 +97,7 @@ OPTIONS -pbl Specify the PBL option [uw | hb | hbr]. -pcols Set maximum number of columns in a chunk to . -pergro Switch enables building CAM for perturbation growth tests. - -phys Physics option [cam3 | cam4 | cam5 | cam6 | cam7 | + -phys Physics option [cam4 | cam5 | cam6 | cam7 | held_suarez | adiabatic | kessler | tj2016 | grayrad spcam_sam1mom | spcam_m2005]. Default: cam6 -prog_species Comma-separate list of prognostic mozart species packages. @@ -602,8 +602,8 @@ if (defined $opts{'chem'}) { " -chem can only be set to 'none' or 'terminator'.\n"; } } - elsif ($phys_pkg =~ m/^cam3$|^cam4$|^spcam_sam1mom$/) { - # The modal aerosols are not valid with cam3 or cam4 physics + elsif ($phys_pkg =~ m/^cam4$|^spcam_sam1mom$/) { + # The modal aerosols are not valid with cam4 physics if ($chem_pkg =~ /_mam/) { die "configure ERROR: -phys=$phys_pkg -chem=$chem_pkg\n". " -chem cannot be set to a modal aerosol option.\n"; @@ -1071,7 +1071,7 @@ if ($unicon and $print>=2) { print "Using UNICON scheme.$eol"; } # Set default my $rad_pkg = 'none'; -if ($phys_pkg =~ m/cam3|cam4|spcam_sam1mom/) { +if ($phys_pkg =~ m/cam4|spcam_sam1mom/) { $rad_pkg = 'camrt'; } elsif ($phys_pkg =~ m/cam5|cam6|cam7|spcam_m2005/) { @@ -1102,12 +1102,6 @@ if ($rad_pkg eq 'camrt') { } elsif ($rad_pkg =~ m/rrtmg/) { - # The rrtmg package doesn't work with the CAM3 prescribed aerosols - if ($phys_pkg eq 'cam3') { - die "configure ERROR: radiation package: $rad_pkg is not compatible\n". - " with physics package $phys_pkg\n"; - } - # RRTMGP not currently working with CARMA if ($rad_pkg eq 'rrtmgp' and $carma_pkg ne 'none') { die "configure ERROR: The CARMA microphysics package does not currently work with RRTMGP\n"; @@ -1371,9 +1365,6 @@ elsif ($phys_pkg eq 'cam5' or $phys_pkg eq 'spcam_m2005') { elsif ($phys_pkg eq 'cam4' or $phys_pkg eq 'spcam_sam1mom') { $nlev = 26; } -elsif ($phys_pkg eq 'cam3') { - $nlev = 26; -} else { # This will be used for Held-Suarez and other 'simple' physics # We may change this to 32 once IC files are available. @@ -1615,7 +1606,7 @@ else { if ($print>=2 and $ttrac_nadv) { print "Advected constituents added by test tracer package: $ttrac_nadv$eol"; } if ($age_of_air_trcs eq "ON") { - $nadv += 4; + $nadv += 3; if ($print>=2) { print "Advected constituents added by the age of air tracer package: 4$eol"; } } diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index ed6fa70b52..74514b37e2 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -44,12 +44,16 @@ atm/cam/inic/cam_vcoords_L32_c180105.nc -atm/cam/inic/mpas/mpasa480_L32_notopo_coords_c201125.nc -atm/cam/inic/mpas/mpasa120_L32_notopo_coords_c201216.nc -atm/cam/inic/mpas/mpasa120_L32_topo_coords_c201022.nc -atm/cam/inic/mpas/mpasa120_L32_topo_coords_c201022.nc -atm/cam/inic/mpas/mpasa60_L32_notopo_coords_c230707.nc -atm/cam/inic/mpas/mpasa30_L32_notopo_coords_c230707.nc +atm/cam/inic/mpas/mpasa480_L32_notopo_coords_c240507.nc +atm/cam/inic/mpas/mpasa120_L32_notopo_coords_c240507.nc +atm/cam/inic/mpas/mpasa60_L32_notopo_coords_c240507.nc +atm/cam/inic/mpas/mpasa30_L32_notopo_coords_c240507.nc +atm/cam/inic/mpas/mpasa480_L58_notopo_coords_c240814.nc +atm/cam/inic/mpas/mpasa120_L58_notopo_coords_c240814.nc +atm/cam/inic/mpas/mpasa60_L58_notopo_coords_c240814.nc +atm/cam/inic/mpas/mpasa480_L93_notopo_coords_c240814.nc +atm/cam/inic/mpas/mpasa120_L93_notopo_coords_c240814.nc +atm/cam/inic/mpas/mpasa60_L93_notopo_coords_c240814.nc atm/cam/inic/fv/cami_0000-01-01_0.23x0.31_L26_c100513.nc @@ -280,10 +284,14 @@ atm/waccm/ic/FW2000_CONUS_30x8_L70_01-01-0001_c200602.nc -atm/waccm/ic/mpasa120km.waccm_fulltopo_c220818.nc +atm/waccm/ic/mpasa120_L70.waccm_topography_SC_c240904.nc -atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa120_L32_CFSR_c210426.nc -atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa480_L32_CFSR_c211013.nc +atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa480_L32_CFSR_c240508.nc +atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa120_L32_CFSR_c240508.nc +atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa480_L58_CFSR_c240814.nc +atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa120_L58_CFSR_c240814.nc +atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa480_L93_CFSR_c240814.nc +atm/cam/inic/mpas/cami_01-01-2000_00Z_mpasa120_L93_CFSR_c240814.nc atm/cam/topo/topo-from-cami_0000-01-01_256x512_L26_c030918.nc @@ -335,8 +343,8 @@ atm/cam/topo/se/ne30x4_ARCTIC_nc3000_Co060_Fi001_MulG_PF_RR_Nsw042_c200428.nc atm/cam/topo/se/ne30x8_ARCTICGRIS_nc3000_Co060_Fi001_MulG_PF_RR_Nsw042_c200428.nc -atm/cam/topo/mpas/mpas_120_nc3000_Co060_Fi001_MulG_PF_Nsw042_c200921.nc -atm/cam/topo/mpas_480_nc3000_Co240_Fi001_MulG_PF_Nsw170.nc +atm/cam/topo/mpas/mpasa480_gmted2010_modis_bedmachine_nc3000_Laplace0400_noleak_20240507.nc +atm/cam/topo/mpas/mpasa120_gmted2010_modis_bedmachine_nc3000_Laplace0100_noleak_20240507.nc 0.0D0 @@ -393,19 +401,6 @@ - -atm/cam/physprops/sul_cam3_c080918.nc -atm/cam/physprops/dustv1b1_cam3_c080918.nc -atm/cam/physprops/dustv1b2_cam3_c080918.nc -atm/cam/physprops/dustv1b3_cam3_c080918.nc -atm/cam/physprops/dustv1b4_cam3_c080918.nc -atm/cam/physprops/bcpho_cam3_c080918.nc -atm/cam/physprops/bcphi_cam3_c080918.nc -atm/cam/physprops/ocpho_cam3_c080918.nc -atm/cam/physprops/ocphi_cam3_c080918.nc -atm/cam/physprops/ssam_cam3_c080918.nc -atm/cam/physprops/sscm_cam3_c080918.nc - atm/cam/physprops/sulfate_camrt_c080918.nc @@ -2571,6 +2566,10 @@ 0.9D0 0.9D0 + +Zender_2003 +atm + 1.35D0 @@ -2960,7 +2959,6 @@ 0.5D0 -0 1 2 diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 2b854bc966..8a353ce7e8 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -476,20 +476,6 @@ Default: none - - - -Full pathname of time-variant boundary dataset for aerosol masses. -Default: set by build-namelist. - - - -Add CAM3 prescribed aerosols to the physics buffer. -Default: FALSE - - -1 for FFT filter always, 0 for combined algebraic/FFT filter. The value 0 -is used for CAM3, otherwise it is using the value 1. +1 for FFT filter always, 0 for combined algebraic/FFT filter. Default: set by build-namelist @@ -1495,12 +1480,6 @@ Full pathname of boundary dataset for meso-gamma ridges. Default: set by build-namelist. - -Critical Froude number squared (used only for orographic waves). -Default: set by build-namelist. - - Factor to multiply tau by, for orographic waves in the southern hemisphere. @@ -5057,30 +5036,6 @@ Specifies the name of the sea salt emission parameterization. Default: Gong - -======= - - - -Full pathname of time-variant ozone mixing ratio boundary dataset. -Default: set by build-namelist. - - - -Add CAM3 prescribed ozone to the physics buffer. -Default: FALSE - - - -Flag for yearly cycling of ozone data. If set to FALSE, a multi-year -dataset is assumed, otherwise a single-year dataset is assumed, and ozone -will be cycled over the 12 monthly averages in the file. -Default: TRUE - - + group="phys_ctl_nl" valid_values="cam4,cam5,cam6,adiabatic,held_suarez,kessler,frierson" > Name of the CAM physics package. N.B. this variable may not be set by the user. It is set by build-namelist via information in the configure cache file to be consistent with how CAM was built. @@ -6500,19 +6455,19 @@ Default: set by build-namelist. + group="aero_wetdep_nl" valid_values="" > Tuning for below cloud scavenging of interstitial modal aerosols. Default: set by build-namelist. + group="aero_wetdep_nl" valid_values="" > Tuning for in-cloud scavenging of interstitial modal aerosols. Default: set by build-namelist. + group="aero_wetdep_nl" valid_values="" > Tuning for in-cloud scavenging of cloud-borne modal aerosols. Default: set by build-namelist. @@ -7921,6 +7876,21 @@ List of fluxes needed by the CARMA model, from CLM to CAM. Default: set by build-namelist. + +Which dust emission method is going to be used. +Either the Zender 2003 scheme or the Leung 2023 scheme. +Default: Zender_2003 + + + +Option only applying for the Zender_2003 method for whether the soil erodibility +file is handled in the active LAND model or in the ATM model. +(only used when dust_emis_method is Zender_2003) +Default: atm + + - - - - -300 -150 - - -0. -0. -0. -fixed_parameters - - - false - - -348.0e-6 -1650.0e-9 -306.0e-9 -280.e-12 -503.e-12 - - - .false. - - - 4.0e-4 - 16.0e-6 - 5.0e-6 - 0.910D0 - 0.700D0 - 0.070D0 - 500.0D0 - 0.140D0 - 500.0D0 - 25000.0D0 - 1800.0D0 - 1.0e-4 - 0.0040D0 - 0.0040D0 - 1.0E-6 - - - -1365.0 -/ - - -apeozone_cam3_5_54.nc -atm/cam/ozone -OZONE -CYCLICAL -1990 - - - - - -86164.10063718943 -6.37100e6 -9.79764 -28.96623324623746 -18.01618112892741 -1.846e3 -273.16 - -'A:Q:H2O', 'N:O2:O2', 'N:CO2:CO2', 'N:ozone:O3', 'N:N2O:N2O', 'N:CH4:CH4', 'N:CFC11:CFC11','N:CFC12:CFC12' - - - 0.5 - - - 0 - - diff --git a/bld/namelist_files/use_cases/hist_cam_lt.xml b/bld/namelist_files/use_cases/hist_cam_lt.xml index 81834955c3..c436b97c1f 100644 --- a/bld/namelist_files/use_cases/hist_cam_lt.xml +++ b/bld/namelist_files/use_cases/hist_cam_lt.xml @@ -13,7 +13,7 @@ 'Q:H2O->UBC_FILE' -atm/cam/chem/ubc/f.e21.FWHISTBgcCrop.f09_f09_mg17.CMIP6-AMIP-WACCM.ensAvg123.cam.h0zm.UBC.195001-201412_c220322.nc +atm/cam/chem/ubc/b.e21.BWHIST.f09_g17.CMIP6-historical-WACCM.ensAvg123.cam.h0zm.H2O.1849-2014_c240604.nc 'SERIAL' diff --git a/bld/namelist_files/use_cases/sd_waccm_ma_cam4.xml b/bld/namelist_files/use_cases/sd_waccm_ma_cam4.xml index 6fa2495972..95b9e204db 100644 --- a/bld/namelist_files/use_cases/sd_waccm_ma_cam4.xml +++ b/bld/namelist_files/use_cases/sd_waccm_ma_cam4.xml @@ -92,7 +92,7 @@ - 'AOA1', 'AOA2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', + 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'HORZ', 'LANDFRAC', 'LHFLX', 'OCNFRAC', 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'QFLX', 'QRL', 'QRLNLTE', diff --git a/bld/namelist_files/use_cases/sd_waccm_ma_cam6.xml b/bld/namelist_files/use_cases/sd_waccm_ma_cam6.xml index 8adf1f6333..753c2e0035 100644 --- a/bld/namelist_files/use_cases/sd_waccm_ma_cam6.xml +++ b/bld/namelist_files/use_cases/sd_waccm_ma_cam6.xml @@ -71,7 +71,7 @@ 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' - 'AOA1', 'AOA2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', + 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'HORZ', 'LANDFRAC', 'LHFLX', 'OCNFRAC', 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'QFLX', 'QRL', 'QRLNLTE', diff --git a/bld/namelist_files/use_cases/sd_waccm_sulfur.xml b/bld/namelist_files/use_cases/sd_waccm_sulfur.xml index 25c4d622de..7a02c11544 100644 --- a/bld/namelist_files/use_cases/sd_waccm_sulfur.xml +++ b/bld/namelist_files/use_cases/sd_waccm_sulfur.xml @@ -67,7 +67,7 @@ - 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', + 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CO', 'CO2', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', @@ -103,7 +103,7 @@ 'CL','CL2', 'CLO', 'OCLO', 'CL2O2', 'CLONO2', 'HOCL', 'HCL', 'CLOX', 'CLOY', 'BR', 'BRO', 'HOBR', 'HBR', 'BRCL', 'BRONO2', 'BROX', 'BROY', 'TCLY', 'jo2_a', 'jo2_b', 'jo3_a', 'jo3_b', 'jhocl', 'jno3_b', 'jcl2o2', - 'SAD_SULFC', 'SAD_LNAT', 'SAD_ICE','AOA1','AOA2', + 'SAD_SULFC', 'SAD_LNAT', 'SAD_ICE', 'O2', 'CLDLIQ', 'CLDICE', 'ASDIR', 'VTHzm', 'WTHzm', 'UVzm', 'UWzm', 'TH', 'MSKtem' diff --git a/bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml b/bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml index e52fd92caa..9da740a7ae 100644 --- a/bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml +++ b/bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml @@ -65,10 +65,10 @@ .true. .true. - 'AOA1SRC', 'AOA2SRC', 'NO2_CMXF' + 'NO2_CMXF' - 'ABSORB', 'ACBZO2', 'ACTREL', 'ALKNIT', 'ALKO2', 'ALKOOH', 'AOA1', 'AOA_NH', 'AODABSdn', 'AODBCdn', 'AODdnDUST01', 'AODdnDUST02', + 'ABSORB', 'ACBZO2', 'ACTREL', 'ALKNIT', 'ALKO2', 'ALKOOH', 'AOA_NH', 'AODABSdn', 'AODBCdn', 'AODdnDUST01', 'AODdnDUST02', 'AODdnDUST03', 'AODdn_aitken', 'AODdn_accum', 'AODdn_coarse', 'AODDUST02', 'AODDUST', 'AODNIRstdn', 'AODPOMdn', 'AODSO4dn', 'AODSOAdn', 'AODSSdn', 'AODUVdn', 'AODUVstdn', 'AODVIS', 'AODVISdn', 'AODVISstdn', 'AQ_SO2', 'AREA', 'AREI', 'AREL', 'bc_a1', 'bc_a1DDF', 'bc_a1SFWET', 'bc_a4', 'bc_a4_CLXF', 'bc_a4DDF', 'bc_a4SFWET', 'BCARY', 'bc_c1', 'bc_c1DDF', 'bc_c1SFWET', 'bc_c4', 'bc_c4DDF', diff --git a/bld/namelist_files/use_cases/sd_waccmx_ma_cam4.xml b/bld/namelist_files/use_cases/sd_waccmx_ma_cam4.xml index 56b964bc54..6ec178700a 100644 --- a/bld/namelist_files/use_cases/sd_waccmx_ma_cam4.xml +++ b/bld/namelist_files/use_cases/sd_waccmx_ma_cam4.xml @@ -85,7 +85,7 @@ 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'U_08_COS', 'U_08_SIN', 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'V_08_COS', 'V_08_SIN', 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN', - 'ALATM', 'ALONM', 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', + 'ALATM', 'ALONM', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CO', 'DTCOND', 'DTV', 'DUV', 'DVV', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC','FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', diff --git a/bld/namelist_files/use_cases/sd_waccmx_ma_cam6.xml b/bld/namelist_files/use_cases/sd_waccmx_ma_cam6.xml index f380c36d60..6493ed584b 100644 --- a/bld/namelist_files/use_cases/sd_waccmx_ma_cam6.xml +++ b/bld/namelist_files/use_cases/sd_waccmx_ma_cam6.xml @@ -72,7 +72,7 @@ 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'U_08_COS', 'U_08_SIN', 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'V_08_COS', 'V_08_SIN', 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN', - 'ALATM', 'ALONM', 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', + 'ALATM', 'ALONM', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CO', 'DTCOND', 'DTV', 'DUV', 'DVV', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC','FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', diff --git a/bld/namelist_files/use_cases/soa_chem_megan_emis.xml b/bld/namelist_files/use_cases/soa_chem_megan_emis.xml index 512d95fcc9..5497ed52a9 100644 --- a/bld/namelist_files/use_cases/soa_chem_megan_emis.xml +++ b/bld/namelist_files/use_cases/soa_chem_megan_emis.xml @@ -63,7 +63,7 @@ NEU - 'AEROD_v', 'AOA1', 'AOA2', 'CH2O', 'CH3O2', 'CH3OOH', 'CH4', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLOUD', + 'AEROD_v', 'CH2O', 'CH3O2', 'CH3OOH', 'CH4', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLOUD', 'CO', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'H', 'H2', 'H2O2', 'HNO3_GAS', 'HNO3_STS', 'HNO3_NAT', 'HNO3', 'HO2', 'HO2NO2', 'LANDFRAC', 'LHFLX', 'N2O', 'N2O5', 'NO', 'NO2', 'NO3', 'O', 'O1D', 'O3', 'OCNFRAC', 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'Q', 'QRL', 'QRS', 'RELHUM', 'SHFLX', 'SOLIN', 'SWCF', diff --git a/bld/namelist_files/use_cases/waccm_carma_bc_2013_cam4.xml b/bld/namelist_files/use_cases/waccm_carma_bc_2013_cam4.xml index a6e5287553..1429770e8e 100644 --- a/bld/namelist_files/use_cases/waccm_carma_bc_2013_cam4.xml +++ b/bld/namelist_files/use_cases/waccm_carma_bc_2013_cam4.xml @@ -77,7 +77,7 @@ - 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', + 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CO', 'CO2', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', @@ -113,7 +113,7 @@ 'CL','CL2', 'CLO', 'OCLO', 'CL2O2', 'CLONO2', 'HOCL', 'HCL', 'CLOX', 'CLOY', 'BR', 'BRO', 'HOBR', 'HBR', 'BRCL', 'BRONO2', 'BROX', 'BROY', 'TCLY', 'jo2_a', 'jo2_b', 'jo3_a', 'jo3_b', 'jhocl', 'jno3_b', 'jcl2o2', - 'SAD_SULFC', 'SAD_LNAT', 'SAD_ICE','AOA1','AOA2', + 'SAD_SULFC', 'SAD_LNAT', 'SAD_ICE', 'O2', 'CLDLIQ', 'CLDICE', 'ASDIR', 'VTHzm', 'WTHzm', 'UVzm', 'UWzm', 'TH', 'MSKtem' diff --git a/bld/namelist_files/use_cases/waccm_ma_1850_cam6.xml b/bld/namelist_files/use_cases/waccm_ma_1850_cam6.xml index 99eb24d6b8..24b55facc2 100644 --- a/bld/namelist_files/use_cases/waccm_ma_1850_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_ma_1850_cam6.xml @@ -55,7 +55,7 @@ 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' - 'AOA1', 'AOA2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', + 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'HORZ', 'LANDFRAC', 'LHFLX', 'OCNFRAC', 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'QFLX', 'QRL', 'QRLNLTE', diff --git a/bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml b/bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml index f87670c6b0..9ccac8892f 100644 --- a/bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml @@ -150,7 +150,7 @@ 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' - 'AOA1', 'AOA2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', + 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'HORZ', 'LANDFRAC', 'LHFLX', 'OCNFRAC', 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'QFLX', 'QRL', 'QRLNLTE', diff --git a/bld/namelist_files/use_cases/waccm_ma_hist_cam4.xml b/bld/namelist_files/use_cases/waccm_ma_hist_cam4.xml index 1177ebd155..e2376e4a70 100644 --- a/bld/namelist_files/use_cases/waccm_ma_hist_cam4.xml +++ b/bld/namelist_files/use_cases/waccm_ma_hist_cam4.xml @@ -78,7 +78,7 @@ 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' - 'AOA1', 'AOA2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', + 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'HORZ', 'LANDFRAC', 'LHFLX', 'OCNFRAC', 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'QFLX', 'QRL', 'QRLNLTE', diff --git a/bld/namelist_files/use_cases/waccm_ma_hist_cam6.xml b/bld/namelist_files/use_cases/waccm_ma_hist_cam6.xml index 03c45f097a..042a153fe4 100644 --- a/bld/namelist_files/use_cases/waccm_ma_hist_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_ma_hist_cam6.xml @@ -49,7 +49,7 @@ 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' - 'AOA1', 'AOA2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', + 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', 'HORZ', 'LANDFRAC', 'LHFLX', 'OCNFRAC', 'OH', 'OMEGA', 'PHIS', 'PRECC', 'PRECL', 'PS', 'QFLX', 'QRL', 'QRLNLTE', diff --git a/bld/namelist_files/use_cases/waccm_sc_1850_cam6.xml b/bld/namelist_files/use_cases/waccm_sc_1850_cam6.xml index a004dafd78..dbc6b0921b 100644 --- a/bld/namelist_files/use_cases/waccm_sc_1850_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_sc_1850_cam6.xml @@ -72,7 +72,7 @@ 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' - 'AOA1', 'AOA2', 'CH4', 'H2O', 'N2O', 'CFC11', 'CFC12', 'CFC11STAR', 'UTGWORO', 'VTGWORO', + 'CH4', 'H2O', 'N2O', 'CFC11', 'CFC12', 'CFC11STAR', 'UTGWORO', 'VTGWORO', 'UTGWSPEC', 'VTGWSPEC', 'BUTGWSPEC', 'AODVISstdn', 'AODVISdn', 'KVH_CLUBB', 'KVH', 'TTENDICE', 'QVTENDICE', 'QCTENDICE', 'NCTENDICE', 'FQTENDICE', 'MASS' diff --git a/bld/namelist_files/use_cases/waccm_sc_2000_cam6.xml b/bld/namelist_files/use_cases/waccm_sc_2000_cam6.xml index 040cf5acfc..ead1445075 100644 --- a/bld/namelist_files/use_cases/waccm_sc_2000_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_sc_2000_cam6.xml @@ -107,7 +107,7 @@ 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' - 'AOA1', 'AOA2', 'CH4', 'H2O', 'N2O', 'CFC11', 'CFC12', 'CFC11STAR', 'UTGWORO', 'VTGWORO', + 'CH4', 'H2O', 'N2O', 'CFC11', 'CFC12', 'CFC11STAR', 'UTGWORO', 'VTGWORO', 'UTGWSPEC', 'VTGWSPEC', 'BUTGWSPEC', 'AODVISstdn', 'AODVISdn', 'KVH_CLUBB', 'KVH', 'TTENDICE', 'QVTENDICE', 'QCTENDICE', 'NCTENDICE', 'FQTENDICE', 'MASS' diff --git a/bld/namelist_files/use_cases/waccm_sc_2010_cam6.xml b/bld/namelist_files/use_cases/waccm_sc_2010_cam6.xml index a77688d0f1..9b168bbef2 100644 --- a/bld/namelist_files/use_cases/waccm_sc_2010_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_sc_2010_cam6.xml @@ -110,7 +110,7 @@ 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' - 'AOA1', 'AOA2', 'CH4', 'H2O', 'N2O', 'CFC11', 'CFC12', 'CFC11STAR', 'UTGWORO', 'VTGWORO', + 'CH4', 'H2O', 'N2O', 'CFC11', 'CFC12', 'CFC11STAR', 'UTGWORO', 'VTGWORO', 'UTGWSPEC', 'VTGWSPEC', 'BUTGWSPEC', 'AODVISstdn', 'AODVISdn', 'KVH_CLUBB', 'KVH', 'TTENDICE', 'QVTENDICE', 'QCTENDICE', 'NCTENDICE', 'FQTENDICE', 'MASS' diff --git a/bld/namelist_files/use_cases/waccm_sc_hist_cam6.xml b/bld/namelist_files/use_cases/waccm_sc_hist_cam6.xml index cad2fb3f3a..3c2583af96 100644 --- a/bld/namelist_files/use_cases/waccm_sc_hist_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_sc_hist_cam6.xml @@ -59,7 +59,7 @@ 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'A', 'I' - 'AOA1', 'AOA2', 'CH4', 'H2O', 'N2O', 'CFC11', 'CFC12', 'CFC11STAR', 'UTGWORO', 'VTGWORO', + 'CH4', 'H2O', 'N2O', 'CFC11', 'CFC12', 'CFC11STAR', 'UTGWORO', 'VTGWORO', 'UTGWSPEC', 'VTGWSPEC', 'BUTGWSPEC', 'AODVISstdn', 'AODVISdn', 'KVH_CLUBB', 'KVH', 'TTENDICE', 'QVTENDICE', 'QCTENDICE', 'NCTENDICE', 'FQTENDICE', 'MASS' diff --git a/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml b/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml index 800b9b228a..86e6af3bab 100644 --- a/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml @@ -63,7 +63,7 @@ .true. .true. - 'AOA1SRC', 'AOA2SRC', 'NO2_CMXF', 'NO2_CLXF' + 'NO2_CMXF', 'NO2_CLXF' 'ACTREL', 'AQ_SO2', 'AREA', 'BROX', 'BROY', 'BRY', 'CLOX', 'CLOY', 'CLY', 'NOX', 'NOY', 'TBRY', 'TCLY', 'CFC11STAR', diff --git a/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml b/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml index 3ad0c7db31..efc485e990 100644 --- a/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml @@ -260,7 +260,7 @@ .true. .true. - 'AOA1SRC', 'AOA2SRC', 'NO2_CMXF' + 'NO2_CMXF' 'ACTREL', 'AQ_SO2', 'AREA', 'BROX', 'BROY', 'BRY', 'CLOX', 'CLOY', 'CLY', 'NOX', 'NOY', 'TBRY', 'TCLY', 'CFC11STAR', diff --git a/bld/namelist_files/use_cases/waccm_tsmlt_2010_cam6.xml b/bld/namelist_files/use_cases/waccm_tsmlt_2010_cam6.xml index 219083b1a4..fa65883ce1 100644 --- a/bld/namelist_files/use_cases/waccm_tsmlt_2010_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_tsmlt_2010_cam6.xml @@ -160,7 +160,7 @@ .true. .true. - 'AOA1SRC', 'AOA2SRC', 'NO2_CMXF' + 'NO2_CMXF' 'ACTREL', 'AQ_SO2', 'AREA', 'BROX', 'BROY', 'BRY', 'CLOX', 'CLOY', 'CLY', 'NOX', 'NOY', 'TBRY', 'TCLY', 'CFC11STAR', diff --git a/bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml b/bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml index 6ad0b14145..00fb808a52 100644 --- a/bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml +++ b/bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml @@ -56,7 +56,7 @@ .true. .true. - 'AOA1SRC', 'AOA2SRC', 'NO2_CMXF' + 'NO2_CMXF' 'ACTREL', 'AQ_SO2', 'AREA', 'BROX', 'BROY', 'BRY', 'CLOX', 'CLOY', 'CLY', 'NOX', 'NOY', 'TBRY', 'TCLY', 'CFC11STAR', diff --git a/bld/namelist_files/use_cases/waccmx_ma_2000_cam4.xml b/bld/namelist_files/use_cases/waccmx_ma_2000_cam4.xml index d40cc385f4..017cc3362e 100644 --- a/bld/namelist_files/use_cases/waccmx_ma_2000_cam4.xml +++ b/bld/namelist_files/use_cases/waccmx_ma_2000_cam4.xml @@ -74,7 +74,7 @@ - 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', + 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CO', 'CO2', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', @@ -110,7 +110,7 @@ 'CL','CL2', 'CLO', 'OCLO', 'CL2O2', 'CLONO2', 'HOCL', 'HCL', 'CLOX', 'CLOY', 'BR', 'BRO', 'HOBR', 'HBR', 'BRCL', 'BRONO2', 'BROX', 'BROY', 'TCLY', 'jo2_a', 'jo2_b', 'jo3_a', 'jo3_b', 'jhocl', 'jno3_b', 'jcl2o2', - 'SAD_SULFC', 'SAD_LNAT', 'SAD_ICE','AOA1','AOA2', + 'SAD_SULFC', 'SAD_LNAT', 'SAD_ICE', 'O2', 'CLDLIQ', 'CLDICE', 'ASDIR', 'O2_1S', 'O2_1D', 'Op', 'O2p', 'Np', 'NOp', 'N2p', 'e', @@ -121,7 +121,7 @@ - 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', + 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CO', 'CO2', 'DTCOND', 'DTV', 'DUV', 'DVV', 'EKGW', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC', 'FSDS', 'FSNS', 'FSNSC', 'FSNT', diff --git a/bld/namelist_files/use_cases/waccmx_ma_2000_cam6.xml b/bld/namelist_files/use_cases/waccmx_ma_2000_cam6.xml index 6e6986f127..06520cc3fb 100644 --- a/bld/namelist_files/use_cases/waccmx_ma_2000_cam6.xml +++ b/bld/namelist_files/use_cases/waccmx_ma_2000_cam6.xml @@ -52,7 +52,7 @@ 'T_24_SIN', 'T_12_COS', 'T_12_SIN', 'T_08_COS', 'T_08_SIN', 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'U_08_COS', 'U_08_SIN', 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'V_08_COS', 'V_08_SIN', 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', - 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN', 'ALATM', 'ALONM', 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', + 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN', 'ALATM', 'ALONM', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CO', 'DTCOND', 'DTV', 'DUV', 'DVV', 'FLNS', diff --git a/bld/namelist_files/use_cases/waccmx_ma_hist_cam6.xml b/bld/namelist_files/use_cases/waccmx_ma_hist_cam6.xml index cc6eea7802..37ca427cd2 100644 --- a/bld/namelist_files/use_cases/waccmx_ma_hist_cam6.xml +++ b/bld/namelist_files/use_cases/waccmx_ma_hist_cam6.xml @@ -50,7 +50,7 @@ 'T_24_SIN', 'T_12_COS', 'T_12_SIN', 'T_08_COS', 'T_08_SIN', 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'U_08_COS', 'U_08_SIN', 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'V_08_COS', 'V_08_SIN', 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', - 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN', 'ALATM', 'ALONM', 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', + 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN', 'ALATM', 'ALONM', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CO', 'DTCOND', 'DTV', 'DUV', 'DVV', 'FLNS', diff --git a/bld/namelist_files/use_cases/waccmxie_ma_2000_cam4.xml b/bld/namelist_files/use_cases/waccmxie_ma_2000_cam4.xml index a3f8c937ec..5fe9c654dd 100644 --- a/bld/namelist_files/use_cases/waccmxie_ma_2000_cam4.xml +++ b/bld/namelist_files/use_cases/waccmxie_ma_2000_cam4.xml @@ -104,7 +104,7 @@ 'U_24_COS', 'U_24_SIN', 'U_12_COS', 'U_12_SIN', 'U_08_COS', 'U_08_SIN', 'V_24_COS', 'V_24_SIN', 'V_12_COS', 'V_12_SIN', 'V_08_COS', 'V_08_SIN', 'OMEGA_24_COS', 'OMEGA_24_SIN', 'OMEGA_12_COS', 'OMEGA_12_SIN', 'OMEGA_08_COS', 'OMEGA_08_SIN', - 'ALATM', 'ALONM', 'AOA1', 'AOA2', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', + 'ALATM', 'ALONM', 'BR', 'BRCL', 'BRO', 'BRONO2', 'CCL4', 'CF2CLBR', 'CF3BR', 'CFC11', 'CFC113', 'CFC12', 'CH2O', 'CH3BR', 'CH3CCL3', 'CH3CL', 'CH3O2', 'CH3OOH', 'CH4', 'CL', 'CL2', 'CL2O2', 'CLDHGH', 'CLDLOW', 'CLDMED', 'CLDTOT', 'CLO', 'CLONO2', 'CLOUD', 'CO', 'DTCOND', 'DTV', 'DUV', 'DVV', 'FLNS', 'FLNSC', 'FLNT', 'FLNTC','FSDS', 'FSNS', 'FSNSC', 'FSNT', 'FSNTC', diff --git a/cime_config/buildnml b/cime_config/buildnml index a077e13fcd..9c156b66d5 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -78,11 +78,11 @@ def buildnml(case, caseroot, compname): buildcpp = import_from_file("buildcpp", cmd) _ = buildcpp.buildcpp(case) except: - raise RuntimeError("CAM's 'buildcpp' script failed to run properly.") + logger.warning(" ...cam buildcpp exited with error") # Verify that we have a config_cache file (generated by the call to buildcpp) expect(os.path.isfile(filename), - " Missing config_cache.xml - cannot run build-namelist") + " Missing CAM's config_cache.xml - cannot run build-namelist") #-------------------------------------------------------------------- # Invoke cam build-namelist - output will go in $CASEROOT/Buildconf/camconf diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 6d652e8e03..4a64730bc1 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -12,7 +12,6 @@ CAM cam6 physics: CAM cam5 physics: CAM cam4 physics: - CAM cam3 physics: CAM simplified and non-versioned physics : - - QPC3 - 2000_CAM30_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV - - QPC4 2000_CAM40_SLND_SICE_DOCN%AQP3_SROF_SGLC_SWAV @@ -904,6 +899,12 @@ + + + FALSE + + + diff --git a/cime_config/testdefs/testlist_cam.xml b/cime_config/testdefs/testlist_cam.xml index 68a0ddbac3..2d736a2d51 100644 --- a/cime_config/testdefs/testlist_cam.xml +++ b/cime_config/testdefs/testlist_cam.xml @@ -1514,7 +1514,7 @@ - + @@ -2023,7 +2023,7 @@ - + @@ -2263,7 +2263,7 @@ - + @@ -2284,7 +2284,6 @@ - @@ -2292,12 +2291,13 @@ - + + - + diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/shell_commands new file mode 100644 index 0000000000..de6a2792a7 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/shell_commands @@ -0,0 +1,2 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange --append CAM_CONFIG_OPTS="-age_of_air_trcs" diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/user_nl_cam new file mode 100644 index 0000000000..b0d39d2335 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/user_nl_cam @@ -0,0 +1,4 @@ +mfilt=1,1,1,1,1,1 +ndens=1,1,1,1,1,1 +nhtfrq=-24,-24,-24,-24,-24,-24 +write_nstep0 = .true. diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/user_nl_clm new file mode 100644 index 0000000000..5634334558 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/user_nl_clm @@ -0,0 +1,27 @@ +!---------------------------------------------------------------------------------- +! Users should add all user specific namelist changes below in the form of +! namelist_var = new_namelist_value +! +! Include namelist variables for drv_flds_in ONLY if -megan and/or -drydep options +! are set in the CLM_NAMELIST_OPTS env variable. +! +! EXCEPTIONS: +! Set use_cndv by the compset you use and the CLM_BLDNML_OPTS -dynamic_vegetation setting +! Set use_vichydro by the compset you use and the CLM_BLDNML_OPTS -vichydro setting +! Set use_cn by the compset you use and CLM_BLDNML_OPTS -bgc setting +! Set use_crop by the compset you use and CLM_BLDNML_OPTS -crop setting +! Set spinup_state by the CLM_BLDNML_OPTS -bgc_spinup setting +! Set irrigate by the CLM_BLDNML_OPTS -irrig setting +! Set dtime with L_NCPL option +! Set fatmlndfrc with LND_DOMAIN_PATH/LND_DOMAIN_FILE options +! Set finidat with RUN_REFCASE/RUN_REFDATE/RUN_REFTOD options for hybrid or branch cases +! (includes $inst_string for multi-ensemble cases) +! Set glc_grid with CISM_GRID option +! Set glc_smb with GLC_SMB option +! Set maxpatch_glcmec with GLC_NEC option +! Set glc_do_dynglacier with GLC_TWO_WAY_COUPLING env variable +!---------------------------------------------------------------------------------- +hist_nhtfrq = -24 +hist_mfilt = 1 +hist_ndens = 1 + diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_Leung_dust/shell_commands b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_Leung_dust/shell_commands new file mode 100644 index 0000000000..eb40ad83e0 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_Leung_dust/shell_commands @@ -0,0 +1,2 @@ +./xmlchange ROF_NCPL=\$ATM_NCPL +./xmlchange GLC_NCPL=\$ATM_NCPL diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_Leung_dust/user_nl_cam b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_Leung_dust/user_nl_cam new file mode 100644 index 0000000000..351fe92801 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_Leung_dust/user_nl_cam @@ -0,0 +1,9 @@ +dust_emis_method = 'Leung_2023' + +fincl2 = 'dst_a1SF', 'dst_a2SF', 'dst_a3SF' + +mfilt=1,1,1,1,1,1 +ndens=1,1,1,1,1,1 +nhtfrq=9,9,9,9,9,9 +write_nstep0=.true. +inithist='ENDOFRUN' diff --git a/cime_config/testdefs/testmods_dirs/cam/outfrq9s_Leung_dust/user_nl_clm b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_Leung_dust/user_nl_clm new file mode 100644 index 0000000000..0d83b5367b --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/cam/outfrq9s_Leung_dust/user_nl_clm @@ -0,0 +1,27 @@ +!---------------------------------------------------------------------------------- +! Users should add all user specific namelist changes below in the form of +! namelist_var = new_namelist_value +! +! Include namelist variables for drv_flds_in ONLY if -megan and/or -drydep options +! are set in the CLM_NAMELIST_OPTS env variable. +! +! EXCEPTIONS: +! Set use_cndv by the compset you use and the CLM_BLDNML_OPTS -dynamic_vegetation setting +! Set use_vichydro by the compset you use and the CLM_BLDNML_OPTS -vichydro setting +! Set use_cn by the compset you use and CLM_BLDNML_OPTS -bgc setting +! Set use_crop by the compset you use and CLM_BLDNML_OPTS -crop setting +! Set spinup_state by the CLM_BLDNML_OPTS -bgc_spinup setting +! Set irrigate by the CLM_BLDNML_OPTS -irrig setting +! Set dtime with L_NCPL option +! Set fatmlndfrc with LND_DOMAIN_PATH/LND_DOMAIN_FILE options +! Set finidat with RUN_REFCASE/RUN_REFDATE/RUN_REFTOD options for hybrid or branch cases +! (includes $inst_string for multi-ensemble cases) +! Set glc_grid with CISM_GRID option +! Set glc_smb with GLC_SMB option +! Set maxpatch_glcmec with GLC_NEC option +! Set glc_do_dynglacier with GLC_TWO_WAY_COUPLING env variable +!---------------------------------------------------------------------------------- +hist_nhtfrq = 9 +hist_mfilt = 1 +hist_ndens = 1 + diff --git a/components/clm b/components/clm index e04b7e2ee9..0999a32f52 160000 --- a/components/clm +++ b/components/clm @@ -1 +1 @@ -Subproject commit e04b7e2ee974aaef93117776a96fd7ce1e774b4d +Subproject commit 0999a32f520c995c3dfc94b9b96781d20ed0d6d5 diff --git a/doc/ChangeLog b/doc/ChangeLog index a4fe5d1495..294d616fc7 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,1246 @@ +=============================================================== + +Tag name: cam6_4_036 +Originator(s): gdicker +Date: Sep 24, 2024 +One-line Summary: Update MPAS-A to v8.2.1 +Github PR URL: https://github.com/ESCOMP/CAM/pull/1145 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): +- Update MPAS-A within CAM to 'v8.2.1' https://github.com/ESCOMP/CAM/issue/1144 + +Describe any changes made to build system: + +Describe any changes made to the namelist: + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: + +List all files eliminated: + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: +M .gitmodules + - Update the mpas fxTag to v8.2.1 + +M src/dynamics/mpas/Makefile + - Add rules to build stream_inquiry and mpas_stream_inquiry + - Pass CPPFLAGS to the registry command + - Edit CPPFLAGS: add MPAS_BUILD_TARGET and add the GIT_VERSION using a shell command + - Also a commented out addition to enable mpi_f08 support in MPAS + +M src/dynamics/mpas/driver/cam_mpas_subdriver.F90 + - Add streamInfo to the MPAS domain_ptr + - Modify function calls for updated variables + - Optional mpi_f08 change + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s COMPARE_base_rest + FAIL SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d ... DIFF + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s + - pre-existing failures -- need fix in CLM external + +derecho/nvhpc/aux_cam: ALL PASS + +izumi/nag/aux_cam: + + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure - issue #670 + +izumi/gnu/aux_cam: ALL PASS + +Summarize any changes to answers: bit-for-bit + +=============================================================== +=============================================================== + +Tag name: cam6_4_035 +Originator(s): fvitt +Date: 23 Sep 2024 +One-line Summary: Generalize aerosol wet removal +Github PR URL: https://github.com/ESCOMP/CAM/pull/1099 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + #1098 Generalize aerosol wet removal processes using the abstract aerosol interfaces + framework which can be extended to other aerosol representations, such as CARMA. + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: nusbaume cacraigucar + +List all files eliminated: +D src/chemistry/modal_aero/modal_aero_convproc.F90 + - replaced by generalized aero_convproc module + +List all files added and what they do: +A src/chemistry/aerosol/aero_convproc.F90 + - generalized aerosol convective wet removal processes + +A src/chemistry/aerosol/aero_wetdep_cam.F90 + - generalized cam layer for aerosol wet removal + (stratiform and convective) + + src/chemistry/aerosol/modal_aero_data.F90 + - moved from src/chemistry/modal_aero + +List all existing files that have been modified, and describe the changes: +M bld/build-namelist + - do not set aer_wetdep_list for MAM + +M bld/namelist_files/namelist_definition.xml + - moved aerosol solubility factors to aero_setdep_nl group + +M src/chemistry/aerosol/aerosol_properties_mod.F90 +M src/chemistry/aerosol/modal_aerosol_properties_mod.F90 + - add interfaces for scavenging diameter and resuspention resize + +M src/chemistry/aerosol/aerosol_state_mod.F90 +M src/chemistry/aerosol/modal_aerosol_state_mod.F90 + - add interfaces for convective cloud aerosol activation, below cloud solubility, and wet diameter + +R100 src/chemistry/modal_aero/modal_aero_data.F90 src/chemistry/aerosol/modal_aero_data.F90 + - moved to src/chemistry/aerosol/ + +M src/physics/carma/cam/carma_intr.F90 +M src/chemistry/aerosol/wetdep.F90 + - allow for 3-dimensional solubilities + +M src/chemistry/modal_aero/aero_model.F90 + - moved aerosol wet removal code to generalized aero_wetdep_cam module + +M src/physics/cam/physpkg.F90 +M src/physics/cam7/physpkg.F90 + - wetdep_lq moved to aero_wetdep_cam + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s + DIFF SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s + - pre-existing failures -- need fix in CLM external + + NLFAIL ERC_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp + NLFAIL ERC_D_Ln9.ne16_ne16_mg17.QPC5HIST.derecho_intel.cam-outfrq3s_usecase + NLFAIL ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase + NLFAIL ERP_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s + NLFAIL ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s + NLFAIL ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp + NLFAIL ERP_D_Ln9_P64x2.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s + NLFAIL ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d + NLFAIL ERP_Ld3.ne30pg3_ne30pg3_mg17.FCts4MTHIST.derecho_intel.cam-outfrq1d_aoa + NLFAIL ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 + NLFAIL ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s + NLFAIL ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s + NLFAIL ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s + NLFAIL ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s + NLFAIL ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s + NLFAIL ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s + NLFAIL ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s + NLFAIL ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes + NLFAIL ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam7 + NLFAIL ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s + NLFAIL ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s + NLFAIL ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 + NLFAIL ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 + NLFAIL SCT_D_Ln7.ne3_ne3_mg37.QPC5.derecho_intel.cam-scm_prep + NLFAIL SCT_D_Ln7.T42_T42_mg17.QPC5.derecho_intel.cam-scm_prep + NLFAIL SMS_D_Ld2.f19_f19_mg17.QPC5HIST.derecho_intel.cam-volc_usecase + NLFAIL SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday + NLFAIL SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s + NLFAIL SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s + NLFAIL SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s + NLFAIL SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 + NLFAIL SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie + NLFAIL SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase + NLFAIL SMS_D_Ln9.f19_f19_mg17.QPC5M7.derecho_intel.cam-outfrq9s + NLFAIL SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s + NLFAIL SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s + NLFAIL SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s + NLFAIL SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s_Leung_dust + NLFAIL SMS_D_Ln9.T42_T42.FSCAMARM97.derecho_intel.cam-outfrq9s + NLFAIL SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d + NLFAIL SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d + NLFAIL SMS_Ld5.f09_f09_mg17.PC6.derecho_intel.cam-cam6_port_f09 + NLFAIL SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m + NLFAIL SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging + NLFAIL SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s + NLFAIL SMS_Ln9.f19_f19.F2000climo.derecho_intel.cam-silhs + NLFAIL SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp + - aerosol_nl settings moved to aero_wetdep_nl + +derecho/nvhpc/aux_cam: + NLFAIL ERS_Ln9_G4-a100-openacc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_mg3_default + - aerosol_nl settings moved to aero_wetdep_nl + +izumi/nag/aux_cam: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure - issue #670 + + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s + NLFAIL ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac + NLFAIL ERI_D_Ln18.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac + NLFAIL ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 + NLFAIL ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf + NLFAIL PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 + NLFAIL PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 + NLFAIL PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 + NLFAIL PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 + NLFAIL PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 + NLFAIL PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 + NLFAIL SMS_D_Ld2.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port + NLFAIL SMS_D_Ln7.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm + NLFAIL SMS_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam + NLFAIL SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase + NLFAIL SUB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s + NLFAIL TMC_D.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac + NLFAIL TMC_D.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 + - aerosol_nl settings moved to aero_wetdep_nl + +izumi/gnu/aux_cam: + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s + NLFAIL ERP_D_Ln9.C48_C48_mg17.QPC6.izumi_gnu.cam-outfrq9s + NLFAIL ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp + NLFAIL ERP_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s + NLFAIL PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 + NLFAIL PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 + NLFAIL PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 + NLFAIL SCT_D_Ln7.ne3_ne3_mg37.QPC6.izumi_gnu.cam-scm_prep_c6 + NLFAIL SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 + NLFAIL SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac + NLFAIL SMS_Ld5.f09_f09_mg17.PC6.izumi_gnu.cam-cam6_port_f09_rrtmgp + - aerosol_nl settings moved to aero_wetdep_nl + +Summarize any changes to answers: bit-for-bit + +=============================================================== +=============================================================== + +Tag name: cam6_4_034 +Originator(s): jimmielin +Date: Thu Sep 19 2024 +One-line Summary: Add missing total energy in physics state from dycore in snapshots and cleanup total water +Github PR URL: https://github.com/ESCOMP/CAM/pull/1142 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Save second dimension (dycore formula) of total energy and total water initial and current condition + (fixes #1141) + + Remove second dimension of tw_ini and tw_cur as they are not different between physics and dycore. + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraigucar, nusbaume + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M src/control/cam_snapshot_common.F90 +- renamed te_ini -> te_ini_phys, te_cur -> te_cur_phys +- added te_ini_dyn, te_cur_dyn which were missing from snapshot, now fixed +- resized state history buffer size + +M src/physics/cam/check_energy.F90 +M src/physics/cam/physics_types.F90 +- removed incorrect second dimension of tw_ini and tw_cur as they are not different between physics / dycore + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) + - pre-existing failure -- need fix in CLM external + +derecho/nvhpc/aux_cam: ALL PASS + +izumi/nag/aux_cam: + + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) + - pre-existing failure - issue #670 + +izumi/gnu/aux_cam: ALL PASS + +Summarize any changes to answers: BFB + +=============================================================== + +Tag name: cam6_4_033 +Originator(s): gdicker1 (gdicker@ucar.edu) +Date: Tue 10 Sep 2024 +One-line Summary: Add updated meshes and topo for v8 MPAS-A dycore +Github PR URL: https://github.com/ESCOMP/CAM/pull/1029 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +Add files created by v8 MPAS init_atmosphere model for frontogenesis fields +#995 - Runs with MPAS-A dycore and CAM7 physics fail - missing variables in inic files: https://github.com/ESCOMP/CAM/issues/995 +#1094 - Wrap MPAS-A longitudes to [0,2pi) range: https://github.com/ESCOMP/CAM/issues/1094 + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: adamrher, jtruesdal, cacraigucar, mgduda + +List all files eliminated: + +- mpasa120_L32_topo_coords_c201022.nc + +Eliminated, replaced by newer versions: +- mpasa480_L32_notopo_coords_c201125.nc +- mpasa120_L32_notopo_coords_c201216.nc +- mpasa60_L32_notopo_coords_c230707.nc +- mpasa30_L32_notopo_coords_c230707.nc +- mpasa120km.waccm_fulltopo_c220818.nc +- cami_01_01_2000_00Z_mpasa120_L32_CFSR_c210426.nc +- cami_01_01_2000_00Z_mpasa480_L32_CFSR_c211013.nc +- mpas_120_nc3000_Co060_Fi001_MulG_PF_Nsw042_c200921.nc +- mpas_480_nc3000_Co240_Fi001_MulG_PF_Nsw170.nc + +List all files added and what they do: + +New input 32, 58, and 93L without real-data (analytic-ICs only): +- mpasa480_L32_notopo_coords_c240507.nc +- mpasa120_L32_notopo_coords_c240507.nc +- mpasa60_L32_notopo_coords_c240507.nc +- mpasa30_L32_notopo_coords_c240507.nc +- mpasa480_L58_notopo_coords_c240814.nc +- mpasa120_L58_notopo_coords_c240814.nc +- mpasa60_L58_notopo_coords_c240814.nc +- mpasa480_L93_notopo_coords_c240814.nc +- mpasa120_L93_notopo_coords_c240814.nc +- mpasa60_L93_notopo_coords_c240814.nc + +New input L70 file for waccm cases: +- mpasa120_L70.waccm_topography_SC_c240904.nc + +New input data with topology and real-data ICs: +- cami_01-01-2000_00Z_mpasa480_L32_CFSR_c240508.nc +- cami_01-01-2000_00Z_mpasa120_L32_CFSR_c240508.nc +- cami_01-01-2000_00Z_mpasa480_L58_CFSR_c240814.nc +- cami_01-01-2000_00Z_mpasa120_L58_CFSR_c240814.nc +- cami_01-01-2000_00Z_mpasa480_L93_CFSR_c240814.nc +- cami_01-01-2000_00Z_mpasa120_L93_CFSR_c240814.nc + +New bnd_topo files: +- mpasa480_gmted2010_modis_bedmachine_nc3000_Laplace0400_noleak_20240507.nc +- mpasa120_gmted2010_modis_bedmachine_nc3000_Laplace0100_noleak_20240507.nc + +List all existing files that have been modified, and describe the changes: +M bld/namelist_files/namelist_defaults_cam.xml + - Add new ncdata and bnd_topo files above so they can be used +M src/dynamics/mpas/dyn_grid.F90 + - Modifies setup_time_invariant to ensure lonCell values are in [0,2pi) range + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) + - pre-existing failure -- need fix in CLM external + + ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 (Overall: DIFF) + ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 (Overall: DIFF) + - expected fails of BASELINE and NLCOMP steps, new mpas input data + +derecho/nvhpc/aux_cam: ALL PASS + +izumi/nag/aux_cam: + + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure - issue #670 + + ERC_D_Ln9.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase (Overall: DIFF) + - expected fails of BASELINE and NLCOMP steps, new mpas input data + +izumi/gnu/aux_cam: ALL PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers, i.e., +- what code configurations: +- what platforms/compilers: +- nature of change (roundoff; larger than roundoff but same climate; new + climate): + +If bitwise differences were observed, how did you show they were no worse +than roundoff? + +If this tag changes climate describe the run(s) done to evaluate the new +climate in enough detail that it(they) could be reproduced, i.e., +- source tag (all code used must be in the repository): +- platform/compilers: +- configure commandline: +- build-namelist command (or complete namelist): +- MSS location of output: + +MSS location of control simulations used to validate new climate: + +URL for AMWG diagnostics output used to validate new climate: + +=============================================================== +=============================================================== + +Tag name: cam6_4_032 +Originator(s): eaton +Date: +One-line Summary: Use same cloud water for radiation and COSP. +Github PR URL: https://github.com/ESCOMP/CAM/pull/1084 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +Issue #1027 - Radiatively active cloud water missing from COSP. + +The all-cloud liquid and ice mixing ratios calculated in the conv_water module are +used by the radiation code. Use these same quantities in the COSP code by +making them accessable via the physics buffer. + +resolves #1027 + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: peverwhee + +List all files eliminated: none + +List all files added and what they do: none + +List all existing files that have been modified, and describe the changes: + +src/control/cam_snapshot_common.F90 +. remove pbuf fields DP_CLDLIQ, DP_CLDICE, SH_CLDLIQ1, SH_CLDICE1 + +src/physics/cam/conv_water.F90 +. add GB_TOTCLDLIQMR, GB_TOTCLDICEMR to pbuf +. remove SH_CLDLIQ1, SH_CLDICE1 from pbuf +. conv_water_4rad + - remove dummy args totg_liq and totg_ice and replace assignment to those + args by assignment to the pbuf variables GB_TOTCLDLIQMR and + GB_TOTCLDICEMR + +src/physics/cam/cloud_diagnostics.F90 +. access the pbuf fields GB_TOTCLDLIQMR and GB_TOTCLDICEMR which are set by + the calls to conv_water_4rad + +src/physics/cam/cospsimulator_intr.F90 +. replace access of pbuf fields DP_CLDLIQ, DP_CLDICE, SH_CLDLIQ1, and + SH_CLDICE1, by GB_TOTCLDLIQMR and GB_TOTCLDICEMR +. assign the total cloud mixing ratios to the arguments for the large scale + values, and set the convective cloud inputs to zero. + +src/physics/cam/zm_conv_intr.F90 +. remove pbuf fields DP_CLDLIQ and DP_CLDICE which were set to 0. and being + used as if they had real data by COSP. + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) + - pre-existing failure -- need fix in CLM external + + SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s (Overall: PASS) + - test failed with error in ESMF on first run, but passed when I reran the tests + - unclear when/why exactly this test began to pass again + + +izumi/nag/aux_cam: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure - issue #670 + +izumi/gnu/aux_cam: All BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB. Only COSP diagnostic fields have +differences. + +=============================================================== + +Tag name: cam6_4_031 +Originator(s): jedwards, eaton +Date: Sept 9, 2024 +One-line Summary: fix issues #1108, #1106, #1058, #1051, #1050; merge PR#1101 +Github PR URL: https://github.com/ESCOMP/CAM/pull/1131 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +Issue #1108 - More robust logic in gw_drag.F90 when deep_scheme='off' +- Modify build-namelist to set use_gw_convect_dp=.false. when + deep_scheme='off'. In gw_drag::gw_tend check whether field TTEND_DP is + in the pbuf. If so then associate the ttend_dp pointer. If not then + allocate the ttend_dp pointer and set to zero. + +PR #1101 - improved fix for rh write performance +- reorder output fields. Merge Jim's PR into this one. + +Issue #1106 - Report an error if a user uses --model_top with anything other than cam7 +- configure reports this error, but the output in the log file gets + obscured by a stack traceback issued from buildnml which is not useful. + The fix implemented in buildnml replaces the "raise RuntimeError" call with + a warning message in the log file. Then, if a subsequent check for CAM's + config_cache.xml file fails, the execution is terminated by a call to + the CIME.utils "expect()" routine. + +Issue #1058 - Remove unused pbuf variable smaw +- Remove both smaw and turbtype from physics buffer. Neither is used. + Remove the calculation of smaw entirely. Calculation of turbtype + remains. It is used locally, and may be written to history file + (UW_turbtype). + +Issue #1051 - Bad logic in SE dycore "interpolate_vector" subroutines +- These subroutines are not currently used by CAM as they are restricted to + interpolating fields on the GLL grid. Fix the conditional logic and + update the endrun message. + +Issue #1050 - Remove CAM3 as a compset or configure option + +Describe any changes made to build system: + +Describe any changes made to the namelist: +. build-namelist now sets use_gw_convect_dp=.false. when deep_scheme='off'. + +List any changes to the defaults for the boundary datasets: + +Describe any substantial timing or memory changes: + +Code reviewed by: peverwhee, nusbaume + +List all files eliminated: + +bld/namelist_files/use_cases/aquaplanet_cam3.xml +src/physics/cam/cam3_aero_data.F90 +src/physics/cam/cam3_ozone_data.F90 + +List all files added and what they do: + +List all existing files that have been modified, and describe the changes: + +bld/build-namelist +. add check to set use_gw_convect_dp=.false. when deep_scheme='off'. +. remove cam3 conditionals +. remove variables cam3_ozone_data_on, cam3_aero_data_on, bndtvo, bndtvaer +. remove cam3 ozone and aerosols from rad_climate specification. +. remove cam3 aerosol deposition fluxes +. remove add_default for fcrit2 + +bld/configure +. remove cam3 as valid physics package + +bld/config_files/definition.xml +. remove cam3 as valid value for -phys + +bld/namelist_files/namelist_defaults_cam.xml +. remove cam3 bulk aerosol files +. remove cam3 setting for fv_fft_flt + +bld/namelist_files/namelist_definition.xml +. remove definitions for cam3_ozone_data_on, cam3_aero_data_on, bndtvo, + bndtvaer, ozncyc +. remove cam3 as valid value for cam_physpkg +. remove definition for fcrit2 + +cime_config/buildnml +. replace RuntimeError exception with message to logger. + +cime_config/config_compsets.xml +. remove QPC3 + +cime_config/config_component.xml +. remove regexp matches for _CAM30 + +src/chemistry/modal_aero/modal_aero_rename.F90 +. remove cam3 comments + +src/chemistry/utils/prescribed_ozone.F90 +. remove cam3 conditional + +src/control/cam_history.F90 +. The variables in the restart history files are reordered so that the nacs + variables are all written together rather than being next to their + corresponding fields. + +src/control/cam_snapshot_common.F90 +. change npbuf_all from 327 to 314 +. fill_pbuf_info + - remove smaw, turbtype + - remove 11 fields: cam3_* + +src/control/runtime_opts.F90 +. remove refs to cam3_aero_data and cam3_ozone_data + +src/dynamics/fv/cd_core.F90 +src/dynamics/fv/dynamics_vars.F90 +. remove cam3 comments + +src/dynamics/se/dycore/interpolate_mod.F90 +. interpolate_vector2d and interpolate_vector3d + - fix conditional logic and clarify endrun message to indicate that the + input fields must be on the GLL grid. + +src/physics/cam/convect_shallow.F90 +. remove cam3 from conditional + +src/physics/cam/eddy_diff.F90 +. caleddy + - remove intent(out) arg sm_aw + +src/physics/cam/eddy_diff_cam.F90 +. eddy_diff_tend + - remove intent(out) args sm_aw and turbtype +. compute_eddy_diff + - remove intent(out) arg sm_aw + - remove intent(out) arg turbtype. use local storage for turbtype. + +src/physics/cam/gw_common.F90 +. remove cam3 comment + +src/physics/cam/gw_drag.F90 +. check that field TTEND_DP is in the pbuf before trying to associate the + pointer ttend_dp. If TTEND_DP is not in pbuf then allocate the ttend_dp + pointer and fill with zeros. +. remove fcrit2 from the namelist. Hardcode to 1.0 in GWBand call that + sets band_oro, just like all the other calls to GWBand. + +src/physics/cam/rk_stratiform.F90 +. remove cam3 from conditional + +src/physics/cam/uwshcu.F90 +. remove cam3 comment + +src/physics/cam/vertical_diffusion.F90 +. remove smaw and turbtype from physics buffer +. vertical_diffusion_tend + - remove smaw and turbtype as actual args in call to eddy_diff_tend + +src/physics/cam/zm_conv_intr.F90 +. remove cam3 conditional + +src/physics/camrt/radlw.F90 +. remove cam3 conditional + +src/physics/rrtmg/aer_src/rrtmg_sw_init.f90 +. remove cam3 comment + + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + + ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s (Overall: FAIL) + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s + SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s (Overall: PEND) + - pre-existing failures -- need fix in CLM external + +derecho/nvhpc/aux_cam: ALL PASS + +izumi/nag/aux_cam: + + DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae (Overall: FAIL) + - pre-existing failure - issue #670 + +izumi/gnu/aux_cam: ALL PASS + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB + +=============================================================== +=============================================================== + +Tag name: cam6_4_030 +Originator(s): eaton, cacraig +Date: Sept 6, 2024 +One-line Summary: fix psl values sent to coupler in cam7 +Github PR URL: https://github.com/ESCOMP/CAM/pull/1128 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + +. Fix issue #1116 - Test SMS_Ld2.ne30pg3_t232.BMT1850.derecho_gnu.allactive-defaultio Fails + - The cam7 version of tphysbc has a call to cpslec added in front of the + call to cam_export so that psl is set consistent with the state sent to + the coupler. + +. Fix issue #805 - cplsec.F90 needs to be in a module. + - Add subroutine cpslec to a new module, src/utils/cam_diagnostic_utils.F90 + +Describe any changes made to build system: none + +Describe any changes made to the namelist: none + +List any changes to the defaults for the boundary datasets: none + +Describe any substantial timing or memory changes: none + +Code reviewed by: cacraig + +List all files eliminated: + +src/physics/cam/cpslec.F90 +. subroutine cpslec moved to new module + +List all files added and what they do: + +src/utils/cam_diagnostic_utils.F90 +. subroutine cpslec added to this new module + +List all existing files that have been modified, and describe the changes: + +src/physics/cam/cam_diagnostics.F90 +. add access to cpslec from cam_diagnostic_utils module + +src/physics/cam7/physpkg.F90 +. add calculation of psl to tphysbc right in front of call to cam_export + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + FAIL SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s RUN time=77 + PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s + - pre-existing failures -- need fix in CLM external + + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s COMPARE_base_rest + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp (Overall: DIFF) details: + ERP_Ld3.ne30pg3_ne30pg3_mg17.FCts4MTHIST.derecho_intel.cam-outfrq1d_aoa (Overall: DIFF) details: + ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam7 (Overall: DIFF) details: + SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s (Overall: DIFF) details: + SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s_Leung_dust (Overall: DIFF) details: + - CPL history file has difference in the atmImp_Sa_pslv field for CAM7 runs + +derecho/nvhpc/aux_cam: + ERS_Ln9_G4-a100-openacc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_mg3_default (Overall: DIFF) details: + - CPL history file has difference in the atmImp_Sa_pslv field for CAM7 runs + +izumi/nag/aux_cam: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure - issue #670 + +izumi/gnu/aux_cam: all BFB + +CAM tag used for the baseline comparison tests if different than previous +tag: + +Summarize any changes to answers: BFB in F compsets. Answers will change + in B compsets. + +=============================================================== +=============================================================== +Tag name: cam6_4_029 +Originator(s): fvitt +Date: 5 Sep 2024 +One-line Summary: Updates to age of air diagnostic tracers +Github PR URL: https://github.com/ESCOMP/CAM/pull/1110 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + New age of air tracer (issue #1082): + Implement an age of air diagnostic tracer (AOA1MF) which has a mixing ratio lower + boundary condition which increases 2% per year starting from 1.e-6. Initial mass mixing + ratios. Legacy age of air tracers AOA1 and AOA2 are removed. + + Update upper boundary file in CAM LT use case for simulations that begin in 1850. + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraigucar + +List all files eliminated: N/A + +List all files added and what they do: +A cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq1d_aoa/user_nl_clm + - for testing age-of-air tracers + +List all existing files that have been modified, and describe the changes: +M bld/configure + - change number of advected AOA tracers to 3 + +M bld/namelist_files/use_cases/1950-2010_ccmi_refc1_waccmx_ma.xml +M bld/namelist_files/use_cases/sd_waccm_ma_cam4.xml +M bld/namelist_files/use_cases/sd_waccm_ma_cam6.xml +M bld/namelist_files/use_cases/sd_waccm_sulfur.xml +M bld/namelist_files/use_cases/sd_waccm_tsmlt_cam6.xml +M bld/namelist_files/use_cases/sd_waccmx_ma_cam4.xml +M bld/namelist_files/use_cases/sd_waccmx_ma_cam6.xml +M bld/namelist_files/use_cases/soa_chem_megan_emis.xml +M bld/namelist_files/use_cases/waccm_carma_bc_2013_cam4.xml +M bld/namelist_files/use_cases/waccm_ma_1850_cam6.xml +M bld/namelist_files/use_cases/waccm_ma_2000_cam6.xml +M bld/namelist_files/use_cases/waccm_ma_hist_cam4.xml +M bld/namelist_files/use_cases/waccm_ma_hist_cam6.xml +M bld/namelist_files/use_cases/waccm_sc_1850_cam6.xml +M bld/namelist_files/use_cases/waccm_sc_2000_cam6.xml +M bld/namelist_files/use_cases/waccm_sc_2010_cam6.xml +M bld/namelist_files/use_cases/waccm_sc_hist_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_1850_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_2000_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_2010_cam6.xml +M bld/namelist_files/use_cases/waccm_tsmlt_hist_cam6.xml +M bld/namelist_files/use_cases/waccmx_ma_2000_cam4.xml +M bld/namelist_files/use_cases/waccmx_ma_2000_cam6.xml +M bld/namelist_files/use_cases/waccmx_ma_hist_cam6.xml +M bld/namelist_files/use_cases/waccmxie_ma_2000_cam4.xml + - remove obsolete AOA tracer fields from fincl lists + +M bld/namelist_files/use_cases/hist_cam_lt.xml + - update UBC file for runs that start in 1850 + +M cime_config/testdefs/testlist_cam.xml + - add new TS4-cam7-MT AOA test + +M src/physics/cam/aoa_tracers.F90 + - implement new AOAMF tracer (described above) + - remove obsolete AOA1 and AOA2 tracers + +M src/physics/cam/physpkg.F90 +M src/physics/cam7/physpkg.F90 + - aoa_tracers_timestep_tend interface change + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s + - pre-existing failures -- need fix in CLM external + + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s COMPARE_base_rest + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + NLFAIL ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s + NLFAIL ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp + - change in ubc_file_path, otherwise bit-for-bit + + DIFF ERC_D_Ln9.f19_f19_mg17.QPX2000.derecho_intel.cam-outfrq3s + DIFF ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d + DIFF ERP_Ld3.ne30pg3_ne30pg3_mg17.FCts4MTHIST.derecho_intel.cam-outfrq1d_aoa + DIFF ERP_Lh12.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h + DIFF ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes + DIFF ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s + DIFF ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday + DIFF SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 + DIFF SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie + DIFF SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase + DIFF SMS_D_Ln9.ne16_ne16_mg17.QPX2000.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s + DIFF SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d + DIFF SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d + DIFF SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h + DIFF SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s + DIFF SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp + - expect baseline failures -- differences in age-of-air tracers + otherwise bit-for-bit + +derecho/nvhpc/aux_cam: PASS + +izumi/nag/aux_cam: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure - issue #670 + + DIFF ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s + DIFF SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s + DIFF SMS_D_Ln6.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem + - expect baseline failures -- differences in age-of-air tracers + otherwise bit-for-bit + +izumi/gnu/aux_cam: + DIFF SMS_D_Ln9.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee + DIFF SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s + - expect baseline failures -- differences in age-of-air tracers + otherwise bit-for-bit + +Summarize any changes to answers: bit-for-bit + +=============================================================== +=============================================================== + +Tag name: cam6_4_028 +Originator(s): fvitt +Date: 4 Sep 2024 +One-line Summary: Add capability to use Leung dust emission scheme +Github PR URL: https://github.com/ESCOMP/CAM/pull/1104 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Add the capability to use Leung_2023 land model dust emission scheme. + Zender_2003 is the default scheme for all F compsets. + (issues #141 and #654) + + NOTE: This reverts cam7 compsets back to Zender_2003 dust emissions. + In tag cam6_4_027 cam7 compsets dust emissions scheme defaulted to + Leung_2023 and where not properly scaled. + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: ekluzek, cacraigucar + +List all files eliminated: N/A + +List all files added and what they do: +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_Leung_dust/shell_commands +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_Leung_dust/user_nl_cam +A cime_config/testdefs/testmods_dirs/cam/outfrq9s_Leung_dust/user_nl_clm + - add test for Leung_2023 dust emis scheme + +List all existing files that have been modified, and describe the changes: +M bld/build-namelist +M bld/namelist_files/namelist_defaults_cam.xml + - set default dust emis namelist settings (Zender_2003 is the default scheme) + +M bld/namelist_files/namelist_definition.xml + - new dust emis namelist vars: + . dust_emis_method ('Zender_2003' or 'Leung_2023') + . zend_soil_erod_source ('atm' or 'lnd') + +M cime_config/config_compsets.xml + - override the 'LND_SETS_DUST_EMIS_DRV_FLDS' xml setting to be FALSE for cam7/clm6 F compsets + +M cime_config/testdefs/testlist_cam.xml + - increase time for aux_cam HEMCO test + - regression test Leung_2023 dust emis scheme + +M src/chemistry/bulk_aero/dust_model.F90 +M src/chemistry/modal_aero/dust_model.F90 + - use soil_erod only if Zender scheme is used + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s + - pre-existing failures -- need fix in CLM external + + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s COMPARE_base_rest + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + DIFF ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s + DIFF ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp + DIFF SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FCts4MTHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s + - differences due to switching dust emis scheme from Leung_2023 to Zender_2003 + + DIFF SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s_Leung_dust + - new reg test -- no baseline to compare against + + NLFAIL ERC_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq3s_cosp + NLFAIL ERC_D_Ln9.f19_f19_mg17.QPMOZ.derecho_intel.cam-outfrq3s + NLFAIL ERC_D_Ln9.f19_f19_mg17.QPX2000.derecho_intel.cam-outfrq3s + NLFAIL ERC_D_Ln9.ne16_ne16_mg17.FADIAB.derecho_intel.cam-terminator + NLFAIL ERC_D_Ln9.ne16_ne16_mg17.QPC5HIST.derecho_intel.cam-outfrq3s_usecase + NLFAIL ERC_D_Ln9_P144x1.ne16pg3_ne16pg3_mg17.QPC6HIST.derecho_intel.cam-outfrq3s_ttrac_usecase + NLFAIL ERC_D_Ln9.T42_T42_mg17.FDABIP04.derecho_intel.cam-outfrq3s_usecase + NLFAIL ERC_D_Ln9.T42_T42_mg17.FHS94.derecho_intel.cam-outfrq3s_usecase + NLFAIL ERI_D_Ln18.f45_f45_mg37.QPC41850.derecho_intel.cam-co2rmp_usecase + NLFAIL ERP_D_Ln9.f19_f19_mg17.QPC6.derecho_intel.cam-outfrq9s + NLFAIL ERP_D_Ln9_P64x2.f09_f09_mg17.QSC6.derecho_intel.cam-outfrq9s + NLFAIL ERP_Ln9_P24x3.f45_f45_mg37.QPWmaC6.derecho_intel.cam-outfrq9s_mee_fluxes + NLFAIL ERS_Ln9.f19_f19_mg17.FSPCAMS.derecho_intel.cam-outfrq9s + NLFAIL ERS_Ln9.ne0TESTONLYne5x4_ne0TESTONLYne5x4_mg37.FADIAB.derecho_intel.cam-outfrq3s_refined + NLFAIL SCT_D_Ln7.ne3_ne3_mg37.QPC5.derecho_intel.cam-scm_prep + NLFAIL SCT_D_Ln7.T42_T42_mg17.QPC5.derecho_intel.cam-scm_prep + NLFAIL SMS_D_Ld2.f19_f19_mg17.QPC5HIST.derecho_intel.cam-volc_usecase + NLFAIL SMS_D_Ld5.f19_f19_mg17.PC4.derecho_intel.cam-cam4_port5d + NLFAIL SMS_D_Ln9.f19_f19_mg17.QPC2000climo.derecho_intel.cam-outfrq3s_usecase + NLFAIL SMS_D_Ln9.f19_f19_mg17.QPC5M7.derecho_intel.cam-outfrq9s + NLFAIL SMS_D_Ln9.ne16_ne16_mg17.QPX2000.derecho_intel.cam-outfrq9s + NLFAIL SMS_Ld5.f09_f09_mg17.PC6.derecho_intel.cam-cam6_port_f09 + NLFAIL SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem + - namelist compare failures due to dust_emis_inparm namelist in drv_flds_in + otherwise bit-for-bit + +derecho/nvhpc/aux_cam: + DIFF ERS_Ln9_G4-a100-openacc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_mg3_default + - difference due to switching dust emis scheme from Leung_2023 to Zender_2003 + +izumi/nag/aux_cam: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure - issue #670 + + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-carma_sea_salt + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_cosp + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_subcol + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_am + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_cospsathist + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPWmaC6.izumi_nag.cam-outfrq3s + NLFAIL ERC_D_Ln9.f10_f10_mg37.QSPCAMS.izumi_nag.cam-outfrq3s + NLFAIL ERC_D_Ln9.mpasa480z32_mpasa480.FHS94.izumi_nag.cam-outfrq3s_usecase + NLFAIL ERC_D_Ln9.ne16_ne16_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase + NLFAIL ERC_D_Ln9.ne16pg3_ne16pg3_mg17.QPC4.izumi_nag.cam-outfrq3s_usecase + NLFAIL ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-outfrq3s_ttrac + NLFAIL ERC_D_Ln9.T5_T5_mg37.QPC4.izumi_nag.cam-outfrq3s_usecase + NLFAIL ERI_D_Ln18.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac + NLFAIL ERI_D_Ln18.f19_f19_mg17.QPC6.izumi_nag.cam-ghgrmp_e8 + NLFAIL ERI_D_Ln18.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic + NLFAIL ERI_D_Ln18.ne5pg3_ne5pg3_mg37.FADIAB.izumi_nag.cam-outfrq3s_bwic + NLFAIL ERP_Ln9.ne5pg3_ne5pg3_mg37.QPC6.izumi_nag.cam-outfrq9s_clubbmf + NLFAIL ERS_Ln27.ne5pg3_ne5pg3_mg37.FKESSLER.izumi_nag.cam-outfrq9s + NLFAIL ERS_Ln9.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq9s + NLFAIL PEM_D_Ln9.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s + NLFAIL PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 + NLFAIL PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 + NLFAIL PLB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 + NLFAIL PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal0 + NLFAIL PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal1 + NLFAIL PLB_D_Ln9.ne5_ne5_mg37.QPC5.izumi_nag.cam-ttrac_loadbal3 + NLFAIL SMS_D_Ld2.f45_f45_mg37.PC5.izumi_nag.cam-outfrq24h_port + NLFAIL SMS_D_Ln3.ne5pg3_ne5pg3_mg37.QPX2000.izumi_nag.cam-outfrq3s + NLFAIL SMS_D_Ln6.ne5_ne5_mg37.QPWmaC4.izumi_nag.cam-outfrq3s_physgrid_tem + NLFAIL SMS_D_Ln7.T42_T42_mg17.QPSCAMC5.izumi_nag.cam-scmarm + NLFAIL SMS_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-rad_diag_mam + NLFAIL SMS_D_Ln9.f10_f10_mg37.QPC6.izumi_nag.cam-outfrq3s_ba + NLFAIL SMS_D_Ln9_P1x1.ne5_ne5_mg37.FADIAB.izumi_nag.cam-outfrq3s + NLFAIL SMS_P48x1_D_Ln3.f09_f09_mg17.QPC6HIST.izumi_nag.cam-outfrq3s_co2cycle_usecase + NLFAIL SUB_D_Ln9.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s + NLFAIL TMC_D.f10_f10_mg37.QPC5.izumi_nag.cam-outfrq3s_eoyttrac + NLFAIL TMC_D.T5_T5_mg37.QPC5.izumi_nag.cam-ghgrmp_e8 + - namelist compare failures due to dust_emis_inparm namelist in drv_flds_in + otherwise bit-for-bit + +izumi/gnu/aux_cam: + NLFAIL ERC_D_Ln9.f10_f10_mg37.FADIAB.izumi_gnu.cam-terminator + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC4.izumi_gnu.cam-outfrq3s_diags + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-outfrq3s_unicon + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPC5.izumi_gnu.cam-rad_diag + NLFAIL ERC_D_Ln9.f10_f10_mg37.QPSPCAMM.izumi_gnu.cam-outfrq3s + NLFAIL ERC_D_Ln9.ne5_ne5_mg37.QPC4.izumi_gnu.cam-outfrq3s_nudging_ne5_L26 + NLFAIL ERC_D_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq3s_ba + NLFAIL ERC_D_Ln9.ne5pg2_ne5pg2_mg37.FADIAB.izumi_gnu.cam-outfrq3s + NLFAIL ERC_D_Ln9.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s + NLFAIL ERI_D_Ln18.T5_T5_mg37.QPC4.izumi_gnu.cam-co2rmp + NLFAIL ERP_D_Ln9.C48_C48_mg17.QPC6.izumi_gnu.cam-outfrq9s + NLFAIL ERP_D_Ln9.ne3pg3_ne3pg3_mg37.QPC6.izumi_gnu.cam-outfrq9s_rrtmgp + NLFAIL ERP_Ln9.ne5_ne5_mg37.FHS94.izumi_gnu.cam-outfrq9s + NLFAIL ERP_Ln9.ne5_ne5_mg37.QPC5.izumi_gnu.cam-outfrq9s + NLFAIL PEM_D_Ln9.ne5pg3_ne5pg3_mg37.FADIAB.izumi_gnu.cam-outfrq3s + NLFAIL PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal0 + NLFAIL PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal1 + NLFAIL PLB_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-ttrac_loadbal3 + NLFAIL SCT_D_Ln7.ne3_ne3_mg37.QPC6.izumi_gnu.cam-scm_prep_c6 + NLFAIL SCT_D_Ln7.T42_T42_mg17.QPC4.izumi_gnu.cam-scm_prep + NLFAIL SCT_D_Ln7.T42_T42_mg17.QPC6.izumi_gnu.cam-scm_prep_c6 + NLFAIL SMS_D_Ln3.f10_f10_mg37.QPMOZ.izumi_gnu.cam-outfrq3s_chemproc + NLFAIL SMS_D_Ln9.f10_f10_mg37.QPWmaC4.izumi_gnu.cam-outfrq9s_apmee + NLFAIL SMS_D_Ln9.ne5pg3_ne5pg3_mg37.QPC5.izumi_gnu.cam-outfrq3s_ttrac + NLFAIL SMS_Ld5.f09_f09_mg17.PC6.izumi_gnu.cam-cam6_port_f09_rrtmgp + - namelist compare failures due to dust_emis_inparm namelist in drv_flds_in + otherwise bit-for-bit + +Summarize any changes to answers: larger than roundoff for cam7, otherwise bit-for-bit + +=============================================================== +=============================================================== + +Tag name: cam6_4_027 +Originator(s): fvitt +Date: 3 Sep 2024 +One-line Summary: Update land model tag to ctsm5.2.027 +Github PR URL: https://github.com/ESCOMP/CAM/pull/1140 + +Purpose of changes (include the issue number and title text for each relevant GitHub issue): + + Update of the CTSM external is needed for new dust emissions capabilities. + Issue #1139 + + The changes which affect CAM are summarized as: + ctsm5.2.016 -- changes answers for clm6_0 for crop grid cells + ctsm5.2.020 -- changes answers for all physics options for MEGAN BGVOC's which will affect CAM-Chem simulations + ctsm5.2.026 -- change answers for clm6_0 over urban grid cells + +Describe any changes made to build system: N/A + +Describe any changes made to the namelist: N/A + +List any changes to the defaults for the boundary datasets: N/A + +Describe any substantial timing or memory changes: N/A + +Code reviewed by: cacraigucar + +List all files eliminated: N/A + +List all files added and what they do: N/A + +List all existing files that have been modified, and describe the changes: +M .gitmodules +M components/clm + - update ctsm to ctsm5.2.027 + +If there were any failures reported from running test_driver.sh on any test +platform, and checkin with these failures has been OK'd by the gatekeeper, +then copy the lines from the td.*.status files for the failed tests to the +appropriate machine below. All failed tests must be justified. + +derecho/intel/aux_cam: + + FAIL ERP_Ln9.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq9s + - pre-existing failure due to HEMCO not having reproducible results issues #1018 and #856 + + PEND SMS_D_Ln9_P1280x1.ne0CONUSne30x8_ne0CONUSne30x8_mt12.FCHIST.derecho_intel.cam-outfrq9s + - pre-existing failures -- need fix in CLM external + + DIFF ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s + DIFF ERP_D_Ln9.ne30pg3_ne30pg3_mg17.FLTHIST.derecho_intel.cam-outfrq9s_rrtmgp + DIFF ERP_Ld3.f09_f09_mg17.FWHIST.derecho_intel.cam-reduced_hist1d + DIFF ERP_Lh12.f19_f19_mg17.FW4madSD.derecho_intel.cam-outfrq3h + DIFF ERP_Ln9.C96_C96_mg17.F2000climo.derecho_intel.cam-outfrq9s_mg3 + DIFF ERP_Ln9.f09_f09_mg17.F1850.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.f09_f09_mg17.F2000climo.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.f09_f09_mg17.FHIST_BDRD.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.f19_f19_mg17.FWsc1850.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.ne30pg3_ne30pg3_mg17.FCnudged.derecho_intel.cam-outfrq9s + DIFF ERP_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s + DIFF ERS_Ld3.f10_f10_mg37.F1850.derecho_intel.cam-outfrq1d_14dec_ghg_cam7 + DIFF ERS_Ln9.f09_f09_mg17.FX2000.derecho_intel.cam-outfrq9s + DIFF ERS_Ln9.f19_f19_mg17.FSPCAMS.derecho_intel.cam-outfrq9s + DIFF ERS_Ln9.f19_f19_mg17.FXSD.derecho_intel.cam-outfrq9s + DIFF ERS_Ln9_P288x1.mpasa120_mpasa120.F2000climo.derecho_intel.cam-outfrq9s_mpasa120 + DIFF ERS_Ln9_P36x1.mpasa480_mpasa480.F2000climo.derecho_intel.cam-outfrq9s_mpasa480 + DIFF SMS_D_Ln9.f09_f09_mg17.FCts2nudged.derecho_intel.cam-outfrq9s_leapday + DIFF SMS_D_Ln9.f09_f09_mg17.FCvbsxHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f09_f09_mg17.FSD.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.f19_f19_mg17.FWma2000climo.derecho_intel.cam-outfrq9s_waccm_ma_mam4 + DIFF SMS_D_Ln9.f19_f19_mg17.FXHIST.derecho_intel.cam-outfrq9s_amie + DIFF SMS_D_Ln9.ne16pg3_ne16pg3_mg17.FX2000.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FCts4MTHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.ne30pg3_ne30pg3_mg17.FMTHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9_P1280x1.ne0ARCTICne30x4_ne0ARCTICne30x4_mt12.FHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9_P1280x1.ne30pg3_ne30pg3_mg17.FCLTHIST.derecho_intel.cam-outfrq9s + DIFF SMS_D_Ln9.T42_T42.FSCAMARM97.derecho_intel.cam-outfrq9s + DIFF SMS_Ld1.f09_f09_mg17.FCHIST_GC.derecho_intel.cam-outfrq1d + DIFF SMS_Ld1.f09_f09_mg17.FW2000climo.derecho_intel.cam-outfrq1d + DIFF SMS_Ld1.ne30pg3_ne30pg3_mg17.FC2010climo.derecho_intel.cam-outfrq1d + DIFF SMS_Lh12.f09_f09_mg17.FCSD_HCO.derecho_intel.cam-outfrq3h + DIFF SMS_Lm13.f10_f10_mg37.F2000climo.derecho_intel.cam-outfrq1m + DIFF SMS_Ln9.f09_f09_mg17.F2010climo.derecho_intel.cam-nudging + DIFF SMS_Ln9.f09_f09_mg17.FW1850.derecho_intel.cam-reduced_hist3s + DIFF SMS_Ln9.f19_f19.F2000climo.derecho_intel.cam-silhs + DIFF SMS_Ln9.f19_f19_mg17.FHIST.derecho_intel.cam-outfrq9s_nochem + DIFF SMS_Ln9.ne30pg3_ne30pg3_mg17.FW2000climo.derecho_intel.cam-outfrq9s_rrtmgp + - expected baseline test failures + +derecho/nvhpc/aux_cam: + DIFF ERS_Ln9_G4-a100-openacc.ne30pg3_ne30pg3_mg17.F2000dev.derecho_nvhpc.cam-outfrq9s_mg3_default + - expected baseline test failure + +izumi/nag/aux_cam: + FAIL DAE.f45_f45_mg37.FHS94.izumi_nag.cam-dae + - pre-existing failure - issue #670 + +izumi/gnu/aux_cam: + DIFF SMS_P48x1_D_Ln9.f19_f19_mg17.FW4madSD.izumi_gnu.cam-outfrq9s + - expected baseline test failure + +Summarize any changes to answers: larger than roundoff + +=============================================================== =============================================================== Tag name: cam6_4_026 diff --git a/src/chemistry/aerosol/aero_convproc.F90 b/src/chemistry/aerosol/aero_convproc.F90 new file mode 100644 index 0000000000..1915e295ad --- /dev/null +++ b/src/chemistry/aerosol/aero_convproc.F90 @@ -0,0 +1,2146 @@ +module aero_convproc +!--------------------------------------------------------------------------------- +! Purpose: +! +! CAM interface to aerosol/trace-gas convective cloud processing scheme +! +! currently these routines assume stratiform and convective clouds only interact +! through the detrainment of convective cloudborne material into stratiform clouds +! +! thus the stratiform-cloudborne aerosols (in the qqcw array) are not processed +! by the convective up/downdrafts, but are affected by the detrainment +! +! Author: R. C. Easter +! +!--------------------------------------------------------------------------------- + +use shr_kind_mod, only: r8=>shr_kind_r8 +use shr_kind_mod, only: shr_kind_cs + +use spmd_utils, only: masterproc +use physconst, only: gravit, rair +use ppgrid, only: pver, pcols, pverp +use constituents, only: pcnst, cnst_get_ind +use constituents, only: cnst_species_class, cnst_spec_class_aerosol +use phys_control, only: phys_getopts + +use physics_types, only: physics_state, physics_ptend +use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field +use time_manager, only: get_nstep +use cam_history, only: outfld, addfld, add_default, horiz_only +use cam_logfile, only: iulog +use cam_abortutils, only: endrun + +use aerosol_properties_mod, only: aerosol_properties +use aerosol_state_mod, only: aerosol_state, ptr2d_t + +implicit none +private + +public :: aero_convproc_readnl +public :: aero_convproc_init +public :: aero_convproc_intr + +! namelist options +! NOTE: These are the defaults for CAM6. +logical, protected, public :: deepconv_wetdep_history = .true. +logical, protected, public :: convproc_do_deep = .true. +! NOTE: These are the defaults for the Eaton/Wang parameterization. +logical, protected, public :: convproc_do_evaprain_atonce = .false. +real(r8), protected, public :: convproc_pom_spechygro = -1._r8 +real(r8), protected, public :: convproc_wup_max = 4.0_r8 + +logical, parameter :: use_cwaer_for_activate_maxsat = .false. +logical, parameter :: apply_convproc_tend_to_ptend = .true. + +real(r8) :: hund_ovr_g ! = 100.0_r8/gravit +! used with zm_conv mass fluxes and delta-p +! for mu = [mbar/s], mu*hund_ovr_g = [kg/m2/s] +! for dp = [mbar] and q = [kg/kg], q*dp*hund_ovr_g = [kg/m2] + +! method1_activate_nlayers = number of layers (including cloud base) where activation is applied +integer, parameter :: method1_activate_nlayers = 2 +! method2_activate_smaxmax = the uniform or peak supersat value (as 0-1 fraction = percent*0.01) +real(r8), parameter :: method2_activate_smaxmax = 0.003_r8 + +! method_reduce_actfrac = 1 -- multiply activation fractions by factor_reduce_actfrac +! (this works ok with convproc_method_activate = 1 but not for ... = 2) +! = 2 -- do 2 iterations to get an overall reduction by factor_reduce_actfrac +! (this works ok with convproc_method_activate = 1 or 2) +! = other -- do nothing involving reduce_actfrac +integer, parameter :: method_reduce_actfrac = 0 +real(r8), parameter :: factor_reduce_actfrac = 0.5_r8 + +! convproc_method_activate - 1=apply abdulrazzak-ghan to entrained aerosols for lowest nlayers +! 2=do secondary activation with prescribed supersat +integer, parameter :: convproc_method_activate = 2 + +logical :: convproc_do_aer + +! physics buffer indices +integer :: fracis_idx = 0 + +integer :: rprddp_idx = 0 +integer :: rprdsh_idx = 0 +integer :: nevapr_shcu_idx = 0 +integer :: nevapr_dpcu_idx = 0 + +integer :: icwmrdp_idx = 0 +integer :: icwmrsh_idx = 0 +integer :: sh_frac_idx = 0 +integer :: dp_frac_idx = 0 + +integer :: zm_eu_idx = 0 +integer :: zm_du_idx = 0 +integer :: zm_ed_idx = 0 +integer :: zm_dp_idx = 0 +integer :: zm_jt_idx = 0 +integer :: zm_maxg_idx = 0 +integer :: zm_ideep_idx = 0 + +integer :: cmfmc_sh_idx = 0 +integer :: sh_e_ed_ratio_idx = 0 + +integer :: istat + +integer :: nbins = 0 +integer :: ncnstaer = 0 + +integer, allocatable :: aer_cnst_ndx(:) + +character(len=32), allocatable :: cnst_name_extd(:,:) ! (2,ncnstaer) + +contains + +!========================================================================================= +subroutine aero_convproc_readnl(nlfile) + + use namelist_utils, only: find_group_name + use spmd_utils, only: mpicom, masterprocid, mpi_real8, mpi_logical + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + ! Local variables + integer :: unitn, ierr + character(len=*), parameter :: subname = 'aero_convproc_readnl' + + namelist /aerosol_convproc_opts/ deepconv_wetdep_history, convproc_do_deep, & + convproc_do_evaprain_atonce, convproc_pom_spechygro, convproc_wup_max + + ! Read namelist + if (masterproc) then + open( newunit=unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'aerosol_convproc_opts', status=ierr) + if (ierr == 0) then + read(unitn, aerosol_convproc_opts, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + end if + + ! Broadcast namelist variables + call mpi_bcast( deepconv_wetdep_history, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast( convproc_do_deep, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast( convproc_do_evaprain_atonce, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast( convproc_pom_spechygro, 1, mpi_real8, masterprocid, mpicom, ierr) + call mpi_bcast( convproc_wup_max, 1, mpi_real8, masterprocid, mpicom, ierr) + + if (masterproc) then + write(iulog,*) subname//': deepconv_wetdep_history = ',deepconv_wetdep_history + write(iulog,*) subname//': convproc_do_deep = ',convproc_do_deep + write(iulog,*) subname//': convproc_do_evaprain_atonce = ',convproc_do_evaprain_atonce + write(iulog,*) subname//': convproc_pom_spechygro = ',convproc_pom_spechygro + write(iulog,*) subname//': convproc_wup_max = ', convproc_wup_max + end if + +end subroutine aero_convproc_readnl + +!========================================================================================= + +subroutine aero_convproc_init(aero_props) + + class(aerosol_properties), intent(in) :: aero_props + + integer :: m, mm, l, ndx, astat + integer :: npass_calc_updraft + logical :: history_aerosol + character(len=32) :: name_a, name_c + + character(len=*), parameter :: prefix = 'aero_convproc_init: ' + + hund_ovr_g = 100.0_r8/gravit + ! used with zm_conv mass fluxes and delta-p + ! for mu = [mbar/s], mu*hund_ovr_g = [kg/m2/s] + ! for dp = [mbar] and q = [kg/kg], q*dp*hund_ovr_g = [kg/m2] + + nbins = aero_props%nbins() + ncnstaer = aero_props%ncnst_tot() + + allocate(aer_cnst_ndx(ncnstaer),stat=astat) + if (astat/=0) then + call endrun(prefix//'aer_cnst_ndx allocation error') + end if + allocate(cnst_name_extd(2,ncnstaer),stat=astat) + if (astat/=0) then + call endrun(prefix//'cnst_name_extd allocation error') + end if + + aer_cnst_ndx(:) = -1 + + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + if (l==0) then + call aero_props%num_names(m, name_a, name_c) + else + call aero_props%mmr_names(m,l, name_a, name_c) + endif + cnst_name_extd(1,mm) = name_a + cnst_name_extd(2,mm) = name_c + + call cnst_get_ind(trim(name_a), ndx, abort=.false.) + aer_cnst_ndx(mm) = ndx + end do + end do + + call phys_getopts( history_aerosol_out=history_aerosol, & + convproc_do_aer_out = convproc_do_aer ) + + call addfld('DP_MFUP_MAX', horiz_only, 'A', 'kg/m2', & + 'Deep conv. column-max updraft mass flux' ) + call addfld('DP_WCLDBASE', horiz_only, 'A', 'm/s', & + 'Deep conv. cloudbase vertical velocity' ) + call addfld('DP_KCLDBASE', horiz_only, 'A', '1', & + 'Deep conv. cloudbase level index' ) + + ! output wet deposition fields to history + ! I = in-cloud removal; E = precip-evap resuspension + ! C = convective (total); D = deep convective + ! note that the precip-evap resuspension includes that resulting from + ! below-cloud removal, calculated in mz_aero_wet_intr + if (convproc_do_aer .and. apply_convproc_tend_to_ptend ) then + + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + + ndx = aer_cnst_ndx(mm) + + if ( deepconv_wetdep_history ) then + call addfld (trim(cnst_name_extd(1,mm))//'SFSID', & + horiz_only, 'A','kg/m2/s','Wet deposition flux (incloud, deep convective) at surface') + call addfld (trim(cnst_name_extd(1,mm))//'SFSED', & + horiz_only, 'A','kg/m2/s','Wet deposition flux (precip evap, deep convective) at surface') + if (history_aerosol) then + call add_default(trim(cnst_name_extd(1,mm))//'SFSID', 1, ' ') + call add_default(trim(cnst_name_extd(1,mm))//'SFSED', 1, ' ') + end if + end if + + end do + end do + end if + + if ( history_aerosol .and. convproc_do_aer ) then + call add_default( 'DP_MFUP_MAX', 1, ' ' ) + call add_default( 'DP_WCLDBASE', 1, ' ' ) + call add_default( 'DP_KCLDBASE', 1, ' ' ) + end if + + fracis_idx = pbuf_get_index('FRACIS') + + rprddp_idx = pbuf_get_index('RPRDDP') + rprdsh_idx = pbuf_get_index('RPRDSH') + nevapr_dpcu_idx = pbuf_get_index('NEVAPR_DPCU') + nevapr_shcu_idx = pbuf_get_index('NEVAPR_SHCU') + + icwmrdp_idx = pbuf_get_index('ICWMRDP') + icwmrsh_idx = pbuf_get_index('ICWMRSH') + dp_frac_idx = pbuf_get_index('DP_FRAC') + sh_frac_idx = pbuf_get_index('SH_FRAC') + + zm_eu_idx = pbuf_get_index('ZM_EU') + zm_du_idx = pbuf_get_index('ZM_DU') + zm_ed_idx = pbuf_get_index('ZM_ED') + zm_dp_idx = pbuf_get_index('ZM_DP') + zm_jt_idx = pbuf_get_index('ZM_JT') + zm_maxg_idx = pbuf_get_index('ZM_MAXG') + zm_ideep_idx = pbuf_get_index('ZM_IDEEP') + + cmfmc_sh_idx = pbuf_get_index('CMFMC_SH') + sh_e_ed_ratio_idx = pbuf_get_index('SH_E_ED_RATIO', istat) + + if (masterproc ) then + + write(iulog,'(a,l12)') 'aero_convproc_init - convproc_do_aer = ', & + convproc_do_aer + write(iulog,'(a,l12)') 'aero_convproc_init - use_cwaer_for_activate_maxsat = ', & + use_cwaer_for_activate_maxsat + write(iulog,'(a,l12)') 'aero_convproc_init - apply_convproc_tend_to_ptend = ', & + apply_convproc_tend_to_ptend + write(iulog,'(a,i12)') 'aero_convproc_init - convproc_method_activate = ', & + convproc_method_activate + write(iulog,'(a,i12)') 'aero_convproc_init - method1_activate_nlayers = ', & + method1_activate_nlayers + write(iulog,'(a,1pe12.4)') 'aero_convproc_init - method2_activate_smaxmax = ', & + method2_activate_smaxmax + write(iulog,'(a,i12)') 'aero_convproc_init - method_reduce_actfrac = ', & + method_reduce_actfrac + write(iulog,'(a,1pe12.4)') 'aero_convproc_init - factor_reduce_actfrac = ', & + factor_reduce_actfrac + + npass_calc_updraft = 1 + if ( (method_reduce_actfrac == 2) .and. & + (factor_reduce_actfrac >= 0.0_r8) .and. & + (factor_reduce_actfrac <= 1.0_r8) ) npass_calc_updraft = 2 + write(iulog,'(a,i12)') 'aero_convproc_init - npass_calc_updraft = ', & + npass_calc_updraft + + end if + +end subroutine aero_convproc_init + +!========================================================================================= + +subroutine aero_convproc_intr( aero_props, aero_state, state, ptend, pbuf, ztodt, & + nsrflx_mzaer2cnvpr, qsrflx_mzaer2cnvpr, & + aerdepwetis, dcondt_resusp3d ) +!----------------------------------------------------------------------- +! +! Convective cloud processing (transport, activation/resuspension, +! wet removal) of aerosols and trace gases. +! (Currently no aqueous chemistry and no trace-gas wet removal) +! Does aerosols when convproc_do_aer is .true. +! +! Does deep convection +! Uses mass fluxes, cloud water, precip production from the +! convective cloud routines +! +! Author: R. Easter +! +!----------------------------------------------------------------------- + + + ! Arguments + class(aerosol_properties), intent(in) :: aero_props + class(aerosol_state), intent(in) :: aero_state + + type(physics_state),target,intent(in ) :: state ! Physics state variables + type(physics_ptend), intent(inout) :: ptend ! %lq set in aero_model_wetdep + type(physics_buffer_desc), pointer :: pbuf(:) + real(r8), intent(in) :: ztodt ! 2 delta t (model time increment) + + integer, intent(in) :: nsrflx_mzaer2cnvpr + real(r8), intent(in) :: qsrflx_mzaer2cnvpr(pcols,ncnstaer,nsrflx_mzaer2cnvpr) + real(r8), intent(inout) :: aerdepwetis(pcols,pcnst) ! aerosol wet deposition (interstitial) + real(r8), intent(inout) :: dcondt_resusp3d(ncnstaer,pcols,pver) + + ! Local variables + integer, parameter :: nsrflx = 5 ! last dimension of qsrflx + integer :: l, m, mm, ndx, lchnk + integer :: ncol + + real(r8) :: dqdt(pcols,pver,ncnstaer) + real(r8) :: dt + + + + real(r8) :: q(pcols,pver,ncnstaer) + real(r8) :: qsrflx(pcols,ncnstaer,nsrflx) + real(r8), pointer :: qptr(:,:) + + real(r8) :: sflxic(pcols,ncnstaer) + real(r8) :: sflxid(pcols,ncnstaer) + real(r8) :: sflxec(pcols,ncnstaer) + real(r8) :: sflxed(pcols,ncnstaer) + + type(ptr2d_t) :: raer(ncnstaer) ! aerosol mass, number mixing ratios + type(ptr2d_t) :: qqcw(ncnstaer) + + logical :: dotend(pcnst) + logical :: applytend + + !------------------------------------------------------------------------------------------------- + + dotend = .false. + + ! Initialize + lchnk = state%lchnk + ncol = state%ncol + dt = ztodt + + sflxic(:,:) = 0.0_r8 + sflxid(:,:) = 0.0_r8 + sflxec(:,:) = 0.0_r8 + sflxed(:,:) = 0.0_r8 + + call aero_state%get_states( aero_props, raer, qqcw ) + + ! prepare for deep conv processing + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + + mm = aero_props%indexer(m,l) + ndx = aer_cnst_ndx(mm) + + sflxec(1:ncol,mm) = qsrflx_mzaer2cnvpr(1:ncol,mm,1) + sflxed(1:ncol,mm) = qsrflx_mzaer2cnvpr(1:ncol,mm,2) + + applytend = .false. + if ( ndx > 0 ) then + applytend = ptend%lq(ndx) + dotend(ndx) = applytend + endif + + qptr => raer(mm)%fld + + if ( applytend ) then + ! calc new q (after calcaersize and mz_aero_wet_intr) + q(1:ncol,:,mm) = max( 0.0_r8, qptr(1:ncol,:) + dt*ptend%q(1:ncol,:,ndx) ) + else + ! use old q + q(1:ncol,:,mm) = qptr(1:ncol,:) + end if + + end do + end do + + dqdt(:,:,:) = 0.0_r8 + qsrflx(:,:,:) = 0.0_r8 + + if (convproc_do_aer) then + + ! do deep conv processing + if (convproc_do_deep) then + call aero_convproc_dp_intr( aero_props, & + state, pbuf, dt, & + q, dqdt, nsrflx, qsrflx, dcondt_resusp3d ) + + ! apply deep conv processing tendency + + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + ndx = aer_cnst_ndx(mm) + + if ( apply_convproc_tend_to_ptend ) then + ! add dqdt onto ptend%q and set ptend%lq + if (ndx>0) then ! advected species + ptend%q(1:ncol,:,ndx) = ptend%q(1:ncol,:,ndx) + dqdt(1:ncol,:,mm) + else + raer(mm)%fld(1:ncol,:) = max( 0.0_r8, raer(mm)%fld(1:ncol,:) + dqdt(1:ncol,:,mm) * dt ) + end if + end if + + ! these used for history file wetdep diagnostics + sflxic(1:ncol,mm) = sflxic(1:ncol,mm) + qsrflx(1:ncol,mm,4) + sflxid(1:ncol,mm) = sflxid(1:ncol,mm) + qsrflx(1:ncol,mm,4) + sflxec(1:ncol,mm) = sflxec(1:ncol,mm) + qsrflx(1:ncol,mm,5) + sflxed(1:ncol,mm) = sflxed(1:ncol,mm) + qsrflx(1:ncol,mm,5) + + ! this used for surface coupling + if (ndx>0) then + aerdepwetis(1:ncol,ndx) = aerdepwetis(1:ncol,ndx) & + + qsrflx(1:ncol,mm,4) + qsrflx(1:ncol,mm,5) + end if + end do + end do + + end if + + end if ! (convproc_do_aer) then + + if (convproc_do_aer .and. apply_convproc_tend_to_ptend ) then + + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + + ndx = aer_cnst_ndx(mm) + + if (ndx>0) call outfld( trim(cnst_name_extd(1,mm))//'SFWET', aerdepwetis(:,ndx), pcols, lchnk ) + call outfld( trim(cnst_name_extd(1,mm))//'SFSIC', sflxic(:,mm), pcols, lchnk ) + call outfld( trim(cnst_name_extd(1,mm))//'SFSEC', sflxec(:,mm), pcols, lchnk ) + + if ( deepconv_wetdep_history ) then + call outfld( trim(cnst_name_extd(1,mm))//'SFSID', sflxid(:,mm), pcols, lchnk ) + call outfld( trim(cnst_name_extd(1,mm))//'SFSED', sflxed(:,mm), pcols, lchnk ) + end if + end do + end do + + end if + +end subroutine aero_convproc_intr + +!========================================================================================= + +subroutine aero_convproc_dp_intr( aero_props, & + state, pbuf, dt, & + q, dqdt, nsrflx, qsrflx, dcondt_resusp3d) +!----------------------------------------------------------------------- +! +! Convective cloud processing (transport, activation/resuspension, +! wet removal) of aerosols and trace gases. +! (Currently no aqueous chemistry and no trace-gas wet removal) +! Does aerosols when convproc_do_aer is .true. +! +! This routine does deep convection +! Uses mass fluxes, cloud water, precip production from the +! convective cloud routines +! +! Author: R. Easter +! +!----------------------------------------------------------------------- + + ! Arguments + class(aerosol_properties), intent(in) :: aero_props + + type(physics_state), intent(in ) :: state ! Physics state variables + type(physics_buffer_desc), pointer :: pbuf(:) + + real(r8), intent(in) :: dt ! delta t (model time increment) + + real(r8), intent(in) :: q(pcols,pver,ncnstaer) + real(r8), intent(inout) :: dqdt(pcols,pver,ncnstaer) + integer, intent(in) :: nsrflx + real(r8), intent(inout) :: qsrflx(pcols,ncnstaer,nsrflx) + real(r8), intent(inout) :: dcondt_resusp3d(ncnstaer,pcols,pver) + + integer :: i + integer :: lchnk + integer :: nstep + + real(r8) :: dpdry(pcols,pver) ! layer delta-p-dry (mb) + real(r8) :: fracice(pcols,pver) ! Ice fraction of cloud droplets + real(r8) :: xx_mfup_max(pcols), xx_wcldbase(pcols), xx_kcldbase(pcols) + + ! physics buffer fields + real(r8), pointer :: fracis(:,:,:) ! fraction of transported species that are insoluble + real(r8), pointer :: rprddp(:,:) ! Deep conv precip production (kg/kg/s - grid avg) + real(r8), pointer :: evapcdp(:,:) ! Deep conv precip evaporation (kg/kg/s - grid avg) + real(r8), pointer :: icwmrdp(:,:) ! Deep conv cloud condensate (kg/kg - in cloud) + real(r8), pointer :: dp_frac(:,:) ! Deep conv cloud frac (0-1) + + ! deep conv variables + real(r8), pointer :: du(:,:) ! Mass detrain rate from updraft (pcols,pver) + real(r8), pointer :: eu(:,:) ! Mass entrain rate into updraft (pcols,pver) + real(r8), pointer :: ed(:,:) ! Mass entrain rate into downdraft (pcols,pver) + ! eu, ed, du are "d(massflux)/dp" and are all positive + real(r8), pointer :: dp(:,:) ! Delta pressure between interfaces (pcols,pver) + integer, pointer :: jt(:) ! Index of cloud top for each column (pcols) + integer, pointer :: maxg(:) ! Index of cloud bottom for each column (pcols) + integer, pointer :: ideep(:) ! Gathering array (pcols) + integer :: lengath ! Gathered min lon indices over which to operate + + ! Initialize + + lchnk = state%lchnk + nstep = get_nstep() + + ! Associate pointers with physics buffer fields + call pbuf_get_field(pbuf, rprddp_idx, rprddp) + call pbuf_get_field(pbuf, nevapr_dpcu_idx, evapcdp) + call pbuf_get_field(pbuf, icwmrdp_idx, icwmrdp) + call pbuf_get_field(pbuf, dp_frac_idx, dp_frac) + call pbuf_get_field(pbuf, fracis_idx, fracis) + call pbuf_get_field(pbuf, zm_eu_idx, eu) + call pbuf_get_field(pbuf, zm_du_idx, du) + call pbuf_get_field(pbuf, zm_ed_idx, ed) + call pbuf_get_field(pbuf, zm_dp_idx, dp) + call pbuf_get_field(pbuf, zm_jt_idx, jt) + call pbuf_get_field(pbuf, zm_maxg_idx, maxg) + call pbuf_get_field(pbuf, zm_ideep_idx, ideep) + + lengath = count(ideep > 0) + + fracice(:,:) = 0.0_r8 + + ! initialize dpdry (units=mb), which is used for tracers of dry mixing ratio type + dpdry = 0._r8 + do i = 1, lengath + dpdry(i,:) = state%pdeldry(ideep(i),:)/100._r8 + end do + + call aero_convproc_tend( aero_props, 'deep', lchnk, dt, & + state%t, state%pmid, q, du, eu, & + ed, dp, dpdry, jt, & + maxg, ideep, 1, lengath, & + dp_frac, icwmrdp, rprddp, evapcdp, & + fracice, dqdt, nsrflx, qsrflx, & + xx_mfup_max, xx_wcldbase, xx_kcldbase, & + dcondt_resusp3d ) + + call outfld( 'DP_MFUP_MAX', xx_mfup_max, pcols, lchnk ) + call outfld( 'DP_WCLDBASE', xx_wcldbase, pcols, lchnk ) + call outfld( 'DP_KCLDBASE', xx_kcldbase, pcols, lchnk ) + +end subroutine aero_convproc_dp_intr + +!========================================================================================= + +subroutine aero_convproc_tend( aero_props, convtype, lchnk, dt, & + t, pmid, q, du, eu, & + ed, dp, dpdry, jt, & + mx, ideep, il1g, il2g, & + cldfrac, icwmr, rprd, evapc, & + fracice, dqdt, nsrflx, qsrflx, & + xx_mfup_max, xx_wcldbase, xx_kcldbase, & + dcondt_resusp3d ) + +!----------------------------------------------------------------------- +! +! Purpose: +! Convective transport of trace species. +! The trace species need not be conservative, and source/sink terms for +! activation, resuspension, aqueous chemistry and gas uptake, and +! wet removal are all applied. +! Currently this works with the ZM deep convection, but we should be able +! to adapt it for both Hack and McCaa shallow convection +! +! Compare to subr convproc which does conservative trace species. +! +! Method: +! Computes tracer mixing ratios in updraft and downdraft "cells" in a +! Lagrangian manner, with source/sinks applied in the updraft other. +! Then computes grid-cell-mean tendencies by considering +! updraft and downdraft fluxes across layer boundaries +! environment subsidence/lifting fluxes across layer boundaries +! sources and sinks in the updraft +! resuspension of activated species in the grid-cell as a whole +! +! Note1: A better estimate or calculation of either the updraft velocity +! or fractional area is needed. +! Note2: If updraft area is a small fraction of over cloud area, +! then aqueous chemistry is underestimated. These are both +! research areas. +! +! Authors: O. Seland and R. Easter, based on convtran by P. Rasch +! +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! +! Input arguments +! + class(aerosol_properties), intent(in) :: aero_props + + character(len=*), intent(in) :: convtype ! identifies the type of + ! convection ("deep", "shcu") + integer, intent(in) :: lchnk ! chunk identifier + real(r8), intent(in) :: dt ! Model timestep + real(r8), intent(in) :: t(pcols,pver) ! Temperature + real(r8), intent(in) :: pmid(pcols,pver) ! Pressure at model levels + real(r8), intent(in) :: q(pcols,pver,ncnstaer) ! Tracer array including moisture + + real(r8), intent(in) :: du(pcols,pver) ! Mass detrain rate from updraft + real(r8), intent(in) :: eu(pcols,pver) ! Mass entrain rate into updraft + real(r8), intent(in) :: ed(pcols,pver) ! Mass entrain rate into downdraft +! *** note1 - mu, md, eu, ed, du, dp, dpdry are GATHERED ARRAYS *** +! *** note2 - mu and md units are (mb/s), which is used in the zm_conv code +! - eventually these should be changed to (kg/m2/s) +! *** note3 - eu, ed, du are "d(massflux)/dp" (with dp units = mb), and are all >= 0 + + real(r8), intent(in) :: dp(pcols,pver) ! Delta pressure between interfaces (mb) + real(r8), intent(in) :: dpdry(pcols,pver) ! Delta dry-pressure (mb) + integer, intent(in) :: jt(pcols) ! Index of cloud top for each column + integer, intent(in) :: mx(pcols) ! Index of cloud bottom for each column + integer, intent(in) :: ideep(pcols) ! Gathering array indices + integer, intent(in) :: il1g ! Gathered min lon indices over which to operate + integer, intent(in) :: il2g ! Gathered max lon indices over which to operate +! *** note4 -- for il1g <= i <= il2g, icol = ideep(i) is the "normal" chunk column index + + real(r8), intent(in) :: cldfrac(pcols,pver) ! Convective cloud fractional area + real(r8), intent(in) :: icwmr(pcols,pver) ! Convective cloud water from zhang + real(r8), intent(in) :: rprd(pcols,pver) ! Convective precipitation formation rate + real(r8), intent(in) :: evapc(pcols,pver) ! Convective precipitation evaporation rate + real(r8), intent(in) :: fracice(pcols,pver) ! Ice fraction of cloud droplets + + real(r8), intent(out):: dqdt(pcols,pver,ncnstaer) ! Tracer tendency array + integer, intent(in) :: nsrflx ! last dimension of qsrflx + real(r8), intent(out):: qsrflx(pcols,ncnstaer,nsrflx) + ! process-specific column tracer tendencies + ! (1=activation, 2=resuspension, 3=aqueous rxn, + ! 4=wet removal, 5=renaming) + real(r8), intent(out) :: xx_mfup_max(pcols) + real(r8), intent(out) :: xx_wcldbase(pcols) + real(r8), intent(out) :: xx_kcldbase(pcols) + real(r8), intent(inout) :: dcondt_resusp3d(ncnstaer,pcols,pver) + +!--------------------------Local Variables------------------------------ + +! cloudborne aerosol, so the arrays are dimensioned with pcnst_extd = pcnst*2 + + integer :: i, icol ! Work index + integer :: iconvtype ! 1=deep, 2=uw shallow + integer :: iflux_method ! 1=as in convtran (deep), 2=simpler + integer :: ipass_calc_updraft + integer :: jtsub ! Work index + integer :: k ! Work index + integer :: kactcnt ! Counter for no. of levels having activation + integer :: kactcntb ! Counter for activation diagnostic output + integer :: kactfirst ! Lowest layer with activation (= cloudbase) + integer :: kbot ! Cloud-flux bottom layer for current i (=mx(i)) + integer :: kbot_prevap ! Lowest layer for doing resuspension from evaporating precip + integer :: ktop ! Cloud-flux top layer for current i (=jt(i)) + ! Layers between kbot,ktop have mass fluxes + ! but not all have cloud water, because the + ! updraft starts below the cloud base + integer :: km1, km1x ! Work index + integer :: kp1, kp1x ! Work index + integer :: l, mm ! Work index + integer :: m, n, ndx ! Work index + integer :: nerr ! number of errors for entire run + integer :: nerrmax ! maximum number of errors to report + integer :: npass_calc_updraft + integer :: ntsub ! + + logical do_act_this_lev ! flag for doing activation at current level + + real(r8) aqfrac(2,ncnstaer) ! aqueous fraction of constituent in updraft + real(r8) cldfrac_i(pver) ! cldfrac at current i (with adjustments) + + real(r8) chat(2,ncnstaer,pverp) ! mix ratio in env at interfaces + real(r8) cond(2,ncnstaer,pverp) ! mix ratio in downdraft at interfaces + real(r8) const(2,ncnstaer,pver) ! gathered tracer array + real(r8) conu(2,ncnstaer,pverp) ! mix ratio in updraft at interfaces + + real(r8) dcondt(2,ncnstaer,pver) ! grid-average TMR tendency for current column + real(r8) dcondt_prevap(2,ncnstaer,pver) ! portion of dcondt from precip evaporation + real(r8) dcondt_resusp(2,ncnstaer,pver) ! portion of dcondt from resuspension + + real(r8) dcondt_wetdep(2,ncnstaer,pver) ! portion of dcondt from wet deposition + real(r8) dconudt_activa(2,ncnstaer,pverp) ! d(conu)/dt by activation + real(r8) dconudt_aqchem(2,ncnstaer,pverp) ! d(conu)/dt by aqueous chem + real(r8) dconudt_wetdep(2,ncnstaer,pverp) ! d(conu)/dt by wet removal + + real(r8) maxflux(2,ncnstaer) ! maximum (over layers) of fluxin and fluxout + real(r8) maxflux2(2,ncnstaer) ! ditto but computed using method-2 fluxes + real(r8) maxprevap(2,ncnstaer) ! maximum (over layers) of dcondt_prevap*dp + real(r8) maxresusp(2,ncnstaer) ! maximum (over layers) of dcondt_resusp*dp + real(r8) maxsrce(2,ncnstaer) ! maximum (over layers) of netsrce + + real(r8) sumflux(2,ncnstaer) ! sum (over layers) of netflux + real(r8) sumflux2(2,ncnstaer) ! ditto but computed using method-2 fluxes + real(r8) sumsrce(2,ncnstaer) ! sum (over layers) of dp*netsrce + real(r8) sumchng(2,ncnstaer) ! sum (over layers) of dp*dcondt + real(r8) sumchng3(2,ncnstaer) ! ditto but after call to resusp_conv + real(r8) sumprevap(2,ncnstaer) ! sum (over layers) of dp*dcondt_prevap + real(r8) sumwetdep(2,ncnstaer) ! sum (over layers) of dp*dconudt_wetdep + + real(r8) cabv ! mix ratio of constituent above + real(r8) cbel ! mix ratio of constituent below + real(r8) cdifr ! normalized diff between cabv and cbel + real(r8) cdt(pver) ! (in-updraft first order wet removal rate) * dt + real(r8) clw_cut ! threshold clw value for doing updraft + ! transformation and removal + real(r8) courantmax ! maximum courant no. + real(r8) dddp(pver) ! dd(i,k)*dp(i,k) at current i + real(r8) dp_i(pver) ! dp(i,k) at current i + real(r8) dt_u(pver) ! lagrangian transport time in the updraft + real(r8) dudp(pver) ! du(i,k)*dp(i,k) at current i + real(r8) dqdt_i(pver,ncnstaer) ! dqdt(i,k,m) at current i + real(r8) dtsub ! dt/ntsub + real(r8) dz ! working layer thickness (m) + real(r8) eddp(pver) ! ed(i,k)*dp(i,k) at current i + real(r8) eudp(pver) ! eu(i,k)*dp(i,k) at current i + real(r8) expcdtm1 ! a work variable + real(r8) fa_u(pver) ! fractional area of in the updraft + real(r8) fa_u_dp ! current fa_u(k)*dp_i(k) + real(r8) f_ent ! fraction of the "before-detrainment" updraft + ! massflux at k/k-1 interface resulting from + ! entrainment of level k air + real(r8) fluxin ! a work variable + real(r8) fluxout ! a work variable + real(r8) maxc ! a work variable + real(r8) mbsth ! Threshold for mass fluxes + real(r8) minc ! a work variable + real(r8) md_m_eddp ! a work variable + real(r8) md_i(pverp) ! md(i,k) at current i (note pverp dimension) + real(r8) md_x(pverp) ! md(i,k) at current i (note pverp dimension) + real(r8) mu_i(pverp) ! mu(i,k) at current i (note pverp dimension) + real(r8) mu_x(pverp) ! mu(i,k) at current i (note pverp dimension) + ! md_i, md_x, mu_i, mu_x are all "dry" mass fluxes + ! the mu_x/md_x are initially calculated from the incoming mu/md by applying dp/dpdry + ! the mu_i/md_i are next calculated by applying the mbsth threshold + real(r8) mu_p_eudp(pver) ! = mu_i(kp1) + eudp(k) + real(r8) netflux ! a work variable + real(r8) netsrce ! a work variable + real(r8) q_i(pver,ncnstaer) ! q(i,k,m) at current i + real(r8) qsrflx_i(ncnstaer,nsrflx) ! qsrflx(i,m,n) at current i + real(r8) rhoair_i(pver) ! air density at current i + real(r8) small ! a small number + real(r8) tmpa ! work variables + real(r8) tmpf ! work variables + real(r8) xinv_ntsub ! 1.0/ntsub + real(r8) wup(pver) ! working updraft velocity (m/s) + real(r8) conu2(pcols,pver,2,ncnstaer) + real(r8) dcondt2(pcols,pver,2,ncnstaer) + + !Fractional area of ensemble mean updrafts in ZM scheme set to 0.01 + !Chosen to reproduce vertical velocities in GATEIII GIGALES (Khairoutdinov etal 2009, JAMES) + real(r8), parameter :: zm_areafrac = 0.01_r8 + +!----------------------------------------------------------------------- +! + iconvtype = -1 + iflux_method = -1 + + if (convtype == 'deep') then + iconvtype = 1 + iflux_method = 1 + else if (convtype == 'uwsh') then + iconvtype = 2 + iflux_method = 2 + else + call endrun( '*** aero_convproc_tend -- convtype is not |deep| or |uwsh|' ) + end if + + nerr = 0 + nerrmax = 99 + + dcondt_resusp3d(:,:,:) = 0._r8 + + small = 1.e-36_r8 +! mbsth is the threshold below which we treat the mass fluxes as zero (in mb/s) + mbsth = 1.e-15_r8 + + qsrflx(:,:,:) = 0.0_r8 + dqdt(:,:,:) = 0.0_r8 + xx_mfup_max(:) = 0.0_r8 + xx_wcldbase(:) = 0.0_r8 + xx_kcldbase(:) = 0.0_r8 + + wup(:) = 0.0_r8 + + dcondt2 = 0.0_r8 + conu2 = 0.0_r8 + aqfrac = 0.0_r8 + +! inititialize aqfrac to 1.0 for activated aerosol species, 0.0 otherwise + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + aqfrac(2,mm) = 1.0_r8 + enddo + enddo + +! Loop ever each column that has convection +! *** i is index to gathered arrays; ideep(i) is index to "normal" chunk arrays +i_loop_main_aa: & + do i = il1g, il2g + icol = ideep(i) + + + if ( (jt(i) <= 0) .and. (mx(i) <= 0) .and. (iconvtype /= 1) ) then +! shallow conv case with jt,mx <= 0, which means there is no shallow conv +! in this column -- skip this column + cycle i_loop_main_aa + + else if ( (jt(i) < 1) .or. (mx(i) > pver) .or. (jt(i) > mx(i)) ) then +! invalid cloudtop and cloudbase indices -- skip this column + write(*,9010) 'illegal jt, mx', convtype, lchnk, icol, i, & + jt(i), mx(i) +9010 format( '*** aero_convproc_tend error -- ', a, 5x, 'convtype = ', a / & + '*** lchnk, icol, il, jt, mx = ', 5(1x,i10) ) + cycle i_loop_main_aa + + else if (jt(i) == mx(i)) then +! cloudtop = cloudbase (1 layer cloud) -- skip this column + write(*,9010) 'jt == mx', convtype, lchnk, icol, i, jt(i), mx(i) + cycle i_loop_main_aa + + end if + + +! +! cloudtop and cloudbase indices are valid so proceed with calculations +! + +! Load dp_i and cldfrac_i, and calc rhoair_i + do k = 1, pver + dp_i(k) = dpdry(i,k) + cldfrac_i(k) = cldfrac(icol,k) + rhoair_i(k) = pmid(icol,k)/(rair*t(icol,k)) + end do + +! Calc dry mass fluxes +! This is approximate because the updraft air is has different temp and qv than +! the grid mean, but the whole convective parameterization is highly approximate + mu_x(:) = 0.0_r8 + md_x(:) = 0.0_r8 +! (eu-du) = d(mu)/dp -- integrate upwards, multiplying by dpdry + do k = pver, 1, -1 + mu_x(k) = mu_x(k+1) + (eu(i,k)-du(i,k))*dp_i(k) + xx_mfup_max(icol) = max( xx_mfup_max(icol), mu_x(k) ) + end do +! (ed) = d(md)/dp -- integrate downwards, multiplying by dpdry + do k = 2, pver + md_x(k) = md_x(k-1) - ed(i,k-1)*dp_i(k-1) + end do + +! Load mass fluxes over cloud layers +! (Note - use of arrays dimensioned k=1,pver+1 simplifies later coding) +! Zero out values below threshold +! Zero out values at "top of cloudtop", "base of cloudbase" + ktop = jt(i) + kbot = mx(i) +! usually the updraft ( & downdraft) start ( & end ) at kbot=pver, but sometimes kbot < pver +! transport, activation, resuspension, and wet removal only occur between kbot >= k >= ktop +! resuspension from evaporating precip can occur at k > kbot when kbot < pver + kbot_prevap = pver + mu_i(:) = 0.0_r8 + md_i(:) = 0.0_r8 + do k = ktop+1, kbot + mu_i(k) = mu_x(k) + if (mu_i(k) <= mbsth) mu_i(k) = 0.0_r8 + md_i(k) = md_x(k) + if (md_i(k) >= -mbsth) md_i(k) = 0.0_r8 + end do + mu_i(ktop) = 0.0_r8 + md_i(ktop) = 0.0_r8 + mu_i(kbot+1) = 0.0_r8 + md_i(kbot+1) = 0.0_r8 + +! Compute updraft and downdraft "entrainment*dp" from eu and ed +! Compute "detrainment*dp" from mass conservation + eudp(:) = 0.0_r8 + dudp(:) = 0.0_r8 + eddp(:) = 0.0_r8 + dddp(:) = 0.0_r8 + courantmax = 0.0_r8 + do k = ktop, kbot + if ((mu_i(k) > 0) .or. (mu_i(k+1) > 0)) then + if (du(i,k) <= 0.0_r8) then + eudp(k) = mu_i(k) - mu_i(k+1) + else + eudp(k) = max( eu(i,k)*dp_i(k), 0.0_r8 ) + dudp(k) = (mu_i(k+1) + eudp(k)) - mu_i(k) + if (dudp(k) < 1.0e-12_r8*eudp(k)) then + eudp(k) = mu_i(k) - mu_i(k+1) + dudp(k) = 0.0_r8 + end if + end if + end if + if ((md_i(k) < 0) .or. (md_i(k+1) < 0)) then + eddp(k) = max( ed(i,k)*dp_i(k), 0.0_r8 ) + dddp(k) = (md_i(k+1) + eddp(k)) - md_i(k) + if (dddp(k) < 1.0e-12_r8*eddp(k)) then + eddp(k) = md_i(k) - md_i(k+1) + dddp(k) = 0.0_r8 + end if + end if + courantmax = max( courantmax, ( mu_i(k+1)+eudp(k)-md_i(k)+eddp(k) )*dt/dp_i(k) ) + end do ! k + +! number of time substeps needed to maintain "courant number" <= 1 + ntsub = 1 + if (courantmax > (1.0_r8 + 1.0e-6_r8)) then + ntsub = 1 + int( courantmax ) + end if + xinv_ntsub = 1.0_r8/ntsub + dtsub = dt*xinv_ntsub + courantmax = courantmax*xinv_ntsub + +! load tracer mixing ratio array, which will be updated at the end of each jtsub interation + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + q_i(1:pver,mm) = q(icol,1:pver,mm) + conu2(icol,1:pver,1,mm) = q(icol,1:pver,mm) + end do + end do + +! +! when method_reduce_actfrac = 2, need to do the updraft calc twice +! (1st to get non-adjusted activation amount, 2nd to apply reduction factor) + npass_calc_updraft = 1 + if ( (method_reduce_actfrac == 2) .and. & + (factor_reduce_actfrac >= 0.0_r8) .and. & + (factor_reduce_actfrac <= 1.0_r8) ) npass_calc_updraft = 2 + + +jtsub_loop_main_aa: & + do jtsub = 1, ntsub + + +ipass_calc_updraft_loop: & + do ipass_calc_updraft = 1, npass_calc_updraft + + qsrflx_i(:,:) = 0.0_r8 + dqdt_i(:,:) = 0.0_r8 + + const = 0.0_r8 ! zero cloud-phase species + chat = 0.0_r8 ! zero cloud-phase species + conu = 0.0_r8 + cond = 0.0_r8 + + dcondt = 0.0_r8 + dcondt_resusp = 0.0_r8 + dcondt_wetdep = 0.0_r8 + dcondt_prevap = 0.0_r8 + dconudt_aqchem = 0.0_r8 + dconudt_wetdep = 0.0_r8 + +! only initialize the activation tendency on ipass=1 + if (ipass_calc_updraft == 1) dconudt_activa = 0.0_r8 + + ! initialize mixing ratio arrays (chat, const, conu, cond) + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + + const(1,mm,:) = q_i(:,mm) + + ! From now on work only with gathered data + ! Interpolate environment tracer values to interfaces + do k = 1,pver + km1 = max(1,k-1) + minc = min(const(1,mm,km1),const(1,mm,k)) + maxc = max(const(1,mm,km1),const(1,mm,k)) + if (minc < 0) then + cdifr = 0._r8 + else + cdifr = abs(const(1,mm,k)-const(1,mm,km1))/max(maxc,small) + endif + + ! If the two layers differ significantly use a geometric averaging procedure + ! But only do that for deep convection. For shallow, use the simple + ! averaging which is used in subr cmfmca + if (iconvtype /= 1) then + chat(1,mm,k) = 0.5_r8* (const(1,mm,k)+const(1,mm,km1)) + else if (cdifr > 1.E-6_r8) then + cabv = max(const(1,mm,km1),maxc*1.e-12_r8) + cbel = max(const(1,mm,k),maxc*1.e-12_r8) + chat(1,mm,k) = log(cabv/cbel)/(cabv-cbel)*cabv*cbel + else ! Small diff, so just arithmetic mean + chat(1,mm,k) = 0.5_r8* (const(1,mm,k)+const(1,mm,km1)) + end if + + ! Set provisional up and down draft values, and tendencies + conu(1,mm,k) = chat(1,mm,k) + cond(1,mm,k) = chat(1,mm,k) + end do ! k + + ! Values at surface inferface == values in lowest layer + chat(1,mm,pver+1) = const(1,mm,pver) + conu(1,mm,pver+1) = const(1,mm,pver) + cond(1,mm,pver+1) = const(1,mm,pver) + end do ! l + end do ! m + + + +! Compute updraft mixing ratios from cloudbase to cloudtop +! No special treatment is needed at k=pver because arrays +! are dimensioned 1:pver+1 +! A time-split approach is used. First, entrainment is applied to produce +! an initial conu(m,k) from conu(m,k+1). Next, chemistry/physics are +! applied to the initial conu(m,k) to produce a final conu(m,k). +! Detrainment from the updraft uses this final conu(m,k). +! Note that different time-split approaches would give somewhat different +! results + kactcnt = 0 ; kactcntb = 0 ; kactfirst = 1 +k_loop_main_bb: & + do k = kbot, ktop, -1 + kp1 = k+1 + +! cldfrac = conv cloud fractional area. This could represent anvil cirrus area, +! and may not useful for aqueous chem and wet removal calculations + cldfrac_i(k) = max( cldfrac_i(k), 0.005_r8 ) +! mu_p_eudp(k) = updraft massflux at k, without detrainment between kp1,k + mu_p_eudp(k) = mu_i(kp1) + eudp(k) + + fa_u(k) = 0.0_r8 !BSINGH(10/15/2014): Initialized so that it has a value if the following "if" check yeilds .false. + if (mu_p_eudp(k) > mbsth) then +! if (mu_p_eudp(k) <= mbsth) the updraft mass flux is negligible at base and top +! of current layer, +! so current layer is a "gap" between two unconnected updrafts, +! so essentially skip all the updraft calculations for this layer + +! First apply changes from entrainment + f_ent = eudp(k)/mu_p_eudp(k) + f_ent = max( 0.0_r8, min( 1.0_r8, f_ent ) ) + tmpa = 1.0_r8 - f_ent + do n = 1,2 ! phase + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + conu(n,mm,k) = tmpa*conu(n,mm,kp1) + f_ent*const(n,mm,k) + end do + end do + end do + +! estimate updraft velocity (wup) + if (iconvtype /= 1) then +! shallow - wup = (mup in kg/m2/s) / [rhoair * (updraft area)] + wup(k) = (mu_i(kp1) + mu_i(k))*0.5_r8*hund_ovr_g & + / (rhoair_i(k) * (cldfrac_i(k)*0.5_r8)) + else +! deep - as in shallow, but assumed constant updraft_area with height zm_areafrac + wup(k) = (mu_i(kp1) + mu_i(k))*0.5_r8*hund_ovr_g & + / (rhoair_i(k) * zm_areafrac) + end if + +! compute lagrangian transport time (dt_u) and updraft fractional area (fa_u) +! *** these must obey dt_u(k)*mu_p_eudp(k) = dp_i(k)*fa_u(k) + dz = dp_i(k)*hund_ovr_g/rhoair_i(k) + dt_u(k) = dz/wup(k) + dt_u(k) = min( dt_u(k), dt ) + fa_u(k) = dt_u(k)*(mu_p_eudp(k)/dp_i(k)) + + +! Now apply transformation and removal changes +! Skip levels where icwmr(icol,k) <= clw_cut (= 1.0e-6) to eliminate +! occasional very small icwmr values from the ZM module + clw_cut = 1.0e-6_r8 + + + if (convproc_method_activate <= 1) then +! aerosol activation - method 1 +! skip levels that are completely glaciated (fracice(icol,k) == 1.0) +! when kactcnt=1 (first/lowest layer with cloud water) apply +! activatation to the entire updraft +! when kactcnt>1 apply activatation to the amount entrained at this level + if ((icwmr(icol,k) > clw_cut) .and. (fracice(icol,k) < 1.0_r8)) then + kactcnt = kactcnt + 1 + + if ((kactcnt == 1) .or. (f_ent > 0.0_r8)) then + kactcntb = kactcntb + 1 + end if + + if (kactcnt == 1) then + ! diagnostic fields + ! xx_wcldbase = w at first cloudy layer, estimated from mu and cldfrac + xx_wcldbase(icol) = (mu_i(kp1) + mu_i(k))*0.5_r8*hund_ovr_g & + / (rhoair_i(k) * (cldfrac_i(k)*0.5_r8)) + xx_kcldbase(icol) = k + + kactfirst = k + tmpa = 1.0_r8 + call activate_convproc( aero_props, & + conu(:,:,k), dconudt_activa(:,:,k), conu(:,:,k), & + tmpa, dt_u(k), wup(k), & + t(icol,k), rhoair_i(k), ipass_calc_updraft ) + else if (f_ent > 0.0_r8) then + ! current layer is above cloud base (=first layer with activation) + ! only allow activation at k = kactfirst thru kactfirst-(method1_activate_nlayers-1) + if (k >= kactfirst-(method1_activate_nlayers-1)) then + call activate_convproc( aero_props, & + conu(:,:,k), dconudt_activa(:,:,k), const(:,:,k), & + f_ent, dt_u(k), wup(k), & + t(icol,k), rhoair_i(k), ipass_calc_updraft ) + end if + end if +! the following was for cam2 shallow convection (hack), +! but is not appropriate for cam5 (uwshcu) +! else if ((kactcnt > 0) .and. (iconvtype /= 1)) then +! ! for shallow conv, when you move from activation occuring to +! ! not occuring, reset kactcnt=0, because the hack scheme can +! ! produce multiple "1.5 layer clouds" separated by clear air +! kactcnt = 0 +! end if + end if ! ((icwmr(icol,k) > clw_cut) .and. (fracice(icol,k) < 1.0)) then + + else ! (convproc_method_activate >= 2) +! aerosol activation - method 2 +! skip levels that are completely glaciated (fracice(icol,k) == 1.0) +! when kactcnt=1 (first/lowest layer with cloud water) +! apply "primary" activatation to the entire updraft +! when kactcnt>1 +! apply secondary activatation to the entire updraft +! do this for all levels above cloud base (even if completely glaciated) +! (this is something for sensitivity testing) + do_act_this_lev = .false. + if (kactcnt <= 0) then + if (icwmr(icol,k) > clw_cut) then + do_act_this_lev = .true. + kactcnt = 1 + kactfirst = k + ! diagnostic fields + ! xx_wcldbase = w at first cloudy layer, estimated from mu and cldfrac + xx_wcldbase(icol) = (mu_i(kp1) + mu_i(k))*0.5_r8*hund_ovr_g & + / (rhoair_i(k) * (cldfrac_i(k)*0.5_r8)) + xx_kcldbase(icol) = k + end if + else +! if ((icwmr(icol,k) > clw_cut) .and. (fracice(icol,k) < 1.0)) then + do_act_this_lev = .true. + kactcnt = kactcnt + 1 +! end if + end if + + if ( do_act_this_lev ) then + kactcntb = kactcntb + 1 + + call activate_convproc_method2( aero_props, & + conu(:,:,k), dconudt_activa(:,:,k), & + f_ent, dt_u(k), wup(k), & + t(icol,k), rhoair_i(k), k, & + kactfirst, ipass_calc_updraft ) + + end if + conu2(icol,k,:,:) = conu(:,:,k) + + end if ! (convproc_method_activate <= 1) + +! aqueous chemistry +! do glaciated levels as aqchem_conv will eventually do acid vapor uptake +! to ice, and aqchem_conv module checks fracice before doing liquid wtr stuff +! if (icwmr(icol,k) > clw_cut) then +! call aqchem_conv( conu(1,k), dconudt_aqchem(1,k), aqfrac, & +! t(icol,k), fracice(icol,k), icwmr(icol,k), rhoair_i(k), & +! lh2o2(icol,k), lo3(icol,k), dt_u(k) ) +! end if + +! wet removal +! +! mirage2 +! rprd = precip formation as a grid-cell average (kgW/kgA/s) +! icwmr = cloud water MR within updraft area (kgW/kgA) +! fupdr = updraft fractional area (--) +! A = rprd/fupdr = precip formation rate within updraft area (kgW/kgA/s) +! B = A/icwmr = rprd/(icwmr*fupdr) +! = first-order removal rate (1/s) +! C = dp/(mup/fupdr) = updraft air residence time in the layer (s) +! +! fraction removed = (1.0 - exp(-cdt)) where +! cdt = B*C = (dp/mup)*rprd/icwmr +! +! Note1: fupdr cancels out in cdt, so need not be specified +! Note2: dp & mup units need only be consistent (e.g., mb & mb/s) +! Note3: for shallow conv, cdt = 1-beta (beta defined in Hack scheme) +! Note4: the "dp" in C above and code below should be the moist dp +! +! cam5 +! clw_preloss = cloud water MR before loss to precip +! = icwmr + dt*(rprd/fupdr) +! B = A/clw_preloss = (rprd/fupdr)/(icwmr + dt*rprd/fupdr) +! = rprd/(fupdr*icwmr + dt*rprd) +! = first-order removal rate (1/s) +! +! fraction removed = (1.0 - exp(-cdt)) where +! cdt = B*C = (fupdr*dp/mup)*[rprd/(fupdr*icwmr + dt*rprd)] +! +! Note1: *** cdt is now sensitive to fupdr, which we do not really know, +! and is not the same as the convective cloud fraction +! Note2: dt is appropriate in the above cdt expression, not dtsub +! +! Apply wet removal at levels where +! icwmr(icol,k) > clw_cut AND rprd(icol,k) > 0.0 +! as wet removal occurs in both liquid and ice clouds +! + cdt(k) = 0.0_r8 + if ((icwmr(icol,k) > clw_cut) .and. (rprd(icol,k) > 0.0_r8)) then +! if (iconvtype == 1) then + tmpf = 0.5_r8*cldfrac_i(k) + cdt(k) = (tmpf*dp(i,k)/mu_p_eudp(k)) * rprd(icol,k) / & + (tmpf*icwmr(icol,k) + dt*rprd(icol,k)) +! else if (k < pver) then +! if (eudp(k+1) > 0) cdt(k) = & +! rprd(icol,k)*dp(i,k)/(icwmr(icol,k)*eudp(k+1)) +! end if + end if + if (cdt(k) > 0.0_r8) then + expcdtm1 = exp(-cdt(k)) - 1.0_r8 + + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + do n = 1,2 + dconudt_wetdep(n,mm,k) = conu(n,mm,k)*aqfrac(n,mm)*expcdtm1 + conu(n,mm,k) = conu(n,mm,k) + dconudt_wetdep(n,mm,k) + dconudt_wetdep(n,mm,k) = dconudt_wetdep(n,mm,k) / dt_u(k) + conu2(icol,k,n,mm) = conu(n,mm,k) + enddo + enddo + enddo + + end if + + end if ! "(mu_p_eudp(k) > mbsth)" + end do k_loop_main_bb ! "k = kbot, ktop, -1" + +! when doing updraft calcs twice, only need to go this far on the first pass + if ( (ipass_calc_updraft == 1) .and. & + (npass_calc_updraft == 2) ) cycle ipass_calc_updraft_loop + + +! Compute downdraft mixing ratios from cloudtop to cloudbase +! No special treatment is needed at k=2 +! No transformation or removal is applied in the downdraft + do k = ktop, kbot + kp1 = k + 1 +! md_m_eddp = downdraft massflux at kp1, without detrainment between k,kp1 + md_m_eddp = md_i(k) - eddp(k) + if (md_m_eddp < -mbsth) then + + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + do n = 1,2 + cond(n,mm,kp1) = ( md_i(k)*cond(n,mm,k) & + - eddp(k)*const(n,mm,k) ) / md_m_eddp + end do + end do + end do + end if + end do ! k + + +! Now computes fluxes and tendencies +! NOTE: The approach used in convtran applies to inert tracers and +! must be modified to include source and sink terms + sumflux = 0.0_r8 + sumflux2 = 0.0_r8 + sumsrce = 0.0_r8 + sumchng = 0.0_r8 + sumchng3 = 0.0_r8 + sumwetdep = 0.0_r8 + sumprevap = 0.0_r8 + + maxflux = 0.0_r8 + maxflux2 = 0.0_r8 + maxresusp = 0.0_r8 + maxsrce = 0.0_r8 + maxprevap = 0.0_r8 + +k_loop_main_cc: & + do k = ktop, kbot + kp1 = k+1 + km1 = k-1 + kp1x = min( kp1, pver ) + km1x = max( km1, 1 ) + fa_u_dp = fa_u(k)*dp_i(k) + + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + do n = 1,2 + + ! First compute fluxes using environment subsidence/lifting and + ! entrainment/detrainment into up/downdrafts, + ! to provide an additional mass balance check + ! (this could be deleted after the code is well tested) + fluxin = mu_i(k)*min(chat(n,mm,k),const(n,mm,km1x)) & + - md_i(kp1)*min(chat(n,mm,kp1),const(n,mm,kp1x)) & + + dudp(k)*conu(n,mm,k) + dddp(k)*cond(n,mm,kp1) + fluxout = mu_i(kp1)*min(chat(n,mm,kp1),const(n,mm,k)) & + - md_i(k)*min(chat(n,mm,k),const(n,mm,k)) & + + (eudp(k) + eddp(k))*const(n,mm,k) + + netflux = fluxin - fluxout + + sumflux2(n,mm) = sumflux2(n,mm) + netflux + maxflux2(n,mm) = max( maxflux2(n,mm), abs(fluxin), abs(fluxout) ) + + ! Now compute fluxes as in convtran, and also source/sink terms + ! (version 3 limit fluxes outside convection to mass in appropriate layer + ! (these limiters are probably only safe for positive definite quantitities + ! (it assumes that mu and md already satify a courant number limit of 1) + if (iflux_method /= 2) then + fluxin = mu_i(kp1)*conu(n,mm,kp1) & + + mu_i(k )*min(chat(n,mm,k ),const(n,mm,km1x)) & + - ( md_i(k )*cond(n,mm,k) & + + md_i(kp1)*min(chat(n,mm,kp1),const(n,mm,kp1x)) ) + fluxout = mu_i(k )*conu(n,mm,k) & + + mu_i(kp1)*min(chat(n,mm,kp1),const(n,mm,k )) & + - ( md_i(kp1)*cond(n,mm,kp1) & + + md_i(k )*min(chat(n,mm,k ),const(n,mm,k )) ) + else + fluxin = mu_i(kp1)*conu(n,mm,kp1) & + - ( md_i(k )*cond(n,mm,k) ) + fluxout = mu_i(k )*conu(n,mm,k) & + - ( md_i(kp1)*cond(n,mm,kp1) ) + + ! new method -- simple upstream method for the env subsidence + ! tmpa = net env mass flux (positive up) at top of layer k + tmpa = -( mu_i(k ) + md_i(k ) ) + if (tmpa <= 0.0_r8) then + fluxin = fluxin - tmpa*const(n,mm,km1x) + else + fluxout = fluxout + tmpa*const(n,mm,k ) + end if + ! tmpa = net env mass flux (positive up) at base of layer k + tmpa = -( mu_i(kp1) + md_i(kp1) ) + if (tmpa >= 0.0_r8) then + fluxin = fluxin + tmpa*const(n,mm,kp1x) + else + fluxout = fluxout - tmpa*const(n,mm,k ) + end if + end if + + netflux = fluxin - fluxout + netsrce = fa_u_dp*(dconudt_aqchem(n,mm,k) + & + dconudt_activa(n,mm,k) + dconudt_wetdep(n,mm,k)) + dcondt(n,mm,k) = (netflux+netsrce)/dp_i(k) + + dcondt_wetdep(n,mm,k) = fa_u_dp*dconudt_wetdep(n,mm,k)/dp_i(k) + sumwetdep(n,mm) = sumwetdep(n,mm) + fa_u_dp*dconudt_wetdep(n,mm,k) + + dcondt2(icol,k,n,mm) = dcondt(n,mm,k) + + end do + end do + + end do + end do k_loop_main_cc ! "k = ktop, kbot" + +! calculate effects of precipitation evaporation + call precpevap_convproc( aero_props, dcondt, dcondt_wetdep, dcondt_prevap, & + rprd, evapc, dp_i, & + icol, ktop ) + +! make adjustments to dcondt for activated & unactivated aerosol species +! pairs to account any (or total) resuspension of convective-cloudborne aerosol + call resuspend_convproc( aero_props, dcondt, dcondt_resusp, ktop, kbot_prevap ) + + ! Do resuspension of aerosols from rain only when the rain has + ! totally evaporated. + if (convproc_do_evaprain_atonce) then + + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + dcondt_resusp3d(mm,icol,:) = dcondt_resusp(2,mm,:) + end do + end do + + dcondt_resusp(2,:,:) = 0._r8 + end if + +! calculate new column-tendency variables + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + do n = 1,2 + do k = ktop, kbot_prevap + sumprevap(n,mm) = sumprevap(n,mm) + dcondt_prevap(n,mm,k)*dp_i(k) + end do + end do + end do + end do + +! +! note again the aero_convproc_tend does not apply convective cloud processing +! to the stratiform-cloudborne aerosol +! within this routine, cloudborne aerosols are convective-cloudborne +! +! before tendencies (dcondt, which is loaded into dqdt) are returned, +! the convective-cloudborne aerosol tendencies must be combined +! with the interstitial tendencies +! resuspend_convproc has already done this for the dcondt +! +! the individual process column tendencies (sumwetdep, sumprevap, ...) +! are just diagnostic fields that can be written to history +! tendencies for interstitial and convective-cloudborne aerosol could +! both be passed back and output, if desired +! currently, however, the interstitial and convective-cloudborne tendencies +! are combined (in the next code block) before being passed back (in qsrflx) +! + + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + sumwetdep(1,mm) = sumwetdep(1,mm) + sumwetdep(2,mm) + sumprevap(1,mm) = sumprevap(1,mm) + sumprevap(2,mm) + enddo + enddo + +! +! scatter overall tendency back to full array +! + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + ndx = aer_cnst_ndx(mm) + do k = ktop, kbot_prevap + dqdt_i(k,mm) = dcondt(1,mm,k) + dqdt(icol,k,mm) = dqdt(icol,k,mm) + dqdt_i(k,mm)*xinv_ntsub + end do + + end do + end do ! m + +! scatter column burden tendencies for various processes to qsrflx + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + qsrflx_i(mm,4) = sumwetdep(1,mm)*hund_ovr_g + qsrflx_i(mm,5) = sumprevap(1,mm)*hund_ovr_g + qsrflx(icol,mm,1:5) = qsrflx(icol,mm,1:5) + qsrflx_i(mm,1:5)*xinv_ntsub + end do + end do + + if (jtsub < ntsub) then + ! update the q_i for the next interation of the jtsub loop + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + ndx = aer_cnst_ndx(mm) + do k = ktop, kbot_prevap + q_i(k,mm) = max( (q_i(k,mm) + dqdt_i(k,mm)*dtsub), 0.0_r8 ) + end do + end do + end do + end if + + end do ipass_calc_updraft_loop + + end do jtsub_loop_main_aa ! of the main "do jtsub = 1, ntsub" loop + + + end do i_loop_main_aa ! of the main "do i = il1g, il2g" loop + + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + + call outfld( trim(cnst_name_extd(1,mm))//'WETC', dcondt2(:,:,1,mm), pcols, lchnk ) + call outfld( trim(cnst_name_extd(1,mm))//'CONU', conu2(:,:,1,mm), pcols, lchnk ) + call outfld( trim(cnst_name_extd(2,mm))//'WETC', dcondt2(:,:,2,mm), pcols, lchnk ) + call outfld( trim(cnst_name_extd(2,mm))//'CONU', conu2(:,:,2,mm), pcols, lchnk ) + + end do + end do + +end subroutine aero_convproc_tend + +!========================================================================================= + subroutine precpevap_convproc( aero_props, & + dcondt, dcondt_wetdep, dcondt_prevap, & + rprd, evapc, dp_i, & + icol, ktop ) +!----------------------------------------------------------------------- +! +! Purpose: +! Calculate resuspension of wet-removed aerosol species resulting +! from precip evaporation +! +! Author: R. Easter +! +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! arguments +! (note: TMR = tracer mixing ratio) + + class(aerosol_properties), intent(in) :: aero_props + real(r8), intent(inout) :: dcondt(2,ncnstaer,pver) + ! overall TMR tendency from convection + real(r8), intent(in) :: dcondt_wetdep(2,ncnstaer,pver) + ! portion of TMR tendency due to wet removal + real(r8), intent(inout) :: dcondt_prevap(2,ncnstaer,pver) + ! portion of TMR tendency due to precip evaporation + ! (actually, due to the adjustments made here) + ! (on entry, this is 0.0) + + real(r8), intent(in) :: rprd(pcols,pver) ! conv precip production rate (gathered) + real(r8), intent(in) :: evapc(pcols,pver) ! conv precip evaporation rate (gathered) + real(r8), intent(in) :: dp_i(pver) ! pressure thickness of level (in mb) + + integer, intent(in) :: icol ! normal (ungathered) i index for current column + integer, intent(in) :: ktop ! index of top cloud level for current column + +!----------------------------------------------------------------------- +! local variables + integer :: k, l, m, mm, n + real(r8) :: del_pr_flux_prod ! change to precip flux from production [(kg/kg/s)*mb] + real(r8) :: del_pr_flux_evap ! change to precip flux from evaporation [(kg/kg/s)*mb] + real(r8) :: del_wd_flux_evap ! change to wet deposition flux from evaporation [(kg/kg/s)*mb] + real(r8) :: fdel_pr_flux_evap ! fractional change to precip flux from evaporation + real(r8) :: pr_flux ! precip flux at base of current layer [(kg/kg/s)*mb] + real(r8) :: pr_flux_old + real(r8) :: tmpdp ! delta-pressure (mb) + real(r8) :: wd_flux(2,ncnstaer) ! tracer wet deposition flux at base of current layer [(kg/kg/s)*mb] +!----------------------------------------------------------------------- + + pr_flux = 0.0_r8 + wd_flux = 0.0_r8 + + do k = ktop, pver + tmpdp = dp_i(k) + + pr_flux_old = pr_flux + del_pr_flux_prod = tmpdp*max(0.0_r8, rprd(icol,k)) + pr_flux = pr_flux_old + del_pr_flux_prod + + del_pr_flux_evap = min( pr_flux, tmpdp*max(0.0_r8, evapc(icol,k)) ) + + ! Do resuspension of aerosols from rain only when the rain has + ! totally evaporated in one layer. + if (convproc_do_evaprain_atonce .and. & + (del_pr_flux_evap.ne.pr_flux)) del_pr_flux_evap = 0._r8 + + fdel_pr_flux_evap = del_pr_flux_evap / max(pr_flux, 1.0e-35_r8) + + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + do n = 1,2 + + ! use -dcondt_wetdep(m,k) as it is negative (or zero) + wd_flux(n,mm) = wd_flux(n,mm) + tmpdp*max(0.0_r8, -dcondt_wetdep(n,mm,k)) + del_wd_flux_evap = wd_flux(n,mm)*fdel_pr_flux_evap + + dcondt_prevap(n,mm,k) = del_wd_flux_evap/tmpdp + + end do + end do + end do + + ! resuspension --> create larger aerosols + if (convproc_do_evaprain_atonce) then + call aero_props%resuspension_resize( dcondt_prevap(1,:,k) ) + endif + + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + do n = 1,2 + dcondt(n,mm,k) = dcondt(n,mm,k) + dcondt_prevap(n,mm,k) + end do + end do + end do + + pr_flux = max( 0.0_r8, pr_flux-del_pr_flux_evap ) + + end do ! k + + end subroutine precpevap_convproc + +!========================================================================================= + subroutine activate_convproc( aero_props, & + conu, dconudt, conent, & + f_ent, dt_u, wup, & + tair, rhoair, ipass_calc_updraft ) +!----------------------------------------------------------------------- +! +! Purpose: +! Calculate activation of aerosol species in convective updraft +! for a single column and level +! +! Method: +! conu(l) = Updraft TMR (tracer mixing ratio) at k/k-1 interface +! conent(l) = TMR of air that is entrained into the updraft from level k +! f_ent = Fraction of the "before-detrainment" updraft massflux at +! k/k-1 interface" resulting from entrainment of level k air +! (where k is the current level in subr aero_convproc_tend) +! +! On entry to this routine, the conu(l) represents the updraft TMR +! after entrainment, but before chemistry/physics and detrainment, +! and is equal to +! conu(l) = f_ent*conent(l) + (1.0-f_ent)*conu_below(l) +! where +! conu_below(l) = updraft TMR at the k+1/k interface, and +! f_ent = (eudp/mu_p_eudp) is the fraction of the updraft massflux +! from level k entrainment +! +! This routine applies aerosol activation to the entrained tracer, +! then adjusts the conu so that on exit, +! conu(la) = conu_incoming(la) - f_ent*conent(la)*f_act(la) +! conu(lc) = conu_incoming(lc) + f_ent*conent(la)*f_act(la) +! where +! la, lc = indices for an unactivated/activated aerosol component pair +! f_act = fraction of conent(la) that is activated. The f_act are +! calculated with the Razzak-Ghan activation parameterization. +! The f_act differ for each mode, and for number/surface/mass. +! +! Note: At the lowest layer with cloud water, subr convproc calls this +! routine with conent==conu and f_ent==1.0, with the result that +! activation is applied to the entire updraft tracer flux +! +! *** The updraft velocity used for activation calculations is rather +! uncertain and needs more work. However, an updraft of 1-3 m/s +! will activate essentially all of accumulation and coarse mode particles. +! +! Author: R. Easter +! +!----------------------------------------------------------------------- + + use ndrop, only: activate_aerosol + +!----------------------------------------------------------------------- +! arguments (note: TMR = tracer mixing ratio) + + class(aerosol_properties), intent(in) :: aero_props + + ! conu = tracer mixing ratios in updraft at top of this (current) level + ! The conu are changed by activation + real(r8), intent(inout) :: conu(2,ncnstaer) + ! conent = TMRs in the entrained air at this level + real(r8), intent(in) :: conent(2,ncnstaer) + real(r8), intent(inout) :: dconudt(2,ncnstaer) ! TMR tendencies due to activation + + real(r8), intent(in) :: f_ent ! fraction of updraft massflux that was + ! entrained across this layer == eudp/mu_p_eudp + real(r8), intent(in) :: dt_u ! lagrangian transport time (s) in the + ! updraft at current level + real(r8), intent(in) :: wup ! mean updraft vertical velocity (m/s) + ! at current level updraft + + real(r8), intent(in) :: tair ! Temperature in Kelvin + real(r8), intent(in) :: rhoair ! air density (kg/m3) + + integer, intent(in) :: ipass_calc_updraft + +!----------------------------------------------------------------------- +! local variables + integer :: l, m, mm + + real(r8) :: delact ! working variable + real(r8) :: dt_u_inv ! 1.0/dt_u + real(r8) :: fluxm(nbins) ! to understand this, see subr activate_aerosol + real(r8) :: fluxn(nbins) ! to understand this, see subr activate_aerosol + real(r8) :: flux_fullact ! to understand this, see subr activate_aerosol + real(r8) :: fm(nbins) ! mass fraction of aerosols activated + real(r8) :: fn(nbins) ! number fraction of aerosols activated + real(r8) :: hygro(nbins) ! current hygroscopicity for int+act + real(r8) :: naerosol(nbins) ! interstitial+activated number conc (#/m3) + real(r8) :: sigw ! standard deviation of updraft velocity (cm/s) + real(r8) :: tmp_fact ! working variable + real(r8) :: vaerosol(nbins) ! int+act volume (m3/m3) + real(r8) :: wbar ! mean updraft velocity (cm/s) + real(r8) :: wdiab ! diabatic vertical velocity (cm/s) + real(r8) :: wminf, wmaxf ! limits for integration over updraft spectrum (cm/s) + + real(r8) :: spec_hygro + real(r8) :: spec_dens + character(len=32) :: spec_type + + real(r8) :: tmpa, tmpb, tmpc ! working variable + real(r8) :: naerosol_a(1) ! number conc (1/m3) + real(r8) :: vaerosol_a(1) ! volume conc (m3/m3) + +!----------------------------------------------------------------------- + +! when ipass_calc_updraft == 2, apply the activation tendencies +! from pass 1, but multiplied by factor_reduce_actfrac +! (can only have ipass_calc_updraft == 2 when method_reduce_actfrac = 2) + if (ipass_calc_updraft == 2) then + + dt_u_inv = 1.0_r8/dt_u + + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + + delact = dconudt(2,mm)*dt_u * factor_reduce_actfrac + delact = min( delact, conu(1,mm) ) + delact = max( delact, 0.0_r8 ) + conu(1,mm) = conu(1,mm) - delact + conu(2,mm) = conu(2,mm) + delact + dconudt(1,mm) = -delact*dt_u_inv + dconudt(2,mm) = delact*dt_u_inv + + end do + end do + + return + + end if ! (ipass_calc_updraft == 2) + +! check f_ent > 0 + if (f_ent <= 0.0_r8) return + + hygro = 0.0_r8 + vaerosol = 0.0_r8 + naerosol = 0.0_r8 + + do m = 1, nbins +! compute a (or a+cw) volume and hygroscopicity + tmpa = 0.0_r8 + tmpb = 0.0_r8 + do l = 1, aero_props%nmasses(m) + + mm = aero_props%indexer(m,l) + + call aero_props%get(m, l, spectype=spec_type, density=spec_dens, hygro=spec_hygro) + + tmpc = max( conent(1,mm), 0.0_r8 ) + if ( use_cwaer_for_activate_maxsat ) & + tmpc = tmpc + max( conent(2,mm), 0.0_r8 ) + tmpc = tmpc / spec_dens + tmpa = tmpa + tmpc + tmpb = tmpb + tmpc * spec_hygro + end do + vaerosol(m) = tmpa * rhoair + if (tmpa < 1.0e-35_r8) then + hygro(m) = 0.2_r8 + else + hygro(m) = tmpb/tmpa + end if + +! load a (or a+cw) number and bound it + tmpa = max( conent(1,mm), 0.0_r8 ) + if ( use_cwaer_for_activate_maxsat ) & + tmpa = tmpa + max( conent(2,mm), 0.0_r8 ) + naerosol(m) = tmpa * rhoair + + naerosol_a(1) = naerosol(m) + vaerosol_a(1) = vaerosol(m) + + call aero_props%apply_number_limits( naerosol_a, vaerosol_a, 1, 1, m ) + + naerosol(m) = naerosol_a(1) + end do + +! call Razzak-Ghan activation routine with single updraft + wbar = max( wup, 0.5_r8 ) ! force wbar >= 0.5 m/s for now + sigw = 0.0_r8 + wdiab = 0.0_r8 + wminf = wbar + wmaxf = wbar + + call activate_aerosol( & + wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & + naerosol, nbins, vaerosol, hygro, aero_props, & + fn, fm, fluxn, fluxm, flux_fullact ) + +! apply the activation fractions to the updraft aerosol mixing ratios + dt_u_inv = 1.0_r8/dt_u + + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + + if ( (method_reduce_actfrac == 1) .and. & + (factor_reduce_actfrac >= 0.0_r8) .and. & + (factor_reduce_actfrac < 1.0_r8) ) & + tmp_fact = tmp_fact * factor_reduce_actfrac + + delact = min( conent(1,mm)*tmp_fact*f_ent, conu(1,mm) ) + delact = max( delact, 0.0_r8 ) + conu(1,mm) = conu(1,mm) - delact + conu(2,mm) = conu(2,mm) + delact + dconudt(1,mm) = -delact*dt_u_inv + dconudt(2,mm) = delact*dt_u_inv + end do + end do + + end subroutine activate_convproc + +!========================================================================================= + subroutine activate_convproc_method2( aero_props, & + conu, dconudt, & + f_ent, dt_u, wup, & + tair, rhoair, k, & + kactfirst, ipass_calc_updraft ) +!----------------------------------------------------------------------- +! +! Purpose: +! Calculate activation of aerosol species in convective updraft +! for a single column and level +! +! Method: +! conu(l) = Updraft TMR (tracer mixing ratio) at k/k-1 interface +! f_ent = Fraction of the "before-detrainment" updraft massflux at +! k/k-1 interface" resulting from entrainment of level k air +! (where k is the current level in subr aero_convproc_tend) +! +! On entry to this routine, the conu(l) represents the updraft TMR +! after entrainment, but before chemistry/physics and detrainment. +! +! This routine applies aerosol activation to the conu tracer mixing ratios, +! then adjusts the conu so that on exit, +! conu(la) = conu_incoming(la) - conu(la)*f_act(la) +! conu(lc) = conu_incoming(lc) + conu(la)*f_act(la) +! where +! la, lc = indices for an unactivated/activated aerosol component pair +! f_act = fraction of conu(la) that is activated. The f_act are +! calculated with the Razzak-Ghan activation parameterization. +! The f_act differ for each mode, and for number/surface/mass. +! +! At cloud base (k==kactfirst), primary activation is done using the +! "standard" code in subr activate do diagnose maximum supersaturation. +! Above cloud base, secondary activation is done using a +! prescribed supersaturation. +! +! *** The updraft velocity used for activation calculations is rather +! uncertain and needs more work. However, an updraft of 1-3 m/s +! will activate essentially all of accumulation and coarse mode particles. +! +! Author: R. Easter +! +!----------------------------------------------------------------------- + + use ndrop, only: activate_aerosol + +!----------------------------------------------------------------------- +! arguments (note: TMR = tracer mixing ratio) + + class(aerosol_properties), intent(in) :: aero_props + + ! conu = tracer mixing ratios in updraft at top of this (current) level + ! The conu are changed by activation + real(r8), intent(inout) :: conu(2,ncnstaer) + real(r8), intent(inout) :: dconudt(2,ncnstaer) ! TMR tendencies due to activation + + real(r8), intent(in) :: f_ent ! fraction of updraft massflux that was + ! entrained across this layer == eudp/mu_p_eudp + real(r8), intent(in) :: dt_u ! lagrangian transport time (s) in the + ! updraft at current level + real(r8), intent(in) :: wup ! mean updraft vertical velocity (m/s) + ! at current level updraft + + real(r8), intent(in) :: tair ! Temperature in Kelvin + real(r8), intent(in) :: rhoair ! air density (kg/m3) + ! used as in-cloud wet removal rate + integer, intent(in) :: k ! level index + integer, intent(in) :: kactfirst ! k at cloud base + integer, intent(in) :: ipass_calc_updraft + +!----------------------------------------------------------------------- +! local variables + integer :: l, m, mm + + real(r8) :: delact ! working variable + real(r8) :: dt_u_inv ! 1.0/dt_u + real(r8) :: fluxm(nbins) ! to understand this, see subr activate_aerosol + real(r8) :: fluxn(nbins) ! to understand this, see subr activate_aerosol + real(r8) :: flux_fullact ! to understand this, see subr activate_aerosol + real(r8) :: fm(nbins) ! mass fraction of aerosols activated + real(r8) :: fn(nbins) ! number fraction of aerosols activated + real(r8) :: hygro(nbins) ! current hygroscopicity for int+act + real(r8) :: naerosol(nbins) ! interstitial+activated number conc (#/m3) + real(r8) :: sigw ! standard deviation of updraft velocity (cm/s) + real(r8) :: smax_prescribed ! prescribed supersaturation for secondary activation (0-1 fraction) + real(r8) :: tmp_fact ! working variable + real(r8) :: vaerosol(nbins) ! int+act volume (m3/m3) + real(r8) :: wbar ! mean updraft velocity (cm/s) + real(r8) :: wdiab ! diabatic vertical velocity (cm/s) + real(r8) :: wminf, wmaxf ! limits for integration over updraft spectrum (cm/s) + + real(r8) :: spec_hygro + real(r8) :: spec_dens + character(len=32) :: spec_type + + real(r8) :: tmpa, tmpb, tmpc ! working variable + real(r8) :: naerosol_a(1) ! number conc (1/m3) + real(r8) :: vaerosol_a(1) ! volume conc (m3/m3) + +!----------------------------------------------------------------------- + +! when ipass_calc_updraft == 2, apply the activation tendencies +! from pass 1, but multiplied by factor_reduce_actfrac +! (can only have ipass_calc_updraft == 2 when method_reduce_actfrac = 2) + + if (ipass_calc_updraft == 2) then + + dt_u_inv = 1.0_r8/dt_u + + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + + delact = dconudt(2,mm)*dt_u * factor_reduce_actfrac + delact = min( delact, conu(1,mm) ) + delact = max( delact, 0.0_r8 ) + conu(1,mm) = conu(1,mm) - delact + conu(2,mm) = conu(2,mm) + delact + dconudt(1,mm) = -delact*dt_u_inv + dconudt(2,mm) = delact*dt_u_inv + end do + end do ! "n = 1, ntot_amode" + return + + end if ! (ipass_calc_updraft == 2) + +! check f_ent > 0 + if (f_ent <= 0.0_r8) return + + hygro = 0.0_r8 + vaerosol = 0.0_r8 + naerosol = 0.0_r8 + + do m = 1, nbins +! compute a (or a+cw) volume and hygroscopicity + tmpa = 0.0_r8 + tmpb = 0.0_r8 + do l = 1, aero_props%nspecies(m) + + mm = aero_props%indexer(m,l) + + call aero_props%get(m, l, spectype=spec_type, density=spec_dens, hygro=spec_hygro) + + tmpc = max( conu(1,mm), 0.0_r8 ) + if ( use_cwaer_for_activate_maxsat ) & + tmpc = tmpc + max( conu(2,mm), 0.0_r8 ) + tmpc = tmpc / spec_dens + tmpa = tmpa + tmpc + + ! Change the hygroscopicity of POM based on the discussion with Prof. + ! Xiaohong Liu. Some observational studies found that the primary organic + ! material from biomass burning emission shows very high hygroscopicity. + ! Also, found that BC mass will be overestimated if all the aerosols in + ! the primary mode are free to be removed. Therefore, set the hygroscopicity + ! of POM here as 0.2 to enhance the wet scavenge of primary BC and POM. + + if (spec_type=='p-organic' .and. convproc_pom_spechygro>0._r8) then + tmpb = tmpb + tmpc * convproc_pom_spechygro + else + tmpb = tmpb + tmpc * spec_hygro + end if + end do + vaerosol(m) = tmpa * rhoair + if (tmpa < 1.0e-35_r8) then + hygro(m) = 0.2_r8 + else + hygro(m) = tmpb/tmpa + end if + + mm = aero_props%indexer(m,0) + +! load a (or a+cw) number and bound it + tmpa = max( conu(1,mm), 0.0_r8 ) + if ( use_cwaer_for_activate_maxsat ) & + tmpa = tmpa + max( conu(2,mm), 0.0_r8 ) + naerosol(m) = tmpa * rhoair + + naerosol_a(1) = naerosol(m) + vaerosol_a(1) = vaerosol(m) + + call aero_props%apply_number_limits( naerosol_a, vaerosol_a, 1, 1, m ) + + naerosol(m) = naerosol_a(1) + + end do + +! call Razzak-Ghan activation routine with single updraft + wbar = max( wup, 0.5_r8 ) ! force wbar >= 0.5 m/s for now + sigw = 0.0_r8 + wdiab = 0.0_r8 + wminf = wbar + wmaxf = wbar + + if (k == kactfirst) then + + call activate_aerosol( & + wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & + naerosol, nbins, vaerosol, hygro, aero_props, & + fn, fm, fluxn, fluxm, flux_fullact ) + + + else +! above cloud base - do secondary activation with prescribed supersat +! that is constant with height + smax_prescribed = method2_activate_smaxmax + call activate_aerosol( & + wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & + naerosol, nbins, vaerosol, hygro, aero_props, & + fn, fm, fluxn, fluxm, flux_fullact, smax_prescribed ) + end if + +! apply the activation fractions to the updraft aerosol mixing ratios + dt_u_inv = 1.0_r8/dt_u + + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + if (l==0) then + tmp_fact = fn(m) + else + tmp_fact = fm(m) + end if + + if ( (method_reduce_actfrac == 1) .and. & + (factor_reduce_actfrac >= 0.0_r8) .and. & + (factor_reduce_actfrac < 1.0_r8) ) & + tmp_fact = tmp_fact * factor_reduce_actfrac + + delact = min( conu(1,mm)*tmp_fact, conu(1,mm) ) + delact = max( delact, 0.0_r8 ) + conu(1,mm) = conu(1,mm) - delact + conu(2,mm) = conu(2,mm) + delact + dconudt(1,mm) = -delact*dt_u_inv + dconudt(2,mm) = delact*dt_u_inv + end do + end do + + end subroutine activate_convproc_method2 + +!========================================================================================= + subroutine resuspend_convproc( aero_props, & + dcondt, dcondt_resusp, ktop, kbot_prevap ) +!----------------------------------------------------------------------- +! +! Purpose: +! Calculate resuspension of activated aerosol species resulting from both +! detrainment from updraft and downdraft into environment +! subsidence and lifting of environment, which may move air from +! levels with large-scale cloud to levels with no large-scale cloud +! +! Method: +! Three possible approaches were considered: +! +! 1. Ad-hoc #1 approach. At each level, adjust dcondt for the activated +! and unactivated portions of a particular aerosol species so that the +! ratio of dcondt (activated/unactivate) is equal to the ratio of the +! mixing ratios before convection. +! THIS WAS IMPLEMENTED IN MIRAGE2 +! +! 2. Ad-hoc #2 approach. At each level, adjust dcondt for the activated +! and unactivated portions of a particular aerosol species so that the +! change to the activated portion is minimized (zero if possible). The +! would minimize effects of convection on the large-scale cloud. +! THIS IS CURRENTLY IMPLEMENTED IN CAM5 where we assume that convective +! clouds have no impact on the stratiform-cloudborne aerosol +! +! 3. Mechanistic approach that treats the details of interactions between +! the large-scale and convective clouds. (Something for the future.) +! +! Author: R. Easter +! +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! arguments +! (note: TMR = tracer mixing ratio) + + class(aerosol_properties), intent(in) :: aero_props + real(r8), intent(inout) :: dcondt(2,ncnstaer,pver) + ! overall TMR tendency from convection + real(r8), intent(inout) :: dcondt_resusp(2,ncnstaer,pver) + ! portion of TMR tendency due to resuspension + ! (actually, due to the adjustments made here) + integer, intent(in) :: ktop, kbot_prevap ! indices of top and bottom cloud levels + +!----------------------------------------------------------------------- +! local variables + integer :: k, l, m, mm + real(r8) :: qdota, qdotc, qdotac ! working variables (MR tendencies) + !----------------------------------------------------------------------- + + ! apply adjustments to dcondt for pairs of unactivated and + ! activated aerosol species + do m = 1, aero_props%nbins() + do l = 0, aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + + do k = ktop, kbot_prevap + if (convproc_do_evaprain_atonce) then + dcondt_resusp(1,mm,k) = dcondt(1,mm,k) + dcondt_resusp(2,mm,k) = dcondt(2,mm,k) + else + qdota = dcondt(1,mm,k) + qdotc = dcondt(2,mm,k) + qdotac = qdota + qdotc + + dcondt(1,mm,k) = qdotac + dcondt(2,mm,k) = 0.0_r8 + + dcondt_resusp(1,mm,k) = (dcondt(1,mm,k) - qdota) + dcondt_resusp(2,mm,k) = (dcondt(2,mm,k) - qdotc) + end if + end do + + end do + end do + + end subroutine resuspend_convproc + +!========================================================================================= + +end module aero_convproc diff --git a/src/chemistry/aerosol/aero_wetdep_cam.F90 b/src/chemistry/aerosol/aero_wetdep_cam.F90 new file mode 100644 index 0000000000..4a8a4e1ac4 --- /dev/null +++ b/src/chemistry/aerosol/aero_wetdep_cam.F90 @@ -0,0 +1,1189 @@ +module aero_wetdep_cam + use shr_kind_mod, only: r8 => shr_kind_r8 + use physics_types, only: physics_state, physics_ptend, physics_ptend_init + use camsrfexch, only: cam_out_t + use physics_buffer,only: physics_buffer_desc, pbuf_get_index, pbuf_set_field, pbuf_get_field + use constituents, only: pcnst, cnst_name, cnst_get_ind + use phys_control, only: phys_getopts + use ppgrid, only: pcols, pver + use physconst, only: gravit + + use cam_abortutils,only: endrun + use cam_logfile, only: iulog + use spmd_utils, only: masterproc + use infnan, only: nan, assignment(=) + + use cam_history, only: addfld, add_default, horiz_only, outfld + use wetdep, only: wetdep_init + + use rad_constituents, only: rad_cnst_get_info + + use aerosol_properties_mod, only: aero_name_len + use aerosol_properties_mod, only: aerosol_properties + use modal_aerosol_properties_mod, only: modal_aerosol_properties + + use aerosol_state_mod, only: aerosol_state, ptr2d_t + use modal_aerosol_state_mod, only: modal_aerosol_state + + use aero_convproc, only: aero_convproc_readnl, aero_convproc_init, aero_convproc_intr + use aero_convproc, only: convproc_do_evaprain_atonce + use aero_convproc, only: deepconv_wetdep_history + + use infnan, only: nan, assignment(=) + use perf_mod, only: t_startf, t_stopf + + implicit none + private + + public :: aero_wetdep_readnl + public :: aero_wetdep_init + public :: aero_wetdep_tend + + real(r8), parameter :: NOTSET = -huge(1._r8) + real(r8) :: sol_facti_cloud_borne = NOTSET + real(r8) :: sol_factb_interstitial = NOTSET + real(r8) :: sol_factic_interstitial = NOTSET + + integer :: fracis_idx = -1 + integer :: rprddp_idx = -1 + integer :: rprdsh_idx = -1 + integer :: nevapr_shcu_idx = -1 + integer :: nevapr_dpcu_idx = -1 + + logical :: wetdep_active = .false. + integer :: nwetdep = 0 + logical :: convproc_do_aer = .false. + logical,allocatable :: aero_cnst_lq(:,:) + integer,allocatable :: aero_cnst_id(:,:) + logical, public, protected :: wetdep_lq(pcnst) ! set flags true for constituents with non-zero tendencies + + ! variables for table lookup of aerosol impaction/interception scavenging rates + integer, parameter :: nimptblgrow_mind=-7, nimptblgrow_maxd=12 + real(r8) :: dlndg_nimptblgrow + real(r8),allocatable :: scavimptblnum(:,:) + real(r8),allocatable :: scavimptblvol(:,:) + + integer :: nmodes=0 + integer :: nspec_max=0 + integer :: nele_tot ! total number of aerosol elements + class(aerosol_properties), pointer :: aero_props=>null() + +contains + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine aero_wetdep_readnl(nlfile) + use namelist_utils, only: find_group_name + use spmd_utils, only: mpicom, masterprocid, mpi_character, mpi_real8, mpi_integer, mpi_success + use spmd_utils, only: mpi_logical + + character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input + + integer :: unitn, ierr + character(len=*), parameter :: subname = 'aero_wetdep_readnl' + + ! =================== + ! Namelist definition + ! =================== + namelist /aero_wetdep_nl/ sol_facti_cloud_borne, sol_factb_interstitial, sol_factic_interstitial + + ! ============= + ! Read namelist + ! ============= + if (masterproc) then + open( newunit=unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'aero_wetdep_nl', status=ierr) + if (ierr == 0) then + read(unitn, aero_wetdep_nl, iostat=ierr) + if (ierr /= 0) then + call endrun(subname // ':: ERROR reading namelist') + end if + end if + close(unitn) + + ! ============================ + ! Log namelist options + ! ============================ + write(iulog,*) subname,' namelist settings: ' + write(iulog,*) ' sol_facti_cloud_borne : ',sol_facti_cloud_borne + write(iulog,*) ' sol_factb_interstitial : ',sol_factb_interstitial + write(iulog,*) ' sol_factic_interstitial: ',sol_factic_interstitial + end if + + ! ============================ + ! Broadcast namelist variables + ! ============================ + call mpi_bcast(sol_facti_cloud_borne, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) then + call endrun(subname//': MPI_BCAST ERROR: sol_facti_cloud_borne') + end if + call mpi_bcast(sol_factb_interstitial, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) then + call endrun(subname//': MPI_BCAST ERROR: sol_factb_interstitial') + end if + call mpi_bcast(sol_factic_interstitial, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) then + call endrun(subname//': MPI_BCAST ERROR: sol_factic_interstitial') + end if + + call mpi_bcast(nwetdep, 1, mpi_integer, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) then + call endrun(subname//': MPI_BCAST ERROR: nwetdep') + end if + + wetdep_active = .true. !nwetdep>0 + + if (masterproc) then + write(iulog,*) subname,' wetdep_active = ',wetdep_active,' nwetdep = ',nwetdep + endif + + call aero_convproc_readnl(nlfile) + + end subroutine aero_wetdep_readnl + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine aero_wetdep_init( ) + + character(len=*), parameter :: subrname = 'aero_wetdep_init' + + character(len=2) :: unit_basename ! Units 'kg' or '1' + character(len=aero_name_len) :: tmpname + character(len=aero_name_len) :: tmpname_cw + + logical :: history_aerosol ! Output MAM or SECT aerosol tendencies + logical :: history_chemistry + + integer :: l,m, id, astat + character(len=2) :: binstr + + fracis_idx = pbuf_get_index('FRACIS') + rprddp_idx = pbuf_get_index('RPRDDP') + rprdsh_idx = pbuf_get_index('RPRDSH') + nevapr_shcu_idx = pbuf_get_index('NEVAPR_SHCU') + nevapr_dpcu_idx = pbuf_get_index('NEVAPR_DPCU') + + if (.not.wetdep_active) return + + call phys_getopts(history_aerosol_out = history_aerosol, & + history_chemistry_out=history_chemistry, & + convproc_do_aer_out = convproc_do_aer) + + call rad_cnst_get_info(0, nmodes=nmodes) + + if (nmodes>0) then + aero_props => modal_aerosol_properties() + if (.not.associated(aero_props)) then + call endrun(subrname//' : construction of aero_props modal_aerosol_properties object failed') + end if + else + call endrun(subrname//' : cannot determine aerosol model') + endif + + nele_tot = aero_props%ncnst_tot() + + allocate(aero_cnst_lq(aero_props%nbins(),0:maxval(aero_props%nmasses())), stat=astat) + if (astat/=0) then + call endrun(subrname//' : not able to allocate aero_cnst_lq array') + end if + aero_cnst_lq(:,:) = .false. + + allocate(aero_cnst_id(aero_props%nbins(),0:maxval(aero_props%nmasses())), stat=astat) + if (astat/=0) then + call endrun(subrname//' : not able to allocate aero_cnst_id array') + end if + aero_cnst_id(:,:) = -1 + + wetdep_lq = .false. + + do m = 1, aero_props%nbins() + write(binstr,'(i2.2)') m + call addfld('SOLFACTB'//binstr, (/ 'lev' /), 'A', '1', 'below cld sol fact') + + do l = 0, aero_props%nmasses(m) + + if (l == 0) then ! number + call aero_props%num_names( m, tmpname, tmpname_cw) + else + call aero_props%mmr_names( m,l, tmpname, tmpname_cw) + end if + + call cnst_get_ind(tmpname, id, abort=.false.) + aero_cnst_id(m,l) = id + aero_cnst_lq(m,l) = id > 0 + if (id > 0) then + wetdep_lq(id) = .true. + end if + + ! units -- + if (l==0) then + unit_basename = ' 1' ! for num + else + unit_basename = 'kg' + endif + + call add_hist_fields(tmpname, unit_basename) + call add_hist_fields(tmpname_cw, unit_basename) + + call addfld( trim(tmpname_cw)//'RSPTD', (/ 'lev' /), 'A', unit_basename//'/kg/s', & + trim(tmpname_cw)//' resuspension tendency') + + end do + end do + + allocate(scavimptblnum(nimptblgrow_mind:nimptblgrow_maxd, aero_props%nbins()), stat=astat) + if (astat/=0) then + call endrun(subrname//' : not able to allocate scavimptblnum array') + end if + allocate(scavimptblvol(nimptblgrow_mind:nimptblgrow_maxd, aero_props%nbins()), stat=astat) + if (astat/=0) then + call endrun(subrname//' : not able to allocate scavimptblvol array') + end if + scavimptblnum = nan + scavimptblvol = nan + + call wetdep_init() + + nspec_max = maxval(aero_props%nspecies()) + 2 + + call init_bcscavcoef() + + if (convproc_do_aer) then + call aero_convproc_init(aero_props) + end if + + contains + + subroutine add_hist_fields(name,baseunits) + character(len=*), intent(in) :: name + character(len=*), intent(in) :: baseunits + + call addfld (trim(name)//'SFWET', & + horiz_only, 'A',baseunits//'/m2/s ','Wet deposition flux at surface') + call addfld (trim(name)//'SFSIC', & + horiz_only, 'A',baseunits//'/m2/s ','Wet deposition flux (incloud, convective) at surface') + call addfld (trim(name)//'SFSIS', & + horiz_only, 'A',baseunits//'/m2/s ','Wet deposition flux (incloud, stratiform) at surface') + call addfld (trim(name)//'SFSBC', & + horiz_only, 'A',baseunits//'/m2/s ','Wet deposition flux (belowcloud, convective) at surface') + call addfld (trim(name)//'SFSBS', & + horiz_only, 'A',baseunits//'/m2/s ','Wet deposition flux (belowcloud, stratiform) at surface') + + if (convproc_do_aer) then + call addfld (trim(name)//'SFSEC', & + horiz_only, 'A',unit_basename//'/m2/s','Wet deposition flux (precip evap, convective) at surface') + call addfld (trim(name)//'SFSES', & + horiz_only, 'A',unit_basename//'/m2/s','Wet deposition flux (precip evap, stratiform) at surface') + call addfld (trim(name)//'SFSBD', & + horiz_only, 'A',unit_basename//'/m2/s','Wet deposition flux (belowcloud, deep convective) at surface') + call addfld (trim(name)//'WETC', & + (/ 'lev' /), 'A',unit_basename//'/kg/s ','wet deposition tendency') + call addfld (trim(name)//'CONU', & + (/ 'lev' /), 'A',unit_basename//'/kg ','updraft mixing ratio') + end if + + call addfld (trim(name)//'WET',(/ 'lev' /), 'A',baseunits//'/kg/s ','wet deposition tendency') + call addfld (trim(name)//'INS',(/ 'lev' /), 'A',baseunits//'/kg/s ','insol frac') + + call addfld (trim(name)//'SIC',(/ 'lev' /), 'A',baseunits//'/kg/s ', & + trim(name)//' ic wet deposition') + call addfld (trim(name)//'SIS',(/ 'lev' /), 'A',baseunits//'/kg/s ', & + trim(name)//' is wet deposition') + call addfld (trim(name)//'SBC',(/ 'lev' /), 'A',baseunits//'/kg/s ', & + trim(name)//' bc wet deposition') + call addfld (trim(name)//'SBS',(/ 'lev' /), 'A',baseunits//'/kg/s ', & + trim(name)//' bs wet deposition') + + if ( history_aerosol .or. history_chemistry ) then + call add_default (trim(name)//'SFWET', 1, ' ') + endif + if ( history_aerosol ) then + call add_default (trim(name)//'SFSEC', 1, ' ') + call add_default (trim(name)//'SFSIC', 1, ' ') + call add_default (trim(name)//'SFSIS', 1, ' ') + call add_default (trim(name)//'SFSBC', 1, ' ') + call add_default (trim(name)//'SFSBS', 1, ' ') + if (convproc_do_aer) then + call add_default (trim(name)//'SFSES', 1, ' ') + call add_default (trim(name)//'SFSBD', 1, ' ') + end if + endif + + end subroutine add_hist_fields + + end subroutine aero_wetdep_init + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine aero_wetdep_tend( state, dt, dlf, cam_out, ptend, pbuf) + use wetdep, only: wetdepa_v2, wetdep_inputs_set, wetdep_inputs_t + use aerodep_flx, only: aerodep_flx_prescribed + use aero_deposition_cam, only: aero_deposition_cam_setwet + + type(physics_state), target, intent(in) :: state ! Physics state variables + real(r8), intent(in) :: dt ! time step + real(r8), intent(in) :: dlf(:,:) ! shallow+deep convective detrainment [kg/kg/s] + type(cam_out_t), intent(inout) :: cam_out ! export state + type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies + type(physics_buffer_desc), pointer :: pbuf(:) + + character(len=*), parameter :: subrname = 'aero_wetdep_tend' + type(wetdep_inputs_t) :: dep_inputs + real(r8), pointer :: fracis(:,:,:) ! fraction of transported species that are insoluble (pcols, pver, pcnst) + real(r8), target :: fracis_nadv(pcols,pver) ! fraction of not-transported aerosols + + real(r8) :: scavcoefnv(pcols,pver,0:2) ! Dana and Hales coefficient (/mm) for + ! cloud-borne num & vol (0), + ! interstitial num (1), interstitial vol (2) + integer :: jnv ! index for scavcoefnv 3rd dimension + integer :: lphase ! index for interstitial / cloudborne aerosol + integer :: strt_loop, end_loop, stride_loop !loop indices for the lphase loop + + real(r8) :: sol_factb(pcols, pver) + real(r8) :: sol_facti(pcols, pver) + real(r8) :: sol_factic(pcols,pver) + + real(r8) :: dqdt_tmp(pcols,pver) ! temporary array to hold tendency for 1 species + real(r8) :: rcscavt(pcols, pver) + real(r8) :: rsscavt(pcols, pver) + real(r8) :: iscavt(pcols, pver) + real(r8) :: icscavt(pcols, pver) + real(r8) :: isscavt(pcols, pver) + real(r8) :: bcscavt(pcols, pver) + real(r8) :: bsscavt(pcols, pver) + + real(r8) :: diam_wet(state%ncol, pver) + logical :: isprx(pcols,pver) ! true if precipation + real(r8) :: prec(pcols) ! precipitation rate + + real(r8) :: rtscavt(pcols, pver, 0:nspec_max) + + integer :: ncol, lchnk, m, ndx,mm, l + integer :: i,k + + real(r8), pointer :: insolfr_ptr(:,:) + real(r8) :: q_tmp(pcols,pver) ! temporary array to hold "most current" mixing ratio for 1 species + logical :: cldbrn + + type(ptr2d_t) :: raer(nele_tot) + type(ptr2d_t) :: qqcw(nele_tot) + + real(r8) :: sflx(pcols) + character(len=aero_name_len) :: aname, cname, name + + real(r8) :: qqcw_in(pcols,pver), qqcw_sav(pcols,pver,0:nspec_max) + real(r8) :: f_act_conv(pcols,pver) ! prescribed aerosol activation fraction for convective cloud ! rce 2010/05/01 + + character(len=2) :: binstr + real(r8) :: aerdepwetcw(pcols,pcnst) ! aerosol wet deposition (cloud water) + real(r8) :: aerdepwetis(pcols,pcnst) ! aerosol wet deposition (interstitial) + real(r8) :: dcondt_resusp3d(nele_tot,pcols,pver) + + integer, parameter :: nsrflx_mzaer2cnvpr = 2 + real(r8) :: qsrflx_mzaer2cnvpr(pcols,nele_tot,nsrflx_mzaer2cnvpr) + + real(r8), pointer :: rprddp(:,:) ! rain production, deep convection + real(r8), pointer :: rprdsh(:,:) ! rain production, shallow convection + real(r8), pointer :: evapcdp(:,:) ! Evaporation rate of deep convective precipitation >=0. + real(r8), pointer :: evapcsh(:,:) ! Evaporation rate of shallow convective precipitation >=0. + + real(r8) :: rprddpsum(pcols) + real(r8) :: rprdshsum(pcols) + real(r8) :: evapcdpsum(pcols) + real(r8) :: evapcshsum(pcols) + + real(r8) :: tmp_resudp, tmp_resush + real(r8) :: tmpa, tmpb + real(r8) :: sflxec(pcols), sflxecdp(pcols) ! deposition flux + real(r8) :: sflxic(pcols), sflxicdp(pcols) ! deposition flux + real(r8) :: sflxbc(pcols), sflxbcdp(pcols) ! deposition flux + + class(aerosol_state), pointer :: aero_state + + nullify(aero_state) + + if (.not.wetdep_active) return + + dcondt_resusp3d(:,:,:) = 0._r8 + + if (nmodes>0) then + aero_state => modal_aerosol_state(state,pbuf) + if (.not.associated(aero_state)) then + call endrun(subrname//' : construction of aero_state modal_aerosol_state object failed') + end if + else + call endrun(subrname//' : cannot determine aerosol model') + endif + + lchnk = state%lchnk + ncol = state%ncol + + call physics_ptend_init(ptend, state%psetcols, subrname, lq=wetdep_lq) + + call wetdep_inputs_set( state, pbuf, dep_inputs ) + + call pbuf_get_field(pbuf, fracis_idx, fracis) + + call aero_state%get_states( aero_props, raer, qqcw ) + + qsrflx_mzaer2cnvpr(:,:,:) = 0.0_r8 + aerdepwetis(:,:) = 0.0_r8 + aerdepwetcw(:,:) = 0.0_r8 + + if (convproc_do_aer) then + !Do cloudborne first for unified convection scheme so that the resuspension of cloudborne + !can be saved then applied to interstitial + strt_loop = 2 + end_loop = 1 + stride_loop = -1 + else + ! Counters for "without" unified convective treatment (i.e. default case) + strt_loop = 1 + end_loop = 2 + stride_loop = 1 + endif + + prec(:ncol)=0._r8 + do k=1,pver + where (prec(:ncol) >= 1.e-7_r8) + isprx(:ncol,k) = .true. + elsewhere + isprx(:ncol,k) = .false. + endwhere + prec(:ncol) = prec(:ncol) + (dep_inputs%prain(:ncol,k) + dep_inputs%cmfdqr(:ncol,k) - dep_inputs%evapr(:ncol,k)) & + *state%pdel(:ncol,k)/gravit + end do + + f_act_conv = 0._r8 + scavcoefnv = nan + qqcw_sav = nan + + if (convproc_do_aer) then + + call t_startf('aero_convproc') + call aero_convproc_intr( aero_props, aero_state, state, ptend, pbuf, dt, & + nsrflx_mzaer2cnvpr, qsrflx_mzaer2cnvpr, aerdepwetis, dcondt_resusp3d ) + + if (convproc_do_evaprain_atonce) then + + do m = 1,aero_props%nbins() + do l = 0,aero_props%nmasses(m) + mm = aero_props%indexer(m,l) + + if (l == 0) then ! number + call aero_props%num_names(m, aname, cname) + else + call aero_props%mmr_names(m,l, aname, cname) + end if + + call outfld( trim(cname)//'RSPTD', dcondt_resusp3d(mm,:ncol,:), ncol, lchnk ) + + do k = 1,pver + do i = 1,ncol + qqcw(mm)%fld(i,k) = max(0._r8, qqcw(mm)%fld(i,k) + dcondt_resusp3d(mm,i,k)*dt) + end do + end do + + end do + end do + end if + call t_stopf('aero_convproc') + + end if + + bins_loop: do m = 1,aero_props%nbins() + + phase_loop: do lphase = strt_loop,end_loop, stride_loop ! loop over interstitial (1) and cloud-borne (2) forms + + cldbrn = lphase==2 + + sol_factb = nan + sol_facti = nan + sol_factic = nan + + if (lphase == 1) then ! interstial aerosol + + sol_facti = 0.0_r8 ! strat in-cloud scav totally OFF for institial + + sol_factic = sol_factic_interstitial + + else ! cloud-borne aerosol (borne by stratiform cloud drops) + + sol_factb = 0.0_r8 ! all below-cloud scav OFF (anything cloud-borne is located "in-cloud") + sol_facti = sol_facti_cloud_borne ! strat in-cloud scav cloud-borne tuning factor + sol_factic = 0.0_r8 ! conv in-cloud scav OFF (having this on would mean + ! that conv precip collects strat droplets) + f_act_conv = 0.0_r8 ! conv in-cloud scav OFF (having this on would mean + + end if + if (convproc_do_aer .and. lphase == 1) then + ! if modal aero convproc is turned on for aerosols, then + ! turn off the convective in-cloud removal for interstitial aerosols + ! (but leave the below-cloud on, as convproc only does in-cloud) + ! and turn off the outfld SFWET, SFSIC, SFSID, SFSEC, and SFSED calls + ! for (stratiform)-cloudborne aerosols, convective wet removal + ! (all forms) is zero, so no action is needed + sol_factic = 0.0_r8 + endif + + diam_wet = aero_state%wet_diameter(m,ncol,pver) + + scavcoefnv = 0.0_r8 + + if (lphase == 1) then ! interstial aerosol + call get_bcscavcoefs( m, ncol, isprx, diam_wet, scavcoefnv(:,:,1), scavcoefnv(:,:,2) ) + + if ( sol_factb_interstitial /= NOTSET ) then + sol_factb(:ncol,:) = sol_factb_interstitial ! all below-cloud scav + else + sol_factb(:ncol,:) = aero_state%sol_factb_interstitial( m, ncol, pver, aero_props ) + end if + + write(binstr,'(i2.2)') m + call outfld('SOLFACTB'//binstr,sol_factb, pcols, lchnk) + + end if + + masses_loop: do l = 0,aero_props%nmasses(m) + + ndx = aero_cnst_id(m,l) + + if (.not. cldbrn .and. ndx>0) then + insolfr_ptr => fracis(:,:,ndx) + else + insolfr_ptr => fracis_nadv + endif + + mm = aero_props%indexer(m,l) + + if (l == 0) then ! number + call aero_props%num_names( m, aname, cname) + else + call aero_props%mmr_names( m,l, aname, cname) + end if + + if (cldbrn) then + q_tmp(1:ncol,:) = qqcw(mm)%fld(1:ncol,:) + jnv = 0 + if (convproc_do_aer) then + qqcw_sav(:ncol,:,l) = q_tmp(1:ncol,:) + endif + name = cname + qqcw_in = nan + f_act_conv = nan + else ! interstial aerosol + q_tmp(1:ncol,:) = raer(mm)%fld(1:ncol,:) + ptend%q(1:ncol,:,ndx)*dt + if (l==0) then + jnv = 1 + else + jnv = 2 + end if + if(convproc_do_aer) then + !Feed in the saved cloudborne mixing ratios from phase 2 + qqcw_in(:ncol,:) = qqcw_sav(:ncol,:,l) + else + qqcw_in(:ncol,:) = qqcw(mm)%fld(:ncol,:) + end if + + f_act_conv(:ncol,:) = aero_state%convcld_actfrac( m, l, ncol, pver) + name = aname + end if + + dqdt_tmp(1:ncol,:) = 0.0_r8 + + call wetdepa_v2(state%pmid, state%q(:,:,1), state%pdel, & + dep_inputs%cldt, dep_inputs%cldcu, dep_inputs%cmfdqr, & + dep_inputs%evapc, dep_inputs%conicw, dep_inputs%prain, dep_inputs%qme, & + dep_inputs%evapr, dep_inputs%totcond, q_tmp, dt, & + dqdt_tmp, iscavt, dep_inputs%cldvcu, dep_inputs%cldvst, & + dlf, insolfr_ptr, sol_factb, ncol, & + scavcoefnv(:,:,jnv), & + is_strat_cloudborne=cldbrn, & + qqcw=qqcw_in(:,:), f_act_conv=f_act_conv, & + icscavt=icscavt, isscavt=isscavt, bcscavt=bcscavt, bsscavt=bsscavt, & + convproc_do_aer=convproc_do_aer, rcscavt=rcscavt, rsscavt=rsscavt, & + sol_facti_in=sol_facti, sol_factic_in=sol_factic, & + convproc_do_evaprain_atonce_in=convproc_do_evaprain_atonce, & + bergso_in=dep_inputs%bergso ) + + if(convproc_do_aer) then + if(cldbrn) then + ! save resuspension of cloudborne species + rtscavt(1:ncol,:,l) = rcscavt(1:ncol,:) + rsscavt(1:ncol,:) + ! wetdepa_v2 adds the resuspension of cloudborne to the dqdt of cloudborne (as a source) + ! undo this, so the resuspension of cloudborne can be added to the dqdt of interstitial (above) + dqdt_tmp(1:ncol,:) = dqdt_tmp(1:ncol,:) - rtscavt(1:ncol,:,l) + else + ! add resuspension of cloudborne species to dqdt of interstitial species + dqdt_tmp(1:ncol,:) = dqdt_tmp(1:ncol,:) + rtscavt(1:ncol,:,l) + end if + endif + + if (cldbrn .or. ndx<0) then + do k = 1,pver + do i = 1,ncol + if ( (qqcw(mm)%fld(i,k) + dqdt_tmp(i,k) * dt) .lt. 0.0_r8 ) then + dqdt_tmp(i,k) = - qqcw(mm)%fld(i,k) / dt + end if + end do + end do + + qqcw(mm)%fld(1:ncol,:) = qqcw(mm)%fld(1:ncol,:) + dqdt_tmp(1:ncol,:) * dt + + else + ptend%q(1:ncol,:,ndx) = ptend%q(1:ncol,:,ndx) + dqdt_tmp(1:ncol,:) + end if + + call outfld( trim(name)//'WET', dqdt_tmp(:,:), pcols, lchnk) + call outfld( trim(name)//'SIC', icscavt, pcols, lchnk) + call outfld( trim(name)//'SIS', isscavt, pcols, lchnk) + call outfld( trim(name)//'SBC', bcscavt, pcols, lchnk) + call outfld( trim(name)//'SBS', bsscavt, pcols, lchnk) + + call outfld( trim(name)//'INS', insolfr_ptr, pcols, lchnk) + + sflx(:)=0._r8 + do k=1,pver + do i=1,ncol + sflx(i)=sflx(i)+dqdt_tmp(i,k)*state%pdel(i,k)/gravit + enddo + enddo + if (cldbrn) then + call outfld( trim(name)//'SFWET', sflx, pcols, lchnk) + if (ndx>0) aerdepwetcw(:ncol,ndx) = sflx(:ncol) + else + if (.not.convproc_do_aer) call outfld( trim(name)//'SFWET', sflx, pcols, lchnk) + if (ndx>0) aerdepwetis(:ncol,ndx) = aerdepwetis(:ncol,ndx) + sflx(:ncol) + end if + + sflx(:)=0._r8 + do k=1,pver + do i=1,ncol + sflx(i)=sflx(i)+icscavt(i,k)*state%pdel(i,k)/gravit + enddo + enddo + if (cldbrn) then + call outfld( trim(name)//'SFSIC', sflx, pcols, lchnk) + else + if (.not.convproc_do_aer) call outfld( trim(name)//'SFSIC', sflx, pcols, lchnk) + if (convproc_do_aer) sflxic = sflx + end if + + sflx(:)=0._r8 + do k=1,pver + do i=1,ncol + sflx(i)=sflx(i)+isscavt(i,k)*state%pdel(i,k)/gravit + enddo + enddo + call outfld( trim(name)//'SFSIS', sflx, pcols, lchnk) + + sflx(:)=0._r8 + do k=1,pver + do i=1,ncol + sflx(i)=sflx(i)+bcscavt(i,k)*state%pdel(i,k)/gravit + enddo + enddo + call outfld( trim(name)//'SFSBC', sflx, pcols, lchnk) + if (convproc_do_aer) sflxbc = sflx + + sflx(:)=0._r8 + do k=1,pver + do i=1,ncol + sflx(i)=sflx(i)+bsscavt(i,k)*state%pdel(i,k)/gravit + enddo + enddo + call outfld( trim(name)//'SFSBS', sflx, pcols, lchnk) + + if(convproc_do_aer) then + + sflx(:)=0.0_r8 + do k=1,pver + do i=1,ncol + sflx(i)=sflx(i)+rsscavt(i,k)*state%pdel(i,k)/gravit + enddo + enddo + call outfld( trim(name)//'SFSES', sflx, pcols, lchnk) + + sflx(:)=0._r8 + do k=1,pver + do i=1,ncol + sflx(i)=sflx(i)+rcscavt(i,k)*state%pdel(i,k)/gravit + enddo + enddo + if (.not.convproc_do_aer) call outfld( trim(name)//'SFSEC', sflx, pcols, lchnk) + sflxec = sflx + + if(.not.cldbrn) then + + ! apportion convective surface fluxes to deep and shallow conv + ! this could be done more accurately in subr wetdepa + ! since deep and shallow rarely occur simultaneously, and these + ! fields are just diagnostics, this approximate method is adequate + ! only do this for interstitial aerosol, because conv clouds to not + ! affect the stratiform-cloudborne aerosol + if ( deepconv_wetdep_history) then + + call pbuf_get_field(pbuf, rprddp_idx, rprddp ) + call pbuf_get_field(pbuf, rprdsh_idx, rprdsh ) + call pbuf_get_field(pbuf, nevapr_dpcu_idx, evapcdp ) + call pbuf_get_field(pbuf, nevapr_shcu_idx, evapcsh ) + + rprddpsum(:) = 0.0_r8 + rprdshsum(:) = 0.0_r8 + evapcdpsum(:) = 0.0_r8 + evapcshsum(:) = 0.0_r8 + + do k = 1, pver + rprddpsum(:ncol) = rprddpsum(:ncol) + rprddp(:ncol,k)*state%pdel(:ncol,k)/gravit + rprdshsum(:ncol) = rprdshsum(:ncol) + rprdsh(:ncol,k)*state%pdel(:ncol,k)/gravit + evapcdpsum(:ncol) = evapcdpsum(:ncol) + evapcdp(:ncol,k)*state%pdel(:ncol,k)/gravit + evapcshsum(:ncol) = evapcshsum(:ncol) + evapcsh(:ncol,k)*state%pdel(:ncol,k)/gravit + end do + + do i = 1, ncol + rprddpsum(i) = max( rprddpsum(i), 1.0e-35_r8 ) + rprdshsum(i) = max( rprdshsum(i), 1.0e-35_r8 ) + evapcdpsum(i) = max( evapcdpsum(i), 0.1e-35_r8 ) + evapcshsum(i) = max( evapcshsum(i), 0.1e-35_r8 ) + + ! assume that in- and below-cloud removal are proportional to column precip production + tmpa = rprddpsum(i) / (rprddpsum(i) + rprdshsum(i)) + tmpa = max( 0.0_r8, min( 1.0_r8, tmpa ) ) + sflxicdp(i) = sflxic(i)*tmpa + sflxbcdp(i) = sflxbc(i)*tmpa + + ! assume that resuspension is proportional to (wet removal)*[(precip evap)/(precip production)] + tmp_resudp = tmpa * min( (evapcdpsum(i)/rprddpsum(i)), 1.0_r8 ) + tmp_resush = (1.0_r8 - tmpa) * min( (evapcshsum(i)/rprdshsum(i)), 1.0_r8 ) + tmpb = max( tmp_resudp, 1.0e-35_r8 ) / max( (tmp_resudp+tmp_resush), 1.0e-35_r8 ) + tmpb = max( 0.0_r8, min( 1.0_r8, tmpb ) ) + sflxecdp(i) = sflxec(i)*tmpb + end do + call outfld( trim(name)//'SFSBD', sflxbcdp, pcols, lchnk) + else + sflxec(1:ncol) = 0.0_r8 + sflxecdp(1:ncol) = 0.0_r8 + end if + + ! when ma_convproc_intr is used, convective in-cloud wet removal is done there + ! the convective (total and deep) precip-evap-resuspension includes in- and below-cloud + ! contributions + ! so pass the below-cloud contribution to ma_convproc_intr + qsrflx_mzaer2cnvpr(1:ncol,mm,1) = sflxec( 1:ncol) + qsrflx_mzaer2cnvpr(1:ncol,mm,2) = sflxecdp(1:ncol) + + end if + end if + + end do masses_loop + end do phase_loop + + end do bins_loop + + if (associated(aero_state)) then + deallocate(aero_state) + nullify(aero_state) + end if + + ! if the user has specified prescribed aerosol dep fluxes then + ! do not set cam_out dep fluxes according to the prognostic aerosols + if (.not. aerodep_flx_prescribed()) then + call aero_deposition_cam_setwet(aerdepwetis, aerdepwetcw, cam_out) + endif + + contains + + ! below cloud impaction scavenging coefs + subroutine get_bcscavcoefs( m, ncol, isprx, diam_wet, scavcoefnum, scavcoefvol ) + + integer,intent(in) :: m, ncol + logical,intent(in):: isprx(:,:) + real(r8), intent(in) :: diam_wet(:,:) + real(r8), intent(out) :: scavcoefnum(:,:), scavcoefvol(:,:) + + integer i, k, jgrow + real(r8) dumdgratio, xgrow, dumfhi, dumflo, scavimpvol, scavimpnum + + do k = 1, pver + do i = 1, ncol + + ! do only if no precip + if ( isprx(i,k) .and. diam_wet(i,k)>0.0_r8) then + ! + ! interpolate table values using log of (actual-wet-size)/(base-dry-size) + + dumdgratio = diam_wet(i,k)/aero_props%scav_diam(m) + if ((dumdgratio >= 0.99_r8) .and. (dumdgratio <= 1.01_r8)) then + scavimpvol = scavimptblvol(0,m) + scavimpnum = scavimptblnum(0,m) + else + xgrow = log( dumdgratio ) / dlndg_nimptblgrow + jgrow = int( xgrow ) + if (xgrow < 0._r8) jgrow = jgrow - 1 + if (jgrow < nimptblgrow_mind) then + jgrow = nimptblgrow_mind + xgrow = jgrow + else + jgrow = min( jgrow, nimptblgrow_maxd-1 ) + end if + + dumfhi = xgrow - jgrow + dumflo = 1._r8 - dumfhi + + scavimpvol = dumflo*scavimptblvol(jgrow,m) + & + dumfhi*scavimptblvol(jgrow+1,m) + scavimpnum = dumflo*scavimptblnum(jgrow,m) + & + dumfhi*scavimptblnum(jgrow+1,m) + + end if + + ! impaction scavenging removal amount for volume + scavcoefvol(i,k) = exp( scavimpvol ) + ! impaction scavenging removal amount to number + scavcoefnum(i,k) = exp( scavimpnum ) + + else + scavcoefvol(i,k) = 0._r8 + scavcoefnum(i,k) = 0._r8 + end if + + end do + end do + + end subroutine get_bcscavcoefs + + end subroutine aero_wetdep_tend + + !------------------------------------------------------------------------------ + !------------------------------------------------------------------------------ + subroutine init_bcscavcoef( ) + !----------------------------------------------------------------------- + ! + ! Purpose: + ! Computes lookup table for aerosol impaction/interception scavenging rates + ! + ! Authors: R. Easter + ! Simone Tilmes Nov 2021 + ! added modifications for bin model, assuming sigma = 1. + ! + !----------------------------------------------------------------------- + + use mo_constants, only: pi + + ! local variables + integer nnfit_maxd + parameter (nnfit_maxd=27) + + integer m, jgrow, nnfit + integer lunerr + + real(r8) dg0, dg0_cgs, press, dg0_base, & + rhodryaero, rhowetaero, rhowetaero_cgs, & + scavratenum, scavratevol, logsig, & + temp, wetdiaratio, wetvolratio + + real(r8) :: xxfitnum(1,nnfit_maxd), yyfitnum(nnfit_maxd) + real(r8) :: xxfitvol(1,nnfit_maxd), yyfitvol(nnfit_maxd) + + character(len=*), parameter :: subname = 'aero_wetdep_cam::init_bcscavcoef' + + lunerr = iulog + dlndg_nimptblgrow = log( 1.25_r8 ) + + ! bin model: main loop over aerosol bins + + modeloop: do m = 1, aero_props%nbins() + + ! for setting up the lookup table, use the dry density of the first species + ! -- assume the first species of the mode/bin is the dominate species + call aero_props%get(m,1,density=rhodryaero) + + dg0_base = aero_props%scav_diam(m) + + logsig = aero_props%alogsig(m) + + growloop: do jgrow = nimptblgrow_mind, nimptblgrow_maxd + + wetdiaratio = exp( jgrow*dlndg_nimptblgrow ) + dg0 = dg0_base*wetdiaratio + + wetvolratio = exp( jgrow*dlndg_nimptblgrow*3._r8 ) + rhowetaero = 1.0_r8 + (rhodryaero-1.0_r8)/wetvolratio + rhowetaero = min( rhowetaero, rhodryaero ) + + ! + ! compute impaction scavenging rates at 1 temp-press pair and save + ! + nnfit = 0 + + temp = 273.16_r8 + press = 0.75e6_r8 ! dynes/cm2 + rhowetaero = rhodryaero + + dg0_cgs = dg0*1.0e2_r8 ! m to cm + + rhowetaero_cgs = rhowetaero*1.0e-3_r8 ! kg/m3 to g/cm3 + + call calc_1_impact_rate( & + dg0_cgs, logsig, rhowetaero_cgs, temp, press, & + scavratenum, scavratevol, lunerr ) + + nnfit = nnfit + 1 + if (nnfit > nnfit_maxd) then + write(lunerr,9110) + call endrun(subname//' : nnfit > nnfit_maxd') + end if +9110 format( '*** subr. init_bcscavcoef -- nnfit too big' ) + + xxfitnum(1,nnfit) = 1._r8 + yyfitnum(nnfit) = log( scavratenum ) + + xxfitvol(1,nnfit) = 1._r8 + yyfitvol(nnfit) = log( scavratevol ) + + !depends on both bins and different species + scavimptblnum(jgrow,m) = yyfitnum(1) + scavimptblvol(jgrow,m) = yyfitvol(1) + + enddo growloop + enddo modeloop + + contains + + !=============================================================================== + subroutine calc_1_impact_rate( & + dg0, logsig, rhoaero, temp, press, & + scavratenum, scavratevol, lunerr ) + ! + ! routine computes a single impaction scavenging rate + ! for precipitation rate of 1 mm/h + ! + ! dg0 = geometric mean diameter of aerosol number size distrib. (cm) + ! sigmag = geometric standard deviation of size distrib. + ! rhoaero = density of aerosol particles (g/cm^3) + ! temp = temperature (K) + ! press = pressure (dyne/cm^2) + ! scavratenum = number scavenging rate (1/h) + ! scavratevol = volume or mass scavenging rate (1/h) + ! lunerr = logical unit for error message + ! + use mo_constants, only: boltz_cgs, pi, rhowater => rhoh2o_cgs, rgas => rgas_cgs + + implicit none + + ! subr. parameters + integer, intent(in) :: lunerr + real(r8), intent(in) :: dg0, logsig, rhoaero, temp, press + real(r8), intent(out) :: scavratenum, scavratevol + + ! local variables + integer nrainsvmax + parameter (nrainsvmax=50) + real(r8) rrainsv(nrainsvmax), xnumrainsv(nrainsvmax),& + vfallrainsv(nrainsvmax) + + integer naerosvmax + parameter (naerosvmax=51) + real(r8) aaerosv(naerosvmax), & + ynumaerosv(naerosvmax), yvolaerosv(naerosvmax) + + integer i, ja, jr, na, nr + real(r8) a, aerodiffus, aeromass, ag0, airdynvisc, airkinvisc + real(r8) anumsum, avolsum, cair, chi + real(r8) d, dr, dum, dumfuchs, dx + real(r8) ebrown, eimpact, eintercept, etotal, freepath + real(r8) precip, precipmmhr, precipsum + real(r8) r, rainsweepout, reynolds, rhi, rhoair, rlo, rnumsum + real(r8) scavsumnum, scavsumnumbb + real(r8) scavsumvol, scavsumvolbb + real(r8) schmidt, sqrtreynolds, sstar, stokes, sx + real(r8) taurelax, vfall, vfallstp + real(r8) x, xg0, xg3, xhi, xlo, xmuwaterair + + rlo = .005_r8 + rhi = .250_r8 + dr = 0.005_r8 + nr = 1 + nint( (rhi-rlo)/dr ) + if (nr > nrainsvmax) then + write(lunerr,9110) + call endrun(subname//' : nr > nrainsvmax') + end if + +9110 format( '*** subr. calc_1_impact_rate -- nr > nrainsvmax' ) + + precipmmhr = 1.0_r8 + precip = precipmmhr/36000._r8 + + ag0 = dg0/2._r8 + sx = logsig + xg0 = log( ag0 ) + xg3 = xg0 + 3._r8*sx*sx + + xlo = xg3 - 4._r8*sx + xhi = xg3 + 4._r8*sx + dx = 0.2_r8*sx + + dx = max( 0.2_r8*sx, 0.01_r8 ) + xlo = xg3 - max( 4._r8*sx, 2._r8*dx ) + xhi = xg3 + max( 4._r8*sx, 2._r8*dx ) + + na = 1 + nint( (xhi-xlo)/dx ) + if (na > naerosvmax) then + write(lunerr,9120) + call endrun(subname//' : na > naerosvmax') + end if + +9120 format( '*** subr. calc_1_impact_rate -- na > naerosvmax' ) + + ! air molar density + cair = press/(rgas*temp) + ! air mass density + rhoair = 28.966_r8*cair + ! molecular freepath + freepath = 2.8052e-10_r8/cair + ! air dynamic viscosity + airdynvisc = 1.8325e-4_r8 * (416.16_r8/(temp+120._r8)) * & + ((temp/296.16_r8)**1.5_r8) + ! air kinemaic viscosity + airkinvisc = airdynvisc/rhoair + ! ratio of water viscosity to air viscosity (from Slinn) + xmuwaterair = 60.0_r8 + + ! + ! compute rain drop number concentrations + ! rrainsv = raindrop radius (cm) + ! xnumrainsv = raindrop number concentration (#/cm^3) + ! (number in the bin, not number density) + ! vfallrainsv = fall velocity (cm/s) + ! + precipsum = 0._r8 + do i = 1, nr + r = rlo + (i-1)*dr + rrainsv(i) = r + xnumrainsv(i) = exp( -r/2.7e-2_r8 ) + + d = 2._r8*r + if (d <= 0.007_r8) then + vfallstp = 2.88e5_r8 * d**2._r8 + else if (d <= 0.025_r8) then + vfallstp = 2.8008e4_r8 * d**1.528_r8 + else if (d <= 0.1_r8) then + vfallstp = 4104.9_r8 * d**1.008_r8 + else if (d <= 0.25_r8) then + vfallstp = 1812.1_r8 * d**0.638_r8 + else + vfallstp = 1069.8_r8 * d**0.235_r8 + end if + + vfall = vfallstp * sqrt(1.204e-3_r8/rhoair) + vfallrainsv(i) = vfall + precipsum = precipsum + vfall*(r**3)*xnumrainsv(i) + end do + precipsum = precipsum*pi*1.333333_r8 + + rnumsum = 0._r8 + do i = 1, nr + xnumrainsv(i) = xnumrainsv(i)*(precip/precipsum) + rnumsum = rnumsum + xnumrainsv(i) + end do + + ! + ! compute aerosol concentrations + ! aaerosv = particle radius (cm) + ! fnumaerosv = fraction of total number in the bin (--) + ! fvolaerosv = fraction of total volume in the bin (--) + ! + anumsum = 0._r8 + avolsum = 0._r8 + do i = 1, na + x = xlo + (i-1)*dx + a = exp( x ) + aaerosv(i) = a + dum = (x - xg0)/sx + ynumaerosv(i) = exp( -0.5_r8*dum*dum ) + yvolaerosv(i) = ynumaerosv(i)*1.3333_r8*pi*a*a*a + anumsum = anumsum + ynumaerosv(i) + avolsum = avolsum + yvolaerosv(i) + end do + + do i = 1, na + ynumaerosv(i) = ynumaerosv(i)/anumsum + yvolaerosv(i) = yvolaerosv(i)/avolsum + end do + + ! + ! compute scavenging + ! + scavsumnum = 0._r8 + scavsumvol = 0._r8 + ! + ! outer loop for rain drop radius + ! + jr_loop: do jr = 1, nr + + r = rrainsv(jr) + vfall = vfallrainsv(jr) + + reynolds = r * vfall / airkinvisc + sqrtreynolds = sqrt( reynolds ) + + ! + ! inner loop for aerosol particle radius + ! + scavsumnumbb = 0._r8 + scavsumvolbb = 0._r8 + + ja_loop: do ja = 1, na + + a = aaerosv(ja) + + chi = a/r + + dum = freepath/a + dumfuchs = 1._r8 + 1.246_r8*dum + 0.42_r8*dum*exp(-0.87_r8/dum) + taurelax = 2._r8*rhoaero*a*a*dumfuchs/(9._r8*rhoair*airkinvisc) + + aeromass = 4._r8*pi*a*a*a*rhoaero/3._r8 + aerodiffus = boltz_cgs*temp*taurelax/aeromass + + schmidt = airkinvisc/aerodiffus + stokes = vfall*taurelax/r + + ebrown = 4._r8*(1._r8 + 0.4_r8*sqrtreynolds*(schmidt**0.3333333_r8)) / & + (reynolds*schmidt) + + dum = (1._r8 + 2._r8*xmuwaterair*chi) / & + (1._r8 + xmuwaterair/sqrtreynolds) + eintercept = 4._r8*chi*(chi + dum) + + dum = log( 1._r8 + reynolds ) + sstar = (1.2_r8 + dum/12._r8) / (1._r8 + dum) + eimpact = 0._r8 + if (stokes > sstar) then + dum = stokes - sstar + eimpact = (dum/(dum+0.6666667_r8)) ** 1.5_r8 + end if + + etotal = ebrown + eintercept + eimpact + etotal = min( etotal, 1.0_r8 ) + + rainsweepout = xnumrainsv(jr)*4._r8*pi*r*r*vfall + + scavsumnumbb = scavsumnumbb + rainsweepout*etotal*ynumaerosv(ja) + scavsumvolbb = scavsumvolbb + rainsweepout*etotal*yvolaerosv(ja) + + enddo ja_loop + + scavsumnum = scavsumnum + scavsumnumbb + scavsumvol = scavsumvol + scavsumvolbb + + enddo jr_loop + + scavratenum = scavsumnum*3600._r8 + scavratevol = scavsumvol*3600._r8 + + end subroutine calc_1_impact_rate + + end subroutine init_bcscavcoef + +end module aero_wetdep_cam diff --git a/src/chemistry/aerosol/aerosol_properties_mod.F90 b/src/chemistry/aerosol/aerosol_properties_mod.F90 index c94f277637..e7cea68ad4 100644 --- a/src/chemistry/aerosol/aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/aerosol_properties_mod.F90 @@ -70,6 +70,8 @@ module aerosol_properties_mod procedure(aero_min_mass_mean_rad), deferred :: min_mass_mean_rad procedure(aero_optics_params), deferred :: optics_params procedure(aero_bin_name), deferred :: bin_name + procedure(aero_scav_diam), deferred :: scav_diam + procedure(aero_resuspension_resize), deferred :: resuspension_resize procedure(aero_rebin_bulk_fluxes), deferred :: rebin_bulk_fluxes procedure(aero_hydrophilic), deferred :: hydrophilic @@ -382,6 +384,30 @@ function aero_bin_name(self, list_ndx, bin_ndx) result(name) end function aero_bin_name + !------------------------------------------------------------------------------ + ! returns scavenging diameter for a given aerosol bin number + !------------------------------------------------------------------------------ + function aero_scav_diam(self, bin_ndx) result(diam) + import :: aerosol_properties, r8 + class(aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + + real(r8) :: diam + + end function aero_scav_diam + + !------------------------------------------------------------------------------ + ! adjust aerosol concentration tendencies to create larger sizes of aerosols + ! during resuspension + !------------------------------------------------------------------------------ + subroutine aero_resuspension_resize(self, dcondt) + import :: aerosol_properties, r8 + + class(aerosol_properties), intent(in) :: self + real(r8), intent(inout) :: dcondt(:) + + end subroutine aero_resuspension_resize + !------------------------------------------------------------------------------ ! returns bulk deposition fluxes of the specified species type ! rebinned to specified diameter limits diff --git a/src/chemistry/aerosol/aerosol_state_mod.F90 b/src/chemistry/aerosol/aerosol_state_mod.F90 index b0e8d24a1e..363ce7ac99 100644 --- a/src/chemistry/aerosol/aerosol_state_mod.F90 +++ b/src/chemistry/aerosol/aerosol_state_mod.F90 @@ -56,6 +56,9 @@ module aerosol_state_mod procedure(aero_volume), deferred :: dry_volume procedure(aero_volume), deferred :: wet_volume procedure(aero_volume), deferred :: water_volume + procedure(aero_wet_diam), deferred :: wet_diameter + procedure :: convcld_actfrac + procedure :: sol_factb_interstitial end type aerosol_state ! for state fields @@ -264,6 +267,21 @@ function aero_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vol end function aero_volume + !------------------------------------------------------------------------------ + ! aerosol wet diameter + !------------------------------------------------------------------------------ + function aero_wet_diam(self, bin_idx, ncol, nlev) result(diam) + import :: aerosol_state, r8 + + class(aerosol_state), intent(in) :: self + integer, intent(in) :: bin_idx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + + real(r8) :: diam(ncol,nlev) + + end function aero_wet_diam + end interface contains @@ -272,7 +290,7 @@ end function aero_volume ! returns aerosol number, volume concentrations, and bulk hygroscopicity !------------------------------------------------------------------------------ subroutine loadaer( self, aero_props, istart, istop, k, m, cs, phase, & - naerosol, vaerosol, hygro, errnum, errstr) + naerosol, vaerosol, hygro, errnum, errstr, pom_hygro) use aerosol_properties_mod, only: aerosol_properties @@ -295,10 +313,13 @@ subroutine loadaer( self, aero_props, istart, istop, k, m, cs, phase, & integer , intent(out) :: errnum character(len=*), intent(out) :: errstr + real(r8), optional, intent(in) :: pom_hygro ! POM hygroscopicity override + ! internal real(r8), pointer :: raer(:,:) ! interstitial aerosol mass, number mixing ratios real(r8), pointer :: qqcw(:,:) ! cloud-borne aerosol mass, number mixing ratios real(r8) :: specdens, spechygro + character(len=aero_name_len) :: spectype real(r8) :: vol(istart:istop) ! aerosol volume mixing ratio integer :: i, l @@ -314,7 +335,12 @@ subroutine loadaer( self, aero_props, istart, istop, k, m, cs, phase, & call self%get_ambient_mmr(l,m, raer) call self%get_cldbrne_mmr(l,m, qqcw) - call aero_props%get(m,l, density=specdens, hygro=spechygro) + call aero_props%get(m,l, density=specdens, hygro=spechygro, spectype=spectype) + if (present(pom_hygro)) then + if (spectype=='p-organic'.and.pom_hygro>0._r8) then + spechygro=pom_hygro + endif + endif if (phase == 3) then do i = istart, istop @@ -855,4 +881,84 @@ function refractive_index_lw(self, ncol, ilev, ilist, ibin, iwav, aero_props) re end function refractive_index_lw + !------------------------------------------------------------------------------ + ! prescribed aerosol activation fraction for convective cloud + !------------------------------------------------------------------------------ + function convcld_actfrac(self, ibin, ispc, ncol, nlev) result(frac) + + class(aerosol_state), intent(in) :: self + integer, intent(in) :: ibin ! bin index + integer, intent(in) :: ispc ! species index + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + + real(r8) :: frac(ncol,nlev) + + frac = 0.8_r8 ! rce 2010/05/02 + + end function convcld_actfrac + + !------------------------------------------------------------------------------ + ! below cloud solubility factor for interstitial aerosols + !------------------------------------------------------------------------------ + function sol_factb_interstitial(self, bin_ndx, ncol, nlev, aero_props) result(sol_factb) + + class(aerosol_state), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + class(aerosol_properties), intent(in) :: aero_props ! aerosol properties object + + real(r8) :: sol_factb(ncol,nlev) + + real(r8), pointer :: aer_mmr(:,:) + real(r8) :: totmmr(ncol,nlev) + real(r8) :: solmmr(ncol,nlev) + integer :: ispc + character(len=aero_name_len) :: spectype + + sol_factb(:,:) = 0.0_r8 + + totmmr(:,:) = 0._r8 + solmmr(:,:) = 0._r8 + + do ispc = 1, aero_props%nspecies(bin_ndx) + + call aero_props%species_type(bin_ndx, ispc, spectype) + call self%get_ambient_mmr(ispc, bin_ndx, aer_mmr) + + totmmr(:ncol,:) = totmmr(:ncol,:) + aer_mmr(:ncol,:) + + if (trim(spectype) == 'sulfate') then + solmmr(:ncol,:) = solmmr(:ncol,:) + aer_mmr(:ncol,:)*0.5_r8 + end if + if (trim(spectype) == 'p-organic') then + solmmr(:ncol,:) = solmmr(:ncol,:) + aer_mmr(:ncol,:)*0.2_r8 + end if + if (trim(spectype) == 's-organic') then + solmmr(:ncol,:) = solmmr(:ncol,:) + aer_mmr(:ncol,:)*0.2_r8 + end if + if (trim(spectype) == 'dust') then + solmmr(:ncol,:) = solmmr(:ncol,:) + aer_mmr(:ncol,:)*0.1_r8 + end if + if (trim(spectype) == 'seasalt') then + solmmr(:ncol,:) = solmmr(:ncol,:) + aer_mmr(:ncol,:)*0.8_r8 + end if + + end do !nspec + + where ( totmmr > 0._r8 ) + sol_factb = solmmr/totmmr + end where + + where ( sol_factb > 0.8_r8 ) + sol_factb = 0.8_r8 + end where + where ( sol_factb < 0.1_r8 ) + sol_factb = 0.1_r8 + end where + + end function sol_factb_interstitial + + end module aerosol_state_mod diff --git a/src/chemistry/modal_aero/modal_aero_data.F90 b/src/chemistry/aerosol/modal_aero_data.F90 similarity index 100% rename from src/chemistry/modal_aero/modal_aero_data.F90 rename to src/chemistry/aerosol/modal_aero_data.F90 diff --git a/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 b/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 index 54f64fa759..828b54ed99 100644 --- a/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 +++ b/src/chemistry/aerosol/modal_aerosol_properties_mod.F90 @@ -15,6 +15,18 @@ module modal_aerosol_properties_mod real(r8), allocatable :: exp45logsig_(:) real(r8), allocatable :: voltonumblo_(:) real(r8), allocatable :: voltonumbhi_(:) + integer, allocatable :: sulfate_mode_ndxs_(:) + integer, allocatable :: dust_mode_ndxs_(:) + integer, allocatable :: ssalt_mode_ndxs_(:) + integer, allocatable :: ammon_mode_ndxs_(:) + integer, allocatable :: nitrate_mode_ndxs_(:) + integer, allocatable :: msa_mode_ndxs_(:) + integer, allocatable :: bcarbon_mode_ndxs_(:,:) + integer, allocatable :: porganic_mode_ndxs_(:,:) + integer, allocatable :: sorganic_mode_ndxs_(:,:) + integer :: num_soa_ = 0 + integer :: num_poa_ = 0 + integer :: num_bc_ = 0 contains procedure :: number_transported procedure :: get @@ -36,6 +48,8 @@ module modal_aerosol_properties_mod procedure :: soluble procedure :: min_mass_mean_rad procedure :: bin_name + procedure :: scav_diam + procedure :: resuspension_resize procedure :: rebin_bulk_fluxes procedure :: hydrophilic @@ -56,7 +70,7 @@ function constructor() result(newobj) type(modal_aerosol_properties), pointer :: newobj - integer :: m, nmodes, ncnst_tot + integer :: l, m, nmodes, ncnst_tot, mm real(r8) :: dgnumlo real(r8) :: dgnumhi integer,allocatable :: nspecies(:) @@ -66,6 +80,10 @@ function constructor() result(newobj) real(r8),allocatable :: f2(:) integer :: ierr + character(len=aero_name_len) :: spectype + + integer :: npoa, nsoa, nbc + allocate(newobj,stat=ierr) if( ierr /= 0 ) then nullify(newobj) @@ -141,6 +159,123 @@ function constructor() result(newobj) end do call newobj%initialize(nmodes,ncnst_tot,nspecies,nspecies,alogsig,f1,f2,ierr) + + npoa = 0 + nsoa = 0 + nbc = 0 + + m = 1 + do l = 1,newobj%nspecies(m) + mm = newobj%indexer(m,l) + call newobj%species_type(m, l, spectype) + select case ( trim(spectype) ) + case('p-organic') + npoa = npoa + 1 + case('s-organic') + nsoa = nsoa + 1 + case('black-c') + nbc = nbc + 1 + end select + end do + + newobj%num_soa_ = nsoa + newobj%num_poa_ = npoa + newobj%num_bc_ = nbc + + allocate(newobj%sulfate_mode_ndxs_(newobj%nbins()),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(newobj%dust_mode_ndxs_(newobj%nbins()),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(newobj%ssalt_mode_ndxs_(newobj%nbins()),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(newobj%ammon_mode_ndxs_(newobj%nbins()),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(newobj%nitrate_mode_ndxs_(newobj%nbins()),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(newobj%msa_mode_ndxs_(newobj%nbins()),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + + newobj%sulfate_mode_ndxs_ = 0 + newobj%dust_mode_ndxs_ = 0 + newobj%ssalt_mode_ndxs_ = 0 + newobj%ammon_mode_ndxs_ = 0 + newobj%nitrate_mode_ndxs_ = 0 + newobj%msa_mode_ndxs_ = 0 + + allocate(newobj%porganic_mode_ndxs_(newobj%nbins(),npoa),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(newobj%sorganic_mode_ndxs_(newobj%nbins(),nsoa),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + allocate(newobj%bcarbon_mode_ndxs_(newobj%nbins(),nbc),stat=ierr) + if( ierr /= 0 ) then + nullify(newobj) + return + end if + + newobj%porganic_mode_ndxs_ = 0._r8 + newobj%sorganic_mode_ndxs_ = 0._r8 + newobj%bcarbon_mode_ndxs_ = 0._r8 + + do m = 1,newobj%nbins() + npoa = 0 + nsoa = 0 + nbc = 0 + + do l = 1,newobj%nspecies(m) + mm = newobj%indexer(m,l) + call newobj%species_type(m, l, spectype) + + select case ( trim(spectype) ) + case('sulfate') + newobj%sulfate_mode_ndxs_(m) = mm + case('dust') + newobj%dust_mode_ndxs_(m) = mm + case('nitrate') + newobj%nitrate_mode_ndxs_(m) = mm + case('ammonium') + newobj%ammon_mode_ndxs_(m) = mm + case('seasalt') + newobj%ssalt_mode_ndxs_(m) = mm + case('msa') + newobj%msa_mode_ndxs_(m) = mm + case('p-organic') + npoa = npoa + 1 + newobj%porganic_mode_ndxs_(m,npoa) = mm + case('s-organic') + nsoa = nsoa + 1 + newobj%sorganic_mode_ndxs_(m,nsoa) = mm + case('black-c') + nbc = nbc + 1 + newobj%bcarbon_mode_ndxs_(m,nbc) = mm + end select + + end do + end do + if( ierr /= 0 ) then nullify(newobj) return @@ -168,6 +303,34 @@ subroutine destructor(self) deallocate(self%voltonumbhi_) end if + if (allocated(self%sulfate_mode_ndxs_)) then + deallocate(self%sulfate_mode_ndxs_) + end if + if (allocated(self%dust_mode_ndxs_)) then + deallocate(self%dust_mode_ndxs_) + end if + if (allocated(self%ssalt_mode_ndxs_)) then + deallocate(self%ssalt_mode_ndxs_) + end if + if (allocated(self%ammon_mode_ndxs_)) then + deallocate(self%ammon_mode_ndxs_) + end if + if (allocated(self%nitrate_mode_ndxs_)) then + deallocate(self%nitrate_mode_ndxs_) + end if + if (allocated(self%msa_mode_ndxs_)) then + deallocate(self%msa_mode_ndxs_) + end if + if (allocated(self%porganic_mode_ndxs_)) then + deallocate(self%porganic_mode_ndxs_) + end if + if (allocated(self%sorganic_mode_ndxs_)) then + deallocate(self%sorganic_mode_ndxs_) + end if + if (allocated(self%bcarbon_mode_ndxs_)) then + deallocate(self%bcarbon_mode_ndxs_) + end if + call self%final() end subroutine destructor @@ -675,6 +838,99 @@ function bin_name(self, list_ndx, bin_ndx) result(name) end function bin_name + !------------------------------------------------------------------------------ + ! returns scavenging diameter (cm) for a given aerosol bin number + !------------------------------------------------------------------------------ + function scav_diam(self, bin_ndx) result(diam) + use modal_aero_data, only: dgnum_amode + + class(modal_aerosol_properties), intent(in) :: self + integer, intent(in) :: bin_ndx ! bin number + + real(r8) :: diam + + diam = dgnum_amode(bin_ndx) + + end function scav_diam + + !------------------------------------------------------------------------------ + ! adjust aerosol concentration tendencies to create larger sizes of aerosols + ! during resuspension + !------------------------------------------------------------------------------ + subroutine resuspension_resize(self, dcondt) + + use modal_aero_data, only: mode_size_order + + class(modal_aerosol_properties), intent(in) :: self + real(r8), intent(inout) :: dcondt(:) + + integer :: i + character(len=4) :: spcstr + + call accumulate_to_larger_mode( 'SO4', self%sulfate_mode_ndxs_, dcondt ) + call accumulate_to_larger_mode( 'DUST',self%dust_mode_ndxs_,dcondt ) + call accumulate_to_larger_mode( 'NACL',self%ssalt_mode_ndxs_,dcondt ) + call accumulate_to_larger_mode( 'MSA', self%msa_mode_ndxs_, dcondt ) + call accumulate_to_larger_mode( 'NH4', self%ammon_mode_ndxs_, dcondt ) + call accumulate_to_larger_mode( 'NO3', self%nitrate_mode_ndxs_, dcondt ) + + spcstr = ' ' + do i = 1,self%num_soa_ + write(spcstr,'(i4)') i + call accumulate_to_larger_mode( 'SOA'//adjustl(spcstr), self%sorganic_mode_ndxs_(:,i), dcondt ) + enddo + spcstr = ' ' + do i = 1,self%num_poa_ + write(spcstr,'(i4)') i + call accumulate_to_larger_mode( 'POM'//adjustl(spcstr), self%porganic_mode_ndxs_(:,i), dcondt ) + enddo + spcstr = ' ' + do i = 1,self%num_bc_ + write(spcstr,'(i4)') i + call accumulate_to_larger_mode( 'BC'//adjustl(spcstr), self%bcarbon_mode_ndxs_(:,i), dcondt ) + enddo + + contains + + !------------------------------------------------------------------------------ + subroutine accumulate_to_larger_mode( spc_name, lptr, prevap ) + + use cam_logfile, only: iulog + use spmd_utils, only: masterproc + + character(len=*), intent(in) :: spc_name + integer, intent(in) :: lptr(:) + real(r8), intent(inout) :: prevap(:) + + integer :: m,n, nl,ns + + logical, parameter :: debug = .false. + + ! find constituent index of the largest mode for the species + loop1: do m = 1,self%nbins()-1 + nl = lptr(mode_size_order(m)) + if (nl>0) exit loop1 + end do loop1 + + if (.not. nl>0) return + + ! accumulate the smaller modes into the largest mode + do n = m+1,self%nbins() + ns = lptr(mode_size_order(n)) + if (ns>0) then + prevap(nl) = prevap(nl) + prevap(ns) + prevap(ns) = 0._r8 + if (masterproc .and. debug) then + write(iulog,'(a,i3,a,i3)') trim(spc_name)//' mode number accumulate ',ns,'->',nl + endif + endif + end do + + end subroutine accumulate_to_larger_mode + !------------------------------------------------------------------------------ + + end subroutine resuspension_resize + !------------------------------------------------------------------------------ ! returns bulk deposition fluxes of the specified species type ! rebinned to specified diameter limits diff --git a/src/chemistry/aerosol/modal_aerosol_state_mod.F90 b/src/chemistry/aerosol/modal_aerosol_state_mod.F90 index 8f50e5b7e9..819f20d1f0 100644 --- a/src/chemistry/aerosol/modal_aerosol_state_mod.F90 +++ b/src/chemistry/aerosol/modal_aerosol_state_mod.F90 @@ -40,6 +40,8 @@ module modal_aerosol_state_mod procedure :: dry_volume procedure :: wet_volume procedure :: water_volume + procedure :: wet_diameter + procedure :: convcld_actfrac final :: destructor @@ -595,4 +597,91 @@ function water_volume(self, aero_props, list_idx, bin_idx, ncol, nlev) result(vo end function water_volume + !------------------------------------------------------------------------------ + ! aerosol wet diameter + !------------------------------------------------------------------------------ + function wet_diameter(self, bin_idx, ncol, nlev) result(diam) + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: bin_idx ! bin number + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of levels + + real(r8) :: diam(ncol,nlev) + + real(r8), pointer :: dgnumwet(:,:,:) + + call pbuf_get_field(self%pbuf, pbuf_get_index('DGNUMWET'), dgnumwet) + + diam(:ncol,:nlev) = dgnumwet(:ncol,:nlev,bin_idx) + + end function wet_diameter + + !------------------------------------------------------------------------------ + ! prescribed aerosol activation fraction for convective cloud + !------------------------------------------------------------------------------ + function convcld_actfrac(self, ibin, ispc, ncol, nlev) result(frac) + + use modal_aero_data + + class(modal_aerosol_state), intent(in) :: self + integer, intent(in) :: ibin ! bin index + integer, intent(in) :: ispc ! species index + integer, intent(in) :: ncol ! number of columns + integer, intent(in) :: nlev ! number of vertical levels + + real(r8) :: frac(ncol,nlev) + + real(r8) :: f_act_conv_coarse(ncol,nlev) + real(r8) :: f_act_conv_coarse_dust, f_act_conv_coarse_nacl + real(r8) :: tmpdust, tmpnacl + integer :: lcoardust, lcoarnacl + integer :: i,k + + f_act_conv_coarse(:,:) = 0.60_r8 + f_act_conv_coarse_dust = 0.40_r8 + f_act_conv_coarse_nacl = 0.80_r8 + if (modeptr_coarse > 0) then + lcoardust = lptr_dust_a_amode(modeptr_coarse) + lcoarnacl = lptr_nacl_a_amode(modeptr_coarse) + if ((lcoardust > 0) .and. (lcoarnacl > 0)) then + do k = 1, nlev + do i = 1, ncol + tmpdust = max( 0.0_r8, self%state%q(i,k,lcoardust) ) + tmpnacl = max( 0.0_r8, self%state%q(i,k,lcoarnacl) ) + if ((tmpdust+tmpnacl) > 1.0e-30_r8) then + f_act_conv_coarse(i,k) = (f_act_conv_coarse_dust*tmpdust & + + f_act_conv_coarse_nacl*tmpnacl)/(tmpdust+tmpnacl) + end if + end do + end do + end if + end if + + if (ibin == modeptr_pcarbon) then + frac = 0.0_r8 + else if ((ibin == modeptr_finedust) .or. (ibin == modeptr_coardust)) then + frac = 0.4_r8 + else + frac = 0.8_r8 + end if + + ! set f_act_conv for interstitial (lphase=1) coarse mode species + ! for the convective in-cloud, we conceptually treat the coarse dust and seasalt + ! as being externally mixed, and apply f_act_conv = f_act_conv_coarse_dust/nacl to dust/seasalt + ! number and sulfate are conceptually partitioned to the dust and seasalt + ! on a mass basis, so the f_act_conv for number and sulfate are + ! mass-weighted averages of the values used for dust/seasalt + if (ibin == modeptr_coarse) then + frac = f_act_conv_coarse + if (ispc>0) then + if (lmassptr_amode(ispc,ibin) == lptr_dust_a_amode(ibin)) then + frac = f_act_conv_coarse_dust + else if (lmassptr_amode(ispc,ibin) == lptr_nacl_a_amode(ibin)) then + frac = f_act_conv_coarse_nacl + end if + end if + end if + + end function convcld_actfrac + end module modal_aerosol_state_mod diff --git a/src/chemistry/aerosol/wetdep.F90 b/src/chemistry/aerosol/wetdep.F90 index 810e063e1a..b63ebec338 100644 --- a/src/chemistry/aerosol/wetdep.F90 +++ b/src/chemistry/aerosol/wetdep.F90 @@ -330,7 +330,7 @@ subroutine wetdepa_v2( & ! sol_fact is used for below cloud scavenging ! sol_facti is used for in cloud scavenging - real(r8), intent(in) :: sol_fact + real(r8), intent(in) :: sol_fact(pcols,pver) integer, intent(in) :: ncol real(r8), intent(in) :: scavcoef(pcols,pver) ! Dana and Hales coefficient (/mm) (0.1 if not MODAL_AERO) real(r8), intent(out) ::& @@ -348,7 +348,7 @@ subroutine wetdepa_v2( & real(r8), intent(in), optional :: qqcw(pcols,pver) real(r8), intent(in), optional :: f_act_conv(pcols,pver) - real(r8), intent(in), optional :: sol_facti_in ! solubility factor (frac of aerosol scavenged in cloud) + real(r8), intent(in), optional :: sol_facti_in(pcols,pver) ! solubility factor (frac of aerosol scavenged in cloud) real(r8), intent(in), optional :: sol_factic_in(pcols,pver) ! sol_facti_in for convective clouds @@ -405,8 +405,8 @@ subroutine wetdepa_v2( & ! For convective cloud, cloudborne aerosol is not treated explicitly, ! and sol_factic is 1.0 for both cloudborne and interstitial. - real(r8) :: sol_facti ! in cloud fraction of aerosol scavenged - real(r8) :: sol_factb ! below cloud fraction of aerosol scavenged + real(r8) :: sol_facti(pcols,pver) ! in cloud fraction of aerosol scavenged + real(r8) :: sol_factb(pcols,pver) ! below cloud fraction of aerosol scavenged real(r8) :: sol_factic(pcols,pver) ! in cloud fraction of aerosol scavenged for convective clouds real(r8) :: rdeltat @@ -527,7 +527,7 @@ subroutine wetdepa_v2( & fracp(i) = max( 0._r8, min(1._r8, fracp(i)) ) - st_scav_ic(i) = sol_facti *fracp(i)*tracer(i,k)*rdeltat + st_scav_ic(i) = sol_facti(i,k) *fracp(i)*tracer(i,k)*rdeltat st_scav_bc(i) = 0._r8 @@ -548,7 +548,7 @@ subroutine wetdepa_v2( & odds(i) = precabc(i)/max(cldvcu(i,k),1.e-5_r8)*scavcoef(i,k)*deltat odds(i) = max(min(1._r8,odds(i)),0._r8) - conv_scav_bc(i) = sol_factb *cldvcu(i,k)*odds(i)*tracer_mean(i)*rdeltat + conv_scav_bc(i) = sol_factb(i,k) *cldvcu(i,k)*odds(i)*tracer_mean(i)*rdeltat ! stratiform scavenging @@ -557,7 +557,7 @@ subroutine wetdepa_v2( & odds(i) = precabs(i)/max(cldvst(i,k),1.e-5_r8)*scavcoef(i,k)*deltat odds(i) = max(min(1._r8,odds(i)),0._r8) - st_scav_bc(i) = sol_factb *cldvst(i,k)*odds(i)*tracer_mean(i)*rdeltat + st_scav_bc(i) = sol_factb(i,k) *cldvst(i,k)*odds(i)*tracer_mean(i)*rdeltat end if @@ -569,7 +569,7 @@ subroutine wetdepa_v2( & odds(i) = precabc(i)/max(cldvcu(i,k), 1.e-5_r8)*scavcoef(i,k)*deltat odds(i) = max( min(1._r8, odds(i)), 0._r8) - conv_scav_bc(i) = sol_factb*cldvcu(i,k)*odds(i)*tracer(i,k)*rdeltat + conv_scav_bc(i) = sol_factb(i,k)*cldvcu(i,k)*odds(i)*tracer(i,k)*rdeltat ! stratiform scavenging @@ -581,11 +581,11 @@ subroutine wetdepa_v2( & fracp(i) = max( 0._r8, min( 1._r8, fracp(i) ) ) ! assume the corresponding amnt of tracer is removed - st_scav_ic(i) = sol_facti*clds(i)*fracp(i)*tracer(i,k)*rdeltat + st_scav_ic(i) = sol_facti(i,k)*clds(i)*fracp(i)*tracer(i,k)*rdeltat odds(i) = precabs(i)/max(cldvst(i,k),1.e-5_r8)*scavcoef(i,k)*deltat odds(i) = max(min(1._r8,odds(i)),0._r8) - st_scav_bc(i) =sol_factb*(cldvst(i,k)*odds(i)) *tracer(i,k)*rdeltat + st_scav_bc(i) =sol_factb(i,k)*(cldvst(i,k)*odds(i)) *tracer(i,k)*rdeltat end if diff --git a/src/chemistry/bulk_aero/dust_model.F90 b/src/chemistry/bulk_aero/dust_model.F90 index 1a0ff4c5aa..6b559200c6 100644 --- a/src/chemistry/bulk_aero/dust_model.F90 +++ b/src/chemistry/bulk_aero/dust_model.F90 @@ -1,10 +1,12 @@ !=============================================================================== ! Dust for Bulk Aerosol Model !=============================================================================== -module dust_model +module dust_model use shr_kind_mod, only: r8 => shr_kind_r8, cl => shr_kind_cl use spmd_utils, only: masterproc use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use shr_dust_emis_mod,only: is_dust_emis_zender, is_zender_soil_erod_from_atm implicit none private @@ -34,8 +36,9 @@ module dust_model real(r8) :: dust_dmt_vwr(dust_nbin) real(r8) :: dust_stk_crc(dust_nbin) - real(r8) :: dust_emis_fact = -1.e36_r8 ! tuning parameter for dust emissions - character(len=cl) :: soil_erod_file = 'soil_erod_file' ! full pathname for soil erodibility dataset + real(r8) :: dust_emis_fact = -1.e36_r8 ! tuning parameter for dust emissions + character(len=cl) :: soil_erod_file = 'none' ! full pathname for soil erodibility dataset + contains !============================================================================= @@ -44,8 +47,8 @@ module dust_model subroutine dust_readnl(nlfile) use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use mpishorthand + use spmd_utils, only: mpicom, masterprocid, mpi_character, mpi_real8, mpi_success + use shr_dust_emis_mod, only: shr_dust_emis_readnl character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input @@ -59,8 +62,7 @@ subroutine dust_readnl(nlfile) ! Read namelist if (masterproc) then - unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) + open( newunit=unitn, file=trim(nlfile), status='old' ) call find_group_name(unitn, 'dust_nl', status=ierr) if (ierr == 0) then read(unitn, dust_nl, iostat=ierr) @@ -69,14 +71,34 @@ subroutine dust_readnl(nlfile) end if end if close(unitn) - call freeunit(unitn) end if -#ifdef SPMD ! Broadcast namelist variables - call mpibcast(dust_emis_fact, 1, mpir8, 0, mpicom) - call mpibcast(soil_erod_file, len(soil_erod_file), mpichar, 0, mpicom) -#endif + call mpi_bcast(soil_erod_file, len(soil_erod_file), mpi_character, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) then + call endrun(subname//' MPI_BCAST ERROR: soil_erod_file') + end if + call mpi_bcast(dust_emis_fact, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) then + call endrun(subname//' MPI_BCAST ERROR: dust_emis_fact') + end if + + call shr_dust_emis_readnl(mpicom, 'drv_flds_in') + + if ((soil_erod_file /= 'none') .and. (.not.is_zender_soil_erod_from_atm())) then + call endrun(subname//': should not specify soil_erod_file if Zender soil erosion is not in CAM') + end if + + if (masterproc) then + if (is_dust_emis_zender()) then + write(iulog,*) subname,': Zender_2003 dust emission method is being used.' + end if + if (is_zender_soil_erod_from_atm()) then + write(iulog,*) subname,': Zender soil erod file is handled in atm' + write(iulog,*) subname,': soil_erod_file = ',trim(soil_erod_file) + write(iulog,*) subname,': dust_emis_fact = ',dust_emis_fact + end if + end if end subroutine dust_readnl @@ -95,7 +117,9 @@ subroutine dust_init() dust_active = any(dust_indices(:) > 0) if (.not.dust_active) return - call soil_erod_init( dust_emis_fact, soil_erod_file ) + if (is_zender_soil_erod_from_atm()) then + call soil_erod_init( dust_emis_fact, soil_erod_file ) + endif call dust_set_params( dust_nbin, dust_dmt_grd, dust_dmt_vwr, dust_stk_crc ) @@ -106,6 +130,7 @@ end subroutine dust_init subroutine dust_emis( ncol, lchnk, dust_flux_in, cflx, soil_erod ) use soil_erod_mod, only : soil_erod_fact use soil_erod_mod, only : soil_erodibility + use cam_history_support, only : fillvalue ! args integer, intent(in) :: ncol, lchnk @@ -115,25 +140,44 @@ subroutine dust_emis( ncol, lchnk, dust_flux_in, cflx, soil_erod ) ! local vars integer :: i, m, idst + real(r8) :: erodfctr(ncol) real(r8), parameter :: dust_emis_sclfctr(dust_nbin) & = (/ 0.011_r8/0.032456_r8, 0.087_r8/0.174216_r8, 0.277_r8/0.4085517_r8, 0.625_r8/0.384811_r8 /) ! set dust emissions - col_loop: do i =1,ncol + if (is_zender_soil_erod_from_atm()) then + + col_loop1: do i =1,ncol + + soil_erod(i) = soil_erodibility( i, lchnk ) + + ! adjust emissions + do m = 1,dust_nbin + + idst = dust_indices(m) + cflx(i,idst) = -dust_flux_in(i,m) & + * dust_emis_sclfctr(m)*soil_erod(i)/dust_emis_fact*1.15_r8 - soil_erod(i) = soil_erodibility( i, lchnk ) + enddo - ! adjust emissions based on soil erosion - do m = 1,dust_nbin + end do col_loop1 - idst = dust_indices(m) - cflx(i,idst) = -dust_flux_in(i,m) & - * dust_emis_sclfctr(m)*soil_erod(i)/soil_erod_fact*1.15_r8 + else - enddo + col_loop2: do i =1,ncol - end do col_loop + ! adjust emissions + do m = 1,dust_nbin + + idst = dust_indices(m) + cflx(i,idst) = -dust_flux_in(i,m) * dust_emis_sclfctr(m) / dust_emis_fact + + enddo + + end do col_loop2 + + end if end subroutine dust_emis diff --git a/src/chemistry/modal_aero/aero_model.F90 b/src/chemistry/modal_aero/aero_model.F90 index 86236a0650..056b998a36 100644 --- a/src/chemistry/modal_aero/aero_model.F90 +++ b/src/chemistry/modal_aero/aero_model.F90 @@ -46,10 +46,9 @@ module aero_model public :: calc_1_impact_rate public :: nimptblgrow_mind, nimptblgrow_maxd - public :: wetdep_lq ! Accessor functions - public :: get_scavimptblvol, get_scavimptblnum, get_dlndg_nimptblgrow + public :: get_scavimptblvol, get_scavimptblnum, get_dlndg_nimptblgrow ! Misc private data @@ -90,25 +89,16 @@ module aero_model character(len=fieldname_len), allocatable :: dgnum_name(:), dgnumwet_name(:) ! Namelist variables - character(len=16) :: wetdep_list(pcnst) = ' ' character(len=16) :: drydep_list(pcnst) = ' ' - real(r8) :: sol_facti_cloud_borne = 1._r8 - real(r8) :: sol_factb_interstitial = 0.1_r8 - real(r8) :: sol_factic_interstitial = 0.4_r8 real(r8) :: seasalt_emis_scale integer :: ndrydep = 0 integer,allocatable :: drydep_indices(:) - integer :: nwetdep = 0 - integer,allocatable :: wetdep_indices(:) logical :: drydep_lq(pcnst) - logical, protected :: wetdep_lq(pcnst) logical :: modal_accum_coarse_exch = .false. - logical :: convproc_do_aer - - class(modal_aerosol_properties), pointer :: aero_props=>null() + type(modal_aerosol_properties), pointer :: aero_props=>null() contains @@ -120,7 +110,7 @@ subroutine aero_model_readnl(nlfile) use namelist_utils, only: find_group_name use units, only: getunit, freeunit use mpishorthand - use modal_aero_convproc, only: ma_convproc_readnl + use aero_wetdep_cam, only: aero_wetdep_readnl character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input @@ -129,11 +119,9 @@ subroutine aero_model_readnl(nlfile) character(len=*), parameter :: subname = 'aero_model_readnl' ! Namelist variables - character(len=16) :: aer_wetdep_list(pcnst) = ' ' character(len=16) :: aer_drydep_list(pcnst) = ' ' - namelist /aerosol_nl/ aer_wetdep_list, aer_drydep_list, sol_facti_cloud_borne, & - sol_factb_interstitial, sol_factic_interstitial, modal_strat_sulfate, modal_accum_coarse_exch, seasalt_emis_scale + namelist /aerosol_nl/ aer_drydep_list, modal_strat_sulfate, modal_accum_coarse_exch, seasalt_emis_scale !----------------------------------------------------------------------------- @@ -154,20 +142,15 @@ subroutine aero_model_readnl(nlfile) #ifdef SPMD ! Broadcast namelist variables - call mpibcast(aer_wetdep_list, len(aer_wetdep_list(1))*pcnst, mpichar, 0, mpicom) call mpibcast(aer_drydep_list, len(aer_drydep_list(1))*pcnst, mpichar, 0, mpicom) - call mpibcast(sol_facti_cloud_borne, 1, mpir8, 0, mpicom) - call mpibcast(sol_factb_interstitial, 1, mpir8, 0, mpicom) - call mpibcast(sol_factic_interstitial, 1, mpir8, 0, mpicom) call mpibcast(modal_strat_sulfate, 1, mpilog, 0, mpicom) call mpibcast(seasalt_emis_scale, 1, mpir8, 0, mpicom) call mpibcast(modal_accum_coarse_exch, 1, mpilog, 0, mpicom) #endif - wetdep_list = aer_wetdep_list drydep_list = aer_drydep_list - call ma_convproc_readnl(nlfile) + call aero_wetdep_readnl(nlfile) end subroutine aero_model_readnl @@ -193,7 +176,7 @@ subroutine aero_model_init( pbuf2d ) use dust_model, only: dust_init, dust_names, dust_active, dust_nbin, dust_nnum use seasalt_model, only: seasalt_init, seasalt_names, seasalt_active,seasalt_nbin use aer_drydep_mod, only: inidrydep - use wetdep, only: wetdep_init + use aero_wetdep_cam, only: aero_wetdep_init use modal_aero_calcsize, only: modal_aero_calcsize_init use modal_aero_coag, only: modal_aero_coag_init @@ -201,7 +184,6 @@ subroutine aero_model_init( pbuf2d ) use modal_aero_gasaerexch, only: modal_aero_gasaerexch_init use modal_aero_newnuc, only: modal_aero_newnuc_init use modal_aero_rename, only: modal_aero_rename_init - use modal_aero_convproc, only: ma_convproc_init ! args type(physics_buffer_desc), pointer :: pbuf2d(:,:) @@ -240,8 +222,7 @@ subroutine aero_model_init( pbuf2d ) call phys_getopts(history_aerosol_out = history_aerosol, & history_chemistry_out=history_chemistry, & history_cesm_forcing_out=history_cesm_forcing, & - history_dust_out=history_dust, & - convproc_do_aer_out = convproc_do_aer) + history_dust_out=history_dust) call rad_cnst_get_info(0, nmodes=nmodes) @@ -263,28 +244,17 @@ subroutine aero_model_init( pbuf2d ) call aero_deposition_cam_init(aero_props) endif - if (convproc_do_aer) then - call ma_convproc_init() - endif - call dust_init() call seasalt_init(seasalt_emis_scale) - call wetdep_init() - nwetdep = 0 ndrydep = 0 count_species: do m = 1,pcnst - if ( len_trim(wetdep_list(m)) /= 0 ) then - nwetdep = nwetdep+1 - endif if ( len_trim(drydep_list(m)) /= 0 ) then ndrydep = ndrydep+1 endif enddo count_species - if (nwetdep>0) & - allocate(wetdep_indices(nwetdep)) if (ndrydep>0) & allocate(drydep_indices(ndrydep)) @@ -300,18 +270,6 @@ subroutine aero_model_init( pbuf2d ) write(iulog,*) subrname//': '//drydep_list(m)//' will have drydep applied' endif enddo - do m = 1,nwetdep - call cnst_get_ind ( wetdep_list(m), id, abort=.false. ) - if (id>0) then - wetdep_indices(m) = id - else - call endrun(subrname//': invalid wetdep species: '//trim(wetdep_list(m)) ) - endif - - if (masterproc) then - write(iulog,*) subrname//': '//wetdep_list(m)//' will have wet removal' - endif - enddo if (ndrydep>0) then @@ -381,13 +339,6 @@ subroutine aero_model_init( pbuf2d ) drydep_lq(id) = .true. enddo - ! set flags for wetdep tendencies - wetdep_lq(:) = .false. - do m=1,nwetdep - id = wetdep_indices(m) - wetdep_lq(id) = .true. - enddo - wetdens_ap_idx = pbuf_get_index('WETDENS_AP') qaerwat_idx = pbuf_get_index('QAERWAT') pblh_idx = pbuf_get_index('pblh') @@ -425,59 +376,6 @@ subroutine aero_model_init( pbuf2d ) enddo - do m = 1,nwetdep - - ! units - if (wetdep_list(m)(1:3) == 'num') then - unit_basename = ' 1' - else - unit_basename = 'kg' - endif - - call addfld (trim(wetdep_list(m))//'SFWET', & - horiz_only, 'A',unit_basename//'/m2/s ','Wet deposition flux at surface') - call addfld (trim(wetdep_list(m))//'SFSIC', & - horiz_only, 'A',unit_basename//'/m2/s ','Wet deposition flux (incloud, convective) at surface') - call addfld (trim(wetdep_list(m))//'SFSIS', & - horiz_only, 'A',unit_basename//'/m2/s ','Wet deposition flux (incloud, stratiform) at surface') - call addfld (trim(wetdep_list(m))//'SFSBC', & - horiz_only, 'A',unit_basename//'/m2/s ','Wet deposition flux (belowcloud, convective) at surface') - call addfld (trim(wetdep_list(m))//'SFSBS', & - horiz_only, 'A',unit_basename//'/m2/s ','Wet deposition flux (belowcloud, stratiform) at surface') - - if (convproc_do_aer) then - call addfld (trim(wetdep_list(m))//'SFSES', & - horiz_only, 'A','kg/m2/s','Wet deposition flux (precip evap, stratiform) at surface') - call addfld (trim(wetdep_list(m))//'SFSBD', & - horiz_only, 'A','kg/m2/s','Wet deposition flux (belowcloud, deep convective) at surface') - end if - - call addfld (trim(wetdep_list(m))//'WET',(/ 'lev' /), 'A',unit_basename//'/kg/s ','wet deposition tendency') - call addfld (trim(wetdep_list(m))//'SIC',(/ 'lev' /), 'A',unit_basename//'/kg/s ', & - trim(wetdep_list(m))//' ic wet deposition') - call addfld (trim(wetdep_list(m))//'SIS',(/ 'lev' /), 'A',unit_basename//'/kg/s ', & - trim(wetdep_list(m))//' is wet deposition') - call addfld (trim(wetdep_list(m))//'SBC',(/ 'lev' /), 'A',unit_basename//'/kg/s ', & - trim(wetdep_list(m))//' bc wet deposition') - call addfld (trim(wetdep_list(m))//'SBS',(/ 'lev' /), 'A',unit_basename//'/kg/s ', & - trim(wetdep_list(m))//' bs wet deposition') - - if ( history_aerosol .or. history_chemistry ) then - call add_default (trim(wetdep_list(m))//'SFWET', 1, ' ') - endif - if ( history_aerosol ) then - call add_default (trim(wetdep_list(m))//'SFSIC', 1, ' ') - call add_default (trim(wetdep_list(m))//'SFSIS', 1, ' ') - call add_default (trim(wetdep_list(m))//'SFSBC', 1, ' ') - call add_default (trim(wetdep_list(m))//'SFSBS', 1, ' ') - if (convproc_do_aer) then - call add_default (trim(wetdep_list(m))//'SFSES', 1, ' ') - call add_default (trim(wetdep_list(m))//'SFSBD', 1, ' ') - end if - endif - - enddo - do m = 1,gas_pcnst if ( solsym(m)(1:3) == 'num') then @@ -506,16 +404,6 @@ subroutine aero_model_init( pbuf2d ) call addfld( cnst_name_cw(n), (/ 'lev' /), 'A', unit_basename//'/kg ', & trim(cnst_name_cw(n))//' in cloud water') - call addfld (trim(cnst_name_cw(n))//'SFWET', horiz_only, 'A', unit_basename//'/m2/s ', & - trim(cnst_name_cw(n))//' wet deposition flux at surface') - call addfld (trim(cnst_name_cw(n))//'SFSIC', horiz_only, 'A', unit_basename//'/m2/s ', & - trim(cnst_name_cw(n))//' wet deposition flux (incloud, convective) at surface') - call addfld (trim(cnst_name_cw(n))//'SFSIS', horiz_only, 'A', unit_basename//'/m2/s ', & - trim(cnst_name_cw(n))//' wet deposition flux (incloud, stratiform) at surface') - call addfld (trim(cnst_name_cw(n))//'SFSBC', horiz_only, 'A', unit_basename//'/m2/s ', & - trim(cnst_name_cw(n))//' wet deposition flux (belowcloud, convective) at surface') - call addfld (trim(cnst_name_cw(n))//'SFSBS', horiz_only, 'A', unit_basename//'/m2/s ', & - trim(cnst_name_cw(n))//' wet deposition flux (belowcloud, stratiform) at surface') call addfld (trim(cnst_name_cw(n))//'DDF', horiz_only, 'A', unit_basename//'/m2/s ', & trim(cnst_name_cw(n))//' dry deposition flux at bottom (grav + turb)') call addfld (trim(cnst_name_cw(n))//'TBF', horiz_only, 'A', unit_basename//'/m2/s ', & @@ -523,46 +411,13 @@ subroutine aero_model_init( pbuf2d ) call addfld (trim(cnst_name_cw(n))//'GVF', horiz_only, 'A', unit_basename//'/m2/s ', & trim(cnst_name_cw(n))//' gravitational dry deposition flux') - if (convproc_do_aer) then - call addfld (trim(cnst_name_cw(n))//'SFSEC', & - horiz_only, 'A','kg/m2/s','Wet deposition flux (precip evap, convective) at surface') - call addfld (trim(cnst_name_cw(n))//'SFSES', & - horiz_only, 'A','kg/m2/s','Wet deposition flux (precip evap, stratiform) at surface') - call addfld (trim(cnst_name_cw(n))//'SFSBD', & - horiz_only, 'A','kg/m2/s','Wet deposition flux (belowcloud, deep convective) at surface') - - call addfld (trim(cnst_name(n))//'WETC', & - (/ 'lev' /), 'A',unit_basename//'/kg/s ','wet deposition tendency') - call addfld (trim(cnst_name(n))//'CONU', & - (/ 'lev' /), 'A',unit_basename//'/kg ','updraft mixing ratio') - - call addfld (trim(cnst_name_cw(n))//'WETC', & - (/ 'lev' /), 'A',unit_basename//'/kg/s ','wet deposition tendency') - call addfld (trim(cnst_name_cw(n))//'CONU', & - (/ 'lev' /), 'A',unit_basename//'/kg ','updraft mixing ratio') - - call addfld( trim(cnst_name_cw(n))//'RSPTD', (/ 'lev' /), 'A', unit_basename//'/kg/s', & - trim(cnst_name_cw(n))//' resuspension tendency') - - end if - if ( history_aerosol.or. history_chemistry ) then call add_default( cnst_name_cw(n), 1, ' ' ) - call add_default (trim(cnst_name_cw(n))//'SFWET', 1, ' ') endif if ( history_aerosol ) then call add_default (trim(cnst_name_cw(n))//'GVF', 1, ' ') call add_default (trim(cnst_name_cw(n))//'TBF', 1, ' ') call add_default (trim(cnst_name_cw(n))//'DDF', 1, ' ') - call add_default (trim(cnst_name_cw(n))//'SFSBS', 1, ' ') - call add_default (trim(cnst_name_cw(n))//'SFSIC', 1, ' ') - call add_default (trim(cnst_name_cw(n))//'SFSBC', 1, ' ') - call add_default (trim(cnst_name_cw(n))//'SFSIS', 1, ' ') - if (convproc_do_aer) then - call add_default (trim(cnst_name_cw(n))//'SFSEC', 1, ' ') - call add_default (trim(cnst_name_cw(n))//'SFSES', 1, ' ') - call add_default (trim(cnst_name_cw(n))//'SFSBD', 1, ' ') - end if endif endif enddo @@ -681,6 +536,8 @@ subroutine aero_model_init( pbuf2d ) endif endif + call aero_wetdep_init() + end subroutine aero_model_init !============================================================================= @@ -985,10 +842,7 @@ subroutine aero_model_drydep ( state, pbuf, obklen, ustar, cam_in, dt, cam_out, !============================================================================= subroutine aero_model_wetdep( state, dt, dlf, cam_out, ptend, pbuf) - use wetdep, only: wetdepa_v2, wetdep_inputs_set, wetdep_inputs_t - use modal_aero_data - use modal_aero_convproc, only: deepconv_wetdep_history, ma_convproc_intr, convproc_do_evaprain_atonce - use aero_deposition_cam, only: aero_deposition_cam_setwet + use aero_wetdep_cam, only: aero_wetdep_tend ! args @@ -999,650 +853,9 @@ subroutine aero_model_wetdep( state, dt, dlf, cam_out, ptend, pbuf) type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies type(physics_buffer_desc), pointer :: pbuf(:) - ! local vars - - integer :: m ! tracer index - - integer :: lchnk ! chunk identifier - integer :: ncol ! number of atmospheric columns - - real(r8) :: iscavt(pcols, pver) - - integer :: mm - integer :: i,k - - real(r8) :: icscavt(pcols, pver) - real(r8) :: isscavt(pcols, pver) - real(r8) :: bcscavt(pcols, pver) - real(r8) :: bsscavt(pcols, pver) - real(r8) :: sol_factb, sol_facti - real(r8) :: sol_factic(pcols,pver) - - real(r8) :: sflx(pcols) ! deposition flux - - integer :: jnv ! index for scavcoefnv 3rd dimension - integer :: lphase ! index for interstitial / cloudborne aerosol - integer :: strt_loop, end_loop, stride_loop !loop indices for the lphase loop - integer :: lspec ! index for aerosol number / chem-mass / water-mass - integer :: lcoardust, lcoarnacl ! indices for coarse mode dust and seasalt masses - real(r8) :: dqdt_tmp(pcols,pver) ! temporary array to hold tendency for 1 species - real(r8) :: f_act_conv(pcols,pver) ! prescribed aerosol activation fraction for convective cloud ! rce 2010/05/01 - real(r8) :: f_act_conv_coarse(pcols,pver) ! similar but for coarse mode ! rce 2010/05/02 - real(r8) :: f_act_conv_coarse_dust, f_act_conv_coarse_nacl ! rce 2010/05/02 - real(r8) :: fracis_cw(pcols,pver) - real(r8) :: hygro_sum_old(pcols,pver) ! before removal [sum of (mass*hydro/dens)] - real(r8) :: hygro_sum_del(pcols,pver) ! removal change to [sum of (mass*hydro/dens)] - real(r8) :: hygro_sum_old_ik, hygro_sum_new_ik - real(r8) :: prec(pcols) ! precipitation rate - real(r8) :: q_tmp(pcols,pver) ! temporary array to hold "most current" mixing ratio for 1 species - real(r8) :: scavcoefnv(pcols,pver,0:2) ! Dana and Hales coefficient (/mm) for - ! cloud-borne num & vol (0), - ! interstitial num (1), interstitial vol (2) - real(r8) :: tmpa, tmpb - real(r8) :: tmpdust, tmpnacl - real(r8) :: water_old, water_new ! temporary old/new aerosol water mix-rat - logical :: isprx(pcols,pver) ! true if precipation - real(r8) :: aerdepwetis(pcols,pcnst) ! aerosol wet deposition (interstitial) - real(r8) :: aerdepwetcw(pcols,pcnst) ! aerosol wet deposition (cloud water) - - ! For unified convection scheme - logical, parameter :: do_aero_water_removal = .false. ! True if aerosol water reduction by wet removal is to be calculated - ! (this has not been fully tested, so best to leave it off) - logical :: do_hygro_sum_del, do_lphase1, do_lphase2 - - real(r8), pointer :: rprddp(:,:) ! rain production, deep convection - real(r8), pointer :: rprdsh(:,:) ! rain production, shallow convection - real(r8), pointer :: evapcdp(:,:) ! Evaporation rate of deep convective precipitation >=0. - real(r8), pointer :: evapcsh(:,:) ! Evaporation rate of shallow convective precipitation >=0. - - real(r8) :: rprddpsum(pcols) - real(r8) :: rprdshsum(pcols) - real(r8) :: evapcdpsum(pcols) - real(r8) :: evapcshsum(pcols) - - real(r8) :: tmp_resudp, tmp_resush - - real(r8) :: sflxec(pcols), sflxecdp(pcols) ! deposition flux - real(r8) :: sflxic(pcols), sflxicdp(pcols) ! deposition flux - real(r8) :: sflxbc(pcols), sflxbcdp(pcols) ! deposition flux - real(r8) :: rcscavt(pcols, pver) - real(r8) :: rsscavt(pcols, pver) - real(r8) :: qqcw_in(pcols,pver), qqcw_sav(pcols,pver,0:nspec_max) ! temporary array to hold qqcw for the current mode - real(r8) :: rtscavt(pcols, pver, 0:nspec_max) - - integer, parameter :: nsrflx_mzaer2cnvpr = 2 - real(r8) :: qsrflx_mzaer2cnvpr(pcols,pcnst,nsrflx_mzaer2cnvpr) - ! End unified convection scheme - - real(r8), pointer :: fldcw(:,:) - - real(r8), pointer :: dgnumwet(:,:,:) - real(r8), pointer :: qaerwat(:,:,:) ! aerosol water - - real(r8), pointer :: fracis(:,:,:) ! fraction of transported species that are insoluble - - type(wetdep_inputs_t) :: dep_inputs - - real(r8) :: dcondt_resusp3d(2*pcnst,pcols, pver) - - lchnk = state%lchnk - ncol = state%ncol - - dcondt_resusp3d(:,:,:) = 0._r8 - - call physics_ptend_init(ptend, state%psetcols, 'aero_model_wetdep', lq=wetdep_lq) - - if (nwetdep<1) return - - call wetdep_inputs_set( state, pbuf, dep_inputs ) - - call pbuf_get_field(pbuf, dgnumwet_idx, dgnumwet, start=(/1,1,1/), kount=(/pcols,pver,nmodes/) ) - call pbuf_get_field(pbuf, qaerwat_idx, qaerwat, start=(/1,1,1/), kount=(/pcols,pver,nmodes/) ) - call pbuf_get_field(pbuf, fracis_idx, fracis, start=(/1,1,1/), kount=(/pcols, pver, pcnst/) ) - - prec(:ncol)=0._r8 - do k=1,pver - where (prec(:ncol) >= 1.e-7_r8) - isprx(:ncol,k) = .true. - elsewhere - isprx(:ncol,k) = .false. - endwhere - prec(:ncol) = prec(:ncol) + (dep_inputs%prain(:ncol,k) + dep_inputs%cmfdqr(:ncol,k) - dep_inputs%evapr(:ncol,k)) & - *state%pdel(:ncol,k)/gravit - end do - - qsrflx_mzaer2cnvpr(:,:,:) = 0.0_r8 - aerdepwetis(:,:) = 0.0_r8 - aerdepwetcw(:,:) = 0.0_r8 - - ! calculate the mass-weighted sol_factic for coarse mode species - ! sol_factic_coarse(:,:) = 0.30_r8 ! tuned 1/4 - f_act_conv_coarse(:,:) = 0.60_r8 ! rce 2010/05/02 - f_act_conv_coarse_dust = 0.40_r8 ! rce 2010/05/02 - f_act_conv_coarse_nacl = 0.80_r8 ! rce 2010/05/02 - if (modeptr_coarse > 0) then - lcoardust = lptr_dust_a_amode(modeptr_coarse) - lcoarnacl = lptr_nacl_a_amode(modeptr_coarse) - if ((lcoardust > 0) .and. (lcoarnacl > 0)) then - do k = 1, pver - do i = 1, ncol - tmpdust = max( 0.0_r8, state%q(i,k,lcoardust) ) - tmpnacl = max( 0.0_r8, state%q(i,k,lcoarnacl) ) - if ((tmpdust+tmpnacl) > 1.0e-30_r8) then - ! sol_factic_coarse(i,k) = (0.2_r8*tmpdust + 0.4_r8*tmpnacl)/(tmpdust+tmpnacl) ! tuned 1/6 - f_act_conv_coarse(i,k) = (f_act_conv_coarse_dust*tmpdust & - + f_act_conv_coarse_nacl*tmpnacl)/(tmpdust+tmpnacl) ! rce 2010/05/02 - end if - end do - end do - end if - end if - - scavcoefnv(:,:,0) = 0.0_r8 ! below-cloud scavcoef = 0.0 for cloud-borne species - - ! Counters for "without" unified convective treatment (i.e. default case) - strt_loop = 1 - end_loop = 2 - stride_loop = 1 - if (convproc_do_aer) then - !Do cloudborne first for unified convection scheme so that the resuspension of cloudborne - !can be saved then applied to interstitial - strt_loop = 2 - end_loop = 1 - stride_loop = -1 - endif - - if (convproc_do_aer) then - call t_startf('ma_convproc') - call ma_convproc_intr( state, ptend, pbuf, dt, & - nsrflx_mzaer2cnvpr, qsrflx_mzaer2cnvpr, aerdepwetis, dcondt_resusp3d) - - if (convproc_do_evaprain_atonce) then - do m = 1, ntot_amode ! main loop over aerosol modes - - do lspec = 0, nspec_amode(m) ! loop over number + chem constituents - if (lspec == 0) then ! number - mm = numptrcw_amode(m) - else if (lspec <= nspec_amode(m)) then ! non-water mass - mm = lmassptrcw_amode(lspec,m) - endif - fldcw => qqcw_get_field(pbuf, mm,lchnk) - - call outfld( trim(cnst_name_cw(mm))//'RSPTD', dcondt_resusp3d(mm+pcnst,:ncol,:), ncol, lchnk ) - - do k = 1,pver - do i = 1,ncol - fldcw(i,k) = max(0._r8, fldcw(i,k) + dcondt_resusp3d(mm+pcnst,i,k)*dt) - end do - end do - end do ! loop over number + chem constituents - end do ! m aerosol modes - end if - call t_stopf('ma_convproc') - endif - - do m = 1, ntot_amode ! main loop over aerosol modes - - do lphase = strt_loop,end_loop, stride_loop ! loop over interstitial (1) and cloud-borne (2) forms - - ! sol_factb and sol_facti values - ! sol_factb - currently this is basically a tuning factor - ! sol_facti & sol_factic - currently has a physical basis, and reflects activation fraction - ! - ! 2008-mar-07 rce - sol_factb (interstitial) changed from 0.3 to 0.1 - ! - sol_factic (interstitial, dust modes) changed from 1.0 to 0.5 - ! - sol_factic (cloud-borne, pcarb modes) no need to set it to 0.0 - ! because the cloud-borne pcarbon == 0 (no activation) - ! - ! rce 2010/05/02 - ! prior to this date, sol_factic was used for convective in-cloud wet removal, - ! and its value reflected a combination of an activation fraction (which varied between modes) - ! and a tuning factor - ! from this date forward, two parameters are used for convective in-cloud wet removal - ! f_act_conv is the activation fraction - ! note that "non-activation" of aerosol in air entrained into updrafts should - ! be included here - ! eventually we might use the activate routine (with w ~= 1 m/s) to calculate - ! this, but there is still the entrainment issue - ! sol_factic is strictly a tuning factor - ! - if (lphase == 1) then ! interstial aerosol - hygro_sum_old(:,:) = 0.0_r8 - hygro_sum_del(:,:) = 0.0_r8 - call modal_aero_bcscavcoef_get( m, ncol, isprx, dgnumwet, & - scavcoefnv(:,:,1), scavcoefnv(:,:,2) ) - - sol_factb = sol_factb_interstitial ! all below-cloud scav ON (0.1 "tuning factor") - - sol_facti = 0.0_r8 ! strat in-cloud scav totally OFF for institial - - sol_factic = sol_factic_interstitial - - if (m == modeptr_pcarbon) then - ! sol_factic = 0.0_r8 ! conv in-cloud scav OFF (0.0 activation fraction) - f_act_conv = 0.0_r8 ! rce 2010/05/02 - else if ((m == modeptr_finedust) .or. (m == modeptr_coardust)) then - ! sol_factic = 0.2_r8 ! conv in-cloud scav ON (0.5 activation fraction) ! tuned 1/4 - f_act_conv = 0.4_r8 ! rce 2010/05/02 - else - ! sol_factic = 0.4_r8 ! conv in-cloud scav ON (1.0 activation fraction) ! tuned 1/4 - f_act_conv = 0.8_r8 ! rce 2010/05/02 - end if - - else ! cloud-borne aerosol (borne by stratiform cloud drops) - - sol_factb = 0.0_r8 ! all below-cloud scav OFF (anything cloud-borne is located "in-cloud") - sol_facti = sol_facti_cloud_borne ! strat in-cloud scav cloud-borne tuning factor - sol_factic = 0.0_r8 ! conv in-cloud scav OFF (having this on would mean - ! that conv precip collects strat droplets) - f_act_conv = 0.0_r8 ! conv in-cloud scav OFF (having this on would mean - - end if - if (convproc_do_aer .and. lphase == 1) then - ! if modal aero convproc is turned on for aerosols, then - ! turn off the convective in-cloud removal for interstitial aerosols - ! (but leave the below-cloud on, as convproc only does in-cloud) - ! and turn off the outfld SFWET, SFSIC, SFSID, SFSEC, and SFSED calls - ! for (stratiform)-cloudborne aerosols, convective wet removal - ! (all forms) is zero, so no action is needed - sol_factic = 0.0_r8 - endif - - ! - ! rce 2010/05/03 - ! wetdepa has "sol_fact" parameters: - ! sol_facti, sol_factic, sol_factb for liquid cloud - - do lspec = 0, nspec_amode(m)+1 ! loop over number + chem constituents + water - - if (lspec == 0) then ! number - if (lphase == 1) then - mm = numptr_amode(m) - jnv = 1 - else - mm = numptrcw_amode(m) - jnv = 0 - endif - else if (lspec <= nspec_amode(m)) then ! non-water mass - if (lphase == 1) then - mm = lmassptr_amode(lspec,m) - jnv = 2 - else - mm = lmassptrcw_amode(lspec,m) - jnv = 0 - endif - else ! water mass - ! bypass wet removal of aerosol water - if(convproc_do_aer) then - if ( .not. do_aero_water_removal ) cycle - else - cycle - endif - if (lphase == 1) then - mm = 0 - ! mm = lwaterptr_amode(m) - jnv = 2 - else - mm = 0 - jnv = 0 - endif - endif - - if (mm <= 0) cycle - - - ! set f_act_conv for interstitial (lphase=1) coarse mode species - ! for the convective in-cloud, we conceptually treat the coarse dust and seasalt - ! as being externally mixed, and apply f_act_conv = f_act_conv_coarse_dust/nacl to dust/seasalt - ! number and sulfate are conceptually partitioned to the dust and seasalt - ! on a mass basis, so the f_act_conv for number and sulfate are - ! mass-weighted averages of the values used for dust/seasalt - if ((lphase == 1) .and. (m == modeptr_coarse)) then - ! sol_factic = sol_factic_coarse - f_act_conv = f_act_conv_coarse ! rce 2010/05/02 - if (lspec > 0) then - if (lmassptr_amode(lspec,m) == lptr_dust_a_amode(m)) then - ! sol_factic = 0.2_r8 ! tuned 1/4 - f_act_conv = f_act_conv_coarse_dust ! rce 2010/05/02 - else if (lmassptr_amode(lspec,m) == lptr_nacl_a_amode(m)) then - ! sol_factic = 0.4_r8 ! tuned 1/6 - f_act_conv = f_act_conv_coarse_nacl ! rce 2010/05/02 - end if - end if - end if - - if ((lphase == 1) .and. (lspec <= nspec_amode(m))) then - ptend%lq(mm) = .TRUE. - dqdt_tmp(:,:) = 0.0_r8 - ! q_tmp is the "most current" q - q_tmp(1:ncol,:) = state%q(1:ncol,:,mm) + ptend%q(1:ncol,:,mm)*dt - if(convproc_do_aer) then - !Feed in the saved cloudborne mixing ratios from phase 2 - qqcw_in(:,:) = qqcw_sav(:,:,lspec) - else - fldcw => qqcw_get_field(pbuf, mm,lchnk) - qqcw_in(:,:) = fldcw(:,:) - endif - - call wetdepa_v2( state%pmid, state%q(:,:,1), state%pdel, & - dep_inputs%cldt, dep_inputs%cldcu, dep_inputs%cmfdqr, & - dep_inputs%evapc, dep_inputs%conicw, dep_inputs%prain, dep_inputs%qme, & - dep_inputs%evapr, dep_inputs%totcond, q_tmp, dt, & - dqdt_tmp, iscavt, dep_inputs%cldvcu, dep_inputs%cldvst, & - dlf, fracis(:,:,mm), sol_factb, ncol, & - scavcoefnv(:,:,jnv), & - is_strat_cloudborne=.false., & - qqcw=qqcw_in(:,:), & - f_act_conv=f_act_conv, & - icscavt=icscavt, isscavt=isscavt, bcscavt=bcscavt, bsscavt=bsscavt, & - convproc_do_aer=convproc_do_aer, rcscavt=rcscavt, rsscavt=rsscavt, & - sol_facti_in=sol_facti, sol_factic_in=sol_factic, & - convproc_do_evaprain_atonce_in=convproc_do_evaprain_atonce ) - - do_hygro_sum_del = .false. - if ( lspec > 0 ) do_hygro_sum_del = .true. - - if(convproc_do_aer) then - do_hygro_sum_del = .false. - ! add resuspension of cloudborne species to dqdt of interstitial species - dqdt_tmp(1:ncol,:) = dqdt_tmp(1:ncol,:) + rtscavt(1:ncol,:,lspec) - if ( (lspec > 0) .and. do_aero_water_removal ) then - do_hygro_sum_del = .true. - endif - endif - - ptend%q(1:ncol,:,mm) = ptend%q(1:ncol,:,mm) + dqdt_tmp(1:ncol,:) - - call outfld( trim(cnst_name(mm))//'WET', dqdt_tmp(:,:), pcols, lchnk) - call outfld( trim(cnst_name(mm))//'SIC', icscavt, pcols, lchnk) - call outfld( trim(cnst_name(mm))//'SIS', isscavt, pcols, lchnk) - call outfld( trim(cnst_name(mm))//'SBC', bcscavt, pcols, lchnk) - call outfld( trim(cnst_name(mm))//'SBS', bsscavt, pcols, lchnk) - - sflx(:)=0._r8 - do k=1,pver - do i=1,ncol - sflx(i)=sflx(i)+dqdt_tmp(i,k)*state%pdel(i,k)/gravit - enddo - enddo - if (.not.convproc_do_aer) call outfld( trim(cnst_name(mm))//'SFWET', sflx, pcols, lchnk) - aerdepwetis(:ncol,mm) = aerdepwetis(:ncol,mm) + sflx(:ncol) - - sflx(:)=0._r8 - do k=1,pver - do i=1,ncol - sflx(i)=sflx(i)+icscavt(i,k)*state%pdel(i,k)/gravit - enddo - enddo - if (.not.convproc_do_aer) call outfld( trim(cnst_name(mm))//'SFSIC', sflx, pcols, lchnk) - if (convproc_do_aer) sflxic = sflx - - sflx(:)=0._r8 - do k=1,pver - do i=1,ncol - sflx(i)=sflx(i)+isscavt(i,k)*state%pdel(i,k)/gravit - enddo - enddo - call outfld( trim(cnst_name(mm))//'SFSIS', sflx, pcols, lchnk) - - sflx(:)=0._r8 - do k=1,pver - do i=1,ncol - sflx(i)=sflx(i)+bcscavt(i,k)*state%pdel(i,k)/gravit - enddo - enddo - call outfld( trim(cnst_name(mm))//'SFSBC', sflx, pcols, lchnk) - if (convproc_do_aer) sflxbc = sflx - - sflx(:)=0._r8 - do k=1,pver - do i=1,ncol - sflx(i)=sflx(i)+bsscavt(i,k)*state%pdel(i,k)/gravit - enddo - enddo - call outfld( trim(cnst_name(mm))//'SFSBS', sflx, pcols, lchnk) - - if (convproc_do_aer) then - - sflx(:)=0._r8 - do k=1,pver - do i=1,ncol - sflx(i)=sflx(i)+rcscavt(i,k)*state%pdel(i,k)/gravit - enddo - enddo - sflxec = sflx - - sflx(:)=0._r8 - do k=1,pver - do i=1,ncol - sflx(i)=sflx(i)+rsscavt(i,k)*state%pdel(i,k)/gravit - enddo - enddo - call outfld( trim(cnst_name(mm))//'SFSES', sflx, pcols, lchnk) - - ! apportion convective surface fluxes to deep and shallow conv - ! this could be done more accurately in subr wetdepa - ! since deep and shallow rarely occur simultaneously, and these - ! fields are just diagnostics, this approximate method is adequate - ! only do this for interstitial aerosol, because conv clouds to not - ! affect the stratiform-cloudborne aerosol - if ( deepconv_wetdep_history) then - - call pbuf_get_field(pbuf, rprddp_idx, rprddp ) - call pbuf_get_field(pbuf, rprdsh_idx, rprdsh ) - call pbuf_get_field(pbuf, nevapr_dpcu_idx, evapcdp ) - call pbuf_get_field(pbuf, nevapr_shcu_idx, evapcsh ) - - rprddpsum(:) = 0.0_r8 - rprdshsum(:) = 0.0_r8 - evapcdpsum(:) = 0.0_r8 - evapcshsum(:) = 0.0_r8 - - do k = 1, pver - rprddpsum(:ncol) = rprddpsum(:ncol) + rprddp(:ncol,k)*state%pdel(:ncol,k)/gravit - rprdshsum(:ncol) = rprdshsum(:ncol) + rprdsh(:ncol,k)*state%pdel(:ncol,k)/gravit - evapcdpsum(:ncol) = evapcdpsum(:ncol) + evapcdp(:ncol,k)*state%pdel(:ncol,k)/gravit - evapcshsum(:ncol) = evapcshsum(:ncol) + evapcsh(:ncol,k)*state%pdel(:ncol,k)/gravit - end do - - do i = 1, ncol - rprddpsum(i) = max( rprddpsum(i), 1.0e-35_r8 ) - rprdshsum(i) = max( rprdshsum(i), 1.0e-35_r8 ) - evapcdpsum(i) = max( evapcdpsum(i), 0.1e-35_r8 ) - evapcshsum(i) = max( evapcshsum(i), 0.1e-35_r8 ) - - ! assume that in- and below-cloud removal are proportional to column precip production - tmpa = rprddpsum(i) / (rprddpsum(i) + rprdshsum(i)) - tmpa = max( 0.0_r8, min( 1.0_r8, tmpa ) ) - sflxicdp(i) = sflxic(i)*tmpa - sflxbcdp(i) = sflxbc(i)*tmpa - - ! assume that resuspension is proportional to (wet removal)*[(precip evap)/(precip production)] - tmp_resudp = tmpa * min( (evapcdpsum(i)/rprddpsum(i)), 1.0_r8 ) - tmp_resush = (1.0_r8 - tmpa) * min( (evapcshsum(i)/rprdshsum(i)), 1.0_r8 ) - tmpb = max( tmp_resudp, 1.0e-35_r8 ) / max( (tmp_resudp+tmp_resush), 1.0e-35_r8 ) - tmpb = max( 0.0_r8, min( 1.0_r8, tmpb ) ) - sflxecdp(i) = sflxec(i)*tmpb - end do - call outfld( trim(cnst_name(mm))//'SFSBD', sflxbcdp, pcols, lchnk) - else - sflxec(1:ncol) = 0.0_r8 - sflxecdp(1:ncol) = 0.0_r8 - end if - - ! when ma_convproc_intr is used, convective in-cloud wet removal is done there - ! the convective (total and deep) precip-evap-resuspension includes in- and below-cloud - ! contributions - ! so pass the below-cloud contribution to ma_convproc_intr - qsrflx_mzaer2cnvpr(1:ncol,mm,1) = sflxec( 1:ncol) - qsrflx_mzaer2cnvpr(1:ncol,mm,2) = sflxecdp(1:ncol) - - endif - - if (do_hygro_sum_del) then - tmpa = spechygro(lspec,m)/ & - specdens_amode(lspec,m) - tmpb = tmpa*dt - hygro_sum_old(1:ncol,:) = hygro_sum_old(1:ncol,:) & - + tmpa*q_tmp(1:ncol,:) - hygro_sum_del(1:ncol,:) = hygro_sum_del(1:ncol,:) & - + tmpb*dqdt_tmp(1:ncol,:) - end if - - else if ((lphase == 1) .and. (lspec == nspec_amode(m)+1)) then - do_lphase1 = .true. - if(convproc_do_aer) then - do_lphase1 = .false. - if(do_aero_water_removal)do_lphase1 = .true. - endif - if(do_lphase1) then - ! aerosol water -- because of how wetdepa treats evaporation of stratiform - ! precip, it is not appropriate to apply wetdepa to aerosol water - ! instead, "hygro_sum" = [sum of (mass*hygro/dens)] is calculated before and - ! after wet removal, and new water is calculated using - ! new_water = old_water*min(10,(hygro_sum_new/hygro_sum_old)) - ! the "min(10,...)" is to avoid potential problems when hygro_sum_old ~= 0 - ! also, individual wet removal terms (ic,is,bc,bs) are not output to history - ! ptend%lq(mm) = .TRUE. - ! dqdt_tmp(:,:) = 0.0_r8 - do k = 1, pver - do i = 1, ncol - ! water_old = max( 0.0_r8, state%q(i,k,mm)+ptend%q(i,k,mm)*dt ) - water_old = max( 0.0_r8, qaerwat(i,k,mm) ) - hygro_sum_old_ik = max( 0.0_r8, hygro_sum_old(i,k) ) - hygro_sum_new_ik = max( 0.0_r8, hygro_sum_old_ik+hygro_sum_del(i,k) ) - if (hygro_sum_new_ik >= 10.0_r8*hygro_sum_old_ik) then - water_new = 10.0_r8*water_old - else - water_new = water_old*(hygro_sum_new_ik/hygro_sum_old_ik) - end if - ! dqdt_tmp(i,k) = (water_new - water_old)/dt - qaerwat(i,k,mm) = water_new - end do - end do - - ! ptend%q(1:ncol,:,mm) = ptend%q(1:ncol,:,mm) + dqdt_tmp(1:ncol,:) - - ! call outfld( trim(cnst_name(mm)) - - ! sflx(:)=0._r8 - ! do k=1,pver - ! do i=1,ncol - ! sflx(i)=sflx(i)+dqdt_tmp(i,k)*state%pdel(i,k)/gravit - ! enddo - ! enddo - ! call outfld( trim(cnst_name(mm)) - endif - - elseif (lphase == 2) then - - do_lphase2 = .true. - if (convproc_do_aer) then - do_lphase2 = .false. - if (lspec <= nspec_amode(m)) do_lphase2 = .true. - endif - - if (do_lphase2) then - - dqdt_tmp(:,:) = 0.0_r8 - - if (convproc_do_aer) then - fldcw => qqcw_get_field(pbuf,mm,lchnk) - qqcw_sav(1:ncol,:,lspec) = fldcw(1:ncol,:) - else - fldcw => qqcw_get_field(pbuf, mm,lchnk) - endif - - call wetdepa_v2(state%pmid, state%q(:,:,1), state%pdel, & - dep_inputs%cldt, dep_inputs%cldcu, dep_inputs%cmfdqr, & - dep_inputs%evapc, dep_inputs%conicw, dep_inputs%prain, dep_inputs%qme, & - dep_inputs%evapr, dep_inputs%totcond, fldcw, dt, & - dqdt_tmp, iscavt, dep_inputs%cldvcu, dep_inputs%cldvst, & - dlf, fracis_cw, sol_factb, ncol, & - scavcoefnv(:,:,jnv), & - is_strat_cloudborne=.true., & - icscavt=icscavt, isscavt=isscavt, bcscavt=bcscavt, bsscavt=bsscavt, & - convproc_do_aer=convproc_do_aer, rcscavt=rcscavt, rsscavt=rsscavt, & - sol_facti_in=sol_facti, sol_factic_in=sol_factic, & - convproc_do_evaprain_atonce_in=convproc_do_evaprain_atonce, & - bergso_in=dep_inputs%bergso ) - - if(convproc_do_aer) then - ! save resuspension of cloudborne species - rtscavt(1:ncol,:,lspec) = rcscavt(1:ncol,:) + rsscavt(1:ncol,:) - ! wetdepa_v2 adds the resuspension of cloudborne to the dqdt of cloudborne (as a source) - ! undo this, so the resuspension of cloudborne can be added to the dqdt of interstitial (above) - dqdt_tmp(1:ncol,:) = dqdt_tmp(1:ncol,:) - rtscavt(1:ncol,:,lspec) - endif - - - fldcw(1:ncol,:) = fldcw(1:ncol,:) + dqdt_tmp(1:ncol,:) * dt - - sflx(:)=0._r8 - do k=1,pver - do i=1,ncol - sflx(i)=sflx(i)+dqdt_tmp(i,k)*state%pdel(i,k)/gravit - enddo - enddo - call outfld( trim(cnst_name_cw(mm))//'SFWET', sflx, pcols, lchnk) - aerdepwetcw(:ncol,mm) = sflx(:ncol) - - sflx(:)=0._r8 - do k=1,pver - do i=1,ncol - sflx(i)=sflx(i)+icscavt(i,k)*state%pdel(i,k)/gravit - enddo - enddo - call outfld( trim(cnst_name_cw(mm))//'SFSIC', sflx, pcols, lchnk) - sflx(:)=0._r8 - do k=1,pver - do i=1,ncol - sflx(i)=sflx(i)+isscavt(i,k)*state%pdel(i,k)/gravit - enddo - enddo - call outfld( trim(cnst_name_cw(mm))//'SFSIS', sflx, pcols, lchnk) - sflx(:)=0._r8 - do k=1,pver - do i=1,ncol - sflx(i)=sflx(i)+bcscavt(i,k)*state%pdel(i,k)/gravit - enddo - enddo - call outfld( trim(cnst_name_cw(mm))//'SFSBC', sflx, pcols, lchnk) - sflx(:)=0._r8 - do k=1,pver - do i=1,ncol - sflx(i)=sflx(i)+bsscavt(i,k)*state%pdel(i,k)/gravit - enddo - enddo - call outfld( trim(cnst_name_cw(mm))//'SFSBS', sflx, pcols, lchnk) - - if(convproc_do_aer) then - sflx(:)=0.0_r8 - do k=1,pver - sflx(1:ncol)=sflx(1:ncol)+rcscavt(1:ncol,k)*state%pdel(1:ncol,k)/gravit - enddo - call outfld( trim(cnst_name_cw(mm))//'SFSEC', sflx, pcols, lchnk) - - sflx(:)=0.0_r8 - do k=1,pver - sflx(1:ncol)=sflx(1:ncol)+rsscavt(1:ncol,k)*state%pdel(1:ncol,k)/gravit - enddo - call outfld( trim(cnst_name_cw(mm))//'SFSES', sflx, pcols, lchnk) - endif - endif - endif - - enddo ! lspec = 0, nspec_amode(m)+1 - enddo ! lphase = 1, 2 - enddo ! m = 1, ntot_amode - - ! if the user has specified prescribed aerosol dep fluxes then - ! do not set cam_out dep fluxes according to the prognostic aerosols - if (.not. aerodep_flx_prescribed()) then - call aero_deposition_cam_setwet(aerdepwetis, aerdepwetcw, cam_out) - endif + call aero_wetdep_tend(state, dt, dlf, cam_out, ptend, pbuf) - endsubroutine aero_model_wetdep + end subroutine aero_model_wetdep !------------------------------------------------------------------------- ! provides wet tropospheric aerosol surface area info for modal aerosols diff --git a/src/chemistry/modal_aero/dust_model.F90 b/src/chemistry/modal_aero/dust_model.F90 index 923ab9e3db..6213c47636 100644 --- a/src/chemistry/modal_aero/dust_model.F90 +++ b/src/chemistry/modal_aero/dust_model.F90 @@ -6,6 +6,8 @@ module dust_model use spmd_utils, only: masterproc use cam_abortutils, only: endrun use modal_aero_data, only: ntot_amode, ndst=>nDust + use cam_logfile, only: iulog + use shr_dust_emis_mod,only: is_dust_emis_zender, is_zender_soil_erod_from_atm implicit none private @@ -30,8 +32,8 @@ module dust_model real(r8), allocatable :: dust_dmt_vwr(:) real(r8), allocatable :: dust_stk_crc(:) - real(r8) :: dust_emis_fact = -1.e36_r8 ! tuning parameter for dust emissions - character(len=cl) :: soil_erod_file = 'soil_erod_file' ! full pathname for soil erodibility dataset + real(r8) :: dust_emis_fact = 0._r8 ! tuning parameter for dust emissions + character(len=cl) :: soil_erod_file = 'none' ! full pathname for soil erodibility dataset logical :: dust_active = .false. @@ -43,8 +45,8 @@ module dust_model subroutine dust_readnl(nlfile) use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use mpishorthand + use spmd_utils, only: mpicom, masterprocid, mpi_character, mpi_real8, mpi_success + use shr_dust_emis_mod, only: shr_dust_emis_readnl character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input @@ -58,8 +60,7 @@ subroutine dust_readnl(nlfile) ! Read namelist if (masterproc) then - unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) + open( newunit=unitn, file=trim(nlfile), status='old' ) call find_group_name(unitn, 'dust_nl', status=ierr) if (ierr == 0) then read(unitn, dust_nl, iostat=ierr) @@ -68,14 +69,34 @@ subroutine dust_readnl(nlfile) end if end if close(unitn) - call freeunit(unitn) end if -#ifdef SPMD ! Broadcast namelist variables - call mpibcast(dust_emis_fact, 1, mpir8, 0, mpicom) - call mpibcast(soil_erod_file, len(soil_erod_file), mpichar, 0, mpicom) -#endif + call mpi_bcast(soil_erod_file, len(soil_erod_file), mpi_character, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) then + call endrun(subname//' MPI_BCAST ERROR: soil_erod_file') + end if + call mpi_bcast(dust_emis_fact, 1, mpi_real8, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) then + call endrun(subname//' MPI_BCAST ERROR: dust_emis_fact') + end if + + call shr_dust_emis_readnl(mpicom, 'drv_flds_in') + + if ((soil_erod_file /= 'none') .and. (.not.is_zender_soil_erod_from_atm())) then + call endrun(subname//': should not specify soil_erod_file if Zender soil erosion is not in CAM') + end if + + if (masterproc) then + if (is_dust_emis_zender()) then + write(iulog,*) subname,': Zender_2003 dust emission method is being used.' + end if + if (is_zender_soil_erod_from_atm()) then + write(iulog,*) subname,': Zender soil erod file is handled in atm' + write(iulog,*) subname,': soil_erod_file = ',trim(soil_erod_file) + write(iulog,*) subname,': dust_emis_fact = ',dust_emis_fact + end if + end if end subroutine dust_readnl @@ -131,7 +152,9 @@ subroutine dust_init() dust_active = any(dust_indices(:) > 0) if (.not.dust_active) return - call soil_erod_init( dust_emis_fact, soil_erod_file ) + if (is_zender_soil_erod_from_atm()) then + call soil_erod_init( dust_emis_fact, soil_erod_file ) + end if call dust_set_params( dust_nbin, dust_dmt_grd, dust_dmt_vwr, dust_stk_crc ) @@ -158,29 +181,36 @@ subroutine dust_emis( ncol, lchnk, dust_flux_in, cflx, soil_erod ) ! set dust emissions - col_loop: do i =1,ncol - - soil_erod(i) = soil_erodibility( i, lchnk ) - - if( soil_erod(i) .lt. soil_erod_threshold ) soil_erod(i) = 0._r8 - - ! rebin and adjust dust emissons.. - do m = 1,dust_nbin - - idst = dust_indices(m) - - cflx(i,idst) = sum( -dust_flux_in(i,:) ) & - * dust_emis_sclfctr(m)*soil_erod(i)/soil_erod_fact*1.15_r8 - - x_mton = 6._r8 / (pi * dust_density * (dust_dmt_vwr(m)**3._r8)) - - inum = dust_indices(m+dust_nbin) - - cflx(i,inum) = cflx(i,idst)*x_mton - - enddo - - end do col_loop + if (is_zender_soil_erod_from_atm()) then + col_loop1: do i = 1,ncol + soil_erod(i) = soil_erodibility( i, lchnk ) + if( soil_erod(i) .lt. soil_erod_threshold ) soil_erod(i) = 0._r8 + + ! rebin and adjust dust emissons. + do m = 1,dust_nbin + idst = dust_indices(m) + cflx(i,idst) = sum( -dust_flux_in(i,:) ) & + * dust_emis_sclfctr(m)*soil_erod(i)/dust_emis_fact*1.15_r8 + x_mton = 6._r8 / (pi * dust_density * (dust_dmt_vwr(m)**3._r8)) + inum = dust_indices(m+dust_nbin) + cflx(i,inum) = cflx(i,idst)*x_mton + enddo + enddo col_loop1 + else ! Leung emissions + + col_loop2: do i = 1,ncol + ! rebin and adjust dust emissons. + do m = 1,dust_nbin + idst = dust_indices(m) + + cflx(i,idst) = sum( -dust_flux_in(i,:) ) & + * dust_emis_sclfctr(m) / dust_emis_fact + x_mton = 6._r8 / (pi * dust_density * (dust_dmt_vwr(m)**3._r8)) + inum = dust_indices(m+dust_nbin) + cflx(i,inum) = cflx(i,idst)*x_mton + enddo + enddo col_loop2 + end if end subroutine dust_emis diff --git a/src/chemistry/modal_aero/modal_aero_convproc.F90 b/src/chemistry/modal_aero/modal_aero_convproc.F90 deleted file mode 100644 index 9def684ec0..0000000000 --- a/src/chemistry/modal_aero/modal_aero_convproc.F90 +++ /dev/null @@ -1,3016 +0,0 @@ - -module modal_aero_convproc -!--------------------------------------------------------------------------------- -! Purpose: -! -! CAM interface to aerosol/trace-gas convective cloud processing scheme -! -! currently these routines assume stratiform and convective clouds only interact -! through the detrainment of convective cloudborne material into stratiform clouds -! -! thus the stratiform-cloudborne aerosols (in the qqcw array) are not processed -! by the convective up/downdrafts, but are affected by the detrainment -! -! Author: R. C. Easter -! -!--------------------------------------------------------------------------------- - -use shr_kind_mod, only: r8=>shr_kind_r8 -use spmd_utils, only: masterproc -use physconst, only: gravit, rair -use ppgrid, only: pver, pcols, pverp -use constituents, only: pcnst, cnst_name -use constituents, only: cnst_species_class, cnst_spec_class_aerosol, cnst_spec_class_gas -use phys_control, only: phys_getopts - -use physics_types, only: physics_state, physics_ptend -use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field - -use time_manager, only: get_nstep -use cam_history, only: outfld, addfld, add_default, horiz_only -use cam_logfile, only: iulog -use cam_abortutils, only: endrun - -use modal_aero_data, only: lmassptr_amode, nspec_amode, ntot_amode, numptr_amode -use modal_aero_data, only: lptr_so4_a_amode, lptr_dust_a_amode, lptr_nacl_a_amode, mode_size_order -use modal_aero_data, only: lptr2_pom_a_amode, lptr2_soa_a_amode, lptr2_bc_a_amode, nsoa, npoa, nbc -use modal_aero_data, only: lptr_msa_a_amode, lptr_nh4_a_amode, lptr_no3_a_amode - -use modal_aerosol_properties_mod, only: modal_aerosol_properties - -implicit none -private -save - -public :: & - ma_convproc_register, & - ma_convproc_init, & - ma_convproc_intr, & - ma_convproc_readnl - -! namelist options -! NOTE: These are the defaults for CAM6. -logical, protected, public :: convproc_do_gas = .false. -logical, protected, public :: deepconv_wetdep_history = .true. -logical, protected, public :: convproc_do_deep = .true. -! NOTE: Shallow convection processing does not currently work with CLUBB. -logical, protected, public :: convproc_do_shallow = .false. -! NOTE: These are the defaults for the Eaton/Wang parameterization. -logical, protected, public :: convproc_do_evaprain_atonce = .false. -real(r8), protected, public :: convproc_pom_spechygro = -1._r8 -real(r8), protected, public :: convproc_wup_max = 4.0_r8 - -logical, parameter :: use_cwaer_for_activate_maxsat = .false. -logical, parameter :: apply_convproc_tend_to_ptend = .true. - -real(r8) :: hund_ovr_g ! = 100.0_r8/gravit -! used with zm_conv mass fluxes and delta-p -! for mu = [mbar/s], mu*hund_ovr_g = [kg/m2/s] -! for dp = [mbar] and q = [kg/kg], q*dp*hund_ovr_g = [kg/m2] - -! method1_activate_nlayers = number of layers (including cloud base) where activation is applied -integer, parameter :: method1_activate_nlayers = 2 -! method2_activate_smaxmax = the uniform or peak supersat value (as 0-1 fraction = percent*0.01) -real(r8), parameter :: method2_activate_smaxmax = 0.003_r8 - -! method_reduce_actfrac = 1 -- multiply activation fractions by factor_reduce_actfrac -! (this works ok with convproc_method_activate = 1 but not for ... = 2) -! = 2 -- do 2 iterations to get an overall reduction by factor_reduce_actfrac -! (this works ok with convproc_method_activate = 1 or 2) -! = other -- do nothing involving reduce_actfrac -integer, parameter :: method_reduce_actfrac = 0 -real(r8), parameter :: factor_reduce_actfrac = 0.5_r8 - -! convproc_method_activate - 1=apply abdulrazzak-ghan to entrained aerosols for lowest nlayers -! 2=do secondary activation with prescribed supersat -integer, parameter :: convproc_method_activate = 2 - -logical :: convproc_do_aer - -! physics buffer indices -integer :: fracis_idx = 0 - -integer :: rprddp_idx = 0 -integer :: rprdsh_idx = 0 -integer :: nevapr_shcu_idx = 0 -integer :: nevapr_dpcu_idx = 0 - -integer :: icwmrdp_idx = 0 -integer :: icwmrsh_idx = 0 -integer :: sh_frac_idx = 0 -integer :: dp_frac_idx = 0 - -integer :: zm_mu_idx = 0 -integer :: zm_eu_idx = 0 -integer :: zm_du_idx = 0 -integer :: zm_md_idx = 0 -integer :: zm_ed_idx = 0 -integer :: zm_dp_idx = 0 -integer :: zm_dsubcld_idx = 0 -integer :: zm_jt_idx = 0 -integer :: zm_maxg_idx = 0 -integer :: zm_ideep_idx = 0 - -integer :: cmfmc_sh_idx = 0 -integer :: sh_e_ed_ratio_idx = 0 - -integer :: istat - -logical, parameter :: debug=.false. - -type(modal_aerosol_properties), pointer :: aero_props_obj => null() - -!========================================================================================= -contains -!========================================================================================= - -subroutine ma_convproc_register - -end subroutine ma_convproc_register - -!========================================================================================= -subroutine ma_convproc_readnl(nlfile) - - use namelist_utils, only: find_group_name - use spmd_utils, only: mpicom, masterprocid, mpi_real8, mpi_logical - - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - - ! Local variables - integer :: unitn, ierr - character(len=*), parameter :: subname = 'ma_convproc_readnl' - - namelist /aerosol_convproc_opts/ convproc_do_gas, deepconv_wetdep_history, convproc_do_deep, & - convproc_do_shallow, convproc_do_evaprain_atonce, convproc_pom_spechygro, convproc_wup_max - - ! Read namelist - if (masterproc) then - open( newunit=unitn, file=trim(nlfile), status='old' ) - call find_group_name(unitn, 'aerosol_convproc_opts', status=ierr) - if (ierr == 0) then - read(unitn, aerosol_convproc_opts, iostat=ierr) - if (ierr /= 0) then - call endrun(subname // ':: ERROR reading namelist') - end if - end if - close(unitn) - end if - - ! Broadcast namelist variables - call mpi_bcast( convproc_do_gas, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast( deepconv_wetdep_history, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast( convproc_do_deep, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast( convproc_do_shallow, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast( convproc_do_evaprain_atonce, 1, mpi_logical, masterprocid, mpicom, ierr) - call mpi_bcast( convproc_pom_spechygro, 1, mpi_real8, masterprocid, mpicom, ierr) - call mpi_bcast( convproc_wup_max, 1, mpi_real8, masterprocid, mpicom, ierr) - - if (masterproc) then - write(iulog,*) subname//': convproc_do_gas = ', convproc_do_gas - write(iulog,*) subname//': deepconv_wetdep_history = ',deepconv_wetdep_history - write(iulog,*) subname//': convproc_do_deep = ',convproc_do_deep - write(iulog,*) subname//': convproc_do_shallow = ',convproc_do_shallow - write(iulog,*) subname//': convproc_do_evaprain_atonce = ',convproc_do_evaprain_atonce - write(iulog,*) subname//': convproc_pom_spechygro = ',convproc_pom_spechygro - write(iulog,*) subname//': convproc_wup_max = ', convproc_wup_max - end if - -end subroutine ma_convproc_readnl - -!========================================================================================= - -subroutine ma_convproc_init - - integer :: n, l, ll - integer :: npass_calc_updraft - logical :: history_aerosol - - call phys_getopts( history_aerosol_out=history_aerosol, & - convproc_do_aer_out = convproc_do_aer ) - - call addfld('SH_MFUP_MAX', horiz_only, 'A', 'kg/m2', & - 'Shallow conv. column-max updraft mass flux' ) - call addfld('SH_WCLDBASE', horiz_only, 'A', 'm/s', & - 'Shallow conv. cloudbase vertical velocity' ) - call addfld('SH_KCLDBASE', horiz_only, 'A', '1', & - 'Shallow conv. cloudbase level index' ) - - call addfld('DP_MFUP_MAX', horiz_only, 'A', 'kg/m2', & - 'Deep conv. column-max updraft mass flux' ) - call addfld('DP_WCLDBASE', horiz_only, 'A', 'm/s', & - 'Deep conv. cloudbase vertical velocity' ) - call addfld('DP_KCLDBASE', horiz_only, 'A', '1', & - 'Deep conv. cloudbase level index' ) - - ! output wet deposition fields to history - ! I = in-cloud removal; E = precip-evap resuspension - ! C = convective (total); D = deep convective - ! note that the precip-evap resuspension includes that resulting from - ! below-cloud removal, calculated in mz_aero_wet_intr - if (convproc_do_aer .and. apply_convproc_tend_to_ptend ) then - do n = 1, ntot_amode - do ll = 0, nspec_amode(n) - if (ll == 0) then - l = numptr_amode(n) - else - l = lmassptr_amode(ll,n) - end if - - call addfld (trim(cnst_name(l))//'SFSEC', & - horiz_only, 'A','kg/m2/s','Wet deposition flux (precip evap, convective) at surface') - if (history_aerosol) then - call add_default(trim(cnst_name(l))//'SFSEC', 1, ' ') - end if - - if ( deepconv_wetdep_history ) then - call addfld (trim(cnst_name(l))//'SFSID', & - horiz_only, 'A','kg/m2/s','Wet deposition flux (incloud, deep convective) at surface') - call addfld (trim(cnst_name(l))//'SFSED', & - horiz_only, 'A','kg/m2/s','Wet deposition flux (precip evap, deep convective) at surface') - if (history_aerosol) then - call add_default(trim(cnst_name(l))//'SFSID', 1, ' ') - call add_default(trim(cnst_name(l))//'SFSED', 1, ' ') - end if - end if - end do - end do - end if - - if ( history_aerosol .and. & - ( convproc_do_aer .or. convproc_do_gas) ) then - if (convproc_do_shallow) then - call add_default( 'SH_MFUP_MAX', 1, ' ' ) - call add_default( 'SH_WCLDBASE', 1, ' ' ) - call add_default( 'SH_KCLDBASE', 1, ' ' ) - end if - if (convproc_do_deep) then - call add_default( 'DP_MFUP_MAX', 1, ' ' ) - call add_default( 'DP_WCLDBASE', 1, ' ' ) - call add_default( 'DP_KCLDBASE', 1, ' ' ) - end if - end if - - fracis_idx = pbuf_get_index('FRACIS') - - rprddp_idx = pbuf_get_index('RPRDDP') - rprdsh_idx = pbuf_get_index('RPRDSH') - nevapr_dpcu_idx = pbuf_get_index('NEVAPR_DPCU') - nevapr_shcu_idx = pbuf_get_index('NEVAPR_SHCU') - - icwmrdp_idx = pbuf_get_index('ICWMRDP') - icwmrsh_idx = pbuf_get_index('ICWMRSH') - dp_frac_idx = pbuf_get_index('DP_FRAC') - sh_frac_idx = pbuf_get_index('SH_FRAC') - - zm_mu_idx = pbuf_get_index('ZM_MU') - zm_eu_idx = pbuf_get_index('ZM_EU') - zm_du_idx = pbuf_get_index('ZM_DU') - zm_md_idx = pbuf_get_index('ZM_MD') - zm_ed_idx = pbuf_get_index('ZM_ED') - zm_dp_idx = pbuf_get_index('ZM_DP') - zm_dsubcld_idx = pbuf_get_index('ZM_DSUBCLD') - zm_jt_idx = pbuf_get_index('ZM_JT') - zm_maxg_idx = pbuf_get_index('ZM_MAXG') - zm_ideep_idx = pbuf_get_index('ZM_IDEEP') - - cmfmc_sh_idx = pbuf_get_index('CMFMC_SH') - sh_e_ed_ratio_idx = pbuf_get_index('SH_E_ED_RATIO', istat) - - if (masterproc ) then - - write(iulog,'(a,l12)') 'ma_convproc_init - convproc_do_aer = ', & - convproc_do_aer - write(iulog,'(a,l12)') 'ma_convproc_init - convproc_do_gas = ', & - convproc_do_gas - write(iulog,'(a,l12)') 'ma_convproc_init - use_cwaer_for_activate_maxsat = ', & - use_cwaer_for_activate_maxsat - write(iulog,'(a,l12)') 'ma_convproc_init - apply_convproc_tend_to_ptend = ', & - apply_convproc_tend_to_ptend - write(iulog,'(a,i12)') 'ma_convproc_init - convproc_method_activate = ', & - convproc_method_activate - write(iulog,'(a,i12)') 'ma_convproc_init - method1_activate_nlayers = ', & - method1_activate_nlayers - write(iulog,'(a,1pe12.4)') 'ma_convproc_init - method2_activate_smaxmax = ', & - method2_activate_smaxmax - write(iulog,'(a,i12)') 'ma_convproc_init - method_reduce_actfrac = ', & - method_reduce_actfrac - write(iulog,'(a,1pe12.4)') 'ma_convproc_init - factor_reduce_actfrac = ', & - factor_reduce_actfrac - - npass_calc_updraft = 1 - if ( (method_reduce_actfrac == 2) .and. & - (factor_reduce_actfrac >= 0.0_r8) .and. & - (factor_reduce_actfrac <= 1.0_r8) ) npass_calc_updraft = 2 - write(iulog,'(a,i12)') 'ma_convproc_init - npass_calc_updraft = ', & - npass_calc_updraft - - end if - - aero_props_obj => modal_aerosol_properties() - if (.not.associated(aero_props_obj)) then - call endrun('ma_convproc_init: modal_aerosol_properties constructor failed') - end if - -end subroutine ma_convproc_init - -!========================================================================================= - -subroutine ma_convproc_intr( state, ptend, pbuf, ztodt, & - nsrflx_mzaer2cnvpr, qsrflx_mzaer2cnvpr, & - aerdepwetis, dcondt_resusp3d ) -!----------------------------------------------------------------------- -! -! Convective cloud processing (transport, activation/resuspension, -! wet removal) of aerosols and trace gases. -! (Currently no aqueous chemistry and no trace-gas wet removal) -! Does aerosols when convproc_do_aer is .true. -! Does trace gases when convproc_do_gas is .true. -! -! Does deep and shallow convection -! Uses mass fluxes, cloud water, precip production from the -! convective cloud routines -! -! Author: R. Easter -! -!----------------------------------------------------------------------- - - - ! Arguments - type(physics_state), intent(in ) :: state ! Physics state variables - type(physics_ptend), intent(inout) :: ptend ! %lq set in aero_model_wetdep - type(physics_buffer_desc), pointer :: pbuf(:) - real(r8), intent(in) :: ztodt ! 2 delta t (model time increment) - - integer, intent(in) :: nsrflx_mzaer2cnvpr - real(r8), intent(in) :: qsrflx_mzaer2cnvpr(pcols,pcnst,nsrflx_mzaer2cnvpr) - real(r8), intent(inout) :: aerdepwetis(pcols,pcnst) ! aerosol wet deposition (interstitial) - real(r8), intent(inout) :: dcondt_resusp3d(2*pcnst,pcols,pver) - - ! Local variables - integer, parameter :: nsrflx = 5 ! last dimension of qsrflx - integer :: l, ll, lchnk - integer :: n, ncol - - real(r8) :: dqdt(pcols,pver,pcnst) - real(r8) :: dt - real(r8) :: qa(pcols,pver,pcnst), qb(pcols,pver,pcnst) - real(r8) :: qsrflx(pcols,pcnst,nsrflx) - real(r8) :: sflxic(pcols,pcnst) - real(r8) :: sflxid(pcols,pcnst) - real(r8) :: sflxec(pcols,pcnst) - real(r8) :: sflxed(pcols,pcnst) - - logical :: dotend(pcnst) - !------------------------------------------------------------------------------------------------- - - ! Initialize - lchnk = state%lchnk - ncol = state%ncol - dt = ztodt - - hund_ovr_g = 100.0_r8/gravit - ! used with zm_conv mass fluxes and delta-p - ! for mu = [mbar/s], mu*hund_ovr_g = [kg/m2/s] - ! for dp = [mbar] and q = [kg/kg], q*dp*hund_ovr_g = [kg/m2] - - sflxic(:,:) = 0.0_r8 - sflxid(:,:) = 0.0_r8 - sflxec(:,:) = 0.0_r8 - sflxed(:,:) = 0.0_r8 - do l = 1, pcnst - if ( (cnst_species_class(l) == cnst_spec_class_aerosol) .and. ptend%lq(l) ) then - sflxec(1:ncol,l) = qsrflx_mzaer2cnvpr(1:ncol,l,1) - sflxed(1:ncol,l) = qsrflx_mzaer2cnvpr(1:ncol,l,2) - end if - end do - - ! prepare for deep conv processing - do l = 1, pcnst - if ( ptend%lq(l) ) then - ! calc new q (after calcaersize and mz_aero_wet_intr) - qa(1:ncol,:,l) = state%q(1:ncol,:,l) + dt*ptend%q(1:ncol,:,l) - qb(1:ncol,:,l) = max( 0.0_r8, qa(1:ncol,:,l) ) - else - ! use old q - qb(1:ncol,:,l) = state%q(1:ncol,:,l) - end if - end do - dqdt(:,:,:) = 0.0_r8 - qsrflx(:,:,:) = 0.0_r8 - - if (convproc_do_aer .or. convproc_do_gas) then - - ! do deep conv processing - if (convproc_do_deep) then - call ma_convproc_dp_intr( & - state, pbuf, dt, & - qb, dqdt, dotend, nsrflx, qsrflx, dcondt_resusp3d ) - - - ! apply deep conv processing tendency and prepare for shallow conv processing - do l = 1, pcnst - if ( .not. dotend(l) ) cycle - - ! calc new q (after ma_convproc_dp_intr) - qa(1:ncol,:,l) = qb(1:ncol,:,l) + dt*dqdt(1:ncol,:,l) - qb(1:ncol,:,l) = max( 0.0_r8, qa(1:ncol,:,l) ) - - if ( apply_convproc_tend_to_ptend ) then - ! add dqdt onto ptend%q and set ptend%lq - ptend%q(1:ncol,:,l) = ptend%q(1:ncol,:,l) + dqdt(1:ncol,:,l) - ptend%lq(l) = .true. - end if - - if ((cnst_species_class(l) == cnst_spec_class_aerosol) .or. & - (cnst_species_class(l) == cnst_spec_class_gas )) then - ! these used for history file wetdep diagnostics - sflxic(1:ncol,l) = sflxic(1:ncol,l) + qsrflx(1:ncol,l,4) - sflxid(1:ncol,l) = sflxid(1:ncol,l) + qsrflx(1:ncol,l,4) - sflxec(1:ncol,l) = sflxec(1:ncol,l) + qsrflx(1:ncol,l,5) - sflxed(1:ncol,l) = sflxed(1:ncol,l) + qsrflx(1:ncol,l,5) - end if - - if (cnst_species_class(l) == cnst_spec_class_aerosol) then - ! this used for surface coupling - aerdepwetis(1:ncol,l) = aerdepwetis(1:ncol,l) & - + qsrflx(1:ncol,l,4) + qsrflx(1:ncol,l,5) - end if - end do - end if - - dqdt(:,:,:) = 0.0_r8 - qsrflx(:,:,:) = 0.0_r8 - if (convproc_do_shallow) then - call ma_convproc_sh_intr( & - state, pbuf, dt, & - qb, dqdt, dotend, nsrflx, qsrflx, dcondt_resusp3d ) - - ! apply shallow conv processing tendency - do l = 1, pcnst - if ( .not. dotend(l) ) cycle - - ! calc new q (after ma_convproc_sh_intr) - qa(1:ncol,:,l) = qb(1:ncol,:,l) + dt*dqdt(1:ncol,:,l) - qb(1:ncol,:,l) = max( 0.0_r8, qa(1:ncol,:,l) ) - - if ( apply_convproc_tend_to_ptend ) then - ! add dqdt onto ptend%q and set ptend%lq - ptend%q(1:ncol,:,l) = ptend%q(1:ncol,:,l) + dqdt(1:ncol,:,l) - ptend%lq(l) = .true. - end if - - if ((cnst_species_class(l) == cnst_spec_class_aerosol) .or. & - (cnst_species_class(l) == cnst_spec_class_gas )) then - sflxic(1:ncol,l) = sflxic(1:ncol,l) + qsrflx(1:ncol,l,4) - sflxec(1:ncol,l) = sflxec(1:ncol,l) + qsrflx(1:ncol,l,5) - end if - - if (cnst_species_class(l) == cnst_spec_class_aerosol) then - aerdepwetis(1:ncol,l) = aerdepwetis(1:ncol,l) & - + qsrflx(1:ncol,l,4) + qsrflx(1:ncol,l,5) - end if - - end do - end if - - end if ! (convproc_do_aer .or. convproc_do_gas) then - - - if (convproc_do_aer .and. apply_convproc_tend_to_ptend ) then - do n = 1, ntot_amode - do ll = 0, nspec_amode(n) - if (ll == 0) then - l = numptr_amode(n) - else - l = lmassptr_amode(ll,n) - end if - - call outfld( trim(cnst_name(l))//'SFWET', aerdepwetis(:,l), pcols, lchnk ) - call outfld( trim(cnst_name(l))//'SFSIC', sflxic(:,l), pcols, lchnk ) - call outfld( trim(cnst_name(l))//'SFSEC', sflxec(:,l), pcols, lchnk ) - - if ( deepconv_wetdep_history ) then - call outfld( trim(cnst_name(l))//'SFSID', sflxid(:,l), pcols, lchnk ) - call outfld( trim(cnst_name(l))//'SFSED', sflxed(:,l), pcols, lchnk ) - end if - end do - end do - end if - -end subroutine ma_convproc_intr - -!========================================================================================= - -subroutine ma_convproc_dp_intr( & - state, pbuf, dt, & - q, dqdt, dotend, nsrflx, qsrflx, dcondt_resusp3d) -!----------------------------------------------------------------------- -! -! Convective cloud processing (transport, activation/resuspension, -! wet removal) of aerosols and trace gases. -! (Currently no aqueous chemistry and no trace-gas wet removal) -! Does aerosols when convproc_do_aer is .true. -! Does trace gases when convproc_do_gas is .true. -! -! This routine does deep convection -! Uses mass fluxes, cloud water, precip production from the -! convective cloud routines -! -! Author: R. Easter -! -!----------------------------------------------------------------------- - - - ! Arguments - type(physics_state), intent(in ) :: state ! Physics state variables - type(physics_buffer_desc), pointer :: pbuf(:) - - real(r8), intent(in) :: dt ! delta t (model time increment) - - real(r8), intent(in) :: q(pcols,pver,pcnst) - real(r8), intent(inout) :: dqdt(pcols,pver,pcnst) - logical, intent(out) :: dotend(pcnst) - integer, intent(in) :: nsrflx - real(r8), intent(inout) :: qsrflx(pcols,pcnst,nsrflx) - real(r8), intent(inout) :: dcondt_resusp3d(pcnst*2,pcols,pver) - - integer :: i - integer :: itmpveca(pcols) - integer :: l, lchnk, lun, ncol - integer :: nstep - - real(r8) :: dpdry(pcols,pver) ! layer delta-p-dry (mb) - real(r8) :: fracice(pcols,pver) ! Ice fraction of cloud droplets - real(r8) :: qaa(pcols,pver,pcnst) - real(r8) :: xx_mfup_max(pcols), xx_wcldbase(pcols), xx_kcldbase(pcols) - - ! physics buffer fields - real(r8), pointer :: fracis(:,:,:) ! fraction of transported species that are insoluble - real(r8), pointer :: rprddp(:,:) ! Deep conv precip production (kg/kg/s - grid avg) - real(r8), pointer :: evapcdp(:,:) ! Deep conv precip evaporation (kg/kg/s - grid avg) - real(r8), pointer :: icwmrdp(:,:) ! Deep conv cloud condensate (kg/kg - in cloud) - real(r8), pointer :: dp_frac(:,:) ! Deep conv cloud frac (0-1) - ! mu, md, ..., ideep, lengath are all deep conv variables - real(r8), pointer :: mu(:,:) ! Updraft mass flux (positive) (pcols,pver) - real(r8), pointer :: md(:,:) ! Downdraft mass flux (negative) (pcols,pver) - real(r8), pointer :: du(:,:) ! Mass detrain rate from updraft (pcols,pver) - real(r8), pointer :: eu(:,:) ! Mass entrain rate into updraft (pcols,pver) - real(r8), pointer :: ed(:,:) ! Mass entrain rate into downdraft (pcols,pver) - ! eu, ed, du are "d(massflux)/dp" and are all positive - real(r8), pointer :: dp(:,:) ! Delta pressure between interfaces (pcols,pver) - real(r8), pointer :: dsubcld(:) ! Delta pressure from cloud base to sfc (pcols) - - integer, pointer :: jt(:) ! Index of cloud top for each column (pcols) - integer, pointer :: maxg(:) ! Index of cloud top for each column (pcols) - integer, pointer :: ideep(:) ! Gathering array (pcols) - integer :: lengath ! Gathered min lon indices over which to operate - - - ! Initialize - - lchnk = state%lchnk - ncol = state%ncol - nstep = get_nstep() - lun = iulog - - ! Associate pointers with physics buffer fields - call pbuf_get_field(pbuf, fracis_idx, fracis) - call pbuf_get_field(pbuf, rprddp_idx, rprddp) - call pbuf_get_field(pbuf, nevapr_dpcu_idx, evapcdp) - call pbuf_get_field(pbuf, icwmrdp_idx, icwmrdp) - call pbuf_get_field(pbuf, dp_frac_idx, dp_frac) - call pbuf_get_field(pbuf, fracis_idx, fracis) - call pbuf_get_field(pbuf, zm_mu_idx, mu) - call pbuf_get_field(pbuf, zm_eu_idx, eu) - call pbuf_get_field(pbuf, zm_du_idx, du) - call pbuf_get_field(pbuf, zm_md_idx, md) - call pbuf_get_field(pbuf, zm_ed_idx, ed) - call pbuf_get_field(pbuf, zm_dp_idx, dp) - call pbuf_get_field(pbuf, zm_dsubcld_idx, dsubcld) - call pbuf_get_field(pbuf, zm_jt_idx, jt) - call pbuf_get_field(pbuf, zm_maxg_idx, maxg) - call pbuf_get_field(pbuf, zm_ideep_idx, ideep) - - lengath = count(ideep > 0) - if (lengath > ncol) lengath = ncol ! should not happen, but force it to not be larger than ncol for safety sake - - fracice(:,:) = 0.0_r8 - - ! initialize dpdry (units=mb), which is used for tracers of dry mixing ratio type - dpdry = 0._r8 - do i = 1, lengath - dpdry(i,:) = state%pdeldry(ideep(i),:)/100._r8 - end do - - qaa = q - - ! turn on/off calculations for aerosols and trace gases - do l = 1, pcnst - dotend(l) = .false. - if (cnst_species_class(l) == cnst_spec_class_aerosol) then - if (convproc_do_aer) dotend(l) = .true. - else if (cnst_species_class(l) == cnst_spec_class_gas) then - if (convproc_do_gas) dotend(l) = .true. - end if - end do - - itmpveca(:) = -1 - - call ma_convproc_tend( & - 'deep', & - lchnk, pcnst, nstep, dt, & - state%t, state%pmid, state%pdel, qaa, & - mu, md, du, eu, & - ed, dp, dpdry, jt, & - maxg, ideep, 1, lengath, & - dp_frac, icwmrdp, rprddp, evapcdp, & - fracice, & - dqdt, dotend, nsrflx, qsrflx, & - xx_mfup_max, xx_wcldbase, xx_kcldbase, & - lun, itmpveca, dcondt_resusp3d ) - - call outfld( 'DP_MFUP_MAX', xx_mfup_max, pcols, lchnk ) - call outfld( 'DP_WCLDBASE', xx_wcldbase, pcols, lchnk ) - call outfld( 'DP_KCLDBASE', xx_kcldbase, pcols, lchnk ) - -end subroutine ma_convproc_dp_intr - - - -!========================================================================================= -subroutine ma_convproc_sh_intr( & - state, pbuf, dt, & - q, dqdt, dotend, nsrflx, qsrflx, dcondt_resusp3d ) -!----------------------------------------------------------------------- -! -! Purpose: -! Convective cloud processing (transport, activation/resuspension, -! wet removal) of aerosols and trace gases. -! (Currently no aqueous chemistry and no trace-gas wet removal) -! Does aerosols when convproc_do_aer is .true. -! Does trace gases when convproc_do_gas is .true. -! -! This routine does shallow convection -! Uses mass fluxes, cloud water, precip production from the -! convective cloud routines -! -! Author: R. Easter -! -!----------------------------------------------------------------------- - -! Arguments - type(physics_state), intent(in ) :: state ! Physics state variables - type(physics_buffer_desc), pointer :: pbuf(:) - - real(r8), intent(in) :: dt ! delta t (model time increment) - - real(r8), intent(in) :: q(pcols,pver,pcnst) - real(r8), intent(inout) :: dqdt(pcols,pver,pcnst) - logical, intent(out) :: dotend(pcnst) - integer, intent(in) :: nsrflx - real(r8), intent(inout) :: qsrflx(pcols,pcnst,nsrflx) - real(r8), intent(inout) :: dcondt_resusp3d(pcnst*2,pcols,pver) - - integer :: i - integer :: itmpveca(pcols) - integer :: k, kaa, kbb, kk - integer :: l, lchnk, lun - integer :: maxg_minval - integer :: ncol, nstep - - real(r8) :: dpdry(pcols,pver) ! layer delta-p-dry (mb) - real(r8) :: fracice(pcols,pver) ! Ice fraction of cloud droplets - real(r8) :: qaa(pcols,pver,pcnst) - real(r8) :: tmpa, tmpb - real(r8) :: xx_mfup_max(pcols), xx_wcldbase(pcols), xx_kcldbase(pcols) - - ! variables that mimic the zm-deep counterparts - real(r8) :: mu(pcols,pver) ! Updraft mass flux (positive) - real(r8) :: md(pcols,pver) ! Downdraft mass flux (negative) - real(r8) :: du(pcols,pver) ! Mass detrain rate from updraft - real(r8) :: eu(pcols,pver) ! Mass entrain rate into updraft - real(r8) :: ed(pcols,pver) ! Mass entrain rate into downdraft - ! eu, ed, du are "d(massflux)/dp" and are all positive - real(r8) :: dp(pcols,pver) ! Delta pressure between interfaces - - integer :: jt(pcols) ! Index of cloud top for each column - integer :: maxg(pcols) ! Index of cloud bot for each column - integer :: ideep(pcols) ! Gathering array - integer :: lengath ! Gathered min lon indices over which to operate - - ! physics buffer fields - real(r8), pointer :: rprdsh(:,:) ! Shallow conv precip production (kg/kg/s - grid avg) - real(r8), pointer :: evapcsh(:,:) ! Shal conv precip evaporation (kg/kg/s - grid avg) - real(r8), pointer :: icwmrsh(:,:) ! Shal conv cloud condensate (kg/kg - in cloud) - real(r8), pointer :: sh_frac(:,:) ! Shal conv cloud frac (0-1) - - real(r8), pointer :: cmfmcsh(:,:) ! Shallow conv mass flux (pcols,pverp) (kg/m2/s) - real(r8), pointer :: sh_e_ed_ratio(:,:) ! shallow conv [ent/(ent+det)] ratio (pcols,pver) - - ! Initialize - - lchnk = state%lchnk - ncol = state%ncol - nstep = get_nstep() - lun = iulog - - ! Associate pointers with physics buffer fields - call pbuf_get_field(pbuf, rprdsh_idx, rprdsh) - call pbuf_get_field(pbuf, nevapr_shcu_idx, evapcsh) - call pbuf_get_field(pbuf, icwmrsh_idx, icwmrsh) - call pbuf_get_field(pbuf, sh_frac_idx, sh_frac) - call pbuf_get_field(pbuf, cmfmc_sh_idx, cmfmcsh) - if (sh_e_ed_ratio_idx .gt. 0) then - call pbuf_get_field(pbuf, sh_e_ed_ratio_idx, sh_e_ed_ratio) - end if - - fracice(:,:) = 0.0_r8 - - ! create mass flux, entrainment, detrainment, and delta-p arrays - ! with same units as the zm-deep - mu(:,:) = 0.0_r8 - md(:,:) = 0.0_r8 - du(:,:) = 0.0_r8 - eu(:,:) = 0.0_r8 - ed(:,:) = 0.0_r8 - jt(:) = -1 - maxg(:) = -1 - ideep(:) = -1 - lengath = ncol - maxg_minval = pver*2 - - ! these dp and dpdry have units of mb - dpdry(1:ncol,:) = state%pdeldry(1:ncol,:)/100._r8 - dp( 1:ncol,:) = state%pdel( 1:ncol,:)/100._r8 - - do i = 1, ncol - ideep(i) = i - - ! load updraft mass flux from cmfmcsh - kk = 0 - do k = 2, pver - ! if mass-flux < 1e-7 kg/m2/s ~= 1e-7 m/s ~= 1 cm/day, treat as zero - if (cmfmcsh(i,k) >= 1.0e-7_r8) then - ! mu has units of mb/s - mu(i,k) = cmfmcsh(i,k) / hund_ovr_g - kk = kk + 1 - if (kk == 1) jt(i) = k - 1 - maxg(i) = k - end if - end do - if (kk <= 0) cycle ! current column has no convection - - ! extend below-cloud source region downwards (how far?) - maxg_minval = min( maxg_minval, maxg(i) ) - kaa = maxg(i) - kbb = min( kaa+4, pver ) - ! kbb = pver - if (kbb > kaa) then - tmpa = sum( dpdry(i,kaa:kbb) ) - do k = kaa+1, kbb - mu(i,k) = mu(i,kaa)*sum( dpdry(i,k:kbb) )/tmpa - end do - maxg(i) = kbb - end if - - ! calc ent / detrainment, using the [ent/(ent+det)] ratio from uw scheme - ! which is equal to [fer_out/(fer_out+fdr_out)] (see uwshcu.F90) - ! - ! note that the ratio is set to -1.0 (invalid) when both fer and fdr are very small - ! and the ratio values are often strange (??) at topmost layer - ! - ! for initial testing, impose a limit of - ! entrainment <= 4 * (net entrainment), OR - ! detrainment <= 4 * (net detrainment) - do k = jt(i), maxg(i) - if (k < pver) then - tmpa = (mu(i,k) - mu(i,k+1))/dpdry(i,k) - else - tmpa = mu(i,k)/dpdry(i,k) - end if - if (sh_e_ed_ratio_idx .gt. 0) then - tmpb = sh_e_ed_ratio(i,k) - else - tmpb = -1.0_r8 ! force ent only or det only - end if - if (tmpb < -1.0e-5_r8) then - ! do ent only or det only - if (tmpa >= 0.0_r8) then - ! net entrainment - eu(i,k) = tmpa - else - ! net detrainment - du(i,k) = -tmpa - end if - else - if (tmpa >= 0.0_r8) then - ! net entrainment - if (k >= kaa .or. tmpb < 0.0_r8) then - ! layers at/below initial maxg, or sh_e_ed_ratio is invalid - eu(i,k) = tmpa - else - tmpb = max( tmpb, 0.571_r8 ) - eu(i,k) = tmpa*(tmpb/(2.0_r8*tmpb - 1.0_r8)) - du(i,k) = eu(i,k) - tmpa - end if - else - ! net detrainment - tmpa = -tmpa - if (k <= jt(i) .or. tmpb < 0.0_r8) then - ! layers at/above jt (where ratio is strange??), or sh_e_ed_ratio is invalid - du(i,k) = tmpa - else - tmpb = min( tmpb, 0.429_r8 ) - du(i,k) = tmpa*(1.0_r8 - tmpb)/(1.0_r8 - 2.0_r8*tmpb) - eu(i,k) = du(i,k) - tmpa - end if - end if - end if - end do ! k - - end do ! i - - qaa = q - - ! turn on/off calculations for aerosols and trace gases - do l = 1, pcnst - dotend(l) = .false. - if (cnst_species_class(l) == cnst_spec_class_aerosol) then - if (convproc_do_aer) dotend(l) = .true. - else if (cnst_species_class(l) == cnst_spec_class_gas) then - if (convproc_do_gas) dotend(l) = .true. - end if - end do - - - itmpveca(:) = -1 - - call ma_convproc_tend( & - 'uwsh', & - lchnk, pcnst, nstep, dt, & - state%t, state%pmid, state%pdel, qaa, & - mu, md, du, eu, & - ed, dp, dpdry, jt, & - maxg, ideep, 1, lengath, & - sh_frac, icwmrsh, rprdsh, evapcsh, & - fracice, & - dqdt, dotend, nsrflx, qsrflx, & - xx_mfup_max, xx_wcldbase, xx_kcldbase, & - lun, itmpveca, dcondt_resusp3d) - - call outfld( 'SH_MFUP_MAX', xx_mfup_max, pcols, lchnk ) - call outfld( 'SH_WCLDBASE', xx_wcldbase, pcols, lchnk ) - call outfld( 'SH_KCLDBASE', xx_kcldbase, pcols, lchnk ) - -end subroutine ma_convproc_sh_intr - -!========================================================================================= - -subroutine ma_convproc_tend( & - convtype, & - lchnk, ncnst, nstep, dt, & - t, pmid, pdel, q, & - mu, md, du, eu, & - ed, dp, dpdry, jt, & - mx, ideep, il1g, il2g, & - cldfrac, icwmr, rprd, evapc, & - fracice, & - dqdt, doconvproc, nsrflx, qsrflx, & - xx_mfup_max, xx_wcldbase, xx_kcldbase, & - lun, idiag_in, dcondt_resusp3d ) - -!----------------------------------------------------------------------- -! -! Purpose: -! Convective transport of trace species. -! The trace species need not be conservative, and source/sink terms for -! activation, resuspension, aqueous chemistry and gas uptake, and -! wet removal are all applied. -! Currently this works with the ZM deep convection, but we should be able -! to adapt it for both Hack and McCaa shallow convection -! -! -! Compare to subr convproc which does conservative trace species. -! -! A distinction between "moist" and "dry" mixing ratios is not currently made. -! (P. Rasch comment: Note that we are still assuming that the tracers are -! in a moist mixing ratio this will change soon) - -! -! Method: -! Computes tracer mixing ratios in updraft and downdraft "cells" in a -! Lagrangian manner, with source/sinks applied in the updraft other. -! Then computes grid-cell-mean tendencies by considering -! updraft and downdraft fluxes across layer boundaries -! environment subsidence/lifting fluxes across layer boundaries -! sources and sinks in the updraft -! resuspension of activated species in the grid-cell as a whole -! -! Note1: A better estimate or calculation of either the updraft velocity -! or fractional area is needed. -! Note2: If updraft area is a small fraction of over cloud area, -! then aqueous chemistry is underestimated. These are both -! research areas. -! -! Authors: O. Seland and R. Easter, based on convtran by P. Rasch -! -!----------------------------------------------------------------------- - - use modal_aero_data, only: cnst_name_cw, & - lmassptr_amode, lmassptrcw_amode, & - ntot_amode, ntot_amode, & - nspec_amode, numptr_amode, numptrcw_amode - - implicit none - -!----------------------------------------------------------------------- -! -! Input arguments -! - character(len=*), intent(in) :: convtype ! identifies the type of - ! convection ("deep", "shcu") - integer, intent(in) :: lchnk ! chunk identifier - integer, intent(in) :: ncnst ! number of tracers to transport - integer, intent(in) :: nstep ! Time step index - real(r8), intent(in) :: dt ! Model timestep - real(r8), intent(in) :: t(pcols,pver) ! Temperature - real(r8), intent(in) :: pmid(pcols,pver) ! Pressure at model levels - real(r8), intent(in) :: pdel(pcols,pver) ! Pressure thickness of levels - real(r8), intent(in) :: q(pcols,pver,ncnst) ! Tracer array including moisture - - real(r8), intent(in) :: mu(pcols,pver) ! Updraft mass flux (positive) - real(r8), intent(in) :: md(pcols,pver) ! Downdraft mass flux (negative) - real(r8), intent(in) :: du(pcols,pver) ! Mass detrain rate from updraft - real(r8), intent(in) :: eu(pcols,pver) ! Mass entrain rate into updraft - real(r8), intent(in) :: ed(pcols,pver) ! Mass entrain rate into downdraft -! *** note1 - mu, md, eu, ed, du, dp, dpdry are GATHERED ARRAYS *** -! *** note2 - mu and md units are (mb/s), which is used in the zm_conv code -! - eventually these should be changed to (kg/m2/s) -! *** note3 - eu, ed, du are "d(massflux)/dp" (with dp units = mb), and are all >= 0 - - real(r8), intent(in) :: dp(pcols,pver) ! Delta pressure between interfaces (mb) - real(r8), intent(in) :: dpdry(pcols,pver) ! Delta dry-pressure (mb) -! real(r8), intent(in) :: dsubcld(pcols) ! Delta pressure from cloud base to sfc - integer, intent(in) :: jt(pcols) ! Index of cloud top for each column - integer, intent(in) :: mx(pcols) ! Index of cloud top for each column - integer, intent(in) :: ideep(pcols) ! Gathering array indices - integer, intent(in) :: il1g ! Gathered min lon indices over which to operate - integer, intent(in) :: il2g ! Gathered max lon indices over which to operate -! *** note4 -- for il1g <= i <= il2g, icol = ideep(i) is the "normal" chunk column index - - real(r8), intent(in) :: cldfrac(pcols,pver) ! Convective cloud fractional area - real(r8), intent(in) :: icwmr(pcols,pver) ! Convective cloud water from zhang - real(r8), intent(in) :: rprd(pcols,pver) ! Convective precipitation formation rate - real(r8), intent(in) :: evapc(pcols,pver) ! Convective precipitation evaporation rate - real(r8), intent(in) :: fracice(pcols,pver) ! Ice fraction of cloud droplets - - real(r8), intent(out):: dqdt(pcols,pver,ncnst) ! Tracer tendency array - logical, intent(in) :: doconvproc(ncnst) ! flag for doing convective transport - integer, intent(in) :: nsrflx ! last dimension of qsrflx - real(r8), intent(out):: qsrflx(pcols,pcnst,nsrflx) - ! process-specific column tracer tendencies - ! (1=activation, 2=resuspension, 3=aqueous rxn, - ! 4=wet removal, 5=renaming) - real(r8), intent(out) :: xx_mfup_max(pcols) - real(r8), intent(out) :: xx_wcldbase(pcols) - real(r8), intent(out) :: xx_kcldbase(pcols) - integer, intent(in) :: lun ! unit number for diagnostic output - integer, intent(in) :: idiag_in(pcols) ! flag for diagnostic output - real(r8), intent(inout) :: dcondt_resusp3d(pcnst*2,pcols,pver) - -!--------------------------Local Variables------------------------------ - -! cloudborne aerosol, so the arrays are dimensioned with pcnst_extd = pcnst*2 - integer, parameter :: pcnst_extd = pcnst*2 - - integer :: i, icol ! Work index - integer :: iconvtype ! 1=deep, 2=uw shallow - integer :: idiag_act ! Work index - integer :: iflux_method ! 1=as in convtran (deep), 2=simpler - integer :: ipass_calc_updraft - integer :: itmpa, itmpb ! Work variable - integer :: j, jtsub ! Work index - integer :: k ! Work index - integer :: kactcnt ! Counter for no. of levels having activation - integer :: kactcntb ! Counter for activation diagnostic output - integer :: kactfirst ! Lowest layer with activation (= cloudbase) - integer :: kbot ! Cloud-flux bottom layer for current i (=mx(i)) - integer :: kbot_prevap ! Lowest layer for doing resuspension from evaporating precip - integer :: ktop ! Cloud-flux top layer for current i (=jt(i)) - ! Layers between kbot,ktop have mass fluxes - ! but not all have cloud water, because the - ! updraft starts below the cloud base - integer :: km1, km1x ! Work index - integer :: kp1, kp1x ! Work index - integer :: l, ll, la, lc ! Work index - integer :: m, n ! Work index - integer :: merr ! number of errors (i.e., failed diagnostics) - ! for current column - integer :: nerr ! number of errors for entire run - integer :: nerrmax ! maximum number of errors to report - integer :: ncnst_extd - integer :: npass_calc_updraft - integer :: ntsub ! - - logical do_act_this_lev ! flag for doing activation at current level - logical doconvproc_extd(pcnst_extd) ! flag for doing convective transport - - real(r8) aqfrac(pcnst_extd) ! aqueous fraction of constituent in updraft - real(r8) cldfrac_i(pver) ! cldfrac at current i (with adjustments) - - real(r8) chat(pcnst_extd,pverp) ! mix ratio in env at interfaces - real(r8) cond(pcnst_extd,pverp) ! mix ratio in downdraft at interfaces - real(r8) const(pcnst_extd,pver) ! gathered tracer array - real(r8) conu(pcnst_extd,pverp) ! mix ratio in updraft at interfaces - - real(r8) dcondt(pcnst_extd,pver) ! grid-average TMR tendency for current column - real(r8) dcondt_prevap(pcnst_extd,pver) ! portion of dcondt from precip evaporation - real(r8) dcondt_resusp(pcnst_extd,pver) ! portion of dcondt from resuspension - - real(r8) dcondt_wetdep(pcnst_extd,pver) ! portion of dcondt from wet deposition - real(r8) dconudt_activa(pcnst_extd,pverp) ! d(conu)/dt by activation - real(r8) dconudt_aqchem(pcnst_extd,pverp) ! d(conu)/dt by aqueous chem - real(r8) dconudt_wetdep(pcnst_extd,pverp) ! d(conu)/dt by wet removal - - real(r8) maxflux(pcnst_extd) ! maximum (over layers) of fluxin and fluxout - real(r8) maxflux2(pcnst_extd) ! ditto but computed using method-2 fluxes - real(r8) maxprevap(pcnst_extd) ! maximum (over layers) of dcondt_prevap*dp - real(r8) maxresusp(pcnst_extd) ! maximum (over layers) of dcondt_resusp*dp - real(r8) maxsrce(pcnst_extd) ! maximum (over layers) of netsrce - - real(r8) sumflux(pcnst_extd) ! sum (over layers) of netflux - real(r8) sumflux2(pcnst_extd) ! ditto but computed using method-2 fluxes - real(r8) sumsrce(pcnst_extd) ! sum (over layers) of dp*netsrce - real(r8) sumchng(pcnst_extd) ! sum (over layers) of dp*dcondt - real(r8) sumchng3(pcnst_extd) ! ditto but after call to resusp_conv - real(r8) sumactiva(pcnst_extd) ! sum (over layers) of dp*dconudt_activa - real(r8) sumaqchem(pcnst_extd) ! sum (over layers) of dp*dconudt_aqchem - real(r8) sumprevap(pcnst_extd) ! sum (over layers) of dp*dcondt_prevap - real(r8) sumresusp(pcnst_extd) ! sum (over layers) of dp*dcondt_resusp - real(r8) sumwetdep(pcnst_extd) ! sum (over layers) of dp*dconudt_wetdep - - real(r8) cabv ! mix ratio of constituent above - real(r8) cbel ! mix ratio of constituent below - real(r8) cdifr ! normalized diff between cabv and cbel - real(r8) cdt(pver) ! (in-updraft first order wet removal rate) * dt - real(r8) clw_cut ! threshold clw value for doing updraft - ! transformation and removal - real(r8) courantmax ! maximum courant no. - real(r8) dddp(pver) ! dd(i,k)*dp(i,k) at current i - real(r8) dp_i(pver) ! dp(i,k) at current i - real(r8) dt_u(pver) ! lagrangian transport time in the updraft - real(r8) dudp(pver) ! du(i,k)*dp(i,k) at current i - real(r8) dqdt_i(pver,pcnst) ! dqdt(i,k,m) at current i - real(r8) dtsub ! dt/ntsub - real(r8) dz ! working layer thickness (m) - real(r8) eddp(pver) ! ed(i,k)*dp(i,k) at current i - real(r8) eudp(pver) ! eu(i,k)*dp(i,k) at current i - real(r8) expcdtm1 ! a work variable - real(r8) fa_u(pver) ! fractional area of in the updraft - real(r8) fa_u_dp ! current fa_u(k)*dp_i(k) - real(r8) f_ent ! fraction of the "before-detrainment" updraft - ! massflux at k/k-1 interface resulting from - ! entrainment of level k air - real(r8) fluxin ! a work variable - real(r8) fluxout ! a work variable - real(r8) maxc ! a work variable - real(r8) mbsth ! Threshold for mass fluxes - real(r8) minc ! a work variable - real(r8) md_m_eddp ! a work variable - real(r8) md_i(pverp) ! md(i,k) at current i (note pverp dimension) - real(r8) md_x(pverp) ! md(i,k) at current i (note pverp dimension) - real(r8) mu_i(pverp) ! mu(i,k) at current i (note pverp dimension) - real(r8) mu_x(pverp) ! mu(i,k) at current i (note pverp dimension) - ! md_i, md_x, mu_i, mu_x are all "dry" mass fluxes - ! the mu_x/md_x are initially calculated from the incoming mu/md by applying dp/dpdry - ! the mu_i/md_i are next calculated by applying the mbsth threshold - real(r8) mu_p_eudp(pver) ! = mu_i(kp1) + eudp(k) - real(r8) netflux ! a work variable - real(r8) netsrce ! a work variable - real(r8) q_i(pver,pcnst) ! q(i,k,m) at current i - real(r8) qsrflx_i(pcnst,nsrflx) ! qsrflx(i,m,n) at current i - real(r8) relerr_cut ! relative error criterion for diagnostics - real(r8) rhoair_i(pver) ! air density at current i - real(r8) small ! a small number - real(r8) tmpa, tmpb ! work variables - real(r8) tmpf ! work variables - real(r8) tmpveca(pcnst_extd) ! work variables - real(r8) tmpmata(pcnst_extd,3) ! work variables - real(r8) xinv_ntsub ! 1.0/ntsub - real(r8) wup(pver) ! working updraft velocity (m/s) - - real(r8) :: dcondt2(pcols,pver,pcnst_extd) - real(r8) :: conu2(pcols,pver,pcnst_extd) - - character(len=16) :: cnst_name_extd(pcnst_extd) - - !Fractional area of ensemble mean updrafts in ZM scheme set to 0.01 - !Chosen to reproduce vertical vecocities in GATEIII GIGALES (Khairoutdinov etal 2009, JAMES) - real(r8), parameter :: zm_areafrac = 0.01_r8 -!----------------------------------------------------------------------- -! - -! if (nstep > 1) call endrun() - - if (convtype == 'deep') then - iconvtype = 1 - iflux_method = 1 - else if (convtype == 'uwsh') then - iconvtype = 2 - iflux_method = 2 - else - call endrun( '*** ma_convproc_tend -- convtype is not |deep| or |uwsh|' ) - end if - - nerr = 0 - nerrmax = 99 - - ncnst_extd = pcnst_extd - dcondt_resusp3d(:,:,:) = 0._r8 - - small = 1.e-36_r8 -! mbsth is the threshold below which we treat the mass fluxes as zero (in mb/s) - mbsth = 1.e-15_r8 - - qsrflx(:,:,:) = 0.0_r8 - dqdt(:,:,:) = 0.0_r8 - xx_mfup_max(:) = 0.0_r8 - xx_wcldbase(:) = 0.0_r8 - xx_kcldbase(:) = 0.0_r8 - - wup(:) = 0.0_r8 - - dcondt2 = 0.0_r8 - conu2 = 0.0_r8 - -! set doconvproc_extd (extended array) values -! inititialize aqfrac to 1.0 for activated aerosol species, 0.0 otherwise - doconvproc_extd(:) = .false. - doconvproc_extd(2:ncnst) = doconvproc(2:ncnst) - aqfrac(:) = 0.0_r8 - do n = 1, ntot_amode - do ll = 0, nspec_amode(n) - if (ll == 0) then - la = numptr_amode(n) - lc = numptrcw_amode(n) + pcnst - else - la = lmassptr_amode(ll,n) - lc = lmassptrcw_amode(ll,n) + pcnst - end if - if ( doconvproc(la) ) then - doconvproc_extd(lc) = .true. - aqfrac(lc) = 1.0_r8 - end if - enddo - enddo ! n - - do l = 1, pcnst_extd - if (l <= pcnst) then - cnst_name_extd(l) = cnst_name(l) - else - cnst_name_extd(l) = cnst_name_cw(l-pcnst) - end if - end do - - -! Loop ever each column that has convection -! *** i is index to gathered arrays; ideep(i) is index to "normal" chunk arrays -i_loop_main_aa: & - do i = il1g, il2g - icol = ideep(i) - - - if ( (jt(i) <= 0) .and. (mx(i) <= 0) .and. (iconvtype /= 1) ) then -! shallow conv case with jt,mx <= 0, which means there is no shallow conv -! in this column -- skip this column - cycle i_loop_main_aa - - else if ( (jt(i) < 1) .or. (mx(i) > pver) .or. (jt(i) > mx(i)) ) then -! invalid cloudtop and cloudbase indices -- skip this column - write(lun,9010) 'illegal jt, mx', convtype, lchnk, icol, i, & - jt(i), mx(i) -9010 format( '*** ma_convproc_tend error -- ', a, 5x, 'convtype = ', a / & - '*** lchnk, icol, il, jt, mx = ', 5(1x,i10) ) - cycle i_loop_main_aa - - else if (jt(i) == mx(i)) then -! cloudtop = cloudbase (1 layer cloud) -- skip this column - write(lun,9010) 'jt == mx', convtype, lchnk, icol, i, jt(i), mx(i) - cycle i_loop_main_aa - - end if - - -! -! cloudtop and cloudbase indices are valid so proceed with calculations -! - -! Load dp_i and cldfrac_i, and calc rhoair_i - do k = 1, pver - dp_i(k) = dpdry(i,k) - cldfrac_i(k) = cldfrac(icol,k) - rhoair_i(k) = pmid(icol,k)/(rair*t(icol,k)) - end do - -! Calc dry mass fluxes -! This is approximate because the updraft air is has different temp and qv than -! the grid mean, but the whole convective parameterization is highly approximate - mu_x(:) = 0.0_r8 - md_x(:) = 0.0_r8 -! (eu-du) = d(mu)/dp -- integrate upwards, multiplying by dpdry - do k = pver, 1, -1 - mu_x(k) = mu_x(k+1) + (eu(i,k)-du(i,k))*dp_i(k) - xx_mfup_max(icol) = max( xx_mfup_max(icol), mu_x(k) ) - end do -! (ed) = d(md)/dp -- integrate downwards, multiplying by dpdry - do k = 2, pver - md_x(k) = md_x(k-1) - ed(i,k-1)*dp_i(k-1) - end do - -! Load mass fluxes over cloud layers -! (Note - use of arrays dimensioned k=1,pver+1 simplifies later coding) -! Zero out values below threshold -! Zero out values at "top of cloudtop", "base of cloudbase" - ktop = jt(i) - kbot = mx(i) -! usually the updraft ( & downdraft) start ( & end ) at kbot=pver, but sometimes kbot < pver -! transport, activation, resuspension, and wet removal only occur between kbot >= k >= ktop -! resuspension from evaporating precip can occur at k > kbot when kbot < pver - kbot_prevap = pver - mu_i(:) = 0.0_r8 - md_i(:) = 0.0_r8 - do k = ktop+1, kbot - mu_i(k) = mu_x(k) - if (mu_i(k) <= mbsth) mu_i(k) = 0.0_r8 - md_i(k) = md_x(k) - if (md_i(k) >= -mbsth) md_i(k) = 0.0_r8 - end do - mu_i(ktop) = 0.0_r8 - md_i(ktop) = 0.0_r8 - mu_i(kbot+1) = 0.0_r8 - md_i(kbot+1) = 0.0_r8 - -! Compute updraft and downdraft "entrainment*dp" from eu and ed -! Compute "detrainment*dp" from mass conservation - eudp(:) = 0.0_r8 - dudp(:) = 0.0_r8 - eddp(:) = 0.0_r8 - dddp(:) = 0.0_r8 - courantmax = 0.0_r8 - do k = ktop, kbot - if ((mu_i(k) > 0) .or. (mu_i(k+1) > 0)) then - if (du(i,k) <= 0.0_r8) then - eudp(k) = mu_i(k) - mu_i(k+1) - else - eudp(k) = max( eu(i,k)*dp_i(k), 0.0_r8 ) - dudp(k) = (mu_i(k+1) + eudp(k)) - mu_i(k) - if (dudp(k) < 1.0e-12_r8*eudp(k)) then - eudp(k) = mu_i(k) - mu_i(k+1) - dudp(k) = 0.0_r8 - end if - end if - end if - if ((md_i(k) < 0) .or. (md_i(k+1) < 0)) then - eddp(k) = max( ed(i,k)*dp_i(k), 0.0_r8 ) - dddp(k) = (md_i(k+1) + eddp(k)) - md_i(k) - if (dddp(k) < 1.0e-12_r8*eddp(k)) then - eddp(k) = md_i(k) - md_i(k+1) - dddp(k) = 0.0_r8 - end if - end if -! courantmax = max( courantmax, (eudp(k)+eddp(k))*dt/dp_i(k) ) ! old version - incorrect - courantmax = max( courantmax, ( mu_i(k+1)+eudp(k)-md_i(k)+eddp(k) )*dt/dp_i(k) ) - end do ! k - -! number of time substeps needed to maintain "courant number" <= 1 - ntsub = 1 - if (courantmax > (1.0_r8 + 1.0e-6_r8)) then - ntsub = 1 + int( courantmax ) - end if - xinv_ntsub = 1.0_r8/ntsub - dtsub = dt*xinv_ntsub - courantmax = courantmax*xinv_ntsub - -! load tracer mixing ratio array, which will be updated at the end of each jtsub interation - q_i(1:pver,1:pcnst) = q(icol,1:pver,1:pcnst) - - do m = 1,pcnst - conu2(icol,1:pver,m) = q(icol,1:pver,m) - end do - -! -! when method_reduce_actfrac = 2, need to do the updraft calc twice -! (1st to get non-adjusted activation amount, 2nd to apply reduction factor) - npass_calc_updraft = 1 - if ( (method_reduce_actfrac == 2) .and. & - (factor_reduce_actfrac >= 0.0_r8) .and. & - (factor_reduce_actfrac <= 1.0_r8) ) npass_calc_updraft = 2 - - -jtsub_loop_main_aa: & - do jtsub = 1, ntsub - - -ipass_calc_updraft_loop: & - do ipass_calc_updraft = 1, npass_calc_updraft - - - if (idiag_in(icol) > 0) & - write(lun,'(/a,3x,a,1x,i9,5i5)') 'qakr - convtype,lchnk,i,jt,mx,jtsub,ipass=', & - trim(convtype), lchnk, icol, jt(i), mx(i), jtsub, ipass_calc_updraft - - qsrflx_i(:,:) = 0.0_r8 - dqdt_i(:,:) = 0.0_r8 - - const(:,:) = 0.0_r8 ! zero cloud-phase species - chat(:,:) = 0.0_r8 ! zero cloud-phase species - conu(:,:) = 0.0_r8 - cond(:,:) = 0.0_r8 - - dcondt(:,:) = 0.0_r8 - dcondt_resusp(:,:) = 0.0_r8 - dcondt_wetdep(:,:) = 0.0_r8 - dcondt_prevap(:,:) = 0.0_r8 - dconudt_aqchem(:,:) = 0.0_r8 - dconudt_wetdep(:,:) = 0.0_r8 -! only initialize the activation tendency on ipass=1 - if (ipass_calc_updraft == 1) dconudt_activa(:,:) = 0.0_r8 - -! initialize mixing ratio arrays (chat, const, conu, cond) - do m = 2, ncnst - if ( doconvproc_extd(m) ) then - -! Gather up the constituent - do k = 1,pver - const(m,k) = q_i(k,m) - end do - -! From now on work only with gathered data -! Interpolate environment tracer values to interfaces - do k = 1,pver - km1 = max(1,k-1) - minc = min(const(m,km1),const(m,k)) - maxc = max(const(m,km1),const(m,k)) - if (minc < 0) then - cdifr = 0._r8 - else - cdifr = abs(const(m,k)-const(m,km1))/max(maxc,small) - endif - -! If the two layers differ significantly use a geometric averaging procedure -! But only do that for deep convection. For shallow, use the simple -! averaging which is used in subr cmfmca - if (iconvtype /= 1) then - chat(m,k) = 0.5_r8* (const(m,k)+const(m,km1)) - else if (cdifr > 1.E-6_r8) then -! if (cdifr > 1.E-6) then - cabv = max(const(m,km1),maxc*1.e-12_r8) - cbel = max(const(m,k),maxc*1.e-12_r8) - chat(m,k) = log(cabv/cbel)/(cabv-cbel)*cabv*cbel - else ! Small diff, so just arithmetic mean - chat(m,k) = 0.5_r8* (const(m,k)+const(m,km1)) - end if - -! Set provisional up and down draft values, and tendencies - conu(m,k) = chat(m,k) - cond(m,k) = chat(m,k) - end do ! k - -! Values at surface inferface == values in lowest layer - chat(m,pver+1) = const(m,pver) - conu(m,pver+1) = const(m,pver) - cond(m,pver+1) = const(m,pver) - end if - end do ! m - - - - -! Compute updraft mixing ratios from cloudbase to cloudtop -! No special treatment is needed at k=pver because arrays -! are dimensioned 1:pver+1 -! A time-split approach is used. First, entrainment is applied to produce -! an initial conu(m,k) from conu(m,k+1). Next, chemistry/physics are -! applied to the initial conu(m,k) to produce a final conu(m,k). -! Detrainment from the updraft uses this final conu(m,k). -! Note that different time-split approaches would give somewhat different -! results - kactcnt = 0 ; kactcntb = 0 ; kactfirst = 1 -k_loop_main_bb: & - do k = kbot, ktop, -1 - kp1 = k+1 - -! cldfrac = conv cloud fractional area. This could represent anvil cirrus area, -! and may not useful for aqueous chem and wet removal calculations - cldfrac_i(k) = max( cldfrac_i(k), 0.005_r8 ) -! mu_p_eudp(k) = updraft massflux at k, without detrainment between kp1,k - mu_p_eudp(k) = mu_i(kp1) + eudp(k) - - fa_u(k) = 0.0_r8 !BSINGH(10/15/2014): Initialized so that it has a value if the following "if" check yeilds .false. - if (mu_p_eudp(k) > mbsth) then -! if (mu_p_eudp(k) <= mbsth) the updraft mass flux is negligible at base and top -! of current layer, -! so current layer is a "gap" between two unconnected updrafts, -! so essentially skip all the updraft calculations for this layer - -! First apply changes from entrainment - f_ent = eudp(k)/mu_p_eudp(k) - f_ent = max( 0.0_r8, min( 1.0_r8, f_ent ) ) - tmpa = 1.0_r8 - f_ent - do m = 2, ncnst_extd - if (doconvproc_extd(m)) then - conu(m,k) = tmpa*conu(m,kp1) + f_ent*const(m,k) - end if - end do - -! estimate updraft velocity (wup) - if (iconvtype /= 1) then -! shallow - wup = (mup in kg/m2/s) / [rhoair * (updraft area)] - wup(k) = (mu_i(kp1) + mu_i(k))*0.5_r8*hund_ovr_g & - / (rhoair_i(k) * (cldfrac_i(k)*0.5_r8)) - else -! deep - as in shallow, but assumed constant updraft_area with height zm_areafrac - wup(k) = (mu_i(kp1) + mu_i(k))*0.5_r8*hund_ovr_g & - / (rhoair_i(k) * zm_areafrac) - end if - -! compute lagrangian transport time (dt_u) and updraft fractional area (fa_u) -! *** these must obey dt_u(k)*mu_p_eudp(k) = dp_i(k)*fa_u(k) - dz = dp_i(k)*hund_ovr_g/rhoair_i(k) - dt_u(k) = dz/wup(k) - dt_u(k) = min( dt_u(k), dt ) - fa_u(k) = dt_u(k)*(mu_p_eudp(k)/dp_i(k)) - - -! Now apply transformation and removal changes -! Skip levels where icwmr(icol,k) <= clw_cut (= 1.0e-6) to eliminate -! occasional very small icwmr values from the ZM module - clw_cut = 1.0e-6_r8 - - - if (convproc_method_activate <= 1) then -! aerosol activation - method 1 -! skip levels that are completely glaciated (fracice(icol,k) == 1.0) -! when kactcnt=1 (first/lowest layer with cloud water) apply -! activatation to the entire updraft -! when kactcnt>1 apply activatation to the amount entrained at this level - if ((icwmr(icol,k) > clw_cut) .and. (fracice(icol,k) < 1.0_r8)) then - kactcnt = kactcnt + 1 - - idiag_act = idiag_in(icol) - if ((kactcnt == 1) .or. (f_ent > 0.0_r8)) then - kactcntb = kactcntb + 1 - if ((kactcntb == 1) .and. (idiag_act > 0)) then - write(lun,'(/a,i9,2i4)') & - 'qaku act_conv lchnk,i,jtsub', lchnk, icol, jtsub - end if - end if - - if (kactcnt == 1) then - ! diagnostic fields - ! xx_wcldbase = w at first cloudy layer, estimated from mu and cldfrac - xx_wcldbase(icol) = (mu_i(kp1) + mu_i(k))*0.5_r8*hund_ovr_g & - / (rhoair_i(k) * (cldfrac_i(k)*0.5_r8)) - xx_kcldbase(icol) = k - - kactfirst = k - tmpa = 1.0_r8 - call ma_activate_convproc( & - conu(:,k), dconudt_activa(:,k), conu(:,k), & - tmpa, dt_u(k), wup(k), & - t(icol,k), rhoair_i(k), fracice(icol,k), & - pcnst_extd, lun, idiag_act, & - lchnk, icol, k, & - ipass_calc_updraft ) - else if (f_ent > 0.0_r8) then - ! current layer is above cloud base (=first layer with activation) - ! only allow activation at k = kactfirst thru kactfirst-(method1_activate_nlayers-1) - if (k >= kactfirst-(method1_activate_nlayers-1)) then - call ma_activate_convproc( & - conu(:,k), dconudt_activa(:,k), const(:,k), & - f_ent, dt_u(k), wup(k), & - t(icol,k), rhoair_i(k), fracice(icol,k), & - pcnst_extd, lun, idiag_act, & - lchnk, icol, k, & - ipass_calc_updraft ) - end if - end if -! the following was for cam2 shallow convection (hack), -! but is not appropriate for cam5 (uwshcu) -! else if ((kactcnt > 0) .and. (iconvtype /= 1)) then -! ! for shallow conv, when you move from activation occuring to -! ! not occuring, reset kactcnt=0, because the hack scheme can -! ! produce multiple "1.5 layer clouds" separated by clear air -! kactcnt = 0 -! end if - end if ! ((icwmr(icol,k) > clw_cut) .and. (fracice(icol,k) < 1.0)) then - - else ! (convproc_method_activate >= 2) -! aerosol activation - method 2 -! skip levels that are completely glaciated (fracice(icol,k) == 1.0) -! when kactcnt=1 (first/lowest layer with cloud water) -! apply "primary" activatation to the entire updraft -! when kactcnt>1 -! apply secondary activatation to the entire updraft -! do this for all levels above cloud base (even if completely glaciated) -! (this is something for sensitivity testing) - do_act_this_lev = .false. - if (kactcnt <= 0) then - if (icwmr(icol,k) > clw_cut) then - do_act_this_lev = .true. - kactcnt = 1 - kactfirst = k - ! diagnostic fields - ! xx_wcldbase = w at first cloudy layer, estimated from mu and cldfrac - xx_wcldbase(icol) = (mu_i(kp1) + mu_i(k))*0.5_r8*hund_ovr_g & - / (rhoair_i(k) * (cldfrac_i(k)*0.5_r8)) - xx_kcldbase(icol) = k - end if - else -! if ((icwmr(icol,k) > clw_cut) .and. (fracice(icol,k) < 1.0)) then - do_act_this_lev = .true. - kactcnt = kactcnt + 1 -! end if - end if - - idiag_act = idiag_in(icol) - if ( do_act_this_lev ) then - kactcntb = kactcntb + 1 - if ((kactcntb == 1) .and. (idiag_act > 0)) then - write(lun,'(/a,i9,2i4)') & - 'qaku act_conv lchnk,i,jtsub', lchnk, icol, jtsub - end if - - call ma_activate_convproc_method2( & - conu(:,k), dconudt_activa(:,k), & - f_ent, dt_u(k), wup(k), & - t(icol,k), rhoair_i(k), fracice(icol,k), & - pcnst_extd, lun, idiag_act, & - lchnk, icol, k, & - kactfirst, ipass_calc_updraft ) - end if - - conu2(icol,k,:) = conu(:,k) - - end if ! (convproc_method_activate <= 1) - -! aqueous chemistry -! do glaciated levels as aqchem_conv will eventually do acid vapor uptake -! to ice, and aqchem_conv module checks fracice before doing liquid wtr stuff - if (icwmr(icol,k) > clw_cut) then -! call aqchem_conv( conu(1,k), dconudt_aqchem(1,k), aqfrac, & -! t(icol,k), fracice(icol,k), icwmr(icol,k), rhoair_i(k), & -! lh2o2(icol,k), lo3(icol,k), dt_u(k) ) - end if - -! wet removal -! -! mirage2 -! rprd = precip formation as a grid-cell average (kgW/kgA/s) -! icwmr = cloud water MR within updraft area (kgW/kgA) -! fupdr = updraft fractional area (--) -! A = rprd/fupdr = precip formation rate within updraft area (kgW/kgA/s) -! B = A/icwmr = rprd/(icwmr*fupdr) -! = first-order removal rate (1/s) -! C = dp/(mup/fupdr) = updraft air residence time in the layer (s) -! -! fraction removed = (1.0 - exp(-cdt)) where -! cdt = B*C = (dp/mup)*rprd/icwmr -! -! Note1: fupdr cancels out in cdt, so need not be specified -! Note2: dp & mup units need only be consistent (e.g., mb & mb/s) -! Note3: for shallow conv, cdt = 1-beta (beta defined in Hack scheme) -! Note4: the "dp" in C above and code below should be the moist dp -! -! cam5 -! clw_preloss = cloud water MR before loss to precip -! = icwmr + dt*(rprd/fupdr) -! B = A/clw_preloss = (rprd/fupdr)/(icwmr + dt*rprd/fupdr) -! = rprd/(fupdr*icwmr + dt*rprd) -! = first-order removal rate (1/s) -! -! fraction removed = (1.0 - exp(-cdt)) where -! cdt = B*C = (fupdr*dp/mup)*[rprd/(fupdr*icwmr + dt*rprd)] -! -! Note1: *** cdt is now sensitive to fupdr, which we do not really know, -! and is not the same as the convective cloud fraction -! Note2: dt is appropriate in the above cdt expression, not dtsub -! -! Apply wet removal at levels where -! icwmr(icol,k) > clw_cut AND rprd(icol,k) > 0.0 -! as wet removal occurs in both liquid and ice clouds -! - cdt(k) = 0.0_r8 - if ((icwmr(icol,k) > clw_cut) .and. (rprd(icol,k) > 0.0_r8)) then -! if (iconvtype == 1) then - tmpf = 0.5_r8*cldfrac_i(k) - cdt(k) = (tmpf*dp(i,k)/mu_p_eudp(k)) * rprd(icol,k) / & - (tmpf*icwmr(icol,k) + dt*rprd(icol,k)) -! else if (k < pver) then -! if (eudp(k+1) > 0) cdt(k) = & -! rprd(icol,k)*dp(i,k)/(icwmr(icol,k)*eudp(k+1)) -! end if - end if - if (cdt(k) > 0.0_r8) then - expcdtm1 = exp(-cdt(k)) - 1.0_r8 - do m = 2, ncnst_extd - if (doconvproc_extd(m)) then - dconudt_wetdep(m,k) = conu(m,k)*aqfrac(m)*expcdtm1 - conu(m,k) = conu(m,k) + dconudt_wetdep(m,k) - dconudt_wetdep(m,k) = dconudt_wetdep(m,k) / dt_u(k) - conu2(icol,k,m) = conu(m,k) - end if - enddo - end if - - end if ! "(mu_p_eudp(k) > mbsth)" - end do k_loop_main_bb ! "k = kbot, ktop, -1" - -! when doing updraft calcs twice, only need to go this far on the first pass - if ( (ipass_calc_updraft == 1) .and. & - (npass_calc_updraft == 2) ) cycle ipass_calc_updraft_loop - - if (idiag_in(icol) > 0) then - ! do wet removal diagnostics here - do k = kbot, ktop, -1 - if (mu_p_eudp(k) > mbsth) & - write(lun,'(a,i9,3i4,1p,6e10.3)') & - 'qakr - l,i,k,jt; cdt, cldfrac, icwmr, rprd, ...', lchnk, icol, k, jtsub, & - cdt(k), cldfrac_i(k), icwmr(icol,k), rprd(icol,k), dp(i,k), mu_p_eudp(k) - end do - end if - - -! Compute downdraft mixing ratios from cloudtop to cloudbase -! No special treatment is needed at k=2 -! No transformation or removal is applied in the downdraft - do k = ktop, kbot - kp1 = k + 1 -! md_m_eddp = downdraft massflux at kp1, without detrainment between k,kp1 - md_m_eddp = md_i(k) - eddp(k) - if (md_m_eddp < -mbsth) then - do m = 2, ncnst_extd - if (doconvproc_extd(m)) then - cond(m,kp1) = ( md_i(k)*cond(m,k) & - - eddp(k)*const(m,k) ) / md_m_eddp - endif - end do - end if - end do ! k - - -! Now computes fluxes and tendencies -! NOTE: The approach used in convtran applies to inert tracers and -! must be modified to include source and sink terms - sumflux(:) = 0.0_r8 - sumflux2(:) = 0.0_r8 - sumsrce(:) = 0.0_r8 - sumchng(:) = 0.0_r8 - sumchng3(:) = 0.0_r8 - sumactiva(:) = 0.0_r8 - sumaqchem(:) = 0.0_r8 - sumwetdep(:) = 0.0_r8 - sumresusp(:) = 0.0_r8 - sumprevap(:) = 0.0_r8 - - maxflux(:) = 0.0_r8 - maxflux2(:) = 0.0_r8 - maxresusp(:) = 0.0_r8 - maxsrce(:) = 0.0_r8 - maxprevap(:) = 0.0_r8 - -k_loop_main_cc: & - do k = ktop, kbot - kp1 = k+1 - km1 = k-1 - kp1x = min( kp1, pver ) - km1x = max( km1, 1 ) - fa_u_dp = fa_u(k)*dp_i(k) - do m = 2, ncnst_extd - if (doconvproc_extd(m)) then - -! First compute fluxes using environment subsidence/lifting and -! entrainment/detrainment into up/downdrafts, -! to provide an additional mass balance check -! (this could be deleted after the code is well tested) - fluxin = mu_i(k)*min(chat(m,k),const(m,km1x)) & - - md_i(kp1)*min(chat(m,kp1),const(m,kp1x)) & - + dudp(k)*conu(m,k) + dddp(k)*cond(m,kp1) - fluxout = mu_i(kp1)*min(chat(m,kp1),const(m,k)) & - - md_i(k)*min(chat(m,k),const(m,k)) & - + (eudp(k) + eddp(k))*const(m,k) - - netflux = fluxin - fluxout - - sumflux2(m) = sumflux2(m) + netflux - maxflux2(m) = max( maxflux2(m), abs(fluxin), abs(fluxout) ) - -! Now compute fluxes as in convtran, and also source/sink terms -! (version 3 limit fluxes outside convection to mass in appropriate layer -! (these limiters are probably only safe for positive definite quantitities -! (it assumes that mu and md already satify a courant number limit of 1) - if (iflux_method /= 2) then - fluxin = mu_i(kp1)*conu(m,kp1) & - + mu_i(k )*min(chat(m,k ),const(m,km1x)) & - - ( md_i(k )*cond(m,k) & - + md_i(kp1)*min(chat(m,kp1),const(m,kp1x)) ) - fluxout = mu_i(k )*conu(m,k) & - + mu_i(kp1)*min(chat(m,kp1),const(m,k )) & - - ( md_i(kp1)*cond(m,kp1) & - + md_i(k )*min(chat(m,k ),const(m,k )) ) - else - fluxin = mu_i(kp1)*conu(m,kp1) & - - ( md_i(k )*cond(m,k) ) - fluxout = mu_i(k )*conu(m,k) & - - ( md_i(kp1)*cond(m,kp1) ) - tmpveca(1) = fluxin ; tmpveca(4) = -fluxout - - ! new method -- simple upstream method for the env subsidence - ! tmpa = net env mass flux (positive up) at top of layer k - tmpa = -( mu_i(k ) + md_i(k ) ) - if (tmpa <= 0.0_r8) then - fluxin = fluxin - tmpa*const(m,km1x) - else - fluxout = fluxout + tmpa*const(m,k ) - end if - tmpveca(2) = fluxin ; tmpveca(5) = -fluxout - ! tmpa = net env mass flux (positive up) at base of layer k - tmpa = -( mu_i(kp1) + md_i(kp1) ) - if (tmpa >= 0.0_r8) then - fluxin = fluxin + tmpa*const(m,kp1x) - else - fluxout = fluxout - tmpa*const(m,k ) - end if - tmpveca(3) = fluxin ; tmpveca(6) = -fluxout - end if - - netflux = fluxin - fluxout - netsrce = fa_u_dp*(dconudt_aqchem(m,k) + & - dconudt_activa(m,k) + dconudt_wetdep(m,k)) - dcondt(m,k) = (netflux+netsrce)/dp_i(k) - - dcondt_wetdep(m,k) = fa_u_dp*dconudt_wetdep(m,k)/dp_i(k) - - sumflux(m) = sumflux(m) + netflux - maxflux(m) = max( maxflux(m), abs(fluxin), abs(fluxout) ) - sumsrce(m) = sumsrce(m) + netsrce - maxsrce(m) = max( maxsrce(m), & - fa_u_dp*max( abs(dconudt_aqchem(m,k)), & - abs(dconudt_activa(m,k)), abs(dconudt_wetdep(m,k)) ) ) - sumchng(m) = sumchng(m) + dcondt(m,k)*dp_i(k) - sumactiva(m) = sumactiva(m) + fa_u_dp*dconudt_activa(m,k) - sumaqchem(m) = sumaqchem(m) + fa_u_dp*dconudt_aqchem(m,k) - sumwetdep(m) = sumwetdep(m) + fa_u_dp*dconudt_wetdep(m,k) - - if ( idiag_in(icol)>0 .and. k==26 .and. & - (m==16 .or. m==23 .or. m==16+pcnst .or. m==23+pcnst) ) then - if (m==16) & - write(lun,'(a,i9,4i4,1p,22x, 2x,11x, 2x,6e11.3)') & - 'qakww0-'//convtype(1:4), lchnk, icol, k, -1, jtsub, & - dtsub*mu_i(k+1)/dp_i(k), dtsub*mu_i(k)/dp_i(k), dtsub*eudp(k)/dp_i(k), & - dtsub*md_i(k+1)/dp_i(k), dtsub*md_i(k)/dp_i(k), dtsub*eddp(k)/dp_i(k) - - write(lun,'(a,i9,4i4,1p,2e11.3,2x,e11.3,2x,6e11.3)') & - 'qakww1-'//convtype(1:4), lchnk, icol, k, m, jtsub, & - const(m,k), const(m,k)+dtsub*dcondt(m,k), dtsub*dcondt(m,k), & - dtsub*fluxin/dp_i(k), -dtsub*fluxout/dp_i(k), & - dtsub*fa_u_dp*dconudt_aqchem(m,k)/dp_i(k), & - dtsub*fa_u_dp*dconudt_activa(m,k)/dp_i(k), & - dtsub*fa_u_dp*dconudt_wetdep(m,k)/dp_i(k) - write(lun,'(a,i9,4i4,1p,22x, 2x,11x, 2x,6e11.3)') & - 'qakww1-'//convtype(1:4), lchnk, icol, k, m, jtsub, & - dtsub*tmpveca(1:6)/dp_i(k) - end if - - dcondt2(icol,k,m) = dcondt(m,k) - - end if ! "(doconvproc_extd(m))" - end do ! "m = 2,ncnst_extd" - end do k_loop_main_cc ! "k = ktop, kbot" - - -! calculate effects of precipitation evaporation - call ma_precpevap_convproc( dcondt, dcondt_wetdep, dcondt_prevap, & - rprd, evapc, dp_i, & - icol, ktop, pcnst_extd, & - lun, idiag_in(icol), lchnk, & - doconvproc_extd ) - if ( idiag_in(icol)>0 ) then - k = 26 - do m = 16, 23, 7 - write(lun,'(a,i9,4i4,1p,2e11.3,2x,e11.3,2x,5e11.3)') & - 'qakww2-'//convtype(1:4), lchnk, icol, k, m, jtsub, & - const(m,k), const(m,k)+dtsub*dcondt(m,k), dtsub*dcondt(m,k) - end do - do m = 16+pcnst, 23+pcnst, 7 - write(lun,'(a,i9,4i4,1p,2e11.3,2x,e11.3,2x,5e11.3)') & - 'qakww2-'//convtype(1:4), lchnk, icol, k, m, jtsub, & - const(m,k), const(m,k)+dtsub*dcondt(m,k), dtsub*dcondt(m,k) - end do - end if - - - -! make adjustments to dcondt for activated & unactivated aerosol species -! pairs to account any (or total) resuspension of convective-cloudborne aerosol - call ma_resuspend_convproc( dcondt, dcondt_resusp, & - const, dp_i, ktop, kbot_prevap, pcnst_extd ) - - ! Do resuspension of aerosols from rain only when the rain has - ! totally evaporated. - if (convproc_do_evaprain_atonce) then - dcondt_resusp3d(pcnst+1:pcnst_extd,icol,:) = dcondt_resusp(pcnst+1:pcnst_extd,:) - dcondt_resusp(pcnst+1:pcnst_extd,:) = 0._r8 - end if - - if ( idiag_in(icol)>0 ) then - k = 26 - do m = 16, 23, 7 - write(lun,'(a,i9,4i4,1p,2e11.3,2x,e11.3,2x,5e11.3)') & - 'qakww3-'//convtype(1:4), lchnk, icol, k, m, jtsub, & - const(m,k), const(m,k)+dtsub*dcondt(m,k), dtsub*dcondt(m,k) - end do - do m = 16+pcnst, 23+pcnst, 7 - write(lun,'(a,i9,4i4,1p,2e11.3,2x,e11.3,2x,5e11.3)') & - 'qakww3-'//convtype(1:4), lchnk, icol, k, m, jtsub, & - const(m,k), const(m,k)+dtsub*dcondt(m,k), dtsub*dcondt(m,k) - end do - end if - - -! calculate new column-tendency variables - do m = 2, ncnst_extd - if (doconvproc_extd(m)) then - do k = ktop, kbot_prevap - sumchng3(m) = sumchng3(m) + dcondt(m,k)*dp_i(k) - sumresusp(m) = sumresusp(m) + dcondt_resusp(m,k)*dp_i(k) - maxresusp(m) = max( maxresusp(m), & - abs(dcondt_resusp(m,k)*dp_i(k)) ) - sumprevap(m) = sumprevap(m) + dcondt_prevap(m,k)*dp_i(k) - maxprevap(m) = max( maxprevap(m), & - abs(dcondt_prevap(m,k)*dp_i(k)) ) - end do - end if - end do ! m - - -! do checks for mass conservation -! do not expect errors > 1.0e-14, but use a conservative 1.0e-10 here, -! as an error of this size is still not a big concern - relerr_cut = 1.0e-10_r8 - if (nerr < nerrmax) then - merr = 0 - if (courantmax > (1.0_r8 + 1.0e-6_r8)) then - write(lun,9161) '-', trim(convtype), courantmax - merr = merr + 1 - end if - do m = 2, ncnst_extd - if (doconvproc_extd(m)) then - itmpa = 0 - ! sumflux should be ~=0.0 because fluxout of one layer cancels - ! fluxin to adjacent layer - tmpa = sumflux(m) - tmpb = max( maxflux(m), small ) - if (abs(tmpa) > relerr_cut*tmpb) then - write(lun,9151) '1', m, cnst_name_extd(m), tmpb, tmpa, (tmpa/tmpb) - itmpa = itmpa + 1 - end if - ! sumflux2 involve environment fluxes and entrainment/detrainment - ! to up/downdrafts, and it should be equal to sumchng, - ! and so (sumflux2 - sumsrce) should be ~=0.0 - tmpa = sumflux2(m) - sumsrce(m) - tmpb = max( maxflux2(m), maxsrce(m), small ) - if (abs(tmpa) > relerr_cut*tmpb) then - write(lun,9151) '2', m, cnst_name_extd(m), tmpb, tmpa, (tmpa/tmpb) - itmpa = itmpa + 10 - end if - ! sunchng = sumflux + sumsrce, so (sumchng - sumsrc) should be ~=0.0 - tmpa = sumchng(m) - sumsrce(m) - tmpb = max( maxflux(m), maxsrce(m), small ) - if (abs(tmpa) > relerr_cut*tmpb) then - write(lun,9151) '3', m, cnst_name_extd(m), tmpb, tmpa, (tmpa/tmpb) - itmpa = itmpa + 100 - end if - ! sumchng3 = sumchng + sumresusp + sumprevap, - ! so tmpa (below) should be ~=0.0 - ! NOTE: This check needs to be redone if the rain is being - ! evaporated all at once. Until then, skip this check for that case. - if (.not. convproc_do_evaprain_atonce) then - tmpa = sumchng3(m) - (sumsrce(m) + sumresusp(m) + sumprevap(m)) - tmpb = max( maxflux(m), maxsrce(m), maxresusp(m), maxprevap(m), small ) - - if (abs(tmpa) > relerr_cut*tmpb) then - write(lun,9151) '4', m, cnst_name_extd(m), tmpb, tmpa, (tmpa/tmpb) - itmpa = itmpa + 1000 - end if - end if - - if (itmpa > 0) merr = merr + 1 - end if - end do ! m - if (merr > 0) write(lun,9181) convtype, lchnk, icol, i, jt(i), mx(i) - nerr = nerr + merr - if (nerr >= nerrmax) write(lun,9171) nerr - end if ! (nerr < nerrmax) then - -9151 format( '*** ma_convproc_tend error, massbal', a, 1x, i5,1x,a, & - ' -- maxflux, sumflux, relerr =', 3(1pe14.6) ) -9161 format( '*** ma_convproc_tend error, courantmax', 2a, 3x, 1pe14.6 ) -9171 format( '*** ma_convproc_tend error, stopping messages after nerr =', i10 ) - -9181 format( '*** ma_convproc_tend error -- convtype, lchnk, icol, il, jt, mx = ', a,2x,5(1x,i10) ) - - -! -! note again the ma_convproc_tend does not apply convective cloud processing -! to the stratiform-cloudborne aerosol -! within this routine, cloudborne aerosols are convective-cloudborne -! -! before tendencies (dcondt, which is loaded into dqdt) are returned, -! the convective-cloudborne aerosol tendencies must be combined -! with the interstitial tendencies -! ma_resuspend_convproc has already done this for the dcondt -! -! the individual process column tendencies (sumwetdep, sumprevap, ...) -! are just diagnostic fields that can be written to history -! tendencies for interstitial and convective-cloudborne aerosol could -! both be passed back and output, if desired -! currently, however, the interstitial and convective-cloudborne tendencies -! are combined (in the next code block) before being passed back (in qsrflx) -! - do n = 1, ntot_amode - do ll = 0, nspec_amode(n) - if (ll == 0) then - la = numptr_amode(n) - lc = numptrcw_amode(n) + pcnst - else - la = lmassptr_amode(ll,n) - lc = lmassptrcw_amode(ll,n) + pcnst - end if - if (doconvproc(la)) then - sumactiva(la) = sumactiva(la) + sumactiva(lc) - sumresusp(la) = sumresusp(la) + sumresusp(lc) - sumaqchem(la) = sumaqchem(la) + sumaqchem(lc) - sumwetdep(la) = sumwetdep(la) + sumwetdep(lc) - sumprevap(la) = sumprevap(la) + sumprevap(lc) -! if (n==1 .and. ll==1) then -! write(lun,*) 'la, sumaqchem(la) =', la, sumaqchem(la) -! endif - end if - enddo ! ll - enddo ! n - -! -! scatter overall tendency back to full array -! - do m = 2, ncnst - if (doconvproc(m)) then - do k = ktop, kbot_prevap - dqdt_i(k,m) = dcondt(m,k) - dqdt(icol,k,m) = dqdt(icol,k,m) + dqdt_i(k,m)*xinv_ntsub - end do -! dqdt_i(:,m) = 0. - end if - end do ! m - -! scatter column burden tendencies for various processes to qsrflx - do m = 2, ncnst - if (doconvproc(m)) then - qsrflx_i(m,1) = sumactiva(m)*hund_ovr_g - qsrflx_i(m,2) = sumresusp(m)*hund_ovr_g - qsrflx_i(m,3) = sumaqchem(m)*hund_ovr_g - qsrflx_i(m,4) = sumwetdep(m)*hund_ovr_g - qsrflx_i(m,5) = sumprevap(m)*hund_ovr_g -! qsrflx_i(m,1:4) = 0. - qsrflx(icol,m,1:5) = qsrflx(icol,m,1:5) + qsrflx_i(m,1:5)*xinv_ntsub - end if - end do ! m - - -! diagnostic output of profiles before - if (idiag_in(icol) > 0) then - write(lun, '(/3a,i9,2i4)' ) 'qakr-', trim(convtype), ' - lchnk,i,jtsub', lchnk, icol, jtsub - n = 1 - - do j = 1, 2 - if (j == 1) then - write(lun, '(4a,i4)' ) & - 'qakr-', trim(convtype), ' - k, mu,md; then mode-1 ', & - 'numb & numbcw for q, const, conu, cond, delq(a/c/ac noresu)', jtsub - else - write(lun, '(/4a,i4)' ) & - 'qakr-', trim(convtype), ' - k, mu,md; then mode-1 ', & - 'mass & masscw for q, const, conu, cond, delq(a/c/ac noresu)', jtsub - end if - - do k = 10, pver - tmpveca(:) = 0.0_r8 - do ll = 1, nspec_amode(n) - if (j == 1) then - la = numptr_amode(n) - lc = numptr_amode(n) + pcnst - else - la = lmassptr_amode(ll,n) - lc = lmassptr_amode(ll,n) + pcnst - end if - tmpveca(1) = tmpveca(1) + q_i(k,la) - tmpveca(2) = tmpveca(2) + const(la,k) - tmpveca(3) = tmpveca(3) + const(lc,k) - tmpveca(4) = tmpveca(4) + conu( la,k) - tmpveca(5) = tmpveca(5) + conu( lc,k) - tmpveca(6) = tmpveca(6) + cond( la,k) - tmpveca(7) = tmpveca(7) + cond( lc,k) - tmpveca(8) = tmpveca(8) + (dcondt(la,k)-dcondt_resusp(la,k))*dtsub - tmpveca(9) = tmpveca(9) + (dcondt(lc,k)-dcondt_resusp(lc,k))*dtsub - tmpveca(10) = tmpveca(8) + tmpveca(9) - if (j == 1) exit - end do ! ll - if ((k > 15) .and. (mod(k,5) == 1)) write(lun,'(a)') - write(lun, '(a,i3,1p,2e10.2, e11.2, 3(2x,2e9.2), 2x,3e10.2 )' ) 'qakr', k, & - mu_i(k), md_i(k), tmpveca(1:10) - end do ! k - end do ! j - - if (pcnst < 0) then - write(lun, '(/a,i4)' ) & - 'qakr - name; burden; qsrflx tot, activa,resusp,aqchem,wetdep,resid', jtsub - do m = 2, ncnst - if ( .not. doconvproc(m) ) cycle - tmpveca(1) = sum( q_i(:,m)*dp_i(:) ) * hund_ovr_g - tmpveca(2) = sum( dqdt_i(:,m)*dp_i(:) ) * hund_ovr_g - tmpveca(3:6) = qsrflx_i(m,1:4) - tmpveca(7) = tmpveca(2) - sum( tmpveca(3:6) ) - write(lun, '(2a,1p,2(2x,e11.3),2x,4e11.3,2x,e11.3)' ) & - 'qakr ', cnst_name_extd(m)(1:10), tmpveca(1:7) - end do ! m - end if ! (pcnst < 0) then - - write(lun, '(/3a,i4)' ) 'qakr-', trim(convtype), & - ' - name; burden; sumchng3, sumactiva,resusp,aqchem,wetdep, resid,resid*dt/burden', jtsub -! write(lun, '(/2a)' ) & -! 'qakr - name; burden; sumchng3; ', & -! 'sumactiva,resusp,aqchem,wetdep,prevap; resid,resid*dtsub/burden' - tmpb = 0.0_r8 - itmpb = 0 - do m = 2, pcnst - if ( .not. doconvproc_extd(m) ) cycle - - tmpmata(:,:) = 0.0_r8 - do j = 1, 3 - l = m - if (j == 3) l = m + pcnst - if ( .not. doconvproc_extd(l) ) cycle - - if (j == 1) then - tmpmata(1,j) = sum( q_i(:,l)*dp_i(:) ) * hund_ovr_g - tmpmata(2,j) = sum( dqdt_i(:,l)*dp_i(:) ) * hund_ovr_g - tmpmata(3:7,j) = qsrflx_i(l,1:5) - else - tmpmata(1,j) = sum( const(l,1:pver)*dp_i(1:pver) ) * hund_ovr_g - tmpmata(2,j) = sumchng3( l) * hund_ovr_g - tmpmata(3,j) = sumactiva(l) * hund_ovr_g - tmpmata(4,j) = sumresusp(l) * hund_ovr_g - tmpmata(5,j) = sumaqchem(l) * hund_ovr_g - tmpmata(6,j) = sumwetdep(l) * hund_ovr_g - tmpmata(7,j) = sumprevap(l) * hund_ovr_g - end if - end do ! j - - tmpmata(3:7,2) = tmpmata(3:7,2) - tmpmata(3:7,3) ! because lc values were added onto la - do j = 1, 3 - tmpmata(8,j) = tmpmata(2,j) - sum( tmpmata(3:7,j) ) ! residual - tmpa = max( tmpmata(1,min(j,2)), 1.0e-20_r8 ) - tmpmata(9,j) = tmpmata(8,j) * dtsub / tmpa - if (abs(tmpmata(9,j)) > tmpb) then - tmpb = abs(tmpmata(9,j)) - itmpb = m - end if - end do - -! write(lun, '(/2a,1p,2(2x,e11.3),2x,4e11.3,2x,2e11.3)' ) & -! 'qakr1 ', cnst_name_extd(m)(1:10), tmpmata(1:6,1), tmpmata(8:9,1) - write(lun, '(/2a,1p,2(2x,e11.3),2x,5e11.3,2x,2e11.3)' ) & - 'qakr1 ', cnst_name_extd(m)(1:10), tmpmata(1:9,1) -! write(lun, '( 2a,1p,2(2x,e11.3),2x,4e11.3,2x,2e11.3)' ) & -! 'qakr2 ', cnst_name_extd(m)(1:10), tmpmata(1:6,2), tmpmata(8:9,2) - write(lun, '( 2a,1p,2(2x,e11.3),2x,5e11.3,2x,2e11.3)' ) & - 'qakr2 ', cnst_name_extd(m)(1:10), tmpmata(1:9,2) - if ( .not. doconvproc_extd(l) ) cycle -! write(lun, '( 2a,1p,2(2x,e11.3),2x,4e11.3,2x,2e11.3)' ) & -! 'qakr3 ', cnst_name_cw(m)(1:10), tmpmata(1:6,3), tmpmata(8:9,3) - write(lun, '( 2a,1p,2(2x,e11.3),2x,5e11.3,2x,2e11.3)' ) & - 'qakr3 ', cnst_name_cw(m)(1:10), tmpmata(1:9,3) - end do ! m - write(lun, '(/3a,2i4,1p,e11.2)' ) 'qakr-', trim(convtype), & - ' - max(resid*dt/burden)', jtsub, itmpb, tmpb - - end if ! (idiag_in(icol) > 0) then - - - if (jtsub < ntsub) then - ! update the q_i for the next interation of the jtsub loop - do m = 2, ncnst - if (doconvproc(m)) then - do k = ktop, kbot_prevap - q_i(k,m) = max( (q_i(k,m) + dqdt_i(k,m)*dtsub), 0.0_r8 ) - end do - end if - end do ! m - end if - - end do ipass_calc_updraft_loop - - end do jtsub_loop_main_aa ! of the main "do jtsub = 1, ntsub" loop - - - end do i_loop_main_aa ! of the main "do i = il1g, il2g" loop - - do n = 1, ntot_amode - do ll = 0, nspec_amode(n) - if (ll == 0) then - la = numptr_amode(n) - lc = numptrcw_amode(n) + pcnst - else - la = lmassptr_amode(ll,n) - lc = lmassptrcw_amode(ll,n) + pcnst - end if - - call outfld( trim(cnst_name_extd(la))//'WETC', dcondt2(:,:,la), pcols, lchnk ) - call outfld( trim(cnst_name_extd(la))//'CONU', conu2(:,:,la), pcols, lchnk ) - call outfld( trim(cnst_name_extd(lc))//'WETC', dcondt2(:,:,lc), pcols, lchnk ) - call outfld( trim(cnst_name_extd(lc))//'CONU', conu2(:,:,lc), pcols, lchnk ) - - end do - end do - - return -end subroutine ma_convproc_tend - - - -!========================================================================================= - subroutine ma_precpevap_convproc( & - dcondt, dcondt_wetdep, dcondt_prevap, & - rprd, evapc, dp_i, & - icol, ktop, pcnst_extd, & - lun, idiag_prevap, lchnk, & - doconvproc_extd ) -!----------------------------------------------------------------------- -! -! Purpose: -! Calculate resuspension of wet-removed aerosol species resulting -! precip evaporation -! -! Author: R. Easter -! -!----------------------------------------------------------------------- - - use modal_aero_data, only: & - lmassptrcw_amode, nspec_amode, numptrcw_amode - - implicit none - -!----------------------------------------------------------------------- -! arguments -! (note: TMR = tracer mixing ratio) - integer, intent(in) :: pcnst_extd - - real(r8), intent(inout) :: dcondt(pcnst_extd,pver) - ! overall TMR tendency from convection - real(r8), intent(in) :: dcondt_wetdep(pcnst_extd,pver) - ! portion of TMR tendency due to wet removal - real(r8), intent(inout) :: dcondt_prevap(pcnst_extd,pver) - ! portion of TMR tendency due to precip evaporation - ! (actually, due to the adjustments made here) - ! (on entry, this is 0.0) - - real(r8), intent(in) :: rprd(pcols,pver) ! conv precip production rate (gathered) - real(r8), intent(in) :: evapc(pcols,pver) ! conv precip evaporation rate (gathered) - real(r8), intent(in) :: dp_i(pver) ! pressure thickness of level (in mb) - - integer, intent(in) :: icol ! normal (ungathered) i index for current column - integer, intent(in) :: ktop ! index of top cloud level for current column - integer, intent(in) :: lun ! logical unit for diagnostic output - integer, intent(in) :: idiag_prevap ! flag for diagnostic output - integer, intent(in) :: lchnk ! chunk index - - logical, intent(in) :: doconvproc_extd(pcnst_extd) ! indicates which species to process - -!----------------------------------------------------------------------- -! local variables - integer :: k, l, ll, m, n - real(r8) :: del_pr_flux_prod ! change to precip flux from production [(kg/kg/s)*mb] - real(r8) :: del_pr_flux_evap ! change to precip flux from evaporation [(kg/kg/s)*mb] - real(r8) :: del_wd_flux_evap ! change to wet deposition flux from evaporation [(kg/kg/s)*mb] - real(r8) :: fdel_pr_flux_evap ! fractional change to precip flux from evaporation - real(r8) :: pr_flux ! precip flux at base of current layer [(kg/kg/s)*mb] - real(r8) :: pr_flux_old - real(r8) :: tmpa, tmpb, tmpc, tmpd - real(r8) :: tmpdp ! delta-pressure (mb) - real(r8) :: wd_flux(pcnst_extd) ! tracer wet deposition flux at base of current layer [(kg/kg/s)*mb] - integer :: i - character(len=4) :: spcstr -!----------------------------------------------------------------------- - - - pr_flux = 0.0_r8 - wd_flux(:) = 0.0_r8 - - if (idiag_prevap > 0) then - write(lun,'(a,i9,i4,5x,a)') 'qakx - lchnk,i', lchnk, icol, & - '// k; pr_flux old,new; delprod,devap; mode-1 numb wetdep,prevap; mass ...' - end if - - do k = ktop, pver - tmpdp = dp_i(k) - - pr_flux_old = pr_flux - del_pr_flux_prod = tmpdp*max(0.0_r8, rprd(icol,k)) - pr_flux = pr_flux_old + del_pr_flux_prod - - del_pr_flux_evap = min( pr_flux, tmpdp*max(0.0_r8, evapc(icol,k)) ) - - ! Do resuspension of aerosols from rain only when the rain has - ! totally evaporated in one layer. - if (convproc_do_evaprain_atonce .and. & - (del_pr_flux_evap.ne.pr_flux)) del_pr_flux_evap = 0._r8 - - fdel_pr_flux_evap = del_pr_flux_evap / max(pr_flux, 1.0e-35_r8) - - do m = 2, pcnst_extd - if ( doconvproc_extd(m) ) then - ! use -dcondt_wetdep(m,k) as it is negative (or zero) - wd_flux(m) = wd_flux(m) + tmpdp*max(0.0_r8, -dcondt_wetdep(m,k)) - del_wd_flux_evap = wd_flux(m)*fdel_pr_flux_evap - dcondt_prevap(m,k) = del_wd_flux_evap/tmpdp - end if - end do - - ! Do resuspension of aerosol species from rain to coarse mode (large particle) rather - ! than to individual modes. - if (convproc_do_evaprain_atonce) then - - call accumulate_to_larger_mode( 'SO4', lptr_so4_a_amode, dcondt_prevap(:,k) ) - call accumulate_to_larger_mode( 'DUST',lptr_dust_a_amode,dcondt_prevap(:,k) ) - call accumulate_to_larger_mode( 'NACL',lptr_nacl_a_amode,dcondt_prevap(:,k) ) - call accumulate_to_larger_mode( 'MSA', lptr_msa_a_amode, dcondt_prevap(:,k) ) - call accumulate_to_larger_mode( 'NH4', lptr_nh4_a_amode, dcondt_prevap(:,k) ) - call accumulate_to_larger_mode( 'NO3', lptr_no3_a_amode, dcondt_prevap(:,k) ) - - spcstr = ' ' - do i = 1,nsoa - if (nsoa>1) write(spcstr,'(i4)') i - call accumulate_to_larger_mode( 'SOA'//adjustl(spcstr), lptr2_soa_a_amode(:,i), dcondt_prevap(:,k) ) - enddo - spcstr = ' ' - do i = 1,npoa - if (npoa>1) write(spcstr,'(i4)') i - call accumulate_to_larger_mode( 'POM'//adjustl(spcstr), lptr2_pom_a_amode(:,i), dcondt_prevap(:,k) ) - enddo - spcstr = ' ' - do i = 1,nbc - if (nbc>1) write(spcstr,'(i4)') i - call accumulate_to_larger_mode( 'BC'//adjustl(spcstr), lptr2_bc_a_amode(:,i), dcondt_prevap(:,k) ) - enddo - - end if - - do m = 2, pcnst_extd - if ( doconvproc_extd(m) ) then - dcondt(m,k) = dcondt(m,k) + dcondt_prevap(m,k) - end if - end do - - pr_flux = max( 0.0_r8, pr_flux-del_pr_flux_evap ) - - if (idiag_prevap > 0) then - n = 1 - l = numptrcw_amode(n) + pcnst - tmpa = dcondt_wetdep(l,k) - tmpb = dcondt_prevap(l,k) - tmpc = 0.0_r8 - tmpd = 0.0_r8 - do ll = 1, nspec_amode(n) - l = lmassptrcw_amode(ll,n) + pcnst - tmpc = tmpc + dcondt_wetdep(l,k) - tmpd = tmpd + dcondt_prevap(l,k) - end do - write(lun,'(a,i4,1p,4(2x,2e10.2))') 'qakx', k, & - pr_flux_old, pr_flux, del_pr_flux_prod, -del_pr_flux_evap, & - -tmpa, tmpb, -tmpc, tmpd - end if - end do ! k - - return - end subroutine ma_precpevap_convproc - -!========================================================================================= - subroutine accumulate_to_larger_mode( spc_name, lptr, prevap ) - - character(len=*), intent(in) :: spc_name - integer, intent(in) :: lptr(:) - real(r8), intent(inout) :: prevap(:) - - integer :: m,n, nl,ns - - nl = -1 - ! find constituent index of the largest mode for the species - loop1: do m = 1,ntot_amode-1 - nl = lptr(mode_size_order(m)) - if (nl>0) exit loop1 - end do loop1 - - if (.not. nl>0) return - - ! accumulate the smaller modes into the largest mode - do n = m+1,ntot_amode - ns = lptr(mode_size_order(n)) - if (ns>0) then - prevap(nl) = prevap(nl) + prevap(ns) - prevap(ns) = 0._r8 - if (masterproc .and. debug) then - write(iulog,'(a,i3,a,i3)') trim(spc_name)//' mode number accumulate ',ns,'->',nl - endif - endif - end do - - end subroutine accumulate_to_larger_mode - -!========================================================================================= - subroutine ma_activate_convproc( & - conu, dconudt, conent, & - f_ent, dt_u, wup, & - tair, rhoair, fracice, & - pcnst_extd, lun, idiag_act, & - lchnk, i, k, & - ipass_calc_updraft ) -!----------------------------------------------------------------------- -! -! Purpose: -! Calculate activation of aerosol species in convective updraft -! for a single column and level -! -! Method: -! conu(l) = Updraft TMR (tracer mixing ratio) at k/k-1 interface -! conent(l) = TMR of air that is entrained into the updraft from level k -! f_ent = Fraction of the "before-detrainment" updraft massflux at -! k/k-1 interface" resulting from entrainment of level k air -! (where k is the current level in subr ma_convproc_tend) -! -! On entry to this routine, the conu(l) represents the updraft TMR -! after entrainment, but before chemistry/physics and detrainment, -! and is equal to -! conu(l) = f_ent*conent(l) + (1.0-f_ent)*conu_below(l) -! where -! conu_below(l) = updraft TMR at the k+1/k interface, and -! f_ent = (eudp/mu_p_eudp) is the fraction of the updraft massflux -! from level k entrainment -! -! This routine applies aerosol activation to the entrained tracer, -! then adjusts the conu so that on exit, -! conu(la) = conu_incoming(la) - f_ent*conent(la)*f_act(la) -! conu(lc) = conu_incoming(lc) + f_ent*conent(la)*f_act(la) -! where -! la, lc = indices for an unactivated/activated aerosol component pair -! f_act = fraction of conent(la) that is activated. The f_act are -! calculated with the Razzak-Ghan activation parameterization. -! The f_act differ for each mode, and for number/surface/mass. -! -! Note: At the lowest layer with cloud water, subr convproc calls this -! routine with conent==conu and f_ent==1.0, with the result that -! activation is applied to the entire updraft tracer flux -! -! *** The updraft velocity used for activation calculations is rather -! uncertain and needs more work. However, an updraft of 1-3 m/s -! will activate essentially all of accumulation and coarse mode particles. -! -! Author: R. Easter -! -!----------------------------------------------------------------------- - - use ndrop, only: activate_aerosol - - use modal_aero_data, only: lmassptr_amode, lmassptrcw_amode, & - ntot_amode, & - nspec_amode, ntot_amode, numptr_amode, numptrcw_amode, & - specdens_amode, spechygro, & - voltonumblo_amode, voltonumbhi_amode - - implicit none - -!----------------------------------------------------------------------- -! arguments (note: TMR = tracer mixing ratio) - integer, intent(in) :: pcnst_extd - ! conu = tracer mixing ratios in updraft at top of this (current) level - ! The conu are changed by activation - real(r8), intent(inout) :: conu(pcnst_extd) - ! conent = TMRs in the entrained air at this level - real(r8), intent(in) :: conent(pcnst_extd) - real(r8), intent(inout) :: dconudt(pcnst_extd) ! TMR tendencies due to activation - - real(r8), intent(in) :: f_ent ! fraction of updraft massflux that was - ! entrained across this layer == eudp/mu_p_eudp - real(r8), intent(in) :: dt_u ! lagrangian transport time (s) in the - ! updraft at current level - real(r8), intent(in) :: wup ! mean updraft vertical velocity (m/s) - ! at current level updraft - - real(r8), intent(in) :: tair ! Temperature in Kelvin - real(r8), intent(in) :: rhoair ! air density (kg/m3) - - real(r8), intent(in) :: fracice ! Fraction of ice within the cloud - ! used as in-cloud wet removal rate - integer, intent(in) :: lun ! logical unit for diagnostic output - integer, intent(in) :: idiag_act ! flag for diagnostic output - integer, intent(in) :: lchnk ! chunk index - integer, intent(in) :: i ! column index - integer, intent(in) :: k ! level index - integer, intent(in) :: ipass_calc_updraft - -!----------------------------------------------------------------------- -! local variables - integer :: ll, la, lc, n - - real(r8) :: delact ! working variable - real(r8) :: dt_u_inv ! 1.0/dt_u - real(r8) :: fluxm(ntot_amode) ! to understand this, see subr activate_aerosol - real(r8) :: fluxn(ntot_amode) ! to understand this, see subr activate_aerosol - real(r8) :: flux_fullact ! to understand this, see subr activate_aerosol - real(r8) :: fm(ntot_amode) ! mass fraction of aerosols activated - real(r8) :: fn(ntot_amode) ! number fraction of aerosols activated - real(r8) :: hygro(ntot_amode) ! current hygroscopicity for int+act - real(r8) :: naerosol(ntot_amode) ! interstitial+activated number conc (#/m3) - real(r8) :: sigw ! standard deviation of updraft velocity (cm/s) - real(r8) :: tmpa, tmpb, tmpc ! working variable - real(r8) :: tmp_fact ! working variable - real(r8) :: vaerosol(ntot_amode) ! int+act volume (m3/m3) - real(r8) :: wbar ! mean updraft velocity (cm/s) - real(r8) :: wdiab ! diabatic vertical velocity (cm/s) - real(r8) :: wminf, wmaxf ! limits for integration over updraft spectrum (cm/s) - - -!----------------------------------------------------------------------- - - -! when ipass_calc_updraft == 2, apply the activation tendencies -! from pass 1, but multiplied by factor_reduce_actfrac -! (can only have ipass_calc_updraft == 2 when method_reduce_actfrac = 2) - if (ipass_calc_updraft == 2) then - - dt_u_inv = 1.0_r8/dt_u - do n = 1, ntot_amode - do ll = 0, nspec_amode(n) - if (ll == 0) then - la = numptr_amode(n) - lc = numptrcw_amode(n) + pcnst - else - la = lmassptr_amode(ll,n) - lc = lmassptrcw_amode(ll,n) + pcnst - end if - - delact = dconudt(lc)*dt_u * factor_reduce_actfrac - delact = min( delact, conu(la) ) - delact = max( delact, 0.0_r8 ) - conu(la) = conu(la) - delact - conu(lc) = conu(lc) + delact - dconudt(la) = -delact*dt_u_inv - dconudt(lc) = delact*dt_u_inv - end do - end do ! "n = 1, ntot_amode" - return - - end if ! (ipass_calc_updraft == 2) - - -! check f_ent > 0 - if (f_ent <= 0.0_r8) return - - - do n = 1, ntot_amode -! compute a (or a+cw) volume and hygroscopicity - tmpa = 0.0_r8 - tmpb = 0.0_r8 - do ll = 1, nspec_amode(n) - tmpc = max( conent(lmassptr_amode(ll,n)), 0.0_r8 ) - if ( use_cwaer_for_activate_maxsat ) & - tmpc = tmpc + max( conent(lmassptrcw_amode(ll,n)+pcnst), 0.0_r8 ) - tmpc = tmpc / specdens_amode(ll,n) - tmpa = tmpa + tmpc - tmpb = tmpb + tmpc * spechygro(ll,n) - end do - vaerosol(n) = tmpa * rhoair - if (tmpa < 1.0e-35_r8) then - hygro(n) = 0.2_r8 - else - hygro(n) = tmpb/tmpa - end if - -! load a (or a+cw) number and bound it - tmpa = max( conent(numptr_amode(n)), 0.0_r8 ) - if ( use_cwaer_for_activate_maxsat ) & - tmpa = tmpa + max( conent(numptrcw_amode(n)+pcnst), 0.0_r8 ) - naerosol(n) = tmpa * rhoair - naerosol(n) = max( naerosol(n), & - vaerosol(n)*voltonumbhi_amode(n) ) - naerosol(n) = min( naerosol(n), & - vaerosol(n)*voltonumblo_amode(n) ) - -! diagnostic output for testing/development -! if (lun > 0) then -! if (n == 1) then -! write(lun,9500) -! write(lun,9510) (cnst_name(l), conu(l), l=1,pcnst_extd) -! write(lun,9520) tair, rhoaircgs, airconcgs -! end if -! write(lun,9530) n, ntype(n), vaerosol -! write(lun,9540) naerosol(n), tmp*airconcgs, & -! voltonumbhi_amode(n), voltonumblo_amode(n) -! write(lun,9550) (maerosol(l,n), l=1,ntype(n)) -!9500 format( / 'activate_conv output -- conu values' ) -!9510 format( 3( a, 1pe11.3, 4x ) ) -!9520 format( 'ta, rhoa, acon ', 3(1pe11.3) ) -!9530 format( 'n, ntype, sg, vol ', i6, i5, 2(1pe11.3) ) -!9540 format( 'num, num0, v2nhi&lo', 4(1pe11.3) ) -!9550 format( 'masses ', 6(1pe11.3) ) -! end if - - end do - - -! call Razzak-Ghan activation routine with single updraft - wbar = max( wup, 0.5_r8 ) ! force wbar >= 0.5 m/s for now - sigw = 0.0_r8 - wdiab = 0.0_r8 - wminf = wbar - wmaxf = wbar - - call activate_aerosol( & - wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & - naerosol, ntot_amode, vaerosol, hygro, aero_props_obj, & - fn, fm, fluxn, fluxm, flux_fullact ) - - - -! diagnostic output for testing/development - if (idiag_act > 0) then - n = min( ntot_amode, 3 ) - write(lun, '(a,i3,2f6.3, 1p,2(2x,3e10.2), 0p,3(2x,3f6.3) )' ) & - 'qaku k,w,qn,qm,hy,fn,fm', k, wup, wbar, & - naerosol(1:n)/rhoair, vaerosol(1:n)*1.8e3_r8/rhoair, & - hygro(1:n), fn(1:n), fm(1:n) - ! convert naer, vaer to number and (approx) mass TMRs - end if -! if (lun > 0) then -! write(lun,9560) (fn(n), n=1,ntot_amode) -! write(lun,9570) (fm(n), n=1,ntot_amode) -!9560 format( 'fnact values ', 6(1pe11.3) ) -!9570 format( 'fmact values ', 6(1pe11.3) ) -! end if - - -! apply the activation fractions to the updraft aerosol mixing ratios - dt_u_inv = 1.0_r8/dt_u - - do n = 1, ntot_amode - do ll = 0, nspec_amode(n) - if (ll == 0) then - la = numptr_amode(n) - lc = numptrcw_amode(n) + pcnst - tmp_fact = fn(n) - else - la = lmassptr_amode(ll,n) - lc = lmassptrcw_amode(ll,n) + pcnst - tmp_fact = fm(n) - end if - - if ( (method_reduce_actfrac == 1) .and. & - (factor_reduce_actfrac >= 0.0_r8) .and. & - (factor_reduce_actfrac < 1.0_r8) ) & - tmp_fact = tmp_fact * factor_reduce_actfrac - - delact = min( conent(la)*tmp_fact*f_ent, conu(la) ) - delact = max( delact, 0.0_r8 ) - conu(la) = conu(la) - delact - conu(lc) = conu(lc) + delact - dconudt(la) = -delact*dt_u_inv - dconudt(lc) = delact*dt_u_inv - end do - end do ! "n = 1, ntot_amode" - - return - end subroutine ma_activate_convproc - - - -!========================================================================================= - subroutine ma_activate_convproc_method2( & - conu, dconudt, & - f_ent, dt_u, wup, & - tair, rhoair, fracice, & - pcnst_extd, lun, idiag_act, & - lchnk, i, k, & - kactfirst, ipass_calc_updraft ) -!----------------------------------------------------------------------- -! -! Purpose: -! Calculate activation of aerosol species in convective updraft -! for a single column and level -! -! Method: -! conu(l) = Updraft TMR (tracer mixing ratio) at k/k-1 interface -! f_ent = Fraction of the "before-detrainment" updraft massflux at -! k/k-1 interface" resulting from entrainment of level k air -! (where k is the current level in subr ma_convproc_tend) -! -! On entry to this routine, the conu(l) represents the updraft TMR -! after entrainment, but before chemistry/physics and detrainment. -! -! This routine applies aerosol activation to the conu tracer mixing ratios, -! then adjusts the conu so that on exit, -! conu(la) = conu_incoming(la) - conu(la)*f_act(la) -! conu(lc) = conu_incoming(lc) + conu(la)*f_act(la) -! where -! la, lc = indices for an unactivated/activated aerosol component pair -! f_act = fraction of conu(la) that is activated. The f_act are -! calculated with the Razzak-Ghan activation parameterization. -! The f_act differ for each mode, and for number/surface/mass. -! -! At cloud base (k==kactfirst), primary activation is done using the -! "standard" code in subr activate do diagnose maximum supersaturation. -! Above cloud base, secondary activation is done using a -! prescribed supersaturation. -! -! *** The updraft velocity used for activation calculations is rather -! uncertain and needs more work. However, an updraft of 1-3 m/s -! will activate essentially all of accumulation and coarse mode particles. -! -! Author: R. Easter -! -!----------------------------------------------------------------------- - - use ndrop, only: activate_aerosol - - use modal_aero_data, only: lmassptr_amode, lmassptrcw_amode, & - ntot_amode, & - nspec_amode, ntot_amode, numptr_amode, numptrcw_amode, & - specdens_amode, spechygro, & - voltonumblo_amode, voltonumbhi_amode - - use rad_constituents,only: rad_cnst_get_info - - implicit none - -!----------------------------------------------------------------------- -! arguments (note: TMR = tracer mixing ratio) - integer, intent(in) :: pcnst_extd - ! conu = tracer mixing ratios in updraft at top of this (current) level - ! The conu are changed by activation - real(r8), intent(inout) :: conu(pcnst_extd) - real(r8), intent(inout) :: dconudt(pcnst_extd) ! TMR tendencies due to activation - - real(r8), intent(in) :: f_ent ! fraction of updraft massflux that was - ! entrained across this layer == eudp/mu_p_eudp - real(r8), intent(in) :: dt_u ! lagrangian transport time (s) in the - ! updraft at current level - real(r8), intent(in) :: wup ! mean updraft vertical velocity (m/s) - ! at current level updraft - - real(r8), intent(in) :: tair ! Temperature in Kelvin - real(r8), intent(in) :: rhoair ! air density (kg/m3) - - real(r8), intent(in) :: fracice ! Fraction of ice within the cloud - ! used as in-cloud wet removal rate - integer, intent(in) :: lun ! logical unit for diagnostic output - integer, intent(in) :: idiag_act ! flag for diagnostic output - integer, intent(in) :: lchnk ! chunk index - integer, intent(in) :: i ! column index - integer, intent(in) :: k ! level index - integer, intent(in) :: kactfirst ! k at cloud base - integer, intent(in) :: ipass_calc_updraft - -!----------------------------------------------------------------------- -! local variables - integer :: ll, la, lc, n - - real(r8) :: delact ! working variable - real(r8) :: dt_u_inv ! 1.0/dt_u - real(r8) :: fluxm(ntot_amode) ! to understand this, see subr activate_aerosol - real(r8) :: fluxn(ntot_amode) ! to understand this, see subr activate_aerosol - real(r8) :: flux_fullact ! to understand this, see subr activate_aerosol - real(r8) :: fm(ntot_amode) ! mass fraction of aerosols activated - real(r8) :: fn(ntot_amode) ! number fraction of aerosols activated - real(r8) :: hygro(ntot_amode) ! current hygroscopicity for int+act - real(r8) :: naerosol(ntot_amode) ! interstitial+activated number conc (#/m3) - real(r8) :: sigw ! standard deviation of updraft velocity (cm/s) - real(r8) :: smax_prescribed ! prescribed supersaturation for secondary activation (0-1 fraction) - real(r8) :: tmpa, tmpb, tmpc ! working variable - real(r8) :: tmp_fact ! working variable - real(r8) :: vaerosol(ntot_amode) ! int+act volume (m3/m3) - real(r8) :: wbar ! mean updraft velocity (cm/s) - real(r8) :: wdiab ! diabatic vertical velocity (cm/s) - real(r8) :: wminf, wmaxf ! limits for integration over updraft spectrum (cm/s) - - character(len=32) :: spec_type - -!----------------------------------------------------------------------- - - -! when ipass_calc_updraft == 2, apply the activation tendencies -! from pass 1, but multiplied by factor_reduce_actfrac -! (can only have ipass_calc_updraft == 2 when method_reduce_actfrac = 2) - if (ipass_calc_updraft == 2) then - - dt_u_inv = 1.0_r8/dt_u - do n = 1, ntot_amode - do ll = 0, nspec_amode(n) - if (ll == 0) then - la = numptr_amode(n) - lc = numptrcw_amode(n) + pcnst - else - la = lmassptr_amode(ll,n) - lc = lmassptrcw_amode(ll,n) + pcnst - end if - - delact = dconudt(lc)*dt_u * factor_reduce_actfrac - delact = min( delact, conu(la) ) - delact = max( delact, 0.0_r8 ) - conu(la) = conu(la) - delact - conu(lc) = conu(lc) + delact - dconudt(la) = -delact*dt_u_inv - dconudt(lc) = delact*dt_u_inv - end do - end do ! "n = 1, ntot_amode" - return - - end if ! (ipass_calc_updraft == 2) - - -! check f_ent > 0 - if (f_ent <= 0.0_r8) return - - - do n = 1, ntot_amode -! compute a (or a+cw) volume and hygroscopicity - tmpa = 0.0_r8 - tmpb = 0.0_r8 - do ll = 1, nspec_amode(n) - tmpc = max( conu(lmassptr_amode(ll,n)), 0.0_r8 ) - if ( use_cwaer_for_activate_maxsat ) & - tmpc = tmpc + max( conu(lmassptrcw_amode(ll,n)+pcnst), 0.0_r8 ) - tmpc = tmpc / specdens_amode(ll,n) - tmpa = tmpa + tmpc - - ! Change the hygroscopicity of POM based on the discussion with Prof. - ! Xiaohong Liu. Some observational studies found that the primary organic - ! material from biomass burning emission shows very high hygroscopicity. - ! Also, found that BC mass will be overestimated if all the aerosols in - ! the primary mode are free to be removed. Therefore, set the hygroscopicity - ! of POM here as 0.2 to enhance the wet scavenge of primary BC and POM. - - call rad_cnst_get_info(0, n, ll, spec_type=spec_type) - if (spec_type=='p-organic' .and. convproc_pom_spechygro>0._r8) then - tmpb = tmpb + tmpc * convproc_pom_spechygro - else - tmpb = tmpb + tmpc * spechygro(ll,n) - end if - end do - vaerosol(n) = tmpa * rhoair - if (tmpa < 1.0e-35_r8) then - hygro(n) = 0.2_r8 - else - hygro(n) = tmpb/tmpa - end if - -! load a (or a+cw) number and bound it - tmpa = max( conu(numptr_amode(n)), 0.0_r8 ) - if ( use_cwaer_for_activate_maxsat ) & - tmpa = tmpa + max( conu(numptrcw_amode(n)+pcnst), 0.0_r8 ) - naerosol(n) = tmpa * rhoair - naerosol(n) = max( naerosol(n), & - vaerosol(n)*voltonumbhi_amode(n) ) - naerosol(n) = min( naerosol(n), & - vaerosol(n)*voltonumblo_amode(n) ) - -! diagnostic output for testing/development -! if (lun > 0) then -! if (n == 1) then -! write(lun,9500) -! write(lun,9510) (cnst_name(l), conu(l), l=1,pcnst_extd) -! write(lun,9520) tair, rhoaircgs, airconcgs -! end if -! write(lun,9530) n, ntype(n), vaerosol -! write(lun,9540) naerosol(n), tmp*airconcgs, & -! voltonumbhi_amode(n), voltonumblo_amode(n) -! write(lun,9550) (maerosol(l,n), l=1,ntype(n)) -!9500 format( / 'activate_conv output -- conu values' ) -!9510 format( 3( a, 1pe11.3, 4x ) ) -!9520 format( 'ta, rhoa, acon ', 3(1pe11.3) ) -!9530 format( 'n, ntype, sg, vol ', i6, i5, 2(1pe11.3) ) -!9540 format( 'num, num0, v2nhi&lo', 4(1pe11.3) ) -!9550 format( 'masses ', 6(1pe11.3) ) -! end if - - end do - - -! call Razzak-Ghan activation routine with single updraft - wbar = max( wup, 0.5_r8 ) ! force wbar >= 0.5 m/s for now - sigw = 0.0_r8 - wdiab = 0.0_r8 - wminf = wbar - wmaxf = wbar - - if (k == kactfirst) then - - call activate_aerosol( & - wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & - naerosol, ntot_amode, vaerosol, hygro, aero_props_obj, & - fn, fm, fluxn, fluxm, flux_fullact ) - - - else -! above cloud base - do secondary activation with prescribed supersat -! that is constant with height - smax_prescribed = method2_activate_smaxmax - call activate_aerosol( & - wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, & - naerosol, ntot_amode, vaerosol, hygro, aero_props_obj, & - fn, fm, fluxn, fluxm, flux_fullact, smax_prescribed ) - end if - - -! diagnostic output for testing/development - if (idiag_act > 0) then - n = min( ntot_amode, 3 ) - write(lun, '(a,i3,2f6.3, 1p,2(2x,3e10.2), 0p,3(2x,3f6.3) )' ) & - 'qaku k,w,qn,qm,hy,fn,fm', k, wup, wbar, & - naerosol(1:n)/rhoair, vaerosol(1:n)*1.8e3_r8/rhoair, & - hygro(1:n), fn(1:n), fm(1:n) - ! convert naer, vaer to number and (approx) mass TMRs - end if -! if (lun > 0) then -! write(lun,9560) (fn(n), n=1,ntot_amode) -! write(lun,9570) (fm(n), n=1,ntot_amode) -!9560 format( 'fnact values ', 6(1pe11.3) ) -!9570 format( 'fmact values ', 6(1pe11.3) ) -! end if - - -! apply the activation fractions to the updraft aerosol mixing ratios - dt_u_inv = 1.0_r8/dt_u - - do n = 1, ntot_amode - do ll = 0, nspec_amode(n) - if (ll == 0) then - la = numptr_amode(n) - lc = numptrcw_amode(n) + pcnst - tmp_fact = fn(n) - else - la = lmassptr_amode(ll,n) - lc = lmassptrcw_amode(ll,n) + pcnst - tmp_fact = fm(n) - end if - - if ( (method_reduce_actfrac == 1) .and. & - (factor_reduce_actfrac >= 0.0_r8) .and. & - (factor_reduce_actfrac < 1.0_r8) ) & - tmp_fact = tmp_fact * factor_reduce_actfrac - - delact = min( conu(la)*tmp_fact, conu(la) ) - delact = max( delact, 0.0_r8 ) - conu(la) = conu(la) - delact - conu(lc) = conu(lc) + delact - dconudt(la) = -delact*dt_u_inv - dconudt(lc) = delact*dt_u_inv - end do - end do ! "n = 1, ntot_amode" - - return - end subroutine ma_activate_convproc_method2 - - - -!========================================================================================= - subroutine ma_resuspend_convproc( & - dcondt, dcondt_resusp, & - const, dp_i, ktop, kbot_prevap, pcnst_extd ) -!----------------------------------------------------------------------- -! -! Purpose: -! Calculate resuspension of activated aerosol species resulting from both -! detrainment from updraft and downdraft into environment -! subsidence and lifting of environment, which may move air from -! levels with large-scale cloud to levels with no large-scale cloud -! -! Method: -! Three possible approaches were considered: -! -! 1. Ad-hoc #1 approach. At each level, adjust dcondt for the activated -! and unactivated portions of a particular aerosol species so that the -! ratio of dcondt (activated/unactivate) is equal to the ratio of the -! mixing ratios before convection. -! THIS WAS IMPLEMENTED IN MIRAGE2 -! -! 2. Ad-hoc #2 approach. At each level, adjust dcondt for the activated -! and unactivated portions of a particular aerosol species so that the -! change to the activated portion is minimized (zero if possible). The -! would minimize effects of convection on the large-scale cloud. -! THIS IS CURRENTLY IMPLEMENTED IN CAM5 where we assume that convective -! clouds have no impact on the stratiform-cloudborne aerosol -! -! 3. Mechanistic approach that treats the details of interactions between -! the large-scale and convective clouds. (Something for the future.) -! -! Author: R. Easter -! -!----------------------------------------------------------------------- - - use modal_aero_data, only: lmassptr_amode, lmassptrcw_amode, & - nspec_amode, ntot_amode, numptr_amode, numptrcw_amode - - implicit none - -!----------------------------------------------------------------------- -! arguments -! (note: TMR = tracer mixing ratio) - integer, intent(in) :: pcnst_extd - real(r8), intent(inout) :: dcondt(pcnst_extd,pver) - ! overall TMR tendency from convection - real(r8), intent(inout) :: dcondt_resusp(pcnst_extd,pver) - ! portion of TMR tendency due to resuspension - ! (actually, due to the adjustments made here) - real(r8), intent(in) :: const(pcnst_extd,pver) ! TMRs before convection - - real(r8), intent(in) :: dp_i(pver) ! pressure thickness of level (in mb) - integer, intent(in) :: ktop, kbot_prevap ! indices of top and bottom cloud levels - -!----------------------------------------------------------------------- -! local variables - integer :: k, ll, la, lc, n - real(r8) :: qa, qc, qac ! working variables (mixing ratios) - real(r8) :: qdota, qdotc, qdotac ! working variables (MR tendencies) -!----------------------------------------------------------------------- - - - do n = 1, ntot_amode - - do ll = 0, nspec_amode(n) - if (ll == 0) then - la = numptr_amode(n) - lc = numptrcw_amode(n) + pcnst - else - la = lmassptr_amode(ll,n) - lc = lmassptrcw_amode(ll,n) + pcnst - end if - -! apply adjustments to dcondt for pairs of unactivated (la) and -! activated (lc) aerosol species - if ( (la <= 0) .or. (la > pcnst_extd) ) cycle - if ( (lc <= 0) .or. (lc > pcnst_extd) ) cycle - - do k = ktop, kbot_prevap - qdota = dcondt(la,k) - qdotc = dcondt(lc,k) - qdotac = qdota + qdotc - -! mirage2 approach -! qa = max( const(la,k), 0.0_r8 ) -! qc = max( const(lc,k), 0.0_r8 ) -! qac = qa + qc -! if (qac <= 0.0) then -! dcondt(la,k) = qdotac -! dcondt(lc,k) = 0.0 -! else -! dcondt(la,k) = qdotac*(qa/qac) -! dcondt(lc,k) = qdotac*(qc/qac) -! end if - -! cam5 approach - if (convproc_do_evaprain_atonce) then - dcondt(la,k) = qdota - dcondt(lc,k) = qdotc - - dcondt_resusp(la,k) = dcondt(la,k) - dcondt_resusp(lc,k) = dcondt(lc,k) - else - dcondt(la,k) = qdotac - dcondt(lc,k) = 0.0_r8 - - dcondt_resusp(la,k) = (dcondt(la,k) - qdota) - dcondt_resusp(lc,k) = (dcondt(lc,k) - qdotc) - end if - end do - - end do ! "ll = -1, nspec_amode(n)" - end do ! "n = 1, ntot_amode" - - return - end subroutine ma_resuspend_convproc - - - -!========================================================================================= - - - -end module modal_aero_convproc diff --git a/src/chemistry/modal_aero/modal_aero_rename.F90 b/src/chemistry/modal_aero/modal_aero_rename.F90 index 8a7d120f24..9ff3a2c87d 100644 --- a/src/chemistry/modal_aero/modal_aero_rename.F90 +++ b/src/chemistry/modal_aero/modal_aero_rename.F90 @@ -183,9 +183,6 @@ subroutine modal_aero_rename_sub( & real(r8), intent(inout) :: dqqcwdt(ncol,pver,pcnstxx) real(r8), intent(in) :: dqdt_other(ncol,pver,pcnstxx) ! tendencies for "other" continuous growth process - ! currently in cam3 - ! dqdt is from gas (h2so4, nh3) condensation - ! dqdt_other is from aqchem and soa ! *** NOTE ncol and pcnstxx dimensions real(r8), intent(in) :: dqqcwdt_other(ncol,pver,pcnstxx) logical, intent(inout) :: dotendrn(pcnstxx) ! identifies the species for which @@ -286,9 +283,6 @@ subroutine modal_aero_rename_no_acc_crs_sub( & real(r8), intent(inout) :: dqqcwdt(ncol,pver,pcnstxx) real(r8), intent(in) :: dqdt_other(ncol,pver,pcnstxx) ! tendencies for "other" continuous growth process - ! currently in cam3 - ! dqdt is from gas (h2so4, nh3) condensation - ! dqdt_other is from aqchem and soa ! *** NOTE ncol and pcnstxx dimensions real(r8), intent(in) :: dqqcwdt_other(ncol,pver,pcnstxx) logical, intent(inout) :: dotendrn(pcnstxx) ! identifies the species for which @@ -878,9 +872,6 @@ subroutine modal_aero_rename_acc_crs_sub( & real(r8), intent(inout) :: dqqcwdt(ncol,pver,pcnstxx) real(r8), intent(in) :: dqdt_other(ncol,pver,pcnstxx) ! tendencies for "other" continuous growth process - ! currently in cam3 - ! dqdt is from gas (h2so4, nh3) condensation - ! dqdt_other is from aqchem and soa ! *** NOTE ncol and pcnstxx dimensions real(r8), intent(in) :: dqqcwdt_other(ncol,pver,pcnstxx) logical, intent(inout) :: dotendrn(pcnstxx) ! identifies the species for which diff --git a/src/chemistry/utils/prescribed_ozone.F90 b/src/chemistry/utils/prescribed_ozone.F90 index 92a4ac84b4..cc82603025 100644 --- a/src/chemistry/utils/prescribed_ozone.F90 +++ b/src/chemistry/utils/prescribed_ozone.F90 @@ -215,13 +215,8 @@ subroutine prescribed_ozone_adv( state, pbuf2d) if( .not. has_prescribed_ozone ) return - if( cam_physpkg_is('cam3') .and. aqua_planet ) then - molmass = 48._r8 - amass = 28.9644_r8 - else - molmass = 47.9981995_r8 - amass = mwdry - end if + molmass = 47.9981995_r8 + amass = mwdry call advance_trcdata( fields, file, state, pbuf2d ) diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90 index 99fb9b3a0b..39222fc536 100644 --- a/src/control/cam_history.F90 +++ b/src/control/cam_history.F90 @@ -4694,7 +4694,6 @@ subroutine h_define (t, restart) num_hdims = 2 do i = 1, num_hdims dimindex(i) = header_info(1)%get_hdimid(i) - nacsdims(i) = header_info(1)%get_hdimid(i) end do else if (patch_output) then ! All patches for this variable should be on the same grid @@ -4720,7 +4719,6 @@ subroutine h_define (t, restart) num_hdims = header_info(grd)%num_hdims() do i = 1, num_hdims dimindex(i) = header_info(grd)%get_hdimid(i) - nacsdims(i) = header_info(grd)%get_hdimid(i) end do end if ! is_satfile @@ -4836,22 +4834,8 @@ subroutine h_define (t, restart) tape(t)%hlist(fld)%field%name) call cam_pio_handle_error(ierr, & 'h_define: cannot define basename for '//trim(fname_tmp)) - end if - - if (restart) then - ! For restart history files, we need to save accumulation counts - fname_tmp = trim(fname_tmp)//'_nacs' - if (.not. associated(tape(t)%hlist(fld)%nacs_varid)) then - allocate(tape(t)%hlist(fld)%nacs_varid) - end if - if (size(tape(t)%hlist(fld)%nacs, 1) > 1) then - call cam_pio_def_var(tape(t)%Files(f), trim(fname_tmp), pio_int, & - nacsdims(1:num_hdims), tape(t)%hlist(fld)%nacs_varid) - else - ! Save just one value representing all chunks - call cam_pio_def_var(tape(t)%Files(f), trim(fname_tmp), pio_int, & - tape(t)%hlist(fld)%nacs_varid) - end if + end if + if(restart) then ! for standard deviation if (associated(tape(t)%hlist(fld)%sbuf)) then fname_tmp = strip_suffix(tape(t)%hlist(fld)%field%name) @@ -4862,9 +4846,69 @@ subroutine h_define (t, restart) call cam_pio_def_var(tape(t)%Files(f), trim(fname_tmp), pio_double, & dimids_tmp(1:fdims), tape(t)%hlist(fld)%sbuf_varid) endif - end if - end do ! Loop over output patches + endif + end do ! Loop over output patches end do ! Loop over fields + if (restart) then + do fld = 1, nflds(t) + if(is_satfile(t)) then + num_hdims=0 + nfils(t)=1 + else if (interpolate) then + ! Interpolate can't use normal grid code since we are forcing fields + ! to use interpolate decomp + if (.not. allocated(header_info)) then + ! Safety check + call endrun('h_define: header_info not allocated') + end if + num_hdims = 2 + do i = 1, num_hdims + nacsdims(i) = header_info(1)%get_hdimid(i) + end do + else if (patch_output) then + ! All patches for this variable should be on the same grid + num_hdims = tape(t)%patches(1)%num_hdims(tape(t)%hlist(fld)%field%decomp_type) + else + ! Normal grid output + ! Find appropriate grid in header_info + if (.not. allocated(header_info)) then + ! Safety check + call endrun('h_define: header_info not allocated') + end if + grd = -1 + do i = 1, size(header_info) + if (header_info(i)%get_gridid() == tape(t)%hlist(fld)%field%decomp_type) then + grd = i + exit + end if + end do + if (grd < 0) then + write(errormsg, '(a,i0,2a)') 'grid, ',tape(t)%hlist(fld)%field%decomp_type,', not found for ',trim(fname_tmp) + call endrun('H_DEFINE: '//errormsg) + end if + num_hdims = header_info(grd)%num_hdims() + do i = 1, num_hdims + nacsdims(i) = header_info(grd)%get_hdimid(i) + end do + end if ! is_satfile + + fname_tmp = strip_suffix(tape(t)%hlist(fld)%field%name) + ! For restart history files, we need to save accumulation counts + fname_tmp = trim(fname_tmp)//'_nacs' + if (.not. associated(tape(t)%hlist(fld)%nacs_varid)) then + allocate(tape(t)%hlist(fld)%nacs_varid) + end if + if (size(tape(t)%hlist(fld)%nacs, 1) > 1) then + call cam_pio_def_var(tape(t)%Files(f), trim(fname_tmp), pio_int, & + nacsdims(1:num_hdims), tape(t)%hlist(fld)%nacs_varid) + else + ! Save just one value representing all chunks + call cam_pio_def_var(tape(t)%Files(f), trim(fname_tmp), pio_int, & + tape(t)%hlist(fld)%nacs_varid) + end if + + end do ! Loop over fields + end if ! deallocate(mdimids) ret = pio_enddef(tape(t)%Files(f)) diff --git a/src/control/cam_snapshot_common.F90 b/src/control/cam_snapshot_common.F90 index e30d2d340a..74e39ac7b8 100644 --- a/src/control/cam_snapshot_common.F90 +++ b/src/control/cam_snapshot_common.F90 @@ -48,7 +48,7 @@ module cam_snapshot_common ! This is the number of pbuf fields in the CAM code that are declared with the fieldname as opposed to being data driven. -integer, parameter :: npbuf_all = 327 +integer, parameter :: npbuf_all = 310 type snapshot_type character(len=40) :: ddt_string @@ -81,7 +81,7 @@ module cam_snapshot_common integer :: cam_snapshot_before_num, cam_snapshot_after_num ! Note the maximum number of variables for each type -type (snapshot_type) :: state_snapshot(27) +type (snapshot_type) :: state_snapshot(29) type (snapshot_type) :: cnst_snapshot(pcnst) type (snapshot_type) :: tend_snapshot(6) type (snapshot_type) :: cam_in_snapshot(30) @@ -269,16 +269,22 @@ subroutine cam_state_snapshot_init(cam_snapshot_before_num_in, cam_snapshot_afte 'state%zi', 'state_zi', 'm', 'ilev') call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'state%te_ini', 'state_te_ini', 'unset', horiz_only) + 'state%te_ini_phys', 'state_te_ini_phys', 'unset', horiz_only) call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'state%te_cur', 'state_te_cur', 'unset', horiz_only) + 'state%te_cur_phys', 'state_te_cur_phys', 'unset', horiz_only) call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'state%tw_ini', 'state_tw_ini', 'unset', horiz_only) + 'state%tw_ini', 'state_tw_ini', 'unset', horiz_only) call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & - 'state%tw_cur', 'state_tw_cur', 'unset', horiz_only) + 'state%tw_cur', 'state_tw_cur', 'unset', horiz_only) + + call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'state%te_ini_dyn', 'state_te_ini_dyn', 'unset', horiz_only) + + call snapshot_addfld( nstate_var, state_snapshot, cam_snapshot_before_num, cam_snapshot_after_num, & + 'state%te_cur_dyn', 'state_te_cur_dyn', 'unset', horiz_only) end subroutine cam_state_snapshot_init @@ -737,6 +743,8 @@ end subroutine snapshot_addfld subroutine state_snapshot_all_outfld(lchnk, file_num, state) + use physics_types, only: phys_te_idx, dyn_te_idx + integer, intent(in) :: lchnk integer, intent(in) :: file_num type(physics_state), intent(in) :: state @@ -820,11 +828,11 @@ subroutine state_snapshot_all_outfld(lchnk, file_num, state) case ('state%zi') call outfld(state_snapshot(i)%standard_name, state%zi, pcols, lchnk) - case ('state%te_ini') - call outfld(state_snapshot(i)%standard_name, state%te_ini, pcols, lchnk) + case ('state%te_ini_phys') + call outfld(state_snapshot(i)%standard_name, state%te_ini(:, phys_te_idx), pcols, lchnk) - case ('state%te_cur') - call outfld(state_snapshot(i)%standard_name, state%te_cur, pcols, lchnk) + case ('state%te_cur_phys') + call outfld(state_snapshot(i)%standard_name, state%te_cur(:, phys_te_idx), pcols, lchnk) case ('state%tw_ini') call outfld(state_snapshot(i)%standard_name, state%tw_ini, pcols, lchnk) @@ -832,6 +840,12 @@ subroutine state_snapshot_all_outfld(lchnk, file_num, state) case ('state%tw_cur') call outfld(state_snapshot(i)%standard_name, state%tw_cur, pcols, lchnk) + case ('state%te_ini_dyn') + call outfld(state_snapshot(i)%standard_name, state%te_ini(:, dyn_te_idx), pcols, lchnk) + + case ('state%te_cur_dyn') + call outfld(state_snapshot(i)%standard_name, state%te_cur(:, dyn_te_idx), pcols, lchnk) + case default call endrun('ERROR in state_snapshot_all_outfld: no match found for '//trim(state_snapshot(i)%ddt_string)) @@ -1243,17 +1257,6 @@ subroutine fill_pbuf_info(pbuf_info, pbuf, const_cname) 'AurIPRateSum ','unset ',& 'awk_PBL ','unset ',& 'bprod ','unset ',& - 'cam3_bcphi ','unset ',& - 'cam3_bcpho ','unset ',& - 'cam3_dust1 ','unset ',& - 'cam3_dust2 ','unset ',& - 'cam3_dust3 ','unset ',& - 'cam3_dust4 ','unset ',& - 'cam3_ocphi ','unset ',& - 'cam3_ocpho ','unset ',& - 'cam3_ssam ','unset ',& - 'cam3_sscm ','unset ',& - 'cam3_sul ','unset ',& 'CC_ni ','unset ',& 'CC_nl ','unset ',& 'CC_qi ','unset ',& @@ -1328,9 +1331,7 @@ subroutine fill_pbuf_info(pbuf_info, pbuf, const_cname) 'delta_thl_PBL ','unset ',& 'delta_tr_PBL ','unset ',& 'delta_u_PBL ','unset ',& - 'delta_v_PBL ','unset '/) , (/2,100/)) - - pbuf_all(1:2,101:200) = reshape ( (/ & + 'delta_v_PBL ','unset ',& 'DES ','unset ',& 'DGNUM ','unset ',& 'DGNUMWET ','unset ',& @@ -1338,12 +1339,12 @@ subroutine fill_pbuf_info(pbuf_info, pbuf, const_cname) 'DLFZM ','kg/kg/s ',& 'DNIFZM ','1/kg/s ',& 'DNLFZM ','1/kg/s ',& - 'DP_CLDICE ','unset ',& - 'DP_CLDLIQ ','unset ',& 'DP_FLXPRC ','unset ',& 'DP_FLXSNW ','unset ',& 'DP_FRAC ','unset ',& - 'dragblj ','1/s ',& + 'dragblj ','1/s ' /), (/2,100/)) + + pbuf_all(1:2,101:200) = reshape ( (/ & 'DRYMASS ','unset ',& 'DRYRAD ','unset ',& 'DRYVOL ','unset ',& @@ -1430,9 +1431,7 @@ subroutine fill_pbuf_info(pbuf_info, pbuf, const_cname) 'QCWAT ','unset ',& 'QFLX ','kg/m2/s ',& 'QFLX_RES ','unset ',& - 'QINI ','unset ' /), (/2,100/)) - - pbuf_all(1:2,201:300) = reshape ( (/ & + 'QINI ','unset ',& 'qir_det ','kg/kg ',& 'QIST ','unset ',& 'qlr_det ','kg/kg ',& @@ -1445,7 +1444,9 @@ subroutine fill_pbuf_info(pbuf_info, pbuf, const_cname) 'QRS ','K/s ',& 'qrsin ','unset ',& 'QSATFAC ','- ',& - 'QSNOW ','kg/kg ',& + 'QSNOW ','kg/kg ' /), (/2,100/)) + + pbuf_all(1:2,201:300) = reshape ( (/ & 'QTeAur ','unset ',& 'qti_flx ','unset ',& 'qtl_flx ','unset ',& @@ -1473,9 +1474,7 @@ subroutine fill_pbuf_info(pbuf_info, pbuf, const_cname) 'SD ','unset ',& 'SGH30 ','unset ',& 'SGH ','unset ',& - 'SH_CLDICE1 ','unset ',& 'SH_CLDICE ','unset ',& - 'SH_CLDLIQ1 ','unset ',& 'SH_CLDLIQ ','unset ',& 'SH_E_ED_RATIO ','unset ',& 'SHFLX ','W/m2 ',& @@ -1484,7 +1483,6 @@ subroutine fill_pbuf_info(pbuf_info, pbuf, const_cname) 'SH_FLXSNW ','unset ',& 'SH_FRAC ','unset ',& 'shfrc ','unset ',& - 'smaw ','unset ',& 'SNOW_DP ','unset ',& 'SNOW_PCW ','unset ',& 'SNOW_SED ','unset ',& @@ -1526,15 +1524,12 @@ subroutine fill_pbuf_info(pbuf_info, pbuf, const_cname) 'TTEND_DP ','unset ',& 'TTEND_SH ','unset ',& 'T_TTEND ','unset ',& - 'turbtype ','unset ',& "UI ",'m/s ',& 'UM ','unset ',& 'UP2_nadv ','unset ',& 'UPWP ','m^2/s^2 ',& 'UZM ','M/S ',& - 'VI ','m/s ' /), (/2,100/)) - - pbuf_all(1:2,301:npbuf_all) = reshape ( (/ & + 'VI ','m/s ',& 'VM ','m/s ',& 'VOLC_MMR ','unset ',& 'VOLC_RAD_GEOM ','unset ',& @@ -1551,7 +1546,9 @@ subroutine fill_pbuf_info(pbuf_info, pbuf, const_cname) 'WPTHVP ','unset ',& 'WSEDL ','unset ',& 'wstarPBL ','unset ',& - 'ZM_DP ','unset ',& + 'ZM_DP ','unset ' /), (/2,100/)) + + pbuf_all(1:2,301:npbuf_all) = reshape ( (/ & 'ZM_DSUBCLD ','unset ',& 'ZM_DU ','unset ',& 'ZM_ED ','unset ',& @@ -1561,7 +1558,7 @@ subroutine fill_pbuf_info(pbuf_info, pbuf, const_cname) 'ZM_MAXG ','unset ',& 'ZM_MD ','unset ',& 'ZM_MU ','unset ',& - 'ZTODT ','unset ' /), (/2,27/)) + 'ZTODT ','unset ' /), (/2,10/)) ! Fields which are added with pbuf_add_field calls, but are data driven. These are not ! included in the above list. This means that these fields will not have proper units diff --git a/src/control/runtime_opts.F90 b/src/control/runtime_opts.F90 index 6d5a6e1058..915664cdb9 100644 --- a/src/control/runtime_opts.F90 +++ b/src/control/runtime_opts.F90 @@ -41,8 +41,6 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) use phys_control, only: phys_ctl_readnl use wv_saturation, only: wv_sat_readnl use ref_pres, only: ref_pres_readnl - use cam3_aero_data, only: cam3_aero_data_readnl - use cam3_ozone_data, only: cam3_ozone_data_readnl use dadadj_cam, only: dadadj_readnl use macrop_driver, only: macrop_driver_readnl use microp_driver, only: microp_driver_readnl @@ -143,8 +141,6 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon) call phys_ctl_readnl(nlfilename) call wv_sat_readnl(nlfilename) call ref_pres_readnl(nlfilename) - call cam3_aero_data_readnl(nlfilename) - call cam3_ozone_data_readnl(nlfilename) call dadadj_readnl(nlfilename) call macrop_driver_readnl(nlfilename) call microp_driver_readnl(nlfilename) diff --git a/src/dynamics/fv/cd_core.F90 b/src/dynamics/fv/cd_core.F90 index f7f64e6512..ad5e35aab8 100644 --- a/src/dynamics/fv/cd_core.F90 +++ b/src/dynamics/fv/cd_core.F90 @@ -251,7 +251,6 @@ subroutine cd_core(grid, nx, u, v, pt, & ! with coefficient del2coef (default 3E5) ! ! - ldiv2: 2nd-order divergence damping everywhere and increasing in top layers - ! (default cam3.5 setting) ! ! - ldiv4: 4th-order divergence damping everywhere and increasing in top layers ! @@ -530,7 +529,6 @@ subroutine cd_core(grid, nx, u, v, pt, & if (div24del2flag == 2) then - ! cam3.5 default damping setting ldiv2 = .true. ldiv4 = .false. ldel2 = .false. @@ -608,7 +606,7 @@ subroutine cd_core(grid, nx, u, v, pt, & !*********************************************** ! - ! cam3 default second-order divergence damping + ! second-order divergence damping ! !*********************************************** press = D0_5 * ( grid%ak(k)+grid%ak(k+1) + & diff --git a/src/dynamics/fv/dynamics_vars.F90 b/src/dynamics/fv/dynamics_vars.F90 index 97cbfb7d34..73f8c1e26b 100644 --- a/src/dynamics/fv/dynamics_vars.F90 +++ b/src/dynamics/fv/dynamics_vars.F90 @@ -927,7 +927,6 @@ subroutine grid_vars_init(pi, ae, om, dt, fft_flt, & grid%cosp, grid%cose, ycrit) !for filtering of u and v in div4 damping - !(needs larger halo than cam3.5 code) call pft_cf(im, jm, js2gs, jn2gd, jn1gs, & grid%scdiv4, grid%sediv4, grid%dcdiv4, grid%dediv4, & grid%cosp, grid%cose, ycrit) diff --git a/src/dynamics/mpas/Makefile b/src/dynamics/mpas/Makefile index 216be0ff1a..f79b718aa0 100644 --- a/src/dynamics/mpas/Makefile +++ b/src/dynamics/mpas/Makefile @@ -1,10 +1,13 @@ -CPPFLAGS := -D_MPI -DMPAS_NATIVE_TIMERS -DMPAS_GIT_VERSION=unknown -DMPAS_NAMELIST_SUFFIX=atmosphere -DMPAS_CAM_DYCORE -DMPAS_PIO_SUPPORT -DMPAS_NO_ESMF_INIT +GIT_VERSION=$(shell git -C "$(MPAS_SRC_ROOT)/dycore" describe --always --dirty --tags || echo "N/A" ) +CPPFLAGS := -D_MPI -DMPAS_NATIVE_TIMERS -DMPAS_CAM_DYCORE -DMPAS_PIO_SUPPORT -DMPAS_NO_ESMF_INIT -DMPAS_GIT_VERSION="$(GIT_VERSION)" -DMPAS_BUILD_TARGET="N/A" -DMPAS_NAMELIST_SUFFIX="atmosphere" ifdef PIODEF CPPFLAGS += $(PIODEF) endif ifeq ($(strip $(COMP_INTERFACE)),nuopc) CPPFLAGS += -DMPAS_EXTERNAL_ESMF_LIB endif +# Uncomment next line to enable MPAS to use mpi_f08 module +#CPPFLAGS += -DMPAS_USE_MPI_F08 REGISTRY_FILE := $(MPAS_SRC_ROOT)/dycore/src/core_atmosphere/Registry.xml @@ -80,6 +83,8 @@ FRAME_OBJS = \ mpas_io_streams.o \ mpas_bootstrapping.o \ mpas_io_units.o \ + mpas_stream_inquiry.o \ + stream_inquiry.o \ mpas_stream_manager.o \ mpas_stream_list.o \ mpas_forcing.o \ @@ -179,6 +184,8 @@ mpas_io_units.o: mpas_kind_types.o mpas_threading.o: mpas_kind_types.o +mpas_stream_inquiry.o: mpas_derived_types.o mpas_log.o mpas_c_interfacing.o stream_inquiry.o + mpas_stream_list.o: mpas_derived_types.o mpas_kind_types.o mpas_io_streams.o mpas_timekeeping.o regex_matching.o mpas_log.o mpas_stream_manager.o: mpas_io_streams.o mpas_timekeeping.o mpas_derived_types.o mpas_kind_types.o mpas_c_interfacing.o mpas_stream_list.o mpas_dmpar.o mpas_io.o mpas_threading.o mpas_log.o @@ -226,7 +233,7 @@ streams_gen: $(STREAMS_GEN_OBJS) ezxml.o # incs: $(REGISTRY_FILE) ( cpp -P -traditional $(CPPFLAGS) -I$(MPAS_SRC_ROOT)/dycore/src/core_atmosphere/diagnostics $(REGISTRY_FILE) > Registry_processed.xml ) - ( ./registry Registry_processed.xml ) + ( ./registry Registry_processed.xml $(CPPFLAGS) ) # # Dycore diff --git a/src/dynamics/mpas/driver/cam_mpas_subdriver.F90 b/src/dynamics/mpas/driver/cam_mpas_subdriver.F90 index 676bacd4af..59d9c462ee 100644 --- a/src/dynamics/mpas/driver/cam_mpas_subdriver.F90 +++ b/src/dynamics/mpas/driver/cam_mpas_subdriver.F90 @@ -73,13 +73,20 @@ end subroutine halt_model !----------------------------------------------------------------------- subroutine cam_mpas_init_phase1(mpicom, endrun, logUnits, realkind) +#ifdef MPAS_USE_MPI_F08 + use mpi_f08, only : mpi_comm_type => mpi_comm +#endif use mpas_domain_routines, only : mpas_allocate_domain use mpas_framework, only : mpas_framework_init_phase1 use atm_core_interface, only : atm_setup_core, atm_setup_domain use mpas_kind_types, only : RKIND ! Dummy argument +#ifdef MPAS_USE_MPI_F08 + type(mpi_comm_type), intent(in) :: mpicom +#else integer, intent(in) :: mpicom +#endif procedure(halt_model) :: endrun integer, dimension(2), intent(in) :: logUnits integer, intent(in) :: realkind @@ -108,7 +115,7 @@ subroutine cam_mpas_init_phase1(mpicom, endrun, logUnits, realkind) ! ! Initialize MPAS infrastructure (principally, the mpas_dmpar module) ! - call mpas_framework_init_phase1(domain_ptr % dminfo, mpi_comm=mpicom) + call mpas_framework_init_phase1(domain_ptr % dminfo, external_comm=mpicom) call atm_setup_core(corelist) call atm_setup_domain(domain_ptr) @@ -152,6 +159,7 @@ subroutine cam_mpas_init_phase2(pio_subsystem, endrun, cam_calendar) use mpas_framework, only : mpas_framework_init_phase2 use mpas_timer, only : mpas_timer_start + use mpas_stream_inquiry, only : mpas_stream_inquiry_new_streaminfo type (iosystem_desc_t), pointer :: pio_subsystem procedure(halt_model) :: endrun @@ -181,12 +189,20 @@ subroutine cam_mpas_init_phase2(pio_subsystem, endrun, cam_calendar) call mpas_timer_start('total time') + ! Since MPAS is being used as a dycore and is not responsible for IO, it's enough to create this + ! object without running its init(). Any queries made to it will always return `.false.` + domain_ptr % streamInfo => mpas_stream_inquiry_new_streaminfo() + if (.not. associated(domain_ptr % streamInfo)) then + call endrun(subname//': FATAL: streamInfo instantiation failed for core '//trim(domain_ptr % core % coreName)) + end if + ierr = domain_ptr % core % define_packages(domain_ptr % packages) if ( ierr /= 0 ) then call endrun(subname//': FATAL: Package definition failed for core '//trim(domain_ptr % core % coreName)) end if - ierr = domain_ptr % core % setup_packages(domain_ptr % configs, domain_ptr % packages, domain_ptr % iocontext) + ierr = domain_ptr % core % setup_packages(domain_ptr % configs, domain_ptr % streamInfo, & + domain_ptr % packages, domain_ptr % iocontext) if ( ierr /= 0 ) then call endrun(subname//': FATAL: Package setup failed for core '//trim(domain_ptr % core % coreName)) end if @@ -2353,6 +2369,7 @@ subroutine cam_mpas_finalize() ! ! Finalize infrastructure ! + deallocate(domain_ptr % streamInfo) ! created by mpas_stream_inquiry_new_streaminfo ! Print out log stats and close log file ! (Do this after timer stats are printed and stream mgr finalized, diff --git a/src/dynamics/mpas/dycore b/src/dynamics/mpas/dycore index b8c33daa4b..b566fc8a95 160000 --- a/src/dynamics/mpas/dycore +++ b/src/dynamics/mpas/dycore @@ -1 +1 @@ -Subproject commit b8c33daa4b124f116b0ba1b1386968c4c15b42e4 +Subproject commit b566fc8a959390d838aba08fd03c81edae986f6a diff --git a/src/dynamics/mpas/dyn_grid.F90 b/src/dynamics/mpas/dyn_grid.F90 index d0b53c5fa0..7efcc866dd 100644 --- a/src/dynamics/mpas/dyn_grid.F90 +++ b/src/dynamics/mpas/dyn_grid.F90 @@ -453,6 +453,8 @@ subroutine setup_time_invariant(fh_ini) type(mpas_pool_type), pointer :: meshPool real(r8), pointer :: rdzw(:) real(r8), allocatable :: dzw(:) + integer, pointer :: nCells + real(r8), dimension(:), pointer :: lonCell integer :: k, kk integer :: ierr @@ -473,6 +475,7 @@ subroutine setup_time_invariant(fh_ini) call mpas_pool_get_dimension(meshPool, 'nEdgesSolve', nEdgesSolve) call mpas_pool_get_dimension(meshPool, 'nVerticesSolve', nVerticesSolve) call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevelsSolve) ! MPAS always solves over the full column + call mpas_pool_get_dimension(meshPool, 'nCells', nCells) ! check that number of vertical layers matches MPAS grid data if (plev /= nVertLevelsSolve) then @@ -482,6 +485,17 @@ subroutine setup_time_invariant(fh_ini) ') does not match plev ('//int2str(nVertLevelsSolve)//').') end if + ! Ensure longitudes are within the [0,2*pi) range, and only remap values that + ! are outside the range. Some non-simple physics in CAM require this + ! longitude range, the MPAS-A dycore does not require any specific range for + ! lonCell + call mpas_pool_get_array(meshPool, 'lonCell', lonCell) + do k=1,nCells + if (lonCell(k) < 0._r8 .or. lonCell(k) >= (2._r8 * pi)) then + lonCell(k) = lonCell(k) - (2._r8 * pi) * floor(lonCell(k) / (2._r8 * pi)) + end if + end do + ! Initialize fields needed for reconstruction of cell-centered winds from edge-normal winds ! Note: This same pair of calls happens a second time later in the initialization of ! the MPAS-A dycore (in atm_mpas_init_block), but the redundant calls do no harm diff --git a/src/dynamics/se/dycore/interpolate_mod.F90 b/src/dynamics/se/dycore/interpolate_mod.F90 index 65e1e26c9b..55093dad73 100644 --- a/src/dynamics/se/dycore/interpolate_mod.F90 +++ b/src/dynamics/se/dycore/interpolate_mod.F90 @@ -1625,8 +1625,8 @@ subroutine interpolate_vector2d(interpdata,elem,fld_cube,npts,fld,input_coords, if (npts==np) then interp => interp_p - else if (npts==np) then - call endrun('interpolate_vector2d: Error in interpolate_vector(): input must be on velocity grid') + else + call endrun('interpolate_vector2d: Error in interpolate_vector(): input must be on GLL grid') endif @@ -1715,8 +1715,8 @@ subroutine interpolate_vector3d(interpdata,elem,fld_cube,npts,nlev,fld,input_coo if (npts==np) then interp => interp_p - else if (npts==np) then - call endrun('interpolate_vector3d: Error in interpolate_vector(): input must be on velocity grid') + else + call endrun('interpolate_vector3d: Error in interpolate_vector(): input must be on GLL grid') endif diff --git a/src/physics/cam/aoa_tracers.F90 b/src/physics/cam/aoa_tracers.F90 index f13660b327..f0c272b69d 100644 --- a/src/physics/cam/aoa_tracers.F90 +++ b/src/physics/cam/aoa_tracers.F90 @@ -11,10 +11,11 @@ module aoa_tracers use constituents, only: pcnst, cnst_add, cnst_name, cnst_longname use cam_logfile, only: iulog use ref_pres, only: pref_mid_norm + use time_manager, only: get_curr_date, get_start_date + use time_manager, only: is_leapyear, timemgr_get_calendar_cf, get_calday implicit none private - save ! Public interfaces public :: aoa_tracers_register ! register constituents @@ -27,19 +28,18 @@ module aoa_tracers ! Private module data - integer, parameter :: ncnst=4 ! number of constituents implemented by this module + integer, parameter :: ncnst=3 ! number of constituents implemented by this module ! constituent names - character(len=8), parameter :: c_names(ncnst) = (/'AOA1', 'AOA2', 'HORZ', 'VERT'/) + character(len=6), parameter :: c_names(ncnst) = (/'AOAMF ', 'HORZ ', 'VERT '/) ! constituent source/sink names - character(len=8), parameter :: src_names(ncnst) = (/'AOA1SRC', 'AOA2SRC', 'HORZSRC', 'VERTSRC'/) + character(len=8), parameter :: src_names(ncnst) = (/'AOAMFSRC', 'HORZSRC ', 'VERTSRC '/) - integer :: ifirst ! global index of first constituent - integer :: ixaoa1 ! global index for AOA1 tracer - integer :: ixaoa2 ! global index for AOA2 tracer - integer :: ixht ! global index for HORZ tracer - integer :: ixvt ! global index for VERT tracer + integer :: ifirst = -1 ! global index of first constituent + integer :: ixaoa = -1 ! global index for AOAMFSRC tracer + integer :: ixht = -1 ! global index for HORZ tracer + integer :: ixvt = -1 ! global index for VERT tracer ! Data from namelist variables logical :: aoa_tracers_flag = .false. ! true => turn on test tracer code, namelist variable @@ -66,7 +66,11 @@ module aoa_tracers ! Troposphere and Stratosphere. J. Atmos. Sci., 57, 673-699. ! doi: http://dx.doi.org/10.1175/1520-0469(2000)057<0673:TDOGAI>2.0.CO;2 - real(r8) :: qrel_vert(pver) ! = -7._r8*log(pref_mid_norm(k)) + vert_offset + real(r8) :: qrel_vert(pver) = -huge(1._r8) ! = -7._r8*log(pref_mid_norm(k)) + vert_offset + + integer :: yr0 = -huge(1) + real(r8) :: calday0 = -huge(1._r8) + real(r8) :: years = -huge(1._r8) !=============================================================================== contains @@ -75,12 +79,9 @@ module aoa_tracers !================================================================================ subroutine aoa_tracers_readnl(nlfile) - use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use mpishorthand - use cam_abortutils, only: endrun - - implicit none + use namelist_utils, only: find_group_name + use cam_abortutils, only: endrun + use spmd_utils, only: mpicom, masterprocid, mpi_logical, mpi_success character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input @@ -88,14 +89,12 @@ subroutine aoa_tracers_readnl(nlfile) integer :: unitn, ierr character(len=*), parameter :: subname = 'aoa_tracers_readnl' - namelist /aoa_tracers_nl/ aoa_tracers_flag, aoa_read_from_ic_file !----------------------------------------------------------------------------- if (masterproc) then - unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) + open( newunit=unitn, file=trim(nlfile), status='old' ) call find_group_name(unitn, 'aoa_tracers_nl', status=ierr) if (ierr == 0) then read(unitn, aoa_tracers_nl, iostat=ierr) @@ -104,13 +103,16 @@ subroutine aoa_tracers_readnl(nlfile) end if end if close(unitn) - call freeunit(unitn) end if -#ifdef SPMD - call mpibcast(aoa_tracers_flag, 1, mpilog, 0, mpicom) - call mpibcast(aoa_read_from_ic_file, 1, mpilog, 0, mpicom) -#endif + call mpi_bcast(aoa_tracers_flag, 1, mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) then + call endrun(subname//': MPI_BCAST ERROR: aoa_tracers_flag') + end if + call mpi_bcast(aoa_read_from_ic_file, 1, mpi_logical, masterprocid, mpicom, ierr) + if (ierr/=mpi_success) then + call endrun(subname//': MPI_BCAST ERROR: aoa_read_from_ic_file') + end if endsubroutine aoa_tracers_readnl @@ -125,18 +127,24 @@ subroutine aoa_tracers_register use physconst, only: cpair, mwdry !----------------------------------------------------------------------- + integer :: k + if (.not. aoa_tracers_flag) return - call cnst_add(c_names(1), mwdry, cpair, 0._r8, ixaoa1, readiv=aoa_read_from_ic_file, & - longname='Age-of_air tracer 1') - ifirst = ixaoa1 - call cnst_add(c_names(2), mwdry, cpair, 0._r8, ixaoa2, readiv=aoa_read_from_ic_file, & - longname='Age-of_air tracer 2') - call cnst_add(c_names(3), mwdry, cpair, 1._r8, ixht, readiv=aoa_read_from_ic_file, & + call cnst_add(c_names(1), mwdry, cpair, 0._r8, ixaoa, readiv=aoa_read_from_ic_file, & + longname='mixing ratio LB tracer') + + call cnst_add(c_names(2), mwdry, cpair, 1._r8, ixht, readiv=aoa_read_from_ic_file, & longname='horizontal tracer') - call cnst_add(c_names(4), mwdry, cpair, 0._r8, ixvt, readiv=aoa_read_from_ic_file, & + call cnst_add(c_names(3), mwdry, cpair, 0._r8, ixvt, readiv=aoa_read_from_ic_file, & longname='vertical tracer') + ifirst = ixaoa + + do k = 1,pver + qrel_vert(k) = -7._r8*log(pref_mid_norm(k)) + vert_offset + enddo + end subroutine aoa_tracers_register !=============================================================================== @@ -211,7 +219,9 @@ subroutine aoa_tracers_init use cam_history, only: addfld, add_default - integer :: m, mm, k + integer :: m, mm + integer :: yr, mon, day, sec, ymd + !----------------------------------------------------------------------- if (.not. aoa_tracers_flag) return @@ -227,9 +237,12 @@ subroutine aoa_tracers_init call add_default (src_names(m), 1, ' ') end do - do k = 1,pver - qrel_vert(k) = -7._r8*log(pref_mid_norm(k)) + vert_offset - enddo + call get_start_date(yr, mon, day, sec) + + ymd = yr*10000 + mon*100 + day + + yr0 = yr + calday0 = get_calday(ymd, sec) end subroutine aoa_tracers_init @@ -240,15 +253,14 @@ subroutine aoa_tracers_timestep_init( phys_state ) ! Provides a place to reinitialize diagnostic constituents HORZ and VERT !----------------------------------------------------------------------- - use time_manager, only: get_curr_date use ppgrid, only: begchunk, endchunk use physics_types, only: physics_state type(physics_state), intent(inout), dimension(begchunk:endchunk), optional :: phys_state - integer c, i, k, ncol - integer yr, mon, day, tod + integer yr, mon, day, tod, ymd + real(r8) :: calday, dpy !-------------------------------------------------------------------------- if (.not. aoa_tracers_flag) return @@ -272,29 +284,34 @@ subroutine aoa_tracers_timestep_init( phys_state ) end if + ymd = yr*10000 + mon*100 + day + calday = get_calday(ymd, tod) + + dpy = 365._r8 + if (timemgr_get_calendar_cf() == 'gregorian' .and. is_leapyear(yr)) then + dpy = 366._r8 + end if + years = (yr-yr0) + (calday-calday0)/dpy + end subroutine aoa_tracers_timestep_init !=============================================================================== - subroutine aoa_tracers_timestep_tend(state, ptend, cflx, landfrac, dt) + subroutine aoa_tracers_timestep_tend(state, ptend, dt) use physics_types, only: physics_state, physics_ptend, physics_ptend_init use cam_history, only: outfld - use time_manager, only: get_nstep ! Arguments type(physics_state), intent(in) :: state ! state variables type(physics_ptend), intent(out) :: ptend ! package tendencies - real(r8), intent(inout) :: cflx(pcols,pcnst) ! Surface constituent flux (kg/m^2/s) - real(r8), intent(in) :: landfrac(pcols) ! Land fraction - real(r8), intent(in) :: dt ! timestep + real(r8), intent(in) :: dt ! timestep size (sec) !----------------- Local workspace------------------------------- integer :: i, k integer :: lchnk ! chunk identifier integer :: ncol ! no. of column in chunk - integer :: nstep ! current timestep number real(r8) :: qrel ! value to be relaxed to real(r8) :: xhorz ! updated value of HORZ real(r8) :: xvert ! updated value of VERT @@ -302,6 +319,11 @@ subroutine aoa_tracers_timestep_tend(state, ptend, cflx, landfrac, dt) real(r8) :: teul ! relaxation in 1/sec*dt/2 = k*dt/2 real(r8) :: wimp ! 1./(1.+ k*dt/2) real(r8) :: wsrc ! teul*wimp + + real(r8) :: xmmr + real(r8), parameter :: mmr0 = 1.0e-6_r8 ! initial lower boundary mmr + real(r8), parameter :: per_yr = 0.02_r8 ! fractional increase per year + !------------------------------------------------------------------ teul = .5_r8*dt/(86400._r8 * treldays) ! 1/2 for the semi-implicit scheme if dt=time step @@ -313,26 +335,23 @@ subroutine aoa_tracers_timestep_tend(state, ptend, cflx, landfrac, dt) return end if - lq(:) = .FALSE. - lq(ixaoa1) = .TRUE. - lq(ixaoa2) = .TRUE. - lq(ixht) = .TRUE. - lq(ixvt) = .TRUE. + lq(:) = .FALSE. + lq(ixaoa) = .TRUE. + lq(ixht) = .TRUE. + lq(ixvt) = .TRUE. + call physics_ptend_init(ptend,state%psetcols, 'aoa_tracers', lq=lq) - nstep = get_nstep() lchnk = state%lchnk ncol = state%ncol + ! AOAMF + xmmr = mmr0*(1._r8 + per_yr*years) + ptend%q(1:ncol,pver,ixaoa) = (xmmr - state%q(1:ncol,pver,ixaoa)) / dt + do k = 1, pver do i = 1, ncol - ! AOA1 - ptend%q(i,k,ixaoa1) = 0.0_r8 - - ! AOA2 - ptend%q(i,k,ixaoa2) = 0.0_r8 - ! HORZ qrel = 2._r8 + sin(state%lat(i)) ! qrel should zonal mean xhorz = state%q(i,k,ixht)*wimp + wsrc*qrel ! Xnew = weight*3D-tracer + (1.-weight)*1D-tracer @@ -344,34 +363,13 @@ subroutine aoa_tracers_timestep_tend(state, ptend, cflx, landfrac, dt) ptend%q(i,k,ixvt) = (xvert - state%q(i,k,ixvt)) / dt end do + end do ! record tendencies on history files - call outfld (src_names(1), ptend%q(:,:,ixaoa1), pcols, lchnk) - call outfld (src_names(2), ptend%q(:,:,ixaoa2), pcols, lchnk) - call outfld (src_names(3), ptend%q(:,:,ixht), pcols, lchnk) - call outfld (src_names(4), ptend%q(:,:,ixvt), pcols, lchnk) - - ! Set tracer fluxes - do i = 1, ncol - - ! AOA1 - cflx(i,ixaoa1) = 1.e-6_r8 - - ! AOA2 - if (landfrac(i) .eq. 1._r8 .and. state%lat(i) .gt. 0.35_r8) then - cflx(i,ixaoa2) = 1.e-6_r8 + 1e-6_r8*0.0434_r8*real(nstep,r8)*dt/(86400._r8*365._r8) - else - cflx(i,ixaoa2) = 0._r8 - endif - - ! HORZ - cflx(i,ixht) = 0._r8 - - ! VERT - cflx(i,ixvt) = 0._r8 - - end do + call outfld (src_names(1), ptend%q(:,:,ixaoa), pcols, lchnk) + call outfld (src_names(2), ptend%q(:,:,ixht), pcols, lchnk) + call outfld (src_names(3), ptend%q(:,:,ixvt), pcols, lchnk) end subroutine aoa_tracers_timestep_tend @@ -389,19 +387,17 @@ subroutine init_cnst_3d(m, latvals, lonvals, mask, q) !----------------------------------------------------------------------- if (masterproc) then - write(iulog,*) 'AGE-OF-AIR CONSTITUENTS: INITIALIZING ',cnst_name(m),m + write(iulog,*) 'AGE-OF-AIR CONSTITUENTS: INITIALIZING ',cnst_name(m),m end if - if (m == ixaoa1) then - - q(:,:) = 0.0_r8 - - else if (m == ixaoa2) then + if (m == ixaoa) then + ! AOAMF q(:,:) = 0.0_r8 else if (m == ixht) then + ! HORZ gsize = size(q, 1) do j = 1, gsize q(j,:) = 2._r8 + sin(latvals(j)) @@ -409,6 +405,7 @@ subroutine init_cnst_3d(m, latvals, lonvals, mask, q) else if (m == ixvt) then + ! VERT do k = 1, pver do j = 1, size(q,1) q(j,k) = qrel_vert(k) @@ -421,5 +418,4 @@ end subroutine init_cnst_3d !===================================================================== - end module aoa_tracers diff --git a/src/physics/cam/cam3_aero_data.F90 b/src/physics/cam/cam3_aero_data.F90 deleted file mode 100644 index bb32e36b8a..0000000000 --- a/src/physics/cam/cam3_aero_data.F90 +++ /dev/null @@ -1,1021 +0,0 @@ -module cam3_aero_data -!----------------------------------------------------------------------- -! -! Purposes: -! read, store, interpolate, and return fields -! of aerosols to CAM. The initialization -! file (mass.nc) is assumed to be a monthly climatology -! of aerosols from MATCH (on a sigma pressure -! coordinate system). -! also provide a "background" aerosol field to correct -! for any deficiencies in the physical parameterizations -! This fields is a "tuning" parameter. -! Public methods: -! (1) - initialization -! read aerosol masses from external file -! also pressure coordinates -! convert from monthly average values to mid-month values -! (2) - interpolation (time and vertical) -! interpolate onto pressure levels of CAM -! interpolate to time step of CAM -! return mass of aerosols -! -!----------------------------------------------------------------------- - - use shr_kind_mod, only: r8 => shr_kind_r8 - use shr_scam_mod, only: shr_scam_GetCloseLatLon - use spmd_utils, only: masterproc - use ppgrid, only: pcols, pver, pverp, begchunk, endchunk - use phys_grid, only: get_ncols_p, scatter_field_to_chunk - use time_manager, only: get_curr_calday - use infnan, only: nan, assignment(=) - use cam_abortutils, only: endrun - use scamMod, only: scmlon,scmlat,single_column - use error_messages, only: handle_ncerr - use physics_types, only: physics_state - use boundarydata, only: boundarydata_init, boundarydata_type - use perf_mod, only: t_startf, t_stopf - use cam_logfile, only: iulog - use netcdf - - implicit none - private - save - - public :: & - cam3_aero_data_readnl, & ! read namelist - cam3_aero_data_register, & ! register these aerosols with pbuf2d - cam3_aero_data_init, & ! read from file, interpolate onto horiz grid - cam3_aero_data_timestep_init ! update data-aerosols to this timestep - - ! namelist variables - logical, public :: cam3_aero_data_on = .false. - character(len=256) :: bndtvaer = 'bndtvaer' ! full pathname for time-variant aerosol mass climatology dataset - - ! naer is number of species in climatology - integer, parameter :: naer = 11 - - real(r8), parameter :: wgt_sscm = 6.0_r8 / 7.0_r8 ! Fraction of total seasalt mass in coarse mode - - ! indices to aerosol array (species portion) - integer, parameter :: & - idxSUL = 1, & - idxSSLTA = 2, & ! accumulation mode - idxSSLTC = 3, & ! coarse mode - idxOCPHO = 8, & - idxBCPHO = 9, & - idxOCPHI = 10, & - idxBCPHI = 11 - - ! indices to sections of array that represent - ! groups of aerosols - integer, parameter :: & - idxSSLTfirst = 2, numSSLT = 2, & - idxDUSTfirst = 4, & - numDUST = 4, & - idxCARBONfirst = 8, & - numCARBON = 4 - - ! names of aerosols are they are represented in - ! the climatology file. - ! Appended '_V' indicates field has been vertically summed. - character(len=8), parameter :: aerosol_name(naer) = & - (/"MSUL_V "& - ,"MSSLTA_V"& - ,"MSSLTC_V"& - ,"MDUST1_V"& - ,"MDUST2_V"& - ,"MDUST3_V"& - ,"MDUST4_V"& - ,"MOCPHO_V"& - ,"MBCPHO_V"& - ,"MOCPHI_V"& - ,"MBCPHI_V"/) - - ! number of different "groups" of aerosols - integer, parameter :: num_aer_groups=4 - - ! which group does each bin belong to? - integer, dimension(naer), parameter :: & - group =(/1,2,2,3,3,3,3,4,4,4,4/) - - ! name of each group - character(len=10), dimension(num_aer_groups), parameter :: & - aerosol_names = (/'sul ','sslt ','dust ','car '/) - - ! this boundarydata_type is used for datasets in the ncols format only. - type(boundarydata_type) :: aerosol_datan - - integer :: aernid = -1 ! netcdf id for aerosol file (init to invalid) - integer :: species_id(naer) = -1 ! netcdf_id of each aerosol species (init to invalid) - integer :: Mpsid ! netcdf id for MATCH PS - integer :: nm = 1 ! index to prv month in array. init to 1 and toggle between 1 and 2 - integer :: np = 2 ! index to nxt month in array. init to 2 and toggle between 1 and 2 - integer :: mo_nxt = huge(1) ! index to nxt month in file - - real(r8) :: cdaym ! calendar day of prv month - real(r8) :: cdayp ! calendar day of next month - - ! aerosol mass - real(r8), allocatable :: aer_mass(:, :, :, :) - - ! Days into year for mid month date - ! This variable is dumb, the dates are in the dataset to be read in but they are - ! slightly different than this so getting rid of it causes a change which - ! exceeds roundoff. - real(r8) :: Mid(12) = (/16.5_r8, 46.0_r8, 75.5_r8, 106.0_r8, 136.5_r8, 167.0_r8, & - 197.5_r8, 228.5_r8, 259.0_r8, 289.5_r8, 320.0_r8, 350.5_r8 /) - - ! values read from file and temporary values used for interpolation - ! - ! aerosolc is: - ! Cumulative Mass at midpoint of each month - ! on CAM's horizontal grid (col) - ! on MATCH's levels (lev) - ! aerosolc - integer, parameter :: paerlev = 28 ! number of levels for aerosol fields (MUST = naerlev) - integer :: naerlev ! size of level dimension in MATCH data - integer :: naerlon - integer :: naerlat - real(r8), pointer :: M_hybi(:) ! MATCH hybi - real(r8), pointer :: M_ps(:,:) ! surface pressure from MATCH file - real(r8), pointer :: aerosolc(:,:,:,:,:) ! Aerosol cumulative mass from MATCH - real(r8), pointer :: M_ps_cam_col(:,:,:) ! PS from MATCH on Cam Columns - - ! indices for fields in the physics buffer - integer :: cam3_sul_idx, cam3_ssam_idx, cam3_sscm_idx, & - cam3_dust1_idx, cam3_dust2_idx, cam3_dust3_idx, cam3_dust4_idx,& - cam3_ocpho_idx, cam3_bcpho_idx, cam3_ocphi_idx, cam3_bcphi_idx - -!================================================================================================ -contains -!================================================================================================ - -subroutine cam3_aero_data_readnl(nlfile) - - use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use mpishorthand - - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - - ! Local variables - integer :: unitn, ierr - character(len=*), parameter :: subname = 'cam3_aero_data_readnl' - - namelist /cam3_aero_data_nl/ cam3_aero_data_on, bndtvaer - !----------------------------------------------------------------------------- - - if (masterproc) then - unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) - call find_group_name(unitn, 'cam3_aero_data_nl', status=ierr) - if (ierr == 0) then - read(unitn, cam3_aero_data_nl, iostat=ierr) - if (ierr /= 0) then - call endrun(subname // ':: ERROR reading namelist') - end if - end if - close(unitn) - call freeunit(unitn) - end if - -#ifdef SPMD - ! Broadcast namelist variables - call mpibcast(cam3_aero_data_on, 1, mpilog, 0, mpicom) - call mpibcast(bndtvaer, len(bndtvaer), mpichar, 0, mpicom) -#endif - - ! Prevent using these before they are set. - cdaym = nan - cdayp = nan - -end subroutine cam3_aero_data_readnl - -!================================================================================================ - -subroutine cam3_aero_data_register - - ! register old prescribed aerosols with physics buffer - - use physics_buffer, only: pbuf_add_field, dtype_r8 - - call pbuf_add_field('cam3_sul', 'physpkg',dtype_r8,(/pcols,pver/),cam3_sul_idx) - call pbuf_add_field('cam3_ssam', 'physpkg',dtype_r8,(/pcols,pver/),cam3_ssam_idx) - call pbuf_add_field('cam3_sscm', 'physpkg',dtype_r8,(/pcols,pver/),cam3_sscm_idx) - call pbuf_add_field('cam3_dust1','physpkg',dtype_r8,(/pcols,pver/),cam3_dust1_idx) - call pbuf_add_field('cam3_dust2','physpkg',dtype_r8,(/pcols,pver/),cam3_dust2_idx) - call pbuf_add_field('cam3_dust3','physpkg',dtype_r8,(/pcols,pver/),cam3_dust3_idx) - call pbuf_add_field('cam3_dust4','physpkg',dtype_r8,(/pcols,pver/),cam3_dust4_idx) - call pbuf_add_field('cam3_ocpho','physpkg',dtype_r8,(/pcols,pver/),cam3_ocpho_idx) - call pbuf_add_field('cam3_bcpho','physpkg',dtype_r8,(/pcols,pver/),cam3_bcpho_idx) - call pbuf_add_field('cam3_ocphi','physpkg',dtype_r8,(/pcols,pver/),cam3_ocphi_idx) - call pbuf_add_field('cam3_bcphi','physpkg',dtype_r8,(/pcols,pver/),cam3_bcphi_idx) - -end subroutine cam3_aero_data_register - -!================================================================================================ - -subroutine cam3_aero_data_init(phys_state) -!------------------------------------------------------------------ -! Reads in: -! file from which to read aerosol Masses on CAM grid. Currently -! assumed to be MATCH ncep runs, averaged by month. -! NOTE (Data have been externally interpolated onto CAM grid -! and backsolved to provide Mid-month values) -! -! Populates: -! module variables: -! aerosolc(pcols,paerlev+1,begchunk:endchunk,naer,2)) -! aerosolc( column_index -! , level_index (match levels) -! , chunk_index -! , species_index -! , month = 1:2 ) -! M_hybi(level_index = Lev_MATCH) = pressure at mid-level. -! M_ps_cam_col(column,chunk,month) ! PS from MATCH on Cam Columns -! -! Method: -! read data from file -! allocate memory for storage of aerosol data on CAM horizontal grid -! distribute data to remote nodes -! populates the module variables -! -!------------------------------------------------------------------ - use ioFileMod, only: getfil - -#if ( defined SPMD ) - use mpishorthand -#endif - type(physics_state), intent(in) :: phys_state(begchunk:endchunk) - -! local variables - - integer :: naerlev - - integer dateid ! netcdf id for date variable - integer secid ! netcdf id for seconds variable - integer londimid ! netcdf id for longitude dimension - integer latdimid ! netcdf id for latitude dimension - integer levdimid ! netcdf id for level dimension - - integer timesiz ! number of time samples (=12) in netcdf file - integer latid ! netcdf id for latitude variable - integer Mhybiid ! netcdf id for MATCH hybi - integer timeid ! netcdf id for time variable - integer dimids(nf90_max_var_dims) ! variable shape - integer :: start(4) ! start vector for netcdf calls - integer :: kount(4) ! count vector for netcdf calls - integer mo ! month index - integer m ! constituent index - integer :: n ! loop index - integer :: i,j,k ! spatial indices - integer :: date_aer(12) ! Date on aerosol dataset (YYYYMMDD) - integer :: attnum ! attribute number - integer :: ierr ! netcdf return code - real(r8) :: coldata(paerlev) ! aerosol field read in from dataset - integer :: ret - integer mo_prv ! index to previous month - integer latidx,lonidx - - character(len=8) :: aname ! temporary aerosol name - character(len=8) :: tmp_aero_name(naer) ! name for input to boundary data - - character(len=256) :: locfn ! netcdf local filename to open -! -! aerosol_data will be read in from the aerosol boundary dataset, then scattered to chunks -! after filling in the bottom level with zeros -! - real(r8), allocatable :: aerosol_data(:,:,:) ! aerosol field read in from dataset - real(r8), allocatable :: aerosol_field(:,:,:) ! (plon,paerlev+1,plat) aerosol field to be scattered - real(r8) :: caldayloc ! calendar day of current timestep - real(r8) :: closelat,closelon - - character(len=*), parameter :: subname = 'cam3_aero_data_init' - !------------------------------------------------------------------ - - call t_startf(subname) - - allocate (aer_mass(pcols, pver, naer, begchunk:endchunk) ) - - ! set new aerosol names because input file has 1 seasalt bin - do m = 1, naer - tmp_aero_name(m)=aerosol_name(m) - if (aerosol_name(m)=='MSSLTA_V') tmp_aero_name(m) = 'MSSLT_V' - if (aerosol_name(m)=='MSSLTC_V') tmp_aero_name(m) = 'MSSLT_V' - end do - - allocate (aerosolc(pcols,paerlev+1,begchunk:endchunk,naer,2)) - aerosolc(:,:,:,:,:) = 0._r8 - - caldayloc = get_curr_calday () - - if (caldayloc < Mid(1)) then - mo_prv = 12 - mo_nxt = 1 - else if (caldayloc >= Mid(12)) then - mo_prv = 12 - mo_nxt = 1 - else - do i = 2 , 12 - if (caldayloc < Mid(i)) then - mo_prv = i-1 - mo_nxt = i - exit - end if - end do - end if - - ! Set initial calendar day values - cdaym = Mid(mo_prv) - cdayp = Mid(mo_nxt) - - if (masterproc) & - write(iulog,*) subname//': CAM3 prescribed aerosol dataset is: ', trim(bndtvaer) - - call getfil (bndtvaer, locfn, 0) - - call handle_ncerr( nf90_open (locfn, 0, aernid),& - subname, __LINE__) - - if (single_column) & - call shr_scam_GetCloseLatLon(aernid,scmlat,scmlon,closelat,closelon,latidx,lonidx) - - ! Check to see if this dataset is in ncol format. - aerosol_datan%isncol=.false. - ierr = nf90_inq_dimid( aernid, 'ncol', londimid ) - if ( ierr==NF90_NOERR ) then - - aerosol_datan%isncol=.true. - call handle_ncerr(nf90_close(aernid),subname, __LINE__) - - call boundarydata_init(bndtvaer, phys_state, tmp_aero_name, naer, & - aerosol_datan, 3) - - aerosolc(:,1:paerlev,:,:,:)=aerosol_datan%fields - - M_ps_cam_col=>aerosol_datan%ps - M_hybi=>aerosol_datan%hybi - - else - - ! Allocate memory for dynamic arrays local to this module - allocate (M_ps_cam_col(pcols,begchunk:endchunk,2)) - allocate (M_hybi(paerlev+1)) - ! TBH: HACK to avoid use of uninitialized values when ncols < pcols - M_ps_cam_col(:,:,:) = 0._r8 - - if (masterproc) then - - ! First ensure dataset is CAM-ready - - call handle_ncerr(nf90_inquire_attribute (aernid, nf90_global, 'cam-ready', attnum=attnum),& - subname//': interpaerosols needs to be run to create a cam-ready aerosol dataset') - - ! Get and check dimension info - - call handle_ncerr( nf90_inq_dimid( aernid, 'lon', londimid ),& - subname, __LINE__) - call handle_ncerr( nf90_inq_dimid( aernid, 'lev', levdimid ),& - subname, __LINE__) - call handle_ncerr( nf90_inq_dimid( aernid, 'time', timeid ),& - subname, __LINE__) - call handle_ncerr( nf90_inq_dimid( aernid, 'lat', latdimid ),& - subname, __LINE__) - call handle_ncerr( nf90_inquire_dimension( aernid, londimid, len=naerlon ),& - subname, __LINE__) - call handle_ncerr( nf90_inquire_dimension( aernid, levdimid, len=naerlev ),& - subname, __LINE__) - call handle_ncerr( nf90_inquire_dimension( aernid, latdimid, len=naerlat ),& - subname, __LINE__) - call handle_ncerr( nf90_inquire_dimension( aernid, timeid, len=timesiz ),& - subname, __LINE__) - - call handle_ncerr( nf90_inq_varid( aernid, 'date', dateid ),& - subname, __LINE__) - call handle_ncerr( nf90_inq_varid( aernid, 'datesec', secid ),& - subname, __LINE__) - - do m = 1, naer - aname=aerosol_name(m) - ! rename because file has only one seasalt field - if (aname=='MSSLTA_V') aname = 'MSSLT_V' - if (aname=='MSSLTC_V') aname = 'MSSLT_V' - call handle_ncerr( nf90_inq_varid( aernid, TRIM(aname), species_id(m)), & - subname, __LINE__) - end do - - call handle_ncerr( nf90_inq_varid( aernid, 'lat', latid ),& - subname, __LINE__) - - ! quick sanity check on one field - call handle_ncerr( nf90_inquire_variable (aernid, species_id(1), dimids=dimids),& - subname, __LINE__) - - if ( (dimids(4) /= timeid) .or. & - (dimids(3) /= levdimid) .or. & - (dimids(2) /= latdimid) .or. & - (dimids(1) /= londimid) ) then - write(iulog,*) subname//': Data must be ordered time, lev, lat, lon' - write(iulog,*) 'data are ordered as', dimids(4), dimids(3), dimids(2), dimids(1) - write(iulog,*) 'data should be ordered as', timeid, levdimid, latdimid, londimid - call endrun () - end if - - ! use hybi,PS from MATCH - call handle_ncerr( nf90_inq_varid( aernid, 'hybi', Mhybiid ),& - subname, __LINE__) - call handle_ncerr( nf90_inq_varid( aernid, 'PS', Mpsid ),& - subname, __LINE__) - - ! check dimension order for MATCH's surface pressure - call handle_ncerr( nf90_inquire_variable (aernid, Mpsid, dimids=dimids),& - subname, __LINE__) - if ( (dimids(3) /= timeid) .or. & - (dimids(2) /= latdimid) .or. & - (dimids(1) /= londimid) ) then - write(iulog,*) subname//': Pressure must be ordered time, lat, lon' - write(iulog,*) 'data are ordered as', dimids(3), dimids(2), dimids(1) - write(iulog,*) 'data should be ordered as', timeid, levdimid, latdimid, londimid - call endrun () - end if - - ! read in hybi from MATCH - call handle_ncerr( nf90_get_var (aernid, Mhybiid, M_hybi),& - subname, __LINE__) - - ! Retrieve date and sec variables. - call handle_ncerr( nf90_get_var (aernid, dateid, date_aer),& - subname, __LINE__) - if (timesiz < 12) then - write(iulog,*) subname//': When cycling aerosols, dataset must have 12 consecutive ', & - 'months of data starting with Jan' - write(iulog,*) 'Current dataset has only ',timesiz,' months' - call endrun () - end if - do mo = 1,12 - if (mod(date_aer(mo),10000)/100 /= mo) then - write(iulog,*) subname//': When cycling aerosols, dataset must have 12 consecutive ', & - 'months of data starting with Jan' - write(iulog,*)'Month ',mo,' of dataset says date=',date_aer(mo) - call endrun () - end if - end do - if (single_column) then - naerlat=1 - naerlon=1 - endif - kount(:) = (/naerlon,naerlat,paerlev,1/) - end if ! masterproc - - ! broadcast hybi to nodes - -#if ( defined SPMD ) - call mpibcast (M_hybi, paerlev+1, mpir8, 0, mpicom) - call mpibcast (kount, 3, mpiint, 0, mpicom) - naerlon = kount(1) - naerlat = kount(2) -#endif - allocate(aerosol_field(kount(1),kount(3)+1,kount(2))) - allocate(M_ps(kount(1),kount(2))) - if (masterproc) allocate(aerosol_data(kount(1),kount(2),kount(3))) - - ! Retrieve Aerosol Masses (kg/m^2 in each layer), transpose to model order (lon,lev,lat), - ! then scatter to slaves. - if (nm /= 1 .or. np /= 2) call endrun (subname//': bad nm or np value') - do n=nm,np - if (n == 1) then - mo = mo_prv - else - mo = mo_nxt - end if - - do m=1,naer - if (masterproc) then - if (single_column) then - start(:) = (/lonidx,latidx,1,mo/) - else - start(:) = (/1,1,1,mo/) - endif - kount(:) = (/naerlon,naerlat,paerlev,1/) - - call handle_ncerr( nf90_get_var (aernid, species_id(m),aerosol_data, start, kount),& - subname, __LINE__) - do j=1,naerlat - do k=1,paerlev - aerosol_field(:,k,j) = aerosol_data(:,j,k) - end do - aerosol_field(:,paerlev+1,j) = 0._r8 ! value at bottom - end do - - end if - call scatter_field_to_chunk (1, paerlev+1, 1, naerlon, aerosol_field, & - aerosolc(:,:,:,m,n)) - end do - - ! Retrieve PS from Match - - if (masterproc) then - if (single_column) then - start(:) = (/lonidx,latidx,mo,-1/) - else - start(:) = (/1,1,mo,-1/) - endif - kount(:) = (/naerlon,naerlat,1,-1/) - call handle_ncerr( nf90_get_var(aernid, Mpsid, M_ps,start,kount),& - subname, __LINE__) - end if - call scatter_field_to_chunk (1, 1, 1, naerlon, M_ps(:,:), M_ps_cam_col(:,:,n)) - end do ! n=nm,np (=1,2) - - if(masterproc) deallocate(aerosol_data) - deallocate(aerosol_field) - - end if ! Check to see if this dataset is in ncol format. - - call t_stopf(subname) - -end subroutine cam3_aero_data_init - -!================================================================================================ - -subroutine cam3_aero_data_timestep_init(pbuf2d, phys_state) -!------------------------------------------------------------------ -! -! Input: -! time at which aerosol masses are needed (get_curr_calday()) -! chunk index -! CAM's vertical grid (pint) -! -! Output: -! values for Aerosol Mass at time specified by get_curr_calday -! on vertical grid specified by pint (aer_mass) :: aerosol at time t -! -! Method: -! first determine which indexs of aerosols are the bounding data sets -! interpolate both onto vertical grid aerm(),aerp(). -! from those two, interpolate in time. -! -!------------------------------------------------------------------ - - use interpolate_data, only: get_timeinterp_factors - - use physics_buffer, only: physics_buffer_desc, dtype_r8, pbuf_set_field, pbuf_get_chunk - use cam_logfile, only: iulog - use ppgrid, only: begchunk,endchunk - use physconst, only: gravit - -! -! aerosol fields interpolated to current time step -! on pressure levels of this time step. -! these should be made read-only for other modules -! Is allocation done correctly here? -! - - type(physics_buffer_desc), pointer :: pbuf2d(:,:) - type(physics_state), intent(in), dimension(begchunk:endchunk) :: phys_state - -! -! Local workspace -! - type(physics_buffer_desc), pointer :: phys_buffer_chunk(:) - real(r8) :: pint(pcols,pverp) ! interface pres. - integer :: c ! chunk index - real(r8) caldayloc ! calendar day of current timestep - real(r8) fact1, fact2 ! time interpolation factors - - integer i, k, j ! spatial indices - integer m ! constituent index - integer lats(pcols),lons(pcols) ! latitude and longitudes of column - integer ncol ! number of columns - integer lchnk ! chunk index - - real(r8) speciesmin(naer) ! minimal value for each species -! -! values before current time step "the minus month" -! aerosolm(pcols,pver) is value of preceeding month's aerosol masses -! aerosolp(pcols,pver) is value of next month's aerosol masses -! (think minus and plus or values to left and right of point to be interpolated) -! - real(r8) aerosolm(pcols,pver,naer,begchunk:endchunk) ! aerosol mass from MATCH in column,level at previous (minus) month -! -! values beyond (or at) current time step "the plus month" -! - real(r8) aerosolp(pcols,pver,naer,begchunk:endchunk) ! aerosol mass from MATCH in column,level at next (plus) month - real(r8) :: mass_to_mmr(pcols,pver) - - character(len=*), parameter :: subname = 'cam3_aero_data_timestep_init' - - logical error_found - !------------------------------------------------------------------ - - call aerint(phys_state) - - caldayloc = get_curr_calday () - - ! Determine time interpolation factors. 1st arg says we are cycling 1 year of data - call get_timeinterp_factors (.true., mo_nxt, cdaym, cdayp, caldayloc, & - fact1, fact2, 'GET_AEROSOL:') - - ! interpolate (prv and nxt month) bounding datasets onto cam vertical grid. - ! compute mass mixing ratios on CAMS's pressure coordinate - ! for both the "minus" and "plus" months - ! - ! This loop over chunk could probably be removed by working with the whole - ! begchunk:endchunk group at once. It would require a slight generalization - ! in vert_interpolate. - do c = begchunk,endchunk - - lchnk = phys_state(c)%lchnk - pint = phys_state(c)%pint - ncol = get_ncols_p(c) - - call vert_interpolate (M_ps_cam_col(:,c,nm), pint, nm, aerosolm(:,:,:,c), ncol, c) - call vert_interpolate (M_ps_cam_col(:,c,np), pint, np, aerosolp(:,:,:,c), ncol, c) - - ! Time interpolate. - do m=1,naer - do k=1,pver - do i=1,ncol - aer_mass(i,k,m,c) = aerosolm(i,k,m,c)*fact1 + aerosolp(i,k,m,c)*fact2 - end do - end do - ! Partition seasalt aerosol mass - if (m .eq. idxSSLTA) then - aer_mass(:ncol,:,m,c) = (1._r8-wgt_sscm)*aer_mass(:ncol,:,m,c) ! fraction of seasalt mass in accumulation mode - elseif (m .eq. idxSSLTC) then - aer_mass(:ncol,:,m,c) = wgt_sscm*aer_mass(:ncol,:,m,c) ! fraction of seasalt mass in coarse mode - endif - end do - - ! exit if mass is negative (we have previously set - ! cumulative mass to be a decreasing function.) - speciesmin(:) = 0._r8 ! speciesmin(m) = 0 is minimum mass for each species - - error_found = .false. - do m=1,naer - do k=1,pver - do i=1,ncol - if (aer_mass(i, k, m,c) < speciesmin(m)) error_found = .true. - end do - end do - end do - if (error_found) then - do m=1,naer - do k=1,pver - do i=1,ncol - if (aer_mass(i, k, m,c) < speciesmin(m)) then - write(iulog,*) subname//': negative mass mixing ratio, exiting' - write(iulog,*) 'm, column, pver',m, i, k ,aer_mass(i, k, m,c) - call endrun () - end if - end do - end do - end do - end if - do k = 1, pver - mass_to_mmr(1:ncol,k) = gravit/(pint(1:ncol,k+1)-pint(1:ncol,k)) - enddo - - phys_buffer_chunk => pbuf_get_chunk(pbuf2d, lchnk) - - call pbuf_set_field(phys_buffer_chunk, cam3_sul_idx, aer_mass(1:ncol,:, idxSUL,c)*mass_to_mmr(:ncol,:), & - start=(/1,1/), kount=(/ncol,pver/)) - call pbuf_set_field(phys_buffer_chunk, cam3_ssam_idx, aer_mass(1:ncol,:, idxSSLTA,c)*mass_to_mmr(:ncol,:), & - start=(/1,1/), kount=(/ncol,pver/)) - call pbuf_set_field(phys_buffer_chunk, cam3_sscm_idx, aer_mass(1:ncol,:, idxSSLTC,c)*mass_to_mmr(:ncol,:), & - start=(/1,1/), kount=(/ncol,pver/)) - call pbuf_set_field(phys_buffer_chunk, cam3_dust1_idx, aer_mass(1:ncol,:, idxDUSTfirst,c)*mass_to_mmr(:ncol,:), & - start=(/1,1/), kount=(/ncol,pver/)) - call pbuf_set_field(phys_buffer_chunk, cam3_dust2_idx, aer_mass(1:ncol,:,idxDUSTfirst+1,c)*mass_to_mmr(:ncol,:), & - start=(/1,1/), kount=(/ncol,pver/)) - call pbuf_set_field(phys_buffer_chunk, cam3_dust3_idx, aer_mass(1:ncol,:,idxDUSTfirst+2,c)*mass_to_mmr(:ncol,:), & - start=(/1,1/), kount=(/ncol,pver/)) - call pbuf_set_field(phys_buffer_chunk, cam3_dust4_idx, aer_mass(1:ncol,:,idxDUSTfirst+3,c)*mass_to_mmr(:ncol,:), & - start=(/1,1/), kount=(/ncol,pver/)) - call pbuf_set_field(phys_buffer_chunk, cam3_ocpho_idx, aer_mass(1:ncol,:, idxOCPHO,c)*mass_to_mmr(:ncol,:), & - start=(/1,1/), kount=(/ncol,pver/)) - call pbuf_set_field(phys_buffer_chunk, cam3_bcpho_idx, aer_mass(1:ncol,:, idxBCPHO,c)*mass_to_mmr(:ncol,:), & - start=(/1,1/), kount=(/ncol,pver/)) - call pbuf_set_field(phys_buffer_chunk, cam3_ocphi_idx, aer_mass(1:ncol,:, idxOCPHI,c)*mass_to_mmr(:ncol,:), & - start=(/1,1/), kount=(/ncol,pver/)) - call pbuf_set_field(phys_buffer_chunk, cam3_bcphi_idx, aer_mass(1:ncol,:, idxBCPHI,c)*mass_to_mmr(:ncol,:), & - start=(/1,1/), kount=(/ncol,pver/)) - - enddo ! c = begchunk:endchunk - -end subroutine cam3_aero_data_timestep_init - -!================================================================================================ - -subroutine vert_interpolate (Match_ps, pint, n, aerosol_mass, ncol, c) -!-------------------------------------------------------------------- -! Input: match surface pressure, cam interface pressure, -! month index, number of columns, chunk index -! -! Output: Aerosol mass mixing ratio (aerosol_mass) -! -! Method: -! interpolate column mass (cumulative) from match onto -! cam's vertical grid (pressure coordinate) -! convert back to mass mixing ratio -! -!-------------------------------------------------------------------- - - real(r8), intent(out) :: aerosol_mass(pcols,pver,naer) ! aerosol mass from MATCH - real(r8), intent(in) :: Match_ps(pcols) ! surface pressure at a particular month - real(r8), intent(in) :: pint(pcols,pverp) ! interface pressure from CAM - - integer, intent(in) :: ncol,c ! chunk index and number of columns - integer, intent(in) :: n ! prv or nxt month index -! -! Local workspace -! - integer m ! index to aerosol species - integer kupper(pcols) ! last upper bound for interpolation - integer i, k, kk, kkstart, kount ! loop vars for interpolation - integer isv, ksv, msv ! loop indices to save - - logical bad ! indicates a bad point found - logical lev_interp_comp ! interpolation completed for a level - logical error_found - - real(r8) aerosol(pcols,pverp,naer) ! cumulative mass of aerosol in column beneath upper - ! interface of level in column at particular month - real(r8) dpl, dpu ! lower and upper intepolation factors - real(r8) v_coord ! vertical coordinate - real(r8) AER_diff ! temp var for difference between aerosol masses - - character(len=*), parameter :: subname = 'cam3_aero_data.vert_interpolate' - !----------------------------------------------------------------------- - - call t_startf ('vert_interpolate') -! -! Initialize index array -! - do i=1,ncol - kupper(i) = 1 - end do -! -! assign total mass to topmost level -! - aerosol(:,1,:) = aerosolc(:,1,c,:,n) -! -! At every pressure level, interpolate onto that pressure level -! - do k=2,pver -! -! Top level we need to start looking is the top level for the previous k -! for all longitude points -! - kkstart = paerlev+1 - do i=1,ncol - kkstart = min0(kkstart,kupper(i)) - end do - kount = 0 -! -! Store level indices for interpolation -! -! for the pressure interpolation should be comparing -! pint(column,lev) with M_hybi(lev)*M_ps_cam_col(month,column,chunk) -! - lev_interp_comp = .false. - do kk=kkstart,paerlev - if(.not.lev_interp_comp) then - do i=1,ncol - v_coord = pint(i,k) - if (M_hybi(kk)*Match_ps(i) .lt. v_coord .and. v_coord .le. M_hybi(kk+1)*Match_ps(i)) then - kupper(i) = kk - kount = kount + 1 - end if - end do -! -! If all indices for this level have been found, do the interpolation and -! go to the next level -! -! Interpolate in pressure. -! - if (kount.eq.ncol) then - do m=1,naer - do i=1,ncol - dpu = pint(i,k) - M_hybi(kupper(i))*Match_ps(i) - dpl = M_hybi(kupper(i)+1)*Match_ps(i) - pint(i,k) - aerosol(i,k,m) = & - (aerosolc(i,kupper(i) ,c,m,n)*dpl + & - aerosolc(i,kupper(i)+1,c,m,n)*dpu)/(dpl + dpu) - enddo !i - end do - lev_interp_comp = .true. - end if - end if - end do -! -! If we've fallen through the kk=1,levsiz-1 loop, we cannot interpolate and -! must extrapolate from the bottom or top pressure level for at least some -! of the longitude points. -! - - if(.not.lev_interp_comp) then - do m=1,naer - do i=1,ncol - if (pint(i,k) .lt. M_hybi(1)*Match_ps(i)) then - aerosol(i,k,m) = aerosolc(i,1,c,m,n) - else if (pint(i,k) .gt. M_hybi(paerlev+1)*Match_ps(i)) then - aerosol(i,k,m) = 0.0_r8 - else - dpu = pint(i,k) - M_hybi(kupper(i))*Match_ps(i) - dpl = M_hybi(kupper(i)+1)*Match_ps(i) - pint(i,k) - aerosol(i,k,m) = & - (aerosolc(i,kupper(i) ,c,m,n)*dpl + & - aerosolc(i,kupper(i)+1,c,m,n)*dpu)/(dpl + dpu) - end if - end do - end do - - if (kount.gt.ncol) then - call endrun (subname//': Bad data: non-monotonicity suspected in dependent variable') - end if - end if - end do - -! call t_startf ('vi_checks') -! -! aerosol mass beneath lowest interface (pverp) must be 0 -! - aerosol(1:ncol,pverp,:) = 0._r8 -! -! Set mass in layer to zero whenever it is less than -! 1.e-40 kg/m^2 in the layer -! - do m = 1, naer - do k = 1, pver - do i = 1, ncol - if (aerosol(i,k,m) < 1.e-40_r8) aerosol(i,k,m) = 0._r8 - end do - end do - end do -! -! Set mass in layer to zero whenever it is less than -! 10^-15 relative to column total mass -! - error_found = .false. - do m = 1, naer - do k = 1, pver - do i = 1, ncol - AER_diff = aerosol(i,k,m) - aerosol(i,k+1,m) - if( abs(AER_diff) < 1e-15_r8*aerosol(i,1,m)) then - AER_diff = 0._r8 - end if - aerosol_mass(i,k,m)= AER_diff - if (aerosol_mass(i,k,m) < 0) error_found = .true. - end do - end do - end do - if (error_found) then - do m = 1, naer - do k = 1, pver - do i = 1, ncol - if (aerosol_mass(i,k,m) < 0) then - write(iulog,*) subname//': mass < 0, m, col, lev, mass',m, i, k, aerosol_mass(i,k,m) - write(iulog,*) subname//': aerosol(k),(k+1)',aerosol(i,k,m),aerosol(i,k+1,m) - write(iulog,*) subname//': pint(k+1),(k)',pint(i,k+1),pint(i,k) - write(iulog,*)'n,c',n,c - call endrun() - end if - end do - end do - end do - end if - - call t_stopf ('vert_interpolate') - - return -end subroutine vert_interpolate - -!================================================================================================ - -subroutine aerint (phys_state) - - type(physics_state), intent(in) :: phys_state(begchunk:endchunk) - - integer :: ntmp ! used in index swapping - integer :: start(4) ! start vector for netcdf calls - integer :: kount(4) ! count vector for netcdf calls - integer :: i,j,k ! spatial indices - integer :: m ! constituent index - integer :: cols, cole - integer :: lchnk, ncol - real(r8) :: caldayloc ! calendar day of current timestep - real(r8) :: aerosol_data(naerlon,naerlat,paerlev) ! aerosol field read in from dataset - real(r8) :: aerosol_field(naerlon,paerlev+1,naerlat) ! aerosol field to be scattered - integer latidx,lonidx - real(r8) closelat,closelon - - character(len=*), parameter :: subname = 'cam3_aero_data.aerint' - !----------------------------------------------------------------------- - - if (single_column) & - call shr_scam_GetCloseLatLon(aernid,scmlat,scmlon,closelat,closelon,latidx,lonidx) - -! -! determine if need to read in next month data -! also determine time interpolation factors -! - caldayloc = get_curr_calday () -! -! If model time is past current forward timeslice, then -! masterproc reads in the next timeslice for time interpolation. Messy logic is -! for interpolation between December and January (mo_nxt == 1). Just like -! ozone_data_timestep_init, sstint. -! - if (caldayloc > cdayp .and. .not. (mo_nxt == 1 .and. caldayloc >= cdaym)) then - mo_nxt = mod(mo_nxt,12) + 1 - cdaym = cdayp - cdayp = Mid(mo_nxt) -! -! Check for valid date info -! - if (.not. (mo_nxt == 1 .or. caldayloc <= cdayp)) then - call endrun (subname//': Non-monotonicity suspected in input aerosol data') - end if - - ntmp = nm - nm = np - np = ntmp - - if(aerosol_datan%isncol) then - do lchnk=begchunk,endchunk - ncol=phys_state(lchnk)%ncol - cols=1 - cole=cols+aerosol_datan%count(cols,lchnk)-1 - do while(cole<=ncol) - start=(/aerosol_datan%start(cols,lchnk),mo_nxt,1,-1/) - kount=(/aerosol_datan%count(cols,lchnk),1,-1,-1/) - call handle_ncerr( nf90_get_var(aerosol_datan%ncid, aerosol_datan%psid , & - aerosol_datan%ps(cols:cole,lchnk,np), start(1:2), & - kount(1:2)),& - subname, __LINE__) - start(2)=1 - start(3)=mo_nxt - kount(2)=paerlev - kount(3)=1 - do m=1,naer - call handle_ncerr( nf90_get_var(aerosol_datan%ncid, aerosol_datan%dataid(m) , & - aerosol_datan%fields(cols:cole,:,lchnk,m,np), & - start(1:3), kount(1:3)),& - subname, __LINE__) - - end do - if(cols==ncol) exit - cols=cols+aerosol_datan%count(cols,lchnk) - cole=cols+aerosol_datan%count(cols,lchnk)-1 - end do - end do - aerosolc(:,1:paerlev,:,:,np)=aerosol_datan%fields(:,:,:,:,np) - else - do m=1,naer - if (masterproc) then - if (single_column) then - naerlon=1 - naerlat=1 - start(:) = (/lonidx,latidx,1,mo_nxt/) - else - start(:) = (/1,1,1,mo_nxt/) - endif - kount(:) = (/naerlon,naerlat,paerlev,1/) - call handle_ncerr( nf90_get_var (aernid, species_id(m), aerosol_data, start, kount),& - subname, __LINE__) - - do j=1,naerlat - do k=1,paerlev - aerosol_field(:,k,j) = aerosol_data(:,j,k) - end do - aerosol_field(:,paerlev+1,j) = 0._r8 ! value at bottom - end do - end if - call scatter_field_to_chunk (1, paerlev+1, 1, naerlon, aerosol_field, & - aerosolc(:,:,:,m,np)) - end do -! -! Retrieve PS from Match -! - if (masterproc) then - if (single_column) then - naerlon=1 - naerlat=1 - start(:) = (/lonidx,latidx,mo_nxt,-1/) - else - start(:) = (/1,1,mo_nxt,-1/) - endif - kount(:) = (/naerlon,naerlat,1,-1/) - call handle_ncerr( nf90_get_var (aernid, Mpsid, M_ps, start, kount),& - subname, __LINE__) - write(iulog,*) subname//': Read aerosols data for julian day', Mid(mo_nxt) - end if - call scatter_field_to_chunk (1, 1, 1, naerlon, M_ps(:,:), M_ps_cam_col(:,:,np)) - end if - end if - -end subroutine aerint - -end module cam3_aero_data diff --git a/src/physics/cam/cam3_ozone_data.F90 b/src/physics/cam/cam3_ozone_data.F90 deleted file mode 100644 index 567679fb0d..0000000000 --- a/src/physics/cam/cam3_ozone_data.F90 +++ /dev/null @@ -1,220 +0,0 @@ -module cam3_ozone_data - -!----------------------------------------------------------------------- -! Purpose: -! -! Interpolates zonal ozone datasets used by CAM3 and puts the field 'O3' into -! the physics buffer. -! -! Revision history: -! 2004-07-31 B. Eaton Assemble module from comozp.F90, oznini.F90, oznint.F90, radozn.F90 -! 2004-08-19 B. Eaton Modify ozone_data_vert_interp to return mass mixing ratio. -! 2004-08-30 B. Eaton Add ozone_data_get_cnst method. -! 2008 June B. Eaton Change name to cam3_ozone_data to support backwards compatibility -! for reading the CAM3 ozone data. Add *_readnl method so module -! reads its own namelist. Add cam3_ozone_data_on variable to -! turn the module on from the namelist. By default it's off. -!----------------------------------------------------------------------- - -use shr_kind_mod, only: r8 => shr_kind_r8 -use spmd_utils, only: masterproc -use ppgrid, only: begchunk, endchunk, pcols, pver -use cam_abortutils, only: endrun -use cam_logfile, only: iulog -use physics_types, only: physics_state -use boundarydata, only: boundarydata_type, boundarydata_init, boundarydata_update, & - boundarydata_vert_interp -use mpishorthand - -implicit none -private -save - -! Public methods -public ::& - cam3_ozone_data_readnl, &! get namelist input - cam3_ozone_data_register, &! register ozone with physics buffer - cam3_ozone_data_init, &! open dataset and spatially interpolate data bounding initial time - cam3_ozone_data_timestep_init ! interpolate to current time - -! Namelist variables -logical, public :: cam3_ozone_data_on = .false. ! switch to turn module on/off -logical :: ozncyc = .true. ! .true. => assume annual cycle ozone data -character(len=256) :: bndtvo = ' ' ! full pathname for time-variant ozone dataset - -! Local -integer :: oz_idx ! index into phys_buffer for ozone - -type(boundarydata_type) :: ozonedata -character(len=6), parameter, dimension(1) :: nc_name = (/'OZONE '/) ! constituent names - -!================================================================================================ -contains -!================================================================================================ - -subroutine cam3_ozone_data_readnl(nlfile) - - use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use mpishorthand - - character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input - - ! Local variables - integer :: unitn, ierr - character(len=*), parameter :: subname = 'cam3_ozone_data_readnl' - - namelist /cam3_ozone_data_nl/ cam3_ozone_data_on, bndtvo, ozncyc - !----------------------------------------------------------------------------- - - if (masterproc) then - unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) - call find_group_name(unitn, 'cam3_ozone_data_nl', status=ierr) - if (ierr == 0) then - read(unitn, cam3_ozone_data_nl, iostat=ierr) - if (ierr /= 0) then - call endrun(subname // ':: ERROR reading namelist') - end if - end if - close(unitn) - call freeunit(unitn) - end if - -#ifdef SPMD - ! Broadcast namelist variables - call mpibcast(cam3_ozone_data_on, 1, mpilog, 0, mpicom) - call mpibcast(bndtvo, len(bndtvo), mpichar, 0, mpicom) - call mpibcast(ozncyc, 1, mpilog, 0, mpicom) -#endif - -end subroutine cam3_ozone_data_readnl - -!================================================================================================ - -subroutine cam3_ozone_data_register() - use physics_buffer, only : pbuf_add_field, dtype_r8 - - call pbuf_add_field('O3','physpkg',dtype_r8,(/pcols,pver/),oz_idx) - -end subroutine cam3_ozone_data_register - -!================================================================================================ - -subroutine cam3_ozone_data_init(phys_state) -!----------------------------------------------------------------------- -! -! Purpose: Do initial read of time-variant ozone boundary dataset, containing -! ozone mixing ratios as a function of latitude and pressure. Read two -! consecutive months between which the current date lies. Routine -! RADOZ2 then evaluates the two path length integrals (with and without -! pressure weighting) from zero to the interfaces between the input -! levels. It also stores the contribution to the integral from each -! layer. -! -! Method: Call appropriate netcdf wrapper routines and interpolate to model grid -! -! Author: CCM Core Group -! Modified: P. Worley, August 2003, for chunking and performance optimization -! J. Edwards, Dec 2005, functionality now performed by zonalbndrydata -!----------------------------------------------------------------------- - - use cam_history, only: addfld - - type(physics_state), intent(in) :: phys_state(begchunk:endchunk) - !----------------------------------------------------------------------- - - call addfld ('O3VMR', (/ 'lev' /), 'A', 'm3/m3', 'Ozone volume mixing ratio', sampling_seq='rad_lwsw') - - - ! Initialize for one field (arg_4=1) and do not vertically interpolate (arg_6=3) - call boundarydata_init(bndtvo, phys_state, nc_name, 1, ozonedata, 3) - - if (masterproc) then - write(iulog,*)'cam3_ozone_data_init: Initializing CAM3 prescribed ozone' - write(iulog,*)'Time-variant boundary dataset (ozone) is: ', trim(bndtvo) - if (ozncyc) then - write(iulog,*)'OZONE dataset will be reused for each model year' - else - write(iulog,*)'OZONE dataset will not be cycled' - end if - end if - -end subroutine cam3_ozone_data_init - -!================================================================================================ - -subroutine cam3_ozone_data_timestep_init(pbuf2d, phys_state) -!----------------------------------------------------------------------- -! -! Purpose: Interpolate ozone mixing ratios to current time, reading in new monthly -! data if necessary, and spatially interpolating it. -! -! Method: Find next month of ozone data to interpolate. Linearly interpolate -! vertically and horizontally -! -!----------------------------------------------------------------------- - - - use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_get_chunk - - - type(physics_state), intent(in) :: phys_state(begchunk:endchunk) - type(physics_buffer_desc), pointer :: pbuf2d(:,:) - real(r8),pointer :: tmpptr(:,:) - - integer lchnk - - call boundarydata_update(phys_state, ozonedata) - - do lchnk = begchunk, endchunk - call pbuf_get_field(pbuf_get_chunk(pbuf2d, lchnk), oz_idx, tmpptr) - call ozone_data_get_cnst(phys_state(lchnk), tmpptr) - enddo - -end subroutine cam3_ozone_data_timestep_init - -!================================================================================================ - -subroutine ozone_data_get_cnst(state, q) - - use cam_history, only: outfld - use physconst, only: mwo3 - - type(physics_state), intent(in) :: state - real(r8) :: q(:,:) ! constituent mass mixing ratio - - ! local variables - integer :: lchnk ! chunk identifier - integer :: i, k - real(r8) :: ozmixin(pcols,ozonedata%levsiz) - ! *** N.B. this hardwired mw of dry air needs to be changed to the share value - real(r8), parameter :: mwdry = 28.9644_r8 ! Effective molecular weight of dry air (g/mol) - real(r8), parameter :: mwr = mwo3/mwdry ! convert from the dataset values of vmr to mmr - !------------------------------------------------------------------------------- - - lchnk = state%lchnk - - ozmixin=0._r8 - do k=1,ozonedata%levsiz - do i=1,state%ncol - ozmixin(i,k) = ozonedata%datainst(state%latmapback(i),k,lchnk,1) - end do - end do - call boundarydata_vert_interp(lchnk, state%ncol, ozonedata%levsiz, & - 1, ozonedata%pin, state%pmid, ozmixin , q) - - call outfld('O3VMR', q, pcols, lchnk) - - do k=1,pver - do i=1,state%ncol - q(i,k) = mwr*q(i,k) - end do - end do - -end subroutine ozone_data_get_cnst - -!================================================================================================ - -end module cam3_ozone_data - diff --git a/src/physics/cam/cam_diagnostics.F90 b/src/physics/cam/cam_diagnostics.F90 index 2886c44222..97dad2ba01 100644 --- a/src/physics/cam/cam_diagnostics.F90 +++ b/src/physics/cam/cam_diagnostics.F90 @@ -901,11 +901,12 @@ subroutine diag_phys_writeout_dry(state, pbuf, p_surf_t) ! Purpose: output dry physics diagnostics ! !----------------------------------------------------------------------- - use physconst, only: gravit, rga, rair, cappa - use time_manager, only: get_nstep - use interpolate_data, only: vertinterp - use tidal_diag, only: tidal_diag_write - use air_composition, only: cpairv, rairv + use physconst, only: gravit, rga, rair, cappa + use time_manager, only: get_nstep + use interpolate_data, only: vertinterp + use tidal_diag, only: tidal_diag_write + use air_composition, only: cpairv, rairv + use cam_diagnostic_utils, only: cpslec !----------------------------------------------------------------------- ! ! Arguments diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index 290d0022de..9c569387e0 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -262,7 +262,7 @@ subroutine check_energy_timestep_init(state, tend, pbuf, col_type) state%pdel(1:ncol,1:pver), cp_or_cv(1:ncol,1:pver), & state%u(1:ncol,1:pver), state%v(1:ncol,1:pver), state%T(1:ncol,1:pver), & vc_physics, ptop=state%pintdry(1:ncol,1), phis = state%phis(1:ncol),& - te = state%te_ini(1:ncol,phys_te_idx), H2O = state%tw_ini(1:ncol,phys_te_idx)) + te = state%te_ini(1:ncol,phys_te_idx), H2O = state%tw_ini(1:ncol)) ! ! Dynamical core total energy ! @@ -283,7 +283,7 @@ subroutine check_energy_timestep_init(state, tend, pbuf, col_type) state%u(1:ncol,1:pver), state%v(1:ncol,1:pver), state%T(1:ncol,1:pver), & vc_dycore, ptop=state%pintdry(1:ncol,1), phis = state%phis(1:ncol), & z_mid = state%z_ini(1:ncol,:), & - te = state%te_ini(1:ncol,dyn_te_idx), H2O = state%tw_ini(1:ncol,dyn_te_idx)) + te = state%te_ini(1:ncol,dyn_te_idx), H2O = state%tw_ini(1:ncol)) else if (vc_dycore == vc_dry_pressure) then ! ! SE specific hydrostatic energy (enthalpy) @@ -297,16 +297,15 @@ subroutine check_energy_timestep_init(state, tend, pbuf, col_type) state%pdel(1:ncol,1:pver), cp_or_cv(1:ncol,1:pver), & state%u(1:ncol,1:pver), state%v(1:ncol,1:pver), state%T(1:ncol,1:pver), & vc_dry_pressure, ptop=state%pintdry(1:ncol,1), phis = state%phis(1:ncol), & - te = state%te_ini(1:ncol,dyn_te_idx), H2O = state%tw_ini(1:ncol,dyn_te_idx)) + te = state%te_ini(1:ncol,dyn_te_idx), H2O = state%tw_ini(1:ncol)) else ! ! dycore energy is the same as physics ! state%te_ini(1:ncol,dyn_te_idx) = state%te_ini(1:ncol,phys_te_idx) - state%tw_ini(1:ncol,dyn_te_idx) = state%tw_ini(1:ncol,phys_te_idx) end if state%te_cur(:ncol,:) = state%te_ini(:ncol,:) - state%tw_cur(:ncol,:) = state%tw_ini(:ncol,:) + state%tw_cur(:ncol) = state%tw_ini(:ncol) ! zero cummulative boundary fluxes tend%te_tnd(:ncol) = 0._r8 @@ -404,7 +403,7 @@ subroutine check_energy_chng(state, tend, name, nstep, ztodt, & do i = 1, ncol ! change in static energy and total water te_dif(i) = te(i) - state%te_cur(i,phys_te_idx) - tw_dif(i) = tw(i) - state%tw_cur(i,phys_te_idx) + tw_dif(i) = tw(i) - state%tw_cur(i) ! expected tendencies from boundary fluxes for last process te_tnd(i) = flx_vap(i)*(latvap+latice) - (flx_cnd(i) - flx_ice(i))*1000._r8*latice + flx_sen(i) @@ -416,7 +415,7 @@ subroutine check_energy_chng(state, tend, name, nstep, ztodt, & ! expected new values from previous state plus boundary fluxes te_xpd(i) = state%te_cur(i,phys_te_idx) + te_tnd(i)*ztodt - tw_xpd(i) = state%tw_cur(i,phys_te_idx) + tw_tnd(i)*ztodt + tw_xpd(i) = state%tw_cur(i) + tw_tnd(i)*ztodt ! relative error, expected value - input state / previous state te_rer(i) = (te_xpd(i) - te(i)) / state%te_cur(i,phys_te_idx) @@ -424,8 +423,8 @@ subroutine check_energy_chng(state, tend, name, nstep, ztodt, & ! relative error for total water (allow for dry atmosphere) tw_rer = 0._r8 - where (state%tw_cur(:ncol,phys_te_idx) > 0._r8) - tw_rer(:ncol) = (tw_xpd(:ncol) - tw(:ncol)) / state%tw_cur(:ncol,1) + where (state%tw_cur(:ncol) > 0._r8) + tw_rer(:ncol) = (tw_xpd(:ncol) - tw(:ncol)) / state%tw_cur(:ncol) end where ! error checking @@ -457,7 +456,7 @@ subroutine check_energy_chng(state, tend, name, nstep, ztodt, & do i = 1, ncol state%te_cur(i,phys_te_idx) = te(i) - state%tw_cur(i,phys_te_idx) = tw(i) + state%tw_cur(i) = tw(i) end do ! @@ -480,7 +479,7 @@ subroutine check_energy_chng(state, tend, name, nstep, ztodt, & state%u(1:ncol,1:pver), state%v(1:ncol,1:pver), temp(1:ncol,1:pver), & vc_dycore, ptop=state%pintdry(1:ncol,1), phis = state%phis(1:ncol), & z_mid = state%z_ini(1:ncol,:), & - te = state%te_cur(1:ncol,dyn_te_idx), H2O = state%tw_cur(1:ncol,dyn_te_idx)) + te = state%te_cur(1:ncol,dyn_te_idx), H2O = state%tw_cur(1:ncol)) else if (vc_dycore == vc_dry_pressure) then ! ! SE specific hydrostatic energy @@ -500,10 +499,9 @@ subroutine check_energy_chng(state, tend, name, nstep, ztodt, & state%pdel(1:ncol,1:pver), cp_or_cv(1:ncol,1:pver), & state%u(1:ncol,1:pver), state%v(1:ncol,1:pver), temp(1:ncol,1:pver), & vc_dry_pressure, ptop=state%pintdry(1:ncol,1), phis = state%phis(1:ncol), & - te = state%te_cur(1:ncol,dyn_te_idx), H2O = state%tw_cur(1:ncol,dyn_te_idx)) + te = state%te_cur(1:ncol,dyn_te_idx), H2O = state%tw_cur(1:ncol)) else state%te_cur(1:ncol,dyn_te_idx) = te(1:ncol) - state%tw_cur(1:ncol,dyn_te_idx) = tw(1:ncol) end if end subroutine check_energy_chng diff --git a/src/physics/cam/cloud_diagnostics.F90 b/src/physics/cam/cloud_diagnostics.F90 index b3488bec60..bd0f9b8e9d 100644 --- a/src/physics/cam/cloud_diagnostics.F90 +++ b/src/physics/cam/cloud_diagnostics.F90 @@ -39,6 +39,8 @@ module cloud_diagnostics integer :: cldtau_idx = -1 integer :: nmxrgn_idx = -1 integer :: pmxrgn_idx = -1 + integer :: gb_totcldliqmr_idx = -1 + integer :: gb_totcldicemr_idx = -1 ! Index fields for precipitation efficiency. integer :: acpr_idx, acgcme_idx, acnum_idx @@ -103,6 +105,10 @@ subroutine cloud_diagnostics_init(pbuf2d) !----------------------------------------------------------------------- cld_idx = pbuf_get_index('CLD') + ! grid box total cloud liquid water mixing ratio (kg/kg) + gb_totcldliqmr_idx = pbuf_get_index('GB_TOTCLDLIQMR') + ! grid box total cloud ice water mixing ratio (kg/kg) + gb_totcldicemr_idx = pbuf_get_index('GB_TOTCLDICEMR') call phys_getopts(use_spcam_out=use_spcam) @@ -254,6 +260,9 @@ subroutine cloud_diagnostics_calc(state, pbuf) integer, pointer :: nmxrgn(:) ! Number of maximally overlapped regions real(r8), pointer :: pmxrgn(:,:) ! Maximum values of pressure for each + real(r8), pointer :: totg_ice(:,:) ! grid box total cloud ice mixing ratio + real(r8), pointer :: totg_liq(:,:) ! grid box total cloud liquid mixing ratio + integer :: itim_old real(r8) :: cwp (pcols,pver) ! in-cloud cloud (total) water path @@ -306,6 +315,9 @@ subroutine cloud_diagnostics_calc(state, pbuf) itim_old = pbuf_old_tim_idx() call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + call pbuf_get_field(pbuf, gb_totcldicemr_idx, totg_ice) + call pbuf_get_field(pbuf, gb_totcldliqmr_idx, totg_liq) + if(two_mom_clouds)then call pbuf_get_field(pbuf, iclwp_idx, iclwp ) @@ -371,10 +383,9 @@ subroutine cloud_diagnostics_calc(state, pbuf) ! iclwp and iciwp to pass to the radiation. ! ! ----------------------------------------------------------- ! if( conv_water_in_rad /= 0 ) then - allcld_ice(:ncol,:) = 0._r8 ! Grid-avg all cloud liquid - allcld_liq(:ncol,:) = 0._r8 ! Grid-avg all cloud ice - - call conv_water_4rad(state, pbuf, allcld_liq, allcld_ice) + call conv_water_4rad(state, pbuf) + allcld_ice(:ncol,:) = totg_ice(:ncol,:) ! Grid-avg all cloud liquid + allcld_liq(:ncol,:) = totg_liq(:ncol,:) ! Grid-avg all cloud ice else allcld_liq(:ncol,top_lev:pver) = state%q(:ncol,top_lev:pver,ixcldliq) ! Grid-ave all cloud liquid allcld_ice(:ncol,top_lev:pver) = state%q(:ncol,top_lev:pver,ixcldice) ! " ice @@ -419,7 +430,9 @@ subroutine cloud_diagnostics_calc(state, pbuf) elseif(one_mom_clouds) then if (conv_water_in_rad /= 0) then - call conv_water_4rad(state, pbuf, allcld_liq, allcld_ice) + call conv_water_4rad(state, pbuf) + allcld_ice(:ncol,:) = totg_ice(:ncol,:) ! Grid-avg all cloud liquid + allcld_liq(:ncol,:) = totg_liq(:ncol,:) ! Grid-avg all cloud ice else allcld_liq = state%q(:,:,ixcldliq) allcld_ice = state%q(:,:,ixcldice) diff --git a/src/physics/cam/conv_water.F90 b/src/physics/cam/conv_water.F90 index dfcdb7be98..d848895366 100644 --- a/src/physics/cam/conv_water.F90 +++ b/src/physics/cam/conv_water.F90 @@ -3,7 +3,7 @@ module conv_water ! --------------------------------------------------------------------- ! ! Purpose: ! ! Computes grid-box average liquid (and ice) from stratus and cumulus ! - ! Just for the purposes of radiation. ! + ! These values used by both the radiation and the COSP diagnostics. ! ! ! ! Method: ! ! Extract information about deep+shallow liquid and cloud fraction from ! @@ -38,9 +38,10 @@ module conv_water ! pbuf indices integer :: icwmrsh_idx, icwmrdp_idx, fice_idx, sh_frac_idx, dp_frac_idx, & - ast_idx, sh_cldliq1_idx, sh_cldice1_idx, rei_idx + ast_idx, rei_idx integer :: ixcldice, ixcldliq + integer :: gb_totcldliqmr_idx, gb_totcldicemr_idx ! Namelist integer, parameter :: unset_int = huge(1) @@ -113,11 +114,10 @@ subroutine conv_water_register !----------------------------------------------------------------------- - ! these calls were already done in convect_shallow...so here I add the same fields to the physics buffer with a "1" at the end -! shallow gbm cloud liquid water (kg/kg) - call pbuf_add_field('SH_CLDLIQ1','physpkg',dtype_r8,(/pcols,pver/),sh_cldliq1_idx) -! shallow gbm cloud ice water (kg/kg) - call pbuf_add_field('SH_CLDICE1','physpkg',dtype_r8,(/pcols,pver/),sh_cldice1_idx) + ! grid box total cloud liquid water mixing ratio (kg/kg) + call pbuf_add_field('GB_TOTCLDLIQMR', 'physpkg', dtype_r8, (/pcols,pver/), gb_totcldliqmr_idx) + ! grid box total cloud ice water mixing ratio (kg/kg) + call pbuf_add_field('GB_TOTCLDICEMR', 'physpkg', dtype_r8, (/pcols,pver/), gb_totcldicemr_idx) end subroutine conv_water_register @@ -168,7 +168,7 @@ subroutine conv_water_init() end subroutine conv_water_init - subroutine conv_water_4rad(state, pbuf, totg_liq, totg_ice) + subroutine conv_water_4rad(state, pbuf) ! --------------------------------------------------------------------- ! ! Purpose: ! @@ -202,9 +202,6 @@ subroutine conv_water_4rad(state, pbuf, totg_liq, totg_ice) type(physics_state), target, intent(in) :: state ! state variables type(physics_buffer_desc), pointer :: pbuf(:) - real(r8), intent(out):: totg_ice(pcols,pver) ! Total GBA in-cloud ice - real(r8), intent(out):: totg_liq(pcols,pver) ! Total GBA in-cloud liquid - ! --------------- ! ! Local Workspace ! ! --------------- ! @@ -222,8 +219,9 @@ subroutine conv_water_4rad(state, pbuf, totg_liq, totg_ice) real(r8), pointer, dimension(:,:) :: dp_icwmr ! Deep conv. cloud water real(r8), pointer, dimension(:,:) :: sh_icwmr ! Shallow conv. cloud water real(r8), pointer, dimension(:,:) :: fice ! Ice partitioning ratio - real(r8), pointer, dimension(:,:) :: sh_cldliq ! shallow convection gbx liq cld mixing ratio for COSP - real(r8), pointer, dimension(:,:) :: sh_cldice ! shallow convection gbx ice cld mixing ratio for COSP + + real(r8), pointer, dimension(:,:) :: totg_ice ! Grid box total cloud ice mixing ratio + real(r8), pointer, dimension(:,:) :: totg_liq ! Grid box total cloud liquid mixing ratio real(r8) :: conv_ice(pcols,pver) ! Convective contributions to IC cloud ice real(r8) :: conv_liq(pcols,pver) ! Convective contributions to IC cloud liquid @@ -282,6 +280,10 @@ subroutine conv_water_4rad(state, pbuf, totg_liq, totg_ice) itim_old = pbuf_old_tim_idx() call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) ) + ! Fields computed below and stored in pbuf. + call pbuf_get_field(pbuf, gb_totcldicemr_idx, totg_ice) + call pbuf_get_field(pbuf, gb_totcldliqmr_idx, totg_liq) + ! --------------------------------------------------------------- ! ! Loop through grid-boxes and determine: ! ! 1. Effective mean in-cloud convective ice/liquid (deep+shallow) ! @@ -407,13 +409,6 @@ subroutine conv_water_4rad(state, pbuf, totg_liq, totg_ice) end do end do -!add pbuff calls for COSP - call pbuf_get_field(pbuf, sh_cldliq1_idx, sh_cldliq ) - call pbuf_get_field(pbuf, sh_cldice1_idx, sh_cldice ) - - sh_cldliq(:ncol,:pver)=sh_icwmr(:ncol,:pver)*(1-fice(:ncol,:pver))*sh_frac(:ncol,:pver) - sh_cldice(:ncol,:pver)=sh_icwmr(:ncol,:pver)*fice(:ncol,:pver)*sh_frac(:ncol,:pver) - ! Output convective IC WMRs call outfld( 'ICLMRCU ', conv_liq , pcols, lchnk ) diff --git a/src/physics/cam/convect_shallow.F90 b/src/physics/cam/convect_shallow.F90 index 8086f16ddb..242001d483 100644 --- a/src/physics/cam/convect_shallow.F90 +++ b/src/physics/cam/convect_shallow.F90 @@ -250,7 +250,7 @@ subroutine convect_shallow_init(pref_edge, pbuf2d) call add_default( 'CMFDICE ', history_budget_histfile_num, ' ' ) call add_default( 'CMFDT ', history_budget_histfile_num, ' ' ) call add_default( 'CMFDQ ', history_budget_histfile_num, ' ' ) - if( cam_physpkg_is('cam3') .or. cam_physpkg_is('cam4') ) then + if( cam_physpkg_is('cam4') ) then call add_default( 'EVAPQCM ', history_budget_histfile_num, ' ' ) call add_default( 'EVAPTCM ', history_budget_histfile_num, ' ' ) end if diff --git a/src/physics/cam/cospsimulator_intr.F90 b/src/physics/cam/cospsimulator_intr.F90 index 7db2792a12..7e81e61053 100644 --- a/src/physics/cam/cospsimulator_intr.F90 +++ b/src/physics/cam/cospsimulator_intr.F90 @@ -212,8 +212,9 @@ module cospsimulator_intr ! chunk (allocatable->1:pcols,begchunk:endchunk) ! pbuf indices integer :: cld_idx, concld_idx, lsreffrain_idx, lsreffsnow_idx, cvreffliq_idx - integer :: cvreffice_idx, dpcldliq_idx, dpcldice_idx - integer :: shcldliq1_idx, shcldice1_idx, dpflxprc_idx + integer :: cvreffice_idx + integer :: gb_totcldliqmr_idx, gb_totcldicemr_idx + integer :: dpflxprc_idx integer :: dpflxsnw_idx, shflxprc_idx, shflxsnw_idx, lsflxprc_idx, lsflxsnw_idx integer :: rei_idx, rel_idx @@ -870,10 +871,8 @@ subroutine cospsimulator_intr_init() lsreffsnow_idx = pbuf_get_index('LS_REFFSNOW') cvreffliq_idx = pbuf_get_index('CV_REFFLIQ') cvreffice_idx = pbuf_get_index('CV_REFFICE') - dpcldliq_idx = pbuf_get_index('DP_CLDLIQ') - dpcldice_idx = pbuf_get_index('DP_CLDICE') - shcldliq1_idx = pbuf_get_index('SH_CLDLIQ1') - shcldice1_idx = pbuf_get_index('SH_CLDICE1') + gb_totcldliqmr_idx = pbuf_get_index('GB_TOTCLDLIQMR') ! grid box total cloud liquid water mr (kg/kg) + gb_totcldicemr_idx = pbuf_get_index('GB_TOTCLDICEMR') ! grid box total cloud ice water mr (kg/kg) dpflxprc_idx = pbuf_get_index('DP_FLXPRC') dpflxsnw_idx = pbuf_get_index('DP_FLXSNW') shflxprc_idx = pbuf_get_index('SH_FLXPRC', errcode=ierr) @@ -1205,11 +1204,9 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & real(r8), pointer, dimension(:,:) :: ls_flxprc ! stratiform interface gbm flux_cloud_rain+snow (kg m^-2 s^-1) real(r8), pointer, dimension(:,:) :: ls_flxsnw ! stratiform interface gbm flux_cloud_snow (kg m^-2 s^-1) - !! cloud mixing ratio pointers (note: large-scale in state) - real(r8), pointer, dimension(:,:) :: sh_cldliq ! shallow gbm cloud liquid water (kg/kg) - real(r8), pointer, dimension(:,:) :: sh_cldice ! shallow gbm cloud ice water (kg/kg) - real(r8), pointer, dimension(:,:) :: dp_cldliq ! deep gbm cloud liquid water (kg/kg) - real(r8), pointer, dimension(:,:) :: dp_cldice ! deep gmb cloud ice water (kg/kg) + !! grid box total cloud mixing ratio (large-scale + convective) + real(r8), pointer, dimension(:,:) :: totg_liq ! gbm total cloud liquid water (kg/kg) + real(r8), pointer, dimension(:,:) :: totg_ice ! gbm total cloud ice water (kg/kg) ! Output CAM variables ! Multiple "mdims" are collapsed because CAM history buffers only support one mdim. @@ -1508,11 +1505,9 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & call pbuf_get_field(pbuf, cvreffliq_idx, cv_reffliq ) call pbuf_get_field(pbuf, cvreffice_idx, cv_reffice ) - !! convective cloud mixing ratios - call pbuf_get_field(pbuf, dpcldliq_idx, dp_cldliq ) - call pbuf_get_field(pbuf, dpcldice_idx, dp_cldice ) - call pbuf_get_field(pbuf, shcldliq1_idx, sh_cldliq ) - call pbuf_get_field(pbuf, shcldice1_idx, sh_cldice ) + !! grid box total cloud mixing ratios + call pbuf_get_field(pbuf, gb_totcldliqmr_idx, totg_liq) + call pbuf_get_field(pbuf, gb_totcldicemr_idx, totg_ice) !! precipitation fluxes call pbuf_get_field(pbuf, dpflxprc_idx, dp_flxprc ) @@ -1616,9 +1611,12 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & grpl_ls_interp = 0._r8 - !! CAM5 cloud mixing ratio calculations - !! Note: Although CAM5 has non-zero convective cloud mixing ratios that affect the model state, - !! Convective cloud water is NOT part of radiation calculations. + ! subroutine subsample_and_optics provides separate arguments to pass + ! the large scale and convective cloud condensate. Below the grid box + ! total cloud water mixing ratios are passed in the arrays for the + ! large scale contributions and the arrays for the convective + ! contributions are set to zero. This is consistent with the treatment + ! of cloud water by the radiation code. mr_ccliq = 0._r8 mr_ccice = 0._r8 mr_lsliq = 0._r8 @@ -1627,11 +1625,8 @@ subroutine cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, & kk = ktop + k -1 do i = 1, ncol if (cld(i,k) > 0._r8) then - !! note: convective mixing ratio is the sum of shallow and deep convective clouds in CAM5 - mr_ccliq(i,k) = sh_cldliq(i,kk) + dp_cldliq(i,kk) - mr_ccice(i,k) = sh_cldice(i,kk) + dp_cldice(i,kk) - mr_lsliq(i,k) = state%q(i,kk,ixcldliq) ! state only includes stratiform (kg/kg) - mr_lsice(i,k) = state%q(i,kk,ixcldice) ! state only includes stratiform (kg/kg) + mr_lsliq(i,k) = totg_liq(i,kk) + mr_lsice(i,k) = totg_ice(i,kk) end if end do end do diff --git a/src/physics/cam/eddy_diff.F90 b/src/physics/cam/eddy_diff.F90 index de50778cbd..b48e7ed137 100644 --- a/src/physics/cam/eddy_diff.F90 +++ b/src/physics/cam/eddy_diff.F90 @@ -632,7 +632,7 @@ subroutine caleddy( pcols , pver , ncol , kvh_in , kvm_in , kvh , kvm , & tpert , qpert , qrlin , kvf , tke , & wstarent , bprod , sprod , minpblh , wpert , & - tkes , went , turbtype , sm_aw , & + tkes , went , turbtype , & kbase_o , ktop_o , ncvfin_o , & kbase_mg , ktop_mg , ncvfin_mg , & kbase_f , ktop_f , ncvfin_f , & @@ -752,8 +752,6 @@ subroutine caleddy( pcols , pver , ncol , ! 3. = Bottom external interface of CL ! 4. = Top external interface of CL. ! 5. = Double entraining CL external interface - real(r8), intent(out) :: sm_aw(pcols,pver+1) ! Galperin instability function of momentum for use in the microphysics - ! [ no unit ] integer(i4), intent(out) :: ipbl(pcols) ! If 1, PBL is CL, while if 0, PBL is STL. integer(i4), intent(out) :: kpblh(pcols) ! Layer index containing PBL within or at the base interface real(r8), intent(out) :: wsed_CL(pcols,ncvmax) ! Sedimentation velocity at the top of each CL [ m/s ] @@ -1002,7 +1000,6 @@ subroutine caleddy( pcols , pver , ncol , sh_a(i,:pver+1) = 0._r8 sm_a(i,:pver+1) = 0._r8 ri_a(i,:pver+1) = 0._r8 - sm_aw(i,:pver+1) = 0._r8 ipbl(i) = 0 kpblh(i) = pver wsed_CL(i,:ncvmax) = 0._r8 @@ -1844,7 +1841,6 @@ subroutine caleddy( pcols , pver , ncol , bprod(i,k) = -kvh(i,k) * n2(i,k) sprod(i,k) = kvm(i,k) * s2(i,k) turbtype(i,k) = 2 ! CL interior interfaces. - sm_aw(i,k) = smcl(i,ncv)/alph1 ! Diagnostic output for microphysics end do ! 2. At CL top entrainment interface @@ -1860,7 +1856,6 @@ subroutine caleddy( pcols , pver , ncol , rcap = min( max(rcap,rcapmin), rcapmax ) tke(i,kt) = ebrk(i,ncv) * rcap tke(i,kt) = min( tke(i,kt), tkemax ) - sm_aw(i,kt) = smcl(i,ncv) / alph1 ! Diagnostic output for microphysics ! 3. At CL base entrainment interface and double entraining interfaces ! When current CL base is also the top interface of CL regime below, @@ -1921,12 +1916,6 @@ subroutine caleddy( pcols , pver , ncol , end if - ! For double entraining interface, simply use smcl(i,ncv) of the overlying CL. - ! Below 'sm_aw' is a diagnostic output for use in the microphysics. - ! When 'kb' is surface, 'sm' will be over-written later below. - - sm_aw(i,kb) = smcl(i,ncv)/alph1 - ! Calculate wcap at all interfaces of CL. Put a minimum threshold on TKE ! to prevent possible division by zero. 'wcap' at CL internal interfaces ! are already calculated in the first part of 'do ncv' loop correctly. @@ -2122,8 +2111,6 @@ subroutine caleddy( pcols , pver , ncol , bprod(i,k) = -kvh(i,k) * n2(i,k) sprod(i,k) = kvm(i,k) * s2(i,k) - sm_aw(i,k) = sm/alph1 ! This is diagnostic output for use in the microphysics - end if end do ! k @@ -2192,7 +2179,6 @@ subroutine caleddy( pcols , pver , ncol , wcap(i,k) = tke_imsi / b1 bprod(i,k) = -kvh_imsi * n2(i,k) sprod(i,k) = kvm_imsi * s2(i,k) - sm_aw(i,k) = sm/alph1 ! This is diagnostic output for use in the microphysics turbtype(i,k) = 1 ! This was added on Dec.10.2009 for use in microphysics. endif @@ -2257,7 +2243,6 @@ subroutine caleddy( pcols , pver , ncol , else sm_a(i,pver+1) = max(0._r8,(alph1+alph2*gh)/(1._r8+alph3*gh)/(1._r8+alph4exs*gh)) endif - sm_aw(i,pver+1) = sm_a(i,pver+1)/alph1 ri_a(i,pver+1) = -(sm_a(i,pver+1)/sh_a(i,pver+1))*(bprod(i,pver+1)/sprod(i,pver+1)) do k = 1, pver diff --git a/src/physics/cam/eddy_diff_cam.F90 b/src/physics/cam/eddy_diff_cam.F90 index f8660e35f1..1742bf5038 100644 --- a/src/physics/cam/eddy_diff_cam.F90 +++ b/src/physics/cam/eddy_diff_cam.F90 @@ -321,7 +321,7 @@ subroutine eddy_diff_tend(state, pbuf, cam_in, & ztodt, p, tint, rhoi, cldn, wstarent, & kvm_in, kvh_in, ksrftms, dragblj,tauresx, tauresy, & rrho, ustar, pblh, kvm, kvh, kvq, cgh, cgs, tpert, qpert, & - tke, sprod, sfi, turbtype, sm_aw) + tke, sprod, sfi) use physics_types, only: physics_state use camsrfexch, only: cam_in_t @@ -355,8 +355,6 @@ subroutine eddy_diff_tend(state, pbuf, cam_in, & real(r8), intent(out) :: tke(pcols,pver+1) real(r8), intent(out) :: sprod(pcols,pver+1) real(r8), intent(out) :: sfi(pcols,pver+1) - integer(i4), intent(out) :: turbtype(pcols,pver+1) - real(r8), intent(out) :: sm_aw(pcols,pver+1) integer :: i, k @@ -370,7 +368,7 @@ subroutine eddy_diff_tend(state, pbuf, cam_in, & kvh , kvq , cgh , & cgs , tpert , qpert , tke , & sprod , sfi , & - tauresx , tauresy , ksrftms , dragblj , turbtype , sm_aw ) + tauresx , tauresy , ksrftms , dragblj ) ! The diffusivities from diag_TKE can be much larger than from HB in the free ! troposphere and upper atmosphere. These seem to be larger than observations, @@ -416,7 +414,7 @@ subroutine compute_eddy_diff( pbuf, lchnk , ustar , pblh , kvm_in , kvh_in , kvm_out , kvh_out , kvq , & cgh , cgs , tpert , qpert , tke , & sprod , sfi , & - tauresx, tauresy, ksrftms, dragblj, turbtype, sm_aw ) + tauresx, tauresy, ksrftms, dragblj ) !-------------------------------------------------------------------- ! ! Purpose: Interface to compute eddy diffusivities. ! @@ -490,10 +488,6 @@ subroutine compute_eddy_diff( pbuf, lchnk , real(r8), intent(out) :: tke(pcols,pver+1) ! Turbulent kinetic energy [ m2/s2 ] real(r8), intent(out) :: sprod(pcols,pver+1) ! Shear production [ m2/s3 ] real(r8), intent(out) :: sfi(pcols,pver+1) ! Interfacial layer saturation fraction [ fraction ] - integer(i4), intent(out):: turbtype(pcols,pver+1) ! Turbulence type identifier at all interfaces [ no unit ] - real(r8), intent(out) :: sm_aw(pcols,pver+1) ! Normalized Galperin instability function for momentum [ no unit ] - ! This is 1 when neutral condition (Ri=0), - ! 4.964 for maximum unstable case, and 0 when Ri > Ricrit=0.19. ! ---------------------- ! ! Input-Output Variables ! @@ -623,6 +617,8 @@ subroutine compute_eddy_diff( pbuf, lchnk , ! For sedimentation-entrainment feedback real(r8) :: wsed(pcols,ncvmax) ! Sedimentation velocity at the top of each CL [ m/s ] + integer(i4) :: turbtype(pcols,pver+1) ! Turbulence type identifier at all interfaces [ no unit ] + ! ---------- ! ! Parameters ! ! ---------- ! @@ -738,7 +734,7 @@ subroutine compute_eddy_diff( pbuf, lchnk , kvh , kvm , kvh_out , kvm_out , & tpert , qpert , qrl , kvf , tke , & wstarent , bprod , sprod , minpblh , wpert , & - tkes , went , turbtype , sm_aw , & + tkes , went , turbtype , & kbase_o , ktop_o , ncvfin_o , & kbase_mg , ktop_mg , ncvfin_mg , & kbase_f , ktop_f , ncvfin_f , & diff --git a/src/physics/cam/gw_common.F90 b/src/physics/cam/gw_common.F90 index ae91ec08ce..04014c8c97 100644 --- a/src/physics/cam/gw_common.F90 +++ b/src/physics/cam/gw_common.F90 @@ -98,7 +98,7 @@ module gw_common real(r8) :: dc ! Reference speeds [m/s]. real(r8), allocatable :: cref(:) - ! Critical Froude number, squared (usually 1, but CAM3 used 0.5). + ! Critical Froude number, squared real(r8) :: fcrit2 ! Horizontal wave number [1/m]. real(r8) :: kwv diff --git a/src/physics/cam/gw_drag.F90 b/src/physics/cam/gw_drag.F90 index aeab27a5c6..798ad63059 100644 --- a/src/physics/cam/gw_drag.F90 +++ b/src/physics/cam/gw_drag.F90 @@ -235,14 +235,9 @@ subroutine gw_drag_readnl(nlfile) integer :: pgwv_long = -1 real(r8) :: gw_dc_long = unset_r8 - ! fcrit2 for the mid-scale waves has been made a namelist variable to - ! facilitate backwards compatibility with the CAM3 version of this - ! parameterization. In CAM3, fcrit2=0.5. - real(r8) :: fcrit2 = unset_r8 ! critical froude number squared - namelist /gw_drag_nl/ pgwv, gw_dc, pgwv_long, gw_dc_long, tau_0_ubc, & effgw_beres_dp, effgw_beres_sh, effgw_cm, effgw_cm_igw, effgw_oro, & - fcrit2, frontgfc, gw_drag_file, gw_drag_file_sh, gw_drag_file_mm, taubgnd, & + frontgfc, gw_drag_file, gw_drag_file_sh, gw_drag_file_mm, taubgnd, & taubgnd_igw, gw_polar_taper, & use_gw_rdg_beta, n_rdg_beta, effgw_rdg_beta, effgw_rdg_beta_max, & rdg_beta_cd_llb, trpd_leewv_rdg_beta, & @@ -320,8 +315,6 @@ subroutine gw_drag_readnl(nlfile) call mpi_bcast(gw_oro_south_fac, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: gw_oro_south_fac") - call mpi_bcast(fcrit2, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: fcrit2") call mpi_bcast(frontgfc, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: frontgfc") call mpi_bcast(taubgnd, 1, mpi_real8, mstrid, mpicom, ierr) @@ -359,11 +352,6 @@ subroutine gw_drag_readnl(nlfile) call mpi_bcast(alpha_gw_movmtn, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: alpha_gw_movmtn") - ! Check if fcrit2 was set. - call shr_assert(fcrit2 /= unset_r8, & - "gw_drag_readnl: fcrit2 must be set via the namelist."// & - errMsg(__FILE__, __LINE__)) - ! Check if pgwv was set. call shr_assert(pgwv >= 0, & "gw_drag_readnl: pgwv must be set via the namelist and & @@ -375,7 +363,7 @@ subroutine gw_drag_readnl(nlfile) "gw_drag_readnl: gw_dc must be set via the namelist."// & errMsg(__FILE__, __LINE__)) - band_oro = GWBand(0, gw_dc, fcrit2, wavelength_mid) + band_oro = GWBand(0, gw_dc, 1.0_r8, wavelength_mid) band_mid = GWBand(pgwv, gw_dc, 1.0_r8, wavelength_mid) band_long = GWBand(pgwv_long, gw_dc_long, 1.0_r8, wavelength_long) band_movmtn = GWBand(0, gw_dc, 1.0_r8, wavelength_mid) @@ -1716,7 +1704,13 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) call alloc_err(istat,'gw_tend','phase_speeds',ncol*band_movmtn%ngwv**2+1) ! Set up heating - call pbuf_get_field(pbuf, ttend_dp_idx, ttend_dp) + if (ttend_dp_idx > 0) then + call pbuf_get_field(pbuf, ttend_dp_idx, ttend_dp) + else + allocate(ttend_dp(pcols,pver), stat=istat) + call alloc_err(istat, 'gw_tend', 'ttend_dp', pcols*pver) + ttend_dp = 0.0_r8 + end if ! New couplings from CLUBB call pbuf_get_field(pbuf, ttend_clubb_idx, ttend_clubb) @@ -1789,7 +1783,15 @@ subroutine gw_tend(state, pbuf, dt, ptend, cam_in, flx_heat) call outfld('UPWP_CLUBB_GW', upwp_clubb_gw, pcols, lchnk) call outfld('VPWP_CLUBB_GW', vpwp_clubb_gw, pcols, lchnk) + !Deallocate variables that are no longer used: deallocate(tau, gwut, phase_speeds) + + !Deallocate/nullify ttend_dp if not a pbuf variable: + if (ttend_dp_idx <= 0) then + deallocate(ttend_dp) + nullify(ttend_dp) + end if + end if if (use_gw_convect_dp) then diff --git a/src/physics/cam/physics_types.F90 b/src/physics/cam/physics_types.F90 index 03f8022fa8..3228c27105 100644 --- a/src/physics/cam/physics_types.F90 +++ b/src/physics/cam/physics_types.F90 @@ -101,7 +101,8 @@ module physics_types ! Second dimension is (phys_te_idx) CAM physics total energy and ! (dyn_te_idx) dycore total energy computed in physics te_ini, &! vertically integrated total (kinetic + static) energy of initial state - te_cur, &! vertically integrated total (kinetic + static) energy of current state + te_cur ! vertically integrated total (kinetic + static) energy of current state + real(r8), dimension(:), allocatable :: & tw_ini, &! vertically integrated total water of initial state tw_cur ! vertically integrated total water of new state real(r8), dimension(:,:),allocatable :: & @@ -537,9 +538,9 @@ subroutine physics_state_check(state, name) varname="state%te_ini", msg=msg) call shr_assert_in_domain(state%te_cur(:ncol,:), is_nan=.false., & varname="state%te_cur", msg=msg) - call shr_assert_in_domain(state%tw_ini(:ncol,:), is_nan=.false., & + call shr_assert_in_domain(state%tw_ini(:ncol), is_nan=.false., & varname="state%tw_ini", msg=msg) - call shr_assert_in_domain(state%tw_cur(:ncol,:), is_nan=.false., & + call shr_assert_in_domain(state%tw_cur(:ncol), is_nan=.false., & varname="state%tw_cur", msg=msg) call shr_assert_in_domain(state%temp_ini(:ncol,:), is_nan=.false., & varname="state%temp_ini", msg=msg) @@ -615,9 +616,9 @@ subroutine physics_state_check(state, name) varname="state%te_ini", msg=msg) call shr_assert_in_domain(state%te_cur(:ncol,:), lt=posinf_r8, gt=neginf_r8, & varname="state%te_cur", msg=msg) - call shr_assert_in_domain(state%tw_ini(:ncol,:), lt=posinf_r8, gt=neginf_r8, & + call shr_assert_in_domain(state%tw_ini(:ncol), lt=posinf_r8, gt=neginf_r8, & varname="state%tw_ini", msg=msg) - call shr_assert_in_domain(state%tw_cur(:ncol,:), lt=posinf_r8, gt=neginf_r8, & + call shr_assert_in_domain(state%tw_cur(:ncol), lt=posinf_r8, gt=neginf_r8, & varname="state%tw_cur", msg=msg) call shr_assert_in_domain(state%temp_ini(:ncol,:), lt=posinf_r8, gt=neginf_r8, & varname="state%temp_ini", msg=msg) @@ -1351,8 +1352,8 @@ subroutine physics_state_copy(state_in, state_out) end do state_out%te_ini(:ncol,:) = state_in%te_ini(:ncol,:) state_out%te_cur(:ncol,:) = state_in%te_cur(:ncol,:) - state_out%tw_ini(:ncol,:) = state_in%tw_ini(:ncol,:) - state_out%tw_cur(:ncol,:) = state_in%tw_cur(:ncol,:) + state_out%tw_ini(:ncol) = state_in%tw_ini(:ncol) + state_out%tw_cur(:ncol) = state_in%tw_cur(:ncol) do k = 1, pver do i = 1, ncol @@ -1667,10 +1668,10 @@ subroutine physics_state_alloc(state,lchnk,psetcols) allocate(state%te_cur(psetcols,2), stat=ierr) if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%te_cur') - allocate(state%tw_ini(psetcols,2), stat=ierr) + allocate(state%tw_ini(psetcols), stat=ierr) if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%tw_ini') - allocate(state%tw_cur(psetcols,2), stat=ierr) + allocate(state%tw_cur(psetcols), stat=ierr) if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%tw_cur') allocate(state%temp_ini(psetcols,pver), stat=ierr) @@ -1720,8 +1721,8 @@ subroutine physics_state_alloc(state,lchnk,psetcols) state%te_ini(:,:) = inf state%te_cur(:,:) = inf - state%tw_ini(:,:) = inf - state%tw_cur(:,:) = inf + state%tw_ini(:) = inf + state%tw_cur(:) = inf state%temp_ini(:,:) = inf state%z_ini(:,:) = inf diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90 index 10f65a2ff2..8fd4ff52db 100644 --- a/src/physics/cam/physpkg.F90 +++ b/src/physics/cam/physpkg.F90 @@ -130,8 +130,6 @@ subroutine phys_register use tracers, only: tracers_register use check_energy, only: check_energy_register use carma_intr, only: carma_register - use cam3_aero_data, only: cam3_aero_data_on, cam3_aero_data_register - use cam3_ozone_data, only: cam3_ozone_data_on, cam3_ozone_data_register use ghg_data, only: ghg_data_register use vertical_diffusion, only: vd_register use convect_deep, only: convect_deep_register @@ -281,9 +279,6 @@ subroutine phys_register call co2_register() ! register data model ozone with pbuf - if (cam3_ozone_data_on) then - call cam3_ozone_data_register() - end if call prescribed_volcaero_register() call prescribed_strataero_register() call prescribed_ozone_register() @@ -291,11 +286,6 @@ subroutine phys_register call prescribed_ghg_register() call sslt_rebin_register - ! CAM3 prescribed aerosols - if (cam3_aero_data_on) then - call cam3_aero_data_register() - end if - ! register various data model gasses with pbuf call ghg_data_register() @@ -743,8 +733,6 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) use convect_shallow, only: convect_shallow_init use cam_diagnostics, only: diag_init use gw_drag, only: gw_init - use cam3_aero_data, only: cam3_aero_data_on, cam3_aero_data_init - use cam3_ozone_data, only: cam3_ozone_data_on, cam3_ozone_data_init use radheat, only: radheat_init use radiation, only: radiation_init use cloud_diagnostics, only: cloud_diagnostics_init @@ -859,9 +847,6 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) ! solar irradiance data modules call solar_data_init() - ! CAM3 prescribed aerosols - if (cam3_aero_data_on) call cam3_aero_data_init(phys_state) - ! Initialize rad constituents and their properties call rad_cnst_init() @@ -892,9 +877,6 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) call co2_init() end if - ! CAM3 prescribed ozone - if (cam3_ozone_data_on) call cam3_ozone_data_init(phys_state) - call gw_init() call rayleigh_friction_init() @@ -1575,7 +1557,7 @@ subroutine tphysac (ztodt, cam_in, & call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& fh2o, surfric, obklen, flx_heat) end if - call aoa_tracers_timestep_tend(state, ptend, cam_in%cflx, cam_in%landfrac, ztodt) + call aoa_tracers_timestep_tend(state, ptend, ztodt) if ( (trim(cam_take_snapshot_after) == "aoa_tracers_timestep_tend") .and. & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) @@ -2066,7 +2048,8 @@ subroutine tphysbc (ztodt, state, & use check_energy, only: check_tracers_data, check_tracers_init, check_tracers_chng use check_energy, only: tot_energy_phys use dycore, only: dycore_is - use aero_model, only: aero_model_wetdep, wetdep_lq + use aero_model, only: aero_model_wetdep + use aero_wetdep_cam, only: wetdep_lq use carma_intr, only: carma_wetdep_tend, carma_timestep_tend use carma_flags_mod, only: carma_do_detrain, carma_do_cldice, carma_do_cldliq, carma_do_wetdep use radiation, only: radiation_tend @@ -2958,8 +2941,6 @@ subroutine phys_timestep_init(phys_state, cam_in, cam_out, pbuf2d) use physics_buffer, only: physics_buffer_desc use carma_intr, only: carma_timestep_init use ghg_data, only: ghg_data_timestep_init - use cam3_aero_data, only: cam3_aero_data_on, cam3_aero_data_timestep_init - use cam3_ozone_data, only: cam3_ozone_data_on, cam3_ozone_data_timestep_init use aoa_tracers, only: aoa_tracers_timestep_init use vertical_diffusion, only: vertical_diffusion_ts_init use radheat, only: radheat_timestep_init @@ -3023,12 +3004,6 @@ subroutine phys_timestep_init(phys_state, cam_in, cam_out, pbuf2d) ! prescribed aerosol deposition fluxes call aerodep_flx_adv(phys_state, pbuf2d, cam_out) - ! CAM3 prescribed aerosol masses - if (cam3_aero_data_on) call cam3_aero_data_timestep_init(pbuf2d, phys_state) - - ! CAM3 prescribed ozone data - if (cam3_ozone_data_on) call cam3_ozone_data_timestep_init(pbuf2d, phys_state) - ! Time interpolate data models of gasses in pbuf2d call ghg_data_timestep_init(pbuf2d, phys_state) diff --git a/src/physics/cam/rk_stratiform.F90 b/src/physics/cam/rk_stratiform.F90 index 84607a20b7..a6bcf39be7 100644 --- a/src/physics/cam/rk_stratiform.F90 +++ b/src/physics/cam/rk_stratiform.F90 @@ -3,7 +3,7 @@ module rk_stratiform !------------------------------------------------------------------------------------------------------- ! ! Provides the CAM interface to the Rasch and Kristjansson (RK) -! prognostic cloud microphysics, and the cam3/4 macrophysics. +! prognostic cloud microphysics, and the cam4 macrophysics. ! !------------------------------------------------------------------------------------------------------- @@ -356,7 +356,7 @@ subroutine rk_stratiform_init() call add_default ('EVAPPREC ', history_budget_histfile_num, ' ') call add_default ('CMELIQ ', history_budget_histfile_num, ' ') - if( cam_physpkg_is('cam3') .or. cam_physpkg_is('cam4') ) then + if( cam_physpkg_is('cam4') ) then call add_default ('ZMDLF ', history_budget_histfile_num, ' ') call add_default ('CME ', history_budget_histfile_num, ' ') @@ -954,20 +954,16 @@ subroutine rk_stratiform_tend( & call physics_ptend_sum( ptend_loc, ptend_all, ncol ) call physics_update( state1, ptend_loc, dtime ) - if (.not. cam_physpkg_is('cam3')) then - - call t_startf("cldfrc") - call cldfrc( lchnk, ncol, pbuf, & - state1%pmid, state1%t, state1%q(:,:,1), state1%omega, state1%phis, & - shfrc, use_shfrc, & - cld, rhcloud, clc, state1%pdel, & - cmfmc, cmfmc_sh, landfrac, snowh, concld, cldst, & - ts, sst, state1%pint(:,pverp), zdu, ocnfrac, rhu00, & - state1%q(:,:,ixcldice), icecldf, liqcldf, & - relhum, 0 ) - call t_stopf("cldfrc") - - endif + call t_startf("cldfrc") + call cldfrc( lchnk, ncol, pbuf, & + state1%pmid, state1%t, state1%q(:,:,1), state1%omega, state1%phis, & + shfrc, use_shfrc, & + cld, rhcloud, clc, state1%pdel, & + cmfmc, cmfmc_sh, landfrac, snowh, concld, cldst, & + ts, sst, state1%pint(:,pverp), zdu, ocnfrac, rhu00, & + state1%q(:,:,ixcldice), icecldf, liqcldf, & + relhum, 0 ) + call t_stopf("cldfrc") call outfld( 'CONCLD ', concld, pcols, lchnk ) call outfld( 'CLDST ', cldst, pcols, lchnk ) diff --git a/src/physics/cam/uwshcu.F90 b/src/physics/cam/uwshcu.F90 index 914d131a94..a5e5a0c6ea 100644 --- a/src/physics/cam/uwshcu.F90 +++ b/src/physics/cam/uwshcu.F90 @@ -3765,7 +3765,7 @@ subroutine compute_uwshcu( mix , mkx , iend , ncnst , dt ! -------------------------------------------------------------------------- ! ! 'rliq' : Verticall-integrated 'suspended cloud condensate' ! ! [m/s] This is so called 'reserved liquid water' in other subroutines ! - ! of CAM3, since the contribution of this term should not be included into ! + ! of CAM, since the contribution of this term should not be included into ! ! the tendency of each layer or surface flux (precip) within this cumulus ! ! scheme. The adding of this term to the layer tendency will be done inthe ! ! 'stratiform_tend', just after performing sediment process there. ! @@ -3928,9 +3928,9 @@ subroutine compute_uwshcu( mix , mkx , iend , ncnst , dt ! --------------------------------------------------------------------------- ! ! Until now, all the calculations are done completely in this shallow cumulus ! - ! scheme. If you want to use this cumulus scheme other than CAM3, then do not ! + ! scheme. If you want to use this cumulus scheme other than CAM, then do not ! ! perform below block. However, for compatible use with the other subroutines ! - ! in CAM3, I should subtract the effect of 'qc(k)' ('rliq') from the tendency ! + ! in CAM, I should subtract the effect of 'qc(k)' ('rliq') from the tendency ! ! equation in each layer, since this effect will be separately added later in ! ! in 'stratiform_tend' just after performing sediment process there. In order ! ! to be consistent with 'stratiform_tend', just subtract qc(k) from tendency ! diff --git a/src/physics/cam/vertical_diffusion.F90 b/src/physics/cam/vertical_diffusion.F90 index 507e99dc8d..472b2a5501 100644 --- a/src/physics/cam/vertical_diffusion.F90 +++ b/src/physics/cam/vertical_diffusion.F90 @@ -105,7 +105,6 @@ module vertical_diffusion type(vdiff_selector) :: fieldlist_molec ! Logical switches for molecular diffusion integer :: tke_idx, kvh_idx, kvm_idx ! TKE and eddy diffusivity indices for fields in the physics buffer integer :: kvt_idx ! Index for kinematic molecular conductivity -integer :: turbtype_idx, smaw_idx ! Turbulence type and instability functions integer :: tauresx_idx, tauresy_idx ! Redisual stress for implicit surface stress character(len=fieldname_len) :: vdiffnam(pcnst) ! Names of vertical diffusion tendencies @@ -228,8 +227,6 @@ subroutine vd_register() call pbuf_add_field('kvm', 'global', dtype_r8, (/pcols, pverp/), kvm_idx ) call pbuf_add_field('pblh', 'global', dtype_r8, (/pcols/), pblh_idx) call pbuf_add_field('tke', 'global', dtype_r8, (/pcols, pverp/), tke_idx) - call pbuf_add_field('turbtype', 'global', dtype_i4, (/pcols, pverp/), turbtype_idx) - call pbuf_add_field('smaw', 'global', dtype_r8, (/pcols, pverp/), smaw_idx) call pbuf_add_field('tauresx', 'global', dtype_r8, (/pcols/), tauresx_idx) call pbuf_add_field('tauresy', 'global', dtype_r8, (/pcols/), tauresy_idx) @@ -665,8 +662,6 @@ subroutine vertical_diffusion_init(pbuf2d) ! Initialization of some pbuf fields if (is_first_step()) then ! Initialization of pbuf fields tke, kvh, kvm are done in phys_inidat - call pbuf_set_field(pbuf2d, turbtype_idx, 0 ) - call pbuf_set_field(pbuf2d, smaw_idx, 0.0_r8) call pbuf_set_field(pbuf2d, tauresx_idx, 0.0_r8) call pbuf_set_field(pbuf2d, tauresy_idx, 0.0_r8) if (trim(shallow_scheme) == 'UNICON') then @@ -773,9 +768,6 @@ subroutine vertical_diffusion_tend( & real(r8) :: dtk(pcols,pver) ! T tendency from KE dissipation real(r8), pointer :: tke(:,:) ! Turbulent kinetic energy [ m2/s2 ] - integer(i4),pointer :: turbtype(:,:) ! Turbulent interface types [ no unit ] - real(r8), pointer :: smaw(:,:) ! Normalized Galperin instability function - ! ( 0<= <=4.964 and 1 at neutral ) real(r8), pointer :: qtl_flx(:,:) ! overbar(w'qtl') where qtl = qv + ql real(r8), pointer :: qti_flx(:,:) ! overbar(w'qti') where qti = qv + qi @@ -922,7 +914,6 @@ subroutine vertical_diffusion_tend( & call pbuf_get_field(pbuf, tpert_idx, tpert) call pbuf_get_field(pbuf, qpert_idx, qpert) call pbuf_get_field(pbuf, pblh_idx, pblh) - call pbuf_get_field(pbuf, turbtype_idx, turbtype) ! Interpolate temperature to interfaces. do k = 2, pver @@ -1015,7 +1006,6 @@ subroutine vertical_diffusion_tend( & !----------------------------------------------------------------------- ! call pbuf_get_field(pbuf, kvm_idx, kvm_in) call pbuf_get_field(pbuf, kvh_idx, kvh_in) - call pbuf_get_field(pbuf, smaw_idx, smaw) call pbuf_get_field(pbuf, tke_idx, tke) ! Get potential temperature. @@ -1028,7 +1018,7 @@ subroutine vertical_diffusion_tend( & ztodt, p, tint, rhoi, cldn, wstarent, & kvm_in, kvh_in, ksrftms, dragblj, tauresx, tauresy, & rrho, ustar, pblh, kvm, kvh, kvq, cgh, cgs, tpert, qpert, & - tke, sprod, sfi, turbtype, smaw) + tke, sprod, sfi) ! The diag_TKE scheme does not calculate the Monin-Obukhov length, which is used in dry deposition calculations. ! Use the routines from pbl_utils to accomplish this. Assumes ustar and rrho have been set. diff --git a/src/physics/cam/zm_conv_intr.F90 b/src/physics/cam/zm_conv_intr.F90 index 62cd8bfca3..4113c33a4b 100644 --- a/src/physics/cam/zm_conv_intr.F90 +++ b/src/physics/cam/zm_conv_intr.F90 @@ -52,9 +52,7 @@ module zm_conv_intr zm_ideep_idx, & dp_flxprc_idx, & dp_flxsnw_idx, & - dp_cldliq_idx, & ixorg, & - dp_cldice_idx, & dlfzm_idx, & ! detrained convective cloud water mixing ratio. difzm_idx, & ! detrained convective cloud ice mixing ratio. dnlfzm_idx, & ! detrained convective cloud water num concen. @@ -135,12 +133,6 @@ subroutine zm_conv_register ! Flux of snow from deep convection (kg/m2/s) call pbuf_add_field('DP_FLXSNW','global',dtype_r8,(/pcols,pverp/),dp_flxsnw_idx) -! deep gbm cloud liquid water (kg/kg) - call pbuf_add_field('DP_CLDLIQ','global',dtype_r8,(/pcols,pver/), dp_cldliq_idx) - -! deep gbm cloud liquid water (kg/kg) - call pbuf_add_field('DP_CLDICE','global',dtype_r8,(/pcols,pver/), dp_cldice_idx) - call pbuf_add_field('ICWMRDP', 'physpkg',dtype_r8,(/pcols,pver/),icwmrdp_idx) call pbuf_add_field('RPRDDP', 'physpkg',dtype_r8,(/pcols,pver/),rprddp_idx) call pbuf_add_field('NEVAPR_DPCU','physpkg',dtype_r8,(/pcols,pver/),nevapr_dpcu_idx) @@ -459,8 +451,6 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & real(r8), pointer, dimension(:,:) :: evapcdp ! Evaporation of deep convective precipitation real(r8), pointer, dimension(:,:) :: flxprec ! Convective-scale flux of precip at interfaces (kg/m2/s) real(r8), pointer, dimension(:,:) :: flxsnow ! Convective-scale flux of snow at interfaces (kg/m2/s) - real(r8), pointer, dimension(:,:) :: dp_cldliq - real(r8), pointer, dimension(:,:) :: dp_cldice real(r8), pointer :: dlf(:,:) ! detrained convective cloud water mixing ratio. real(r8), pointer :: dif(:,:) ! detrained convective cloud ice mixing ratio. real(r8), pointer :: dnlf(:,:) ! detrained convective cloud water num concen. @@ -709,10 +699,6 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & call pbuf_get_field(pbuf, dp_flxprc_idx, flxprec ) call pbuf_get_field(pbuf, dp_flxsnw_idx, flxsnow ) - call pbuf_get_field(pbuf, dp_cldliq_idx, dp_cldliq ) - call pbuf_get_field(pbuf, dp_cldice_idx, dp_cldice ) - dp_cldliq(:ncol,:) = 0._r8 - dp_cldice(:ncol,:) = 0._r8 !REMOVECAM - no longer need these when CAM is retired and pcols no longer exists flxprec(:,:) = 0._r8 flxsnow(:,:) = 0._r8 @@ -766,23 +752,21 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & call physics_update(state1, ptend_loc, ztodt) - ! Momentum Transport (non-cam3 physics) + ! Momentum Transport - if ( .not. cam_physpkg_is('cam3')) then + call physics_ptend_init(ptend_loc, state1%psetcols, 'zm_conv_momtran_run', ls=.true., lu=.true., lv=.true.) - call physics_ptend_init(ptend_loc, state1%psetcols, 'zm_conv_momtran_run', ls=.true., lu=.true., lv=.true.) - - l_windt(1) = .true. - l_windt(2) = .true. + l_windt(1) = .true. + l_windt(2) = .true. !REMOVECAM - no longer need these when CAM is retired and pcols no longer exists - ptend_loc%s(:,:) = 0._r8 - ptend_loc%u(:,:) = 0._r8 - ptend_loc%v(:,:) = 0._r8 + ptend_loc%s(:,:) = 0._r8 + ptend_loc%u(:,:) = 0._r8 + ptend_loc%v(:,:) = 0._r8 !REMOVECAM_END - call t_startf ('zm_conv_momtran_run') + call t_startf ('zm_conv_momtran_run') - call zm_conv_momtran_run (ncol, pver, pverp, & + call zm_conv_momtran_run (ncol, pver, pverp, & l_windt,state1%u(:ncol,:), state1%v(:ncol,:), 2, mu(:ncol,:), md(:ncol,:), & zmconv_momcu, zmconv_momcd, & du(:ncol,:), eu(:ncol,:), ed(:ncol,:), dp(:ncol,:), dsubcld(:ncol), & @@ -790,47 +774,45 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , & nstep, ptend_loc%u(:ncol,:), ptend_loc%v(:ncol,:),& pguallu(:ncol,:), pguallv(:ncol,:), pgdallu(:ncol,:), pgdallv(:ncol,:), & icwuu(:ncol,:), icwuv(:ncol,:), icwdu(:ncol,:), icwdv(:ncol,:), ztodt, seten(:ncol,:) ) - call t_stopf ('zm_conv_momtran_run') - - ptend_loc%s(:ncol,:pver) = seten(:ncol,:pver) - - call physics_ptend_sum(ptend_loc,ptend_all, ncol) - - ! Output ptend variables before they are set to zero with physics_update - call outfld('ZMMTU', ptend_loc%u, pcols, lchnk) - call outfld('ZMMTV', ptend_loc%v, pcols, lchnk) - - ! update physics state type state1 with ptend_loc - call physics_update(state1, ptend_loc, ztodt) - - ftem(:ncol,:pver) = seten(:ncol,:pver)/cpair - if (zmconv_org) then - call outfld('ZM_ORG', state%q(:,:,ixorg), pcols, lchnk) - call outfld('ZM_ORG2D', zm_org2d, pcols, lchnk) - endif - call outfld('ZMMTT', ftem , pcols, lchnk) + call t_stopf ('zm_conv_momtran_run') - ! Output apparent force from pressure gradient - call outfld('ZMUPGU', pguallu, pcols, lchnk) - call outfld('ZMUPGD', pgdallu, pcols, lchnk) - call outfld('ZMVPGU', pguallv, pcols, lchnk) - call outfld('ZMVPGD', pgdallv, pcols, lchnk) + ptend_loc%s(:ncol,:pver) = seten(:ncol,:pver) - ! Output in-cloud winds - call outfld('ZMICUU', icwuu, pcols, lchnk) - call outfld('ZMICUD', icwdu, pcols, lchnk) - call outfld('ZMICVU', icwuv, pcols, lchnk) - call outfld('ZMICVD', icwdv, pcols, lchnk) + call physics_ptend_sum(ptend_loc,ptend_all, ncol) - end if + ! Output ptend variables before they are set to zero with physics_update + call outfld('ZMMTU', ptend_loc%u, pcols, lchnk) + call outfld('ZMMTV', ptend_loc%v, pcols, lchnk) - ! Transport cloud water and ice only - call cnst_get_ind('CLDLIQ', ixcldliq) - call cnst_get_ind('CLDICE', ixcldice) + ! update physics state type state1 with ptend_loc + call physics_update(state1, ptend_loc, ztodt) - lq(:) = .FALSE. - lq(2:) = cnst_is_convtran1(2:) - call physics_ptend_init(ptend_loc, state1%psetcols, 'convtran1', lq=lq) + ftem(:ncol,:pver) = seten(:ncol,:pver)/cpair + if (zmconv_org) then + call outfld('ZM_ORG', state%q(:,:,ixorg), pcols, lchnk) + call outfld('ZM_ORG2D', zm_org2d, pcols, lchnk) + endif + call outfld('ZMMTT', ftem , pcols, lchnk) + + ! Output apparent force from pressure gradient + call outfld('ZMUPGU', pguallu, pcols, lchnk) + call outfld('ZMUPGD', pgdallu, pcols, lchnk) + call outfld('ZMVPGU', pguallv, pcols, lchnk) + call outfld('ZMVPGD', pgdallv, pcols, lchnk) + + ! Output in-cloud winds + call outfld('ZMICUU', icwuu, pcols, lchnk) + call outfld('ZMICUD', icwdu, pcols, lchnk) + call outfld('ZMICVU', icwuv, pcols, lchnk) + call outfld('ZMICVD', icwdv, pcols, lchnk) + + ! Transport cloud water and ice only + call cnst_get_ind('CLDLIQ', ixcldliq) + call cnst_get_ind('CLDICE', ixcldice) + + lq(:) = .FALSE. + lq(2:) = cnst_is_convtran1(2:) + call physics_ptend_init(ptend_loc, state1%psetcols, 'convtran1', lq=lq) ! dpdry is not used in this call to convtran since the cloud liquid and ice mixing diff --git a/src/physics/cam7/physpkg.F90 b/src/physics/cam7/physpkg.F90 index 2e0a273a28..811bafcf70 100644 --- a/src/physics/cam7/physpkg.F90 +++ b/src/physics/cam7/physpkg.F90 @@ -94,6 +94,8 @@ module physpkg integer :: dqcore_idx = 0 ! dqcore index in physics buffer integer :: cmfmczm_idx = 0 ! Zhang-McFarlane convective mass fluxes integer :: rliqbc_idx = 0 ! tphysbc reserve liquid + integer :: psl_idx = 0 + !======================================================================= contains !======================================================================= @@ -1037,6 +1039,8 @@ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_in, cam_out ) dtcore_idx = pbuf_get_index('DTCORE') dqcore_idx = pbuf_get_index('DQCORE') + psl_idx = pbuf_get_index('PSL') + end subroutine phys_init ! @@ -1398,7 +1402,8 @@ subroutine tphysac (ztodt, cam_in, & use radiation, only: radiation_tend use tropopause, only: tropopause_output use cam_diagnostics, only: diag_phys_writeout, diag_conv, diag_clip_tend_writeout - use aero_model, only: aero_model_wetdep, wetdep_lq + use aero_model, only: aero_model_wetdep + use aero_wetdep_cam, only: wetdep_lq use physics_buffer, only: col_type_subcol use check_energy, only: check_energy_timestep_init use carma_intr, only: carma_wetdep_tend, carma_timestep_tend, carma_emission_tend @@ -2073,7 +2078,7 @@ subroutine tphysac (ztodt, cam_in, & call cam_snapshot_all_outfld_tphysac(cam_snapshot_before_num, state, tend, cam_in, cam_out, pbuf,& fh2o, surfric, obklen, flx_heat, cmfmc, dlf, det_s, det_ice, net_flx) end if - call aoa_tracers_timestep_tend(state, ptend, cam_in%cflx, cam_in%landfrac, ztodt) + call aoa_tracers_timestep_tend(state, ptend, ztodt) if ( (trim(cam_take_snapshot_after) == "aoa_tracers_timestep_tend") .and. & (trim(cam_take_snapshot_before) == trim(cam_take_snapshot_after))) then call cam_snapshot_ptend_outfld(ptend, lchnk) @@ -2525,7 +2530,9 @@ subroutine tphysbc (ztodt, state, & use physics_types, only: physics_update, & physics_state_check, & dyn_te_idx - use cam_diagnostics, only: diag_conv_tend_ini, diag_conv, diag_export, diag_state_b4_phys_write + use physconst, only: rair, gravit + use cam_diagnostics, only: diag_conv_tend_ini, diag_export, diag_state_b4_phys_write + use cam_diagnostic_utils, only: cpslec use cam_history, only: outfld use constituents, only: qmin use air_composition, only: thermodynamic_active_species_liq_num,thermodynamic_active_species_liq_idx @@ -2634,6 +2641,8 @@ subroutine tphysbc (ztodt, state, & type(check_tracers_data):: tracerint ! energy integrals and cummulative boundary fluxes real(r8) :: zero_tracers(pcols,pcnst) + real(r8), pointer :: psl(:) ! Sea Level Pressure + logical :: lq(pcnst) !----------------------------------------------------------------------- @@ -2911,6 +2920,8 @@ subroutine tphysbc (ztodt, state, & ! Save atmospheric fields to force surface models call t_startf('cam_export') + call pbuf_get_field(pbuf, psl_idx, psl) + call cpslec(ncol, state%pmid, state%phis, state%ps, state%t, psl, gravit, rair) call cam_export (state,cam_out,pbuf) call t_stopf('cam_export') diff --git a/src/physics/camrt/radconstants.F90 b/src/physics/camrt/radconstants.F90 index c95c8d2154..f9faf308f1 100644 --- a/src/physics/camrt/radconstants.F90 +++ b/src/physics/camrt/radconstants.F90 @@ -1,7 +1,7 @@ module radconstants ! This module contains constants that are specific to the radiative transfer -! code used in the CAM3 model. +! code used in the CAM4 model. use shr_kind_mod, only: r8 => shr_kind_r8 use cam_abortutils, only: endrun diff --git a/src/physics/camrt/radlw.F90 b/src/physics/camrt/radlw.F90 index 62ec514ffc..befd69fbc9 100644 --- a/src/physics/camrt/radlw.F90 +++ b/src/physics/camrt/radlw.F90 @@ -435,11 +435,7 @@ subroutine radclwmx(lchnk ,ncol ,doabsems , & ntopcld = max(ntopcld, trop_cloud_top_lev) cldp(:ncol,1:ntopcld) = 0.0_r8 - if ( cam_physpkg_is('cam3')) then - cldp(:ncol,ntoplw:pver) = cld(:ncol,ntoplw:pver) - else - cldp(:ncol,ntopcld+1:pver) = cld(:ncol,ntopcld+1:pver) - end if + cldp(:ncol,ntopcld+1:pver) = cld(:ncol,ntopcld+1:pver) cldp(:ncol,pverp) = 0.0_r8 ! ! diff --git a/src/physics/carma/cam/carma_intr.F90 b/src/physics/carma/cam/carma_intr.F90 index 03d7ca5fab..e726c296c9 100644 --- a/src/physics/carma/cam/carma_intr.F90 +++ b/src/physics/carma/cam/carma_intr.F90 @@ -1941,7 +1941,8 @@ subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) integer :: ixcldliq integer :: ixcldice real(r8) :: totcond(pcols, pver) ! total condensate - real(r8) :: solfac ! solubility factor + real(r8) :: solfac(pcols, pver) ! solubility factor + real(r8) :: solfactor real(r8) :: scavcoef ! scavenging Coefficient logical :: do_wetdep integer :: ncol ! number of columns @@ -2029,7 +2030,9 @@ subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) if (rc < 0) call endrun('carma_wetdep_tend::CARMAELEMENT_Get failed.') call CARMAGROUP_Get(carma, igroup, rc, cnsttype=cnsttype, do_wetdep=do_wetdep, & - solfac=solfac, scavcoef=scavcoef, maxbin=maxbin) + solfac=solfactor, scavcoef=scavcoef, maxbin=maxbin) + solfac(:ncol,:) = solfactor + if (rc < 0) call endrun('carma_wetdep_tend::CARMAGROUP_Get failed.') if ((do_wetdep) .and. (cnsttype == I_CNSTTYPE_PROGNOSTIC)) then @@ -2096,7 +2099,7 @@ subroutine carma_wetdep_tend(state, ptend, dt, pbuf, dlf, cam_out) iscavt, & cldv, & fracis(:, :, icnst), & - solfac, & + solfactor, & ncol, & z_scavcoef) else diff --git a/src/physics/rrtmg/aer_src/rrtmg_sw_init.f90 b/src/physics/rrtmg/aer_src/rrtmg_sw_init.f90 index d71fa2a897..fc2ec91a53 100644 --- a/src/physics/rrtmg/aer_src/rrtmg_sw_init.f90 +++ b/src/physics/rrtmg/aer_src/rrtmg_sw_init.f90 @@ -182,10 +182,6 @@ subroutine swdatinit ! = (9.8066)(86400)(1e-5)/(1.004) ! heatfac = 8.4391_r8 -! Modified values for consistency with CAM3: -! = (9.80616)(86400)(1e-5)/(1.00464) -! heatfac = 8.43339130434_r8 - ! Calculate heatfac directly from CAM constants: heatfac = grav * cday * 1.e-5_r8 / (cpair * 1.e-3_r8) diff --git a/src/physics/cam/cpslec.F90 b/src/utils/cam_diagnostic_utils.F90 similarity index 55% rename from src/physics/cam/cpslec.F90 rename to src/utils/cam_diagnostic_utils.F90 index cb29dc29e7..7a6921904a 100644 --- a/src/physics/cam/cpslec.F90 +++ b/src/utils/cam_diagnostic_utils.F90 @@ -1,31 +1,34 @@ +module cam_diagnostic_utils -subroutine cpslec (ncol, pmid, phis, ps, t, psl, gravit, rair) +! Collection of routines used for diagnostic calculations. + +use shr_kind_mod, only: r8 => shr_kind_r8 +use ppgrid, only: pcols, pver + + +implicit none +private +save + +public :: & + cpslec ! compute sea level pressure + +!=============================================================================== +contains +!=============================================================================== + +subroutine cpslec(ncol, pmid, phis, ps, t, psl, gravit, rair) !----------------------------------------------------------------------- ! -! Purpose: -! Hybrid coord version: Compute sea level pressure for a latitude line +! Compute sea level pressure. ! -! Method: -! CCM2 hybrid coord version using ECMWF formulation -! Algorithm: See section 3.1.b in NCAR NT-396 "Vertical +! Uses ECMWF formulation Algorithm: See section 3.1.b in NCAR NT-396 "Vertical ! Interpolation and Truncation of Model-Coordinate Data ! -! Author: Stolen from the Processor by Erik Kluzek -! -!----------------------------------------------------------------------- -! -! $Id$ -! $Author$ -! !----------------------------------------------------------------------- - use shr_kind_mod, only: r8 => shr_kind_r8 - use ppgrid, only: pcols, pver - - implicit none - -!-----------------------------Arguments--------------------------------- + !-----------------------------Arguments--------------------------------- integer , intent(in) :: ncol ! longitude dimension real(r8), intent(in) :: pmid(pcols,pver) ! Atmospheric pressure (pascals) @@ -36,21 +39,19 @@ subroutine cpslec (ncol, pmid, phis, ps, t, psl, gravit, rair) real(r8), intent(in) :: rair ! gas constant for dry air real(r8), intent(out):: psl(pcols) ! Sea level pressures (pascals) -!----------------------------------------------------------------------- -!-----------------------------Parameters-------------------------------- + !-----------------------------Parameters-------------------------------- real(r8), parameter :: xlapse = 6.5e-3_r8 ! Temperature lapse rate (K/m) -!----------------------------------------------------------------------- -!-----------------------------Local Variables--------------------------- - integer i ! Loop index - real(r8) alpha ! Temperature lapse rate in terms of pressure ratio (unitless) - real(r8) Tstar ! Computed surface temperature - real(r8) TT0 ! Computed temperature at sea-level - real(r8) alph ! Power to raise P/Ps to get rate of increase of T with pressure - real(r8) beta ! alpha*phis/(R*T) term used in approximation of PSL -!----------------------------------------------------------------------- -! + !-----------------------------Local Variables--------------------------- + integer :: i ! Loop index + real(r8) :: alpha ! Temperature lapse rate in terms of pressure ratio (unitless) + real(r8) :: Tstar ! Computed surface temperature + real(r8) :: TT0 ! Computed temperature at sea-level + real(r8) :: alph ! Power to raise P/Ps to get rate of increase of T with pressure + real(r8) :: beta ! alpha*phis/(R*T) term used in approximation of PSL + !----------------------------------------------------------------------- + alpha = rair*xlapse/gravit do i=1,ncol if ( abs(phis(i)/gravit) < 1.e-4_r8 )then @@ -77,5 +78,8 @@ subroutine cpslec (ncol, pmid, phis, ps, t, psl, gravit, rair) end if enddo - return end subroutine cpslec + +!=============================================================================== + +end module cam_diagnostic_utils