From 01c11536f0969d63cd66209385f670a1bbeab5e7 Mon Sep 17 00:00:00 2001 From: jv388 Date: Wed, 14 Mar 2018 20:28:48 +0000 Subject: [PATCH 001/181] FAN_n05_clm4_5_18_r272 created the n05 tag --- bld/CLMBuildNamelist.pm | 172 ++ .../namelist_defaults_clm4_5.xml | 86 + .../namelist_defaults_usr_files.xml | 1 + .../namelist_definition_clm4_5.xml | 77 + bld/namelist_files/use_cases/2000_control.xml | 12 + .../use_cases/20thC_transient.xml | 16 + src/biogeochem/CNDriverMod.F90 | 31 +- src/biogeochem/CNNDynamicsMod.F90 | 1539 ++++++++++++++++- src/biogeochem/CNPhenologyMod.F90 | 36 +- src/biogeochem/CNVegCarbonStateType.F90 | 54 +- src/biogeochem/CNVegNitrogenFluxType.F90 | 28 +- src/biogeochem/CNVegNitrogenStateType.F90 | 25 +- src/biogeochem/CNVegetationFacade.F90 | 18 +- src/biogeochem/FanMod.F90 | 1293 ++++++++++++++ src/biogeophys/HydrologyNoDrainageMod.F90 | 34 +- src/biogeophys/TemperatureType.F90 | 91 +- src/biogeophys/WaterStateType.F90 | 21 +- src/biogeophys/WaterfluxType.F90 | 14 + src/main/atm2lndType.F90 | 19 +- src/main/clm_driver.F90 | 20 +- src/main/clm_initializeMod.F90 | 22 +- src/main/clm_varctl.F90 | 8 + src/main/controlMod.F90 | 11 + src/main/ndep2StreamMod.F90 | 285 +++ src/main/ndep3StreamMod.F90 | 285 +++ .../SoilBiogeochemCarbonFluxType.F90 | 50 +- .../SoilBiogeochemCompetitionMod.F90 | 24 +- .../SoilBiogeochemNitrogenFluxType.F90 | 449 ++++- .../SoilBiogeochemNitrogenStateType.F90 | 783 ++++++++- 29 files changed, 5452 insertions(+), 52 deletions(-) create mode 100755 src/biogeochem/FanMod.F90 create mode 100644 src/main/ndep2StreamMod.F90 create mode 100644 src/main/ndep3StreamMod.F90 diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 4c0d7df810..c52461e5a5 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -20,6 +20,7 @@ # 2012-07-01 Kluzek Add some common CESM namelist options # 2013-12 Andre Refactor everything into subroutines # 2013-12 Muszala Add Ecosystem Demography functionality +# 2016-09-20 Oleson Add ndep2 and ndep3 streams capability #-------------------------------------------------------------------------------------------- package CLMBuildNamelist; @@ -1563,6 +1564,9 @@ sub process_namelist_inline_logic { setup_logic_supplemental_nitrogen($opts, $nl_flags, $definition, $defaults, $nl, $physv); setup_logic_snowpack($opts, $nl_flags, $definition, $defaults, $nl, $physv); setup_logic_fates($opts, $nl_flags, $definition, $defaults, $nl, $physv); +#!KO + setup_logic_fan($opts, $nl_flags, $definition, $defaults, $nl, $physv); +#!KO ######################################### # namelist group: atm2lnd_inparm @@ -1610,6 +1614,18 @@ sub process_namelist_inline_logic { ############################### setup_logic_nitrogen_deposition($opts, $nl_flags, $definition, $defaults, $nl, $physv); +#!KO + ################################ + # namelist group: ndep2dyn_nml # + ################################ + setup_logic_nitrogen_deposition2($opts, $nl_flags, $definition, $defaults, $nl, $physv); + + ################################ + # namelist group: ndep3dyn_nml # + ################################ + setup_logic_nitrogen_deposition3($opts, $nl_flags, $definition, $defaults, $nl, $physv); +#!KO + ################################## # namelist group: cnmresp_inparm # ################################## @@ -3015,6 +3031,26 @@ sub setup_logic_fertilizer { #------------------------------------------------------------------------------- +#!KO +sub setup_logic_fan { + # + # Flags to control FAN (Flow of Agricultural Nitrogen) nitrogen deposition (manure and fertilizer) + # + my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + if ( $physv->as_long() >= $physv->as_long("clm4_5") ) { + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_fan', + 'use_cn'=>$nl_flags->{'use_cn'}, 'use_ed'=>$nl_flags->{'use_ed'} ); + $nl_flags->{'use_fan'} = $nl->get_value('use_fan'); + if ( value_is_true( $nl_flags->{'use_ed'} ) && value_is_true( $nl_flags->{'use_fan'} ) ) { + fatal_error("Cannot turn use_fan on when use_ed is on\n" ); + } + } +} + +#------------------------------------------------------------------------------- +#!KO + sub setup_logic_grainproduct { # # Flags to control 1-year grain product pool @@ -3182,6 +3218,136 @@ sub setup_logic_nitrogen_deposition { #------------------------------------------------------------------------------- +#!KO +sub setup_logic_nitrogen_deposition2 { + my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + # + # Nitrogen deposition2 for bgc=CN + # + + if ( $physv->as_long() >= $physv->as_long("clm4_5") && $nl_flags->{'bgc_mode'} ne "none" && value_is_true( $nl_flags->{'use_fan'} ) ) { + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'ndep2mapalgo', 'phys'=>$nl_flags->{'phys'}, + 'bgc'=>$nl_flags->{'bgc_mode'}, 'hgrid'=>$nl_flags->{'res'}, + 'clm_accelerated_spinup'=>$nl_flags->{'clm_accelerated_spinup'} ); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_first_ndep2', 'phys'=>$nl_flags->{'phys'}, + 'bgc'=>$nl_flags->{'bgc_mode'}, 'sim_year'=>$nl_flags->{'sim_year'}, + 'sim_year_range'=>$nl_flags->{'sim_year_range'}); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_last_ndep2', 'phys'=>$nl_flags->{'phys'}, + 'bgc'=>$nl_flags->{'bgc_mode'}, 'sim_year'=>$nl_flags->{'sim_year'}, + 'sim_year_range'=>$nl_flags->{'sim_year_range'}); + + # Set align year, if first and last years are different + if ( $nl->get_value('stream_year_first_ndep2') != $nl->get_value('stream_year_last_ndep2') ) { + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'model_year_align_ndep2', 'sim_year'=>$nl_flags->{'sim_year'}, + 'sim_year_range'=>$nl_flags->{'sim_year_range'}); + } + + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_fldfilename_ndep2', 'phys'=>$nl_flags->{'phys'}, + 'bgc'=>$nl_flags->{'bgc_mode'}, + 'hgrid'=>"360x720cru" ); + + } elsif ( $physv->as_long() >= $physv->as_long("clm4_5") && $nl_flags->{'bgc_mode'} =~/cn|bgc/ && value_is_true( $nl_flags->{'use_fan'} ) ) { + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'ndep2mapalgo', 'phys'=>$nl_flags->{'phys'}, + 'use_cn'=>$nl_flags->{'use_cn'}, 'hgrid'=>$nl_flags->{'res'}, + 'clm_accelerated_spinup'=>$nl_flags->{'clm_accelerated_spinup'} ); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_first_ndep2', 'phys'=>$nl_flags->{'phys'}, + 'use_cn'=>$nl_flags->{'use_cn'}, 'sim_year'=>$nl_flags->{'sim_year'}, + 'sim_year_range'=>$nl_flags->{'sim_year_range'}); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_last_ndep2', 'phys'=>$nl_flags->{'phys'}, + 'use_cn'=>$nl_flags->{'use_cn'}, 'sim_year'=>$nl_flags->{'sim_year'}, + 'sim_year_range'=>$nl_flags->{'sim_year_range'}); + # Set align year, if first and last years are different + if ( $nl->get_value('stream_year_first_ndep2') != $nl->get_value('stream_year_last_ndep2') ) { + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'model_year_align_ndep2', 'sim_year'=>$nl_flags->{'sim_year'}, + 'sim_year_range'=>$nl_flags->{'sim_year_range'}); + } + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_fldfilename_ndep2', 'phys'=>$nl_flags->{'phys'}, + 'use_cn'=>$nl_flags->{'use_cn'}, + 'hgrid'=>"360x720cru" ); + } else { + # If bgc is NOT CN/CNDV then make sure none of the ndep2 settings are set! + if ( value_is_true( $nl_flags->{'use_fan'} ) ) { + if ( defined($nl->get_value('stream_year_first_ndep2')) || + defined($nl->get_value('stream_year_last_ndep2')) || + defined($nl->get_value('model_year_align_ndep2')) || + defined($nl->get_value('stream_fldfilename_ndep2')) + ) { + fatal_error("When bgc is NOT CN or CNDV none of: stream_year_first_ndep2," . + "stream_year_last_ndep2, model_year_align_ndep2, nor stream_fldfilename_ndep2" . + " can be set!\n"); + } + } + } +} + +#------------------------------------------------------------------------------- + +sub setup_logic_nitrogen_deposition3 { + my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + # + # Nitrogen deposition3 for bgc=CN + # + + if ( $physv->as_long() >= $physv->as_long("clm4_5") && $nl_flags->{'bgc_mode'} ne "none" && value_is_true( $nl_flags->{'use_fan'} ) ) { + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'ndep3mapalgo', 'phys'=>$nl_flags->{'phys'}, + 'bgc'=>$nl_flags->{'bgc_mode'}, 'hgrid'=>$nl_flags->{'res'}, + 'clm_accelerated_spinup'=>$nl_flags->{'clm_accelerated_spinup'} ); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_first_ndep3', 'phys'=>$nl_flags->{'phys'}, + 'bgc'=>$nl_flags->{'bgc_mode'}, 'sim_year'=>$nl_flags->{'sim_year'}, + 'sim_year_range'=>$nl_flags->{'sim_year_range'}); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_last_ndep3', 'phys'=>$nl_flags->{'phys'}, + 'bgc'=>$nl_flags->{'bgc_mode'}, 'sim_year'=>$nl_flags->{'sim_year'}, + 'sim_year_range'=>$nl_flags->{'sim_year_range'}); + + # Set align year, if first and last years are different + if ( $nl->get_value('stream_year_first_ndep3') != $nl->get_value('stream_year_last_ndep3') ) { + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'model_year_align_ndep3', 'sim_year'=>$nl_flags->{'sim_year'}, + 'sim_year_range'=>$nl_flags->{'sim_year_range'}); + } + + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_fldfilename_ndep3', 'phys'=>$nl_flags->{'phys'}, + 'bgc'=>$nl_flags->{'bgc_mode'}, + 'hgrid'=>"360x720cru" ); + + } elsif ( $physv->as_long() >= $physv->as_long("clm4_5") && $nl_flags->{'bgc_mode'} =~/cn|bgc/ && value_is_true( $nl_flags->{'use_fan'} ) ) { + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'ndep3mapalgo', 'phys'=>$nl_flags->{'phys'}, + 'use_cn'=>$nl_flags->{'use_cn'}, 'hgrid'=>$nl_flags->{'res'}, + 'clm_accelerated_spinup'=>$nl_flags->{'clm_accelerated_spinup'} ); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_first_ndep3', 'phys'=>$nl_flags->{'phys'}, + 'use_cn'=>$nl_flags->{'use_cn'}, 'sim_year'=>$nl_flags->{'sim_year'}, + 'sim_year_range'=>$nl_flags->{'sim_year_range'}); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_last_ndep3', 'phys'=>$nl_flags->{'phys'}, + 'use_cn'=>$nl_flags->{'use_cn'}, 'sim_year'=>$nl_flags->{'sim_year'}, + 'sim_year_range'=>$nl_flags->{'sim_year_range'}); + # Set align year, if first and last years are different + if ( $nl->get_value('stream_year_first_ndep3') != $nl->get_value('stream_year_last_ndep3') ) { + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'model_year_align_ndep3', 'sim_year'=>$nl_flags->{'sim_year'}, + 'sim_year_range'=>$nl_flags->{'sim_year_range'}); + } + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_fldfilename_ndep3', 'phys'=>$nl_flags->{'phys'}, + 'use_cn'=>$nl_flags->{'use_cn'}, + 'hgrid'=>"360x720cru" ); + } else { + # If bgc is NOT CN/CNDV then make sure none of the ndep3 settings are set! + if ( value_is_true( $nl_flags->{'use_fan'} ) ) { + if ( defined($nl->get_value('stream_year_first_ndep3')) || + defined($nl->get_value('stream_year_last_ndep3')) || + defined($nl->get_value('model_year_align_ndep3')) || + defined($nl->get_value('stream_fldfilename_ndep3')) + ) { + fatal_error("When bgc is NOT CN or CNDV none of: stream_year_first_ndep3," . + "stream_year_last_ndep3, model_year_align_ndep3, nor stream_fldfilename_ndep3" . + " can be set!\n"); + } + } + } +} +#!KO + +#------------------------------------------------------------------------------- + sub setup_logic_cnmresp { my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_; @@ -3758,6 +3924,12 @@ sub write_output_files { push @groups, "ch4finundated"; push @groups, "clm_canopy_inparm"; } +#!KO + if ( $physv->as_long() >= $physv->as_long("clm4_5") ) { + push @groups, "ndep2dyn_nml"; + push @groups, "ndep3dyn_nml"; + } +#!KO } my $outfile; diff --git a/bld/namelist_files/namelist_defaults_clm4_5.xml b/bld/namelist_files/namelist_defaults_clm4_5.xml index d9a498adb4..37a1deb871 100644 --- a/bld/namelist_files/namelist_defaults_clm4_5.xml +++ b/bld/namelist_files/namelist_defaults_clm4_5.xml @@ -439,6 +439,14 @@ attributes from the config_cache.xml file (with keys converted to upper-case). .false. .false. .true. + + +.true. +.false. +.true. +.false. +.false. + + +2000 +2000 + +2000 +2000 + +2000 +2000 + +2000 +2000 + +2000 +2000 + +2000 +2000 + +2000 +2000 + +2000 +2000 + +/glade/p/cgd/tss/people/oleson/nitrogen/Nmanure.nc + +bilinear + +nn +nn +nn +nn +nn +nn +nn +nn + + +2000 +2000 + +2000 +2000 + +2000 +2000 + +2000 +2000 + +2000 +2000 + +2000 +2000 + +2000 +2000 + +2000 +2000 + +/glade/p/cgd/tss/people/oleson/nitrogen/Nfert.nc + +bilinear + +nn +nn +nn +nn +nn +nn +nn +nn + + .false. 2001 diff --git a/bld/namelist_files/namelist_defaults_usr_files.xml b/bld/namelist_files/namelist_defaults_usr_files.xml index 14ba49de23..d6d01d09f2 100644 --- a/bld/namelist_files/namelist_defaults_usr_files.xml +++ b/bld/namelist_files/namelist_defaults_usr_files.xml @@ -25,6 +25,7 @@ provided they are in the valid list expressed above. lnd/clm2/surfdata/surfdata_${clm_usr_name}_simyr${sim_year}.nc lnd/clm2/surfdata_map/surfdata_${clm_usr_name}_simyr${sim_year}.nc +lnd/clm2/surfdata_map/surfdata_${clm_usr_name}_simyr${sim_year}.nc null diff --git a/bld/namelist_files/namelist_definition_clm4_5.xml b/bld/namelist_files/namelist_definition_clm4_5.xml index ea00f3babe..445763d48c 100644 --- a/bld/namelist_files/namelist_definition_clm4_5.xml +++ b/bld/namelist_files/namelist_definition_clm4_5.xml @@ -637,6 +637,11 @@ LUNA: Leaf Utilization of Nitrogen for Assimilation Toggle to turn on the plant hydraulic stress model + +Toggle to turn on the Flow of Agricultural Nitrogen (FAN) model + + How LUNA and Photosynthesis (if needed) will get Leaf nitrogen content @@ -1456,6 +1461,78 @@ Mapping method from Nitrogen deposition input file to the model resolution copy = copy using the same indices + + + + + + +First year to loop over for FAN Nitrogen (manure) Deposition data + + + +Last year to loop over for FAN Nitrogen (manure) Deposition data + + + +Simulation year that aligns with stream_year_first_ndep2 value + + + +Filename of input stream data for FAN Nitrogen (manure) Deposition + + + +Mapping method from FAN Nitrogen (manure) deposition input file to the model resolution + bilinear = bilinear interpolation + nn = nearest neighbor + nnoni = nearest neighbor on the "i" (longitude) axis + nnonj = nearest neighbor on the "j" (latitude) axis + spval = set to special value + copy = copy using the same indices + + + + + + + +First year to loop over for FAN Nitrogen (fertilizer) Deposition data + + + +Last year to loop over for FAN Nitrogen (fertilizer) Deposition data + + + +Simulation year that aligns with stream_year_first_ndep3 value + + + +Filename of input stream data for FAN Nitrogen (fertilizer) Deposition + + + +Mapping method from FAN Nitrogen (fertilizer) deposition input file to the model resolution + bilinear = bilinear interpolation + nn = nearest neighbor + nnoni = nearest neighbor on the "i" (longitude) axis + nnonj = nearest neighbor on the "j" (latitude) axis + spval = set to special value + copy = copy using the same indices + + + diff --git a/bld/namelist_files/use_cases/2000_control.xml b/bld/namelist_files/use_cases/2000_control.xml index ca7c1ac5cd..5d72834cc7 100644 --- a/bld/namelist_files/use_cases/2000_control.xml +++ b/bld/namelist_files/use_cases/2000_control.xml @@ -24,6 +24,18 @@ 2000 2000 +2000 +2000 + +2000 +2000 + +2000 +2000 + +2000 +2000 + 2000 2000 diff --git a/bld/namelist_files/use_cases/20thC_transient.xml b/bld/namelist_files/use_cases/20thC_transient.xml index 3ee0134b9b..4b09ca60ce 100644 --- a/bld/namelist_files/use_cases/20thC_transient.xml +++ b/bld/namelist_files/use_cases/20thC_transient.xml @@ -35,6 +35,22 @@ 2005 1850 +2000 +2000 +2000 + +2000 +2000 +2000 + +2000 +2000 +2000 + +2000 +2000 +2000 + 1850 2010 1850 diff --git a/src/biogeochem/CNDriverMod.F90 b/src/biogeochem/CNDriverMod.F90 index a8ed44cd97..f673d86646 100644 --- a/src/biogeochem/CNDriverMod.F90 +++ b/src/biogeochem/CNDriverMod.F90 @@ -37,6 +37,9 @@ module CNDriverMod use ch4Mod , only : ch4_type use EnergyFluxType , only : energyflux_type use SoilHydrologyType , only : soilhydrology_type +!KO + use FrictionVelocityMod , only : frictionvel_type +!KO ! ! !PUBLIC TYPES: implicit none @@ -92,7 +95,10 @@ subroutine CNDriverNoLeaching(bounds, atm2lnd_inst, waterstate_inst, waterflux_inst, & canopystate_inst, soilstate_inst, temperature_inst, crop_inst, ch4_inst, & dgvs_inst, photosyns_inst, soilhydrology_inst, energyflux_inst, & - nutrient_competition_method, cnfire_method) +!KO nutrient_competition_method, cnfire_method) +!KO + nutrient_competition_method, cnfire_method, frictionvel_inst) +!KO ! ! !DESCRIPTION: ! The core CN code is executed here. Calculates fluxes for maintenance @@ -166,7 +172,10 @@ subroutine CNDriverNoLeaching(bounds, type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst type(atm2lnd_type) , intent(in) :: atm2lnd_inst - type(waterstate_type) , intent(in) :: waterstate_inst +!KO type(waterstate_type) , intent(in) :: waterstate_inst +!KO + type(waterstate_type) , intent(inout) :: waterstate_inst +!KO type(waterflux_type) , intent(inout) :: waterflux_inst type(canopystate_type) , intent(inout) :: canopystate_inst type(soilstate_type) , intent(inout) :: soilstate_inst @@ -177,6 +186,9 @@ subroutine CNDriverNoLeaching(bounds, type(photosyns_type) , intent(in) :: photosyns_inst type(soilhydrology_type) , intent(in) :: soilhydrology_inst type(energyflux_type) , intent(in) :: energyflux_inst +!KO + type(frictionvel_type) , intent(inout) :: frictionvel_inst +!KO class(nutrient_competition_method_type) , intent(inout) :: nutrient_competition_method class(cnfire_method_type) , intent(inout) :: cnfire_method ! @@ -261,8 +273,16 @@ subroutine CNDriverNoLeaching(bounds, ! -------------------------------------------------- call t_startf('CNDeposition') - call CNNDeposition(bounds, & - atm2lnd_inst, soilbiogeochem_nitrogenflux_inst) +!KO call CNNDeposition(bounds, & +!KO atm2lnd_inst, soilbiogeochem_nitrogenflux_inst) +!KO + call CNNDeposition(bounds, num_soilc, filter_soilc, & + atm2lnd_inst, soilbiogeochem_nitrogenflux_inst, cnveg_carbonstate_inst, & + soilbiogeochem_nitrogenstate_inst, soilbiogeochem_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + waterstate_inst, soilstate_inst, temperature_inst, & + waterflux_inst, frictionvel_inst) +!KO call t_stopf('CNDeposition') if(use_fun)then @@ -353,6 +373,7 @@ subroutine CNDriverNoLeaching(bounds, crop_inst, canopystate_inst, soilstate_inst, dgvs_inst, & cnveg_state_inst, cnveg_carbonstate_inst, cnveg_carbonflux_inst, & cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_nitrogenstate_inst, & c13_cnveg_carbonstate_inst, c14_cnveg_carbonstate_inst, & leaf_prof_patch=soilbiogeochem_state_inst%leaf_prof_patch(begp:endp,1:nlevdecomp_full), & froot_prof_patch=soilbiogeochem_state_inst%froot_prof_patch(begp:endp,1:nlevdecomp_full), & @@ -448,6 +469,7 @@ subroutine CNDriverNoLeaching(bounds, crop_inst, canopystate_inst, soilstate_inst, dgvs_inst, & cnveg_state_inst, cnveg_carbonstate_inst, cnveg_carbonflux_inst, & cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_nitrogenstate_inst, & c13_cnveg_carbonstate_inst, c14_cnveg_carbonstate_inst, & leaf_prof_patch=soilbiogeochem_state_inst%leaf_prof_patch(begp:endp,1:nlevdecomp_full), & froot_prof_patch=soilbiogeochem_state_inst%froot_prof_patch(begp:endp,1:nlevdecomp_full), & @@ -459,6 +481,7 @@ subroutine CNDriverNoLeaching(bounds, crop_inst, canopystate_inst, soilstate_inst, dgvs_inst, & cnveg_state_inst, cnveg_carbonstate_inst, cnveg_carbonflux_inst, & cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_nitrogenstate_inst, & c13_cnveg_carbonstate_inst, c14_cnveg_carbonstate_inst, & leaf_prof_patch=soilbiogeochem_state_inst%leaf_prof_patch(begp:endp,1:nlevdecomp_full), & froot_prof_patch=soilbiogeochem_state_inst%froot_prof_patch(begp:endp,1:nlevdecomp_full), & diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index b8796912a2..f0dcfbc6ec 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -14,6 +14,14 @@ module CNNDynamicsMod use atm2lndType , only : atm2lnd_type use CNVegStateType , only : cnveg_state_type use CNVegCarbonFluxType , only : cnveg_carbonflux_type +!KO + use CNVegCarbonStateType , only : cnveg_carbonstate_type + use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type + use TemperatureType , only : temperature_type + use FrictionVelocityMod , only : frictionvel_type + use clm_varctl , only : iulog + use shr_infnan_mod , only : isnan => shr_infnan_isnan +!KO use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type use SoilBiogeochemStateType , only : soilbiogeochem_state_type @@ -21,10 +29,15 @@ module CNNDynamicsMod use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type use WaterStateType , only : waterstate_type use WaterFluxType , only : waterflux_type + !JV + use SoilStateType , only : soilstate_type + !JV + use CropType , only : crop_type use ColumnType , only : col use PatchType , only : patch use perf_mod , only : t_startf, t_stopf + use FanMod ! implicit none private @@ -44,6 +57,8 @@ module CNNDynamicsMod real(r8) :: freelivfix_slope_wET ! slope of line of free living fixation with annual ET end type params_type type(params_type) :: params_inst + + logical, private, parameter :: debug_fan = .false. !----------------------------------------------------------------------- contains @@ -113,9 +128,758 @@ subroutine CNNDynamicsReadNML( NLFilename ) end subroutine CNNDynamicsReadNML + subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & + atm2lnd_inst, soilbiogeochem_nitrogenflux_inst, cnveg_carbonstate_inst, & + soilbiogeochem_nitrogenstate_inst, soilbiogeochem_carbonflux_inst, & + cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + waterstate_inst, soilstate_inst, temperature_inst, & + waterflux_inst, frictionvel_inst) + use CNSharedParamsMod , only: use_fun + !KO + use clm_varctl , only: use_fan +! use subgridAveMod , only: p2c + use clm_time_manager , only: get_step_size, get_curr_date, get_curr_calday, get_nstep + + use clm_varpar , only: max_patch_per_col + use LandunitType , only: lun + use shr_sys_mod , only : shr_sys_flush +!KO use ColumnType , only: col + use GridcellType , only: grc + use FanMod + use clm_varctl , only : iulog + use abortutils , only : endrun + use pftconMod, only : nc4_grass, nc3_nonarctic_grass + use landunit_varcon, only: istsoil, istcrop + use clm_varcon, only : spval, ispval + + type(bounds_type) , intent(in) :: bounds +!KO + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns +!KO + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst +!KO + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(soilbiogeochem_nitrogenstate_type), intent(inout) :: soilbiogeochem_nitrogenstate_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(temperature_type) , intent(inout) :: temperature_inst + type(waterflux_type) , intent(inout) :: waterflux_inst + type(frictionvel_type) , intent(inout) :: frictionvel_inst + + integer, parameter :: num_substeps = 4, balance_check_freq = 1000 + integer :: c, g, patchcounter, p, status, c1, c2, l, fc, ind_substep + real(r8) :: dt, ndep_org(3), orgpools(3), tanprod(3), watertend, fluxes(6,3), tanpools3(3), ratm, tandep, & + fluxes2(6,2), fluxes3(6,3), tanpools2(2), fluxes_tmp(6), garbage_total + real(r8), parameter :: water_init_grz = 0.005_r8, cnc_nh3_air = 0.0_r8, depth_slurry = 0.005_r8 + real(r8), parameter :: fract_resist=0.225_r8, fract_unavail=0.025_r8, fract_avail=0.25_r8, fract_tan=0.5_r8 + real(r8), parameter :: dz_layer_fert = 0.02_r8, dz_layer_grz = 0.02_r8 + !real(r8), parameter :: fract_resist=0._r8, fract_unavail=0._r8, fract_avail=0._r8, fract_tan=1.0_r8 + + real(r8), parameter :: slurry_infiltr_time = 6*3600.0_r8, water_init_fert = 1e-6 + real(r8), parameter :: poolranges_grz(2) = (/24*3600.0_r8, 360*24*3600.0_r8/), & + poolranges_fert(3) = (/2*24*3600.0_r8, 24*3600.0_r8, 360*24*3600.0_r8/), & + poolranges_slr(3) = (/slurry_infiltr_time, 24*3600.0_r8, 360*24*3600.0_r8/), & + Hconc_grz(2) = (/10**(-8.5_r8), 10**(-8.0_r8)/), & + Hconc_fert(3) = (/10**-7.0_r8, 10**(-8.0_r8), 10**(-8.0_r8)/) + !logical, parameter :: do_balance_checks = .false. + logical :: do_balance_checks + real(r8) :: tg, garbage, theta, thetasat, infiltr_m_s, evap_m_s, runoff_m_s, org_n_tot, & + nstored_old, nsoilman_old, nsoilfert_old, fert_to_air, fert_to_soil, fert_total, fert_urea, fert_tan, & + soilflux_org, urea_resid + real(r8) :: tanprod_from_urea(3), ureapools(2), fert_no3, fert_generic + real(r8), parameter :: fract_urea=0.545, fract_no3=0.048 + integer, parameter :: ind_region = 1 + + dt = real( get_step_size(), r8 ) + do_balance_checks = mod(get_nstep(), balance_check_freq) == 0 + associate( & + ! Input: [real(r8) (:)] nitrogen deposition rate (gN/m2/s) + forc_ndep => atm2lnd_inst%forc_ndep_grc , & + ! Output: [real(r8) (:)] atmospheric N deposition to soil mineral N (gN/m2/s) + ndep_to_sminn => soilbiogeochem_nitrogenflux_inst%ndep_to_sminn_col & + ) + ! Loop through columns + do c = bounds%begc, bounds%endc + g = col%gridcell(c) + ndep_to_sminn(c) = forc_ndep(g) + end do + end associate + + associate(& + ngrz => soilbiogeochem_nitrogenflux_inst%man_n_grz_col, & + man_u_grz => soilbiogeochem_nitrogenstate_inst%man_u_grz_col, & + man_a_grz => soilbiogeochem_nitrogenstate_inst%man_a_grz_col, & + man_r_grz => soilbiogeochem_nitrogenstate_inst%man_r_grz_col, & + man_u_app => soilbiogeochem_nitrogenstate_inst%man_u_app_col, & + man_a_app => soilbiogeochem_nitrogenstate_inst%man_a_app_col, & + man_r_app => soilbiogeochem_nitrogenstate_inst%man_r_app_col, & + ns => soilbiogeochem_nitrogenstate_inst, & + nf => soilbiogeochem_nitrogenflux_inst, & + cnv_nf => cnveg_nitrogenflux_inst, & + ram1 => frictionvel_inst%ram1_patch, & + rb1 => frictionvel_inst%rb1_patch) + + nf%fert_n_appl_col(bounds%begc:bounds%endc) = 0.0 + nf%man_n_appl_col(bounds%begc:bounds%endc) = 0.0 + nf%man_tan_appl_col(bounds%begc:bounds%endc) = 0.0 + + call p2c(bounds, num_soilc, filter_soilc, & + cnv_nf%fert_patch(bounds%begp:bounds%endp), & + nf%fert_n_appl_col(bounds%begc:bounds%endc)) + call p2c(bounds, num_soilc, filter_soilc, & + cnv_nf%manu_patch(bounds%begp:bounds%endp), & + nf%man_n_appl_col(bounds%begc:bounds%endc)) + + if (any(nf%man_n_appl_col > 100)) then + write(iulog, *) maxval(nf%man_n_appl_col) + call endrun('bad man_n_appl_col') + end if + if (do_balance_checks) then + nstored_old = get_total_n(ns, nf, 'pools_storage') + nsoilman_old = get_total_n(ns, nf, 'pools_manure') + nsoilfert_old = get_total_n(ns, nf, 'pools_fertilizer') + end if + + ! Assign the "pastoral" manure entire to the natural vegetation column + do fc = 1, num_soilc + c = filter_soilc(fc) + l = col%landunit(c) + if (.not. (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop)) cycle + if (.not. col%active(c) .or. col%wtgcell(c) < 1e-6) cycle + g = col%gridcell(c) + if (lun%itype(l) == istsoil) then + ngrz(c) = atm2lnd_inst%forc_ndep3_grc(g) / col%wtgcell(c) * 1e-3 ! kg to g + if (debug_fan) then + if (ngrz(c) > 1e12 .or. (isnan(ngrz(c)))) then + write(iulog, *) 'bad ngrz', atm2lnd_inst%forc_ndep3_grc(g), col%wtgcell(c) + call endrun('bad ngrz 1') + end if + end if + if (nf%man_n_appl_col(c) > 0) then + write(iulog, *) nf%man_n_appl_col(c) + call endrun(msg='Found fertilizer in soil column') + end if + else + ngrz(c) = 0.0 + end if + + end do + + if(debug_fan) then + write(iulog, *) 'nan count of storage 1', count(isnan(ns%man_n_stored_col)) + if (any(isnan(nf%man_n_appl_col))) then + call endrun('nan nh3 appl b') + end if + end if + + call handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & + atm2lnd_inst%forc_ndep2_grc, & + ns%man_n_stored_col, ns%man_tan_stored_col, & + nf%man_n_appl_col, nf%man_tan_appl_col, & + nf%man_n_grz_col, nf%man_n_mix_col, & + nf%nh3_stores_col, nf%nh3_barns_col, & + nf%man_n_transf_col, filter_soilc, num_soilc) + + if (debug_fan) then + if (any(isnan(nf%nh3_stores_col))) then + call endrun('nan nh3 stores') + end if + if (any(isnan(nf%nh3_barns_col))) then + call endrun('nan nh3 barns') + end if + if (any(isnan(nf%man_n_appl_col))) then + call endrun('nan nh3 appl') + end if + if (any(isnan(nf%man_n_mix_col))) then + call endrun('nan nh3 appl') + end if + end if + + do fc = 1, num_soilc + c = filter_soilc(fc) + l = col%landunit(c) + if (.not. (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop)) cycle + if (.not. col%active(c) .or. col%wtgcell(c) < 1e-6) cycle + + if (nf%man_n_appl_col(c) > 1e12 .or. ngrz(c) > 1e12) then + write(iulog, *) c, nf%man_n_appl_col(c), ngrz(c), cnv_nf%fert_patch(col%patchi(c):col%patchf(c)), & + cnv_nf%manu_patch(col%patchi(c):col%patchf(c)) + call endrun('nf%man_n_appl_col(c) is spval') + end if + + ! Find and average the atmospheric resistances Rb and Ra. + ! + if (lun%itype(col%landunit(c)) == istcrop) then + ! for column, only one patch + p = col%patchi(c) + if (p /= col%patchf(c)) call endrun(msg='Strange patch for crop') + ratm = ram1(p) + rb1(p) + else + ! if natural, find average over grasses + ratm = 0.0 + patchcounter = 0 + do p = col%patchi(c), col%patchf(c) + if (patch%itype(p) == nc4_grass .or. patch%itype(p) == nc3_nonarctic_grass) then + if (.not. patch%active(p) .or. ram1(p) == spval .or. rb1(p) == spval) cycle + ratm = ratm + ram1(p) + rb1(p) + patchcounter = patchcounter + 1 + end if + end do + if (patchcounter > 0) then + ratm = ratm / patchcounter + else + ! grass not found, take something. + do p = col%patchi(c), col%patchf(c) + if (.not. patch%active(p) .or. ram1(p) == spval .or. rb1(p) == spval) cycle + ratm = ram1(p) + rb1(p) + exit + end do + if (p == col%patchf(c) + 1) then + ratm = 150.0_r8 + end if + end if + end if + + ! Calculation of the water fluxes should include the background soil moisture + ! tendency. However, it's unclear how to do this in a numerically consistent + ! way. Following a naive finite differencing approach led to poorer agreement in + ! stand-alone simulations so the term is currenltly neglected here. + watertend = 0.0_r8 + tg = temperature_inst%t_grnd_col(c) + theta = waterstate_inst%h2osoi_vol_col(c,1) + thetasat = soilstate_inst%watsat_col(c,1) + theta = min(theta, 0.98_r8*thetasat) + infiltr_m_s = max(waterflux_inst%qflx_infl_col(c), 0.0) * 1e-3 + evap_m_s = waterflux_inst%qflx_evap_grnd_col(c) * 1e-3 + runoff_m_s = max(waterflux_inst%qflx_runoff_col(c), 0.0) * 1e-3 + + ! + ! grazing + ! + + ndep_org(ind_avail) = ngrz(c) * fract_avail + ndep_org(ind_resist) = ngrz(c) * fract_resist + ndep_org(ind_unavail) = ngrz(c) * fract_unavail + tandep = ngrz(c) * fract_tan + + orgpools(ind_avail) = man_a_grz(c) + orgpools(ind_resist) = man_r_grz(c) + orgpools(ind_unavail) = man_u_grz(c) + call update_org_n(ndep_org, tg, orgpools, dt, tanprod, soilflux_org) + man_a_grz(c) = orgpools(ind_avail) + man_r_grz(c) = orgpools(ind_resist) + man_u_grz(c) = orgpools(ind_unavail) + + tanpools2(1) = ns%tan_g1_col(c) + tanpools2(2) = ns%tan_g2_col(c) + if (any(isnan(tanpools2))) then + call endrun('nan1') + end if + + fluxes_tmp = 0.0 + garbage_total = 0.0 + fluxes2 = 0.0 + garbage = 0 + do ind_substep = 1, num_substeps + call update_npool(tg, ratm, & + theta, thetasat, infiltr_m_s, evap_m_s, & + atm2lnd_inst%forc_q_downscaled_col(c), watertend, & + runoff_m_s, tandep, (/0.0_r8, sum(tanprod)/), water_init_grz, & + cnc_nh3_air, poolranges_grz, Hconc_grz, dz_layer_grz, tanpools2, & + fluxes2(1:5,:), garbage, dt/num_substeps, status, 2) + if (status /= 0) then + write(iulog, *) 'status = ', status, tanpools2, ratm, theta, thetasat, tandep, tanprod + call endrun(msg='update_npool status /= 0') + end if + if (debug_fan .and. any(isnan(tanpools2))) then + call endrun('nan2') + end if + fluxes_tmp = fluxes_tmp + sum(fluxes2, dim=2) + garbage_total = garbage_total + garbage + end do + fluxes_tmp = fluxes_tmp / num_substeps + + ns%tan_g1_col(c) = tanpools2(1) + ns%tan_g2_col(c) = tanpools2(2) + if (debug_fan .and. any(isnan(fluxes2))) then + write(iulog, *) fluxes2 + call endrun('nan3') + end if + + nf%nh3_grz_col(c) = fluxes_tmp(iflx_air) + nf%manure_runoff_col(c) = fluxes_tmp(iflx_roff) + nf%manure_no3_prod_col(c) = fluxes_tmp(iflx_no3) + nf%manure_nh4_to_soil_col(c) & + = fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) + garbage_total / dt + soilflux_org + + ! + ! Manure application + ! + + org_n_tot = nf%man_n_appl_col(c) - nf%man_tan_appl_col(c) + ! Use the the same fractionation of organic N as for grazing, after removing the + ! "explicitly" calculated TAN. + if (1-fract_tan > 1e-6) then + ndep_org(ind_avail) = org_n_tot * fract_avail / (1-fract_tan) + ndep_org(ind_resist) = org_n_tot * fract_resist / (1-fract_tan) + ndep_org(ind_unavail) = org_n_tot * fract_unavail / (1-fract_tan) + else + ndep_org = 0.0 + end if + tandep = nf%man_tan_appl_col(c) + + orgpools(ind_avail) = man_a_app(c) + orgpools(ind_resist) = man_r_app(c) + orgpools(ind_unavail) = man_u_app(c) + call update_org_n(ndep_org, tg, orgpools, dt, tanprod, soilflux_org) + man_a_app(c) = orgpools(ind_avail) + man_r_app(c) = orgpools(ind_resist) + man_u_app(c) = orgpools(ind_unavail) + tanpools3(1) = ns%tan_s0_col(c) + tanpools3(2) = ns%tan_s1_col(c) + tanpools3(3) = ns%tan_s2_col(c) + + if (debug_fan .and. any(isnan(tanpools3))) then + call endrun('nan31') + end if + + fluxes_tmp = 0.0 + garbage_total = 0.0 + fluxes3 = 0.0 + do ind_substep = 1, num_substeps + if (debug_fan .and. any(abs(tanpools3) > 1e12)) then + write(iulog, *) ind_substep, tanpools3, tandep, nf%fert_n_appl_col(c), & + nf%man_n_appl_col(c), ns%man_n_stored_col(c), ns%man_tan_stored_col(c) + call endrun('bad tanpools (manure app)') + end if + + call update_3pool(tg, ratm, theta, thetasat, infiltr_m_s, evap_m_s, & + atm2lnd_inst%forc_q_downscaled_col(c), watertend, & + runoff_m_s, tandep, sum(tanprod), cnc_nh3_air, depth_slurry, & + poolranges_slr, tanpools3, fluxes3(1:5,:), garbage, dt / num_substeps, status) + if (status /= 0) then + write(iulog, *) 'status = ', status, tanpools3, tg, ratm, 'th', theta, & + thetasat, tandep, 'tp', tanprod, 'fx', fluxes + call endrun(msg='update_3pool status /= 0') + end if + fluxes_tmp = fluxes_tmp + sum(fluxes3, dim=2) + garbage_total = garbage_total + garbage + end do + fluxes_tmp = fluxes_tmp / num_substeps + + ns%tan_s0_col(c) = tanpools3(1) + ns%tan_s1_col(c) = tanpools3(2) + ns%tan_s2_col(c) = tanpools3(3) + + if (debug_fan .and. any(isnan(fluxes3))) then + write(iulog, *) fluxes3, tanpools3,ratm, theta, thetasat, infiltr_m_s, tandep, tanprod + call endrun('nan4') + end if + + nf%nh3_man_app_col(c) = fluxes_tmp(iflx_air) + nf%manure_runoff_col(c) = nf%manure_runoff_col(c) + fluxes_tmp(iflx_roff) + nf%manure_no3_prod_col(c) = nf%manure_no3_prod_col(c) + fluxes_tmp(iflx_no3) + nf%manure_nh4_to_soil_col(c) & + = nf%manure_nh4_to_soil_col(c) + fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) & + + garbage_total / dt + soilflux_org + + ! + ! Fertilizer + ! + + fert_total = nf%fert_n_appl_col(c) + + fert_urea = fert_total * fract_urea + fert_no3 = fert_total * fract_no3 + fert_generic = fert_total - fert_urea - fert_no3 + + ! Urea decomposition + ! + ureapools(1) = ns%fert_u0_col(c) + ureapools(2) = ns%fert_u1_col(c) + fluxes2 = 0.0 + call update_urea(tg, theta, thetasat, infiltr_m_s, evap_m_s, watertend, & + runoff_m_s, fert_urea, ureapools, fluxes2, urea_resid, poolranges_fert(1:2), & + dt, status, numpools=2) + if (status /= 0) then + call endrun(msg='Bad status after update_urea for fertilizer') + end if + ! Nitrogen fluxes from urea pool. Be sure to not zero below! + fluxes_tmp = sum(fluxes2, dim=2) + + ns%fert_u0_col(c) = ureapools(1) + ns%fert_u1_col(c) = ureapools(2) + ! Collect the formed ammonia for updating the TAN pools + tanprod_from_urea(1:2) = fluxes2(iflx_to_tan, 1:2) + tanprod_from_urea(2) = tanprod_from_urea(2) + ! There is no urea pool corresponding to tan_f2, because most of the urea will + ! have decomposed. Here whatever remains gets sent to tan_f2. + tanprod_from_urea(3) = urea_resid / dt + + tanpools3(1) = ns%tan_f0_col(c) + tanpools3(2) = ns%tan_f1_col(c) + tanpools3(3) = ns%tan_f2_col(c) + garbage_total = 0.0 + fluxes3 = 0.0 + do ind_substep = 1, num_substeps + ! Fertilizer pools f0...f2 + call update_npool(tg, ratm, theta, thetasat, infiltr_m_s, evap_m_s, & + atm2lnd_inst%forc_q_downscaled_col(c), watertend, & + runoff_m_s, 0.0_r8, tanprod_from_urea, water_init_fert, cnc_nh3_air, & + poolranges_fert, Hconc_fert, dz_layer_fert, tanpools3, fluxes3(1:5,:), & + garbage, dt/num_substeps, status, numpools=3) + if (status /= 0) then + write(iulog, *) 'status:', status, tanpools3, nf%fert_n_appl_col(c) + call endrun(msg='Bad status after npool for fertilizer') + end if + fluxes_tmp = fluxes_tmp + sum(fluxes3, dim=2) / num_substeps + garbage_total = garbage_total + garbage + + ! Fertilizer pool f3 + call update_npool(tg, ratm, theta, thetasat, infiltr_m_s, evap_m_s, & + atm2lnd_inst%forc_q_downscaled_col(c), watertend, & + runoff_m_s, fert_generic, (/0.0_r8/), water_init_fert, cnc_nh3_air, & + (/360*24*3600.0_r8/), (/10**(-6.5_r8)/), dz_layer_fert, ns%tan_f3_col(c:c), fluxes3(1:5,1:1), & + garbage, dt/num_substeps, status, numpools=1) + if (status /= 0) then + write(iulog, *) 'status:', status, tanpools3, nf%fert_n_appl_col(c) + call endrun(msg='Bad status after npool for generic') + end if + fluxes_tmp = fluxes_tmp + fluxes3(:, 1) / num_substeps + garbage_total = garbage_total + garbage + end do + + ns%tan_f0_col(c) = tanpools3(1) + ns%tan_f1_col(c) = tanpools3(2) + ns%tan_f2_col(c) = tanpools3(3) + ! tan_f3_col already updated by update_npool! + + nf%nh3_fert_col(c) = fluxes_tmp(iflx_air) + nf%fert_runoff_col(c) = fluxes_tmp(iflx_roff) + nf%fert_no3_prod_col(c) = fluxes_tmp(iflx_no3) + fert_no3 + nf%fert_nh4_to_soil_col(c) & + = fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) + fert_to_soil + garbage_total/dt + + end do + + if (do_balance_checks) then + call balance_check('Storage', nstored_old, & + get_total_n(ns, nf, 'pools_storage'), get_total_n(ns, nf, 'fluxes_storage')) + call balance_check('Manure', nsoilman_old, & + get_total_n(ns, nf, 'pools_manure'), get_total_n(ns, nf, 'fluxes_manure')) + call balance_check('Fertilizer', nsoilfert_old, & + get_total_n(ns, nf, 'pools_fertilizer'), get_total_n(ns, nf, 'fluxes_fertilizer')) + end if + + end associate + + contains + + real(r8) function get_total_n(ns, nf, which) result(total) + type(soilbiogeochem_nitrogenstate_type), intent(in) :: ns + type(soilbiogeochem_nitrogenflux_type), intent(in) :: nf + character(len=*), intent(in) :: which + + total = 0 + + associate(soilc => filter_soilc(1:num_soilc)) + + select case(which) + case('pools_storage') + total = sum(ns%man_n_stored_col(soilc)) + + case('fluxes_storage') + total = sum(nf%man_n_mix_col(soilc)) + total = total - sum(nf%nh3_stores_col(soilc)) + total = total - sum(nf%nh3_barns_col(soilc)) - sum(nf%man_n_transf_col(soilc)) + + case('pools_manure') + total = total + sum(ns%tan_g1_col(soilc)) + sum(ns%tan_g2_col(soilc)) + total = total + sum(ns%man_u_grz_col(soilc)) & + + sum(ns%man_a_grz_col(soilc)) + sum(ns%man_r_grz_col(soilc)) + total = total + sum(ns%tan_s0_col(soilc)) & + + sum(ns%tan_s1_col(soilc)) + sum(ns%tan_s2_col(soilc)) + total = total + sum(ns%man_u_app_col(soilc)) & + + sum(ns%man_a_app_col(soilc)) + sum(ns%man_r_app_col(soilc)) + + case('fluxes_manure') + total = sum(nf%man_n_grz_col(soilc)) + sum(nf%man_n_appl_col(soilc)) + total = total - sum(nf%nh3_man_app_col(soilc)) & + - sum(nf%nh3_grz_col(soilc)) - sum(nf%manure_runoff_col(soilc)) + total = total - sum(nf%manure_no3_prod_col(soilc)) - sum(nf%manure_nh4_to_soil_col(soilc)) + + case('pools_fertilizer') + total = sum(ns%tan_f0_col((soilc))) + sum(ns%tan_f1_col((soilc))) + sum(ns%tan_f2_col(soilc)) & + + sum(ns%tan_f3_col(soilc)) + total = total + sum(ns%fert_u0_col(soilc)) + sum(ns%fert_u1_col(soilc)) + + case('fluxes_fertilizer') + total = sum(nf%fert_n_appl_col(soilc)) + total = total - sum(nf%nh3_fert_col(soilc)) - sum(nf%fert_runoff_col(soilc)) + total = total - sum(nf%fert_no3_prod_col(soilc)) - sum(nf%fert_nh4_to_soil_col(soilc)) + + case default + call endrun(msg='Bad argument to get_total_n') + + end select + + end associate + + end function get_total_n + + subroutine balance_check(label, total_old, total_new, flux) + ! Check and report that the net flux equals the accumulated mass in pools. The + ! total pools and fluxes can be evaluated by the function get_total_n. + character(len=*), intent(in) :: label + real(r8), intent(in) :: total_old, total_new, flux + + real(r8) :: diff, accflux + real(r8) :: tol = 1e-6_r8 + + diff = total_new - total_old + accflux = flux*dt + write(iulog, *) 'Balance check:', label, diff, accflux + + end subroutine balance_check + + end subroutine CNNDeposition + + + subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & + ndep_mixed_grc, n_stored_col, tan_stored_col, & + n_manure_spread_col, tan_manure_spread_col, & + n_manure_graze_col, n_manure_mixed_col, & + nh3_flux_stores, nh3_flux_barns, man_n_transf, & + filter_soilc, num_soilc) + use landunit_varcon, only : max_lunit + use pftconMod, only : nc4_grass, nc3_nonarctic_grass + use clm_varcon, only : ispval + use landunit_varcon, only: istsoil, istcrop + use abortutils , only : endrun + use LandunitType , only: lun + use GridcellType , only: grc + use clm_varctl , only : iulog + use ColumnType , only : col + + implicit none + type(bounds_type), intent(in) :: bounds + type(temperature_type) , intent(in) :: temperature_inst + type(frictionvel_type) , intent(in) :: frictionvel_inst + real(r8), intent(in) :: dt + + ! N excreted in manure, mixed/pastoral systems, gN/m2: + real(r8), intent(in) :: ndep_mixed_grc(bounds%begg:bounds%endg) + real(r8), intent(inout) :: n_stored_col(bounds%begc:bounds%endc), tan_stored_col(bounds%begc:bounds%endc) ! N, TAN currently stored, gN/m2 + ! N, TAN spread on grasslands, gN/m2/s: + real(r8), intent(inout) :: n_manure_spread_col(bounds%begc:bounds%endc) ! for crops, input, determined by crop model, otherwise output + real(r8), intent(out) :: tan_manure_spread_col(bounds%begc:bounds%endc) ! output, calculated from the above and stored manure + ! N excreted by animals allocated to mixed production systems temporarily grazing on grasslands: + real(r8), intent(inout) :: n_manure_graze_col(bounds%begc:bounds%endc) + ! N excreted by animals in mixed systems, total + real(r8), intent(out) :: n_manure_mixed_col(bounds%begc:bounds%endc) + ! NH3 emission fluxes from manure storage and housings, gN/m2/s + real(r8), intent(out) :: nh3_flux_stores(bounds%begc:bounds%endc), nh3_flux_barns(bounds%begc:bounds%endc) + ! total nitrogen flux transferred out of a crop column + real(r8), intent(out) :: man_n_transf(bounds%begc:bounds%endc) + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + + integer :: begg, endg, g, l, c, il, counter, col_grass, status, p + real(r8) :: flux_avail, flux_grazing + real(r8) :: tempr_ave, windspeed_ave ! windspeed and temperature averaged over agricultural patches + real(r8) :: tempr_barns, tempr_stores, vent_barns, flux_grass_crop, tempr_min_10day, & + flux_grass_graze, flux_grass_spread, flux_grass_spread_tan, flux_grass_crop_tan + real(r8) :: cumflux, totalinput + real(r8) :: fluxes_nitr(4), fluxes_tan(4) + ! The fraction of manure applied continuously on grasslands (if present in the gridcell) + real(r8), parameter :: fract_continuous = 0.1_r8, kg_to_g = 0.001_r8, max_grazing_fract = 0.3_r8, & + tan_fract_excr = 0.5_r8, volat_coef_barns = 0.02_r8, volat_coef_stores = 0.01_r8, & + tempr_min_grazing = 283.0_r8!!!! + + begg = bounds%begg; endg = bounds%endg + nh3_flux_stores(bounds%begc:bounds%endc) = 0_r8 + nh3_flux_barns(bounds%begc:bounds%endc) = 0_r8 + + totalinput = 0.0 + cumflux = 0.0 + + do g = begg, endg + !totalinput = totalinput + ndep_mixed_grc(g) + + ! First find out if there are grasslands in this cell. If yes, a fraction of + ! manure can be diverted to them before storage. + col_grass = ispval + do il = 1, max_lunit + l = grc%landunit_indices(il, g) + if (lun%itype(l) == istsoil) then + do p = lun%patchi(l), lun%patchf(l) + if (patch%itype(p) == nc4_grass .or. patch%itype(p) == nc3_nonarctic_grass) then + col_grass = patch%column(p) + exit + end if + end do + end if + if (col_grass /= ispval) exit + end do + if (col%wtgcell(col_grass) < 1e-6) col_grass = ispval + ! Transfer of manure from all crop columns to the natural vegetation column: + flux_grass_graze = 0_r8 + flux_grass_spread = 0_r8 + flux_grass_spread_tan = 0_r8 + + do il = 1, max_lunit + l = grc%landunit_indices(il, g) + if (l == ispval) cycle + if (lun%itype(l) == istcrop) then + ! flux_avail = manure excreted per m2 of crops (ndep_mixed_grc = per m2 / all land units) + do c = lun%coli(l), lun%colf(l) + if (.not. col%active(c)) cycle + if (col%wtgcell(c) < 1e-6) cycle + + if (col%landunit(c) /= l) then + write(iulog, *) g, il, c, col%landunit(c) + call endrun('something wrong') + end if + if (.not. any(c==filter_soilc(1:num_soilc))) then + write(iulog, *) c, n_manure_spread_col(c) + call endrun('column not in soilfilter') + end if + + flux_avail = ndep_mixed_grc(g) * kg_to_g / lun%wtgcell(l) + if (flux_avail > 1e12 .or. isnan(flux_avail)) then + write(iulog, *) 'bad flux_avail', ndep_mixed_grc(g), lun%wtgcell(l) + call endrun('bad flux_avail') + end if + n_manure_mixed_col(c) = flux_avail + totalinput = totalinput + flux_avail + !manure_input(c) = flux_avail + + !tempr_ave = 0_r8 + !windspeed_ave = 0_r8 + counter = 0 + if (col_grass == c) call endrun('Something wrong with the indices') + if (col%patchi(c) /= col%patchf(c)) then + call endrun(msg="ERROR crop column has multiple patches") + end if + + tempr_ave = temperature_inst%t_ref2m_patch(col%patchi(c)) + windspeed_ave = frictionvel_inst%u10_patch(col%patchi(c)) + + tempr_min_10day = temperature_inst%t_a10min_patch(col%patchi(c)) + if (tempr_min_10day > tempr_min_grazing) then + ! fraction of animals grazing -> allocate some manure to grasslands before barns + flux_grazing = max_grazing_fract * flux_avail + flux_avail = flux_avail - flux_grazing + else + flux_grazing = 0_r8 + end if + flux_grass_graze = flux_grass_graze + flux_grazing*col%wtgcell(c) + + call eval_fluxes_storage(flux_avail, tempr_ave, windspeed_ave, fract_continuous, & + volat_coef_barns, volat_coef_stores, tan_fract_excr, fluxes_nitr, fluxes_tan, status) + if (any(fluxes_nitr > 1e12)) then + write(iulog, *) 'bad fluxes', fluxes_nitr + end if + if (status /=0) then + write(iulog, *) 'status = ', status + call endrun(msg='eval_fluxes_storage failed') + end if + cumflux = cumflux + sum(fluxes_nitr) + + !flux_grass_spread = flux_grass_spread + flux_grass_crop*col%wtgcell(c) + flux_grass_spread = flux_grass_spread + fluxes_nitr(iflx_appl)*col%wtgcell(c) + !flux_grass_spread_tan = flux_grass_spread_tan + flux_grass_crop_tan*col%wtgcell(c) + flux_grass_spread_tan = flux_grass_spread_tan + fluxes_tan(iflx_appl)*col%wtgcell(c) + + + !man_n_transf(c) = flux_grazing + + if (fluxes_tan(iflx_to_store) < 0) then + call endrun(msg="ERROR too much manure lost") + end if + + if (n_stored_col(c) < 0) then + call endrun(msg='n_stored_col is negative') + end if + + if (n_stored_col(c) > 0_r8) then + tan_manure_spread_col(c) = n_manure_spread_col(c) * tan_stored_col(c)/n_stored_col(c) + else if (n_manure_spread_col(c) > 0) then + write(iulog, *) 'stored, spread', n_stored_col(c), n_manure_spread_col(c) + call endrun(msg='Inconsistent manure application') + else + tan_manure_spread_col(c) = 0_r8 + end if + + if (tan_manure_spread_col(c) > 1) then + write(iulog, *) 'bad tan_manure', tan_manure_spread_col(c), tan_stored_col(c), n_stored_col(c), n_manure_spread_col(c) + end if + + + if (n_manure_spread_col(c) > 1) then + write(iulog, *) 'bad n_manure', tan_manure_spread_col(c), tan_stored_col(c), n_stored_col(c), n_manure_spread_col(c) + end if + + n_stored_col(c) = n_stored_col(c) + (fluxes_nitr(iflx_to_store) - n_manure_spread_col(c)) * dt + tan_stored_col(c) = tan_stored_col(c) & + + (fluxes_tan(iflx_to_store) - tan_manure_spread_col(c)) * dt + if (n_stored_col(c) > 1e6) then + call endrun(msg='ERROR bad n_stored_col') + end if + if (n_stored_col(c) < 0) then + if (n_stored_col(c) > -1e-6_r8) then + n_stored_col(c) = 0_r8 + else + call endrun(msg="ERROR negative n_stored_col") + end if + end if + + man_n_transf(c) = fluxes_nitr(iflx_appl) + flux_grazing + n_manure_spread_col(c) + + nh3_flux_stores(c) = fluxes_nitr(iflx_air_stores) + nh3_flux_barns(c) = fluxes_nitr(iflx_air_barns) + + end do ! column + end if ! crop land unit + end do ! landunit + + if (col_grass /= ispval) then + if (tan_manure_spread_col(col_grass) > 1) then + write(iulog, *) 'bad tan_manure col_grass before adding', n_manure_spread_col(col_grass), & + tan_manure_spread_col(col_grass) + end if + n_manure_spread_col(col_grass) = n_manure_spread_col(col_grass) & + + flux_grass_spread / col%wtgcell(col_grass) + tan_manure_spread_col(col_grass) = tan_manure_spread_col(col_grass) & + + flux_grass_spread_tan / col%wtgcell(col_grass) + n_manure_graze_col(col_grass) = n_manure_graze_col(col_grass) + flux_grass_graze / col%wtgcell(col_grass) + !write(iulog, *) 'to grass:', n_manure_spread(col_grass), col_grass + if (tan_manure_spread_col(col_grass) > 1) then + write(iulog, *) 'bad tan_manure col_grass', flux_grass_spread_tan, col%wtgcell(col_grass) + end if + + end if + + end do ! grid + + end subroutine handle_storage + + !----------------------------------------------------------------------- - subroutine CNNDeposition( bounds, & - atm2lnd_inst, soilbiogeochem_nitrogenflux_inst ) +!KO subroutine CNNDeposition( bounds, & +!KO atm2lnd_inst, soilbiogeochem_nitrogenflux_inst ) +!KO + subroutine CNNDeposition_old( bounds, num_soilc, filter_soilc, & + atm2lnd_inst, soilbiogeochem_nitrogenflux_inst, cnveg_carbonstate_inst, & + soilbiogeochem_nitrogenstate_inst, soilbiogeochem_carbonflux_inst, & + cnveg_nitrogenstate_inst, waterstate_inst, temperature_inst, & + waterflux_inst, frictionvel_inst ) +!KO ! ! !DESCRIPTION: ! On the radiation time step, update the nitrogen deposition rate @@ -126,30 +890,795 @@ subroutine CNNDeposition( bounds, & ! ! !USES: use CNSharedParamsMod , only: use_fun +!KO + use clm_varctl , only: use_fan +! use subgridAveMod , only: p2c + use clm_time_manager , only: get_step_size, get_curr_date, get_curr_calday + use clm_varpar , only: max_patch_per_col + use LandunitType , only: lun + use shr_sys_mod , only : shr_sys_flush +!KO use ColumnType , only: col + use GridcellType , only: grc +!KO use PatchType , only: patch +!KO ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds +!KO + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns +!KO type(atm2lnd_type) , intent(in) :: atm2lnd_inst type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst +!KO + type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst + type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst + type(soilbiogeochem_nitrogenstate_type), intent(inout) :: soilbiogeochem_nitrogenstate_inst + type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst + type(waterstate_type) , intent(inout) :: waterstate_inst + type(temperature_type) , intent(inout) :: temperature_inst + type(waterflux_type) , intent(inout) :: waterflux_inst + type(frictionvel_type) , intent(inout) :: frictionvel_inst +!KO ! ! !LOCAL VARIABLES: - integer :: g,c ! indices +!KO integer :: g,c ! indices +!KO + integer :: g,c,p,fc,pi ! Indices + integer :: yr, mon, day, sec ! Outputs from get_curr_date + real(r8) :: fmm ! Fraction of manure that changes to methane (0.055; Lerner et al 1988) + real(r8) :: na ! Fraction of N assimilated by cows (0) + real(r8) :: ca ! Fraction of C assimilated by cows (0) + real(r8) :: pl ! Fraction of cows feed consumed from live shoots (0.9; Holland et al, 1992) + real(r8) :: pd ! Fraction of cows feed consumed from dead shoots (0.1; Holland et al, 1992) + real(r8) :: cn ! Carbon:nitrogen ratio (30) + real(r8) :: fua ! Fraction of urine that volatilizes (0.2; Holland et al, 1992) + real(r8) :: fu ! Fraction of manure that is urine (0.5; Parton et al, 2001) + real(r8) :: ffa ! Fraction of feces that volatilizes pre-industrial (0.27; Bouwman et al, 2002) + real(r8) :: ff ! Fraction of manure that is feces (0.5; Parton et al, 2001) + real(r8) :: f1850 ! Fraction of ndep_fert in 1850 (0.19; Potter et al, 2010) + real(r8) :: m1850 ! Fraction of ndep_manure in 1850 (0.19; Potter et al, 2010) + real(r8) :: dt ! Radiation time step (seconds) + real(r8) :: NFactor !KO + real(r8) :: denit !KO + real(r8) :: jday !KO + real(r8) :: loss_manure_u !KO + real(r8) :: loss_manure_n !KO + real(r8) :: loss_manure_a !KO + real(r8) :: loss_manure_r !KO + real(r8) :: TF !KO + real(r8) :: ndep_fertilizer !KO + real(r8) :: loss_fert_u !KO + real(r8) :: R_nox_to_n2o !KO + real(r8) :: kh !KO + real(r8) :: nh3_gas_conc !KO + real(r8) :: fert_nh3_gas_conc !KO + real(r8) :: knh4 !KO + real(r8) :: nh3_aq_conc !KO + real(r8) :: nh3_aq_sat !KO + real(r8) :: NH4_fert !KO + real(r8) :: NH4_manu !KO + real(r8) :: kf ! Decay rate of urea + real(r8) :: dnh4,dno3 ! Base rate diffusion for nh4 and no3 + real(r8) :: porosity !KO + real(r8) :: ratenh4tosom,rateno3tosom !KO + real(r8) :: canopy_frac ! Fraction of NH3 emissions captured by canopy + real(r8) :: manu_inc,fert_inc ! N mechanically incorporated into soil on a timescale of one year + real(r8) :: k_relax ! Timescale for manure/fert water to relax to soil water (top 5cm) + + ! local pointers to implicit in scalars + integer , pointer :: gridcell (:) ! Index into gridcell level quantities + integer , pointer :: npfts (:) ! Number of pfts for each column + integer , pointer :: pfti (:) ! Beginning pft index for each column + real(r8), pointer :: latdeg (:) ! Latitude in degrees + + real(r8), pointer :: forc_wind (:) ! Wind speed (m s-1) + real(r8), pointer :: forc_rh (:) ! Relative humidity(%) + real(r8), pointer :: forc_ndep2 (:) ! Nitrogen deposition rate (gN/ha/yr) + real(r8), pointer :: forc_ndep3 (:) ! Nitrogen deposition rate (gN/ha/yr) + + real(r8), pointer :: ndep_manure (:) ! Nitrogen manure deposition rate (gN/m2/s) + real(r8), pointer :: ndep_fert (:) ! Nitrogen fertilizer deposition rate (gN/m2/s) + real(r8), pointer :: nh3_manure (:) ! NH3 emission from manure(gN/m2/s) + real(r8), pointer :: gamma_nh3 (:) !KO + real(r8), pointer :: gamma_nh3_fert (:) !KO + real(r8), pointer :: nh3_fert (:) ! NH3 emission from fertilizer(gN/m2/s) + real(r8), pointer :: nhxdep_to_sminn (:) ! NHx deposition from fertilizer & manure NH3 emissions(gN/m2/s) + real(r8), pointer :: noydep_to_sminn (:) ! NOy deposition (gN/m2/s) + real(r8), pointer :: nmanure_to_sminn (:) ! N deposition to soil mineral from manure(gN/m2/s) + real(r8), pointer :: nfert_to_sminn (:) ! N deposition to soil mineral from fertilizer(gN/m2/s) + real(r8), pointer :: N_Run_Off (:) ! Nitrogen Run Off from manure (gN/m2/s) + real(r8), pointer :: N_Run_Off_fert (:) ! Nitrogen Run Off from fertilizer(gN/m2/s) + real(r8), pointer :: manure_f_n2o_nit (:) ! N2O emission from nitrification of manure (gN/m2/s) + real(r8), pointer :: manure_f_n2_denit (:) ! N2 emission from denitrification of manure (gN/m2/s) + real(r8), pointer :: manure_f_nox_nit (:) ! NOx emission from nitrification of manure (gN/m2/s) + real(r8), pointer :: fert_f_n2o_nit (:) ! N2O emission from nitrification of fertilizer (gN/m2/s) + real(r8), pointer :: fert_f_n2_denit (:) ! N2 emission from denitrification of fertilizer (gN/m2/s) + real(r8), pointer :: fert_f_nox_nit (:) ! NOx emission from nitrification of fertilizer (gN/m2/s) + real(r8), pointer :: no3_manure_to_soil (:) ! NO3 flow from manure to soil @ 25 % NO3 pool per hour (gN/m2/s) + real(r8), pointer :: TAN_manure_to_soil (:) ! NH4 flow from TAN manure to soil @ 1 % TAN pool per day (gN/m2/s) + real(r8), pointer :: no3_fert_to_soil (:) ! NO3 flow from fertilizer to soil @ 25 % NO3 pool per hour (gN/m2/s) + real(r8), pointer :: TAN_fert_to_soil (:) ! NH4 flow from TAN fertilizer to soil @ 1 % TAN pool per day (gN/m2/s) + real(r8), pointer :: Nd (:) ! Total Amount of N emitted during denitrification (gN/m2/s) + real(r8), pointer :: lat_fert (:) !KO + + real(r8), pointer :: ndep_total (:) ! Total nitrogen deposition rate (gN/m2) + real(r8), pointer :: TAN_manu (:) ! Manure Total Ammoniacal Nitrogen (gN/m2) + real(r8), pointer :: TAN_fert (:) ! Fertilizer Total Ammoniacal Nitrogen (gN/m2) + real(r8), pointer :: man_water_pool (:) ! Volume of water in manure/water solution (m3/m2) + real(r8), pointer :: fert_water_pool (:) ! Volume of water in fert/water solution (m3/m2) + real(r8), pointer :: no3_manure (:) ! NO3 pool in manure (gN/m2) + real(r8), pointer :: no3_fert (:) ! NO3 pool in fertilizer(gN/m2) + real(r8), pointer :: nh3_manure_total (:) ! Total NH3 created from manure to atmosphere (gN/m2) + real(r8), pointer :: no3_manure_total (:) ! Total NO3 created from manure(gN/m2) + real(r8), pointer :: nh4_manure_total (:) ! Total NH4 created from manure (gN/m2) + real(r8), pointer :: manure_u (:) ! Urine N pool in manure (gN/m2) + real(r8), pointer :: manure_n (:) ! Non-minerizable N pool in manure (gN/m2) + real(r8), pointer :: manure_a (:) ! Available N pool in manure (gN/m2) + real(r8), pointer :: manure_r (:) ! Resistant N pool in manure (gN/m2) + real(r8), pointer :: fert_u (:) ! Fertilizer N pool (gN/m2) + real(r8), pointer :: ndep_fert_total (:) ! Total nitrogen deposition rate of fertilizer(gN/m2) + real(r8), pointer :: nh3_fert_total (:) ! Total NH3 created from fertilizer to atmosphere (gN/m2) + real(r8), pointer :: no3_fert_total (:) ! Total NO3 created from fertilizer(gN/m2) + real(r8), pointer :: nh4_fert_total (:) ! Total NH4 created from fertilizer (gN/m2) + real(r8), pointer :: total_ndep (:) ! Total nitrogen deposition from Nr (gN/m2) + real(r8), pointer :: total_nh3 (:) ! Total NH3 created from Nr to atmosphere (gN/m2) + real(r8), pointer :: total_N_Run_Off (:) ! Total N washed from Nr (gN/m2) + real(r8), pointer :: total_no3 (:) ! Total NO3 created from Nr(gN/m2) + real(r8), pointer :: total_nh4 (:) ! Total NH4 created from Nr (gN/m2) + real(r8), pointer :: ra_col (:) ! Aerodynamic resistance for grass pfts (s/m) + real(r8), pointer :: rb_col (:) ! Leaf boundary layer resistance for grass pfts (s/m) + real(r8), pointer :: fert_app_jday (:) ! Julian day of the first fertilizer application (day) + real(r8), pointer :: gdd8_col (:) ! Col growing degree-days base 8C from planting (ddays) + real(r8), pointer :: t_a10_col (:) ! Col 10-day running mean of the 2 m temperature (K) + real(r8), pointer :: t_a10min_col (:) ! Col 10-day running mean of min 2-m temperature (K) + real(r8), pointer :: N_Run_Off_manure_total (:) ! Total N washed from manure (gN/m2) + real(r8), pointer :: N_Run_Off_fert_total (:) ! Total N washed from fertilizer (gN/m2) + + real(r8), pointer :: leafn_manure (:) ! Leaf N (gN/m2) + real(r8), pointer :: deadstemn_manure (:) ! Dead stem N eaten by cows (gN/m2) + + real(r8), pointer :: methane_manure (:) ! Emission of CH4 from cows (gC/m2/s) + real(r8), pointer :: cmanure_to_sminn (:) ! Deposition of C from manure to soil mineral C (gC/m2/s) + real(r8), pointer :: somhr (:) ! Soil organic matter heterotrophic respiration (gC/m2/s) + + real(r8), pointer :: total_leafc (:) ! Total C at column-level (gC/m2) + real(r8), pointer :: leafc (:) ! Leaf carbon (gC/m2) + real(r8), pointer :: leafc_manure (:) ! Leaf C eaten by cows (gC/m2) + real(r8), pointer :: deadstemc_manure (:) ! Dead stem C eaten by cows (gC/m2) + + real(r8), pointer :: t_grnd (:) ! Ground temperature (K) + real(r8), pointer :: gdd8_patch (:) ! patch Growing degree-days base 8C from planting (ddays) + real(r8), pointer :: t_a10_patch (:) ! patch 10-day running mean of the 2 m temperature (K) + real(r8), pointer :: t_a10min_patch (:) ! patch 10-day running mean of min 2-m temperature + + real(r8), pointer :: h2osoi_liqice_5cm (:) ! Liquid water + ice lens in top 5cm of soil (kg/m2) + real(r8), pointer :: qflx_runoff (:) ! Total runoff (qflx_drain+qflx_surf+qflx_qrgwl) (mm H2O /s) + + real(r8), pointer :: ram1 (:) ! Aerodynamical air resistance (s/m) + real(r8), pointer :: rb1 (:) ! Aerodynamical boundary layer resistance (s/m) +!KO !----------------------------------------------------------------------- associate( & forc_ndep => atm2lnd_inst%forc_ndep_grc , & ! Input: [real(r8) (:)] nitrogen deposition rate (gN/m2/s) ndep_to_sminn => soilbiogeochem_nitrogenflux_inst%ndep_to_sminn_col & ! Output: [real(r8) (:)] atmospheric N deposition to soil mineral N (gN/m2/s) ) - +!KO + if ( use_fan ) then + + gridcell => col%gridcell + npfts => col%npatches + pfti => col%patchi + latdeg => grc%latdeg + + forc_wind => atm2lnd_inst%forc_wind_grc + forc_rh => atm2lnd_inst%forc_rh_grc + forc_ndep2 => atm2lnd_inst%forc_ndep2_grc + forc_ndep3 => atm2lnd_inst%forc_ndep3_grc + + ndep_manure => soilbiogeochem_nitrogenflux_inst%ndep_manure_col + ndep_fert => soilbiogeochem_nitrogenflux_inst%ndep_fert_col + nh3_manure => soilbiogeochem_nitrogenflux_inst%nh3_manure_col + gamma_nh3 => soilbiogeochem_nitrogenflux_inst%gamma_nh3_col + gamma_nh3_fert => soilbiogeochem_nitrogenflux_inst%gamma_nh3_fert_col + nh3_fert => soilbiogeochem_nitrogenflux_inst%nh3_fert_col + nhxdep_to_sminn => soilbiogeochem_nitrogenflux_inst%nhxdep_to_sminn_col + noydep_to_sminn => soilbiogeochem_nitrogenflux_inst%noydep_to_sminn_col + nmanure_to_sminn => soilbiogeochem_nitrogenflux_inst%nmanure_to_sminn_col + nfert_to_sminn => soilbiogeochem_nitrogenflux_inst%nfert_to_sminn_col + N_Run_Off => soilbiogeochem_nitrogenflux_inst%N_Run_Off_col + N_Run_Off_fert => soilbiogeochem_nitrogenflux_inst%N_Run_Off_fert_col + manure_f_n2o_nit => soilbiogeochem_nitrogenflux_inst%manure_f_n2o_nit_col + manure_f_n2_denit => soilbiogeochem_nitrogenflux_inst%manure_f_n2_denit_col + manure_f_nox_nit => soilbiogeochem_nitrogenflux_inst%manure_f_nox_nit_col + fert_f_n2o_nit => soilbiogeochem_nitrogenflux_inst%fert_f_n2o_nit_col + fert_f_n2_denit => soilbiogeochem_nitrogenflux_inst%fert_f_n2_denit_col + fert_f_nox_nit => soilbiogeochem_nitrogenflux_inst%fert_f_nox_nit_col + no3_manure_to_soil => soilbiogeochem_nitrogenflux_inst%no3_manure_to_soil_col + TAN_manure_to_soil => soilbiogeochem_nitrogenflux_inst%TAN_manure_to_soil_col + no3_fert_to_soil => soilbiogeochem_nitrogenflux_inst%no3_fert_to_soil_col + TAN_fert_to_soil => soilbiogeochem_nitrogenflux_inst%TAN_fert_to_soil_col + Nd => soilbiogeochem_nitrogenflux_inst%Nd_col + lat_fert => soilbiogeochem_nitrogenflux_inst%lat_fert_col + + ndep_total => soilbiogeochem_nitrogenstate_inst%ndep_total_col + TAN_manu => soilbiogeochem_nitrogenstate_inst%TAN_manu_col + TAN_fert => soilbiogeochem_nitrogenstate_inst%TAN_fert_col + man_water_pool => soilbiogeochem_nitrogenstate_inst%man_water_pool_col + fert_water_pool => soilbiogeochem_nitrogenstate_inst%fert_water_pool_col + no3_manure => soilbiogeochem_nitrogenstate_inst%no3_manure_col + no3_fert => soilbiogeochem_nitrogenstate_inst%no3_fert_col + nh3_manure_total => soilbiogeochem_nitrogenstate_inst%nh3_manure_total_col + no3_manure_total => soilbiogeochem_nitrogenstate_inst%no3_manure_total_col + nh4_manure_total => soilbiogeochem_nitrogenstate_inst%nh4_manure_total_col + manure_u => soilbiogeochem_nitrogenstate_inst%manure_u_col + manure_n => soilbiogeochem_nitrogenstate_inst%manure_n_col + manure_a => soilbiogeochem_nitrogenstate_inst%manure_a_col + manure_r => soilbiogeochem_nitrogenstate_inst%manure_r_col + fert_u => soilbiogeochem_nitrogenstate_inst%fert_u_col + ndep_fert_total => soilbiogeochem_nitrogenstate_inst%ndep_fert_total_col + nh3_fert_total => soilbiogeochem_nitrogenstate_inst%nh3_fert_total_col + no3_fert_total => soilbiogeochem_nitrogenstate_inst%no3_fert_total_col + nh4_fert_total => soilbiogeochem_nitrogenstate_inst%nh4_fert_total_col + total_ndep => soilbiogeochem_nitrogenstate_inst%total_ndep_col + total_nh3 => soilbiogeochem_nitrogenstate_inst%total_nh3_col + total_N_Run_Off => soilbiogeochem_nitrogenstate_inst%total_N_Run_Off_col + total_no3 => soilbiogeochem_nitrogenstate_inst%total_no3_col + total_nh4 => soilbiogeochem_nitrogenstate_inst%total_nh4_col + ra_col => soilbiogeochem_nitrogenstate_inst%ra_col + rb_col => soilbiogeochem_nitrogenstate_inst%rb_col + fert_app_jday => soilbiogeochem_nitrogenstate_inst%fert_app_jday_col + gdd8_col => soilbiogeochem_nitrogenstate_inst%gdd8_col + t_a10_col => soilbiogeochem_nitrogenstate_inst%t_a10_col + t_a10min_col => soilbiogeochem_nitrogenstate_inst%t_a10min_col + N_Run_Off_manure_total => soilbiogeochem_nitrogenstate_inst%N_Run_Off_manure_total_col + N_Run_Off_fert_total => soilbiogeochem_nitrogenstate_inst%N_Run_Off_fert_total_col + + leafn_manure => cnveg_nitrogenstate_inst%leafn_manure_patch + deadstemn_manure => cnveg_nitrogenstate_inst%deadstemn_manure_patch + + methane_manure => soilbiogeochem_carbonflux_inst%methane_manure_col + cmanure_to_sminn => soilbiogeochem_carbonflux_inst%cmanure_to_sminn_col + somhr => soilbiogeochem_carbonflux_inst%somhr_col + + total_leafc => cnveg_carbonstate_inst%total_leafc_col + leafc => cnveg_carbonstate_inst%leafc_patch + leafc_manure => cnveg_carbonstate_inst%leafc_manure_patch + deadstemc_manure => cnveg_carbonstate_inst%deadstemc_manure_patch + + t_grnd => temperature_inst%t_grnd_col + gdd8_patch => temperature_inst%gdd8_patch + t_a10_patch => temperature_inst%t_a10_patch + t_a10min_patch => temperature_inst%t_a10min_patch + + h2osoi_liqice_5cm => waterstate_inst%h2osoi_liqice_5cm_col + + qflx_runoff => waterflux_inst%qflx_runoff_col + + ram1 => frictionvel_inst%ram1_patch + rb1 => frictionvel_inst%rb1_patch + + end if +!KO + +!KO ! Loop through columns do c = bounds%begc, bounds%endc g = col%gridcell(c) ndep_to_sminn(c) = forc_ndep(g) + end do + + if ( use_fan ) then + + fmm = 0._r8 + na = 0._r8 + ca = 0._r8 + pl = 1.0_r8 + pd = 0._r8 + cn = 30._r8 !Carbon:nitrogen + fua = 0.2_r8 + fu = 0.5_r8 + ffa = 0.27_r8 + ff = 0.5_r8 + + !*pgmh urea decomposition rate (1/s) + kf = 4.83e-06_r8 ! [Agehara and Warncke, 2005 + dnh4 = 9.8e-10_r8 ! from genermont and cellier + dno3 = 1.3e-08_r8 ! fast x13 than dnh4 consistent with data + porosity = 0.5_r8 + !*pgmh + canopy_frac = 0.6_r8 + + call get_curr_date(yr, mon, day, sec) + m1850 = 0.00000000004_r8 * exp(0.012_r8 * yr) + f1850 = 1.05_r8/(1._r8+exp(0.13_r8*(1975-yr))) + + dt = real( get_step_size(), r8 ) +!KO + + ! Loop through columns + do c = bounds%begc, bounds%endc + g = col%gridcell(c) +!KO ndep_to_sminn(c) = forc_ndep(g) +!KO + !calculate the nitrogen excreted (kg ha-1 s-1) by cows from file + !Nmanure.nc, then change to (g m-2 s-1) + + ndep_manure(c) = forc_ndep2(g) / (10._r8) * m1850 + ndep_fert(c) = forc_ndep3(g) / (10._r8) * f1850 + + lat_fert(c) = latdeg(g) + + !Remove any NaN values + if (ndep_manure(c) .ne. ndep_manure(c)) ndep_manure(c) = 0._r8 + if (ndep_fert(c) .ne. ndep_fert(c)) ndep_fert(c) = 0._r8 +!KO end do +!KO + ! Convert pft-level variables to column-level for computing fertilizer application date and + ! aerodynamic resistance factors. These conversions will not be necessary once this code is + ! implemented in the crop model where crop calculations are done on their own column. + call p2c(bounds, num_soilc, filter_soilc, & + ram1(bounds%begp:bounds%endp), & + ra_col(bounds%begc:bounds%endc)) + call p2c(bounds, num_soilc, filter_soilc, & + rb1(bounds%begp:bounds%endp), & + rb_col(bounds%begc:bounds%endc)) + call p2c(bounds, num_soilc, filter_soilc, & + gdd8_patch(bounds%begp:bounds%endp), & + gdd8_col(bounds%begc:bounds%endc)) + call p2c(bounds, num_soilc, filter_soilc, & + t_a10_patch(bounds%begp:bounds%endp), & + t_a10_col(bounds%begc:bounds%endc)) + call p2c(bounds, num_soilc, filter_soilc, & + t_a10min_patch(bounds%begp:bounds%endp), & + t_a10min_col(bounds%begc:bounds%endc)) + + do fc = 1,num_soilc + c = filter_soilc(fc) + + do pi = 1,max_patch_per_col + if ( pi <= npfts(c) ) then + p = pfti(c) + pi - 1 +!KO + if (patch%active(p)) then +!KO +!KO total_leafc(c) = total_leafc(c) + leafc(p) +!KO + total_leafc(c) = total_leafc(c) + leafc(p) * patch%wtcol(p) +!KO + end if + end if + end do + + ! Fertilize crops 1 time a year when planting conditions are first met. The conditions + ! for corn planting are used here for all crops. The earliest date of planting is April + ! 1st and the latest date is June 14th for the NHemis, add 180 days for Shemis planting + jday = get_curr_calday() + + if (jday .eq. 1) fert_app_jday(c) = 0._r8 + + if (t_a10_col(c) >= 283.15_r8 .and. t_a10min_col(c) >= 279.15_r8 .and. & + gdd8_col(c) >= 50._r8 .and. fert_app_jday(c) .eq. 0._r8 .and. & + jday .gt. 90._r8 .and. lat_fert(c) .gt. 0._r8) fert_app_jday(c) = jday + if (t_a10_col(c) >= 283.15_r8 .and. t_a10min_col(c) >= 279.15_r8 .and. & + gdd8_col(c) >= 50._r8 .and. fert_app_jday(c) .eq. 0._r8 .and. & + jday .gt. 272._r8 .and. lat_fert(c) .lt. 0._r8) fert_app_jday(c) = jday + + if (jday .eq. 165._r8 .and. lat_fert(c) .gt. 0._r8 .and. fert_app_jday(c) .eq. 0._r8) fert_app_jday(c) = jday + if (jday .eq. 347._r8 .and. lat_fert(c) .lt. 0._r8 .and. fert_app_jday(c) .eq. 0._r8) fert_app_jday(c) = jday + + ! Add fertilizer (ndep_fertilizer) + if (jday .eq. fert_app_jday(c)) then + ndep_fertilizer = (ndep_fert(c) * 3600._r8 * 24._r8 * 365._r8 ) + + ! If there is any N in existing fertilizer pools, add this to the soil pool (later on in code) + ! before adding the new fertilizer N to the TAN_fert pool. + fert_inc = TAN_fert(c)+fert_u(c) + fert_u(c) = 0._r8 + TAN_fert(c) = 0._r8 + else + !KO fert_inc needs to be set here, for now assume 0? + fert_inc = 0._r8 + ndep_fertilizer = 0._r8 + end if + + fert_u(c) = fert_u(c) + ndep_fertilizer + + ! Fertilizer decay into the TAN pool following King and Balogh, 2000 (using one day timescale) + if (t_grnd(c) <= 273._r8) then + loss_fert_u = 0._r8 + else +!*pgmh changed to a rate consistent with urea +! loss_fert_u = fert_u(c)*(1._r8 - exp(-1._r8 * dt * (0.04_r8/(86400._r8)) *(((t_grnd(c) - 273._r8) / 38._r8))**1.33_r8)) + fert_u(c) = fert_u(c) / (1._r8+dt*kf) + loss_fert_u = dt * kf * fert_u(c) + TAN_fert(c) = TAN_fert(c) + loss_fert_u + end if + +! TAN_fert(c) = TAN_fert(c) + loss_fert_u +! fert_u(c) = fert_u(c) - loss_fert_u +!*pgmh + ! Manure decay into TAN pool + + ! Here the N from manure is divided into separate pools. + ! Urine (urea) is 50 % of the N excreted by the animals (Parton et al., 1987) + ! Non-mineralizable = 10 % feces N, Available = 44 % feces N & Resistant = 46 % feces N (Andrews, 1996) + + manure_u(c) = manure_u(c) + (ndep_manure(c)* 0.5_r8 *dt) + manure_n(c) = manure_n(c) + (0.025_r8 * ndep_manure(c) * dt) + manure_a(c) = manure_a(c) + (0.25_r8 * ndep_manure(c) * dt) + manure_r(c) = manure_r(c) + (0.225_r8 * ndep_manure(c) * dt) + + TF = 0.0106_r8 * exp(0.12979_r8 * (t_grnd(c) - 273._r8)) + + loss_manure_u = manure_u(c) + loss_manure_n = 0._r8 + loss_manure_a = manure_a(c) * (1._r8 - exp(TF * (8.938e-7_r8 * (-1._r8) * dt))) + loss_manure_r = manure_r(c) * (1._r8 - exp(TF * (6.38e-8_r8 * (-1._r8) * dt))) + + TAN_manu(c) = TAN_manu(c) + loss_manure_u + loss_manure_n + loss_manure_a + loss_manure_r + + ! Represent mechanical incorporation of manure into soil, timescale of one year + manu_inc = (dt/(365._r8 * 86400._r8)) * (manure_r(c) + manure_a(c)) + + manure_u(c) = manure_u(c) - loss_manure_u + manure_n(c) = manure_n(c) - loss_manure_n + manure_r(c) = manure_r(c) - loss_manure_r - (dt/(365._r8 * 86400._r8))*manure_r(c) + manure_a(c) = manure_a(c) - loss_manure_a - (dt/(365._r8 * 86400._r8))*manure_a(c) + + ! Take N content of manure as 1% dry matter and the water content of manure as 85% of total mass + ! Thus, the water content added is 567 times the N content added at each timstep. + k_relax = dt/(3._r8*86400._r8) + + ! Add manure water and relax the manure water content to the water content of the top 5 cm of soil + ! on a timescale of 3 days (k_relax) + if (TAN_manu(c) .gt. 0._r8) then + man_water_pool(c) = man_water_pool(c)+(1.e-6_r8*ndep_manure(c)*dt*566.6667_r8) - & + k_relax*(man_water_pool(c)-h2osoi_liqice_5cm(c)*1.e-3_r8) + else + man_water_pool(c) = 0._r8 + TAN_manu(c) = 0._r8 + end if + + if (man_water_pool(c) .ne. man_water_pool(c)) man_water_pool(c) = 0._r8 + !Remove Manure TAN pool washed off by rain using the method of the global NEWS model (Harrison et al., 2005) + if (TAN_manu(c) <= 0._r8) then + N_Run_Off(c) = 0._r8 + TAN_manu(c) = 0._r8 +!*pgmh convert qflx_surf from mm/sec to m/sec +! elseif ((0.94_r8 * TAN_manu(c) * (qflx_surf(c)))*dt > TAN_manu(c)) then + elseif ((TAN_manu(c)/man_water_pool(c) * (qflx_runoff(c)*1.e-3_r8))*dt > TAN_manu(c)) then +!*pgmh + N_Run_Off(c) = TAN_manu(c) / dt + else +!*pgmh convert qflx_surf from mm/sec to m/sec +! N_Run_Off(c) = 0.94_r8 * TAN_manu(c) * (qflx_surf(c)) + N_Run_Off(c) = TAN_manu(c)/man_water_pool(c) * (qflx_runoff(c)*1.e-3_r8) +!*pgmh + end if + +!KO TAN_manu(c) = TAN_manu(c) - N_Run_Off(c)*dt +!KO + ! Protect against negative values of TAN_manu which can cause divide by + ! zero errors in NFactor below, and adjust N_Run_Off accordingly + TAN_manu(c) = TAN_manu(c) - min(N_Run_Off(c)*dt,TAN_manu(c)) + N_Run_Off(c) = min(N_Run_Off(c),TAN_manu(c)/dt) +!KO + + ! Calculate nh3_gas_conc. (PGMH 29th August 2014). Note that a neutral pH is assumed (1.e-7) and that + ! the units of nh3_gas_conc are g/m3. If the column is completely dry, the nh3_gas_conc is set to zero. + kh = 56._r8*exp(4092._r8*((1._r8/t_grnd(c))-(1._r8/298.15_r8))) + knh4 = 5.67e-10_r8*exp(-6286._r8*((1._r8/t_grnd(c))-(1._r8/298.15_r8))) ! [mole/Liter] + + if (man_water_pool(c) .le. 0._r8) then + man_water_pool(c) = 0._r8 + nh3_gas_conc = 0._r8 + else + nh3_gas_conc = (TAN_manu(c)/man_water_pool(c))/ & + (1._r8+(kh*t_grnd(c)/12.2_r8)+(kh*t_grnd(c)/12.2_r8)*(1.e-7_r8/knh4)) + endif + + ! Compute nh3 saturation with respect to the aqueous concentration of nh3 + nh3_aq_conc = (t_grnd(c)/12.2_r8)*kh*nh3_gas_conc ! [g/m3] + nh3_aq_sat = (10._r8**((966.7475_r8/t_grnd(c))-0.57953_r8))*1.e3_r8 ! [g/m3] + + if (nh3_aq_conc .gt. nh3_aq_sat) then + nh3_aq_conc=nh3_aq_sat + nh3_gas_conc=nh3_aq_sat*(12.2_r8/t_grnd(c))*(1._r8/kh) + endif + + ! Calculate NH3 emission + if (nh3_gas_conc < 3.e-7_r8) then + nh3_manure(c) = 0._r8 + else +!*pgmh +! nh3_manure(c) = ((nh3_gas_conc-3.e-7)/(ra_col(c)+rb_col(c))) * 0.35_r8 + nh3_manure(c) = ((nh3_gas_conc-3.e-7_r8)/(ra_col(c)+rb_col(c))) * (1._r8-canopy_frac) +!*pgmh + end if + + if (nh3_manure(c) .ne. nh3_manure(c)) nh3_manure(c) = 0._r8 + + !Calculate the amount of water in TAN of Fertilizer. Water is added when fertilizer + ! is applied, and then the total water pool is relaxed to the water in the top 5cm of soil + if (TAN_fert(c) .gt. 0._r8) then + fert_water_pool(c) = fert_water_pool(c)+(((1.e-6_r8*(ndep_fertilizer*dt))/0.466_r8)/ & + (0.66_r8 *exp(0.0239_r8*(t_grnd(c)-273._r8))))-& + k_relax*(fert_water_pool(c)-h2osoi_liqice_5cm(c)*1.e-3_r8) + else + fert_water_pool(c) = 0._r8 + TAN_fert(c) = 0._r8 + end if + + if (fert_water_pool(c) .ne. fert_water_pool(c)) fert_water_pool(c) = 0._r8 + + !Remove Fertilizer TAN pool washed off by rain at rate of the global NEWS model (Harrison et al., 2005) + if (TAN_fert(c) <= 0._r8) then + N_Run_Off_fert(c) = 0._r8 + TAN_fert(c) = 0._r8 +!*pgmh convert qflx_surf from mm/sec to m/sec +! elseif ((0.94_r8 * TAN_fert(c) *(qflx_surf(c)))*dt > TAN_fert(c)) then + elseif ((TAN_fert(c)/fert_water_pool(c) *(qflx_runoff(c)*1.e-3_r8))*dt > TAN_fert(c)) then +!*pgmh + N_Run_Off_fert(c) = TAN_fert(c) / dt + else +!*pgmh convert qflx_surf from mm/sec to m/sec +! N_Run_Off_fert(c) = 0.94_r8 * TAN_fert(c) *(qflx_surf(c)) + N_Run_Off_fert(c) = TAN_fert(c)/fert_water_pool(c) *(qflx_runoff(c)*1.e-3_r8) +!*pgmh + end if +!KO TAN_fert(c) = TAN_fert(c) - N_Run_Off_fert(c)*dt +!KO + ! Protect against negative values of TAN_fert which can cause divide by + ! zero errors in NFactor below, and adjust N_Run_Off_fert accordingly + TAN_fert(c) = TAN_fert(c) - min(N_Run_Off_fert(c)*dt,TAN_fert(c)) + N_Run_Off_fert(c) = min(N_Run_Off_fert(c),TAN_fert(c)/dt) +!KO + + !Calculate gamma for fertilizer + if (fert_water_pool(c) .le. 0._r8) then + fert_water_pool(c) = 0._r8 + fert_nh3_gas_conc = 0._r8 + else + fert_nh3_gas_conc = (TAN_fert(c)/fert_water_pool(c))/ & + (1._r8+(kh*t_grnd(c)/12.2_r8)+(kh*t_grnd(c)/12.2_r8)*(1.e-7_r8/knh4)) + endif + + ! Compute nh3 saturation with respect to the aqueous concentration of nh3 + nh3_aq_conc = (t_grnd(c)/12.2_r8)*kh*fert_nh3_gas_conc ! [g/m3] + + if (nh3_aq_conc .gt. nh3_aq_sat) then + nh3_aq_conc=nh3_aq_sat + fert_nh3_gas_conc=nh3_aq_sat*(12.2_r8/t_grnd(c))*(1._r8/kh) + endif + + ! Calculate NH3 emission + if (fert_nh3_gas_conc < 3.e-7_r8) then + nh3_fert(c) = 0._r8 + else +!*pgmh +! nh3_fert(c) = ((fert_nh3_gas_conc-3.e-7)/(ra_col(c)+rb_col(c))) * 0.35_r8 + nh3_fert(c) = ((fert_nh3_gas_conc-3.e-7_r8)/(ra_col(c)+rb_col(c))) * (1._r8-canopy_frac) +!*pgmh + end if + if (nh3_fert(c) .ne. nh3_fert(c)) nh3_fert(c)=0._r8 + + ! Calculate transfert to soil organic matter + NH4_manu = (kh*t_grnd(c)/12.2_r8)*(1.e-7_r8/knh4)*nh3_gas_conc*man_water_pool(c) + if (t_grnd(c) > 313._r8) then + !nmanure_to_sminn(c) = 0._r8 +!*dsw set to canopy captured N for very high temperatures + nmanure_to_sminn(c) = (nh3_manure(c) / (1._r8-canopy_frac) * canopy_frac) + else +!*pgmh units incorect for conversion, also assume 70% leave capture +! nmanure_to_sminn(c) = ((2.*1.16e-6*NH4_manu) / ((1./(1.0 - exp(-1.0 * ((h2osoi_liqice_5cm(c)*9.5e-3)/ 0.12)**2.0))) & +! +(1./((((40. - (t_grnd(c)-273.))/12.)**2.4) * exp(0.2*((t_grnd(c)-273.)-28.)))))) & +! +(nh3_manure(c) / 0.35_r8 * 0.65_r8) + nmanure_to_sminn(c) = ((2._r8*1.16e-6_r8*NH4_manu) / & + ((1._r8/(1._r8 - exp(-1._r8 * ((h2osoi_liqice_5cm(c)*0.019_r8)/ 0.12_r8)**2._r8))) + & + (1._r8/((((40._r8 - (t_grnd(c)-273._r8))/12._r8)**2.4_r8) * & + exp(0.2_r8*((t_grnd(c)-273._r8)-28._r8)))))) & + +(nh3_manure(c) / (1._r8-canopy_frac) * canopy_frac) +!*pgmh units incorect for conversion + end if + + ! Calculate soil organic matter + NH4_fert = (kh*t_grnd(c)/12.2_r8)*(1.e-7_r8/knh4)*fert_nh3_gas_conc*fert_water_pool(c) + if (t_grnd(c) > 313._r8) then +! nfert_to_sminn(c) = 0._r8 +!*dsw set to canopy captured N for very high temperatures + nfert_to_sminn(c) = (nh3_fert(c) / (1._r8-canopy_frac) * canopy_frac) + else +!*pgmh units incorect for conversion +! nfert_to_sminn(c) = ((2.*1.16e-6*NH4_fert) / ((1./(1.0 - exp(-1.0 * ((h2osoi_liqice_5cm(c)*9.5e-3)/0.12)**2.0))) & +! +(1./((((40. - (t_grnd(c)-273.))/12.)**2.4) * exp(0.2*((t_grnd(c)-273.)-28.)))))) & +! +(nh3_fert(c) / 0.35_r8 * 0.65_r8) + + nfert_to_sminn(c) = ((2._r8*1.16e-6_r8*NH4_fert) / & + ((1._r8/(1._r8 - exp(-1._r8 * ((h2osoi_liqice_5cm(c)*0.019_r8)/0.12_r8)**2._r8))) + & + (1._r8/((((40._r8 - (t_grnd(c)-273._r8))/12._r8)**2.4_r8) * & + exp(0.2_r8*((t_grnd(c)-273._r8)-28._r8)))))) & + +(nh3_fert(c) / (1._r8-canopy_frac) * canopy_frac) +!*pgmh units incorect for conversion + end if + + !Calculate N2O & NOx fluxes from nitrification of manure and fertilizer + + manure_f_n2o_nit(c) = nmanure_to_sminn(c) * 0.0_r8 !0.02_r8 + fert_f_n2o_nit(c) = nfert_to_sminn(c) * 0.0_r8 !0.02_r8 + + ! NOx FLUXES + !------------ + + ! Ratio of NOx to N2O from nit or denit: eq 5, Parton '01. Add soi_gd later for now soi_gd = 0.1 + R_nox_to_n2o = 15.2_r8+(35.5_r8*ATAN(0.68_r8*3.14_r8*(10._r8*0.4_r8 -1.86_r8)))/3.14_r8 + + manure_f_nox_nit(c) = manure_f_n2o_nit(c) * R_nox_to_n2o + fert_f_nox_nit(c) = fert_f_n2o_nit(c) * R_nox_to_n2o + + nh3_manure(c) = abs(nh3_manure(c)) + nmanure_to_sminn(c) = abs(nmanure_to_sminn(c)) + manure_f_n2o_nit(c) = abs(manure_f_n2o_nit(c)) + manure_f_nox_nit(c) = abs(manure_f_nox_nit(c)) + N_Run_Off(c) = abs(N_Run_Off(c)) + nh3_fert(c) = abs(nh3_fert(c)) + nfert_to_sminn(c) = abs(nfert_to_sminn(c)) + fert_f_n2o_nit(c) = abs(fert_f_n2o_nit(c)) + fert_f_nox_nit(c) = abs(fert_f_nox_nit(c)) + N_Run_Off_fert(c) = abs(N_Run_Off_fert(c)) + + if (TAN_manu(c) <((nh3_manure(c)+ nmanure_to_sminn(c) + manure_f_n2o_nit(c) + manure_f_nox_nit(c) )*dt)) then + NFactor = (nh3_manure(c) + nmanure_to_sminn(c)+ manure_f_n2o_nit(c) + manure_f_nox_nit(c) ) + nh3_manure(c) = nh3_manure(c) * (TAN_manu(c)/dt) / NFactor + nmanure_to_sminn(c) = nmanure_to_sminn(c) * (TAN_manu(c)/dt) / NFactor + manure_f_n2o_nit(c) = manure_f_n2o_nit(c) * (TAN_manu(c)/dt) / NFactor + manure_f_nox_nit(c) = manure_f_nox_nit(c) * (TAN_manu(c)/dt) / NFactor + + TAN_manu(c) = 0._r8 + else + TAN_manu(c) = TAN_manu(c) - ((nh3_manure(c) + nmanure_to_sminn(c) + manure_f_n2o_nit(c) + manure_f_nox_nit(c) )*dt) + end if + + if (TAN_fert(c) <((nh3_fert(c)+ nfert_to_sminn(c) + fert_f_n2o_nit(c) + fert_f_nox_nit(c) )*dt)) then + NFactor = (nh3_fert(c) + nfert_to_sminn(c) + fert_f_n2o_nit(c) + fert_f_nox_nit(c) ) + nh3_fert(c) = nh3_fert(c) * (TAN_fert(c)/dt) / NFactor + nfert_to_sminn(c) = nfert_to_sminn(c) * (TAN_fert(c)/dt) / NFactor + fert_f_n2o_nit(c) = fert_f_n2o_nit(c) * (TAN_fert(c)/dt) / NFactor + fert_f_nox_nit(c) = fert_f_nox_nit(c) * (TAN_fert(c)/dt) / NFactor + + TAN_fert(c) = 0._r8 + else + TAN_fert(c) = TAN_fert(c) - ((nh3_fert(c) + nfert_to_sminn(c) + fert_f_n2o_nit(c) + fert_f_nox_nit(c) )*dt) + end if + + !Add N from mechanical incorporation into soil N pools + nmanure_to_sminn(c)=nmanure_to_sminn(c)+manu_inc/dt + nfert_to_sminn(c)=nfert_to_sminn(c)+fert_inc/dt + +!*pgmh!!!!! diffusion times for lengths of 1 cm (dz^2=1.e-4 m) +! ratenh4tosom=1.e-4*dnh4*(1.03**(t_grnd(c)-273.))*((man_water_pool(c)/5.e-2)**(10./3.))/(porosity**2.) +! rateno3tosom=1.e-4*dno3*(1.03**(t_grnd(c)-273.))*((fert_water_pool(c)/5.e-2)**(10./3.))/(porosity**2.) + ratenh4tosom = 1.e4_r8*dnh4*(1.03_r8**(t_grnd(c)-273._r8)) * & + ((man_water_pool(c)/5.e-2_r8)**(10._r8/3._r8))/(porosity**2._r8) + rateno3tosom = 1.e4_r8*dno3*(1.03_r8**(t_grnd(c)-273._r8)) * & + ((fert_water_pool(c)/5.e-2_r8)**(10._r8/3._r8))/(porosity**2._r8) + if (t_grnd(c) < 273.15_r8) then ! Turn vertical diffusion off when temperature is below freezing + ratenh4tosom = 0._r8 + rateno3tosom = 0._r8 + endif + +!*pgmh!!!!! + !Calculate rate that SOM forms NH4 to the soil +!*pgmh +! TAN_manure_to_soil(c) = 1.16e-7 * TAN_manu(c) + TAN_manure_to_soil(c) = ratenh4tosom * TAN_manu(c) +!*pgmh + TAN_manu(c) = TAN_manu(c) - (TAN_manure_to_soil(c) * dt) + +!*pgmh +! TAN_fert_to_soil(c) = 1.16e-7 * TAN_fert(c) + TAN_fert_to_soil(c) = ratenh4tosom * TAN_fert(c) +!*pgmh + TAN_fert(c) = TAN_fert(c) - (TAN_fert_to_soil(c) * dt) + + !Calculate rate that NO3- goes to soil +!* pgmh: at present all no3 goes to the soil in a timestep. nmanure_to_sminn goes back to the no3_pool. +!This includes nitrification and mechanical incorporation of manure (not correct!!) +!*pgmh +! no3_manure_to_soil(c) = (no3_manure(c) / dt) +! no3_manure(c) = (nmanure_to_sminn(c) * dt) +! +! no3_fert_to_soil(c) = (no3_fert(c) / dt) +! no3_fert(c) = (nfert_to_sminn(c) * dt) +!pgmh: suggested changes: use diffusion coefficient, correct for no3 pool and +! no3_manure_to_soil(c)=rateno3tosom * no3_manure(c) +! no3_manure(c)=no3_manure(c)+nmanure_to_sminn(c)*dt - (no3_manure_to_soil(c) * dt) +! no3_fert_to_soil(c)=rateno3tosom * no3_fert(c) +! no3_fert(c)=no3_fert(c) +nfert_to_sminn(c)*dt - (no3_fert_to_soil(c) * dt) +!*pgmh + no3_manure_to_soil(c) = rateno3tosom * no3_manure(c) + no3_fert_to_soil(c) = rateno3tosom * no3_fert(c) + no3_manure(c) = no3_manure(c) + nmanure_to_sminn(c)*dt + no3_fert(c) = no3_fert(c) + nfert_to_sminn(c)*dt + if (no3_manure_to_soil(c)*dt .gt. no3_manure(c)) no3_manure_to_soil(c) = no3_manure(c)/dt + if (no3_fert_to_soil(c)*dt .gt. no3_fert(c)) no3_fert_to_soil(c) = no3_fert(c)/dt + no3_fert(c) = no3_fert(c) - (no3_fert_to_soil(c) * dt) + no3_manure(c) = no3_manure(c) - (no3_manure_to_soil(c) * dt) + + ! Calculate NHx & NOy deposition as 45 & 55 % ndep_to_sminn, respectively + ! Then NHx and NOy as a fraction of average Ndep from Peter Hess + + call get_curr_date(yr, mon, day, sec) + if (mon .eq. 1) then + noydep_to_sminn(c) = 0.55_r8 * ndep_to_sminn(c) * 0.986_r8 + nhxdep_to_sminn(c) = 0.45_r8 * ndep_to_sminn(c) * 1.185_r8 + elseif (mon .eq. 2) then + noydep_to_sminn(c) = 0.55_r8 * ndep_to_sminn(c) * 0.894_r8 + nhxdep_to_sminn(c) = 0.45_r8 * ndep_to_sminn(c) * 1.496_r8 + elseif (mon .eq. 3) then + noydep_to_sminn(c) = 0.55_r8 * ndep_to_sminn(c) * 0.825_r8 + nhxdep_to_sminn(c) = 0.45_r8 * ndep_to_sminn(c) * 1.152_r8 + elseif (mon .eq. 4) then + noydep_to_sminn(c) = 0.55_r8 * ndep_to_sminn(c) * 0.792_r8 + nhxdep_to_sminn(c) = 0.45_r8 * ndep_to_sminn(c) * 1.013_r8 + elseif (mon .eq. 5) then + noydep_to_sminn(c) = 0.55_r8 * ndep_to_sminn(c) * 0.814_r8 + nhxdep_to_sminn(c) = 0.45_r8 * ndep_to_sminn(c) * 0.739_r8 + elseif (mon .eq. 6) then + noydep_to_sminn(c) = 0.55_r8 * ndep_to_sminn(c) * 1.201_r8 + nhxdep_to_sminn(c) = 0.45_r8 * ndep_to_sminn(c) * 0.833_r8 + elseif (mon .eq. 7) then + noydep_to_sminn(c) = 0.55_r8 * ndep_to_sminn(c) * 1.242_r8 + nhxdep_to_sminn(c) = 0.45_r8 * ndep_to_sminn(c) * 1.038_r8 + elseif (mon .eq. 8) then + noydep_to_sminn(c) = 0.55_r8 * ndep_to_sminn(c) * 1.141_r8 + nhxdep_to_sminn(c) = 0.45_r8 * ndep_to_sminn(c) * 0.718_r8 + elseif (mon .eq. 9) then + noydep_to_sminn(c) = 0.55_r8 * ndep_to_sminn(c) * 0.986_r8 + nhxdep_to_sminn(c) = 0.45_r8 * ndep_to_sminn(c) * 0.856_r8 + elseif (mon .eq. 10) then + noydep_to_sminn(c) = 0.55_r8 * ndep_to_sminn(c) * 0.964_r8 + nhxdep_to_sminn(c) = 0.45_r8 * ndep_to_sminn(c) * 0.808_r8 + elseif (mon .eq. 11) then + noydep_to_sminn(c) = 0.55_r8 * ndep_to_sminn(c) * 1.155_r8 + nhxdep_to_sminn(c) = 0.45_r8 * ndep_to_sminn(c) * 1.024_r8 + elseif (mon .eq. 12) then + noydep_to_sminn(c) = 0.55_r8 * ndep_to_sminn(c) * 1.021_r8 + nhxdep_to_sminn(c) = 0.45_r8 * ndep_to_sminn(c) * 1.137_r8 + endif + + !calculate the weighted amount of C and N eaten at the PFT level + do pi = 1,max_patch_per_col + if ( pi <= npfts(c) ) then +!KO + p = pfti(c) + pi - 1 + if (patch%active(p)) then +!KO + if (total_leafc(c) > 0._r8) then + leafc_manure(p) = leafc(p) * (cn * ((pl * ndep_manure(c))/(1._r8 - na))) * dt / total_leafc(c) + leafn_manure(p) = leafc(p) * ((pl * ndep_manure(c))/(1._r8 - na)) * dt / total_leafc(c) + deadstemc_manure(p) = leafc(p) * (cn * ((pd * ndep_manure(c))/(1._r8 - na))) * dt / total_leafc(c) + deadstemn_manure(p) = leafc(p) * ((pd * ndep_manure(c))/(1._r8 - na)) * dt / total_leafc(c) + else + leafc_manure(p) = 0._r8 + leafn_manure(p) = 0._r8 + deadstemc_manure(p) = 0._r8 + deadstemn_manure(p) = 0._r8 + end if + end if + end if + end do + + end do ! End column loop + + end if ! End use_fan +!KO end associate - end subroutine CNNDeposition + end subroutine CNNDeposition_Old !----------------------------------------------------------------------- subroutine CNFreeLivingFixation(num_soilc, filter_soilc, & diff --git a/src/biogeochem/CNPhenologyMod.F90 b/src/biogeochem/CNPhenologyMod.F90 index 9d66373085..59cceaf76a 100644 --- a/src/biogeochem/CNPhenologyMod.F90 +++ b/src/biogeochem/CNPhenologyMod.F90 @@ -25,6 +25,7 @@ module CNPhenologyMod use CNVegCarbonFluxType , only : cnveg_carbonflux_type use CNVegnitrogenstateType , only : cnveg_nitrogenstate_type use CNVegnitrogenfluxType , only : cnveg_nitrogenflux_type + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type use CropType , only : crop_type use pftconMod , only : pftcon use SoilStateType , only : soilstate_type @@ -244,6 +245,7 @@ subroutine CNPhenology (bounds, num_soilc, filter_soilc, num_soilp, & canopystate_inst, soilstate_inst, dgvs_inst, & cnveg_state_inst, cnveg_carbonstate_inst, cnveg_carbonflux_inst, & cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_nitrogenstate_inst, & c13_cnveg_carbonstate_inst, c14_cnveg_carbonstate_inst, & leaf_prof_patch, froot_prof_patch, phase) ! !USES: @@ -276,6 +278,7 @@ subroutine CNPhenology (bounds, num_soilc, filter_soilc, num_soilp, & type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst type(cnveg_carbonstate_type) , intent(inout) :: c13_cnveg_carbonstate_inst type(cnveg_carbonstate_type) , intent(inout) :: c14_cnveg_carbonstate_inst + type(soilbiogeochem_nitrogenstate_type), intent(inout) :: soilbiogeochem_nitrogenstate_inst real(r8) , intent(in) :: leaf_prof_patch(bounds%begp:,1:) real(r8) , intent(in) :: froot_prof_patch(bounds%begp:,1:) integer , intent(in) :: phase @@ -307,6 +310,7 @@ subroutine CNPhenology (bounds, num_soilc, filter_soilc, num_soilp, & call CropPhenology(num_pcropp, filter_pcropp, & waterstate_inst, temperature_inst, crop_inst, canopystate_inst, cnveg_state_inst, & cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst, & + soilbiogeochem_nitrogenstate_inst, & c13_cnveg_carbonstate_inst, c14_cnveg_carbonstate_inst) end if else if ( phase == 2 ) then @@ -1420,6 +1424,7 @@ end subroutine CNStressDecidPhenology subroutine CropPhenology(num_pcropp, filter_pcropp , & waterstate_inst, temperature_inst, crop_inst, canopystate_inst, cnveg_state_inst , & cnveg_carbonstate_inst, cnveg_nitrogenstate_inst, cnveg_carbonflux_inst, cnveg_nitrogenflux_inst,& + soilbiogeochem_nitrogenstate_inst, & c13_cnveg_carbonstate_inst, c14_cnveg_carbonstate_inst) ! !DESCRIPTION: @@ -1434,9 +1439,11 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & use pftconMod , only : nirrig_trp_corn, nirrig_sugarcane, nirrig_trp_soybean use pftconMod , only : nirrig_cotton, nirrig_rice use clm_varcon , only : spval, secspday - use clm_varctl , only : use_fertilizer + use clm_varctl , only : use_fertilizer, use_fan use clm_varctl , only : use_c13, use_c14 use clm_varcon , only : c13ratio, c14ratio + use LandunitType , only: lun + ! ! !ARGUMENTS: integer , intent(in) :: num_pcropp ! number of prog crop patches in filter @@ -1450,6 +1457,7 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(soilbiogeochem_nitrogenstate_type), intent(inout) :: soilbiogeochem_nitrogenstate_inst type(cnveg_carbonstate_type) , intent(inout) :: c13_cnveg_carbonstate_inst type(cnveg_carbonstate_type) , intent(inout) :: c14_cnveg_carbonstate_inst ! @@ -1468,6 +1476,7 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & real(r8) dayspyr ! days per year real(r8) crmcorn ! comparitive relative maturity for corn real(r8) ndays_on ! number of days to fertilize + real(r8) manure_avail ! manure nitrogen available in the beginning of fertilization !------------------------------------------------------------------------ associate( & @@ -1524,7 +1533,9 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & leafn_xfer => cnveg_nitrogenstate_inst%leafn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) leaf N transfer crop_seedn_to_leaf => cnveg_nitrogenflux_inst%crop_seedn_to_leaf_patch, & ! Output: [real(r8) (:) ] (gN/m2/s) seed source to leaf cphase => crop_inst%cphase_patch , & ! Output: [real(r8) (:)] phenology phase - fert => cnveg_nitrogenflux_inst%fert_patch & ! Output: [real(r8) (:) ] (gN/m2/s) fertilizer applied each timestep + fert => cnveg_nitrogenflux_inst%fert_patch , & ! Output: [real(r8) (:) ] (gN/m2/s) fertilizer applied each timestep + manu => cnveg_nitrogenflux_inst%manu_patch , & ! Output: [real(r8) (:) ] (gN/m2/s) manure applied each timestep + manurestore => soilbiogeochem_nitrogenstate_inst%man_n_stored_col & ! Input: [real(r8) (:) ] manure nitrogen available for fertilization ) ! get time info @@ -1933,17 +1944,25 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & hui(p) = max(hui(p),huigrain(p)) endif + !write(iulog,*) 'cropmodel, manu', manure_avail, manu(p) if (leafout(p) >= huileaf(p) .and. hui(p) < huigrain(p) .and. idpp < mxmat(ivt(p))) then cphase(p) = 2._r8 if (abs(onset_counter(p)) > 1.e-6_r8) then onset_flag(p) = 1._r8 onset_counter(p) = dt - fert_counter(p) = ndays_on * secspday - if (ndays_on .gt. 0) then - fert(p) = (manunitro(ivt(p)) * 1000._r8 + fertnitro(p))/ fert_counter(p) - else - fert(p) = 0._r8 - end if + fert_counter(p) = ndays_on * secspday + if (ndays_on .gt. 0) then + if (use_fan) then + fert(p) = fertnitro(p) / fert_counter(p) + manu(p) = manurestore(c) / fert_counter(p) + ! manurestore(c) not changed here but in FAN code + else + fert(p) = (manunitro(ivt(p)) * 1000._r8 + fertnitro(p))/ fert_counter(p) + end if + else + fert(p) = 0._r8 + if (use_fan) manu(p) = 0._r8 + end if else ! this ensures no re-entry to onset of phase2 ! b/c onset_counter(p) = onset_counter(p) - dt @@ -2001,6 +2020,7 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & if (fert_counter(p) <= 0._r8) then fert(p) = 0._r8 + if (use_fan) manu(p) = 0._r8 else ! continue same fert application every timestep fert_counter(p) = fert_counter(p) - dtrad end if diff --git a/src/biogeochem/CNVegCarbonStateType.F90 b/src/biogeochem/CNVegCarbonStateType.F90 index 41eb79134f..1d3bcad6fb 100644 --- a/src/biogeochem/CNVegCarbonStateType.F90 +++ b/src/biogeochem/CNVegCarbonStateType.F90 @@ -11,7 +11,10 @@ module CNVegCarbonStateType use shr_log_mod , only : errMsg => shr_log_errMsg use pftconMod , only : noveg, npcropmin, pftcon use clm_varcon , only : spval, c3_r2, c4_r2, c14ratio - use clm_varctl , only : iulog, use_cndv, use_crop +!KO use clm_varctl , only : iulog, use_cndv, use_crop +!KO + use clm_varctl , only : iulog, use_cndv, use_crop, use_fan +!KO use decompMod , only : bounds_type use abortutils , only : endrun use spmdMod , only : masterproc @@ -36,6 +39,10 @@ module CNVegCarbonStateType real(r8), pointer :: grainc_xfer_patch (:) ! (gC/m2) grain C transfer (crop model) real(r8), pointer :: leafc_patch (:) ! (gC/m2) leaf C real(r8), pointer :: leafc_storage_patch (:) ! (gC/m2) leaf C storage +!KO + real(r8), pointer :: leafc_manure_patch (:) ! (gC/m2) leaf C eaten by cows + real(r8), pointer :: deadstemc_manure_patch (:) ! (gC/m2) dead stem C eaten by cows +!KO real(r8), pointer :: leafc_xfer_patch (:) ! (gC/m2) leaf C transfer real(r8), pointer :: leafc_storage_xfer_acc_patch (:) ! (gC/m2) Accmulated leaf C transfer real(r8), pointer :: storage_cdemand_patch (:) ! (gC/m2) C use from the C storage pool @@ -67,6 +74,9 @@ module CNVegCarbonStateType real(r8), pointer :: deadstemc_col (:) ! (gC/m2) column-level deadstemc (fire) real(r8), pointer :: fuelc_col (:) ! fuel load outside cropland real(r8), pointer :: fuelc_crop_col (:) ! fuel load for cropland +!KO + real(r8), pointer :: total_leafc_col (:) ! (gC/m2) total C at column-level +!KO real(r8), pointer :: cropseedc_deficit_patch (:) ! (gC/m2) pool for seeding new crop growth; this is a NEGATIVE term, indicating the amount of seed usage that needs to be repaid ! pools for dynamic landcover @@ -216,6 +226,12 @@ subroutine InitAllocate(this, bounds) begg = bounds%begg; endg = bounds%endg allocate(this%leafc_patch (begp:endp)) ; this%leafc_patch (:) = nan +!KO + if ( use_fan ) then + allocate(this%leafc_manure_patch (begp:endp)) ; this%leafc_manure_patch (:) = nan + allocate(this%deadstemc_manure_patch(begp:endp)) ; this%deadstemc_manure_patch (:) = nan + end if +!KO allocate(this%leafc_storage_patch (begp:endp)) ; this%leafc_storage_patch (:) = nan allocate(this%leafc_xfer_patch (begp:endp)) ; this%leafc_xfer_patch (:) = nan allocate(this%leafc_storage_xfer_acc_patch (begp:endp)) ; this%leafc_storage_xfer_acc_patch (:) = nan @@ -256,6 +272,11 @@ subroutine InitAllocate(this, bounds) allocate(this%deadstemc_col (begc:endc)) ; this%deadstemc_col (:) = nan allocate(this%fuelc_col (begc:endc)) ; this%fuelc_col (:) = nan allocate(this%fuelc_crop_col (begc:endc)) ; this%fuelc_crop_col (:) = nan +!KO + if ( use_fan ) then + allocate(this%total_leafc_col (begc:endc)) ; this%total_leafc_col (:) = nan + end if +!KO allocate(this%totvegc_patch (begp:endp)) ; this%totvegc_patch (:) = nan allocate(this%totvegc_col (begc:endc)) ; this%totvegc_col (:) = nan @@ -993,6 +1014,11 @@ subroutine InitCold(this, bounds, ratio, carbon_type, c12_cnveg_carbonstate_inst this%totecosysc_col(c) = 0._r8 this%totc_p2c_col(c) = 0._r8 this%totc_col(c) = 0._r8 +!KO + if ( use_fan ) then + this%total_leafc_col(c)= 0._r8 + end if +!KO end if end do @@ -2234,6 +2260,13 @@ subroutine Restart ( this, bounds, ncid, flag, carbon_type, reseed_dead_plants, call restartvar(ncid=ncid, flag=flag, varname='seedc_g', xtype=ncd_double, & dim1name='gridcell', long_name='', units='', & interpinic_flag='interp', readvar=readvar, data=this%seedc_grc) +!KO + if ( use_fan ) then + call restartvar(ncid=ncid, flag=flag, varname='total_leafc', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%total_leafc_col) + end if +!KO end if !-------------------------------- @@ -2333,6 +2366,16 @@ subroutine SetValues ( this, & end if end do +!KO + if ( use_fan ) then + do fi = 1,num_patch + i = filter_patch(fi) + this%leafc_manure_patch(i) = value_patch + this%deadstemc_manure_patch(i)= value_patch + end do + end if +!KO + do fi = 1,num_column i = filter_column(fi) this%rootc_col(i) = value_column @@ -2346,6 +2389,15 @@ subroutine SetValues ( this, & this%totecosysc_col(i) = value_column end do +!KO + if ( use_fan ) then + do fi = 1,num_column + i = filter_column(fi) + this%total_leafc_col(i) = value_column + end do + end if +!KO + end subroutine SetValues !----------------------------------------------------------------------- diff --git a/src/biogeochem/CNVegNitrogenFluxType.F90 b/src/biogeochem/CNVegNitrogenFluxType.F90 index 1bb630c687..70c0d852e0 100644 --- a/src/biogeochem/CNVegNitrogenFluxType.F90 +++ b/src/biogeochem/CNVegNitrogenFluxType.F90 @@ -6,13 +6,13 @@ module CNVegNitrogenFluxType use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools use clm_varpar , only : nlevdecomp_full, nlevdecomp use clm_varcon , only : spval, ispval, dzsoi_decomp - use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_crop + use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_crop, use_fan, iulog use CNSharedParamsMod , only : use_fun use decompMod , only : bounds_type use abortutils , only : endrun use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con use LandunitType , only : lun - use ColumnType , only : col + use ColumnType , only : col use PatchType , only : patch ! ! !PUBLIC TYPES: @@ -165,6 +165,8 @@ module CNVegNitrogenFluxType real(r8), pointer :: livecrootn_storage_to_xfer_patch (:) ! patch live coarse root N shift storage to transfer (gN/m2/s) real(r8), pointer :: deadcrootn_storage_to_xfer_patch (:) ! patch dead coarse root N shift storage to transfer (gN/m2/s) real(r8), pointer :: fert_patch (:) ! patch applied fertilizer (gN/m2/s) + real(r8), pointer :: manu_patch (:) ! patch applied manure (gN/m2/s) + real(r8), pointer :: fert_counter_patch (:) ! patch >0 fertilize; <=0 not real(r8), pointer :: soyfixn_patch (:) ! patch soybean fixed N (gN/m2/s) @@ -418,6 +420,7 @@ subroutine InitAllocate(this, bounds) allocate(this%grainn_xfer_to_grainn_patch (begp:endp)) ; this%grainn_xfer_to_grainn_patch (:) = nan allocate(this%grainn_storage_to_xfer_patch (begp:endp)) ; this%grainn_storage_to_xfer_patch (:) = nan allocate(this%fert_patch (begp:endp)) ; this%fert_patch (:) = nan + allocate(this%manu_patch (begp:endp)) ; this%manu_patch (:) = nan allocate(this%fert_counter_patch (begp:endp)) ; this%fert_counter_patch (:) = nan allocate(this%soyfixn_patch (begp:endp)) ; this%soyfixn_patch (:) = nan @@ -951,6 +954,13 @@ subroutine InitHistory(this, bounds) ptr_patch=this%fert_patch) end if + if (use_fan) then + this%manu_patch(begp:endp) = spval + call hist_addfld1d (fname='MANU', units='gN/m^2/s', & + avgflag='A', long_name='manure added', & + ptr_patch=this%manu_patch) + end if + if (use_crop) then this%soyfixn_patch(begp:endp) = spval call hist_addfld1d (fname='SOYFIXN', units='gN/m^2/s', & @@ -1254,15 +1264,18 @@ subroutine InitCold(this, bounds) !----------------------------------------------- ! initialize nitrogen flux variables !----------------------------------------------- - + if (use_fan) write(iulog, *) 'SETTING MANU_PATCH TO ZERO' do p = bounds%begp,bounds%endp l = patch%landunit(p) if ( use_crop )then this%fert_counter_patch(p) = spval - this%fert_patch(p) = 0._r8 + this%fert_patch(p) = 0._r8 this%soyfixn_patch(p) = 0._r8 end if + if ( use_fan) then + this%manu_patch(p) = 0._r8 + end if if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then this%fert_counter_patch(p) = 0._r8 @@ -1351,6 +1364,13 @@ subroutine Restart (this, bounds, ncid, flag ) interpinic_flag='interp', readvar=readvar, data=this%fert_patch) end if + if (use_fan) then + call restartvar(ncid=ncid, flag=flag, varname='manu', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%manu_patch) + end if + if (use_crop) then call restartvar(ncid=ncid, flag=flag, varname='grainn_xfer_to_grainn', xtype=ncd_double, & dim1name='pft', & diff --git a/src/biogeochem/CNVegNitrogenStateType.F90 b/src/biogeochem/CNVegNitrogenStateType.F90 index 97a5ffaae4..4468bfce44 100644 --- a/src/biogeochem/CNVegNitrogenStateType.F90 +++ b/src/biogeochem/CNVegNitrogenStateType.F90 @@ -11,7 +11,10 @@ module CNVegNitrogenStateType use landunit_varcon , only : istcrop, istsoil use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_century_decomp use clm_varctl , only : iulog, override_bgc_restart_mismatch_dump - use clm_varctl , only : use_crop +!KO use clm_varctl , only : use_crop +!KO + use clm_varctl , only : use_crop, use_fan +!KO use CNSharedParamsMod , only : use_fun use decompMod , only : bounds_type use pftconMod , only : npcropmin, noveg, pftcon @@ -38,6 +41,10 @@ module CNVegNitrogenStateType real(r8), pointer :: grainn_storage_patch (:) ! (gN/m2) grain N storage (crop) real(r8), pointer :: grainn_xfer_patch (:) ! (gN/m2) grain N transfer (crop) real(r8), pointer :: leafn_patch (:) ! (gN/m2) leaf N +!KO + real(r8), pointer :: leafn_manure_patch (:) ! (gN/m2) leaf N eaten by cows + real(r8), pointer :: deadstemn_manure_patch (:) ! (gN/m2) dead stem N eaten by cows +!KO real(r8), pointer :: leafn_storage_patch (:) ! (gN/m2) leaf N storage real(r8), pointer :: leafn_xfer_patch (:) ! (gN/m2) leaf N transfer real(r8), pointer :: leafn_storage_xfer_acc_patch (:) ! (gN/m2) Accmulated leaf N transfer @@ -134,6 +141,12 @@ subroutine InitAllocate(this, bounds) allocate(this%grainn_storage_patch (begp:endp)) ; this%grainn_storage_patch (:) = nan allocate(this%grainn_xfer_patch (begp:endp)) ; this%grainn_xfer_patch (:) = nan allocate(this%leafn_patch (begp:endp)) ; this%leafn_patch (:) = nan +!KO + if ( use_fan ) then + allocate(this%leafn_manure_patch (begp:endp)) ; this%leafn_manure_patch (:) = nan + allocate(this%deadstemn_manure_patch(begp:endp)) ; this%deadstemn_manure_patch (:) = nan + end if +!KO allocate(this%leafn_storage_patch (begp:endp)) ; this%leafn_storage_patch (:) = nan allocate(this%leafn_xfer_patch (begp:endp)) ; this%leafn_xfer_patch (:) = nan allocate(this%leafn_storage_xfer_acc_patch (begp:endp)) ; this%leafn_storage_xfer_acc_patch (:) = nan @@ -891,6 +904,16 @@ subroutine SetValues ( this, & this%totn_patch(i) = value_patch end do +!KO + if ( use_fan ) then + do fi = 1,num_patch + i = filter_patch(fi) + this%leafn_manure_patch(i) = value_patch + this%deadstemn_manure_patch(i)= value_patch + end do + end if +!KO + if ( use_crop )then do fi = 1,num_patch i = filter_patch(fi) diff --git a/src/biogeochem/CNVegetationFacade.F90 b/src/biogeochem/CNVegetationFacade.F90 index 10c8164baa..44cbf92beb 100644 --- a/src/biogeochem/CNVegetationFacade.F90 +++ b/src/biogeochem/CNVegetationFacade.F90 @@ -785,7 +785,10 @@ subroutine EcosystemDynamicsPreDrainage(this, bounds, & atm2lnd_inst, waterstate_inst, waterflux_inst, & canopystate_inst, soilstate_inst, temperature_inst, crop_inst, ch4_inst, & photosyns_inst, soilhydrology_inst, energyflux_inst, & - nutrient_competition_method, fireemis_inst) +!KO nutrient_competition_method, fireemis_inst) +!KO + nutrient_competition_method, fireemis_inst, frictionvel_inst) +!KO ! ! !DESCRIPTION: ! Do the main science for CN vegetation that needs to be done before hydrology-drainage @@ -815,7 +818,10 @@ subroutine EcosystemDynamicsPreDrainage(this, bounds, & type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst type(soilbiogeochem_nitrogenstate_type) , intent(inout) :: soilbiogeochem_nitrogenstate_inst type(atm2lnd_type) , intent(in) :: atm2lnd_inst - type(waterstate_type) , intent(in) :: waterstate_inst +!KO type(waterstate_type) , intent(in) :: waterstate_inst +!KO + type(waterstate_type) , intent(inout) :: waterstate_inst +!KO type(waterflux_type) , intent(inout) :: waterflux_inst type(canopystate_type) , intent(inout) :: canopystate_inst type(soilstate_type) , intent(inout) :: soilstate_inst @@ -825,6 +831,9 @@ subroutine EcosystemDynamicsPreDrainage(this, bounds, & type(photosyns_type) , intent(in) :: photosyns_inst type(soilhydrology_type) , intent(in) :: soilhydrology_inst type(energyflux_type) , intent(in) :: energyflux_inst +!KO + type(frictionvel_type) , intent(inout) :: frictionvel_inst +!KO class(nutrient_competition_method_type) , intent(inout) :: nutrient_competition_method type(fireemis_type) , intent(inout) :: fireemis_inst ! @@ -854,7 +863,10 @@ subroutine EcosystemDynamicsPreDrainage(this, bounds, & atm2lnd_inst, waterstate_inst, waterflux_inst, & canopystate_inst, soilstate_inst, temperature_inst, crop_inst, ch4_inst, & this%dgvs_inst, photosyns_inst, soilhydrology_inst, energyflux_inst, & - nutrient_competition_method, this%cnfire_method) +!KO nutrient_competition_method, this%cnfire_method) +!KO + nutrient_competition_method, this%cnfire_method, frictionvel_inst) +!KO ! fire carbon emissions call CNFireEmisUpdate(bounds, num_soilp, filter_soilp, & diff --git a/src/biogeochem/FanMod.F90 b/src/biogeochem/FanMod.F90 new file mode 100755 index 0000000000..c378fb2d44 --- /dev/null +++ b/src/biogeochem/FanMod.F90 @@ -0,0 +1,1293 @@ +module FanMod +#ifdef _PYMOD_ + use qsatmod +#else + use shr_const_mod + use shr_kind_mod , only : r8 => shr_kind_r8 + use QSatMod , only : QSat +#endif + implicit none + +#ifdef _REALPR_ + integer, parameter :: r8 = 8 +#endif + +#ifdef _PYMOD_ + public + + real(r8), parameter :: SHR_CONST_BOLTZ = 1.38065e-23 + real(r8), parameter :: SHR_CONST_AVOGAD = 6.02214e26 + real(r8), parameter :: SHR_CONST_RGAS = SHR_CONST_AVOGAD*SHR_CONST_BOLTZ + real(r8), parameter :: SHR_CONST_MWDAIR = 28.966 + real(r8), parameter :: SHR_CONST_RDAIR = SHR_CONST_RGAS/SHR_CONST_MWDAIR + +#else + private + public update_org_n + public eval_fluxes_storage + public update_npool + public update_3pool + public update_urea +#endif + + ! Indices in flux arrays, soil: + integer, parameter, public :: iflx_air = 1, & ! flux to air + iflx_soild = 2, & ! diffusion to soil + iflx_no3 = 3, & ! nitrification + iflx_soilq = 4, & ! percolation to soil + iflx_roff = 5, & ! surface runoff + iflx_to_tan = 6 ! conversion to tan (from urea) + ! Indices in flux arrays, storage: + integer, parameter, public :: iflx_air_barns = 1, & + iflx_air_stores = 2, & + iflx_appl = 3, & + iflx_to_store = 4 + ! Indices in the organic N pools and fluxes + integer, parameter, public :: ind_avail = 1, ind_resist = 2, ind_unavail = 3 + + ! nominal depth where the soil TAN concentration vanishes: + real(r8), parameter, public :: soildepth_reservoir = 0.05_r8 + + integer, parameter, public :: err_bad_theta = 1, err_negative_tan = 2, err_negative_flux = 3, & + err_balance_tan = 4, err_balance_nitr = 5, err_nan = 6, err_bad_subst = 7 + + integer, parameter, public :: subst_tan = 1, subst_urea = 2 + + real(r8), parameter, public :: water_relax_t = 24*3600.0_r8 + +contains + + ! accessor functions are only needed for the python interface... + ! + integer function ind_soild() result(ind) + ind = iflx_soild + end function ind_soild + + integer function ind_soilq() result(ind) + ind = iflx_soilq + end function ind_soilq + + integer function ind_air() result(ind) + ind = iflx_air + end function ind_air + + integer function ind_no3() result(ind) + ind = iflx_no3 + end function ind_no3 + + integer function ind_roff() result(ind) + ind = iflx_roff + end function ind_roff + + integer function ind_air_barns() result(ind) + ind = iflx_air_barns + end function ind_air_barns + + integer function ind_air_stores() result(ind) + ind = iflx_air_stores + end function ind_air_stores + + integer function ind_appl() result(ind) + ind = iflx_appl + end function ind_appl + + integer function ind_to_store() result(ind) + ind = iflx_to_store + end function ind_to_store + + function eval_diffusivity_liq_mq(theta, thetasat, tg) result(diff) + ! Evaluate the aquous phase diffusivity for TAN in soil according to the Millington & + ! Quirk model. + implicit none + real(r8), intent(in) :: theta, thetasat, tg + real(r8) :: diff + + real(r8) :: kaq_base + real(r8), parameter :: pw = 10.0_r8 / 3.0_r8 + + kaq_base = 9.8e-10_r8 * 1.03_r8 ** (Tg-273.0_r8) + diff = kaq_base * (theta**pw) / (thetasat**2) + + end function eval_diffusivity_liq_mq + + function eval_diffusivity_gas_mq(theta, thetasat, tg) result(diff) + ! Evaluate the gas phase diffusivity for NH3 in soil according to the Millington & + ! Quirk model. + implicit none + real(r8), intent(in) :: theta, thetasat, tg + real(r8) :: diff + + real(r8) :: soilair, dair + real(r8), parameter :: pw = 10.0_r8 / 3.0_r8 + real(r8), parameter :: mNH3 = 17., mair = 29, vNH3 = 14.9, vair = 20.1, press = 1.0 + + soilair = thetasat - theta + !dair = 1.7e-5_r8 * 1.03_r8**(Tg-293.0_r8) + !dair = 18e-6_r8 + !dair = 1.4e-5 + + ! Base rate from Perry's Chemical Engineer's Handbook, 8th ed. + dair = (0.001 * tg**1.75 * sqrt(1/mNH3 + 1/mair)) / (press * (vair**(1./3) * vNH3**(1./3))**2) * 1e-4 + diff = dair * (soilair**pw) / (thetasat**2) + + end function eval_diffusivity_gas_mq + + function eval_diffusivity_gas_m03(theta, thetasat, tg) result(diff) + ! Evaluate the gas phase diffusivity for NH3 in soil according to the method of + ! Moldrup (2003). + implicit none + real(r8), intent(in) :: theta, thetasat, tg + real(r8) :: diff + + real(r8) :: soilair, dair + real(r8), parameter :: pw = 10.0_r8 / 3.0_r8 + real(r8), parameter :: bsw = 5.0_r8, m03_T = 2.0, m03_W = 3.0 / bsw + + soilair = thetasat - theta + dair = 1.7e-5 * 1.03**(Tg-293.0_r8) + + diff = dair * soilair**m03_T * (soilair/thetasat)**m03_W + + end function eval_diffusivity_gas_m03 + + function eval_diffusivity_liq_m03(theta, thetasat, tg) result(diff) + ! Evaluate the aquous phase diffusivity for TAN in soil according to the method of Moldrup (2003). + implicit none + real(r8), intent(in) :: theta, thetasat, tg + real(r8) :: diff + + real(r8) :: kaq_base + real(r8), parameter :: pw = 10.0_r8 / 3.0_r8, bsw = 5.0_r8, m03_T = 2.0_r8, m03_W = 0.3333_r8*bsw - 1.0 + + kaq_base = 9.8e-10 * 1.03 ** (Tg-273.0_r8) + + diff = kaq_base * theta**m03_T * (theta/thetasat)**m03_W + + end function eval_diffusivity_liq_m03 + + + ! The following three subroutines are meant for evaluating the net NH3 flux between soil and atmosphere as + ! + ! F = g * (N - beta * cair) + ! + ! where F is the net upwards flux of NH3, g is a conductance (m/s), cair is the + ! atmospheric concentration of NH3, and beta is a unitless constant. N denotes the TAN + ! concentration in soil in different phases as detailed below. + + subroutine get_volat_coefs_liq(ratm, tg, theta, thetasat, Hconc, depth, conductance, beta) + ! + ! Evaluate the conductance g with N = [NH4+ (aq)] + [NH3 (aq)] in soilwater and + ! assuming that [NH3 (g)] < N in soil. + ! + ! For cair = 0, this subroutine is actually equivalent to get_volat_soil_leachn. + ! + implicit none + real(r8), intent(in) :: ratm ! resistance between the soil surface and bulk atmosphere + real(r8), intent(in) :: tg ! ground temperature + real(r8), intent(in) :: theta ! volumetric water content + real(r8), intent(in) :: thetasat ! volumetric water content at saturation + real(r8), intent(in) :: Hconc ! hydrogen ion concentration, -log10(pH) + real(r8), intent(in) :: depth ! thickenss of the soil layer, m + real(r8), intent(out) :: conductance ! as defined above + real(r8), intent(out) :: beta ! as defined above + + real(r8) :: dz, henry_eff, dsl, dsg, rsl, rsg, grad, cond, air + + dz = 0.5*depth + dsl = eval_diffusivity_liq_mq(theta, thetasat, Tg) + dsg = eval_diffusivity_gas_mq(theta, thetasat, Tg) + + henry_eff = get_henry_eff(Tg, Hconc) + beta = 1/henry_eff + air = thetasat - theta + + rsg = dz / (dsg*air) + rsl = dz / (dsl*theta) + + conductance = henry_eff*(henry_eff*rsl + rsg)/(henry_eff*ratm*rsl + henry_eff*rsg*rsl + ratm*rsg) + + end subroutine get_volat_coefs_liq + + subroutine get_volat_coefs_bulk(ratm, tg, theta, thetasat, Hconc, depth, conductance, beta) + ! + ! Evaluate the conductance g with N = [NH4+ (aq)] + [NH3 (aq)] + [NH3 (g)] measured per volume of soil. + ! + ! More accurate than get_volat_coefs_liq but in practice rarely different because when + ! measured in mass per volume, most of the TAN is normally in soil water. + + implicit none + real(r8), intent(in) :: ratm, tg, theta, thetasat, Hconc, depth + real(r8), intent(out) :: conductance, beta + + real(r8) :: dz, henry_eff, dsl, dsg, rsl, rsg, cond, air + + dz = 0.5*depth + dsl = eval_diffusivity_liq_mq(theta, thetasat, Tg) + dsg = eval_diffusivity_gas_mq(theta, thetasat, Tg) + + henry_eff = get_henry_eff(Tg, Hconc) + beta = (air*henry_eff + theta)/henry_eff + air = thetasat - theta + + rsg = dz / (dsg*air) + rsl = dz / (dsl*theta) + + conductance = henry_eff*(henry_eff*rsl + rsg) & + /(air*henry_eff**2*ratm*rsl + air*henry_eff**2*rsg*rsl + air*henry_eff*ratm*rsg & + + henry_eff*ratm*rsl*theta + henry_eff*rsg*rsl*theta + ratm*rsg*theta) + + end subroutine get_volat_coefs_bulk + + subroutine get_volat_coefs_3p(ratm, tg, theta, thetasat, Hconc, depth, cond, beta) + ! + ! Evaluate the conductance g including absorbed "solid" NH4+, + ! + ! N = [NH3 (aq)] + [NHH4+ (aq)] + [NH3 (g)] + [NH4+ (s)]. + ! + ! The partitioning between absorbed and aquoeous NH4+ is evaluted with a linear isotherm + ! such that [NH4+ (s)] / [NH4+ (aq)] = kxc, where kxc is a constant set below. + ! + implicit none + real(r8), intent(in) :: ratm, tg, theta, thetasat, Hconc, depth + real(r8), intent(out) :: cond, beta + + real(r8) :: dz, henry_eff, dsl, dsg, rsl, rsg, air, solid + real(r8), parameter :: kxc = 0.3_r8 + + dz = 0.5*depth + dsl = eval_diffusivity_liq_mq(theta, thetasat, Tg) + dsg = eval_diffusivity_gas_mq(theta, thetasat, Tg) + + henry_eff = get_henry_eff(Tg, Hconc) + solid = 1 - thetasat + air = thetasat - theta + beta = (air*henry_eff + kxc*solid + theta)/henry_eff + + rsg = dz / (dsg*air) + rsl = dz / (dsl*theta) + + cond = henry_eff*(henry_eff*rsl + rsg) & + / (air*henry_eff**2*ratm*rsl + air*henry_eff**2*rsg*rsl + air*henry_eff*ratm*rsg & + + henry_eff*kxc*solid*ratm*rsl + henry_eff*kxc*solid*rsg*rsl + henry_eff*ratm*rsl*theta & + + henry_eff*rsg*rsl*theta + kxc*solid*ratm*rsg + ratm*rsg*theta) + + end subroutine get_volat_coefs_3p + + function get_volat_soil_leachn(ratm, tg, theta, thetasat, Hconc, depth) result(rate) + ! Evaluate the instanteneous volatilization rate from soil as done in the LEACHN + ! model. Includes gas and aquoues phase diffusion within soil and gas/liquid + ! partitioning. + real(r8), intent(in) :: ratm, tg, theta, thetasat, Hconc, depth + real(r8) :: rate + + real(r8) :: dz, henry_eff, dsl, dsg, dstot, gs, gatm_eff + + dz = 0.5*depth + + henry_eff = get_henry_eff(Tg, Hconc) + gatm_eff = henry_eff / ratm + dsl = eval_diffusivity_liq_mq(theta, thetasat, Tg) + dsg = eval_diffusivity_gas_mq(theta, thetasat, Tg) + dstot = dsl*theta + dsg*henry_eff*(thetasat-theta) + gs = dstot / dz + rate = gs*gatm_eff / (gs + gatm_eff) + + end function get_volat_soil_leachn + + + real(r8) function get_henry_eff(tg, Hconc) result(henry) + ! Evaluate the "effective Henry constant" for ammonia, i.e the ratio + ! H* = [NH3 (g)] / [NH3 (aq) + NH4+ (aq)] + ! given a fixed H+ concentration in the solution. + real(r8), intent(in) :: tg ! soil temperature, K + real(r8), intent(in) :: Hconc ! H+ concentration, mol / l + + real(r8) :: KNH4, KH + real(r8), parameter :: Tref = 298.15_r8 + + KNH4 = 5.67_r8 * 1e-10_r8 * exp(-6286.0_r8 * (1.0_r8/Tg - 1.0_r8/Tref)) + KH = 4.59_r8 * Tg * exp(4092_r8 * (1.0_r8/Tg - 1.0_r8/Tref)) + henry = 1.0_r8 / (1.0_r8 + KH + KH*Hconc/KNH4) + + end function get_henry_eff + + real(r8) function eval_no3prod(theta, Tg, Hconc) result(kNO3) + ! Evaluate nitrification rate as in the Riddick et al. (2016) paper. + real(r8), intent(in) :: theta ! volumetric soil water m/m + real(r8), intent(in) :: Tg ! soil temperature, K + real(r8), intent(in) :: Hconc ! hydrogen ion concentration mol/l + + real(r8) :: KNH4, KH, gas, stf, wmr, smrf, mNH4 + + real(r8), parameter :: soil_dens = 1050.0_r8 ! Soil density, kg/m3 + real(r8), parameter :: water_dens = 1000.0_r8 + real(r8), parameter :: rmax = 1.16e-6_r8 ! Maximum rate of nitrification, s-1 + real(r8), parameter :: tmax = 313.0 ! Maximm temperature of microbial activity, K + real(r8), parameter :: topt = 301.0 ! Optimal temperature of microbial acticity, K + real(r8), parameter :: asg = 2.4_8 ! a_sigma, empirical factor + real(r8), parameter :: wmr_crit = 0.12_r8 ! Critical water content, g/g + real(r8), parameter :: smrf_b = 2 ! Parameter in soil moisture response function + real(r8), parameter :: Tref = 298.15_r8 + + KNH4 = 5.67_r8 * 1e-10_r8 * exp(-6286.0_r8 * (1.0_r8/Tg - 1.0_r8/Tref)) + KH = 4.59_r8 * Tg * exp(4092_r8 * (1.0_r8/Tg - 1.0_r8/Tref)) + gas = 1.0_r8 / (1.0_r8 + KH + KH*Hconc/KNH4) + mNH4 = gas * KH*Hconc/KNH4 + + ! soil temperature function + stf = (max(1e-3_r8, tmax-Tg) / (tmax-topt))**asg * exp(asg * (Tg-topt)/(tmax-topt)) + + ! gravimetric soil water + wmr = theta * water_dens / soil_dens + + ! soil moisture response function + + smrf = 1.0_r8 - exp(-(wmr/wmr_crit)**smrf_b) + !if stf < 1e-9 or smrf < 1e-9: + ! print theta + ! 1/0 + kNO3 = 2.0_r8 * rmax * mNH4 / (1.0_r8/stf + 1.0_r8/smrf) + + end function eval_no3prod + + subroutine eval_fluxes_slurry(water, mtan, Hconc, tg, ratm, theta, thetasat, perc, runoff, cnc_nh3_air, fluxes) + ! Evaluate nitrogen fluxes for a partly infiltrated layer of slurry. + ! The state of infiltration is detemined from the amounts water on surface and in soil. + ! Positive flux means loss of TAN. + implicit none + real(r8), intent(in) :: water(2) ! water in (surface , subsurface), m + real(r8), intent(in) :: mtan ! TAN, mass units / m2, surface + subsurface + real(r8), intent(out) :: fluxes(5) ! TAN fluxes, see top of the module + real(r8), intent(in) :: Hconc ! H+ concentration, -log10(pH) + real(r8), intent(in) :: tg ! soil temperature, K + real(r8), intent(in) :: ratm ! atmospheric resistance, s/m + real(r8), intent(in) :: theta ! volumetric soil water in "clean" soil + real(r8), intent(in) :: thetasat ! volumetric soil water at saturation + real(r8), intent(in) :: perc ! percolation water flux thourgh the bottom of volatilization layer, m/s + real(r8), intent(in) :: runoff ! surface runoff, m/s + real(r8), intent(in) :: cnc_nh3_air ! atmospheric NH3 concentration, mass units / m3 + !real(r8), intent(in) :: dt ! timestep + + real(r8) :: water_tot, cnc, air, depth_soilsat, diffusivity_water, diffusivity_satsoil, halfwater, insoil, r1, dz2 + real(r8) :: r2, volat_rate, kno3, henry_eff, depth_lower + + water_tot = water(1) + water(2) + + air = thetasat - theta + ! depth of the saturated soil layer below the surface pool + depth_soilsat = water(2) / air + + cnc = mtan / water_tot + + fluxes(iflx_roff) = cnc * runoff + fluxes(iflx_soilq) = cnc * perc + + + diffusivity_water = 9.8e-10_r8 * 1.03_r8 ** (tg - 273.0_r8) + diffusivity_satsoil = eval_diffusivity_liq_mq(thetasat, thetasat, tg) * thetasat + + halfwater = 0.5_r8 * water_tot + + ! Calculate the internal resistance r1 of the slurry/soil layer by integrating the + ! diffusivity for distance that covers half of the slurry water. + if (water(1) < halfwater) then + ! contribution from both pool and the saturated soil. + insoil = (halfwater - water(1)) / thetasat + r1 = water(1) / diffusivity_water + insoil / diffusivity_satsoil + else + ! pool only + r1 = halfwater / diffusivity_water + end if + + depth_lower = max(soildepth_reservoir, depth_soilsat*1.5) + ! Diffusion to deeper soil over distance dz2 + dz2 = depth_lower - 0.5*depth_soilsat + r2 = 0.5 * depth_soilsat/diffusivity_satsoil + dz2 / eval_diffusivity_liq_mq(theta, thetasat, tg) + !print *, 'r2', r2, diffusivity_satsoil, dz2, depth_soilsat + fluxes(iflx_soild) = cnc / r2 + + henry_eff = get_henry_eff(tg, Hconc) + volat_rate = 1.0_r8 / (r1 + ratm / henry_eff) ! conductance from aqueous TAN in slurry to NH3 in atmosphere + fluxes(iflx_air) = max(volat_rate*(cnc - cnc_nh3_air), 0.0_r8) + + ! nitrification + kno3 = eval_no3prod(thetasat, tg, Hconc) + fluxes(iflx_no3) = kno3 * mtan + + !fluxes(3:) = 0 + + end subroutine eval_fluxes_slurry + + subroutine eval_fluxes_soil(mtan, water_manure, Hconc, tg, ratm, theta, thetasat, perc, & + & runoff, cnc_nh3_air, soildepth, fluxes, substance, status) + ! + ! Evaluate nitrogen fluxes from a soil layer. Use for all cases except the partly + ! infiltrated slurry (above). Fluxes can be evaluated either for urea or TAN: for + ! urea, only the aqueous phase fluxes are evaluated and nitrification is set to zero. + ! + implicit none + real(r8), intent(in) :: mtan ! TAN, mass units / m2 + real(r8), intent(in) :: water_manure ! water in the soil pool *in addition to* background soil water + real(r8), intent(out) :: fluxes(5) ! nitrogen fluxes, mass units / m2 / s, see top of module + real(r8), intent(in) :: Hconc ! Hydrogen ion concentration, mol/l + real(r8), intent(in) :: tg ! soil temperature, K + real(r8), intent(in) :: ratm ! atmospheric resistance, s/m + real(r8), intent(in) :: theta ! volumetric soil water in "clean" soil, m/m + real(r8), intent(in) :: thetasat ! volumetric soil water at saturation + real(r8), intent(in) :: perc ! downwards water percolation rate at the bottom of layer, m/s, > 0 + real(r8), intent(in) :: runoff ! runoff water flux, m / s + real(r8), intent(in) :: cnc_nh3_air ! NH3 concentration in air, mass units / m3 + real(r8), intent(in) :: soildepth ! thickness of the volatlization layer + integer, intent(in) :: substance ! subst_tan or subst_urea. + integer, intent(out) :: status ! error flag + + + real(r8) :: water_tot, cnc, air, henry_eff, dsl, dsg, dstot, dz2, no3_rate, volat_rate, theta_tot, beta + + water_tot = water_manure + theta*soildepth + if (water_tot < 1e-9) then + fluxes = 0.0 + return + end if + + theta_tot = water_tot / soildepth + if (theta_tot > thetasat) then + status = err_bad_theta + return + end if + + cnc = mtan / water_tot + + air = thetasat - theta_tot + beta = 0.0 + + if (substance == subst_tan) then + + volat_rate = get_volat_soil_leachn(ratm, tg, water_tot/soildepth, thetasat, Hconc, soildepth) + !fluxes(iflx_air) = max((cnc-cnc_nh3_air) * volat_rate, 0.0_r8) + + !call get_volat_coefs_liq(ratm, tg, water_tot/soildepth, thetasat, Hconc, soildepth, volat_rate, beta) + !fluxes(iflx_air) = volat_rate * (cnc - beta*cnc_nh3_air) + + call get_volat_coefs_bulk(ratm, tg, water_tot/soildepth, thetasat, Hconc, soildepth, volat_rate, beta) + !call get_volat_coefs_3p(ratm, tg, water_tot/soildepth, thetasat, Hconc, soildepth, volat_rate, beta) + fluxes(iflx_air) = volat_rate * (mtan/soildepth - beta*cnc_nh3_air) + + henry_eff = get_henry_eff(tg, Hconc) + dsg = eval_diffusivity_gas_mq(theta_tot, thetasat, tg) + no3_rate = eval_no3prod(theta_tot, tg, Hconc) + else if (substance == subst_urea) then + fluxes(iflx_air) = 0.0_r8 + henry_eff = 0.0_r8 + dsg = 0.0_r8 + no3_rate = 0.0_r8 + else + status = err_bad_subst + return + end if + + ! Downwards diffusion + ! soil diffusivities: liquid, gas, bulk + dsl = eval_diffusivity_liq_mq(theta_tot, thetasat, tg) + dstot = dsl*theta_tot + dsg*henry_eff*air + dz2 = soildepth_reservoir - 0.5 * soildepth + !print *, 'dz2:', dz2 + fluxes(iflx_soild) = cnc * dstot / dz2 + fluxes(iflx_no3) = mtan * no3_rate + fluxes(iflx_soilq) = cnc * perc + fluxes(iflx_roff) = cnc * runoff + + status = 0 + !fluxes(4:) = 0 + + end subroutine eval_fluxes_soil + + subroutine partition_to_layer(water, theta, thetasat, soildepth, fraction_in, fraction_down, fraction_runoff) + ! Evaluate the fraction of water volume that can be accommodated (before saturation) + ! by soil layer with current water content theta. + implicit none + real(r8), intent(in) :: water ! water to be added to the layer, m + real(r8), intent(in) :: theta, thetasat ! vol. soil water, current and saturation, m/m + real(r8), intent(in) :: soildepth ! thickness of the layer, m + real(r8), intent(out) :: fraction_in ! fraction that fits in + real(r8), intent(out) :: fraction_down ! fraction excess + real(r8), intent(out) :: fraction_runoff ! = 1 if theta is > 99% saturation otherwise 0 + + real(r8) :: watvol, watvol_sat, vol_to_layer, vol_to_deeper, vol_avail + + watvol = theta*soildepth + watvol_sat = thetasat*soildepth + + if (watvol < 0.99*watvol_sat) then + vol_avail = watvol_sat - watvol + vol_to_layer = min(water, vol_avail) + vol_to_deeper = water - vol_to_layer + fraction_down = vol_to_deeper / water + fraction_runoff = 0.0 + fraction_in = 1.0_r8 - fraction_down + else + fraction_down = 0.0 + fraction_in = 0.0 + fraction_runoff = 1.0_r8 + end if + + end subroutine partition_to_layer + + subroutine age_pools_soil(ndep, dt, pools, mtan, garbage) + implicit none + real(r8), intent(in) :: ndep ! flux of TAN input, gN/m2/s + real(r8), intent(inout) :: mtan(:) ! TAN pools for each age range. gN/m2 + real(r8), intent(in) :: dt ! timestep, s + real(r8), intent(in) :: pools(:) ! age spans covered by each bin, seconds. size(mtan) = size(pools) + real(r8), intent(out) :: garbage ! TAN removed from the oldest pool. gN/m2 + + real(r8) :: flux_out(size(mtan)) + + flux_out = mtan / pools + + ! new nitrogen + mtan(1) = mtan(1) + ndep * dt + ! transfer nitrogen from fresh to old pools + mtan = mtan - flux_out * dt + mtan(2:) = mtan(2:) + flux_out(:size(mtan)-1) * dt + ! provided that the oldest pool has wide enough age range, the amount transferred out + ! should be small. + garbage = flux_out(size(mtan)) * dt + + end subroutine age_pools_soil + + subroutine age_pools_slurry(ndep, dt, water_slurry, tan_slurry, tan_soil, pools, garbage) + implicit none + real(r8), intent(in) :: ndep ! flux of TAN input, gN/m2/s + real(r8), intent(in) :: dt ! timestep, s + ! water in slurry pool, on surface (1) and below surface (2) not including the background water content (theta) + real(r8), intent(in) :: water_slurry(2) + real(r8), intent(inout) :: tan_slurry ! TAN in slurry pool, gN/m2 + real(r8), intent(inout) :: tan_soil(:) ! TAN in soil pools, gN/m2 + real(r8), intent(in) :: pools(:) ! age spans covered by each pool, including the S0 surface slurry. seconds. + real(r8), intent(out) :: garbage ! garbage TAN, see above + + real(r8) :: fract_slurry_soil, flux_to_soilpools + + fract_slurry_soil = water_slurry(2) / sum(water_slurry) + flux_to_soilpools = tan_slurry * fract_slurry_soil / pools(1) + tan_slurry = tan_slurry + (ndep - flux_to_soilpools) * dt + + call age_pools_soil(flux_to_soilpools, dt, pools(2:), tan_soil, garbage) + + end subroutine age_pools_slurry + + subroutine update_3pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend, runoff, tandep, tanprod, cnc_nh3_air, & + depth_slurry, poolranges, tanpools, fluxes, garbage, dt, status) + ! + ! Evalute fluxes and update TAN pools for the 3-pool slurry model with a partly + ! infiltrated, freshly infiltrated and aged TAN pools. + ! + implicit none + real(r8), intent(in) :: tg ! soil temperature, K + real(r8), intent(in) :: ratm ! atmospheric resistance, s/m + real(r8), intent(in) :: theta ! volumetric soil water in soil column (unaffected by slurry) + real(r8), intent(in) :: thetasat ! vol. soil water at saturation + real(r8), intent(in) :: precip ! precipitation, m/s + real(r8), intent(in) :: evap ! ground evaporation, m/s + real(r8), intent(in) :: qbot ! specific humidity (kg/kg) at lowest atmospheric model level + real(r8), intent(in) :: watertend ! time derivative of theta + real(r8), intent(in) :: runoff ! surface runoff flux, m/s + real(r8), intent(in) :: tandep ! TAN input flux, gN/m2/s + real(r8), intent(in) :: tanprod ! TAN produced in the column, added to aged TAN pool + !real(r8), intent(in) :: infiltr_slurry ! Slurry infiltration rate, m/s + real(r8), intent(in) :: depth_slurry ! Initial slurry depth, m + real(r8), intent(in) :: cnc_nh3_air ! NH3 concentration in air, gN/m3 + real(r8), intent(in) :: poolranges(3) ! age ranges of TAN pools S0, S1, S2, sec. Slurry infiltration time is inferred from S0. + real(r8), intent(inout) :: tanpools(3) ! TAN pools gN/m2 + real(r8), intent(out) :: fluxes(5,3) ! TAN fluxes, gN/m2/s (type of flux, pool) + real(r8), intent(out) :: garbage ! over-aged TAN occurring during the step, gN/m. + real(r8), intent(in) :: dt ! timestep, sec, >0 + integer, intent(out) :: status ! return status, 0 = good + + real(r8) :: infiltr_slurry, infiltrated, percolated, evap_slurry, water_slurry(2), perc_slurry_mean, waterloss + real(r8) :: percolation, water_soil, age_prev, water_in_layer, tanpools_old(3) + integer :: indpl + + real(r8), parameter :: dz_layer = 0.02 ! thickness of the volatilization layer, m + ! H+ concentration in each pool + real(r8), parameter :: Hconc(3) = (/10.0_r8**(-8.0_r8), 10.0_r8**(-8.0_r8), 10.0_r8**(-8.0_r8)/) + + if (theta > thetasat) then + status = err_bad_theta + return + end if + + tanpools_old = tanpools + + ! Pool S0 + ! + evap_slurry = get_evap_pool(tg, ratm, qbot) + infiltr_slurry = max(depth_slurry / poolranges(1), precip) + infiltrated = depth_slurry * infiltr_slurry / (infiltr_slurry + evap_slurry) + ! Slurry water (in addition to soil water, theta) on surface and in soil. Represents + ! mean over pool S0. + water_slurry = (/0.5*depth_slurry, 0.5*infiltrated/) + ! The excess water assumed to have percolated down from the volat. layer. + percolated = max(infiltrated - dz_layer*(thetasat-theta), 0.0) + ! Percolation rate out of volat layer, average over the pool S0. + perc_slurry_mean = percolated / poolranges(1) + + call eval_fluxes_slurry(water_slurry, tanpools(1), Hconc(1), tg, ratm, theta, thetasat, perc_slurry_mean, & + runoff, cnc_nh3_air, fluxes(:,1)) + + if (any(isnan(fluxes))) then + status = err_nan * 10 + end if + + call update_pools(tanpools(1:1), fluxes(1:5,1:1), dt, 1, 5) + + if (any(tanpools < -1e-15)) then + status = err_negative_tan + return + end if + + ! Pool aging & input + ! + call age_pools_slurry(tandep, dt, water_slurry, tanpools(1), tanpools(2:3), poolranges, garbage) + ! TAN produced (mineralization) goes to directly the old TAN pool. + tanpools(3) = tanpools(3) + tanprod*dt + + ! Soil bins S1 and S2 + ! + age_prev = 0 ! for water evaluations, consider beginning of S1 as the starting point + water_in_layer = infiltrated - percolated ! water in layer just after slurry has infiltrated + do indpl = 2, 3 + ! water content lost during the aging + waterloss = water_in_layer * (waterfunction(age_prev) - waterfunction(age_prev+poolranges(indpl))) + percolation = eval_perc(waterloss, evap, precip, watertend, poolranges(indpl)) + ! water content at the mean age of the pool + water_soil = water_in_layer * waterfunction(age_prev + 0.5*poolranges(indpl)) + call eval_fluxes_soil(tanpools(indpl), water_soil, Hconc(indpl), tg, & + & ratm, theta, thetasat, percolation, runoff, cnc_nh3_air, & + & dz_layer, fluxes(:,indpl), subst_tan, status) + if (status /= 0) return + age_prev = age_prev + poolranges(indpl) + end do + + call update_pools(tanpools(2:3), fluxes(1:5,2:3), dt, 2, 5) + + if (any(tanpools < -1e-15)) then + status = err_negative_tan * 10 + return + !end if + end if + + if (any(isnan(fluxes))) then + status = err_nan * 100 + end if + + if (abs(sum(tanpools - tanpools_old) - (-sum(fluxes) + tandep + tanprod)*dt + garbage) & + > max(sum(tanpools_old)*1e-2, 1e-4)) then + status = err_balance_tan + return + end if + + status = 0 + + end subroutine update_3pool + + subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend, runoff, tandep, tanprod, cnc_nh3_air, & + depth_slurry, poolranges, tanpools, fluxes, garbage, dt, status) + ! + ! Experimental, as above but with an additional long-lived TAN pool. + ! + implicit none + real(r8), intent(in) :: tg ! soil temperature, K + real(r8), intent(in) :: ratm ! atmospheric resistance, s/m + real(r8), intent(in) :: theta ! volumetric soil water in soil column (unaffected by slurry) + real(r8), intent(in) :: thetasat ! vol. soil water at saturation + real(r8), intent(in) :: precip ! precipitation, m/s + real(r8), intent(in) :: evap ! ground evaporation, m/s + real(r8), intent(in) :: qbot ! specific humidity (kg/kg) at lowest atmospheric model level + real(r8), intent(in) :: watertend ! time derivative of theta + real(r8), intent(in) :: runoff ! surface runoff flux, m/s + real(r8), intent(in) :: tandep ! TAN input flux, gN/m2/s + real(r8), intent(in) :: tanprod ! TAN produced in the column, added to aged TAN pool + !real(r8), intent(in) :: infiltr_slurry ! Slurry infiltration rate, m/s + real(r8), intent(in) :: depth_slurry ! Initial slurry depth, m + real(r8), intent(in) :: cnc_nh3_air ! NH3 concentration in air, gN/m3 + real(r8), intent(in) :: poolranges(4) ! age ranges of TAN pools S0, S1, S2, sec. Slurry infiltration time is inferred from S0. + real(r8), intent(inout) :: tanpools(4) ! TAN pools gN/m2 + real(r8), intent(out) :: fluxes(5,4) ! TAN fluxes, gN/m2/s (type of flux, pool) + real(r8), intent(out) :: garbage ! over-aged TAN occurring during the step, gN/m. + real(r8), intent(in) :: dt ! timestep, sec, >0 + integer, intent(out) :: status ! return status, 0 = good + + real(r8) :: infiltr_slurry, infiltrated, percolated, evap_slurry, water_slurry(2), perc_slurry_mean, waterloss + real(r8) :: percolation, water_soil, age_prev, water_in_layer, tanpools_old(4) + integer :: indpl + + real(r8), parameter :: dz_layer = 0.02 ! thickness of the volatilization layer, m + ! H+ concentration in each pool + real(r8), parameter :: Hconc(4) = (/10.0_r8**(-8.0_r8), 10.0_r8**(-8.0_r8), 10.0_r8**(-8.0_r8), 10.0_r8**(-7_r8)/) + + if (theta > thetasat) then + status = err_bad_theta + return + end if + + tanpools_old = tanpools + + ! Pool S0 + ! + evap_slurry = get_evap_pool(tg, ratm, qbot) + infiltr_slurry = max(depth_slurry / poolranges(1), precip) + infiltrated = depth_slurry * infiltr_slurry / (infiltr_slurry + evap_slurry) + ! Slurry water (in addition to soil water, theta) on surface and in soil. Represents + ! mean over pool S0. + water_slurry = (/0.5*depth_slurry, 0.5*infiltrated/) + ! The excess water assumed to have percolated down from the volat. layer. + percolated = max(infiltrated - dz_layer*(thetasat-theta), 0.0) + ! Percolation rate out of volat layer, average over the pool S0. + perc_slurry_mean = percolated / poolranges(1) + + call eval_fluxes_slurry(water_slurry, tanpools(1), Hconc(1), tg, ratm, theta, thetasat, perc_slurry_mean, & + runoff, cnc_nh3_air, fluxes(:,1)) + + if (any(isnan(fluxes))) then + status = err_nan * 10 + end if + + !tanpools(1) = tanpools(1) - sum(fluxes(:,1)) * dt + call update_pools(tanpools(1:1), fluxes(1:5,1:1), dt, 1, 5) + + if (any(tanpools < -1e-15)) then + status = err_negative_tan + return + end if + + ! Pool aging & input + ! + call age_pools_slurry(tandep, dt, water_slurry, tanpools(1), tanpools(2:), poolranges, garbage) + ! TAN produced (mineralization) goes to directly the old TAN pool. + tanpools(4) = tanpools(4) + tanprod*dt + + ! Soil bins S1 and S2 + ! + age_prev = 0 ! for water evaluations, consider beginning of S1 as the starting point + water_in_layer = infiltrated - percolated ! water in layer just after slurry has infiltrated + do indpl = 2, 4 + ! water content lost during the aging + waterloss = water_in_layer * (waterfunction(age_prev) - waterfunction(age_prev+poolranges(indpl))) + percolation = eval_perc(waterloss, evap, precip, watertend, poolranges(indpl)) + !print *, water_in_layer*waterfunction(age_prev), water_in_layer*waterfunction(age_prev+poolranges(indpl)) + ! water content at the mean age of the pool + water_soil = water_in_layer * waterfunction(age_prev + 0.5*poolranges(indpl)) + !print *, tanpools(indpl), water_soil, Hconc(indpl), tg, & + ! & ratm, theta, thetasat, percolation, runoff, cnc_nh3_air, & + ! & dz_layer + call eval_fluxes_soil(tanpools(indpl), water_soil, Hconc(indpl), tg, & + & ratm, theta, thetasat, percolation, runoff, cnc_nh3_air, & + & dz_layer, fluxes(:,indpl), subst_tan, status) + if (status /= 0) return + !print *, fluxes(4,indpl), percolation, waterloss + !fluxes(:,indpl) = 0 + !fluxes(5:,indpl) = 0 + !tanpools(indpl) = tanpools(indpl) - sum(fluxes(:,indpl)) * dt + age_prev = age_prev + poolranges(indpl) + end do + + call update_pools(tanpools(2:), fluxes(1:5,2:), dt, 3, 5) + + if (any(tanpools < -1e-15)) then + !if (any(tanpools < -1e-3)) then + status = err_negative_tan * 10 + return + !end if + end if + + if (any(isnan(fluxes))) then + status = err_nan * 100 + end if + + if (abs(sum(tanpools - tanpools_old) - (-sum(fluxes) + tandep + tanprod)*dt + garbage) > max(sum(tanpools_old)*1e-2, 1e-4)) then + !print *, sum(tanpools_old), sum(tanpools), sum(tanpools - tanpools_old) + !print *, sum(fluxes), tandep*dt, tanprod*dt + status = err_balance_tan + return + end if + !print *, sum(tanpools), sum(tanpools - tanpools_old) !+ garbage + + status = 0 + + end subroutine update_4pool + + subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend, runoff, tandep, tanprod, & + water_init, cnc_nh3_air, poolranges, Hconc, dz_layer, tanpools, fluxes, garbage, dt, status, numpools) + ! + ! Evaluate fluxes and update TAN pools for a model with arbitrary number of pools + ! divided by age and pH. + ! + implicit none + real(r8), intent(in) :: tg ! soil temperature, K + real(r8), intent(in) :: ratm ! atmospheric resistance, s/m + real(r8), intent(in) :: theta ! volumetric soil water in soil column (unaffected by slurry) + real(r8), intent(in) :: thetasat ! vol. soil water at saturation + real(r8), intent(in) :: precip ! precipitation, m/s + real(r8), intent(in) :: evap ! ground evaporation, m/s + real(r8), intent(in) :: qbot ! specific humidity (kg/kg) at lowest atmospheric model level + real(r8), intent(in) :: watertend ! time derivative of theta*dz + real(r8), intent(in) :: runoff ! surface runoff flux, m/s + real(r8), intent(in) :: tandep ! TAN input flux, gN/m2/s + real(r8), intent(in) :: tanprod(numpools) ! flux of TAN produced (from urea/organic n) in the column + real(r8), intent(in) :: water_init ! Initial water volume in the affected patch, m + real(r8), intent(in) :: cnc_nh3_air ! NH3 concentration in air, gN/m3 + real(r8), intent(in) :: poolranges(numpools) ! age ranges of TAN pools (npools) + real(r8), intent(in) :: Hconc(numpools) ! H+ concentration, mol/l (npools) + real(r8), intent(in) :: dz_layer ! thickness of the volatilization layer, m + real(r8), intent(inout) :: tanpools(numpools) ! TAN pools gN/m2 (npools) + real(r8), intent(out) :: fluxes(5,numpools) ! TAN fluxes, gN/m2/s (type of flux, pool) + real(r8), intent(out) :: garbage ! "over-aged" TAN produced during the step, gN/m. + real(r8), intent(in) :: dt ! timestep, sec, >0 + integer, intent(out) :: status ! 0 == OK + integer, intent(in) :: numpools + + real(r8) :: fraction_layer, fraction_reservoir, fraction_runoff, waterloss, direct_runoff + real(r8) :: percolation, water_soil, age_prev, tandep_remaining, direct_percolation, water_into_layer + real(r8) :: tanpools_old(size(tanpools)), imbalance + integer :: indpl + + real(r8), parameter :: water_relax_t = 24*3600.0_r8 + logical :: fixed + + tanpools_old = tanpools + + if (theta > thetasat) then + !print *, 'bad theta update_npool 1', theta, thetasat + status = err_bad_theta + return + end if + + ! Initial water excess goes to runoff if the surface is close to saturation, otherwise to the soil. + ! + call partition_to_layer(water_init, theta, thetasat, dz_layer, fraction_layer, fraction_reservoir, fraction_runoff) + direct_runoff = fraction_runoff * tandep + direct_percolation = fraction_reservoir * tandep + tandep_remaining = tandep - direct_runoff - direct_percolation + water_into_layer = water_init * (1.0_r8 - fraction_reservoir - fraction_runoff) + if (tandep_remaining < -1e-15) then + status = err_negative_tan + 10 + return + end if + if (water_into_layer/dz_layer + theta > thetasat+1e-5) then + status = err_bad_theta + return + end if + + if(any(isnan(tanpools))) then + status = err_nan + return + end if + + ! Pool aging & TAN input + ! + call age_pools_soil(tandep_remaining, dt, poolranges, tanpools, garbage) + ! TAN produced (mineralization) goes to directly the old TAN pool. + + if (any(tanpools < 0)) then + if (any(tanpools < -1e-15)) then + print *, '<0 2', tanpools_old, 'new', tanpools, 'fx', & + sum(fluxes(:,1)) * dt, sum(fluxes(:,2)) * dt, sum(fluxes(:,3)) * dt + status = err_negative_tan + 10000 + return + else + where(tanpools<0) tanpools = 0.0 + end if + end if + + imbalance = abs((sum(tanpools) - sum(tanpools_old)) - ((tandep_remaining)*dt+garbage)) + if (imbalance > max(1e-14, 0.001*sum(tanpools_old))) then + print *, imbalance, 'old', tanpools_old, 'new', tanpools, 'g', garbage, tandep_remaining, & + 'diff', sum(tanpools_old-tanpools), & + 'depprod', tandep+sum(tanprod), garbage + status = err_balance_tan*10 + return + end if + + age_prev = 0 ! for water evaluations, consider beginning of S1 as the starting point + do indpl = 1, size(tanpools) + ! water content lost during the aging + waterloss = water_into_layer * (waterfunction(age_prev) - waterfunction(age_prev+poolranges(indpl))) + percolation = eval_perc(waterloss, evap, precip, watertend, poolranges(indpl)) + ! water content at the middle of the age range + water_soil = water_into_layer * waterfunction(age_prev + 0.5*poolranges(indpl)) + call eval_fluxes_soil(tanpools(indpl), water_soil, Hconc(indpl), tg, & + & ratm, theta, thetasat, percolation, runoff, cnc_nh3_air, & + & dz_layer, fluxes(:,indpl), subst_tan, status) + if (status /= 0) then + return + end if + age_prev = age_prev + poolranges(indpl) + end do + + call update_pools(tanpools, fluxes, dt, numpools, 5, fixed) + !print *, 'pools just after', tanpools + tanpools = tanpools + tanprod*dt + if(any(isnan(tanpools))) then + status = err_nan+100 + return + end if + + if (any(isnan(fluxes))) then + status = err_nan + 1000 + end if + + if (any(tanpools < -1e-15)) then + status = err_negative_tan + 1000 + print *, '<0 2', tanpools_old, tanpools, sum(fluxes(:,1)) * dt, sum(fluxes(:,2)) * dt + + return + end if + + + if (abs(sum(tanpools - tanpools_old) + (sum(fluxes)-tandep_remaining-sum(tanprod))*dt + garbage) & + > max(sum(tanpools_old)*1e-2, 1d-2)) then + print *, tanpools, tanpools_old, 'fx', fluxes*dt, 'dp', tandep_remaining*dt, tanprod*dt, 'g', garbage, & + 'ib', sum(tanpools-tanpools_old), (sum(fluxes)-tandep_remaining-sum(tanprod))*dt + garbage, 'fix', fixed + status = err_balance_tan + return + end if + + ! Add the "direct" fluxes to the fluxes of the first pool + fluxes(iflx_roff, 1) = fluxes(iflx_roff, 1) + direct_runoff + fluxes(iflx_soilq, 1) = fluxes(iflx_soilq, 1) + direct_percolation + + if (any(fluxes < -1e-6)) then + print *, fluxes + status = err_negative_flux + return + end if + + status = 0 + + end subroutine update_npool + + subroutine update_pools(tanpools, fluxes, dt, np, nf, fixed) + ! Update tan pools using the fluxes and an ad-hoc scheme agains negative TAN masses. + implicit none + real(r8), intent(inout) :: tanpools(np), fluxes(nf,np) + real(r8), intent(in) :: dt + integer, intent(in) :: np, nf + logical, intent(out), optional :: fixed + + integer :: ip + real(r8) :: sumflux, ff + logical :: fixed_ + + fixed_ = .false. + do ip = 1, np + sumflux = sum(fluxes(:,ip))*dt + if (sumflux > tanpools(ip)) then + if (sumflux > 1e-15) then + fixed_ = .true. + ff = tanpools(ip) / sumflux + fluxes(:,ip) = fluxes(:,ip) * ff + sumflux = tanpools(ip) + sumflux = sum(fluxes(:,ip))*dt + else + sumflux = 0.0 + end if + end if + tanpools(ip) = tanpools(ip) - sumflux + end do + if (present(fixed)) fixed = fixed_ + + end subroutine update_pools + + function get_evap_pool(tg, ratm, qbot) result(evap) + ! Evaluate evaporation rate for surface water given spcific humidity at the reference + ! height. + implicit none + real(r8), intent(in) :: tg, ratm, qbot + real(r8) :: evap ! m/s + + real(r8) :: es, esdt, qs, qsdt, dens, flux + real(r8), parameter :: press = 101300.0_r8 + + call qsat(tg, press, es, esdt, qs, qsdt) + if (qbot > qs) then + evap = 0 + return + end if + + dens = press / (SHR_CONST_RDAIR * tg) + flux = dens * (qs - qbot) / ratm ! kg/s/m2 == mm/s + evap = flux*1e-3 + + end function get_evap_pool + + function waterfunction(pool_age) result(water) + implicit none + real(r8), intent(in) :: pool_age ! sec + real(r8) :: water + + water = exp(-pool_age / water_relax_t) + end function waterfunction + + function eval_perc(waterloss, evap, precip, watertend, dt) result(rate) + ! + ! Evaluate the downwards water flux at the layer bottom given the infiltration and + ! evaporation fluxes. + implicit none + real(r8), intent(in) :: waterloss ! total water loss during dt, m + real(r8), intent(in) :: evap ! average evaporation rate, m/s + real(r8), intent(in) :: precip ! average infiltration rate, m/s + real(r8), intent(in) :: watertend ! background water tendency, m/s + real(r8), intent(in) :: dt ! timespan, s + + real(r8) :: rate ! percolation rate, m/s + real(r8) :: perc_base, perc_adj + + perc_base = waterloss / dt + perc_adj = perc_base + precip - evap - watertend + rate = max(perc_adj, 0.0) + + end function eval_perc + + subroutine eval_fluxes_storage(nitr_input, tempr_outside, windspeed, fract_direct, & + volat_coef_barns, volat_coef_stores, & + tan_fract_excr, fluxes_nitr, fluxes_tan, status) + ! + ! Evaluate nitrogen fluxes in animal housings and storage. Only volatilization losses + ! are assumed. The volatilization fluxes are assumed to depend linearly on the TAN + ! fluxes entering the housings or storage. The base coefficients are given as + ! arguments and adjusted according the model of Gyldenkaerne et al. + ! + implicit none + real(r8), intent(in) :: nitr_input ! total nitrogen excreted by animals in housings + real(r8), intent(in) :: tempr_outside ! K + real(r8), intent(in) :: windspeed ! m/s + real(r8), intent(in) :: fract_direct + real(r8), intent(in) :: volat_coef_barns, volat_coef_stores + real(r8), intent(in) :: tan_fract_excr ! fraction of NH4 nitrogen in excreted N + real(r8), intent(out) :: fluxes_nitr(4), fluxes_tan(4) + integer, intent(out) :: status + + ! parameters for the Gyldenkaerne et al. parameterization + real(r8), parameter :: Tfloor_barns = 4.0_8, Tfloor_stores = 1.0_8 + real(r8), parameter :: Tmin_barns = 0_8 + real(r8), parameter :: Tmax_barns = 12.5_8 + real(r8), parameter :: tempr_D = 3.0 + real(r8), parameter :: Vmin_barns = 0.2_8 + real(r8), parameter :: Vmax_barns = 0.228_8 + real(r8), parameter :: pA = 0.89_8, pB = 0.26_8 + + real(r8) :: flux_avail, flux_avail_tan, tempr_stores, tempr_barns, vent_barns, flux_direct, flux_direct_tan, & + & flux_barn, flux_store, tempr_C + + fluxes_nitr = 0.0_r8 + fluxes_tan = 0.0_r8 + tempr_C = tempr_outside - 273 + + tempr_barns = max(tempr_C+tempr_D, Tfloor_barns) + if (tempr_C < Tmin_barns) then + vent_barns = Vmin_barns + else if (tempr_C > Tmax_barns) then + vent_barns = Vmax_barns + else + vent_barns = Vmin_barns + tempr_C * (Vmax_barns-Vmin_barns) / (Tmax_barns - Tmin_barns) + end if + + flux_avail = nitr_input + flux_avail_tan = nitr_input * tan_fract_excr + + if (flux_avail < -1e-15 .or. flux_avail_tan < -1e-15) then + status = err_negative_flux + return + end if + + flux_barn = flux_avail_tan * volat_coef_barns * tempr_barns**pA * vent_barns**pB + + fluxes_tan(iflx_air_barns) = flux_barn + fluxes_nitr(iflx_air_barns) = flux_barn + + flux_avail = flux_avail - flux_barn + flux_avail_tan = flux_avail_tan - flux_barn + + if (flux_avail < 0 .or. flux_avail_tan < 0) then + status = err_negative_flux + return + end if + + flux_direct = fract_direct * flux_avail + flux_avail = flux_avail - flux_direct + flux_direct_tan = flux_avail_tan * fract_direct + flux_avail_tan = flux_avail_tan - flux_direct_tan + + fluxes_tan(iflx_appl) = flux_direct_tan + fluxes_nitr(iflx_appl) = flux_direct + + tempr_stores = max(Tfloor_stores, tempr_C) + flux_store = flux_avail_tan & + & * volat_coef_stores * tempr_stores**pA * windspeed**pB + + fluxes_tan(iflx_air_stores) = flux_store + fluxes_nitr(iflx_air_stores) = flux_store + + flux_avail = flux_avail - flux_store + flux_avail_tan = flux_avail_tan - flux_store + if (flux_avail < 0) then + !print *, 'stores' + status = err_negative_flux + return + end if + + fluxes_nitr(iflx_to_store) = flux_avail + fluxes_tan(iflx_to_store) = flux_avail_tan + + if (abs(sum(fluxes_nitr) - nitr_input) > 1e-5*nitr_input) then + !print *, fluxes_nitr, sum(fluxes_nitr), nitr_input + status = err_balance_nitr + return + end if + + if (abs(sum(fluxes_tan) - nitr_input*tan_fract_excr) > 1e-5*nitr_input) then + status = err_balance_tan + return + end if + + if (any(fluxes_nitr < 0) .or. any(fluxes_tan < 0)) then + !print *, 'final' + status = err_negative_flux + return + end if + + status = 0 + + end subroutine eval_fluxes_storage + + subroutine update_org_n(flux_input, tg, pools, dt, tanprod, soilflux) + ! + ! Evaluate the decomposition/mineralization N fluxes from the available, resistant and + ! unavailable N fractions, and update the organic N pools. In addition, evaluate the + ! flux of organic N into the soil pools according to a fixed time constant set below. + implicit none + real(r8), intent(in) :: flux_input(3) ! organic N entering the pools. gN/m2/s. For + ! indices see at top of the module. + real(r8), intent(in) :: tg ! ground temperature, K + real(r8), intent(inout) :: pools(3) ! organic N pools + real(r8), intent(in) :: dt ! timestep, sec + real(r8), intent(out) :: tanprod(3) ! Flux of TAN formed, both pools + real(r8), intent(out) :: soilflux ! Flux of organic nitrogen to soil + + real(r8) :: rate_res, rate_avail, TR + real(r8), parameter :: ka1 = 8.94e-7_r8, ka2 = 6.38e-8 ! 1/s + real(r8), parameter :: tr1 = 0.0106, tr2 = 0.12979 + real(r8), parameter :: org_to_soil_time = 365*24*3600.0_r8 + + real(r8) :: soilfluxes(3) + + TR = tr1 * exp(tr2 * (tg-273.15_r8)) + tanprod(ind_avail) = ka1 * TR * pools(ind_avail) + tanprod(ind_resist) = ka2 * TR * pools(ind_resist) + tanprod(ind_unavail) = 0.0 + soilfluxes = pools * 1.0_r8 / org_to_soil_time + + pools = pools + (flux_input - tanprod - soilfluxes) * dt + soilflux = sum(soilfluxes) + + end subroutine update_org_n + + subroutine update_urea(tg, theta, thetasat, precip, evap, watertend, runoff, & + ndep, pools, fluxes, garbage, ranges, dt, status, numpools) + ! + ! Evaluate fluxes and update the urea pools. The procedure is similar to updating the + ! soil TAN pools, but NO3 and volatilization fluxes do not occur. + ! + implicit none + real(r8), intent(in) :: tg ! soil temperature, K + real(r8), intent(in) :: theta ! volumetric soil water in soil column (background) + real(r8), intent(in) :: thetasat ! vol. soil water at saturation + real(r8), intent(in) :: precip ! precipitation, m/s + real(r8), intent(in) :: evap ! ground evaporation, m/s + real(r8), intent(in) :: watertend ! time derivative of theta*dz + real(r8), intent(in) :: runoff ! surface runoff flux, m/s + real(r8), intent(in) :: ndep + real(r8), intent(inout) :: pools(numpools) + real(r8), intent(out) :: fluxes(6, numpools) ! one extra for the to_tan flux + real(r8), intent(in) :: ranges(numpools) + real(r8), intent(out) :: garbage + real(r8), intent(in) :: dt + integer, intent(out) :: status + integer, intent(in) :: numpools + + real(r8), parameter :: rate = 4.83e-6 ! 1/s + real(r8), parameter :: missing = 1e36 ! for the parameters not needed for urea fluxes + real(r8), parameter :: dz_layer = 0.02 ! thickness of the volatilization layer, m + + real(r8) :: age_prev, percolation, old_total, balance + integer :: indpl + + old_total = sum(pools) + + call age_pools_soil(ndep, dt, ranges, pools, garbage) + + age_prev = 0 + do indpl = 1, numpools + percolation = eval_perc(0.0_r8, evap, precip, watertend, ranges(indpl)) + call eval_fluxes_soil(pools(indpl), 0.0_r8, missing, tg, & + & missing, theta, thetasat, percolation, runoff, missing, & + & dz_layer, fluxes(1:5,indpl), subst_urea, status) + if (status /= 0) then + return + end if + fluxes(iflx_to_tan, indpl) = rate*pools(indpl) + age_prev = age_prev + ranges(indpl) + end do + + ! Here goes also flux_tan! + call update_pools(pools, fluxes, dt, numpools, 6) + + balance = sum(pools) - old_total + if (abs(balance - (ndep-sum(fluxes))*dt + garbage) > 1e-9) then + print *, balance, 'f', sum(fluxes)*dt, ndep*dt, (ndep-sum(fluxes))*dt-garbage - balance, & + 'p', pools, 'g', garbage + status = err_balance_nitr + return + end if + + status = 0 + + end subroutine update_urea + + subroutine get_storage_fluxes_tan_ar(manure_excr, tempr_outside, windspeed, fract_direct, & + & flux_direct, flux_direct_tan, flux_barn, flux_store, flux_resid, flux_resid_tan, & + & volat_target_barns, volat_target_stores, volat_coef_barns, volat_coef_stores, tan_fract_excr, nn) + + real(8), intent(in), dimension(nn) :: manure_excr, tempr_outside, windspeed, fract_direct + real(8), intent(out), dimension(nn) :: flux_barn, flux_store, flux_direct, flux_resid, & + & flux_direct_tan, flux_resid_tan + real(8), intent(in) :: volat_target_barns, volat_target_stores, volat_coef_barns, volat_coef_stores, tan_fract_excr + integer, intent(in) :: nn + + integer :: ii, status + real(r8) :: fluxes_nitr(4), fluxes_tan(4) + + do ii = 1, nn + call eval_fluxes_storage(manure_excr(ii), tempr_outside(ii), windspeed(ii), fract_direct(ii), & + & volat_coef_barns, volat_coef_stores, tan_fract_excr, & + & fluxes_nitr, fluxes_tan, status) + + if (status /= 0) then + print *, 'Status = ', status + return + end if + + flux_direct(ii) = fluxes_nitr(iflx_appl) + flux_direct_tan(ii) = fluxes_tan(iflx_appl) + flux_barn(ii) = fluxes_tan(iflx_air_barns) + flux_store(ii) = fluxes_tan(iflx_air_stores) + flux_resid(ii) = fluxes_nitr(iflx_to_store) + flux_resid_tan(ii) = fluxes_tan(iflx_to_store) + !print *, '1', fluxes_nitr(iflx_appl), flux_direct(ii) + + end do + end subroutine get_storage_fluxes_tan_ar + +end module FanMod diff --git a/src/biogeophys/HydrologyNoDrainageMod.F90 b/src/biogeophys/HydrologyNoDrainageMod.F90 index 6ab5e8d98e..476a6960b1 100644 --- a/src/biogeophys/HydrologyNoDrainageMod.F90 +++ b/src/biogeophys/HydrologyNoDrainageMod.F90 @@ -7,7 +7,10 @@ Module HydrologyNoDrainageMod use shr_kind_mod , only : r8 => shr_kind_r8 use shr_log_mod , only : errMsg => shr_log_errMsg use decompMod , only : bounds_type - use clm_varctl , only : iulog, use_vichydro, use_fates +!KO use clm_varctl , only : iulog, use_vichydro, use_fates +!KO + use clm_varctl , only : iulog, use_vichydro, use_fan, use_fates +!KO use clm_varcon , only : e_ice, denh2o, denice, rpi, spval use CLMFatesInterfaceMod, only : hlm_fates_interface_type use atm2lndType , only : atm2lnd_type @@ -146,6 +149,9 @@ subroutine HydrologyNoDrainage(bounds, & snowliq => waterstate_inst%snowliq_col , & ! Output: [real(r8) (:) ] average snow liquid water snow_persistence => waterstate_inst%snow_persistence_col , & ! Output: [real(r8) (:) ] counter for length of time snow-covered h2osoi_liqice_10cm => waterstate_inst%h2osoi_liqice_10cm_col , & ! Output: [real(r8) (:) ] liquid water + ice lens in top 10cm of soil (kg/m2) +!KO +! h2osoi_liqice_5cm => waterstate_inst%h2osoi_liqice_5cm_col , & ! Output: [real(r8) (:) ] liquid water + ice lens in top 5cm of soil (kg/m2) +!KO h2osoi_ice => waterstate_inst%h2osoi_ice_col , & ! Output: [real(r8) (:,:) ] ice lens (kg/m2) h2osoi_liq => waterstate_inst%h2osoi_liq_col , & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) h2osoi_ice_tot => waterstate_inst%h2osoi_ice_tot_col , & ! Output: [real(r8) (:) ] vertically summed ice lens (kg/m2) @@ -301,6 +307,9 @@ subroutine HydrologyNoDrainage(bounds, & ! Determine ground temperature, ending water balance and volumetric soil water ! Calculate soil temperature and total water (liq+ice) in top 10cm of soil ! Calculate soil temperature and total water (liq+ice) in top 17cm of soil +!KO + ! Calculate total water (liq+ice) in top 5cm of soil +!KO do fc = 1, num_nolakec c = filter_nolakec(fc) l = col%landunit(c) @@ -308,6 +317,11 @@ subroutine HydrologyNoDrainage(bounds, & t_soi_10cm(c) = 0._r8 tsoi17(c) = 0._r8 h2osoi_liqice_10cm(c) = 0._r8 +!KO + if ( use_fan ) then + waterstate_inst%h2osoi_liqice_5cm_col(c) = 0._r8 + end if +!KO h2osoi_liq_tot(c) = 0._r8 h2osoi_ice_tot(c) = 0._r8 end if @@ -328,12 +342,30 @@ subroutine HydrologyNoDrainage(bounds, & end if end if + !JV + if ( use_fan ) then + if (zi(c,j-1) < 0.05_r8) then + if (zi(c,j) < 0.05_r8) then + fracl = 1.0_r8 + else + fracl = (0.05_r8 - zi(c,j-1)) / dz(c,j) + end if + waterstate_inst%h2osoi_liqice_5cm_col(c) = & + waterstate_inst%h2osoi_liqice_5cm_col(c) + & + (h2osoi_liq(c,j)+h2osoi_ice(c,j))* & + fracl + end if + end if + !JV + if (zi(c,j) <= 0.1_r8) then fracl = 1._r8 t_soi_10cm(c) = t_soi_10cm(c) + t_soisno(c,j)*dz(c,j)*fracl h2osoi_liqice_10cm(c) = h2osoi_liqice_10cm(c) + & (h2osoi_liq(c,j)+h2osoi_ice(c,j))* & fracl + !KO + !KO else if (zi(c,j) > 0.1_r8 .and. zi(c,j-1) < 0.1_r8) then fracl = (0.1_r8 - zi(c,j-1))/dz(c,j) diff --git a/src/biogeophys/TemperatureType.F90 b/src/biogeophys/TemperatureType.F90 index a797159829..01c98db16d 100644 --- a/src/biogeophys/TemperatureType.F90 +++ b/src/biogeophys/TemperatureType.F90 @@ -7,7 +7,10 @@ module TemperatureType use shr_log_mod , only : errMsg => shr_log_errMsg use decompMod , only : bounds_type use abortutils , only : endrun - use clm_varctl , only : use_cndv, iulog, use_luna, use_crop +!KO use clm_varctl , only : use_cndv, iulog, use_luna, use_crop +!KO + use clm_varctl , only : use_cndv, iulog, use_luna, use_crop, use_fan +!KO use clm_varpar , only : nlevsno, nlevgrnd, nlevlak, nlevlak, nlevurb use clm_varcon , only : spval, ispval use GridcellType , only : grc @@ -549,11 +552,19 @@ subroutine InitHistory(this, bounds, is_simple_buildtemp, is_prog_buildtemp ) ptr_patch=this%gdd0_patch, default='inactive') end if - if (use_crop) then +!KO + if (use_crop .or. use_fan) then this%gdd8_patch(begp:endp) = spval call hist_addfld1d (fname='GDD8', units='ddays', & avgflag='A', long_name='Growing degree days base 8C from planting', & ptr_patch=this%gdd8_patch, default='inactive') + end if + + if (use_crop) then +!KO this%gdd8_patch(begp:endp) = spval +!KO call hist_addfld1d (fname='GDD8', units='ddays', & +!KO avgflag='A', long_name='Growing degree days base 8C from planting', & +!KO ptr_patch=this%gdd8_patch, default='inactive') this%gdd10_patch(begp:endp) = spval call hist_addfld1d (fname='GDD10', units='ddays', & @@ -1118,16 +1129,32 @@ subroutine InitAccBuffer (this, bounds) desc='10-day running mean of 2-m temperature', accum_type='runmean', accum_period=-10, & subgrid_type='pft', numlev=1,init_value=SHR_CONST_TKFRZ+20._r8) - if ( use_crop )then +!KO + if ( use_crop .or. use_fan ) then call init_accum_field (name='TDM10', units='K', & desc='10-day running mean of min 2-m temperature', accum_type='runmean', accum_period=-10, & subgrid_type='pft', numlev=1, init_value=SHR_CONST_TKFRZ) + end if +!KO + + if ( use_crop )then +!KO call init_accum_field (name='TDM10', units='K', & +!KO desc='10-day running mean of min 2-m temperature', accum_type='runmean', accum_period=-10, & +!KO subgrid_type='pft', numlev=1, init_value=SHR_CONST_TKFRZ) call init_accum_field (name='TDM5', units='K', & desc='5-day running mean of min 2-m temperature', accum_type='runmean', accum_period=-5, & subgrid_type='pft', numlev=1, init_value=SHR_CONST_TKFRZ) end if +!KO + if ( use_crop .or. use_fan ) then + call init_accum_field (name='GDD8', units='K', & + desc='growing degree-days base 8C from planting', accum_type='runaccum', accum_period=not_used, & + subgrid_type='pft', numlev=1, init_value=0._r8) + end if +!KO + if ( use_crop )then ! All GDD summations are relative to the planting date (Kucharik & Brye 2003) @@ -1135,9 +1162,9 @@ subroutine InitAccBuffer (this, bounds) desc='growing degree-days base 0C from planting', accum_type='runaccum', accum_period=not_used, & subgrid_type='pft', numlev=1, init_value=0._r8) - call init_accum_field (name='GDD8', units='K', & - desc='growing degree-days base 8C from planting', accum_type='runaccum', accum_period=not_used, & - subgrid_type='pft', numlev=1, init_value=0._r8) +!KO call init_accum_field (name='GDD8', units='K', & +!KO desc='growing degree-days base 8C from planting', accum_type='runaccum', accum_period=not_used, & +!KO subgrid_type='pft', numlev=1, init_value=0._r8) call init_accum_field (name='GDD10', units='K', & desc='growing degree-days base 10C from planting', accum_type='runaccum', accum_period=not_used, & @@ -1203,9 +1230,16 @@ subroutine InitAccVars(this, bounds) call extract_accum_field ('T10', rbufslp, nstep) this%t_a10_patch(begp:endp) = rbufslp(begp:endp) - if (use_crop) then +!KO + if ( use_crop .or. use_fan ) then call extract_accum_field ('TDM10', rbufslp, nstep) this%t_a10min_patch(begp:endp)= rbufslp(begp:endp) + end if +!KO + + if (use_crop) then +!KO call extract_accum_field ('TDM10', rbufslp, nstep) +!KO this%t_a10min_patch(begp:endp)= rbufslp(begp:endp) call extract_accum_field ('TDM5', rbufslp, nstep) this%t_a5min_patch(begp:endp) = rbufslp(begp:endp) @@ -1232,13 +1266,20 @@ subroutine InitAccVars(this, bounds) this%t_ref2m_min_inst_u_patch(begp:endp) = spval end if +!KO + if ( use_crop .or. use_fan ) then + call extract_accum_field ('GDD8', rbufslp, nstep) ; + this%gdd8_patch(begp:endp) = rbufslp(begp:endp) + end if +!KO + if ( use_crop ) then call extract_accum_field ('GDD0', rbufslp, nstep) this%gdd0_patch(begp:endp) = rbufslp(begp:endp) - call extract_accum_field ('GDD8', rbufslp, nstep) ; - this%gdd8_patch(begp:endp) = rbufslp(begp:endp) +!KO call extract_accum_field ('GDD8', rbufslp, nstep) ; +!KO this%gdd8_patch(begp:endp) = rbufslp(begp:endp) call extract_accum_field ('GDD10', rbufslp, nstep) this%gdd10_patch(begp:endp) = rbufslp(begp:endp) @@ -1387,7 +1428,8 @@ subroutine UpdateAccVars (this, bounds) call update_accum_field ('T10', this%t_ref2m_patch, nstep) call extract_accum_field ('T10', this%t_a10_patch, nstep) - if ( use_crop )then +!KO + if ( use_crop .or. use_fan ) then ! Accumulate and extract TDM10 do p = begp,endp @@ -1397,6 +1439,35 @@ subroutine UpdateAccVars (this, bounds) call update_accum_field ('TDM10', rbufslp, nstep) call extract_accum_field ('TDM10', this%t_a10min_patch, nstep) + ! Accumulate and extract GDD8 + + do p = begp,endp + g = patch%gridcell(p) + if (month==1 .and. day==1 .and. secs==dtime) then + rbufslp(p) = accumResetVal ! reset gdd + else if (( month > 3 .and. month < 10 .and. grc%latdeg(g) >= 0._r8) .or. & + ((month > 9 .or. month < 4) .and. grc%latdeg(g) < 0._r8) ) then + rbufslp(p) = max(0._r8, min(30._r8, & + this%t_ref2m_patch(p)-(SHR_CONST_TKFRZ + 8._r8))) * dtime/SHR_CONST_CDAY + else + rbufslp(p) = 0._r8 ! keeps gdd unchanged at other times (eg, through Dec in NH) + end if + end do + call update_accum_field ('GDD8', rbufslp, nstep) + call extract_accum_field ('GDD8', this%gdd8_patch, nstep) + end if +!KO + + if ( use_crop )then +!KO ! Accumulate and extract TDM10 + +!KO do p = begp,endp +!KO rbufslp(p) = min(this%t_ref2m_min_patch(p),this%t_ref2m_min_inst_patch(p)) !slevis: ok choice? +!KO if (rbufslp(p) > 1.e30_r8) rbufslp(p) = SHR_CONST_TKFRZ !and were 'min'& +!KO end do !'min_inst' not initialized? +!KO call update_accum_field ('TDM10', rbufslp, nstep) +!KO call extract_accum_field ('TDM10', this%t_a10min_patch, nstep) + ! Accumulate and extract TDM5 do p = begp,endp diff --git a/src/biogeophys/WaterStateType.F90 b/src/biogeophys/WaterStateType.F90 index edf49686de..3f8a3b6630 100644 --- a/src/biogeophys/WaterStateType.F90 +++ b/src/biogeophys/WaterStateType.F90 @@ -10,7 +10,10 @@ module WaterstateType use shr_kind_mod , only : r8 => shr_kind_r8 use shr_log_mod , only : errMsg => shr_log_errMsg use decompMod , only : bounds_type - use clm_varctl , only : use_vancouver, use_mexicocity, use_cn, iulog, use_luna +!KO use clm_varctl , only : use_vancouver, use_mexicocity, use_cn, iulog, use_luna +!KO + use clm_varctl , only : use_vancouver, use_mexicocity, use_cn, iulog, use_luna, use_fan +!KO use clm_varpar , only : nlevgrnd, nlevurb, nlevsno use clm_varcon , only : spval use LandunitType , only : lun @@ -39,6 +42,9 @@ module WaterstateType real(r8), pointer :: h2osoi_liq_tot_col (:) ! vertically summed col liquid water (kg/m2) (new) (-nlevsno+1:nlevgrnd) real(r8), pointer :: h2osoi_ice_tot_col (:) ! vertically summed col ice lens (kg/m2) (new) (-nlevsno+1:nlevgrnd) real(r8), pointer :: h2osoi_liqice_10cm_col (:) ! col liquid water + ice lens in top 10cm of soil (kg/m2) +!KO + real(r8), pointer :: h2osoi_liqice_5cm_col (:) ! col liquid water + ice lens in top 5cm of soil (kg/m2) +!KO real(r8), pointer :: h2osoi_vol_col (:,:) ! col volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] (nlevgrnd) real(r8), pointer :: air_vol_col (:,:) ! col air filled porosity real(r8), pointer :: h2osoi_liqvol_col (:,:) ! col volumetric liquid water content (v/v) @@ -183,6 +189,11 @@ subroutine InitAllocate(this, bounds) allocate(this%h2osno_col (begc:endc)) ; this%h2osno_col (:) = nan allocate(this%h2osno_old_col (begc:endc)) ; this%h2osno_old_col (:) = nan allocate(this%h2osoi_liqice_10cm_col (begc:endc)) ; this%h2osoi_liqice_10cm_col (:) = nan +!KO + if ( use_fan ) then + allocate(this%h2osoi_liqice_5cm_col (begc:endc)) ; this%h2osoi_liqice_5cm_col (:) = nan + end if +!KO allocate(this%h2osoi_vol_col (begc:endc, 1:nlevgrnd)) ; this%h2osoi_vol_col (:,:) = nan allocate(this%air_vol_col (begc:endc, 1:nlevgrnd)) ; this%air_vol_col (:,:) = nan allocate(this%h2osoi_liqvol_col (begc:endc,-nlevsno+1:nlevgrnd)) ; this%h2osoi_liqvol_col (:,:) = nan @@ -307,6 +318,14 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='soil liquid water + ice in top 10cm of soil (veg landunits only)', & ptr_col=this%h2osoi_liqice_10cm_col, set_urb=spval, set_lake=spval, l2g_scale_type='veg') +!KO + if ( use_fan ) then + this%h2osoi_liqice_5cm_col(begc:endc) = spval + call hist_addfld1d (fname='SOILWATER_5CM', units='kg/m2', & + avgflag='A', long_name='soil liquid water + ice in top 5cm of soil (veg landunits only)', & + ptr_col=this%h2osoi_liqice_5cm_col, set_urb=spval, set_lake=spval, l2g_scale_type='veg') + end if +!KO this%h2osoi_liq_tot_col(begc:endc) = spval call hist_addfld1d (fname='TOTSOILLIQ', units='kg/m2', & avgflag='A', long_name='vertically summed soil liquid water (veg landunits only)', & diff --git a/src/biogeophys/WaterfluxType.F90 b/src/biogeophys/WaterfluxType.F90 index 1a77328305..b2e1ac8f54 100644 --- a/src/biogeophys/WaterfluxType.F90 +++ b/src/biogeophys/WaterfluxType.F90 @@ -668,6 +668,9 @@ subroutine InitCold(this, bounds) this%qflx_h2osfc_surf_col(bounds%begc:bounds%endc) = 0._r8 this%qflx_snow_drain_col(bounds%begc:bounds%endc) = 0._r8 +!KO + this%qflx_runoff_col(bounds%begc:bounds%endc) = 0._r8 +!KO ! This variable only gets set in the hydrology filter; need to initialize it to 0 for ! the sake of columns outside this filter @@ -731,6 +734,17 @@ subroutine Restart(this, bounds, ncid, flag) ! initial run, not restart: initialize qflx_snow_drain to zero this%AnnET(bounds%begc:bounds%endc) = 0._r8 endif + +!KO + call restartvar(ncid=ncid, flag=flag, varname='qflx_runoff', xtype=ncd_double, & + dim1name='column', & + long_name='total runoff (qflx_drain+qflx_surf+qflx_qrgwl)', units='mm/s', & + interpinic_flag='interp', readvar=readvar, data=this%qflx_runoff_col) + if (flag == 'read' .and. .not. readvar) then + ! initial run, not restart: initialize qflx_runoff to zero + this%qflx_runoff_col(bounds%begc:bounds%endc) = 0._r8 + endif +!KO call this%qflx_liq_dynbal_dribbler%Restart(bounds, ncid, flag) call this%qflx_ice_dynbal_dribbler%Restart(bounds, ncid, flag) diff --git a/src/main/atm2lndType.F90 b/src/main/atm2lndType.F90 index 09a2a5002e..c89bc97943 100644 --- a/src/main/atm2lndType.F90 +++ b/src/main/atm2lndType.F90 @@ -10,7 +10,10 @@ module atm2lndType use shr_log_mod , only : errMsg => shr_log_errMsg use clm_varpar , only : numrad, ndst, nlevgrnd !ndst = number of dust bins. use clm_varcon , only : rair, grav, cpair, hfus, tfrz, spval - use clm_varctl , only : iulog, use_c13, use_cn, use_lch4, use_cndv, use_fates, use_luna +!KO use clm_varctl , only : iulog, use_c13, use_cn, use_lch4, use_cndv, use_fates, use_luna +!KO + use clm_varctl , only : iulog, use_c13, use_cn, use_lch4, use_cndv, use_fates, use_luna, use_fan +!KO use decompMod , only : bounds_type use abortutils , only : endrun use PatchType , only : patch @@ -86,6 +89,10 @@ module atm2lndType real(r8), pointer :: forc_solai_grc (:,:) => null() ! diffuse radiation (numrad) (vis=forc_solsd, nir=forc_solld) real(r8), pointer :: forc_solar_grc (:) => null() ! incident solar radiation real(r8), pointer :: forc_ndep_grc (:) => null() ! nitrogen deposition rate (gN/m2/s) +!KO + real(r8), pointer :: forc_ndep2_grc (:) => null() ! FAN nitrogen deposition (manure) rate (gN/m2/s) + real(r8), pointer :: forc_ndep3_grc (:) => null() ! FAN nitrogen deposition (fertilizer) rate (gN/m2/s) +!KO real(r8), pointer :: forc_pc13o2_grc (:) => null() ! C13O2 partial pressure (Pa) real(r8), pointer :: forc_po2_grc (:) => null() ! O2 partial pressure (Pa) real(r8), pointer :: forc_po2_240_patch (:) => null() ! 10-day mean O2 partial pressure (Pa) @@ -509,6 +516,12 @@ subroutine InitAllocate(this, bounds) allocate(this%forc_solai_grc (begg:endg,numrad)) ; this%forc_solai_grc (:,:) = ival allocate(this%forc_solar_grc (begg:endg)) ; this%forc_solar_grc (:) = ival allocate(this%forc_ndep_grc (begg:endg)) ; this%forc_ndep_grc (:) = ival +!KO + if ( use_fan ) then + allocate(this%forc_ndep2_grc (begg:endg)) ; this%forc_ndep2_grc (:) = ival + allocate(this%forc_ndep3_grc (begg:endg)) ; this%forc_ndep3_grc (:) = ival + end if +!KO allocate(this%forc_pc13o2_grc (begg:endg)) ; this%forc_pc13o2_grc (:) = ival allocate(this%forc_po2_grc (begg:endg)) ; this%forc_po2_grc (:) = ival allocate(this%forc_aer_grc (begg:endg,14)) ; this%forc_aer_grc (:,:) = ival @@ -1224,6 +1237,10 @@ subroutine Clean(this) deallocate(this%forc_solai_grc) deallocate(this%forc_solar_grc) deallocate(this%forc_ndep_grc) +!KO + deallocate(this%forc_ndep2_grc) + deallocate(this%forc_ndep3_grc) +!KO deallocate(this%forc_pc13o2_grc) deallocate(this%forc_po2_grc) deallocate(this%forc_aer_grc) diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index 9cbbe51f25..c18eff3f6e 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -10,7 +10,10 @@ module clm_driver ! !USES: use shr_kind_mod , only : r8 => shr_kind_r8 use clm_varctl , only : wrtdia, iulog, use_fates - use clm_varctl , only : use_cn, use_lch4, use_noio, use_c13, use_c14 +!KO use clm_varctl , only : use_cn, use_lch4, use_voc, use_noio, use_c13, use_c14 +!KO + use clm_varctl , only : use_fan, use_cn, use_lch4, use_noio, use_c13, use_c14 +!KO use clm_varctl , only : use_crop, ndep_from_cpl use clm_varctl , only : is_cold_start, is_interpolated_start use clm_time_manager , only : get_nstep, is_beg_curr_day @@ -54,6 +57,10 @@ module clm_driver use SoilBiogeochemVerticalProfileMod , only : SoilBiogeochemVerticalProfile use SatellitePhenologyMod , only : SatellitePhenology, interpMonthlyVeg use ndepStreamMod , only : ndep_interp +!KO + use ndep2StreamMod , only : ndep2_interp + use ndep3StreamMod , only : ndep3_interp +!KO use ActiveLayerMod , only : alt_calc use ch4Mod , only : ch4, ch4_init_balance_check use DUSTMod , only : DustDryDep, DustEmission @@ -377,6 +384,12 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro call bgc_vegetation_inst%InterpFileInputs(bounds_proc) call t_stopf('bgc_interp') end if +!KO + if (use_cn .and. use_fan) then + call ndep2_interp(bounds_proc, atm2lnd_inst) + call ndep3_interp(bounds_proc, atm2lnd_inst) + end if +!KO ! Get time varying urban data call urbantv_inst%urbantv_interp(bounds_proc) @@ -813,7 +826,10 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro atm2lnd_inst, waterstate_inst, waterflux_inst, & canopystate_inst, soilstate_inst, temperature_inst, crop_inst, ch4_inst, & photosyns_inst, soilhydrology_inst, energyflux_inst, & - nutrient_competition_method, fireemis_inst) +!KO nutrient_competition_method, fireemis_inst) +!KO + nutrient_competition_method, fireemis_inst, frictionvel_inst) +!KO call t_stopf('ecosysdyn') diff --git a/src/main/clm_initializeMod.F90 b/src/main/clm_initializeMod.F90 index 7c888c6252..cd6882faff 100644 --- a/src/main/clm_initializeMod.F90 +++ b/src/main/clm_initializeMod.F90 @@ -266,7 +266,10 @@ subroutine initialize2( ) use clm_varcon , only : spval use clm_varctl , only : finidat, finidat_interp_source, finidat_interp_dest, fsurdat use clm_varctl , only : use_century_decomp, single_column, scmlat, scmlon, use_cn, use_fates - use clm_varctl , only : use_crop, ndep_from_cpl +!KO use clm_varctl , only : use_crop +!KO + use clm_varctl , only : use_crop, use_fan, ndep_from_cpl +!KO use clm_varorb , only : eccen, mvelpp, lambm0, obliqr use clm_time_manager , only : get_step_size, get_curr_calday use clm_time_manager , only : get_curr_date, get_nstep, advance_timestep @@ -282,6 +285,10 @@ subroutine initialize2( ) use restFileMod , only : restFile_getfile, restFile_open, restFile_close use restFileMod , only : restFile_read, restFile_write use ndepStreamMod , only : ndep_init, ndep_interp +!KO + use ndep2StreamMod , only : ndep2_init, ndep2_interp + use ndep3StreamMod , only : ndep3_init, ndep3_interp +!KO use LakeCon , only : LakeConInit use SatellitePhenologyMod , only : SatellitePhenologyInit, readAnnualVegetation, interpMonthlyVeg use SnowSnicarMod , only : SnowAge_init, SnowOptics_init @@ -571,6 +578,19 @@ subroutine initialize2( ) call ndep_interp(bounds_proc, atm2lnd_inst) end if call t_stopf('init_ndep') +!KO + if ( use_fan ) then + call t_startf('init_ndep2') + call ndep2_init(bounds_proc, NLFilename) + call ndep2_interp(bounds_proc, atm2lnd_inst) + call t_stopf('init_ndep2') + + call t_startf('init_ndep3') + call ndep3_init(bounds_proc, NLFilename) + call ndep3_interp(bounds_proc, atm2lnd_inst) + call t_stopf('init_ndep3') + end if +!KO end if ! ------------------------------------------------------------------------ diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index a8362dd8aa..cc1b1ae4bb 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -247,6 +247,14 @@ module clm_varctl logical, public :: use_hydrstress = .false. ! true => use plant hydraulic stress calculation +!KO + !---------------------------------------------------------- + ! FAN (Flow of Agricultural Nitrogen) switch + !---------------------------------------------------------- + + logical, public :: use_fan = .false. ! true => use FAN model +!KO + !---------------------------------------------------------- ! dynamic root switch !---------------------------------------------------------- diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index daa16205b7..9ca8952831 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -233,6 +233,10 @@ subroutine control_init( ) namelist /clm_inparm/ use_hydrstress +!KO + namelist /clm_inparm/ use_fan +!KO + namelist /clm_inparm/ use_dynroot namelist /clm_inparm/ & @@ -655,6 +659,10 @@ subroutine control_spmd() call mpi_bcast (use_hydrstress, 1, MPI_LOGICAL, 0, mpicom, ier) +!KO + call mpi_bcast (use_fan, 1, MPI_LOGICAL, 0, mpicom, ier) +!KO + call mpi_bcast (use_dynroot, 1, MPI_LOGICAL, 0, mpicom, ier) if (use_cn .and. use_vertsoilc) then @@ -899,6 +907,9 @@ subroutine control_print () write(iulog,*) ' land-ice albedos (unitless 0-1) = ', albice write(iulog,*) ' soil layer structure = ', soil_layerstruct write(iulog,*) ' plant hydraulic stress = ', use_hydrstress +!KO + write(iulog,*) ' FAN = ', use_fan +!KO write(iulog,*) ' dynamic roots = ', use_dynroot if (nsrest == nsrContinue) then write(iulog,*) 'restart warning:' diff --git a/src/main/ndep2StreamMod.F90 b/src/main/ndep2StreamMod.F90 new file mode 100644 index 0000000000..e403302d72 --- /dev/null +++ b/src/main/ndep2StreamMod.F90 @@ -0,0 +1,285 @@ +module ndep2StreamMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Contains methods for reading in FAN nitrogen deposition (in the form of + ! manure) data file + ! Also includes functions for dynamic ndep2 file handling and + ! interpolation. + ! + ! !USES + use shr_kind_mod, only: r8 => shr_kind_r8, CL => shr_kind_cl + use shr_strdata_mod + use shr_stream_mod + use shr_string_mod + use shr_sys_mod + use shr_mct_mod + use mct_mod + use spmdMod , only: mpicom, masterproc, comp_id, iam + use clm_varctl , only: iulog + use abortutils , only: endrun + use fileutils , only: getavu, relavu + use decompMod , only: bounds_type, ldecomp, gsmap_lnd_gdc2glo + use domainMod , only: ldomain +!KO + use ndepStreamMod, only: clm_domain_mct +!KO + + ! !PUBLIC TYPES: + implicit none + private + save + + ! !PUBLIC MEMBER FUNCTIONS: + public :: ndep2_init ! position datasets for dynamic ndep2 + public :: ndep2_interp ! interpolates between two years of ndep2 file data +!KO public :: clm_domain_mct ! Sets up MCT domain for this resolution + + ! ! PRIVATE TYPES + type(shr_strdata_type) :: sdat ! input data stream + integer :: stream_year_first_ndep2 ! first year in stream to use + integer :: stream_year_last_ndep2 ! last year in stream to use + integer :: model_year_align_ndep2 ! align stream_year_firstndep2 with + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + !============================================================================== + +contains + + !============================================================================== + + subroutine ndep2_init(bounds, NLFilename) + ! + ! Initialize data stream information. + ! + ! Uses: + use clm_varctl , only : inst_name + use clm_time_manager , only : get_calendar + use ncdio_pio , only : pio_subsystem + use shr_pio_mod , only : shr_pio_getiotype + use shr_nl_mod , only : shr_nl_find_group_name + use shr_log_mod , only : errMsg => shr_log_errMsg + ! + ! arguments + implicit none + type(bounds_type), intent(in) :: bounds + character(len=*), intent(in) :: NLFilename ! Namelist filename + ! + ! local variables + integer :: nu_nml ! unit for namelist file + integer :: nml_error ! namelist i/o error flag + type(mct_ggrid) :: dom_clm ! domain information + character(len=CL) :: stream_fldFileName_ndep2 + character(len=CL) :: ndep2mapalgo = 'bilinear' + character(*), parameter :: shr_strdata_unset = 'NOT_SET' + character(*), parameter :: subName = "('ndep2dyn_init')" + character(*), parameter :: F00 = "('(ndep2dyn_init) ',4a)" + !----------------------------------------------------------------------- + + namelist /ndep2dyn_nml/ & + stream_year_first_ndep2, & + stream_year_last_ndep2, & + model_year_align_ndep2, & + ndep2mapalgo, & + stream_fldFileName_ndep2 + + ! Default values for namelist + stream_year_first_ndep2 = 1 ! first year in stream to use + stream_year_last_ndep2 = 1 ! last year in stream to use + model_year_align_ndep2 = 1 ! align stream_year_first_ndep2 with this model year + stream_fldFileName_ndep2 = ' ' + + ! Read ndep2dyn_nml namelist + if (masterproc) then + nu_nml = getavu() + open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error ) + call shr_nl_find_group_name(nu_nml, 'ndep2dyn_nml', status=nml_error) + if (nml_error == 0) then + read(nu_nml, nml=ndep2dyn_nml,iostat=nml_error) + if (nml_error /= 0) then + call endrun(msg=' ERROR reading ndep2dyn_nml namelist'//errMsg(sourcefile, __LINE__)) + end if + else + call endrun(msg=' ERROR finding ndep2dyn_nml namelist'//errMsg(sourcefile, __LINE__)) + end if + close(nu_nml) + call relavu( nu_nml ) + endif + + call shr_mpi_bcast(stream_year_first_ndep2, mpicom) + call shr_mpi_bcast(stream_year_last_ndep2, mpicom) + call shr_mpi_bcast(model_year_align_ndep2, mpicom) + call shr_mpi_bcast(stream_fldFileName_ndep2, mpicom) + + if (masterproc) then + write(iulog,*) ' ' + write(iulog,*) 'ndep2dyn stream settings:' + write(iulog,*) ' stream_year_first_ndep2 = ',stream_year_first_ndep2 + write(iulog,*) ' stream_year_last_ndep2 = ',stream_year_last_ndep2 + write(iulog,*) ' model_year_align_ndep2 = ',model_year_align_ndep2 + write(iulog,*) ' stream_fldFileName_ndep2 = ',stream_fldFileName_ndep2 + write(iulog,*) ' ' + endif + + call clm_domain_mct (bounds, dom_clm) + + call shr_strdata_create(sdat,name="clmndep2", & + pio_subsystem=pio_subsystem, & + pio_iotype=shr_pio_getiotype(inst_name), & + mpicom=mpicom, compid=comp_id, & + gsmap=gsmap_lnd_gdc2glo, ggrid=dom_clm, & + nxg=ldomain%ni, nyg=ldomain%nj, & + yearFirst=stream_year_first_ndep2, & + yearLast=stream_year_last_ndep2, & + yearAlign=model_year_align_ndep2, & + offset=0, & + domFilePath='', & + domFileName=trim(stream_fldFileName_ndep2), & + domTvarName='time', & + domXvarName='x' , & + domYvarName='y' , & + domAreaName='area', & + domMaskName='mask', & + filePath='', & + filename=(/trim(stream_fldFileName_ndep2)/),& + fldListFile='NDEP_year', & + fldListModel='NDEP_year', & + fillalgo='none', & + mapalgo=ndep2mapalgo, & + calendar=get_calendar(), & + taxmode='extend' ) + + if (masterproc) then + call shr_strdata_print(sdat,'CLMNDEP2 data') + endif + + end subroutine ndep2_init + + !================================================================ + subroutine ndep2_interp(bounds, atm2lnd_inst) + + !----------------------------------------------------------------------- + use clm_time_manager, only : get_curr_date, get_days_per_year + use clm_varcon , only : secspday + use atm2lndType , only : atm2lnd_type + ! + ! Arguments + type(bounds_type) , intent(in) :: bounds + type(atm2lnd_type), intent(inout) :: atm2lnd_inst + ! + ! Local variables + integer :: g, ig + integer :: year ! year (0, ...) for nstep+1 + integer :: mon ! month (1, ..., 12) for nstep+1 + integer :: day ! day of month (1, ..., 31) for nstep+1 + integer :: sec ! seconds into current date for nstep+1 + integer :: mcdate ! Current model date (yyyymmdd) + integer :: dayspyr ! days per year + !----------------------------------------------------------------------- + + call get_curr_date(year, mon, day, sec) + mcdate = year*10000 + mon*100 + day + + call shr_strdata_advance(sdat, mcdate, sec, mpicom, 'ndep2dyn') + + ig = 0 + dayspyr = get_days_per_year( ) + do g = bounds%begg,bounds%endg + ig = ig+1 + atm2lnd_inst%forc_ndep2_grc(g) = sdat%avs(1)%rAttr(1,ig) / (secspday * dayspyr) + end do + + end subroutine ndep2_interp + +!!============================================================================== +! subroutine clm_domain_mct(bounds, dom_clm) + +! !------------------------------------------------------------------- +! ! Set domain data type for internal clm grid +! use clm_varcon , only : re +! use domainMod , only : ldomain +! use seq_flds_mod +! implicit none +! ! +! ! arguments +! type(bounds_type), intent(in) :: bounds +! type(mct_ggrid), intent(out) :: dom_clm ! Output domain information for land model +! ! +! ! local variables +! integer :: g,i,j ! index +! integer :: lsize ! land model domain data size +! real(r8), pointer :: data(:) ! temporary +! integer , pointer :: idata(:) ! temporary +! !------------------------------------------------------------------- +! ! +! ! Initialize mct domain type +! ! lat/lon in degrees, area in radians^2, mask is 1 (land), 0 (non-land) +! ! Note that in addition land carries around landfrac for the purposes of domain checking +! ! +! lsize = mct_gsMap_lsize(gsmap_lnd_gdc2glo, mpicom) +! call mct_gGrid_init( GGrid=dom_clm, CoordChars=trim(seq_flds_dom_coord), & +! OtherChars=trim(seq_flds_dom_other), lsize=lsize ) +! ! +! ! Allocate memory +! ! +! allocate(data(lsize)) +! ! +! ! Determine global gridpoint number attribute, GlobGridNum, which is set automatically by MCT +! ! +! call mct_gsMap_orderedPoints(gsmap_lnd_gdc2glo, iam, idata) +! call mct_gGrid_importIAttr(dom_clm,'GlobGridNum',idata,lsize) +! ! +! ! Determine domain (numbering scheme is: West to East and South to North to South pole) +! ! Initialize attribute vector with special value +! ! +! data(:) = -9999.0_R8 +! call mct_gGrid_importRAttr(dom_clm,"lat" ,data,lsize) +! call mct_gGrid_importRAttr(dom_clm,"lon" ,data,lsize) +! call mct_gGrid_importRAttr(dom_clm,"area" ,data,lsize) +! call mct_gGrid_importRAttr(dom_clm,"aream",data,lsize) +! data(:) = 0.0_R8 +! call mct_gGrid_importRAttr(dom_clm,"mask" ,data,lsize) +! ! +! ! Determine bounds +! ! +! ! Fill in correct values for domain components +! ! Note aream will be filled in in the atm-lnd mapper +! ! +! do g = bounds%begg,bounds%endg +! i = 1 + (g - bounds%begg) +! data(i) = ldomain%lonc(g) +! end do +! call mct_gGrid_importRattr(dom_clm,"lon",data,lsize) + +! do g = bounds%begg,bounds%endg +! i = 1 + (g - bounds%begg) +! data(i) = ldomain%latc(g) +! end do +! call mct_gGrid_importRattr(dom_clm,"lat",data,lsize) + +! do g = bounds%begg,bounds%endg +! i = 1 + (g - bounds%begg) +! data(i) = ldomain%area(g)/(re*re) +! end do +! call mct_gGrid_importRattr(dom_clm,"area",data,lsize) + +! do g = bounds%begg,bounds%endg +! i = 1 + (g - bounds%begg) +! data(i) = real(ldomain%mask(g), r8) +! end do +! call mct_gGrid_importRattr(dom_clm,"mask",data,lsize) + +! do g = bounds%begg,bounds%endg +! i = 1 + (g - bounds%begg) +! data(i) = real(ldomain%frac(g), r8) +! end do +! call mct_gGrid_importRattr(dom_clm,"frac",data,lsize) + +! deallocate(data) +! deallocate(idata) + +! end subroutine clm_domain_mct + +end module ndep2StreamMod + diff --git a/src/main/ndep3StreamMod.F90 b/src/main/ndep3StreamMod.F90 new file mode 100644 index 0000000000..d2ffa887f4 --- /dev/null +++ b/src/main/ndep3StreamMod.F90 @@ -0,0 +1,285 @@ +module ndep3StreamMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Contains methods for reading in FAN nitrogen deposition (in the form of + ! fertilizer) data file + ! Also includes functions for dynamic ndep3 file handling and + ! interpolation. + ! + ! !USES + use shr_kind_mod, only: r8 => shr_kind_r8, CL => shr_kind_cl + use shr_strdata_mod + use shr_stream_mod + use shr_string_mod + use shr_sys_mod + use shr_mct_mod + use mct_mod + use spmdMod , only: mpicom, masterproc, comp_id, iam + use clm_varctl , only: iulog + use abortutils , only: endrun + use fileutils , only: getavu, relavu + use decompMod , only: bounds_type, ldecomp, gsmap_lnd_gdc2glo + use domainMod , only: ldomain +!KO + use ndepStreamMod, only: clm_domain_mct +!KO + + ! !PUBLIC TYPES: + implicit none + private + save + + ! !PUBLIC MEMBER FUNCTIONS: + public :: ndep3_init ! position datasets for dynamic ndep3 + public :: ndep3_interp ! interpolates between two years of ndep3 file data +!KO public :: clm_domain_mct ! Sets up MCT domain for this resolution + + ! ! PRIVATE TYPES + type(shr_strdata_type) :: sdat ! input data stream + integer :: stream_year_first_ndep3 ! first year in stream to use + integer :: stream_year_last_ndep3 ! last year in stream to use + integer :: model_year_align_ndep3 ! align stream_year_firstndep3 with + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + !============================================================================== + +contains + + !============================================================================== + + subroutine ndep3_init(bounds, NLFilename) + ! + ! Initialize data stream information. + ! + ! Uses: + use clm_varctl , only : inst_name + use clm_time_manager , only : get_calendar + use ncdio_pio , only : pio_subsystem + use shr_pio_mod , only : shr_pio_getiotype + use shr_nl_mod , only : shr_nl_find_group_name + use shr_log_mod , only : errMsg => shr_log_errMsg + ! + ! arguments + implicit none + type(bounds_type), intent(in) :: bounds + character(len=*), intent(in) :: NLFilename ! Namelist filename + ! + ! local variables + integer :: nu_nml ! unit for namelist file + integer :: nml_error ! namelist i/o error flag + type(mct_ggrid) :: dom_clm ! domain information + character(len=CL) :: stream_fldFileName_ndep3 + character(len=CL) :: ndep3mapalgo = 'bilinear' + character(*), parameter :: shr_strdata_unset = 'NOT_SET' + character(*), parameter :: subName = "('ndep3dyn_init')" + character(*), parameter :: F00 = "('(ndep3dyn_init) ',4a)" + !----------------------------------------------------------------------- + + namelist /ndep3dyn_nml/ & + stream_year_first_ndep3, & + stream_year_last_ndep3, & + model_year_align_ndep3, & + ndep3mapalgo, & + stream_fldFileName_ndep3 + + ! Default values for namelist + stream_year_first_ndep3 = 1 ! first year in stream to use + stream_year_last_ndep3 = 1 ! last year in stream to use + model_year_align_ndep3 = 1 ! align stream_year_first_ndep3 with this model year + stream_fldFileName_ndep3 = ' ' + + ! Read ndep3dyn_nml namelist + if (masterproc) then + nu_nml = getavu() + open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error ) + call shr_nl_find_group_name(nu_nml, 'ndep3dyn_nml', status=nml_error) + if (nml_error == 0) then + read(nu_nml, nml=ndep3dyn_nml,iostat=nml_error) + if (nml_error /= 0) then + call endrun(msg=' ERROR reading ndep3dyn_nml namelist'//errMsg(sourcefile, __LINE__)) + end if + else + call endrun(msg=' ERROR finding ndep3dyn_nml namelist'//errMsg(sourcefile, __LINE__)) + end if + close(nu_nml) + call relavu( nu_nml ) + endif + + call shr_mpi_bcast(stream_year_first_ndep3, mpicom) + call shr_mpi_bcast(stream_year_last_ndep3, mpicom) + call shr_mpi_bcast(model_year_align_ndep3, mpicom) + call shr_mpi_bcast(stream_fldFileName_ndep3, mpicom) + + if (masterproc) then + write(iulog,*) ' ' + write(iulog,*) 'ndep3dyn stream settings:' + write(iulog,*) ' stream_year_first_ndep3 = ',stream_year_first_ndep3 + write(iulog,*) ' stream_year_last_ndep3 = ',stream_year_last_ndep3 + write(iulog,*) ' model_year_align_ndep3 = ',model_year_align_ndep3 + write(iulog,*) ' stream_fldFileName_ndep3 = ',stream_fldFileName_ndep3 + write(iulog,*) ' ' + endif + + call clm_domain_mct (bounds, dom_clm) + + call shr_strdata_create(sdat,name="clmndep3", & + pio_subsystem=pio_subsystem, & + pio_iotype=shr_pio_getiotype(inst_name), & + mpicom=mpicom, compid=comp_id, & + gsmap=gsmap_lnd_gdc2glo, ggrid=dom_clm, & + nxg=ldomain%ni, nyg=ldomain%nj, & + yearFirst=stream_year_first_ndep3, & + yearLast=stream_year_last_ndep3, & + yearAlign=model_year_align_ndep3, & + offset=0, & + domFilePath='', & + domFileName=trim(stream_fldFileName_ndep3), & + domTvarName='time', & + domXvarName='x' , & + domYvarName='y' , & + domAreaName='area', & + domMaskName='mask', & + filePath='', & + filename=(/trim(stream_fldFileName_ndep3)/),& + fldListFile='NDEP_year', & + fldListModel='NDEP_year', & + fillalgo='none', & + mapalgo=ndep3mapalgo, & + calendar=get_calendar(), & + taxmode='extend' ) + + if (masterproc) then + call shr_strdata_print(sdat,'CLMNDEP3 data') + endif + + end subroutine ndep3_init + + !================================================================ + subroutine ndep3_interp(bounds, atm2lnd_inst) + + !----------------------------------------------------------------------- + use clm_time_manager, only : get_curr_date, get_days_per_year + use clm_varcon , only : secspday + use atm2lndType , only : atm2lnd_type + ! + ! Arguments + type(bounds_type) , intent(in) :: bounds + type(atm2lnd_type), intent(inout) :: atm2lnd_inst + ! + ! Local variables + integer :: g, ig + integer :: year ! year (0, ...) for nstep+1 + integer :: mon ! month (1, ..., 12) for nstep+1 + integer :: day ! day of month (1, ..., 31) for nstep+1 + integer :: sec ! seconds into current date for nstep+1 + integer :: mcdate ! Current model date (yyyymmdd) + integer :: dayspyr ! days per year + !----------------------------------------------------------------------- + + call get_curr_date(year, mon, day, sec) + mcdate = year*10000 + mon*100 + day + + call shr_strdata_advance(sdat, mcdate, sec, mpicom, 'ndep3dyn') + + ig = 0 + dayspyr = get_days_per_year( ) + do g = bounds%begg,bounds%endg + ig = ig+1 + atm2lnd_inst%forc_ndep3_grc(g) = sdat%avs(1)%rAttr(1,ig) / (secspday * dayspyr) + end do + + end subroutine ndep3_interp + +!!============================================================================== +! subroutine clm_domain_mct(bounds, dom_clm) + +! !------------------------------------------------------------------- +! ! Set domain data type for internal clm grid +! use clm_varcon , only : re +! use domainMod , only : ldomain +! use seq_flds_mod +! implicit none +! ! +! ! arguments +! type(bounds_type), intent(in) :: bounds +! type(mct_ggrid), intent(out) :: dom_clm ! Output domain information for land model +! ! +! ! local variables +! integer :: g,i,j ! index +! integer :: lsize ! land model domain data size +! real(r8), pointer :: data(:) ! temporary +! integer , pointer :: idata(:) ! temporary +! !------------------------------------------------------------------- +! ! +! ! Initialize mct domain type +! ! lat/lon in degrees, area in radians^2, mask is 1 (land), 0 (non-land) +! ! Note that in addition land carries around landfrac for the purposes of domain checking +! ! +! lsize = mct_gsMap_lsize(gsmap_lnd_gdc2glo, mpicom) +! call mct_gGrid_init( GGrid=dom_clm, CoordChars=trim(seq_flds_dom_coord), & +! OtherChars=trim(seq_flds_dom_other), lsize=lsize ) +! ! +! ! Allocate memory +! ! +! allocate(data(lsize)) +! ! +! ! Determine global gridpoint number attribute, GlobGridNum, which is set automatically by MCT +! ! +! call mct_gsMap_orderedPoints(gsmap_lnd_gdc2glo, iam, idata) +! call mct_gGrid_importIAttr(dom_clm,'GlobGridNum',idata,lsize) +! ! +! ! Determine domain (numbering scheme is: West to East and South to North to South pole) +! ! Initialize attribute vector with special value +! ! +! data(:) = -9999.0_R8 +! call mct_gGrid_importRAttr(dom_clm,"lat" ,data,lsize) +! call mct_gGrid_importRAttr(dom_clm,"lon" ,data,lsize) +! call mct_gGrid_importRAttr(dom_clm,"area" ,data,lsize) +! call mct_gGrid_importRAttr(dom_clm,"aream",data,lsize) +! data(:) = 0.0_R8 +! call mct_gGrid_importRAttr(dom_clm,"mask" ,data,lsize) +! ! +! ! Determine bounds +! ! +! ! Fill in correct values for domain components +! ! Note aream will be filled in in the atm-lnd mapper +! ! +! do g = bounds%begg,bounds%endg +! i = 1 + (g - bounds%begg) +! data(i) = ldomain%lonc(g) +! end do +! call mct_gGrid_importRattr(dom_clm,"lon",data,lsize) + +! do g = bounds%begg,bounds%endg +! i = 1 + (g - bounds%begg) +! data(i) = ldomain%latc(g) +! end do +! call mct_gGrid_importRattr(dom_clm,"lat",data,lsize) + +! do g = bounds%begg,bounds%endg +! i = 1 + (g - bounds%begg) +! data(i) = ldomain%area(g)/(re*re) +! end do +! call mct_gGrid_importRattr(dom_clm,"area",data,lsize) + +! do g = bounds%begg,bounds%endg +! i = 1 + (g - bounds%begg) +! data(i) = real(ldomain%mask(g), r8) +! end do +! call mct_gGrid_importRattr(dom_clm,"mask",data,lsize) + +! do g = bounds%begg,bounds%endg +! i = 1 + (g - bounds%begg) +! data(i) = real(ldomain%frac(g), r8) +! end do +! call mct_gGrid_importRattr(dom_clm,"frac",data,lsize) + +! deallocate(data) +! deallocate(idata) + +! end subroutine clm_domain_mct + +end module ndep3StreamMod + diff --git a/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 index 5d169527c5..29a120ffdd 100644 --- a/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 @@ -11,7 +11,10 @@ module SoilBiogeochemCarbonFluxType use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con use ColumnType , only : col use LandunitType , only : lun - use clm_varctl , only : use_fates +!KO use clm_varctl , only : use_ed +!KO + use clm_varctl , only : use_fates, use_fan +!KO ! ! !PUBLIC TYPES: @@ -32,6 +35,11 @@ module SoilBiogeochemCarbonFluxType real(r8), pointer :: decomp_k_col (:,:,:) ! rate constant for decomposition (1./sec) real(r8), pointer :: hr_vr_col (:,:) ! (gC/m3/s) total vertically-resolved het. resp. from decomposing C pools real(r8), pointer :: o_scalar_col (:,:) ! fraction by which decomposition is limited by anoxia +!KO + real(r8), pointer :: soi_gd_col (:,:) !KO + real(r8), pointer :: cmanure_to_sminn_col (:) ! (gC/m2/s) deposition of C from manure to soil mineral C + real(r8), pointer :: methane_manure_col (:) ! (gC/m2/s) emission of CH4 from cows +!KO real(r8), pointer :: w_scalar_col (:,:) ! fraction by which decomposition is limited by moisture availability real(r8), pointer :: t_scalar_col (:,:) ! fraction by which decomposition is limited by temperature real(r8), pointer :: som_c_leached_col (:) ! (gC/m^2/s) total SOM C loss from vertical transport @@ -44,7 +52,7 @@ module SoilBiogeochemCarbonFluxType real(r8), pointer :: hr_col (:) ! (gC/m2/s) total heterotrophic respiration real(r8), pointer :: lithr_col (:) ! (gC/m2/s) litter heterotrophic respiration - real(r8), pointer :: somhr_col (:) ! (gC/m2/s) soil organic matter heterotrophic res + real(r8), pointer :: somhr_col (:) ! (gC/m2/s) soil organic matter heterotrophic respiration real(r8), pointer :: soilc_change_col (:) ! (gC/m2/s) FUN used soil C ! fluxes to receive carbon inputs from FATES @@ -98,6 +106,13 @@ subroutine InitAllocate(this, bounds) allocate(this%t_scalar_col (begc:endc,1:nlevdecomp_full)); this%t_scalar_col (:,:) =spval allocate(this%w_scalar_col (begc:endc,1:nlevdecomp_full)); this%w_scalar_col (:,:) =spval allocate(this%o_scalar_col (begc:endc,1:nlevdecomp_full)); this%o_scalar_col (:,:) =spval +!KO + if ( use_fan ) then + allocate(this%soi_gd_col (begc:endc,1:nlevdecomp_full)) ; this%soi_gd_col (:,:) = spval + allocate(this%cmanure_to_sminn_col (begc:endc)) ; this%cmanure_to_sminn_col (:) = nan + allocate(this%methane_manure_col (begc:endc)) ; this%methane_manure_col (:) = nan + end if +!KO allocate(this%phr_vr_col (begc:endc,1:nlevdecomp_full)); this%phr_vr_col (:,:) =nan allocate(this%fphr_col (begc:endc,1:nlevgrnd)) ; this%fphr_col (:,:) =nan allocate(this%som_c_leached_col (begc:endc)) ; this%som_c_leached_col (:) =nan @@ -199,6 +214,21 @@ subroutine InitHistory(this, bounds, carbon_type) call hist_addfld1d (fname='HR', units='gC/m^2/s', & avgflag='A', long_name='total heterotrophic respiration', & ptr_col=this%hr_col) +!KO + if ( use_fan ) then + + this%cmanure_to_sminn_col(begc:endc) = spval + call hist_addfld1d (fname='CMANURE_TO_SMINN', units='gC/m^2/s', & + avgflag='A', long_name='Deposition of C from manure to soil mineral', & + ptr_col=this%cmanure_to_sminn_col) + + this%methane_manure_col(begc:endc) = spval + call hist_addfld1d (fname='METHANE_MANURE', units='gC/m^2/s', & + avgflag='A', long_name='Emission of Methane from cows', & + ptr_col=this%methane_manure_col) + + end if +!KO this%lithr_col(begc:endc) = spval call hist_addfld1d (fname='LITTERC_HR', units='gC/m^2/s', & @@ -707,6 +737,22 @@ subroutine SetValues ( this, num_column, filter_column, value_column) this%soilc_change_col(i) = value_column end do +!KO + if ( use_fan ) then + do j = 1, nlevdecomp_full + do fi = 1,num_column + i = filter_column(fi) + this%soi_gd_col(i,j) = value_column + end do + end do + do fi = 1,num_column + i = filter_column(fi) + this%cmanure_to_sminn_col(i) = value_column + this%methane_manure_col(i) = value_column + end do + end if +!KO + ! NOTE: do not zero the fates to BGC C flux variables since they need to persist from the daily fates timestep s to the half-hourly BGC timesteps. I.e. FATES_c_to_litr_lab_c_col, FATES_c_to_litr_cel_c_col, FATES_c_to_litr_lig_c_col end subroutine SetValues diff --git a/src/soilbiogeochem/SoilBiogeochemCompetitionMod.F90 b/src/soilbiogeochem/SoilBiogeochemCompetitionMod.F90 index 0094cfb561..57b7903883 100644 --- a/src/soilbiogeochem/SoilBiogeochemCompetitionMod.F90 +++ b/src/soilbiogeochem/SoilBiogeochemCompetitionMod.F90 @@ -174,7 +174,10 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, soilbiogeochem_nitrogenflux_inst,canopystate_inst) ! ! !USES: - use clm_varctl , only: cnallocate_carbon_only, iulog +!KO use clm_varctl , only: cnallocate_carbon_only, iulog +!KO + use clm_varctl , only: cnallocate_carbon_only, iulog, use_fan +!KO use clm_varpar , only: nlevdecomp, ndecomp_cascade_transitions use clm_varcon , only: nitrif_n2o_loss_frac use CNSharedParamsMod, only: use_fun @@ -234,6 +237,9 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, real(r8) :: residual_smin_no3(bounds%begc:bounds%endc) real(r8) :: residual_plant_ndemand(bounds%begc:bounds%endc) real(r8) :: sminn_to_plant_new(bounds%begc:bounds%endc) +!KO + real(r8) :: smin_nh4_vr_factor ! factor to reduce smin_nh4_nr if use_fan is true +!KO !----------------------------------------------------------------------- associate( & @@ -279,6 +285,16 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, ! column loops to resolve plant/heterotroph competition for mineral N +!KO The following implements code that was in clm4_0_60. However, per Peter +! Hess, this code is not part of FAN per se and so we comment it out for now. +! If uncommented, this changes CLM answers in certain cases. +! if ( use_fan ) then +! smin_nh4_vr_factor = 0.1_r8 +! else +! smin_nh4_vr_factor = 1.0_r8 +! end if +!KO + sminn_to_plant_new(bounds%begc:bounds%endc) = 0._r8 local_use_fun = use_fun @@ -547,6 +563,12 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, potential_immob_vr(c,j)*compet_decomp_nh4 + pot_f_nit_vr(c,j)*compet_nit if (sum_nh4_demand(c,j)*dt < smin_nh4_vr(c,j)) then +!KO +! The following implements code that was in clm4_0_60. However, per Peter +! Hess, this code is not part of FAN per se and so we comment it out for now. +! If uncommented, this changes CLM answers in certain cases. +! if (sum_nh4_demand(c,j)*dt < smin_nh4_vr_factor * smin_nh4_vr(c,j)) then +!KO ! NH4 availability is not limiting immobilization or plant ! uptake, and all can proceed at their potential rates diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 index f1ff0e48ca..40ce64ddf7 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 @@ -7,7 +7,10 @@ module SoilBiogeochemNitrogenFluxType use clm_varpar , only : nlevdecomp_full, nlevdecomp use clm_varcon , only : spval, ispval, dzsoi_decomp use decompMod , only : bounds_type - use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_crop +!KO use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_crop +!KO + use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_crop, use_fan +!KO use CNSharedParamsMod , only : use_fun use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con use abortutils , only : endrun @@ -26,7 +29,87 @@ module SoilBiogeochemNitrogenFluxType real(r8), pointer :: ffix_to_sminn_col (:) ! col free living N fixation to soil mineral N (gN/m2/s) real(r8), pointer :: fert_to_sminn_col (:) ! col fertilizer N to soil mineral N (gN/m2/s) real(r8), pointer :: soyfixn_to_sminn_col (:) ! col soybean fixation to soil mineral N (gN/m2/s) - +!KO + ! FAN fluxes + real(r8), pointer :: rain_24hr_col (:) + real(r8), pointer :: nhxdep_to_sminn_col (:) ! col atmospheric NHx deposition to soil mineral N (gN/m2/s) + real(r8), pointer :: noydep_to_sminn_col (:) ! col atmospheric NOy deposition to soil mineral N (gN/m2/s) + real(r8), pointer :: ndep_manure_col (:) ! col manure N deposition to soil mineral N (gN/m2/s) + real(r8), pointer :: ndep_fert_col (:) ! col fertilizer N deposition to soil mineral N (gN/m2/s) + real(r8), pointer :: N_Run_Off_col (:) ! col nitrogen washed from manure by rain(gN/m2/s) + real(r8), pointer :: N_Run_Off_fert_col (:) ! col nitrogen washed from fertilizer by rain(gN/m2/s) + real(r8), pointer :: u10_avg_col (:) ! col windspeed at 10m(m/s) + real(r8), pointer :: rh_gamma_col (:) !KO + real(r8), pointer :: rain_col (:) ! col rain amount(mm) + real(r8), pointer :: gamma_nh3_col (:) !KO + real(r8), pointer :: gamma_nh3_fert_col (:) !KO + real(r8), pointer :: nh3_manure_col (:) ! col atmospheric N emission of NH3 from manure (gN/m2/s) +! real(r8), pointer :: nh3_fert_col (:) ! col atmospheric N emission of NH3 from fertilizer (gN/m2/s) + real(r8), pointer :: lat_fert_col (:) ! col latitude at which fertilization occurs (degN) + real(r8), pointer :: nmanure_to_sminn_col (:) ! col deposition of N from manure to soil mineral N (gN/m2/s) + real(r8), pointer :: nfert_to_sminn_col (:) ! col deposition of N from fertilizer to soil mineral N (gN/m2/s) + real(r8), pointer :: manure_f_n2o_nit_col (:) ! col N2O emission from nitrification of manure (gN/m2/s) + real(r8), pointer :: manure_f_n2_denit_col (:) ! col N2 emission from denitrification of manure (gN/m2/s) + real(r8), pointer :: manure_f_nox_nit_col (:) ! col NOx emission from nitrification of manure (gN/m2/s) + real(r8), pointer :: fert_f_n2o_nit_col (:) ! col N2O emission from nitrification of fertilizer (gN/m2/s) + real(r8), pointer :: fert_f_n2_denit_col (:) ! col N2 emission from denitrification of fertilizer (gN/m2/s) + real(r8), pointer :: fert_f_nox_nit_col (:) ! col NOx emission from nitrification of fertilizer (gN/m2/s) + real(r8), pointer :: Nd_col (:) ! col total N emission from denitrification of manure (gN/m2/s) + real(r8), pointer :: no3_manure_to_soil_col (:) ! col flow of NO3 from manure pool to soil (gN/m2/s) + real(r8), pointer :: TAN_manure_to_soil_col (:) ! col flow of NH4 in manure TAN pool to soil (gN/m2/s) + real(r8), pointer :: no3_fert_to_soil_col (:) ! col flow of NO3 from fertilizer pool to soil (gN/m2/s) + real(r8), pointer :: TAN_fert_to_soil_col (:) ! col flow of NH4 in fertilizer TAN pool to soil (gN/m2/s) + real(r8), pointer :: f_nox_col (:) ! col flux of NOx [gN/m^2/s] + real(r8), pointer :: f_nox_denit_vr_col (:,:) ! col flux of NOx from denitrification [gN/m^3/s] + real(r8), pointer :: f_nox_denit_col (:) ! col flux of NOx from denitrification [gN/m^2/s] + real(r8), pointer :: f_nox_nit_vr_col (:,:) ! col flux of NOx from nitrification [gN/m^3/s] + real(r8), pointer :: f_nox_nit_col (:) ! col flux of NOx from nitrification [gN/m^2/s] + real(r8), pointer :: Dfc_col (:,:) !KO + real(r8), pointer :: poro_fc_col (:,:) !KO + real(r8), pointer :: poroair_col (:,:) !KO + real(r8), pointer :: wfpsfc_col (:,:) !KO +!KO + + !JV FAN fluxes +!!$ man_tan_appl_col +!!$ man_n_appl_col +!!$ man_n_grz_col +!!$ fert_n_appl_col +!!$ nh3_barns_col +!!$ nh3_stores_col +!!$ nh3_grz_col +!!$ nh3_man_app_col +!!$ nh3_fert_col +!!$ +!!$ manure_no3_prod_col +!!$ fert_no3_prod_col +!!$ manure_nh4_to_soil_col +!!$ fert_nh4_to_soil_col +!!$ manure_runoff_col +!!$ fert_runoff_col + + + real(r8), pointer :: man_tan_appl_col (:) ! Manure TAN applied on soil (gN/m2/s) + real(r8), pointer :: man_n_appl_col (:) ! Manure N (TAN+organic) applied on soil (gN/m2/s) + real(r8), pointer :: man_n_grz_col (:) ! Manure N from grazing animals (gN/m2/s) + real(r8), pointer :: man_n_mix_col (:) ! Manure N from produced in mixed systems (gN/m2/s) + real(r8), pointer :: fert_n_appl_col (:) ! Fertilizer N applied on soil (gN/m2/s) + real(r8), pointer :: man_n_transf_col (:) ! Manure N removed from the crop column (into the natural veg. column in the gcell) + + real(r8), pointer :: nh3_barns_col (:) ! NH3 emission from animal housings (gN/m2/s + real(r8), pointer :: nh3_stores_col (:) ! NH3 emission from manure storage, (gN/m2/s + real(r8), pointer :: nh3_grz_col (:) ! NH3 emission from manure on pastures, (gN/m2/s + real(r8), pointer :: nh3_man_app_col (:) ! NH3 emission from manure applied on crops and grasslands, (gN/m2/s + real(r8), pointer :: nh3_fert_col (:) ! NH3 emission from fertilizers applied on crops and grasslands, (gN/m2/s + + real(r8), pointer :: manure_no3_prod_col (:) ! Nitrification flux from manure (gN/m2/s) + real(r8), pointer :: fert_no3_prod_col (:) ! Nitrification flux from fertilizer (gN/m2/s) + real(r8), pointer :: manure_nh4_to_soil_col (:) ! NH4 flux to soil mineral N pools from manure (gN/m2/s) + real(r8), pointer :: fert_nh4_to_soil_col (:) ! NH4 flux to soil mineral N pools from fertilizer (gN/m2/s) + real(r8), pointer :: manure_runoff_col (:) ! NH4 runoff flux from manure, gN/m2/s + real(r8), pointer :: fert_runoff_col (:) ! NH4 runoff flux from fertilizer, gN/m2/s + + ! decomposition fluxes real(r8), pointer :: decomp_cascade_ntransfer_vr_col (:,:,:) ! col vert-res transfer of N from donor to receiver pool along decomp. cascade (gN/m3/s) real(r8), pointer :: decomp_cascade_ntransfer_col (:,:) ! col vert-int (diagnostic) transfer of N from donor to receiver pool along decomp. cascade (gN/m2/s) @@ -179,6 +262,71 @@ subroutine InitAllocate(this, bounds) allocate(this%ffix_to_sminn_col (begc:endc)) ; this%ffix_to_sminn_col (:) = nan allocate(this%fert_to_sminn_col (begc:endc)) ; this%fert_to_sminn_col (:) = nan allocate(this%soyfixn_to_sminn_col (begc:endc)) ; this%soyfixn_to_sminn_col (:) = nan +!KO + if ( use_fan ) then + allocate(this%rain_24hr_col (begc:endc)) ; this%rain_24hr_col (:) = nan + allocate(this%nhxdep_to_sminn_col (begc:endc)) ; this%nhxdep_to_sminn_col (:) = nan + allocate(this%noydep_to_sminn_col (begc:endc)) ; this%noydep_to_sminn_col (:) = nan + allocate(this%ndep_manure_col (begc:endc)) ; this%ndep_manure_col (:) = nan + allocate(this%ndep_fert_col (begc:endc)) ; this%ndep_fert_col (:) = nan + allocate(this%N_Run_Off_col (begc:endc)) ; this%N_Run_Off_col (:) = nan + allocate(this%N_Run_Off_fert_col (begc:endc)) ; this%N_Run_Off_fert_col (:) = nan + allocate(this%u10_avg_col (begc:endc)) ; this%u10_avg_col (:) = nan + allocate(this%rh_gamma_col (begc:endc)) ; this%rh_gamma_col (:) = nan + allocate(this%rain_col (begc:endc)) ; this%rain_col (:) = nan + allocate(this%gamma_nh3_col (begc:endc)) ; this%gamma_nh3_col (:) = nan + allocate(this%gamma_nh3_fert_col (begc:endc)) ; this%gamma_nh3_fert_col (:) = nan + allocate(this%nh3_manure_col (begc:endc)) ; this%nh3_manure_col (:) = nan +! allocate(this%nh3_fert_col (begc:endc)) ; this%nh3_fert_col (:) = nan + allocate(this%lat_fert_col (begc:endc)) ; this%lat_fert_col (:) = nan + allocate(this%nmanure_to_sminn_col (begc:endc)) ; this%nmanure_to_sminn_col (:) = nan + allocate(this%nfert_to_sminn_col (begc:endc)) ; this%nfert_to_sminn_col (:) = nan + allocate(this%manure_f_n2o_nit_col (begc:endc)) ; this%manure_f_n2o_nit_col (:) = nan + allocate(this%manure_f_n2_denit_col (begc:endc)) ; this%manure_f_n2_denit_col (:) = nan + allocate(this%manure_f_nox_nit_col (begc:endc)) ; this%manure_f_nox_nit_col (:) = nan + allocate(this%fert_f_n2o_nit_col (begc:endc)) ; this%fert_f_n2o_nit_col (:) = nan + allocate(this%fert_f_n2_denit_col (begc:endc)) ; this%fert_f_n2_denit_col (:) = nan + allocate(this%fert_f_nox_nit_col (begc:endc)) ; this%fert_f_nox_nit_col (:) = nan + allocate(this%Nd_col (begc:endc)) ; this%Nd_col (:) = nan + allocate(this%no3_manure_to_soil_col (begc:endc)) ; this%no3_manure_to_soil_col (:) = nan + allocate(this%TAN_manure_to_soil_col (begc:endc)) ; this%TAN_manure_to_soil_col (:) = nan + allocate(this%no3_fert_to_soil_col (begc:endc)) ; this%no3_fert_to_soil_col (:) = nan + allocate(this%TAN_fert_to_soil_col (begc:endc)) ; this%TAN_fert_to_soil_col (:) = nan + allocate(this%f_nox_col (begc:endc)) ; this%f_nox_col (:) = nan + allocate(this%f_nox_denit_vr_col (begc:endc,1:nlevdecomp_full)) ; this%f_nox_denit_vr_col (:,:) = nan + allocate(this%f_nox_denit_col (begc:endc)) ; this%f_nox_denit_col (:) = nan + allocate(this%f_nox_nit_vr_col (begc:endc,1:nlevdecomp_full)) ; this%f_nox_nit_vr_col (:,:) = nan + allocate(this%f_nox_nit_col (begc:endc)) ; this%f_nox_nit_col (:) = nan + allocate(this%Dfc_col (begc:endc,1:nlevdecomp_full)) ; this%Dfc_col (:,:) = spval + allocate(this%poro_fc_col (begc:endc,1:nlevdecomp_full)) ; this%poro_fc_col (:,:) = spval + allocate(this%poroair_col (begc:endc,1:nlevdecomp_full)) ; this%poroair_col (:,:) = spval + allocate(this%wfpsfc_col (begc:endc,1:nlevdecomp_full)) ; this%wfpsfc_col (:,:) = spval + end if +!KO + + !JV + if (use_fan) then + allocate(this%man_tan_appl_col (begc:endc)) ; this%man_tan_appl_col (:) = spval + allocate(this%man_n_appl_col (begc:endc)) ; this%man_n_appl_col (:) = spval + allocate(this%man_n_grz_col (begc:endc)) ; this%man_n_grz_col (:) = spval + allocate(this%man_n_mix_col (begc:endc)) ; this%man_n_mix_col (:) = spval + allocate(this%fert_n_appl_col (begc:endc)) ; this%fert_n_appl_col (:) = spval + allocate(this%man_n_transf_col (begc:endc)) ; this%man_n_transf_col (:) = spval + + allocate(this%nh3_barns_col (begc:endc)) ; this%nh3_barns_col (:) = spval + allocate(this%nh3_stores_col (begc:endc)) ; this%nh3_stores_col (:) = spval + allocate(this%nh3_grz_col (begc:endc)) ; this%nh3_grz_col (:) = spval + allocate(this%nh3_man_app_col (begc:endc)) ; this%nh3_man_app_col (:) = spval + allocate(this%nh3_fert_col (begc:endc)) ; this%nh3_fert_col (:) = spval + + allocate(this%manure_no3_prod_col (begc:endc)) ; this%manure_no3_prod_col (:) = spval + allocate(this%fert_no3_prod_col (begc:endc)) ; this%fert_no3_prod_col (:) = spval + allocate(this%manure_nh4_to_soil_col (begc:endc)) ; this%manure_nh4_to_soil_col (:) = spval + allocate(this%fert_nh4_to_soil_col (begc:endc)) ; this%fert_nh4_to_soil_col (:) = spval + allocate(this%manure_runoff_col (begc:endc)) ; this%manure_runoff_col (:) = spval + allocate(this%fert_runoff_col (begc:endc)) ; this%fert_runoff_col (:) = spval + end if + allocate(this%sminn_to_plant_col (begc:endc)) ; this%sminn_to_plant_col (:) = nan allocate(this%potential_immob_col (begc:endc)) ; this%potential_immob_col (:) = nan allocate(this%actual_immob_col (begc:endc)) ; this%actual_immob_col (:) = nan @@ -223,7 +371,6 @@ subroutine InitAllocate(this, bounds) allocate(this%f_n2o_denit_vr_col (begc:endc,1:nlevdecomp_full)) ; this%f_n2o_denit_vr_col (:,:) = nan allocate(this%f_n2o_nit_col (begc:endc)) ; this%f_n2o_nit_col (:) = nan allocate(this%f_n2o_nit_vr_col (begc:endc,1:nlevdecomp_full)) ; this%f_n2o_nit_vr_col (:,:) = nan - allocate(this%smin_no3_massdens_vr_col (begc:endc,1:nlevdecomp_full)) ; this%smin_no3_massdens_vr_col (:,:) = nan allocate(this%soil_bulkdensity_col (begc:endc,1:nlevdecomp_full)) ; this%soil_bulkdensity_col (:,:) = nan allocate(this%k_nitr_t_vr_col (begc:endc,1:nlevdecomp_full)) ; this%k_nitr_t_vr_col (:,:) = nan @@ -315,7 +462,211 @@ subroutine InitHistory(this, bounds) call hist_addfld1d (fname='NDEP_TO_SMINN', units='gN/m^2/s', & avgflag='A', long_name='atmospheric N deposition to soil mineral N', & ptr_col=this%ndep_to_sminn_col) - +!KO + if ( use_fan ) then + + this%nhxdep_to_sminn_col(begc:endc) = spval + call hist_addfld1d (fname='NHxDEP_TO_SMINN', units='gN/m^2/s', & + avgflag='A', long_name='atmospheric NHx deposition to soil mineral N', & + ptr_col=this%nhxdep_to_sminn_col) + + this%noydep_to_sminn_col(begc:endc) = spval + call hist_addfld1d (fname='NOyDEP_TO_SMINN', units='gN/m^2/s', & + avgflag='A', long_name='atmospheric NOy deposition to soil mineral N', & + ptr_col=this%noydep_to_sminn_col) + + this%ndep_manure_col(begc:endc) = spval + call hist_addfld1d (fname='NDEP_MANURE', units='gN/m^2/s', & + avgflag='A', long_name='N deposition from manure', & + ptr_col=this%ndep_manure_col) + + this%N_Run_Off_col(begc:endc) = spval + call hist_addfld1d (fname='N_RUN_OFF', units='gN/m^2/s', & + avgflag='A', long_name='N run off from manure by rain', & + ptr_col=this%N_Run_Off_col) + + this%nmanure_to_sminn_col(begc:endc) = spval + call hist_addfld1d (fname='NMANURE_TO_SMINN', units='gN/m^2/s', & + avgflag='A', long_name='Deposition of N from manure to soil mineral', & + ptr_col=this%nmanure_to_sminn_col) + + this%ndep_fert_col(begc:endc) = spval + call hist_addfld1d (fname='NDEP_FERT', units='gN/m^2/s', & + avgflag='A', long_name='N deposition from fertilizer', & + ptr_col=this%ndep_fert_col) + + this%N_Run_Off_fert_col(begc:endc) = spval + call hist_addfld1d (fname='N_RUN_OFF_FERT', units='gN/m^2/s', & + avgflag='A', long_name='N run off from fertilizer by rain', & + ptr_col=this%N_Run_Off_fert_col) + + this%nfert_to_sminn_col(begc:endc) = spval + call hist_addfld1d (fname='NFERT_TO_SMINN', units='gN/m^2/s', & + avgflag='A', long_name='Deposition of N from fertilizer to soil mineral', & + ptr_col=this%nfert_to_sminn_col) + + this%nh3_manure_col(begc:endc) = spval + call hist_addfld1d (fname='NH3_MANURE', units='gN/m^2/s', & + avgflag='A', long_name='NH3 emission from manure', & + ptr_col=this%nh3_manure_col) + + this%gamma_nh3_fert_col(begc:endc) = spval + call hist_addfld1d (fname='GAMMA_NH3_FERT', units='none', & + avgflag='A', long_name='Gamma Fn NH3 emission for fertilizer', & + ptr_col=this%gamma_nh3_fert_col) + + !this%nh3_fert_col(begc:endc) = spval + !call hist_addfld1d (fname='NH3_FERT', units='gN/m^2/s', & + ! avgflag='A', long_name='NH3 emission from fertilizer', & + ! ptr_col=this%nh3_fert_col) + + this%manure_f_n2o_nit_col(begc:endc) = spval + call hist_addfld1d (fname='F_N2O_NIT_MANURE', units='gN/m^2/s', & + avgflag='A', long_name='N2O emission from nitrification of manure', & + ptr_col=this%manure_f_n2o_nit_col) + + this%manure_f_n2_denit_col(begc:endc) = spval + call hist_addfld1d (fname='F_N2_DENIT_MANURE', units='gN/m^2/s', & + avgflag='A', long_name='N2 emission from denitrification of manure', & + ptr_col=this%manure_f_n2_denit_col) + + this%manure_f_nox_nit_col(begc:endc) = spval + call hist_addfld1d (fname='F_NOx_NIT_MANURE', units='gN/m^2/s', & + avgflag='A', long_name='NOx emission from nitrification of manure', & + ptr_col=this%manure_f_nox_nit_col) + + this%fert_f_n2o_nit_col(begc:endc) = spval + call hist_addfld1d (fname='F_N2O_NIT_FERTILIZER', units='gN/m^2/s', & + avgflag='A', long_name='N2O emission from nitrification of fertilizer', & + ptr_col=this%fert_f_n2o_nit_col) + + this%fert_f_n2_denit_col(begc:endc) = spval + call hist_addfld1d (fname='F_N2_DENIT_FERTILIZER', units='gN/m^2/s', & + avgflag='A', long_name='N2 emission from denitrification of fertilizer', & + ptr_col=this%fert_f_n2_denit_col) + + this%fert_f_nox_nit_col(begc:endc) = spval + call hist_addfld1d (fname='F_NOx_NIT_FERTILIZER', units='gN/m^2/s', & + avgflag='A', long_name='NOx emission from nitrification of fertilzer', & + ptr_col=this%fert_f_nox_nit_col) + + this%Nd_col(begc:endc) = spval + call hist_addfld1d (fname='ND', units='gN/m^2/s', & + avgflag='A', long_name='Total N emission from denitrification of manure', & + ptr_col=this%Nd_col) + + this%no3_manure_to_soil_col(begc:endc) = spval + call hist_addfld1d (fname='NO3_MANURE_TO_SOIL', units='gN/m^2/s', & + avgflag='A', long_name='Flow of NO3 from manure to soil at rate of 1 % per day', & + ptr_col=this%no3_manure_to_soil_col) + + this%TAN_manure_to_soil_col(begc:endc) = spval + call hist_addfld1d (fname='TAN_MANURE_TO_SOIL', units='gN/m^2/s', & + avgflag='A', long_name='Flow of NH4 from manure to soil at rate of 1 % per day', & + ptr_col=this%TAN_manure_to_soil_col) + + this%no3_fert_to_soil_col(begc:endc) = spval + call hist_addfld1d (fname='NO3_FERT_TO_SOIL', units='gN/m^2/s', & + avgflag='A', long_name='Flow of NO3 from fertilizer to soil at rate of 1 % per day', & + ptr_col=this%no3_fert_to_soil_col) + + this%TAN_fert_to_soil_col(begc:endc) = spval + call hist_addfld1d (fname='TAN_FERT_TO_SOIL', units='gN/m^2/s', & + avgflag='A', long_name='Flow of NH4 from fertilizer to soil at rate of 1 % per day', & + ptr_col=this%TAN_fert_to_soil_col) + + + end if + !KO + !JV + if (use_fan) then + this%man_tan_appl_col(begc:endc) = spval + call hist_addfld1d( fname='MAN_TAN_APP', units='gN/m^2/s', & + avgflag='A', long_name='Manure TAN applied on soil', & + ptr_col=this%man_tan_appl_col) + + this%man_n_appl_col(begc:endc) = spval + call hist_addfld1d( fname='MAN_N_APP', units='gN/m^2/s', & + avgflag='A', long_name='Manure N applied on soil', & + ptr_col=this%man_n_appl_col) + + this%man_n_grz_col(begc:endc) = spval + call hist_addfld1d( fname='MAN_N_GRZ', units='gN/m^2/s', & + avgflag='A', long_name='Manure N from grazing animals', & + ptr_col=this%man_n_grz_col) + + this%man_n_mix_col(begc:endc) = spval + call hist_addfld1d( fname='MAN_N_MIX', units='gN/m^2/s', & + avgflag='A', long_name='Manure N in produced mixed systems', & + ptr_col=this%man_n_mix_col) + + this%fert_n_appl_col(begc:endc) = spval + call hist_addfld1d( fname='FERT_N_APP', units='gN/m^2/s', & + avgflag='A', long_name='Fertilizer N applied on soil', & + ptr_col=this%fert_n_appl_col) + + this%man_n_transf_col(begc:endc) = spval + call hist_addfld1d( fname='MAN_N_TRANSF', units='gN/m^2/s', & + avgflag='A', long_name='Manure N moved from crop to natural column', & + ptr_col=this%man_n_transf_col) + + this%nh3_barns_col(begc:endc) = spval + call hist_addfld1d( fname='NH3_BARNS', units='gN/m^2/s', & + avgflag='A', long_name='NH3 emitted from animal housings', & + ptr_col=this%nh3_barns_col) + + this%nh3_stores_col(begc:endc) = spval + call hist_addfld1d( fname='NH3_STORES', units='gN/m^2/s', & + avgflag='A', long_name='NH3 emitted from stored manure', & + ptr_col=this%nh3_stores_col) + + this%nh3_grz_col(begc:endc) = spval + call hist_addfld1d( fname='NH3_GRZ', units='gN/m^2/s', & + avgflag='A', long_name='NH3 emitted from manure on pastures', & + ptr_col=this%nh3_grz_col) + + this%nh3_man_app_col(begc:endc) = spval + call hist_addfld1d( fname='NH3_MAN_APP', units='gN/m^2/s', & + avgflag='A', long_name='NH3 emitted from manure applied on crops and grasslands', & + ptr_col=this%nh3_man_app_col) + + this%nh3_fert_col(begc:endc) = spval + call hist_addfld1d( fname='NH3_FERT', units='gN/m^2/s', & + avgflag='A', long_name='NH3 emitted from fertilizer applied on crops', & + ptr_col=this%nh3_fert_col) + + this%manure_no3_prod_col(begc:endc) = spval + call hist_addfld1d( fname='MANURE_NO3_PROD', units='gN/m^2/s', & + avgflag='A', long_name='Manure nitrification flux', & + ptr_col=this%manure_no3_prod_col) + + this%fert_no3_prod_col(begc:endc) = spval + call hist_addfld1d( fname='FERT_NO3_PROD', units='gN/m^2/s', & + avgflag='A', long_name='Fertilizer nitrification flux', & + ptr_col=this%fert_no3_prod_col) + + this%fert_nh4_to_soil_col(begc:endc) = spval + call hist_addfld1d( fname='FERT_NH4_TO_SOIL', units='gN/m^2/s', & + avgflag='A', long_name='Flux of NH4 to soil mineral pools, fertilizer', & + ptr_col=this%fert_nh4_to_soil_col) + + this%manure_nh4_to_soil_col(begc:endc) = spval + call hist_addfld1d( fname='MANURE_NH3_TO_SOIL', units='gN/m^2/s', & + avgflag='A', long_name='Flux of NH4 to soil mineral pools, manure', & + ptr_col=this%manure_nh4_to_soil_col) + + + this%manure_runoff_col(begc:endc) = spval + call hist_addfld1d( fname='MANURE_RUNOFF', units='gN/m^2/s', & + avgflag='A', long_name='NH4 in surface runoff, manure', & + ptr_col=this%manure_runoff_col) + + this%fert_runoff_col(begc:endc) = spval + call hist_addfld1d( fname='FERT_RUNOFF', units='gN/m^2/s', & + avgflag='A', long_name='NH4 in surface runoff, fertilizer', & + ptr_col=this%fert_runoff_col) + end if + this%nfix_to_sminn_col(begc:endc) = spval call hist_addfld1d (fname='NFIX_TO_SMINN', units='gN/m^2/s', & avgflag='A', long_name='symbiotic/asymbiotic N fixation to soil mineral N', & @@ -1011,6 +1362,24 @@ subroutine SetValues ( this, & end do end do +!KO + if ( use_fan ) then + do j = 1, nlevdecomp_full + do fi = 1,num_column + i = filter_column(fi) + if ( use_nitrif_denitrif ) then + this%f_nox_denit_vr_col(i,j) = value_column + this%f_nox_nit_vr_col(i,j) = value_column + this%Dfc_col(i,j) = value_column + this%poro_fc_col(i,j) = value_column + this%poroair_col(i,j) = value_column + this%wfpsfc_col(i,j) = value_column + end if + end do + end do + end if +!KO + do fi = 1,num_column i = filter_column(fi) @@ -1045,6 +1414,66 @@ subroutine SetValues ( this, & this%som_n_leached_col(i) = value_column end do +!KO + if ( use_fan ) then + do fi = 1,num_column + i = filter_column(fi) +!KO this%rain_24hr_col(i) = value_column + this%nhxdep_to_sminn_col(i) = value_column + this%noydep_to_sminn_col(i) = value_column + this%ndep_manure_col(i) = value_column + this%ndep_fert_col(i) = value_column + this%N_Run_Off_col(i) = value_column + this%N_Run_Off_fert_col(i) = value_column +!KO this%u10_avg_col(i) = value_column +!KO this%rh_gamma_col(i) = value_column +!KO this%rain_col(i) = value_column +!KO this%gamma_nh3_col(i) = value_column + this%gamma_nh3_fert_col(i) = value_column + this%nh3_manure_col(i) = value_column + this%nh3_fert_col(i) = value_column + this%lat_fert_col(i) = value_column + this%nmanure_to_sminn_col(i) = value_column + this%nfert_to_sminn_col(i) = value_column + this%manure_f_n2o_nit_col(i) = value_column + this%manure_f_n2_denit_col(i) = value_column + this%manure_f_nox_nit_col(i) = value_column + this%fert_f_n2o_nit_col(i) = value_column + this%fert_f_n2_denit_col(i) = value_column + this%fert_f_nox_nit_col(i) = value_column + this%Nd_col(i) = value_column + this%no3_manure_to_soil_col(i) = value_column + this%TAN_manure_to_soil_col(i) = value_column + this%no3_fert_to_soil_col(i) = value_column + this%TAN_fert_to_soil_col(i) = value_column + if ( use_nitrif_denitrif ) then + this%f_nox_col(i) = value_column + this%f_nox_denit_col(i) = value_column + this%f_nox_nit_col(i) = value_column + end if + + this%man_tan_appl_col(i) = value_column + this%man_n_appl_col(i) = value_column + this%man_n_grz_col(i) = value_column + this%man_n_mix_col(i) = value_column + this%fert_n_appl_col(i) = value_column + this%man_n_transf_col(i) = value_column + this%nh3_barns_col(i) = value_column + this%nh3_stores_col(i) = value_column + this%nh3_grz_col(i) = value_column + this%nh3_man_app_col(i) = value_column + this%nh3_fert_col(i) = value_column + this%manure_no3_prod_col(i) = value_column + this%fert_no3_prod_col(i) = value_column + this%manure_nh4_to_soil_col(i) = value_column + this%fert_nh4_to_soil_col(i) = value_column + this%manure_runoff_col(i) = value_column + this%fert_runoff_col(i) = value_column + + end do + end if +!KO + do k = 1, ndecomp_pools do fi = 1,num_column i = filter_column(fi) @@ -1207,6 +1636,18 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc) this%pot_f_denit_col(c) + & this%pot_f_denit_vr_col(c,j) * dzsoi_decomp(j) +!KO + if ( use_fan ) then + this%f_nox_nit_col(c) = & + this%f_nox_nit_col(c) + & + this%f_nox_nit_vr_col(c,j) * dzsoi_decomp(j) + + this%f_nox_denit_col(c) = & + this%f_nox_denit_col(c) + & + this%f_nox_denit_vr_col(c,j) * dzsoi_decomp(j) + end if +!KO + this%f_n2o_nit_col(c) = & this%f_n2o_nit_col(c) + & this%f_n2o_nit_vr_col(c,j) * dzsoi_decomp(j) diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 index ca09e63624..b53365e4f6 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 @@ -11,7 +11,10 @@ module SoilBiogeochemNitrogenStateType use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, nlevcan use clm_varpar , only : nlevdecomp_full, nlevdecomp, nlevsoi use clm_varcon , only : spval, dzsoi_decomp, zisoi - use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_century_decomp +!KO use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_century_decomp +!KO + use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_century_decomp, use_fan +!KO use clm_varctl , only : iulog, override_bgc_restart_mismatch_dump, spinup_state use landunit_varcon , only : istcrop, istsoil use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con @@ -36,6 +39,71 @@ module SoilBiogeochemNitrogenStateType real(r8), pointer :: smin_nh4_vr_col (:,:) ! col (gN/m3) vertically-resolved soil mineral NH4 real(r8), pointer :: smin_nh4_col (:) ! col (gN/m2) soil mineral NH4 pool + !JV, FAN + real(r8), pointer :: tan_g1_col(:) ! col (gN/m2) total ammoniacal N in FAN pool G1 + real(r8), pointer :: tan_g2_col(:) ! col (gN/m2) total ammoniacal N in FAN pool G2 + real(r8), pointer :: tan_s0_col(:) ! col (gN/m2) total ammoniacal N in FAN pool S0 + real(r8), pointer :: tan_s1_col(:) ! col (gN/m2) total ammoniacal N in FAN pool S1 + real(r8), pointer :: tan_s2_col(:) ! col (gN/m2) total ammoniacal N in FAN pool S2 + + real(r8), pointer :: tan_f0_col(:) ! col (gN/m2) total ammoniacal N in FAN pool F0 + real(r8), pointer :: tan_f1_col(:) ! col (gN/m2) total ammoniacal N in FAN pool F1 + real(r8), pointer :: tan_f2_col(:) ! col (gN/m2) total ammoniacal N in FAN pool F2 + real(r8), pointer :: tan_f3_col(:) ! col (gN/m2) total ammoniacal N in FAN pool F3 + + real(r8), pointer :: fert_u0_col(:) ! col (gN/m2) total urea N in FAN pool U0 + real(r8), pointer :: fert_u1_col(:) ! col (gN/m2) total urea N in FAN pool U1 + + real(r8), pointer :: man_u_grz_col(:) ! col (gN/m2) unavailable organic N, grazing + real(r8), pointer :: man_a_grz_col(:) ! col (gN/m2) available organic N, grazing + real(r8), pointer :: man_r_grz_col(:) ! col (gN/m2) resistant organic N, grazing + + real(r8), pointer :: man_u_app_col(:) ! col (gN/m2) unavailable organic N, application + real(r8), pointer :: man_a_app_col(:) ! col (gN/m2) available organic N, application + real(r8), pointer :: man_r_app_col(:) ! col (gN/m2) resistant organic N, application + + real(r8), pointer :: man_n_stored_col(:) ! col (gN/m2) manure N in storage + real(r8), pointer :: man_tan_stored_col(:) ! col (gN/m2) manure TAN in storage +!KO + ! FAN + real(r8), pointer :: smin_no3_monthly_col (:) ! col (gN/m2) soil mineral NO3 pool + real(r8), pointer :: smin_nh4_monthly_col (:) ! col (gN/m2) soil mineral NH4 pool + real(r8), pointer :: TAN_manu_col (:) ! col (gN/m2) total ammoniacal nitrogen in manure + real(r8), pointer :: no3_manure_col (:) ! col (gN/m2) NO3 pool in manure + real(r8), pointer :: manure_u_col (:) ! col (gN/m2) urine pool in manure + real(r8), pointer :: manure_n_col (:) ! col (gN/m2) non-mineralizable N pool in manure + real(r8), pointer :: manure_a_col (:) ! col (gN/m2) available N pool in manure + real(r8), pointer :: manure_r_col (:) ! col (gN/m2) resistant N pool in manure + real(r8), pointer :: n2o_manure_total_col (:) ! col (gN/m2) total atmospheric N emission of N2O from manure + real(r8), pointer :: nox_manure_total_col (:) ! col (gN/m2) total atmospheric N emission of NOx from manure + real(r8), pointer :: nh3_manure_total_col (:) ! col (gN/m2) total atmospheric N emission of NH3 from manure + real(r8), pointer :: N_Run_Off_manure_total_col (:) ! col (gN/m2) total N washed from N manure + real(r8), pointer :: nh4_manure_total_col (:) ! col (gN/m2) total NH4 emission from manure + real(r8), pointer :: no3_manure_total_col (:) ! col (gN/m2) total NO3 emission from manure + real(r8), pointer :: ndep_total_col (:) ! col (gN/m2) total ndep from manure and fertilizer + real(r8), pointer :: fert_u_col (:) ! col (gN/m2) N pool in fertilizer + real(r8), pointer :: no3_fert_col (:) ! col (gN/m2) NO3 pool in fertilizer + real(r8), pointer :: nh3_fert_total_col (:) ! col (gN/m2) total atmospheric N emission of NH3 from fertilizer + real(r8), pointer :: N_Run_Off_fert_total_col (:) ! col (gN/m2) total N washed from N fertilizer + real(r8), pointer :: nh4_fert_total_col (:) ! col (gN/m2) total NH4 emission from fertilizer + real(r8), pointer :: no3_fert_total_col (:) ! col (gN/m2) total NO3 emission from fertilizer + real(r8), pointer :: ndep_fert_total_col (:) ! col (gN/m2) total ndep from fertilizer + real(r8), pointer :: total_nh3_col (:) ! col (gN/m2) total atmospheric N emission of NH3 from Nr + real(r8), pointer :: total_N_Run_Off_col (:) ! col (gN/m2) total N washed from N Nr + real(r8), pointer :: total_nh4_col (:) ! col (gN/m2) total NH4 emission from Nr + real(r8), pointer :: total_no3_col (:) ! col (gN/m2) total NO3 emission from Nr + real(r8), pointer :: total_ndep_col (:) ! col (gN/m2) total ndep from Nr + real(r8), pointer :: TAN_fert_col (:) ! col (gN/m2) total ammoniacal nitrogen in fertilizer + real(r8), pointer :: man_water_pool_col (:) ! col (m3/m2) volume of water in manure/water solution + real(r8), pointer :: fert_water_pool_col (:) ! col (m3/m2) volume of water in fert/water solution + real(r8), pointer :: ra_col (:) ! col (s/m) aerodynamic resistance for grass pfts + real(r8), pointer :: rb_col (:) ! col (s/m) leaf boundary layer resistance for grass pfts + real(r8), pointer :: gdd8_col (:) ! col (ddays) growing degree-days base 8C from planting + real(r8), pointer :: t_a10_col (:) ! col (K) 10-day running mean of the 2 m temperature + real(r8), pointer :: t_a10min_col (:) ! col (K) 10-day running mean of min 2-m temperature + real(r8), pointer :: fert_app_jday_col (:) ! col (day) julian day of the first fertilizer application +!KO + ! summary (diagnostic) state variables, not involved in mass balance real(r8), pointer :: decomp_npools_col (:,:) ! col (gN/m2) decomposing (litter, cwd, soil) N pools real(r8), pointer :: decomp_npools_1m_col (:,:) ! col (gN/m2) diagnostic: decomposing (litter, cwd, soil) N pools to 1 meter @@ -129,6 +197,75 @@ subroutine InitAllocate(this, bounds) allocate(this%decomp_npools_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools)); this%decomp_npools_vr_col(:,:,:)= nan + !JV + if (use_fan) then + allocate(this%tan_g1_col(begc:endc)) ; this%tan_g1_col(:) = nan + allocate(this%tan_g2_col(begc:endc)) ; this%tan_g2_col(:) = nan + allocate(this%tan_s0_col(begc:endc)) ; this%tan_s0_col(:) = nan + allocate(this%tan_s1_col(begc:endc)) ; this%tan_s1_col(:) = nan + allocate(this%tan_s2_col(begc:endc)) ; this%tan_s2_col(:) = nan + allocate(this%tan_f0_col(begc:endc)) ; this%tan_f0_col(:) = nan + allocate(this%tan_f1_col(begc:endc)) ; this%tan_f1_col(:) = nan + allocate(this%tan_f2_col(begc:endc)) ; this%tan_f2_col(:) = nan + allocate(this%tan_f3_col(begc:endc)) ; this%tan_f3_col(:) = nan + allocate(this%fert_u0_col(begc:endc)) ; this%fert_u0_col(:) = nan + allocate(this%fert_u1_col(begc:endc)) ; this%fert_u1_col(:) = nan + + allocate(this%man_u_grz_col(begc:endc)) ; this%man_u_grz_col(:) = nan + allocate(this%man_a_grz_col(begc:endc)) ; this%man_a_grz_col(:) = nan + allocate(this%man_r_grz_col(begc:endc)) ; this%man_r_grz_col(:) = nan + + allocate(this%man_u_app_col(begc:endc)) ; this%man_u_app_col(:) = nan + allocate(this%man_a_app_col(begc:endc)) ; this%man_a_app_col(:) = nan + allocate(this%man_r_app_col(begc:endc)) ; this%man_r_app_col(:) = nan + + allocate(this%man_n_stored_col(begc:endc)) ; this%man_n_stored_col(:) = nan + allocate(this%man_tan_stored_col(begc:endc)) ; this%man_tan_stored_col(:) = nan + + end if + !KO + + + if ( use_fan ) then + allocate(this%smin_no3_monthly_col (begc:endc)) ; this%smin_no3_monthly_col (:) = nan + allocate(this%smin_nh4_monthly_col (begc:endc)) ; this%smin_nh4_monthly_col (:) = nan + allocate(this%TAN_manu_col (begc:endc)) ; this%TAN_manu_col (:) = nan + allocate(this%no3_manure_col (begc:endc)) ; this%no3_manure_col (:) = nan + allocate(this%manure_u_col (begc:endc)) ; this%manure_u_col (:) = nan + allocate(this%manure_n_col (begc:endc)) ; this%manure_n_col (:) = nan + allocate(this%manure_a_col (begc:endc)) ; this%manure_a_col (:) = nan + allocate(this%manure_r_col (begc:endc)) ; this%manure_r_col (:) = nan + allocate(this%n2o_manure_total_col (begc:endc)) ; this%n2o_manure_total_col (:) = nan + allocate(this%nox_manure_total_col (begc:endc)) ; this%nox_manure_total_col (:) = nan + allocate(this%nh3_manure_total_col (begc:endc)) ; this%nh3_manure_total_col (:) = nan + allocate(this%N_Run_Off_manure_total_col (begc:endc)) ; this%N_Run_Off_manure_total_col (:) = nan + allocate(this%nh4_manure_total_col (begc:endc)) ; this%nh4_manure_total_col (:) = nan + allocate(this%no3_manure_total_col (begc:endc)) ; this%no3_manure_total_col (:) = nan + allocate(this%ndep_total_col (begc:endc)) ; this%ndep_total_col (:) = nan + allocate(this%fert_u_col (begc:endc)) ; this%fert_u_col (:) = nan + allocate(this%no3_fert_col (begc:endc)) ; this%no3_fert_col (:) = nan + allocate(this%nh3_fert_total_col (begc:endc)) ; this%nh3_fert_total_col (:) = nan + allocate(this%N_Run_Off_fert_total_col (begc:endc)) ; this%N_Run_Off_fert_total_col (:) = nan + allocate(this%nh4_fert_total_col (begc:endc)) ; this%nh4_fert_total_col (:) = nan + allocate(this%no3_fert_total_col (begc:endc)) ; this%no3_fert_total_col (:) = nan + allocate(this%ndep_fert_total_col (begc:endc)) ; this%ndep_fert_total_col (:) = nan + allocate(this%total_nh3_col (begc:endc)) ; this%total_nh3_col (:) = nan + allocate(this%total_N_Run_Off_col (begc:endc)) ; this%total_N_Run_Off_col (:) = nan + allocate(this%total_nh4_col (begc:endc)) ; this%total_nh4_col (:) = nan + allocate(this%total_no3_col (begc:endc)) ; this%total_no3_col (:) = nan + allocate(this%total_ndep_col (begc:endc)) ; this%total_ndep_col (:) = nan + allocate(this%TAN_fert_col (begc:endc)) ; this%TAN_fert_col (:) = nan + allocate(this%man_water_pool_col (begc:endc)) ; this%man_water_pool_col (:) = nan + allocate(this%fert_water_pool_col (begc:endc)) ; this%fert_water_pool_col (:) = nan + allocate(this%ra_col (begc:endc)) ; this%ra_col (:) = nan + allocate(this%rb_col (begc:endc)) ; this%rb_col (:) = nan + allocate(this%gdd8_col (begc:endc)) ; this%gdd8_col (:) = nan + allocate(this%fert_app_jday_col (begc:endc)) ; this%fert_app_jday_col (:) = nan + allocate(this%t_a10_col (begc:endc)) ; this%t_a10_col (:) = nan + allocate(this%t_a10min_col (begc:endc)) ; this%t_a10min_col (:) = nan + end if +!KO + end subroutine InitAllocate !------------------------------------------------------------------------ @@ -249,6 +386,19 @@ subroutine InitHistory(this, bounds) call hist_addfld1d (fname='SMIN_NH4', units='gN/m^2', & avgflag='A', long_name='soil mineral NH4', & ptr_col=this%smin_nh4_col) +!KO + if ( use_fan ) then + this%smin_no3_monthly_col(begc:endc) = spval + call hist_addfld1d (fname='SMIN_NO3_MONTHLY', units='gN/m^2/month', & + avgflag='A', long_name='soil mineral NO3 monthly', & + ptr_col=this%smin_no3_monthly_col) + + this%smin_nh4_monthly_col(begc:endc) = spval + call hist_addfld1d (fname='SMIN_NH4_MONTHLY', units='gN/m^2/month', & + avgflag='A', long_name='soil mineral NH4 monthly', & + ptr_col=this%smin_nh4_monthly_col) + end if +!KO endif else if ( nlevdecomp_full > 1 ) then @@ -277,6 +427,263 @@ subroutine InitHistory(this, bounds) &only makes sense at the column level: should not be averaged to gridcell', & ptr_col=this%dyn_nbal_adjustments_col, default='inactive') +!KO + if ( use_fan ) then + + this%TAN_manu_col(begc:endc) = spval + call hist_addfld1d (fname='TAN_MANU', units='gN/m^2', & + avgflag='A', long_name='Manure TAN pool', & + ptr_col=this%TAN_manu_col) + + this%TAN_fert_col(begc:endc) = spval + call hist_addfld1d (fname='TAN_FERT', units='gN/m^2', & + avgflag='A', long_name='Fertilizer TAN pool', & + ptr_col=this%TAN_fert_col) + + this%fert_u_col(begc:endc) = spval + call hist_addfld1d (fname='TAN_FERT_U', units='gN/m^2', & + avgflag='A', long_name='Fertilizer N pool', & + ptr_col=this%fert_u_col) + + this%manure_n_col(begc:endc) = spval + call hist_addfld1d (fname='TAN_MANU_N', units='gN/m^2', & + avgflag='A', long_name='Non-minerizable manure TAN pool', & + ptr_col=this%manure_n_col) + + this%manure_u_col(begc:endc) = spval + call hist_addfld1d (fname='TAN_MANU_U', units='gN/m^2', & + avgflag='A', long_name='Urine manure TAN pool', & + ptr_col=this%manure_u_col) + + this%manure_a_col(begc:endc) = spval + call hist_addfld1d (fname='TAN_MANU_A', units='gN/m^2', & + avgflag='A', long_name='Available manure TAN pool', & + ptr_col=this%manure_a_col) + + this%manure_r_col(begc:endc) = spval + call hist_addfld1d (fname='TAN_MANU_R', units='gN/m^2', & + avgflag='A', long_name='Resistant manure TAN pool', & + ptr_col=this%manure_r_col) + + this%man_water_pool_col(begc:endc) = spval + call hist_addfld1d (fname='MAN_WATER_POOL', units='m^3/m^2', & + avgflag='A', long_name='Manure water pool', & + ptr_col=this%man_water_pool_col) + + this%fert_water_pool_col(begc:endc) = spval + call hist_addfld1d (fname='FERT_WATER_POOL', units='m^3/m^2', & + avgflag='A', long_name='Fertilizer water pool', & + ptr_col=this%fert_water_pool_col) + + this%ra_col(begc:endc) = spval + call hist_addfld1d (fname='RA_COL', units='s/m', & + avgflag='A', long_name='Column aerodynamic resistance for grass pft', & + ptr_col=this%ra_col) + + this%rb_col(begc:endc) = spval + call hist_addfld1d (fname='RB_COL', units='s/m', & + avgflag='A', long_name='Column boundary layer resistance for grass pft', & + ptr_col=this%rb_col) + + this%fert_app_jday_col(begc:endc) = spval + call hist_addfld1d (fname='FERT_APP_JDAY', units='', & + avgflag='A', long_name='Fertilizer application julian day', & + ptr_col=this%fert_app_jday_col) + + this%no3_manure_col(begc:endc) = spval + call hist_addfld1d (fname='NO3_MANURE', units='gN/m^2', & + avgflag='A', long_name='NO3 Pool in Manure', & + ptr_col=this%no3_manure_col) + + this%n2o_manure_total_col(begc:endc) = spval + call hist_addfld1d (fname='N2O_MANURE_TOTAL', units='gN/m^2/yr', & + avgflag='A', long_name='TOTAL N2O emission from manure', & + ptr_col=this%n2o_manure_total_col) + + this%nox_manure_total_col(begc:endc) = spval + call hist_addfld1d (fname='NOx_MANURE_TOTAL', units='gN/m^2/yr', & + avgflag='A', long_name='TOTAL NOx emission from manure', & + ptr_col=this%nox_manure_total_col) + + this%nh3_manure_total_col(begc:endc) = spval + call hist_addfld1d (fname='NH3_MANURE_TOTAL', units='gN/m^2/yr', & + avgflag='A', long_name='TOTAL NH3 emission from manure', & + ptr_col=this%nh3_manure_total_col) + + this%ndep_total_col(begc:endc) = spval + call hist_addfld1d (fname='NDEP_TOTAL', units='gN/m^2/yr', & + avgflag='A', long_name='TOTAL N DEP from manure and fertilizer', & + ptr_col=this%ndep_total_col) + + this%N_Run_Off_manure_total_col(begc:endc) = spval + call hist_addfld1d (fname='N_RUN_OFF_MANURE_TOTAL', units='gN/m^2/yr', & + avgflag='A', long_name='Total N run off from manure', & + ptr_col=this%N_Run_Off_manure_total_col) + + this%nh4_manure_total_col(begc:endc) = spval + call hist_addfld1d (fname='NH4_MANURE_TOTAL', units='gN/m^2/yr', & + avgflag='A', long_name='Total NH4 from manure', & + ptr_col=this%nh4_manure_total_col) + + this%no3_manure_total_col(begc:endc) = spval + call hist_addfld1d (fname='NO3_MANURE_TOTAL', units='gN/m^2/yr', & + avgflag='A', long_name='Total NO3 from manure', & + ptr_col=this%no3_manure_total_col) + + this%nh3_fert_total_col(begc:endc) = spval + call hist_addfld1d (fname='NH3_FERT_TOTAL', units='gN/m^2/yr', & + avgflag='A', long_name='TOTAL NH3 emission from fertilizer', & + ptr_col=this%nh3_fert_total_col) + + this%ndep_fert_total_col(begc:endc) = spval + call hist_addfld1d (fname='NDEP_FERT_TOTAL', units='gN/m^2/yr', & + avgflag='A', long_name='TOTAL N DEP from FERTILIZER', & + ptr_col=this%ndep_fert_total_col) + + this%N_Run_Off_fert_total_col(begc:endc) = spval + call hist_addfld1d (fname='N_RUN_OFF_FERT_TOTAL', units='gN/m^2/yr', & + avgflag='A', long_name='Total N run off from fertilizer', & + ptr_col=this%N_Run_Off_fert_total_col) + + this%nh4_fert_total_col(begc:endc) = spval + call hist_addfld1d (fname='NH4_FERT_TOTAL', units='gN/m^2/yr', & + avgflag='A', long_name='Total NH4 from fertilizer', & + ptr_col=this%nh4_fert_total_col) + + this%no3_fert_total_col(begc:endc) = spval + call hist_addfld1d (fname='NO3_FERT_TOTAL', units='gN/m^2/yr', & + avgflag='A', long_name='Total NO3 from fertilizer', & + ptr_col=this%no3_fert_total_col) + + this%total_nh3_col(begc:endc) = spval + call hist_addfld1d (fname='TOTAL_NH3', units='gN/m^2/yr', & + avgflag='A', long_name='TOTAL NH3 emission from Nr', & + ptr_col=this%total_nh3_col) + + this%total_ndep_col(begc:endc) = spval + call hist_addfld1d (fname='TOTAL_NDEP', units='gN/m^2/yr', & + avgflag='A', long_name='TOTAL N DEP from Nr', & + ptr_col=this%total_ndep_col) + + this%total_N_Run_Off_col(begc:endc) = spval + call hist_addfld1d (fname='TOTAL_N_RUN_OFF', units='gN/m^2/yr', & + avgflag='A', long_name='Total N run off from Nr', & + ptr_col=this%total_N_Run_Off_col) + + this%total_nh4_col(begc:endc) = spval + call hist_addfld1d (fname='TOTAL_NH4', units='gN/m^2', & + avgflag='A', long_name='Total NH4 from Nr', & + ptr_col=this%total_nh4_col) + + this%total_no3_col(begc:endc) = spval + call hist_addfld1d (fname='TOTAL_NO3', units='gN/m^2', & + avgflag='A', long_name='Total NO3 from Nr', & + ptr_col=this%total_no3_col) + + end if +!KO + + !JV + if (use_fan) then + this%tan_g1_col(begc:endc) = spval + call hist_addfld1d (fname='TAN_G1', units='gN/m^2', & + avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool G1', & + ptr_col=this%tan_g1_col) + + this%tan_g2_col(begc:endc) = spval + call hist_addfld1d (fname='TAN_G2', units='gN/m^2', & + avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool G2', & + ptr_col=this%tan_g2_col) + + this%tan_f0_col(begc:endc) = spval + call hist_addfld1d (fname='TAN_F0', units='gN/m^2', & + avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool F0', & + ptr_col=this%tan_f0_col) + + this%tan_f1_col(begc:endc) = spval + call hist_addfld1d (fname='TAN_F1', units='gN/m^2', & + avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool F1', & + ptr_col=this%tan_f1_col) + + this%tan_f2_col(begc:endc) = spval + call hist_addfld1d (fname='TAN_F2', units='gN/m^2', & + avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool F2', & + ptr_col=this%tan_f2_col) + + this%tan_f3_col(begc:endc) = spval + call hist_addfld1d (fname='TAN_F3', units='gN/m^2', & + avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool F3', & + ptr_col=this%tan_f3_col) + + this%tan_f0_col(begc:endc) = spval + call hist_addfld1d (fname='FERT_U0', units='gN/m^2', & + avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool F0', & + ptr_col=this%fert_u0_col) + + this%tan_f1_col(begc:endc) = spval + call hist_addfld1d (fname='FERT_U1', units='gN/m^2', & + avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool F1', & + ptr_col=this%fert_u1_col) + + + this%tan_s0_col(begc:endc) = spval + call hist_addfld1d (fname='TAN_S0', units='gN/m^2', & + avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool S0', & + ptr_col=this%tan_s0_col) + + this%tan_s1_col(begc:endc) = spval + call hist_addfld1d (fname='TAN_S1', units='gN/m^2', & + avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool S1', & + ptr_col=this%tan_s1_col) + + this%tan_s1_col(begc:endc) = spval + call hist_addfld1d (fname='TAN_S2', units='gN/m^2', & + avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool S2', & + ptr_col=this%tan_s2_col) + + this%man_u_grz_col(begc:endc) = spval + call hist_addfld1d (fname='MAN_U_GRZ', units='gN/m^2', & + avgflag='A', long_name='Unavailable manure nitrogen, grazing', & + ptr_col=this%man_u_grz_col) + + this%man_a_grz_col(begc:endc) = spval + call hist_addfld1d (fname='MAN_A_GRZ', units='gN/m^2', & + avgflag='A', long_name='Available manure nitrogen, grazing', & + ptr_col=this%man_a_grz_col) + + this%man_r_grz_col(begc:endc) = spval + call hist_addfld1d (fname='MAN_R_GRZ', units='gN/m^2', & + avgflag='A', long_name='Resistant manure nitrogen, grazing', & + ptr_col=this%man_r_grz_col) + + this%man_u_grz_col(begc:endc) = spval + call hist_addfld1d (fname='MAN_U_APP', units='gN/m^2', & + avgflag='A', long_name='Unavailable manure nitrogen, application', & + ptr_col=this%man_u_app_col) + + this%man_a_app_col(begc:endc) = spval + call hist_addfld1d (fname='MAN_A_APP', units='gN/m^2', & + avgflag='A', long_name='Available manure nitrogen, application', & + ptr_col=this%man_a_app_col) + + this%man_r_app_col(begc:endc) = spval + call hist_addfld1d (fname='MAN_R_APP', units='gN/m^2', & + avgflag='A', long_name='Resistant manure nitrogen, application', & + ptr_col=this%man_r_app_col) + + this%man_n_stored_col(begc:endc) = spval + call hist_addfld1d (fname='MAN_N_STORED', units='gN/m^2', & + avgflag='A', long_name='Manure nitrogen in storage', & + ptr_col=this%man_n_stored_col) + + this%man_tan_stored_col(begc:endc) = spval + call hist_addfld1d (fname='MAN_TAN_STORED', units='gN/m^2', & + avgflag='A', long_name='Manure ammoniacal nitrogen in storage', & + ptr_col=this%man_tan_stored_col) + + end if + + if (use_nitrif_denitrif) then call hist_addfld1d (fname='DYN_COL_SOIL_ADJUSTMENTS_NO3', units='gN/m^2', & avgflag='SUM', & @@ -360,6 +767,70 @@ subroutine InitCold(this, bounds, & this%totlitn_1m_col(c) = 0._r8 this%totsomn_1m_col(c) = 0._r8 this%cwdn_col(c) = 0._r8 +!KO + if ( use_fan ) then + !JV + this%tan_g1_col(c) = 0.0_r8 + this%tan_g2_col(c) = 0.0_r8 + this%tan_s0_col(c) = 0.0_r8 + this%tan_s1_col(c) = 0.0_r8 + this%tan_s2_col(c) = 0.0_r8 + this%tan_f0_col(c) = 0.0_r8 + this%tan_f1_col(c) = 0.0_r8 + this%tan_f2_col(c) = 0.0_r8 + this%tan_f3_col(c) = 0.0_r8 + this%fert_u1_col(c) = 0.0_r8 + this%fert_u0_col(c) = 0.0_r8 + + this%man_u_grz_col(c) = 0.0_r8 + this%man_a_grz_col(c) = 0.0_r8 + this%man_r_grz_col(c) = 0.0_r8 + + this%man_u_app_col(c) = 0.0_r8 + this%man_a_app_col(c) = 0.0_r8 + this%man_r_app_col(c) = 0.0_r8 + + this%man_tan_stored_col(c) = 0.0_r8 + this%man_n_stored_col(c) = 0.0_r8 + + this%TAN_manu_col(c) = 0._r8 + this%no3_manure_col(c) = 0._r8 + this%manure_u_col(c) = 0._r8 + this%manure_n_col(c) = 0._r8 + this%manure_a_col(c) = 0._r8 + this%manure_r_col(c) = 0._r8 + this%n2o_manure_total_col(c) = 0._r8 + this%nox_manure_total_col(c) = 0._r8 + this%nh3_manure_total_col(c) = 0._r8 + this%N_Run_Off_manure_total_col(c) = 0._r8 + this%no3_manure_total_col(c) = 0._r8 + this%nh4_manure_total_col(c) = 0._r8 + this%ndep_total_col(c) = 0._r8 + this%smin_nh4_monthly_col(c) = 0._r8 + this%smin_no3_monthly_col(c) = 0._r8 + this%TAN_fert_col(c) = 0._r8 + this%no3_fert_col(c) = 0._r8 + this%man_water_pool_col(c) = 0._r8 + this%fert_water_pool_col(c) = 0._r8 + this%ra_col(c) = 0._r8 + this%rb_col(c) = 0._r8 + this%t_a10_col(c) = 0._r8 + this%gdd8_col(c) = 0._r8 + this%t_a10min_col(c) = 0._r8 + this%fert_app_jday_col(c) = 0._r8 + this%fert_u_col(c) = 0._r8 + this%nh3_fert_total_col(c) = 0._r8 + this%no3_fert_total_col(c) = 0._r8 + this%nh4_fert_total_col(c) = 0._r8 + this%ndep_fert_total_col(c) = 0._r8 + this%N_Run_Off_fert_total_col(c) = 0._r8 + this%total_nh3_col(c) = 0._r8 + this%total_N_Run_Off_col(c) = 0._r8 + this%total_no3_col(c) = 0._r8 + this%total_nh4_col(c) = 0._r8 + this%total_ndep_col(c) = 0._r8 + end if +!KO end if end do @@ -486,12 +957,233 @@ subroutine Restart ( this, bounds, ncid, flag, totvegc_col ) dim1name='column', & long_name='', units='', & interpinic_flag='interp', readvar=readvar, data=ptr1d) +!KO + ! I don't think these have to be on the restart file since they are + ! computed at each time step and it doesn't depend on the previous + ! time step. Plus it should be outside the if/else use_vertsoilc + ! structure (just within the use_nitrif_denitrif structure) + if ( use_fan ) then + call restartvar(ncid=ncid, flag=flag, varname='smin_nh4_monthly', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%smin_nh4_monthly_col) + + call restartvar(ncid=ncid, flag=flag, varname='smin_no3_monthly', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%smin_no3_monthly_col) + end if +!KO end if if (flag=='read' .and. .not. readvar) then call endrun(msg= 'ERROR:: smin_no3_vr'//' is required on an initialization dataset' ) end if end if +!KO + if ( use_fan ) then + + call restartvar(ncid=ncid, flag=flag, varname='TAN_manu', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%TAN_manu_col) + + call restartvar(ncid=ncid, flag=flag, varname='TAN_fert', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%TAN_fert_col) + + call restartvar(ncid=ncid, flag=flag, varname='man_water_pool', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%man_water_pool_col) + + call restartvar(ncid=ncid, flag=flag, varname='fert_water_pool', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%fert_water_pool_col) + + call restartvar(ncid=ncid, flag=flag, varname='ra', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%ra_col) + + call restartvar(ncid=ncid, flag=flag, varname='rb', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%rb_col) + + call restartvar(ncid=ncid, flag=flag, varname='gdd8', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%gdd8_col) + + call restartvar(ncid=ncid, flag=flag, varname='t_a10', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%t_a10_col) + + call restartvar(ncid=ncid, flag=flag, varname='t_a10min', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%t_a10min_col) + + call restartvar(ncid=ncid, flag=flag, varname='fert_app_jday', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%fert_app_jday_col) + + call restartvar(ncid=ncid, flag=flag, varname='no3_manure', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%no3_manure_col) + + call restartvar(ncid=ncid, flag=flag, varname='no3_fert', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%no3_fert_col) + + call restartvar(ncid=ncid, flag=flag, varname='n2o_manure_total', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%n2o_manure_total_col) + + call restartvar(ncid=ncid, flag=flag, varname='nox_manure_total', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%nox_manure_total_col) + + call restartvar(ncid=ncid, flag=flag, varname='nh3_manure_total', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%nh3_manure_total_col) + + call restartvar(ncid=ncid, flag=flag, varname='nh3_fert_total', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%nh3_fert_total_col) + + call restartvar(ncid=ncid, flag=flag, varname='total_nh3', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%total_nh3_col) + + call restartvar(ncid=ncid, flag=flag, varname='manure_u', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%manure_u_col) + + call restartvar(ncid=ncid, flag=flag, varname='fert_u', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%fert_u_col) + + call restartvar(ncid=ncid, flag=flag, varname='manure_n', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%manure_n_col) + + call restartvar(ncid=ncid, flag=flag, varname='manure_a', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%manure_a_col) + + call restartvar(ncid=ncid, flag=flag, varname='manure_r', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%manure_r_col) + + call restartvar(ncid=ncid, flag=flag, varname='ndep_total', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%ndep_total_col) + + call restartvar(ncid=ncid, flag=flag, varname='ndep_fert_total', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%ndep_fert_total_col) + + call restartvar(ncid=ncid, flag=flag, varname='total_ndep', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%total_ndep_col) + + call restartvar(ncid=ncid, flag=flag, varname='N_Run_Off_manure_total', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%N_Run_Off_manure_total_col) + + call restartvar(ncid=ncid, flag=flag, varname='N_Run_Off_fert_total', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%N_Run_Off_fert_total_col) + + call restartvar(ncid=ncid, flag=flag, varname='total_N_Run_Off', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%total_N_Run_Off_col) + + call restartvar(ncid=ncid, flag=flag, varname='no3_manure_total', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%no3_manure_total_col) + + call restartvar(ncid=ncid, flag=flag, varname='no3_fert_total', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%no3_fert_total_col) + + call restartvar(ncid=ncid, flag=flag, varname='total_no3', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%total_no3_col) + + call restartvar(ncid=ncid, flag=flag, varname='nh4_manure_total', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%nh4_manure_total_col) + + call restartvar(ncid=ncid, flag=flag, varname='nh4_fert_total', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%nh4_fert_total_col) + + call restartvar(ncid=ncid, flag=flag, varname='total_nh4', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%total_nh4_col) + + !JV + call restartvar(ncid=ncid, flag=flag, varname='tan_g1', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%tan_g1_col) + call restartvar(ncid=ncid, flag=flag, varname='tan_g2', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%tan_g2_col) + call restartvar(ncid=ncid, flag=flag, varname='tan_s0', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%tan_s0_col) + call restartvar(ncid=ncid, flag=flag, varname='tan_s1', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%tan_s1_col) + call restartvar(ncid=ncid, flag=flag, varname='tan_s2', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%tan_s2_col) + call restartvar(ncid=ncid, flag=flag, varname='tan_f0', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%tan_f0_col) + call restartvar(ncid=ncid, flag=flag, varname='tan_f1', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%tan_f1_col) + call restartvar(ncid=ncid, flag=flag, varname='tan_f2', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%tan_f2_col) + call restartvar(ncid=ncid, flag=flag, varname='tan_f3', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%tan_f3_col) + + call restartvar(ncid=ncid, flag=flag, varname='fert_u0', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%fert_u0_col) + call restartvar(ncid=ncid, flag=flag, varname='fert_u1', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%fert_u1_col) + + call restartvar(ncid=ncid, flag=flag, varname='man_u_grz', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%man_u_grz_col) + call restartvar(ncid=ncid, flag=flag, varname='man_a_grz', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%man_a_grz_col) + call restartvar(ncid=ncid, flag=flag, varname='man_r_grz', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%man_r_grz_col) + + call restartvar(ncid=ncid, flag=flag, varname='man_u_app', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%man_u_app_col) + call restartvar(ncid=ncid, flag=flag, varname='man_a_app', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%man_a_app_col) + call restartvar(ncid=ncid, flag=flag, varname='man_r_app', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%man_r_app_col) + + call restartvar(ncid=ncid, flag=flag, varname='man_tan_stored', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%man_tan_stored_col) + call restartvar(ncid=ncid, flag=flag, varname='man_n_stored', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%man_n_stored_col) + + !JV + end if +!KO + if (use_nitrif_denitrif) then ! smin_nh4 if (use_vertsoilc) then @@ -684,6 +1376,60 @@ subroutine SetValues ( this, num_column, filter_column, value_column ) this%totlitn_1m_col(i) = value_column end do +!KO + if ( use_fan ) then + do fi = 1,num_column + i = filter_column(fi) + if (use_nitrif_denitrif) then + this%smin_no3_monthly_col(i) = value_column + this%smin_nh4_monthly_col(i) = value_column + end if + end do + end if +!KO + +!KO + if ( use_fan ) then + do fi = 1,num_column + i = filter_column(fi) + this%TAN_manu_col(i) = value_column + this%no3_manure_col(i) = value_column + this%manure_u_col(i) = value_column + this%manure_n_col(i) = value_column + this%manure_a_col(i) = value_column + this%manure_r_col(i) = value_column + this%n2o_manure_total_col(i) = value_column + this%nox_manure_total_col(i) = value_column + this%nh3_manure_total_col(i) = value_column + this%N_Run_Off_manure_total_col(i) = value_column + this%nh4_manure_total_col(i) = value_column + this%no3_manure_total_col(i) = value_column + this%ndep_total_col(i) = value_column + this%fert_u_col(i) = value_column + this%no3_fert_col(i) = value_column + this%nh3_fert_total_col(i) = value_column + this%N_Run_Off_fert_total_col(i) = value_column + this%nh4_fert_total_col(i) = value_column + this%no3_fert_total_col(i) = value_column + this%ndep_fert_total_col(i) = value_column + this%total_nh3_col(i) = value_column + this%total_N_Run_Off_col(i) = value_column + this%total_nh4_col(i) = value_column + this%total_no3_col(i) = value_column + this%total_ndep_col(i) = value_column + this%TAN_fert_col(i) = value_column + this%man_water_pool_col(i) = value_column + this%fert_water_pool_col(i) = value_column + this%ra_col(i) = value_column + this%rb_col(i) = value_column + this%gdd8_col(i) = value_column + this%t_a10_col(i) = value_column + this%t_a10min_col(i) = value_column + this%fert_app_jday_col(i) = value_column + end do + end if +!KO + do j = 1,nlevdecomp_full do fi = 1,num_column i = filter_column(fi) @@ -720,6 +1466,11 @@ end subroutine SetValues !----------------------------------------------------------------------- subroutine Summary(this, bounds, num_allc, filter_allc) ! +!KO + ! !USES: + use clm_time_manager , only : get_curr_date + ! +!KO ! !ARGUMENTS: class (soilbiogeochem_nitrogenstate_type) :: this type(bounds_type) , intent(in) :: bounds @@ -730,8 +1481,19 @@ subroutine Summary(this, bounds, num_allc, filter_allc) integer :: c,j,k,l ! indices integer :: fc ! lake filter indices real(r8) :: maxdepth ! depth to integrate soil variables +!KO + ! !LOCAL VARIABLES: + integer kyr ! current year + integer kmo ! month of year (1, ..., 12) + integer kda ! day of month (1, ..., 31) + integer mcsec ! seconds of day (0, ..., seconds/day) +!KO !----------------------------------------------------------------------- +!KO + call get_curr_date (kyr, kmo, kda, mcsec) +!KO + ! vertically integrate NO3 NH4 N2O pools if (use_nitrif_denitrif) then do fc = 1,num_allc @@ -749,8 +1511,23 @@ subroutine Summary(this, bounds, num_allc, filter_allc) this%smin_nh4_col(c) = & this%smin_nh4_col(c) + & this%smin_nh4_vr_col(c,j) * dzsoi_decomp(j) - end do - end do + + end do + end do +!KO + if ( use_fan ) then + do fc = 1,num_allc + c = filter_allc(fc) + if (kda == 1 .and. mcsec == 0) then + this%smin_no3_monthly_col(c) = 0._r8 + this%smin_nh4_monthly_col(c) = 0._r8 + endif + + this%smin_no3_monthly_col(c) = this%smin_no3_col(c) + this%smin_nh4_monthly_col(c) = this%smin_nh4_col(c) + end do + end if +!KO end if From 51270398053149e05dac7d872656224cde31822c Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Fri, 16 Mar 2018 18:35:40 -0400 Subject: [PATCH 002/181] point externals to fancpl branch --- Externals.cfg | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index cfd2b65564..34ff8c4b70 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -29,8 +29,8 @@ required = True [cime] local_path = cime protocol = git -repo_url = https://github.com/CESM-Development/cime -tag = clm4518/n04/cime5.4.0-alpha.03 +repo_url = https://github.com/juliusvira/cime +branch = fancpl required = True [externals_description] From e23d599eacb48eb0dfe069711bdb3d3e20852de5 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Mon, 19 Mar 2018 17:32:24 -0400 Subject: [PATCH 003/181] first attempt, not quite working --- bld/CLMBuildNamelist.pm | 23 ++++++++++++++----- bld/configure | 2 +- .../namelist_defaults_clm4_5.xml | 2 +- bld/namelist_files/namelist_defaults_fan.xml | 19 +++++++++++++++ .../namelist_definition_drv_flds.xml | 9 ++++++++ 5 files changed, 47 insertions(+), 8 deletions(-) create mode 100644 bld/namelist_files/namelist_defaults_fan.xml diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index c4abbb000c..50917ba734 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -267,6 +267,7 @@ sub process_commandline { chk_res => undef, note => undef, drydep => 0, + fan => "default", output_reals_filename => undef, fire_emis => 0, megan => "default", @@ -512,7 +513,8 @@ sub read_namelist_defaults { "$cfgdir/namelist_files/namelist_defaults_$phys.xml", "$cfgdir/namelist_files/namelist_defaults_drv.xml", "$cfgdir/namelist_files/namelist_defaults_fire_emis.xml", - "$cfgdir/namelist_files/namelist_defaults_drydep.xml" ); + "$cfgdir/namelist_files/namelist_defaults_drydep.xml", + "$cfgdir/namelist_files/namelist_defaults_fan.xml" ); # Add the location of the use case defaults files to the options hash $opts->{'use_case_dir'} = "$cfgdir/namelist_files/use_cases"; @@ -3055,11 +3057,17 @@ sub setup_logic_fan { # Flags to control FAN (Flow of Agricultural Nitrogen) nitrogen deposition (manure and fertilizer) # my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_; - + print "FAN MODE: $opts->{'fan'}\n"; if ( $physv->as_long() >= $physv->as_long("clm4_5") ) { - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_fan', - 'use_cn'=>$nl_flags->{'use_cn'}, 'use_ed'=>$nl_flags->{'use_ed'} ); - $nl_flags->{'use_fan'} = $nl->get_value('use_fan'); + if ( $opts->{'fan'} ) { + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_fan', + 'use_cn'=>$nl_flags->{'use_cn'}, 'use_ed'=>$nl_flags->{'use_ed'} ); + $nl_flags->{'use_fan'} = $nl->get_value('use_fan'); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fan_nh3_to_atm', + 'fan_mode'=>$opts->{'fan'}); + $nl_flags->{'fan_nh3_to_atm'} = $nl->get_value('fan_nh3_to_atm'); + + } if ( value_is_true( $nl_flags->{'use_ed'} ) && value_is_true( $nl_flags->{'use_fan'} ) ) { fatal_error("Cannot turn use_fan on when use_ed is on\n" ); } @@ -3970,7 +3978,8 @@ sub write_output_files { $log->verbose_message("Writing clm namelist to $outfile"); # Drydep, fire-emission or MEGAN namelist for driver - @groups = qw(drydep_inparm megan_emis_nl fire_emis_nl carma_inparm); + @groups = qw(drydep_inparm megan_emis_nl fire_emis_nl carma_inparm fan_inparm); + print "GROUPS: @groups \n"; $outfile = "$opts->{'dir'}/drv_flds_in"; $nl->write($outfile, 'groups'=>\@groups, 'note'=>"$note" ); $log->verbose_message("Writing @groups namelists to $outfile"); @@ -4590,6 +4599,7 @@ sub version { sub main { my %nl_flags; + $nl_flags{'cfgdir'} = dirname(abs_path($0)); my %opts = process_commandline(\%nl_flags); @@ -4604,6 +4614,7 @@ sub main { my $definition = read_namelist_definition($cfgdir, \%opts, \%nl_flags, $physv); my $defaults = read_namelist_defaults($cfgdir, \%opts, \%nl_flags, $cfg, $physv); + # List valid values if asked for list_options(\%opts, $definition, $defaults); diff --git a/bld/configure b/bld/configure index fb5fe9bf7f..1be8eb8db8 100755 --- a/bld/configure +++ b/bld/configure @@ -46,7 +46,7 @@ OPTIONS white-space must be quoted. Long option names may be supplied with either single or double leading dashes. A consequence of this is that single letter options may NOT be bundled. - + -bgc Build CLM with BGC package [ none | cn | cndv ] (default is none). -cache Name of output cache file (default: config_cache.xml). diff --git a/bld/namelist_files/namelist_defaults_clm4_5.xml b/bld/namelist_files/namelist_defaults_clm4_5.xml index 5b70602e0e..07b6c2f316 100644 --- a/bld/namelist_files/namelist_defaults_clm4_5.xml +++ b/bld/namelist_files/namelist_defaults_clm4_5.xml @@ -450,7 +450,7 @@ attributes from the config_cache.xml file (with keys converted to upper-case). .true. .false. .false. - +.false. + +.false. +.true. + + diff --git a/bld/namelist_files/namelist_definition_drv_flds.xml b/bld/namelist_files/namelist_definition_drv_flds.xml index b54082981a..978a1c76b5 100644 --- a/bld/namelist_files/namelist_definition_drv_flds.xml +++ b/bld/namelist_files/namelist_definition_drv_flds.xml @@ -128,4 +128,13 @@ List of fluxes needed by the CARMA model, from CLM to CAM. + + + + + Switch on/off the coupling of NH3 emissions from FAN/CLM to CAM + + + From f52f15940edc77288e54382ea1559d9c868e8557 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Mon, 19 Mar 2018 19:46:30 -0400 Subject: [PATCH 004/181] add handling of -fan option to CLMBuildNamelist --- bld/CLMBuildNamelist.pm | 1 + 1 file changed, 1 insertion(+) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 50917ba734..533aa84422 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -295,6 +295,7 @@ sub process_commandline { "clm_usr_name=s" => \$opts{'clm_usr_name'}, "envxml_dir=s" => \$opts{'envxml_dir'}, "drydep!" => \$opts{'drydep'}, + "fan=s" => \$opts{'fan'}, "fire_emis!" => \$opts{'fire_emis'}, "ignore_warnings!" => \$opts{'ignore_warnings'}, "chk_res!" => \$opts{'chk_res'}, From f94ac48e28e74a79b24b5c52d6161f68164a822f Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Tue, 20 Mar 2018 17:43:22 -0400 Subject: [PATCH 005/181] FAN NH3 to coupler --- src/biogeochem/CNNDynamicsMod.F90 | 7 ++++++- src/cpl/clm_cpl_indices.F90 | 12 +++++++++++- src/cpl/lnd_import_export.F90 | 4 ++++ src/main/clm_driver.F90 | 1 + src/main/lnd2atmMod.F90 | 13 ++++++++++++- src/main/lnd2atmType.F90 | 11 ++++++++++- .../SoilBiogeochemNitrogenFluxType.F90 | 11 ++++++++++- 7 files changed, 54 insertions(+), 5 deletions(-) diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index f0dcfbc6ec..8d86e08ba0 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -557,7 +557,7 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & ns%tan_f0_col(c) = tanpools3(1) ns%tan_f1_col(c) = tanpools3(2) ns%tan_f2_col(c) = tanpools3(3) - ! tan_f3_col already updated by update_npool! + ! !!tan_f3_col already updated above by update_npool!! nf%nh3_fert_col(c) = fluxes_tmp(iflx_air) nf%fert_runoff_col(c) = fluxes_tmp(iflx_roff) @@ -565,6 +565,11 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & nf%fert_nh4_to_soil_col(c) & = fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) + fert_to_soil + garbage_total/dt + ! Total flux + ! + nf%nh3_total_col(c) = nf%nh3_fert_col(c) + nf%nh3_man_app_col(c) & + + nf%nh3_grz_col(c) + nf%nh3_stores_col(c) + nf%nh3_barns_col(c) + end do if (do_balance_checks) then diff --git a/src/cpl/clm_cpl_indices.F90 b/src/cpl/clm_cpl_indices.F90 index 525b709cc6..4485dcf975 100644 --- a/src/cpl/clm_cpl_indices.F90 +++ b/src/cpl/clm_cpl_indices.F90 @@ -57,7 +57,8 @@ module clm_cpl_indices integer, public ::index_l2x_Fall_flxvoc ! MEGAN fluxes integer, public ::index_l2x_Fall_flxfire ! Fire fluxes integer, public ::index_l2x_Sl_ztopfire ! Top of fire emissions (m) - + integer, public ::index_l2x_Fall_flxnh3 ! FAN flux + ! In the following, index 0 is bare land, other indices are glc elevation classes integer, allocatable, public ::index_l2x_Sl_tsrf(:) ! glc MEC temperature integer, allocatable, public ::index_l2x_Sl_topo(:) ! glc MEC topo height @@ -139,6 +140,7 @@ subroutine clm_cpl_indices_set( ) use seq_drydep_mod , only: drydep_fields_token, lnd_drydep use shr_megan_mod , only: shr_megan_fields_token, shr_megan_mechcomps_n use shr_fire_emis_mod,only: shr_fire_emis_fields_token, shr_fire_emis_ztop_token, shr_fire_emis_mechcomps_n + use shr_fan_mod, only: shr_fan_fields_token, shr_fan_to_atm use clm_varctl , only: ndep_from_cpl use glc_elevclass_mod, only: glc_get_num_elevation_classes, glc_elevclass_as_string ! @@ -228,6 +230,14 @@ subroutine clm_cpl_indices_set( ) index_l2x_Sl_ztopfire = 0 endif + ! FAN fluxes + if (shr_fan_to_atm) then + index_l2x_Fall_flxnh3 = mct_avect_indexra(l2x,trim(shr_fan_fields_token)) + else + index_l2x_Fall_flxnh3 = 0 + end if + + !------------------------------------------------------------- ! drv -> clm !------------------------------------------------------------- diff --git a/src/cpl/lnd_import_export.F90 b/src/cpl/lnd_import_export.F90 index c255ec479f..83e30c3ee1 100644 --- a/src/cpl/lnd_import_export.F90 +++ b/src/cpl/lnd_import_export.F90 @@ -374,6 +374,10 @@ subroutine lnd_export( bounds, lnd2atm_inst, lnd2glc_inst, l2x) l2x(index_l2x_Fall_methane,i) = -lnd2atm_inst%flux_ch4_grc(g) endif + if (index_l2x_Fall_flxnh3 /= 0) then + l2x(index_l2x_Fall_flxnh3,i) = -lnd2atm_inst%flux_nh3_grc(g) + end if + ! sign convention is positive downward with ! hierarchy of atm/glc/lnd/rof/ice/ocn. ! I.e. water sent from land to rof is positive diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index c18eff3f6e..6a7f067a95 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -1056,6 +1056,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro waterstate_inst, waterflux_inst, irrigation_inst, energyflux_inst, & solarabs_inst, drydepvel_inst, & vocemis_inst, fireemis_inst, dust_inst, ch4_inst, glc_behavior, & + soilbiogeochem_nitrogenflux_inst, & lnd2atm_inst, & net_carbon_exchange_grc = net_carbon_exchange_grc(bounds_proc%begg:bounds_proc%endg)) deallocate(net_carbon_exchange_grc) diff --git a/src/main/lnd2atmMod.F90 b/src/main/lnd2atmMod.F90 index 2a4a00d5cd..bfacc79906 100644 --- a/src/main/lnd2atmMod.F90 +++ b/src/main/lnd2atmMod.F90 @@ -13,7 +13,7 @@ module lnd2atmMod use shr_fire_emis_mod , only : shr_fire_emis_mechcomps_n use clm_varpar , only : numrad, ndst, nlevgrnd !ndst = number of dust bins. use clm_varcon , only : rair, grav, cpair, hfus, tfrz, spval - use clm_varctl , only : iulog, use_lch4 + use clm_varctl , only : iulog, use_lch4, use_fan use seq_drydep_mod , only : n_drydep, drydep_method, DD_XLND use decompMod , only : bounds_type use subgridAveMod , only : p2g, c2g @@ -38,6 +38,7 @@ module lnd2atmMod use LandunitType , only : lun use GridcellType , only : grc use landunit_varcon , only : istice_mec + use SoilBiogeochemNitrogenFluxType, only : SoilBiogeochem_nitrogenflux_type ! ! !PUBLIC TYPES: implicit none @@ -126,6 +127,7 @@ subroutine lnd2atm(bounds, & waterstate_inst, waterflux_inst, irrigation_inst, energyflux_inst, & solarabs_inst, drydepvel_inst, & vocemis_inst, fireemis_inst, dust_inst, ch4_inst, glc_behavior, & + sbgc_nf_inst, & lnd2atm_inst, & net_carbon_exchange_grc) ! @@ -152,6 +154,7 @@ subroutine lnd2atm(bounds, & type(dust_type) , intent(in) :: dust_inst type(ch4_type) , intent(in) :: ch4_inst type(glc_behavior_type) , intent(in) :: glc_behavior + type(SoilBiogeochem_nitrogenflux_type), intent(in) :: sbgc_nf_inst type(lnd2atm_type) , intent(inout) :: lnd2atm_inst real(r8) , intent(in) :: net_carbon_exchange_grc( bounds%begg: ) ! net carbon exchange between land and atmosphere, positive for source (gC/m2/s) ! @@ -314,6 +317,14 @@ subroutine lnd2atm(bounds, & c2l_scale_type= 'unity', l2g_scale_type='unity' ) end if + ! nh3 flux + if (use_fan) then + call c2g(bounds, & + sbgc_nf_inst%nh3_total_col (bounds%begc:bounds%endc), & + lnd2atm_inst%flux_nh3_grc (bounds%begg:bounds%endg), & + c2l_scale_type= 'unity', l2g_scale_type='unity') + end if + !---------------------------------------------------- ! lnd -> rof !---------------------------------------------------- diff --git a/src/main/lnd2atmType.F90 b/src/main/lnd2atmType.F90 index 023608a4a7..08009d8483 100644 --- a/src/main/lnd2atmType.F90 +++ b/src/main/lnd2atmType.F90 @@ -12,7 +12,7 @@ module lnd2atmType use decompMod , only : bounds_type use clm_varpar , only : numrad, ndst, nlevgrnd !ndst = number of dust bins. use clm_varcon , only : spval - use clm_varctl , only : iulog, use_lch4 + use clm_varctl , only : iulog, use_lch4, use_fan use shr_megan_mod , only : shr_megan_mechcomps_n use shr_fire_emis_mod,only : shr_fire_emis_mechcomps_n use seq_drydep_mod, only : n_drydep, drydep_method, DD_XLND @@ -61,6 +61,8 @@ module lnd2atmType real(r8), pointer :: fireflx_grc (:,:) => null() ! Wild Fire Emissions real(r8), pointer :: fireztop_grc (:) => null() ! Wild Fire Emissions vertical distribution top real(r8), pointer :: flux_ch4_grc (:) => null() ! net CH4 flux (kg C/m**2/s) [+ to atm] + real(r8), pointer :: flux_nh3_grc (:) => null() ! gross NH3 emission (gN/m2/s) [+ to atm] + ! lnd->rof real(r8), pointer :: qflx_rofliq_grc (:) => null() ! rof liq forcing real(r8), pointer :: qflx_rofliq_qsur_grc (:) => null() ! rof liq -- surface runoff component @@ -168,6 +170,7 @@ subroutine InitAllocate(this, bounds) allocate(this%fv_grc (begg:endg)) ; this%fv_grc (:) =ival allocate(this%flxdst_grc (begg:endg,1:ndst)) ; this%flxdst_grc (:,:) =ival allocate(this%flux_ch4_grc (begg:endg)) ; this%flux_ch4_grc (:) =ival + allocate(this%flux_nh3_grc (begg:endg)) ; this%flux_nh3_grc (:) =ival allocate(this%qflx_rofliq_grc (begg:endg)) ; this%qflx_rofliq_grc (:) =ival allocate(this%qflx_rofliq_qsur_grc (begg:endg)) ; this%qflx_rofliq_qsur_grc (:) =ival allocate(this%qflx_rofliq_qsub_grc (begg:endg)) ; this%qflx_rofliq_qsub_grc (:) =ival @@ -324,6 +327,12 @@ subroutine InitHistory(this, bounds) ptr_lnd=this%nem_grc) end if + if (use_fan) then + this%flux_nh3_grc(begg:endg) = 0.0_r8 + call hist_addfld1d (fname='NH3_TO_COUPLER', units='gN/m2/s', & + avgflag='A', long_name='Gridcell gross NH3 emission passed to coupler', & + ptr_lnd=this%flux_nh3_grc) + end if end subroutine InitHistory end module lnd2atmType diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 index 40ce64ddf7..a32f23d8b1 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 @@ -108,7 +108,8 @@ module SoilBiogeochemNitrogenFluxType real(r8), pointer :: fert_nh4_to_soil_col (:) ! NH4 flux to soil mineral N pools from fertilizer (gN/m2/s) real(r8), pointer :: manure_runoff_col (:) ! NH4 runoff flux from manure, gN/m2/s real(r8), pointer :: fert_runoff_col (:) ! NH4 runoff flux from fertilizer, gN/m2/s - + + real(r8), pointer :: nh3_total_col (:) ! Total NH3 emission from agriculture ! decomposition fluxes real(r8), pointer :: decomp_cascade_ntransfer_vr_col (:,:,:) ! col vert-res transfer of N from donor to receiver pool along decomp. cascade (gN/m3/s) @@ -318,6 +319,7 @@ subroutine InitAllocate(this, bounds) allocate(this%nh3_grz_col (begc:endc)) ; this%nh3_grz_col (:) = spval allocate(this%nh3_man_app_col (begc:endc)) ; this%nh3_man_app_col (:) = spval allocate(this%nh3_fert_col (begc:endc)) ; this%nh3_fert_col (:) = spval + allocate(this%nh3_total_col (begc:endc)) ; this%nh3_total_col (:) = spval allocate(this%manure_no3_prod_col (begc:endc)) ; this%manure_no3_prod_col (:) = spval allocate(this%fert_no3_prod_col (begc:endc)) ; this%fert_no3_prod_col (:) = spval @@ -635,6 +637,12 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='NH3 emitted from fertilizer applied on crops', & ptr_col=this%nh3_fert_col) + this%nh3_fert_col(begc:endc) = spval + call hist_addfld1d( fname='NH3_total', units='gN/m^2/s', & + avgflag='A', long_name='Total NH3 emitted from fertilizers and manure', & + ptr_col=this%nh3_total_col) + + this%manure_no3_prod_col(begc:endc) = spval call hist_addfld1d( fname='MANURE_NO3_PROD', units='gN/m^2/s', & avgflag='A', long_name='Manure nitrification flux', & @@ -1463,6 +1471,7 @@ subroutine SetValues ( this, & this%nh3_grz_col(i) = value_column this%nh3_man_app_col(i) = value_column this%nh3_fert_col(i) = value_column + this%nh3_total_col(i) = value_column this%manure_no3_prod_col(i) = value_column this%fert_no3_prod_col(i) = value_column this%manure_nh4_to_soil_col(i) = value_column From 63df80b800e6487684a7b7e43328358ebd6b4562 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Tue, 20 Mar 2018 17:57:25 -0400 Subject: [PATCH 006/181] finally correct units for manure nitrogen --- src/biogeochem/CNNDynamicsMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index 8d86e08ba0..e8e00233d6 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -253,7 +253,7 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & if (.not. col%active(c) .or. col%wtgcell(c) < 1e-6) cycle g = col%gridcell(c) if (lun%itype(l) == istsoil) then - ngrz(c) = atm2lnd_inst%forc_ndep3_grc(g) / col%wtgcell(c) * 1e-3 ! kg to g + ngrz(c) = atm2lnd_inst%forc_ndep3_grc(g) / col%wtgcell(c) * 1e3 ! kg to g if (debug_fan) then if (ngrz(c) > 1e12 .or. (isnan(ngrz(c)))) then write(iulog, *) 'bad ngrz', atm2lnd_inst%forc_ndep3_grc(g), col%wtgcell(c) From 6c5185ec573b247443c29b356cf7601c77f2138f Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Tue, 20 Mar 2018 18:56:51 -0400 Subject: [PATCH 007/181] output name NH3_total -> NH3_TOTAL --- src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 index a32f23d8b1..cb07b49030 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 @@ -638,7 +638,7 @@ subroutine InitHistory(this, bounds) ptr_col=this%nh3_fert_col) this%nh3_fert_col(begc:endc) = spval - call hist_addfld1d( fname='NH3_total', units='gN/m^2/s', & + call hist_addfld1d( fname='NH3_TOTAL', units='gN/m^2/s', & avgflag='A', long_name='Total NH3 emitted from fertilizers and manure', & ptr_col=this%nh3_total_col) From 0227fd395e37910ef4640d392748299e0aa25604 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 21 Mar 2018 10:33:48 -0400 Subject: [PATCH 008/181] non-negativity checks tweaked --- src/biogeochem/CNNDynamicsMod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index e8e00233d6..f38cf126fc 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -569,7 +569,9 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & ! nf%nh3_total_col(c) = nf%nh3_fert_col(c) + nf%nh3_man_app_col(c) & + nf%nh3_grz_col(c) + nf%nh3_stores_col(c) + nf%nh3_barns_col(c) - + if (nh%nh3_total_col(c) < -1e15) then + call endrun(msg='ERROR: FAN, negative total emission') + end if end do if (do_balance_checks) then @@ -814,7 +816,7 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & if (n_stored_col(c) > 0_r8) then tan_manure_spread_col(c) = n_manure_spread_col(c) * tan_stored_col(c)/n_stored_col(c) - else if (n_manure_spread_col(c) > 0) then + else if (n_manure_spread_col(c) > 1e-15_r8) then write(iulog, *) 'stored, spread', n_stored_col(c), n_manure_spread_col(c) call endrun(msg='Inconsistent manure application') else From cc8c8642a6d9f37d4a51efd306a485b6d5b5929b Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 21 Mar 2018 11:20:13 -0400 Subject: [PATCH 009/181] manure unit conversion again --- src/biogeochem/CNNDynamicsMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index f38cf126fc..cd0b3b4115 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -704,7 +704,7 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & real(r8) :: cumflux, totalinput real(r8) :: fluxes_nitr(4), fluxes_tan(4) ! The fraction of manure applied continuously on grasslands (if present in the gridcell) - real(r8), parameter :: fract_continuous = 0.1_r8, kg_to_g = 0.001_r8, max_grazing_fract = 0.3_r8, & + real(r8), parameter :: fract_continuous = 0.1_r8, kg_to_g = 1e6_r8, max_grazing_fract = 0.3_r8, & tan_fract_excr = 0.5_r8, volat_coef_barns = 0.02_r8, volat_coef_stores = 0.01_r8, & tempr_min_grazing = 283.0_r8!!!! From f4b7cbbce382474040abcabe1e730cb38484319c Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 21 Mar 2018 15:14:29 -0400 Subject: [PATCH 010/181] nh->nf --- src/biogeochem/CNNDynamicsMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index cd0b3b4115..d58007cddc 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -569,7 +569,7 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & ! nf%nh3_total_col(c) = nf%nh3_fert_col(c) + nf%nh3_man_app_col(c) & + nf%nh3_grz_col(c) + nf%nh3_stores_col(c) + nf%nh3_barns_col(c) - if (nh%nh3_total_col(c) < -1e15) then + if (nf%nh3_total_col(c) < -1e15) then call endrun(msg='ERROR: FAN, negative total emission') end if end do From def5ee8a52b1e520948a424404f6f2af7ef0483c Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 21 Mar 2018 17:17:13 -0400 Subject: [PATCH 011/181] remove uninitilized fert_to_soil + increase bogus n_stored limit according to the correct unit --- src/biogeochem/CNNDynamicsMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index d58007cddc..7bbec64076 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -563,7 +563,7 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & nf%fert_runoff_col(c) = fluxes_tmp(iflx_roff) nf%fert_no3_prod_col(c) = fluxes_tmp(iflx_no3) + fert_no3 nf%fert_nh4_to_soil_col(c) & - = fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) + fert_to_soil + garbage_total/dt + = fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) + garbage_total/dt ! Total flux ! @@ -835,7 +835,7 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & n_stored_col(c) = n_stored_col(c) + (fluxes_nitr(iflx_to_store) - n_manure_spread_col(c)) * dt tan_stored_col(c) = tan_stored_col(c) & + (fluxes_tan(iflx_to_store) - tan_manure_spread_col(c)) * dt - if (n_stored_col(c) > 1e6) then + if (n_stored_col(c) > 1e12) then call endrun(msg='ERROR bad n_stored_col') end if if (n_stored_col(c) < 0) then From f591e8d8cec81710dd1bdede35ca4ae60d74c706 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Thu, 22 Mar 2018 13:49:36 -0400 Subject: [PATCH 012/181] Handle size 1 tan pools correctly --- src/biogeochem/FanMod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/biogeochem/FanMod.F90 b/src/biogeochem/FanMod.F90 index c378fb2d44..1ca065671e 100755 --- a/src/biogeochem/FanMod.F90 +++ b/src/biogeochem/FanMod.F90 @@ -549,7 +549,7 @@ subroutine age_pools_soil(ndep, dt, pools, mtan, garbage) mtan(1) = mtan(1) + ndep * dt ! transfer nitrogen from fresh to old pools mtan = mtan - flux_out * dt - mtan(2:) = mtan(2:) + flux_out(:size(mtan)-1) * dt + if (size(mtan) > 1) mtan(2:) = mtan(2:) + flux_out(:size(mtan)-1) * dt ! provided that the oldest pool has wide enough age range, the amount transferred out ! should be small. garbage = flux_out(size(mtan)) * dt @@ -924,6 +924,7 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend return end if age_prev = age_prev + poolranges(indpl) + fluxes = 0 end do call update_pools(tanpools, fluxes, dt, numpools, 5, fixed) From c65ecf677f5fb0cf2b22c13de77468b02c9db052 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Thu, 22 Mar 2018 19:42:30 -0400 Subject: [PATCH 013/181] debugging: disarray between crop pheno and ndep, lower wtgcell threshold for skipping --- src/biogeochem/CNNDynamicsMod.F90 | 25 +++++++++++++++++-------- 1 file changed, 17 insertions(+), 8 deletions(-) diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index 7bbec64076..70f6f320b5 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -304,7 +304,7 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & c = filter_soilc(fc) l = col%landunit(c) if (.not. (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop)) cycle - if (.not. col%active(c) .or. col%wtgcell(c) < 1e-6) cycle + if (.not. col%active(c) .or. col%wtgcell(c) < 1e-15) cycle if (nf%man_n_appl_col(c) > 1e12 .or. ngrz(c) > 1e12) then write(iulog, *) c, nf%man_n_appl_col(c), ngrz(c), cnv_nf%fert_patch(col%patchi(c):col%patchf(c)), & @@ -346,8 +346,8 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & end if ! Calculation of the water fluxes should include the background soil moisture - ! tendency. However, it's unclear how to do this in a numerically consistent - ! way. Following a naive finite differencing approach led to poorer agreement in + ! tendency. However, it is unclear how to do this in a numerically consistent + ! way. Following a naive finite differencing approach led to worse agreement in ! stand-alone simulations so the term is currenltly neglected here. watertend = 0.0_r8 tg = temperature_inst%t_grnd_col(c) @@ -704,7 +704,7 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & real(r8) :: cumflux, totalinput real(r8) :: fluxes_nitr(4), fluxes_tan(4) ! The fraction of manure applied continuously on grasslands (if present in the gridcell) - real(r8), parameter :: fract_continuous = 0.1_r8, kg_to_g = 1e6_r8, max_grazing_fract = 0.3_r8, & + real(r8), parameter :: fract_continuous = 0.1_r8, kg_to_g = 1e3_r8, max_grazing_fract = 0.3_r8, & tan_fract_excr = 0.5_r8, volat_coef_barns = 0.02_r8, volat_coef_stores = 0.01_r8, & tempr_min_grazing = 283.0_r8!!!! @@ -823,13 +823,22 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & tan_manure_spread_col(c) = 0_r8 end if - if (tan_manure_spread_col(c) > 1) then - write(iulog, *) 'bad tan_manure', tan_manure_spread_col(c), tan_stored_col(c), n_stored_col(c), n_manure_spread_col(c) + if (tan_manure_spread_col(c) > 1e6) then + write(iulog, *) 'bad tan_manure', tan_manure_spread_col(c), tan_stored_col(c), & + n_stored_col(c), n_manure_spread_col(c) end if - if (n_manure_spread_col(c) > 1) then - write(iulog, *) 'bad n_manure', tan_manure_spread_col(c), tan_stored_col(c), n_stored_col(c), n_manure_spread_col(c) + if (n_manure_spread_col(c) > 1e6) then + write(iulog, *) 'bad n_manure', tan_manure_spread_col(c), tan_stored_col(c), & + n_stored_col(c), n_manure_spread_col(c) + end if + + if (n_manure_spread_col(c)*dt > n_stored_col(c)) then + ! Might happen because the crop phenology runs at radiation timestep + ! and might not have yet ended the fertilization. Quick fix: + n_manure_spread_col(c) = 0 + tan_manure_spread_col(c) = 0 end if n_stored_col(c) = n_stored_col(c) + (fluxes_nitr(iflx_to_store) - n_manure_spread_col(c)) * dt From 6b256bac9724dd6eb6851e04021c88a5020509b7 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Mon, 26 Mar 2018 15:53:03 -0400 Subject: [PATCH 014/181] fix zeroing the fluxes --- src/biogeochem/FanMod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/biogeochem/FanMod.F90 b/src/biogeochem/FanMod.F90 index 1ca065671e..b3ed8919d4 100755 --- a/src/biogeochem/FanMod.F90 +++ b/src/biogeochem/FanMod.F90 @@ -924,7 +924,6 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend return end if age_prev = age_prev + poolranges(indpl) - fluxes = 0 end do call update_pools(tanpools, fluxes, dt, numpools, 5, fixed) From e20a808375104de7c0cf25f4fe7a4cade8273fcf Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 4 Apr 2018 12:29:36 -0400 Subject: [PATCH 015/181] other-fert output --- src/biogeochem/CNNDynamicsMod.F90 | 5 ++- .../SoilBiogeochemNitrogenFluxType.F90 | 36 +++++++++---------- 2 files changed, 22 insertions(+), 19 deletions(-) diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index 70f6f320b5..c9ab80755b 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -497,7 +497,8 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & fert_urea = fert_total * fract_urea fert_no3 = fert_total * fract_no3 fert_generic = fert_total - fert_urea - fert_no3 - + nf%otherfert_n_appl_col(c) = fert_no3 + fert_generic + ! Urea decomposition ! ureapools(1) = ns%fert_u0_col(c) @@ -526,6 +527,7 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & tanpools3(3) = ns%tan_f2_col(c) garbage_total = 0.0 fluxes3 = 0.0 + nf%nh3_otherfert_col(c) = 0.0 do ind_substep = 1, num_substeps ! Fertilizer pools f0...f2 call update_npool(tg, ratm, theta, thetasat, infiltr_m_s, evap_m_s, & @@ -552,6 +554,7 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & end if fluxes_tmp = fluxes_tmp + fluxes3(:, 1) / num_substeps garbage_total = garbage_total + garbage + nf%nh3_otherfert_col(c) = nf%nh3_otherfert_col(c) + fluxes3(iflx_air, 1) / num_substeps end do ns%tan_f0_col(c) = tanpools3(1) diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 index cb07b49030..1fb897eb97 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 @@ -71,22 +71,6 @@ module SoilBiogeochemNitrogenFluxType !KO !JV FAN fluxes -!!$ man_tan_appl_col -!!$ man_n_appl_col -!!$ man_n_grz_col -!!$ fert_n_appl_col -!!$ nh3_barns_col -!!$ nh3_stores_col -!!$ nh3_grz_col -!!$ nh3_man_app_col -!!$ nh3_fert_col -!!$ -!!$ manure_no3_prod_col -!!$ fert_no3_prod_col -!!$ manure_nh4_to_soil_col -!!$ fert_nh4_to_soil_col -!!$ manure_runoff_col -!!$ fert_runoff_col real(r8), pointer :: man_tan_appl_col (:) ! Manure TAN applied on soil (gN/m2/s) @@ -94,6 +78,7 @@ module SoilBiogeochemNitrogenFluxType real(r8), pointer :: man_n_grz_col (:) ! Manure N from grazing animals (gN/m2/s) real(r8), pointer :: man_n_mix_col (:) ! Manure N from produced in mixed systems (gN/m2/s) real(r8), pointer :: fert_n_appl_col (:) ! Fertilizer N applied on soil (gN/m2/s) + real(r8), pointer :: otherfert_n_appl_col (:) ! Non-urea fertilizer N applied on soil (gN/m2/s) real(r8), pointer :: man_n_transf_col (:) ! Manure N removed from the crop column (into the natural veg. column in the gcell) real(r8), pointer :: nh3_barns_col (:) ! NH3 emission from animal housings (gN/m2/s @@ -101,7 +86,7 @@ module SoilBiogeochemNitrogenFluxType real(r8), pointer :: nh3_grz_col (:) ! NH3 emission from manure on pastures, (gN/m2/s real(r8), pointer :: nh3_man_app_col (:) ! NH3 emission from manure applied on crops and grasslands, (gN/m2/s real(r8), pointer :: nh3_fert_col (:) ! NH3 emission from fertilizers applied on crops and grasslands, (gN/m2/s - + real(r8), pointer :: nh3_otherfert_col (:) ! NH3 emission from non-urea fertilizers applied on crops and grasslands, (gN/m2/s real(r8), pointer :: manure_no3_prod_col (:) ! Nitrification flux from manure (gN/m2/s) real(r8), pointer :: fert_no3_prod_col (:) ! Nitrification flux from fertilizer (gN/m2/s) real(r8), pointer :: manure_nh4_to_soil_col (:) ! NH4 flux to soil mineral N pools from manure (gN/m2/s) @@ -312,6 +297,7 @@ subroutine InitAllocate(this, bounds) allocate(this%man_n_grz_col (begc:endc)) ; this%man_n_grz_col (:) = spval allocate(this%man_n_mix_col (begc:endc)) ; this%man_n_mix_col (:) = spval allocate(this%fert_n_appl_col (begc:endc)) ; this%fert_n_appl_col (:) = spval + allocate(this%otherfert_n_appl_col (begc:endc)) ; this%otherfert_n_appl_col (:) = spval allocate(this%man_n_transf_col (begc:endc)) ; this%man_n_transf_col (:) = spval allocate(this%nh3_barns_col (begc:endc)) ; this%nh3_barns_col (:) = spval @@ -319,6 +305,7 @@ subroutine InitAllocate(this, bounds) allocate(this%nh3_grz_col (begc:endc)) ; this%nh3_grz_col (:) = spval allocate(this%nh3_man_app_col (begc:endc)) ; this%nh3_man_app_col (:) = spval allocate(this%nh3_fert_col (begc:endc)) ; this%nh3_fert_col (:) = spval + allocate(this%nh3_otherfert_col (begc:endc)) ; this%nh3_otherfert_col (:) = spval allocate(this%nh3_total_col (begc:endc)) ; this%nh3_total_col (:) = spval allocate(this%manure_no3_prod_col (begc:endc)) ; this%manure_no3_prod_col (:) = spval @@ -607,6 +594,11 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='Fertilizer N applied on soil', & ptr_col=this%fert_n_appl_col) + this%otherfert_n_appl_col(begc:endc) = spval + call hist_addfld1d( fname='OTHERFERT_N_APP', units='gN/m^2/s', & + avgflag='A', long_name='Non-urea fertilizer N applied on soil', & + ptr_col=this%otherfert_n_appl_col) + this%man_n_transf_col(begc:endc) = spval call hist_addfld1d( fname='MAN_N_TRANSF', units='gN/m^2/s', & avgflag='A', long_name='Manure N moved from crop to natural column', & @@ -637,7 +629,13 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='NH3 emitted from fertilizer applied on crops', & ptr_col=this%nh3_fert_col) - this%nh3_fert_col(begc:endc) = spval + this%nh3_otherfert_col(begc:endc) = spval + call hist_addfld1d( fname='NH3_OTHERFERT', units='gN/m^2/s', & + avgflag='A', long_name='NH3 emitted from fertilizers other than urea', & + ptr_col=this%nh3_otherfert_col) + + + this%nh3_total_col(begc:endc) = spval call hist_addfld1d( fname='NH3_TOTAL', units='gN/m^2/s', & avgflag='A', long_name='Total NH3 emitted from fertilizers and manure', & ptr_col=this%nh3_total_col) @@ -1465,12 +1463,14 @@ subroutine SetValues ( this, & this%man_n_grz_col(i) = value_column this%man_n_mix_col(i) = value_column this%fert_n_appl_col(i) = value_column + this%otherfert_n_appl_col(i) = value_column this%man_n_transf_col(i) = value_column this%nh3_barns_col(i) = value_column this%nh3_stores_col(i) = value_column this%nh3_grz_col(i) = value_column this%nh3_man_app_col(i) = value_column this%nh3_fert_col(i) = value_column + this%nh3_otherfert_col(i) = value_column this%nh3_total_col(i) = value_column this%manure_no3_prod_col(i) = value_column this%fert_no3_prod_col(i) = value_column From 138e09a9a261f55e1893019f0632c6a5f2a24994 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 4 Apr 2018 12:31:11 -0400 Subject: [PATCH 016/181] change to fancpl2 cime --- Externals.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals.cfg b/Externals.cfg index 34ff8c4b70..5e5fdb2e6e 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -30,7 +30,7 @@ required = True local_path = cime protocol = git repo_url = https://github.com/juliusvira/cime -branch = fancpl +branch = fancpl2 required = True [externals_description] From b71f54b9ec6a18e277e4623777eb85bc223b690f Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 4 Apr 2018 14:40:45 -0400 Subject: [PATCH 017/181] fanstream attempt 1 --- src/main/clm_driver.F90 | 12 +- src/main/clm_initializeMod.F90 | 19 ++- src/main/fanStreamMod.F90 | 298 +++++++++++++++++++++++++++++++++ 3 files changed, 315 insertions(+), 14 deletions(-) create mode 100644 src/main/fanStreamMod.F90 diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index 6a7f067a95..4567cae8b1 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -58,9 +58,11 @@ module clm_driver use SatellitePhenologyMod , only : SatellitePhenology, interpMonthlyVeg use ndepStreamMod , only : ndep_interp !KO - use ndep2StreamMod , only : ndep2_interp - use ndep3StreamMod , only : ndep3_interp -!KO + !use ndep2StreamMod , only : ndep2_interp + !use ndep3StreamMod , only : ndep3_interp + + !KO + use FanStreamMod , only : fanstream_interp use ActiveLayerMod , only : alt_calc use ch4Mod , only : ch4, ch4_init_balance_check use DUSTMod , only : DustDryDep, DustEmission @@ -386,8 +388,8 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro end if !KO if (use_cn .and. use_fan) then - call ndep2_interp(bounds_proc, atm2lnd_inst) - call ndep3_interp(bounds_proc, atm2lnd_inst) + call fanstream_interp(bounds_proc, atm2lnd_inst) + !call ndep3_interp(bounds_proc, atm2lnd_inst) end if !KO diff --git a/src/main/clm_initializeMod.F90 b/src/main/clm_initializeMod.F90 index cd6882faff..744add094b 100644 --- a/src/main/clm_initializeMod.F90 +++ b/src/main/clm_initializeMod.F90 @@ -286,9 +286,10 @@ subroutine initialize2( ) use restFileMod , only : restFile_read, restFile_write use ndepStreamMod , only : ndep_init, ndep_interp !KO - use ndep2StreamMod , only : ndep2_init, ndep2_interp - use ndep3StreamMod , only : ndep3_init, ndep3_interp -!KO + !use ndep2StreamMod , only : ndep2_init, ndep2_interp + !use ndep3StreamMod , only : ndep3_init, ndep3_interp + !KO + use FanStreamMod , only : fanstream_init, fanstream_interp use LakeCon , only : LakeConInit use SatellitePhenologyMod , only : SatellitePhenologyInit, readAnnualVegetation, interpMonthlyVeg use SnowSnicarMod , only : SnowAge_init, SnowOptics_init @@ -581,14 +582,14 @@ subroutine initialize2( ) !KO if ( use_fan ) then call t_startf('init_ndep2') - call ndep2_init(bounds_proc, NLFilename) - call ndep2_interp(bounds_proc, atm2lnd_inst) + call fanstream_init(bounds_proc, NLFilename) + call fanstream_interp(bounds_proc, atm2lnd_inst) call t_stopf('init_ndep2') - call t_startf('init_ndep3') - call ndep3_init(bounds_proc, NLFilename) - call ndep3_interp(bounds_proc, atm2lnd_inst) - call t_stopf('init_ndep3') +!!$ call t_startf('init_ndep3') +!!$ call ndep3_init(bounds_proc, NLFilename) +!!$ call ndep3_interp(bounds_proc, atm2lnd_inst) +!!$ call t_stopf('init_ndep3') end if !KO end if diff --git a/src/main/fanStreamMod.F90 b/src/main/fanStreamMod.F90 new file mode 100644 index 0000000000..ab33421f59 --- /dev/null +++ b/src/main/fanStreamMod.F90 @@ -0,0 +1,298 @@ +module FanStreamMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Contains methods for reading in FAN nitrogen deposition (in the form of + ! manure) data file + ! Also includes functions for dynamic ndep2 file handling and + ! interpolation. + ! + ! !USES + use shr_kind_mod, only: r8 => shr_kind_r8, CL => shr_kind_cl + use shr_strdata_mod + use shr_stream_mod + use shr_string_mod + use shr_sys_mod + use shr_mct_mod + use mct_mod + use spmdMod , only: mpicom, masterproc, comp_id, iam + use clm_varctl , only: iulog + use abortutils , only: endrun + use fileutils , only: getavu, relavu + use decompMod , only: bounds_type, ldecomp, gsmap_lnd_gdc2glo + use domainMod , only: ldomain +!KO + use ndepStreamMod, only: clm_domain_mct +!KO + + ! !PUBLIC TYPES: + implicit none + private + save + + ! !PUBLIC MEMBER FUNCTIONS: + public :: fanstream_init ! position datasets for dynamic ndep2 + public :: fanstream_interp ! interpolates between two years of ndep2 file data +!KO public :: clm_domain_mct ! Sets up MCT domain for this resolution + + ! ! PRIVATE TYPES + type(shr_strdata_type) :: sdat_past, sdat_mix, sdat_urea, sdat_nitr ! input data streams + integer :: stream_year_first_ndep2 ! first year in stream to use + integer :: stream_year_last_ndep2 ! last year in stream to use + integer :: model_year_align_ndep2 ! align stream_year_firstndep2 with + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + !============================================================================== + +contains + + !============================================================================== + + subroutine fanstream_init(bounds, NLFilename) + ! + ! Initialize data stream information. + ! + ! Uses: + use clm_varctl , only : inst_name + use clm_time_manager , only : get_calendar + use ncdio_pio , only : pio_subsystem + use shr_pio_mod , only : shr_pio_getiotype + use shr_nl_mod , only : shr_nl_find_group_name + use shr_log_mod , only : errMsg => shr_log_errMsg + ! + ! arguments + implicit none + type(bounds_type), intent(in) :: bounds + character(len=*), intent(in) :: NLFilename ! Namelist filename + ! + ! local variables + integer :: nu_nml ! unit for namelist file + integer :: nml_error ! namelist i/o error flag + type(mct_ggrid) :: dom_clm ! domain information + character(len=CL) :: stream_fldFileName_ndep2 + character(len=CL) :: ndep2mapalgo = 'bilinear' + character(*), parameter :: shr_strdata_unset = 'NOT_SET' + character(*), parameter :: subName = "('ndep2dyn_init')" + character(*), parameter :: F00 = "('(ndep2dyn_init) ',4a)" + !----------------------------------------------------------------------- + + namelist /ndep2dyn_nml/ & + stream_year_first_ndep2, & + stream_year_last_ndep2, & + model_year_align_ndep2, & + ndep2mapalgo, & + stream_fldFileName_ndep2 + + ! Default values for namelist + stream_year_first_ndep2 = 1 ! first year in stream to use + stream_year_last_ndep2 = 1 ! last year in stream to use + model_year_align_ndep2 = 1 ! align stream_year_first_ndep2 with this model year + stream_fldFileName_ndep2 = ' ' + + ! Read ndep2dyn_nml namelist + if (masterproc) then + nu_nml = getavu() + open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error ) + call shr_nl_find_group_name(nu_nml, 'ndep2dyn_nml', status=nml_error) + if (nml_error == 0) then + read(nu_nml, nml=ndep2dyn_nml,iostat=nml_error) + if (nml_error /= 0) then + call endrun(msg=' ERROR reading ndep2dyn_nml namelist'//errMsg(sourcefile, __LINE__)) + end if + else + call endrun(msg=' ERROR finding ndep2dyn_nml namelist'//errMsg(sourcefile, __LINE__)) + end if + close(nu_nml) + call relavu( nu_nml ) + endif + + call shr_mpi_bcast(stream_year_first_ndep2, mpicom) + call shr_mpi_bcast(stream_year_last_ndep2, mpicom) + call shr_mpi_bcast(model_year_align_ndep2, mpicom) + call shr_mpi_bcast(stream_fldFileName_ndep2, mpicom) + + if (masterproc) then + write(iulog,*) ' ' + write(iulog,*) 'ndep2dyn stream settings:' + write(iulog,*) ' stream_year_first_ndep2 = ',stream_year_first_ndep2 + write(iulog,*) ' stream_year_last_ndep2 = ',stream_year_last_ndep2 + write(iulog,*) ' model_year_align_ndep2 = ',model_year_align_ndep2 + write(iulog,*) ' stream_fldFileName_ndep2 = ',stream_fldFileName_ndep2 + write(iulog,*) ' ' + endif + + call clm_domain_mct (bounds, dom_clm) + + call shr_strdata_create(sdat_past,name="clmndep2past", & + pio_subsystem=pio_subsystem, & + pio_iotype=shr_pio_getiotype(inst_name), & + mpicom=mpicom, compid=comp_id, & + gsmap=gsmap_lnd_gdc2glo, ggrid=dom_clm, & + nxg=ldomain%ni, nyg=ldomain%nj, & + yearFirst=stream_year_first_ndep2, & + yearLast=stream_year_last_ndep2, & + yearAlign=model_year_align_ndep2, & + offset=0, & + domFilePath='', & + domFileName=trim(stream_fldFileName_ndep2), & + domTvarName='time', & + domXvarName='x' , & + domYvarName='y' , & + domAreaName='area', & + domMaskName='mask', & + filePath='', & + filename=(/trim(stream_fldFileName_ndep2)/),& + fldListFile='Nmanure_pastures', & + fldListModel='Nmanure_pastures', & + fillalgo='none', & + mapalgo=ndep2mapalgo, & + calendar=get_calendar(), & + taxmode='extend' ) + + if (masterproc) then + call shr_strdata_print(sdat_past,'CLMNDEP2 data') + endif + + call shr_strdata_create(sdat_mix,name="clmndep2mixed", & + pio_subsystem=pio_subsystem, & + pio_iotype=shr_pio_getiotype(inst_name), & + mpicom=mpicom, compid=comp_id, & + gsmap=gsmap_lnd_gdc2glo, ggrid=dom_clm, & + nxg=ldomain%ni, nyg=ldomain%nj, & + yearFirst=stream_year_first_ndep2, & + yearLast=stream_year_last_ndep2, & + yearAlign=model_year_align_ndep2, & + offset=0, & + domFilePath='', & + domFileName=trim(stream_fldFileName_ndep2), & + domTvarName='time', & + domXvarName='x' , & + domYvarName='y' , & + domAreaName='area', & + domMaskName='mask', & + filePath='', & + filename=(/trim(stream_fldFileName_ndep2)/),& + fldListFile='Nmanure_mixed', & + fldListModel='Nmanure_mixed', & + fillalgo='none', & + mapalgo=ndep2mapalgo, & + calendar=get_calendar(), & + taxmode='extend' ) + + if (masterproc) then + call shr_strdata_print(sdat_mix,'CLMNDEP2 data') + endif + + call shr_strdata_create(sdat_urea,name="clmndep2urea", & + pio_subsystem=pio_subsystem, & + pio_iotype=shr_pio_getiotype(inst_name), & + mpicom=mpicom, compid=comp_id, & + gsmap=gsmap_lnd_gdc2glo, ggrid=dom_clm, & + nxg=ldomain%ni, nyg=ldomain%nj, & + yearFirst=stream_year_first_ndep2, & + yearLast=stream_year_last_ndep2, & + yearAlign=model_year_align_ndep2, & + offset=0, & + domFilePath='', & + domFileName=trim(stream_fldFileName_ndep2), & + domTvarName='time', & + domXvarName='x' , & + domYvarName='y' , & + domAreaName='area', & + domMaskName='mask', & + filePath='', & + filename=(/trim(stream_fldFileName_ndep2)/),& + fldListFile='fract_urea', & + fldListModel='fract_urea', & + fillalgo='none', & + mapalgo='nn', & + calendar=get_calendar(), & + taxmode='extend' ) + + if (masterproc) then + call shr_strdata_print(sdat_urea,'CLMNDEP2 data') + endif + + call shr_strdata_create(sdat_nitr,name="clmndep2nitr", & + pio_subsystem=pio_subsystem, & + pio_iotype=shr_pio_getiotype(inst_name), & + mpicom=mpicom, compid=comp_id, & + gsmap=gsmap_lnd_gdc2glo, ggrid=dom_clm, & + nxg=ldomain%ni, nyg=ldomain%nj, & + yearFirst=stream_year_first_ndep2, & + yearLast=stream_year_last_ndep2, & + yearAlign=model_year_align_ndep2, & + offset=0, & + domFilePath='', & + domFileName=trim(stream_fldFileName_ndep2), & + domTvarName='time', & + domXvarName='x' , & + domYvarName='y' , & + domAreaName='area', & + domMaskName='mask', & + filePath='', & + filename=(/trim(stream_fldFileName_ndep2)/),& + fldListFile='fract_nitr', & + fldListModel='fract_nitr', & + fillalgo='none', & + mapalgo='nn', & + calendar=get_calendar(), & + taxmode='extend' ) + + if (masterproc) then + call shr_strdata_print(sdat_mix,'CLMNDEP2 data') + endif + + + end subroutine fanstream_init + + !================================================================ + subroutine fanstream_interp(bounds, atm2lnd_inst) + + !----------------------------------------------------------------------- + use clm_time_manager, only : get_curr_date, get_days_per_year + use clm_varcon , only : secspday + use atm2lndType , only : atm2lnd_type + ! + ! Arguments + type(bounds_type) , intent(in) :: bounds + type(atm2lnd_type), intent(inout) :: atm2lnd_inst + ! + ! Local variables + integer :: g, ig + integer :: year ! year (0, ...) for nstep+1 + integer :: mon ! month (1, ..., 12) for nstep+1 + integer :: day ! day of month (1, ..., 31) for nstep+1 + integer :: sec ! seconds into current date for nstep+1 + integer :: mcdate ! Current model date (yyyymmdd) + integer :: dayspyr ! days per year + !----------------------------------------------------------------------- + + call get_curr_date(year, mon, day, sec) + mcdate = year*10000 + mon*100 + day + + call shr_strdata_advance(sdat_past, mcdate, sec, mpicom, 'clmndep2pasture') + + ig = 0 + dayspyr = get_days_per_year( ) + do g = bounds%begg,bounds%endg + ig = ig+1 + atm2lnd_inst%forc_ndep2_grc(g) = sdat_past%avs(1)%rAttr(1,ig) / (secspday * dayspyr) + end do + + call shr_strdata_advance(sdat_mix, mcdate, sec, mpicom, 'clmndep2mixed') + + ig = 0 + dayspyr = get_days_per_year( ) + do g = bounds%begg,bounds%endg + ig = ig+1 + atm2lnd_inst%forc_ndep3_grc(g) = sdat_mix%avs(1)%rAttr(1,ig) / (secspday * dayspyr) + end do + + write(iulog, *) 'NCDPINTERP', sdat_past%avs(1)%rAttr(1,ig), sdat_mix%avs(1)%rAttr(1,ig) + + end subroutine fanstream_interp + +end module FanStreamMod + From 59478df368b6543505d0320f2e4f3db6e791f13f Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 4 Apr 2018 16:34:00 -0400 Subject: [PATCH 018/181] variable fert fractions (2) --- src/biogeochem/CNNDynamicsMod.F90 | 13 ++++++++++--- src/main/atm2lndType.F90 | 16 ++++++++++++---- src/main/fanStreamMod.F90 | 23 ++++++++++++++++++----- 3 files changed, 40 insertions(+), 12 deletions(-) diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index c9ab80755b..f548c5eb26 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -192,7 +192,8 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & nstored_old, nsoilman_old, nsoilfert_old, fert_to_air, fert_to_soil, fert_total, fert_urea, fert_tan, & soilflux_org, urea_resid real(r8) :: tanprod_from_urea(3), ureapools(2), fert_no3, fert_generic - real(r8), parameter :: fract_urea=0.545, fract_no3=0.048 + !real(r8), parameter :: fract_urea=0.545, fract_no3=0.048 + real(r8) :: fract_urea, fract_no3 integer, parameter :: ind_region = 1 dt = real( get_step_size(), r8 ) @@ -303,6 +304,7 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & do fc = 1, num_soilc c = filter_soilc(fc) l = col%landunit(c) + g = col%gridcell(c) if (.not. (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop)) cycle if (.not. col%active(c) .or. col%wtgcell(c) < 1e-15) cycle @@ -493,7 +495,13 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & ! fert_total = nf%fert_n_appl_col(c) + fract_urea = atm2lnd_inst%forc_ndep_urea_grc(g) + fract_no3 = atm2lnd_inst%forc_ndep_nitr_grc(g) + if (fract_urea < 0 .or. fract_no3 < 0 .or. fract_urea + fract_no3 > 1) then + call endrun('bad fertilizer fractions') + end if + fert_urea = fert_total * fract_urea fert_no3 = fert_total * fract_no3 fert_generic = fert_total - fert_urea - fert_no3 @@ -565,8 +573,7 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & nf%nh3_fert_col(c) = fluxes_tmp(iflx_air) nf%fert_runoff_col(c) = fluxes_tmp(iflx_roff) nf%fert_no3_prod_col(c) = fluxes_tmp(iflx_no3) + fert_no3 - nf%fert_nh4_to_soil_col(c) & - = fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) + garbage_total/dt + nf%fert_nh4_to_soil_col(c) = fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) + garbage_total/dt ! Total flux ! diff --git a/src/main/atm2lndType.F90 b/src/main/atm2lndType.F90 index 91cc94bbdf..8d7db9baa4 100644 --- a/src/main/atm2lndType.F90 +++ b/src/main/atm2lndType.F90 @@ -92,6 +92,8 @@ module atm2lndType !KO real(r8), pointer :: forc_ndep2_grc (:) => null() ! FAN nitrogen deposition (manure) rate (gN/m2/s) real(r8), pointer :: forc_ndep3_grc (:) => null() ! FAN nitrogen deposition (fertilizer) rate (gN/m2/s) + real(r8), pointer :: forc_ndep_urea_grc (:) => null() ! FAN nitrogen deposition, urea fertilizer fraction + real(r8), pointer :: forc_ndep_nitr_grc (:) => null() ! FAN nitrogen deposition, nitrate fertilizer fraction !KO real(r8), pointer :: forc_pc13o2_grc (:) => null() ! C13O2 partial pressure (Pa) real(r8), pointer :: forc_po2_grc (:) => null() ! O2 partial pressure (Pa) @@ -520,6 +522,8 @@ subroutine InitAllocate(this, bounds) if ( use_fan ) then allocate(this%forc_ndep2_grc (begg:endg)) ; this%forc_ndep2_grc (:) = ival allocate(this%forc_ndep3_grc (begg:endg)) ; this%forc_ndep3_grc (:) = ival + allocate(this%forc_ndep_urea_grc (begg:endg)) ; this%forc_ndep3_grc (:) = ival + allocate(this%forc_ndep_nitr_grc (begg:endg)) ; this%forc_ndep3_grc (:) = ival end if !KO allocate(this%forc_pc13o2_grc (begg:endg)) ; this%forc_pc13o2_grc (:) = ival @@ -1255,10 +1259,14 @@ subroutine Clean(this) deallocate(this%forc_solai_grc) deallocate(this%forc_solar_grc) deallocate(this%forc_ndep_grc) -!KO - deallocate(this%forc_ndep2_grc) - deallocate(this%forc_ndep3_grc) -!KO + !KO + if (use_fan) then + deallocate(this%forc_ndep2_grc) + deallocate(this%forc_ndep3_grc) + deallocate(this%forc_ndep_nitr_grc) + deallocate(this%forc_ndep_urea_grc) + !KO + end if deallocate(this%forc_pc13o2_grc) deallocate(this%forc_po2_grc) deallocate(this%forc_aer_grc) diff --git a/src/main/fanStreamMod.F90 b/src/main/fanStreamMod.F90 index ab33421f59..97c3214b39 100644 --- a/src/main/fanStreamMod.F90 +++ b/src/main/fanStreamMod.F90 @@ -271,26 +271,39 @@ subroutine fanstream_interp(bounds, atm2lnd_inst) call get_curr_date(year, mon, day, sec) mcdate = year*10000 + mon*100 + day + dayspyr = get_days_per_year( ) call shr_strdata_advance(sdat_past, mcdate, sec, mpicom, 'clmndep2pasture') ig = 0 - dayspyr = get_days_per_year( ) do g = bounds%begg,bounds%endg ig = ig+1 - atm2lnd_inst%forc_ndep2_grc(g) = sdat_past%avs(1)%rAttr(1,ig) / (secspday * dayspyr) + atm2lnd_inst%forc_ndep3_grc(g) = sdat_past%avs(1)%rAttr(1,ig) / (secspday * dayspyr) end do call shr_strdata_advance(sdat_mix, mcdate, sec, mpicom, 'clmndep2mixed') ig = 0 - dayspyr = get_days_per_year( ) do g = bounds%begg,bounds%endg ig = ig+1 - atm2lnd_inst%forc_ndep3_grc(g) = sdat_mix%avs(1)%rAttr(1,ig) / (secspday * dayspyr) + atm2lnd_inst%forc_ndep2_grc(g) = sdat_mix%avs(1)%rAttr(1,ig) / (secspday * dayspyr) + end do + + call shr_strdata_advance(sdat_urea, mcdate, sec, mpicom, 'clmndep2urea') + + ig = 0 + do g = bounds%begg,bounds%endg + ig = ig+1 + atm2lnd_inst%forc_ndep_urea_grc(g) = sdat_urea%avs(1)%rAttr(1,ig) end do - write(iulog, *) 'NCDPINTERP', sdat_past%avs(1)%rAttr(1,ig), sdat_mix%avs(1)%rAttr(1,ig) + call shr_strdata_advance(sdat_nitr, mcdate, sec, mpicom, 'clmndep2nitr') + + ig = 0 + do g = bounds%begg,bounds%endg + ig = ig+1 + atm2lnd_inst%forc_ndep_nitr_grc(g) = sdat_nitr%avs(1)%rAttr(1,ig) + end do end subroutine fanstream_interp From 44333c939ec60a9d9a8d2a740db35755f973fc08 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Mon, 9 Jul 2018 14:21:01 -0400 Subject: [PATCH 019/181] mods from the summer 2018 experiments (1) --- src/biogeochem/CNNDynamicsMod.F90 | 302 +++++++++++++++--- src/biogeochem/FanMod.F90 | 241 +++++++++++++- src/main/atm2lndType.F90 | 7 +- src/main/fanStreamMod.F90 | 37 ++- .../SoilBiogeochemNitrogenStateType.F90 | 40 ++- 5 files changed, 579 insertions(+), 48 deletions(-) diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index f548c5eb26..ddb2c7cb75 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -174,18 +174,22 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & integer, parameter :: num_substeps = 4, balance_check_freq = 1000 integer :: c, g, patchcounter, p, status, c1, c2, l, fc, ind_substep real(r8) :: dt, ndep_org(3), orgpools(3), tanprod(3), watertend, fluxes(6,3), tanpools3(3), ratm, tandep, & - fluxes2(6,2), fluxes3(6,3), tanpools2(2), fluxes_tmp(6), garbage_total + fluxes2(6,2), fluxes3(6,3), fluxes4(6,4), tanpools2(2), tanpools4(4), fluxes_tmp(6), garbage_total real(r8), parameter :: water_init_grz = 0.005_r8, cnc_nh3_air = 0.0_r8, depth_slurry = 0.005_r8 - real(r8), parameter :: fract_resist=0.225_r8, fract_unavail=0.025_r8, fract_avail=0.25_r8, fract_tan=0.5_r8 + real(r8), parameter :: fract_resist=0.225_r8, fract_unavail=0.025_r8, fract_avail=0.25_r8, fract_tan=0.6_r8 real(r8), parameter :: dz_layer_fert = 0.02_r8, dz_layer_grz = 0.02_r8 !real(r8), parameter :: fract_resist=0._r8, fract_unavail=0._r8, fract_avail=0._r8, fract_tan=1.0_r8 - real(r8), parameter :: slurry_infiltr_time = 6*3600.0_r8, water_init_fert = 1e-6 - real(r8), parameter :: poolranges_grz(2) = (/24*3600.0_r8, 360*24*3600.0_r8/), & + real(r8), parameter :: slurry_infiltr_time = 12*3600.0_r8, water_init_fert = 1e-6 + real(r8), parameter :: & + poolranges_grz(3) = (/24*3600.0_r8, 10*24*3600.0_r8, 360*24*3600.0_r8/), & poolranges_fert(3) = (/2*24*3600.0_r8, 24*3600.0_r8, 360*24*3600.0_r8/), & - poolranges_slr(3) = (/slurry_infiltr_time, 24*3600.0_r8, 360*24*3600.0_r8/), & - Hconc_grz(2) = (/10**(-8.5_r8), 10**(-8.0_r8)/), & - Hconc_fert(3) = (/10**-7.0_r8, 10**(-8.0_r8), 10**(-8.0_r8)/) + poolranges_slr(4) = (/slurry_infiltr_time, 24*3600.0_r8, 10*24*3600.0_r8, 360*24*3600.0_r8/), & + !Hconc_grz(3) = (/10**(-8.5_r8), 10**(-8.0_r8), 10**(-7.0_r8)/), & + Hconc_fert(3) = (/10**(-7.0_r8), 10**(-8.5_r8), 10**(-8.0_r8)/) + + real(r8) :: Hconc_grz(3), Hconc_slr(4), pH_soil, pH_crop + !logical, parameter :: do_balance_checks = .false. logical :: do_balance_checks real(r8) :: tg, garbage, theta, thetasat, infiltr_m_s, evap_m_s, runoff_m_s, org_n_tot, & @@ -193,9 +197,15 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & soilflux_org, urea_resid real(r8) :: tanprod_from_urea(3), ureapools(2), fert_no3, fert_generic !real(r8), parameter :: fract_urea=0.545, fract_no3=0.048 - real(r8) :: fract_urea, fract_no3 + real(r8) :: fract_urea, fract_no3, soilph_min, soilph_max integer, parameter :: ind_region = 1 + integer :: def_ph_count + Hconc_grz(1:2) = (/10**(-8.5_r8), 10**(-8.0_r8)/) + Hconc_slr(1:3) = (/10.0_r8**(-8.0_r8), 10.0_r8**(-8.0_r8), 10.0_r8**(-8.0_r8)/) + soilph_min = 999 + soilph_max = -999 + def_ph_count = 0 dt = real( get_step_size(), r8 ) do_balance_checks = mod(get_nstep(), balance_check_freq) == 0 associate( & @@ -278,13 +288,23 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & end if end if - call handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & +!!$ call handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & +!!$ atm2lnd_inst%forc_ndep2_grc, & +!!$ ns%man_n_stored_col, ns%man_tan_stored_col, & +!!$ nf%man_n_appl_col, nf%man_tan_appl_col, & +!!$ nf%man_n_grz_col, nf%man_n_mix_col, & +!!$ nf%nh3_stores_col, nf%nh3_barns_col, & +!!$ nf%man_n_transf_col, filter_soilc, num_soilc) + + call handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & atm2lnd_inst%forc_ndep2_grc, & ns%man_n_stored_col, ns%man_tan_stored_col, & nf%man_n_appl_col, nf%man_tan_appl_col, & nf%man_n_grz_col, nf%man_n_mix_col, & nf%nh3_stores_col, nf%nh3_barns_col, & - nf%man_n_transf_col, filter_soilc, num_soilc) + nf%man_n_transf_col, ns%fan_grz_fract_col, & + fract_tan, & + filter_soilc, num_soilc) if (debug_fan) then if (any(isnan(nf%nh3_stores_col))) then @@ -345,6 +365,7 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & ratm = 150.0_r8 end if end if + ns%fan_grz_fract_col(c) = 1.0_r8 ! for crops handled by handle_storage end if ! Calculation of the water fluxes should include the background soil moisture @@ -377,23 +398,33 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & man_r_grz(c) = orgpools(ind_resist) man_u_grz(c) = orgpools(ind_unavail) - tanpools2(1) = ns%tan_g1_col(c) - tanpools2(2) = ns%tan_g2_col(c) - if (any(isnan(tanpools2))) then + tanpools3(1) = ns%tan_g1_col(c) + tanpools3(2) = ns%tan_g2_col(c) + tanpools3(3) = ns%tan_g3_col(c) + if (any(isnan(tanpools3))) then call endrun('nan1') end if + ph_soil = atm2lnd_inst%forc_soilph_grc(g) + if (ph_soil < 3.0) then + ph_soil = 6.5_r8 + def_ph_count = def_ph_count + 1 + end if + Hconc_grz(3) = 10**-(ph_soil) + soilph_max = max(soilph_max, ph_soil) + soilph_min = min(soilph_min, ph_soil) + fluxes_tmp = 0.0 garbage_total = 0.0 - fluxes2 = 0.0 + fluxes3 = 0.0 garbage = 0 do ind_substep = 1, num_substeps call update_npool(tg, ratm, & theta, thetasat, infiltr_m_s, evap_m_s, & atm2lnd_inst%forc_q_downscaled_col(c), watertend, & - runoff_m_s, tandep, (/0.0_r8, sum(tanprod)/), water_init_grz, & - cnc_nh3_air, poolranges_grz, Hconc_grz, dz_layer_grz, tanpools2, & - fluxes2(1:5,:), garbage, dt/num_substeps, status, 2) + runoff_m_s, tandep, (/0.0_r8, 0.0_r8, sum(tanprod)/), water_init_grz, & + cnc_nh3_air, poolranges_grz, Hconc_grz, dz_layer_grz, tanpools3, & + fluxes3(1:5,:), garbage, dt/num_substeps, status, 3) if (status /= 0) then write(iulog, *) 'status = ', status, tanpools2, ratm, theta, thetasat, tandep, tanprod call endrun(msg='update_npool status /= 0') @@ -401,15 +432,16 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & if (debug_fan .and. any(isnan(tanpools2))) then call endrun('nan2') end if - fluxes_tmp = fluxes_tmp + sum(fluxes2, dim=2) + fluxes_tmp = fluxes_tmp + sum(fluxes3, dim=2) garbage_total = garbage_total + garbage end do fluxes_tmp = fluxes_tmp / num_substeps - ns%tan_g1_col(c) = tanpools2(1) - ns%tan_g2_col(c) = tanpools2(2) - if (debug_fan .and. any(isnan(fluxes2))) then - write(iulog, *) fluxes2 + ns%tan_g1_col(c) = tanpools3(1) + ns%tan_g2_col(c) = tanpools3(2) + ns%tan_g3_col(c) = tanpools3(3) + if (debug_fan .and. any(isnan(fluxes3))) then + write(iulog, *) fluxes3 call endrun('nan3') end if @@ -442,44 +474,49 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & man_a_app(c) = orgpools(ind_avail) man_r_app(c) = orgpools(ind_resist) man_u_app(c) = orgpools(ind_unavail) - tanpools3(1) = ns%tan_s0_col(c) - tanpools3(2) = ns%tan_s1_col(c) - tanpools3(3) = ns%tan_s2_col(c) + tanpools4(1) = ns%tan_s0_col(c) + tanpools4(2) = ns%tan_s1_col(c) + tanpools4(3) = ns%tan_s2_col(c) + tanpools4(4) = ns%tan_s3_col(c) - if (debug_fan .and. any(isnan(tanpools3))) then + ph_crop = min(max(ph_soil, 5.5_r8), 7.5_r8) + Hconc_slr(4) = 10**-(ph_crop) + + if (debug_fan .and. any(isnan(tanpools4))) then call endrun('nan31') end if fluxes_tmp = 0.0 garbage_total = 0.0 - fluxes3 = 0.0 + fluxes4 = 0.0 do ind_substep = 1, num_substeps - if (debug_fan .and. any(abs(tanpools3) > 1e12)) then - write(iulog, *) ind_substep, tanpools3, tandep, nf%fert_n_appl_col(c), & + if (debug_fan .and. any(abs(tanpools4) > 1e12)) then + write(iulog, *) ind_substep, tanpools4, tandep, nf%fert_n_appl_col(c), & nf%man_n_appl_col(c), ns%man_n_stored_col(c), ns%man_tan_stored_col(c) call endrun('bad tanpools (manure app)') end if - call update_3pool(tg, ratm, theta, thetasat, infiltr_m_s, evap_m_s, & + call update_4pool(tg, ratm, theta, thetasat, infiltr_m_s, evap_m_s, & atm2lnd_inst%forc_q_downscaled_col(c), watertend, & runoff_m_s, tandep, sum(tanprod), cnc_nh3_air, depth_slurry, & - poolranges_slr, tanpools3, fluxes3(1:5,:), garbage, dt / num_substeps, status) + poolranges_slr, tanpools4, Hconc_slr, fluxes4(1:5,:), garbage, dt / num_substeps, status) if (status /= 0) then - write(iulog, *) 'status = ', status, tanpools3, tg, ratm, 'th', theta, & - thetasat, tandep, 'tp', tanprod, 'fx', fluxes + write(iulog, *) 'status = ', status, tanpools4, tg, ratm, 'th', theta, & + thetasat, tandep, 'tp', tanprod, 'fx', fluxes4 call endrun(msg='update_3pool status /= 0') end if - fluxes_tmp = fluxes_tmp + sum(fluxes3, dim=2) + fluxes_tmp = fluxes_tmp + sum(fluxes4, dim=2) garbage_total = garbage_total + garbage end do fluxes_tmp = fluxes_tmp / num_substeps - ns%tan_s0_col(c) = tanpools3(1) - ns%tan_s1_col(c) = tanpools3(2) - ns%tan_s2_col(c) = tanpools3(3) + ns%tan_s0_col(c) = tanpools4(1) + ns%tan_s1_col(c) = tanpools4(2) + ns%tan_s2_col(c) = tanpools4(3) + ns%tan_s3_col(c) = tanpools4(4) - if (debug_fan .and. any(isnan(fluxes3))) then - write(iulog, *) fluxes3, tanpools3,ratm, theta, thetasat, infiltr_m_s, tandep, tanprod + if (debug_fan .and. any(isnan(fluxes4))) then + write(iulog, *) fluxes3, tanpools4,ratm, theta, thetasat, infiltr_m_s, tandep, tanprod call endrun('nan4') end if @@ -554,7 +591,8 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & call update_npool(tg, ratm, theta, thetasat, infiltr_m_s, evap_m_s, & atm2lnd_inst%forc_q_downscaled_col(c), watertend, & runoff_m_s, fert_generic, (/0.0_r8/), water_init_fert, cnc_nh3_air, & - (/360*24*3600.0_r8/), (/10**(-6.5_r8)/), dz_layer_fert, ns%tan_f3_col(c:c), fluxes3(1:5,1:1), & + !(/360*24*3600.0_r8/), (/10**(-6.0_r8)/), dz_layer_fert, ns%tan_f3_col(c:c), fluxes3(1:5,1:1), & + (/360*24*3600.0_r8/), (/10**(-ph_crop)/), dz_layer_fert, ns%tan_f3_col(c:c), fluxes3(1:5,1:1), & garbage, dt/num_substeps, status, numpools=1) if (status /= 0) then write(iulog, *) 'status:', status, tanpools3, nf%fert_n_appl_col(c) @@ -591,6 +629,7 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & get_total_n(ns, nf, 'pools_manure'), get_total_n(ns, nf, 'fluxes_manure')) call balance_check('Fertilizer', nsoilfert_old, & get_total_n(ns, nf, 'pools_fertilizer'), get_total_n(ns, nf, 'fluxes_fertilizer')) + write(iulog, *) 'SoilPH check:', soilph_min, soilph_max, def_ph_count end if end associate @@ -666,6 +705,189 @@ end subroutine balance_check end subroutine CNNDeposition + subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & + ndep_mixed_grc, n_stored_col, tan_stored_col, & + n_manure_spread_col, tan_manure_spread_col, & + n_manure_graze_col, n_manure_mixed_col, & + nh3_flux_stores, nh3_flux_barns, man_n_transf, & + grz_fract, tan_fract_excr, & + filter_soilc, num_soilc) + use landunit_varcon, only : max_lunit + use pftconMod, only : nc4_grass, nc3_nonarctic_grass + use clm_varcon, only : ispval + use landunit_varcon, only: istsoil, istcrop + use abortutils , only : endrun + use LandunitType , only: lun + use GridcellType , only: grc + use clm_varctl , only : iulog + use ColumnType , only : col + + implicit none + type(bounds_type), intent(in) :: bounds + type(temperature_type) , intent(in) :: temperature_inst + type(frictionvel_type) , intent(in) :: frictionvel_inst + real(r8), intent(in) :: dt + + ! N excreted in manure, mixed/pastoral systems, gN/m2: + real(r8), intent(in) :: ndep_mixed_grc(bounds%begg:bounds%endg) + real(r8), intent(inout) :: n_stored_col(bounds%begc:bounds%endc), tan_stored_col(bounds%begc:bounds%endc) ! N, TAN currently stored, gN/m2 + ! N, TAN spread on grasslands, gN/m2/s: + real(r8), intent(inout) :: n_manure_spread_col(bounds%begc:bounds%endc) ! for crops, input, determined by crop model, otherwise output + real(r8), intent(out) :: tan_manure_spread_col(bounds%begc:bounds%endc) ! output, calculated from the above and stored manure + ! N excreted by animals allocated to mixed production systems temporarily grazing on grasslands: + real(r8), intent(inout) :: n_manure_graze_col(bounds%begc:bounds%endc) + ! N excreted by animals in mixed systems, total + real(r8), intent(out) :: n_manure_mixed_col(bounds%begc:bounds%endc) + ! NH3 emission fluxes from manure storage and housings, gN/m2/s + real(r8), intent(out) :: nh3_flux_stores(bounds%begc:bounds%endc), nh3_flux_barns(bounds%begc:bounds%endc) + ! total nitrogen flux transferred out of a crop column + real(r8), intent(out) :: man_n_transf(bounds%begc:bounds%endc) + ! fraction of manure excreted when grazing + real(r8), intent(out) :: grz_fract(bounds%begc:bounds%endc) + ! TAN fraction in excreted N + real(r8), intent(in) :: tan_fract_excr + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + + integer :: begg, endg, g, l, c, il, counter, col_grass, status, p + real(r8) :: flux_avail, flux_grazing + real(r8) :: tempr_ave, windspeed_ave ! windspeed and temperature averaged over agricultural patches + real(r8) :: tempr_barns, tempr_stores, vent_barns, flux_grass_crop, tempr_min_10day, & + flux_grass_graze, flux_grass_spread, flux_grass_spread_tan, flux_grass_crop_tan + real(r8) :: cumflux, totalinput + real(r8) :: fluxes_nitr(4), fluxes_tan(4) + ! The fraction of manure applied continuously on grasslands (if present in the gridcell) + real(r8), parameter :: fract_continuous = 0.1_r8, kg_to_g = 1e3_r8, max_grazing_fract = 0.3_r8, & + volat_coef_barns = 0.02_r8, volat_coef_stores = 0.02_r8, & + tempr_min_grazing = 283.0_r8!!!! + + begg = bounds%begg; endg = bounds%endg + nh3_flux_stores(bounds%begc:bounds%endc) = 0_r8 + nh3_flux_barns(bounds%begc:bounds%endc) = 0_r8 + + totalinput = 0.0 + cumflux = 0.0 + + do g = begg, endg + !totalinput = totalinput + ndep_mixed_grc(g) + + ! First find out if there are grasslands in this cell. If yes, a fraction of + ! manure can be diverted to them before storage. + col_grass = ispval + do il = 1, max_lunit + l = grc%landunit_indices(il, g) + if (lun%itype(l) == istsoil) then + do p = lun%patchi(l), lun%patchf(l) + if (patch%itype(p) == nc4_grass .or. patch%itype(p) == nc3_nonarctic_grass) then + col_grass = patch%column(p) + exit + end if + end do + end if + if (col_grass /= ispval) exit + end do + if (col%wtgcell(col_grass) < 1e-6) col_grass = ispval + ! Transfer of manure from all crop columns to the natural vegetation column: + flux_grass_graze = 0_r8 + flux_grass_spread = 0_r8 + flux_grass_spread_tan = 0_r8 + + do il = 1, max_lunit + l = grc%landunit_indices(il, g) + if (l == ispval) cycle + if (lun%itype(l) == istcrop) then + ! flux_avail = manure excreted per m2 of crops (ndep_mixed_grc = per m2 / all land units) + do c = lun%coli(l), lun%colf(l) + if (.not. col%active(c)) cycle + if (col%wtgcell(c) < 1e-6) cycle + + if (col%landunit(c) /= l) then + write(iulog, *) g, il, c, col%landunit(c) + call endrun('something wrong') + end if + if (.not. any(c==filter_soilc(1:num_soilc))) then + write(iulog, *) c, n_manure_spread_col(c) + call endrun('column not in soilfilter') + end if + + flux_avail = ndep_mixed_grc(g) * kg_to_g / lun%wtgcell(l) + if (flux_avail > 1e12 .or. isnan(flux_avail)) then + write(iulog, *) 'bad flux_avail', ndep_mixed_grc(g), lun%wtgcell(l) + call endrun('bad flux_avail') + end if + n_manure_mixed_col(c) = flux_avail + totalinput = totalinput + flux_avail + + counter = 0 + if (col_grass == c) call endrun('Something wrong with the indices') + if (col%patchi(c) /= col%patchf(c)) then + call endrun(msg="ERROR crop column has multiple patches") + end if + + tempr_ave = temperature_inst%t_ref2m_patch(col%patchi(c)) + windspeed_ave = frictionvel_inst%u10_patch(col%patchi(c)) + + tempr_min_10day = temperature_inst%t_a10min_patch(col%patchi(c)) + if (tempr_min_10day > tempr_min_grazing) then + ! fraction of animals grazing -> allocate some manure to grasslands before barns + flux_grazing = max_grazing_fract * flux_avail + flux_avail = flux_avail - flux_grazing + grz_fract(c) = max_grazing_fract + else + flux_grazing = 0 + grz_fract(c) = 0 + end if + flux_grass_graze = flux_grass_graze + flux_grazing*col%wtgcell(c) + + call eval_fluxes_storage(flux_avail, tempr_ave, windspeed_ave, 0.0_r8, & + volat_coef_barns, volat_coef_stores, tan_fract_excr, fluxes_nitr, fluxes_tan, status) + if (any(fluxes_nitr > 1e12)) then + write(iulog, *) 'bad fluxes', fluxes_nitr + end if + if (status /=0) then + write(iulog, *) 'status = ', status + call endrun(msg='eval_fluxes_storage failed') + end if + cumflux = cumflux + sum(fluxes_nitr) + + if (fluxes_tan(iflx_to_store) < 0) then + call endrun(msg="ERROR too much manure lost") + end if + + flux_grass_spread = flux_grass_spread + fluxes_nitr(iflx_to_store)*col%wtgcell(c) + flux_grass_spread_tan = flux_grass_spread_tan + fluxes_tan(iflx_to_store)*col%wtgcell(c) + + man_n_transf(c) = flux_grazing + fluxes_nitr(iflx_to_store) + + nh3_flux_stores(c) = fluxes_nitr(iflx_air_stores) + nh3_flux_barns(c) = fluxes_nitr(iflx_air_barns) + + end do ! column + end if ! crop land unit + end do ! landunit + + if (col_grass /= ispval) then + if (tan_manure_spread_col(col_grass) > 1) then + write(iulog, *) 'bad tan_manure col_grass before adding', n_manure_spread_col(col_grass), & + tan_manure_spread_col(col_grass) + end if + n_manure_spread_col(col_grass) = n_manure_spread_col(col_grass) & + + flux_grass_spread / col%wtgcell(col_grass) + tan_manure_spread_col(col_grass) = tan_manure_spread_col(col_grass) & + + flux_grass_spread_tan / col%wtgcell(col_grass) + n_manure_graze_col(col_grass) = n_manure_graze_col(col_grass) + flux_grass_graze / col%wtgcell(col_grass) + !write(iulog, *) 'to grass:', n_manure_spread(col_grass), col_grass + if (tan_manure_spread_col(col_grass) > 1) then + write(iulog, *) 'bad tan_manure col_grass', flux_grass_spread_tan, col%wtgcell(col_grass) + end if + else if (flux_grass_spread > 0) then + call endrun('Cannot spread manure') + end if + + end do ! grid + + end subroutine handle_storage_v2 + subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & ndep_mixed_grc, n_stored_col, tan_stored_col, & diff --git a/src/biogeochem/FanMod.F90 b/src/biogeochem/FanMod.F90 index b3ed8919d4..978c3e8af0 100755 --- a/src/biogeochem/FanMod.F90 +++ b/src/biogeochem/FanMod.F90 @@ -27,6 +27,7 @@ module FanMod public eval_fluxes_storage public update_npool public update_3pool + public update_4pool public update_urea #endif @@ -502,6 +503,233 @@ subroutine eval_fluxes_soil(mtan, water_manure, Hconc, tg, ratm, theta, thetasat end subroutine eval_fluxes_soil + subroutine eval_fluxes_soilroff(mtan, water_manure, Hconc, tg, ratm, theta, thetasat, perc, & + & runoff, cnc_nh3_air, soildepth, fluxes, substance, status) + ! + ! Evaluate nitrogen fluxes from a soil layer. Use for all cases except the partly + ! infiltrated slurry (above). Fluxes can be evaluated either for urea or TAN: for + ! urea, only the aqueous phase fluxes are evaluated and nitrification is set to zero. + ! + implicit none + real(r8), intent(in) :: mtan ! TAN, mass units / m2 + real(r8), intent(in) :: water_manure ! water in the soil pool *in addition to* background soil water + real(r8), intent(out) :: fluxes(5) ! nitrogen fluxes, mass units / m2 / s, see top of module + real(r8), intent(in) :: Hconc ! Hydrogen ion concentration, mol/l + real(r8), intent(in) :: tg ! soil temperature, K + real(r8), intent(in) :: ratm ! atmospheric resistance, s/m + real(r8), intent(in) :: theta ! volumetric soil water in "clean" soil, m/m + real(r8), intent(in) :: thetasat ! volumetric soil water at saturation + real(r8), intent(in) :: perc ! downwards water percolation rate at the bottom of layer, m/s, > 0 + real(r8), intent(in) :: runoff ! runoff water flux, m / s + real(r8), intent(in) :: cnc_nh3_air ! NH3 concentration in air, mass units / m3 + real(r8), intent(in) :: soildepth ! thickness of the volatlization layer + integer, intent(in) :: substance ! subst_tan or subst_urea. + integer, intent(out) :: status ! error flag + + + real(r8) :: water_tot, cnc, air, henry_eff, dsl, dsg, dstot, dz2, no3_rate, volat_rate, theta_tot, beta + real(r8) :: cnc_srfg, cnc_srfaq, cnc_soilaq, cnc_soilg, dz, rsl, rsg, qrf + + water_tot = water_manure + theta*soildepth + if (water_tot < 1e-9) then + fluxes = 0.0 + return + end if + + theta_tot = water_tot / soildepth + if (theta_tot > thetasat) then + status = err_bad_theta + return + end if + + cnc = mtan / soildepth + qrf = runoff + air = thetasat - theta_tot + beta = 0.0 + + dz = 0.5*soildepth + dsl = eval_diffusivity_liq_mq(theta_tot, thetasat, Tg) + dsg = eval_diffusivity_gas_mq(theta_tot, thetasat, Tg) + rsg = dz / (dsg*air) + rsl = dz / (dsl*theta_tot) + + if (substance == subst_tan) then + henry_eff = get_henry_eff(tg, Hconc) + no3_rate = eval_no3prod(theta_tot, tg, Hconc) + cnc_soilg = cnc / (theta_tot/henry_eff + air) + else if (substance == subst_urea) then + henry_eff = 0.0 + no3_rate = 0.0_r8 + cnc_soilg = 0.0_r8 + else + status = err_bad_subst + return + end if + + cnc_srfg = (henry_eff * ratm * cnc * (henry_eff*rsl + rsg)) & + / (air*henry_eff**2*rsl*(ratm + rsg) + air*henry_eff*ratm*rsg*(qrf*rsl + 1) & + + henry_eff*rsl*theta_tot*(ratm + rsg) + ratm*rsg*theta_tot*(qrf*rsl + 1)) + + cnc_srfaq = ratm * cnc * (henry_eff*rsl + rsg)& + / (air*henry_eff**2*rsl*(ratm + rsg) + air*henry_eff*ratm*rsg*(qrf*rsl + 1) & + + henry_eff*rsl*theta_tot*(ratm + rsg) + ratm*rsg*theta_tot*(qrf*rsl + 1)) + + fluxes(iflx_air) = cnc_srfg / ratm + fluxes(iflx_roff) = runoff * cnc_srfaq + + dstot = dsl*theta_tot + dsg*henry_eff*air + dz2 = soildepth_reservoir - 0.5 * soildepth + + cnc_soilaq = cnc / (theta_tot + air*henry_eff) + + fluxes(iflx_soild) = (cnc_soilaq * dsl) / dz2 + (cnc_soilg * dsg) / dz2 + + + fluxes(iflx_no3) = mtan * no3_rate + fluxes(iflx_soilq) = cnc_soilaq * perc + + status = 0 + !fluxes(4:) = 0 + + end subroutine eval_fluxes_soilroff + + + subroutine eval_fluxes_soil_3p(mtan, water_manure, Hconc, tg, ratm, theta, thetasat, perc, & + & runoff, cnc_nh3_air, soildepth, fluxes, substance, status) + ! + ! Evaluate nitrogen fluxes from a soil layer. Use for all cases except the partly + ! infiltrated slurry (above). Fluxes can be evaluated either for urea or TAN: for + ! urea, only the aqueous phase fluxes are evaluated and nitrification is set to zero. + ! + implicit none + real(r8), intent(in) :: mtan ! TAN, mass units / m2 + real(r8), intent(in) :: water_manure ! water in the soil pool *in addition to* background soil water + real(r8), intent(out) :: fluxes(5) ! nitrogen fluxes, mass units / m2 / s, see top of module + real(r8), intent(in) :: Hconc ! Hydrogen ion concentration, mol/l + real(r8), intent(in) :: tg ! soil temperature, K + real(r8), intent(in) :: ratm ! atmospheric resistance, s/m + real(r8), intent(in) :: theta ! volumetric soil water in "clean" soil, m/m + real(r8), intent(in) :: thetasat ! volumetric soil water at saturation + real(r8), intent(in) :: perc ! downwards water percolation rate at the bottom of layer, m/s, > 0 + real(r8), intent(in) :: runoff ! runoff water flux, m / s + real(r8), intent(in) :: cnc_nh3_air ! NH3 concentration in air, mass units / m3 + real(r8), intent(in) :: soildepth ! thickness of the volatlization layer + integer, intent(in) :: substance ! subst_tan or subst_urea. + integer, intent(out) :: status ! error flag + + + real(r8) :: water_tot, cnc, air, henry_eff, dsl, dsg, dstot, dz2, no3_rate, volat_rate, theta_tot, beta + real(r8) :: part_liq, part_gas, part_nh4, part_solid, part_avail + + water_tot = water_manure + theta*soildepth + if (water_tot < 1e-9) then + fluxes = 0.0 + return + end if + + theta_tot = water_tot / soildepth + if (theta_tot > thetasat) then + status = err_bad_theta + return + end if + + cnc = mtan / water_tot + + air = thetasat - theta_tot + beta = 0.0 + dz2 = soildepth_reservoir - 0.5 * soildepth + + if (substance == subst_tan) then + call get_fluxes_3p(mtan/soildepth, ratm, theta_tot, thetasat, tg, 0.5*soildepth, dz2, Hconc, & + fluxes(iflx_air), fluxes(iflx_soild), part_liq, part_gas, part_nh4, part_solid) + !print *, 'part:', part_liq, part_gas, part_nh4, part_solid + !volat_rate = get_volat_soil_leachn(ratm, tg, water_tot/soildepth, thetasat, Hconc, soildepth) + !fluxes(iflx_air) = max((cnc-cnc_nh3_air) * volat_rate, 0.0_r8) + + !call get_volat_coefs_liq(ratm, tg, water_tot/soildepth, thetasat, Hconc, soildepth, volat_rate, beta) + !fluxes(iflx_air) = volat_rate * (cnc - beta*cnc_nh3_air) + + !call get_volat_coefs_bulk(ratm, tg, water_tot/soildepth, thetasat, Hconc, soildepth, volat_rate, beta) + !call get_volat_coefs_3p(ratm, tg, water_tot/soildepth, thetasat, Hconc, soildepth, volat_rate, beta) + !fluxes(iflx_air) = volat_rate * (mtan/soildepth - beta*cnc_nh3_air) + part_avail = 1 - part_solid + no3_rate = thetasat * part_avail * eval_no3prod(theta_tot, tg, Hconc) + no3_rate = eval_no3prod(theta_tot, tg, Hconc) + fluxes(iflx_no3) = no3_rate * mtan! * ( 1 - part_solid * (1-thetasat)) + cnc = mtan / soildepth * part_liq + else if (substance == subst_urea) then + fluxes(iflx_air) = 0.0_r8 + henry_eff = 0.0_r8 + dsg = 0.0_r8 + no3_rate = 0.0_r8 + part_avail = 1.0_r8 + dsl = eval_diffusivity_liq_mq(theta_tot, thetasat, tg) + dstot = dsl*theta_tot + dsg*henry_eff*air + fluxes(iflx_soild) = cnc * dstot / dz2 + fluxes(iflx_no3) = 0.0 + else + status = err_bad_subst + return + end if + + ! Downwards diffusion + ! soil diffusivities: liquid, gas, bulk + + !print *, 'dz2:', dz2 + fluxes(iflx_soilq) = cnc * perc + fluxes(iflx_roff) = cnc * runoff + + status = 0 + !fluxes(4:) = 0 + + contains + + subroutine get_fluxes_3p(tan_soil, ratm, theta, thetasat, tg, dzup, dzdown, Hconc, & + flux_atm, flux_soild, part_soil_liq, part_soil_gas, part_soil_nh4, part_soil_solid) + real(r8), intent(in) :: tan_soil, ratm, theta, thetasat, tg, dzup, dzdown, Hconc + real(r8), intent(out) :: flux_atm, flux_soild, part_soil_liq, part_soil_gas, part_soil_nh4, part_soil_solid + + real(r8) :: rsl, rsg, knh4, kh, air, solid, comp + real(r8), parameter :: Tref = 298.15_r8 + real(r8), parameter :: kx = 1.0 + + KNH4 = 5.67_r8 * 1e-10_r8 * exp(-6286.0_r8 * (1.0_r8/Tg - 1.0_r8/Tref)) + KH = 4.59_r8 * Tg * exp(4092_r8 * (1.0_r8/Tg - 1.0_r8/Tref)) + + air = thetasat - theta + solid = 1 - thetasat + + rsl = dzup / (theta * eval_diffusivity_liq_mq(theta, thetasat, tg)) + rsg = dzup / (air * eval_diffusivity_gas_mq(theta, thetasat, tg)) + + comp = knh4*(cnc_nh3_air*rsg*rsl*(Hconc*kh*kx*solid + Hconc*kh*theta + & + air*knh4 + kh*knh4*theta) + ratm*tan_soil*(Hconc*kh*rsg + kh*knh4*rsg + & + knh4*rsl))/(Hconc**2*kh**2*kx*ratm*rsg*solid + Hconc**2*kh**2*ratm*rsg*theta + & + Hconc*air*kh*knh4*ratm*rsg + Hconc*kh**2*knh4*kx*ratm*rsg*solid + & + 2*Hconc*kh**2*knh4*ratm*rsg*theta + Hconc*kh*knh4*kx*rsl*solid*(ratm + rsg) + & + Hconc*kh*knh4*rsl*theta*(ratm + rsg) + air*kh*knh4**2*ratm*rsg + & + air*knh4**2*rsl*(ratm + rsg) + kh**2*knh4**2*ratm*rsg*theta + & + kh*knh4**2*rsl*theta*(ratm + rsg)) + + flux_atm = comp / ratm + + part_soil_liq = kh*(Hconc + knh4)/(Hconc*kh*kx*solid + Hconc*kh*theta + air*knh4 + kh*knh4*theta) + part_soil_nh4 = Hconc*kh/(Hconc*kh*kx*solid + Hconc*kh*theta + air*knh4 + kh*knh4*theta) + part_soil_gas = knh4/(Hconc*kh*kx*solid + Hconc*kh*theta + air*knh4 + kh*knh4*theta) + part_soil_solid = Hconc*kh*kx/(Hconc*kh*kx*solid + Hconc*kh*theta + air*knh4 + kh*knh4*theta) + !flux_soild = & + ! tan_soil*(kh*rsg*(Hconc + knh4) + knh4*rsl)& + ! /(rsg*rsl*(Hconc*kh*kx*solid + H*kh*theta + epsilon*knh4 + kh*knh4*theta)) + + rsl = dzdown / (theta * eval_diffusivity_liq_mq(theta, thetasat, tg)) + rsg = dzdown / (air * eval_diffusivity_gas_mq(theta, thetasat, tg)) + + flux_soild = tan_soil * part_soil_liq / rsl + tan_soil * part_soil_gas / rsg + + end subroutine get_fluxes_3p + + end subroutine eval_fluxes_soil_3p + subroutine partition_to_layer(water, theta, thetasat, soildepth, fraction_in, fraction_down, fraction_runoff) ! Evaluate the fraction of water volume that can be accommodated (before saturation) ! by soil layer with current water content theta. @@ -693,7 +921,7 @@ subroutine update_3pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend end subroutine update_3pool subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend, runoff, tandep, tanprod, cnc_nh3_air, & - depth_slurry, poolranges, tanpools, fluxes, garbage, dt, status) + depth_slurry, poolranges, tanpools, Hconc, fluxes, garbage, dt, status) ! ! Experimental, as above but with an additional long-lived TAN pool. ! @@ -715,6 +943,7 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend real(r8), intent(in) :: poolranges(4) ! age ranges of TAN pools S0, S1, S2, sec. Slurry infiltration time is inferred from S0. real(r8), intent(inout) :: tanpools(4) ! TAN pools gN/m2 real(r8), intent(out) :: fluxes(5,4) ! TAN fluxes, gN/m2/s (type of flux, pool) + real(r8), intent(in) :: Hconc(4) ! H+ concentration real(r8), intent(out) :: garbage ! over-aged TAN occurring during the step, gN/m. real(r8), intent(in) :: dt ! timestep, sec, >0 integer, intent(out) :: status ! return status, 0 = good @@ -725,7 +954,7 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend real(r8), parameter :: dz_layer = 0.02 ! thickness of the volatilization layer, m ! H+ concentration in each pool - real(r8), parameter :: Hconc(4) = (/10.0_r8**(-8.0_r8), 10.0_r8**(-8.0_r8), 10.0_r8**(-8.0_r8), 10.0_r8**(-7_r8)/) + !real(r8), parameter :: Hconc(4) = (/10.0_r8**(-8.0_r8), 10.0_r8**(-8.0_r8), 10.0_r8**(-8.0_r8), 10.0_r8**(-7_r8)/) if (theta > thetasat) then status = err_bad_theta @@ -917,7 +1146,9 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend percolation = eval_perc(waterloss, evap, precip, watertend, poolranges(indpl)) ! water content at the middle of the age range water_soil = water_into_layer * waterfunction(age_prev + 0.5*poolranges(indpl)) - call eval_fluxes_soil(tanpools(indpl), water_soil, Hconc(indpl), tg, & + !call eval_fluxes_soil(tanpools(indpl), water_soil, Hconc(indpl), tg, & + !call eval_fluxes_soil_3p(tanpools(indpl), water_soil, Hconc(indpl), tg, & + call eval_fluxes_soilroff(tanpools(indpl), water_soil, Hconc(indpl), tg, & & ratm, theta, thetasat, percolation, runoff, cnc_nh3_air, & & dz_layer, fluxes(:,indpl), subst_tan, status) if (status /= 0) then @@ -1126,6 +1357,7 @@ subroutine eval_fluxes_storage(nitr_input, tempr_outside, windspeed, fract_direc tempr_stores = max(Tfloor_stores, tempr_C) flux_store = flux_avail_tan & & * volat_coef_stores * tempr_stores**pA * windspeed**pB + flux_store = min(flux_avail_tan, flux_store) fluxes_tan(iflx_air_stores) = flux_store fluxes_nitr(iflx_air_stores) = flux_store @@ -1231,7 +1463,8 @@ subroutine update_urea(tg, theta, thetasat, precip, evap, watertend, runoff, & age_prev = 0 do indpl = 1, numpools percolation = eval_perc(0.0_r8, evap, precip, watertend, ranges(indpl)) - call eval_fluxes_soil(pools(indpl), 0.0_r8, missing, tg, & + call eval_fluxes_soilroff(pools(indpl), 0.0_r8, missing, tg, & + !call eval_fluxes_soil(pools(indpl), 0.0_r8, missing, tg, & & missing, theta, thetasat, percolation, runoff, missing, & & dz_layer, fluxes(1:5,indpl), subst_urea, status) if (status /= 0) then diff --git a/src/main/atm2lndType.F90 b/src/main/atm2lndType.F90 index 8d7db9baa4..ad0f49e2be 100644 --- a/src/main/atm2lndType.F90 +++ b/src/main/atm2lndType.F90 @@ -89,12 +89,13 @@ module atm2lndType real(r8), pointer :: forc_solai_grc (:,:) => null() ! diffuse radiation (numrad) (vis=forc_solsd, nir=forc_solld) real(r8), pointer :: forc_solar_grc (:) => null() ! incident solar radiation real(r8), pointer :: forc_ndep_grc (:) => null() ! nitrogen deposition rate (gN/m2/s) -!KO +!JV real(r8), pointer :: forc_ndep2_grc (:) => null() ! FAN nitrogen deposition (manure) rate (gN/m2/s) real(r8), pointer :: forc_ndep3_grc (:) => null() ! FAN nitrogen deposition (fertilizer) rate (gN/m2/s) real(r8), pointer :: forc_ndep_urea_grc (:) => null() ! FAN nitrogen deposition, urea fertilizer fraction real(r8), pointer :: forc_ndep_nitr_grc (:) => null() ! FAN nitrogen deposition, nitrate fertilizer fraction -!KO + real(r8), pointer :: forc_soilph_grc (:) => null() ! FAN soil pH +!JV real(r8), pointer :: forc_pc13o2_grc (:) => null() ! C13O2 partial pressure (Pa) real(r8), pointer :: forc_po2_grc (:) => null() ! O2 partial pressure (Pa) real(r8), pointer :: forc_po2_240_patch (:) => null() ! 10-day mean O2 partial pressure (Pa) @@ -524,6 +525,7 @@ subroutine InitAllocate(this, bounds) allocate(this%forc_ndep3_grc (begg:endg)) ; this%forc_ndep3_grc (:) = ival allocate(this%forc_ndep_urea_grc (begg:endg)) ; this%forc_ndep3_grc (:) = ival allocate(this%forc_ndep_nitr_grc (begg:endg)) ; this%forc_ndep3_grc (:) = ival + allocate(this%forc_soilph_grc (begg:endg)) ; this%forc_soilph_grc (:) = ival end if !KO allocate(this%forc_pc13o2_grc (begg:endg)) ; this%forc_pc13o2_grc (:) = ival @@ -1265,6 +1267,7 @@ subroutine Clean(this) deallocate(this%forc_ndep3_grc) deallocate(this%forc_ndep_nitr_grc) deallocate(this%forc_ndep_urea_grc) + deallocate(this%forc_soilph_grc) !KO end if deallocate(this%forc_pc13o2_grc) diff --git a/src/main/fanStreamMod.F90 b/src/main/fanStreamMod.F90 index 97c3214b39..244d910f22 100644 --- a/src/main/fanStreamMod.F90 +++ b/src/main/fanStreamMod.F90 @@ -36,7 +36,7 @@ module FanStreamMod !KO public :: clm_domain_mct ! Sets up MCT domain for this resolution ! ! PRIVATE TYPES - type(shr_strdata_type) :: sdat_past, sdat_mix, sdat_urea, sdat_nitr ! input data streams + type(shr_strdata_type) :: sdat_past, sdat_mix, sdat_urea, sdat_nitr, sdat_soilph ! input data streams integer :: stream_year_first_ndep2 ! first year in stream to use integer :: stream_year_last_ndep2 ! last year in stream to use integer :: model_year_align_ndep2 ! align stream_year_firstndep2 with @@ -240,6 +240,32 @@ subroutine fanstream_init(bounds, NLFilename) calendar=get_calendar(), & taxmode='extend' ) + call shr_strdata_create(sdat_soilph,name="clmndep2ph", & + pio_subsystem=pio_subsystem, & + pio_iotype=shr_pio_getiotype(inst_name), & + mpicom=mpicom, compid=comp_id, & + gsmap=gsmap_lnd_gdc2glo, ggrid=dom_clm, & + nxg=ldomain%ni, nyg=ldomain%nj, & + yearFirst=stream_year_first_ndep2, & + yearLast=stream_year_last_ndep2, & + yearAlign=model_year_align_ndep2, & + offset=0, & + domFilePath='', & + domFileName=trim(stream_fldFileName_ndep2), & + domTvarName='time', & + domXvarName='x' , & + domYvarName='y' , & + domAreaName='area', & + domMaskName='mask', & + filePath='', & + filename=(/trim(stream_fldFileName_ndep2)/),& + fldListFile='soilph', & + fldListModel='fansoilph', & + fillalgo='none', & + mapalgo='nn', & + calendar=get_calendar(), & + taxmode='extend' ) + if (masterproc) then call shr_strdata_print(sdat_mix,'CLMNDEP2 data') endif @@ -304,6 +330,15 @@ subroutine fanstream_interp(bounds, atm2lnd_inst) ig = ig+1 atm2lnd_inst%forc_ndep_nitr_grc(g) = sdat_nitr%avs(1)%rAttr(1,ig) end do + + call shr_strdata_advance(sdat_soilph, mcdate, sec, mpicom, 'clmndep2ph') + + ig = 0 + do g = bounds%begg,bounds%endg + ig = ig+1 + atm2lnd_inst%forc_soilph_grc(g) = sdat_soilph%avs(1)%rAttr(1,ig) + end do + end subroutine fanstream_interp diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 index b53365e4f6..7dada94956 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 @@ -42,9 +42,12 @@ module SoilBiogeochemNitrogenStateType !JV, FAN real(r8), pointer :: tan_g1_col(:) ! col (gN/m2) total ammoniacal N in FAN pool G1 real(r8), pointer :: tan_g2_col(:) ! col (gN/m2) total ammoniacal N in FAN pool G2 + real(r8), pointer :: tan_g3_col(:) ! col (gN/m2) total ammoniacal N in FAN pool G2 + real(r8), pointer :: tan_s0_col(:) ! col (gN/m2) total ammoniacal N in FAN pool S0 real(r8), pointer :: tan_s1_col(:) ! col (gN/m2) total ammoniacal N in FAN pool S1 real(r8), pointer :: tan_s2_col(:) ! col (gN/m2) total ammoniacal N in FAN pool S2 + real(r8), pointer :: tan_s3_col(:) ! col (gN/m2) total ammoniacal N in FAN pool S2 real(r8), pointer :: tan_f0_col(:) ! col (gN/m2) total ammoniacal N in FAN pool F0 real(r8), pointer :: tan_f1_col(:) ! col (gN/m2) total ammoniacal N in FAN pool F1 @@ -64,6 +67,7 @@ module SoilBiogeochemNitrogenStateType real(r8), pointer :: man_n_stored_col(:) ! col (gN/m2) manure N in storage real(r8), pointer :: man_tan_stored_col(:) ! col (gN/m2) manure TAN in storage + real(r8), pointer :: fan_grz_fract_col(:) ! col unitless fraction of animals grazing !KO ! FAN real(r8), pointer :: smin_no3_monthly_col (:) ! col (gN/m2) soil mineral NO3 pool @@ -201,9 +205,11 @@ subroutine InitAllocate(this, bounds) if (use_fan) then allocate(this%tan_g1_col(begc:endc)) ; this%tan_g1_col(:) = nan allocate(this%tan_g2_col(begc:endc)) ; this%tan_g2_col(:) = nan + allocate(this%tan_g3_col(begc:endc)) ; this%tan_g3_col(:) = nan allocate(this%tan_s0_col(begc:endc)) ; this%tan_s0_col(:) = nan allocate(this%tan_s1_col(begc:endc)) ; this%tan_s1_col(:) = nan allocate(this%tan_s2_col(begc:endc)) ; this%tan_s2_col(:) = nan + allocate(this%tan_s3_col(begc:endc)) ; this%tan_s3_col(:) = nan allocate(this%tan_f0_col(begc:endc)) ; this%tan_f0_col(:) = nan allocate(this%tan_f1_col(begc:endc)) ; this%tan_f1_col(:) = nan allocate(this%tan_f2_col(begc:endc)) ; this%tan_f2_col(:) = nan @@ -221,6 +227,7 @@ subroutine InitAllocate(this, bounds) allocate(this%man_n_stored_col(begc:endc)) ; this%man_n_stored_col(:) = nan allocate(this%man_tan_stored_col(begc:endc)) ; this%man_tan_stored_col(:) = nan + allocate(this%fan_grz_fract_col(begc:endc)) ; this%fan_grz_fract_col(:) = nan end if !KO @@ -595,6 +602,11 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool G2', & ptr_col=this%tan_g2_col) + this%tan_g3_col(begc:endc) = spval + call hist_addfld1d (fname='TAN_G3', units='gN/m^2', & + avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool G3', & + ptr_col=this%tan_g3_col) + this%tan_f0_col(begc:endc) = spval call hist_addfld1d (fname='TAN_F0', units='gN/m^2', & avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool F0', & @@ -636,11 +648,17 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool S1', & ptr_col=this%tan_s1_col) - this%tan_s1_col(begc:endc) = spval + this%tan_s2_col(begc:endc) = spval call hist_addfld1d (fname='TAN_S2', units='gN/m^2', & avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool S2', & ptr_col=this%tan_s2_col) + this%tan_s3_col(begc:endc) = spval + call hist_addfld1d (fname='TAN_S3', units='gN/m^2', & + avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool S3', & + ptr_col=this%tan_s3_col) + + this%man_u_grz_col(begc:endc) = spval call hist_addfld1d (fname='MAN_U_GRZ', units='gN/m^2', & avgflag='A', long_name='Unavailable manure nitrogen, grazing', & @@ -681,6 +699,12 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='Manure ammoniacal nitrogen in storage', & ptr_col=this%man_tan_stored_col) + this%fan_grz_fract_col(begc:endc) = spval + call hist_addfld1d (fname='FAN_GRZ_FRACT', units='', & + avgflag='A', long_name='Fraction of animals grazing', & + ptr_col=this%fan_grz_fract_col) + + end if @@ -772,9 +796,11 @@ subroutine InitCold(this, bounds, & !JV this%tan_g1_col(c) = 0.0_r8 this%tan_g2_col(c) = 0.0_r8 + this%tan_g3_col(c) = 0.0_r8 this%tan_s0_col(c) = 0.0_r8 this%tan_s1_col(c) = 0.0_r8 this%tan_s2_col(c) = 0.0_r8 + this%tan_s3_col(c) = 0.0_r8 this%tan_f0_col(c) = 0.0_r8 this%tan_f1_col(c) = 0.0_r8 this%tan_f2_col(c) = 0.0_r8 @@ -791,6 +817,7 @@ subroutine InitCold(this, bounds, & this%man_r_app_col(c) = 0.0_r8 this%man_tan_stored_col(c) = 0.0_r8 + this%fan_grz_fract_col(c) = 0.0_r8 this%man_n_stored_col(c) = 0.0_r8 this%TAN_manu_col(c) = 0._r8 @@ -1124,6 +1151,10 @@ subroutine Restart ( this, bounds, ncid, flag, totvegc_col ) call restartvar(ncid=ncid, flag=flag, varname='tan_g2', xtype=ncd_double, & dim1name='column', long_name='', units='', & interpinic_flag='interp', readvar=readvar, data=this%tan_g2_col) + call restartvar(ncid=ncid, flag=flag, varname='tan_g3', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%tan_g3_col) + call restartvar(ncid=ncid, flag=flag, varname='tan_s0', xtype=ncd_double, & dim1name='column', long_name='', units='', & interpinic_flag='interp', readvar=readvar, data=this%tan_s0_col) @@ -1133,6 +1164,10 @@ subroutine Restart ( this, bounds, ncid, flag, totvegc_col ) call restartvar(ncid=ncid, flag=flag, varname='tan_s2', xtype=ncd_double, & dim1name='column', long_name='', units='', & interpinic_flag='interp', readvar=readvar, data=this%tan_s2_col) + call restartvar(ncid=ncid, flag=flag, varname='tan_s3', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%tan_s3_col) + call restartvar(ncid=ncid, flag=flag, varname='tan_f0', xtype=ncd_double, & dim1name='column', long_name='', units='', & interpinic_flag='interp', readvar=readvar, data=this%tan_f0_col) @@ -1179,6 +1214,9 @@ subroutine Restart ( this, bounds, ncid, flag, totvegc_col ) call restartvar(ncid=ncid, flag=flag, varname='man_n_stored', xtype=ncd_double, & dim1name='column', long_name='', units='', & interpinic_flag='interp', readvar=readvar, data=this%man_n_stored_col) + call restartvar(ncid=ncid, flag=flag, varname='fan_grz_fract', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%fan_grz_fract_col) !JV end if From 0910db2a36b56a698c59bc37f3a11ae380be0875 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Mon, 9 Jul 2018 12:46:08 -0600 Subject: [PATCH 020/181] drydep mods, clm side --- src/biogeochem/DryDepVelocity.F90 | 124 ++++++++++++++++++++++++------ 1 file changed, 101 insertions(+), 23 deletions(-) diff --git a/src/biogeochem/DryDepVelocity.F90 b/src/biogeochem/DryDepVelocity.F90 index 603e9d24c4..897bc97b91 100644 --- a/src/biogeochem/DryDepVelocity.F90 +++ b/src/biogeochem/DryDepVelocity.F90 @@ -84,6 +84,10 @@ Module DryDepVelocity real(r8), pointer, public :: velocity_patch (:,:) ! Dry Deposition Velocity real(r8), pointer, private :: rs_drydep_patch (:) ! Stomatal resistance associated with dry deposition velocity for Ozone + real(r8), pointer, private :: rsg_drydep_patch (:) ! Stomatal resistance associated with dry deposition velocity for Ozone + real(r8), pointer, private :: rac_drydep_patch (:) ! Stomatal resistance associated with dry deposition velocity for Ozone + real(r8), pointer, private :: ra_drydep_patch (:) ! Stomatal resistance associated with dry deposition velocity for Ozone + real(r8), pointer, private :: rb_drydep_patch (:) ! Stomatal resistance associated with dry deposition velocity for Ozone contains @@ -130,7 +134,12 @@ subroutine InitAllocate(this, bounds) ! Dry Deposition Velocity if ( n_drydep > 0 .and. drydep_method == DD_XLND )then allocate(this%velocity_patch(begp:endp, n_drydep)); this%velocity_patch(:,:) = nan - allocate(this%rs_drydep_patch(begp:endp)) ; this%rs_drydep_patch(:) = nan + allocate(this%rs_drydep_patch(begp:endp)) ; this%rs_drydep_patch(:) = nan + allocate(this%rsg_drydep_patch(begp:endp)) ; this%rsg_drydep_patch(:) = nan + allocate(this%rac_drydep_patch(begp:endp)) ; this%rac_drydep_patch(:) = nan + allocate(this%ra_drydep_patch(begp:endp)) ; this%ra_drydep_patch(:) = nan + allocate(this%rb_drydep_patch(begp:endp)) ; this%rb_drydep_patch(:) = nan + end if end subroutine InitAllocate @@ -167,13 +176,35 @@ subroutine InitHistory(this, bounds) ptr_1d => this%velocity_patch(begp:endp,ispec) call hist_addfld1d ( fname='DRYDEPV_'//trim(drydep_list(ispec)), units='cm/sec', & avgflag='A', long_name='Dry Deposition Velocity', & - ptr_patch=ptr_1d, default='inactive' ) + ptr_patch=ptr_1d, default='active' ) end do this%rs_drydep_patch(begp:endp)= spval call hist_addfld1d ( fname='RS_DRYDEP_O3', units='s/m', & avgflag='A', long_name='Stomatal Resistance Associated with Ozone Dry Deposition Velocity', & - ptr_patch=this%rs_drydep_patch, default='inactive' ) + ptr_patch=this%rs_drydep_patch, default='active' ) + + this%rsg_drydep_patch(begp:endp)= spval + call hist_addfld1d ( fname='RSG_DRYDEP_SO2', units='s/m', & + avgflag='A', long_name='Ground Resistance Associated with SO2 Dry Deposition Velocity', & + ptr_patch=this%rsg_drydep_patch, default='active' ) + + this%rac_drydep_patch(begp:endp)= spval + call hist_addfld1d ( fname='RAC_DRYDEP', units='s/m', & + avgflag='A', long_name='Upper canopy resistance for dry dep', & + ptr_patch=this%rac_drydep_patch, default='active' ) + + this%ra_drydep_patch(begp:endp)= spval + call hist_addfld1d ( fname='RA_DRYDEP', units='s/m', & + avgflag='A', long_name='Aerodynamic resistance', & + ptr_patch=this%ra_drydep_patch, default='active' ) + + this%rb_drydep_patch(begp:endp)= spval + call hist_addfld1d ( fname='RB_DRYDEP', units='s/m', & + avgflag='A', long_name='Quasi-laminar layer resistance', & + ptr_patch=this%rb_drydep_patch, default='active' ) + + end subroutine InitHistory @@ -249,7 +280,8 @@ subroutine depvel_compute( bounds, & logical :: has_dew logical :: has_rain real(r8), parameter :: rain_threshold = 1.e-7_r8 ! of the order of 1cm/day expressed in m/s - + real(r8), parameter :: pH = 6.5_r8 ! pH used in scaling solubility-dependent resistances + ! local arrays: dependent on species only real(r8), dimension(n_drydep) :: rsmx !vegetative resistance (plant mesophyll) real(r8), dimension(n_drydep) :: rclx !lower canopy resistance @@ -260,7 +292,8 @@ subroutine depvel_compute( bounds, & real(r8) :: rc !combined surface resistance real(r8) :: cts !correction to flu rcl and rgs for frost real(r8) :: rlux_o3 !to calculate O3 leaf resistance in dew/rain conditions - + real(r8) :: heff_so2 ! effective Henry's law constant for SO2 under the local conditions + real(r8) :: cts2 ! constants real(r8), parameter :: slope = 0._r8 ! Used to calculate rdc in (lower canopy resistance) integer, parameter :: wveg_unset = -1 ! Unset Wesley vegetation type @@ -300,7 +333,12 @@ subroutine depvel_compute( bounds, & annlai => canopystate_inst%annlai_patch , & ! Input: [real(r8) (:,:) ] 12 months of monthly lai from input data set velocity => drydepvel_inst%velocity_patch , & ! Output: [real(r8) (:,:) ] cm/sec - rs_drydep => drydepvel_inst%rs_drydep_patch & ! Output: [real(r8) (:) ] stomatal resistance associated with Ozone dry deposition velocity (s/m) + rs_drydep => drydepvel_inst%rs_drydep_patch , & ! Output: [real(r8) (:) ] stomatal resistance associated with Ozone dry deposition velocity (s/m) + rac_drydep => drydepvel_inst%rac_drydep_patch, & + rsg_drydep => drydepvel_inst%rsg_drydep_patch, & + ra_drydep => drydepvel_inst%ra_drydep_patch, & + rb_drydep => drydepvel_inst%rb_drydep_patch & + ) !_________________________________________________________________ @@ -448,9 +486,11 @@ subroutine depvel_compute( bounds, & ! land types are computed seperately, then resistance is computed as average of values ! following wesely rc=(1/(rs+rm) + 1/rlu +1/(rdc+rcl) + 1/(rac+rgs))**-1 + !******************************************************* - call seq_drydep_setHCoeff( sfc_temp, heff(:n_drydep) ) + call seq_drydep_setHCoeff( sfc_temp, 10**(-pH), heff(:n_drydep) ) !********************************************************* + heff_so2 = heff(index_so2) species_loop1: do ispec=1, n_drydep if(mapping(ispec) <= 0) cycle @@ -465,9 +505,24 @@ subroutine depvel_compute( bounds, & cts = 1000._r8*exp( -tc - 4._r8 ) !ground resistance - rgsx(ispec) = 1._r8/((heff(ispec)/(1.e5_r8*(rgss(index_season,wesveg)+cts))) + & - (foxd(ispec)/(rgso(index_season,wesveg)+cts))) + !rgsx(ispec) = 1._r8 / ((heff(ispec) / (1.e5_r8*(rgss(index_season,wesveg)+cts))) + & + ! (foxd(ispec)/(rgso(index_season,wesveg)+cts))) + !rgsx(ispec) = 1._r8/((heff(ispec)/(1.e5_r8*(rgss(index_season,wesveg)))) + & + ! (foxd(ispec)/(rgso(index_season,wesveg)))) + + !rgsx(ispec) = 1._r8/((heff(ispec)/(heff_so2*(rgss(index_season,wesveg) + cts))) + & + ! (foxd(ispec)/(rgso(index_season,wesveg) + cts))) + + if (tc < -1) then + cts2 = min(2.0_r8, exp(0.2*(-1.0_r8 - tc))) + else + cts2 = 1.0_r8 + end if + rgsx(ispec) = cts2 / ((heff(ispec)/(heff_so2*(rgss(index_season,wesveg)))) + & + (foxd(ispec)/(rgso(index_season,wesveg)))) + + !------------------------------------------------------------------------------------- ! special case for H2 and CO;; CH4 is set ot a fraction of dv(H2) !------------------------------------------------------------------------------------- @@ -524,13 +579,19 @@ subroutine depvel_compute( bounds, & ! Leaf resistance !MVM: adjusted rlu by LAI to get leaf resistance over bulk canopy (gao and wesely, 1995) - rlu_lai=cts+rlu(index_season,wesveg)/elai(pi) - rlux(ispec) = rlu_lai/(1.e-5_r8*heff(ispec)+foxd(ispec)) + !rlu_lai=cts+rlu(index_season,wesveg)/elai(pi) + !rlux(ispec) = rlu_lai/(1.e-5_r8*heff(ispec)+foxd(ispec)) + + rlu_lai = rlu(index_season,wesveg)/elai(pi) + rlux(ispec) = cts2 * rlu_lai / (heff(ispec)/heff_so2 + foxd(ispec)) !Lower canopy resistance - rclx(ispec) = 1._r8/((heff(ispec)/(1.e5_r8*(rcls(index_season,wesveg)+cts))) + & - (foxd(ispec)/(rclo(index_season,wesveg)+cts))) + !rclx(ispec) = 1._r8/((heff(ispec)/(1.e5_r8*(rcls(index_season,wesveg)+cts))) + & + ! (foxd(ispec)/(rclo(index_season,wesveg)+cts))) + rclx(ispec) = cts2 / ((heff(ispec)/(heff_so2*(rcls(index_season,wesveg)))) + & + (foxd(ispec)/(rclo(index_season,wesveg)))) + !----------------------------------- !mvm 11/30/2013: special case for CO !Dry deposition of CO and hydrocarbons is negligibly @@ -574,8 +635,11 @@ subroutine depvel_compute( bounds, & ! non_freezing: if(sfc_temp.gt.tmelt) then if( has_dew ) then - rlu_lai=cts+rlu(index_season,wesveg)/elai(pi) - rlux_o3 = 1._r8/((1._r8/3000._r8)+(1._r8/(3._r8*rlu_lai))) + !rlu_lai=cts+rlu(index_season,wesveg)/elai(pi) + !rlux_o3 = 1._r8/((1._r8/3000._r8)+(1._r8/(3._r8*rlu_lai))) + + rlu_lai=rlu(index_season,wesveg)/elai(pi) + rlux_o3 = cts2/((1._r8/3000._r8)+(1._r8/(3._r8*rlu_lai))) if (index_o3 > 0) then rlux(index_o3) = rlux_o3 @@ -586,8 +650,10 @@ subroutine depvel_compute( bounds, & endif if(has_rain) then - rlu_lai=cts+rlu(index_season,wesveg)/elai(pi) - rlux_o3 = 1._r8/((1._r8/1000._r8)+(1._r8/(3._r8*rlu_lai))) + !rlu_lai=cts+rlu(index_season,wesveg)/elai(pi) + !rlux_o3 = 1._r8/((1._r8/1000._r8)+(1._r8/(3._r8*rlu_lai))) + rlu_lai=rlu(index_season,wesveg)/elai(pi) + rlux_o3 = cts2 / ((1._r8/1000._r8)+(1._r8/(3._r8*rlu_lai))) if (index_o3 > 0) then rlux(index_o3) = rlux_o3 @@ -602,9 +668,13 @@ subroutine depvel_compute( bounds, & if(ispec.ne.index_o3.and.ispec.ne.index_o3a.and.ispec.ne.index_so2) then if( has_dew .or. has_rain) then - rlu_lai=cts+rlu(index_season,wesveg)/elai(pi) - rlux(ispec)=1._r8/((1._r8/(3._r8*rlu_lai))+ & - (1.e-7_r8*heff(ispec))+(foxd(ispec)/rlux_o3)) + !rlu_lai=cts+rlu(index_season,wesveg)/elai(pi) + !rlux(ispec)=1._r8/((1._r8/(3._r8*rlu_lai))+ & + ! (1.e-7_r8*heff(ispec))+(foxd(ispec)/rlux_o3)) + rlu_lai = rlu(index_season,wesveg)/elai(pi) + rlux(ispec) = cts / ((1._r8/(3._r8*rlu_lai))+ & + (1.e-7_r8*heff(ispec)) + (foxd(ispec)/rlux_o3)) + endif elseif(ispec.eq.index_so2) then @@ -614,8 +684,12 @@ subroutine depvel_compute( bounds, & endif if(has_rain) then - rlu_lai=cts+rlu(index_season,wesveg)/elai(pi) - rlux(ispec) = 1._r8/((1._r8/5000._r8)+(1._r8/(3._r8*rlu_lai))) + !rlu_lai=cts+rlu(index_season,wesveg)/elai(pi) + !rlux(ispec) = 1._r8/((1._r8/5000._r8)+(1._r8/(3._r8*rlu_lai))) + + rlu_lai=rlu(index_season,wesveg)/elai(pi) + rlux(ispec) = cts2 / ((1._r8/5000._r8)+(1._r8/(3._r8*rlu_lai))) + endif if( has_dew .or. has_rain ) then @@ -663,7 +737,11 @@ subroutine depvel_compute( bounds, & case ( 'CB1', 'CB2', 'OC1', 'OC2', 'SOAM', 'SOAI', 'SOAT', 'SOAB', 'SOAX' ) velocity(pi,ispec) = 0.10_r8 case ( 'SO2' ) - velocity(pi,ispec) = (1._r8/(ram1(pi)+rb1(pi)+rc))*200._r8 + velocity(pi,ispec) = (1._r8/(ram1(pi)+rb1(pi)+rc))*100._r8 + rsg_drydep(pi) = rgsx(ispec) + rac_drydep(pi) = rac(index_season,wesveg) + ra_drydep(pi) = ram1(pi) + rb_drydep(pi) = rb1(pi) case default velocity(pi,ispec) = (1._r8/(ram1(pi)+rb1(pi)+rc))*100._r8 end select From bb2dc1e7192b1bc92c312020138d6ac255f4008c Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 11 Jul 2018 10:45:33 -0400 Subject: [PATCH 021/181] cleanup --- src/main/clm_initializeMod.F90 | 5 ----- 1 file changed, 5 deletions(-) diff --git a/src/main/clm_initializeMod.F90 b/src/main/clm_initializeMod.F90 index 744add094b..66b1f844a9 100644 --- a/src/main/clm_initializeMod.F90 +++ b/src/main/clm_initializeMod.F90 @@ -585,11 +585,6 @@ subroutine initialize2( ) call fanstream_init(bounds_proc, NLFilename) call fanstream_interp(bounds_proc, atm2lnd_inst) call t_stopf('init_ndep2') - -!!$ call t_startf('init_ndep3') -!!$ call ndep3_init(bounds_proc, NLFilename) -!!$ call ndep3_interp(bounds_proc, atm2lnd_inst) -!!$ call t_stopf('init_ndep3') end if !KO end if From 761bb116a487256c81667aa5223a8778c96a0e56 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 11 Jul 2018 10:46:26 -0400 Subject: [PATCH 022/181] fix tan_fract + mass check --- src/biogeochem/CNNDynamicsMod.F90 | 27 ++++++++++++++------------- 1 file changed, 14 insertions(+), 13 deletions(-) diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index ddb2c7cb75..682798bc9b 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -176,7 +176,12 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & real(r8) :: dt, ndep_org(3), orgpools(3), tanprod(3), watertend, fluxes(6,3), tanpools3(3), ratm, tandep, & fluxes2(6,2), fluxes3(6,3), fluxes4(6,4), tanpools2(2), tanpools4(4), fluxes_tmp(6), garbage_total real(r8), parameter :: water_init_grz = 0.005_r8, cnc_nh3_air = 0.0_r8, depth_slurry = 0.005_r8 - real(r8), parameter :: fract_resist=0.225_r8, fract_unavail=0.025_r8, fract_avail=0.25_r8, fract_tan=0.6_r8 + !real(r8), parameter :: fract_resist=0.225_r8, fract_unavail=0.025_r8, fract_avail=0.25_r8, fract_tan=0.6_r8 + + real(r8), parameter :: fract_tan=0.6_r8 ! of all N + real(r8), parameter :: fract_resist=0.45_r8, fract_unavail=0.05_r8, fract_avail=0.5_r8 ! of organic N + + real(r8), parameter :: dz_layer_fert = 0.02_r8, dz_layer_grz = 0.02_r8 !real(r8), parameter :: fract_resist=0._r8, fract_unavail=0._r8, fract_avail=0._r8, fract_tan=1.0_r8 @@ -385,9 +390,9 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & ! grazing ! - ndep_org(ind_avail) = ngrz(c) * fract_avail - ndep_org(ind_resist) = ngrz(c) * fract_resist - ndep_org(ind_unavail) = ngrz(c) * fract_unavail + ndep_org(ind_avail) = ngrz(c) * (1.0_r8-tract_tan) * fract_avail + ndep_org(ind_resist) = ngrz(c) * (1.0_r8-tract_tan) * fract_resist + ndep_org(ind_unavail) = ngrz(c) * (1.0_r8-tract_tan) * fract_unavail tandep = ngrz(c) * fract_tan orgpools(ind_avail) = man_a_grz(c) @@ -458,13 +463,9 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & org_n_tot = nf%man_n_appl_col(c) - nf%man_tan_appl_col(c) ! Use the the same fractionation of organic N as for grazing, after removing the ! "explicitly" calculated TAN. - if (1-fract_tan > 1e-6) then - ndep_org(ind_avail) = org_n_tot * fract_avail / (1-fract_tan) - ndep_org(ind_resist) = org_n_tot * fract_resist / (1-fract_tan) - ndep_org(ind_unavail) = org_n_tot * fract_unavail / (1-fract_tan) - else - ndep_org = 0.0 - end if + ndep_org(ind_avail) = org_n_tot * fract_avail + ndep_org(ind_resist) = org_n_tot * fract_resist + ndep_org(ind_unavail) = org_n_tot * fract_unavail tandep = nf%man_tan_appl_col(c) orgpools(ind_avail) = man_a_app(c) @@ -655,11 +656,11 @@ real(r8) function get_total_n(ns, nf, which) result(total) total = total - sum(nf%nh3_barns_col(soilc)) - sum(nf%man_n_transf_col(soilc)) case('pools_manure') - total = total + sum(ns%tan_g1_col(soilc)) + sum(ns%tan_g2_col(soilc)) + total = total + sum(ns%tan_g1_col(soilc)) + sum(ns%tan_g2_col(soilc)) + sum(ns%tan_g3_col(soilc)) total = total + sum(ns%man_u_grz_col(soilc)) & + sum(ns%man_a_grz_col(soilc)) + sum(ns%man_r_grz_col(soilc)) total = total + sum(ns%tan_s0_col(soilc)) & - + sum(ns%tan_s1_col(soilc)) + sum(ns%tan_s2_col(soilc)) + + sum(ns%tan_s1_col(soilc)) + sum(ns%tan_s2_col(soilc)) + sum(ns%tan_s3_col(soilc)) total = total + sum(ns%man_u_app_col(soilc)) & + sum(ns%man_a_app_col(soilc)) + sum(ns%man_r_app_col(soilc)) From 9292097ffd15ecf113049d36f5895f9ebdfad644 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Thu, 12 Jul 2018 12:34:21 -0600 Subject: [PATCH 023/181] fix typo --- src/biogeochem/CNNDynamicsMod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index 682798bc9b..3f9532d14b 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -390,9 +390,9 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & ! grazing ! - ndep_org(ind_avail) = ngrz(c) * (1.0_r8-tract_tan) * fract_avail - ndep_org(ind_resist) = ngrz(c) * (1.0_r8-tract_tan) * fract_resist - ndep_org(ind_unavail) = ngrz(c) * (1.0_r8-tract_tan) * fract_unavail + ndep_org(ind_avail) = ngrz(c) * (1.0_r8-fract_tan) * fract_avail + ndep_org(ind_resist) = ngrz(c) * (1.0_r8-fract_tan) * fract_resist + ndep_org(ind_unavail) = ngrz(c) * (1.0_r8-fract_tan) * fract_unavail tandep = ngrz(c) * fract_tan orgpools(ind_avail) = man_a_grz(c) From d7445602c8b6d868cce0c6dc54ff0992109e04d4 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Tue, 17 Jul 2018 17:35:25 -0400 Subject: [PATCH 024/181] increased housing/storage emissions --- src/biogeochem/CNNDynamicsMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index 3f9532d14b..123355d3e0 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -759,7 +759,7 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & real(r8) :: fluxes_nitr(4), fluxes_tan(4) ! The fraction of manure applied continuously on grasslands (if present in the gridcell) real(r8), parameter :: fract_continuous = 0.1_r8, kg_to_g = 1e3_r8, max_grazing_fract = 0.3_r8, & - volat_coef_barns = 0.02_r8, volat_coef_stores = 0.02_r8, & + volat_coef_barns = 0.03_r8, volat_coef_stores = 0.025_r8, & tempr_min_grazing = 283.0_r8!!!! begg = bounds%begg; endg = bounds%endg From 5b9473a37d9dd0f663f5e911e6dbab0b9155e505 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Tue, 17 Jul 2018 17:49:28 -0400 Subject: [PATCH 025/181] version without drydep mods --- src/biogeochem/DryDepVelocity.F90 | 124 ++++++------------------------ 1 file changed, 23 insertions(+), 101 deletions(-) diff --git a/src/biogeochem/DryDepVelocity.F90 b/src/biogeochem/DryDepVelocity.F90 index 897bc97b91..603e9d24c4 100644 --- a/src/biogeochem/DryDepVelocity.F90 +++ b/src/biogeochem/DryDepVelocity.F90 @@ -84,10 +84,6 @@ Module DryDepVelocity real(r8), pointer, public :: velocity_patch (:,:) ! Dry Deposition Velocity real(r8), pointer, private :: rs_drydep_patch (:) ! Stomatal resistance associated with dry deposition velocity for Ozone - real(r8), pointer, private :: rsg_drydep_patch (:) ! Stomatal resistance associated with dry deposition velocity for Ozone - real(r8), pointer, private :: rac_drydep_patch (:) ! Stomatal resistance associated with dry deposition velocity for Ozone - real(r8), pointer, private :: ra_drydep_patch (:) ! Stomatal resistance associated with dry deposition velocity for Ozone - real(r8), pointer, private :: rb_drydep_patch (:) ! Stomatal resistance associated with dry deposition velocity for Ozone contains @@ -134,12 +130,7 @@ subroutine InitAllocate(this, bounds) ! Dry Deposition Velocity if ( n_drydep > 0 .and. drydep_method == DD_XLND )then allocate(this%velocity_patch(begp:endp, n_drydep)); this%velocity_patch(:,:) = nan - allocate(this%rs_drydep_patch(begp:endp)) ; this%rs_drydep_patch(:) = nan - allocate(this%rsg_drydep_patch(begp:endp)) ; this%rsg_drydep_patch(:) = nan - allocate(this%rac_drydep_patch(begp:endp)) ; this%rac_drydep_patch(:) = nan - allocate(this%ra_drydep_patch(begp:endp)) ; this%ra_drydep_patch(:) = nan - allocate(this%rb_drydep_patch(begp:endp)) ; this%rb_drydep_patch(:) = nan - + allocate(this%rs_drydep_patch(begp:endp)) ; this%rs_drydep_patch(:) = nan end if end subroutine InitAllocate @@ -176,35 +167,13 @@ subroutine InitHistory(this, bounds) ptr_1d => this%velocity_patch(begp:endp,ispec) call hist_addfld1d ( fname='DRYDEPV_'//trim(drydep_list(ispec)), units='cm/sec', & avgflag='A', long_name='Dry Deposition Velocity', & - ptr_patch=ptr_1d, default='active' ) + ptr_patch=ptr_1d, default='inactive' ) end do this%rs_drydep_patch(begp:endp)= spval call hist_addfld1d ( fname='RS_DRYDEP_O3', units='s/m', & avgflag='A', long_name='Stomatal Resistance Associated with Ozone Dry Deposition Velocity', & - ptr_patch=this%rs_drydep_patch, default='active' ) - - this%rsg_drydep_patch(begp:endp)= spval - call hist_addfld1d ( fname='RSG_DRYDEP_SO2', units='s/m', & - avgflag='A', long_name='Ground Resistance Associated with SO2 Dry Deposition Velocity', & - ptr_patch=this%rsg_drydep_patch, default='active' ) - - this%rac_drydep_patch(begp:endp)= spval - call hist_addfld1d ( fname='RAC_DRYDEP', units='s/m', & - avgflag='A', long_name='Upper canopy resistance for dry dep', & - ptr_patch=this%rac_drydep_patch, default='active' ) - - this%ra_drydep_patch(begp:endp)= spval - call hist_addfld1d ( fname='RA_DRYDEP', units='s/m', & - avgflag='A', long_name='Aerodynamic resistance', & - ptr_patch=this%ra_drydep_patch, default='active' ) - - this%rb_drydep_patch(begp:endp)= spval - call hist_addfld1d ( fname='RB_DRYDEP', units='s/m', & - avgflag='A', long_name='Quasi-laminar layer resistance', & - ptr_patch=this%rb_drydep_patch, default='active' ) - - + ptr_patch=this%rs_drydep_patch, default='inactive' ) end subroutine InitHistory @@ -280,8 +249,7 @@ subroutine depvel_compute( bounds, & logical :: has_dew logical :: has_rain real(r8), parameter :: rain_threshold = 1.e-7_r8 ! of the order of 1cm/day expressed in m/s - real(r8), parameter :: pH = 6.5_r8 ! pH used in scaling solubility-dependent resistances - + ! local arrays: dependent on species only real(r8), dimension(n_drydep) :: rsmx !vegetative resistance (plant mesophyll) real(r8), dimension(n_drydep) :: rclx !lower canopy resistance @@ -292,8 +260,7 @@ subroutine depvel_compute( bounds, & real(r8) :: rc !combined surface resistance real(r8) :: cts !correction to flu rcl and rgs for frost real(r8) :: rlux_o3 !to calculate O3 leaf resistance in dew/rain conditions - real(r8) :: heff_so2 ! effective Henry's law constant for SO2 under the local conditions - real(r8) :: cts2 + ! constants real(r8), parameter :: slope = 0._r8 ! Used to calculate rdc in (lower canopy resistance) integer, parameter :: wveg_unset = -1 ! Unset Wesley vegetation type @@ -333,12 +300,7 @@ subroutine depvel_compute( bounds, & annlai => canopystate_inst%annlai_patch , & ! Input: [real(r8) (:,:) ] 12 months of monthly lai from input data set velocity => drydepvel_inst%velocity_patch , & ! Output: [real(r8) (:,:) ] cm/sec - rs_drydep => drydepvel_inst%rs_drydep_patch , & ! Output: [real(r8) (:) ] stomatal resistance associated with Ozone dry deposition velocity (s/m) - rac_drydep => drydepvel_inst%rac_drydep_patch, & - rsg_drydep => drydepvel_inst%rsg_drydep_patch, & - ra_drydep => drydepvel_inst%ra_drydep_patch, & - rb_drydep => drydepvel_inst%rb_drydep_patch & - + rs_drydep => drydepvel_inst%rs_drydep_patch & ! Output: [real(r8) (:) ] stomatal resistance associated with Ozone dry deposition velocity (s/m) ) !_________________________________________________________________ @@ -486,11 +448,9 @@ subroutine depvel_compute( bounds, & ! land types are computed seperately, then resistance is computed as average of values ! following wesely rc=(1/(rs+rm) + 1/rlu +1/(rdc+rcl) + 1/(rac+rgs))**-1 - !******************************************************* - call seq_drydep_setHCoeff( sfc_temp, 10**(-pH), heff(:n_drydep) ) + call seq_drydep_setHCoeff( sfc_temp, heff(:n_drydep) ) !********************************************************* - heff_so2 = heff(index_so2) species_loop1: do ispec=1, n_drydep if(mapping(ispec) <= 0) cycle @@ -505,24 +465,9 @@ subroutine depvel_compute( bounds, & cts = 1000._r8*exp( -tc - 4._r8 ) !ground resistance - !rgsx(ispec) = 1._r8 / ((heff(ispec) / (1.e5_r8*(rgss(index_season,wesveg)+cts))) + & - ! (foxd(ispec)/(rgso(index_season,wesveg)+cts))) + rgsx(ispec) = 1._r8/((heff(ispec)/(1.e5_r8*(rgss(index_season,wesveg)+cts))) + & + (foxd(ispec)/(rgso(index_season,wesveg)+cts))) - !rgsx(ispec) = 1._r8/((heff(ispec)/(1.e5_r8*(rgss(index_season,wesveg)))) + & - ! (foxd(ispec)/(rgso(index_season,wesveg)))) - - !rgsx(ispec) = 1._r8/((heff(ispec)/(heff_so2*(rgss(index_season,wesveg) + cts))) + & - ! (foxd(ispec)/(rgso(index_season,wesveg) + cts))) - - if (tc < -1) then - cts2 = min(2.0_r8, exp(0.2*(-1.0_r8 - tc))) - else - cts2 = 1.0_r8 - end if - rgsx(ispec) = cts2 / ((heff(ispec)/(heff_so2*(rgss(index_season,wesveg)))) + & - (foxd(ispec)/(rgso(index_season,wesveg)))) - - !------------------------------------------------------------------------------------- ! special case for H2 and CO;; CH4 is set ot a fraction of dv(H2) !------------------------------------------------------------------------------------- @@ -579,19 +524,13 @@ subroutine depvel_compute( bounds, & ! Leaf resistance !MVM: adjusted rlu by LAI to get leaf resistance over bulk canopy (gao and wesely, 1995) - !rlu_lai=cts+rlu(index_season,wesveg)/elai(pi) - !rlux(ispec) = rlu_lai/(1.e-5_r8*heff(ispec)+foxd(ispec)) - - rlu_lai = rlu(index_season,wesveg)/elai(pi) - rlux(ispec) = cts2 * rlu_lai / (heff(ispec)/heff_so2 + foxd(ispec)) + rlu_lai=cts+rlu(index_season,wesveg)/elai(pi) + rlux(ispec) = rlu_lai/(1.e-5_r8*heff(ispec)+foxd(ispec)) !Lower canopy resistance - !rclx(ispec) = 1._r8/((heff(ispec)/(1.e5_r8*(rcls(index_season,wesveg)+cts))) + & - ! (foxd(ispec)/(rclo(index_season,wesveg)+cts))) - rclx(ispec) = cts2 / ((heff(ispec)/(heff_so2*(rcls(index_season,wesveg)))) + & - (foxd(ispec)/(rclo(index_season,wesveg)))) + rclx(ispec) = 1._r8/((heff(ispec)/(1.e5_r8*(rcls(index_season,wesveg)+cts))) + & + (foxd(ispec)/(rclo(index_season,wesveg)+cts))) - !----------------------------------- !mvm 11/30/2013: special case for CO !Dry deposition of CO and hydrocarbons is negligibly @@ -635,11 +574,8 @@ subroutine depvel_compute( bounds, & ! non_freezing: if(sfc_temp.gt.tmelt) then if( has_dew ) then - !rlu_lai=cts+rlu(index_season,wesveg)/elai(pi) - !rlux_o3 = 1._r8/((1._r8/3000._r8)+(1._r8/(3._r8*rlu_lai))) - - rlu_lai=rlu(index_season,wesveg)/elai(pi) - rlux_o3 = cts2/((1._r8/3000._r8)+(1._r8/(3._r8*rlu_lai))) + rlu_lai=cts+rlu(index_season,wesveg)/elai(pi) + rlux_o3 = 1._r8/((1._r8/3000._r8)+(1._r8/(3._r8*rlu_lai))) if (index_o3 > 0) then rlux(index_o3) = rlux_o3 @@ -650,10 +586,8 @@ subroutine depvel_compute( bounds, & endif if(has_rain) then - !rlu_lai=cts+rlu(index_season,wesveg)/elai(pi) - !rlux_o3 = 1._r8/((1._r8/1000._r8)+(1._r8/(3._r8*rlu_lai))) - rlu_lai=rlu(index_season,wesveg)/elai(pi) - rlux_o3 = cts2 / ((1._r8/1000._r8)+(1._r8/(3._r8*rlu_lai))) + rlu_lai=cts+rlu(index_season,wesveg)/elai(pi) + rlux_o3 = 1._r8/((1._r8/1000._r8)+(1._r8/(3._r8*rlu_lai))) if (index_o3 > 0) then rlux(index_o3) = rlux_o3 @@ -668,13 +602,9 @@ subroutine depvel_compute( bounds, & if(ispec.ne.index_o3.and.ispec.ne.index_o3a.and.ispec.ne.index_so2) then if( has_dew .or. has_rain) then - !rlu_lai=cts+rlu(index_season,wesveg)/elai(pi) - !rlux(ispec)=1._r8/((1._r8/(3._r8*rlu_lai))+ & - ! (1.e-7_r8*heff(ispec))+(foxd(ispec)/rlux_o3)) - rlu_lai = rlu(index_season,wesveg)/elai(pi) - rlux(ispec) = cts / ((1._r8/(3._r8*rlu_lai))+ & - (1.e-7_r8*heff(ispec)) + (foxd(ispec)/rlux_o3)) - + rlu_lai=cts+rlu(index_season,wesveg)/elai(pi) + rlux(ispec)=1._r8/((1._r8/(3._r8*rlu_lai))+ & + (1.e-7_r8*heff(ispec))+(foxd(ispec)/rlux_o3)) endif elseif(ispec.eq.index_so2) then @@ -684,12 +614,8 @@ subroutine depvel_compute( bounds, & endif if(has_rain) then - !rlu_lai=cts+rlu(index_season,wesveg)/elai(pi) - !rlux(ispec) = 1._r8/((1._r8/5000._r8)+(1._r8/(3._r8*rlu_lai))) - - rlu_lai=rlu(index_season,wesveg)/elai(pi) - rlux(ispec) = cts2 / ((1._r8/5000._r8)+(1._r8/(3._r8*rlu_lai))) - + rlu_lai=cts+rlu(index_season,wesveg)/elai(pi) + rlux(ispec) = 1._r8/((1._r8/5000._r8)+(1._r8/(3._r8*rlu_lai))) endif if( has_dew .or. has_rain ) then @@ -737,11 +663,7 @@ subroutine depvel_compute( bounds, & case ( 'CB1', 'CB2', 'OC1', 'OC2', 'SOAM', 'SOAI', 'SOAT', 'SOAB', 'SOAX' ) velocity(pi,ispec) = 0.10_r8 case ( 'SO2' ) - velocity(pi,ispec) = (1._r8/(ram1(pi)+rb1(pi)+rc))*100._r8 - rsg_drydep(pi) = rgsx(ispec) - rac_drydep(pi) = rac(index_season,wesveg) - ra_drydep(pi) = ram1(pi) - rb_drydep(pi) = rb1(pi) + velocity(pi,ispec) = (1._r8/(ram1(pi)+rb1(pi)+rc))*200._r8 case default velocity(pi,ispec) = (1._r8/(ram1(pi)+rb1(pi)+rc))*100._r8 end select From feba86dad67a4fc12186076d79685410e92503fe Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Thu, 19 Jul 2018 20:10:23 -0400 Subject: [PATCH 026/181] output field for manure in barns --- src/biogeochem/CNNDynamicsMod.F90 | 9 +++++++-- src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 | 10 +++++++++- 2 files changed, 16 insertions(+), 3 deletions(-) diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index 123355d3e0..58e73cea45 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -308,6 +308,7 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & nf%man_n_grz_col, nf%man_n_mix_col, & nf%nh3_stores_col, nf%nh3_barns_col, & nf%man_n_transf_col, ns%fan_grz_fract_col, & + nf%man_n_barns_col, & fract_tan, & filter_soilc, num_soilc) @@ -711,7 +712,7 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & n_manure_spread_col, tan_manure_spread_col, & n_manure_graze_col, n_manure_mixed_col, & nh3_flux_stores, nh3_flux_barns, man_n_transf, & - grz_fract, tan_fract_excr, & + grz_fract, man_n_barns, tan_fract_excr, & filter_soilc, num_soilc) use landunit_varcon, only : max_lunit use pftconMod, only : nc4_grass, nc3_nonarctic_grass @@ -743,6 +744,7 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & real(r8), intent(out) :: nh3_flux_stores(bounds%begc:bounds%endc), nh3_flux_barns(bounds%begc:bounds%endc) ! total nitrogen flux transferred out of a crop column real(r8), intent(out) :: man_n_transf(bounds%begc:bounds%endc) + real(r8), intent(out) :: man_n_barns(bounds%begc:bounds%endc) ! fraction of manure excreted when grazing real(r8), intent(out) :: grz_fract(bounds%begc:bounds%endc) ! TAN fraction in excreted N @@ -765,7 +767,8 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & begg = bounds%begg; endg = bounds%endg nh3_flux_stores(bounds%begc:bounds%endc) = 0_r8 nh3_flux_barns(bounds%begc:bounds%endc) = 0_r8 - + man_n_barns(bounds%begc:bounds%endc) = 0.0_r8 + totalinput = 0.0 cumflux = 0.0 @@ -840,6 +843,8 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & end if flux_grass_graze = flux_grass_graze + flux_grazing*col%wtgcell(c) + man_n_barns(c) = flux_avail + call eval_fluxes_storage(flux_avail, tempr_ave, windspeed_ave, 0.0_r8, & volat_coef_barns, volat_coef_stores, tan_fract_excr, fluxes_nitr, fluxes_tan, status) if (any(fluxes_nitr > 1e12)) then diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 index 1fb897eb97..7e79ee0ac3 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 @@ -77,6 +77,7 @@ module SoilBiogeochemNitrogenFluxType real(r8), pointer :: man_n_appl_col (:) ! Manure N (TAN+organic) applied on soil (gN/m2/s) real(r8), pointer :: man_n_grz_col (:) ! Manure N from grazing animals (gN/m2/s) real(r8), pointer :: man_n_mix_col (:) ! Manure N from produced in mixed systems (gN/m2/s) + real(r8), pointer :: man_n_barns_col (:) ! Manure N from produced in animal housings (gN/m2/s) real(r8), pointer :: fert_n_appl_col (:) ! Fertilizer N applied on soil (gN/m2/s) real(r8), pointer :: otherfert_n_appl_col (:) ! Non-urea fertilizer N applied on soil (gN/m2/s) real(r8), pointer :: man_n_transf_col (:) ! Manure N removed from the crop column (into the natural veg. column in the gcell) @@ -296,6 +297,7 @@ subroutine InitAllocate(this, bounds) allocate(this%man_n_appl_col (begc:endc)) ; this%man_n_appl_col (:) = spval allocate(this%man_n_grz_col (begc:endc)) ; this%man_n_grz_col (:) = spval allocate(this%man_n_mix_col (begc:endc)) ; this%man_n_mix_col (:) = spval + allocate(this%man_n_barns_col (begc:endc)) ; this%man_n_barns_col (:) = spval allocate(this%fert_n_appl_col (begc:endc)) ; this%fert_n_appl_col (:) = spval allocate(this%otherfert_n_appl_col (begc:endc)) ; this%otherfert_n_appl_col (:) = spval allocate(this%man_n_transf_col (begc:endc)) ; this%man_n_transf_col (:) = spval @@ -588,7 +590,12 @@ subroutine InitHistory(this, bounds) call hist_addfld1d( fname='MAN_N_MIX', units='gN/m^2/s', & avgflag='A', long_name='Manure N in produced mixed systems', & ptr_col=this%man_n_mix_col) - + + this%man_n_barns_col(begc:endc) = spval + call hist_addfld1d( fname='MAN_N_BARNS', units='gN/m^2/s', & + avgflag='A', long_name='Manure N in produced barns', & + ptr_col=this%man_n_barns_col) + this%fert_n_appl_col(begc:endc) = spval call hist_addfld1d( fname='FERT_N_APP', units='gN/m^2/s', & avgflag='A', long_name='Fertilizer N applied on soil', & @@ -1462,6 +1469,7 @@ subroutine SetValues ( this, & this%man_n_appl_col(i) = value_column this%man_n_grz_col(i) = value_column this%man_n_mix_col(i) = value_column + this%man_n_barns_col(i) = value_column this%fert_n_appl_col(i) = value_column this%otherfert_n_appl_col(i) = value_column this%man_n_transf_col(i) = value_column From 2a408afd42ea9c5a62b2c4becff9f66f5db08e81 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Tue, 14 Aug 2018 16:46:46 -0400 Subject: [PATCH 027/181] changed the flux formulations to what compost.py gives --- src/biogeochem/FanMod.F90 | 165 +++++++++++++++++++++++++++++++------- 1 file changed, 135 insertions(+), 30 deletions(-) diff --git a/src/biogeochem/FanMod.F90 b/src/biogeochem/FanMod.F90 index 978c3e8af0..fbf1bc61ca 100755 --- a/src/biogeochem/FanMod.F90 +++ b/src/biogeochem/FanMod.F90 @@ -312,6 +312,53 @@ real(r8) function get_henry_eff(tg, Hconc) result(henry) end function get_henry_eff + subroutine partition_tan(tg, Hconc, theta, air, KNH3, fract_nh4) + implicit none + real(r8), intent(in) :: tg ! soil temperature, K + real(r8), intent(in) :: Hconc ! H+ concentration, mol / l + real(r8), intent(in) :: theta ! water volume fraction + real(r8), intent(in) :: air ! air volume fraction + + real(r8), optional, intent(out) :: fract_nh4 ! mass fraction of NH4 + real(r8), intent(out) :: KNH3 ! ratio of concentrations [NH3 (gas)] / [NH3+NH4 (aq)] + + real(r8) :: KNH4, HNH3, cnc_aq, fract_aq + real(r8), parameter :: Tref = 298.15_r8 + + KNH4 = 5.67_r8 * 1e-10_r8 * exp(-6286.0_r8 * (1.0_r8/Tg - 1.0_r8/Tref)) + ! HNH3 = [aq] / [gas] -- solubility + HNH3 = 4.59_r8 * Tg * exp(4092_r8 * (1.0_r8/Tg - 1.0_r8/Tref)) + + KNH3 = KNH4 / (HNH3*(KNH4 + Hconc)) + + fract_aq = theta / (air*KNH3 + theta) + if (present(fract_nh4)) fract_nh4 = fract_aq * Hconc / (KNH4 + Hconc) + !if (present(fract_nh3g)) fract_nh3g = air * KNH3 / (air*KNH3 + theta) + !if (present(fract_nh3aq)) fract_nh3aq = fract_aq * (1.0_r8 - Hconc / (KNH4 + Hconc)) + + end subroutine partition_tan + + real(r8) function get_tan_volat(tg, Hconc) result(ratio) + ! Evaluate the ratio + ! KNH3 = [NH3 (gas)] / [NH3+NH4 (aq)] + ! given a fixed H+ concentration in the solution. Higher ratio means higher + ! volatility (as opposed to usual definition of Henry's law constants as + ! solubilities). This is convenient because then non-volatile substances are obtained + ! by setting KNH3 = 0. + real(r8), intent(in) :: tg ! soil temperature, K + real(r8), intent(in) :: Hconc ! H+ concentration, mol / l + + real(r8) :: KNH4, HNH3 + real(r8), parameter :: Tref = 298.15_r8 + + KNH4 = 5.67_r8 * 1e-10_r8 * exp(-6286.0_r8 * (1.0_r8/Tg - 1.0_r8/Tref)) + ! HNH3 = [aq] / [gas] -- solubility + HNH3 = 4.59_r8 * Tg * exp(4092_r8 * (1.0_r8/Tg - 1.0_r8/Tref)) + + ratio = KNH4 / (HNH3*(KNH4 + Hconc)) + + end function get_tan_volat + real(r8) function eval_no3prod(theta, Tg, Hconc) result(kNO3) ! Evaluate nitrification rate as in the Riddick et al. (2016) paper. real(r8), intent(in) :: theta ! volumetric soil water m/m @@ -350,6 +397,42 @@ real(r8) function eval_no3prod(theta, Tg, Hconc) result(kNO3) kNO3 = 2.0_r8 * rmax * mNH4 / (1.0_r8/stf + 1.0_r8/smrf) end function eval_no3prod + + real(r8) function eval_no3prod_v2(theta, Tg) result(kNO3) + ! Evaluate nitrification rate as in the Riddick et al. (2016) paper but for NH4. + ! Partitioning between TAN forms is not included. + real(r8), intent(in) :: theta ! volumetric soil water m/m + real(r8), intent(in) :: Tg ! soil temperature, K + + real(r8) :: stf, wmr, smrf, mNH4 + + real(r8), parameter :: soil_dens = 1050.0_r8 ! Soil density, kg/m3 + real(r8), parameter :: water_dens = 1000.0_r8 + real(r8), parameter :: rmax = 1.16e-6_r8 ! Maximum rate of nitrification, s-1 + real(r8), parameter :: tmax = 313.0 ! Maximm temperature of microbial activity, K + real(r8), parameter :: topt = 301.0 ! Optimal temperature of microbial acticity, K + real(r8), parameter :: asg = 2.4_8 ! a_sigma, empirical factor + real(r8), parameter :: wmr_crit = 0.12_r8 ! Critical water content, g/g + real(r8), parameter :: smrf_b = 2 ! Parameter in soil moisture response function + real(r8), parameter :: Tref = 298.15_r8 + + mNH4 = 1.0_r8 + + ! soil temperature function + stf = (max(1e-3_r8, tmax-Tg) / (tmax-topt))**asg * exp(asg * (Tg-topt)/(tmax-topt)) + + ! gravimetric soil water + wmr = theta * water_dens / soil_dens + + ! soil moisture response function + + smrf = 1.0_r8 - exp(-(wmr/wmr_crit)**smrf_b) + !if stf < 1e-9 or smrf < 1e-9: + ! print theta + ! 1/0 + kNO3 = 2.0_r8 * rmax * mNH4 / (1.0_r8/stf + 1.0_r8/smrf) + + end function eval_no3prod_v2 subroutine eval_fluxes_slurry(water, mtan, Hconc, tg, ratm, theta, thetasat, perc, runoff, cnc_nh3_air, fluxes) ! Evaluate nitrogen fluxes for a partly infiltrated layer of slurry. @@ -370,7 +453,7 @@ subroutine eval_fluxes_slurry(water, mtan, Hconc, tg, ratm, theta, thetasat, per !real(r8), intent(in) :: dt ! timestep real(r8) :: water_tot, cnc, air, depth_soilsat, diffusivity_water, diffusivity_satsoil, halfwater, insoil, r1, dz2 - real(r8) :: r2, volat_rate, kno3, henry_eff, depth_lower + real(r8) :: r2, volat_rate, kno3, henry_eff, depth_lower, fract_nh4 water_tot = water(1) + water(2) @@ -407,13 +490,14 @@ subroutine eval_fluxes_slurry(water, mtan, Hconc, tg, ratm, theta, thetasat, per !print *, 'r2', r2, diffusivity_satsoil, dz2, depth_soilsat fluxes(iflx_soild) = cnc / r2 - henry_eff = get_henry_eff(tg, Hconc) + !henry_eff = get_henry_eff(tg, Hconc) + call partition_tan(tg, Hconc, 1.0_r8, 0.0_r8, henry_eff, fract_nh4=fract_nh4) volat_rate = 1.0_r8 / (r1 + ratm / henry_eff) ! conductance from aqueous TAN in slurry to NH3 in atmosphere - fluxes(iflx_air) = max(volat_rate*(cnc - cnc_nh3_air), 0.0_r8) + fluxes(iflx_air) = volat_rate*cnc ! nitrification kno3 = eval_no3prod(thetasat, tg, Hconc) - fluxes(iflx_no3) = kno3 * mtan + fluxes(iflx_no3) = kno3 * mtan * fract_nh4 !fluxes(3:) = 0 @@ -526,9 +610,9 @@ subroutine eval_fluxes_soilroff(mtan, water_manure, Hconc, tg, ratm, theta, thet integer, intent(in) :: substance ! subst_tan or subst_urea. integer, intent(out) :: status ! error flag - real(r8) :: water_tot, cnc, air, henry_eff, dsl, dsg, dstot, dz2, no3_rate, volat_rate, theta_tot, beta - real(r8) :: cnc_srfg, cnc_srfaq, cnc_soilaq, cnc_soilg, dz, rsl, rsg, qrf + real(r8) :: cnc_srfg, cnc_srfaq, cnc_soilaq, cnc_soilg, dz, rsl, rsg + real(r8) :: fract_gas, fract_nh3aq, fract_nh4, fract_aq, volatility water_tot = water_manure + theta*soildepth if (water_tot < 1e-9) then @@ -543,47 +627,39 @@ subroutine eval_fluxes_soilroff(mtan, water_manure, Hconc, tg, ratm, theta, thet end if cnc = mtan / soildepth - qrf = runoff air = thetasat - theta_tot - beta = 0.0 dz = 0.5*soildepth dsl = eval_diffusivity_liq_mq(theta_tot, thetasat, Tg) dsg = eval_diffusivity_gas_mq(theta_tot, thetasat, Tg) + + !dsl = eval_diffusivity_liq_m03(theta_tot, thetasat, Tg) + !dsg = eval_diffusivity_gas_m03(theta_tot, thetasat, Tg) + rsg = dz / (dsg*air) rsl = dz / (dsl*theta_tot) if (substance == subst_tan) then - henry_eff = get_henry_eff(tg, Hconc) - no3_rate = eval_no3prod(theta_tot, tg, Hconc) - cnc_soilg = cnc / (theta_tot/henry_eff + air) + call partition_tan(tg, Hconc, theta_tot, air, volatility, fract_nh4=fract_nh4) + no3_rate = eval_no3prod_v2(theta_tot, tg)*fract_nh4 else if (substance == subst_urea) then - henry_eff = 0.0 + volatility = 0.0 no3_rate = 0.0_r8 - cnc_soilg = 0.0_r8 else status = err_bad_subst return end if - - cnc_srfg = (henry_eff * ratm * cnc * (henry_eff*rsl + rsg)) & - / (air*henry_eff**2*rsl*(ratm + rsg) + air*henry_eff*ratm*rsg*(qrf*rsl + 1) & - + henry_eff*rsl*theta_tot*(ratm + rsg) + ratm*rsg*theta_tot*(qrf*rsl + 1)) - - cnc_srfaq = ratm * cnc * (henry_eff*rsl + rsg)& - / (air*henry_eff**2*rsl*(ratm + rsg) + air*henry_eff*ratm*rsg*(qrf*rsl + 1) & - + henry_eff*rsl*theta_tot*(ratm + rsg) + ratm*rsg*theta_tot*(qrf*rsl + 1)) + call get_srf_cnc(volatility, cnc, cnc_nh3_air, rsg, rsl, Ratm, runoff, theta_tot, air, cnc_srfg, cnc_srfaq) + fluxes(iflx_air) = cnc_srfg / ratm fluxes(iflx_roff) = runoff * cnc_srfaq - dstot = dsl*theta_tot + dsg*henry_eff*air dz2 = soildepth_reservoir - 0.5 * soildepth - - cnc_soilaq = cnc / (theta_tot + air*henry_eff) - - fluxes(iflx_soild) = (cnc_soilaq * dsl) / dz2 + (cnc_soilg * dsg) / dz2 + cnc_soilaq = cnc / (theta_tot + air*volatility) + cnc_soilg = cnc_soilaq*volatility + fluxes(iflx_soild) = (cnc_soilaq * dsl*theta_tot) / dz2 + (cnc_soilg * dsg*air) / dz2 fluxes(iflx_no3) = mtan * no3_rate fluxes(iflx_soilq) = cnc_soilaq * perc @@ -591,6 +667,32 @@ subroutine eval_fluxes_soilroff(mtan, water_manure, Hconc, tg, ratm, theta, thet status = 0 !fluxes(4:) = 0 + contains + + subroutine get_srf_cnc(knh3, xs, xag, Rsg, Rsl, Rag, qr, theta, air, cnc_gas, cnc_aq) + real(r8), intent(in) :: knh3 ! volatility + real(r8), intent(in) :: xag ! cnc_atm_gas + real(r8), intent(in) :: qr ! runoff m/s + real(r8), intent(in) :: Rag ! Ratm + real(r8), intent(in) :: xs ! mass / m3 soil + real(r8), intent(in) :: Rsg, Rsl, theta, air + + real(r8), intent(out) :: cnc_gas, cnc_aq + + real(r8) :: x0, x1, x2, x3 + + x0 = Rag*xs + x1 = Rsl*knh3 + x2 = Rsl*theta + x3 = (Rsg*air*x1*xag + Rsg*x0 + Rsg*x2*xag + x0*x1) & + / (Rag*Rsg*(air*knh3 + air*qr*x1 + qr*x2 + theta) & + + knh3*(Rag + Rsg)*(-Rsg*air + air*(Rsg + x1) + x2)) + + cnc_aq = x3 + cnc_gas = knh3*x3 + + end subroutine get_srf_cnc + end subroutine eval_fluxes_soilroff @@ -618,7 +720,7 @@ subroutine eval_fluxes_soil_3p(mtan, water_manure, Hconc, tg, ratm, theta, theta integer, intent(out) :: status ! error flag - real(r8) :: water_tot, cnc, air, henry_eff, dsl, dsg, dstot, dz2, no3_rate, volat_rate, theta_tot, beta + real(r8) :: water_tot, cnc, air, henry_eff, dsl, dsg, dstot, dz2, no3_rate, volat_rate, theta_tot real(r8) :: part_liq, part_gas, part_nh4, part_solid, part_avail water_tot = water_manure + theta*soildepth @@ -636,7 +738,6 @@ subroutine eval_fluxes_soil_3p(mtan, water_manure, Hconc, tg, ratm, theta, theta cnc = mtan / water_tot air = thetasat - theta_tot - beta = 0.0 dz2 = soildepth_reservoir - 0.5 * soildepth if (substance == subst_tan) then @@ -1011,7 +1112,10 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend !print *, tanpools(indpl), water_soil, Hconc(indpl), tg, & ! & ratm, theta, thetasat, percolation, runoff, cnc_nh3_air, & ! & dz_layer - call eval_fluxes_soil(tanpools(indpl), water_soil, Hconc(indpl), tg, & + !call eval_fluxes_soil(tanpools(indpl), water_soil, Hconc(indpl), tg, & + ! & ratm, theta, thetasat, percolation, runoff, cnc_nh3_air, & + ! & dz_layer, fluxes(:,indpl), subst_tan, status) + call eval_fluxes_soilroff(tanpools(indpl), water_soil, Hconc(indpl), tg, & & ratm, theta, thetasat, percolation, runoff, cnc_nh3_air, & & dz_layer, fluxes(:,indpl), subst_tan, status) if (status /= 0) return @@ -1463,9 +1567,10 @@ subroutine update_urea(tg, theta, thetasat, precip, evap, watertend, runoff, & age_prev = 0 do indpl = 1, numpools percolation = eval_perc(0.0_r8, evap, precip, watertend, ranges(indpl)) + ! in the following, atmospheric concentration should be 0 not missing! call eval_fluxes_soilroff(pools(indpl), 0.0_r8, missing, tg, & !call eval_fluxes_soil(pools(indpl), 0.0_r8, missing, tg, & - & missing, theta, thetasat, percolation, runoff, missing, & + & missing, theta, thetasat, percolation, runoff, 0.0_r8, & & dz_layer, fluxes(1:5,indpl), subst_urea, status) if (status /= 0) then return From 615c290c2f841f14406e4e16172dcaf5ad14af1a Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Fri, 9 Nov 2018 15:25:22 -0500 Subject: [PATCH 028/181] fix indent --- src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 index 7e79ee0ac3..136d644250 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 @@ -77,7 +77,7 @@ module SoilBiogeochemNitrogenFluxType real(r8), pointer :: man_n_appl_col (:) ! Manure N (TAN+organic) applied on soil (gN/m2/s) real(r8), pointer :: man_n_grz_col (:) ! Manure N from grazing animals (gN/m2/s) real(r8), pointer :: man_n_mix_col (:) ! Manure N from produced in mixed systems (gN/m2/s) - real(r8), pointer :: man_n_barns_col (:) ! Manure N from produced in animal housings (gN/m2/s) + real(r8), pointer :: man_n_barns_col (:) ! Manure N from produced in animal housings (gN/m2/s) real(r8), pointer :: fert_n_appl_col (:) ! Fertilizer N applied on soil (gN/m2/s) real(r8), pointer :: otherfert_n_appl_col (:) ! Non-urea fertilizer N applied on soil (gN/m2/s) real(r8), pointer :: man_n_transf_col (:) ! Manure N removed from the crop column (into the natural veg. column in the gcell) From 5d51bd1a951009f6ffa995ed537d2441a51791ea Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Fri, 9 Nov 2018 15:26:40 -0500 Subject: [PATCH 029/181] soilwater tendency for fan --- src/biogeophys/HydrologyNoDrainageMod.F90 | 27 ++++++++++++++++++++++- src/biogeophys/WaterStateType.F90 | 18 +++++++++++---- 2 files changed, 40 insertions(+), 5 deletions(-) diff --git a/src/biogeophys/HydrologyNoDrainageMod.F90 b/src/biogeophys/HydrologyNoDrainageMod.F90 index 64e4d9583d..2c58786816 100644 --- a/src/biogeophys/HydrologyNoDrainageMod.F90 +++ b/src/biogeophys/HydrologyNoDrainageMod.F90 @@ -202,10 +202,13 @@ subroutine HydrologyNoDrainage(bounds, & filter_hydrologyc, soilstate_inst, canopystate_inst, waterflux_inst, energyflux_inst) if ( use_fates ) call clm_fates%ComputeRootSoilFlux(bounds, num_hydrologyc, filter_hydrologyc, soilstate_inst, waterflux_inst) - + !if ( use_fan ) call store_tsl_moisture(waterstate_inst) + if ( .true. ) call store_tsl_moisture(waterstate_inst) call SoilWater(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, filter_urbanc, & soilhydrology_inst, soilstate_inst, waterflux_inst, waterstate_inst, temperature_inst, & canopystate_inst, energyflux_inst, soil_water_retention_curve) + !if ( use_fan ) call eval_tsl_moist_tend(waterstate_inst) + if ( .true. ) call eval_tsl_moist_tend(waterstate_inst) if (use_vichydro) then ! mapping soilmoist from CLM to VIC layers for runoff calculations @@ -596,6 +599,28 @@ subroutine HydrologyNoDrainage(bounds, & end associate + + contains + + subroutine store_tsl_moisture(waterstate_inst) + type(waterstate_type), intent(inout) :: waterstate_inst + print *, 'store flux' + associate(h2osoi_tend_tsl => waterstate_inst%h2osoi_tend_tsl_col(bounds%begc:bounds%endc), & + h2osoi_liq_tsl => waterstate_inst%h2osoi_liq_col(bounds%begc:bounds%endc,1)) + h2osoi_tend_tsl = h2osoi_liq_tsl + end associate + end subroutine store_tsl_moisture + + subroutine eval_tsl_moist_tend(waterstate_inst) + type(waterstate_type), intent(inout) :: waterstate_inst + print *, 'eval tend' + associate(h2osoi_tend_tsl => waterstate_inst%h2osoi_tend_tsl_col(bounds%begc:bounds%endc), & + h2osoi_liq_tsl => waterstate_inst%h2osoi_liq_col(bounds%begc:bounds%endc,1)) + h2osoi_tend_tsl = (h2osoi_liq_tsl - h2osoi_tend_tsl) / dtime + end associate + print *, 'done' + end subroutine eval_tsl_moist_tend + end subroutine HydrologyNoDrainage end Module HydrologyNoDrainageMod diff --git a/src/biogeophys/WaterStateType.F90 b/src/biogeophys/WaterStateType.F90 index fe4f7dcc2b..ab28b88ed9 100644 --- a/src/biogeophys/WaterStateType.F90 +++ b/src/biogeophys/WaterStateType.F90 @@ -44,7 +44,8 @@ module WaterstateType real(r8), pointer :: h2osoi_liqice_10cm_col (:) ! col liquid water + ice lens in top 10cm of soil (kg/m2) !KO real(r8), pointer :: h2osoi_liqice_5cm_col (:) ! col liquid water + ice lens in top 5cm of soil (kg/m2) -!KO + !KO + real(r8), pointer :: h2osoi_tend_tsl_col (:) ! col moisture tendency due to vertical movement at topmost layer (m3/m3/s) real(r8), pointer :: h2osoi_vol_col (:,:) ! col volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] (nlevgrnd) real(r8), pointer :: air_vol_col (:,:) ! col air filled porosity real(r8), pointer :: h2osoi_liqvol_col (:,:) ! col volumetric liquid water content (v/v) @@ -191,9 +192,12 @@ subroutine InitAllocate(this, bounds) allocate(this%h2osoi_liqice_10cm_col (begc:endc)) ; this%h2osoi_liqice_10cm_col (:) = nan !KO if ( use_fan ) then - allocate(this%h2osoi_liqice_5cm_col (begc:endc)) ; this%h2osoi_liqice_5cm_col (:) = nan + allocate(this%h2osoi_liqice_5cm_col (begc:endc)) ; this%h2osoi_liqice_5cm_col (:) = nan + end if -!KO + !KO + allocate(this%h2osoi_tend_tsl_col (begc:endc)) ; this%h2osoi_tend_tsl_col (:) = nan + allocate(this%h2osoi_vol_col (begc:endc, 1:nlevgrnd)) ; this%h2osoi_vol_col (:,:) = nan allocate(this%air_vol_col (begc:endc, 1:nlevgrnd)) ; this%air_vol_col (:,:) = nan allocate(this%h2osoi_liqvol_col (begc:endc,-nlevsno+1:nlevgrnd)) ; this%h2osoi_liqvol_col (:,:) = nan @@ -324,8 +328,14 @@ subroutine InitHistory(this, bounds) call hist_addfld1d (fname='SOILWATER_5CM', units='kg/m2', & avgflag='A', long_name='soil liquid water + ice in top 5cm of soil (veg landunits only)', & ptr_col=this%h2osoi_liqice_5cm_col, set_urb=spval, set_lake=spval, l2g_scale_type='veg') + end if -!KO + !KO + this%h2osoi_tend_tsl_col(begc:endc) = spval + call hist_addfld1d (fname='SOILWATERTEND_TSL', units='m3/m3/s', & + avgflag='A', long_name='tsl tendency for fan', & + ptr_col=this%h2osoi_tend_tsl_col, set_urb=spval, set_lake=spval, l2g_scale_type='veg') + this%h2osoi_liq_tot_col(begc:endc) = spval call hist_addfld1d (fname='TOTSOILLIQ', units='kg/m2', & avgflag='A', long_name='vertically summed soil liquid water (veg landunits only)', & From 1514aeddb28f0f12fb532466c4929d7a98bb0b4d Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Fri, 9 Nov 2018 17:41:27 -0500 Subject: [PATCH 030/181] initialize fan-watertend in coldstart --- src/biogeophys/WaterStateType.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/biogeophys/WaterStateType.F90 b/src/biogeophys/WaterStateType.F90 index ab28b88ed9..c1e0ea830b 100644 --- a/src/biogeophys/WaterStateType.F90 +++ b/src/biogeophys/WaterStateType.F90 @@ -841,6 +841,8 @@ subroutine InitCold(this, bounds, & end if end do end if + if (use_fan) this%h2osoi_tend_tsl_col(c) = 0.0_r8 + end do From a9fd431744f0287080403cbdbcfa33affa047052 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Fri, 9 Nov 2018 17:42:48 -0500 Subject: [PATCH 031/181] using watertend in cnndep (commented out0 --- src/biogeochem/CNNDynamicsMod.F90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index 58e73cea45..be2f21268d 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -378,7 +378,11 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & ! tendency. However, it is unclear how to do this in a numerically consistent ! way. Following a naive finite differencing approach led to worse agreement in ! stand-alone simulations so the term is currenltly neglected here. - watertend = 0.0_r8 + watertend = 0.0_r8 + + ! Try using watertend evaluated in waterstatetype: + ! watertend = waterstate_inst%h2osoi_tend_tsl_col(c) + tg = temperature_inst%t_grnd_col(c) theta = waterstate_inst%h2osoi_vol_col(c,1) thetasat = soilstate_inst%watsat_col(c,1) From 3861750569438fd70219998b449ae8fd1f1a4237 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Mon, 3 Dec 2018 14:30:39 -0500 Subject: [PATCH 032/181] tsl tendency unit --- src/biogeophys/WaterStateType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/biogeophys/WaterStateType.F90 b/src/biogeophys/WaterStateType.F90 index c1e0ea830b..7b63aefdc2 100644 --- a/src/biogeophys/WaterStateType.F90 +++ b/src/biogeophys/WaterStateType.F90 @@ -332,7 +332,7 @@ subroutine InitHistory(this, bounds) end if !KO this%h2osoi_tend_tsl_col(begc:endc) = spval - call hist_addfld1d (fname='SOILWATERTEND_TSL', units='m3/m3/s', & + call hist_addfld1d (fname='SOILWATERTEND_TSL', units='kg/m2/s', & avgflag='A', long_name='tsl tendency for fan', & ptr_col=this%h2osoi_tend_tsl_col, set_urb=spval, set_lake=spval, l2g_scale_type='veg') From 00442aa25bc7d60a9a23698b68727348355ee1b0 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 2 Jan 2019 18:40:51 -0500 Subject: [PATCH 033/181] fan physics updates + 3-way manure split --- src/biogeochem/CNNDynamicsMod.F90 | 85 ++++----- src/biogeochem/FanMod.F90 | 305 +++++++++++++++++++++++------- src/main/atm2lndType.F90 | 23 ++- src/main/fanStreamMod.F90 | 60 ++++-- 4 files changed, 342 insertions(+), 131 deletions(-) diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index be2f21268d..1ff219f062 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -175,10 +175,10 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & integer :: c, g, patchcounter, p, status, c1, c2, l, fc, ind_substep real(r8) :: dt, ndep_org(3), orgpools(3), tanprod(3), watertend, fluxes(6,3), tanpools3(3), ratm, tandep, & fluxes2(6,2), fluxes3(6,3), fluxes4(6,4), tanpools2(2), tanpools4(4), fluxes_tmp(6), garbage_total - real(r8), parameter :: water_init_grz = 0.005_r8, cnc_nh3_air = 0.0_r8, depth_slurry = 0.005_r8 + real(r8), parameter :: water_init_grz = 0.006_r8, cnc_nh3_air = 0.0_r8, depth_slurry = 0.005_r8 !real(r8), parameter :: fract_resist=0.225_r8, fract_unavail=0.025_r8, fract_avail=0.25_r8, fract_tan=0.6_r8 - real(r8), parameter :: fract_tan=0.6_r8 ! of all N + real(r8), parameter :: fract_tan=0.5_r8 ! of all N real(r8), parameter :: fract_resist=0.45_r8, fract_unavail=0.05_r8, fract_avail=0.5_r8 ! of organic N @@ -188,7 +188,7 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & real(r8), parameter :: slurry_infiltr_time = 12*3600.0_r8, water_init_fert = 1e-6 real(r8), parameter :: & poolranges_grz(3) = (/24*3600.0_r8, 10*24*3600.0_r8, 360*24*3600.0_r8/), & - poolranges_fert(3) = (/2*24*3600.0_r8, 24*3600.0_r8, 360*24*3600.0_r8/), & + poolranges_fert(3) = (/2.36*24*3600.0_r8, 24*3600.0_r8, 360*24*3600.0_r8/), & poolranges_slr(4) = (/slurry_infiltr_time, 24*3600.0_r8, 10*24*3600.0_r8, 360*24*3600.0_r8/), & !Hconc_grz(3) = (/10**(-8.5_r8), 10**(-8.0_r8), 10**(-7.0_r8)/), & Hconc_fert(3) = (/10**(-7.0_r8), 10**(-8.5_r8), 10**(-8.0_r8)/) @@ -200,19 +200,21 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & real(r8) :: tg, garbage, theta, thetasat, infiltr_m_s, evap_m_s, runoff_m_s, org_n_tot, & nstored_old, nsoilman_old, nsoilfert_old, fert_to_air, fert_to_soil, fert_total, fert_urea, fert_tan, & soilflux_org, urea_resid - real(r8) :: tanprod_from_urea(3), ureapools(2), fert_no3, fert_generic + real(r8) :: tanprod_from_urea(3), ureapools(2), fert_no3, fert_generic, bsw !real(r8), parameter :: fract_urea=0.545, fract_no3=0.048 - real(r8) :: fract_urea, fract_no3, soilph_min, soilph_max + real(r8) :: fract_urea, fract_no3, soilph_min, soilph_max, soilpsi integer, parameter :: ind_region = 1 integer :: def_ph_count Hconc_grz(1:2) = (/10**(-8.5_r8), 10**(-8.0_r8)/) Hconc_slr(1:3) = (/10.0_r8**(-8.0_r8), 10.0_r8**(-8.0_r8), 10.0_r8**(-8.0_r8)/) + soilph_min = 999 soilph_max = -999 def_ph_count = 0 dt = real( get_step_size(), r8 ) do_balance_checks = mod(get_nstep(), balance_check_freq) == 0 + associate( & ! Input: [real(r8) (:)] nitrogen deposition rate (gN/m2/s) forc_ndep => atm2lnd_inst%forc_ndep_grc , & @@ -269,10 +271,10 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & if (.not. col%active(c) .or. col%wtgcell(c) < 1e-6) cycle g = col%gridcell(c) if (lun%itype(l) == istsoil) then - ngrz(c) = atm2lnd_inst%forc_ndep3_grc(g) / col%wtgcell(c) * 1e3 ! kg to g + ngrz(c) = atm2lnd_inst%forc_ndep_grz_grc(g) / col%wtgcell(c) * 1e3 ! kg to g if (debug_fan) then if (ngrz(c) > 1e12 .or. (isnan(ngrz(c)))) then - write(iulog, *) 'bad ngrz', atm2lnd_inst%forc_ndep3_grc(g), col%wtgcell(c) + write(iulog, *) 'bad ngrz', atm2lnd_inst%forc_ndep_grz_grc(g), col%wtgcell(c) call endrun('bad ngrz 1') end if end if @@ -293,16 +295,8 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & end if end if -!!$ call handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & -!!$ atm2lnd_inst%forc_ndep2_grc, & -!!$ ns%man_n_stored_col, ns%man_tan_stored_col, & -!!$ nf%man_n_appl_col, nf%man_tan_appl_col, & -!!$ nf%man_n_grz_col, nf%man_n_mix_col, & -!!$ nf%nh3_stores_col, nf%nh3_barns_col, & -!!$ nf%man_n_transf_col, filter_soilc, num_soilc) - call handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & - atm2lnd_inst%forc_ndep2_grc, & + atm2lnd_inst%forc_ndep_sgrz_grc, atm2lnd_inst%forc_ndep_ngrz_grc, & ns%man_n_stored_col, ns%man_tan_stored_col, & nf%man_n_appl_col, nf%man_tan_appl_col, & nf%man_n_grz_col, nf%man_n_mix_col, & @@ -380,16 +374,18 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & ! stand-alone simulations so the term is currenltly neglected here. watertend = 0.0_r8 - ! Try using watertend evaluated in waterstatetype: - ! watertend = waterstate_inst%h2osoi_tend_tsl_col(c) + ! use the calculated tend + watertend = waterstate_inst%h2osoi_tend_tsl_col(c) * 1e-3 ! to meters/sec (ie. m3/m2/s) tg = temperature_inst%t_grnd_col(c) theta = waterstate_inst%h2osoi_vol_col(c,1) thetasat = soilstate_inst%watsat_col(c,1) + bsw = soilstate_inst%bsw_col(c,1) theta = min(theta, 0.98_r8*thetasat) infiltr_m_s = max(waterflux_inst%qflx_infl_col(c), 0.0) * 1e-3 evap_m_s = waterflux_inst%qflx_evap_grnd_col(c) * 1e-3 runoff_m_s = max(waterflux_inst%qflx_runoff_col(c), 0.0) * 1e-3 + soilpsi = soilstate_inst%soilpsi_col(c,1) ! ! grazing @@ -403,7 +399,7 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & orgpools(ind_avail) = man_a_grz(c) orgpools(ind_resist) = man_r_grz(c) orgpools(ind_unavail) = man_u_grz(c) - call update_org_n(ndep_org, tg, orgpools, dt, tanprod, soilflux_org) + call update_org_n(ndep_org, tg, soilpsi, orgpools, dt, tanprod, soilflux_org) man_a_grz(c) = orgpools(ind_avail) man_r_grz(c) = orgpools(ind_resist) man_u_grz(c) = orgpools(ind_unavail) @@ -433,7 +429,7 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & theta, thetasat, infiltr_m_s, evap_m_s, & atm2lnd_inst%forc_q_downscaled_col(c), watertend, & runoff_m_s, tandep, (/0.0_r8, 0.0_r8, sum(tanprod)/), water_init_grz, & - cnc_nh3_air, poolranges_grz, Hconc_grz, dz_layer_grz, tanpools3, & + bsw, poolranges_grz, Hconc_grz, dz_layer_grz, tanpools3, & fluxes3(1:5,:), garbage, dt/num_substeps, status, 3) if (status /= 0) then write(iulog, *) 'status = ', status, tanpools2, ratm, theta, thetasat, tandep, tanprod @@ -476,7 +472,7 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & orgpools(ind_avail) = man_a_app(c) orgpools(ind_resist) = man_r_app(c) orgpools(ind_unavail) = man_u_app(c) - call update_org_n(ndep_org, tg, orgpools, dt, tanprod, soilflux_org) + call update_org_n(ndep_org, tg, soilpsi, orgpools, dt, tanprod, soilflux_org) man_a_app(c) = orgpools(ind_avail) man_r_app(c) = orgpools(ind_resist) man_u_app(c) = orgpools(ind_unavail) @@ -504,7 +500,7 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & call update_4pool(tg, ratm, theta, thetasat, infiltr_m_s, evap_m_s, & atm2lnd_inst%forc_q_downscaled_col(c), watertend, & - runoff_m_s, tandep, sum(tanprod), cnc_nh3_air, depth_slurry, & + runoff_m_s, tandep, sum(tanprod), bsw, depth_slurry, & poolranges_slr, tanpools4, Hconc_slr, fluxes4(1:5,:), garbage, dt / num_substeps, status) if (status /= 0) then write(iulog, *) 'status = ', status, tanpools4, tg, ratm, 'th', theta, & @@ -556,7 +552,7 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & ureapools(2) = ns%fert_u1_col(c) fluxes2 = 0.0 call update_urea(tg, theta, thetasat, infiltr_m_s, evap_m_s, watertend, & - runoff_m_s, fert_urea, ureapools, fluxes2, urea_resid, poolranges_fert(1:2), & + runoff_m_s, fert_urea, bsw, ureapools, fluxes2, urea_resid, poolranges_fert(1:2), & dt, status, numpools=2) if (status /= 0) then call endrun(msg='Bad status after update_urea for fertilizer') @@ -583,7 +579,7 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & ! Fertilizer pools f0...f2 call update_npool(tg, ratm, theta, thetasat, infiltr_m_s, evap_m_s, & atm2lnd_inst%forc_q_downscaled_col(c), watertend, & - runoff_m_s, 0.0_r8, tanprod_from_urea, water_init_fert, cnc_nh3_air, & + runoff_m_s, 0.0_r8, tanprod_from_urea, water_init_fert, bsw, & poolranges_fert, Hconc_fert, dz_layer_fert, tanpools3, fluxes3(1:5,:), & garbage, dt/num_substeps, status, numpools=3) if (status /= 0) then @@ -596,7 +592,7 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & ! Fertilizer pool f3 call update_npool(tg, ratm, theta, thetasat, infiltr_m_s, evap_m_s, & atm2lnd_inst%forc_q_downscaled_col(c), watertend, & - runoff_m_s, fert_generic, (/0.0_r8/), water_init_fert, cnc_nh3_air, & + runoff_m_s, fert_generic, (/0.0_r8/), water_init_fert, bsw, & !(/360*24*3600.0_r8/), (/10**(-6.0_r8)/), dz_layer_fert, ns%tan_f3_col(c:c), fluxes3(1:5,1:1), & (/360*24*3600.0_r8/), (/10**(-ph_crop)/), dz_layer_fert, ns%tan_f3_col(c:c), fluxes3(1:5,1:1), & garbage, dt/num_substeps, status, numpools=1) @@ -712,7 +708,7 @@ end subroutine balance_check end subroutine CNNDeposition subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & - ndep_mixed_grc, n_stored_col, tan_stored_col, & + ndep_sgrz_grc, ndep_ngrz_grc, n_stored_col, tan_stored_col, & n_manure_spread_col, tan_manure_spread_col, & n_manure_graze_col, n_manure_mixed_col, & nh3_flux_stores, nh3_flux_barns, man_n_transf, & @@ -734,8 +730,9 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & type(frictionvel_type) , intent(in) :: frictionvel_inst real(r8), intent(in) :: dt - ! N excreted in manure, mixed/pastoral systems, gN/m2: - real(r8), intent(in) :: ndep_mixed_grc(bounds%begg:bounds%endg) + ! N excreted in manure, gN/m2: + real(r8), intent(in) :: ndep_sgrz_grc(bounds%begg:bounds%endg) ! seasonally grazing animals + real(r8), intent(in) :: ndep_ngrz_grc(bounds%begg:bounds%endg) ! non-grazing animals real(r8), intent(inout) :: n_stored_col(bounds%begc:bounds%endc), tan_stored_col(bounds%begc:bounds%endc) ! N, TAN currently stored, gN/m2 ! N, TAN spread on grasslands, gN/m2/s: real(r8), intent(inout) :: n_manure_spread_col(bounds%begc:bounds%endc) ! for crops, input, determined by crop model, otherwise output @@ -764,7 +761,7 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & real(r8) :: cumflux, totalinput real(r8) :: fluxes_nitr(4), fluxes_tan(4) ! The fraction of manure applied continuously on grasslands (if present in the gridcell) - real(r8), parameter :: fract_continuous = 0.1_r8, kg_to_g = 1e3_r8, max_grazing_fract = 0.3_r8, & + real(r8), parameter :: fract_continuous = 0.1_r8, kg_to_g = 1e3_r8, max_grazing_fract = 0.5_r8, & volat_coef_barns = 0.03_r8, volat_coef_stores = 0.025_r8, & tempr_min_grazing = 283.0_r8!!!! @@ -818,12 +815,26 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & call endrun('column not in soilfilter') end if - flux_avail = ndep_mixed_grc(g) * kg_to_g / lun%wtgcell(l) + n_manure_mixed_col(c) = (ndep_ngrz_grc(g) + ndep_sgrz_grc(g)) * kg_to_g / lun%wtgcell(l) + + tempr_min_10day = temperature_inst%t_a10min_patch(col%patchi(c)) + if (tempr_min_10day > tempr_min_grazing) then + ! fraction of animals grazing -> allocate some manure to grasslands before barns + flux_grazing = max_grazing_fract * ndep_sgrz_grc(g) * kg_to_g / lun%wtgcell(l) + flux_avail = (ndep_ngrz_grc(g) + ndep_sgrz_grc(g)*(1.0_r8 - max_grazing_fract)) * kg_to_g / lun%wtgcell(l) + grz_fract(c) = max_grazing_fract + else + flux_grazing = 0.0_r8 + flux_avail = n_manure_mixed_col(c) + grz_fract(c) = 0.0_r8 + end if + flux_grass_graze = flux_grass_graze + flux_grazing*col%wtgcell(c) + if (flux_avail > 1e12 .or. isnan(flux_avail)) then write(iulog, *) 'bad flux_avail', ndep_mixed_grc(g), lun%wtgcell(l) call endrun('bad flux_avail') end if - n_manure_mixed_col(c) = flux_avail + totalinput = totalinput + flux_avail counter = 0 @@ -835,18 +846,6 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & tempr_ave = temperature_inst%t_ref2m_patch(col%patchi(c)) windspeed_ave = frictionvel_inst%u10_patch(col%patchi(c)) - tempr_min_10day = temperature_inst%t_a10min_patch(col%patchi(c)) - if (tempr_min_10day > tempr_min_grazing) then - ! fraction of animals grazing -> allocate some manure to grasslands before barns - flux_grazing = max_grazing_fract * flux_avail - flux_avail = flux_avail - flux_grazing - grz_fract(c) = max_grazing_fract - else - flux_grazing = 0 - grz_fract(c) = 0 - end if - flux_grass_graze = flux_grass_graze + flux_grazing*col%wtgcell(c) - man_n_barns(c) = flux_avail call eval_fluxes_storage(flux_avail, tempr_ave, windspeed_ave, 0.0_r8, & diff --git a/src/biogeochem/FanMod.F90 b/src/biogeochem/FanMod.F90 index fbf1bc61ca..5220c68239 100755 --- a/src/biogeochem/FanMod.F90 +++ b/src/biogeochem/FanMod.F90 @@ -47,7 +47,7 @@ module FanMod integer, parameter, public :: ind_avail = 1, ind_resist = 2, ind_unavail = 3 ! nominal depth where the soil TAN concentration vanishes: - real(r8), parameter, public :: soildepth_reservoir = 0.05_r8 + real(r8), parameter, public :: soildepth_reservoir = 0.04_r8 integer, parameter, public :: err_bad_theta = 1, err_negative_tan = 2, err_negative_flux = 3, & err_balance_tan = 4, err_balance_nitr = 5, err_nan = 6, err_bad_subst = 7 @@ -104,9 +104,12 @@ function eval_diffusivity_liq_mq(theta, thetasat, tg) result(diff) real(r8) :: diff real(r8) :: kaq_base - real(r8), parameter :: pw = 10.0_r8 / 3.0_r8 - - kaq_base = 9.8e-10_r8 * 1.03_r8 ** (Tg-273.0_r8) + real(r8), parameter :: pw = 7.0_r8 / 3.0_r8 + real(r8), parameter :: gascnst = 8.314, faraday = 96500.0_r8, lp = 73.4_r8, lm_no3 = 71.4_r8, lm_oh=197.6_r8, lm=lm_no3 + + kaq_base = 1e-4 * (gascnst*tg / (2*faraday**2)) / (1/lp + 1/lm) + !kaq_base = 9.8e-10_r8 * 1.03_r8 ** (Tg-273.0_r8) + diff = kaq_base * (theta**pw) / (thetasat**2) end function eval_diffusivity_liq_mq @@ -119,7 +122,7 @@ function eval_diffusivity_gas_mq(theta, thetasat, tg) result(diff) real(r8) :: diff real(r8) :: soilair, dair - real(r8), parameter :: pw = 10.0_r8 / 3.0_r8 + real(r8), parameter :: pw = 7.0_r8 / 3.0_r8 real(r8), parameter :: mNH3 = 17., mair = 29, vNH3 = 14.9, vair = 20.1, press = 1.0 soilair = thetasat - theta @@ -133,36 +136,45 @@ function eval_diffusivity_gas_mq(theta, thetasat, tg) result(diff) end function eval_diffusivity_gas_mq - function eval_diffusivity_gas_m03(theta, thetasat, tg) result(diff) + function eval_diffusivity_gas_m03(theta, thetasat, tg, bsw) result(diff) ! Evaluate the gas phase diffusivity for NH3 in soil according to the method of ! Moldrup (2003). implicit none - real(r8), intent(in) :: theta, thetasat, tg + real(r8), intent(in) :: theta, thetasat, tg, bsw real(r8) :: diff - real(r8) :: soilair, dair + real(r8) :: soilair, dair, m03_W real(r8), parameter :: pw = 10.0_r8 / 3.0_r8 - real(r8), parameter :: bsw = 5.0_r8, m03_T = 2.0, m03_W = 3.0 / bsw + real(r8), parameter :: m03_T = 2.0 + real(r8), parameter :: mNH3 = 17., mair = 29, vNH3 = 14.9, vair = 20.1, press = 1.0 + + m03_W = 3.0 / bsw soilair = thetasat - theta - dair = 1.7e-5 * 1.03**(Tg-293.0_r8) + !dair = 1.7e-5 * 1.03**(Tg-293.0_r8) + dair = (0.001 * tg**1.75 * sqrt(1/mNH3 + 1/mair)) / (press * (vair**(1./3) * vNH3**(1./3))**2) * 1e-4 - diff = dair * soilair**m03_T * (soilair/thetasat)**m03_W + diff = dair * soilair**m03_T * (soilair/thetasat)**m03_W / soilair end function eval_diffusivity_gas_m03 - function eval_diffusivity_liq_m03(theta, thetasat, tg) result(diff) + function eval_diffusivity_liq_m03(theta, thetasat, tg, bsw) result(diff) ! Evaluate the aquous phase diffusivity for TAN in soil according to the method of Moldrup (2003). implicit none - real(r8), intent(in) :: theta, thetasat, tg + real(r8), intent(in) :: theta, thetasat, tg, bsw real(r8) :: diff - real(r8) :: kaq_base - real(r8), parameter :: pw = 10.0_r8 / 3.0_r8, bsw = 5.0_r8, m03_T = 2.0_r8, m03_W = 0.3333_r8*bsw - 1.0 + real(r8) :: kaq_base, m03_W + real(r8), parameter :: pw = 10.0_r8 / 3.0_r8, m03_T = 2.0_r8 + real(r8), parameter :: gascnst = 8.314, faraday = 96500.0_r8, lp = 73.4_r8, lm_no3 = 71.4_r8, lm_oh=197.6_r8, lm=lm_oh kaq_base = 9.8e-10 * 1.03 ** (Tg-273.0_r8) - diff = kaq_base * theta**m03_T * (theta/thetasat)**m03_W + !kaq_base = 1e-4 * (gascnst*tg / (2*faraday**2)) / (1/lp + 1/lm) + + m03_W = 0.3333_r8*bsw - 1.0 + + diff = kaq_base * theta**m03_T * (theta/thetasat)**m03_W / theta end function eval_diffusivity_liq_m03 @@ -312,15 +324,16 @@ real(r8) function get_henry_eff(tg, Hconc) result(henry) end function get_henry_eff - subroutine partition_tan(tg, Hconc, theta, air, KNH3, fract_nh4) + subroutine partition_tan(tg, Hconc, theta, air, kads, KNH3, fract_nh4) implicit none real(r8), intent(in) :: tg ! soil temperature, K real(r8), intent(in) :: Hconc ! H+ concentration, mol / l real(r8), intent(in) :: theta ! water volume fraction real(r8), intent(in) :: air ! air volume fraction + real(r8), intent(in) :: kads ! adsorption coefficient, kads = NH4(ads) / NH4(aq) real(r8), optional, intent(out) :: fract_nh4 ! mass fraction of NH4 - real(r8), intent(out) :: KNH3 ! ratio of concentrations [NH3 (gas)] / [NH3+NH4 (aq)] + real(r8), intent(out) :: KNH3 ! volatility, ratio of concentrations [NH3 (gas)] / [NH3+NH4 (aq)] real(r8) :: KNH4, HNH3, cnc_aq, fract_aq real(r8), parameter :: Tref = 298.15_r8 @@ -331,7 +344,7 @@ subroutine partition_tan(tg, Hconc, theta, air, KNH3, fract_nh4) KNH3 = KNH4 / (HNH3*(KNH4 + Hconc)) - fract_aq = theta / (air*KNH3 + theta) + fract_aq = theta / (air*KNH3 + theta + kads*(1.0_r8-theta-air)) if (present(fract_nh4)) fract_nh4 = fract_aq * Hconc / (KNH4 + Hconc) !if (present(fract_nh3g)) fract_nh3g = air * KNH3 / (air*KNH3 + theta) !if (present(fract_nh3aq)) fract_nh3aq = fract_aq * (1.0_r8 - Hconc / (KNH4 + Hconc)) @@ -398,15 +411,15 @@ real(r8) function eval_no3prod(theta, Tg, Hconc) result(kNO3) end function eval_no3prod - real(r8) function eval_no3prod_v2(theta, Tg) result(kNO3) + real(r8) function eval_no3prod_v2(theta, theta_sat, Tg) result(kNO3) ! Evaluate nitrification rate as in the Riddick et al. (2016) paper but for NH4. ! Partitioning between TAN forms is not included. - real(r8), intent(in) :: theta ! volumetric soil water m/m + real(r8), intent(in) :: theta, theta_sat ! volumetric soil water m/m real(r8), intent(in) :: Tg ! soil temperature, K - real(r8) :: stf, wmr, smrf, mNH4 + real(r8) :: stf, wmr, smrf, mNH4, soil_dens - real(r8), parameter :: soil_dens = 1050.0_r8 ! Soil density, kg/m3 + !real(r8), parameter :: soil_dens = 1400.0_r8 ! Soil density, kg/m3 real(r8), parameter :: water_dens = 1000.0_r8 real(r8), parameter :: rmax = 1.16e-6_r8 ! Maximum rate of nitrification, s-1 real(r8), parameter :: tmax = 313.0 ! Maximm temperature of microbial activity, K @@ -416,6 +429,8 @@ real(r8) function eval_no3prod_v2(theta, Tg) result(kNO3) real(r8), parameter :: smrf_b = 2 ! Parameter in soil moisture response function real(r8), parameter :: Tref = 298.15_r8 + + soil_dens = 2650.0_r8 * (1.0_r8-theta_sat) mNH4 = 1.0_r8 ! soil temperature function @@ -434,7 +449,7 @@ real(r8) function eval_no3prod_v2(theta, Tg) result(kNO3) end function eval_no3prod_v2 - subroutine eval_fluxes_slurry(water, mtan, Hconc, tg, ratm, theta, thetasat, perc, runoff, cnc_nh3_air, fluxes) + subroutine eval_fluxes_slurry(water, mtan, Hconc, tg, ratm, theta, thetasat, perc, runoff, bsw, fluxes) ! Evaluate nitrogen fluxes for a partly infiltrated layer of slurry. ! The state of infiltration is detemined from the amounts water on surface and in soil. ! Positive flux means loss of TAN. @@ -449,10 +464,10 @@ subroutine eval_fluxes_slurry(water, mtan, Hconc, tg, ratm, theta, thetasat, per real(r8), intent(in) :: thetasat ! volumetric soil water at saturation real(r8), intent(in) :: perc ! percolation water flux thourgh the bottom of volatilization layer, m/s real(r8), intent(in) :: runoff ! surface runoff, m/s - real(r8), intent(in) :: cnc_nh3_air ! atmospheric NH3 concentration, mass units / m3 + real(r8), intent(in) :: bsw !real(r8), intent(in) :: dt ! timestep - real(r8) :: water_tot, cnc, air, depth_soilsat, diffusivity_water, diffusivity_satsoil, halfwater, insoil, r1, dz2 + real(r8) :: water_tot, cnc, air, depth_soilsat, diffusivity_water, diffusivity_satsoil, halfwater, insoil, r1, dz2, inwater real(r8) :: r2, volat_rate, kno3, henry_eff, depth_lower, fract_nh4 water_tot = water(1) + water(2) @@ -469,7 +484,8 @@ subroutine eval_fluxes_slurry(water, mtan, Hconc, tg, ratm, theta, thetasat, per diffusivity_water = 9.8e-10_r8 * 1.03_r8 ** (tg - 273.0_r8) diffusivity_satsoil = eval_diffusivity_liq_mq(thetasat, thetasat, tg) * thetasat - + !diffusivity_satsoil = eval_diffusivity_liq_m03(thetasat, thetasat, tg, bsw) * thetasat + halfwater = 0.5_r8 * water_tot ! Calculate the internal resistance r1 of the slurry/soil layer by integrating the @@ -477,26 +493,42 @@ subroutine eval_fluxes_slurry(water, mtan, Hconc, tg, ratm, theta, thetasat, per if (water(1) < halfwater) then ! contribution from both pool and the saturated soil. insoil = (halfwater - water(1)) / thetasat - r1 = water(1) / diffusivity_water + insoil / diffusivity_satsoil + inwater = water(1) + !r1 = water(1) / diffusivity_water + insoil / diffusivity_satsoil + else ! pool only - r1 = halfwater / diffusivity_water + inwater = halfwater + insoil = 0.0 + !r1 = halfwater / diffusivity_water end if - + + r1 = inwater / diffusivity_water + insoil /diffusivity_satsoil + depth_lower = max(soildepth_reservoir, depth_soilsat*1.5) ! Diffusion to deeper soil over distance dz2 - dz2 = depth_lower - 0.5*depth_soilsat - r2 = 0.5 * depth_soilsat/diffusivity_satsoil + dz2 / eval_diffusivity_liq_mq(theta, thetasat, tg) + !dz2 = depth_lower - 0.5*depth_soilsat + + !r2 = (water(1)-inwater) / diffusivity_water + (depth_soilsat-insoil) / diffusivity_satsoil & + ! & + (depth_lower-depth_soilsat) / (eval_diffusivity_liq_m03(theta, thetasat, tg, bsw)*theta) + + r2 = (water(1)-inwater) / diffusivity_water + (depth_soilsat-insoil) / diffusivity_satsoil & + & + (depth_lower-depth_soilsat) / (eval_diffusivity_liq_mq(theta, thetasat, tg)*theta) + + + !dz2 = depth_lower - insoil + + !r2 = 0.5 * depth_soilsat/diffusivity_satsoil + dz2 / (eval_diffusivity_liq_mq(theta, thetasat, tg)*theta) !print *, 'r2', r2, diffusivity_satsoil, dz2, depth_soilsat fluxes(iflx_soild) = cnc / r2 !henry_eff = get_henry_eff(tg, Hconc) - call partition_tan(tg, Hconc, 1.0_r8, 0.0_r8, henry_eff, fract_nh4=fract_nh4) + call partition_tan(tg, Hconc, 1.0_r8, 0.0_r8, 0.0_r8, henry_eff, fract_nh4=fract_nh4) volat_rate = 1.0_r8 / (r1 + ratm / henry_eff) ! conductance from aqueous TAN in slurry to NH3 in atmosphere fluxes(iflx_air) = volat_rate*cnc ! nitrification - kno3 = eval_no3prod(thetasat, tg, Hconc) + kno3 = eval_no3prod_v2(thetasat, thetasat, tg) fluxes(iflx_no3) = kno3 * mtan * fract_nh4 !fluxes(3:) = 0 @@ -588,7 +620,7 @@ subroutine eval_fluxes_soil(mtan, water_manure, Hconc, tg, ratm, theta, thetasat end subroutine eval_fluxes_soil subroutine eval_fluxes_soilroff(mtan, water_manure, Hconc, tg, ratm, theta, thetasat, perc, & - & runoff, cnc_nh3_air, soildepth, fluxes, substance, status) + & runoff, bsw, soildepth, fluxes, substance, status) ! ! Evaluate nitrogen fluxes from a soil layer. Use for all cases except the partly ! infiltrated slurry (above). Fluxes can be evaluated either for urea or TAN: for @@ -605,7 +637,7 @@ subroutine eval_fluxes_soilroff(mtan, water_manure, Hconc, tg, ratm, theta, thet real(r8), intent(in) :: thetasat ! volumetric soil water at saturation real(r8), intent(in) :: perc ! downwards water percolation rate at the bottom of layer, m/s, > 0 real(r8), intent(in) :: runoff ! runoff water flux, m / s - real(r8), intent(in) :: cnc_nh3_air ! NH3 concentration in air, mass units / m3 + real(r8), intent(in) :: bsw ! real(r8), intent(in) :: soildepth ! thickness of the volatlization layer integer, intent(in) :: substance ! subst_tan or subst_urea. integer, intent(out) :: status ! error flag @@ -630,18 +662,18 @@ subroutine eval_fluxes_soilroff(mtan, water_manure, Hconc, tg, ratm, theta, thet air = thetasat - theta_tot dz = 0.5*soildepth - dsl = eval_diffusivity_liq_mq(theta_tot, thetasat, Tg) - dsg = eval_diffusivity_gas_mq(theta_tot, thetasat, Tg) + !dsl = eval_diffusivity_liq_mq(theta_tot, thetasat, Tg) + !dsg = eval_diffusivity_gas_mq(theta_tot, thetasat, Tg) - !dsl = eval_diffusivity_liq_m03(theta_tot, thetasat, Tg) - !dsg = eval_diffusivity_gas_m03(theta_tot, thetasat, Tg) + dsl = eval_diffusivity_liq_m03(theta_tot, thetasat, Tg, bsw) + dsg = eval_diffusivity_gas_m03(theta_tot, thetasat, Tg, bsw) rsg = dz / (dsg*air) rsl = dz / (dsl*theta_tot) if (substance == subst_tan) then - call partition_tan(tg, Hconc, theta_tot, air, volatility, fract_nh4=fract_nh4) - no3_rate = eval_no3prod_v2(theta_tot, tg)*fract_nh4 + call partition_tan(tg, Hconc, theta_tot, air, 0.0_r8, volatility, fract_nh4=fract_nh4) + no3_rate = eval_no3prod_v2(theta_tot, thetasat, tg)!*fract_nh4 else if (substance == subst_urea) then volatility = 0.0 no3_rate = 0.0_r8 @@ -650,7 +682,7 @@ subroutine eval_fluxes_soilroff(mtan, water_manure, Hconc, tg, ratm, theta, thet return end if - call get_srf_cnc(volatility, cnc, cnc_nh3_air, rsg, rsl, Ratm, runoff, theta_tot, air, cnc_srfg, cnc_srfaq) + call get_srf_cnc(volatility, cnc, 0.0_r8, rsg, rsl, Ratm, runoff, theta_tot, air, cnc_srfg, cnc_srfaq) fluxes(iflx_air) = cnc_srfg / ratm fluxes(iflx_roff) = runoff * cnc_srfaq @@ -659,8 +691,8 @@ subroutine eval_fluxes_soilroff(mtan, water_manure, Hconc, tg, ratm, theta, thet cnc_soilaq = cnc / (theta_tot + air*volatility) cnc_soilg = cnc_soilaq*volatility - fluxes(iflx_soild) = (cnc_soilaq * dsl*theta_tot) / dz2 + (cnc_soilg * dsg*air) / dz2 - + fluxes(iflx_soild) = (cnc_soilaq * dsl * theta_tot) / dz2 + (cnc_soilg * dsg * air) / dz2 + fluxes(iflx_soild) = fluxes(iflx_soild) + mtan / (24*3600.0*365) fluxes(iflx_no3) = mtan * no3_rate fluxes(iflx_soilq) = cnc_soilaq * perc @@ -695,6 +727,120 @@ end subroutine get_srf_cnc end subroutine eval_fluxes_soilroff + subroutine eval_fluxes_soilroff_ads(mtan, water_manure, Hconc, tg, ratm, theta, thetasat, perc, & + & runoff, bsw, soildepth, fluxes, substance, status) + ! + ! Evaluate nitrogen fluxes from a soil layer. Use for all cases except the partly + ! infiltrated slurry (above). Fluxes can be evaluated either for urea or TAN: for + ! urea, only the aqueous phase fluxes are evaluated and nitrification is set to zero. + ! + implicit none + real(r8), intent(in) :: mtan ! TAN, mass units / m2 + real(r8), intent(in) :: water_manure ! water in the soil pool *in addition to* background soil water + real(r8), intent(out) :: fluxes(5) ! nitrogen fluxes, mass units / m2 / s, see top of module + real(r8), intent(in) :: Hconc ! Hydrogen ion concentration, mol/l + real(r8), intent(in) :: tg ! soil temperature, K + real(r8), intent(in) :: ratm ! atmospheric resistance, s/m + real(r8), intent(in) :: theta ! volumetric soil water in "clean" soil, m/m + real(r8), intent(in) :: thetasat ! volumetric soil water at saturation + real(r8), intent(in) :: perc ! downwards water percolation rate at the bottom of layer, m/s, > 0 + real(r8), intent(in) :: runoff ! runoff water flux, m / s + real(r8), intent(in) :: bsw ! + real(r8), intent(in) :: soildepth ! thickness of the volatlization layer + integer, intent(in) :: substance ! subst_tan or subst_urea. + integer, intent(out) :: status ! error flag + + real(r8) :: water_tot, cnc, air, henry_eff, dsl, dsg, dstot, dz2, no3_rate, volat_rate, theta_tot, beta + real(r8) :: cnc_srfg, cnc_srfaq, cnc_soilaq, cnc_soilg, dz, rsl, rsg + real(r8) :: fract_gas, fract_nh3aq, fract_nh4, fract_aq, volatility + + real(r8) :: kads + + water_tot = water_manure + theta*soildepth + if (water_tot < 1e-9) then + fluxes = 0.0 + return + end if + + theta_tot = water_tot / soildepth + if (theta_tot > thetasat) then + status = err_bad_theta + return + end if + + cnc = mtan / soildepth + air = thetasat - theta_tot + + dz = 0.5*soildepth + dsl = eval_diffusivity_liq_mq(theta_tot, thetasat, Tg) + dsg = eval_diffusivity_gas_mq(theta_tot, thetasat, Tg) + + !dsl = eval_diffusivity_liq_m03(theta_tot, thetasat, Tg, bsw) + !dsg = eval_diffusivity_gas_m03(theta_tot, thetasat, Tg, bsw) + + rsg = dz / (dsg*air) + rsl = dz / (dsl*theta_tot) + + if (substance == subst_tan) then + kads = 0.0_r8 + call partition_tan(tg, Hconc, theta_tot, air, kads, volatility, fract_nh4=fract_nh4) + no3_rate = eval_no3prod_v2(theta_tot, thetasat, tg) + else if (substance == subst_urea) then + volatility = 0.0 + no3_rate = 0.0_r8 + kads = 0.0 + else + status = err_bad_subst + return + end if + + call get_srf_cnc(volatility, cnc, 0.0_r8, rsg, rsl, Ratm, runoff, theta_tot, air, cnc_srfg, cnc_srfaq) + + fluxes(iflx_air) = cnc_srfg / ratm + fluxes(iflx_roff) = runoff * cnc_srfaq + + dz2 = soildepth_reservoir - 0.5 * soildepth + cnc_soilaq = cnc / (theta_tot + air*volatility + (1-theta_tot-air)*kads) + cnc_soilg = cnc_soilaq*volatility + + fluxes(iflx_soild) = (cnc_soilaq * dsl*theta_tot) / dz2 + (cnc_soilg * dsg*air) / dz2 + fluxes(iflx_soild) = fluxes(iflx_soild) + mtan / (24*3600.0*365) + fluxes(iflx_no3) = mtan * no3_rate + fluxes(iflx_soilq) = cnc_soilaq * perc + + status = 0 + !fluxes(4:) = 0 + + contains + + subroutine get_srf_cnc(knh3, xs, xag, Rsg, Rsl, Rag, qr, theta, air, cnc_gas, cnc_aq) + real(r8), intent(in) :: knh3 ! volatility + real(r8), intent(in) :: xag ! cnc_atm_gas + real(r8), intent(in) :: qr ! runoff m/s + real(r8), intent(in) :: Rag ! Ratm + real(r8), intent(in) :: xs ! mass / m3 soil + real(r8), intent(in) :: Rsg, Rsl, theta, air + + real(r8), intent(out) :: cnc_gas, cnc_aq + + real(r8) :: x0, x1, x2, x3, x4, x5, x6 + + x0 = air*knh3 + x1 = air*kads + x2 = kads*theta + x3 = Rag + Rsg + x4 = Rsl*knh3*x3 + x5 = Rag*Rsg*(Rsl*qr + 1) + x6 = (Rag*xs*(Rsg + Rsl*knh3) + Rsg*Rsl*xag*(kads + theta + x0 - x1 - x2)) & + /(Rsl*air*knh3**2*x3 + kads*x4 + kads*x5 + theta*x4 + theta*x5 + x0*x5 - x1*x4 - x1*x5 - x2*x4 - x2*x5) + cnc_gas = knh3*x6 + cnc_aq = x6 + + end subroutine get_srf_cnc + + end subroutine eval_fluxes_soilroff_ads + + subroutine eval_fluxes_soil_3p(mtan, water_manure, Hconc, tg, ratm, theta, thetasat, perc, & & runoff, cnc_nh3_air, soildepth, fluxes, substance, status) @@ -1021,7 +1167,7 @@ subroutine update_3pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend end subroutine update_3pool - subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend, runoff, tandep, tanprod, cnc_nh3_air, & + subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend, runoff, tandep, tanprod, bsw, & depth_slurry, poolranges, tanpools, Hconc, fluxes, garbage, dt, status) ! ! Experimental, as above but with an additional long-lived TAN pool. @@ -1040,7 +1186,7 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend real(r8), intent(in) :: tanprod ! TAN produced in the column, added to aged TAN pool !real(r8), intent(in) :: infiltr_slurry ! Slurry infiltration rate, m/s real(r8), intent(in) :: depth_slurry ! Initial slurry depth, m - real(r8), intent(in) :: cnc_nh3_air ! NH3 concentration in air, gN/m3 + real(r8), intent(in) :: bsw real(r8), intent(in) :: poolranges(4) ! age ranges of TAN pools S0, S1, S2, sec. Slurry infiltration time is inferred from S0. real(r8), intent(inout) :: tanpools(4) ! TAN pools gN/m2 real(r8), intent(out) :: fluxes(5,4) ! TAN fluxes, gN/m2/s (type of flux, pool) @@ -1071,14 +1217,14 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend infiltrated = depth_slurry * infiltr_slurry / (infiltr_slurry + evap_slurry) ! Slurry water (in addition to soil water, theta) on surface and in soil. Represents ! mean over pool S0. - water_slurry = (/0.5*depth_slurry, 0.5*infiltrated/) + water_slurry = (/0.5*depth_slurry, 0.5*infiltrated/) ! The excess water assumed to have percolated down from the volat. layer. percolated = max(infiltrated - dz_layer*(thetasat-theta), 0.0) ! Percolation rate out of volat layer, average over the pool S0. perc_slurry_mean = percolated / poolranges(1) call eval_fluxes_slurry(water_slurry, tanpools(1), Hconc(1), tg, ratm, theta, thetasat, perc_slurry_mean, & - runoff, cnc_nh3_air, fluxes(:,1)) + runoff, bsw, fluxes(:,1)) if (any(isnan(fluxes))) then status = err_nan * 10 @@ -1115,14 +1261,11 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend !call eval_fluxes_soil(tanpools(indpl), water_soil, Hconc(indpl), tg, & ! & ratm, theta, thetasat, percolation, runoff, cnc_nh3_air, & ! & dz_layer, fluxes(:,indpl), subst_tan, status) - call eval_fluxes_soilroff(tanpools(indpl), water_soil, Hconc(indpl), tg, & - & ratm, theta, thetasat, percolation, runoff, cnc_nh3_air, & + call eval_fluxes_soilroff_ads(tanpools(indpl), water_soil, Hconc(indpl), tg, & + & ratm, theta, thetasat, percolation, runoff, bsw, & & dz_layer, fluxes(:,indpl), subst_tan, status) + if (status /= 0) return - !print *, fluxes(4,indpl), percolation, waterloss - !fluxes(:,indpl) = 0 - !fluxes(5:,indpl) = 0 - !tanpools(indpl) = tanpools(indpl) - sum(fluxes(:,indpl)) * dt age_prev = age_prev + poolranges(indpl) end do @@ -1137,6 +1280,7 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend if (any(isnan(fluxes))) then status = err_nan * 100 + return end if if (abs(sum(tanpools - tanpools_old) - (-sum(fluxes) + tandep + tanprod)*dt + garbage) > max(sum(tanpools_old)*1e-2, 1e-4)) then @@ -1152,7 +1296,7 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend end subroutine update_4pool subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend, runoff, tandep, tanprod, & - water_init, cnc_nh3_air, poolranges, Hconc, dz_layer, tanpools, fluxes, garbage, dt, status, numpools) + water_init, bsw, poolranges, Hconc, dz_layer, tanpools, fluxes, garbage, dt, status, numpools) ! ! Evaluate fluxes and update TAN pools for a model with arbitrary number of pools ! divided by age and pH. @@ -1170,7 +1314,7 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend real(r8), intent(in) :: tandep ! TAN input flux, gN/m2/s real(r8), intent(in) :: tanprod(numpools) ! flux of TAN produced (from urea/organic n) in the column real(r8), intent(in) :: water_init ! Initial water volume in the affected patch, m - real(r8), intent(in) :: cnc_nh3_air ! NH3 concentration in air, gN/m3 + real(r8), intent(in) :: bsw real(r8), intent(in) :: poolranges(numpools) ! age ranges of TAN pools (npools) real(r8), intent(in) :: Hconc(numpools) ! H+ concentration, mol/l (npools) real(r8), intent(in) :: dz_layer ! thickness of the volatilization layer, m @@ -1205,6 +1349,7 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend tandep_remaining = tandep - direct_runoff - direct_percolation water_into_layer = water_init * (1.0_r8 - fraction_reservoir - fraction_runoff) if (tandep_remaining < -1e-15) then + print *, tandep, direct_runoff, direct_percolation status = err_negative_tan + 10 return end if @@ -1252,8 +1397,8 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend water_soil = water_into_layer * waterfunction(age_prev + 0.5*poolranges(indpl)) !call eval_fluxes_soil(tanpools(indpl), water_soil, Hconc(indpl), tg, & !call eval_fluxes_soil_3p(tanpools(indpl), water_soil, Hconc(indpl), tg, & - call eval_fluxes_soilroff(tanpools(indpl), water_soil, Hconc(indpl), tg, & - & ratm, theta, thetasat, percolation, runoff, cnc_nh3_air, & + call eval_fluxes_soilroff_ads(tanpools(indpl), water_soil, Hconc(indpl), tg, & + & ratm, theta, thetasat, percolation, runoff, bsw, & & dz_layer, fluxes(:,indpl), subst_tan, status) if (status /= 0) then return @@ -1357,14 +1502,27 @@ function get_evap_pool(tg, ratm, qbot) result(evap) end function get_evap_pool - function waterfunction(pool_age) result(water) + function waterfunction_exp(pool_age) result(water) implicit none real(r8), intent(in) :: pool_age ! sec real(r8) :: water water = exp(-pool_age / water_relax_t) - end function waterfunction + end function waterfunction_exp + + function waterfunction(pool_age) result(water) + implicit none + real(r8), intent(in) :: pool_age ! sec + real(r8) :: water + if (pool_age > water_relax_t) then + water = 0.0_r8 + else + water = 1.0_r8 - pool_age / water_relax_t + end if + + end function waterfunction + function eval_perc(waterloss, evap, precip, watertend, dt) result(rate) ! ! Evaluate the downwards water flux at the layer bottom given the infiltration and @@ -1498,7 +1656,7 @@ subroutine eval_fluxes_storage(nitr_input, tempr_outside, windspeed, fract_direc end subroutine eval_fluxes_storage - subroutine update_org_n(flux_input, tg, pools, dt, tanprod, soilflux) + subroutine update_org_n(flux_input, tg, soilpsi, pools, dt, tanprod, soilflux) ! ! Evaluate the decomposition/mineralization N fluxes from the available, resistant and ! unavailable N fractions, and update the organic N pools. In addition, evaluate the @@ -1507,21 +1665,31 @@ subroutine update_org_n(flux_input, tg, pools, dt, tanprod, soilflux) real(r8), intent(in) :: flux_input(3) ! organic N entering the pools. gN/m2/s. For ! indices see at top of the module. real(r8), intent(in) :: tg ! ground temperature, K + real(r8), intent(in) :: soilpsi ! soil water potential (MPa) real(r8), intent(inout) :: pools(3) ! organic N pools real(r8), intent(in) :: dt ! timestep, sec real(r8), intent(out) :: tanprod(3) ! Flux of TAN formed, both pools real(r8), intent(out) :: soilflux ! Flux of organic nitrogen to soil - real(r8) :: rate_res, rate_avail, TR + real(r8) :: rate_res, rate_avail, TR, rmoist, psi real(r8), parameter :: ka1 = 8.94e-7_r8, ka2 = 6.38e-8 ! 1/s real(r8), parameter :: tr1 = 0.0106, tr2 = 0.12979 real(r8), parameter :: org_to_soil_time = 365*24*3600.0_r8 - + real(r8), parameter :: minpsi = -2.5_r8, maxpsi=-0.002_r8 real(r8) :: soilfluxes(3) TR = tr1 * exp(tr2 * (tg-273.15_r8)) - tanprod(ind_avail) = ka1 * TR * pools(ind_avail) - tanprod(ind_resist) = ka2 * TR * pools(ind_resist) + + psi = min(soilpsi, maxpsi) + ! decomp only if soilpsi is higher than minpsi + if (psi > minpsi) then + rmoist = log(minpsi/psi) / log(minpsi/maxpsi) + else + rmoist = 0.0 + end if + + tanprod(ind_avail) = ka1 * TR * pools(ind_avail)*rmoist + tanprod(ind_resist) = ka2 * TR * pools(ind_resist)*rmoist tanprod(ind_unavail) = 0.0 soilfluxes = pools * 1.0_r8 / org_to_soil_time @@ -1531,7 +1699,7 @@ subroutine update_org_n(flux_input, tg, pools, dt, tanprod, soilflux) end subroutine update_org_n subroutine update_urea(tg, theta, thetasat, precip, evap, watertend, runoff, & - ndep, pools, fluxes, garbage, ranges, dt, status, numpools) + ndep, bsw, pools, fluxes, garbage, ranges, dt, status, numpools) ! ! Evaluate fluxes and update the urea pools. The procedure is similar to updating the ! soil TAN pools, but NO3 and volatilization fluxes do not occur. @@ -1545,6 +1713,7 @@ subroutine update_urea(tg, theta, thetasat, precip, evap, watertend, runoff, & real(r8), intent(in) :: watertend ! time derivative of theta*dz real(r8), intent(in) :: runoff ! surface runoff flux, m/s real(r8), intent(in) :: ndep + real(r8), intent(in) :: bsw real(r8), intent(inout) :: pools(numpools) real(r8), intent(out) :: fluxes(6, numpools) ! one extra for the to_tan flux real(r8), intent(in) :: ranges(numpools) @@ -1570,7 +1739,7 @@ subroutine update_urea(tg, theta, thetasat, precip, evap, watertend, runoff, & ! in the following, atmospheric concentration should be 0 not missing! call eval_fluxes_soilroff(pools(indpl), 0.0_r8, missing, tg, & !call eval_fluxes_soil(pools(indpl), 0.0_r8, missing, tg, & - & missing, theta, thetasat, percolation, runoff, 0.0_r8, & + & missing, theta, thetasat, percolation, runoff, bsw, & & dz_layer, fluxes(1:5,indpl), subst_urea, status) if (status /= 0) then return diff --git a/src/main/atm2lndType.F90 b/src/main/atm2lndType.F90 index ad0f49e2be..3356e03fc2 100644 --- a/src/main/atm2lndType.F90 +++ b/src/main/atm2lndType.F90 @@ -89,9 +89,12 @@ module atm2lndType real(r8), pointer :: forc_solai_grc (:,:) => null() ! diffuse radiation (numrad) (vis=forc_solsd, nir=forc_solld) real(r8), pointer :: forc_solar_grc (:) => null() ! incident solar radiation real(r8), pointer :: forc_ndep_grc (:) => null() ! nitrogen deposition rate (gN/m2/s) -!JV - real(r8), pointer :: forc_ndep2_grc (:) => null() ! FAN nitrogen deposition (manure) rate (gN/m2/s) - real(r8), pointer :: forc_ndep3_grc (:) => null() ! FAN nitrogen deposition (fertilizer) rate (gN/m2/s) + !JV + ! FAN manure N streams: all-grazing, seasonal-grazing, no-grazing + real(r8), pointer :: forc_ndep_grz_grc (:) => null() ! FAN nitrogen deposition rate (gN/m2/s) + real(r8), pointer :: forc_ndep_sgrz_grc (:) => null() ! FAN nitrogen deposition rate (gN/m2/s) + real(r8), pointer :: forc_ndep_ngrz_grc (:) => null() ! FAN nitrogen deposition rate (gN/m2/s) + real(r8), pointer :: forc_ndep_urea_grc (:) => null() ! FAN nitrogen deposition, urea fertilizer fraction real(r8), pointer :: forc_ndep_nitr_grc (:) => null() ! FAN nitrogen deposition, nitrate fertilizer fraction real(r8), pointer :: forc_soilph_grc (:) => null() ! FAN soil pH @@ -521,10 +524,11 @@ subroutine InitAllocate(this, bounds) allocate(this%forc_ndep_grc (begg:endg)) ; this%forc_ndep_grc (:) = ival !KO if ( use_fan ) then - allocate(this%forc_ndep2_grc (begg:endg)) ; this%forc_ndep2_grc (:) = ival - allocate(this%forc_ndep3_grc (begg:endg)) ; this%forc_ndep3_grc (:) = ival - allocate(this%forc_ndep_urea_grc (begg:endg)) ; this%forc_ndep3_grc (:) = ival - allocate(this%forc_ndep_nitr_grc (begg:endg)) ; this%forc_ndep3_grc (:) = ival + allocate(this%forc_ndep_grz_grc (begg:endg)) ; this%forc_ndep_grz_grc (:) = ival + allocate(this%forc_ndep_sgrz_grc (begg:endg)) ; this%forc_ndep_sgrz_grc (:) = ival + allocate(this%forc_ndep_ngrz_grc (begg:endg)) ; this%forc_ndep_ngrz_grc (:) = ival + allocate(this%forc_ndep_urea_grc (begg:endg)) ; this%forc_ndep_urea_grc (:) = ival + allocate(this%forc_ndep_nitr_grc (begg:endg)) ; this%forc_ndep_nitr_grc (:) = ival allocate(this%forc_soilph_grc (begg:endg)) ; this%forc_soilph_grc (:) = ival end if !KO @@ -1263,8 +1267,9 @@ subroutine Clean(this) deallocate(this%forc_ndep_grc) !KO if (use_fan) then - deallocate(this%forc_ndep2_grc) - deallocate(this%forc_ndep3_grc) + deallocate(this%forc_ndep_grz_grc) + deallocate(this%forc_ndep_sgrz_grc) + deallocate(this%forc_ndep_ngrz_grc) deallocate(this%forc_ndep_nitr_grc) deallocate(this%forc_ndep_urea_grc) deallocate(this%forc_soilph_grc) diff --git a/src/main/fanStreamMod.F90 b/src/main/fanStreamMod.F90 index 244d910f22..382a2b4514 100644 --- a/src/main/fanStreamMod.F90 +++ b/src/main/fanStreamMod.F90 @@ -36,7 +36,7 @@ module FanStreamMod !KO public :: clm_domain_mct ! Sets up MCT domain for this resolution ! ! PRIVATE TYPES - type(shr_strdata_type) :: sdat_past, sdat_mix, sdat_urea, sdat_nitr, sdat_soilph ! input data streams + type(shr_strdata_type) :: sdat_grz, sdat_sgrz, sdat_ngrz, sdat_urea, sdat_nitr, sdat_soilph ! input data streams integer :: stream_year_first_ndep2 ! first year in stream to use integer :: stream_year_last_ndep2 ! last year in stream to use integer :: model_year_align_ndep2 ! align stream_year_firstndep2 with @@ -124,7 +124,7 @@ subroutine fanstream_init(bounds, NLFilename) call clm_domain_mct (bounds, dom_clm) - call shr_strdata_create(sdat_past,name="clmndep2past", & + call shr_strdata_create(sdat_grz,name="clmndep2grz", & pio_subsystem=pio_subsystem, & pio_iotype=shr_pio_getiotype(inst_name), & mpicom=mpicom, compid=comp_id, & @@ -143,8 +143,8 @@ subroutine fanstream_init(bounds, NLFilename) domMaskName='mask', & filePath='', & filename=(/trim(stream_fldFileName_ndep2)/),& - fldListFile='Nmanure_pastures', & - fldListModel='Nmanure_pastures', & + fldListFile='Nmanure_grz', & + fldListModel='Nmanure_grz', & fillalgo='none', & mapalgo=ndep2mapalgo, & calendar=get_calendar(), & @@ -154,7 +154,7 @@ subroutine fanstream_init(bounds, NLFilename) call shr_strdata_print(sdat_past,'CLMNDEP2 data') endif - call shr_strdata_create(sdat_mix,name="clmndep2mixed", & + call shr_strdata_create(sdat_mix,name="clmndep2sgrz", & pio_subsystem=pio_subsystem, & pio_iotype=shr_pio_getiotype(inst_name), & mpicom=mpicom, compid=comp_id, & @@ -173,8 +173,38 @@ subroutine fanstream_init(bounds, NLFilename) domMaskName='mask', & filePath='', & filename=(/trim(stream_fldFileName_ndep2)/),& - fldListFile='Nmanure_mixed', & - fldListModel='Nmanure_mixed', & + fldListFile='Nmanure_sgrz', & + fldListModel='Nmanure_sgrz', & + fillalgo='none', & + mapalgo=ndep2mapalgo, & + calendar=get_calendar(), & + taxmode='extend' ) + + if (masterproc) then + call shr_strdata_print(sdat_mix,'CLMNDEP2 data') + endif + + call shr_strdata_create(sdat_mix,name="clmndep2ngrz", & + pio_subsystem=pio_subsystem, & + pio_iotype=shr_pio_getiotype(inst_name), & + mpicom=mpicom, compid=comp_id, & + gsmap=gsmap_lnd_gdc2glo, ggrid=dom_clm, & + nxg=ldomain%ni, nyg=ldomain%nj, & + yearFirst=stream_year_first_ndep2, & + yearLast=stream_year_last_ndep2, & + yearAlign=model_year_align_ndep2, & + offset=0, & + domFilePath='', & + domFileName=trim(stream_fldFileName_ndep2), & + domTvarName='time', & + domXvarName='x' , & + domYvarName='y' , & + domAreaName='area', & + domMaskName='mask', & + filePath='', & + filename=(/trim(stream_fldFileName_ndep2)/),& + fldListFile='Nmanure_ngrz', & + fldListModel='Nmanure_ngrz', & fillalgo='none', & mapalgo=ndep2mapalgo, & calendar=get_calendar(), & @@ -299,22 +329,30 @@ subroutine fanstream_interp(bounds, atm2lnd_inst) mcdate = year*10000 + mon*100 + day dayspyr = get_days_per_year( ) - call shr_strdata_advance(sdat_past, mcdate, sec, mpicom, 'clmndep2pasture') + call shr_strdata_advance(sdat_grz, mcdate, sec, mpicom, 'clmndep2grz') ig = 0 do g = bounds%begg,bounds%endg ig = ig+1 - atm2lnd_inst%forc_ndep3_grc(g) = sdat_past%avs(1)%rAttr(1,ig) / (secspday * dayspyr) + atm2lnd_inst%forc_ndep_grz_grc(g) = sdat_grz%avs(1)%rAttr(1,ig) / (secspday * dayspyr) end do - call shr_strdata_advance(sdat_mix, mcdate, sec, mpicom, 'clmndep2mixed') + call shr_strdata_advance(sdat_sgrz, mcdate, sec, mpicom, 'clmndep2sgrz') ig = 0 do g = bounds%begg,bounds%endg ig = ig+1 - atm2lnd_inst%forc_ndep2_grc(g) = sdat_mix%avs(1)%rAttr(1,ig) / (secspday * dayspyr) + atm2lnd_inst%forc_ndep_sgrz_grc(g) = sdat_sgrz%avs(1)%rAttr(1,ig) / (secspday * dayspyr) end do + call shr_strdata_advance(sdat_ngrz, mcdate, sec, mpicom, 'clmndep2ngrz') + + ig = 0 + do g = bounds%begg,bounds%endg + ig = ig+1 + atm2lnd_inst%forc_ndep_ngrz_grc(g) = sdat_ngrz%avs(1)%rAttr(1,ig) / (secspday * dayspyr) + end do + call shr_strdata_advance(sdat_urea, mcdate, sec, mpicom, 'clmndep2urea') ig = 0 From 69036c0ce7328a883923ba9862254de25728e5d8 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Thu, 3 Jan 2019 14:41:47 -0500 Subject: [PATCH 034/181] 3-way manure final --- src/biogeochem/CNNDynamicsMod.F90 | 1043 +---------------------------- src/main/fanStreamMod.F90 | 24 +- src/main/ndep2StreamMod.F90 | 285 -------- src/main/ndep3StreamMod.F90 | 285 -------- 4 files changed, 14 insertions(+), 1623 deletions(-) delete mode 100644 src/main/ndep2StreamMod.F90 delete mode 100644 src/main/ndep3StreamMod.F90 diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index 1ff219f062..ff4d5eb865 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -761,7 +761,7 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & real(r8) :: cumflux, totalinput real(r8) :: fluxes_nitr(4), fluxes_tan(4) ! The fraction of manure applied continuously on grasslands (if present in the gridcell) - real(r8), parameter :: fract_continuous = 0.1_r8, kg_to_g = 1e3_r8, max_grazing_fract = 0.5_r8, & + real(r8), parameter :: fract_continuous = 0.1_r8, kg_to_g = 1e3_r8, max_grazing_fract = 0.65_r8, & volat_coef_barns = 0.03_r8, volat_coef_stores = 0.025_r8, & tempr_min_grazing = 283.0_r8!!!! @@ -831,7 +831,7 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & flux_grass_graze = flux_grass_graze + flux_grazing*col%wtgcell(c) if (flux_avail > 1e12 .or. isnan(flux_avail)) then - write(iulog, *) 'bad flux_avail', ndep_mixed_grc(g), lun%wtgcell(l) + write(iulog, *) 'bad flux_avail', ndep_ngrz_grc(g), ndep_sgrz_grc(g), lun%wtgcell(l) call endrun('bad flux_avail') end if @@ -896,1046 +896,7 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & end do ! grid end subroutine handle_storage_v2 - - - subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & - ndep_mixed_grc, n_stored_col, tan_stored_col, & - n_manure_spread_col, tan_manure_spread_col, & - n_manure_graze_col, n_manure_mixed_col, & - nh3_flux_stores, nh3_flux_barns, man_n_transf, & - filter_soilc, num_soilc) - use landunit_varcon, only : max_lunit - use pftconMod, only : nc4_grass, nc3_nonarctic_grass - use clm_varcon, only : ispval - use landunit_varcon, only: istsoil, istcrop - use abortutils , only : endrun - use LandunitType , only: lun - use GridcellType , only: grc - use clm_varctl , only : iulog - use ColumnType , only : col - - implicit none - type(bounds_type), intent(in) :: bounds - type(temperature_type) , intent(in) :: temperature_inst - type(frictionvel_type) , intent(in) :: frictionvel_inst - real(r8), intent(in) :: dt - - ! N excreted in manure, mixed/pastoral systems, gN/m2: - real(r8), intent(in) :: ndep_mixed_grc(bounds%begg:bounds%endg) - real(r8), intent(inout) :: n_stored_col(bounds%begc:bounds%endc), tan_stored_col(bounds%begc:bounds%endc) ! N, TAN currently stored, gN/m2 - ! N, TAN spread on grasslands, gN/m2/s: - real(r8), intent(inout) :: n_manure_spread_col(bounds%begc:bounds%endc) ! for crops, input, determined by crop model, otherwise output - real(r8), intent(out) :: tan_manure_spread_col(bounds%begc:bounds%endc) ! output, calculated from the above and stored manure - ! N excreted by animals allocated to mixed production systems temporarily grazing on grasslands: - real(r8), intent(inout) :: n_manure_graze_col(bounds%begc:bounds%endc) - ! N excreted by animals in mixed systems, total - real(r8), intent(out) :: n_manure_mixed_col(bounds%begc:bounds%endc) - ! NH3 emission fluxes from manure storage and housings, gN/m2/s - real(r8), intent(out) :: nh3_flux_stores(bounds%begc:bounds%endc), nh3_flux_barns(bounds%begc:bounds%endc) - ! total nitrogen flux transferred out of a crop column - real(r8), intent(out) :: man_n_transf(bounds%begc:bounds%endc) - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns - - integer :: begg, endg, g, l, c, il, counter, col_grass, status, p - real(r8) :: flux_avail, flux_grazing - real(r8) :: tempr_ave, windspeed_ave ! windspeed and temperature averaged over agricultural patches - real(r8) :: tempr_barns, tempr_stores, vent_barns, flux_grass_crop, tempr_min_10day, & - flux_grass_graze, flux_grass_spread, flux_grass_spread_tan, flux_grass_crop_tan - real(r8) :: cumflux, totalinput - real(r8) :: fluxes_nitr(4), fluxes_tan(4) - ! The fraction of manure applied continuously on grasslands (if present in the gridcell) - real(r8), parameter :: fract_continuous = 0.1_r8, kg_to_g = 1e3_r8, max_grazing_fract = 0.3_r8, & - tan_fract_excr = 0.5_r8, volat_coef_barns = 0.02_r8, volat_coef_stores = 0.01_r8, & - tempr_min_grazing = 283.0_r8!!!! - - begg = bounds%begg; endg = bounds%endg - nh3_flux_stores(bounds%begc:bounds%endc) = 0_r8 - nh3_flux_barns(bounds%begc:bounds%endc) = 0_r8 - - totalinput = 0.0 - cumflux = 0.0 - - do g = begg, endg - !totalinput = totalinput + ndep_mixed_grc(g) - - ! First find out if there are grasslands in this cell. If yes, a fraction of - ! manure can be diverted to them before storage. - col_grass = ispval - do il = 1, max_lunit - l = grc%landunit_indices(il, g) - if (lun%itype(l) == istsoil) then - do p = lun%patchi(l), lun%patchf(l) - if (patch%itype(p) == nc4_grass .or. patch%itype(p) == nc3_nonarctic_grass) then - col_grass = patch%column(p) - exit - end if - end do - end if - if (col_grass /= ispval) exit - end do - if (col%wtgcell(col_grass) < 1e-6) col_grass = ispval - ! Transfer of manure from all crop columns to the natural vegetation column: - flux_grass_graze = 0_r8 - flux_grass_spread = 0_r8 - flux_grass_spread_tan = 0_r8 - - do il = 1, max_lunit - l = grc%landunit_indices(il, g) - if (l == ispval) cycle - if (lun%itype(l) == istcrop) then - ! flux_avail = manure excreted per m2 of crops (ndep_mixed_grc = per m2 / all land units) - do c = lun%coli(l), lun%colf(l) - if (.not. col%active(c)) cycle - if (col%wtgcell(c) < 1e-6) cycle - - if (col%landunit(c) /= l) then - write(iulog, *) g, il, c, col%landunit(c) - call endrun('something wrong') - end if - if (.not. any(c==filter_soilc(1:num_soilc))) then - write(iulog, *) c, n_manure_spread_col(c) - call endrun('column not in soilfilter') - end if - - flux_avail = ndep_mixed_grc(g) * kg_to_g / lun%wtgcell(l) - if (flux_avail > 1e12 .or. isnan(flux_avail)) then - write(iulog, *) 'bad flux_avail', ndep_mixed_grc(g), lun%wtgcell(l) - call endrun('bad flux_avail') - end if - n_manure_mixed_col(c) = flux_avail - totalinput = totalinput + flux_avail - !manure_input(c) = flux_avail - - !tempr_ave = 0_r8 - !windspeed_ave = 0_r8 - counter = 0 - if (col_grass == c) call endrun('Something wrong with the indices') - if (col%patchi(c) /= col%patchf(c)) then - call endrun(msg="ERROR crop column has multiple patches") - end if - - tempr_ave = temperature_inst%t_ref2m_patch(col%patchi(c)) - windspeed_ave = frictionvel_inst%u10_patch(col%patchi(c)) - - tempr_min_10day = temperature_inst%t_a10min_patch(col%patchi(c)) - if (tempr_min_10day > tempr_min_grazing) then - ! fraction of animals grazing -> allocate some manure to grasslands before barns - flux_grazing = max_grazing_fract * flux_avail - flux_avail = flux_avail - flux_grazing - else - flux_grazing = 0_r8 - end if - flux_grass_graze = flux_grass_graze + flux_grazing*col%wtgcell(c) - - call eval_fluxes_storage(flux_avail, tempr_ave, windspeed_ave, fract_continuous, & - volat_coef_barns, volat_coef_stores, tan_fract_excr, fluxes_nitr, fluxes_tan, status) - if (any(fluxes_nitr > 1e12)) then - write(iulog, *) 'bad fluxes', fluxes_nitr - end if - if (status /=0) then - write(iulog, *) 'status = ', status - call endrun(msg='eval_fluxes_storage failed') - end if - cumflux = cumflux + sum(fluxes_nitr) - - !flux_grass_spread = flux_grass_spread + flux_grass_crop*col%wtgcell(c) - flux_grass_spread = flux_grass_spread + fluxes_nitr(iflx_appl)*col%wtgcell(c) - !flux_grass_spread_tan = flux_grass_spread_tan + flux_grass_crop_tan*col%wtgcell(c) - flux_grass_spread_tan = flux_grass_spread_tan + fluxes_tan(iflx_appl)*col%wtgcell(c) - - - !man_n_transf(c) = flux_grazing - - if (fluxes_tan(iflx_to_store) < 0) then - call endrun(msg="ERROR too much manure lost") - end if - - if (n_stored_col(c) < 0) then - call endrun(msg='n_stored_col is negative') - end if - - if (n_stored_col(c) > 0_r8) then - tan_manure_spread_col(c) = n_manure_spread_col(c) * tan_stored_col(c)/n_stored_col(c) - else if (n_manure_spread_col(c) > 1e-15_r8) then - write(iulog, *) 'stored, spread', n_stored_col(c), n_manure_spread_col(c) - call endrun(msg='Inconsistent manure application') - else - tan_manure_spread_col(c) = 0_r8 - end if - - if (tan_manure_spread_col(c) > 1e6) then - write(iulog, *) 'bad tan_manure', tan_manure_spread_col(c), tan_stored_col(c), & - n_stored_col(c), n_manure_spread_col(c) - end if - - - if (n_manure_spread_col(c) > 1e6) then - write(iulog, *) 'bad n_manure', tan_manure_spread_col(c), tan_stored_col(c), & - n_stored_col(c), n_manure_spread_col(c) - end if - - if (n_manure_spread_col(c)*dt > n_stored_col(c)) then - ! Might happen because the crop phenology runs at radiation timestep - ! and might not have yet ended the fertilization. Quick fix: - n_manure_spread_col(c) = 0 - tan_manure_spread_col(c) = 0 - end if - - n_stored_col(c) = n_stored_col(c) + (fluxes_nitr(iflx_to_store) - n_manure_spread_col(c)) * dt - tan_stored_col(c) = tan_stored_col(c) & - + (fluxes_tan(iflx_to_store) - tan_manure_spread_col(c)) * dt - if (n_stored_col(c) > 1e12) then - call endrun(msg='ERROR bad n_stored_col') - end if - if (n_stored_col(c) < 0) then - if (n_stored_col(c) > -1e-6_r8) then - n_stored_col(c) = 0_r8 - else - call endrun(msg="ERROR negative n_stored_col") - end if - end if - - man_n_transf(c) = fluxes_nitr(iflx_appl) + flux_grazing + n_manure_spread_col(c) - - nh3_flux_stores(c) = fluxes_nitr(iflx_air_stores) - nh3_flux_barns(c) = fluxes_nitr(iflx_air_barns) - - end do ! column - end if ! crop land unit - end do ! landunit - - if (col_grass /= ispval) then - if (tan_manure_spread_col(col_grass) > 1) then - write(iulog, *) 'bad tan_manure col_grass before adding', n_manure_spread_col(col_grass), & - tan_manure_spread_col(col_grass) - end if - n_manure_spread_col(col_grass) = n_manure_spread_col(col_grass) & - + flux_grass_spread / col%wtgcell(col_grass) - tan_manure_spread_col(col_grass) = tan_manure_spread_col(col_grass) & - + flux_grass_spread_tan / col%wtgcell(col_grass) - n_manure_graze_col(col_grass) = n_manure_graze_col(col_grass) + flux_grass_graze / col%wtgcell(col_grass) - !write(iulog, *) 'to grass:', n_manure_spread(col_grass), col_grass - if (tan_manure_spread_col(col_grass) > 1) then - write(iulog, *) 'bad tan_manure col_grass', flux_grass_spread_tan, col%wtgcell(col_grass) - end if - - end if - - end do ! grid - - end subroutine handle_storage - - !----------------------------------------------------------------------- -!KO subroutine CNNDeposition( bounds, & -!KO atm2lnd_inst, soilbiogeochem_nitrogenflux_inst ) -!KO - subroutine CNNDeposition_old( bounds, num_soilc, filter_soilc, & - atm2lnd_inst, soilbiogeochem_nitrogenflux_inst, cnveg_carbonstate_inst, & - soilbiogeochem_nitrogenstate_inst, soilbiogeochem_carbonflux_inst, & - cnveg_nitrogenstate_inst, waterstate_inst, temperature_inst, & - waterflux_inst, frictionvel_inst ) -!KO - ! - ! !DESCRIPTION: - ! On the radiation time step, update the nitrogen deposition rate - ! from atmospheric forcing. For now it is assumed that all the atmospheric - ! N deposition goes to the soil mineral N pool. - ! This could be updated later to divide the inputs between mineral N absorbed - ! directly into the canopy and mineral N entering the soil pool. - ! - ! !USES: - use CNSharedParamsMod , only: use_fun -!KO - use clm_varctl , only: use_fan -! use subgridAveMod , only: p2c - use clm_time_manager , only: get_step_size, get_curr_date, get_curr_calday - use clm_varpar , only: max_patch_per_col - use LandunitType , only: lun - use shr_sys_mod , only : shr_sys_flush -!KO use ColumnType , only: col - use GridcellType , only: grc -!KO use PatchType , only: patch -!KO - ! !ARGUMENTS: - type(bounds_type) , intent(in) :: bounds -!KO - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns -!KO - type(atm2lnd_type) , intent(in) :: atm2lnd_inst - type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst -!KO - type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst - type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst - type(soilbiogeochem_nitrogenstate_type), intent(inout) :: soilbiogeochem_nitrogenstate_inst - type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst - type(waterstate_type) , intent(inout) :: waterstate_inst - type(temperature_type) , intent(inout) :: temperature_inst - type(waterflux_type) , intent(inout) :: waterflux_inst - type(frictionvel_type) , intent(inout) :: frictionvel_inst -!KO - ! - ! !LOCAL VARIABLES: -!KO integer :: g,c ! indices -!KO - integer :: g,c,p,fc,pi ! Indices - integer :: yr, mon, day, sec ! Outputs from get_curr_date - real(r8) :: fmm ! Fraction of manure that changes to methane (0.055; Lerner et al 1988) - real(r8) :: na ! Fraction of N assimilated by cows (0) - real(r8) :: ca ! Fraction of C assimilated by cows (0) - real(r8) :: pl ! Fraction of cows feed consumed from live shoots (0.9; Holland et al, 1992) - real(r8) :: pd ! Fraction of cows feed consumed from dead shoots (0.1; Holland et al, 1992) - real(r8) :: cn ! Carbon:nitrogen ratio (30) - real(r8) :: fua ! Fraction of urine that volatilizes (0.2; Holland et al, 1992) - real(r8) :: fu ! Fraction of manure that is urine (0.5; Parton et al, 2001) - real(r8) :: ffa ! Fraction of feces that volatilizes pre-industrial (0.27; Bouwman et al, 2002) - real(r8) :: ff ! Fraction of manure that is feces (0.5; Parton et al, 2001) - real(r8) :: f1850 ! Fraction of ndep_fert in 1850 (0.19; Potter et al, 2010) - real(r8) :: m1850 ! Fraction of ndep_manure in 1850 (0.19; Potter et al, 2010) - real(r8) :: dt ! Radiation time step (seconds) - real(r8) :: NFactor !KO - real(r8) :: denit !KO - real(r8) :: jday !KO - real(r8) :: loss_manure_u !KO - real(r8) :: loss_manure_n !KO - real(r8) :: loss_manure_a !KO - real(r8) :: loss_manure_r !KO - real(r8) :: TF !KO - real(r8) :: ndep_fertilizer !KO - real(r8) :: loss_fert_u !KO - real(r8) :: R_nox_to_n2o !KO - real(r8) :: kh !KO - real(r8) :: nh3_gas_conc !KO - real(r8) :: fert_nh3_gas_conc !KO - real(r8) :: knh4 !KO - real(r8) :: nh3_aq_conc !KO - real(r8) :: nh3_aq_sat !KO - real(r8) :: NH4_fert !KO - real(r8) :: NH4_manu !KO - real(r8) :: kf ! Decay rate of urea - real(r8) :: dnh4,dno3 ! Base rate diffusion for nh4 and no3 - real(r8) :: porosity !KO - real(r8) :: ratenh4tosom,rateno3tosom !KO - real(r8) :: canopy_frac ! Fraction of NH3 emissions captured by canopy - real(r8) :: manu_inc,fert_inc ! N mechanically incorporated into soil on a timescale of one year - real(r8) :: k_relax ! Timescale for manure/fert water to relax to soil water (top 5cm) - - ! local pointers to implicit in scalars - integer , pointer :: gridcell (:) ! Index into gridcell level quantities - integer , pointer :: npfts (:) ! Number of pfts for each column - integer , pointer :: pfti (:) ! Beginning pft index for each column - real(r8), pointer :: latdeg (:) ! Latitude in degrees - - real(r8), pointer :: forc_wind (:) ! Wind speed (m s-1) - real(r8), pointer :: forc_rh (:) ! Relative humidity(%) - real(r8), pointer :: forc_ndep2 (:) ! Nitrogen deposition rate (gN/ha/yr) - real(r8), pointer :: forc_ndep3 (:) ! Nitrogen deposition rate (gN/ha/yr) - - real(r8), pointer :: ndep_manure (:) ! Nitrogen manure deposition rate (gN/m2/s) - real(r8), pointer :: ndep_fert (:) ! Nitrogen fertilizer deposition rate (gN/m2/s) - real(r8), pointer :: nh3_manure (:) ! NH3 emission from manure(gN/m2/s) - real(r8), pointer :: gamma_nh3 (:) !KO - real(r8), pointer :: gamma_nh3_fert (:) !KO - real(r8), pointer :: nh3_fert (:) ! NH3 emission from fertilizer(gN/m2/s) - real(r8), pointer :: nhxdep_to_sminn (:) ! NHx deposition from fertilizer & manure NH3 emissions(gN/m2/s) - real(r8), pointer :: noydep_to_sminn (:) ! NOy deposition (gN/m2/s) - real(r8), pointer :: nmanure_to_sminn (:) ! N deposition to soil mineral from manure(gN/m2/s) - real(r8), pointer :: nfert_to_sminn (:) ! N deposition to soil mineral from fertilizer(gN/m2/s) - real(r8), pointer :: N_Run_Off (:) ! Nitrogen Run Off from manure (gN/m2/s) - real(r8), pointer :: N_Run_Off_fert (:) ! Nitrogen Run Off from fertilizer(gN/m2/s) - real(r8), pointer :: manure_f_n2o_nit (:) ! N2O emission from nitrification of manure (gN/m2/s) - real(r8), pointer :: manure_f_n2_denit (:) ! N2 emission from denitrification of manure (gN/m2/s) - real(r8), pointer :: manure_f_nox_nit (:) ! NOx emission from nitrification of manure (gN/m2/s) - real(r8), pointer :: fert_f_n2o_nit (:) ! N2O emission from nitrification of fertilizer (gN/m2/s) - real(r8), pointer :: fert_f_n2_denit (:) ! N2 emission from denitrification of fertilizer (gN/m2/s) - real(r8), pointer :: fert_f_nox_nit (:) ! NOx emission from nitrification of fertilizer (gN/m2/s) - real(r8), pointer :: no3_manure_to_soil (:) ! NO3 flow from manure to soil @ 25 % NO3 pool per hour (gN/m2/s) - real(r8), pointer :: TAN_manure_to_soil (:) ! NH4 flow from TAN manure to soil @ 1 % TAN pool per day (gN/m2/s) - real(r8), pointer :: no3_fert_to_soil (:) ! NO3 flow from fertilizer to soil @ 25 % NO3 pool per hour (gN/m2/s) - real(r8), pointer :: TAN_fert_to_soil (:) ! NH4 flow from TAN fertilizer to soil @ 1 % TAN pool per day (gN/m2/s) - real(r8), pointer :: Nd (:) ! Total Amount of N emitted during denitrification (gN/m2/s) - real(r8), pointer :: lat_fert (:) !KO - - real(r8), pointer :: ndep_total (:) ! Total nitrogen deposition rate (gN/m2) - real(r8), pointer :: TAN_manu (:) ! Manure Total Ammoniacal Nitrogen (gN/m2) - real(r8), pointer :: TAN_fert (:) ! Fertilizer Total Ammoniacal Nitrogen (gN/m2) - real(r8), pointer :: man_water_pool (:) ! Volume of water in manure/water solution (m3/m2) - real(r8), pointer :: fert_water_pool (:) ! Volume of water in fert/water solution (m3/m2) - real(r8), pointer :: no3_manure (:) ! NO3 pool in manure (gN/m2) - real(r8), pointer :: no3_fert (:) ! NO3 pool in fertilizer(gN/m2) - real(r8), pointer :: nh3_manure_total (:) ! Total NH3 created from manure to atmosphere (gN/m2) - real(r8), pointer :: no3_manure_total (:) ! Total NO3 created from manure(gN/m2) - real(r8), pointer :: nh4_manure_total (:) ! Total NH4 created from manure (gN/m2) - real(r8), pointer :: manure_u (:) ! Urine N pool in manure (gN/m2) - real(r8), pointer :: manure_n (:) ! Non-minerizable N pool in manure (gN/m2) - real(r8), pointer :: manure_a (:) ! Available N pool in manure (gN/m2) - real(r8), pointer :: manure_r (:) ! Resistant N pool in manure (gN/m2) - real(r8), pointer :: fert_u (:) ! Fertilizer N pool (gN/m2) - real(r8), pointer :: ndep_fert_total (:) ! Total nitrogen deposition rate of fertilizer(gN/m2) - real(r8), pointer :: nh3_fert_total (:) ! Total NH3 created from fertilizer to atmosphere (gN/m2) - real(r8), pointer :: no3_fert_total (:) ! Total NO3 created from fertilizer(gN/m2) - real(r8), pointer :: nh4_fert_total (:) ! Total NH4 created from fertilizer (gN/m2) - real(r8), pointer :: total_ndep (:) ! Total nitrogen deposition from Nr (gN/m2) - real(r8), pointer :: total_nh3 (:) ! Total NH3 created from Nr to atmosphere (gN/m2) - real(r8), pointer :: total_N_Run_Off (:) ! Total N washed from Nr (gN/m2) - real(r8), pointer :: total_no3 (:) ! Total NO3 created from Nr(gN/m2) - real(r8), pointer :: total_nh4 (:) ! Total NH4 created from Nr (gN/m2) - real(r8), pointer :: ra_col (:) ! Aerodynamic resistance for grass pfts (s/m) - real(r8), pointer :: rb_col (:) ! Leaf boundary layer resistance for grass pfts (s/m) - real(r8), pointer :: fert_app_jday (:) ! Julian day of the first fertilizer application (day) - real(r8), pointer :: gdd8_col (:) ! Col growing degree-days base 8C from planting (ddays) - real(r8), pointer :: t_a10_col (:) ! Col 10-day running mean of the 2 m temperature (K) - real(r8), pointer :: t_a10min_col (:) ! Col 10-day running mean of min 2-m temperature (K) - real(r8), pointer :: N_Run_Off_manure_total (:) ! Total N washed from manure (gN/m2) - real(r8), pointer :: N_Run_Off_fert_total (:) ! Total N washed from fertilizer (gN/m2) - - real(r8), pointer :: leafn_manure (:) ! Leaf N (gN/m2) - real(r8), pointer :: deadstemn_manure (:) ! Dead stem N eaten by cows (gN/m2) - - real(r8), pointer :: methane_manure (:) ! Emission of CH4 from cows (gC/m2/s) - real(r8), pointer :: cmanure_to_sminn (:) ! Deposition of C from manure to soil mineral C (gC/m2/s) - real(r8), pointer :: somhr (:) ! Soil organic matter heterotrophic respiration (gC/m2/s) - - real(r8), pointer :: total_leafc (:) ! Total C at column-level (gC/m2) - real(r8), pointer :: leafc (:) ! Leaf carbon (gC/m2) - real(r8), pointer :: leafc_manure (:) ! Leaf C eaten by cows (gC/m2) - real(r8), pointer :: deadstemc_manure (:) ! Dead stem C eaten by cows (gC/m2) - - real(r8), pointer :: t_grnd (:) ! Ground temperature (K) - real(r8), pointer :: gdd8_patch (:) ! patch Growing degree-days base 8C from planting (ddays) - real(r8), pointer :: t_a10_patch (:) ! patch 10-day running mean of the 2 m temperature (K) - real(r8), pointer :: t_a10min_patch (:) ! patch 10-day running mean of min 2-m temperature - - real(r8), pointer :: h2osoi_liqice_5cm (:) ! Liquid water + ice lens in top 5cm of soil (kg/m2) - real(r8), pointer :: qflx_runoff (:) ! Total runoff (qflx_drain+qflx_surf+qflx_qrgwl) (mm H2O /s) - - real(r8), pointer :: ram1 (:) ! Aerodynamical air resistance (s/m) - real(r8), pointer :: rb1 (:) ! Aerodynamical boundary layer resistance (s/m) -!KO - !----------------------------------------------------------------------- - - associate( & - forc_ndep => atm2lnd_inst%forc_ndep_grc , & ! Input: [real(r8) (:)] nitrogen deposition rate (gN/m2/s) - ndep_to_sminn => soilbiogeochem_nitrogenflux_inst%ndep_to_sminn_col & ! Output: [real(r8) (:)] atmospheric N deposition to soil mineral N (gN/m2/s) - ) -!KO - if ( use_fan ) then - - gridcell => col%gridcell - npfts => col%npatches - pfti => col%patchi - latdeg => grc%latdeg - - forc_wind => atm2lnd_inst%forc_wind_grc - forc_rh => atm2lnd_inst%forc_rh_grc - forc_ndep2 => atm2lnd_inst%forc_ndep2_grc - forc_ndep3 => atm2lnd_inst%forc_ndep3_grc - - ndep_manure => soilbiogeochem_nitrogenflux_inst%ndep_manure_col - ndep_fert => soilbiogeochem_nitrogenflux_inst%ndep_fert_col - nh3_manure => soilbiogeochem_nitrogenflux_inst%nh3_manure_col - gamma_nh3 => soilbiogeochem_nitrogenflux_inst%gamma_nh3_col - gamma_nh3_fert => soilbiogeochem_nitrogenflux_inst%gamma_nh3_fert_col - nh3_fert => soilbiogeochem_nitrogenflux_inst%nh3_fert_col - nhxdep_to_sminn => soilbiogeochem_nitrogenflux_inst%nhxdep_to_sminn_col - noydep_to_sminn => soilbiogeochem_nitrogenflux_inst%noydep_to_sminn_col - nmanure_to_sminn => soilbiogeochem_nitrogenflux_inst%nmanure_to_sminn_col - nfert_to_sminn => soilbiogeochem_nitrogenflux_inst%nfert_to_sminn_col - N_Run_Off => soilbiogeochem_nitrogenflux_inst%N_Run_Off_col - N_Run_Off_fert => soilbiogeochem_nitrogenflux_inst%N_Run_Off_fert_col - manure_f_n2o_nit => soilbiogeochem_nitrogenflux_inst%manure_f_n2o_nit_col - manure_f_n2_denit => soilbiogeochem_nitrogenflux_inst%manure_f_n2_denit_col - manure_f_nox_nit => soilbiogeochem_nitrogenflux_inst%manure_f_nox_nit_col - fert_f_n2o_nit => soilbiogeochem_nitrogenflux_inst%fert_f_n2o_nit_col - fert_f_n2_denit => soilbiogeochem_nitrogenflux_inst%fert_f_n2_denit_col - fert_f_nox_nit => soilbiogeochem_nitrogenflux_inst%fert_f_nox_nit_col - no3_manure_to_soil => soilbiogeochem_nitrogenflux_inst%no3_manure_to_soil_col - TAN_manure_to_soil => soilbiogeochem_nitrogenflux_inst%TAN_manure_to_soil_col - no3_fert_to_soil => soilbiogeochem_nitrogenflux_inst%no3_fert_to_soil_col - TAN_fert_to_soil => soilbiogeochem_nitrogenflux_inst%TAN_fert_to_soil_col - Nd => soilbiogeochem_nitrogenflux_inst%Nd_col - lat_fert => soilbiogeochem_nitrogenflux_inst%lat_fert_col - - ndep_total => soilbiogeochem_nitrogenstate_inst%ndep_total_col - TAN_manu => soilbiogeochem_nitrogenstate_inst%TAN_manu_col - TAN_fert => soilbiogeochem_nitrogenstate_inst%TAN_fert_col - man_water_pool => soilbiogeochem_nitrogenstate_inst%man_water_pool_col - fert_water_pool => soilbiogeochem_nitrogenstate_inst%fert_water_pool_col - no3_manure => soilbiogeochem_nitrogenstate_inst%no3_manure_col - no3_fert => soilbiogeochem_nitrogenstate_inst%no3_fert_col - nh3_manure_total => soilbiogeochem_nitrogenstate_inst%nh3_manure_total_col - no3_manure_total => soilbiogeochem_nitrogenstate_inst%no3_manure_total_col - nh4_manure_total => soilbiogeochem_nitrogenstate_inst%nh4_manure_total_col - manure_u => soilbiogeochem_nitrogenstate_inst%manure_u_col - manure_n => soilbiogeochem_nitrogenstate_inst%manure_n_col - manure_a => soilbiogeochem_nitrogenstate_inst%manure_a_col - manure_r => soilbiogeochem_nitrogenstate_inst%manure_r_col - fert_u => soilbiogeochem_nitrogenstate_inst%fert_u_col - ndep_fert_total => soilbiogeochem_nitrogenstate_inst%ndep_fert_total_col - nh3_fert_total => soilbiogeochem_nitrogenstate_inst%nh3_fert_total_col - no3_fert_total => soilbiogeochem_nitrogenstate_inst%no3_fert_total_col - nh4_fert_total => soilbiogeochem_nitrogenstate_inst%nh4_fert_total_col - total_ndep => soilbiogeochem_nitrogenstate_inst%total_ndep_col - total_nh3 => soilbiogeochem_nitrogenstate_inst%total_nh3_col - total_N_Run_Off => soilbiogeochem_nitrogenstate_inst%total_N_Run_Off_col - total_no3 => soilbiogeochem_nitrogenstate_inst%total_no3_col - total_nh4 => soilbiogeochem_nitrogenstate_inst%total_nh4_col - ra_col => soilbiogeochem_nitrogenstate_inst%ra_col - rb_col => soilbiogeochem_nitrogenstate_inst%rb_col - fert_app_jday => soilbiogeochem_nitrogenstate_inst%fert_app_jday_col - gdd8_col => soilbiogeochem_nitrogenstate_inst%gdd8_col - t_a10_col => soilbiogeochem_nitrogenstate_inst%t_a10_col - t_a10min_col => soilbiogeochem_nitrogenstate_inst%t_a10min_col - N_Run_Off_manure_total => soilbiogeochem_nitrogenstate_inst%N_Run_Off_manure_total_col - N_Run_Off_fert_total => soilbiogeochem_nitrogenstate_inst%N_Run_Off_fert_total_col - - leafn_manure => cnveg_nitrogenstate_inst%leafn_manure_patch - deadstemn_manure => cnveg_nitrogenstate_inst%deadstemn_manure_patch - - methane_manure => soilbiogeochem_carbonflux_inst%methane_manure_col - cmanure_to_sminn => soilbiogeochem_carbonflux_inst%cmanure_to_sminn_col - somhr => soilbiogeochem_carbonflux_inst%somhr_col - - total_leafc => cnveg_carbonstate_inst%total_leafc_col - leafc => cnveg_carbonstate_inst%leafc_patch - leafc_manure => cnveg_carbonstate_inst%leafc_manure_patch - deadstemc_manure => cnveg_carbonstate_inst%deadstemc_manure_patch - - t_grnd => temperature_inst%t_grnd_col - gdd8_patch => temperature_inst%gdd8_patch - t_a10_patch => temperature_inst%t_a10_patch - t_a10min_patch => temperature_inst%t_a10min_patch - - h2osoi_liqice_5cm => waterstate_inst%h2osoi_liqice_5cm_col - - qflx_runoff => waterflux_inst%qflx_runoff_col - - ram1 => frictionvel_inst%ram1_patch - rb1 => frictionvel_inst%rb1_patch - - end if -!KO - -!KO - ! Loop through columns - do c = bounds%begc, bounds%endc - g = col%gridcell(c) - ndep_to_sminn(c) = forc_ndep(g) - end do - - if ( use_fan ) then - - fmm = 0._r8 - na = 0._r8 - ca = 0._r8 - pl = 1.0_r8 - pd = 0._r8 - cn = 30._r8 !Carbon:nitrogen - fua = 0.2_r8 - fu = 0.5_r8 - ffa = 0.27_r8 - ff = 0.5_r8 - - !*pgmh urea decomposition rate (1/s) - kf = 4.83e-06_r8 ! [Agehara and Warncke, 2005 - dnh4 = 9.8e-10_r8 ! from genermont and cellier - dno3 = 1.3e-08_r8 ! fast x13 than dnh4 consistent with data - porosity = 0.5_r8 - !*pgmh - canopy_frac = 0.6_r8 - - call get_curr_date(yr, mon, day, sec) - m1850 = 0.00000000004_r8 * exp(0.012_r8 * yr) - f1850 = 1.05_r8/(1._r8+exp(0.13_r8*(1975-yr))) - - dt = real( get_step_size(), r8 ) -!KO - - ! Loop through columns - do c = bounds%begc, bounds%endc - g = col%gridcell(c) -!KO ndep_to_sminn(c) = forc_ndep(g) -!KO - !calculate the nitrogen excreted (kg ha-1 s-1) by cows from file - !Nmanure.nc, then change to (g m-2 s-1) - - ndep_manure(c) = forc_ndep2(g) / (10._r8) * m1850 - ndep_fert(c) = forc_ndep3(g) / (10._r8) * f1850 - - lat_fert(c) = latdeg(g) - - !Remove any NaN values - if (ndep_manure(c) .ne. ndep_manure(c)) ndep_manure(c) = 0._r8 - if (ndep_fert(c) .ne. ndep_fert(c)) ndep_fert(c) = 0._r8 -!KO - - end do -!KO - ! Convert pft-level variables to column-level for computing fertilizer application date and - ! aerodynamic resistance factors. These conversions will not be necessary once this code is - ! implemented in the crop model where crop calculations are done on their own column. - call p2c(bounds, num_soilc, filter_soilc, & - ram1(bounds%begp:bounds%endp), & - ra_col(bounds%begc:bounds%endc)) - call p2c(bounds, num_soilc, filter_soilc, & - rb1(bounds%begp:bounds%endp), & - rb_col(bounds%begc:bounds%endc)) - call p2c(bounds, num_soilc, filter_soilc, & - gdd8_patch(bounds%begp:bounds%endp), & - gdd8_col(bounds%begc:bounds%endc)) - call p2c(bounds, num_soilc, filter_soilc, & - t_a10_patch(bounds%begp:bounds%endp), & - t_a10_col(bounds%begc:bounds%endc)) - call p2c(bounds, num_soilc, filter_soilc, & - t_a10min_patch(bounds%begp:bounds%endp), & - t_a10min_col(bounds%begc:bounds%endc)) - - do fc = 1,num_soilc - c = filter_soilc(fc) - - do pi = 1,max_patch_per_col - if ( pi <= npfts(c) ) then - p = pfti(c) + pi - 1 -!KO - if (patch%active(p)) then -!KO -!KO total_leafc(c) = total_leafc(c) + leafc(p) -!KO - total_leafc(c) = total_leafc(c) + leafc(p) * patch%wtcol(p) -!KO - end if - end if - end do - - ! Fertilize crops 1 time a year when planting conditions are first met. The conditions - ! for corn planting are used here for all crops. The earliest date of planting is April - ! 1st and the latest date is June 14th for the NHemis, add 180 days for Shemis planting - jday = get_curr_calday() - - if (jday .eq. 1) fert_app_jday(c) = 0._r8 - - if (t_a10_col(c) >= 283.15_r8 .and. t_a10min_col(c) >= 279.15_r8 .and. & - gdd8_col(c) >= 50._r8 .and. fert_app_jday(c) .eq. 0._r8 .and. & - jday .gt. 90._r8 .and. lat_fert(c) .gt. 0._r8) fert_app_jday(c) = jday - if (t_a10_col(c) >= 283.15_r8 .and. t_a10min_col(c) >= 279.15_r8 .and. & - gdd8_col(c) >= 50._r8 .and. fert_app_jday(c) .eq. 0._r8 .and. & - jday .gt. 272._r8 .and. lat_fert(c) .lt. 0._r8) fert_app_jday(c) = jday - - if (jday .eq. 165._r8 .and. lat_fert(c) .gt. 0._r8 .and. fert_app_jday(c) .eq. 0._r8) fert_app_jday(c) = jday - if (jday .eq. 347._r8 .and. lat_fert(c) .lt. 0._r8 .and. fert_app_jday(c) .eq. 0._r8) fert_app_jday(c) = jday - - ! Add fertilizer (ndep_fertilizer) - if (jday .eq. fert_app_jday(c)) then - ndep_fertilizer = (ndep_fert(c) * 3600._r8 * 24._r8 * 365._r8 ) - - ! If there is any N in existing fertilizer pools, add this to the soil pool (later on in code) - ! before adding the new fertilizer N to the TAN_fert pool. - fert_inc = TAN_fert(c)+fert_u(c) - fert_u(c) = 0._r8 - TAN_fert(c) = 0._r8 - else - !KO fert_inc needs to be set here, for now assume 0? - fert_inc = 0._r8 - ndep_fertilizer = 0._r8 - end if - - fert_u(c) = fert_u(c) + ndep_fertilizer - - ! Fertilizer decay into the TAN pool following King and Balogh, 2000 (using one day timescale) - if (t_grnd(c) <= 273._r8) then - loss_fert_u = 0._r8 - else -!*pgmh changed to a rate consistent with urea -! loss_fert_u = fert_u(c)*(1._r8 - exp(-1._r8 * dt * (0.04_r8/(86400._r8)) *(((t_grnd(c) - 273._r8) / 38._r8))**1.33_r8)) - fert_u(c) = fert_u(c) / (1._r8+dt*kf) - loss_fert_u = dt * kf * fert_u(c) - TAN_fert(c) = TAN_fert(c) + loss_fert_u - end if - -! TAN_fert(c) = TAN_fert(c) + loss_fert_u -! fert_u(c) = fert_u(c) - loss_fert_u -!*pgmh - ! Manure decay into TAN pool - - ! Here the N from manure is divided into separate pools. - ! Urine (urea) is 50 % of the N excreted by the animals (Parton et al., 1987) - ! Non-mineralizable = 10 % feces N, Available = 44 % feces N & Resistant = 46 % feces N (Andrews, 1996) - - manure_u(c) = manure_u(c) + (ndep_manure(c)* 0.5_r8 *dt) - manure_n(c) = manure_n(c) + (0.025_r8 * ndep_manure(c) * dt) - manure_a(c) = manure_a(c) + (0.25_r8 * ndep_manure(c) * dt) - manure_r(c) = manure_r(c) + (0.225_r8 * ndep_manure(c) * dt) - - TF = 0.0106_r8 * exp(0.12979_r8 * (t_grnd(c) - 273._r8)) - - loss_manure_u = manure_u(c) - loss_manure_n = 0._r8 - loss_manure_a = manure_a(c) * (1._r8 - exp(TF * (8.938e-7_r8 * (-1._r8) * dt))) - loss_manure_r = manure_r(c) * (1._r8 - exp(TF * (6.38e-8_r8 * (-1._r8) * dt))) - - TAN_manu(c) = TAN_manu(c) + loss_manure_u + loss_manure_n + loss_manure_a + loss_manure_r - - ! Represent mechanical incorporation of manure into soil, timescale of one year - manu_inc = (dt/(365._r8 * 86400._r8)) * (manure_r(c) + manure_a(c)) - - manure_u(c) = manure_u(c) - loss_manure_u - manure_n(c) = manure_n(c) - loss_manure_n - manure_r(c) = manure_r(c) - loss_manure_r - (dt/(365._r8 * 86400._r8))*manure_r(c) - manure_a(c) = manure_a(c) - loss_manure_a - (dt/(365._r8 * 86400._r8))*manure_a(c) - - ! Take N content of manure as 1% dry matter and the water content of manure as 85% of total mass - ! Thus, the water content added is 567 times the N content added at each timstep. - k_relax = dt/(3._r8*86400._r8) - - ! Add manure water and relax the manure water content to the water content of the top 5 cm of soil - ! on a timescale of 3 days (k_relax) - if (TAN_manu(c) .gt. 0._r8) then - man_water_pool(c) = man_water_pool(c)+(1.e-6_r8*ndep_manure(c)*dt*566.6667_r8) - & - k_relax*(man_water_pool(c)-h2osoi_liqice_5cm(c)*1.e-3_r8) - else - man_water_pool(c) = 0._r8 - TAN_manu(c) = 0._r8 - end if - - if (man_water_pool(c) .ne. man_water_pool(c)) man_water_pool(c) = 0._r8 - !Remove Manure TAN pool washed off by rain using the method of the global NEWS model (Harrison et al., 2005) - if (TAN_manu(c) <= 0._r8) then - N_Run_Off(c) = 0._r8 - TAN_manu(c) = 0._r8 -!*pgmh convert qflx_surf from mm/sec to m/sec -! elseif ((0.94_r8 * TAN_manu(c) * (qflx_surf(c)))*dt > TAN_manu(c)) then - elseif ((TAN_manu(c)/man_water_pool(c) * (qflx_runoff(c)*1.e-3_r8))*dt > TAN_manu(c)) then -!*pgmh - N_Run_Off(c) = TAN_manu(c) / dt - else -!*pgmh convert qflx_surf from mm/sec to m/sec -! N_Run_Off(c) = 0.94_r8 * TAN_manu(c) * (qflx_surf(c)) - N_Run_Off(c) = TAN_manu(c)/man_water_pool(c) * (qflx_runoff(c)*1.e-3_r8) -!*pgmh - end if - -!KO TAN_manu(c) = TAN_manu(c) - N_Run_Off(c)*dt -!KO - ! Protect against negative values of TAN_manu which can cause divide by - ! zero errors in NFactor below, and adjust N_Run_Off accordingly - TAN_manu(c) = TAN_manu(c) - min(N_Run_Off(c)*dt,TAN_manu(c)) - N_Run_Off(c) = min(N_Run_Off(c),TAN_manu(c)/dt) -!KO - - ! Calculate nh3_gas_conc. (PGMH 29th August 2014). Note that a neutral pH is assumed (1.e-7) and that - ! the units of nh3_gas_conc are g/m3. If the column is completely dry, the nh3_gas_conc is set to zero. - kh = 56._r8*exp(4092._r8*((1._r8/t_grnd(c))-(1._r8/298.15_r8))) - knh4 = 5.67e-10_r8*exp(-6286._r8*((1._r8/t_grnd(c))-(1._r8/298.15_r8))) ! [mole/Liter] - - if (man_water_pool(c) .le. 0._r8) then - man_water_pool(c) = 0._r8 - nh3_gas_conc = 0._r8 - else - nh3_gas_conc = (TAN_manu(c)/man_water_pool(c))/ & - (1._r8+(kh*t_grnd(c)/12.2_r8)+(kh*t_grnd(c)/12.2_r8)*(1.e-7_r8/knh4)) - endif - - ! Compute nh3 saturation with respect to the aqueous concentration of nh3 - nh3_aq_conc = (t_grnd(c)/12.2_r8)*kh*nh3_gas_conc ! [g/m3] - nh3_aq_sat = (10._r8**((966.7475_r8/t_grnd(c))-0.57953_r8))*1.e3_r8 ! [g/m3] - - if (nh3_aq_conc .gt. nh3_aq_sat) then - nh3_aq_conc=nh3_aq_sat - nh3_gas_conc=nh3_aq_sat*(12.2_r8/t_grnd(c))*(1._r8/kh) - endif - - ! Calculate NH3 emission - if (nh3_gas_conc < 3.e-7_r8) then - nh3_manure(c) = 0._r8 - else -!*pgmh -! nh3_manure(c) = ((nh3_gas_conc-3.e-7)/(ra_col(c)+rb_col(c))) * 0.35_r8 - nh3_manure(c) = ((nh3_gas_conc-3.e-7_r8)/(ra_col(c)+rb_col(c))) * (1._r8-canopy_frac) -!*pgmh - end if - - if (nh3_manure(c) .ne. nh3_manure(c)) nh3_manure(c) = 0._r8 - - !Calculate the amount of water in TAN of Fertilizer. Water is added when fertilizer - ! is applied, and then the total water pool is relaxed to the water in the top 5cm of soil - if (TAN_fert(c) .gt. 0._r8) then - fert_water_pool(c) = fert_water_pool(c)+(((1.e-6_r8*(ndep_fertilizer*dt))/0.466_r8)/ & - (0.66_r8 *exp(0.0239_r8*(t_grnd(c)-273._r8))))-& - k_relax*(fert_water_pool(c)-h2osoi_liqice_5cm(c)*1.e-3_r8) - else - fert_water_pool(c) = 0._r8 - TAN_fert(c) = 0._r8 - end if - - if (fert_water_pool(c) .ne. fert_water_pool(c)) fert_water_pool(c) = 0._r8 - - !Remove Fertilizer TAN pool washed off by rain at rate of the global NEWS model (Harrison et al., 2005) - if (TAN_fert(c) <= 0._r8) then - N_Run_Off_fert(c) = 0._r8 - TAN_fert(c) = 0._r8 -!*pgmh convert qflx_surf from mm/sec to m/sec -! elseif ((0.94_r8 * TAN_fert(c) *(qflx_surf(c)))*dt > TAN_fert(c)) then - elseif ((TAN_fert(c)/fert_water_pool(c) *(qflx_runoff(c)*1.e-3_r8))*dt > TAN_fert(c)) then -!*pgmh - N_Run_Off_fert(c) = TAN_fert(c) / dt - else -!*pgmh convert qflx_surf from mm/sec to m/sec -! N_Run_Off_fert(c) = 0.94_r8 * TAN_fert(c) *(qflx_surf(c)) - N_Run_Off_fert(c) = TAN_fert(c)/fert_water_pool(c) *(qflx_runoff(c)*1.e-3_r8) -!*pgmh - end if -!KO TAN_fert(c) = TAN_fert(c) - N_Run_Off_fert(c)*dt -!KO - ! Protect against negative values of TAN_fert which can cause divide by - ! zero errors in NFactor below, and adjust N_Run_Off_fert accordingly - TAN_fert(c) = TAN_fert(c) - min(N_Run_Off_fert(c)*dt,TAN_fert(c)) - N_Run_Off_fert(c) = min(N_Run_Off_fert(c),TAN_fert(c)/dt) -!KO - - !Calculate gamma for fertilizer - if (fert_water_pool(c) .le. 0._r8) then - fert_water_pool(c) = 0._r8 - fert_nh3_gas_conc = 0._r8 - else - fert_nh3_gas_conc = (TAN_fert(c)/fert_water_pool(c))/ & - (1._r8+(kh*t_grnd(c)/12.2_r8)+(kh*t_grnd(c)/12.2_r8)*(1.e-7_r8/knh4)) - endif - - ! Compute nh3 saturation with respect to the aqueous concentration of nh3 - nh3_aq_conc = (t_grnd(c)/12.2_r8)*kh*fert_nh3_gas_conc ! [g/m3] - - if (nh3_aq_conc .gt. nh3_aq_sat) then - nh3_aq_conc=nh3_aq_sat - fert_nh3_gas_conc=nh3_aq_sat*(12.2_r8/t_grnd(c))*(1._r8/kh) - endif - - ! Calculate NH3 emission - if (fert_nh3_gas_conc < 3.e-7_r8) then - nh3_fert(c) = 0._r8 - else -!*pgmh -! nh3_fert(c) = ((fert_nh3_gas_conc-3.e-7)/(ra_col(c)+rb_col(c))) * 0.35_r8 - nh3_fert(c) = ((fert_nh3_gas_conc-3.e-7_r8)/(ra_col(c)+rb_col(c))) * (1._r8-canopy_frac) -!*pgmh - end if - if (nh3_fert(c) .ne. nh3_fert(c)) nh3_fert(c)=0._r8 - - ! Calculate transfert to soil organic matter - NH4_manu = (kh*t_grnd(c)/12.2_r8)*(1.e-7_r8/knh4)*nh3_gas_conc*man_water_pool(c) - if (t_grnd(c) > 313._r8) then - !nmanure_to_sminn(c) = 0._r8 -!*dsw set to canopy captured N for very high temperatures - nmanure_to_sminn(c) = (nh3_manure(c) / (1._r8-canopy_frac) * canopy_frac) - else -!*pgmh units incorect for conversion, also assume 70% leave capture -! nmanure_to_sminn(c) = ((2.*1.16e-6*NH4_manu) / ((1./(1.0 - exp(-1.0 * ((h2osoi_liqice_5cm(c)*9.5e-3)/ 0.12)**2.0))) & -! +(1./((((40. - (t_grnd(c)-273.))/12.)**2.4) * exp(0.2*((t_grnd(c)-273.)-28.)))))) & -! +(nh3_manure(c) / 0.35_r8 * 0.65_r8) - nmanure_to_sminn(c) = ((2._r8*1.16e-6_r8*NH4_manu) / & - ((1._r8/(1._r8 - exp(-1._r8 * ((h2osoi_liqice_5cm(c)*0.019_r8)/ 0.12_r8)**2._r8))) + & - (1._r8/((((40._r8 - (t_grnd(c)-273._r8))/12._r8)**2.4_r8) * & - exp(0.2_r8*((t_grnd(c)-273._r8)-28._r8)))))) & - +(nh3_manure(c) / (1._r8-canopy_frac) * canopy_frac) -!*pgmh units incorect for conversion - end if - - ! Calculate soil organic matter - NH4_fert = (kh*t_grnd(c)/12.2_r8)*(1.e-7_r8/knh4)*fert_nh3_gas_conc*fert_water_pool(c) - if (t_grnd(c) > 313._r8) then -! nfert_to_sminn(c) = 0._r8 -!*dsw set to canopy captured N for very high temperatures - nfert_to_sminn(c) = (nh3_fert(c) / (1._r8-canopy_frac) * canopy_frac) - else -!*pgmh units incorect for conversion -! nfert_to_sminn(c) = ((2.*1.16e-6*NH4_fert) / ((1./(1.0 - exp(-1.0 * ((h2osoi_liqice_5cm(c)*9.5e-3)/0.12)**2.0))) & -! +(1./((((40. - (t_grnd(c)-273.))/12.)**2.4) * exp(0.2*((t_grnd(c)-273.)-28.)))))) & -! +(nh3_fert(c) / 0.35_r8 * 0.65_r8) - - nfert_to_sminn(c) = ((2._r8*1.16e-6_r8*NH4_fert) / & - ((1._r8/(1._r8 - exp(-1._r8 * ((h2osoi_liqice_5cm(c)*0.019_r8)/0.12_r8)**2._r8))) + & - (1._r8/((((40._r8 - (t_grnd(c)-273._r8))/12._r8)**2.4_r8) * & - exp(0.2_r8*((t_grnd(c)-273._r8)-28._r8)))))) & - +(nh3_fert(c) / (1._r8-canopy_frac) * canopy_frac) -!*pgmh units incorect for conversion - end if - - !Calculate N2O & NOx fluxes from nitrification of manure and fertilizer - - manure_f_n2o_nit(c) = nmanure_to_sminn(c) * 0.0_r8 !0.02_r8 - fert_f_n2o_nit(c) = nfert_to_sminn(c) * 0.0_r8 !0.02_r8 - - ! NOx FLUXES - !------------ - - ! Ratio of NOx to N2O from nit or denit: eq 5, Parton '01. Add soi_gd later for now soi_gd = 0.1 - R_nox_to_n2o = 15.2_r8+(35.5_r8*ATAN(0.68_r8*3.14_r8*(10._r8*0.4_r8 -1.86_r8)))/3.14_r8 - - manure_f_nox_nit(c) = manure_f_n2o_nit(c) * R_nox_to_n2o - fert_f_nox_nit(c) = fert_f_n2o_nit(c) * R_nox_to_n2o - - nh3_manure(c) = abs(nh3_manure(c)) - nmanure_to_sminn(c) = abs(nmanure_to_sminn(c)) - manure_f_n2o_nit(c) = abs(manure_f_n2o_nit(c)) - manure_f_nox_nit(c) = abs(manure_f_nox_nit(c)) - N_Run_Off(c) = abs(N_Run_Off(c)) - nh3_fert(c) = abs(nh3_fert(c)) - nfert_to_sminn(c) = abs(nfert_to_sminn(c)) - fert_f_n2o_nit(c) = abs(fert_f_n2o_nit(c)) - fert_f_nox_nit(c) = abs(fert_f_nox_nit(c)) - N_Run_Off_fert(c) = abs(N_Run_Off_fert(c)) - - if (TAN_manu(c) <((nh3_manure(c)+ nmanure_to_sminn(c) + manure_f_n2o_nit(c) + manure_f_nox_nit(c) )*dt)) then - NFactor = (nh3_manure(c) + nmanure_to_sminn(c)+ manure_f_n2o_nit(c) + manure_f_nox_nit(c) ) - nh3_manure(c) = nh3_manure(c) * (TAN_manu(c)/dt) / NFactor - nmanure_to_sminn(c) = nmanure_to_sminn(c) * (TAN_manu(c)/dt) / NFactor - manure_f_n2o_nit(c) = manure_f_n2o_nit(c) * (TAN_manu(c)/dt) / NFactor - manure_f_nox_nit(c) = manure_f_nox_nit(c) * (TAN_manu(c)/dt) / NFactor - - TAN_manu(c) = 0._r8 - else - TAN_manu(c) = TAN_manu(c) - ((nh3_manure(c) + nmanure_to_sminn(c) + manure_f_n2o_nit(c) + manure_f_nox_nit(c) )*dt) - end if - - if (TAN_fert(c) <((nh3_fert(c)+ nfert_to_sminn(c) + fert_f_n2o_nit(c) + fert_f_nox_nit(c) )*dt)) then - NFactor = (nh3_fert(c) + nfert_to_sminn(c) + fert_f_n2o_nit(c) + fert_f_nox_nit(c) ) - nh3_fert(c) = nh3_fert(c) * (TAN_fert(c)/dt) / NFactor - nfert_to_sminn(c) = nfert_to_sminn(c) * (TAN_fert(c)/dt) / NFactor - fert_f_n2o_nit(c) = fert_f_n2o_nit(c) * (TAN_fert(c)/dt) / NFactor - fert_f_nox_nit(c) = fert_f_nox_nit(c) * (TAN_fert(c)/dt) / NFactor - - TAN_fert(c) = 0._r8 - else - TAN_fert(c) = TAN_fert(c) - ((nh3_fert(c) + nfert_to_sminn(c) + fert_f_n2o_nit(c) + fert_f_nox_nit(c) )*dt) - end if - - !Add N from mechanical incorporation into soil N pools - nmanure_to_sminn(c)=nmanure_to_sminn(c)+manu_inc/dt - nfert_to_sminn(c)=nfert_to_sminn(c)+fert_inc/dt - -!*pgmh!!!!! diffusion times for lengths of 1 cm (dz^2=1.e-4 m) -! ratenh4tosom=1.e-4*dnh4*(1.03**(t_grnd(c)-273.))*((man_water_pool(c)/5.e-2)**(10./3.))/(porosity**2.) -! rateno3tosom=1.e-4*dno3*(1.03**(t_grnd(c)-273.))*((fert_water_pool(c)/5.e-2)**(10./3.))/(porosity**2.) - ratenh4tosom = 1.e4_r8*dnh4*(1.03_r8**(t_grnd(c)-273._r8)) * & - ((man_water_pool(c)/5.e-2_r8)**(10._r8/3._r8))/(porosity**2._r8) - rateno3tosom = 1.e4_r8*dno3*(1.03_r8**(t_grnd(c)-273._r8)) * & - ((fert_water_pool(c)/5.e-2_r8)**(10._r8/3._r8))/(porosity**2._r8) - if (t_grnd(c) < 273.15_r8) then ! Turn vertical diffusion off when temperature is below freezing - ratenh4tosom = 0._r8 - rateno3tosom = 0._r8 - endif - -!*pgmh!!!!! - !Calculate rate that SOM forms NH4 to the soil -!*pgmh -! TAN_manure_to_soil(c) = 1.16e-7 * TAN_manu(c) - TAN_manure_to_soil(c) = ratenh4tosom * TAN_manu(c) -!*pgmh - TAN_manu(c) = TAN_manu(c) - (TAN_manure_to_soil(c) * dt) - -!*pgmh -! TAN_fert_to_soil(c) = 1.16e-7 * TAN_fert(c) - TAN_fert_to_soil(c) = ratenh4tosom * TAN_fert(c) -!*pgmh - TAN_fert(c) = TAN_fert(c) - (TAN_fert_to_soil(c) * dt) - - !Calculate rate that NO3- goes to soil -!* pgmh: at present all no3 goes to the soil in a timestep. nmanure_to_sminn goes back to the no3_pool. -!This includes nitrification and mechanical incorporation of manure (not correct!!) -!*pgmh -! no3_manure_to_soil(c) = (no3_manure(c) / dt) -! no3_manure(c) = (nmanure_to_sminn(c) * dt) -! -! no3_fert_to_soil(c) = (no3_fert(c) / dt) -! no3_fert(c) = (nfert_to_sminn(c) * dt) -!pgmh: suggested changes: use diffusion coefficient, correct for no3 pool and -! no3_manure_to_soil(c)=rateno3tosom * no3_manure(c) -! no3_manure(c)=no3_manure(c)+nmanure_to_sminn(c)*dt - (no3_manure_to_soil(c) * dt) -! no3_fert_to_soil(c)=rateno3tosom * no3_fert(c) -! no3_fert(c)=no3_fert(c) +nfert_to_sminn(c)*dt - (no3_fert_to_soil(c) * dt) -!*pgmh - no3_manure_to_soil(c) = rateno3tosom * no3_manure(c) - no3_fert_to_soil(c) = rateno3tosom * no3_fert(c) - no3_manure(c) = no3_manure(c) + nmanure_to_sminn(c)*dt - no3_fert(c) = no3_fert(c) + nfert_to_sminn(c)*dt - if (no3_manure_to_soil(c)*dt .gt. no3_manure(c)) no3_manure_to_soil(c) = no3_manure(c)/dt - if (no3_fert_to_soil(c)*dt .gt. no3_fert(c)) no3_fert_to_soil(c) = no3_fert(c)/dt - no3_fert(c) = no3_fert(c) - (no3_fert_to_soil(c) * dt) - no3_manure(c) = no3_manure(c) - (no3_manure_to_soil(c) * dt) - - ! Calculate NHx & NOy deposition as 45 & 55 % ndep_to_sminn, respectively - ! Then NHx and NOy as a fraction of average Ndep from Peter Hess - - call get_curr_date(yr, mon, day, sec) - if (mon .eq. 1) then - noydep_to_sminn(c) = 0.55_r8 * ndep_to_sminn(c) * 0.986_r8 - nhxdep_to_sminn(c) = 0.45_r8 * ndep_to_sminn(c) * 1.185_r8 - elseif (mon .eq. 2) then - noydep_to_sminn(c) = 0.55_r8 * ndep_to_sminn(c) * 0.894_r8 - nhxdep_to_sminn(c) = 0.45_r8 * ndep_to_sminn(c) * 1.496_r8 - elseif (mon .eq. 3) then - noydep_to_sminn(c) = 0.55_r8 * ndep_to_sminn(c) * 0.825_r8 - nhxdep_to_sminn(c) = 0.45_r8 * ndep_to_sminn(c) * 1.152_r8 - elseif (mon .eq. 4) then - noydep_to_sminn(c) = 0.55_r8 * ndep_to_sminn(c) * 0.792_r8 - nhxdep_to_sminn(c) = 0.45_r8 * ndep_to_sminn(c) * 1.013_r8 - elseif (mon .eq. 5) then - noydep_to_sminn(c) = 0.55_r8 * ndep_to_sminn(c) * 0.814_r8 - nhxdep_to_sminn(c) = 0.45_r8 * ndep_to_sminn(c) * 0.739_r8 - elseif (mon .eq. 6) then - noydep_to_sminn(c) = 0.55_r8 * ndep_to_sminn(c) * 1.201_r8 - nhxdep_to_sminn(c) = 0.45_r8 * ndep_to_sminn(c) * 0.833_r8 - elseif (mon .eq. 7) then - noydep_to_sminn(c) = 0.55_r8 * ndep_to_sminn(c) * 1.242_r8 - nhxdep_to_sminn(c) = 0.45_r8 * ndep_to_sminn(c) * 1.038_r8 - elseif (mon .eq. 8) then - noydep_to_sminn(c) = 0.55_r8 * ndep_to_sminn(c) * 1.141_r8 - nhxdep_to_sminn(c) = 0.45_r8 * ndep_to_sminn(c) * 0.718_r8 - elseif (mon .eq. 9) then - noydep_to_sminn(c) = 0.55_r8 * ndep_to_sminn(c) * 0.986_r8 - nhxdep_to_sminn(c) = 0.45_r8 * ndep_to_sminn(c) * 0.856_r8 - elseif (mon .eq. 10) then - noydep_to_sminn(c) = 0.55_r8 * ndep_to_sminn(c) * 0.964_r8 - nhxdep_to_sminn(c) = 0.45_r8 * ndep_to_sminn(c) * 0.808_r8 - elseif (mon .eq. 11) then - noydep_to_sminn(c) = 0.55_r8 * ndep_to_sminn(c) * 1.155_r8 - nhxdep_to_sminn(c) = 0.45_r8 * ndep_to_sminn(c) * 1.024_r8 - elseif (mon .eq. 12) then - noydep_to_sminn(c) = 0.55_r8 * ndep_to_sminn(c) * 1.021_r8 - nhxdep_to_sminn(c) = 0.45_r8 * ndep_to_sminn(c) * 1.137_r8 - endif - - !calculate the weighted amount of C and N eaten at the PFT level - do pi = 1,max_patch_per_col - if ( pi <= npfts(c) ) then -!KO - p = pfti(c) + pi - 1 - if (patch%active(p)) then -!KO - if (total_leafc(c) > 0._r8) then - leafc_manure(p) = leafc(p) * (cn * ((pl * ndep_manure(c))/(1._r8 - na))) * dt / total_leafc(c) - leafn_manure(p) = leafc(p) * ((pl * ndep_manure(c))/(1._r8 - na)) * dt / total_leafc(c) - deadstemc_manure(p) = leafc(p) * (cn * ((pd * ndep_manure(c))/(1._r8 - na))) * dt / total_leafc(c) - deadstemn_manure(p) = leafc(p) * ((pd * ndep_manure(c))/(1._r8 - na)) * dt / total_leafc(c) - else - leafc_manure(p) = 0._r8 - leafn_manure(p) = 0._r8 - deadstemc_manure(p) = 0._r8 - deadstemn_manure(p) = 0._r8 - end if - end if - end if - end do - - end do ! End column loop - - end if ! End use_fan -!KO - - end associate - - end subroutine CNNDeposition_Old !----------------------------------------------------------------------- subroutine CNFreeLivingFixation(num_soilc, filter_soilc, & diff --git a/src/main/fanStreamMod.F90 b/src/main/fanStreamMod.F90 index 382a2b4514..6796be76f1 100644 --- a/src/main/fanStreamMod.F90 +++ b/src/main/fanStreamMod.F90 @@ -143,18 +143,18 @@ subroutine fanstream_init(bounds, NLFilename) domMaskName='mask', & filePath='', & filename=(/trim(stream_fldFileName_ndep2)/),& - fldListFile='Nmanure_grz', & - fldListModel='Nmanure_grz', & + fldListFile='manure_grz', & + fldListModel='manure_grz', & fillalgo='none', & mapalgo=ndep2mapalgo, & calendar=get_calendar(), & taxmode='extend' ) if (masterproc) then - call shr_strdata_print(sdat_past,'CLMNDEP2 data') + call shr_strdata_print(sdat_grz,'CLMNDEP2 data') endif - call shr_strdata_create(sdat_mix,name="clmndep2sgrz", & + call shr_strdata_create(sdat_sgrz,name="clmndep2sgrz", & pio_subsystem=pio_subsystem, & pio_iotype=shr_pio_getiotype(inst_name), & mpicom=mpicom, compid=comp_id, & @@ -173,18 +173,18 @@ subroutine fanstream_init(bounds, NLFilename) domMaskName='mask', & filePath='', & filename=(/trim(stream_fldFileName_ndep2)/),& - fldListFile='Nmanure_sgrz', & - fldListModel='Nmanure_sgrz', & + fldListFile='manure_sgrz', & + fldListModel='manure_sgrz', & fillalgo='none', & mapalgo=ndep2mapalgo, & calendar=get_calendar(), & taxmode='extend' ) if (masterproc) then - call shr_strdata_print(sdat_mix,'CLMNDEP2 data') + call shr_strdata_print(sdat_sgrz,'CLMNDEP2 data') endif - call shr_strdata_create(sdat_mix,name="clmndep2ngrz", & + call shr_strdata_create(sdat_ngrz,name="clmndep2ngrz", & pio_subsystem=pio_subsystem, & pio_iotype=shr_pio_getiotype(inst_name), & mpicom=mpicom, compid=comp_id, & @@ -203,15 +203,15 @@ subroutine fanstream_init(bounds, NLFilename) domMaskName='mask', & filePath='', & filename=(/trim(stream_fldFileName_ndep2)/),& - fldListFile='Nmanure_ngrz', & - fldListModel='Nmanure_ngrz', & + fldListFile='manure_ngrz', & + fldListModel='manure_ngrz', & fillalgo='none', & mapalgo=ndep2mapalgo, & calendar=get_calendar(), & taxmode='extend' ) if (masterproc) then - call shr_strdata_print(sdat_mix,'CLMNDEP2 data') + call shr_strdata_print(sdat_ngrz,'CLMNDEP2 data') endif call shr_strdata_create(sdat_urea,name="clmndep2urea", & @@ -297,7 +297,7 @@ subroutine fanstream_init(bounds, NLFilename) taxmode='extend' ) if (masterproc) then - call shr_strdata_print(sdat_mix,'CLMNDEP2 data') + call shr_strdata_print(sdat_soilph,'CLMNDEP2 data') endif diff --git a/src/main/ndep2StreamMod.F90 b/src/main/ndep2StreamMod.F90 deleted file mode 100644 index e403302d72..0000000000 --- a/src/main/ndep2StreamMod.F90 +++ /dev/null @@ -1,285 +0,0 @@ -module ndep2StreamMod - - !----------------------------------------------------------------------- - ! !DESCRIPTION: - ! Contains methods for reading in FAN nitrogen deposition (in the form of - ! manure) data file - ! Also includes functions for dynamic ndep2 file handling and - ! interpolation. - ! - ! !USES - use shr_kind_mod, only: r8 => shr_kind_r8, CL => shr_kind_cl - use shr_strdata_mod - use shr_stream_mod - use shr_string_mod - use shr_sys_mod - use shr_mct_mod - use mct_mod - use spmdMod , only: mpicom, masterproc, comp_id, iam - use clm_varctl , only: iulog - use abortutils , only: endrun - use fileutils , only: getavu, relavu - use decompMod , only: bounds_type, ldecomp, gsmap_lnd_gdc2glo - use domainMod , only: ldomain -!KO - use ndepStreamMod, only: clm_domain_mct -!KO - - ! !PUBLIC TYPES: - implicit none - private - save - - ! !PUBLIC MEMBER FUNCTIONS: - public :: ndep2_init ! position datasets for dynamic ndep2 - public :: ndep2_interp ! interpolates between two years of ndep2 file data -!KO public :: clm_domain_mct ! Sets up MCT domain for this resolution - - ! ! PRIVATE TYPES - type(shr_strdata_type) :: sdat ! input data stream - integer :: stream_year_first_ndep2 ! first year in stream to use - integer :: stream_year_last_ndep2 ! last year in stream to use - integer :: model_year_align_ndep2 ! align stream_year_firstndep2 with - - character(len=*), parameter, private :: sourcefile = & - __FILE__ - !============================================================================== - -contains - - !============================================================================== - - subroutine ndep2_init(bounds, NLFilename) - ! - ! Initialize data stream information. - ! - ! Uses: - use clm_varctl , only : inst_name - use clm_time_manager , only : get_calendar - use ncdio_pio , only : pio_subsystem - use shr_pio_mod , only : shr_pio_getiotype - use shr_nl_mod , only : shr_nl_find_group_name - use shr_log_mod , only : errMsg => shr_log_errMsg - ! - ! arguments - implicit none - type(bounds_type), intent(in) :: bounds - character(len=*), intent(in) :: NLFilename ! Namelist filename - ! - ! local variables - integer :: nu_nml ! unit for namelist file - integer :: nml_error ! namelist i/o error flag - type(mct_ggrid) :: dom_clm ! domain information - character(len=CL) :: stream_fldFileName_ndep2 - character(len=CL) :: ndep2mapalgo = 'bilinear' - character(*), parameter :: shr_strdata_unset = 'NOT_SET' - character(*), parameter :: subName = "('ndep2dyn_init')" - character(*), parameter :: F00 = "('(ndep2dyn_init) ',4a)" - !----------------------------------------------------------------------- - - namelist /ndep2dyn_nml/ & - stream_year_first_ndep2, & - stream_year_last_ndep2, & - model_year_align_ndep2, & - ndep2mapalgo, & - stream_fldFileName_ndep2 - - ! Default values for namelist - stream_year_first_ndep2 = 1 ! first year in stream to use - stream_year_last_ndep2 = 1 ! last year in stream to use - model_year_align_ndep2 = 1 ! align stream_year_first_ndep2 with this model year - stream_fldFileName_ndep2 = ' ' - - ! Read ndep2dyn_nml namelist - if (masterproc) then - nu_nml = getavu() - open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error ) - call shr_nl_find_group_name(nu_nml, 'ndep2dyn_nml', status=nml_error) - if (nml_error == 0) then - read(nu_nml, nml=ndep2dyn_nml,iostat=nml_error) - if (nml_error /= 0) then - call endrun(msg=' ERROR reading ndep2dyn_nml namelist'//errMsg(sourcefile, __LINE__)) - end if - else - call endrun(msg=' ERROR finding ndep2dyn_nml namelist'//errMsg(sourcefile, __LINE__)) - end if - close(nu_nml) - call relavu( nu_nml ) - endif - - call shr_mpi_bcast(stream_year_first_ndep2, mpicom) - call shr_mpi_bcast(stream_year_last_ndep2, mpicom) - call shr_mpi_bcast(model_year_align_ndep2, mpicom) - call shr_mpi_bcast(stream_fldFileName_ndep2, mpicom) - - if (masterproc) then - write(iulog,*) ' ' - write(iulog,*) 'ndep2dyn stream settings:' - write(iulog,*) ' stream_year_first_ndep2 = ',stream_year_first_ndep2 - write(iulog,*) ' stream_year_last_ndep2 = ',stream_year_last_ndep2 - write(iulog,*) ' model_year_align_ndep2 = ',model_year_align_ndep2 - write(iulog,*) ' stream_fldFileName_ndep2 = ',stream_fldFileName_ndep2 - write(iulog,*) ' ' - endif - - call clm_domain_mct (bounds, dom_clm) - - call shr_strdata_create(sdat,name="clmndep2", & - pio_subsystem=pio_subsystem, & - pio_iotype=shr_pio_getiotype(inst_name), & - mpicom=mpicom, compid=comp_id, & - gsmap=gsmap_lnd_gdc2glo, ggrid=dom_clm, & - nxg=ldomain%ni, nyg=ldomain%nj, & - yearFirst=stream_year_first_ndep2, & - yearLast=stream_year_last_ndep2, & - yearAlign=model_year_align_ndep2, & - offset=0, & - domFilePath='', & - domFileName=trim(stream_fldFileName_ndep2), & - domTvarName='time', & - domXvarName='x' , & - domYvarName='y' , & - domAreaName='area', & - domMaskName='mask', & - filePath='', & - filename=(/trim(stream_fldFileName_ndep2)/),& - fldListFile='NDEP_year', & - fldListModel='NDEP_year', & - fillalgo='none', & - mapalgo=ndep2mapalgo, & - calendar=get_calendar(), & - taxmode='extend' ) - - if (masterproc) then - call shr_strdata_print(sdat,'CLMNDEP2 data') - endif - - end subroutine ndep2_init - - !================================================================ - subroutine ndep2_interp(bounds, atm2lnd_inst) - - !----------------------------------------------------------------------- - use clm_time_manager, only : get_curr_date, get_days_per_year - use clm_varcon , only : secspday - use atm2lndType , only : atm2lnd_type - ! - ! Arguments - type(bounds_type) , intent(in) :: bounds - type(atm2lnd_type), intent(inout) :: atm2lnd_inst - ! - ! Local variables - integer :: g, ig - integer :: year ! year (0, ...) for nstep+1 - integer :: mon ! month (1, ..., 12) for nstep+1 - integer :: day ! day of month (1, ..., 31) for nstep+1 - integer :: sec ! seconds into current date for nstep+1 - integer :: mcdate ! Current model date (yyyymmdd) - integer :: dayspyr ! days per year - !----------------------------------------------------------------------- - - call get_curr_date(year, mon, day, sec) - mcdate = year*10000 + mon*100 + day - - call shr_strdata_advance(sdat, mcdate, sec, mpicom, 'ndep2dyn') - - ig = 0 - dayspyr = get_days_per_year( ) - do g = bounds%begg,bounds%endg - ig = ig+1 - atm2lnd_inst%forc_ndep2_grc(g) = sdat%avs(1)%rAttr(1,ig) / (secspday * dayspyr) - end do - - end subroutine ndep2_interp - -!!============================================================================== -! subroutine clm_domain_mct(bounds, dom_clm) - -! !------------------------------------------------------------------- -! ! Set domain data type for internal clm grid -! use clm_varcon , only : re -! use domainMod , only : ldomain -! use seq_flds_mod -! implicit none -! ! -! ! arguments -! type(bounds_type), intent(in) :: bounds -! type(mct_ggrid), intent(out) :: dom_clm ! Output domain information for land model -! ! -! ! local variables -! integer :: g,i,j ! index -! integer :: lsize ! land model domain data size -! real(r8), pointer :: data(:) ! temporary -! integer , pointer :: idata(:) ! temporary -! !------------------------------------------------------------------- -! ! -! ! Initialize mct domain type -! ! lat/lon in degrees, area in radians^2, mask is 1 (land), 0 (non-land) -! ! Note that in addition land carries around landfrac for the purposes of domain checking -! ! -! lsize = mct_gsMap_lsize(gsmap_lnd_gdc2glo, mpicom) -! call mct_gGrid_init( GGrid=dom_clm, CoordChars=trim(seq_flds_dom_coord), & -! OtherChars=trim(seq_flds_dom_other), lsize=lsize ) -! ! -! ! Allocate memory -! ! -! allocate(data(lsize)) -! ! -! ! Determine global gridpoint number attribute, GlobGridNum, which is set automatically by MCT -! ! -! call mct_gsMap_orderedPoints(gsmap_lnd_gdc2glo, iam, idata) -! call mct_gGrid_importIAttr(dom_clm,'GlobGridNum',idata,lsize) -! ! -! ! Determine domain (numbering scheme is: West to East and South to North to South pole) -! ! Initialize attribute vector with special value -! ! -! data(:) = -9999.0_R8 -! call mct_gGrid_importRAttr(dom_clm,"lat" ,data,lsize) -! call mct_gGrid_importRAttr(dom_clm,"lon" ,data,lsize) -! call mct_gGrid_importRAttr(dom_clm,"area" ,data,lsize) -! call mct_gGrid_importRAttr(dom_clm,"aream",data,lsize) -! data(:) = 0.0_R8 -! call mct_gGrid_importRAttr(dom_clm,"mask" ,data,lsize) -! ! -! ! Determine bounds -! ! -! ! Fill in correct values for domain components -! ! Note aream will be filled in in the atm-lnd mapper -! ! -! do g = bounds%begg,bounds%endg -! i = 1 + (g - bounds%begg) -! data(i) = ldomain%lonc(g) -! end do -! call mct_gGrid_importRattr(dom_clm,"lon",data,lsize) - -! do g = bounds%begg,bounds%endg -! i = 1 + (g - bounds%begg) -! data(i) = ldomain%latc(g) -! end do -! call mct_gGrid_importRattr(dom_clm,"lat",data,lsize) - -! do g = bounds%begg,bounds%endg -! i = 1 + (g - bounds%begg) -! data(i) = ldomain%area(g)/(re*re) -! end do -! call mct_gGrid_importRattr(dom_clm,"area",data,lsize) - -! do g = bounds%begg,bounds%endg -! i = 1 + (g - bounds%begg) -! data(i) = real(ldomain%mask(g), r8) -! end do -! call mct_gGrid_importRattr(dom_clm,"mask",data,lsize) - -! do g = bounds%begg,bounds%endg -! i = 1 + (g - bounds%begg) -! data(i) = real(ldomain%frac(g), r8) -! end do -! call mct_gGrid_importRattr(dom_clm,"frac",data,lsize) - -! deallocate(data) -! deallocate(idata) - -! end subroutine clm_domain_mct - -end module ndep2StreamMod - diff --git a/src/main/ndep3StreamMod.F90 b/src/main/ndep3StreamMod.F90 deleted file mode 100644 index d2ffa887f4..0000000000 --- a/src/main/ndep3StreamMod.F90 +++ /dev/null @@ -1,285 +0,0 @@ -module ndep3StreamMod - - !----------------------------------------------------------------------- - ! !DESCRIPTION: - ! Contains methods for reading in FAN nitrogen deposition (in the form of - ! fertilizer) data file - ! Also includes functions for dynamic ndep3 file handling and - ! interpolation. - ! - ! !USES - use shr_kind_mod, only: r8 => shr_kind_r8, CL => shr_kind_cl - use shr_strdata_mod - use shr_stream_mod - use shr_string_mod - use shr_sys_mod - use shr_mct_mod - use mct_mod - use spmdMod , only: mpicom, masterproc, comp_id, iam - use clm_varctl , only: iulog - use abortutils , only: endrun - use fileutils , only: getavu, relavu - use decompMod , only: bounds_type, ldecomp, gsmap_lnd_gdc2glo - use domainMod , only: ldomain -!KO - use ndepStreamMod, only: clm_domain_mct -!KO - - ! !PUBLIC TYPES: - implicit none - private - save - - ! !PUBLIC MEMBER FUNCTIONS: - public :: ndep3_init ! position datasets for dynamic ndep3 - public :: ndep3_interp ! interpolates between two years of ndep3 file data -!KO public :: clm_domain_mct ! Sets up MCT domain for this resolution - - ! ! PRIVATE TYPES - type(shr_strdata_type) :: sdat ! input data stream - integer :: stream_year_first_ndep3 ! first year in stream to use - integer :: stream_year_last_ndep3 ! last year in stream to use - integer :: model_year_align_ndep3 ! align stream_year_firstndep3 with - - character(len=*), parameter, private :: sourcefile = & - __FILE__ - !============================================================================== - -contains - - !============================================================================== - - subroutine ndep3_init(bounds, NLFilename) - ! - ! Initialize data stream information. - ! - ! Uses: - use clm_varctl , only : inst_name - use clm_time_manager , only : get_calendar - use ncdio_pio , only : pio_subsystem - use shr_pio_mod , only : shr_pio_getiotype - use shr_nl_mod , only : shr_nl_find_group_name - use shr_log_mod , only : errMsg => shr_log_errMsg - ! - ! arguments - implicit none - type(bounds_type), intent(in) :: bounds - character(len=*), intent(in) :: NLFilename ! Namelist filename - ! - ! local variables - integer :: nu_nml ! unit for namelist file - integer :: nml_error ! namelist i/o error flag - type(mct_ggrid) :: dom_clm ! domain information - character(len=CL) :: stream_fldFileName_ndep3 - character(len=CL) :: ndep3mapalgo = 'bilinear' - character(*), parameter :: shr_strdata_unset = 'NOT_SET' - character(*), parameter :: subName = "('ndep3dyn_init')" - character(*), parameter :: F00 = "('(ndep3dyn_init) ',4a)" - !----------------------------------------------------------------------- - - namelist /ndep3dyn_nml/ & - stream_year_first_ndep3, & - stream_year_last_ndep3, & - model_year_align_ndep3, & - ndep3mapalgo, & - stream_fldFileName_ndep3 - - ! Default values for namelist - stream_year_first_ndep3 = 1 ! first year in stream to use - stream_year_last_ndep3 = 1 ! last year in stream to use - model_year_align_ndep3 = 1 ! align stream_year_first_ndep3 with this model year - stream_fldFileName_ndep3 = ' ' - - ! Read ndep3dyn_nml namelist - if (masterproc) then - nu_nml = getavu() - open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error ) - call shr_nl_find_group_name(nu_nml, 'ndep3dyn_nml', status=nml_error) - if (nml_error == 0) then - read(nu_nml, nml=ndep3dyn_nml,iostat=nml_error) - if (nml_error /= 0) then - call endrun(msg=' ERROR reading ndep3dyn_nml namelist'//errMsg(sourcefile, __LINE__)) - end if - else - call endrun(msg=' ERROR finding ndep3dyn_nml namelist'//errMsg(sourcefile, __LINE__)) - end if - close(nu_nml) - call relavu( nu_nml ) - endif - - call shr_mpi_bcast(stream_year_first_ndep3, mpicom) - call shr_mpi_bcast(stream_year_last_ndep3, mpicom) - call shr_mpi_bcast(model_year_align_ndep3, mpicom) - call shr_mpi_bcast(stream_fldFileName_ndep3, mpicom) - - if (masterproc) then - write(iulog,*) ' ' - write(iulog,*) 'ndep3dyn stream settings:' - write(iulog,*) ' stream_year_first_ndep3 = ',stream_year_first_ndep3 - write(iulog,*) ' stream_year_last_ndep3 = ',stream_year_last_ndep3 - write(iulog,*) ' model_year_align_ndep3 = ',model_year_align_ndep3 - write(iulog,*) ' stream_fldFileName_ndep3 = ',stream_fldFileName_ndep3 - write(iulog,*) ' ' - endif - - call clm_domain_mct (bounds, dom_clm) - - call shr_strdata_create(sdat,name="clmndep3", & - pio_subsystem=pio_subsystem, & - pio_iotype=shr_pio_getiotype(inst_name), & - mpicom=mpicom, compid=comp_id, & - gsmap=gsmap_lnd_gdc2glo, ggrid=dom_clm, & - nxg=ldomain%ni, nyg=ldomain%nj, & - yearFirst=stream_year_first_ndep3, & - yearLast=stream_year_last_ndep3, & - yearAlign=model_year_align_ndep3, & - offset=0, & - domFilePath='', & - domFileName=trim(stream_fldFileName_ndep3), & - domTvarName='time', & - domXvarName='x' , & - domYvarName='y' , & - domAreaName='area', & - domMaskName='mask', & - filePath='', & - filename=(/trim(stream_fldFileName_ndep3)/),& - fldListFile='NDEP_year', & - fldListModel='NDEP_year', & - fillalgo='none', & - mapalgo=ndep3mapalgo, & - calendar=get_calendar(), & - taxmode='extend' ) - - if (masterproc) then - call shr_strdata_print(sdat,'CLMNDEP3 data') - endif - - end subroutine ndep3_init - - !================================================================ - subroutine ndep3_interp(bounds, atm2lnd_inst) - - !----------------------------------------------------------------------- - use clm_time_manager, only : get_curr_date, get_days_per_year - use clm_varcon , only : secspday - use atm2lndType , only : atm2lnd_type - ! - ! Arguments - type(bounds_type) , intent(in) :: bounds - type(atm2lnd_type), intent(inout) :: atm2lnd_inst - ! - ! Local variables - integer :: g, ig - integer :: year ! year (0, ...) for nstep+1 - integer :: mon ! month (1, ..., 12) for nstep+1 - integer :: day ! day of month (1, ..., 31) for nstep+1 - integer :: sec ! seconds into current date for nstep+1 - integer :: mcdate ! Current model date (yyyymmdd) - integer :: dayspyr ! days per year - !----------------------------------------------------------------------- - - call get_curr_date(year, mon, day, sec) - mcdate = year*10000 + mon*100 + day - - call shr_strdata_advance(sdat, mcdate, sec, mpicom, 'ndep3dyn') - - ig = 0 - dayspyr = get_days_per_year( ) - do g = bounds%begg,bounds%endg - ig = ig+1 - atm2lnd_inst%forc_ndep3_grc(g) = sdat%avs(1)%rAttr(1,ig) / (secspday * dayspyr) - end do - - end subroutine ndep3_interp - -!!============================================================================== -! subroutine clm_domain_mct(bounds, dom_clm) - -! !------------------------------------------------------------------- -! ! Set domain data type for internal clm grid -! use clm_varcon , only : re -! use domainMod , only : ldomain -! use seq_flds_mod -! implicit none -! ! -! ! arguments -! type(bounds_type), intent(in) :: bounds -! type(mct_ggrid), intent(out) :: dom_clm ! Output domain information for land model -! ! -! ! local variables -! integer :: g,i,j ! index -! integer :: lsize ! land model domain data size -! real(r8), pointer :: data(:) ! temporary -! integer , pointer :: idata(:) ! temporary -! !------------------------------------------------------------------- -! ! -! ! Initialize mct domain type -! ! lat/lon in degrees, area in radians^2, mask is 1 (land), 0 (non-land) -! ! Note that in addition land carries around landfrac for the purposes of domain checking -! ! -! lsize = mct_gsMap_lsize(gsmap_lnd_gdc2glo, mpicom) -! call mct_gGrid_init( GGrid=dom_clm, CoordChars=trim(seq_flds_dom_coord), & -! OtherChars=trim(seq_flds_dom_other), lsize=lsize ) -! ! -! ! Allocate memory -! ! -! allocate(data(lsize)) -! ! -! ! Determine global gridpoint number attribute, GlobGridNum, which is set automatically by MCT -! ! -! call mct_gsMap_orderedPoints(gsmap_lnd_gdc2glo, iam, idata) -! call mct_gGrid_importIAttr(dom_clm,'GlobGridNum',idata,lsize) -! ! -! ! Determine domain (numbering scheme is: West to East and South to North to South pole) -! ! Initialize attribute vector with special value -! ! -! data(:) = -9999.0_R8 -! call mct_gGrid_importRAttr(dom_clm,"lat" ,data,lsize) -! call mct_gGrid_importRAttr(dom_clm,"lon" ,data,lsize) -! call mct_gGrid_importRAttr(dom_clm,"area" ,data,lsize) -! call mct_gGrid_importRAttr(dom_clm,"aream",data,lsize) -! data(:) = 0.0_R8 -! call mct_gGrid_importRAttr(dom_clm,"mask" ,data,lsize) -! ! -! ! Determine bounds -! ! -! ! Fill in correct values for domain components -! ! Note aream will be filled in in the atm-lnd mapper -! ! -! do g = bounds%begg,bounds%endg -! i = 1 + (g - bounds%begg) -! data(i) = ldomain%lonc(g) -! end do -! call mct_gGrid_importRattr(dom_clm,"lon",data,lsize) - -! do g = bounds%begg,bounds%endg -! i = 1 + (g - bounds%begg) -! data(i) = ldomain%latc(g) -! end do -! call mct_gGrid_importRattr(dom_clm,"lat",data,lsize) - -! do g = bounds%begg,bounds%endg -! i = 1 + (g - bounds%begg) -! data(i) = ldomain%area(g)/(re*re) -! end do -! call mct_gGrid_importRattr(dom_clm,"area",data,lsize) - -! do g = bounds%begg,bounds%endg -! i = 1 + (g - bounds%begg) -! data(i) = real(ldomain%mask(g), r8) -! end do -! call mct_gGrid_importRattr(dom_clm,"mask",data,lsize) - -! do g = bounds%begg,bounds%endg -! i = 1 + (g - bounds%begg) -! data(i) = real(ldomain%frac(g), r8) -! end do -! call mct_gGrid_importRattr(dom_clm,"frac",data,lsize) - -! deallocate(data) -! deallocate(idata) - -! end subroutine clm_domain_mct - -end module ndep3StreamMod - From 2de3aab475f12efff2bb61c39289d58ad3e049b1 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Thu, 3 Jan 2019 15:18:03 -0500 Subject: [PATCH 035/181] fert incorp reduction --- src/biogeochem/CNNDynamicsMod.F90 | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index ff4d5eb865..0a4fedc377 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -184,7 +184,7 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & real(r8), parameter :: dz_layer_fert = 0.02_r8, dz_layer_grz = 0.02_r8 !real(r8), parameter :: fract_resist=0._r8, fract_unavail=0._r8, fract_avail=0._r8, fract_tan=1.0_r8 - + real(r8), parameter :: fert_incorp_reduct = 0.3_r8 real(r8), parameter :: slurry_infiltr_time = 12*3600.0_r8, water_init_fert = 1e-6 real(r8), parameter :: & poolranges_grz(3) = (/24*3600.0_r8, 10*24*3600.0_r8, 360*24*3600.0_r8/), & @@ -533,17 +533,28 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & ! Fertilizer ! - fert_total = nf%fert_n_appl_col(c) + ! Fraction available for volatilization + fert_total = nf%fert_n_appl_col(c) * (1.0_r8 - fert_incorp_reduct) + fract_urea = atm2lnd_inst%forc_ndep_urea_grc(g) fract_no3 = atm2lnd_inst%forc_ndep_nitr_grc(g) + ! Fractions made unavailable by mechanical incorporation, will be added to the + ! to-soil flux (tan) or no3 production (no3) below. + fert_inc_tan = nf%fert_n_appl_col(c) * fert_incorp_reduct * (1.0 - fract_no3) + fert_inc_no3 = nf%fert_n_appl_col(c) * fert_incorp_reduct * fract_no3 + if (fract_urea < 0 .or. fract_no3 < 0 .or. fract_urea + fract_no3 > 1) then call endrun('bad fertilizer fractions') end if fert_urea = fert_total * fract_urea - fert_no3 = fert_total * fract_no3 + + ! Include the incorporated NO3 fertilizer to the no3 flux + fert_no3 = fert_total * fract_no3 + fert_inc_no3 + fert_generic = fert_total - fert_urea - fert_no3 + nf%otherfert_n_appl_col(c) = fert_no3 + fert_generic ! Urea decomposition @@ -613,7 +624,7 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & nf%nh3_fert_col(c) = fluxes_tmp(iflx_air) nf%fert_runoff_col(c) = fluxes_tmp(iflx_roff) nf%fert_no3_prod_col(c) = fluxes_tmp(iflx_no3) + fert_no3 - nf%fert_nh4_to_soil_col(c) = fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) + garbage_total/dt + nf%fert_nh4_to_soil_col(c) = fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) + garbage_total/dt + fert_inc_tan ! Total flux ! From 5d02b4b9566c77915d6d83bd65c8dd0aa82ab5e5 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Thu, 3 Jan 2019 15:48:27 -0500 Subject: [PATCH 036/181] remove old FAN flux and state variables --- .../SoilBiogeochemNitrogenFluxType.F90 | 498 ++++----- .../SoilBiogeochemNitrogenStateType.F90 | 969 +++++++++--------- 2 files changed, 734 insertions(+), 733 deletions(-) diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 index 136d644250..eff678c7bb 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 @@ -30,45 +30,45 @@ module SoilBiogeochemNitrogenFluxType real(r8), pointer :: fert_to_sminn_col (:) ! col fertilizer N to soil mineral N (gN/m2/s) real(r8), pointer :: soyfixn_to_sminn_col (:) ! col soybean fixation to soil mineral N (gN/m2/s) !KO - ! FAN fluxes - real(r8), pointer :: rain_24hr_col (:) - real(r8), pointer :: nhxdep_to_sminn_col (:) ! col atmospheric NHx deposition to soil mineral N (gN/m2/s) - real(r8), pointer :: noydep_to_sminn_col (:) ! col atmospheric NOy deposition to soil mineral N (gN/m2/s) - real(r8), pointer :: ndep_manure_col (:) ! col manure N deposition to soil mineral N (gN/m2/s) - real(r8), pointer :: ndep_fert_col (:) ! col fertilizer N deposition to soil mineral N (gN/m2/s) - real(r8), pointer :: N_Run_Off_col (:) ! col nitrogen washed from manure by rain(gN/m2/s) - real(r8), pointer :: N_Run_Off_fert_col (:) ! col nitrogen washed from fertilizer by rain(gN/m2/s) - real(r8), pointer :: u10_avg_col (:) ! col windspeed at 10m(m/s) - real(r8), pointer :: rh_gamma_col (:) !KO - real(r8), pointer :: rain_col (:) ! col rain amount(mm) - real(r8), pointer :: gamma_nh3_col (:) !KO - real(r8), pointer :: gamma_nh3_fert_col (:) !KO - real(r8), pointer :: nh3_manure_col (:) ! col atmospheric N emission of NH3 from manure (gN/m2/s) -! real(r8), pointer :: nh3_fert_col (:) ! col atmospheric N emission of NH3 from fertilizer (gN/m2/s) - real(r8), pointer :: lat_fert_col (:) ! col latitude at which fertilization occurs (degN) - real(r8), pointer :: nmanure_to_sminn_col (:) ! col deposition of N from manure to soil mineral N (gN/m2/s) - real(r8), pointer :: nfert_to_sminn_col (:) ! col deposition of N from fertilizer to soil mineral N (gN/m2/s) - real(r8), pointer :: manure_f_n2o_nit_col (:) ! col N2O emission from nitrification of manure (gN/m2/s) - real(r8), pointer :: manure_f_n2_denit_col (:) ! col N2 emission from denitrification of manure (gN/m2/s) - real(r8), pointer :: manure_f_nox_nit_col (:) ! col NOx emission from nitrification of manure (gN/m2/s) - real(r8), pointer :: fert_f_n2o_nit_col (:) ! col N2O emission from nitrification of fertilizer (gN/m2/s) - real(r8), pointer :: fert_f_n2_denit_col (:) ! col N2 emission from denitrification of fertilizer (gN/m2/s) - real(r8), pointer :: fert_f_nox_nit_col (:) ! col NOx emission from nitrification of fertilizer (gN/m2/s) - real(r8), pointer :: Nd_col (:) ! col total N emission from denitrification of manure (gN/m2/s) - real(r8), pointer :: no3_manure_to_soil_col (:) ! col flow of NO3 from manure pool to soil (gN/m2/s) - real(r8), pointer :: TAN_manure_to_soil_col (:) ! col flow of NH4 in manure TAN pool to soil (gN/m2/s) - real(r8), pointer :: no3_fert_to_soil_col (:) ! col flow of NO3 from fertilizer pool to soil (gN/m2/s) - real(r8), pointer :: TAN_fert_to_soil_col (:) ! col flow of NH4 in fertilizer TAN pool to soil (gN/m2/s) - real(r8), pointer :: f_nox_col (:) ! col flux of NOx [gN/m^2/s] - real(r8), pointer :: f_nox_denit_vr_col (:,:) ! col flux of NOx from denitrification [gN/m^3/s] - real(r8), pointer :: f_nox_denit_col (:) ! col flux of NOx from denitrification [gN/m^2/s] - real(r8), pointer :: f_nox_nit_vr_col (:,:) ! col flux of NOx from nitrification [gN/m^3/s] - real(r8), pointer :: f_nox_nit_col (:) ! col flux of NOx from nitrification [gN/m^2/s] - real(r8), pointer :: Dfc_col (:,:) !KO - real(r8), pointer :: poro_fc_col (:,:) !KO - real(r8), pointer :: poroair_col (:,:) !KO - real(r8), pointer :: wfpsfc_col (:,:) !KO -!KO +!!$ ! FAN fluxes +!!$ real(r8), pointer :: rain_24hr_col (:) +!!$ real(r8), pointer :: nhxdep_to_sminn_col (:) ! col atmospheric NHx deposition to soil mineral N (gN/m2/s) +!!$ real(r8), pointer :: noydep_to_sminn_col (:) ! col atmospheric NOy deposition to soil mineral N (gN/m2/s) +!!$ real(r8), pointer :: ndep_manure_col (:) ! col manure N deposition to soil mineral N (gN/m2/s) +!!$ real(r8), pointer :: ndep_fert_col (:) ! col fertilizer N deposition to soil mineral N (gN/m2/s) +!!$ real(r8), pointer :: N_Run_Off_col (:) ! col nitrogen washed from manure by rain(gN/m2/s) +!!$ real(r8), pointer :: N_Run_Off_fert_col (:) ! col nitrogen washed from fertilizer by rain(gN/m2/s) +!!$ real(r8), pointer :: u10_avg_col (:) ! col windspeed at 10m(m/s) +!!$ real(r8), pointer :: rh_gamma_col (:) !KO +!!$ real(r8), pointer :: rain_col (:) ! col rain amount(mm) +!!$ real(r8), pointer :: gamma_nh3_col (:) !KO +!!$ real(r8), pointer :: gamma_nh3_fert_col (:) !KO +!!$ real(r8), pointer :: nh3_manure_col (:) ! col atmospheric N emission of NH3 from manure (gN/m2/s) +!!$! real(r8), pointer :: nh3_fert_col (:) ! col atmospheric N emission of NH3 from fertilizer (gN/m2/s) +!!$ real(r8), pointer :: lat_fert_col (:) ! col latitude at which fertilization occurs (degN) +!!$ real(r8), pointer :: nmanure_to_sminn_col (:) ! col deposition of N from manure to soil mineral N (gN/m2/s) +!!$ real(r8), pointer :: nfert_to_sminn_col (:) ! col deposition of N from fertilizer to soil mineral N (gN/m2/s) +!!$ real(r8), pointer :: manure_f_n2o_nit_col (:) ! col N2O emission from nitrification of manure (gN/m2/s) +!!$ real(r8), pointer :: manure_f_n2_denit_col (:) ! col N2 emission from denitrification of manure (gN/m2/s) +!!$ real(r8), pointer :: manure_f_nox_nit_col (:) ! col NOx emission from nitrification of manure (gN/m2/s) +!!$ real(r8), pointer :: fert_f_n2o_nit_col (:) ! col N2O emission from nitrification of fertilizer (gN/m2/s) +!!$ real(r8), pointer :: fert_f_n2_denit_col (:) ! col N2 emission from denitrification of fertilizer (gN/m2/s) +!!$ real(r8), pointer :: fert_f_nox_nit_col (:) ! col NOx emission from nitrification of fertilizer (gN/m2/s) +!!$ real(r8), pointer :: Nd_col (:) ! col total N emission from denitrification of manure (gN/m2/s) +!!$ real(r8), pointer :: no3_manure_to_soil_col (:) ! col flow of NO3 from manure pool to soil (gN/m2/s) +!!$ real(r8), pointer :: TAN_manure_to_soil_col (:) ! col flow of NH4 in manure TAN pool to soil (gN/m2/s) +!!$ real(r8), pointer :: no3_fert_to_soil_col (:) ! col flow of NO3 from fertilizer pool to soil (gN/m2/s) +!!$ real(r8), pointer :: TAN_fert_to_soil_col (:) ! col flow of NH4 in fertilizer TAN pool to soil (gN/m2/s) +!!$ real(r8), pointer :: f_nox_col (:) ! col flux of NOx [gN/m^2/s] +!!$ real(r8), pointer :: f_nox_denit_vr_col (:,:) ! col flux of NOx from denitrification [gN/m^3/s] +!!$ real(r8), pointer :: f_nox_denit_col (:) ! col flux of NOx from denitrification [gN/m^2/s] +!!$ real(r8), pointer :: f_nox_nit_vr_col (:,:) ! col flux of NOx from nitrification [gN/m^3/s] +!!$ real(r8), pointer :: f_nox_nit_col (:) ! col flux of NOx from nitrification [gN/m^2/s] +!!$ real(r8), pointer :: Dfc_col (:,:) !KO +!!$ real(r8), pointer :: poro_fc_col (:,:) !KO +!!$ real(r8), pointer :: poroair_col (:,:) !KO +!!$ real(r8), pointer :: wfpsfc_col (:,:) !KO +!!$!KO !JV FAN fluxes @@ -250,45 +250,45 @@ subroutine InitAllocate(this, bounds) allocate(this%fert_to_sminn_col (begc:endc)) ; this%fert_to_sminn_col (:) = nan allocate(this%soyfixn_to_sminn_col (begc:endc)) ; this%soyfixn_to_sminn_col (:) = nan !KO - if ( use_fan ) then - allocate(this%rain_24hr_col (begc:endc)) ; this%rain_24hr_col (:) = nan - allocate(this%nhxdep_to_sminn_col (begc:endc)) ; this%nhxdep_to_sminn_col (:) = nan - allocate(this%noydep_to_sminn_col (begc:endc)) ; this%noydep_to_sminn_col (:) = nan - allocate(this%ndep_manure_col (begc:endc)) ; this%ndep_manure_col (:) = nan - allocate(this%ndep_fert_col (begc:endc)) ; this%ndep_fert_col (:) = nan - allocate(this%N_Run_Off_col (begc:endc)) ; this%N_Run_Off_col (:) = nan - allocate(this%N_Run_Off_fert_col (begc:endc)) ; this%N_Run_Off_fert_col (:) = nan - allocate(this%u10_avg_col (begc:endc)) ; this%u10_avg_col (:) = nan - allocate(this%rh_gamma_col (begc:endc)) ; this%rh_gamma_col (:) = nan - allocate(this%rain_col (begc:endc)) ; this%rain_col (:) = nan - allocate(this%gamma_nh3_col (begc:endc)) ; this%gamma_nh3_col (:) = nan - allocate(this%gamma_nh3_fert_col (begc:endc)) ; this%gamma_nh3_fert_col (:) = nan - allocate(this%nh3_manure_col (begc:endc)) ; this%nh3_manure_col (:) = nan -! allocate(this%nh3_fert_col (begc:endc)) ; this%nh3_fert_col (:) = nan - allocate(this%lat_fert_col (begc:endc)) ; this%lat_fert_col (:) = nan - allocate(this%nmanure_to_sminn_col (begc:endc)) ; this%nmanure_to_sminn_col (:) = nan - allocate(this%nfert_to_sminn_col (begc:endc)) ; this%nfert_to_sminn_col (:) = nan - allocate(this%manure_f_n2o_nit_col (begc:endc)) ; this%manure_f_n2o_nit_col (:) = nan - allocate(this%manure_f_n2_denit_col (begc:endc)) ; this%manure_f_n2_denit_col (:) = nan - allocate(this%manure_f_nox_nit_col (begc:endc)) ; this%manure_f_nox_nit_col (:) = nan - allocate(this%fert_f_n2o_nit_col (begc:endc)) ; this%fert_f_n2o_nit_col (:) = nan - allocate(this%fert_f_n2_denit_col (begc:endc)) ; this%fert_f_n2_denit_col (:) = nan - allocate(this%fert_f_nox_nit_col (begc:endc)) ; this%fert_f_nox_nit_col (:) = nan - allocate(this%Nd_col (begc:endc)) ; this%Nd_col (:) = nan - allocate(this%no3_manure_to_soil_col (begc:endc)) ; this%no3_manure_to_soil_col (:) = nan - allocate(this%TAN_manure_to_soil_col (begc:endc)) ; this%TAN_manure_to_soil_col (:) = nan - allocate(this%no3_fert_to_soil_col (begc:endc)) ; this%no3_fert_to_soil_col (:) = nan - allocate(this%TAN_fert_to_soil_col (begc:endc)) ; this%TAN_fert_to_soil_col (:) = nan - allocate(this%f_nox_col (begc:endc)) ; this%f_nox_col (:) = nan - allocate(this%f_nox_denit_vr_col (begc:endc,1:nlevdecomp_full)) ; this%f_nox_denit_vr_col (:,:) = nan - allocate(this%f_nox_denit_col (begc:endc)) ; this%f_nox_denit_col (:) = nan - allocate(this%f_nox_nit_vr_col (begc:endc,1:nlevdecomp_full)) ; this%f_nox_nit_vr_col (:,:) = nan - allocate(this%f_nox_nit_col (begc:endc)) ; this%f_nox_nit_col (:) = nan - allocate(this%Dfc_col (begc:endc,1:nlevdecomp_full)) ; this%Dfc_col (:,:) = spval - allocate(this%poro_fc_col (begc:endc,1:nlevdecomp_full)) ; this%poro_fc_col (:,:) = spval - allocate(this%poroair_col (begc:endc,1:nlevdecomp_full)) ; this%poroair_col (:,:) = spval - allocate(this%wfpsfc_col (begc:endc,1:nlevdecomp_full)) ; this%wfpsfc_col (:,:) = spval - end if +!!$ if ( use_fan ) then +!!$ allocate(this%rain_24hr_col (begc:endc)) ; this%rain_24hr_col (:) = nan +!!$ allocate(this%nhxdep_to_sminn_col (begc:endc)) ; this%nhxdep_to_sminn_col (:) = nan +!!$ allocate(this%noydep_to_sminn_col (begc:endc)) ; this%noydep_to_sminn_col (:) = nan +!!$ allocate(this%ndep_manure_col (begc:endc)) ; this%ndep_manure_col (:) = nan +!!$ allocate(this%ndep_fert_col (begc:endc)) ; this%ndep_fert_col (:) = nan +!!$ allocate(this%N_Run_Off_col (begc:endc)) ; this%N_Run_Off_col (:) = nan +!!$ allocate(this%N_Run_Off_fert_col (begc:endc)) ; this%N_Run_Off_fert_col (:) = nan +!!$ allocate(this%u10_avg_col (begc:endc)) ; this%u10_avg_col (:) = nan +!!$ allocate(this%rh_gamma_col (begc:endc)) ; this%rh_gamma_col (:) = nan +!!$ allocate(this%rain_col (begc:endc)) ; this%rain_col (:) = nan +!!$ allocate(this%gamma_nh3_col (begc:endc)) ; this%gamma_nh3_col (:) = nan +!!$ allocate(this%gamma_nh3_fert_col (begc:endc)) ; this%gamma_nh3_fert_col (:) = nan +!!$ allocate(this%nh3_manure_col (begc:endc)) ; this%nh3_manure_col (:) = nan +!!$! allocate(this%nh3_fert_col (begc:endc)) ; this%nh3_fert_col (:) = nan +!!$ allocate(this%lat_fert_col (begc:endc)) ; this%lat_fert_col (:) = nan +!!$ allocate(this%nmanure_to_sminn_col (begc:endc)) ; this%nmanure_to_sminn_col (:) = nan +!!$ allocate(this%nfert_to_sminn_col (begc:endc)) ; this%nfert_to_sminn_col (:) = nan +!!$ allocate(this%manure_f_n2o_nit_col (begc:endc)) ; this%manure_f_n2o_nit_col (:) = nan +!!$ allocate(this%manure_f_n2_denit_col (begc:endc)) ; this%manure_f_n2_denit_col (:) = nan +!!$ allocate(this%manure_f_nox_nit_col (begc:endc)) ; this%manure_f_nox_nit_col (:) = nan +!!$ allocate(this%fert_f_n2o_nit_col (begc:endc)) ; this%fert_f_n2o_nit_col (:) = nan +!!$ allocate(this%fert_f_n2_denit_col (begc:endc)) ; this%fert_f_n2_denit_col (:) = nan +!!$ allocate(this%fert_f_nox_nit_col (begc:endc)) ; this%fert_f_nox_nit_col (:) = nan +!!$ allocate(this%Nd_col (begc:endc)) ; this%Nd_col (:) = nan +!!$ allocate(this%no3_manure_to_soil_col (begc:endc)) ; this%no3_manure_to_soil_col (:) = nan +!!$ allocate(this%TAN_manure_to_soil_col (begc:endc)) ; this%TAN_manure_to_soil_col (:) = nan +!!$ allocate(this%no3_fert_to_soil_col (begc:endc)) ; this%no3_fert_to_soil_col (:) = nan +!!$ allocate(this%TAN_fert_to_soil_col (begc:endc)) ; this%TAN_fert_to_soil_col (:) = nan +!!$ allocate(this%f_nox_col (begc:endc)) ; this%f_nox_col (:) = nan +!!$ allocate(this%f_nox_denit_vr_col (begc:endc,1:nlevdecomp_full)) ; this%f_nox_denit_vr_col (:,:) = nan +!!$ allocate(this%f_nox_denit_col (begc:endc)) ; this%f_nox_denit_col (:) = nan +!!$ allocate(this%f_nox_nit_vr_col (begc:endc,1:nlevdecomp_full)) ; this%f_nox_nit_vr_col (:,:) = nan +!!$ allocate(this%f_nox_nit_col (begc:endc)) ; this%f_nox_nit_col (:) = nan +!!$ allocate(this%Dfc_col (begc:endc,1:nlevdecomp_full)) ; this%Dfc_col (:,:) = spval +!!$ allocate(this%poro_fc_col (begc:endc,1:nlevdecomp_full)) ; this%poro_fc_col (:,:) = spval +!!$ allocate(this%poroair_col (begc:endc,1:nlevdecomp_full)) ; this%poroair_col (:,:) = spval +!!$ allocate(this%wfpsfc_col (begc:endc,1:nlevdecomp_full)) ; this%wfpsfc_col (:,:) = spval +!!$ end if !KO !JV @@ -454,120 +454,120 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='atmospheric N deposition to soil mineral N', & ptr_col=this%ndep_to_sminn_col) !KO - if ( use_fan ) then - - this%nhxdep_to_sminn_col(begc:endc) = spval - call hist_addfld1d (fname='NHxDEP_TO_SMINN', units='gN/m^2/s', & - avgflag='A', long_name='atmospheric NHx deposition to soil mineral N', & - ptr_col=this%nhxdep_to_sminn_col) - - this%noydep_to_sminn_col(begc:endc) = spval - call hist_addfld1d (fname='NOyDEP_TO_SMINN', units='gN/m^2/s', & - avgflag='A', long_name='atmospheric NOy deposition to soil mineral N', & - ptr_col=this%noydep_to_sminn_col) - - this%ndep_manure_col(begc:endc) = spval - call hist_addfld1d (fname='NDEP_MANURE', units='gN/m^2/s', & - avgflag='A', long_name='N deposition from manure', & - ptr_col=this%ndep_manure_col) - - this%N_Run_Off_col(begc:endc) = spval - call hist_addfld1d (fname='N_RUN_OFF', units='gN/m^2/s', & - avgflag='A', long_name='N run off from manure by rain', & - ptr_col=this%N_Run_Off_col) - - this%nmanure_to_sminn_col(begc:endc) = spval - call hist_addfld1d (fname='NMANURE_TO_SMINN', units='gN/m^2/s', & - avgflag='A', long_name='Deposition of N from manure to soil mineral', & - ptr_col=this%nmanure_to_sminn_col) - - this%ndep_fert_col(begc:endc) = spval - call hist_addfld1d (fname='NDEP_FERT', units='gN/m^2/s', & - avgflag='A', long_name='N deposition from fertilizer', & - ptr_col=this%ndep_fert_col) - - this%N_Run_Off_fert_col(begc:endc) = spval - call hist_addfld1d (fname='N_RUN_OFF_FERT', units='gN/m^2/s', & - avgflag='A', long_name='N run off from fertilizer by rain', & - ptr_col=this%N_Run_Off_fert_col) - - this%nfert_to_sminn_col(begc:endc) = spval - call hist_addfld1d (fname='NFERT_TO_SMINN', units='gN/m^2/s', & - avgflag='A', long_name='Deposition of N from fertilizer to soil mineral', & - ptr_col=this%nfert_to_sminn_col) - - this%nh3_manure_col(begc:endc) = spval - call hist_addfld1d (fname='NH3_MANURE', units='gN/m^2/s', & - avgflag='A', long_name='NH3 emission from manure', & - ptr_col=this%nh3_manure_col) - - this%gamma_nh3_fert_col(begc:endc) = spval - call hist_addfld1d (fname='GAMMA_NH3_FERT', units='none', & - avgflag='A', long_name='Gamma Fn NH3 emission for fertilizer', & - ptr_col=this%gamma_nh3_fert_col) - - !this%nh3_fert_col(begc:endc) = spval - !call hist_addfld1d (fname='NH3_FERT', units='gN/m^2/s', & - ! avgflag='A', long_name='NH3 emission from fertilizer', & - ! ptr_col=this%nh3_fert_col) - - this%manure_f_n2o_nit_col(begc:endc) = spval - call hist_addfld1d (fname='F_N2O_NIT_MANURE', units='gN/m^2/s', & - avgflag='A', long_name='N2O emission from nitrification of manure', & - ptr_col=this%manure_f_n2o_nit_col) - - this%manure_f_n2_denit_col(begc:endc) = spval - call hist_addfld1d (fname='F_N2_DENIT_MANURE', units='gN/m^2/s', & - avgflag='A', long_name='N2 emission from denitrification of manure', & - ptr_col=this%manure_f_n2_denit_col) - - this%manure_f_nox_nit_col(begc:endc) = spval - call hist_addfld1d (fname='F_NOx_NIT_MANURE', units='gN/m^2/s', & - avgflag='A', long_name='NOx emission from nitrification of manure', & - ptr_col=this%manure_f_nox_nit_col) - - this%fert_f_n2o_nit_col(begc:endc) = spval - call hist_addfld1d (fname='F_N2O_NIT_FERTILIZER', units='gN/m^2/s', & - avgflag='A', long_name='N2O emission from nitrification of fertilizer', & - ptr_col=this%fert_f_n2o_nit_col) - - this%fert_f_n2_denit_col(begc:endc) = spval - call hist_addfld1d (fname='F_N2_DENIT_FERTILIZER', units='gN/m^2/s', & - avgflag='A', long_name='N2 emission from denitrification of fertilizer', & - ptr_col=this%fert_f_n2_denit_col) - - this%fert_f_nox_nit_col(begc:endc) = spval - call hist_addfld1d (fname='F_NOx_NIT_FERTILIZER', units='gN/m^2/s', & - avgflag='A', long_name='NOx emission from nitrification of fertilzer', & - ptr_col=this%fert_f_nox_nit_col) - - this%Nd_col(begc:endc) = spval - call hist_addfld1d (fname='ND', units='gN/m^2/s', & - avgflag='A', long_name='Total N emission from denitrification of manure', & - ptr_col=this%Nd_col) - - this%no3_manure_to_soil_col(begc:endc) = spval - call hist_addfld1d (fname='NO3_MANURE_TO_SOIL', units='gN/m^2/s', & - avgflag='A', long_name='Flow of NO3 from manure to soil at rate of 1 % per day', & - ptr_col=this%no3_manure_to_soil_col) - - this%TAN_manure_to_soil_col(begc:endc) = spval - call hist_addfld1d (fname='TAN_MANURE_TO_SOIL', units='gN/m^2/s', & - avgflag='A', long_name='Flow of NH4 from manure to soil at rate of 1 % per day', & - ptr_col=this%TAN_manure_to_soil_col) - - this%no3_fert_to_soil_col(begc:endc) = spval - call hist_addfld1d (fname='NO3_FERT_TO_SOIL', units='gN/m^2/s', & - avgflag='A', long_name='Flow of NO3 from fertilizer to soil at rate of 1 % per day', & - ptr_col=this%no3_fert_to_soil_col) - - this%TAN_fert_to_soil_col(begc:endc) = spval - call hist_addfld1d (fname='TAN_FERT_TO_SOIL', units='gN/m^2/s', & - avgflag='A', long_name='Flow of NH4 from fertilizer to soil at rate of 1 % per day', & - ptr_col=this%TAN_fert_to_soil_col) - - - end if +!!$ if ( use_fan ) then + +!!$ this%nhxdep_to_sminn_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='NHxDEP_TO_SMINN', units='gN/m^2/s', & +!!$ avgflag='A', long_name='atmospheric NHx deposition to soil mineral N', & +!!$ ptr_col=this%nhxdep_to_sminn_col) +!!$ +!!$ this%noydep_to_sminn_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='NOyDEP_TO_SMINN', units='gN/m^2/s', & +!!$ avgflag='A', long_name='atmospheric NOy deposition to soil mineral N', & +!!$ ptr_col=this%noydep_to_sminn_col) +!!$ +!!$ this%ndep_manure_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='NDEP_MANURE', units='gN/m^2/s', & +!!$ avgflag='A', long_name='N deposition from manure', & +!!$ ptr_col=this%ndep_manure_col) +!!$ +!!$ this%N_Run_Off_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='N_RUN_OFF', units='gN/m^2/s', & +!!$ avgflag='A', long_name='N run off from manure by rain', & +!!$ ptr_col=this%N_Run_Off_col) +!!$ +!!$ this%nmanure_to_sminn_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='NMANURE_TO_SMINN', units='gN/m^2/s', & +!!$ avgflag='A', long_name='Deposition of N from manure to soil mineral', & +!!$ ptr_col=this%nmanure_to_sminn_col) +!!$ +!!$ this%ndep_fert_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='NDEP_FERT', units='gN/m^2/s', & +!!$ avgflag='A', long_name='N deposition from fertilizer', & +!!$ ptr_col=this%ndep_fert_col) +!!$ +!!$ this%N_Run_Off_fert_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='N_RUN_OFF_FERT', units='gN/m^2/s', & +!!$ avgflag='A', long_name='N run off from fertilizer by rain', & +!!$ ptr_col=this%N_Run_Off_fert_col) +!!$ +!!$ this%nfert_to_sminn_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='NFERT_TO_SMINN', units='gN/m^2/s', & +!!$ avgflag='A', long_name='Deposition of N from fertilizer to soil mineral', & +!!$ ptr_col=this%nfert_to_sminn_col) +!!$ +!!$ this%nh3_manure_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='NH3_MANURE', units='gN/m^2/s', & +!!$ avgflag='A', long_name='NH3 emission from manure', & +!!$ ptr_col=this%nh3_manure_col) +!!$ +!!$ this%gamma_nh3_fert_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='GAMMA_NH3_FERT', units='none', & +!!$ avgflag='A', long_name='Gamma Fn NH3 emission for fertilizer', & +!!$ ptr_col=this%gamma_nh3_fert_col) +!!$ +!!$ !this%nh3_fert_col(begc:endc) = spval +!!$ !call hist_addfld1d (fname='NH3_FERT', units='gN/m^2/s', & +!!$ ! avgflag='A', long_name='NH3 emission from fertilizer', & +!!$ ! ptr_col=this%nh3_fert_col) +!!$ +!!$ this%manure_f_n2o_nit_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='F_N2O_NIT_MANURE', units='gN/m^2/s', & +!!$ avgflag='A', long_name='N2O emission from nitrification of manure', & +!!$ ptr_col=this%manure_f_n2o_nit_col) +!!$ +!!$ this%manure_f_n2_denit_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='F_N2_DENIT_MANURE', units='gN/m^2/s', & +!!$ avgflag='A', long_name='N2 emission from denitrification of manure', & +!!$ ptr_col=this%manure_f_n2_denit_col) +!!$ +!!$ this%manure_f_nox_nit_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='F_NOx_NIT_MANURE', units='gN/m^2/s', & +!!$ avgflag='A', long_name='NOx emission from nitrification of manure', & +!!$ ptr_col=this%manure_f_nox_nit_col) +!!$ +!!$ this%fert_f_n2o_nit_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='F_N2O_NIT_FERTILIZER', units='gN/m^2/s', & +!!$ avgflag='A', long_name='N2O emission from nitrification of fertilizer', & +!!$ ptr_col=this%fert_f_n2o_nit_col) +!!$ +!!$ this%fert_f_n2_denit_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='F_N2_DENIT_FERTILIZER', units='gN/m^2/s', & +!!$ avgflag='A', long_name='N2 emission from denitrification of fertilizer', & +!!$ ptr_col=this%fert_f_n2_denit_col) +!!$ +!!$ this%fert_f_nox_nit_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='F_NOx_NIT_FERTILIZER', units='gN/m^2/s', & +!!$ avgflag='A', long_name='NOx emission from nitrification of fertilzer', & +!!$ ptr_col=this%fert_f_nox_nit_col) +!!$ +!!$ this%Nd_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='ND', units='gN/m^2/s', & +!!$ avgflag='A', long_name='Total N emission from denitrification of manure', & +!!$ ptr_col=this%Nd_col) +!!$ +!!$ this%no3_manure_to_soil_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='NO3_MANURE_TO_SOIL', units='gN/m^2/s', & +!!$ avgflag='A', long_name='Flow of NO3 from manure to soil at rate of 1 % per day', & +!!$ ptr_col=this%no3_manure_to_soil_col) +!!$ +!!$ this%TAN_manure_to_soil_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='TAN_MANURE_TO_SOIL', units='gN/m^2/s', & +!!$ avgflag='A', long_name='Flow of NH4 from manure to soil at rate of 1 % per day', & +!!$ ptr_col=this%TAN_manure_to_soil_col) +!!$ +!!$ this%no3_fert_to_soil_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='NO3_FERT_TO_SOIL', units='gN/m^2/s', & +!!$ avgflag='A', long_name='Flow of NO3 from fertilizer to soil at rate of 1 % per day', & +!!$ ptr_col=this%no3_fert_to_soil_col) +!!$ +!!$ this%TAN_fert_to_soil_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='TAN_FERT_TO_SOIL', units='gN/m^2/s', & +!!$ avgflag='A', long_name='Flow of NH4 from fertilizer to soil at rate of 1 % per day', & +!!$ ptr_col=this%TAN_fert_to_soil_col) +!!$ +!!$ +!!$ end if !KO !JV if (use_fan) then @@ -1376,21 +1376,21 @@ subroutine SetValues ( this, & end do !KO - if ( use_fan ) then - do j = 1, nlevdecomp_full - do fi = 1,num_column - i = filter_column(fi) - if ( use_nitrif_denitrif ) then - this%f_nox_denit_vr_col(i,j) = value_column - this%f_nox_nit_vr_col(i,j) = value_column - this%Dfc_col(i,j) = value_column - this%poro_fc_col(i,j) = value_column - this%poroair_col(i,j) = value_column - this%wfpsfc_col(i,j) = value_column - end if - end do - end do - end if +!!$ if ( use_fan ) then +!!$ do j = 1, nlevdecomp_full +!!$ do fi = 1,num_column +!!$ i = filter_column(fi) +!!$ if ( use_nitrif_denitrif ) then +!!$ this%f_nox_denit_vr_col(i,j) = value_column +!!$ this%f_nox_nit_vr_col(i,j) = value_column +!!$ this%Dfc_col(i,j) = value_column +!!$ this%poro_fc_col(i,j) = value_column +!!$ this%poroair_col(i,j) = value_column +!!$ this%wfpsfc_col(i,j) = value_column +!!$ end if +!!$ end do +!!$ end do +!!$ end if !KO do fi = 1,num_column @@ -1431,39 +1431,39 @@ subroutine SetValues ( this, & if ( use_fan ) then do fi = 1,num_column i = filter_column(fi) -!KO this%rain_24hr_col(i) = value_column - this%nhxdep_to_sminn_col(i) = value_column - this%noydep_to_sminn_col(i) = value_column - this%ndep_manure_col(i) = value_column - this%ndep_fert_col(i) = value_column - this%N_Run_Off_col(i) = value_column - this%N_Run_Off_fert_col(i) = value_column -!KO this%u10_avg_col(i) = value_column -!KO this%rh_gamma_col(i) = value_column -!KO this%rain_col(i) = value_column -!KO this%gamma_nh3_col(i) = value_column - this%gamma_nh3_fert_col(i) = value_column - this%nh3_manure_col(i) = value_column - this%nh3_fert_col(i) = value_column - this%lat_fert_col(i) = value_column - this%nmanure_to_sminn_col(i) = value_column - this%nfert_to_sminn_col(i) = value_column - this%manure_f_n2o_nit_col(i) = value_column - this%manure_f_n2_denit_col(i) = value_column - this%manure_f_nox_nit_col(i) = value_column - this%fert_f_n2o_nit_col(i) = value_column - this%fert_f_n2_denit_col(i) = value_column - this%fert_f_nox_nit_col(i) = value_column - this%Nd_col(i) = value_column - this%no3_manure_to_soil_col(i) = value_column - this%TAN_manure_to_soil_col(i) = value_column - this%no3_fert_to_soil_col(i) = value_column - this%TAN_fert_to_soil_col(i) = value_column - if ( use_nitrif_denitrif ) then - this%f_nox_col(i) = value_column - this%f_nox_denit_col(i) = value_column - this%f_nox_nit_col(i) = value_column - end if +!!$!KO this%rain_24hr_col(i) = value_column +!!$ this%nhxdep_to_sminn_col(i) = value_column +!!$ this%noydep_to_sminn_col(i) = value_column +!!$ this%ndep_manure_col(i) = value_column +!!$ this%ndep_fert_col(i) = value_column +!!$ this%N_Run_Off_col(i) = value_column +!!$ this%N_Run_Off_fert_col(i) = value_column +!!$!KO this%u10_avg_col(i) = value_column +!!$!KO this%rh_gamma_col(i) = value_column +!!$!KO this%rain_col(i) = value_column +!!$!KO this%gamma_nh3_col(i) = value_column +!!$ this%gamma_nh3_fert_col(i) = value_column +!!$ this%nh3_manure_col(i) = value_column +!!$ this%nh3_fert_col(i) = value_column +!!$ this%lat_fert_col(i) = value_column +!!$ this%nmanure_to_sminn_col(i) = value_column +!!$ this%nfert_to_sminn_col(i) = value_column +!!$ this%manure_f_n2o_nit_col(i) = value_column +!!$ this%manure_f_n2_denit_col(i) = value_column +!!$ this%manure_f_nox_nit_col(i) = value_column +!!$ this%fert_f_n2o_nit_col(i) = value_column +!!$ this%fert_f_n2_denit_col(i) = value_column +!!$ this%fert_f_nox_nit_col(i) = value_column +!!$ this%Nd_col(i) = value_column +!!$ this%no3_manure_to_soil_col(i) = value_column +!!$ this%TAN_manure_to_soil_col(i) = value_column +!!$ this%no3_fert_to_soil_col(i) = value_column +!!$ this%TAN_fert_to_soil_col(i) = value_column +!!$ if ( use_nitrif_denitrif ) then +!!$ this%f_nox_col(i) = value_column +!!$ this%f_nox_denit_col(i) = value_column +!!$ this%f_nox_nit_col(i) = value_column +!!$ end if this%man_tan_appl_col(i) = value_column this%man_n_appl_col(i) = value_column @@ -1654,15 +1654,15 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc) this%pot_f_denit_vr_col(c,j) * dzsoi_decomp(j) !KO - if ( use_fan ) then - this%f_nox_nit_col(c) = & - this%f_nox_nit_col(c) + & - this%f_nox_nit_vr_col(c,j) * dzsoi_decomp(j) - - this%f_nox_denit_col(c) = & - this%f_nox_denit_col(c) + & - this%f_nox_denit_vr_col(c,j) * dzsoi_decomp(j) - end if +!!$ if ( use_fan ) then +!!$ this%f_nox_nit_col(c) = & +!!$ this%f_nox_nit_col(c) + & +!!$ this%f_nox_nit_vr_col(c,j) * dzsoi_decomp(j) +!!$ +!!$ this%f_nox_denit_col(c) = & +!!$ this%f_nox_denit_col(c) + & +!!$ this%f_nox_denit_vr_col(c,j) * dzsoi_decomp(j) +!!$ end if !KO this%f_n2o_nit_col(c) = & diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 index 7dada94956..39628726aa 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 @@ -70,42 +70,42 @@ module SoilBiogeochemNitrogenStateType real(r8), pointer :: fan_grz_fract_col(:) ! col unitless fraction of animals grazing !KO ! FAN - real(r8), pointer :: smin_no3_monthly_col (:) ! col (gN/m2) soil mineral NO3 pool - real(r8), pointer :: smin_nh4_monthly_col (:) ! col (gN/m2) soil mineral NH4 pool - real(r8), pointer :: TAN_manu_col (:) ! col (gN/m2) total ammoniacal nitrogen in manure - real(r8), pointer :: no3_manure_col (:) ! col (gN/m2) NO3 pool in manure - real(r8), pointer :: manure_u_col (:) ! col (gN/m2) urine pool in manure - real(r8), pointer :: manure_n_col (:) ! col (gN/m2) non-mineralizable N pool in manure - real(r8), pointer :: manure_a_col (:) ! col (gN/m2) available N pool in manure - real(r8), pointer :: manure_r_col (:) ! col (gN/m2) resistant N pool in manure - real(r8), pointer :: n2o_manure_total_col (:) ! col (gN/m2) total atmospheric N emission of N2O from manure - real(r8), pointer :: nox_manure_total_col (:) ! col (gN/m2) total atmospheric N emission of NOx from manure - real(r8), pointer :: nh3_manure_total_col (:) ! col (gN/m2) total atmospheric N emission of NH3 from manure - real(r8), pointer :: N_Run_Off_manure_total_col (:) ! col (gN/m2) total N washed from N manure - real(r8), pointer :: nh4_manure_total_col (:) ! col (gN/m2) total NH4 emission from manure - real(r8), pointer :: no3_manure_total_col (:) ! col (gN/m2) total NO3 emission from manure - real(r8), pointer :: ndep_total_col (:) ! col (gN/m2) total ndep from manure and fertilizer - real(r8), pointer :: fert_u_col (:) ! col (gN/m2) N pool in fertilizer - real(r8), pointer :: no3_fert_col (:) ! col (gN/m2) NO3 pool in fertilizer - real(r8), pointer :: nh3_fert_total_col (:) ! col (gN/m2) total atmospheric N emission of NH3 from fertilizer - real(r8), pointer :: N_Run_Off_fert_total_col (:) ! col (gN/m2) total N washed from N fertilizer - real(r8), pointer :: nh4_fert_total_col (:) ! col (gN/m2) total NH4 emission from fertilizer - real(r8), pointer :: no3_fert_total_col (:) ! col (gN/m2) total NO3 emission from fertilizer - real(r8), pointer :: ndep_fert_total_col (:) ! col (gN/m2) total ndep from fertilizer - real(r8), pointer :: total_nh3_col (:) ! col (gN/m2) total atmospheric N emission of NH3 from Nr - real(r8), pointer :: total_N_Run_Off_col (:) ! col (gN/m2) total N washed from N Nr - real(r8), pointer :: total_nh4_col (:) ! col (gN/m2) total NH4 emission from Nr - real(r8), pointer :: total_no3_col (:) ! col (gN/m2) total NO3 emission from Nr - real(r8), pointer :: total_ndep_col (:) ! col (gN/m2) total ndep from Nr - real(r8), pointer :: TAN_fert_col (:) ! col (gN/m2) total ammoniacal nitrogen in fertilizer - real(r8), pointer :: man_water_pool_col (:) ! col (m3/m2) volume of water in manure/water solution - real(r8), pointer :: fert_water_pool_col (:) ! col (m3/m2) volume of water in fert/water solution - real(r8), pointer :: ra_col (:) ! col (s/m) aerodynamic resistance for grass pfts - real(r8), pointer :: rb_col (:) ! col (s/m) leaf boundary layer resistance for grass pfts - real(r8), pointer :: gdd8_col (:) ! col (ddays) growing degree-days base 8C from planting - real(r8), pointer :: t_a10_col (:) ! col (K) 10-day running mean of the 2 m temperature - real(r8), pointer :: t_a10min_col (:) ! col (K) 10-day running mean of min 2-m temperature - real(r8), pointer :: fert_app_jday_col (:) ! col (day) julian day of the first fertilizer application +!!$ real(r8), pointer :: smin_no3_monthly_col (:) ! col (gN/m2) soil mineral NO3 pool +!!$ real(r8), pointer :: smin_nh4_monthly_col (:) ! col (gN/m2) soil mineral NH4 pool +!!$ real(r8), pointer :: TAN_manu_col (:) ! col (gN/m2) total ammoniacal nitrogen in manure +!!$ real(r8), pointer :: no3_manure_col (:) ! col (gN/m2) NO3 pool in manure +!!$ real(r8), pointer :: manure_u_col (:) ! col (gN/m2) urine pool in manure +!!$ real(r8), pointer :: manure_n_col (:) ! col (gN/m2) non-mineralizable N pool in manure +!!$ real(r8), pointer :: manure_a_col (:) ! col (gN/m2) available N pool in manure +!!$ real(r8), pointer :: manure_r_col (:) ! col (gN/m2) resistant N pool in manure +!!$ real(r8), pointer :: n2o_manure_total_col (:) ! col (gN/m2) total atmospheric N emission of N2O from manure +!!$ real(r8), pointer :: nox_manure_total_col (:) ! col (gN/m2) total atmospheric N emission of NOx from manure +!!$ real(r8), pointer :: nh3_manure_total_col (:) ! col (gN/m2) total atmospheric N emission of NH3 from manure +!!$ real(r8), pointer :: N_Run_Off_manure_total_col (:) ! col (gN/m2) total N washed from N manure +!!$ real(r8), pointer :: nh4_manure_total_col (:) ! col (gN/m2) total NH4 emission from manure +!!$ real(r8), pointer :: no3_manure_total_col (:) ! col (gN/m2) total NO3 emission from manure +!!$ real(r8), pointer :: ndep_total_col (:) ! col (gN/m2) total ndep from manure and fertilizer +!!$ real(r8), pointer :: fert_u_col (:) ! col (gN/m2) N pool in fertilizer +!!$ real(r8), pointer :: no3_fert_col (:) ! col (gN/m2) NO3 pool in fertilizer +!!$ real(r8), pointer :: nh3_fert_total_col (:) ! col (gN/m2) total atmospheric N emission of NH3 from fertilizer +!!$ real(r8), pointer :: N_Run_Off_fert_total_col (:) ! col (gN/m2) total N washed from N fertilizer +!!$ real(r8), pointer :: nh4_fert_total_col (:) ! col (gN/m2) total NH4 emission from fertilizer +!!$ real(r8), pointer :: no3_fert_total_col (:) ! col (gN/m2) total NO3 emission from fertilizer +!!$ real(r8), pointer :: ndep_fert_total_col (:) ! col (gN/m2) total ndep from fertilizer +!!$ real(r8), pointer :: total_nh3_col (:) ! col (gN/m2) total atmospheric N emission of NH3 from Nr +!!$ real(r8), pointer :: total_N_Run_Off_col (:) ! col (gN/m2) total N washed from N Nr +!!$ real(r8), pointer :: total_nh4_col (:) ! col (gN/m2) total NH4 emission from Nr +!!$ real(r8), pointer :: total_no3_col (:) ! col (gN/m2) total NO3 emission from Nr +!!$ real(r8), pointer :: total_ndep_col (:) ! col (gN/m2) total ndep from Nr +!!$ real(r8), pointer :: TAN_fert_col (:) ! col (gN/m2) total ammoniacal nitrogen in fertilizer +!!$ real(r8), pointer :: man_water_pool_col (:) ! col (m3/m2) volume of water in manure/water solution +!!$ real(r8), pointer :: fert_water_pool_col (:) ! col (m3/m2) volume of water in fert/water solution +!!$ real(r8), pointer :: ra_col (:) ! col (s/m) aerodynamic resistance for grass pfts +!!$ real(r8), pointer :: rb_col (:) ! col (s/m) leaf boundary layer resistance for grass pfts +!!$ real(r8), pointer :: gdd8_col (:) ! col (ddays) growing degree-days base 8C from planting +!!$ real(r8), pointer :: t_a10_col (:) ! col (K) 10-day running mean of the 2 m temperature +!!$ real(r8), pointer :: t_a10min_col (:) ! col (K) 10-day running mean of min 2-m temperature +!!$ real(r8), pointer :: fert_app_jday_col (:) ! col (day) julian day of the first fertilizer application !KO ! summary (diagnostic) state variables, not involved in mass balance @@ -233,44 +233,44 @@ subroutine InitAllocate(this, bounds) !KO - if ( use_fan ) then - allocate(this%smin_no3_monthly_col (begc:endc)) ; this%smin_no3_monthly_col (:) = nan - allocate(this%smin_nh4_monthly_col (begc:endc)) ; this%smin_nh4_monthly_col (:) = nan - allocate(this%TAN_manu_col (begc:endc)) ; this%TAN_manu_col (:) = nan - allocate(this%no3_manure_col (begc:endc)) ; this%no3_manure_col (:) = nan - allocate(this%manure_u_col (begc:endc)) ; this%manure_u_col (:) = nan - allocate(this%manure_n_col (begc:endc)) ; this%manure_n_col (:) = nan - allocate(this%manure_a_col (begc:endc)) ; this%manure_a_col (:) = nan - allocate(this%manure_r_col (begc:endc)) ; this%manure_r_col (:) = nan - allocate(this%n2o_manure_total_col (begc:endc)) ; this%n2o_manure_total_col (:) = nan - allocate(this%nox_manure_total_col (begc:endc)) ; this%nox_manure_total_col (:) = nan - allocate(this%nh3_manure_total_col (begc:endc)) ; this%nh3_manure_total_col (:) = nan - allocate(this%N_Run_Off_manure_total_col (begc:endc)) ; this%N_Run_Off_manure_total_col (:) = nan - allocate(this%nh4_manure_total_col (begc:endc)) ; this%nh4_manure_total_col (:) = nan - allocate(this%no3_manure_total_col (begc:endc)) ; this%no3_manure_total_col (:) = nan - allocate(this%ndep_total_col (begc:endc)) ; this%ndep_total_col (:) = nan - allocate(this%fert_u_col (begc:endc)) ; this%fert_u_col (:) = nan - allocate(this%no3_fert_col (begc:endc)) ; this%no3_fert_col (:) = nan - allocate(this%nh3_fert_total_col (begc:endc)) ; this%nh3_fert_total_col (:) = nan - allocate(this%N_Run_Off_fert_total_col (begc:endc)) ; this%N_Run_Off_fert_total_col (:) = nan - allocate(this%nh4_fert_total_col (begc:endc)) ; this%nh4_fert_total_col (:) = nan - allocate(this%no3_fert_total_col (begc:endc)) ; this%no3_fert_total_col (:) = nan - allocate(this%ndep_fert_total_col (begc:endc)) ; this%ndep_fert_total_col (:) = nan - allocate(this%total_nh3_col (begc:endc)) ; this%total_nh3_col (:) = nan - allocate(this%total_N_Run_Off_col (begc:endc)) ; this%total_N_Run_Off_col (:) = nan - allocate(this%total_nh4_col (begc:endc)) ; this%total_nh4_col (:) = nan - allocate(this%total_no3_col (begc:endc)) ; this%total_no3_col (:) = nan - allocate(this%total_ndep_col (begc:endc)) ; this%total_ndep_col (:) = nan - allocate(this%TAN_fert_col (begc:endc)) ; this%TAN_fert_col (:) = nan - allocate(this%man_water_pool_col (begc:endc)) ; this%man_water_pool_col (:) = nan - allocate(this%fert_water_pool_col (begc:endc)) ; this%fert_water_pool_col (:) = nan - allocate(this%ra_col (begc:endc)) ; this%ra_col (:) = nan - allocate(this%rb_col (begc:endc)) ; this%rb_col (:) = nan - allocate(this%gdd8_col (begc:endc)) ; this%gdd8_col (:) = nan - allocate(this%fert_app_jday_col (begc:endc)) ; this%fert_app_jday_col (:) = nan - allocate(this%t_a10_col (begc:endc)) ; this%t_a10_col (:) = nan - allocate(this%t_a10min_col (begc:endc)) ; this%t_a10min_col (:) = nan - end if +!!$ if ( use_fan ) then +!!$ allocate(this%smin_no3_monthly_col (begc:endc)) ; this%smin_no3_monthly_col (:) = nan +!!$ allocate(this%smin_nh4_monthly_col (begc:endc)) ; this%smin_nh4_monthly_col (:) = nan +!!$ allocate(this%TAN_manu_col (begc:endc)) ; this%TAN_manu_col (:) = nan +!!$ allocate(this%no3_manure_col (begc:endc)) ; this%no3_manure_col (:) = nan +!!$ allocate(this%manure_u_col (begc:endc)) ; this%manure_u_col (:) = nan +!!$ allocate(this%manure_n_col (begc:endc)) ; this%manure_n_col (:) = nan +!!$ allocate(this%manure_a_col (begc:endc)) ; this%manure_a_col (:) = nan +!!$ allocate(this%manure_r_col (begc:endc)) ; this%manure_r_col (:) = nan +!!$ allocate(this%n2o_manure_total_col (begc:endc)) ; this%n2o_manure_total_col (:) = nan +!!$ allocate(this%nox_manure_total_col (begc:endc)) ; this%nox_manure_total_col (:) = nan +!!$ allocate(this%nh3_manure_total_col (begc:endc)) ; this%nh3_manure_total_col (:) = nan +!!$ allocate(this%N_Run_Off_manure_total_col (begc:endc)) ; this%N_Run_Off_manure_total_col (:) = nan +!!$ allocate(this%nh4_manure_total_col (begc:endc)) ; this%nh4_manure_total_col (:) = nan +!!$ allocate(this%no3_manure_total_col (begc:endc)) ; this%no3_manure_total_col (:) = nan +!!$ allocate(this%ndep_total_col (begc:endc)) ; this%ndep_total_col (:) = nan +!!$ allocate(this%fert_u_col (begc:endc)) ; this%fert_u_col (:) = nan +!!$ allocate(this%no3_fert_col (begc:endc)) ; this%no3_fert_col (:) = nan +!!$ allocate(this%nh3_fert_total_col (begc:endc)) ; this%nh3_fert_total_col (:) = nan +!!$ allocate(this%N_Run_Off_fert_total_col (begc:endc)) ; this%N_Run_Off_fert_total_col (:) = nan +!!$ allocate(this%nh4_fert_total_col (begc:endc)) ; this%nh4_fert_total_col (:) = nan +!!$ allocate(this%no3_fert_total_col (begc:endc)) ; this%no3_fert_total_col (:) = nan +!!$ allocate(this%ndep_fert_total_col (begc:endc)) ; this%ndep_fert_total_col (:) = nan +!!$ allocate(this%total_nh3_col (begc:endc)) ; this%total_nh3_col (:) = nan +!!$ allocate(this%total_N_Run_Off_col (begc:endc)) ; this%total_N_Run_Off_col (:) = nan +!!$ allocate(this%total_nh4_col (begc:endc)) ; this%total_nh4_col (:) = nan +!!$ allocate(this%total_no3_col (begc:endc)) ; this%total_no3_col (:) = nan +!!$ allocate(this%total_ndep_col (begc:endc)) ; this%total_ndep_col (:) = nan +!!$ allocate(this%TAN_fert_col (begc:endc)) ; this%TAN_fert_col (:) = nan +!!$ allocate(this%man_water_pool_col (begc:endc)) ; this%man_water_pool_col (:) = nan +!!$ allocate(this%fert_water_pool_col (begc:endc)) ; this%fert_water_pool_col (:) = nan +!!$ allocate(this%ra_col (begc:endc)) ; this%ra_col (:) = nan +!!$ allocate(this%rb_col (begc:endc)) ; this%rb_col (:) = nan +!!$ allocate(this%gdd8_col (begc:endc)) ; this%gdd8_col (:) = nan +!!$ allocate(this%fert_app_jday_col (begc:endc)) ; this%fert_app_jday_col (:) = nan +!!$ allocate(this%t_a10_col (begc:endc)) ; this%t_a10_col (:) = nan +!!$ allocate(this%t_a10min_col (begc:endc)) ; this%t_a10min_col (:) = nan +!!$ end if !KO end subroutine InitAllocate @@ -394,17 +394,17 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='soil mineral NH4', & ptr_col=this%smin_nh4_col) !KO - if ( use_fan ) then - this%smin_no3_monthly_col(begc:endc) = spval - call hist_addfld1d (fname='SMIN_NO3_MONTHLY', units='gN/m^2/month', & - avgflag='A', long_name='soil mineral NO3 monthly', & - ptr_col=this%smin_no3_monthly_col) - - this%smin_nh4_monthly_col(begc:endc) = spval - call hist_addfld1d (fname='SMIN_NH4_MONTHLY', units='gN/m^2/month', & - avgflag='A', long_name='soil mineral NH4 monthly', & - ptr_col=this%smin_nh4_monthly_col) - end if +!!$ if ( use_fan ) then +!!$ this%smin_no3_monthly_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='SMIN_NO3_MONTHLY', units='gN/m^2/month', & +!!$ avgflag='A', long_name='soil mineral NO3 monthly', & +!!$ ptr_col=this%smin_no3_monthly_col) +!!$ +!!$ this%smin_nh4_monthly_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='SMIN_NH4_MONTHLY', units='gN/m^2/month', & +!!$ avgflag='A', long_name='soil mineral NH4 monthly', & +!!$ ptr_col=this%smin_nh4_monthly_col) +!!$ end if !KO endif else @@ -435,160 +435,160 @@ subroutine InitHistory(this, bounds) ptr_col=this%dyn_nbal_adjustments_col, default='inactive') !KO - if ( use_fan ) then - - this%TAN_manu_col(begc:endc) = spval - call hist_addfld1d (fname='TAN_MANU', units='gN/m^2', & - avgflag='A', long_name='Manure TAN pool', & - ptr_col=this%TAN_manu_col) - - this%TAN_fert_col(begc:endc) = spval - call hist_addfld1d (fname='TAN_FERT', units='gN/m^2', & - avgflag='A', long_name='Fertilizer TAN pool', & - ptr_col=this%TAN_fert_col) - - this%fert_u_col(begc:endc) = spval - call hist_addfld1d (fname='TAN_FERT_U', units='gN/m^2', & - avgflag='A', long_name='Fertilizer N pool', & - ptr_col=this%fert_u_col) - - this%manure_n_col(begc:endc) = spval - call hist_addfld1d (fname='TAN_MANU_N', units='gN/m^2', & - avgflag='A', long_name='Non-minerizable manure TAN pool', & - ptr_col=this%manure_n_col) - - this%manure_u_col(begc:endc) = spval - call hist_addfld1d (fname='TAN_MANU_U', units='gN/m^2', & - avgflag='A', long_name='Urine manure TAN pool', & - ptr_col=this%manure_u_col) - - this%manure_a_col(begc:endc) = spval - call hist_addfld1d (fname='TAN_MANU_A', units='gN/m^2', & - avgflag='A', long_name='Available manure TAN pool', & - ptr_col=this%manure_a_col) - - this%manure_r_col(begc:endc) = spval - call hist_addfld1d (fname='TAN_MANU_R', units='gN/m^2', & - avgflag='A', long_name='Resistant manure TAN pool', & - ptr_col=this%manure_r_col) - - this%man_water_pool_col(begc:endc) = spval - call hist_addfld1d (fname='MAN_WATER_POOL', units='m^3/m^2', & - avgflag='A', long_name='Manure water pool', & - ptr_col=this%man_water_pool_col) - - this%fert_water_pool_col(begc:endc) = spval - call hist_addfld1d (fname='FERT_WATER_POOL', units='m^3/m^2', & - avgflag='A', long_name='Fertilizer water pool', & - ptr_col=this%fert_water_pool_col) - - this%ra_col(begc:endc) = spval - call hist_addfld1d (fname='RA_COL', units='s/m', & - avgflag='A', long_name='Column aerodynamic resistance for grass pft', & - ptr_col=this%ra_col) - - this%rb_col(begc:endc) = spval - call hist_addfld1d (fname='RB_COL', units='s/m', & - avgflag='A', long_name='Column boundary layer resistance for grass pft', & - ptr_col=this%rb_col) - - this%fert_app_jday_col(begc:endc) = spval - call hist_addfld1d (fname='FERT_APP_JDAY', units='', & - avgflag='A', long_name='Fertilizer application julian day', & - ptr_col=this%fert_app_jday_col) - - this%no3_manure_col(begc:endc) = spval - call hist_addfld1d (fname='NO3_MANURE', units='gN/m^2', & - avgflag='A', long_name='NO3 Pool in Manure', & - ptr_col=this%no3_manure_col) - - this%n2o_manure_total_col(begc:endc) = spval - call hist_addfld1d (fname='N2O_MANURE_TOTAL', units='gN/m^2/yr', & - avgflag='A', long_name='TOTAL N2O emission from manure', & - ptr_col=this%n2o_manure_total_col) - - this%nox_manure_total_col(begc:endc) = spval - call hist_addfld1d (fname='NOx_MANURE_TOTAL', units='gN/m^2/yr', & - avgflag='A', long_name='TOTAL NOx emission from manure', & - ptr_col=this%nox_manure_total_col) - - this%nh3_manure_total_col(begc:endc) = spval - call hist_addfld1d (fname='NH3_MANURE_TOTAL', units='gN/m^2/yr', & - avgflag='A', long_name='TOTAL NH3 emission from manure', & - ptr_col=this%nh3_manure_total_col) - - this%ndep_total_col(begc:endc) = spval - call hist_addfld1d (fname='NDEP_TOTAL', units='gN/m^2/yr', & - avgflag='A', long_name='TOTAL N DEP from manure and fertilizer', & - ptr_col=this%ndep_total_col) - - this%N_Run_Off_manure_total_col(begc:endc) = spval - call hist_addfld1d (fname='N_RUN_OFF_MANURE_TOTAL', units='gN/m^2/yr', & - avgflag='A', long_name='Total N run off from manure', & - ptr_col=this%N_Run_Off_manure_total_col) - - this%nh4_manure_total_col(begc:endc) = spval - call hist_addfld1d (fname='NH4_MANURE_TOTAL', units='gN/m^2/yr', & - avgflag='A', long_name='Total NH4 from manure', & - ptr_col=this%nh4_manure_total_col) - - this%no3_manure_total_col(begc:endc) = spval - call hist_addfld1d (fname='NO3_MANURE_TOTAL', units='gN/m^2/yr', & - avgflag='A', long_name='Total NO3 from manure', & - ptr_col=this%no3_manure_total_col) - - this%nh3_fert_total_col(begc:endc) = spval - call hist_addfld1d (fname='NH3_FERT_TOTAL', units='gN/m^2/yr', & - avgflag='A', long_name='TOTAL NH3 emission from fertilizer', & - ptr_col=this%nh3_fert_total_col) - - this%ndep_fert_total_col(begc:endc) = spval - call hist_addfld1d (fname='NDEP_FERT_TOTAL', units='gN/m^2/yr', & - avgflag='A', long_name='TOTAL N DEP from FERTILIZER', & - ptr_col=this%ndep_fert_total_col) - - this%N_Run_Off_fert_total_col(begc:endc) = spval - call hist_addfld1d (fname='N_RUN_OFF_FERT_TOTAL', units='gN/m^2/yr', & - avgflag='A', long_name='Total N run off from fertilizer', & - ptr_col=this%N_Run_Off_fert_total_col) - - this%nh4_fert_total_col(begc:endc) = spval - call hist_addfld1d (fname='NH4_FERT_TOTAL', units='gN/m^2/yr', & - avgflag='A', long_name='Total NH4 from fertilizer', & - ptr_col=this%nh4_fert_total_col) - - this%no3_fert_total_col(begc:endc) = spval - call hist_addfld1d (fname='NO3_FERT_TOTAL', units='gN/m^2/yr', & - avgflag='A', long_name='Total NO3 from fertilizer', & - ptr_col=this%no3_fert_total_col) - - this%total_nh3_col(begc:endc) = spval - call hist_addfld1d (fname='TOTAL_NH3', units='gN/m^2/yr', & - avgflag='A', long_name='TOTAL NH3 emission from Nr', & - ptr_col=this%total_nh3_col) - - this%total_ndep_col(begc:endc) = spval - call hist_addfld1d (fname='TOTAL_NDEP', units='gN/m^2/yr', & - avgflag='A', long_name='TOTAL N DEP from Nr', & - ptr_col=this%total_ndep_col) - - this%total_N_Run_Off_col(begc:endc) = spval - call hist_addfld1d (fname='TOTAL_N_RUN_OFF', units='gN/m^2/yr', & - avgflag='A', long_name='Total N run off from Nr', & - ptr_col=this%total_N_Run_Off_col) - - this%total_nh4_col(begc:endc) = spval - call hist_addfld1d (fname='TOTAL_NH4', units='gN/m^2', & - avgflag='A', long_name='Total NH4 from Nr', & - ptr_col=this%total_nh4_col) - - this%total_no3_col(begc:endc) = spval - call hist_addfld1d (fname='TOTAL_NO3', units='gN/m^2', & - avgflag='A', long_name='Total NO3 from Nr', & - ptr_col=this%total_no3_col) - - end if -!KO +!!$ if ( use_fan ) then +!!$ +!!$ this%TAN_manu_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='TAN_MANU', units='gN/m^2', & +!!$ avgflag='A', long_name='Manure TAN pool', & +!!$ ptr_col=this%TAN_manu_col) +!!$ +!!$ this%TAN_fert_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='TAN_FERT', units='gN/m^2', & +!!$ avgflag='A', long_name='Fertilizer TAN pool', & +!!$ ptr_col=this%TAN_fert_col) +!!$ +!!$ this%fert_u_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='TAN_FERT_U', units='gN/m^2', & +!!$ avgflag='A', long_name='Fertilizer N pool', & +!!$ ptr_col=this%fert_u_col) +!!$ +!!$ this%manure_n_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='TAN_MANU_N', units='gN/m^2', & +!!$ avgflag='A', long_name='Non-minerizable manure TAN pool', & +!!$ ptr_col=this%manure_n_col) +!!$ +!!$ this%manure_u_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='TAN_MANU_U', units='gN/m^2', & +!!$ avgflag='A', long_name='Urine manure TAN pool', & +!!$ ptr_col=this%manure_u_col) +!!$ +!!$ this%manure_a_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='TAN_MANU_A', units='gN/m^2', & +!!$ avgflag='A', long_name='Available manure TAN pool', & +!!$ ptr_col=this%manure_a_col) +!!$ +!!$ this%manure_r_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='TAN_MANU_R', units='gN/m^2', & +!!$ avgflag='A', long_name='Resistant manure TAN pool', & +!!$ ptr_col=this%manure_r_col) +!!$ +!!$ this%man_water_pool_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='MAN_WATER_POOL', units='m^3/m^2', & +!!$ avgflag='A', long_name='Manure water pool', & +!!$ ptr_col=this%man_water_pool_col) +!!$ +!!$ this%fert_water_pool_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='FERT_WATER_POOL', units='m^3/m^2', & +!!$ avgflag='A', long_name='Fertilizer water pool', & +!!$ ptr_col=this%fert_water_pool_col) +!!$ +!!$ this%ra_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='RA_COL', units='s/m', & +!!$ avgflag='A', long_name='Column aerodynamic resistance for grass pft', & +!!$ ptr_col=this%ra_col) +!!$ +!!$ this%rb_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='RB_COL', units='s/m', & +!!$ avgflag='A', long_name='Column boundary layer resistance for grass pft', & +!!$ ptr_col=this%rb_col) +!!$ +!!$ this%fert_app_jday_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='FERT_APP_JDAY', units='', & +!!$ avgflag='A', long_name='Fertilizer application julian day', & +!!$ ptr_col=this%fert_app_jday_col) +!!$ +!!$ this%no3_manure_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='NO3_MANURE', units='gN/m^2', & +!!$ avgflag='A', long_name='NO3 Pool in Manure', & +!!$ ptr_col=this%no3_manure_col) +!!$ +!!$ this%n2o_manure_total_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='N2O_MANURE_TOTAL', units='gN/m^2/yr', & +!!$ avgflag='A', long_name='TOTAL N2O emission from manure', & +!!$ ptr_col=this%n2o_manure_total_col) +!!$ +!!$ this%nox_manure_total_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='NOx_MANURE_TOTAL', units='gN/m^2/yr', & +!!$ avgflag='A', long_name='TOTAL NOx emission from manure', & +!!$ ptr_col=this%nox_manure_total_col) +!!$ +!!$ this%nh3_manure_total_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='NH3_MANURE_TOTAL', units='gN/m^2/yr', & +!!$ avgflag='A', long_name='TOTAL NH3 emission from manure', & +!!$ ptr_col=this%nh3_manure_total_col) +!!$ +!!$ this%ndep_total_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='NDEP_TOTAL', units='gN/m^2/yr', & +!!$ avgflag='A', long_name='TOTAL N DEP from manure and fertilizer', & +!!$ ptr_col=this%ndep_total_col) +!!$ +!!$ this%N_Run_Off_manure_total_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='N_RUN_OFF_MANURE_TOTAL', units='gN/m^2/yr', & +!!$ avgflag='A', long_name='Total N run off from manure', & +!!$ ptr_col=this%N_Run_Off_manure_total_col) +!!$ +!!$ this%nh4_manure_total_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='NH4_MANURE_TOTAL', units='gN/m^2/yr', & +!!$ avgflag='A', long_name='Total NH4 from manure', & +!!$ ptr_col=this%nh4_manure_total_col) +!!$ +!!$ this%no3_manure_total_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='NO3_MANURE_TOTAL', units='gN/m^2/yr', & +!!$ avgflag='A', long_name='Total NO3 from manure', & +!!$ ptr_col=this%no3_manure_total_col) +!!$ +!!$ this%nh3_fert_total_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='NH3_FERT_TOTAL', units='gN/m^2/yr', & +!!$ avgflag='A', long_name='TOTAL NH3 emission from fertilizer', & +!!$ ptr_col=this%nh3_fert_total_col) +!!$ +!!$ this%ndep_fert_total_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='NDEP_FERT_TOTAL', units='gN/m^2/yr', & +!!$ avgflag='A', long_name='TOTAL N DEP from FERTILIZER', & +!!$ ptr_col=this%ndep_fert_total_col) +!!$ +!!$ this%N_Run_Off_fert_total_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='N_RUN_OFF_FERT_TOTAL', units='gN/m^2/yr', & +!!$ avgflag='A', long_name='Total N run off from fertilizer', & +!!$ ptr_col=this%N_Run_Off_fert_total_col) +!!$ +!!$ this%nh4_fert_total_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='NH4_FERT_TOTAL', units='gN/m^2/yr', & +!!$ avgflag='A', long_name='Total NH4 from fertilizer', & +!!$ ptr_col=this%nh4_fert_total_col) +!!$ +!!$ this%no3_fert_total_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='NO3_FERT_TOTAL', units='gN/m^2/yr', & +!!$ avgflag='A', long_name='Total NO3 from fertilizer', & +!!$ ptr_col=this%no3_fert_total_col) +!!$ +!!$ this%total_nh3_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='TOTAL_NH3', units='gN/m^2/yr', & +!!$ avgflag='A', long_name='TOTAL NH3 emission from Nr', & +!!$ ptr_col=this%total_nh3_col) +!!$ +!!$ this%total_ndep_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='TOTAL_NDEP', units='gN/m^2/yr', & +!!$ avgflag='A', long_name='TOTAL N DEP from Nr', & +!!$ ptr_col=this%total_ndep_col) +!!$ +!!$ this%total_N_Run_Off_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='TOTAL_N_RUN_OFF', units='gN/m^2/yr', & +!!$ avgflag='A', long_name='Total N run off from Nr', & +!!$ ptr_col=this%total_N_Run_Off_col) +!!$ +!!$ this%total_nh4_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='TOTAL_NH4', units='gN/m^2', & +!!$ avgflag='A', long_name='Total NH4 from Nr', & +!!$ ptr_col=this%total_nh4_col) +!!$ +!!$ this%total_no3_col(begc:endc) = spval +!!$ call hist_addfld1d (fname='TOTAL_NO3', units='gN/m^2', & +!!$ avgflag='A', long_name='Total NO3 from Nr', & +!!$ ptr_col=this%total_no3_col) +!!$ +!!$ end if +!!$!KO !JV if (use_fan) then @@ -820,42 +820,43 @@ subroutine InitCold(this, bounds, & this%fan_grz_fract_col(c) = 0.0_r8 this%man_n_stored_col(c) = 0.0_r8 - this%TAN_manu_col(c) = 0._r8 - this%no3_manure_col(c) = 0._r8 - this%manure_u_col(c) = 0._r8 - this%manure_n_col(c) = 0._r8 - this%manure_a_col(c) = 0._r8 - this%manure_r_col(c) = 0._r8 - this%n2o_manure_total_col(c) = 0._r8 - this%nox_manure_total_col(c) = 0._r8 - this%nh3_manure_total_col(c) = 0._r8 - this%N_Run_Off_manure_total_col(c) = 0._r8 - this%no3_manure_total_col(c) = 0._r8 - this%nh4_manure_total_col(c) = 0._r8 - this%ndep_total_col(c) = 0._r8 - this%smin_nh4_monthly_col(c) = 0._r8 - this%smin_no3_monthly_col(c) = 0._r8 - this%TAN_fert_col(c) = 0._r8 - this%no3_fert_col(c) = 0._r8 - this%man_water_pool_col(c) = 0._r8 - this%fert_water_pool_col(c) = 0._r8 - this%ra_col(c) = 0._r8 - this%rb_col(c) = 0._r8 - this%t_a10_col(c) = 0._r8 - this%gdd8_col(c) = 0._r8 - this%t_a10min_col(c) = 0._r8 - this%fert_app_jday_col(c) = 0._r8 - this%fert_u_col(c) = 0._r8 - this%nh3_fert_total_col(c) = 0._r8 - this%no3_fert_total_col(c) = 0._r8 - this%nh4_fert_total_col(c) = 0._r8 - this%ndep_fert_total_col(c) = 0._r8 - this%N_Run_Off_fert_total_col(c) = 0._r8 - this%total_nh3_col(c) = 0._r8 - this%total_N_Run_Off_col(c) = 0._r8 - this%total_no3_col(c) = 0._r8 - this%total_nh4_col(c) = 0._r8 - this%total_ndep_col(c) = 0._r8 +!!$ this%TAN_manu_col(c) = 0._r8 +!!$ this%no3_manure_col(c) = 0._r8 +!!$ this%manure_u_col(c) = 0._r8 +!!$ this%manure_n_col(c) = 0._r8 +!!$ this%manure_a_col(c) = 0._r8 +!!$ this%manure_r_col(c) = 0._r8 +!!$ +!!$ this%n2o_manure_total_col(c) = 0._r8 +!!$ this%nox_manure_total_col(c) = 0._r8 +!!$ this%nh3_manure_total_col(c) = 0._r8 +!!$ this%N_Run_Off_manure_total_col(c) = 0._r8 +!!$ this%no3_manure_total_col(c) = 0._r8 +!!$ this%nh4_manure_total_col(c) = 0._r8 +!!$ this%ndep_total_col(c) = 0._r8 +!!$ this%smin_nh4_monthly_col(c) = 0._r8 +!!$ this%smin_no3_monthly_col(c) = 0._r8 +!!$ this%TAN_fert_col(c) = 0._r8 +!!$ this%no3_fert_col(c) = 0._r8 +!!$ this%man_water_pool_col(c) = 0._r8 +!!$ this%fert_water_pool_col(c) = 0._r8 +!!$ this%ra_col(c) = 0._r8 +!!$ this%rb_col(c) = 0._r8 +!!$ this%t_a10_col(c) = 0._r8 +!!$ this%gdd8_col(c) = 0._r8 +!!$ this%t_a10min_col(c) = 0._r8 +!!$ this%fert_app_jday_col(c) = 0._r8 +!!$ this%fert_u_col(c) = 0._r8 +!!$ this%nh3_fert_total_col(c) = 0._r8 +!!$ this%no3_fert_total_col(c) = 0._r8 +!!$ this%nh4_fert_total_col(c) = 0._r8 +!!$ this%ndep_fert_total_col(c) = 0._r8 +!!$ this%N_Run_Off_fert_total_col(c) = 0._r8 +!!$ this%total_nh3_col(c) = 0._r8 +!!$ this%total_N_Run_Off_col(c) = 0._r8 +!!$ this%total_no3_col(c) = 0._r8 +!!$ this%total_nh4_col(c) = 0._r8 +!!$ this%total_ndep_col(c) = 0._r8 end if !KO @@ -985,19 +986,19 @@ subroutine Restart ( this, bounds, ncid, flag, totvegc_col ) long_name='', units='', & interpinic_flag='interp', readvar=readvar, data=ptr1d) !KO - ! I don't think these have to be on the restart file since they are - ! computed at each time step and it doesn't depend on the previous - ! time step. Plus it should be outside the if/else use_vertsoilc - ! structure (just within the use_nitrif_denitrif structure) - if ( use_fan ) then - call restartvar(ncid=ncid, flag=flag, varname='smin_nh4_monthly', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%smin_nh4_monthly_col) - - call restartvar(ncid=ncid, flag=flag, varname='smin_no3_monthly', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%smin_no3_monthly_col) - end if +!!$ ! I don't think these have to be on the restart file since they are +!!$ ! computed at each time step and it doesn't depend on the previous +!!$ ! time step. Plus it should be outside the if/else use_vertsoilc +!!$ ! structure (just within the use_nitrif_denitrif structure) +!!$ if ( use_fan ) then +!!$ call restartvar(ncid=ncid, flag=flag, varname='smin_nh4_monthly', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%smin_nh4_monthly_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='smin_no3_monthly', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%smin_no3_monthly_col) +!!$ end if !KO end if if (flag=='read' .and. .not. readvar) then @@ -1007,142 +1008,142 @@ subroutine Restart ( this, bounds, ncid, flag, totvegc_col ) !KO if ( use_fan ) then - - call restartvar(ncid=ncid, flag=flag, varname='TAN_manu', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%TAN_manu_col) - - call restartvar(ncid=ncid, flag=flag, varname='TAN_fert', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%TAN_fert_col) - - call restartvar(ncid=ncid, flag=flag, varname='man_water_pool', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%man_water_pool_col) - - call restartvar(ncid=ncid, flag=flag, varname='fert_water_pool', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%fert_water_pool_col) - - call restartvar(ncid=ncid, flag=flag, varname='ra', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%ra_col) - - call restartvar(ncid=ncid, flag=flag, varname='rb', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%rb_col) - - call restartvar(ncid=ncid, flag=flag, varname='gdd8', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%gdd8_col) - - call restartvar(ncid=ncid, flag=flag, varname='t_a10', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%t_a10_col) - - call restartvar(ncid=ncid, flag=flag, varname='t_a10min', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%t_a10min_col) - - call restartvar(ncid=ncid, flag=flag, varname='fert_app_jday', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%fert_app_jday_col) - - call restartvar(ncid=ncid, flag=flag, varname='no3_manure', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%no3_manure_col) - - call restartvar(ncid=ncid, flag=flag, varname='no3_fert', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%no3_fert_col) - - call restartvar(ncid=ncid, flag=flag, varname='n2o_manure_total', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%n2o_manure_total_col) - - call restartvar(ncid=ncid, flag=flag, varname='nox_manure_total', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%nox_manure_total_col) - - call restartvar(ncid=ncid, flag=flag, varname='nh3_manure_total', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%nh3_manure_total_col) - - call restartvar(ncid=ncid, flag=flag, varname='nh3_fert_total', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%nh3_fert_total_col) - - call restartvar(ncid=ncid, flag=flag, varname='total_nh3', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%total_nh3_col) - - call restartvar(ncid=ncid, flag=flag, varname='manure_u', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%manure_u_col) - - call restartvar(ncid=ncid, flag=flag, varname='fert_u', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%fert_u_col) - - call restartvar(ncid=ncid, flag=flag, varname='manure_n', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%manure_n_col) - - call restartvar(ncid=ncid, flag=flag, varname='manure_a', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%manure_a_col) - - call restartvar(ncid=ncid, flag=flag, varname='manure_r', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%manure_r_col) - - call restartvar(ncid=ncid, flag=flag, varname='ndep_total', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%ndep_total_col) - - call restartvar(ncid=ncid, flag=flag, varname='ndep_fert_total', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%ndep_fert_total_col) - - call restartvar(ncid=ncid, flag=flag, varname='total_ndep', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%total_ndep_col) - - call restartvar(ncid=ncid, flag=flag, varname='N_Run_Off_manure_total', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%N_Run_Off_manure_total_col) - - call restartvar(ncid=ncid, flag=flag, varname='N_Run_Off_fert_total', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%N_Run_Off_fert_total_col) - - call restartvar(ncid=ncid, flag=flag, varname='total_N_Run_Off', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%total_N_Run_Off_col) - - call restartvar(ncid=ncid, flag=flag, varname='no3_manure_total', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%no3_manure_total_col) - - call restartvar(ncid=ncid, flag=flag, varname='no3_fert_total', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%no3_fert_total_col) - - call restartvar(ncid=ncid, flag=flag, varname='total_no3', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%total_no3_col) - - call restartvar(ncid=ncid, flag=flag, varname='nh4_manure_total', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%nh4_manure_total_col) - - call restartvar(ncid=ncid, flag=flag, varname='nh4_fert_total', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%nh4_fert_total_col) - - call restartvar(ncid=ncid, flag=flag, varname='total_nh4', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%total_nh4_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='TAN_manu', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%TAN_manu_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='TAN_fert', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%TAN_fert_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='man_water_pool', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%man_water_pool_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='fert_water_pool', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%fert_water_pool_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='ra', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%ra_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='rb', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%rb_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='gdd8', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%gdd8_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='t_a10', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%t_a10_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='t_a10min', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%t_a10min_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='fert_app_jday', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%fert_app_jday_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='no3_manure', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%no3_manure_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='no3_fert', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%no3_fert_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='n2o_manure_total', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%n2o_manure_total_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='nox_manure_total', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%nox_manure_total_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='nh3_manure_total', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%nh3_manure_total_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='nh3_fert_total', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%nh3_fert_total_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='total_nh3', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%total_nh3_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='manure_u', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%manure_u_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='fert_u', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%fert_u_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='manure_n', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%manure_n_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='manure_a', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%manure_a_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='manure_r', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%manure_r_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='ndep_total', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%ndep_total_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='ndep_fert_total', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%ndep_fert_total_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='total_ndep', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%total_ndep_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='N_Run_Off_manure_total', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%N_Run_Off_manure_total_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='N_Run_Off_fert_total', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%N_Run_Off_fert_total_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='total_N_Run_Off', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%total_N_Run_Off_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='no3_manure_total', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%no3_manure_total_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='no3_fert_total', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%no3_fert_total_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='total_no3', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%total_no3_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='nh4_manure_total', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%nh4_manure_total_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='nh4_fert_total', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%nh4_fert_total_col) +!!$ +!!$ call restartvar(ncid=ncid, flag=flag, varname='total_nh4', xtype=ncd_double, & +!!$ dim1name='column', long_name='', units='', & +!!$ interpinic_flag='interp', readvar=readvar, data=this%total_nh4_col) !JV call restartvar(ncid=ncid, flag=flag, varname='tan_g1', xtype=ncd_double, & @@ -1415,57 +1416,57 @@ subroutine SetValues ( this, num_column, filter_column, value_column ) end do !KO - if ( use_fan ) then - do fi = 1,num_column - i = filter_column(fi) - if (use_nitrif_denitrif) then - this%smin_no3_monthly_col(i) = value_column - this%smin_nh4_monthly_col(i) = value_column - end if - end do - end if +!!$ if ( use_fan ) then +!!$ do fi = 1,num_column +!!$ i = filter_column(fi) +!!$ if (use_nitrif_denitrif) then +!!$ this%smin_no3_monthly_col(i) = value_column +!!$ this%smin_nh4_monthly_col(i) = value_column +!!$ end if +!!$ end do +!!$ end if !KO !KO - if ( use_fan ) then - do fi = 1,num_column - i = filter_column(fi) - this%TAN_manu_col(i) = value_column - this%no3_manure_col(i) = value_column - this%manure_u_col(i) = value_column - this%manure_n_col(i) = value_column - this%manure_a_col(i) = value_column - this%manure_r_col(i) = value_column - this%n2o_manure_total_col(i) = value_column - this%nox_manure_total_col(i) = value_column - this%nh3_manure_total_col(i) = value_column - this%N_Run_Off_manure_total_col(i) = value_column - this%nh4_manure_total_col(i) = value_column - this%no3_manure_total_col(i) = value_column - this%ndep_total_col(i) = value_column - this%fert_u_col(i) = value_column - this%no3_fert_col(i) = value_column - this%nh3_fert_total_col(i) = value_column - this%N_Run_Off_fert_total_col(i) = value_column - this%nh4_fert_total_col(i) = value_column - this%no3_fert_total_col(i) = value_column - this%ndep_fert_total_col(i) = value_column - this%total_nh3_col(i) = value_column - this%total_N_Run_Off_col(i) = value_column - this%total_nh4_col(i) = value_column - this%total_no3_col(i) = value_column - this%total_ndep_col(i) = value_column - this%TAN_fert_col(i) = value_column - this%man_water_pool_col(i) = value_column - this%fert_water_pool_col(i) = value_column - this%ra_col(i) = value_column - this%rb_col(i) = value_column - this%gdd8_col(i) = value_column - this%t_a10_col(i) = value_column - this%t_a10min_col(i) = value_column - this%fert_app_jday_col(i) = value_column - end do - end if +!!$ if ( use_fan ) then +!!$ do fi = 1,num_column +!!$ i = filter_column(fi) +!!$ this%TAN_manu_col(i) = value_column +!!$ this%no3_manure_col(i) = value_column +!!$ this%manure_u_col(i) = value_column +!!$ this%manure_n_col(i) = value_column +!!$ this%manure_a_col(i) = value_column +!!$ this%manure_r_col(i) = value_column +!!$ this%n2o_manure_total_col(i) = value_column +!!$ this%nox_manure_total_col(i) = value_column +!!$ this%nh3_manure_total_col(i) = value_column +!!$ this%N_Run_Off_manure_total_col(i) = value_column +!!$ this%nh4_manure_total_col(i) = value_column +!!$ this%no3_manure_total_col(i) = value_column +!!$ this%ndep_total_col(i) = value_column +!!$ this%fert_u_col(i) = value_column +!!$ this%no3_fert_col(i) = value_column +!!$ this%nh3_fert_total_col(i) = value_column +!!$ this%N_Run_Off_fert_total_col(i) = value_column +!!$ this%nh4_fert_total_col(i) = value_column +!!$ this%no3_fert_total_col(i) = value_column +!!$ this%ndep_fert_total_col(i) = value_column +!!$ this%total_nh3_col(i) = value_column +!!$ this%total_N_Run_Off_col(i) = value_column +!!$ this%total_nh4_col(i) = value_column +!!$ this%total_no3_col(i) = value_column +!!$ this%total_ndep_col(i) = value_column +!!$ this%TAN_fert_col(i) = value_column +!!$ this%man_water_pool_col(i) = value_column +!!$ this%fert_water_pool_col(i) = value_column +!!$ this%ra_col(i) = value_column +!!$ this%rb_col(i) = value_column +!!$ this%gdd8_col(i) = value_column +!!$ this%t_a10_col(i) = value_column +!!$ this%t_a10min_col(i) = value_column +!!$ this%fert_app_jday_col(i) = value_column +!!$ end do +!!$ end if !KO do j = 1,nlevdecomp_full @@ -1553,18 +1554,18 @@ subroutine Summary(this, bounds, num_allc, filter_allc) end do end do !KO - if ( use_fan ) then - do fc = 1,num_allc - c = filter_allc(fc) - if (kda == 1 .and. mcsec == 0) then - this%smin_no3_monthly_col(c) = 0._r8 - this%smin_nh4_monthly_col(c) = 0._r8 - endif - - this%smin_no3_monthly_col(c) = this%smin_no3_col(c) - this%smin_nh4_monthly_col(c) = this%smin_nh4_col(c) - end do - end if +!!$ if ( use_fan ) then +!!$ do fc = 1,num_allc +!!$ c = filter_allc(fc) +!!$ if (kda == 1 .and. mcsec == 0) then +!!$ this%smin_no3_monthly_col(c) = 0._r8 +!!$ this%smin_nh4_monthly_col(c) = 0._r8 +!!$ endif +!!$ +!!$ this%smin_no3_monthly_col(c) = this%smin_no3_col(c) +!!$ this%smin_nh4_monthly_col(c) = this%smin_nh4_col(c) +!!$ end do +!!$ end if !KO end if From e9fb31016bdf1e53c505b73336729fb5b33896f3 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Thu, 3 Jan 2019 15:58:07 -0500 Subject: [PATCH 037/181] fertilizer incorporation --- src/biogeochem/CNNDynamicsMod.F90 | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index ff4d5eb865..2df938fa0a 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -184,7 +184,7 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & real(r8), parameter :: dz_layer_fert = 0.02_r8, dz_layer_grz = 0.02_r8 !real(r8), parameter :: fract_resist=0._r8, fract_unavail=0._r8, fract_avail=0._r8, fract_tan=1.0_r8 - + real(r8), parameter :: fert_incorp_reduct = 0.3_r8 real(r8), parameter :: slurry_infiltr_time = 12*3600.0_r8, water_init_fert = 1e-6 real(r8), parameter :: & poolranges_grz(3) = (/24*3600.0_r8, 10*24*3600.0_r8, 360*24*3600.0_r8/), & @@ -194,7 +194,7 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & Hconc_fert(3) = (/10**(-7.0_r8), 10**(-8.5_r8), 10**(-8.0_r8)/) real(r8) :: Hconc_grz(3), Hconc_slr(4), pH_soil, pH_crop - + real(r8) :: fert_inc_tan, fert_inc_no3 !logical, parameter :: do_balance_checks = .false. logical :: do_balance_checks real(r8) :: tg, garbage, theta, thetasat, infiltr_m_s, evap_m_s, runoff_m_s, org_n_tot, & @@ -533,17 +533,28 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & ! Fertilizer ! - fert_total = nf%fert_n_appl_col(c) + ! Fraction available for volatilization + fert_total = nf%fert_n_appl_col(c) * (1.0_r8 - fert_incorp_reduct) + fract_urea = atm2lnd_inst%forc_ndep_urea_grc(g) fract_no3 = atm2lnd_inst%forc_ndep_nitr_grc(g) + ! Fractions made unavailable by mechanical incorporation, will be added to the + ! to-soil flux (tan) or no3 production (no3) below. + fert_inc_tan = nf%fert_n_appl_col(c) * fert_incorp_reduct * (1.0 - fract_no3) + fert_inc_no3 = nf%fert_n_appl_col(c) * fert_incorp_reduct * fract_no3 + if (fract_urea < 0 .or. fract_no3 < 0 .or. fract_urea + fract_no3 > 1) then call endrun('bad fertilizer fractions') end if fert_urea = fert_total * fract_urea - fert_no3 = fert_total * fract_no3 + + ! Include the incorporated NO3 fertilizer to the no3 flux + fert_no3 = fert_total * fract_no3 + fert_inc_no3 + fert_generic = fert_total - fert_urea - fert_no3 + nf%otherfert_n_appl_col(c) = fert_no3 + fert_generic ! Urea decomposition @@ -613,7 +624,7 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & nf%nh3_fert_col(c) = fluxes_tmp(iflx_air) nf%fert_runoff_col(c) = fluxes_tmp(iflx_roff) nf%fert_no3_prod_col(c) = fluxes_tmp(iflx_no3) + fert_no3 - nf%fert_nh4_to_soil_col(c) = fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) + garbage_total/dt + nf%fert_nh4_to_soil_col(c) = fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) + garbage_total/dt + fert_inc_tan ! Total flux ! From 1cc8868cb1137a9567b926630b776b5a87086047 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Thu, 3 Jan 2019 17:18:12 -0500 Subject: [PATCH 038/181] fanmod cleanup --- src/biogeochem/FanMod.F90 | 763 +++----------------------------------- 1 file changed, 54 insertions(+), 709 deletions(-) diff --git a/src/biogeochem/FanMod.F90 b/src/biogeochem/FanMod.F90 index 5220c68239..431bd18317 100755 --- a/src/biogeochem/FanMod.F90 +++ b/src/biogeochem/FanMod.F90 @@ -26,7 +26,6 @@ module FanMod public update_org_n public eval_fluxes_storage public update_npool - public update_3pool public update_4pool public update_urea #endif @@ -100,14 +99,20 @@ function eval_diffusivity_liq_mq(theta, thetasat, tg) result(diff) ! Evaluate the aquous phase diffusivity for TAN in soil according to the Millington & ! Quirk model. implicit none - real(r8), intent(in) :: theta, thetasat, tg + real(r8), intent(in) :: theta ! volumetric water content, m3/m3 + real(r8), intent(in) :: thetasat ! theta at saturation + real(r8), intent(in) :: tg ! soil temperature, K + real(r8) :: diff real(r8) :: kaq_base real(r8), parameter :: pw = 7.0_r8 / 3.0_r8 real(r8), parameter :: gascnst = 8.314, faraday = 96500.0_r8, lp = 73.4_r8, lm_no3 = 71.4_r8, lm_oh=197.6_r8, lm=lm_no3 + ! Base rate by Nernst-Haskell equation, see Poling et al., 2000. The Properties of + ! Gases and Liquids. kaq_base = 1e-4 * (gascnst*tg / (2*faraday**2)) / (1/lp + 1/lm) + !kaq_base = 9.8e-10_r8 * 1.03_r8 ** (Tg-273.0_r8) diff = kaq_base * (theta**pw) / (thetasat**2) @@ -118,24 +123,31 @@ function eval_diffusivity_gas_mq(theta, thetasat, tg) result(diff) ! Evaluate the gas phase diffusivity for NH3 in soil according to the Millington & ! Quirk model. implicit none - real(r8), intent(in) :: theta, thetasat, tg - real(r8) :: diff + real(r8), intent(in) :: theta ! volumetric water content, m3/m3 + real(r8), intent(in) :: thetasat ! theta at saturation + real(r8), intent(in) :: tg ! soil temperature, K + real(r8) :: diff ! diffusivity, m2/s real(r8) :: soilair, dair real(r8), parameter :: pw = 7.0_r8 / 3.0_r8 real(r8), parameter :: mNH3 = 17., mair = 29, vNH3 = 14.9, vair = 20.1, press = 1.0 soilair = thetasat - theta + + ! !dair = 1.7e-5_r8 * 1.03_r8**(Tg-293.0_r8) + !dair = 18e-6_r8 !dair = 1.4e-5 - ! Base rate from Perry's Chemical Engineer's Handbook, 8th ed. + ! Base rate by the Fuller et al. 1966 method. dair = (0.001 * tg**1.75 * sqrt(1/mNH3 + 1/mair)) / (press * (vair**(1./3) * vNH3**(1./3))**2) * 1e-4 diff = dair * (soilair**pw) / (thetasat**2) end function eval_diffusivity_gas_mq + ! The moldrup 2003 are here but not used currently. Check the base rates if use these. + function eval_diffusivity_gas_m03(theta, thetasat, tg, bsw) result(diff) ! Evaluate the gas phase diffusivity for NH3 in soil according to the method of ! Moldrup (2003). @@ -177,154 +189,10 @@ function eval_diffusivity_liq_m03(theta, thetasat, tg, bsw) result(diff) diff = kaq_base * theta**m03_T * (theta/thetasat)**m03_W / theta end function eval_diffusivity_liq_m03 - - - ! The following three subroutines are meant for evaluating the net NH3 flux between soil and atmosphere as - ! - ! F = g * (N - beta * cair) - ! - ! where F is the net upwards flux of NH3, g is a conductance (m/s), cair is the - ! atmospheric concentration of NH3, and beta is a unitless constant. N denotes the TAN - ! concentration in soil in different phases as detailed below. - - subroutine get_volat_coefs_liq(ratm, tg, theta, thetasat, Hconc, depth, conductance, beta) - ! - ! Evaluate the conductance g with N = [NH4+ (aq)] + [NH3 (aq)] in soilwater and - ! assuming that [NH3 (g)] < N in soil. - ! - ! For cair = 0, this subroutine is actually equivalent to get_volat_soil_leachn. - ! - implicit none - real(r8), intent(in) :: ratm ! resistance between the soil surface and bulk atmosphere - real(r8), intent(in) :: tg ! ground temperature - real(r8), intent(in) :: theta ! volumetric water content - real(r8), intent(in) :: thetasat ! volumetric water content at saturation - real(r8), intent(in) :: Hconc ! hydrogen ion concentration, -log10(pH) - real(r8), intent(in) :: depth ! thickenss of the soil layer, m - real(r8), intent(out) :: conductance ! as defined above - real(r8), intent(out) :: beta ! as defined above - - real(r8) :: dz, henry_eff, dsl, dsg, rsl, rsg, grad, cond, air - - dz = 0.5*depth - dsl = eval_diffusivity_liq_mq(theta, thetasat, Tg) - dsg = eval_diffusivity_gas_mq(theta, thetasat, Tg) - - henry_eff = get_henry_eff(Tg, Hconc) - beta = 1/henry_eff - air = thetasat - theta - - rsg = dz / (dsg*air) - rsl = dz / (dsl*theta) - - conductance = henry_eff*(henry_eff*rsl + rsg)/(henry_eff*ratm*rsl + henry_eff*rsg*rsl + ratm*rsg) - - end subroutine get_volat_coefs_liq - - subroutine get_volat_coefs_bulk(ratm, tg, theta, thetasat, Hconc, depth, conductance, beta) - ! - ! Evaluate the conductance g with N = [NH4+ (aq)] + [NH3 (aq)] + [NH3 (g)] measured per volume of soil. - ! - ! More accurate than get_volat_coefs_liq but in practice rarely different because when - ! measured in mass per volume, most of the TAN is normally in soil water. - - implicit none - real(r8), intent(in) :: ratm, tg, theta, thetasat, Hconc, depth - real(r8), intent(out) :: conductance, beta - - real(r8) :: dz, henry_eff, dsl, dsg, rsl, rsg, cond, air - - dz = 0.5*depth - dsl = eval_diffusivity_liq_mq(theta, thetasat, Tg) - dsg = eval_diffusivity_gas_mq(theta, thetasat, Tg) - - henry_eff = get_henry_eff(Tg, Hconc) - beta = (air*henry_eff + theta)/henry_eff - air = thetasat - theta - - rsg = dz / (dsg*air) - rsl = dz / (dsl*theta) - - conductance = henry_eff*(henry_eff*rsl + rsg) & - /(air*henry_eff**2*ratm*rsl + air*henry_eff**2*rsg*rsl + air*henry_eff*ratm*rsg & - + henry_eff*ratm*rsl*theta + henry_eff*rsg*rsl*theta + ratm*rsg*theta) - - end subroutine get_volat_coefs_bulk - - subroutine get_volat_coefs_3p(ratm, tg, theta, thetasat, Hconc, depth, cond, beta) - ! - ! Evaluate the conductance g including absorbed "solid" NH4+, - ! - ! N = [NH3 (aq)] + [NHH4+ (aq)] + [NH3 (g)] + [NH4+ (s)]. - ! - ! The partitioning between absorbed and aquoeous NH4+ is evaluted with a linear isotherm - ! such that [NH4+ (s)] / [NH4+ (aq)] = kxc, where kxc is a constant set below. - ! - implicit none - real(r8), intent(in) :: ratm, tg, theta, thetasat, Hconc, depth - real(r8), intent(out) :: cond, beta - - real(r8) :: dz, henry_eff, dsl, dsg, rsl, rsg, air, solid - real(r8), parameter :: kxc = 0.3_r8 - - dz = 0.5*depth - dsl = eval_diffusivity_liq_mq(theta, thetasat, Tg) - dsg = eval_diffusivity_gas_mq(theta, thetasat, Tg) - - henry_eff = get_henry_eff(Tg, Hconc) - solid = 1 - thetasat - air = thetasat - theta - beta = (air*henry_eff + kxc*solid + theta)/henry_eff - - rsg = dz / (dsg*air) - rsl = dz / (dsl*theta) - - cond = henry_eff*(henry_eff*rsl + rsg) & - / (air*henry_eff**2*ratm*rsl + air*henry_eff**2*rsg*rsl + air*henry_eff*ratm*rsg & - + henry_eff*kxc*solid*ratm*rsl + henry_eff*kxc*solid*rsg*rsl + henry_eff*ratm*rsl*theta & - + henry_eff*rsg*rsl*theta + kxc*solid*ratm*rsg + ratm*rsg*theta) - - end subroutine get_volat_coefs_3p - - function get_volat_soil_leachn(ratm, tg, theta, thetasat, Hconc, depth) result(rate) - ! Evaluate the instanteneous volatilization rate from soil as done in the LEACHN - ! model. Includes gas and aquoues phase diffusion within soil and gas/liquid - ! partitioning. - real(r8), intent(in) :: ratm, tg, theta, thetasat, Hconc, depth - real(r8) :: rate - - real(r8) :: dz, henry_eff, dsl, dsg, dstot, gs, gatm_eff - - dz = 0.5*depth - - henry_eff = get_henry_eff(Tg, Hconc) - gatm_eff = henry_eff / ratm - dsl = eval_diffusivity_liq_mq(theta, thetasat, Tg) - dsg = eval_diffusivity_gas_mq(theta, thetasat, Tg) - dstot = dsl*theta + dsg*henry_eff*(thetasat-theta) - gs = dstot / dz - rate = gs*gatm_eff / (gs + gatm_eff) - - end function get_volat_soil_leachn - - - real(r8) function get_henry_eff(tg, Hconc) result(henry) - ! Evaluate the "effective Henry constant" for ammonia, i.e the ratio - ! H* = [NH3 (g)] / [NH3 (aq) + NH4+ (aq)] - ! given a fixed H+ concentration in the solution. - real(r8), intent(in) :: tg ! soil temperature, K - real(r8), intent(in) :: Hconc ! H+ concentration, mol / l - - real(r8) :: KNH4, KH - real(r8), parameter :: Tref = 298.15_r8 - - KNH4 = 5.67_r8 * 1e-10_r8 * exp(-6286.0_r8 * (1.0_r8/Tg - 1.0_r8/Tref)) - KH = 4.59_r8 * Tg * exp(4092_r8 * (1.0_r8/Tg - 1.0_r8/Tref)) - henry = 1.0_r8 / (1.0_r8 + KH + KH*Hconc/KNH4) - - end function get_henry_eff subroutine partition_tan(tg, Hconc, theta, air, kads, KNH3, fract_nh4) + ! Partition the bulk TAN (NH3 gas/aq + NH4 (aq)) between gas and aqueous. Outputs the + ! volatility (gas/aq ratio), see below. implicit none real(r8), intent(in) :: tg ! soil temperature, K real(r8), intent(in) :: Hconc ! H+ concentration, mol / l @@ -332,7 +200,7 @@ subroutine partition_tan(tg, Hconc, theta, air, kads, KNH3, fract_nh4) real(r8), intent(in) :: air ! air volume fraction real(r8), intent(in) :: kads ! adsorption coefficient, kads = NH4(ads) / NH4(aq) - real(r8), optional, intent(out) :: fract_nh4 ! mass fraction of NH4 + real(r8), optional, intent(out) :: fract_nh4 ! mass fraction of NH4. real(r8), intent(out) :: KNH3 ! volatility, ratio of concentrations [NH3 (gas)] / [NH3+NH4 (aq)] real(r8) :: KNH4, HNH3, cnc_aq, fract_aq @@ -346,71 +214,12 @@ subroutine partition_tan(tg, Hconc, theta, air, kads, KNH3, fract_nh4) fract_aq = theta / (air*KNH3 + theta + kads*(1.0_r8-theta-air)) if (present(fract_nh4)) fract_nh4 = fract_aq * Hconc / (KNH4 + Hconc) + !if (present(fract_nh3g)) fract_nh3g = air * KNH3 / (air*KNH3 + theta) !if (present(fract_nh3aq)) fract_nh3aq = fract_aq * (1.0_r8 - Hconc / (KNH4 + Hconc)) end subroutine partition_tan - real(r8) function get_tan_volat(tg, Hconc) result(ratio) - ! Evaluate the ratio - ! KNH3 = [NH3 (gas)] / [NH3+NH4 (aq)] - ! given a fixed H+ concentration in the solution. Higher ratio means higher - ! volatility (as opposed to usual definition of Henry's law constants as - ! solubilities). This is convenient because then non-volatile substances are obtained - ! by setting KNH3 = 0. - real(r8), intent(in) :: tg ! soil temperature, K - real(r8), intent(in) :: Hconc ! H+ concentration, mol / l - - real(r8) :: KNH4, HNH3 - real(r8), parameter :: Tref = 298.15_r8 - - KNH4 = 5.67_r8 * 1e-10_r8 * exp(-6286.0_r8 * (1.0_r8/Tg - 1.0_r8/Tref)) - ! HNH3 = [aq] / [gas] -- solubility - HNH3 = 4.59_r8 * Tg * exp(4092_r8 * (1.0_r8/Tg - 1.0_r8/Tref)) - - ratio = KNH4 / (HNH3*(KNH4 + Hconc)) - - end function get_tan_volat - - real(r8) function eval_no3prod(theta, Tg, Hconc) result(kNO3) - ! Evaluate nitrification rate as in the Riddick et al. (2016) paper. - real(r8), intent(in) :: theta ! volumetric soil water m/m - real(r8), intent(in) :: Tg ! soil temperature, K - real(r8), intent(in) :: Hconc ! hydrogen ion concentration mol/l - - real(r8) :: KNH4, KH, gas, stf, wmr, smrf, mNH4 - - real(r8), parameter :: soil_dens = 1050.0_r8 ! Soil density, kg/m3 - real(r8), parameter :: water_dens = 1000.0_r8 - real(r8), parameter :: rmax = 1.16e-6_r8 ! Maximum rate of nitrification, s-1 - real(r8), parameter :: tmax = 313.0 ! Maximm temperature of microbial activity, K - real(r8), parameter :: topt = 301.0 ! Optimal temperature of microbial acticity, K - real(r8), parameter :: asg = 2.4_8 ! a_sigma, empirical factor - real(r8), parameter :: wmr_crit = 0.12_r8 ! Critical water content, g/g - real(r8), parameter :: smrf_b = 2 ! Parameter in soil moisture response function - real(r8), parameter :: Tref = 298.15_r8 - - KNH4 = 5.67_r8 * 1e-10_r8 * exp(-6286.0_r8 * (1.0_r8/Tg - 1.0_r8/Tref)) - KH = 4.59_r8 * Tg * exp(4092_r8 * (1.0_r8/Tg - 1.0_r8/Tref)) - gas = 1.0_r8 / (1.0_r8 + KH + KH*Hconc/KNH4) - mNH4 = gas * KH*Hconc/KNH4 - - ! soil temperature function - stf = (max(1e-3_r8, tmax-Tg) / (tmax-topt))**asg * exp(asg * (Tg-topt)/(tmax-topt)) - - ! gravimetric soil water - wmr = theta * water_dens / soil_dens - - ! soil moisture response function - - smrf = 1.0_r8 - exp(-(wmr/wmr_crit)**smrf_b) - !if stf < 1e-9 or smrf < 1e-9: - ! print theta - ! 1/0 - kNO3 = 2.0_r8 * rmax * mNH4 / (1.0_r8/stf + 1.0_r8/smrf) - - end function eval_no3prod - real(r8) function eval_no3prod_v2(theta, theta_sat, Tg) result(kNO3) ! Evaluate nitrification rate as in the Riddick et al. (2016) paper but for NH4. ! Partitioning between TAN forms is not included. @@ -494,8 +303,6 @@ subroutine eval_fluxes_slurry(water, mtan, Hconc, tg, ratm, theta, thetasat, per ! contribution from both pool and the saturated soil. insoil = (halfwater - water(1)) / thetasat inwater = water(1) - !r1 = water(1) / diffusivity_water + insoil / diffusivity_satsoil - else ! pool only inwater = halfwater @@ -506,11 +313,6 @@ subroutine eval_fluxes_slurry(water, mtan, Hconc, tg, ratm, theta, thetasat, per r1 = inwater / diffusivity_water + insoil /diffusivity_satsoil depth_lower = max(soildepth_reservoir, depth_soilsat*1.5) - ! Diffusion to deeper soil over distance dz2 - !dz2 = depth_lower - 0.5*depth_soilsat - - !r2 = (water(1)-inwater) / diffusivity_water + (depth_soilsat-insoil) / diffusivity_satsoil & - ! & + (depth_lower-depth_soilsat) / (eval_diffusivity_liq_m03(theta, thetasat, tg, bsw)*theta) r2 = (water(1)-inwater) / diffusivity_water + (depth_soilsat-insoil) / diffusivity_satsoil & & + (depth_lower-depth_soilsat) / (eval_diffusivity_liq_mq(theta, thetasat, tg)*theta) @@ -535,198 +337,6 @@ subroutine eval_fluxes_slurry(water, mtan, Hconc, tg, ratm, theta, thetasat, per end subroutine eval_fluxes_slurry - subroutine eval_fluxes_soil(mtan, water_manure, Hconc, tg, ratm, theta, thetasat, perc, & - & runoff, cnc_nh3_air, soildepth, fluxes, substance, status) - ! - ! Evaluate nitrogen fluxes from a soil layer. Use for all cases except the partly - ! infiltrated slurry (above). Fluxes can be evaluated either for urea or TAN: for - ! urea, only the aqueous phase fluxes are evaluated and nitrification is set to zero. - ! - implicit none - real(r8), intent(in) :: mtan ! TAN, mass units / m2 - real(r8), intent(in) :: water_manure ! water in the soil pool *in addition to* background soil water - real(r8), intent(out) :: fluxes(5) ! nitrogen fluxes, mass units / m2 / s, see top of module - real(r8), intent(in) :: Hconc ! Hydrogen ion concentration, mol/l - real(r8), intent(in) :: tg ! soil temperature, K - real(r8), intent(in) :: ratm ! atmospheric resistance, s/m - real(r8), intent(in) :: theta ! volumetric soil water in "clean" soil, m/m - real(r8), intent(in) :: thetasat ! volumetric soil water at saturation - real(r8), intent(in) :: perc ! downwards water percolation rate at the bottom of layer, m/s, > 0 - real(r8), intent(in) :: runoff ! runoff water flux, m / s - real(r8), intent(in) :: cnc_nh3_air ! NH3 concentration in air, mass units / m3 - real(r8), intent(in) :: soildepth ! thickness of the volatlization layer - integer, intent(in) :: substance ! subst_tan or subst_urea. - integer, intent(out) :: status ! error flag - - - real(r8) :: water_tot, cnc, air, henry_eff, dsl, dsg, dstot, dz2, no3_rate, volat_rate, theta_tot, beta - - water_tot = water_manure + theta*soildepth - if (water_tot < 1e-9) then - fluxes = 0.0 - return - end if - - theta_tot = water_tot / soildepth - if (theta_tot > thetasat) then - status = err_bad_theta - return - end if - - cnc = mtan / water_tot - - air = thetasat - theta_tot - beta = 0.0 - - if (substance == subst_tan) then - - volat_rate = get_volat_soil_leachn(ratm, tg, water_tot/soildepth, thetasat, Hconc, soildepth) - !fluxes(iflx_air) = max((cnc-cnc_nh3_air) * volat_rate, 0.0_r8) - - !call get_volat_coefs_liq(ratm, tg, water_tot/soildepth, thetasat, Hconc, soildepth, volat_rate, beta) - !fluxes(iflx_air) = volat_rate * (cnc - beta*cnc_nh3_air) - - call get_volat_coefs_bulk(ratm, tg, water_tot/soildepth, thetasat, Hconc, soildepth, volat_rate, beta) - !call get_volat_coefs_3p(ratm, tg, water_tot/soildepth, thetasat, Hconc, soildepth, volat_rate, beta) - fluxes(iflx_air) = volat_rate * (mtan/soildepth - beta*cnc_nh3_air) - - henry_eff = get_henry_eff(tg, Hconc) - dsg = eval_diffusivity_gas_mq(theta_tot, thetasat, tg) - no3_rate = eval_no3prod(theta_tot, tg, Hconc) - else if (substance == subst_urea) then - fluxes(iflx_air) = 0.0_r8 - henry_eff = 0.0_r8 - dsg = 0.0_r8 - no3_rate = 0.0_r8 - else - status = err_bad_subst - return - end if - - ! Downwards diffusion - ! soil diffusivities: liquid, gas, bulk - dsl = eval_diffusivity_liq_mq(theta_tot, thetasat, tg) - dstot = dsl*theta_tot + dsg*henry_eff*air - dz2 = soildepth_reservoir - 0.5 * soildepth - !print *, 'dz2:', dz2 - fluxes(iflx_soild) = cnc * dstot / dz2 - fluxes(iflx_no3) = mtan * no3_rate - fluxes(iflx_soilq) = cnc * perc - fluxes(iflx_roff) = cnc * runoff - - status = 0 - !fluxes(4:) = 0 - - end subroutine eval_fluxes_soil - - subroutine eval_fluxes_soilroff(mtan, water_manure, Hconc, tg, ratm, theta, thetasat, perc, & - & runoff, bsw, soildepth, fluxes, substance, status) - ! - ! Evaluate nitrogen fluxes from a soil layer. Use for all cases except the partly - ! infiltrated slurry (above). Fluxes can be evaluated either for urea or TAN: for - ! urea, only the aqueous phase fluxes are evaluated and nitrification is set to zero. - ! - implicit none - real(r8), intent(in) :: mtan ! TAN, mass units / m2 - real(r8), intent(in) :: water_manure ! water in the soil pool *in addition to* background soil water - real(r8), intent(out) :: fluxes(5) ! nitrogen fluxes, mass units / m2 / s, see top of module - real(r8), intent(in) :: Hconc ! Hydrogen ion concentration, mol/l - real(r8), intent(in) :: tg ! soil temperature, K - real(r8), intent(in) :: ratm ! atmospheric resistance, s/m - real(r8), intent(in) :: theta ! volumetric soil water in "clean" soil, m/m - real(r8), intent(in) :: thetasat ! volumetric soil water at saturation - real(r8), intent(in) :: perc ! downwards water percolation rate at the bottom of layer, m/s, > 0 - real(r8), intent(in) :: runoff ! runoff water flux, m / s - real(r8), intent(in) :: bsw ! - real(r8), intent(in) :: soildepth ! thickness of the volatlization layer - integer, intent(in) :: substance ! subst_tan or subst_urea. - integer, intent(out) :: status ! error flag - - real(r8) :: water_tot, cnc, air, henry_eff, dsl, dsg, dstot, dz2, no3_rate, volat_rate, theta_tot, beta - real(r8) :: cnc_srfg, cnc_srfaq, cnc_soilaq, cnc_soilg, dz, rsl, rsg - real(r8) :: fract_gas, fract_nh3aq, fract_nh4, fract_aq, volatility - - water_tot = water_manure + theta*soildepth - if (water_tot < 1e-9) then - fluxes = 0.0 - return - end if - - theta_tot = water_tot / soildepth - if (theta_tot > thetasat) then - status = err_bad_theta - return - end if - - cnc = mtan / soildepth - air = thetasat - theta_tot - - dz = 0.5*soildepth - !dsl = eval_diffusivity_liq_mq(theta_tot, thetasat, Tg) - !dsg = eval_diffusivity_gas_mq(theta_tot, thetasat, Tg) - - dsl = eval_diffusivity_liq_m03(theta_tot, thetasat, Tg, bsw) - dsg = eval_diffusivity_gas_m03(theta_tot, thetasat, Tg, bsw) - - rsg = dz / (dsg*air) - rsl = dz / (dsl*theta_tot) - - if (substance == subst_tan) then - call partition_tan(tg, Hconc, theta_tot, air, 0.0_r8, volatility, fract_nh4=fract_nh4) - no3_rate = eval_no3prod_v2(theta_tot, thetasat, tg)!*fract_nh4 - else if (substance == subst_urea) then - volatility = 0.0 - no3_rate = 0.0_r8 - else - status = err_bad_subst - return - end if - - call get_srf_cnc(volatility, cnc, 0.0_r8, rsg, rsl, Ratm, runoff, theta_tot, air, cnc_srfg, cnc_srfaq) - - fluxes(iflx_air) = cnc_srfg / ratm - fluxes(iflx_roff) = runoff * cnc_srfaq - - dz2 = soildepth_reservoir - 0.5 * soildepth - cnc_soilaq = cnc / (theta_tot + air*volatility) - cnc_soilg = cnc_soilaq*volatility - - fluxes(iflx_soild) = (cnc_soilaq * dsl * theta_tot) / dz2 + (cnc_soilg * dsg * air) / dz2 - fluxes(iflx_soild) = fluxes(iflx_soild) + mtan / (24*3600.0*365) - fluxes(iflx_no3) = mtan * no3_rate - fluxes(iflx_soilq) = cnc_soilaq * perc - - status = 0 - !fluxes(4:) = 0 - - contains - - subroutine get_srf_cnc(knh3, xs, xag, Rsg, Rsl, Rag, qr, theta, air, cnc_gas, cnc_aq) - real(r8), intent(in) :: knh3 ! volatility - real(r8), intent(in) :: xag ! cnc_atm_gas - real(r8), intent(in) :: qr ! runoff m/s - real(r8), intent(in) :: Rag ! Ratm - real(r8), intent(in) :: xs ! mass / m3 soil - real(r8), intent(in) :: Rsg, Rsl, theta, air - - real(r8), intent(out) :: cnc_gas, cnc_aq - - real(r8) :: x0, x1, x2, x3 - - x0 = Rag*xs - x1 = Rsl*knh3 - x2 = Rsl*theta - x3 = (Rsg*air*x1*xag + Rsg*x0 + Rsg*x2*xag + x0*x1) & - / (Rag*Rsg*(air*knh3 + air*qr*x1 + qr*x2 + theta) & - + knh3*(Rag + Rsg)*(-Rsg*air + air*(Rsg + x1) + x2)) - - cnc_aq = x3 - cnc_gas = knh3*x3 - - end subroutine get_srf_cnc - - end subroutine eval_fluxes_soilroff - subroutine eval_fluxes_soilroff_ads(mtan, water_manure, Hconc, tg, ratm, theta, thetasat, perc, & & runoff, bsw, soildepth, fluxes, substance, status) ! @@ -735,7 +345,7 @@ subroutine eval_fluxes_soilroff_ads(mtan, water_manure, Hconc, tg, ratm, theta, ! urea, only the aqueous phase fluxes are evaluated and nitrification is set to zero. ! implicit none - real(r8), intent(in) :: mtan ! TAN, mass units / m2 + real(r8), intent(in) :: mtan ! TAN (=NH4 (aq) + NH3 (g) + NH3 (aq)), mass units / m2 real(r8), intent(in) :: water_manure ! water in the soil pool *in addition to* background soil water real(r8), intent(out) :: fluxes(5) ! nitrogen fluxes, mass units / m2 / s, see top of module real(r8), intent(in) :: Hconc ! Hydrogen ion concentration, mol/l @@ -745,16 +355,16 @@ subroutine eval_fluxes_soilroff_ads(mtan, water_manure, Hconc, tg, ratm, theta, real(r8), intent(in) :: thetasat ! volumetric soil water at saturation real(r8), intent(in) :: perc ! downwards water percolation rate at the bottom of layer, m/s, > 0 real(r8), intent(in) :: runoff ! runoff water flux, m / s - real(r8), intent(in) :: bsw ! + real(r8), intent(in) :: bsw ! b in the soilwater retention curve; needed if the Moldrup 2003 diffusivities are used. real(r8), intent(in) :: soildepth ! thickness of the volatlization layer integer, intent(in) :: substance ! subst_tan or subst_urea. - integer, intent(out) :: status ! error flag + integer, intent(out) :: status ! error flag real(r8) :: water_tot, cnc, air, henry_eff, dsl, dsg, dstot, dz2, no3_rate, volat_rate, theta_tot, beta real(r8) :: cnc_srfg, cnc_srfaq, cnc_soilaq, cnc_soilg, dz, rsl, rsg real(r8) :: fract_gas, fract_nh3aq, fract_nh4, fract_aq, volatility - real(r8) :: kads + real(r8) :: kads ! distribution coefficient, unitless ((g NH4 adsorbed / m3 soil solid) / (g NH4 dissolved / m3 soil water)) water_tot = water_manure + theta*soildepth if (water_tot < 1e-9) then @@ -775,14 +385,11 @@ subroutine eval_fluxes_soilroff_ads(mtan, water_manure, Hconc, tg, ratm, theta, dsl = eval_diffusivity_liq_mq(theta_tot, thetasat, Tg) dsg = eval_diffusivity_gas_mq(theta_tot, thetasat, Tg) - !dsl = eval_diffusivity_liq_m03(theta_tot, thetasat, Tg, bsw) - !dsg = eval_diffusivity_gas_m03(theta_tot, thetasat, Tg, bsw) - rsg = dz / (dsg*air) rsl = dz / (dsl*theta_tot) if (substance == subst_tan) then - kads = 0.0_r8 + kads = 0.0_r8 ! adsorption currently off. call partition_tan(tg, Hconc, theta_tot, air, kads, volatility, fract_nh4=fract_nh4) no3_rate = eval_no3prod_v2(theta_tot, thetasat, tg) else if (substance == subst_urea) then @@ -809,11 +416,11 @@ subroutine eval_fluxes_soilroff_ads(mtan, water_manure, Hconc, tg, ratm, theta, fluxes(iflx_soilq) = cnc_soilaq * perc status = 0 - !fluxes(4:) = 0 contains subroutine get_srf_cnc(knh3, xs, xag, Rsg, Rsl, Rag, qr, theta, air, cnc_gas, cnc_aq) + ! automatically generated by compost.py real(r8), intent(in) :: knh3 ! volatility real(r8), intent(in) :: xag ! cnc_atm_gas real(r8), intent(in) :: qr ! runoff m/s @@ -840,143 +447,6 @@ end subroutine get_srf_cnc end subroutine eval_fluxes_soilroff_ads - - - subroutine eval_fluxes_soil_3p(mtan, water_manure, Hconc, tg, ratm, theta, thetasat, perc, & - & runoff, cnc_nh3_air, soildepth, fluxes, substance, status) - ! - ! Evaluate nitrogen fluxes from a soil layer. Use for all cases except the partly - ! infiltrated slurry (above). Fluxes can be evaluated either for urea or TAN: for - ! urea, only the aqueous phase fluxes are evaluated and nitrification is set to zero. - ! - implicit none - real(r8), intent(in) :: mtan ! TAN, mass units / m2 - real(r8), intent(in) :: water_manure ! water in the soil pool *in addition to* background soil water - real(r8), intent(out) :: fluxes(5) ! nitrogen fluxes, mass units / m2 / s, see top of module - real(r8), intent(in) :: Hconc ! Hydrogen ion concentration, mol/l - real(r8), intent(in) :: tg ! soil temperature, K - real(r8), intent(in) :: ratm ! atmospheric resistance, s/m - real(r8), intent(in) :: theta ! volumetric soil water in "clean" soil, m/m - real(r8), intent(in) :: thetasat ! volumetric soil water at saturation - real(r8), intent(in) :: perc ! downwards water percolation rate at the bottom of layer, m/s, > 0 - real(r8), intent(in) :: runoff ! runoff water flux, m / s - real(r8), intent(in) :: cnc_nh3_air ! NH3 concentration in air, mass units / m3 - real(r8), intent(in) :: soildepth ! thickness of the volatlization layer - integer, intent(in) :: substance ! subst_tan or subst_urea. - integer, intent(out) :: status ! error flag - - - real(r8) :: water_tot, cnc, air, henry_eff, dsl, dsg, dstot, dz2, no3_rate, volat_rate, theta_tot - real(r8) :: part_liq, part_gas, part_nh4, part_solid, part_avail - - water_tot = water_manure + theta*soildepth - if (water_tot < 1e-9) then - fluxes = 0.0 - return - end if - - theta_tot = water_tot / soildepth - if (theta_tot > thetasat) then - status = err_bad_theta - return - end if - - cnc = mtan / water_tot - - air = thetasat - theta_tot - dz2 = soildepth_reservoir - 0.5 * soildepth - - if (substance == subst_tan) then - call get_fluxes_3p(mtan/soildepth, ratm, theta_tot, thetasat, tg, 0.5*soildepth, dz2, Hconc, & - fluxes(iflx_air), fluxes(iflx_soild), part_liq, part_gas, part_nh4, part_solid) - !print *, 'part:', part_liq, part_gas, part_nh4, part_solid - !volat_rate = get_volat_soil_leachn(ratm, tg, water_tot/soildepth, thetasat, Hconc, soildepth) - !fluxes(iflx_air) = max((cnc-cnc_nh3_air) * volat_rate, 0.0_r8) - - !call get_volat_coefs_liq(ratm, tg, water_tot/soildepth, thetasat, Hconc, soildepth, volat_rate, beta) - !fluxes(iflx_air) = volat_rate * (cnc - beta*cnc_nh3_air) - - !call get_volat_coefs_bulk(ratm, tg, water_tot/soildepth, thetasat, Hconc, soildepth, volat_rate, beta) - !call get_volat_coefs_3p(ratm, tg, water_tot/soildepth, thetasat, Hconc, soildepth, volat_rate, beta) - !fluxes(iflx_air) = volat_rate * (mtan/soildepth - beta*cnc_nh3_air) - part_avail = 1 - part_solid - no3_rate = thetasat * part_avail * eval_no3prod(theta_tot, tg, Hconc) - no3_rate = eval_no3prod(theta_tot, tg, Hconc) - fluxes(iflx_no3) = no3_rate * mtan! * ( 1 - part_solid * (1-thetasat)) - cnc = mtan / soildepth * part_liq - else if (substance == subst_urea) then - fluxes(iflx_air) = 0.0_r8 - henry_eff = 0.0_r8 - dsg = 0.0_r8 - no3_rate = 0.0_r8 - part_avail = 1.0_r8 - dsl = eval_diffusivity_liq_mq(theta_tot, thetasat, tg) - dstot = dsl*theta_tot + dsg*henry_eff*air - fluxes(iflx_soild) = cnc * dstot / dz2 - fluxes(iflx_no3) = 0.0 - else - status = err_bad_subst - return - end if - - ! Downwards diffusion - ! soil diffusivities: liquid, gas, bulk - - !print *, 'dz2:', dz2 - fluxes(iflx_soilq) = cnc * perc - fluxes(iflx_roff) = cnc * runoff - - status = 0 - !fluxes(4:) = 0 - - contains - - subroutine get_fluxes_3p(tan_soil, ratm, theta, thetasat, tg, dzup, dzdown, Hconc, & - flux_atm, flux_soild, part_soil_liq, part_soil_gas, part_soil_nh4, part_soil_solid) - real(r8), intent(in) :: tan_soil, ratm, theta, thetasat, tg, dzup, dzdown, Hconc - real(r8), intent(out) :: flux_atm, flux_soild, part_soil_liq, part_soil_gas, part_soil_nh4, part_soil_solid - - real(r8) :: rsl, rsg, knh4, kh, air, solid, comp - real(r8), parameter :: Tref = 298.15_r8 - real(r8), parameter :: kx = 1.0 - - KNH4 = 5.67_r8 * 1e-10_r8 * exp(-6286.0_r8 * (1.0_r8/Tg - 1.0_r8/Tref)) - KH = 4.59_r8 * Tg * exp(4092_r8 * (1.0_r8/Tg - 1.0_r8/Tref)) - - air = thetasat - theta - solid = 1 - thetasat - - rsl = dzup / (theta * eval_diffusivity_liq_mq(theta, thetasat, tg)) - rsg = dzup / (air * eval_diffusivity_gas_mq(theta, thetasat, tg)) - - comp = knh4*(cnc_nh3_air*rsg*rsl*(Hconc*kh*kx*solid + Hconc*kh*theta + & - air*knh4 + kh*knh4*theta) + ratm*tan_soil*(Hconc*kh*rsg + kh*knh4*rsg + & - knh4*rsl))/(Hconc**2*kh**2*kx*ratm*rsg*solid + Hconc**2*kh**2*ratm*rsg*theta + & - Hconc*air*kh*knh4*ratm*rsg + Hconc*kh**2*knh4*kx*ratm*rsg*solid + & - 2*Hconc*kh**2*knh4*ratm*rsg*theta + Hconc*kh*knh4*kx*rsl*solid*(ratm + rsg) + & - Hconc*kh*knh4*rsl*theta*(ratm + rsg) + air*kh*knh4**2*ratm*rsg + & - air*knh4**2*rsl*(ratm + rsg) + kh**2*knh4**2*ratm*rsg*theta + & - kh*knh4**2*rsl*theta*(ratm + rsg)) - - flux_atm = comp / ratm - - part_soil_liq = kh*(Hconc + knh4)/(Hconc*kh*kx*solid + Hconc*kh*theta + air*knh4 + kh*knh4*theta) - part_soil_nh4 = Hconc*kh/(Hconc*kh*kx*solid + Hconc*kh*theta + air*knh4 + kh*knh4*theta) - part_soil_gas = knh4/(Hconc*kh*kx*solid + Hconc*kh*theta + air*knh4 + kh*knh4*theta) - part_soil_solid = Hconc*kh*kx/(Hconc*kh*kx*solid + Hconc*kh*theta + air*knh4 + kh*knh4*theta) - !flux_soild = & - ! tan_soil*(kh*rsg*(Hconc + knh4) + knh4*rsl)& - ! /(rsg*rsl*(Hconc*kh*kx*solid + H*kh*theta + epsilon*knh4 + kh*knh4*theta)) - - rsl = dzdown / (theta * eval_diffusivity_liq_mq(theta, thetasat, tg)) - rsg = dzdown / (air * eval_diffusivity_gas_mq(theta, thetasat, tg)) - - flux_soild = tan_soil * part_soil_liq / rsl + tan_soil * part_soil_gas / rsg - - end subroutine get_fluxes_3p - - end subroutine eval_fluxes_soil_3p - subroutine partition_to_layer(water, theta, thetasat, soildepth, fraction_in, fraction_down, fraction_runoff) ! Evaluate the fraction of water volume that can be accommodated (before saturation) ! by soil layer with current water content theta. @@ -1052,125 +522,11 @@ subroutine age_pools_slurry(ndep, dt, water_slurry, tan_slurry, tan_soil, pools, end subroutine age_pools_slurry - subroutine update_3pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend, runoff, tandep, tanprod, cnc_nh3_air, & - depth_slurry, poolranges, tanpools, fluxes, garbage, dt, status) - ! - ! Evalute fluxes and update TAN pools for the 3-pool slurry model with a partly - ! infiltrated, freshly infiltrated and aged TAN pools. - ! - implicit none - real(r8), intent(in) :: tg ! soil temperature, K - real(r8), intent(in) :: ratm ! atmospheric resistance, s/m - real(r8), intent(in) :: theta ! volumetric soil water in soil column (unaffected by slurry) - real(r8), intent(in) :: thetasat ! vol. soil water at saturation - real(r8), intent(in) :: precip ! precipitation, m/s - real(r8), intent(in) :: evap ! ground evaporation, m/s - real(r8), intent(in) :: qbot ! specific humidity (kg/kg) at lowest atmospheric model level - real(r8), intent(in) :: watertend ! time derivative of theta - real(r8), intent(in) :: runoff ! surface runoff flux, m/s - real(r8), intent(in) :: tandep ! TAN input flux, gN/m2/s - real(r8), intent(in) :: tanprod ! TAN produced in the column, added to aged TAN pool - !real(r8), intent(in) :: infiltr_slurry ! Slurry infiltration rate, m/s - real(r8), intent(in) :: depth_slurry ! Initial slurry depth, m - real(r8), intent(in) :: cnc_nh3_air ! NH3 concentration in air, gN/m3 - real(r8), intent(in) :: poolranges(3) ! age ranges of TAN pools S0, S1, S2, sec. Slurry infiltration time is inferred from S0. - real(r8), intent(inout) :: tanpools(3) ! TAN pools gN/m2 - real(r8), intent(out) :: fluxes(5,3) ! TAN fluxes, gN/m2/s (type of flux, pool) - real(r8), intent(out) :: garbage ! over-aged TAN occurring during the step, gN/m. - real(r8), intent(in) :: dt ! timestep, sec, >0 - integer, intent(out) :: status ! return status, 0 = good - - real(r8) :: infiltr_slurry, infiltrated, percolated, evap_slurry, water_slurry(2), perc_slurry_mean, waterloss - real(r8) :: percolation, water_soil, age_prev, water_in_layer, tanpools_old(3) - integer :: indpl - - real(r8), parameter :: dz_layer = 0.02 ! thickness of the volatilization layer, m - ! H+ concentration in each pool - real(r8), parameter :: Hconc(3) = (/10.0_r8**(-8.0_r8), 10.0_r8**(-8.0_r8), 10.0_r8**(-8.0_r8)/) - - if (theta > thetasat) then - status = err_bad_theta - return - end if - - tanpools_old = tanpools - - ! Pool S0 - ! - evap_slurry = get_evap_pool(tg, ratm, qbot) - infiltr_slurry = max(depth_slurry / poolranges(1), precip) - infiltrated = depth_slurry * infiltr_slurry / (infiltr_slurry + evap_slurry) - ! Slurry water (in addition to soil water, theta) on surface and in soil. Represents - ! mean over pool S0. - water_slurry = (/0.5*depth_slurry, 0.5*infiltrated/) - ! The excess water assumed to have percolated down from the volat. layer. - percolated = max(infiltrated - dz_layer*(thetasat-theta), 0.0) - ! Percolation rate out of volat layer, average over the pool S0. - perc_slurry_mean = percolated / poolranges(1) - - call eval_fluxes_slurry(water_slurry, tanpools(1), Hconc(1), tg, ratm, theta, thetasat, perc_slurry_mean, & - runoff, cnc_nh3_air, fluxes(:,1)) - - if (any(isnan(fluxes))) then - status = err_nan * 10 - end if - - call update_pools(tanpools(1:1), fluxes(1:5,1:1), dt, 1, 5) - - if (any(tanpools < -1e-15)) then - status = err_negative_tan - return - end if - - ! Pool aging & input - ! - call age_pools_slurry(tandep, dt, water_slurry, tanpools(1), tanpools(2:3), poolranges, garbage) - ! TAN produced (mineralization) goes to directly the old TAN pool. - tanpools(3) = tanpools(3) + tanprod*dt - - ! Soil bins S1 and S2 - ! - age_prev = 0 ! for water evaluations, consider beginning of S1 as the starting point - water_in_layer = infiltrated - percolated ! water in layer just after slurry has infiltrated - do indpl = 2, 3 - ! water content lost during the aging - waterloss = water_in_layer * (waterfunction(age_prev) - waterfunction(age_prev+poolranges(indpl))) - percolation = eval_perc(waterloss, evap, precip, watertend, poolranges(indpl)) - ! water content at the mean age of the pool - water_soil = water_in_layer * waterfunction(age_prev + 0.5*poolranges(indpl)) - call eval_fluxes_soil(tanpools(indpl), water_soil, Hconc(indpl), tg, & - & ratm, theta, thetasat, percolation, runoff, cnc_nh3_air, & - & dz_layer, fluxes(:,indpl), subst_tan, status) - if (status /= 0) return - age_prev = age_prev + poolranges(indpl) - end do - - call update_pools(tanpools(2:3), fluxes(1:5,2:3), dt, 2, 5) - - if (any(tanpools < -1e-15)) then - status = err_negative_tan * 10 - return - !end if - end if - - if (any(isnan(fluxes))) then - status = err_nan * 100 - end if - - if (abs(sum(tanpools - tanpools_old) - (-sum(fluxes) + tandep + tanprod)*dt + garbage) & - > max(sum(tanpools_old)*1e-2, 1e-4)) then - status = err_balance_tan - return - end if - - status = 0 - - end subroutine update_3pool - subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend, runoff, tandep, tanprod, bsw, & depth_slurry, poolranges, tanpools, Hconc, fluxes, garbage, dt, status) ! - ! Experimental, as above but with an additional long-lived TAN pool. + ! Evaluate fluxes and integrate states for a 4-stage slurry model with first pool + ! representing uninfiltrated slurry. ! implicit none real(r8), intent(in) :: tg ! soil temperature, K @@ -1229,8 +585,7 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend if (any(isnan(fluxes))) then status = err_nan * 10 end if - - !tanpools(1) = tanpools(1) - sum(fluxes(:,1)) * dt + call update_pools(tanpools(1:1), fluxes(1:5,1:1), dt, 1, 5) if (any(tanpools < -1e-15)) then @@ -1252,15 +607,9 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend ! water content lost during the aging waterloss = water_in_layer * (waterfunction(age_prev) - waterfunction(age_prev+poolranges(indpl))) percolation = eval_perc(waterloss, evap, precip, watertend, poolranges(indpl)) - !print *, water_in_layer*waterfunction(age_prev), water_in_layer*waterfunction(age_prev+poolranges(indpl)) + ! water content at the mean age of the pool water_soil = water_in_layer * waterfunction(age_prev + 0.5*poolranges(indpl)) - !print *, tanpools(indpl), water_soil, Hconc(indpl), tg, & - ! & ratm, theta, thetasat, percolation, runoff, cnc_nh3_air, & - ! & dz_layer - !call eval_fluxes_soil(tanpools(indpl), water_soil, Hconc(indpl), tg, & - ! & ratm, theta, thetasat, percolation, runoff, cnc_nh3_air, & - ! & dz_layer, fluxes(:,indpl), subst_tan, status) call eval_fluxes_soilroff_ads(tanpools(indpl), water_soil, Hconc(indpl), tg, & & ratm, theta, thetasat, percolation, runoff, bsw, & & dz_layer, fluxes(:,indpl), subst_tan, status) @@ -1284,12 +633,9 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend end if if (abs(sum(tanpools - tanpools_old) - (-sum(fluxes) + tandep + tanprod)*dt + garbage) > max(sum(tanpools_old)*1e-2, 1e-4)) then - !print *, sum(tanpools_old), sum(tanpools), sum(tanpools - tanpools_old) - !print *, sum(fluxes), tandep*dt, tanprod*dt status = err_balance_tan return end if - !print *, sum(tanpools), sum(tanpools - tanpools_old) !+ garbage status = 0 @@ -1298,8 +644,8 @@ end subroutine update_4pool subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend, runoff, tandep, tanprod, & water_init, bsw, poolranges, Hconc, dz_layer, tanpools, fluxes, garbage, dt, status, numpools) ! - ! Evaluate fluxes and update TAN pools for a model with arbitrary number of pools - ! divided by age and pH. + ! Evaluate fluxes and update soil TAN pools for a model with arbitrary number of pools + ! divided by age and pH. For slurry use update_4pool. ! implicit none real(r8), intent(in) :: tg ! soil temperature, K @@ -1336,7 +682,6 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend tanpools_old = tanpools if (theta > thetasat) then - !print *, 'bad theta update_npool 1', theta, thetasat status = err_bad_theta return end if @@ -1395,8 +740,6 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend percolation = eval_perc(waterloss, evap, precip, watertend, poolranges(indpl)) ! water content at the middle of the age range water_soil = water_into_layer * waterfunction(age_prev + 0.5*poolranges(indpl)) - !call eval_fluxes_soil(tanpools(indpl), water_soil, Hconc(indpl), tg, & - !call eval_fluxes_soil_3p(tanpools(indpl), water_soil, Hconc(indpl), tg, & call eval_fluxes_soilroff_ads(tanpools(indpl), water_soil, Hconc(indpl), tg, & & ratm, theta, thetasat, percolation, runoff, bsw, & & dz_layer, fluxes(:,indpl), subst_tan, status) @@ -1449,7 +792,7 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend end subroutine update_npool subroutine update_pools(tanpools, fluxes, dt, np, nf, fixed) - ! Update tan pools using the fluxes and an ad-hoc scheme agains negative TAN masses. + ! Update tan pools using the fluxes and an ad-hoc scheme against negative TAN masses. implicit none real(r8), intent(inout) :: tanpools(np), fluxes(nf,np) real(r8), intent(in) :: dt @@ -1502,6 +845,9 @@ function get_evap_pool(tg, ratm, qbot) result(evap) end function get_evap_pool + ! Waterfunction gives the relaxation of the moisture perturbation normalized between 0 + ! and 1. Either exponential or step. + function waterfunction_exp(pool_age) result(water) implicit none real(r8), intent(in) :: pool_age ! sec @@ -1524,7 +870,6 @@ function waterfunction(pool_age) result(water) end function waterfunction function eval_perc(waterloss, evap, precip, watertend, dt) result(rate) - ! ! Evaluate the downwards water flux at the layer bottom given the infiltration and ! evaporation fluxes. implicit none @@ -1556,11 +901,13 @@ subroutine eval_fluxes_storage(nitr_input, tempr_outside, windspeed, fract_direc real(r8), intent(in) :: nitr_input ! total nitrogen excreted by animals in housings real(r8), intent(in) :: tempr_outside ! K real(r8), intent(in) :: windspeed ! m/s - real(r8), intent(in) :: fract_direct - real(r8), intent(in) :: volat_coef_barns, volat_coef_stores + real(r8), intent(in) :: fract_direct ! fraction of manure N applied before storage + real(r8), intent(in) :: volat_coef_barns, volat_coef_stores ! normalization coefficients, unitless real(r8), intent(in) :: tan_fract_excr ! fraction of NH4 nitrogen in excreted N - real(r8), intent(out) :: fluxes_nitr(4), fluxes_tan(4) - integer, intent(out) :: status + real(r8), intent(out) :: fluxes_nitr(4), fluxes_tan(4) ! nitrogen and TAN fluxes, gN/s + ! (/m2). See top of module for + ! indices. + integer, intent(out) :: status ! see top of the module. ! parameters for the Gyldenkaerne et al. parameterization real(r8), parameter :: Tfloor_barns = 4.0_8, Tfloor_stores = 1.0_8 @@ -1627,7 +974,6 @@ subroutine eval_fluxes_storage(nitr_input, tempr_outside, windspeed, fract_direc flux_avail = flux_avail - flux_store flux_avail_tan = flux_avail_tan - flux_store if (flux_avail < 0) then - !print *, 'stores' status = err_negative_flux return end if @@ -1636,7 +982,6 @@ subroutine eval_fluxes_storage(nitr_input, tempr_outside, windspeed, fract_direc fluxes_tan(iflx_to_store) = flux_avail_tan if (abs(sum(fluxes_nitr) - nitr_input) > 1e-5*nitr_input) then - !print *, fluxes_nitr, sum(fluxes_nitr), nitr_input status = err_balance_nitr return end if @@ -1647,7 +992,6 @@ subroutine eval_fluxes_storage(nitr_input, tempr_outside, windspeed, fract_direc end if if (any(fluxes_nitr < 0) .or. any(fluxes_tan < 0)) then - !print *, 'final' status = err_negative_flux return end if @@ -1679,7 +1023,8 @@ subroutine update_org_n(flux_input, tg, soilpsi, pools, dt, tanprod, soilflux) real(r8) :: soilfluxes(3) TR = tr1 * exp(tr2 * (tg-273.15_r8)) - + + ! The moisture scaling taken from CLM5 litter decomposition scheme: psi = min(soilpsi, maxpsi) ! decomp only if soilpsi is higher than minpsi if (psi > minpsi) then @@ -1712,17 +1057,17 @@ subroutine update_urea(tg, theta, thetasat, precip, evap, watertend, runoff, & real(r8), intent(in) :: evap ! ground evaporation, m/s real(r8), intent(in) :: watertend ! time derivative of theta*dz real(r8), intent(in) :: runoff ! surface runoff flux, m/s - real(r8), intent(in) :: ndep - real(r8), intent(in) :: bsw - real(r8), intent(inout) :: pools(numpools) + real(r8), intent(in) :: ndep ! nitrogen input, mass unit / s + real(r8), intent(in) :: bsw ! b in the soil water retention curve + real(r8), intent(inout) :: pools(numpools) ! nitrogen pools mass / m2 real(r8), intent(out) :: fluxes(6, numpools) ! one extra for the to_tan flux - real(r8), intent(in) :: ranges(numpools) - real(r8), intent(out) :: garbage - real(r8), intent(in) :: dt - integer, intent(out) :: status - integer, intent(in) :: numpools + real(r8), intent(in) :: ranges(numpools) ! pool age extents, s + real(r8), intent(out) :: garbage ! nitrogen in patches aged beyond the oldest pool. mass / m2 + real(r8), intent(in) :: dt ! time step, s + integer, intent(out) :: status ! see top of module + integer, intent(in) :: numpools - real(r8), parameter :: rate = 4.83e-6 ! 1/s + real(r8), parameter :: rate = 4.83e-6 ! urea decomposition, 1/s real(r8), parameter :: missing = 1e36 ! for the parameters not needed for urea fluxes real(r8), parameter :: dz_layer = 0.02 ! thickness of the volatilization layer, m From 940eb895821c2370769b488664444aa44b6c7c48 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Fri, 4 Jan 2019 16:10:03 -0500 Subject: [PATCH 039/181] bug fix --- src/biogeochem/FanMod.F90 | 34 ++++++++++++++++++---------------- 1 file changed, 18 insertions(+), 16 deletions(-) diff --git a/src/biogeochem/FanMod.F90 b/src/biogeochem/FanMod.F90 index 431bd18317..6c90002ef3 100755 --- a/src/biogeochem/FanMod.F90 +++ b/src/biogeochem/FanMod.F90 @@ -277,7 +277,7 @@ subroutine eval_fluxes_slurry(water, mtan, Hconc, tg, ratm, theta, thetasat, per !real(r8), intent(in) :: dt ! timestep real(r8) :: water_tot, cnc, air, depth_soilsat, diffusivity_water, diffusivity_satsoil, halfwater, insoil, r1, dz2, inwater - real(r8) :: r2, volat_rate, kno3, henry_eff, depth_lower, fract_nh4 + real(r8) :: r2, volat_rate, kno3, knh3, depth_lower, fract_nh4, r2a, r2b, g3 water_tot = water(1) + water(2) @@ -314,20 +314,23 @@ subroutine eval_fluxes_slurry(water, mtan, Hconc, tg, ratm, theta, thetasat, per depth_lower = max(soildepth_reservoir, depth_soilsat*1.5) - r2 = (water(1)-inwater) / diffusivity_water + (depth_soilsat-insoil) / diffusivity_satsoil & - & + (depth_lower-depth_soilsat) / (eval_diffusivity_liq_mq(theta, thetasat, tg)*theta) - - - !dz2 = depth_lower - insoil - - !r2 = 0.5 * depth_soilsat/diffusivity_satsoil + dz2 / (eval_diffusivity_liq_mq(theta, thetasat, tg)*theta) - !print *, 'r2', r2, diffusivity_satsoil, dz2, depth_soilsat + call partition_tan(tg, Hconc, 1.0_r8, 0.0_r8, 0.0_r8, knh3, fract_nh4=fract_nh4) + volat_rate = 1.0_r8 / (r1 + ratm / knh3) ! conductance from aqueous TAN in slurry to NH3 in atmosphere + fluxes(iflx_air) = volat_rate*cnc + + ! lower soil resistance consists of liquid diffusion slurry, in saturated layer, and + ! parallel liquid/gas diffusion below the saturated layer. + r2a = (water(1)-inwater) / diffusivity_water + r2b = (depth_soilsat-insoil) / diffusivity_satsoil + dz2 = depth_lower-depth_soilsat + ! conductance = inverse resistance + g3 = (eval_diffusivity_liq_mq(theta, thetasat, tg)*theta & + + knh3*eval_diffusivity_gas_mq(theta, thetasat, tg)*(thetasat-theta)) & + / dz2 + r2 = r2a + r2b + 1.0/g3 + fluxes(iflx_soild) = cnc / r2 - !henry_eff = get_henry_eff(tg, Hconc) - call partition_tan(tg, Hconc, 1.0_r8, 0.0_r8, 0.0_r8, henry_eff, fract_nh4=fract_nh4) - volat_rate = 1.0_r8 / (r1 + ratm / henry_eff) ! conductance from aqueous TAN in slurry to NH3 in atmosphere - fluxes(iflx_air) = volat_rate*cnc ! nitrification kno3 = eval_no3prod_v2(thetasat, thetasat, tg) @@ -1081,9 +1084,8 @@ subroutine update_urea(tg, theta, thetasat, precip, evap, watertend, runoff, & age_prev = 0 do indpl = 1, numpools percolation = eval_perc(0.0_r8, evap, precip, watertend, ranges(indpl)) - ! in the following, atmospheric concentration should be 0 not missing! - call eval_fluxes_soilroff(pools(indpl), 0.0_r8, missing, tg, & - !call eval_fluxes_soil(pools(indpl), 0.0_r8, missing, tg, & + ! Hconc and Ratm are missing since they do not affect urea. + call eval_fluxes_soilroff_ads(pools(indpl), 0.0_r8, missing, tg, & & missing, theta, thetasat, percolation, runoff, bsw, & & dz_layer, fluxes(1:5,indpl), subst_urea, status) if (status /= 0) then From 6216a136073162560ac51aca47a721dfdb2f25c1 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Fri, 4 Jan 2019 16:11:27 -0500 Subject: [PATCH 040/181] bug fix 2 --- src/biogeochem/CNNDynamicsMod.F90 | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index 2df938fa0a..4678471c11 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -534,28 +534,29 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & ! ! Fraction available for volatilization - fert_total = nf%fert_n_appl_col(c) * (1.0_r8 - fert_incorp_reduct) + fert_total = nf%fert_n_appl_col(c) fract_urea = atm2lnd_inst%forc_ndep_urea_grc(g) fract_no3 = atm2lnd_inst%forc_ndep_nitr_grc(g) ! Fractions made unavailable by mechanical incorporation, will be added to the ! to-soil flux (tan) or no3 production (no3) below. - fert_inc_tan = nf%fert_n_appl_col(c) * fert_incorp_reduct * (1.0 - fract_no3) - fert_inc_no3 = nf%fert_n_appl_col(c) * fert_incorp_reduct * fract_no3 + fert_inc_tan = fert_total * fert_incorp_reduct * (1.0 - fract_no3) + fert_inc_no3 = fert_total * fert_incorp_reduct * fract_no3 if (fract_urea < 0 .or. fract_no3 < 0 .or. fract_urea + fract_no3 > 1) then call endrun('bad fertilizer fractions') end if - fert_urea = fert_total * fract_urea + fert_urea = fert_total * fract_urea * (1.0_r8 - fert_incorp_reduct) ! Include the incorporated NO3 fertilizer to the no3 flux - fert_no3 = fert_total * fract_no3 + fert_inc_no3 + fert_no3 = fert_total * fract_no3 - fert_generic = fert_total - fert_urea - fert_no3 + !fert_generic = (fert_total - fert_urea - fert_no3) * (1.0_r8 - fert_incorp_reduct) + fert_generic = fert_total * (1.0_r8 - fract_urea - fract_no3) * (1.0_r8 - fert_incorp_reduct) - nf%otherfert_n_appl_col(c) = fert_no3 + fert_generic + nf%otherfert_n_appl_col(c) = fert_total * (1.0_r8 - fract_urea) !fert_no3 + fert_generic ! Urea decomposition ! From 53b8a83765450233dac7379ee28a94caacd6f6db Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Fri, 4 Jan 2019 16:20:53 -0500 Subject: [PATCH 041/181] comments --- src/biogeochem/FanMod.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/biogeochem/FanMod.F90 b/src/biogeochem/FanMod.F90 index 6c90002ef3..f44e896614 100755 --- a/src/biogeochem/FanMod.F90 +++ b/src/biogeochem/FanMod.F90 @@ -112,7 +112,8 @@ function eval_diffusivity_liq_mq(theta, thetasat, tg) result(diff) ! Base rate by Nernst-Haskell equation, see Poling et al., 2000. The Properties of ! Gases and Liquids. kaq_base = 1e-4 * (gascnst*tg / (2*faraday**2)) / (1/lp + 1/lm) - + + ! Van Der Molen 1990 fit of the base rate. !kaq_base = 9.8e-10_r8 * 1.03_r8 ** (Tg-273.0_r8) diff = kaq_base * (theta**pw) / (thetasat**2) @@ -134,13 +135,13 @@ function eval_diffusivity_gas_mq(theta, thetasat, tg) result(diff) soilair = thetasat - theta - ! + ! Van Der Molen 1990 fit of the base rate. !dair = 1.7e-5_r8 * 1.03_r8**(Tg-293.0_r8) !dair = 18e-6_r8 !dair = 1.4e-5 - ! Base rate by the Fuller et al. 1966 method. + ! Base rate from the Fuller et al. 1966 method. dair = (0.001 * tg**1.75 * sqrt(1/mNH3 + 1/mair)) / (press * (vair**(1./3) * vNH3**(1./3))**2) * 1e-4 diff = dair * (soilair**pw) / (thetasat**2) From a3a0e5f3929dedd26c210c940f18d0334bf12410 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Thu, 10 Jan 2019 17:35:07 -0500 Subject: [PATCH 042/181] kads for slurry --- src/biogeochem/FanMod.F90 | 45 ++++++++++++++++++++++++++------------- 1 file changed, 30 insertions(+), 15 deletions(-) diff --git a/src/biogeochem/FanMod.F90 b/src/biogeochem/FanMod.F90 index f44e896614..e7c3e49b42 100755 --- a/src/biogeochem/FanMod.F90 +++ b/src/biogeochem/FanMod.F90 @@ -259,7 +259,7 @@ real(r8) function eval_no3prod_v2(theta, theta_sat, Tg) result(kNO3) end function eval_no3prod_v2 - subroutine eval_fluxes_slurry(water, mtan, Hconc, tg, ratm, theta, thetasat, perc, runoff, bsw, fluxes) + subroutine eval_fluxes_slurry(water, mtan, Hconc, tg, ratm, theta, thetasat, perc, runoff, bsw, kads, fluxes) ! Evaluate nitrogen fluxes for a partly infiltrated layer of slurry. ! The state of infiltration is detemined from the amounts water on surface and in soil. ! Positive flux means loss of TAN. @@ -275,10 +275,12 @@ subroutine eval_fluxes_slurry(water, mtan, Hconc, tg, ratm, theta, thetasat, per real(r8), intent(in) :: perc ! percolation water flux thourgh the bottom of volatilization layer, m/s real(r8), intent(in) :: runoff ! surface runoff, m/s real(r8), intent(in) :: bsw + real(r8), intent(in) :: kads ! dimensionless distribution coefficient, kads = [TAN (s)] / [TAN (aq)] !real(r8), intent(in) :: dt ! timestep real(r8) :: water_tot, cnc, air, depth_soilsat, diffusivity_water, diffusivity_satsoil, halfwater, insoil, r1, dz2, inwater - real(r8) :: r2, volat_rate, kno3, knh3, depth_lower, fract_nh4, r2a, r2b, g3 + real(r8) :: r2, volat_rate, kno3, knh3, depth_lower, fract_nh4, r2a, r2b, g3, gdown, rsld, rkl, rkg + water_tot = water(1) + water(2) @@ -316,7 +318,10 @@ subroutine eval_fluxes_slurry(water, mtan, Hconc, tg, ratm, theta, thetasat, per depth_lower = max(soildepth_reservoir, depth_soilsat*1.5) call partition_tan(tg, Hconc, 1.0_r8, 0.0_r8, 0.0_r8, knh3, fract_nh4=fract_nh4) - volat_rate = 1.0_r8 / (r1 + ratm / knh3) ! conductance from aqueous TAN in slurry to NH3 in atmosphere + volat_rate = & + knh3/(-ratm*kads*theta + ratm*kads + ratm*thetasat - r1*kads*knh3*theta + r1*kads*knh3 + r1*knh3*thetasat) + + !volat_rate = 1.0_r8 / (r1 + ratm / knh3) ! conductance from aqueous TAN in slurry to NH3 in atmosphere fluxes(iflx_air) = volat_rate*cnc ! lower soil resistance consists of liquid diffusion slurry, in saturated layer, and @@ -324,14 +329,20 @@ subroutine eval_fluxes_slurry(water, mtan, Hconc, tg, ratm, theta, thetasat, per r2a = (water(1)-inwater) / diffusivity_water r2b = (depth_soilsat-insoil) / diffusivity_satsoil dz2 = depth_lower-depth_soilsat - ! conductance = inverse resistance - g3 = (eval_diffusivity_liq_mq(theta, thetasat, tg)*theta & - + knh3*eval_diffusivity_gas_mq(theta, thetasat, tg)*(thetasat-theta)) & - / dz2 - r2 = r2a + r2b + 1.0/g3 - fluxes(iflx_soild) = cnc / r2 + Rkl = dz2 / (eval_diffusivity_liq_mq(theta, thetasat, tg)*theta) + Rkg = dz2 / (eval_diffusivity_gas_mq(theta, thetasat, tg)*(thetasat-theta)) + Rsld = r2a + r2b + + gdown = -(Rkg + Rkl*knh3)/((Rkg*(Rkl + Rsld) + Rkl*Rsld*knh3)*(kads*(theta - 1) - thetasat)) + ! conductance = inverse resistance + !g3 = (eval_diffusivity_liq_mq(theta, thetasat, tg)*theta & + ! + knh3*eval_diffusivity_gas_mq(theta, thetasat, tg)*(thetasat-theta)) & + ! / dz2 + !r2 = r2a + r2b + 1.0/g3 + + fluxes(iflx_soild) = cnc * gdown ! nitrification kno3 = eval_no3prod_v2(thetasat, thetasat, tg) @@ -342,7 +353,7 @@ subroutine eval_fluxes_slurry(water, mtan, Hconc, tg, ratm, theta, thetasat, per end subroutine eval_fluxes_slurry subroutine eval_fluxes_soilroff_ads(mtan, water_manure, Hconc, tg, ratm, theta, thetasat, perc, & - & runoff, bsw, soildepth, fluxes, substance, status) + & runoff, bsw, kads_nh4, soildepth, fluxes, substance, status) ! ! Evaluate nitrogen fluxes from a soil layer. Use for all cases except the partly ! infiltrated slurry (above). Fluxes can be evaluated either for urea or TAN: for @@ -360,6 +371,7 @@ subroutine eval_fluxes_soilroff_ads(mtan, water_manure, Hconc, tg, ratm, theta, real(r8), intent(in) :: perc ! downwards water percolation rate at the bottom of layer, m/s, > 0 real(r8), intent(in) :: runoff ! runoff water flux, m / s real(r8), intent(in) :: bsw ! b in the soilwater retention curve; needed if the Moldrup 2003 diffusivities are used. + real(r8), intent(in) :: kads_nh4 ! distribution coefficient kads = [TAN (s)] / [TAN (aq)]. Unit m3(water) / m3(soil). real(r8), intent(in) :: soildepth ! thickness of the volatlization layer integer, intent(in) :: substance ! subst_tan or subst_urea. integer, intent(out) :: status ! error flag @@ -393,7 +405,7 @@ subroutine eval_fluxes_soilroff_ads(mtan, water_manure, Hconc, tg, ratm, theta, rsl = dz / (dsl*theta_tot) if (substance == subst_tan) then - kads = 0.0_r8 ! adsorption currently off. + kads = kads_nh4 call partition_tan(tg, Hconc, theta_tot, air, kads, volatility, fract_nh4=fract_nh4) no3_rate = eval_no3prod_v2(theta_tot, thetasat, tg) else if (substance == subst_urea) then @@ -560,6 +572,8 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend integer :: indpl real(r8), parameter :: dz_layer = 0.02 ! thickness of the volatilization layer, m + real(r8), parameter :: kads = 0.0_r8 ! distriution coefficient kads = [TAN (s)] / [TAN (aq)], dimensionless + ! H+ concentration in each pool !real(r8), parameter :: Hconc(4) = (/10.0_r8**(-8.0_r8), 10.0_r8**(-8.0_r8), 10.0_r8**(-8.0_r8), 10.0_r8**(-7_r8)/) @@ -584,7 +598,7 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend perc_slurry_mean = percolated / poolranges(1) call eval_fluxes_slurry(water_slurry, tanpools(1), Hconc(1), tg, ratm, theta, thetasat, perc_slurry_mean, & - runoff, bsw, fluxes(:,1)) + runoff, bsw, kads, fluxes(:,1)) if (any(isnan(fluxes))) then status = err_nan * 10 @@ -615,7 +629,7 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend ! water content at the mean age of the pool water_soil = water_in_layer * waterfunction(age_prev + 0.5*poolranges(indpl)) call eval_fluxes_soilroff_ads(tanpools(indpl), water_soil, Hconc(indpl), tg, & - & ratm, theta, thetasat, percolation, runoff, bsw, & + & ratm, theta, thetasat, percolation, runoff, bsw, kads, & & dz_layer, fluxes(:,indpl), subst_tan, status) if (status /= 0) return @@ -681,6 +695,7 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend integer :: indpl real(r8), parameter :: water_relax_t = 24*3600.0_r8 + real(r8), parameter :: kads = 0.0_r8 logical :: fixed tanpools_old = tanpools @@ -745,7 +760,7 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend ! water content at the middle of the age range water_soil = water_into_layer * waterfunction(age_prev + 0.5*poolranges(indpl)) call eval_fluxes_soilroff_ads(tanpools(indpl), water_soil, Hconc(indpl), tg, & - & ratm, theta, thetasat, percolation, runoff, bsw, & + & ratm, theta, thetasat, percolation, runoff, bsw, kads, & & dz_layer, fluxes(:,indpl), subst_tan, status) if (status /= 0) then return @@ -1087,7 +1102,7 @@ subroutine update_urea(tg, theta, thetasat, precip, evap, watertend, runoff, & percolation = eval_perc(0.0_r8, evap, precip, watertend, ranges(indpl)) ! Hconc and Ratm are missing since they do not affect urea. call eval_fluxes_soilroff_ads(pools(indpl), 0.0_r8, missing, tg, & - & missing, theta, thetasat, percolation, runoff, bsw, & + & missing, theta, thetasat, percolation, runoff, bsw, 0.0_r8, & & dz_layer, fluxes(1:5,indpl), subst_urea, status) if (status /= 0) then return From 03eff3a56e2108fdbfb80a1ee32b68f21855e2cc Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Thu, 10 Jan 2019 17:36:02 -0500 Subject: [PATCH 043/181] tan fraction, slurry infiltration, inc. reduction --- src/biogeochem/CNNDynamicsMod.F90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index 4678471c11..ac8f3367a1 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -178,14 +178,13 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & real(r8), parameter :: water_init_grz = 0.006_r8, cnc_nh3_air = 0.0_r8, depth_slurry = 0.005_r8 !real(r8), parameter :: fract_resist=0.225_r8, fract_unavail=0.025_r8, fract_avail=0.25_r8, fract_tan=0.6_r8 - real(r8), parameter :: fract_tan=0.5_r8 ! of all N + real(r8), parameter :: fract_tan=0.6_r8 ! of all N real(r8), parameter :: fract_resist=0.45_r8, fract_unavail=0.05_r8, fract_avail=0.5_r8 ! of organic N - real(r8), parameter :: dz_layer_fert = 0.02_r8, dz_layer_grz = 0.02_r8 !real(r8), parameter :: fract_resist=0._r8, fract_unavail=0._r8, fract_avail=0._r8, fract_tan=1.0_r8 - real(r8), parameter :: fert_incorp_reduct = 0.3_r8 - real(r8), parameter :: slurry_infiltr_time = 12*3600.0_r8, water_init_fert = 1e-6 + real(r8), parameter :: fert_incorp_reduct = 0.25_r8 + real(r8), parameter :: slurry_infiltr_time = 6*3600.0_r8, water_init_fert = 1e-6 real(r8), parameter :: & poolranges_grz(3) = (/24*3600.0_r8, 10*24*3600.0_r8, 360*24*3600.0_r8/), & poolranges_fert(3) = (/2.36*24*3600.0_r8, 24*3600.0_r8, 360*24*3600.0_r8/), & From dc05bc0f8b80634b815237d864e9ce9ae8bacdbb Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Thu, 14 Feb 2019 11:22:08 -0500 Subject: [PATCH 044/181] trying to merge but probably need to do it differently --- bld/CLMBuildNamelist.pm | 42 +- src/biogeochem/CNDriverMod.F90 | 7 +- src/biogeochem/CNNDynamicsMod.F90 | 38 +- src/biogeochem/CNVegetationFacade.F90 | 3 - src/biogeophys/HydrologyNoDrainageMod.F90 | 51 +- src/biogeophys/WaterfluxType.F90 | 762 ---------------------- 6 files changed, 57 insertions(+), 846 deletions(-) delete mode 100644 src/biogeophys/WaterfluxType.F90 diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 7256e19e2c..acd2447088 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -2876,19 +2876,20 @@ sub setup_logic_fan { # my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_; print "FAN MODE: $opts->{'fan'}\n"; - if ( $physv->as_long() >= $physv->as_long("clm4_5") ) { - if ( $opts->{'fan'} ) { - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_fan', - 'use_cn'=>$nl_flags->{'use_cn'}, 'use_ed'=>$nl_flags->{'use_ed'} ); - $nl_flags->{'use_fan'} = $nl->get_value('use_fan'); - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fan_nh3_to_atm', - 'fan_mode'=>$opts->{'fan'}); - $nl_flags->{'fan_nh3_to_atm'} = $nl->get_value('fan_nh3_to_atm'); - - } - if ( value_is_true( $nl_flags->{'use_ed'} ) && value_is_true( $nl_flags->{'use_fan'} ) ) { - fatal_error("Cannot turn use_fan on when use_ed is on\n" ); - } + if ( $opts->{'fan'} ) { + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_fan', + 'use_cn'=>$nl_flags->{'use_cn'}, 'use_ed'=>$nl_flags->{'use_ed'} ); + $nl_flags->{'use_fan'} = $nl->get_value('use_fan'); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fan_nh3_to_atm', + 'fan_mode'=>$opts->{'fan'}); + $nl_flags->{'fan_nh3_to_atm'} = $nl->get_value('fan_nh3_to_atm'); + + } + if ( &value_is_true( $nl_flags->{'use_ed'} ) && &value_is_true( $nl_flags->{'use_fan'} ) ) { + fatal_error("Cannot turn use_fan on when use_ed is on\n" ); + } + if ( !&value_is_true( $nl_flags->{'use_crop'} ) && &value_is_true( $nl_flags->{'use_fan'} ) ) { + fatal_error("Cannot turn use_fan on when use_crop is off\n" ); } } @@ -3061,7 +3062,7 @@ sub setup_logic_nitrogen_deposition2 { # Nitrogen deposition2 for bgc=CN # - if ( $physv->as_long() >= $physv->as_long("clm4_5") && $nl_flags->{'bgc_mode'} ne "none" && value_is_true( $nl_flags->{'use_fan'} ) ) { + if ( $nl_flags->{'bgc_mode'} ne "none" && value_is_true( $nl_flags->{'use_fan'} ) ) { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'ndep2mapalgo', 'phys'=>$nl_flags->{'phys'}, 'bgc'=>$nl_flags->{'bgc_mode'}, 'hgrid'=>$nl_flags->{'res'}, 'clm_accelerated_spinup'=>$nl_flags->{'clm_accelerated_spinup'} ); @@ -3082,7 +3083,7 @@ sub setup_logic_nitrogen_deposition2 { 'bgc'=>$nl_flags->{'bgc_mode'}, 'hgrid'=>"360x720cru" ); - } elsif ( $physv->as_long() >= $physv->as_long("clm4_5") && $nl_flags->{'bgc_mode'} =~/cn|bgc/ && value_is_true( $nl_flags->{'use_fan'} ) ) { + } elsif ( $nl_flags->{'bgc_mode'} =~/cn|bgc/ && value_is_true( $nl_flags->{'use_fan'} ) ) { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'ndep2mapalgo', 'phys'=>$nl_flags->{'phys'}, 'use_cn'=>$nl_flags->{'use_cn'}, 'hgrid'=>$nl_flags->{'res'}, 'clm_accelerated_spinup'=>$nl_flags->{'clm_accelerated_spinup'} ); @@ -3125,7 +3126,7 @@ sub setup_logic_nitrogen_deposition3 { # Nitrogen deposition3 for bgc=CN # - if ( $physv->as_long() >= $physv->as_long("clm4_5") && $nl_flags->{'bgc_mode'} ne "none" && value_is_true( $nl_flags->{'use_fan'} ) ) { + if ( $nl_flags->{'bgc_mode'} ne "none" && value_is_true( $nl_flags->{'use_fan'} ) ) { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'ndep3mapalgo', 'phys'=>$nl_flags->{'phys'}, 'bgc'=>$nl_flags->{'bgc_mode'}, 'hgrid'=>$nl_flags->{'res'}, 'clm_accelerated_spinup'=>$nl_flags->{'clm_accelerated_spinup'} ); @@ -3146,7 +3147,7 @@ sub setup_logic_nitrogen_deposition3 { 'bgc'=>$nl_flags->{'bgc_mode'}, 'hgrid'=>"360x720cru" ); - } elsif ( $physv->as_long() >= $physv->as_long("clm4_5") && $nl_flags->{'bgc_mode'} =~/cn|bgc/ && value_is_true( $nl_flags->{'use_fan'} ) ) { + } elsif ( $nl_flags->{'bgc_mode'} =~/cn|bgc/ && value_is_true( $nl_flags->{'use_fan'} ) ) { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'ndep3mapalgo', 'phys'=>$nl_flags->{'phys'}, 'use_cn'=>$nl_flags->{'use_cn'}, 'hgrid'=>$nl_flags->{'res'}, 'clm_accelerated_spinup'=>$nl_flags->{'clm_accelerated_spinup'} ); @@ -3731,11 +3732,8 @@ sub write_output_files { push @groups, "lifire_inparm"; push @groups, "ch4finundated"; push @groups, "clm_canopy_inparm"; - - if ( $physv->as_long() >= $physv->as_long("clm4_5") ) { - push @groups, "ndep2dyn_nml"; - push @groups, "ndep3dyn_nml"; - } + push @groups, "ndep2dyn_nml"; + push @groups, "ndep3dyn_nml"; my $outfile; $outfile = "$opts->{'dir'}/lnd_in"; diff --git a/src/biogeochem/CNDriverMod.F90 b/src/biogeochem/CNDriverMod.F90 index 3c3e19f449..b0ca0620ab 100644 --- a/src/biogeochem/CNDriverMod.F90 +++ b/src/biogeochem/CNDriverMod.F90 @@ -275,11 +275,12 @@ subroutine CNDriverNoLeaching(bounds, !KO atm2lnd_inst, soilbiogeochem_nitrogenflux_inst) !KO call CNNDeposition(bounds, num_soilc, filter_soilc, & - atm2lnd_inst, soilbiogeochem_nitrogenflux_inst, cnveg_carbonstate_inst, & + atm2lnd_inst, wateratm2lndbulk_inst, & + soilbiogeochem_nitrogenflux_inst, cnveg_carbonstate_inst, & soilbiogeochem_nitrogenstate_inst, soilbiogeochem_carbonflux_inst, & cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & - waterstate_inst, soilstate_inst, temperature_inst, & - waterflux_inst, frictionvel_inst) + waterstatebulk_inst, soilstate_inst, temperature_inst, & + waterfluxbulk_inst, frictionvel_inst) !KO call t_stopf('CNDeposition') diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index 3a6d9a663b..6f7ef4c000 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -12,6 +12,7 @@ module CNNDynamicsMod use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, nfix_timeconst use subgridAveMod , only : p2c use atm2lndType , only : atm2lnd_type + use Wateratm2lndBulkType , only : wateratm2lndbulk_type use CNVegStateType , only : cnveg_state_type use CNVegCarbonFluxType , only : cnveg_carbonflux_type !KO @@ -27,8 +28,8 @@ module CNNDynamicsMod use SoilBiogeochemStateType , only : soilbiogeochem_state_type use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type - use WaterStateType , only : waterstate_type - use WaterFluxType , only : waterflux_type + use WaterStateBulkType , only : waterstatebulk_type + use WaterFluxBulkType , only : waterfluxbulk_type !JV use SoilStateType , only : soilstate_type !JV @@ -130,11 +131,12 @@ subroutine CNNDynamicsReadNML( NLFilename ) end subroutine CNNDynamicsReadNML subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & - atm2lnd_inst, soilbiogeochem_nitrogenflux_inst, cnveg_carbonstate_inst, & + atm2lnd_inst, wateratm2lndbulk_inst, & + soilbiogeochem_nitrogenflux_inst, cnveg_carbonstate_inst, & soilbiogeochem_nitrogenstate_inst, soilbiogeochem_carbonflux_inst, & cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & - waterstate_inst, soilstate_inst, temperature_inst, & - waterflux_inst, frictionvel_inst) + waterstatebulk_inst, soilstate_inst, temperature_inst, & + waterfluxbulk_inst, frictionvel_inst) use CNSharedParamsMod , only: use_fun !KO use clm_varctl , only: use_fan @@ -159,6 +161,7 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & integer , intent(in) :: filter_soilc(:) ! filter for soil columns !KO type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(wateratm2lndbulk_type), intent(in) :: wateratm2lndbulk_inst type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst !KO type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst @@ -166,10 +169,10 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst type(soilbiogeochem_nitrogenstate_type), intent(inout) :: soilbiogeochem_nitrogenstate_inst type(soilbiogeochem_carbonflux_type) , intent(inout) :: soilbiogeochem_carbonflux_inst - type(waterstate_type) , intent(inout) :: waterstate_inst + type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst type(soilstate_type) , intent(in) :: soilstate_inst type(temperature_type) , intent(inout) :: temperature_inst - type(waterflux_type) , intent(inout) :: waterflux_inst + type(waterfluxbulk_type) , intent(in) :: waterfluxbulk_inst type(frictionvel_type) , intent(inout) :: frictionvel_inst integer, parameter :: num_substeps = 4, balance_check_freq = 1000 @@ -375,16 +378,16 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & watertend = 0.0_r8 ! use the calculated tend - watertend = waterstate_inst%h2osoi_tend_tsl_col(c) * 1e-3 ! to meters/sec (ie. m3/m2/s) + watertend = waterstatebulk_inst%h2osoi_tend_tsl_col(c) * 1e-3 ! to meters/sec (ie. m3/m2/s) tg = temperature_inst%t_grnd_col(c) - theta = waterstate_inst%h2osoi_vol_col(c,1) + theta = waterstatebulk_inst%h2osoi_vol_col(c,1) thetasat = soilstate_inst%watsat_col(c,1) bsw = soilstate_inst%bsw_col(c,1) theta = min(theta, 0.98_r8*thetasat) - infiltr_m_s = max(waterflux_inst%qflx_infl_col(c), 0.0) * 1e-3 - evap_m_s = waterflux_inst%qflx_evap_grnd_col(c) * 1e-3 - runoff_m_s = max(waterflux_inst%qflx_runoff_col(c), 0.0) * 1e-3 + infiltr_m_s = max(waterfluxbulk_inst%qflx_infl_col(c), 0.0) * 1e-3 + evap_m_s = waterfluxbulk_inst%qflx_evap_grnd_col(c) * 1e-3 + runoff_m_s = max(waterfluxbulk_inst%qflx_runoff_col(c), 0.0) * 1e-3 soilpsi = soilstate_inst%soilpsi_col(c,1) ! @@ -427,7 +430,7 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & do ind_substep = 1, num_substeps call update_npool(tg, ratm, & theta, thetasat, infiltr_m_s, evap_m_s, & - atm2lnd_inst%forc_q_downscaled_col(c), watertend, & + wateratm2lndbulk_inst%forc_q_downscaled_col(c), watertend, & runoff_m_s, tandep, (/0.0_r8, 0.0_r8, sum(tanprod)/), water_init_grz, & bsw, poolranges_grz, Hconc_grz, dz_layer_grz, tanpools3, & fluxes3(1:5,:), garbage, dt/num_substeps, status, 3) @@ -499,7 +502,7 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & end if call update_4pool(tg, ratm, theta, thetasat, infiltr_m_s, evap_m_s, & - atm2lnd_inst%forc_q_downscaled_col(c), watertend, & + wateratm2lndbulk_inst%forc_q_downscaled_col(c), watertend, & runoff_m_s, tandep, sum(tanprod), bsw, depth_slurry, & poolranges_slr, tanpools4, Hconc_slr, fluxes4(1:5,:), garbage, dt / num_substeps, status) if (status /= 0) then @@ -590,7 +593,7 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & do ind_substep = 1, num_substeps ! Fertilizer pools f0...f2 call update_npool(tg, ratm, theta, thetasat, infiltr_m_s, evap_m_s, & - atm2lnd_inst%forc_q_downscaled_col(c), watertend, & + wateratm2lndbulk_inst%forc_q_downscaled_col(c), watertend, & runoff_m_s, 0.0_r8, tanprod_from_urea, water_init_fert, bsw, & poolranges_fert, Hconc_fert, dz_layer_fert, tanpools3, fluxes3(1:5,:), & garbage, dt/num_substeps, status, numpools=3) @@ -603,7 +606,7 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & ! Fertilizer pool f3 call update_npool(tg, ratm, theta, thetasat, infiltr_m_s, evap_m_s, & - atm2lnd_inst%forc_q_downscaled_col(c), watertend, & + wateratm2lndbulk_inst%forc_q_downscaled_col(c), watertend, & runoff_m_s, fert_generic, (/0.0_r8/), water_init_fert, bsw, & !(/360*24*3600.0_r8/), (/10**(-6.0_r8)/), dz_layer_fert, ns%tan_f3_col(c:c), fluxes3(1:5,1:1), & (/360*24*3600.0_r8/), (/10**(-ph_crop)/), dz_layer_fert, ns%tan_f3_col(c:c), fluxes3(1:5,1:1), & @@ -902,7 +905,8 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & write(iulog, *) 'bad tan_manure col_grass', flux_grass_spread_tan, col%wtgcell(col_grass) end if else if (flux_grass_spread > 0) then - call endrun('Cannot spread manure') + continue + !call endrun('Cannot spread manure') end if end do ! grid diff --git a/src/biogeochem/CNVegetationFacade.F90 b/src/biogeochem/CNVegetationFacade.F90 index 1fc957b147..f994c2da93 100644 --- a/src/biogeochem/CNVegetationFacade.F90 +++ b/src/biogeochem/CNVegetationFacade.F90 @@ -790,9 +790,6 @@ subroutine EcosystemDynamicsPreDrainage(this, bounds, & c14_soilbiogeochem_carbonflux_inst, c14_soilbiogeochem_carbonstate_inst, & soilbiogeochem_state_inst, & soilbiogeochem_nitrogenflux_inst, soilbiogeochem_nitrogenstate_inst, & - atm2lnd_inst, waterstate_inst, waterflux_inst, & - canopystate_inst, soilstate_inst, temperature_inst, crop_inst, ch4_inst, & - photosyns_inst, soilhydrology_inst, energyflux_inst, & atm2lnd_inst, waterstatebulk_inst, waterdiagnosticbulk_inst, waterfluxbulk_inst, & wateratm2lndbulk_inst, canopystate_inst, soilstate_inst, temperature_inst, crop_inst, ch4_inst, & photosyns_inst, saturated_excess_runoff_inst, energyflux_inst, & diff --git a/src/biogeophys/HydrologyNoDrainageMod.F90 b/src/biogeophys/HydrologyNoDrainageMod.F90 index 6d2e8b8029..c8e77c4b7a 100644 --- a/src/biogeophys/HydrologyNoDrainageMod.F90 +++ b/src/biogeophys/HydrologyNoDrainageMod.F90 @@ -277,7 +277,7 @@ subroutine HydrologyNoDrainage(bounds, & call Compute_EffecRootFrac_And_VertTranSink(bounds, num_hydrologyc, & filter_hydrologyc, soilstate_inst, canopystate_inst, waterfluxbulk_inst, energyflux_inst) - if ( use_fan ) call store_tsl_moisture(waterstate_inst) + if ( use_fan ) call store_tsl_moisture(waterstatebulk_inst) if ( use_fates ) then call clm_fates%ComputeRootSoilFlux(bounds, num_hydrologyc, filter_hydrologyc, soilstate_inst, waterfluxbulk_inst) end if @@ -285,7 +285,7 @@ subroutine HydrologyNoDrainage(bounds, & call SoilWater(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, filter_urbanc, & soilhydrology_inst, soilstate_inst, waterfluxbulk_inst, waterstatebulk_inst, temperature_inst, & canopystate_inst, energyflux_inst, soil_water_retention_curve) - if ( use_fan ) call eval_tsl_moist_tend(waterstate_inst) + if ( use_fan ) call eval_tsl_moist_tend(waterstatebulk_inst) if (use_vichydro) then ! mapping soilmoist from CLM to VIC layers for runoff calculations @@ -434,9 +434,7 @@ subroutine HydrologyNoDrainage(bounds, & ! Calculate temperature of near-surface soil layer ! Calculate soil temperature and total water (liq+ice) in top 10cm of soil ! Calculate soil temperature and total water (liq+ice) in top 17cm of soil -!KO - ! Calculate total water (liq+ice) in top 5cm of soil -!KO + do fc = 1, num_nolakec c = filter_nolakec(fc) l = col%landunit(c) @@ -444,11 +442,6 @@ subroutine HydrologyNoDrainage(bounds, & t_soi_10cm(c) = 0._r8 tsoi17(c) = 0._r8 h2osoi_liqice_10cm(c) = 0._r8 -!KO - if ( use_fan ) then - waterstate_inst%h2osoi_liqice_5cm_col(c) = 0._r8 - end if -!KO h2osoi_liq_tot(c) = 0._r8 h2osoi_ice_tot(c) = 0._r8 end if @@ -472,30 +465,12 @@ subroutine HydrologyNoDrainage(bounds, & end if end if - !JV - if ( use_fan ) then - if (zi(c,j-1) < 0.05_r8) then - if (zi(c,j) < 0.05_r8) then - fracl = 1.0_r8 - else - fracl = (0.05_r8 - zi(c,j-1)) / dz(c,j) - end if - waterstate_inst%h2osoi_liqice_5cm_col(c) = & - waterstate_inst%h2osoi_liqice_5cm_col(c) + & - (h2osoi_liq(c,j)+h2osoi_ice(c,j))* & - fracl - end if - end if - !JV - if (zi(c,j) <= 0.1_r8) then fracl = 1._r8 t_soi_10cm(c) = t_soi_10cm(c) + t_soisno(c,j)*dz(c,j)*fracl h2osoi_liqice_10cm(c) = h2osoi_liqice_10cm(c) + & (h2osoi_liq(c,j)+h2osoi_ice(c,j))* & fracl - !KO - !KO else if (zi(c,j) > 0.1_r8 .and. zi(c,j-1) < 0.1_r8) then fracl = (0.1_r8 - zi(c,j-1))/dz(c,j) @@ -684,23 +659,21 @@ subroutine HydrologyNoDrainage(bounds, & contains - subroutine store_tsl_moisture(waterstate_inst) - type(waterstate_type), intent(inout) :: waterstate_inst - print *, 'store flux' - associate(h2osoi_tend_tsl => waterstate_inst%h2osoi_tend_tsl_col(bounds%begc:bounds%endc), & - h2osoi_liq_tsl => waterstate_inst%h2osoi_liq_col(bounds%begc:bounds%endc,1)) + subroutine store_tsl_moisture(waterstatebulk_inst) + type(waterstatebulk_type), intent(inout) :: waterstatebulk_inst + associate(h2osoi_tend_tsl => waterstatebulk_inst%h2osoi_tend_tsl_col(bounds%begc:bounds%endc), & + h2osoi_liq_tsl => waterstatebulk_inst%h2osoi_liq_col(bounds%begc:bounds%endc,1)) h2osoi_tend_tsl = h2osoi_liq_tsl end associate end subroutine store_tsl_moisture - subroutine eval_tsl_moist_tend(waterstate_inst) - type(waterstate_type), intent(inout) :: waterstate_inst - print *, 'eval tend' - associate(h2osoi_tend_tsl => waterstate_inst%h2osoi_tend_tsl_col(bounds%begc:bounds%endc), & - h2osoi_liq_tsl => waterstate_inst%h2osoi_liq_col(bounds%begc:bounds%endc,1)) + subroutine eval_tsl_moist_tend(waterstatebulk_inst) + type(waterstatebulk_type), intent(inout) :: waterstatebulk_inst + associate(h2osoi_tend_tsl => waterstatebulk_inst%h2osoi_tend_tsl_col(bounds%begc:bounds%endc), & + h2osoi_liq_tsl => waterstatebulk_inst%h2osoi_liq_col(bounds%begc:bounds%endc,1)) h2osoi_tend_tsl = (h2osoi_liq_tsl - h2osoi_tend_tsl) / dtime end associate - print *, 'done' + end subroutine eval_tsl_moist_tend end subroutine HydrologyNoDrainage diff --git a/src/biogeophys/WaterfluxType.F90 b/src/biogeophys/WaterfluxType.F90 deleted file mode 100644 index 7e7780c63e..0000000000 --- a/src/biogeophys/WaterfluxType.F90 +++ /dev/null @@ -1,762 +0,0 @@ -module WaterfluxType - - !------------------------------------------------------------------------------ - ! !DESCRIPTION: - ! - ! !USES: - use shr_kind_mod , only: r8 => shr_kind_r8 - use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) - use clm_varpar , only : nlevsno, nlevsoi - use clm_varcon , only : spval - use decompMod , only : bounds_type - use LandunitType , only : lun - use ColumnType , only : col - use PatchType , only : patch - use CNSharedParamsMod , only : use_fun - use AnnualFluxDribbler, only : annual_flux_dribbler_type, annual_flux_dribbler_gridcell - ! - implicit none - private - ! - ! !PUBLIC TYPES: - type, public :: waterflux_type - - ! water fluxes are in units or mm/s - - real(r8), pointer :: qflx_prec_grnd_patch (:) ! patch water onto ground including canopy runoff [kg/(m2 s)] - real(r8), pointer :: qflx_prec_grnd_col (:) ! col water onto ground including canopy runoff [kg/(m2 s)] - real(r8), pointer :: qflx_rain_grnd_patch (:) ! patch rain on ground after interception (mm H2O/s) [+] - real(r8), pointer :: qflx_rain_grnd_col (:) ! col rain on ground after interception (mm H2O/s) [+] - real(r8), pointer :: qflx_snow_grnd_patch (:) ! patch snow on ground after interception (mm H2O/s) [+] - real(r8), pointer :: qflx_snow_grnd_col (:) ! col snow on ground after interception (mm H2O/s) [+] - real(r8), pointer :: qflx_sub_snow_patch (:) ! patch sublimation rate from snow pack (mm H2O /s) [+] - real(r8), pointer :: qflx_sub_snow_col (:) ! col sublimation rate from snow pack (mm H2O /s) [+] - real(r8), pointer :: qflx_evap_soi_patch (:) ! patch soil evaporation (mm H2O/s) (+ = to atm) - real(r8), pointer :: qflx_evap_soi_col (:) ! col soil evaporation (mm H2O/s) (+ = to atm) - real(r8), pointer :: qflx_evap_veg_patch (:) ! patch vegetation evaporation (mm H2O/s) (+ = to atm) - real(r8), pointer :: qflx_evap_veg_col (:) ! col vegetation evaporation (mm H2O/s) (+ = to atm) - real(r8), pointer :: qflx_evap_can_patch (:) ! patch evaporation from leaves and stems (mm H2O/s) (+ = to atm) - real(r8), pointer :: qflx_evap_can_col (:) ! col evaporation from leaves and stems (mm H2O/s) (+ = to atm) - real(r8), pointer :: qflx_evap_tot_patch (:) ! patch pft_qflx_evap_soi + pft_qflx_evap_veg + qflx_tran_veg - real(r8), pointer :: qflx_evap_tot_col (:) ! col col_qflx_evap_soi + col_qflx_evap_veg + qflx_tran_veg - real(r8), pointer :: qflx_evap_grnd_patch (:) ! patch ground surface evaporation rate (mm H2O/s) [+] - real(r8), pointer :: qflx_evap_grnd_col (:) ! col ground surface evaporation rate (mm H2O/s) [+] - real(r8), pointer :: qflx_phs_neg_col (:) ! col sum of negative hydraulic redistribution fluxes (mm H2O/s) [+] - - ! In the snow capping parametrization excess mass above h2osno_max is removed. A breakdown of mass into liquid - ! and solid fluxes is done, these are represented by qflx_snwcp_liq_col and qflx_snwcp_ice_col. - real(r8), pointer :: qflx_snwcp_liq_col (:) ! col excess liquid h2o due to snow capping (outgoing) (mm H2O /s) - real(r8), pointer :: qflx_snwcp_ice_col (:) ! col excess solid h2o due to snow capping (outgoing) (mm H2O /s) - real(r8), pointer :: qflx_snwcp_discarded_liq_col(:) ! col excess liquid h2o due to snow capping, which we simply discard in order to reset the snow pack (mm H2O /s) - real(r8), pointer :: qflx_snwcp_discarded_ice_col(:) ! col excess solid h2o due to snow capping, which we simply discard in order to reset the snow pack (mm H2O /s) - - real(r8), pointer :: qflx_tran_veg_patch (:) ! patch vegetation transpiration (mm H2O/s) (+ = to atm) - real(r8), pointer :: qflx_tran_veg_col (:) ! col vegetation transpiration (mm H2O/s) (+ = to atm) - real(r8), pointer :: qflx_dew_snow_patch (:) ! patch surface dew added to snow pack (mm H2O /s) [+] - real(r8), pointer :: qflx_dew_snow_col (:) ! col surface dew added to snow pack (mm H2O /s) [+] - real(r8), pointer :: qflx_dew_grnd_patch (:) ! patch ground surface dew formation (mm H2O /s) [+] - real(r8), pointer :: qflx_dew_grnd_col (:) ! col ground surface dew formation (mm H2O /s) [+] (+ = to atm); usually eflx_bot >= 0) - real(r8), pointer :: qflx_prec_intr_patch (:) ! patch interception of precipitation [mm/s] - real(r8), pointer :: qflx_prec_intr_col (:) ! col interception of precipitation [mm/s] - real(r8), pointer :: qflx_snowindunload_patch (:) ! patch canopy snow wind unloading (mm H2O /s) - real(r8), pointer :: qflx_snowindunload_col (:) ! col canopy snow wind unloading (mm H2O /s) - real(r8), pointer :: qflx_snotempunload_patch (:) ! patch canopy snow temp unloading (mm H2O /s) - real(r8), pointer :: qflx_snotempunload_col (:) ! col canopy snow temp unloading (mm H2O /s) - - real(r8), pointer :: qflx_ev_snow_patch (:) ! patch evaporation heat flux from snow (mm H2O/s) [+ to atm] - real(r8), pointer :: qflx_ev_snow_col (:) ! col evaporation heat flux from snow (mm H2O/s) [+ to atm] - real(r8), pointer :: qflx_ev_soil_patch (:) ! patch evaporation heat flux from soil (mm H2O/s) [+ to atm] - real(r8), pointer :: qflx_ev_soil_col (:) ! col evaporation heat flux from soil (mm H2O/s) [+ to atm] - real(r8), pointer :: qflx_ev_h2osfc_patch (:) ! patch evaporation heat flux from soil (mm H2O/s) [+ to atm] - real(r8), pointer :: qflx_ev_h2osfc_col (:) ! col evaporation heat flux from soil (mm H2O/s) [+ to atm] - - real(r8), pointer :: qflx_adv_col (:,:) ! col advective flux across different soil layer interfaces [mm H2O/s] [+ downward] - real(r8), pointer :: qflx_rootsoi_col (:,:) ! col root and soil water exchange [mm H2O/s] [+ into root] - real(r8), pointer :: qflx_infl_col (:) ! col infiltration (mm H2O /s) - real(r8), pointer :: qflx_surf_col (:) ! col surface runoff (mm H2O /s) - real(r8), pointer :: qflx_drain_col (:) ! col sub-surface runoff (mm H2O /s) - real(r8), pointer :: qflx_top_soil_col (:) ! col net water input into soil from top (mm/s) - real(r8), pointer :: qflx_h2osfc_to_ice_col (:) ! col conversion of h2osfc to ice - real(r8), pointer :: qflx_h2osfc_surf_col (:) ! col surface water runoff - real(r8), pointer :: qflx_snow_h2osfc_col (:) ! col snow falling on surface water - real(r8), pointer :: qflx_drain_perched_col (:) ! col sub-surface runoff from perched wt (mm H2O /s) - real(r8), pointer :: qflx_deficit_col (:) ! col water deficit to keep non-negative liquid water content (mm H2O) - real(r8), pointer :: qflx_floodc_col (:) ! col flood water flux at column level - real(r8), pointer :: qflx_sl_top_soil_col (:) ! col liquid water + ice from layer above soil to top soil layer or sent to qflx_qrgwl (mm H2O/s) - real(r8), pointer :: qflx_snomelt_col (:) ! col snow melt (mm H2O /s) - real(r8), pointer :: qflx_snomelt_lyr_col (:,:) ! col snow melt in each layer (mm H2O /s) - real(r8), pointer :: qflx_snow_drain_col (:) ! col drainage from snow pack - real(r8), pointer :: qflx_qrgwl_col (:) ! col qflx_surf at glaciers, wetlands, lakes - real(r8), pointer :: qflx_runoff_col (:) ! col total runoff (qflx_drain+qflx_surf+qflx_qrgwl) (mm H2O /s) - real(r8), pointer :: qflx_runoff_r_col (:) ! col Rural total runoff (qflx_drain+qflx_surf+qflx_qrgwl) (mm H2O /s) - real(r8), pointer :: qflx_runoff_u_col (:) ! col urban total runoff (qflx_drain+qflx_surf) (mm H2O /s) - real(r8), pointer :: qflx_ice_runoff_snwcp_col(:) ! col solid runoff from snow capping (mm H2O /s) - real(r8), pointer :: qflx_ice_runoff_xs_col (:) ! col solid runoff from excess ice in soil (mm H2O /s) - real(r8), pointer :: qflx_rsub_sat_col (:) ! col soil saturation excess [mm/s] - real(r8), pointer :: qflx_snofrz_lyr_col (:,:) ! col snow freezing rate (positive definite) (col,lyr) [kg m-2 s-1] - real(r8), pointer :: qflx_snofrz_col (:) ! col column-integrated snow freezing rate (positive definite) (col) [kg m-2 s-1] - real(r8), pointer :: qflx_drain_vr_col (:,:) ! col liquid water losted as drainage (m /time step) - real(r8), pointer :: snow_sources_col (:) ! col snow sources (mm H2O/s) - real(r8), pointer :: snow_sinks_col (:) ! col snow sinks (mm H2O/s) - - ! Dynamic land cover change - real(r8), pointer :: qflx_liq_dynbal_grc (:) ! grc liq dynamic land cover change conversion runoff flux - real(r8), pointer :: qflx_ice_dynbal_grc (:) ! grc ice dynamic land cover change conversion runoff flux - - ! Objects that help convert once-per-year dynamic land cover changes into fluxes - ! that are dribbled throughout the year - type(annual_flux_dribbler_type) :: qflx_liq_dynbal_dribbler - type(annual_flux_dribbler_type) :: qflx_ice_dynbal_dribbler - - ! ET accumulation - real(r8), pointer :: AnnEt (:) ! Annual average ET flux mmH20/s - - - contains - - - - procedure, public :: Init - procedure, public :: Restart - procedure, private :: InitAllocate - procedure, private :: InitHistory - procedure, private :: InitCold - procedure, public :: InitAccBuffer - procedure, public :: InitAccVars - procedure, public :: UpdateAccVars - - end type waterflux_type - !------------------------------------------------------------------------ - -contains - - !------------------------------------------------------------------------ - subroutine Init(this, bounds) - - class(waterflux_type) :: this - type(bounds_type), intent(in) :: bounds - - call this%InitAllocate(bounds) ! same as "call initAllocate_type(hydro, bounds)" - call this%InitHistory(bounds) - call this%InitCold(bounds) - - end subroutine Init - - !------------------------------------------------------------------------ - subroutine InitAllocate(this, bounds) - ! - ! !DESCRIPTION: - ! Initialize module data structure - ! - ! !USES: - ! - ! !ARGUMENTS: - class(waterflux_type) :: this - type(bounds_type), intent(in) :: bounds - ! - ! !LOCAL VARIABLES: - integer :: begp, endp - integer :: begc, endc - integer :: begg, endg - !------------------------------------------------------------------------ - - begp = bounds%begp; endp= bounds%endp - begc = bounds%begc; endc= bounds%endc - begg = bounds%begg; endg= bounds%endg - - allocate(this%qflx_prec_intr_patch (begp:endp)) ; this%qflx_prec_intr_patch (:) = nan - allocate(this%qflx_prec_grnd_patch (begp:endp)) ; this%qflx_prec_grnd_patch (:) = nan - allocate(this%qflx_rain_grnd_patch (begp:endp)) ; this%qflx_rain_grnd_patch (:) = nan - allocate(this%qflx_snow_grnd_patch (begp:endp)) ; this%qflx_snow_grnd_patch (:) = nan - allocate(this%qflx_sub_snow_patch (begp:endp)) ; this%qflx_sub_snow_patch (:) = 0.0_r8 - allocate(this%qflx_tran_veg_patch (begp:endp)) ; this%qflx_tran_veg_patch (:) = nan - - allocate(this%qflx_snowindunload_patch (begp:endp)) ; this%qflx_snowindunload_patch (:) = nan - allocate(this%qflx_snowindunload_col (begp:endp)) ; this%qflx_snowindunload_col (:) = nan - allocate(this%qflx_snotempunload_patch (begp:endp)) ; this%qflx_snotempunload_patch (:) = nan - allocate(this%qflx_snotempunload_col (begp:endp)) ; this%qflx_snotempunload_col (:) = nan - - allocate(this%qflx_dew_grnd_patch (begp:endp)) ; this%qflx_dew_grnd_patch (:) = nan - allocate(this%qflx_dew_snow_patch (begp:endp)) ; this%qflx_dew_snow_patch (:) = nan - - allocate(this%qflx_prec_intr_col (begc:endc)) ; this%qflx_prec_intr_col (:) = nan - allocate(this%qflx_prec_grnd_col (begc:endc)) ; this%qflx_prec_grnd_col (:) = nan - allocate(this%qflx_rain_grnd_col (begc:endc)) ; this%qflx_rain_grnd_col (:) = nan - allocate(this%qflx_snow_grnd_col (begc:endc)) ; this%qflx_snow_grnd_col (:) = nan - allocate(this%qflx_sub_snow_col (begc:endc)) ; this%qflx_sub_snow_col (:) = 0.0_r8 - allocate(this%qflx_snwcp_liq_col (begc:endc)) ; this%qflx_snwcp_liq_col (:) = nan - allocate(this%qflx_snwcp_ice_col (begc:endc)) ; this%qflx_snwcp_ice_col (:) = nan - allocate(this%qflx_snwcp_discarded_liq_col(begc:endc)) ; this%qflx_snwcp_discarded_liq_col(:) = nan - allocate(this%qflx_snwcp_discarded_ice_col(begc:endc)) ; this%qflx_snwcp_discarded_ice_col(:) = nan - allocate(this%qflx_tran_veg_col (begc:endc)) ; this%qflx_tran_veg_col (:) = nan - allocate(this%qflx_evap_veg_col (begc:endc)) ; this%qflx_evap_veg_col (:) = nan - allocate(this%qflx_evap_can_col (begc:endc)) ; this%qflx_evap_can_col (:) = nan - allocate(this%qflx_evap_soi_col (begc:endc)) ; this%qflx_evap_soi_col (:) = nan - allocate(this%qflx_evap_tot_col (begc:endc)) ; this%qflx_evap_tot_col (:) = nan - allocate(this%qflx_evap_grnd_col (begc:endc)) ; this%qflx_evap_grnd_col (:) = nan - allocate(this%qflx_dew_grnd_col (begc:endc)) ; this%qflx_dew_grnd_col (:) = nan - allocate(this%qflx_dew_snow_col (begc:endc)) ; this%qflx_dew_snow_col (:) = nan - allocate(this%qflx_evap_veg_patch (begp:endp)) ; this%qflx_evap_veg_patch (:) = nan - allocate(this%qflx_evap_can_patch (begp:endp)) ; this%qflx_evap_can_patch (:) = nan - allocate(this%qflx_evap_soi_patch (begp:endp)) ; this%qflx_evap_soi_patch (:) = nan - allocate(this%qflx_evap_tot_patch (begp:endp)) ; this%qflx_evap_tot_patch (:) = nan - allocate(this%qflx_evap_grnd_patch (begp:endp)) ; this%qflx_evap_grnd_patch (:) = nan - allocate(this%qflx_phs_neg_col (begc:endc)) ; this%qflx_phs_neg_col (:) = nan - - allocate( this%qflx_ev_snow_patch (begp:endp)) ; this%qflx_ev_snow_patch (:) = nan - allocate( this%qflx_ev_snow_col (begc:endc)) ; this%qflx_ev_snow_col (:) = nan - allocate( this%qflx_ev_soil_patch (begp:endp)) ; this%qflx_ev_soil_patch (:) = nan - allocate( this%qflx_ev_soil_col (begc:endc)) ; this%qflx_ev_soil_col (:) = nan - allocate( this%qflx_ev_h2osfc_patch (begp:endp)) ; this%qflx_ev_h2osfc_patch (:) = nan - allocate( this%qflx_ev_h2osfc_col (begc:endc)) ; this%qflx_ev_h2osfc_col (:) = nan - - allocate(this%qflx_drain_vr_col (begc:endc,1:nlevsoi)) ; this%qflx_drain_vr_col (:,:) = nan - allocate(this%qflx_adv_col (begc:endc,0:nlevsoi)) ; this%qflx_adv_col (:,:) = nan - allocate(this%qflx_rootsoi_col (begc:endc,1:nlevsoi)) ; this%qflx_rootsoi_col (:,:) = nan - allocate(this%qflx_infl_col (begc:endc)) ; this%qflx_infl_col (:) = nan - allocate(this%qflx_surf_col (begc:endc)) ; this%qflx_surf_col (:) = nan - allocate(this%qflx_drain_col (begc:endc)) ; this%qflx_drain_col (:) = nan - allocate(this%qflx_top_soil_col (begc:endc)) ; this%qflx_top_soil_col (:) = nan - allocate(this%qflx_h2osfc_to_ice_col (begc:endc)) ; this%qflx_h2osfc_to_ice_col (:) = nan - allocate(this%qflx_h2osfc_surf_col (begc:endc)) ; this%qflx_h2osfc_surf_col (:) = nan - allocate(this%qflx_snow_h2osfc_col (begc:endc)) ; this%qflx_snow_h2osfc_col (:) = nan - allocate(this%qflx_snomelt_col (begc:endc)) ; this%qflx_snomelt_col (:) = nan - allocate(this%qflx_snomelt_lyr_col (begc:endc,-nlevsno+1:0)) ; this%qflx_snomelt_lyr_col (:,:) = nan - allocate(this%qflx_snow_drain_col (begc:endc)) ; this%qflx_snow_drain_col (:) = nan - allocate(this%qflx_snofrz_col (begc:endc)) ; this%qflx_snofrz_col (:) = nan - allocate(this%qflx_snofrz_lyr_col (begc:endc,-nlevsno+1:0)) ; this%qflx_snofrz_lyr_col (:,:) = nan - allocate(this%qflx_qrgwl_col (begc:endc)) ; this%qflx_qrgwl_col (:) = nan - allocate(this%qflx_drain_perched_col (begc:endc)) ; this%qflx_drain_perched_col (:) = nan - allocate(this%qflx_deficit_col (begc:endc)) ; this%qflx_deficit_col (:) = nan - allocate(this%qflx_floodc_col (begc:endc)) ; this%qflx_floodc_col (:) = nan - allocate(this%qflx_sl_top_soil_col (begc:endc)) ; this%qflx_sl_top_soil_col (:) = nan - allocate(this%qflx_runoff_col (begc:endc)) ; this%qflx_runoff_col (:) = nan - allocate(this%qflx_runoff_r_col (begc:endc)) ; this%qflx_runoff_r_col (:) = nan - allocate(this%qflx_runoff_u_col (begc:endc)) ; this%qflx_runoff_u_col (:) = nan - allocate(this%qflx_ice_runoff_snwcp_col(begc:endc)) ; this%qflx_ice_runoff_snwcp_col(:) = nan - allocate(this%qflx_ice_runoff_xs_col (begc:endc)) ; this%qflx_ice_runoff_xs_col (:) = nan - allocate(this%qflx_rsub_sat_col (begc:endc)) ; this%qflx_rsub_sat_col (:) = nan - allocate(this%snow_sources_col (begc:endc)) ; this%snow_sources_col (:) = nan - allocate(this%snow_sinks_col (begc:endc)) ; this%snow_sinks_col (:) = nan - - allocate(this%qflx_liq_dynbal_grc (begg:endg)) ; this%qflx_liq_dynbal_grc (:) = nan - allocate(this%qflx_ice_dynbal_grc (begg:endg)) ; this%qflx_ice_dynbal_grc (:) = nan - allocate(this%AnnET (begc:endc)) ; this%AnnET (:) = nan - - this%qflx_liq_dynbal_dribbler = annual_flux_dribbler_gridcell( & - bounds = bounds, & - name = 'qflx_liq_dynbal', & - units = 'mm H2O') - - this%qflx_ice_dynbal_dribbler = annual_flux_dribbler_gridcell( & - bounds = bounds, & - name = 'qflx_ice_dynbal', & - units = 'mm H2O') - - end subroutine InitAllocate - - !------------------------------------------------------------------------ - subroutine InitHistory(this, bounds) - ! - ! !USES: - use clm_varctl , only : use_cn - use histFileMod , only : hist_addfld1d, hist_addfld2d, no_snow_normal - ! - ! !ARGUMENTS: - class(waterflux_type) :: this - type(bounds_type), intent(in) :: bounds - ! - ! !LOCAL VARIABLES: - integer :: begp, endp - integer :: begc, endc - integer :: begg, endg - character(10) :: active - real(r8), pointer :: data2dptr(:,:), data1dptr(:) ! temp. pointers for slicing larger arrays - !------------------------------------------------------------------------ - - begp = bounds%begp; endp= bounds%endp - begc = bounds%begc; endc= bounds%endc - begg = bounds%begg; endg= bounds%endg - - this%qflx_top_soil_col(begc:endc) = spval - call hist_addfld1d (fname='QTOPSOIL', units='mm/s', & - avgflag='A', long_name='water input to surface', & - ptr_col=this%qflx_top_soil_col, c2l_scale_type='urbanf', default='inactive') - - this%qflx_infl_col(begc:endc) = spval - call hist_addfld1d (fname='QINFL', units='mm/s', & - avgflag='A', long_name='infiltration', & - ptr_col=this%qflx_infl_col, c2l_scale_type='urbanf') - - this%qflx_surf_col(begc:endc) = spval - call hist_addfld1d (fname='QOVER', units='mm/s', & - avgflag='A', long_name='surface runoff', & - ptr_col=this%qflx_surf_col, c2l_scale_type='urbanf') - - this%qflx_qrgwl_col(begc:endc) = spval - call hist_addfld1d (fname='QRGWL', units='mm/s', & - avgflag='A', & - long_name='surface runoff at glaciers (liquid only), wetlands, lakes; also includes melted ice runoff from QSNWCPICE', & - ptr_col=this%qflx_qrgwl_col, c2l_scale_type='urbanf') - - this%qflx_drain_col(begc:endc) = spval - call hist_addfld1d (fname='QDRAI', units='mm/s', & - avgflag='A', long_name='sub-surface drainage', & - ptr_col=this%qflx_drain_col, c2l_scale_type='urbanf') - - this%qflx_liq_dynbal_grc(begg:endg) = spval - call hist_addfld1d (fname='QFLX_LIQ_DYNBAL', units='mm/s', & - avgflag='A', long_name='liq dynamic land cover change conversion runoff flux', & - ptr_lnd=this%qflx_liq_dynbal_grc) - - this%qflx_ice_dynbal_grc(begg:endg) = spval - call hist_addfld1d (fname='QFLX_ICE_DYNBAL', units='mm/s', & - avgflag='A', long_name='ice dynamic land cover change conversion runoff flux', & - ptr_lnd=this%qflx_ice_dynbal_grc) - - this%qflx_runoff_col(begc:endc) = spval - call hist_addfld1d (fname='QRUNOFF', units='mm/s', & - avgflag='A', & - long_name='total liquid runoff not including correction for land use change', & - ptr_col=this%qflx_runoff_col, c2l_scale_type='urbanf') - - call hist_addfld1d (fname='QRUNOFF_ICE', units='mm/s', avgflag='A', & - long_name='total liquid runoff not incl corret for LULCC (ice landunits only)', & - ptr_col=this%qflx_runoff_col, c2l_scale_type='urbanf', l2g_scale_type='ice') - - this%qflx_runoff_u_col(begc:endc) = spval - call hist_addfld1d (fname='QRUNOFF_U', units='mm/s', & - avgflag='A', long_name='Urban total runoff', & - ptr_col=this%qflx_runoff_u_col, set_nourb=spval, c2l_scale_type='urbanf', default='inactive') - - this%qflx_runoff_r_col(begc:endc) = spval - call hist_addfld1d (fname='QRUNOFF_R', units='mm/s', & - avgflag='A', long_name='Rural total runoff', & - ptr_col=this%qflx_runoff_r_col, set_spec=spval, default='inactive') - - this%qflx_snow_drain_col(begc:endc) = spval - call hist_addfld1d (fname='QFLX_SNOW_DRAIN', units='mm/s', & - avgflag='A', long_name='drainage from snow pack', & - ptr_col=this%qflx_snow_drain_col, c2l_scale_type='urbanf') - - call hist_addfld1d (fname='QFLX_SNOW_DRAIN_ICE', units='mm/s', & - avgflag='A', long_name='drainage from snow pack melt (ice landunits only)', & - ptr_col=this%qflx_snow_drain_col, c2l_scale_type='urbanf', l2g_scale_type='ice') - - this%qflx_snomelt_col(begc:endc) = spval - call hist_addfld1d (fname='QSNOMELT', units='mm/s', & - avgflag='A', long_name='snow melt rate', & - ptr_col=this%qflx_snomelt_col, c2l_scale_type='urbanf') - - call hist_addfld1d (fname='QSNOMELT_ICE', units='mm/s', & - avgflag='A', long_name='snow melt (ice landunits only)', & - ptr_col=this%qflx_snomelt_col, c2l_scale_type='urbanf', l2g_scale_type='ice') - - this%qflx_snomelt_lyr_col(begc:endc,-nlevsno+1:0) = spval - data2dptr => this%qflx_snomelt_lyr_col(begc:endc,-nlevsno+1:0) - call hist_addfld2d (fname='SNO_MELT', units='mm/s', type2d='levsno', & - avgflag='A', long_name='snow melt rate in each snow layer', & - ptr_col=data2dptr, c2l_scale_type='urbanf',no_snow_behavior=no_snow_normal, default='inactive') - - call hist_addfld2d (fname='SNO_MELT_ICE', units='mm/s', type2d='levsno', & - avgflag='A', long_name='snow melt rate in each snow layer (ice landunits only)', & - ptr_col=data2dptr, c2l_scale_type='urbanf',no_snow_behavior=no_snow_normal, & - l2g_scale_type='ice', default='inactive') - - this%qflx_snofrz_col(begc:endc) = spval - call hist_addfld1d (fname='QSNOFRZ', units='kg/m2/s', & - avgflag='A', long_name='column-integrated snow freezing rate', & - ptr_col=this%qflx_snofrz_col, set_lake=spval, c2l_scale_type='urbanf') - - call hist_addfld1d (fname='QSNOFRZ_ICE', units='mm/s', & - avgflag='A', long_name='column-integrated snow freezing rate (ice landunits only)', & - ptr_col=this%qflx_snofrz_col, c2l_scale_type='urbanf', l2g_scale_type='ice') - - this%qflx_snofrz_lyr_col(begc:endc,-nlevsno+1:0) = spval - data2dptr => this%qflx_snofrz_lyr_col(begc:endc,-nlevsno+1:0) - call hist_addfld2d (fname='SNO_FRZ', units='kg/m2/s', type2d='levsno', & - avgflag='A', long_name='snow freezing rate in each snow layer', & - ptr_col=data2dptr, c2l_scale_type='urbanf',no_snow_behavior=no_snow_normal, default='inactive') - - call hist_addfld2d (fname='SNO_FRZ_ICE', units='mm/s', type2d='levsno', & - avgflag='A', long_name='snow freezing rate in each snow layer (ice landunits only)', & - ptr_col=data2dptr, c2l_scale_type='urbanf',no_snow_behavior=no_snow_normal, & - l2g_scale_type='ice', default='inactive') - - this%qflx_h2osfc_to_ice_col(begc:endc) = spval - call hist_addfld1d (fname='QH2OSFC_TO_ICE', units='mm/s', & - avgflag='A', long_name='surface water converted to ice', & - ptr_col=this%qflx_h2osfc_to_ice_col, default='inactive') - - this%qflx_prec_intr_patch(begp:endp) = spval - call hist_addfld1d (fname='QINTR', units='mm/s', & - avgflag='A', long_name='interception', & - ptr_patch=this%qflx_prec_intr_patch, set_lake=0._r8) - - this%qflx_prec_grnd_patch(begp:endp) = spval - call hist_addfld1d (fname='QDRIP', units='mm/s', & - avgflag='A', long_name='throughfall', & - ptr_patch=this%qflx_prec_grnd_patch, c2l_scale_type='urbanf') - - this%qflx_evap_soi_patch(begp:endp) = spval - call hist_addfld1d (fname='QSOIL', units='mm/s', & - avgflag='A', long_name= 'Ground evaporation (soil/snow evaporation + soil/snow sublimation - dew)', & - ptr_patch=this%qflx_evap_soi_patch, c2l_scale_type='urbanf') - - call hist_addfld1d (fname='QSOIL_ICE', units='mm/s', & - avgflag='A', long_name='Ground evaporation (ice landunits only)', & - ptr_patch=this%qflx_evap_soi_patch, c2l_scale_type='urbanf', l2g_scale_type='ice') - - call hist_addfld2d (fname='QROOTSINK', units='mm/s', type2d='levsoi', & - avgflag='A', long_name='water flux from soil to root in each soil-layer', & - ptr_col=this%qflx_rootsoi_col, set_spec=spval, l2g_scale_type='veg', default='inactive') - - this%qflx_evap_can_patch(begp:endp) = spval - call hist_addfld1d (fname='QVEGE', units='mm/s', & - avgflag='A', long_name='canopy evaporation', & - ptr_patch=this%qflx_evap_can_patch, set_lake=0._r8, c2l_scale_type='urbanf') - - this%qflx_tran_veg_patch(begp:endp) = spval - call hist_addfld1d (fname='QVEGT', units='mm/s', & - avgflag='A', long_name='canopy transpiration', & - ptr_patch=this%qflx_tran_veg_patch, set_lake=0._r8, c2l_scale_type='urbanf') - - this%qflx_ev_snow_patch(begp:endp) = spval - call hist_addfld1d (fname='QSNOEVAP', units='mm/s', & - avgflag='A', long_name='evaporation from snow', & - ptr_patch=this%qflx_tran_veg_patch, set_lake=0._r8, c2l_scale_type='urbanf') - - this%qflx_snowindunload_patch(begp:endp) = spval - call hist_addfld1d (fname='QSNO_WINDUNLOAD', units='mm/s', & - avgflag='A', long_name='canopy snow wind unloading', & - ptr_patch=this%qflx_snowindunload_patch, set_lake=0._r8, c2l_scale_type='urbanf') - - this%qflx_snotempunload_patch(begp:endp) = spval - call hist_addfld1d (fname='QSNO_TEMPUNLOAD', units='mm/s', & - avgflag='A', long_name='canopy snow temp unloading', & - ptr_patch=this%qflx_snotempunload_patch, set_lake=0._r8, c2l_scale_type='urbanf') - - this%qflx_snwcp_liq_col(begc:endc) = spval - call hist_addfld1d (fname='QSNOCPLIQ', units='mm H2O/s', & - avgflag='A', long_name='excess liquid h2o due to snow capping not including correction for land use change', & - ptr_col=this%qflx_snwcp_liq_col, c2l_scale_type='urbanf') - - this%qflx_snwcp_ice_col(begc:endc) = spval - call hist_addfld1d (fname='QSNWCPICE', units='mm H2O/s', & - avgflag='A', long_name='excess solid h2o due to snow capping not including correction for land use change', & - ptr_col=this%qflx_snwcp_ice_col, c2l_scale_type='urbanf') - - this%qflx_rain_grnd_patch(begp:endp) = spval - call hist_addfld1d (fname='QFLX_RAIN_GRND', units='mm H2O/s', & - avgflag='A', long_name='rain on ground after interception', & - ptr_patch=this%qflx_rain_grnd_patch, default='inactive', c2l_scale_type='urbanf') - - this%qflx_snow_grnd_patch(begp:endp) = spval - call hist_addfld1d (fname='QFLX_SNOW_GRND', units='mm H2O/s', & - avgflag='A', long_name='snow on ground after interception', & - ptr_patch=this%qflx_snow_grnd_patch, default='inactive', c2l_scale_type='urbanf') - - this%qflx_evap_grnd_patch(begp:endp) = spval - call hist_addfld1d (fname='QFLX_EVAP_GRND', units='mm H2O/s', & - avgflag='A', long_name='ground surface evaporation', & - ptr_patch=this%qflx_evap_grnd_patch, default='inactive', c2l_scale_type='urbanf') - - this%qflx_evap_veg_patch(begp:endp) = spval - call hist_addfld1d (fname='QFLX_EVAP_VEG', units='mm H2O/s', & - avgflag='A', long_name='vegetation evaporation', & - ptr_patch=this%qflx_evap_veg_patch, default='inactive', c2l_scale_type='urbanf') - - this%qflx_evap_tot_patch(begp:endp) = spval - call hist_addfld1d (fname='QFLX_EVAP_TOT', units='mm H2O/s', & - avgflag='A', long_name='qflx_evap_soi + qflx_evap_can + qflx_tran_veg', & - ptr_patch=this%qflx_evap_tot_patch, c2l_scale_type='urbanf') - - this%qflx_dew_grnd_patch(begp:endp) = spval - call hist_addfld1d (fname='QFLX_DEW_GRND', units='mm H2O/s', & - avgflag='A', long_name='ground surface dew formation', & - ptr_patch=this%qflx_dew_grnd_patch, c2l_scale_type='urbanf') - - this%qflx_sub_snow_patch(begp:endp) = spval - call hist_addfld1d (fname='QFLX_SUB_SNOW', units='mm H2O/s', & - avgflag='A', & - long_name='sublimation rate from snow pack (also includes bare ice sublimation from glacier columns)', & - ptr_patch=this%qflx_sub_snow_patch, c2l_scale_type='urbanf') - - call hist_addfld1d (fname='QFLX_SUB_SNOW_ICE', units='mm H2O/s', & - avgflag='A', & - long_name='sublimation rate from snow pack (also includes bare ice sublimation from glacier columns) '// & - '(ice landunits only)', & - ptr_patch=this%qflx_sub_snow_patch, c2l_scale_type='urbanf', l2g_scale_type='ice', & - default='inactive') - - this%qflx_dew_snow_patch(begp:endp) = spval - call hist_addfld1d (fname='QFLX_DEW_SNOW', units='mm H2O/s', & - avgflag='A', long_name='surface dew added to snow pacK', & - ptr_patch=this%qflx_dew_snow_patch, c2l_scale_type='urbanf') - - this%qflx_h2osfc_surf_col(begc:endc) = spval - call hist_addfld1d (fname='QH2OSFC', units='mm/s', & - avgflag='A', long_name='surface water runoff', & - ptr_col=this%qflx_h2osfc_surf_col) - - this%qflx_drain_perched_col(begc:endc) = spval - call hist_addfld1d (fname='QDRAI_PERCH', units='mm/s', & - avgflag='A', long_name='perched wt drainage', & - ptr_col=this%qflx_drain_perched_col, c2l_scale_type='urbanf') - - this%qflx_rsub_sat_col(begc:endc) = spval - call hist_addfld1d (fname='QDRAI_XS', units='mm/s', & - avgflag='A', long_name='saturation excess drainage', & - ptr_col=this%qflx_rsub_sat_col, c2l_scale_type='urbanf') - - this%qflx_phs_neg_col(begc:endc) = spval - call hist_addfld1d (fname='QPHSNEG', units='mm/s', & - avgflag='A', long_name='net negative hydraulic redistribution flux', & - ptr_col=this%qflx_phs_neg_col, default='inactive') - - ! As defined here, snow_sources - snow_sinks will equal the change in h2osno at any - ! given time step but only if there is at least one snow layer (for all landunits - ! except lakes). Also note that monthly average files of snow_sources and snow_sinks - ! sinks must be weighted by number of days in the month to diagnose, for example, an - ! annual value of the change in h2osno. - - this%snow_sources_col(begc:endc) = spval - call hist_addfld1d (fname='SNOW_SOURCES', units='mm/s', & - avgflag='A', long_name='snow sources (liquid water)', & - ptr_col=this%snow_sources_col, c2l_scale_type='urbanf') - - this%snow_sinks_col(begc:endc) = spval - call hist_addfld1d (fname='SNOW_SINKS', units='mm/s', & - avgflag='A', long_name='snow sinks (liquid water)', & - ptr_col=this%snow_sinks_col, c2l_scale_type='urbanf') - - this%AnnET(begc:endc) = spval - call hist_addfld1d (fname='AnnET', units='mm/s', & - avgflag='A', long_name='Annual ET', & - ptr_col=this%AnnET, c2l_scale_type='urbanf', default='inactive') - - end subroutine InitHistory - - - - !----------------------------------------------------------------------- - subroutine InitAccBuffer (this, bounds) - ! - ! !DESCRIPTION: - ! Initialize accumulation buffer for all required module accumulated fields - ! This routine set defaults values that are then overwritten by the - ! restart file for restart or branch runs - ! - ! !USES - use clm_varcon , only : spval - use accumulMod , only : init_accum_field - ! - ! !ARGUMENTS: - class(waterflux_type) :: this - type(bounds_type), intent(in) :: bounds - !--------------------------------------------------------------------- - - if (use_fun) then - - call init_accum_field (name='AnnET', units='MM H2O/S', & - desc='365-day running mean of total ET', accum_type='runmean', accum_period=-365, & - subgrid_type='column', numlev=1, init_value=0._r8) - - end if - - end subroutine InitAccBuffer - - !----------------------------------------------------------------------- - ! - subroutine InitAccVars (this, bounds) - ! !DESCRIPTION: - ! Initialize module variables that are associated with - ! time accumulated fields. This routine is called for both an initial run - ! and a restart run (and must therefore must be called after the restart file - ! is read in and the accumulation buffer is obtained) - ! - ! !USES - use accumulMod , only : extract_accum_field - use clm_time_manager , only : get_nstep - ! - ! !ARGUMENTS: - class(waterflux_type) :: this - type(bounds_type), intent(in) :: bounds - ! - ! !LOCAL VARIABLES: - integer :: begc, endc - integer :: nstep - integer :: ier - real(r8), pointer :: rbufslp(:) ! temporary - !--------------------------------------------------------------------- - begc = bounds%begc; endc = bounds%endc - - ! Allocate needed dynamic memory for single level patch field - allocate(rbufslp(begc:endc), stat=ier) - - ! Determine time step - nstep = get_nstep() - - if (use_fun) then - call extract_accum_field ('AnnET', rbufslp, nstep) - this%qflx_evap_tot_col(begc:endc) = rbufslp(begc:endc) - end if - - deallocate(rbufslp) - - end subroutine InitAccVars - - - !----------------------------------------------------------------------- - subroutine UpdateAccVars (this, bounds) - ! - ! USES - use clm_time_manager, only : get_nstep - use accumulMod , only : update_accum_field, extract_accum_field - ! - ! !ARGUMENTS: - class(waterflux_type) :: this - type(bounds_type) , intent(in) :: bounds - ! - ! !LOCAL VARIABLES: - integer :: g,c,p ! indices - integer :: dtime ! timestep size [seconds] - integer :: nstep ! timestep number - integer :: ier ! error status - integer :: begc, endc - real(r8), pointer :: rbufslp(:) ! temporary single level - patch level - !--------------------------------------------------------------------- - - begc = bounds%begc; endc = bounds%endc - - nstep = get_nstep() - - ! Allocate needed dynamic memory for single level patch field - - allocate(rbufslp(begc:endc), stat=ier) - - do c = begc,endc - rbufslp(c) = this%qflx_evap_tot_col(c) - end do - if (use_fun) then - ! Accumulate and extract AnnET (accumulates total ET as 365-day running mean) - call update_accum_field ('AnnET', rbufslp, nstep) - call extract_accum_field ('AnnET', this%AnnET, nstep) - - end if - - deallocate(rbufslp) - - end subroutine UpdateAccVars - - - !----------------------------------------------------------------------- - subroutine InitCold(this, bounds) - ! - ! !USES: - use landunit_varcon, only : istsoil, istcrop - ! - ! !ARGUMENTS: - class(waterflux_type) :: this - type(bounds_type) , intent(in) :: bounds - ! - ! !LOCAL VARIABLES: - integer :: p,c,l - !----------------------------------------------------------------------- - - this%qflx_evap_grnd_patch(bounds%begp:bounds%endp) = 0.0_r8 - this%qflx_dew_grnd_patch (bounds%begp:bounds%endp) = 0.0_r8 - this%qflx_dew_snow_patch (bounds%begp:bounds%endp) = 0.0_r8 - - this%qflx_evap_grnd_col(bounds%begc:bounds%endc) = 0.0_r8 - this%qflx_dew_grnd_col (bounds%begc:bounds%endc) = 0.0_r8 - this%qflx_dew_snow_col (bounds%begc:bounds%endc) = 0.0_r8 - - this%qflx_phs_neg_col(bounds%begc:bounds%endc) = 0.0_r8 - - this%qflx_h2osfc_surf_col(bounds%begc:bounds%endc) = 0._r8 - this%qflx_snow_drain_col(bounds%begc:bounds%endc) = 0._r8 -!KO - this%qflx_runoff_col(bounds%begc:bounds%endc) = 0._r8 -!KO - - ! This variable only gets set in the hydrology filter; need to initialize it to 0 for - ! the sake of columns outside this filter - this%qflx_ice_runoff_xs_col(bounds%begc:bounds%endc) = 0._r8 - - this%AnnEt(bounds%begc:bounds%endc) = 0._r8 - - ! needed for CNNLeaching - do c = bounds%begc, bounds%endc - l = col%landunit(c) - if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then - this%qflx_drain_col(c) = 0._r8 - this%qflx_surf_col(c) = 0._r8 - end if - end do - - end subroutine InitCold - - !------------------------------------------------------------------------ - subroutine Restart(this, bounds, ncid, flag) - ! - ! !USES: - use ncdio_pio, only : file_desc_t, ncd_double - use restUtilMod - ! - ! !ARGUMENTS: - class(waterflux_type) :: this - type(bounds_type), intent(in) :: bounds - type(file_desc_t), intent(inout) :: ncid ! netcdf id - character(len=*) , intent(in) :: flag ! 'read' or 'write' - ! - ! !LOCAL VARIABLES: - logical :: readvar ! determine if variable is on initial file - !----------------------------------------------------------------------- - - ! needed for SNICAR - call restartvar(ncid=ncid, flag=flag, varname='qflx_snofrz_lyr', xtype=ncd_double, & - dim1name='column', dim2name='levsno', switchdim=.true., lowerb2=-nlevsno+1, upperb2=0, & - long_name='snow layer ice freezing rate', units='kg m-2 s-1', & - interpinic_flag='interp', readvar=readvar, data=this%qflx_snofrz_lyr_col) - if (flag == 'read' .and. .not. readvar) then - ! initial run, not restart: initialize qflx_snofrz_lyr to zero - this%qflx_snofrz_lyr_col(bounds%begc:bounds%endc,-nlevsno+1:0) = 0._r8 - endif - - call restartvar(ncid=ncid, flag=flag, varname='qflx_snow_drain:qflx_snow_melt', xtype=ncd_double, & - dim1name='column', & - long_name='drainage from snow column', units='mm/s', & - interpinic_flag='interp', readvar=readvar, data=this%qflx_snow_drain_col) - if (flag == 'read' .and. .not. readvar) then - ! initial run, not restart: initialize qflx_snow_drain to zero - this%qflx_snow_drain_col(bounds%begc:bounds%endc) = 0._r8 - endif - - - call restartvar(ncid=ncid, flag=flag, varname='AnnET', xtype=ncd_double, & - dim1name='column', & - long_name='Annual ET ', units='mm/s', & - interpinic_flag='interp', readvar=readvar, data=this%AnnET) - if (flag == 'read' .and. .not. readvar) then - ! initial run, not restart: initialize qflx_snow_drain to zero - this%AnnET(bounds%begc:bounds%endc) = 0._r8 - endif - -!KO - call restartvar(ncid=ncid, flag=flag, varname='qflx_runoff', xtype=ncd_double, & - dim1name='column', & - long_name='total runoff (qflx_drain+qflx_surf+qflx_qrgwl)', units='mm/s', & - interpinic_flag='interp', readvar=readvar, data=this%qflx_runoff_col) - if (flag == 'read' .and. .not. readvar) then - ! initial run, not restart: initialize qflx_runoff to zero - this%qflx_runoff_col(bounds%begc:bounds%endc) = 0._r8 - endif -!KO - - call this%qflx_liq_dynbal_dribbler%Restart(bounds, ncid, flag) - call this%qflx_ice_dynbal_dribbler%Restart(bounds, ncid, flag) - - end subroutine Restart - -end module WaterfluxType From 50db0dad259a8c935fc0cebb5bd83c90e840cffe Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Fri, 15 Feb 2019 12:20:54 -0500 Subject: [PATCH 045/181] removed old FANv1 fluxes and states --- .../SoilBiogeochemNitrogenFluxType.F90 | 151 +----- .../SoilBiogeochemNitrogenStateType.F90 | 512 +----------------- 2 files changed, 2 insertions(+), 661 deletions(-) diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 index 62d044d2c3..c3677367d9 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 @@ -29,50 +29,8 @@ module SoilBiogeochemNitrogenFluxType real(r8), pointer :: ffix_to_sminn_col (:) ! col free living N fixation to soil mineral N (gN/m2/s) real(r8), pointer :: fert_to_sminn_col (:) ! col fertilizer N to soil mineral N (gN/m2/s) real(r8), pointer :: soyfixn_to_sminn_col (:) ! col soybean fixation to soil mineral N (gN/m2/s) -!KO -!!$ ! FAN fluxes -!!$ real(r8), pointer :: rain_24hr_col (:) -!!$ real(r8), pointer :: nhxdep_to_sminn_col (:) ! col atmospheric NHx deposition to soil mineral N (gN/m2/s) -!!$ real(r8), pointer :: noydep_to_sminn_col (:) ! col atmospheric NOy deposition to soil mineral N (gN/m2/s) -!!$ real(r8), pointer :: ndep_manure_col (:) ! col manure N deposition to soil mineral N (gN/m2/s) -!!$ real(r8), pointer :: ndep_fert_col (:) ! col fertilizer N deposition to soil mineral N (gN/m2/s) -!!$ real(r8), pointer :: N_Run_Off_col (:) ! col nitrogen washed from manure by rain(gN/m2/s) -!!$ real(r8), pointer :: N_Run_Off_fert_col (:) ! col nitrogen washed from fertilizer by rain(gN/m2/s) -!!$ real(r8), pointer :: u10_avg_col (:) ! col windspeed at 10m(m/s) -!!$ real(r8), pointer :: rh_gamma_col (:) !KO -!!$ real(r8), pointer :: rain_col (:) ! col rain amount(mm) -!!$ real(r8), pointer :: gamma_nh3_col (:) !KO -!!$ real(r8), pointer :: gamma_nh3_fert_col (:) !KO -!!$ real(r8), pointer :: nh3_manure_col (:) ! col atmospheric N emission of NH3 from manure (gN/m2/s) -!!$! real(r8), pointer :: nh3_fert_col (:) ! col atmospheric N emission of NH3 from fertilizer (gN/m2/s) -!!$ real(r8), pointer :: lat_fert_col (:) ! col latitude at which fertilization occurs (degN) -!!$ real(r8), pointer :: nmanure_to_sminn_col (:) ! col deposition of N from manure to soil mineral N (gN/m2/s) -!!$ real(r8), pointer :: nfert_to_sminn_col (:) ! col deposition of N from fertilizer to soil mineral N (gN/m2/s) -!!$ real(r8), pointer :: manure_f_n2o_nit_col (:) ! col N2O emission from nitrification of manure (gN/m2/s) -!!$ real(r8), pointer :: manure_f_n2_denit_col (:) ! col N2 emission from denitrification of manure (gN/m2/s) -!!$ real(r8), pointer :: manure_f_nox_nit_col (:) ! col NOx emission from nitrification of manure (gN/m2/s) -!!$ real(r8), pointer :: fert_f_n2o_nit_col (:) ! col N2O emission from nitrification of fertilizer (gN/m2/s) -!!$ real(r8), pointer :: fert_f_n2_denit_col (:) ! col N2 emission from denitrification of fertilizer (gN/m2/s) -!!$ real(r8), pointer :: fert_f_nox_nit_col (:) ! col NOx emission from nitrification of fertilizer (gN/m2/s) -!!$ real(r8), pointer :: Nd_col (:) ! col total N emission from denitrification of manure (gN/m2/s) -!!$ real(r8), pointer :: no3_manure_to_soil_col (:) ! col flow of NO3 from manure pool to soil (gN/m2/s) -!!$ real(r8), pointer :: TAN_manure_to_soil_col (:) ! col flow of NH4 in manure TAN pool to soil (gN/m2/s) -!!$ real(r8), pointer :: no3_fert_to_soil_col (:) ! col flow of NO3 from fertilizer pool to soil (gN/m2/s) -!!$ real(r8), pointer :: TAN_fert_to_soil_col (:) ! col flow of NH4 in fertilizer TAN pool to soil (gN/m2/s) -!!$ real(r8), pointer :: f_nox_col (:) ! col flux of NOx [gN/m^2/s] -!!$ real(r8), pointer :: f_nox_denit_vr_col (:,:) ! col flux of NOx from denitrification [gN/m^3/s] -!!$ real(r8), pointer :: f_nox_denit_col (:) ! col flux of NOx from denitrification [gN/m^2/s] -!!$ real(r8), pointer :: f_nox_nit_vr_col (:,:) ! col flux of NOx from nitrification [gN/m^3/s] -!!$ real(r8), pointer :: f_nox_nit_col (:) ! col flux of NOx from nitrification [gN/m^2/s] -!!$ real(r8), pointer :: Dfc_col (:,:) !KO -!!$ real(r8), pointer :: poro_fc_col (:,:) !KO -!!$ real(r8), pointer :: poroair_col (:,:) !KO -!!$ real(r8), pointer :: wfpsfc_col (:,:) !KO -!!$!KO - + !JV FAN fluxes - - real(r8), pointer :: man_tan_appl_col (:) ! Manure TAN applied on soil (gN/m2/s) real(r8), pointer :: man_n_appl_col (:) ! Manure N (TAN+organic) applied on soil (gN/m2/s) real(r8), pointer :: man_n_grz_col (:) ! Manure N from grazing animals (gN/m2/s) @@ -248,47 +206,6 @@ subroutine InitAllocate(this, bounds) allocate(this%ffix_to_sminn_col (begc:endc)) ; this%ffix_to_sminn_col (:) = nan allocate(this%fert_to_sminn_col (begc:endc)) ; this%fert_to_sminn_col (:) = nan allocate(this%soyfixn_to_sminn_col (begc:endc)) ; this%soyfixn_to_sminn_col (:) = nan -!KO -!!$ if ( use_fan ) then -!!$ allocate(this%rain_24hr_col (begc:endc)) ; this%rain_24hr_col (:) = nan -!!$ allocate(this%nhxdep_to_sminn_col (begc:endc)) ; this%nhxdep_to_sminn_col (:) = nan -!!$ allocate(this%noydep_to_sminn_col (begc:endc)) ; this%noydep_to_sminn_col (:) = nan -!!$ allocate(this%ndep_manure_col (begc:endc)) ; this%ndep_manure_col (:) = nan -!!$ allocate(this%ndep_fert_col (begc:endc)) ; this%ndep_fert_col (:) = nan -!!$ allocate(this%N_Run_Off_col (begc:endc)) ; this%N_Run_Off_col (:) = nan -!!$ allocate(this%N_Run_Off_fert_col (begc:endc)) ; this%N_Run_Off_fert_col (:) = nan -!!$ allocate(this%u10_avg_col (begc:endc)) ; this%u10_avg_col (:) = nan -!!$ allocate(this%rh_gamma_col (begc:endc)) ; this%rh_gamma_col (:) = nan -!!$ allocate(this%rain_col (begc:endc)) ; this%rain_col (:) = nan -!!$ allocate(this%gamma_nh3_col (begc:endc)) ; this%gamma_nh3_col (:) = nan -!!$ allocate(this%gamma_nh3_fert_col (begc:endc)) ; this%gamma_nh3_fert_col (:) = nan -!!$ allocate(this%nh3_manure_col (begc:endc)) ; this%nh3_manure_col (:) = nan -!!$! allocate(this%nh3_fert_col (begc:endc)) ; this%nh3_fert_col (:) = nan -!!$ allocate(this%lat_fert_col (begc:endc)) ; this%lat_fert_col (:) = nan -!!$ allocate(this%nmanure_to_sminn_col (begc:endc)) ; this%nmanure_to_sminn_col (:) = nan -!!$ allocate(this%nfert_to_sminn_col (begc:endc)) ; this%nfert_to_sminn_col (:) = nan -!!$ allocate(this%manure_f_n2o_nit_col (begc:endc)) ; this%manure_f_n2o_nit_col (:) = nan -!!$ allocate(this%manure_f_n2_denit_col (begc:endc)) ; this%manure_f_n2_denit_col (:) = nan -!!$ allocate(this%manure_f_nox_nit_col (begc:endc)) ; this%manure_f_nox_nit_col (:) = nan -!!$ allocate(this%fert_f_n2o_nit_col (begc:endc)) ; this%fert_f_n2o_nit_col (:) = nan -!!$ allocate(this%fert_f_n2_denit_col (begc:endc)) ; this%fert_f_n2_denit_col (:) = nan -!!$ allocate(this%fert_f_nox_nit_col (begc:endc)) ; this%fert_f_nox_nit_col (:) = nan -!!$ allocate(this%Nd_col (begc:endc)) ; this%Nd_col (:) = nan -!!$ allocate(this%no3_manure_to_soil_col (begc:endc)) ; this%no3_manure_to_soil_col (:) = nan -!!$ allocate(this%TAN_manure_to_soil_col (begc:endc)) ; this%TAN_manure_to_soil_col (:) = nan -!!$ allocate(this%no3_fert_to_soil_col (begc:endc)) ; this%no3_fert_to_soil_col (:) = nan -!!$ allocate(this%TAN_fert_to_soil_col (begc:endc)) ; this%TAN_fert_to_soil_col (:) = nan -!!$ allocate(this%f_nox_col (begc:endc)) ; this%f_nox_col (:) = nan -!!$ allocate(this%f_nox_denit_vr_col (begc:endc,1:nlevdecomp_full)) ; this%f_nox_denit_vr_col (:,:) = nan -!!$ allocate(this%f_nox_denit_col (begc:endc)) ; this%f_nox_denit_col (:) = nan -!!$ allocate(this%f_nox_nit_vr_col (begc:endc,1:nlevdecomp_full)) ; this%f_nox_nit_vr_col (:,:) = nan -!!$ allocate(this%f_nox_nit_col (begc:endc)) ; this%f_nox_nit_col (:) = nan -!!$ allocate(this%Dfc_col (begc:endc,1:nlevdecomp_full)) ; this%Dfc_col (:,:) = spval -!!$ allocate(this%poro_fc_col (begc:endc,1:nlevdecomp_full)) ; this%poro_fc_col (:,:) = spval -!!$ allocate(this%poroair_col (begc:endc,1:nlevdecomp_full)) ; this%poroair_col (:,:) = spval -!!$ allocate(this%wfpsfc_col (begc:endc,1:nlevdecomp_full)) ; this%wfpsfc_col (:,:) = spval -!!$ end if -!KO !JV if (use_fan) then @@ -1200,24 +1117,6 @@ subroutine SetValues ( this, & end do end do -!KO -!!$ if ( use_fan ) then -!!$ do j = 1, nlevdecomp_full -!!$ do fi = 1,num_column -!!$ i = filter_column(fi) -!!$ if ( use_nitrif_denitrif ) then -!!$ this%f_nox_denit_vr_col(i,j) = value_column -!!$ this%f_nox_nit_vr_col(i,j) = value_column -!!$ this%Dfc_col(i,j) = value_column -!!$ this%poro_fc_col(i,j) = value_column -!!$ this%poroair_col(i,j) = value_column -!!$ this%wfpsfc_col(i,j) = value_column -!!$ end if -!!$ end do -!!$ end do -!!$ end if -!KO - do fi = 1,num_column i = filter_column(fi) @@ -1252,44 +1151,9 @@ subroutine SetValues ( this, & this%som_n_leached_col(i) = value_column end do -!KO if ( use_fan ) then do fi = 1,num_column i = filter_column(fi) -!!$!KO this%rain_24hr_col(i) = value_column -!!$ this%nhxdep_to_sminn_col(i) = value_column -!!$ this%noydep_to_sminn_col(i) = value_column -!!$ this%ndep_manure_col(i) = value_column -!!$ this%ndep_fert_col(i) = value_column -!!$ this%N_Run_Off_col(i) = value_column -!!$ this%N_Run_Off_fert_col(i) = value_column -!!$!KO this%u10_avg_col(i) = value_column -!!$!KO this%rh_gamma_col(i) = value_column -!!$!KO this%rain_col(i) = value_column -!!$!KO this%gamma_nh3_col(i) = value_column -!!$ this%gamma_nh3_fert_col(i) = value_column -!!$ this%nh3_manure_col(i) = value_column -!!$ this%nh3_fert_col(i) = value_column -!!$ this%lat_fert_col(i) = value_column -!!$ this%nmanure_to_sminn_col(i) = value_column -!!$ this%nfert_to_sminn_col(i) = value_column -!!$ this%manure_f_n2o_nit_col(i) = value_column -!!$ this%manure_f_n2_denit_col(i) = value_column -!!$ this%manure_f_nox_nit_col(i) = value_column -!!$ this%fert_f_n2o_nit_col(i) = value_column -!!$ this%fert_f_n2_denit_col(i) = value_column -!!$ this%fert_f_nox_nit_col(i) = value_column -!!$ this%Nd_col(i) = value_column -!!$ this%no3_manure_to_soil_col(i) = value_column -!!$ this%TAN_manure_to_soil_col(i) = value_column -!!$ this%no3_fert_to_soil_col(i) = value_column -!!$ this%TAN_fert_to_soil_col(i) = value_column -!!$ if ( use_nitrif_denitrif ) then -!!$ this%f_nox_col(i) = value_column -!!$ this%f_nox_denit_col(i) = value_column -!!$ this%f_nox_nit_col(i) = value_column -!!$ end if - this%man_tan_appl_col(i) = value_column this%man_n_appl_col(i) = value_column this%man_n_grz_col(i) = value_column @@ -1314,7 +1178,6 @@ subroutine SetValues ( this, & end do end if -!KO do k = 1, ndecomp_pools do fi = 1,num_column @@ -1478,18 +1341,6 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc) this%pot_f_denit_col(c) + & this%pot_f_denit_vr_col(c,j) * dzsoi_decomp(j) -!KO -!!$ if ( use_fan ) then -!!$ this%f_nox_nit_col(c) = & -!!$ this%f_nox_nit_col(c) + & -!!$ this%f_nox_nit_vr_col(c,j) * dzsoi_decomp(j) -!!$ -!!$ this%f_nox_denit_col(c) = & -!!$ this%f_nox_denit_col(c) + & -!!$ this%f_nox_denit_vr_col(c,j) * dzsoi_decomp(j) -!!$ end if -!KO - this%f_n2o_nit_col(c) = & this%f_n2o_nit_col(c) + & this%f_n2o_nit_vr_col(c,j) * dzsoi_decomp(j) diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 index 39628726aa..be97c655a5 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 @@ -68,45 +68,6 @@ module SoilBiogeochemNitrogenStateType real(r8), pointer :: man_n_stored_col(:) ! col (gN/m2) manure N in storage real(r8), pointer :: man_tan_stored_col(:) ! col (gN/m2) manure TAN in storage real(r8), pointer :: fan_grz_fract_col(:) ! col unitless fraction of animals grazing -!KO - ! FAN -!!$ real(r8), pointer :: smin_no3_monthly_col (:) ! col (gN/m2) soil mineral NO3 pool -!!$ real(r8), pointer :: smin_nh4_monthly_col (:) ! col (gN/m2) soil mineral NH4 pool -!!$ real(r8), pointer :: TAN_manu_col (:) ! col (gN/m2) total ammoniacal nitrogen in manure -!!$ real(r8), pointer :: no3_manure_col (:) ! col (gN/m2) NO3 pool in manure -!!$ real(r8), pointer :: manure_u_col (:) ! col (gN/m2) urine pool in manure -!!$ real(r8), pointer :: manure_n_col (:) ! col (gN/m2) non-mineralizable N pool in manure -!!$ real(r8), pointer :: manure_a_col (:) ! col (gN/m2) available N pool in manure -!!$ real(r8), pointer :: manure_r_col (:) ! col (gN/m2) resistant N pool in manure -!!$ real(r8), pointer :: n2o_manure_total_col (:) ! col (gN/m2) total atmospheric N emission of N2O from manure -!!$ real(r8), pointer :: nox_manure_total_col (:) ! col (gN/m2) total atmospheric N emission of NOx from manure -!!$ real(r8), pointer :: nh3_manure_total_col (:) ! col (gN/m2) total atmospheric N emission of NH3 from manure -!!$ real(r8), pointer :: N_Run_Off_manure_total_col (:) ! col (gN/m2) total N washed from N manure -!!$ real(r8), pointer :: nh4_manure_total_col (:) ! col (gN/m2) total NH4 emission from manure -!!$ real(r8), pointer :: no3_manure_total_col (:) ! col (gN/m2) total NO3 emission from manure -!!$ real(r8), pointer :: ndep_total_col (:) ! col (gN/m2) total ndep from manure and fertilizer -!!$ real(r8), pointer :: fert_u_col (:) ! col (gN/m2) N pool in fertilizer -!!$ real(r8), pointer :: no3_fert_col (:) ! col (gN/m2) NO3 pool in fertilizer -!!$ real(r8), pointer :: nh3_fert_total_col (:) ! col (gN/m2) total atmospheric N emission of NH3 from fertilizer -!!$ real(r8), pointer :: N_Run_Off_fert_total_col (:) ! col (gN/m2) total N washed from N fertilizer -!!$ real(r8), pointer :: nh4_fert_total_col (:) ! col (gN/m2) total NH4 emission from fertilizer -!!$ real(r8), pointer :: no3_fert_total_col (:) ! col (gN/m2) total NO3 emission from fertilizer -!!$ real(r8), pointer :: ndep_fert_total_col (:) ! col (gN/m2) total ndep from fertilizer -!!$ real(r8), pointer :: total_nh3_col (:) ! col (gN/m2) total atmospheric N emission of NH3 from Nr -!!$ real(r8), pointer :: total_N_Run_Off_col (:) ! col (gN/m2) total N washed from N Nr -!!$ real(r8), pointer :: total_nh4_col (:) ! col (gN/m2) total NH4 emission from Nr -!!$ real(r8), pointer :: total_no3_col (:) ! col (gN/m2) total NO3 emission from Nr -!!$ real(r8), pointer :: total_ndep_col (:) ! col (gN/m2) total ndep from Nr -!!$ real(r8), pointer :: TAN_fert_col (:) ! col (gN/m2) total ammoniacal nitrogen in fertilizer -!!$ real(r8), pointer :: man_water_pool_col (:) ! col (m3/m2) volume of water in manure/water solution -!!$ real(r8), pointer :: fert_water_pool_col (:) ! col (m3/m2) volume of water in fert/water solution -!!$ real(r8), pointer :: ra_col (:) ! col (s/m) aerodynamic resistance for grass pfts -!!$ real(r8), pointer :: rb_col (:) ! col (s/m) leaf boundary layer resistance for grass pfts -!!$ real(r8), pointer :: gdd8_col (:) ! col (ddays) growing degree-days base 8C from planting -!!$ real(r8), pointer :: t_a10_col (:) ! col (K) 10-day running mean of the 2 m temperature -!!$ real(r8), pointer :: t_a10min_col (:) ! col (K) 10-day running mean of min 2-m temperature -!!$ real(r8), pointer :: fert_app_jday_col (:) ! col (day) julian day of the first fertilizer application -!KO ! summary (diagnostic) state variables, not involved in mass balance real(r8), pointer :: decomp_npools_col (:,:) ! col (gN/m2) decomposing (litter, cwd, soil) N pools @@ -230,48 +191,6 @@ subroutine InitAllocate(this, bounds) allocate(this%fan_grz_fract_col(begc:endc)) ; this%fan_grz_fract_col(:) = nan end if - !KO - - -!!$ if ( use_fan ) then -!!$ allocate(this%smin_no3_monthly_col (begc:endc)) ; this%smin_no3_monthly_col (:) = nan -!!$ allocate(this%smin_nh4_monthly_col (begc:endc)) ; this%smin_nh4_monthly_col (:) = nan -!!$ allocate(this%TAN_manu_col (begc:endc)) ; this%TAN_manu_col (:) = nan -!!$ allocate(this%no3_manure_col (begc:endc)) ; this%no3_manure_col (:) = nan -!!$ allocate(this%manure_u_col (begc:endc)) ; this%manure_u_col (:) = nan -!!$ allocate(this%manure_n_col (begc:endc)) ; this%manure_n_col (:) = nan -!!$ allocate(this%manure_a_col (begc:endc)) ; this%manure_a_col (:) = nan -!!$ allocate(this%manure_r_col (begc:endc)) ; this%manure_r_col (:) = nan -!!$ allocate(this%n2o_manure_total_col (begc:endc)) ; this%n2o_manure_total_col (:) = nan -!!$ allocate(this%nox_manure_total_col (begc:endc)) ; this%nox_manure_total_col (:) = nan -!!$ allocate(this%nh3_manure_total_col (begc:endc)) ; this%nh3_manure_total_col (:) = nan -!!$ allocate(this%N_Run_Off_manure_total_col (begc:endc)) ; this%N_Run_Off_manure_total_col (:) = nan -!!$ allocate(this%nh4_manure_total_col (begc:endc)) ; this%nh4_manure_total_col (:) = nan -!!$ allocate(this%no3_manure_total_col (begc:endc)) ; this%no3_manure_total_col (:) = nan -!!$ allocate(this%ndep_total_col (begc:endc)) ; this%ndep_total_col (:) = nan -!!$ allocate(this%fert_u_col (begc:endc)) ; this%fert_u_col (:) = nan -!!$ allocate(this%no3_fert_col (begc:endc)) ; this%no3_fert_col (:) = nan -!!$ allocate(this%nh3_fert_total_col (begc:endc)) ; this%nh3_fert_total_col (:) = nan -!!$ allocate(this%N_Run_Off_fert_total_col (begc:endc)) ; this%N_Run_Off_fert_total_col (:) = nan -!!$ allocate(this%nh4_fert_total_col (begc:endc)) ; this%nh4_fert_total_col (:) = nan -!!$ allocate(this%no3_fert_total_col (begc:endc)) ; this%no3_fert_total_col (:) = nan -!!$ allocate(this%ndep_fert_total_col (begc:endc)) ; this%ndep_fert_total_col (:) = nan -!!$ allocate(this%total_nh3_col (begc:endc)) ; this%total_nh3_col (:) = nan -!!$ allocate(this%total_N_Run_Off_col (begc:endc)) ; this%total_N_Run_Off_col (:) = nan -!!$ allocate(this%total_nh4_col (begc:endc)) ; this%total_nh4_col (:) = nan -!!$ allocate(this%total_no3_col (begc:endc)) ; this%total_no3_col (:) = nan -!!$ allocate(this%total_ndep_col (begc:endc)) ; this%total_ndep_col (:) = nan -!!$ allocate(this%TAN_fert_col (begc:endc)) ; this%TAN_fert_col (:) = nan -!!$ allocate(this%man_water_pool_col (begc:endc)) ; this%man_water_pool_col (:) = nan -!!$ allocate(this%fert_water_pool_col (begc:endc)) ; this%fert_water_pool_col (:) = nan -!!$ allocate(this%ra_col (begc:endc)) ; this%ra_col (:) = nan -!!$ allocate(this%rb_col (begc:endc)) ; this%rb_col (:) = nan -!!$ allocate(this%gdd8_col (begc:endc)) ; this%gdd8_col (:) = nan -!!$ allocate(this%fert_app_jday_col (begc:endc)) ; this%fert_app_jday_col (:) = nan -!!$ allocate(this%t_a10_col (begc:endc)) ; this%t_a10_col (:) = nan -!!$ allocate(this%t_a10min_col (begc:endc)) ; this%t_a10min_col (:) = nan -!!$ end if -!KO end subroutine InitAllocate @@ -393,19 +312,6 @@ subroutine InitHistory(this, bounds) call hist_addfld1d (fname='SMIN_NH4', units='gN/m^2', & avgflag='A', long_name='soil mineral NH4', & ptr_col=this%smin_nh4_col) -!KO -!!$ if ( use_fan ) then -!!$ this%smin_no3_monthly_col(begc:endc) = spval -!!$ call hist_addfld1d (fname='SMIN_NO3_MONTHLY', units='gN/m^2/month', & -!!$ avgflag='A', long_name='soil mineral NO3 monthly', & -!!$ ptr_col=this%smin_no3_monthly_col) -!!$ -!!$ this%smin_nh4_monthly_col(begc:endc) = spval -!!$ call hist_addfld1d (fname='SMIN_NH4_MONTHLY', units='gN/m^2/month', & -!!$ avgflag='A', long_name='soil mineral NH4 monthly', & -!!$ ptr_col=this%smin_nh4_monthly_col) -!!$ end if -!KO endif else if ( nlevdecomp_full > 1 ) then @@ -434,162 +340,6 @@ subroutine InitHistory(this, bounds) &only makes sense at the column level: should not be averaged to gridcell', & ptr_col=this%dyn_nbal_adjustments_col, default='inactive') -!KO -!!$ if ( use_fan ) then -!!$ -!!$ this%TAN_manu_col(begc:endc) = spval -!!$ call hist_addfld1d (fname='TAN_MANU', units='gN/m^2', & -!!$ avgflag='A', long_name='Manure TAN pool', & -!!$ ptr_col=this%TAN_manu_col) -!!$ -!!$ this%TAN_fert_col(begc:endc) = spval -!!$ call hist_addfld1d (fname='TAN_FERT', units='gN/m^2', & -!!$ avgflag='A', long_name='Fertilizer TAN pool', & -!!$ ptr_col=this%TAN_fert_col) -!!$ -!!$ this%fert_u_col(begc:endc) = spval -!!$ call hist_addfld1d (fname='TAN_FERT_U', units='gN/m^2', & -!!$ avgflag='A', long_name='Fertilizer N pool', & -!!$ ptr_col=this%fert_u_col) -!!$ -!!$ this%manure_n_col(begc:endc) = spval -!!$ call hist_addfld1d (fname='TAN_MANU_N', units='gN/m^2', & -!!$ avgflag='A', long_name='Non-minerizable manure TAN pool', & -!!$ ptr_col=this%manure_n_col) -!!$ -!!$ this%manure_u_col(begc:endc) = spval -!!$ call hist_addfld1d (fname='TAN_MANU_U', units='gN/m^2', & -!!$ avgflag='A', long_name='Urine manure TAN pool', & -!!$ ptr_col=this%manure_u_col) -!!$ -!!$ this%manure_a_col(begc:endc) = spval -!!$ call hist_addfld1d (fname='TAN_MANU_A', units='gN/m^2', & -!!$ avgflag='A', long_name='Available manure TAN pool', & -!!$ ptr_col=this%manure_a_col) -!!$ -!!$ this%manure_r_col(begc:endc) = spval -!!$ call hist_addfld1d (fname='TAN_MANU_R', units='gN/m^2', & -!!$ avgflag='A', long_name='Resistant manure TAN pool', & -!!$ ptr_col=this%manure_r_col) -!!$ -!!$ this%man_water_pool_col(begc:endc) = spval -!!$ call hist_addfld1d (fname='MAN_WATER_POOL', units='m^3/m^2', & -!!$ avgflag='A', long_name='Manure water pool', & -!!$ ptr_col=this%man_water_pool_col) -!!$ -!!$ this%fert_water_pool_col(begc:endc) = spval -!!$ call hist_addfld1d (fname='FERT_WATER_POOL', units='m^3/m^2', & -!!$ avgflag='A', long_name='Fertilizer water pool', & -!!$ ptr_col=this%fert_water_pool_col) -!!$ -!!$ this%ra_col(begc:endc) = spval -!!$ call hist_addfld1d (fname='RA_COL', units='s/m', & -!!$ avgflag='A', long_name='Column aerodynamic resistance for grass pft', & -!!$ ptr_col=this%ra_col) -!!$ -!!$ this%rb_col(begc:endc) = spval -!!$ call hist_addfld1d (fname='RB_COL', units='s/m', & -!!$ avgflag='A', long_name='Column boundary layer resistance for grass pft', & -!!$ ptr_col=this%rb_col) -!!$ -!!$ this%fert_app_jday_col(begc:endc) = spval -!!$ call hist_addfld1d (fname='FERT_APP_JDAY', units='', & -!!$ avgflag='A', long_name='Fertilizer application julian day', & -!!$ ptr_col=this%fert_app_jday_col) -!!$ -!!$ this%no3_manure_col(begc:endc) = spval -!!$ call hist_addfld1d (fname='NO3_MANURE', units='gN/m^2', & -!!$ avgflag='A', long_name='NO3 Pool in Manure', & -!!$ ptr_col=this%no3_manure_col) -!!$ -!!$ this%n2o_manure_total_col(begc:endc) = spval -!!$ call hist_addfld1d (fname='N2O_MANURE_TOTAL', units='gN/m^2/yr', & -!!$ avgflag='A', long_name='TOTAL N2O emission from manure', & -!!$ ptr_col=this%n2o_manure_total_col) -!!$ -!!$ this%nox_manure_total_col(begc:endc) = spval -!!$ call hist_addfld1d (fname='NOx_MANURE_TOTAL', units='gN/m^2/yr', & -!!$ avgflag='A', long_name='TOTAL NOx emission from manure', & -!!$ ptr_col=this%nox_manure_total_col) -!!$ -!!$ this%nh3_manure_total_col(begc:endc) = spval -!!$ call hist_addfld1d (fname='NH3_MANURE_TOTAL', units='gN/m^2/yr', & -!!$ avgflag='A', long_name='TOTAL NH3 emission from manure', & -!!$ ptr_col=this%nh3_manure_total_col) -!!$ -!!$ this%ndep_total_col(begc:endc) = spval -!!$ call hist_addfld1d (fname='NDEP_TOTAL', units='gN/m^2/yr', & -!!$ avgflag='A', long_name='TOTAL N DEP from manure and fertilizer', & -!!$ ptr_col=this%ndep_total_col) -!!$ -!!$ this%N_Run_Off_manure_total_col(begc:endc) = spval -!!$ call hist_addfld1d (fname='N_RUN_OFF_MANURE_TOTAL', units='gN/m^2/yr', & -!!$ avgflag='A', long_name='Total N run off from manure', & -!!$ ptr_col=this%N_Run_Off_manure_total_col) -!!$ -!!$ this%nh4_manure_total_col(begc:endc) = spval -!!$ call hist_addfld1d (fname='NH4_MANURE_TOTAL', units='gN/m^2/yr', & -!!$ avgflag='A', long_name='Total NH4 from manure', & -!!$ ptr_col=this%nh4_manure_total_col) -!!$ -!!$ this%no3_manure_total_col(begc:endc) = spval -!!$ call hist_addfld1d (fname='NO3_MANURE_TOTAL', units='gN/m^2/yr', & -!!$ avgflag='A', long_name='Total NO3 from manure', & -!!$ ptr_col=this%no3_manure_total_col) -!!$ -!!$ this%nh3_fert_total_col(begc:endc) = spval -!!$ call hist_addfld1d (fname='NH3_FERT_TOTAL', units='gN/m^2/yr', & -!!$ avgflag='A', long_name='TOTAL NH3 emission from fertilizer', & -!!$ ptr_col=this%nh3_fert_total_col) -!!$ -!!$ this%ndep_fert_total_col(begc:endc) = spval -!!$ call hist_addfld1d (fname='NDEP_FERT_TOTAL', units='gN/m^2/yr', & -!!$ avgflag='A', long_name='TOTAL N DEP from FERTILIZER', & -!!$ ptr_col=this%ndep_fert_total_col) -!!$ -!!$ this%N_Run_Off_fert_total_col(begc:endc) = spval -!!$ call hist_addfld1d (fname='N_RUN_OFF_FERT_TOTAL', units='gN/m^2/yr', & -!!$ avgflag='A', long_name='Total N run off from fertilizer', & -!!$ ptr_col=this%N_Run_Off_fert_total_col) -!!$ -!!$ this%nh4_fert_total_col(begc:endc) = spval -!!$ call hist_addfld1d (fname='NH4_FERT_TOTAL', units='gN/m^2/yr', & -!!$ avgflag='A', long_name='Total NH4 from fertilizer', & -!!$ ptr_col=this%nh4_fert_total_col) -!!$ -!!$ this%no3_fert_total_col(begc:endc) = spval -!!$ call hist_addfld1d (fname='NO3_FERT_TOTAL', units='gN/m^2/yr', & -!!$ avgflag='A', long_name='Total NO3 from fertilizer', & -!!$ ptr_col=this%no3_fert_total_col) -!!$ -!!$ this%total_nh3_col(begc:endc) = spval -!!$ call hist_addfld1d (fname='TOTAL_NH3', units='gN/m^2/yr', & -!!$ avgflag='A', long_name='TOTAL NH3 emission from Nr', & -!!$ ptr_col=this%total_nh3_col) -!!$ -!!$ this%total_ndep_col(begc:endc) = spval -!!$ call hist_addfld1d (fname='TOTAL_NDEP', units='gN/m^2/yr', & -!!$ avgflag='A', long_name='TOTAL N DEP from Nr', & -!!$ ptr_col=this%total_ndep_col) -!!$ -!!$ this%total_N_Run_Off_col(begc:endc) = spval -!!$ call hist_addfld1d (fname='TOTAL_N_RUN_OFF', units='gN/m^2/yr', & -!!$ avgflag='A', long_name='Total N run off from Nr', & -!!$ ptr_col=this%total_N_Run_Off_col) -!!$ -!!$ this%total_nh4_col(begc:endc) = spval -!!$ call hist_addfld1d (fname='TOTAL_NH4', units='gN/m^2', & -!!$ avgflag='A', long_name='Total NH4 from Nr', & -!!$ ptr_col=this%total_nh4_col) -!!$ -!!$ this%total_no3_col(begc:endc) = spval -!!$ call hist_addfld1d (fname='TOTAL_NO3', units='gN/m^2', & -!!$ avgflag='A', long_name='Total NO3 from Nr', & -!!$ ptr_col=this%total_no3_col) -!!$ -!!$ end if -!!$!KO - !JV if (use_fan) then this%tan_g1_col(begc:endc) = spval @@ -791,7 +541,7 @@ subroutine InitCold(this, bounds, & this%totlitn_1m_col(c) = 0._r8 this%totsomn_1m_col(c) = 0._r8 this%cwdn_col(c) = 0._r8 -!KO + if ( use_fan ) then !JV this%tan_g1_col(c) = 0.0_r8 @@ -820,45 +570,7 @@ subroutine InitCold(this, bounds, & this%fan_grz_fract_col(c) = 0.0_r8 this%man_n_stored_col(c) = 0.0_r8 -!!$ this%TAN_manu_col(c) = 0._r8 -!!$ this%no3_manure_col(c) = 0._r8 -!!$ this%manure_u_col(c) = 0._r8 -!!$ this%manure_n_col(c) = 0._r8 -!!$ this%manure_a_col(c) = 0._r8 -!!$ this%manure_r_col(c) = 0._r8 -!!$ -!!$ this%n2o_manure_total_col(c) = 0._r8 -!!$ this%nox_manure_total_col(c) = 0._r8 -!!$ this%nh3_manure_total_col(c) = 0._r8 -!!$ this%N_Run_Off_manure_total_col(c) = 0._r8 -!!$ this%no3_manure_total_col(c) = 0._r8 -!!$ this%nh4_manure_total_col(c) = 0._r8 -!!$ this%ndep_total_col(c) = 0._r8 -!!$ this%smin_nh4_monthly_col(c) = 0._r8 -!!$ this%smin_no3_monthly_col(c) = 0._r8 -!!$ this%TAN_fert_col(c) = 0._r8 -!!$ this%no3_fert_col(c) = 0._r8 -!!$ this%man_water_pool_col(c) = 0._r8 -!!$ this%fert_water_pool_col(c) = 0._r8 -!!$ this%ra_col(c) = 0._r8 -!!$ this%rb_col(c) = 0._r8 -!!$ this%t_a10_col(c) = 0._r8 -!!$ this%gdd8_col(c) = 0._r8 -!!$ this%t_a10min_col(c) = 0._r8 -!!$ this%fert_app_jday_col(c) = 0._r8 -!!$ this%fert_u_col(c) = 0._r8 -!!$ this%nh3_fert_total_col(c) = 0._r8 -!!$ this%no3_fert_total_col(c) = 0._r8 -!!$ this%nh4_fert_total_col(c) = 0._r8 -!!$ this%ndep_fert_total_col(c) = 0._r8 -!!$ this%N_Run_Off_fert_total_col(c) = 0._r8 -!!$ this%total_nh3_col(c) = 0._r8 -!!$ this%total_N_Run_Off_col(c) = 0._r8 -!!$ this%total_no3_col(c) = 0._r8 -!!$ this%total_nh4_col(c) = 0._r8 -!!$ this%total_ndep_col(c) = 0._r8 end if -!KO end if end do @@ -985,167 +697,14 @@ subroutine Restart ( this, bounds, ncid, flag, totvegc_col ) dim1name='column', & long_name='', units='', & interpinic_flag='interp', readvar=readvar, data=ptr1d) -!KO -!!$ ! I don't think these have to be on the restart file since they are -!!$ ! computed at each time step and it doesn't depend on the previous -!!$ ! time step. Plus it should be outside the if/else use_vertsoilc -!!$ ! structure (just within the use_nitrif_denitrif structure) -!!$ if ( use_fan ) then -!!$ call restartvar(ncid=ncid, flag=flag, varname='smin_nh4_monthly', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%smin_nh4_monthly_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='smin_no3_monthly', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%smin_no3_monthly_col) -!!$ end if -!KO end if if (flag=='read' .and. .not. readvar) then call endrun(msg= 'ERROR:: smin_no3_vr'//' is required on an initialization dataset' ) end if end if -!KO if ( use_fan ) then -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='TAN_manu', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%TAN_manu_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='TAN_fert', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%TAN_fert_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='man_water_pool', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%man_water_pool_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='fert_water_pool', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%fert_water_pool_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='ra', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%ra_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='rb', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%rb_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='gdd8', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%gdd8_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='t_a10', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%t_a10_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='t_a10min', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%t_a10min_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='fert_app_jday', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%fert_app_jday_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='no3_manure', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%no3_manure_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='no3_fert', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%no3_fert_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='n2o_manure_total', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%n2o_manure_total_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='nox_manure_total', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%nox_manure_total_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='nh3_manure_total', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%nh3_manure_total_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='nh3_fert_total', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%nh3_fert_total_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='total_nh3', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%total_nh3_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='manure_u', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%manure_u_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='fert_u', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%fert_u_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='manure_n', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%manure_n_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='manure_a', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%manure_a_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='manure_r', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%manure_r_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='ndep_total', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%ndep_total_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='ndep_fert_total', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%ndep_fert_total_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='total_ndep', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%total_ndep_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='N_Run_Off_manure_total', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%N_Run_Off_manure_total_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='N_Run_Off_fert_total', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%N_Run_Off_fert_total_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='total_N_Run_Off', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%total_N_Run_Off_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='no3_manure_total', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%no3_manure_total_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='no3_fert_total', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%no3_fert_total_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='total_no3', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%total_no3_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='nh4_manure_total', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%nh4_manure_total_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='nh4_fert_total', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%nh4_fert_total_col) -!!$ -!!$ call restartvar(ncid=ncid, flag=flag, varname='total_nh4', xtype=ncd_double, & -!!$ dim1name='column', long_name='', units='', & -!!$ interpinic_flag='interp', readvar=readvar, data=this%total_nh4_col) - !JV call restartvar(ncid=ncid, flag=flag, varname='tan_g1', xtype=ncd_double, & dim1name='column', long_name='', units='', & interpinic_flag='interp', readvar=readvar, data=this%tan_g1_col) @@ -1221,7 +780,6 @@ subroutine Restart ( this, bounds, ncid, flag, totvegc_col ) !JV end if -!KO if (use_nitrif_denitrif) then ! smin_nh4 @@ -1415,60 +973,6 @@ subroutine SetValues ( this, num_column, filter_column, value_column ) this%totlitn_1m_col(i) = value_column end do -!KO -!!$ if ( use_fan ) then -!!$ do fi = 1,num_column -!!$ i = filter_column(fi) -!!$ if (use_nitrif_denitrif) then -!!$ this%smin_no3_monthly_col(i) = value_column -!!$ this%smin_nh4_monthly_col(i) = value_column -!!$ end if -!!$ end do -!!$ end if -!KO - -!KO -!!$ if ( use_fan ) then -!!$ do fi = 1,num_column -!!$ i = filter_column(fi) -!!$ this%TAN_manu_col(i) = value_column -!!$ this%no3_manure_col(i) = value_column -!!$ this%manure_u_col(i) = value_column -!!$ this%manure_n_col(i) = value_column -!!$ this%manure_a_col(i) = value_column -!!$ this%manure_r_col(i) = value_column -!!$ this%n2o_manure_total_col(i) = value_column -!!$ this%nox_manure_total_col(i) = value_column -!!$ this%nh3_manure_total_col(i) = value_column -!!$ this%N_Run_Off_manure_total_col(i) = value_column -!!$ this%nh4_manure_total_col(i) = value_column -!!$ this%no3_manure_total_col(i) = value_column -!!$ this%ndep_total_col(i) = value_column -!!$ this%fert_u_col(i) = value_column -!!$ this%no3_fert_col(i) = value_column -!!$ this%nh3_fert_total_col(i) = value_column -!!$ this%N_Run_Off_fert_total_col(i) = value_column -!!$ this%nh4_fert_total_col(i) = value_column -!!$ this%no3_fert_total_col(i) = value_column -!!$ this%ndep_fert_total_col(i) = value_column -!!$ this%total_nh3_col(i) = value_column -!!$ this%total_N_Run_Off_col(i) = value_column -!!$ this%total_nh4_col(i) = value_column -!!$ this%total_no3_col(i) = value_column -!!$ this%total_ndep_col(i) = value_column -!!$ this%TAN_fert_col(i) = value_column -!!$ this%man_water_pool_col(i) = value_column -!!$ this%fert_water_pool_col(i) = value_column -!!$ this%ra_col(i) = value_column -!!$ this%rb_col(i) = value_column -!!$ this%gdd8_col(i) = value_column -!!$ this%t_a10_col(i) = value_column -!!$ this%t_a10min_col(i) = value_column -!!$ this%fert_app_jday_col(i) = value_column -!!$ end do -!!$ end if -!KO - do j = 1,nlevdecomp_full do fi = 1,num_column i = filter_column(fi) @@ -1553,20 +1057,6 @@ subroutine Summary(this, bounds, num_allc, filter_allc) end do end do -!KO -!!$ if ( use_fan ) then -!!$ do fc = 1,num_allc -!!$ c = filter_allc(fc) -!!$ if (kda == 1 .and. mcsec == 0) then -!!$ this%smin_no3_monthly_col(c) = 0._r8 -!!$ this%smin_nh4_monthly_col(c) = 0._r8 -!!$ endif -!!$ -!!$ this%smin_no3_monthly_col(c) = this%smin_no3_col(c) -!!$ this%smin_nh4_monthly_col(c) = this%smin_nh4_col(c) -!!$ end do -!!$ end if -!KO end if From e82648d8654e25e85fd0a109fea938e272a227dc Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Fri, 15 Feb 2019 12:22:20 -0500 Subject: [PATCH 046/181] cleanup --- src/biogeochem/CNPhenologyMod.F90 | 1 - src/biogeochem/FanMod.F90 | 3 +-- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/src/biogeochem/CNPhenologyMod.F90 b/src/biogeochem/CNPhenologyMod.F90 index a414efa5fa..d9dd515b36 100644 --- a/src/biogeochem/CNPhenologyMod.F90 +++ b/src/biogeochem/CNPhenologyMod.F90 @@ -1947,7 +1947,6 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & hui(p) = max(hui(p),huigrain(p)) endif - !write(iulog,*) 'cropmodel, manu', manure_avail, manu(p) if (leafout(p) >= huileaf(p) .and. hui(p) < huigrain(p) .and. idpp < mxmat(ivt(p))) then cphase(p) = 2._r8 if (abs(onset_counter(p)) > 1.e-6_r8) then diff --git a/src/biogeochem/FanMod.F90 b/src/biogeochem/FanMod.F90 index e7c3e49b42..f509479ba9 100755 --- a/src/biogeochem/FanMod.F90 +++ b/src/biogeochem/FanMod.F90 @@ -769,7 +769,7 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend end do call update_pools(tanpools, fluxes, dt, numpools, 5, fixed) - !print *, 'pools just after', tanpools + tanpools = tanpools + tanprod*dt if(any(isnan(tanpools))) then status = err_nan+100 @@ -787,7 +787,6 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend return end if - if (abs(sum(tanpools - tanpools_old) + (sum(fluxes)-tandep_remaining-sum(tanprod))*dt + garbage) & > max(sum(tanpools_old)*1e-2, 1d-2)) then print *, tanpools, tanpools_old, 'fx', fluxes*dt, 'dp', tandep_remaining*dt, tanprod*dt, 'g', garbage, & From 290989c5fb38983fb5330d6480557f2f754bbb15 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Fri, 15 Feb 2019 13:40:27 -0700 Subject: [PATCH 047/181] animal housing (open/closed) modifications --- src/biogeochem/CNNDynamicsMod.F90 | 78 +++++++++++++++++++++---------- src/biogeochem/FanMod.F90 | 54 +++++++++++++++------ 2 files changed, 92 insertions(+), 40 deletions(-) diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index ac8f3367a1..756775580c 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -765,15 +765,15 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & integer , intent(in) :: filter_soilc(:) ! filter for soil columns integer :: begg, endg, g, l, c, il, counter, col_grass, status, p - real(r8) :: flux_avail, flux_grazing + real(r8) :: flux_avail_rum, flux_avail_mg, flux_grazing real(r8) :: tempr_ave, windspeed_ave ! windspeed and temperature averaged over agricultural patches real(r8) :: tempr_barns, tempr_stores, vent_barns, flux_grass_crop, tempr_min_10day, & flux_grass_graze, flux_grass_spread, flux_grass_spread_tan, flux_grass_crop_tan - real(r8) :: cumflux, totalinput - real(r8) :: fluxes_nitr(4), fluxes_tan(4) + real(r8) :: cumflux, totalinput, total_to_store + real(r8) :: fluxes_nitr(4,2), fluxes_tan(4,2) ! The fraction of manure applied continuously on grasslands (if present in the gridcell) real(r8), parameter :: fract_continuous = 0.1_r8, kg_to_g = 1e3_r8, max_grazing_fract = 0.65_r8, & - volat_coef_barns = 0.03_r8, volat_coef_stores = 0.025_r8, & + volat_coef_barns_open = 0.03_r8, volat_coef_barns_closed = 0.025, volat_coef_stores = 0.025_r8, & tempr_min_grazing = 283.0_r8!!!! begg = bounds%begg; endg = bounds%endg @@ -785,8 +785,6 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & cumflux = 0.0 do g = begg, endg - !totalinput = totalinput + ndep_mixed_grc(g) - ! First find out if there are grasslands in this cell. If yes, a fraction of ! manure can be diverted to them before storage. col_grass = ispval @@ -832,21 +830,23 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & if (tempr_min_10day > tempr_min_grazing) then ! fraction of animals grazing -> allocate some manure to grasslands before barns flux_grazing = max_grazing_fract * ndep_sgrz_grc(g) * kg_to_g / lun%wtgcell(l) - flux_avail = (ndep_ngrz_grc(g) + ndep_sgrz_grc(g)*(1.0_r8 - max_grazing_fract)) * kg_to_g / lun%wtgcell(l) + !flux_avail = (ndep_ngrz_grc(g) + ndep_sgrz_grc(g)*(1.0_r8 - max_grazing_fract)) * kg_to_g / lun%wtgcell(l) + flux_avail_rum = (ndep_sgrz_grc(g)*(1.0_r8 - max_grazing_fract)) * kg_to_g / lun%wtgcell(l) grz_fract(c) = max_grazing_fract else flux_grazing = 0.0_r8 - flux_avail = n_manure_mixed_col(c) + flux_avail_rum = ndep_sgrz_grc(g) * kg_to_g / lun%wtgcell(l) grz_fract(c) = 0.0_r8 end if + flux_avail_mg = ndep_ngrz_grc(g) * kg_to_g / lun%wtgcell(l) flux_grass_graze = flux_grass_graze + flux_grazing*col%wtgcell(c) - if (flux_avail > 1e12 .or. isnan(flux_avail)) then + if (flux_avail_rum > 1e12 .or. flux_avail_mg > 1e12 .or. isnan(flux_avail_mg) .or. isnan(flux_avail_rum)) then write(iulog, *) 'bad flux_avail', ndep_ngrz_grc(g), ndep_sgrz_grc(g), lun%wtgcell(l) call endrun('bad flux_avail') end if - totalinput = totalinput + flux_avail + totalinput = totalinput + flux_avail_rum + flux_avail_mg counter = 0 if (col_grass == c) call endrun('Something wrong with the indices') @@ -857,30 +857,58 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & tempr_ave = temperature_inst%t_ref2m_patch(col%patchi(c)) windspeed_ave = frictionvel_inst%u10_patch(col%patchi(c)) - man_n_barns(c) = flux_avail + man_n_barns(c) = flux_avail_rum + flux_avail_mg + - call eval_fluxes_storage(flux_avail, tempr_ave, windspeed_ave, 0.0_r8, & - volat_coef_barns, volat_coef_stores, tan_fract_excr, fluxes_nitr, fluxes_tan, status) - if (any(fluxes_nitr > 1e12)) then - write(iulog, *) 'bad fluxes', fluxes_nitr + ! Evaluate the NH3 losses, separate for ruminants (open barns) and others + ! (poultry and pigs, closed barns). Note the slicing of fluxes(:,:) and fluxes_tan(:,:). + man_n_transf(c) = flux_grazing + nh3_flux_stores(c) = 0.0 + + if (flux_avail_rum < 0) then + write(iulog, *) 'flux:', flux_avail_rum + call endrun(msg='negat flux_avail for ruminants') + end if + + ! Ruminants + call eval_fluxes_storage(flux_avail_rum, 'open', tempr_ave, windspeed_ave, 0.0_r8, & + volat_coef_barns_open, volat_coef_stores, tan_fract_excr, fluxes_nitr(:,1), fluxes_tan(:,1), status) + if (status /=0) then + write(iulog, *) 'status = ', status + call endrun(msg='eval_fluxes_storage failed for ruminants') end if + + ! Others + call eval_fluxes_storage(flux_avail_mg, 'closed', tempr_ave, windspeed_ave, 0.0_r8, & + volat_coef_barns_closed, volat_coef_stores, tan_fract_excr, fluxes_nitr(:,2), fluxes_tan(:,2), status) if (status /=0) then write(iulog, *) 'status = ', status - call endrun(msg='eval_fluxes_storage failed') + call endrun(msg='eval_fluxes_storage failed for other livestock') end if cumflux = cumflux + sum(fluxes_nitr) + if (any(isnan(fluxes_nitr))) then + write(iulog, *) 'fluxes 1', fluxes_nitr(:,1) + write(iulog, *) 'fluxes 2', fluxes_nitr(:,2) + call endrun('Nan in fluxes_nitr') + end if + if (any(isnan(fluxes_tan))) then + write(iulog, *) 'fluxes 1', fluxes_tan(:,1) + write(iulog, *) 'fluxes 2', fluxes_tan(:,2) + call endrun('Nan in fluxes_tan') + end if - if (fluxes_tan(iflx_to_store) < 0) then + if (fluxes_tan(iflx_to_store,1) < 0) then call endrun(msg="ERROR too much manure lost") end if - - flux_grass_spread = flux_grass_spread + fluxes_nitr(iflx_to_store)*col%wtgcell(c) - flux_grass_spread_tan = flux_grass_spread_tan + fluxes_tan(iflx_to_store)*col%wtgcell(c) - - man_n_transf(c) = flux_grazing + fluxes_nitr(iflx_to_store) - - nh3_flux_stores(c) = fluxes_nitr(iflx_air_stores) - nh3_flux_barns(c) = fluxes_nitr(iflx_air_barns) + ! Simplification as of 2019: no explicit manure storage. Flux to storage + ! will be spread "immediately". + total_to_store = sum(fluxes_nitr(iflx_to_store,:)) + flux_grass_spread = flux_grass_spread + total_to_store*col%wtgcell(c) + flux_grass_spread_tan = flux_grass_spread_tan + sum(fluxes_tan(iflx_to_store,:))*col%wtgcell(c) + man_n_transf(c) = man_n_transf(c) + total_to_store + + nh3_flux_stores(c) = sum(fluxes_nitr(iflx_air_stores,:)) + nh3_flux_barns(c) = sum(fluxes_nitr(iflx_air_barns,:)) end do ! column end if ! crop land unit diff --git a/src/biogeochem/FanMod.F90 b/src/biogeochem/FanMod.F90 index e7c3e49b42..1b1410bba7 100755 --- a/src/biogeochem/FanMod.F90 +++ b/src/biogeochem/FanMod.F90 @@ -49,7 +49,7 @@ module FanMod real(r8), parameter, public :: soildepth_reservoir = 0.04_r8 integer, parameter, public :: err_bad_theta = 1, err_negative_tan = 2, err_negative_flux = 3, & - err_balance_tan = 4, err_balance_nitr = 5, err_nan = 6, err_bad_subst = 7 + err_balance_tan = 4, err_balance_nitr = 5, err_nan = 6, err_bad_subst = 7, err_bad_type = 8 integer, parameter, public :: subst_tan = 1, subst_urea = 2 @@ -907,7 +907,7 @@ function eval_perc(waterloss, evap, precip, watertend, dt) result(rate) end function eval_perc - subroutine eval_fluxes_storage(nitr_input, tempr_outside, windspeed, fract_direct, & + subroutine eval_fluxes_storage(nitr_input, barntype, tempr_outside, windspeed, fract_direct, & volat_coef_barns, volat_coef_stores, & tan_fract_excr, fluxes_nitr, fluxes_tan, status) ! @@ -918,6 +918,7 @@ subroutine eval_fluxes_storage(nitr_input, tempr_outside, windspeed, fract_direc ! implicit none real(r8), intent(in) :: nitr_input ! total nitrogen excreted by animals in housings + character(len=*), intent(in) :: barntype ! "closed" (pigs, poultry) or "open" (others) real(r8), intent(in) :: tempr_outside ! K real(r8), intent(in) :: windspeed ! m/s real(r8), intent(in) :: fract_direct ! fraction of manure N applied before storage @@ -929,13 +930,16 @@ subroutine eval_fluxes_storage(nitr_input, tempr_outside, windspeed, fract_direc integer, intent(out) :: status ! see top of the module. ! parameters for the Gyldenkaerne et al. parameterization - real(r8), parameter :: Tfloor_barns = 4.0_8, Tfloor_stores = 1.0_8 - real(r8), parameter :: Tmin_barns = 0_8 - real(r8), parameter :: Tmax_barns = 12.5_8 - real(r8), parameter :: tempr_D = 3.0 - real(r8), parameter :: Vmin_barns = 0.2_8 - real(r8), parameter :: Vmax_barns = 0.228_8 - real(r8), parameter :: pA = 0.89_8, pB = 0.26_8 + real(r8), parameter :: Tfloor_barns = 4.0_r8, Tfloor_stores = 1.0_r8 + real(r8), parameter :: Tmin_barns = 0.01_r8 + real(r8), parameter :: Tmax_barns = 12.5_r8 + real(r8), parameter :: tempr_D = 3.0_r8 + real(r8), parameter :: Trec = 21.0_r8 + real(r8), parameter :: Vmin_barns = 0.2_r8 + !real(r8), parameter :: Vmax_barns = 0.228_r8 + real(r8), parameter :: pA = 0.89_r8, pB = 0.26_r8 + real(r8), parameter :: DTlow = 0.5_r8, DThigh = 1.0_r8 + real(r8) :: Vmax_barns ! depends on barntype real(r8) :: flux_avail, flux_avail_tan, tempr_stores, tempr_barns, vent_barns, flux_direct, flux_direct_tan, & & flux_barn, flux_store, tempr_C @@ -944,7 +948,26 @@ subroutine eval_fluxes_storage(nitr_input, tempr_outside, windspeed, fract_direc fluxes_tan = 0.0_r8 tempr_C = tempr_outside - 273 + select case(barntype) + case ('open') + Vmax_barns = 0.228_r8 tempr_barns = max(tempr_C+tempr_D, Tfloor_barns) + case ('closed') + Vmax_barns = 0.40_r8 + if (Trec + DTlow * (tempr_C - Tmin_barns) < Tmin_barns) then + tempr_barns = Tmin_barns + else if (tempr_C < Tmin_barns) then + tempr_barns = Trec + DTlow * (tempr_C - Tmin_barns) + else if (tempr_C > Tmax_barns) then + tempr_barns = Trec + DThigh * (tempr_C - Tmax_barns) + else + tempr_barns = Trec + end if + case default + status = err_bad_type + return + end select + if (tempr_C < Tmin_barns) then vent_barns = Vmin_barns else if (tempr_C > Tmax_barns) then @@ -957,12 +980,12 @@ subroutine eval_fluxes_storage(nitr_input, tempr_outside, windspeed, fract_direc flux_avail_tan = nitr_input * tan_fract_excr if (flux_avail < -1e-15 .or. flux_avail_tan < -1e-15) then - status = err_negative_flux + status = err_negative_flux*1000 return end if flux_barn = flux_avail_tan * volat_coef_barns * tempr_barns**pA * vent_barns**pB - + flux_barn = min(flux_avail_tan, flux_barn) ! hopefully uncommon fluxes_tan(iflx_air_barns) = flux_barn fluxes_nitr(iflx_air_barns) = flux_barn @@ -970,7 +993,8 @@ subroutine eval_fluxes_storage(nitr_input, tempr_outside, windspeed, fract_direc flux_avail_tan = flux_avail_tan - flux_barn if (flux_avail < 0 .or. flux_avail_tan < 0) then - status = err_negative_flux + !print *, flux_avail_tan, flux_avail, flux_barn, tempr_barns, vent_barns, tempr_C + status = err_negative_flux*10000 return end if @@ -993,7 +1017,7 @@ subroutine eval_fluxes_storage(nitr_input, tempr_outside, windspeed, fract_direc flux_avail = flux_avail - flux_store flux_avail_tan = flux_avail_tan - flux_store if (flux_avail < 0) then - status = err_negative_flux + status = err_negative_flux*10 return end if @@ -1011,7 +1035,7 @@ subroutine eval_fluxes_storage(nitr_input, tempr_outside, windspeed, fract_direc end if if (any(fluxes_nitr < 0) .or. any(fluxes_tan < 0)) then - status = err_negative_flux + status = err_negative_flux*100 return end if @@ -1140,7 +1164,7 @@ subroutine get_storage_fluxes_tan_ar(manure_excr, tempr_outside, windspeed, frac real(r8) :: fluxes_nitr(4), fluxes_tan(4) do ii = 1, nn - call eval_fluxes_storage(manure_excr(ii), tempr_outside(ii), windspeed(ii), fract_direct(ii), & + call eval_fluxes_storage(manure_excr(ii), 'open', tempr_outside(ii), windspeed(ii), fract_direct(ii), & & volat_coef_barns, volat_coef_stores, tan_fract_excr, & & fluxes_nitr, fluxes_tan, status) From bb9e526390fe218fc031aa9ce736fdfc6afb862b Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Fri, 15 Feb 2019 13:53:14 -0700 Subject: [PATCH 048/181] change cime to point at the fan-enabled version --- Externals.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals.cfg b/Externals.cfg index c4fc7c1728..91c24d3e44 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -30,7 +30,7 @@ required = True local_path = cime protocol = git repo_url = https://github.com/juliusvira/cime -branch = fancpl2 +branch = fancpl2-up-merge required = True [externals_description] From ec442876c581b1ffc5fea330c88f5b97a3bf3833 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 20 Feb 2019 10:45:02 -0700 Subject: [PATCH 049/181] Avoid referring unallocate array in land-only runs --- src/main/lnd2atmMod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/main/lnd2atmMod.F90 b/src/main/lnd2atmMod.F90 index c5968efbfa..4902462b1a 100644 --- a/src/main/lnd2atmMod.F90 +++ b/src/main/lnd2atmMod.F90 @@ -11,6 +11,7 @@ module lnd2atmMod use shr_log_mod , only : errMsg => shr_log_errMsg use shr_megan_mod , only : shr_megan_mechcomps_n use shr_fire_emis_mod , only : shr_fire_emis_mechcomps_n + use shr_fan_mod , only : shr_fan_to_atm use clm_varpar , only : numrad, ndst, nlevgrnd !ndst = number of dust bins. use clm_varcon , only : rair, grav, cpair, hfus, tfrz, spval use clm_varctl , only : iulog, use_lch4, use_fan @@ -320,7 +321,7 @@ subroutine lnd2atm(bounds, & end if ! nh3 flux - if (use_fan) then + if (shr_fan_to_atm) then call c2g(bounds, & sbgc_nf_inst%nh3_total_col (bounds%begc:bounds%endc), & lnd2atm_inst%flux_nh3_grc (bounds%begg:bounds%endg), & From ca71111d87f45148d47c4ec36199464a7abf3dcd Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 20 Feb 2019 10:45:29 -0700 Subject: [PATCH 050/181] Better checking for landunit indices --- src/biogeochem/CNNDynamicsMod.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index ee3f420200..79bfc16ccb 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -794,9 +794,11 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & col_grass = ispval do il = 1, max_lunit l = grc%landunit_indices(il, g) + if (l == ispval) cycle if (lun%itype(l) == istsoil) then do p = lun%patchi(l), lun%patchf(l) - if (patch%itype(p) == nc4_grass .or. patch%itype(p) == nc3_nonarctic_grass) then + if ((patch%itype(p) == nc4_grass .or. patch%itype(p) == nc3_nonarctic_grass) & + .and. col%wtgcell(patch%column(p)) > 1e-6) then col_grass = patch%column(p) exit end if @@ -804,7 +806,6 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & end if if (col_grass /= ispval) exit end do - if (col%wtgcell(col_grass) < 1e-6) col_grass = ispval ! Transfer of manure from all crop columns to the natural vegetation column: flux_grass_graze = 0_r8 flux_grass_spread = 0_r8 From bdcff24af1cda400238a5295a023176b578a23fb Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Fri, 22 Feb 2019 14:30:11 -0700 Subject: [PATCH 051/181] ndep2dyn_nml renamed to fan_nml and removed ndep3dyn_nml --- bld/CLMBuildNamelist.pm | 120 +++---------- bld/namelist_files/namelist_defaults_ctsm.xml | 90 +++------- .../namelist_definition_ctsm.xml | 58 ++---- bld/namelist_files/use_cases/2000_control.xml | 14 +- .../use_cases/20thC_transient.xml | 20 +-- src/main/clm_driver.F90 | 11 +- src/main/fanStreamMod.F90 | 170 ++++++++++-------- 7 files changed, 163 insertions(+), 320 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index acd2447088..99530f3dcb 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -1530,17 +1530,10 @@ sub process_namelist_inline_logic { ############################### setup_logic_nitrogen_deposition($opts, $nl_flags, $definition, $defaults, $nl); -#!KO - ################################ - # namelist group: ndep2dyn_nml # - ################################ - setup_logic_nitrogen_deposition2($opts, $nl_flags, $definition, $defaults, $nl, $physv); - ################################ - # namelist group: ndep3dyn_nml # + # namelist group: fan_nml # ################################ - setup_logic_nitrogen_deposition3($opts, $nl_flags, $definition, $defaults, $nl, $physv); -#!KO + setup_logic_fan_nml($opts, $nl_flags, $definition, $defaults, $nl, $physv); ################################## # namelist group: cnmresp_inparm # @@ -2875,7 +2868,6 @@ sub setup_logic_fan { # Flags to control FAN (Flow of Agricultural Nitrogen) nitrogen deposition (manure and fertilizer) # my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_; - print "FAN MODE: $opts->{'fan'}\n"; if ( $opts->{'fan'} ) { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_fan', 'use_cn'=>$nl_flags->{'use_cn'}, 'use_ed'=>$nl_flags->{'use_ed'} ); @@ -2883,7 +2875,6 @@ sub setup_logic_fan { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fan_nh3_to_atm', 'fan_mode'=>$opts->{'fan'}); $nl_flags->{'fan_nh3_to_atm'} = $nl->get_value('fan_nh3_to_atm'); - } if ( &value_is_true( $nl_flags->{'use_ed'} ) && &value_is_true( $nl_flags->{'use_fan'} ) ) { fatal_error("Cannot turn use_fan on when use_ed is on\n" ); @@ -3055,7 +3046,7 @@ sub setup_logic_nitrogen_deposition { #------------------------------------------------------------------------------- #!KO -sub setup_logic_nitrogen_deposition2 { +sub setup_logic_fan_nml { my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_; # @@ -3063,124 +3054,60 @@ sub setup_logic_nitrogen_deposition2 { # if ( $nl_flags->{'bgc_mode'} ne "none" && value_is_true( $nl_flags->{'use_fan'} ) ) { - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'ndep2mapalgo', 'phys'=>$nl_flags->{'phys'}, + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fan_mapalgo', 'phys'=>$nl_flags->{'phys'}, 'bgc'=>$nl_flags->{'bgc_mode'}, 'hgrid'=>$nl_flags->{'res'}, 'clm_accelerated_spinup'=>$nl_flags->{'clm_accelerated_spinup'} ); - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_first_ndep2', 'phys'=>$nl_flags->{'phys'}, + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_first_fan', 'phys'=>$nl_flags->{'phys'}, 'bgc'=>$nl_flags->{'bgc_mode'}, 'sim_year'=>$nl_flags->{'sim_year'}, 'sim_year_range'=>$nl_flags->{'sim_year_range'}); - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_last_ndep2', 'phys'=>$nl_flags->{'phys'}, + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_last_fan', 'phys'=>$nl_flags->{'phys'}, 'bgc'=>$nl_flags->{'bgc_mode'}, 'sim_year'=>$nl_flags->{'sim_year'}, 'sim_year_range'=>$nl_flags->{'sim_year_range'}); # Set align year, if first and last years are different - if ( $nl->get_value('stream_year_first_ndep2') != $nl->get_value('stream_year_last_ndep2') ) { - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'model_year_align_ndep2', 'sim_year'=>$nl_flags->{'sim_year'}, + if ( $nl->get_value('stream_year_first_fan') != $nl->get_value('stream_year_last_fan') ) { + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'model_year_align_fan', 'sim_year'=>$nl_flags->{'sim_year'}, 'sim_year_range'=>$nl_flags->{'sim_year_range'}); } - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_fldfilename_ndep2', 'phys'=>$nl_flags->{'phys'}, + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_fldfilename_fan', 'phys'=>$nl_flags->{'phys'}, 'bgc'=>$nl_flags->{'bgc_mode'}, 'hgrid'=>"360x720cru" ); } elsif ( $nl_flags->{'bgc_mode'} =~/cn|bgc/ && value_is_true( $nl_flags->{'use_fan'} ) ) { - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'ndep2mapalgo', 'phys'=>$nl_flags->{'phys'}, + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fan_mapalgo', 'phys'=>$nl_flags->{'phys'}, 'use_cn'=>$nl_flags->{'use_cn'}, 'hgrid'=>$nl_flags->{'res'}, 'clm_accelerated_spinup'=>$nl_flags->{'clm_accelerated_spinup'} ); - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_first_ndep2', 'phys'=>$nl_flags->{'phys'}, + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_first_fan', 'phys'=>$nl_flags->{'phys'}, 'use_cn'=>$nl_flags->{'use_cn'}, 'sim_year'=>$nl_flags->{'sim_year'}, 'sim_year_range'=>$nl_flags->{'sim_year_range'}); - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_last_ndep2', 'phys'=>$nl_flags->{'phys'}, + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_last_fan', 'phys'=>$nl_flags->{'phys'}, 'use_cn'=>$nl_flags->{'use_cn'}, 'sim_year'=>$nl_flags->{'sim_year'}, 'sim_year_range'=>$nl_flags->{'sim_year_range'}); # Set align year, if first and last years are different - if ( $nl->get_value('stream_year_first_ndep2') != $nl->get_value('stream_year_last_ndep2') ) { - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'model_year_align_ndep2', 'sim_year'=>$nl_flags->{'sim_year'}, + if ( $nl->get_value('stream_year_first_fan') != $nl->get_value('stream_year_last_fan') ) { + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'model_year_align_fan', 'sim_year'=>$nl_flags->{'sim_year'}, 'sim_year_range'=>$nl_flags->{'sim_year_range'}); } - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_fldfilename_ndep2', 'phys'=>$nl_flags->{'phys'}, + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_fldfilename_fan', 'phys'=>$nl_flags->{'phys'}, 'use_cn'=>$nl_flags->{'use_cn'}, 'hgrid'=>"360x720cru" ); } else { - # If bgc is NOT CN/CNDV then make sure none of the ndep2 settings are set! + # If bgc is NOT CN/CNDV then make sure none of the fan settings are set! if ( value_is_true( $nl_flags->{'use_fan'} ) ) { - if ( defined($nl->get_value('stream_year_first_ndep2')) || - defined($nl->get_value('stream_year_last_ndep2')) || - defined($nl->get_value('model_year_align_ndep2')) || - defined($nl->get_value('stream_fldfilename_ndep2')) + if ( defined($nl->get_value('stream_year_first_fan')) || + defined($nl->get_value('stream_year_last_fan')) || + defined($nl->get_value('model_year_align_fan')) || + defined($nl->get_value('stream_fldfilename_fan')) ) { - fatal_error("When bgc is NOT CN or CNDV none of: stream_year_first_ndep2," . - "stream_year_last_ndep2, model_year_align_ndep2, nor stream_fldfilename_ndep2" . + fatal_error("When bgc is NOT CN or CNDV none of: stream_year_first_fan," . + "stream_year_last_fan, model_year_align_fan, nor stream_fldfilename_fan" . " can be set!\n"); } } } } -#------------------------------------------------------------------------------- - -sub setup_logic_nitrogen_deposition3 { - my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_; - - # - # Nitrogen deposition3 for bgc=CN - # - - if ( $nl_flags->{'bgc_mode'} ne "none" && value_is_true( $nl_flags->{'use_fan'} ) ) { - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'ndep3mapalgo', 'phys'=>$nl_flags->{'phys'}, - 'bgc'=>$nl_flags->{'bgc_mode'}, 'hgrid'=>$nl_flags->{'res'}, - 'clm_accelerated_spinup'=>$nl_flags->{'clm_accelerated_spinup'} ); - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_first_ndep3', 'phys'=>$nl_flags->{'phys'}, - 'bgc'=>$nl_flags->{'bgc_mode'}, 'sim_year'=>$nl_flags->{'sim_year'}, - 'sim_year_range'=>$nl_flags->{'sim_year_range'}); - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_last_ndep3', 'phys'=>$nl_flags->{'phys'}, - 'bgc'=>$nl_flags->{'bgc_mode'}, 'sim_year'=>$nl_flags->{'sim_year'}, - 'sim_year_range'=>$nl_flags->{'sim_year_range'}); - - # Set align year, if first and last years are different - if ( $nl->get_value('stream_year_first_ndep3') != $nl->get_value('stream_year_last_ndep3') ) { - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'model_year_align_ndep3', 'sim_year'=>$nl_flags->{'sim_year'}, - 'sim_year_range'=>$nl_flags->{'sim_year_range'}); - } - - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_fldfilename_ndep3', 'phys'=>$nl_flags->{'phys'}, - 'bgc'=>$nl_flags->{'bgc_mode'}, - 'hgrid'=>"360x720cru" ); - - } elsif ( $nl_flags->{'bgc_mode'} =~/cn|bgc/ && value_is_true( $nl_flags->{'use_fan'} ) ) { - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'ndep3mapalgo', 'phys'=>$nl_flags->{'phys'}, - 'use_cn'=>$nl_flags->{'use_cn'}, 'hgrid'=>$nl_flags->{'res'}, - 'clm_accelerated_spinup'=>$nl_flags->{'clm_accelerated_spinup'} ); - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_first_ndep3', 'phys'=>$nl_flags->{'phys'}, - 'use_cn'=>$nl_flags->{'use_cn'}, 'sim_year'=>$nl_flags->{'sim_year'}, - 'sim_year_range'=>$nl_flags->{'sim_year_range'}); - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_last_ndep3', 'phys'=>$nl_flags->{'phys'}, - 'use_cn'=>$nl_flags->{'use_cn'}, 'sim_year'=>$nl_flags->{'sim_year'}, - 'sim_year_range'=>$nl_flags->{'sim_year_range'}); - # Set align year, if first and last years are different - if ( $nl->get_value('stream_year_first_ndep3') != $nl->get_value('stream_year_last_ndep3') ) { - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'model_year_align_ndep3', 'sim_year'=>$nl_flags->{'sim_year'}, - 'sim_year_range'=>$nl_flags->{'sim_year_range'}); - } - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_fldfilename_ndep3', 'phys'=>$nl_flags->{'phys'}, - 'use_cn'=>$nl_flags->{'use_cn'}, - 'hgrid'=>"360x720cru" ); - } else { - # If bgc is NOT CN/CNDV then make sure none of the ndep3 settings are set! - if ( value_is_true( $nl_flags->{'use_fan'} ) ) { - if ( defined($nl->get_value('stream_year_first_ndep3')) || - defined($nl->get_value('stream_year_last_ndep3')) || - defined($nl->get_value('model_year_align_ndep3')) || - defined($nl->get_value('stream_fldfilename_ndep3')) - ) { - fatal_error("When bgc is NOT CN or CNDV none of: stream_year_first_ndep3," . - "stream_year_last_ndep3, model_year_align_ndep3, nor stream_fldfilename_ndep3" . - " can be set!\n"); - } - } - } -} -#!KO #------------------------------------------------------------------------------- @@ -3732,8 +3659,7 @@ sub write_output_files { push @groups, "lifire_inparm"; push @groups, "ch4finundated"; push @groups, "clm_canopy_inparm"; - push @groups, "ndep2dyn_nml"; - push @groups, "ndep3dyn_nml"; + push @groups, "fan_nml"; my $outfile; $outfile = "$opts->{'dir'}/lnd_in"; diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 8ac6b8e9bd..04f9ce462d 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -1015,81 +1015,43 @@ lnd/clm2/surfdata_map/surfdata_ne120np4_78pfts_CMIP6_simyr1850_c170824.nc -2000 -2000 +2010 +2010 -2000 -2000 +2010 +2010 -2000 -2000 +2010 +2010 -2000 -2000 +2010 +2010 -2000 -2000 +2010 +2010 -2000 -2000 +2010 +2010 -2000 -2000 +2010 +2010 -2000 -2000 +2010 +2010 -/glade/p/cgd/tss/people/oleson/nitrogen/Nmanure.nc +nitrogen.nc -bilinear +bilinear -nn -nn -nn -nn -nn -nn -nn -nn +nn +nn +nn +nn +nn +nn +nn +nn - -2000 -2000 - -2000 -2000 - -2000 -2000 - -2000 -2000 - -2000 -2000 - -2000 -2000 - -2000 -2000 - -2000 -2000 - -/glade/p/cgd/tss/people/oleson/nitrogen/Nfert.nc - -bilinear - -nn -nn -nn -nn -nn -nn -nn -nn - .false. diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index 6571301648..270180473f 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -1554,33 +1554,32 @@ Mapping method from Nitrogen deposition input file to the model resolution copy = copy using the same indices - - + - + First year to loop over for FAN Nitrogen (manure) Deposition data - + Last year to loop over for FAN Nitrogen (manure) Deposition data - + Simulation year that aligns with stream_year_first_ndep2 value - + Filename of input stream data for FAN Nitrogen (manure) Deposition - + Mapping method from FAN Nitrogen (manure) deposition input file to the model resolution bilinear = bilinear interpolation nn = nearest neighbor @@ -1590,41 +1589,6 @@ Mapping method from FAN Nitrogen (manure) deposition input file to the model res copy = copy using the same indices - - - - - -First year to loop over for FAN Nitrogen (fertilizer) Deposition data - - - -Last year to loop over for FAN Nitrogen (fertilizer) Deposition data - - - -Simulation year that aligns with stream_year_first_ndep3 value - - - -Filename of input stream data for FAN Nitrogen (fertilizer) Deposition - - - -Mapping method from FAN Nitrogen (fertilizer) deposition input file to the model resolution - bilinear = bilinear interpolation - nn = nearest neighbor - nnoni = nearest neighbor on the "i" (longitude) axis - nnonj = nearest neighbor on the "j" (latitude) axis - spval = set to special value - copy = copy using the same indices - - diff --git a/bld/namelist_files/use_cases/2000_control.xml b/bld/namelist_files/use_cases/2000_control.xml index 1f70ffb924..e09939de17 100644 --- a/bld/namelist_files/use_cases/2000_control.xml +++ b/bld/namelist_files/use_cases/2000_control.xml @@ -18,17 +18,11 @@ 2000 2000 -2000 -2000 +2010 +2010 -2000 -2000 - -2000 -2000 - -2000 -2000 +2010 +2010 2000 2000 diff --git a/bld/namelist_files/use_cases/20thC_transient.xml b/bld/namelist_files/use_cases/20thC_transient.xml index 5731a6f7cf..f5f8244670 100644 --- a/bld/namelist_files/use_cases/20thC_transient.xml +++ b/bld/namelist_files/use_cases/20thC_transient.xml @@ -26,21 +26,13 @@ 2005 1850 -2000 -2000 -2000 +2010 +2010 +2010 -2000 -2000 -2000 - -2000 -2000 -2000 - -2000 -2000 -2000 +2010 +2010 +2010 1850 2016 diff --git a/src/main/clm_driver.F90 b/src/main/clm_driver.F90 index 1606e5ee07..52da99ba32 100644 --- a/src/main/clm_driver.F90 +++ b/src/main/clm_driver.F90 @@ -55,11 +55,6 @@ module clm_driver use SoilBiogeochemVerticalProfileMod , only : SoilBiogeochemVerticalProfile use SatellitePhenologyMod , only : SatellitePhenology, interpMonthlyVeg use ndepStreamMod , only : ndep_interp -!KO - !use ndep2StreamMod , only : ndep2_interp - !use ndep3StreamMod , only : ndep3_interp - - !KO use FanStreamMod , only : fanstream_interp use ActiveLayerMod , only : alt_calc use ch4Mod , only : ch4, ch4_init_balance_check @@ -385,12 +380,10 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate, ro call bgc_vegetation_inst%InterpFileInputs(bounds_proc) call t_stopf('bgc_interp') end if -!KO - if (use_cn .and. use_fan) then + + if (use_fan) then call fanstream_interp(bounds_proc, atm2lnd_inst) - !call ndep3_interp(bounds_proc, atm2lnd_inst) end if -!KO ! Get time varying urban data call urbantv_inst%urbantv_interp(bounds_proc) diff --git a/src/main/fanStreamMod.F90 b/src/main/fanStreamMod.F90 index 6796be76f1..9735458360 100644 --- a/src/main/fanStreamMod.F90 +++ b/src/main/fanStreamMod.F90 @@ -4,7 +4,7 @@ module FanStreamMod ! !DESCRIPTION: ! Contains methods for reading in FAN nitrogen deposition (in the form of ! manure) data file - ! Also includes functions for dynamic ndep2 file handling and + ! Also includes functions for fan stream file handling and ! interpolation. ! ! !USES @@ -37,9 +37,9 @@ module FanStreamMod ! ! PRIVATE TYPES type(shr_strdata_type) :: sdat_grz, sdat_sgrz, sdat_ngrz, sdat_urea, sdat_nitr, sdat_soilph ! input data streams - integer :: stream_year_first_ndep2 ! first year in stream to use - integer :: stream_year_last_ndep2 ! last year in stream to use - integer :: model_year_align_ndep2 ! align stream_year_firstndep2 with + integer :: stream_year_first_fan ! first year in stream to use + integer :: stream_year_last_fan ! last year in stream to use + integer :: model_year_align_fan ! align stream_year_firstndep2 with character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -70,169 +70,177 @@ subroutine fanstream_init(bounds, NLFilename) integer :: nu_nml ! unit for namelist file integer :: nml_error ! namelist i/o error flag type(mct_ggrid) :: dom_clm ! domain information - character(len=CL) :: stream_fldFileName_ndep2 - character(len=CL) :: ndep2mapalgo = 'bilinear' + character(len=CL) :: stream_fldFileName_fan + character(len=CL) :: fan_mapalgo = 'bilinear' character(*), parameter :: shr_strdata_unset = 'NOT_SET' character(*), parameter :: subName = "('ndep2dyn_init')" character(*), parameter :: F00 = "('(ndep2dyn_init) ',4a)" !----------------------------------------------------------------------- - namelist /ndep2dyn_nml/ & - stream_year_first_ndep2, & - stream_year_last_ndep2, & - model_year_align_ndep2, & - ndep2mapalgo, & - stream_fldFileName_ndep2 + namelist /fan_nml/ & + stream_year_first_fan, & + stream_year_last_fan, & + model_year_align_fan, & + fan_mapalgo, & + stream_fldFileName_fan ! Default values for namelist - stream_year_first_ndep2 = 1 ! first year in stream to use - stream_year_last_ndep2 = 1 ! last year in stream to use - model_year_align_ndep2 = 1 ! align stream_year_first_ndep2 with this model year - stream_fldFileName_ndep2 = ' ' + stream_year_first_fan = 1 ! first year in stream to use + stream_year_last_fan = 1 ! last year in stream to use + model_year_align_fan = 1 ! align stream_year_first_fan with this model year + stream_fldFileName_fan = ' ' - ! Read ndep2dyn_nml namelist + ! Read fandyn_nml namelist if (masterproc) then nu_nml = getavu() open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error ) - call shr_nl_find_group_name(nu_nml, 'ndep2dyn_nml', status=nml_error) + call shr_nl_find_group_name(nu_nml, 'fan_nml', status=nml_error) if (nml_error == 0) then - read(nu_nml, nml=ndep2dyn_nml,iostat=nml_error) + read(nu_nml, nml=fan_nml,iostat=nml_error) if (nml_error /= 0) then - call endrun(msg=' ERROR reading ndep2dyn_nml namelist'//errMsg(sourcefile, __LINE__)) + call endrun(msg=' ERROR reading fan_nml namelist'//errMsg(sourcefile, __LINE__)) end if else - call endrun(msg=' ERROR finding ndep2dyn_nml namelist'//errMsg(sourcefile, __LINE__)) + call endrun(msg=' ERROR finding fan_nml namelist'//errMsg(sourcefile, __LINE__)) end if close(nu_nml) call relavu( nu_nml ) endif - call shr_mpi_bcast(stream_year_first_ndep2, mpicom) - call shr_mpi_bcast(stream_year_last_ndep2, mpicom) - call shr_mpi_bcast(model_year_align_ndep2, mpicom) - call shr_mpi_bcast(stream_fldFileName_ndep2, mpicom) + call shr_mpi_bcast(stream_year_first_fan, mpicom) + call shr_mpi_bcast(stream_year_last_fan, mpicom) + call shr_mpi_bcast(model_year_align_fan, mpicom) + call shr_mpi_bcast(stream_fldFileName_fan, mpicom) if (masterproc) then write(iulog,*) ' ' write(iulog,*) 'ndep2dyn stream settings:' - write(iulog,*) ' stream_year_first_ndep2 = ',stream_year_first_ndep2 - write(iulog,*) ' stream_year_last_ndep2 = ',stream_year_last_ndep2 - write(iulog,*) ' model_year_align_ndep2 = ',model_year_align_ndep2 - write(iulog,*) ' stream_fldFileName_ndep2 = ',stream_fldFileName_ndep2 + write(iulog,*) ' stream_year_first_fan = ',stream_year_first_fan + write(iulog,*) ' stream_year_last_fan = ',stream_year_last_fan + write(iulog,*) ' model_year_align_fan = ',model_year_align_fan + write(iulog,*) ' stream_fldFileName_fan = ',stream_fldFileName_fan write(iulog,*) ' ' endif call clm_domain_mct (bounds, dom_clm) - call shr_strdata_create(sdat_grz,name="clmndep2grz", & + ! Manure N from year-round grazing livestock + ! + call shr_strdata_create(sdat_grz,name="clmfangrz", & pio_subsystem=pio_subsystem, & pio_iotype=shr_pio_getiotype(inst_name), & mpicom=mpicom, compid=comp_id, & gsmap=gsmap_lnd_gdc2glo, ggrid=dom_clm, & nxg=ldomain%ni, nyg=ldomain%nj, & - yearFirst=stream_year_first_ndep2, & - yearLast=stream_year_last_ndep2, & - yearAlign=model_year_align_ndep2, & + yearFirst=stream_year_first_fan, & + yearLast=stream_year_last_fan, & + yearAlign=model_year_align_fan, & offset=0, & domFilePath='', & - domFileName=trim(stream_fldFileName_ndep2), & + domFileName=trim(stream_fldFileName_fan), & domTvarName='time', & domXvarName='x' , & domYvarName='y' , & domAreaName='area', & domMaskName='mask', & filePath='', & - filename=(/trim(stream_fldFileName_ndep2)/),& + filename=(/trim(stream_fldFileName_fan)/),& fldListFile='manure_grz', & fldListModel='manure_grz', & fillalgo='none', & - mapalgo=ndep2mapalgo, & + mapalgo=fan_mapalgo, & calendar=get_calendar(), & taxmode='extend' ) if (masterproc) then - call shr_strdata_print(sdat_grz,'CLMNDEP2 data') + call shr_strdata_print(sdat_grz,'CLMFAN data') endif - call shr_strdata_create(sdat_sgrz,name="clmndep2sgrz", & + ! Manure N from seasonally grazing livestock + ! + call shr_strdata_create(sdat_sgrz,name="clmfansgrz", & pio_subsystem=pio_subsystem, & pio_iotype=shr_pio_getiotype(inst_name), & mpicom=mpicom, compid=comp_id, & gsmap=gsmap_lnd_gdc2glo, ggrid=dom_clm, & nxg=ldomain%ni, nyg=ldomain%nj, & - yearFirst=stream_year_first_ndep2, & - yearLast=stream_year_last_ndep2, & - yearAlign=model_year_align_ndep2, & + yearFirst=stream_year_first_fan, & + yearLast=stream_year_last_fan, & + yearAlign=model_year_align_fan, & offset=0, & domFilePath='', & - domFileName=trim(stream_fldFileName_ndep2), & + domFileName=trim(stream_fldFileName_fan), & domTvarName='time', & domXvarName='x' , & domYvarName='y' , & domAreaName='area', & domMaskName='mask', & filePath='', & - filename=(/trim(stream_fldFileName_ndep2)/),& + filename=(/trim(stream_fldFileName_fan)/),& fldListFile='manure_sgrz', & fldListModel='manure_sgrz', & fillalgo='none', & - mapalgo=ndep2mapalgo, & + mapalgo=fan_mapalgo, & calendar=get_calendar(), & taxmode='extend' ) if (masterproc) then - call shr_strdata_print(sdat_sgrz,'CLMNDEP2 data') + call shr_strdata_print(sdat_sgrz,'CLMFAN data') endif - call shr_strdata_create(sdat_ngrz,name="clmndep2ngrz", & + ! Manure N from non-grazing livestock + ! + call shr_strdata_create(sdat_ngrz,name="clmfanngrz", & pio_subsystem=pio_subsystem, & pio_iotype=shr_pio_getiotype(inst_name), & mpicom=mpicom, compid=comp_id, & gsmap=gsmap_lnd_gdc2glo, ggrid=dom_clm, & nxg=ldomain%ni, nyg=ldomain%nj, & - yearFirst=stream_year_first_ndep2, & - yearLast=stream_year_last_ndep2, & - yearAlign=model_year_align_ndep2, & + yearFirst=stream_year_first_fan, & + yearLast=stream_year_last_fan, & + yearAlign=model_year_align_fan, & offset=0, & domFilePath='', & - domFileName=trim(stream_fldFileName_ndep2), & + domFileName=trim(stream_fldFileName_fan), & domTvarName='time', & domXvarName='x' , & domYvarName='y' , & domAreaName='area', & domMaskName='mask', & filePath='', & - filename=(/trim(stream_fldFileName_ndep2)/),& + filename=(/trim(stream_fldFileName_fan)/),& fldListFile='manure_ngrz', & fldListModel='manure_ngrz', & fillalgo='none', & - mapalgo=ndep2mapalgo, & + mapalgo=fan_mapalgo, & calendar=get_calendar(), & taxmode='extend' ) if (masterproc) then - call shr_strdata_print(sdat_ngrz,'CLMNDEP2 data') + call shr_strdata_print(sdat_ngrz,'CLMFAN data') endif - call shr_strdata_create(sdat_urea,name="clmndep2urea", & + ! Fraction of urea N in synthetic fertilizer N + ! + call shr_strdata_create(sdat_urea,name="clmfanurea", & pio_subsystem=pio_subsystem, & pio_iotype=shr_pio_getiotype(inst_name), & mpicom=mpicom, compid=comp_id, & gsmap=gsmap_lnd_gdc2glo, ggrid=dom_clm, & nxg=ldomain%ni, nyg=ldomain%nj, & - yearFirst=stream_year_first_ndep2, & - yearLast=stream_year_last_ndep2, & - yearAlign=model_year_align_ndep2, & + yearFirst=stream_year_first_fan, & + yearLast=stream_year_last_fan, & + yearAlign=model_year_align_fan, & offset=0, & domFilePath='', & - domFileName=trim(stream_fldFileName_ndep2), & + domFileName=trim(stream_fldFileName_fan), & domTvarName='time', & domXvarName='x' , & domYvarName='y' , & domAreaName='area', & domMaskName='mask', & filePath='', & - filename=(/trim(stream_fldFileName_ndep2)/),& + filename=(/trim(stream_fldFileName_fan)/),& fldListFile='fract_urea', & fldListModel='fract_urea', & fillalgo='none', & @@ -241,28 +249,30 @@ subroutine fanstream_init(bounds, NLFilename) taxmode='extend' ) if (masterproc) then - call shr_strdata_print(sdat_urea,'CLMNDEP2 data') + call shr_strdata_print(sdat_urea,'CLMFAN data') endif - call shr_strdata_create(sdat_nitr,name="clmndep2nitr", & + ! Fraction of nitrate N in synthetic fertilizer N + ! + call shr_strdata_create(sdat_nitr,name="clmfannitr", & pio_subsystem=pio_subsystem, & pio_iotype=shr_pio_getiotype(inst_name), & mpicom=mpicom, compid=comp_id, & gsmap=gsmap_lnd_gdc2glo, ggrid=dom_clm, & nxg=ldomain%ni, nyg=ldomain%nj, & - yearFirst=stream_year_first_ndep2, & - yearLast=stream_year_last_ndep2, & - yearAlign=model_year_align_ndep2, & + yearFirst=stream_year_first_fan, & + yearLast=stream_year_last_fan, & + yearAlign=model_year_align_fan, & offset=0, & domFilePath='', & - domFileName=trim(stream_fldFileName_ndep2), & + domFileName=trim(stream_fldFileName_fan), & domTvarName='time', & domXvarName='x' , & domYvarName='y' , & domAreaName='area', & domMaskName='mask', & filePath='', & - filename=(/trim(stream_fldFileName_ndep2)/),& + filename=(/trim(stream_fldFileName_fan)/),& fldListFile='fract_nitr', & fldListModel='fract_nitr', & fillalgo='none', & @@ -270,25 +280,27 @@ subroutine fanstream_init(bounds, NLFilename) calendar=get_calendar(), & taxmode='extend' ) - call shr_strdata_create(sdat_soilph,name="clmndep2ph", & + ! Soil pH (to be moved to surface dataset) + ! + call shr_strdata_create(sdat_soilph,name="clmfanph", & pio_subsystem=pio_subsystem, & pio_iotype=shr_pio_getiotype(inst_name), & mpicom=mpicom, compid=comp_id, & gsmap=gsmap_lnd_gdc2glo, ggrid=dom_clm, & nxg=ldomain%ni, nyg=ldomain%nj, & - yearFirst=stream_year_first_ndep2, & - yearLast=stream_year_last_ndep2, & - yearAlign=model_year_align_ndep2, & + yearFirst=stream_year_first_fan, & + yearLast=stream_year_last_fan, & + yearAlign=model_year_align_fan, & offset=0, & domFilePath='', & - domFileName=trim(stream_fldFileName_ndep2), & + domFileName=trim(stream_fldFileName_fan), & domTvarName='time', & domXvarName='x' , & domYvarName='y' , & domAreaName='area', & domMaskName='mask', & filePath='', & - filename=(/trim(stream_fldFileName_ndep2)/),& + filename=(/trim(stream_fldFileName_fan)/),& fldListFile='soilph', & fldListModel='fansoilph', & fillalgo='none', & @@ -297,7 +309,7 @@ subroutine fanstream_init(bounds, NLFilename) taxmode='extend' ) if (masterproc) then - call shr_strdata_print(sdat_soilph,'CLMNDEP2 data') + call shr_strdata_print(sdat_soilph,'CLMFAN data') endif @@ -329,7 +341,7 @@ subroutine fanstream_interp(bounds, atm2lnd_inst) mcdate = year*10000 + mon*100 + day dayspyr = get_days_per_year( ) - call shr_strdata_advance(sdat_grz, mcdate, sec, mpicom, 'clmndep2grz') + call shr_strdata_advance(sdat_grz, mcdate, sec, mpicom, 'clmfangrz') ig = 0 do g = bounds%begg,bounds%endg @@ -337,7 +349,7 @@ subroutine fanstream_interp(bounds, atm2lnd_inst) atm2lnd_inst%forc_ndep_grz_grc(g) = sdat_grz%avs(1)%rAttr(1,ig) / (secspday * dayspyr) end do - call shr_strdata_advance(sdat_sgrz, mcdate, sec, mpicom, 'clmndep2sgrz') + call shr_strdata_advance(sdat_sgrz, mcdate, sec, mpicom, 'clmfansgrz') ig = 0 do g = bounds%begg,bounds%endg @@ -345,7 +357,7 @@ subroutine fanstream_interp(bounds, atm2lnd_inst) atm2lnd_inst%forc_ndep_sgrz_grc(g) = sdat_sgrz%avs(1)%rAttr(1,ig) / (secspday * dayspyr) end do - call shr_strdata_advance(sdat_ngrz, mcdate, sec, mpicom, 'clmndep2ngrz') + call shr_strdata_advance(sdat_ngrz, mcdate, sec, mpicom, 'clmfanngrz') ig = 0 do g = bounds%begg,bounds%endg @@ -353,7 +365,7 @@ subroutine fanstream_interp(bounds, atm2lnd_inst) atm2lnd_inst%forc_ndep_ngrz_grc(g) = sdat_ngrz%avs(1)%rAttr(1,ig) / (secspday * dayspyr) end do - call shr_strdata_advance(sdat_urea, mcdate, sec, mpicom, 'clmndep2urea') + call shr_strdata_advance(sdat_urea, mcdate, sec, mpicom, 'clmfanurea') ig = 0 do g = bounds%begg,bounds%endg @@ -361,7 +373,7 @@ subroutine fanstream_interp(bounds, atm2lnd_inst) atm2lnd_inst%forc_ndep_urea_grc(g) = sdat_urea%avs(1)%rAttr(1,ig) end do - call shr_strdata_advance(sdat_nitr, mcdate, sec, mpicom, 'clmndep2nitr') + call shr_strdata_advance(sdat_nitr, mcdate, sec, mpicom, 'clmfannitr') ig = 0 do g = bounds%begg,bounds%endg @@ -369,7 +381,7 @@ subroutine fanstream_interp(bounds, atm2lnd_inst) atm2lnd_inst%forc_ndep_nitr_grc(g) = sdat_nitr%avs(1)%rAttr(1,ig) end do - call shr_strdata_advance(sdat_soilph, mcdate, sec, mpicom, 'clmndep2ph') + call shr_strdata_advance(sdat_soilph, mcdate, sec, mpicom, 'clmfanph') ig = 0 do g = bounds%begg,bounds%endg From d11bf70d7ef197174151a7ec78650fc9c99c2636 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Mon, 4 Mar 2019 12:49:00 -0500 Subject: [PATCH 052/181] refractoring with fan2ctsm interface module + preparation for including FAN in N balance check --- src/biogeochem/CNNDynamicsMod.F90 | 757 +------------- src/biogeochem/Fan2CTSMMod.F90 | 963 ++++++++++++++++++ .../SoilBiogeochemNitrogenFluxType.F90 | 233 +++-- .../SoilBiogeochemNitrogenStateType.F90 | 17 +- 4 files changed, 1103 insertions(+), 867 deletions(-) create mode 100644 src/biogeochem/Fan2CTSMMod.F90 diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index 79bfc16ccb..c7d6b57ad7 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -148,13 +148,13 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & use shr_sys_mod , only : shr_sys_flush !KO use ColumnType , only: col use GridcellType , only: grc - use FanMod use clm_varctl , only : iulog use abortutils , only : endrun use pftconMod, only : nc4_grass, nc3_nonarctic_grass use landunit_varcon, only: istsoil, istcrop use clm_varcon, only : spval, ispval - + use fan2ctsm + type(bounds_type) , intent(in) :: bounds !KO integer , intent(in) :: num_soilc ! number of soil columns in filter @@ -175,49 +175,8 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & type(waterfluxbulk_type) , intent(in) :: waterfluxbulk_inst type(frictionvel_type) , intent(inout) :: frictionvel_inst - integer, parameter :: num_substeps = 4, balance_check_freq = 1000 - integer :: c, g, patchcounter, p, status, c1, c2, l, fc, ind_substep - real(r8) :: dt, ndep_org(3), orgpools(3), tanprod(3), watertend, fluxes(6,3), tanpools3(3), ratm, tandep, & - fluxes2(6,2), fluxes3(6,3), fluxes4(6,4), tanpools2(2), tanpools4(4), fluxes_tmp(6), garbage_total - real(r8), parameter :: water_init_grz = 0.006_r8, cnc_nh3_air = 0.0_r8, depth_slurry = 0.005_r8 - !real(r8), parameter :: fract_resist=0.225_r8, fract_unavail=0.025_r8, fract_avail=0.25_r8, fract_tan=0.6_r8 - - real(r8), parameter :: fract_tan=0.6_r8 ! of all N - real(r8), parameter :: fract_resist=0.45_r8, fract_unavail=0.05_r8, fract_avail=0.5_r8 ! of organic N - - real(r8), parameter :: dz_layer_fert = 0.02_r8, dz_layer_grz = 0.02_r8 - !real(r8), parameter :: fract_resist=0._r8, fract_unavail=0._r8, fract_avail=0._r8, fract_tan=1.0_r8 - real(r8), parameter :: fert_incorp_reduct = 0.25_r8 - real(r8), parameter :: slurry_infiltr_time = 6*3600.0_r8, water_init_fert = 1e-6 - real(r8), parameter :: & - poolranges_grz(3) = (/24*3600.0_r8, 10*24*3600.0_r8, 360*24*3600.0_r8/), & - poolranges_fert(3) = (/2.36*24*3600.0_r8, 24*3600.0_r8, 360*24*3600.0_r8/), & - poolranges_slr(4) = (/slurry_infiltr_time, 24*3600.0_r8, 10*24*3600.0_r8, 360*24*3600.0_r8/), & - !Hconc_grz(3) = (/10**(-8.5_r8), 10**(-8.0_r8), 10**(-7.0_r8)/), & - Hconc_fert(3) = (/10**(-7.0_r8), 10**(-8.5_r8), 10**(-8.0_r8)/) - - real(r8) :: Hconc_grz(3), Hconc_slr(4), pH_soil, pH_crop - real(r8) :: fert_inc_tan, fert_inc_no3 - !logical, parameter :: do_balance_checks = .false. - logical :: do_balance_checks - real(r8) :: tg, garbage, theta, thetasat, infiltr_m_s, evap_m_s, runoff_m_s, org_n_tot, & - nstored_old, nsoilman_old, nsoilfert_old, fert_to_air, fert_to_soil, fert_total, fert_urea, fert_tan, & - soilflux_org, urea_resid - real(r8) :: tanprod_from_urea(3), ureapools(2), fert_no3, fert_generic, bsw - !real(r8), parameter :: fract_urea=0.545, fract_no3=0.048 - real(r8) :: fract_urea, fract_no3, soilph_min, soilph_max, soilpsi - integer, parameter :: ind_region = 1 - integer :: def_ph_count + integer :: c, g - Hconc_grz(1:2) = (/10**(-8.5_r8), 10**(-8.0_r8)/) - Hconc_slr(1:3) = (/10.0_r8**(-8.0_r8), 10.0_r8**(-8.0_r8), 10.0_r8**(-8.0_r8)/) - - soilph_min = 999 - soilph_max = -999 - def_ph_count = 0 - dt = real( get_step_size(), r8 ) - do_balance_checks = mod(get_nstep(), balance_check_freq) == 0 - associate( & ! Input: [real(r8) (:)] nitrogen deposition rate (gN/m2/s) forc_ndep => atm2lnd_inst%forc_ndep_grc , & @@ -231,718 +190,8 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & end do end associate - associate(& - ngrz => soilbiogeochem_nitrogenflux_inst%man_n_grz_col, & - man_u_grz => soilbiogeochem_nitrogenstate_inst%man_u_grz_col, & - man_a_grz => soilbiogeochem_nitrogenstate_inst%man_a_grz_col, & - man_r_grz => soilbiogeochem_nitrogenstate_inst%man_r_grz_col, & - man_u_app => soilbiogeochem_nitrogenstate_inst%man_u_app_col, & - man_a_app => soilbiogeochem_nitrogenstate_inst%man_a_app_col, & - man_r_app => soilbiogeochem_nitrogenstate_inst%man_r_app_col, & - ns => soilbiogeochem_nitrogenstate_inst, & - nf => soilbiogeochem_nitrogenflux_inst, & - cnv_nf => cnveg_nitrogenflux_inst, & - ram1 => frictionvel_inst%ram1_patch, & - rb1 => frictionvel_inst%rb1_patch) - - nf%fert_n_appl_col(bounds%begc:bounds%endc) = 0.0 - nf%man_n_appl_col(bounds%begc:bounds%endc) = 0.0 - nf%man_tan_appl_col(bounds%begc:bounds%endc) = 0.0 - - call p2c(bounds, num_soilc, filter_soilc, & - cnv_nf%fert_patch(bounds%begp:bounds%endp), & - nf%fert_n_appl_col(bounds%begc:bounds%endc)) - call p2c(bounds, num_soilc, filter_soilc, & - cnv_nf%manu_patch(bounds%begp:bounds%endp), & - nf%man_n_appl_col(bounds%begc:bounds%endc)) - - if (any(nf%man_n_appl_col > 100)) then - write(iulog, *) maxval(nf%man_n_appl_col) - call endrun('bad man_n_appl_col') - end if - if (do_balance_checks) then - nstored_old = get_total_n(ns, nf, 'pools_storage') - nsoilman_old = get_total_n(ns, nf, 'pools_manure') - nsoilfert_old = get_total_n(ns, nf, 'pools_fertilizer') - end if - - ! Assign the "pastoral" manure entire to the natural vegetation column - do fc = 1, num_soilc - c = filter_soilc(fc) - l = col%landunit(c) - if (.not. (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop)) cycle - if (.not. col%active(c) .or. col%wtgcell(c) < 1e-6) cycle - g = col%gridcell(c) - if (lun%itype(l) == istsoil) then - ngrz(c) = atm2lnd_inst%forc_ndep_grz_grc(g) / col%wtgcell(c) * 1e3 ! kg to g - if (debug_fan) then - if (ngrz(c) > 1e12 .or. (isnan(ngrz(c)))) then - write(iulog, *) 'bad ngrz', atm2lnd_inst%forc_ndep_grz_grc(g), col%wtgcell(c) - call endrun('bad ngrz 1') - end if - end if - if (nf%man_n_appl_col(c) > 0) then - write(iulog, *) nf%man_n_appl_col(c) - call endrun(msg='Found fertilizer in soil column') - end if - else - ngrz(c) = 0.0 - end if - - end do - - if(debug_fan) then - write(iulog, *) 'nan count of storage 1', count(isnan(ns%man_n_stored_col)) - if (any(isnan(nf%man_n_appl_col))) then - call endrun('nan nh3 appl b') - end if - end if - - call handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & - atm2lnd_inst%forc_ndep_sgrz_grc, atm2lnd_inst%forc_ndep_ngrz_grc, & - ns%man_n_stored_col, ns%man_tan_stored_col, & - nf%man_n_appl_col, nf%man_tan_appl_col, & - nf%man_n_grz_col, nf%man_n_mix_col, & - nf%nh3_stores_col, nf%nh3_barns_col, & - nf%man_n_transf_col, ns%fan_grz_fract_col, & - nf%man_n_barns_col, & - fract_tan, & - filter_soilc, num_soilc) - - if (debug_fan) then - if (any(isnan(nf%nh3_stores_col))) then - call endrun('nan nh3 stores') - end if - if (any(isnan(nf%nh3_barns_col))) then - call endrun('nan nh3 barns') - end if - if (any(isnan(nf%man_n_appl_col))) then - call endrun('nan nh3 appl') - end if - if (any(isnan(nf%man_n_mix_col))) then - call endrun('nan nh3 appl') - end if - end if - - do fc = 1, num_soilc - c = filter_soilc(fc) - l = col%landunit(c) - g = col%gridcell(c) - if (.not. (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop)) cycle - if (.not. col%active(c) .or. col%wtgcell(c) < 1e-15) cycle - - if (nf%man_n_appl_col(c) > 1e12 .or. ngrz(c) > 1e12) then - write(iulog, *) c, nf%man_n_appl_col(c), ngrz(c), cnv_nf%fert_patch(col%patchi(c):col%patchf(c)), & - cnv_nf%manu_patch(col%patchi(c):col%patchf(c)) - call endrun('nf%man_n_appl_col(c) is spval') - end if - - ! Find and average the atmospheric resistances Rb and Ra. - ! - if (lun%itype(col%landunit(c)) == istcrop) then - ! for column, only one patch - p = col%patchi(c) - if (p /= col%patchf(c)) call endrun(msg='Strange patch for crop') - ratm = ram1(p) + rb1(p) - else - ! if natural, find average over grasses - ratm = 0.0 - patchcounter = 0 - do p = col%patchi(c), col%patchf(c) - if (patch%itype(p) == nc4_grass .or. patch%itype(p) == nc3_nonarctic_grass) then - if (.not. patch%active(p) .or. ram1(p) == spval .or. rb1(p) == spval) cycle - ratm = ratm + ram1(p) + rb1(p) - patchcounter = patchcounter + 1 - end if - end do - if (patchcounter > 0) then - ratm = ratm / patchcounter - else - ! grass not found, take something. - do p = col%patchi(c), col%patchf(c) - if (.not. patch%active(p) .or. ram1(p) == spval .or. rb1(p) == spval) cycle - ratm = ram1(p) + rb1(p) - exit - end do - if (p == col%patchf(c) + 1) then - ratm = 150.0_r8 - end if - end if - ns%fan_grz_fract_col(c) = 1.0_r8 ! for crops handled by handle_storage - end if - - ! Calculation of the water fluxes should include the background soil moisture - ! tendency. However, it is unclear how to do this in a numerically consistent - ! way. Following a naive finite differencing approach led to worse agreement in - ! stand-alone simulations so the term is currenltly neglected here. - watertend = 0.0_r8 - - ! use the calculated tend - watertend = waterstatebulk_inst%h2osoi_tend_tsl_col(c) * 1e-3 ! to meters/sec (ie. m3/m2/s) - - tg = temperature_inst%t_grnd_col(c) - theta = waterstatebulk_inst%h2osoi_vol_col(c,1) - thetasat = soilstate_inst%watsat_col(c,1) - bsw = soilstate_inst%bsw_col(c,1) - theta = min(theta, 0.98_r8*thetasat) - infiltr_m_s = max(waterfluxbulk_inst%qflx_infl_col(c), 0.0) * 1e-3 - evap_m_s = waterfluxbulk_inst%qflx_evap_grnd_col(c) * 1e-3 - runoff_m_s = max(waterfluxbulk_inst%qflx_runoff_col(c), 0.0) * 1e-3 - soilpsi = soilstate_inst%soilpsi_col(c,1) - - ! - ! grazing - ! - - ndep_org(ind_avail) = ngrz(c) * (1.0_r8-fract_tan) * fract_avail - ndep_org(ind_resist) = ngrz(c) * (1.0_r8-fract_tan) * fract_resist - ndep_org(ind_unavail) = ngrz(c) * (1.0_r8-fract_tan) * fract_unavail - tandep = ngrz(c) * fract_tan - - orgpools(ind_avail) = man_a_grz(c) - orgpools(ind_resist) = man_r_grz(c) - orgpools(ind_unavail) = man_u_grz(c) - call update_org_n(ndep_org, tg, soilpsi, orgpools, dt, tanprod, soilflux_org) - man_a_grz(c) = orgpools(ind_avail) - man_r_grz(c) = orgpools(ind_resist) - man_u_grz(c) = orgpools(ind_unavail) - - tanpools3(1) = ns%tan_g1_col(c) - tanpools3(2) = ns%tan_g2_col(c) - tanpools3(3) = ns%tan_g3_col(c) - if (any(isnan(tanpools3))) then - call endrun('nan1') - end if - - ph_soil = atm2lnd_inst%forc_soilph_grc(g) - if (ph_soil < 3.0) then - ph_soil = 6.5_r8 - def_ph_count = def_ph_count + 1 - end if - Hconc_grz(3) = 10**-(ph_soil) - soilph_max = max(soilph_max, ph_soil) - soilph_min = min(soilph_min, ph_soil) - - fluxes_tmp = 0.0 - garbage_total = 0.0 - fluxes3 = 0.0 - garbage = 0 - do ind_substep = 1, num_substeps - call update_npool(tg, ratm, & - theta, thetasat, infiltr_m_s, evap_m_s, & - wateratm2lndbulk_inst%forc_q_downscaled_col(c), watertend, & - runoff_m_s, tandep, (/0.0_r8, 0.0_r8, sum(tanprod)/), water_init_grz, & - bsw, poolranges_grz, Hconc_grz, dz_layer_grz, tanpools3, & - fluxes3(1:5,:), garbage, dt/num_substeps, status, 3) - if (status /= 0) then - write(iulog, *) 'status = ', status, tanpools2, ratm, theta, thetasat, tandep, tanprod - call endrun(msg='update_npool status /= 0') - end if - if (debug_fan .and. any(isnan(tanpools2))) then - call endrun('nan2') - end if - fluxes_tmp = fluxes_tmp + sum(fluxes3, dim=2) - garbage_total = garbage_total + garbage - end do - fluxes_tmp = fluxes_tmp / num_substeps - - ns%tan_g1_col(c) = tanpools3(1) - ns%tan_g2_col(c) = tanpools3(2) - ns%tan_g3_col(c) = tanpools3(3) - if (debug_fan .and. any(isnan(fluxes3))) then - write(iulog, *) fluxes3 - call endrun('nan3') - end if - - nf%nh3_grz_col(c) = fluxes_tmp(iflx_air) - nf%manure_runoff_col(c) = fluxes_tmp(iflx_roff) - nf%manure_no3_prod_col(c) = fluxes_tmp(iflx_no3) - nf%manure_nh4_to_soil_col(c) & - = fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) + garbage_total / dt + soilflux_org - - ! - ! Manure application - ! - - org_n_tot = nf%man_n_appl_col(c) - nf%man_tan_appl_col(c) - ! Use the the same fractionation of organic N as for grazing, after removing the - ! "explicitly" calculated TAN. - ndep_org(ind_avail) = org_n_tot * fract_avail - ndep_org(ind_resist) = org_n_tot * fract_resist - ndep_org(ind_unavail) = org_n_tot * fract_unavail - tandep = nf%man_tan_appl_col(c) - - orgpools(ind_avail) = man_a_app(c) - orgpools(ind_resist) = man_r_app(c) - orgpools(ind_unavail) = man_u_app(c) - call update_org_n(ndep_org, tg, soilpsi, orgpools, dt, tanprod, soilflux_org) - man_a_app(c) = orgpools(ind_avail) - man_r_app(c) = orgpools(ind_resist) - man_u_app(c) = orgpools(ind_unavail) - tanpools4(1) = ns%tan_s0_col(c) - tanpools4(2) = ns%tan_s1_col(c) - tanpools4(3) = ns%tan_s2_col(c) - tanpools4(4) = ns%tan_s3_col(c) - - ph_crop = min(max(ph_soil, 5.5_r8), 7.5_r8) - Hconc_slr(4) = 10**-(ph_crop) - - if (debug_fan .and. any(isnan(tanpools4))) then - call endrun('nan31') - end if - - fluxes_tmp = 0.0 - garbage_total = 0.0 - fluxes4 = 0.0 - do ind_substep = 1, num_substeps - if (debug_fan .and. any(abs(tanpools4) > 1e12)) then - write(iulog, *) ind_substep, tanpools4, tandep, nf%fert_n_appl_col(c), & - nf%man_n_appl_col(c), ns%man_n_stored_col(c), ns%man_tan_stored_col(c) - call endrun('bad tanpools (manure app)') - end if - - call update_4pool(tg, ratm, theta, thetasat, infiltr_m_s, evap_m_s, & - wateratm2lndbulk_inst%forc_q_downscaled_col(c), watertend, & - runoff_m_s, tandep, sum(tanprod), bsw, depth_slurry, & - poolranges_slr, tanpools4, Hconc_slr, fluxes4(1:5,:), garbage, dt / num_substeps, status) - if (status /= 0) then - write(iulog, *) 'status = ', status, tanpools4, tg, ratm, 'th', theta, & - thetasat, tandep, 'tp', tanprod, 'fx', fluxes4 - call endrun(msg='update_3pool status /= 0') - end if - fluxes_tmp = fluxes_tmp + sum(fluxes4, dim=2) - garbage_total = garbage_total + garbage - end do - fluxes_tmp = fluxes_tmp / num_substeps - - ns%tan_s0_col(c) = tanpools4(1) - ns%tan_s1_col(c) = tanpools4(2) - ns%tan_s2_col(c) = tanpools4(3) - ns%tan_s3_col(c) = tanpools4(4) - - if (debug_fan .and. any(isnan(fluxes4))) then - write(iulog, *) fluxes3, tanpools4,ratm, theta, thetasat, infiltr_m_s, tandep, tanprod - call endrun('nan4') - end if - - nf%nh3_man_app_col(c) = fluxes_tmp(iflx_air) - nf%manure_runoff_col(c) = nf%manure_runoff_col(c) + fluxes_tmp(iflx_roff) - nf%manure_no3_prod_col(c) = nf%manure_no3_prod_col(c) + fluxes_tmp(iflx_no3) - nf%manure_nh4_to_soil_col(c) & - = nf%manure_nh4_to_soil_col(c) + fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) & - + garbage_total / dt + soilflux_org - - ! - ! Fertilizer - ! - - ! Fraction available for volatilization - fert_total = nf%fert_n_appl_col(c) - - fract_urea = atm2lnd_inst%forc_ndep_urea_grc(g) - fract_no3 = atm2lnd_inst%forc_ndep_nitr_grc(g) - - ! Fractions made unavailable by mechanical incorporation, will be added to the - ! to-soil flux (tan) or no3 production (no3) below. - fert_inc_tan = fert_total * fert_incorp_reduct * (1.0 - fract_no3) - fert_inc_no3 = fert_total * fert_incorp_reduct * fract_no3 - - if (fract_urea < 0 .or. fract_no3 < 0 .or. fract_urea + fract_no3 > 1) then - call endrun('bad fertilizer fractions') - end if - - fert_urea = fert_total * fract_urea * (1.0_r8 - fert_incorp_reduct) - - ! Include the incorporated NO3 fertilizer to the no3 flux - fert_no3 = fert_total * fract_no3 - - !fert_generic = (fert_total - fert_urea - fert_no3) * (1.0_r8 - fert_incorp_reduct) - fert_generic = fert_total * (1.0_r8 - fract_urea - fract_no3) * (1.0_r8 - fert_incorp_reduct) - - nf%otherfert_n_appl_col(c) = fert_total * (1.0_r8 - fract_urea) !fert_no3 + fert_generic - - ! Urea decomposition - ! - ureapools(1) = ns%fert_u0_col(c) - ureapools(2) = ns%fert_u1_col(c) - fluxes2 = 0.0 - call update_urea(tg, theta, thetasat, infiltr_m_s, evap_m_s, watertend, & - runoff_m_s, fert_urea, bsw, ureapools, fluxes2, urea_resid, poolranges_fert(1:2), & - dt, status, numpools=2) - if (status /= 0) then - call endrun(msg='Bad status after update_urea for fertilizer') - end if - ! Nitrogen fluxes from urea pool. Be sure to not zero below! - fluxes_tmp = sum(fluxes2, dim=2) - - ns%fert_u0_col(c) = ureapools(1) - ns%fert_u1_col(c) = ureapools(2) - ! Collect the formed ammonia for updating the TAN pools - tanprod_from_urea(1:2) = fluxes2(iflx_to_tan, 1:2) - tanprod_from_urea(2) = tanprod_from_urea(2) - ! There is no urea pool corresponding to tan_f2, because most of the urea will - ! have decomposed. Here whatever remains gets sent to tan_f2. - tanprod_from_urea(3) = urea_resid / dt - - tanpools3(1) = ns%tan_f0_col(c) - tanpools3(2) = ns%tan_f1_col(c) - tanpools3(3) = ns%tan_f2_col(c) - garbage_total = 0.0 - fluxes3 = 0.0 - nf%nh3_otherfert_col(c) = 0.0 - do ind_substep = 1, num_substeps - ! Fertilizer pools f0...f2 - call update_npool(tg, ratm, theta, thetasat, infiltr_m_s, evap_m_s, & - wateratm2lndbulk_inst%forc_q_downscaled_col(c), watertend, & - runoff_m_s, 0.0_r8, tanprod_from_urea, water_init_fert, bsw, & - poolranges_fert, Hconc_fert, dz_layer_fert, tanpools3, fluxes3(1:5,:), & - garbage, dt/num_substeps, status, numpools=3) - if (status /= 0) then - write(iulog, *) 'status:', status, tanpools3, nf%fert_n_appl_col(c) - call endrun(msg='Bad status after npool for fertilizer') - end if - fluxes_tmp = fluxes_tmp + sum(fluxes3, dim=2) / num_substeps - garbage_total = garbage_total + garbage - - ! Fertilizer pool f3 - call update_npool(tg, ratm, theta, thetasat, infiltr_m_s, evap_m_s, & - wateratm2lndbulk_inst%forc_q_downscaled_col(c), watertend, & - runoff_m_s, fert_generic, (/0.0_r8/), water_init_fert, bsw, & - !(/360*24*3600.0_r8/), (/10**(-6.0_r8)/), dz_layer_fert, ns%tan_f3_col(c:c), fluxes3(1:5,1:1), & - (/360*24*3600.0_r8/), (/10**(-ph_crop)/), dz_layer_fert, ns%tan_f3_col(c:c), fluxes3(1:5,1:1), & - garbage, dt/num_substeps, status, numpools=1) - if (status /= 0) then - write(iulog, *) 'status:', status, tanpools3, nf%fert_n_appl_col(c) - call endrun(msg='Bad status after npool for generic') - end if - fluxes_tmp = fluxes_tmp + fluxes3(:, 1) / num_substeps - garbage_total = garbage_total + garbage - nf%nh3_otherfert_col(c) = nf%nh3_otherfert_col(c) + fluxes3(iflx_air, 1) / num_substeps - end do - - ns%tan_f0_col(c) = tanpools3(1) - ns%tan_f1_col(c) = tanpools3(2) - ns%tan_f2_col(c) = tanpools3(3) - ! !!tan_f3_col already updated above by update_npool!! - - nf%nh3_fert_col(c) = fluxes_tmp(iflx_air) - nf%fert_runoff_col(c) = fluxes_tmp(iflx_roff) - nf%fert_no3_prod_col(c) = fluxes_tmp(iflx_no3) + fert_no3 - nf%fert_nh4_to_soil_col(c) = fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) + garbage_total/dt + fert_inc_tan - - ! Total flux - ! - nf%nh3_total_col(c) = nf%nh3_fert_col(c) + nf%nh3_man_app_col(c) & - + nf%nh3_grz_col(c) + nf%nh3_stores_col(c) + nf%nh3_barns_col(c) - if (nf%nh3_total_col(c) < -1e15) then - call endrun(msg='ERROR: FAN, negative total emission') - end if - end do - - if (do_balance_checks) then - call balance_check('Storage', nstored_old, & - get_total_n(ns, nf, 'pools_storage'), get_total_n(ns, nf, 'fluxes_storage')) - call balance_check('Manure', nsoilman_old, & - get_total_n(ns, nf, 'pools_manure'), get_total_n(ns, nf, 'fluxes_manure')) - call balance_check('Fertilizer', nsoilfert_old, & - get_total_n(ns, nf, 'pools_fertilizer'), get_total_n(ns, nf, 'fluxes_fertilizer')) - write(iulog, *) 'SoilPH check:', soilph_min, soilph_max, def_ph_count - end if - - end associate - - contains - - real(r8) function get_total_n(ns, nf, which) result(total) - type(soilbiogeochem_nitrogenstate_type), intent(in) :: ns - type(soilbiogeochem_nitrogenflux_type), intent(in) :: nf - character(len=*), intent(in) :: which - - total = 0 - - associate(soilc => filter_soilc(1:num_soilc)) - - select case(which) - case('pools_storage') - total = sum(ns%man_n_stored_col(soilc)) - - case('fluxes_storage') - total = sum(nf%man_n_mix_col(soilc)) - total = total - sum(nf%nh3_stores_col(soilc)) - total = total - sum(nf%nh3_barns_col(soilc)) - sum(nf%man_n_transf_col(soilc)) - - case('pools_manure') - total = total + sum(ns%tan_g1_col(soilc)) + sum(ns%tan_g2_col(soilc)) + sum(ns%tan_g3_col(soilc)) - total = total + sum(ns%man_u_grz_col(soilc)) & - + sum(ns%man_a_grz_col(soilc)) + sum(ns%man_r_grz_col(soilc)) - total = total + sum(ns%tan_s0_col(soilc)) & - + sum(ns%tan_s1_col(soilc)) + sum(ns%tan_s2_col(soilc)) + sum(ns%tan_s3_col(soilc)) - total = total + sum(ns%man_u_app_col(soilc)) & - + sum(ns%man_a_app_col(soilc)) + sum(ns%man_r_app_col(soilc)) - - case('fluxes_manure') - total = sum(nf%man_n_grz_col(soilc)) + sum(nf%man_n_appl_col(soilc)) - total = total - sum(nf%nh3_man_app_col(soilc)) & - - sum(nf%nh3_grz_col(soilc)) - sum(nf%manure_runoff_col(soilc)) - total = total - sum(nf%manure_no3_prod_col(soilc)) - sum(nf%manure_nh4_to_soil_col(soilc)) - - case('pools_fertilizer') - total = sum(ns%tan_f0_col((soilc))) + sum(ns%tan_f1_col((soilc))) + sum(ns%tan_f2_col(soilc)) & - + sum(ns%tan_f3_col(soilc)) - total = total + sum(ns%fert_u0_col(soilc)) + sum(ns%fert_u1_col(soilc)) - - case('fluxes_fertilizer') - total = sum(nf%fert_n_appl_col(soilc)) - total = total - sum(nf%nh3_fert_col(soilc)) - sum(nf%fert_runoff_col(soilc)) - total = total - sum(nf%fert_no3_prod_col(soilc)) - sum(nf%fert_nh4_to_soil_col(soilc)) - - case default - call endrun(msg='Bad argument to get_total_n') - - end select - - end associate - - end function get_total_n - - subroutine balance_check(label, total_old, total_new, flux) - ! Check and report that the net flux equals the accumulated mass in pools. The - ! total pools and fluxes can be evaluated by the function get_total_n. - character(len=*), intent(in) :: label - real(r8), intent(in) :: total_old, total_new, flux - - real(r8) :: diff, accflux - real(r8) :: tol = 1e-6_r8 - - diff = total_new - total_old - accflux = flux*dt - write(iulog, *) 'Balance check:', label, diff, accflux - - end subroutine balance_check - end subroutine CNNDeposition - - subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & - ndep_sgrz_grc, ndep_ngrz_grc, n_stored_col, tan_stored_col, & - n_manure_spread_col, tan_manure_spread_col, & - n_manure_graze_col, n_manure_mixed_col, & - nh3_flux_stores, nh3_flux_barns, man_n_transf, & - grz_fract, man_n_barns, tan_fract_excr, & - filter_soilc, num_soilc) - use landunit_varcon, only : max_lunit - use pftconMod, only : nc4_grass, nc3_nonarctic_grass - use clm_varcon, only : ispval - use landunit_varcon, only: istsoil, istcrop - use abortutils , only : endrun - use LandunitType , only: lun - use GridcellType , only: grc - use clm_varctl , only : iulog - use ColumnType , only : col - - implicit none - type(bounds_type), intent(in) :: bounds - type(temperature_type) , intent(in) :: temperature_inst - type(frictionvel_type) , intent(in) :: frictionvel_inst - real(r8), intent(in) :: dt - - ! N excreted in manure, gN/m2: - real(r8), intent(in) :: ndep_sgrz_grc(bounds%begg:bounds%endg) ! seasonally grazing animals - real(r8), intent(in) :: ndep_ngrz_grc(bounds%begg:bounds%endg) ! non-grazing animals - real(r8), intent(inout) :: n_stored_col(bounds%begc:bounds%endc), tan_stored_col(bounds%begc:bounds%endc) ! N, TAN currently stored, gN/m2 - ! N, TAN spread on grasslands, gN/m2/s: - real(r8), intent(inout) :: n_manure_spread_col(bounds%begc:bounds%endc) ! for crops, input, determined by crop model, otherwise output - real(r8), intent(out) :: tan_manure_spread_col(bounds%begc:bounds%endc) ! output, calculated from the above and stored manure - ! N excreted by animals allocated to mixed production systems temporarily grazing on grasslands: - real(r8), intent(inout) :: n_manure_graze_col(bounds%begc:bounds%endc) - ! N excreted by animals in mixed systems, total - real(r8), intent(out) :: n_manure_mixed_col(bounds%begc:bounds%endc) - ! NH3 emission fluxes from manure storage and housings, gN/m2/s - real(r8), intent(out) :: nh3_flux_stores(bounds%begc:bounds%endc), nh3_flux_barns(bounds%begc:bounds%endc) - ! total nitrogen flux transferred out of a crop column - real(r8), intent(out) :: man_n_transf(bounds%begc:bounds%endc) - real(r8), intent(out) :: man_n_barns(bounds%begc:bounds%endc) - ! fraction of manure excreted when grazing - real(r8), intent(out) :: grz_fract(bounds%begc:bounds%endc) - ! TAN fraction in excreted N - real(r8), intent(in) :: tan_fract_excr - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns - - integer :: begg, endg, g, l, c, il, counter, col_grass, status, p - real(r8) :: flux_avail_rum, flux_avail_mg, flux_grazing - real(r8) :: tempr_ave, windspeed_ave ! windspeed and temperature averaged over agricultural patches - real(r8) :: tempr_barns, tempr_stores, vent_barns, flux_grass_crop, tempr_min_10day, & - flux_grass_graze, flux_grass_spread, flux_grass_spread_tan, flux_grass_crop_tan - real(r8) :: cumflux, totalinput, total_to_store - real(r8) :: fluxes_nitr(4,2), fluxes_tan(4,2) - ! The fraction of manure applied continuously on grasslands (if present in the gridcell) - real(r8), parameter :: fract_continuous = 0.1_r8, kg_to_g = 1e3_r8, max_grazing_fract = 0.65_r8, & - volat_coef_barns_open = 0.03_r8, volat_coef_barns_closed = 0.025, volat_coef_stores = 0.025_r8, & - tempr_min_grazing = 283.0_r8!!!! - - begg = bounds%begg; endg = bounds%endg - nh3_flux_stores(bounds%begc:bounds%endc) = 0_r8 - nh3_flux_barns(bounds%begc:bounds%endc) = 0_r8 - man_n_barns(bounds%begc:bounds%endc) = 0.0_r8 - - totalinput = 0.0 - cumflux = 0.0 - - do g = begg, endg - ! First find out if there are grasslands in this cell. If yes, a fraction of - ! manure can be diverted to them before storage. - col_grass = ispval - do il = 1, max_lunit - l = grc%landunit_indices(il, g) - if (l == ispval) cycle - if (lun%itype(l) == istsoil) then - do p = lun%patchi(l), lun%patchf(l) - if ((patch%itype(p) == nc4_grass .or. patch%itype(p) == nc3_nonarctic_grass) & - .and. col%wtgcell(patch%column(p)) > 1e-6) then - col_grass = patch%column(p) - exit - end if - end do - end if - if (col_grass /= ispval) exit - end do - ! Transfer of manure from all crop columns to the natural vegetation column: - flux_grass_graze = 0_r8 - flux_grass_spread = 0_r8 - flux_grass_spread_tan = 0_r8 - - do il = 1, max_lunit - l = grc%landunit_indices(il, g) - if (l == ispval) cycle - if (lun%itype(l) == istcrop) then - ! flux_avail = manure excreted per m2 of crops (ndep_mixed_grc = per m2 / all land units) - do c = lun%coli(l), lun%colf(l) - if (.not. col%active(c)) cycle - if (col%wtgcell(c) < 1e-6) cycle - - if (col%landunit(c) /= l) then - write(iulog, *) g, il, c, col%landunit(c) - call endrun('something wrong') - end if - if (.not. any(c==filter_soilc(1:num_soilc))) then - write(iulog, *) c, n_manure_spread_col(c) - call endrun('column not in soilfilter') - end if - - n_manure_mixed_col(c) = (ndep_ngrz_grc(g) + ndep_sgrz_grc(g)) * kg_to_g / lun%wtgcell(l) - - tempr_min_10day = temperature_inst%t_a10min_patch(col%patchi(c)) - if (tempr_min_10day > tempr_min_grazing) then - ! fraction of animals grazing -> allocate some manure to grasslands before barns - flux_grazing = max_grazing_fract * ndep_sgrz_grc(g) * kg_to_g / lun%wtgcell(l) - !flux_avail = (ndep_ngrz_grc(g) + ndep_sgrz_grc(g)*(1.0_r8 - max_grazing_fract)) * kg_to_g / lun%wtgcell(l) - flux_avail_rum = (ndep_sgrz_grc(g)*(1.0_r8 - max_grazing_fract)) * kg_to_g / lun%wtgcell(l) - grz_fract(c) = max_grazing_fract - else - flux_grazing = 0.0_r8 - flux_avail_rum = ndep_sgrz_grc(g) * kg_to_g / lun%wtgcell(l) - grz_fract(c) = 0.0_r8 - end if - flux_avail_mg = ndep_ngrz_grc(g) * kg_to_g / lun%wtgcell(l) - flux_grass_graze = flux_grass_graze + flux_grazing*col%wtgcell(c) - - if (flux_avail_rum > 1e12 .or. flux_avail_mg > 1e12 .or. isnan(flux_avail_mg) .or. isnan(flux_avail_rum)) then - write(iulog, *) 'bad flux_avail', ndep_ngrz_grc(g), ndep_sgrz_grc(g), lun%wtgcell(l) - call endrun('bad flux_avail') - end if - - totalinput = totalinput + flux_avail_rum + flux_avail_mg - - counter = 0 - if (col_grass == c) call endrun('Something wrong with the indices') - if (col%patchi(c) /= col%patchf(c)) then - call endrun(msg="ERROR crop column has multiple patches") - end if - - tempr_ave = temperature_inst%t_ref2m_patch(col%patchi(c)) - windspeed_ave = frictionvel_inst%u10_patch(col%patchi(c)) - - man_n_barns(c) = flux_avail_rum + flux_avail_mg - - - ! Evaluate the NH3 losses, separate for ruminants (open barns) and others - ! (poultry and pigs, closed barns). Note the slicing of fluxes(:,:) and fluxes_tan(:,:). - man_n_transf(c) = flux_grazing - nh3_flux_stores(c) = 0.0 - - if (flux_avail_rum < 0) then - write(iulog, *) 'flux:', flux_avail_rum - call endrun(msg='negat flux_avail for ruminants') - end if - - ! Ruminants - call eval_fluxes_storage(flux_avail_rum, 'open', tempr_ave, windspeed_ave, 0.0_r8, & - volat_coef_barns_open, volat_coef_stores, tan_fract_excr, fluxes_nitr(:,1), fluxes_tan(:,1), status) - if (status /=0) then - write(iulog, *) 'status = ', status - call endrun(msg='eval_fluxes_storage failed for ruminants') - end if - - ! Others - call eval_fluxes_storage(flux_avail_mg, 'closed', tempr_ave, windspeed_ave, 0.0_r8, & - volat_coef_barns_closed, volat_coef_stores, tan_fract_excr, fluxes_nitr(:,2), fluxes_tan(:,2), status) - if (status /=0) then - write(iulog, *) 'status = ', status - call endrun(msg='eval_fluxes_storage failed for other livestock') - end if - cumflux = cumflux + sum(fluxes_nitr) - if (any(isnan(fluxes_nitr))) then - write(iulog, *) 'fluxes 1', fluxes_nitr(:,1) - write(iulog, *) 'fluxes 2', fluxes_nitr(:,2) - call endrun('Nan in fluxes_nitr') - end if - if (any(isnan(fluxes_tan))) then - write(iulog, *) 'fluxes 1', fluxes_tan(:,1) - write(iulog, *) 'fluxes 2', fluxes_tan(:,2) - call endrun('Nan in fluxes_tan') - end if - - if (fluxes_tan(iflx_to_store,1) < 0) then - call endrun(msg="ERROR too much manure lost") - end if - ! Simplification as of 2019: no explicit manure storage. Flux to storage - ! will be spread "immediately". - total_to_store = sum(fluxes_nitr(iflx_to_store,:)) - flux_grass_spread = flux_grass_spread + total_to_store*col%wtgcell(c) - flux_grass_spread_tan = flux_grass_spread_tan + sum(fluxes_tan(iflx_to_store,:))*col%wtgcell(c) - man_n_transf(c) = man_n_transf(c) + total_to_store - - nh3_flux_stores(c) = sum(fluxes_nitr(iflx_air_stores,:)) - nh3_flux_barns(c) = sum(fluxes_nitr(iflx_air_barns,:)) - - end do ! column - end if ! crop land unit - end do ! landunit - - if (col_grass /= ispval) then - if (tan_manure_spread_col(col_grass) > 1) then - write(iulog, *) 'bad tan_manure col_grass before adding', n_manure_spread_col(col_grass), & - tan_manure_spread_col(col_grass) - end if - n_manure_spread_col(col_grass) = n_manure_spread_col(col_grass) & - + flux_grass_spread / col%wtgcell(col_grass) - tan_manure_spread_col(col_grass) = tan_manure_spread_col(col_grass) & - + flux_grass_spread_tan / col%wtgcell(col_grass) - n_manure_graze_col(col_grass) = n_manure_graze_col(col_grass) + flux_grass_graze / col%wtgcell(col_grass) - !write(iulog, *) 'to grass:', n_manure_spread(col_grass), col_grass - if (tan_manure_spread_col(col_grass) > 1) then - write(iulog, *) 'bad tan_manure col_grass', flux_grass_spread_tan, col%wtgcell(col_grass) - end if - else if (flux_grass_spread > 0) then - continue - !call endrun('Cannot spread manure') - end if - - end do ! grid - - end subroutine handle_storage_v2 - !----------------------------------------------------------------------- subroutine CNFreeLivingFixation(num_soilc, filter_soilc, & waterfluxbulk_inst, soilbiogeochem_nitrogenflux_inst) diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 new file mode 100644 index 0000000000..131d9a614e --- /dev/null +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -0,0 +1,963 @@ +module fan2ctsm + use FanMod + use shr_kind_mod, only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use atm2lndType , only : atm2lnd_type + use Wateratm2lndBulkType , only : wateratm2lndbulk_type + use TemperatureType , only : temperature_type + use FrictionVelocityMod , only : frictionvel_type + use shr_infnan_mod , only : isnan => shr_infnan_isnan + use SoilBiogeochemNitrogenStateType , only : soilbiogeochem_nitrogenstate_type + use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type + use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type + use WaterStateBulkType , only : waterstatebulk_type + use WaterFluxBulkType , only : waterfluxbulk_type + use SoilStateType , only : soilstate_type + use ColumnType , only : col + use PatchType , only : patch + use clm_varctl , only : iulog + + implicit none + + private + + public fan_readnml + public fan_eval + public fan_to_sminn + + ! Hydrogen ion concentration in TAN pools, mol/l == 10**-pH + ! + ! Pastures and slurry. The last age class gets soil pH. + real(r8), parameter :: Hconc_grz_def(2) = (/10**(-8.5_r8), 10**(-8.0_r8)/) + real(r8), parameter :: Hconc_slr_def(3) & + = (/10.0_r8**(-8.0_r8), 10.0_r8**(-8.0_r8), 10.0_r8**(-8.0_r8)/) + ! Urea fertilizer. The other fertilizer (F4) pool gets soil pH. + real(r8), parameter :: Hconc_fert(3) = (/10**(-7.0_r8), 10**(-8.5_r8), 10**(-8.0_r8)/) + + ! Active layer thickness used by FAN. + real(r8), parameter :: dz_layer_fert = 0.02_r8 ! m + real(r8), parameter :: dz_layer_grz = 0.02_r8 ! m + + ! Manure N composition + real(r8) :: fract_tan = 0.6_r8 ! fraction of total ammoniacal nitrogen + ! The following are fractions of non-TAN N + real(r8), parameter :: & + fract_resist = 0.45_r8, & ! resistant organic N + fract_unavail = 0.05_r8, & ! unvavailable organic N + fract_avail = 0.5_r8 ! available organic N + + ! application rate in meters water: + real(r8), parameter :: water_init_grz = 0.006_r8 ! urine patch depth (m) + real(r8), parameter :: depth_slurry = 0.005_r8 ! slurry application rate (m) + real(r8), parameter :: water_init_fert = 1e-9_r8 ! water in fertilizer (assumed none). + ! Slurry infiltration time + real(r8), parameter :: slurry_infiltr_time = 6.0_r8*3600_r8 ! seconds + ! Reduction factor for fertilizer due to mechanical incorporation. + ! N available for volatilization becomes multiplied by (1-fert_incorp_reduct). + real(r8) :: fert_incorp_reduct = 0.25_r8 + + ! TAN pool age ranges (sec). + real(r8), parameter :: & + poolranges_grz(3) = (/24*3600.0_r8, 10*24*3600.0_r8, 360*24*3600.0_r8/), & + poolranges_fert(3) = (/2.36*24*3600.0_r8, 24*3600.0_r8, 360*24*3600.0_r8/), & + poolranges_slr(4) = (/slurry_infiltr_time, 24*3600.0_r8, 10*24*3600.0_r8, 360*24*3600.0_r8/), & + poolrange_otherfert(1) = (/360*24*3600.0_r8/) + + ! soil pH for crops restricted between these limits: + real(r8), parameter :: pH_crop_min = 5.5_r8 + real(r8), parameter :: pH_crop_max = 7.5_r8 + + ! Parameters for grazing in mixed/landless systems: + real(r8), parameter :: tempr_min_grazing = 283.0_r8 ! Lowest 10-day daily-min temperature for grazing, K + ! Fraction of ruminants grazing when permitted by temperature + real(r8), parameter :: max_grazing_fract = 0.65_r8 + ! Normalization constants for barn and storage emissions. + real(r8), parameter :: volat_coef_barns_open = 0.03_r8, volat_coef_barns_closed = 0.025, volat_coef_stores = 0.025_r8 + + logical :: fan_to_bgc_crop = .false. + logical :: fan_to_bgc_veg = .false. + + logical, parameter :: debug_fan = .true. + +contains + + subroutine fan_readnml(NLFilename) + use spmdMod , only : masterproc, mpicom + use fileutils , only : getavu, relavu, opnfil + use clm_varctl , only : use_fan + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_nl_mod , only : shr_nl_find_group_name + use abortutils , only : endrun + use shr_mpi_mod , only : shr_mpi_bcast + + character(len=*), intent(in) :: NLFilename ! Namelist filename + + integer :: ierr ! error code + integer :: unitn ! unit for namelist file + character(len=*), parameter :: subname = 'fan_readnml' + character(len=*), parameter :: nmlname = 'fan_nml' + + namelist /fan_nml/ use_fan, fan_to_bgc_crop, fan_to_bgc_veg + + if (masterproc) then + unitn = getavu() + write(iulog, *) 'Read in ' // nmlname // ' namelist' + call opnfil(NLFilename, unitn, 'F') + call shr_nl_find_group_name(unitn, nmlname, status=ierr) + if (ierr == 0) then + read(unitn, nml=fan_nml, iostat=ierr) + if (ierr /= 0) then + call endrun(msg="ERROR reading " // nmlname // "namelist" // errmsg(__FILE__, __LINE__)) + end if + else + call endrun(msg="ERROR could NOT find " // nmlname // "namelist" // errmsg(__FILE__, __LINE__)) + end if + call relavu(unitn) + end if + + call shr_mpi_bcast(use_fan, mpicom) + call shr_mpi_bcast(fan_to_bgc_crop, mpicom) + call shr_mpi_bcast(fan_to_bgc_veg, mpicom) + + !call mpi_bcast(fan_to_bgc_crop, 1, MPI_LOGICAL, 0, mpicom, ierr) + !call mpi_bcast(fan_to_bgc_veg, 1, MPI_LOGICAL, 0, mpicom, ierr) + !call mpi_bcast(use_fan, 1, MPI_LOGICAL, 0, mpicom, ierr) + + end subroutine fan_readnml + + !************************************************************************************ + + subroutine fan_eval(bounds, num_soilc, filter_soilc, & + atm2lnd_inst, wateratm2lndbulk_inst, & + cnveg_nitrogenflux_inst, & + soilbiogeochem_nitrogenflux_inst, & + soilbiogeochem_nitrogenstate_inst, & + waterstatebulk_inst, soilstate_inst, temperature_inst, & + waterfluxbulk_inst, frictionvel_inst) + use clm_time_manager, only: get_step_size, get_curr_date, get_curr_calday, get_nstep + use clm_varpar, only: max_patch_per_col + use LandunitType, only: lun + use shr_sys_mod, only : shr_sys_flush + use GridcellType, only: grc + use abortutils, only : endrun + use pftconMod, only : nc4_grass, nc3_nonarctic_grass + use landunit_varcon, only: istsoil, istcrop + use clm_varcon, only : spval, ispval + use decompMod, only : bounds_type + + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(atm2lnd_type) , intent(in) :: atm2lnd_inst + type(wateratm2lndbulk_type), intent(in) :: wateratm2lndbulk_inst + type(cnveg_nitrogenflux_type) , intent(in) :: cnveg_nitrogenflux_inst + type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst + type(soilbiogeochem_nitrogenstate_type), intent(inout) :: soilbiogeochem_nitrogenstate_inst + type(waterstatebulk_type) , intent(in) :: waterstatebulk_inst + type(soilstate_type) , intent(in) :: soilstate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(waterfluxbulk_type) , intent(in) :: waterfluxbulk_inst + type(frictionvel_type) , intent(in) :: frictionvel_inst + + ! Local variables + integer, parameter :: num_substeps = 4, balance_check_freq = 1000 + integer :: c, g, patchcounter, p, status, c1, c2, l, fc, ind_substep + real(r8) :: dt, ndep_org(3), orgpools(3), tanprod(3), watertend, fluxes(6,3), tanpools3(3), ratm, tandep, & + fluxes2(6,2), fluxes3(6,3), fluxes4(6,4), tanpools2(2), tanpools4(4), fluxes_tmp(6), garbage_total + + real(r8) :: Hconc_grz(3), Hconc_slr(4), pH_soil, pH_crop + real(r8) :: fert_inc_tan, fert_inc_no3 + logical :: do_balance_checks + real(r8) :: tg, garbage, theta, thetasat, infiltr_m_s, evap_m_s, runoff_m_s, org_n_tot, & + nstored_old, nsoilman_old, nsoilfert_old, fert_to_air, fert_to_soil, fert_total, fert_urea, fert_tan, & + soilflux_org, urea_resid + real(r8) :: tanprod_from_urea(3), ureapools(2), fert_no3, fert_generic, bsw + real(r8) :: fract_urea, fract_no3, soilph_min, soilph_max, soilpsi + integer :: def_ph_count + + Hconc_grz(1:2) = Hconc_grz_def + Hconc_slr(1:3) = Hconc_slr_def + + soilph_min = 999 + soilph_max = -999 + def_ph_count = 0 + dt = real(get_step_size(), r8) + do_balance_checks = mod(get_nstep(), balance_check_freq) == 0 + + associate(& + ngrz => soilbiogeochem_nitrogenflux_inst%man_n_grz_col, & + man_u_grz => soilbiogeochem_nitrogenstate_inst%man_u_grz_col, & + man_a_grz => soilbiogeochem_nitrogenstate_inst%man_a_grz_col, & + man_r_grz => soilbiogeochem_nitrogenstate_inst%man_r_grz_col, & + man_u_app => soilbiogeochem_nitrogenstate_inst%man_u_app_col, & + man_a_app => soilbiogeochem_nitrogenstate_inst%man_a_app_col, & + man_r_app => soilbiogeochem_nitrogenstate_inst%man_r_app_col, & + ns => soilbiogeochem_nitrogenstate_inst, & + nf => soilbiogeochem_nitrogenflux_inst, & + cnv_nf => cnveg_nitrogenflux_inst, & + ram1 => frictionvel_inst%ram1_patch, & + rb1 => frictionvel_inst%rb1_patch) + + nf%fert_n_appl_col(bounds%begc:bounds%endc) = 0.0 + nf%man_n_appl_col(bounds%begc:bounds%endc) = 0.0 + nf%man_tan_appl_col(bounds%begc:bounds%endc) = 0.0 + + call p2c(bounds, num_soilc, filter_soilc, & + cnv_nf%fert_patch(bounds%begp:bounds%endp), & + nf%fert_n_appl_col(bounds%begc:bounds%endc)) + call p2c(bounds, num_soilc, filter_soilc, & + cnv_nf%manu_patch(bounds%begp:bounds%endp), & + nf%man_n_appl_col(bounds%begc:bounds%endc)) + + if (any(nf%man_n_appl_col > 100)) then + write(iulog, *) maxval(nf%man_n_appl_col) + call endrun('bad man_n_appl_col') + end if + if (do_balance_checks) then + nstored_old = get_total_n(ns, nf, 'pools_storage') + nsoilman_old = get_total_n(ns, nf, 'pools_manure') + nsoilfert_old = get_total_n(ns, nf, 'pools_fertilizer') + end if + + ! Assign the "pastoral" manure entire to the natural vegetation column + do fc = 1, num_soilc + c = filter_soilc(fc) + l = col%landunit(c) + if (.not. (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop)) cycle + if (.not. col%active(c) .or. col%wtgcell(c) < 1e-6) cycle + g = col%gridcell(c) + if (lun%itype(l) == istsoil) then + ngrz(c) = atm2lnd_inst%forc_ndep_grz_grc(g) / col%wtgcell(c) * 1e3 ! kg to g + if (debug_fan) then + if (ngrz(c) > 1e12 .or. (isnan(ngrz(c)))) then + write(iulog, *) 'bad ngrz', atm2lnd_inst%forc_ndep_grz_grc(g), col%wtgcell(c) + call endrun('bad ngrz 1') + end if + end if + if (nf%man_n_appl_col(c) > 0) then + write(iulog, *) nf%man_n_appl_col(c) + call endrun(msg='Found fertilizer in soil column') + end if + else + ngrz(c) = 0.0 + end if + + end do + + if(debug_fan) then + write(iulog, *) 'nan count of storage 1', count(isnan(ns%man_n_stored_col)) + if (any(isnan(nf%man_n_appl_col))) then + call endrun('nan nh3 appl b') + end if + end if + + call handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & + atm2lnd_inst%forc_ndep_sgrz_grc, atm2lnd_inst%forc_ndep_ngrz_grc, & + ns%man_n_stored_col, ns%man_tan_stored_col, & + nf%man_n_appl_col, nf%man_tan_appl_col, & + nf%man_n_grz_col, nf%man_n_mix_col, & + nf%nh3_stores_col, nf%nh3_barns_col, & + nf%man_n_transf_col, ns%fan_grz_fract_col, & + nf%man_n_barns_col, & + fract_tan, & + filter_soilc, num_soilc) + + if (debug_fan) then + if (any(isnan(nf%nh3_stores_col))) then + call endrun('nan nh3 stores') + end if + if (any(isnan(nf%nh3_barns_col))) then + call endrun('nan nh3 barns') + end if + if (any(isnan(nf%man_n_appl_col))) then + call endrun('nan nh3 appl') + end if + if (any(isnan(nf%man_n_mix_col))) then + call endrun('nan nh3 appl') + end if + end if + + do fc = 1, num_soilc + c = filter_soilc(fc) + l = col%landunit(c) + g = col%gridcell(c) + if (.not. (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop)) cycle + if (.not. col%active(c) .or. col%wtgcell(c) < 1e-15) cycle + + if (nf%man_n_appl_col(c) > 1e12 .or. ngrz(c) > 1e12) then + write(iulog, *) c, nf%man_n_appl_col(c), ngrz(c), cnv_nf%fert_patch(col%patchi(c):col%patchf(c)), & + cnv_nf%manu_patch(col%patchi(c):col%patchf(c)) + call endrun('nf%man_n_appl_col(c) is spval') + end if + + ! Find and average the atmospheric resistances Rb and Ra. + ! + if (lun%itype(col%landunit(c)) == istcrop) then + ! Crop column, only one patch + p = col%patchi(c) + if (p /= col%patchf(c)) call endrun(msg='Strange patch for crop') + ratm = ram1(p) + rb1(p) + else + ! if natural, find average over grasses + ratm = 0.0 + patchcounter = 0 + do p = col%patchi(c), col%patchf(c) + if (patch%itype(p) == nc4_grass .or. patch%itype(p) == nc3_nonarctic_grass) then + if (.not. patch%active(p) .or. ram1(p) == spval .or. rb1(p) == spval) cycle + ratm = ratm + ram1(p) + rb1(p) + patchcounter = patchcounter + 1 + end if + end do + if (patchcounter > 0) then + ratm = ratm / patchcounter + else + ! grass not found, take something. + do p = col%patchi(c), col%patchf(c) + if (.not. patch%active(p) .or. ram1(p) == spval .or. rb1(p) == spval) cycle + ratm = ram1(p) + rb1(p) + exit + end do + if (p == col%patchf(c) + 1) then + ! Nothing found. We shouldn't be here. + ratm = 150.0_r8 + end if + end if + ns%fan_grz_fract_col(c) = 1.0_r8 ! for crops handled by handle_storage + end if + + watertend = waterstatebulk_inst%h2osoi_tend_tsl_col(c) * 1e-3 ! to meters/sec (ie. m3/m2/s) + + tg = temperature_inst%t_grnd_col(c) + theta = waterstatebulk_inst%h2osoi_vol_col(c,1) + thetasat = soilstate_inst%watsat_col(c,1) + bsw = soilstate_inst%bsw_col(c,1) + theta = min(theta, 0.98_r8*thetasat) + infiltr_m_s = max(waterfluxbulk_inst%qflx_infl_col(c), 0.0) * 1e-3 + evap_m_s = waterfluxbulk_inst%qflx_evap_grnd_col(c) * 1e-3 + runoff_m_s = max(waterfluxbulk_inst%qflx_runoff_col(c), 0.0) * 1e-3 + soilpsi = soilstate_inst%soilpsi_col(c,1) + + ! grazing + ! + + ndep_org(ind_avail) = ngrz(c) * (1.0_r8-fract_tan) * fract_avail + ndep_org(ind_resist) = ngrz(c) * (1.0_r8-fract_tan) * fract_resist + ndep_org(ind_unavail) = ngrz(c) * (1.0_r8-fract_tan) * fract_unavail + tandep = ngrz(c) * fract_tan + + orgpools(ind_avail) = man_a_grz(c) + orgpools(ind_resist) = man_r_grz(c) + orgpools(ind_unavail) = man_u_grz(c) + call update_org_n(ndep_org, tg, soilpsi, orgpools, dt, tanprod, soilflux_org) + man_a_grz(c) = orgpools(ind_avail) + man_r_grz(c) = orgpools(ind_resist) + man_u_grz(c) = orgpools(ind_unavail) + + tanpools3(1) = ns%tan_g1_col(c) + tanpools3(2) = ns%tan_g2_col(c) + tanpools3(3) = ns%tan_g3_col(c) + if (any(isnan(tanpools3))) then + call endrun('nan1') + end if + + ph_soil = atm2lnd_inst%forc_soilph_grc(g) + if (ph_soil < 3.0) then + ph_soil = 6.5_r8 + def_ph_count = def_ph_count + 1 + end if + Hconc_grz(3) = 10**-(ph_soil) + soilph_max = max(soilph_max, ph_soil) + soilph_min = min(soilph_min, ph_soil) + + fluxes_tmp = 0.0 + garbage_total = 0.0 + fluxes3 = 0.0 + garbage = 0 + do ind_substep = 1, num_substeps + call update_npool(tg, ratm, & + theta, thetasat, infiltr_m_s, evap_m_s, & + wateratm2lndbulk_inst%forc_q_downscaled_col(c), watertend, & + runoff_m_s, tandep, (/0.0_r8, 0.0_r8, sum(tanprod)/), water_init_grz, & + bsw, poolranges_grz, Hconc_grz, dz_layer_grz, tanpools3, & + fluxes3(1:5,:), garbage, dt/num_substeps, status, 3) + if (status /= 0) then + write(iulog, *) 'status = ', status, tanpools2, ratm, theta, thetasat, tandep, tanprod + call endrun(msg='update_npool status /= 0') + end if + if (debug_fan .and. any(isnan(tanpools2))) then + call endrun('nan2') + end if + fluxes_tmp = fluxes_tmp + sum(fluxes3, dim=2) + garbage_total = garbage_total + garbage + end do + fluxes_tmp = fluxes_tmp / num_substeps + + ns%tan_g1_col(c) = tanpools3(1) + ns%tan_g2_col(c) = tanpools3(2) + ns%tan_g3_col(c) = tanpools3(3) + if (debug_fan .and. any(isnan(fluxes3))) then + write(iulog, *) fluxes3 + call endrun('nan3') + end if + + nf%nh3_grz_col(c) = fluxes_tmp(iflx_air) + nf%manure_runoff_col(c) = fluxes_tmp(iflx_roff) + nf%manure_no3_prod_col(c) = fluxes_tmp(iflx_no3) + nf%manure_nh4_to_soil_col(c) & + = fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) + garbage_total / dt + soilflux_org + + ! Manure application + ! + + org_n_tot = nf%man_n_appl_col(c) - nf%man_tan_appl_col(c) + ! Use the the same fractionation of organic N as for grazing, after removing the + ! "explicitly" calculated TAN. + ndep_org(ind_avail) = org_n_tot * fract_avail + ndep_org(ind_resist) = org_n_tot * fract_resist + ndep_org(ind_unavail) = org_n_tot * fract_unavail + tandep = nf%man_tan_appl_col(c) + + orgpools(ind_avail) = man_a_app(c) + orgpools(ind_resist) = man_r_app(c) + orgpools(ind_unavail) = man_u_app(c) + call update_org_n(ndep_org, tg, soilpsi, orgpools, dt, tanprod, soilflux_org) + man_a_app(c) = orgpools(ind_avail) + man_r_app(c) = orgpools(ind_resist) + man_u_app(c) = orgpools(ind_unavail) + tanpools4(1) = ns%tan_s0_col(c) + tanpools4(2) = ns%tan_s1_col(c) + tanpools4(3) = ns%tan_s2_col(c) + tanpools4(4) = ns%tan_s3_col(c) + + ph_crop = min(max(ph_soil, ph_crop_min), ph_crop_max) + Hconc_slr(4) = 10**-(ph_crop) + + if (debug_fan .and. any(isnan(tanpools4))) then + call endrun('nan31') + end if + + fluxes_tmp = 0.0 + garbage_total = 0.0 + fluxes4 = 0.0 + do ind_substep = 1, num_substeps + if (debug_fan .and. any(abs(tanpools4) > 1e12)) then + write(iulog, *) ind_substep, tanpools4, tandep, nf%fert_n_appl_col(c), & + nf%man_n_appl_col(c), ns%man_n_stored_col(c), ns%man_tan_stored_col(c) + call endrun('bad tanpools (manure app)') + end if + + call update_4pool(tg, ratm, theta, thetasat, infiltr_m_s, evap_m_s, & + wateratm2lndbulk_inst%forc_q_downscaled_col(c), watertend, & + runoff_m_s, tandep, sum(tanprod), bsw, depth_slurry, & + poolranges_slr, tanpools4, Hconc_slr, fluxes4(1:5,:), garbage, dt / num_substeps, status) + if (status /= 0) then + write(iulog, *) 'status = ', status, tanpools4, tg, ratm, 'th', theta, & + thetasat, tandep, 'tp', tanprod, 'fx', fluxes4 + call endrun(msg='update_3pool status /= 0') + end if + fluxes_tmp = fluxes_tmp + sum(fluxes4, dim=2) + garbage_total = garbage_total + garbage + end do + fluxes_tmp = fluxes_tmp / num_substeps + + ns%tan_s0_col(c) = tanpools4(1) + ns%tan_s1_col(c) = tanpools4(2) + ns%tan_s2_col(c) = tanpools4(3) + ns%tan_s3_col(c) = tanpools4(4) + + if (debug_fan .and. any(isnan(fluxes4))) then + write(iulog, *) fluxes3, tanpools4,ratm, theta, thetasat, infiltr_m_s, tandep, tanprod + call endrun('nan4') + end if + + nf%nh3_man_app_col(c) = fluxes_tmp(iflx_air) + nf%manure_runoff_col(c) = nf%manure_runoff_col(c) + fluxes_tmp(iflx_roff) + nf%manure_no3_prod_col(c) = nf%manure_no3_prod_col(c) + fluxes_tmp(iflx_no3) + nf%manure_nh4_to_soil_col(c) & + = nf%manure_nh4_to_soil_col(c) + fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) & + + garbage_total / dt + soilflux_org + + ! Fertilizer + ! + + ! Fraction available for volatilization + fert_total = nf%fert_n_appl_col(c) + + fract_urea = atm2lnd_inst%forc_ndep_urea_grc(g) + fract_no3 = atm2lnd_inst%forc_ndep_nitr_grc(g) + + ! Fractions made unavailable by mechanical incorporation, will be added to the + ! to-soil flux (tan) or no3 production (no3) below. + fert_inc_tan = fert_total * fert_incorp_reduct * (1.0 - fract_no3) + fert_inc_no3 = fert_total * fert_incorp_reduct * fract_no3 + + if (fract_urea < 0 .or. fract_no3 < 0 .or. fract_urea + fract_no3 > 1) then + call endrun('bad fertilizer fractions') + end if + + fert_urea = fert_total * fract_urea * (1.0_r8 - fert_incorp_reduct) + + ! Include the incorporated NO3 fertilizer to the no3 flux + fert_no3 = fert_total * fract_no3 + fert_generic = fert_total * (1.0_r8 - fract_urea - fract_no3) * (1.0_r8 - fert_incorp_reduct) + nf%otherfert_n_appl_col(c) = fert_total * (1.0_r8 - fract_urea) !fert_no3 + fert_generic + + ! Urea decomposition + ! + ureapools(1) = ns%fert_u0_col(c) + ureapools(2) = ns%fert_u1_col(c) + fluxes2 = 0.0 + call update_urea(tg, theta, thetasat, infiltr_m_s, evap_m_s, watertend, & + runoff_m_s, fert_urea, bsw, ureapools, fluxes2, urea_resid, poolranges_fert(1:2), & + dt, status, numpools=2) + if (status /= 0) then + call endrun(msg='Bad status after update_urea for fertilizer') + end if + ! Nitrogen fluxes from urea pool. Be sure to not zero below! + fluxes_tmp = sum(fluxes2, dim=2) + + ns%fert_u0_col(c) = ureapools(1) + ns%fert_u1_col(c) = ureapools(2) + ! Collect the formed ammonia for updating the TAN pools + tanprod_from_urea(1:2) = fluxes2(iflx_to_tan, 1:2) + tanprod_from_urea(2) = tanprod_from_urea(2) + ! There is no urea pool corresponding to tan_f2, because most of the urea will + ! have decomposed. Here whatever remains gets sent to tan_f2. + tanprod_from_urea(3) = urea_resid / dt + + tanpools3(1) = ns%tan_f0_col(c) + tanpools3(2) = ns%tan_f1_col(c) + tanpools3(3) = ns%tan_f2_col(c) + garbage_total = 0.0 + fluxes3 = 0.0 + nf%nh3_otherfert_col(c) = 0.0 + do ind_substep = 1, num_substeps + ! Fertilizer pools f0...f2 + call update_npool(tg, ratm, theta, thetasat, infiltr_m_s, evap_m_s, & + wateratm2lndbulk_inst%forc_q_downscaled_col(c), watertend, & + runoff_m_s, 0.0_r8, tanprod_from_urea, water_init_fert, bsw, & + poolranges_fert, Hconc_fert, dz_layer_fert, tanpools3, fluxes3(1:5,:), & + garbage, dt/num_substeps, status, numpools=3) + if (status /= 0) then + write(iulog, *) 'status:', status, tanpools3, nf%fert_n_appl_col(c) + call endrun(msg='Bad status after npool for fertilizer') + end if + fluxes_tmp = fluxes_tmp + sum(fluxes3, dim=2) / num_substeps + garbage_total = garbage_total + garbage + + ! Fertilizer pool f3 + call update_npool(tg, ratm, theta, thetasat, infiltr_m_s, evap_m_s, & + wateratm2lndbulk_inst%forc_q_downscaled_col(c), watertend, & + runoff_m_s, fert_generic, (/0.0_r8/), water_init_fert, bsw, & + poolrange_otherfert, (/10**(-ph_crop)/), dz_layer_fert, ns%tan_f3_col(c:c), fluxes3(1:5,1:1), & + garbage, dt/num_substeps, status, numpools=1) + if (status /= 0) then + write(iulog, *) 'status:', status, tanpools3, nf%fert_n_appl_col(c) + call endrun(msg='Bad status after npool for generic') + end if + fluxes_tmp = fluxes_tmp + fluxes3(:, 1) / num_substeps + garbage_total = garbage_total + garbage + nf%nh3_otherfert_col(c) = nf%nh3_otherfert_col(c) + fluxes3(iflx_air, 1) / num_substeps + end do + + ns%tan_f0_col(c) = tanpools3(1) + ns%tan_f1_col(c) = tanpools3(2) + ns%tan_f2_col(c) = tanpools3(3) + ! !!tan_f3_col already updated above by update_npool!! + + nf%nh3_fert_col(c) = fluxes_tmp(iflx_air) + nf%fert_runoff_col(c) = fluxes_tmp(iflx_roff) + nf%fert_no3_prod_col(c) = fluxes_tmp(iflx_no3) + fert_no3 + nf%fert_nh4_to_soil_col(c) = fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) + garbage_total/dt + fert_inc_tan + + ! Total flux + ! + nf%nh3_total_col(c) = nf%nh3_fert_col(c) + nf%nh3_man_app_col(c) & + + nf%nh3_grz_col(c) + nf%nh3_stores_col(c) + nf%nh3_barns_col(c) + if (nf%nh3_total_col(c) < -1e15) then + call endrun(msg='ERROR: FAN, negative total emission') + end if + end do + + if (do_balance_checks) then + call balance_check('Storage', nstored_old, & + get_total_n(ns, nf, 'pools_storage'), get_total_n(ns, nf, 'fluxes_storage')) + call balance_check('Manure', nsoilman_old, & + get_total_n(ns, nf, 'pools_manure'), get_total_n(ns, nf, 'fluxes_manure')) + call balance_check('Fertilizer', nsoilfert_old, & + get_total_n(ns, nf, 'pools_fertilizer'), get_total_n(ns, nf, 'fluxes_fertilizer')) + write(iulog, *) 'SoilPH check:', soilph_min, soilph_max, def_ph_count + end if + + call update_summary(ns, nf, filter_soilc, num_soilc) + + end associate + + contains + + real(r8) function get_total_n(ns, nf, which) result(total) + type(soilbiogeochem_nitrogenstate_type), intent(in) :: ns + type(soilbiogeochem_nitrogenflux_type), intent(in) :: nf + character(len=*), intent(in) :: which + + total = 0 + + associate(soilc => filter_soilc(1:num_soilc)) + + select case(which) + case('pools_storage') + total = sum(ns%man_n_stored_col(soilc)) + + case('fluxes_storage') + total = sum(nf%man_n_mix_col(soilc)) + total = total - sum(nf%nh3_stores_col(soilc)) + total = total - sum(nf%nh3_barns_col(soilc)) - sum(nf%man_n_transf_col(soilc)) + + case('pools_manure') + total = total + sum(ns%tan_g1_col(soilc)) + sum(ns%tan_g2_col(soilc)) + sum(ns%tan_g3_col(soilc)) + total = total + sum(ns%man_u_grz_col(soilc)) & + + sum(ns%man_a_grz_col(soilc)) + sum(ns%man_r_grz_col(soilc)) + total = total + sum(ns%tan_s0_col(soilc)) & + + sum(ns%tan_s1_col(soilc)) + sum(ns%tan_s2_col(soilc)) + sum(ns%tan_s3_col(soilc)) + total = total + sum(ns%man_u_app_col(soilc)) & + + sum(ns%man_a_app_col(soilc)) + sum(ns%man_r_app_col(soilc)) + + case('fluxes_manure') + total = sum(nf%man_n_grz_col(soilc)) + sum(nf%man_n_appl_col(soilc)) + total = total - sum(nf%nh3_man_app_col(soilc)) & + - sum(nf%nh3_grz_col(soilc)) - sum(nf%manure_runoff_col(soilc)) + total = total - sum(nf%manure_no3_prod_col(soilc)) - sum(nf%manure_nh4_to_soil_col(soilc)) + + case('pools_fertilizer') + total = sum(ns%tan_f0_col((soilc))) + sum(ns%tan_f1_col((soilc))) + sum(ns%tan_f2_col(soilc)) & + + sum(ns%tan_f3_col(soilc)) + total = total + sum(ns%fert_u0_col(soilc)) + sum(ns%fert_u1_col(soilc)) + + case('fluxes_fertilizer') + total = sum(nf%fert_n_appl_col(soilc)) + total = total - sum(nf%nh3_fert_col(soilc)) - sum(nf%fert_runoff_col(soilc)) + total = total - sum(nf%fert_no3_prod_col(soilc)) - sum(nf%fert_nh4_to_soil_col(soilc)) + + case default + call endrun(msg='Bad argument to get_total_n') + + end select + + end associate + + end function get_total_n + + subroutine balance_check(label, total_old, total_new, flux) + ! Check and report that the net flux equals the accumulated mass in pools. The + ! total pools and fluxes can be evaluated by the function get_total_n. + character(len=*), intent(in) :: label + real(r8), intent(in) :: total_old, total_new, flux + + real(r8) :: diff, accflux + real(r8) :: tol = 1e-6_r8 + + diff = total_new - total_old + accflux = flux*dt + write(iulog, *) 'Balance check:', label, diff, accflux + + end subroutine balance_check + + end subroutine fan_eval + + !************************************************************************************ + + subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & + ndep_sgrz_grc, ndep_ngrz_grc, n_stored_col, tan_stored_col, & + n_manure_spread_col, tan_manure_spread_col, & + n_manure_graze_col, n_manure_mixed_col, & + nh3_flux_stores, nh3_flux_barns, man_n_transf, & + grz_fract, man_n_barns, tan_fract_excr, & + filter_soilc, num_soilc) + use landunit_varcon, only : max_lunit + use pftconMod, only : nc4_grass, nc3_nonarctic_grass + use clm_varcon, only : ispval + use landunit_varcon, only: istsoil, istcrop + use abortutils , only : endrun + use LandunitType , only: lun + use GridcellType , only: grc + use clm_varctl , only : iulog + + implicit none + type(bounds_type), intent(in) :: bounds + type(temperature_type) , intent(in) :: temperature_inst + type(frictionvel_type) , intent(in) :: frictionvel_inst + real(r8), intent(in) :: dt + + ! N excreted in manure, gN/m2: + real(r8), intent(in) :: ndep_sgrz_grc(bounds%begg:bounds%endg) ! seasonally grazing animals + real(r8), intent(in) :: ndep_ngrz_grc(bounds%begg:bounds%endg) ! non-grazing animals + real(r8), intent(inout) :: n_stored_col(bounds%begc:bounds%endc), & + & tan_stored_col(bounds%begc:bounds%endc) ! N, TAN currently stored, gN/m2 + ! N, TAN spread on grasslands, gN/m2/s: + real(r8), intent(inout) :: n_manure_spread_col(bounds%begc:bounds%endc) + real(r8), intent(out) :: tan_manure_spread_col(bounds%begc:bounds%endc) ! output, calculated from the above and stored manure + ! N excreted by animals allocated to mixed production systems temporarily grazing on grasslands: + real(r8), intent(inout) :: n_manure_graze_col(bounds%begc:bounds%endc) + ! N excreted by animals in mixed systems, total + real(r8), intent(out) :: n_manure_mixed_col(bounds%begc:bounds%endc) + ! NH3 emission fluxes from manure storage and housings, gN/m2/s + real(r8), intent(out) :: nh3_flux_stores(bounds%begc:bounds%endc), nh3_flux_barns(bounds%begc:bounds%endc) + ! total nitrogen flux transferred out of a crop column (manure spreading + temporary grazing) + real(r8), intent(out) :: man_n_transf(bounds%begc:bounds%endc) + ! Total nitrogen excreted in barns + real(r8), intent(out) :: man_n_barns(bounds%begc:bounds%endc) + ! fraction of manure excreted when grazing + real(r8), intent(out) :: grz_fract(bounds%begc:bounds%endc) + ! TAN fraction in excreted N + real(r8), intent(in) :: tan_fract_excr + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + + integer :: begg, endg, g, l, c, il, counter, col_grass, status, p + real(r8) :: flux_avail_rum, flux_avail_mg, flux_grazing + real(r8) :: tempr_ave, windspeed_ave ! windspeed and temperature averaged over agricultural patches + real(r8) :: tempr_barns, tempr_stores, vent_barns, flux_grass_crop, tempr_min_10day, & + flux_grass_graze, flux_grass_spread, flux_grass_spread_tan, flux_grass_crop_tan + real(r8) :: cumflux, totalinput, total_to_store + real(r8) :: fluxes_nitr(4,2), fluxes_tan(4,2) + ! The fraction of manure applied continuously on grasslands (if present in the gridcell) + real(r8), parameter :: kg_to_g = 1e3_r8 + + begg = bounds%begg; endg = bounds%endg + nh3_flux_stores(bounds%begc:bounds%endc) = 0_r8 + nh3_flux_barns(bounds%begc:bounds%endc) = 0_r8 + man_n_barns(bounds%begc:bounds%endc) = 0.0_r8 + + totalinput = 0.0 + cumflux = 0.0 + + do g = begg, endg + ! First find out if there are grasslands in this cell. If yes, a fraction of + ! manure can be diverted to them before storage. + col_grass = ispval + do il = 1, max_lunit + l = grc%landunit_indices(il, g) + if (l == ispval) cycle + if (lun%itype(l) == istsoil) then + do p = lun%patchi(l), lun%patchf(l) + if ((patch%itype(p) == nc4_grass .or. patch%itype(p) == nc3_nonarctic_grass) & + .and. col%wtgcell(patch%column(p)) > 1e-6) then + col_grass = patch%column(p) + exit + end if + end do + end if + if (col_grass /= ispval) exit + end do + ! Transfer of manure from all crop columns to the natural vegetation column: + flux_grass_graze = 0_r8 + flux_grass_spread = 0_r8 + flux_grass_spread_tan = 0_r8 + + do il = 1, max_lunit + l = grc%landunit_indices(il, g) + if (l == ispval) cycle + if (lun%itype(l) == istcrop) then + ! flux_avail = manure excreted per m2 of crops (ndep_mixed_grc = per m2 / all land units) + do c = lun%coli(l), lun%colf(l) + if (.not. col%active(c)) cycle + if (col%wtgcell(c) < 1e-6) cycle + + if (col%landunit(c) /= l) then + write(iulog, *) g, il, c, col%landunit(c) + call endrun('something wrong') + end if + if (.not. any(c==filter_soilc(1:num_soilc))) then + write(iulog, *) c, n_manure_spread_col(c) + call endrun('column not in soilfilter') + end if + + n_manure_mixed_col(c) = (ndep_ngrz_grc(g) + ndep_sgrz_grc(g)) * kg_to_g / lun%wtgcell(l) + + tempr_min_10day = temperature_inst%t_a10min_patch(col%patchi(c)) + if (tempr_min_10day > tempr_min_grazing) then + ! fraction of animals grazing -> allocate some manure to grasslands before barns + flux_grazing = max_grazing_fract * ndep_sgrz_grc(g) * kg_to_g / lun%wtgcell(l) + !flux_avail = (ndep_ngrz_grc(g) + ndep_sgrz_grc(g)*(1.0_r8 - max_grazing_fract)) * kg_to_g / lun%wtgcell(l) + flux_avail_rum = (ndep_sgrz_grc(g)*(1.0_r8 - max_grazing_fract)) * kg_to_g / lun%wtgcell(l) + grz_fract(c) = max_grazing_fract + else + flux_grazing = 0.0_r8 + flux_avail_rum = ndep_sgrz_grc(g) * kg_to_g / lun%wtgcell(l) + grz_fract(c) = 0.0_r8 + end if + flux_avail_mg = ndep_ngrz_grc(g) * kg_to_g / lun%wtgcell(l) + flux_grass_graze = flux_grass_graze + flux_grazing*col%wtgcell(c) + + if (flux_avail_rum > 1e12 .or. flux_avail_mg > 1e12 .or. isnan(flux_avail_mg) .or. isnan(flux_avail_rum)) then + write(iulog, *) 'bad flux_avail', ndep_ngrz_grc(g), ndep_sgrz_grc(g), lun%wtgcell(l) + call endrun('bad flux_avail') + end if + + totalinput = totalinput + flux_avail_rum + flux_avail_mg + + counter = 0 + if (col_grass == c) call endrun('Something wrong with the indices') + if (col%patchi(c) /= col%patchf(c)) then + call endrun(msg="ERROR crop column has multiple patches") + end if + + tempr_ave = temperature_inst%t_ref2m_patch(col%patchi(c)) + windspeed_ave = frictionvel_inst%u10_patch(col%patchi(c)) + + man_n_barns(c) = flux_avail_rum + flux_avail_mg + + ! Evaluate the NH3 losses, separate for ruminants (open barns) and others + ! (poultry and pigs, closed barns). Note the slicing of fluxes(:,:) and fluxes_tan(:,:). + man_n_transf(c) = flux_grazing + nh3_flux_stores(c) = 0.0 + + if (flux_avail_rum < 0) then + write(iulog, *) 'flux:', flux_avail_rum + call endrun(msg='negat flux_avail for ruminants') + end if + + ! Ruminants + call eval_fluxes_storage(flux_avail_rum, 'open', tempr_ave, windspeed_ave, 0.0_r8, & + volat_coef_barns_open, volat_coef_stores, tan_fract_excr, fluxes_nitr(:,1), fluxes_tan(:,1), status) + if (status /=0) then + write(iulog, *) 'status = ', status + call endrun(msg='eval_fluxes_storage failed for ruminants') + end if + + ! Others + call eval_fluxes_storage(flux_avail_mg, 'closed', tempr_ave, windspeed_ave, 0.0_r8, & + volat_coef_barns_closed, volat_coef_stores, tan_fract_excr, fluxes_nitr(:,2), fluxes_tan(:,2), status) + if (status /=0) then + write(iulog, *) 'status = ', status + call endrun(msg='eval_fluxes_storage failed for other livestock') + end if + cumflux = cumflux + sum(fluxes_nitr) + if (any(isnan(fluxes_nitr))) then + write(iulog, *) 'fluxes 1', fluxes_nitr(:,1) + write(iulog, *) 'fluxes 2', fluxes_nitr(:,2) + call endrun('Nan in fluxes_nitr') + end if + if (any(isnan(fluxes_tan))) then + write(iulog, *) 'fluxes 1', fluxes_tan(:,1) + write(iulog, *) 'fluxes 2', fluxes_tan(:,2) + call endrun('Nan in fluxes_tan') + end if + + if (fluxes_tan(iflx_to_store,1) < 0) then + call endrun(msg="ERROR too much manure lost") + end if + ! Simplification as of 2019: no explicit manure storage. Flux to storage + ! will be spread "immediately". + total_to_store = sum(fluxes_nitr(iflx_to_store,:)) + flux_grass_spread = flux_grass_spread + total_to_store*col%wtgcell(c) + flux_grass_spread_tan = flux_grass_spread_tan + sum(fluxes_tan(iflx_to_store,:))*col%wtgcell(c) + man_n_transf(c) = man_n_transf(c) + total_to_store + + nh3_flux_stores(c) = sum(fluxes_nitr(iflx_air_stores,:)) + nh3_flux_barns(c) = sum(fluxes_nitr(iflx_air_barns,:)) + + end do ! column + end if ! crop land unit + end do ! landunit + + if (col_grass /= ispval) then + if (tan_manure_spread_col(col_grass) > 1) then + write(iulog, *) 'bad tan_manure col_grass before adding', n_manure_spread_col(col_grass), & + tan_manure_spread_col(col_grass) + end if + n_manure_spread_col(col_grass) = n_manure_spread_col(col_grass) & + + flux_grass_spread / col%wtgcell(col_grass) + tan_manure_spread_col(col_grass) = tan_manure_spread_col(col_grass) & + + flux_grass_spread_tan / col%wtgcell(col_grass) + n_manure_graze_col(col_grass) = n_manure_graze_col(col_grass) + flux_grass_graze / col%wtgcell(col_grass) + !write(iulog, *) 'to grass:', n_manure_spread(col_grass), col_grass + if (tan_manure_spread_col(col_grass) > 1) then + write(iulog, *) 'bad tan_manure col_grass', flux_grass_spread_tan, col%wtgcell(col_grass) + end if + else if (flux_grass_spread > 0) then + continue + !call endrun('Cannot spread manure') + end if + + end do ! grid + + end subroutine handle_storage_v2 + + !************************************************************************************ + + subroutine update_summary(ns, nf, filter_soilc, num_soilc) + use ColumnType, only : col + use LandunitType , only: lun + use landunit_varcon, only : istcrop + + type(soilbiogeochem_nitrogenstate_type), intent(inout) :: ns + type(soilbiogeochem_nitrogenflux_type), intent(inout) :: nf + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! filter for soil columns + + integer :: c, fc + real(r8) :: total, fluxout, fluxin, flux_loss + + do fc = 1, num_soilc + c = filter_soilc(fc) + total = ns%tan_g1_col(c) + ns%tan_g2_col(c) + ns%tan_g3_col(c) + total = total + ns%man_u_grz_col(c) + ns%man_a_grz_col(c) + ns%man_r_grz_col(c) + total = total + ns%tan_s0_col(c) + ns%tan_s1_col(c) + ns%tan_s2_col(c) + ns%tan_s3_col(c) + total = total + ns%man_u_app_col(c) + ns%man_a_app_col(c) + ns%man_r_app_col(c) + total = total + ns%tan_f0_col(c) + ns%tan_f1_col(c) + ns%tan_f2_col(c) + ns%tan_f3_col(c) + total = total + ns%fert_u0_col(c) + ns%fert_u1_col(c) + ns%fan_totn_col(c) = total + + if (lun%itype(col%landunit(c)) == istcrop) then + ! no grazing, man_n_appl is from the same column and not counted as input + fluxin = nf%man_n_barns_col(c) + nf%fert_n_appl_col(c) + else + ! no barns or fertilization. man_n_appl is transferred from crop columns and not + ! included in the other inputs. + fluxin = nf%man_n_grz_col(c) + nf%man_n_appl_col(c) + end if + + flux_loss = nf%nh3_man_app_col(c) + nf%nh3_grz_col(c) + nf%manure_runoff_col(c) & + + nf%nh3_stores_col(c) + nf%nh3_barns_col(c) & + + nf%nh3_fert_col(c) + nf%fert_runoff_col(c) + + fluxout = nf%fert_no3_prod_col(c) + nf%fert_nh4_to_soil_col(c) & + + nf%manure_no3_prod_col(c) + nf%manure_nh4_to_soil_col(c) & + + nf%man_n_transf_col(c) + flux_loss + + nf%fan_totnin(c) = fluxin + nf%fan_totnout(c) = fluxout + + end do + + end subroutine update_summary + + !************************************************************************************ + + subroutine fan_to_sminn(filter_soilc, num_soilc, sbgc_nf) + use ColumnType, only : col + use LandunitType , only: lun + use landunit_varcon, only : istcrop + integer, intent(in) :: filter_soilc(:) + integer, intent(in) :: num_soilc + type(soilbiogeochem_nitrogenflux_type), intent(inout) :: sbgc_nf + + integer :: c, fc + real(r8) :: fan_nitr + + do fc = 1, num_soilc + c = filter_soilc(c) + fan_nitr & + = sbgc_nf%fert_no3_prod_col(c) + sbgc_nf%fert_nh4_to_soil_col(c) & + + sbgc_nf%manure_no3_prod_col(c) + sbgc_nf%manure_nh4_to_soil_col(c) + if (lun%itype(col%landunit(c)) == istcrop .and. fan_to_bgc_crop) then + sbgc_nf%fert_to_sminn_col(c) = fan_nitr + else if (fan_to_bgc_veg) then + sbgc_nf%fert_to_sminn_col(c) = fan_nitr + end if + end do + + end subroutine fan_to_sminn + +end module fan2ctsm diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 index c3677367d9..03b2cbb0d6 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 @@ -53,7 +53,9 @@ module SoilBiogeochemNitrogenFluxType real(r8), pointer :: manure_runoff_col (:) ! NH4 runoff flux from manure, gN/m2/s real(r8), pointer :: fert_runoff_col (:) ! NH4 runoff flux from fertilizer, gN/m2/s - real(r8), pointer :: nh3_total_col (:) ! Total NH3 emission from agriculture + real(r8), pointer :: nh3_total_col (:) ! Total NH3 emission from agriculture, gN/m2/s + real(r8), pointer :: fan_totnout (:) ! Total input N into FAN pools, gN/m2/s + real(r8), pointer :: fan_totnin (:) ! Total output N from FAN pools, gN/m2/s ! decomposition fluxes real(r8), pointer :: decomp_cascade_ntransfer_vr_col (:,:,:) ! col vert-res transfer of N from donor to receiver pool along decomp. cascade (gN/m3/s) @@ -226,6 +228,8 @@ subroutine InitAllocate(this, bounds) allocate(this%nh3_otherfert_col (begc:endc)) ; this%nh3_otherfert_col (:) = spval allocate(this%nh3_total_col (begc:endc)) ; this%nh3_total_col (:) = spval + allocate(this%nh3_total_col (begc:endc)) ; this%nh3_total_col (:) = spval + allocate(this%manure_no3_prod_col (begc:endc)) ; this%manure_no3_prod_col (:) = spval allocate(this%fert_no3_prod_col (begc:endc)) ; this%fert_no3_prod_col (:) = spval allocate(this%manure_nh4_to_soil_col (begc:endc)) ; this%manure_nh4_to_soil_col (:) = spval @@ -233,7 +237,10 @@ subroutine InitAllocate(this, bounds) allocate(this%manure_runoff_col (begc:endc)) ; this%manure_runoff_col (:) = spval allocate(this%fert_runoff_col (begc:endc)) ; this%fert_runoff_col (:) = spval end if - + ! Allocate FAN summary fluxes even if FAN is off and set them to 0. + allocate(this%fan_totnin (begc:endc)) ; this%fan_totnin (:) = 0.0_r8 + allocate(this%fan_totnout (begc:endc)) ; this%fan_totnout (:) = 0.0_r8 + allocate(this%sminn_to_plant_col (begc:endc)) ; this%sminn_to_plant_col (:) = nan allocate(this%potential_immob_col (begc:endc)) ; this%potential_immob_col (:) = nan allocate(this%actual_immob_col (begc:endc)) ; this%actual_immob_col (:) = nan @@ -371,115 +378,121 @@ subroutine InitHistory(this, bounds) ptr_col=this%ndep_to_sminn_col) if (use_fan) then - this%man_tan_appl_col(begc:endc) = spval - call hist_addfld1d( fname='MAN_TAN_APP', units='gN/m^2/s', & - avgflag='A', long_name='Manure TAN applied on soil', & - ptr_col=this%man_tan_appl_col) - - this%man_n_appl_col(begc:endc) = spval - call hist_addfld1d( fname='MAN_N_APP', units='gN/m^2/s', & - avgflag='A', long_name='Manure N applied on soil', & - ptr_col=this%man_n_appl_col) - - this%man_n_grz_col(begc:endc) = spval - call hist_addfld1d( fname='MAN_N_GRZ', units='gN/m^2/s', & - avgflag='A', long_name='Manure N from grazing animals', & - ptr_col=this%man_n_grz_col) - - this%man_n_mix_col(begc:endc) = spval - call hist_addfld1d( fname='MAN_N_MIX', units='gN/m^2/s', & - avgflag='A', long_name='Manure N in produced mixed systems', & - ptr_col=this%man_n_mix_col) - - this%man_n_barns_col(begc:endc) = spval - call hist_addfld1d( fname='MAN_N_BARNS', units='gN/m^2/s', & - avgflag='A', long_name='Manure N in produced barns', & - ptr_col=this%man_n_barns_col) - - this%fert_n_appl_col(begc:endc) = spval - call hist_addfld1d( fname='FERT_N_APP', units='gN/m^2/s', & - avgflag='A', long_name='Fertilizer N applied on soil', & - ptr_col=this%fert_n_appl_col) - - this%otherfert_n_appl_col(begc:endc) = spval - call hist_addfld1d( fname='OTHERFERT_N_APP', units='gN/m^2/s', & - avgflag='A', long_name='Non-urea fertilizer N applied on soil', & - ptr_col=this%otherfert_n_appl_col) - - this%man_n_transf_col(begc:endc) = spval - call hist_addfld1d( fname='MAN_N_TRANSF', units='gN/m^2/s', & - avgflag='A', long_name='Manure N moved from crop to natural column', & - ptr_col=this%man_n_transf_col) - - this%nh3_barns_col(begc:endc) = spval - call hist_addfld1d( fname='NH3_BARNS', units='gN/m^2/s', & - avgflag='A', long_name='NH3 emitted from animal housings', & - ptr_col=this%nh3_barns_col) - - this%nh3_stores_col(begc:endc) = spval - call hist_addfld1d( fname='NH3_STORES', units='gN/m^2/s', & - avgflag='A', long_name='NH3 emitted from stored manure', & - ptr_col=this%nh3_stores_col) - - this%nh3_grz_col(begc:endc) = spval - call hist_addfld1d( fname='NH3_GRZ', units='gN/m^2/s', & - avgflag='A', long_name='NH3 emitted from manure on pastures', & - ptr_col=this%nh3_grz_col) - - this%nh3_man_app_col(begc:endc) = spval - call hist_addfld1d( fname='NH3_MAN_APP', units='gN/m^2/s', & - avgflag='A', long_name='NH3 emitted from manure applied on crops and grasslands', & - ptr_col=this%nh3_man_app_col) - - this%nh3_fert_col(begc:endc) = spval - call hist_addfld1d( fname='NH3_FERT', units='gN/m^2/s', & - avgflag='A', long_name='NH3 emitted from fertilizer applied on crops', & - ptr_col=this%nh3_fert_col) - - this%nh3_otherfert_col(begc:endc) = spval - call hist_addfld1d( fname='NH3_OTHERFERT', units='gN/m^2/s', & - avgflag='A', long_name='NH3 emitted from fertilizers other than urea', & - ptr_col=this%nh3_otherfert_col) - - - this%nh3_total_col(begc:endc) = spval - call hist_addfld1d( fname='NH3_TOTAL', units='gN/m^2/s', & - avgflag='A', long_name='Total NH3 emitted from fertilizers and manure', & - ptr_col=this%nh3_total_col) - - - this%manure_no3_prod_col(begc:endc) = spval - call hist_addfld1d( fname='MANURE_NO3_PROD', units='gN/m^2/s', & - avgflag='A', long_name='Manure nitrification flux', & - ptr_col=this%manure_no3_prod_col) - - this%fert_no3_prod_col(begc:endc) = spval - call hist_addfld1d( fname='FERT_NO3_PROD', units='gN/m^2/s', & - avgflag='A', long_name='Fertilizer nitrification flux', & - ptr_col=this%fert_no3_prod_col) - - this%fert_nh4_to_soil_col(begc:endc) = spval - call hist_addfld1d( fname='FERT_NH4_TO_SOIL', units='gN/m^2/s', & - avgflag='A', long_name='Flux of NH4 to soil mineral pools, fertilizer', & - ptr_col=this%fert_nh4_to_soil_col) - - this%manure_nh4_to_soil_col(begc:endc) = spval - call hist_addfld1d( fname='MANURE_NH3_TO_SOIL', units='gN/m^2/s', & - avgflag='A', long_name='Flux of NH4 to soil mineral pools, manure', & - ptr_col=this%manure_nh4_to_soil_col) - - - this%manure_runoff_col(begc:endc) = spval - call hist_addfld1d( fname='MANURE_RUNOFF', units='gN/m^2/s', & - avgflag='A', long_name='NH4 in surface runoff, manure', & - ptr_col=this%manure_runoff_col) - - this%fert_runoff_col(begc:endc) = spval - call hist_addfld1d( fname='FERT_RUNOFF', units='gN/m^2/s', & - avgflag='A', long_name='NH4 in surface runoff, fertilizer', & - ptr_col=this%fert_runoff_col) - end if + this%man_tan_appl_col(begc:endc) = spval + call hist_addfld1d( fname='MAN_TAN_APP', units='gN/m^2/s', & + avgflag='A', long_name='Manure TAN applied on soil', & + ptr_col=this%man_tan_appl_col) + + this%man_n_appl_col(begc:endc) = spval + call hist_addfld1d( fname='MAN_N_APP', units='gN/m^2/s', & + avgflag='A', long_name='Manure N applied on soil', & + ptr_col=this%man_n_appl_col) + + this%man_n_grz_col(begc:endc) = spval + call hist_addfld1d( fname='MAN_N_GRZ', units='gN/m^2/s', & + avgflag='A', long_name='Manure N from grazing animals', & + ptr_col=this%man_n_grz_col) + + this%man_n_mix_col(begc:endc) = spval + call hist_addfld1d( fname='MAN_N_MIX', units='gN/m^2/s', & + avgflag='A', long_name='Manure N in produced mixed systems', & + ptr_col=this%man_n_mix_col) + + this%man_n_barns_col(begc:endc) = spval + call hist_addfld1d( fname='MAN_N_BARNS', units='gN/m^2/s', & + avgflag='A', long_name='Manure N in produced barns', & + ptr_col=this%man_n_barns_col) + + this%fert_n_appl_col(begc:endc) = spval + call hist_addfld1d( fname='FERT_N_APP', units='gN/m^2/s', & + avgflag='A', long_name='Fertilizer N applied on soil', & + ptr_col=this%fert_n_appl_col) + + this%otherfert_n_appl_col(begc:endc) = spval + call hist_addfld1d( fname='OTHERFERT_N_APP', units='gN/m^2/s', & + avgflag='A', long_name='Non-urea fertilizer N applied on soil', & + ptr_col=this%otherfert_n_appl_col) + + this%man_n_transf_col(begc:endc) = spval + call hist_addfld1d( fname='MAN_N_TRANSF', units='gN/m^2/s', & + avgflag='A', long_name='Manure N moved from crop to natural column', & + ptr_col=this%man_n_transf_col) + + this%nh3_barns_col(begc:endc) = spval + call hist_addfld1d( fname='NH3_BARNS', units='gN/m^2/s', & + avgflag='A', long_name='NH3 emitted from animal housings', & + ptr_col=this%nh3_barns_col) + + this%nh3_stores_col(begc:endc) = spval + call hist_addfld1d( fname='NH3_STORES', units='gN/m^2/s', & + avgflag='A', long_name='NH3 emitted from stored manure', & + ptr_col=this%nh3_stores_col) + + this%nh3_grz_col(begc:endc) = spval + call hist_addfld1d( fname='NH3_GRZ', units='gN/m^2/s', & + avgflag='A', long_name='NH3 emitted from manure on pastures', & + ptr_col=this%nh3_grz_col) + + this%nh3_man_app_col(begc:endc) = spval + call hist_addfld1d( fname='NH3_MAN_APP', units='gN/m^2/s', & + avgflag='A', long_name='NH3 emitted from manure applied on crops and grasslands', & + ptr_col=this%nh3_man_app_col) + + this%nh3_fert_col(begc:endc) = spval + call hist_addfld1d( fname='NH3_FERT', units='gN/m^2/s', & + avgflag='A', long_name='NH3 emitted from fertilizer applied on crops', & + ptr_col=this%nh3_fert_col) + + this%nh3_otherfert_col(begc:endc) = spval + call hist_addfld1d( fname='NH3_OTHERFERT', units='gN/m^2/s', & + avgflag='A', long_name='NH3 emitted from fertilizers other than urea', & + ptr_col=this%nh3_otherfert_col) + + this%nh3_total_col(begc:endc) = spval + call hist_addfld1d( fname='NH3_TOTAL', units='gN/m^2/s', & + avgflag='A', long_name='Total NH3 emitted from fertilizers and manure', & + ptr_col=this%nh3_total_col) + + this%manure_no3_prod_col(begc:endc) = spval + call hist_addfld1d( fname='MANURE_NO3_PROD', units='gN/m^2/s', & + avgflag='A', long_name='Manure nitrification flux', & + ptr_col=this%manure_no3_prod_col) + + this%fert_no3_prod_col(begc:endc) = spval + call hist_addfld1d( fname='FERT_NO3_PROD', units='gN/m^2/s', & + avgflag='A', long_name='Fertilizer nitrification flux', & + ptr_col=this%fert_no3_prod_col) + + this%fert_nh4_to_soil_col(begc:endc) = spval + call hist_addfld1d( fname='FERT_NH4_TO_SOIL', units='gN/m^2/s', & + avgflag='A', long_name='Flux of NH4 to soil mineral pools, fertilizer', & + ptr_col=this%fert_nh4_to_soil_col) + + this%manure_nh4_to_soil_col(begc:endc) = spval + call hist_addfld1d( fname='MANURE_NH3_TO_SOIL', units='gN/m^2/s', & + avgflag='A', long_name='Flux of NH4 to soil mineral pools, manure', & + ptr_col=this%manure_nh4_to_soil_col) + + + this%manure_runoff_col(begc:endc) = spval + call hist_addfld1d( fname='MANURE_RUNOFF', units='gN/m^2/s', & + avgflag='A', long_name='NH4 in surface runoff, manure', & + ptr_col=this%manure_runoff_col) + + this%fert_runoff_col(begc:endc) = spval + call hist_addfld1d( fname='FERT_RUNOFF', units='gN/m^2/s', & + avgflag='A', long_name='NH4 in surface runoff, fertilizer', & + ptr_col=this%fert_runoff_col) + end if + this%fan_totnin(begc:endc) = spval + call hist_addfld1d(fname='FAN_TOTNIN', units='gN/m^2/s', & + avgflag='A', long_name='Total N input into FAN', & + ptr_col=this%fan_totnin, default='inactive') + call hist_addfld1d(fname='FAN_TOTNOUT', units='gN/m^2/s', & + avgflag='A', long_name='Total N output from FAN', & + ptr_col=this%fan_totnout, default='inactive') + if (use_fun) then default = 'inactive' else diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 index 2789c624c6..e8e93a1028 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 @@ -71,6 +71,8 @@ module SoilBiogeochemNitrogenStateType real(r8), pointer :: man_tan_stored_col(:) ! col (gN/m2) manure TAN in storage real(r8), pointer :: fan_grz_fract_col(:) ! col unitless fraction of animals grazing + real(r8), pointer :: fan_totn_col(:) ! col (gN/m2) total N in FAN pools + ! summary (diagnostic) state variables, not involved in mass balance real(r8), pointer :: decomp_npools_col (:,:) ! col (gN/m2) decomposing (litter, cwd, soil) N pools real(r8), pointer :: decomp_npools_1m_col (:,:) ! col (gN/m2) diagnostic: decomposing (litter, cwd, soil) N pools to 1 meter @@ -195,6 +197,8 @@ subroutine InitAllocate(this, bounds) allocate(this%fan_grz_fract_col(begc:endc)) ; this%fan_grz_fract_col(:) = nan end if + ! Always allocate FAN total N, stays 0 if FAN is inactive. + allocate(this%fan_totn_col(begc:endc)) ; this%fan_totn_col(:) = nan end subroutine InitAllocate @@ -465,8 +469,12 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='Fraction of animals grazing', & ptr_col=this%fan_grz_fract_col) - end if + + this%fan_totn_col(begc:endc) = spval + call hist_addfld1d (fname='FAN_TOTN', units='gN/m2', & + avgflag='A', long_name='FAN total N', & + ptr_col=this%fan_totn_col, default='inactive') if (use_nitrif_denitrif) then @@ -582,7 +590,7 @@ subroutine InitCold(this, bounds, & this%man_n_stored_col(c) = 0.0_r8 end if - + this%fan_totn_col(c) = 0.0_r8 end if end do @@ -789,8 +797,11 @@ subroutine Restart ( this, bounds, ncid, flag, totvegc_col ) dim1name='column', long_name='', units='', & interpinic_flag='interp', readvar=readvar, data=this%fan_grz_fract_col) - !JV end if + call restartvar(ncid=ncid, flag=flag, varname='fan_totn', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%fan_totn_col) + if (use_nitrif_denitrif) then ! smin_nh4 From 6c41b797723ca7b01e654b9e049ce1a7c9f3abaa Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Mon, 4 Mar 2019 17:16:27 -0500 Subject: [PATCH 053/181] Introducing fan pools & fluxes to the soil N balance check --- src/biogeochem/CNBalanceCheckMod.F90 | 10 ++++++++-- src/biogeochem/CNVegNitrogenStateType.F90 | 3 ++- src/biogeochem/Fan2CTSMMod.F90 | 4 ++-- .../SoilBiogeochemNitrogenFluxType.F90 | 17 ++++++++++------- 4 files changed, 22 insertions(+), 12 deletions(-) diff --git a/src/biogeochem/CNBalanceCheckMod.F90 b/src/biogeochem/CNBalanceCheckMod.F90 index f2811d290a..b3a611be99 100644 --- a/src/biogeochem/CNBalanceCheckMod.F90 +++ b/src/biogeochem/CNBalanceCheckMod.F90 @@ -266,10 +266,13 @@ subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & f_n2o_nit => soilbiogeochem_nitrogenflux_inst%f_n2o_nit_col , & ! Input: [real(r8) (:) ] (gN/m2/s) flux of N2o from nitrification som_n_leached => soilbiogeochem_nitrogenflux_inst%som_n_leached_col , & ! Input: [real(r8) (:) ] (gN/m2/s) total SOM N loss from vertical transport + fan_totnin => soilbiogeochem_nitrogenflux_inst%fan_totnin_col , & ! Input: [real(r8) (:) ] (gN/m2/s) total N input into the FAN pools + fan_totnout => soilbiogeochem_nitrogenflux_inst%fan_totnout_col , & ! Input: [real(r8) (:) ] (gN/m2/s) total N output from the FAN pools + col_fire_nloss => cnveg_nitrogenflux_inst%fire_nloss_col , & ! Input: [real(r8) (:) ] (gN/m2/s) total column-level fire N loss wood_harvestn => cnveg_nitrogenflux_inst%wood_harvestn_col , & ! Input: [real(r8) (:) ] (gN/m2/s) wood harvest (to product pools) grainn_to_cropprodn => cnveg_nitrogenflux_inst%grainn_to_cropprodn_col , & ! Input: [real(r8) (:) ] (gN/m2/s) grain N to 1-year crop product pool - + totcoln => cnveg_nitrogenstate_inst%totn_col & ! Input: [real(r8) (:) ] (gN/m2) total column nitrogen, incl veg ) @@ -294,6 +297,8 @@ subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & col_ninputs(c) = col_ninputs(c) + fert_to_sminn(c) + soyfixn_to_sminn(c) end if + col_ninputs(c) = col_ninputs(c) + fan_totnin(c) + ! calculate total column-level outputs col_noutputs(c) = denit(c) + col_fire_nloss(c) @@ -315,7 +320,8 @@ subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & end if col_noutputs(c) = col_noutputs(c) - som_n_leached(c) - + col_noutputs(c) = col_noutputs(c) + fan_totnout(c) + ! calculate the total column-level nitrogen balance error for this time step col_errnb(c) = (col_ninputs(c) - col_noutputs(c))*dt - & (col_endnb(c) - col_begnb(c)) diff --git a/src/biogeochem/CNVegNitrogenStateType.F90 b/src/biogeochem/CNVegNitrogenStateType.F90 index 4468bfce44..4ca8061877 100644 --- a/src/biogeochem/CNVegNitrogenStateType.F90 +++ b/src/biogeochem/CNVegNitrogenStateType.F90 @@ -1072,7 +1072,8 @@ subroutine Summary_nitrogenstate(this, bounds, num_allc, filter_allc, & soilbiogeochem_nitrogenstate_inst%totlitn_col(c) + & soilbiogeochem_nitrogenstate_inst%totsomn_col(c) + & soilbiogeochem_nitrogenstate_inst%sminn_col(c) + & - soilbiogeochem_nitrogenstate_inst%ntrunc_col(c) + soilbiogeochem_nitrogenstate_inst%ntrunc_col(c) + & + soilbiogeochem_nitrogenstate_inst%fan_totn_col(c) end do diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index 131d9a614e..d68174e1cc 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -926,8 +926,8 @@ subroutine update_summary(ns, nf, filter_soilc, num_soilc) + nf%manure_no3_prod_col(c) + nf%manure_nh4_to_soil_col(c) & + nf%man_n_transf_col(c) + flux_loss - nf%fan_totnin(c) = fluxin - nf%fan_totnout(c) = fluxout + nf%fan_totnin_col(c) = fluxin + nf%fan_totnout_col(c) = fluxout end do diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 index 03b2cbb0d6..161749ae4f 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 @@ -54,8 +54,8 @@ module SoilBiogeochemNitrogenFluxType real(r8), pointer :: fert_runoff_col (:) ! NH4 runoff flux from fertilizer, gN/m2/s real(r8), pointer :: nh3_total_col (:) ! Total NH3 emission from agriculture, gN/m2/s - real(r8), pointer :: fan_totnout (:) ! Total input N into FAN pools, gN/m2/s - real(r8), pointer :: fan_totnin (:) ! Total output N from FAN pools, gN/m2/s + real(r8), pointer :: fan_totnout_col (:) ! Total input N into FAN pools, gN/m2/s + real(r8), pointer :: fan_totnin_col (:) ! Total output N from FAN pools, gN/m2/s ! decomposition fluxes real(r8), pointer :: decomp_cascade_ntransfer_vr_col (:,:,:) ! col vert-res transfer of N from donor to receiver pool along decomp. cascade (gN/m3/s) @@ -238,8 +238,8 @@ subroutine InitAllocate(this, bounds) allocate(this%fert_runoff_col (begc:endc)) ; this%fert_runoff_col (:) = spval end if ! Allocate FAN summary fluxes even if FAN is off and set them to 0. - allocate(this%fan_totnin (begc:endc)) ; this%fan_totnin (:) = 0.0_r8 - allocate(this%fan_totnout (begc:endc)) ; this%fan_totnout (:) = 0.0_r8 + allocate(this%fan_totnin_col (begc:endc)) ; this%fan_totnin_col (:) = spval + allocate(this%fan_totnout_col (begc:endc)) ; this%fan_totnout_col (:) = spval allocate(this%sminn_to_plant_col (begc:endc)) ; this%sminn_to_plant_col (:) = nan allocate(this%potential_immob_col (begc:endc)) ; this%potential_immob_col (:) = nan @@ -485,13 +485,14 @@ subroutine InitHistory(this, bounds) ptr_col=this%fert_runoff_col) end if - this%fan_totnin(begc:endc) = spval + this%fan_totnin_col(begc:endc) = spval call hist_addfld1d(fname='FAN_TOTNIN', units='gN/m^2/s', & avgflag='A', long_name='Total N input into FAN', & - ptr_col=this%fan_totnin, default='inactive') + ptr_col=this%fan_totnin_col, default='inactive') + this%fan_totnout_col(begc:endc) = spval call hist_addfld1d(fname='FAN_TOTNOUT', units='gN/m^2/s', & avgflag='A', long_name='Total N output from FAN', & - ptr_col=this%fan_totnout, default='inactive') + ptr_col=this%fan_totnout_col, default='inactive') if (use_fun) then default = 'inactive' @@ -1162,6 +1163,8 @@ subroutine SetValues ( this, & this%ninputs_col(i) = value_column this%noutputs_col(i) = value_column this%som_n_leached_col(i) = value_column + this%fan_totnin_col(i) = value_column + this%fan_totnout_col(i) = value_column end do if ( use_fan ) then From de079be0a9a7ae7e4640e76c28cf407a09d0cbda Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Tue, 5 Mar 2019 11:01:19 -0500 Subject: [PATCH 054/181] namelist parameters for fan-bgc coupling --- bld/CLMBuildNamelist.pm | 8 ++++++++ bld/namelist_files/namelist_defaults_ctsm.xml | 3 ++- bld/namelist_files/namelist_definition_ctsm.xml | 9 +++++++++ 3 files changed, 19 insertions(+), 1 deletion(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 99530f3dcb..1a7db77262 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -3074,6 +3074,14 @@ sub setup_logic_fan_nml { 'bgc'=>$nl_flags->{'bgc_mode'}, 'hgrid'=>"360x720cru" ); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fan_to_bgc_crop', + 'use_cn'=>$nl_flags->{'use_cn'}, 'use_ed'=>$nl_flags->{'use_ed'} ); + $nl_flags->{'fan_to_bgc_crop'} = $nl->get_value('fan_to_bgc_crop'); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fan_to_bgc_veg', + 'use_cn'=>$nl_flags->{'use_cn'}, 'use_ed'=>$nl_flags->{'use_ed'} ); + $nl_flags->{'use_veg'} = $nl->get_value('fan_to_bgc_veg'); + + } elsif ( $nl_flags->{'bgc_mode'} =~/cn|bgc/ && value_is_true( $nl_flags->{'use_fan'} ) ) { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fan_mapalgo', 'phys'=>$nl_flags->{'phys'}, 'use_cn'=>$nl_flags->{'use_cn'}, 'hgrid'=>$nl_flags->{'res'}, diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 04f9ce462d..b71efbc5c5 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -1051,7 +1051,8 @@ lnd/clm2/surfdata_map/surfdata_ne120np4_78pfts_CMIP6_simyr1850_c170824.ncnn nn nn - +.false. +.false. .false. diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index 270180473f..92710844b2 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -1589,6 +1589,15 @@ Mapping method from FAN Nitrogen (manure) deposition input file to the model res copy = copy using the same indices + +Toggle to connect the FAN N pools to soil biogeochemistry for CROP columns + + + +Toggle to connect the FAN N pools to soil biogeochemistry for NATIVE VEGETATION columns + From a95a6e185fd2f2c42ed644c2bda71a55672868b8 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Tue, 5 Mar 2019 11:02:26 -0500 Subject: [PATCH 055/181] add call to fan_eval --- src/biogeochem/CNNDynamicsMod.F90 | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index c7d6b57ad7..7a7eef8867 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -190,6 +190,16 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & end do end associate + if (use_fan) then + call fan_eval(bounds, num_soilc, filter_soilc, & + atm2lnd_inst, wateratm2lndbulk_inst, & + cnveg_nitrogenflux_inst, & + soilbiogeochem_nitrogenflux_inst, & + soilbiogeochem_nitrogenstate_inst, & + waterstatebulk_inst, soilstate_inst, temperature_inst, & + waterfluxbulk_inst, frictionvel_inst) + end if + end subroutine CNNDeposition !----------------------------------------------------------------------- From 2e36926b99d53f4d8fd7567908ebb734aa234b98 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Tue, 5 Mar 2019 11:02:38 -0500 Subject: [PATCH 056/181] debug the debug checks --- src/biogeochem/Fan2CTSMMod.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index 131d9a614e..4e9ea572d0 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -144,6 +144,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & use landunit_varcon, only: istsoil, istcrop use clm_varcon, only : spval, ispval use decompMod, only : bounds_type + use subgridAveMod, only: p2c type(bounds_type) , intent(in) :: bounds integer , intent(in) :: num_soilc ! number of soil columns in filter @@ -381,10 +382,10 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & bsw, poolranges_grz, Hconc_grz, dz_layer_grz, tanpools3, & fluxes3(1:5,:), garbage, dt/num_substeps, status, 3) if (status /= 0) then - write(iulog, *) 'status = ', status, tanpools2, ratm, theta, thetasat, tandep, tanprod + write(iulog, *) 'status = ', status, tanpools3, ratm, theta, thetasat, tandep, tanprod call endrun(msg='update_npool status /= 0') end if - if (debug_fan .and. any(isnan(tanpools2))) then + if (debug_fan .and. any(isnan(tanpools3))) then call endrun('nan2') end if fluxes_tmp = fluxes_tmp + sum(fluxes3, dim=2) From 6c1162343acc7626e6f76b63442a8fdfbc56f4f2 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Tue, 5 Mar 2019 16:34:44 -0500 Subject: [PATCH 057/181] more bgc coupling + initialization --- src/biogeochem/CNNDynamicsMod.F90 | 52 ++++++++------ src/biogeochem/CNPhenologyMod.F90 | 18 ++--- src/biogeochem/CNVegNitrogenFluxType.F90 | 27 +++---- src/biogeochem/Fan2CTSMMod.F90 | 91 +++++++++++++++++++----- src/main/controlMod.F90 | 9 ++- src/main/fanStreamMod.F90 | 75 +++++++++---------- 6 files changed, 158 insertions(+), 114 deletions(-) diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index 7a7eef8867..d0e22f3850 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -15,14 +15,12 @@ module CNNDynamicsMod use Wateratm2lndBulkType , only : wateratm2lndbulk_type use CNVegStateType , only : cnveg_state_type use CNVegCarbonFluxType , only : cnveg_carbonflux_type -!KO use CNVegCarbonStateType , only : cnveg_carbonstate_type use SoilBiogeochemCarbonFluxType , only : soilbiogeochem_carbonflux_type use TemperatureType , only : temperature_type use FrictionVelocityMod , only : frictionvel_type use clm_varctl , only : iulog use shr_infnan_mod , only : isnan => shr_infnan_isnan -!KO use CNVegNitrogenStateType , only : cnveg_nitrogenstate_type use CNVegNitrogenFluxType , only : cnveg_nitrogenflux_type use SoilBiogeochemStateType , only : soilbiogeochem_state_type @@ -30,16 +28,16 @@ module CNNDynamicsMod use SoilBiogeochemNitrogenFluxType , only : soilbiogeochem_nitrogenflux_type use WaterStateBulkType , only : waterstatebulk_type use WaterFluxBulkType , only : waterfluxbulk_type - !JV use SoilStateType , only : soilstate_type - !JV - use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type - use WaterFluxBulkType , only : waterfluxbulk_type + use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type + use WaterFluxBulkType , only : waterfluxbulk_type use CropType , only : crop_type use ColumnType , only : col use PatchType , only : patch use perf_mod , only : t_startf, t_stopf use FanMod + use clm_varctl , only: use_fan + ! implicit none private @@ -138,32 +136,25 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & waterstatebulk_inst, soilstate_inst, temperature_inst, & waterfluxbulk_inst, frictionvel_inst) use CNSharedParamsMod , only: use_fun - !KO - use clm_varctl , only: use_fan -! use subgridAveMod , only: p2c use clm_time_manager , only: get_step_size, get_curr_date, get_curr_calday, get_nstep use clm_varpar , only: max_patch_per_col use LandunitType , only: lun - use shr_sys_mod , only : shr_sys_flush -!KO use ColumnType , only: col + use shr_sys_mod , only : shr_sys_flush use GridcellType , only: grc - use clm_varctl , only : iulog - use abortutils , only : endrun - use pftconMod, only : nc4_grass, nc3_nonarctic_grass - use landunit_varcon, only: istsoil, istcrop - use clm_varcon, only : spval, ispval - use fan2ctsm + use clm_varctl , only : iulog + use abortutils , only : endrun + use pftconMod , only : nc4_grass, nc3_nonarctic_grass + use landunit_varcon , only: istsoil, istcrop + use clm_varcon , only : spval, ispval + use Fan2ctsmMod type(bounds_type) , intent(in) :: bounds -!KO integer , intent(in) :: num_soilc ! number of soil columns in filter integer , intent(in) :: filter_soilc(:) ! filter for soil columns -!KO type(atm2lnd_type) , intent(in) :: atm2lnd_inst type(wateratm2lndbulk_type), intent(in) :: wateratm2lndbulk_inst type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst -!KO type(cnveg_carbonstate_type) , intent(inout) :: cnveg_carbonstate_inst type(cnveg_nitrogenstate_type) , intent(inout) :: cnveg_nitrogenstate_inst type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst @@ -311,6 +302,7 @@ end subroutine CNNFixation !----------------------------------------------------------------------- subroutine CNNFert(bounds, num_soilc, filter_soilc, & cnveg_nitrogenflux_inst, soilbiogeochem_nitrogenflux_inst) + use Fan2CTSMMod, only : fan_to_sminn ! ! !DESCRIPTION: ! On the radiation time step, update the nitrogen fertilizer for crops @@ -327,19 +319,33 @@ subroutine CNNFert(bounds, num_soilc, filter_soilc, & ! ! !LOCAL VARIABLES: integer :: c,fc ! indices + real(r8) :: manure_col(bounds%begc:bounds%endc) + !----------------------------------------------------------------------- associate( & - fert => cnveg_nitrogenflux_inst%fert_patch , & ! Input: [real(r8) (:)] nitrogen fertilizer rate (gN/m2/s) + fert => cnveg_nitrogenflux_inst%fert_patch , & ! Input: [real(r8) (:)] nitrogen fertilizer rate (gN/m2/s) + manure => cnveg_nitrogenflux_inst%manure_patch , & ! Input: [real(r8) (:)] manure nitrogen rate (gN/m2/s) fert_to_sminn => soilbiogeochem_nitrogenflux_inst%fert_to_sminn_col & ! Output: [real(r8) (:)] ) - call p2c(bounds, num_soilc, filter_soilc, & fert(bounds%begp:bounds%endp), & fert_to_sminn(bounds%begc:bounds%endc)) - + call p2c(bounds, num_soilc, filter_soilc, & + manure(bounds%begp:bounds%endp), & + manure_col) + ! Add the manure N processed above: + do fc = 1, fc + c = filter_soilc(fc) + fert_to_sminn(c) = fert_to_sminn(c) + manure_col(c) + end do + end associate + ! Fan may overwrite fert_to_sminn for some or all columns if enabled. + ! + if (use_fan) call fan_to_sminn(filter_soilc, num_soilc, soilbiogeochem_nitrogenflux_inst) + end subroutine CNNFert !----------------------------------------------------------------------- diff --git a/src/biogeochem/CNPhenologyMod.F90 b/src/biogeochem/CNPhenologyMod.F90 index d9dd515b36..67fc39007f 100644 --- a/src/biogeochem/CNPhenologyMod.F90 +++ b/src/biogeochem/CNPhenologyMod.F90 @@ -1442,7 +1442,7 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & use pftconMod , only : nirrig_trp_corn, nirrig_sugarcane, nirrig_trp_soybean use pftconMod , only : nirrig_cotton, nirrig_rice use clm_varcon , only : spval, secspday - use clm_varctl , only : use_fertilizer, use_fan + use clm_varctl , only : use_fertilizer use clm_varctl , only : use_c13, use_c14 use clm_varcon , only : c13ratio, c14ratio use LandunitType , only: lun @@ -1537,8 +1537,7 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & crop_seedn_to_leaf => cnveg_nitrogenflux_inst%crop_seedn_to_leaf_patch, & ! Output: [real(r8) (:) ] (gN/m2/s) seed source to leaf cphase => crop_inst%cphase_patch , & ! Output: [real(r8) (:)] phenology phase fert => cnveg_nitrogenflux_inst%fert_patch , & ! Output: [real(r8) (:) ] (gN/m2/s) fertilizer applied each timestep - manu => cnveg_nitrogenflux_inst%manu_patch , & ! Output: [real(r8) (:) ] (gN/m2/s) manure applied each timestep - manurestore => soilbiogeochem_nitrogenstate_inst%man_n_stored_col & ! Input: [real(r8) (:) ] manure nitrogen available for fertilization + manure => cnveg_nitrogenflux_inst%manure_patch & ! Output: [real(r8) (:) ] (gN/m2/s) manure applied each timestep ) ! get time info @@ -1954,16 +1953,11 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & onset_counter(p) = dt fert_counter(p) = ndays_on * secspday if (ndays_on .gt. 0) then - if (use_fan) then - fert(p) = fertnitro(p) / fert_counter(p) - manu(p) = manurestore(c) / fert_counter(p) - ! manurestore(c) not changed here but in FAN code - else - fert(p) = (manunitro(ivt(p)) * 1000._r8 + fertnitro(p))/ fert_counter(p) - end if + fert(p) = fertnitro(p) / fert_counter(p) + manure(p) = (manunitro(ivt(p)) * 1000._r8) / fert_counter(p) else fert(p) = 0._r8 - if (use_fan) manu(p) = 0._r8 + manure(p) = 0._r8 end if else ! this ensures no re-entry to onset of phase2 @@ -2022,7 +2016,7 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & if (fert_counter(p) <= 0._r8) then fert(p) = 0._r8 - if (use_fan) manu(p) = 0._r8 + manure(p) = 0._r8 else ! continue same fert application every timestep fert_counter(p) = fert_counter(p) - dtrad end if diff --git a/src/biogeochem/CNVegNitrogenFluxType.F90 b/src/biogeochem/CNVegNitrogenFluxType.F90 index 4e2f9ddadc..9f4b25080d 100644 --- a/src/biogeochem/CNVegNitrogenFluxType.F90 +++ b/src/biogeochem/CNVegNitrogenFluxType.F90 @@ -6,7 +6,7 @@ module CNVegNitrogenFluxType use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools use clm_varpar , only : nlevdecomp_full, nlevdecomp use clm_varcon , only : spval, ispval, dzsoi_decomp - use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_crop, use_fan, iulog + use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_crop, iulog use CNSharedParamsMod , only : use_fun use decompMod , only : bounds_type use abortutils , only : endrun @@ -165,7 +165,7 @@ module CNVegNitrogenFluxType real(r8), pointer :: livecrootn_storage_to_xfer_patch (:) ! patch live coarse root N shift storage to transfer (gN/m2/s) real(r8), pointer :: deadcrootn_storage_to_xfer_patch (:) ! patch dead coarse root N shift storage to transfer (gN/m2/s) real(r8), pointer :: fert_patch (:) ! patch applied fertilizer (gN/m2/s) - real(r8), pointer :: manu_patch (:) ! patch applied manure (gN/m2/s) + real(r8), pointer :: manure_patch (:) ! patch applied manure (gN/m2/s) real(r8), pointer :: fert_counter_patch (:) ! patch >0 fertilize; <=0 not real(r8), pointer :: soyfixn_patch (:) ! patch soybean fixed N (gN/m2/s) @@ -419,7 +419,7 @@ subroutine InitAllocate(this, bounds) allocate(this%grainn_xfer_to_grainn_patch (begp:endp)) ; this%grainn_xfer_to_grainn_patch (:) = nan allocate(this%grainn_storage_to_xfer_patch (begp:endp)) ; this%grainn_storage_to_xfer_patch (:) = nan allocate(this%fert_patch (begp:endp)) ; this%fert_patch (:) = nan - allocate(this%manu_patch (begp:endp)) ; this%manu_patch (:) = nan + allocate(this%manure_patch (begp:endp)) ; this%manure_patch (:) = nan allocate(this%fert_counter_patch (begp:endp)) ; this%fert_counter_patch (:) = nan allocate(this%soyfixn_patch (begp:endp)) ; this%soyfixn_patch (:) = nan @@ -951,13 +951,10 @@ subroutine InitHistory(this, bounds) call hist_addfld1d (fname='NFERTILIZATION', units='gN/m^2/s', & avgflag='A', long_name='fertilizer added', & ptr_patch=this%fert_patch) - end if - - if (use_fan) then - this%manu_patch(begp:endp) = spval - call hist_addfld1d (fname='MANU', units='gN/m^2/s', & + this%manure_patch(begp:endp) = spval + call hist_addfld1d (fname='NMANURE', units='gN/m^2/s', & avgflag='A', long_name='manure added', & - ptr_patch=this%manu_patch) + ptr_patch=this%manure_patch) end if if (use_crop .and. .not. use_fun) then @@ -1263,18 +1260,15 @@ subroutine InitCold(this, bounds) !----------------------------------------------- ! initialize nitrogen flux variables !----------------------------------------------- - if (use_fan) write(iulog, *) 'SETTING MANU_PATCH TO ZERO' do p = bounds%begp,bounds%endp l = patch%landunit(p) if ( use_crop )then this%fert_counter_patch(p) = spval this%fert_patch(p) = 0._r8 + this%manure_patch(p) = 0._r8 this%soyfixn_patch(p) = 0._r8 end if - if ( use_fan) then - this%manu_patch(p) = 0._r8 - end if if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then this%fert_counter_patch(p) = 0._r8 @@ -1361,13 +1355,12 @@ subroutine Restart (this, bounds, ncid, flag ) dim1name='pft', & long_name='', units='', & interpinic_flag='interp', readvar=readvar, data=this%fert_patch) - end if - if (use_fan) then - call restartvar(ncid=ncid, flag=flag, varname='manu', xtype=ncd_double, & + call restartvar(ncid=ncid, flag=flag, varname='manure', xtype=ncd_double, & dim1name='pft', & long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%manu_patch) + interpinic_flag='interp', readvar=readvar, data=this%manure_patch) + end if if (use_crop) then diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index 4e9ea572d0..65c2d6034d 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -1,6 +1,6 @@ -module fan2ctsm +module Fan2CTSMMod use FanMod - use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_kind_mod, only : r8 => shr_kind_r8, CL => shr_kind_cl use decompMod , only : bounds_type use atm2lndType , only : atm2lnd_type use Wateratm2lndBulkType , only : wateratm2lndbulk_type @@ -73,6 +73,9 @@ module fan2ctsm real(r8), parameter :: max_grazing_fract = 0.65_r8 ! Normalization constants for barn and storage emissions. real(r8), parameter :: volat_coef_barns_open = 0.03_r8, volat_coef_barns_closed = 0.025, volat_coef_stores = 0.025_r8 + + ! Fraction of manure N moved from crop to native columns (manure spreading) + real(r8) :: fract_spread_grass = 1.0_r8 logical :: fan_to_bgc_crop = .false. logical :: fan_to_bgc_veg = .false. @@ -89,6 +92,7 @@ subroutine fan_readnml(NLFilename) use shr_nl_mod , only : shr_nl_find_group_name use abortutils , only : endrun use shr_mpi_mod , only : shr_mpi_bcast + use FanStreamMod , only : set_bcast_fanstream_pars character(len=*), intent(in) :: NLFilename ! Namelist filename @@ -96,8 +100,15 @@ subroutine fan_readnml(NLFilename) integer :: unitn ! unit for namelist file character(len=*), parameter :: subname = 'fan_readnml' character(len=*), parameter :: nmlname = 'fan_nml' + integer :: stream_year_first_fan ! first year in stream to use + integer :: stream_year_last_fan ! last year in stream to use + integer :: model_year_align_fan ! align stream_year_firstndep2 with + character(len=CL) :: stream_fldFileName_fan + character(len=CL) :: fan_mapalgo - namelist /fan_nml/ use_fan, fan_to_bgc_crop, fan_to_bgc_veg + namelist /fan_nml/ fan_to_bgc_crop, fan_to_bgc_veg, stream_year_first_fan, & + stream_year_last_fan, model_year_align_fan, fan_mapalgo, stream_fldFileName_fan, & + fract_spread_grass if (masterproc) then unitn = getavu() @@ -115,9 +126,17 @@ subroutine fan_readnml(NLFilename) call relavu(unitn) end if - call shr_mpi_bcast(use_fan, mpicom) + call set_bcast_fanstream_pars(stream_year_first_fan, stream_year_last_fan, & + model_year_align_fan, fan_mapalgo, stream_fldFileName_fan) + call shr_mpi_bcast(fan_to_bgc_crop, mpicom) call shr_mpi_bcast(fan_to_bgc_veg, mpicom) + call shr_mpi_bcast(fract_spread_grass, mpicom) + + if (fract_spread_grass > 1 .or. fract_spread_grass < 0) then + call endrun(msg="ERROR invalid fract_spread_grass") + end if + !call mpi_bcast(fan_to_bgc_crop, 1, MPI_LOGICAL, 0, mpicom, ierr) !call mpi_bcast(fan_to_bgc_veg, 1, MPI_LOGICAL, 0, mpicom, ierr) @@ -161,13 +180,13 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & type(frictionvel_type) , intent(in) :: frictionvel_inst ! Local variables - integer, parameter :: num_substeps = 4, balance_check_freq = 1000 + integer, parameter :: num_substeps = 4, balance_check_freq = 1 integer :: c, g, patchcounter, p, status, c1, c2, l, fc, ind_substep real(r8) :: dt, ndep_org(3), orgpools(3), tanprod(3), watertend, fluxes(6,3), tanpools3(3), ratm, tandep, & fluxes2(6,2), fluxes3(6,3), fluxes4(6,4), tanpools2(2), tanpools4(4), fluxes_tmp(6), garbage_total real(r8) :: Hconc_grz(3), Hconc_slr(4), pH_soil, pH_crop - real(r8) :: fert_inc_tan, fert_inc_no3 + real(r8) :: fert_inc_tan, fert_inc_no3, old(num_soilc) logical :: do_balance_checks real(r8) :: tg, garbage, theta, thetasat, infiltr_m_s, evap_m_s, runoff_m_s, org_n_tot, & nstored_old, nsoilman_old, nsoilfert_old, fert_to_air, fert_to_soil, fert_total, fert_urea, fert_tan, & @@ -206,10 +225,12 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & call p2c(bounds, num_soilc, filter_soilc, & cnv_nf%fert_patch(bounds%begp:bounds%endp), & nf%fert_n_appl_col(bounds%begc:bounds%endc)) - call p2c(bounds, num_soilc, filter_soilc, & - cnv_nf%manu_patch(bounds%begp:bounds%endp), & - nf%man_n_appl_col(bounds%begc:bounds%endc)) + !call p2c(bounds, num_soilc, filter_soilc, & + ! cnv_nf%manu_patch(bounds%begp:bounds%endp), & + ! nf%man_n_appl_col(bounds%begc:bounds%endc)) + nf%man_n_appl_col(bounds%begc:bounds%endc) = 0.0_r8 + if (any(nf%man_n_appl_col > 100)) then write(iulog, *) maxval(nf%man_n_appl_col) call endrun('bad man_n_appl_col') @@ -287,7 +308,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & if (nf%man_n_appl_col(c) > 1e12 .or. ngrz(c) > 1e12) then write(iulog, *) c, nf%man_n_appl_col(c), ngrz(c), cnv_nf%fert_patch(col%patchi(c):col%patchf(c)), & - cnv_nf%manu_patch(col%patchi(c):col%patchf(c)) + cnv_nf%manure_patch(col%patchi(c):col%patchf(c)) call endrun('nf%man_n_appl_col(c) is spval') end if @@ -590,12 +611,41 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & write(iulog, *) 'SoilPH check:', soilph_min, soilph_max, def_ph_count end if + old = ns%fan_totn_col(filter_soilc(1:num_soilc)) + call update_summary(ns, nf, filter_soilc, num_soilc) + + call debug_balance(ns, nf, old, filter_soilc(1:num_soilc)) + + call debug_balance(ns, nf, old, (/1/)) + + call debug_balance(ns, nf, old, (/2/)) end associate contains + subroutine debug_balance(ns, nf, oldn, columns) + type(soilbiogeochem_nitrogenstate_type), intent(in) :: ns + type(soilbiogeochem_nitrogenflux_type), intent(in) :: nf + real(r8) :: oldn(:) + integer :: columns(:) + + real(r8) :: newn(size(old)) + + newn = ns%fan_totn_col + + + print *, 'FAN SUMMARY', columns + print *, 'old total:', sum(oldn(columns)) + print *, 'new total:', sum(newn(columns)) + print *, 'delta:', sum(oldn(columns)) - sum(newn(columns)) + print *, 'new flux:', (sum(nf%fan_totnin(columns)) - sum(nf%fan_totnout(columns)))*dt + !print *, 'total from funct', get_total_n(ns, nf, 'pools_manure') + get_total_n(ns, nf, 'pools_fertilizer') + + end subroutine debug_balance + + real(r8) function get_total_n(ns, nf, which) result(total) type(soilbiogeochem_nitrogenstate_type), intent(in) :: ns type(soilbiogeochem_nitrogenflux_type), intent(in) :: nf @@ -719,7 +769,7 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & real(r8) :: tempr_ave, windspeed_ave ! windspeed and temperature averaged over agricultural patches real(r8) :: tempr_barns, tempr_stores, vent_barns, flux_grass_crop, tempr_min_10day, & flux_grass_graze, flux_grass_spread, flux_grass_spread_tan, flux_grass_crop_tan - real(r8) :: cumflux, totalinput, total_to_store + real(r8) :: cumflux, totalinput, total_to_store, total_to_store_tan real(r8) :: fluxes_nitr(4,2), fluxes_tan(4,2) ! The fraction of manure applied continuously on grasslands (if present in the gridcell) real(r8), parameter :: kg_to_g = 1e3_r8 @@ -851,8 +901,14 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & ! Simplification as of 2019: no explicit manure storage. Flux to storage ! will be spread "immediately". total_to_store = sum(fluxes_nitr(iflx_to_store,:)) - flux_grass_spread = flux_grass_spread + total_to_store*col%wtgcell(c) - flux_grass_spread_tan = flux_grass_spread_tan + sum(fluxes_tan(iflx_to_store,:))*col%wtgcell(c) + total_to_store_tan = sum(fluxes_tan(iflx_to_store,:)) + + n_manure_spread_col(c) = (1.0_r8 - fract_spread_grass) * total_to_store + tan_manure_spread_col(c) = (1.0_r8 - fract_spread_grass) * total_to_store_tan + + flux_grass_spread = flux_grass_spread + fract_spread_grass * total_to_store*col%wtgcell(c) + flux_grass_spread_tan = flux_grass_spread_tan + fract_spread_grass * total_to_store_tan*col%wtgcell(c) + man_n_transf(c) = man_n_transf(c) + total_to_store nh3_flux_stores(c) = sum(fluxes_nitr(iflx_air_stores,:)) @@ -898,7 +954,7 @@ subroutine update_summary(ns, nf, filter_soilc, num_soilc) integer, intent(in) :: filter_soilc(:) ! filter for soil columns integer :: c, fc - real(r8) :: total, fluxout, fluxin, flux_loss + real(r8) :: total, fluxout, fluxin, flux_loss do fc = 1, num_soilc c = filter_soilc(fc) @@ -939,7 +995,8 @@ end subroutine update_summary subroutine fan_to_sminn(filter_soilc, num_soilc, sbgc_nf) use ColumnType, only : col use LandunitType , only: lun - use landunit_varcon, only : istcrop + use landunit_varcon, only : istcrop, istsoil + integer, intent(in) :: filter_soilc(:) integer, intent(in) :: num_soilc type(soilbiogeochem_nitrogenflux_type), intent(inout) :: sbgc_nf @@ -954,11 +1011,11 @@ subroutine fan_to_sminn(filter_soilc, num_soilc, sbgc_nf) + sbgc_nf%manure_no3_prod_col(c) + sbgc_nf%manure_nh4_to_soil_col(c) if (lun%itype(col%landunit(c)) == istcrop .and. fan_to_bgc_crop) then sbgc_nf%fert_to_sminn_col(c) = fan_nitr - else if (fan_to_bgc_veg) then + else if (lun%itype(col%landunit(c)) == istsoil .and. fan_to_bgc_veg) then sbgc_nf%fert_to_sminn_col(c) = fan_nitr end if end do end subroutine fan_to_sminn -end module fan2ctsm +end module Fan2CTSMMod diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index 2bcb1b6e6f..1f1b42f83a 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -121,6 +121,7 @@ subroutine control_init( ) use CNNDynamicsMod , only : CNNDynamicsReadNML use SoilBiogeochemDecompCascadeBGCMod, only : DecompCascadeBGCreadNML use CNPhenologyMod , only : CNPhenologyReadNML + use Fan2CTSMMod , only : fan_readnml ! ! !LOCAL VARIABLES: integer :: i ! loop indices @@ -241,9 +242,7 @@ subroutine control_init( ) namelist /clm_inparm/ use_hydrstress -!KO namelist /clm_inparm/ use_fan -!KO namelist /clm_inparm/ use_dynroot @@ -479,7 +478,7 @@ subroutine control_init( ) call HumanIndexReadNML ( NLFilename ) call LunaReadNML ( NLFilename ) call FrictionVelReadNML ( NLFilename ) - + ! ---------------------------------------------------------------------- ! Broadcast all control information if appropriate ! ---------------------------------------------------------------------- @@ -506,6 +505,10 @@ subroutine control_init( ) call DecompCascadeBGCreadNML( NLFilename ) end if + if ( use_fan ) then + call fan_readnml ( NLFilename ) + end if + ! ---------------------------------------------------------------------- ! consistency checks ! ---------------------------------------------------------------------- diff --git a/src/main/fanStreamMod.F90 b/src/main/fanStreamMod.F90 index 9735458360..468f6f3627 100644 --- a/src/main/fanStreamMod.F90 +++ b/src/main/fanStreamMod.F90 @@ -9,6 +9,7 @@ module FanStreamMod ! ! !USES use shr_kind_mod, only: r8 => shr_kind_r8, CL => shr_kind_cl + use clm_varcon, only : ispval use shr_strdata_mod use shr_stream_mod use shr_string_mod @@ -33,14 +34,17 @@ module FanStreamMod ! !PUBLIC MEMBER FUNCTIONS: public :: fanstream_init ! position datasets for dynamic ndep2 public :: fanstream_interp ! interpolates between two years of ndep2 file data -!KO public :: clm_domain_mct ! Sets up MCT domain for this resolution + public :: set_bcast_fanstream_pars + ! ! PRIVATE TYPES type(shr_strdata_type) :: sdat_grz, sdat_sgrz, sdat_ngrz, sdat_urea, sdat_nitr, sdat_soilph ! input data streams - integer :: stream_year_first_fan ! first year in stream to use - integer :: stream_year_last_fan ! last year in stream to use - integer :: model_year_align_fan ! align stream_year_firstndep2 with - + integer :: stream_year_first_fan = ispval ! first year in stream to use + integer :: stream_year_last_fan = ispval ! last year in stream to use + integer :: model_year_align_fan = ispval ! align stream_year_firstndep2 with + character(len=CL) :: stream_fldFileName_fan + character(len=CL) :: fan_mapalgo = 'bilinear' + character(len=*), parameter, private :: sourcefile = & __FILE__ !============================================================================== @@ -49,6 +53,26 @@ module FanStreamMod !============================================================================== + subroutine set_bcast_fanstream_pars(str_yr_first, str_yr_last, mdl_yr_align, mapalgo, str_filename) + integer, intent(in) :: str_yr_first, str_yr_last, mdl_yr_align + character(len=*), intent(in) :: str_filename, mapalgo + + stream_year_first_fan = str_yr_first + stream_year_last_fan = str_yr_last + model_year_align_fan = mdl_yr_align + stream_fldFileName_fan = str_filename + fan_mapalgo = mapalgo + + call shr_mpi_bcast(stream_year_first_fan, mpicom) + call shr_mpi_bcast(stream_year_last_fan, mpicom) + call shr_mpi_bcast(model_year_align_fan, mpicom) + call shr_mpi_bcast(stream_fldFileName_fan, mpicom) + call shr_mpi_bcast(fan_mapalgo, mpicom) + + end subroutine set_bcast_fanstream_pars + + !************************************************************************************ + subroutine fanstream_init(bounds, NLFilename) ! ! Initialize data stream information. @@ -70,48 +94,15 @@ subroutine fanstream_init(bounds, NLFilename) integer :: nu_nml ! unit for namelist file integer :: nml_error ! namelist i/o error flag type(mct_ggrid) :: dom_clm ! domain information - character(len=CL) :: stream_fldFileName_fan - character(len=CL) :: fan_mapalgo = 'bilinear' character(*), parameter :: shr_strdata_unset = 'NOT_SET' character(*), parameter :: subName = "('ndep2dyn_init')" character(*), parameter :: F00 = "('(ndep2dyn_init) ',4a)" !----------------------------------------------------------------------- - namelist /fan_nml/ & - stream_year_first_fan, & - stream_year_last_fan, & - model_year_align_fan, & - fan_mapalgo, & - stream_fldFileName_fan - - ! Default values for namelist - stream_year_first_fan = 1 ! first year in stream to use - stream_year_last_fan = 1 ! last year in stream to use - model_year_align_fan = 1 ! align stream_year_first_fan with this model year - stream_fldFileName_fan = ' ' - - ! Read fandyn_nml namelist - if (masterproc) then - nu_nml = getavu() - open( nu_nml, file=trim(NLFilename), status='old', iostat=nml_error ) - call shr_nl_find_group_name(nu_nml, 'fan_nml', status=nml_error) - if (nml_error == 0) then - read(nu_nml, nml=fan_nml,iostat=nml_error) - if (nml_error /= 0) then - call endrun(msg=' ERROR reading fan_nml namelist'//errMsg(sourcefile, __LINE__)) - end if - else - call endrun(msg=' ERROR finding fan_nml namelist'//errMsg(sourcefile, __LINE__)) - end if - close(nu_nml) - call relavu( nu_nml ) - endif - - call shr_mpi_bcast(stream_year_first_fan, mpicom) - call shr_mpi_bcast(stream_year_last_fan, mpicom) - call shr_mpi_bcast(model_year_align_fan, mpicom) - call shr_mpi_bcast(stream_fldFileName_fan, mpicom) - + if (stream_year_first_fan == ispval) then + call endrun(msg='ERROR stream_year_first_fan not set at '//errMsg(sourcefile, __LINE__)) + end if + if (masterproc) then write(iulog,*) ' ' write(iulog,*) 'ndep2dyn stream settings:' From c0402639e05cb25bc7ab1d844f27744d22027454 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 6 Mar 2019 15:34:30 -0500 Subject: [PATCH 058/181] FanMod array interfaces, comments, etc --- src/biogeochem/CNNDynamicsMod.F90 | 1 - src/biogeochem/Fan2CTSMMod.F90 | 128 +++++------ src/biogeochem/FanMod.F90 | 357 ++++++++++++++++++------------ 3 files changed, 271 insertions(+), 215 deletions(-) diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index c7d6b57ad7..fc6b0fbfa3 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -60,7 +60,6 @@ module CNNDynamicsMod end type params_type type(params_type) :: params_inst - logical, private, parameter :: debug_fan = .false. !----------------------------------------------------------------------- contains diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index d68174e1cc..2caf904ead 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -1,4 +1,19 @@ module fan2ctsm + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! + ! This module interfaces the FAN (Flow of Agricultural Nitrogen) process model with + ! CTSM. This includes the main driver routine (fan_eval), initialization, and + ! use-modifiable parameters, some of which are read from namelist. The remaining, + ! internal parameters are set in FanMod. + ! + ! FAN is implemented on column level. Synthetic fertilizer application is taken from the + ! CLM crop model and remains in crop columns. Manure N is read from a separate stream, + ! which distinguishes pastoral and mixed/landless livestock systems. Manure in pastures + ! is allocated to the native soil column. The mixed/landless systems are associated with + ! crop columns, however, some N may be transferred to the native column due to manure + ! spreading or seasonal grazing. + use FanMod use shr_kind_mod, only : r8 => shr_kind_r8 use decompMod , only : bounds_type @@ -34,13 +49,14 @@ module fan2ctsm ! Urea fertilizer. The other fertilizer (F4) pool gets soil pH. real(r8), parameter :: Hconc_fert(3) = (/10**(-7.0_r8), 10**(-8.5_r8), 10**(-8.0_r8)/) - ! Active layer thickness used by FAN. + ! Active layer thickness used by FAN. This is assumed to match the topmost CLM layer. If + ! this is not the case, handling of the soil moisture becomes inconsistent. real(r8), parameter :: dz_layer_fert = 0.02_r8 ! m real(r8), parameter :: dz_layer_grz = 0.02_r8 ! m ! Manure N composition real(r8) :: fract_tan = 0.6_r8 ! fraction of total ammoniacal nitrogen - ! The following are fractions of non-TAN N + ! The following are fractions of the remaining non-TAN N: real(r8), parameter :: & fract_resist = 0.45_r8, & ! resistant organic N fract_unavail = 0.05_r8, & ! unvavailable organic N @@ -49,12 +65,12 @@ module fan2ctsm ! application rate in meters water: real(r8), parameter :: water_init_grz = 0.006_r8 ! urine patch depth (m) real(r8), parameter :: depth_slurry = 0.005_r8 ! slurry application rate (m) - real(r8), parameter :: water_init_fert = 1e-9_r8 ! water in fertilizer (assumed none). + real(r8), parameter :: water_init_fert = 1e-9_r8 ! water in fertilizer (assumed very little). ! Slurry infiltration time real(r8), parameter :: slurry_infiltr_time = 6.0_r8*3600_r8 ! seconds ! Reduction factor for fertilizer due to mechanical incorporation. ! N available for volatilization becomes multiplied by (1-fert_incorp_reduct). - real(r8) :: fert_incorp_reduct = 0.25_r8 + real(r8) :: fert_incorp_reduct = 0.25_r8 ! TAN pool age ranges (sec). real(r8), parameter :: & @@ -73,12 +89,11 @@ module fan2ctsm real(r8), parameter :: max_grazing_fract = 0.65_r8 ! Normalization constants for barn and storage emissions. real(r8), parameter :: volat_coef_barns_open = 0.03_r8, volat_coef_barns_closed = 0.025, volat_coef_stores = 0.025_r8 - + + ! Fan coupling to soil BGC. Can be set on separately for crop and other columns. logical :: fan_to_bgc_crop = .false. logical :: fan_to_bgc_veg = .false. - logical, parameter :: debug_fan = .true. - contains subroutine fan_readnml(NLFilename) @@ -160,13 +175,21 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & type(frictionvel_type) , intent(in) :: frictionvel_inst ! Local variables - integer, parameter :: num_substeps = 4, balance_check_freq = 1000 + integer, parameter :: & + ! Use this many sub-steps. This improves numerical accuracy but is no longer + ! essential, because FAN includes an ad-hoc fixer for negative fluxes. + num_substeps = 4, & + ! FAN includes a separate nitrogen conservation check, which can be done every + ! nth time step. This is mostly redundant, because the FAN pools and fluxes are + ! now included in the main CLM soil N balance check. The FAN check has more + ! detail. + balance_check_freq = 1000 integer :: c, g, patchcounter, p, status, c1, c2, l, fc, ind_substep real(r8) :: dt, ndep_org(3), orgpools(3), tanprod(3), watertend, fluxes(6,3), tanpools3(3), ratm, tandep, & fluxes2(6,2), fluxes3(6,3), fluxes4(6,4), tanpools2(2), tanpools4(4), fluxes_tmp(6), garbage_total real(r8) :: Hconc_grz(3), Hconc_slr(4), pH_soil, pH_crop - real(r8) :: fert_inc_tan, fert_inc_no3 + real(r8) :: fert_inc_tan logical :: do_balance_checks real(r8) :: tg, garbage, theta, thetasat, infiltr_m_s, evap_m_s, runoff_m_s, org_n_tot, & nstored_old, nsoilman_old, nsoilfert_old, fert_to_air, fert_to_soil, fert_total, fert_urea, fert_tan, & @@ -209,17 +232,13 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & cnv_nf%manu_patch(bounds%begp:bounds%endp), & nf%man_n_appl_col(bounds%begc:bounds%endc)) - if (any(nf%man_n_appl_col > 100)) then - write(iulog, *) maxval(nf%man_n_appl_col) - call endrun('bad man_n_appl_col') - end if if (do_balance_checks) then nstored_old = get_total_n(ns, nf, 'pools_storage') nsoilman_old = get_total_n(ns, nf, 'pools_manure') nsoilfert_old = get_total_n(ns, nf, 'pools_fertilizer') end if - ! Assign the "pastoral" manure entire to the natural vegetation column + ! Assign the "pastoral" manure entirely to the natural vegetation column do fc = 1, num_soilc c = filter_soilc(fc) l = col%landunit(c) @@ -244,13 +263,6 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & end do - if(debug_fan) then - write(iulog, *) 'nan count of storage 1', count(isnan(ns%man_n_stored_col)) - if (any(isnan(nf%man_n_appl_col))) then - call endrun('nan nh3 appl b') - end if - end if - call handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & atm2lnd_inst%forc_ndep_sgrz_grc, atm2lnd_inst%forc_ndep_ngrz_grc, & ns%man_n_stored_col, ns%man_tan_stored_col, & @@ -348,7 +360,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & orgpools(ind_avail) = man_a_grz(c) orgpools(ind_resist) = man_r_grz(c) orgpools(ind_unavail) = man_u_grz(c) - call update_org_n(ndep_org, tg, soilpsi, orgpools, dt, tanprod, soilflux_org) + call update_org_n(ndep_org, tg, soilpsi, orgpools, dt, tanprod, soilflux_org, size(orgpools), status) man_a_grz(c) = orgpools(ind_avail) man_r_grz(c) = orgpools(ind_resist) man_u_grz(c) = orgpools(ind_unavail) @@ -356,9 +368,6 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & tanpools3(1) = ns%tan_g1_col(c) tanpools3(2) = ns%tan_g2_col(c) tanpools3(3) = ns%tan_g3_col(c) - if (any(isnan(tanpools3))) then - call endrun('nan1') - end if ph_soil = atm2lnd_inst%forc_soilph_grc(g) if (ph_soil < 3.0) then @@ -379,14 +388,11 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & wateratm2lndbulk_inst%forc_q_downscaled_col(c), watertend, & runoff_m_s, tandep, (/0.0_r8, 0.0_r8, sum(tanprod)/), water_init_grz, & bsw, poolranges_grz, Hconc_grz, dz_layer_grz, tanpools3, & - fluxes3(1:5,:), garbage, dt/num_substeps, status, 3) + fluxes3(1:5,1:3), garbage, dt/num_substeps, 3, 5, status) if (status /= 0) then - write(iulog, *) 'status = ', status, tanpools2, ratm, theta, thetasat, tandep, tanprod + write(iulog, *) 'status = ', status, tanpools3, ratm, theta, thetasat, tandep, tanprod call endrun(msg='update_npool status /= 0') end if - if (debug_fan .and. any(isnan(tanpools2))) then - call endrun('nan2') - end if fluxes_tmp = fluxes_tmp + sum(fluxes3, dim=2) garbage_total = garbage_total + garbage end do @@ -395,10 +401,6 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & ns%tan_g1_col(c) = tanpools3(1) ns%tan_g2_col(c) = tanpools3(2) ns%tan_g3_col(c) = tanpools3(3) - if (debug_fan .and. any(isnan(fluxes3))) then - write(iulog, *) fluxes3 - call endrun('nan3') - end if nf%nh3_grz_col(c) = fluxes_tmp(iflx_air) nf%manure_runoff_col(c) = fluxes_tmp(iflx_roff) @@ -420,10 +422,11 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & orgpools(ind_avail) = man_a_app(c) orgpools(ind_resist) = man_r_app(c) orgpools(ind_unavail) = man_u_app(c) - call update_org_n(ndep_org, tg, soilpsi, orgpools, dt, tanprod, soilflux_org) + call update_org_n(ndep_org, tg, soilpsi, orgpools, dt, tanprod, soilflux_org, size(orgpools), status) man_a_app(c) = orgpools(ind_avail) man_r_app(c) = orgpools(ind_resist) man_u_app(c) = orgpools(ind_unavail) + tanpools4(1) = ns%tan_s0_col(c) tanpools4(2) = ns%tan_s1_col(c) tanpools4(3) = ns%tan_s2_col(c) @@ -432,10 +435,6 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & ph_crop = min(max(ph_soil, ph_crop_min), ph_crop_max) Hconc_slr(4) = 10**-(ph_crop) - if (debug_fan .and. any(isnan(tanpools4))) then - call endrun('nan31') - end if - fluxes_tmp = 0.0 garbage_total = 0.0 fluxes4 = 0.0 @@ -449,7 +448,8 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & call update_4pool(tg, ratm, theta, thetasat, infiltr_m_s, evap_m_s, & wateratm2lndbulk_inst%forc_q_downscaled_col(c), watertend, & runoff_m_s, tandep, sum(tanprod), bsw, depth_slurry, & - poolranges_slr, tanpools4, Hconc_slr, fluxes4(1:5,:), garbage, dt / num_substeps, status) + poolranges_slr, tanpools4, Hconc_slr, fluxes4(1:5, 1:4), & + garbage, dt / num_substeps, 4, 5, status) if (status /= 0) then write(iulog, *) 'status = ', status, tanpools4, tg, ratm, 'th', theta, & thetasat, tandep, 'tp', tanprod, 'fx', fluxes4 @@ -465,11 +465,6 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & ns%tan_s2_col(c) = tanpools4(3) ns%tan_s3_col(c) = tanpools4(4) - if (debug_fan .and. any(isnan(fluxes4))) then - write(iulog, *) fluxes3, tanpools4,ratm, theta, thetasat, infiltr_m_s, tandep, tanprod - call endrun('nan4') - end if - nf%nh3_man_app_col(c) = fluxes_tmp(iflx_air) nf%manure_runoff_col(c) = nf%manure_runoff_col(c) + fluxes_tmp(iflx_roff) nf%manure_no3_prod_col(c) = nf%manure_no3_prod_col(c) + fluxes_tmp(iflx_no3) @@ -480,16 +475,14 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & ! Fertilizer ! - ! Fraction available for volatilization fert_total = nf%fert_n_appl_col(c) fract_urea = atm2lnd_inst%forc_ndep_urea_grc(g) fract_no3 = atm2lnd_inst%forc_ndep_nitr_grc(g) - ! Fractions made unavailable by mechanical incorporation, will be added to the - ! to-soil flux (tan) or no3 production (no3) below. + ! N fractions made unavailable by mechanical incorporation, will be added directly + ! to the to-soil flux (tan) or no3 production (no3) below. fert_inc_tan = fert_total * fert_incorp_reduct * (1.0 - fract_no3) - fert_inc_no3 = fert_total * fert_incorp_reduct * fract_no3 if (fract_urea < 0 .or. fract_no3 < 0 .or. fract_urea + fract_no3 > 1) then call endrun('bad fertilizer fractions') @@ -497,10 +490,10 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & fert_urea = fert_total * fract_urea * (1.0_r8 - fert_incorp_reduct) - ! Include the incorporated NO3 fertilizer to the no3 flux + ! Fertilizer nitrate goes straight to the no3_prod, incorporated or not. fert_no3 = fert_total * fract_no3 fert_generic = fert_total * (1.0_r8 - fract_urea - fract_no3) * (1.0_r8 - fert_incorp_reduct) - nf%otherfert_n_appl_col(c) = fert_total * (1.0_r8 - fract_urea) !fert_no3 + fert_generic + nf%otherfert_n_appl_col(c) = fert_total * (1.0_r8 - fract_urea) ! note here goes also the incorporated N ! Urea decomposition ! @@ -509,7 +502,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & fluxes2 = 0.0 call update_urea(tg, theta, thetasat, infiltr_m_s, evap_m_s, watertend, & runoff_m_s, fert_urea, bsw, ureapools, fluxes2, urea_resid, poolranges_fert(1:2), & - dt, status, numpools=2) + dt, 2, 6, status) if (status /= 0) then call endrun(msg='Bad status after update_urea for fertilizer') end if @@ -520,7 +513,6 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & ns%fert_u1_col(c) = ureapools(2) ! Collect the formed ammonia for updating the TAN pools tanprod_from_urea(1:2) = fluxes2(iflx_to_tan, 1:2) - tanprod_from_urea(2) = tanprod_from_urea(2) ! There is no urea pool corresponding to tan_f2, because most of the urea will ! have decomposed. Here whatever remains gets sent to tan_f2. tanprod_from_urea(3) = urea_resid / dt @@ -536,8 +528,8 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & call update_npool(tg, ratm, theta, thetasat, infiltr_m_s, evap_m_s, & wateratm2lndbulk_inst%forc_q_downscaled_col(c), watertend, & runoff_m_s, 0.0_r8, tanprod_from_urea, water_init_fert, bsw, & - poolranges_fert, Hconc_fert, dz_layer_fert, tanpools3, fluxes3(1:5,:), & - garbage, dt/num_substeps, status, numpools=3) + poolranges_fert, Hconc_fert, dz_layer_fert, tanpools3, fluxes3(1:5,1:3), & + garbage, dt/num_substeps, 3, 5, status) if (status /= 0) then write(iulog, *) 'status:', status, tanpools3, nf%fert_n_appl_col(c) call endrun(msg='Bad status after npool for fertilizer') @@ -550,7 +542,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & wateratm2lndbulk_inst%forc_q_downscaled_col(c), watertend, & runoff_m_s, fert_generic, (/0.0_r8/), water_init_fert, bsw, & poolrange_otherfert, (/10**(-ph_crop)/), dz_layer_fert, ns%tan_f3_col(c:c), fluxes3(1:5,1:1), & - garbage, dt/num_substeps, status, numpools=1) + garbage, dt/num_substeps, 1, 5, status) if (status /= 0) then write(iulog, *) 'status:', status, tanpools3, nf%fert_n_appl_col(c) call endrun(msg='Bad status after npool for generic') @@ -673,6 +665,14 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & nh3_flux_stores, nh3_flux_barns, man_n_transf, & grz_fract, man_n_barns, tan_fract_excr, & filter_soilc, num_soilc) + ! + ! Evaluate storage losse for manure in the mixed/landless production systems + ! associated with crop columns in CLM. The N remaining after storage losses is applied + ! on soil either in the same column, or a fraction may be moved to the native + ! vegetation column within the gridcell (grasslands). This subroutine also evaluates + ! seasonal grazing of livestock, and the manure N on pastures is also moved into the + ! native vegatation. + ! use landunit_varcon, only : max_lunit use pftconMod, only : nc4_grass, nc3_nonarctic_grass use clm_varcon, only : ispval @@ -819,7 +819,8 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & ! Ruminants call eval_fluxes_storage(flux_avail_rum, 'open', tempr_ave, windspeed_ave, 0.0_r8, & - volat_coef_barns_open, volat_coef_stores, tan_fract_excr, fluxes_nitr(:,1), fluxes_tan(:,1), status) + volat_coef_barns_open, volat_coef_stores, tan_fract_excr, fluxes_nitr(:,1), fluxes_tan(:,1), & + size(fluxes_nitr, 1), status) if (status /=0) then write(iulog, *) 'status = ', status call endrun(msg='eval_fluxes_storage failed for ruminants') @@ -827,22 +828,13 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & ! Others call eval_fluxes_storage(flux_avail_mg, 'closed', tempr_ave, windspeed_ave, 0.0_r8, & - volat_coef_barns_closed, volat_coef_stores, tan_fract_excr, fluxes_nitr(:,2), fluxes_tan(:,2), status) + volat_coef_barns_closed, volat_coef_stores, tan_fract_excr, fluxes_nitr(:,2), fluxes_tan(:,2), & + size(fluxes_nitr, 1), status) if (status /=0) then write(iulog, *) 'status = ', status call endrun(msg='eval_fluxes_storage failed for other livestock') end if cumflux = cumflux + sum(fluxes_nitr) - if (any(isnan(fluxes_nitr))) then - write(iulog, *) 'fluxes 1', fluxes_nitr(:,1) - write(iulog, *) 'fluxes 2', fluxes_nitr(:,2) - call endrun('Nan in fluxes_nitr') - end if - if (any(isnan(fluxes_tan))) then - write(iulog, *) 'fluxes 1', fluxes_tan(:,1) - write(iulog, *) 'fluxes 2', fluxes_tan(:,2) - call endrun('Nan in fluxes_tan') - end if if (fluxes_tan(iflx_to_store,1) < 0) then call endrun(msg="ERROR too much manure lost") diff --git a/src/biogeochem/FanMod.F90 b/src/biogeochem/FanMod.F90 index 39f804d9e7..727ca7fe86 100755 --- a/src/biogeochem/FanMod.F90 +++ b/src/biogeochem/FanMod.F90 @@ -1,4 +1,19 @@ module FanMod + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! + ! This module implements the physical parameterizations of the FANv2 (Flow of + ! Agricultureal Nitrogen version 2) process model, and includes the numericals routines + ! for handling age-seggregated N pools. The model evaluates nitrogen losses due to + ! volatilization and leaching from livestock manure and mineral fertilizers. + ! + ! The public subroutines are designed to be callable from python code using f2py. In + ! this case the _PYMOD_ flag needs to be set. While the non-public subroutines are + ! exported to the python module, they may not work correctly due to the assumed-shape + ! arrays. + ! + #ifdef _PYMOD_ use qsatmod #else @@ -14,12 +29,15 @@ module FanMod #ifdef _PYMOD_ public - + ! Define physical constants here to avoid dependency on CESM. real(r8), parameter :: SHR_CONST_BOLTZ = 1.38065e-23 - real(r8), parameter :: SHR_CONST_AVOGAD = 6.02214e26 - real(r8), parameter :: SHR_CONST_RGAS = SHR_CONST_AVOGAD*SHR_CONST_BOLTZ - real(r8), parameter :: SHR_CONST_MWDAIR = 28.966 + real(r8), parameter :: SHR_CONST_AVOGAD = 6.02214e26 ! molecules per kmole + real(r8), parameter :: SHR_CONST_RGAS = SHR_CONST_AVOGAD*SHR_CONST_BOLTZ ! universal gas constant in J kmole-1 K-1 real(r8), parameter :: SHR_CONST_RDAIR = SHR_CONST_RGAS/SHR_CONST_MWDAIR + real(r8), parameter :: SHR_CONST_RHOFW = 1.000e3_R8 + real(r8), parameter :: SHR_CONST_PSTD = 101325.0_R8 ! standard pressure ~ pascals + real(r8), parameter :: SHR_CONST_TKFRZ = 273.15_R8 ! freezing T of fresh water ~ K + real(r8), parameter :: SHR_CONST_MWDAIR = 28.966_R8 ! molecular weight dry air ~ kg/kmole #else private @@ -49,11 +67,13 @@ module FanMod real(r8), parameter, public :: soildepth_reservoir = 0.04_r8 integer, parameter, public :: err_bad_theta = 1, err_negative_tan = 2, err_negative_flux = 3, & - err_balance_tan = 4, err_balance_nitr = 5, err_nan = 6, err_bad_subst = 7, err_bad_type = 8 + err_balance_tan = 4, err_balance_nitr = 5, err_nan = 6, err_bad_subst = 7, err_bad_type = 8, err_bad_arg = 9 integer, parameter, public :: subst_tan = 1, subst_urea = 2 real(r8), parameter, public :: water_relax_t = 24*3600.0_r8 + + logical, parameter, public :: debug_fan = .true. contains @@ -94,6 +114,9 @@ end function ind_appl integer function ind_to_store() result(ind) ind = iflx_to_store end function ind_to_store + + !************************************************************************************ + ! Soil diffusion for ammonium/ammonia. function eval_diffusivity_liq_mq(theta, thetasat, tg) result(diff) ! Evaluate the aquous phase diffusivity for TAN in soil according to the Millington & @@ -107,9 +130,10 @@ function eval_diffusivity_liq_mq(theta, thetasat, tg) result(diff) real(r8) :: kaq_base real(r8), parameter :: pw = 7.0_r8 / 3.0_r8 - real(r8), parameter :: gascnst = 8.314, faraday = 96500.0_r8, lp = 73.4_r8, lm_no3 = 71.4_r8, lm_oh=197.6_r8, lm=lm_no3 + real(r8), parameter :: gascnst = SHR_CONST_RGAS*1e-3_r8, & ! SHR_CONST_RGAS is per kmole (!) + faraday = 96500.0_r8, lp = 73.4_r8, lm_no3 = 71.4_r8, lm_oh=197.6_r8, lm=lm_no3 - ! Base rate by Nernst-Haskell equation, see Poling et al., 2000. The Properties of + ! Base rate by Nernst-Haskell equation, see Poling et al., 2000, The Properties of ! Gases and Liquids. kaq_base = 1e-4 * (gascnst*tg / (2*faraday**2)) / (1/lp + 1/lm) @@ -131,8 +155,8 @@ function eval_diffusivity_gas_mq(theta, thetasat, tg) result(diff) real(r8) :: soilair, dair real(r8), parameter :: pw = 7.0_r8 / 3.0_r8 - real(r8), parameter :: mNH3 = 17., mair = 29, vNH3 = 14.9, vair = 20.1, press = 1.0 - + real(r8), parameter :: mNH3 = 17.0_r8, mair = SHR_CONST_MWDAIR, vNH3 = 14.9_r8, vair = 20.1_r8, press = 1.0_r8 + real(r8), parameter :: pow = 1.0_r8 / 3.0_r8 soilair = thetasat - theta ! Van Der Molen 1990 fit of the base rate. @@ -142,12 +166,13 @@ function eval_diffusivity_gas_mq(theta, thetasat, tg) result(diff) !dair = 1.4e-5 ! Base rate from the Fuller et al. 1966 method. - dair = (0.001 * tg**1.75 * sqrt(1/mNH3 + 1/mair)) / (press * (vair**(1./3) * vNH3**(1./3))**2) * 1e-4 + dair = (0.001_r8 * tg**1.75_r8 * sqrt(1.0_r8/mNH3 + 1.0_r8/mair)) / (press * (vair**pow * vNH3**pow)**2) * 1e-4_r8 diff = dair * (soilair**pw) / (thetasat**2) end function eval_diffusivity_gas_mq - ! The moldrup 2003 are here but not used currently. Check the base rates if use these. + ! The moldrup 2003 formulas are here but not used currently. Check the base rates if use + ! these. function eval_diffusivity_gas_m03(theta, thetasat, tg, bsw) result(diff) ! Evaluate the gas phase diffusivity for NH3 in soil according to the method of @@ -161,11 +186,12 @@ function eval_diffusivity_gas_m03(theta, thetasat, tg, bsw) result(diff) real(r8), parameter :: m03_T = 2.0 real(r8), parameter :: mNH3 = 17., mair = 29, vNH3 = 14.9, vair = 20.1, press = 1.0 - m03_W = 3.0 / bsw + m03_W = 3.0_r8 / bsw soilair = thetasat - theta !dair = 1.7e-5 * 1.03**(Tg-293.0_r8) - dair = (0.001 * tg**1.75 * sqrt(1/mNH3 + 1/mair)) / (press * (vair**(1./3) * vNH3**(1./3))**2) * 1e-4 + dair = (0.001_r8 * tg**1.75_r8 * sqrt(1.0_r8/mNH3 + 1.0_r8/mair)) & + / (press * (vair**(1.0_r8/3.0_r8) * vNH3**(1.0_r8/3.0_r8))**2) * 1e-4_r8 diff = dair * soilair**m03_T * (soilair/thetasat)**m03_W / soilair @@ -181,7 +207,7 @@ function eval_diffusivity_liq_m03(theta, thetasat, tg, bsw) result(diff) real(r8), parameter :: pw = 10.0_r8 / 3.0_r8, m03_T = 2.0_r8 real(r8), parameter :: gascnst = 8.314, faraday = 96500.0_r8, lp = 73.4_r8, lm_no3 = 71.4_r8, lm_oh=197.6_r8, lm=lm_oh - kaq_base = 9.8e-10 * 1.03 ** (Tg-273.0_r8) + kaq_base = 9.8e-10 * 1.03 ** (Tg-SHR_CONST_TKFRZ) !kaq_base = 1e-4 * (gascnst*tg / (2*faraday**2)) / (1/lp + 1/lm) @@ -191,6 +217,8 @@ function eval_diffusivity_liq_m03(theta, thetasat, tg, bsw) result(diff) end function eval_diffusivity_liq_m03 + !************************************************************************************ + subroutine partition_tan(tg, Hconc, theta, air, kads, KNH3, fract_nh4) ! Partition the bulk TAN (NH3 gas/aq + NH4 (aq)) between gas and aqueous. Outputs the ! volatility (gas/aq ratio), see below. @@ -230,15 +258,13 @@ real(r8) function eval_no3prod_v2(theta, theta_sat, Tg) result(kNO3) real(r8) :: stf, wmr, smrf, mNH4, soil_dens !real(r8), parameter :: soil_dens = 1400.0_r8 ! Soil density, kg/m3 - real(r8), parameter :: water_dens = 1000.0_r8 + real(r8), parameter :: water_dens = SHR_CONST_RHOFW real(r8), parameter :: rmax = 1.16e-6_r8 ! Maximum rate of nitrification, s-1 real(r8), parameter :: tmax = 313.0 ! Maximm temperature of microbial activity, K real(r8), parameter :: topt = 301.0 ! Optimal temperature of microbial acticity, K real(r8), parameter :: asg = 2.4_8 ! a_sigma, empirical factor real(r8), parameter :: wmr_crit = 0.12_r8 ! Critical water content, g/g real(r8), parameter :: smrf_b = 2 ! Parameter in soil moisture response function - real(r8), parameter :: Tref = 298.15_r8 - soil_dens = 2650.0_r8 * (1.0_r8-theta_sat) mNH4 = 1.0_r8 @@ -252,21 +278,23 @@ real(r8) function eval_no3prod_v2(theta, theta_sat, Tg) result(kNO3) ! soil moisture response function smrf = 1.0_r8 - exp(-(wmr/wmr_crit)**smrf_b) - !if stf < 1e-9 or smrf < 1e-9: - ! print theta - ! 1/0 kNO3 = 2.0_r8 * rmax * mNH4 / (1.0_r8/stf + 1.0_r8/smrf) end function eval_no3prod_v2 + + !************************************************************************************ + ! Nitrogen fluxes for single patch / single N pool - subroutine eval_fluxes_slurry(water, mtan, Hconc, tg, ratm, theta, thetasat, perc, runoff, bsw, kads, fluxes) + subroutine eval_fluxes_slurry(water_surf, water_subsurf, mtan, Hconc, tg, ratm, theta, & + thetasat, perc, runoff, bsw, kads, fluxes, fluxes_size) ! Evaluate nitrogen fluxes for a partly infiltrated layer of slurry. ! The state of infiltration is detemined from the amounts water on surface and in soil. ! Positive flux means loss of TAN. implicit none - real(r8), intent(in) :: water(2) ! water in (surface , subsurface), m + real(r8), intent(in) :: water_surf ! water in (surface , subsurface), m + real(r8), intent(in) :: water_subsurf ! water in (surface , subsurface), m real(r8), intent(in) :: mtan ! TAN, mass units / m2, surface + subsurface - real(r8), intent(out) :: fluxes(5) ! TAN fluxes, see top of the module + real(r8), intent(out) :: fluxes(fluxes_size) ! TAN fluxes, see top of the module real(r8), intent(in) :: Hconc ! H+ concentration, -log10(pH) real(r8), intent(in) :: tg ! soil temperature, K real(r8), intent(in) :: ratm ! atmospheric resistance, s/m @@ -276,25 +304,24 @@ subroutine eval_fluxes_slurry(water, mtan, Hconc, tg, ratm, theta, thetasat, per real(r8), intent(in) :: runoff ! surface runoff, m/s real(r8), intent(in) :: bsw real(r8), intent(in) :: kads ! dimensionless distribution coefficient, kads = [TAN (s)] / [TAN (aq)] + integer, intent(in) :: fluxes_size !real(r8), intent(in) :: dt ! timestep real(r8) :: water_tot, cnc, air, depth_soilsat, diffusivity_water, diffusivity_satsoil, halfwater, insoil, r1, dz2, inwater real(r8) :: r2, volat_rate, kno3, knh3, depth_lower, fract_nh4, r2a, r2b, g3, gdown, rsld, rkl, rkg - - water_tot = water(1) + water(2) + water_tot = water_surf + water_subsurf air = thetasat - theta ! depth of the saturated soil layer below the surface pool - depth_soilsat = water(2) / air + depth_soilsat = water_subsurf / air cnc = mtan / water_tot fluxes(iflx_roff) = cnc * runoff fluxes(iflx_soilq) = cnc * perc - - diffusivity_water = 9.8e-10_r8 * 1.03_r8 ** (tg - 273.0_r8) + diffusivity_water = 9.8e-10_r8 * 1.03_r8 ** (tg - SHR_CONST_TKFRZ) diffusivity_satsoil = eval_diffusivity_liq_mq(thetasat, thetasat, tg) * thetasat !diffusivity_satsoil = eval_diffusivity_liq_m03(thetasat, thetasat, tg, bsw) * thetasat @@ -302,14 +329,14 @@ subroutine eval_fluxes_slurry(water, mtan, Hconc, tg, ratm, theta, thetasat, per ! Calculate the internal resistance r1 of the slurry/soil layer by integrating the ! diffusivity for distance that covers half of the slurry water. - if (water(1) < halfwater) then + if (water_surf < halfwater) then ! contribution from both pool and the saturated soil. - insoil = (halfwater - water(1)) / thetasat - inwater = water(1) + insoil = (halfwater - water_surf) / thetasat + inwater = water_surf else ! pool only inwater = halfwater - insoil = 0.0 + insoil = 0.0_r8 !r1 = halfwater / diffusivity_water end if @@ -326,7 +353,7 @@ subroutine eval_fluxes_slurry(water, mtan, Hconc, tg, ratm, theta, thetasat, per ! lower soil resistance consists of liquid diffusion slurry, in saturated layer, and ! parallel liquid/gas diffusion below the saturated layer. - r2a = (water(1)-inwater) / diffusivity_water + r2a = (water_surf-inwater) / diffusivity_water r2b = (depth_soilsat-insoil) / diffusivity_satsoil dz2 = depth_lower-depth_soilsat @@ -336,24 +363,16 @@ subroutine eval_fluxes_slurry(water, mtan, Hconc, tg, ratm, theta, thetasat, per gdown = -(Rkg + Rkl*knh3)/((Rkg*(Rkl + Rsld) + Rkl*Rsld*knh3)*(kads*(theta - 1) - thetasat)) - ! conductance = inverse resistance - !g3 = (eval_diffusivity_liq_mq(theta, thetasat, tg)*theta & - ! + knh3*eval_diffusivity_gas_mq(theta, thetasat, tg)*(thetasat-theta)) & - ! / dz2 - !r2 = r2a + r2b + 1.0/g3 - fluxes(iflx_soild) = cnc * gdown ! nitrification kno3 = eval_no3prod_v2(thetasat, thetasat, tg) fluxes(iflx_no3) = kno3 * mtan * fract_nh4 - - !fluxes(3:) = 0 end subroutine eval_fluxes_slurry subroutine eval_fluxes_soilroff_ads(mtan, water_manure, Hconc, tg, ratm, theta, thetasat, perc, & - & runoff, bsw, kads_nh4, soildepth, fluxes, substance, status) + & runoff, bsw, kads_nh4, soildepth, fluxes, substance, fluxes_size, status) ! ! Evaluate nitrogen fluxes from a soil layer. Use for all cases except the partly ! infiltrated slurry (above). Fluxes can be evaluated either for urea or TAN: for @@ -362,7 +381,7 @@ subroutine eval_fluxes_soilroff_ads(mtan, water_manure, Hconc, tg, ratm, theta, implicit none real(r8), intent(in) :: mtan ! TAN (=NH4 (aq) + NH3 (g) + NH3 (aq)), mass units / m2 real(r8), intent(in) :: water_manure ! water in the soil pool *in addition to* background soil water - real(r8), intent(out) :: fluxes(5) ! nitrogen fluxes, mass units / m2 / s, see top of module + real(r8), intent(out) :: fluxes(fluxes_size) ! nitrogen fluxes, mass units / m2 / s, see top of module real(r8), intent(in) :: Hconc ! Hydrogen ion concentration, mol/l real(r8), intent(in) :: tg ! soil temperature, K real(r8), intent(in) :: ratm ! atmospheric resistance, s/m @@ -374,6 +393,7 @@ subroutine eval_fluxes_soilroff_ads(mtan, water_manure, Hconc, tg, ratm, theta, real(r8), intent(in) :: kads_nh4 ! distribution coefficient kads = [TAN (s)] / [TAN (aq)]. Unit m3(water) / m3(soil). real(r8), intent(in) :: soildepth ! thickness of the volatlization layer integer, intent(in) :: substance ! subst_tan or subst_urea. + integer, intent(in) :: fluxes_size integer, intent(out) :: status ! error flag real(r8) :: water_tot, cnc, air, henry_eff, dsl, dsg, dstot, dz2, no3_rate, volat_rate, theta_tot, beta @@ -463,6 +483,9 @@ end subroutine get_srf_cnc end subroutine eval_fluxes_soilroff_ads + !************************************************************************************ + ! Pool aging + subroutine partition_to_layer(water, theta, thetasat, soildepth, fraction_in, fraction_down, fraction_runoff) ! Evaluate the fraction of water volume that can be accommodated (before saturation) ! by soil layer with current water content theta. @@ -522,7 +545,7 @@ subroutine age_pools_slurry(ndep, dt, water_slurry, tan_slurry, tan_soil, pools, real(r8), intent(in) :: ndep ! flux of TAN input, gN/m2/s real(r8), intent(in) :: dt ! timestep, s ! water in slurry pool, on surface (1) and below surface (2) not including the background water content (theta) - real(r8), intent(in) :: water_slurry(2) + real(r8), intent(in) :: water_slurry(:) real(r8), intent(inout) :: tan_slurry ! TAN in slurry pool, gN/m2 real(r8), intent(inout) :: tan_soil(:) ! TAN in soil pools, gN/m2 real(r8), intent(in) :: pools(:) ! age spans covered by each pool, including the S0 surface slurry. seconds. @@ -538,8 +561,11 @@ subroutine age_pools_slurry(ndep, dt, water_slurry, tan_slurry, tan_soil, pools, end subroutine age_pools_slurry + !************************************************************************************ + ! Public functions for integrating the FAN model for one timestep. + subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend, runoff, tandep, tanprod, bsw, & - depth_slurry, poolranges, tanpools, Hconc, fluxes, garbage, dt, status) + depth_slurry, poolranges, tanpools, Hconc, fluxes, garbage, dt, pools_size, fluxes_size, status) ! ! Evaluate fluxes and integrate states for a 4-stage slurry model with first pool ! representing uninfiltrated slurry. @@ -556,17 +582,19 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend real(r8), intent(in) :: runoff ! surface runoff flux, m/s real(r8), intent(in) :: tandep ! TAN input flux, gN/m2/s real(r8), intent(in) :: tanprod ! TAN produced in the column, added to aged TAN pool - !real(r8), intent(in) :: infiltr_slurry ! Slurry infiltration rate, m/s real(r8), intent(in) :: depth_slurry ! Initial slurry depth, m real(r8), intent(in) :: bsw - real(r8), intent(in) :: poolranges(4) ! age ranges of TAN pools S0, S1, S2, sec. Slurry infiltration time is inferred from S0. - real(r8), intent(inout) :: tanpools(4) ! TAN pools gN/m2 - real(r8), intent(out) :: fluxes(5,4) ! TAN fluxes, gN/m2/s (type of flux, pool) - real(r8), intent(in) :: Hconc(4) ! H+ concentration + ! age ranges of TAN pools S0, S1, S2, S3 sec. Slurry infiltration time is inferred from S0. + real(r8), intent(in) :: poolranges(pools_size) + real(r8), intent(inout) :: tanpools(pools_size) ! TAN pools gN/m2 + real(r8), intent(out) :: fluxes(fluxes_size, pools_size) ! TAN fluxes, gN/m2/s (type of flux, pool) + real(r8), intent(in) :: Hconc(pools_size) ! H+ concentration real(r8), intent(out) :: garbage ! over-aged TAN occurring during the step, gN/m. real(r8), intent(in) :: dt ! timestep, sec, >0 + integer, intent(in) :: pools_size ! size of the tanpools array. >= 4 + integer, intent(in) :: fluxes_size ! size of the fluxes array. >= 5 integer, intent(out) :: status ! return status, 0 = good - + real(r8) :: infiltr_slurry, infiltrated, percolated, evap_slurry, water_slurry(2), perc_slurry_mean, waterloss real(r8) :: percolation, water_soil, age_prev, water_in_layer, tanpools_old(4) integer :: indpl @@ -574,9 +602,11 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend real(r8), parameter :: dz_layer = 0.02 ! thickness of the volatilization layer, m real(r8), parameter :: kads = 0.0_r8 ! distriution coefficient kads = [TAN (s)] / [TAN (aq)], dimensionless - ! H+ concentration in each pool - !real(r8), parameter :: Hconc(4) = (/10.0_r8**(-8.0_r8), 10.0_r8**(-8.0_r8), 10.0_r8**(-8.0_r8), 10.0_r8**(-7_r8)/) - + if (pools_size < 4 .or. fluxes_size < 5) then + status = err_bad_arg + return + end if + if (theta > thetasat) then status = err_bad_theta return @@ -597,13 +627,16 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend ! Percolation rate out of volat layer, average over the pool S0. perc_slurry_mean = percolated / poolranges(1) - call eval_fluxes_slurry(water_slurry, tanpools(1), Hconc(1), tg, ratm, theta, thetasat, perc_slurry_mean, & - runoff, bsw, kads, fluxes(:,1)) + call eval_fluxes_slurry(water_slurry(1), water_slurry(2), tanpools(1), Hconc(1), & + tg, ratm, theta, thetasat, perc_slurry_mean, & + runoff, bsw, kads, fluxes(1:5,1), 5) - if (any(isnan(fluxes))) then - status = err_nan * 10 + if (debug_fan) then + if (any(isnan(fluxes))) then + status = err_nan * 10 + end if end if - + call update_pools(tanpools(1:1), fluxes(1:5,1:1), dt, 1, 5) if (any(tanpools < -1e-15)) then @@ -630,13 +663,13 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend water_soil = water_in_layer * waterfunction(age_prev + 0.5*poolranges(indpl)) call eval_fluxes_soilroff_ads(tanpools(indpl), water_soil, Hconc(indpl), tg, & & ratm, theta, thetasat, percolation, runoff, bsw, kads, & - & dz_layer, fluxes(:,indpl), subst_tan, status) + & dz_layer, fluxes(1:5,indpl), subst_tan, 5, status) if (status /= 0) return age_prev = age_prev + poolranges(indpl) end do - call update_pools(tanpools(2:), fluxes(1:5,2:), dt, 3, 5) + call update_pools(tanpools(2:4), fluxes(1:5,2:4), dt, 3, 5) if (any(tanpools < -1e-15)) then !if (any(tanpools < -1e-3)) then @@ -645,14 +678,17 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend !end if end if - if (any(isnan(fluxes))) then - status = err_nan * 100 - return - end if + if (debug_fan) then + if (any(isnan(fluxes))) then + status = err_nan * 100 + return + end if - if (abs(sum(tanpools - tanpools_old) - (-sum(fluxes) + tandep + tanprod)*dt + garbage) > max(sum(tanpools_old)*1e-2, 1e-4)) then - status = err_balance_tan - return + if (abs(sum(tanpools - tanpools_old) - (-sum(fluxes) + tandep + tanprod)*dt + garbage) & + > max(sum(tanpools_old)*1e-2, 1e-4)) then + status = err_balance_tan + return + end if end if status = 0 @@ -660,10 +696,10 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend end subroutine update_4pool subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend, runoff, tandep, tanprod, & - water_init, bsw, poolranges, Hconc, dz_layer, tanpools, fluxes, garbage, dt, status, numpools) + water_init, bsw, poolranges, Hconc, dz_layer, tanpools, fluxes, garbage, dt, numpools, size_fluxes, status) ! ! Evaluate fluxes and update soil TAN pools for a model with arbitrary number of pools - ! divided by age and pH. For slurry use update_4pool. + ! defined by age and pH. For slurry use update_4pool. ! implicit none real(r8), intent(in) :: tg ! soil temperature, K @@ -683,11 +719,12 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend real(r8), intent(in) :: Hconc(numpools) ! H+ concentration, mol/l (npools) real(r8), intent(in) :: dz_layer ! thickness of the volatilization layer, m real(r8), intent(inout) :: tanpools(numpools) ! TAN pools gN/m2 (npools) - real(r8), intent(out) :: fluxes(5,numpools) ! TAN fluxes, gN/m2/s (type of flux, pool) + real(r8), intent(out) :: fluxes(size_fluxes,numpools) ! TAN fluxes, gN/m2/s (type of flux, pool) real(r8), intent(out) :: garbage ! "over-aged" TAN produced during the step, gN/m. real(r8), intent(in) :: dt ! timestep, sec, >0 - integer, intent(out) :: status ! 0 == OK integer, intent(in) :: numpools + integer, intent(in) :: size_fluxes + integer, intent(out) :: status ! 0 == OK real(r8) :: fraction_layer, fraction_reservoir, fraction_runoff, waterloss, direct_runoff real(r8) :: percolation, water_soil, age_prev, tandep_remaining, direct_percolation, water_into_layer @@ -698,6 +735,11 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend real(r8), parameter :: kads = 0.0_r8 logical :: fixed + if (size_fluxes < 5) then + status = err_bad_arg + return + end if + tanpools_old = tanpools if (theta > thetasat) then @@ -713,7 +755,6 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend tandep_remaining = tandep - direct_runoff - direct_percolation water_into_layer = water_init * (1.0_r8 - fraction_reservoir - fraction_runoff) if (tandep_remaining < -1e-15) then - print *, tandep, direct_runoff, direct_percolation status = err_negative_tan + 10 return end if @@ -722,9 +763,11 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend return end if - if(any(isnan(tanpools))) then - status = err_nan - return + if (debug_fan) then + if(any(isnan(tanpools))) then + status = err_nan + return + end if end if ! Pool aging & TAN input @@ -734,8 +777,6 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend if (any(tanpools < 0)) then if (any(tanpools < -1e-15)) then - print *, '<0 2', tanpools_old, 'new', tanpools, 'fx', & - sum(fluxes(:,1)) * dt, sum(fluxes(:,2)) * dt, sum(fluxes(:,3)) * dt status = err_negative_tan + 10000 return else @@ -745,9 +786,6 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend imbalance = abs((sum(tanpools) - sum(tanpools_old)) - ((tandep_remaining)*dt+garbage)) if (imbalance > max(1e-14, 0.001*sum(tanpools_old))) then - print *, imbalance, 'old', tanpools_old, 'new', tanpools, 'g', garbage, tandep_remaining, & - 'diff', sum(tanpools_old-tanpools), & - 'depprod', tandep+sum(tanprod), garbage status = err_balance_tan*10 return end if @@ -761,14 +799,14 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend water_soil = water_into_layer * waterfunction(age_prev + 0.5*poolranges(indpl)) call eval_fluxes_soilroff_ads(tanpools(indpl), water_soil, Hconc(indpl), tg, & & ratm, theta, thetasat, percolation, runoff, bsw, kads, & - & dz_layer, fluxes(:,indpl), subst_tan, status) + & dz_layer, fluxes(1:5,indpl), subst_tan, 5, status) if (status /= 0) then return end if age_prev = age_prev + poolranges(indpl) end do - call update_pools(tanpools, fluxes, dt, numpools, 5, fixed) + call update_pools(tanpools, fluxes(1:5,:), dt, numpools, 5, fixed) tanpools = tanpools + tanprod*dt if(any(isnan(tanpools))) then @@ -776,31 +814,28 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend return end if - if (any(isnan(fluxes))) then - status = err_nan + 1000 - end if - if (any(tanpools < -1e-15)) then status = err_negative_tan + 1000 - print *, '<0 2', tanpools_old, tanpools, sum(fluxes(:,1)) * dt, sum(fluxes(:,2)) * dt - - return - end if - - if (abs(sum(tanpools - tanpools_old) + (sum(fluxes)-tandep_remaining-sum(tanprod))*dt + garbage) & - > max(sum(tanpools_old)*1e-2, 1d-2)) then - print *, tanpools, tanpools_old, 'fx', fluxes*dt, 'dp', tandep_remaining*dt, tanprod*dt, 'g', garbage, & - 'ib', sum(tanpools-tanpools_old), (sum(fluxes)-tandep_remaining-sum(tanprod))*dt + garbage, 'fix', fixed - status = err_balance_tan return end if + if (debug_fan) then + if (any(isnan(fluxes))) then + status = err_nan + 1000 + end if + + if (abs(sum(tanpools - tanpools_old) + (sum(fluxes)-tandep_remaining-sum(tanprod))*dt + garbage) & + > max(sum(tanpools_old)*1e-2, 1d-2)) then + status = err_balance_tan + return + end if + end if + ! Add the "direct" fluxes to the fluxes of the first pool fluxes(iflx_roff, 1) = fluxes(iflx_roff, 1) + direct_runoff fluxes(iflx_soilq, 1) = fluxes(iflx_soilq, 1) + direct_percolation if (any(fluxes < -1e-6)) then - print *, fluxes status = err_negative_flux return end if @@ -809,6 +844,9 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend end subroutine update_npool + !************************************************************************************ + ! Helper functions + subroutine update_pools(tanpools, fluxes, dt, np, nf, fixed) ! Update tan pools using the fluxes and an ad-hoc scheme against negative TAN masses. implicit none @@ -832,7 +870,7 @@ subroutine update_pools(tanpools, fluxes, dt, np, nf, fixed) sumflux = tanpools(ip) sumflux = sum(fluxes(:,ip))*dt else - sumflux = 0.0 + sumflux = 0.0_r8 end if end if tanpools(ip) = tanpools(ip) - sumflux @@ -849,22 +887,22 @@ function get_evap_pool(tg, ratm, qbot) result(evap) real(r8) :: evap ! m/s real(r8) :: es, esdt, qs, qsdt, dens, flux - real(r8), parameter :: press = 101300.0_r8 + real(r8), parameter :: press = SHR_CONST_PSTD call qsat(tg, press, es, esdt, qs, qsdt) if (qbot > qs) then - evap = 0 + evap = 0.0_r8 return end if dens = press / (SHR_CONST_RDAIR * tg) flux = dens * (qs - qbot) / ratm ! kg/s/m2 == mm/s - evap = flux*1e-3 + evap = flux*1e-3_r8 end function get_evap_pool ! Waterfunction gives the relaxation of the moisture perturbation normalized between 0 - ! and 1. Either exponential or step. + ! and 1. Either exponential or linear. function waterfunction_exp(pool_age) result(water) implicit none @@ -906,9 +944,11 @@ function eval_perc(waterloss, evap, precip, watertend, dt) result(rate) end function eval_perc + !************************************************************************************ + subroutine eval_fluxes_storage(nitr_input, barntype, tempr_outside, windspeed, fract_direct, & volat_coef_barns, volat_coef_stores, & - tan_fract_excr, fluxes_nitr, fluxes_tan, status) + tan_fract_excr, fluxes_nitr, fluxes_tan, fluxes_size, status) ! ! Evaluate nitrogen fluxes in animal housings and storage. Only volatilization losses ! are assumed. The volatilization fluxes are assumed to depend linearly on the TAN @@ -923,9 +963,10 @@ subroutine eval_fluxes_storage(nitr_input, barntype, tempr_outside, windspeed, f real(r8), intent(in) :: fract_direct ! fraction of manure N applied before storage real(r8), intent(in) :: volat_coef_barns, volat_coef_stores ! normalization coefficients, unitless real(r8), intent(in) :: tan_fract_excr ! fraction of NH4 nitrogen in excreted N - real(r8), intent(out) :: fluxes_nitr(4), fluxes_tan(4) ! nitrogen and TAN fluxes, gN/s + real(r8), intent(out), dimension(fluxes_size) :: fluxes_nitr, fluxes_tan ! nitrogen and TAN fluxes, gN/s ! (/m2). See top of module for ! indices. + integer, intent(in) :: fluxes_size integer, intent(out) :: status ! see top of the module. ! parameters for the Gyldenkaerne et al. parameterization @@ -938,21 +979,27 @@ subroutine eval_fluxes_storage(nitr_input, barntype, tempr_outside, windspeed, f !real(r8), parameter :: Vmax_barns = 0.228_r8 real(r8), parameter :: pA = 0.89_r8, pB = 0.26_r8 real(r8), parameter :: DTlow = 0.5_r8, DThigh = 1.0_r8 + real(r8), parameter :: vmax_barns_closed = 0.40_r8, vmax_barns_open = 0.228_r8 real(r8) :: Vmax_barns ! depends on barntype real(r8) :: flux_avail, flux_avail_tan, tempr_stores, tempr_barns, vent_barns, flux_direct, flux_direct_tan, & & flux_barn, flux_store, tempr_C + + if (fluxes_size < 4) then + status = err_bad_arg + return + end if fluxes_nitr = 0.0_r8 fluxes_tan = 0.0_r8 - tempr_C = tempr_outside - 273 + tempr_C = tempr_outside - SHR_CONST_TKFRZ select case(barntype) case ('open') - Vmax_barns = 0.228_r8 - tempr_barns = max(tempr_C+tempr_D, Tfloor_barns) + Vmax_barns = vmax_barns_open + tempr_barns = max(tempr_C+tempr_D, Tfloor_barns) case ('closed') - Vmax_barns = 0.40_r8 + Vmax_barns = vmax_barns_closed if (Trec + DTlow * (tempr_C - Tmin_barns) < Tmin_barns) then tempr_barns = Tmin_barns else if (tempr_C < Tmin_barns) then @@ -984,7 +1031,7 @@ subroutine eval_fluxes_storage(nitr_input, barntype, tempr_outside, windspeed, f end if flux_barn = flux_avail_tan * volat_coef_barns * tempr_barns**pA * vent_barns**pB - flux_barn = min(flux_avail_tan, flux_barn) ! hopefully uncommon + flux_barn = min(flux_avail_tan, flux_barn) fluxes_tan(iflx_air_barns) = flux_barn fluxes_nitr(iflx_air_barns) = flux_barn @@ -992,7 +1039,6 @@ subroutine eval_fluxes_storage(nitr_input, barntype, tempr_outside, windspeed, f flux_avail_tan = flux_avail_tan - flux_barn if (flux_avail < 0 .or. flux_avail_tan < 0) then - !print *, flux_avail_tan, flux_avail, flux_barn, tempr_barns, vent_barns, tempr_C status = err_negative_flux*10000 return end if @@ -1022,49 +1068,60 @@ subroutine eval_fluxes_storage(nitr_input, barntype, tempr_outside, windspeed, f fluxes_nitr(iflx_to_store) = flux_avail fluxes_tan(iflx_to_store) = flux_avail_tan - - if (abs(sum(fluxes_nitr) - nitr_input) > 1e-5*nitr_input) then - status = err_balance_nitr - return - end if - if (abs(sum(fluxes_tan) - nitr_input*tan_fract_excr) > 1e-5*nitr_input) then - status = err_balance_tan - return - end if + if (debug_fan) then + if (abs(sum(fluxes_nitr) - nitr_input) > 1e-5*nitr_input) then + status = err_balance_nitr + return + end if - if (any(fluxes_nitr < 0) .or. any(fluxes_tan < 0)) then - status = err_negative_flux*100 - return + if (abs(sum(fluxes_tan) - nitr_input*tan_fract_excr) > 1e-5*nitr_input) then + status = err_balance_tan + return + end if + + if (any(fluxes_nitr < 0) .or. any(fluxes_tan < 0)) then + status = err_negative_flux*100 + return + end if end if status = 0 end subroutine eval_fluxes_storage - subroutine update_org_n(flux_input, tg, soilpsi, pools, dt, tanprod, soilflux) + !************************************************************************************ + + subroutine update_org_n(flux_input, tg, soilpsi, pools, dt, tanprod, soilflux, size_pools, status) ! ! Evaluate the decomposition/mineralization N fluxes from the available, resistant and ! unavailable N fractions, and update the organic N pools. In addition, evaluate the ! flux of organic N into the soil pools according to a fixed time constant set below. implicit none - real(r8), intent(in) :: flux_input(3) ! organic N entering the pools. gN/m2/s. For + real(r8), intent(in) :: flux_input(size_pools) ! organic N entering the pools. gN/m2/s. For ! indices see at top of the module. real(r8), intent(in) :: tg ! ground temperature, K real(r8), intent(in) :: soilpsi ! soil water potential (MPa) - real(r8), intent(inout) :: pools(3) ! organic N pools + real(r8), intent(inout) :: pools(size_pools) ! organic N pools real(r8), intent(in) :: dt ! timestep, sec - real(r8), intent(out) :: tanprod(3) ! Flux of TAN formed, both pools + real(r8), intent(out) :: tanprod(size_pools) ! Flux of TAN formed, both pools real(r8), intent(out) :: soilflux ! Flux of organic nitrogen to soil - + integer, intent(in) :: size_pools + integer, intent(out) :: status + real(r8) :: rate_res, rate_avail, TR, rmoist, psi real(r8), parameter :: ka1 = 8.94e-7_r8, ka2 = 6.38e-8 ! 1/s - real(r8), parameter :: tr1 = 0.0106, tr2 = 0.12979 + real(r8), parameter :: tr1 = 0.0106_r8, tr2 = 0.12979_r8 real(r8), parameter :: org_to_soil_time = 365*24*3600.0_r8 real(r8), parameter :: minpsi = -2.5_r8, maxpsi=-0.002_r8 real(r8) :: soilfluxes(3) + + if (size_pools < 3) then + status = err_bad_arg + return + end if - TR = tr1 * exp(tr2 * (tg-273.15_r8)) + TR = tr1 * exp(tr2 * (tg-SHR_CONST_TKFRZ)) ! The moisture scaling taken from CLM5 litter decomposition scheme: psi = min(soilpsi, maxpsi) @@ -1078,15 +1135,16 @@ subroutine update_org_n(flux_input, tg, soilpsi, pools, dt, tanprod, soilflux) tanprod(ind_avail) = ka1 * TR * pools(ind_avail)*rmoist tanprod(ind_resist) = ka2 * TR * pools(ind_resist)*rmoist tanprod(ind_unavail) = 0.0 - soilfluxes = pools * 1.0_r8 / org_to_soil_time + soilfluxes = pools(1:3) * 1.0_r8 / org_to_soil_time pools = pools + (flux_input - tanprod - soilfluxes) * dt soilflux = sum(soilfluxes) + status = 0 end subroutine update_org_n subroutine update_urea(tg, theta, thetasat, precip, evap, watertend, runoff, & - ndep, bsw, pools, fluxes, garbage, ranges, dt, status, numpools) + ndep, bsw, pools, fluxes, garbage, ranges, dt, numpools, fluxes_size, status) ! ! Evaluate fluxes and update the urea pools. The procedure is similar to updating the ! soil TAN pools, but NO3 and volatilization fluxes do not occur. @@ -1102,12 +1160,13 @@ subroutine update_urea(tg, theta, thetasat, precip, evap, watertend, runoff, & real(r8), intent(in) :: ndep ! nitrogen input, mass unit / s real(r8), intent(in) :: bsw ! b in the soil water retention curve real(r8), intent(inout) :: pools(numpools) ! nitrogen pools mass / m2 - real(r8), intent(out) :: fluxes(6, numpools) ! one extra for the to_tan flux + real(r8), intent(out) :: fluxes(fluxes_size, numpools) ! needs one extra for the to_tan flux real(r8), intent(in) :: ranges(numpools) ! pool age extents, s real(r8), intent(out) :: garbage ! nitrogen in patches aged beyond the oldest pool. mass / m2 real(r8), intent(in) :: dt ! time step, s - integer, intent(out) :: status ! see top of module integer, intent(in) :: numpools + integer, intent(in) :: fluxes_size + integer, intent(out) :: status ! see top of module real(r8), parameter :: rate = 4.83e-6 ! urea decomposition, 1/s real(r8), parameter :: missing = 1e36 ! for the parameters not needed for urea fluxes @@ -1116,6 +1175,11 @@ subroutine update_urea(tg, theta, thetasat, precip, evap, watertend, runoff, & real(r8) :: age_prev, percolation, old_total, balance integer :: indpl + if (fluxes_size < 6) then + status = err_bad_arg + return + end if + old_total = sum(pools) call age_pools_soil(ndep, dt, ranges, pools, garbage) @@ -1125,8 +1189,8 @@ subroutine update_urea(tg, theta, thetasat, precip, evap, watertend, runoff, & percolation = eval_perc(0.0_r8, evap, precip, watertend, ranges(indpl)) ! Hconc and Ratm are missing since they do not affect urea. call eval_fluxes_soilroff_ads(pools(indpl), 0.0_r8, missing, tg, & - & missing, theta, thetasat, percolation, runoff, bsw, 0.0_r8, & - & dz_layer, fluxes(1:5,indpl), subst_urea, status) + missing, theta, thetasat, percolation, runoff, bsw, 0.0_r8, & + dz_layer, fluxes(1:5, indpl), subst_urea, 5, status) if (status /= 0) then return end if @@ -1135,19 +1199,22 @@ subroutine update_urea(tg, theta, thetasat, precip, evap, watertend, runoff, & end do ! Here goes also flux_tan! - call update_pools(pools, fluxes, dt, numpools, 6) + call update_pools(pools, fluxes(1:6, 1:numpools), dt, numpools, 6) balance = sum(pools) - old_total - if (abs(balance - (ndep-sum(fluxes))*dt + garbage) > 1e-9) then - print *, balance, 'f', sum(fluxes)*dt, ndep*dt, (ndep-sum(fluxes))*dt-garbage - balance, & - 'p', pools, 'g', garbage - status = err_balance_nitr - return - end if + if (debug_fan) then + if (abs(balance - (ndep-sum(fluxes))*dt + garbage) > 1e-9) then + status = err_balance_nitr + return + end if + end if + status = 0 end subroutine update_urea + + !************************************************************************************ subroutine get_storage_fluxes_tan_ar(manure_excr, tempr_outside, windspeed, fract_direct, & & flux_direct, flux_direct_tan, flux_barn, flux_store, flux_resid, flux_resid_tan, & @@ -1165,10 +1232,9 @@ subroutine get_storage_fluxes_tan_ar(manure_excr, tempr_outside, windspeed, frac do ii = 1, nn call eval_fluxes_storage(manure_excr(ii), 'open', tempr_outside(ii), windspeed(ii), fract_direct(ii), & & volat_coef_barns, volat_coef_stores, tan_fract_excr, & - & fluxes_nitr, fluxes_tan, status) + & fluxes_nitr, fluxes_tan, 4, status) if (status /= 0) then - print *, 'Status = ', status return end if @@ -1178,7 +1244,6 @@ subroutine get_storage_fluxes_tan_ar(manure_excr, tempr_outside, windspeed, frac flux_store(ii) = fluxes_tan(iflx_air_stores) flux_resid(ii) = fluxes_nitr(iflx_to_store) flux_resid_tan(ii) = fluxes_tan(iflx_to_store) - !print *, '1', fluxes_nitr(iflx_appl), flux_direct(ii) end do end subroutine get_storage_fluxes_tan_ar From c0c311d9b250827517d42b3d728e42bc4816b952 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 6 Mar 2019 15:36:17 -0500 Subject: [PATCH 059/181] n-balance check debugged --- src/biogeochem/Fan2CTSMMod.F90 | 35 +++++++++++++++++++--------------- 1 file changed, 20 insertions(+), 15 deletions(-) diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index 16f2d8cb65..9c8918220e 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -110,6 +110,8 @@ subroutine fan_readnml(NLFilename) stream_year_last_fan, model_year_align_fan, fan_mapalgo, stream_fldFileName_fan, & fract_spread_grass + if (.not. use_fan) return + if (masterproc) then unitn = getavu() write(iulog, *) 'Read in ' // nmlname // ' namelist' @@ -611,15 +613,14 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & write(iulog, *) 'SoilPH check:', soilph_min, soilph_max, def_ph_count end if - old = ns%fan_totn_col(filter_soilc(1:num_soilc)) - + !old = ns%fan_totn_col(filter_soilc(1:num_soilc)) call update_summary(ns, nf, filter_soilc, num_soilc) - call debug_balance(ns, nf, old, filter_soilc(1:num_soilc)) - - call debug_balance(ns, nf, old, (/1/)) + !call debug_balance(ns, nf, old, filter_soilc(1:num_soilc)) - call debug_balance(ns, nf, old, (/2/)) + !do fc = 1, num_soilc + ! call debug_balance(ns, nf, old, (/fc/)) + !end do end associate @@ -640,8 +641,7 @@ subroutine debug_balance(ns, nf, oldn, columns) print *, 'old total:', sum(oldn(columns)) print *, 'new total:', sum(newn(columns)) print *, 'delta:', sum(oldn(columns)) - sum(newn(columns)) - print *, 'new flux:', (sum(nf%fan_totnin(columns)) - sum(nf%fan_totnout(columns)))*dt - !print *, 'total from funct', get_total_n(ns, nf, 'pools_manure') + get_total_n(ns, nf, 'pools_fertilizer') + print *, 'new flux:', (sum(nf%fan_totnin_col(columns)) - sum(nf%fan_totnout_col(columns)))*dt end subroutine debug_balance @@ -860,7 +860,6 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & ! Evaluate the NH3 losses, separate for ruminants (open barns) and others ! (poultry and pigs, closed barns). Note the slicing of fluxes(:,:) and fluxes_tan(:,:). - man_n_transf(c) = flux_grazing nh3_flux_stores(c) = 0.0 if (flux_avail_rum < 0) then @@ -909,7 +908,7 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & flux_grass_spread = flux_grass_spread + fract_spread_grass * total_to_store*col%wtgcell(c) flux_grass_spread_tan = flux_grass_spread_tan + fract_spread_grass * total_to_store_tan*col%wtgcell(c) - man_n_transf(c) = man_n_transf(c) + total_to_store + man_n_transf(c) = flux_grazing + fract_spread_grass*total_to_store nh3_flux_stores(c) = sum(fluxes_nitr(iflx_air_stores,:)) nh3_flux_barns(c) = sum(fluxes_nitr(iflx_air_barns,:)) @@ -965,24 +964,28 @@ subroutine update_summary(ns, nf, filter_soilc, num_soilc) total = total + ns%tan_f0_col(c) + ns%tan_f1_col(c) + ns%tan_f2_col(c) + ns%tan_f3_col(c) total = total + ns%fert_u0_col(c) + ns%fert_u1_col(c) ns%fan_totn_col(c) = total - + if (lun%itype(col%landunit(c)) == istcrop) then ! no grazing, man_n_appl is from the same column and not counted as input - fluxin = nf%man_n_barns_col(c) + nf%fert_n_appl_col(c) + fluxin = nf%man_n_mix_col(c) + nf%fert_n_appl_col(c) + print *, 'crop', fc, fluxin else ! no barns or fertilization. man_n_appl is transferred from crop columns and not ! included in the other inputs. fluxin = nf%man_n_grz_col(c) + nf%man_n_appl_col(c) + print *, 'veg', fc, fluxin end if flux_loss = nf%nh3_man_app_col(c) + nf%nh3_grz_col(c) + nf%manure_runoff_col(c) & + nf%nh3_stores_col(c) + nf%nh3_barns_col(c) & + nf%nh3_fert_col(c) + nf%fert_runoff_col(c) - + print *, 'flux_loss', flux_loss fluxout = nf%fert_no3_prod_col(c) + nf%fert_nh4_to_soil_col(c) & + nf%manure_no3_prod_col(c) + nf%manure_nh4_to_soil_col(c) & + nf%man_n_transf_col(c) + flux_loss - + print *, 'flux_out', fluxout + print *, 'transf', nf%man_n_transf_col(c) + nf%fan_totnin_col(c) = fluxin nf%fan_totnout_col(c) = fluxout @@ -1003,9 +1006,11 @@ subroutine fan_to_sminn(filter_soilc, num_soilc, sbgc_nf) integer :: c, fc real(r8) :: fan_nitr + + if (.not. (fan_to_bgc_veg .or. fan_to_bgc_crop)) return do fc = 1, num_soilc - c = filter_soilc(c) + c = filter_soilc(fc) fan_nitr & = sbgc_nf%fert_no3_prod_col(c) + sbgc_nf%fert_nh4_to_soil_col(c) & + sbgc_nf%manure_no3_prod_col(c) + sbgc_nf%manure_nh4_to_soil_col(c) From 27719f650ea36af01d431bea41b5072f1edea6ff Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 6 Mar 2019 15:36:40 -0500 Subject: [PATCH 060/181] FAN namelist setup --- bld/CLMBuildNamelist.pm | 55 +++++++++++--- bld/namelist_files/namelist_defaults_ctsm.xml | 75 +++++++++++-------- bld/namelist_files/namelist_defaults_fan.xml | 1 + .../namelist_definition_ctsm.xml | 9 ++- 4 files changed, 96 insertions(+), 44 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 1a7db77262..e3a85374db 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -1533,7 +1533,7 @@ sub process_namelist_inline_logic { ################################ # namelist group: fan_nml # ################################ - setup_logic_fan_nml($opts, $nl_flags, $definition, $defaults, $nl, $physv); + # setup_logic_fan_nml($opts, $nl_flags, $definition, $defaults, $nl, $physv); ################################## # namelist group: cnmresp_inparm # @@ -2868,14 +2868,50 @@ sub setup_logic_fan { # Flags to control FAN (Flow of Agricultural Nitrogen) nitrogen deposition (manure and fertilizer) # my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_; - if ( $opts->{'fan'} ) { - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_fan', - 'use_cn'=>$nl_flags->{'use_cn'}, 'use_ed'=>$nl_flags->{'use_ed'} ); - $nl_flags->{'use_fan'} = $nl->get_value('use_fan'); - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fan_nh3_to_atm', - 'fan_mode'=>$opts->{'fan'}); - $nl_flags->{'fan_nh3_to_atm'} = $nl->get_value('fan_nh3_to_atm'); + my $fan_mode = $opts->{'fan'}; + print "FAN MODE: $fan_mode\n"; + if ($fan_mode eq 'default') { $fan_mode = 'off'; } + + if (!($fan_mode =~ /atm|soil|full|on|off/)) { + $log->fatal_error("fan_mode not one of atm, soil, full, on, off\n" ); + } + #print "USE_FAN 1:", $nl->get_value('use_fan'); + + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_fan', + 'fan_mode'=>$fan_mode ); + print "USE_FAN 2:", $nl->get_value('use_fan'); + + $nl_flags->{'use_fan'} = $nl->get_value('use_fan'); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fan_nh3_to_atm', + 'fan_mode'=>$fan_mode); + $nl_flags->{'fan_nh3_to_atm'} = $nl->get_value('fan_nh3_to_atm'); + + if ( !($fan_mode eq 'off') ) { + + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fan_mapalgo'); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_first_fan', + 'sim_year'=>$nl_flags->{'sim_year'}, 'sim_year_range'=>$nl_flags->{'sim_year_range'}); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_last_fan', + 'sim_year'=>$nl_flags->{'sim_year'}, 'sim_year_range'=>$nl_flags->{'sim_year_range'}); + + # Set align year, if first and last years are different + if ( $nl->get_value('stream_year_first_fan') != $nl->get_value('stream_year_last_fan') ) { + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'model_year_align_fan', + 'sim_year'=>$nl_flags->{'sim_year'}, 'sim_year_range'=>$nl_flags->{'sim_year_range'}); + } + + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_fldfilename_fan'); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fan_to_bgc_crop', + 'fan_mode'=>$fan_mode); + #$nl_flags->{'fan_to_bgc_crop'} = $nl->get_value('fan_to_bgc_crop'); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fan_to_bgc_veg', + 'fan_mode'=>$fan_mode); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fract_spread_grass', + 'fan_mode'=>$fan_mode); + + } + if ( &value_is_true( $nl_flags->{'use_ed'} ) && &value_is_true( $nl_flags->{'use_fan'} ) ) { fatal_error("Cannot turn use_fan on when use_ed is on\n" ); } @@ -3762,8 +3798,9 @@ sub add_default { # check whether the variable has a value in the namelist object -- if so then skip to end my $val = $nl->get_variable_value($group, $var); - if (! defined $val) { + print "ifdef $var $val\n"; + if (! defined $val) { # Look for a specified value in the options hash if (defined $settings{'val'}) { diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index b71efbc5c5..1c54892bf6 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -452,12 +452,13 @@ attributes from the config_cache.xml file (with keys converted to upper-case). .true. -.true. -.false. -.true. -.false. -.false. -.false. +.false. +.true. +.true. +.true. +.true. + + -2010 -2010 +2010 +2010 -2010 -2010 +2010 +2010 -2010 -2010 +2010 +2010 -2010 -2010 +2010 +2010 -2010 -2010 +2010 +2010 -2010 -2010 +2010 +2010 -2010 -2010 +2010 +2010 -2010 -2010 +2010 +2010 nitrogen.nc -bilinear - -nn -nn -nn -nn -nn -nn -nn -nn -.false. +bilinear + +nn +nn +nn +nn +nn +nn +nn +nn + +.true. +.true. +.false. .false. +1.0 +0.0 +0.0 +1.0 + .false. diff --git a/bld/namelist_files/namelist_defaults_fan.xml b/bld/namelist_files/namelist_defaults_fan.xml index 80c24cb154..d4711385f0 100644 --- a/bld/namelist_files/namelist_defaults_fan.xml +++ b/bld/namelist_files/namelist_defaults_fan.xml @@ -15,5 +15,6 @@ attributes from the config_cache.xml file (with keys converted to upper-case). .false. .true. +.true. diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index 92710844b2..3badece69f 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -669,7 +669,7 @@ Toggle to turn on the plant hydraulic stress model + group="clm_inparm" valid_values=""> Toggle to turn on the Flow of Agricultural Nitrogen (FAN) model @@ -1591,7 +1591,7 @@ Mapping method from FAN Nitrogen (manure) deposition input file to the model res -Toggle to connect the FAN N pools to soil biogeochemistry for CROP columns +Fraction (0...1) of manure N moved from crops to native vegetation column + +Toggle to connect the FAN N pools to soil biogeochemistry for NATIVE VEGETATION columns + + From 5e51050aaf6990d1acd4f75097ea979f8d4b6bae Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Fri, 8 Mar 2019 15:21:53 -0500 Subject: [PATCH 061/181] debug fan_to_bgc_crop namelist defaults --- bld/namelist_files/namelist_defaults_ctsm.xml | 1 + 1 file changed, 1 insertion(+) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 1c54892bf6..48c7b0bf01 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -1056,6 +1056,7 @@ lnd/clm2/surfdata_map/surfdata_ne120np4_78pfts_CMIP6_simyr1850_c170824.nc.true. .true. .false. +.false. .false. 1.0 0.0 From 954001907c098eb0fbef2fa3293973a73956b667 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Fri, 8 Mar 2019 15:24:36 -0500 Subject: [PATCH 062/181] 10**-ph -> 10**(-ph), etc --- src/biogeochem/Fan2CTSMMod.F90 | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index 62c1f869aa..7d32e0aee5 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -228,7 +228,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & soilph_max = -999 def_ph_count = 0 dt = real(get_step_size(), r8) - do_balance_checks = mod(get_nstep(), balance_check_freq) == 0 + do_balance_checks = balance_check_freq > 0 .and. mod(get_nstep(), balance_check_freq) == 0 associate(& ngrz => soilbiogeochem_nitrogenflux_inst%man_n_grz_col, & @@ -399,7 +399,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & ph_soil = 6.5_r8 def_ph_count = def_ph_count + 1 end if - Hconc_grz(3) = 10**-(ph_soil) + Hconc_grz(3) = 10**(-ph_soil) soilph_max = max(soilph_max, ph_soil) soilph_min = min(soilph_min, ph_soil) @@ -458,7 +458,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & tanpools4(4) = ns%tan_s3_col(c) ph_crop = min(max(ph_soil, ph_crop_min), ph_crop_max) - Hconc_slr(4) = 10**-(ph_crop) + Hconc_slr(4) = 10**(-ph_crop) fluxes_tmp = 0.0 garbage_total = 0.0 @@ -625,7 +625,7 @@ subroutine debug_balance(ns, nf, oldn, columns) real(r8) :: oldn(:) integer :: columns(:) - real(r8) :: newn(size(old)) + real(r8) :: newn(size(oldn)) newn = ns%fan_totn_col @@ -885,6 +885,7 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & write(iulog, *) 'status = ', status call endrun(msg='eval_fluxes_storage failed for other livestock') end if + cumflux = cumflux + sum(fluxes_nitr) if (fluxes_tan(iflx_to_store,1) < 0) then From 8687c208820d538c4b5237b615d17d4813140c76 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Tue, 12 Mar 2019 16:45:50 -0400 Subject: [PATCH 063/181] more cleanup --- src/biogeochem/FanMod.F90 | 34 +++++++++++++--------------------- 1 file changed, 13 insertions(+), 21 deletions(-) diff --git a/src/biogeochem/FanMod.F90 b/src/biogeochem/FanMod.F90 index 727ca7fe86..12dc5c98e7 100755 --- a/src/biogeochem/FanMod.F90 +++ b/src/biogeochem/FanMod.F90 @@ -4,13 +4,13 @@ module FanMod ! !DESCRIPTION: ! ! This module implements the physical parameterizations of the FANv2 (Flow of - ! Agricultureal Nitrogen version 2) process model, and includes the numericals routines + ! Agricultureal Nitrogen version 2) process model, and includes the numerical routines ! for handling age-seggregated N pools. The model evaluates nitrogen losses due to ! volatilization and leaching from livestock manure and mineral fertilizers. ! ! The public subroutines are designed to be callable from python code using f2py. In ! this case the _PYMOD_ flag needs to be set. While the non-public subroutines are - ! exported to the python module, they may not work correctly due to the assumed-shape + ! exported to the python module, they might not work correctly due to the assumed-shape ! arrays. ! @@ -22,10 +22,6 @@ module FanMod use QSatMod , only : QSat #endif implicit none - -#ifdef _REALPR_ - integer, parameter :: r8 = 8 -#endif #ifdef _PYMOD_ public @@ -77,7 +73,7 @@ module FanMod contains - ! accessor functions are only needed for the python interface... + ! Accessor functions for module constants. Only needed for the python interface. ! integer function ind_soild() result(ind) ind = iflx_soild @@ -244,12 +240,9 @@ subroutine partition_tan(tg, Hconc, theta, air, kads, KNH3, fract_nh4) fract_aq = theta / (air*KNH3 + theta + kads*(1.0_r8-theta-air)) if (present(fract_nh4)) fract_nh4 = fract_aq * Hconc / (KNH4 + Hconc) - !if (present(fract_nh3g)) fract_nh3g = air * KNH3 / (air*KNH3 + theta) - !if (present(fract_nh3aq)) fract_nh3aq = fract_aq * (1.0_r8 - Hconc / (KNH4 + Hconc)) - end subroutine partition_tan - real(r8) function eval_no3prod_v2(theta, theta_sat, Tg) result(kNO3) + real(r8) function eval_no3prod(theta, theta_sat, Tg) result(kNO3) ! Evaluate nitrification rate as in the Riddick et al. (2016) paper but for NH4. ! Partitioning between TAN forms is not included. real(r8), intent(in) :: theta, theta_sat ! volumetric soil water m/m @@ -280,7 +273,7 @@ real(r8) function eval_no3prod_v2(theta, theta_sat, Tg) result(kNO3) smrf = 1.0_r8 - exp(-(wmr/wmr_crit)**smrf_b) kNO3 = 2.0_r8 * rmax * mNH4 / (1.0_r8/stf + 1.0_r8/smrf) - end function eval_no3prod_v2 + end function eval_no3prod !************************************************************************************ ! Nitrogen fluxes for single patch / single N pool @@ -321,9 +314,8 @@ subroutine eval_fluxes_slurry(water_surf, water_subsurf, mtan, Hconc, tg, ratm, fluxes(iflx_roff) = cnc * runoff fluxes(iflx_soilq) = cnc * perc - diffusivity_water = 9.8e-10_r8 * 1.03_r8 ** (tg - SHR_CONST_TKFRZ) + diffusivity_water = eval_diffusivity_liq_mq(1.0_r8, 1.0_r8, tg) ! use tortuosity = 1 diffusivity_satsoil = eval_diffusivity_liq_mq(thetasat, thetasat, tg) * thetasat - !diffusivity_satsoil = eval_diffusivity_liq_m03(thetasat, thetasat, tg, bsw) * thetasat halfwater = 0.5_r8 * water_tot @@ -366,12 +358,12 @@ subroutine eval_fluxes_slurry(water_surf, water_subsurf, mtan, Hconc, tg, ratm, fluxes(iflx_soild) = cnc * gdown ! nitrification - kno3 = eval_no3prod_v2(thetasat, thetasat, tg) + kno3 = eval_no3prod(thetasat, thetasat, tg) fluxes(iflx_no3) = kno3 * mtan * fract_nh4 end subroutine eval_fluxes_slurry - subroutine eval_fluxes_soilroff_ads(mtan, water_manure, Hconc, tg, ratm, theta, thetasat, perc, & + subroutine eval_fluxes_soil(mtan, water_manure, Hconc, tg, ratm, theta, thetasat, perc, & & runoff, bsw, kads_nh4, soildepth, fluxes, substance, fluxes_size, status) ! ! Evaluate nitrogen fluxes from a soil layer. Use for all cases except the partly @@ -427,7 +419,7 @@ subroutine eval_fluxes_soilroff_ads(mtan, water_manure, Hconc, tg, ratm, theta, if (substance == subst_tan) then kads = kads_nh4 call partition_tan(tg, Hconc, theta_tot, air, kads, volatility, fract_nh4=fract_nh4) - no3_rate = eval_no3prod_v2(theta_tot, thetasat, tg) + no3_rate = eval_no3prod(theta_tot, thetasat, tg) else if (substance == subst_urea) then volatility = 0.0 no3_rate = 0.0_r8 @@ -481,7 +473,7 @@ subroutine get_srf_cnc(knh3, xs, xag, Rsg, Rsl, Rag, qr, theta, air, cnc_gas, cn end subroutine get_srf_cnc - end subroutine eval_fluxes_soilroff_ads + end subroutine eval_fluxes_soil !************************************************************************************ ! Pool aging @@ -661,7 +653,7 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend ! water content at the mean age of the pool water_soil = water_in_layer * waterfunction(age_prev + 0.5*poolranges(indpl)) - call eval_fluxes_soilroff_ads(tanpools(indpl), water_soil, Hconc(indpl), tg, & + call eval_fluxes_soil(tanpools(indpl), water_soil, Hconc(indpl), tg, & & ratm, theta, thetasat, percolation, runoff, bsw, kads, & & dz_layer, fluxes(1:5,indpl), subst_tan, 5, status) @@ -797,7 +789,7 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend percolation = eval_perc(waterloss, evap, precip, watertend, poolranges(indpl)) ! water content at the middle of the age range water_soil = water_into_layer * waterfunction(age_prev + 0.5*poolranges(indpl)) - call eval_fluxes_soilroff_ads(tanpools(indpl), water_soil, Hconc(indpl), tg, & + call eval_fluxes_soil(tanpools(indpl), water_soil, Hconc(indpl), tg, & & ratm, theta, thetasat, percolation, runoff, bsw, kads, & & dz_layer, fluxes(1:5,indpl), subst_tan, 5, status) if (status /= 0) then @@ -1188,7 +1180,7 @@ subroutine update_urea(tg, theta, thetasat, precip, evap, watertend, runoff, & do indpl = 1, numpools percolation = eval_perc(0.0_r8, evap, precip, watertend, ranges(indpl)) ! Hconc and Ratm are missing since they do not affect urea. - call eval_fluxes_soilroff_ads(pools(indpl), 0.0_r8, missing, tg, & + call eval_fluxes_soil(pools(indpl), 0.0_r8, missing, tg, & missing, theta, thetasat, percolation, runoff, bsw, 0.0_r8, & dz_layer, fluxes(1:5, indpl), subst_urea, 5, status) if (status /= 0) then From b730f66f77bd83bb7bf433135e70a442905f06e0 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 13 Mar 2019 12:19:33 -0600 Subject: [PATCH 064/181] housing mods --- src/biogeochem/CNNDynamicsMod.F90 | 78 +++++++++++++++++++++---------- src/biogeochem/FanMod.F90 | 58 ++++++++++++++++------- 2 files changed, 94 insertions(+), 42 deletions(-) diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index ac8f3367a1..ce1f6b4434 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -765,15 +765,15 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & integer , intent(in) :: filter_soilc(:) ! filter for soil columns integer :: begg, endg, g, l, c, il, counter, col_grass, status, p - real(r8) :: flux_avail, flux_grazing + real(r8) :: flux_avail_rum, flux_avail_mg, flux_grazing real(r8) :: tempr_ave, windspeed_ave ! windspeed and temperature averaged over agricultural patches real(r8) :: tempr_barns, tempr_stores, vent_barns, flux_grass_crop, tempr_min_10day, & flux_grass_graze, flux_grass_spread, flux_grass_spread_tan, flux_grass_crop_tan - real(r8) :: cumflux, totalinput - real(r8) :: fluxes_nitr(4), fluxes_tan(4) + real(r8) :: cumflux, totalinput, total_to_store + real(r8) :: fluxes_nitr(4,2), fluxes_tan(4,2) ! The fraction of manure applied continuously on grasslands (if present in the gridcell) real(r8), parameter :: fract_continuous = 0.1_r8, kg_to_g = 1e3_r8, max_grazing_fract = 0.65_r8, & - volat_coef_barns = 0.03_r8, volat_coef_stores = 0.025_r8, & + volat_coef_barns_open = 0.03_r8, volat_coef_barns_closed = 0.025, volat_coef_stores = 0.025_r8, & tempr_min_grazing = 283.0_r8!!!! begg = bounds%begg; endg = bounds%endg @@ -785,8 +785,6 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & cumflux = 0.0 do g = begg, endg - !totalinput = totalinput + ndep_mixed_grc(g) - ! First find out if there are grasslands in this cell. If yes, a fraction of ! manure can be diverted to them before storage. col_grass = ispval @@ -832,21 +830,23 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & if (tempr_min_10day > tempr_min_grazing) then ! fraction of animals grazing -> allocate some manure to grasslands before barns flux_grazing = max_grazing_fract * ndep_sgrz_grc(g) * kg_to_g / lun%wtgcell(l) - flux_avail = (ndep_ngrz_grc(g) + ndep_sgrz_grc(g)*(1.0_r8 - max_grazing_fract)) * kg_to_g / lun%wtgcell(l) + !flux_avail = (ndep_ngrz_grc(g) + ndep_sgrz_grc(g)*(1.0_r8 - max_grazing_fract)) * kg_to_g / lun%wtgcell(l) + flux_avail_rum = (ndep_sgrz_grc(g)*(1.0_r8 - max_grazing_fract)) * kg_to_g / lun%wtgcell(l) grz_fract(c) = max_grazing_fract else flux_grazing = 0.0_r8 - flux_avail = n_manure_mixed_col(c) + flux_avail_rum = ndep_sgrz_grc(g) * kg_to_g / lun%wtgcell(l) grz_fract(c) = 0.0_r8 end if + flux_avail_mg = ndep_ngrz_grc(g) * kg_to_g / lun%wtgcell(l) flux_grass_graze = flux_grass_graze + flux_grazing*col%wtgcell(c) - if (flux_avail > 1e12 .or. isnan(flux_avail)) then + if (flux_avail_rum > 1e12 .or. flux_avail_mg > 1e12 .or. isnan(flux_avail_mg) .or. isnan(flux_avail_rum)) then write(iulog, *) 'bad flux_avail', ndep_ngrz_grc(g), ndep_sgrz_grc(g), lun%wtgcell(l) call endrun('bad flux_avail') end if - totalinput = totalinput + flux_avail + totalinput = totalinput + flux_avail_rum + flux_avail_mg counter = 0 if (col_grass == c) call endrun('Something wrong with the indices') @@ -857,30 +857,58 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & tempr_ave = temperature_inst%t_ref2m_patch(col%patchi(c)) windspeed_ave = frictionvel_inst%u10_patch(col%patchi(c)) - man_n_barns(c) = flux_avail + man_n_barns(c) = flux_avail_rum + flux_avail_mg + - call eval_fluxes_storage(flux_avail, tempr_ave, windspeed_ave, 0.0_r8, & - volat_coef_barns, volat_coef_stores, tan_fract_excr, fluxes_nitr, fluxes_tan, status) - if (any(fluxes_nitr > 1e12)) then - write(iulog, *) 'bad fluxes', fluxes_nitr + ! Evaluate the NH3 losses, separate for ruminants (open barns) and others + ! (poultry and pigs, closed barns). Note the slicing of fluxes(:,:) and fluxes_tan(:,:). + man_n_transf(c) = flux_grazing + nh3_flux_stores(c) = 0.0 + + if (flux_avail_rum < 0) then + write(iulog, *) 'flux:', flux_avail_rum + call endrun(msg='negat flux_avail for ruminants') end if + + ! Ruminants + call eval_fluxes_storage(flux_avail_rum, 'open', tempr_ave, windspeed_ave, 0.0_r8, & + volat_coef_barns_open, volat_coef_stores, tan_fract_excr, fluxes_nitr(:,1), fluxes_tan(:,1), status) + if (status /=0) then + write(iulog, *) 'status = ', status + call endrun(msg='eval_fluxes_storage failed for ruminants') + end if + + ! Others + call eval_fluxes_storage(flux_avail_mg, 'closed', tempr_ave, windspeed_ave, 0.0_r8, & + volat_coef_barns_closed, volat_coef_stores, tan_fract_excr, fluxes_nitr(:,2), fluxes_tan(:,2), status) if (status /=0) then write(iulog, *) 'status = ', status - call endrun(msg='eval_fluxes_storage failed') + call endrun(msg='eval_fluxes_storage failed for other livestock') end if cumflux = cumflux + sum(fluxes_nitr) - - if (fluxes_tan(iflx_to_store) < 0) then - call endrun(msg="ERROR too much manure lost") + if (any(isnan(fluxes_nitr))) then + write(iulog, *) 'fluxes 1', fluxes_nitr(:,1) + write(iulog, *) 'fluxes 2', fluxes_nitr(:,2) + call endrun('Nan in fluxes_nitr') + end if + if (any(isnan(fluxes_tan))) then + write(iulog, *) 'fluxes 1', fluxes_tan(:,1) + write(iulog, *) 'fluxes 2', fluxes_tan(:,2) + call endrun('Nan in fluxes_tan') end if - flux_grass_spread = flux_grass_spread + fluxes_nitr(iflx_to_store)*col%wtgcell(c) - flux_grass_spread_tan = flux_grass_spread_tan + fluxes_tan(iflx_to_store)*col%wtgcell(c) - - man_n_transf(c) = flux_grazing + fluxes_nitr(iflx_to_store) + if (fluxes_tan(iflx_to_store,1) < 0) then + call endrun(msg="ERROR too much manure lost") + end if + ! Simplification as of 2019: no explicit manure storage. Flux to storage + ! will be spread "immediately". + total_to_store = sum(fluxes_nitr(iflx_to_store,:)) + flux_grass_spread = flux_grass_spread + total_to_store*col%wtgcell(c) + flux_grass_spread_tan = flux_grass_spread_tan + sum(fluxes_tan(iflx_to_store,:))*col%wtgcell(c) + man_n_transf(c) = man_n_transf(c) + total_to_store - nh3_flux_stores(c) = fluxes_nitr(iflx_air_stores) - nh3_flux_barns(c) = fluxes_nitr(iflx_air_barns) + nh3_flux_stores(c) = sum(fluxes_nitr(iflx_air_stores,:)) + nh3_flux_barns(c) = sum(fluxes_nitr(iflx_air_barns,:)) end do ! column end if ! crop land unit diff --git a/src/biogeochem/FanMod.F90 b/src/biogeochem/FanMod.F90 index e7c3e49b42..8c6d610397 100755 --- a/src/biogeochem/FanMod.F90 +++ b/src/biogeochem/FanMod.F90 @@ -49,7 +49,7 @@ module FanMod real(r8), parameter, public :: soildepth_reservoir = 0.04_r8 integer, parameter, public :: err_bad_theta = 1, err_negative_tan = 2, err_negative_flux = 3, & - err_balance_tan = 4, err_balance_nitr = 5, err_nan = 6, err_bad_subst = 7 + err_balance_tan = 4, err_balance_nitr = 5, err_nan = 6, err_bad_subst = 7, err_bad_type = 8 integer, parameter, public :: subst_tan = 1, subst_urea = 2 @@ -907,7 +907,7 @@ function eval_perc(waterloss, evap, precip, watertend, dt) result(rate) end function eval_perc - subroutine eval_fluxes_storage(nitr_input, tempr_outside, windspeed, fract_direct, & + subroutine eval_fluxes_storage(nitr_input, barntype, tempr_outside, windspeed, fract_direct, & volat_coef_barns, volat_coef_stores, & tan_fract_excr, fluxes_nitr, fluxes_tan, status) ! @@ -918,6 +918,7 @@ subroutine eval_fluxes_storage(nitr_input, tempr_outside, windspeed, fract_direc ! implicit none real(r8), intent(in) :: nitr_input ! total nitrogen excreted by animals in housings + character(len=*), intent(in) :: barntype ! "closed" (pigs, poultry) or "open" (others) real(r8), intent(in) :: tempr_outside ! K real(r8), intent(in) :: windspeed ! m/s real(r8), intent(in) :: fract_direct ! fraction of manure N applied before storage @@ -929,13 +930,16 @@ subroutine eval_fluxes_storage(nitr_input, tempr_outside, windspeed, fract_direc integer, intent(out) :: status ! see top of the module. ! parameters for the Gyldenkaerne et al. parameterization - real(r8), parameter :: Tfloor_barns = 4.0_8, Tfloor_stores = 1.0_8 - real(r8), parameter :: Tmin_barns = 0_8 - real(r8), parameter :: Tmax_barns = 12.5_8 - real(r8), parameter :: tempr_D = 3.0 - real(r8), parameter :: Vmin_barns = 0.2_8 - real(r8), parameter :: Vmax_barns = 0.228_8 - real(r8), parameter :: pA = 0.89_8, pB = 0.26_8 + real(r8), parameter :: Tfloor_barns = 4.0_r8, Tfloor_stores = 1.0_r8 + real(r8), parameter :: Tmin_barns = 0.01_r8 + real(r8), parameter :: Tmax_barns = 12.5_r8 + real(r8), parameter :: tempr_D = 3.0_r8 + real(r8), parameter :: Trec = 21.0_r8 + real(r8), parameter :: Vmin_barns = 0.2_r8 + !real(r8), parameter :: Vmax_barns = 0.228_r8 + real(r8), parameter :: pA = 0.89_r8, pB = 0.26_r8 + real(r8), parameter :: DTlow = 0.5_r8, DThigh = 1.0_r8 + real(r8) :: Vmax_barns ! depends on barntype real(r8) :: flux_avail, flux_avail_tan, tempr_stores, tempr_barns, vent_barns, flux_direct, flux_direct_tan, & & flux_barn, flux_store, tempr_C @@ -943,8 +947,27 @@ subroutine eval_fluxes_storage(nitr_input, tempr_outside, windspeed, fract_direc fluxes_nitr = 0.0_r8 fluxes_tan = 0.0_r8 tempr_C = tempr_outside - 273 - - tempr_barns = max(tempr_C+tempr_D, Tfloor_barns) + + select case(barntype) + case ('open') + Vmax_barns = 0.228_r8 + tempr_barns = max(tempr_C+tempr_D, Tfloor_barns) + case ('closed') + Vmax_barns = 0.40_r8 + if (Trec + DTlow * (tempr_C - Tmin_barns) < Tmin_barns) then + tempr_barns = Tmin_barns + else if (tempr_C < Tmin_barns) then + tempr_barns = Trec + DTlow * (tempr_C - Tmin_barns) + else if (tempr_C > Tmax_barns) then + tempr_barns = Trec + DThigh * (tempr_C - Tmax_barns) + else + tempr_barns = Trec + end if + case default + status = err_bad_type + return + end select + if (tempr_C < Tmin_barns) then vent_barns = Vmin_barns else if (tempr_C > Tmax_barns) then @@ -957,12 +980,12 @@ subroutine eval_fluxes_storage(nitr_input, tempr_outside, windspeed, fract_direc flux_avail_tan = nitr_input * tan_fract_excr if (flux_avail < -1e-15 .or. flux_avail_tan < -1e-15) then - status = err_negative_flux + status = err_negative_flux*1000 return end if flux_barn = flux_avail_tan * volat_coef_barns * tempr_barns**pA * vent_barns**pB - + flux_barn = min(flux_avail_tan, flux_barn) ! hopefully uncommon fluxes_tan(iflx_air_barns) = flux_barn fluxes_nitr(iflx_air_barns) = flux_barn @@ -970,7 +993,8 @@ subroutine eval_fluxes_storage(nitr_input, tempr_outside, windspeed, fract_direc flux_avail_tan = flux_avail_tan - flux_barn if (flux_avail < 0 .or. flux_avail_tan < 0) then - status = err_negative_flux + !print *, flux_avail_tan, flux_avail, flux_barn, tempr_barns, vent_barns, tempr_C + status = err_negative_flux*10000 return end if @@ -993,7 +1017,7 @@ subroutine eval_fluxes_storage(nitr_input, tempr_outside, windspeed, fract_direc flux_avail = flux_avail - flux_store flux_avail_tan = flux_avail_tan - flux_store if (flux_avail < 0) then - status = err_negative_flux + status = err_negative_flux*10 return end if @@ -1011,7 +1035,7 @@ subroutine eval_fluxes_storage(nitr_input, tempr_outside, windspeed, fract_direc end if if (any(fluxes_nitr < 0) .or. any(fluxes_tan < 0)) then - status = err_negative_flux + status = err_negative_flux*100 return end if @@ -1140,7 +1164,7 @@ subroutine get_storage_fluxes_tan_ar(manure_excr, tempr_outside, windspeed, frac real(r8) :: fluxes_nitr(4), fluxes_tan(4) do ii = 1, nn - call eval_fluxes_storage(manure_excr(ii), tempr_outside(ii), windspeed(ii), fract_direct(ii), & + call eval_fluxes_storage(manure_excr(ii), 'open', tempr_outside(ii), windspeed(ii), fract_direct(ii), & & volat_coef_barns, volat_coef_stores, tan_fract_excr, & & fluxes_nitr, fluxes_tan, status) From 807c639179b4a059ed13ab1d302f45cdce206e12 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 13 Mar 2019 12:24:40 -0600 Subject: [PATCH 065/181] slurry infiltration without precip + slurry diffusivity --- src/biogeochem/FanMod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/biogeochem/FanMod.F90 b/src/biogeochem/FanMod.F90 index 8c6d610397..06c49e2c92 100755 --- a/src/biogeochem/FanMod.F90 +++ b/src/biogeochem/FanMod.F90 @@ -294,7 +294,8 @@ subroutine eval_fluxes_slurry(water, mtan, Hconc, tg, ratm, theta, thetasat, per fluxes(iflx_soilq) = cnc * perc - diffusivity_water = 9.8e-10_r8 * 1.03_r8 ** (tg - 273.0_r8) + !diffusivity_water = 9.8e-10_r8 * 1.03_r8 ** (tg - 273.0_r8) + diffusivity_water = eval_diffusivity_liq_mq(1.0_r8, 1.0_r8, tg) diffusivity_satsoil = eval_diffusivity_liq_mq(thetasat, thetasat, tg) * thetasat !diffusivity_satsoil = eval_diffusivity_liq_m03(thetasat, thetasat, tg, bsw) * thetasat @@ -587,7 +588,8 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend ! Pool S0 ! evap_slurry = get_evap_pool(tg, ratm, qbot) - infiltr_slurry = max(depth_slurry / poolranges(1), precip) + !infiltr_slurry = max(depth_slurry / poolranges(1), precip) + infiltr_slurry = depth_slurry / poolranges(1) infiltrated = depth_slurry * infiltr_slurry / (infiltr_slurry + evap_slurry) ! Slurry water (in addition to soil water, theta) on surface and in soil. Represents ! mean over pool S0. From 108a0a7c4f8cdf73782e05ab2d78f36e6adf40f4 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Thu, 21 Mar 2019 17:20:08 -0600 Subject: [PATCH 066/181] van der molen liq diffusion + kads = 1 --- src/biogeochem/FanMod.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/biogeochem/FanMod.F90 b/src/biogeochem/FanMod.F90 index 06c49e2c92..5acaeda6d8 100755 --- a/src/biogeochem/FanMod.F90 +++ b/src/biogeochem/FanMod.F90 @@ -111,10 +111,10 @@ function eval_diffusivity_liq_mq(theta, thetasat, tg) result(diff) ! Base rate by Nernst-Haskell equation, see Poling et al., 2000. The Properties of ! Gases and Liquids. - kaq_base = 1e-4 * (gascnst*tg / (2*faraday**2)) / (1/lp + 1/lm) + !kaq_base = 1e-4 * (gascnst*tg / (2*faraday**2)) / (1/lp + 1/lm) ! Van Der Molen 1990 fit of the base rate. - !kaq_base = 9.8e-10_r8 * 1.03_r8 ** (Tg-273.0_r8) + kaq_base = 9.8e-10_r8 * 1.03_r8 ** (Tg-273.0_r8) diff = kaq_base * (theta**pw) / (thetasat**2) @@ -573,7 +573,7 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend integer :: indpl real(r8), parameter :: dz_layer = 0.02 ! thickness of the volatilization layer, m - real(r8), parameter :: kads = 0.0_r8 ! distriution coefficient kads = [TAN (s)] / [TAN (aq)], dimensionless + real(r8), parameter :: kads = 1.0_r8 ! distriution coefficient kads = [TAN (s)] / [TAN (aq)], dimensionless ! H+ concentration in each pool !real(r8), parameter :: Hconc(4) = (/10.0_r8**(-8.0_r8), 10.0_r8**(-8.0_r8), 10.0_r8**(-8.0_r8), 10.0_r8**(-7_r8)/) @@ -697,7 +697,7 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend integer :: indpl real(r8), parameter :: water_relax_t = 24*3600.0_r8 - real(r8), parameter :: kads = 0.0_r8 + real(r8), parameter :: kads = 1.0_r8 logical :: fixed tanpools_old = tanpools From 00d92f42fda1c36a99d5b35c404eccc95f8eec93 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 3 Apr 2019 16:11:04 -0600 Subject: [PATCH 067/181] kelvin to c --- src/biogeochem/FanMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/biogeochem/FanMod.F90 b/src/biogeochem/FanMod.F90 index 5acaeda6d8..cc14cea72d 100755 --- a/src/biogeochem/FanMod.F90 +++ b/src/biogeochem/FanMod.F90 @@ -114,7 +114,7 @@ function eval_diffusivity_liq_mq(theta, thetasat, tg) result(diff) !kaq_base = 1e-4 * (gascnst*tg / (2*faraday**2)) / (1/lp + 1/lm) ! Van Der Molen 1990 fit of the base rate. - kaq_base = 9.8e-10_r8 * 1.03_r8 ** (Tg-273.0_r8) + kaq_base = 9.8e-10_r8 * 1.03_r8 ** (Tg-273.14_r8) diff = kaq_base * (theta**pw) / (thetasat**2) From 5c359a3cfeb1d260bbe7662da87caa53d272ccca Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Mon, 6 May 2019 15:16:43 -0600 Subject: [PATCH 068/181] more careful checking for column gridcell weight --- src/biogeochem/CNNDynamicsMod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index ce1f6b4434..c1badf3fd6 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -790,9 +790,10 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & col_grass = ispval do il = 1, max_lunit l = grc%landunit_indices(il, g) + if (l == ispval) cycle if (lun%itype(l) == istsoil) then do p = lun%patchi(l), lun%patchf(l) - if (patch%itype(p) == nc4_grass .or. patch%itype(p) == nc3_nonarctic_grass) then + if ((patch%itype(p) == nc4_grass .or. patch%itype(p) == nc3_nonarctic_grass) .and. col%wtgcell(patch%column(p)) > 1e-6) then col_grass = patch%column(p) exit end if @@ -800,7 +801,7 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & end if if (col_grass /= ispval) exit end do - if (col%wtgcell(col_grass) < 1e-6) col_grass = ispval + !if (col%wtgcell(col_grass) < 1e-6) col_grass = ispval ! Transfer of manure from all crop columns to the natural vegetation column: flux_grass_graze = 0_r8 flux_grass_spread = 0_r8 @@ -869,6 +870,7 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & write(iulog, *) 'flux:', flux_avail_rum call endrun(msg='negat flux_avail for ruminants') end if + windspeed_ave = max(windspeed_ave, 1e-2) ! Ruminants call eval_fluxes_storage(flux_avail_rum, 'open', tempr_ave, windspeed_ave, 0.0_r8, & From fc1250fc6dc07e5c9dd4a02acbe8994ad0444c19 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Mon, 6 May 2019 15:18:11 -0600 Subject: [PATCH 069/181] more consistent treatment of slurry resistances --- src/biogeochem/FanMod.F90 | 40 +++++++++++++++++++++++++++++++-------- 1 file changed, 32 insertions(+), 8 deletions(-) diff --git a/src/biogeochem/FanMod.F90 b/src/biogeochem/FanMod.F90 index cc14cea72d..9be86de86a 100755 --- a/src/biogeochem/FanMod.F90 +++ b/src/biogeochem/FanMod.F90 @@ -1,3 +1,21 @@ +! RUN: R12 + +! EXPERIMENTS INCLUDED + +! X0 +! Type: all +! Parameter: nan +! Value: nan +! Comment: Control run with GSWP3 +! Files: nan + +! X12 +! Type: manure +! Parameter: slurry layer +! Value: debugged +! Comment: nan +! Files: FanMod + module FanMod #ifdef _PYMOD_ use qsatmod @@ -280,13 +298,13 @@ subroutine eval_fluxes_slurry(water, mtan, Hconc, tg, ratm, theta, thetasat, per real(r8) :: water_tot, cnc, air, depth_soilsat, diffusivity_water, diffusivity_satsoil, halfwater, insoil, r1, dz2, inwater real(r8) :: r2, volat_rate, kno3, knh3, depth_lower, fract_nh4, r2a, r2b, g3, gdown, rsld, rkl, rkg + real(r8) :: rsl, rssup, rssdn - water_tot = water(1) + water(2) - - air = thetasat - theta + air = max(thetasat - theta, 0.001) ! depth of the saturated soil layer below the surface pool - depth_soilsat = water(2) / air + depth_soilsat = water(2) / air + water_tot = water(1) + thetasat*depth_soilsat cnc = mtan / water_tot @@ -316,6 +334,10 @@ subroutine eval_fluxes_slurry(water, mtan, Hconc, tg, ratm, theta, thetasat, per r1 = inwater / diffusivity_water + insoil /diffusivity_satsoil + rsl = min(halfwater, water(1)) / diffusivity_water + rssup = max(halfwater - water(1), 0.0_r8) / (thetasat * diffusivity_satsoil) + r1 = rsl + rssup + depth_lower = max(soildepth_reservoir, depth_soilsat*1.5) call partition_tan(tg, Hconc, 1.0_r8, 0.0_r8, 0.0_r8, knh3, fract_nh4=fract_nh4) @@ -327,13 +349,15 @@ subroutine eval_fluxes_slurry(water, mtan, Hconc, tg, ratm, theta, thetasat, per ! lower soil resistance consists of liquid diffusion slurry, in saturated layer, and ! parallel liquid/gas diffusion below the saturated layer. - r2a = (water(1)-inwater) / diffusivity_water - r2b = (depth_soilsat-insoil) / diffusivity_satsoil + + r2a = 0.0 + rssdn = halfwater / (thetasat * diffusivity_satsoil) + dz2 = depth_lower-depth_soilsat Rkl = dz2 / (eval_diffusivity_liq_mq(theta, thetasat, tg)*theta) Rkg = dz2 / (eval_diffusivity_gas_mq(theta, thetasat, tg)*(thetasat-theta)) - Rsld = r2a + r2b + Rsld = r2a + rssdn gdown = -(Rkg + Rkl*knh3)/((Rkg*(Rkl + Rsld) + Rkl*Rsld*knh3)*(kads*(theta - 1) - thetasat)) @@ -347,7 +371,7 @@ subroutine eval_fluxes_slurry(water, mtan, Hconc, tg, ratm, theta, thetasat, per ! nitrification kno3 = eval_no3prod_v2(thetasat, thetasat, tg) - fluxes(iflx_no3) = kno3 * mtan * fract_nh4 + fluxes(iflx_no3) = kno3 * mtan! * fract_nh4 !fluxes(3:) = 0 From 7c56648a73c83ce094da15c810f9447a8bb169cc Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Thu, 4 Jul 2019 17:21:42 -0400 Subject: [PATCH 070/181] remove printf and other cleanup --- src/biogeochem/Fan2CTSMMod.F90 | 19 +++++-------------- 1 file changed, 5 insertions(+), 14 deletions(-) diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index 7d32e0aee5..44f94832a3 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -153,11 +153,6 @@ subroutine fan_readnml(NLFilename) if (fract_spread_grass > 1 .or. fract_spread_grass < 0) then call endrun(msg="ERROR invalid fract_spread_grass") end if - - - !call mpi_bcast(fan_to_bgc_crop, 1, MPI_LOGICAL, 0, mpicom, ierr) - !call mpi_bcast(fan_to_bgc_veg, 1, MPI_LOGICAL, 0, mpicom, ierr) - !call mpi_bcast(use_fan, 1, MPI_LOGICAL, 0, mpicom, ierr) end subroutine fan_readnml @@ -937,6 +932,7 @@ end subroutine handle_storage_v2 !************************************************************************************ subroutine update_summary(ns, nf, filter_soilc, num_soilc) + ! Collect FAN fluxes and pools into aggregates used by the NitrogenBalanceCheck. use ColumnType, only : col use LandunitType , only: lun use landunit_varcon, only : istcrop @@ -962,23 +958,18 @@ subroutine update_summary(ns, nf, filter_soilc, num_soilc) if (lun%itype(col%landunit(c)) == istcrop) then ! no grazing, man_n_appl is from the same column and not counted as input fluxin = nf%man_n_mix_col(c) + nf%fert_n_appl_col(c) - print *, 'crop', fc, fluxin else ! no barns or fertilization. man_n_appl is transferred from crop columns and not ! included in the other inputs. fluxin = nf%man_n_grz_col(c) + nf%man_n_appl_col(c) - print *, 'veg', fc, fluxin end if flux_loss = nf%nh3_man_app_col(c) + nf%nh3_grz_col(c) + nf%manure_runoff_col(c) & + nf%nh3_stores_col(c) + nf%nh3_barns_col(c) & + nf%nh3_fert_col(c) + nf%fert_runoff_col(c) - print *, 'flux_loss', flux_loss fluxout = nf%fert_no3_prod_col(c) + nf%fert_nh4_to_soil_col(c) & + nf%manure_no3_prod_col(c) + nf%manure_nh4_to_soil_col(c) & + nf%man_n_transf_col(c) + flux_loss - print *, 'flux_out', fluxout - print *, 'transf', nf%man_n_transf_col(c) nf%fan_totnin_col(c) = fluxin nf%fan_totnout_col(c) = fluxout @@ -999,19 +990,19 @@ subroutine fan_to_sminn(filter_soilc, num_soilc, sbgc_nf) type(soilbiogeochem_nitrogenflux_type), intent(inout) :: sbgc_nf integer :: c, fc - real(r8) :: fan_nitr + real(r8) :: fan_nflux if (.not. (fan_to_bgc_veg .or. fan_to_bgc_crop)) return do fc = 1, num_soilc c = filter_soilc(fc) - fan_nitr & + fan_nflux & = sbgc_nf%fert_no3_prod_col(c) + sbgc_nf%fert_nh4_to_soil_col(c) & + sbgc_nf%manure_no3_prod_col(c) + sbgc_nf%manure_nh4_to_soil_col(c) if (lun%itype(col%landunit(c)) == istcrop .and. fan_to_bgc_crop) then - sbgc_nf%fert_to_sminn_col(c) = fan_nitr + sbgc_nf%fert_to_sminn_col(c) = fan_nflux else if (lun%itype(col%landunit(c)) == istsoil .and. fan_to_bgc_veg) then - sbgc_nf%fert_to_sminn_col(c) = fan_nitr + sbgc_nf%fert_to_sminn_col(c) = fan_nflux end if end do From e7dda27e93ce96bbe8f615b029f2f6266af3dc52 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Thu, 4 Jul 2019 17:22:21 -0400 Subject: [PATCH 071/181] debug previous merge + use more debug_fan for checkings --- src/biogeochem/FanMod.F90 | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/src/biogeochem/FanMod.F90 b/src/biogeochem/FanMod.F90 index bc4db02dc5..6a676133e6 100755 --- a/src/biogeochem/FanMod.F90 +++ b/src/biogeochem/FanMod.F90 @@ -138,7 +138,7 @@ function eval_diffusivity_liq_mq(theta, thetasat, tg) result(diff) !kaq_base = 1e-4 * (gascnst*tg / (2*faraday**2)) / (1/lp + 1/lm) ! Van Der Molen 1990 fit of the base rate. - kaq_base = 9.8e-10_r8 * 1.03_r8 ** (Tg-273.14_r8) + kaq_base = 9.8e-10_r8 * 1.03_r8 ** (Tg-SHR_CONST_TKFRZ) diff = kaq_base * (theta**pw) / (thetasat**2) @@ -341,10 +341,8 @@ subroutine eval_fluxes_slurry(water_surf, water_subsurf, mtan, Hconc, tg, ratm, !r1 = halfwater / diffusivity_water end if - r1 = inwater / diffusivity_water + insoil /diffusivity_satsoil - - rsl = min(halfwater, water(1)) / diffusivity_water - rssup = max(halfwater - water(1), 0.0_r8) / (thetasat * diffusivity_satsoil) + rsl = min(halfwater, water_surf) / diffusivity_water + rssup = max(halfwater - water_surf, 0.0_r8) / (thetasat * diffusivity_satsoil) r1 = rsl + rssup depth_lower = max(soildepth_reservoir, depth_soilsat*1.5) @@ -644,7 +642,7 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend call update_pools(tanpools(1:1), fluxes(1:5,1:1), dt, 1, 5) - if (any(tanpools < -1e-15)) then + if (debug_fan .and. any(tanpools < -1e-15)) then status = err_negative_tan return end if @@ -676,7 +674,7 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend call update_pools(tanpools(2:4), fluxes(1:5,2:4), dt, 3, 5) - if (any(tanpools < -1e-15)) then + if (debug_fan .and. any(tanpools < -1e-15)) then !if (any(tanpools < -1e-3)) then status = err_negative_tan * 10 return @@ -789,10 +787,12 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend end if end if - imbalance = abs((sum(tanpools) - sum(tanpools_old)) - ((tandep_remaining)*dt+garbage)) - if (imbalance > max(1e-14, 0.001*sum(tanpools_old))) then - status = err_balance_tan*10 - return + if (debug_fan) then + imbalance = abs((sum(tanpools) - sum(tanpools_old)) - ((tandep_remaining)*dt+garbage)) + if (imbalance > max(1e-14, 0.001*sum(tanpools_old))) then + status = err_balance_tan*10 + return + end if end if age_prev = 0 ! for water evaluations, consider beginning of S1 as the starting point @@ -819,12 +819,12 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend return end if - if (any(tanpools < -1e-15)) then - status = err_negative_tan + 1000 - return - end if - if (debug_fan) then + if (any(tanpools < -1e-15)) then + status = err_negative_tan + 1000 + return + end if + if (any(isnan(fluxes))) then status = err_nan + 1000 end if From b06931e9360a742c48021a5ced2e5ca88d29dea0 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Sat, 6 Jul 2019 11:12:04 -0400 Subject: [PATCH 072/181] Add help for the -fan options --- bld/CLMBuildNamelist.pm | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index e3a85374db..621b010534 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -158,6 +158,11 @@ OPTIONS -dynamic_vegetation Toggle for dynamic vegetation model. (default is off) (can ONLY be turned on when BGC type is 'cn' or 'bgc') This turns on the namelist variable: use_cndv + -fan "mode" Set how and if FAN is run: atm|soil|full|on|off + If "on", FAN is enabled but not connected to atmosphere or + soil biogeochemistry. If "full", both connections are + active. The soil and atmosphere coupling can be enabled + selectively with the "soil" and "atm" modes. -fire_emis Produce a fire_emis_nl namelist that will go into the "drv_flds_in" file for the driver to pass fire emissions to the atm. (Note: buildnml copies the file for use by the driver) @@ -2869,17 +2874,15 @@ sub setup_logic_fan { # my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_; my $fan_mode = $opts->{'fan'}; - print "FAN MODE: $fan_mode\n"; + if ($fan_mode eq 'default') { $fan_mode = 'off'; } if (!($fan_mode =~ /atm|soil|full|on|off/)) { $log->fatal_error("fan_mode not one of atm, soil, full, on, off\n" ); } - #print "USE_FAN 1:", $nl->get_value('use_fan'); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_fan', 'fan_mode'=>$fan_mode ); - print "USE_FAN 2:", $nl->get_value('use_fan'); $nl_flags->{'use_fan'} = $nl->get_value('use_fan'); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fan_nh3_to_atm', @@ -2887,29 +2890,23 @@ sub setup_logic_fan { $nl_flags->{'fan_nh3_to_atm'} = $nl->get_value('fan_nh3_to_atm'); if ( !($fan_mode eq 'off') ) { - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fan_mapalgo'); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_first_fan', 'sim_year'=>$nl_flags->{'sim_year'}, 'sim_year_range'=>$nl_flags->{'sim_year_range'}); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_last_fan', 'sim_year'=>$nl_flags->{'sim_year'}, 'sim_year_range'=>$nl_flags->{'sim_year_range'}); - - # Set align year, if first and last years are different + # Set align year, if first and last years are different if ( $nl->get_value('stream_year_first_fan') != $nl->get_value('stream_year_last_fan') ) { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'model_year_align_fan', 'sim_year'=>$nl_flags->{'sim_year'}, 'sim_year_range'=>$nl_flags->{'sim_year_range'}); } - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_fldfilename_fan'); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fan_to_bgc_crop', 'fan_mode'=>$fan_mode); - #$nl_flags->{'fan_to_bgc_crop'} = $nl->get_value('fan_to_bgc_crop'); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fan_to_bgc_veg', 'fan_mode'=>$fan_mode); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fract_spread_grass', 'fan_mode'=>$fan_mode); - - } if ( &value_is_true( $nl_flags->{'use_ed'} ) && &value_is_true( $nl_flags->{'use_fan'} ) ) { From 35bbe00f90e21d4318a3fb0c9c78f5e4b856d1cc Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Sat, 6 Jul 2019 11:12:20 -0400 Subject: [PATCH 073/181] code cleanup --- src/biogeochem/Fan2CTSMMod.F90 | 12 +----------- src/biogeochem/FanMod.F90 | 21 ++++++--------------- 2 files changed, 7 insertions(+), 26 deletions(-) diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index 44f94832a3..f8dfd91c34 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -247,9 +247,6 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & cnv_nf%fert_patch(bounds%begp:bounds%endp), & nf%fert_n_appl_col(bounds%begc:bounds%endc)) - !call p2c(bounds, num_soilc, filter_soilc, & - ! cnv_nf%manu_patch(bounds%begp:bounds%endp), & - ! nf%man_n_appl_col(bounds%begc:bounds%endc)) nf%man_n_appl_col(bounds%begc:bounds%endc) = 0.0_r8 if (do_balance_checks) then @@ -350,6 +347,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & exit end do if (p == col%patchf(c) + 1) then + call endrun(msg='Could not find any useful pft for ram1') ! Nothing found. We shouldn't be here. ratm = 150.0_r8 end if @@ -494,7 +492,6 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & ! Fertilizer ! - fert_total = nf%fert_n_appl_col(c) fract_urea = atm2lnd_inst%forc_ndep_urea_grc(g) @@ -601,14 +598,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & write(iulog, *) 'SoilPH check:', soilph_min, soilph_max, def_ph_count end if - !old = ns%fan_totn_col(filter_soilc(1:num_soilc)) call update_summary(ns, nf, filter_soilc, num_soilc) - - !call debug_balance(ns, nf, old, filter_soilc(1:num_soilc)) - - !do fc = 1, num_soilc - ! call debug_balance(ns, nf, old, (/fc/)) - !end do end associate diff --git a/src/biogeochem/FanMod.F90 b/src/biogeochem/FanMod.F90 index 6a676133e6..722481cbd9 100755 --- a/src/biogeochem/FanMod.F90 +++ b/src/biogeochem/FanMod.F90 @@ -15,6 +15,7 @@ module FanMod ! #ifdef _PYMOD_ + ! This cpp flag is inteded for compiling FAN into a python module with f2py. use qsatmod #else use shr_const_mod @@ -22,14 +23,11 @@ module FanMod use QSatMod , only : QSat #endif implicit none - -#ifdef _REALPR_ - integer, parameter :: r8 = 8 -#endif #ifdef _PYMOD_ public ! Define physical constants here to avoid dependency on CESM. + integer, parameter :: r8 = 8 real(r8), parameter :: SHR_CONST_BOLTZ = 1.38065e-23 real(r8), parameter :: SHR_CONST_AVOGAD = 6.02214e26 ! molecules per kmole real(r8), parameter :: SHR_CONST_RGAS = SHR_CONST_AVOGAD*SHR_CONST_BOLTZ ! universal gas constant in J kmole-1 K-1 @@ -38,7 +36,6 @@ module FanMod real(r8), parameter :: SHR_CONST_PSTD = 101325.0_R8 ! standard pressure ~ pascals real(r8), parameter :: SHR_CONST_TKFRZ = 273.15_R8 ! freezing T of fresh water ~ K real(r8), parameter :: SHR_CONST_MWDAIR = 28.966_R8 ! molecular weight dry air ~ kg/kmole - #else private public update_org_n @@ -73,7 +70,7 @@ module FanMod real(r8), parameter, public :: water_relax_t = 24*3600.0_r8 - logical, parameter, public :: debug_fan = .true. + logical, parameter, public :: debug_fan = .false. contains @@ -243,9 +240,6 @@ subroutine partition_tan(tg, Hconc, theta, air, kads, KNH3, fract_nh4) fract_aq = theta / (air*KNH3 + theta + kads*(1.0_r8-theta-air)) if (present(fract_nh4)) fract_nh4 = fract_aq * Hconc / (KNH4 + Hconc) - - !if (present(fract_nh3g)) fract_nh3g = air * KNH3 / (air*KNH3 + theta) - !if (present(fract_nh3aq)) fract_nh3aq = fract_aq * (1.0_r8 - Hconc / (KNH4 + Hconc)) end subroutine partition_tan @@ -257,7 +251,6 @@ real(r8) function eval_no3prod_v2(theta, theta_sat, Tg) result(kNO3) real(r8) :: stf, wmr, smrf, mNH4, soil_dens - !real(r8), parameter :: soil_dens = 1400.0_r8 ! Soil density, kg/m3 real(r8), parameter :: water_dens = SHR_CONST_RHOFW real(r8), parameter :: rmax = 1.16e-6_r8 ! Maximum rate of nitrification, s-1 real(r8), parameter :: tmax = 313.0 ! Maximm temperature of microbial activity, K @@ -351,7 +344,6 @@ subroutine eval_fluxes_slurry(water_surf, water_subsurf, mtan, Hconc, tg, ratm, volat_rate = & knh3/(-ratm*kads*theta + ratm*kads + ratm*thetasat - r1*kads*knh3*theta + r1*kads*knh3 + r1*knh3*thetasat) - !volat_rate = 1.0_r8 / (r1 + ratm / knh3) ! conductance from aqueous TAN in slurry to NH3 in atmosphere fluxes(iflx_air) = volat_rate*cnc ! lower soil resistance consists of liquid diffusion slurry, in saturated layer, and @@ -402,7 +394,8 @@ subroutine eval_fluxes_soilroff_ads(mtan, water_manure, Hconc, tg, ratm, theta, real(r8) :: cnc_srfg, cnc_srfaq, cnc_soilaq, cnc_soilg, dz, rsl, rsg real(r8) :: fract_gas, fract_nh3aq, fract_nh4, fract_aq, volatility - real(r8) :: kads ! distribution coefficient, unitless ((g NH4 adsorbed / m3 soil solid) / (g NH4 dissolved / m3 soil water)) + ! distribution coefficient, unitless ((g NH4 adsorbed / m3 soil solid) / (g NH4 dissolved / m3 soil water)) + real(r8) :: kads water_tot = water_manure + theta*soildepth if (water_tot < 1e-9) then @@ -675,10 +668,8 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend call update_pools(tanpools(2:4), fluxes(1:5,2:4), dt, 3, 5) if (debug_fan .and. any(tanpools < -1e-15)) then - !if (any(tanpools < -1e-3)) then status = err_negative_tan * 10 return - !end if end if if (debug_fan) then @@ -688,7 +679,7 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend end if if (abs(sum(tanpools - tanpools_old) - (-sum(fluxes) + tandep + tanprod)*dt + garbage) & - > max(sum(tanpools_old)*1e-2, 1e-4)) then + > max(sum(tanpools_old)*1e-2, 1e-4)) then status = err_balance_tan return end if From 090ec9c0eaedc201136fc3c9abd02bd12f5fc566 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Tue, 9 Jul 2019 16:01:46 -0600 Subject: [PATCH 074/181] debug declaration order + make water_relax_t an argument for the waterfunction --- src/biogeochem/FanMod.F90 | 53 ++++++++++++++++++++------------------- 1 file changed, 27 insertions(+), 26 deletions(-) diff --git a/src/biogeochem/FanMod.F90 b/src/biogeochem/FanMod.F90 index d642883552..fa891eeeec 100755 --- a/src/biogeochem/FanMod.F90 +++ b/src/biogeochem/FanMod.F90 @@ -68,7 +68,7 @@ module FanMod integer, parameter, public :: subst_tan = 1, subst_urea = 2 - real(r8), parameter, public :: water_relax_t = 24*3600.0_r8 + !real(r8), parameter, public :: water_relax_t = 24*3600.0_r8 logical, parameter, public :: debug_fan = .false. @@ -287,7 +287,6 @@ subroutine eval_fluxes_slurry(water_surf, water_subsurf, mtan, Hconc, tg, ratm, real(r8), intent(in) :: water_surf ! water (slurry) on surface, m real(r8), intent(in) :: water_subsurf ! water (slurry) below surface in addition to water already in soil, m real(r8), intent(in) :: mtan ! TAN, mass units / m2, surface + subsurface - real(r8), intent(out) :: fluxes(fluxes_size) ! TAN fluxes, see top of the module real(r8), intent(in) :: Hconc ! H+ concentration, -log10(pH) real(r8), intent(in) :: tg ! soil temperature, K real(r8), intent(in) :: ratm ! atmospheric resistance, s/m @@ -298,6 +297,8 @@ subroutine eval_fluxes_slurry(water_surf, water_subsurf, mtan, Hconc, tg, ratm, real(r8), intent(in) :: bsw real(r8), intent(in) :: kads ! dimensionless distribution coefficient, kads = [TAN (s)] / [TAN (aq)] integer, intent(in) :: fluxes_size + real(r8), intent(out) :: fluxes(fluxes_size) ! TAN fluxes, see top of the module + !real(r8), intent(in) :: dt ! timestep real(r8) :: water_tot, cnc, air, depth_soilsat, diffusivity_water, diffusivity_satsoil, halfwater, insoil, r1, dz2, inwater @@ -358,7 +359,7 @@ subroutine eval_fluxes_slurry(water_surf, water_subsurf, mtan, Hconc, tg, ratm, fluxes(iflx_soild) = cnc * gdown ! nitrification - kno3 = eval_no3prod_v2(thetasat, thetasat, tg) + kno3 = eval_no3prod(thetasat, thetasat, tg) fluxes(iflx_no3) = kno3 * mtan end subroutine eval_fluxes_slurry @@ -373,7 +374,6 @@ subroutine eval_fluxes_soil(mtan, water_manure, Hconc, tg, ratm, theta, thetasat implicit none real(r8), intent(in) :: mtan ! TAN (=NH4 (aq) + NH3 (g) + NH3 (aq)), mass units / m2 real(r8), intent(in) :: water_manure ! water in the soil pool *in addition to* background soil water - real(r8), intent(out) :: fluxes(fluxes_size) ! nitrogen fluxes, mass units / m2 / s, see top of module real(r8), intent(in) :: Hconc ! Hydrogen ion concentration, mol/l real(r8), intent(in) :: tg ! soil temperature, K real(r8), intent(in) :: ratm ! atmospheric resistance, s/m @@ -384,8 +384,9 @@ subroutine eval_fluxes_soil(mtan, water_manure, Hconc, tg, ratm, theta, thetasat real(r8), intent(in) :: bsw ! b in the soilwater retention curve; needed if the Moldrup 2003 diffusivities are used. real(r8), intent(in) :: kads_nh4 ! distribution coefficient kads = [TAN (s)] / [TAN (aq)]. Unit m3(water) / m3(soil). real(r8), intent(in) :: soildepth ! thickness of the volatlization layer - integer, intent(in) :: substance ! subst_tan or subst_urea. integer, intent(in) :: fluxes_size + real(r8), intent(out) :: fluxes(fluxes_size) ! nitrogen fluxes, mass units / m2 / s, see top of module + integer, intent(in) :: substance ! subst_tan or subst_urea. integer, intent(out) :: status ! error flag real(r8) :: water_tot, cnc, air, henry_eff, dsl, dsg, dstot, dz2, no3_rate, volat_rate, theta_tot, beta @@ -575,21 +576,21 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend real(r8), intent(in) :: runoff ! surface runoff flux, m/s real(r8), intent(in) :: tandep ! TAN input flux, gN/m2/s real(r8), intent(in) :: tanprod ! TAN produced in the column, added to aged TAN pool - real(r8), intent(in) :: depth_slurry ! Initial slurry depth, m real(r8), intent(in) :: bsw + real(r8), intent(in) :: depth_slurry ! Initial slurry depth, m ! age ranges of TAN pools S0, S1, S2, S3 sec. Slurry infiltration time is inferred from S0. + integer, intent(in) :: pools_size ! size of the tanpools array. >= 4 real(r8), intent(in) :: poolranges(pools_size) real(r8), intent(inout) :: tanpools(pools_size) ! TAN pools gN/m2 + integer, intent(in) :: fluxes_size ! size of the fluxes array. >= 5 real(r8), intent(out) :: fluxes(fluxes_size, pools_size) ! TAN fluxes, gN/m2/s (type of flux, pool) real(r8), intent(in) :: Hconc(pools_size) ! H+ concentration real(r8), intent(out) :: garbage ! over-aged TAN occurring during the step, gN/m. real(r8), intent(in) :: dt ! timestep, sec, >0 - integer, intent(in) :: pools_size ! size of the tanpools array. >= 4 - integer, intent(in) :: fluxes_size ! size of the fluxes array. >= 5 integer, intent(out) :: status ! return status, 0 = good real(r8) :: infiltr_slurry, infiltrated, percolated, evap_slurry, water_slurry(2), perc_slurry_mean, waterloss - real(r8) :: percolation, water_soil, age_prev, water_in_layer, tanpools_old(4) + real(r8) :: percolation, water_soil, age_prev, water_in_layer, tanpools_old(4), water_relax_t integer :: indpl real(r8), parameter :: dz_layer = 0.02 ! thickness of the volatilization layer, m @@ -648,13 +649,14 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend ! age_prev = 0 ! for water evaluations, consider beginning of S1 as the starting point water_in_layer = infiltrated - percolated ! water in layer just after slurry has infiltrated + water_relax_t = poolranges(2) ! relax time is for soil moisture after infiltration ie. the first "normal" N pool. do indpl = 2, 4 ! water content lost during the aging - waterloss = water_in_layer * (waterfunction(age_prev) - waterfunction(age_prev+poolranges(indpl))) + waterloss = water_in_layer * (waterfunction(age_prev, water_relax_t) - waterfunction(age_prev+poolranges(indpl), water_relax_t)) percolation = eval_perc(waterloss, evap, precip, watertend, poolranges(indpl)) ! water content at the mean age of the pool - water_soil = water_in_layer * waterfunction(age_prev + 0.5*poolranges(indpl)) + water_soil = water_in_layer * waterfunction(age_prev + 0.5*poolranges(indpl), water_relax_t) call eval_fluxes_soil(tanpools(indpl), water_soil, Hconc(indpl), tg, & & ratm, theta, thetasat, percolation, runoff, bsw, kads, & & dz_layer, fluxes(1:5,indpl), subst_tan, 5, status) @@ -711,19 +713,18 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend real(r8), intent(in) :: Hconc(numpools) ! H+ concentration, mol/l (npools) real(r8), intent(in) :: dz_layer ! thickness of the volatilization layer, m real(r8), intent(inout) :: tanpools(numpools) ! TAN pools gN/m2 (npools) + integer, intent(in) :: numpools + integer, intent(in) :: size_fluxes real(r8), intent(out) :: fluxes(size_fluxes,numpools) ! TAN fluxes, gN/m2/s (type of flux, pool) real(r8), intent(out) :: garbage ! "over-aged" TAN produced during the step, gN/m. real(r8), intent(in) :: dt ! timestep, sec, >0 - integer, intent(in) :: numpools - integer, intent(in) :: size_fluxes integer, intent(out) :: status ! 0 == OK real(r8) :: fraction_layer, fraction_reservoir, fraction_runoff, waterloss, direct_runoff real(r8) :: percolation, water_soil, age_prev, tandep_remaining, direct_percolation, water_into_layer - real(r8) :: tanpools_old(size(tanpools)), imbalance + real(r8) :: tanpools_old(size(tanpools)), imbalance, water_relax_t integer :: indpl - real(r8), parameter :: water_relax_t = 24*3600.0_r8 real(r8), parameter :: kads = 1.0_r8 logical :: fixed @@ -783,14 +784,14 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend return end if end if - + water_relax_t = poolranges(1) age_prev = 0 ! for water evaluations, consider beginning of S1 as the starting point do indpl = 1, size(tanpools) ! water content lost during the aging - waterloss = water_into_layer * (waterfunction(age_prev) - waterfunction(age_prev+poolranges(indpl))) + waterloss = water_into_layer * (waterfunction(age_prev, water_relax_t) - waterfunction(age_prev+poolranges(indpl), water_relax_t)) percolation = eval_perc(waterloss, evap, precip, watertend, poolranges(indpl)) ! water content at the middle of the age range - water_soil = water_into_layer * waterfunction(age_prev + 0.5*poolranges(indpl)) + water_soil = water_into_layer * waterfunction(age_prev + 0.5*poolranges(indpl), water_relax_t) call eval_fluxes_soil(tanpools(indpl), water_soil, Hconc(indpl), tg, & & ratm, theta, thetasat, percolation, runoff, bsw, kads, & & dz_layer, fluxes(1:5,indpl), subst_tan, 5, status) @@ -898,17 +899,17 @@ end function get_evap_pool ! Waterfunction gives the relaxation of the moisture perturbation normalized between 0 ! and 1. Either exponential or linear. - function waterfunction_exp(pool_age) result(water) + function waterfunction_exp(pool_age, water_relax_t) result(water) implicit none - real(r8), intent(in) :: pool_age ! sec + real(r8), intent(in) :: pool_age, water_relax_t ! sec real(r8) :: water water = exp(-pool_age / water_relax_t) end function waterfunction_exp - function waterfunction(pool_age) result(water) + function waterfunction(pool_age, water_relax_t) result(water) implicit none - real(r8), intent(in) :: pool_age ! sec + real(r8), intent(in) :: pool_age, water_relax_t ! sec real(r8) :: water if (pool_age > water_relax_t) then @@ -957,10 +958,10 @@ subroutine eval_fluxes_storage(nitr_input, barntype, tempr_outside, windspeed, f real(r8), intent(in) :: fract_direct ! fraction of manure N applied before storage real(r8), intent(in) :: volat_coef_barns, volat_coef_stores ! normalization coefficients, unitless real(r8), intent(in) :: tan_fract_excr ! fraction of NH4 nitrogen in excreted N + integer, intent(in) :: fluxes_size real(r8), intent(out), dimension(fluxes_size) :: fluxes_nitr, fluxes_tan ! nitrogen and TAN fluxes, gN/s ! (/m2). See top of module for ! indices. - integer, intent(in) :: fluxes_size integer, intent(out) :: status ! see top of the module. ! parameters for the Gyldenkaerne et al. parameterization @@ -1092,6 +1093,7 @@ subroutine update_org_n(flux_input, tg, soilpsi, pools, dt, tanprod, soilflux, s ! unavailable N fractions, and update the organic N pools. In addition, evaluate the ! flux of organic N into the soil pools according to a fixed time constant set below. implicit none + integer, intent(in) :: size_pools real(r8), intent(in) :: flux_input(size_pools) ! organic N entering the pools. gN/m2/s. For ! indices see at top of the module. real(r8), intent(in) :: tg ! ground temperature, K @@ -1100,7 +1102,6 @@ subroutine update_org_n(flux_input, tg, soilpsi, pools, dt, tanprod, soilflux, s real(r8), intent(in) :: dt ! timestep, sec real(r8), intent(out) :: tanprod(size_pools) ! Flux of TAN formed, both pools real(r8), intent(out) :: soilflux ! Flux of organic nitrogen to soil - integer, intent(in) :: size_pools integer, intent(out) :: status real(r8) :: rate_res, rate_avail, TR, rmoist, psi @@ -1153,13 +1154,13 @@ subroutine update_urea(tg, theta, thetasat, precip, evap, watertend, runoff, & real(r8), intent(in) :: runoff ! surface runoff flux, m/s real(r8), intent(in) :: ndep ! nitrogen input, mass unit / s real(r8), intent(in) :: bsw ! b in the soil water retention curve + integer, intent(in) :: numpools + integer, intent(in) :: fluxes_size real(r8), intent(inout) :: pools(numpools) ! nitrogen pools mass / m2 real(r8), intent(out) :: fluxes(fluxes_size, numpools) ! needs one extra for the to_tan flux real(r8), intent(in) :: ranges(numpools) ! pool age extents, s real(r8), intent(out) :: garbage ! nitrogen in patches aged beyond the oldest pool. mass / m2 real(r8), intent(in) :: dt ! time step, s - integer, intent(in) :: numpools - integer, intent(in) :: fluxes_size integer, intent(out) :: status ! see top of module real(r8), parameter :: rate = 4.83e-6 ! urea decomposition, 1/s From 5ca3cc4981adc2bce9c33003b9d3df94430c87ac Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Tue, 9 Jul 2019 16:34:50 -0600 Subject: [PATCH 075/181] remove commented out water_relax_t --- src/biogeochem/FanMod.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/biogeochem/FanMod.F90 b/src/biogeochem/FanMod.F90 index fa891eeeec..8043b43c8e 100755 --- a/src/biogeochem/FanMod.F90 +++ b/src/biogeochem/FanMod.F90 @@ -67,8 +67,6 @@ module FanMod err_balance_tan = 4, err_balance_nitr = 5, err_nan = 6, err_bad_subst = 7, err_bad_type = 8, err_bad_arg = 9 integer, parameter, public :: subst_tan = 1, subst_urea = 2 - - !real(r8), parameter, public :: water_relax_t = 24*3600.0_r8 logical, parameter, public :: debug_fan = .false. From be597f8ff3fd03d008b740664cbf1ec0f2391248 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 10 Jul 2019 18:09:40 -0400 Subject: [PATCH 076/181] remove unnecessary changes to accumulated temperatures --- src/biogeophys/TemperatureType.F90 | 72 ++++-------------------------- 1 file changed, 8 insertions(+), 64 deletions(-) diff --git a/src/biogeophys/TemperatureType.F90 b/src/biogeophys/TemperatureType.F90 index e7014baabb..5dfc3bc704 100644 --- a/src/biogeophys/TemperatureType.F90 +++ b/src/biogeophys/TemperatureType.F90 @@ -7,10 +7,7 @@ module TemperatureType use shr_log_mod , only : errMsg => shr_log_errMsg use decompMod , only : bounds_type use abortutils , only : endrun -!KO use clm_varctl , only : use_cndv, iulog, use_luna, use_crop -!KO - use clm_varctl , only : use_cndv, iulog, use_luna, use_crop, use_fan -!KO + use clm_varctl , only : use_cndv, iulog, use_luna, use_crop use clm_varpar , only : nlevsno, nlevgrnd, nlevlak, nlevlak, nlevurb use clm_varcon , only : spval, ispval use GridcellType , only : grc @@ -580,19 +577,11 @@ subroutine InitHistory(this, bounds, is_simple_buildtemp, is_prog_buildtemp ) ptr_patch=this%gdd0_patch, default='inactive') end if -!KO - if (use_crop .or. use_fan) then + if (use_crop) then this%gdd8_patch(begp:endp) = spval call hist_addfld1d (fname='GDD8', units='ddays', & avgflag='A', long_name='Growing degree days base 8C from planting', & ptr_patch=this%gdd8_patch, default='inactive') - end if - - if (use_crop) then -!KO this%gdd8_patch(begp:endp) = spval -!KO call hist_addfld1d (fname='GDD8', units='ddays', & -!KO avgflag='A', long_name='Growing degree days base 8C from planting', & -!KO ptr_patch=this%gdd8_patch, default='inactive') this%gdd10_patch(begp:endp) = spval call hist_addfld1d (fname='GDD10', units='ddays', & @@ -1157,32 +1146,16 @@ subroutine InitAccBuffer (this, bounds) desc='10-day running mean of 2-m temperature', accum_type='runmean', accum_period=-10, & subgrid_type='pft', numlev=1,init_value=SHR_CONST_TKFRZ+20._r8) -!KO - if ( use_crop .or. use_fan ) then + if ( use_crop )then call init_accum_field (name='TDM10', units='K', & desc='10-day running mean of min 2-m temperature', accum_type='runmean', accum_period=-10, & subgrid_type='pft', numlev=1, init_value=SHR_CONST_TKFRZ) - end if -!KO - - if ( use_crop )then -!KO call init_accum_field (name='TDM10', units='K', & -!KO desc='10-day running mean of min 2-m temperature', accum_type='runmean', accum_period=-10, & -!KO subgrid_type='pft', numlev=1, init_value=SHR_CONST_TKFRZ) call init_accum_field (name='TDM5', units='K', & desc='5-day running mean of min 2-m temperature', accum_type='runmean', accum_period=-5, & subgrid_type='pft', numlev=1, init_value=SHR_CONST_TKFRZ) end if -!KO - if ( use_crop .or. use_fan ) then - call init_accum_field (name='GDD8', units='K', & - desc='growing degree-days base 8C from planting', accum_type='runaccum', accum_period=not_used, & - subgrid_type='pft', numlev=1, init_value=0._r8) - end if -!KO - if ( use_crop )then ! All GDD summations are relative to the planting date (Kucharik & Brye 2003) @@ -1190,9 +1163,9 @@ subroutine InitAccBuffer (this, bounds) desc='growing degree-days base 0C from planting', accum_type='runaccum', accum_period=not_used, & subgrid_type='pft', numlev=1, init_value=0._r8) -!KO call init_accum_field (name='GDD8', units='K', & -!KO desc='growing degree-days base 8C from planting', accum_type='runaccum', accum_period=not_used, & -!KO subgrid_type='pft', numlev=1, init_value=0._r8) + call init_accum_field (name='GDD8', units='K', & + desc='growing degree-days base 8C from planting', accum_type='runaccum', accum_period=not_used, & + subgrid_type='pft', numlev=1, init_value=0._r8) call init_accum_field (name='GDD10', units='K', & desc='growing degree-days base 10C from planting', accum_type='runaccum', accum_period=not_used, & @@ -1261,6 +1234,7 @@ subroutine InitAccVars(this, bounds) if (use_crop) then call extract_accum_field ('TDM10', rbufslp, nstep) this%t_a10min_patch(begp:endp)= rbufslp(begp:endp) + call extract_accum_field ('TDM5', rbufslp, nstep) this%t_a5min_patch(begp:endp) = rbufslp(begp:endp) end if @@ -1441,8 +1415,7 @@ subroutine UpdateAccVars (this, bounds) call update_accum_field ('T10', this%t_ref2m_patch, nstep) call extract_accum_field ('T10', this%t_a10_patch, nstep) -!KO - if ( use_crop .or. use_fan ) then + if ( use_crop )then ! Accumulate and extract TDM10 do p = begp,endp @@ -1452,35 +1425,6 @@ subroutine UpdateAccVars (this, bounds) call update_accum_field ('TDM10', rbufslp, nstep) call extract_accum_field ('TDM10', this%t_a10min_patch, nstep) - ! Accumulate and extract GDD8 - - do p = begp,endp - g = patch%gridcell(p) - if (month==1 .and. day==1 .and. secs==dtime) then - rbufslp(p) = accumResetVal ! reset gdd - else if (( month > 3 .and. month < 10 .and. grc%latdeg(g) >= 0._r8) .or. & - ((month > 9 .or. month < 4) .and. grc%latdeg(g) < 0._r8) ) then - rbufslp(p) = max(0._r8, min(30._r8, & - this%t_ref2m_patch(p)-(SHR_CONST_TKFRZ + 8._r8))) * dtime/SHR_CONST_CDAY - else - rbufslp(p) = 0._r8 ! keeps gdd unchanged at other times (eg, through Dec in NH) - end if - end do - call update_accum_field ('GDD8', rbufslp, nstep) - call extract_accum_field ('GDD8', this%gdd8_patch, nstep) - end if -!KO - - if ( use_crop )then -!KO ! Accumulate and extract TDM10 - -!KO do p = begp,endp -!KO rbufslp(p) = min(this%t_ref2m_min_patch(p),this%t_ref2m_min_inst_patch(p)) !slevis: ok choice? -!KO if (rbufslp(p) > 1.e30_r8) rbufslp(p) = SHR_CONST_TKFRZ !and were 'min'& -!KO end do !'min_inst' not initialized? -!KO call update_accum_field ('TDM10', rbufslp, nstep) -!KO call extract_accum_field ('TDM10', this%t_a10min_patch, nstep) - ! Accumulate and extract TDM5 do p = begp,endp From 802e8e6e025346dabdf37b2983ab7e770bdbbd7b Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 10 Jul 2019 20:01:22 -0400 Subject: [PATCH 077/181] debug fan-bgc coupling --- src/biogeochem/CNNDynamicsMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index 0a28e543c0..834996c20e 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -332,9 +332,9 @@ subroutine CNNFert(bounds, num_soilc, filter_soilc, & fert_to_sminn(bounds%begc:bounds%endc)) call p2c(bounds, num_soilc, filter_soilc, & manure(bounds%begp:bounds%endp), & - manure_col) + manure_col(bounds%begc:bounds%endc)) ! Add the manure N processed above: - do fc = 1, fc + do fc = 1, num_soilc c = filter_soilc(fc) fert_to_sminn(c) = fert_to_sminn(c) + manure_col(c) end do From 57292f8c3e5d9e1381669abb322b66155c23208e Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 10 Jul 2019 20:02:24 -0400 Subject: [PATCH 078/181] remove unnecessary variable --- src/biogeochem/CNPhenologyMod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/biogeochem/CNPhenologyMod.F90 b/src/biogeochem/CNPhenologyMod.F90 index 67fc39007f..e43db63226 100644 --- a/src/biogeochem/CNPhenologyMod.F90 +++ b/src/biogeochem/CNPhenologyMod.F90 @@ -1479,7 +1479,6 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & real(r8) dayspyr ! days per year real(r8) crmcorn ! comparitive relative maturity for corn real(r8) ndays_on ! number of days to fertilize - real(r8) manure_avail ! manure nitrogen available in the beginning of fertilization !------------------------------------------------------------------------ associate( & From 013ff5718b70a5c62aa395b58811fe2218d96ba0 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Fri, 12 Jul 2019 09:31:52 -0600 Subject: [PATCH 079/181] guard agains negative windspeed (!) --- src/biogeochem/FanMod.F90 | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/src/biogeochem/FanMod.F90 b/src/biogeochem/FanMod.F90 index 8043b43c8e..8dca42ddd5 100755 --- a/src/biogeochem/FanMod.F90 +++ b/src/biogeochem/FanMod.F90 @@ -632,7 +632,7 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend call update_pools(tanpools(1:1), fluxes(1:5,1:1), dt, 1, 5) - if (debug_fan .and. any(tanpools < -1e-15)) then + if (debug_fan .and. any(tanpools < -1e-14)) then status = err_negative_tan return end if @@ -802,12 +802,13 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend call update_pools(tanpools, fluxes(1:5,:), dt, numpools, 5, fixed) tanpools = tanpools + tanprod*dt - if(any(isnan(tanpools))) then - status = err_nan+100 - return - end if if (debug_fan) then + if(any(isnan(tanpools))) then + status = err_nan+100 + return + end if + if (any(tanpools < -1e-15)) then status = err_negative_tan + 1000 return @@ -1046,8 +1047,9 @@ subroutine eval_fluxes_storage(nitr_input, barntype, tempr_outside, windspeed, f fluxes_nitr(iflx_appl) = flux_direct tempr_stores = max(Tfloor_stores, tempr_C) + ! with some data, in some rare places, we can have windspeed < 0 (!?) flux_store = flux_avail_tan & - & * volat_coef_stores * tempr_stores**pA * windspeed**pB + & * volat_coef_stores * tempr_stores**pA * max(windspeed, 0.0_r8)**pB flux_store = min(flux_avail_tan, flux_store) fluxes_tan(iflx_air_stores) = flux_store @@ -1064,6 +1066,10 @@ subroutine eval_fluxes_storage(nitr_input, barntype, tempr_outside, windspeed, f fluxes_tan(iflx_to_store) = flux_avail_tan if (debug_fan) then + if (any(isnan(fluxes_nitr)) .or. any(isnan(fluxes_tan))) then + status = err_nan + return + end if if (abs(sum(fluxes_nitr) - nitr_input) > 1e-5*nitr_input) then status = err_balance_nitr return From bc183b1c70c34ad55c2766a60c55502f66f3aa72 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Sat, 20 Jul 2019 15:26:22 -0600 Subject: [PATCH 080/181] make nh4 adsorption a namelist parameter --- bld/CLMBuildNamelist.pm | 3 + bld/namelist_files/namelist_defaults_ctsm.xml | 2 +- .../namelist_definition_ctsm.xml | 6 +- src/biogeochem/Fan2CTSMMod.F90 | 109 +++++++++--------- src/biogeochem/FanMod.F90 | 14 ++- 5 files changed, 74 insertions(+), 60 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 621b010534..07289ad0c4 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -2907,6 +2907,9 @@ sub setup_logic_fan { 'fan_mode'=>$fan_mode); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fract_spread_grass', 'fan_mode'=>$fan_mode); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'nh4_ads_coef', + 'fan_mode'=>$fan_mode); + } if ( &value_is_true( $nl_flags->{'use_ed'} ) && &value_is_true( $nl_flags->{'use_fan'} ) ) { diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 48c7b0bf01..45fbc1ca76 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -1062,7 +1062,7 @@ lnd/clm2/surfdata_map/surfdata_ne120np4_78pfts_CMIP6_simyr1850_c170824.nc0.0 0.0 1.0 - +1.0 .false. diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index 3badece69f..7a8c66242f 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -1591,7 +1591,7 @@ Mapping method from FAN Nitrogen (manure) deposition input file to the model res -Fraction (0...1) of manure N moved from crops to native vegetation column +Toggle to connect the FAN N pools to soil biogeochemistry for CROP VEGETATION columns + + Adsorption coefficient for ammonium in FAN. Must be >= 0, 0 means no adsorption. + diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index f8dfd91c34..5d15049ee7 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -108,7 +108,7 @@ subroutine fan_readnml(NLFilename) use abortutils , only : endrun use shr_mpi_mod , only : shr_mpi_bcast use FanStreamMod , only : set_bcast_fanstream_pars - + use FanMod , only : nh4_ads_coef character(len=*), intent(in) :: NLFilename ! Namelist filename integer :: ierr ! error code @@ -123,7 +123,7 @@ subroutine fan_readnml(NLFilename) namelist /fan_nml/ fan_to_bgc_crop, fan_to_bgc_veg, stream_year_first_fan, & stream_year_last_fan, model_year_align_fan, fan_mapalgo, stream_fldFileName_fan, & - fract_spread_grass + fract_spread_grass, nh4_ads_coef if (.not. use_fan) return @@ -149,7 +149,11 @@ subroutine fan_readnml(NLFilename) call shr_mpi_bcast(fan_to_bgc_crop, mpicom) call shr_mpi_bcast(fan_to_bgc_veg, mpicom) call shr_mpi_bcast(fract_spread_grass, mpicom) - + call shr_mpi_bcast(nh4_ads_coef, mpicom) + + if (nh4_ads_coef < 0) then + call endrun(msg="ERROR invalid nh4_ads_coef") + end if if (fract_spread_grass > 1 .or. fract_spread_grass < 0) then call endrun(msg="ERROR invalid fract_spread_grass") end if @@ -193,7 +197,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & ! Local variables integer, parameter :: & - ! Use this many sub-steps. This improves numerical accuracy but is no longer + ! Use this many sub-steps. This improves numerical accuracy but is perhaps not ! essential, because FAN includes an ad-hoc fixer for negative fluxes. num_substeps = 4, & ! FAN includes a separate nitrogen conservation check, which can be done every @@ -202,9 +206,8 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & ! detail. balance_check_freq = 1000 integer :: c, g, patchcounter, p, status, c1, c2, l, fc, ind_substep - real(r8) :: dt, ndep_org(3), orgpools(3), tanprod(3), watertend, fluxes(6,3), tanpools3(3), ratm, tandep, & - fluxes2(6,2), fluxes3(6,3), fluxes4(6,4), tanpools2(2), tanpools4(4), fluxes_tmp(6), garbage_total - + real(r8) :: dt, ndep_org(3), orgpools(3), tanprod(3), watertend, fluxes(6,4), tanpools(4), ratm, tandep, & + fluxes_tmp(6), garbage_total real(r8) :: Hconc_grz(3), Hconc_slr(4), pH_soil, pH_crop real(r8) :: fert_inc_tan @@ -365,6 +368,9 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & infiltr_m_s = max(waterfluxbulk_inst%qflx_infl_col(c), 0.0) * 1e-3 evap_m_s = waterfluxbulk_inst%qflx_evap_grnd_col(c) * 1e-3 runoff_m_s = max(waterfluxbulk_inst%qflx_runoff_col(c), 0.0) * 1e-3 + if (runoff_m_s > 1.0_r8) then + runoff_m_s = 0.0_r8 + end if soilpsi = soilstate_inst%soilpsi_col(c,1) ! grazing @@ -383,9 +389,9 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & man_r_grz(c) = orgpools(ind_resist) man_u_grz(c) = orgpools(ind_unavail) - tanpools3(1) = ns%tan_g1_col(c) - tanpools3(2) = ns%tan_g2_col(c) - tanpools3(3) = ns%tan_g3_col(c) + tanpools(1) = ns%tan_g1_col(c) + tanpools(2) = ns%tan_g2_col(c) + tanpools(3) = ns%tan_g3_col(c) ph_soil = atm2lnd_inst%forc_soilph_grc(g) if (ph_soil < 3.0) then @@ -398,27 +404,27 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & fluxes_tmp = 0.0 garbage_total = 0.0 - fluxes3 = 0.0 + fluxes = 0.0 garbage = 0 do ind_substep = 1, num_substeps call update_npool(tg, ratm, & theta, thetasat, infiltr_m_s, evap_m_s, & wateratm2lndbulk_inst%forc_q_downscaled_col(c), watertend, & runoff_m_s, tandep, (/0.0_r8, 0.0_r8, sum(tanprod)/), water_init_grz, & - bsw, poolranges_grz, Hconc_grz, dz_layer_grz, tanpools3, & - fluxes3(1:5,1:3), garbage, dt/num_substeps, 3, 5, status) + bsw, poolranges_grz, Hconc_grz, dz_layer_grz, tanpools(1:3), & + fluxes(1:5,1:3), garbage, dt/num_substeps, 3, 5, status) if (status /= 0) then - write(iulog, *) 'status = ', status, tanpools3, ratm, theta, thetasat, tandep, tanprod + write(iulog, *) 'status = ', status, tanpools(1:3), ratm, theta, thetasat, tandep, tanprod call endrun(msg='update_npool status /= 0') end if - fluxes_tmp = fluxes_tmp + sum(fluxes3, dim=2) + fluxes_tmp = fluxes_tmp + sum(fluxes(:,1:3), dim=2) garbage_total = garbage_total + garbage end do fluxes_tmp = fluxes_tmp / num_substeps - ns%tan_g1_col(c) = tanpools3(1) - ns%tan_g2_col(c) = tanpools3(2) - ns%tan_g3_col(c) = tanpools3(3) + ns%tan_g1_col(c) = tanpools(1) + ns%tan_g2_col(c) = tanpools(2) + ns%tan_g3_col(c) = tanpools(3) nf%nh3_grz_col(c) = fluxes_tmp(iflx_air) nf%manure_runoff_col(c) = fluxes_tmp(iflx_roff) @@ -427,7 +433,6 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & = fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) + garbage_total / dt + soilflux_org ! Manure application - ! org_n_tot = nf%man_n_appl_col(c) - nf%man_tan_appl_col(c) ! Use the the same fractionation of organic N as for grazing, after removing the @@ -445,20 +450,20 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & man_r_app(c) = orgpools(ind_resist) man_u_app(c) = orgpools(ind_unavail) - tanpools4(1) = ns%tan_s0_col(c) - tanpools4(2) = ns%tan_s1_col(c) - tanpools4(3) = ns%tan_s2_col(c) - tanpools4(4) = ns%tan_s3_col(c) + tanpools(1) = ns%tan_s0_col(c) + tanpools(2) = ns%tan_s1_col(c) + tanpools(3) = ns%tan_s2_col(c) + tanpools(4) = ns%tan_s3_col(c) ph_crop = min(max(ph_soil, ph_crop_min), ph_crop_max) Hconc_slr(4) = 10**(-ph_crop) fluxes_tmp = 0.0 garbage_total = 0.0 - fluxes4 = 0.0 + fluxes = 0.0 do ind_substep = 1, num_substeps - if (debug_fan .and. any(abs(tanpools4) > 1e12)) then - write(iulog, *) ind_substep, tanpools4, tandep, nf%fert_n_appl_col(c), & + if (debug_fan .and. any(abs(tanpools(1:4)) > 1e12)) then + write(iulog, *) ind_substep, tanpools(1:4), tandep, nf%fert_n_appl_col(c), & nf%man_n_appl_col(c), ns%man_n_stored_col(c), ns%man_tan_stored_col(c) call endrun('bad tanpools (manure app)') end if @@ -466,22 +471,22 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & call update_4pool(tg, ratm, theta, thetasat, infiltr_m_s, evap_m_s, & wateratm2lndbulk_inst%forc_q_downscaled_col(c), watertend, & runoff_m_s, tandep, sum(tanprod), bsw, depth_slurry, & - poolranges_slr, tanpools4, Hconc_slr, fluxes4(1:5, 1:4), & + poolranges_slr, tanpools(1:4), Hconc_slr, fluxes(1:5, 1:4), & garbage, dt / num_substeps, 4, 5, status) if (status /= 0) then - write(iulog, *) 'status = ', status, tanpools4, tg, ratm, 'th', theta, & - thetasat, tandep, 'tp', tanprod, 'fx', fluxes4 + write(iulog, *) 'status = ', status, tanpools(1:4), tg, ratm, 'th', theta, & + thetasat, tandep, 'tp', tanprod, 'fx', fluxes(1:5,1:4) call endrun(msg='update_3pool status /= 0') end if - fluxes_tmp = fluxes_tmp + sum(fluxes4, dim=2) + fluxes_tmp = fluxes_tmp + sum(fluxes(:,1:4), dim=2) garbage_total = garbage_total + garbage end do fluxes_tmp = fluxes_tmp / num_substeps - ns%tan_s0_col(c) = tanpools4(1) - ns%tan_s1_col(c) = tanpools4(2) - ns%tan_s2_col(c) = tanpools4(3) - ns%tan_s3_col(c) = tanpools4(4) + ns%tan_s0_col(c) = tanpools(1) + ns%tan_s1_col(c) = tanpools(2) + ns%tan_s2_col(c) = tanpools(3) + ns%tan_s3_col(c) = tanpools(4) nf%nh3_man_app_col(c) = fluxes_tmp(iflx_air) nf%manure_runoff_col(c) = nf%manure_runoff_col(c) + fluxes_tmp(iflx_roff) @@ -516,62 +521,62 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & ! ureapools(1) = ns%fert_u0_col(c) ureapools(2) = ns%fert_u1_col(c) - fluxes2 = 0.0 + fluxes = 0.0 call update_urea(tg, theta, thetasat, infiltr_m_s, evap_m_s, watertend, & - runoff_m_s, fert_urea, bsw, ureapools, fluxes2, urea_resid, poolranges_fert(1:2), & + runoff_m_s, fert_urea, bsw, ureapools, fluxes(1:6,1:2), urea_resid, poolranges_fert(1:2), & dt, 2, 6, status) if (status /= 0) then call endrun(msg='Bad status after update_urea for fertilizer') end if ! Nitrogen fluxes from urea pool. Be sure to not zero below! - fluxes_tmp = sum(fluxes2, dim=2) + fluxes_tmp = sum(fluxes(:,1:2), dim=2) ns%fert_u0_col(c) = ureapools(1) ns%fert_u1_col(c) = ureapools(2) ! Collect the formed ammonia for updating the TAN pools - tanprod_from_urea(1:2) = fluxes2(iflx_to_tan, 1:2) + tanprod_from_urea(1:2) = fluxes(iflx_to_tan, 1:2) ! There is no urea pool corresponding to tan_f2, because most of the urea will ! have decomposed. Here whatever remains gets sent to tan_f2. tanprod_from_urea(3) = urea_resid / dt - tanpools3(1) = ns%tan_f0_col(c) - tanpools3(2) = ns%tan_f1_col(c) - tanpools3(3) = ns%tan_f2_col(c) + tanpools(1) = ns%tan_f0_col(c) + tanpools(2) = ns%tan_f1_col(c) + tanpools(3) = ns%tan_f2_col(c) garbage_total = 0.0 - fluxes3 = 0.0 + fluxes = 0.0 nf%nh3_otherfert_col(c) = 0.0 do ind_substep = 1, num_substeps ! Fertilizer pools f0...f2 call update_npool(tg, ratm, theta, thetasat, infiltr_m_s, evap_m_s, & wateratm2lndbulk_inst%forc_q_downscaled_col(c), watertend, & runoff_m_s, 0.0_r8, tanprod_from_urea, water_init_fert, bsw, & - poolranges_fert, Hconc_fert, dz_layer_fert, tanpools3, fluxes3(1:5,1:3), & + poolranges_fert, Hconc_fert, dz_layer_fert, tanpools(1:3), fluxes(1:5,1:3), & garbage, dt/num_substeps, 3, 5, status) if (status /= 0) then - write(iulog, *) 'status:', status, tanpools3, nf%fert_n_appl_col(c) + write(iulog, *) 'status:', status, tanpools(1:3), nf%fert_n_appl_col(c) call endrun(msg='Bad status after npool for fertilizer') end if - fluxes_tmp = fluxes_tmp + sum(fluxes3, dim=2) / num_substeps + fluxes_tmp = fluxes_tmp + sum(fluxes(:,1:3), dim=2) / num_substeps garbage_total = garbage_total + garbage ! Fertilizer pool f3 call update_npool(tg, ratm, theta, thetasat, infiltr_m_s, evap_m_s, & wateratm2lndbulk_inst%forc_q_downscaled_col(c), watertend, & runoff_m_s, fert_generic, (/0.0_r8/), water_init_fert, bsw, & - poolrange_otherfert, (/10**(-ph_crop)/), dz_layer_fert, ns%tan_f3_col(c:c), fluxes3(1:5,1:1), & + poolrange_otherfert, (/10**(-ph_crop)/), dz_layer_fert, ns%tan_f3_col(c:c), fluxes(1:5,1:1), & garbage, dt/num_substeps, 1, 5, status) if (status /= 0) then - write(iulog, *) 'status:', status, tanpools3, nf%fert_n_appl_col(c) + write(iulog, *) 'status:', status, ns%tan_f3_col(c:c), nf%fert_n_appl_col(c) call endrun(msg='Bad status after npool for generic') end if - fluxes_tmp = fluxes_tmp + fluxes3(:, 1) / num_substeps + fluxes_tmp = fluxes_tmp + fluxes(:, 1) / num_substeps garbage_total = garbage_total + garbage - nf%nh3_otherfert_col(c) = nf%nh3_otherfert_col(c) + fluxes3(iflx_air, 1) / num_substeps + nf%nh3_otherfert_col(c) = nf%nh3_otherfert_col(c) + fluxes(iflx_air, 1) / num_substeps end do - ns%tan_f0_col(c) = tanpools3(1) - ns%tan_f1_col(c) = tanpools3(2) - ns%tan_f2_col(c) = tanpools3(3) + ns%tan_f0_col(c) = tanpools(1) + ns%tan_f1_col(c) = tanpools(2) + ns%tan_f2_col(c) = tanpools(3) ! !!tan_f3_col already updated above by update_npool!! nf%nh3_fert_col(c) = fluxes_tmp(iflx_air) diff --git a/src/biogeochem/FanMod.F90 b/src/biogeochem/FanMod.F90 index 8dca42ddd5..d95e4e2371 100755 --- a/src/biogeochem/FanMod.F90 +++ b/src/biogeochem/FanMod.F90 @@ -62,6 +62,8 @@ module FanMod ! nominal depth where the soil TAN concentration vanishes: real(r8), parameter, public :: soildepth_reservoir = 0.04_r8 + ! Adsorption coeffient of NH4 in soil: + real(r8), public, save :: nh4_ads_coef = 1.0_r8 integer, parameter, public :: err_bad_theta = 1, err_negative_tan = 2, err_negative_flux = 3, & err_balance_tan = 4, err_balance_nitr = 5, err_nan = 6, err_bad_subst = 7, err_bad_type = 8, err_bad_arg = 9 @@ -592,8 +594,8 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend integer :: indpl real(r8), parameter :: dz_layer = 0.02 ! thickness of the volatilization layer, m - real(r8), parameter :: kads = 1.0_r8 ! distriution coefficient kads = [TAN (s)] / [TAN (aq)], dimensionless - + !real(r8), parameter :: kads = 1.0_r8 ! distriution coefficient kads = [TAN (s)] / [TAN (aq)], dimensionless + if (pools_size < 4 .or. fluxes_size < 5) then status = err_bad_arg return @@ -622,7 +624,7 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend call eval_fluxes_slurry(water_slurry(1), water_slurry(2), tanpools(1), Hconc(1), & tg, ratm, theta, thetasat, perc_slurry_mean, & - runoff, bsw, kads, fluxes(1:5,1), 5) + runoff, bsw, nh4_ads_coef, fluxes(1:5,1), 5) if (debug_fan) then if (any(isnan(fluxes))) then @@ -656,7 +658,7 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend ! water content at the mean age of the pool water_soil = water_in_layer * waterfunction(age_prev + 0.5*poolranges(indpl), water_relax_t) call eval_fluxes_soil(tanpools(indpl), water_soil, Hconc(indpl), tg, & - & ratm, theta, thetasat, percolation, runoff, bsw, kads, & + & ratm, theta, thetasat, percolation, runoff, bsw, nh4_ads_coef, & & dz_layer, fluxes(1:5,indpl), subst_tan, 5, status) if (status /= 0) return @@ -723,7 +725,7 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend real(r8) :: tanpools_old(size(tanpools)), imbalance, water_relax_t integer :: indpl - real(r8), parameter :: kads = 1.0_r8 + !real(r8), parameter :: kads = 1.0_r8 logical :: fixed if (size_fluxes < 5) then @@ -791,7 +793,7 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend ! water content at the middle of the age range water_soil = water_into_layer * waterfunction(age_prev + 0.5*poolranges(indpl), water_relax_t) call eval_fluxes_soil(tanpools(indpl), water_soil, Hconc(indpl), tg, & - & ratm, theta, thetasat, percolation, runoff, bsw, kads, & + & ratm, theta, thetasat, percolation, runoff, bsw, nh4_ads_coef, & & dz_layer, fluxes(1:5,indpl), subst_tan, 5, status) if (status /= 0) then return From 46ff6f7620a3f72abe71e46b0ba55e4e6041a327 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Sat, 20 Jul 2019 15:26:59 -0600 Subject: [PATCH 081/181] add comments to the tsl tend evaluation --- src/biogeophys/HydrologyNoDrainageMod.F90 | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/biogeophys/HydrologyNoDrainageMod.F90 b/src/biogeophys/HydrologyNoDrainageMod.F90 index c8e77c4b7a..3696a9d4e5 100644 --- a/src/biogeophys/HydrologyNoDrainageMod.F90 +++ b/src/biogeophys/HydrologyNoDrainageMod.F90 @@ -276,8 +276,10 @@ subroutine HydrologyNoDrainage(bounds, & call Compute_EffecRootFrac_And_VertTranSink(bounds, num_hydrologyc, & filter_hydrologyc, soilstate_inst, canopystate_inst, waterfluxbulk_inst, energyflux_inst) + + ! save the h2osoi_liq in top layer before evaluating the soilwater movement + if ( use_fan ) call store_tsl_moisture(waterstatebulk_inst) - if ( use_fan ) call store_tsl_moisture(waterstatebulk_inst) if ( use_fates ) then call clm_fates%ComputeRootSoilFlux(bounds, num_hydrologyc, filter_hydrologyc, soilstate_inst, waterfluxbulk_inst) end if @@ -285,7 +287,8 @@ subroutine HydrologyNoDrainage(bounds, & call SoilWater(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, filter_urbanc, & soilhydrology_inst, soilstate_inst, waterfluxbulk_inst, waterstatebulk_inst, temperature_inst, & canopystate_inst, energyflux_inst, soil_water_retention_curve) - if ( use_fan ) call eval_tsl_moist_tend(waterstatebulk_inst) + ! + if ( use_fan ) call eval_tsl_moist_tend(waterstatebulk_inst) ! use the saved value to calculate the tendency if (use_vichydro) then ! mapping soilmoist from CLM to VIC layers for runoff calculations @@ -658,6 +661,9 @@ subroutine HydrologyNoDrainage(bounds, & contains + + ! Subroutines for storing the time derivative of top most soil layer moisture. This is + ! used for diagnosing the downwards moisture flux within FAN. subroutine store_tsl_moisture(waterstatebulk_inst) type(waterstatebulk_type), intent(inout) :: waterstatebulk_inst From 9a4b1fc12835d6582054b04cac4227470ad8dc49 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 24 Jul 2019 14:25:55 -0600 Subject: [PATCH 082/181] change the runoff variable to qflx_surf --- src/biogeochem/Fan2CTSMMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index 5d15049ee7..d459a893d7 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -367,7 +367,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & theta = min(theta, 0.98_r8*thetasat) infiltr_m_s = max(waterfluxbulk_inst%qflx_infl_col(c), 0.0) * 1e-3 evap_m_s = waterfluxbulk_inst%qflx_evap_grnd_col(c) * 1e-3 - runoff_m_s = max(waterfluxbulk_inst%qflx_runoff_col(c), 0.0) * 1e-3 + runoff_m_s = max(waterfluxbulk_inst%qflx_surf_col(c), 0.0) * 1e-3 if (runoff_m_s > 1.0_r8) then runoff_m_s = 0.0_r8 end if From 34f3af1daa13447c00c6165281e9cfe49bb17806 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Mon, 29 Jul 2019 11:21:13 -0600 Subject: [PATCH 083/181] Changed array assignments to filter loops --- src/biogeophys/HydrologyNoDrainageMod.F90 | 41 ++++++++++++++++------- 1 file changed, 29 insertions(+), 12 deletions(-) diff --git a/src/biogeophys/HydrologyNoDrainageMod.F90 b/src/biogeophys/HydrologyNoDrainageMod.F90 index 3696a9d4e5..fbbd29f450 100644 --- a/src/biogeophys/HydrologyNoDrainageMod.F90 +++ b/src/biogeophys/HydrologyNoDrainageMod.F90 @@ -278,7 +278,7 @@ subroutine HydrologyNoDrainage(bounds, & filter_hydrologyc, soilstate_inst, canopystate_inst, waterfluxbulk_inst, energyflux_inst) ! save the h2osoi_liq in top layer before evaluating the soilwater movement - if ( use_fan ) call store_tsl_moisture(waterstatebulk_inst) + if ( use_fan ) call store_tsl_moisture(waterstatebulk_inst, filter_hydrologyc, num_hydrologyc) if ( use_fates ) then call clm_fates%ComputeRootSoilFlux(bounds, num_hydrologyc, filter_hydrologyc, soilstate_inst, waterfluxbulk_inst) @@ -287,8 +287,9 @@ subroutine HydrologyNoDrainage(bounds, & call SoilWater(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, filter_urbanc, & soilhydrology_inst, soilstate_inst, waterfluxbulk_inst, waterstatebulk_inst, temperature_inst, & canopystate_inst, energyflux_inst, soil_water_retention_curve) - ! - if ( use_fan ) call eval_tsl_moist_tend(waterstatebulk_inst) ! use the saved value to calculate the tendency + + ! use the saved value to calculate the tendency + if ( use_fan ) call eval_tsl_moist_tend(waterstatebulk_inst , filter_hydrologyc, num_hydrologyc) if (use_vichydro) then ! mapping soilmoist from CLM to VIC layers for runoff calculations @@ -665,19 +666,35 @@ subroutine HydrologyNoDrainage(bounds, & ! Subroutines for storing the time derivative of top most soil layer moisture. This is ! used for diagnosing the downwards moisture flux within FAN. - subroutine store_tsl_moisture(waterstatebulk_inst) + subroutine store_tsl_moisture(waterstatebulk_inst, filter, num_fc) type(waterstatebulk_type), intent(inout) :: waterstatebulk_inst - associate(h2osoi_tend_tsl => waterstatebulk_inst%h2osoi_tend_tsl_col(bounds%begc:bounds%endc), & - h2osoi_liq_tsl => waterstatebulk_inst%h2osoi_liq_col(bounds%begc:bounds%endc,1)) - h2osoi_tend_tsl = h2osoi_liq_tsl - end associate + integer, intent(in) :: filter(:) + integer, intent(in) :: num_fc + + integer :: fc, c + + do fc = 1, num_fc + c = filter(fc) + waterstatebulk_inst%h2osoi_tend_tsl_col(c) = waterstatebulk_inst%h2osoi_liq_col(c,1) + end do + end subroutine store_tsl_moisture - subroutine eval_tsl_moist_tend(waterstatebulk_inst) + subroutine eval_tsl_moist_tend(waterstatebulk_inst, filter, num_fc) type(waterstatebulk_type), intent(inout) :: waterstatebulk_inst - associate(h2osoi_tend_tsl => waterstatebulk_inst%h2osoi_tend_tsl_col(bounds%begc:bounds%endc), & - h2osoi_liq_tsl => waterstatebulk_inst%h2osoi_liq_col(bounds%begc:bounds%endc,1)) - h2osoi_tend_tsl = (h2osoi_liq_tsl - h2osoi_tend_tsl) / dtime + integer, intent(in) :: filter(:) + integer, intent(in) :: num_fc + + integer :: fc, c + + associate(h2osoi_tend_tsl => waterstatebulk_inst%h2osoi_tend_tsl_col, & + h2osoi_liq => waterstatebulk_inst%h2osoi_liq_col) + + do fc = 1, num_fc + c = filter(fc) + h2osoi_tend_tsl(c) = (h2osoi_liq(c,1) - h2osoi_tend_tsl(c)) / dtime + end do + end associate end subroutine eval_tsl_moist_tend From 638f58fcabb6bad394353b987c4e9dede77c6417 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Mon, 29 Jul 2019 11:21:34 -0600 Subject: [PATCH 084/181] Moved FAN soil moisture tendency to waterstatebulktype --- src/biogeophys/WaterStateBulkType.F90 | 17 +++++++++++++++-- src/biogeophys/WaterStateType.F90 | 17 +---------------- 2 files changed, 16 insertions(+), 18 deletions(-) diff --git a/src/biogeophys/WaterStateBulkType.F90 b/src/biogeophys/WaterStateBulkType.F90 index 3c7db77798..8b5bd43631 100644 --- a/src/biogeophys/WaterStateBulkType.F90 +++ b/src/biogeophys/WaterStateBulkType.F90 @@ -15,6 +15,7 @@ module WaterStateBulkType use decompMod , only : bounds_type use clm_varpar , only : nlevgrnd, nlevsno use clm_varcon , only : spval + use clm_varctl , only : use_fan use WaterStateType , only : waterstate_type use WaterInfoBaseType, only : water_info_base_type use WaterTracerContainerType, only : water_tracer_container_type @@ -28,7 +29,7 @@ module WaterStateBulkType real(r8), pointer :: snow_persistence_col (:) ! col length of time that ground has had non-zero snow thickness (sec) real(r8), pointer :: int_snow_col (:) ! col integrated snowfall (mm H2O) - + real(r8), pointer :: h2osoi_tend_tsl_col (:) ! col moisture tendency due to vertical movement at topmost layer (m3/m3/s) contains @@ -105,6 +106,9 @@ subroutine InitBulkAllocate(this, bounds) allocate(this%snow_persistence_col (begc:endc)) ; this%snow_persistence_col (:) = nan allocate(this%int_snow_col (begc:endc)) ; this%int_snow_col (:) = nan + if (use_fan) then + allocate(this%h2osoi_tend_tsl_col(begc:endc)); this%h2osoi_tend_tsl_col(:) = nan + end if @@ -161,6 +165,14 @@ subroutine InitBulkHistory(this, bounds) long_name=this%info%lname('Length of time of continuous snow cover (nat. veg. landunits only)'), & ptr_col=this%snow_persistence_col, l2g_scale_type='natveg') + if (use_fan) then + this%h2osoi_tend_tsl_col(begc:endc) = spval + call hist_addfld1d ( & + fname='SOILWATERTEND_TSL', units='kg/m2/s', & + avgflag='A', long_name='Tendency of soil water in the topmost soil layer', & + ptr_col=this%h2osoi_tend_tsl_col, l2g_scale_type='veg', & + default='inactive') + end if end subroutine InitBulkHistory @@ -185,8 +197,9 @@ subroutine InitBulkCold(this, bounds, & do c = bounds%begc,bounds%endc this%int_snow_col(c) = h2osno_input_col(c) this%snow_persistence_col(c) = 0._r8 + if (use_fan) this%h2osoi_tend_tsl_col(c) = 0._r8 end do - + end subroutine InitBulkCold !------------------------------------------------------------------------ diff --git a/src/biogeophys/WaterStateType.F90 b/src/biogeophys/WaterStateType.F90 index 1196b9aa8f..c39a991b1e 100644 --- a/src/biogeophys/WaterStateType.F90 +++ b/src/biogeophys/WaterStateType.F90 @@ -13,7 +13,7 @@ module WaterStateType use abortutils , only : endrun use decompMod , only : bounds_type use decompMod , only : BOUNDS_SUBGRID_PATCH, BOUNDS_SUBGRID_COLUMN - use clm_varctl , only : use_bedrock, iulog, use_fan + use clm_varctl , only : use_bedrock, iulog use clm_varpar , only : nlevgrnd, nlevsoi, nlevurb, nlevsno use clm_varcon , only : spval use LandunitType , only : lun @@ -34,7 +34,6 @@ module WaterStateType real(r8), pointer :: h2osno_col (:) ! col snow water (mm H2O) real(r8), pointer :: h2osoi_liq_col (:,:) ! col liquid water (kg/m2) (new) (-nlevsno+1:nlevgrnd) real(r8), pointer :: h2osoi_ice_col (:,:) ! col ice lens (kg/m2) (new) (-nlevsno+1:nlevgrnd) - real(r8), pointer :: h2osoi_tend_tsl_col (:) ! col moisture tendency due to vertical movement at topmost layer (m3/m3/s) real(r8), pointer :: h2osoi_vol_col (:,:) ! col volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] (nlevgrnd) real(r8), pointer :: h2ocan_patch (:) ! patch canopy water (mm H2O) real(r8), pointer :: h2osfc_col (:) ! col surface water (mm H2O) @@ -135,11 +134,6 @@ subroutine InitAllocate(this, bounds, tracer_vars) call AllocateVar1d(var = this%wa_col, name = 'wa_col', & container = tracer_vars, & bounds = bounds, subgrid_level = BOUNDS_SUBGRID_COLUMN) - if (use_fan) then - call AllocateVar1d(var = this%h2osoi_tend_tsl_col, name = 'h2osoi_tend_tsl_col', & - container = tracer_vars, & - bounds = bounds, subgrid_level = BOUNDS_SUBGRID_COLUMN) - end if end subroutine InitAllocate @@ -218,13 +212,6 @@ subroutine InitHistory(this, bounds) long_name=this%info%lname('soil ice (vegetated landunits only)'), & ptr_col=data2dptr, l2g_scale_type='veg') - if (use_fan) then - this%h2osoi_tend_tsl_col(begc:endc) = spval - call hist_addfld1d (fname='SOILWATERTEND_TSL', units='kg/m2/s', & - avgflag='A', long_name='Tendency of volumetric soil water in the topmost soil layer', & - ptr_col=this%h2osoi_tend_tsl_col, set_urb=spval, set_lake=spval, l2g_scale_type='veg', & - default='inactive') - end if this%h2ocan_patch(begp:endp) = spval call hist_addfld1d ( & @@ -427,8 +414,6 @@ subroutine InitCold(this, bounds, & end if end do end if - if (use_fan) this%h2osoi_tend_tsl_col(c) = 0.0_r8 - end do From 0865091a5176c55bb51d7efc2715607bd3183608 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Tue, 30 Jul 2019 16:18:35 -0600 Subject: [PATCH 085/181] separate variables for moisture tendency and moisture before SoilWater call --- src/biogeophys/HydrologyNoDrainageMod.F90 | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/src/biogeophys/HydrologyNoDrainageMod.F90 b/src/biogeophys/HydrologyNoDrainageMod.F90 index fbbd29f450..6c5cb3efd6 100644 --- a/src/biogeophys/HydrologyNoDrainageMod.F90 +++ b/src/biogeophys/HydrologyNoDrainageMod.F90 @@ -165,6 +165,7 @@ subroutine HydrologyNoDrainage(bounds, & real(r8) :: rwat(bounds%begc:bounds%endc) ! soil water wgted by depth to maximum depth of 0.5 m real(r8) :: swat(bounds%begc:bounds%endc) ! same as rwat but at saturation real(r8) :: rz(bounds%begc:bounds%endc) ! thickness of soil layers contributing to rwat (m) + real(r8) :: h2osoi_liq_saved(bounds%begc:bounds%endc) ! h2osoi_liq_col in topmost layer before calling SoilWater real(r8) :: tsw ! volumetric soil water to 0.5 m real(r8) :: stsw ! volumetric soil water to 0.5 m at saturation real(r8) :: fracl ! fraction of soil layer contributing to 10cm total soil water @@ -277,8 +278,10 @@ subroutine HydrologyNoDrainage(bounds, & call Compute_EffecRootFrac_And_VertTranSink(bounds, num_hydrologyc, & filter_hydrologyc, soilstate_inst, canopystate_inst, waterfluxbulk_inst, energyflux_inst) - ! save the h2osoi_liq in top layer before evaluating the soilwater movement - if ( use_fan ) call store_tsl_moisture(waterstatebulk_inst, filter_hydrologyc, num_hydrologyc) + if ( use_fan ) then + ! save the h2osoi_liq in top layer before evaluating the soilwater movement + call store_tsl_moisture(waterstatebulk_inst, filter_hydrologyc, num_hydrologyc) + end if if ( use_fates ) then call clm_fates%ComputeRootSoilFlux(bounds, num_hydrologyc, filter_hydrologyc, soilstate_inst, waterfluxbulk_inst) @@ -288,8 +291,10 @@ subroutine HydrologyNoDrainage(bounds, & soilhydrology_inst, soilstate_inst, waterfluxbulk_inst, waterstatebulk_inst, temperature_inst, & canopystate_inst, energyflux_inst, soil_water_retention_curve) - ! use the saved value to calculate the tendency - if ( use_fan ) call eval_tsl_moist_tend(waterstatebulk_inst , filter_hydrologyc, num_hydrologyc) + if ( use_fan ) then + ! use the saved value to calculate the tendency + call eval_tsl_moist_tend(waterstatebulk_inst , filter_hydrologyc, num_hydrologyc) + end if if (use_vichydro) then ! mapping soilmoist from CLM to VIC layers for runoff calculations @@ -675,7 +680,7 @@ subroutine store_tsl_moisture(waterstatebulk_inst, filter, num_fc) do fc = 1, num_fc c = filter(fc) - waterstatebulk_inst%h2osoi_tend_tsl_col(c) = waterstatebulk_inst%h2osoi_liq_col(c,1) + h2osoi_liq_saved(c) = waterstatebulk_inst%h2osoi_liq_col(c,1) end do end subroutine store_tsl_moisture @@ -692,7 +697,7 @@ subroutine eval_tsl_moist_tend(waterstatebulk_inst, filter, num_fc) do fc = 1, num_fc c = filter(fc) - h2osoi_tend_tsl(c) = (h2osoi_liq(c,1) - h2osoi_tend_tsl(c)) / dtime + h2osoi_tend_tsl(c) = (h2osoi_liq(c,1) - h2osoi_liq_saved(c)) / dtime end do end associate From b110e2dda90aa162d35d045f31907b4bad5dad89 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 14 Aug 2019 17:17:28 +0300 Subject: [PATCH 086/181] add check for arctic grass in addition to others --- src/biogeochem/Fan2CTSMMod.F90 | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index d459a893d7..c05dc1403c 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -175,7 +175,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & use shr_sys_mod, only : shr_sys_flush use GridcellType, only: grc use abortutils, only : endrun - use pftconMod, only : nc4_grass, nc3_nonarctic_grass + use pftconMod, only : nc4_grass, nc3_nonarctic_grass, nc3_arctic_grass use landunit_varcon, only: istsoil, istcrop use clm_varcon, only : spval, ispval use decompMod, only : bounds_type @@ -334,7 +334,9 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & ratm = 0.0 patchcounter = 0 do p = col%patchi(c), col%patchf(c) - if (patch%itype(p) == nc4_grass .or. patch%itype(p) == nc3_nonarctic_grass) then + if ( patch%itype(p) == nc4_grass & + .or. patch%itype(p) == nc3_nonarctic_grass & + .or. patch%itype(p) == nc3_arctic_grass) then if (.not. patch%active(p) .or. ram1(p) == spval .or. rb1(p) == spval) cycle ratm = ratm + ram1(p) + rb1(p) patchcounter = patchcounter + 1 @@ -716,7 +718,7 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & ! native vegatation. ! use landunit_varcon, only : max_lunit - use pftconMod, only : nc4_grass, nc3_nonarctic_grass + use pftconMod, only : nc4_grass, nc3_nonarctic_grass, nc3_arctic_grass use clm_varcon, only : ispval use landunit_varcon, only: istsoil, istcrop use abortutils , only : endrun @@ -764,6 +766,7 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & real(r8) :: fluxes_nitr(4,2), fluxes_tan(4,2) ! The fraction of manure applied continuously on grasslands (if present in the gridcell) real(r8), parameter :: kg_to_g = 1e3_r8 + logical :: is_grass begg = bounds%begg; endg = bounds%endg nh3_flux_stores(bounds%begc:bounds%endc) = 0_r8 @@ -782,8 +785,10 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & if (l == ispval) cycle if (lun%itype(l) == istsoil) then do p = lun%patchi(l), lun%patchf(l) - if ((patch%itype(p) == nc4_grass .or. patch%itype(p) == nc3_nonarctic_grass) & - .and. col%wtgcell(patch%column(p)) > 1e-6) then + is_grass = patch%itype(p) == nc4_grass & + .or. patch%itype(p) == nc3_nonarctic_grass & + .or. patch%itype(p) == nc3_arctic_grass + if (is_grass .and. col%wtgcell(patch%column(p)) > 1e-6) then col_grass = patch%column(p) exit end if From f8813d4df383edaeba5ad6c13a772a92dc53330f Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 14 Aug 2019 17:25:57 +0300 Subject: [PATCH 087/181] Remove !JV and !KO comments --- bld/CLMBuildNamelist.pm | 3 --- src/biogeochem/CNDriverMod.F90 | 6 ----- src/biogeochem/CNVegCarbonStateType.F90 | 19 --------------- src/biogeochem/CNVegNitrogenStateType.F90 | 9 ------- src/biogeochem/CNVegetationFacade.F90 | 2 -- src/biogeophys/HydrologyNoDrainageMod.F90 | 3 --- src/main/atm2lndType.F90 | 12 ++-------- src/main/clm_initializeMod.F90 | 9 ------- src/main/clm_varctl.F90 | 2 -- src/main/controlMod.F90 | 4 ---- src/main/fanStreamMod.F90 | 2 -- .../SoilBiogeochemCarbonFluxType.F90 | 11 --------- .../SoilBiogeochemCompetitionMod.F90 | 24 ------------------- .../SoilBiogeochemNitrogenFluxType.F90 | 6 +---- .../SoilBiogeochemNitrogenStateType.F90 | 14 +---------- 15 files changed, 4 insertions(+), 122 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 07289ad0c4..d9862e3816 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -2867,7 +2867,6 @@ sub setup_logic_fertilizer { #------------------------------------------------------------------------------- -#!KO sub setup_logic_fan { # # Flags to control FAN (Flow of Agricultural Nitrogen) nitrogen deposition (manure and fertilizer) @@ -2921,7 +2920,6 @@ sub setup_logic_fan { } #------------------------------------------------------------------------------- -#!KO sub setup_logic_grainproduct { # @@ -3081,7 +3079,6 @@ sub setup_logic_nitrogen_deposition { #------------------------------------------------------------------------------- -#!KO sub setup_logic_fan_nml { my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_; diff --git a/src/biogeochem/CNDriverMod.F90 b/src/biogeochem/CNDriverMod.F90 index b0ca0620ab..73c87efa41 100644 --- a/src/biogeochem/CNDriverMod.F90 +++ b/src/biogeochem/CNDriverMod.F90 @@ -184,9 +184,7 @@ subroutine CNDriverNoLeaching(bounds, type(photosyns_type) , intent(in) :: photosyns_inst type(saturated_excess_runoff_type) , intent(in) :: saturated_excess_runoff_inst type(energyflux_type) , intent(in) :: energyflux_inst -!KO type(frictionvel_type) , intent(inout) :: frictionvel_inst -!KO class(nutrient_competition_method_type) , intent(inout) :: nutrient_competition_method class(cnfire_method_type) , intent(inout) :: cnfire_method ! @@ -271,9 +269,6 @@ subroutine CNDriverNoLeaching(bounds, ! -------------------------------------------------- call t_startf('CNDeposition') -!KO call CNNDeposition(bounds, & -!KO atm2lnd_inst, soilbiogeochem_nitrogenflux_inst) -!KO call CNNDeposition(bounds, num_soilc, filter_soilc, & atm2lnd_inst, wateratm2lndbulk_inst, & soilbiogeochem_nitrogenflux_inst, cnveg_carbonstate_inst, & @@ -281,7 +276,6 @@ subroutine CNDriverNoLeaching(bounds, cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & waterstatebulk_inst, soilstate_inst, temperature_inst, & waterfluxbulk_inst, frictionvel_inst) -!KO call t_stopf('CNDeposition') if(use_fun)then diff --git a/src/biogeochem/CNVegCarbonStateType.F90 b/src/biogeochem/CNVegCarbonStateType.F90 index f51a98614c..044629c3fa 100644 --- a/src/biogeochem/CNVegCarbonStateType.F90 +++ b/src/biogeochem/CNVegCarbonStateType.F90 @@ -11,10 +11,7 @@ module CNVegCarbonStateType use shr_log_mod , only : errMsg => shr_log_errMsg use pftconMod , only : noveg, npcropmin, pftcon use clm_varcon , only : spval, c3_r2, c4_r2, c14ratio -!KO use clm_varctl , only : iulog, use_cndv, use_crop -!KO use clm_varctl , only : iulog, use_cndv, use_crop, use_fan -!KO use decompMod , only : bounds_type use abortutils , only : endrun use spmdMod , only : masterproc @@ -39,10 +36,8 @@ module CNVegCarbonStateType real(r8), pointer :: grainc_xfer_patch (:) ! (gC/m2) grain C transfer (crop model) real(r8), pointer :: leafc_patch (:) ! (gC/m2) leaf C real(r8), pointer :: leafc_storage_patch (:) ! (gC/m2) leaf C storage -!KO real(r8), pointer :: leafc_manure_patch (:) ! (gC/m2) leaf C eaten by cows real(r8), pointer :: deadstemc_manure_patch (:) ! (gC/m2) dead stem C eaten by cows -!KO real(r8), pointer :: leafc_xfer_patch (:) ! (gC/m2) leaf C transfer real(r8), pointer :: leafc_storage_xfer_acc_patch (:) ! (gC/m2) Accmulated leaf C transfer real(r8), pointer :: storage_cdemand_patch (:) ! (gC/m2) C use from the C storage pool @@ -74,9 +69,7 @@ module CNVegCarbonStateType real(r8), pointer :: deadstemc_col (:) ! (gC/m2) column-level deadstemc (fire) real(r8), pointer :: fuelc_col (:) ! fuel load outside cropland real(r8), pointer :: fuelc_crop_col (:) ! fuel load for cropland -!KO real(r8), pointer :: total_leafc_col (:) ! (gC/m2) total C at column-level -!KO real(r8), pointer :: cropseedc_deficit_patch (:) ! (gC/m2) pool for seeding new crop growth; this is a NEGATIVE term, indicating the amount of seed usage that needs to be repaid ! pools for dynamic landcover @@ -226,12 +219,10 @@ subroutine InitAllocate(this, bounds) begg = bounds%begg; endg = bounds%endg allocate(this%leafc_patch (begp:endp)) ; this%leafc_patch (:) = nan -!KO if ( use_fan ) then allocate(this%leafc_manure_patch (begp:endp)) ; this%leafc_manure_patch (:) = nan allocate(this%deadstemc_manure_patch(begp:endp)) ; this%deadstemc_manure_patch (:) = nan end if -!KO allocate(this%leafc_storage_patch (begp:endp)) ; this%leafc_storage_patch (:) = nan allocate(this%leafc_xfer_patch (begp:endp)) ; this%leafc_xfer_patch (:) = nan allocate(this%leafc_storage_xfer_acc_patch (begp:endp)) ; this%leafc_storage_xfer_acc_patch (:) = nan @@ -272,11 +263,9 @@ subroutine InitAllocate(this, bounds) allocate(this%deadstemc_col (begc:endc)) ; this%deadstemc_col (:) = nan allocate(this%fuelc_col (begc:endc)) ; this%fuelc_col (:) = nan allocate(this%fuelc_crop_col (begc:endc)) ; this%fuelc_crop_col (:) = nan -!KO if ( use_fan ) then allocate(this%total_leafc_col (begc:endc)) ; this%total_leafc_col (:) = nan end if -!KO allocate(this%totvegc_patch (begp:endp)) ; this%totvegc_patch (:) = nan allocate(this%totvegc_col (begc:endc)) ; this%totvegc_col (:) = nan @@ -1014,11 +1003,9 @@ subroutine InitCold(this, bounds, ratio, carbon_type, c12_cnveg_carbonstate_inst this%totecosysc_col(c) = 0._r8 this%totc_p2c_col(c) = 0._r8 this%totc_col(c) = 0._r8 -!KO if ( use_fan ) then this%total_leafc_col(c)= 0._r8 end if -!KO end if end do @@ -2260,13 +2247,11 @@ subroutine Restart ( this, bounds, ncid, flag, carbon_type, reseed_dead_plants, call restartvar(ncid=ncid, flag=flag, varname='seedc_g', xtype=ncd_double, & dim1name='gridcell', long_name='', units='', & interpinic_flag='interp', readvar=readvar, data=this%seedc_grc) -!KO if ( use_fan ) then call restartvar(ncid=ncid, flag=flag, varname='total_leafc', xtype=ncd_double, & dim1name='column', long_name='', units='', & interpinic_flag='interp', readvar=readvar, data=this%total_leafc_col) end if -!KO end if !-------------------------------- @@ -2366,7 +2351,6 @@ subroutine SetValues ( this, & end if end do -!KO if ( use_fan ) then do fi = 1,num_patch i = filter_patch(fi) @@ -2374,7 +2358,6 @@ subroutine SetValues ( this, & this%deadstemc_manure_patch(i)= value_patch end do end if -!KO do fi = 1,num_column i = filter_column(fi) @@ -2389,14 +2372,12 @@ subroutine SetValues ( this, & this%totecosysc_col(i) = value_column end do -!KO if ( use_fan ) then do fi = 1,num_column i = filter_column(fi) this%total_leafc_col(i) = value_column end do end if -!KO end subroutine SetValues diff --git a/src/biogeochem/CNVegNitrogenStateType.F90 b/src/biogeochem/CNVegNitrogenStateType.F90 index 4ca8061877..92f2fee613 100644 --- a/src/biogeochem/CNVegNitrogenStateType.F90 +++ b/src/biogeochem/CNVegNitrogenStateType.F90 @@ -11,10 +11,7 @@ module CNVegNitrogenStateType use landunit_varcon , only : istcrop, istsoil use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_century_decomp use clm_varctl , only : iulog, override_bgc_restart_mismatch_dump -!KO use clm_varctl , only : use_crop -!KO use clm_varctl , only : use_crop, use_fan -!KO use CNSharedParamsMod , only : use_fun use decompMod , only : bounds_type use pftconMod , only : npcropmin, noveg, pftcon @@ -41,10 +38,8 @@ module CNVegNitrogenStateType real(r8), pointer :: grainn_storage_patch (:) ! (gN/m2) grain N storage (crop) real(r8), pointer :: grainn_xfer_patch (:) ! (gN/m2) grain N transfer (crop) real(r8), pointer :: leafn_patch (:) ! (gN/m2) leaf N -!KO real(r8), pointer :: leafn_manure_patch (:) ! (gN/m2) leaf N eaten by cows real(r8), pointer :: deadstemn_manure_patch (:) ! (gN/m2) dead stem N eaten by cows -!KO real(r8), pointer :: leafn_storage_patch (:) ! (gN/m2) leaf N storage real(r8), pointer :: leafn_xfer_patch (:) ! (gN/m2) leaf N transfer real(r8), pointer :: leafn_storage_xfer_acc_patch (:) ! (gN/m2) Accmulated leaf N transfer @@ -141,12 +136,10 @@ subroutine InitAllocate(this, bounds) allocate(this%grainn_storage_patch (begp:endp)) ; this%grainn_storage_patch (:) = nan allocate(this%grainn_xfer_patch (begp:endp)) ; this%grainn_xfer_patch (:) = nan allocate(this%leafn_patch (begp:endp)) ; this%leafn_patch (:) = nan -!KO if ( use_fan ) then allocate(this%leafn_manure_patch (begp:endp)) ; this%leafn_manure_patch (:) = nan allocate(this%deadstemn_manure_patch(begp:endp)) ; this%deadstemn_manure_patch (:) = nan end if -!KO allocate(this%leafn_storage_patch (begp:endp)) ; this%leafn_storage_patch (:) = nan allocate(this%leafn_xfer_patch (begp:endp)) ; this%leafn_xfer_patch (:) = nan allocate(this%leafn_storage_xfer_acc_patch (begp:endp)) ; this%leafn_storage_xfer_acc_patch (:) = nan @@ -904,7 +897,6 @@ subroutine SetValues ( this, & this%totn_patch(i) = value_patch end do -!KO if ( use_fan ) then do fi = 1,num_patch i = filter_patch(fi) @@ -912,7 +904,6 @@ subroutine SetValues ( this, & this%deadstemn_manure_patch(i)= value_patch end do end if -!KO if ( use_crop )then do fi = 1,num_patch diff --git a/src/biogeochem/CNVegetationFacade.F90 b/src/biogeochem/CNVegetationFacade.F90 index f994c2da93..4d56ae5945 100644 --- a/src/biogeochem/CNVegetationFacade.F90 +++ b/src/biogeochem/CNVegetationFacade.F90 @@ -835,9 +835,7 @@ subroutine EcosystemDynamicsPreDrainage(this, bounds, & type(photosyns_type) , intent(in) :: photosyns_inst type(saturated_excess_runoff_type) , intent(in) :: saturated_excess_runoff_inst type(energyflux_type) , intent(in) :: energyflux_inst -!KO type(frictionvel_type) , intent(inout) :: frictionvel_inst -!KO class(nutrient_competition_method_type) , intent(inout) :: nutrient_competition_method type(fireemis_type) , intent(inout) :: fireemis_inst ! diff --git a/src/biogeophys/HydrologyNoDrainageMod.F90 b/src/biogeophys/HydrologyNoDrainageMod.F90 index 6c5cb3efd6..782b548195 100644 --- a/src/biogeophys/HydrologyNoDrainageMod.F90 +++ b/src/biogeophys/HydrologyNoDrainageMod.F90 @@ -7,10 +7,7 @@ Module HydrologyNoDrainageMod use shr_kind_mod , only : r8 => shr_kind_r8 use shr_log_mod , only : errMsg => shr_log_errMsg use decompMod , only : bounds_type -!KO use clm_varctl , only : iulog, use_vichydro, use_fates -!KO use clm_varctl , only : iulog, use_vichydro, use_fan, use_fates -!KO use clm_varcon , only : e_ice, denh2o, denice, rpi, spval use CLMFatesInterfaceMod, only : hlm_fates_interface_type use atm2lndType , only : atm2lnd_type diff --git a/src/main/atm2lndType.F90 b/src/main/atm2lndType.F90 index 4d05570d55..c3bc46f668 100644 --- a/src/main/atm2lndType.F90 +++ b/src/main/atm2lndType.F90 @@ -10,10 +10,7 @@ module atm2lndType use shr_log_mod , only : errMsg => shr_log_errMsg use clm_varpar , only : numrad, ndst, nlevgrnd !ndst = number of dust bins. use clm_varcon , only : rair, grav, cpair, hfus, tfrz, spval -!KO use clm_varctl , only : iulog, use_c13, use_cn, use_lch4, use_cndv, use_fates, use_luna -!KO use clm_varctl , only : iulog, use_c13, use_cn, use_lch4, use_cndv, use_fates, use_luna, use_fan -!KO use decompMod , only : bounds_type use abortutils , only : endrun use PatchType , only : patch @@ -88,16 +85,15 @@ module atm2lndType real(r8), pointer :: forc_solai_grc (:,:) => null() ! diffuse radiation (numrad) (vis=forc_solsd, nir=forc_solld) real(r8), pointer :: forc_solar_grc (:) => null() ! incident solar radiation real(r8), pointer :: forc_ndep_grc (:) => null() ! nitrogen deposition rate (gN/m2/s) - !JV ! FAN manure N streams: all-grazing, seasonal-grazing, no-grazing real(r8), pointer :: forc_ndep_grz_grc (:) => null() ! FAN nitrogen deposition rate (gN/m2/s) real(r8), pointer :: forc_ndep_sgrz_grc (:) => null() ! FAN nitrogen deposition rate (gN/m2/s) real(r8), pointer :: forc_ndep_ngrz_grc (:) => null() ! FAN nitrogen deposition rate (gN/m2/s) - + ! FAN urea and nitrate N and soil pH real(r8), pointer :: forc_ndep_urea_grc (:) => null() ! FAN nitrogen deposition, urea fertilizer fraction real(r8), pointer :: forc_ndep_nitr_grc (:) => null() ! FAN nitrogen deposition, nitrate fertilizer fraction real(r8), pointer :: forc_soilph_grc (:) => null() ! FAN soil pH -!JV + real(r8), pointer :: forc_pc13o2_grc (:) => null() ! C13O2 partial pressure (Pa) real(r8), pointer :: forc_po2_grc (:) => null() ! O2 partial pressure (Pa) real(r8), pointer :: forc_po2_240_patch (:) => null() ! 10-day mean O2 partial pressure (Pa) @@ -493,7 +489,6 @@ subroutine InitAllocate(this, bounds) allocate(this%forc_solai_grc (begg:endg,numrad)) ; this%forc_solai_grc (:,:) = ival allocate(this%forc_solar_grc (begg:endg)) ; this%forc_solar_grc (:) = ival allocate(this%forc_ndep_grc (begg:endg)) ; this%forc_ndep_grc (:) = ival -!KO if ( use_fan ) then allocate(this%forc_ndep_grz_grc (begg:endg)) ; this%forc_ndep_grz_grc (:) = ival allocate(this%forc_ndep_sgrz_grc (begg:endg)) ; this%forc_ndep_sgrz_grc (:) = ival @@ -502,7 +497,6 @@ subroutine InitAllocate(this, bounds) allocate(this%forc_ndep_nitr_grc (begg:endg)) ; this%forc_ndep_nitr_grc (:) = ival allocate(this%forc_soilph_grc (begg:endg)) ; this%forc_soilph_grc (:) = ival end if -!KO allocate(this%forc_pc13o2_grc (begg:endg)) ; this%forc_pc13o2_grc (:) = ival allocate(this%forc_po2_grc (begg:endg)) ; this%forc_po2_grc (:) = ival allocate(this%forc_aer_grc (begg:endg,14)) ; this%forc_aer_grc (:,:) = ival @@ -1021,7 +1015,6 @@ subroutine Clean(this) deallocate(this%forc_solai_grc) deallocate(this%forc_solar_grc) deallocate(this%forc_ndep_grc) - !KO if (use_fan) then deallocate(this%forc_ndep_grz_grc) deallocate(this%forc_ndep_sgrz_grc) @@ -1029,7 +1022,6 @@ subroutine Clean(this) deallocate(this%forc_ndep_nitr_grc) deallocate(this%forc_ndep_urea_grc) deallocate(this%forc_soilph_grc) - !KO end if deallocate(this%forc_pc13o2_grc) deallocate(this%forc_po2_grc) diff --git a/src/main/clm_initializeMod.F90 b/src/main/clm_initializeMod.F90 index ce3171aec6..703063ef43 100644 --- a/src/main/clm_initializeMod.F90 +++ b/src/main/clm_initializeMod.F90 @@ -270,10 +270,7 @@ subroutine initialize2( ) use clm_varcon , only : spval use clm_varctl , only : finidat, finidat_interp_source, finidat_interp_dest, fsurdat use clm_varctl , only : use_century_decomp, single_column, scmlat, scmlon, use_cn, use_fates -!KO use clm_varctl , only : use_crop -!KO use clm_varctl , only : use_crop, use_fan, ndep_from_cpl -!KO use clm_varorb , only : eccen, mvelpp, lambm0, obliqr use clm_time_manager , only : get_step_size, get_curr_calday use clm_time_manager , only : get_curr_date, get_nstep, advance_timestep @@ -289,10 +286,6 @@ subroutine initialize2( ) use restFileMod , only : restFile_getfile, restFile_open, restFile_close use restFileMod , only : restFile_read, restFile_write use ndepStreamMod , only : ndep_init, ndep_interp -!KO - !use ndep2StreamMod , only : ndep2_init, ndep2_interp - !use ndep3StreamMod , only : ndep3_init, ndep3_interp - !KO use FanStreamMod , only : fanstream_init, fanstream_interp use LakeCon , only : LakeConInit use SatellitePhenologyMod , only : SatellitePhenologyInit, readAnnualVegetation, interpMonthlyVeg @@ -578,14 +571,12 @@ subroutine initialize2( ) call ndep_interp(bounds_proc, atm2lnd_inst) end if call t_stopf('init_ndep') -!KO if ( use_fan ) then call t_startf('init_ndep2') call fanstream_init(bounds_proc, NLFilename) call fanstream_interp(bounds_proc, atm2lnd_inst) call t_stopf('init_ndep2') end if -!KO end if ! ------------------------------------------------------------------------ diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index 17b15a04ab..c1ede10492 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -263,13 +263,11 @@ module clm_varctl logical, public :: use_hydrstress = .false. ! true => use plant hydraulic stress calculation -!KO !---------------------------------------------------------- ! FAN (Flow of Agricultural Nitrogen) switch !---------------------------------------------------------- logical, public :: use_fan = .false. ! true => use FAN model -!KO !---------------------------------------------------------- ! dynamic root switch diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index 1f1b42f83a..0d85d92365 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -694,9 +694,7 @@ subroutine control_spmd() call mpi_bcast (use_hydrstress, 1, MPI_LOGICAL, 0, mpicom, ier) -!KO call mpi_bcast (use_fan, 1, MPI_LOGICAL, 0, mpicom, ier) -!KO call mpi_bcast (use_dynroot, 1, MPI_LOGICAL, 0, mpicom, ier) @@ -952,9 +950,7 @@ subroutine control_print () write(iulog,*) ' land-ice albedos (unitless 0-1) = ', albice write(iulog,*) ' soil layer structure = ', soil_layerstruct write(iulog,*) ' plant hydraulic stress = ', use_hydrstress -!KO write(iulog,*) ' FAN = ', use_fan -!KO write(iulog,*) ' dynamic roots = ', use_dynroot if (nsrest == nsrContinue) then write(iulog,*) 'restart warning:' diff --git a/src/main/fanStreamMod.F90 b/src/main/fanStreamMod.F90 index 468f6f3627..ee1af9d6a2 100644 --- a/src/main/fanStreamMod.F90 +++ b/src/main/fanStreamMod.F90 @@ -22,9 +22,7 @@ module FanStreamMod use fileutils , only: getavu, relavu use decompMod , only: bounds_type, ldecomp, gsmap_lnd_gdc2glo use domainMod , only: ldomain -!KO use ndepStreamMod, only: clm_domain_mct -!KO ! !PUBLIC TYPES: implicit none diff --git a/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 index 275fd36ff7..4d94616bd5 100644 --- a/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 @@ -11,10 +11,7 @@ module SoilBiogeochemCarbonFluxType use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con use ColumnType , only : col use LandunitType , only : lun -!KO use clm_varctl , only : use_ed -!KO use clm_varctl , only : use_fates, use_fan -!KO ! ! !PUBLIC TYPES: @@ -35,11 +32,9 @@ module SoilBiogeochemCarbonFluxType real(r8), pointer :: decomp_k_col (:,:,:) ! rate constant for decomposition (1./sec) real(r8), pointer :: hr_vr_col (:,:) ! (gC/m3/s) total vertically-resolved het. resp. from decomposing C pools real(r8), pointer :: o_scalar_col (:,:) ! fraction by which decomposition is limited by anoxia -!KO real(r8), pointer :: soi_gd_col (:,:) !KO real(r8), pointer :: cmanure_to_sminn_col (:) ! (gC/m2/s) deposition of C from manure to soil mineral C real(r8), pointer :: methane_manure_col (:) ! (gC/m2/s) emission of CH4 from cows -!KO real(r8), pointer :: w_scalar_col (:,:) ! fraction by which decomposition is limited by moisture availability real(r8), pointer :: t_scalar_col (:,:) ! fraction by which decomposition is limited by temperature real(r8), pointer :: som_c_leached_col (:) ! (gC/m^2/s) total SOM C loss from vertical transport @@ -106,13 +101,11 @@ subroutine InitAllocate(this, bounds) allocate(this%t_scalar_col (begc:endc,1:nlevdecomp_full)); this%t_scalar_col (:,:) =spval allocate(this%w_scalar_col (begc:endc,1:nlevdecomp_full)); this%w_scalar_col (:,:) =spval allocate(this%o_scalar_col (begc:endc,1:nlevdecomp_full)); this%o_scalar_col (:,:) =spval -!KO if ( use_fan ) then allocate(this%soi_gd_col (begc:endc,1:nlevdecomp_full)) ; this%soi_gd_col (:,:) = spval allocate(this%cmanure_to_sminn_col (begc:endc)) ; this%cmanure_to_sminn_col (:) = nan allocate(this%methane_manure_col (begc:endc)) ; this%methane_manure_col (:) = nan end if -!KO allocate(this%phr_vr_col (begc:endc,1:nlevdecomp_full)); this%phr_vr_col (:,:) =nan allocate(this%fphr_col (begc:endc,1:nlevgrnd)) ; this%fphr_col (:,:) =nan allocate(this%som_c_leached_col (begc:endc)) ; this%som_c_leached_col (:) =nan @@ -214,7 +207,6 @@ subroutine InitHistory(this, bounds, carbon_type) call hist_addfld1d (fname='HR', units='gC/m^2/s', & avgflag='A', long_name='total heterotrophic respiration', & ptr_col=this%hr_col) -!KO if ( use_fan ) then this%cmanure_to_sminn_col(begc:endc) = spval @@ -228,7 +220,6 @@ subroutine InitHistory(this, bounds, carbon_type) ptr_col=this%methane_manure_col) end if -!KO this%lithr_col(begc:endc) = spval call hist_addfld1d (fname='LITTERC_HR', units='gC/m^2/s', & @@ -737,7 +728,6 @@ subroutine SetValues ( this, num_column, filter_column, value_column) this%soilc_change_col(i) = value_column end do -!KO if ( use_fan ) then do j = 1, nlevdecomp_full do fi = 1,num_column @@ -751,7 +741,6 @@ subroutine SetValues ( this, num_column, filter_column, value_column) this%methane_manure_col(i) = value_column end do end if -!KO ! NOTE: do not zero the fates to BGC C flux variables since they need to persist from the daily fates timestep s to the half-hourly BGC timesteps. I.e. FATES_c_to_litr_lab_c_col, FATES_c_to_litr_cel_c_col, FATES_c_to_litr_lig_c_col diff --git a/src/soilbiogeochem/SoilBiogeochemCompetitionMod.F90 b/src/soilbiogeochem/SoilBiogeochemCompetitionMod.F90 index f43c681911..485beaadbd 100644 --- a/src/soilbiogeochem/SoilBiogeochemCompetitionMod.F90 +++ b/src/soilbiogeochem/SoilBiogeochemCompetitionMod.F90 @@ -174,10 +174,7 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, soilbiogeochem_nitrogenflux_inst,canopystate_inst) ! ! !USES: -!KO use clm_varctl , only: cnallocate_carbon_only, iulog -!KO use clm_varctl , only: cnallocate_carbon_only, iulog, use_fan -!KO use clm_varpar , only: nlevdecomp, ndecomp_cascade_transitions use clm_varcon , only: nitrif_n2o_loss_frac use CNSharedParamsMod, only: use_fun @@ -237,9 +234,7 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, real(r8) :: residual_smin_no3(bounds%begc:bounds%endc) real(r8) :: residual_plant_ndemand(bounds%begc:bounds%endc) real(r8) :: sminn_to_plant_new(bounds%begc:bounds%endc) -!KO real(r8) :: smin_nh4_vr_factor ! factor to reduce smin_nh4_nr if use_fan is true -!KO !----------------------------------------------------------------------- associate( & @@ -285,16 +280,6 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, ! column loops to resolve plant/heterotroph competition for mineral N -!KO The following implements code that was in clm4_0_60. However, per Peter -! Hess, this code is not part of FAN per se and so we comment it out for now. -! If uncommented, this changes CLM answers in certain cases. -! if ( use_fan ) then -! smin_nh4_vr_factor = 0.1_r8 -! else -! smin_nh4_vr_factor = 1.0_r8 -! end if -!KO - sminn_to_plant_new(bounds%begc:bounds%endc) = 0._r8 local_use_fun = use_fun @@ -563,12 +548,6 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, potential_immob_vr(c,j)*compet_decomp_nh4 + pot_f_nit_vr(c,j)*compet_nit if (sum_nh4_demand(c,j)*dt < smin_nh4_vr(c,j)) then -!KO -! The following implements code that was in clm4_0_60. However, per Peter -! Hess, this code is not part of FAN per se and so we comment it out for now. -! If uncommented, this changes CLM answers in certain cases. -! if (sum_nh4_demand(c,j)*dt < smin_nh4_vr_factor * smin_nh4_vr(c,j)) then -!KO ! NH4 availability is not limiting immobilization or plant ! uptake, and all can proceed at their potential rates @@ -800,10 +779,7 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, sminn_to_plant_fun_no3_vr(c,j),smin_no3_to_plant_vr(c,j) call endrun("too much NO3 uptake predicted by FUN") end if -!KO if ((sminn_to_plant_fun_nh4_vr(c,j)-smin_nh4_to_plant_vr(c,j)).gt.0.0000000000001_r8) then -!KO if ((sminn_to_plant_fun_nh4_vr(c,j)-smin_nh4_to_plant_vr(c,j)).gt.0.0000001_r8) then -!KO write(iulog,*) 'problem with limitations on nh4 uptake', & sminn_to_plant_fun_nh4_vr(c,j),smin_nh4_to_plant_vr(c,j) call endrun("too much NH4 uptake predicted by FUN") diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 index 161749ae4f..cdd5eed95a 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 @@ -7,10 +7,7 @@ module SoilBiogeochemNitrogenFluxType use clm_varpar , only : nlevdecomp_full, nlevdecomp use clm_varcon , only : spval, ispval, dzsoi_decomp use decompMod , only : bounds_type -!KO use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_crop -!KO use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_crop, use_fan -!KO use CNSharedParamsMod , only : use_fun use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con use abortutils , only : endrun @@ -30,7 +27,7 @@ module SoilBiogeochemNitrogenFluxType real(r8), pointer :: fert_to_sminn_col (:) ! col fertilizer N to soil mineral N (gN/m2/s) real(r8), pointer :: soyfixn_to_sminn_col (:) ! col soybean fixation to soil mineral N (gN/m2/s) - !JV FAN fluxes + ! FAN fluxes real(r8), pointer :: man_tan_appl_col (:) ! Manure TAN applied on soil (gN/m2/s) real(r8), pointer :: man_n_appl_col (:) ! Manure N (TAN+organic) applied on soil (gN/m2/s) real(r8), pointer :: man_n_grz_col (:) ! Manure N from grazing animals (gN/m2/s) @@ -209,7 +206,6 @@ subroutine InitAllocate(this, bounds) allocate(this%fert_to_sminn_col (begc:endc)) ; this%fert_to_sminn_col (:) = nan allocate(this%soyfixn_to_sminn_col (begc:endc)) ; this%soyfixn_to_sminn_col (:) = nan - !JV if (use_fan) then allocate(this%man_tan_appl_col (begc:endc)) ; this%man_tan_appl_col (:) = spval allocate(this%man_n_appl_col (begc:endc)) ; this%man_n_appl_col (:) = spval diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 index e8e93a1028..cae7b7b475 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 @@ -11,10 +11,7 @@ module SoilBiogeochemNitrogenStateType use clm_varpar , only : ndecomp_cascade_transitions, ndecomp_pools, nlevcan use clm_varpar , only : nlevdecomp_full, nlevdecomp, nlevsoi use clm_varcon , only : spval, dzsoi_decomp, zisoi -!KO use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_century_decomp -!KO use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_century_decomp, use_fan -!KO use clm_varctl , only : iulog, override_bgc_restart_mismatch_dump, spinup_state use landunit_varcon , only : istcrop, istsoil use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con @@ -41,7 +38,7 @@ module SoilBiogeochemNitrogenStateType real(r8), pointer :: smin_nh4_vr_col (:,:) ! col (gN/m3) vertically-resolved soil mineral NH4 real(r8), pointer :: smin_nh4_col (:) ! col (gN/m2) soil mineral NH4 pool - !JV, FAN + ! FAN real(r8), pointer :: tan_g1_col(:) ! col (gN/m2) total ammoniacal N in FAN pool G1 real(r8), pointer :: tan_g2_col(:) ! col (gN/m2) total ammoniacal N in FAN pool G2 real(r8), pointer :: tan_g3_col(:) ! col (gN/m2) total ammoniacal N in FAN pool G2 @@ -168,7 +165,6 @@ subroutine InitAllocate(this, bounds) allocate(this%decomp_soiln_vr_col(begc:endc,1:nlevdecomp_full)) this%decomp_soiln_vr_col(:,:)= nan - !JV if (use_fan) then allocate(this%tan_g1_col(begc:endc)) ; this%tan_g1_col(:) = nan allocate(this%tan_g2_col(begc:endc)) ; this%tan_g2_col(:) = nan @@ -355,7 +351,6 @@ subroutine InitHistory(this, bounds) &only makes sense at the column level: should not be averaged to gridcell', & ptr_col=this%dyn_nbal_adjustments_col, default='inactive') - !JV if (use_fan) then this%tan_g1_col(begc:endc) = spval call hist_addfld1d (fname='TAN_G1', units='gN/m^2', & @@ -562,7 +557,6 @@ subroutine InitCold(this, bounds, & this%cwdn_col(c) = 0._r8 if ( use_fan ) then - !JV this%tan_g1_col(c) = 0.0_r8 this%tan_g2_col(c) = 0.0_r8 this%tan_g3_col(c) = 0.0_r8 @@ -1031,11 +1025,9 @@ end subroutine SetValues !----------------------------------------------------------------------- subroutine Summary(this, bounds, num_allc, filter_allc) ! -!KO ! !USES: use clm_time_manager , only : get_curr_date ! -!KO ! !ARGUMENTS: class (soilbiogeochem_nitrogenstate_type) :: this type(bounds_type) , intent(in) :: bounds @@ -1046,18 +1038,14 @@ subroutine Summary(this, bounds, num_allc, filter_allc) integer :: c,j,k,l ! indices integer :: fc ! lake filter indices real(r8) :: maxdepth ! depth to integrate soil variables -!KO ! !LOCAL VARIABLES: integer kyr ! current year integer kmo ! month of year (1, ..., 12) integer kda ! day of month (1, ..., 31) integer mcsec ! seconds of day (0, ..., seconds/day) -!KO !----------------------------------------------------------------------- -!KO call get_curr_date (kyr, kmo, kda, mcsec) -!KO ! vertically integrate NO3 NH4 N2O pools if (use_nitrif_denitrif) then From 7bea1d606a0133721bbdd6d3c9f0444adef935c8 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Thu, 15 Aug 2019 14:53:24 +0300 Subject: [PATCH 088/181] make array dimensions named constants --- src/biogeochem/Fan2CTSMMod.F90 | 146 ++++++++++++++++++++------------- src/biogeochem/FanMod.F90 | 5 +- 2 files changed, 93 insertions(+), 58 deletions(-) diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index c05dc1403c..33fc4ade42 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -39,15 +39,23 @@ module Fan2CTSMMod public fan_readnml public fan_eval public fan_to_sminn + + ! Structure of FAN TAN pools: number of age classes for N each type: + integer, parameter :: num_cls_slr = 4 ! slurry (S1,S2,S3,S4) + integer, parameter :: num_cls_grz = 3 ! grazing (G1, G2, G3) + integer, parameter :: num_cls_urea = 2 ! urea before hydrolysis (U1, U2) + integer, parameter :: num_cls_fert = 3 ! tan formed from urea (F1, F2, F3) + integer, parameter :: num_cls_otherfert = 1 ! F4 + integer, parameter :: num_cls_max = 4 ! max of above ! Hydrogen ion concentration in TAN pools, mol/l == 10**-pH ! - ! Pastures and slurry. The last age class gets soil pH. - real(r8), parameter :: Hconc_grz_def(2) = (/10**(-8.5_r8), 10**(-8.0_r8)/) - real(r8), parameter :: Hconc_slr_def(3) & - = (/10.0_r8**(-8.0_r8), 10.0_r8**(-8.0_r8), 10.0_r8**(-8.0_r8)/) + ! Pastures and slurry. The last age class gets soil pH (from the FAN stream), so sizes + ! are one less than the number of classes. + real(r8), parameter :: hconc_grz_def(num_cls_grz-1) = 10**(/-8.5_r8, -8.0_r8/) + real(r8), parameter :: Hconc_slr_def(num_cls_slr-1) = 10**(/-8.0_r8, -8.0_r8, -8.0_r8/) ! Urea fertilizer. The other fertilizer (F4) pool gets soil pH. - real(r8), parameter :: Hconc_fert(3) = (/10**(-7.0_r8), 10**(-8.5_r8), 10**(-8.0_r8)/) + real(r8), parameter :: Hconc_fert(num_cls_fert) = 10**(/-7.0_r8, -8.5_r8, -8.0_r8/) ! Active layer thickness used by FAN. This is assumed to match the topmost CLM layer. If ! this is not the case, handling of the soil moisture becomes inconsistent. @@ -74,10 +82,10 @@ module Fan2CTSMMod ! TAN pool age ranges (sec). real(r8), parameter :: & - poolranges_grz(3) = (/24*3600.0_r8, 10*24*3600.0_r8, 360*24*3600.0_r8/), & - poolranges_fert(3) = (/2.36*24*3600.0_r8, 24*3600.0_r8, 360*24*3600.0_r8/), & - poolranges_slr(4) = (/slurry_infiltr_time, 24*3600.0_r8, 10*24*3600.0_r8, 360*24*3600.0_r8/), & - poolrange_otherfert(1) = (/360*24*3600.0_r8/) + poolranges_grz(num_cls_grz) = (/24*3600.0_r8, 10*24*3600.0_r8, 360*24*3600.0_r8/), & + poolranges_fert(num_cls_fert) = (/2.36_r8*24*3600.0_r8, 24*3600.0_r8, 360*24*3600.0_r8/), & + poolranges_slr(num_cls_slr) = (/slurry_infiltr_time, 24*3600.0_r8, 10*24*3600.0_r8, 360*24*3600.0_r8/), & + poolrange_otherfert(num_cls_otherfert) = (/360*24*3600.0_r8/) ! soil pH for crops restricted between these limits: real(r8), parameter :: pH_crop_min = 5.5_r8 @@ -87,8 +95,9 @@ module Fan2CTSMMod real(r8), parameter :: tempr_min_grazing = 283.0_r8 ! Lowest 10-day daily-min temperature for grazing, K ! Fraction of ruminants grazing when permitted by temperature real(r8), parameter :: max_grazing_fract = 0.65_r8 - ! Normalization constants for barn and storage emissions. - real(r8), parameter :: volat_coef_barns_open = 0.03_r8, volat_coef_barns_closed = 0.025, volat_coef_stores = 0.025_r8 + ! Normalization constants for barn and storage emissions. The defaults are calibrated + ! to roughly reproduce the EMEP emission factors under European climate. + real(r8), parameter :: volat_coef_barns_open = 0.03_r8, volat_coef_barns_closed = 0.025_r8, volat_coef_stores = 0.025_r8 ! Fraction of manure N moved from crop to native columns (manure spreading) real(r8) :: fract_spread_grass = 1.0_r8 @@ -180,7 +189,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & use clm_varcon, only : spval, ispval use decompMod, only : bounds_type use subgridAveMod, only: p2c - + type(bounds_type) , intent(in) :: bounds integer , intent(in) :: num_soilc ! number of soil columns in filter integer , intent(in) :: filter_soilc(:) ! filter for soil columns @@ -205,22 +214,36 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & ! now included in the main CLM soil N balance check. The FAN check has more ! detail. balance_check_freq = 1000 + ! Number of organic N types (available, unavailable, resistant) + integer, parameter :: num_org_n_types = 3 integer :: c, g, patchcounter, p, status, c1, c2, l, fc, ind_substep - real(r8) :: dt, ndep_org(3), orgpools(3), tanprod(3), watertend, fluxes(6,4), tanpools(4), ratm, tandep, & - fluxes_tmp(6), garbage_total - real(r8) :: Hconc_grz(3), Hconc_slr(4), pH_soil, pH_crop - real(r8) :: fert_inc_tan + real(r8) :: dt, watertend, ratm, tandep + + ! Organic (non-urea) manure N: production, pools, flux to TAN. Named indices to denote + ! each N fraction. + real(r8) :: ndep_org(num_org_n_types), orgpools(num_org_n_types), tanprod(num_org_n_types) + ! Temporary arrays for N fluxes and pools. Named indices to denote different fluxes; + ! numerical indices to denote the age class. + real(r8) :: fluxes(num_fluxes, num_cls_max), tanpools(num_cls_max), fluxes_tmp(num_fluxes) + ! timestep-cumulative (gN/m2) aging flux out of the oldest class + real(r8) :: n_residual, n_residual_total + ! H ion concentrations for grz and slr pools (== prescribed + soil pH for oldest class) + real(r8) :: Hconc_grz(num_cls_grz), Hconc_slr(num_cls_slr) + real(r8) :: fert_inc_tan, pH_soil, pH_crop logical :: do_balance_checks - real(r8) :: tg, garbage, theta, thetasat, infiltr_m_s, evap_m_s, runoff_m_s, org_n_tot, & + real(r8) :: tg, theta, thetasat, infiltr_m_s, evap_m_s, runoff_m_s, org_n_tot, & nstored_old, nsoilman_old, nsoilfert_old, fert_to_air, fert_to_soil, fert_total, fert_urea, fert_tan, & soilflux_org, urea_resid - real(r8) :: tanprod_from_urea(3), ureapools(2), fert_no3, fert_generic, bsw - real(r8) :: fract_urea, fract_no3, soilph_min, soilph_max, soilpsi + ! TAN production flux from urea. Include one extra flux for the residual flux out of U2. + real(r8) :: tanprod_from_urea(num_cls_urea + 1) + real(r8) :: ureapools(num_cls_urea) + real(r8) :: fract_urea, fract_no3, soilph_min, soilph_max, & + soilpsi, fert_no3, fert_generic, bsw integer :: def_ph_count - Hconc_grz(1:2) = Hconc_grz_def - Hconc_slr(1:3) = Hconc_slr_def + Hconc_grz(1:num_cls_grz-1) = Hconc_grz_def + Hconc_slr(1:num_cls_slr-1) = Hconc_slr_def soilph_min = 999 soilph_max = -999 @@ -280,7 +303,6 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & else ngrz(c) = 0.0 end if - end do call handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & @@ -405,22 +427,26 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & soilph_min = min(soilph_min, ph_soil) fluxes_tmp = 0.0 - garbage_total = 0.0 + n_residual_total = 0.0 fluxes = 0.0 - garbage = 0 + n_residual = 0 do ind_substep = 1, num_substeps call update_npool(tg, ratm, & theta, thetasat, infiltr_m_s, evap_m_s, & wateratm2lndbulk_inst%forc_q_downscaled_col(c), watertend, & - runoff_m_s, tandep, (/0.0_r8, 0.0_r8, sum(tanprod)/), water_init_grz, & - bsw, poolranges_grz, Hconc_grz, dz_layer_grz, tanpools(1:3), & - fluxes(1:5,1:3), garbage, dt/num_substeps, 3, 5, status) + runoff_m_s, tandep, & + (/0.0_r8, 0.0_r8, sum(tanprod)/), & ! all TAN procuced from org N goes to G3 + water_init_grz, & + bsw, poolranges_grz, Hconc_grz, dz_layer_grz, tanpools(1:num_cls_grz), & + fluxes(1:num_fluxes,1:num_cls_grz), & + n_residual, dt/num_substeps, num_cls_grz, num_fluxes, status) if (status /= 0) then - write(iulog, *) 'status = ', status, tanpools(1:3), ratm, theta, thetasat, tandep, tanprod + write(iulog, *) 'status = ', status, tanpools(1:num_cls_grz), & + ratm, theta, thetasat, tandep, tanprod call endrun(msg='update_npool status /= 0') end if - fluxes_tmp = fluxes_tmp + sum(fluxes(:,1:3), dim=2) - garbage_total = garbage_total + garbage + fluxes_tmp = fluxes_tmp + sum(fluxes(:,1:num_cls_grz), dim=2) + n_residual_total = n_residual_total + n_residual end do fluxes_tmp = fluxes_tmp / num_substeps @@ -432,7 +458,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & nf%manure_runoff_col(c) = fluxes_tmp(iflx_roff) nf%manure_no3_prod_col(c) = fluxes_tmp(iflx_no3) nf%manure_nh4_to_soil_col(c) & - = fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) + garbage_total / dt + soilflux_org + = fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) + n_residual_total / dt + soilflux_org ! Manure application @@ -461,7 +487,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & Hconc_slr(4) = 10**(-ph_crop) fluxes_tmp = 0.0 - garbage_total = 0.0 + n_residual_total = 0.0 fluxes = 0.0 do ind_substep = 1, num_substeps if (debug_fan .and. any(abs(tanpools(1:4)) > 1e12)) then @@ -473,15 +499,17 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & call update_4pool(tg, ratm, theta, thetasat, infiltr_m_s, evap_m_s, & wateratm2lndbulk_inst%forc_q_downscaled_col(c), watertend, & runoff_m_s, tandep, sum(tanprod), bsw, depth_slurry, & - poolranges_slr, tanpools(1:4), Hconc_slr, fluxes(1:5, 1:4), & - garbage, dt / num_substeps, 4, 5, status) + poolranges_slr, tanpools(1:num_cls_slr), Hconc_slr, & + fluxes(1:num_fluxes, 1:num_cls_slr), & + n_residual, dt / num_substeps, num_cls_slr, num_fluxes, status) if (status /= 0) then - write(iulog, *) 'status = ', status, tanpools(1:4), tg, ratm, 'th', theta, & - thetasat, tandep, 'tp', tanprod, 'fx', fluxes(1:5,1:4) - call endrun(msg='update_3pool status /= 0') + write(iulog, *) 'status = ', status, tanpools(1:num_cls_slr), & + & tg, ratm, 'th', theta, & + thetasat, tandep, 'tp', tanprod, 'fx', fluxes(1:num_fluxes,1:num_cls_slr) + call endrun(msg='update_4pool status /= 0') end if - fluxes_tmp = fluxes_tmp + sum(fluxes(:,1:4), dim=2) - garbage_total = garbage_total + garbage + fluxes_tmp = fluxes_tmp + sum(fluxes(:,1:num_cls_slr), dim=2) + n_residual_total = n_residual_total + n_residual end do fluxes_tmp = fluxes_tmp / num_substeps @@ -495,7 +523,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & nf%manure_no3_prod_col(c) = nf%manure_no3_prod_col(c) + fluxes_tmp(iflx_no3) nf%manure_nh4_to_soil_col(c) & = nf%manure_nh4_to_soil_col(c) + fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) & - + garbage_total / dt + soilflux_org + + n_residual_total / dt + soilflux_org ! Fertilizer ! @@ -525,26 +553,27 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & ureapools(2) = ns%fert_u1_col(c) fluxes = 0.0 call update_urea(tg, theta, thetasat, infiltr_m_s, evap_m_s, watertend, & - runoff_m_s, fert_urea, bsw, ureapools, fluxes(1:6,1:2), urea_resid, poolranges_fert(1:2), & - dt, 2, 6, status) + runoff_m_s, fert_urea, bsw, ureapools, fluxes(1:num_fluxes,1:num_cls_urea), & + urea_resid, poolranges_fert(1:num_cls_urea), & + dt, num_cls_urea, num_fluxes, status) if (status /= 0) then call endrun(msg='Bad status after update_urea for fertilizer') end if ! Nitrogen fluxes from urea pool. Be sure to not zero below! - fluxes_tmp = sum(fluxes(:,1:2), dim=2) + fluxes_tmp = sum(fluxes(:,1:num_cls_urea), dim=2) ns%fert_u0_col(c) = ureapools(1) ns%fert_u1_col(c) = ureapools(2) ! Collect the formed ammonia for updating the TAN pools - tanprod_from_urea(1:2) = fluxes(iflx_to_tan, 1:2) + tanprod_from_urea(1:num_cls_urea) = fluxes(iflx_to_tan, 1:num_cls_urea) ! There is no urea pool corresponding to tan_f2, because most of the urea will ! have decomposed. Here whatever remains gets sent to tan_f2. - tanprod_from_urea(3) = urea_resid / dt + tanprod_from_urea(num_cls_urea+1) = urea_resid / dt tanpools(1) = ns%tan_f0_col(c) tanpools(2) = ns%tan_f1_col(c) tanpools(3) = ns%tan_f2_col(c) - garbage_total = 0.0 + n_residual_total = 0.0 fluxes = 0.0 nf%nh3_otherfert_col(c) = 0.0 do ind_substep = 1, num_substeps @@ -552,27 +581,29 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & call update_npool(tg, ratm, theta, thetasat, infiltr_m_s, evap_m_s, & wateratm2lndbulk_inst%forc_q_downscaled_col(c), watertend, & runoff_m_s, 0.0_r8, tanprod_from_urea, water_init_fert, bsw, & - poolranges_fert, Hconc_fert, dz_layer_fert, tanpools(1:3), fluxes(1:5,1:3), & - garbage, dt/num_substeps, 3, 5, status) + poolranges_fert, Hconc_fert, dz_layer_fert, & + tanpools(1:num_cls_fert), fluxes(1:num_fluxes,1:num_cls_fert), & + n_residual, dt/num_substeps, num_cls_fert, num_fluxes, status) if (status /= 0) then - write(iulog, *) 'status:', status, tanpools(1:3), nf%fert_n_appl_col(c) + write(iulog, *) 'status:', status, tanpools(1:num_cls_fert), nf%fert_n_appl_col(c) call endrun(msg='Bad status after npool for fertilizer') end if - fluxes_tmp = fluxes_tmp + sum(fluxes(:,1:3), dim=2) / num_substeps - garbage_total = garbage_total + garbage + fluxes_tmp = fluxes_tmp + sum(fluxes(:,1:num_cls_fert), dim=2) / num_substeps + n_residual_total = n_residual_total + n_residual ! Fertilizer pool f3 call update_npool(tg, ratm, theta, thetasat, infiltr_m_s, evap_m_s, & wateratm2lndbulk_inst%forc_q_downscaled_col(c), watertend, & runoff_m_s, fert_generic, (/0.0_r8/), water_init_fert, bsw, & - poolrange_otherfert, (/10**(-ph_crop)/), dz_layer_fert, ns%tan_f3_col(c:c), fluxes(1:5,1:1), & - garbage, dt/num_substeps, 1, 5, status) + poolrange_otherfert, (/10**(-ph_crop)/), dz_layer_fert, & + ns%tan_f3_col(c:c), fluxes(1:num_fluxes,1:1), & + n_residual, dt/num_substeps, 1, num_fluxes, status) if (status /= 0) then write(iulog, *) 'status:', status, ns%tan_f3_col(c:c), nf%fert_n_appl_col(c) call endrun(msg='Bad status after npool for generic') end if fluxes_tmp = fluxes_tmp + fluxes(:, 1) / num_substeps - garbage_total = garbage_total + garbage + n_residual_total = n_residual_total + n_residual nf%nh3_otherfert_col(c) = nf%nh3_otherfert_col(c) + fluxes(iflx_air, 1) / num_substeps end do @@ -584,7 +615,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & nf%nh3_fert_col(c) = fluxes_tmp(iflx_air) nf%fert_runoff_col(c) = fluxes_tmp(iflx_roff) nf%fert_no3_prod_col(c) = fluxes_tmp(iflx_no3) + fert_no3 - nf%fert_nh4_to_soil_col(c) = fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) + garbage_total/dt + fert_inc_tan + nf%fert_nh4_to_soil_col(c) = fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) + n_residual_total/dt + fert_inc_tan ! Total flux ! @@ -763,7 +794,8 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & real(r8) :: tempr_barns, tempr_stores, vent_barns, flux_grass_crop, tempr_min_10day, & flux_grass_graze, flux_grass_spread, flux_grass_spread_tan, flux_grass_crop_tan real(r8) :: cumflux, totalinput, total_to_store, total_to_store_tan - real(r8) :: fluxes_nitr(4,2), fluxes_tan(4,2) + ! dimensions are (type of flux, ruminant/other) + real(r8) :: fluxes_nitr(num_fluxes,2), fluxes_tan(num_fluxes,2) ! The fraction of manure applied continuously on grasslands (if present in the gridcell) real(r8), parameter :: kg_to_g = 1e3_r8 logical :: is_grass @@ -875,7 +907,7 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & ! Others call eval_fluxes_storage(flux_avail_mg, 'closed', tempr_ave, windspeed_ave, 0.0_r8, & volat_coef_barns_closed, volat_coef_stores, tan_fract_excr, fluxes_nitr(:,2), fluxes_tan(:,2), & - size(fluxes_nitr, 1), status) + size(fluxes_nitr, 2), status) if (status /=0) then write(iulog, *) 'status = ', status call endrun(msg='eval_fluxes_storage failed for other livestock') diff --git a/src/biogeochem/FanMod.F90 b/src/biogeochem/FanMod.F90 index d95e4e2371..2c7ddd62fb 100755 --- a/src/biogeochem/FanMod.F90 +++ b/src/biogeochem/FanMod.F90 @@ -51,7 +51,10 @@ module FanMod iflx_no3 = 3, & ! nitrification iflx_soilq = 4, & ! percolation to soil iflx_roff = 5, & ! surface runoff - iflx_to_tan = 6 ! conversion to tan (from urea) + iflx_to_tan = 6 ! conversion to tan (from urea) + ! Number of different fluxes, the minimum size for flux vectors: + integer, parameter, public :: num_fluxes = 6 + ! Indices in flux arrays, storage: integer, parameter, public :: iflx_air_barns = 1, & iflx_air_stores = 2, & From 60fa182e7f5a6e469e1bd0cdd08effba8e3e34cc Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Thu, 15 Aug 2019 14:53:36 +0300 Subject: [PATCH 089/181] manure_nh3 -> manure_nh4 --- src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 index cdd5eed95a..4aa787fb2e 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 @@ -465,7 +465,7 @@ subroutine InitHistory(this, bounds) ptr_col=this%fert_nh4_to_soil_col) this%manure_nh4_to_soil_col(begc:endc) = spval - call hist_addfld1d( fname='MANURE_NH3_TO_SOIL', units='gN/m^2/s', & + call hist_addfld1d( fname='MANURE_NH4_TO_SOIL', units='gN/m^2/s', & avgflag='A', long_name='Flux of NH4 to soil mineral pools, manure', & ptr_col=this%manure_nh4_to_soil_col) From 4acfd5ac33f61fbe640f2bf0989f47e91154f6e3 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Thu, 15 Aug 2019 14:54:42 +0300 Subject: [PATCH 090/181] handle_storage_v2 -> handle_storage --- src/biogeochem/Fan2CTSMMod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index 33fc4ade42..d62828e7bf 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -305,7 +305,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & end if end do - call handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & + call handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & atm2lnd_inst%forc_ndep_sgrz_grc, atm2lnd_inst%forc_ndep_ngrz_grc, & ns%man_n_stored_col, ns%man_tan_stored_col, & nf%man_n_appl_col, nf%man_tan_appl_col, & @@ -733,7 +733,7 @@ end subroutine fan_eval !************************************************************************************ - subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & + subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & ndep_sgrz_grc, ndep_ngrz_grc, n_stored_col, tan_stored_col, & n_manure_spread_col, tan_manure_spread_col, & n_manure_graze_col, n_manure_mixed_col, & @@ -959,7 +959,7 @@ subroutine handle_storage_v2(bounds, temperature_inst, frictionvel_inst, dt, & end do ! grid - end subroutine handle_storage_v2 + end subroutine handle_storage !************************************************************************************ From 4b086ec1cde7bbb0aa0be5ee2e274892663f755b Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Thu, 15 Aug 2019 16:28:42 +0300 Subject: [PATCH 091/181] fix subName --- src/main/fanStreamMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/main/fanStreamMod.F90 b/src/main/fanStreamMod.F90 index ee1af9d6a2..6d74cbbfcb 100644 --- a/src/main/fanStreamMod.F90 +++ b/src/main/fanStreamMod.F90 @@ -93,8 +93,8 @@ subroutine fanstream_init(bounds, NLFilename) integer :: nml_error ! namelist i/o error flag type(mct_ggrid) :: dom_clm ! domain information character(*), parameter :: shr_strdata_unset = 'NOT_SET' - character(*), parameter :: subName = "('ndep2dyn_init')" - character(*), parameter :: F00 = "('(ndep2dyn_init) ',4a)" + character(*), parameter :: subName = "('fanstream_init')" + character(*), parameter :: F00 = "('(fanstream_init) ',4a)" !----------------------------------------------------------------------- if (stream_year_first_fan == ispval) then From a755fb22f4e45eac8f692c418b6fec4f2fafdcb5 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Thu, 15 Aug 2019 16:28:59 +0300 Subject: [PATCH 092/181] remove commented out lines --- src/biogeochem/Fan2CTSMMod.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index d62828e7bf..ebc9bf285b 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -857,7 +857,6 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & if (tempr_min_10day > tempr_min_grazing) then ! fraction of animals grazing -> allocate some manure to grasslands before barns flux_grazing = max_grazing_fract * ndep_sgrz_grc(g) * kg_to_g / lun%wtgcell(l) - !flux_avail = (ndep_ngrz_grc(g) + ndep_sgrz_grc(g)*(1.0_r8 - max_grazing_fract)) * kg_to_g / lun%wtgcell(l) flux_avail_rum = (ndep_sgrz_grc(g)*(1.0_r8 - max_grazing_fract)) * kg_to_g / lun%wtgcell(l) grz_fract(c) = max_grazing_fract else @@ -948,7 +947,6 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & tan_manure_spread_col(col_grass) = tan_manure_spread_col(col_grass) & + flux_grass_spread_tan / col%wtgcell(col_grass) n_manure_graze_col(col_grass) = n_manure_graze_col(col_grass) + flux_grass_graze / col%wtgcell(col_grass) - !write(iulog, *) 'to grass:', n_manure_spread(col_grass), col_grass if (tan_manure_spread_col(col_grass) > 1) then write(iulog, *) 'bad tan_manure col_grass', flux_grass_spread_tan, col%wtgcell(col_grass) end if From c723a9b2093e187a8faea4512e0e316813b256af Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Thu, 15 Aug 2019 17:43:51 +0300 Subject: [PATCH 093/181] renamed fertilizer tan pools to match the convetion in the FANv2 description paper --- src/biogeochem/Fan2CTSMMod.F90 | 40 ++++----- .../SoilBiogeochemNitrogenStateType.F90 | 89 ++++++++++--------- 2 files changed, 66 insertions(+), 63 deletions(-) diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index ebc9bf285b..c85211a7eb 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -549,8 +549,8 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & ! Urea decomposition ! - ureapools(1) = ns%fert_u0_col(c) - ureapools(2) = ns%fert_u1_col(c) + ureapools(1) = ns%fert_u1_col(c) + ureapools(2) = ns%fert_u2_col(c) fluxes = 0.0 call update_urea(tg, theta, thetasat, infiltr_m_s, evap_m_s, watertend, & runoff_m_s, fert_urea, bsw, ureapools, fluxes(1:num_fluxes,1:num_cls_urea), & @@ -562,22 +562,22 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & ! Nitrogen fluxes from urea pool. Be sure to not zero below! fluxes_tmp = sum(fluxes(:,1:num_cls_urea), dim=2) - ns%fert_u0_col(c) = ureapools(1) - ns%fert_u1_col(c) = ureapools(2) + ns%fert_u1_col(c) = ureapools(1) + ns%fert_u2_col(c) = ureapools(2) ! Collect the formed ammonia for updating the TAN pools tanprod_from_urea(1:num_cls_urea) = fluxes(iflx_to_tan, 1:num_cls_urea) ! There is no urea pool corresponding to tan_f2, because most of the urea will ! have decomposed. Here whatever remains gets sent to tan_f2. tanprod_from_urea(num_cls_urea+1) = urea_resid / dt - tanpools(1) = ns%tan_f0_col(c) - tanpools(2) = ns%tan_f1_col(c) - tanpools(3) = ns%tan_f2_col(c) + tanpools(1) = ns%tan_f1_col(c) + tanpools(2) = ns%tan_f2_col(c) + tanpools(3) = ns%tan_f3_col(c) n_residual_total = 0.0 fluxes = 0.0 nf%nh3_otherfert_col(c) = 0.0 do ind_substep = 1, num_substeps - ! Fertilizer pools f0...f2 + ! Fertilizer pools f1...f3 call update_npool(tg, ratm, theta, thetasat, infiltr_m_s, evap_m_s, & wateratm2lndbulk_inst%forc_q_downscaled_col(c), watertend, & runoff_m_s, 0.0_r8, tanprod_from_urea, water_init_fert, bsw, & @@ -591,15 +591,15 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & fluxes_tmp = fluxes_tmp + sum(fluxes(:,1:num_cls_fert), dim=2) / num_substeps n_residual_total = n_residual_total + n_residual - ! Fertilizer pool f3 + ! Fertilizer pool f4 call update_npool(tg, ratm, theta, thetasat, infiltr_m_s, evap_m_s, & wateratm2lndbulk_inst%forc_q_downscaled_col(c), watertend, & runoff_m_s, fert_generic, (/0.0_r8/), water_init_fert, bsw, & poolrange_otherfert, (/10**(-ph_crop)/), dz_layer_fert, & - ns%tan_f3_col(c:c), fluxes(1:num_fluxes,1:1), & + ns%tan_f4_col(c:c), fluxes(1:num_fluxes,1:1), & n_residual, dt/num_substeps, 1, num_fluxes, status) if (status /= 0) then - write(iulog, *) 'status:', status, ns%tan_f3_col(c:c), nf%fert_n_appl_col(c) + write(iulog, *) 'status:', status, ns%tan_f4_col(c:c), nf%fert_n_appl_col(c) call endrun(msg='Bad status after npool for generic') end if fluxes_tmp = fluxes_tmp + fluxes(:, 1) / num_substeps @@ -607,10 +607,10 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & nf%nh3_otherfert_col(c) = nf%nh3_otherfert_col(c) + fluxes(iflx_air, 1) / num_substeps end do - ns%tan_f0_col(c) = tanpools(1) - ns%tan_f1_col(c) = tanpools(2) - ns%tan_f2_col(c) = tanpools(3) - ! !!tan_f3_col already updated above by update_npool!! + ns%tan_f1_col(c) = tanpools(1) + ns%tan_f2_col(c) = tanpools(2) + ns%tan_f3_col(c) = tanpools(3) + ! !!tan_f4_col already updated above by update_npool!! nf%nh3_fert_col(c) = fluxes_tmp(iflx_air) nf%fert_runoff_col(c) = fluxes_tmp(iflx_roff) @@ -696,9 +696,9 @@ real(r8) function get_total_n(ns, nf, which) result(total) total = total - sum(nf%manure_no3_prod_col(soilc)) - sum(nf%manure_nh4_to_soil_col(soilc)) case('pools_fertilizer') - total = sum(ns%tan_f0_col((soilc))) + sum(ns%tan_f1_col((soilc))) + sum(ns%tan_f2_col(soilc)) & - + sum(ns%tan_f3_col(soilc)) - total = total + sum(ns%fert_u0_col(soilc)) + sum(ns%fert_u1_col(soilc)) + total = sum(ns%tan_f1_col((soilc))) + sum(ns%tan_f2_col((soilc))) + sum(ns%tan_f3_col(soilc)) & + + sum(ns%tan_f4_col(soilc)) + total = total + sum(ns%fert_u1_col(soilc)) + sum(ns%fert_u2_col(soilc)) case('fluxes_fertilizer') total = sum(nf%fert_n_appl_col(soilc)) @@ -981,8 +981,8 @@ subroutine update_summary(ns, nf, filter_soilc, num_soilc) total = total + ns%man_u_grz_col(c) + ns%man_a_grz_col(c) + ns%man_r_grz_col(c) total = total + ns%tan_s0_col(c) + ns%tan_s1_col(c) + ns%tan_s2_col(c) + ns%tan_s3_col(c) total = total + ns%man_u_app_col(c) + ns%man_a_app_col(c) + ns%man_r_app_col(c) - total = total + ns%tan_f0_col(c) + ns%tan_f1_col(c) + ns%tan_f2_col(c) + ns%tan_f3_col(c) - total = total + ns%fert_u0_col(c) + ns%fert_u1_col(c) + total = total + ns%tan_f1_col(c) + ns%tan_f2_col(c) + ns%tan_f3_col(c) + ns%tan_f4_col(c) + total = total + ns%fert_u1_col(c) + ns%fert_u2_col(c) ns%fan_totn_col(c) = total if (lun%itype(col%landunit(c)) == istcrop) then diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 index cae7b7b475..0799a1b572 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 @@ -48,13 +48,13 @@ module SoilBiogeochemNitrogenStateType real(r8), pointer :: tan_s2_col(:) ! col (gN/m2) total ammoniacal N in FAN pool S2 real(r8), pointer :: tan_s3_col(:) ! col (gN/m2) total ammoniacal N in FAN pool S2 - real(r8), pointer :: tan_f0_col(:) ! col (gN/m2) total ammoniacal N in FAN pool F0 real(r8), pointer :: tan_f1_col(:) ! col (gN/m2) total ammoniacal N in FAN pool F1 real(r8), pointer :: tan_f2_col(:) ! col (gN/m2) total ammoniacal N in FAN pool F2 real(r8), pointer :: tan_f3_col(:) ! col (gN/m2) total ammoniacal N in FAN pool F3 + real(r8), pointer :: tan_f4_col(:) ! col (gN/m2) total ammoniacal N in FAN pool F4 - real(r8), pointer :: fert_u0_col(:) ! col (gN/m2) total urea N in FAN pool U0 real(r8), pointer :: fert_u1_col(:) ! col (gN/m2) total urea N in FAN pool U1 + real(r8), pointer :: fert_u2_col(:) ! col (gN/m2) total urea N in FAN pool U2 real(r8), pointer :: man_u_grz_col(:) ! col (gN/m2) unavailable organic N, grazing real(r8), pointer :: man_a_grz_col(:) ! col (gN/m2) available organic N, grazing @@ -104,6 +104,7 @@ module SoilBiogeochemNitrogenStateType character(len=*), parameter, private :: sourcefile = & __FILE__ + !------------------------------------------------------------------------ contains @@ -173,12 +174,12 @@ subroutine InitAllocate(this, bounds) allocate(this%tan_s1_col(begc:endc)) ; this%tan_s1_col(:) = nan allocate(this%tan_s2_col(begc:endc)) ; this%tan_s2_col(:) = nan allocate(this%tan_s3_col(begc:endc)) ; this%tan_s3_col(:) = nan - allocate(this%tan_f0_col(begc:endc)) ; this%tan_f0_col(:) = nan allocate(this%tan_f1_col(begc:endc)) ; this%tan_f1_col(:) = nan allocate(this%tan_f2_col(begc:endc)) ; this%tan_f2_col(:) = nan allocate(this%tan_f3_col(begc:endc)) ; this%tan_f3_col(:) = nan - allocate(this%fert_u0_col(begc:endc)) ; this%fert_u0_col(:) = nan + allocate(this%tan_f4_col(begc:endc)) ; this%tan_f4_col(:) = nan allocate(this%fert_u1_col(begc:endc)) ; this%fert_u1_col(:) = nan + allocate(this%fert_u2_col(begc:endc)) ; this%fert_u2_col(:) = nan allocate(this%man_u_grz_col(begc:endc)) ; this%man_u_grz_col(:) = nan allocate(this%man_a_grz_col(begc:endc)) ; this%man_a_grz_col(:) = nan @@ -223,6 +224,9 @@ subroutine InitHistory(this, bounds) character(100) :: longname real(r8), pointer :: data1dptr(:) ! temp. pointer for slicing larger arrays real(r8), pointer :: data2dptr(:,:) ! temp. pointer for slicing larger arrays + ! Switch to quickly enable/disable FAN N pools in output + character(len=*), parameter :: fanpools_default = 'inactive' + !--------------------------------------------------------------------- begc = bounds%begc; endc = bounds%endc @@ -355,109 +359,107 @@ subroutine InitHistory(this, bounds) this%tan_g1_col(begc:endc) = spval call hist_addfld1d (fname='TAN_G1', units='gN/m^2', & avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool G1', & - ptr_col=this%tan_g1_col) + ptr_col=this%tan_g1_col, default=fanpools_default) this%tan_g2_col(begc:endc) = spval call hist_addfld1d (fname='TAN_G2', units='gN/m^2', & avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool G2', & - ptr_col=this%tan_g2_col) + ptr_col=this%tan_g2_col, default=fanpools_default) this%tan_g3_col(begc:endc) = spval call hist_addfld1d (fname='TAN_G3', units='gN/m^2', & avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool G3', & - ptr_col=this%tan_g3_col) + ptr_col=this%tan_g3_col, default=fanpools_default) - this%tan_f0_col(begc:endc) = spval - call hist_addfld1d (fname='TAN_F0', units='gN/m^2', & - avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool F0', & - ptr_col=this%tan_f0_col) - this%tan_f1_col(begc:endc) = spval call hist_addfld1d (fname='TAN_F1', units='gN/m^2', & avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool F1', & - ptr_col=this%tan_f1_col) + ptr_col=this%tan_f1_col, default=fanpools_default) this%tan_f2_col(begc:endc) = spval call hist_addfld1d (fname='TAN_F2', units='gN/m^2', & avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool F2', & - ptr_col=this%tan_f2_col) + ptr_col=this%tan_f2_col, default=fanpools_default) this%tan_f3_col(begc:endc) = spval call hist_addfld1d (fname='TAN_F3', units='gN/m^2', & avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool F3', & - ptr_col=this%tan_f3_col) + ptr_col=this%tan_f3_col, default=fanpools_default) - this%tan_f0_col(begc:endc) = spval - call hist_addfld1d (fname='FERT_U0', units='gN/m^2', & - avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool F0', & - ptr_col=this%fert_u0_col) + this%tan_f4_col(begc:endc) = spval + call hist_addfld1d (fname='TAN_F4', units='gN/m^2', & + avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool F4', & + ptr_col=this%tan_f4_col, default=fanpools_default) - this%tan_f1_col(begc:endc) = spval + this%fert_u1_col(begc:endc) = spval call hist_addfld1d (fname='FERT_U1', units='gN/m^2', & - avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool F1', & - ptr_col=this%fert_u1_col) + avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool U1', & + ptr_col=this%fert_u1_col, default=fanpools_default) + this%fert_u2_col(begc:endc) = spval + call hist_addfld1d (fname='FERT_U2', units='gN/m^2', & + avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool U2', & + ptr_col=this%fert_u2_col, default=fanpools_default) this%tan_s0_col(begc:endc) = spval call hist_addfld1d (fname='TAN_S0', units='gN/m^2', & avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool S0', & - ptr_col=this%tan_s0_col) + ptr_col=this%tan_s0_col, default=fanpools_default) this%tan_s1_col(begc:endc) = spval call hist_addfld1d (fname='TAN_S1', units='gN/m^2', & avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool S1', & - ptr_col=this%tan_s1_col) + ptr_col=this%tan_s1_col, default=fanpools_default) this%tan_s2_col(begc:endc) = spval call hist_addfld1d (fname='TAN_S2', units='gN/m^2', & avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool S2', & - ptr_col=this%tan_s2_col) + ptr_col=this%tan_s2_col, default=fanpools_default) this%tan_s3_col(begc:endc) = spval call hist_addfld1d (fname='TAN_S3', units='gN/m^2', & avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool S3', & - ptr_col=this%tan_s3_col) - + ptr_col=this%tan_s3_col, default=fanpools_default) this%man_u_grz_col(begc:endc) = spval call hist_addfld1d (fname='MAN_U_GRZ', units='gN/m^2', & avgflag='A', long_name='Unavailable manure nitrogen, grazing', & - ptr_col=this%man_u_grz_col) + ptr_col=this%man_u_grz_col, default=fanpools_default) this%man_a_grz_col(begc:endc) = spval call hist_addfld1d (fname='MAN_A_GRZ', units='gN/m^2', & avgflag='A', long_name='Available manure nitrogen, grazing', & - ptr_col=this%man_a_grz_col) + ptr_col=this%man_a_grz_col, default=fanpools_default) this%man_r_grz_col(begc:endc) = spval call hist_addfld1d (fname='MAN_R_GRZ', units='gN/m^2', & avgflag='A', long_name='Resistant manure nitrogen, grazing', & - ptr_col=this%man_r_grz_col) + ptr_col=this%man_r_grz_col, default=fanpools_default) this%man_u_grz_col(begc:endc) = spval call hist_addfld1d (fname='MAN_U_APP', units='gN/m^2', & avgflag='A', long_name='Unavailable manure nitrogen, application', & - ptr_col=this%man_u_app_col) + ptr_col=this%man_u_app_col, default=fanpools_default) this%man_a_app_col(begc:endc) = spval call hist_addfld1d (fname='MAN_A_APP', units='gN/m^2', & avgflag='A', long_name='Available manure nitrogen, application', & - ptr_col=this%man_a_app_col) + ptr_col=this%man_a_app_col, default=fanpools_default) this%man_r_app_col(begc:endc) = spval call hist_addfld1d (fname='MAN_R_APP', units='gN/m^2', & avgflag='A', long_name='Resistant manure nitrogen, application', & - ptr_col=this%man_r_app_col) + ptr_col=this%man_r_app_col, default=fanpools_default) this%man_n_stored_col(begc:endc) = spval call hist_addfld1d (fname='MAN_N_STORED', units='gN/m^2', & avgflag='A', long_name='Manure nitrogen in storage', & - ptr_col=this%man_n_stored_col) + ptr_col=this%man_n_stored_col, default=fanpools_default) this%man_tan_stored_col(begc:endc) = spval call hist_addfld1d (fname='MAN_TAN_STORED', units='gN/m^2', & avgflag='A', long_name='Manure ammoniacal nitrogen in storage', & - ptr_col=this%man_tan_stored_col) + ptr_col=this%man_tan_stored_col, default=fanpools_default) this%fan_grz_fract_col(begc:endc) = spval call hist_addfld1d (fname='FAN_GRZ_FRACT', units='', & @@ -466,6 +468,7 @@ subroutine InitHistory(this, bounds) end if + ! The FAN total N is always allocated but may be zero. this%fan_totn_col(begc:endc) = spval call hist_addfld1d (fname='FAN_TOTN', units='gN/m2', & avgflag='A', long_name='FAN total N', & @@ -564,12 +567,12 @@ subroutine InitCold(this, bounds, & this%tan_s1_col(c) = 0.0_r8 this%tan_s2_col(c) = 0.0_r8 this%tan_s3_col(c) = 0.0_r8 - this%tan_f0_col(c) = 0.0_r8 this%tan_f1_col(c) = 0.0_r8 this%tan_f2_col(c) = 0.0_r8 this%tan_f3_col(c) = 0.0_r8 + this%tan_f4_col(c) = 0.0_r8 this%fert_u1_col(c) = 0.0_r8 - this%fert_u0_col(c) = 0.0_r8 + this%fert_u2_col(c) = 0.0_r8 this%man_u_grz_col(c) = 0.0_r8 this%man_a_grz_col(c) = 0.0_r8 @@ -741,9 +744,6 @@ subroutine Restart ( this, bounds, ncid, flag, totvegc_col ) dim1name='column', long_name='', units='', & interpinic_flag='interp', readvar=readvar, data=this%tan_s3_col) - call restartvar(ncid=ncid, flag=flag, varname='tan_f0', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%tan_f0_col) call restartvar(ncid=ncid, flag=flag, varname='tan_f1', xtype=ncd_double, & dim1name='column', long_name='', units='', & interpinic_flag='interp', readvar=readvar, data=this%tan_f1_col) @@ -753,13 +753,16 @@ subroutine Restart ( this, bounds, ncid, flag, totvegc_col ) call restartvar(ncid=ncid, flag=flag, varname='tan_f3', xtype=ncd_double, & dim1name='column', long_name='', units='', & interpinic_flag='interp', readvar=readvar, data=this%tan_f3_col) - - call restartvar(ncid=ncid, flag=flag, varname='fert_u0', xtype=ncd_double, & + call restartvar(ncid=ncid, flag=flag, varname='tan_f4', xtype=ncd_double, & dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%fert_u0_col) + interpinic_flag='interp', readvar=readvar, data=this%tan_f4_col) + call restartvar(ncid=ncid, flag=flag, varname='fert_u1', xtype=ncd_double, & dim1name='column', long_name='', units='', & interpinic_flag='interp', readvar=readvar, data=this%fert_u1_col) + call restartvar(ncid=ncid, flag=flag, varname='fert_u2', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%fert_u2_col) call restartvar(ncid=ncid, flag=flag, varname='man_u_grz', xtype=ncd_double, & dim1name='column', long_name='', units='', & From bb1b661a0136164ae054304f7d0cf92611afc5e2 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Thu, 15 Aug 2019 17:48:45 +0300 Subject: [PATCH 094/181] renamed fert_runoff and manure_runoff to fert_nh4_runoff and manure_nh4_runoff --- src/biogeochem/Fan2CTSMMod.F90 | 14 +++++----- .../SoilBiogeochemNitrogenFluxType.F90 | 28 +++++++++---------- 2 files changed, 21 insertions(+), 21 deletions(-) diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index c85211a7eb..4db54453f0 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -455,7 +455,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & ns%tan_g3_col(c) = tanpools(3) nf%nh3_grz_col(c) = fluxes_tmp(iflx_air) - nf%manure_runoff_col(c) = fluxes_tmp(iflx_roff) + nf%manure_nh4_runoff_col(c) = fluxes_tmp(iflx_roff) nf%manure_no3_prod_col(c) = fluxes_tmp(iflx_no3) nf%manure_nh4_to_soil_col(c) & = fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) + n_residual_total / dt + soilflux_org @@ -519,7 +519,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & ns%tan_s3_col(c) = tanpools(4) nf%nh3_man_app_col(c) = fluxes_tmp(iflx_air) - nf%manure_runoff_col(c) = nf%manure_runoff_col(c) + fluxes_tmp(iflx_roff) + nf%manure_nh4_runoff_col(c) = nf%manure_nh4_runoff_col(c) + fluxes_tmp(iflx_roff) nf%manure_no3_prod_col(c) = nf%manure_no3_prod_col(c) + fluxes_tmp(iflx_no3) nf%manure_nh4_to_soil_col(c) & = nf%manure_nh4_to_soil_col(c) + fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) & @@ -613,7 +613,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & ! !!tan_f4_col already updated above by update_npool!! nf%nh3_fert_col(c) = fluxes_tmp(iflx_air) - nf%fert_runoff_col(c) = fluxes_tmp(iflx_roff) + nf%fert_nh4_runoff_col(c) = fluxes_tmp(iflx_roff) nf%fert_no3_prod_col(c) = fluxes_tmp(iflx_no3) + fert_no3 nf%fert_nh4_to_soil_col(c) = fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) + n_residual_total/dt + fert_inc_tan @@ -692,7 +692,7 @@ real(r8) function get_total_n(ns, nf, which) result(total) case('fluxes_manure') total = sum(nf%man_n_grz_col(soilc)) + sum(nf%man_n_appl_col(soilc)) total = total - sum(nf%nh3_man_app_col(soilc)) & - - sum(nf%nh3_grz_col(soilc)) - sum(nf%manure_runoff_col(soilc)) + - sum(nf%nh3_grz_col(soilc)) - sum(nf%manure_nh4_runoff_col(soilc)) total = total - sum(nf%manure_no3_prod_col(soilc)) - sum(nf%manure_nh4_to_soil_col(soilc)) case('pools_fertilizer') @@ -702,7 +702,7 @@ real(r8) function get_total_n(ns, nf, which) result(total) case('fluxes_fertilizer') total = sum(nf%fert_n_appl_col(soilc)) - total = total - sum(nf%nh3_fert_col(soilc)) - sum(nf%fert_runoff_col(soilc)) + total = total - sum(nf%nh3_fert_col(soilc)) - sum(nf%fert_nh4_runoff_col(soilc)) total = total - sum(nf%fert_no3_prod_col(soilc)) - sum(nf%fert_nh4_to_soil_col(soilc)) case default @@ -994,9 +994,9 @@ subroutine update_summary(ns, nf, filter_soilc, num_soilc) fluxin = nf%man_n_grz_col(c) + nf%man_n_appl_col(c) end if - flux_loss = nf%nh3_man_app_col(c) + nf%nh3_grz_col(c) + nf%manure_runoff_col(c) & + flux_loss = nf%nh3_man_app_col(c) + nf%nh3_grz_col(c) + nf%manure_nh4_runoff_col(c) & + nf%nh3_stores_col(c) + nf%nh3_barns_col(c) & - + nf%nh3_fert_col(c) + nf%fert_runoff_col(c) + + nf%nh3_fert_col(c) + nf%fert_nh4_runoff_col(c) fluxout = nf%fert_no3_prod_col(c) + nf%fert_nh4_to_soil_col(c) & + nf%manure_no3_prod_col(c) + nf%manure_nh4_to_soil_col(c) & + nf%man_n_transf_col(c) + flux_loss diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 index 4aa787fb2e..43429f0b62 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 @@ -47,12 +47,12 @@ module SoilBiogeochemNitrogenFluxType real(r8), pointer :: fert_no3_prod_col (:) ! Nitrification flux from fertilizer (gN/m2/s) real(r8), pointer :: manure_nh4_to_soil_col (:) ! NH4 flux to soil mineral N pools from manure (gN/m2/s) real(r8), pointer :: fert_nh4_to_soil_col (:) ! NH4 flux to soil mineral N pools from fertilizer (gN/m2/s) - real(r8), pointer :: manure_runoff_col (:) ! NH4 runoff flux from manure, gN/m2/s - real(r8), pointer :: fert_runoff_col (:) ! NH4 runoff flux from fertilizer, gN/m2/s + real(r8), pointer :: manure_nh4_runoff_col (:) ! NH4 runoff flux from manure, gN/m2/s + real(r8), pointer :: fert_nh4_runoff_col (:) ! NH4 runoff flux from fertilizer, gN/m2/s real(r8), pointer :: nh3_total_col (:) ! Total NH3 emission from agriculture, gN/m2/s real(r8), pointer :: fan_totnout_col (:) ! Total input N into FAN pools, gN/m2/s - real(r8), pointer :: fan_totnin_col (:) ! Total output N from FAN pools, gN/m2/s + real(r8), pointer :: fan_totnin_col (:) ! Total output N from FAN pools, gN/m2/s ! decomposition fluxes real(r8), pointer :: decomp_cascade_ntransfer_vr_col (:,:,:) ! col vert-res transfer of N from donor to receiver pool along decomp. cascade (gN/m3/s) @@ -230,8 +230,8 @@ subroutine InitAllocate(this, bounds) allocate(this%fert_no3_prod_col (begc:endc)) ; this%fert_no3_prod_col (:) = spval allocate(this%manure_nh4_to_soil_col (begc:endc)) ; this%manure_nh4_to_soil_col (:) = spval allocate(this%fert_nh4_to_soil_col (begc:endc)) ; this%fert_nh4_to_soil_col (:) = spval - allocate(this%manure_runoff_col (begc:endc)) ; this%manure_runoff_col (:) = spval - allocate(this%fert_runoff_col (begc:endc)) ; this%fert_runoff_col (:) = spval + allocate(this%manure_nh4_runoff_col (begc:endc)) ; this%manure_nh4_runoff_col (:) = spval + allocate(this%fert_nh4_runoff_col (begc:endc)) ; this%fert_nh4_runoff_col (:) = spval end if ! Allocate FAN summary fluxes even if FAN is off and set them to 0. allocate(this%fan_totnin_col (begc:endc)) ; this%fan_totnin_col (:) = spval @@ -470,15 +470,15 @@ subroutine InitHistory(this, bounds) ptr_col=this%manure_nh4_to_soil_col) - this%manure_runoff_col(begc:endc) = spval - call hist_addfld1d( fname='MANURE_RUNOFF', units='gN/m^2/s', & + this%manure_nh4_runoff_col(begc:endc) = spval + call hist_addfld1d( fname='MANURE_NH4_RUNOFF', units='gN/m^2/s', & avgflag='A', long_name='NH4 in surface runoff, manure', & - ptr_col=this%manure_runoff_col) + ptr_col=this%manure_nh4_runoff_col) - this%fert_runoff_col(begc:endc) = spval - call hist_addfld1d( fname='FERT_RUNOFF', units='gN/m^2/s', & - avgflag='A', long_name='NH4 in surface runoff, fertilizer', & - ptr_col=this%fert_runoff_col) + this%fert_nh4_runoff_col(begc:endc) = spval + call hist_addfld1d( fname='FERT_NH4_RUNOFF', units='gN/m^2/s', & + avgflag='A', long_name='NH4 (and urea) in surface runoff, fertilizer', & + ptr_col=this%fert_nh4_runoff_col) end if this%fan_totnin_col(begc:endc) = spval @@ -1185,8 +1185,8 @@ subroutine SetValues ( this, & this%fert_no3_prod_col(i) = value_column this%manure_nh4_to_soil_col(i) = value_column this%fert_nh4_to_soil_col(i) = value_column - this%manure_runoff_col(i) = value_column - this%fert_runoff_col(i) = value_column + this%manure_nh4_runoff_col(i) = value_column + this%fert_nh4_runoff_col(i) = value_column end do end if From ccffea1943b6bfac1043f3a93b4864eb36d8fd04 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Sat, 17 Aug 2019 13:35:56 +0300 Subject: [PATCH 095/181] comments --- src/biogeochem/Fan2CTSMMod.F90 | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index 4db54453f0..ac767b8cd8 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -13,6 +13,13 @@ module Fan2CTSMMod ! is allocated to the native soil column. The mixed/landless systems are associated with ! crop columns, however, some N may be transferred to the native column due to manure ! spreading or seasonal grazing. + ! + ! Within FAN, the nitrogen is distributed to several pools which represent different + ! types of input (manures, fertilizers) and different "age" (time since + ! fertilizer/manure application). The pools of same type but different age are called + ! age classes in the FAN description paper. The model includes 4 slurry (manure) age + ! classes, 3 grazing manure age classes, 2 urea age classes, 3 age classes for ammonium + ! produced from urea, and 1 age class for non-urea NH4 fertilizer N. use FanMod use shr_kind_mod, only : r8 => shr_kind_r8, CL => shr_kind_cl @@ -41,7 +48,7 @@ module Fan2CTSMMod public fan_to_sminn ! Structure of FAN TAN pools: number of age classes for N each type: - integer, parameter :: num_cls_slr = 4 ! slurry (S1,S2,S3,S4) + integer, parameter :: num_cls_slr = 4 ! slurry (S0,S1,S2,S3) integer, parameter :: num_cls_grz = 3 ! grazing (G1, G2, G3) integer, parameter :: num_cls_urea = 2 ! urea before hydrolysis (U1, U2) integer, parameter :: num_cls_fert = 3 ! tan formed from urea (F1, F2, F3) @@ -52,7 +59,7 @@ module Fan2CTSMMod ! ! Pastures and slurry. The last age class gets soil pH (from the FAN stream), so sizes ! are one less than the number of classes. - real(r8), parameter :: hconc_grz_def(num_cls_grz-1) = 10**(/-8.5_r8, -8.0_r8/) + real(r8), parameter :: Hconc_grz_def(num_cls_grz-1) = 10**(/-8.5_r8, -8.0_r8/) real(r8), parameter :: Hconc_slr_def(num_cls_slr-1) = 10**(/-8.0_r8, -8.0_r8, -8.0_r8/) ! Urea fertilizer. The other fertilizer (F4) pool gets soil pH. real(r8), parameter :: Hconc_fert(num_cls_fert) = 10**(/-7.0_r8, -8.5_r8, -8.0_r8/) From 17df3a2a13f74ef29f4fdbf3d21a42ce41cab17e Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Sat, 17 Aug 2019 13:38:56 +0300 Subject: [PATCH 096/181] fix description of fract_spread_gass --- bld/namelist_files/namelist_definition_ctsm.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index 7a8c66242f..ee434378f7 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -1601,7 +1601,7 @@ Toggle to connect the FAN N pools to soil biogeochemistry for NATIVE VEGETATION -Toggle to connect the FAN N pools to soil biogeochemistry for NATIVE VEGETATION columns +Fraction of manure N produced in crop columns but spread on native vegetation columns (grasslands) Date: Sat, 17 Aug 2019 04:50:45 -0600 Subject: [PATCH 097/181] ndep2 -> fan --- bld/namelist_files/namelist_definition_ctsm.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index ee434378f7..006896c5fd 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -1570,7 +1570,7 @@ Last year to loop over for FAN Nitrogen (manure) Deposition data -Simulation year that aligns with stream_year_first_ndep2 value +Simulation year that aligns with stream_year_first_fan value Date: Wed, 4 Sep 2019 12:59:44 -0600 Subject: [PATCH 098/181] initialize fan state variables also for special columns --- .../SoilBiogeochemNitrogenStateType.F90 | 26 +++++++++++++++++-- 1 file changed, 24 insertions(+), 2 deletions(-) diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 index 0799a1b572..7d9d0ed242 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 @@ -436,7 +436,7 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='Resistant manure nitrogen, grazing', & ptr_col=this%man_r_grz_col, default=fanpools_default) - this%man_u_grz_col(begc:endc) = spval + this%man_u_app_col(begc:endc) = spval call hist_addfld1d (fname='MAN_U_APP', units='gN/m^2', & avgflag='A', long_name='Unavailable manure nitrogen, application', & ptr_col=this%man_u_app_col, default=fanpools_default) @@ -990,8 +990,30 @@ subroutine SetValues ( this, num_column, filter_column, value_column ) this%totsomn_col(i) = value_column this%totsomn_1m_col(i) = value_column this%totlitn_1m_col(i) = value_column + this%fan_totn_col(i) = value_column + if (use_fan) then + this%tan_g1_col(i) = value_column + this%tan_g2_col(i) = value_column + this%tan_g3_col(i) = value_column + this%tan_s0_col(i) = value_column + this%tan_s1_col(i) = value_column + this%tan_s2_col(i) = value_column + this%tan_s3_col(i) = value_column + this%tan_f1_col(i) = value_column + this%tan_f2_col(i) = value_column + this%tan_f3_col(i) = value_column + this%tan_f4_col(i) = value_column + this%fert_u1_col(i) = value_column + this%fert_u2_col(i) = value_column + this%man_u_grz_col(i) = value_column + this%man_a_grz_col(i) = value_column + this%man_r_grz_col(i) = value_column + this%man_u_app_col(i) = value_column + this%man_a_app_col(i) = value_column + this%man_r_app_col(i) = value_column + end if end do - + do j = 1,nlevdecomp_full do fi = 1,num_column i = filter_column(fi) From b68f23f4598b37cd719328e2eaf03a26efabba0f Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 4 Sep 2019 18:17:39 -0400 Subject: [PATCH 099/181] option for landless/mixed manure per crop/land area --- src/biogeochem/Fan2CTSMMod.F90 | 32 +++++++++++++++++++++----------- src/main/fanStreamMod.F90 | 29 +++++++++++++++++++++++------ 2 files changed, 44 insertions(+), 17 deletions(-) diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index ac767b8cd8..53d64e46f8 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -112,6 +112,10 @@ module Fan2CTSMMod ! Fan coupling to soil BGC. Can be set on separately for crop and other columns. logical :: fan_to_bgc_crop = .false. logical :: fan_to_bgc_veg = .false. + + ! Whether manure N in mixed/landless systems (manure_sgrz and manure_ngrz streams) is + ! defined per crop or land area: + logical :: crop_man_is4crop_area = .true. contains @@ -158,9 +162,9 @@ subroutine fan_readnml(NLFilename) end if call relavu(unitn) end if - - call set_bcast_fanstream_pars(stream_year_first_fan, stream_year_last_fan, & - model_year_align_fan, fan_mapalgo, stream_fldFileName_fan) + + call set_bcast_fanstream_pars(stream_year_first_fan, stream_year_last_fan, & + model_year_align_fan, fan_mapalgo, stream_fldFileName_fan, crop_man_is4crop_area) call shr_mpi_bcast(fan_to_bgc_crop, mpicom) call shr_mpi_bcast(fan_to_bgc_veg, mpicom) @@ -796,7 +800,7 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & integer , intent(in) :: filter_soilc(:) ! filter for soil columns integer :: begg, endg, g, l, c, il, counter, col_grass, status, p - real(r8) :: flux_avail_rum, flux_avail_mg, flux_grazing + real(r8) :: flux_avail_rum, flux_avail_mg, flux_grazing, invscale real(r8) :: tempr_ave, windspeed_ave ! windspeed and temperature averaged over agricultural patches real(r8) :: tempr_barns, tempr_stores, vent_barns, flux_grass_crop, tempr_min_10day, & flux_grass_graze, flux_grass_spread, flux_grass_spread_tan, flux_grass_crop_tan @@ -858,20 +862,26 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & call endrun('column not in soilfilter') end if - n_manure_mixed_col(c) = (ndep_ngrz_grc(g) + ndep_sgrz_grc(g)) * kg_to_g / lun%wtgcell(l) - + if (crop_man_is4crop_area) then + invscale = 1.0_r8 + else + invscale = 1.0_r8 / lun%wtgcell(l) + end if + + n_manure_mixed_col(c) = (ndep_ngrz_grc(g) + ndep_sgrz_grc(g)) * kg_to_g * invscale + tempr_min_10day = temperature_inst%t_a10min_patch(col%patchi(c)) if (tempr_min_10day > tempr_min_grazing) then ! fraction of animals grazing -> allocate some manure to grasslands before barns - flux_grazing = max_grazing_fract * ndep_sgrz_grc(g) * kg_to_g / lun%wtgcell(l) - flux_avail_rum = (ndep_sgrz_grc(g)*(1.0_r8 - max_grazing_fract)) * kg_to_g / lun%wtgcell(l) + flux_grazing = max_grazing_fract * ndep_sgrz_grc(g) * kg_to_g * invscale + flux_avail_rum = (ndep_sgrz_grc(g)*(1.0_r8 - max_grazing_fract)) * kg_to_g * invscale grz_fract(c) = max_grazing_fract else flux_grazing = 0.0_r8 - flux_avail_rum = ndep_sgrz_grc(g) * kg_to_g / lun%wtgcell(l) + flux_avail_rum = ndep_sgrz_grc(g) * kg_to_g * invscale grz_fract(c) = 0.0_r8 end if - flux_avail_mg = ndep_ngrz_grc(g) * kg_to_g / lun%wtgcell(l) + flux_avail_mg = ndep_ngrz_grc(g) * kg_to_g * invscale flux_grass_graze = flux_grass_graze + flux_grazing*col%wtgcell(c) if (flux_avail_rum > 1e12 .or. flux_avail_mg > 1e12 .or. isnan(flux_avail_mg) .or. isnan(flux_avail_rum)) then @@ -913,7 +923,7 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & ! Others call eval_fluxes_storage(flux_avail_mg, 'closed', tempr_ave, windspeed_ave, 0.0_r8, & volat_coef_barns_closed, volat_coef_stores, tan_fract_excr, fluxes_nitr(:,2), fluxes_tan(:,2), & - size(fluxes_nitr, 2), status) + size(fluxes_nitr, 1), status) if (status /=0) then write(iulog, *) 'status = ', status call endrun(msg='eval_fluxes_storage failed for other livestock') diff --git a/src/main/fanStreamMod.F90 b/src/main/fanStreamMod.F90 index 6d74cbbfcb..cfa0ddb892 100644 --- a/src/main/fanStreamMod.F90 +++ b/src/main/fanStreamMod.F90 @@ -42,7 +42,7 @@ module FanStreamMod integer :: model_year_align_fan = ispval ! align stream_year_firstndep2 with character(len=CL) :: stream_fldFileName_fan character(len=CL) :: fan_mapalgo = 'bilinear' - + logical :: crop_manure_per_crop character(len=*), parameter, private :: sourcefile = & __FILE__ !============================================================================== @@ -51,20 +51,24 @@ module FanStreamMod !============================================================================== - subroutine set_bcast_fanstream_pars(str_yr_first, str_yr_last, mdl_yr_align, mapalgo, str_filename) + subroutine set_bcast_fanstream_pars(str_yr_first, str_yr_last, mdl_yr_align, mapalgo, str_filename, crop_man_is_percrop) integer, intent(in) :: str_yr_first, str_yr_last, mdl_yr_align + ! whether manure_sgrz and manure_ngrz are per crop or land area: + logical, intent(in) :: crop_man_is_percrop character(len=*), intent(in) :: str_filename, mapalgo stream_year_first_fan = str_yr_first stream_year_last_fan = str_yr_last model_year_align_fan = mdl_yr_align stream_fldFileName_fan = str_filename + crop_manure_per_crop = crop_man_is_percrop fan_mapalgo = mapalgo call shr_mpi_bcast(stream_year_first_fan, mpicom) call shr_mpi_bcast(stream_year_last_fan, mpicom) call shr_mpi_bcast(model_year_align_fan, mpicom) call shr_mpi_bcast(stream_fldFileName_fan, mpicom) + call shr_mpi_bcast(crop_manure_per_crop, mpicom) call shr_mpi_bcast(fan_mapalgo, mpicom) end subroutine set_bcast_fanstream_pars @@ -95,6 +99,7 @@ subroutine fanstream_init(bounds, NLFilename) character(*), parameter :: shr_strdata_unset = 'NOT_SET' character(*), parameter :: subName = "('fanstream_init')" character(*), parameter :: F00 = "('(fanstream_init) ',4a)" + character(len=80) :: streamvar !----------------------------------------------------------------------- if (stream_year_first_fan == ispval) then @@ -147,6 +152,12 @@ subroutine fanstream_init(bounds, NLFilename) ! Manure N from seasonally grazing livestock ! + if (crop_manure_per_crop) then + streamvar = 'manure_sgrz_crop' + else + streamvar = 'manure_sgrz' + end if + call shr_strdata_create(sdat_sgrz,name="clmfansgrz", & pio_subsystem=pio_subsystem, & pio_iotype=shr_pio_getiotype(inst_name), & @@ -166,8 +177,8 @@ subroutine fanstream_init(bounds, NLFilename) domMaskName='mask', & filePath='', & filename=(/trim(stream_fldFileName_fan)/),& - fldListFile='manure_sgrz', & - fldListModel='manure_sgrz', & + fldListFile=streamvar, & + fldListModel=streamvar, & fillalgo='none', & mapalgo=fan_mapalgo, & calendar=get_calendar(), & @@ -179,6 +190,12 @@ subroutine fanstream_init(bounds, NLFilename) ! Manure N from non-grazing livestock ! + if (crop_manure_per_crop) then + streamvar = 'manure_ngrz_crop' + else + streamvar = 'manure_ngrz' + end if + call shr_strdata_create(sdat_ngrz,name="clmfanngrz", & pio_subsystem=pio_subsystem, & pio_iotype=shr_pio_getiotype(inst_name), & @@ -198,8 +215,8 @@ subroutine fanstream_init(bounds, NLFilename) domMaskName='mask', & filePath='', & filename=(/trim(stream_fldFileName_fan)/),& - fldListFile='manure_ngrz', & - fldListModel='manure_ngrz', & + fldListFile=streamvar, & + fldListModel=streamvar, & fillalgo='none', & mapalgo=fan_mapalgo, & calendar=get_calendar(), & From 9a80707ef369e9a84b9b0a1a24d096981e100e7d Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 4 Sep 2019 18:18:23 -0400 Subject: [PATCH 100/181] correct size for fluxes array --- src/biogeochem/Fan2CTSMMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index ac767b8cd8..5a8a5b9955 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -913,7 +913,7 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & ! Others call eval_fluxes_storage(flux_avail_mg, 'closed', tempr_ave, windspeed_ave, 0.0_r8, & volat_coef_barns_closed, volat_coef_stores, tan_fract_excr, fluxes_nitr(:,2), fluxes_tan(:,2), & - size(fluxes_nitr, 2), status) + size(fluxes_nitr, 1), status) if (status /=0) then write(iulog, *) 'status = ', status call endrun(msg='eval_fluxes_storage failed for other livestock') From 33bc7c8208d06025674e10c400361b99046bd842 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 4 Sep 2019 19:02:25 -0400 Subject: [PATCH 101/181] remove moldrup parameterizations; make dz_layer arguement everywhere; etc --- src/biogeochem/Fan2CTSMMod.F90 | 32 +++++++------ src/biogeochem/FanMod.F90 | 88 +++++++--------------------------- 2 files changed, 34 insertions(+), 86 deletions(-) diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index ac767b8cd8..e60d538bf7 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -8,18 +8,19 @@ module Fan2CTSMMod ! internal parameters are set in FanMod. ! ! FAN is implemented on column level. Synthetic fertilizer application is taken from the - ! CLM crop model and remains in crop columns. Manure N is read from a separate stream, - ! which distinguishes pastoral and mixed/landless livestock systems. Manure in pastures - ! is allocated to the native soil column. The mixed/landless systems are associated with - ! crop columns, however, some N may be transferred to the native column due to manure - ! spreading or seasonal grazing. + ! CLM crop model and remains in crop columns. Manure N is read from a stream (by + ! fanStreamMod) which distinguishes pastoral and mixed/landless livestock + ! systems. Manure in pastures is allocated to the native soil column. The mixed/landless + ! systems are associated with crop columns, however, some N may be transferred to the + ! native column due to manure spreading or seasonal grazing. ! ! Within FAN, the nitrogen is distributed to several pools which represent different ! types of input (manures, fertilizers) and different "age" (time since - ! fertilizer/manure application). The pools of same type but different age are called - ! age classes in the FAN description paper. The model includes 4 slurry (manure) age - ! classes, 3 grazing manure age classes, 2 urea age classes, 3 age classes for ammonium - ! produced from urea, and 1 age class for non-urea NH4 fertilizer N. + ! fertilizer/manure application). The age determines properties like pH. The pools of + ! same type but different age are called age classes in the FAN description paper. The + ! model includes 4 slurry (manure) age classes, 3 grazing manure age classes, 2 urea age + ! classes, 3 age classes for ammonium produced from urea, and 1 age class for non-urea + ! NH4 fertilizer N. use FanMod use shr_kind_mod, only : r8 => shr_kind_r8, CL => shr_kind_cl @@ -66,8 +67,9 @@ module Fan2CTSMMod ! Active layer thickness used by FAN. This is assumed to match the topmost CLM layer. If ! this is not the case, handling of the soil moisture becomes inconsistent. - real(r8), parameter :: dz_layer_fert = 0.02_r8 ! m - real(r8), parameter :: dz_layer_grz = 0.02_r8 ! m + real(r8), parameter :: dz_layer_fert = 0.02_r8 ! m, fertilizer + real(r8), parameter :: dz_layer_grz = 0.02_r8 ! m, grazing + real(r8), parameter :: dz_layer_slr = 0.02_r8 ! m, slurry ! Manure N composition real(r8) :: fract_tan = 0.6_r8 ! fraction of total ammoniacal nitrogen @@ -415,7 +417,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & orgpools(ind_avail) = man_a_grz(c) orgpools(ind_resist) = man_r_grz(c) orgpools(ind_unavail) = man_u_grz(c) - call update_org_n(ndep_org, tg, soilpsi, orgpools, dt, tanprod, soilflux_org, size(orgpools), status) + call update_org_n(ndep_org, tg, soilpsi, orgpools, dt, dz_layer_grz, tanprod, soilflux_org, size(orgpools), status) man_a_grz(c) = orgpools(ind_avail) man_r_grz(c) = orgpools(ind_resist) man_u_grz(c) = orgpools(ind_unavail) @@ -480,7 +482,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & orgpools(ind_avail) = man_a_app(c) orgpools(ind_resist) = man_r_app(c) orgpools(ind_unavail) = man_u_app(c) - call update_org_n(ndep_org, tg, soilpsi, orgpools, dt, tanprod, soilflux_org, size(orgpools), status) + call update_org_n(ndep_org, tg, soilpsi, orgpools, dt, dz_layer_slr, tanprod, soilflux_org, size(orgpools), status) man_a_app(c) = orgpools(ind_avail) man_r_app(c) = orgpools(ind_resist) man_u_app(c) = orgpools(ind_unavail) @@ -508,7 +510,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & runoff_m_s, tandep, sum(tanprod), bsw, depth_slurry, & poolranges_slr, tanpools(1:num_cls_slr), Hconc_slr, & fluxes(1:num_fluxes, 1:num_cls_slr), & - n_residual, dt / num_substeps, num_cls_slr, num_fluxes, status) + n_residual, dt / num_substeps, dz_layer_slr, num_cls_slr, num_fluxes, status) if (status /= 0) then write(iulog, *) 'status = ', status, tanpools(1:num_cls_slr), & & tg, ratm, 'th', theta, & @@ -562,7 +564,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & call update_urea(tg, theta, thetasat, infiltr_m_s, evap_m_s, watertend, & runoff_m_s, fert_urea, bsw, ureapools, fluxes(1:num_fluxes,1:num_cls_urea), & urea_resid, poolranges_fert(1:num_cls_urea), & - dt, num_cls_urea, num_fluxes, status) + dt, dz_layer_fert, num_cls_urea, num_fluxes, status) if (status /= 0) then call endrun(msg='Bad status after update_urea for fertilizer') end if diff --git a/src/biogeochem/FanMod.F90 b/src/biogeochem/FanMod.F90 index 2c7ddd62fb..dc4778e0ec 100755 --- a/src/biogeochem/FanMod.F90 +++ b/src/biogeochem/FanMod.F90 @@ -130,12 +130,6 @@ function eval_diffusivity_liq_mq(theta, thetasat, tg) result(diff) real(r8) :: kaq_base real(r8), parameter :: pw = 7.0_r8 / 3.0_r8 - real(r8), parameter :: gascnst = SHR_CONST_RGAS*1e-3_r8, & ! SHR_CONST_RGAS is per kmole (!) - faraday = 96500.0_r8, lp = 73.4_r8, lm_no3 = 71.4_r8, lm_oh=197.6_r8, lm=lm_no3 - - ! Base rate by Nernst-Haskell equation, see Poling et al., 2000, The Properties of - ! Gases and Liquids. - !kaq_base = 1e-4 * (gascnst*tg / (2*faraday**2)) / (1/lp + 1/lm) ! Van Der Molen 1990 fit of the base rate. kaq_base = 9.8e-10_r8 * 1.03_r8 ** (Tg-SHR_CONST_TKFRZ) @@ -171,52 +165,6 @@ function eval_diffusivity_gas_mq(theta, thetasat, tg) result(diff) end function eval_diffusivity_gas_mq - ! The moldrup 2003 formulas are here but not used currently. Check the base rates if use - ! these. - - function eval_diffusivity_gas_m03(theta, thetasat, tg, bsw) result(diff) - ! Evaluate the gas phase diffusivity for NH3 in soil according to the method of - ! Moldrup (2003). - implicit none - real(r8), intent(in) :: theta, thetasat, tg, bsw - real(r8) :: diff - - real(r8) :: soilair, dair, m03_W - real(r8), parameter :: pw = 10.0_r8 / 3.0_r8 - real(r8), parameter :: m03_T = 2.0 - real(r8), parameter :: mNH3 = 17., mair = 29, vNH3 = 14.9, vair = 20.1, press = 1.0 - - m03_W = 3.0_r8 / bsw - - soilair = thetasat - theta - !dair = 1.7e-5 * 1.03**(Tg-293.0_r8) - dair = (0.001_r8 * tg**1.75_r8 * sqrt(1.0_r8/mNH3 + 1.0_r8/mair)) & - / (press * (vair**(1.0_r8/3.0_r8) * vNH3**(1.0_r8/3.0_r8))**2) * 1e-4_r8 - - diff = dair * soilair**m03_T * (soilair/thetasat)**m03_W / soilair - - end function eval_diffusivity_gas_m03 - - function eval_diffusivity_liq_m03(theta, thetasat, tg, bsw) result(diff) - ! Evaluate the aquous phase diffusivity for TAN in soil according to the method of Moldrup (2003). - implicit none - real(r8), intent(in) :: theta, thetasat, tg, bsw - real(r8) :: diff - - real(r8) :: kaq_base, m03_W - real(r8), parameter :: pw = 10.0_r8 / 3.0_r8, m03_T = 2.0_r8 - real(r8), parameter :: gascnst = 8.314, faraday = 96500.0_r8, lp = 73.4_r8, lm_no3 = 71.4_r8, lm_oh=197.6_r8, lm=lm_oh - - kaq_base = 9.8e-10 * 1.03 ** (Tg-SHR_CONST_TKFRZ) - - !kaq_base = 1e-4 * (gascnst*tg / (2*faraday**2)) / (1/lp + 1/lm) - - m03_W = 0.3333_r8*bsw - 1.0 - - diff = kaq_base * theta**m03_T * (theta/thetasat)**m03_W / theta - - end function eval_diffusivity_liq_m03 - !************************************************************************************ subroutine partition_tan(tg, Hconc, theta, air, kads, KNH3, fract_nh4) @@ -562,7 +510,7 @@ end subroutine age_pools_slurry ! Public functions for integrating the FAN model for one timestep. subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend, runoff, tandep, tanprod, bsw, & - depth_slurry, poolranges, tanpools, Hconc, fluxes, garbage, dt, pools_size, fluxes_size, status) + depth_slurry, poolranges, tanpools, Hconc, fluxes, residual, dt, dz_layer, pools_size, fluxes_size, status) ! ! Evaluate fluxes and integrate states for a 4-stage slurry model with first pool ! representing uninfiltrated slurry. @@ -588,7 +536,8 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend integer, intent(in) :: fluxes_size ! size of the fluxes array. >= 5 real(r8), intent(out) :: fluxes(fluxes_size, pools_size) ! TAN fluxes, gN/m2/s (type of flux, pool) real(r8), intent(in) :: Hconc(pools_size) ! H+ concentration - real(r8), intent(out) :: garbage ! over-aged TAN occurring during the step, gN/m. + real(r8), intent(in) :: dz_layer ! layer thickness, m + real(r8), intent(out) :: residual ! over-aged TAN occurring during the step, gN/m. real(r8), intent(in) :: dt ! timestep, sec, >0 integer, intent(out) :: status ! return status, 0 = good @@ -596,9 +545,6 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend real(r8) :: percolation, water_soil, age_prev, water_in_layer, tanpools_old(4), water_relax_t integer :: indpl - real(r8), parameter :: dz_layer = 0.02 ! thickness of the volatilization layer, m - !real(r8), parameter :: kads = 1.0_r8 ! distriution coefficient kads = [TAN (s)] / [TAN (aq)], dimensionless - if (pools_size < 4 .or. fluxes_size < 5) then status = err_bad_arg return @@ -644,7 +590,7 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend ! Pool aging & input ! - call age_pools_slurry(tandep, dt, water_slurry, tanpools(1), tanpools(2:), poolranges, garbage) + call age_pools_slurry(tandep, dt, water_slurry, tanpools(1), tanpools(2:), poolranges, residual) ! TAN produced (mineralization) goes to directly the old TAN pool. tanpools(4) = tanpools(4) + tanprod*dt @@ -681,7 +627,7 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend return end if - if (abs(sum(tanpools - tanpools_old) - (-sum(fluxes) + tandep + tanprod)*dt + garbage) & + if (abs(sum(tanpools - tanpools_old) - (-sum(fluxes) + tandep + tanprod)*dt + residual) & > max(sum(tanpools_old)*1e-2, 1e-4)) then status = err_balance_tan return @@ -693,7 +639,7 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend end subroutine update_4pool subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend, runoff, tandep, tanprod, & - water_init, bsw, poolranges, Hconc, dz_layer, tanpools, fluxes, garbage, dt, numpools, size_fluxes, status) + water_init, bsw, poolranges, Hconc, dz_layer, tanpools, fluxes, residual, dt, numpools, size_fluxes, status) ! ! Evaluate fluxes and update soil TAN pools for a model with arbitrary number of pools ! defined by age and pH. For slurry use update_4pool. @@ -719,7 +665,7 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend integer, intent(in) :: numpools integer, intent(in) :: size_fluxes real(r8), intent(out) :: fluxes(size_fluxes,numpools) ! TAN fluxes, gN/m2/s (type of flux, pool) - real(r8), intent(out) :: garbage ! "over-aged" TAN produced during the step, gN/m. + real(r8), intent(out) :: residual ! "over-aged" TAN produced during the step, gN/m. real(r8), intent(in) :: dt ! timestep, sec, >0 integer, intent(out) :: status ! 0 == OK @@ -728,7 +674,6 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend real(r8) :: tanpools_old(size(tanpools)), imbalance, water_relax_t integer :: indpl - !real(r8), parameter :: kads = 1.0_r8 logical :: fixed if (size_fluxes < 5) then @@ -768,7 +713,7 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend ! Pool aging & TAN input ! - call age_pools_soil(tandep_remaining, dt, poolranges, tanpools, garbage) + call age_pools_soil(tandep_remaining, dt, poolranges, tanpools, residual) ! TAN produced (mineralization) goes to directly the old TAN pool. if (any(tanpools < 0)) then @@ -781,7 +726,7 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend end if if (debug_fan) then - imbalance = abs((sum(tanpools) - sum(tanpools_old)) - ((tandep_remaining)*dt+garbage)) + imbalance = abs((sum(tanpools) - sum(tanpools_old)) - ((tandep_remaining)*dt+residual)) if (imbalance > max(1e-14, 0.001*sum(tanpools_old))) then status = err_balance_tan*10 return @@ -823,7 +768,7 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend status = err_nan + 1000 end if - if (abs(sum(tanpools - tanpools_old) + (sum(fluxes)-tandep_remaining-sum(tanprod))*dt + garbage) & + if (abs(sum(tanpools - tanpools_old) + (sum(fluxes)-tandep_remaining-sum(tanprod))*dt + residual) & > max(sum(tanpools_old)*1e-2, 1d-2)) then status = err_balance_tan return @@ -1096,7 +1041,7 @@ end subroutine eval_fluxes_storage !************************************************************************************ - subroutine update_org_n(flux_input, tg, soilpsi, pools, dt, tanprod, soilflux, size_pools, status) + subroutine update_org_n(flux_input, tg, soilpsi, pools, dt, dz_layer, tanprod, soilflux, size_pools, status) ! ! Evaluate the decomposition/mineralization N fluxes from the available, resistant and ! unavailable N fractions, and update the organic N pools. In addition, evaluate the @@ -1109,6 +1054,7 @@ subroutine update_org_n(flux_input, tg, soilpsi, pools, dt, tanprod, soilflux, s real(r8), intent(in) :: soilpsi ! soil water potential (MPa) real(r8), intent(inout) :: pools(size_pools) ! organic N pools real(r8), intent(in) :: dt ! timestep, sec + real(r8), intent(in) :: dz_layer ! layer thickness, m real(r8), intent(out) :: tanprod(size_pools) ! Flux of TAN formed, both pools real(r8), intent(out) :: soilflux ! Flux of organic nitrogen to soil integer, intent(out) :: status @@ -1148,7 +1094,7 @@ subroutine update_org_n(flux_input, tg, soilpsi, pools, dt, tanprod, soilflux, s end subroutine update_org_n subroutine update_urea(tg, theta, thetasat, precip, evap, watertend, runoff, & - ndep, bsw, pools, fluxes, garbage, ranges, dt, numpools, fluxes_size, status) + ndep, bsw, pools, fluxes, residual, ranges, dt, dz_layer, numpools, fluxes_size, status) ! ! Evaluate fluxes and update the urea pools. The procedure is similar to updating the ! soil TAN pools, but NO3 and volatilization fluxes do not occur. @@ -1168,13 +1114,13 @@ subroutine update_urea(tg, theta, thetasat, precip, evap, watertend, runoff, & real(r8), intent(inout) :: pools(numpools) ! nitrogen pools mass / m2 real(r8), intent(out) :: fluxes(fluxes_size, numpools) ! needs one extra for the to_tan flux real(r8), intent(in) :: ranges(numpools) ! pool age extents, s - real(r8), intent(out) :: garbage ! nitrogen in patches aged beyond the oldest pool. mass / m2 + real(r8), intent(out) :: residual ! nitrogen in patches aged beyond the oldest pool. mass / m2 real(r8), intent(in) :: dt ! time step, s + real(r8), intent(in) :: dz_layer ! layer thickness, m integer, intent(out) :: status ! see top of module real(r8), parameter :: rate = 4.83e-6 ! urea decomposition, 1/s real(r8), parameter :: missing = 1e36 ! for the parameters not needed for urea fluxes - real(r8), parameter :: dz_layer = 0.02 ! thickness of the volatilization layer, m real(r8) :: age_prev, percolation, old_total, balance integer :: indpl @@ -1186,7 +1132,7 @@ subroutine update_urea(tg, theta, thetasat, precip, evap, watertend, runoff, & old_total = sum(pools) - call age_pools_soil(ndep, dt, ranges, pools, garbage) + call age_pools_soil(ndep, dt, ranges, pools, residual) age_prev = 0 do indpl = 1, numpools @@ -1208,7 +1154,7 @@ subroutine update_urea(tg, theta, thetasat, precip, evap, watertend, runoff, & balance = sum(pools) - old_total if (debug_fan) then - if (abs(balance - (ndep-sum(fluxes))*dt + garbage) > 1e-9) then + if (abs(balance - (ndep-sum(fluxes))*dt + residual) > 1e-9) then status = err_balance_nitr return end if From fd5ffab0ac5f68bcb46ba84434809a571fb0db23 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Thu, 5 Sep 2019 14:25:42 -0600 Subject: [PATCH 102/181] make manure balance check include stores/barns --- src/biogeochem/Fan2CTSMMod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index 967780607f..7b5d3584e6 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -703,10 +703,11 @@ real(r8) function get_total_n(ns, nf, which) result(total) + sum(ns%man_a_app_col(soilc)) + sum(ns%man_r_app_col(soilc)) case('fluxes_manure') - total = sum(nf%man_n_grz_col(soilc)) + sum(nf%man_n_appl_col(soilc)) + total = sum(nf%man_n_grz_col(soilc)) + sum(nf%man_n_barns_col(soilc)) total = total - sum(nf%nh3_man_app_col(soilc)) & - sum(nf%nh3_grz_col(soilc)) - sum(nf%manure_nh4_runoff_col(soilc)) total = total - sum(nf%manure_no3_prod_col(soilc)) - sum(nf%manure_nh4_to_soil_col(soilc)) + total = total - sum(nf%man_n_transf_col(soilc)) - sum(nf%nh3_stores_col(soilc)) - sum(nf%nh3_barns_col(soilc)) case('pools_fertilizer') total = sum(ns%tan_f1_col((soilc))) + sum(ns%tan_f2_col((soilc))) + sum(ns%tan_f3_col(soilc)) & From 6f0e78cb94bcd591fc72a63568619220c3e1dc7c Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Tue, 10 Sep 2019 16:56:41 -0400 Subject: [PATCH 103/181] Remove defunct storage balance check + make pH filling more obvious --- src/biogeochem/Fan2CTSMMod.F90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index 967780607f..8687a57bca 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -431,7 +431,8 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & tanpools(3) = ns%tan_g3_col(c) ph_soil = atm2lnd_inst%forc_soilph_grc(g) - if (ph_soil < 3.0) then + if (ph_soil < 0.1) then + ! Missing values in the pH, eg. Antarctica. ph_soil = 6.5_r8 def_ph_count = def_ph_count + 1 end if @@ -640,8 +641,6 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & end do if (do_balance_checks) then - call balance_check('Storage', nstored_old, & - get_total_n(ns, nf, 'pools_storage'), get_total_n(ns, nf, 'fluxes_storage')) call balance_check('Manure', nsoilman_old, & get_total_n(ns, nf, 'pools_manure'), get_total_n(ns, nf, 'fluxes_manure')) call balance_check('Fertilizer', nsoilfert_old, & From b9d97f0fa1193e61cd54fa788d482cc74559c22b Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Tue, 10 Sep 2019 18:12:41 -0400 Subject: [PATCH 104/181] remove legacy state and flux variables --- src/biogeochem/CNVegCarbonStateType.F90 | 32 +-------------- src/biogeochem/CNVegNitrogenStateType.F90 | 16 +------- .../SoilBiogeochemCarbonFluxType.F90 | 39 +------------------ .../SoilBiogeochemCompetitionMod.F90 | 3 +- .../SoilBiogeochemNitrogenStateType.F90 | 11 ------ 5 files changed, 5 insertions(+), 96 deletions(-) diff --git a/src/biogeochem/CNVegCarbonStateType.F90 b/src/biogeochem/CNVegCarbonStateType.F90 index 044629c3fa..b898b212c4 100644 --- a/src/biogeochem/CNVegCarbonStateType.F90 +++ b/src/biogeochem/CNVegCarbonStateType.F90 @@ -11,7 +11,7 @@ module CNVegCarbonStateType use shr_log_mod , only : errMsg => shr_log_errMsg use pftconMod , only : noveg, npcropmin, pftcon use clm_varcon , only : spval, c3_r2, c4_r2, c14ratio - use clm_varctl , only : iulog, use_cndv, use_crop, use_fan + use clm_varctl , only : iulog, use_cndv, use_crop use decompMod , only : bounds_type use abortutils , only : endrun use spmdMod , only : masterproc @@ -36,8 +36,6 @@ module CNVegCarbonStateType real(r8), pointer :: grainc_xfer_patch (:) ! (gC/m2) grain C transfer (crop model) real(r8), pointer :: leafc_patch (:) ! (gC/m2) leaf C real(r8), pointer :: leafc_storage_patch (:) ! (gC/m2) leaf C storage - real(r8), pointer :: leafc_manure_patch (:) ! (gC/m2) leaf C eaten by cows - real(r8), pointer :: deadstemc_manure_patch (:) ! (gC/m2) dead stem C eaten by cows real(r8), pointer :: leafc_xfer_patch (:) ! (gC/m2) leaf C transfer real(r8), pointer :: leafc_storage_xfer_acc_patch (:) ! (gC/m2) Accmulated leaf C transfer real(r8), pointer :: storage_cdemand_patch (:) ! (gC/m2) C use from the C storage pool @@ -69,7 +67,6 @@ module CNVegCarbonStateType real(r8), pointer :: deadstemc_col (:) ! (gC/m2) column-level deadstemc (fire) real(r8), pointer :: fuelc_col (:) ! fuel load outside cropland real(r8), pointer :: fuelc_crop_col (:) ! fuel load for cropland - real(r8), pointer :: total_leafc_col (:) ! (gC/m2) total C at column-level real(r8), pointer :: cropseedc_deficit_patch (:) ! (gC/m2) pool for seeding new crop growth; this is a NEGATIVE term, indicating the amount of seed usage that needs to be repaid ! pools for dynamic landcover @@ -219,10 +216,6 @@ subroutine InitAllocate(this, bounds) begg = bounds%begg; endg = bounds%endg allocate(this%leafc_patch (begp:endp)) ; this%leafc_patch (:) = nan - if ( use_fan ) then - allocate(this%leafc_manure_patch (begp:endp)) ; this%leafc_manure_patch (:) = nan - allocate(this%deadstemc_manure_patch(begp:endp)) ; this%deadstemc_manure_patch (:) = nan - end if allocate(this%leafc_storage_patch (begp:endp)) ; this%leafc_storage_patch (:) = nan allocate(this%leafc_xfer_patch (begp:endp)) ; this%leafc_xfer_patch (:) = nan allocate(this%leafc_storage_xfer_acc_patch (begp:endp)) ; this%leafc_storage_xfer_acc_patch (:) = nan @@ -263,9 +256,6 @@ subroutine InitAllocate(this, bounds) allocate(this%deadstemc_col (begc:endc)) ; this%deadstemc_col (:) = nan allocate(this%fuelc_col (begc:endc)) ; this%fuelc_col (:) = nan allocate(this%fuelc_crop_col (begc:endc)) ; this%fuelc_crop_col (:) = nan - if ( use_fan ) then - allocate(this%total_leafc_col (begc:endc)) ; this%total_leafc_col (:) = nan - end if allocate(this%totvegc_patch (begp:endp)) ; this%totvegc_patch (:) = nan allocate(this%totvegc_col (begc:endc)) ; this%totvegc_col (:) = nan @@ -2247,11 +2237,6 @@ subroutine Restart ( this, bounds, ncid, flag, carbon_type, reseed_dead_plants, call restartvar(ncid=ncid, flag=flag, varname='seedc_g', xtype=ncd_double, & dim1name='gridcell', long_name='', units='', & interpinic_flag='interp', readvar=readvar, data=this%seedc_grc) - if ( use_fan ) then - call restartvar(ncid=ncid, flag=flag, varname='total_leafc', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%total_leafc_col) - end if end if !-------------------------------- @@ -2351,14 +2336,6 @@ subroutine SetValues ( this, & end if end do - if ( use_fan ) then - do fi = 1,num_patch - i = filter_patch(fi) - this%leafc_manure_patch(i) = value_patch - this%deadstemc_manure_patch(i)= value_patch - end do - end if - do fi = 1,num_column i = filter_column(fi) this%rootc_col(i) = value_column @@ -2372,13 +2349,6 @@ subroutine SetValues ( this, & this%totecosysc_col(i) = value_column end do - if ( use_fan ) then - do fi = 1,num_column - i = filter_column(fi) - this%total_leafc_col(i) = value_column - end do - end if - end subroutine SetValues !----------------------------------------------------------------------- diff --git a/src/biogeochem/CNVegNitrogenStateType.F90 b/src/biogeochem/CNVegNitrogenStateType.F90 index 92f2fee613..954e3b07c1 100644 --- a/src/biogeochem/CNVegNitrogenStateType.F90 +++ b/src/biogeochem/CNVegNitrogenStateType.F90 @@ -11,7 +11,7 @@ module CNVegNitrogenStateType use landunit_varcon , only : istcrop, istsoil use clm_varctl , only : use_nitrif_denitrif, use_vertsoilc, use_century_decomp use clm_varctl , only : iulog, override_bgc_restart_mismatch_dump - use clm_varctl , only : use_crop, use_fan + use clm_varctl , only : use_crop use CNSharedParamsMod , only : use_fun use decompMod , only : bounds_type use pftconMod , only : npcropmin, noveg, pftcon @@ -38,8 +38,6 @@ module CNVegNitrogenStateType real(r8), pointer :: grainn_storage_patch (:) ! (gN/m2) grain N storage (crop) real(r8), pointer :: grainn_xfer_patch (:) ! (gN/m2) grain N transfer (crop) real(r8), pointer :: leafn_patch (:) ! (gN/m2) leaf N - real(r8), pointer :: leafn_manure_patch (:) ! (gN/m2) leaf N eaten by cows - real(r8), pointer :: deadstemn_manure_patch (:) ! (gN/m2) dead stem N eaten by cows real(r8), pointer :: leafn_storage_patch (:) ! (gN/m2) leaf N storage real(r8), pointer :: leafn_xfer_patch (:) ! (gN/m2) leaf N transfer real(r8), pointer :: leafn_storage_xfer_acc_patch (:) ! (gN/m2) Accmulated leaf N transfer @@ -136,10 +134,6 @@ subroutine InitAllocate(this, bounds) allocate(this%grainn_storage_patch (begp:endp)) ; this%grainn_storage_patch (:) = nan allocate(this%grainn_xfer_patch (begp:endp)) ; this%grainn_xfer_patch (:) = nan allocate(this%leafn_patch (begp:endp)) ; this%leafn_patch (:) = nan - if ( use_fan ) then - allocate(this%leafn_manure_patch (begp:endp)) ; this%leafn_manure_patch (:) = nan - allocate(this%deadstemn_manure_patch(begp:endp)) ; this%deadstemn_manure_patch (:) = nan - end if allocate(this%leafn_storage_patch (begp:endp)) ; this%leafn_storage_patch (:) = nan allocate(this%leafn_xfer_patch (begp:endp)) ; this%leafn_xfer_patch (:) = nan allocate(this%leafn_storage_xfer_acc_patch (begp:endp)) ; this%leafn_storage_xfer_acc_patch (:) = nan @@ -897,14 +891,6 @@ subroutine SetValues ( this, & this%totn_patch(i) = value_patch end do - if ( use_fan ) then - do fi = 1,num_patch - i = filter_patch(fi) - this%leafn_manure_patch(i) = value_patch - this%deadstemn_manure_patch(i)= value_patch - end do - end if - if ( use_crop )then do fi = 1,num_patch i = filter_patch(fi) diff --git a/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 index 4d94616bd5..e866ea280b 100644 --- a/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemCarbonFluxType.F90 @@ -11,7 +11,7 @@ module SoilBiogeochemCarbonFluxType use SoilBiogeochemDecompCascadeConType , only : decomp_cascade_con use ColumnType , only : col use LandunitType , only : lun - use clm_varctl , only : use_fates, use_fan + use clm_varctl , only : use_fates ! ! !PUBLIC TYPES: @@ -32,9 +32,6 @@ module SoilBiogeochemCarbonFluxType real(r8), pointer :: decomp_k_col (:,:,:) ! rate constant for decomposition (1./sec) real(r8), pointer :: hr_vr_col (:,:) ! (gC/m3/s) total vertically-resolved het. resp. from decomposing C pools real(r8), pointer :: o_scalar_col (:,:) ! fraction by which decomposition is limited by anoxia - real(r8), pointer :: soi_gd_col (:,:) !KO - real(r8), pointer :: cmanure_to_sminn_col (:) ! (gC/m2/s) deposition of C from manure to soil mineral C - real(r8), pointer :: methane_manure_col (:) ! (gC/m2/s) emission of CH4 from cows real(r8), pointer :: w_scalar_col (:,:) ! fraction by which decomposition is limited by moisture availability real(r8), pointer :: t_scalar_col (:,:) ! fraction by which decomposition is limited by temperature real(r8), pointer :: som_c_leached_col (:) ! (gC/m^2/s) total SOM C loss from vertical transport @@ -47,7 +44,7 @@ module SoilBiogeochemCarbonFluxType real(r8), pointer :: hr_col (:) ! (gC/m2/s) total heterotrophic respiration real(r8), pointer :: lithr_col (:) ! (gC/m2/s) litter heterotrophic respiration - real(r8), pointer :: somhr_col (:) ! (gC/m2/s) soil organic matter heterotrophic respiration + real(r8), pointer :: somhr_col (:) ! (gC/m2/s) soil organic matter heterotrophic res real(r8), pointer :: soilc_change_col (:) ! (gC/m2/s) FUN used soil C ! fluxes to receive carbon inputs from FATES @@ -101,11 +98,6 @@ subroutine InitAllocate(this, bounds) allocate(this%t_scalar_col (begc:endc,1:nlevdecomp_full)); this%t_scalar_col (:,:) =spval allocate(this%w_scalar_col (begc:endc,1:nlevdecomp_full)); this%w_scalar_col (:,:) =spval allocate(this%o_scalar_col (begc:endc,1:nlevdecomp_full)); this%o_scalar_col (:,:) =spval - if ( use_fan ) then - allocate(this%soi_gd_col (begc:endc,1:nlevdecomp_full)) ; this%soi_gd_col (:,:) = spval - allocate(this%cmanure_to_sminn_col (begc:endc)) ; this%cmanure_to_sminn_col (:) = nan - allocate(this%methane_manure_col (begc:endc)) ; this%methane_manure_col (:) = nan - end if allocate(this%phr_vr_col (begc:endc,1:nlevdecomp_full)); this%phr_vr_col (:,:) =nan allocate(this%fphr_col (begc:endc,1:nlevgrnd)) ; this%fphr_col (:,:) =nan allocate(this%som_c_leached_col (begc:endc)) ; this%som_c_leached_col (:) =nan @@ -207,19 +199,6 @@ subroutine InitHistory(this, bounds, carbon_type) call hist_addfld1d (fname='HR', units='gC/m^2/s', & avgflag='A', long_name='total heterotrophic respiration', & ptr_col=this%hr_col) - if ( use_fan ) then - - this%cmanure_to_sminn_col(begc:endc) = spval - call hist_addfld1d (fname='CMANURE_TO_SMINN', units='gC/m^2/s', & - avgflag='A', long_name='Deposition of C from manure to soil mineral', & - ptr_col=this%cmanure_to_sminn_col) - - this%methane_manure_col(begc:endc) = spval - call hist_addfld1d (fname='METHANE_MANURE', units='gC/m^2/s', & - avgflag='A', long_name='Emission of Methane from cows', & - ptr_col=this%methane_manure_col) - - end if this%lithr_col(begc:endc) = spval call hist_addfld1d (fname='LITTERC_HR', units='gC/m^2/s', & @@ -728,20 +707,6 @@ subroutine SetValues ( this, num_column, filter_column, value_column) this%soilc_change_col(i) = value_column end do - if ( use_fan ) then - do j = 1, nlevdecomp_full - do fi = 1,num_column - i = filter_column(fi) - this%soi_gd_col(i,j) = value_column - end do - end do - do fi = 1,num_column - i = filter_column(fi) - this%cmanure_to_sminn_col(i) = value_column - this%methane_manure_col(i) = value_column - end do - end if - ! NOTE: do not zero the fates to BGC C flux variables since they need to persist from the daily fates timestep s to the half-hourly BGC timesteps. I.e. FATES_c_to_litr_lab_c_col, FATES_c_to_litr_cel_c_col, FATES_c_to_litr_lig_c_col end subroutine SetValues diff --git a/src/soilbiogeochem/SoilBiogeochemCompetitionMod.F90 b/src/soilbiogeochem/SoilBiogeochemCompetitionMod.F90 index 485beaadbd..ba38428d6d 100644 --- a/src/soilbiogeochem/SoilBiogeochemCompetitionMod.F90 +++ b/src/soilbiogeochem/SoilBiogeochemCompetitionMod.F90 @@ -174,7 +174,7 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, soilbiogeochem_nitrogenflux_inst,canopystate_inst) ! ! !USES: - use clm_varctl , only: cnallocate_carbon_only, iulog, use_fan + use clm_varctl , only: cnallocate_carbon_only, iulog use clm_varpar , only: nlevdecomp, ndecomp_cascade_transitions use clm_varcon , only: nitrif_n2o_loss_frac use CNSharedParamsMod, only: use_fun @@ -234,7 +234,6 @@ subroutine SoilBiogeochemCompetition (bounds, num_soilc, filter_soilc,num_soilp, real(r8) :: residual_smin_no3(bounds%begc:bounds%endc) real(r8) :: residual_plant_ndemand(bounds%begc:bounds%endc) real(r8) :: sminn_to_plant_new(bounds%begc:bounds%endc) - real(r8) :: smin_nh4_vr_factor ! factor to reduce smin_nh4_nr if use_fan is true !----------------------------------------------------------------------- associate( & diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 index 7d9d0ed242..52aea7ce2e 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 @@ -1049,9 +1049,6 @@ end subroutine SetValues !----------------------------------------------------------------------- subroutine Summary(this, bounds, num_allc, filter_allc) - ! - ! !USES: - use clm_time_manager , only : get_curr_date ! ! !ARGUMENTS: class (soilbiogeochem_nitrogenstate_type) :: this @@ -1063,15 +1060,8 @@ subroutine Summary(this, bounds, num_allc, filter_allc) integer :: c,j,k,l ! indices integer :: fc ! lake filter indices real(r8) :: maxdepth ! depth to integrate soil variables - ! !LOCAL VARIABLES: - integer kyr ! current year - integer kmo ! month of year (1, ..., 12) - integer kda ! day of month (1, ..., 31) - integer mcsec ! seconds of day (0, ..., seconds/day) !----------------------------------------------------------------------- - call get_curr_date (kyr, kmo, kda, mcsec) - ! vertically integrate NO3 NH4 N2O pools if (use_nitrif_denitrif) then do fc = 1,num_allc @@ -1089,7 +1079,6 @@ subroutine Summary(this, bounds, num_allc, filter_allc) this%smin_nh4_col(c) = & this%smin_nh4_col(c) + & this%smin_nh4_vr_col(c,j) * dzsoi_decomp(j) - end do end do From 52de87dd66059ce305deaacf82f3e72d02b5150d Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Tue, 10 Sep 2019 18:16:41 -0400 Subject: [PATCH 105/181] remove legacy state and flux variables (2) --- src/biogeochem/CNVegCarbonStateType.F90 | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/biogeochem/CNVegCarbonStateType.F90 b/src/biogeochem/CNVegCarbonStateType.F90 index b898b212c4..a6dd0dfd96 100644 --- a/src/biogeochem/CNVegCarbonStateType.F90 +++ b/src/biogeochem/CNVegCarbonStateType.F90 @@ -993,9 +993,6 @@ subroutine InitCold(this, bounds, ratio, carbon_type, c12_cnveg_carbonstate_inst this%totecosysc_col(c) = 0._r8 this%totc_p2c_col(c) = 0._r8 this%totc_col(c) = 0._r8 - if ( use_fan ) then - this%total_leafc_col(c)= 0._r8 - end if end if end do From 0d94113fcadf8958b8619db65ca332c7a6595f60 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Tue, 10 Sep 2019 18:19:57 -0400 Subject: [PATCH 106/181] Crash if fan nh3 requested to coupler but fan is off --- src/main/lnd2atmType.F90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/main/lnd2atmType.F90 b/src/main/lnd2atmType.F90 index c6ca693b39..7fd3223f99 100644 --- a/src/main/lnd2atmType.F90 +++ b/src/main/lnd2atmType.F90 @@ -12,11 +12,12 @@ module lnd2atmType use decompMod , only : bounds_type use clm_varpar , only : numrad, ndst, nlevgrnd !ndst = number of dust bins. use clm_varcon , only : spval - use clm_varctl , only : iulog, use_lch4 + use clm_varctl , only : iulog, use_lch4, use_fan use shr_megan_mod , only : shr_megan_mechcomps_n use shr_fire_emis_mod,only : shr_fire_emis_mechcomps_n use seq_drydep_mod, only : n_drydep, drydep_method, DD_XLND use shr_fan_mod, only : shr_fan_to_atm + ! ! !PUBLIC TYPES: implicit none @@ -156,6 +157,9 @@ subroutine InitAllocate(this, bounds) allocate(this%flux_ch4_grc (begg:endg)) ; this%flux_ch4_grc (:) =ival if (shr_fan_to_atm) then + if (.not. use_fan) then + call endrun(msg="ERROR fan_to_atm is on but use_fan is off") + end if allocate(this%flux_nh3_grc (begg:endg)) ; this%flux_nh3_grc (:) =ival end if if (shr_megan_mechcomps_n>0) then From ec1ff0d25aceeb87e06062b69a6a1dc5163ca956 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 19 Sep 2019 15:04:35 -0600 Subject: [PATCH 107/181] If fan is off, let namelist be identical to without it, remove some extra debug printing in namelist, add some unit tests for fan on, and fan error conditions --- bld/CLMBuildNamelist.pm | 32 +- bld/configure | 755 ------------------------ bld/unit_testers/build-namelist_test.pl | 20 +- 3 files changed, 36 insertions(+), 771 deletions(-) delete mode 100755 bld/configure diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index ade2cd4ce3..3ede62a434 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -2999,15 +2999,15 @@ sub setup_logic_fan { $log->fatal_error("fan_mode not one of atm, soil, full, on, off\n" ); } - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_fan', - 'fan_mode'=>$fan_mode ); + if ( !($fan_mode eq 'off') ) { + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_fan', + 'fan_mode'=>$fan_mode ); - $nl_flags->{'use_fan'} = $nl->get_value('use_fan'); - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fan_nh3_to_atm', - 'fan_mode'=>$fan_mode); - $nl_flags->{'fan_nh3_to_atm'} = $nl->get_value('fan_nh3_to_atm'); + $nl_flags->{'use_fan'} = $nl->get_value('use_fan'); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fan_nh3_to_atm', + 'fan_mode'=>$fan_mode); + $nl_flags->{'fan_nh3_to_atm'} = $nl->get_value('fan_nh3_to_atm'); - if ( !($fan_mode eq 'off') ) { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fan_mapalgo'); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_first_fan', 'sim_year'=>$nl_flags->{'sim_year'}, 'sim_year_range'=>$nl_flags->{'sim_year_range'}); @@ -3027,14 +3027,15 @@ sub setup_logic_fan { 'fan_mode'=>$fan_mode); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'nh4_ads_coef', 'fan_mode'=>$fan_mode); - + } else { + $nl_flags->{'use_fan'} = ".false."; } if ( &value_is_true( $nl_flags->{'use_ed'} ) && &value_is_true( $nl_flags->{'use_fan'} ) ) { - fatal_error("Cannot turn use_fan on when use_ed is on\n" ); + $log->fatal_error("Cannot turn use_fan on when use_ed is on\n" ); } if ( !&value_is_true( $nl_flags->{'use_crop'} ) && &value_is_true( $nl_flags->{'use_fan'} ) ) { - fatal_error("Cannot turn use_fan on when use_crop is off\n" ); + $log->fatal_error("Cannot turn use_fan on when use_crop is off\n" ); } } @@ -3884,7 +3885,9 @@ sub write_output_files { push @groups, "lifire_inparm"; push @groups, "ch4finundated"; push @groups, "clm_canopy_inparm"; - push @groups, "fan_nml"; + if ( &value_is_true($nl_flags->{'use_fan'}) ) { + push @groups, "fan_nml"; + } if (remove_leading_and_trailing_quotes($nl->get_value('snow_cover_fraction_method')) eq 'SwensonLawrence2012') { push @groups, "scf_swenson_lawrence_2012_inparm"; } @@ -3895,8 +3898,10 @@ sub write_output_files { $log->verbose_message("Writing clm namelist to $outfile"); # Drydep, fire-emission or MEGAN namelist for driver - @groups = qw(drydep_inparm megan_emis_nl fire_emis_nl carma_inparm fan_inparm); - print "GROUPS: @groups \n"; + @groups = qw(drydep_inparm megan_emis_nl fire_emis_nl carma_inparm); + if ( &value_is_true($nl_flags->{'use_fan'}) ) { + push @groups, "fan_inparm"; + } $outfile = "$opts->{'dir'}/drv_flds_in"; $nl->write($outfile, 'groups'=>\@groups, 'note'=>"$note" ); $log->verbose_message("Writing @groups namelists to $outfile"); @@ -3982,7 +3987,6 @@ sub add_default { # check whether the variable has a value in the namelist object -- if so then skip to end my $val = $nl->get_variable_value($group, $var); - print "ifdef $var $val\n"; if (! defined $val) { # Look for a specified value in the options hash diff --git a/bld/configure b/bld/configure deleted file mode 100755 index 1be8eb8db8..0000000000 --- a/bld/configure +++ /dev/null @@ -1,755 +0,0 @@ -#!/usr/bin/env perl -#----------------------------------------------------------------------------------------------- -# -# configure -# -# -# This utility allows the CLM user to specify compile-time configuration -# options via a commandline interface. The output from configure is a -# Makefile and a cache file that contains all configuration parameters -# required to produce the Makefile. A subsequent invocation of configure -# can use the cache file as input (via the -defaults argument) to reproduce -# the CLM configuration contained in it. Note that when a cache file is -# used to set default values only the model parameters are used. The -# parameters that are platform dependent (e.g., compiler options, library -# locations, etc) are ignored. -# -# As the build time configurable options of CLM are changed, this script -# must also be changed. Thus configure is maintained under revision -# control in the CLM source tree and it is assumed that only the version of -# configure in the source tree will be used to build CLM. Thus we assume -# that the root of the source tree can be derived from the location of this -# script. -# -#----------------------------------------------------------------------------------------------- - -use strict; -#use warnings; -#use diagnostics; -use Cwd qw(getcwd abs_path); -use English; -use Getopt::Long; -use IO::File; -use IO::Handle; -use File::Copy; - -#----------------------------------------------------------------------------------------------- - -sub usage { - die <). Any value that contains - white-space must be quoted. Long option names may be supplied with either single - or double leading dashes. A consequence of this is that single letter options may - NOT be bundled. - - -bgc Build CLM with BGC package [ none | cn | cndv ] - (default is none). - -cache Name of output cache file (default: config_cache.xml). - -cachedir Name of directory where output cache file is written - (default: CLM build directory). - -cimeroot REQUIRED: Path to cime directory - -clm_root Root directory of clm source code - (default: directory above location of this script) - -cppdefs A string of user specified CPP defines. Appended to - Makefile defaults. e.g. -cppdefs '-DVAR1 -DVAR2' - -crop Toggle for prognostic crop model. [on | off] (default is off) - (can ONLY be turned on when BGC type is CN or CNDV) - -comp_intf Component interface to use (ESMF or MCT) (default MCT) - -defaults Specify full path to a configuration file which will be used - to supply defaults instead of the defaults in bld/config_files. - This file is used to specify model configuration parameters only. - Parameters relating to the build which are system dependent will - be ignored. - -help [or -h] Print usage to STDOUT. - -nofire Turn off wildfires for BGC setting of CN - (default includes fire for CN) - -noio Turn history output completely off (typically for testing). - -phys Value of clm4_0, clm4_5, or clm5_0 (default is clm4_0) - -silent [or -s] Turns on silent mode - only fatal messages issued. - -sitespf_pt Setup for the given site specific single-point resolution. - -snicar_frc Turn on SNICAR radiative forcing calculation. [on | off] - (default is off) - -spinup CLM 4.0 Only. For CLM 4.5, spinup is controlled from build-namelist. - Turn on given spinup mode for BGC setting of CN (level) - AD Turn on Accelerated Decomposition from (2) - bare-soil - exit Jump directly from AD spinup to normal mode (1) - normal Normal decomposition ("final spinup mode") (0) - (default) - The recommended sequence is 2-1-0 - -usr_src [,[,[...]]] - Directories containing user source code. - -verbose [or -v] Turn on verbose echoing of settings made by configure. - -version Echo the SVN tag name used to check out this CLM distribution. -EOF -} - -#----------------------------------------------------------------------------------------------- -# Setting autoflush (an IO::Handle method) on STDOUT helps in debugging. It forces the test -# descriptions to be printed to STDOUT before the error messages start. - -*STDOUT->autoflush(); - -#----------------------------------------------------------------------------------------------- -# Set the directory that contains the CLM configuration scripts. If the configure command was -# issued using a relative or absolute path, that path is in $ProgDir. Otherwise assume the -# command was issued from the current working directory. - -(my $ProgName = $0) =~ s!(.*)/!!; # name of this script -my $ProgDir = $1; # name of directory containing this script -- may be a - # relative or absolute path, or null if the script is in - # the user's PATH -my $cwd = getcwd(); # current working directory -my $cfgdir; # absolute pathname of directory that contains this script -if ($ProgDir) { - $cfgdir = abs_path($ProgDir); -} else { - $cfgdir = $cwd; -} - -#----------------------------------------------------------------------------------------------- -# Save commandline -my $commandline = "$cfgdir/configure @ARGV"; - -#----------------------------------------------------------------------------------------------- -# Parse command-line options. -my %opts = ( - cache => "config_cache.xml", - phys => "clm4_0", - nofire => undef, - noio => undef, - cimeroot => undef, - clm_root => undef, - spinup => "normal", - ); -GetOptions( - "spinup=s" => \$opts{'spinup'}, - "bgc=s" => \$opts{'bgc'}, - "cache=s" => \$opts{'cache'}, - "cachedir=s" => \$opts{'cachedir'}, - "snicar_frc=s" => \$opts{'snicar_frc'}, - "cimeroot=s" => \$opts{'cimeroot'}, - "clm_root=s" => \$opts{'clm_root'}, - "cppdefs=s" => \$opts{'cppdefs'}, - "comp_intf=s" => \$opts{'comp_intf'}, - "defaults=s" => \$opts{'defaults'}, - "clm4me=s" => \$opts{'clm4me'}, - "h|help" => \$opts{'help'}, - "nofire" => \$opts{'nofire'}, - "noio" => \$opts{'noio'}, - "phys=s" => \$opts{'phys'}, - "snicar_frc=s" => \$opts{'snicar_frc'}, - "s|silent" => \$opts{'silent'}, - "sitespf_pt=s" => \$opts{'sitespf_pt'}, - "usr_src=s" => \$opts{'usr_src'}, - "v|verbose" => \$opts{'verbose'}, - "version" => \$opts{'version'}, - "crop=s" => \$opts{'crop'}, -) or usage(); - -# Give usage message. -usage() if $opts{'help'}; - -# Echo version info. -version($cfgdir) if $opts{'version'}; - -# Check for unparsed arguments -if (@ARGV) { - print "ERROR: unrecognized arguments: @ARGV\n"; - usage(); -} - -# Define 3 print levels: -# 0 - only issue fatal error messages -# 1 - only informs what files are created (default) -# 2 - verbose -my $print = 1; -if ($opts{'silent'}) { $print = 0; } -if ($opts{'verbose'}) { $print = 2; } -my $eol = "\n"; - -my %cfg = (); # build configuration - -#----------------------------------------------------------------------------------------------- -# Make sure we can find required perl modules and configuration files. -# Look for them in the directory that contains the configure script. - -my $cimeroot = $opts{'cimeroot'}; -if ( ! defined($cimeroot) ) { - $cimeroot = "$cfgdir/../cime"; - if ( -d $cimeroot ) { - } elsif ( -d "$cfgdir/../../../cime" ) { - $cimeroot = "$cfgdir/../../../cime"; - } else { - die <<"EOF"; -** Cannot find the root of the cime directory enter it using the -cimeroot option - Did you run the checkout_externals scripts? -EOF - } -} -my $casecfgdir = "$cimeroot/scripts/Tools"; -my $perl5lib = "$cimeroot/utils/perl5lib/"; - -# The Build::Config module provides utilities to store and manipulate the configuration. -my $file = "$perl5lib/Build/Config.pm"; -(-f "$file") or die <<"EOF"; -** Cannot find perl module \"Build/Config.pm\" in path - \"$file\" ** -EOF -#----------------------------------------------------------------------------------------------- -# Add $cfgdir/perl5lib to the list of paths that Perl searches for modules -my @dirs = ( $cfgdir, "$perl5lib", $casecfgdir); -unshift @INC, @dirs; -require Build::Config; -require config_files::clm_phys_vers; - -# Get the physics version -my $phys = config_files::clm_phys_vers->new($opts{'phys'}); - -# Check for the physics specific configuration definition file. -my $phys_string = $phys->as_filename(); - -my $config_def_file = "config_definition_$phys_string.xml"; -(-f "$cfgdir/config_files/$config_def_file") or die <<"EOF"; -** Cannot find configuration definition file \"$config_def_file\" in directory - \"$cfgdir/config_files\" ** -EOF - -# The configuration defaults file modifies the generic defaults in the configuration -# definition file. Note that the -defaults option has precedence over all other options. -my $config_defaults_file; -my $std_config_defaults_file = "$cfgdir/config_files/config_defaults.xml"; -if ($opts{'defaults'}) { - $config_defaults_file = $opts{'defaults'}; -} elsif (defined($opts{'sitespf_pt'}) and $phys->as_long() == $phys->as_long( "clm4_0" ) ) { - $config_defaults_file = "$cfgdir/config_files/config_defaults_$opts{'sitespf_pt'}.xml"; - if ( ! -f $config_defaults_file ) { - $config_defaults_file = "$std_config_defaults_file"; - } -} else { - $config_defaults_file = "$std_config_defaults_file"; -} -(-f "$config_defaults_file") or die <<"EOF"; -** Cannot find configuration defaults file \"$config_defaults_file\" ** -EOF - -if ($print>=2) { print "Setting CLM configuration script directory to $cfgdir$eol"; } -if ($print>=2) { print "Using configuration defaults file $config_defaults_file$eol"; } - -# Initialize the configuration. The $config_def_file provides the definition of a CLM -# configuration, and the $config_defaults_file provides default values for a specific CLM -# configuration. $cfg_ref is a reference to the new configuration object. -my $cfg_ref = Build::Config->new("$cfgdir/config_files/$config_def_file", - "$config_defaults_file"); - -#----------------------------------------------------------------------------------------------- -# CLM root directory. -my $clm_root; - -if ( ! defined($opts{'clm_root'} ) ) { - $clm_root = abs_path("$cfgdir/.."); -} else { - $clm_root = $opts{'clm_root'}; -} - -if ( &is_valid_directory( "$clm_root/src", allowEnv=>0 ) ) { - $cfg_ref->set('clm_root', $clm_root); -} else { - die <<"EOF"; -** Invalid CLM root directory: $clm_root -** -** The CLM root directory must contain the subdirectory /src/. -** clm_root can be entered on the command line or it will be derived -** from the location of this script. -EOF -} - -if ($print>=2) { print "Setting CLM root directory to $clm_root$eol"; } - -#----------------------------------------------------------------------------------------------- -# CLM build directory is current directory -my $clm_bld = `pwd`; -chomp( $clm_bld ); - -# Make sure directory is valid -if ( ! &is_valid_directory( $clm_bld ) and ! mkdirp($clm_bld)) { - die <<"EOF"; -** Could not create the specified CLM build directory: $clm_bld -EOF -} - -if ($print>=2) { print "Setting CLM build directory to $clm_bld$eol"; } - -#----------------------------------------------------------------------------------------------- -# User source directories. -my $usr_src = ''; -if (defined $opts{'usr_src'}) { - my @dirs = split ',', $opts{'usr_src'}; - my @adirs; - while ( my $dir = shift @dirs ) { - if (&is_valid_directory( "$dir", allowEnv=>0 ) ) { - push @adirs, $dir; - } else { - die "** User source directory does not exist: $dir\n"; - } - } - $usr_src = join ',', @adirs; - $cfg_ref->set('usr_src', $usr_src); -} - -if ($print>=2) { print "Setting user source directories to $usr_src$eol"; } - -#----------------------------------------------------------------------------------------------- -# configuration cache directory and file. -my $config_cache_dir; -my $config_cache_file; -if (defined $opts{'cachedir'}) { - $config_cache_dir = abs_path($opts{'cachedir'}); -} -else { - $config_cache_dir = $clm_bld; -} - -if (&is_valid_directory( $config_cache_dir, allowEnv=>0 ) or mkdirp($config_cache_dir)) { - $config_cache_file = "$config_cache_dir/$opts{'cache'}"; -} else { - die <<"EOF"; -** Could not create the specified directory for configuration cache file: $config_cache_dir -EOF -} - -if ($print>=2) { print "The configuration cache file will be created in $config_cache_file$eol"; } - - -#----------------------------------------------------------------------------------------------- -# physics - -$cfg_ref->set('phys', $opts{'phys'}); -my $phys_string = $phys->as_string(); -if ($print>=2) { - if( defined($opts{'phys'}) ) { - print "Using version $phys_string physics.$eol"; - } -} - -#----------------------------------------------------------------------------------------------- -# supported single point configurations -my $sitespf_pt = undef; -if ($phys->as_long() == $phys->as_long("clm4_0") ) { - if( defined($opts{'sitespf_pt'}) ) { - $cfg_ref->set('sitespf_pt', $opts{'sitespf_pt'}); - } - $sitespf_pt = $cfg_ref->get('sitespf_pt'); - if ($print>=2) { - if( defined($opts{'sitespf_pt'}) ) { - print "Using $sitespf_pt for supported single point configuration.$eol"; - } - } -} - -#----------------------------------------------------------------------------------------------- -# NOIO option -my $noio = undef; -if ($phys->as_long() == $phys->as_long("clm4_0") ) { - if (defined $opts{'noio'}) { - $cfg_ref->set('noio', "on" ); - } - $noio = $cfg_ref->get('noio'); - if ($print>=2) { - if ( $noio eq "on") { print "ALL history output is turned OFF.$eol"; } - } -} -#----------------------------------------------------------------------------------------------- -# BGC option -my $bgc_mode = undef; -if ($phys->as_long() == $phys->as_long("clm4_0") ) { - if (defined $opts{'bgc'}) { - $cfg_ref->set('bgc', $opts{'bgc'}); - } - $bgc_mode = $cfg_ref->get('bgc'); - if ($print>=2) { print "Using $bgc_mode for bgc.$eol"; } - if ( $bgc_mode eq "casa" ) { - print "Warning:: bgc=casa is NOT validated / scientifically supported.$eol"; - } -} - -# NOFIRE option -- currently only in bgc=CN -my $nofire = undef; -if ($phys->as_long() == $phys->as_long("clm4_0") ) { - if (defined $opts{'nofire'}) { - $cfg_ref->set('nofire', "on" ); - } - $nofire = $cfg_ref->get('nofire'); - if ( ($nofire eq "on") && ($bgc_mode ne "cn") ) { - die <<"EOF"; -** Cannot turn nofire mode on -- without cn for bgc mode** -EOF - } - if ($print>=2 && $bgc_mode =~ /^cn/ ) { - if ( $nofire eq "off") { print "Wildfires are active as normal.$eol"; } - else { print "Wildfires are turned off.$eol"; } - } -} - -#----------------------------------------------------------------------------------------------- -# SPINUP option for BGC/CN mode only -my $spinup = undef; -if ($phys->as_long() == $phys->as_long("clm4_0") ) { - if (defined $opts{'spinup'}) { - $cfg_ref->set('spinup', $opts{'spinup'}); - } - $spinup = $cfg_ref->get('spinup'); - if ( ($spinup ne "normal" ) && ($bgc_mode ne "cn") ) { - die <<"EOF"; -** Cannot turn spinup mode on -- without cn for bgc mode** -** -** Set the bgc mode by the following means from highest to lowest precedence: -** * by the command-line option -bgc cn -** * by a default configuration file, specified by -defaults -EOF - } - if ($print>=2) { print "Using $spinup for spinup for cn mode.$eol"; } -} else { - if ($opts{'spinup'} ne "normal") { - die <<"EOF"; -** Spinup mode can only be controlled with configure for CLM 4.0. -** For CLM 4.5 use the bgc_spinup option to build-namelist -EOF - } -} - -#----------------------------------------------------------------------------------------------- -# comp_intf option -if (defined $opts{'comp_intf'}) { - $cfg_ref->set('comp_intf', $opts{'comp_intf'}); -} -my $comp_intf = $cfg_ref->get('comp_intf'); -if ($print>=2) { print "Using $comp_intf for comp_intf.$eol"; } - - -#----------------------------------------------------------------------------------------------- -# CROP option -my $crpmode = undef; -my $crop = undef; -if ($phys->as_long() == $phys->as_long("clm4_0") ) { - if (defined $opts{'crop'}) { - $cfg_ref->set('crop', $opts{'crop'}); - } - $crpmode = "nocrop"; - $crop = $cfg_ref->get('crop'); - if ( $crop eq "on" ) { - $crpmode = "crop"; - } - if ( ($crop eq "on" ) && ($bgc_mode ne "cn") && ($bgc_mode ne "cndv") ) { - die <<"EOF"; -** Cannot turn crop mode on -- without some form of cn for bgc mode** -** -** Set the bgc mode by the following means from highest to lowest precedence: -** * by the command-line options -bgc cn -** * by a default configuration file, specified by -defaults -EOF - } -} - -#----------------------------------------------------------------------------------------------- -# MAXPFT option - -my %maxpatchpft; -my $maxpft = undef; -if ($phys->as_long() == $phys->as_long("clm4_0") ) { - $maxpatchpft{'crop'} = 21; - $maxpatchpft{'nocrop'} = 17; - - $cfg_ref->set('maxpft', $maxpatchpft{$crpmode} ); - $maxpft = $cfg_ref->get('maxpft'); - if ( (($bgc_mode eq "cn") || ($bgc_mode eq "cndv")) && ($maxpft != $maxpatchpft{$crpmode}) ) { - die <<"EOF"; -** For CN or CNDV BGC mode you MUST set max patch PFT's to $maxpatchpft{$crpmode} -** -** When the crop model is on then it must be set to $maxpatchpft{'crop'} otherwise to $maxpatchpft{'nocrop'} -** Set the bgc mode, crop and maxpft by the following means from highest to lowest precedence: -** * by the command-line options -bgc, -crop and -maxpft -** * by a default configuration file, specified by -defaults -** -EOF - } - if ( $maxpft > $maxpatchpft{$crpmode} ) { - die <<"EOF"; -** Max patch PFT's can NOT exceed $maxpatchpft{$crpmode} -** -** Set maxpft by the following means from highest to lowest precedence: -** * by the command-line options -maxpft -** * by a default configuration file, specified by -defaults -** -EOF - } - if ( $maxpft != $maxpatchpft{$crpmode} ) { - print "Warning:: running with maxpft NOT equal to $maxpatchpft{$crpmode} is " . - "NOT validated / scientifically supported.$eol"; - } - if ($print>=2) { print "Using $maxpft for maxpft.$eol"; } -} -#----------------------------------------------------------------------------------------------- -# SNICAR_FRC option -my $snicar_frc = undef; -if ($phys->as_long() == $phys->as_long("clm4_0") ) { - if (defined $opts{'snicar_frc'}) { - $cfg_ref->set('snicar_frc', $opts{'snicar_frc'}); - } - $snicar_frc = $cfg_ref->get('snicar_frc'); - if ($print>=2) { print "Using $snicar_frc for snicar_frc.$eol"; } -} - -#----------------------------------------------------------------------------------------------- -# Makefile configuration ####################################################################### -#----------------------------------------------------------------------------------------------- - -#----------------------------------------------------------------------------------------------- -# Name of CLM executable. -my $clm_exe = "clm"; - -if ($print>=2) { print "Name of CLM executable: $clm_exe.$eol"; } - -#----------------------------------------------------------------------------------------------- -# For the CPP tokens, start with the defaults (from defaults file) and append the specifications -# from the commandline. That way the user can override defaults since the commandline versions -# occur last. -my $usr_cppdefs = $cfg_ref->get('cppdefs'); -if (defined $opts{'cppdefs'}) { - $usr_cppdefs .= " $opts{'cppdefs'}"; - print "Warning:: running with user defined cppdefs is NOT validated / " . - "scientifically supported.$eol"; -} -$cfg_ref->set('cppdefs', $usr_cppdefs); - -if ($usr_cppdefs and $print>=2) { print "Default and user CPP definitions: \'$usr_cppdefs\'$eol";} - -# The following CPP macro definitions are used to implement the compile-time options. They are -# determined by the configuration parameters that have been set above. They will be appended to -# the CPP definitions that were explicitly set in the defaults file or by the user on the commandline. -my $cfg_cppdefs = ''; -if ($phys->as_long() == $phys->as_long("clm4_0") ) { - $cfg_cppdefs .= " -DMAXPATCH_PFT=$maxpft"; - - if ($bgc_mode eq 'cn') { - $cfg_cppdefs .= " -DCN"; - } - if ($crop eq 'on') { - $cfg_cppdefs .= " -DCROP"; - } - if ($bgc_mode eq 'cndv') { - $cfg_cppdefs .= " -DCNDV -DCN"; - } - if ($nofire eq 'on') { - $cfg_cppdefs .= " -DNOFIRE"; - } - if ($noio eq 'on') { - $cfg_cppdefs .= " -D_NOIO"; - } - if ($spinup eq 'AD') { - $cfg_cppdefs .= " -DAD_SPINUP"; - } elsif ($spinup eq 'exit') { - $cfg_cppdefs .= " -DEXIT_SPINUP"; - } - if ( $snicar_frc eq 'on' ) { - $cfg_cppdefs .= " -DSNICAR_FRC"; - } -} elsif ($phys->as_long() >= $phys->as_long("clm4_5") ) { - # clm4_5 cppdefs -- SHOULD NOT BE ANY! - if ( $cfg_cppdefs ne '' ) { - die <<"EOF"; -** CPP definitions should be empty for clm5_0 and is NOT ** -EOF - } -} elsif ($phys->as_long() == $phys->as_long("clm5_0") ) { - # clm5_0 cppdefs -- SHOULD NOT BE ANY! - if ( $cfg_cppdefs ne '' ) { - die <<"EOF"; -** CPP definitions should be empty for clm5_0 and is NOT ** -EOF - } -} else { - # this should NOT happen - die <<"EOF"; -** Bad CLM physics version ** -EOF -} -# CPP defines to put on Makefile -my $make_cppdefs = "$usr_cppdefs $cfg_cppdefs"; - -if ($print>=2) { print "CPP definitions set by configure: \'$cfg_cppdefs\'$eol"; } - -#----------------------------------------------------------------------------------------------- -# Write configuration files #################################################################### -#----------------------------------------------------------------------------------------------- - -my $fp_filename = 'Filepath'; # name of output filepath file -my $cpp_filename = 'CESM_cppdefs'; # name of output file for clm's cppdefs in cesm - -# Write the filepath file for cesm. -write_filepath_cesmbld("$clm_bld/$fp_filename", $cfg_ref, $phys, allowEnv=>0 ); -if ($print>=2) { print "creating $clm_bld/$fp_filename\n"; } - -# Write the file for clm's cppdefs needed in cesm. -write_cppdefs("$clm_bld/$cpp_filename", $make_cppdefs); -if ($print>=2) { print "creating $clm_bld/$cpp_filename\n"; } - -# Write the configuration file. -$cfg_ref->write_file($config_cache_file, $commandline); -if ($print>=2) { print "creating $config_cache_file\n"; } - -#----------------------------------------------------------------------------------------------- -# Done -chdir( $cwd ) || die <<"EOF"; -** Trouble changing directory back to $cwd -** -EOF -if ($print) { print "CLM configure done.\n"; } -exit; - -#----------------------------------------------------------------------------------------------- -# FINISHED #################################################################################### -#----------------------------------------------------------------------------------------------- - -#------------------------------------------------------------------------------- - -sub write_filepath_cesmbld -{ - my ($file, $cfg_ref, $phys, %opts) = @_; - my $fh = new IO::File; - - $fh->open(">$file") or die "** can't open filepath file: $file\n"; - - # configuration parameters used to determine paths - my $usr_src = $cfg_ref->get('usr_src'); - my $clm_root = $cfg_ref->get('clm_root'); - - # User specified source directories. - if ($usr_src =~ /\S+/) { - my @dirs = split ',', $usr_src; - while ( my $dir = shift @dirs ) { - print $fh "$dir\n"; - } - } else { - print $fh "../SourceMods/src.clm\n"; - } - - if ($phys->as_long() == $phys->as_long("clm4_0") ) { - # source root - my $srcdir = "$clm_root/src_clm40"; - if ( ! &is_valid_directory( "$srcdir", %opts ) ) { die "** source directory does not exist: $srcdir\n"; } - - # source directories under root - my @dirs = ( "main", "biogeophys", "biogeochem" ); - foreach my $dir ( @dirs ) { - if ( &is_valid_directory( "$srcdir/$dir", %opts ) ) { - print $fh "$srcdir/$dir\n"; - } else { - die "** source directory does not exist: $srcdir/$dir\n"; - } - } - } else { - # source root - my $srcdir = "$clm_root/src"; - if ( ! &is_valid_directory( "$srcdir", %opts ) ) { die "** source directory does not exist: $srcdir\n"; } - - # source directories under root - my @dirs = ( "main", - "biogeophys", - "biogeochem", - "soilbiogeochem", - "dyn_subgrid", - "init_interp", - "fates", - "fates/main", - "fates/biogeophys", - "fates/biogeochem", - "fates/fire", - "utils", - "cpl" ); - - foreach my $dir ( @dirs ) { - if ( &is_valid_directory( "$srcdir/$dir", %opts ) ) { - print $fh "$srcdir/$dir\n"; - } else { - die "** source directory does not exist: $srcdir/$dir\n"; - } - } - } - - - $fh->close; -} -#------------------------------------------------------------------------------- - -sub write_cppdefs -{ - my ($file, $make_cppdefs) = @_; - my $fh = new IO::File; - - $fh->open(">$file") or die "** can't open cpp defs file: $file\n"; - - print $fh "$make_cppdefs\n"; - $fh->close; -} - -#------------------------------------------------------------------------------- - -sub mkdirp { - my ($dir) = @_; - my (@dirs) = split /\//, $dir; - my (@subdirs, $path); - - # if $dir is absolute pathname then @dirs will start with "" - if ($dirs[0] eq "") { push @subdirs, shift @dirs; } - - while ( @dirs ) { # check that each subdir exists and mkdir if it doesn't - push @subdirs, shift @dirs; - $path = join '/', @subdirs; - unless (-d $path or mkdir($path, 0777)) { return 0; } - } - return 1; -} - -#------------------------------------------------------------------------------- - -sub version { -# The version is found in CLM's ChangeLog file. -# $cfgdir is set by the configure script to the name of its directory. - - my ($cfgdir) = @_; - - my $logfile = "$cfgdir/../doc/ChangeLog"; - - my $fh = IO::File->new($logfile, '<') or die "** can't open ChangeLog file: $logfile\n"; - - while (my $line = <$fh>) { - - if ($line =~ /^Tag name:\s*[clm0-9_.-]*\s*[toin]*\s*([cesmclm0-9_.-]+)$/ ) { - print "$1\n"; - exit; - } - } - -} - -#------------------------------------------------------------------------------- - -sub is_valid_directory { -# -# Validate that the input is a valid existing directory. -# - my ($dir, %opts) = @_; - my $nm = "is_valid_directory"; - - my $valid = 0; - if ( -d $dir ) { $valid = 1; } - return( $valid ); - -} - diff --git a/bld/unit_testers/build-namelist_test.pl b/bld/unit_testers/build-namelist_test.pl index 77ea34f13c..9ba38e1eee 100755 --- a/bld/unit_testers/build-namelist_test.pl +++ b/bld/unit_testers/build-namelist_test.pl @@ -138,9 +138,9 @@ sub make_config_cache { # # Figure out number of tests that will run # -my $ntests = 927; +my $ntests = 946; if ( defined($opts{'compare'}) ) { - $ntests += 588; + $ntests += 600; } plan( tests=>$ntests ); @@ -298,6 +298,7 @@ sub make_config_cache { "-use_case 1850_control", "-l_ncpl 1", "-clm_start_type startup", "-namelist '&a irrigate=.false./' -crop -bgc bgc", "-envxml_dir . -infile myuser_nl_clm", + "-fan on -bgc bgc -crop", "-fan atm -bgc cn -crop", "-fan soil -bgc bgc -crop ", "-fan full -bgc bgc -crop", "-ignore_ic_date -clm_start_type branch -namelist '&a nrevsn=\"thing.nc\"/' -bgc bgc -crop", "-ignore_ic_date -clm_start_type startup -namelist '&a finidat=\"thing.nc\"/' -bgc bgc -crop", ) { @@ -403,6 +404,21 @@ sub make_config_cache { GLC_TWO_WAY_COUPLING=>"FALSE", phys=>"clm5_0", }, + "bad_fan_mode" =>{ options=>" -envxml_dir . -fan zztop", + namelst=>"", + GLC_TWO_WAY_COUPLING=>"FALSE", + phys=>"clm5_0", + }, + "fan_wo_crop" =>{ options=>" -envxml_dir . -fan on -bgc bgc", + namelst=>"", + GLC_TWO_WAY_COUPLING=>"FALSE", + phys=>"clm5_0", + }, + "fan_w_fates" =>{ options=>" -envxml_dir . -fan on -bgc fates", + namelst=>"", + GLC_TWO_WAY_COUPLING=>"FALSE", + phys=>"clm5_0", + }, "use_crop without -crop" =>{ options=>" -envxml_dir .", namelst=>"use_crop=.true.", GLC_TWO_WAY_COUPLING=>"FALSE", From ff5f125704ffad8eebadc998dfe260fe76811c70 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 19 Sep 2019 15:20:56 -0600 Subject: [PATCH 108/181] Add a full fan driver fields namelist test to the other drv_flds namelist tests --- bld/unit_testers/build-namelist_test.pl | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/bld/unit_testers/build-namelist_test.pl b/bld/unit_testers/build-namelist_test.pl index 9ba38e1eee..2e81b1a5b9 100755 --- a/bld/unit_testers/build-namelist_test.pl +++ b/bld/unit_testers/build-namelist_test.pl @@ -255,9 +255,9 @@ sub make_config_cache { } &cleanup(); -print "\n==================================================\n"; -print "Test drydep, fire_emis and megan namelists \n"; -print "==================================================\n"; +print "\n=============================================================\n"; +print "Test fan, drydep, fire_emis and megan driver fields namelists \n"; +print "===============================================================\n"; # drydep and megan namelists $phys = "clm5_0"; @@ -265,7 +265,8 @@ sub make_config_cache { &make_config_cache($phys); my @mfiles = ( "lnd_in", "drv_flds_in", $tempfile ); my $mfiles = NMLTest::CompFiles->new( $cwd, @mfiles ); -foreach my $options ( "-drydep", "-megan", "-drydep -megan", "-fire_emis", "-drydep -megan -fire_emis" ) { +foreach my $options ( "-drydep", "-megan", "-drydep -megan", "-fire_emis", "-drydep -megan -fire_emis", + "-fan full -bgc bgc -crop" ) { &make_env_run(); eval{ system( "$bldnml -envxml_dir . $options > $tempfile 2>&1 " ); }; is( $@, '', "options: $options" ); @@ -298,7 +299,7 @@ sub make_config_cache { "-use_case 1850_control", "-l_ncpl 1", "-clm_start_type startup", "-namelist '&a irrigate=.false./' -crop -bgc bgc", "-envxml_dir . -infile myuser_nl_clm", - "-fan on -bgc bgc -crop", "-fan atm -bgc cn -crop", "-fan soil -bgc bgc -crop ", "-fan full -bgc bgc -crop", + "-fan on -bgc bgc -crop", "-fan atm -bgc cn -crop", "-fan soil -bgc bgc -crop ", "-ignore_ic_date -clm_start_type branch -namelist '&a nrevsn=\"thing.nc\"/' -bgc bgc -crop", "-ignore_ic_date -clm_start_type startup -namelist '&a finidat=\"thing.nc\"/' -bgc bgc -crop", ) { From 6fc9a0dddc28952757791c46a1280597aeea2db8 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sat, 21 Sep 2019 11:18:18 -0600 Subject: [PATCH 109/181] Add in fan test mods and add fan tests to the test list, point to Erik's branch of cime, set the fan stream align always (other it initializes it to a bad value that causes it to abort), fix an issue with the ctsm update so using the right water instance, add the fan nitrogen dataset to inputdata and point to it --- Externals.cfg | 2 +- bld/CLMBuildNamelist.pm | 4 ++-- bld/namelist_files/namelist_defaults_ctsm.xml | 4 +++- cime_config/testdefs/testlist_clm.xml | 20 +++++++++++++++++++ .../clm/2009Start/include_user_mods | 1 + .../clm/2009Start/shell_commands | 1 + .../clm/fanFull/include_user_mods | 1 + .../testmods_dirs/clm/fanFull/shell_commands | 1 + .../clm/fanFull2009Start/include_user_mods | 2 ++ src/biogeophys/HydrologyNoDrainageMod.F90 | 4 ++-- 10 files changed, 34 insertions(+), 6 deletions(-) create mode 100644 cime_config/testdefs/testmods_dirs/clm/2009Start/include_user_mods create mode 100755 cime_config/testdefs/testmods_dirs/clm/2009Start/shell_commands create mode 100644 cime_config/testdefs/testmods_dirs/clm/fanFull/include_user_mods create mode 100755 cime_config/testdefs/testmods_dirs/clm/fanFull/shell_commands create mode 100644 cime_config/testdefs/testmods_dirs/clm/fanFull2009Start/include_user_mods diff --git a/Externals.cfg b/Externals.cfg index f83790cbe3..e1b85ea709 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -29,7 +29,7 @@ required = True [cime] local_path = cime protocol = git -repo_url = https://github.com/juliusvira/cime +repo_url = https://github.com/ekluzek/cime branch = fancpl2-up-merge required = True diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 3ede62a434..1945be68a3 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -3014,10 +3014,10 @@ sub setup_logic_fan { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_year_last_fan', 'sim_year'=>$nl_flags->{'sim_year'}, 'sim_year_range'=>$nl_flags->{'sim_year_range'}); # Set align year, if first and last years are different - if ( $nl->get_value('stream_year_first_fan') != $nl->get_value('stream_year_last_fan') ) { + #if ( $nl->get_value('stream_year_first_fan') != $nl->get_value('stream_year_last_fan') ) { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'model_year_align_fan', 'sim_year'=>$nl_flags->{'sim_year'}, 'sim_year_range'=>$nl_flags->{'sim_year_range'}); - } + #} add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_fldfilename_fan'); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fan_to_bgc_crop', 'fan_mode'=>$fan_mode); diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index d61a66fd5b..253a5c7879 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -1046,6 +1046,8 @@ lnd/clm2/surfdata_map/surfdata_ne120np4_78pfts_CMIP6_simyr1850_c170824.nc2010 2010 +2010 + 2010 2010 @@ -1061,7 +1063,7 @@ lnd/clm2/surfdata_map/surfdata_ne120np4_78pfts_CMIP6_simyr1850_c170824.nc2010 2010 -nitrogen.nc +lnd/clm2/paramdata/FAN_nitrogen_soilph_fv1.9x2.5_simyr2010_c20190905.nc bilinear diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 73c04e27f9..dbe9fcecff 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -367,6 +367,26 @@ + + + + + + + + + + + + + + + + + + + + diff --git a/cime_config/testdefs/testmods_dirs/clm/2009Start/include_user_mods b/cime_config/testdefs/testmods_dirs/clm/2009Start/include_user_mods new file mode 100644 index 0000000000..fe0e18cf88 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/2009Start/include_user_mods @@ -0,0 +1 @@ +../default diff --git a/cime_config/testdefs/testmods_dirs/clm/2009Start/shell_commands b/cime_config/testdefs/testmods_dirs/clm/2009Start/shell_commands new file mode 100755 index 0000000000..295e6f9a5c --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/2009Start/shell_commands @@ -0,0 +1 @@ +./xmlchange RUN_STARTDATE=2009-01-01,DATM_CLMNCEP_YR_START=1991,DATM_CLMNCEP_YR_END=2012 diff --git a/cime_config/testdefs/testmods_dirs/clm/fanFull/include_user_mods b/cime_config/testdefs/testmods_dirs/clm/fanFull/include_user_mods new file mode 100644 index 0000000000..23ea3745e6 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/fanFull/include_user_mods @@ -0,0 +1 @@ +../crop diff --git a/cime_config/testdefs/testmods_dirs/clm/fanFull/shell_commands b/cime_config/testdefs/testmods_dirs/clm/fanFull/shell_commands new file mode 100755 index 0000000000..83786a7fb9 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/fanFull/shell_commands @@ -0,0 +1 @@ +./xmlchange --append CLM_BLDNML_OPTS="-fan full" diff --git a/cime_config/testdefs/testmods_dirs/clm/fanFull2009Start/include_user_mods b/cime_config/testdefs/testmods_dirs/clm/fanFull2009Start/include_user_mods new file mode 100644 index 0000000000..a9b10d0dde --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/fanFull2009Start/include_user_mods @@ -0,0 +1,2 @@ +../fanFull +../2009Start diff --git a/src/biogeophys/HydrologyNoDrainageMod.F90 b/src/biogeophys/HydrologyNoDrainageMod.F90 index 058a62cf45..b43fa7efdf 100644 --- a/src/biogeophys/HydrologyNoDrainageMod.F90 +++ b/src/biogeophys/HydrologyNoDrainageMod.F90 @@ -345,7 +345,7 @@ subroutine HydrologyNoDrainage(bounds, & if ( use_fan ) then ! save the h2osoi_liq in top layer before evaluating the soilwater movement - call store_tsl_moisture(waterstatebulk_inst, filter_hydrologyc, num_hydrologyc) + call store_tsl_moisture(b_waterstate_inst, filter_hydrologyc, num_hydrologyc) end if if ( use_fates ) then @@ -358,7 +358,7 @@ subroutine HydrologyNoDrainage(bounds, & if ( use_fan ) then ! use the saved value to calculate the tendency - call eval_tsl_moist_tend(waterstatebulk_inst , filter_hydrologyc, num_hydrologyc) + call eval_tsl_moist_tend(b_waterstate_inst , filter_hydrologyc, num_hydrologyc) end if if (use_vichydro) then From 56f57983bd547e7308920166dfa785ca337febfd Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sat, 21 Sep 2019 11:41:19 -0600 Subject: [PATCH 110/181] Increase wallclock for longer FAN test --- cime_config/testdefs/testlist_clm.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index dbe9fcecff..1b0291aefd 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -384,7 +384,7 @@ - + From 42b434e25821a5244558741e6442a745ffed79a6 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 1 Oct 2019 00:07:48 -0600 Subject: [PATCH 111/181] Remove some extra log output for FAN, add some extra timing for FAN, turn two fan warnings into an abort --- src/biogeochem/CNDriverMod.F90 | 4 ++++ src/biogeochem/Fan2CTSMMod.F90 | 24 ++--------------------- src/biogeophys/HydrologyNoDrainageMod.F90 | 4 ++++ 3 files changed, 10 insertions(+), 22 deletions(-) diff --git a/src/biogeochem/CNDriverMod.F90 b/src/biogeochem/CNDriverMod.F90 index 73c87efa41..b6957c5d24 100644 --- a/src/biogeochem/CNDriverMod.F90 +++ b/src/biogeochem/CNDriverMod.F90 @@ -292,13 +292,17 @@ subroutine CNDriverNoLeaching(bounds, if (use_crop) then + call t_startf('CNNFert') call CNNFert(bounds, num_soilc,filter_soilc, & cnveg_nitrogenflux_inst, soilbiogeochem_nitrogenflux_inst) + call t_stopf('CNNFert') if (.not. use_fun) then ! if FUN is active, then soy fixation handled by FUN + call t_startf('CNSoyfix') call CNSoyfix (bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & waterdiagnosticbulk_inst, crop_inst, cnveg_state_inst, cnveg_nitrogenflux_inst , & soilbiogeochem_state_inst, soilbiogeochem_nitrogenstate_inst, soilbiogeochem_nitrogenflux_inst) + call t_stopf('CNSoyfix') end if end if diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index 7a379cddfa..1eed582607 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -645,7 +645,6 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & get_total_n(ns, nf, 'pools_manure'), get_total_n(ns, nf, 'fluxes_manure')) call balance_check('Fertilizer', nsoilfert_old, & get_total_n(ns, nf, 'pools_fertilizer'), get_total_n(ns, nf, 'fluxes_fertilizer')) - write(iulog, *) 'SoilPH check:', soilph_min, soilph_max, def_ph_count end if call update_summary(ns, nf, filter_soilc, num_soilc) @@ -654,26 +653,6 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & contains - subroutine debug_balance(ns, nf, oldn, columns) - type(soilbiogeochem_nitrogenstate_type), intent(in) :: ns - type(soilbiogeochem_nitrogenflux_type), intent(in) :: nf - real(r8) :: oldn(:) - integer :: columns(:) - - real(r8) :: newn(size(oldn)) - - newn = ns%fan_totn_col - - - print *, 'FAN SUMMARY', columns - print *, 'old total:', sum(oldn(columns)) - print *, 'new total:', sum(newn(columns)) - print *, 'delta:', sum(oldn(columns)) - sum(newn(columns)) - print *, 'new flux:', (sum(nf%fan_totnin_col(columns)) - sum(nf%fan_totnout_col(columns)))*dt - - end subroutine debug_balance - - real(r8) function get_total_n(ns, nf, which) result(total) type(soilbiogeochem_nitrogenstate_type), intent(in) :: ns type(soilbiogeochem_nitrogenflux_type), intent(in) :: nf @@ -738,7 +717,6 @@ subroutine balance_check(label, total_old, total_new, flux) diff = total_new - total_old accflux = flux*dt - write(iulog, *) 'Balance check:', label, diff, accflux end subroutine balance_check @@ -960,6 +938,7 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & if (tan_manure_spread_col(col_grass) > 1) then write(iulog, *) 'bad tan_manure col_grass before adding', n_manure_spread_col(col_grass), & tan_manure_spread_col(col_grass) + call endrun(msg="ERROR bad tan") end if n_manure_spread_col(col_grass) = n_manure_spread_col(col_grass) & + flux_grass_spread / col%wtgcell(col_grass) @@ -968,6 +947,7 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & n_manure_graze_col(col_grass) = n_manure_graze_col(col_grass) + flux_grass_graze / col%wtgcell(col_grass) if (tan_manure_spread_col(col_grass) > 1) then write(iulog, *) 'bad tan_manure col_grass', flux_grass_spread_tan, col%wtgcell(col_grass) + call endrun(msg="ERROR bad tan") end if else if (flux_grass_spread > 0) then continue diff --git a/src/biogeophys/HydrologyNoDrainageMod.F90 b/src/biogeophys/HydrologyNoDrainageMod.F90 index b43fa7efdf..ef9a306ce2 100644 --- a/src/biogeophys/HydrologyNoDrainageMod.F90 +++ b/src/biogeophys/HydrologyNoDrainageMod.F90 @@ -344,8 +344,10 @@ subroutine HydrologyNoDrainage(bounds, & filter_hydrologyc, soilstate_inst, canopystate_inst, b_waterflux_inst, energyflux_inst) if ( use_fan ) then + call t_startf("store_tsl_moisture") ! save the h2osoi_liq in top layer before evaluating the soilwater movement call store_tsl_moisture(b_waterstate_inst, filter_hydrologyc, num_hydrologyc) + call t_stopf("store_tsl_moisture") end if if ( use_fates ) then @@ -357,8 +359,10 @@ subroutine HydrologyNoDrainage(bounds, & canopystate_inst, energyflux_inst, soil_water_retention_curve) if ( use_fan ) then + call t_startf("eval_tsl_moist_tend") ! use the saved value to calculate the tendency call eval_tsl_moist_tend(b_waterstate_inst , filter_hydrologyc, num_hydrologyc) + call t_stopf("eval_tsl_moist_tend") end if if (use_vichydro) then From a6b124ab1adbbb601cb1bef106fd98086183d9d9 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 1 Oct 2019 00:59:16 -0600 Subject: [PATCH 112/181] Some changes to get it to compile with nag compile on izumi, argument order and use of shr_infnan for isnan, rather than isnan that's only available from intel compiler --- src/biogeochem/FanMod.F90 | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/src/biogeochem/FanMod.F90 b/src/biogeochem/FanMod.F90 index dc4778e0ec..e8b7f194fa 100755 --- a/src/biogeochem/FanMod.F90 +++ b/src/biogeochem/FanMod.F90 @@ -21,6 +21,7 @@ module FanMod use shr_const_mod use shr_kind_mod , only : r8 => shr_kind_r8 use QSatMod , only : QSat + use shr_infnan_mod , only : isnan => shr_infnan_isnan #endif implicit none @@ -206,7 +207,7 @@ real(r8) function eval_no3prod(theta, theta_sat, Tg) result(kNO3) real(r8), parameter :: rmax = 1.16e-6_r8 ! Maximum rate of nitrification, s-1 real(r8), parameter :: tmax = 313.0 ! Maximm temperature of microbial activity, K real(r8), parameter :: topt = 301.0 ! Optimal temperature of microbial acticity, K - real(r8), parameter :: asg = 2.4_8 ! a_sigma, empirical factor + real(r8), parameter :: asg = 2.4_r8 ! a_sigma, empirical factor real(r8), parameter :: wmr_crit = 0.12_r8 ! Critical water content, g/g real(r8), parameter :: smrf_b = 2 ! Parameter in soil moisture response function @@ -655,6 +656,7 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend real(r8), intent(in) :: watertend ! time derivative of theta*dz real(r8), intent(in) :: runoff ! surface runoff flux, m/s real(r8), intent(in) :: tandep ! TAN input flux, gN/m2/s + integer, intent(in) :: numpools real(r8), intent(in) :: tanprod(numpools) ! flux of TAN produced (from urea/organic n) in the column real(r8), intent(in) :: water_init ! Initial water volume in the affected patch, m real(r8), intent(in) :: bsw @@ -662,7 +664,6 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend real(r8), intent(in) :: Hconc(numpools) ! H+ concentration, mol/l (npools) real(r8), intent(in) :: dz_layer ! thickness of the volatilization layer, m real(r8), intent(inout) :: tanpools(numpools) ! TAN pools gN/m2 (npools) - integer, intent(in) :: numpools integer, intent(in) :: size_fluxes real(r8), intent(out) :: fluxes(size_fluxes,numpools) ! TAN fluxes, gN/m2/s (type of flux, pool) real(r8), intent(out) :: residual ! "over-aged" TAN produced during the step, gN/m. @@ -794,9 +795,9 @@ end subroutine update_npool subroutine update_pools(tanpools, fluxes, dt, np, nf, fixed) ! Update tan pools using the fluxes and an ad-hoc scheme against negative TAN masses. implicit none + integer, intent(in) :: np, nf real(r8), intent(inout) :: tanpools(np), fluxes(nf,np) real(r8), intent(in) :: dt - integer, intent(in) :: np, nf logical, intent(out), optional :: fixed integer :: ip @@ -1170,11 +1171,11 @@ subroutine get_storage_fluxes_tan_ar(manure_excr, tempr_outside, windspeed, frac & flux_direct, flux_direct_tan, flux_barn, flux_store, flux_resid, flux_resid_tan, & & volat_target_barns, volat_target_stores, volat_coef_barns, volat_coef_stores, tan_fract_excr, nn) - real(8), intent(in), dimension(nn) :: manure_excr, tempr_outside, windspeed, fract_direct - real(8), intent(out), dimension(nn) :: flux_barn, flux_store, flux_direct, flux_resid, & - & flux_direct_tan, flux_resid_tan - real(8), intent(in) :: volat_target_barns, volat_target_stores, volat_coef_barns, volat_coef_stores, tan_fract_excr integer, intent(in) :: nn + real(r8), intent(in), dimension(nn) :: manure_excr, tempr_outside, windspeed, fract_direct + real(r8), intent(out), dimension(nn) :: flux_barn, flux_store, flux_direct, flux_resid, & + & flux_direct_tan, flux_resid_tan + real(r8), intent(in) :: volat_target_barns, volat_target_stores, volat_coef_barns, volat_coef_stores, tan_fract_excr integer :: ii, status real(r8) :: fluxes_nitr(4), fluxes_tan(4) From 3c8bea87e037e44c75e0cb4cc21e5b99fde06a5b Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Tue, 1 Oct 2019 16:20:58 -0400 Subject: [PATCH 113/181] Restore comment to CNNDeposition --- src/biogeochem/CNNDynamicsMod.F90 | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index 176336fafa..08569ecbcd 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -134,9 +134,21 @@ subroutine CNNDeposition(bounds, num_soilc, filter_soilc, & cnveg_nitrogenstate_inst, cnveg_nitrogenflux_inst, & waterstatebulk_inst, soilstate_inst, temperature_inst, & waterfluxbulk_inst, frictionvel_inst) + ! + ! !DESCRIPTION: + ! On the radiation time step, update the nitrogen deposition rate from + ! atmospheric forcing and if enabled, call FAN to evaluate NH3 volatilization from + ! fertilizers and manure. + ! + ! For now it is assumed that all the atmospheric N deposition goes to the soil mineral + ! N pool. This could be updated later to divide the inputs between mineral N absorbed + ! directly into the canopy and mineral N entering the soil pool. + ! + ! !USES: use CNSharedParamsMod , only: use_fun use clm_time_manager , only: get_step_size, get_curr_date, get_curr_calday, get_nstep - + ! + ! !LOCAL VARIABLES: use clm_varpar , only: max_patch_per_col use LandunitType , only: lun use shr_sys_mod , only : shr_sys_flush From 2043e3aaf8df4dc4b7aeb226ec1280690e6f71b2 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 2 Oct 2019 12:03:24 -0400 Subject: [PATCH 114/181] added commits --- src/biogeochem/Fan2CTSMMod.F90 | 13 +++++++- src/biogeochem/FanMod.F90 | 38 +++++++++++++++-------- src/biogeophys/HydrologyNoDrainageMod.F90 | 4 +++ 3 files changed, 41 insertions(+), 14 deletions(-) diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index 1eed582607..c36916e4e4 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -122,6 +122,9 @@ module Fan2CTSMMod contains subroutine fan_readnml(NLFilename) + ! + ! Read FAN namelist and set the module variables according to it. + ! use spmdMod , only : masterproc, mpicom use fileutils , only : getavu, relavu, opnfil use clm_varctl , only : use_fan @@ -202,7 +205,11 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & use clm_varcon, only : spval, ispval use decompMod, only : bounds_type use subgridAveMod, only: p2c - + ! + ! Evaluate the N fluxes and update the state of the FAN pools. Uses the fertilization + ! flux determined in CropPhenology; the manure inputs come from the FAN stream. The + ! CLM soil N pools are not changed here but in fan_to_sminn. + ! type(bounds_type) , intent(in) :: bounds integer , intent(in) :: num_soilc ! number of soil columns in filter integer , intent(in) :: filter_soilc(:) ! filter for soil columns @@ -1010,6 +1017,10 @@ end subroutine update_summary !************************************************************************************ subroutine fan_to_sminn(filter_soilc, num_soilc, sbgc_nf) + ! + ! Collect the FAN fluxes into totals which are either passed to the CLM N cycle + ! (depending on the fan_to_bgc_ switches) or used diagnostically. + ! use ColumnType, only : col use LandunitType , only: lun use landunit_varcon, only : istcrop, istsoil diff --git a/src/biogeochem/FanMod.F90 b/src/biogeochem/FanMod.F90 index e8b7f194fa..a8be5b9ff3 100755 --- a/src/biogeochem/FanMod.F90 +++ b/src/biogeochem/FanMod.F90 @@ -197,7 +197,6 @@ end subroutine partition_tan real(r8) function eval_no3prod(theta, theta_sat, Tg) result(kNO3) ! Evaluate nitrification rate as in the Riddick et al. (2016) paper but for NH4. - ! Partitioning between TAN forms is not included. real(r8), intent(in) :: theta, theta_sat ! volumetric soil water m/m real(r8), intent(in) :: Tg ! soil temperature, K @@ -246,7 +245,7 @@ subroutine eval_fluxes_slurry(water_surf, water_subsurf, mtan, Hconc, tg, ratm, real(r8), intent(in) :: thetasat ! volumetric soil water at saturation real(r8), intent(in) :: perc ! percolation water flux thourgh the bottom of volatilization layer, m/s real(r8), intent(in) :: runoff ! surface runoff, m/s - real(r8), intent(in) :: bsw + real(r8), intent(in) :: bsw ! water retention curve "b" real(r8), intent(in) :: kads ! dimensionless distribution coefficient, kads = [TAN (s)] / [TAN (aq)] integer, intent(in) :: fluxes_size real(r8), intent(out) :: fluxes(fluxes_size) ! TAN fluxes, see top of the module @@ -434,7 +433,7 @@ end subroutine eval_fluxes_soil subroutine partition_to_layer(water, theta, thetasat, soildepth, fraction_in, fraction_down, fraction_runoff) ! Evaluate the fraction of water volume that can be accommodated (before saturation) - ! by soil layer with current water content theta. + ! by a soil layer with current water content theta. implicit none real(r8), intent(in) :: water ! water to be added to the layer, m real(r8), intent(in) :: theta, thetasat ! vol. soil water, current and saturation, m/m @@ -464,6 +463,10 @@ subroutine partition_to_layer(water, theta, thetasat, soildepth, fraction_in, fr end subroutine partition_to_layer subroutine age_pools_soil(ndep, dt, pools, mtan, garbage) + ! + ! Evaluate the N pool "aging" for one time step; moves N mass from the pools + ! representing younger to older N patches. + ! implicit none real(r8), intent(in) :: ndep ! flux of TAN input, gN/m2/s real(r8), intent(inout) :: mtan(:) ! TAN pools for each age range. gN/m2 @@ -487,6 +490,9 @@ subroutine age_pools_soil(ndep, dt, pools, mtan, garbage) end subroutine age_pools_soil subroutine age_pools_slurry(ndep, dt, water_slurry, tan_slurry, tan_soil, pools, garbage) + ! + ! Age pools, modified for the 4-stage slurry model (only below-surface slurry ages). + ! implicit none real(r8), intent(in) :: ndep ! flux of TAN input, gN/m2/s real(r8), intent(in) :: dt ! timestep, s @@ -561,15 +567,16 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend ! Pool S0 ! evap_slurry = get_evap_pool(tg, ratm, qbot) - !infiltr_slurry = max(depth_slurry / poolranges(1), precip) - infiltr_slurry = depth_slurry / poolranges(1) + + infiltr_slurry = depth_slurry / poolranges(1) ! infiltration rate m/s + ! amount infiltrated by the end of S0: infiltrated = depth_slurry * infiltr_slurry / (infiltr_slurry + evap_slurry) ! Slurry water (in addition to soil water, theta) on surface and in soil. Represents ! mean over pool S0. water_slurry = (/0.5*depth_slurry, 0.5*infiltrated/) ! The excess water assumed to have percolated down from the volat. layer. percolated = max(infiltrated - dz_layer*(thetasat-theta), 0.0) - ! Percolation rate out of volat layer, average over the pool S0. + ! Percolation rate (m/s) out of volat layer, average over the pool S0. perc_slurry_mean = percolated / poolranges(1) call eval_fluxes_slurry(water_slurry(1), water_slurry(2), tanpools(1), Hconc(1), & @@ -595,14 +602,15 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend ! TAN produced (mineralization) goes to directly the old TAN pool. tanpools(4) = tanpools(4) + tanprod*dt - ! Soil bins S1 and S2 + ! Soil bins S1, S2 and S3 ! age_prev = 0 ! for water evaluations, consider beginning of S1 as the starting point water_in_layer = infiltrated - percolated ! water in layer just after slurry has infiltrated water_relax_t = poolranges(2) ! relax time is for soil moisture after infiltration ie. the first "normal" N pool. do indpl = 2, 4 ! water content lost during the aging - waterloss = water_in_layer * (waterfunction(age_prev, water_relax_t) - waterfunction(age_prev+poolranges(indpl), water_relax_t)) + waterloss = water_in_layer * (waterfunction(age_prev, water_relax_t) & + - waterfunction(age_prev+poolranges(indpl), water_relax_t)) percolation = eval_perc(waterloss, evap, precip, watertend, poolranges(indpl)) ! water content at the mean age of the pool @@ -659,7 +667,7 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend integer, intent(in) :: numpools real(r8), intent(in) :: tanprod(numpools) ! flux of TAN produced (from urea/organic n) in the column real(r8), intent(in) :: water_init ! Initial water volume in the affected patch, m - real(r8), intent(in) :: bsw + real(r8), intent(in) :: bsw ! b parameter in soil water retention curve real(r8), intent(in) :: poolranges(numpools) ! age ranges of TAN pools (npools) real(r8), intent(in) :: Hconc(numpools) ! H+ concentration, mol/l (npools) real(r8), intent(in) :: dz_layer ! thickness of the volatilization layer, m @@ -737,7 +745,8 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend age_prev = 0 ! for water evaluations, consider beginning of S1 as the starting point do indpl = 1, size(tanpools) ! water content lost during the aging - waterloss = water_into_layer * (waterfunction(age_prev, water_relax_t) - waterfunction(age_prev+poolranges(indpl), water_relax_t)) + waterloss = water_into_layer * (waterfunction(age_prev, water_relax_t) & + - waterfunction(age_prev+poolranges(indpl), water_relax_t)) percolation = eval_perc(waterloss, evap, precip, watertend, poolranges(indpl)) ! water content at the middle of the age range water_soil = water_into_layer * waterfunction(age_prev + 0.5*poolranges(indpl), water_relax_t) @@ -808,6 +817,8 @@ subroutine update_pools(tanpools, fluxes, dt, np, nf, fixed) do ip = 1, np sumflux = sum(fluxes(:,ip))*dt if (sumflux > tanpools(ip)) then + ! Scale all fluxes equally if flux out of the pools is greater than the pool + ! mass: if (sumflux > 1e-15) then fixed_ = .true. ff = tanpools(ip) / sumflux @@ -921,7 +932,6 @@ subroutine eval_fluxes_storage(nitr_input, barntype, tempr_outside, windspeed, f real(r8), parameter :: tempr_D = 3.0_r8 real(r8), parameter :: Trec = 21.0_r8 real(r8), parameter :: Vmin_barns = 0.2_r8 - !real(r8), parameter :: Vmax_barns = 0.228_r8 real(r8), parameter :: pA = 0.89_r8, pB = 0.26_r8 real(r8), parameter :: DTlow = 0.5_r8, DThigh = 1.0_r8 real(r8), parameter :: vmax_barns_closed = 0.40_r8, vmax_barns_open = 0.228_r8 @@ -998,7 +1008,7 @@ subroutine eval_fluxes_storage(nitr_input, barntype, tempr_outside, windspeed, f fluxes_nitr(iflx_appl) = flux_direct tempr_stores = max(Tfloor_stores, tempr_C) - ! with some data, in some rare places, we can have windspeed < 0 (!?) + ! with some input data, in some rare places, we can have windspeed < 0 (!?) flux_store = flux_avail_tan & & * volat_coef_stores * tempr_stores**pA * max(windspeed, 0.0_r8)**pB flux_store = min(flux_avail_tan, flux_store) @@ -1170,7 +1180,9 @@ end subroutine update_urea subroutine get_storage_fluxes_tan_ar(manure_excr, tempr_outside, windspeed, fract_direct, & & flux_direct, flux_direct_tan, flux_barn, flux_store, flux_resid, flux_resid_tan, & & volat_target_barns, volat_target_stores, volat_coef_barns, volat_coef_stores, tan_fract_excr, nn) - + ! + ! array version of eval_fluxes_storage, used for off-line calibration of the volat_coefs. + ! integer, intent(in) :: nn real(r8), intent(in), dimension(nn) :: manure_excr, tempr_outside, windspeed, fract_direct real(r8), intent(out), dimension(nn) :: flux_barn, flux_store, flux_direct, flux_resid, & diff --git a/src/biogeophys/HydrologyNoDrainageMod.F90 b/src/biogeophys/HydrologyNoDrainageMod.F90 index ef9a306ce2..9ce860bcd5 100644 --- a/src/biogeophys/HydrologyNoDrainageMod.F90 +++ b/src/biogeophys/HydrologyNoDrainageMod.F90 @@ -731,6 +731,8 @@ subroutine HydrologyNoDrainage(bounds, & ! used for diagnosing the downwards moisture flux within FAN. subroutine store_tsl_moisture(waterstatebulk_inst, filter, num_fc) + ! Store the soil water within topmost layer before evaluating soil moisture + ! transport. type(waterstatebulk_type), intent(inout) :: waterstatebulk_inst integer, intent(in) :: filter(:) integer, intent(in) :: num_fc @@ -745,6 +747,8 @@ subroutine store_tsl_moisture(waterstatebulk_inst, filter, num_fc) end subroutine store_tsl_moisture subroutine eval_tsl_moist_tend(waterstatebulk_inst, filter, num_fc) + ! Evaluate the time derivative of soil liquid water due to percolation as required + ! in FAN. type(waterstatebulk_type), intent(inout) :: waterstatebulk_inst integer, intent(in) :: filter(:) integer, intent(in) :: num_fc From f840649523124c60b2daebc19a8adce73869b74d Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 2 Oct 2019 16:53:51 -0400 Subject: [PATCH 115/181] added calculation of NFERTILIZATION depending on fan-bgc mode + new output variables for total manure N and sminn fluxes --- src/biogeochem/CNDriverMod.F90 | 2 +- src/biogeochem/CNNDynamicsMod.F90 | 52 ++++++++++++------- src/biogeochem/CNPhenologyMod.F90 | 8 +-- src/biogeochem/CNVegNitrogenFluxType.F90 | 38 +++++++++----- src/biogeochem/Fan2CTSMMod.F90 | 51 +++++++++++------- .../SoilBiogeochemNitrogenFluxType.F90 | 29 ++++++++++- 6 files changed, 122 insertions(+), 58 deletions(-) diff --git a/src/biogeochem/CNDriverMod.F90 b/src/biogeochem/CNDriverMod.F90 index b6957c5d24..05a015a11c 100644 --- a/src/biogeochem/CNDriverMod.F90 +++ b/src/biogeochem/CNDriverMod.F90 @@ -293,7 +293,7 @@ subroutine CNDriverNoLeaching(bounds, if (use_crop) then call t_startf('CNNFert') - call CNNFert(bounds, num_soilc,filter_soilc, & + call CNNFert(bounds, num_soilc,filter_soilc, num_pcropp, filter_pcropp, & cnveg_nitrogenflux_inst, soilbiogeochem_nitrogenflux_inst) call t_stopf('CNNFert') diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index 08569ecbcd..68ba9f3f3c 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -312,8 +312,9 @@ end subroutine CNNFixation !----------------------------------------------------------------------- subroutine CNNFert(bounds, num_soilc, filter_soilc, & + num_pcropp, filter_pcropp, & cnveg_nitrogenflux_inst, soilbiogeochem_nitrogenflux_inst) - use Fan2CTSMMod, only : fan_to_sminn + use Fan2CTSMMod, only : fan_to_sminn, fan_to_bgc_crop ! ! !DESCRIPTION: ! On the radiation time step, update the nitrogen fertilizer for crops @@ -325,37 +326,50 @@ subroutine CNNFert(bounds, num_soilc, filter_soilc, & type(bounds_type) , intent(in) :: bounds integer , intent(in) :: num_soilc ! number of soil columns in filter integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer , intent(in) :: num_pcropp ! number of prognostic crop pathches + integer , intent(in) :: filter_pcropp(:)! filter for prognostic crop patches type(cnveg_nitrogenflux_type) , intent(in) :: cnveg_nitrogenflux_inst type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst ! ! !LOCAL VARIABLES: - integer :: c,fc ! indices + integer :: c,fc, p, fp ! indices real(r8) :: manure_col(bounds%begc:bounds%endc) !----------------------------------------------------------------------- associate( & - fert => cnveg_nitrogenflux_inst%fert_patch , & ! Input: [real(r8) (:)] nitrogen fertilizer rate (gN/m2/s) - manure => cnveg_nitrogenflux_inst%manure_patch , & ! Input: [real(r8) (:)] manure nitrogen rate (gN/m2/s) + synthfert => cnveg_nitrogenflux_inst%synthfert_patch , & ! Input: [real(r8) (:)] nitrogen fertilizer rate (gN/m2/s) + manure => cnveg_nitrogenflux_inst%manure_patch , & ! Input: [real(r8) (:)] manure nitrogen rate (gN/m2/s) + totalfert => cnveg_nitrogenflux_inst%nfertilization_patch, & ! Input: [real(r8) (:)] manure nitrogen rate (gN/m2/s) fert_to_sminn => soilbiogeochem_nitrogenflux_inst%fert_to_sminn_col & ! Output: [real(r8) (:)] ) - call p2c(bounds, num_soilc, filter_soilc, & - fert(bounds%begp:bounds%endp), & - fert_to_sminn(bounds%begc:bounds%endc)) - call p2c(bounds, num_soilc, filter_soilc, & - manure(bounds%begp:bounds%endp), & - manure_col(bounds%begc:bounds%endc)) - ! Add the manure N processed above: - do fc = 1, num_soilc - c = filter_soilc(fc) - fert_to_sminn(c) = fert_to_sminn(c) + manure_col(c) - end do + + if (.not. fan_to_bgc_crop) then + ! => Crop columns/patches are not handled by FAN. Use synthfert directly and add + ! the default CLM manure. No N input to non-crop columns in this case. + call p2c(bounds, num_soilc, filter_soilc, & + synthfert(bounds%begp:bounds%endp), & + fert_to_sminn(bounds%begc:bounds%endc)) + call p2c(bounds, num_soilc, filter_soilc, & + manure(bounds%begp:bounds%endp), & + manure_col(bounds%begc:bounds%endc)) + ! Add the manure N processed above: + do fc = 1, num_soilc + c = filter_soilc(fc) + fert_to_sminn(c) = fert_to_sminn(c) + manure_col(c) + end do + ! Add up synthetic fertilizer and manure to the nfertilization output variable. + do fp = 1, num_pcropp + p = filter_pcropp(fp) + totalfert(p) = synthfert(p) + manure(p) + end do + end if + + ! if fan_to_bgc_crop == .true., FAN fills in the fert_to_sminn and totalfert for + ! crops. It might also fill in the non-crop columns if enabled. + call fan_to_sminn(bounds, filter_soilc, num_soilc, soilbiogeochem_nitrogenflux_inst, totalfert) end associate - - ! Fan may overwrite fert_to_sminn for some or all columns if enabled. - ! - if (use_fan) call fan_to_sminn(filter_soilc, num_soilc, soilbiogeochem_nitrogenflux_inst) end subroutine CNNFert diff --git a/src/biogeochem/CNPhenologyMod.F90 b/src/biogeochem/CNPhenologyMod.F90 index 182a9e7681..fd94252216 100644 --- a/src/biogeochem/CNPhenologyMod.F90 +++ b/src/biogeochem/CNPhenologyMod.F90 @@ -1535,7 +1535,7 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & leafn_xfer => cnveg_nitrogenstate_inst%leafn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) leaf N transfer crop_seedn_to_leaf => cnveg_nitrogenflux_inst%crop_seedn_to_leaf_patch, & ! Output: [real(r8) (:) ] (gN/m2/s) seed source to leaf cphase => crop_inst%cphase_patch , & ! Output: [real(r8) (:)] phenology phase - fert => cnveg_nitrogenflux_inst%fert_patch , & ! Output: [real(r8) (:) ] (gN/m2/s) fertilizer applied each timestep + synthfert => cnveg_nitrogenflux_inst%synthfert_patch , & ! Output: [real(r8) (:) ] (gN/m2/s) fertilizer applied each timestep manure => cnveg_nitrogenflux_inst%manure_patch & ! Output: [real(r8) (:) ] (gN/m2/s) manure applied each timestep ) @@ -1952,10 +1952,10 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & onset_counter(p) = dt fert_counter(p) = ndays_on * secspday if (ndays_on .gt. 0) then - fert(p) = fertnitro(p) / fert_counter(p) + synthfert(p) = fertnitro(p) / fert_counter(p) manure(p) = (manunitro(ivt(p)) * 1000._r8) / fert_counter(p) else - fert(p) = 0._r8 + synthfert(p) = 0._r8 manure(p) = 0._r8 end if else @@ -2014,7 +2014,7 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & ! assumes that onset of phase 2 took one time step only if (fert_counter(p) <= 0._r8) then - fert(p) = 0._r8 + synthfert(p) = 0._r8 manure(p) = 0._r8 else ! continue same fert application every timestep fert_counter(p) = fert_counter(p) - dtrad diff --git a/src/biogeochem/CNVegNitrogenFluxType.F90 b/src/biogeochem/CNVegNitrogenFluxType.F90 index 9f4b25080d..1e378b5494 100644 --- a/src/biogeochem/CNVegNitrogenFluxType.F90 +++ b/src/biogeochem/CNVegNitrogenFluxType.F90 @@ -164,9 +164,10 @@ module CNVegNitrogenFluxType real(r8), pointer :: deadstemn_storage_to_xfer_patch (:) ! patch dead stem N shift storage to transfer (gN/m2/s) real(r8), pointer :: livecrootn_storage_to_xfer_patch (:) ! patch live coarse root N shift storage to transfer (gN/m2/s) real(r8), pointer :: deadcrootn_storage_to_xfer_patch (:) ! patch dead coarse root N shift storage to transfer (gN/m2/s) - real(r8), pointer :: fert_patch (:) ! patch applied fertilizer (gN/m2/s) + real(r8), pointer :: synthfert_patch (:) ! patch applied synthetic fertilizer (gN/m2/s) real(r8), pointer :: manure_patch (:) ! patch applied manure (gN/m2/s) - + real(r8), pointer :: nfertilization_patch (:) ! patch applied total (synth. + manure) fertilizer (gN/m2/s) + real(r8), pointer :: fert_counter_patch (:) ! patch >0 fertilize; <=0 not real(r8), pointer :: soyfixn_patch (:) ! patch soybean fixed N (gN/m2/s) @@ -418,8 +419,9 @@ subroutine InitAllocate(this, bounds) allocate(this%grainn_to_seed_patch (begp:endp)) ; this%grainn_to_seed_patch (:) = nan allocate(this%grainn_xfer_to_grainn_patch (begp:endp)) ; this%grainn_xfer_to_grainn_patch (:) = nan allocate(this%grainn_storage_to_xfer_patch (begp:endp)) ; this%grainn_storage_to_xfer_patch (:) = nan - allocate(this%fert_patch (begp:endp)) ; this%fert_patch (:) = nan + allocate(this%synthfert_patch (begp:endp)) ; this%synthfert_patch (:) = nan allocate(this%manure_patch (begp:endp)) ; this%manure_patch (:) = nan + allocate(this%nfertilization_patch (begp:endp)) ; this%nfertilization_patch (:) = nan allocate(this%fert_counter_patch (begp:endp)) ; this%fert_counter_patch (:) = nan allocate(this%soyfixn_patch (begp:endp)) ; this%soyfixn_patch (:) = nan @@ -947,14 +949,17 @@ subroutine InitHistory(this, bounds) ptr_patch=this%fire_nloss_patch) if (use_crop) then - this%fert_patch(begp:endp) = spval + this%nfertilization_patch(begp:endp) = spval call hist_addfld1d (fname='NFERTILIZATION', units='gN/m^2/s', & - avgflag='A', long_name='fertilizer added', & - ptr_patch=this%fert_patch) + avgflag='A', long_name='Total fertilizer N added', & + ptr_patch=this%nfertilization_patch) this%manure_patch(begp:endp) = spval call hist_addfld1d (fname='NMANURE', units='gN/m^2/s', & - avgflag='A', long_name='manure added', & - ptr_patch=this%manure_patch) + avgflag='A', long_name='Manure N added', & + ptr_patch=this%manure_patch, default='inactive') + call hist_addfld1d (fname='NSYNTHFERT', units='gN/m^2/s', & + avgflag='A', long_name='Syntheric fertilizer N added', & + ptr_patch=this%manure_patch, default='inactive') end if if (use_crop .and. .not. use_fun) then @@ -1264,10 +1269,11 @@ subroutine InitCold(this, bounds) l = patch%landunit(p) if ( use_crop )then - this%fert_counter_patch(p) = spval - this%fert_patch(p) = 0._r8 - this%manure_patch(p) = 0._r8 - this%soyfixn_patch(p) = 0._r8 + this%fert_counter_patch(p) = spval + this%nfertilization_patch(p) = 0._r8 + this%synthfert_patch(p) = 0._r8 + this%manure_patch(p) = 0._r8 + this%soyfixn_patch(p) = 0._r8 end if if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then @@ -1351,16 +1357,20 @@ subroutine Restart (this, bounds, ncid, flag ) long_name='', units='', & interpinic_flag='interp', readvar=readvar, data=this%fert_counter_patch) - call restartvar(ncid=ncid, flag=flag, varname='fert', xtype=ncd_double, & + call restartvar(ncid=ncid, flag=flag, varname='synthfert', xtype=ncd_double, & dim1name='pft', & long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%fert_patch) + interpinic_flag='interp', readvar=readvar, data=this%synthfert_patch) call restartvar(ncid=ncid, flag=flag, varname='manure', xtype=ncd_double, & dim1name='pft', & long_name='', units='', & interpinic_flag='interp', readvar=readvar, data=this%manure_patch) + call restartvar(ncid=ncid, flag=flag, varname='nfertilization', xtype=ncd_double, & + dim1name='pft', & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%nfertilization_patch) end if if (use_crop) then diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index c36916e4e4..fbdaa186b7 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -112,8 +112,8 @@ module Fan2CTSMMod real(r8) :: fract_spread_grass = 1.0_r8 ! Fan coupling to soil BGC. Can be set on separately for crop and other columns. - logical :: fan_to_bgc_crop = .false. - logical :: fan_to_bgc_veg = .false. + logical, public :: fan_to_bgc_crop = .false. + logical, public :: fan_to_bgc_veg = .false. ! Whether manure N in mixed/landless systems (manure_sgrz and manure_ngrz streams) is ! defined per crop or land area: @@ -290,7 +290,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & nf%man_tan_appl_col(bounds%begc:bounds%endc) = 0.0 call p2c(bounds, num_soilc, filter_soilc, & - cnv_nf%fert_patch(bounds%begp:bounds%endp), & + cnv_nf%synthfert_patch(bounds%begp:bounds%endp), & nf%fert_n_appl_col(bounds%begc:bounds%endc)) nf%man_n_appl_col(bounds%begc:bounds%endc) = 0.0_r8 @@ -359,7 +359,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & if (.not. col%active(c) .or. col%wtgcell(c) < 1e-15) cycle if (nf%man_n_appl_col(c) > 1e12 .or. ngrz(c) > 1e12) then - write(iulog, *) c, nf%man_n_appl_col(c), ngrz(c), cnv_nf%fert_patch(col%patchi(c):col%patchf(c)), & + write(iulog, *) c, nf%man_n_appl_col(c), ngrz(c), cnv_nf%synthfert_patch(col%patchi(c):col%patchf(c)), & cnv_nf%manure_patch(col%patchi(c):col%patchf(c)) call endrun('nf%man_n_appl_col(c) is spval') end if @@ -1009,14 +1009,14 @@ subroutine update_summary(ns, nf, filter_soilc, num_soilc) nf%fan_totnin_col(c) = fluxin nf%fan_totnout_col(c) = fluxout - + nf%manure_n_total_col(c) = nf%man_n_grz_col(c) + nf%man_n_barns_col(c) end do end subroutine update_summary !************************************************************************************ - subroutine fan_to_sminn(filter_soilc, num_soilc, sbgc_nf) + subroutine fan_to_sminn(bounds, filter_soilc, num_soilc, sbgc_nf, nfertilization_patch) ! ! Collect the FAN fluxes into totals which are either passed to the CLM N cycle ! (depending on the fan_to_bgc_ switches) or used diagnostically. @@ -1024,26 +1024,41 @@ subroutine fan_to_sminn(filter_soilc, num_soilc, sbgc_nf) use ColumnType, only : col use LandunitType , only: lun use landunit_varcon, only : istcrop, istsoil - + + type(bounds_type), intent(in) :: bounds integer, intent(in) :: filter_soilc(:) integer, intent(in) :: num_soilc type(soilbiogeochem_nitrogenflux_type), intent(inout) :: sbgc_nf - - integer :: c, fc - real(r8) :: fan_nflux - + ! patch level fertilizer application + manure production + real(r8), intent(inout) :: nfertilization_patch(bounds%begp:) + + integer :: c, fc, p + real(r8) :: flux_manure, flux_fert, manure_prod + logical :: included + if (.not. (fan_to_bgc_veg .or. fan_to_bgc_crop)) return do fc = 1, num_soilc c = filter_soilc(fc) - fan_nflux & - = sbgc_nf%fert_no3_prod_col(c) + sbgc_nf%fert_nh4_to_soil_col(c) & - + sbgc_nf%manure_no3_prod_col(c) + sbgc_nf%manure_nh4_to_soil_col(c) - if (lun%itype(col%landunit(c)) == istcrop .and. fan_to_bgc_crop) then - sbgc_nf%fert_to_sminn_col(c) = fan_nflux - else if (lun%itype(col%landunit(c)) == istsoil .and. fan_to_bgc_veg) then - sbgc_nf%fert_to_sminn_col(c) = fan_nflux + flux_manure = sbgc_nf%manure_no3_prod_col(c) + sbgc_nf%manure_nh4_to_soil_col(c) + flux_fert = sbgc_nf%fert_no3_prod_col(c) + sbgc_nf%fert_nh4_to_soil_col(c) + manure_prod = sbgc_nf%man_n_barns_col(c) + sbgc_nf%man_n_grz_col(c) + + included = (lun%itype(col%landunit(c)) == istcrop .and. fan_to_bgc_crop) & + .or. (lun%itype(col%landunit(c)) == istsoil .and. fan_to_bgc_veg) + + if (included) then + sbgc_nf%fert_to_sminn_col(c) = flux_fert + flux_manure + sbgc_nf%manure_n_to_sminn_col(c) = flux_manure + sbgc_nf%fert_n_to_sminn_col(c) = flux_fert + do p = col%patchi(c), col%patchf(c) + ! NFERTILIZATION gets the fertilizer applied + all manure N produced in the + ! column. Note that if fract_spread_grass > 0 then some of this N might be + ! still moved to the native veg. column. + nfertilization_patch(p) = manure_prod + sbgc_nf%fert_n_appl_col(c) + end do end if + end do end subroutine fan_to_sminn diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 index 43429f0b62..2cc5783473 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 @@ -53,6 +53,10 @@ module SoilBiogeochemNitrogenFluxType real(r8), pointer :: nh3_total_col (:) ! Total NH3 emission from agriculture, gN/m2/s real(r8), pointer :: fan_totnout_col (:) ! Total input N into FAN pools, gN/m2/s real(r8), pointer :: fan_totnin_col (:) ! Total output N from FAN pools, gN/m2/s + + real(r8), pointer :: manure_n_to_sminn_col (:) ! Manure N from FAN pools to soil mineral pools, gN/m2/s + real(r8), pointer :: fert_n_to_sminn_col (:) ! Fertilizer N from FAN pools to soil mineral pools, gN/m2/s + real(r8), pointer :: manure_n_total_col (:) ! Total manure N produced, gN/m2/s ! decomposition fluxes real(r8), pointer :: decomp_cascade_ntransfer_vr_col (:,:,:) ! col vert-res transfer of N from donor to receiver pool along decomp. cascade (gN/m3/s) @@ -232,8 +236,12 @@ subroutine InitAllocate(this, bounds) allocate(this%fert_nh4_to_soil_col (begc:endc)) ; this%fert_nh4_to_soil_col (:) = spval allocate(this%manure_nh4_runoff_col (begc:endc)) ; this%manure_nh4_runoff_col (:) = spval allocate(this%fert_nh4_runoff_col (begc:endc)) ; this%fert_nh4_runoff_col (:) = spval + + allocate(this%manure_n_to_sminn_col (begc:endc)) ; this%manure_n_to_sminn_col (:) = spval + allocate(this%fert_n_to_sminn_col (begc:endc)) ; this%fert_n_to_sminn_col (:) = spval + allocate(this%manure_n_total_col (begc:endc)) ; this%manure_n_total_col (:) = spval end if - ! Allocate FAN summary fluxes even if FAN is off and set them to 0. + ! Allocate the FAN summary fluxes even if FAN is off and set them to 0. allocate(this%fan_totnin_col (begc:endc)) ; this%fan_totnin_col (:) = spval allocate(this%fan_totnout_col (begc:endc)) ; this%fan_totnout_col (:) = spval @@ -479,6 +487,21 @@ subroutine InitHistory(this, bounds) call hist_addfld1d( fname='FERT_NH4_RUNOFF', units='gN/m^2/s', & avgflag='A', long_name='NH4 (and urea) in surface runoff, fertilizer', & ptr_col=this%fert_nh4_runoff_col) + + this%fert_n_to_sminn_col(begc:endc) = spval + call hist_addfld1d( fname='FERT_N_TO_SMINN', units='gN/m^2/s', & + avgflag='A', long_name='Fertilizer NH4, NO3 and urea-N from FAN to soil mineral pools', & + ptr_col=this%fert_n_to_sminn_col) + + this%manure_n_to_sminn_col(begc:endc) = spval + call hist_addfld1d( fname='MANURE_N_TO_SMINN', units='gN/m^2/s', & + avgflag='A', long_name='Manure NH4 and NO3 from FAN to soil mineral pools', & + ptr_col=this%manure_n_to_sminn_col) + + this%manure_n_total_col(begc:endc) = spval + call hist_addfld1d( fname='MANURE_N_TOTAL', units='gN/m^2/s', & + avgflag='A', long_name='Total manure N produced', & + ptr_col=this%manure_n_total_col) end if this%fan_totnin_col(begc:endc) = spval @@ -1187,7 +1210,9 @@ subroutine SetValues ( this, & this%fert_nh4_to_soil_col(i) = value_column this%manure_nh4_runoff_col(i) = value_column this%fert_nh4_runoff_col(i) = value_column - + this%manure_n_to_sminn_col(i) = value_column + this%manure_n_total_col(i) = value_column + this%fert_n_to_sminn_col(i) = value_column end do end if From 84ddc7306ccfc13e66795579ec3bf199fcc45452 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 9 Oct 2019 13:46:17 -0600 Subject: [PATCH 116/181] zero nmanure if fan_to_bgc_crop --- src/biogeochem/CNPhenologyMod.F90 | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/biogeochem/CNPhenologyMod.F90 b/src/biogeochem/CNPhenologyMod.F90 index fd94252216..4d03c839cf 100644 --- a/src/biogeochem/CNPhenologyMod.F90 +++ b/src/biogeochem/CNPhenologyMod.F90 @@ -1445,7 +1445,8 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & use clm_varctl , only : use_fertilizer use clm_varctl , only : use_c13, use_c14 use clm_varcon , only : c13ratio, c14ratio - use LandunitType , only: lun + use LandunitType , only : lun + use Fan2CTSMMod , only : fan_to_bgc_crop ! ! !ARGUMENTS: @@ -1953,7 +1954,12 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & fert_counter(p) = ndays_on * secspday if (ndays_on .gt. 0) then synthfert(p) = fertnitro(p) / fert_counter(p) - manure(p) = (manunitro(ivt(p)) * 1000._r8) / fert_counter(p) + if (.not. fan_to_bgc_crop) then + manure(p) = (manunitro(ivt(p)) * 1000._r8) / fert_counter(p) + else + ! CLM default manure not used; FAN determines the application. + manure(p) = 0.0_r8 + end if else synthfert(p) = 0._r8 manure(p) = 0._r8 From 56920757e16e3b66a7abf27ad42bbf734357f5bb Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 9 Oct 2019 13:46:50 -0600 Subject: [PATCH 117/181] Use correct intent() --- src/biogeochem/CNNDynamicsMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index 68ba9f3f3c..b44d2ee187 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -328,7 +328,7 @@ subroutine CNNFert(bounds, num_soilc, filter_soilc, & integer , intent(in) :: filter_soilc(:) ! filter for soil columns integer , intent(in) :: num_pcropp ! number of prognostic crop pathches integer , intent(in) :: filter_pcropp(:)! filter for prognostic crop patches - type(cnveg_nitrogenflux_type) , intent(in) :: cnveg_nitrogenflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst ! ! !LOCAL VARIABLES: From a1f94850041e37210108a6325d92135be160eafc Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 9 Oct 2019 13:47:15 -0600 Subject: [PATCH 118/181] Fix wrong output variable pointer --- src/biogeochem/CNVegNitrogenFluxType.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/biogeochem/CNVegNitrogenFluxType.F90 b/src/biogeochem/CNVegNitrogenFluxType.F90 index 1e378b5494..b7f6c35fc4 100644 --- a/src/biogeochem/CNVegNitrogenFluxType.F90 +++ b/src/biogeochem/CNVegNitrogenFluxType.F90 @@ -955,11 +955,11 @@ subroutine InitHistory(this, bounds) ptr_patch=this%nfertilization_patch) this%manure_patch(begp:endp) = spval call hist_addfld1d (fname='NMANURE', units='gN/m^2/s', & - avgflag='A', long_name='Manure N added', & + avgflag='A', long_name='Manure N added according to CLM default', & ptr_patch=this%manure_patch, default='inactive') call hist_addfld1d (fname='NSYNTHFERT', units='gN/m^2/s', & avgflag='A', long_name='Syntheric fertilizer N added', & - ptr_patch=this%manure_patch, default='inactive') + ptr_patch=this%synthfert_patch, default='inactive') end if if (use_crop .and. .not. use_fun) then From 4d26005ff7051c873630aa8fed6f2a6f86fdbf66 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 9 Oct 2019 16:12:59 -0600 Subject: [PATCH 119/181] Rename MAN_ -> MANURE_; revise warning messages --- src/biogeochem/Fan2CTSMMod.F90 | 130 ++++++++-------- .../SoilBiogeochemNitrogenFluxType.F90 | 125 ++++++++-------- .../SoilBiogeochemNitrogenStateType.F90 | 140 +++++++++--------- 3 files changed, 195 insertions(+), 200 deletions(-) diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index fbdaa186b7..d602d9e18b 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -272,13 +272,13 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & do_balance_checks = balance_check_freq > 0 .and. mod(get_nstep(), balance_check_freq) == 0 associate(& - ngrz => soilbiogeochem_nitrogenflux_inst%man_n_grz_col, & - man_u_grz => soilbiogeochem_nitrogenstate_inst%man_u_grz_col, & - man_a_grz => soilbiogeochem_nitrogenstate_inst%man_a_grz_col, & - man_r_grz => soilbiogeochem_nitrogenstate_inst%man_r_grz_col, & - man_u_app => soilbiogeochem_nitrogenstate_inst%man_u_app_col, & - man_a_app => soilbiogeochem_nitrogenstate_inst%man_a_app_col, & - man_r_app => soilbiogeochem_nitrogenstate_inst%man_r_app_col, & + ngrz => soilbiogeochem_nitrogenflux_inst%manure_n_grz_col, & + man_u_grz => soilbiogeochem_nitrogenstate_inst%manure_u_grz_col, & + man_a_grz => soilbiogeochem_nitrogenstate_inst%manure_a_grz_col, & + man_r_grz => soilbiogeochem_nitrogenstate_inst%manure_r_grz_col, & + man_u_app => soilbiogeochem_nitrogenstate_inst%manure_u_app_col, & + man_a_app => soilbiogeochem_nitrogenstate_inst%manure_a_app_col, & + man_r_app => soilbiogeochem_nitrogenstate_inst%manure_r_app_col, & ns => soilbiogeochem_nitrogenstate_inst, & nf => soilbiogeochem_nitrogenflux_inst, & cnv_nf => cnveg_nitrogenflux_inst, & @@ -286,14 +286,14 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & rb1 => frictionvel_inst%rb1_patch) nf%fert_n_appl_col(bounds%begc:bounds%endc) = 0.0 - nf%man_n_appl_col(bounds%begc:bounds%endc) = 0.0 - nf%man_tan_appl_col(bounds%begc:bounds%endc) = 0.0 + nf%manure_n_appl_col(bounds%begc:bounds%endc) = 0.0 + nf%manure_tan_appl_col(bounds%begc:bounds%endc) = 0.0 call p2c(bounds, num_soilc, filter_soilc, & cnv_nf%synthfert_patch(bounds%begp:bounds%endp), & nf%fert_n_appl_col(bounds%begc:bounds%endc)) - nf%man_n_appl_col(bounds%begc:bounds%endc) = 0.0_r8 + nf%manure_n_appl_col(bounds%begc:bounds%endc) = 0.0_r8 if (do_balance_checks) then nstored_old = get_total_n(ns, nf, 'pools_storage') @@ -316,8 +316,8 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & call endrun('bad ngrz 1') end if end if - if (nf%man_n_appl_col(c) > 0) then - write(iulog, *) nf%man_n_appl_col(c) + if (nf%manure_n_appl_col(c) > 0) then + write(iulog, *) nf%manure_n_appl_col(c) call endrun(msg='Found fertilizer in soil column') end if else @@ -327,12 +327,12 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & call handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & atm2lnd_inst%forc_ndep_sgrz_grc, atm2lnd_inst%forc_ndep_ngrz_grc, & - ns%man_n_stored_col, ns%man_tan_stored_col, & - nf%man_n_appl_col, nf%man_tan_appl_col, & - nf%man_n_grz_col, nf%man_n_mix_col, & + ns%manure_n_stored_col, ns%manure_tan_stored_col, & + nf%manure_n_appl_col, nf%manure_tan_appl_col, & + nf%manure_n_grz_col, nf%manure_n_mix_col, & nf%nh3_stores_col, nf%nh3_barns_col, & - nf%man_n_transf_col, ns%fan_grz_fract_col, & - nf%man_n_barns_col, & + nf%manure_n_transf_col, ns%fan_grz_fract_col, & + nf%manure_n_barns_col, & fract_tan, & filter_soilc, num_soilc) @@ -343,10 +343,10 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & if (any(isnan(nf%nh3_barns_col))) then call endrun('nan nh3 barns') end if - if (any(isnan(nf%man_n_appl_col))) then + if (any(isnan(nf%manure_n_appl_col))) then call endrun('nan nh3 appl') end if - if (any(isnan(nf%man_n_mix_col))) then + if (any(isnan(nf%manure_n_mix_col))) then call endrun('nan nh3 appl') end if end if @@ -358,10 +358,10 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & if (.not. (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop)) cycle if (.not. col%active(c) .or. col%wtgcell(c) < 1e-15) cycle - if (nf%man_n_appl_col(c) > 1e12 .or. ngrz(c) > 1e12) then - write(iulog, *) c, nf%man_n_appl_col(c), ngrz(c), cnv_nf%synthfert_patch(col%patchi(c):col%patchf(c)), & + if (nf%manure_n_appl_col(c) > 1e12 .or. ngrz(c) > 1e12) then + write(iulog, *) c, nf%manure_n_appl_col(c), ngrz(c), cnv_nf%synthfert_patch(col%patchi(c):col%patchf(c)), & cnv_nf%manure_patch(col%patchi(c):col%patchf(c)) - call endrun('nf%man_n_appl_col(c) is spval') + call endrun('nf%manure_n_appl_col(c) is spval') end if ! Find and average the atmospheric resistances Rb and Ra. @@ -477,19 +477,19 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & nf%nh3_grz_col(c) = fluxes_tmp(iflx_air) nf%manure_nh4_runoff_col(c) = fluxes_tmp(iflx_roff) - nf%manure_no3_prod_col(c) = fluxes_tmp(iflx_no3) + nf%manure_no3_to_soil_col(c) = fluxes_tmp(iflx_no3) nf%manure_nh4_to_soil_col(c) & = fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) + n_residual_total / dt + soilflux_org ! Manure application - org_n_tot = nf%man_n_appl_col(c) - nf%man_tan_appl_col(c) + org_n_tot = nf%manure_n_appl_col(c) - nf%manure_tan_appl_col(c) ! Use the the same fractionation of organic N as for grazing, after removing the ! "explicitly" calculated TAN. ndep_org(ind_avail) = org_n_tot * fract_avail ndep_org(ind_resist) = org_n_tot * fract_resist ndep_org(ind_unavail) = org_n_tot * fract_unavail - tandep = nf%man_tan_appl_col(c) + tandep = nf%manure_tan_appl_col(c) orgpools(ind_avail) = man_a_app(c) orgpools(ind_resist) = man_r_app(c) @@ -513,7 +513,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & do ind_substep = 1, num_substeps if (debug_fan .and. any(abs(tanpools(1:4)) > 1e12)) then write(iulog, *) ind_substep, tanpools(1:4), tandep, nf%fert_n_appl_col(c), & - nf%man_n_appl_col(c), ns%man_n_stored_col(c), ns%man_tan_stored_col(c) + nf%manure_n_appl_col(c), ns%manure_n_stored_col(c), ns%manure_tan_stored_col(c) call endrun('bad tanpools (manure app)') end if @@ -539,9 +539,9 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & ns%tan_s2_col(c) = tanpools(3) ns%tan_s3_col(c) = tanpools(4) - nf%nh3_man_app_col(c) = fluxes_tmp(iflx_air) + nf%nh3_manure_app_col(c) = fluxes_tmp(iflx_air) nf%manure_nh4_runoff_col(c) = nf%manure_nh4_runoff_col(c) + fluxes_tmp(iflx_roff) - nf%manure_no3_prod_col(c) = nf%manure_no3_prod_col(c) + fluxes_tmp(iflx_no3) + nf%manure_no3_to_soil_col(c) = nf%manure_no3_to_soil_col(c) + fluxes_tmp(iflx_no3) nf%manure_nh4_to_soil_col(c) & = nf%manure_nh4_to_soil_col(c) + fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) & + n_residual_total / dt + soilflux_org @@ -563,7 +563,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & fert_urea = fert_total * fract_urea * (1.0_r8 - fert_incorp_reduct) - ! Fertilizer nitrate goes straight to the no3_prod, incorporated or not. + ! Fertilizer nitrate goes straight to the no3_to_soil, incorporated or not. fert_no3 = fert_total * fract_no3 fert_generic = fert_total * (1.0_r8 - fract_urea - fract_no3) * (1.0_r8 - fert_incorp_reduct) nf%otherfert_n_appl_col(c) = fert_total * (1.0_r8 - fract_urea) ! note here goes also the incorporated N @@ -635,12 +635,12 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & nf%nh3_fert_col(c) = fluxes_tmp(iflx_air) nf%fert_nh4_runoff_col(c) = fluxes_tmp(iflx_roff) - nf%fert_no3_prod_col(c) = fluxes_tmp(iflx_no3) + fert_no3 + nf%fert_no3_to_soil_col(c) = fluxes_tmp(iflx_no3) + fert_no3 nf%fert_nh4_to_soil_col(c) = fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) + n_residual_total/dt + fert_inc_tan ! Total flux ! - nf%nh3_total_col(c) = nf%nh3_fert_col(c) + nf%nh3_man_app_col(c) & + nf%nh3_total_col(c) = nf%nh3_fert_col(c) + nf%nh3_manure_app_col(c) & + nf%nh3_grz_col(c) + nf%nh3_stores_col(c) + nf%nh3_barns_col(c) if (nf%nh3_total_col(c) < -1e15) then call endrun(msg='ERROR: FAN, negative total emission') @@ -671,28 +671,28 @@ real(r8) function get_total_n(ns, nf, which) result(total) select case(which) case('pools_storage') - total = sum(ns%man_n_stored_col(soilc)) + total = sum(ns%manure_n_stored_col(soilc)) case('fluxes_storage') - total = sum(nf%man_n_mix_col(soilc)) + total = sum(nf%manure_n_mix_col(soilc)) total = total - sum(nf%nh3_stores_col(soilc)) - total = total - sum(nf%nh3_barns_col(soilc)) - sum(nf%man_n_transf_col(soilc)) + total = total - sum(nf%nh3_barns_col(soilc)) - sum(nf%manure_n_transf_col(soilc)) case('pools_manure') total = total + sum(ns%tan_g1_col(soilc)) + sum(ns%tan_g2_col(soilc)) + sum(ns%tan_g3_col(soilc)) - total = total + sum(ns%man_u_grz_col(soilc)) & - + sum(ns%man_a_grz_col(soilc)) + sum(ns%man_r_grz_col(soilc)) + total = total + sum(ns%manure_u_grz_col(soilc)) & + + sum(ns%manure_a_grz_col(soilc)) + sum(ns%manure_r_grz_col(soilc)) total = total + sum(ns%tan_s0_col(soilc)) & + sum(ns%tan_s1_col(soilc)) + sum(ns%tan_s2_col(soilc)) + sum(ns%tan_s3_col(soilc)) - total = total + sum(ns%man_u_app_col(soilc)) & - + sum(ns%man_a_app_col(soilc)) + sum(ns%man_r_app_col(soilc)) + total = total + sum(ns%manure_u_app_col(soilc)) & + + sum(ns%manure_a_app_col(soilc)) + sum(ns%manure_r_app_col(soilc)) case('fluxes_manure') - total = sum(nf%man_n_grz_col(soilc)) + sum(nf%man_n_barns_col(soilc)) - total = total - sum(nf%nh3_man_app_col(soilc)) & + total = sum(nf%manure_n_grz_col(soilc)) + sum(nf%manure_n_barns_col(soilc)) + total = total - sum(nf%nh3_manure_app_col(soilc)) & - sum(nf%nh3_grz_col(soilc)) - sum(nf%manure_nh4_runoff_col(soilc)) - total = total - sum(nf%manure_no3_prod_col(soilc)) - sum(nf%manure_nh4_to_soil_col(soilc)) - total = total - sum(nf%man_n_transf_col(soilc)) - sum(nf%nh3_stores_col(soilc)) - sum(nf%nh3_barns_col(soilc)) + total = total - sum(nf%manure_no3_to_soil_col(soilc)) - sum(nf%manure_nh4_to_soil_col(soilc)) + total = total - sum(nf%manure_n_transf_col(soilc)) - sum(nf%nh3_stores_col(soilc)) - sum(nf%nh3_barns_col(soilc)) case('pools_fertilizer') total = sum(ns%tan_f1_col((soilc))) + sum(ns%tan_f2_col((soilc))) + sum(ns%tan_f3_col(soilc)) & @@ -702,7 +702,7 @@ real(r8) function get_total_n(ns, nf, which) result(total) case('fluxes_fertilizer') total = sum(nf%fert_n_appl_col(soilc)) total = total - sum(nf%nh3_fert_col(soilc)) - sum(nf%fert_nh4_runoff_col(soilc)) - total = total - sum(nf%fert_no3_prod_col(soilc)) - sum(nf%fert_nh4_to_soil_col(soilc)) + total = total - sum(nf%fert_no3_to_soil_col(soilc)) - sum(nf%fert_nh4_to_soil_col(soilc)) case default call endrun(msg='Bad argument to get_total_n') @@ -942,23 +942,19 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & end do ! landunit if (col_grass /= ispval) then - if (tan_manure_spread_col(col_grass) > 1) then - write(iulog, *) 'bad tan_manure col_grass before adding', n_manure_spread_col(col_grass), & - tan_manure_spread_col(col_grass) - call endrun(msg="ERROR bad tan") - end if n_manure_spread_col(col_grass) = n_manure_spread_col(col_grass) & + flux_grass_spread / col%wtgcell(col_grass) tan_manure_spread_col(col_grass) = tan_manure_spread_col(col_grass) & + flux_grass_spread_tan / col%wtgcell(col_grass) n_manure_graze_col(col_grass) = n_manure_graze_col(col_grass) + flux_grass_graze / col%wtgcell(col_grass) if (tan_manure_spread_col(col_grass) > 1) then - write(iulog, *) 'bad tan_manure col_grass', flux_grass_spread_tan, col%wtgcell(col_grass) - call endrun(msg="ERROR bad tan") + ! In principle this could happen if col%wtgcell(col_grass) is very small. + write(iulog, *) 'Warning (FAN): suspicious manure N spread flux to natural vegetation column; flux, icol:', & + flux_grass_spread_tan, col_grass end if else if (flux_grass_spread > 0) then - continue - !call endrun('Cannot spread manure') + ! There was no column that had a grass pft: + write(iulog, *) 'Warning (FAN): fract_spread_grass > 0 not possible in this cell:', g end if end do ! grid @@ -984,32 +980,32 @@ subroutine update_summary(ns, nf, filter_soilc, num_soilc) do fc = 1, num_soilc c = filter_soilc(fc) total = ns%tan_g1_col(c) + ns%tan_g2_col(c) + ns%tan_g3_col(c) - total = total + ns%man_u_grz_col(c) + ns%man_a_grz_col(c) + ns%man_r_grz_col(c) + total = total + ns%manure_u_grz_col(c) + ns%manure_a_grz_col(c) + ns%manure_r_grz_col(c) total = total + ns%tan_s0_col(c) + ns%tan_s1_col(c) + ns%tan_s2_col(c) + ns%tan_s3_col(c) - total = total + ns%man_u_app_col(c) + ns%man_a_app_col(c) + ns%man_r_app_col(c) + total = total + ns%manure_u_app_col(c) + ns%manure_a_app_col(c) + ns%manure_r_app_col(c) total = total + ns%tan_f1_col(c) + ns%tan_f2_col(c) + ns%tan_f3_col(c) + ns%tan_f4_col(c) total = total + ns%fert_u1_col(c) + ns%fert_u2_col(c) ns%fan_totn_col(c) = total if (lun%itype(col%landunit(c)) == istcrop) then - ! no grazing, man_n_appl is from the same column and not counted as input - fluxin = nf%man_n_mix_col(c) + nf%fert_n_appl_col(c) + ! no grazing, manure_n_appl is from the same column and not counted as input + fluxin = nf%manure_n_mix_col(c) + nf%fert_n_appl_col(c) else - ! no barns or fertilization. man_n_appl is transferred from crop columns and not + ! no barns or fertilization. manure_n_appl is transferred from crop columns and not ! included in the other inputs. - fluxin = nf%man_n_grz_col(c) + nf%man_n_appl_col(c) + fluxin = nf%manure_n_grz_col(c) + nf%manure_n_appl_col(c) end if - flux_loss = nf%nh3_man_app_col(c) + nf%nh3_grz_col(c) + nf%manure_nh4_runoff_col(c) & + flux_loss = nf%nh3_manure_app_col(c) + nf%nh3_grz_col(c) + nf%manure_nh4_runoff_col(c) & + nf%nh3_stores_col(c) + nf%nh3_barns_col(c) & + nf%nh3_fert_col(c) + nf%fert_nh4_runoff_col(c) - fluxout = nf%fert_no3_prod_col(c) + nf%fert_nh4_to_soil_col(c) & - + nf%manure_no3_prod_col(c) + nf%manure_nh4_to_soil_col(c) & - + nf%man_n_transf_col(c) + flux_loss + fluxout = nf%fert_no3_to_soil_col(c) + nf%fert_nh4_to_soil_col(c) & + + nf%manure_no3_to_soil_col(c) + nf%manure_nh4_to_soil_col(c) & + + nf%manure_n_transf_col(c) + flux_loss nf%fan_totnin_col(c) = fluxin nf%fan_totnout_col(c) = fluxout - nf%manure_n_total_col(c) = nf%man_n_grz_col(c) + nf%man_n_barns_col(c) + nf%manure_n_total_col(c) = nf%manure_n_grz_col(c) + nf%manure_n_barns_col(c) end do end subroutine update_summary @@ -1040,9 +1036,9 @@ subroutine fan_to_sminn(bounds, filter_soilc, num_soilc, sbgc_nf, nfertilization do fc = 1, num_soilc c = filter_soilc(fc) - flux_manure = sbgc_nf%manure_no3_prod_col(c) + sbgc_nf%manure_nh4_to_soil_col(c) - flux_fert = sbgc_nf%fert_no3_prod_col(c) + sbgc_nf%fert_nh4_to_soil_col(c) - manure_prod = sbgc_nf%man_n_barns_col(c) + sbgc_nf%man_n_grz_col(c) + flux_manure = sbgc_nf%manure_no3_to_soil_col(c) + sbgc_nf%manure_nh4_to_soil_col(c) + flux_fert = sbgc_nf%fert_no3_to_soil_col(c) + sbgc_nf%fert_nh4_to_soil_col(c) + manure_prod = sbgc_nf%manure_n_barns_col(c) + sbgc_nf%manure_n_grz_col(c) included = (lun%itype(col%landunit(c)) == istcrop .and. fan_to_bgc_crop) & .or. (lun%itype(col%landunit(c)) == istsoil .and. fan_to_bgc_veg) @@ -1050,7 +1046,7 @@ subroutine fan_to_sminn(bounds, filter_soilc, num_soilc, sbgc_nf, nfertilization if (included) then sbgc_nf%fert_to_sminn_col(c) = flux_fert + flux_manure sbgc_nf%manure_n_to_sminn_col(c) = flux_manure - sbgc_nf%fert_n_to_sminn_col(c) = flux_fert + sbgc_nf%synthfert_n_to_sminn_col(c) = flux_fert do p = col%patchi(c), col%patchf(c) ! NFERTILIZATION gets the fertilizer applied + all manure N produced in the ! column. Note that if fract_spread_grass > 0 then some of this N might be diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 index 2cc5783473..646a939161 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenFluxType.F90 @@ -28,23 +28,23 @@ module SoilBiogeochemNitrogenFluxType real(r8), pointer :: soyfixn_to_sminn_col (:) ! col soybean fixation to soil mineral N (gN/m2/s) ! FAN fluxes - real(r8), pointer :: man_tan_appl_col (:) ! Manure TAN applied on soil (gN/m2/s) - real(r8), pointer :: man_n_appl_col (:) ! Manure N (TAN+organic) applied on soil (gN/m2/s) - real(r8), pointer :: man_n_grz_col (:) ! Manure N from grazing animals (gN/m2/s) - real(r8), pointer :: man_n_mix_col (:) ! Manure N from produced in mixed systems (gN/m2/s) - real(r8), pointer :: man_n_barns_col (:) ! Manure N from produced in animal housings (gN/m2/s) + real(r8), pointer :: manure_tan_appl_col (:) ! Manure TAN applied on soil (gN/m2/s) + real(r8), pointer :: manure_n_appl_col (:) ! Manure N (TAN+organic) applied on soil (gN/m2/s) + real(r8), pointer :: manure_n_grz_col (:) ! Manure N from grazing animals (gN/m2/s) + real(r8), pointer :: manure_n_mix_col (:) ! Manure N from produced in mixed systems (gN/m2/s) + real(r8), pointer :: manure_n_barns_col (:) ! Manure N from produced in animal housings (gN/m2/s) real(r8), pointer :: fert_n_appl_col (:) ! Fertilizer N applied on soil (gN/m2/s) real(r8), pointer :: otherfert_n_appl_col (:) ! Non-urea fertilizer N applied on soil (gN/m2/s) - real(r8), pointer :: man_n_transf_col (:) ! Manure N removed from the crop column (into the natural veg. column in the gcell) + real(r8), pointer :: manure_n_transf_col (:) ! Manure N removed from the crop column (into the natural veg. column in the gcell) real(r8), pointer :: nh3_barns_col (:) ! NH3 emission from animal housings (gN/m2/s real(r8), pointer :: nh3_stores_col (:) ! NH3 emission from manure storage, (gN/m2/s real(r8), pointer :: nh3_grz_col (:) ! NH3 emission from manure on pastures, (gN/m2/s - real(r8), pointer :: nh3_man_app_col (:) ! NH3 emission from manure applied on crops and grasslands, (gN/m2/s + real(r8), pointer :: nh3_manure_app_col (:) ! NH3 emission from manure applied on crops and grasslands, (gN/m2/s real(r8), pointer :: nh3_fert_col (:) ! NH3 emission from fertilizers applied on crops and grasslands, (gN/m2/s real(r8), pointer :: nh3_otherfert_col (:) ! NH3 emission from non-urea fertilizers applied on crops and grasslands, (gN/m2/s - real(r8), pointer :: manure_no3_prod_col (:) ! Nitrification flux from manure (gN/m2/s) - real(r8), pointer :: fert_no3_prod_col (:) ! Nitrification flux from fertilizer (gN/m2/s) + real(r8), pointer :: manure_no3_to_soil_col (:) ! Nitrification flux from manure (gN/m2/s) + real(r8), pointer :: fert_no3_to_soil_col (:) ! Nitrification flux from fertilizer (gN/m2/s) real(r8), pointer :: manure_nh4_to_soil_col (:) ! NH4 flux to soil mineral N pools from manure (gN/m2/s) real(r8), pointer :: fert_nh4_to_soil_col (:) ! NH4 flux to soil mineral N pools from fertilizer (gN/m2/s) real(r8), pointer :: manure_nh4_runoff_col (:) ! NH4 runoff flux from manure, gN/m2/s @@ -55,7 +55,7 @@ module SoilBiogeochemNitrogenFluxType real(r8), pointer :: fan_totnin_col (:) ! Total output N from FAN pools, gN/m2/s real(r8), pointer :: manure_n_to_sminn_col (:) ! Manure N from FAN pools to soil mineral pools, gN/m2/s - real(r8), pointer :: fert_n_to_sminn_col (:) ! Fertilizer N from FAN pools to soil mineral pools, gN/m2/s + real(r8), pointer :: synthfert_n_to_sminn_col (:) ! Fertilizer N from FAN pools to soil mineral pools, gN/m2/s real(r8), pointer :: manure_n_total_col (:) ! Total manure N produced, gN/m2/s ! decomposition fluxes @@ -211,34 +211,34 @@ subroutine InitAllocate(this, bounds) allocate(this%soyfixn_to_sminn_col (begc:endc)) ; this%soyfixn_to_sminn_col (:) = nan if (use_fan) then - allocate(this%man_tan_appl_col (begc:endc)) ; this%man_tan_appl_col (:) = spval - allocate(this%man_n_appl_col (begc:endc)) ; this%man_n_appl_col (:) = spval - allocate(this%man_n_grz_col (begc:endc)) ; this%man_n_grz_col (:) = spval - allocate(this%man_n_mix_col (begc:endc)) ; this%man_n_mix_col (:) = spval - allocate(this%man_n_barns_col (begc:endc)) ; this%man_n_barns_col (:) = spval + allocate(this%manure_tan_appl_col (begc:endc)) ; this%manure_tan_appl_col (:) = spval + allocate(this%manure_n_appl_col (begc:endc)) ; this%manure_n_appl_col (:) = spval + allocate(this%manure_n_grz_col (begc:endc)) ; this%manure_n_grz_col (:) = spval + allocate(this%manure_n_mix_col (begc:endc)) ; this%manure_n_mix_col (:) = spval + allocate(this%manure_n_barns_col (begc:endc)) ; this%manure_n_barns_col (:) = spval allocate(this%fert_n_appl_col (begc:endc)) ; this%fert_n_appl_col (:) = spval allocate(this%otherfert_n_appl_col (begc:endc)) ; this%otherfert_n_appl_col (:) = spval - allocate(this%man_n_transf_col (begc:endc)) ; this%man_n_transf_col (:) = spval + allocate(this%manure_n_transf_col (begc:endc)) ; this%manure_n_transf_col (:) = spval allocate(this%nh3_barns_col (begc:endc)) ; this%nh3_barns_col (:) = spval allocate(this%nh3_stores_col (begc:endc)) ; this%nh3_stores_col (:) = spval allocate(this%nh3_grz_col (begc:endc)) ; this%nh3_grz_col (:) = spval - allocate(this%nh3_man_app_col (begc:endc)) ; this%nh3_man_app_col (:) = spval + allocate(this%nh3_manure_app_col (begc:endc)) ; this%nh3_manure_app_col (:) = spval allocate(this%nh3_fert_col (begc:endc)) ; this%nh3_fert_col (:) = spval allocate(this%nh3_otherfert_col (begc:endc)) ; this%nh3_otherfert_col (:) = spval allocate(this%nh3_total_col (begc:endc)) ; this%nh3_total_col (:) = spval allocate(this%nh3_total_col (begc:endc)) ; this%nh3_total_col (:) = spval - allocate(this%manure_no3_prod_col (begc:endc)) ; this%manure_no3_prod_col (:) = spval - allocate(this%fert_no3_prod_col (begc:endc)) ; this%fert_no3_prod_col (:) = spval + allocate(this%manure_no3_to_soil_col (begc:endc)) ; this%manure_no3_to_soil_col (:) = spval + allocate(this%fert_no3_to_soil_col (begc:endc)) ; this%fert_no3_to_soil_col (:) = spval allocate(this%manure_nh4_to_soil_col (begc:endc)) ; this%manure_nh4_to_soil_col (:) = spval allocate(this%fert_nh4_to_soil_col (begc:endc)) ; this%fert_nh4_to_soil_col (:) = spval allocate(this%manure_nh4_runoff_col (begc:endc)) ; this%manure_nh4_runoff_col (:) = spval allocate(this%fert_nh4_runoff_col (begc:endc)) ; this%fert_nh4_runoff_col (:) = spval allocate(this%manure_n_to_sminn_col (begc:endc)) ; this%manure_n_to_sminn_col (:) = spval - allocate(this%fert_n_to_sminn_col (begc:endc)) ; this%fert_n_to_sminn_col (:) = spval + allocate(this%synthfert_n_to_sminn_col (begc:endc)) ; this%synthfert_n_to_sminn_col (:) = spval allocate(this%manure_n_total_col (begc:endc)) ; this%manure_n_total_col (:) = spval end if ! Allocate the FAN summary fluxes even if FAN is off and set them to 0. @@ -382,30 +382,30 @@ subroutine InitHistory(this, bounds) ptr_col=this%ndep_to_sminn_col) if (use_fan) then - this%man_tan_appl_col(begc:endc) = spval - call hist_addfld1d( fname='MAN_TAN_APP', units='gN/m^2/s', & - avgflag='A', long_name='Manure TAN applied on soil', & - ptr_col=this%man_tan_appl_col) + this%manure_tan_appl_col(begc:endc) = spval + call hist_addfld1d( fname='MANURE_TAN_APP', units='gN/m^2/s', & + avgflag='A', long_name='Manure ammonical N applied on soil', & + ptr_col=this%manure_tan_appl_col) - this%man_n_appl_col(begc:endc) = spval - call hist_addfld1d( fname='MAN_N_APP', units='gN/m^2/s', & + this%manure_n_appl_col(begc:endc) = spval + call hist_addfld1d( fname='MANURE_N_APP', units='gN/m^2/s', & avgflag='A', long_name='Manure N applied on soil', & - ptr_col=this%man_n_appl_col) + ptr_col=this%manure_n_appl_col) - this%man_n_grz_col(begc:endc) = spval - call hist_addfld1d( fname='MAN_N_GRZ', units='gN/m^2/s', & + this%manure_n_grz_col(begc:endc) = spval + call hist_addfld1d( fname='MANURE_N_GRZ', units='gN/m^2/s', & avgflag='A', long_name='Manure N from grazing animals', & - ptr_col=this%man_n_grz_col) + ptr_col=this%manure_n_grz_col) - this%man_n_mix_col(begc:endc) = spval - call hist_addfld1d( fname='MAN_N_MIX', units='gN/m^2/s', & + this%manure_n_mix_col(begc:endc) = spval + call hist_addfld1d( fname='MANURE_N_MIX', units='gN/m^2/s', & avgflag='A', long_name='Manure N in produced mixed systems', & - ptr_col=this%man_n_mix_col) + ptr_col=this%manure_n_mix_col) - this%man_n_barns_col(begc:endc) = spval - call hist_addfld1d( fname='MAN_N_BARNS', units='gN/m^2/s', & + this%manure_n_barns_col(begc:endc) = spval + call hist_addfld1d( fname='MANURE_N_BARNS', units='gN/m^2/s', & avgflag='A', long_name='Manure N in produced barns', & - ptr_col=this%man_n_barns_col) + ptr_col=this%manure_n_barns_col) this%fert_n_appl_col(begc:endc) = spval call hist_addfld1d( fname='FERT_N_APP', units='gN/m^2/s', & @@ -417,10 +417,10 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='Non-urea fertilizer N applied on soil', & ptr_col=this%otherfert_n_appl_col) - this%man_n_transf_col(begc:endc) = spval - call hist_addfld1d( fname='MAN_N_TRANSF', units='gN/m^2/s', & + this%manure_n_transf_col(begc:endc) = spval + call hist_addfld1d( fname='MANURE_N_TRANSF', units='gN/m^2/s', & avgflag='A', long_name='Manure N moved from crop to natural column', & - ptr_col=this%man_n_transf_col) + ptr_col=this%manure_n_transf_col) this%nh3_barns_col(begc:endc) = spval call hist_addfld1d( fname='NH3_BARNS', units='gN/m^2/s', & @@ -437,10 +437,10 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='NH3 emitted from manure on pastures', & ptr_col=this%nh3_grz_col) - this%nh3_man_app_col(begc:endc) = spval - call hist_addfld1d( fname='NH3_MAN_APP', units='gN/m^2/s', & + this%nh3_manure_app_col(begc:endc) = spval + call hist_addfld1d( fname='NH3_MANURE_APP', units='gN/m^2/s', & avgflag='A', long_name='NH3 emitted from manure applied on crops and grasslands', & - ptr_col=this%nh3_man_app_col) + ptr_col=this%nh3_manure_app_col) this%nh3_fert_col(begc:endc) = spval call hist_addfld1d( fname='NH3_FERT', units='gN/m^2/s', & @@ -457,15 +457,15 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='Total NH3 emitted from fertilizers and manure', & ptr_col=this%nh3_total_col) - this%manure_no3_prod_col(begc:endc) = spval - call hist_addfld1d( fname='MANURE_NO3_PROD', units='gN/m^2/s', & + this%manure_no3_to_soil_col(begc:endc) = spval + call hist_addfld1d( fname='MANURE_NO3_TO_SOIL', units='gN/m^2/s', & avgflag='A', long_name='Manure nitrification flux', & - ptr_col=this%manure_no3_prod_col) + ptr_col=this%manure_no3_to_soil_col) - this%fert_no3_prod_col(begc:endc) = spval - call hist_addfld1d( fname='FERT_NO3_PROD', units='gN/m^2/s', & + this%fert_no3_to_soil_col(begc:endc) = spval + call hist_addfld1d( fname='FERT_NO3_TO_SOIL', units='gN/m^2/s', & avgflag='A', long_name='Fertilizer nitrification flux', & - ptr_col=this%fert_no3_prod_col) + ptr_col=this%fert_no3_to_soil_col) this%fert_nh4_to_soil_col(begc:endc) = spval call hist_addfld1d( fname='FERT_NH4_TO_SOIL', units='gN/m^2/s', & @@ -477,10 +477,9 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='Flux of NH4 to soil mineral pools, manure', & ptr_col=this%manure_nh4_to_soil_col) - this%manure_nh4_runoff_col(begc:endc) = spval call hist_addfld1d( fname='MANURE_NH4_RUNOFF', units='gN/m^2/s', & - avgflag='A', long_name='NH4 in surface runoff, manure', & + avgflag='A', long_name='NH4 in surface runoff, manure, FAN', & ptr_col=this%manure_nh4_runoff_col) this%fert_nh4_runoff_col(begc:endc) = spval @@ -488,10 +487,10 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='NH4 (and urea) in surface runoff, fertilizer', & ptr_col=this%fert_nh4_runoff_col) - this%fert_n_to_sminn_col(begc:endc) = spval - call hist_addfld1d( fname='FERT_N_TO_SMINN', units='gN/m^2/s', & + this%synthfert_n_to_sminn_col(begc:endc) = spval + call hist_addfld1d( fname='SYNTHFERT_N_TO_SMINN', units='gN/m^2/s', & avgflag='A', long_name='Fertilizer NH4, NO3 and urea-N from FAN to soil mineral pools', & - ptr_col=this%fert_n_to_sminn_col) + ptr_col=this%synthfert_n_to_sminn_col) this%manure_n_to_sminn_col(begc:endc) = spval call hist_addfld1d( fname='MANURE_N_TO_SMINN', units='gN/m^2/s', & @@ -1189,30 +1188,30 @@ subroutine SetValues ( this, & if ( use_fan ) then do fi = 1,num_column i = filter_column(fi) - this%man_tan_appl_col(i) = value_column - this%man_n_appl_col(i) = value_column - this%man_n_grz_col(i) = value_column - this%man_n_mix_col(i) = value_column - this%man_n_barns_col(i) = value_column + this%manure_tan_appl_col(i) = value_column + this%manure_n_appl_col(i) = value_column + this%manure_n_grz_col(i) = value_column + this%manure_n_mix_col(i) = value_column + this%manure_n_barns_col(i) = value_column this%fert_n_appl_col(i) = value_column this%otherfert_n_appl_col(i) = value_column - this%man_n_transf_col(i) = value_column + this%manure_n_transf_col(i) = value_column this%nh3_barns_col(i) = value_column this%nh3_stores_col(i) = value_column this%nh3_grz_col(i) = value_column - this%nh3_man_app_col(i) = value_column + this%nh3_manure_app_col(i) = value_column this%nh3_fert_col(i) = value_column this%nh3_otherfert_col(i) = value_column this%nh3_total_col(i) = value_column - this%manure_no3_prod_col(i) = value_column - this%fert_no3_prod_col(i) = value_column + this%manure_no3_to_soil_col(i) = value_column + this%fert_no3_to_soil_col(i) = value_column this%manure_nh4_to_soil_col(i) = value_column this%fert_nh4_to_soil_col(i) = value_column this%manure_nh4_runoff_col(i) = value_column this%fert_nh4_runoff_col(i) = value_column this%manure_n_to_sminn_col(i) = value_column this%manure_n_total_col(i) = value_column - this%fert_n_to_sminn_col(i) = value_column + this%synthfert_n_to_sminn_col(i) = value_column end do end if diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 index 52aea7ce2e..a6a4a0e1c8 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 @@ -56,16 +56,16 @@ module SoilBiogeochemNitrogenStateType real(r8), pointer :: fert_u1_col(:) ! col (gN/m2) total urea N in FAN pool U1 real(r8), pointer :: fert_u2_col(:) ! col (gN/m2) total urea N in FAN pool U2 - real(r8), pointer :: man_u_grz_col(:) ! col (gN/m2) unavailable organic N, grazing - real(r8), pointer :: man_a_grz_col(:) ! col (gN/m2) available organic N, grazing - real(r8), pointer :: man_r_grz_col(:) ! col (gN/m2) resistant organic N, grazing + real(r8), pointer :: manure_u_grz_col(:) ! col (gN/m2) unavailable organic N, grazing + real(r8), pointer :: manure_a_grz_col(:) ! col (gN/m2) available organic N, grazing + real(r8), pointer :: manure_r_grz_col(:) ! col (gN/m2) resistant organic N, grazing - real(r8), pointer :: man_u_app_col(:) ! col (gN/m2) unavailable organic N, application - real(r8), pointer :: man_a_app_col(:) ! col (gN/m2) available organic N, application - real(r8), pointer :: man_r_app_col(:) ! col (gN/m2) resistant organic N, application + real(r8), pointer :: manure_u_app_col(:) ! col (gN/m2) unavailable organic N, application + real(r8), pointer :: manure_a_app_col(:) ! col (gN/m2) available organic N, application + real(r8), pointer :: manure_r_app_col(:) ! col (gN/m2) resistant organic N, application - real(r8), pointer :: man_n_stored_col(:) ! col (gN/m2) manure N in storage - real(r8), pointer :: man_tan_stored_col(:) ! col (gN/m2) manure TAN in storage + real(r8), pointer :: manure_n_stored_col(:) ! col (gN/m2) manure N in storage + real(r8), pointer :: manure_tan_stored_col(:) ! col (gN/m2) manure TAN in storage real(r8), pointer :: fan_grz_fract_col(:) ! col unitless fraction of animals grazing real(r8), pointer :: fan_totn_col(:) ! col (gN/m2) total N in FAN pools @@ -181,16 +181,16 @@ subroutine InitAllocate(this, bounds) allocate(this%fert_u1_col(begc:endc)) ; this%fert_u1_col(:) = nan allocate(this%fert_u2_col(begc:endc)) ; this%fert_u2_col(:) = nan - allocate(this%man_u_grz_col(begc:endc)) ; this%man_u_grz_col(:) = nan - allocate(this%man_a_grz_col(begc:endc)) ; this%man_a_grz_col(:) = nan - allocate(this%man_r_grz_col(begc:endc)) ; this%man_r_grz_col(:) = nan + allocate(this%manure_u_grz_col(begc:endc)) ; this%manure_u_grz_col(:) = nan + allocate(this%manure_a_grz_col(begc:endc)) ; this%manure_a_grz_col(:) = nan + allocate(this%manure_r_grz_col(begc:endc)) ; this%manure_r_grz_col(:) = nan - allocate(this%man_u_app_col(begc:endc)) ; this%man_u_app_col(:) = nan - allocate(this%man_a_app_col(begc:endc)) ; this%man_a_app_col(:) = nan - allocate(this%man_r_app_col(begc:endc)) ; this%man_r_app_col(:) = nan + allocate(this%manure_u_app_col(begc:endc)) ; this%manure_u_app_col(:) = nan + allocate(this%manure_a_app_col(begc:endc)) ; this%manure_a_app_col(:) = nan + allocate(this%manure_r_app_col(begc:endc)) ; this%manure_r_app_col(:) = nan - allocate(this%man_n_stored_col(begc:endc)) ; this%man_n_stored_col(:) = nan - allocate(this%man_tan_stored_col(begc:endc)) ; this%man_tan_stored_col(:) = nan + allocate(this%manure_n_stored_col(begc:endc)) ; this%manure_n_stored_col(:) = nan + allocate(this%manure_tan_stored_col(begc:endc)) ; this%manure_tan_stored_col(:) = nan allocate(this%fan_grz_fract_col(begc:endc)) ; this%fan_grz_fract_col(:) = nan end if @@ -421,45 +421,45 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='Total ammoniacal nitrogen in FAN pool S3', & ptr_col=this%tan_s3_col, default=fanpools_default) - this%man_u_grz_col(begc:endc) = spval - call hist_addfld1d (fname='MAN_U_GRZ', units='gN/m^2', & + this%manure_u_grz_col(begc:endc) = spval + call hist_addfld1d (fname='MANURE_U_GRZ', units='gN/m^2', & avgflag='A', long_name='Unavailable manure nitrogen, grazing', & - ptr_col=this%man_u_grz_col, default=fanpools_default) + ptr_col=this%manure_u_grz_col, default=fanpools_default) - this%man_a_grz_col(begc:endc) = spval - call hist_addfld1d (fname='MAN_A_GRZ', units='gN/m^2', & + this%manure_a_grz_col(begc:endc) = spval + call hist_addfld1d (fname='MANURE_A_GRZ', units='gN/m^2', & avgflag='A', long_name='Available manure nitrogen, grazing', & - ptr_col=this%man_a_grz_col, default=fanpools_default) + ptr_col=this%manure_a_grz_col, default=fanpools_default) - this%man_r_grz_col(begc:endc) = spval - call hist_addfld1d (fname='MAN_R_GRZ', units='gN/m^2', & + this%manure_r_grz_col(begc:endc) = spval + call hist_addfld1d (fname='MANURE_R_GRZ', units='gN/m^2', & avgflag='A', long_name='Resistant manure nitrogen, grazing', & - ptr_col=this%man_r_grz_col, default=fanpools_default) + ptr_col=this%manure_r_grz_col, default=fanpools_default) - this%man_u_app_col(begc:endc) = spval - call hist_addfld1d (fname='MAN_U_APP', units='gN/m^2', & + this%manure_u_app_col(begc:endc) = spval + call hist_addfld1d (fname='MANURE_U_APP', units='gN/m^2', & avgflag='A', long_name='Unavailable manure nitrogen, application', & - ptr_col=this%man_u_app_col, default=fanpools_default) + ptr_col=this%manure_u_app_col, default=fanpools_default) - this%man_a_app_col(begc:endc) = spval - call hist_addfld1d (fname='MAN_A_APP', units='gN/m^2', & + this%manure_a_app_col(begc:endc) = spval + call hist_addfld1d (fname='MANURE_A_APP', units='gN/m^2', & avgflag='A', long_name='Available manure nitrogen, application', & - ptr_col=this%man_a_app_col, default=fanpools_default) + ptr_col=this%manure_a_app_col, default=fanpools_default) - this%man_r_app_col(begc:endc) = spval - call hist_addfld1d (fname='MAN_R_APP', units='gN/m^2', & + this%manure_r_app_col(begc:endc) = spval + call hist_addfld1d (fname='MANURE_R_APP', units='gN/m^2', & avgflag='A', long_name='Resistant manure nitrogen, application', & - ptr_col=this%man_r_app_col, default=fanpools_default) + ptr_col=this%manure_r_app_col, default=fanpools_default) - this%man_n_stored_col(begc:endc) = spval - call hist_addfld1d (fname='MAN_N_STORED', units='gN/m^2', & + this%manure_n_stored_col(begc:endc) = spval + call hist_addfld1d (fname='MANURE_N_STORED', units='gN/m^2', & avgflag='A', long_name='Manure nitrogen in storage', & - ptr_col=this%man_n_stored_col, default=fanpools_default) + ptr_col=this%manure_n_stored_col, default=fanpools_default) - this%man_tan_stored_col(begc:endc) = spval - call hist_addfld1d (fname='MAN_TAN_STORED', units='gN/m^2', & + this%manure_tan_stored_col(begc:endc) = spval + call hist_addfld1d (fname='MANURE_TAN_STORED', units='gN/m^2', & avgflag='A', long_name='Manure ammoniacal nitrogen in storage', & - ptr_col=this%man_tan_stored_col, default=fanpools_default) + ptr_col=this%manure_tan_stored_col, default=fanpools_default) this%fan_grz_fract_col(begc:endc) = spval call hist_addfld1d (fname='FAN_GRZ_FRACT', units='', & @@ -574,17 +574,17 @@ subroutine InitCold(this, bounds, & this%fert_u1_col(c) = 0.0_r8 this%fert_u2_col(c) = 0.0_r8 - this%man_u_grz_col(c) = 0.0_r8 - this%man_a_grz_col(c) = 0.0_r8 - this%man_r_grz_col(c) = 0.0_r8 + this%manure_u_grz_col(c) = 0.0_r8 + this%manure_a_grz_col(c) = 0.0_r8 + this%manure_r_grz_col(c) = 0.0_r8 - this%man_u_app_col(c) = 0.0_r8 - this%man_a_app_col(c) = 0.0_r8 - this%man_r_app_col(c) = 0.0_r8 + this%manure_u_app_col(c) = 0.0_r8 + this%manure_a_app_col(c) = 0.0_r8 + this%manure_r_app_col(c) = 0.0_r8 - this%man_tan_stored_col(c) = 0.0_r8 + this%manure_tan_stored_col(c) = 0.0_r8 this%fan_grz_fract_col(c) = 0.0_r8 - this%man_n_stored_col(c) = 0.0_r8 + this%manure_n_stored_col(c) = 0.0_r8 end if this%fan_totn_col(c) = 0.0_r8 @@ -764,32 +764,32 @@ subroutine Restart ( this, bounds, ncid, flag, totvegc_col ) dim1name='column', long_name='', units='', & interpinic_flag='interp', readvar=readvar, data=this%fert_u2_col) - call restartvar(ncid=ncid, flag=flag, varname='man_u_grz', xtype=ncd_double, & + call restartvar(ncid=ncid, flag=flag, varname='manure_u_grz', xtype=ncd_double, & dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%man_u_grz_col) - call restartvar(ncid=ncid, flag=flag, varname='man_a_grz', xtype=ncd_double, & + interpinic_flag='interp', readvar=readvar, data=this%manure_u_grz_col) + call restartvar(ncid=ncid, flag=flag, varname='manure_a_grz', xtype=ncd_double, & dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%man_a_grz_col) - call restartvar(ncid=ncid, flag=flag, varname='man_r_grz', xtype=ncd_double, & + interpinic_flag='interp', readvar=readvar, data=this%manure_a_grz_col) + call restartvar(ncid=ncid, flag=flag, varname='manure_r_grz', xtype=ncd_double, & dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%man_r_grz_col) + interpinic_flag='interp', readvar=readvar, data=this%manure_r_grz_col) - call restartvar(ncid=ncid, flag=flag, varname='man_u_app', xtype=ncd_double, & + call restartvar(ncid=ncid, flag=flag, varname='manure_u_app', xtype=ncd_double, & dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%man_u_app_col) - call restartvar(ncid=ncid, flag=flag, varname='man_a_app', xtype=ncd_double, & + interpinic_flag='interp', readvar=readvar, data=this%manure_u_app_col) + call restartvar(ncid=ncid, flag=flag, varname='manure_a_app', xtype=ncd_double, & dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%man_a_app_col) - call restartvar(ncid=ncid, flag=flag, varname='man_r_app', xtype=ncd_double, & + interpinic_flag='interp', readvar=readvar, data=this%manure_a_app_col) + call restartvar(ncid=ncid, flag=flag, varname='manure_r_app', xtype=ncd_double, & dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%man_r_app_col) + interpinic_flag='interp', readvar=readvar, data=this%manure_r_app_col) - call restartvar(ncid=ncid, flag=flag, varname='man_tan_stored', xtype=ncd_double, & + call restartvar(ncid=ncid, flag=flag, varname='manure_tan_stored', xtype=ncd_double, & dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%man_tan_stored_col) - call restartvar(ncid=ncid, flag=flag, varname='man_n_stored', xtype=ncd_double, & + interpinic_flag='interp', readvar=readvar, data=this%manure_tan_stored_col) + call restartvar(ncid=ncid, flag=flag, varname='manure_n_stored', xtype=ncd_double, & dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%man_n_stored_col) + interpinic_flag='interp', readvar=readvar, data=this%manure_n_stored_col) call restartvar(ncid=ncid, flag=flag, varname='fan_grz_fract', xtype=ncd_double, & dim1name='column', long_name='', units='', & interpinic_flag='interp', readvar=readvar, data=this%fan_grz_fract_col) @@ -1005,12 +1005,12 @@ subroutine SetValues ( this, num_column, filter_column, value_column ) this%tan_f4_col(i) = value_column this%fert_u1_col(i) = value_column this%fert_u2_col(i) = value_column - this%man_u_grz_col(i) = value_column - this%man_a_grz_col(i) = value_column - this%man_r_grz_col(i) = value_column - this%man_u_app_col(i) = value_column - this%man_a_app_col(i) = value_column - this%man_r_app_col(i) = value_column + this%manure_u_grz_col(i) = value_column + this%manure_a_grz_col(i) = value_column + this%manure_r_grz_col(i) = value_column + this%manure_u_app_col(i) = value_column + this%manure_a_app_col(i) = value_column + this%manure_r_app_col(i) = value_column end if end do From bde3383d6158b18b680148b7a3b7f372a688501b Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Fri, 18 Oct 2019 10:55:14 -0600 Subject: [PATCH 120/181] remove unused n_stored vars --- src/biogeochem/Fan2CTSMMod.F90 | 9 +++----- .../SoilBiogeochemNitrogenStateType.F90 | 22 ------------------- 2 files changed, 3 insertions(+), 28 deletions(-) diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index d602d9e18b..25993f8a6a 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -327,7 +327,6 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & call handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & atm2lnd_inst%forc_ndep_sgrz_grc, atm2lnd_inst%forc_ndep_ngrz_grc, & - ns%manure_n_stored_col, ns%manure_tan_stored_col, & nf%manure_n_appl_col, nf%manure_tan_appl_col, & nf%manure_n_grz_col, nf%manure_n_mix_col, & nf%nh3_stores_col, nf%nh3_barns_col, & @@ -513,7 +512,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & do ind_substep = 1, num_substeps if (debug_fan .and. any(abs(tanpools(1:4)) > 1e12)) then write(iulog, *) ind_substep, tanpools(1:4), tandep, nf%fert_n_appl_col(c), & - nf%manure_n_appl_col(c), ns%manure_n_stored_col(c), ns%manure_tan_stored_col(c) + nf%manure_n_appl_col(c) call endrun('bad tanpools (manure app)') end if @@ -671,7 +670,7 @@ real(r8) function get_total_n(ns, nf, which) result(total) select case(which) case('pools_storage') - total = sum(ns%manure_n_stored_col(soilc)) + total = 0.0_r8 ! no explicit storage in this version case('fluxes_storage') total = sum(nf%manure_n_mix_col(soilc)) @@ -732,7 +731,7 @@ end subroutine fan_eval !************************************************************************************ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & - ndep_sgrz_grc, ndep_ngrz_grc, n_stored_col, tan_stored_col, & + ndep_sgrz_grc, ndep_ngrz_grc, & n_manure_spread_col, tan_manure_spread_col, & n_manure_graze_col, n_manure_mixed_col, & nh3_flux_stores, nh3_flux_barns, man_n_transf, & @@ -764,8 +763,6 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & ! N excreted in manure, gN/m2: real(r8), intent(in) :: ndep_sgrz_grc(bounds%begg:bounds%endg) ! seasonally grazing animals real(r8), intent(in) :: ndep_ngrz_grc(bounds%begg:bounds%endg) ! non-grazing animals - real(r8), intent(inout) :: n_stored_col(bounds%begc:bounds%endc), & - & tan_stored_col(bounds%begc:bounds%endc) ! N, TAN currently stored, gN/m2 ! N, TAN spread on grasslands, gN/m2/s: real(r8), intent(inout) :: n_manure_spread_col(bounds%begc:bounds%endc) real(r8), intent(out) :: tan_manure_spread_col(bounds%begc:bounds%endc) ! output, calculated from the above and stored manure diff --git a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 index a6a4a0e1c8..79b0cf9329 100644 --- a/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 +++ b/src/soilbiogeochem/SoilBiogeochemNitrogenStateType.F90 @@ -64,8 +64,6 @@ module SoilBiogeochemNitrogenStateType real(r8), pointer :: manure_a_app_col(:) ! col (gN/m2) available organic N, application real(r8), pointer :: manure_r_app_col(:) ! col (gN/m2) resistant organic N, application - real(r8), pointer :: manure_n_stored_col(:) ! col (gN/m2) manure N in storage - real(r8), pointer :: manure_tan_stored_col(:) ! col (gN/m2) manure TAN in storage real(r8), pointer :: fan_grz_fract_col(:) ! col unitless fraction of animals grazing real(r8), pointer :: fan_totn_col(:) ! col (gN/m2) total N in FAN pools @@ -189,8 +187,6 @@ subroutine InitAllocate(this, bounds) allocate(this%manure_a_app_col(begc:endc)) ; this%manure_a_app_col(:) = nan allocate(this%manure_r_app_col(begc:endc)) ; this%manure_r_app_col(:) = nan - allocate(this%manure_n_stored_col(begc:endc)) ; this%manure_n_stored_col(:) = nan - allocate(this%manure_tan_stored_col(begc:endc)) ; this%manure_tan_stored_col(:) = nan allocate(this%fan_grz_fract_col(begc:endc)) ; this%fan_grz_fract_col(:) = nan end if @@ -451,16 +447,6 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='Resistant manure nitrogen, application', & ptr_col=this%manure_r_app_col, default=fanpools_default) - this%manure_n_stored_col(begc:endc) = spval - call hist_addfld1d (fname='MANURE_N_STORED', units='gN/m^2', & - avgflag='A', long_name='Manure nitrogen in storage', & - ptr_col=this%manure_n_stored_col, default=fanpools_default) - - this%manure_tan_stored_col(begc:endc) = spval - call hist_addfld1d (fname='MANURE_TAN_STORED', units='gN/m^2', & - avgflag='A', long_name='Manure ammoniacal nitrogen in storage', & - ptr_col=this%manure_tan_stored_col, default=fanpools_default) - this%fan_grz_fract_col(begc:endc) = spval call hist_addfld1d (fname='FAN_GRZ_FRACT', units='', & avgflag='A', long_name='Fraction of animals grazing', & @@ -582,9 +568,7 @@ subroutine InitCold(this, bounds, & this%manure_a_app_col(c) = 0.0_r8 this%manure_r_app_col(c) = 0.0_r8 - this%manure_tan_stored_col(c) = 0.0_r8 this%fan_grz_fract_col(c) = 0.0_r8 - this%manure_n_stored_col(c) = 0.0_r8 end if this%fan_totn_col(c) = 0.0_r8 @@ -784,12 +768,6 @@ subroutine Restart ( this, bounds, ncid, flag, totvegc_col ) dim1name='column', long_name='', units='', & interpinic_flag='interp', readvar=readvar, data=this%manure_r_app_col) - call restartvar(ncid=ncid, flag=flag, varname='manure_tan_stored', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%manure_tan_stored_col) - call restartvar(ncid=ncid, flag=flag, varname='manure_n_stored', xtype=ncd_double, & - dim1name='column', long_name='', units='', & - interpinic_flag='interp', readvar=readvar, data=this%manure_n_stored_col) call restartvar(ncid=ncid, flag=flag, varname='fan_grz_fract', xtype=ncd_double, & dim1name='column', long_name='', units='', & interpinic_flag='interp', readvar=readvar, data=this%fan_grz_fract_col) From c9d43049c34ca1c34caa5fac53a6de00013c450b Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Fri, 18 Oct 2019 10:55:29 -0600 Subject: [PATCH 121/181] fix initialization of nsynthfert --- src/biogeochem/CNVegNitrogenFluxType.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/biogeochem/CNVegNitrogenFluxType.F90 b/src/biogeochem/CNVegNitrogenFluxType.F90 index b7f6c35fc4..ac4a3cbc28 100644 --- a/src/biogeochem/CNVegNitrogenFluxType.F90 +++ b/src/biogeochem/CNVegNitrogenFluxType.F90 @@ -957,6 +957,7 @@ subroutine InitHistory(this, bounds) call hist_addfld1d (fname='NMANURE', units='gN/m^2/s', & avgflag='A', long_name='Manure N added according to CLM default', & ptr_patch=this%manure_patch, default='inactive') + this%synthfert_patch(begp:endp) = spval call hist_addfld1d (fname='NSYNTHFERT', units='gN/m^2/s', & avgflag='A', long_name='Syntheric fertilizer N added', & ptr_patch=this%synthfert_patch, default='inactive') From 38638ad0f41621f888f87b12fc50f59012aab6c8 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Sun, 15 Dec 2019 17:27:03 +0200 Subject: [PATCH 122/181] variable naming, units, comments, etc --- src/biogeochem/Fan2CTSMMod.F90 | 305 +++++++++++++++++---------------- src/biogeochem/FanMod.F90 | 234 ++++++++++++++++--------- 2 files changed, 306 insertions(+), 233 deletions(-) diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index fbdaa186b7..9fc4963c6f 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -224,7 +224,6 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & type(waterfluxbulk_type) , intent(in) :: waterfluxbulk_inst type(frictionvel_type) , intent(in) :: frictionvel_inst - ! Local variables integer, parameter :: & ! Use this many sub-steps. This improves numerical accuracy but is perhaps not ! essential, because FAN includes an ad-hoc fixer for negative fluxes. @@ -236,32 +235,49 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & balance_check_freq = 1000 ! Number of organic N types (available, unavailable, resistant) integer, parameter :: num_org_n_types = 3 - integer :: c, g, patchcounter, p, status, c1, c2, l, fc, ind_substep - real(r8) :: dt, watertend, ratm, tandep - ! Organic (non-urea) manure N: production, pools, flux to TAN. Named indices to denote - ! each N fraction. - real(r8) :: ndep_org(num_org_n_types), orgpools(num_org_n_types), tanprod(num_org_n_types) - ! Temporary arrays for N fluxes and pools. Named indices to denote different fluxes; - ! numerical indices to denote the age class. - real(r8) :: fluxes(num_fluxes, num_cls_max), tanpools(num_cls_max), fluxes_tmp(num_fluxes) + ! Organic (non-urea) manure N: production, pools, flux to TAN. Named indices to + ! denote each N fraction. + real(r8) :: ndep_org(num_org_n_types) ! gN/m2/sec + real(r8) :: orgpools(num_org_n_types) ! gN/m2 + real(r8) :: tanprod(num_org_n_types) ! gN/m2/sec + ! Temporary arrays for N fluxes and pools. Named indices to denote different fluxes. + ! Numerical indices to denote the age class. + real(r8) :: tanpools(num_cls_max) ! gN/m2 + real(r8) :: ureapools(num_cls_urea) ! gN/m2 + real(r8) :: fluxes_tmp(num_fluxes) ! gN/m2/sec + real(r8) :: fluxes(num_fluxes, num_cls_max) ! gN/m2/sec + ! TAN production flux from urea. Include one extra flux for the residual flux out of U2. + real(r8) :: tanprod_from_urea(num_cls_urea + 1) ! gN/m2/sec ! timestep-cumulative (gN/m2) aging flux out of the oldest class - real(r8) :: n_residual, n_residual_total + real(r8) :: n_residual, n_residual_total, urea_resid ! H ion concentrations for grz and slr pools (== prescribed + soil pH for oldest class) - real(r8) :: Hconc_grz(num_cls_grz), Hconc_slr(num_cls_slr) - real(r8) :: fert_inc_tan, pH_soil, pH_crop - - logical :: do_balance_checks - real(r8) :: tg, theta, thetasat, infiltr_m_s, evap_m_s, runoff_m_s, org_n_tot, & - nstored_old, nsoilman_old, nsoilfert_old, fert_to_air, fert_to_soil, fert_total, fert_urea, fert_tan, & - soilflux_org, urea_resid - ! TAN production flux from urea. Include one extra flux for the residual flux out of U2. - real(r8) :: tanprod_from_urea(num_cls_urea + 1) - real(r8) :: ureapools(num_cls_urea) - real(r8) :: fract_urea, fract_no3, soilph_min, soilph_max, & - soilpsi, fert_no3, fert_generic, bsw + real(r8) :: Hconc_grz(num_cls_grz) + real(r8) :: Hconc_slr(num_cls_slr) + + real(r8) :: dt ! timestep, sec + real(r8) :: watertend ! time derivative of soil water content, m/s + real(r8) :: ratm ! total resistance Ra + Rb s/m + real(r8) :: pH_soil, pH_crop ! background soil pH in native veg. and crops + real(r8) :: tg ! soil temprature, K + real(r8) :: theta ! volumetric soil moisture, m3/m3 + real(r8) :: thetasat ! volumetric soil moisture at saturation (porosity), m3/m3 + real(r8) :: infiltr_m_s, evap_m_s, runoff_m_s ! infiltration, evaporation, runoff, m/s + real(r8) :: soilpsi ! soil matric potential, MPa + real(r8) :: org_n_tot ! organic N in slurry application, gN/m2/sec + real(r8) :: fert_total, fert_urea, fert_tan, fert_no3, soilflux_org + real(r8) :: ngrz ! manure N flux in grazing, gN/m2/sec + real(r8) :: fert_inc_tan ! urea and NH4 fertilizer incorporated directly to soil, gN/m2/sec + real(r8) :: fert_generic ! non-urea, non-no3 fertilizer N applied, gN/m2/sec + + ! index and auxiliary variables + real(r8) :: soilph_min, soilph_max, bsw + real(r8) :: nsoilman_old, nsoilfert_old integer :: def_ph_count - + integer :: c, g, p, l, fc, ind_substep, patchcounter, status + logical :: do_balance_checks + + ! Set the constant pHs. The column-dependent pHs will be set below. Hconc_grz(1:num_cls_grz-1) = Hconc_grz_def Hconc_slr(1:num_cls_slr-1) = Hconc_slr_def @@ -272,31 +288,20 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & do_balance_checks = balance_check_freq > 0 .and. mod(get_nstep(), balance_check_freq) == 0 associate(& - ngrz => soilbiogeochem_nitrogenflux_inst%man_n_grz_col, & - man_u_grz => soilbiogeochem_nitrogenstate_inst%man_u_grz_col, & - man_a_grz => soilbiogeochem_nitrogenstate_inst%man_a_grz_col, & - man_r_grz => soilbiogeochem_nitrogenstate_inst%man_r_grz_col, & - man_u_app => soilbiogeochem_nitrogenstate_inst%man_u_app_col, & - man_a_app => soilbiogeochem_nitrogenstate_inst%man_a_app_col, & - man_r_app => soilbiogeochem_nitrogenstate_inst%man_r_app_col, & ns => soilbiogeochem_nitrogenstate_inst, & nf => soilbiogeochem_nitrogenflux_inst, & cnv_nf => cnveg_nitrogenflux_inst, & - ram1 => frictionvel_inst%ram1_patch, & - rb1 => frictionvel_inst%rb1_patch) - - nf%fert_n_appl_col(bounds%begc:bounds%endc) = 0.0 - nf%man_n_appl_col(bounds%begc:bounds%endc) = 0.0 - nf%man_tan_appl_col(bounds%begc:bounds%endc) = 0.0 - + fract_urea => atm2lnd_inst%forc_ndep_urea_grc, & ! Fraction of urea in fertilizer N + fract_no3 => atm2lnd_inst%forc_ndep_nitr_grc, & ! Fraction of NO3 in fertilizer N + ram1 => frictionvel_inst%ram1_patch, & ! Aerodynamic resistance, s/m + rb1 => frictionvel_inst%rb1_patch) ! Quasi-laminar layer resistance, s/m + + ! Convert the patch fertilizer application (from crop model) to column flux: call p2c(bounds, num_soilc, filter_soilc, & cnv_nf%synthfert_patch(bounds%begp:bounds%endp), & nf%fert_n_appl_col(bounds%begc:bounds%endc)) - - nf%man_n_appl_col(bounds%begc:bounds%endc) = 0.0_r8 if (do_balance_checks) then - nstored_old = get_total_n(ns, nf, 'pools_storage') nsoilman_old = get_total_n(ns, nf, 'pools_manure') nsoilfert_old = get_total_n(ns, nf, 'pools_fertilizer') end if @@ -309,19 +314,14 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & if (.not. col%active(c) .or. col%wtgcell(c) < 1e-6) cycle g = col%gridcell(c) if (lun%itype(l) == istsoil) then - ngrz(c) = atm2lnd_inst%forc_ndep_grz_grc(g) / col%wtgcell(c) * 1e3 ! kg to g - if (debug_fan) then - if (ngrz(c) > 1e12 .or. (isnan(ngrz(c)))) then - write(iulog, *) 'bad ngrz', atm2lnd_inst%forc_ndep_grz_grc(g), col%wtgcell(c) - call endrun('bad ngrz 1') - end if - end if + nf%man_n_grz_col(c) & + = atm2lnd_inst%forc_ndep_grz_grc(g) / col%wtgcell(c) * 1e3 ! kg to g if (nf%man_n_appl_col(c) > 0) then - write(iulog, *) nf%man_n_appl_col(c) + write(iulog, *) 'man_n_appl_col:', nf%man_n_appl_col(c) call endrun(msg='Found fertilizer in soil column') end if else - ngrz(c) = 0.0 + nf%man_n_grz_col(c) = 0.0 end if end do @@ -358,12 +358,6 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & if (.not. (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop)) cycle if (.not. col%active(c) .or. col%wtgcell(c) < 1e-15) cycle - if (nf%man_n_appl_col(c) > 1e12 .or. ngrz(c) > 1e12) then - write(iulog, *) c, nf%man_n_appl_col(c), ngrz(c), cnv_nf%synthfert_patch(col%patchi(c):col%patchf(c)), & - cnv_nf%manure_patch(col%patchi(c):col%patchf(c)) - call endrun('nf%man_n_appl_col(c) is spval') - end if - ! Find and average the atmospheric resistances Rb and Ra. ! if (lun%itype(col%landunit(c)) == istcrop) then @@ -402,7 +396,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & ns%fan_grz_fract_col(c) = 1.0_r8 ! for crops handled by handle_storage end if - watertend = waterstatebulk_inst%h2osoi_tend_tsl_col(c) * 1e-3 ! to meters/sec (ie. m3/m2/s) + watertend = waterstatebulk_inst%h2osoi_tend_tsl_col(c) * 1e-3 ! to m/s tg = temperature_inst%t_grnd_col(c) theta = waterstatebulk_inst%h2osoi_vol_col(c,1) @@ -419,19 +413,19 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & ! grazing ! - - ndep_org(ind_avail) = ngrz(c) * (1.0_r8-fract_tan) * fract_avail - ndep_org(ind_resist) = ngrz(c) * (1.0_r8-fract_tan) * fract_resist - ndep_org(ind_unavail) = ngrz(c) * (1.0_r8-fract_tan) * fract_unavail - tandep = ngrz(c) * fract_tan - - orgpools(ind_avail) = man_a_grz(c) - orgpools(ind_resist) = man_r_grz(c) - orgpools(ind_unavail) = man_u_grz(c) - call update_org_n(ndep_org, tg, soilpsi, orgpools, dt, dz_layer_grz, tanprod, soilflux_org, size(orgpools), status) - man_a_grz(c) = orgpools(ind_avail) - man_r_grz(c) = orgpools(ind_resist) - man_u_grz(c) = orgpools(ind_unavail) + ngrz = nf%man_n_grz_col(c) + ndep_org(ind_avail) = ngrz * (1.0_r8-fract_tan) * fract_avail + ndep_org(ind_resist) = ngrz * (1.0_r8-fract_tan) * fract_resist + ndep_org(ind_unavail) = ngrz * (1.0_r8-fract_tan) * fract_unavail + + orgpools(ind_avail) = ns%man_a_grz_col(c) + orgpools(ind_resist) = ns%man_r_grz_col(c) + orgpools(ind_unavail) = ns%man_u_grz_col(c) + call update_org_n(ndep_org, tg, soilpsi, orgpools, dt, dz_layer_grz, & + tanprod, soilflux_org, size(orgpools), status) + ns%man_a_grz_col(c) = orgpools(ind_avail) + ns%man_r_grz_col(c) = orgpools(ind_resist) + ns%man_u_grz_col(c) = orgpools(ind_unavail) tanpools(1) = ns%tan_g1_col(c) tanpools(2) = ns%tan_g2_col(c) @@ -455,7 +449,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & call update_npool(tg, ratm, & theta, thetasat, infiltr_m_s, evap_m_s, & wateratm2lndbulk_inst%forc_q_downscaled_col(c), watertend, & - runoff_m_s, tandep, & + runoff_m_s, ngrz * fract_tan, & (/0.0_r8, 0.0_r8, sum(tanprod)/), & ! all TAN procuced from org N goes to G3 water_init_grz, & bsw, poolranges_grz, Hconc_grz, dz_layer_grz, tanpools(1:num_cls_grz), & @@ -463,7 +457,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & n_residual, dt/num_substeps, num_cls_grz, num_fluxes, status) if (status /= 0) then write(iulog, *) 'status = ', status, tanpools(1:num_cls_grz), & - ratm, theta, thetasat, tandep, tanprod + ratm, theta, thetasat, ngrz * fract_tan, tanprod call endrun(msg='update_npool status /= 0') end if fluxes_tmp = fluxes_tmp + sum(fluxes(:,1:num_cls_grz), dim=2) @@ -479,7 +473,8 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & nf%manure_nh4_runoff_col(c) = fluxes_tmp(iflx_roff) nf%manure_no3_prod_col(c) = fluxes_tmp(iflx_no3) nf%manure_nh4_to_soil_col(c) & - = fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) + n_residual_total / dt + soilflux_org + = fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) & + + n_residual_total / dt + soilflux_org ! Manure application @@ -489,15 +484,15 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & ndep_org(ind_avail) = org_n_tot * fract_avail ndep_org(ind_resist) = org_n_tot * fract_resist ndep_org(ind_unavail) = org_n_tot * fract_unavail - tandep = nf%man_tan_appl_col(c) - - orgpools(ind_avail) = man_a_app(c) - orgpools(ind_resist) = man_r_app(c) - orgpools(ind_unavail) = man_u_app(c) - call update_org_n(ndep_org, tg, soilpsi, orgpools, dt, dz_layer_slr, tanprod, soilflux_org, size(orgpools), status) - man_a_app(c) = orgpools(ind_avail) - man_r_app(c) = orgpools(ind_resist) - man_u_app(c) = orgpools(ind_unavail) + + orgpools(ind_avail) = ns%man_a_app_col(c) + orgpools(ind_resist) = ns%man_r_app_col(c) + orgpools(ind_unavail) = ns%man_u_app_col(c) + call update_org_n(ndep_org, tg, soilpsi, orgpools, dt, dz_layer_slr, & + tanprod, soilflux_org, size(orgpools), status) + ns%man_a_app_col(c) = orgpools(ind_avail) + ns%man_r_app_col(c) = orgpools(ind_resist) + ns%man_u_app_col(c) = orgpools(ind_unavail) tanpools(1) = ns%tan_s0_col(c) tanpools(2) = ns%tan_s1_col(c) @@ -511,22 +506,16 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & n_residual_total = 0.0 fluxes = 0.0 do ind_substep = 1, num_substeps - if (debug_fan .and. any(abs(tanpools(1:4)) > 1e12)) then - write(iulog, *) ind_substep, tanpools(1:4), tandep, nf%fert_n_appl_col(c), & - nf%man_n_appl_col(c), ns%man_n_stored_col(c), ns%man_tan_stored_col(c) - call endrun('bad tanpools (manure app)') - end if - call update_4pool(tg, ratm, theta, thetasat, infiltr_m_s, evap_m_s, & wateratm2lndbulk_inst%forc_q_downscaled_col(c), watertend, & - runoff_m_s, tandep, sum(tanprod), bsw, depth_slurry, & + runoff_m_s, nf%man_tan_appl_col(c), sum(tanprod), bsw, depth_slurry, & poolranges_slr, tanpools(1:num_cls_slr), Hconc_slr, & fluxes(1:num_fluxes, 1:num_cls_slr), & n_residual, dt / num_substeps, dz_layer_slr, num_cls_slr, num_fluxes, status) if (status /= 0) then - write(iulog, *) 'status = ', status, tanpools(1:num_cls_slr), & - & tg, ratm, 'th', theta, & - thetasat, tandep, 'tp', tanprod, 'fx', fluxes(1:num_fluxes,1:num_cls_slr) + write(iulog, *) 'status and tanpools: ', status, tanpools(1:num_cls_slr) + write(iulog, *) 'tg, ratm, theta, thetasat:', tg, ratm, theta, thetasat + write(iulog, *) 'tanfluxes:', nf%man_tan_appl_col(c), tanprod, fluxes(1:num_fluxes,1:num_cls_slr) call endrun(msg='update_4pool status /= 0') end if fluxes_tmp = fluxes_tmp + sum(fluxes(:,1:num_cls_slr), dim=2) @@ -547,26 +536,26 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & + n_residual_total / dt + soilflux_org ! Fertilizer - ! + ! split fertilizer N berween urea, no3 and the remaining other ammonium-N. fert_total = nf%fert_n_appl_col(c) - - fract_urea = atm2lnd_inst%forc_ndep_urea_grc(g) - fract_no3 = atm2lnd_inst%forc_ndep_nitr_grc(g) + !fract_urea = atm2lnd_inst%forc_ndep_urea_grc(g) + !fract_no3 = atm2lnd_inst%forc_ndep_nitr_grc(g) - ! N fractions made unavailable by mechanical incorporation, will be added directly - ! to the to-soil flux (tan) or no3 production (no3) below. - fert_inc_tan = fert_total * fert_incorp_reduct * (1.0 - fract_no3) + ! A fraction of fertilizer N is made unavailable by mechanical incorporation, this + ! will be added directly to the to-soil flux (tan) or no3 production (no3) below. + fert_inc_tan = fert_total * fert_incorp_reduct * (1.0 - fract_no3(g)) - if (fract_urea < 0 .or. fract_no3 < 0 .or. fract_urea + fract_no3 > 1) then + if (fract_urea(g) < 0 .or. fract_no3(g) < 0 .or. fract_urea(g) + fract_no3(g) > 1) then call endrun('bad fertilizer fractions') end if - - fert_urea = fert_total * fract_urea * (1.0_r8 - fert_incorp_reduct) + fert_urea = fert_total * fract_urea(g) * (1.0_r8 - fert_incorp_reduct) ! Fertilizer nitrate goes straight to the no3_prod, incorporated or not. - fert_no3 = fert_total * fract_no3 - fert_generic = fert_total * (1.0_r8 - fract_urea - fract_no3) * (1.0_r8 - fert_incorp_reduct) - nf%otherfert_n_appl_col(c) = fert_total * (1.0_r8 - fract_urea) ! note here goes also the incorporated N + fert_no3 = fert_total * fract_no3(g) + fert_generic = fert_total * (1.0_r8 - fract_urea(g) - fract_no3(g)) & + * (1.0_r8 - fert_incorp_reduct) + ! Below also includes the incorporated N: + nf%otherfert_n_appl_col(c) = fert_total * (1.0_r8 - fract_urea(g)) ! Urea decomposition ! @@ -580,7 +569,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & if (status /= 0) then call endrun(msg='Bad status after update_urea for fertilizer') end if - ! Nitrogen fluxes from urea pool. Be sure to not zero below! + ! Nitrogen fluxes from the urea pool. Be sure to not zero below! fluxes_tmp = sum(fluxes(:,1:num_cls_urea), dim=2) ns%fert_u1_col(c) = ureapools(1) @@ -636,7 +625,8 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & nf%nh3_fert_col(c) = fluxes_tmp(iflx_air) nf%fert_nh4_runoff_col(c) = fluxes_tmp(iflx_roff) nf%fert_no3_prod_col(c) = fluxes_tmp(iflx_no3) + fert_no3 - nf%fert_nh4_to_soil_col(c) = fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) + n_residual_total/dt + fert_inc_tan + nf%fert_nh4_to_soil_col(c) = fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) & + + n_residual_total/dt + fert_inc_tan ! Total flux ! @@ -759,7 +749,7 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & type(bounds_type), intent(in) :: bounds type(temperature_type) , intent(in) :: temperature_inst type(frictionvel_type) , intent(in) :: frictionvel_inst - real(r8), intent(in) :: dt + real(r8), intent(in) :: dt ! timestep, sec ! N excreted in manure, gN/m2: real(r8), intent(in) :: ndep_sgrz_grc(bounds%begg:bounds%endg) ! seasonally grazing animals @@ -783,29 +773,54 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & real(r8), intent(out) :: grz_fract(bounds%begc:bounds%endc) ! TAN fraction in excreted N real(r8), intent(in) :: tan_fract_excr - integer , intent(in) :: num_soilc ! number of soil columns in filter - integer , intent(in) :: filter_soilc(:) ! filter for soil columns + integer, intent(in) :: num_soilc ! number of soil columns in filter + integer, intent(in) :: filter_soilc(:) ! filter for soil columns - integer :: begg, endg, g, l, c, il, counter, col_grass, status, p - real(r8) :: flux_avail_rum, flux_avail_mg, flux_grazing, invscale - real(r8) :: tempr_ave, windspeed_ave ! windspeed and temperature averaged over agricultural patches - real(r8) :: tempr_barns, tempr_stores, vent_barns, flux_grass_crop, tempr_min_10day, & - flux_grass_graze, flux_grass_spread, flux_grass_spread_tan, flux_grass_crop_tan - real(r8) :: cumflux, totalinput, total_to_store, total_to_store_tan - ! dimensions are (type of flux, ruminant/other) - real(r8) :: fluxes_nitr(num_fluxes,2), fluxes_tan(num_fluxes,2) - ! The fraction of manure applied continuously on grasslands (if present in the gridcell) real(r8), parameter :: kg_to_g = 1e3_r8 + ! FAN allows a fraction of manure N diverted before storage; this optionis currently + ! not used. + real(r8), parameter :: fract_direct = 0.0_r8 + + ! N fluxes, gN/m2/sec: + ! + real(r8) :: flux_avail_rum ! Total ruminant manure in barns (not grazing) + real(r8) :: flux_avail_mg ! Non-ruminant manure (only barns) + real(r8) :: flux_grazing ! Ruminant manure, grazing in mixed/landless systems Manure + ! Manure N collected from crop columns and moved to nat. veg. column within the gridcell; + ! grazing: + real(r8) :: flux_grass_graze + ! Manure N collected from crop columns and moved to nat. veg. column within the gridcell; + ! manure application: + real(r8) :: flux_grass_spread ! Organic + TAN + real(r8) :: flux_grass_spread_tan ! TAN only + real(r8) :: total_to_store ! total N remaining after losses in barns + real(r8) :: total_to_store_tan ! TAN remaining after losses in barns + + ! scaling factor for converting from per-land-area to per-crop area if needed: + real(r8) :: invscale + + ! N fluxes evaluated by eval_fluxes_storage. Indices are in FanMode.F90. Dimensions + ! are (type of flux, ruminant/other). + real(r8) :: fluxes_nitr(num_fluxes,2), fluxes_tan(num_fluxes,2) + + ! Auxiliary and index variables: logical :: is_grass + integer :: begg, endg, g, l, c, il, counter, col_grass, status, p + real(r8) :: cumflux, totalinput begg = bounds%begg; endg = bounds%endg nh3_flux_stores(bounds%begc:bounds%endc) = 0_r8 nh3_flux_barns(bounds%begc:bounds%endc) = 0_r8 man_n_barns(bounds%begc:bounds%endc) = 0.0_r8 + + associate(& + t_ref2m => temperature_inst%t_ref2m_patch, & ! 2m temperature, K + u10 => frictionvel_inst%u10_patch, & ! 10m wind speed, m/s + t_a10min => temperature_inst%t_a10min_patch) ! 10-day running mean 2m temperature (K) totalinput = 0.0 cumflux = 0.0 - + do g = begg, endg ! First find out if there are grasslands in this cell. If yes, a fraction of ! manure can be diverted to them before storage. @@ -827,9 +842,9 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & if (col_grass /= ispval) exit end do ! Transfer of manure from all crop columns to the natural vegetation column: - flux_grass_graze = 0_r8 - flux_grass_spread = 0_r8 - flux_grass_spread_tan = 0_r8 + flux_grass_graze = 0.0_r8 + flux_grass_spread = 0.0_r8 + flux_grass_spread_tan = 0.0_r8 do il = 1, max_lunit l = grc%landunit_indices(il, g) @@ -857,8 +872,7 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & n_manure_mixed_col(c) = (ndep_ngrz_grc(g) + ndep_sgrz_grc(g)) * kg_to_g * invscale - tempr_min_10day = temperature_inst%t_a10min_patch(col%patchi(c)) - if (tempr_min_10day > tempr_min_grazing) then + if (t_a10min(col%patchi(c)) > tempr_min_grazing) then ! fraction of animals grazing -> allocate some manure to grasslands before barns flux_grazing = max_grazing_fract * ndep_sgrz_grc(g) * kg_to_g * invscale flux_avail_rum = (ndep_sgrz_grc(g)*(1.0_r8 - max_grazing_fract)) * kg_to_g * invscale @@ -871,11 +885,6 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & flux_avail_mg = ndep_ngrz_grc(g) * kg_to_g * invscale flux_grass_graze = flux_grass_graze + flux_grazing*col%wtgcell(c) - if (flux_avail_rum > 1e12 .or. flux_avail_mg > 1e12 .or. isnan(flux_avail_mg) .or. isnan(flux_avail_rum)) then - write(iulog, *) 'bad flux_avail', ndep_ngrz_grc(g), ndep_sgrz_grc(g), lun%wtgcell(l) - call endrun('bad flux_avail') - end if - totalinput = totalinput + flux_avail_rum + flux_avail_mg counter = 0 @@ -884,13 +893,11 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & call endrun(msg="ERROR crop column has multiple patches") end if - tempr_ave = temperature_inst%t_ref2m_patch(col%patchi(c)) - windspeed_ave = frictionvel_inst%u10_patch(col%patchi(c)) - man_n_barns(c) = flux_avail_rum + flux_avail_mg ! Evaluate the NH3 losses, separate for ruminants (open barns) and others - ! (poultry and pigs, closed barns). Note the slicing of fluxes(:,:) and fluxes_tan(:,:). + ! (poultry and pigs, closed barns). Note the slicing of fluxes(:,:) and + ! fluxes_tan(:,:). nh3_flux_stores(c) = 0.0 if (flux_avail_rum < 0) then @@ -899,8 +906,10 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & end if ! Ruminants - call eval_fluxes_storage(flux_avail_rum, 'open', tempr_ave, windspeed_ave, 0.0_r8, & - volat_coef_barns_open, volat_coef_stores, tan_fract_excr, fluxes_nitr(:,1), fluxes_tan(:,1), & + call eval_fluxes_storage(flux_avail_rum, 'open', & + t_ref2m(col%patchi(c)), u10(col%patchi(c)), & + fract_direct, volat_coef_barns_open, volat_coef_stores, & + tan_fract_excr, fluxes_nitr(:,1), fluxes_tan(:,1), & size(fluxes_nitr, 1), status) if (status /=0) then write(iulog, *) 'status = ', status @@ -908,8 +917,10 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & end if ! Others - call eval_fluxes_storage(flux_avail_mg, 'closed', tempr_ave, windspeed_ave, 0.0_r8, & - volat_coef_barns_closed, volat_coef_stores, tan_fract_excr, fluxes_nitr(:,2), fluxes_tan(:,2), & + call eval_fluxes_storage(flux_avail_mg, 'closed', & + t_ref2m(col%patchi(c)), u10(col%patchi(c)), & + fract_direct, volat_coef_barns_closed, volat_coef_stores, & + tan_fract_excr, fluxes_nitr(:,2), fluxes_tan(:,2), & size(fluxes_nitr, 1), status) if (status /=0) then write(iulog, *) 'status = ', status @@ -921,7 +932,7 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & if (fluxes_tan(iflx_to_store,1) < 0) then call endrun(msg="ERROR too much manure lost") end if - ! Simplification as of 2019: no explicit manure storage. Flux to storage + ! Manure storage is not evaluated explicitly, instead, the flux to storage ! will be spread "immediately". total_to_store = sum(fluxes_nitr(iflx_to_store,:)) total_to_store_tan = sum(fluxes_tan(iflx_to_store,:)) @@ -929,8 +940,10 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & n_manure_spread_col(c) = (1.0_r8 - fract_spread_grass) * total_to_store tan_manure_spread_col(c) = (1.0_r8 - fract_spread_grass) * total_to_store_tan - flux_grass_spread = flux_grass_spread + fract_spread_grass * total_to_store*col%wtgcell(c) - flux_grass_spread_tan = flux_grass_spread_tan + fract_spread_grass * total_to_store_tan*col%wtgcell(c) + flux_grass_spread = flux_grass_spread & + + fract_spread_grass * total_to_store*col%wtgcell(c) + flux_grass_spread_tan = flux_grass_spread_tan & + + fract_spread_grass * total_to_store_tan*col%wtgcell(c) man_n_transf(c) = flux_grazing + fract_spread_grass*total_to_store @@ -942,27 +955,18 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & end do ! landunit if (col_grass /= ispval) then - if (tan_manure_spread_col(col_grass) > 1) then - write(iulog, *) 'bad tan_manure col_grass before adding', n_manure_spread_col(col_grass), & - tan_manure_spread_col(col_grass) - call endrun(msg="ERROR bad tan") - end if n_manure_spread_col(col_grass) = n_manure_spread_col(col_grass) & + flux_grass_spread / col%wtgcell(col_grass) tan_manure_spread_col(col_grass) = tan_manure_spread_col(col_grass) & + flux_grass_spread_tan / col%wtgcell(col_grass) n_manure_graze_col(col_grass) = n_manure_graze_col(col_grass) + flux_grass_graze / col%wtgcell(col_grass) - if (tan_manure_spread_col(col_grass) > 1) then - write(iulog, *) 'bad tan_manure col_grass', flux_grass_spread_tan, col%wtgcell(col_grass) - call endrun(msg="ERROR bad tan") - end if else if (flux_grass_spread > 0) then continue !call endrun('Cannot spread manure') end if end do ! grid - + end associate end subroutine handle_storage !************************************************************************************ @@ -1058,7 +1062,6 @@ subroutine fan_to_sminn(bounds, filter_soilc, num_soilc, sbgc_nf, nfertilization nfertilization_patch(p) = manure_prod + sbgc_nf%fert_n_appl_col(c) end do end if - end do end subroutine fan_to_sminn diff --git a/src/biogeochem/FanMod.F90 b/src/biogeochem/FanMod.F90 index a8be5b9ff3..52c6a1de65 100755 --- a/src/biogeochem/FanMod.F90 +++ b/src/biogeochem/FanMod.F90 @@ -69,12 +69,17 @@ module FanMod ! Adsorption coeffient of NH4 in soil: real(r8), public, save :: nh4_ads_coef = 1.0_r8 - integer, parameter, public :: err_bad_theta = 1, err_negative_tan = 2, err_negative_flux = 3, & - err_balance_tan = 4, err_balance_nitr = 5, err_nan = 6, err_bad_subst = 7, err_bad_type = 8, err_bad_arg = 9 + ! Error flags: + integer, parameter, public :: & + err_bad_theta = 1, err_negative_tan = 2, err_negative_flux = 3, & + err_balance_tan = 4, err_balance_nitr = 5, err_nan = 6, & + err_bad_subst = 7, err_bad_type = 8, err_bad_arg = 9 integer, parameter, public :: subst_tan = 1, subst_urea = 2 logical, parameter, public :: debug_fan = .false. + + real(r8), parameter :: abstol = 1e-15_r8 ! tolerance for trapping roundoff errors contains @@ -127,9 +132,9 @@ function eval_diffusivity_liq_mq(theta, thetasat, tg) result(diff) real(r8), intent(in) :: thetasat ! theta at saturation real(r8), intent(in) :: tg ! soil temperature, K - real(r8) :: diff + real(r8) :: diff ! diffusivity in m2/s - real(r8) :: kaq_base + real(r8) :: kaq_base ! diffusivity without tortuosity factor real(r8), parameter :: pw = 7.0_r8 / 3.0_r8 ! Van Der Molen 1990 fit of the base rate. @@ -148,7 +153,8 @@ function eval_diffusivity_gas_mq(theta, thetasat, tg) result(diff) real(r8), intent(in) :: tg ! soil temperature, K real(r8) :: diff ! diffusivity, m2/s - real(r8) :: soilair, dair + real(r8) :: soilair ! volume fraction of air filled pore space + real(r8) :: dair ! molec. diffusivity in air real(r8), parameter :: pw = 7.0_r8 / 3.0_r8 real(r8), parameter :: mNH3 = 17.0_r8, mair = SHR_CONST_MWDAIR, vNH3 = 14.9_r8, vair = 20.1_r8, press = 1.0_r8 real(r8), parameter :: pow = 1.0_r8 / 3.0_r8 @@ -156,9 +162,6 @@ function eval_diffusivity_gas_mq(theta, thetasat, tg) result(diff) ! Van Der Molen 1990 fit of the base rate. !dair = 1.7e-5_r8 * 1.03_r8**(Tg-293.0_r8) - - !dair = 18e-6_r8 - !dair = 1.4e-5 ! Base rate from the Fuller et al. 1966 method. dair = (0.001_r8 * tg**1.75_r8 * sqrt(1.0_r8/mNH3 + 1.0_r8/mair)) / (press * (vair**pow * vNH3**pow)**2) * 1e-4_r8 @@ -195,13 +198,18 @@ subroutine partition_tan(tg, Hconc, theta, air, kads, KNH3, fract_nh4) end subroutine partition_tan - real(r8) function eval_no3prod(theta, theta_sat, Tg) result(kNO3) + function eval_no3prod(theta, theta_sat, Tg) result(kNO3) ! Evaluate nitrification rate as in the Riddick et al. (2016) paper but for NH4. real(r8), intent(in) :: theta, theta_sat ! volumetric soil water m/m real(r8), intent(in) :: Tg ! soil temperature, K + ! return value + real(r8) :: kNO3 ! nitrification rate, 1/s + ! terms in the parameterization, see below: + real(r8) :: stf, wmr, smrf - real(r8) :: stf, wmr, smrf, mNH4, soil_dens - + real(r8), parameter :: soil_part_dens = 2650.0_r8 ! soil particle density, kg/m3 + real(r8) :: soil_dens ! bulk density of soil, kg/m3 + real(r8), parameter :: water_dens = SHR_CONST_RHOFW real(r8), parameter :: rmax = 1.16e-6_r8 ! Maximum rate of nitrification, s-1 real(r8), parameter :: tmax = 313.0 ! Maximm temperature of microbial activity, K @@ -209,10 +217,8 @@ real(r8) function eval_no3prod(theta, theta_sat, Tg) result(kNO3) real(r8), parameter :: asg = 2.4_r8 ! a_sigma, empirical factor real(r8), parameter :: wmr_crit = 0.12_r8 ! Critical water content, g/g real(r8), parameter :: smrf_b = 2 ! Parameter in soil moisture response function - - soil_dens = 2650.0_r8 * (1.0_r8-theta_sat) - mNH4 = 1.0_r8 - + + soil_dens = soil_part_dens * (1.0_r8-theta_sat) ! soil temperature function stf = (max(1e-3_r8, tmax-Tg) / (tmax-topt))**asg * exp(asg * (Tg-topt)/(tmax-topt)) @@ -220,9 +226,9 @@ real(r8) function eval_no3prod(theta, theta_sat, Tg) result(kNO3) wmr = theta * water_dens / soil_dens ! soil moisture response function - smrf = 1.0_r8 - exp(-(wmr/wmr_crit)**smrf_b) - kNO3 = 2.0_r8 * rmax * mNH4 / (1.0_r8/stf + 1.0_r8/smrf) + ! nitrification rate + kNO3 = 2.0_r8 * rmax / (1.0_r8/stf + 1.0_r8/smrf) end function eval_no3prod @@ -250,11 +256,18 @@ subroutine eval_fluxes_slurry(water_surf, water_subsurf, mtan, Hconc, tg, ratm, integer, intent(in) :: fluxes_size real(r8), intent(out) :: fluxes(fluxes_size) ! TAN fluxes, see top of the module - !real(r8), intent(in) :: dt ! timestep - - real(r8) :: water_tot, cnc, air, depth_soilsat, diffusivity_water, diffusivity_satsoil, halfwater, insoil, r1, dz2, inwater - real(r8) :: r2, volat_rate, kno3, knh3, depth_lower, fract_nh4, r2a, r2b, g3, gdown, rsld, rkl, rkg - real(r8) :: rsl, rssup, rssdn + real(r8) :: water_tot ! total water volume, m + real(r8) :: cnc ! concentration of tan in water, gN / m3 + real(r8) :: air ! volume fraction of air-filled pores + real(r8) :: diffusivity_water, diffusivity_satsoil + real(r8) :: volat_rate ! volatilization rate, 1/s + real(r8) :: kno3 ! nitrification rate, 1/s + real(r8) :: knh3 ! gas/aqueous partitioning of TAN, tan(g) / tan(aq) + + ! auxiliary resistance for diffusion, s/m + real(r8) :: r1, r2a, rsld, rkl, rkg, gdown, rsl, rssup, rssdn + ! other auxiliary variables + real(r8) :: depth_soilsat, halfwater, insoil, dz2, inwater, depth_lower air = max(thetasat - theta, 0.001) ! depth of the saturated soil layer below the surface pool @@ -281,7 +294,6 @@ subroutine eval_fluxes_slurry(water_surf, water_subsurf, mtan, Hconc, tg, ratm, ! pool only inwater = halfwater insoil = 0.0_r8 - !r1 = halfwater / diffusivity_water end if rsl = min(halfwater, water_surf) / diffusivity_water @@ -290,7 +302,7 @@ subroutine eval_fluxes_slurry(water_surf, water_subsurf, mtan, Hconc, tg, ratm, depth_lower = max(soildepth_reservoir, depth_soilsat*1.5) - call partition_tan(tg, Hconc, 1.0_r8, 0.0_r8, 0.0_r8, knh3, fract_nh4=fract_nh4) + call partition_tan(tg, Hconc, 1.0_r8, 0.0_r8, 0.0_r8, knh3) volat_rate = & knh3/(-ratm*kads*theta + ratm*kads + ratm*thetasat - r1*kads*knh3*theta + r1*kads*knh3 + r1*knh3*thetasat) @@ -339,14 +351,31 @@ subroutine eval_fluxes_soil(mtan, water_manure, Hconc, tg, ratm, theta, thetasat real(r8), intent(out) :: fluxes(fluxes_size) ! nitrogen fluxes, mass units / m2 / s, see top of module integer, intent(in) :: substance ! subst_tan or subst_urea. integer, intent(out) :: status ! error flag - - real(r8) :: water_tot, cnc, air, henry_eff, dsl, dsg, dstot, dz2, no3_rate, volat_rate, theta_tot, beta - real(r8) :: cnc_srfg, cnc_srfaq, cnc_soilaq, cnc_soilg, dz, rsl, rsg - real(r8) :: fract_gas, fract_nh3aq, fract_nh4, fract_aq, volatility - ! distribution coefficient, unitless ((g NH4 adsorbed / m3 soil solid) / (g NH4 dissolved / m3 soil water)) + ! Atmospheric concentration of NH3. This will be always 0 for evaluating gross + ! emissions. + real(r8), parameter :: cnc_atm = 0.0_r8 + ! + ! Local variables + real(r8) :: water_tot ! soil + possible manure water, m + real(r8) :: cnc ! concentration per volume of soil, gN / m soil + real(r8) :: cnc_srfg ! concentration in gas at surface, gN / m air + real(r8) :: cnc_srfaq ! concentration in water at surface, gN / m water + real(r8) :: cnc_soilaq ! concentration in water in soil, gN / m water + real(r8) :: cnc_soilg ! concentration in air in soil, gN / m air + real(r8) :: air ! volume fraction of air in soil + real(r8) :: no3_rate ! nitrification rate, 1/s + real(r8) :: volat_rate ! volatilization rate, 1/s + real(r8) :: volatility ! volatility, TAN (g) / TAN(aq) + ! distribution coefficient of NH4+ + ! ((g NH4 adsorbed / m3 soil solid) / (g NH4 dissolved / m3 soil water)) real(r8) :: kads + ! auxiliary variables + real(r8) :: dsl, dsg, dz2, theta_tot + real(r8) :: dz, rsl, rsg + + water_tot = water_manure + theta*soildepth if (water_tot < 1e-9) then fluxes = 0.0 @@ -371,7 +400,7 @@ subroutine eval_fluxes_soil(mtan, water_manure, Hconc, tg, ratm, theta, thetasat if (substance == subst_tan) then kads = kads_nh4 - call partition_tan(tg, Hconc, theta_tot, air, kads, volatility, fract_nh4=fract_nh4) + call partition_tan(tg, Hconc, theta_tot, air, kads, volatility) no3_rate = eval_no3prod(theta_tot, thetasat, tg) else if (substance == subst_urea) then volatility = 0.0 @@ -382,7 +411,8 @@ subroutine eval_fluxes_soil(mtan, water_manure, Hconc, tg, ratm, theta, thetasat return end if - call get_srf_cnc(volatility, cnc, 0.0_r8, rsg, rsl, Ratm, runoff, theta_tot, air, cnc_srfg, cnc_srfaq) + call get_srf_cnc(volatility, cnc, cnc_atm, rsg, rsl, Ratm, & + runoff, theta_tot, air, cnc_srfg, cnc_srfaq) fluxes(iflx_air) = cnc_srfg / ratm fluxes(iflx_roff) = runoff * cnc_srfaq @@ -409,7 +439,7 @@ subroutine get_srf_cnc(knh3, xs, xag, Rsg, Rsl, Rag, qr, theta, air, cnc_gas, cn real(r8), intent(in) :: xs ! mass / m3 soil real(r8), intent(in) :: Rsg, Rsl, theta, air - real(r8), intent(out) :: cnc_gas, cnc_aq + real(r8), intent(out) :: cnc_gas, cnc_aq ! at the surface real(r8) :: x0, x1, x2, x3, x4, x5, x6 @@ -519,7 +549,7 @@ end subroutine age_pools_slurry subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend, runoff, tandep, tanprod, bsw, & depth_slurry, poolranges, tanpools, Hconc, fluxes, residual, dt, dz_layer, pools_size, fluxes_size, status) ! - ! Evaluate fluxes and integrate states for a 4-stage slurry model with first pool + ! Evaluate fluxes and integrate states for a 4-stage slurry model with the first pool ! representing uninfiltrated slurry. ! implicit none @@ -548,8 +578,17 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend real(r8), intent(in) :: dt ! timestep, sec, >0 integer, intent(out) :: status ! return status, 0 = good - real(r8) :: infiltr_slurry, infiltrated, percolated, evap_slurry, water_slurry(2), perc_slurry_mean, waterloss - real(r8) :: percolation, water_soil, age_prev, water_in_layer, tanpools_old(4), water_relax_t + real(r8) :: infiltr_slurry ! infiltration rate, m/s + real(r8) :: infiltrated, percolated ! m + real(r8) :: water_slurry(2) ! m + real(r8) :: perc_clurry_mean ! m/s + real(r8) :: waterloss ! m + real(r8) :: percolation ! m/s + real(r8) :: water_soil ! m + real(r8) :: evap_slurry ! m/s + real(r8) :: water_relax_t ! sec + + real(r8) :: age_prev, water_in_layer, tanpools_old(4), perc_slurry_mean integer :: indpl if (pools_size < 4 .or. fluxes_size < 5) then @@ -591,7 +630,7 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend call update_pools(tanpools(1:1), fluxes(1:5,1:1), dt, 1, 5) - if (debug_fan .and. any(tanpools < -1e-14)) then + if (debug_fan .and. any(tanpools < -abstol)) then status = err_negative_tan return end if @@ -606,7 +645,8 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend ! age_prev = 0 ! for water evaluations, consider beginning of S1 as the starting point water_in_layer = infiltrated - percolated ! water in layer just after slurry has infiltrated - water_relax_t = poolranges(2) ! relax time is for soil moisture after infiltration ie. the first "normal" N pool. + ! this relax time is for soil moisture after infiltration ie. the first "normal" N pool. + water_relax_t = poolranges(2) do indpl = 2, 4 ! water content lost during the aging waterloss = water_in_layer * (waterfunction(age_prev, water_relax_t) & @@ -625,7 +665,7 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend call update_pools(tanpools(2:4), fluxes(1:5,2:4), dt, 3, 5) - if (debug_fan .and. any(tanpools < -1e-15)) then + if (debug_fan .and. any(tanpools < -abstol)) then status = err_negative_tan * 10 return end if @@ -678,11 +718,16 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend real(r8), intent(in) :: dt ! timestep, sec, >0 integer, intent(out) :: status ! 0 == OK - real(r8) :: fraction_layer, fraction_reservoir, fraction_runoff, waterloss, direct_runoff - real(r8) :: percolation, water_soil, age_prev, tandep_remaining, direct_percolation, water_into_layer - real(r8) :: tanpools_old(size(tanpools)), imbalance, water_relax_t - integer :: indpl + real(r8) :: fraction_layer ! fraction of initial water content remaining in the FAN layer + real(r8) :: fraction_reservoir! fraction of initial water content going to the layer below + real(r8) :: fraction_runoff ! fraction of initial water content going to immediate runoff + real(r8) :: waterloss ! loss of water within the age span of first pool, m + real(r8) :: percolation ! water percolated downwards within the age span of a pool, m/s + real(r8) :: water_relax_t ! time (in age dimension) required for moisture to relax, sec + real(r8) :: age_prev, tandep_remaining, direct_percolation, water_into_layer + real(r8) :: tanpools_old(size(tanpools)), imbalance, direct_runoff, water_soil + integer :: indpl logical :: fixed if (size_fluxes < 5) then @@ -697,14 +742,17 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend return end if - ! Initial water excess goes to runoff if the surface is close to saturation, otherwise to the soil. + ! Initial water excess goes to runoff if the surface is close to saturation, otherwise + ! to the soil. ! - call partition_to_layer(water_init, theta, thetasat, dz_layer, fraction_layer, fraction_reservoir, fraction_runoff) + call partition_to_layer(water_init, theta, thetasat, dz_layer, & + fraction_layer, fraction_reservoir, fraction_runoff) direct_runoff = fraction_runoff * tandep direct_percolation = fraction_reservoir * tandep tandep_remaining = tandep - direct_runoff - direct_percolation water_into_layer = water_init * (1.0_r8 - fraction_reservoir - fraction_runoff) - if (tandep_remaining < -1e-15) then + + if (tandep_remaining < -abstol) then status = err_negative_tan + 10 return end if @@ -723,20 +771,20 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend ! Pool aging & TAN input ! call age_pools_soil(tandep_remaining, dt, poolranges, tanpools, residual) - ! TAN produced (mineralization) goes to directly the old TAN pool. + ! TAN produced from organic N (mineralization) goes to directly the old TAN pool. if (any(tanpools < 0)) then - if (any(tanpools < -1e-15)) then + if (any(tanpools < -abstol)) then status = err_negative_tan + 10000 return else - where(tanpools<0) tanpools = 0.0 + where(tanpools<0) tanpools = 0.0_r8 end if end if if (debug_fan) then imbalance = abs((sum(tanpools) - sum(tanpools_old)) - ((tandep_remaining)*dt+residual)) - if (imbalance > max(1e-14, 0.001*sum(tanpools_old))) then + if (imbalance > max(abstol, 0.001*sum(tanpools_old))) then status = err_balance_tan*10 return end if @@ -752,14 +800,14 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend water_soil = water_into_layer * waterfunction(age_prev + 0.5*poolranges(indpl), water_relax_t) call eval_fluxes_soil(tanpools(indpl), water_soil, Hconc(indpl), tg, & & ratm, theta, thetasat, percolation, runoff, bsw, nh4_ads_coef, & - & dz_layer, fluxes(1:5,indpl), subst_tan, 5, status) + & dz_layer, fluxes(1:num_fluxes,indpl), subst_tan, num_fluxes, status) if (status /= 0) then return end if age_prev = age_prev + poolranges(indpl) end do - call update_pools(tanpools, fluxes(1:5,:), dt, numpools, 5, fixed) + call update_pools(tanpools, fluxes(1:5,:), dt, numpools, nf=5, fixed=fixed) tanpools = tanpools + tanprod*dt @@ -769,7 +817,7 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend return end if - if (any(tanpools < -1e-15)) then + if (any(tanpools < -abstol)) then status = err_negative_tan + 1000 return end if @@ -778,8 +826,9 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend status = err_nan + 1000 end if - if (abs(sum(tanpools - tanpools_old) + (sum(fluxes)-tandep_remaining-sum(tanprod))*dt + residual) & - > max(sum(tanpools_old)*1e-2, 1d-2)) then + if (abs(sum(tanpools - tanpools_old) + & + (sum(fluxes)-tandep_remaining-sum(tanprod))*dt + residual) & + > max(sum(tanpools_old)*1e-2_r8, 1e-2_r8)) then status = err_balance_tan return end if @@ -789,7 +838,7 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend fluxes(iflx_roff, 1) = fluxes(iflx_roff, 1) + direct_runoff fluxes(iflx_soilq, 1) = fluxes(iflx_soilq, 1) + direct_percolation - if (any(fluxes < -1e-6)) then + if (any(fluxes < -abstol)) then status = err_negative_flux return end if @@ -857,13 +906,13 @@ function get_evap_pool(tg, ratm, qbot) result(evap) end function get_evap_pool - ! Waterfunction gives the relaxation of the moisture perturbation normalized between 0 - ! and 1. Either exponential or linear. + ! The "waterfunction" gives the relaxation of the moisture perturbation normalized + ! between 0 and 1. Either exponential or linear. function waterfunction_exp(pool_age, water_relax_t) result(water) implicit none real(r8), intent(in) :: pool_age, water_relax_t ! sec - real(r8) :: water + real(r8) :: water water = exp(-pool_age / water_relax_t) end function waterfunction_exp @@ -926,6 +975,7 @@ subroutine eval_fluxes_storage(nitr_input, barntype, tempr_outside, windspeed, f integer, intent(out) :: status ! see top of the module. ! parameters for the Gyldenkaerne et al. parameterization + ! all temperatures in deg. C. real(r8), parameter :: Tfloor_barns = 4.0_r8, Tfloor_stores = 1.0_r8 real(r8), parameter :: Tmin_barns = 0.01_r8 real(r8), parameter :: Tmax_barns = 12.5_r8 @@ -936,9 +986,19 @@ subroutine eval_fluxes_storage(nitr_input, barntype, tempr_outside, windspeed, f real(r8), parameter :: DTlow = 0.5_r8, DThigh = 1.0_r8 real(r8), parameter :: vmax_barns_closed = 0.40_r8, vmax_barns_open = 0.228_r8 real(r8) :: Vmax_barns ! depends on barntype - - real(r8) :: flux_avail, flux_avail_tan, tempr_stores, tempr_barns, vent_barns, flux_direct, flux_direct_tan, & - & flux_barn, flux_store, tempr_C + + ! N fluxes, gN/m2/sec + real(r8) :: flux_avail ! Manure N flux in barns after after losses at each step. Total N + real(r8) :: flux_avail_tan ! TAN + real(r8) :: flux_direct ! Manure N applied to soil directly from barns. Total N + real(r8) :: flux_direct_tan ! TAN + real(r8) :: flux_barn ! NH3 emission from barns + real(r8) :: flux_store ! NH3 emission from stores + + ! Temperatures in C for the parameterization: + real(r8) :: tempr_C + real(r8) :: tempr_stores, tempr_barns + real(r8) :: vent_barns if (fluxes_size < 4) then status = err_bad_arg @@ -948,7 +1008,9 @@ subroutine eval_fluxes_storage(nitr_input, barntype, tempr_outside, windspeed, f fluxes_nitr = 0.0_r8 fluxes_tan = 0.0_r8 tempr_C = tempr_outside - SHR_CONST_TKFRZ - + + ! Determine the temperature and ventilation rates of animal housings according to the + ! parameterization, depeding on the type of housing. select case(barntype) case ('open') Vmax_barns = vmax_barns_open @@ -968,7 +1030,7 @@ subroutine eval_fluxes_storage(nitr_input, barntype, tempr_outside, windspeed, f status = err_bad_type return end select - + if (tempr_C < Tmin_barns) then vent_barns = Vmin_barns else if (tempr_C > Tmax_barns) then @@ -980,25 +1042,28 @@ subroutine eval_fluxes_storage(nitr_input, barntype, tempr_outside, windspeed, f flux_avail = nitr_input flux_avail_tan = nitr_input * tan_fract_excr - if (flux_avail < -1e-15 .or. flux_avail_tan < -1e-15) then + if (flux_avail < -abstol .or. flux_avail_tan < -abstol) then status = err_negative_flux*1000 return end if - + + ! NH3 emissions from barns + ! flux_barn = flux_avail_tan * volat_coef_barns * tempr_barns**pA * vent_barns**pB flux_barn = min(flux_avail_tan, flux_barn) ! hopefully uncommon - fluxes_tan(iflx_air_barns) = flux_barn fluxes_nitr(iflx_air_barns) = flux_barn flux_avail = flux_avail - flux_barn flux_avail_tan = flux_avail_tan - flux_barn - if (flux_avail < 0 .or. flux_avail_tan < 0) then + if (flux_avail < abstol .or. flux_avail_tan < abstol) then status = err_negative_flux*10000 return end if - + + ! Direct manure application before storage: + ! flux_direct = fract_direct * flux_avail flux_avail = flux_avail - flux_direct flux_direct_tan = flux_avail_tan * fract_direct @@ -1007,8 +1072,10 @@ subroutine eval_fluxes_storage(nitr_input, barntype, tempr_outside, windspeed, f fluxes_tan(iflx_appl) = flux_direct_tan fluxes_nitr(iflx_appl) = flux_direct + ! NH3 emissions from manure storage + ! tempr_stores = max(Tfloor_stores, tempr_C) - ! with some input data, in some rare places, we can have windspeed < 0 (!?) + ! With some input data, in some rare places, we can have windspeed < 0 (!?) flux_store = flux_avail_tan & & * volat_coef_stores * tempr_stores**pA * max(windspeed, 0.0_r8)**pB flux_store = min(flux_avail_tan, flux_store) @@ -1071,11 +1138,11 @@ subroutine update_org_n(flux_input, tg, soilpsi, pools, dt, dz_layer, tanprod, s integer, intent(out) :: status real(r8) :: rate_res, rate_avail, TR, rmoist, psi - real(r8), parameter :: ka1 = 8.94e-7_r8, ka2 = 6.38e-8 ! 1/s + real(r8), parameter :: ka1 = 8.94e-7_r8, ka2 = 6.38e-8_r8 ! 1/s real(r8), parameter :: tr1 = 0.0106_r8, tr2 = 0.12979_r8 - real(r8), parameter :: org_to_soil_time = 365*24*3600.0_r8 - real(r8), parameter :: minpsi = -2.5_r8, maxpsi=-0.002_r8 - real(r8) :: soilfluxes(3) + real(r8), parameter :: org_to_soil_time = 365*24*3600.0_r8 ! s + real(r8), parameter :: minpsi = -2.5_r8, maxpsi=-0.002_r8 ! MPa + real(r8) :: soilfluxes(3) ! N flux to soil pools from each organic N fraction, gN/m2/sec if (size_pools < 3) then status = err_bad_arg @@ -1084,13 +1151,13 @@ subroutine update_org_n(flux_input, tg, soilpsi, pools, dt, dz_layer, tanprod, s TR = tr1 * exp(tr2 * (tg-SHR_CONST_TKFRZ)) - ! The moisture scaling taken from CLM5 litter decomposition scheme: + ! The moisture scaling is taken from CLM5 litter decomposition scheme: psi = min(soilpsi, maxpsi) ! decomp only if soilpsi is higher than minpsi if (psi > minpsi) then rmoist = log(minpsi/psi) / log(minpsi/maxpsi) else - rmoist = 0.0 + rmoist = 0.0_r8 end if tanprod(ind_avail) = ka1 * TR * pools(ind_avail)*rmoist @@ -1132,8 +1199,10 @@ subroutine update_urea(tg, theta, thetasat, precip, evap, watertend, runoff, & real(r8), parameter :: rate = 4.83e-6 ! urea decomposition, 1/s real(r8), parameter :: missing = 1e36 ! for the parameters not needed for urea fluxes - + real(r8), parameter :: water_manure=0.0_r8, Hconc_missing=missing, & + ratm_missing=missing, kads_nh4_missing=missing real(r8) :: age_prev, percolation, old_total, balance + integer :: indpl if (fluxes_size < 6) then @@ -1149,8 +1218,8 @@ subroutine update_urea(tg, theta, thetasat, precip, evap, watertend, runoff, & do indpl = 1, numpools percolation = eval_perc(0.0_r8, evap, precip, watertend, ranges(indpl)) ! Hconc and Ratm are missing since they do not affect urea. - call eval_fluxes_soil(pools(indpl), 0.0_r8, missing, tg, & - missing, theta, thetasat, percolation, runoff, bsw, 0.0_r8, & + call eval_fluxes_soil(pools(indpl), water_manure, Hconc_missing, tg, & + ratm_missing, theta, thetasat, percolation, runoff, bsw, kads_nh4_missing, & dz_layer, fluxes(1:5, indpl), subst_urea, 5, status) if (status /= 0) then return @@ -1159,13 +1228,13 @@ subroutine update_urea(tg, theta, thetasat, precip, evap, watertend, runoff, & age_prev = age_prev + ranges(indpl) end do - ! Here goes also flux_tan! - call update_pools(pools, fluxes(1:6, 1:numpools), dt, numpools, 6) + ! Here goes also flux_tan (the production of TAN from urea decomposition) + call update_pools(pools, fluxes(1:num_fluxes, 1:numpools), dt, numpools, num_fluxes) balance = sum(pools) - old_total if (debug_fan) then - if (abs(balance - (ndep-sum(fluxes))*dt + residual) > 1e-9) then + if (abs(balance - (ndep-sum(fluxes))*dt + residual) > abstol) then status = err_balance_nitr return end if @@ -1193,7 +1262,8 @@ subroutine get_storage_fluxes_tan_ar(manure_excr, tempr_outside, windspeed, frac real(r8) :: fluxes_nitr(4), fluxes_tan(4) do ii = 1, nn - call eval_fluxes_storage(manure_excr(ii), 'open', tempr_outside(ii), windspeed(ii), fract_direct(ii), & + call eval_fluxes_storage(manure_excr(ii), 'open', tempr_outside(ii), windspeed(ii), & + & fract_direct(ii), & & volat_coef_barns, volat_coef_stores, tan_fract_excr, & & fluxes_nitr, fluxes_tan, 4, status) From c2f9448f97fc691529d7cc1fccbcbe98332a0f9e Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Sat, 18 Jan 2020 18:14:25 +0200 Subject: [PATCH 123/181] supposedly not answer changing changes after Bill Sacks' comments --- src/biogeochem/Fan2CTSMMod.F90 | 219 +++++++++++++++------------------ src/biogeochem/FanMod.F90 | 107 +++++++--------- 2 files changed, 142 insertions(+), 184 deletions(-) diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index 9fc4963c6f..2b38f89d2c 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -287,6 +287,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & dt = real(get_step_size(), r8) do_balance_checks = balance_check_freq > 0 .and. mod(get_nstep(), balance_check_freq) == 0 + ! TODO rename forc_ndep_nitr_grz to fract_no3_grc associate(& ns => soilbiogeochem_nitrogenstate_inst, & nf => soilbiogeochem_nitrogenflux_inst, & @@ -310,7 +311,6 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & do fc = 1, num_soilc c = filter_soilc(fc) l = col%landunit(c) - if (.not. (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop)) cycle if (.not. col%active(c) .or. col%wtgcell(c) < 1e-6) cycle g = col%gridcell(c) if (lun%itype(l) == istsoil) then @@ -382,6 +382,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & ratm = ratm / patchcounter else ! grass not found, take something. + ! TODO change to average over everything do p = col%patchi(c), col%patchf(c) if (.not. patch%active(p) .or. ram1(p) == spval .or. rb1(p) == spval) cycle ratm = ram1(p) + rb1(p) @@ -422,7 +423,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & orgpools(ind_resist) = ns%man_r_grz_col(c) orgpools(ind_unavail) = ns%man_u_grz_col(c) call update_org_n(ndep_org, tg, soilpsi, orgpools, dt, dz_layer_grz, & - tanprod, soilflux_org, size(orgpools), status) + tanprod, soilflux_org, status) ns%man_a_grz_col(c) = orgpools(ind_avail) ns%man_r_grz_col(c) = orgpools(ind_resist) ns%man_u_grz_col(c) = orgpools(ind_unavail) @@ -489,7 +490,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & orgpools(ind_resist) = ns%man_r_app_col(c) orgpools(ind_unavail) = ns%man_u_app_col(c) call update_org_n(ndep_org, tg, soilpsi, orgpools, dt, dz_layer_slr, & - tanprod, soilflux_org, size(orgpools), status) + tanprod, soilflux_org, status) ns%man_a_app_col(c) = orgpools(ind_avail) ns%man_r_app_col(c) = orgpools(ind_resist) ns%man_u_app_col(c) = orgpools(ind_unavail) @@ -511,7 +512,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & runoff_m_s, nf%man_tan_appl_col(c), sum(tanprod), bsw, depth_slurry, & poolranges_slr, tanpools(1:num_cls_slr), Hconc_slr, & fluxes(1:num_fluxes, 1:num_cls_slr), & - n_residual, dt / num_substeps, dz_layer_slr, num_cls_slr, num_fluxes, status) + n_residual, dt / num_substeps, dz_layer_slr, status) if (status /= 0) then write(iulog, *) 'status and tanpools: ', status, tanpools(1:num_cls_slr) write(iulog, *) 'tg, ratm, theta, thetasat:', tg, ratm, theta, thetasat @@ -565,7 +566,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & call update_urea(tg, theta, thetasat, infiltr_m_s, evap_m_s, watertend, & runoff_m_s, fert_urea, bsw, ureapools, fluxes(1:num_fluxes,1:num_cls_urea), & urea_resid, poolranges_fert(1:num_cls_urea), & - dt, dz_layer_fert, num_cls_urea, num_fluxes, status) + dt, dz_layer_fert, status) if (status /= 0) then call endrun(msg='Bad status after update_urea for fertilizer') end if @@ -752,25 +753,25 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & real(r8), intent(in) :: dt ! timestep, sec ! N excreted in manure, gN/m2: - real(r8), intent(in) :: ndep_sgrz_grc(bounds%begg:bounds%endg) ! seasonally grazing animals - real(r8), intent(in) :: ndep_ngrz_grc(bounds%begg:bounds%endg) ! non-grazing animals - real(r8), intent(inout) :: n_stored_col(bounds%begc:bounds%endc), & + real(r8), intent(in) :: ndep_sgrz_grc(:) ! seasonally grazing animals + real(r8), intent(in) :: ndep_ngrz_grc(:) ! non-grazing animals + real(r8), intent(inout) :: n_stored_col(:), & & tan_stored_col(bounds%begc:bounds%endc) ! N, TAN currently stored, gN/m2 ! N, TAN spread on grasslands, gN/m2/s: - real(r8), intent(inout) :: n_manure_spread_col(bounds%begc:bounds%endc) - real(r8), intent(out) :: tan_manure_spread_col(bounds%begc:bounds%endc) ! output, calculated from the above and stored manure + real(r8), intent(inout) :: n_manure_spread_col(:) + real(r8), intent(inout) :: tan_manure_spread_col(:) ! output, calculated from the above and stored manure ! N excreted by animals allocated to mixed production systems temporarily grazing on grasslands: - real(r8), intent(inout) :: n_manure_graze_col(bounds%begc:bounds%endc) + real(r8), intent(inout) :: n_manure_graze_col(:) ! N excreted by animals in mixed systems, total - real(r8), intent(out) :: n_manure_mixed_col(bounds%begc:bounds%endc) + real(r8), intent(inout) :: n_manure_mixed_col(:) ! NH3 emission fluxes from manure storage and housings, gN/m2/s - real(r8), intent(out) :: nh3_flux_stores(bounds%begc:bounds%endc), nh3_flux_barns(bounds%begc:bounds%endc) + real(r8), intent(inout) :: nh3_flux_stores(:), nh3_flux_barns(bounds%begc:bounds%endc) ! total nitrogen flux transferred out of a crop column (manure spreading + temporary grazing) - real(r8), intent(out) :: man_n_transf(bounds%begc:bounds%endc) + real(r8), intent(inout) :: man_n_transf(:) ! Total nitrogen excreted in barns - real(r8), intent(out) :: man_n_barns(bounds%begc:bounds%endc) + real(r8), intent(inout) :: man_n_barns(:) ! fraction of manure excreted when grazing - real(r8), intent(out) :: grz_fract(bounds%begc:bounds%endc) + real(r8), intent(inout) :: grz_fract(:) ! TAN fraction in excreted N real(r8), intent(in) :: tan_fract_excr integer, intent(in) :: num_soilc ! number of soil columns in filter @@ -807,11 +808,6 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & logical :: is_grass integer :: begg, endg, g, l, c, il, counter, col_grass, status, p real(r8) :: cumflux, totalinput - - begg = bounds%begg; endg = bounds%endg - nh3_flux_stores(bounds%begc:bounds%endc) = 0_r8 - nh3_flux_barns(bounds%begc:bounds%endc) = 0_r8 - man_n_barns(bounds%begc:bounds%endc) = 0.0_r8 associate(& t_ref2m => temperature_inst%t_ref2m_patch, & ! 2m temperature, K @@ -846,113 +842,98 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & flux_grass_spread = 0.0_r8 flux_grass_spread_tan = 0.0_r8 - do il = 1, max_lunit - l = grc%landunit_indices(il, g) - if (l == ispval) cycle - if (lun%itype(l) == istcrop) then - ! flux_avail = manure excreted per m2 of crops (ndep_mixed_grc = per m2 / all land units) - do c = lun%coli(l), lun%colf(l) - if (.not. col%active(c)) cycle - if (col%wtgcell(c) < 1e-6) cycle - - if (col%landunit(c) /= l) then - write(iulog, *) g, il, c, col%landunit(c) - call endrun('something wrong') - end if - if (.not. any(c==filter_soilc(1:num_soilc))) then - write(iulog, *) c, n_manure_spread_col(c) - call endrun('column not in soilfilter') - end if + l = grc%landunit_indices(istcrop, g) + if (l /= ispval) then + ! flux_avail = manure excreted per m2 of crops (ndep_mixed_grc = per m2 / all land units) + do c = lun%coli(l), lun%colf(l) + if (.not. col%active(c)) cycle - if (crop_man_is4crop_area) then - invscale = 1.0_r8 - else - invscale = 1.0_r8 / lun%wtgcell(l) - end if + if (crop_man_is4crop_area) then + invscale = 1.0_r8 + else + invscale = 1.0_r8 / lun%wtgcell(l) + end if - n_manure_mixed_col(c) = (ndep_ngrz_grc(g) + ndep_sgrz_grc(g)) * kg_to_g * invscale - - if (t_a10min(col%patchi(c)) > tempr_min_grazing) then - ! fraction of animals grazing -> allocate some manure to grasslands before barns - flux_grazing = max_grazing_fract * ndep_sgrz_grc(g) * kg_to_g * invscale - flux_avail_rum = (ndep_sgrz_grc(g)*(1.0_r8 - max_grazing_fract)) * kg_to_g * invscale - grz_fract(c) = max_grazing_fract - else - flux_grazing = 0.0_r8 - flux_avail_rum = ndep_sgrz_grc(g) * kg_to_g * invscale - grz_fract(c) = 0.0_r8 - end if - flux_avail_mg = ndep_ngrz_grc(g) * kg_to_g * invscale - flux_grass_graze = flux_grass_graze + flux_grazing*col%wtgcell(c) + n_manure_mixed_col(c) = (ndep_ngrz_grc(g) + ndep_sgrz_grc(g)) * kg_to_g * invscale + + if (t_a10min(col%patchi(c)) > tempr_min_grazing) then + ! fraction of animals grazing -> allocate some manure to grasslands before barns + flux_grazing = max_grazing_fract * ndep_sgrz_grc(g) * kg_to_g * invscale + flux_avail_rum = (ndep_sgrz_grc(g)*(1.0_r8 - max_grazing_fract)) * kg_to_g * invscale + grz_fract(c) = max_grazing_fract + else + flux_grazing = 0.0_r8 + flux_avail_rum = ndep_sgrz_grc(g) * kg_to_g * invscale + grz_fract(c) = 0.0_r8 + end if + flux_avail_mg = ndep_ngrz_grc(g) * kg_to_g * invscale + flux_grass_graze = flux_grass_graze + flux_grazing*col%wtgcell(c) - totalinput = totalinput + flux_avail_rum + flux_avail_mg + totalinput = totalinput + flux_avail_rum + flux_avail_mg - counter = 0 - if (col_grass == c) call endrun('Something wrong with the indices') - if (col%patchi(c) /= col%patchf(c)) then - call endrun(msg="ERROR crop column has multiple patches") - end if + counter = 0 + if (col_grass == c) call endrun('Something wrong with the indices') + if (col%patchi(c) /= col%patchf(c)) then + call endrun(msg="ERROR crop column has multiple patches") + end if - man_n_barns(c) = flux_avail_rum + flux_avail_mg - - ! Evaluate the NH3 losses, separate for ruminants (open barns) and others - ! (poultry and pigs, closed barns). Note the slicing of fluxes(:,:) and - ! fluxes_tan(:,:). - nh3_flux_stores(c) = 0.0 + man_n_barns(c) = flux_avail_rum + flux_avail_mg - if (flux_avail_rum < 0) then - write(iulog, *) 'flux:', flux_avail_rum - call endrun(msg='negat flux_avail for ruminants') - end if + ! Evaluate the NH3 losses, separate for ruminants (open barns) and others + ! (poultry and pigs, closed barns). Note the slicing of fluxes(:,:) and + ! fluxes_tan(:,:). + nh3_flux_stores(c) = 0.0 - ! Ruminants - call eval_fluxes_storage(flux_avail_rum, 'open', & - t_ref2m(col%patchi(c)), u10(col%patchi(c)), & - fract_direct, volat_coef_barns_open, volat_coef_stores, & - tan_fract_excr, fluxes_nitr(:,1), fluxes_tan(:,1), & - size(fluxes_nitr, 1), status) - if (status /=0) then - write(iulog, *) 'status = ', status - call endrun(msg='eval_fluxes_storage failed for ruminants') - end if + if (flux_avail_rum < 0) then + write(iulog, *) 'flux:', flux_avail_rum + call endrun(msg='negat flux_avail for ruminants') + end if - ! Others - call eval_fluxes_storage(flux_avail_mg, 'closed', & - t_ref2m(col%patchi(c)), u10(col%patchi(c)), & - fract_direct, volat_coef_barns_closed, volat_coef_stores, & - tan_fract_excr, fluxes_nitr(:,2), fluxes_tan(:,2), & - size(fluxes_nitr, 1), status) - if (status /=0) then - write(iulog, *) 'status = ', status - call endrun(msg='eval_fluxes_storage failed for other livestock') - end if + ! Ruminants + call eval_fluxes_storage(flux_avail_rum, 'open', & + t_ref2m(col%patchi(c)), u10(col%patchi(c)), & + fract_direct, volat_coef_barns_open, volat_coef_stores, & + tan_fract_excr, fluxes_nitr(:,1), fluxes_tan(:,1), status) + if (status /=0) then + write(iulog, *) 'status = ', status + call endrun(msg='eval_fluxes_storage failed for ruminants') + end if - cumflux = cumflux + sum(fluxes_nitr) - - if (fluxes_tan(iflx_to_store,1) < 0) then - call endrun(msg="ERROR too much manure lost") - end if - ! Manure storage is not evaluated explicitly, instead, the flux to storage - ! will be spread "immediately". - total_to_store = sum(fluxes_nitr(iflx_to_store,:)) - total_to_store_tan = sum(fluxes_tan(iflx_to_store,:)) - - n_manure_spread_col(c) = (1.0_r8 - fract_spread_grass) * total_to_store - tan_manure_spread_col(c) = (1.0_r8 - fract_spread_grass) * total_to_store_tan - - flux_grass_spread = flux_grass_spread & - + fract_spread_grass * total_to_store*col%wtgcell(c) - flux_grass_spread_tan = flux_grass_spread_tan & - + fract_spread_grass * total_to_store_tan*col%wtgcell(c) - - man_n_transf(c) = flux_grazing + fract_spread_grass*total_to_store - - nh3_flux_stores(c) = sum(fluxes_nitr(iflx_air_stores,:)) - nh3_flux_barns(c) = sum(fluxes_nitr(iflx_air_barns,:)) - - end do ! column - end if ! crop land unit - end do ! landunit + ! Others + call eval_fluxes_storage(flux_avail_mg, 'closed', & + t_ref2m(col%patchi(c)), u10(col%patchi(c)), & + fract_direct, volat_coef_barns_closed, volat_coef_stores, & + tan_fract_excr, fluxes_nitr(:,2), fluxes_tan(:,2), status) + if (status /=0) then + write(iulog, *) 'status = ', status + call endrun(msg='eval_fluxes_storage failed for other livestock') + end if + + cumflux = cumflux + sum(fluxes_nitr) + + if (fluxes_tan(iflx_to_store,1) < 0) then + call endrun(msg="ERROR too much manure lost") + end if + ! Manure storage is not evaluated explicitly, instead, the flux to storage + ! will be spread "immediately". + total_to_store = sum(fluxes_nitr(iflx_to_store,:)) + total_to_store_tan = sum(fluxes_tan(iflx_to_store,:)) + + n_manure_spread_col(c) = (1.0_r8 - fract_spread_grass) * total_to_store + tan_manure_spread_col(c) = (1.0_r8 - fract_spread_grass) * total_to_store_tan + + flux_grass_spread = flux_grass_spread & + + fract_spread_grass * total_to_store*col%wtgcell(c) + flux_grass_spread_tan = flux_grass_spread_tan & + + fract_spread_grass * total_to_store_tan*col%wtgcell(c) + + man_n_transf(c) = flux_grazing + fract_spread_grass*total_to_store + + nh3_flux_stores(c) = sum(fluxes_nitr(iflx_air_stores,:)) + nh3_flux_barns(c) = sum(fluxes_nitr(iflx_air_barns,:)) + + end do ! column + end if ! land unit not ispval if (col_grass /= ispval) then n_manure_spread_col(col_grass) = n_manure_spread_col(col_grass) & diff --git a/src/biogeochem/FanMod.F90 b/src/biogeochem/FanMod.F90 index 52c6a1de65..0f14bfb7bf 100755 --- a/src/biogeochem/FanMod.F90 +++ b/src/biogeochem/FanMod.F90 @@ -127,7 +127,6 @@ end function ind_to_store function eval_diffusivity_liq_mq(theta, thetasat, tg) result(diff) ! Evaluate the aquous phase diffusivity for TAN in soil according to the Millington & ! Quirk model. - implicit none real(r8), intent(in) :: theta ! volumetric water content, m3/m3 real(r8), intent(in) :: thetasat ! theta at saturation real(r8), intent(in) :: tg ! soil temperature, K @@ -147,7 +146,6 @@ end function eval_diffusivity_liq_mq function eval_diffusivity_gas_mq(theta, thetasat, tg) result(diff) ! Evaluate the gas phase diffusivity for NH3 in soil according to the Millington & ! Quirk model. - implicit none real(r8), intent(in) :: theta ! volumetric water content, m3/m3 real(r8), intent(in) :: thetasat ! theta at saturation real(r8), intent(in) :: tg ! soil temperature, K @@ -174,7 +172,6 @@ end function eval_diffusivity_gas_mq subroutine partition_tan(tg, Hconc, theta, air, kads, KNH3, fract_nh4) ! Partition the bulk TAN (NH3 gas/aq + NH4 (aq)) between gas and aqueous. Outputs the ! volatility (gas/aq ratio), see below. - implicit none real(r8), intent(in) :: tg ! soil temperature, K real(r8), intent(in) :: Hconc ! H+ concentration, mol / l real(r8), intent(in) :: theta ! water volume fraction @@ -236,11 +233,10 @@ end function eval_no3prod ! Nitrogen fluxes for single patch / single N pool subroutine eval_fluxes_slurry(water_surf, water_subsurf, mtan, Hconc, tg, ratm, theta, & - thetasat, perc, runoff, bsw, kads, fluxes, fluxes_size) + thetasat, perc, runoff, bsw, kads, fluxes) ! Evaluate nitrogen fluxes for a partly infiltrated layer of slurry. ! The state of infiltration is detemined from the amounts water on surface and in soil. ! Positive flux means loss of TAN. - implicit none real(r8), intent(in) :: water_surf ! water (slurry) on surface, m real(r8), intent(in) :: water_subsurf ! water (slurry) below surface in addition to water already in soil, m real(r8), intent(in) :: mtan ! TAN, mass units / m2, surface + subsurface @@ -253,8 +249,7 @@ subroutine eval_fluxes_slurry(water_surf, water_subsurf, mtan, Hconc, tg, ratm, real(r8), intent(in) :: runoff ! surface runoff, m/s real(r8), intent(in) :: bsw ! water retention curve "b" real(r8), intent(in) :: kads ! dimensionless distribution coefficient, kads = [TAN (s)] / [TAN (aq)] - integer, intent(in) :: fluxes_size - real(r8), intent(out) :: fluxes(fluxes_size) ! TAN fluxes, see top of the module + real(r8), intent(out) :: fluxes(:) ! TAN fluxes, see top of the module real(r8) :: water_tot ! total water volume, m real(r8) :: cnc ! concentration of tan in water, gN / m3 @@ -304,7 +299,8 @@ subroutine eval_fluxes_slurry(water_surf, water_subsurf, mtan, Hconc, tg, ratm, call partition_tan(tg, Hconc, 1.0_r8, 0.0_r8, 0.0_r8, knh3) volat_rate = & - knh3/(-ratm*kads*theta + ratm*kads + ratm*thetasat - r1*kads*knh3*theta + r1*kads*knh3 + r1*knh3*thetasat) + knh3/(-ratm*kads*theta + ratm*kads + ratm*thetasat - r1*kads*knh3*theta & + + r1*kads*knh3 + r1*knh3*thetasat) fluxes(iflx_air) = volat_rate*cnc @@ -328,13 +324,12 @@ subroutine eval_fluxes_slurry(water_surf, water_subsurf, mtan, Hconc, tg, ratm, end subroutine eval_fluxes_slurry subroutine eval_fluxes_soil(mtan, water_manure, Hconc, tg, ratm, theta, thetasat, perc, & - & runoff, bsw, kads_nh4, soildepth, fluxes, substance, fluxes_size, status) + & runoff, bsw, kads_nh4, soildepth, fluxes, substance, status) ! ! Evaluate nitrogen fluxes from a soil layer. Use for all cases except the partly ! infiltrated slurry (above). Fluxes can be evaluated either for urea or TAN: for ! urea, only the aqueous phase fluxes are evaluated and nitrification is set to zero. ! - implicit none real(r8), intent(in) :: mtan ! TAN (=NH4 (aq) + NH3 (g) + NH3 (aq)), mass units / m2 real(r8), intent(in) :: water_manure ! water in the soil pool *in addition to* background soil water real(r8), intent(in) :: Hconc ! Hydrogen ion concentration, mol/l @@ -347,8 +342,7 @@ subroutine eval_fluxes_soil(mtan, water_manure, Hconc, tg, ratm, theta, thetasat real(r8), intent(in) :: bsw ! b in the soilwater retention curve; needed if the Moldrup 2003 diffusivities are used. real(r8), intent(in) :: kads_nh4 ! distribution coefficient kads = [TAN (s)] / [TAN (aq)]. Unit m3(water) / m3(soil). real(r8), intent(in) :: soildepth ! thickness of the volatlization layer - integer, intent(in) :: fluxes_size - real(r8), intent(out) :: fluxes(fluxes_size) ! nitrogen fluxes, mass units / m2 / s, see top of module + real(r8), intent(out) :: fluxes(:) ! nitrogen fluxes, mass units / m2 / s, see top of module integer, intent(in) :: substance ! subst_tan or subst_urea. integer, intent(out) :: status ! error flag @@ -464,7 +458,6 @@ end subroutine eval_fluxes_soil subroutine partition_to_layer(water, theta, thetasat, soildepth, fraction_in, fraction_down, fraction_runoff) ! Evaluate the fraction of water volume that can be accommodated (before saturation) ! by a soil layer with current water content theta. - implicit none real(r8), intent(in) :: water ! water to be added to the layer, m real(r8), intent(in) :: theta, thetasat ! vol. soil water, current and saturation, m/m real(r8), intent(in) :: soildepth ! thickness of the layer, m @@ -497,7 +490,6 @@ subroutine age_pools_soil(ndep, dt, pools, mtan, garbage) ! Evaluate the N pool "aging" for one time step; moves N mass from the pools ! representing younger to older N patches. ! - implicit none real(r8), intent(in) :: ndep ! flux of TAN input, gN/m2/s real(r8), intent(inout) :: mtan(:) ! TAN pools for each age range. gN/m2 real(r8), intent(in) :: dt ! timestep, s @@ -523,7 +515,6 @@ subroutine age_pools_slurry(ndep, dt, water_slurry, tan_slurry, tan_soil, pools, ! ! Age pools, modified for the 4-stage slurry model (only below-surface slurry ages). ! - implicit none real(r8), intent(in) :: ndep ! flux of TAN input, gN/m2/s real(r8), intent(in) :: dt ! timestep, s ! water in slurry pool, on surface (1) and below surface (2) not including the background water content (theta) @@ -547,12 +538,11 @@ end subroutine age_pools_slurry ! Public functions for integrating the FAN model for one timestep. subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend, runoff, tandep, tanprod, bsw, & - depth_slurry, poolranges, tanpools, Hconc, fluxes, residual, dt, dz_layer, pools_size, fluxes_size, status) + depth_slurry, poolranges, tanpools, Hconc, fluxes, residual, dt, dz_layer, status) ! ! Evaluate fluxes and integrate states for a 4-stage slurry model with the first pool ! representing uninfiltrated slurry. ! - implicit none real(r8), intent(in) :: tg ! soil temperature, K real(r8), intent(in) :: ratm ! atmospheric resistance, s/m real(r8), intent(in) :: theta ! volumetric soil water in soil column (unaffected by slurry) @@ -567,12 +557,10 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend real(r8), intent(in) :: bsw real(r8), intent(in) :: depth_slurry ! Initial slurry depth, m ! age ranges of TAN pools S0, S1, S2, S3 sec. Slurry infiltration time is inferred from S0. - integer, intent(in) :: pools_size ! size of the tanpools array. >= 4 - real(r8), intent(in) :: poolranges(pools_size) - real(r8), intent(inout) :: tanpools(pools_size) ! TAN pools gN/m2 - integer, intent(in) :: fluxes_size ! size of the fluxes array. >= 5 - real(r8), intent(out) :: fluxes(fluxes_size, pools_size) ! TAN fluxes, gN/m2/s (type of flux, pool) - real(r8), intent(in) :: Hconc(pools_size) ! H+ concentration + real(r8), intent(in) :: poolranges(:) + real(r8), intent(inout) :: tanpools(:) ! TAN pools gN/m2 + real(r8), intent(out) :: fluxes(:,:) ! TAN fluxes, gN/m2/s (type of flux, pool) + real(r8), intent(in) :: Hconc(:) ! H+ concentration real(r8), intent(in) :: dz_layer ! layer thickness, m real(r8), intent(out) :: residual ! over-aged TAN occurring during the step, gN/m. real(r8), intent(in) :: dt ! timestep, sec, >0 @@ -590,8 +578,8 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend real(r8) :: age_prev, water_in_layer, tanpools_old(4), perc_slurry_mean integer :: indpl - - if (pools_size < 4 .or. fluxes_size < 5) then + + if (ubound(fluxes, 1) < num_fluxes .or. ubound(fluxes, 2) < 4) then status = err_bad_arg return end if @@ -620,7 +608,7 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend call eval_fluxes_slurry(water_slurry(1), water_slurry(2), tanpools(1), Hconc(1), & tg, ratm, theta, thetasat, perc_slurry_mean, & - runoff, bsw, nh4_ads_coef, fluxes(1:5,1), 5) + runoff, bsw, nh4_ads_coef, fluxes(1:5,1)) if (debug_fan) then if (any(isnan(fluxes))) then @@ -657,7 +645,7 @@ subroutine update_4pool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend water_soil = water_in_layer * waterfunction(age_prev + 0.5*poolranges(indpl), water_relax_t) call eval_fluxes_soil(tanpools(indpl), water_soil, Hconc(indpl), tg, & & ratm, theta, thetasat, percolation, runoff, bsw, nh4_ads_coef, & - & dz_layer, fluxes(1:5,indpl), subst_tan, 5, status) + & dz_layer, fluxes(1:5,indpl), subst_tan, status) if (status /= 0) return age_prev = age_prev + poolranges(indpl) @@ -693,7 +681,6 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend ! Evaluate fluxes and update soil TAN pools for a model with arbitrary number of pools ! defined by age and pH. For slurry use update_4pool. ! - implicit none real(r8), intent(in) :: tg ! soil temperature, K real(r8), intent(in) :: ratm ! atmospheric resistance, s/m real(r8), intent(in) :: theta ! volumetric soil water in soil column (unaffected by slurry) @@ -705,15 +692,15 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend real(r8), intent(in) :: runoff ! surface runoff flux, m/s real(r8), intent(in) :: tandep ! TAN input flux, gN/m2/s integer, intent(in) :: numpools - real(r8), intent(in) :: tanprod(numpools) ! flux of TAN produced (from urea/organic n) in the column + real(r8), intent(in) :: tanprod(:) ! flux of TAN produced (from urea/organic n) in the column real(r8), intent(in) :: water_init ! Initial water volume in the affected patch, m real(r8), intent(in) :: bsw ! b parameter in soil water retention curve - real(r8), intent(in) :: poolranges(numpools) ! age ranges of TAN pools (npools) - real(r8), intent(in) :: Hconc(numpools) ! H+ concentration, mol/l (npools) + real(r8), intent(in) :: poolranges(:) ! age ranges of TAN pools (npools) + real(r8), intent(in) :: Hconc(:) ! H+ concentration, mol/l (npools) real(r8), intent(in) :: dz_layer ! thickness of the volatilization layer, m - real(r8), intent(inout) :: tanpools(numpools) ! TAN pools gN/m2 (npools) + real(r8), intent(inout) :: tanpools(:) ! TAN pools gN/m2 (npools) integer, intent(in) :: size_fluxes - real(r8), intent(out) :: fluxes(size_fluxes,numpools) ! TAN fluxes, gN/m2/s (type of flux, pool) + real(r8), intent(out) :: fluxes(:,:) ! TAN fluxes, gN/m2/s (type of flux, pool) real(r8), intent(out) :: residual ! "over-aged" TAN produced during the step, gN/m. real(r8), intent(in) :: dt ! timestep, sec, >0 integer, intent(out) :: status ! 0 == OK @@ -800,7 +787,7 @@ subroutine update_npool(tg, ratm, theta, thetasat, precip, evap, qbot, watertend water_soil = water_into_layer * waterfunction(age_prev + 0.5*poolranges(indpl), water_relax_t) call eval_fluxes_soil(tanpools(indpl), water_soil, Hconc(indpl), tg, & & ratm, theta, thetasat, percolation, runoff, bsw, nh4_ads_coef, & - & dz_layer, fluxes(1:num_fluxes,indpl), subst_tan, num_fluxes, status) + & dz_layer, fluxes(1:num_fluxes,indpl), subst_tan, status) if (status /= 0) then return end if @@ -852,7 +839,6 @@ end subroutine update_npool subroutine update_pools(tanpools, fluxes, dt, np, nf, fixed) ! Update tan pools using the fluxes and an ad-hoc scheme against negative TAN masses. - implicit none integer, intent(in) :: np, nf real(r8), intent(inout) :: tanpools(np), fluxes(nf,np) real(r8), intent(in) :: dt @@ -887,7 +873,6 @@ end subroutine update_pools function get_evap_pool(tg, ratm, qbot) result(evap) ! Evaluate evaporation rate for surface water given spcific humidity at the reference ! height. - implicit none real(r8), intent(in) :: tg, ratm, qbot real(r8) :: evap ! m/s @@ -910,7 +895,6 @@ end function get_evap_pool ! between 0 and 1. Either exponential or linear. function waterfunction_exp(pool_age, water_relax_t) result(water) - implicit none real(r8), intent(in) :: pool_age, water_relax_t ! sec real(r8) :: water @@ -918,7 +902,6 @@ function waterfunction_exp(pool_age, water_relax_t) result(water) end function waterfunction_exp function waterfunction(pool_age, water_relax_t) result(water) - implicit none real(r8), intent(in) :: pool_age, water_relax_t ! sec real(r8) :: water @@ -933,7 +916,6 @@ end function waterfunction function eval_perc(waterloss, evap, precip, watertend, dt) result(rate) ! Evaluate the downwards water flux at the layer bottom given the infiltration and ! evaporation fluxes. - implicit none real(r8), intent(in) :: waterloss ! total water loss during dt, m real(r8), intent(in) :: evap ! average evaporation rate, m/s real(r8), intent(in) :: precip ! average infiltration rate, m/s @@ -952,15 +934,13 @@ end function eval_perc !************************************************************************************ subroutine eval_fluxes_storage(nitr_input, barntype, tempr_outside, windspeed, fract_direct, & - volat_coef_barns, volat_coef_stores, & - tan_fract_excr, fluxes_nitr, fluxes_tan, fluxes_size, status) + volat_coef_barns, volat_coef_stores, tan_fract_excr, fluxes_nitr, fluxes_tan, status) ! ! Evaluate nitrogen fluxes in animal housings and storage. Only volatilization losses ! are assumed. The volatilization fluxes are assumed to depend linearly on the TAN ! fluxes entering the housings or storage. The base coefficients are given as ! arguments and adjusted according the model of Gyldenkaerne et al. ! - implicit none real(r8), intent(in) :: nitr_input ! total nitrogen excreted by animals in housings character(len=*), intent(in) :: barntype ! "closed" (pigs, poultry) or "open" (others) real(r8), intent(in) :: tempr_outside ! K @@ -968,8 +948,7 @@ subroutine eval_fluxes_storage(nitr_input, barntype, tempr_outside, windspeed, f real(r8), intent(in) :: fract_direct ! fraction of manure N applied before storage real(r8), intent(in) :: volat_coef_barns, volat_coef_stores ! normalization coefficients, unitless real(r8), intent(in) :: tan_fract_excr ! fraction of NH4 nitrogen in excreted N - integer, intent(in) :: fluxes_size - real(r8), intent(out), dimension(fluxes_size) :: fluxes_nitr, fluxes_tan ! nitrogen and TAN fluxes, gN/s + real(r8), intent(out), dimension(:) :: fluxes_nitr, fluxes_tan ! nitrogen and TAN fluxes, gN/s ! (/m2). See top of module for ! indices. integer, intent(out) :: status ! see top of the module. @@ -1000,7 +979,7 @@ subroutine eval_fluxes_storage(nitr_input, barntype, tempr_outside, windspeed, f real(r8) :: tempr_stores, tempr_barns real(r8) :: vent_barns - if (fluxes_size < 4) then + if (ubound(fluxes_tan, 1) < 4 .or. ubound(fluxes_nitr, 1) < 4) then status = err_bad_arg return end if @@ -1119,21 +1098,19 @@ end subroutine eval_fluxes_storage !************************************************************************************ - subroutine update_org_n(flux_input, tg, soilpsi, pools, dt, dz_layer, tanprod, soilflux, size_pools, status) + subroutine update_org_n(flux_input, tg, soilpsi, pools, dt, dz_layer, tanprod, soilflux, status) ! ! Evaluate the decomposition/mineralization N fluxes from the available, resistant and ! unavailable N fractions, and update the organic N pools. In addition, evaluate the ! flux of organic N into the soil pools according to a fixed time constant set below. - implicit none - integer, intent(in) :: size_pools - real(r8), intent(in) :: flux_input(size_pools) ! organic N entering the pools. gN/m2/s. For + real(r8), intent(in) :: flux_input(:) ! organic N entering the pools. gN/m2/s. For ! indices see at top of the module. real(r8), intent(in) :: tg ! ground temperature, K real(r8), intent(in) :: soilpsi ! soil water potential (MPa) - real(r8), intent(inout) :: pools(size_pools) ! organic N pools + real(r8), intent(inout) :: pools(:) ! organic N pools real(r8), intent(in) :: dt ! timestep, sec real(r8), intent(in) :: dz_layer ! layer thickness, m - real(r8), intent(out) :: tanprod(size_pools) ! Flux of TAN formed, both pools + real(r8), intent(out) :: tanprod(:) ! Flux of TAN formed, both pools real(r8), intent(out) :: soilflux ! Flux of organic nitrogen to soil integer, intent(out) :: status @@ -1144,7 +1121,7 @@ subroutine update_org_n(flux_input, tg, soilpsi, pools, dt, dz_layer, tanprod, s real(r8), parameter :: minpsi = -2.5_r8, maxpsi=-0.002_r8 ! MPa real(r8) :: soilfluxes(3) ! N flux to soil pools from each organic N fraction, gN/m2/sec - if (size_pools < 3) then + if (ubound(pools, 1) < 3) then status = err_bad_arg return end if @@ -1172,12 +1149,11 @@ subroutine update_org_n(flux_input, tg, soilpsi, pools, dt, dz_layer, tanprod, s end subroutine update_org_n subroutine update_urea(tg, theta, thetasat, precip, evap, watertend, runoff, & - ndep, bsw, pools, fluxes, residual, ranges, dt, dz_layer, numpools, fluxes_size, status) + ndep, bsw, pools, fluxes, residual, ranges, dt, dz_layer, status) ! ! Evaluate fluxes and update the urea pools. The procedure is similar to updating the ! soil TAN pools, but NO3 and volatilization fluxes do not occur. ! - implicit none real(r8), intent(in) :: tg ! soil temperature, K real(r8), intent(in) :: theta ! volumetric soil water in soil column (background) real(r8), intent(in) :: thetasat ! vol. soil water at saturation @@ -1187,11 +1163,9 @@ subroutine update_urea(tg, theta, thetasat, precip, evap, watertend, runoff, & real(r8), intent(in) :: runoff ! surface runoff flux, m/s real(r8), intent(in) :: ndep ! nitrogen input, mass unit / s real(r8), intent(in) :: bsw ! b in the soil water retention curve - integer, intent(in) :: numpools - integer, intent(in) :: fluxes_size - real(r8), intent(inout) :: pools(numpools) ! nitrogen pools mass / m2 - real(r8), intent(out) :: fluxes(fluxes_size, numpools) ! needs one extra for the to_tan flux - real(r8), intent(in) :: ranges(numpools) ! pool age extents, s + real(r8), intent(inout) :: pools(:) ! nitrogen pools mass / m2 + real(r8), intent(out) :: fluxes(:,:) ! (ind_flux, ind_pool), includes production of TAN + real(r8), intent(in) :: ranges(:) ! pool age extents, s real(r8), intent(out) :: residual ! nitrogen in patches aged beyond the oldest pool. mass / m2 real(r8), intent(in) :: dt ! time step, s real(r8), intent(in) :: dz_layer ! layer thickness, m @@ -1203,13 +1177,16 @@ subroutine update_urea(tg, theta, thetasat, precip, evap, watertend, runoff, & ratm_missing=missing, kads_nh4_missing=missing real(r8) :: age_prev, percolation, old_total, balance - integer :: indpl + integer :: indpl, numpools - if (fluxes_size < 6) then + numpools = size(ranges) + if (ubound(fluxes, 1) < num_fluxes & + .or. ubound(fluxes, 2) /= numpools & + .or. ubound(pools, 1) /= numpools) then status = err_bad_arg return end if - + old_total = sum(pools) call age_pools_soil(ndep, dt, ranges, pools, residual) @@ -1220,7 +1197,7 @@ subroutine update_urea(tg, theta, thetasat, precip, evap, watertend, runoff, & ! Hconc and Ratm are missing since they do not affect urea. call eval_fluxes_soil(pools(indpl), water_manure, Hconc_missing, tg, & ratm_missing, theta, thetasat, percolation, runoff, bsw, kads_nh4_missing, & - dz_layer, fluxes(1:5, indpl), subst_urea, 5, status) + dz_layer, fluxes(1:5, indpl), subst_urea, status) if (status /= 0) then return end if @@ -1229,7 +1206,7 @@ subroutine update_urea(tg, theta, thetasat, precip, evap, watertend, runoff, & end do ! Here goes also flux_tan (the production of TAN from urea decomposition) - call update_pools(pools, fluxes(1:num_fluxes, 1:numpools), dt, numpools, num_fluxes) + call update_pools(pools, fluxes, dt, numpools, size(fluxes, 1)) balance = sum(pools) - old_total @@ -1265,7 +1242,7 @@ subroutine get_storage_fluxes_tan_ar(manure_excr, tempr_outside, windspeed, frac call eval_fluxes_storage(manure_excr(ii), 'open', tempr_outside(ii), windspeed(ii), & & fract_direct(ii), & & volat_coef_barns, volat_coef_stores, tan_fract_excr, & - & fluxes_nitr, fluxes_tan, 4, status) + & fluxes_nitr, fluxes_tan, status) if (status /= 0) then return From 8b51ed484c3ea95b2cec35758808b8023536521b Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Sat, 18 Jan 2020 10:50:04 -0700 Subject: [PATCH 124/181] fix argument intent --- src/biogeochem/CNNDynamicsMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/biogeochem/CNNDynamicsMod.F90 b/src/biogeochem/CNNDynamicsMod.F90 index 68ba9f3f3c..b44d2ee187 100644 --- a/src/biogeochem/CNNDynamicsMod.F90 +++ b/src/biogeochem/CNNDynamicsMod.F90 @@ -328,7 +328,7 @@ subroutine CNNFert(bounds, num_soilc, filter_soilc, & integer , intent(in) :: filter_soilc(:) ! filter for soil columns integer , intent(in) :: num_pcropp ! number of prognostic crop pathches integer , intent(in) :: filter_pcropp(:)! filter for prognostic crop patches - type(cnveg_nitrogenflux_type) , intent(in) :: cnveg_nitrogenflux_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst type(soilbiogeochem_nitrogenflux_type) , intent(inout) :: soilbiogeochem_nitrogenflux_inst ! ! !LOCAL VARIABLES: From facec5cadc5072d1f852979e87c1cb6eb318a98c Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 29 Jan 2020 09:10:50 -0700 Subject: [PATCH 125/181] Use -abstol instead of +abstol to check for negativity --- src/biogeochem/FanMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/biogeochem/FanMod.F90 b/src/biogeochem/FanMod.F90 index 0f14bfb7bf..1fa59f5f9a 100755 --- a/src/biogeochem/FanMod.F90 +++ b/src/biogeochem/FanMod.F90 @@ -1036,7 +1036,7 @@ subroutine eval_fluxes_storage(nitr_input, barntype, tempr_outside, windspeed, f flux_avail = flux_avail - flux_barn flux_avail_tan = flux_avail_tan - flux_barn - if (flux_avail < abstol .or. flux_avail_tan < abstol) then + if (flux_avail < -abstol .or. flux_avail_tan < -abstol) then status = err_negative_flux*10000 return end if From f21e04d48ac74c0df55a59b890419f9edd48dd19 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Wed, 29 Jan 2020 09:11:04 -0700 Subject: [PATCH 126/181] Fix array bounds, etc --- src/biogeochem/Fan2CTSMMod.F90 | 76 +++++++++++++++++++--------------- 1 file changed, 43 insertions(+), 33 deletions(-) diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index ccdc19105c..541710cc79 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -314,14 +314,14 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & if (.not. col%active(c) .or. col%wtgcell(c) < 1e-6) cycle g = col%gridcell(c) if (lun%itype(l) == istsoil) then - nf%man_n_grz_col(c) & + nf%manure_n_grz_col(c) & = atm2lnd_inst%forc_ndep_grz_grc(g) / col%wtgcell(c) * 1e3 ! kg to g - if (nf%man_n_appl_col(c) > 0) then - write(iulog, *) 'man_n_appl_col:', nf%man_n_appl_col(c) + if (nf%manure_n_appl_col(c) > 0) then + write(iulog, *) 'manure_n_appl_col:', nf%manure_n_appl_col(c) call endrun(msg='Found fertilizer in soil column') end if else - nf%man_n_grz_col(c) = 0.0 + nf%manure_n_grz_col(c) = 0.0 end if end do @@ -413,19 +413,19 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & ! grazing ! - ngrz = nf%man_n_grz_col(c) + ngrz = nf%manure_n_grz_col(c) ndep_org(ind_avail) = ngrz * (1.0_r8-fract_tan) * fract_avail ndep_org(ind_resist) = ngrz * (1.0_r8-fract_tan) * fract_resist ndep_org(ind_unavail) = ngrz * (1.0_r8-fract_tan) * fract_unavail - orgpools(ind_avail) = ns%man_a_grz_col(c) - orgpools(ind_resist) = ns%man_r_grz_col(c) - orgpools(ind_unavail) = ns%man_u_grz_col(c) + orgpools(ind_avail) = ns%manure_a_grz_col(c) + orgpools(ind_resist) = ns%manure_r_grz_col(c) + orgpools(ind_unavail) = ns%manure_u_grz_col(c) call update_org_n(ndep_org, tg, soilpsi, orgpools, dt, dz_layer_grz, & tanprod, soilflux_org, status) - ns%man_a_grz_col(c) = orgpools(ind_avail) - ns%man_r_grz_col(c) = orgpools(ind_resist) - ns%man_u_grz_col(c) = orgpools(ind_unavail) + ns%manure_a_grz_col(c) = orgpools(ind_avail) + ns%manure_r_grz_col(c) = orgpools(ind_resist) + ns%manure_u_grz_col(c) = orgpools(ind_unavail) tanpools(1) = ns%tan_g1_col(c) tanpools(2) = ns%tan_g2_col(c) @@ -485,14 +485,14 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & ndep_org(ind_resist) = org_n_tot * fract_resist ndep_org(ind_unavail) = org_n_tot * fract_unavail - orgpools(ind_avail) = ns%man_a_app_col(c) - orgpools(ind_resist) = ns%man_r_app_col(c) - orgpools(ind_unavail) = ns%man_u_app_col(c) + orgpools(ind_avail) = ns%manure_a_app_col(c) + orgpools(ind_resist) = ns%manure_r_app_col(c) + orgpools(ind_unavail) = ns%manure_u_app_col(c) call update_org_n(ndep_org, tg, soilpsi, orgpools, dt, dz_layer_slr, & tanprod, soilflux_org, status) - ns%man_a_app_col(c) = orgpools(ind_avail) - ns%man_r_app_col(c) = orgpools(ind_resist) - ns%man_u_app_col(c) = orgpools(ind_unavail) + ns%manure_a_app_col(c) = orgpools(ind_avail) + ns%manure_r_app_col(c) = orgpools(ind_resist) + ns%manure_u_app_col(c) = orgpools(ind_unavail) tanpools(1) = ns%tan_s0_col(c) tanpools(2) = ns%tan_s1_col(c) @@ -508,14 +508,14 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & do ind_substep = 1, num_substeps call update_4pool(tg, ratm, theta, thetasat, infiltr_m_s, evap_m_s, & wateratm2lndbulk_inst%forc_q_downscaled_col(c), watertend, & - runoff_m_s, nf%man_tan_appl_col(c), sum(tanprod), bsw, depth_slurry, & + runoff_m_s, nf%manure_tan_appl_col(c), sum(tanprod), bsw, depth_slurry, & poolranges_slr, tanpools(1:num_cls_slr), Hconc_slr, & fluxes(1:num_fluxes, 1:num_cls_slr), & n_residual, dt / num_substeps, dz_layer_slr, status) if (status /= 0) then write(iulog, *) 'status and tanpools: ', status, tanpools(1:num_cls_slr) write(iulog, *) 'tg, ratm, theta, thetasat:', tg, ratm, theta, thetasat - write(iulog, *) 'tanfluxes:', nf%man_tan_appl_col(c), tanprod, fluxes(1:num_fluxes,1:num_cls_slr) + write(iulog, *) 'tanfluxes:', nf%manure_tan_appl_col(c), tanprod, fluxes(1:num_fluxes,1:num_cls_slr) call endrun(msg='update_4pool status /= 0') end if fluxes_tmp = fluxes_tmp + sum(fluxes(:,1:num_cls_slr), dim=2) @@ -624,7 +624,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & nf%nh3_fert_col(c) = fluxes_tmp(iflx_air) nf%fert_nh4_runoff_col(c) = fluxes_tmp(iflx_roff) - nf%fert_no3_prod_col(c) = fluxes_tmp(iflx_no3) + fert_no3 + nf%fert_no3_to_soil_col(c) = fluxes_tmp(iflx_no3) + fert_no3 nf%fert_nh4_to_soil_col(c) = fluxes_tmp(iflx_soild) + fluxes_tmp(iflx_soilq) & + n_residual_total/dt + fert_inc_tan @@ -752,23 +752,23 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & real(r8), intent(in) :: dt ! timestep, sec ! N excreted in manure, gN/m2: - real(r8), intent(in) :: ndep_sgrz_grc(:) ! seasonally grazing animals - real(r8), intent(in) :: ndep_ngrz_grc(:) ! non-grazing animals + real(r8), intent(in) :: ndep_sgrz_grc(bounds%begg:) ! seasonally grazing animals + real(r8), intent(in) :: ndep_ngrz_grc(bounds%begg:) ! non-grazing animals ! N, TAN spread on grasslands, gN/m2/s: - real(r8), intent(inout) :: n_manure_spread_col(:) - real(r8), intent(inout) :: tan_manure_spread_col(:) ! output, calculated from the above and stored manure + real(r8), intent(inout) :: n_manure_spread_col(bounds%begc:) + real(r8), intent(inout) :: tan_manure_spread_col(bounds%begc:) ! output, calculated from the above and stored manure ! N excreted by animals allocated to mixed production systems temporarily grazing on grasslands: - real(r8), intent(inout) :: n_manure_graze_col(:) + real(r8), intent(inout) :: n_manure_graze_col(bounds%begc:) ! N excreted by animals in mixed systems, total - real(r8), intent(inout) :: n_manure_mixed_col(:) + real(r8), intent(inout) :: n_manure_mixed_col(bounds%begc:) ! NH3 emission fluxes from manure storage and housings, gN/m2/s - real(r8), intent(inout) :: nh3_flux_stores(:), nh3_flux_barns(bounds%begc:bounds%endc) + real(r8), intent(inout) :: nh3_flux_stores(bounds%begc:), nh3_flux_barns(bounds%begc:) ! total nitrogen flux transferred out of a crop column (manure spreading + temporary grazing) - real(r8), intent(inout) :: man_n_transf(:) + real(r8), intent(inout) :: man_n_transf(bounds%begc:) ! Total nitrogen excreted in barns - real(r8), intent(inout) :: man_n_barns(:) + real(r8), intent(inout) :: man_n_barns(bounds%begc:) ! fraction of manure excreted when grazing - real(r8), intent(inout) :: grz_fract(:) + real(r8), intent(inout) :: grz_fract(bounds%begc:) ! TAN fraction in excreted N real(r8), intent(in) :: tan_fract_excr integer, intent(in) :: num_soilc ! number of soil columns in filter @@ -803,9 +803,11 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & ! Auxiliary and index variables: logical :: is_grass - integer :: begg, endg, g, l, c, il, counter, col_grass, status, p + integer :: begg, endg, g, l, c, il, counter, col_grass, status, p, fc real(r8) :: cumflux, totalinput + begg = bounds%begg; endg = bounds%endg + associate(& t_ref2m => temperature_inst%t_ref2m_patch, & ! 2m temperature, K u10 => frictionvel_inst%u10_patch, & ! 10m wind speed, m/s @@ -814,6 +816,13 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & totalinput = 0.0 cumflux = 0.0 + do fc = 1, num_soilc + ! Zero the manure N spread arrays because the nat veg columns receive N additively (see below) + c = filter_soilc(fc) + tan_manure_spread_col(c) = 0.0_r8 + n_manure_spread_col(c) = 0.0_r8 + end do + do g = begg, endg ! First find out if there are grasslands in this cell. If yes, a fraction of ! manure can be diverted to them before storage. @@ -871,6 +880,7 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & counter = 0 if (col_grass == c) call endrun('Something wrong with the indices') if (col%patchi(c) /= col%patchf(c)) then + print *, 'wtf', c, col%patchi(c), col%patchf(c), l, g call endrun(msg="ERROR crop column has multiple patches") end if @@ -882,7 +892,7 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & nh3_flux_stores(c) = 0.0 if (flux_avail_rum < 0) then - write(iulog, *) 'flux:', flux_avail_rum + write(iulog, *) 'flux:', flux_avail_rum, ndep_sgrz_grc(g), (1.0_r8 - max_grazing_fract) * kg_to_g * invscale call endrun(msg='negat flux_avail for ruminants') end if @@ -941,7 +951,7 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & if (tan_manure_spread_col(col_grass) > 1) then ! In principle this could happen if col%wtgcell(col_grass) is very small. write(iulog, *) 'Warning (FAN): suspicious manure N spread flux to natural vegetation column; flux, icol:', & - flux_grass_spread_tan, col_grass + flux_grass_spread_tan, col_grass, tan_manure_spread_col(col_grass) end if else if (flux_grass_spread > 0) then ! There was no column that had a grass pft: From e0e2fc5f8c8efbc10119d0424c568575c5c52920 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Sun, 9 Feb 2020 05:26:20 -0700 Subject: [PATCH 127/181] Change the code to remove dependency of column/patch ordering --- src/biogeochem/Fan2CTSMMod.F90 | 41 ++++++++++++++-------------------- 1 file changed, 17 insertions(+), 24 deletions(-) diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index 541710cc79..e10b101a73 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -380,18 +380,16 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & if (patchcounter > 0) then ratm = ratm / patchcounter else - ! grass not found, take something. - ! TODO change to average over everything + ! grass not found, take average over everything do p = col%patchi(c), col%patchf(c) if (.not. patch%active(p) .or. ram1(p) == spval .or. rb1(p) == spval) cycle - ratm = ram1(p) + rb1(p) - exit + ratm = ratm + ram1(p) + rb1(p) + patchcounter = patchcounter + 1 end do - if (p == col%patchf(c) + 1) then + if (patchcounter == 0) then call endrun(msg='Could not find any useful pft for ram1') - ! Nothing found. We shouldn't be here. - ratm = 150.0_r8 end if + ratm = ratm / patchcounter end if ns%fan_grz_fract_col(c) = 1.0_r8 ! for crops handled by handle_storage end if @@ -824,25 +822,21 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & end do do g = begg, endg - ! First find out if there are grasslands in this cell. If yes, a fraction of - ! manure can be diverted to them before storage. + ! First find out if there are grasslands in this cell. If yes, a fraction of manure + ! can be diverted to them before storage. At this time, we assume that the + ! grasslands are always found in the natural vegetation column. col_grass = ispval - do il = 1, max_lunit - l = grc%landunit_indices(il, g) - if (l == ispval) cycle - if (lun%itype(l) == istsoil) then - do p = lun%patchi(l), lun%patchf(l) - is_grass = patch%itype(p) == nc4_grass & - .or. patch%itype(p) == nc3_nonarctic_grass & - .or. patch%itype(p) == nc3_arctic_grass - if (is_grass .and. col%wtgcell(patch%column(p)) > 1e-6) then - col_grass = patch%column(p) - exit - end if - end do + l = grc%landunit_indices(istsoil, g) + do c = lun%coli(l), lun%colf(l) + if (col%itype(c) == istsoil) then + col_grass = c + exit end if - if (col_grass /= ispval) exit end do + if (col_grass == ispval) then + call endrun(msg='Failed to find net veg column') + end if + ! Transfer of manure from all crop columns to the natural vegetation column: flux_grass_graze = 0.0_r8 flux_grass_spread = 0.0_r8 @@ -880,7 +874,6 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & counter = 0 if (col_grass == c) call endrun('Something wrong with the indices') if (col%patchi(c) /= col%patchf(c)) then - print *, 'wtf', c, col%patchi(c), col%patchf(c), l, g call endrun(msg="ERROR crop column has multiple patches") end if From 12a9857aef0feb6f48ddbc973c8f8b61ecdd9b07 Mon Sep 17 00:00:00 2001 From: Julius Vira Date: Sun, 9 Feb 2020 05:56:14 -0700 Subject: [PATCH 128/181] remove unnecessary if block --- src/biogeochem/Fan2CTSMMod.F90 | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index e10b101a73..fb05c761cd 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -287,13 +287,12 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & dt = real(get_step_size(), r8) do_balance_checks = balance_check_freq > 0 .and. mod(get_nstep(), balance_check_freq) == 0 - ! TODO rename forc_ndep_nitr_grz to fract_no3_grc associate(& ns => soilbiogeochem_nitrogenstate_inst, & nf => soilbiogeochem_nitrogenflux_inst, & cnv_nf => cnveg_nitrogenflux_inst, & - fract_urea => atm2lnd_inst%forc_ndep_urea_grc, & ! Fraction of urea in fertilizer N - fract_no3 => atm2lnd_inst%forc_ndep_nitr_grc, & ! Fraction of NO3 in fertilizer N + forc_ndep_urea => atm2lnd_inst%forc_ndep_urea_grc, & ! Fraction of urea in fertilizer N + forc_ndep_no3 => atm2lnd_inst%forc_ndep_nitr_grc, & ! Fraction of NO3 in fertilizer N ram1 => frictionvel_inst%ram1_patch, & ! Aerodynamic resistance, s/m rb1 => frictionvel_inst%rb1_patch) ! Quasi-laminar layer resistance, s/m @@ -536,24 +535,24 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & ! Fertilizer ! split fertilizer N berween urea, no3 and the remaining other ammonium-N. fert_total = nf%fert_n_appl_col(c) - !fract_urea = atm2lnd_inst%forc_ndep_urea_grc(g) - !fract_no3 = atm2lnd_inst%forc_ndep_nitr_grc(g) + !forc_ndep_urea = atm2lnd_inst%forc_ndep_urea_grc(g) + !forc_ndep_no3 = atm2lnd_inst%forc_ndep_nitr_grc(g) ! A fraction of fertilizer N is made unavailable by mechanical incorporation, this ! will be added directly to the to-soil flux (tan) or no3 production (no3) below. - fert_inc_tan = fert_total * fert_incorp_reduct * (1.0 - fract_no3(g)) + fert_inc_tan = fert_total * fert_incorp_reduct * (1.0 - forc_ndep_no3(g)) - if (fract_urea(g) < 0 .or. fract_no3(g) < 0 .or. fract_urea(g) + fract_no3(g) > 1) then + if (forc_ndep_urea(g) < 0 .or. forc_ndep_no3(g) < 0 .or. forc_ndep_urea(g) + forc_ndep_no3(g) > 1) then call endrun('bad fertilizer fractions') end if - fert_urea = fert_total * fract_urea(g) * (1.0_r8 - fert_incorp_reduct) + fert_urea = fert_total * forc_ndep_urea(g) * (1.0_r8 - fert_incorp_reduct) ! Fertilizer nitrate goes straight to the no3_prod, incorporated or not. - fert_no3 = fert_total * fract_no3(g) - fert_generic = fert_total * (1.0_r8 - fract_urea(g) - fract_no3(g)) & + fert_no3 = fert_total * forc_ndep_no3(g) + fert_generic = fert_total * (1.0_r8 - forc_ndep_urea(g) - forc_ndep_no3(g)) & * (1.0_r8 - fert_incorp_reduct) ! Below also includes the incorporated N: - nf%otherfert_n_appl_col(c) = fert_total * (1.0_r8 - fract_urea(g)) + nf%otherfert_n_appl_col(c) = fert_total * (1.0_r8 - forc_ndep_urea(g)) ! Urea decomposition ! From 4b4033788430d2665f8faeb65ffd98c4ed558122 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sun, 21 Aug 2022 20:54:35 -0600 Subject: [PATCH 129/181] Variable name changed --- src/biogeochem/Fan2CTSMMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index fb05c761cd..bfb524ff7b 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -401,7 +401,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & bsw = soilstate_inst%bsw_col(c,1) theta = min(theta, 0.98_r8*thetasat) infiltr_m_s = max(waterfluxbulk_inst%qflx_infl_col(c), 0.0) * 1e-3 - evap_m_s = waterfluxbulk_inst%qflx_evap_grnd_col(c) * 1e-3 + evap_m_s = waterfluxbulk_inst%qflx_liqevap_from_top_layer_col(c) * 1e-3 runoff_m_s = max(waterfluxbulk_inst%qflx_surf_col(c), 0.0) * 1e-3 if (runoff_m_s > 1.0_r8) then runoff_m_s = 0.0_r8 From e66a3470c9a6c5261e68d692f7197c4d24284e45 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 22 Aug 2022 10:54:34 -0600 Subject: [PATCH 130/181] Change fan tests to f19_f19_mg17 since f19_f19_mg16 was having trouble with finding finidat files and mg17 doesn't --- cime_config/testdefs/testlist_clm.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 81179cfc5e..6a19fce4a8 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -356,7 +356,7 @@ - + @@ -366,7 +366,7 @@ - + From b529fb7aa954a19e666b9d6368fb407e019ca129 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 26 Aug 2022 00:43:22 -0600 Subject: [PATCH 131/181] Make these cold starts so they will run, as otherwise it has a conflict of use_init_interp not being set to true though needed to with the finidat picked --- cime_config/testdefs/testmods_dirs/clm/2009Start/shell_commands | 1 + 1 file changed, 1 insertion(+) diff --git a/cime_config/testdefs/testmods_dirs/clm/2009Start/shell_commands b/cime_config/testdefs/testmods_dirs/clm/2009Start/shell_commands index 295e6f9a5c..8593bd7d72 100755 --- a/cime_config/testdefs/testmods_dirs/clm/2009Start/shell_commands +++ b/cime_config/testdefs/testmods_dirs/clm/2009Start/shell_commands @@ -1 +1,2 @@ ./xmlchange RUN_STARTDATE=2009-01-01,DATM_CLMNCEP_YR_START=1991,DATM_CLMNCEP_YR_END=2012 +./xmlchange CLM_FORCE_COLDSTART=on From 32acf320fbfc63ad10aff8d6c73c45896e4fb7ab Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 26 Aug 2022 09:39:48 -0600 Subject: [PATCH 132/181] Put the cime hash that goes with this --- Externals.cfg | 1 + 1 file changed, 1 insertion(+) diff --git a/Externals.cfg b/Externals.cfg index ed3172fedc..a89f38a634 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -31,6 +31,7 @@ local_path = cime protocol = git repo_url = https://github.com/ekluzek/cime branch = fancpl2-up-merge +#hash = 60ba18ca8996d190cc5927437024338c59fab0ab externals = ../Externals_cime.cfg required = True From f6389834a6da648c34793abd4a043b23601b9d16 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 30 Aug 2022 14:31:22 -0600 Subject: [PATCH 133/181] Add smallville single point tests for FAN --- cime_config/testdefs/testlist_clm.xml | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 6a19fce4a8..4fc91b2720 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -376,6 +376,26 @@ + + + + + + + + + + + + + + + + + + + + From d5b1e4cd28ece95b793f41000bf4298caa70a4dc Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 30 Aug 2022 14:33:42 -0600 Subject: [PATCH 134/181] Add a hack to allow three problematic points in the f19 grid to be set to zero for FAN so that other points will run, and we can finish the updating --- src/biogeochem/Fan2CTSMMod.F90 | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index bfb524ff7b..18294ddb15 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -460,6 +460,23 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & fluxes_tmp = fluxes_tmp + sum(fluxes(:,1:num_cls_grz), dim=2) n_residual_total = n_residual_total + n_residual end do + !---------------------------------------------------------------------- + ! NOTE: Hack to set some failing points to zero + ! Thare are three points that are failing (in the f19 grid) and give fluxes of NaN's, set + ! these points to zero, so that the model will work for other points. + ! Once, we get the model updated to a current verion we will examine + ! these points in detail, and figure out why they aren't working and fix + ! FAN so they do work. + ! This will need to be changed when g no longer has a global index. + ! EBK: 08/30/2022 + !---------------------------------------------------------------------- + ! + if ( (g == 4043) .or. (g == 4047) .or. (g == 3687) )then + if (any(isnan(fluxes_tmp))) then + fluxes_tmp = 0.0_r8 + end if + end if + !---------------------------------------------------------------------- fluxes_tmp = fluxes_tmp / num_substeps ns%tan_g1_col(c) = tanpools(1) @@ -632,6 +649,10 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & if (nf%nh3_total_col(c) < -1e15) then call endrun(msg='ERROR: FAN, negative total emission') end if + if ( (g == 3687) .or. (g == 4043) .or. (g == 4047) )then + write(iulog, *) 'g=', g, ' c=', c, 'nh3_total_col=', nf%nh3_total_col(c), 'fert=', nf%nh3_fert_col(c), & + 'app=', nf%nh3_manure_app_col(c), 'grz=', nf%nh3_grz_col(c), 'stores=', nf%nh3_stores_col(c), 'barns=', nf%nh3_barns_col(c) + end if end do if (do_balance_checks) then From b436dbbdcb706807028f1ba9520b8fbf326a844d Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 30 Aug 2022 14:54:17 -0600 Subject: [PATCH 135/181] Add the check for the three bad points to more places --- src/biogeochem/Fan2CTSMMod.F90 | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index 18294ddb15..0e408d4f8c 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -535,6 +535,16 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & fluxes_tmp = fluxes_tmp + sum(fluxes(:,1:num_cls_slr), dim=2) n_residual_total = n_residual_total + n_residual end do + !---------------------------------------------------------------------- + ! NOTE: Hack to set some failing points to zero, see above... + ! EBK: 08/30/2022 + !---------------------------------------------------------------------- + if ( (g == 4043) .or. (g == 4047) .or. (g == 3687) )then + if (any(isnan(fluxes_tmp))) then + fluxes_tmp = 0.0_r8 + end if + end if + !---------------------------------------------------------------------- fluxes_tmp = fluxes_tmp / num_substeps ns%tan_s0_col(c) = tanpools(1) @@ -630,6 +640,16 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & n_residual_total = n_residual_total + n_residual nf%nh3_otherfert_col(c) = nf%nh3_otherfert_col(c) + fluxes(iflx_air, 1) / num_substeps end do + !---------------------------------------------------------------------- + ! NOTE: Hack to set some failing points to zero, see above... + ! EBK: 08/30/2022 + !---------------------------------------------------------------------- + if ( (g == 4043) .or. (g == 4047) .or. (g == 3687) )then + if (any(isnan(fluxes_tmp))) then + fluxes_tmp = 0.0_r8 + end if + end if + !---------------------------------------------------------------------- ns%tan_f1_col(c) = tanpools(1) ns%tan_f2_col(c) = tanpools(2) From 2b13f9eab6f8e0f98ca4a74eae8e31c73ad57b0f Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 30 Aug 2022 15:15:44 -0600 Subject: [PATCH 136/181] More setting of the three points in FAN to zero, so that they will run, now gets past initialization --- src/biogeochem/Fan2CTSMMod.F90 | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index 0e408d4f8c..23539b1dd8 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -392,6 +392,25 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & end if ns%fan_grz_fract_col(c) = 1.0_r8 ! for crops handled by handle_storage end if + !---------------------------------------------------------------------- + ! NOTE: Hack to set some failing points to zero, see below... + ! EBK: 08/30/2022 + !---------------------------------------------------------------------- + if ( (g == 4043) .or. (g == 4047) .or. (g == 3687) )then + if (isnan(nf%nh3_stores_col(c) ) ) then + nf%nh3_stores_col(c) = 0.0_r8 + end if + if (isnan(nf%nh3_barns_col(c) ) .or. (nf%nh3_barns_col(c) > 9.99e99_r8) ) then + nf%nh3_barns_col(c) = 0.0_r8 + end if + if (isnan(nf%manure_n_appl_col(c) ) ) then + nf%manure_n_appl_col(c) = 0.0_r8 + end if + if (isnan(nf%manure_n_mix_col(c) ) ) then + nf%manure_n_mix_col(c) = 0.0_r8 + end if + end if + !---------------------------------------------------------------------- watertend = waterstatebulk_inst%h2osoi_tend_tsl_col(c) * 1e-3 ! to m/s @@ -474,6 +493,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & if ( (g == 4043) .or. (g == 4047) .or. (g == 3687) )then if (any(isnan(fluxes_tmp))) then fluxes_tmp = 0.0_r8 + fluxes = 0.0_r8 end if end if !---------------------------------------------------------------------- @@ -542,6 +562,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & if ( (g == 4043) .or. (g == 4047) .or. (g == 3687) )then if (any(isnan(fluxes_tmp))) then fluxes_tmp = 0.0_r8 + fluxes = 0.0_r8 end if end if !---------------------------------------------------------------------- @@ -647,6 +668,7 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & if ( (g == 4043) .or. (g == 4047) .or. (g == 3687) )then if (any(isnan(fluxes_tmp))) then fluxes_tmp = 0.0_r8 + fluxes = 0.0_r8 end if end if !---------------------------------------------------------------------- From 51374ecf366284985b04c6611694f3a6d3d24ab3 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 30 Aug 2022 15:55:44 -0600 Subject: [PATCH 137/181] Also don't abort due to a Nbalance error when fan is on for the three points, and increase the error threshold to abort when FAN is on --- src/biogeochem/CNBalanceCheckMod.F90 | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/src/biogeochem/CNBalanceCheckMod.F90 b/src/biogeochem/CNBalanceCheckMod.F90 index 85e2aa03f1..5418667337 100644 --- a/src/biogeochem/CNBalanceCheckMod.F90 +++ b/src/biogeochem/CNBalanceCheckMod.F90 @@ -395,6 +395,7 @@ subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & ! ! !USES: use clm_varctl, only : use_crop + use clm_varctl, only : use_fan use subgridAveMod, only: c2g use atm2lndType, only: atm2lnd_type ! @@ -536,7 +537,9 @@ subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & if (err_found) then c = err_index + g = col%gridcell(c) write(iulog,*)'column nbalance error = ',col_errnb(c), c + write(iulog,*)'gridcell = ',g write(iulog,*)'Latdeg,Londeg = ',grc%latdeg(col%gridcell(c)),grc%londeg(col%gridcell(c)) write(iulog,*)'begnb = ',col_begnb(c) write(iulog,*)'endnb = ',col_endnb(c) @@ -548,8 +551,15 @@ subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & write(iulog,*)'outputs,ffix,nfix,ndep = ',smin_no3_leached(c)*dt, smin_no3_runoff(c)*dt,f_n2o_nit(c)*dt - - call endrun(msg=errMsg(sourcefile, __LINE__)) + ! Only actually abort if FAN is off or it's not one of the bad points + ! (at f19 resolution). If FAN is on allow Nbalance to be two orders of + ! magnitude higher than normal. + ! EBK 08/30/2022 + if ( (.not. use_fan) .or. ( (g /= 4043) .and. (g /= 4047) .and. (g /= 3687) ) )then + if ( (.not. use_fan) .or. (abs(col_errnb(c)) > 1e-1_r8) )then + call endrun(msg=errMsg(sourcefile, __LINE__)) + end if + end if end if ! Repeat error check at the gridcell level From 433481363ab644f5f83bd238a92bd6f5f96e32f5 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 30 Aug 2022 20:30:43 -0600 Subject: [PATCH 138/181] Add a cycle if landunit is tiny, protect another divide by tiny landunit weight, and abort for high values in FAN --- src/biogeochem/Fan2CTSMMod.F90 | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index 23539b1dd8..51c1d2c5fa 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -913,6 +913,7 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & if (crop_man_is4crop_area) then invscale = 1.0_r8 else + if ( lun%wtgcell(l) < 1.e-14_r8 ) cycle ! Ignore if landunit is very tiny invscale = 1.0_r8 / lun%wtgcell(l) end if @@ -950,6 +951,10 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & write(iulog, *) 'flux:', flux_avail_rum, ndep_sgrz_grc(g), (1.0_r8 - max_grazing_fract) * kg_to_g * invscale call endrun(msg='negat flux_avail for ruminants') end if + if (flux_avail_rum > 9.e99_r8 ) then + write(iulog, *) 'flux:', flux_avail_rum, ndep_sgrz_grc(g), (1.0_r8 - max_grazing_fract) * kg_to_g * invscale + call endrun(msg='Infinite flux_avail for ruminants') + end if ! Ruminants call eval_fluxes_storage(flux_avail_rum, 'open', & @@ -961,6 +966,10 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & call endrun(msg='eval_fluxes_storage failed for ruminants') end if + if (flux_avail_mg > 9.e99_r8 ) then + write(iulog, *) 'flux:', flux_avail_mg, ndep_sgrz_grc(g), (1.0_r8 - max_grazing_fract) * kg_to_g * invscale + call endrun(msg='Infinite flux_avail for livestock') + end if ! Others call eval_fluxes_storage(flux_avail_mg, 'closed', & t_ref2m(col%patchi(c)), u10(col%patchi(c)), & @@ -997,7 +1006,7 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & end do ! column end if ! land unit not ispval - if (col_grass /= ispval) then + if (col_grass /= ispval .and. (col%wtgcell(col_grass) > 1.e-14_r8) ) then n_manure_spread_col(col_grass) = n_manure_spread_col(col_grass) & + flux_grass_spread / col%wtgcell(col_grass) tan_manure_spread_col(col_grass) = tan_manure_spread_col(col_grass) & From c635d5a1f22a80ae4d4bdfc9d2a34b25bec5fbf8 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 30 Aug 2022 21:22:38 -0600 Subject: [PATCH 139/181] If sgrz or ngrz are infinity from the manure stream file set them to zero --- src/main/fanStreamMod.F90 | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/src/main/fanStreamMod.F90 b/src/main/fanStreamMod.F90 index cfa0ddb892..f962563b13 100644 --- a/src/main/fanStreamMod.F90 +++ b/src/main/fanStreamMod.F90 @@ -360,7 +360,11 @@ subroutine fanstream_interp(bounds, atm2lnd_inst) ig = 0 do g = bounds%begg,bounds%endg ig = ig+1 - atm2lnd_inst%forc_ndep_sgrz_grc(g) = sdat_sgrz%avs(1)%rAttr(1,ig) / (secspday * dayspyr) + if ( sdat_ngrz%avs(1)%rAttr(1,ig) < 9.e99_r8 )then + atm2lnd_inst%forc_ndep_sgrz_grc(g) = sdat_sgrz%avs(1)%rAttr(1,ig) / (secspday * dayspyr) + else + atm2lnd_inst%forc_ndep_sgrz_grc(g) = 0.0_r8 + end if end do call shr_strdata_advance(sdat_ngrz, mcdate, sec, mpicom, 'clmfanngrz') @@ -368,7 +372,11 @@ subroutine fanstream_interp(bounds, atm2lnd_inst) ig = 0 do g = bounds%begg,bounds%endg ig = ig+1 - atm2lnd_inst%forc_ndep_ngrz_grc(g) = sdat_ngrz%avs(1)%rAttr(1,ig) / (secspday * dayspyr) + if ( sdat_ngrz%avs(1)%rAttr(1,ig) < 9.e99_r8 )then + atm2lnd_inst%forc_ndep_ngrz_grc(g) = sdat_ngrz%avs(1)%rAttr(1,ig) / (secspday * dayspyr) + else + atm2lnd_inst%forc_ndep_ngrz_grc(g) = 0.0_r8 + end if end do call shr_strdata_advance(sdat_urea, mcdate, sec, mpicom, 'clmfanurea') From 22de9df54c4dbcc4020b439b68dedafaad436365 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 31 Aug 2022 10:06:39 -0600 Subject: [PATCH 140/181] Use shr_infnan_isinf rather than a comparison as the comparison fails --- src/main/fanStreamMod.F90 | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/main/fanStreamMod.F90 b/src/main/fanStreamMod.F90 index f962563b13..46939d7f22 100644 --- a/src/main/fanStreamMod.F90 +++ b/src/main/fanStreamMod.F90 @@ -328,6 +328,7 @@ subroutine fanstream_interp(bounds, atm2lnd_inst) use clm_time_manager, only : get_curr_date, get_days_per_year use clm_varcon , only : secspday use atm2lndType , only : atm2lnd_type + use shr_infnan_mod , only : isinf => shr_infnan_isinf ! ! Arguments type(bounds_type) , intent(in) :: bounds @@ -360,10 +361,10 @@ subroutine fanstream_interp(bounds, atm2lnd_inst) ig = 0 do g = bounds%begg,bounds%endg ig = ig+1 - if ( sdat_ngrz%avs(1)%rAttr(1,ig) < 9.e99_r8 )then - atm2lnd_inst%forc_ndep_sgrz_grc(g) = sdat_sgrz%avs(1)%rAttr(1,ig) / (secspday * dayspyr) - else + if ( isinf(sdat_ngrz%avs(1)%rAttr(1,ig)) )then atm2lnd_inst%forc_ndep_sgrz_grc(g) = 0.0_r8 + else + atm2lnd_inst%forc_ndep_sgrz_grc(g) = sdat_sgrz%avs(1)%rAttr(1,ig) / (secspday * dayspyr) end if end do @@ -372,10 +373,10 @@ subroutine fanstream_interp(bounds, atm2lnd_inst) ig = 0 do g = bounds%begg,bounds%endg ig = ig+1 - if ( sdat_ngrz%avs(1)%rAttr(1,ig) < 9.e99_r8 )then - atm2lnd_inst%forc_ndep_ngrz_grc(g) = sdat_ngrz%avs(1)%rAttr(1,ig) / (secspday * dayspyr) - else + if ( isinf(sdat_ngrz%avs(1)%rAttr(1,ig)) )then atm2lnd_inst%forc_ndep_ngrz_grc(g) = 0.0_r8 + else + atm2lnd_inst%forc_ndep_ngrz_grc(g) = sdat_ngrz%avs(1)%rAttr(1,ig) / (secspday * dayspyr) end if end do From 459952b5c8d1847cb4942e39d40e1bb13be67641 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 2 Sep 2022 11:31:24 -0600 Subject: [PATCH 141/181] Fix error in N balance check, turn off some of the changes for small values. This version seems to run without nbalance issues --- src/biogeochem/CNBalanceCheckMod.F90 | 17 +++--- src/biogeochem/Fan2CTSMMod.F90 | 85 +++++++++++++--------------- 2 files changed, 48 insertions(+), 54 deletions(-) diff --git a/src/biogeochem/CNBalanceCheckMod.F90 b/src/biogeochem/CNBalanceCheckMod.F90 index 5418667337..424608d964 100644 --- a/src/biogeochem/CNBalanceCheckMod.F90 +++ b/src/biogeochem/CNBalanceCheckMod.F90 @@ -487,6 +487,7 @@ subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & if (use_crop) then col_ninputs(c) = col_ninputs(c) + fert_to_sminn(c) + soyfixn_to_sminn(c) end if + col_ninputs(c) = col_ninputs(c) + fan_totnin(c) col_ninputs_partial(c) = col_ninputs(c) @@ -511,12 +512,11 @@ subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & end if col_noutputs(c) = col_noutputs(c) - som_n_leached(c) - col_ninputs_partial(c) = col_ninputs(c) + fan_totnin(c) + col_noutputs(c) = col_noutputs(c) + fan_totnout(c) col_noutputs_partial(c) = col_noutputs(c) - & wood_harvestn(c) - & - grainn_to_cropprodn(c) + & - fan_totnout(c) + grainn_to_cropprodn(c) ! calculate the total column-level nitrogen balance error for this time step col_errnb(c) = (col_ninputs(c) - col_noutputs(c))*dt - & @@ -551,15 +551,16 @@ subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & write(iulog,*)'outputs,ffix,nfix,ndep = ',smin_no3_leached(c)*dt, smin_no3_runoff(c)*dt,f_n2o_nit(c)*dt + call endrun(msg=errMsg(sourcefile, __LINE__)) ! Only actually abort if FAN is off or it's not one of the bad points ! (at f19 resolution). If FAN is on allow Nbalance to be two orders of ! magnitude higher than normal. ! EBK 08/30/2022 - if ( (.not. use_fan) .or. ( (g /= 4043) .and. (g /= 4047) .and. (g /= 3687) ) )then - if ( (.not. use_fan) .or. (abs(col_errnb(c)) > 1e-1_r8) )then - call endrun(msg=errMsg(sourcefile, __LINE__)) - end if - end if + !if ( (.not. use_fan) .or. ( (g /= 4043) .and. (g /= 4047) .and. (g /= 3687) ) )then + ! if ( (.not. use_fan) .or. (abs(col_errnb(c)) > 1e-1_r8) )then + ! call endrun(msg=errMsg(sourcefile, __LINE__)) + ! end if + !end if end if ! Repeat error check at the gridcell level diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index 51c1d2c5fa..3efb7ef7da 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -396,20 +396,20 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & ! NOTE: Hack to set some failing points to zero, see below... ! EBK: 08/30/2022 !---------------------------------------------------------------------- - if ( (g == 4043) .or. (g == 4047) .or. (g == 3687) )then - if (isnan(nf%nh3_stores_col(c) ) ) then - nf%nh3_stores_col(c) = 0.0_r8 - end if - if (isnan(nf%nh3_barns_col(c) ) .or. (nf%nh3_barns_col(c) > 9.99e99_r8) ) then - nf%nh3_barns_col(c) = 0.0_r8 - end if - if (isnan(nf%manure_n_appl_col(c) ) ) then - nf%manure_n_appl_col(c) = 0.0_r8 - end if - if (isnan(nf%manure_n_mix_col(c) ) ) then - nf%manure_n_mix_col(c) = 0.0_r8 - end if - end if + !if ( (g == 4043) .or. (g == 4047) .or. (g == 3687) )then + ! if (isnan(nf%nh3_stores_col(c) ) ) then + ! nf%nh3_stores_col(c) = 0.0_r8 + ! end if + ! if (isnan(nf%nh3_barns_col(c) ) .or. (nf%nh3_barns_col(c) > 9.99e99_r8) ) then + ! nf%nh3_barns_col(c) = 0.0_r8 + ! end if + ! if (isnan(nf%manure_n_appl_col(c) ) ) then + ! nf%manure_n_appl_col(c) = 0.0_r8 + ! end if + ! if (isnan(nf%manure_n_mix_col(c) ) ) then + ! nf%manure_n_mix_col(c) = 0.0_r8 + ! end if + !end if !---------------------------------------------------------------------- watertend = waterstatebulk_inst%h2osoi_tend_tsl_col(c) * 1e-3 ! to m/s @@ -490,12 +490,12 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & ! EBK: 08/30/2022 !---------------------------------------------------------------------- ! - if ( (g == 4043) .or. (g == 4047) .or. (g == 3687) )then - if (any(isnan(fluxes_tmp))) then - fluxes_tmp = 0.0_r8 - fluxes = 0.0_r8 - end if - end if + !if ( (g == 4043) .or. (g == 4047) .or. (g == 3687) )then + ! if (any(isnan(fluxes_tmp))) then + ! fluxes_tmp = 0.0_r8 + ! fluxes = 0.0_r8 + ! end if + !end if !---------------------------------------------------------------------- fluxes_tmp = fluxes_tmp / num_substeps @@ -559,12 +559,12 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & ! NOTE: Hack to set some failing points to zero, see above... ! EBK: 08/30/2022 !---------------------------------------------------------------------- - if ( (g == 4043) .or. (g == 4047) .or. (g == 3687) )then - if (any(isnan(fluxes_tmp))) then - fluxes_tmp = 0.0_r8 - fluxes = 0.0_r8 - end if - end if + !if ( (g == 4043) .or. (g == 4047) .or. (g == 3687) )then + ! if (any(isnan(fluxes_tmp))) then + ! fluxes_tmp = 0.0_r8 + ! fluxes = 0.0_r8 + ! end if + !end if !---------------------------------------------------------------------- fluxes_tmp = fluxes_tmp / num_substeps @@ -665,12 +665,12 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & ! NOTE: Hack to set some failing points to zero, see above... ! EBK: 08/30/2022 !---------------------------------------------------------------------- - if ( (g == 4043) .or. (g == 4047) .or. (g == 3687) )then - if (any(isnan(fluxes_tmp))) then - fluxes_tmp = 0.0_r8 - fluxes = 0.0_r8 - end if - end if + !if ( (g == 4043) .or. (g == 4047) .or. (g == 3687) )then + ! if (any(isnan(fluxes_tmp))) then + ! fluxes_tmp = 0.0_r8 + ! fluxes = 0.0_r8 + ! end if + !end if !---------------------------------------------------------------------- ns%tan_f1_col(c) = tanpools(1) @@ -691,10 +691,10 @@ subroutine fan_eval(bounds, num_soilc, filter_soilc, & if (nf%nh3_total_col(c) < -1e15) then call endrun(msg='ERROR: FAN, negative total emission') end if - if ( (g == 3687) .or. (g == 4043) .or. (g == 4047) )then - write(iulog, *) 'g=', g, ' c=', c, 'nh3_total_col=', nf%nh3_total_col(c), 'fert=', nf%nh3_fert_col(c), & - 'app=', nf%nh3_manure_app_col(c), 'grz=', nf%nh3_grz_col(c), 'stores=', nf%nh3_stores_col(c), 'barns=', nf%nh3_barns_col(c) - end if + !if ( (g == 3687) .or. (g == 4043) .or. (g == 4047) )then + ! write(iulog, *) 'g=', g, ' c=', c, 'nh3_total_col=', nf%nh3_total_col(c), 'fert=', nf%nh3_fert_col(c), & + ! 'app=', nf%nh3_manure_app_col(c), 'grz=', nf%nh3_grz_col(c), 'stores=', nf%nh3_stores_col(c), 'barns=', nf%nh3_barns_col(c) + !end if end do if (do_balance_checks) then @@ -913,7 +913,7 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & if (crop_man_is4crop_area) then invscale = 1.0_r8 else - if ( lun%wtgcell(l) < 1.e-14_r8 ) cycle ! Ignore if landunit is very tiny + !if ( lun%wtgcell(l) < 1.e-14_r8 ) cycle ! Ignore if landunit is very tiny invscale = 1.0_r8 / lun%wtgcell(l) end if @@ -951,10 +951,6 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & write(iulog, *) 'flux:', flux_avail_rum, ndep_sgrz_grc(g), (1.0_r8 - max_grazing_fract) * kg_to_g * invscale call endrun(msg='negat flux_avail for ruminants') end if - if (flux_avail_rum > 9.e99_r8 ) then - write(iulog, *) 'flux:', flux_avail_rum, ndep_sgrz_grc(g), (1.0_r8 - max_grazing_fract) * kg_to_g * invscale - call endrun(msg='Infinite flux_avail for ruminants') - end if ! Ruminants call eval_fluxes_storage(flux_avail_rum, 'open', & @@ -966,10 +962,6 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & call endrun(msg='eval_fluxes_storage failed for ruminants') end if - if (flux_avail_mg > 9.e99_r8 ) then - write(iulog, *) 'flux:', flux_avail_mg, ndep_sgrz_grc(g), (1.0_r8 - max_grazing_fract) * kg_to_g * invscale - call endrun(msg='Infinite flux_avail for livestock') - end if ! Others call eval_fluxes_storage(flux_avail_mg, 'closed', & t_ref2m(col%patchi(c)), u10(col%patchi(c)), & @@ -1006,7 +998,8 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & end do ! column end if ! land unit not ispval - if (col_grass /= ispval .and. (col%wtgcell(col_grass) > 1.e-14_r8) ) then + !if (col_grass /= ispval .and. (col%wtgcell(col_grass) > 1.e-14_r8) ) then + if (col_grass /= ispval )then n_manure_spread_col(col_grass) = n_manure_spread_col(col_grass) & + flux_grass_spread / col%wtgcell(col_grass) tan_manure_spread_col(col_grass) = tan_manure_spread_col(col_grass) & From 6ff603cfe5cf90213ccedb44812cb84f23ad4126 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 2 Sep 2022 11:43:54 -0600 Subject: [PATCH 142/181] Add fan input/output to the balance check error --- src/biogeochem/CNBalanceCheckMod.F90 | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/src/biogeochem/CNBalanceCheckMod.F90 b/src/biogeochem/CNBalanceCheckMod.F90 index 424608d964..0ec8f54b0b 100644 --- a/src/biogeochem/CNBalanceCheckMod.F90 +++ b/src/biogeochem/CNBalanceCheckMod.F90 @@ -538,19 +538,19 @@ subroutine NBalanceCheck(this, bounds, num_soilc, filter_soilc, & if (err_found) then c = err_index g = col%gridcell(c) - write(iulog,*)'column nbalance error = ',col_errnb(c), c - write(iulog,*)'gridcell = ',g - write(iulog,*)'Latdeg,Londeg = ',grc%latdeg(col%gridcell(c)),grc%londeg(col%gridcell(c)) - write(iulog,*)'begnb = ',col_begnb(c) - write(iulog,*)'endnb = ',col_endnb(c) - write(iulog,*)'delta store = ',col_endnb(c)-col_begnb(c) - write(iulog,*)'input mass = ',col_ninputs(c)*dt - write(iulog,*)'output mass = ',col_noutputs(c)*dt - write(iulog,*)'net flux = ',(col_ninputs(c)-col_noutputs(c))*dt - write(iulog,*)'inputs,ffix,nfix,ndep = ',ffix_to_sminn(c)*dt,nfix_to_sminn(c)*dt,ndep_to_sminn(c)*dt - write(iulog,*)'outputs,ffix,nfix,ndep = ',smin_no3_leached(c)*dt, smin_no3_runoff(c)*dt,f_n2o_nit(c)*dt - - + write(iulog,*)'column nbalance error = ',col_errnb(c), c + write(iulog,*)'gridcell = ',g + write(iulog,*)'Latdeg,Londeg = ',grc%latdeg(col%gridcell(c)),grc%londeg(col%gridcell(c)) + write(iulog,*)'begnb = ',col_begnb(c) + write(iulog,*)'endnb = ',col_endnb(c) + write(iulog,*)'delta store = ',col_endnb(c)-col_begnb(c) + write(iulog,*)'input mass = ',col_ninputs(c)*dt + write(iulog,*)'output mass = ',col_noutputs(c)*dt + write(iulog,*)'net flux = ',(col_ninputs(c)-col_noutputs(c))*dt + write(iulog,*)'inputs,ffix,nfix,ndep,fan = ',ffix_to_sminn(c)*dt,nfix_to_sminn(c)*dt, & + ndep_to_sminn(c)*dt, fan_totnin(c)*dt + write(iulog,*)'outputs,ffix,nfix,ndep,fan= ',smin_no3_leached(c)*dt, smin_no3_runoff(c)*dt, & + f_n2o_nit(c)*dt, fan_totnout(c)*dt call endrun(msg=errMsg(sourcefile, __LINE__)) ! Only actually abort if FAN is off or it's not one of the bad points ! (at f19 resolution). If FAN is on allow Nbalance to be two orders of From 74733356c82da6afd7b537ce0c76918f95215981 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 2 Sep 2022 12:58:40 -0600 Subject: [PATCH 143/181] Adjust FAN tests for what we expect to work --- cime_config/testdefs/testlist_clm.xml | 24 +++++++++++++++++------- 1 file changed, 17 insertions(+), 7 deletions(-) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 4fc91b2720..cd7f04183e 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -356,7 +356,15 @@ - + + + + + + + + + @@ -364,36 +372,38 @@ + - + - + + - + - + - + - + From 1001dceba1ebd074e771959c54dca026a1d37dc4 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 2 Sep 2022 12:59:12 -0600 Subject: [PATCH 144/181] Add a FAN test month for longer simulations that has monthly output --- .../clm/fanFull2009StartMonthly/include_user_mods | 3 +++ 1 file changed, 3 insertions(+) create mode 100644 cime_config/testdefs/testmods_dirs/clm/fanFull2009StartMonthly/include_user_mods diff --git a/cime_config/testdefs/testmods_dirs/clm/fanFull2009StartMonthly/include_user_mods b/cime_config/testdefs/testmods_dirs/clm/fanFull2009StartMonthly/include_user_mods new file mode 100644 index 0000000000..21dc533641 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/fanFull2009StartMonthly/include_user_mods @@ -0,0 +1,3 @@ +../fanFull +../2009Start +../monthly From ce03b35538eaee634167880b6cf16c5f7077fee9 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 2 Sep 2022 13:00:41 -0600 Subject: [PATCH 145/181] Set Inifinity from manure file to a large arbitrary value rather than zero --- src/main/fanStreamMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/main/fanStreamMod.F90 b/src/main/fanStreamMod.F90 index 46939d7f22..d1076b2cc8 100644 --- a/src/main/fanStreamMod.F90 +++ b/src/main/fanStreamMod.F90 @@ -362,7 +362,7 @@ subroutine fanstream_interp(bounds, atm2lnd_inst) do g = bounds%begg,bounds%endg ig = ig+1 if ( isinf(sdat_ngrz%avs(1)%rAttr(1,ig)) )then - atm2lnd_inst%forc_ndep_sgrz_grc(g) = 0.0_r8 + atm2lnd_inst%forc_ndep_sgrz_grc(g) = 9.0e99_r8 else atm2lnd_inst%forc_ndep_sgrz_grc(g) = sdat_sgrz%avs(1)%rAttr(1,ig) / (secspday * dayspyr) end if @@ -374,7 +374,7 @@ subroutine fanstream_interp(bounds, atm2lnd_inst) do g = bounds%begg,bounds%endg ig = ig+1 if ( isinf(sdat_ngrz%avs(1)%rAttr(1,ig)) )then - atm2lnd_inst%forc_ndep_ngrz_grc(g) = 0.0_r8 + atm2lnd_inst%forc_ndep_ngrz_grc(g) = 9.0e99_r8 else atm2lnd_inst%forc_ndep_ngrz_grc(g) = sdat_ngrz%avs(1)%rAttr(1,ig) / (secspday * dayspyr) end if From b7cb2f1f2781d1f457f63f90d89355fd829e0812 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 2 Sep 2022 13:48:12 -0600 Subject: [PATCH 146/181] Add back changes for handling small land fraction, they do seem to be working --- src/biogeochem/Fan2CTSMMod.F90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index 3efb7ef7da..1c1293d51f 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -913,7 +913,7 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & if (crop_man_is4crop_area) then invscale = 1.0_r8 else - !if ( lun%wtgcell(l) < 1.e-14_r8 ) cycle ! Ignore if landunit is very tiny + if ( lun%wtgcell(l) < 1.e-14_r8 ) cycle ! Ignore if landunit is very tiny invscale = 1.0_r8 / lun%wtgcell(l) end if @@ -998,8 +998,7 @@ subroutine handle_storage(bounds, temperature_inst, frictionvel_inst, dt, & end do ! column end if ! land unit not ispval - !if (col_grass /= ispval .and. (col%wtgcell(col_grass) > 1.e-14_r8) ) then - if (col_grass /= ispval )then + if (col_grass /= ispval .and. (col%wtgcell(col_grass) > 1.e-14_r8) ) then n_manure_spread_col(col_grass) = n_manure_spread_col(col_grass) & + flux_grass_spread / col%wtgcell(col_grass) tan_manure_spread_col(col_grass) = tan_manure_spread_col(col_grass) & From a3fd227d7485246a9789df14fe2dc25f16831173 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 2 Sep 2022 15:43:15 -0600 Subject: [PATCH 147/181] Add a finidat file that's explicit for FAN so that we aren't doing cold-starts, I added this after I ran the testing for ctsm1.0.dev097 --- cime_config/testdefs/testmods_dirs/clm/2009Start/user_nl_clm | 3 +++ 1 file changed, 3 insertions(+) create mode 100644 cime_config/testdefs/testmods_dirs/clm/2009Start/user_nl_clm diff --git a/cime_config/testdefs/testmods_dirs/clm/2009Start/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/2009Start/user_nl_clm new file mode 100644 index 0000000000..a91cc32e84 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/clm/2009Start/user_nl_clm @@ -0,0 +1,3 @@ +! Explicitly add a file to start from +use_init_interp = TRUE +finidat = '$DIN_LOC_ROOT/lnd/clm2/initdata_map/clmi.I2000Clm50BgcCrop.2011-01-01.1.9x2.5_gx1v7_gl4_simyr2000_c180715.nc' From 19879daf92affc6413c2f68e2e4c4e66d293fa92 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 2 Sep 2022 16:52:25 -0600 Subject: [PATCH 148/181] Remove the cold start setting so that the finidat file can be used --- cime_config/testdefs/testmods_dirs/clm/2009Start/shell_commands | 1 - 1 file changed, 1 deletion(-) diff --git a/cime_config/testdefs/testmods_dirs/clm/2009Start/shell_commands b/cime_config/testdefs/testmods_dirs/clm/2009Start/shell_commands index 8593bd7d72..295e6f9a5c 100755 --- a/cime_config/testdefs/testmods_dirs/clm/2009Start/shell_commands +++ b/cime_config/testdefs/testmods_dirs/clm/2009Start/shell_commands @@ -1,2 +1 @@ ./xmlchange RUN_STARTDATE=2009-01-01,DATM_CLMNCEP_YR_START=1991,DATM_CLMNCEP_YR_END=2012 -./xmlchange CLM_FORCE_COLDSTART=on From dce44b9e2ce3638ebc5f9cf836f9b7a8dbab7bb0 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 2 Sep 2022 18:09:03 -0600 Subject: [PATCH 149/181] Add threaded FAN test fail to expected fails --- cime_config/testdefs/ExpectedTestFails.xml | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/cime_config/testdefs/ExpectedTestFails.xml b/cime_config/testdefs/ExpectedTestFails.xml index 938b10be53..e164e3ed31 100644 --- a/cime_config/testdefs/ExpectedTestFails.xml +++ b/cime_config/testdefs/ExpectedTestFails.xml @@ -30,6 +30,13 @@ + + + FAIL + Threaded issues with FAN + + + FAIL From 285b5267ee12542b593b547dccde970016863d9b Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sun, 4 Sep 2022 18:27:30 -0600 Subject: [PATCH 150/181] Update FAN tests for existing compset and make it a CLM51 compset --- cime_config/testdefs/testlist_clm.xml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 4fda961488..991dbd9df5 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -513,7 +513,7 @@ - + @@ -521,7 +521,7 @@ - + @@ -532,7 +532,7 @@ - + @@ -543,7 +543,7 @@ - + @@ -553,7 +553,7 @@ - + From 80ed25b8629ae7050e7edd0d2244906b0d07dc87 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Mon, 5 Sep 2022 16:13:42 -0600 Subject: [PATCH 151/181] Fix xml error, and add Vmct to all FAN tests --- cime_config/testdefs/testlist_clm.xml | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 991dbd9df5..d3023fb953 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -513,15 +513,16 @@ - + + - + @@ -532,7 +533,7 @@ - + @@ -543,7 +544,7 @@ - + @@ -553,7 +554,7 @@ - + From 368a5fa5fc72fb9023c5018be1d90da16268a0df Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 6 Sep 2022 12:03:59 -0600 Subject: [PATCH 152/181] Document problems with the nuopc cases --- cime_config/testdefs/ExpectedTestFails.xml | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/cime_config/testdefs/ExpectedTestFails.xml b/cime_config/testdefs/ExpectedTestFails.xml index b1ab579143..fbd6baec63 100644 --- a/cime_config/testdefs/ExpectedTestFails.xml +++ b/cime_config/testdefs/ExpectedTestFails.xml @@ -30,7 +30,21 @@ - + + + FAIL + Build issue for nuopc_shr_methods, ctsm5.1.dev021 does work though + + + + + + FAIL + Build issue for nuopc_shr_methods, has problems in ctsm5.1.dev021 as well + + + + FAIL Threaded issues with FAN From c203f2ebb471da5fdc430c955c8feed2b5ed7fe6 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 7 Sep 2022 09:57:33 -0600 Subject: [PATCH 153/181] Add a couple tests to the expected fail, due to downloading data --- cime_config/testdefs/ExpectedTestFails.xml | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/cime_config/testdefs/ExpectedTestFails.xml b/cime_config/testdefs/ExpectedTestFails.xml index b50ba30b20..a85dc9e1fa 100644 --- a/cime_config/testdefs/ExpectedTestFails.xml +++ b/cime_config/testdefs/ExpectedTestFails.xml @@ -30,6 +30,20 @@ + + + FAIL + Trouble downloading data + + + + + + FAIL + Trouble downloading data + + + FAIL From 07a641fce1c073791884538e854666f1f23e50c4 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 7 Sep 2022 16:26:28 -0600 Subject: [PATCH 154/181] Move location of fanStreams to MCT version of streams --- src/{main => cpl/mct}/fanStreamMod.F90 | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename src/{main => cpl/mct}/fanStreamMod.F90 (100%) diff --git a/src/main/fanStreamMod.F90 b/src/cpl/mct/fanStreamMod.F90 similarity index 100% rename from src/main/fanStreamMod.F90 rename to src/cpl/mct/fanStreamMod.F90 From c9169e7883cb72497ba3ac5bd6b83bf294e311a2 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 7 Sep 2022 16:34:40 -0600 Subject: [PATCH 155/181] Make the same changes that went into ndepStreams in fanStreams --- src/cpl/mct/fanStreamMod.F90 | 29 ++++++++++++++--------------- 1 file changed, 14 insertions(+), 15 deletions(-) diff --git a/src/cpl/mct/fanStreamMod.F90 b/src/cpl/mct/fanStreamMod.F90 index d1076b2cc8..02669f56f3 100644 --- a/src/cpl/mct/fanStreamMod.F90 +++ b/src/cpl/mct/fanStreamMod.F90 @@ -19,15 +19,13 @@ module FanStreamMod use spmdMod , only: mpicom, masterproc, comp_id, iam use clm_varctl , only: iulog use abortutils , only: endrun - use fileutils , only: getavu, relavu - use decompMod , only: bounds_type, ldecomp, gsmap_lnd_gdc2glo + use decompMod , only: bounds_type use domainMod , only: ldomain use ndepStreamMod, only: clm_domain_mct ! !PUBLIC TYPES: implicit none private - save ! !PUBLIC MEMBER FUNCTIONS: public :: fanstream_init ! position datasets for dynamic ndep2 @@ -80,12 +78,13 @@ subroutine fanstream_init(bounds, NLFilename) ! Initialize data stream information. ! ! Uses: - use clm_varctl , only : inst_name - use clm_time_manager , only : get_calendar - use ncdio_pio , only : pio_subsystem - use shr_pio_mod , only : shr_pio_getiotype - use shr_nl_mod , only : shr_nl_find_group_name - use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varctl , only : inst_name + use clm_time_manager , only : get_calendar + use ncdio_pio , only : pio_subsystem + use shr_pio_mod , only : shr_pio_getiotype + use shr_nl_mod , only : shr_nl_find_group_name + use shr_log_mod , only : errMsg => shr_log_errMsg + use lnd_set_decomp_and_domain , only : gsmap_global ! ! arguments implicit none @@ -124,7 +123,7 @@ subroutine fanstream_init(bounds, NLFilename) pio_subsystem=pio_subsystem, & pio_iotype=shr_pio_getiotype(inst_name), & mpicom=mpicom, compid=comp_id, & - gsmap=gsmap_lnd_gdc2glo, ggrid=dom_clm, & + gsmap=gsmap_global, ggrid=dom_clm, & nxg=ldomain%ni, nyg=ldomain%nj, & yearFirst=stream_year_first_fan, & yearLast=stream_year_last_fan, & @@ -162,7 +161,7 @@ subroutine fanstream_init(bounds, NLFilename) pio_subsystem=pio_subsystem, & pio_iotype=shr_pio_getiotype(inst_name), & mpicom=mpicom, compid=comp_id, & - gsmap=gsmap_lnd_gdc2glo, ggrid=dom_clm, & + gsmap=gsmap_global, ggrid=dom_clm, & nxg=ldomain%ni, nyg=ldomain%nj, & yearFirst=stream_year_first_fan, & yearLast=stream_year_last_fan, & @@ -200,7 +199,7 @@ subroutine fanstream_init(bounds, NLFilename) pio_subsystem=pio_subsystem, & pio_iotype=shr_pio_getiotype(inst_name), & mpicom=mpicom, compid=comp_id, & - gsmap=gsmap_lnd_gdc2glo, ggrid=dom_clm, & + gsmap=gsmap_global, ggrid=dom_clm, & nxg=ldomain%ni, nyg=ldomain%nj, & yearFirst=stream_year_first_fan, & yearLast=stream_year_last_fan, & @@ -232,7 +231,7 @@ subroutine fanstream_init(bounds, NLFilename) pio_subsystem=pio_subsystem, & pio_iotype=shr_pio_getiotype(inst_name), & mpicom=mpicom, compid=comp_id, & - gsmap=gsmap_lnd_gdc2glo, ggrid=dom_clm, & + gsmap=gsmap_global, ggrid=dom_clm, & nxg=ldomain%ni, nyg=ldomain%nj, & yearFirst=stream_year_first_fan, & yearLast=stream_year_last_fan, & @@ -264,7 +263,7 @@ subroutine fanstream_init(bounds, NLFilename) pio_subsystem=pio_subsystem, & pio_iotype=shr_pio_getiotype(inst_name), & mpicom=mpicom, compid=comp_id, & - gsmap=gsmap_lnd_gdc2glo, ggrid=dom_clm, & + gsmap=gsmap_global, ggrid=dom_clm, & nxg=ldomain%ni, nyg=ldomain%nj, & yearFirst=stream_year_first_fan, & yearLast=stream_year_last_fan, & @@ -292,7 +291,7 @@ subroutine fanstream_init(bounds, NLFilename) pio_subsystem=pio_subsystem, & pio_iotype=shr_pio_getiotype(inst_name), & mpicom=mpicom, compid=comp_id, & - gsmap=gsmap_lnd_gdc2glo, ggrid=dom_clm, & + gsmap=gsmap_global, ggrid=dom_clm, & nxg=ldomain%ni, nyg=ldomain%nj, & yearFirst=stream_year_first_fan, & yearLast=stream_year_last_fan, & From 67cf886d9664dd8e1af69c3498ca9f33dd06199d Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 7 Sep 2022 16:52:30 -0600 Subject: [PATCH 156/181] Smallville tests of FAN need to use a compset that has ROF off, so using a clm5_0 one --- cime_config/testdefs/testlist_clm.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 503b9b9bdf..9a323cd50b 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -553,7 +553,7 @@ - + @@ -563,7 +563,7 @@ - + From 169f2f6cc80bfdb703f5aead91854c5d12943b92 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 7 Sep 2022 17:43:45 -0600 Subject: [PATCH 157/181] Change FAN single point compset tests to GSWP3 since Qian data only goes to 2004 and FAN tests start in 2009 --- cime_config/testdefs/testlist_clm.xml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 9a323cd50b..10273e7575 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -553,24 +553,24 @@ - + - + - + - + From ede22be3d294341a05a75c5baa84cd03f95b7c1d Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 7 Sep 2022 20:25:21 -0600 Subject: [PATCH 158/181] Add initial version of FAN streams, that just adds the interfaces and is not ready to use yet --- src/cpl/share_esmf/fanStreamMod.F90 | 219 ++++++++++++++++++++++++++++ 1 file changed, 219 insertions(+) create mode 100644 src/cpl/share_esmf/fanStreamMod.F90 diff --git a/src/cpl/share_esmf/fanStreamMod.F90 b/src/cpl/share_esmf/fanStreamMod.F90 new file mode 100644 index 0000000000..40f074d0af --- /dev/null +++ b/src/cpl/share_esmf/fanStreamMod.F90 @@ -0,0 +1,219 @@ +module FanStreamMod + + !----------------------------------------------------------------------- + ! Contains methods for reading in FAN nitrogen deposition (in the form of + ! manure) data file + ! Also includes functions for fan stream file handling and + ! interpolation. + ! + ! uses: + use ESMF + use dshr_strdata_mod , only : shr_strdata_type + use shr_kind_mod , only: r8 => shr_kind_r8, CL => shr_kind_cl + use clm_varcon , only : ispval + use spmdMod , only: mpicom, masterproc, comp_id, iam + use clm_varctl , only: iulog + use abortutils , only: endrun + use decompMod , only: bounds_type + + ! + implicit none + private + + ! Public interfaces + public :: fanstream_init ! Initialize FAN streams data + public :: fanstream_interp ! interpolates between two years of FAN file data + public :: set_bcast_fanstream_pars ! Set teh namelist parameters for the FAN streams + + ! Private module data + type(shr_strdata_type) :: sdat ! input data streams + integer :: stream_year_first_fan = ispval ! first year in stream to use + integer :: stream_year_last_fan = ispval ! last year in stream to use + integer :: model_year_align_fan = ispval ! align year to align model years with FAN streams + character(len=CL) :: stream_fldFileName_fan ! FAN stream filename + character(len=CL) :: fan_mapalgo = 'bilinear' ! FAN stream mapping algorithm + logical :: crop_manure_per_crop ! If manure is per crop or per land area, changes the variables read in + character(len=*), parameter, private :: sourcefile = & + __FILE__ + !============================================================================== + +contains + + !============================================================================== + + subroutine set_bcast_fanstream_pars(str_yr_first, str_yr_last, mdl_yr_align, mapalgo, str_filename, crop_man_is_percrop) + !----------------------------------------------------------------------- + ! + ! Set the FAN stream namelist parameters + ! + !----------------------------------------------------------------------- + ! Arguments: + integer, intent(in) :: str_yr_first, str_yr_last, mdl_yr_align + ! whether manure_sgrz and manure_ngrz are per crop or land area: + logical, intent(in) :: crop_man_is_percrop + character(len=*), intent(in) :: str_filename, mapalgo + !----------------------------------------------------------------------- + + stream_year_first_fan = str_yr_first + stream_year_last_fan = str_yr_last + model_year_align_fan = mdl_yr_align + stream_fldFileName_fan = str_filename + crop_manure_per_crop = crop_man_is_percrop + fan_mapalgo = mapalgo + + call shr_mpi_bcast(stream_year_first_fan, mpicom) + call shr_mpi_bcast(stream_year_last_fan, mpicom) + call shr_mpi_bcast(model_year_align_fan, mpicom) + call shr_mpi_bcast(stream_fldFileName_fan, mpicom) + call shr_mpi_bcast(crop_manure_per_crop, mpicom) + call shr_mpi_bcast(fan_mapalgo, mpicom) + + end subroutine set_bcast_fanstream_pars + + !************************************************************************************ + + subroutine fanstream_init(bounds, NLFilename) + !----------------------------------------------------------------------- + ! + ! Initialize data stream information for FAN + ! + !----------------------------------------------------------------------- + ! uses: + use clm_varctl , only : inst_name + use ncdio_pio , only : pio_subsystem + use shr_pio_mod , only : shr_pio_getiotype + use shr_nl_mod , only : shr_nl_find_group_name + use shr_log_mod , only : errMsg => shr_log_errMsg + use lnd_comp_shr , only : mesh, model_clock + use dshr_strdata_mod , only : shr_strdata_init_from_inline, shr_strdata_print + use dshr_strdata_mod , only : shr_strdata_advance + use dshr_methods_mod , only : dshr_fldbun_getfldptr + ! + ! Arguments: + implicit none + type(bounds_type), intent(in) :: bounds + character(len=*), intent(in) :: NLFilename ! Namelist filename + ! + ! Local variables: + integer :: nu_nml ! unit for namelist file + integer :: nml_error ! namelist i/o error flag + integer :: rc ! error code + character(len=16), allocatable :: stream_varnames(:) ! array of stream field names + character(len=80) :: streamvar, streamvar2 ! Specific stream variable names + character(*), parameter :: subName = "('fanstream_init')" + !----------------------------------------------------------------------- + + call endrun(msg=subName//'ERROR FAN is not configured for NUOPC driver yet'//errMsg(sourcefile, __LINE__)) + if (stream_year_first_fan == ispval) then + call endrun(msg=subName//'ERROR stream_year_first_fan not set at '//errMsg(sourcefile, __LINE__)) + end if + + allocate(stream_varnames(6)) + if (crop_manure_per_crop) then + streamvar = 'manure_sgrz_crop' + streamvar2 = 'manure_ngrz_crop' + else + streamvar = 'manure_sgrz' + streamvar2 = 'manure_ngrz' + end if + else + stream_varnames = (/ + 'manure_grz', & + streamvar, & + streamvar2, & + 'fract_urea', & + 'fract_nitr', & + 'soilph ' & + /) + + if (masterproc) then + write(iulog,*) ' ' + write(iulog,*) 'FAN stream settings:' + write(iulog,*) ' stream_year_first_fan = ',stream_year_first_fan + write(iulog,*) ' stream_year_last_fan = ',stream_year_last_fan + write(iulog,*) ' model_year_align_fan = ',model_year_align_fan + write(iulog,*) ' stream_fldFileName_fan = ',stream_fldFileName_fan + write(iulog,*) ' ' + endif + ! + ! Initialize the cdeps data type sdat + call shr_strdata_init_from_inline(sdat, & + my_task = iam, & + logunit = iulog, & + compname = 'LND', & + model_clock = model_clock, & + model_mesh = mesh, & + stream_meshfile = "filethisin" & + stream_lev_dimname = 'null', & + stream_mapalgo = fan_mapalgo, & + stream_filenames = (/trim(stream_fldFileName_fan)/), & + stream_fldlistFile = stream_varnames, & + stream_fldListModel = stream_varnames, & + stream_yearFirst = stream_year_first_fan, & + stream_yearLast = stream_year_last_fan, & + stream_yearAlign = model_year_align_fan, & + stream_offset = 0, & + stream_taxmode = 'extend', & + stream_dtlimit = 1.0e30_r8, & + stream_tintalgo = 'linear', & + stream_name = 'FAN manure file', & + rc = rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + + if (masterproc) then + call shr_strdata_print(sdat_grz,'CLMFAN data') + endif + + end subroutine fanstream_init + + !================================================================ + + subroutine fanstream_interp(bounds, atm2lnd_inst) + !----------------------------------------------------------------------- + ! + ! Interpoalte the FAN data to the current simulation time + ! + !----------------------------------------------------------------------- + use clm_time_manager, only : get_curr_date, get_days_per_year + use clm_varcon , only : secspday + use atm2lndType , only : atm2lnd_type + use shr_infnan_mod , only : isinf => shr_infnan_isinf + ! + ! Arguments + type(bounds_type) , intent(in) :: bounds + type(atm2lnd_type), intent(inout) :: atm2lnd_inst + ! + ! Local variables + integer :: g, ig , n ! Indices + integer :: year ! year (0, ...) for nstep+1 + integer :: mon ! month (1, ..., 12) for nstep+1 + integer :: day ! day of month (1, ..., 31) for nstep+1 + integer :: sec ! seconds into current date for nstep+1 + integer :: mcdate ! Current model date (yyyymmdd) + integer :: dayspyr ! days per year + integer :: rc ! error code + character(*), parameter :: subName = "('fanstream_interp')" + !----------------------------------------------------------------------- + + call endrun(msg=subName//'ERROR FAN is not configured for NUOPC driver yet'//errMsg(sourcefile, __LINE__)) + + call get_curr_date(year, mon, day, sec) + mcdate = year*10000 + mon*100 + day + dayspyr = get_days_per_year( ) + + call shr_strdata_advance(sdat, ymd=mcdate, tod=sec, logunit=iulog, istr='clmfan', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + + ig = 0 + do g = bounds%begg,bounds%endg + ig = ig+1 +! atm2lnd_inst%forc_ndep_grz_grc(g) = sdat%avs(1)%rAttr(1,ig) / (secspday * dayspyr) + end do + + end subroutine fanstream_interp + +end module FanStreamMod From 07653f47531d218add62d728fddcd9d5aab45333 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 7 Sep 2022 22:35:07 -0600 Subject: [PATCH 159/181] Fixes so will compile --- src/cpl/share_esmf/fanStreamMod.F90 | 36 ++++++++++++++--------------- 1 file changed, 17 insertions(+), 19 deletions(-) diff --git a/src/cpl/share_esmf/fanStreamMod.F90 b/src/cpl/share_esmf/fanStreamMod.F90 index 40f074d0af..d7b961b2db 100644 --- a/src/cpl/share_esmf/fanStreamMod.F90 +++ b/src/cpl/share_esmf/fanStreamMod.F90 @@ -9,12 +9,13 @@ module FanStreamMod ! uses: use ESMF use dshr_strdata_mod , only : shr_strdata_type - use shr_kind_mod , only: r8 => shr_kind_r8, CL => shr_kind_cl + use shr_kind_mod , only : r8 => shr_kind_r8, CL => shr_kind_cl use clm_varcon , only : ispval - use spmdMod , only: mpicom, masterproc, comp_id, iam - use clm_varctl , only: iulog - use abortutils , only: endrun - use decompMod , only: bounds_type + use shr_log_mod , only : errMsg => shr_log_errMsg + use spmdMod , only : mpicom, masterproc, comp_id, iam + use clm_varctl , only : iulog + use abortutils , only : endrun + use decompMod , only : bounds_type ! implicit none @@ -26,7 +27,7 @@ module FanStreamMod public :: set_bcast_fanstream_pars ! Set teh namelist parameters for the FAN streams ! Private module data - type(shr_strdata_type) :: sdat ! input data streams + type(shr_strdata_type) :: sdat_fan ! input data streams integer :: stream_year_first_fan = ispval ! first year in stream to use integer :: stream_year_last_fan = ispval ! last year in stream to use integer :: model_year_align_fan = ispval ! align year to align model years with FAN streams @@ -83,10 +84,8 @@ subroutine fanstream_init(bounds, NLFilename) use ncdio_pio , only : pio_subsystem use shr_pio_mod , only : shr_pio_getiotype use shr_nl_mod , only : shr_nl_find_group_name - use shr_log_mod , only : errMsg => shr_log_errMsg use lnd_comp_shr , only : mesh, model_clock use dshr_strdata_mod , only : shr_strdata_init_from_inline, shr_strdata_print - use dshr_strdata_mod , only : shr_strdata_advance use dshr_methods_mod , only : dshr_fldbun_getfldptr ! ! Arguments: @@ -98,8 +97,8 @@ subroutine fanstream_init(bounds, NLFilename) integer :: nu_nml ! unit for namelist file integer :: nml_error ! namelist i/o error flag integer :: rc ! error code - character(len=16), allocatable :: stream_varnames(:) ! array of stream field names - character(len=80) :: streamvar, streamvar2 ! Specific stream variable names + character(len=16) :: stream_varnames(6) ! array of stream field names + character(len=80) :: streamvar, streamvar2 ! Specific stream variable names character(*), parameter :: subName = "('fanstream_init')" !----------------------------------------------------------------------- @@ -108,7 +107,6 @@ subroutine fanstream_init(bounds, NLFilename) call endrun(msg=subName//'ERROR stream_year_first_fan not set at '//errMsg(sourcefile, __LINE__)) end if - allocate(stream_varnames(6)) if (crop_manure_per_crop) then streamvar = 'manure_sgrz_crop' streamvar2 = 'manure_ngrz_crop' @@ -116,8 +114,7 @@ subroutine fanstream_init(bounds, NLFilename) streamvar = 'manure_sgrz' streamvar2 = 'manure_ngrz' end if - else - stream_varnames = (/ + stream_varnames = (/ & 'manure_grz', & streamvar, & streamvar2, & @@ -136,14 +133,14 @@ subroutine fanstream_init(bounds, NLFilename) write(iulog,*) ' ' endif ! - ! Initialize the cdeps data type sdat - call shr_strdata_init_from_inline(sdat, & + ! Initialize the cdeps data type sdat_fan + call shr_strdata_init_from_inline(sdat_fan, & my_task = iam, & logunit = iulog, & compname = 'LND', & model_clock = model_clock, & model_mesh = mesh, & - stream_meshfile = "filethisin" & + stream_meshfile = "filethisin", & stream_lev_dimname = 'null', & stream_mapalgo = fan_mapalgo, & stream_filenames = (/trim(stream_fldFileName_fan)/), & @@ -163,7 +160,7 @@ subroutine fanstream_init(bounds, NLFilename) end if if (masterproc) then - call shr_strdata_print(sdat_grz,'CLMFAN data') + call shr_strdata_print(sdat_fan,'CLMFAN data') endif end subroutine fanstream_init @@ -180,6 +177,7 @@ subroutine fanstream_interp(bounds, atm2lnd_inst) use clm_varcon , only : secspday use atm2lndType , only : atm2lnd_type use shr_infnan_mod , only : isinf => shr_infnan_isinf + use dshr_strdata_mod, only : shr_strdata_advance ! ! Arguments type(bounds_type) , intent(in) :: bounds @@ -203,7 +201,7 @@ subroutine fanstream_interp(bounds, atm2lnd_inst) mcdate = year*10000 + mon*100 + day dayspyr = get_days_per_year( ) - call shr_strdata_advance(sdat, ymd=mcdate, tod=sec, logunit=iulog, istr='clmfan', rc=rc) + call shr_strdata_advance(sdat_fan, ymd=mcdate, tod=sec, logunit=iulog, istr='clmfan', rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then call ESMF_Finalize(endflag=ESMF_END_ABORT) end if @@ -211,7 +209,7 @@ subroutine fanstream_interp(bounds, atm2lnd_inst) ig = 0 do g = bounds%begg,bounds%endg ig = ig+1 -! atm2lnd_inst%forc_ndep_grz_grc(g) = sdat%avs(1)%rAttr(1,ig) / (secspday * dayspyr) +! atm2lnd_inst%forc_ndep_grz_grc(g) = sdat_fan%avs(1)%rAttr(1,ig) / (secspday * dayspyr) end do end subroutine fanstream_interp From a24fb200f69031e07a73736d4fc1683fa218ba05 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 7 Sep 2022 22:53:03 -0600 Subject: [PATCH 160/181] add missing use statement for shr_mpi_mod bcast method --- src/cpl/share_esmf/fanStreamMod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/cpl/share_esmf/fanStreamMod.F90 b/src/cpl/share_esmf/fanStreamMod.F90 index d7b961b2db..e9057a06af 100644 --- a/src/cpl/share_esmf/fanStreamMod.F90 +++ b/src/cpl/share_esmf/fanStreamMod.F90 @@ -48,6 +48,8 @@ subroutine set_bcast_fanstream_pars(str_yr_first, str_yr_last, mdl_yr_align, map ! Set the FAN stream namelist parameters ! !----------------------------------------------------------------------- + ! uses: + use shr_mpi_mod, only : shr_mpi_bcast ! Arguments: integer, intent(in) :: str_yr_first, str_yr_last, mdl_yr_align ! whether manure_sgrz and manure_ngrz are per crop or land area: From 62f4d18767e4afd455a06eeaec2d0f7d6710f134 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 8 Sep 2022 15:53:11 -0600 Subject: [PATCH 161/181] gnu compiler requires string lengths to be identical --- src/cpl/share_esmf/fanStreamMod.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/cpl/share_esmf/fanStreamMod.F90 b/src/cpl/share_esmf/fanStreamMod.F90 index e9057a06af..8f4f6340cb 100644 --- a/src/cpl/share_esmf/fanStreamMod.F90 +++ b/src/cpl/share_esmf/fanStreamMod.F90 @@ -100,7 +100,7 @@ subroutine fanstream_init(bounds, NLFilename) integer :: nml_error ! namelist i/o error flag integer :: rc ! error code character(len=16) :: stream_varnames(6) ! array of stream field names - character(len=80) :: streamvar, streamvar2 ! Specific stream variable names + character(len=16) :: streamvar, streamvar2 ! Specific stream variable names character(*), parameter :: subName = "('fanstream_init')" !----------------------------------------------------------------------- @@ -117,12 +117,12 @@ subroutine fanstream_init(bounds, NLFilename) streamvar2 = 'manure_ngrz' end if stream_varnames = (/ & - 'manure_grz', & + 'manure_grz ', & streamvar, & streamvar2, & - 'fract_urea', & - 'fract_nitr', & - 'soilph ' & + 'fract_urea ', & + 'fract_nitr ', & + 'soilph ' & /) if (masterproc) then From 1596900946bc4d6858f6930e7dc8b34066351f7f Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 8 Sep 2022 21:52:41 -0600 Subject: [PATCH 162/181] Add more files to the unit test build since they are now needed with FAN, add a stub for FAN streams for the unit testing --- src/biogeochem/CMakeLists.txt | 2 + src/biogeophys/CMakeLists.txt | 1 + src/soilbiogeochem/CMakeLists.txt | 1 + src/unit_test_stubs/utils/CMakeLists.txt | 1 + src/unit_test_stubs/utils/fanStreamMod.F90 | 94 ++++++++++++++++++++++ 5 files changed, 99 insertions(+) create mode 100644 src/unit_test_stubs/utils/fanStreamMod.F90 diff --git a/src/biogeochem/CMakeLists.txt b/src/biogeochem/CMakeLists.txt index b2de170099..9d88824562 100644 --- a/src/biogeochem/CMakeLists.txt +++ b/src/biogeochem/CMakeLists.txt @@ -14,6 +14,8 @@ list(APPEND clm_sources CNVegNitrogenFluxType.F90 CNCIsoAtmTimeSeriesReadMod.F90 CNVegComputeSeedMod.F90 + Fan2CTSMMod.F90 + FanMod.F90 SpeciesBaseType.F90 SpeciesIsotopeType.F90 SpeciesNonIsotopeType.F90 diff --git a/src/biogeophys/CMakeLists.txt b/src/biogeophys/CMakeLists.txt index 3cf5e0eaf0..176df4dc6d 100644 --- a/src/biogeophys/CMakeLists.txt +++ b/src/biogeophys/CMakeLists.txt @@ -7,6 +7,7 @@ list(APPEND clm_sources BalanceCheckMod.F90 CanopyStateType.F90 EnergyFluxType.F90 + FrictionVelocityMod.F90 GlacierSurfaceMassBalanceMod.F90 HumanIndexMod.F90 InfiltrationExcessRunoffMod.F90 diff --git a/src/soilbiogeochem/CMakeLists.txt b/src/soilbiogeochem/CMakeLists.txt index 6d9a02f312..f4545a6a76 100644 --- a/src/soilbiogeochem/CMakeLists.txt +++ b/src/soilbiogeochem/CMakeLists.txt @@ -6,6 +6,7 @@ list(APPEND clm_sources SoilBiogeochemDecompCascadeConType.F90 SoilBiogeochemStateType.F90 SoilBiogeochemNitrogenStateType.F90 + SoilBiogeochemNitrogenFluxType.F90 ) sourcelist_to_parent(clm_sources) diff --git a/src/unit_test_stubs/utils/CMakeLists.txt b/src/unit_test_stubs/utils/CMakeLists.txt index 25f7c0c29f..af45162e5f 100644 --- a/src/unit_test_stubs/utils/CMakeLists.txt +++ b/src/unit_test_stubs/utils/CMakeLists.txt @@ -9,6 +9,7 @@ sourcelist_to_parent(clm_genf90_sources) list(APPEND clm_sources "${clm_genf90_sources}") list(APPEND clm_sources + fanStreamMod.F90 restUtilMod_stub.F90 spmdMod_stub.F90 clmfates_paraminterfaceMod_stub.F90 diff --git a/src/unit_test_stubs/utils/fanStreamMod.F90 b/src/unit_test_stubs/utils/fanStreamMod.F90 new file mode 100644 index 0000000000..b72d4a2299 --- /dev/null +++ b/src/unit_test_stubs/utils/fanStreamMod.F90 @@ -0,0 +1,94 @@ +module FanStreamMod + + !----------------------------------------------------------------------- + ! Contains methods for reading in FAN nitrogen deposition (in the form of + ! manure) data file + ! Also includes functions for fan stream file handling and + ! interpolation. + ! + ! uses: + use shr_kind_mod , only : r8 => shr_kind_r8, CL => shr_kind_cl + use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun + use decompMod , only : bounds_type + ! + implicit none + private + + ! Public interfaces + public :: fanstream_init ! Initialize FAN streams data + public :: fanstream_interp ! interpolates between two years of FAN file data + public :: set_bcast_fanstream_pars ! Set teh namelist parameters for the FAN streams + + character(len=*), parameter, private :: sourcefile = & + __FILE__ + !============================================================================== + +contains + + !============================================================================== + + subroutine set_bcast_fanstream_pars(str_yr_first, str_yr_last, mdl_yr_align, mapalgo, str_filename, crop_man_is_percrop) + !----------------------------------------------------------------------- + ! + ! Set the FAN stream namelist parameters + ! + !----------------------------------------------------------------------- + ! uses: + ! Arguments: + integer, intent(in) :: str_yr_first, str_yr_last, mdl_yr_align + ! whether manure_sgrz and manure_ngrz are per crop or land area: + logical, intent(in) :: crop_man_is_percrop + character(len=*), intent(in) :: str_filename, mapalgo + ! Local variables: + character(*), parameter :: subName = "('set_bcast_fanstream_pars')" + !----------------------------------------------------------------------- + call endrun(msg=subName//'ERROR this is a stub and should not be called'//errMsg(sourcefile, __LINE__)) + + end subroutine set_bcast_fanstream_pars + + !************************************************************************************ + + subroutine fanstream_init(bounds, NLFilename) + !----------------------------------------------------------------------- + ! + ! Initialize data stream information for FAN + ! + !----------------------------------------------------------------------- + ! uses: + ! + ! Arguments: + implicit none + type(bounds_type), intent(in) :: bounds + character(len=*), intent(in) :: NLFilename ! Namelist filename + ! + ! Local variables: + character(*), parameter :: subName = "('fanstream_init')" + + call endrun(msg=subName//'ERROR this is a stub and should not be called'//errMsg(sourcefile, __LINE__)) + + end subroutine fanstream_init + + !================================================================ + + subroutine fanstream_interp(bounds, atm2lnd_inst) + !----------------------------------------------------------------------- + ! + ! Interpoalte the FAN data to the current simulation time + ! + !----------------------------------------------------------------------- + use atm2lndType , only : atm2lnd_type + ! + ! Arguments + type(bounds_type) , intent(in) :: bounds + type(atm2lnd_type), intent(inout) :: atm2lnd_inst + ! + ! Local variables + character(*), parameter :: subName = "('fanstream_interp')" + !----------------------------------------------------------------------- + + call endrun(msg=subName//'ERROR this is a stub and should not be called'//errMsg(sourcefile, __LINE__)) + + end subroutine fanstream_interp + +end module FanStreamMod From 3427431acddb24ff7101510c988c98cb34573923 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 8 Sep 2022 22:03:28 -0600 Subject: [PATCH 163/181] Update repository to point to my fork to get the branch for cpl7 and share code --- Externals.cfg | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index f5756702d1..65d4419c3d 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -58,7 +58,7 @@ required = True [cpl7] #tag = cpl7.0.5 protocol = git -repo_url = https://github.com/ESCOMP/CESM_CPL7andDataComps +repo_url = https://github.com/ekluzek/CESM_CPL7andDataComps local_path = components/cpl7 #branch = fancpl2-up-merge hash = 3030a0b4c709c55bde9da6acce4decaabbb9073d @@ -69,7 +69,7 @@ hash = 9a77c51f8b6e9c2ed96f579848efe3553b2abc3a #tag = share1.0.8 #branch = fancpl2-up-merge protocol = git -repo_url = https://github.com/ESCOMP/CESM_share +repo_url = https://github.com/ekluzek/CESM_share local_path = share required = True From 86bb9a4f936d06ec842f4fad14f62673276693d9 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 8 Sep 2022 23:02:24 -0600 Subject: [PATCH 164/181] Use new get_curr_days_per_year in FAN streams which is required in the update --- src/cpl/mct/fanStreamMod.F90 | 4 ++-- src/cpl/share_esmf/fanStreamMod.F90 | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/cpl/mct/fanStreamMod.F90 b/src/cpl/mct/fanStreamMod.F90 index 02669f56f3..b261879631 100644 --- a/src/cpl/mct/fanStreamMod.F90 +++ b/src/cpl/mct/fanStreamMod.F90 @@ -324,7 +324,7 @@ end subroutine fanstream_init subroutine fanstream_interp(bounds, atm2lnd_inst) !----------------------------------------------------------------------- - use clm_time_manager, only : get_curr_date, get_days_per_year + use clm_time_manager, only : get_curr_date, get_curr_days_per_year use clm_varcon , only : secspday use atm2lndType , only : atm2lnd_type use shr_infnan_mod , only : isinf => shr_infnan_isinf @@ -345,7 +345,7 @@ subroutine fanstream_interp(bounds, atm2lnd_inst) call get_curr_date(year, mon, day, sec) mcdate = year*10000 + mon*100 + day - dayspyr = get_days_per_year( ) + dayspyr = get_curr_days_per_year( ) call shr_strdata_advance(sdat_grz, mcdate, sec, mpicom, 'clmfangrz') diff --git a/src/cpl/share_esmf/fanStreamMod.F90 b/src/cpl/share_esmf/fanStreamMod.F90 index 8f4f6340cb..b4676c8841 100644 --- a/src/cpl/share_esmf/fanStreamMod.F90 +++ b/src/cpl/share_esmf/fanStreamMod.F90 @@ -175,7 +175,7 @@ subroutine fanstream_interp(bounds, atm2lnd_inst) ! Interpoalte the FAN data to the current simulation time ! !----------------------------------------------------------------------- - use clm_time_manager, only : get_curr_date, get_days_per_year + use clm_time_manager, only : get_curr_date, get_curr_days_per_year use clm_varcon , only : secspday use atm2lndType , only : atm2lnd_type use shr_infnan_mod , only : isinf => shr_infnan_isinf @@ -201,7 +201,7 @@ subroutine fanstream_interp(bounds, atm2lnd_inst) call get_curr_date(year, mon, day, sec) mcdate = year*10000 + mon*100 + day - dayspyr = get_days_per_year( ) + dayspyr = get_curr_days_per_year( ) call shr_strdata_advance(sdat_fan, ymd=mcdate, tod=sec, logunit=iulog, istr='clmfan', rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then From 43cc3249dfe0afb64d211e0706b6c5aaa987e119 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 9 Sep 2022 13:10:27 -0600 Subject: [PATCH 165/181] Move shr_fan from share to cmeps, so change so share is standard, and cmeps is a branch --- Externals.cfg | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index 6c9e5603a1..4c5be89e8e 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -48,9 +48,11 @@ tag = cime6.0.45 required = True [cmeps] -tag = cmeps0.13.71 +#tag = cmeps0.13.71 +hash = e0e2f0a1e80fa76c04c73514d2ee4ff8c67f31f9 +#branch = fancpl2-up-merge protocol = git -repo_url = https://github.com/ESCOMP/CMEPS.git +repo_url = https://github.com/ekluzek/CMEPS.git local_path = components/cmeps required = True @@ -72,11 +74,9 @@ hash = ae5cee2a7fe4fa111778119939fb3e7868cf8d06 required = True [share] -hash = 8f39b8076f17a007cf43e2dd2219a8cf814a7335 -#branch = fancpl2-up-merge -#tag = share1.0.12 +tag = share1.0.12 protocol = git -repo_url = https://github.com/ekluzek/CESM_share +repo_url = https://github.com/ESCOMP/CESM_share local_path = share required = True From aa4d65b5c739e123aeacd72b39317de53146a1d7 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Sat, 10 Sep 2022 11:40:19 -0600 Subject: [PATCH 166/181] Add path for lilac to shr_fan_mod.F90 under cmeps so that LILAC can build --- cime_config/buildlib | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/cime_config/buildlib b/cime_config/buildlib index 31b7fe3d38..208904c28a 100755 --- a/cime_config/buildlib +++ b/cime_config/buildlib @@ -133,6 +133,10 @@ def _main_func(): # to use its directories in place of stub_rof paths.append(os.path.join(lnd_root,"lilac","stub_rof")) + # Add path needed for shr_fan_mod.F90, which is under cmeps + cmeps_root = os.path.normpath( os.path.join(_CIMEROOT,os.pardir, "components", "cmeps") ) + paths.append(os.path.join(cmeps_root,"cesm","nuopc_cap_share")) + if (driver == 'lilac' or driver == 'nuopc'): paths.append(os.path.join(lnd_root,"src","cpl","share_esmf")) From 521686cff8ce53f33a762883b19d55475939e22e Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 13 Sep 2022 12:25:24 -0600 Subject: [PATCH 167/181] Add an update to cmeps --- Externals.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals.cfg b/Externals.cfg index 4c5be89e8e..08f2ceb0b6 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -49,7 +49,7 @@ required = True [cmeps] #tag = cmeps0.13.71 -hash = e0e2f0a1e80fa76c04c73514d2ee4ff8c67f31f9 +hash = d02b30cdd898affe8d383bf9bdc24aaf3c27b059 #branch = fancpl2-up-merge protocol = git repo_url = https://github.com/ekluzek/CMEPS.git From 9b6a56d8112d108e1381d20f0e137b62ddaf06b7 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 13 Sep 2022 14:38:04 -0600 Subject: [PATCH 168/181] Add passing of FAN fields to atm Fall_FANflxnh3 for NUOPC case --- src/cpl/nuopc/lnd_import_export.F90 | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/src/cpl/nuopc/lnd_import_export.F90 b/src/cpl/nuopc/lnd_import_export.F90 index 0e7a5e2eef..de4ba7ee1d 100644 --- a/src/cpl/nuopc/lnd_import_export.F90 +++ b/src/cpl/nuopc/lnd_import_export.F90 @@ -61,6 +61,7 @@ module lnd_import_export integer :: drydep_nflds ! number of dry deposition velocity fields lnd-> atm integer :: megan_nflds ! number of MEGAN voc fields from lnd-> atm integer :: emis_nflds ! number of fire emission fields from lnd-> atm + character(len=cx) :: fan_fields ! List of NH3 emission fields from lnd->atm logical :: flds_co2a ! use case logical :: flds_co2b ! use case @@ -131,6 +132,7 @@ module lnd_import_export character(*), parameter :: Fall_fco2_lnd = 'Fall_fco2_lnd' character(*), parameter :: Sl_ddvel = 'Sl_ddvel' character(*), parameter :: Fall_voc = 'Fall_voc' + character(*), parameter :: Fall_fan = 'Fall_FANflxnh3' character(*), parameter :: Fall_fire = 'Fall_fire' character(*), parameter :: Sl_fztop = 'Sl_fztop' character(*), parameter :: Flrl_rofsur = 'Flrl_rofsur' @@ -158,6 +160,7 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r use shr_carma_mod , only : shr_carma_readnl use shr_ndep_mod , only : shr_ndep_readnl + use shr_fan_mod , only : shr_fan_readnl use shr_fire_emis_mod , only : shr_fire_emis_readnl use clm_varctl , only : ndep_from_cpl use controlMod , only : NLFilename @@ -179,6 +182,7 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r integer :: n, num logical :: send_co2_to_atm = .false. logical :: recv_co2_fr_atm = .false. + logical :: fan_have_fields ! .true. if FAN coupled to atmosphere character(len=*), parameter :: subname='(lnd_import_export:advertise_fields)' !------------------------------------------------------------------------------- @@ -248,6 +252,9 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r ! TODO: is the following correct - the CARMA field exchange is very confusing in mct call shr_carma_readnl('drv_flds_in', carma_fields) + ! FAN model NH3 emissions from land + call shr_fan_readnl(nlfilename='drv_flds_in', fan_fields=fan_fields, have_fields=fan_have_fields) + ! export to atm call fldlist_add(fldsFrLnd_num, fldsFrlnd, trim(flds_scalar_name)) call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_lfrin') @@ -289,6 +296,9 @@ subroutine advertise_fields(gcomp, flds_scalar_name, glc_present, cism_evolve, r if (carma_fields /= ' ') then call fldlist_add(fldsFrLnd_num, fldsFrlnd, Sl_soilw) ! optional for carma end if + if (fan_have_fields) then + call fldlist_add(fldsFrLnd_num, fldsFrLnd, Fall_fan) + end if end if ! export to rof @@ -827,6 +837,11 @@ subroutine export_fields( gcomp, bounds, glc_present, rof_prognostic, & init_spval=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + if (fldchk(exportState, Fall_fan)) then + call state_setexport_1d(exportState, Fall_fan, lnd2atm_inst%flux_nh3_grc(begg:), & + init_spval=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if if (fldchk(exportState, Fall_fco2_lnd)) then call state_setexport_1d(exportState, Fall_fco2_lnd, lnd2atm_inst%net_carbon_exchange_grc(begg:), & init_spval=.false., minus=.true., rc=rc) From ee8ef31abdfaf0383c1b93331b376df224ea5d88 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 13 Sep 2022 16:02:55 -0600 Subject: [PATCH 169/181] Add code to handle reading in the FAN streams for nuopc --- src/cpl/share_esmf/fanStreamMod.F90 | 64 +++++++++++++++++++++++++---- 1 file changed, 55 insertions(+), 9 deletions(-) diff --git a/src/cpl/share_esmf/fanStreamMod.F90 b/src/cpl/share_esmf/fanStreamMod.F90 index b4676c8841..63b442a189 100644 --- a/src/cpl/share_esmf/fanStreamMod.F90 +++ b/src/cpl/share_esmf/fanStreamMod.F90 @@ -33,6 +33,8 @@ module FanStreamMod integer :: model_year_align_fan = ispval ! align year to align model years with FAN streams character(len=CL) :: stream_fldFileName_fan ! FAN stream filename character(len=CL) :: fan_mapalgo = 'bilinear' ! FAN stream mapping algorithm + integer, parameter :: nFields = 6 + character(len=16) :: stream_varnames(nFields) ! array of stream field names logical :: crop_manure_per_crop ! If manure is per crop or per land area, changes the variables read in character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -99,12 +101,10 @@ subroutine fanstream_init(bounds, NLFilename) integer :: nu_nml ! unit for namelist file integer :: nml_error ! namelist i/o error flag integer :: rc ! error code - character(len=16) :: stream_varnames(6) ! array of stream field names - character(len=16) :: streamvar, streamvar2 ! Specific stream variable names + character(len=16) :: streamvar, streamvar2 ! Specific stream variable names character(*), parameter :: subName = "('fanstream_init')" !----------------------------------------------------------------------- - call endrun(msg=subName//'ERROR FAN is not configured for NUOPC driver yet'//errMsg(sourcefile, __LINE__)) if (stream_year_first_fan == ispval) then call endrun(msg=subName//'ERROR stream_year_first_fan not set at '//errMsg(sourcefile, __LINE__)) end if @@ -179,6 +179,7 @@ subroutine fanstream_interp(bounds, atm2lnd_inst) use clm_varcon , only : secspday use atm2lndType , only : atm2lnd_type use shr_infnan_mod , only : isinf => shr_infnan_isinf + use dshr_methods_mod, only : dshr_fldbun_getfldptr use dshr_strdata_mod, only : shr_strdata_advance ! ! Arguments @@ -194,11 +195,10 @@ subroutine fanstream_interp(bounds, atm2lnd_inst) integer :: mcdate ! Current model date (yyyymmdd) integer :: dayspyr ! days per year integer :: rc ! error code + real(r8), pointer :: dataptr1d(:) ! Temporary data array to put stream data into character(*), parameter :: subName = "('fanstream_interp')" !----------------------------------------------------------------------- - call endrun(msg=subName//'ERROR FAN is not configured for NUOPC driver yet'//errMsg(sourcefile, __LINE__)) - call get_curr_date(year, mon, day, sec) mcdate = year*10000 + mon*100 + day dayspyr = get_curr_days_per_year( ) @@ -208,10 +208,56 @@ subroutine fanstream_interp(bounds, atm2lnd_inst) call ESMF_Finalize(endflag=ESMF_END_ABORT) end if - ig = 0 - do g = bounds%begg,bounds%endg - ig = ig+1 -! atm2lnd_inst%forc_ndep_grz_grc(g) = sdat_fan%avs(1)%rAttr(1,ig) / (secspday * dayspyr) + do n = 1, nFields + call dshr_fldbun_getFldPtr(this%sdat_urbantv%pstrm(1)%fldbun_model, trim(stream_varnames(n)), & + fldptr1=dataptr1d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + select case trim(stream_varnames(n)) + case( 'manure_grz') + atm2lnd_inst%forc_grz_grc(:) = dataprt1d(:) / (secspday * dayspyr) + case( 'manure_sgrz_crop') + do g = bounds%begg,bounds%endg + if ( isinf(dataprt1d(g) ) then + atm2lnd_inst%forc_ndep_sgrz_grc(g) = 9.0e99_r8 + else + atm2lnd_inst%forc_ndep_sgrz_grc(g) = dataprt1d(g) / (secspday * dayspyr) + end if + end do + case( 'manure_ngrz_crop') + do g = bounds%begg,bounds%endg + if ( isinf(dataprt1d(g) ) then + atm2lnd_inst%forc_ndep_ngrz_grc(g) = 9.0e99_r8 + else + atm2lnd_inst%forc_ndep_ngrz_grc(g) = dataprt1d(g) / (secspday * dayspyr) + end if + end do + case( 'manure_sgrz' ) + do g = bounds%begg,bounds%endg + if ( isinf(dataprt1d(g) ) then + atm2lnd_inst%forc_ndep_sgrz_grc(g) = 9.0e99_r8 + else + atm2lnd_inst%forc_ndep_sgrz_grc(g) = dataprt1d(g) / (secspday * dayspyr) + end if + end do + case( 'manure_ngrz' ) + do g = bounds%begg,bounds%endg + if ( isinf(dataprt1d(g) ) then + atm2lnd_inst%forc_ndep_ngrz_grc(g) = 9.0e99_r8 + else + atm2lnd_inst%forc_ndep_ngrz_grc(g) = dataprt1d(g) / (secspday * dayspyr) + end if + end do + case( 'fract_urea' ) + atm2lnd_inst%forc_ndep_urea_grc(:) = dataprt1d(:) + case( 'fract_nitr' ) + atm2lnd_inst%forc_ndep_nitr_grc(:) = dataprt1d(:) + case( 'soilph' ) + atm2lnd_inst%forc_soilph_grc(:) = dataptr1d(:) + case default + call endrun(msg=subName//'ERROR FAN stream variable is not handled'//trim(stream_varnames(n))//errMsg(sourcefile, __LINE__)) + end select end do end subroutine fanstream_interp From 7ea2c7786476de8a8cae2acb296a7b13e1176baa Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 13 Sep 2022 16:12:01 -0600 Subject: [PATCH 170/181] Add a default NUOPC version of each of the FAN MCT tests --- cime_config/testdefs/testlist_clm.xml | 51 +++++++++++++++++++++++++++ 1 file changed, 51 insertions(+) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 7f9ec8a911..c0d5aaa4ea 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -566,6 +566,57 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + From 757baa0c196583024991252e6df6367e7a9ae058 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Tue, 13 Sep 2022 16:31:23 -0600 Subject: [PATCH 171/181] Add a test for a NEON AG site with FAN on --- cime_config/testdefs/testlist_clm.xml | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index c0d5aaa4ea..e31f519510 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -617,6 +617,16 @@ + + + + + + + + + + From 63be0edff547175a353c3cc372e3901f53d71d9a Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 14 Sep 2022 00:33:30 -0600 Subject: [PATCH 172/181] Get to compile on nag compiler on izumi --- src/cpl/share_esmf/fanStreamMod.F90 | 32 ++++++++++++++++------------- 1 file changed, 18 insertions(+), 14 deletions(-) diff --git a/src/cpl/share_esmf/fanStreamMod.F90 b/src/cpl/share_esmf/fanStreamMod.F90 index 63b442a189..ad97e43215 100644 --- a/src/cpl/share_esmf/fanStreamMod.F90 +++ b/src/cpl/share_esmf/fanStreamMod.F90 @@ -53,6 +53,7 @@ subroutine set_bcast_fanstream_pars(str_yr_first, str_yr_last, mdl_yr_align, map ! uses: use shr_mpi_mod, only : shr_mpi_bcast ! Arguments: + implicit none integer, intent(in) :: str_yr_first, str_yr_last, mdl_yr_align ! whether manure_sgrz and manure_ngrz are per crop or land area: logical, intent(in) :: crop_man_is_percrop @@ -183,6 +184,7 @@ subroutine fanstream_interp(bounds, atm2lnd_inst) use dshr_strdata_mod, only : shr_strdata_advance ! ! Arguments + implicit none type(bounds_type) , intent(in) :: bounds type(atm2lnd_type), intent(inout) :: atm2lnd_inst ! @@ -209,56 +211,58 @@ subroutine fanstream_interp(bounds, atm2lnd_inst) end if do n = 1, nFields - call dshr_fldbun_getFldPtr(this%sdat_urbantv%pstrm(1)%fldbun_model, trim(stream_varnames(n)), & + dataptr1d => NULL() + call dshr_fldbun_getFldPtr(sdat_fan%pstrm(1)%fldbun_model, trim(stream_varnames(n)), & fldptr1=dataptr1d, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) then call ESMF_Finalize(endflag=ESMF_END_ABORT) end if - select case trim(stream_varnames(n)) + select case( trim(stream_varnames(n)) ) case( 'manure_grz') - atm2lnd_inst%forc_grz_grc(:) = dataprt1d(:) / (secspday * dayspyr) + atm2lnd_inst%forc_ndep_grz_grc(bounds%begg:) = dataptr1d(:) / (secspday * dayspyr) case( 'manure_sgrz_crop') do g = bounds%begg,bounds%endg - if ( isinf(dataprt1d(g) ) then + if ( isinf(dataptr1d(g)) ) then atm2lnd_inst%forc_ndep_sgrz_grc(g) = 9.0e99_r8 else - atm2lnd_inst%forc_ndep_sgrz_grc(g) = dataprt1d(g) / (secspday * dayspyr) + atm2lnd_inst%forc_ndep_sgrz_grc(g) = dataptr1d(g) / (secspday * dayspyr) end if end do case( 'manure_ngrz_crop') do g = bounds%begg,bounds%endg - if ( isinf(dataprt1d(g) ) then + if ( isinf(dataptr1d(g)) ) then atm2lnd_inst%forc_ndep_ngrz_grc(g) = 9.0e99_r8 else - atm2lnd_inst%forc_ndep_ngrz_grc(g) = dataprt1d(g) / (secspday * dayspyr) + atm2lnd_inst%forc_ndep_ngrz_grc(g) = dataptr1d(g) / (secspday * dayspyr) end if end do case( 'manure_sgrz' ) do g = bounds%begg,bounds%endg - if ( isinf(dataprt1d(g) ) then + if ( isinf(dataptr1d(g)) ) then atm2lnd_inst%forc_ndep_sgrz_grc(g) = 9.0e99_r8 else - atm2lnd_inst%forc_ndep_sgrz_grc(g) = dataprt1d(g) / (secspday * dayspyr) + atm2lnd_inst%forc_ndep_sgrz_grc(g) = dataptr1d(g) / (secspday * dayspyr) end if end do case( 'manure_ngrz' ) do g = bounds%begg,bounds%endg - if ( isinf(dataprt1d(g) ) then + if ( isinf(dataptr1d(g)) ) then atm2lnd_inst%forc_ndep_ngrz_grc(g) = 9.0e99_r8 else - atm2lnd_inst%forc_ndep_ngrz_grc(g) = dataprt1d(g) / (secspday * dayspyr) + atm2lnd_inst%forc_ndep_ngrz_grc(g) = dataptr1d(g) / (secspday * dayspyr) end if end do case( 'fract_urea' ) - atm2lnd_inst%forc_ndep_urea_grc(:) = dataprt1d(:) + atm2lnd_inst%forc_ndep_urea_grc(bounds%begg:) = dataptr1d(:) case( 'fract_nitr' ) - atm2lnd_inst%forc_ndep_nitr_grc(:) = dataprt1d(:) + atm2lnd_inst%forc_ndep_nitr_grc(bounds%begg:) = dataptr1d(:) case( 'soilph' ) - atm2lnd_inst%forc_soilph_grc(:) = dataptr1d(:) + atm2lnd_inst%forc_soilph_grc(bounds%begg:) = dataptr1d(:) case default call endrun(msg=subName//'ERROR FAN stream variable is not handled'//trim(stream_varnames(n))//errMsg(sourcefile, __LINE__)) end select end do + dataptr1d => NULL() end subroutine fanstream_interp From 0fe26fc59ddae7c10e40eb87ae61908aa16a9503 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 14 Sep 2022 12:00:15 -0600 Subject: [PATCH 173/181] Make KONA test case a BGC-CROP compset and add a I1PT BGC-CROP compset --- cime_config/config_compsets.xml | 6 ++++++ cime_config/testdefs/testlist_clm.xml | 2 +- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index 649306b05a..26d34c9528 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -41,6 +41,12 @@ 2000_DATM%1PT_CLM51%BGC_SICE_SOCN_SROF_SGLC_SWAV + + I1PtClm51BgcCrop + 2000_DATM%1PT_CLM51%BGC-CROP_SICE_SOCN_SROF_SGLC_SWAV + + + IHist1PtClm51Bgc HIST_DATM%1PT_CLM51%BGC_SICE_SOCN_SROF_SGLC_SWAV diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index e31f519510..4042ab7dba 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -617,7 +617,7 @@ - + From 136d23f8afb7674b3dd43619dde7be98b1cb0793 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 14 Sep 2022 13:14:37 -0600 Subject: [PATCH 174/181] Mark FAN NUOPC threaded test as an expected fail --- cime_config/testdefs/ExpectedTestFails.xml | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/cime_config/testdefs/ExpectedTestFails.xml b/cime_config/testdefs/ExpectedTestFails.xml index ca15bbb044..32586c0616 100644 --- a/cime_config/testdefs/ExpectedTestFails.xml +++ b/cime_config/testdefs/ExpectedTestFails.xml @@ -37,6 +37,13 @@ + + + FAIL + Threaded issues with FAN + + + From d08dbd98120ac83da4116e4a3740e52ed11f14b0 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 16 Sep 2022 01:54:51 -0600 Subject: [PATCH 175/181] Update cmeps externals with changes needed for FAN --- Externals.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals.cfg b/Externals.cfg index 08f2ceb0b6..3c2e1e3461 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -49,7 +49,7 @@ required = True [cmeps] #tag = cmeps0.13.71 -hash = d02b30cdd898affe8d383bf9bdc24aaf3c27b059 +hash = 1fce4310845bff83de67d4fa52be09a02ef1954c #branch = fancpl2-up-merge protocol = git repo_url = https://github.com/ekluzek/CMEPS.git From 90f5e397587db74e00233bc693e802112499d6c9 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 16 Sep 2022 01:55:49 -0600 Subject: [PATCH 176/181] Set FAN meshfile and make name consistent with new CMEPS --- bld/CLMBuildNamelist.pm | 3 +++ bld/namelist_files/namelist_defaults_ctsm.xml | 1 + bld/namelist_files/namelist_definition_ctsm.xml | 5 +++++ src/biogeochem/Fan2CTSMMod.F90 | 5 +++-- src/cpl/nuopc/lnd_import_export.F90 | 2 +- src/cpl/share_esmf/fanStreamMod.F90 | 11 ++++++++--- 6 files changed, 21 insertions(+), 6 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 48c4954325..5596e3447e 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -3327,6 +3327,9 @@ sub setup_logic_fan { 'sim_year'=>$nl_flags->{'sim_year'}, 'sim_year_range'=>$nl_flags->{'sim_year_range'}); #} add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_fldfilename_fan'); + if ($opts->{'driver'} eq "nuopc" ) { + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'stream_meshfile_fan'); + } add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fan_to_bgc_crop', 'fan_mode'=>$fan_mode); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fan_to_bgc_veg', diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 04b14bfd49..ef09327204 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -1557,6 +1557,7 @@ lnd/clm2/surfdata_map/release-clm5.0.30/surfdata_ne0np4.CONUS.ne30x8_hist_78pfts 2010 lnd/clm2/paramdata/FAN_nitrogen_soilph_fv1.9x2.5_simyr2010_c20190905.nc +share/meshes/fv1.9x2.5_141008_ESMFmesh_c20191001.nc bilinear diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index b57adbea9f..59bd015645 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -1722,6 +1722,11 @@ Simulation year that aligns with stream_year_first_fan value Filename of input stream data for FAN Nitrogen (manure) Deposition + +Stream meshfile for FAN Nitrogen (manure) Deposition data + + Mapping method from FAN Nitrogen (manure) deposition input file to the model resolution diff --git a/src/biogeochem/Fan2CTSMMod.F90 b/src/biogeochem/Fan2CTSMMod.F90 index 1c1293d51f..8c36e717ad 100644 --- a/src/biogeochem/Fan2CTSMMod.F90 +++ b/src/biogeochem/Fan2CTSMMod.F90 @@ -144,11 +144,12 @@ subroutine fan_readnml(NLFilename) integer :: stream_year_last_fan ! last year in stream to use integer :: model_year_align_fan ! align stream_year_firstndep2 with character(len=CL) :: stream_fldFileName_fan + character(len=CL) :: stream_meshFile_fan character(len=CL) :: fan_mapalgo namelist /fan_nml/ fan_to_bgc_crop, fan_to_bgc_veg, stream_year_first_fan, & stream_year_last_fan, model_year_align_fan, fan_mapalgo, stream_fldFileName_fan, & - fract_spread_grass, nh4_ads_coef + stream_meshFile_fan, fract_spread_grass, nh4_ads_coef if (.not. use_fan) return @@ -169,7 +170,7 @@ subroutine fan_readnml(NLFilename) end if call set_bcast_fanstream_pars(stream_year_first_fan, stream_year_last_fan, & - model_year_align_fan, fan_mapalgo, stream_fldFileName_fan, crop_man_is4crop_area) + model_year_align_fan, fan_mapalgo, stream_fldFileName_fan, stream_meshFile_fan, crop_man_is4crop_area) call shr_mpi_bcast(fan_to_bgc_crop, mpicom) call shr_mpi_bcast(fan_to_bgc_veg, mpicom) diff --git a/src/cpl/nuopc/lnd_import_export.F90 b/src/cpl/nuopc/lnd_import_export.F90 index de4ba7ee1d..afea839012 100644 --- a/src/cpl/nuopc/lnd_import_export.F90 +++ b/src/cpl/nuopc/lnd_import_export.F90 @@ -132,7 +132,7 @@ module lnd_import_export character(*), parameter :: Fall_fco2_lnd = 'Fall_fco2_lnd' character(*), parameter :: Sl_ddvel = 'Sl_ddvel' character(*), parameter :: Fall_voc = 'Fall_voc' - character(*), parameter :: Fall_fan = 'Fall_FANflxnh3' + character(*), parameter :: Fall_fan = 'Fall_FAN_nh3' character(*), parameter :: Fall_fire = 'Fall_fire' character(*), parameter :: Sl_fztop = 'Sl_fztop' character(*), parameter :: Flrl_rofsur = 'Flrl_rofsur' diff --git a/src/cpl/share_esmf/fanStreamMod.F90 b/src/cpl/share_esmf/fanStreamMod.F90 index ad97e43215..89f1b5cdf2 100644 --- a/src/cpl/share_esmf/fanStreamMod.F90 +++ b/src/cpl/share_esmf/fanStreamMod.F90 @@ -32,6 +32,7 @@ module FanStreamMod integer :: stream_year_last_fan = ispval ! last year in stream to use integer :: model_year_align_fan = ispval ! align year to align model years with FAN streams character(len=CL) :: stream_fldFileName_fan ! FAN stream filename + character(len=CL) :: stream_meshFile_fan ! FAN mesh filename character(len=CL) :: fan_mapalgo = 'bilinear' ! FAN stream mapping algorithm integer, parameter :: nFields = 6 character(len=16) :: stream_varnames(nFields) ! array of stream field names @@ -44,7 +45,7 @@ module FanStreamMod !============================================================================== - subroutine set_bcast_fanstream_pars(str_yr_first, str_yr_last, mdl_yr_align, mapalgo, str_filename, crop_man_is_percrop) + subroutine set_bcast_fanstream_pars(str_yr_first, str_yr_last, mdl_yr_align, mapalgo, str_filename, str_meshname, crop_man_is_percrop) !----------------------------------------------------------------------- ! ! Set the FAN stream namelist parameters @@ -57,13 +58,14 @@ subroutine set_bcast_fanstream_pars(str_yr_first, str_yr_last, mdl_yr_align, map integer, intent(in) :: str_yr_first, str_yr_last, mdl_yr_align ! whether manure_sgrz and manure_ngrz are per crop or land area: logical, intent(in) :: crop_man_is_percrop - character(len=*), intent(in) :: str_filename, mapalgo + character(len=*), intent(in) :: str_filename, str_meshname, mapalgo !----------------------------------------------------------------------- stream_year_first_fan = str_yr_first stream_year_last_fan = str_yr_last model_year_align_fan = mdl_yr_align stream_fldFileName_fan = str_filename + stream_meshFile_fan = str_meshname crop_manure_per_crop = crop_man_is_percrop fan_mapalgo = mapalgo @@ -71,6 +73,7 @@ subroutine set_bcast_fanstream_pars(str_yr_first, str_yr_last, mdl_yr_align, map call shr_mpi_bcast(stream_year_last_fan, mpicom) call shr_mpi_bcast(model_year_align_fan, mpicom) call shr_mpi_bcast(stream_fldFileName_fan, mpicom) + call shr_mpi_bcast(stream_meshFile_fan, mpicom) call shr_mpi_bcast(crop_manure_per_crop, mpicom) call shr_mpi_bcast(fan_mapalgo, mpicom) @@ -133,6 +136,8 @@ subroutine fanstream_init(bounds, NLFilename) write(iulog,*) ' stream_year_last_fan = ',stream_year_last_fan write(iulog,*) ' model_year_align_fan = ',model_year_align_fan write(iulog,*) ' stream_fldFileName_fan = ',stream_fldFileName_fan + write(iulog,*) ' stream_meshFile_fan = ',stream_meshFile_fan + write(iulog,*) ' stream_varnames = ',stream_varnames write(iulog,*) ' ' endif ! @@ -143,7 +148,7 @@ subroutine fanstream_init(bounds, NLFilename) compname = 'LND', & model_clock = model_clock, & model_mesh = mesh, & - stream_meshfile = "filethisin", & + stream_meshfile = stream_meshFile_fan, & stream_lev_dimname = 'null', & stream_mapalgo = fan_mapalgo, & stream_filenames = (/trim(stream_fldFileName_fan)/), & From 22e0add8eb99443eff7b9c8079b20e74f4452a51 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 16 Sep 2022 13:37:29 -0600 Subject: [PATCH 177/181] Update cpl7 so shr_fan_mod is included --- Externals.cfg | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Externals.cfg b/Externals.cfg index 3c2e1e3461..e7d138bf53 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -70,7 +70,7 @@ protocol = git repo_url = https://github.com/ekluzek/CESM_CPL7andDataComps local_path = components/cpl7 #branch = fancpl2-up-merge -hash = ae5cee2a7fe4fa111778119939fb3e7868cf8d06 +hash = 52afc38938202889ca42925407e77d89ca288623 required = True [share] From 020704cc0fb985e8454456b8b8a2eb5fca918369 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Fri, 16 Sep 2022 15:44:25 -0600 Subject: [PATCH 178/181] Add dummy_mesh argument, because it's required for the NUOPC interface, internally it can be ignored --- src/cpl/mct/fanStreamMod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/cpl/mct/fanStreamMod.F90 b/src/cpl/mct/fanStreamMod.F90 index b261879631..7e512ae7aa 100644 --- a/src/cpl/mct/fanStreamMod.F90 +++ b/src/cpl/mct/fanStreamMod.F90 @@ -49,16 +49,18 @@ module FanStreamMod !============================================================================== - subroutine set_bcast_fanstream_pars(str_yr_first, str_yr_last, mdl_yr_align, mapalgo, str_filename, crop_man_is_percrop) + subroutine set_bcast_fanstream_pars(str_yr_first, str_yr_last, mdl_yr_align, mapalgo, str_filename, & + dummy_mesh, crop_man_is_percrop) integer, intent(in) :: str_yr_first, str_yr_last, mdl_yr_align ! whether manure_sgrz and manure_ngrz are per crop or land area: logical, intent(in) :: crop_man_is_percrop - character(len=*), intent(in) :: str_filename, mapalgo + character(len=*), intent(in) :: str_filename, dummy_mesh, mapalgo stream_year_first_fan = str_yr_first stream_year_last_fan = str_yr_last model_year_align_fan = mdl_yr_align stream_fldFileName_fan = str_filename + ! Note dummy_mesh file is ignored crop_manure_per_crop = crop_man_is_percrop fan_mapalgo = mapalgo From 625c225c714937033d47cc7ddba67ea072df4410 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 21 Sep 2022 15:56:42 -0600 Subject: [PATCH 179/181] Add shr_assert to check array size, and switch to loops over array copies, as well as properly adjusting g index by begg --- src/cpl/share_esmf/fanStreamMod.F90 | 28 ++++++++++++++++++++-------- 1 file changed, 20 insertions(+), 8 deletions(-) diff --git a/src/cpl/share_esmf/fanStreamMod.F90 b/src/cpl/share_esmf/fanStreamMod.F90 index 89f1b5cdf2..d45f688460 100644 --- a/src/cpl/share_esmf/fanStreamMod.F90 +++ b/src/cpl/share_esmf/fanStreamMod.F90 @@ -1,5 +1,7 @@ module FanStreamMod +#include "shr_assert.h" + !----------------------------------------------------------------------- ! Contains methods for reading in FAN nitrogen deposition (in the form of ! manure) data file @@ -205,6 +207,8 @@ subroutine fanstream_interp(bounds, atm2lnd_inst) real(r8), pointer :: dataptr1d(:) ! Temporary data array to put stream data into character(*), parameter :: subName = "('fanstream_interp')" !----------------------------------------------------------------------- + SHR_ASSERT_FL( (lbound(atm2lnd_inst%forc_ndep_grz_grc,1) == bounds%begg ), sourcefile, __LINE__) + SHR_ASSERT_FL( (ubound(atm2lnd_inst%forc_ndep_grz_grc,1) == bounds%endg ), sourcefile, __LINE__) call get_curr_date(year, mon, day, sec) mcdate = year*10000 + mon*100 + day @@ -224,13 +228,15 @@ subroutine fanstream_interp(bounds, atm2lnd_inst) end if select case( trim(stream_varnames(n)) ) case( 'manure_grz') - atm2lnd_inst%forc_ndep_grz_grc(bounds%begg:) = dataptr1d(:) / (secspday * dayspyr) + do g = bounds%begg,bounds%endg + atm2lnd_inst%forc_ndep_grz_grc(g) = dataptr1d(g-bounds%begg+1) / (secspday * dayspyr) + end do case( 'manure_sgrz_crop') do g = bounds%begg,bounds%endg if ( isinf(dataptr1d(g)) ) then atm2lnd_inst%forc_ndep_sgrz_grc(g) = 9.0e99_r8 else - atm2lnd_inst%forc_ndep_sgrz_grc(g) = dataptr1d(g) / (secspday * dayspyr) + atm2lnd_inst%forc_ndep_sgrz_grc(g) = dataptr1d(g-bounds%begg+1) / (secspday * dayspyr) end if end do case( 'manure_ngrz_crop') @@ -238,7 +244,7 @@ subroutine fanstream_interp(bounds, atm2lnd_inst) if ( isinf(dataptr1d(g)) ) then atm2lnd_inst%forc_ndep_ngrz_grc(g) = 9.0e99_r8 else - atm2lnd_inst%forc_ndep_ngrz_grc(g) = dataptr1d(g) / (secspday * dayspyr) + atm2lnd_inst%forc_ndep_ngrz_grc(g) = dataptr1d(g-bounds%begg+1) / (secspday * dayspyr) end if end do case( 'manure_sgrz' ) @@ -246,7 +252,7 @@ subroutine fanstream_interp(bounds, atm2lnd_inst) if ( isinf(dataptr1d(g)) ) then atm2lnd_inst%forc_ndep_sgrz_grc(g) = 9.0e99_r8 else - atm2lnd_inst%forc_ndep_sgrz_grc(g) = dataptr1d(g) / (secspday * dayspyr) + atm2lnd_inst%forc_ndep_sgrz_grc(g) = dataptr1d(g-bounds%begg+1) / (secspday * dayspyr) end if end do case( 'manure_ngrz' ) @@ -254,15 +260,21 @@ subroutine fanstream_interp(bounds, atm2lnd_inst) if ( isinf(dataptr1d(g)) ) then atm2lnd_inst%forc_ndep_ngrz_grc(g) = 9.0e99_r8 else - atm2lnd_inst%forc_ndep_ngrz_grc(g) = dataptr1d(g) / (secspday * dayspyr) + atm2lnd_inst%forc_ndep_ngrz_grc(g) = dataptr1d(g-bounds%begg+1) / (secspday * dayspyr) end if end do case( 'fract_urea' ) - atm2lnd_inst%forc_ndep_urea_grc(bounds%begg:) = dataptr1d(:) + do g = bounds%begg,bounds%endg + atm2lnd_inst%forc_ndep_urea_grc(g) = dataptr1d(g-bounds%begg+1) + end do case( 'fract_nitr' ) - atm2lnd_inst%forc_ndep_nitr_grc(bounds%begg:) = dataptr1d(:) + do g = bounds%begg,bounds%endg + atm2lnd_inst%forc_ndep_nitr_grc(g) = dataptr1d(g-bounds%begg+1) + end do case( 'soilph' ) - atm2lnd_inst%forc_soilph_grc(bounds%begg:) = dataptr1d(:) + do g = bounds%begg,bounds%endg + atm2lnd_inst%forc_soilph_grc(g)= dataptr1d(g-bounds%begg+1) + end do case default call endrun(msg=subName//'ERROR FAN stream variable is not handled'//trim(stream_varnames(n))//errMsg(sourcefile, __LINE__)) end select From 84f9ca3e9208eac1646053bdd1381fb0f2a4529c Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Wed, 21 Sep 2022 16:17:30 -0600 Subject: [PATCH 180/181] Change izumi_nag non debug tests to izumi_intel for FAN since DEBUG tests fail for nag --- cime_config/testdefs/testlist_clm.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/testdefs/testlist_clm.xml b/cime_config/testdefs/testlist_clm.xml index 4042ab7dba..cefb5daa88 100644 --- a/cime_config/testdefs/testlist_clm.xml +++ b/cime_config/testdefs/testlist_clm.xml @@ -539,7 +539,7 @@ - + @@ -590,7 +590,7 @@ - + From 326bd8c0b2df6ded3d16e91e74cffcbc83548f35 Mon Sep 17 00:00:00 2001 From: Erik Kluzek Date: Thu, 22 Sep 2022 16:21:04 -0600 Subject: [PATCH 181/181] Add a stub ROF Hist Clm51 Bgc-Crop compset --- cime_config/config_compsets.xml | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml index 26d34c9528..e367e56757 100644 --- a/cime_config/config_compsets.xml +++ b/cime_config/config_compsets.xml @@ -296,6 +296,11 @@ HIST_DATM%GSWP3v1_CLM51%BGC-CROP_SICE_SOCN_MOSART_SGLC_SWAV + + IHistClm51BgcCropRs + HIST_DATM%GSWP3v1_CLM51%BGC-CROP_SICE_SOCN_SROF_SGLC_SWAV + + IHistClm50Sp HIST_DATM%GSWP3v1_CLM50%SP_SICE_SOCN_MOSART_SGLC_SWAV