diff --git a/cime/machines-acme/env_mach_specific.edison b/cime/machines-acme/env_mach_specific.edison index 9a4afbba5bbe..e22ddc6c1b77 100755 --- a/cime/machines-acme/env_mach_specific.edison +++ b/cime/machines-acme/env_mach_specific.edison @@ -19,12 +19,12 @@ echo "DEBUG=$DEBUG" if (-e /opt/modules/default/init/csh) then source /opt/modules/default/init/csh module rm PrgEnv-intel - module rm PrgEnv-cray + module rm PrgEnv-cray module rm PrgEnv-gnu module rm intel module rm cce module rm cray-parallel-netcdf - module rm cray-parallel-hdf5 + module rm cray-parallel-hdf5 module rm pmi module rm cray-libsci module rm cray-mpich2 @@ -46,8 +46,8 @@ if ( $COMPILER == "intel" ) then module load esmf/6.2.0-defio-mpi-g else module load esmf/6.2.0-defio-mpi-O - endif -endif + endif +endif if ( $COMPILER == "cray" ) then module load PrgEnv-cray module switch cce cce/8.3.7 @@ -55,7 +55,7 @@ endif if ( $COMPILER == "gnu" ) then module load PrgEnv-gnu module switch gcc gcc/4.8.0 -endif +endif module load papi/5.3.2 module swap craype craype/2.1.1 diff --git a/components/clm/bld/CLMBuildNamelist.pm b/components/clm/bld/CLMBuildNamelist.pm index 462384233034..7f2031de99b8 100755 --- a/components/clm/bld/CLMBuildNamelist.pm +++ b/components/clm/bld/CLMBuildNamelist.pm @@ -217,6 +217,7 @@ OPTIONS -version Echo the SVN tag name used to check out this CLM distribution. -vichydro Toggle to turn on VIC hydrologic parameterizations (default is off) This turns on the namelist variable: use_vichydro + -betr_mode Turn on betr model for tracer transport in soil. [on|off] default is off. Note: The precedence for setting the values of namelist variables is (highest to lowest): @@ -278,6 +279,7 @@ sub process_commandline { envxml_dir => ".", vichydro => 0, maxpft => "default", + betr_mode => "default", ); GetOptions( @@ -322,6 +324,7 @@ sub process_commandline { "maxpft=i" => \$opts{'maxpft'}, "v|verbose" => \$opts{'verbose'}, "version" => \$opts{'version'}, + "betr_mode=s" => \$opts{'betr_mode'}, ) or usage(); # Give usage message. @@ -641,6 +644,7 @@ sub process_namelist_commandline_options { setup_cmdl_dynamic_vegetation($opts, $nl_flags, $definition, $defaults, $nl, $physv); setup_cmdl_ed_mode($opts, $nl_flags, $definition, $defaults, $nl, $physv); setup_cmdl_vichydro($opts, $nl_flags, $definition, $defaults, $nl, $physv); + setup_cmdl_betr_mode($opts, $nl_flags, $definition, $defaults, $nl, $physv); } #------------------------------------------------------------------------------- @@ -762,6 +766,49 @@ sub setup_cmdl_ed_mode { } } +#------------------------------------------------------------------------------- +sub setup_cmdl_betr_mode { + # + # call this at least after crop check is called + # + my ($opts, $nl_flags, $definition, $defaults, $nl, $physv) = @_; + + my $val; + my $var = "betr_mode"; + + $val = $opts->{$var}; + $nl_flags->{'betr_mode'} = $val; + + if ( $physv->as_long() == $physv->as_long("clm4_0") || $nl_flags->{'crop'} eq "on" ) { + if ( $nl_flags->{'ed_mode'} == 1 ) { + # ED is not a clm4_0 option and should not be used with crop and not with clm4_0 + fatal_error("** Cannot turn betr mode on with crop or with clm4_0 physics.\n" ); + } + } else { + + $var = "use_betr"; + $nl_flags->{$var} = ".false."; + if ($nl_flags->{'betr_mode'} eq "on") { + message("Using BETR (Reactive Transport)."); + $val = ".true."; + $nl_flags->{$var} = $val; + } + if ( defined($nl->get_value($var)) && $nl->get_value($var) ne $val ) { + fatal_error("$var is inconsistent with the commandline setting of -betr_mode"); + } + if ( $nl_flags->{$var} eq ".true." ) { + my $group = $definition->get_group_name($var); + $nl->set_variable_value($group, $var, $val); + if ( ! $definition->is_valid_value( $var, $val ) ) { + my @valid_values = $definition->get_valid_values( $var ); + fatal_error("$var has a value ($val) that is NOT valid. Valid values are: @valid_values\n"); + } + + } + } +} + + #------------------------------------------------------------------------------- sub setup_cmdl_bgc { # BGC - alias for group of biogeochemistry related use_XXX namelists @@ -2759,7 +2806,7 @@ sub write_output_files { } else { @groups = qw(clm_inparm ndepdyn_nml popd_streams light_streams lai_streams clm_canopyhydrology_inparm clm_soilhydrology_inparm dynamic_subgrid finidat_consistency_checks dynpft_consistency_checks - clmu_inparm clm_soilstate_inparm clm_pflotran_inparm ); + clmu_inparm clm_soilstate_inparm clm_pflotran_inparm betr_inparm); #@groups = qw(clm_inparm clm_canopyhydrology_inparm clm_soilhydrology_inparm # finidat_consistency_checks dynpft_consistency_checks); # Eventually only list namelists that are actually used when CN on diff --git a/components/clm/bld/configure b/components/clm/bld/configure index 4a1a54efac52..9adc0b1edb0f 100755 --- a/components/clm/bld/configure +++ b/components/clm/bld/configure @@ -645,7 +645,12 @@ sub write_filepath_cesmbld # source directories under root my @dirs = ( "main", - "biogeophys", + "betr", + "betr/betr_math", + "betr/betr_core", + "betr/bgc_century", + "betr/bgc_sminn", + "biogeophys", "biogeochem", "dyn_subgrid", "ED", diff --git a/components/clm/bld/namelist_files/namelist_definition_clm4_5.xml b/components/clm/bld/namelist_files/namelist_definition_clm4_5.xml index d1547a2fe2de..1fd760e1534f 100644 --- a/components/clm/bld/namelist_files/namelist_definition_clm4_5.xml +++ b/components/clm/bld/namelist_files/namelist_definition_clm4_5.xml @@ -198,6 +198,11 @@ This downscaling is conservative. Default: .true. + +Toggle to turn on the BeTR +(BETR = 'on' is EXPERIMENTAL NOT SUPPORTED!) + @@ -1275,6 +1280,14 @@ reaches melting when ice is present with no snow layers. Represents puddling, ic Set to alblak values (0.6, 0.4) to keep albedo constant for ice-covered lakes without snow layers. + + + + +Specify what bgc module will be used within the betr framework. + + diff --git a/components/clm/bld/test_build_namelist/t/input/namelist_definition_clm4_5_test.xml b/components/clm/bld/test_build_namelist/t/input/namelist_definition_clm4_5_test.xml index 7b9cd85cc407..81402ba86372 100644 --- a/components/clm/bld/test_build_namelist/t/input/namelist_definition_clm4_5_test.xml +++ b/components/clm/bld/test_build_namelist/t/input/namelist_definition_clm4_5_test.xml @@ -1159,6 +1159,14 @@ reaches melting when ice is present with no snow layers. Represents puddling, ic Set to alblak values (0.6, 0.4) to keep albedo constant for ice-covered lakes without snow layers. + + + + +Specify what bgc module will be used within the betr framework. + + diff --git a/components/clm/bld/unit_testers/build-namelist_test.pl b/components/clm/bld/unit_testers/build-namelist_test.pl index 2bfcfa7b192a..4e829aa67eb6 100755 --- a/components/clm/bld/unit_testers/build-namelist_test.pl +++ b/components/clm/bld/unit_testers/build-namelist_test.pl @@ -507,6 +507,11 @@ sub make_env_run { GLC_TWO_WAY_COUPLING=>"FALSE", conopts=>"-phys clm4_5", }, + "useBETRContradict" =>{ options=>"-betr_mode -envxml_dir .", + namelst=>"use_betr=.false.", + GLC_TWO_WAY_COUPLING=>"FALSE", + conopts=>"-phys clm4_5", + }, "useEDContradict2" =>{ options=>"-envxml_dir .", namelst=>"use_ed=.true.", GLC_TWO_WAY_COUPLING=>"FALSE", diff --git a/components/clm/src/betr/BGCReactionsFactoryMod.F90 b/components/clm/src/betr/BGCReactionsFactoryMod.F90 new file mode 100644 index 000000000000..ffc441759773 --- /dev/null +++ b/components/clm/src/betr/BGCReactionsFactoryMod.F90 @@ -0,0 +1,76 @@ +module BGCReactionsFactoryMod + ! + ! !DESCRIPTION: + ! factory to load the specific bgc reaction modules + ! + ! History: + ! Created by Jinyun Tang, Oct 2, 2014 + ! + ! + ! !USES: + ! + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use shr_log_mod , only : errMsg => shr_log_errMsg + implicit none + save + private + public :: ctreate_bgc_reaction_type + + +contains + + function ctreate_bgc_reaction_type(method) result(bgc_reaction) + ! + ! !DESCRIPTION: + ! create and return an object of bgc_reaction + ! + ! !USES: + use BGCReactionsMod , only : bgc_reaction_type + use BGCReactionsMockRunType , only : bgc_reaction_mock_run_type + use BGCReactionsCenturyType , only : bgc_reaction_CENTURY_type + use BGCReactionsCenturyCLMType , only : bgc_reaction_CENTURY_clm_type + use BGCReactionsCenturyECAType , only : bgc_reaction_CENTURY_ECA_type + use BGCReactionsSminNType , only : bgc_reaction_sminn_type + use BGCReactionsCenturyCLM3Type , only : bgc_reaction_CENTURY_clm3_type + use BGCReactionsCenturyCLMOType , only : bgc_reaction_CENTURY_clmo_type + use abortutils , only : endrun + use clm_varctl , only : iulog + use tracer_varcon , only : is_active_betr_bgc, do_betr_leaching + + ! !ARGUMENTS: + class(bgc_reaction_type), allocatable :: bgc_reaction + character(len=*), intent(in) :: method + character(len=*), parameter :: subname = 'ctreate_bgc_reaction_type' + + select case(trim(method)) + case ("mock_run") + allocate(bgc_reaction, source=bgc_reaction_mock_run_type()) + case ("century_bgc") + is_active_betr_bgc = .true. + allocate(bgc_reaction, source=bgc_reaction_CENTURY_type()) + case ("century_bgcclm") + is_active_betr_bgc = .true. + allocate(bgc_reaction, source=bgc_reaction_CENTURY_clm_type()) + case ("century_bgcECA") + is_active_betr_bgc = .true. + allocate(bgc_reaction, source=bgc_reaction_CENTURY_ECA_type()) + case ("century_bgcclm3") + is_active_betr_bgc=.true. + allocate(bgc_reaction, source=bgc_reaction_CENTURY_clm3_type()) + case ("century_bgcclmo") + is_active_betr_bgc=.true. + allocate(bgc_reaction, source=bgc_reaction_CENTURY_clmo_type()) + case ("betr_sminn") + !this must be used together with clm45bgc + do_betr_leaching = .true. + allocate(bgc_reaction, source=bgc_reaction_sminn_type()) + !case ("o18_istope") ! on hold + ! allocate(bgc_reaction, source=bgc_reaction_O18ISO_type()) + case default + write(iulog,*)subname //' ERROR: unknown method: ', method + call endrun(msg=errMsg(__FILE__, __LINE__)) + end select + end function ctreate_bgc_reaction_type + +end module BGCReactionsFactoryMod diff --git a/components/clm/src/betr/BGCReactionsMockRunType.F90 b/components/clm/src/betr/BGCReactionsMockRunType.F90 new file mode 100644 index 000000000000..e34e4b3c7a36 --- /dev/null +++ b/components/clm/src/betr/BGCReactionsMockRunType.F90 @@ -0,0 +1,460 @@ +module BGCReactionsMockRunType + +#include "shr_assert.h" + ! + ! !DESCRIPTION: + ! This is an example on how to use polymorphism to create your own bgc modules that will be run with BeTR + ! + ! HISTORY: + ! Created by Jinyun Tang, Oct 2nd, 2014 + ! !USES: + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use BGCReactionsMod , only : bgc_reaction_type + use tracer_varcon , only : bndcond_as_conc, bndcond_as_flux + use LandunitType , only : lun + use ColumnType , only : col + implicit none + + save + private + ! + ! !PUBLIC TYPES: + public :: bgc_reaction_mock_run_type + + type, extends(bgc_reaction_type) :: & + bgc_reaction_mock_run_type + private + contains + procedure :: Init_betrbgc ! initialize betr bgc + procedure :: set_boundary_conditions ! set top/bottom boundary conditions for various tracers + procedure :: calc_bgc_reaction ! doing bgc calculation + procedure :: init_boundary_condition_type ! initialize type of top boundary conditions + procedure :: do_tracer_equilibration ! do equilibrium tracer chemistry + procedure :: InitCold ! do cold initialization + procedure :: readParams ! read in parameters + procedure :: betr_alm_flux_statevar_feedback ! + procedure :: init_betr_alm_bgc_coupler + end type bgc_reaction_mock_run_type + + interface bgc_reaction_mock_run_type + module procedure constructor + end interface bgc_reaction_mock_run_type + +contains + !------------------------------------------------------------------------------- + type(bgc_reaction_mock_run_type) function constructor() + ! + ! !DESCRIPTION: + ! create an object of type bgc_reaction_mock_run_type. + ! Right now it is purposely empty + + end function constructor + + !------------------------------------------------------------------------------- + subroutine init_boundary_condition_type(this, bounds, betrtracer_vars, tracerboundarycond_vars ) + ! + ! !DESCRIPTION: + ! initialize boundary condition types + ! + ! !USES: + use BeTRTracerType , only : betrtracer_type + use TracerBoundaryCondType, only : tracerboundarycond_type + use BeTRTracerType , only : betrtracer_type + + ! !ARGUMENTS: + class(bgc_reaction_mock_run_type), intent(in) :: this + type(BeTRtracer_type ), intent(in) :: betrtracer_vars + type(bounds_type), intent(in) :: bounds + type(tracerboundarycond_type), intent(in) :: tracerboundarycond_vars + + ! !LOCAL VARIABLES: + integer, parameter :: bndcond_as_conc = 1 ! top boundary condition as tracer concentration + integer, parameter :: bndcond_as_flx = 2 ! top boundary condition as tracer flux + + tracerboundarycond_vars%topbc_type(:) = bndcond_as_conc + + end subroutine init_boundary_condition_type + + !------------------------------------------------------------------------------- + subroutine Init_betrbgc(this, bounds, lbj, ubj, betrtracer_vars) + ! + ! DESCRIPTION: + ! initialize the betrbgc + ! + ! !USES: + use BeTRTracerType , only : betrtracer_type + use MathfuncMod , only : addone + + ! !ARGUMENTS: + class(bgc_reaction_mock_run_type), intent(in) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: lbj, ubj + type(BeTRtracer_type ) , intent(inout) :: betrtracer_vars + + character(len=*), parameter :: subname ='Init_betrbgc' + + integer :: itemp_gwm + integer :: itemp_g + integer :: itemp_s + integer :: itemp_gwm_grp + integer :: dum + integer :: itemp_grp, itemp_v, itemp_vgrp + + itemp_gwm = 0; + itemp_g = 0 ; + itemp_s = 0; + itemp_gwm_grp = 0 + + betrtracer_vars%id_trc_n2 = addone(itemp_gwm); dum = addone(itemp_g); dum = addone(itemp_gwm_grp) + betrtracer_vars%id_trc_o2 = addone(itemp_gwm); dum = addone(itemp_g); dum = addone(itemp_gwm_grp) + betrtracer_vars%id_trc_ar = addone(itemp_gwm); dum = addone(itemp_g); dum = addone(itemp_gwm_grp) + betrtracer_vars%id_trc_co2x= addone(itemp_gwm); dum = addone(itemp_g); dum = addone(itemp_gwm_grp) + betrtracer_vars%id_trc_ch4 = addone(itemp_gwm); dum = addone(itemp_g); dum = addone(itemp_gwm_grp) + + betrtracer_vars%ngwmobile_tracers = itemp_gwm; betrtracer_vars%ngwmobile_tracer_groups= itemp_gwm_grp + betrtracer_vars%nsolid_passive_tracers = itemp_s; betrtracer_vars%nsolid_passive_tracer_groups = itemp_s + betrtracer_vars%nvolatile_tracers = itemp_g; betrtracer_vars%nvolatile_tracer_groups= itemp_g + betrtracer_vars%nmem_max = 1 + + call betrtracer_vars%Init() + + itemp_grp = 0 !group id + itemp_v = 0 !volatile id + itemp_vgrp = 0 !volatile group + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_n2, trc_name='N2' , & + is_trc_mobile=.true., is_trc_advective = .true., trc_group_id = addone(itemp_grp), & + trc_group_mem= 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_o2, trc_name='O2' , & + is_trc_mobile=.true., is_trc_advective = .true., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_ar, trc_name='AR' , & + is_trc_mobile=.true., is_trc_advective = .true., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_co2x, trc_name='CO2x', & + is_trc_mobile=.true., is_trc_advective = .true., trc_group_id = addone(itemp_grp) , & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp) ) + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_ch4, trc_name='CH4', & + is_trc_mobile=.true., is_trc_advective = .true., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + end subroutine Init_betrbgc + + !------------------------------------------------------------------------------- + subroutine set_boundary_conditions(this, bounds, num_soilc, filter_soilc, dz_top, betrtracer_vars, & + waterflux_vars, tracerboundarycond_vars) + ! + ! !DESCRIPTION: + ! set up boundary conditions for tracer movement + ! + ! !USES: + use clm_varctl , only : iulog + use TracerBoundaryCondType, only : tracerboundarycond_type + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + use BeTRTracerType , only : betrtracer_type + use WaterfluxType , only : waterflux_type + + ! !ARGUMENTS: + class(bgc_reaction_mock_run_type) , intent(in) :: this ! + type(bounds_type) , intent(in) :: bounds ! + integer , intent(in) :: num_soilc ! number of columns in column filter_soilc + integer , intent(in) :: filter_soilc(:) ! column filter_soilc + type(betrtracer_type) , intent(in) :: betrtracer_vars ! + real(r8) , intent(in) :: dz_top(bounds%begc: ) ! + type(waterflux_type) , intent(in) :: waterflux_vars ! + type(tracerboundarycond_type) , intent(inout) :: tracerboundarycond_vars ! + + + ! !LOCAL VARIABLES: + integer :: fc, c + character(len=255) :: subname = 'set_boundary_conditions' + + SHR_ASSERT_ALL((ubound(dz_top) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + + associate( & + groupid => betrtracer_vars%groupid & + ) + + do fc = 1, num_soilc + c = filter_soilc(fc) + + !eventually, the following code will be implemented using polymorphism + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_n2) = 32.8_r8 !mol m-3, contant boundary condition + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_o2) = 8.78_r8 !mol m-3, contant boundary condition + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_ar) = 0.3924_r8 !mol m-3, contant boundary condition + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_co2x) = 0.0168_r8 !mol m-3, contant boundary condition + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_ch4) = 6.939e-5_r8 !mol m-3, contant boundary condition + + tracerboundarycond_vars%bot_concflux_col(c,1,:) = 0._r8 !zero flux boundary condition + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_n2)) = 2._r8*1.837e-5_r8/dz_top(c) !m/s surface conductance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_o2)) = 2._r8*1.713e-5_r8/dz_top(c) !m/s surface conductance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_ar)) = 2._r8*1.532e-5_r8/dz_top(c) !m/s surface conductance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_co2x)) = 2._r8*1.399e-5_r8/dz_top(c) !m/s surface conductance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_ch4)) = 2._r8*1.808e-5_r8/dz_top(c) !m/s surface conductance + enddo + + end associate + end subroutine set_boundary_conditions + + !------------------------------------------------------------------------------- + subroutine calc_bgc_reaction(this, bounds, lbj, ubj, num_soilc, filter_soilc, num_soilp, filter_soilp, jtops, & + dtime, betrtracer_vars, tracercoeff_vars, waterstate_vars, temperature_vars, soilstate_vars, chemstate_vars, & + cnstate_vars, carbonstate_vars, carbonflux_vars,nitrogenstate_vars, nitrogenflux_vars, tracerstate_vars, & + tracerflux_vars, plantsoilnutrientflux_vars) + ! + ! !DESCRIPTION: + ! do bgc reaction + ! + ! !USES: + use tracerfluxType , only : tracerflux_type + use tracerstatetype , only : tracerstate_type + use tracercoeffType , only : tracercoeff_type + use BetrTracerType , only : betrtracer_type + use WaterStateType , only : Waterstate_Type + use TemperatureType , only : temperature_type + use SoilStatetype , only : soilstate_type + use ChemStateType , only : chemstate_type + use CanopyStateType , only : canopystate_type + use CNStateType , only : cnstate_type + use PlantSoilnutrientFluxType, only : plantsoilnutrientflux_type + use CNCarbonFluxType , only : carbonflux_type + use CNCarbonStateType , only : carbonstate_type + use CNNitrogenFluxType , only : nitrogenflux_type + use CNNitrogenStateType , only : nitrogenstate_type + !ARGUMENTS + class(bgc_reaction_mock_run_type) , intent(in) :: this ! + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_soilc ! number of columns in column filter_soilc + integer , intent(in) :: filter_soilc(:) ! column filter_soilc + integer , intent(in) :: num_soilp ! + integer , intent(in) :: filter_soilp(:) ! pft filter + integer , intent(in) :: jtops(bounds%begc: ) ! top index of each column + integer , intent(in) :: lbj, ubj ! lower and upper bounds, make sure they are > 0 + real(r8) , intent(in) :: dtime ! model time step + type(Waterstate_Type) , intent(in) :: waterstate_vars ! water state variables + type(temperature_type) , intent(in) :: temperature_vars ! energy state variable + type(soilstate_type) , intent(in) :: soilstate_vars ! + type(cnstate_type) , intent(inout) :: cnstate_vars ! + type(carbonstate_type) , intent(in) :: carbonstate_vars ! + type(carbonflux_type) , intent(inout) :: carbonflux_vars ! + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars ! + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars ! + type(chemstate_type) , intent(in) :: chemstate_vars ! + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(tracercoeff_type) , intent(in) :: tracercoeff_vars ! + type(tracerstate_type) , intent(inout) :: tracerstate_vars ! + type(tracerflux_type) , intent(inout) :: tracerflux_vars ! + type(plantsoilnutrientflux_type) , intent(inout) :: plantsoilnutrientflux_vars ! + + character(len=*) , parameter :: subname ='calc_bgc_reaction' + + end subroutine calc_bgc_reaction + + + !------------------------------------------------------------------------------- + subroutine do_tracer_equilibration(this, bounds, lbj, ubj, jtops, num_soilc, filter_soilc, & + betrtracer_vars, tracercoeff_vars, tracerstate_vars) + ! + ! DESCRIPTION: + ! requilibrate tracers that has solid and mobile phases + ! using the theory of mass action. + ! + ! !USES: + ! + + use tracerstatetype , only : tracerstate_type + use tracercoeffType , only : tracercoeff_type + use BeTRTracerType , only : betrtracer_type + use BeTRTracerType , only : betrtracer_type + + ! !ARGUMENTS: + class(bgc_reaction_mock_run_type), intent(in) :: this + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: lbj, ubj + integer, intent(in) :: jtops(bounds%begc: ) ! top label of each column + integer, intent(in) :: num_soilc + integer, intent(in) :: filter_soilc(:) + type(betrtracer_type), intent(in) :: betrtracer_vars + type(tracercoeff_type), intent(in) :: tracercoeff_vars + type(tracerstate_type), intent(inout) :: tracerstate_vars + character(len=255) :: subname = 'do_tracer_equilibration' + + + SHR_ASSERT_ALL((ubound(jtops) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + + !depending on the simulation type, an implementation of aqueous chemistry will be + !employed to separate out the adsorbed phase + !It should be noted that this formulation excludes the use of linear isotherm, which + !can be integrated through the retardation factor + + + end subroutine do_tracer_equilibration + + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds, betrtracer_vars, waterstate_vars, tracerstate_vars) + ! + ! !DESCRIPTION: + ! do cold initialization + ! + ! !USES: + use BeTRTracerType , only : BeTRTracer_Type + use tracerstatetype , only : tracerstate_type + use WaterstateType , only : waterstate_type + use PatchType , only : pft + use clm_varcon , only : spval, ispval + use landunit_varcon , only : istsoil, istcrop + + ! !ARGUMENTS: + class(bgc_reaction_mock_run_type) , intent(in) :: this + type(bounds_type) , intent(in) :: bounds + type(BeTRTracer_Type) , intent(in) :: betrtracer_vars + type(waterstate_type) , intent(in) :: waterstate_vars + type(tracerstate_type) , intent(inout) :: tracerstate_vars + + ! + ! !LOCAL VARIABLES: + integer :: p, c, l, k, j + integer :: fc ! filter_soilc index + integer :: begc, endc + integer :: begg, endg + !----------------------------------------------------------------------- + + begc = bounds%begc; endc= bounds%endc + begg = bounds%begg; endg= bounds%endg + !----------------------------------------------------------------------- + + + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if (lun%ifspecial(l)) then + if(betrtracer_vars%ngwmobile_tracers>0)then + tracerstate_vars%tracer_conc_mobile_col(c,:,:) = spval + tracerstate_vars%tracer_conc_surfwater_col(c,:) = spval + tracerstate_vars%tracer_conc_aquifer_col(c,:) = spval + tracerstate_vars%tracer_conc_grndwater_col(c,:) = spval + endif + if(betrtracer_vars%ntracers > betrtracer_vars%ngwmobile_tracers)then + tracerstate_vars%tracer_conc_solid_passive_col(c,:,:) = spval + endif + if(betrtracer_vars%nsolid_equil_tracers>0)then + tracerstate_vars%tracer_conc_solid_equil_col(c, :, :) = spval + endif + endif + tracerstate_vars%tracer_soi_molarmass_col(c,:) = spval + + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + !dual phase tracers + + tracerstate_vars%tracer_conc_mobile_col(c,:, :) = 0._r8 + tracerstate_vars%tracer_conc_surfwater_col(c,:) = 0._r8 + tracerstate_vars%tracer_conc_aquifer_col(c,:) = 0._r8 + tracerstate_vars%tracer_conc_grndwater_col(c,:) = 0._r8 + + + !solid tracers + if(betrtracer_vars%ngwmobile_tracers < betrtracer_vars%ntracers)then + tracerstate_vars%tracer_conc_solid_passive_col(c,:,:) = 0._r8 + endif + + if(betrtracer_vars%nsolid_equil_tracers>0)then + tracerstate_vars%tracer_conc_solid_equil_col(c, :, :) = 0._r8 + endif + tracerstate_vars%tracer_soi_molarmass_col(c,:) = 0._r8 + endif + enddo + + + end subroutine InitCold + + !----------------------------------------------------------------------- + subroutine readParams(this, ncid, betrtracer_vars) + ! + ! !DESCRIPTION: + ! read in module specific parameters + ! + ! !USES: + + use ncdio_pio , only : file_desc_t + use BeTRTracerType , only : BeTRTracer_Type + ! !ARGUMENTS: + class(bgc_reaction_mock_run_type) , intent(in) :: this + type(BeTRTracer_Type) , intent(inout) :: betrtracer_vars + type(file_desc_t) , intent(inout) :: ncid ! pio netCDF file id + + !do nothing here + end subroutine readParams + + !------------------------------------------------------------------------------- + subroutine betr_alm_flux_statevar_feedback(this, bounds, num_soilc, filter_soilc, & + carbonstate_vars, nitrogenstate_vars, nitrogenflux_vars, tracerstate_vars, & + tracerflux_vars, betrtracer_vars) + ! + ! !DESCRIPTION: + ! do flux and state variable change between betr and alm. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use tracerfluxType , only : tracerflux_type + use tracerstatetype , only : tracerstate_type + use decompMod , only : bounds_type + use BeTRTracerType , only : BeTRTracer_Type + use CNCarbonStateType , only : carbonstate_type + use CNNitrogenStateType , only : nitrogenstate_type + use CNNitrogenFluxType , only : nitrogenflux_type + + ! !ARGUMENTS: + class(bgc_reaction_mock_run_type) , intent(in) :: this ! + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_soilc ! number of columns in column filter + integer , intent(in) :: filter_soilc(:) ! column filter + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(tracerstate_type) , intent(in) :: tracerstate_vars ! + type(tracerflux_type) , intent(in) :: tracerflux_vars ! + type(carbonstate_type) , intent(inout) :: carbonstate_vars ! + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars ! + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars ! + + end subroutine betr_alm_flux_statevar_feedback + + !------------------------------------------------------------------------------- + + + subroutine init_betr_alm_bgc_coupler(this, bounds, carbonstate_vars, & + nitrogenstate_vars, betrtracer_vars, tracerstate_vars) + + ! !DESCRIPTION: + ! initialize the bgc coupling between betr and alm + ! + ! !USES: + use clm_varcon , only : natomw, catomw + use clm_varpar , only : i_cwd, i_met_lit, i_cel_lit, i_lig_lit + use CNCarbonStateType , only : carbonstate_type + use CNNitrogenStateType , only : nitrogenstate_type + use tracerstatetype , only : tracerstate_type + use BetrTracerType , only : betrtracer_type + use clm_varpar , only : nlevtrc_soil + use landunit_varcon , only : istsoil, istcrop + + ! !ARGUMENTS: + class(bgc_reaction_mock_run_type) , intent(in) :: this ! + type(bounds_type) , intent(in) :: bounds ! + type(tracerstate_type) , intent(inout) :: tracerstate_vars ! + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(carbonstate_type) , intent(in) :: carbonstate_vars ! + type(nitrogenstate_type) , intent(in) :: nitrogenstate_vars ! + + end subroutine init_betr_alm_bgc_coupler + +end module BGCReactionsMockRunType diff --git a/components/clm/src/betr/BGCReactionsMod.F90 b/components/clm/src/betr/BGCReactionsMod.F90 new file mode 100644 index 000000000000..b258dc973ead --- /dev/null +++ b/components/clm/src/betr/BGCReactionsMod.F90 @@ -0,0 +1,310 @@ +module BGCReactionsMod + ! + ! !DESCRIPTION: + ! template for doing bgc reaction in betr + ! + ! !USES: + use LandunitType , only : lun + use ColumnType , only : col + implicit none + save + private + public :: bgc_reaction_type + + type, abstract :: bgc_reaction_type + private + contains + !initialize betr bgc + procedure(Init_betrbgc_interface) , deferred :: Init_betrbgc + + !doing bgc reaction + procedure(calc_bgc_reaction_interface) , deferred :: calc_bgc_reaction + + !set boundary condition for related tracer transport + procedure(set_boundary_conditions_interface) , deferred :: set_boundary_conditions + + procedure(init_boundary_condition_type_interface) , deferred :: init_boundary_condition_type + + !do equilibrium tracer chemistry + procedure(do_tracer_equilibration_interface ) , deferred :: do_tracer_equilibration + + !do cold initialization of different tracers + procedure(initCold_interface) , deferred :: initCold + + !read in implementation specific parameters + procedure(readParams_interface) , deferred :: readParams + + !send back state flux variables to other parts of alm + procedure(betr_alm_flux_statevar_feedback_interface) , deferred :: betr_alm_flux_statevar_feedback + + !initialize betr state variable from other bgc components in alm + procedure(init_betr_alm_bgc_coupler_interface) , deferred :: init_betr_alm_bgc_coupler + + end type bgc_reaction_type + + abstract interface + !---------------------------------------------------------------------- + subroutine Init_betrbgc_interface(this, bounds, lbj, ubj, betrtracer_vars) + ! + ! !DESCRIPTION: + ! template for init_betrbgc + ! + ! !USES: + use BeTRTracerType , only : BeTRtracer_type + use decompMod , only : bounds_type + ! + ! !ARGUMENTS: + import :: bgc_reaction_type + class(bgc_reaction_type) , intent(in) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: lbj, ubj + type(BeTRtracer_type ) , intent(inout) :: betrtracer_vars + + end subroutine Init_betrbgc_interface + !---------------------------------------------------------------------- + subroutine calc_bgc_reaction_interface(this, bounds, lbj, ubj, num_soilc, filter_soilc, & + num_soilp,filter_soilp, jtops, dtime, & + betrtracer_vars, tracercoeff_vars, waterstate_vars, temperature_vars, & + soilstate_vars, chemstate_vars, cnstate_vars, carbonstate_vars, carbonflux_vars, & + nitrogenstate_vars, nitrogenflux_vars, & + tracerstate_vars, tracerflux_vars, plantsoilnutrientflux_vars) + ! + ! !DESCRIPTION: + ! template for calc_bgc_reaction + ! + ! !USES: + use tracerfluxType , only : tracerflux_type + use tracerstatetype , only : tracerstate_type + use tracercoeffType , only : tracercoeff_type + use WaterStateType , only : Waterstate_Type + use TemperatureType , only : temperature_type + use ChemStateType , only : chemstate_type + use SoilStatetype , only : soilstate_type + use decompMod , only : bounds_type + use PlantSoilnutrientFluxType, only : plantsoilnutrientflux_type + use BeTRTracerType , only : BeTRTracer_Type + use shr_kind_mod , only : r8 => shr_kind_r8 + use CanopyStateType , only : canopystate_type + use CNStateType , only : cnstate_type + use CNCarbonStateType , only : carbonstate_type + use CNCarbonFluxType , only : carbonflux_type + use CNNitrogenFluxType , only : nitrogenflux_type + use CNNitrogenStateType , only : nitrogenstate_type + + ! !ARGUMENTS: + import :: bgc_reaction_type + class(bgc_reaction_type) , intent(in) :: this + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_soilc ! number of columns in column filter + integer , intent(in) :: filter_soilc(:) ! column filter + integer , intent(in) :: num_soilp + integer , intent(in) :: filter_soilp(:) + integer , intent(in) :: jtops( : ) ! top index of each column + integer , intent(in) :: lbj, ubj ! lower and upper bounds, make sure they are > 0 + real(r8) , intent(in) :: dtime ! model time step + type(Waterstate_Type) , intent(in) :: waterstate_vars ! water state variables + type(temperature_type) , intent(in) :: temperature_vars ! energy state variable + type(chemstate_type) , intent(in) :: chemstate_vars + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(soilstate_type) , intent(in) :: soilstate_vars + type(cnstate_type) , intent(inout) :: cnstate_vars + type(carbonstate_type) , intent(in) :: carbonstate_vars + type(carbonflux_type) , intent(inout) :: carbonflux_vars + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + type(tracercoeff_type) , intent(in) :: tracercoeff_vars + type(tracerstate_type) , intent(inout) :: tracerstate_vars + type(tracerflux_type) , intent(inout) :: tracerflux_vars + type(plantsoilnutrientflux_type) , intent(inout) :: plantsoilnutrientflux_vars !total nitrogen yield to plant + + end subroutine calc_bgc_reaction_interface + !---------------------------------------------------------------------- + + subroutine set_boundary_conditions_interface(this, bounds, num_soilc, filter_soilc, dz_top, & + betrtracer_vars, waterflux_vars, tracerboundarycond_vars) + + ! !DESCRIPTION: + ! template for set_boundary_conditions + ! + ! !USES: + use TracerBoundaryCondType , only : tracerboundarycond_type + use decompMod , only : bounds_type + use BeTRTracerType , only : BeTRTracer_Type + use WaterfluxType , only : waterflux_type + use shr_kind_mod , only : r8 => shr_kind_r8 + + ! !ARGUMENTS: + import :: bgc_reaction_type + class(bgc_reaction_type) , intent(in) :: this ! + type(bounds_type) , intent(in) :: bounds ! + integer , intent(in) :: num_soilc ! number of columns in column filter + integer , intent(in) :: filter_soilc(:) ! column filter + type(betrtracer_type) , intent(in) :: betrtracer_vars ! + real(r8) , intent(in) :: dz_top( : ) ! + type(waterflux_type) , intent(in) :: waterflux_vars ! + type(tracerboundarycond_type) , intent(inout) :: tracerboundarycond_vars ! + + end subroutine set_boundary_conditions_interface + + !---------------------------------------------------------------------- + + subroutine init_boundary_condition_type_interface(this, bounds, & + betrtracer_vars, tracerboundarycond_vars ) + ! + ! !DESCRIPTION: + ! template for init_boundary_condition + ! + ! !USES: + use BeTRTracerType , only : betrtracer_type + use TracerBoundaryCondType, only : tracerboundarycond_type + use decompMod , only : bounds_type + + ! !ARGUMENTS: + import :: bgc_reaction_type + class(bgc_reaction_type) , intent(in) :: this + type(BeTRtracer_type ) , intent(in) :: betrtracer_vars + type(bounds_type) , intent(in) :: bounds + type(tracerboundarycond_type) , intent(in) :: tracerboundarycond_vars + + end subroutine init_boundary_condition_type_interface + + + !------------------------------------------------------------------------------- + subroutine do_tracer_equilibration_interface(this, bounds, lbj, ubj, jtops, num_soilc, filter_soilc, & + betrtracer_vars, tracercoeff_vars, tracerstate_vars) + ! + ! !DESCRIPTION: + ! template for do_tracer_equilibration + ! !USES: + ! + use tracerstatetype , only : tracerstate_type + use tracercoeffType , only : tracercoeff_type + use BeTRTracerType , only : BeTRTracer_Type + use decompMod , only : bounds_type + + ! !ARGUMENTS: + import :: bgc_reaction_type + + class(bgc_reaction_type) , intent(in) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: lbj, ubj + integer , intent(in) :: jtops( : ) ! top label of each column + integer , intent(in) :: num_soilc + integer , intent(in) :: filter_soilc(:) + type(betrtracer_type) , intent(in) :: betrtracer_vars + type(tracercoeff_type) , intent(in) :: tracercoeff_vars + type(tracerstate_type) , intent(inout) :: tracerstate_vars + + + end subroutine do_tracer_equilibration_interface + + !------------------------------------------------------------------------------- + subroutine InitCold_interface(this, bounds, betrtracer_vars, waterstate_vars, tracerstate_vars) + ! + ! !DESCRIPTION: + ! template for InitCold + ! !USES: + ! + use BeTRTracerType , only : BeTRTracer_Type + use tracerstatetype , only : tracerstate_type + use WaterstateType , only : waterstate_type + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : pft + use decompMod , only : bounds_type + + ! !ARGUMENTS: + import :: bgc_reaction_type + class(bgc_reaction_type) , intent(in) :: this + type(bounds_type) , intent(in) :: bounds + type(BeTRTracer_Type) , intent(in) :: betrtracer_vars + type(waterstate_type) , intent(in) :: waterstate_vars + type(tracerstate_type) , intent(inout) :: tracerstate_vars + + + end subroutine InitCold_interface + + !------------------------------------------------------------------------------- + subroutine readParams_interface(this, ncid, betrtracer_vars) + ! + ! !DESCRIPTION: + ! template for readParams + ! !USES: + use ncdio_pio , only : file_desc_t + use BeTRTracerType , only : BeTRTracer_Type + + ! !ARGUMENTS: + import :: bgc_reaction_type + + class(bgc_reaction_type) , intent(in) :: this + type(file_desc_t) , intent(inout) :: ncid ! pio netCDF file id + type(BeTRTracer_Type) , intent(inout) :: betrtracer_vars + + end subroutine readParams_interface + + !------------------------------------------------------------------------------- + subroutine betr_alm_flux_statevar_feedback_interface(this, bounds, num_soilc, filter_soilc, & + carbonstate_vars, nitrogenstate_vars, nitrogenflux_vars, & + tracerstate_vars, tracerflux_vars, betrtracer_vars) + + ! !DESCRIPTION: + ! template for betr_alm_flux_statevar_feedback + ! !USES: + use decompMod , only : bounds_type + use shr_kind_mod , only : r8 => shr_kind_r8 + use tracerfluxType , only : tracerflux_type + use tracerstatetype , only : tracerstate_type + use BeTRTracerType , only : BeTRTracer_Type + use CNCarbonStateType , only : carbonstate_type + use CNNitrogenStateType , only : nitrogenstate_type + use CNNitrogenFluxType , only : nitrogenflux_type + + ! !ARGUMENTS: + import :: bgc_reaction_type + class(bgc_reaction_type) , intent(in) :: this ! + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_soilc ! number of columns in column filter + integer , intent(in) :: filter_soilc(:) ! column filter + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(tracerstate_type) , intent(in) :: tracerstate_vars ! + type(tracerflux_type) , intent(in) :: tracerflux_vars ! + type(carbonstate_type) , intent(inout) :: carbonstate_vars ! + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars ! + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars ! + + end subroutine betr_alm_flux_statevar_feedback_interface + + !------------------------------------------------------------------------------- + + + subroutine init_betr_alm_bgc_coupler_interface(this, bounds, carbonstate_vars, & + nitrogenstate_vars, betrtracer_vars, tracerstate_vars) + ! + ! !DESCRIPTION: + ! template for init_betr_alm_bgc_coupler + + ! !USES: + use decompMod , only : bounds_type + use clm_varcon , only : natomw, catomw + use clm_varpar , only : i_cwd, i_met_lit, i_cel_lit, i_lig_lit + use CNCarbonStateType , only : carbonstate_type + use CNNitrogenStateType , only : nitrogenstate_type + use tracerstatetype , only : tracerstate_type + use BetrTracerType , only : betrtracer_type + use clm_varpar , only : nlevtrc_soil + use landunit_varcon , only : istsoil, istcrop + ! + ! !ARGUMENTS: + import :: bgc_reaction_type + class(bgc_reaction_type) , intent(in) :: this + type(bounds_type) , intent(in) :: bounds + type(tracerstate_type) , intent(inout) :: tracerstate_vars + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(carbonstate_type) , intent(in) :: carbonstate_vars + type(nitrogenstate_type) , intent(in) :: nitrogenstate_vars + + + end subroutine init_betr_alm_bgc_coupler_interface + + end interface +end module BGCReactionsMod diff --git a/components/clm/src/betr/BetrBGCMod.F90 b/components/clm/src/betr/BetrBGCMod.F90 new file mode 100644 index 000000000000..b48593a419f2 --- /dev/null +++ b/components/clm/src/betr/BetrBGCMod.F90 @@ -0,0 +1,1801 @@ +module BetrBGCMod + +#include "shr_assert.h" + ! + ! !DESCRIPTION: + ! subroutines for betr application + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use BeTRTracerType , only : betrtracer_type + use clm_varctl , only : iulog + use clm_time_manager , only : get_nstep + use MathfuncMod , only : dot_sum + implicit none + private + + integer, parameter :: do_diffusion = 1 ! do diffusive transport + integer, parameter :: do_advection = 2 ! do advective transport, aquesou phase only + + real(r8), parameter :: tiny_val = 1.e-20_r8 !very small value, for tracer concentration etc. + real(r8), parameter :: dtime_min = 1._r8 !minimum time step 1 second + real(r8), parameter :: err_tol_transp = 1.e-8_r8 !error tolerance for tracer transport + + public :: run_betr_one_step_without_drainage + public :: run_betr_one_step_with_drainage + public :: betrBGC_init + public :: calc_dew_sub_flux + +contains + + subroutine betrbgc_init(bounds, betrtracer_vars) + ! + ! !DESCRIPTION: + ! initialize local variables + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + + ! !LOCAL VARIABLES: + character(len=255) :: subname = 'betrbgc_init' + + end subroutine betrbgc_init + + !------------------------------------------------------------------------------- + subroutine run_betr_one_step_without_drainage(bounds, lbj, ubj, num_soilc, filter_soilc, num_soilp, filter_soilp, col , & + atm2lnd_vars, soilhydrology_vars, soilstate_vars, waterstate_vars, temperature_vars, waterflux_vars, chemstate_vars, & + cnstate_vars, canopystate_vars, carbonstate_vars, carbonflux_vars,nitrogenstate_vars, nitrogenflux_vars, & + betrtracer_vars, bgc_reaction, tracerboundarycond_vars, tracercoeff_vars, tracerstate_vars, tracerflux_vars, & + plantsoilnutrientflux_vars) + ! + ! !DESCRIPTION: + ! run betr code one time step forward, without drainage calculation + + ! !USES: + use clm_time_manager , only : get_step_size + use clm_varctl , only : use_cn + use tracerfluxType , only : tracerflux_type + use tracerstatetype , only : tracerstate_type + use tracercoeffType , only : tracercoeff_type + use TracerBoundaryCondType , only : TracerBoundaryCond_type + use BetrTracerType , only : betrtracer_type + use TracerParamsMod , only : set_phase_convert_coeff, set_multi_phase_diffusion, calc_tracer_infiltration + use TracerParamsMod , only : get_zwt, calc_aerecond, betr_annualupdate + use SoilStateType , only : soilstate_type + use WaterStateType , only : Waterstate_Type + use TemperatureType , only : temperature_type + use ChemStateType , only : chemstate_type + use WaterfluxType , only : waterflux_type + use ColumnType , only : column_type + use BGCReactionsMod , only : bgc_reaction_type + use atm2lndType , only : atm2lnd_type + use SoilHydrologyType , only : soilhydrology_type + use clm_varpar , only : nlevsoi + use PlantSoilnutrientFluxType , only : plantsoilnutrientflux_type + use CNStateType , only : cnstate_type + use CNCarbonFluxType , only : carbonflux_type + use tracer_varcon , only : is_active_betr_bgc + use CNNitrogenStateType , only : nitrogenstate_type + use CNNitrogenFluxType , only : nitrogenflux_type + use CanopyStateType , only : canopystate_type + use CNCarbonStateType , only : carbonstate_type + ! + ! !ARGUMENTS : + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_soilc ! number of columns in column filter_soilc + integer , intent(in) :: filter_soilc(:) ! column filter_soilc + integer , intent(in) :: num_soilp + integer , intent(in) :: filter_soilp(:) ! pft filter + integer , intent(in) :: lbj, ubj ! lower and upper bounds, make sure they are > 0 + + type(column_type) , intent(in) :: col ! column type + type(Waterstate_Type) , intent(in) :: waterstate_vars ! water state variables + type(soilstate_type) , intent(in) :: soilstate_vars ! column physics variable + type(temperature_type) , intent(in) :: temperature_vars ! energy state variable + type(chemstate_type) , intent(in) :: chemstate_vars + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + class(bgc_reaction_type) , intent(in) :: bgc_reaction + type(atm2lnd_type) , intent(in) :: atm2lnd_vars + type(soilhydrology_type) , intent(in) :: soilhydrology_vars + type(cnstate_type) , intent(inout) :: cnstate_vars + type(canopystate_type) , intent(in) :: canopystate_vars + type(carbonflux_type) , intent(inout) :: carbonflux_vars + type(carbonstate_type) , intent(in) :: carbonstate_vars + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + type(waterflux_type) , intent(inout) :: waterflux_vars + type(tracerboundarycond_type) , intent(inout) :: tracerboundarycond_vars + type(tracercoeff_type) , intent(inout) :: tracercoeff_vars + type(tracerstate_type) , intent(inout) :: tracerstate_vars + type(tracerflux_type) , intent(inout) :: tracerflux_vars + type(plantsoilnutrientflux_type) , intent(inout) :: plantsoilnutrientflux_vars ! + + ! !LOCAL VARIABLES: + character(len=255) :: subname = 'run_betr_one_step_without_drainage' + real(r8) :: dtime2, dtime + real(r8) :: Rfactor(bounds%begc:bounds%endc, lbj:ubj,1:betrtracer_vars%ngwmobile_tracers) !retardation factor + integer :: j + integer :: jwt(bounds%begc:bounds%endc) + + dtime = get_step_size() + + !initialize extra parameters + dtime2 = dtime * 0.5_r8 + + !set up jtops + tracerboundarycond_vars%jtops_col(:)=1 + + if(use_cn)then + !update npp for aerenchyma calculation + call betr_annualupdate(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + carbonflux_vars, tracercoeff_vars) + endif + + !obtain water table depth + call get_zwt (bounds, num_soilc, filter_soilc, & + col%zi(bounds%begc:bounds%endc, 0:nlevsoi), & + soilstate_vars, & + waterstate_vars, & + temperature_vars, & + soilhydrology_vars%zwts_col(bounds%begc:bounds%endc), & + jwt(bounds%begc:bounds%endc)) + + !calculate arenchyma conductance + call calc_aerecond(bounds, num_soilp, filter_soilp, & + jwt(bounds%begc:bounds%endc), & + soilstate_vars%rootfr_patch(bounds%begp:bounds%endp, 1:ubj), & + temperature_vars, & + betrtracer_vars, & + canopystate_vars, & + carbonstate_vars, & + carbonflux_vars, & + tracercoeff_vars) + + chemstate_vars%soil_pH(bounds%begc:bounds%endc,1:ubj)=7._r8 + + call set_phase_convert_coeff(bounds, lbj, ubj, & + tracerboundarycond_vars%jtops_col, & + num_soilc, & + filter_soilc, & + col%dz(bounds%begc:bounds%endc, lbj:ubj), & + soilstate_vars=soilstate_vars, & + waterstate_vars=waterstate_vars, & + temperature_vars=temperature_vars, & + chemstate_vars=chemstate_vars, & + betrtracer_vars=betrtracer_vars, & + tracercoeff_vars=tracercoeff_vars) + + call set_multi_phase_diffusion(bounds, lbj, ubj, & + tracerboundarycond_vars%jtops_col, & + num_soilc, & + filter_soilc, & + soilstate_vars=soilstate_vars, & + waterstate_vars=waterstate_vars, & + canopystate_vars=canopystate_vars, & + temperature_vars=temperature_vars, & + chemstate_vars=chemstate_vars, & + betrtracer_vars=betrtracer_vars , & + tracercoeff_vars=tracercoeff_vars) + + call bgc_reaction%set_boundary_conditions(bounds, num_soilc, filter_soilc, & + col%dz(bounds%begc:bounds%endc,1), & + betrtracer_vars, & + waterflux_vars, & + tracerboundarycond_vars) + + call calc_tracer_infiltration(bounds, lbj, ubj, & + tracerboundarycond_vars%jtops_col, & + num_soilc, & + filter_soilc, & + tracercoeff_vars%bunsencef_col(bounds%begc:bounds%endc, & + 1, & + 1:betrtracer_vars%nvolatile_tracer_groups), & + betrtracer_vars, & + tracerboundarycond_vars, & + waterflux_vars, & + tracerflux_vars%tracer_flx_infl_col) + + call set_gwdif_Rfactor(bounds, lbj, ubj, & + tracerboundarycond_vars%jtops_col, & + num_soilc, & + filter_soilc, & + tracercoeff_vars, & + betrtracer_vars, & + Rfactor) + + !calculate flux from merging topsoil with surface ponding water and snow + call calc_tracer_h2osfc_snow_residual_combine(bounds, num_soilc, filter_soilc, & + waterflux_vars, & + betrtracer_vars, & + tracerstate_vars, & + tracerflux_vars) + + ! do tracer wash with surface runoff + call calc_tracer_surface_runoff(bounds, lbj, ubj, & + num_soilc, & + filter_soilc, & + soilhydrology_vars%fracice_col(bounds%begc:bounds%endc,1), & + col%dz(bounds%begc:bounds%endc, 1:ubj), & + waterstate_vars, & + waterflux_vars, & + betrtracer_vars, & + tracerstate_vars, & + tracercoeff_vars, & + tracerflux_vars) + + call bgc_reaction%calc_bgc_reaction(bounds, lbj, ubj, & + num_soilc, & + filter_soilc, & + num_soilp, & + filter_soilp, & + tracerboundarycond_vars%jtops_col, & + dtime, & + betrtracer_vars, & + tracercoeff_vars, & + waterstate_vars, & + temperature_vars, & + soilstate_vars, & + chemstate_vars, & + cnstate_vars, & + carbonstate_vars, & + carbonflux_vars, & + nitrogenstate_vars, & + nitrogenflux_vars, & + tracerstate_vars, & + tracerflux_vars, & + plantsoilnutrientflux_vars) + + call tracer_gw_transport(bounds, lbj, ubj, & + tracerboundarycond_vars%jtops_col, & + num_soilc, & + filter_soilc, & + Rfactor, & + col%dz(bounds%begc:bounds%endc, lbj:ubj), & + col%zi(bounds%begc:bounds%endc,lbj-1:ubj), & + waterstate_vars%h2osoi_liqvol_col(bounds%begc:bounds%endc, lbj:ubj), & + (/do_advection, do_diffusion/), & + dtime, & + betrtracer_vars, & + tracerboundarycond_vars, & + tracercoeff_vars, & + waterflux_vars, & + bgc_reaction, & + tracerstate_vars, & + tracerflux_vars, & + waterstate_vars) + + call tracer_solid_transport(bounds, 1, ubj, & + num_soilc, & + filter_soilc, & + dtime, & + tracercoeff_vars%hmconductance_col(bounds%begc:bounds%endc, 1:ubj-1, : ), & + col%dz(bounds%begc:bounds%endc, 1:ubj), & + betrtracer_vars, & + tracerboundarycond_vars, & + tracerflux_vars, & + tracerstate_vars) + + call calc_ebullition(bounds, 1, ubj, & + tracerboundarycond_vars%jtops_col, & + num_soilc, & + filter_soilc, & + atm2lnd_vars%forc_pbot_downscaled_col, & + col%zi(bounds%begc:bounds%endc, 0:ubj), & + col%dz(bounds%begc:bounds%endc, 1:ubj), & + dtime, & + soilhydrology_vars%fracice_col(bounds%begc:bounds%endc, 1:ubj), & + soilhydrology_vars%zwts_col(bounds%begc:bounds%endc), & + betrtracer_vars, & + tracercoeff_vars, & + tracerstate_vars, & + tracerflux_vars%tracer_flx_ebu_col(bounds%begc:bounds%endc, 1:betrtracer_vars%nvolatile_tracers)) + + if (is_active_betr_bgc) then + + !update nitrogen storage pool + call plantsoilnutrientflux_vars%summary(bounds, ubj, num_soilc, & + filter_soilc, & + col%dz(bounds%begc:bounds%endc,1:ubj), & + tracerflux_vars%tracer_flx_vtrans_col(bounds%begc:bounds%endc,betrtracer_vars%id_trc_nh3x), & + tracerflux_vars%tracer_flx_vtrans_col(bounds%begc:bounds%endc,betrtracer_vars%id_trc_no3x)) + endif + end subroutine run_betr_one_step_without_drainage + + !------------------------------------------------------------------------------- + subroutine tracer_solid_transport(bounds, lbj, ubj, num_soilc, filter_soilc, dtime, hmconductance_col, dz, & + betrtracer_vars, tracerboundarycond_vars, tracerflux_vars, tracerstate_vars) + ! + ! !DESCRIPTION: + ! + ! do solid phase tracer transport, due to various turbation processes, + ! which are parameterized as diffusion + ! the surface flux of solid tracer is zero + ! + ! !USES: + use tracerstateType , only : tracerstate_type + use tracerfluxType , only : tracerflux_type + use tracerboundarycondtype , only : tracerboundarycond_type + use TransportMod , only : DiffusTransp + use abortutils , only : endrun + + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: lbj, ubj + integer , intent(in) :: num_soilc ! number of columns in column filter_soilc + integer , intent(in) :: filter_soilc(:) ! column filter_soilc + type(betrtracer_type) , intent(in) :: betrtracer_vars + real(r8) , intent(in) :: dtime ! model time step + real(r8) , intent(in) :: hmconductance_col(bounds%begc: , lbj: ,1: ) !weighted bulk conductance + real(r8) , intent(in) :: dz(bounds%begc: , lbj: ) + type(tracerboundarycond_type), intent(in) :: tracerboundarycond_vars + type(tracerflux_type) , intent(in) :: tracerflux_vars + type(tracerstate_type) , intent(inout) :: tracerstate_vars + + ! !LOCAL VARIABLES: + integer :: kk, j, fc, c, l, ntrcs, trcid, k + real(r8) :: dtime_loc(bounds%begc:bounds%endc) + real(r8) :: time_remain(bounds%begc:bounds%endc) + integer :: jtops(bounds%begc:bounds%endc) + + logical :: update_col(bounds%begc:bounds%endc) + logical :: lnegative_tracer + logical :: lexit_loop + + integer, allocatable :: difs_trc_group(:) + real(r8), pointer :: dtracer(:, :, :) + real(r8), pointer :: err_tracer(:, :) + real(r8), pointer :: local_source(:, :, :) + + real(r8), parameter :: err_min_solid=1.e-12_r8 + + character(len=255) :: subname = 'tracer_solid_transport' + + associate(& + tracernames => betrtracer_vars%tracernames , & + nmem_max => betrtracer_vars%nmem_max , & + ngwmobile_tracers => betrtracer_vars%ngwmobile_tracers , & + tracer_group_memid => betrtracer_vars%tracer_group_memid , & + is_mobile => betrtracer_vars%is_mobile , & + tracer_flx_netpro_vr => tracerflux_vars%tracer_flx_netpro_vr_col , & ! + tracer_conc_solid_passive_col => tracerstate_vars%tracer_conc_solid_passive_col & + ) + + SHR_ASSERT_ALL((ubound(hmconductance_col) == (/bounds%endc, ubj-1, betrtracer_vars%ntracer_groups/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(dz) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) + + allocate (difs_trc_group (nmem_max )) + allocate (dtracer (bounds%begc:bounds%endc, lbj:ubj, nmem_max )) + allocate (err_tracer (bounds%begc:bounds%endc, nmem_max )) + allocate (local_source (bounds%begc:bounds%endc,lbj:ubj,nmem_max )) + + jtops(:) =1 + local_source(:,:,:) = 0._r8 + + do j = betrtracer_vars%ngwmobile_tracer_groups+1, betrtracer_vars%ntracer_groups + ntrcs = 0 + difs_trc_group(:) = 0 + do k = 1, nmem_max + trcid = tracer_group_memid(j, k)-ngwmobile_tracers + if(trcid>0)then + if(is_mobile(tracer_group_memid(j, k)))then + ntrcs = ntrcs + 1 + difs_trc_group(ntrcs) = trcid + endif + endif + enddo + + if (ntrcs==0) cycle + + !adaptive time stepping for solid phase transport + kk = j - betrtracer_vars%ngwmobile_tracer_groups + do fc = 1, num_soilc + c = filter_soilc(fc) + dtime_loc(c) = dtime + time_remain(c) =dtime + update_col(c) = .true. + enddo + + do + !do diffusive transport + call DiffusTransp(bounds, lbj, ubj, jtops, num_soilc, filter_soilc, ntrcs, & + tracer_conc_solid_passive_col(:,:,difs_trc_group(1:ntrcs)), & + hmconductance_col(:,:,j), & + dtime_loc, & + dz, & + source=local_source(:,:,1:ntrcs), & + update_col=update_col, & + dtracer=dtracer(:,:,1:ntrcs)) + + !do tracer update + do fc = 1, num_soilc + c = filter_soilc(fc) + if(update_col(c))then + + !do negative tracer screening + lnegative_tracer = .false. + + !loop through layers + do k = 1, ntrcs + trcid = difs_trc_group(k) + do l = jtops(c), ubj + if(tracer_conc_solid_passive_col(c,l,trcid)<-dtracer(c,l,k))then + !if the tracer update is very tinty, then set it to zero + if(abs(dtracer(c,l,k))=err_min_solid)then + call endrun('mass balance error for tracer '//tracernames(trcid)//' in '//trim(subname)) + endif + enddo + !if negative tracer concentration is found, go to the next column + if(lnegative_tracer)cycle + + !when everything is OK, update the remaining time to be evolved. + time_remain(c) = time_remain(c)-dtime_loc(c) + dtime_loc(c) = max(dtime_loc(c),dtime_min) + dtime_loc(c) = min(dtime_loc(c), time_remain(c)) + endif + + enddo + + !test for loop exit + lexit_loop=exit_loop_by_threshold(bounds%begc, bounds%endc, time_remain, & + dtime_min, num_soilc, filter_soilc, update_col) + if(lexit_loop)exit + + enddo + enddo + + deallocate(difs_trc_group) + deallocate(dtracer) + deallocate(err_tracer) + deallocate(local_source) + end associate + + end subroutine tracer_solid_transport + + !------------------------------------------------------------------------------- + subroutine tracer_gw_transport(bounds, lbj, ubj, jtops, num_soilc, filter_soilc, Rfactor, & + dz, zi, h2osoi_liqvol, transp_pathway, dtime, betrtracer_vars, tracerboundarycond_vars, & + tracercoeff_vars, waterflux_vars, bgc_reaction, tracerstate_vars, tracerflux_vars, waterstate_vars) + ! + ! !DESCRIPTION: + ! do dual-phase (gas+aqueous) vertical tracer transport + ! + ! !USES: + use tracerstateType , only : tracerstate_type + use tracerboundarycondtype , only : tracerboundarycond_type + use tracerfluxtype , only : tracerflux_type + use tracercoeffType , only : tracercoeff_type + use WaterfluxType , only : waterflux_type + use BGCReactionsMod , only : bgc_reaction_type + use WaterStateType , only : Waterstate_Type + + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: lbj, ubj + integer , intent(in) :: num_soilc ! number of columns in column filter_soilc + integer , intent(in) :: filter_soilc(:) ! column filter_soilc + integer , intent(in) :: jtops(bounds%begc: ) ! top label of each column + type(betrtracer_type) , intent(in) :: betrtracer_vars + real(r8) , intent(in) :: dz(bounds%begc: ,lbj: ) ! + real(r8) , intent(in) :: zi(bounds%begc: ,lbj-1: ) ! + real(r8) , intent(in) :: h2osoi_liqvol(bounds%begc: , lbj: ) ! + real(r8) , intent(in) :: Rfactor(bounds%begc: ,lbj: ,1: ) !rfactor for dual diffusive transport + integer , intent(in) :: transp_pathway(2) !the pathway vector + real(r8) , intent(in) :: dtime !model time step + type(waterflux_type) , intent(in) :: waterflux_vars + type(tracerboundarycond_type) , intent(in) :: tracerboundarycond_vars + class(bgc_reaction_type) , intent(in) :: bgc_reaction + type(tracercoeff_type) , intent(inout) :: tracercoeff_vars + type(tracerstate_type) , intent(inout) :: tracerstate_vars + type(tracerflux_type) , intent(inout) :: tracerflux_vars + type(Waterstate_Type) , intent(in) :: waterstate_vars ! water state variables + + ! !LOCAL VARIABLES: + integer :: kk + integer :: jtops0(bounds%begc:bounds%endc) + character(len=255) :: subname = 'tracer_gw_transport' + + SHR_ASSERT_ALL((ubound(jtops) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(dz) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(zi) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(h2osoi_liqvol) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(Rfactor) == (/bounds%endc, ubj, betrtracer_vars%ngwmobile_tracer_groups/)), errMsg(__FILE__,__LINE__)) + + ! + !Exclude solid phase tracers, by doing tracer equilibration + !This is equivalent to do aqueous chemistry without biological production/consumption + !The reason for doing this is to account for change in phase + !partitioning due to change in hydrological status. + + call bgc_reaction%do_tracer_equilibration(bounds, lbj, ubj, & + jtops, & + num_soilc, & + filter_soilc, & + betrtracer_vars, & + tracercoeff_vars, tracerstate_vars) + + !do diffusive and advective transport, assuming aqueous and gaseous phase are in equilbrium + do kk = 1 , 2 + if (transp_pathway(kk) == do_diffusion) then + + call do_tracer_gw_diffusion(bounds, lbj, ubj, & + jtops, & + num_soilc, & + filter_soilc, & + betrtracer_vars, & + tracerboundarycond_vars, & + Rfactor, & + tracercoeff_vars%hmconductance_col(bounds%begc:bounds%endc, lbj:ubj-1, : ), & + dz, & + dtime, & + tracerstate_vars, & + tracerflux_vars, & + waterstate_vars) + + elseif (transp_pathway(kk) == do_advection)then + jtops0(:) = 1 + call do_tracer_advection(bounds, lbj, ubj, & + jtops0, & + num_soilc, & + filter_soilc, & + betrtracer_vars, & + dz, & + zi, & + dtime, & + h2osoi_liqvol, & + waterflux_vars, & + tracercoeff_vars, & + tracerstate_vars, & + tracerflux_vars) + endif + enddo + + end subroutine tracer_gw_transport + + !------------------------------------------------------------------------------- + subroutine do_tracer_advection(bounds, lbj, ubj, jtops, num_soilc, filter_soilc, & + betrtracer_vars, dz, zi, dtime, h2osoi_liqvol, waterflux_vars, & + tracercoeff_vars, tracerstate_vars, tracerflux_vars) + ! + ! !DESCRIPTION: + ! do aqueous advection for dissolved tracers, the advection of gasesous phase is done through pressure + ! adjustment for ebullition + ! the aquesou advection is formulated as + ! \frac{\partial{p(vsm*C_aq)}}{\partial t} = - \frac{\partial u*C_aq}{\partial z} + S_{root vs soil} + ! + ! now the code transport tracers by groups specified by phase conversion coefficients + ! !USES: + use tracerstateType , only : tracerstate_type + use tracerfluxtype , only : tracerflux_type + use TracerCoeffType , only : tracercoeff_type + use TransportMod , only : semi_lagrange_adv_backward + use abortutils , only : endrun + use WaterfluxType , only : waterflux_type + use MathfuncMod , only : safe_div + ! + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: lbj, ubj + integer , intent(in) :: num_soilc ! number of columns in column filter_soilc + integer , intent(in) :: jtops(bounds%begc: ) + integer , intent(in) :: filter_soilc(:) ! column filter_soilc + type(betrtracer_type) , intent(in) :: betrtracer_vars + real(r8) , intent(in) :: dz(bounds%begc: ,lbj: ) + real(r8) , intent(in) :: zi(bounds%begc: ,lbj-1: ) + real(r8) , intent(in) :: h2osoi_liqvol(bounds%begc: , lbj: ) ! + real(r8) , intent(in) :: dtime !model time step + type(waterflux_type) , intent(in) :: waterflux_vars + type(tracercoeff_type) , intent(in) :: tracercoeff_vars + type(tracerstate_type) , intent(inout) :: tracerstate_vars + type(tracerflux_type) , intent(inout) :: tracerflux_vars + + ! !LOCAL VARIABLES: + logical :: update_col(bounds%begc:bounds%endc) + real(r8) :: time_remain(bounds%begc:bounds%endc) + real(r8) :: dtime_loc(bounds%begc:bounds%endc) + real(r8) :: denum, num + real(r8) :: qflx_adv_local(bounds%begc:bounds%endc,lbj-1:ubj) + real(r8) :: qflx_rootsoi_local(bounds%begc:bounds%endc,lbj:ubj) ! + integer, allocatable :: adv_trc_group( : ) + real(r8), pointer :: err_tracer( : , : ) + real(r8), pointer :: transp_mass( : , : ) + real(r8), pointer :: leaching_mass( : , : ) + real(r8), pointer :: inflx_top( : , : ) + real(r8), pointer :: inflx_bot( : , : ) + real(r8), pointer :: dmass( : , : ) + real(r8), pointer :: trc_conc_out(:,:,:) + logical :: halfdt_col(bounds%begc:bounds%endc) + real(r8) :: err_relative + real(r8) :: c_courant + integer :: num_loops !number of loops as determined by the courant number condition + logical :: lexit_loop + integer :: c, fc, j, l, k, ntrcs, trcid,kk + integer :: ngwmobile_tracers + logical :: lshock + + real(r8), parameter :: err_relative_threshold=1.e-2_r8 !relative error threshold + real(r8), parameter :: err_adv_min=1.e-10_r8 + real(r8), parameter :: loc_eps = 1.e-8_r8 !smoothing factor to avoid advection velocity spikes, dimension less + real(r8) :: mass0 + character(len=255) :: subname = 'do_tracer_advection' + + + SHR_ASSERT_ALL((ubound(jtops) == (/bounds%endc/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(dz) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(h2osoi_liqvol) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(zi) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) + + associate(& + qflx_adv => waterflux_vars%qflx_adv_col , & !real(r8) (:,:)[intent(in)], advective velocity defined at layer interfatemperature_vars + qflx_rootsoi => waterflux_vars%qflx_rootsoi_col , & !real(r8) (:,:)[intent(in)], water flux between plant and soil at different layers + is_advective => betrtracer_vars%is_advective , & !logical(:) [intent(in)], indicator whether the tracer undergoes advection + is_mobile => betrtracer_vars%is_mobile , & ! + is_h2o => betrtracer_vars%is_h2o , & !logical(:) [intent(in)], indicator whether the tracer is h2o + vtrans_scal => betrtracer_vars%vtrans_scal , & !real(r8) (:) [intent(in)], transport scalar for tracer exchaning between root and soil + ngwmobile_tracer_groups => betrtracer_vars%ngwmobile_tracer_groups , & !integer [intent(in)], number of mobile tracers undergoing dual phase transport + nmem_max => betrtracer_vars%nmem_max , & ! + tracer_group_memid => betrtracer_vars%tracer_group_memid , & ! + tracernames => betrtracer_vars%tracernames , & ! + tracer_conc_mobile_col => tracerstate_vars%tracer_conc_mobile_col , & ! + aqu2bulkcef_mobile_col => tracercoeff_vars%aqu2bulkcef_mobile_col , & ! + tracer_flx_leaching => tracerflux_vars%tracer_flx_leaching_col , & ! + tracer_flx_vtrans => tracerflux_vars%tracer_flx_vtrans_col , & ! + tracer_flx_infl => tracerflux_vars%tracer_flx_infl_col & ! + ) + !allocate memories + allocate (adv_trc_group (nmem_max )) + allocate (err_tracer (bounds%begc:bounds%endc ,nmem_max )) + allocate (transp_mass (bounds%begc:bounds%endc, nmem_max )) + allocate (leaching_mass (bounds%begc:bounds%endc, nmem_max )) + allocate (inflx_top (bounds%begc:bounds%endc, nmem_max )) + allocate (inflx_bot (bounds%begc:bounds%endc, nmem_max )) + allocate (dmass (bounds%begc:bounds%endc,nmem_max )) + allocate (trc_conc_out (bounds%begc:bounds%endc,lbj:ubj, 1:nmem_max )) + + !initialize local variables + update_col (:) = .true. + time_remain (:) = 0._r8 + dtime_loc (:) = 0._r8 + + !loop over all tracers + do j = 1, ngwmobile_tracer_groups + ntrcs = 0 + adv_trc_group(:) = 0 + do k = 1, nmem_max + trcid = tracer_group_memid(j,k) + if(trcid>0)then + if(is_mobile(trcid) .and. is_advective(trcid)) then + ntrcs = ntrcs + 1 + adv_trc_group(ntrcs) = trcid + endif + endif + enddo + if(ntrcs==0)cycle + + !convert bulk mobile phase into aqueous phase + do k = 1, ntrcs + do fc = 1, num_soilc + c = filter_soilc(fc) + inflx_top(c, k) = tracer_flx_infl(c,adv_trc_group(k)) + !set to 0 to ensure outgoing boundary condition is imposed, this may not be correct for water isotopes + inflx_bot(c,k) = 0._r8 + enddo + enddo + + !obtain advective velocity for the tracer group + do fc = 1, num_soilc + c = filter_soilc(fc) + qflx_adv_local(c,jtops(c)-1) = safe_div(qflx_adv(c,jtops(c)-1),aqu2bulkcef_mobile_col(c,jtops(c),j),eps=loc_eps) + do l = jtops(c), ubj + qflx_adv_local(c,l) = safe_div(qflx_adv(c,l),aqu2bulkcef_mobile_col(c,l,j),eps=loc_eps) + qflx_rootsoi_local(c,l) = safe_div(qflx_rootsoi(c,l),aqu2bulkcef_mobile_col(c,l,j),eps=loc_eps) + enddo + enddo + + !dertmine the local advection time step based on the existence of convergence grid cell, i.e. + ! grid cells with ul * ur < 0 + ! note qflx_adv(c,jtops(c)-1) is defined with infiltration + do fc = 1, num_soilc + c = filter_soilc(fc) + dtime_loc(c)=dtime !local advective time step + + !initialize the time keeper and make sure all columns are updated initially + update_col(c)=.true. + time_remain(c) = dtime + enddo + + do + !zero leaching flux, leaching is outgoing only. + leaching_mass=0._r8 + + do fc = 1, num_soilc + c = filter_soilc(fc) + if(update_col(c))then + do k = 1, ntrcs + trcid = adv_trc_group(k) + dmass(c, k) = dot_sum(tracer_conc_mobile_col(c, jtops(c):ubj, trcid), dz(c, jtops(c):ubj)) + enddo + endif + enddo + + ! do semi-lagrangian tracer transport + call semi_lagrange_adv_backward(bounds, lbj, ubj, & + jtops, & + num_soilc, & + filter_soilc, & + ntrcs, & + dtime_loc, & + dz, & + zi, & + qflx_adv_local(bounds%begc:bounds%endc,lbj-1:ubj), & + inflx_top(bounds%begc:bounds%endc, 1:ntrcs), & + inflx_bot(bounds%begc:bounds%endc, 1:ntrcs), & + update_col, & + halfdt_col, & + tracer_conc_mobile_col(bounds%begc:bounds%endc, lbj:ubj,adv_trc_group(1:ntrcs)), & + trc_conc_out(:,:,1:ntrcs), & + leaching_mass(bounds%begc:bounds%endc,1:ntrcs)) + + !do soil-root tracer exchange + do k = 1, ntrcs + trcid = adv_trc_group(k) + do l = lbj, ubj + do fc = 1, num_soilc + c = filter_soilc(fc) + if(update_col(c) .and. (.not. halfdt_col(c)) .and. l>=jtops(c))then + tracer_conc_mobile_col(c,l,trcid)=trc_conc_out(c,l,k) + endif + enddo + enddo + transp_mass(:,k) = 0._r8 + if(vtrans_scal(trcid)>0._r8)then + call calc_root_uptake_as_perfect_sink(bounds, lbj, ubj, num_soilc, & + filter_soilc, & + dtime_loc, & + dz, & + qflx_rootsoi_local, & + update_col, & + halfdt_col, & + tracer_conc_mobile_col(bounds%begc:bounds%endc, lbj:ubj,trcid), & + transp_mass(bounds%begc:bounds%endc, k)) + endif + enddo + + !do error budget and tracer flux update + do k = 1, ntrcs + trcid = adv_trc_group(k) + do fc = 1, num_soilc + c = filter_soilc(fc) + + if(update_col(c) .and. (.not. halfdt_col(c)))then + mass0 = dmass(c, k) + dmass(c, k) = dot_sum(tracer_conc_mobile_col(c,jtops(c):ubj,trcid), dz(c,jtops(c):ubj))- dmass(c, k) + + err_tracer(c, k) = dmass(c, k) - inflx_top(c,k) * dtime_loc(c) + leaching_mass(c,k) + transp_mass(c, k) + if(abs(err_tracer(c,k)) betrtracer_vars%is_volatile , & ! + is_mobile => betrtracer_vars%is_mobile , & ! + volatileid => betrtracer_vars%volatileid , & ! + tracernames => betrtracer_vars%tracernames , & ! + nmem_max => betrtracer_vars%nmem_max , & ! + ngwmobile_tracers => betrtracer_vars%ngwmobile_tracers , & ! + ngwmobile_tracer_groups => betrtracer_vars%ngwmobile_tracer_groups , & ! + tracer_group_memid => betrtracer_vars%tracer_group_memid , & ! + tracer_flx_dif => tracerflux_vars%tracer_flx_dif_col , & ! + tracer_flx_netpro_vr => tracerflux_vars%tracer_flx_netpro_vr_col , & ! + tracer_gwdif_concflux_top=> ttracerboundarycond_vars%tracer_gwdif_concflux_top_col , & ! + condc_toplay => ttracerboundarycond_vars%condc_toplay_col , & ! + topbc_type => ttracerboundarycond_vars%topbc_type , & ! + bot_concflux => ttracerboundarycond_vars%bot_concflux_col , & ! + tracer_conc_mobile_col => tracerstate_vars%tracer_conc_mobile_col & + ) + + allocate (err_tracer (bounds%begc:bounds%endc, nmem_max )) + allocate (diff_surf (bounds%begc:bounds%endc, nmem_max )) + allocate (dtracer (bounds%begc:bounds%endc,lbj:ubj, nmem_max )) + allocate (dmass (bounds%begc:bounds%endc, nmem_max )) + allocate (local_source (bounds%begc:bounds%endc,lbj:ubj, nmem_max )) + allocate (dif_trc_group (nmem_max )) + + update_col(:) = .true. + time_remain(:) = 0._r8 + dtime_loc(:) = 0._r8 + local_source(:,:,:) = 0._r8 + + do j = 1, ngwmobile_tracer_groups + + !assemable the tracer group for diffusion + ntrcs = 0 + dif_trc_group(:) = 0 + do k = 1, nmem_max + trcid = tracer_group_memid(j,k) + if(trcid>0)then + if(is_mobile(trcid)) then + ntrcs = ntrcs + 1 + dif_trc_group(ntrcs) = trcid + endif + endif + enddo + if(ntrcs==0)cycle + + !initialize the time keeper + do fc = 1, num_soilc + c = filter_soilc(fc) + time_remain(c) = dtime + dtime_loc(c) = dtime + update_col(c) = .true. + enddo + + !Do adpative time stepping to avoid negative tracer + do + call DiffusTransp(bounds, lbj, ubj, jtops, & + num_soilc, & + filter_soilc, ntrcs, & + tracer_conc_mobile_col( : , : ,dif_trc_group(1:ntrcs)), Rfactor( : , : ,j), & + hmconductance_col( : , : ,j), dtime_loc, dz, local_source(:,:, 1:ntrcs), & + tracer_gwdif_concflux_top( : , : ,dif_trc_group(1:ntrcs)), & + condc_toplay( : ,j), & + topbc_type(j), & + bot_concflux( : , : ,dif_trc_group(1:ntrcs)), & + update_col, & + dtracer(:,:,1:ntrcs)) + + !do tracer update + do fc = 1, num_soilc + c = filter_soilc(fc) + + !update the column + if(update_col(c))then + + !do negative tracer screening + lnegative_tracer = .false. + + do k = 1, ntrcs + trcid = dif_trc_group(k) + !loop through all layers + do l = jtops(c), ubj + if(tracer_conc_mobile_col(c,l,trcid)<-dtracer(c,l,k))then + !if the tracer update is very tinty, then set it to zero + if(abs(dtracer(c,l,k)) betrtracer_vars%ngwmobile_tracer_groups , & ! + tracer_group_memid => betrtracer_vars%tracer_group_memid , & ! + is_volatile => betrtracer_vars%is_volatile , & ! + is_h2o => betrtracer_vars%is_h2o , & ! + volatilegroupid => betrtracer_vars%volatilegroupid , & ! + gas2bulkcef_mobile => tracercoeff_vars%gas2bulkcef_mobile_col , & ! + aqu2bulkcef_mobile => tracercoeff_vars%aqu2bulkcef_mobile_col & ! + ) + do j = lbj, ubj + do fc = 1, num_soilc + c = filter_soilc(fc) + if(j>=jtops(c))then + do k = 1, ngwmobile_tracer_groups + trcid = tracer_group_memid(k,1) + if(is_volatile(trcid))then + kk = volatilegroupid(trcid) + Rfactor(c,j, k) = gas2bulkcef_mobile(c,j,kk) + else + Rfactor(c,j, k) = aqu2bulkcef_mobile(c,j,k) + endif + enddo + endif + enddo + enddo + + end associate + + end subroutine set_gwdif_Rfactor + + !------------------------------------------------------------------------------- + subroutine calc_ebullition(bounds, lbj, ubj, jtops, num_soilc, filter_soilc, & + forc_psrf, zi, dz, dtime, fracice, zwt, betrtracer_vars, & + tracercoeff_vars, tracerstate_vars, tracer_flx_ebu_col) + ! + ! !DESCRIPTION: + ! + ! !USES: + use tracercoeffType , only : tracercoeff_type + use tracerfluxType , only : tracerflux_type + use tracerstatetype , only : tracerstate_type + use clm_varcon , only : grav, denh2o, oneatm + + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: lbj, ubj + integer, intent(in) :: jtops(bounds%begc: ) ! top label of each column + integer, intent(in) :: num_soilc ! number of columns in column filter_soilc + integer, intent(in) :: filter_soilc(:) ! column filter_soilc + real(r8), intent(in) :: dtime + real(r8), intent(in) :: dz(bounds%begc: , lbj: ) + real(r8), intent(in) :: zi(bounds%begc: , lbj-1: ) + real(r8), intent(in) :: forc_psrf(bounds%begc: ) ! atmospheric pressure, [Pa] + real(r8), intent(in) :: fracice(bounds%begc: , lbj: ) ! fraction of ice in the soil layer, 0-1 + real(r8), intent(in) :: zwt(bounds%begc: ) ! water table depth [m] + type(betrtracer_type), intent(in) :: betrtracer_vars ! tracer info data structure + type(tracercoeff_type), intent(in) :: tracercoeff_vars ! tracer phase conversion coefficients + type(tracerstate_type), intent(inout) :: tracerstate_vars ! tracer state variables data structure + real(r8), intent(inout) :: tracer_flx_ebu_col(bounds%begc:bounds%endc, 1:betrtracer_vars%nvolatile_tracers) ! tracer ebullition + + ! !LOCAL VARIABLES: + real(r8), parameter :: icefrac_sealed=0.99_r8 !set the sealing up ice fraction + real(r8) :: bubble_flux(betrtracer_vars%nvolatile_tracers) !bubble flux, mol/m2/s + real(r8) :: press_hydro + real(r8) :: n2_pressure + real(r8) :: o2_pressure + real(r8) :: ar_pressure + real(r8) :: co2_pressure + real(r8) :: ch4_pressure + real(r8) :: total_pressure + real(r8) :: frac + integer :: vid + integer :: fc, c, j, kk + + SHR_ASSERT_ALL((ubound(jtops) == (/bounds%endc/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(forc_psrf) == (/bounds%endc/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(fracice) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(dz) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(zi) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(zwt) == (/bounds%endc/)) , errMsg(__FILE__,__LINE__)) + + associate( & + tracer_conc_mobile_col => tracerstate_vars%tracer_conc_mobile_col, & + aqu2bulkcef_mobile_col => tracercoeff_vars%aqu2bulkcef_mobile_col, & + henrycef_col => tracercoeff_vars%henrycef_col , & + volatileid => betrtracer_vars%volatileid , & + groupid => betrtracer_vars%groupid , & + volatilegroupid => betrtracer_vars%volatilegroupid , & + ngwmobile_tracers => betrtracer_vars%ngwmobile_tracers , & + nvolatile_tracers => betrtracer_vars%nvolatile_tracers , & + is_mobile => betrtracer_vars%is_mobile , & + is_volatile => betrtracer_vars%is_volatile , & + is_h2o => betrtracer_vars%is_h2o , & + id_trc_n2 => betrtracer_vars%id_trc_n2 , & + id_trc_o2 => betrtracer_vars%id_trc_o2 , & + id_trc_ar => betrtracer_vars%id_trc_ar , & + id_trc_ch4 => betrtracer_vars%id_trc_ch4 , & + id_trc_co2x => betrtracer_vars%id_trc_co2x & + ) + + if (.not. all(is_mobile((/id_trc_n2,id_trc_o2,id_trc_ar,id_trc_ch4,id_trc_co2x/)))) return + + do fc = 1, num_soilc + c = filter_soilc(fc) + !initialize bubble flux to zero + tracer_flx_ebu_col(c,:) = 0._r8 + !do not do anything if the soil is ice sealed. + if(fracice(c,1)>=icefrac_sealed)cycle + !initialize temporary bubble collecting vector + bubble_flux(:) = 0._r8 + do j = ubj, 1, -1 + !calculate the imposed atmospheric pressure plus hydrostatic pressure from water + press_hydro= max(zwt(c)-zi(c,j-1),0._r8)*denh2o*grav + forc_psrf(c) + !convert Pa into atm + press_hydro=press_hydro/oneatm + !calculate the total gas pressure + n2_pressure=calc_gas_pressure(tracer_conc_mobile_col(c,j,id_trc_n2), & + aqu2bulkcef_mobile_col(c,j,groupid(id_trc_n2)), & + henrycef_col(c, j, volatilegroupid(id_trc_n2))) + + o2_pressure=calc_gas_pressure(tracer_conc_mobile_col(c,j,id_trc_o2), & + aqu2bulkcef_mobile_col(c,j,groupid(id_trc_o2)), & + henrycef_col(c, j, volatilegroupid(id_trc_o2))) + + ar_pressure=calc_gas_pressure(tracer_conc_mobile_col(c,j,id_trc_ar), & + aqu2bulkcef_mobile_col(c,j,groupid(id_trc_ar)), & + henrycef_col(c, j, volatilegroupid(id_trc_ar))) + + co2_pressure=calc_gas_pressure(tracer_conc_mobile_col(c,j,id_trc_co2x), & + aqu2bulkcef_mobile_col(c,j,groupid(id_trc_co2x)), & + henrycef_col(c, j, volatilegroupid(id_trc_co2x))) + + ch4_pressure=calc_gas_pressure(tracer_conc_mobile_col(c,j,id_trc_ch4), & + aqu2bulkcef_mobile_col(c,j,groupid(id_trc_ch4)), & + henrycef_col(c, j, volatilegroupid(id_trc_ch4))) + + total_pressure=n2_pressure+o2_pressure+ar_pressure+co2_pressure+ch4_pressure + + if(total_pressure>press_hydro)then + !ebullition occurs + !calculate the fraction of gas to be released as bubble + frac=(total_pressure-press_hydro)/total_pressure + !note because there exisiting a relationship gas_conc*gas2bulkcef=bulk_con + !a fraction of amount frac will be released as bubbles to move upward + do kk = 1, ngwmobile_tracers + if(is_volatile(kk) .and. (.not. is_h2o(kk)))then + vid = volatileid(kk) + !the upward moving bubble flux + bubble_flux(vid) = tracer_conc_mobile_col(c,j,kk)*frac*dz(c,j) + !the readjusted tracer concentration + tracer_conc_mobile_col(c,j,kk) = tracer_conc_mobile_col(c,j,kk)*(1._r8-frac) + !add the bubbles to next layer above + if(j>1)then + tracer_conc_mobile_col(c,j-1,kk) = tracer_conc_mobile_col(c,j-1,kk) + bubble_flux(vid)/dz(c,j-1) + bubble_flux(vid) = 0._r8 + endif + endif + enddo + endif + enddo + do kk = 1, nvolatile_tracers + !+ into the atmosphere + tracer_flx_ebu_col(c,kk) = bubble_flux(kk) + enddo + + enddo + end associate + end subroutine calc_ebullition + + !------------------------------------------------------------------------------- + function calc_gas_pressure(tracer_conc, aqu2bulkcef, henrycef) result(pres_atm) + ! + ! !DESCRIPTION: + ! Calculate gas pressure using given conditions + + ! !ARGUMENTS: + real(r8), intent(in) :: tracer_conc !tracer concentrations [mol/m3] + real(r8), intent(in) :: aqu2bulkcef !conversion parameter between aqueous and bulk tracer concentrations + real(r8), intent(in) :: henrycef !henry's law constant + + ! !LOCAL VARIABLES: + real(r8) :: aqucon + real(r8) :: pres_atm !gas pressure [atm] + !compuate aqueous concentration, mol/m3 + aqucon = tracer_conc / aqu2bulkcef + !compuate partial pressure, atm + pres_atm = aqucon * 1.e-3_r8 / henrycef + + end function calc_gas_pressure + + !------------------------------------------------------------------------------- + subroutine calc_root_uptake_as_perfect_sink(bounds, lbj, ubj, num_soilc, filter_soilc, & + dtime_loc, dz, qflx_rootsoi, & + update_col, halfdt_col, tracer_conc, transp_mass) + ! + ! !DESCRIPTION: + ! calculate plant aqueous tracer uptake through transpiration into xylem + + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: lbj, ubj + integer, intent(in) :: num_soilc ! number of columns in column filter_soilc + integer, intent(in) :: filter_soilc(:) ! column filter_soilc + real(r8), intent(in) :: dz(bounds%begc: , lbj: ) ! layer thickness + real(r8), intent(in) :: dtime_loc(bounds%begc: ) + real(r8), intent(in) :: qflx_rootsoi(bounds%begc: , lbj: ) + logical, intent(in) :: update_col(bounds%begc:bounds%endc) ! logical switch for active col update + logical, intent(in) :: halfdt_col(bounds%begc:bounds%endc) + real(r8), intent(inout) :: tracer_conc(bounds%begc: , lbj: ) ! incoming tracer concentration + real(r8), intent(out) :: transp_mass(bounds%begc: ) + + ! !LOCAL VARIABLES: + real(r8) :: tracer_conc_new + integer :: fc, c, j + + SHR_ASSERT_ALL((ubound(dz) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(update_col) == (/bounds%endc/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(dtime_loc) == (/bounds%endc/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(tracer_conc) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(qflx_rootsoi) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(transp_mass) == (/bounds%endc/)) , errMsg(__FILE__,__LINE__)) + + transp_mass(:) = 0._r8 + do fc = 1, num_soilc + c = filter_soilc(fc) + if(update_col(c) .and. (.not. halfdt_col(c)))then + + do j = 1, ubj + tracer_conc_new = tracer_conc(c,j) * exp(-max(qflx_rootsoi(c,j),0._r8)*dtime_loc(c)) + transp_mass(c) = transp_mass(c) + (tracer_conc(c,j)-tracer_conc_new)*dz(c,j) + tracer_conc(c,j) = tracer_conc_new + enddo + endif + enddo + + end subroutine calc_root_uptake_as_perfect_sink + + !-------------------------------------------------------------------------------- + subroutine run_betr_one_step_with_drainage(bounds, lbj, ubj, num_soilc, filter_soilc, & + jtops, qflx_drain_vr, col, & + betrtracer_vars, tracercoeff_vars, tracerstate_vars, tracerflux_vars) + ! + ! !DESCRIPTION: + ! do tracer update due to drainage + ! + ! !USES: + use tracerfluxType , only : tracerflux_type + use tracerstatetype , only : tracerstate_type + use tracercoeffType , only : tracercoeff_type + use ColumnType , only : column_type + use MathfuncMod , only : safe_div + + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: lbj, ubj + integer, intent(in) :: num_soilc ! number of columns in column filter_soilc + integer, intent(in) :: filter_soilc(:) ! column filter_soilc + integer, intent(in) :: jtops(bounds%begc: ) + real(r8), intent(in) :: qflx_drain_vr(bounds%begc: ,lbj: ) ! + type(column_type), intent(in) :: col ! column type + type(betrtracer_type), intent(in) :: betrtracer_vars ! betr configuration information + type(tracercoeff_type), intent(in) :: tracercoeff_vars ! tracer phase conversion coefficients + type(tracerflux_type), intent(inout) :: tracerflux_vars + type(tracerstate_type), intent(inout) :: tracerstate_vars ! tracer state variables data structure + + ! !LOCAL VARIABLES: + real(r8) :: aqucon + integer :: fc, c, j, k + + SHR_ASSERT_ALL((ubound(qflx_drain_vr) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(jtops) == (/bounds%endc/)) , errMsg(__FILE__,__LINE__)) + + associate( & ! + ngwmobile_tracers => betrtracer_vars%ngwmobile_tracers , & ! + groupid => betrtracer_vars%groupid , & ! + is_h2o => betrtracer_vars%is_h2o , & ! + is_advective => betrtracer_vars%is_advective , & ! + aqu2bulkcef_mobile => tracercoeff_vars%aqu2bulkcef_mobile_col , & ! + tracer_conc_mobile => tracerstate_vars%tracer_conc_mobile_col , & ! + dz => col%dz , & ! + tracer_flx_drain => tracerflux_vars%tracer_flx_drain_col & ! + ) + + do j = lbj, ubj + do fc = 1, num_soilc + c = filter_soilc(fc) + if(j>=jtops(c))then + do k = 1, ngwmobile_tracers + !obtain aqueous concentration + if(.not. is_advective(k))cycle + aqucon = safe_div(tracer_conc_mobile(c,j,k),aqu2bulkcef_mobile(c,j,groupid(k))) + if(.not. is_h2o(k))then + tracer_flx_drain(c,k) = tracer_flx_drain(c,k) + aqucon * max(qflx_drain_vr(c,j),0._r8) + tracer_conc_mobile(c,j,k) = tracer_conc_mobile(c,j,k) - aqucon * max(qflx_drain_vr(c,j),0._r8)/dz(c,j) + if(tracer_conc_mobile(c,j,k)<0._r8)then + tracer_flx_drain(c,k) = tracer_flx_drain(c,k)+tracer_conc_mobile(c,j,k)*dz(c,j) + tracer_conc_mobile(c,j,k)=0._r8 + endif + else + !when drainage is negative, this could result in mass balance problem + tracer_flx_drain(c,k) = tracer_flx_drain(c,k) + aqucon * max(qflx_drain_vr(c,j),0._r8) + tracer_conc_mobile(c,j,k) = tracer_conc_mobile(c,j,k) - aqucon * max(qflx_drain_vr(c,j),0._r8)/dz(c,j) + endif + enddo + endif + enddo + enddo + !diagnose gas pressure + call diagnose_gas_pressure(bounds, lbj, ubj, num_soilc, filter_soilc, & + betrtracer_vars, tracercoeff_vars, tracerstate_vars) + + end associate + end subroutine run_betr_one_step_with_drainage + + !-------------------------------------------------------------------------------- + subroutine calc_tracer_surface_runoff(bounds, lbj, ubj, num_soilc, filter_soilc, & + fracice_top, dz_top2, waterstate_vars, waterflux_vars, betrtracer_vars, & + tracerstate_vars, tracercoeff_vars, tracerflux_vars) + ! + ! !DESCRIPTION: + ! calculate tracer loss through surface water runoff + ! + ! !USES: + use clm_time_manager , only : get_step_size + use WaterStateType , only : Waterstate_Type + use WaterfluxType , only : waterflux_type + use tracerfluxType , only : tracerflux_type + use tracerstatetype , only : tracerstate_type + use tracercoeffType , only : tracercoeff_type + use MathfuncMod , only : safe_div + use clm_varcon , only : denh2o + + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: lbj, ubj + integer, intent(in) :: num_soilc ! number of columns in column filter_soilc + integer, intent(in) :: filter_soilc(:) ! column filter_soilc + real(r8), intent(in) :: fracice_top(bounds%begc:bounds%endc) ! ice fraction of topsoil + real(r8), intent(in) :: dz_top2(bounds%begc:bounds%endc, 1:ubj) ! node depth of the first 2 soil layers + type(Waterstate_Type), intent(in) :: waterstate_vars + type(waterflux_type), intent(in) :: waterflux_vars + type(betrtracer_type), intent(in) :: betrtracer_vars ! betr configuration information + type(tracercoeff_type), intent(in) :: tracercoeff_vars ! tracer phase conversion coefficients + type(tracerflux_type), intent(inout) :: tracerflux_vars ! tracer flux + type(tracerstate_type), intent(inout) :: tracerstate_vars ! tracer state variables data structure + + ! !LOCAL VARIABLES: + integer :: fc, c, j, k + real(r8) :: scal + real(r8) :: fracc(2) + real(r8) :: h2o_srun ! total amount of water lost as surface runoff + real(r8) :: trc_srun ! + real(r8) :: dloss + real(r8) :: dtime + real(r8) :: total + real(r8) :: frac1 + real(r8) :: dtmp + associate( & + ngwmobile_tracers => betrtracer_vars%ngwmobile_tracers , & ! + groupid => betrtracer_vars%groupid , & ! + is_advective => betrtracer_vars%is_advective , & ! + is_h2o => betrtracer_vars%is_h2o , & !Input [logical (:)] indicator whether it is a H2O tracer + h2osoi_liqvol => waterstate_vars%h2osoi_liqvol_col , & ! + qflx_surf => waterflux_vars%qflx_surf_col , & !Input [real(r8) (:)] surface runoff [mm H2O/s] + tracer_conc_surfwater => tracerstate_vars%tracer_conc_surfwater_col , & !Inout [real(r8) (:,:)] tracer concentration in surface water + tracer_conc_mobile => tracerstate_vars%tracer_conc_mobile_col , & ! + aqu2bulkcef_mobile => tracercoeff_vars%aqu2bulkcef_mobile_col , & ! + tracer_flx_surfrun => tracerflux_vars%tracer_flx_surfrun_col & !Output[real(r8) (:,:)] tracer loss through surface runoff + + ) + + dtime = get_step_size() + do fc = 1, num_soilc + c = filter_soilc(fc) + !it is assumed the surface runoff water mixes perfectly with that of the first two soil nodes, so that a proportion goes off with surface runoff + + !Obtain the total volume + if(qflx_surf(c)==0._r8)cycle + !volume of water coming from surface runoff + h2o_srun = qflx_surf(c) * dtime / denh2o + !total volume of water + total = h2o_srun+ h2osoi_liqvol(c,1) * dz_top2(c,1) + h2osoi_liqvol(c,2) * dz_top2(c,2) * (1._r8-fracice_top(c)) + !fraction lost through liquid water surface runoff + frac1 = h2o_srun/total + + do j = 1, ngwmobile_tracers + + if(.not. is_advective(j))cycle + !Do not do this for water tracer, maybe I can do it. + if(is_h2o(j))cycle + tracer_conc_surfwater(c,j) = 0._r8 !at this moment it is set to zero, however, when tracer is tracked in snow, it should be non-zero + trc_srun = tracer_conc_surfwater(c,j) * h2o_srun !total tracer mass in runoff water before mixing + total = trc_srun + do k = 1, 2 + if(k==1)then + scal = 1._r8 + else + scal=1._r8-fracice_top(c) !reduce the water flush due to ice forst in layer 1 + endif + fracc(k) = safe_div(tracer_conc_mobile(c,k,j), aqu2bulkcef_mobile(c,k,groupid(j))) * h2osoi_liqvol(c,k) * dz_top2(c,k) * scal + total = total + fracc(k) !total mass + enddo + !assume perfect mix and obtain the net loss through surface runoff + dloss = total * frac1 + + !total export through runoff + tracer_flx_surfrun(c,j) = dloss + + !increase of tracer in the surface runoff + dloss = dloss - trc_srun + dtmp = fracc(1)+fracc(2) + + tracer_conc_mobile(c,1,j) = tracer_conc_mobile(c,1,j) - dloss*safe_div(fracc(1),dtmp)/dz_top2(c,1) + tracer_conc_mobile(c,2,j) = tracer_conc_mobile(c,2,j) - dloss*safe_div(fracc(2),dtmp)/dz_top2(c,2) + tracer_conc_surfwater(c,j) = tracer_flx_surfrun(c,j)/h2o_srun !revise the tracer concentration in runoff + + enddo + enddo + + end associate + end subroutine calc_tracer_surface_runoff + + !-------------------------------------------------------------------------------- + subroutine calc_dew_sub_flux(bounds, num_hydrologyc, filter_soilc_hydrologyc, & + waterstate_vars, waterflux_vars, betrtracer_vars, tracerflux_vars, tracerstate_vars) + ! + ! DESCRIPTION: + ! calculate water flux from dew formation, and sublimation + ! !USES: + use clm_time_manager , only : get_step_size + use ColumnType , only : col + use LandunitType , only : lun + use WaterfluxType , only : waterflux_type + use WaterstateType , only : waterstate_type + use tracerfluxType , only : tracerflux_type + use tracerstatetype , only : tracerstate_type + use clm_varcon , only : denh2o,spval + use landunit_varcon , only : istsoil, istcrop + + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_hydrologyc ! number of column soil points in column filter_soilc + integer , intent(in) :: filter_soilc_hydrologyc(:) ! column filter_soilc for soil points + type(waterstate_type) , intent(in) :: waterstate_vars + type(waterflux_type) , intent(in) :: waterflux_vars + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(tracerflux_type) , intent(inout) :: tracerflux_vars ! tracer flux + type(tracerstate_type) , intent(inout) :: tracerstate_vars ! tracer state variables data structure + + ! !LOCAL VARIABLES: + real(r8) :: dtime + integer :: fc, c, j, l + + associate( & ! + snl => col%snl , & ! Input: [integer (:) ] number of snow layers + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer depth (m) + h2osoi_ice => waterstate_vars%h2osoi_ice_col , & ! Output: [real(r8) (:,:) ] ice lens (kg/m2) + frac_h2osfc => waterstate_vars%frac_h2osfc_col , & ! Input: [real(r8) (:) ] + qflx_dew_grnd => waterflux_vars%qflx_dew_grnd_col , & ! Input: [real(r8) (:) ] ground surface dew formation (mm H2O /s) [+] + qflx_dew_snow => waterflux_vars%qflx_dew_snow_col , & ! Input: [real(r8) (:) ] surface dew added to snow pack (mm H2O /s + qflx_sub_snow => waterflux_vars%qflx_sub_snow_col , & ! Output: [real(r8) (:) ] sublimation rate from snow pack (mm H2O /s) + tracer_flx_dew_grnd=> tracerflux_vars%tracer_flx_dew_grnd_col , & ! + tracer_flx_dew_snow=> tracerflux_vars%tracer_flx_dew_snow_col , & ! + tracer_flx_sub_snow=> tracerflux_vars%tracer_flx_sub_snow_col , & ! + tracer_conc_mobile => tracerstate_vars%tracer_conc_mobile_col , & ! + is_h2o => betrtracer_vars%is_h2o , & ! + tracernames => betrtracer_vars%tracernames , & + clandunit => col%landunit , & ! Input: [integer (:) ] columns's landunit + ltype => lun%itype , & ! Input: [integer (:) ] landunit type + ngwmobile_tracers => betrtracer_vars%ngwmobile_tracers & + ) + + dtime = get_step_size() + + do j = 1, ngwmobile_tracers + !now only do water isotope tracer + if(.not. is_h2o(j))cycle + + do fc = 1, num_hydrologyc + c = filter_soilc_hydrologyc(fc) + l = clandunit(c) + if (ltype(l)/=istsoil .and. ltype(l)/=istcrop)cycle + if(snl(c)+1>=1)then + tracer_flx_dew_grnd(c, j) = (1._r8 - frac_h2osfc(c))*qflx_dew_grnd(c) * dtime/denh2o + tracer_flx_dew_snow(c, j) = (1._r8 - frac_h2osfc(c))*qflx_dew_snow(c) * dtime/denh2o + if(h2osoi_ice(c,1)==0._r8)then + tracer_flx_sub_snow(c, j) = qflx_sub_snow(c) * dtime/denh2o + else + tracer_flx_sub_snow(c, j) = (1._r8 - frac_h2osfc(c)) * qflx_sub_snow(c) * dtime/denh2o + endif + else + tracer_flx_dew_grnd(c, j) = 0._r8 + tracer_flx_dew_snow(c, j) = 0._r8 + tracer_flx_sub_snow(c, j) = 0._r8 + endif + enddo + enddo + + !apply those fluxes + do j = 1, ngwmobile_tracers + do fc = 1, num_hydrologyc + c = filter_soilc_hydrologyc(fc) + l = clandunit(c) + if (ltype(l)/=istsoil .and. ltype(l)/=istcrop)cycle + tracer_conc_mobile(c,1,j) = tracer_conc_mobile(c,1,j) + (tracer_flx_dew_grnd(c, j)+tracer_flx_dew_snow(c, j)-tracer_flx_sub_snow(c,j))/dz(c,1) + + enddo + enddo + end associate + end subroutine calc_dew_sub_flux + + !-------------------------------------------------------------------------------- + subroutine calc_tracer_h2osfc_snow_residual_combine(bounds, num_soilc, filter_soilc, & + waterflux_vars, betrtracer_vars, tracerstate_vars, tracerflux_vars) + ! + ! !DESCRIPTION: + ! apply tracer flux from combining residual snow and ponding water + ! !USES: + use clm_time_manager , only : get_step_size + use ColumnType , only : col + use WaterfluxType , only : waterflux_type + use tracerfluxType , only : tracerflux_type + use tracerstatetype , only : tracerstate_type + use clm_varcon , only : denh2o + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of column soil points in column filter_soilc + integer , intent(in) :: filter_soilc(:) ! column filter_soilc for soil points + type(waterflux_type) , intent(in) :: waterflux_vars + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(tracerflux_type) , intent(inout) :: tracerflux_vars ! tracer flux + type(tracerstate_type) , intent(inout) :: tracerstate_vars ! tracer state variables data structure + + ! !LOCAL VARIABLES: + real(r8) :: dtime + integer :: fc, c, j + + associate( & ! + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer depth (m) + qflx_snow2topsoi => waterflux_vars%qflx_snow2topsoi_col , & ! Input: [real(r8) (:) ] ground surface dew formation (mm H2O /s) [+] + qflx_h2osfc2topsoi => waterflux_vars%qflx_h2osfc2topsoi_col , & ! Input: [real(r8) (:) ] surface dew added to snow pack (mm H2O /s + tracer_flx_h2osfc_snow_residual => tracerflux_vars%tracer_flx_h2osfc_snow_residual_col, & ! + tracer_conc_mobile => tracerstate_vars%tracer_conc_mobile_col , & ! + is_h2o => betrtracer_vars%is_h2o , & ! + tracernames => betrtracer_vars%tracernames , & ! + ngwmobile_tracers => betrtracer_vars%ngwmobile_tracers & ! + ) + + + dtime = get_step_size() + do j = 1, ngwmobile_tracers + + if(.not. is_h2o(j))cycle + + do fc = 1, num_soilc + c = filter_soilc(fc) + + tracer_flx_h2osfc_snow_residual(c,j) = (qflx_snow2topsoi(c) + qflx_h2osfc2topsoi(c))*dtime/denh2o + tracer_conc_mobile(c,1,j) = tracer_conc_mobile(c,1,j) + tracer_flx_h2osfc_snow_residual(c,j) /dz(c,1) + + enddo + enddo + + end associate + end subroutine calc_tracer_h2osfc_snow_residual_combine + + !-------------------------------------------------------------------------------- + subroutine diagnose_gas_pressure(bounds, lbj, ubj, num_soilc, filter_soilc, & + betrtracer_vars, tracercoeff_vars, tracerstate_vars) + + ! + ! !DESCRIPTION: + ! diagnose gas pressure + + ! !USES: + use tracercoeffType , only : tracercoeff_type + use tracerfluxType , only : tracerflux_type + use tracerstatetype , only : tracerstate_type + use MathfuncMod , only : safe_div + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: lbj, ubj + integer, intent(in) :: num_soilc ! number of columns in column filter_soilc + integer, intent(in) :: filter_soilc(:) ! column filter_soilc + type(betrtracer_type), intent(in) :: betrtracer_vars ! tracer info data structure + type(tracercoeff_type), intent(in) :: tracercoeff_vars ! tracer phase conversion coefficients + type(tracerstate_type), intent(inout) :: tracerstate_vars ! tracer state variables data structure + + ! !LOCAL VARIABLES: + integer :: j, fc, c, jj + real(r8) :: total_pres + + associate( & + tracer_conc_mobile_col => tracerstate_vars%tracer_conc_mobile_col, & + tracer_P_gas_frac_col => tracerstate_vars%tracer_P_gas_frac_col , & + aqu2bulkcef_mobile_col => tracercoeff_vars%aqu2bulkcef_mobile_col, & + henrycef_col => tracercoeff_vars%henrycef_col , & + volatilegroupid => betrtracer_vars%volatilegroupid , & + volatileid => betrtracer_vars%volatileid , & + groupid => betrtracer_vars%groupid , & + ngwmobile_tracers => betrtracer_vars%ngwmobile_tracers , & + is_volatile => betrtracer_vars%is_volatile , & + is_isotope => betrtracer_vars%is_isotope , & + is_h2o => betrtracer_vars%is_h2o & + + ) + + do fc = 1, num_soilc + c = filter_soilc(fc) + do j = 1, ubj + !calculate the total gas pressure + total_pres=0._r8 + do jj = 1, ngwmobile_tracers + + if(is_volatile(jj) .and. (.not. is_h2o(jj)) .and. (.not. is_isotope(jj)))then + tracer_P_gas_frac_col(c,j, volatileid(jj)) = calc_gas_pressure(tracer_conc_mobile_col(c,j,jj), & + aqu2bulkcef_mobile_col(c,j,groupid(jj)), henrycef_col(c, j, volatilegroupid(jj))) + total_pres=total_pres + tracer_P_gas_frac_col(c,j, volatileid(jj)) + endif + enddo + do jj = 1, ngwmobile_tracers + if(is_volatile(jj) .and. (.not. is_h2o(jj)) .and. (.not. is_isotope(jj)))then + tracer_P_gas_frac_col(c,j, volatileid(jj)) = safe_div(tracer_P_gas_frac_col(c,j, volatileid(jj)),total_pres) + endif + enddo + enddo + enddo + end associate + end subroutine diagnose_gas_pressure + +end module BetrBGCMod diff --git a/components/clm/src/betr/PlantSoilnutrientFluxType.F90 b/components/clm/src/betr/PlantSoilnutrientFluxType.F90 new file mode 100644 index 000000000000..126e62d4cb5e --- /dev/null +++ b/components/clm/src/betr/PlantSoilnutrientFluxType.F90 @@ -0,0 +1,364 @@ +module PlantSoilnutrientFluxType +#include "shr_assert.h" + !!DESCRIPTION: + ! data structure for above/below ground nutrient coupling. + ! The vision is beyond nitrogen, which probably extends to P, S and ect. + ! This is part of BeTRbgc + ! Created by Jinyun Tang, Jan 11, 2015 + ! + ! !USES: + ! + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varctl , only : iulog + use clm_time_manager , only : get_nstep + use clm_varcon , only : spval, ispval + use decompMod , only : bounds_type + use ColumnType , only : col + use PatchType , only : pft + ! !PUBLIC TYPES: + implicit none + save + private + ! + type, public :: plantsoilnutrientflux_type + + real(r8), pointer :: plant_minn_active_yield_flx_col (:) !column level mineral nitrogen yield from soil bgc calculation + real(r8), pointer :: plant_minn_passive_yield_flx_col (:) + real(r8), pointer :: plant_minn_active_yield_flx_patch (:) !patch level mineral nitrogen yeild from soil bgc calculation + real(r8), pointer :: plant_minn_passive_yield_flx_patch (:) !patch level mineral nitrogen yeild from soil bgc calculation + real(r8), pointer :: plant_minn_active_yield_flx_vr_col (:, :) !layer specific active mineral nitrogen yield + real(r8), pointer :: plant_minn_uptake_potential_patch (:) + real(r8), pointer :: plant_minn_uptake_potential_col (:) + real(r8), pointer :: plant_minn_uptake_potential_vr_patch (:,:) !plant mineral nitrogen uptake potential for each layer + real(r8), pointer :: plant_minn_uptake_potential_vr_col (:,:) !plant mineral nitrogen uptake potential for each layer + real(r8), pointer :: plant_totn_demand_flx_col (:) !column level total nitrogen demand, g N/m2/s + real(r8), pointer :: fppnd_col (:) !fraction of fufilled nitrogen demand + real(r8), pointer :: plant_frootsc_vr_col (:,:) !fine root for nutrient uptake + real(r8), pointer :: plant_frootsc_col (:) !fine root for nutrient uptake + + contains + + procedure , public :: Init + procedure , public :: SetValues + procedure , public :: summary + procedure , public :: calc_nutrient_uptake_potential + procedure , private :: InitAllocate + procedure , private :: InitHistory + procedure , private :: InitCold + end type plantsoilnutrientflux_type + + contains + !------------------------------------------------------------------------ + subroutine Init(this, bounds, lbj, ubj) + ! + ! !DESCRIPTION: + ! initialize data type + ! + ! !ARGUMENTS: + class(plantsoilnutrientflux_type) :: this + type(bounds_type), intent(in) :: bounds + + integer , intent(in) :: lbj, ubj + + call this%InitAllocate (bounds, lbj, ubj) + call this%InitHistory (bounds) + call this%InitCold (bounds) + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine InitAllocate(this, bounds, lbj, ubj) + ! + ! !DESCRIPTION: + ! Initialize pft nitrogen flux + ! + ! !ARGUMENTS: + class (plantsoilnutrientflux_type) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: lbj, ubj + ! + ! !LOCAL VARIABLES: + integer :: begp,endp + integer :: begc,endc + + !------------------------------------------------------------------------ + + begp = bounds%begp; endp = bounds%endp + begc = bounds%begc; endc = bounds%endc + + allocate(this%plant_minn_active_yield_flx_patch (begp:endp )) ; this%plant_minn_active_yield_flx_patch (:) = nan + allocate(this%plant_minn_passive_yield_flx_patch (begp:endp )) ; this%plant_minn_passive_yield_flx_patch (:) = nan + allocate(this%plant_minn_uptake_potential_patch (begp:endp )) ; this%plant_minn_uptake_potential_patch (:) = nan + allocate(this%plant_minn_uptake_potential_col (begc:endc )) ; this%plant_minn_uptake_potential_col (:) = nan + allocate(this%fppnd_col (begc:endc )) ; this%fppnd_col (:) = nan + + + allocate(this%plant_minn_active_yield_flx_col (begc:endc )) ; this%plant_minn_active_yield_flx_col (:) = nan + allocate(this%plant_minn_passive_yield_flx_col (begc:endc )) ; this%plant_minn_passive_yield_flx_col (:) = nan + + allocate(this%plant_minn_active_yield_flx_vr_col (begc:endc, lbj:ubj )) ; this%plant_minn_active_yield_flx_vr_col (:,:) = nan + + allocate(this%plant_totn_demand_flx_col (begc:endc )) ; this%plant_totn_demand_flx_col (:) = nan + + allocate(this%plant_frootsc_col (begc:endc )) ; this%plant_frootsc_col (:) = nan + allocate(this%plant_frootsc_vr_col (begc:endc,lbj:ubj )) ; this%plant_frootsc_vr_col (:,:) = nan + + end subroutine InitAllocate + + !------------------------------------------------------------------------ + subroutine InitHistory(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize module data structure + ! + ! + ! !USES: + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use clm_varpar , only : nlevsno, nlevgrnd, crop_prog, nlevtrc_soil + use histFileMod , only : hist_addfld1d, hist_addfld2d, hist_addfld_decomp + ! + ! !ARGUMENTS: + class(plantsoilnutrientflux_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: k,l + integer :: begp, endp + integer :: begc, endc + character(10) :: active + character(24) :: fieldname + character(100) :: longname + character(8) :: vr_suffix + real(r8), pointer :: data2dptr(:,:), data1dptr(:) ! temp. pointers for slicing larger arrays + !------------------------------------------------------------------------ + + begp = bounds%begp; endp= bounds%endp + begc = bounds%begc; endc= bounds%endc + + this%plant_minn_active_yield_flx_patch(begp:endp) = spval + call hist_addfld1d (fname='PLANT_MINN_ACTIVE_YIELD_FLX_PATCH', units='gN/m^2/s', & + avgflag='A', long_name='plant nitrogen active uptake flux from soil', & + ptr_patch=this%plant_minn_active_yield_flx_patch, default='inactive') + + this%plant_minn_passive_yield_flx_patch(begp:endp) = spval + call hist_addfld1d (fname='PLANT_MINN_PASSIVE_YIELD_FLX_PATCH', units='gN/m^2/s', & + avgflag='A', long_name='plant nitrogen passive uptake flux from soil', & + ptr_patch=this%plant_minn_passive_yield_flx_patch, default='inactive') + + this%fppnd_col(begc:endc) = spval + call hist_addfld1d (fname='FPPND', units='none', & + avgflag='A', long_name='fulfilled plant nitrogen demand from mineral nitrogen uptake', & + ptr_col=this%fppnd_col) + + this%plant_minn_active_yield_flx_col(begc:endc) = spval + call hist_addfld1d (fname='PLANT_MINN_ACTIVE_YIELD_FLX_COL', units='gN/m^2/s', & + avgflag='A', long_name='plant nitrogen active uptake flux from soil', & + ptr_col=this%plant_minn_active_yield_flx_col) + + this%plant_minn_passive_yield_flx_col(begc:endc) = spval + call hist_addfld1d (fname='PLANT_MINN_PASSIVE_YIELD_FLX_COL', units='gN/m^2/s', & + avgflag='A', long_name='plant nitrogen passive uptake flux from soil', & + ptr_col=this%plant_minn_passive_yield_flx_col) + + + this%plant_minn_active_yield_flx_vr_col(begc:endc,:) = spval + call hist_addfld_decomp (fname='PLANT_MINN_ACTIVE_YIELD_FLX_vr', units='gN/m^3/s', type2d='levtrc', & + avgflag='A', long_name='plant nitrogen active_uptake flux from soil', & + ptr_col=this%plant_minn_active_yield_flx_vr_col, default='inactive') + + + this%plant_totn_demand_flx_col(begc:endc) = spval + call hist_addfld1d (fname='PLANT_TOTN_DEMAND_FLX', units='gN/m^2/s', & + avgflag='A', long_name='plant nitrogen demand flux', & + ptr_col=this%plant_totn_demand_flx_col, default='inactive') + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine SetValues ( this, & + num_patch, filter_patch, value_patch, & + num_column, filter_column, value_column) + ! + ! !DESCRIPTION: + ! Set nitrogen flux variables + ! + ! !ARGUMENTS: + class (plantsoilnutrientflux_type) :: this + integer , intent(in) :: num_patch + integer , intent(in) :: filter_patch(:) + real(r8), intent(in) :: value_patch + integer , intent(in) :: num_column + integer , intent(in) :: filter_column(:) + real(r8), intent(in) :: value_column + ! + ! !LOCAL VARIABLES: + integer :: fi,i,j,k,l ! loop index + !------------------------------------------------------------------------ + + do fi = 1,num_patch + i=filter_patch(fi) + this%plant_minn_active_yield_flx_patch(i) = value_patch + this%plant_minn_passive_yield_flx_patch(i) = value_patch + enddo + + do fi = 1,num_column + i = filter_column(fi) + this%plant_minn_active_yield_flx_col(i) = value_column + this%plant_minn_passive_yield_flx_col(i) = value_column + this%plant_totn_demand_flx_col(i) = value_column + this%fppnd_col(i) = value_column + enddo + + end subroutine SetValues + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds) + ! + ! !DESCRIPTION: + ! Initializes time varying variables used only in coupled carbon-nitrogen mode (CN): + ! + ! !USES: + use clm_varpar , only : crop_prog + use landunit_varcon , only : istsoil, istcrop + use LandunitType , only : lun + ! + ! !ARGUMENTS: + class(plantsoilnutrientflux_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: p,c,l + integer :: fp, fc ! filter indices + integer :: num_special_col ! number of good values in special_col filter + integer :: num_special_patch ! number of good values in special_patch filter + integer :: special_col(bounds%endc-bounds%begc+1) ! special landunit filter - columns + integer :: special_patch(bounds%endp-bounds%begp+1) ! special landunit filter - patches + + + ! Set column filters + + num_special_col = 0 + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if (lun%ifspecial(l)) then + num_special_col = num_special_col + 1 + special_col(num_special_col) = c + end if + end do + + ! Set patch filters + + num_special_patch = 0 + do p = bounds%begp,bounds%endp + l = pft%landunit(p) + if (lun%ifspecial(l)) then + num_special_patch = num_special_patch + 1 + special_patch(num_special_patch) = p + end if + end do + + + call this%SetValues (& + num_patch=num_special_patch, filter_patch=special_patch, value_patch=0._r8, & + num_column=num_special_col, filter_column=special_col, value_column=0._r8) + end subroutine InitCold + + !----------------------------------------------------------------------- + subroutine summary(this, bounds, ubj, num_soilc, filter_soilc, dz, nh4_transp, no3_transp) + ! + ! !DESCRIPTION: + ! summarize state variables from different subpools/subfluxes + ! !USES: + use MathfuncMod , only : dot_sum + use clm_time_manager , only : get_step_size + use clm_varcon , only : natomw + + ! !ARGUMENTS: + class(plantsoilnutrientflux_type) :: this + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: num_soilc + integer, intent(in) :: filter_soilc(:) + integer, intent(in) :: ubj + real(r8), intent(in) :: dz(bounds%begc:bounds%endc,1:ubj) + real(r8), intent(in) :: nh4_transp(bounds%begc:bounds%endc) + real(r8), intent(in) :: no3_transp(bounds%begc:bounds%endc) + + ! !LOCAL VARIABLES: + integer :: fc, c, j + real(r8) :: dtime + + dtime = get_step_size() + + do fc = 1, num_soilc + c = filter_soilc(fc) + this%plant_minn_active_yield_flx_col(c) =dot_sum(this%plant_minn_active_yield_flx_vr_col(c,1:ubj),dz(c,1:ubj))/dtime + this%plant_minn_passive_yield_flx_col(c) =(nh4_transp(c) + no3_transp(c))*natomw/dtime + + if (this%plant_minn_uptake_potential_col(c)>0._r8) then + this%fppnd_col(c) = (this%plant_minn_active_yield_flx_col(c) + & + this%plant_minn_passive_yield_flx_col(c))/this%plant_minn_uptake_potential_col(c) + else + this%fppnd_col(c) = 1._r8 + endif + enddo + + end subroutine summary + +!-------------------------------------------------------------------------------- + + subroutine calc_nutrient_uptake_potential(this, bounds, num_soilc, filter_soilc, & + num_soilp, filter_soilp, frootc_patch) + ! + ! !DESCRIPTION: + ! diagnose the vmax for nutrient uptake, with the vision to use ECA or something alike. + ! + ! !USES: + use subgridAveMod , only : p2c + use GridcellType , only : grc + + ! + ! !ARGUMENTS: + class(plantsoilnutrientflux_type) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc + integer , intent(in) :: filter_soilc(:) + integer , intent(in) :: num_soilp + integer , intent(in) :: filter_soilp(:) + real(r8) , intent(in) :: frootc_patch(bounds%begp:bounds%endp) + + ! !LOCAL VARIABLES: + real(r8) :: Vmax_minn = 1.e-6_r8 ! gN/gC/s + integer :: fp, p, fc, c + real(r8) :: nscal = 1._r8 + + SHR_ASSERT_ALL((ubound(frootc_patch) == (/bounds%endp/)), errMsg(__FILE__,__LINE__)) + !calculate root nitrogen uptake potential + + !default approach + ! + do fc = 1, num_soilc + c = filter_soilc(fc) + this%plant_minn_uptake_potential_col(c) = this%plant_totn_demand_flx_col(c)*nscal + enddo + + call p2c(bounds, num_soilc, filter_soilc, frootc_patch, this%plant_frootsc_col) + +#if 0 + !new approach + do fp = 1, num_soilp + p = filter_soilp(fp) + c = pft%column(p) + this%plant_minn_uptake_potential_patch(p) = Vmax_minn*max(frootc_patch(p),10._r8) + if(abs(grc%latdeg(col%gridcell(c)))<20._r8)this%plant_minn_uptake_potential_patch(p) = this%plant_minn_uptake_potential_patch(p) * 1.e3_r8 + enddo + + ! now use the p2c routine to get the column-averaged plant_ndemand + call p2c(bounds, num_soilc, filter_soilc, & + this%plant_minn_uptake_potential_patch(bounds%begp:bounds%endp), & + this%plant_minn_uptake_potential_col(bounds%begc:bounds%endc)) +#endif + +end subroutine calc_nutrient_uptake_potential + +end module PlantSoilnutrientFluxType diff --git a/components/clm/src/betr/SOMStateVarUpdateMod.F90 b/components/clm/src/betr/SOMStateVarUpdateMod.F90 new file mode 100644 index 000000000000..bdd8ab8b5ca6 --- /dev/null +++ b/components/clm/src/betr/SOMStateVarUpdateMod.F90 @@ -0,0 +1,33 @@ +module SOMStateVarUpdateMod + ! + ! DESCRIPTION: + ! subroutines to update state variables of any + ! reaction based bgc module + ! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + implicit none + public :: calc_dtrend_som_bgc + +contains + + !----------------------------------------------------------------------- + subroutine calc_dtrend_som_bgc(nx, ny, cascade_matrix, reaction_rates, dxdt) + ! + ! !DESCRIPTION: + ! return the temporal trend of the state variables + implicit none + ! !ARGUMENTS: + integer, intent(in) :: nx, ny + real(r8), intent(in) :: cascade_matrix(1:nx,1:ny) + real(r8), intent(in) :: reaction_rates(1:ny) + real(r8), intent(out):: dxdt(1:nx) + + !intel mkl f90 interface + !call gemv(cascade_matrix, reaction_rates, dxdt, alpha=1._r8, beta=0._r8) + ! BLAS INTERFACE + ! DGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) + call dgemv('N', nx, ny, 1._r8, cascade_matrix, nx, reaction_rates, 1, 0._r8, dxdt, 1) + + end subroutine calc_dtrend_som_bgc + +end module SOMStateVarUpdateMod diff --git a/components/clm/src/betr/betr_core/BeTRTracerType.F90 b/components/clm/src/betr/betr_core/BeTRTracerType.F90 new file mode 100644 index 000000000000..5864451652b5 --- /dev/null +++ b/components/clm/src/betr/betr_core/BeTRTracerType.F90 @@ -0,0 +1,260 @@ +module BeTRTracerType + !------------------------------------------------------------------------------ + ! !DESCRIPTION: + ! data type to configure betr simulations + ! + ! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + use decompMod , only : bounds_type + ! + implicit none + private + + + !---------------------------------------------------- + !betr tracer setup structure + !---------------------------------------------------- + type, public :: BeTRtracer_type + character(len=255) :: betr_simname ! name of the simulation + integer :: nmem_max ! maximum number of members in a transport group + integer :: ntracers ! total number of tracers, gas/aqueous tracers + solid tracers that undergo active mineral protection + integer :: ngwmobile_tracers ! total number of tracers potentially undergoing gas/aqueous movement + integer :: nvolatile_tracers ! number of volatile_tracers + integer :: nsolid_equil_tracers ! number of tracers that undergo equilibrium adsorption in soil could include adsorbed doc, nh4(+) + integer :: nsolid_passive_tracers ! number of tracers that undergo active mineral protection + + integer :: ntracer_groups ! + integer :: ngwmobile_tracer_groups ! total number of groups for mobile tracers + integer :: nvolatile_tracer_groups ! sub group within gwmobile group + integer :: nsolid_equil_tracer_groups ! sub group in solid group + integer :: nsolid_passive_tracer_groups ! sub group in solid group + + integer :: nh2o_tracers ! number of h2o tracers, this will be used to compute vapor gradient and thermal gradient driven isotopic flow + logical :: is_oddstep = .true. !this is not used now, originally was included to set up alternative numerical methods + integer :: id_trc_n2 ! tag for n2 + integer :: id_trc_o2 ! tag for co2 + integer :: id_trc_ar ! tag for ar + integer :: id_trc_co2x ! tag for co2 and its related species, co2x(CO2, H2CO3, HCO3(-), CO3(2-)), + integer :: id_trc_ch4 ! tag for methane + + integer :: id_trc_no ! tag for no + integer :: id_trc_n2o ! tag for n2o + integer :: id_trc_air_co2x ! tag for atmospheric co2 + integer :: id_trc_arrt_co2x ! tag for autotrophic co2 + integer :: id_trc_hrsoi_co2x ! tag for heterotrophic co2 + integer :: id_trc_nh3x ! tag for nh3 and its related species, nh3x(NH3, NH4OH,NH4(+)) + integer :: id_trc_no3x ! tag for no3 and its related species, no3x(HNO3,NO3(-)) + integer :: id_trc_no2x ! tag for no2 and its related species, no2x(HNO2,NO2(-)) + integer :: id_trc_dom ! tag for generic dissolved organic matter + integer :: id_trc_doc ! tag for generic dissolved organic carbon, used for testing single carbon pool model + + + integer :: id_trc_o18_h2o ! tag for H2O(18) + integer :: id_trc_o17_h2o ! tag for H2O(17) + integer :: id_trc_o18_h2o_ice ! tag for H2O(18) in ice + integer :: id_trc_d_h2o ! tag for DHO + integer :: id_trc_d_h2o_ice ! tag for DHO in ice + integer :: id_trc_c13_co2x ! tag for C(13)O2 and its related species + integer :: id_trc_c14_co2x ! tag for C(14)O2 and its related species + integer :: id_trc_o18_co2x ! tag for O(18)CO and its related species + integer :: id_trc_o17_co2x ! tag for O(17)CO and its related species + + integer :: id_trc_o18_o2 ! tag for O(18)O and its related species + integer :: id_trc_o17_o2 ! tag for O(17)O and its related species + integer, pointer :: id_trc_h2o_tags(:) !tagged h2o tracers + + logical, pointer :: is_volatile(:) !flag for volatile species, true/false, (yes/no) + logical, pointer :: is_diffusive(:) + logical, pointer :: is_adsorb(:) !flag for adsorbable species, true/false (year/no), in equilibrium with aqueous phase and/or gaseous phase + logical, pointer :: is_advective(:) !flag for advective species, some species, like non-dissolved som does not undergo advection, rather bioturbation is the major mechanism for vertical transport + logical, pointer :: is_mobile(:) !flag indicating whether the tracer is mobile or inert, when it is innert, do not move it around + logical, pointer :: is_h2o(:) !flag for water isotope + logical, pointer :: is_co2tag(:) !tagged co2 tracer? + logical, pointer :: is_dom(:) !true if it is a dom tracer, place holder for rtm bgc + logical, pointer :: is_isotope(:) + integer, pointer :: refisoid(:) !reference tracer for isotope calculation, this is setup only for non-h2o isotope now + integer, pointer :: adsorbid(:) !which tracer is adsorbed + integer, pointer :: volatileid(:) + integer, pointer :: h2oid(:) + integer, pointer :: adsorbgroupid(:) + integer, pointer :: volatilegroupid(:) ! + integer, pointer :: groupid(:) + + logical :: is_tagged_h2o =.false. !no tagged h2o run by default + real(r8),pointer :: tracer_solid_passive_diffus_scal_group(:) !reference diffusivity for solid phase tracer, for modeling turbation + real(r8),pointer :: tracer_solid_passive_diffus_thc_group(:) !threshold diffusivity for solid phase tracer, for modeling turbation + + integer, pointer :: solid_passive_tracer_groupid(:,:) + integer, pointer :: tracer_group_memid(:,:) !grp, gmem + character(len=36),pointer :: tracernames(:) !array with tracer names + real(r8),pointer :: gram_mole_wt(:) !molecular weight of the master species, [g/mol] + real(r8),pointer :: vtrans_scal(:) !scaling factor for plant tracer uptake through transpiration, for non-water neutral aqueous tracers + + contains + procedure, public :: Init + procedure, public :: init_scalars + procedure, public :: set_tracer + procedure, private :: InitAllocate + end type BeTRtracer_type + + + + contains + + + subroutine Init(this) + + implicit none + class(BeTRtracer_type) :: this + + this%ntracers=this%ngwmobile_tracers+this%nsolid_passive_tracers + this%ntracer_groups = this%nsolid_passive_tracer_groups + this%ngwmobile_tracer_groups + + call this%InitAllocate() + end subroutine Init +!-------------------------------------------------------------------------------- + subroutine init_scalars(this) + + ! !DESCRIPTION: + ! initilaize scalar variables within the type + + implicit none + class(BeTRtracer_type) :: this + + this%ntracers = 0 ! total number of tracers, gas/aqueous tracers + solid tracers that undergo active mineral protection + this%ngwmobile_tracers = 0 ! total number of tracers undergoing gas/aqueous movement + this%nvolatile_tracers = 0 ! number of volatile_tracers + this%nsolid_equil_tracers = 0 ! number of tracers that undergo equilibrium adsorption in soil could include adsorbed doc, nh4(+) + this%nsolid_passive_tracers = 0 ! number of tracers that undergo active mineral protection + + this%ntracer_groups = 0 + this%ngwmobile_tracer_groups = 0 + this%nvolatile_tracer_groups = 0 + this%nsolid_equil_tracer_groups = 0 + this%nsolid_passive_tracer_groups = 0 + + this%nh2o_tracers = 0 ! number of h2o tracers, this will be used to compute vapor gradient and thermal gradient driven isotopic flow + this%is_oddstep = .true. !this is not used now, originally was included to set up alternative numerical methods + + + this%id_trc_ch4 = 0 ! tag for methane + this%id_trc_o2 = 0 ! tag for co2 + this%id_trc_n2 = 0 ! tag for n2 + this%id_trc_no = 0 ! tag for no + this%id_trc_n2o = 0 ! tag for n2o + this%id_trc_ar = 0 ! tag for ar + this%id_trc_air_co2x = 0 ! tag for atmospheric co2 + this%id_trc_arrt_co2x = 0 ! tag for autotrophic co2 + this%id_trc_hrsoi_co2x = 0 ! tag for heterotrophic co2 + + this%id_trc_co2x = 0 ! tag for co2 and its related species, co2x(CO2, H2CO3, HCO3(-), CO3(2-)), + this%id_trc_nh3x = 0 ! tag for nh3 and its related species, nh3x(NH3, NH4OH,NH4(+)) + this%id_trc_no3x = 0 ! tag for no3 and its related species, no3x(HNO3,NO3(-)) + this%id_trc_no2x = 0 ! tag for no2 and its related species, no2x(HNO2,NO2(-)) + this%id_trc_dom = 0 ! tag for generic dissolved organic matter + + + this%id_trc_o18_h2o = 0 ! tag for H2O(18) + this%id_trc_o17_h2o = 0 ! tag for H2O(17) + this%id_trc_d_h2o = 0 ! tag for DHO + this%id_trc_c13_co2x = 0 ! tag for C(13)O2 and its related species + this%id_trc_c14_co2x = 0 ! tag for C(14)O2 and its related species + this%id_trc_o18_co2x = 0 ! tag for O(18)CO and its related species + this%id_trc_o17_co2x = 0 ! tag for O(17)CO and its related species + this%id_trc_o18_h2o_ice = 0 ! tag for H2O(18) in ice + this%id_trc_d_h2o_ice = 0 ! tag for HDO in ice + this%id_trc_o18_o2 = 0 ! tag for O(18)O and its related species + this%id_trc_o17_o2 = 0 ! tag for O(17)O and its related species + + this%betr_simname = '' + end subroutine init_scalars + + +!-------------------------------------------------------------------------------- + subroutine InitAllocate(this) + + ! !DESCRIPTION: + ! allocate memories for vectors + + implicit none + class(BeTRtracer_type) :: this + integer, parameter :: nanid=-1 + + allocate(this%is_volatile (this%ngwmobile_tracers)); this%is_volatile(:) = .false. + allocate(this%is_adsorb (this%ngwmobile_tracers)); this%is_adsorb(:) = .false. + allocate(this%is_advective (this%ntracers)); this%is_advective(:) = .false. + allocate(this%is_diffusive (this%ntracers)); this%is_diffusive(:) = .false. + allocate(this%is_mobile (this%ntracers)); this%is_mobile(:) = .false. + allocate(this%is_h2o (this%ngwmobile_tracers)); this%is_h2o(:) = .false. + allocate(this%is_co2tag (this%ngwmobile_tracers)); this%is_co2tag(:) = .false. + allocate(this%is_dom (this%ngwmobile_tracers)); this%is_dom(:) = .false. + allocate(this%is_isotope (this%ngwmobile_tracers)); this%is_isotope(:) = .false. + + allocate(this%adsorbgroupid (this%ngwmobile_tracers)); this%adsorbgroupid(:) = nanid + allocate(this%adsorbid (this%ngwmobile_tracers)); this%adsorbid(:) = nanid + + allocate(this%volatileid (this%ngwmobile_tracers)); this%volatileid(:) = nanid + allocate(this%volatilegroupid (this%ngwmobile_tracers)); this%volatilegroupid(:) = nanid + allocate(this%h2oid (this%nh2o_tracers)); this%h2oid(:) = nanid + allocate(this%id_trc_h2o_tags (this%nh2o_tracers)); this%id_trc_h2o_tags(:) = nanid + allocate(this%tracernames (this%ntracers)); this%tracernames(:) = '' + allocate(this%vtrans_scal (this%ngwmobile_tracers)); this%vtrans_scal(:) = 0._r8 !no transport through xylem transpiration + + allocate(this%tracer_solid_passive_diffus_scal_group(this%nsolid_passive_tracer_groups)); this%tracer_solid_passive_diffus_scal_group(:) = 1._r8 + allocate(this%tracer_solid_passive_diffus_thc_group (this%nsolid_passive_tracer_groups)); this%tracer_solid_passive_diffus_thc_group(:) = 1e-4_r8 / (86400._r8 * 365._r8) * 1.e-36_r8 + + allocate(this%tracer_group_memid(this%ntracer_groups, this%nmem_max)); this%tracer_group_memid(:,:) = nanid + + allocate(this%solid_passive_tracer_groupid(this%nsolid_passive_tracer_groups, 1:this%nmem_max)); this%solid_passive_tracer_groupid(:,:) = nanid + + allocate(this%groupid(this%ntracers)); this%groupid(:) = nanid + + end subroutine InitAllocate + +!-------------------------------------------------------------------------------- + + subroutine set_tracer(this, trc_id, trc_name, is_trc_mobile, is_trc_advective, trc_group_id, & + trc_group_mem, is_trc_diffusive, is_trc_volatile, trc_volatile_id, trc_volatile_group_id,trc_vtrans_scal) + + ! !DESCRIPTION: + ! set up tracer property based on input configurations + + ! !ARGUMENTS: + class(BeTRtracer_type) :: this + integer , intent(in) :: trc_id + character(len=*) , intent(in) :: trc_name + logical , intent(in) :: is_trc_mobile + logical , intent(in) :: is_trc_advective + integer , intent(in) :: trc_group_id + integer , intent(in) :: trc_group_mem + + logical, optional , intent(in) :: is_trc_diffusive + logical, optional , intent(in) :: is_trc_volatile + integer, optional , intent(in) :: trc_volatile_id + integer, optional , intent(in) :: trc_volatile_group_id + real(r8),optional , intent(in) :: trc_vtrans_scal + + this%tracernames (trc_id) = trim(trc_name) + this%is_mobile (trc_id) = is_trc_mobile + this%groupid (trc_id) = trc_group_id + this%tracer_group_memid(trc_group_id,trc_group_mem) = trc_id + + this%is_advective (trc_id) = is_trc_advective + + if(present(is_trc_diffusive)) this%is_diffusive (trc_id) = is_trc_diffusive + if(present(is_trc_volatile))then + this%is_volatile (trc_id) = is_trc_volatile + if(this%is_volatile (trc_id)) then + this%volatileid (trc_id) = trc_volatile_id + this%volatilegroupid(trc_id) = trc_volatile_group_id + endif + endif + if(present(trc_vtrans_scal))then + this%vtrans_scal(trc_id) = trc_vtrans_scal + endif + + + end subroutine set_tracer + + +end module BeTRTracerType diff --git a/components/clm/src/betr/betr_core/KineticsMod.F90 b/components/clm/src/betr/betr_core/KineticsMod.F90 new file mode 100644 index 000000000000..e96d9e980599 --- /dev/null +++ b/components/clm/src/betr/betr_core/KineticsMod.F90 @@ -0,0 +1,362 @@ +module KineticsMod + ! !DESCRIPTION: + ! Subroutines to do substrate kinetics + ! Created by Jinyun Tang, Apr 11, 2013 + ! !USES: + + use shr_kind_mod, only: r8 => shr_kind_r8 + use abortutils, only: endrun + use clm_varctl, only: iulog + implicit none + real(r8),public, parameter :: kd_infty = 1.e40_r8 !internal parameter + + interface mmcomplex !the m-m kinetics + module procedure mmcomplex_v1s,mmcomplex_v1e, mmcomplex_m + end interface mmcomplex + + interface ecacomplex !the eca kinetics + module procedure ecacomplex_v1s,ecacomplex_v1e, ecacomplex_m + end interface ecacomplex + + interface ecacomplex_cell_norm !the eca kinetics + module procedure ecacomplex_cell_norm_v1s,ecacomplex_cell_norm_v1e, ecacomplex_cell_norm_m + end interface ecacomplex_cell_norm + +contains + !------------------------------------------------------------------------------- + subroutine mmcomplex_v1s(kd,ee,ss,siej) + + ! !DESCRIPTION: + ! Compute concentrations of the enzyme substrate complexes + ! many microbes vs single substrate + ! using the traditional M-M kinetics + + ! !USES: + + implicit none + ! !ARGUMENTS: + real(r8), dimension(:), intent(in) :: kd + real(r8), dimension(:), intent(in) :: ee + real(r8), intent(in) :: ss + real(r8), dimension(:), intent(out) :: siej + + ! !LOCAL VARIABLES: + integer :: jj, j + real(r8) :: dS + jj = size(ee) + siej = 0._r8 + + do j = 1, jj + if(kd(j)>0._r8 .and. (kd(j)<.9*kd_infty))then + siej(j) = ss * ee(j) / (kd(j) + ss) + endif + enddo + ds = sum(siej) + if(ds>ss)then + do j = 1, jj + siej(j) = siej(j) * ss / ds + enddo + endif + + end subroutine mmcomplex_v1s + !------------------------------------------------------------------------------- + subroutine mmcomplex_v1e(kd,ee,ss,siej) + ! !DESCRIPTION: + !compute concentrations of the enzyme substrate complexes + !using the traditional M-M kinetics + !many substrates vs single microbe + + implicit none + ! !ARGUMENTS: + real(r8), dimension(:), intent(in) :: kd + real(r8), dimension(:), intent(in) :: ss + real(r8), intent(in) :: ee + real(r8), dimension(:), intent(out) :: siej + + ! !LOCAL VARIABLES + integer :: ii + integer :: i + real(r8) :: dE + ii = size(ss) + siej = 0._r8 + + do i = 1, ii + if(kd(i)>0._r8 .and. (kd(i)<.9*kd_infty))then + siej(i) = ss(i) * ee / (kd(i) + ss(i)) + endif + enddo + dE = sum(siej) + if(dE>ee)then + do i = 1, ii + siej(i) = siej(i) * ee / dE + enddo + endif + + end subroutine mmcomplex_v1e + !------------------------------------------------------------------------------- + subroutine mmcomplex_m(kd,ee,ss,siej) + ! !DESCRIPTION: + !compute concentrations of the enzyme substrate complexes + !using the traditional M-M kinetics + !many substrates vs many microbes + + implicit none + ! !ARGUMENTS: + real(r8), dimension(:,:), intent(in) :: kd + real(r8), dimension(:), intent(in) :: ee, ss + real(r8), dimension(:,:), intent(out) :: siej + + ! !LOCAL VARIABLES: + integer :: ii,jj + integer :: i, j + real(r8) :: dS, dE + + ii = size(ss) + jj = size(ee) + siej = 0._r8 + do i = 1, ii + do j = 1, jj + if(kd(i,j)>0._r8 .and. (kd(i,j)<.9*kd_infty))then + siej(i,j) = ss(i) * ee(j) / (kd(i,j) + ss(i)) + endif + enddo + ds = sum(siej(i,:)) + if(ds>ss(i))then + do j = 1, jj + siej(i,j) = siej(i,j) * ss(i) / ds + enddo + endif + enddo + + do j = 1, jj + dE = sum(siej(:,j)) + if(dE>ee(j))then + do i = 1, ii + siej(i,j) = siej(i,j) * ee(j) / dE + enddo + endif + enddo + end subroutine mmcomplex_m + !------------------------------------------------------------------------------- + subroutine ecacomplex_v1s(kd,ss,ee,siej) + ! !DESCRIPTION: + !compute concentrations of the enzyme substrate complexes + !using the first order accurate ECA kinetics + !many microbes vs one substrate + implicit none + ! !ARGUMENTS: + real(r8), dimension(:), intent(in) :: kd + real(r8), dimension(:), intent(in) :: ee + real(r8), intent(in) :: ss + real(r8), dimension(:), intent(out) :: siej + + ! !LOCAL VARIABLES: + integer :: jj + integer :: j + real(r8) :: dnm2 + + jj = size(ee) + siej = 0._r8 + + dnm2=1._r8 + do j = 1, jj + if(kd(j)>0._r8 .and. (kd(j)<.9*kd_infty))then + dnm2=dnm2 + ee(j)/kd(j) + endif + enddo + do j = 1, jj + if(kd(j)>0._r8 .and. (kd(j)<.9*kd_infty))then + siej(j) = ss*ee(j)/(kd(j)*(dnm2+ss/kd(j))) + endif + enddo + end subroutine ecacomplex_v1s +!------------------------------------------------------------------------------- + subroutine ecacomplex_v1e(kd,ss,ee,siej) + ! !DESCRIPTION: + !compute concentrations of the enzyme substrate complexes + !using the first order accurate ECA kinetics + !many substrate vs single microbe + implicit none + ! !ARGUMENTS: + real(r8), dimension(:), intent(in) :: kd + real(r8), dimension(:), intent(in) :: ss + real(r8), intent(in) :: ee + real(r8), dimension(:), intent(out) :: siej + + ! !LOCAL VARIABLES: + integer :: ii + integer :: i + real(r8) :: dnm1 + + ii = size(ss) + siej = 0._r8 + dnm1=1._r8 + do i = 1, ii + if(kd(i)>0._r8 .and. (kd(i)<.9*kd_infty))then + dnm1 = dnm1 + ss(i)/kd(i) + endif + enddo + do i = 1, ii + if(kd(i)>0._r8 .and. (kd(i)<.9*kd_infty))then + siej(i) = ss(i)*ee/(kd(i)*(dnm1+ee/kd(i))) + endif + enddo + end subroutine ecacomplex_v1e + !------------------------------------------------------------------------------- + subroutine ecacomplex_m(kd,ss,ee,siej) + ! !DESCRIPTION: + !compute concentrations of the enzyme substrate complexes + !using the first order accurate ECA kinetics + ! many substrate vs many enzymes + implicit none + ! !ARGUMENTS: + real(r8), dimension(:,:), intent(in) :: kd + real(r8), dimension(:), intent(in) :: ee, ss + real(r8), dimension(:,:), intent(out) :: siej + + ! !LOCAL VARIABLES: + integer :: ii,jj + integer :: i, j, k + real(r8) :: dnm1, dnm2 + + ii = size(ss) !number of substrates, dim 1 + jj = size(ee) !number of enzymes, dim2 + if(ii/=size(siej,1) .or. jj/=size(siej,2))then + write(iulog,*)'wrong matrix shape in ecacomplex_m' + write(iulog,*)'clm model is stopping' + call endrun() + endif + siej = 0._r8 + do i = 1, ii + dnm1 = 0._r8 + do k = 1, jj + if(kd(i,k)>0._r8 .and. (kd(i,k)<.9*kd_infty))then + dnm1 = dnm1 + ee(k)/kd(i,k) + endif + enddo + do j = 1, jj + dnm2 = 0._r8 + if(kd(i,j)>0._r8 .and. (kd(i,j)<.9*kd_infty) )then + do k = 1, ii + if(kd(k,j)>0._r8 .and. (kd(k,j)<.9*kd_infty))then + dnm2=dnm2 + ss(k)/kd(k,j) + endif + enddo + siej(i,j) = ss(i)*ee(j)/(kd(i,j)*(1._r8+dnm1+dnm2)) + endif + enddo + enddo + end subroutine ecacomplex_m + !------------------------------------------------------------------------------- + subroutine ecacomplex_cell_norm_m(kd,ss,ee,siej) + ! !DESCRIPTION: + ! compute concentrations of the enzyme substrate complexes + ! using the first order accurate ECA kinetics + ! and noramlize the return value with cell abundance + ! many substrates vs many enzymes + implicit none + ! !ARGUMENTS: + real(r8), dimension(:,:), intent(in) :: kd + real(r8), dimension(:), intent(in) :: ee, ss + real(r8), dimension(:,:), intent(out) :: siej + ! !LOCAL VARIABLES: + integer :: ii,jj + integer :: i, j, k + real(r8) :: dnm1, dnm2 + + ii = size(ss) !number of substrates, dim 1 + jj = size(ee) !number of enzymes, dim2 + if(ii/=size(siej,1) .or. jj/=size(siej,2))then + write(iulog,*)'wrong matrix shape in ecacomplex_m' + write(iulog,*)'clm model is stopping' + call endrun() + endif + siej = 0._r8 + do i = 1, ii + dnm1 = 0._r8 + do k = 1, jj + if(kd(i,k)>0._r8 .and. (kd(i,k)<.9*kd_infty))then + dnm1 = dnm1 + ee(k)/kd(i,k) + endif + enddo + do j = 1, jj + dnm2 = 0._r8 + if(kd(i,j)>0._r8 .and. (kd(i,j)<.9*kd_infty))then + do k = 1, ii + if(kd(k,j)>0._r8)then + dnm2=dnm2 + ss(k)/kd(k,j) + endif + enddo + siej(i,j) = ss(i)/(kd(i,j)*(1._r8+dnm1+dnm2)) + endif + enddo + enddo + end subroutine ecacomplex_cell_norm_m + + !------------------------------------------------------------------------------- + subroutine ecacomplex_cell_norm_v1s(kd,ss,ee,siej) + ! !DESCRIPTION: + !compute concentrations of the enzyme substrate complexes + !using the first order accurate ECA kinetics + !many microbes vs one substrate + !and normalize return value with cell abundance + + implicit none + ! !ARGUMENTS: + real(r8), dimension(:), intent(in) :: kd + real(r8), dimension(:), intent(in) :: ee + real(r8), intent(in) :: ss + real(r8), dimension(:), intent(out) :: siej + ! !LOCAL VARIABLES: + integer :: jj + integer :: j + real(r8) :: dnm2 + + jj = size(ee) + siej = 0._r8 + + dnm2=1._r8 + do j = 1, jj + if(kd(j)>0._r8 .and. (kd(j)<.9*kd_infty))then + dnm2=dnm2 + ee(j)/kd(j) + endif + enddo + do j = 1, jj + if(kd(j)>0._r8 .and. (kd(j)<.9*kd_infty))then + siej(j) = ss/(kd(j)*(dnm2+ss/kd(j))) + endif + enddo + end subroutine ecacomplex_cell_norm_v1s + !------------------------------------------------------------------------------- + subroutine ecacomplex_cell_norm_v1e(kd,ss,ee,siej) + ! !DESCRIPTION: + ! compute concentrations of the enzyme substrate complexes + ! using the first order accurate ECA kinetics + ! many substrate vs single microbe + ! and normalize the return value with cell abundance + implicit none + ! !ARGUMENTS: + real(r8), dimension(:), intent(in) :: kd + real(r8), dimension(:), intent(in) :: ss + real(r8), intent(in) :: ee + real(r8), dimension(:), intent(out) :: siej + ! !LOCAL VARIABLES: + integer :: ii + integer :: i + real(r8) :: dnm1 + + ii = size(ss) + siej = 0._r8 + dnm1=1._r8 + do i = 1, ii + if(kd(i)>0._r8 .and. (kd(i)<.9*kd_infty))then + dnm1 = dnm1 + ss(i)/kd(i) + endif + enddo + do i = 1, ii + if(kd(i)>0._r8 .and. (kd(i)<.9*kd_infty))then + siej(i) = ss(i)/(kd(i)*(dnm1+ee/kd(i))) + endif + enddo + end subroutine ecacomplex_cell_norm_v1e +end module KineticsMod diff --git a/components/clm/src/betr/betr_core/TracerBalanceMod.F90 b/components/clm/src/betr/betr_core/TracerBalanceMod.F90 new file mode 100644 index 000000000000..f19b397b9138 --- /dev/null +++ b/components/clm/src/betr/betr_core/TracerBalanceMod.F90 @@ -0,0 +1,220 @@ +module TracerBalanceMod + +! +! !DESCRIPTION: +! module contains subroutines to do +! tracer mass balance check + + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use decompMod , only : bounds_type + use BeTRTracerType , only : betrtracer_type + use ColumnType , only : col + use clm_time_manager , only : get_nstep + use clm_varctl , only : iulog +implicit none + save + private + + + public :: begin_betr_tracer_massbalance + public :: betr_tracer_massbalance_check + + contains + + + + !-------------------------------------------------------------------------------- + subroutine begin_betr_tracer_massbalance(bounds, lbj, ubj, numf, filter, & + betrtracer_vars, tracerstate_vars, tracerflux_vars) + ! + ! !DESCRIPTION: + ! Preparing for tracer mass balance check + ! + ! !USES: + use tracerstatetype , only : tracerstate_type + use clm_varpar , only : nlevtrc_soil + use tracerfluxType , only : tracerflux_type + + implicit none + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: lbj, ubj + integer, intent(in) :: numf ! number of columns in column filter + integer, intent(in) :: filter(:) ! column filter + type(betrtracer_type), intent(in) :: betrtracer_vars ! betr configuration information + type(tracerstate_type), intent(inout) :: tracerstate_vars ! tracer state variables data structure + type(tracerflux_type) , intent(inout) :: tracerflux_vars + + ! !LOCAL VARIABLES: + character(len=256) :: subname='begin_betr_tracer_massbalance' + integer :: fc, c + + call tracerflux_vars%Reset(bounds, numf, filter) + + call betr_tracer_mass_summary(bounds, lbj, ubj, numf, filter, betrtracer_vars, tracerstate_vars, & + tracerstate_vars%beg_tracer_molarmass_col) + + end subroutine begin_betr_tracer_massbalance + + !-------------------------------------------------------------------------------- + subroutine betr_tracer_massbalance_check(bounds, lbj, ubj, numf, filter, betrtracer_vars, tracerstate_vars, tracerflux_vars) + ! + ! !DESCRIPTION: + ! do mass balance check for betr tracers + ! + ! for solid phase tracers, the only source/sink is biogeochemical production/consumption + ! and it is currently assumed no solid phase input from atmospheric precipitation (either dry or wet) + ! the equilibrium fraction is always associated with the (dual)-phase mobile tracer. + ! However the situation is different for water isotopes, because ice is also part of the + ! mass budget, and by assuming equilibrium partitioning, the chemical source/sink for ice is not tracked explicitly. + ! + ! !USES: + use tracerfluxType , only : tracerflux_type + use tracerstatetype , only : tracerstate_type + use abortutils , only : endrun + use clm_varctl , only : iulog + use clm_time_manager , only : get_step_size,get_nstep + use clm_varcon , only : namec,catomw,natomw + implicit none + + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: lbj, ubj + integer, intent(in) :: numf ! number of columns in column filter + integer, intent(in) :: filter(:) ! column filter + type(betrtracer_type), intent(in) :: betrtracer_vars ! betr configuration information + type(tracerflux_type), intent(inout) :: tracerflux_vars + type(tracerstate_type), intent(inout) :: tracerstate_vars ! tracer state variables data structure + ! !LOCAL VARIABLES: + integer :: jj, fc, c, kk + real(r8) :: dtime + real(r8) :: atw + real(r8) :: err_rel, bal_beg, bal_end, bal_flx + real(r8), parameter :: err_min = 1.e-8_r8 + real(r8), parameter :: err_min_rel=1.e-3_r8 + associate( & + beg_tracer_molarmass => tracerstate_vars%beg_tracer_molarmass_col , & + end_tracer_molarmass => tracerstate_vars%end_tracer_molarmass_col , & + tracer_flx_infl => tracerflux_vars%tracer_flx_infl_col , & + tracer_flx_netpro => tracerflux_vars%tracer_flx_netpro_col , & + tracer_flx_netphyloss => tracerflux_vars%tracer_flx_netphyloss_col , & + is_mobile => betrtracer_vars%is_mobile , & + errtracer => tracerstate_vars%errtracer_col , & + ngwmobile_tracers => betrtracer_vars%ngwmobile_tracers , & + tracernames => betrtracer_vars%tracernames , & + ntracers => betrtracer_vars%ntracers & + + ) + + call betr_tracer_mass_summary(bounds, lbj, ubj, numf, filter, betrtracer_vars, tracerstate_vars, & + end_tracer_molarmass) + + dtime=get_step_size() + + do fc = 1, numf + c = filter(fc) + !summarize the fluxes + call tracerflux_vars%flux_summary(c, betrtracer_vars) + + do kk = 1, ngwmobile_tracers + errtracer(c,kk) = beg_tracer_molarmass(c,kk)-end_tracer_molarmass(c,kk) & + + tracer_flx_netpro(c,kk)-tracer_flx_netphyloss(c,kk) + if(abs(errtracer(c,kk))err_min_rel)then + write(iulog,*)'error exceeds the tolerance for tracer '//tracernames(kk), ' err=',errtracer(c,kk), ' col=',c + write(iulog,*)'nstep=',get_nstep() + write(iulog,'(4(A,X,E20.10))')'netpro=',tracer_flx_netpro(c,kk),' netphyloss=',tracer_flx_netphyloss(c,kk),& + ' begm=',beg_tracer_molarmass(c,kk), & + ' endm=',end_tracer_molarmass(c,kk) + call tracerflux_vars%flux_display(c,kk,betrtracer_vars) + call endrun(decomp_index=c, clmlevel=namec, msg=errmsg(__FILE__, __LINE__)) + endif + enddo + bal_beg=0._r8 + bal_end=0._r8 + bal_flx=0._r8 + do kk = ngwmobile_tracers+1, ntracers + errtracer(c,kk) = beg_tracer_molarmass(c,kk)-end_tracer_molarmass(c,kk) + tracer_flx_netpro(c,kk) + if(abs(errtracer(c,kk))>err_min)then + write(iulog,*)'error exceeds the tolerance for tracer '//tracernames(kk), 'err=',errtracer(c,kk), 'col=',c + write(iulog,*)get_nstep(),is_mobile(kk) + write(iulog,*)'begmss=', beg_tracer_molarmass(c,kk), 'endmass=',end_tracer_molarmass(c,kk),' netpro=',tracer_flx_netpro(c,kk) + call endrun(decomp_index=c, clmlevel=namec, msg=errmsg(__FILE__, __LINE__)) + endif + enddo + + call tracerflux_vars%Temporal_average(c,dtime) + enddo + + end associate + + end subroutine betr_tracer_massbalance_check + + + !-------------------------------------------------------------------------------- + + subroutine betr_tracer_mass_summary(bounds, lbj, ubj, numf, filter, betrtracer_vars, tracerstate_vars, tracer_molarmass_col) + ! + ! !DESCRIPTION: + ! summarize the column tracer mass + ! + ! !USES: + use tracerstatetype , only : tracerstate_type + use clm_varpar , only : nlevtrc_soil + use MathfuncMod , only : dot_sum + + implicit none + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: lbj, ubj + integer, intent(in) :: numf ! number of columns in column filter + integer, intent(in) :: filter(:) ! column filter + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(tracerstate_type), intent(inout) :: tracerstate_vars ! tracer state variables data structure + real(r8) , intent(inout) :: tracer_molarmass_col(bounds%begc:bounds%endc, 1:betrtracer_vars%ntracers) + ! !LOCAL VARIABLES: + integer :: jj, fc, c, kk + + associate( & + tracer_conc_mobile => tracerstate_vars%tracer_conc_mobile_col , & + tracer_conc_solid_equil => tracerstate_vars%tracer_conc_solid_equil_col , & + tracer_conc_solid_passive => tracerstate_vars%tracer_conc_solid_passive_col , & + dz => col%dz , & + ngwmobile_tracers => betrtracer_vars%ngwmobile_tracers , & + ntracers => betrtracer_vars%ntracers , & + is_adsorb => betrtracer_vars%is_adsorb , & + nsolid_passive_tracers => betrtracer_vars%nsolid_passive_tracers , & + adsorbid => betrtracer_vars%adsorbid & + + ) + + do jj = 1, ngwmobile_tracers + do fc = 1, numf + c = filter(fc) + + tracer_molarmass_col(c,jj) = dot_sum(tracer_conc_mobile(c,1:nlevtrc_soil,jj), dz(c,1:nlevtrc_soil)) + + if(is_adsorb(jj))then + tracer_molarmass_col(c,jj) = tracer_molarmass_col(c,jj) + & + dot_sum(tracer_conc_solid_equil(c,1:nlevtrc_soil,adsorbid(jj)),dz(c,1:nlevtrc_soil)) + endif + enddo + enddo + + do jj = 1, nsolid_passive_tracers + kk = jj + ngwmobile_tracers + do fc = 1, numf + c = filter(fc) + tracer_molarmass_col(c,kk) = dot_sum(tracer_conc_solid_passive(c,1:nlevtrc_soil,jj), dz(c,1:nlevtrc_soil)) + enddo + enddo + end associate + end subroutine betr_tracer_mass_summary + +end module TracerBalanceMod diff --git a/components/clm/src/betr/betr_core/TracerBoundaryCondType.F90 b/components/clm/src/betr/betr_core/TracerBoundaryCondType.F90 new file mode 100644 index 000000000000..f7d3b1ddba47 --- /dev/null +++ b/components/clm/src/betr/betr_core/TracerBoundaryCondType.F90 @@ -0,0 +1,168 @@ +module TracerBoundaryCondType +! +! !DESCRIPTION: +! data type to specify boundary conditions for tracer tranpsort +! +! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + + implicit none + save + private + ! + ! !PUBLIC DATA: + ! + + !-------------------------------------------------------------------------------- + type, public :: tracerboundarycond_type + real(r8), pointer :: tracer_gwdif_concflux_top_col( : , : , : ) !tracer concentration or incoming flux imposed at top boundary for dual diffusion calculation + real(r8), pointer :: condc_toplay_col ( : , : ) !conductance at the column-air interface + real(r8), pointer :: bot_concflux_col ( : , : , : ) !bottom boundary condition + integer, pointer :: topbc_type ( : ) !type of top boundary condition, it depends on tracer type + integer, pointer :: botbc_type ( : ) !type of bottom boundary condition, it depends on tracer type + integer, pointer :: jtops_col ( : ) !index of the top numerical node + contains + procedure, public :: Init + procedure, public :: Restart + procedure, public :: Reset + procedure, private :: InitAllocate + procedure, private :: InitHistory + procedure, private :: InitCold + + end type tracerboundarycond_type +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds, betrtracer_vars) + ! + ! !DESCRIPTION: + ! Initialize the datatype + ! + ! !USES: + use BeTRTracerType, only : BeTRTracer_Type + ! + ! !ARGUMENTS: + class(tracerboundarycond_type) :: this + type(bounds_type), intent(in) :: bounds + type(BeTRTracer_Type), intent(in) :: betrtracer_vars + + call this%InitAllocate(bounds, betrtracer_vars) + call this%InitHistory(bounds) + call this%InitCold(bounds) + + end subroutine Init + + !----------------------------------------------------------------------- + subroutine InitAllocate(this, bounds, betrtracer_vars) + use BeTRTracerType, only : BeTRTracer_Type + ! + ! !DESCRIPTION: + ! allocate memories to relevant variables + ! + ! !ARGUMENTS: + class(tracerboundarycond_type) :: this + type(bounds_type), intent(in) :: bounds + type(BeTRTracer_Type), intent(in) :: betrtracer_vars + ! + ! !LOCAL VARIABLES: + integer :: begc, endc + !--------------------------------------------------------------------- + + begc = bounds%begc; endc= bounds%endc + + allocate(this%tracer_gwdif_concflux_top_col (begc:endc, 1:2, 1:betrtracer_vars%ntracers)) ! 1: values at previous time step, 2: values at current time step + allocate(this%bot_concflux_col (begc:endc, 1:2, 1:betrtracer_vars%ntracers)) ! 1: values at previous time step, 2: values at current time step + + allocate(this%condc_toplay_col (begc:endc, 1:betrtracer_vars%ntracer_groups)) + allocate(this%topbc_type (1:betrtracer_vars%ntracer_groups)) + allocate(this%botbc_type (1:betrtracer_vars%ntracer_groups)) + allocate(this%jtops_col (begc:endc)) + end subroutine InitAllocate + + !----------------------------------------------------------------------- + subroutine InitHistory(this, bounds) + ! + ! !DESCRIPTION: + ! History fields initialization + ! + ! !USES: + use clm_varcon , only: spval + use clm_varpar , only: nlevsno + + ! + ! !ARGUMENTS: + class(tracerboundarycond_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begc, endc + real(r8), pointer :: data2dptr_col(:,:) ! temp. pointers for slicing larger arrays + + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds) + ! + ! !DESCRIPTION: + ! do cold initialization + ! !USES: + ! + use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) + implicit none + ! !ARGUMENTS: + class(tracerboundarycond_type) :: this + type(bounds_type) , intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + + + !----------------------------------------------------------------------- + this%topbc_type(:) = -1 + this%botbc_type(:) = -1 + this%tracer_gwdif_concflux_top_col(:,:,:) = nan + this%condc_toplay_col(:,:) = nan + this%bot_concflux_col(:,:,:) = 0._r8 + this%jtops_col(:) = 1 + end subroutine InitCold + + !------------------------------------------------------------------------ + subroutine Restart(this, bounds, ncid, flag) + ! + ! !DESCRIPTION: + ! Read/Write module information to/from restart file. + ! + ! !USES: + use clm_varpar , only : nlevsno, nlevsoi + use clm_varcon , only : spval + use clm_varctl , only : iulog + use ncdio_pio + ! + ! !ARGUMENTS: + class(tracerboundarycond_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: + integer :: j,c ! indices + logical :: readvar ! determine if variable is on initial file + + + end subroutine Restart + + !----------------------------------------------------------------------- + subroutine Reset(this, column) + ! + ! !DESCRIPTION: + ! Intitialize SNICAR variables for fresh snow column + ! + ! !ARGUMENTS: + class(tracerboundarycond_type) :: this + integer , intent(in) :: column ! column index + + + + end subroutine Reset + end module TracerBoundaryCondType diff --git a/components/clm/src/betr/betr_core/TracerCoeffType.F90 b/components/clm/src/betr/betr_core/TracerCoeffType.F90 new file mode 100644 index 000000000000..27998865517c --- /dev/null +++ b/components/clm/src/betr/betr_core/TracerCoeffType.F90 @@ -0,0 +1,282 @@ +module TracerCoeffType + ! + ! DESCRIPTION: + ! datatype for tracer phase conversion parameters and other scaling parameters + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use decompMod , only : bounds_type + use PatchType , only : pft + use ColumnType , only : col + use LandunitType , only : lun + use landunit_varcon, only : istsoil, istcrop + ! + ! !PUBLIC TYPES: + implicit none + save + private + ! + ! !PUBLIC DATA: + ! + !------------------------------------------------------------------------------- + ! Column tracer phase conversion/transport parameters structure + !------------------------------------------------------------------------------- + type, public :: TracerCoeff_type + real(r8), pointer :: aqu2neutralcef_col (:,:,:) !aqueous tracer into neutral aqueous tracer + real(r8), pointer :: aqu2bulkcef_mobile_col (:,:,:) !coefficient to convert bulk concentration into aqueous phase, (nlevsno+nlevtrc_soil) + real(r8), pointer :: gas2bulkcef_mobile_col (:,:,:) !coefficient to convert bulk concentration into gaseous phase, (nlevsno+nlevlak+nlevtrc_soil) + real(r8), pointer :: aqu2equilsolidcef_col (:,:,:) !coefficient to convert solid phase (including ice) into aqueous phase + real(r8), pointer :: henrycef_col (:,:,:) !henry's law constant + real(r8), pointer :: bunsencef_col (:,:,:) !bunsen solubility + real(r8), pointer :: tracer_diffusivity_air_col(:,:) !diffusivity in the air + real(r8), pointer :: aere_cond_col (:,:) !column level aerenchyma conductance (m/s) + real(r8), pointer :: scal_aere_cond_col (:,:) !column level scaling factor for arenchyma or parenchyma transport + real(r8), pointer :: diffgas_topsno_col (:,:) !gas diffusivity in top snow layer, this is not used currently + real(r8), pointer :: diffgas_topsoi_col (:,:) !gas diffusivity in top soil layer, this is not used currently + real(r8), pointer :: hmconductance_col (:,:,:) !geometrically weighted conductances (nlevsno+nlevtrc_soil) + real(r8), pointer :: annsum_counter_col (:) + contains + procedure, public :: Init + procedure, public :: Restart + procedure, private :: InitAllocate + procedure, private :: InitHistory + procedure, private :: InitCold + end type TracerCoeff_type + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds, lbj, ubj, betrtracer_vars) + ! + ! !DESCRIPTION: + ! initialize the data type + ! + ! !USES: + use BeTRTracerType, only : BeTRTracer_Type + implicit none + ! !ARGUMENTS: + class(TracerCoeff_type) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: lbj, ubj + type(BeTRTracer_Type), intent(in) :: betrtracer_vars + + call this%InitAllocate(bounds, lbj, ubj, betrtracer_vars) + call this%InitHistory(bounds, betrtracer_vars) + call this%InitCold(bounds) + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine Restart(this, bounds, ncid, flag, betrtracer_vars) + ! + ! !DESCRIPTION: + ! Read/Write module information to/from restart file. + ! + ! Now it is purposely empty, but will be potentially useful in the future + ! !USES: + use BetrTracerType , only : betrtracer_type + use clm_varpar , only : nlevsno, nlevsoi + use clm_varcon , only : spval + use restUtilMod + use ncdio_pio + ! + ! !ARGUMENTS: + class(TracerCoeff_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' + type(BeTRTracer_Type), intent(in) :: betrtracer_vars + ! + ! !LOCAL VARIABLES: + integer :: j,c ! indices + logical :: readvar ! determine if variable is on initial file + + + call restartvar(ncid=ncid, flag=flag, varname='annsum_counter_betr', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp' , readvar=readvar, data=this%annsum_counter_col) + + end subroutine Restart + + !----------------------------------------------------------------------- + subroutine InitAllocate(this, bounds, lbj, ubj, betrtracer_vars) + ! + ! !DESCRIPTION: + ! Allocate memories for arrays in the datatype + ! + ! !USES: + use BeTRTracerType, only : BeTRTracer_Type + implicit none + ! + ! !ARGUMENTS: + class(TracerCoeff_type) :: this + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: lbj, ubj + type(BeTRTracer_Type), intent(in) :: betrtracer_vars + ! + ! !LOCAL VARIABLES: + integer :: begc, endc + !--------------------------------------------------------------------- + + begc = bounds%begc; endc= bounds%endc + + allocate(this%aqu2neutralcef_col (begc:endc, lbj:ubj, 1:betrtracer_vars%ngwmobile_tracer_groups)); this%aqu2neutralcef_col (:,:,:) = nan + allocate(this%aqu2bulkcef_mobile_col (begc:endc, lbj:ubj, 1:betrtracer_vars%ngwmobile_tracer_groups)); this%aqu2bulkcef_mobile_col (:,:,:) = nan + allocate(this%gas2bulkcef_mobile_col (begc:endc, lbj:ubj, 1:betrtracer_vars%nvolatile_tracer_groups)); this%gas2bulkcef_mobile_col (:,:,:) = nan + allocate(this%henrycef_col (begc:endc, lbj:ubj, 1:betrtracer_vars%nvolatile_tracer_groups)); this%henrycef_col (:,:,:) = nan + allocate(this%bunsencef_col (begc:endc, lbj:ubj, 1:betrtracer_vars%nvolatile_tracer_groups)); this%bunsencef_col (:,:,:) = nan + allocate(this%tracer_diffusivity_air_col (begc:endc, 1:betrtracer_vars%nvolatile_tracer_groups)); this%tracer_diffusivity_air_col(:,:) = nan + allocate(this%scal_aere_cond_col (begc:endc, 1:betrtracer_vars%nvolatile_tracer_groups)); this%scal_aere_cond_col (:,:) = nan + allocate(this%aere_cond_col (begc:endc, 1:betrtracer_vars%nvolatile_tracer_groups)); this%aere_cond_col (:,:) = nan + allocate(this%annsum_counter_col (begc:endc)) ; this%annsum_counter_col (:) = nan + allocate(this%diffgas_topsno_col (begc:endc, 1:betrtracer_vars%nvolatile_tracer_groups)); this%diffgas_topsno_col (:,:) = nan + allocate(this%diffgas_topsoi_col (begc:endc, 1:betrtracer_vars%nvolatile_tracer_groups)); this%diffgas_topsoi_col (:,:) = nan + allocate(this%hmconductance_col (begc:endc, lbj:ubj, 1:betrtracer_vars%ntracer_groups)) ; this%hmconductance_col (:,:,:) = nan + allocate(this%aqu2equilsolidcef_col (begc:endc, lbj:ubj, 1:betrtracer_vars%nsolid_equil_tracer_groups));this%aqu2equilsolidcef_col (:,:,:) = nan + end subroutine InitAllocate + + !----------------------------------------------------------------------- + subroutine InitHistory(this, bounds, betrtracer_vars) + ! + ! !DESCRIPTION: + ! History fields initialization + ! + ! !USES: + !use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) + use clm_varcon , only : spval + use clm_varpar , only : nlevsno + use BeTRTracerType , only : BeTRTracer_Type + use histFileMod , only : hist_addfld1d, hist_addfld2d + use histFileMod , only : no_snow_normal, no_snow_zero + + ! + ! !ARGUMENTS: + class(TracerCoeff_type) :: this + type(bounds_type) , intent(in) :: bounds + type(BeTRTracer_Type), intent(in) :: betrtracer_vars + ! + ! !LOCAL VARIABLES: + integer :: begc, endc + integer :: jj, kk, trcid + real(r8), pointer :: data2dptr(:,:) ! temp. pointers for slicing larger arrays + real(r8), pointer :: data1dptr(:) ! temp. pointers for slicing larger arrays + + !use the interface provided from CLM + + + associate( & + ntracer_groups => betrtracer_vars%ntracer_groups , & + tracer_group_memid => betrtracer_vars%tracer_group_memid , & + ngwmobile_tracer_groups => betrtracer_vars%ngwmobile_tracer_groups , & + nsolid_equil_tracers => betrtracer_vars%nsolid_equil_tracers , & + is_volatile => betrtracer_vars%is_volatile , & + volatilegroupid => betrtracer_vars%volatilegroupid , & + tracernames => betrtracer_vars%tracernames & + ) + begc=bounds%begc; endc=bounds%endc + do jj = 1, ntracer_groups + trcid = tracer_group_memid(jj,1) + if(jj <= ngwmobile_tracer_groups)then + + if(is_volatile(trcid))then + kk = volatilegroupid(jj) + this%scal_aere_cond_col(begc:endc, kk) = spval + data1dptr => this%scal_aere_cond_col(begc:endc, kk) + call hist_addfld1d (fname='SCAL_ARENCHYMA_'//tracernames(trcid), units='none', & + avgflag='A', long_name='scaling factor for tracer transport through arenchyma for '//trim(tracernames(trcid)), & + ptr_col=data1dptr, default='inactive') + + this%aere_cond_col(begc:endc, kk) = spval + data1dptr => this%aere_cond_col(begc:endc, kk) + call hist_addfld1d (fname='ARENCHYMA_'//tracernames(trcid), units='m/s', & + avgflag='A', long_name='conductance for tracer transport through arenchyma for '//trim(tracernames(trcid)), & + ptr_col=data1dptr, default='inactive') + + this%diffgas_topsoi_col(begc:endc, kk) = spval + data1dptr => this%diffgas_topsoi_col(begc:endc, kk) + call hist_addfld1d (fname='CDIFF_TOPSOI_'//tracernames(trcid), units='none', & + avgflag='A', long_name='gas diffusivity in top soil layer for '//trim(tracernames(trcid)), & + ptr_col=data1dptr, default='inactive') + + this%gas2bulkcef_mobile_col(:,:,kk) = spval + data2dptr => this%gas2bulkcef_mobile_col(:,:,kk) + call hist_addfld2d (fname='CGAS2BULK_'//tracernames(trcid), units='none', type2d='levtrc', & + avgflag='A', long_name='converting factor from gas to bulk phase for '//trim(tracernames(trcid)), & + ptr_col=data2dptr, default='inactive') + endif + + this%aqu2bulkcef_mobile_col(:,:,jj) = spval + data2dptr => this%aqu2bulkcef_mobile_col(:,:,jj) + call hist_addfld2d (fname='CAQU2BULK_vr_'//tracernames(trcid), units='none', type2d='levtrc', & + avgflag='A', long_name='converting factor from aqeous to bulk phase for '//trim(tracernames(trcid)), & + ptr_col=data2dptr, default='inactive') + + endif + + this%hmconductance_col(:,:,jj) = spval + data2dptr => this%hmconductance_col(:,:,jj) + call hist_addfld2d (fname='HMCONDC_vr_'//tracernames(trcid), units='none', type2d='levtrc', & + avgflag='A', long_name='bulk conductance for '//trim(tracernames(trcid)), & + ptr_col=data2dptr, default='inactive') + enddo + + end associate + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds) + ! + ! !DESCRIPTION: + ! do cold initialization + ! + ! !USES: + use clm_varcon , only : spval + ! + ! !ARGUMENTS: + class(TracerCoeff_type) :: this + type(bounds_type) , intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: c, l ! index + + !----------------------------------------------------------------------- + + do c = bounds%begc, bounds%endc + l = col%landunit(c) + + if (lun%ifspecial(l)) then + this%aqu2neutralcef_col (c,:,:) = spval + this%aqu2bulkcef_mobile_col (c,:,:) = spval + this%gas2bulkcef_mobile_col (c,:,:) = spval + this%henrycef_col (c,:,:) = spval + this%bunsencef_col (c,:,:) = spval + this%tracer_diffusivity_air_col(c,:) = spval + this%scal_aere_cond_col (c,:) = spval + this%aere_cond_col (c,:) = spval + this%diffgas_topsno_col (c,:) = spval + this%diffgas_topsoi_col (c,:) = spval + this%hmconductance_col (c,:,:) = spval + this%annsum_counter_col (c) = spval + endif + + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + this%aqu2neutralcef_col (c,:,:) = 0._r8 + this%aqu2bulkcef_mobile_col (c,:,:) = 0._r8 + this%gas2bulkcef_mobile_col (c,:,:) = 0._r8 + this%henrycef_col (c,:,:) = 0._r8 + this%bunsencef_col (c,:,:) = 0._r8 + this%tracer_diffusivity_air_col(c,:) = 0._r8 + this%scal_aere_cond_col (c,:) = 0._r8 + this%aere_cond_col (c,:) = 0._r8 + this%diffgas_topsno_col (c,:) = 0._r8 + this%diffgas_topsoi_col (c,:) = 0._r8 + this%hmconductance_col (c,:,:) = 0._r8 + this%annsum_counter_col (c) = 0._r8 + endif + enddo + + end subroutine InitCold + + +end module TracerCoeffType diff --git a/components/clm/src/betr/betr_core/TracerFluxType.F90 b/components/clm/src/betr/betr_core/TracerFluxType.F90 new file mode 100644 index 000000000000..8fb932bc2446 --- /dev/null +++ b/components/clm/src/betr/betr_core/TracerFluxType.F90 @@ -0,0 +1,661 @@ +module TracerFluxType + !!DESCRIPTION: + ! tracer flux type + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use decompMod , only : bounds_type + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : pft + use clm_varcon , only : spval, ispval + use clm_varpar , only : nlevtrc_soil + use landunit_varcon, only : istsoil, istcrop + use clm_varctl , only : iulog + ! + ! !PUBLIC TYPES: + + implicit none + save + private + ! + ! !PUBLIC DATA: + ! + + type, public :: TracerFlux_type + + !tracer flux defined at the column level + real(r8), pointer :: tracer_flx_top_soil_col(:,:) !tracer fluxes available for infiltration+runoff + real(r8), pointer :: tracer_flx_can_loss_col(:,:) !tracer loss from canopy + real(r8), pointer :: tracer_flx_snowmelt_col(:,:) !tracer loss from snow melting + real(r8), pointer :: tracer_flx_infl_col(:,:) !tracer fluxes available for infiltration + real(r8), pointer :: tracer_flx_netphyloss_col(:,:) !total tracer loos through all possible physical pathways: drainage (+ runoff), leaching, ebullition, diffusion, minus precipitation/infiltration + real(r8), pointer :: tracer_flx_netpro_col(:,:) !total tracer production through chemical processes + real(r8), pointer :: tracer_flx_dstor_col(:,:) !net storage of tracer due to input-output, ideally, dstor=netpro-netloss at various scales + real(r8), pointer :: tracer_flx_ebu_col(:,:) !tracer emitted as bubbles, mol, lake, volatile + real(r8), pointer :: tracer_flx_prec_col(:,:) !tracer added to a column from precipitation, mol + real(r8), pointer :: tracer_flx_dif_col(:,:) !tracer emitted through diffusion, unsat, volatile + + real(r8), pointer :: tracer_flx_drain_col(:,:) !tracer removal through subface drainage + real(r8), pointer :: tracer_flx_surfemi_col(:,:) !total emitted tracer fluxes at surface, volatile, including ebullition, diffusion, arenchyma transport + real(r8), pointer :: tracer_flx_leaching_col(:,:) !leaching fluxes + real(r8), pointer :: tracer_flx_surfrun_col(:,:) !tracer loss thru runoff, mol tracer / second + real(r8), pointer :: tracer_flx_netpro_vr_col(:,:,:) !total source strength for the tracers, chemical production, root exudation, excludes incoming root transport (by exchange with air) and (infiltration?) + real(r8), pointer :: tracer_flx_tparchm_col(:,:) !total tracer flux through plant aerenchyma transport, for volatile species only, mol/m^2/s + real(r8), pointer :: tracer_flx_parchm_vr_col(:,:,:) !vertical resolved tracer flux through aerenchyma transport, for volatile species only, mol/m^3/s + real(r8), pointer :: tracer_flx_totleached_col(:,:) !total leaching flux, vertical + lateral leaching + + real(r8), pointer :: tracer_flx_vtrans_col(:,:) !column level tracer flux through transpiration + !real(r8), pointer :: tracer_flx_snowloss_col(:,:) !tracer flux lost from snow dynamics, place holder + + !tracer fluxes defined at the pft level + real(r8), pointer :: tracer_flx_vtrans_patch(:,:) !tracer goes to the pathway of plant transpiration, currently not released, if it is nutrient, assumed it is taken by plants completely + real(r8), pointer :: tracer_flx_snowfall_grnd_patch(:,:) + real(r8), pointer :: tracer_flx_rainfall_grnd_patch(:,:) + real(r8), pointer :: tracer_flx_prec_intr_patch(:,:) !interception of tracer from wet deposition [mol/s] + real(r8), pointer :: tracer_flx_prec_grnd_patch(:,:) !tracer onto ground including from canopy runoff [mol /s] + real(r8), pointer :: tracer_flx_snwcp_liq_patch(:,:) !excess rainfall tracer due to snow capping [mol /s] + real(r8), pointer :: tracer_flx_snwcp_ice_patch(:,:) !excess snowfall tracer due to snow capping [mol /s], this is used for aerosol type and water type tracer input + real(r8), pointer :: tracer_flx_dew_grnd_col(:,:) !tracer flux to ground coming from dew formation + real(r8), pointer :: tracer_flx_dew_snow_col(:,:) !tracer flux to snow coming from dew formation + real(r8), pointer :: tracer_flx_sub_snow_col(:,:) !tracer flux loss from snow sublimation + real(r8), pointer :: tracer_flx_h2osfc_snow_residual_col(:,:) !tracer flux coming from residual standing water and residual snow + + contains + procedure, public :: Init + procedure, public :: Restart + procedure, public :: Reset + procedure, public :: Temporal_average + procedure, public :: Flux_summary + procedure, public :: Flux_display + procedure, private :: InitAllocate + procedure, private :: InitHistory + procedure, private :: InitCold + + end type TracerFlux_type +contains + !------------------------------------------------------------------------ + subroutine Init(this, bounds, lbj, ubj, betrtracer_vars) + ! !DESCRIPTION: + ! initialize data type + ! + ! !USES: + use BeTRTracerType, only : BeTRTracer_Type + implicit none + ! !ARGUMENTS: + class(TracerFlux_type) :: this + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: lbj, ubj + type(BeTRTracer_Type), intent(in) :: betrtracer_vars + + + call this%InitAllocate(bounds, lbj, ubj, betrtracer_vars) + call this%InitHistory(bounds, betrtracer_vars) + call this%InitCold(bounds) + + end subroutine Init + + !----------------------------------------------------------------------- + subroutine InitAllocate(this, bounds, lbj, ubj, betrtracer_vars) + ! !DESCRIPTION: + ! memory allocation + ! + ! !USES: + use BeTRTracerType, only : BeTRTracer_Type + implicit none + ! + ! !ARGUMENTS: + class(TracerFlux_type) :: this + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: lbj, ubj + type(BeTRTracer_Type), intent(in) :: betrtracer_vars + ! + ! !LOCAL VARIABLES: + integer :: begc, endc + integer :: begp, endp + integer :: ngwmobile_tracers + integer :: nvolatile_tracers + integer :: ntracers + integer :: nsolid_passive_tracers + !--------------------------------------------------------------------- + + begc = bounds%begc; endc= bounds%endc + begp = bounds%begp; endp= bounds%endp + ngwmobile_tracers = betrtracer_vars%ngwmobile_tracers + ntracers = betrtracer_vars%ntracers + nvolatile_tracers = betrtracer_vars%nvolatile_tracers + nsolid_passive_tracers = betrtracer_vars%nsolid_passive_tracers + + allocate(this%tracer_flx_prec_col (begc:endc, 1:ntracers)); this%tracer_flx_prec_col (:,:) = nan + allocate(this%tracer_flx_vtrans_patch (begp:endp, 1:ntracers)); this%tracer_flx_vtrans_patch (:,:) = nan + allocate(this%tracer_flx_snowfall_grnd_patch (begp:endp, 1:ntracers)); this%tracer_flx_snowfall_grnd_patch(:,:) = nan + allocate(this%tracer_flx_rainfall_grnd_patch (begp:endp, 1:ntracers)); this%tracer_flx_rainfall_grnd_patch(:,:) = nan + allocate(this%tracer_flx_prec_intr_patch (begp:endp, 1:ntracers)); this%tracer_flx_prec_intr_patch (:,:) = nan + allocate(this%tracer_flx_prec_grnd_patch(begp:endp, 1:ntracers)); this%tracer_flx_prec_grnd_patch(:,:) = nan + allocate(this%tracer_flx_snwcp_liq_patch (begp:endp, 1:ntracers)); this%tracer_flx_snwcp_liq_patch (:,:) = nan + allocate(this%tracer_flx_snwcp_ice_patch (begp:endp, 1:ntracers)); this%tracer_flx_snwcp_ice_patch (:,:) = nan + + if(ngwmobile_tracers>0)then + allocate(this%tracer_flx_drain_col (begc:endc, 1:ngwmobile_tracers)); this%tracer_flx_drain_col (:,:) = nan + allocate(this%tracer_flx_top_soil_col (begc:endc, 1:ngwmobile_tracers)); this%tracer_flx_top_soil_col (:,:) = nan + allocate(this%tracer_flx_can_loss_col (begc:endc, 1:ngwmobile_tracers)); this%tracer_flx_can_loss_col (:,:) = nan + allocate(this%tracer_flx_snowmelt_col (begc:endc, 1:ngwmobile_tracers)); this%tracer_flx_snowmelt_col (:,:) = nan + allocate(this%tracer_flx_infl_col (begc:endc, 1:ngwmobile_tracers)); this%tracer_flx_infl_col (:,:) = nan + allocate(this%tracer_flx_leaching_col (begc:endc, 1:ngwmobile_tracers)); this%tracer_flx_leaching_col (:,:) = nan + allocate(this%tracer_flx_surfrun_col (begc:endc, 1:ngwmobile_tracers)); this%tracer_flx_surfrun_col (:,:) = nan + allocate(this%tracer_flx_vtrans_col (begc:endc, 1:ngwmobile_tracers)); this%tracer_flx_vtrans_col (:,:) = nan + allocate(this%tracer_flx_dew_grnd_col (begc:endc, 1:ngwmobile_tracers)); this%tracer_flx_dew_grnd_col (:,:) = nan + allocate(this%tracer_flx_dew_snow_col (begc:endc, 1:ngwmobile_tracers)); this%tracer_flx_dew_snow_col (:,:) = nan + allocate(this%tracer_flx_sub_snow_col (begc:endc, 1:ngwmobile_tracers)); this%tracer_flx_sub_snow_col (:,:) = nan + + allocate(this%tracer_flx_h2osfc_snow_residual_col(begc:endc, 1:ngwmobile_tracers));this%tracer_flx_h2osfc_snow_residual_col(:,:) = nan + allocate(this%tracer_flx_totleached_col(begc:endc, 1:ngwmobile_tracers)); this%tracer_flx_totleached_col(:,:) = nan + endif + if(nvolatile_tracers>0)then + allocate(this%tracer_flx_ebu_col (begc:endc, 1:nvolatile_tracers)); this%tracer_flx_ebu_col (:,:) = nan + allocate(this%tracer_flx_dif_col (begc:endc, 1:nvolatile_tracers)); this%tracer_flx_dif_col (:,:) = nan + allocate(this%tracer_flx_tparchm_col (begc:endc, 1:nvolatile_tracers)); this%tracer_flx_tparchm_col (:,:) = nan + allocate(this%tracer_flx_surfemi_col (begc:endc, 1:nvolatile_tracers)); this%tracer_flx_surfemi_col (:,:) = nan + allocate(this%tracer_flx_parchm_vr_col (begc:endc, lbj:ubj, 1:nvolatile_tracers)); this%tracer_flx_parchm_vr_col(:,:,:) = nan + endif + + allocate(this%tracer_flx_netpro_vr_col (begc:endc, lbj:ubj, 1:ntracers)); this%tracer_flx_netpro_vr_col (:,:,:) = nan + allocate(this%tracer_flx_netphyloss_col (begc:endc, 1:ntracers)); this%tracer_flx_netphyloss_col(:,:) = nan + allocate(this%tracer_flx_netpro_col (begc:endc, 1:ntracers)); this%tracer_flx_netpro_col(:,:) = nan + allocate(this%tracer_flx_dstor_col (begc:endc, 1:ntracers)); this%tracer_flx_dstor_col(:,:) = nan + + + end subroutine InitAllocate + + !----------------------------------------------------------------------- + subroutine InitHistory(this, bounds, betrtracer_vars) + ! + ! !DESCRIPTION: + ! History fields initialization + ! + ! !USES: + !use shr_infnan_mod, only: nan => shr_infnan_nan, assignment(=) + use clm_varcon , only: spval + use clm_varpar , only: nlevsno + use histFileMod , only: hist_addfld1d, hist_addfld2d + use histFileMod , only: no_snow_normal, no_snow_zero + use BeTRTracerType, only: BeTRTracer_Type + ! + ! !ARGUMENTS: + class(TracerFlux_type) :: this + type(bounds_type), intent(in) :: bounds + type(BeTRTracer_Type), intent(in) :: betrtracer_vars + + ! + ! !LOCAL VARIABLES: + integer :: ntracers + integer :: ngwmobile_tracers + integer :: nsolid_passive_tracers + integer :: jj, kk + integer :: begc, endc + real(r8), pointer :: data2dptr(:,:) ! temp. pointers for slicing larger arrays + real(r8), pointer :: data1dptr(:) ! temp. pointers for slicing larger arrays + + associate( & + ngwmobile_tracers => betrtracer_vars%ngwmobile_tracers , & + ntracers => betrtracer_vars%ntracers , & + is_volatile => betrtracer_vars%is_volatile , & + volatileid => betrtracer_vars%volatileid , & + tracernames => betrtracer_vars%tracernames & + ) + begc=bounds%begc; endc=bounds%endc + do jj = 1, ntracers + if(jj<= ngwmobile_tracers) then + + this%tracer_flx_dew_grnd_col (begc:endc, jj) = spval + data1dptr => this%tracer_flx_dew_grnd_col(:, jj) + call hist_addfld1d (fname=trim(tracernames(jj))//'_FLX_DEW_GRND', units='none', & + avgflag='A', long_name='incoming dew flux to ground for '//trim(tracernames(jj)), & + ptr_col=data1dptr, default='inactive') + + this%tracer_flx_dew_snow_col(begc:endc, jj) = spval + data1dptr => this%tracer_flx_dew_snow_col(:, jj) + call hist_addfld1d (fname=trim(tracernames(jj))//'_FLX_DEW_SNOW', units='none', & + avgflag='A', long_name='incoming dew flux to snow from '//trim(tracernames(jj)), & + ptr_col=data1dptr, default='inactive') + + this%tracer_flx_h2osfc_snow_residual_col(begc:endc, jj) = spval + data1dptr => this%tracer_flx_h2osfc_snow_residual_col(:, jj) + call hist_addfld1d (fname=trim(tracernames(jj))//'_FLX_H2OSFC_SNOW_RES', units='none', & + avgflag='A', long_name='incoming flux to topsoi from snow and h2osfc residual for '//trim(tracernames(jj)), & + ptr_col=data1dptr, default='inactive') + + this%tracer_flx_sub_snow_col(begc:endc, jj) = spval + data1dptr => this%tracer_flx_sub_snow_col(:, jj) + call hist_addfld1d (fname=trim(tracernames(jj))//'_FLX_SUB_SNOW', units='none', & + avgflag='A', long_name='sublimation flux from snow for '//trim(tracernames(jj)), & + ptr_col=data1dptr, default='inactive') + + + this%tracer_flx_top_soil_col(begc:endc, jj) = spval + data1dptr => this%tracer_flx_top_soil_col(:, jj) + call hist_addfld1d (fname=trim(tracernames(jj))//'_FLX_TOPSOIL', units='none', & + avgflag='A', long_name='incoming flux at top of the soil for '//trim(tracernames(jj)), & + ptr_col=data1dptr, default='inactive') + + + this%tracer_flx_can_loss_col(begc:endc, jj) = spval + data1dptr => this%tracer_flx_can_loss_col(:, jj) + call hist_addfld1d (fname=trim(tracernames(jj))//'_FLX_CAN_LOSS', units='none', & + avgflag='A', long_name='loss from canopy for '//trim(tracernames(jj)), & + ptr_col=data1dptr, default='inactive') + + this%tracer_flx_snowmelt_col(begc:endc, jj) = spval + data1dptr => this%tracer_flx_snowmelt_col(:, jj) + call hist_addfld1d (fname=trim(tracernames(jj))//'_FLX_SNOWMELT', units='none', & + avgflag='A', long_name='loss from snowmelt for '//trim(tracernames(jj)), & + ptr_col=data1dptr, default='inactive') + + this%tracer_flx_infl_col(begc:endc, jj) = spval + data1dptr => this%tracer_flx_infl_col(:, jj) + call hist_addfld1d (fname=trim(tracernames(jj))//'_FLX_INFIL', units='none', & + avgflag='A', long_name='infiltration for '//trim(tracernames(jj)), & + ptr_col=data1dptr, default='inactive') + + + this%tracer_flx_netpro_vr_col(begc:endc, :, jj) = spval + data2dptr =>this%tracer_flx_netpro_vr_col(:,:,jj) + call hist_addfld2d (fname=trim(tracernames(jj))//'_FLX_NETPRO_vr', units='none', type2d='levtrc', & + avgflag='A', long_name='net production for '//trim(tracernames(jj)), & + ptr_col=data2dptr, default='inactive') + + this%tracer_flx_leaching_col(begc:endc, jj) = spval + data1dptr => this%tracer_flx_leaching_col(:, jj) + call hist_addfld1d (fname=trim(tracernames(jj))//'_FLX_LEACHING', units='none', & + avgflag='A', long_name='bottom of soil leaching for '//trim(tracernames(jj)), & + ptr_col=data1dptr, default='inactive') + + this%tracer_flx_surfrun_col(begc:endc, jj) = spval + data1dptr => this%tracer_flx_surfrun_col(:, jj) + call hist_addfld1d (fname=trim(tracernames(jj))//'_FLX_SRUNOFF', units='none', & + avgflag='A', long_name='loss from surface runoff for '//trim(tracernames(jj)), & + ptr_col=data1dptr, default='inactive') + + + this%tracer_flx_vtrans_col(begc:endc, jj) = spval + data1dptr => this%tracer_flx_vtrans_col(:, jj) + call hist_addfld1d (fname=trim(tracernames(jj))//'_FLX_VTRANS', units='none', & + avgflag='A', long_name='transport through transpiration for '//trim(tracernames(jj)), & + ptr_col=data1dptr, default='inactive') + + this%tracer_flx_totleached_col(begc:endc, jj) = spval + data1dptr => this%tracer_flx_totleached_col(:, jj) + call hist_addfld1d (fname=trim(tracernames(jj))//'_FLX_TLEACH', units='none', & + avgflag='A', long_name='transport through leaching for '//trim(tracernames(jj)), & + ptr_col=data1dptr, default='inactive') + + if(is_volatile(jj))then + kk = volatileid(jj) + this%tracer_flx_ebu_col(begc:endc, kk) = spval + data1dptr => this%tracer_flx_ebu_col(:, kk) + call hist_addfld1d (fname=trim(tracernames(jj))//'_FLX_EBU', units='none', & + avgflag='A', long_name='loss through ebullition (+ into atmosphere) for '//trim(tracernames(jj)), & + ptr_col=data1dptr, default='inactive') + + this%tracer_flx_dif_col(begc:endc, kk) = spval + data1dptr => this%tracer_flx_dif_col(:, kk) + call hist_addfld1d (fname=trim(tracernames(jj))//'_FLX_DIF', units='none', & + avgflag='A', long_name='loss through diffusion (+ into atmosphere) for '//trim(tracernames(jj)), & + ptr_col=data1dptr, default='inactive') + + this%tracer_flx_tparchm_col(begc:endc, kk) = spval + data1dptr => this%tracer_flx_tparchm_col(:, jj) + call hist_addfld1d (fname=trim(tracernames(jj))//'_FLX_ARCHM', units='none', & + avgflag='A', long_name='loss from aerenchyma transport for '//trim(tracernames(jj)), & + ptr_col=data1dptr, default='inactive') + + endif + + this%tracer_flx_drain_col(begc:endc, jj) = spval + data1dptr => this%tracer_flx_drain_col(:, jj) + call hist_addfld1d (fname=trim(tracernames(jj))//'_FLX_DRAIN', units='none', & + avgflag='A', long_name='loss from drainage for '//trim(tracernames(jj)), & + ptr_col=data1dptr, default='inactive') + endif + this%tracer_flx_netphyloss_col(begc:endc, jj) = spval + data1dptr => this%tracer_flx_netphyloss_col(:, jj) + call hist_addfld1d (fname=trim(tracernames(jj))//'_FLX_NETLOSS', units='none', & + avgflag='A', long_name='net loss for '//trim(tracernames(jj)), & + ptr_col=data1dptr, default='inactive') + + this%tracer_flx_netpro_col(begc:endc, jj) = spval + data1dptr => this%tracer_flx_netpro_col(:, jj) + call hist_addfld1d (fname=trim(tracernames(jj))//'_FLX_NETPRO', units='none', & + avgflag='A', long_name='net production for '//trim(tracernames(jj)), & + ptr_col=data1dptr, default='inactive') + + this%tracer_flx_dstor_col(begc:endc, jj) = spval + data1dptr => this%tracer_flx_dstor_col(:, jj) + call hist_addfld1d (fname=trim(tracernames(jj))//'_FLX_DSTOR', units='none', & + avgflag='A', long_name='total concentration change for '//trim(tracernames(jj)), & + ptr_col=data1dptr, default='inactive') + + this%tracer_flx_prec_col(begc:endc, jj) = spval + data1dptr => this%tracer_flx_prec_col(:, jj) + call hist_addfld1d (fname=trim(tracernames(jj))//'_FLX_PREC', units='none', & + avgflag='A', long_name='incoming from precipitation for '//trim(tracernames(jj)), & + ptr_col=data1dptr, default='inactive') + + enddo + + end associate + + + + end subroutine InitHistory + + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds) + ! + ! !DESCRIPTION: + ! cold initialization + ! + ! !USES: + ! + ! !ARGUMENTS: + class(TracerFlux_type) :: this + type(bounds_type) , intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: c, j, p, l ! index + integer :: begp, endp + integer :: begc, endc + !----------------------------------------------------------------------- + + begc = bounds%begc; endc= bounds%endc + begp = bounds%begp; endp= bounds%endp + + do p = bounds%begp,bounds%endp + l = pft%landunit(p) + if (lun%ifspecial(l)) then + this%tracer_flx_vtrans_patch(p,:) = spval + this%tracer_flx_snowfall_grnd_patch(p,:) = spval + this%tracer_flx_rainfall_grnd_patch(p,:) = spval + this%tracer_flx_prec_intr_patch(p,:) = spval + this%tracer_flx_prec_grnd_patch(p,:) = spval + this%tracer_flx_snwcp_liq_patch(p,:) = spval + this%tracer_flx_snwcp_ice_patch(p,:) = spval + endif + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + this%tracer_flx_vtrans_patch(p,:) = 0._r8 + this%tracer_flx_snowfall_grnd_patch(p,:) = 0._r8 + this%tracer_flx_rainfall_grnd_patch(p,:) = 0._r8 + this%tracer_flx_prec_intr_patch(p,:) = 0._r8 + this%tracer_flx_prec_grnd_patch(p,:) = 0._r8 + this%tracer_flx_snwcp_liq_patch(p,:) = 0._r8 + this%tracer_flx_snwcp_ice_patch(p,:) = 0._r8 + endif + enddo + do c = begc, endc + l = col%landunit(c) + if (lun%ifspecial(l)) then + this%tracer_flx_top_soil_col(c,:) = spval + this%tracer_flx_can_loss_col(c,:) = spval + this%tracer_flx_snowmelt_col (c,:) = spval + this%tracer_flx_infl_col(c,:) = spval + this%tracer_flx_netphyloss_col(c,:) = spval + this%tracer_flx_netpro_col(c,:) = spval + this%tracer_flx_dstor_col(c,:) = spval + this%tracer_flx_ebu_col(c,:) = spval + this%tracer_flx_prec_col(c,:) = spval + this%tracer_flx_dif_col(c,:) = spval + this%tracer_flx_drain_col(c,:) = spval + this%tracer_flx_surfemi_col(c,:) = spval + this%tracer_flx_leaching_col(c,:) = spval + this%tracer_flx_surfrun_col(c,:) = spval + this%tracer_flx_tparchm_col(c,:) = spval + this%tracer_flx_parchm_vr_col(c,:,:) = spval + this%tracer_flx_vtrans_col(c,:) = spval + this%tracer_flx_dew_grnd_col (c,:) = spval + this%tracer_flx_dew_snow_col (c,:) = spval + this%tracer_flx_sub_snow_col (c,:) = spval + this%tracer_flx_h2osfc_snow_residual_col(c,:) = spval + this%tracer_flx_totleached_col(c,:) = spval + endif + + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + this%tracer_flx_top_soil_col(c,:) = 0._r8 + this%tracer_flx_can_loss_col(c,:) = 0._r8 + this%tracer_flx_snowmelt_col (c,:) = 0._r8 + this%tracer_flx_infl_col(c,:) = 0._r8 + this%tracer_flx_netphyloss_col(c,:) = 0._r8 + this%tracer_flx_netpro_col(c,:) = 0._r8 + this%tracer_flx_dstor_col(c,:) = 0._r8 + this%tracer_flx_ebu_col(c,:) = 0._r8 + this%tracer_flx_prec_col(c,:) = 0._r8 + this%tracer_flx_dif_col(c,:) = 0._r8 + this%tracer_flx_drain_col(c,:) = 0._r8 + this%tracer_flx_surfemi_col(c,:) = 0._r8 + this%tracer_flx_leaching_col(c,:) = 0._r8 + this%tracer_flx_surfrun_col(c,:) = 0._r8 + this%tracer_flx_tparchm_col(c,:) = 0._r8 + this%tracer_flx_parchm_vr_col(c,:,:) = 0._r8 + this%tracer_flx_vtrans_col(c,:) = 0._r8 + this%tracer_flx_dew_grnd_col (c,:) = 0._r8 + this%tracer_flx_dew_snow_col (c,:) = 0._r8 + this%tracer_flx_sub_snow_col (c,:) = 0._r8 + this%tracer_flx_h2osfc_snow_residual_col(c,:) = 0._r8 + this%tracer_flx_totleached_col (c,:) = 0._r8 + endif + enddo + + + end subroutine InitCold + + !------------------------------------------------------------------------ + subroutine Restart(this, bounds, ncid, flag, betrtracer_vars) + ! + ! !DESCRIPTION: + ! Read/Write module information to/from restart file. + ! + ! Now it is purposely empty, but will be potentially useful in the future + ! !USES: + use BetrTracerType , only : betrtracer_type + use clm_varpar , only : nlevsno, nlevsoi + use clm_varcon , only : spval + use restUtilMod + use ncdio_pio + ! + ! !ARGUMENTS: + class(TracerFlux_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' + type(BeTRTracer_Type), intent(in) :: betrtracer_vars + ! + ! !LOCAL VARIABLES: + integer :: j,c ! indices + logical :: readvar ! determine if variable is on initial file + + + end subroutine Restart + + !----------------------------------------------------------------------- + subroutine Reset(this, bounds, numf, filter) + ! + ! !DESCRIPTION: + ! Intitialize SNICAR variables for fresh snow column + ! + ! !ARGUMENTS: + class(TracerFlux_type) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: numf + integer , intent(in) :: filter(:) + !----------------------------------------------------------------------- + + integer :: fc, column + + do fc = 1, numf + column = filter(fc) + this%tracer_flx_top_soil_col (column,:) = 0._r8 + this%tracer_flx_can_loss_col (column,:) = 0._r8 + this%tracer_flx_snowmelt_col (column,:) = 0._r8 + this%tracer_flx_infl_col (column,:) = 0._r8 + this%tracer_flx_netphyloss_col (column,:) = 0._r8 + this%tracer_flx_netpro_col (column,:) = 0._r8 + this%tracer_flx_dstor_col (column,:) = 0._r8 + this%tracer_flx_ebu_col (column,:) = 0._r8 + this%tracer_flx_prec_col (column,:) = 0._r8 + this%tracer_flx_dif_col (column,:) = 0._r8 + this%tracer_flx_drain_col (column,:) = 0._r8 + this%tracer_flx_surfemi_col (column,:) = 0._r8 + this%tracer_flx_leaching_col (column,:) = 0._r8 + this%tracer_flx_surfrun_col (column,:) = 0._r8 + this%tracer_flx_tparchm_col (column,:) = 0._r8 + this%tracer_flx_parchm_vr_col (column,:,:) = 0._r8 + this%tracer_flx_vtrans_col (column,:) = 0._r8 + this%tracer_flx_dew_grnd_col (column,:) = 0._r8 + this%tracer_flx_dew_snow_col (column,:) = 0._r8 + this%tracer_flx_sub_snow_col (column,:) = 0._r8 + this%tracer_flx_h2osfc_snow_residual_col(column,:) = 0._r8 + this%tracer_flx_netpro_vr_col (column,:,:) = 0._r8 + this%tracer_flx_totleached_col (column,:) = 0._r8 + enddo + + end subroutine Reset + +!---------------------------------------- + subroutine Temporal_average(this, column, dtime) + ! + ! !DESCRIPTION + ! do temporal average for different fluxes + + !!ARGUMENTS: + class(TracerFlux_type) :: this + integer , intent(in) :: column ! column index + real(r8) , intent(in) :: dtime + + + this%tracer_flx_top_soil_col (column,:) = this%tracer_flx_top_soil_col (column,:)/dtime + this%tracer_flx_can_loss_col (column,:) = this%tracer_flx_can_loss_col (column,:)/dtime + this%tracer_flx_snowmelt_col (column,:) = this%tracer_flx_snowmelt_col (column,:)/dtime + this%tracer_flx_infl_col (column,:) = this%tracer_flx_infl_col (column,:)/dtime + this%tracer_flx_netphyloss_col(column,:) = this%tracer_flx_netphyloss_col (column,:)/dtime + this%tracer_flx_netpro_col (column,:) = this%tracer_flx_netpro_col (column,:)/dtime + this%tracer_flx_ebu_col (column,:) = this%tracer_flx_ebu_col (column,:)/dtime + this%tracer_flx_prec_col (column,:) = this%tracer_flx_prec_col (column,:)/dtime + this%tracer_flx_dif_col (column,:) = this%tracer_flx_dif_col (column,:)/dtime + this%tracer_flx_drain_col (column,:) = this%tracer_flx_drain_col (column,:)/dtime + this%tracer_flx_surfemi_col (column,:) = this%tracer_flx_surfemi_col (column,:)/dtime + this%tracer_flx_leaching_col (column,:) = this%tracer_flx_leaching_col (column,:)/dtime + this%tracer_flx_surfrun_col (column,:) = this%tracer_flx_surfrun_col (column,:)/dtime + this%tracer_flx_tparchm_col (column,:) = this%tracer_flx_tparchm_col (column,:)/dtime + this%tracer_flx_vtrans_col (column,:) = this%tracer_flx_vtrans_col (column,:)/dtime + this%tracer_flx_dew_grnd_col (column,:) = this%tracer_flx_dew_grnd_col (column,:)/dtime + this%tracer_flx_dew_snow_col (column,:) = this%tracer_flx_dew_snow_col (column,:)/dtime + this%tracer_flx_sub_snow_col (column,:) = this%tracer_flx_sub_snow_col (column,:)/dtime + this%tracer_flx_h2osfc_snow_residual_col(column,:) = this%tracer_flx_h2osfc_snow_residual_col(column,:)/dtime + + this%tracer_flx_totleached_col(column,:) = this%tracer_flx_drain_col(column,:) + this%tracer_flx_leaching_col(column,:) + end subroutine temporal_average + + !---------------------------------------------------------------- + subroutine Flux_summary(this, c, betrtracer_vars) + ! + ! aggregate fluxes for mass balance check + + use BetrTracerType , only : betrtracer_type + use clm_time_manager , only : get_step_size + use clm_varpar , only : nlevtrc_soil + use MathfuncMod , only : dot_sum + class(TracerFlux_type) :: this + type(BeTRTracer_Type) , intent(in) :: betrtracer_vars + integer , intent(in) :: c ! column index + + !local variables + integer :: jj, kk + real(r8):: dtime + associate( & + ntracers => betrtracer_vars%ntracers , & + nvolatile_tracers => betrtracer_vars%nvolatile_tracers , & + ngwmobile_tracers => betrtracer_vars%ngwmobile_tracers , & + is_volatile => betrtracer_vars%is_volatile , & + tracernames => betrtracer_vars%tracernames , & + volatileid => betrtracer_vars%volatileid & + ) + dtime = get_step_size() + do jj = 1, ngwmobile_tracers + !the total net physical loss currently includes infiltration, surface runoff, transpiration aided transport, + !lateral drainage, vertical leaching + !for volatile tracers, this includes surface emission surface three different pathways + this%tracer_flx_infl_col(c,jj) = this%tracer_flx_infl_col(c,jj)*dtime + + this%tracer_flx_netphyloss_col(c,jj) = - this%tracer_flx_infl_col(c,jj) - this%tracer_flx_dew_grnd_col(c,jj) & + - this%tracer_flx_dew_snow_col(c,jj) - this%tracer_flx_h2osfc_snow_residual_col(c,jj) & + + this%tracer_flx_sub_snow_col(c,jj) + this%tracer_flx_drain_col(c,jj) + & + this%tracer_flx_surfrun_col(c,jj) + this%tracer_flx_vtrans_col(c,jj) + this%tracer_flx_leaching_col(c,jj) + + + + if(is_volatile(jj))then + kk = volatileid(jj) + this%tracer_flx_tparchm_col(c,kk) = dot_sum(x=this%tracer_flx_parchm_vr_col(c,1:nlevtrc_soil,kk), y=col%dz(c,1:nlevtrc_soil)) + + this%tracer_flx_surfemi_col(c,kk) = this%tracer_flx_tparchm_col(c,kk) + this%tracer_flx_dif_col(c,kk) + & + this%tracer_flx_ebu_col(c,kk) + + this%tracer_flx_netphyloss_col(c,jj) = this%tracer_flx_netphyloss_col(c,jj) + this%tracer_flx_surfemi_col(c,kk) + + endif + enddo + + do jj = 1, ntracers + this%tracer_flx_netpro_col(c,jj) = dot_sum(x=this%tracer_flx_netpro_vr_col(c,1:nlevtrc_soil,jj),y=col%dz(c,1:nlevtrc_soil)) + if(jj<=ngwmobile_tracers)then + if(is_volatile(jj))then + kk = volatileid(jj) + this%tracer_flx_netpro_col(c,jj) = this%tracer_flx_netpro_col(c,jj) + this%tracer_flx_tparchm_col(c,kk) + endif + endif + enddo + end associate + end subroutine Flux_summary + + + !---------------------------------------------------------------- + subroutine Flux_display(this, c, jj, betrtracer_vars) + ! + ! aggregate fluxes for mass balance check + + use BetrTracerType , only : betrtracer_type + + class(TracerFlux_type) :: this + type(BeTRTracer_Type) , intent(in) :: betrtracer_vars + integer , intent(in) :: c ! column index + integer , intent(in) :: jj + !local variables + integer :: kk + + associate( & + ntracers => betrtracer_vars%ntracers , & + nvolatile_tracers => betrtracer_vars%nvolatile_tracers , & + ngwmobile_tracers => betrtracer_vars%ngwmobile_tracers , & + is_volatile => betrtracer_vars%is_volatile , & + tracernames => betrtracer_vars%tracernames , & + volatileid => betrtracer_vars%volatileid & + ) + + !the total net physical loss currently includes infiltration, surface runoff, transpiration aided transport, + !lateral drainage, vertical leaching + !for volatile tracers, this includes surface emission surface three different pathways + write(iulog,*)tracernames(jj) + write(iulog,*),'infl=',this%tracer_flx_infl_col(c,jj),' drain=', this%tracer_flx_drain_col(c,jj), & + ' surfrun=',this%tracer_flx_surfrun_col(c,jj),' vtrans=', this%tracer_flx_vtrans_col(c,jj),& + ' leaching=', this%tracer_flx_leaching_col(c,jj) + + if(is_volatile(jj))then + kk = volatileid(jj) + write(iulog,*),'tpartm=', this%tracer_flx_tparchm_col(c,kk),' dif=', this%tracer_flx_dif_col(c,kk), & + ' ebu=',this%tracer_flx_ebu_col(c,kk) + endif + + + end associate + end subroutine Flux_display + +end module TracerFluxType diff --git a/components/clm/src/betr/betr_core/TracerParamsMod.F90 b/components/clm/src/betr/betr_core/TracerParamsMod.F90 new file mode 100644 index 000000000000..110548293b29 --- /dev/null +++ b/components/clm/src/betr/betr_core/TracerParamsMod.F90 @@ -0,0 +1,1952 @@ +module TracerParamsMod +#include "shr_assert.h" + + ! !DESCRIPTION: + ! Module holding routines used to compute solubility, and phase conversion parameters + ! to be used for BeTR 1D vertical tracer transport + ! + ! + ! History + ! Jinyun Tang created May 2014. + ! !USES: + 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_varpar , only : nlevsoi + use clm_varcon , only : spval + use PatchType , only : pft + use ColumnType , only : col + use tracer_varcon + implicit none + save + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: tracer_param_init + public :: set_multi_phase_diffusion + public :: get_gas_diffusivity + public :: get_diffusivity_ratio_gas2h2o, get_henrycef + public :: convert_mobile2gas + public :: set_phase_convert_coeff + public :: calc_tracer_infiltration + public :: pre_diagnose_soilcol_water_flux + public :: diagnose_advect_water_flux + public :: diagnose_drainage_water_flux + public :: calc_smp_l + public :: get_zwt + public :: calc_aerecond + public :: betr_annualupdate + !parameters + real(r8), parameter :: minval_diffus = 1.e-20_r8 !minimum diffusivity, m2/s + real(r8), parameter :: minval_airvol = 1.e-10_r8 !minimum air-filled volume + + + !declare a private tortuosity type + type :: soil_tortuosity_type + real(r8), pointer :: tau_gas(:,:) !soil tortuosity for gaseous phase diffusion + real(r8), pointer :: tau_liq(:,:) !soil tortuosity for aqueous phase diffusion + end type soil_tortuosity_type + type(soil_tortuosity_type), target :: tau_soil + real(r8), private, pointer :: h2osoi_liq_copy(:,:) + !! +contains + + + subroutine tracer_param_init(bounds) + + ! + ! !DESCRIPTION: + ! + ! initialize the tracerParamsMod + ! + ! !USES: + use clm_varpar , only : nlevtrc_soil + + implicit none + type(bounds_type), intent(in) :: bounds !bounds + character(len=32) :: subname ='tracer_param_init' + + allocate(tau_soil%tau_gas(bounds%begc:bounds%endc, 1 : nlevtrc_soil)) + tau_soil%tau_gas(:,:) = 0._r8 + allocate(tau_soil%tau_liq(bounds%begc:bounds%endc, 1 : nlevtrc_soil)) + tau_soil%tau_liq(:,:) = 0._r8 + + + end subroutine tracer_param_init + + !-------------------------------------------------------------------------------------------------------------- + subroutine Calc_gaseous_diffusion_soil_tortuosity(bounds, lbj, ubj, jtops, num_soilc, filter_soilc, soilstate_vars, waterstate_vars, tau_gas) + ! + ! !DESCRIPTION: + ! + ! compute soil tortuosity for gasesous diffusion + + ! !USES: + use SoilStateType , only : soilstate_type + use WaterStateType , only : Waterstate_Type + + implicit none + !arguments + type(bounds_type), intent(in) :: bounds ! bounds + integer, intent(in) :: num_soilc ! number of column soil points in column filter + integer, intent(in) :: filter_soilc(:) ! column filter for soil points + integer, intent(in) :: lbj, ubj ! lower and upper bounds, make sure they are > 0 + integer, intent(in) :: jtops(bounds%begc: ) ! top label of each column + type(soilstate_type), intent(in) :: soilstate_vars ! column soil physical state variables + type(Waterstate_Type), intent(in) :: waterstate_vars ! column soil water state variables + real(r8), intent(inout) :: tau_gas(bounds%begc: , lbj: ) !output variable + + !local variables + integer :: n, fc, c !indices + character(len=255) :: subname = 'calc_gaseous_diffusion_soil_tortuosity' + + associate( & + eff_porosity => soilstate_vars%eff_porosity_col, & !effective soil porosity + bsw => soilstate_vars%bsw_col , & !clapp-hornber shape parameters + air_vol => waterstate_vars%air_vol_col & !volume possessed by air + ) + + SHR_ASSERT_ALL((ubound(jtops) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(tau_gas) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) + do n = lbj, ubj + do fc = 1, num_soilc + c = filter_soilc(fc) + if(n>=jtops(c))then + tau_gas(c,n) = get_taugas(eff_porosity(c,n), air_vol(c,n),bsw(c,n)) + endif + enddo + enddo + end associate + + end subroutine Calc_gaseous_diffusion_soil_tortuosity + !-------------------------------------------------------------------------------------------------------------- + subroutine Calc_aqueous_diffusion_soil_tortuosity(bounds, lbj, ubj, jtops, numf, filter, soilstate_vars, waterstate_vars, tau_liq) + ! + ! DESCRIPTIONS + ! compute soil tortuosity for aquesous diffusion + ! + + use SoilStateType , only : soilstate_type + use WaterStateType , only : Waterstate_Type + + implicit none + + !arguments + type(bounds_type), intent(in) :: bounds ! bounds + integer, intent(in) :: numf ! number of columns in column filter + integer, intent(in) :: filter(:) ! column filter + integer, intent(in) :: lbj, ubj ! lower and upper bounds, make sure they are > 0 + integer, intent(in) :: jtops(bounds%begc: ) ! top label of each column + type(soilstate_type), intent(in) :: soilstate_vars ! column soil physical state variables + type(Waterstate_Type), intent(in) :: waterstate_vars ! column soil water state variables + real(r8), intent(inout) :: tau_liq(bounds%begc: , lbj: ) !output variable + + !local variables + integer :: n, fc, c !indices + character(len=255) :: subname = 'calc_aqueous_diffusion_soil_tortuosity' + + SHR_ASSERT_ALL((ubound(jtops) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(tau_liq) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) + + associate( & + eff_porosity => soilstate_vars%eff_porosity_col, & !effective soil porosity + bsw => soilstate_vars%bsw_col , & !clapp-hornber shape parameters + h2osoi_liqvol => waterstate_vars%h2osoi_liqvol_col & !soil volume possessed by liquid water + ) + + do n = lbj, ubj + do fc = 1, numf + c = filter(fc) + if(n>=jtops(c))then + tau_liq(c,n)=get_tauliq(eff_porosity(c,n), h2osoi_liqvol(c,n),bsw(c,n)) + endif + enddo + enddo + end associate + end subroutine calc_aqueous_diffusion_soil_tortuosity + + !-------------------------------------------------------------------------------------------------------------- + + subroutine calc_bulk_diffusivity(bounds, lbj, ubj, jtops, numf, filter, bunsencef_col, & + canopystate_vars, waterstate_vars, tau_soi, betrtracer_vars, t_soisno, bulkdiffus) + ! + ! !DESCRIPTION: + ! compute the weighted bulk diffusivity in soil for dual-phase transport + ! Reference: Tang and Riley, 2014, BG, Simple formulations and solutions of & + ! the dual-phase diffusive transport for biogeochemical modeling. + !the formula for a volatile species is + !D_bulk=(airvol*D_g*tau_g+bunsencef_col*h2osoi_liqvol*D_w*tau_w) + + ! !USES: + use WaterStateType , only : Waterstate_Type + use BeTRTracerType , only : betrtracer_type + use CanopyStateType , only : canopystate_type + use clm_varcon , only : zisoi + + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: numf ! number of columns in column filter + integer , intent(in) :: filter(:) ! column filter + integer , intent(in) :: lbj, ubj ! lower and upper bounds, make sure they are > 0 + integer , intent(in) :: jtops(bounds%begc: ) ! top label of each column + real(r8) , intent(in) :: t_soisno(bounds%begc: , lbj: ) ! soil temperature + real(r8) , intent(in) :: bunsencef_col(bounds%begc: ,lbj: ,1: ) ! bunsen coefficient for gaseous-aqueous conversion + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(Waterstate_Type) , intent(in) :: waterstate_vars ! water state variables + type(canopystate_type) , intent(in) :: canopystate_vars ! canopy state variables + type(soil_tortuosity_type) , intent(in) :: tau_soi ! soil tortuosity + real(r8) ,intent(out) :: bulkdiffus(bounds%begc: ,lbj: , 1: ) ! the returning variable + + !local variables + real(r8) :: max_depth_cryoturb = 3._r8 !m + !parameters below will be encapsulated into a structure later + real(r8) :: max_altdepth_cryoturbation = 1._r8 ! (m) maximum active layer thickness for cryoturbation to occur + real(r8) :: cryoturb_diffusion_k = 1e-4_r8 / (86400._r8 * 365._r8) ! [m^2/sec] = 1 cm^2 / yr = 1m^2/1000 yr + real(r8) :: som_diffus = 5e-4_r8 / (86400._r8 * 365._r8) ! [m^2/sec] = 1 cm^2 / yr + integer :: j, k, n, fc, c , trcid !indices + integer :: nsld + real(r8) :: diffaqu, diffgas + character(len=255) :: subname = 'calc_bulk_diffusivity' + + !array shape checking will be added later. + SHR_ASSERT_ALL((ubound(jtops) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(t_soisno) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(jtops) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(bunsencef_col) == (/bounds%endc, ubj, betrtracer_vars%nvolatile_tracer_groups/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(bulkdiffus) == (/bounds%endc, ubj, betrtracer_vars%ntracer_groups/)), errMsg(__FILE__,__LINE__)) + + associate( & + ngwmobile_tracer_groups => betrtracer_vars%ngwmobile_tracer_groups , & ! Integer[intent(in)], number of dual phase (gw) tracers + tracer_group_memid => betrtracer_vars%tracer_group_memid , & ! + ntracer_groups => betrtracer_vars%ntracer_groups , & ! Integer[intent(in)], total number of tracers + is_volatile => betrtracer_vars%is_volatile , & ! logical[intent(in)], is a volatile tracer? + is_h2o => betrtracer_vars%is_h2o , & ! logical[intent(in)], is a h2o tracer? + volatilegroupid => betrtracer_vars%volatilegroupid , & ! integer[intent(in)], location in the volatile vector + air_vol => waterstate_vars%air_vol_col , & ! volume possessed by air + h2osoi_liqvol => waterstate_vars%h2osoi_liqvol_col , & ! soil volume possessed by liquid water + altmax => canopystate_vars%altmax_col , & ! Input: [real(r8) (:) ] maximum annual depth of thaw + altmax_lastyear => canopystate_vars%altmax_lastyear_col , & ! Input: [real(r8) (:) ] prior year maximum annual depth o + tracer_solid_passive_diffus_scal_group => betrtracer_vars%tracer_solid_passive_diffus_scal_group , & !scaling factor for solid phase diffusivity + tracer_solid_passive_diffus_thc_group => betrtracer_vars%tracer_solid_passive_diffus_thc_group , & !threshold for solid phase diffusivity + tau_gas => tau_soi%tau_gas , & ! real(r8)[intent(in)], gaseous tortuosity + tau_liq => tau_soi%tau_liq & ! real(r8)[intent(in)], aqueous tortuosity + ) + + bulkdiffus(:,:,:) = 1.e-40_r8 !initialize to a very small number + do j = 1, ngwmobile_tracer_groups + trcid = tracer_group_memid(j,1) + if(is_volatile(j))then + !it is a volatile tracers + k=volatilegroupid(trcid) + + do n=lbj, ubj + do fc = 1, numf + c = filter(fc) + if(n>=jtops(c))then + !aqueous diffusivity + diffaqu=get_aqueous_diffusivity(trcid, t_soisno(c,n), betrtracer_vars) + !gaseous diffusivity + diffgas=get_gas_diffusivity(trcid, t_soisno(c,n), betrtracer_vars) + + !bulk diffusivity + !the bulk diffusivity is calculated by assuming the diffusion equation is gas-primary + !accordingly the retardation factor is gas primary + if(is_h2o(trcid))then + !for water tracer, the aqueous phase is used as dominant species + bulkdiffus(c,n,j)=air_vol(c,n)*tau_gas(c,n)*diffgas/bunsencef_col(c,n,k)+ & + h2osoi_liqvol(c,n)*tau_liq(c,n)*diffaqu + else + bulkdiffus(c,n,j)=air_vol(c,n)*tau_gas(c,n)*diffgas+ & + h2osoi_liqvol(c,n)*tau_liq(c,n)*diffaqu*bunsencef_col(c,n,k) + endif + !to prevent division by zero + bulkdiffus(c,n,j)=max(bulkdiffus(c,n,j),minval_diffus) + endif + enddo + enddo + + else + !it is not a volatile tracer + do n = lbj, ubj + do fc = 1, numf + c = filter(fc) + if(n>=jtops(c))then + !the retardation factor is 1. + diffaqu=get_aqueous_diffusivity(trcid, t_soisno(c,n), betrtracer_vars) + bulkdiffus(c,n,j)=diffaqu*h2osoi_liqvol(c,n)*tau_liq(c,n) + !to prevent division by zero + bulkdiffus(c,n,j)=max(bulkdiffus(c,n,j),minval_diffus) !avoid division by zero in following calculations + endif + enddo + enddo + endif + enddo + + !do solid phase passive tracers + do j = ngwmobile_tracer_groups + 1, ntracer_groups + nsld = j - ngwmobile_tracer_groups + trcid = tracer_group_memid(j,1) + do n = 1, ubj + do fc = 1,numf + c = filter(fc) + + if ( ( max(altmax(c), altmax_lastyear(c)) <= max_altdepth_cryoturbation ) .and. & + ( max(altmax(c), altmax_lastyear(c)) > 0._r8) ) then + ! use mixing profile modified slightly from Koven et al. (2009): constant through active layer, linear decrease from base of active layer to zero at a fixed depth + + if ( zisoi(n) < max(altmax(c), altmax_lastyear(c)) ) then + bulkdiffus(c,n,j) = cryoturb_diffusion_k * tracer_solid_passive_diffus_scal_group(nsld) + bulkdiffus(c,n,j) = max(bulkdiffus(c,n,j), tracer_solid_passive_diffus_thc_group(nsld)) + else + bulkdiffus(c,n,j) = max(cryoturb_diffusion_k * & + ( 1._r8 - ( zisoi(n) - max(altmax(c), altmax_lastyear(c)) ) / & + ( max_depth_cryoturb - max(altmax(c), altmax_lastyear(c)) ) ), 0._r8) ! go linearly to zero between ALT and max_depth_cryoturb + bulkdiffus(c,n,j) = bulkdiffus(c,n,j) * tracer_solid_passive_diffus_scal_group(nsld) + bulkdiffus(c,n,j) = max(bulkdiffus(c,n,j), tracer_solid_passive_diffus_thc_group(nsld)) + endif + elseif ( max(altmax(c), altmax_lastyear(c)) > 0._r8 ) then + ! constant advection, constant diffusion + bulkdiffus(c,n,j) = som_diffus * tracer_solid_passive_diffus_scal_group(nsld) + bulkdiffus(c,n,j) = max(bulkdiffus(c,n,j), tracer_solid_passive_diffus_thc_group(nsld)) + else + ! completely frozen soils--no mixing + bulkdiffus(c,n,j) = 1e-4_r8 / (86400._r8 * 365._r8) * 1.e-36_r8 !set to very small number for numerical purpose + endif + enddo + enddo + enddo + end associate + end subroutine calc_bulk_diffusivity +!-------------------------------------------------------------------------------------------------------------- + + + subroutine calc_bulk_conductances(bounds, lbj, ubj, jtops, numf, filter, bulkdiffus, dz, betrtracer_vars, hmconductance_col) + ! + ! DESCRIPTIONS: + ! Compute weighted conductances for diffusive/dispersive tracer transport + ! dispersion is not modeled currently. + ! The computation of diffusivity assumes to implement the Fick's law of diffusion, + ! which is supposed to be of good accuracy when the chemical is in trace amount and + ! total air pressure changes with a small amount. The Stefan-Maxwell relationship + ! could be implemented, but it is too complicate to gain much given other sources + ! of uncertainty. + ! Reference: Tang and Riley, 2014, BG, Simple formulations and solutions of & + ! the dual-phase diffusive transport for biogeochemical modeling. + + ! jyt, Jan 6, 2014 + ! !USES: + use transportmod , only : calc_interface_conductance + use BeTRTracerType , only : betrtracer_type + implicit none + !arguments + type(bounds_type), intent(in) :: bounds ! bounds + integer, intent(in) :: lbj, ubj ! lower and upper bounds, make sure they are > 0 + integer, intent(in) :: jtops(bounds%begc: ) ! top label of each column + integer, intent(in) :: numf ! number of columns in column filter + integer, intent(in) :: filter(:) ! column filter + type(betrtracer_type), intent(in) :: betrtracer_vars ! betr configuration information + real(r8), intent(in) :: bulkdiffus(bounds%begc: ,lbj: ,1: ) !weighted bulk diffusivity for dual-phase diffusion + real(r8), intent(in) :: dz(bounds%begc: , lbj: ) + + real(r8), intent(inout) :: hmconductance_col(bounds%begc: , lbj: ,1: ) !weighted bulk conductance + + !local variables + + integer :: j, n, fc, c !indices + character(len=255) :: subname = 'calc_bulk_conductances' + + SHR_ASSERT_ALL((ubound(jtops) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(dz) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(bulkdiffus) == (/bounds%endc, ubj, betrtracer_vars%ntracer_groups/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(hmconductance_col) == (/bounds%endc, ubj-1, betrtracer_vars%ntracer_groups/)), errMsg(__FILE__,__LINE__)) + + associate( & + ngwmobile_tracer_groups => betrtracer_vars%ngwmobile_tracer_groups , & !Integer[intent(in)], number of gw tracers + ntracer_groups => betrtracer_vars%ntracer_groups , & !Integer[intent(in)], total number of tracers + is_volatile => betrtracer_vars%is_volatile , & !logical[intent(in)], is a volatile tracer? + is_mobile => betrtracer_vars%is_mobile , & + tracer_group_memid => betrtracer_vars%tracer_group_memid , & + volatileid => betrtracer_vars%volatileid & !integer[intent(in)], location in the volatile vector + ) + +! compute the depth weighted diffusivities + do j = 1, ntracer_groups + if(.not. is_mobile(tracer_group_memid(j,1)))cycle + call calc_interface_conductance(bounds, lbj, ubj, jtops, numf, filter , & + bulkdiffus(bounds%begc:bounds%endc, lbj:ubj, j) , & + dz(bounds%begc:bounds%endc, lbj:ubj) , & + hmconductance_col(bounds%begc:bounds%endc, lbj:ubj-1, j)) + enddo + + end associate + end subroutine calc_bulk_conductances + +!------------------------------------------------------------------------------- + subroutine calc_henrys_coeff(bounds, lbj, ubj, jtops, numf, filter, t_soisno, soi_pH, & + betrtracer_vars, aqu2neutralcef_col, henrycef_col) + ! + ! DESCRIPTION + ! compute henry's law constant for volatile tracers + use BeTRTracerType , only : betrtracer_type + implicit none + !arguments + type(bounds_type), intent(in) :: bounds ! bounds + integer, intent(in) :: lbj, ubj ! lower and upper bounds, make sure they are > 0 + integer, intent(in) :: jtops(bounds%begc: ) ! top label of each column + integer, intent(in) :: numf ! number of columns in column filter + integer, intent(in) :: filter(:) ! column filter + real(r8), intent(in) :: t_soisno(bounds%begc: , lbj: ) !soil temperature + real(r8), intent(in) :: soi_pH(bounds%begc: , lbj: ) !pH profile + type(betrtracer_type), intent(in) :: betrtracer_vars ! betr configuration information + + real(r8), intent(inout):: aqu2neutralcef_col(bounds%begc: , lbj: , 1: ) !conversion parameter between bulk aqueous and neutral aqueous tracer + real(r8), intent(inout):: henrycef_col(bounds%begc: , lbj: , 1: ) !henry's constant, mol/L/atm = M/atm + + !local variables + integer :: j, k, n, fc, c, trcid ! indices + real(r8) :: scal + character(len=255) :: subname='calc_henrys_coeff' + + SHR_ASSERT_ALL((ubound(jtops) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(t_soisno) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(soi_pH) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(aqu2neutralcef_col)== (/bounds%endc, ubj, betrtracer_vars%ngwmobile_tracer_groups/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(henrycef_col) == (/bounds%endc, ubj, betrtracer_vars%nvolatile_tracer_groups/)), errMsg(__FILE__,__LINE__)) + + + associate( & + ngwmobile_tracer_groups => betrtracer_vars%ngwmobile_tracer_groups , & !Integer[intent(in)], number of tracers + is_volatile => betrtracer_vars%is_volatile , & !logical[intent(in)], is a volatile tracer? + is_h2o => betrtracer_vars%is_h2o , & !logical[intent(in)], is a h2o tracer? + tracer_group_memid => betrtracer_vars%tracer_group_memid , & !integer[intent(in)], tracer id + volatilegroupid => betrtracer_vars%volatilegroupid & !integer[intent(in)], location in the volatile vector + ) + + do j = 1, ngwmobile_tracer_groups + + !for tagged co2 simulations, the henry's constants are assumed same for all co2 tracers + trcid= tracer_group_memid(j, 1) + if(is_volatile(trcid) .and. (.not. is_h2o(trcid)))then + k = volatilegroupid(trcid) + do n = lbj, ubj + do fc = 1, numf + c = filter(fc) + if(n>=jtops(c))then + !Henry's law constants + henrycef_col(c,n,k)=get_henrycef(t_soisno(c,n), trcid, betrtracer_vars) + scal = get_equilibrium_scal(t_soisno(c,n), soi_pH(c,n), trcid,betrtracer_vars) + henrycef_col(c,n,k)=henrycef_col(c,n,k) * scal + aqu2neutralcef_col(c,n,j)=1._r8/scal !this will convert the bulk aqueous phase into neutral phase + + endif + enddo + enddo + endif + enddo + end associate + end subroutine calc_henrys_coeff +!------------------------------------------------------------------------------- + subroutine calc_bunsen_coeff(bounds, lbj, ubj, jtops, numf, filter, henrycef_col, t_soisno, smp_l, betrtracer_vars, bunsencef_col) + ! + ! DESCRIPTION + ! compute Bunsen's coefficient + ! + use clm_varcon , only : denh2o + use BeTRTracerType , only : betrtracer_type + implicit none + !arguments + type(bounds_type), intent(in) :: bounds ! bounds + integer, intent(in) :: lbj, ubj ! lower and upper bounds, make sure they are > 0 + integer, intent(in) :: jtops(bounds%begc: ) ! top label of each column + integer, intent(in) :: numf ! number of columns in column filter + integer, intent(in) :: filter(:) ! column filter + real(r8), intent(in) :: t_soisno(bounds%begc: , lbj: ) !soil temperature, K + real(r8), intent(in) :: smp_l(bounds%begc: , lbj: ) !soil matric pressure, mm + type(betrtracer_type), intent(in) :: betrtracer_vars ! betr configuration information + real(r8), intent(in) :: henrycef_col(bounds%begc: , lbj: , 1: ) !henry's constant + real(r8), intent(inout) :: bunsencef_col(bounds%begc: , lbj: , 1: ) !returning variable + + !local variables + integer :: j, k, n, fc, c , trcid !indices + real(r8) :: rho_vap(bounds%begc:bounds%endc, lbj:ubj) ! saturated vapor pressure for different layers + + character(len=255) :: subname = 'calc_bunsen_coeff' + + SHR_ASSERT_ALL((ubound(jtops) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(t_soisno) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(smp_l) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(henrycef_col) == (/bounds%endc, ubj, betrtracer_vars%nvolatile_tracer_groups/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(bunsencef_col) == (/bounds%endc, ubj, betrtracer_vars%nvolatile_tracer_groups/)), errMsg(__FILE__,__LINE__)) + + associate( & + ngwmobile_tracer_groups => betrtracer_vars%ngwmobile_tracer_groups , & !Integer[intent(in)], number of tracers + tracer_group_memid => betrtracer_vars%tracer_group_memid , & + is_volatile => betrtracer_vars%is_volatile , & !logical[intent(in)], is a volatile tracer? + is_h2o => betrtracer_vars%is_h2o , & !logical[intent(in)], is a h2o tracer + volatilegroupid => betrtracer_vars%volatilegroupid & !integer[intent(in)], location in the volatile vector + ) + + + if(any(is_h2o))then + call calc_rhovap(bounds, lbj, ubj, jtops, numf, filter, t_soisno, smp_l, rho_vap) + endif + + do j = 1, ngwmobile_tracer_groups + !for tagged co2 simulations, the henry's constant are assumed same for all co2 tracers + trcid = tracer_group_memid(j, 1) + if(is_volatile(trcid))then + k = volatilegroupid(trcid) + + do n = lbj, ubj + do fc = 1, numf + c = filter(fc) + if(n>=jtops(c))then + bunsencef_col(c,n, k)= henrycef_col(c,n,k)*t_soisno(c,n)/12.2_r8 + !add the pH effect for tracers that can exist in multiple aqueous phases + if(is_h2o(trcid))then + !for water isotopes + bunsencef_col(c,n,j) = get_equi_lv_h2oiso_fractionation(trcid, t_soisno(c,j), betrtracer_vars) * denh2o/rho_vap(c,n) + endif + endif + enddo + enddo + endif + enddo + end associate + end subroutine calc_bunsen_coeff + +!------------------------------------------------------------------------------- + + subroutine calc_dual_phase_convert_coeff(bounds, lbj, ubj, jtops, numf, filter, & + waterstate_vars, betrtracer_vars, tracercoeff_vars) + + !DESCRIPTIONS: + !compute phase conversion coefficients between gaseous and aqueous phases + ! The total aqueous and gases phase concentration is = theta*aqueous+epsilon*gaseous + ! because aqueous = bunsen*gaseous, these coefficients are constant throughout the all period. + + !USES: + use BeTRTracerType , only : betrtracer_type + use WaterStateType , only : Waterstate_Type + use TracerCoeffType , only : tracercoeff_type + use clm_varcon , only : denh2o, denice + implicit none + !arguments + type(bounds_type), intent(in) :: bounds ! bounds + integer, intent(in) :: lbj, ubj ! lower and upper bounds, make sure they are > 0 + integer, intent(in) :: jtops(bounds%begc: ) ! top label of each column + integer, intent(in) :: numf ! number of columns in column filter + integer, intent(in) :: filter(:) ! column filter + type(betrtracer_type), intent(in) :: betrtracer_vars ! betr configuration information + type(Waterstate_Type), intent(in) :: waterstate_vars ! water state variables + type(tracercoeff_type), intent(inout) :: tracercoeff_vars ! structure containing tracer transport parameters + + !local variables + integer :: j, n, k, fc, c , trcid ! indices + character(len=255) :: subname = 'calc_dual_phase_convert_coeff' + + SHR_ASSERT_ALL((ubound(jtops) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + + associate( & + ngwmobile_tracer_groups => betrtracer_vars%ngwmobile_tracer_groups , & !Input: [integer(:)], number of tracers + tracer_group_memid => betrtracer_vars%tracer_group_memid , & !Input: [integer(:)], tracer id + is_h2o => betrtracer_vars%is_h2o , & !Input: [logical(:)], is h2o tracer? + is_volatile => betrtracer_vars%is_volatile , & !Input: [logical(:)], is a volatile tracer? + volatilegroupid => betrtracer_vars%volatilegroupid , & !Input: [logical(:)], location in the volatile vector + adsorbgroupid => betrtracer_vars%adsorbgroupid , & !Input: [Integer(:)], tracer id + h2osoi_liqvol => waterstate_vars%h2osoi_liqvol_col , & !Input: [real(r8)(:,:)], liquid h2o vol + h2osoi_icevol => waterstate_vars%h2osoi_icevol_col , & !Input: [real(r8)(:,:)], ice h2o vol + air_vol => waterstate_vars%air_vol_col , & !Input: [real(r8)(:,:)], air vol + bunsencef_col => tracercoeff_vars%bunsencef_col , & !Input: [real(r8)(:,:)], bunsen coeff + aqu2bulkcef_mobile => tracercoeff_vars%aqu2bulkcef_mobile_col , & !Output:[real(r8)(:,:)], phase conversion coeff + aqu2equilsolidcef => tracercoeff_vars%aqu2equilsolidcef_col , & !Input: [real(r8)(:,:)], phase conversion coeff + gas2bulkcef_mobile => tracercoeff_vars%gas2bulkcef_mobile_col & !Output:[real(r8)(:,:)], phase conversion coeff + ) + + + do j = 1, ngwmobile_tracer_groups + trcid = tracer_group_memid(j,1) + if(is_volatile(trcid))then + k = volatilegroupid(trcid) + do n = lbj, ubj + do fc = 1, numf + c = filter(fc) + if(n>=jtops(c))then + !aqueous to bulk mobile phase + aqu2bulkcef_mobile(c,n,j) = air_vol(c,n)/bunsencef_col(c,n,k)+h2osoi_liqvol(c,n) + + !gaseous to bulk mobile phase + gas2bulkcef_mobile(c,n,k) = air_vol(c,n)+h2osoi_liqvol(c,n)*bunsencef_col(c,n,k) + + if(is_h2o(trcid))then + !for water tracer, I assume the three phases are in equilibrium, such that + aqu2bulkcef_mobile(c,n,j)= aqu2bulkcef_mobile(c,n,j) + aqu2equilsolidcef(c,n,adsorbgroupid(trcid)) + + gas2bulkcef_mobile(c,n,k) = gas2bulkcef_mobile(c,n,k)+ aqu2equilsolidcef(c,n,adsorbgroupid(trcid)) * bunsencef_col(c,n,k) + endif + + !correct for impermeable layer, to avoid division by zero in doing diffusive transport + gas2bulkcef_mobile(c,n,k) = max(gas2bulkcef_mobile(c,n,k),air_vol(c,n),minval_airvol) + endif + enddo + enddo + else + !when linear adsorption is used for some adsorptive aqueous tracers, the aqu2bulkcef will be the retardation factor + !for the moment, it is set to one for all non-volatile tracers + !It is assumed that ice have same equilibrium solublity as liquid water for soluable tracers + do n = lbj, ubj + do fc = 1, numf + c = filter(fc) + if(n>=jtops(c))then + aqu2bulkcef_mobile(c, n, j) = h2osoi_liqvol(c,n)+denice/denh2o * h2osoi_icevol(c,n) + endif + enddo + enddo + endif + enddo + end associate + end subroutine calc_dual_phase_convert_coeff + + +!------------------------------------------------------------------------------- + function get_equilibrium_scal(temp, pH, tracer, betrtracer_vars)result(rscal) + + !DESCRIPTION: + ! + !obtain the equilibrium scaling factor for species that + !can exist in multiple aqueous forms through hydrolysis. + !obtain mole fractions stored as carbonate and bicarbonate + !dlogK/dT=dH/(2.303RT^2) + !logK=logK(T_0)+dH*(1/(2.303R*T_0)-1/(2.303R*T)) + ! + ! through the scale, the bulk aqueous tracer is, rscal * aqueous(netural) + ! !USES + ! + use BeTRTracerType , only : betrtracer_type + implicit none + real(r8), intent(in) :: temp, pH + integer, intent(in) :: tracer + type(betrtracer_type), intent(in) :: betrtracer_vars ! betr configuration information + + !local variables + real(r8), parameter :: Tref=298.15 ! Kelvin + real(r8), parameter :: co2reflogK1=-6.352_r8 !25 Celcius + real(r8), parameter :: co2reflogK2=-10.33_r8 !25 Celcisum + real(r8), parameter :: co2dH1=-2.0e3_r8 ! J/mol + real(r8), parameter :: co2dH2=-3.5e3_r8 ! J/mol + real(r8), parameter :: nh3logK=9.24_r8 + real(r8), parameter :: no3logK=1.30_r8 + real(r8), parameter :: R=8.3144 + real(r8) :: co2logK1, co2logK2, rscal + character(len=255) :: subname ='get_equilibrium_scal' + + + if(tracer==betrtracer_vars%id_trc_co2x)then + !H2CO3 <--> H(+)+HCO3(-) K1 + !HCO3(-)<--> H(+)+CO3(2-) K2 + !I have to check why I need 1.e3_r8 for conversion + co2logK1 = co2reflogK1+co2dH1*(1._r8/(2.303_r8*R*Tref)-1._r8/(2.303_r8*R*temp)) + co2logK2 = co2reflogK2+co2dH2*(1._r8/(2.303_r8*R*Tref)-1._r8/(2.303_r8*R*temp)) + rscal = 1._r8+10._r8**(co2logK1)*10._r8**(-pH)*(1._r8+10._r8**(co2logK2)*10._r8**(-pH))*1.e3_r8 + + elseif(tracer==betrtracer_vars%id_trc_nh3x)then + !NH3H2O <--> NH4(+) + OH(-) + rscal = 1._r8+10._r8**(nh3logK)*10._r8**(-pH) + + elseif(tracer==betrtracer_vars%id_trc_no3x)then + !HNO3 <--> NO3(-) + H(+) + rscal = 1._r8+10._r8**(no3logK)*10._r8**(-pH) + else + rscal = 1._r8 ! no rescal for other tracers + endif + return + end function get_equilibrium_scal +!------------------------------------------------------------------------------- + function get_henrycef(temp, trcid, betrtracer_vars)result(henry) + ! + ! !DESCRIPTION + !Compute the henry's law coefficient + !There are unconsidered isotopic effect on the henry's law constant. + !Some theoretical comments on such effect can be found in Jancso, 2002 + !REFERENCE: compilation of henry's law constants for inorganic and organic + ! species of potential importance in environmental chemistry, Rolf Sander + + !USES + use BeTRTracerType , only : betrtracer_type + implicit none + real(r8), intent(in) :: temp + integer, intent(in) :: trcid + type(betrtracer_type), intent(in) :: betrtracer_vars ! betr configuration information + + !local variable + real(r8) :: henry !unit[M/atm]=[mol_aq/dm3_aq]/[atm] + real(r8) :: es + character(len=255) :: subname ='get_henrycef' + + + if(trcid == betrtracer_vars%id_trc_ar)then + henry=1.4e-3_r8*exp(-1500._r8*(1._r8/temp-1._r8/298.15_r8)) + else if(trcid==betrtracer_vars%id_trc_o2)then + henry=1.3e-3_r8*exp(-1500._r8*(1._r8/temp-1._r8/298.15_r8)) + else if(trcid == betrtracer_vars%id_trc_nh3x)then + henry=5.6e1_r8*exp(-4100._r8*(1._r8/temp-1._r8/298.15_r8)) + else if(trcid==betrtracer_vars%id_trc_n2)then + henry=6.1e-4_r8*exp(-1300._r8*(1._r8/temp-1._r8/298.15_r8)) + else if(trcid==betrtracer_vars%id_trc_n2o)then + henry=2.5e-2_r8*exp(-2600._r8*(1._r8/temp-1._r8/298.15_r8)) + else if(trcid==betrtracer_vars%id_trc_no)then + henry=1.9e-3*exp(-1500._r8*(1._r8/temp-1._r8/298.15_r8)) + else if(trcid==betrtracer_vars%id_trc_co2x)then + henry=3.4e-2_r8*exp(-2400._r8*(1._r8/temp-1._r8/298.15_r8)) + else if(trcid==betrtracer_vars%id_trc_c13_co2x)then + henry=3.4e-2_r8*exp(-2400._r8*(1._r8/temp-1._r8/298.15_r8)) + else if(trcid==betrtracer_vars%id_trc_c14_co2x)then + henry=3.4e-2_r8*exp(-2400._r8*(1._r8/temp-1._r8/298.15_r8)) + else if(trcid==betrtracer_vars%id_trc_o17_co2x)then + henry=3.4e-2_r8*exp(-2400._r8*(1._r8/temp-1._r8/298.15_r8)) + else if(trcid==betrtracer_vars%id_trc_o18_co2x)then + henry=3.4e-2_r8*exp(-2400._r8*(1._r8/temp-1._r8/298.15_r8)) + else if(trcid==betrtracer_vars%id_trc_air_co2x)then + henry=3.4e-2_r8*exp(-2400._r8*(1._r8/temp-1._r8/298.15_r8)) + else if(trcid==betrtracer_vars%id_trc_arrt_co2x)then + henry=3.4e-2_r8*exp(-2400._r8*(1._r8/temp-1._r8/298.15_r8)) + else if(trcid==betrtracer_vars%id_trc_hrsoi_co2x)then + henry=3.4e-2_r8*exp(-2400._r8*(1._r8/temp-1._r8/298.15_r8)) + else if(trcid == betrtracer_vars%id_trc_ch4)then + henry=1.3e-3_r8*exp(-1700._r8*(1._r8/temp-1._r8/298.15_r8)) !mol dm^-3 amt^-1 + endif + return + end function get_henrycef +!------------------------------------------------------------------------------- + + subroutine calc_rhovap(bounds, lbj, ubj, jtops, num_soilc, filter_soilc, t_soisno, smp_l, rho_vap) + ! + !DESCRIPTION + !Compute actual vapor pressure inside the soil profile + ! + ! uses + use clm_varcon , only : rwat, grav + use QSatMod , only : rhoSat + + implicit none + !arguments + type(bounds_type), intent(in) :: bounds ! bounds + integer, intent(in) :: lbj, ubj ! lower and upper bounds, make sure they are > 0 + integer, intent(in) :: jtops(bounds%begc: ) ! top label of each column + integer, intent(in) :: num_soilc ! number of soil filters + integer, intent(in) :: filter_soilc(:) ! filter + real(r8), intent(in) :: t_soisno(bounds%begc: , lbj: ) !soil temperature, K + real(r8), intent(in) :: smp_l(bounds%begc: , lbj: ) !liquid soil matric potential, mm + real(r8), intent(inout):: rho_vap(bounds%begc: , lbj: ) !actual vapor pressure, kg/m3 + + !local variables + real(r8) :: hh !relative humidity + real(r8) :: rho_sat !saturated water vapor pressure + integer :: c, fc, n + character(len=255) :: subname ='calc_rhovap' + + SHR_ASSERT_ALL((ubound(jtops) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(t_soisno) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(smp_l) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(rho_vap) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) + + + !be careful below, because snow and pure water has no definition of water matrix potential + do n = lbj, ubj + do fc = 1, num_soilc + c = filter_soilc(fc) + if(n>=jtops(c))then + !calculate saturated vapor pressure + if(n>=1)then + hh = exp(smp_l(c,n)*1.e-3_r8*grav/(rwat*t_soisno(c,n))) !relative humidity using Kelvin equation + else + hh = 1._r8 !just in case it is snow layer + endif + call rhoSat(t_soisno(c,n), rho_sat) + !I use max to avoid completely dry soil + rho_vap(c,n) = rho_sat * max(hh,1.e-4_r8) !kg/m3 + endif + enddo + enddo + end subroutine calc_rhovap + +!------------------------------------------------------------------------------- + function get_taugas(eff_por, airvol, bsw)result(taugas) + ! + !Descriptions + !compute the tortuosity for the gas diffusion + !Reference: + !Millington and Quirk, 1961; Maggi et al., 2008 + !Moldrup et al, 2003 + ! + ! USES + ! + + implicit none + real(r8), intent(in) :: eff_por ! effective porosity + real(r8), intent(in) :: airvol ! air filled volume + real(r8), optional, intent(in) :: bsw ! clapp-hornber shape parameter + + real(r8) :: taugas + character(len=255) :: subname ='get_taugas' + + if(eff_por == 0._r8)then + taugas = 0._r8 + else + if(present(bsw))then + !modified from Eq.(5) in Moldrup et al., 2003 + taugas = (airvol/eff_por)**(3._r8/bsw)*airvol + else + taugas= eff_por**(1._r8/3._r8)*(airvol/eff_por)**(7._r8/3._r8) + endif + endif + end function get_taugas +!------------------------------------------------------------------------------- + function get_tauliq(eff_por, liqvol, bsw)result(tauliq) + ! + !DESCRIPTION: + !compute tortuosity for solute diffusion + !Reference: + !Millington and Quirk, 1961; Maggi et al., 2008 + !Moldrup et al, 2003 + ! + ! USES + ! + + implicit none + real(r8), intent(in) :: eff_por !effective porosity + real(r8), intent(in) :: liqvol !liquid water filled volume + real(r8), optional, intent(in) :: bsw !clapp-hornberg shape parameter + + real(r8) :: tauliq + character(len=255) :: subname ='get_tauliq' + + + if(eff_por == 0._r8)then + tauliq = 0._r8 + else + if(present(bsw))then + !Modified from Eq.(3) in Moldrup et al., 2003. + tauliq=(min(liqvol/eff_por,1._r8))**(bsw/3._r8-1._r8)*liqvol + else + tauliq=eff_por**(1._r8/3._r8)*(min(liqvol/eff_por,1._r8))**(7._r8/3._r8) + endif + endif + end function get_tauliq +!------------------------------------------------------------------------------- + + function get_gas_diffusivity(trcid, temp, betrtracer_vars)result(diff) + ! + ! !DESCRIPTIONS + ! + !compute gaseous diffusivity for volatile species + ! + ! USES + ! + use BeTRTracerType , only : betrtracer_type + implicit none + integer, intent(in) :: trcid + real(r8), intent(in) :: temp !kelvin + type(betrtracer_type), intent(in) :: betrtracer_vars ! betr configuration information + + !local variable + real(r8) :: diff + character(len=255) :: subname = 'get_gas_diffusivity' + + if(trcid==betrtracer_vars%id_trc_n2)then + diff=1.93e-5_r8*(temp/273.0_r8)**1.82_r8 + elseif(trcid==betrtracer_vars%id_trc_ar)then + diff=1.61e-5_r8*(temp/273.0_r8)**1.82_r8 + elseif(trcid==betrtracer_vars%id_trc_o2)then + diff=1.8e-5_r8*(temp/273.0_r8)**1.82_r8 + elseif(trcid==betrtracer_vars%id_trc_co2x)then + diff=1.47e-5_r8*(temp/273.15_r8)**1.82_r8 + elseif(trcid==betrtracer_vars%id_trc_air_co2x)then + diff=1.47e-5_r8*(temp/273.15_r8)**1.82_r8 + elseif(trcid==betrtracer_vars%id_trc_arrt_co2x)then + diff=1.47e-5_r8*(temp/273.15_r8)**1.82_r8 + elseif(trcid==betrtracer_vars%id_trc_hrsoi_co2x)then + diff=1.47e-5_r8*(temp/273.15_r8)**1.82_r8 + elseif(trcid==betrtracer_vars%id_trc_ch4)then + diff=1.9e-5_r8*(temp/298.0_r8)**1.82_r8 + elseif(trcid==betrtracer_vars%id_trc_nh3x)then + diff=0.211e-4_r8*(temp/273.15_r8)**1.75_r8 + elseif(trcid==betrtracer_vars%id_trc_no)then + diff=0.199e-4_r8*(temp/293.15)**1.5_r8 + elseif(trcid==betrtracer_vars%id_trc_n2o)then + diff=0.159e-4_r8*(temp/293.15)**1.5_r8 +!isotopes + !use the kinetic theory of gases, assuming the collison diameters are same + !between the light and heavy isotopmer, assuming the bath gas is dry air + elseif(trcid==betrtracer_vars%id_trc_o18_h2o)then + diff = 0.9723_r8*0.226e-4_r8*(temp/273.15_r8)**1.75_r8 !from Merlivat, 1978 + elseif(trcid==betrtracer_vars%id_trc_d_h2o)then + diff = 0.9755_r8*0.226e-4_r8*(temp/273.15_r8)**1.75_r8 !from Merlivat, 1978 + elseif(trcid==betrtracer_vars%id_trc_c13_co2x)then + diff = 0.9958_r8*1.47e-5_r8*(temp/273.15_r8)**1.82_r8 ! from Trudinger, 1997 + elseif(trcid==betrtracer_vars%id_trc_o18_co2x)then + diff = 0.9913_r8*1.47e-5_r8*(temp/273.15_r8)**1.82_r8 !e.g. Wingate et al., 2009 + elseif(trcid==betrtracer_vars%id_trc_c14_co2x)then + diff = 0.9918_r8*1.47e-5_r8*(temp/273.15_r8)**1.82_r8 ! from Trudinger, 1997 + elseif(trcid==betrtracer_vars%id_trc_o17_co2x)then + diff = 0.9957_r8*1.47e-5_r8*(temp/273.15_r8)**1.82_r8 + endif + return + end function get_gas_diffusivity +!------------------------------------------------------------------------------- + + function get_aqueous_diffusivity(trcid, temp, betrtracer_vars, is_dom)result(diff) + ! + ! Descriptions: + ! Compute aqueous diffusivity for volatile species + ! + ! USES + ! + use BeTRTracerType , only : betrtracer_type + implicit none + integer, intent(in) :: trcid + real(r8), intent(in) :: temp + type(betrtracer_type), intent(in) :: betrtracer_vars ! betr configuration information + logical, optional, intent(in) :: is_dom + + !local variable + real(r8) :: diff ! m2/s + character(len=255) :: subname ='get_aqueous_diffusivity' + + if(present(is_dom))then + if(is_dom)then + diff=2.6e-9_r8 + return + endif + endif + if(trcid==betrtracer_vars%id_trc_n2)then + diff=2.57e-9_r8*(temp/273.0_r8) + elseif(trcid==betrtracer_vars%id_trc_o2)then + diff=2.4e-9_r8*temp/298.0_r8 + elseif(trcid==betrtracer_vars%id_trc_ar)then + diff=2.15e-9_r8*temp/298.0_r8 + elseif(trcid==betrtracer_vars%id_trc_co2x)then + diff=1.81e-6_r8*exp(-2032.6/temp) + elseif(trcid==betrtracer_vars%id_trc_air_co2x)then + diff=1.81e-6_r8*exp(-2032.6/temp) + elseif(trcid==betrtracer_vars%id_trc_arrt_co2x)then + diff=1.81e-6_r8*exp(-2032.6/temp) + elseif(trcid==betrtracer_vars%id_trc_hrsoi_co2x)then + diff=1.81e-6_r8*exp(-2032.6/temp) + elseif(trcid==betrtracer_vars%id_trc_ch4)then + diff=1.5e-9_r8*temp/298.0_r8 + elseif(trcid==betrtracer_vars%id_trc_no3x)then + diff=2.6e-9_r8*temp/298.15_r8 + elseif(trcid==betrtracer_vars%id_trc_no2x)then + diff=2.6e-9_r8*temp/298.15_r8 !considers revision + elseif(trcid==betrtracer_vars%id_trc_nh3x)then + diff=1.64e-5_r8*temp/298.15_r8 + +!isotopes + elseif(trcid==betrtracer_vars%id_trc_d_h2o)then + diff=0.9833_r8*1e-9_r8*exp(-(535400._r8/temp-1393.3_r8)/temp+2.1876_r8) + elseif(trcid==betrtracer_vars%id_trc_o18_h2o)then + diff=0.9669_r8*1e-9_r8*exp(-(535400._r8/temp-1393.3_r8)/temp+2.1876_r8) + elseif(trcid==betrtracer_vars%id_trc_o18_co2x)then + !theoretical calculations based on molecular dynamics indicate the fractionation between carbonate and bicarbonate due to diffusion is less than 1 per mil. + !so set it to the diffusivity of the base value + diff=1.81e-6_r8*exp(-2032.6/temp) + elseif(trcid==betrtracer_vars%id_trc_c13_co2x)then + diff=1.81e-6_r8*exp(-2032.6/temp) + elseif(trcid==betrtracer_vars%id_trc_c14_co2x)then + diff=1.81e-6_r8*exp(-2032.6/temp) + else + diff=2.6e-9_r8 + endif + + end function get_aqueous_diffusivity + + +!------------------------------------------------------------------------------- + function get_diffusivity_ratio_gas2h2o(trcid, temp, betrtracer_vars)result(ratio) + ! + ! DESCRIPTIONS: + ! Compute the ratio of gas phase diffusivities for different volatile species in air with respect to that of water vapor + ! + ! USES + ! + use BeTRTracerType , only : betrtracer_type + implicit none + integer, intent(in) :: trcid + real(r8), intent(in) :: temp + type(betrtracer_type), intent(in) :: betrtracer_vars ! betr configuration information + + real(r8) :: diff, ratio, diffh2o + character(len=255) :: subname = 'get_diffusivity_ratio_gas2h2o' + + + diffh2o=0.229e-4_r8*(temp/273.15_r8)**1.75_r8 + + if(trcid==betrtracer_vars%id_trc_n2)then + ratio=1.93e-5_r8*(temp/273.0_r8)**1.82_r8/diffh2o + elseif(trcid==betrtracer_vars%id_trc_o2)then + ratio=1.8e-5_r8*(temp/273.0_r8)**1.82_r8/diffh2o + elseif(trcid==betrtracer_vars%id_trc_ar)then + ratio=1.6e-5_r8*(temp/273.0_r8)**1.82_r8/diffh2o + elseif(trcid==betrtracer_vars%id_trc_co2x)then + ratio=1.47e-5_r8*(temp/273.15_r8)**1.82_r8/diffh2o + elseif(trcid==betrtracer_vars%id_trc_air_co2x)then + ratio=1.47e-5_r8*(temp/273.15_r8)**1.82_r8/diffh2o + elseif(trcid==betrtracer_vars%id_trc_arrt_co2x)then + ratio=1.47e-5_r8*(temp/273.15_r8)**1.82_r8/diffh2o + elseif(trcid==betrtracer_vars%id_trc_hrsoi_co2x)then + ratio=1.47e-5_r8*(temp/273.15_r8)**1.82_r8/diffh2o + elseif(trcid==betrtracer_vars%id_trc_ch4)then + ratio=1.9e-5_r8*(temp/298.0_r8)**1.82_r8/diffh2o + elseif(trcid==betrtracer_vars%id_trc_nh3x)then + ratio=0.211e-4_r8*(temp/273.15_r8)**1.75_r8/diffh2o + elseif(trcid==betrtracer_vars%id_trc_no)then + ratio=0.199e-4_r8*(temp/293.15)**1.5_r8/diffh2o + elseif(trcid==betrtracer_vars%id_trc_n2o)then + ratio=0.159e-4_r8*(temp/293.15)**1.5_r8/diffh2o + +!isotopes + elseif(trcid==betrtracer_vars%id_trc_o18_h2o)then + ratio = 0.9723_r8 !from Merlivat, 1978 + elseif(trcid==betrtracer_vars%id_trc_d_h2o)then + ratio = 0.9755_r8 !from Merlivat, 1978 + elseif(trcid==betrtracer_vars%id_trc_c13_co2x)then + ratio = 0.9957_r8*1.47e-5_r8*(temp/273.15_r8)**1.82_r8/diffh2o + elseif(trcid==betrtracer_vars%id_trc_c14_co2x)then + ratio = 0.9913_r8*1.47e-5_r8*(temp/273.15_r8)**1.82_r8/diffh2o + elseif(trcid==betrtracer_vars%id_trc_o18_co2x)then + ratio = 0.9913_r8*1.47e-5_r8*(temp/273.15_r8)**1.82_r8/diffh2o + elseif(trcid==betrtracer_vars%id_trc_o17_co2x)then + ratio = 0.9957_r8*1.47e-5_r8*(temp/273.15_r8)**1.82_r8/diffh2o + endif + return + end function get_diffusivity_ratio_gas2h2o + +!------------------------------------------------------------------------------- + subroutine convert_mobile2gas(bounds, lbj, ubj, jtops, numf, filter, do_forward, gas2bulkcef_mobile_col, betrtracer_vars, tracer_conc_mobile) + ! + ! DESCRIPTIONS + ! do conversion between bulk mobile phase and gaseous phase + ! + ! USES + ! + use BeTRTracerType , only : betrtracer_type + implicit none + !arguments + type(bounds_type), intent(in) :: bounds ! bounds + integer, intent(in) :: lbj, ubj ! lower and upper bounds + integer, intent(in) :: jtops(bounds%begc: ) ! top label of each column + integer, intent(in) :: numf ! number of filters + integer, intent(in) :: filter(:) ! filter + logical, intent(in) :: do_forward ! true, dual_bulk => gaseous + type(betrtracer_type), intent(in) :: betrtracer_vars ! betr configuration information + real(r8), intent(in) :: gas2bulkcef_mobile_col(bounds%begc: ,lbj: , 1: ) !conversion parameter + real(r8), intent(inout):: tracer_conc_mobile(bounds%begc: ,lbj: , 1: ) !bulk mobile tracer + + !local variables + integer :: jj, kk, fc, c, j + character(len=255) :: subname = 'convert_mobile2gas' + + SHR_ASSERT_ALL((ubound(jtops) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(gas2bulkcef_mobile_col) == (/bounds%endc, ubj, betrtracer_vars%nvolatile_tracers/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(tracer_conc_mobile) == (/bounds%endc, ubj, betrtracer_vars%nvolatile_tracers/)), errMsg(__FILE__,__LINE__)) + + + associate( & + ngwmobile_tracers => betrtracer_vars%ngwmobile_tracers , & !Integer[intent(in)], number of tracers + is_volatile => betrtracer_vars%is_volatile , & !logical[intent(in)], is a volatile tracer? + volatilegroupid => betrtracer_vars%volatilegroupid & !integer[intent(in)], location in the volatile vector + ) + + do jj = 1, ngwmobile_tracers + if(is_volatile(jj))then + kk = volatilegroupid(jj) + if(do_forward)then + do j = lbj, ubj + do fc = 1, numf + c = filter(fc) + if(j>=jtops(c))then + tracer_conc_mobile(c,j,jj) = tracer_conc_mobile(c,j,jj) / gas2bulkcef_mobile_col(c,j,kk) + endif + enddo + enddo + else + do j = lbj, ubj + do fc = 1, numf + c = filter(fc) + if(j>=jtops(c))then + tracer_conc_mobile(c,j,jj) = tracer_conc_mobile(c,j,jj) * gas2bulkcef_mobile_col(c,j,kk) + endif + enddo + enddo + endif + endif + enddo + end associate + end subroutine convert_mobile2gas +!------------------------------------------------------------------------------- + + subroutine set_multi_phase_diffusion(bounds, lbj, ubj, jtops, numf, filter, soilstate_vars, waterstate_vars, & + canopystate_vars, temperature_vars, chemstate_vars, betrtracer_vars, tracercoeff_vars) + ! + ! DESCRIPTION + ! set parameters for the dual phase diffusion + ! + use TracerCoeffType , only : tracercoeff_type + use WaterStateType , only : Waterstate_Type + use SoilStateType , only : soilstate_type + use TemperatureType , only : temperature_type + use ChemStateType , only : chemstate_type + use BeTRTracerType , only : betrtracer_type + use CanopyStateType , only : canopystate_type + + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: lbj, ubj ! lower and upper bounds, make sure they are > 0 + integer , intent(in) :: jtops(bounds%begc: ) ! top label of each column + integer , intent(in) :: numf ! number of columns in column filter + integer , intent(in) :: filter(:) ! column filter + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(Waterstate_Type) , intent(in) :: waterstate_vars ! water state variables + type(soilstate_type) , intent(in) :: soilstate_vars ! physical state variables + type(temperature_type) , intent(in) :: temperature_vars ! energy state variable + type(canopystate_type) , intent(in) :: canopystate_vars + type(chemstate_type) , intent(in) :: chemstate_vars ! chemistry state variable + type(tracercoeff_type) , intent(inout) :: tracercoeff_vars ! structure containing tracer transport parameters + + ! + real(r8) :: bulkdiffus(bounds%begc:bounds%endc,lbj:ubj,1:betrtracer_vars%ntracer_groups ) !weighted bulk diffusivity for dual-phase diffusion + + !maybe I should use tau_soil as a local variable, I will check this later + character(len=255) :: subname='set_multi_phase_diffusion' + + + SHR_ASSERT_ALL((ubound(jtops) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + + !compute tortuosity + !gaseous phase + call calc_gaseous_diffusion_soil_tortuosity(bounds, lbj, ubj, jtops, numf, filter, soilstate_vars, waterstate_vars, tau_soil%tau_gas) + + !aqueous phase + call calc_aqueous_diffusion_soil_tortuosity(bounds, lbj, ubj, jtops, numf, filter, soilstate_vars, waterstate_vars, tau_soil%tau_liq) + + !compute bulk diffusivity + call calc_bulk_diffusivity(bounds, lbj, ubj, jtops, numf, filter , & + tracercoeff_vars%bunsencef_col(bounds%begc:bounds%endc,lbj:ubj, : ) , & + canopystate_vars, waterstate_vars, tau_soil, betrtracer_vars , & + temperature_vars%t_soisno_col(bounds%begc:bounds%endc, lbj:ubj), bulkdiffus) + + !compute weigthed conductances + call calc_bulk_conductances(bounds, lbj, ubj, jtops, numf, filter, bulkdiffus, & + col%dz(bounds%begc:bounds%endc,lbj:ubj), betrtracer_vars, & + tracercoeff_vars%hmconductance_col(bounds%begc:bounds%endc, lbj:ubj-1, :)) + + end subroutine set_multi_phase_diffusion + + +!-------------------------------------------------------------------------------- + subroutine set_phase_convert_coeff(bounds, lbj, ubj, jtops, numf, filter, dz, soilstate_vars, waterstate_vars, & + temperature_vars, chemstate_vars, betrtracer_vars, tracercoeff_vars) + ! + ! DESCRIPTION + ! set parameters for phase conversion + use TracerCoeffType , only : tracercoeff_type + use WaterStateType , only : Waterstate_Type + use SoilStateType , only : soilstate_type + use TemperatureType , only : temperature_type + use ChemStateType , only : chemstate_type + use BeTRTracerType , only : betrtracer_type + implicit none + type(bounds_type), intent(in) :: bounds ! bounds + integer, intent(in) :: lbj, ubj ! lower and upper bounds, make sure they are > 0 + integer, intent(in) :: jtops(bounds%begc:bounds%endc) ! top label of each column + integer, intent(in) :: numf ! number of columns in column filter + integer, intent(in) :: filter(:) ! column filter + real(r8), intent(in) :: dz(bounds%begc: ,lbj: ) + type(betrtracer_type), intent(in) :: betrtracer_vars ! betr configuration information + type(Waterstate_Type), intent(in) :: waterstate_vars ! water state variables + type(soilstate_type), intent(in) :: soilstate_vars ! physical state variables + type(temperature_type), intent(in) :: temperature_vars ! energy state variable + type(chemstate_type), intent(in) :: chemstate_vars ! chemical state variable + type(tracercoeff_type), intent(inout) :: tracercoeff_vars ! structure containing tracer transport parameters + character(len=255) :: subname = 'set_phase_convert_coeff' + + SHR_ASSERT_ALL((ubound(jtops) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(dz) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) + + !compute Henry's law constant + call calc_henrys_coeff(bounds, lbj, ubj, jtops, numf, filter , & + temperature_vars%t_soisno_col(bounds%begc:bounds%endc,lbj:ubj) , & + chemstate_vars%soil_pH(bounds%begc:bounds%endc, lbj:ubj), betrtracer_vars , & + tracercoeff_vars%aqu2neutralcef_col(bounds%begc:bounds%endc,lbj:ubj, : ) , & + tracercoeff_vars%henrycef_col(bounds%begc:bounds%endc, lbj:ubj, : )) + + !compute Bunsen's coefficients + call calc_bunsen_coeff(bounds, lbj, ubj, jtops, numf, filter , & + tracercoeff_vars%henrycef_col(bounds%begc:bounds%endc, lbj:ubj, : ) , & + temperature_vars%t_soisno_col(bounds%begc:bounds%endc, lbj:ubj) , & + waterstate_vars%smp_l_col (bounds%begc:bounds%endc, lbj:ubj) , & + betrtracer_vars , & + tracercoeff_vars%bunsencef_col(bounds%begc:bounds%endc, lbj:ubj, :)) + + !compute equilibrium fraction to liquid phase conversion parameter + if(betrtracer_vars%nsolid_equil_tracers>0)then + call calc_equil_to_liquid_convert_coeff(bounds, lbj, ubj, jtops, numf, filter , & + temperature_vars%t_soisno_col(bounds%begc:bounds%endc, lbj:ubj) , & + waterstate_vars%h2osoi_ice_col(bounds%begc:bounds%endc,lbj:ubj) , & + dz(bounds%begc:bounds%endc, lbj:ubj) , & + betrtracer_vars, tracercoeff_vars%aqu2equilsolidcef_col(bounds%begc:bounds%endc, lbj:ubj,:)) + endif + + !compute phase conversion coefficients + call calc_dual_phase_convert_coeff(bounds, lbj, ubj, jtops, numf, filter, waterstate_vars, betrtracer_vars, tracercoeff_vars) + + + end subroutine set_phase_convert_coeff + + + + !------------------------------------------------------------------------ + subroutine calc_tracer_infiltration(bounds, lbj, ubj, jtops, numf, filter, bunsencef_topsoi, & + betrtracer_vars, tracerboundarycond_vars, waterflux_vars, tracer_flx_infl) + ! + ! DESCRIPTION + ! calculate advection velocity for BeTR code + ! this assumes the interfacial velocity qflx_adv (except infiltration) has been calcualted in doing vertical + ! watermovement + ! This assumes the advection solves the equation + ! \frac{\parital m}{\partial t}+\frac{V*m}{\partial z} = 0 + !where m = C*vsm, therefore, V=ql/vsm + ! + use WaterfluxType , only : waterflux_type + use TracerBoundaryCondType, only : tracerboundarycond_type + use BeTRTracerType , only : betrtracer_type + use clm_varcon , only : denh2o + implicit none + + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: lbj, ubj + integer , intent(in) :: jtops(bounds%begc: ) ! top label of each column + integer , intent(in) :: numf ! number of columns in column filter + integer , intent(in) :: filter(:) ! column filter + real(r8) , intent(in) :: bunsencef_topsoi(bounds%begc: , 1: ) + type(BeTRTracer_Type) , intent(in) :: betrtracer_vars + type(tracerboundarycond_type), intent(in) :: tracerboundarycond_vars + type(waterflux_type) , intent(inout) :: waterflux_vars + real(r8) , intent(inout) :: tracer_flx_infl(bounds%begc: , 1: ) + + ! local variables + integer :: fc, c, j + + associate( & + qflx_gross_infl_soil => waterflux_vars%qflx_gross_infl_soil_col & !real(r8) (:) [intent(in)], infiltration, mm/s + ) + + SHR_ASSERT_ALL((ubound(jtops) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(bunsencef_topsoi) == (/bounds%endc, betrtracer_vars%nvolatile_tracers/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(tracer_flx_infl) == (/bounds%endc, betrtracer_vars%ngwmobile_tracers/)), errMsg(__FILE__,__LINE__)) + + do j = 1, betrtracer_vars%ngwmobile_tracers + + !for a real mechanistic modeling, tracer_flx_infl should be derived from water flux coming from snow melt, surface ponding water, + !and precipitation. I here just comparomise for a quick shot. + + if(j==betrtracer_vars%id_trc_o18_h2o)then + do fc = 1, numf + c = filter(fc) + tracer_flx_infl(c,j) = qflx_gross_infl_soil(c)/denh2o !kg m-2 s-1/ kg m-3 = m/s + enddo + else + do fc = 1, numf + c = filter(fc) + + if(betrtracer_vars%is_volatile(j) .and. betrtracer_vars%is_advective(j))then + !for volatile non water tracer, infiltration is calculated based dissolution of the gas in the water, this may need + !improvement when tracers are allowed to transport inside snow, such that the tracer infiltration is derived from mass balance in snow + tracer_flx_infl(c,j) = bunsencef_topsoi(c,betrtracer_vars%volatilegroupid(j)) * tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1,j) * qflx_gross_infl_soil(c)*1.e-3_r8 + else + tracer_flx_infl(c,j) = 0._r8 + endif + enddo + endif + enddo + end associate + end subroutine calc_tracer_infiltration + !------------------------------------------------------------------------ + subroutine pre_diagnose_soilcol_water_flux(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, filter_urbanc, h2osoi_liq) + ! + ! DESCRIPTION + ! pre diagnose advective water fluxes at different soil interfaces + + + implicit none + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_hydrologyc ! number of column soil points in column filter + integer , intent(in) :: filter_hydrologyc(:) ! column filter for soil points + integer , intent(in) :: num_urbanc ! number of column urban points in column filter + integer , intent(in) :: filter_urbanc(:) ! column filter for urban points + real(r8) , intent(in) :: h2osoi_liq(bounds%begc: , 1: ) + + !local variables + integer :: j, fc, c + SHR_ASSERT_ALL((ubound(h2osoi_liq) == (/bounds%endc, nlevsoi/)), errMsg(__FILE__,__LINE__)) + + allocate(h2osoi_liq_copy(bounds%begc:bounds%endc, 1:nlevsoi)); h2osoi_liq_copy(:, :) = spval + do j = 1, nlevsoi + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + h2osoi_liq_copy(c,j) = h2osoi_liq(c,j) + enddo + enddo + end subroutine pre_diagnose_soilcol_water_flux + + !------------------------------------------------------------------------ + subroutine diagnose_advect_water_flux(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, filter_urbanc, h2osoi_liq, qcharge, waterflux_vars) + ! + ! DESCRIPTION + ! diagnose advective water fluxes between different soil layers + ! + + use WaterFluxType , only : waterflux_type + use clm_time_manager , only : get_step_size + use clm_varcon , only : denh2o + implicit none + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_hydrologyc ! number of column soil points in column filter + integer , intent(in) :: filter_hydrologyc(:) ! column filter for soil points + integer , intent(in) :: num_urbanc ! number of column urban points in column filter + integer , intent(in) :: filter_urbanc(:) ! column filter for urban points + type(waterflux_type) , intent(inout) :: waterflux_vars + real(r8) , intent(in) :: h2osoi_liq(bounds%begc: , 1: ) !mm H2O/m2 eqv. kg H2O/m2 + real(r8) , intent(in) :: qcharge(bounds%begc: ) ! mm H2O/s aquifer recharge rate + + !local variables + integer :: j, fc, c + real(r8):: dtime + real(r8):: diff + real(r8):: infl_tmp + real(r8):: scal + + SHR_ASSERT_ALL((ubound(h2osoi_liq) == (/bounds%endc, nlevsoi/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(qcharge) == (/bounds%endc/)) , errMsg(__FILE__,__LINE__)) + + + associate( & ! + qflx_rootsoi => waterflux_vars%qflx_rootsoi_col , & ! Iput : [real(r8) (:,:) ] vegetation/soil water exchange (m H2O/s) (+ = to atm) + qflx_adv => waterflux_vars%qflx_adv_col , & ! Output: [real(r8) (:,:) ] water flux at interfaces (m H2O/s) (- = to atm) + qflx_gross_infl_soil=> waterflux_vars%qflx_gross_infl_soil_col , & ! Output: [real(r8) (:)] gross infiltration (mm H2O/s) + qflx_infl => waterflux_vars%qflx_infl_col , & ! Output: [real(r8) (:)] infiltration + qflx_gross_evap_soil=> waterflux_vars%qflx_gross_evap_soil_col & ! Output: [real(r8) (:)] gross evaporation (mm H2O/s) + ) + + ! get time step + dtime = get_step_size() + !start from the bottom layer, because the water exchange between vadose zone soil and aquifer and plant root is known + !the water flux at uppper surface can be inferred using the mass balance approach + do j = nlevsoi, 1, -1 + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + if(j==nlevsoi)then + qflx_adv(c,j) = qcharge(c) * 1.e-3_r8 + else + qflx_adv(c,j) = 1.e-3_r8 * (h2osoi_liq(c,j+1)-h2osoi_liq_copy(c,j+1))/dtime + qflx_adv(c,j+1) + qflx_rootsoi(c,j+1) + endif + + enddo + enddo + + ! correct gross infiltration and gross evaporation + ! (h2osoi_liq(c,1)-h2osoi_liq_copy(c,1))/dtime=qflx_infl-q_out-qflx_rootsoi + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + + !obtain the corrected infiltration + qflx_infl(c) = (h2osoi_liq(c,1)-h2osoi_liq_copy(c,1))/dtime + (qflx_rootsoi(c,1)+qflx_adv(c,1))*1.e3_r8 + !the predicted net infiltration + infl_tmp=qflx_gross_infl_soil(c)-qflx_gross_evap_soil(c) + diff=qflx_infl(c)-infl_tmp + if(abs(diff)/=0._r8)then + if(infl_tmp==0._r8)then + if(diff>0._r8)then + qflx_gross_infl_soil(c)=diff + qflx_gross_evap_soil(c)=0._r8 + else + qflx_gross_infl_soil(c)=0._r8 + qflx_gross_evap_soil(c)=-diff + endif + else + scal = (1._r8+diff/infl_tmp) + qflx_gross_infl_soil(c) = qflx_gross_infl_soil(c) * scal + qflx_gross_evap_soil(c) = qflx_gross_evap_soil(c) * scal + if(qflx_gross_evap_soil(c)<0._r8)then + !no negative evaporation allowed + qflx_gross_infl_soil(c) = qflx_gross_infl_soil(c)-qflx_gross_evap_soil(c) + qflx_gross_evap_soil(c) = 0._r8 + endif + if(qflx_gross_infl_soil(c)<0._r8)then + qflx_gross_evap_soil(c) = qflx_gross_evap_soil(c)-qflx_gross_infl_soil(c) + qflx_gross_infl_soil(c) = 0._r8 + endif + endif + endif + + qflx_adv(c,0) = qflx_gross_infl_soil(c) *.1e-3_r8 !surface infiltration + + enddo + + deallocate(h2osoi_liq_copy) + end associate + end subroutine diagnose_advect_water_flux + + + !------------------------------------------------------------------------ + subroutine diagnose_drainage_water_flux(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, filter_urbanc, h2osoi_liq, waterflux_vars) + ! + ! DESCRIPTION + ! diagnose advective water fluxes between different soil layers + ! + + use WaterFluxType , only : waterflux_type + use clm_varcon , only : denh2o + use clm_time_manager , only : get_step_size + implicit none + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_hydrologyc ! number of column soil points in column filter + integer , intent(in) :: filter_hydrologyc(:) ! column filter for soil points + integer , intent(in) :: num_urbanc ! number of column urban points in column filter + integer , intent(in) :: filter_urbanc(:) ! column filter for urban points + type(waterflux_type) , intent(inout) :: waterflux_vars + real(r8) , intent(in) :: h2osoi_liq(bounds%begc: , 1: ) !mm H2O/m2 eqv. kg H2O/m2 + + !local variables + integer :: j, fc, c + real(r8):: dtime + + SHR_ASSERT_ALL((ubound(h2osoi_liq) == (/bounds%endc, nlevsoi/)), errMsg(__FILE__,__LINE__)) + + + associate( & ! + qflx_drain_vr => waterflux_vars%qflx_drain_vr_col & ! Output : [real(r8) (:,:) ] vegetation/soil water exchange (mm H2O/step) (to river +) + ) + + ! get time step + dtime = get_step_size() + !start from the bottom layer, because the water exchange between vadose zone soil and aquifer and plant root is known + !the water flux at uppper surface can be inferred using the mass balance approach + do j = nlevsoi, 1, -1 + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + qflx_drain_vr(c,j) = h2osoi_liq_copy(c,j)-h2osoi_liq(c,j) + + qflx_drain_vr(c,j) = min(qflx_drain_vr(c,j),h2osoi_liq_copy(c,j))/denh2o + + enddo + enddo + + deallocate(h2osoi_liq_copy) + end associate + end subroutine diagnose_drainage_water_flux + + !------------------------------------------------------------------------ + function get_equi_lv_h2oiso_fractionation(trcid, temp, betrtracer_vars)result(ans) + ! + ! DESCRIPTION + ! get equilibrium isotopic fractionation of liquid against gaseous phase + ! + ! + use BeTRTracerType , only : betrtracer_type + implicit none + integer , intent(in) :: trcid + real(r8) , intent(in) :: temp !temperature + type(betrtracer_type) , intent(in) :: betrtracer_vars + + real(r8) :: ans + + + + !now it is set to one, for O18 and H/D, pleasure refer to Braud et al. (2005, J. Hydrology) + ans = 1._r8 + return + end function get_equi_lv_h2oiso_fractionation + + !------------------------------------------------------------------------ + function get_equi_sv_h2oiso_fractionation(trcid, temp, betrtracer_vars)result(ans) + ! + ! DESCRIPTION + ! get equilibrium isotopic fractionation of ice against vapor phase + ! + ! + use BeTRTracerType , only : betrtracer_type + implicit none + integer , intent(in) :: trcid + real(r8) , intent(in) :: temp !temperature + type(betrtracer_type) , intent(in) :: betrtracer_vars + + real(r8) :: ans + + + + !now it is set to one, for O18, Roche (2013, GMD) gives some information + ans = 1._r8 + return + end function get_equi_sv_h2oiso_fractionation + + + !------------------------------------------------------------------------ + function get_equi_sl_h2oiso_fractionation(trcid, temp, betrtracer_vars)result(ans) + ! + ! DESCRIPTION + ! get equilibrium isotopic fractionation of ice against liquid water + ! + ! + use BeTRTracerType , only : betrtracer_type + implicit none + integer , intent(in) :: trcid + real(r8) , intent(in) :: temp !temperature + type(betrtracer_type) , intent(in) :: betrtracer_vars + + real(r8) :: ans + + + + !now it is set to one, it is equal to alpha_sv*alpha_vl + ans = 1._r8 + return + end function get_equi_sl_h2oiso_fractionation + + + !------------------------------------------------------------------------ + subroutine calc_equil_to_liquid_convert_coeff(bounds, lbj, ubj, jtops, numf, filter, t_soisno, h2osoi_ice, dz, & + betrtracer_vars, aqu2equilsolidcef_col) + ! + ! DESCRIPTION + ! calculate partition parameter between solid and aqueous phase tracers + ! this could mean differnt things for different cases + ! for water isotopes, this represents ice/liquid equilibrium partitioning, it could also + ! mean linear isotherms of adsorption/desorption. Currently, it is only + ! for water isotope partitioning between liquid water and ice + ! + use clm_varcon , only : denh2o, denice + use BeTRTracerType , only : betrtracer_type + implicit none + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: lbj, ubj ! lower and upper bounds, make sure they are > 0 + integer , intent(in) :: jtops(bounds%begc: ) ! top label of each column + integer , intent(in) :: numf ! number of columns in column filter + integer , intent(in) :: filter(:) ! column filter + real(r8) , intent(in) :: t_soisno(bounds%begc: , lbj: ) + type(betrtracer_type) , intent(in) :: betrtracer_vars + real(r8) , intent(in) :: h2osoi_ice(bounds%begc: , lbj: ) + real(r8) , intent(in) :: dz(bounds%begc: , lbj: ) + real(r8) , intent(inout) :: aqu2equilsolidcef_col(bounds%begc:bounds%endc, lbj:ubj, 1:betrtracer_vars%nsolid_equil_tracer_groups) + + real(r8) :: alpha_sl + integer :: fc, c, j + + SHR_ASSERT_ALL((ubound(t_soisno) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(h2osoi_ice) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(dz) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) + associate( & + is_h2o => betrtracer_vars%is_h2o & + ) + + if(any(is_h2o))then + !doing a water isotope simulation + if(betrtracer_vars%id_trc_o18_h2o>0)then + do j = lbj, ubj + do fc = 1, numf + c = filter(fc) + if(j>=jtops(c))then + alpha_sl = get_equi_sl_h2oiso_fractionation(betrtracer_vars%id_trc_o18_h2o, t_soisno(c,j), betrtracer_vars) + aqu2equilsolidcef_col(c,j, betrtracer_vars%id_trc_o18_h2o_ice) = alpha_sl * h2osoi_ice(c,j) / (denh2o * dz(c,j)) + endif + enddo + enddo + endif + endif + + end associate + end subroutine calc_equil_to_liquid_convert_coeff + + !------------------------------------------------------------------------ + subroutine calc_smp_l(bounds, lbj, ubj, numf, filter, t_soisno, soilstate_vars, waterstate_vars, soil_water_retention_curve) + + use SoilStateType , only : soilstate_type + use WaterStateType , only : waterstate_type + use SoilWaterRetentionCurveMod , only : soil_water_retention_curve_type + use clm_varcon , only : grav,hfus,tfrz + + implicit none + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: lbj, ubj ! lower and upper bounds, make sure they are > 0 + integer , intent(in) :: numf ! number of columns in column filter + integer , intent(in) :: filter(:) ! column filter + real(r8) , intent(in) :: t_soisno(bounds%begc: , lbj: ) ! soil temperature + type(soilstate_type) , intent(in) :: soilstate_vars + type(waterstate_type) , intent(inout) :: waterstate_vars + class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve + + !local variables + real(r8) :: s_node + integer :: fc, c, j + + SHR_ASSERT_ALL((ubound(t_soisno) == (/bounds%endc, ubj/)),errMsg(__FILE__,__LINE__)) + associate( & ! + h2osoi_vol => waterstate_vars%h2osoi_vol_col , & ! Input: [real(r8) (:,:) ] volumetric soil moisture + smp_l => waterstate_vars%smp_l_col , & ! Output: [real(r8) (:,:) ] soil suction (mm) + bsw => soilstate_vars%bsw_col , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b" + watsat => soilstate_vars%watsat_col , & ! Input: [real(r8) (:,:) ] minimum soil suction (mm) + sucsat => soilstate_vars%sucsat_col & ! Input: [real(r8) (:,:) ] minimum soil suction (mm) + ) + + + do j = lbj, ubj + do fc = 1, numf + c = filter(fc) + if(j>=1)then + + if(t_soisno(c,j) soilstate_vars%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) + h2osoi_vol => waterstate_vars%h2osoi_vol_col , & ! Input: [real(r8) (:,:) ] volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] + t_soisno => temperature_vars%t_soisno_col & ! Input: [real(r8) (: ,:) ] soil temperature (Kelvin) (-nlevsno+1:nlevsoi) + ) + + + ! The layer index of the first unsaturated layer, i.e., the layer right above + ! the water table. + ! ZS: Loop is currently not vectorized. + do fc = 1, numf + c = filter(fc) + + ! Check to see if any soil layers are frozen and saturated. If so, start looking at the first layer above the top + ! such layer. This is potentially important for perched water tables in the Tundra. + + perch = nlevsoi + do j = nlevsoi, 1, -1 + if (t_soisno(c,j) < tfrz .and. h2osoi_vol(c,j) > f_sat * watsat(c,j)) then + ! strictly less than freezing because it could be permeable otherwise + perch = j-1 + end if + end do + jwt(c) = perch + + do j = perch, 2, -1 + if(h2osoi_vol(c,j) > f_sat * watsat(c,j) .and. h2osoi_vol(c,j-1) < f_sat * watsat(c,j-1)) then + jwt(c) = j-1 + zwt(c) = zi(c,jwt(c)) + exit + end if + enddo + if (jwt(c) == perch .and. h2osoi_vol(c,1) > f_sat * watsat(c,1)) then ! missed that the top layer is saturated + jwt(c) = 0 + endif + + zwt(c) = zi(c,jwt(c)) + end do + + end associate + + end subroutine get_zwt + + !----------------------------------------------------------------------- + subroutine calc_aerecond(bounds, num_soilp, filter_soilp, jwt, rootfr, temperature_vars, betrtracer_vars, & + canopystate_vars, carbonstate_vars, carbonflux_vars, tracercoeff_vars) + ! + ! DESCRIPTION + ! + ! calculate aerenchyma conductance (m/s) + use clm_varcon , only : tfrz, rpi + use pftvarcon , only : nc3_arctic_grass, crop, nc3_nonarctic_grass, nc4_grass, noveg + use CNCarbonFluxType , only : carbonflux_type + use CNCarbonStateType , only : carbonstate_type + use CanopyStateType , only : canopystate_type + use BetrTracerType , only : betrtracer_type + use tracercoeffType , only : tracercoeff_type + use clm_varpar , only : nlevsoi + use TemperatureType , only : temperature_type + use MathfuncMod , only : safe_div + use clm_varctl , only : use_cn + use clm_time_manager , only : get_step_size, get_nstep + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilp ! number of column soil points in column filter + integer , intent(in) :: filter_soilp(:) ! column filter for soil points + integer , intent(in) :: jwt(bounds%begc: ) + real(r8) , intent(in) :: rootfr(bounds%begp: ,1: ) ! fraction of roots in each soil layer + type(temperature_type) , intent(in) :: temperature_vars ! energy state variable + type(canopystate_type) , intent(in) :: canopystate_vars + type(carbonstate_type) , intent(in) :: carbonstate_vars + type(carbonflux_type) , intent(in) :: carbonflux_vars + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(tracercoeff_type) , intent(inout) :: tracercoeff_vars + + real(r8) :: aerecond ! + real(r8) :: nppratio + real(r8) :: anpp + real(r8) :: m_tiller + real(r8) :: n_tiller + real(r8) :: poros_tiller + real(r8) :: area_tiller + real(r8) :: lbl_rsc + real(r8) :: porosmin = 0.05_r8 ! wait to be read in later + real(r8) :: rob = 3._r8 ! ratio of root length to vertical depth ("obliquity"), wait to be read in later + real(r8) :: nongrassporosratio = 0.33_r8 ! non grass ratio + real(r8) :: unsat_aere_ratio= 0.05_r8 / 0.3_r8 + logical :: usefrootc = .false. ! wait to be read in later + integer :: j, fp, p, c, g, kk, k, trcid + + SHR_ASSERT_ALL((ubound(jwt) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(rootfr) == (/bounds%endp, nlevsoi/)), errMsg(__FILE__, __LINE__)) + + associate( & ! + z => col%z , & ! Input: [real(r8) (:,:) ] layer depth (m) (-nlevsno+1:nlevsoi) + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer thickness (m) (-nlevsno+1:nlevsoi) + wtcol => pft%wtcol , & ! Input: [real(r8) (:) ] weight (relative to column) + lbl_rsc_h2o => canopystate_vars%lbl_rsc_h2o_patch , & ! laminar layer resistance for h2o + elai => canopystate_vars%elai_patch , & + annsum_npp => carbonflux_vars%annsum_npp_patch , & ! Input: [real(r8) (:) ] annual sum NPP (gC/m2/yr) + annavg_agnpp => carbonflux_vars%annavg_agnpp_patch , & ! Output: [real(r8) (:) ] annual average above-ground NPP (gC/m2/s) + annavg_bgnpp => carbonflux_vars%annavg_bgnpp_patch , & ! Output: [real(r8) (:) ] annual average below-ground NPP (gC/m2/s) + frootc => carbonstate_vars%frootc_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C + is_volatile => betrtracer_vars%is_volatile , & + volatilegroupid=> betrtracer_vars%volatilegroupid , & + ngwmobile_tracer_groups=> betrtracer_vars%ngwmobile_tracer_groups , & + tracer_group_memid => betrtracer_vars%tracer_group_memid , & + t_veg => temperature_vars%t_veg_patch , & + t_soisno => temperature_vars%t_soisno_col , & + scal_aere_cond => tracercoeff_vars%scal_aere_cond_col , & + tracer_diffusivity_air=> tracercoeff_vars%tracer_diffusivity_air_col, & + aere_cond => tracercoeff_vars%aere_cond_col & ! + ) + + + do j=1,nlevsoi + do fp = 1, num_soilp + p = filter_soilp (fp) + c = pft%column(p) + g = col%gridcell(c) + ! Calculate aerenchyma diffusion + if (j > jwt(c) .and. t_soisno(c,j) > tfrz .and. pft%itype(p) /= noveg) then + ! Attn EK: This calculation of aerenchyma properties is very uncertain. Let's check in once all + ! the new components are in; if there is any tuning to be done to get a realistic global flux, + ! this would probably be the place. We will have to document clearly in the Tech Note + ! any major changes from the Riley et al. 2011 version. (There are a few other minor ones.) + if(use_cn)then + anpp = annsum_npp(p) ! g C / m^2/yr + anpp = max(anpp, 0._r8) ! NPP can be negative b/c of consumption of storage pools + + if (annavg_agnpp(p) /= spval .and. annavg_bgnpp(p) /= spval .and. & + annavg_agnpp(p) > 0._r8 .and. annavg_bgnpp(p) > 0._r8) then + nppratio = annavg_bgnpp(p) / (annavg_agnpp(p) + annavg_bgnpp(p)) + else + nppratio = 0.5_r8 + end if + endif + ! Estimate area of tillers (see Wania thesis) + !m_tiller = anpp * r_leaf_root * lai ! (4.17 Wania) + !m_tiller = 600._r8 * 0.5_r8 * 2._r8 ! used to be 300 + ! Note: this calculation is based on Arctic graminoids, and should be refined for woody plants, if not + ! done on a PFT-specific basis. + + if(.not. use_cn)then + m_tiller = 0._r8 !this was set to zero purposely + else + if (usefrootc) then + m_tiller = frootc(p) ! This will yield much smaller aere area. + else + m_tiller = anpp * nppratio * elai(p) + end if + endif + n_tiller = m_tiller / 0.22_r8 + + if (pft%itype(p) == nc3_arctic_grass .or. crop(pft%itype(p)) == 1 .or. & + pft%itype(p) == nc3_nonarctic_grass .or. pft%itype(p) == nc4_grass) then + poros_tiller = 0.3_r8 ! Colmer 2003 + else + poros_tiller = 0.3_r8 * nongrassporosratio + end if + + + poros_tiller = poros_tiller * unsat_aere_ratio + + poros_tiller = max(poros_tiller, porosmin) + + area_tiller = n_tiller * poros_tiller * rpi * 2.9e-3_r8**2._r8 ! (m2/m2) + + do k = 1, ngwmobile_tracer_groups + trcid = tracer_group_memid(k, 1) + if(is_volatile(trcid))then + kk = volatilegroupid(k) + tracer_diffusivity_air(c,kk) = get_gas_diffusivity(trcid,t_veg(p), betrtracer_vars) + aerecond = scal_aere_cond(c, kk)*area_tiller * rootfr(p,j) * tracer_diffusivity_air(c,kk) / (z(c,j)*rob) + ! Add in boundary layer resistance + lbl_rsc = safe_div(lbl_rsc_h2o(p), (get_diffusivity_ratio_gas2h2o(trcid, t_veg(p), betrtracer_vars))**(2._r8/3._r8)) + !laminar boundary resistance + resistance in the aerenchyma + aerecond = safe_div(1._r8, (safe_div(1._r8,aerecond) + safe_div(1._r8,lbl_rsc))) + aere_cond(c,kk) = aere_cond(c,kk) + wtcol(p) * aerecond + endif + enddo + endif + end do ! p filter + end do ! over levels + + + end associate + + end subroutine calc_aerecond + + + !----------------------------------------------------------------------- + subroutine betr_annualupdate(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + carbonflux_vars, tracercoeff_vars) + ! + ! !DESCRIPTION: Annual mean fields. + ! + ! !USES: + use clm_time_manager , only : get_step_size, get_days_per_year, get_nstep + use clm_varcon , only : secspday + use CNCarbonFluxType , only : carbonflux_type + use tracercoeffType , only : tracercoeff_type + ! + ! !ARGUMENTS: + 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_soilp ! number of soil points in pft filter + integer , intent(in) :: filter_soilp(:) ! patch filter for soil points + type(Carbonflux_type) , intent(inout) :: carbonflux_vars + type(tracercoeff_type) , intent(inout) :: tracercoeff_vars + ! + ! !LOCAL VARIABLES: + integer :: c,p ! indices + integer :: fc ! soil column filter indices + integer :: fp ! soil pft filter indices + real(r8):: dt ! time step (seconds) + real(r8):: secsperyear + logical :: newrun + !----------------------------------------------------------------------- + + associate( & + agnpp => carbonflux_vars%agnpp_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) aboveground NPP + bgnpp => carbonflux_vars%bgnpp_patch , & ! Input: [real(r8) (:) ] (gC/m2/s) belowground NPP + tempavg_agnpp => carbonflux_vars%tempavg_agnpp_patch , & ! Output: [real(r8) (:) ] temporary average above-ground NPP (gC/m2/s) + annavg_agnpp => carbonflux_vars%annavg_agnpp_patch , & ! Output: [real(r8) (:) ] annual average above-ground NPP (gC/m2/s) + tempavg_bgnpp => carbonflux_vars%tempavg_bgnpp_patch , & ! Output: [real(r8) (:) ] temporary average below-ground NPP (gC/m2/s) + annavg_bgnpp => carbonflux_vars%annavg_bgnpp_patch , & ! Output: [real(r8) (:) ] annual average below-ground NPP (gC/m2/s) + + + annsum_counter => tracercoeff_vars%annsum_counter_col & ! Output: [real(r8) (:) ] seconds since last annual accumulator turnover + !finundated => ch4_vars%finundated_col , & ! Input: [real(r8) (:) ] fractional inundated area in soil column + !tempavg_somhr => ch4_vars%tempavg_somhr_col , & ! Output: [real(r8) (:) ] temporary average SOM heterotrophic resp. (gC/m2/s) + !annavg_somhr => ch4_vars%annavg_somhr_col , & ! Output: [real(r8) (:) ] annual average SOM heterotrophic resp. (gC/m2/s) + !tempavg_finrw => ch4_vars%tempavg_finrw_col , & ! Output: [real(r8) (:) ] respiration-weighted annual average of finundated + !annavg_finrw => ch4_vars%annavg_finrw_col & ! Output: [real(r8) (:) ] respiration-weighted annual average of finundated + ) + + ! set time steps + dt = real(get_step_size(), r8) + secsperyear = real( get_days_per_year() * secspday, r8) + + newrun = .false. + + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (annsum_counter(c) == spval) then + ! These variables are now in restart files for completeness, but might not be in inicFile and are not. + ! set for arbinit. + newrun = .true. + annsum_counter(c) = 0._r8 + !tempavg_somhr(c) = 0._r8 + !tempavg_finrw(c) = 0._r8 + end if + + annsum_counter(c) = annsum_counter(c) + dt + end do + + ! patch loop + do fp = 1,num_soilp + p = filter_soilp(fp) + + if (newrun .or. tempavg_agnpp(p) == spval) then ! Extra check needed because for back-compatibility + tempavg_agnpp(p) = 0._r8 + tempavg_bgnpp(p) = 0._r8 + end if + end do + + + do fp = 1,num_soilp + p = filter_soilp(fp) + c = pft%column(p) + if (annsum_counter(c) >= secsperyear) then + + annavg_agnpp(p) = tempavg_agnpp(p) + tempavg_agnpp(p) = 0._r8 + + annavg_bgnpp(p) = tempavg_bgnpp(p) + tempavg_bgnpp(p) = 0._r8 + + else + tempavg_agnpp(p) = tempavg_agnpp(p) + dt/secsperyear * agnpp(p) + tempavg_bgnpp(p) = tempavg_bgnpp(p) + dt/secsperyear * bgnpp(p) + end if + end do + + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + if (annsum_counter(c) >= secsperyear) annsum_counter(c) = 0._r8 + end do + + end associate + + end subroutine betr_annualupdate +end module TracerParamsMod diff --git a/components/clm/src/betr/betr_core/TracerStateType.F90 b/components/clm/src/betr/betr_core/TracerStateType.F90 new file mode 100644 index 000000000000..7fc374d0f626 --- /dev/null +++ b/components/clm/src/betr/betr_core/TracerStateType.F90 @@ -0,0 +1,318 @@ +module TracerStateType + ! + ! !DESCRIPTION: + ! data type for state variables used in betr + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use decompMod , only : bounds_type + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : pft + use clm_varctl , only : iulog + use abortutils , only : endrun + use spmdMod , only : masterproc + use clm_varcon , only : spval, ispval + use landunit_varcon, only : istsoil, istcrop + ! + ! !PUBLIC TYPES: + implicit none + save + private + ! + ! !PUBLIC DATA: + ! + + type, public :: TracerState_type + ! Column tracer state variables + real(r8), pointer :: tracer_conc_surfwater_col (:,:) !tracer concentration in the hydraulic head + real(r8), pointer :: tracer_conc_aquifer_col (:,:) !tracer concentration in the flux to aquifer + real(r8), pointer :: tracer_conc_grndwater_col (:,:) !tracer concentration in the flux to groundwater, include lateral drainage and discharge to aquifer + real(r8), pointer :: tracer_col_molarmass_col (:,:) !for error tracking, column tracer mass + real(r8), pointer :: tracer_conc_atm_col (:,:) !colum volatile tracer in the atmosphere + real(r8), pointer :: tracer_P_gas_col (:,:) !total gas pressure at different depth, sum of different gas species. + real(r8), pointer :: tracer_P_gas_frac_col (:,:,:) !fraction of the volatile species in the overall pressure + real(r8), pointer :: tracer_soi_molarmass_col (:,:) !vertically integrated tracer content (mol tracer/m2), only in the soil + real(r8), pointer :: tracer_conc_mobile_col (:,:,:) !tracer concentration in each layer (mol/m3) (snow/ponding water + soil) + real(r8), pointer :: tracer_conc_solid_equil_col (:,:,:) !tracer concentration in adsorbed/solid phase for each layer (mol/m3) (soil), which is in equilibrium with mobile phase + real(r8), pointer :: tracer_conc_solid_passive_col (:,:,:) !tracer concentration in passive solid phase, which is not in equilibrium with mobile phase. e.g. polymers, or protected monomers, or ice + !real(r8), pointer :: tracer_conc_frozen_col (:,:,:) !place holder, tracer concentration in frozen layer for unsaturated part for nonvolatile species + !real(r8), pointer :: tracer_conc_bubble_col (:,:,:) !place holder, a bubble pool to track the lake ebullition in freeze-thaw period, [col, levels, tracer] + real(r8), pointer :: beg_tracer_molarmass_col (:,:) !column integrated tracer mass + real(r8), pointer :: end_tracer_molarmass_col (:,:) !column integrated tracer mass + real(r8), pointer :: errtracer_col (:,:) !column mass balance error + contains + procedure, public :: Init + procedure, public :: Restart + procedure, public :: Reset + procedure, private :: InitAllocate + procedure, private :: InitHistory + end type TracerState_type + +contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds, lbj, ubj, betrtracer_vars) + ! + ! !DESCRIPTION: + ! initialize the data type + + ! !USES: + use BeTRTracerType, only : BeTRTracer_Type + + implicit none + ! !ARGUMENTS: + class(TracerState_type) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: lbj, ubj + type(BeTRTracer_Type), intent(in) :: betrtracer_vars + + call this%InitAllocate(bounds, lbj, ubj, betrtracer_vars) + call this%InitHistory(bounds, betrtracer_vars) + + end subroutine Init + + !----------------------------------------------------------------------- + subroutine InitAllocate(this, bounds, lbj, ubj, betrtracer_vars) + ! + ! !DESCRIPTION: + ! allocate memory for arraies in the data type + + ! !USES: + use BeTRTracerType, only : BeTRTracer_Type + implicit none + ! + ! !ARGUMENTS: + class(TracerState_type) :: this + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: lbj, ubj + type(BeTRTracer_Type), intent(in) :: betrtracer_vars + ! + ! !LOCAL VARIABLES: + integer :: begc, endc + integer :: ngwmobile_tracers, ntracers + integer :: nsolid_equil_tracers + integer :: nsolid_passive_tracers + integer :: nvolatile_tracers + + !--------------------------------------------------------------------- + + begc = bounds%begc; endc= bounds%endc + ngwmobile_tracers = betrtracer_vars%ngwmobile_tracers + ntracers = betrtracer_vars%ntracers + nsolid_equil_tracers = betrtracer_vars%nsolid_equil_tracers + nsolid_passive_tracers = betrtracer_vars%nsolid_passive_tracers + nvolatile_tracers = betrtracer_vars%nvolatile_tracers + allocate(this%tracer_P_gas_col (begc:endc, lbj:ubj)) ; this%tracer_P_gas_col (:,:) = nan + allocate(this%tracer_conc_surfwater_col (begc:endc, 1:ngwmobile_tracers)) ; this%tracer_conc_surfwater_col(:,:) = nan + allocate(this%tracer_conc_aquifer_col (begc:endc, 1:ngwmobile_tracers)) ; this%tracer_conc_aquifer_col (:,:) = nan + allocate(this%tracer_conc_grndwater_col (begc:endc, 1:ngwmobile_tracers)) ; this%tracer_conc_grndwater_col(:,:) = nan + allocate(this%tracer_col_molarmass_col (begc:endc, 1:ntracers)) ; this%tracer_col_molarmass_col (:,:) = nan + allocate(this%tracer_soi_molarmass_col (begc:endc, 1:ntracers)) ; this%tracer_soi_molarmass_col (:,:) = nan + allocate(this%errtracer_col (begc:endc, 1:ntracers)) ; this%errtracer_col (:,:) = nan + allocate(this%tracer_conc_atm_col (begc:endc, 1:nvolatile_tracers)) ; this%tracer_conc_atm_col (:,:) = nan + allocate(this%tracer_conc_mobile_col (begc:endc, lbj:ubj, 1:ngwmobile_tracers)) ; this%tracer_conc_mobile_col (:,:,:) = nan + allocate(this%tracer_conc_solid_equil_col (begc:endc, lbj:ubj, 1:nsolid_equil_tracers)) ; this%tracer_conc_solid_equil_col (:,:,:) = nan + allocate(this%tracer_conc_solid_passive_col (begc:endc, lbj:ubj, 1:nsolid_passive_tracers)); this%tracer_conc_solid_passive_col(:,:,:) = nan + allocate(this%tracer_P_gas_frac_col (begc:endc, lbj:ubj, 1:nvolatile_tracers)) ; this%tracer_P_gas_frac_col (:,:,:) = nan + + allocate(this%beg_tracer_molarmass_col (begc:endc, 1:ntracers)); this%beg_tracer_molarmass_col(:,:) = nan + allocate(this%end_tracer_molarmass_col (begc:endc, 1:ntracers)); this%end_tracer_molarmass_col(:,:) = nan + + end subroutine InitAllocate + + !----------------------------------------------------------------------- + subroutine InitHistory(this, bounds, betrtracer_vars) + ! + ! !DESCRIPTION: + ! History fields initialization + ! + ! !USES: + !use shr_infnan_mod, only: nan => shr_infnan_nan, assignment(=) + use clm_varpar , only: nlevsno + use BeTRTracerType, only: BeTRTracer_Type + use histFileMod , only: hist_addfld1d, hist_addfld2d + use histFileMod , only: no_snow_normal, no_snow_zero + ! + ! !ARGUMENTS: + class(TracerState_type) :: this + type(bounds_type) , intent(in) :: bounds + type(BeTRTracer_Type), intent(in) :: betrtracer_vars + ! + ! !LOCAL VARIABLES: + integer :: begc, endc + integer :: jj, kk + real(r8), pointer :: data2dptr(:,:) ! temp. pointers for slicing larger arrays + real(r8), pointer :: data1dptr(:) ! temp. pointers for slicing larger arrays + + + associate( & + ntracers => betrtracer_vars%ntracers , & + ngwmobile_tracers => betrtracer_vars%ngwmobile_tracers , & + is_volatile => betrtracer_vars%is_volatile , & + is_isotope => betrtracer_vars%is_isotope , & + is_h2o => betrtracer_vars%is_h2o , & + volatileid => betrtracer_vars%volatileid , & + tracernames => betrtracer_vars%tracernames & + ) + begc = bounds%begc; endc=bounds%endc + + this%tracer_P_gas_col(begc:endc, :) = spval + data2dptr => this%tracer_P_gas_col + + call hist_addfld2d (fname='TRACER_P_GAS', units='Pa', type2d='levtrc', & + avgflag='A', long_name='total gas pressure', & + ptr_col=data2dptr) + + do jj = 1, ntracers + if(jj<= ngwmobile_tracers)then + + this%tracer_conc_surfwater_col(begc:endc,jj) = spval + data1dptr => this%tracer_conc_surfwater_col(:,jj) + call hist_addfld1d (fname=trim(tracernames(jj))//'_TRACER_CONC_SURFWATER', units='mol m-3', & + avgflag='A', long_name='head concentration for tracer '//trim(tracernames(jj)), & + ptr_col=data1dptr, default='inactive') + + + this%tracer_conc_aquifer_col(begc:endc, jj) = spval + data1dptr => this%tracer_conc_aquifer_col(:, jj) + call hist_addfld1d (fname=trim(tracernames(jj))//'_TRACER_CONC_AQUIFER', units='mol m-3', & + avgflag='A', long_name='quifier concentration for tracer '//trim(tracernames(jj)), & + ptr_col=data1dptr, default='inactive') + + this%tracer_conc_grndwater_col(begc:endc, jj) = spval + data1dptr => this%tracer_conc_grndwater_col(:, jj) + call hist_addfld1d (fname=trim(tracernames(jj))//'_TRACER_CONC_GRNDWATER', units='mol m-3', & + avgflag='A', long_name='groundwater concentration for tracer '//trim(tracernames(jj)), & + ptr_col=data1dptr, default='inactive') + + this%tracer_conc_mobile_col(begc:endc, :, jj) = spval + data2dptr => this%tracer_conc_mobile_col(:, :, jj) + call hist_addfld2d (fname=trim(tracernames(jj))//'_TRACER_CONC_MOBILE', units='mol m-3', type2d='levtrc', & + avgflag='A', long_name='gw-mobile phase for tracer '//trim(tracernames(jj)), & + ptr_col=data2dptr) + + if(is_volatile(jj) .and. (.not. is_h2o(jj)) .and. (.not. is_isotope(jj)))then + this%tracer_P_gas_frac_col(begc:endc,:, volatileid(jj)) = spval + data2dptr => this%tracer_P_gas_frac_col(:,:, volatileid(jj)) + call hist_addfld2d (fname=trim(tracernames(jj))//'_TRACER_P_GAS_FRAC', units='mol m-3', type2d='levtrc', & + avgflag='A', long_name='fraction of gas phase contributed by '//trim(tracernames(jj)), & + ptr_col=data2dptr) + endif + + else + kk = jj - ngwmobile_tracers + this%tracer_conc_solid_passive_col(begc:endc, :, kk) = spval + data2dptr => this%tracer_conc_solid_passive_col(:, :, kk) + call hist_addfld2d (fname=trim(tracernames(jj))//'TRACER_CONC_SOLID_PASSIVE', units='mol m-3', type2d='levtrc', & + avgflag='A', long_name='passive solid phase for tracer '//trim(tracernames(jj)), & + ptr_col=data2dptr, default='inactive') + endif + + this%tracer_soi_molarmass_col(begc:endc, jj) = spval + data1dptr => this%tracer_soi_molarmass_col(:,jj) + call hist_addfld1d (fname=trim(tracernames(jj))//'_TRCER_SOI_MOLAMASS', units='mol m-2', & + avgflag='A', long_name='total molar mass in soil for '//trim(tracernames(jj)), & + ptr_col=data1dptr, default='inactive') + + this%tracer_col_molarmass_col(begc:endc, jj) = spval + data1dptr => this%tracer_col_molarmass_col(:,jj) + call hist_addfld1d (fname=trim(tracernames(jj))//'_TRCER_COL_MOLAMASS', units='mol m-2', & + avgflag='A', long_name='total molar mass in the column (soi+snow) for '//trim(tracernames(jj)), & + ptr_col=data1dptr, default='inactive') + + enddo + + + + end associate + end subroutine InitHistory + + + !------------------------------------------------------------------------ + subroutine Restart(this, bounds, ncid, flag, betrtracer_vars) + ! + ! !DESCRIPTION: + ! Read/Write module information to/from restart file. + ! + ! !USES: + use clm_varpar , only : nlevsno, nlevsoi + use clm_varctl , only : iulog + use clm_varpar , only : nlevsno + use BeTRTracerType, only : BeTRTracer_Type + !use spmdMod , only : masterproc + use restUtilMod + use ncdio_pio + ! + implicit none + ! !ARGUMENTS: + class(TracerState_type) :: this + type(bounds_type) , intent(in) :: bounds + class(file_desc_t) , intent(inout) :: ncid ! netcdf id + character(len=*) , intent(in) :: flag ! 'read' or 'write' + type(BeTRTracer_Type), intent(in) :: betrtracer_vars + ! + ! !LOCAL VARIABLES: + integer :: j,c,jj,kk ! indices + logical :: readvar ! determine if variable is on initial file + real(r8), pointer :: ptr1d(:) + real(r8), pointer :: ptr2d(:,:) + + associate( & + ntracers => betrtracer_vars%ntracers , & + ngwmobile_tracers => betrtracer_vars%ngwmobile_tracers , & + is_adsorb => betrtracer_vars%is_adsorb , & + adsorbid => betrtracer_vars%adsorbid , & + tracernames => betrtracer_vars%tracernames & + ) + + do jj = 1, ntracers + if(jj<= ngwmobile_tracers)then + + ptr1d => this%tracer_conc_aquifer_col(:, jj) + call restartvar(ncid=ncid, flag=flag, varname=trim(tracernames(jj))//'_TRACER_CONC_AQUIFER', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp' , readvar=readvar, data=ptr1d) + + ptr2d => this%tracer_conc_mobile_col(:, :, jj) + call restartvar(ncid=ncid, flag=flag, varname=trim(tracernames(jj))//'_TRACER_CONC_MOIBLE', xtype=ncd_double, & + dim1name='column',dim2name='levtrc', switchdim=.true., & + long_name='', units='', fill_value=spval, & + interpinic_flag='interp', readvar=readvar, data=ptr2d) + + if(is_adsorb(jj))then + ptr2d => this%tracer_conc_solid_equil_col(:, :, adsorbid(jj)) + call restartvar(ncid=ncid, flag=flag, varname=trim(tracernames(jj))//'_TRACER_CONC_SOLID_EQUIL', xtype=ncd_double, & + dim1name='column',dim2name='levtrc', switchdim=.true., & + long_name='', units='', fill_value=spval, & + interpinic_flag='interp', readvar=readvar, data=ptr2d) + endif + else + kk = jj - ngwmobile_tracers + ptr2d => this%tracer_conc_solid_passive_col(:, :, kk) + call restartvar(ncid=ncid, flag=flag, varname=trim(tracernames(jj))//'TRACER_CONC_SOLID_PASSIVE', xtype=ncd_double, & + dim1name='column',dim2name='levtrc', switchdim=.true., & + long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=ptr2d) + endif + + enddo + end associate + end subroutine Restart + + !----------------------------------------------------------------------- + subroutine Reset(this, column) + ! + ! !DESCRIPTION: + ! reset state variables + ! + ! !ARGUMENTS: + class(TracerState_type) :: this + integer , intent(in) :: column ! column index + !----------------------------------------------------------------------- + + + end subroutine Reset + +end module TracerStateType diff --git a/components/clm/src/betr/betr_core/Tracer_varcon.F90 b/components/clm/src/betr/betr_core/Tracer_varcon.F90 new file mode 100644 index 000000000000..042b789ed936 --- /dev/null +++ b/components/clm/src/betr/betr_core/Tracer_varcon.F90 @@ -0,0 +1,89 @@ +module Tracer_varcon + !----------------------------------------------------------------------- + !BOP + ! + ! !MODULE: Tracer_varcon + ! + ! !DESCRIPTION: + ! Module containing parameters and logical switches and routine to read constants from CLM namelist for tracer transport set up. + ! + ! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use abortutils , only : endrun + use clm_varctl , only : iulog + ! + ! !PUBLIC TYPES: + implicit none + save + + logical, public :: l2ndadvsolver = .false. ! by default use 1st order solver for advection + + real(r8),public, parameter :: SHR_CONST_VSMOW_O18 = 2005.20e-6_R8 ! ratio of 18O/16O in Vienna Standard Mean Ocean Water (VSMOW) + real(r8),public, parameter :: SHR_CONST_VSMOW_O17 = 379.9e-6_R8 ! ratio of 17O/16O in Vienna Standard Mean Ocean Water (VSMOW) + real(r8),public, parameter :: SHR_CONST_VSMOW_D = 155.76e-6_R8 ! ratio of D/H in Vienna Standard Mean Ocean Water (VSMOW) + real(r8),public, parameter :: SHR_CONST_VSMOW_T = 1.85e-6_R8 ! ratio of T/H in Vienna Standard Mean Ocean Water (VSMOW) + + ! underground tracer transport logical switches + logical, public :: ltracer_offline=.true. ! true=> do not pass volatile tracers from/to atmosphere + logical, public :: ltrcunsat=.false. ! ture=> swith on tracer transport for specified underground processes in unsaturated upland soil + logical, public :: ltrcsat =.false. ! ture=> swith on tracer transport for specified underground processes in unsaturated wetland soil + logical, public :: ltrclake =.false. ! ture=> swith on tracer transport for specified underground processes in lake water and lake soil + logical, public :: laquadv_off =.false. ! true=> turn off aqueous advection + logical, public :: lgasadv_off = .false. ! true=> turn off gas advection + logical, public :: lzero_restart = .false. ! true => start with nil tracer concentration, by default + logical, public :: is_online_soilchem = .false. ! true=> chemistry is done outside TracerUpdate, added for plug&play capability, say microbial model + logical, public :: ldsolvn_vtransport = .false. ! this is not in the namelist, and its value will be determined in SoilTracersMod, don transport? + logical, public :: ldsolvc_vtransport = .false. ! this is not in the namelist, and its value will be determined in SoilTracersMod, doc transport? + logical, public :: lco2_refix = .false. ! true => refix co2 transported to leaf + logical, public :: lneut = .false. ! true => only allow neutral molecules to go through xylem + logical, public :: ltracer_stem = .false. ! true => model valatile tracer in stem + logical, public :: use_pH_data = .false. + logical, public :: licecoat = .false. ! true => switch on ice coating for dissolved tracers, the coating is defined as the dice/h2oliq, + ! where, dice is the change of ice content during to free-thaw cyles + logical, public :: is_active_betr_bgc = .false. + logical, public :: do_betr_leaching = .false. + logical, public :: liceseal = .true. ! true => allow ice to seal the surface soil and keep the gas tracer + real(r8),public :: rr_dif_scal = 1._r8 ! scaling factor for how much root respiration is diffused out into soil + real(r8),public :: mr_dif_scal = 0._r8 ! how much fraction of stem respiration is back into xylem + real(r8),public :: co2_refix_scal = 0.0_r8 ! how much fraction of co2 in the xylem is refixed in leaf + real(r8),public :: site_pH = 7._r8 ! pH value of the site + + ! atmospheric compositions, (v/v) + real(r8),public :: atm_n2 = 0.78084_r8 + real(r8),public :: atm_o2 = 0.20946_r8 + real(r8),public :: atm_ar = 0.009340_r8 + real(r8),public :: atm_co2 = 379e-6_r8 !this will be set to the value provided from co2_ppmv + real(r8),public :: atm_ch4 = 1.7e-6_r8 !this will be set to the value provided from atmch4 if clm4me is on + real(r8),public :: atm_n2o = 3.1e-7_r8 + real(r8),public :: atm_no = 4.56e-9_r8 + real(r8),public :: atm_nh3 = 300.e-12_r8 ! + real(r8),public :: atm_h2 = 0.55e-6_r8 + + ! atmospheric isotopic signatures + ! the zeros will be replaced with updated value from literature searching. + real(r8),public :: atm_deld_h2 = 0._r8 !relative to VSMOW + real(r8),public :: atm_delt_h2 = 0._r8 !relative to VSMOW + real(r8),public :: atm_del13c_co2 =-6._r8 !set to pre-industrial value by default, it will be used to set the value of c13ratio, PDB + real(r8),public :: atm_del13c_ch4 = 0._r8 !relative to PDB + real(r8),public :: atm_del14c_co2 = 0._r8 !relative to what? + real(r8),public :: atm_del14c_ch4 = 0._r8 !relative to what? + real(r8),public :: atm_del18o_co2 = 0._r8 !relative to VSMOW + real(r8),public :: atm_del18o_h2o = 0._r8 !relative to VSMOW + real(r8),public :: atm_del18o_o2 = 0._r8 !relative to VSMOW + real(r8),public :: atm_del17o_co2 = 0._r8 !relative to VSMOW + real(r8),public :: atm_del17o_h2o = 0._r8 !relative to VSMOW + real(r8),public :: atm_del17o_o2 = 0._r8 !relative to VSMOW + real(r8),public :: atm_deld_ch4 = 0._r8 !realtive to VSMOW + real(r8),public :: atm_deld_h2o = 0._r8 !relative to VSMOW + + integer, parameter, public :: bndcond_as_conc = 1 !top boundary conditions as tracer concentration + integer, parameter, public :: bndcond_as_flux=2 !top boundary condition as tracer flux + + + !true fractions of the isotopologues in the atmosphere + real(r8),public :: atm_dratio_h2, atm_tratio_h2 + real(r8),public :: atm_c13rc12_co2, atm_c14rc12_co2, atm_o18ro16_co2, atm_o17ro16_co2 + real(r8),public :: atm_drh_h2o,atm_tratio_h2o,atm_o18ro16_h2o, atm_o17ro16_h2o + real(r8),public :: atm_c13rc12_ch4, atm_c14rc12_ch4, atm_drh_ch4 + +end module Tracer_varcon diff --git a/components/clm/src/betr/betr_core/TransportMod.F90 b/components/clm/src/betr/betr_core/TransportMod.F90 new file mode 100644 index 000000000000..42a3987adea7 --- /dev/null +++ b/components/clm/src/betr/betr_core/TransportMod.F90 @@ -0,0 +1,898 @@ +module TransportMod + ! + ! !DESCRIPTION: + ! + ! subroutines to do 1d vertical multiphase transport in soil/water + ! History: created by Jinyun Tang, Jun 2011 + +#include "shr_assert.h" + ! !USES: + use shr_log_mod , only : errMsg => shr_log_errMsg + use tracer_varcon , only : bndcond_as_conc, bndcond_as_flux + use clm_varctl , only : iulog + use abortutils , only : endrun + use shr_kind_mod , only : r8 => shr_kind_r8 + implicit none + private + public :: DiffusTransp !do tracer transport through diffusion, for both lake and soil + public :: calc_interface_conductance + public :: init_transportmod + public :: get_cntheta + public :: calc_col_CFL !claculate CFL critieria + public :: semi_lagrange_adv_backward + interface DiffusTransp + module procedure DiffusTransp_gw + module procedure DiffusTransp_solid + end interface DiffusTransp + + type, private :: Extra_type + real(r8), pointer :: zi(:) !interfaces + real(r8), pointer :: us(:) !flow velocity at the interfaces + integer :: nlen !total number of interfaces + contains + procedure, public :: InitAllocate + procedure, public :: DDeallocate + procedure, public :: AAssign + end type Extra_type + + type(Extra_type), private :: Extra_inst + + !default configuration parameters + real(r8), private :: cntheta + +contains + !------------------------------------------------------------------------------- + subroutine InitAllocate(this, lbj, ubj) + ! + ! !DESCRIPTION: + ! allocate memory for arrays of the specified data type + + ! !ARGUMENTS: + class(Extra_type) :: this + integer, intent(in) :: lbj, ubj + character(len=32) :: subname ='InitAllocate' + + + allocate(this%zi(lbj:ubj)) + allocate(this%us(lbj:ubj)) + + end subroutine InitAllocate + !------------------------------------------------------------------------------- + + subroutine DDeallocate(this) + ! + ! !DESCRIPTION: + ! Deallocate memories + ! + ! !ARGUMENTS: + class(Extra_type) :: this + character(len=32) :: subname ='DDeallocate' + deallocate(this%zi) + deallocate(this%us) + + end subroutine DDeallocate + + !------------------------------------------------------------------------------- + + subroutine AAssign(this, zi_t,us_t) + ! + ! !DESCRIPTION: + ! Assgin values for member variables for the specified data type + ! + ! !ARGUMENTS: + class(Extra_type) :: this + real(r8), dimension(:), intent(in) :: zi_t + real(r8), dimension(:), intent(in) :: us_t + + ! !LOCAL VARIABLES: + integer :: n1, n2 + character(len=32) :: subname ='AAssign' + + n1 = size(zi_t) + n2 = size(us_t) + SHR_ASSERT_ALL((n1 == n2), errMsg(__FILE__,__LINE__)) + this%zi(1:n1) = zi_t + this%us(1:n2) = us_t + this%nlen = n1 + end subroutine AAssign + !------------------------------------------------------------------------------- + function get_cntheta()result(ans) + ! + ! !DESCRIPTION: + ! return the theta factor + ! + implicit none + + ! !LOCAL VARIABLES: + real(r8) :: ans + character(len=32) :: subname ='get_cntheta' + + ans = cntheta + return + end function get_cntheta + !------------------------------------------------------------------------------- + subroutine init_transportmod(lcntheta) + ! + ! !DESCRIPTION: + ! initialize transportmod + ! + implicit none + ! !ARGUMENTS: + real(r8), optional, intent(in) :: lcntheta + character(len=32) :: subname ='init_transportmod' + if(present(lcntheta))then + cntheta = lcntheta + else + ! use implicit solver by default + cntheta = 1._r8 + endif + + end subroutine init_transportmod + !------------------------------------------------------------------------------- + + subroutine calc_interface_conductance(bounds, lbj, ubj, jtop, numfl, filter, bulkdiffus, dz, hmconductance) + ! + ! !DESCRIPTION: + ! calcualte conductances at the interfaces using input layered diffusivity and + ! thickness + ! + ! !USES: + ! + use shr_kind_mod, only: r8 => shr_kind_r8 + use decompMod, only : bounds_type + implicit none + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds !bounds + integer, intent(in) :: lbj, ubj ! lbinning and ubing level indices + integer, intent(in) :: jtop(bounds%begc: ) ! index of upper boundary, which could be variable + integer, intent(in) :: numfl ! length of the filter + integer, intent(in) :: filter(:) ! the actual filter + real(r8), intent(in) :: bulkdiffus(bounds%begc: ,lbj: ) !weighted bulk diffusivity for dual-phase diffusion + real(r8), intent(in) :: dz(bounds%begc: , lbj: ) + real(r8), intent(inout) :: hmconductance(bounds%begc: , lbj: ) !weighted bulk conductance + + ! !LOCAL VARIABLES: + integer :: n, c, fc + + SHR_ASSERT_ALL((ubound(jtop) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(dz) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(bulkdiffus) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(hmconductance) == (/bounds%endc, ubj-1/)), errMsg(__FILE__,__LINE__)) + + do n=lbj, ubj-1 + do fc = 1, numfl + c = filter(fc) + if(n>=jtop(c))then + hmconductance(c,n) = 2._r8/(dz(c,n)/bulkdiffus(c,n)+dz(c,n+1)/bulkdiffus(c,n+1)) + endif + enddo + enddo + + + end subroutine calc_interface_conductance + !------------------------------------------------------------------------------- + subroutine DiffusTransp_gw_tridiag(bounds, lbj, ubj, jtop, numfl, filter, ntrcs, trcin_mobile, & + Rfactor, hmconductance, dtime, dz, source, trc_concflx_air,condc_toplay, topbc_type,& + bot_concflx, update_col, source_only, rt, at,bt,ct, botbc_type, condc_botlay) + ! + ! !DESCRIPTION: + ! Assemble the tridiagonal matrix for the multiphase diffusive transport + ! + ! !USES + ! + use shr_kind_mod, only: r8 => shr_kind_r8 + use decompMod, only : bounds_type + + implicit none + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds ! bounds + integer, intent(in) :: lbj, ubj ! lbinning and ubing level indices + integer, intent(in) :: jtop(bounds%begc: ) ! index of upper boundary, which could be variable + integer, intent(in) :: numfl ! length of the filter + integer, intent(in) :: filter(:) ! the actual filter + integer, intent(in) :: ntrcs + real(r8), intent(in) :: Rfactor(bounds%begc: , lbj: ) ! conversion parameter from the given tracer phase to bulk mobile phase + real(r8), intent(in) :: hmconductance(bounds%begc: , lbj: ) ! weighted bulk tracer conductances + real(r8), intent(in) :: dz(bounds%begc: , lbj: ) ! node thickness + real(r8), intent(in) :: dtime(bounds%begc: ) ! time step + real(r8), intent(in) :: condc_toplay(bounds%begc: ) ! top layer conductance + integer, intent(in) :: topbc_type ! type of top boundary condtion: 1, concentration, 2 flux + real(r8), intent(in) :: bot_concflx (bounds%begc: , 1: , 1: ) ! flux or concentration at the bottom boundary + real(r8), intent(in) :: trc_concflx_air(bounds%begc: , 1: , 1: ) ! atmospheric tracer concentration (topbc_type=1) or flux (topbc_type=2) + real(r8), intent(in) :: trcin_mobile (bounds%begc: , lbj: , 1: ) ! incoming mobile tracer concentration + real(r8), intent(in) :: source (bounds%begc: , lbj: , 1: ) ! chemical sources [mol/m3] + + logical, intent(in) :: source_only ! if .true. only update the source array rt, used for explicit solver + logical, intent(in) :: update_col(bounds%begc: ) ! logical switch indicating if the column is for active update + + real(r8), intent(out):: rt(bounds%begc: ,lbj: , 1: ) ! tridiagonal matrix element r + real(r8), optional,intent(inout):: at(bounds%begc: , lbj: ) ! tridiagonal matrix element a + real(r8), optional,intent(inout):: bt(bounds%begc: , lbj: ) ! tridiagonal matrix element b + real(r8), optional,intent(inout):: ct(bounds%begc: , lbj: ) ! tridiagonal matrix element c + integer, optional,intent(in) :: botbc_type ! type of bottom boundary condition + real(r8), optional,intent(in) :: condc_botlay(bounds%begc: ) !conductance at bottom layer + + ! !LOCAL VARIABLES: + integer :: j, fc, c, k !indices + integer :: botbc_ltype !temp. variable + real(r8) ::Fl, Fr + character(len=255) :: subname='DiffusTransp_gw' + + SHR_ASSERT_ALL((ubound(jtop) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(Rfactor) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(hmconductance) == (/bounds%endc, ubj-1/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(dz) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(dtime) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(condc_toplay) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(update_col) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + + SHR_ASSERT_ALL((ubound(source) == (/bounds%endc, ubj, ntrcs/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(rt) == (/bounds%endc, ubj, ntrcs/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL(((/ubound(trcin_mobile,1),ubound(trcin_mobile,2),size(trcin_mobile,3)/) == (/bounds%endc, ubj, ntrcs/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL(((/ubound(bot_concflx,1),ubound(bot_concflx,2),size(bot_concflx,3)/) == (/bounds%endc, 2, ntrcs/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL(((/ubound(trc_concflx_air,1),ubound(trc_concflx_air,2),size(trc_concflx_air,3)/) == (/bounds%endc, 2, ntrcs/)) , errMsg(__FILE__,__LINE__)) + + + if(.not. source_only) then + SHR_ASSERT_ALL((ubound(at) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(bt) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(ct) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) + endif + !unless specified explicitly, the bottom boundary condition is given as flux + if(present(botbc_type))then + botbc_ltype = botbc_type + if(botbc_type==bndcond_as_conc)then + SHR_ASSERT_ALL((ubound(condc_botlay) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + endif + else + botbc_ltype = bndcond_as_flux + endif + + do fc = 1, numfl + !form the diffusion matrix + c = filter(fc) + if(update_col(c))then + + do j = jtop(c), ubj + do k = 1, ntrcs + if(j == jtop(c))then + !by default the top node is always assumed as snow surface, + !though when it snow free, the conductance is defined with respect to the soil + Fr = -hmconductance(c,j)*(trcin_mobile(c,j+1, k)/rfactor(c,j+1)-trcin_mobile(c,j, k)/rfactor(c,j)) + if(topbc_type == bndcond_as_conc)then + !top boundary condition given as concentration + Fl = -condc_toplay(c)*(trcin_mobile(c,j, k)/rfactor(c,j)-trc_concflx_air(c, 1, k)) + elseif(topbc_type == bndcond_as_flux)then + !top boundary condition given as flux, this only happens when the flux is given at soil surface + Fl = trc_concflx_air(c,1, k) + endif + elseif(j == ubj)then + Fl = -hmconductance(c,j-1)*(trcin_mobile(c,j,k)/rfactor(c,j)-trcin_mobile(c,j-1,k)/rfactor(c,j-1)) + if(botbc_ltype==bndcond_as_conc)then + Fr = - condc_botlay(c)*(bot_concflx(c,1,k)-trcin_mobile(c,j,k)/rfactor(c,j)) + else + Fr = bot_concflx(c,1,k) + endif + else + Fl = -hmconductance(c,j-1)*(trcin_mobile(c,j,k)/rfactor(c,j)-trcin_mobile(c,j-1,k)/rfactor(c,j-1)) + Fr = -hmconductance(c,j)*(trcin_mobile(c,j+1,k)/rfactor(c,j+1)-trcin_mobile(c,j,k)/rfactor(c,j)) + endif + rt(c,j,k) = Fl-Fr + source(c,j,k)*dz(c,j) + if(j==jtop(c) .and. topbc_type == bndcond_as_conc)then + rt(c,j,k) = rt(c,j,k)+cntheta*condc_toplay(c)*(trc_concflx_air(c, 2,k)-trc_concflx_air(c, 1,k)) + endif + if(j == ubj .and. botbc_ltype==bndcond_as_conc)then + rt(c,j,k) = rt(c,j,k) + cntheta*condc_botlay(c)*(bot_concflx(c,2,k) - bot_concflx(c,1,k)) + endif + enddo + enddo + endif + enddo + + if(source_only)return + do fc = 1, numfl + !form the diffusion matrix + c = filter(fc) + if(update_col(c))then + do j = jtop(c), ubj + if(j == jtop(c))then + if(topbc_type == bndcond_as_conc)then !top boundary condition given as concentration + bt(c,j)=dz(c,j)/dtime(c)+cntheta*(hmconductance(c,j) & + +condc_toplay(c))/Rfactor(c,j) + elseif(topbc_type == bndcond_as_flux)then !top boundary condition given as flux + bt(c,j)=dz(c,j)/dtime(c)+cntheta*hmconductance(c,j)/Rfactor(c,j) + endif + ct(c,j)=-cntheta*hmconductance(c,j)/Rfactor(c,j+1) + elseif(j==ubj)then + at(c,j)=-cntheta*hmconductance(c,j-1)/rfactor(c,j-1) + if(botbc_ltype == bndcond_as_conc)then + bt(c,j)=dz(c,j)/dtime(c)+cntheta*(hmconductance(c,j-1)+condc_botlay(c))/Rfactor(c,j) + else + bt(c,j)=dz(c,j)/dtime(c)+cntheta*hmconductance(c,j-1)/Rfactor(c,j) + endif + else + at(c,j)=-cntheta*hmconductance(c,j-1)/rfactor(c,j-1) + ct(c,j)=-cntheta*hmconductance(c,j)/rfactor(c,j+1) + bt(c,j)=dz(c,j)/dtime(c)+cntheta*(hmconductance(c,j-1)+hmconductance(c,j))/Rfactor(c,j) + endif + enddo + endif + enddo + + end subroutine DiffusTransp_gw_tridiag +!------------------------------------------------------------------------------- + subroutine DiffusTransp_gw(bounds, lbj, ubj, jtop, numfl, filter, ntrcs, trcin_mobile, & + Rfactor, hmconductance, dtime, dz, source, trc_concflx_air,condc_toplay, topbc_type,& + bot_flux, update_col, dtracer, botbc_type, condc_botlay) + ! + ! !DESCRIPTION: + ! solve the dual phase transport problem. + ! the solver returns the tracer change due to diffusive transport + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use TridiagonalMod, only : Tridiagonal + + implicit none + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds !bounds + integer , intent(in) :: lbj, ubj ! lbinning and ubing level indices + integer , intent(in) :: jtop(bounds%begc: ) ! index of upper boundary, which could be variable + integer , intent(in) :: numfl ! length of the filter + integer , intent(in) :: filter(:) ! the actual filter + integer , intent(in) :: ntrcs + real(r8) , intent(in) :: Rfactor(bounds%begc: , lbj: ) !conversion parameter from the given tracer phase to bulk mobile phase + real(r8) , intent(in) :: hmconductance(bounds%begc: , lbj: ) !weighted bulk tracer conductances + real(r8) , intent(in) :: dz(bounds%begc: , lbj: ) !node thickness + real(r8) , intent(in) :: dtime(bounds%begc: ) !time step + real(r8) , intent(in) :: condc_toplay(bounds%begc: ) !top layer conductance + integer , intent(in) :: topbc_type !type of top boundary condtion: 1, concentration, 2 flux + integer , optional, intent(in) :: botbc_type + real(r8), optional, intent(in) :: condc_botlay(bounds%begc: ) + logical , intent(in) :: update_col(bounds%begc: ) !logical switch indicating if the column is for active update + real(r8) , intent(in) :: trcin_mobile(bounds%begc: , lbj: ,1: ) ! incoming mobile tracer concentration + real(r8) , intent(in) :: source(bounds%begc: , lbj: , 1: ) !chemical sources [mol/m3] + real(r8) , intent(in) :: bot_flux(bounds%begc: , 1: , 1: ) !flux at the bottom boundary + real(r8) , intent(in) :: trc_concflx_air(bounds%begc: , 1: , 1: ) !atmospheric tracer concentration (topbc_type=1) or flux (topbc_type=2) + real(r8) , intent(inout) :: dtracer(bounds%begc: , lbj: , 1: ) !change of tracer concentration during the time step + + ! !LOCAL VARIABLES: + real(r8) :: rt(bounds%begc:bounds%endc, lbj:ubj, 1:ntrcs) !tridiagonal matrix element r + real(r8) :: at(bounds%begc:bounds%endc, lbj:ubj) !tridiagonal matrix element a + real(r8) :: bt(bounds%begc:bounds%endc, lbj:ubj) !tridiagonal matrix element b + real(r8) :: ct(bounds%begc:bounds%endc, lbj:ubj) !tridiagonal matrix element c + real(r8) :: dtracer1(bounds%begc:bounds%endc, lbj:ubj) + character(len=255) :: subname = 'DiffusTransp_gw' + integer :: kk, fc, c + + SHR_ASSERT_ALL((ubound(jtop) == (/bounds%endc/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(dtime) == (/bounds%endc/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(update_col) == (/bounds%endc/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(condc_toplay) == (/bounds%endc/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(dz) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(Rfactor ) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(hmconductance) == (/bounds%endc, ubj-1/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(source) == (/bounds%endc, ubj, ntrcs/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(dtracer) == (/bounds%endc, ubj, ntrcs/)) , errMsg(__FILE__,__LINE__)) + + SHR_ASSERT_ALL(((/ubound(trcin_mobile , 1) , ubound(trcin_mobile , 2), size(trcin_mobile , 3)/) == (/bounds%endc, ubj, ntrcs/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL(((/ubound(bot_flux , 1) , ubound(bot_flux , 2), size(bot_flux , 3)/) == (/bounds%endc, 2, ntrcs/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL(((/ubound(trc_concflx_air, 1), ubound(trc_concflx_air,2),size(trc_concflx_air,3)/) == (/bounds%endc, 2, ntrcs/)) , errMsg(__FILE__,__LINE__)) + + !assemble the tridiagonal maxtrix + if(present(botbc_type))then + SHR_ASSERT_ALL((ubound(condc_botlay) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + + call DiffusTransp_gw_tridiag(bounds, lbj, ubj, jtop, numfl, filter, ntrcs, trcin_mobile, & + Rfactor, hmconductance, dtime, dz, source, trc_concflx_air,& + condc_toplay, topbc_type, bot_flux, update_col, source_only=.false.,& + rt=rt, at=at,bt=bt,ct=ct, botbc_type=botbc_type, condc_botlay=condc_botlay) + else + call DiffusTransp_gw_tridiag(bounds, lbj, ubj, jtop, numfl, filter, ntrcs, trcin_mobile, & + Rfactor, hmconductance, dtime, dz, source, trc_concflx_air,& + condc_toplay, topbc_type, bot_flux, update_col, source_only=.false.,& + rt=rt, at=at,bt=bt,ct=ct) + endif + + !calculate the change to tracer + call Tridiagonal (bounds, lbj, ubj, jtop, numfl, filter, ntrcs, at, bt, ct, rt, dtracer, update_col) + + end subroutine DiffusTransp_gw + + !------------------------------------------------------------------------------- + subroutine Diffustransp_solid_tridiag(bounds, lbj, ubj, lbn, numfl, filter, ntrcs, trcin,& + hmconductance, dtime_col, dz, source, update_col, at,bt,ct, rt) + ! + ! !DESCRIPTION: + ! + ! Do solid phase transport with tracer source + ! + ! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use decompMod, only : bounds_type + + implicit none + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds !bounds + integer , intent(in) :: lbj, ubj ! lbinning and ubing level indices + integer , intent(in) :: lbn(bounds%begc: ) !indices of top boundary + integer , intent(in) :: numfl !filter dimension + integer , intent(in) :: filter(:) !filter + integer , intent(in) :: ntrcs + real(r8) , intent(in) :: trcin(bounds%begc: , lbj: ,1: ) !tracer concentration [mol/m3] + real(r8) , intent(in) :: hmconductance(bounds%begc: , lbj: ) !weighted conductance + real(r8) , intent(in) :: dtime_col(bounds%begc: ) !model time step + real(r8) , intent(in) :: dz(bounds%begc: , lbj: ) !layer thickness + real(r8) , intent(in) :: source(bounds%begc: , lbj: ,1: ) !chemical sources [mol/m3] + logical , intent(in) :: update_col(bounds%begc: ) !logical switch indicating if the column is for active update + real(r8) , intent(out) :: at(bounds%begc: , lbj: ) !returning tridiagonal a matrix + real(r8) , intent(out) :: bt(bounds%begc: , lbj: ) !returning tridiagonal b matrix + real(r8) , intent(out) :: ct(bounds%begc: , lbj: ) !returning tridiagonal c matrix + real(r8) , intent(out) :: rt(bounds%begc: , lbj: ,1: ) !returning tridiagonal r matrix + + !LOCAL VARIABLES: + real(r8) :: bot + integer :: j, k, fc, c + real(r8) :: Fl, Fr + real(r8) :: dtime + character(len=255) :: subname='DiffusTransp_solid_tridiag' + + SHR_ASSERT_ALL((ubound(lbn) == (/bounds%endc/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(hmconductance) == (/bounds%endc, ubj-1/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(dz) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(dtime_col) == (/bounds%endc/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(update_col) == (/bounds%endc/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(at) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(bt) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(ct) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(rt) == (/bounds%endc, ubj, ntrcs/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(source) == (/bounds%endc, ubj, ntrcs/)), errMsg(__FILE__,__LINE__)) + + SHR_ASSERT_ALL(((/ubound(trcin,1),ubound(trcin,2),size(trcin,3)/) == (/bounds%endc, ubj, ntrcs/)), errMsg(__FILE__,__LINE__)) + + + + !zero flux is imposed both at the top and bottom boundaries + !set zero outgoing flux + bot = 0._r8 + do fc = 1, numfl + c = filter(fc) + if(update_col(c))then + dtime=dtime_col(c) + do j = lbn(c), ubj + do k = 1, ntrcs + if(j==lbn(c))then + Fr=-hmconductance(c,j)*(trcin(c,j+1,k)-trcin(c,j,k)) + Fl=0._r8 !zero flux at top boundary for solid phase + elseif(j==ubj)then + !assume zero flux for diffusion + Fl=-hmconductance(c,j-1)*(trcin(c,j,k)-trcin(c,j-1,k)) + Fr=bot + else + Fl=-hmconductance(c,j-1)*(trcin(c,j,k)-trcin(c,j-1,k)) + Fr=-hmconductance(c,j)*(trcin(c,j+1,k)-trcin(c,j,k)) + endif + rt(c,j,k) = Fl-Fr + source(c,j,k)*dz(c,j) + enddo + enddo + + do j = lbn(c), ubj + if(j==lbn(c))then + !top boundary condition given as flux + at(c,j)=0._r8 + bt(c,j)=dz(c,j)/dtime+cntheta*hmconductance(c,j) + ct(c,j)=-cntheta*hmconductance(c,j) + elseif(j==ubj)then + at(c,j)=-cntheta*hmconductance(c,j-1) + bt(c,j)=dz(c,j)/dtime+cntheta*hmconductance(c,j-1) + else + at(c,j)=-cntheta*hmconductance(c,j-1) + ct(c,j)=-cntheta*hmconductance(c,j) + bt(c,j)=dz(c,j)/dtime-at(c,j)-ct(c,j) + endif + enddo + endif + enddo + + end subroutine DiffusTransp_solid_tridiag + !------------------------------------------------------------------------------- + + subroutine DiffusTransp_solid(bounds, lbj, ubj, lbn, numfl, filter, ntrcs, trcin,& + hmconductance, dtime_col, dz, source, update_col, dtracer) + ! + ! !DESCRIPTION: + ! Do diffusive solid phase tracer transport + ! + ! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use decompMod, only : bounds_type + use TridiagonalMod, only : Tridiagonal + + implicit none + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds ! bounds + integer , intent(in) :: lbj, ubj ! lbinning and ubing level indices + integer , intent(in) :: lbn(bounds%begc: ) ! indices of top boundary + integer , intent(in) :: numfl ! filter dimension + integer , intent(in) :: filter(:) ! filter + integer , intent(in) :: ntrcs + real(r8) , intent(in) :: hmconductance(bounds%begc: , lbj: ) ! weighted conductance + real(r8) , intent(in) :: dtime_col(bounds%begc: ) ! model time step + real(r8) , intent(in) :: dz(bounds%begc: , lbj: ) ! layer thickness + real(r8) , intent(in) :: trcin (bounds%begc: , lbj: , 1: ) ! tracer concentration [mol/m3] + real(r8) , intent(in) :: source(bounds%begc: , lbj: , 1: ) ! chemical sources [mol/m3/s] + logical , intent(in) :: update_col(bounds%begc: ) ! logical switch indicating if the column is for active update + real(r8), intent(inout) :: dtracer(bounds%begc: , lbj: ,1: ) ! update to the tracer + + ! !LOCAL VARIABLES: + real(r8) :: at(bounds%begc:bounds%endc, lbj:ubj) !returning tridiagonal a matrix + real(r8) :: bt(bounds%begc:bounds%endc, lbj:ubj) !returning tridiagonal b matrix + real(r8) :: ct(bounds%begc:bounds%endc, lbj:ubj) !returning tridiagonal c matrix + real(r8) :: rt(bounds%begc:bounds%endc, lbj:ubj, 1:ntrcs) !returning tridiagonal r matrix + character(len=255) :: subname = 'DiffusTransp_solid' + + SHR_ASSERT_ALL((ubound(lbn) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(hmconductance) == (/bounds%endc, ubj-1/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(dz) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(update_col) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(dtime_col) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(dtracer) == (/bounds%endc, ubj, ntrcs/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(source) == (/bounds%endc, ubj, ntrcs/)), errMsg(__FILE__,__LINE__)) + + SHR_ASSERT_ALL(((/ubound(trcin,1),ubound(trcin,2),size(trcin,3)/) == (/bounds%endc, ubj,ntrcs/)), errMsg(__FILE__,__LINE__)) + + + !assemble the tridiagonal matrix + call Diffustransp_solid_tridiag(bounds, lbj, ubj, lbn, numfl, filter, ntrcs, trcin,& + hmconductance, dtime_col, dz, source, update_col, at,bt,ct, rt) + + !calculate the change to tracer + call Tridiagonal (bounds, lbj, ubj, lbn, numfl, filter, ntrcs, at, bt, ct, rt, dtracer, update_col) + + end subroutine DiffusTransp_solid + !------------------------------------------------------------------------------- + function calc_col_CFL(lbj, ubj, us, dx, dtime) result(cfl) + ! + ! DESCRIPTION: + ! calculate the CFL number for the given grid and velocity field + ! this subroutine is now not actively used, but can be used + ! when a Eulerian advection scheme is adopted. + implicit none + ! !ARGUMENTS: + integer, intent(in) :: lbj, ubj !left and right bounds + real(r8), intent(in) :: us(lbj: ) !velocity vector, [m/s] + real(r8), intent(in) :: dx(lbj: ) !node length, [m] + real(r8), intent(in) :: dtime !imposed time step, [s] + + ! !LOCAL VARIABLES: + real(r8) :: cfl + integer :: len, j + character(len=32) :: subname ='calc_col_CFL' + + SHR_ASSERT_ALL((ubound(us) == (/ubj+1/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(dx) == (/ubj/)), errMsg(__FILE__,__LINE__)) + + cfl = 0._r8 + !the column cfl number is defined as the maximum over the whole domain + do j = lbj, ubj + if(us(j)>0._r8)then + if(us(j)<0._r8)then + cfl= max(dtime/dx(j)*max(abs(us(j)), abs(us(j+1))), cfl) + else + cfl=max(abs(dtime*us(j)/dx(j)), cfl) + endif + else + if(us(j+1)>0._r8)then + cfl=max(abs(dtime*us(j+1)/dx(j)),cfl) + else + cfl= max(dtime/dx(j)*max(abs(us(j)), abs(us(j+1))), cfl) + endif + endif + enddo + end function calc_col_CFL + + !------------------------------------------------------------------------------- + subroutine semi_lagrange_adv_backward(bounds, lbj, ubj, lbn, numfl, filter, ntrcs, dtime, dz, & + zi, us, inflx_top, inflx_bot, update_col, halfdt_col, trcin, trcou, leaching_mass) + ! + ! DESCRIPTION: + ! do semi-lagrangian advection for equation + ! pu/pt+c*pu/px=0 + ! for a certain tracer group + ! + ! !USES: + use shr_kind_mod, only : r8 => shr_kind_r8 + use decompMod, only : bounds_type + use MathfuncMod, only : cumsum, cumdif, safe_div, dot_sum, asc_sort_vec + use InterpolationMod, only : pchip_polycc, pchip_interp + + implicit none + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds !bounds + integer , intent(in) :: lbj, ubj ! lbinning and ubing level indices + integer , intent(in) :: lbn(bounds%begc: ) !label of the top/left boundary + integer , intent(in) :: numfl + integer , intent(in) :: ntrcs + integer , intent(in) :: filter(:) + real(r8) , intent(in) :: dtime(bounds%begc: ) + real(r8) , intent(in) :: zi(bounds%begc: , lbj-1: ) + real(r8) , intent(in) :: dz(bounds%begc: , lbj: ) + real(r8) , intent(in) :: inflx_top(bounds%begc: , 1: ) ! incoming tracer flow at top boundary [mol/m2/s] + real(r8) , intent(in) :: inflx_bot(bounds%begc: , 1: ) !incoming tracer flow at bottom boundary + logical , intent(in) :: update_col(bounds%begc: ) !indicator of active clumns + real(r8) , intent(in) :: us(bounds%begc: , lbj-1: ) !convective flux defined at the boundary, positive downwards, [m/s] + logical , intent(out) :: halfdt_col(bounds%begc:bounds%endc) + real(r8) , intent(in) :: trcin(bounds%begc: , lbj: , 1: ) !input tracer concentration + real(r8) , intent(out) :: trcou(bounds%begc: , lbj: , 1: ) + real(r8), optional, intent(out) :: leaching_mass(bounds%begc: , 1: ) !leaching tracer mass + + ! !LOCAL VARIABLES: + integer, parameter :: pn = 2 !first order lagrangian interpolation to avoid overshooting + integer :: j, fc, c, k + integer :: ntr !indices for tracer + integer :: length, lengthp2 + real(r8) :: mass_curve(0:ubj-lbj+5 , ntrcs) !total number of nodes + two ghost cells at each boundary + real(r8) :: cmass_curve(0:ubj-lbj+5, ntrcs) + real(r8) :: mass_new(1:ubj-lbj+1 , ntrcs) + real(r8) :: cmass_new(0:ubj-lbj+1 , ntrcs) + real(r8) :: zold(0:ubj-lbj+1) + real(r8) :: di(0:ubj-lbj+5) + real(r8) :: zghostl(1:2) !ghost grid left interface at the left boundary + real(r8) :: zghostr(1:2) !ghost grid left interface at the right boundary + real(r8) :: ughostl(1:2) !flow velocity at the ghost grid leff interface at the left boundary + real(r8) :: ughostr(1:2) !flow velocity at the ghost grid leff interface at the right boundary + real(r8) :: z0 + real(r8) :: zf + real(r8) :: utmp + real(r8) :: dinfl_mass + character(len=32) :: subname='semi_lagrange_adv_backward' + + SHR_ASSERT_ALL((ubound(lbn) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(dtime) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(dz) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(update_col) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(us) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(zi) == (/bounds%endc, ubj/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(inflx_top) == (/bounds%endc, ntrcs/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(inflx_bot) == (/bounds%endc, ntrcs/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(leaching_mass) == (/bounds%endc,ntrcs/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(trcou) == (/bounds%endc, ubj,ntrcs/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL(((/ubound(trcin,1),ubound(trcin,2),size(trcin,3)/) == (/bounds%endc, ubj,ntrcs/)), errMsg(__FILE__,__LINE__)) + + call Extra_inst%InitAllocate(1,ubj-lbj+6) + halfdt_col(:) = .false. + do fc = 1, numfl + + c = filter(fc) + if(.not. update_col(c))cycle + !do backward advection for all boundaries, including leftmost (lbn(c)-1) and rightmost (ubj) + length = ubj - lbn(c) + 1 !total number of grid cells + lengthp2 = length + 4 ! add 2 ghost cells both at the left and right boundaries + + !define ghost boundary + !NOTE: because of the setup, the left boundary and right boundary should have non-zero flow + utmp = us(c,lbn(c)-1) + zghostl(1) = -abs(utmp)*dtime(c)*2._r8 + zi(c,lbn(c)-1)-2.e-20_r8 + zghostl(2) = -abs(utmp)*dtime(c) + zi(c,lbn(c)-1)-1.e-20_r8 + ughostl(1) = us(c,lbn(c)-1) + ughostl(2) = us(c,lbn(c)-1) + + zghostr(1) = zi(c,ubj) + abs(us(c,ubj)) * dtime(c) + 1.e-14_r8 + zghostr(2) = zi(c,ubj) + abs(us(c,ubj)) * dtime(c) * 2._r8+ 2.e-14_r8 + + ughostr(1) = us(c,ubj) + ughostr(2) = us(c,ubj) + + call backward_advection((/zghostl, zi(c, lbn(c)-1:ubj),zghostr/), (/ughostl, us(c, lbn(c)-1:ubj), ughostr/), dtime(c), zold(0:length)) + + if(.not. is_ascending_vec(zold(0:length)))then + halfdt_col(c) = .true. + cycle + endif + + !create the cumulative mass curve + do ntr = 1, ntrcs + !left boundary ghost grids + j = 0 + mass_curve(j, ntr) = 0._r8 + j = 1 + mass_curve(j, ntr) = inflx_top(c, ntr)*dtime(c) + j = 2 + mass_curve(j, ntr) = inflx_top(c, ntr)*dtime(c) + + !regular grids + do k = lbn(c), ubj + j = k - lbn(c) + 3 + mass_curve(j, ntr) = trcin(c,k, ntr)*dz(c,k) + enddo + + !right ghost grids + if(inflx_bot(c,ntr)==0._r8)then + j = ubj - lbn(c) + 4 + mass_curve(j, ntr) = trcin(c,ubj, ntr)*(zghostr(1)-zi(c,ubj)) + + j = ubj - lbn(c) + 5 + mass_curve(j, ntr) = trcin(c,ubj, ntr)*(zghostr(2)-zghostr(1)) + else + j = ubj - lbn(c) + 4 + mass_curve(j, ntr) = inflx_bot(c, ntr) * dtime(c) + + j = ubj - lbn(c) + 5 + mass_curve(j, ntr) = inflx_bot(c, ntr) * dtime(c) + endif + enddo + !compute cumulative mass curve + call cumsum(mass_curve(0:lengthp2,1:ntr), cmass_curve(0:lengthp2, 1:ntr),idim=1) + + !do mass interpolation + do ntr = 1, ntrcs + call pchip_polycc((/zghostl,zi(c,lbn(c)-1:ubj),zghostr/), cmass_curve(0:lengthp2, ntr), di(0:lengthp2)) + + call pchip_interp((/zghostl,zi(c,lbn(c)-1:ubj),zghostr/), cmass_curve(0:lengthp2, ntr), di(0:lengthp2),& + zold(0:length), cmass_new(0:length, ntr)) + + !ensure mass is increasing monotonically + call asc_sort_vec(cmass_new(0:length,ntr)) + + !ensure no negative leaching + call cmass_mono_smoother(cmass_new(0:length, ntr),cmass_curve(ubj-lbn(c)+3, ntr)) + + !diagnose the leaching flux + if(present(leaching_mass))then + leaching_mass(c, ntr) = cmass_curve(ubj-lbn(c)+3, ntr)-cmass_new(length, ntr) !add the numerical error to leaching + endif + + !obtain the grid concentration + call cumdif(cmass_new(0:length, ntr), mass_new(0:length, ntr)) + do k = lbn(c), ubj + j = k - lbn(c) + 1 + !correct for small negative values + if(mass_new(j, ntr)<0._r8)then + write(iulog,*)j,mass_new(j, ntr),cmass_new(j, ntr),cmass_new(j-1, ntr) + call endrun('negative tracer '//errMsg(__FILE__, __LINE__)) + if(present(leaching_mass))then + leaching_mass(c, ntr) = leaching_mass(c, ntr)+mass_new(j, ntr) !add the numerical error to leaching + endif + mass_new(j, ntr)=mass_curve_correct(mass_new(j, ntr)) + endif + trcou(c,k, ntr)=mass_new(j, ntr)/dz(c,k) + enddo + enddo + + enddo + call Extra_inst%DDeallocate() + end subroutine semi_lagrange_adv_backward + !------------------------------------------------------------------------------- + subroutine cmass_mono_smoother(cmass,mass_thc) + ! + ! !DESCRIPTION: + ! assuming cmass is sorted as ascending vector, make sure no mass is greater than mass_thc + ! + implicit none + ! !ARGUMENTS: + real(r8), dimension(:), intent(inout) :: cmass + real(r8), intent(in) :: mass_thc + ! !LOCAL VARIABLES: + integer :: n , j + character(len=32) :: subname = 'cmass_mono_smoother' + + n = size(cmass) + do j = n, 1 + if(cmass(j)>=mass_thc)then + cmass(j) = mass_thc + else + exit + endif + enddo + end subroutine cmass_mono_smoother + !------------------------------------------------------------------------------- + + function is_ascending_vec(zcor)result(ans) + ! + ! DESCRIPTION: + ! check if it is an ascending array + + implicit none + ! !ARGUMENTS: + real(r8), dimension(:), intent(in) :: zcor + + ! !LOCAL VARIABLES: + logical :: ans + integer :: j, n + character(len=32) :: subname= 'is_ascending_vec' + + n = size(zcor) + ans = .true. + do j = 2 , n + if(zcor(j) shr_log_errMsg + implicit none + save + private ! By default everything is public + + public :: betr_initialize + public :: betr_readNL + character(len=32) :: bgc_method='mock_run' + + ! + !----------------------------------------- + ! Instances of component types + !----------------------------------------- + type(BeTRtracer_type) , public :: betrtracer_vars + type(TracerCoeff_type) , public :: tracercoeff_vars + type(TracerFlux_type) , public :: tracerflux_vars + type(TracerState_type) , public :: tracerState_vars + type(tracerboundarycond_type) , public :: tracerboundarycond_vars + type(plantsoilnutrientflux_type) , public :: plantsoilnutrientflux_vars + class(bgc_reaction_type),allocatable , public :: bgc_reaction + +contains + + !------------------------------------------------------------------------------- + subroutine betr_readNL(NLFilename) + ! + ! !DESCRIPTION: + ! read namelist for betr configuration + ! !USES: + use spmdMod , only : masterproc, mpicom + use fileutils , only : getavu, relavu, opnfil + use shr_nl_mod , only : shr_nl_find_group_name + use shr_mpi_mod , only : shr_mpi_bcast + implicit none + ! !ARGUMENTS: + character(len=*), intent(IN) :: NLFilename ! Namelist filename + ! + ! !LOCAL VARIABLES: + integer :: ierr ! error code + integer :: unitn ! unit for namelist file + character(len=32) :: subname = 'betr_readNL' ! subroutine name + !----------------------------------------------------------------------- + + namelist / betr_inparm / bgc_method + + ! ---------------------------------------------------------------------- + ! Read namelist from standard input. + ! ---------------------------------------------------------------------- + + if ( masterproc )then + + unitn = getavu() + write(iulog,*) 'Read in betr_inparm namelist' + call opnfil (NLFilename, unitn, 'F') + call shr_nl_find_group_name(unitn, 'clm_CanopyHydrology_inparm', status=ierr) + if (ierr == 0) then + read(unitn, betr_inparm, iostat=ierr) + if (ierr /= 0) then + call endrun(msg="ERROR reading betr_inparm namelist"//errmsg(__FILE__, __LINE__)) + end if + end if + call relavu( unitn ) + + end if + ! Broadcast namelist variables read in + call shr_mpi_bcast(bgc_method, mpicom) + + end subroutine betr_readNL + + !------------------------------------------------------------------------------- + subroutine betr_initialize(bounds, lbj, ubj, waterstate_vars) + ! + ! !DESCRIPTION: + ! Initialize BeTR + ! + ! !USES: + use decompMod , only : bounds_type + use BGCReactionsFactoryMod, only : ctreate_bgc_reaction_type + use BetrBGCMod , only : betrbgc_init + use TransportMod , only : init_transportmod + use TracerParamsMod , only : tracer_param_init + use WaterstateType , only : waterstate_type + + implicit none + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: lbj, ubj + type(waterstate_type), intent(in) :: waterstate_vars + + call betrtracer_vars%init_scalars() + + allocate(bgc_reaction, source=ctreate_bgc_reaction_type(bgc_method)) + + call bgc_reaction%Init_betrbgc(bounds, lbj, ubj, betrtracer_vars) + + call init_transportmod + + call tracerState_vars%Init(bounds, lbj, ubj, betrtracer_vars) + + call tracerflux_vars%Init(bounds, lbj, ubj, betrtracer_vars) + + call tracercoeff_vars%Init(bounds, lbj, ubj, betrtracer_vars) + + call tracerboundarycond_vars%Init(bounds, betrtracer_vars) + + call plantsoilnutrientflux_vars%Init(bounds, lbj, ubj) + + !initialize state variable + call bgc_reaction%initCold(bounds, betrtracer_vars, waterstate_vars, tracerstate_vars) + + !initialize boundary condition type + call bgc_reaction%init_boundary_condition_type(bounds, betrtracer_vars, tracerboundarycond_vars) + + !initialize the betr parameterization module + call tracer_param_init(bounds) + + !initialize the betrBGC module + call betrbgc_init(bounds, betrtracer_vars) + + end subroutine betr_initialize + !--------------------------------------------------------------------------------- + +end module betr_initializeMod diff --git a/components/clm/src/betr/betr_math/FindRootMod.F90 b/components/clm/src/betr/betr_math/FindRootMod.F90 new file mode 100644 index 000000000000..5b3395d62deb --- /dev/null +++ b/components/clm/src/betr/betr_math/FindRootMod.F90 @@ -0,0 +1,935 @@ +module FindRootMod + ! + ! !DESCRIPTION: + ! Functions to solve simple equations + ! History: created by Jinyun Tang, 2013 + + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use abortutils , only : endrun + use clm_varctl , only : iulog + use MathfuncMod , only : is_bounded + implicit none + interface hybrid_findroot + module procedure hybrid_findroot_np, hybrid_findroot_p + end interface hybrid_findroot + + interface brent + module procedure brent_np, brent_p + end interface brent + +contains + !------------------------------------------------------------------------------- + function quadrootbnd(a,b,c, xl, xr)result(x) + ! + ! !DESCRIPTION: + ! return a root of the qudratic equation + ! within bound xl and xr + + implicit none + ! !ARGUMENTS: + real(r8), intent(in) :: a, b, c + real(r8), intent(in) :: xl, xr + + ! !LOCAL VARIABLES: + real(r8) :: x + real(r8) :: delta + character(len=32) :: subname ='quadrootbnd' + + delta = b * b -4._r8 * a * c + if(delta>=0._r8)then + x = (-b + sqrt(delta))/2._r8 + if(is_bounded(x,xl,xr))then + return + else + x = (-b - sqrt(delta))/2._r8 + if(is_bounded(x,xl,xr))then + return + else + write(iulog,*)'no bounded solution for the given quadratic equation' + call endrun(msg=errmsg(__FILE__, __LINE__)) + endif + endif + else + write(iulog,*)'no real solution for the given quadratic equation' + call endrun(msg=errmsg(__FILE__, __LINE__)) + endif + return + end function quadrootbnd + + !------------------------------------------------------------------------------- + + function quadproot(a,b,c)result(x) + ! + ! !DESCRIPTION: + ! return positive root of the qudratic equation + + implicit none + ! !ARGUMENTS: + real(r8), intent(in) :: a, b, c + + ! !LOCAL VARIABLES: + real(r8) :: x + real(r8) :: delta + character(len=32) :: subname ='quadproot' + + delta = b * b -4._r8 * a * c + if(delta>=0._r8)then + x = (-b + sqrt(delta))/2._r8 + else + write(iulog,*)'no positive solution for the given quadratic equation' + call endrun(msg=errmsg(__FILE__, __LINE__)) + endif + return + end function quadproot + !=============================================================================== + + function cubicrootbnd(a,b,c,d, xl, xr)result(x) + ! + ! !DESCRIPTION: + ! return positive root of the cubic equation + ! + ! !USES: + use clm_varcon , only : rpi + implicit none + ! !ARGUMENTS: + real(r8), intent(in) :: a, b, c, d + real(r8), intent(in) :: xl, xr + + ! !LOCAL VARIABLES: + real(r8) :: x + real(r8) :: p, q + real(r8) :: b1, c1, d1 + real(r8) :: n, u, f, y + real(r8) :: delta + character(len=32) :: subname ='cubicrootbnd' + + b1 = b/a + c1 = c/a + d1 = d/a + + p = c1 - b1 * b1 /3._r8 + q = d1 - b1 / 3._r8 * (c1 - 2._r8 * b1**2._r8/9._r8) + + delta =-4._r8 * p**3._r8 - 27._r8 * q ** 2._r8 + if(delta<0._r8)then + write(iulog,*)'no real solution for the given cubic equation' + call endrun(msg=errmsg(__FILE__, __LINE__)) + else + n = sqrt(-4._r8*p/3._r8) + f = -q/2._r8 * (-p/3._r8)**(-1.5_r8) + u = acos(f)/3._r8 + + y = n * cos(u) + x = y - b1 / 3._r8 + if(is_bounded(x,xl,xr))then + return + else + y = n * max(cos(u), cos(u-rpi*2._r8/3._r8)) + x = y - b1 /3._r8 + if(is_bounded(x,xl,xr))then + return + else + y = n * cos(u-rpi*2._r8/3._r8) + x = y - b1 / 3._r8 + if(is_bounded(x,xl,xr))then + return + else + write(iulog,*)'no bounded solution for the given cubic equation' + call endrun(msg=errmsg(__FILE__, __LINE__)) + endif + endif + endif + + endif + end function cubicrootbnd + + !=============================================================================== + function cubicproot(a,b,c,d)result(x) + ! + ! !DESCRIPTION: + ! return positive root of the cubic equation + ! + ! !USES: + use clm_varcon , only : rpi + implicit none + ! !ARGUMENTS: + real(r8), intent(in) :: a, b, c, d + ! !LOCAL VARIABLES: + real(r8) :: x + real(r8) :: p, q + real(r8) :: b1, c1, d1 + real(r8) :: n, u, f, y + real(r8) :: delta + b1 = b/a + c1 = c/a + d1 = d/a + + p = c1 - b1 * b1 /3._r8 + q = d1 - b1 / 3._r8 * (c1 - 2._r8 * b1**2._r8/9._r8) + + delta =-4._r8 * p**3._r8 - 27._r8 * q ** 2._r8 + if(delta<0._r8)then + write(iulog,*)'no real solution for the given cubic equation' + call endrun(msg=errmsg(__FILE__, __LINE__)) + else + n = sqrt(-4._r8*p/3._r8) + f = -q/2._r8 * (-p/3._r8)**(-1.5_r8) + u = acos(f)/3._r8 + + if(u<=rpi/3._r8)then + y = n * cos(u) + elseif(u>rpi/3._r8 .and. u < rpi/2._r8)then + !return the maximum of the two non-negative solutions + y = n * max(cos(u), cos(u-rpi*2._r8/3._r8)) + else + y = n * cos(u-rpi*2._r8/3._r8) + endif + x = y - b1 / 3._r8 + endif + end function cubicproot + + !=============================================================================== + + subroutine LUsolvAxr(a,r, n) + ! !DESCRIPTION: + !solve linear equation Ax=r, using the LU decomposition + implicit none + ! !ARGUMENTS: + real(r8) , intent(inout) :: a(n,n) + real(r8) , intent(inout) :: r(n) + integer , intent(in) :: n + + ! !LOCAL VARIABLES: + real(r8) :: d(n) + integer :: indx(n) + + !do lu decomposition + call ludcmp(a,indx,d,n) + + !solve for the equation + + call lubksb(a,indx,r,n) + end subroutine LUsolvAxr + !=============================================================================== + + subroutine lubksb(a,indx,b,n) + ! + ! !DESCRIPTION: + ! Solves the set of N linear equations A X = B. Here the N x N matrix a is input, not + ! as the original matrix A, but rather as its LU decomposition, determined by the routine + ! ludcmp. indx is input as the permutation vector of length N returned by ludcmp. b is + ! input as the right-hand-side vector B, also of length N, and returns with the solution vector + ! X. a and indx are not modified by this routine and can be left in place for successive calls + ! with different right-hand sides b. This routine takes into account the possibility that b will + ! begin with many zero elements, so it is efficient for use in matrix inversion. + + implicit none + ! !ARGUMENTS: + real(r8) , intent(in) :: a(n,n) + integer , intent(in) :: indx(n) + real(r8) , intent(inout) :: b(n) + integer , intent(in) :: n + + ! !LOCAL VARIABLES: + integer :: i,ii,ll + real(r8) :: summ + + ii=0 !When ii is set to a positive value, it will become the index + ! of the first nonvanishing element of b. We now do + ! the forward substitution, equation (2.3.6). The only new + ! wrinkle is to unscramble the permutation as we go. + do i=1,n + ll=indx(i) + summ=b(ll) + b(ll)=b(i) + if (ii /= 0) then + summ=summ-dot_product(a(i,ii:i-1),b(ii:i-1)) + else if (summ /= 0.0) then + ii=i !A nonzero element was encountered, so from now on we will + end if !have to do the dot product above. + b(i)=summ + end do + do i=n,1,-1 !Now we do the backsubstitution, equation (2.3.7). + b(i) = (b(i)-dot_product(a(i,i+1:n),b(i+1:n)))/a(i,i) + end do + end subroutine lubksb + !=============================================================================== + + + subroutine ludcmp(a,indx,d,n) + ! !DESCRIPTION: + ! + ! LU docomposition + ! adapted from Numerical recipe, chptB2 + ! Given an N by N input matrix a, this routine replaces it by the LU decomposition of a + ! rowwise permutation of itself. On output, a is arranged as in equation (2.3.14); indx is an + ! output vector of length N that records the row permutation effected by the partial pivoting; + ! d is output as �1 depending on whether the number of row interchanges was even or odd, + ! respectively. This routine is used in combination with lubksb to solve linear equations or + ! invert a matrix. + ! + ! !USES: + use MathfuncMod, only : swap + implicit none + ! !ARGUMENTS: + real(r8), intent(inout) :: a(n,n) + integer , intent(out) :: indx(n) + real(r8) , intent(out) :: d(n) + integer , intent(in) :: n + + ! !LOCAL VARIABLES: + real(r8), dimension(size(a,1)) :: vv !vv stores the implicit scaling of each row. + real(r8), parameter :: TINY=1.0e-20 !A small number. + integer :: j,imax + + + d=1.0 !No row interchanges yet. + vv=maxval(abs(a),dim=2) !Loop over rows to get the implicit scaling + if (any(vv == 0.0)) then + write(6,*)'singular matrix in ludcmp' !information. + stop + endif + !There is a row of zeros. + vv=1.0 / vv !Save the scaling. + do j=1,n + imax=(j-1)+imaxloc(vv(j:n)*abs(a(j:n,j))) !Find the pivot row. + if (j /= imax) then !Do we need to interchange rows? + call swap(a(imax,:),a(j,:)) !Yes, do so... + d=-d !...and change the parity of d. + vv(imax)=vv(j) !Also interchange the scale factor. + end if + indx(j)=imax + if (a(j,j) == 0.0) a(j,j)=TINY + ! If the pivot element is zero the matrix is singular (at least to the precision of the algorithm). + ! For some applications on singular matrices, it is desirable to substitute TINY + ! for zero. + a(j+1:n,j)=a(j+1:n,j)/a(j,j) !Divide by the pivot element. + a(j+1:n,j+1:n)=a(j+1:n,j+1:n)-outerprod(a(j+1:n,j),a(j,j+1:n)) + !Reduce remaining submatrix. + end do + end subroutine ludcmp + !=============================================================================== + function imaxloc(arr) + ! + ! !DESCRIPTION: + ! locate the maximum in a vector + + implicit none + ! !ARGUMENTS: + real(r8), dimension(:), intent(in) :: arr + + ! !LOCAL VARIABLES: + integer :: imaxloc + integer, dimension(1) :: imax + + imax=maxloc(arr(:)) + imaxloc=imax(1) + + end function imaxloc + + !=============================================================================== + + function outerprod(a,b) + ! !DESCRIPTION: + ! do out product of two vectors + + implicit none + ! !ARGUMENTS: + real(r8), dimension(:), intent(in) :: a,b + + ! !LOCAL VARIABLES: + real(r8), dimension(size(a),size(b)) :: outerprod + + outerprod = spread(a,dim=2,ncopies=size(b)) * & + spread(b,dim=1,ncopies=size(a)) + + end function outerprod + !------------------------------------------------------------------------------- + !BOP + ! + ! !IROUTINE: brent + ! + ! !INTERFACE: + + subroutine brent_p(x, x1,x2,f1, f2, macheps, tol, pp, func) + + ! + !!DESCRIPTION: + !Use Brent's method to find the root of a single variable function func, which is known to exist between x1 and x2. + !The found root will be updated until its accuracy is tol. + + !!REVISION HISTORY: + !Dec 14/2012: Jinyun Tang, modified from numerical recipes in F90 by press et al. 1188-1189 + ! + !!USES: + + + ! + !!ARGUMENTS: + implicit none + real(r8), intent(in) :: x1, x2, f1, f2 !minimum and maximum of the variable domain to search for the solution ci_func(x1) = f1, ci_func(x2)=f2 + real(r8), intent(in) :: macheps !machine precision + integer, intent(in) :: pp !index argument used by subroutine func + real(r8), intent(in) :: tol !the error tolerance + real(r8), intent(out):: x !indepedent variable of the single value function func(x) + + interface + subroutine func(x,f, pp) + use shr_kind_mod , only : r8 => shr_kind_r8 + implicit none + real(r8), intent(in) :: x + real(r8), intent(out) :: f + integer, intent(in) :: pp + end subroutine func + end interface + + ! !LOCAL VARIABLES: + integer, parameter :: ITMAX = 40 !maximum number of iterations + integer :: iter + real(r8) :: a,b,c,d,e,fa,fb,fc,p,q,r,s,xm,tol1 + + + a=x1 + b=x2 + fa=f1 + fb=f2 + if((fa > 0._r8 .and. fb > 0._r8).or.(fa < 0._r8 .and. fb < 0._r8))then + write(iulog,*) 'root must be bracketed for brent' + write(iulog,*) 'a=',a,' b=',b,' fa=',fa,' fb=',fb + call endrun(msg=errmsg(__FILE__, __LINE__)) + endif + c=b + fc=fb + iter = 0 + do + if(iter==ITMAX)exit + iter=iter+1 + if((fb > 0._r8 .and. fc > 0._r8) .or. (fb < 0._r8 .and. fc < 0._r8))then + c=a !Rename a, b, c and adjust bounding interval d. + fc=fa + d=b-a + e=d + endif + if( abs(fc) < abs(fb)) then + a=b + b=c + c=a + fa=fb + fb=fc + fc=fa + endif + tol1=2._r8*macheps*abs(b)+0.5_r8*tol !Convergence check. + xm=0.5_r8*(c-b) + if(abs(xm) <= tol1 .or. fb == 0.)then + x=b + return + endif + if(abs(e) >= tol1 .and. abs(fa) > abs(fb)) then + s=fb/fa !Attempt inverse quadratic interpolation. + if(a == c) then + p=2._r8*xm*s + q=1._r8-s + else + q=fa/fc + r=fb/fc + p=s*(2._r8*xm*q*(q-r)-(b-a)*(r-1._r8)) + q=(q-1._r8)*(r-1._r8)*(s-1._r8) + endif + if(p > 0._r8) q=-q !Check whether in bounds. + p=abs(p) + if(2._r8*p < min(3._r8*xm*q-abs(tol1*q),abs(e*q))) then + e=d !Accept interpolation. + d=p/q + else + d=xm !Interpolation failed, use bisection. + e=d + endif + else !Bounds decreasing too slowly, use bisection. + d=xm + e=d + endif + a=b !Move last best guess to a. + fa=fb + if(abs(d) > tol1) then !Evaluate new trial root. + b=b+d + else + b=b+sign(tol1,xm) + endif + call func(b,fb, pp) + if(fb==0._r8)exit + enddo + if(iter==ITMAX)write(iulog,*) 'brent exceeding maximum iterations', b, fb + x=b + + end subroutine brent_p + !------------------------------------------------------------------------------ + !BOP + ! + ! !IROUTINE: brent + ! + ! !INTERFACE: + + subroutine brent_np(x, x1,x2,f1, f2, macheps, tol,func) + + ! + !!DESCRIPTION: + !Use Brent's method to find the root to a single variable function func, which is known to exist between x1 and x2. + !The found root will be updated until its accuracy is tol. + + !!REVISION HISTORY: + !Dec 14/2012: Jinyun Tang, modified from numerical recipes in F90 by press et al. 1188-1189 + ! + !!USES: + + ! + !!ARGUMENTS: + implicit none + real(r8), intent(in) :: x1, x2, f1, f2 !minimum and maximum of the variable domain to search for the solution ci_func(x1) = f1, ci_func(x2)=f2 + real(r8), intent(in) :: macheps !machine precision + real(r8), intent(in) :: tol !the error tolerance + real(r8), intent(out):: x + interface + subroutine func(x,f) + use shr_kind_mod , only : r8 => shr_kind_r8 + implicit none + real(r8), intent(in) :: x + real(r8), intent(out) :: f + end subroutine func + end interface + + ! !CALLED FROM: + ! whenever it is needed + + integer, parameter :: ITMAX = 40 !maximum number of iterations + integer, parameter :: iulog = 6 + integer :: iter + real(r8) :: a,b,c,d,e,fa,fb,fc,p,q,r,s,xm,tol1 + + + a=x1 + b=x2 + fa=f1 + fb=f2 + if((fa > 0._r8 .and. fb > 0._r8).or.(fa < 0._r8 .and. fb < 0._r8))then + write(iulog,*) 'root must be bracketed for brent' + write(iulog,*) 'a=',a,' b=',b,' fa=',fa,' fb=',fb + call endrun(msg=errmsg(__FILE__, __LINE__)) + endif + c=b + fc=fb + iter = 0 + do + if(iter==ITMAX)exit + iter=iter+1 + if((fb > 0._r8 .and. fc > 0._r8) .or. (fb < 0._r8 .and. fc < 0._r8))then + c=a !Rename a, b, c and adjust bounding interval d. + fc=fa + d=b-a + e=d + endif + if( abs(fc) < abs(fb)) then + a=b + b=c + c=a + fa=fb + fb=fc + fc=fa + endif + tol1=2._r8*macheps*abs(b)+0.5_r8*tol !Convergence check. + xm=0.5_r8*(c-b) + if(abs(xm) <= tol1 .or. fb == 0.)then + x=b + return + endif + if(abs(e) >= tol1 .and. abs(fa) > abs(fb)) then + s=fb/fa !Attempt inverse quadratic interpolation. + if(a == c) then + p=2._r8*xm*s + q=1._r8-s + else + q=fa/fc + r=fb/fc + p=s*(2._r8*xm*q*(q-r)-(b-a)*(r-1._r8)) + q=(q-1._r8)*(r-1._r8)*(s-1._r8) + endif + if(p > 0._r8) q=-q !Check whether in bounds. + p=abs(p) + if(2._r8*p < min(3._r8*xm*q-abs(tol1*q),abs(e*q))) then + e=d !Accept interpolation. + d=p/q + else + d=xm !Interpolation failed, use bisection. + e=d + endif + else !Bounds decreasing too slowly, use bisection. + d=xm + e=d + endif + a=b !Move last best guess to a. + fa=fb + if(abs(d) > tol1) then !Evaluate new trial root. + b=b+d + else + b=b+sign(tol1,xm) + endif + call func(b, fb) + if(fb==0._r8)exit + enddo + if(iter==ITMAX)write(iulog,*) 'brent exceeding maximum iterations', b, fb + x=b + + end subroutine brent_np + + !------------------------------------------------------------------------------------ + subroutine hybrid_findroot_p(x0, p, iter, func) + ! + !! DESCRIPTION: + ! use a hybrid solver to find the root of equation + ! f(x) = x- h(x), + ! s.t. f(x) = 0. + !the hybrid approach combines the strength of the newton secant approach (find the solution domain) + !and the bisection approach implemented with the Brent's method to guarrantee convergence. + ! + !! REVISION HISTORY: + !Apr 14/2013: created by Jinyun Tang + + implicit none + ! !ARGUMENTS: + real(r8) , intent(inout) :: x0 !solution's initial guess + integer , intent(in) :: p !index used in the function + integer , intent(out) :: iter !number of used iterations + interface + subroutine func(x,f,p) + use shr_kind_mod , only : r8 => shr_kind_r8 + implicit none + real(r8), intent(in) :: x + real(r8), intent(out) :: f + integer, intent(in) :: p + end subroutine func + end interface + + ! !LOCAL VARIABLES: + real(r8) :: a, b + real(r8) :: fa, fb + real(r8) :: x1, f0, f1 + real(r8) :: x, dx + real(r8), parameter :: eps = 1.e-2_r8 !relative accuracy + real(r8), parameter :: eps1= 1.e-4_r8 + integer, parameter :: itmax = 40 !maximum number of iterations + real(r8) :: tol,minx,minf + + + call func(x0, f0, p) + if(f0 == 0._r8)return + + minx=x0 + minf=f0 + x1 = x0 * 0.99_r8 + call func(x1,f1, p) + + if(f1==0._r8)then + x0 = x1 + return + endif + if(f1itmax)then + !in case of failing to converge within itmax iterations + !stop at the minimum function + !this happens because of some other issues besides the stomatal conductance calculation + !and it happens usually in very dry places and more likely with c4 plants. + call func(minx,f1, p) + exit + endif + enddo + end subroutine hybrid_findroot_p + + + !------------------------------------------------------------------------------------ + subroutine hybrid_findroot_np(x0, iter, func) + ! + !! DESCRIPTION: + ! use a hybrid solver to find the root of equation + ! f(x) = x- h(x), + ! s.t. f(x) = 0. + !the hybrid approach combines the strength of the newton secant approach (find the solution domain) + !and the bisection approach implemented with the Brent's method to guarrantee convergence. + + ! + !! REVISION HISTORY: + !Apr 14/2013: created by Jinyun Tang + + implicit none + ! !ARGUMENTS: + real(r8), intent(inout) :: x0 !solution's initial guess + integer, intent(out) :: iter + interface + subroutine func(x,f) + use shr_kind_mod , only : r8 => shr_kind_r8 + implicit none + real(r8), intent(in) :: x + real(r8), intent(out) :: f + end subroutine func + end interface + + ! !LOCAL VARIABLES: + real(r8) :: a, b + real(r8) :: fa, fb + real(r8) :: x1, f0, f1 + real(r8) :: x, dx + real(r8), parameter :: eps = 1.e-2_r8 !relative accuracy + real(r8), parameter :: eps1= 1.e-4_r8 + integer, parameter :: itmax = 40 !maximum number of iterations + real(r8) :: tol,minx,minf + + call func(x0, f0) + if(f0 == 0._r8)return + + minx=x0 + minf=f0 + x1 = x0 * 0.99_r8 + call func(x1,f1) + + if(f1==0._r8)then + x0 = x1 + return + endif + if(f1itmax)then + !in case of failing to converge within itmax iterations + !stop at the minimum function + !this happens because of some other issues besides the stomatal conductance calculation + !and it happens usually in very dry places and more likely with c4 plants. + call func(minx,f1) + exit + endif + enddo + end subroutine hybrid_findroot_np + + !-------------------------------------------------------------------------- + SUBROUTINE gaussian_solve(a,b,error) + ! !DESCRIPTION: + ! This subroutine solves the linear system Ax = b + ! Copyright 1994, Miles Ellis, Ivor Philips and Tom Lahey + ! Copyright 1994, Addison-Wesley Publishers Ltd. + ! Copyright 1994, Addison-Wesley Publishing Company Inc. + ! Permission is granted for the use of this code for the purpose of teaching + ! and/or learning the Fortran 90 language provided that the above copyright + ! notices are included in any copies made. + ! Neither the authors nor the publishers accept any responsibility for + ! any results obtained by use of this code. + ! modified by Jinyun Tang + + ! !ARGUMENTS: + real(r8), dimension(:,:), intent(inout) :: a !coefficients of A + real(r8), dimension(:) , intent(inout) :: b !right handside and solution on returning. + integer, intent(out) :: error ! indicates if errors are found + + ! Reduce the equations by Gaussian elimination + call gaussian_elimination(a,b,error) + + ! If reduction was successful, calculate solution by + ! back substitution + if (error == 0) call back_substitution(a,b,error) + + end subroutine gaussian_solve + + !--------------------------------------------------------------------------- + + subroutine gaussian_elimination(a,b,error) + + ! !DESCRIPTION: + ! This subroutine performs Gaussian elimination on a + ! system of linear equations + ! Copyright 1994, Miles Ellis, Ivor Philips and Tom Lahey + ! Copyright 1994, Addison-Wesley Publishers Ltd. + ! Copyright 1994, Addison-Wesley Publishing Company Inc. + ! Permission is granted for the use of this code for the purpose of teaching + ! and/or learning the Fortran 90 language provided that the above copyright + ! notices are included in any copies made. + ! Neither the authors nor the publishers accept any responsibility for + ! any results obtained by use of this code. + + ! !USES: + use MathfuncMod, only : swap + implicit none + ! !ARGUMENTS: + real(r8), dimension(:,:), intent(inout) :: a !contains the coefficients + real(r8), dimension(:) , intent(inout) :: b !contains the right-hand side + integer, intent(out) :: error + + ! !LOCAL VARIABLES: + real(r8), dimension(size(a,1)) :: temp_array ! Automatic array + integer, dimension(1) :: ksave + integer :: i, j, k, n + real(r8) :: temp, m + + ! Validity checks + n = size(a,1) + + if (n == 0) then + error = -1 ! There is no problem to solve + return + endif + + if (n /= size(a,2))then + error = -2 ! a is not square + return + endif + + if (n/=size(b))then + error = -3 ! Size of b does not match a + return + endif + + ! Dimensions of arrays are OK, so go ahead with Gaussian + ! elimination + error = 0 + + do i = 1, n-1 + ! Find row with largest value of |a(j,i)|, j=i, ..., n + ksave = maxloc(abs(a(i:n, i))) + + ! Check whether largest |a(j,i)| is near zero + k = ksave(1) + i - 1 + + if ( abs(a(k,i)) <= 1.e-5_r8 ) then + error = -4 ! No solution possible + return + endif + + !Interchange row i and row k, if necessary + if(k /= i) then + call swap(a(i,:),a(k,:)) + ! Interchange corresponding elements of b + call swap(b(i), b(k)) + endif + + ! Subtract multiples of row i from subsequent rows to + ! zero all subsequent coefficients of x sub i + do j = i + 1, n + m = a(j,i)/a(i,i) + a(j,:) = a(j,:) - m*a(i,:) + b(j) = b(j) - m*b(i) + enddo + enddo + + end subroutine gaussian_elimination + + + !----------------------------------------------------------------- + SUBROUTINE back_substitution(a,b,error) + + ! !DESCRIPTION: + ! + ! This subroutine performs back substition once a system + ! of equations has been reduced by Gaussian elimination + ! Copyright 1994, Miles Ellis, Ivor Philips and Tom Lahey + ! Copyright 1994, Addison-Wesley Publishers Ltd. + ! Copyright 1994, Addison-Wesley Publishing Company Inc. + ! Permission is granted for the use of this code for the purpose of teaching + ! and/or learning the Fortran 90 language provided that the above copyright + ! notices are included in any copies made. + ! Neither the authors nor the publishers accept any responsibility for + ! any results obtained by use of this code. + ! Modified by Jinyun Tang, Apr, 2013 + + implicit none + + ! !ARGUMENTS: + real(r8), dimension(:,:), intent(in) :: a !contains the coefficients + real(r8), dimension(:), intent(inout) :: b !contains the right-hand side coefficients, will contain the solution on exit + integer , intent(out) :: error ! will be set non-zero if an error is found + + ! !LOCAL VARIABLES: + real(r8) :: sum + integer :: i,j,n + + + error = 0 + n = size(b) + ! Solve for each variable in turn + do i = n,1,-1 + ! Check for zero coefficient + if ( abs(a(i,i)) <= 1.e-5_r8 ) then + error = -4 + return + endif + sum = b(i) + do j = i+1,n + sum = sum - a(i,j)*b(j) + enddo + b(i) = sum/a(i,i) + enddo + + end subroutine back_substitution +end module FindRootMod diff --git a/components/clm/src/betr/betr_math/InterpolationMod.F90 b/components/clm/src/betr/betr_math/InterpolationMod.F90 new file mode 100644 index 000000000000..b7b06a457bec --- /dev/null +++ b/components/clm/src/betr/betr_math/InterpolationMod.F90 @@ -0,0 +1,357 @@ +module InterpolationMod +#include "shr_assert.h" + ! + ! !DESCRIPTION: + ! subroutines to do polynomial interpolation + ! author: Jinyun Tang, Sep, 2014 + + ! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + use abortutils , only : endrun + use shr_log_mod , only: errMsg => shr_log_errMsg + implicit none + private + save + + public :: Lagrange_interp + public :: pchip_polycc + public :: pchip_interp +contains + + !------------------------------------------------------------------------------- + subroutine Lagrange_interp(pn, x, y, xi, yi) + ! + ! !DESCRIPTION: + ! do order pn lagrangian interpolation + implicit none + ! !ARGUMENTS: + integer, intent(in) :: pn !order of interpolation + real(r8), dimension(:), intent(in) :: x !location of data + real(r8), dimension(:), intent(in) :: y !value of data + real(r8), dimension(:), intent(in) :: xi !target points to be evaluated + real(r8), dimension(:), intent(out) :: yi !target values + + ! !LOCAL VARIABLES: + integer :: k, ni, nx + integer :: pos, disp, disp1 + + SHR_ASSERT_ALL((ubound(x) == ubound(y)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(xi) == ubound(yi)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(x) >= pn+1), errMsg(__FILE__,__LINE__)) + + ni = size(xi) + nx = size(x) + disp=int((pn+1)*0.5_r8+1.e-8_r8) + !get the half size of the local window + if(mod(pn,2)==0)then + disp1=disp + else + disp1=disp-1 + endif + + do k = 1, ni + ! find the position of z in array x + pos = find_idx(x, xi(k)) + if(pos == -100) then + !left boundary + yi(k) = y(1) + elseif(pos == -200) then + !right boundary + yi(k) = y(nx) + else + ! call function Lagrange + if (pos <= disp1) then + yi(k) = Lagrange_poly(pn, x(1:pn+1), y(1:pn+1), xi(k)) + else if (pos >= nx-disp) then + yi(k) = Lagrange_poly(pn, x(nx-pn:nx), y(nx-pn:nx), xi(k)) + else + yi(k) = Lagrange_poly(pn, x(pos-disp1:pos+disp), y(pos-disp1:pos+disp), xi(k)) + end if + endif + enddo + + end subroutine Lagrange_interp + + !------------------------------------------------------------------------------- + function Lagrange_poly(pn, xvect, yvect, z)result(Pz) + ! + ! !DESCRIPTION: + ! do lagrangian interpolation at order pn + ! + implicit none + ! !ARGUMENTS: + integer, intent(in) :: pn ! Order of Interpolation Polynomial + real(r8), dimension(:), intent(in) :: xvect, yvect ! vectors of known data: x,y-values + real(r8), intent(in) :: z ! the target point "z" + + ! !LOCAL VARIABLES: + integer :: i, j, n + real(r8) :: L(pn+1) ! Lagrange cardinal function + real(r8) :: Pz ! target value + + SHR_ASSERT_ALL((size(xvect) == size(yvect)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((size(xvect) == pn+1), errMsg(__FILE__,__LINE__)) + + ! n = number of data points:length of each data vector + n = size(xvect) + ! Initializations of Pz and L + Pz = 0._r8 ! initializing the polynomia value at z + L(:) = 1._r8 ! initalizing the vector of cardinal functions to 1 + ! Performing the interpolation + do i = 1, n + do j = 1, n + if (i /= j) then + ! part of L(i) + L(i) = ( (z - xvect(j)) / (xvect(i) - xvect(j)) )* L(i) + end if + end do + Pz = Pz + L(i)*yvect(i) ! update Pz ~ f(z) + end do + end function Lagrange_poly + !------------------------------------------------------------ + function find_idx(xvect, x)result(k) + ! + ! !DESCRIPTION: + ! locate the position of x in xvect + ! + implicit none + ! !ARGUMENTS: + real(r8), dimension(:), intent(in) :: xvect ! vector of x-values + real(r8), intent(in) :: x + + integer :: i, k, n + + ! array dimension + n = size(xvect) + + + + if(xxvect(n))then + k = -200 !beyond right boundary + elseif(x==xvect(1))then + k=1 + elseif(x==xvect(n))then + k=n-1 + else + ! find index k so that x[k] < x < x[k+1] + do i = 1, n-1 + if ((xvect(i) <= x) .and. (x < xvect(i+1))) then + k = i + exit + end if + end do + endif + + + end function find_idx + !------------------------------------------------------------ + subroutine pchip_polycc(x, fx, di, region) + ! + ! DESCRIPTION + ! Given the data, generate the coefficients of the monotonic cubic + ! polynomials + ! Ref, Fritsch and Carlson, 1980 + ! + ! !USES: + use MathfuncMod, only : diff + implicit none + ! !ARGUMENTS: + real(r8), dimension(:), intent(in) :: x + real(r8), dimension(:), intent(in) :: fx + real(r8), dimension(:), intent(out):: di + integer, optional, intent(in) :: region + + ! !LOCAL VARIABLES: + real(r8), allocatable :: h(:) + real(r8), allocatable :: df(:) + real(r8), allocatable :: slp(:) + real(r8) :: alpha, beta, tao, rr + integer :: region_loc + integer :: n, j + + SHR_ASSERT_ALL((size(x) == size(fx)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((size(x) == size(di)), errMsg(__FILE__,__LINE__)) + region_loc=2 + if(present(region))region_loc=region + + n = size(x) + allocate(h(n-1)) + allocate(df(n-1)) + allocate(slp(n-1)) + !get interval length + call diff(x, h) + !get function step + call diff(fx, df) + + !get slope + do j = 1, n-1 + slp(j)=df(j)/h(j) + enddo + + !get di + di(:) = 0._r8 + + j = 1 + di(j)=(fx(j+1)+fx(j+2)-2*fx(1))/(2*h(j)+h(j+1)) + do j = 2, n-1 + di(j)=(fx(j+1)-fx(j-1))/(h(j)+h(j-1)) + enddo + j = n + di(j)=(2._r8*fx(j)-(fx(j-1)+fx(j-2)))/(2._r8*h(j-1)+h(j-2)) + + !enforce the sign condition + if(slp(1)*di(1)<=0._r8)then + di(1)=0._r8 + endif + + if(slp(n-1)*di(n)<=0)then + di(n)=0._r8 + endif + + !enforce the range 2 constraint + + do j = 1, n-1 + if(abs(slp(j))<=1.e-16_r8)then + di(j)=0._r8 + di(j+1)=0._r8 + else + alpha=di(j)/slp(j) + beta =di(j+1)/slp(j) + select case (region_loc) + case (1) + rr=beta/alpha + if(rr>1._r8)then + if(beta>3._r8)then + beta=3._r8 + alpha=beta/rr + di(j)=slp(j)*alpha + di(j+1)=slp(j)*beta + endif + else + if(alpha>3._r8)then + alpha=3._r8 + beta=rr*alpha + di(j)=slp(j)*alpha + di(j+1)=slp(j)*beta + endif + endif + case (2) + tao=3._r8/sqrt(alpha*alpha+beta*beta) + if(tao<1._r8)then + di(j)=tao*di(j) + di(j+1)=tao*di(j+1) + endif + case (3) + if(alpha+beta>3._r8)then + if(alpha>0._r8)then + rr=beta/alpha + alpha=3._r8/(1._r8+rr) + beta=alpha*rr + di(j)=slp(j)*alpha + di(j+1)=slp(j)*beta + else + beta=3._r8 + di(j+1)=slp(j)*beta + endif + endif + case (4) + if(alpha>0._r8)then + rr=beta/alpha + if(rr>=1._r8)then + if(2._r8*alpha+beta>3._r8)then + alpha=3._r8/(2._r8+rr) + beta=alpha*rr + di(j)=slp(j)*alpha + di(j+1)=slp(j)*beta; + endif + else + if(alpha+2._r8*beta>3._r8)then + alpha=3._r8/(1._r8+2._r8*rr) + beta=alpha*rr + di(j)=slp(j)*alpha + di(j+1)=slp(j)*beta + endif + endif + else + if(beta>3._r8)then + beta=3._r8 + di(j+1)=slp(j)*beta + endif + endif + case default + call endrun(msg='an constraint region must be specified for pchip_polycc '//errMsg(__FILE__, __LINE__)) + end select + + endif + enddo + + deallocate(h) + deallocate(df) + deallocate(slp) + end subroutine pchip_polycc + !------------------------------------------------------------ + + subroutine pchip_interp(x, fx, di, xi, yi) + + ! !DESCRIPTION: + ! do monotonic cubic spline interpolation + implicit none + ! !ARGUMENTS: + real(r8), dimension(:), intent(in) :: x + real(r8), dimension(:), intent(in) :: fx + real(r8), dimension(:), intent(in) :: di + real(r8), dimension(:), intent(in) :: xi + real(r8), dimension(:), intent(out) :: yi + + ! !LOCAL VARIABLES: + real(r8) :: h, t1, t2 + real(r8) :: h1x, h2x, h3x, h4x + integer :: n, j + integer :: id + + SHR_ASSERT_ALL((size(x) == size(fx)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((size(x) == size(di)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((size(xi) == size(yi)), errMsg(__FILE__,__LINE__)) + + n=size(xi) !total number of points to be interpolated + + yi(:)=0._r8 + do j = 1, n + + id=find_idx(x,xi(j)) + h=x(id+1)-x(id) + t1=(x(id+1)-xi(j))/h + t2=(xi(j)-x(id))/h + + h1x=phi(t1) + h2x=phi(t2) + h3x=-h*psi(t1) + h4x=h*psi(t2) + yi(j)=fx(id)*h1x+fx(id+1)*h2x+di(id)*h3x+di(id+1)*h4x + enddo + + contains + + function phi(t) result(fval) + implicit none + real(r8), intent(in) :: t + + real(r8) :: fval + + fval=(3._r8-2._r8*t)*t*t + + end function phi + + + function psi(t) result(fval) + implicit none + real(r8), intent(in) :: t + + real(r8) :: fval + fval=t*t*(t-1._r8) + end function psi + end subroutine pchip_interp + +end module InterpolationMod diff --git a/components/clm/src/betr/betr_math/MathfuncMod.F90 b/components/clm/src/betr/betr_math/MathfuncMod.F90 new file mode 100644 index 000000000000..1cfe52890515 --- /dev/null +++ b/components/clm/src/betr/betr_math/MathfuncMod.F90 @@ -0,0 +1,432 @@ +module MathfuncMod +#include "shr_assert.h" + ! !DESCRIPTION: + ! mathematical functions for some elementary manipulations + ! History: Created by Jinyun Tang + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_varctl , only : iulog + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + implicit none + save + private + public :: cumsum + public :: swap + public :: minmax + public :: cumdif + public :: diff + public :: safe_div + public :: dot_sum + public :: addone + public :: asc_sort_vec + public :: is_bounded + public :: minp + public :: pd_decomp + public :: num2str + interface cumsum + module procedure cumsum_v, cumsum_m + end interface cumsum + interface swap + module procedure swap_i, swap_r, swap_rv + end interface swap +contains + !------------------------------------------------------------------------------- + function heviside(x)result(ans) + ! + ! !DESCRIPTION: + ! heviside function + implicit none + ! !ARGUMENTS: + real(r8), intent(in) :: x + ! !LOCAL VARIABLES: + real(r8) :: ans + + if(x>0._r8)then + ans = 1._r8 + else + ans = 0._r8 + endif + end function heviside + + + !------------------------------------------------------------------------------- + subroutine swap_i(a,b) + ! + ! !DESCRIPTION: + ! swap two integers + implicit none + ! !ARGUMENTS: + integer, intent(inout) :: a, b + + ! !LOCAL VARIABLES: + integer :: c + + c = a + a = b + b = c + + end subroutine swap_i + !------------------------------------------------------------------------------- + subroutine swap_r(a,b) + ! + ! !DESCRIPTION: + ! swap two real numbers + implicit none + ! !ARGUMENTS: + real(r8), intent(inout) :: a, b + + ! !LOCAL VARIABLES: + real(r8) :: c + + c = a + a = b + b = c + + end subroutine swap_r + !------------------------------------------------------------------------------- + subroutine swap_rv(a,b) + ! + ! !DESCRIPTION: + ! swap two vectors + implicit none + ! !ARGUMENTS: + real(r8), dimension(:), intent(inout) :: a, b + ! !LOCAL VARIABLES: + real(r8), dimension(size(a)) :: c + + integer :: n + + if(size(a)/=size(b))then + write(iulog,*)'the input vectors are not of same size in swap_rv' + write(iulog,*)'clm model is stopping' + call endrun() + endif + + c = a + a = b + b = c + + end subroutine swap_rv + !------------------------------------------------------------------------------- + function minmax(x)result(ans) + ! + ! !DESCRIPTION: + !returnd the minimum and maximum of the input vector + implicit none + ! !ARGUMENTS: + real(r8), dimension(:), intent(in) :: x + + ! !LOCAL VARIABLES: + integer :: n, j + real(r8) :: ans(2) + n = size(x) + ans(1) = x(1) + ans(2) = x(1) + + do j = 2, n + if(ans(1)>x(j))then + ans(1) = x(j) + endif + + if(ans(2) shr_kind_r8 + implicit none + ! !ARGUMENTS: + real(r8), dimension(:), intent(in) :: x + real(r8), dimension(:), intent(in) :: y + ! !LOCAL VARIABLES: + integer :: n, j + real(r8) :: ans + SHR_ASSERT_ALL((size(x) == size(y)), errMsg(__FILE__,__LINE__)) + + n = size(x) + ! use subroutine from blas + !DOUBLE PRECISION FUNCTION ddot(N,DX,INCX,DY,INCY) + ! + ans=dot_product(x,y) + + end function dot_sum + !-------------------------------------------------------------------------------- + function addone(a)result(ans) + ! !DESCRIPTION: + ! return a variable with a + 1 + ! + ! !USES: + use shr_kind_mod, only: r8 => shr_kind_r8 + implicit none + ! !ARGUMENTS: + integer, intent(inout) :: a + ! !LOCAL VARIABLES: + integer :: ans + + a = a + 1 + ans = a + end function addone + + !-------------------------------------------------------------------------------- + subroutine asc_sort_vec(zvec) + ! + ! !DESCRIPTION: + ! sort an array into ascending order + implicit none + ! !ARGUMENTS: + real(r8), dimension(:), intent(inout) :: zvec + ! !LOCAL VARIABLES: + integer :: n, j, k + logical :: lswap + + n = size(zvec) + + do j = 1, n + lswap=.false. + do k = 2, n-j+1 + if(zvec(k)=xl .and. x<=xr)then + ans = .true. + else + ans = .false. + endif + end function is_bounded + + !-------------------------------------------------------------------------------- + function minp(p,v)result(ans) + ! + ! !DESCRIPTION: + !find the minimum of the nonzero p entries, with the entry determined by + !nonzero values of v + + implicit none + ! !ARGUMENTS: + real(r8), dimension(:), intent(in) :: p + real(r8), dimension(:), intent(in) :: v + ! !LOCAL VARIABLES: + integer :: j, sz + real(r8) :: ans !(<=1._r8) + + SHR_ASSERT_ALL((size(p) == size(v)), errMsg(__FILE__,__LINE__)) + + sz = size(p) + ans = 1._r8 + do j = 1, sz + if(v(j)/=0._r8)then + ans = min(ans, p(j)) + endif + enddo + end function minp + + !-------------------------------------------------------------------------------- + subroutine pd_decomp(m, n, A, AP, AD) + ! + ! !DESCRIPTION: + !separate a input matrix A into AP and AD with positive + !and negative entries respectively. + + implicit none + ! !ARGUMENTS: + integer , intent(in) :: n, m + real(r8) , intent(in) :: A(1: , 1: ) + real(r8) , intent(out):: AP(1: , 1: ) + real(r8) , intent(out):: AD(1: , 1: ) + + ! !LOCAL VARIABLES: + integer :: i, j + + + SHR_ASSERT_ALL((ubound(A) == (/m,n/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(AP) == (/m,n/)), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(AD) == (/m,n/)), errMsg(__FILE__,__LINE__)) + + AP(:,:) = 0._r8 + AD(:,:) = 0._r8 + + where(A>0._r8) + AP=A + elsewhere + AD=A + endwhere + end subroutine pd_decomp + !-------------------------------------------------------------------------------- + + function num2str(a,fmt)result(ans) + ! + ! !DESCRIPTION: + !turn a number into a string using the specified format + implicit none + ! !ARGUMENTS: + integer, intent(in) :: a + character(len=*), intent(in) :: fmt + + ! !LOCAL VARIABLES: + character(len=32) :: ans + character(len=32) :: str + + write(str,fmt)a + ans = trim(adjustl(str)) + end function num2str +end module MathfuncMod diff --git a/components/clm/src/betr/betr_math/ODEMod.F90 b/components/clm/src/betr/betr_math/ODEMod.F90 new file mode 100644 index 000000000000..a6879a242b29 --- /dev/null +++ b/components/clm/src/betr/betr_math/ODEMod.F90 @@ -0,0 +1,594 @@ +module ODEMod + ! + ! !DESCRIPTION: + ! ode integrators for the biogeochemistry model + ! Jinyun Tang, 2013 + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_varctl , only : iulog + implicit none + save + private + + public :: ode_mbbks1, ode_adapt_mbbks1 + public :: ode_ebbks1 + public :: ode_rk4 + public :: ode_rk2 + real(r8), parameter :: tiny = 1.e-23_r8 + + type, private:: mbkks_type + real(r8), pointer :: aj(:) + real(r8) :: iJ + integer :: nJ + end type mbkks_type + logical,public :: ldebug_ode=.false. + type(mbkks_type), private :: mbkks_data + interface get_rerr + module procedure get_rerr_v, get_rerr_s + end interface get_rerr + +contains + + !------------------------------------------------------------------------------- + subroutine ode_ebbks1(odefun, y0, nprimeq, neq, t, dt, y, pscal) + ! !DESCRIPTION: + !first order accurate explicit BBKS fixed time step positive preserving ode integrator + !reference: Broekhuizen et al., 2008 + !! + ! + implicit none + ! !ARGUMENTS: + integer, intent(in) :: nprimeq !number of primary equations that are subject to positive constraint + integer, intent(in) :: neq !total number of equations + real(r8), intent(in) :: y0(neq) !initial values + real(r8), intent(in) :: t !current time + real(r8), intent(in) :: dt !time step + real(r8), intent(out) :: y(neq) !return values + real(r8), optional, intent(out) :: pscal !scaling factor + external :: odefun + + ! !LOCAL VARIABLES: + real(r8) :: f(neq) + real(r8) :: pscal_loc + call odefun(y0, dt, t, nprimeq, neq, f) + + call ebbks(y0, f, nprimeq, neq, dt, y,pscal_loc) + if(present(pscal))pscal=pscal_loc + end subroutine ode_ebbks1 + !------------------------------------------------------------------------------- + subroutine ode_ebbks2(odefun, y0, nprimeq, neq, t, dt, y) + ! !DESCRIPTION: + !second order accurate explicit BBKS fixed time step positive preserving ode integrator + !reference: Broekhuizen et al., 2008 + !! + ! + implicit none + ! !ARGUMENTS: + integer, intent(in) :: nprimeq !number of primary equations that are subject to positive constraint + integer, intent(in) :: neq !total number of equations + real(r8), intent(in) :: y0(neq) !initial values + real(r8), intent(in) :: t !current time + real(r8), intent(in) :: dt !time step + real(r8), intent(out) :: y(neq) !return value + + external :: odefun + + ! !LOCAL VARIABLES: + real(r8) :: f(neq) + real(r8) :: f1(neq) + real(r8) :: y1(neq) + real(r8) :: ti + integer :: n + + call odefun(y0, dt, t, nprimeq, neq, f) + call ebbks(y0, f, nprimeq, neq, dt, y1) + ti=t+dt + call odefun(y1, dt, ti, nprimeq, neq, f1) + do n = 1, neq + f(n) = (f(n)+f1(n))*0.5_r8 + enddo + call ebbks(y0, f, nprimeq, neq, dt, y) + end subroutine ode_ebbks2 + !------------------------------------------------------------------------------- + subroutine ode_mbbks1(odefun, y0, nprimeq, neq, t, dt, y, pscal) + ! !DESCRPTION: + !first order accurate implicit BBKS fixed time step positive preserving ode integrator + implicit none + ! !ARGUMENTS: + integer, intent(in) :: nprimeq + integer, intent(in) :: neq + real(r8), intent(in) :: y0(neq) + real(r8), intent(in) :: t + real(r8), intent(in) :: dt + real(r8), intent(out) :: y(neq) + real(r8), optional, intent(out) :: pscal + external :: odefun + + ! !LOCAL VARIABLES: + real(r8) :: f(neq) + real(r8) :: pscal1 + + call odefun(y0, dt, t, nprimeq, neq, f) + + call mbbks(y0, f, nprimeq, neq, dt, y, pscal1) + + if(present(pscal))pscal=pscal1 + end subroutine ode_mbbks1 + !------------------------------------------------------------------------------- + subroutine get_tscal(rerr,dt_scal,acc) + ! + ! !DESCRIPTION: + !obtain the time step scalar for adaptive ode + implicit none + ! !ARGUMENTS: + real(r8), intent(in) :: rerr !input relative err + real(r8), intent(out):: dt_scal !output dt_scal, 2, 1, 0.5 + logical, intent(out):: acc !true or false + + ! !LOCAL VARIABLES: + real(r8), parameter :: rerr_thr=1.e-4_r8 !relative error threshold + + if(rerr<0.5*rerr_thr)then + dt_scal = 2._r8 + acc = .true. + elseif(rerr0._r8)then + do n = 1, neq + f(n) = f(n) * pp**(1._r8/nJ) + enddo + endif + + call mbbks(y0, f, nprimeq, neq, dt, y, pscal) + + end subroutine ode_mbbks2 + !------------------------------------------------------------------------------- + subroutine mbbks(y0, f, nprimeq, neq, dt, y, pscal) + ! !DESCRIPTION: + ! mbbks update + ! + ! !USES: + use MathfuncMod , only : safe_div + implicit none + ! !ARGUMENTS: + real(r8), intent(in) :: y0(neq) ! state variable at previous time step + real(r8), intent(in) :: f(neq) ! derivative + real(r8), intent(in) :: dt ! time stepping + integer, intent(in) :: nprimeq ! + integer, intent(in) :: neq ! number of equations + real(r8), intent(out) :: y(neq) ! updated state variable + real(r8), intent(out) :: pscal + + ! !LOCAL VARIABLES: + real(r8), pointer :: aj(:) + real(r8) :: pmax + real(r8) :: pm + real(r8) :: a + integer :: n, nJ + + allocate(mbkks_data%aj(neq)) + aj => mbkks_data%aj + nJ = 0 + pmax = 0._r8 + do n = 1, nprimeq + if(f(n)<0._r8)then + nJ = nJ + 1 + pm = -y0(n)/(f(n)*dt) + + pm = min(pm,1.e30_r8) + aj(nJ) = -safe_div(1._r8,pm) + if(nJ==1)then + pmax= pm + else + pmax = min(pm, pmax) + endif + endif + enddo + if(nJ>0)then + pmax=min(1._r8,pmax**(nJ)) + + + !solve the gradient modifier function + mbkks_data%nJ=nJ + mbkks_data%iJ=1._r8/nJ + if(pmax<1.e-8_r8)then + pscal=pmax + else + pscal=GetGdtScalar(aj,nJ,pmax) + pscal=pscal**(1._r8/nJ) + endif + !reduce the chance of negative y(n) from roundoff error + pscal=pscal*0.9999_r8 + else + pscal=1._r8 + endif + + y(:)=y0(:) + a=pscal*dt + !daxpy(N,DA,DX,INCX,DY,INCY) + call daxpy(neq, a, f, 1, y, 1) + deallocate(mbkks_data%aj) + + + end subroutine mbbks + + !------------------------------------------------------------------------------- + subroutine ode_adapt_mbbks1(odefun, y0, nprimeq, neq, t, dt, y) + ! !DESCRIPTION: + !first order implicit bkks ode integration with the adaptive time stepping + !This could be used as an example for the implementation of time-adaptive + !mbbks1. + ! !NOTE: + ! this code should only be used for mass positive ODE integration + implicit none + ! !ARGUMENTS: + real(r8), intent(in) :: y0(neq) ! state variable at previous time step + real(r8), intent(in) :: t ! time stamp + real(r8), intent(in) :: dt ! time stepping + integer, intent(in) :: nprimeq ! + integer, intent(in) :: neq ! number of equations + real(r8), intent(out) :: y(neq) ! updated state variable + external :: odefun + + ! !LOCAL VARIABLES: + real(r8) :: yc(neq) !coarse time stepping solution + real(r8) :: yf(neq) !fine time stepping solution + real(r8) :: ycp(neq) !temporary variable + real(r8) :: f(neq) ! derivative + real(r8) :: dt2 + real(r8) :: dtr + real(r8) :: dt05 + real(r8) :: dtmin + real(r8) :: tt,tt2 !temporary variables + logical :: acc + real(r8) :: rerr, dt_scal, pscal + integer :: n, nJ + + dt2=dt + dtmin=dt/64._r8 + dtr=dt + tt=0._r8 + !make a copy of the solution at the current time step + y=y0 + do + if(dt2<=dtmin)then + call odefun(y, dt2, tt, nprimeq, neq, f) + call mbbks(y, f, nprimeq, neq, dt2, yc, pscal) + dtr=dtr-dt2 + tt=tt+dt2 + y=yc + else + !get coarse grid solution + call odefun(y, dt2, tt, nprimeq, neq, f) + call mbbks(y, f, nprimeq, neq, dt2, yc, pscal) + + !get fine grid solution + dt05=dt2*0.5_r8 + call mbbks(y,f,nprimeq, neq,dt05, yf, pscal) + tt2=tt+dt05 + ycp=yf + call odefun(ycp, dt05, tt, nprimeq, neq, f) + call mbbks(ycp,f,nprimeq, neq,dt05,yf,pscal) + + !determine the relative error + rerr=get_rerr_v(yc,yf, neq) + + !determine time scalar factor + call get_tscal(rerr,dt_scal,acc) + + if(acc)then + dtr=dtr-dt2 + tt=tt+dt2 + y=yf + endif + dt2=dt2*dt_scal + dt2=min(dt2,dtr) + endif + if(abs(dtr/dt)<1.e-4_r8)exit + enddo + + end subroutine ode_adapt_mbbks1 + + !------------------------------------------------------------------------------- + function get_rerr_v(yc,yf,neq)result(rerr) + ! + ! !DESCRIPTION: + ! obtain the relative error + implicit none + ! !ARGUMENTS: + real(r8), intent(in) :: yc(neq) !coarse solution + real(r8), intent(in) :: yf(neq) !fine solution + integer, intent(in) :: neq !number of equations + + ! !LOCAL VARIABLES: + real(r8) :: rerr + real(r8) :: rtmp + integer :: n + rerr=abs(yc(1)-yf(1))/(abs(yf(1))+1.e-20_r8) + do n = 2, neq + rtmp=abs(yc(n)-yf(n))/(abs(yf(n))+1.e-20_r8) + rerr=max(rerr,rtmp) + enddo + + end function get_rerr_v + !------------------------------------------------------------------------------- + function get_rerr_s(yc,yf)result(rerr) + ! + ! DESCRIPTION: + ! obtain the relative error + implicit none + ! !ARGUMENTS: + real(r8), intent(in) :: yc !coarse solution + real(r8), intent(in) :: yf !fine solution + ! !LOCAL VARIABLES + real(r8) :: rerr + real(r8) :: rtmp + integer :: n + + rerr=abs(yc-yf)/(abs(yf)+1.e-20_r8) + + end function get_rerr_s + + !------------------------------------------------------------------------------- + function GetGdtScalar(aj,nJ,pmax)result(pp) + ! !DESCRIPTION: + !get the gradient scaling factor for bkks integrator + ! + ! !USES: + use FindRootMod, only : brent + implicit none + ! !ARGUMENTS: + real(r8), intent(in) :: aj(nJ) + real(r8), intent(in) :: pmax + integer, intent(in) :: nJ + ! !LOCAL VARIABLES: + real(r8) :: iJ + real(r8) :: f1, f2 + real(r8), parameter :: macheps = 1.e-8_r8 + real(r8), parameter :: tol = 1.e-8_r8 + + real(r8) :: pp + + call gfunc_mbkks(0._r8, f1) + call gfunc_mbkks(pmax, f2) + call brent(pp, 0._r8, pmax, f1, f2, macheps, tol, gfunc_mbkks) + end function GetGdtScalar + !------------------------------------------------------------------------------- + + subroutine gfunc_mbkks(p, value) + ! !DESCRIPTION: + !the bkks function + implicit none + ! !ARGUMENTS: + real(r8), intent(in) :: p + real(r8), intent(out):: value + + ! !LOCAL VARIABLES: + integer :: jj + real(r8), pointer :: aj(:) + integer :: nJ + real(r8) :: iJ + + aj => mbkks_data%aj + nJ = mbkks_data%nJ + iJ = mbkks_data%iJ + value = 1._r8 + do jj = 1, nJ + value = value * (1._r8 + aj(jj) * p**(iJ)) + enddo + value = value - p + if(abs(value)<1.e-20_r8)value=0._r8 + end subroutine gfunc_mbkks + + !------------------------------------------------------------------------------- + subroutine ebbks(y0, f, nprimeq, neq, dt, y,ps) + ! !DESCRIPTION: + !ebbks update + implicit none + ! !ARGUMENTS: + real(r8), intent(in) :: y0(neq) + real(r8), intent(in) :: f(neq) + real(r8), intent(in) :: dt + integer, intent(in) :: nprimeq + integer, intent(in) :: neq + real(r8), intent(out):: y(neq) + real(r8), optional, intent(out):: ps + ! !LOCAL VARIABLES: + real(r8), parameter :: beta=0.999_r8 !scaling parameter + real(r8) :: js, jsmin + real(r8) :: p + integer :: n, nJ + + nJ=0 + do n = 1, nprimeq + if(f(n)<0._r8)then + js = y0(n)/(-f(n)*dt) + nJ=nJ+1 + if(nJ==1)then + jsmin=js + else + jsmin=min(jsmin,js) + endif + if(ldebug_ode)then + write(*,'(A,X,I3,3(X,E20.10))')'debbkb',n,f(n),js,y0(n) + endif + endif + enddo + p=1._r8 + if(nJ>0)then + p = min(jsmin*beta,1._r8) + endif + + y(:) = y0(:) + if(present(ps))ps=p + p = p * dt + call daxpy(neq, p, f, 1, y, 1) + + end subroutine ebbks + + + + !------------------------------------------------------------------------------- + subroutine ode_rk4(odefun, y0, neq, t, dt, y ) + ! + ! !DESCRIPTION: + ! 4-th order runge-kutta method for ode integration + ! Solve differential equations with a non-adaptive method of order 4. + ! call rk4(y, ODEFUN,t, dt,Y0, neq) integrates + ! the system of differential equations y' = f(t,y) by stepping from T to + ! t+dt. Function ODEFUN(T,Y) must return f(t,y) in a column vector. + ! The vector Y0 is the initial conditions at T0. Each row in the solution + ! array Y corresponds to a time specified in TSPAN. + ! + ! This is a non-adaptive solver. The step sequence is determined by TSPAN + ! but the derivative function ODEFUN is evaluated multiple times per step. + ! + implicit none + ! !ARGUMENTS: + integer, intent(in) :: neq + real(r8), intent(in) :: y0(neq) + real(r8), intent(in) :: t + real(r8), intent(in) :: dt + real(r8), intent(out) :: y(neq) + ! !LOCAL VARIABLES: + real(r8) :: k1(neq) + real(r8) :: k2(neq) + real(r8) :: k3(neq) + real(r8) :: k4(neq) + real(r8) :: kt(neq) + real(r8) :: ti, dt05, a + integer :: n + external :: odefun + + ti = t + dt05 = dt * 0.5_r8 + + call odefun(y0, dt05, ti, neq, k1) + + y(:) = y0(:) + call daxpy(neq, dt05, k1, 1, y, 1) + + ti = t + dt05 + call odefun(y, dt05, ti, neq, k2) + + y(:) = y0(:) + call daxpy(neq, dt05, k2, 1, y, 1) + + ti = t + dt05 + call odefun( y, dt05, ti, neq, k3) + + y(:) = y0(:) + call daxpy(neq, dt, k3, 1, y, 1) + + ti = t + dt + call odefun(y, dt, ti, neq, k4) + + do n = 1, neq + kt(n) = k1(n)+2._r8*K2(n)+2._r8*k3(n)+k4(n) + enddo + a = dt / 6._r8 + + y(:) = y0(:) + call daxpy(neq, a, kt, 1, y, 1) + + end subroutine ode_rk4 + + + !------------------------------------------------------------------------------- + subroutine ode_rk2(odefun, y0, neq, t, dt, y ) + ! + ! !DESCRIPTION: + ! 2-th order runge-kutta method for ode integration + ! Solve differential equations with a non-adaptive method of order 2. + ! call rk2(y, ODEFUN,t, dt,Y0, neq) integrates + ! the system of differential equations y' = f(t,y) by stepping from T to + ! t+dt. Function ODEFUN(T,Y) must return f(t,y) in a column vector. + ! The vector Y0 is the initial conditions at T0. Each row in the solution + ! array Y corresponds to a time specified in TSPAN. + + ! + ! This is a non-adaptive solver. The step sequence is determined by TSPAN + ! but the derivative function ODEFUN is evaluated multiple times per step. + ! + implicit none + ! !ARGUMENTS: + integer, intent(in) :: neq + real(r8), intent(in) :: y0(neq) + real(r8), intent(in) :: t + real(r8), intent(in) :: dt + real(r8), intent(out) :: y(neq) + ! !LOCAL VARIABLES: + real(r8) :: k1(neq) + real(r8) :: k2(neq) + real(r8) :: ti, dt05 + integer :: n + external :: odefun + + ti = t + dt05 = dt * 0.5_r8 + + call odefun(y0, dt, ti, neq, k1) + + y(:) = y0(:) + call daxpy(neq, dt05, k1, 1, y, 1) + + ti = t + dt05 + call odefun(y, dt05, ti, neq, k2) + + y(:) = y0(:) + call daxpy(neq, dt, k2, 1, y, 1) + end subroutine ode_rk2 + +end module ODEMod diff --git a/components/clm/src/betr/bgc_century/BGCCenturyParMod.F90 b/components/clm/src/betr/bgc_century/BGCCenturyParMod.F90 new file mode 100644 index 000000000000..f6b30d1dfdd3 --- /dev/null +++ b/components/clm/src/betr/bgc_century/BGCCenturyParMod.F90 @@ -0,0 +1,557 @@ +module BGCCenturyParMod + ! + ! !DESCRIPTION: + ! parameterization module for century bgc + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + implicit none + + public :: readCentDecompBgcParams + public :: readCentNitrifDenitrifParams + public :: readCentCNAllocParams + + type, private :: CNNitrifDenitrifParamsType + real(r8) :: k_nitr_max ! maximum nitrification rate constant (1/s) + real(r8) :: surface_tension_water ! surface tension of water(J/m^2), Arah an and Vinten 1995 + real(r8) :: rij_kro_a ! Arah and Vinten 1995) + real(r8) :: rij_kro_alpha ! parameter to calculate anoxic fraction of soil (Arah and Vinten 1995) + real(r8) :: rij_kro_beta ! (Arah and Vinten 1995) + real(r8) :: rij_kro_gamma ! (Arah and Vinten 1995) + real(r8) :: rij_kro_delta ! (Arah and Vinten 1995) + end type CNNitrifDenitrifParamsType + + type(CNNitrifDenitrifParamsType), protected :: CNNitrifDenitrifParamsInst + + + type :: NutrientCompetitionParamsType + + real(r8) :: dayscrecover ! number of days to recover negative cpool + real(r8) :: compet_plant_no3 ! (unitless) relative compettiveness of plants for NO3 + real(r8) :: compet_plant_nh4 ! (unitless) relative compettiveness of plants for NH4 + real(r8) :: compet_decomp_no3 ! (unitless) relative competitiveness of immobilizers for NO3 + real(r8) :: compet_decomp_nh4 ! (unitless) relative competitiveness of immobilizers for NH4 + real(r8) :: compet_denit ! (unitless) relative competitiveness of denitrifiers for NO3 + real(r8) :: compet_nit ! (unitless) relative competitiveness of nitrifiers for NH4 + end type NutrientCompetitionParamsType + + ! NutrientCompetitionParamsInst is populated in readCNAllocParams which is called in + type(NutrientCompetitionParamsType),protected :: NutrientCompetitionParamsInst + + + type, private :: CNDecompBgcParamsType + real(r8) :: cn_s1_bgc !C:N for SOM 1 + real(r8) :: cn_s2_bgc !C:N for SOM 2 + real(r8) :: cn_s3_bgc !C:N for SOM 3 + + real(r8) :: rf_l1s1_bgc !respiration fraction litter 1 -> SOM 1 + real(r8) :: rf_l2s1_bgc + real(r8) :: rf_l3s2_bgc + + real(r8) :: rf_s2s1_bgc + real(r8) :: rf_s2s3_bgc + real(r8) :: rf_s3s1_bgc + + real(r8) :: rf_cwdl2_bgc + real(r8) :: rf_cwdl3_bgc + + real(r8) :: tau_l1_bgc ! turnover time of litter 1 (yr) + real(r8) :: tau_l2_l3_bgc ! turnover time of litter 2 and litter 3 (yr) + real(r8) :: tau_s1_bgc ! turnover time of SOM 1 (yr) + real(r8) :: tau_s2_bgc ! turnover time of SOM 2 (yr) + real(r8) :: tau_s3_bgc ! turnover time of SOM 3 (yr) + real(r8) :: tau_cwd_bgc ! corrected fragmentation rate constant CWD + + real(r8) :: k_decay_lit1 + real(r8) :: k_decay_lit2 + real(r8) :: k_decay_lit3 + real(r8) :: k_decay_som1 + real(r8) :: k_decay_som2 + real(r8) :: k_decay_som3 + real(r8) :: k_decay_cwd + + real(r8) :: cwd_fcel_bgc !cellulose fraction for CWD + real(r8) :: cwd_flig_bgc ! + + real(r8) :: k_frag_bgc !fragmentation rate for CWD + real(r8) :: minpsi_bgc !minimum soil water potential for heterotrophic resp + + integer :: nsompools = 3 + + real(r8),allocatable :: spinup_vector(:) ! multipliers for soil decomp during accelerated spinup + + end type CNDecompBgcParamsType + + type(CNDecompBgcParamsType),protected :: CNDecompBgcParamsInst + + +contains + + !------------------------------------------------------------------------------- + subroutine readCentNitrifDenitrifParams ( ncid ) + ! + ! !DESCRIPTION: + ! read in nitrification denitrification parameters: + + ! !USES: + use ncdio_pio , only : file_desc_t,ncd_io + use clm_varcon , only : secspday + use clm_time_manager , only : get_days_per_year + ! + ! !ARGUMENTS: + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'CNNitrifDenitrifParamsType' + character(len=100) :: errCode = '-Error reading in parameters file:' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in constant + character(len=100) :: tString ! temp. var for reading + !----------------------------------------------------------------------- + ! + ! read in constants + ! + tString='k_nitr_max' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNNitrifDenitrifParamsInst%k_nitr_max=tempr + + tString='surface_tension_water' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNNitrifDenitrifParamsInst%surface_tension_water=tempr + + tString='rij_kro_a' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNNitrifDenitrifParamsInst%rij_kro_a=tempr + + tString='rij_kro_alpha' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNNitrifDenitrifParamsInst%rij_kro_alpha=tempr + + tString='rij_kro_beta' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNNitrifDenitrifParamsInst%rij_kro_beta=tempr + + tString='rij_kro_gamma' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNNitrifDenitrifParamsInst%rij_kro_gamma=tempr + + tString='rij_kro_delta' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNNitrifDenitrifParamsInst%rij_kro_delta=tempr + + end subroutine readCentNitrifDenitrifParams + + !----------------------------------------------------------------------- + subroutine readCentDecompBgcParams ( ncid, nelms, betrtracer_vars ) + ! + ! !DESCRIPTION: + ! read in decomposition parameters for century bgc + ! + ! !USES: + use ncdio_pio , only: file_desc_t,ncd_io + use clm_varcon , only : secspday + use clm_varctl , only : spinup_state + use clm_varpar , only : i_met_lit, i_cel_lit, i_lig_lit, i_cwd + use clm_time_manager , only : get_days_per_year + use BeTRTracerType , only : BeTRTracer_Type + use CNDecompCascadeConType , only : decomp_cascade_con + ! + ! !ARGUMENTS: + type(file_desc_t) , intent(inout) :: ncid ! pio netCDF file id + type(BeTRTracer_Type) , intent(inout) :: betrtracer_vars + integer , intent(in) :: nelms + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'CNDecompBgcParamsType' + character(len=100) :: errCode = 'Error reading in CN const file ' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in constant + character(len=100) :: tString ! temp. var for reading + + real(r8) :: tau_l1 + real(r8) :: tau_l2_l3 + real(r8) :: tau_s1 + real(r8) :: tau_s2 + real(r8) :: tau_s3 + real(r8) :: days_per_year + real(r8) :: tau_cwd + real(r8) :: cn_s1 + real(r8) :: cn_s2 + real(r8) :: cn_s3 + integer :: i_litr1 + integer :: i_litr2 + integer :: i_litr3 + integer :: i_soil1 + integer :: i_soil2 + integer :: i_soil3 + integer :: ii, jj, kk + !----------------------------------------------------------------------- + associate( & ! + floating_cn_ratio_decomp_pools => decomp_cascade_con%floating_cn_ratio_decomp_pools , & ! Output: [logical (:) ] TRUE => pool has fixed C:N ratio + decomp_pool_name_restart => decomp_cascade_con%decomp_pool_name_restart , & ! Output: [character(len=8) (:) ] name of pool for restart files + decomp_pool_name_history => decomp_cascade_con%decomp_pool_name_history , & ! Output: [character(len=8) (:) ] name of pool for history files + decomp_pool_name_long => decomp_cascade_con%decomp_pool_name_long , & ! Output: [character(len=20) (:) ] name of pool for netcdf long names + decomp_pool_name_short => decomp_cascade_con%decomp_pool_name_short , & ! Output: [character(len=8) (:) ] name of pool for netcdf short names + is_litter => decomp_cascade_con%is_litter , & ! Output: [logical (:) ] TRUE => pool is a litter pool + is_soil => decomp_cascade_con%is_soil , & ! Output: [logical (:) ] TRUE => pool is a soil pool + is_cwd => decomp_cascade_con%is_cwd , & ! Output: [logical (:) ] TRUE => pool is a cwd pool + initial_cn_ratio => decomp_cascade_con%initial_cn_ratio , & ! Output: [real(r8) (:) ] c:n ratio for initialization of pools + initial_stock => decomp_cascade_con%initial_stock , & ! Output: [real(r8) (:) ] initial concentration for seeding at spinup + is_metabolic => decomp_cascade_con%is_metabolic , & ! Output: [logical (:) ] TRUE => pool is metabolic material + is_cellulose => decomp_cascade_con%is_cellulose , & ! Output: [logical (:) ] TRUE => pool is cellulose + is_lignin => decomp_cascade_con%is_lignin , & ! Output: [logical (:) ] TRUE => pool is lignin + spinup_factor => decomp_cascade_con%spinup_factor & ! Output: [real(r8) (:) + ) + ! These are not read off of netcdf file + allocate(CNDecompBgcParamsInst%spinup_vector(CNDecompBgcParamsInst%nsompools)) + CNDecompBgcParamsInst%spinup_vector(:) = (/ 1.0_r8, 15.0_r8, 675.0_r8 /) + + + + ! Read off of netcdf file + tString='tau_l1' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNDecompBgcParamsInst%tau_l1_bgc=tempr + + tString='tau_l2_l3' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNDecompBgcParamsInst%tau_l2_l3_bgc=tempr + + tString='tau_s1' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNDecompBgcParamsInst%tau_s1_bgc=tempr + + tString='tau_s2' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNDecompBgcParamsInst%tau_s2_bgc=tempr + + tString='tau_s3' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNDecompBgcParamsInst%tau_s3_bgc=tempr + + tString='tau_cwd' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNDecompBgcParamsInst%tau_cwd_bgc=tempr + + tString='cn_s1_bgc' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNDecompBgcParamsInst%cn_s1_bgc=tempr + + tString='cn_s2_bgc' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNDecompBgcParamsInst%cn_s2_bgc=tempr + + tString='cn_s3_bgc' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNDecompBgcParamsInst%cn_s3_bgc=tempr + + tString='rf_l1s1_bgc' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNDecompBgcParamsInst%rf_l1s1_bgc=tempr + + tString='rf_l2s1_bgc' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNDecompBgcParamsInst%rf_l2s1_bgc=tempr + + tString='rf_l3s2_bgc' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNDecompBgcParamsInst%rf_l3s2_bgc=tempr + + tString='rf_s2s1_bgc' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNDecompBgcParamsInst%rf_s2s1_bgc=tempr + + tString='rf_s2s3_bgc' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNDecompBgcParamsInst%rf_s2s3_bgc=tempr + + tString='rf_s3s1_bgc' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNDecompBgcParamsInst%rf_s3s1_bgc=tempr + + tString='rf_cwdl2_bgc' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNDecompBgcParamsInst%rf_cwdl2_bgc=tempr + + tString='rf_cwdl3_bgc' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNDecompBgcParamsInst%rf_cwdl3_bgc=tempr + + tString='cwd_fcel' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNDecompBgcParamsInst%cwd_fcel_bgc=tempr + + tString='k_frag' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNDecompBgcParamsInst%k_frag_bgc=tempr + + tString='minpsi_hr' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNDecompBgcParamsInst%minpsi_bgc=tempr + + tString='cwd_flig' + call ncd_io(trim(tString),tempr, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNDecompBgcParamsInst%cwd_flig_bgc=tempr + + !------- time-constant coefficients ---------- ! + ! set soil organic matter compartment C:N ratios + cn_s1 = CNDecompBgcParamsInst%cn_s1_bgc + cn_s2 = CNDecompBgcParamsInst%cn_s2_bgc + cn_s3 = CNDecompBgcParamsInst%cn_s3_bgc + + !------------------- list of pools and their attributes ------------ + i_litr1 = i_met_lit + floating_cn_ratio_decomp_pools(i_litr1) = .true. + decomp_pool_name_restart(i_litr1) = 'litr1' + decomp_pool_name_history(i_litr1) = 'LITR1' + decomp_pool_name_long(i_litr1) = 'litter 1' + decomp_pool_name_short(i_litr1) = 'L1' + is_litter(i_litr1) = .true. + is_soil(i_litr1) = .false. + is_cwd(i_litr1) = .false. + initial_cn_ratio(i_litr1) = 90._r8 + initial_stock(i_litr1) = 0._r8 + is_metabolic(i_litr1) = .true. + is_cellulose(i_litr1) = .false. + is_lignin(i_litr1) = .false. + + i_litr2 = i_cel_lit + floating_cn_ratio_decomp_pools(i_litr2) = .true. + decomp_pool_name_restart(i_litr2) = 'litr2' + decomp_pool_name_history(i_litr2) = 'LITR2' + decomp_pool_name_long(i_litr2) = 'litter 2' + decomp_pool_name_short(i_litr2) = 'L2' + is_litter(i_litr2) = .true. + is_soil(i_litr2) = .false. + is_cwd(i_litr2) = .false. + initial_cn_ratio(i_litr2) = 90._r8 + initial_stock(i_litr2) = 0._r8 + is_metabolic(i_litr2) = .false. + is_cellulose(i_litr2) = .true. + is_lignin(i_litr2) = .false. + + i_litr3 = i_lig_lit + floating_cn_ratio_decomp_pools(i_litr3) = .true. + decomp_pool_name_restart(i_litr3) = 'litr3' + decomp_pool_name_history(i_litr3) = 'LITR3' + decomp_pool_name_long(i_litr3) = 'litter 3' + decomp_pool_name_short(i_litr3) = 'L3' + is_litter(i_litr3) = .true. + is_soil(i_litr3) = .false. + is_cwd(i_litr3) = .false. + initial_cn_ratio(i_litr3) = 90._r8 + initial_stock(i_litr3) = 0._r8 + is_metabolic(i_litr3) = .false. + is_cellulose(i_litr3) = .false. + is_lignin(i_litr3) = .true. + + ! CWD + floating_cn_ratio_decomp_pools(i_cwd) = .true. + decomp_pool_name_restart(i_cwd) = 'cwd' + decomp_pool_name_history(i_cwd) = 'CWD' + decomp_pool_name_long(i_cwd) = 'coarse woody debris' + decomp_pool_name_short(i_cwd) = 'CWD' + is_litter(i_cwd) = .false. + is_soil(i_cwd) = .false. + is_cwd(i_cwd) = .true. + initial_cn_ratio(i_cwd) = 90._r8 + initial_stock(i_cwd) = 0._r8 + is_metabolic(i_cwd) = .false. + is_cellulose(i_cwd) = .false. + is_lignin(i_cwd) = .false. + + i_soil1 = 5 + floating_cn_ratio_decomp_pools(i_soil1) = .false. + decomp_pool_name_restart(i_soil1) = 'soil1' + decomp_pool_name_history(i_soil1) = 'SOIL1' + decomp_pool_name_long(i_soil1) = 'soil 1' + decomp_pool_name_short(i_soil1) = 'S1' + is_litter(i_soil1) = .false. + is_soil(i_soil1) = .true. + is_cwd(i_soil1) = .false. + initial_cn_ratio(i_soil1) = cn_s1 + initial_stock(i_soil1) = 20._r8 + is_metabolic(i_soil1) = .false. + is_cellulose(i_soil1) = .false. + is_lignin(i_soil1) = .false. + + i_soil2 = 6 + floating_cn_ratio_decomp_pools(i_soil2) = .false. + decomp_pool_name_restart(i_soil2) = 'soil2' + decomp_pool_name_history(i_soil2) = 'SOIL2' + decomp_pool_name_long(i_soil2) = 'soil 2' + decomp_pool_name_short(i_soil2) = 'S2' + is_litter(i_soil2) = .false. + is_soil(i_soil2) = .true. + is_cwd(i_soil2) = .false. + initial_cn_ratio(i_soil2) = cn_s2 + initial_stock(i_soil2) = 20._r8 + is_metabolic(i_soil2) = .false. + is_cellulose(i_soil2) = .false. + is_lignin(i_soil2) = .false. + + i_soil3 = 7 + floating_cn_ratio_decomp_pools(i_soil3) = .false. + decomp_pool_name_restart(i_soil3) = 'soil3' + decomp_pool_name_history(i_soil3) = 'SOIL3' + decomp_pool_name_long(i_soil3) = 'soil 3' + decomp_pool_name_short(i_soil3) = 'S3' + is_litter(i_soil3) = .false. + is_soil(i_soil3) = .true. + is_cwd(i_soil3) = .false. + initial_cn_ratio(i_soil3) = cn_s3 + initial_stock(i_soil3) = 20._r8 + is_metabolic(i_soil3) = .false. + is_cellulose(i_soil3) = .false. + is_lignin(i_soil3) = .false. + + spinup_factor(i_litr1) = 1._r8 + spinup_factor(i_litr2) = 1._r8 + spinup_factor(i_litr3) = 1._r8 + spinup_factor(i_cwd) = 1._r8 + spinup_factor(i_soil1) = CNDecompBgcParamsInst%spinup_vector(1) + spinup_factor(i_soil2) = CNDecompBgcParamsInst%spinup_vector(2) + spinup_factor(i_soil3) = CNDecompBgcParamsInst%spinup_vector(3) + + tau_l1 = 1./18.5 + tau_l2_l3 = 1./4.9 + tau_s1 = 1./7.3 + tau_s2 = 1./0.2 + tau_s3 = 1./.0045 + + ! century leaves wood decomposition rates open, within range of 0 - 0.5 yr^-1 + tau_cwd = 1./0.3 + days_per_year = get_days_per_year() + + CNDecompBgcParamsInst%k_decay_lit1=1._r8/(secspday * days_per_year * tau_l1) ![1/s] + CNDecompBgcParamsInst%k_decay_lit2=1._r8/(secspday * days_per_year * tau_l2_l3) + CNDecompBgcParamsInst%k_decay_lit3=1._r8/(secspday * days_per_year * tau_l2_l3) + CNDecompBgcParamsInst%k_decay_som1=1._r8/(secspday * days_per_year * tau_s1) + CNDecompBgcParamsInst%k_decay_som2=1._r8/(secspday * days_per_year * tau_s2) + CNDecompBgcParamsInst%k_decay_som3=1._r8/(secspday * days_per_year * tau_s3) + CNDecompBgcParamsInst%k_decay_cwd =1._r8/(secspday * days_per_year * tau_cwd) + + + kk = 1 + betrtracer_vars%tracer_solid_passive_diffus_scal_group(kk) = 1._r8 + betrtracer_vars%tracer_solid_passive_diffus_thc_group(kk) = 1.e-30_r8 + + if ( spinup_state .eq. 1 ) then + CNDecompBgcParamsInst%k_decay_som1 = CNDecompBgcParamsInst%k_decay_som1 * CNDecompBgcParamsInst%spinup_vector(1) + CNDecompBgcParamsInst%k_decay_som2 = CNDecompBgcParamsInst%k_decay_som2 * CNDecompBgcParamsInst%spinup_vector(2) + CNDecompBgcParamsInst%k_decay_som3 = CNDecompBgcParamsInst%k_decay_som3 * CNDecompBgcParamsInst%spinup_vector(3) + + ii=i_soil1 + kk = 2 + do jj = 1, nelms + betrtracer_vars%tracer_solid_passive_diffus_scal_group(kk) = & + betrtracer_vars%tracer_solid_passive_diffus_scal_group(kk) * spinup_factor(ii) + enddo + + ii=i_soil2 + kk = 3 + do jj = 1, nelms + betrtracer_vars%tracer_solid_passive_diffus_scal_group(kk) = & + betrtracer_vars%tracer_solid_passive_diffus_scal_group(kk) * spinup_factor(ii) + enddo + + ii=i_soil3 + kk = 4 + do jj = 1, nelms + betrtracer_vars%tracer_solid_passive_diffus_scal_group(kk) = & + betrtracer_vars%tracer_solid_passive_diffus_scal_group(kk) * spinup_factor(ii) + enddo + + endif + end associate + +end subroutine readCentDecompBgcParams + +!----------------------------------------------------------------------- +subroutine readCentCNAllocParams ( ncid ) + ! + ! !DESCRIPTION: + ! read in allocation parameters. + ! + ! !USES: + use ncdio_pio , only : file_desc_t,ncd_io + + ! !ARGUMENTS: + implicit none + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'readCentCNAllocParams' + character(len=100) :: errCode = '-Error reading in parameters file:' + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in parameter + character(len=100) :: tString ! temp. var for reading + !----------------------------------------------------------------------- + + ! read in parameters + + tString='compet_plant_no3' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + NutrientCompetitionParamsInst%compet_plant_no3=tempr + + tString='compet_plant_nh4' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + NutrientCompetitionParamsInst%compet_plant_nh4=tempr + + tString='compet_decomp_no3' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + NutrientCompetitionParamsInst%compet_decomp_no3=tempr + + tString='compet_decomp_nh4' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + NutrientCompetitionParamsInst%compet_decomp_nh4=tempr + + tString='compet_denit' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + NutrientCompetitionParamsInst%compet_denit=tempr + + tString='compet_nit' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + NutrientCompetitionParamsInst%compet_nit=tempr + + +end subroutine readCentCNAllocParams + + +end module BGCCenturyParMod diff --git a/components/clm/src/betr/bgc_century/BGCCenturySubCoreMod.F90 b/components/clm/src/betr/bgc_century/BGCCenturySubCoreMod.F90 new file mode 100644 index 000000000000..330a859c0df9 --- /dev/null +++ b/components/clm/src/betr/bgc_century/BGCCenturySubCoreMod.F90 @@ -0,0 +1,1767 @@ +module BGCCenturySubCoreMod +#include "shr_assert.h" + ! + ! !DESCRIPTION: + ! module contains subroutine for the century bgc implementation + ! !USES: + 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_varcon , only : spval + use clm_varcon , only : catomw, natomw + use clm_varpar , only : ndecomp_pools + use ColumnType , only : col + use clm_varctl , only : spinup_state,iulog + use clm_varctl , only : CNAllocate_Carbon_only + implicit none + save + private + + public :: apply_plant_root_respiration_prof + public :: apply_plant_root_nuptake_prof + public :: calc_som_deacyK + public :: calc_sompool_decay + public :: init_state_vector + public :: retrieve_flux_vars + public :: retrieve_state_vars + public :: calc_nitrif_denitrif_rate + public :: calc_anaerobic_frac + public :: calc_potential_aerobic_hr + public :: calc_decompK_multiply_scalar + public :: calc_nuptake_prof + public :: calc_plant_nitrogen_uptake_prof + public :: bgcstate_ext_update_bfdecomp + public :: bgcstate_ext_update_afdecomp + public :: set_reaction_order + public :: calc_nutrient_compet_rescal + public :: assign_nitrogen_hydroloss + public :: assign_OM_CNpools + + type, public :: centurybgc_type + + integer :: nom_pools !not include coarse wood debris + integer :: nom_totelms + integer :: lit1, lit1_dek_reac + integer :: lit2, lit2_dek_reac + integer :: lit3, lit3_dek_reac + integer :: som1, som1_dek_reac + integer :: som2, som2_dek_reac + integer :: som3, som3_dek_reac + integer :: cwd, cwd_dek_reac + + integer :: c_loc + integer :: n_loc + integer :: nelms !number of chemical elements in an om pool + + !reactive primary variables + real(r8) :: k_decay_lit1 + real(r8) :: k_decay_lit2 + real(r8) :: k_decay_lit3 + real(r8) :: k_decay_som1 + real(r8) :: k_decay_som2 + real(r8) :: k_decay_som3 + real(r8) :: k_decay_cwd + integer :: lid_nh4, lid_nh4_nit_reac !local position of nh4 in the state variable vector + integer :: lid_no3, lid_no3_den_reac !local position of no3 in the state variable vector + integer :: lid_plant_minn, lid_plant_minn_up_reac !local position of plant consumption of mineral nitrogen in the state variable vector + integer :: lid_at_rt, lid_at_rt_reac !root autotrophic respiration + + !non reactive primary variables + integer :: lid_ar, lid_ar_aere_reac !local position of ar in the state variable vector + integer :: lid_ch4, lid_ch4_aere_reac !nonreactive primary variables + + !secondary variables + integer :: lid_o2, lid_o2_aere_reac !local position of o2 in the state variable vector + integer :: lid_co2, lid_co2_aere_reac !local position of co2 in the state variable vector + integer :: lid_n2, lid_n2_aere_reac + integer :: lid_n2o, lid_n2o_aere_reac + !diagnostic variables + integer :: lid_n2o_nit !n2o production from nitrification, used to for mass balance book keeping + integer :: lid_co2_hr !co2 production from heterotrophic respiration + integer :: lid_no3_den !no3 consumption due to denitrification + integer :: lid_minn_nh4_immob !net mineral N immobilization for decomposition + integer :: lid_minn_no3_immob + integer :: lid_minn_nh4_plant + integer :: lid_minn_no3_plant + integer :: lid_nh4_nit + !aerechyma transport, diagnostic efflux + + integer :: lid_ar_paere + integer :: lid_n2_paere + integer :: lid_o2_paere + integer :: lid_co2_paere + integer :: lid_ch4_paere + integer :: lid_n2o_paere + + integer :: lid_nh4_mpcbuf !nh4 buffer providing the tight to loose coupling between immobilizing and mineralizing decomposers + integer :: lid_nh4_supp + integer :: nstvars !number of equations for the state variabile vector + integer :: nprimvars !total number of primary variables + integer :: nreactions !seven decomposition pathways plus nitrification, denitrification and plant immobilization + integer :: ncompets !decomposers, + nitrifiers, + denitrifiers, + plants, + adsorption surface + + integer :: lid_lit1_compet + integer :: lid_lit2_compet + integer :: lid_lit3_compet + integer :: lid_cwd_compet + integer :: lid_som1_compet + integer :: lid_som2_compet + integer :: lid_som3_compet + integer :: lid_plant_compet + integer :: lid_nitri_compet + integer :: lid_denit_compet + integer :: lid_clay_compet + + real(r8), pointer :: t_scalar_col(:,:) + real(r8), pointer :: w_scalar_col(:,:) + real(r8), pointer :: o_scalar_col(:,:) + real(r8), pointer :: depth_scalar_col(:,:) ! + integer , pointer :: primvarid(:) + logical , pointer :: is_aerobic_reac(:) + + contains + procedure, public :: Init + procedure, private :: Init_pars + procedure, private :: InitAllocate + end type centurybgc_type + +contains + + subroutine Init(this, bounds, lbj, ubj, do_mpc) + ! + ! DESCRIPTION: + ! Initialize centurybgc type + ! !USES: + use ncdio_pio , only: file_desc_t + + ! !ARGUMENTS: + class(centurybgc_type) :: this + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: lbj, ubj ! lower and upper bounds, make sure they are > 0 + + ! !LOCAL VARIABLES: + logical, optional :: do_mpc + logical :: do_mpc_loc + + if(present(do_mpc))then + do_mpc_loc = do_mpc + else + do_mpc_loc = .false. + endif + call this%init_pars(do_mpc_loc) + + call this%InitAllocate(bounds, lbj, ubj) + + end subroutine Init + !------------------------------------------------------------------------------- + + subroutine Init_pars(this, do_mpc) + ! + ! !DESCRIPTION: + ! describe the layout of the stoichiometric matrix for the reactions + ! r{1} r{2} r{3} r{4} ... r{n} + ! s{1} + ! s{2} + ! s{3} + ! s{4} + ! ... + ! s{n} + ! s{n+1} nonreactive primary variables + ! s{n+2} + ! ... + ! s{m} + ! s{m+1} diagnostic variables + ! s{p} + ! each reaction is associated with a primary species, the secondary species follows after primary species + ! for the century model, the primary species are seven om pools and nh4, no3 and plant nitrogen + ! + ! !USES: + use MathfuncMod , only : addone + class(centurybgc_type) :: this + logical , intent(in) :: do_mpc + + ! !LOCAL VARIABLES: + integer :: itemp + integer :: ireac !counter of reactions + integer :: itemp1 + + itemp = 0 + ireac = 0 + this%nom_pools = 7 !not include coarse wood debris + this%lit1 = addone(itemp); this%lit1_dek_reac = addone(ireac) + this%lit2 = addone(itemp); this%lit2_dek_reac = addone(ireac) + this%lit3 = addone(itemp); this%lit3_dek_reac = addone(ireac) + this%cwd = addone(itemp); this%cwd_dek_reac = addone(ireac) + this%som1 = addone(itemp); this%som1_dek_reac = addone(ireac) + this%som2 = addone(itemp); this%som2_dek_reac = addone(ireac) + this%som3 = addone(itemp); this%som3_dek_reac = addone(ireac) + + this%nelms = 2 !carbon and nitrogen + this%c_loc = 1 + this%n_loc = 2 + + itemp = this%nom_pools*this%nelms + this%nom_totelms = itemp + this%lid_nh4 = addone(itemp); this%lid_nh4_nit_reac = addone(ireac) !this is also used to indicate the nitrification reaction + this%lid_no3 = addone(itemp); this%lid_no3_den_reac = addone(ireac) !this is also used to indicate the denitrification reaction + this%lid_plant_minn = addone(itemp); this%lid_plant_minn_up_reac = addone(ireac) !this is used to indicate plant mineral nitrogen uptake + this%lid_at_rt = addone(itemp); this%lid_at_rt_reac = addone(ireac) !this is used to indicate plant autotrophic root respiration + + !non-reactive primary variables + this%lid_ch4 = addone(itemp); + this%lid_ar = addone(itemp); + + + !second primary variables + this%lid_o2 = addone(itemp); + this%lid_co2 = addone(itemp); + this%lid_n2o = addone(itemp); + this%lid_n2 = addone(itemp); + + this%lid_o2_aere_reac = addone(ireac) + + if(do_mpc)then + this%lid_nh4_mpcbuf = addone(itemp) + endif + this%nprimvars = itemp !primary state variables 14 + 6 + + !diagnostic variables + this%lid_n2o_nit = addone(itemp) + this%lid_co2_hr = addone(itemp) + this%lid_no3_den = addone(itemp) + this%lid_minn_nh4_immob = addone(itemp) + this%lid_minn_no3_immob = addone(itemp) + this%lid_minn_nh4_plant = addone(itemp) + this%lid_minn_no3_plant = addone(itemp) + this%lid_nh4_nit = addone(itemp) + + if(CNAllocate_Carbon_only())then + this%lid_nh4_supp = addone(itemp) + endif + !aerechyma transport + this%lid_o2_paere = addone(itemp) ! + if ( spinup_state /= 1 ) then + this%lid_ar_paere = addone(itemp); this%lid_ar_aere_reac = addone(ireac) ! + this%lid_n2_paere = addone(itemp); this%lid_n2_aere_reac = addone(ireac) ! + this%lid_co2_paere = addone(itemp); this%lid_co2_aere_reac = addone(ireac) ! + this%lid_ch4_paere = addone(itemp); this%lid_ch4_aere_reac = addone(ireac) ! + this%lid_n2o_paere = addone(itemp); this%lid_n2o_aere_reac = addone(ireac) ! + endif + this%nstvars = itemp !totally 14+32 state variables + + this%nreactions = ireac !seven decomposition pathways plus root auto respiration, nitrification, denitrification and plant immobilization + allocate(this%primvarid(ireac)); this%primvarid(:) = -1 + allocate(this%is_aerobic_reac(ireac)); this%is_aerobic_reac(:)=.false. + + !decomposers, + nitrifiers, + denitrifiers, + plants, + adsorption surface + itemp1=0 + this%lid_lit1_compet = addone(itemp1) + this%lid_lit2_compet = addone(itemp1) + this%lid_lit3_compet = addone(itemp1) + this%lid_cwd_compet = addone(itemp1) + this%lid_som1_compet = addone(itemp1) + this%lid_som2_compet = addone(itemp1) + this%lid_som3_compet = addone(itemp1) + this%lid_plant_compet = addone(itemp1) + this%lid_nitri_compet = addone(itemp1) + this%lid_denit_compet = addone(itemp1) + this%lid_clay_compet = addone(itemp1) + + this%ncompets = itemp1 + + end subroutine Init_pars + !------------------------------------------------------------------------------- + + subroutine InitAllocate(this, bounds, lbj, ubj) + ! + ! !DESCRIPTION: + ! memory allocation for the data type specified by this + ! + ! !ARGUMENTS: + class(centurybgc_type) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: lbj, ubj ! lower and upper bounds, make sure they are > 0 + + + allocate(this%t_scalar_col(bounds%begc:bounds%endc, lbj:ubj)) + allocate(this%w_scalar_col(bounds%begc:bounds%endc, lbj:ubj)) + allocate(this%o_scalar_col(bounds%begc:bounds%endc, lbj:ubj)) + allocate(this%depth_scalar_col(bounds%begc:bounds%endc, lbj:ubj)) + + end subroutine InitAllocate + + !------------------------------------------------------------------------------- + subroutine init_state_vector(bounds, lbj, ubj, numf, filter, jtops, neq, & + tracerstate_vars, betrtracer_vars, centurybgc_vars, y0) + ! + ! !DESCRIPTION: + ! number of equations, total number of carbon pools + o2 + co2 + ! + ! !USES: + use tracerstatetype , only : tracerstate_type + use BeTRTracerType , only : betrtracer_type + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: lbj, ubj + integer , intent(in) :: jtops(bounds%begc:bounds%endc) ! top label of each column + integer , intent(in) :: numf + integer , intent(in) :: filter(:) + integer , intent(in) :: neq + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(tracerstate_type) , intent(in) :: tracerstate_vars + type(centurybgc_type) , intent(in) :: centurybgc_vars + real(r8) , intent(out):: y0(neq, bounds%begc:bounds%endc, lbj:ubj) + + ! !LOCAL VARIABLES: + integer :: fc, c, j + + ! all organic matter pools are distributed into solid passive tracers + do j = lbj, ubj + do fc = 1, numf + c = filter(fc) + if(j>=jtops(c))then + !zero out everything + y0(:, c, j ) = 0._r8 + + !set up nonzero variables + y0(1:centurybgc_vars%nom_pools*centurybgc_vars%nelms, c, j) = tracerstate_vars%tracer_conc_solid_passive_col(c, j, :) + + y0(centurybgc_vars%lid_n2, c, j) = max(tracerstate_vars%tracer_conc_mobile_col(c, j, betrtracer_vars%id_trc_n2) ,0._r8) + + y0(centurybgc_vars%lid_o2, c, j) = max(tracerstate_vars%tracer_conc_mobile_col(c, j, betrtracer_vars%id_trc_o2) ,0._r8) + + y0(centurybgc_vars%lid_ar, c, j) = max(tracerstate_vars%tracer_conc_mobile_col(c, j, betrtracer_vars%id_trc_ar) ,0._r8) + + y0(centurybgc_vars%lid_co2, c, j) = max(tracerstate_vars%tracer_conc_mobile_col(c, j, betrtracer_vars%id_trc_co2x),0._r8) + + y0(centurybgc_vars%lid_ch4, c, j) = max(tracerstate_vars%tracer_conc_mobile_col(c, j, betrtracer_vars%id_trc_ch4) ,0._r8) + + y0(centurybgc_vars%lid_nh4, c, j) = max(tracerstate_vars%tracer_conc_mobile_col(c, j, betrtracer_vars%id_trc_nh3x),0._r8) + + y0(centurybgc_vars%lid_no3, c, j) = max(tracerstate_vars%tracer_conc_mobile_col(c, j, betrtracer_vars%id_trc_no3x),0._r8) + + y0(centurybgc_vars%lid_n2o, c, j) = max(tracerstate_vars%tracer_conc_mobile_col(c, j, betrtracer_vars%id_trc_n2o), 0._r8) + endif + enddo + enddo + end subroutine init_state_vector + + !------------------------------------------------------------------------------- + subroutine calc_som_deacyK(bounds, lbj, ubj, numf, filter, jtops, nom_pools, & + tracercoeff_vars, tracerstate_vars, betrtracer_vars, centurybgc_vars, & + carbonflux_vars, dtime, k_decay) + ! + ! !DESCRIPTION: + ! calculate decay coefficients for different pools + ! + ! !USES: + use tracercoeffType , only : tracercoeff_type + use BetrTracerType , only : betrtracer_type + use tracerstatetype , only : tracerstate_type + use BeTRTracerType , only : betrtracer_type + use BGCCenturyParMod , only : CNDecompBgcParamsInst + use CNCarbonFluxType , only : carbonflux_type + integer , intent(in) :: nom_pools + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: lbj, ubj + integer , intent(in) :: jtops(bounds%begc:bounds%endc) ! top label of each column + integer , intent(in) :: numf + integer , intent(in) :: filter(:) + real(r8) , intent(in) :: dtime + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(centurybgc_type) , intent(in) :: centurybgc_vars + type(carbonflux_type) , intent(in) :: carbonflux_vars + type(tracercoeff_type) , intent(in) :: tracercoeff_vars + type(tracerstate_type) , intent(inout) :: tracerstate_vars + real(r8) , intent(out) :: k_decay(nom_pools, bounds%begc:bounds%endc, lbj:ubj) + ! + ! !LOCAL VARIABLES: + integer :: fc, c, j + real(r8):: dtimei + associate( & + t_scalar => carbonflux_vars%t_scalar_col , & ! Output: [real(r8) (:,:) ] soil temperature scalar for decomp + w_scalar => carbonflux_vars%w_scalar_col , & ! Output: [real(r8) (:,:) ] soil water scalar for decomp + o_scalar => carbonflux_vars%o_scalar_col , & ! Output: [real(r8) (:,:) ] fraction by which decomposition is limited by anoxia + depth_scalar => centurybgc_vars%depth_scalar_col , & ! Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec) + lit1 => centurybgc_vars%lit1 , & ! + lit2 => centurybgc_vars%lit2 , & ! + lit3 => centurybgc_vars%lit3 , & ! + som1 => centurybgc_vars%som1 , & ! + som2 => centurybgc_vars%som2 , & ! + som3 => centurybgc_vars%som3 , & ! + cwd => centurybgc_vars%cwd , & ! + k_decay_lit1 => CNDecompBgcParamsInst%k_decay_lit1 , & ! + k_decay_lit2 => CNDecompBgcParamsInst%k_decay_lit2 , & ! + k_decay_lit3 => CNDecompBgcParamsInst%k_decay_lit3 , & ! + k_decay_som1 => CNDecompBgcParamsInst%k_decay_som1 , & ! + k_decay_som2 => CNDecompBgcParamsInst%k_decay_som2 , & ! + k_decay_som3 => CNDecompBgcParamsInst%k_decay_som3 , & ! + k_decay_cwd => CNDecompBgcParamsInst%k_decay_cwd & ! + ) + + dtimei=1._r8/dtime + k_decay(:, :, :) = spval + do j = lbj, ubj + do fc = 1, numf + c = filter(fc) + if(j>=jtops(c))then + k_decay(lit1, c, j) = min(k_decay_lit1 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * depth_scalar(c,j),dtimei) + k_decay(lit2, c, j) = min(k_decay_lit2 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * depth_scalar(c,j),dtimei) + k_decay(lit3, c, j) = min(k_decay_lit3 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * depth_scalar(c,j),dtimei) + k_decay(som1, c, j) = min(k_decay_som1 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * depth_scalar(c,j),dtimei) + k_decay(som2, c, j) = min(k_decay_som2 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * depth_scalar(c,j),dtimei) + k_decay(som3, c, j) = min(k_decay_som3 * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * depth_scalar(c,j),dtimei) + k_decay(cwd, c, j) = min(k_decay_cwd * t_scalar(c,j) * w_scalar(c,j) * o_scalar(c,j) * depth_scalar(c,j),dtimei) + endif + enddo + enddo + end associate + end subroutine calc_som_deacyK + + + !------------------------------------------------------------------------------- + subroutine calc_sompool_decay(bounds, lbj, ubj, numf, filter, jtops, & + centurybgc_vars, k_decay, om_pools, decay_rates) + ! + ! !DESCRIPTION: + ! calculate degradation for all different pools + ! + ! !USES: + type(centurybgc_type) , intent(in) :: centurybgc_vars + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: lbj, ubj + integer , intent(in) :: jtops(bounds%begc:bounds%endc) ! top label of each column + integer , intent(in) :: numf + integer , intent(in) :: filter(:) + real(r8) , intent(inout) :: k_decay(centurybgc_vars%nom_pools, bounds%begc:bounds%endc, lbj:ubj) + real(r8) , intent(in) :: om_pools(centurybgc_vars%nom_totelms,bounds%begc:bounds%endc, lbj:ubj) + real(r8) , intent(out) :: decay_rates(centurybgc_vars%nom_pools, bounds%begc:bounds%endc, lbj:ubj) + + ! !LOCAL VARIABLES: + integer :: jj, fc, c, j + integer :: kc, kn + associate( & + nelms => centurybgc_vars%nelms , & + nom_pools => centurybgc_vars%nom_pools , & + nom_totelms => centurybgc_vars%nom_totelms, & + c_loc => centurybgc_vars%c_loc , & + n_loc => centurybgc_vars%n_loc & + ) + + do j = lbj, ubj + do fc = 1, numf + c = filter(fc) + if(j>=jtops(c))then + !for om pools + do jj = 1, nom_pools + kc = (jj-1) * nelms + c_loc + kn = (jj-1) * nelms + n_loc + if(min(om_pools(kc, c, j),om_pools(kn, c, j))<1.e-10_r8)then + k_decay(jj,c,j) = 0._r8 + endif + decay_rates(jj, c, j) = om_pools(kc, c, j) * k_decay(jj, c, j) + enddo + endif + enddo + enddo + + !for nitrification and denitrification + end associate + end subroutine calc_sompool_decay + + !------------------------------------------------------------------------------- + + subroutine retrieve_flux_vars(bounds, lbj, ubj, numf, filter, jtops, neq, dtime, yf, y0, & + centurybgc_vars, betrtracer_vars, tracerflux_vars, carbonflux_vars, nitrogenflux_vars, & + plantsoilnutrientflux_vars) + ! + ! !DESCRIPTION: + ! + ! retrieve the fluxes + ! !USES: + use tracerfluxType , only : tracerflux_type + use PlantSoilnutrientFluxType, only : plantsoilnutrientflux_type + use CNCarbonFluxType , only : carbonflux_type + use CNNitrogenFluxType , only : nitrogenflux_type + use BeTRTracerType , only : betrtracer_type + + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: lbj, ubj + integer, intent(in) :: jtops(bounds%begc:bounds%endc) ! top label of each column + integer, intent(in) :: numf + integer, intent(in) :: filter(:) + integer , intent(in) :: neq + real(r8) , intent(in) :: dtime + real(r8) , intent(in) :: yf(neq, bounds%begc:bounds%endc, lbj:ubj) ! + real(r8) , intent(in) :: y0(neq, bounds%begc:bounds%endc, lbj:ubj) ! + type(centurybgc_type) , intent(in) :: centurybgc_vars + type(betrtracer_type) , intent(in) :: betrtracer_vars + type(carbonflux_type) , intent(inout) :: carbonflux_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + type(tracerflux_type) , intent(inout) :: tracerflux_vars + type(plantsoilnutrientflux_type), intent(inout) :: plantsoilnutrientflux_vars + + ! !LOCAL VARIABLES: + real(r8) :: deltac, fnit + real(r8) :: delta_nh4, delta_no3 + real(r8) :: delta_nh4_m,delta_no3_m + real(r8) :: sminn_plant, sminn_plant2 + real(r8) :: err,hr, immob + real(r8) :: f_nit_n2o, f_den + integer :: fc, c, j, k + + associate( & ! + nom_pools => centurybgc_vars%nom_pools , & ! + nelms => centurybgc_vars%nelms , & ! + c_loc => centurybgc_vars%c_loc , & ! + n_loc => centurybgc_vars%n_loc , & ! + f_n2o_nit_vr => nitrogenflux_vars%f_n2o_nit_vr_col , & ! + f_denit_vr => nitrogenflux_vars%f_denit_vr_col , & ! + f_nit_vr => nitrogenflux_vars%f_nit_vr_col , & ! + actual_immob_no3_vr => nitrogenflux_vars%actual_immob_no3_vr_col , & ! + actual_immob_nh4_vr => nitrogenflux_vars%actual_immob_nh4_vr_col , & ! + smin_no3_to_plant_vr => nitrogenflux_vars%smin_no3_to_plant_vr_col , & ! + smin_nh4_to_plant_vr => nitrogenflux_vars%smin_nh4_to_plant_vr_col , & ! + supplement_to_sminn_vr=> nitrogenflux_vars%supplement_to_sminn_vr_col , & ! + hr_vr => carbonflux_vars%hr_vr_col , & ! + volatileid => betrtracer_vars%volatileid , & ! + ngwmobile_tracers => betrtracer_vars%ngwmobile_tracers , & ! + tracer_flx_netpro_vr => tracerflux_vars%tracer_flx_netpro_vr_col , & ! + tracer_flx_parchm_vr => tracerflux_vars%tracer_flx_parchm_vr_col & ! + ) + + if(CNAllocate_Carbon_only())then + do j = lbj, ubj + do fc = 1, numf + c = filter(fc) + supplement_to_sminn_vr(c,j) = (y0(centurybgc_vars%lid_nh4_supp, c, j) - yf(centurybgc_vars%lid_nh4_supp, c, j))*natomw/dtime + enddo + enddo + endif + + do j = lbj, ubj + do fc = 1, numf + c = filter(fc) + + if(j>=jtops(c))then + plantsoilnutrientflux_vars%plant_minn_active_yield_flx_vr_col(c,j) = (yf(centurybgc_vars%lid_plant_minn, c, j) - y0(centurybgc_vars%lid_plant_minn, c, j))*natomw + + smin_no3_to_plant_vr(c,j) = (yf(centurybgc_vars%lid_minn_no3_plant, c, j) - y0(centurybgc_vars%lid_minn_no3_plant, c, j))*natomw/dtime + smin_nh4_to_plant_vr(c,j) = (yf(centurybgc_vars%lid_minn_nh4_plant, c, j) - y0(centurybgc_vars%lid_minn_nh4_plant, c, j))*natomw/dtime + + hr_vr (c,j) = (yf(centurybgc_vars%lid_co2_hr, c, j) - y0(centurybgc_vars%lid_co2_hr, c, j))*catomw/dtime + f_nit_vr (c,j) = (yf(centurybgc_vars%lid_nh4_nit,c, j) - y0(centurybgc_vars%lid_nh4_nit,c, j))*natomw/dtime + f_n2o_nit_vr(c,j) = (yf(centurybgc_vars%lid_n2o_nit,c, j) - y0(centurybgc_vars%lid_n2o_nit,c, j))*natomw/dtime + f_denit_vr (c,j) = (yf(centurybgc_vars%lid_no3_den,c, j) - y0(centurybgc_vars%lid_no3_den,c, j))*natomw/dtime + + actual_immob_no3_vr(c,j) = (yf(centurybgc_vars%lid_minn_no3_immob,c, j) - y0(centurybgc_vars%lid_minn_no3_immob,c, j))*natomw/dtime + actual_immob_nh4_vr(c,j) = (yf(centurybgc_vars%lid_minn_nh4_immob,c, j) - y0(centurybgc_vars%lid_minn_nh4_immob,c, j))*natomw/dtime + + !the temporal averaging for fluxes below will be done later + + tracer_flx_parchm_vr(c,j,volatileid(betrtracer_vars%id_trc_o2) ) = yf(centurybgc_vars%lid_o2_paere ,c, j) - y0(centurybgc_vars%lid_o2_paere , c, j) + + if ( spinup_state /= 1 ) then + tracer_flx_parchm_vr(c,j,volatileid(betrtracer_vars%id_trc_n2) ) = yf(centurybgc_vars%lid_n2_paere ,c, j) - y0(centurybgc_vars%lid_n2_paere , c, j) + tracer_flx_parchm_vr(c,j,volatileid(betrtracer_vars%id_trc_ar) ) = yf(centurybgc_vars%lid_ar_paere ,c, j) - y0(centurybgc_vars%lid_ar_paere , c, j) + tracer_flx_parchm_vr(c,j,volatileid(betrtracer_vars%id_trc_co2x)) = yf(centurybgc_vars%lid_co2_paere ,c, j) - y0(centurybgc_vars%lid_co2_paere, c, j) + tracer_flx_parchm_vr(c,j,volatileid(betrtracer_vars%id_trc_ch4) ) = yf(centurybgc_vars%lid_ch4_paere ,c, j) - y0(centurybgc_vars%lid_ch4_paere, c, j) + tracer_flx_parchm_vr(c,j,volatileid(betrtracer_vars%id_trc_n2o) ) = yf(centurybgc_vars%lid_n2o_paere ,c, j) - y0(centurybgc_vars%lid_n2o_paere, c, j) + endif + + tracer_flx_netpro_vr(c,j,betrtracer_vars%id_trc_nh3x) = & + tracer_flx_netpro_vr(c,j,betrtracer_vars%id_trc_nh3x) + & + yf(centurybgc_vars%lid_nh4,c,j) - y0(centurybgc_vars%lid_nh4,c,j) + + tracer_flx_netpro_vr(c,j,betrtracer_vars%id_trc_no3x) = & + tracer_flx_netpro_vr(c,j,betrtracer_vars%id_trc_no3x) + & + yf(centurybgc_vars%lid_no3,c,j) - y0(centurybgc_vars%lid_no3,c,j) + + tracer_flx_netpro_vr(c,j,betrtracer_vars%id_trc_n2) = & + yf(centurybgc_vars%lid_n2,c,j) - y0(centurybgc_vars%lid_n2,c,j) + + tracer_flx_netpro_vr(c,j,betrtracer_vars%id_trc_co2x ) = & + yf(centurybgc_vars%lid_co2,c,j) - y0(centurybgc_vars%lid_co2,c,j) + + tracer_flx_netpro_vr(c,j,betrtracer_vars%id_trc_n2o ) = & + yf(centurybgc_vars%lid_n2o,c,j) - y0(centurybgc_vars%lid_n2o,c,j) + + tracer_flx_netpro_vr(c,j,betrtracer_vars%id_trc_o2 ) = & + yf(centurybgc_vars%lid_o2,c,j) - y0(centurybgc_vars%lid_o2,c,j) + + tracer_flx_netpro_vr(c,j,betrtracer_vars%id_trc_ch4 ) = & + yf(centurybgc_vars%lid_ch4,c,j) - y0(centurybgc_vars%lid_ch4,c,j) + + tracer_flx_netpro_vr(c,j,betrtracer_vars%id_trc_ar) = & + yf(centurybgc_vars%lid_ar,c,j) - y0(centurybgc_vars%lid_ar,c,j) + + !get net production for om pools + deltac=0._r8 + do k = 1, nom_pools + tracer_flx_netpro_vr(c,j,ngwmobile_tracers+(k-1)*nelms+c_loc) = & + tracer_flx_netpro_vr(c,j,ngwmobile_tracers+(k-1)*nelms+c_loc) + & + yf((k-1)*nelms+c_loc, c, j) - y0((k-1)*nelms+c_loc, c, j) + + tracer_flx_netpro_vr(c,j,ngwmobile_tracers+(k-1)*nelms+n_loc) = & + tracer_flx_netpro_vr(c,j,ngwmobile_tracers+(k-1)*nelms+n_loc) + & + yf((k-1)*nelms+n_loc, c, j) - y0((k-1)*nelms+n_loc, c, j) + enddo + endif + enddo + + enddo + + end associate + end subroutine retrieve_flux_vars + !------------------------------------------------------------------------------- + + subroutine retrieve_state_vars(bounds, lbj, ubj, numf, filter, jtops, neq, yf, & + centurybgc_vars, betrtracer_vars, tracerstate_vars) + ! + ! !DESCRIPTION: + ! retrieve state variables + ! number of equations, total number of carbon pools + o2 + co2 + ! !USES: + use tracerstatetype , only : tracerstate_type + use BeTRTracerType , only : betrtracer_type + use MathfuncMod , only : addone + + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: lbj, ubj + integer , intent(in) :: jtops(bounds%begc:bounds%endc) ! top label of each column + integer , intent(in) :: numf + integer , intent(in) :: filter(:) + integer , intent(in) :: neq + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(centurybgc_type) , intent(in) :: centurybgc_vars + real(r8) , intent(in) :: yf(neq, bounds%begc:bounds%endc, lbj:ubj) ! + type(tracerstate_type) , intent(inout) :: tracerstate_vars + + ! !LOCAL VARIABLES: + integer :: fc, c, j, k1, k2, k, ll, l + real(r8):: totsomc + ! all organic matter pools are distributed into solid passive tracers + associate( & + ngwtracers => betrtracer_vars%ngwmobile_tracers , & ! + tracer_conc_mobile_col => tracerstate_vars%tracer_conc_mobile_col & + ) + + !only retrieve non-mobile tracers + + do k = 1, ndecomp_pools + do l = 1, centurybgc_vars%nelms + ll = (k-1)*centurybgc_vars%nelms + l + do j = lbj, ubj !currently, om is added only to soil layers + do fc = 1, numf + c = filter(fc) + if(j>=jtops(c))then + tracerstate_vars%tracer_conc_solid_passive_col(c, j, ll) = yf(ll, c, j) + endif + enddo + enddo + enddo + enddo + + k1 = betrtracer_vars%id_trc_o2 ; k2 = centurybgc_vars%lid_o2 ; + call assign_A2B(bounds, lbj, ubj, neq, ngwtracers, numf, filter, jtops, k1, k2, yf(:,bounds%begc:bounds%endc, lbj:ubj), tracer_conc_mobile_col(bounds%begc:bounds%endc,lbj:ubj,:)) + k1 = betrtracer_vars%id_trc_co2x ; k2 = centurybgc_vars%lid_co2 ; + call assign_A2B(bounds, lbj, ubj, neq, ngwtracers, numf, filter, jtops, k1, k2, yf(:,bounds%begc:bounds%endc, lbj:ubj), tracer_conc_mobile_col(bounds%begc:bounds%endc,lbj:ubj,:)) + k1 = betrtracer_vars%id_trc_nh3x ; k2 = centurybgc_vars%lid_nh4 ; + call assign_A2B(bounds, lbj, ubj, neq, ngwtracers, numf, filter, jtops, k1, k2, yf(:,bounds%begc:bounds%endc, lbj:ubj), tracer_conc_mobile_col(bounds%begc:bounds%endc,lbj:ubj,:)) + k1 = betrtracer_vars%id_trc_no3x ; k2 = centurybgc_vars%lid_no3 ; + call assign_A2B(bounds, lbj, ubj, neq, ngwtracers, numf, filter, jtops, k1, k2, yf(:,bounds%begc:bounds%endc, lbj:ubj), tracer_conc_mobile_col(bounds%begc:bounds%endc,lbj:ubj,:)) + k1 = betrtracer_vars%id_trc_n2 ; k2 = centurybgc_vars%lid_n2 ; + call assign_A2B(bounds, lbj, ubj, neq, ngwtracers, numf, filter, jtops, k1, k2, yf(:,bounds%begc:bounds%endc, lbj:ubj), tracer_conc_mobile_col(bounds%begc:bounds%endc,lbj:ubj,:)) + k1 = betrtracer_vars%id_trc_ar ; k2 = centurybgc_vars%lid_ar ; + call assign_A2B(bounds, lbj, ubj, neq, ngwtracers, numf, filter, jtops, k1, k2, yf(:,bounds%begc:bounds%endc, lbj:ubj), tracer_conc_mobile_col(bounds%begc:bounds%endc,lbj:ubj,:)) + k1 = betrtracer_vars%id_trc_ch4 ; k2 = centurybgc_vars%lid_ch4 ; + call assign_A2B(bounds, lbj, ubj, neq, ngwtracers, numf, filter, jtops, k1, k2, yf(:,bounds%begc:bounds%endc, lbj:ubj), tracer_conc_mobile_col(bounds%begc:bounds%endc,lbj:ubj,:)) + k1 = betrtracer_vars%id_trc_n2o ; k2 = centurybgc_vars%lid_n2o ; + call assign_A2B(bounds, lbj, ubj, neq, ngwtracers, numf, filter, jtops, k1, k2, yf(:,bounds%begc:bounds%endc, lbj:ubj), tracer_conc_mobile_col(bounds%begc:bounds%endc,lbj:ubj,:)) + + end associate + end subroutine retrieve_state_vars + !------------------------------------------------------------------------------- + + subroutine assign_A2B(bounds, lbj, ubj, neq, ngwtracers, numf, filter, jtops, & + k1, k2, yf, tracer_conc_mobile_col) + + ! + ! !DESCRIPTION: + ! assign state variables + ! + implicit none + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: lbj, ubj + integer, intent(in) :: jtops(bounds%begc:bounds%endc) ! top label of each column + integer, intent(in) :: numf + integer, intent(in) :: filter(:) + integer, intent(in) :: k1, k2, neq, ngwtracers + real(r8), intent(in) :: yf(neq, bounds%begc:bounds%endc, lbj:ubj) + real(r8), intent(inout) :: tracer_conc_mobile_col(bounds%begc:bounds%endc,lbj:ubj,ngwtracers) + + ! !LOCAL VARIABLES: + integer :: j, fc, c + + do j = lbj, ubj !currently, om is added only to soil layers + do fc = 1, numf + c = filter(fc) + if(j>=jtops(c))then + tracer_conc_mobile_col(c, j, k1) = yf(k2, c, j) + endif + enddo + enddo + end subroutine assign_A2B + + !------------------------------------------------------------------------------- + subroutine calc_nitrif_denitrif_rate(bounds, lbj, ubj, numf, filter, jtops, dz, t_soisno, pH, & + pot_co2_hr, anaerobic_frac, smin_nh4_vr, smin_no3_vr, soilstate_vars, waterstate_vars, & + carbonflux_vars, n2_n2o_ratio_denit, nh4_no3_ratio, decay_nh4, decay_no3) + ! + ! !DESCRIPTION: + ! calculate nitrification denitrification rate + ! the actual nitrification rate will be f_nitr * [nh4] + ! and the actual denitri rate will be of f_denit * [no3] + ! + ! !USES: + use clm_varcon , only : rpi, secspday + use SoilStatetype , only : soilstate_type + use WaterStateType , only : waterstate_type + use MathfuncMod , only : safe_div + use shr_const_mod , only : SHR_CONST_TKFRZ + use CNCarbonFluxType , only : carbonflux_type + + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: lbj, ubj + integer, intent(in) :: jtops(bounds%begc: ) ! top label of each column + integer, intent(in) :: numf + integer, intent(in) :: filter(:) + real(r8), intent(in) :: dz(bounds%begc: , lbj: ) + real(r8), intent(in) :: pH(bounds%begc: , lbj: ) !pH of soil + real(r8), intent(in) :: t_soisno(bounds%begc: , lbj: ) !soil temperature + real(r8), intent(in) :: pot_co2_hr(bounds%begc: , lbj: ) !potential aerobic heteotrophic respiration, mol CO2/m3/s + real(r8), intent(in) :: anaerobic_frac(bounds%begc: , lbj: ) !fraction of anaerobic soil + real(r8), intent(in) :: smin_nh4_vr(bounds%begc: , lbj: ) + real(r8), intent(in) :: smin_no3_vr(bounds%begc: , lbj: ) !soil no3 concentration [mol N/m3] + type(waterstate_type) , intent(in) :: waterstate_vars + type(soilstate_type) , intent(in) :: soilstate_vars + type(carbonflux_type) , intent(in) :: carbonflux_vars + real(r8) , intent(out) :: n2_n2o_ratio_denit(bounds%begc: , lbj: ) !ratio of n2 to n2o in denitrification + real(r8) , intent(out) :: nh4_no3_ratio(bounds%begc: , lbj: ) !ratio of soil nh4 and no3 + real(r8) , intent(out) :: decay_nh4(bounds%begc: ,lbj: ) !1/s, decay rate of nh4 + real(r8) , intent(out) :: decay_no3(bounds%begc: ,lbj: ) !1/s, decay rate of no3 + + ! !LOCAL VARIABLES: + logical, parameter :: no_frozen_nitrif_denitrif = .false. !this is a testing parameter, just to make the model run + real(r8) :: soil_hr_vr(bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: k_nitr_t_vr(bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: k_nitr_ph_vr(bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: k_nitr_h2o_vr(bounds%begc:bounds%endc,lbj:ubj) + real(r8) :: k_nitr_vr(bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: pot_f_nit_vr(bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: soil_bulkdensity(bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: smin_no3_massdens_vr(bounds%begc:bounds%endc,lbj:ubj) + real(r8) :: soil_co2_prod(bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: fmax_denit_carbonsubstrate_vr(bounds%begc:bounds%endc, lbj:ubj) ! + real(r8) :: fmax_denit_nitrate_vr(bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: f_denit_base_vr(bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: ratio_k1(bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: diffus(bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: ratio_no3_co2(bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: wfps_vr(bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: fr_WFPS(bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: pot_f_denit_vr(bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: co2diff_con(2) = (/0.1325_r8, 0.0009_r8/) + real(r8) :: g_per_m3__to__ug_per_gsoil + real(r8) :: g_per_m3_sec__to__ug_per_gsoil_day + real(r8) :: k_nitr_max + integer :: fc, c, j + + SHR_ASSERT_ALL((ubound(jtops) == (/bounds%endc/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(pH) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(t_soisno) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(pot_co2_hr) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(anaerobic_frac) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(smin_nh4_vr) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(smin_no3_vr) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(n2_n2o_ratio_denit) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(nh4_no3_ratio) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(decay_nh4) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(decay_no3) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) + + associate( & + bd => soilstate_vars%bd_col , & ! + watsat => soilstate_vars%watsat_col , & ! + h2osoi_vol => waterstate_vars%h2osoi_vol_col , & ! + h2osoi_liq => waterstate_vars%h2osoi_liq_col , & ! + finundated => waterstate_vars%finundated_col , & ! Input: [real(r8) (:)] + t_scalar => carbonflux_vars%t_scalar_col , & ! Input: [real(r8) (:,:) ] soil temperature scalar for decomp + w_scalar => carbonflux_vars%w_scalar_col & ! Input: [real(r8) (:,:) ] soil water scalar for decomp + ) + + ! Set maximum nitrification rate constant + k_nitr_max = 0.1_r8 / secspday ! [1/sec] 10%/day Parton et al., 2001 + + + decay_nh4(:, :) = spval + decay_no3(:, :) = spval + do j = lbj, ubj + do fc = 1,numf + c = filter(fc) + if(j 0 ) then + ratio_no3_co2(c,j) = smin_no3_massdens_vr(c,j) / soil_co2_prod(c,j) + else + ! fucntion saturates at large no3/co2 ratios, so set as some nominally large number + ratio_no3_co2(c,j) = 100._r8 + endif + + ! total water limitation function (Del Grosso et al., 2000, figure 7a) + wfps_vr(c,j) = max(min(h2osoi_vol(c,j)/watsat(c, j), 1._r8), 0._r8) * 100._r8 + fr_WFPS(c,j) = max(0.1_r8, 0.015_r8 * wfps_vr(c,j) - 0.32_r8) + + ! final ratio expression + n2_n2o_ratio_denit(c,j) = max(0.16*ratio_k1(c,j), ratio_k1(c,j)*exp(-0.8 * ratio_no3_co2(c,j))) * fr_WFPS(c,j) + enddo + enddo + + + end associate + end subroutine calc_nitrif_denitrif_rate + + !---------------------------------------------------------------------------------------------------- + + + subroutine calc_anaerobic_frac(bounds, lbj, ubj, numf, filter, jtops, t_soisno, soilstate_vars, & + h2osoi_vol, o2_decomp_depth_unsat, conc_o2_unsat, anaerobic_frac) + ! + ! !DESCRIPTION: + ! + ! calculate soil anoxia state for doing nitrification and denitrification + ! Rewritten based on Charlie Koven's code by Jinyun Tang + ! !USES: + use CNSharedParamsMod , only : CNParamsShareInst + use clm_varcon , only : d_con_g, grav, d_con_w + use SoilStatetype , only : soilstate_type + use BGCCenturyParMod , only : CNNitrifDenitrifParamsInst + + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: lbj, ubj + integer, intent(in) :: jtops(bounds%begc: ) ! top label of each column + integer, intent(in) :: numf + integer, intent(in) :: filter(:) !indices + type(soilstate_type), intent(in) :: soilstate_vars + real(r8), intent(in) :: t_soisno(bounds%begc: , lbj: ) + real(r8), intent(in) :: h2osoi_vol(bounds%begc:, lbj: ) + real(r8), intent(in) :: o2_decomp_depth_unsat(bounds%begc: ,lbj: ) !potential o2 consumption, as deduced from aerobic heteorotrophic decomposition, mol o2/m3/s + real(r8), intent(in) :: conc_o2_unsat(bounds%begc: , lbj: ) !bulk soil o2 concentration, mol/m3 + real(r8), intent(out) :: anaerobic_frac(bounds%begc: , lbj: ) !fraction of aerobic soil + ! !LOCAL VARIABLES: + real(r8), parameter :: rho_w = 1.e3_r8 ![kg/m3] + real(r8) :: f_a + real(r8) :: eps + real(r8) :: om_frac + real(r8) :: diffus(bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: organic_max + real(r8) :: rij_kro_a + real(r8) :: rij_kro_alpha + real(r8) :: rij_kro_beta + real(r8) :: rij_kro_gamma + real(r8) :: rij_kro_delta + real(r8) :: surface_tension_water + real(r8) :: r_min_sat + real(r8) :: r_psi_sat + real(r8) :: r_max(bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: r_min(bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: r_psi(bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: anaerobic_frac_sat + real(r8) :: ratio_diffusivity_water_gas(bounds%begc:bounds%endc, lbj:ubj) + integer :: fc, c, j + + SHR_ASSERT_ALL((ubound(jtops) == (/bounds%endc/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(t_soisno) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(o2_decomp_depth_unsat) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(conc_o2_unsat) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(anaerobic_frac) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((ubound(h2osoi_vol) == (/bounds%endc, ubj/)) , errMsg(__FILE__,__LINE__)) + + associate( & + watsat => soilstate_vars%watsat_col , & + watfc => soilstate_vars%watfc_col , & + bsw => soilstate_vars%bsw_col , & + sucsat => soilstate_vars%sucsat_col , & + soilpsi => soilstate_vars%soilpsi_col , & + cellorg => soilstate_vars%cellorg_col & + ) + + surface_tension_water = CNNitrifDenitrifParamsInst%surface_tension_water + + ! Set parameters from simple-structure model to calculate anoxic fratction (Arah and Vinten 1995) + rij_kro_a = CNNitrifDenitrifParamsInst%rij_kro_a + rij_kro_alpha = CNNitrifDenitrifParamsInst%rij_kro_alpha + rij_kro_beta = CNNitrifDenitrifParamsInst%rij_kro_beta + rij_kro_gamma = CNNitrifDenitrifParamsInst%rij_kro_gamma + rij_kro_delta = CNNitrifDenitrifParamsInst%rij_kro_delta + + organic_max = CNParamsShareInst%organic_max + + do j = lbj, ubj + do fc = 1,numf + c = filter(fc) + if(j 0._r8) then + om_frac = min(cellorg(c,j)/organic_max, 1._r8) + ! Use first power, not square as in iniTimeConst + else + om_frac = 1._r8 + end if + diffus (c,j) = (d_con_g(2,1) + d_con_g(2,2)*t_soisno(c,j)) * 1.e-4_r8 * & + (om_frac * f_a**(10._r8/3._r8) / watsat(c,j)**2 + & + (1._r8-om_frac) * eps**2 * f_a**(3._r8 / bsw(c,j)) ) + + ! calculate anoxic fraction of soils + ! use rijtema and kroess model after Riley et al., 2000 + ! caclulated r_psi as a function of psi + r_min(c,j) = 2 * surface_tension_water / (rho_w * grav * abs(soilpsi(c,j))) + r_max(c,j) = 2 * surface_tension_water / (rho_w * grav * 0.1_r8) + r_psi(c,j) = sqrt(r_min(c,j) * r_max(c,j)) + ratio_diffusivity_water_gas(c,j) = (d_con_g(2,1) + d_con_g(2,2)*t_soisno(c,j) ) * 1.e-4_r8 / & + ((d_con_w(2,1) + d_con_w(2,2)*t_soisno(c,j) + d_con_w(2,3)*t_soisno(c,j)**2) * 1.e-9_r8) + + if (o2_decomp_depth_unsat(c,j) /= spval .and. conc_o2_unsat(c,j) /= spval .and. & + o2_decomp_depth_unsat(c,j) > 0._r8) then + anaerobic_frac(c,j) = exp(-rij_kro_a * r_psi(c,j)**(-rij_kro_alpha) * & + o2_decomp_depth_unsat(c,j)**(-rij_kro_beta) * & + conc_o2_unsat(c,j)**rij_kro_gamma * (h2osoi_vol(c,j) + ratio_diffusivity_water_gas(c,j) * & + watsat(c,j))**rij_kro_delta) + else + anaerobic_frac(c,j) = 0._r8 + endif + + enddo + enddo + end associate + end subroutine calc_anaerobic_frac + + !---------------------------------------------------------------------------------------------------- + + subroutine calc_potential_aerobic_hr(bounds, lbj, ubj, numf, filter, jtops, cn_ratios, cp_ratios, & + centurybgc_vars, pot_decay_rates, pct_sand, pot_co2_hr, pot_nh3_immob) + ! + ! DESCRIPTION: + ! calculate potential aerobic heteorotrophic respiration, and potential oxygen consumption based on cascade_matrix + ! !USES: + use MathfuncMod , only : dot_sum + use CNSharedParamsMod , only : CNParamsShareInst + use CNSharedParamsMod , only : CNParamsShareInst + use BGCCenturyParMod , only : CNDecompBgcParamsInst + use MathfuncMod , only : safe_div + + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: lbj, ubj + integer , intent(in) :: jtops(bounds%begc:bounds%endc) ! top label of each column + integer , intent(in) :: numf + integer , intent(in) :: filter(:) + type(centurybgc_type) , intent(in) :: centurybgc_vars + real(r8) , intent(in) :: cn_ratios(centurybgc_vars%nom_pools, bounds%begc:bounds%endc, lbj:ubj) + real(r8) , intent(in) :: cp_ratios(centurybgc_vars%nom_pools, bounds%begc:bounds%endc, lbj:ubj) + real(r8) , intent(in) :: pot_decay_rates(centurybgc_vars%nom_pools, bounds%begc:bounds%endc, lbj:ubj) + real(r8) , intent(in) :: pct_sand(bounds%begc:bounds%endc, lbj:ubj) + real(r8) , intent(out):: pot_co2_hr(bounds%begc:bounds%endc, lbj:ubj) + real(r8) , intent(out):: pot_nh3_immob(bounds%begc:bounds%endc, lbj:ubj) + + ! !LOCAL VARIABLES: + real(r8) :: ftxt, f1, f2 + real(r8) :: cascade_matrix_hr(centurybgc_vars%nom_pools) + real(r8) :: cascade_matrix_nh3(centurybgc_vars%nom_pools) + + integer :: fc, c, j, reac + + associate( & ! + nom_pools => centurybgc_vars%nom_pools , & ! + lit1 => centurybgc_vars%lit1 , & ! + lit2 => centurybgc_vars%lit2 , & ! + lit3 => centurybgc_vars%lit3 , & ! + som1 => centurybgc_vars%som1 , & ! + som2 => centurybgc_vars%som2 , & ! + som3 => centurybgc_vars%som3 , & ! + cwd => centurybgc_vars%cwd , & ! + lit1_dek_reac=> centurybgc_vars%lit1_dek_reac , & ! + lit2_dek_reac=> centurybgc_vars%lit2_dek_reac , & ! + lit3_dek_reac=> centurybgc_vars%lit3_dek_reac , & ! + som1_dek_reac=> centurybgc_vars%som1_dek_reac , & ! + som2_dek_reac=> centurybgc_vars%som2_dek_reac , & ! + som3_dek_reac=> centurybgc_vars%som3_dek_reac , & ! + cwd_dek_reac=> centurybgc_vars%cwd_dek_reac & ! + ) + + do j = lbj, ubj + do fc = 1, numf + c = filter(fc) + if(j som1 + !lit1 + 0.55*o2 -> 0.45 som1 + 0.55co2 + (1/cn_ratios(lit1) - 0.45/cn_ratios(som1))+ (1/cp_ratios(lit1)-0.45/cp_ratios(som1)) + reac=lit1_dek_reac + cascade_matrix_hr(reac) = CNDecompBgcParamsInst%rf_l1s1_bgc + cascade_matrix_nh3(reac) = safe_div(1._r8,cn_ratios(lit1,c,j)) - safe_div(1._r8-CNDecompBgcParamsInst%rf_l1s1_bgc,cn_ratios(som1,c,j)) + + cascade_matrix_nh3(reac) = min(cascade_matrix_nh3(reac) , 0._r8) + !reaction 2, lit2 -> som1 + !lit2 + 0.5 o2 -> 0.5 som1 + 0.5 co2 + (1/cn_ratios(lit2)-0.5/cn_ratios(som1)) +(1/cp_ratios(lit2)-0.5/cp_ratios(som1)) + reac = lit2_dek_reac + cascade_matrix_hr(reac) = CNDecompBgcParamsInst%rf_l2s1_bgc + cascade_matrix_nh3(reac) = safe_div(1._r8,cn_ratios(lit2,c,j)) - safe_div(1._r8-CNDecompBgcParamsInst%rf_l2s1_bgc,cn_ratios(som1,c,j)) + + cascade_matrix_nh3(reac) = min(cascade_matrix_nh3(reac) , 0._r8) + + !reaction 3, lit3 -> som2 + !lit3 + 0.5 o2 -> 0.5 som2 + 0.5 co2 + reac = lit3_dek_reac + cascade_matrix_hr(reac) = CNDecompBgcParamsInst%rf_l3s2_bgc + cascade_matrix_nh3(reac) = safe_div(1._r8,cn_ratios(lit3,c,j)) - safe_div(1._r8-CNDecompBgcParamsInst%rf_l3s2_bgc,cn_ratios(som2,c,j)) + + cascade_matrix_nh3(reac) = min(cascade_matrix_nh3(reac) , 0._r8) + + !reaction 4, the partition into som2 and som3 is soil texture dependent, som1->som2, som3 + !som1 + f(txt) o2 -> f1*som2 + f2*som3 + f(txt) co2 + (1/cn_ratios(som1)-f1/cn_ratios(som2)-f2/cn_ratios(som3)) +(1/cp_ratios(som1)-f1/cp_ratios(som2)-f2/cp_ratios(som3)) + reac = som1_dek_reac + !f(txt) = 0.85_r8 - 0.68_r8 * 0.01_r8 * (100._r8 - sand), assuming sand = 30% + !f1+f2+f(txt)=1._r8 + ftxt = 0.85_r8 - 0.68_r8 * 0.01_r8 * (100._r8 - pct_sand(c,j)) + f1 = 0.996*(1._r8-ftxt) + f2 = 0.004*(1._r8-ftxt) + + cascade_matrix_hr(reac) = ftxt + cascade_matrix_nh3(reac) = safe_div(1._r8,cn_ratios(som1,c,j))-safe_div(f1,cn_ratios(som2,c,j))-safe_div(f2,cn_ratios(som3,c,j)) + + cascade_matrix_nh3(reac) = min(cascade_matrix_nh3(reac) , 0._r8) + + !reaction 5, som2 -> som1, som3 + !som2 + 0.55 o2 -> 0.42 som1 + 0.03som3 + 0.55co2 + (1/cn_ratios(som2)-0.42/cn_ratios(som1)-0.03/cn_ratios(som3)) + (1/cp_raitos(som2)-0.42/cp_ratios(som1)-0.03/cp_ratios(som3)) + reac = som2_dek_reac + cascade_matrix_hr(reac) = CNDecompBgcParamsInst%rf_s2s1_bgc + cascade_matrix_nh3(reac) = safe_div(1._r8,cn_ratios(som2,c,j))-0.93_r8*safe_div(1._r8-CNDecompBgcParamsInst%rf_s2s1_bgc,cn_ratios(som1,c,j)) & + -0.07_r8*safe_div(1._r8-CNDecompBgcParamsInst%rf_s2s1_bgc,cn_ratios(som3,c,j)) + cascade_matrix_nh3(reac) = min(cascade_matrix_nh3(reac) , 0._r8) + + !reaction 6, s3 -> s1 + !som3 + 0.55 o2 -> 0.45*som1 + 0.55co2 + (1/cn_ratios(som3)-0.45/cn_ratios(som1)) + (1/cp_ratios(som3)-0.45/cp_ratios(som1)) + reac = som3_dek_reac + cascade_matrix_hr(reac) = CNDecompBgcParamsInst%rf_s3s1_bgc + cascade_matrix_nh3(reac)= safe_div(1._r8,cn_ratios(som3,c,j)) - safe_div(1._r8-CNDecompBgcParamsInst%rf_s3s1_bgc,cn_ratios(som1,c,j)) + + cascade_matrix_nh3(reac) = min(cascade_matrix_nh3(reac) , 0._r8) + + !cwd -> lit1, lit2 + reac = cwd_dek_reac + cascade_matrix_nh3(reac) = safe_div(1._r8,cn_ratios(cwd,c,j)) - safe_div(CNDecompBgcParamsInst%cwd_fcel_bgc,cn_ratios(lit2,c,j)) - & + safe_div(CNDecompBgcParamsInst%cwd_flig_bgc,cn_ratios(lit3,c,j)) + + cascade_matrix_nh3(reac) = min(cascade_matrix_nh3(reac) , 0._r8) + + !obtain the potential respiration + pot_co2_hr(c,j) = dot_sum(cascade_matrix_hr, pot_decay_rates(:, c, j)) !mol CO2/m3/s + pot_nh3_immob(c,j) = dot_sum(cascade_matrix_nh3,pot_decay_rates(:,c,j)) !mol NH3/m3/s, this does not include mineralization + enddo + enddo + end associate + end subroutine calc_potential_aerobic_hr + + !---------------------------------------------------------------------------------------------------- + subroutine calc_decompK_multiply_scalar(bounds, lbj, ubj, numf, filter, jtops, finundated, zsoi, & + t_soisno, o2_bulk, o2_aqu2bulkcef, soilstate_vars, centurybgc_vars, carbonflux_vars) + ! + ! !DESCRIPTION: + ! compute scalar multipliers for aerobic om decomposition + ! because temperature and moisture scalars will not be independent from each other for microbe explicit models, + ! temp_scalar and moist_scalar are used as private variables + + ! !USES: + ! + use CNSharedParamsMod , only : CNParamsShareInst + use shr_const_mod , only : SHR_CONST_TKFRZ, SHR_CONST_PI + use SoilStatetype , only : soilstate_type + use CNCarbonFluxType , only : carbonflux_type + ! + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: lbj, ubj + integer, intent(in) :: jtops(bounds%begc:bounds%endc) ! top label of each column + integer, intent(in) :: numf + integer, intent(in) :: filter(:) + real(r8), intent(in) :: t_soisno(bounds%begc:bounds%endc, lbj:ubj) + real(r8), intent(in) :: o2_bulk(bounds%begc:bounds%endc,lbj:ubj) + real(r8), intent(in) :: zsoi(bounds%begc:bounds%endc, lbj:ubj) + real(r8), intent(in) :: finundated(bounds%begc:bounds%endc) + real(r8), intent(in) :: o2_aqu2bulkcef(bounds%begc:bounds%endc, lbj:ubj) + type(soilstate_type), intent(in) :: soilstate_vars + type(centurybgc_type) , intent(inout) :: centurybgc_vars + type(carbonflux_type) , intent(inout) :: carbonflux_vars + + ! !LOCAL VARIABLES: + integer :: fc, c, j !indices + real(r8), parameter :: normalization_tref = 15._r8 ! reference temperature for normalizaion (degrees C) + real(r8) :: decomp_depth_efolding ! [m] a testing parameter, which will be replaced, + real(r8) :: Q10 ! a number taken from CLM4.5bgc + real(r8) :: froz_q10 + real(r8) :: minpsi + real(r8) :: maxpsi + real(r8) :: normalization_factor + real(r8) :: catanf_30 + real(r8) :: catanf + real(r8) :: t1 + real(r8) :: o2w + real(r8) :: psi + + !----- CENTURY T response function + catanf(t1) = 11.75_r8 +(29.7_r8 / SHR_CONST_PI) * atan( SHR_CONST_PI * 0.031_r8 * ( t1 - 15.4_r8 )) + + associate( & + sucsat => soilstate_vars%sucsat_col , & ! Input: [real(r8) (:,:)] minimum soil suction [mm] + soilpsi => soilstate_vars%soilpsi_col , & ! Input: [real(r8) (:,:)] soilwater pontential in each soil layer [MPa] + t_scalar => carbonflux_vars%t_scalar_col , & ! Output: [real(r8) (:,:) ] soil temperature scalar for decomp + w_scalar => carbonflux_vars%w_scalar_col , & ! Output: [real(r8) (:,:) ] soil water scalar for decomp + o_scalar => carbonflux_vars%o_scalar_col , & ! Output: [real(r8) (:,:) ] fraction by which decomposition is limited by anoxia + depth_scalar => centurybgc_vars%depth_scalar_col & ! Output: [real(r8) (:,:,:) ] rate constant for decomposition (1./sec) + ) + + catanf_30 = catanf(30._r8) + + ! set "Q10" parameter + Q10 = CNParamsShareInst%Q10 + + ! set "froz_q10" parameter + froz_q10 = CNParamsShareInst%froz_q10 + + ! Set "decomp_depth_efolding" parameter + decomp_depth_efolding = CNParamsShareInst%decomp_depth_efolding + + do j = lbj, ubj + do fc = 1, numf + c = filter(fc) + if(j= SHR_CONST_TKFRZ) then + t_scalar(c,j)= (Q10**((t_soisno(c,j)-(SHR_CONST_TKFRZ+25._r8))/10._r8)) + else + t_scalar(c,j)= (Q10**(-25._r8/10._r8))*(froz_q10**((t_soisno(c,j)-SHR_CONST_TKFRZ)/10._r8)) + endif + ! scale all decomposition rates by a constant to compensate for offset between original CENTURY temp func and Q10 + normalization_factor = (catanf(normalization_tref)/catanf_30) / (q10**((normalization_tref-25._r8)/10._r8)) + t_scalar(c,j) = t_scalar(c,j) * normalization_factor + !moisture scalar, also follows what Charlie has done + minpsi = -10.0_r8 + w_scalar(c,j) = 1._r8 + + maxpsi = sucsat(c,j) * (-9.8e-6_r8) + psi = min(soilpsi(c,j),maxpsi) + ! decomp only if soilpsi is higher than minpsi + if (psi > minpsi) then + w_scalar(c,j) = (log(minpsi/psi)/log(minpsi/maxpsi)) + else + w_scalar(c,j) = 0._r8 + end if + + !oxygen scalar, this is different from what CLM4.5bgc does, I use a M-M formulation to indicate O2 stress + !and the O2 budget is done on the fly + o2w = o2_bulk(c,j) / o2_aqu2bulkcef(c, j) + o_scalar(c,j) = o2w/(o2w+0.02_r8) !the value 0.22 mol O3/m3 is from Arah and Kirk, 2000 + + !depth scalar, according to Koven et al. (2013), BG, the depth scalar is needed to resolve the radiocarbon profile + depth_scalar(c,j) = exp(-zsoi(c,j)/decomp_depth_efolding) + enddo + enddo + + end associate + end subroutine calc_decompK_multiply_scalar + + + + !----------------------------------------------------------------------- + subroutine calc_nuptake_prof(bounds, nlevdecomp, num_soilc, filter_soilc, sminn_nh4_vr, sminn_no3_vr, & + dzsoi, nfixation_prof, nuptake_prof) + ! + ! !DESCRIPTION: + ! calculate the nitrogen uptake profile + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: nlevdecomp ! number of vertical layers + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + real(r8) , intent(in) :: sminn_nh4_vr(bounds%begc: , 1: ) ! soil mineral nitrogen profile + real(r8) , intent(in) :: sminn_no3_vr(bounds%begc: , 1: ) ! soil mineral nitrogen profile + real(r8) , intent(in) :: dzsoi(bounds%begc: , 1: ) ! layer thickness + real(r8) , intent(in) :: nfixation_prof(bounds%begc: , 1: ) ! nitrogen fixation profile + real(r8) , intent(inout):: nuptake_prof(bounds%begc: , 1: ) ! nitrogen uptake profile + + ! !LOCAL VARIABLES: + integer :: fc, j, c ! indices + real(r8):: sminn_tot(bounds%begc:bounds%endc) !vertically integrated mineral nitrogen + + + SHR_ASSERT_ALL((ubound(dzsoi) == (/bounds%endc, nlevdecomp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sminn_nh4_vr) == (/bounds%endc, nlevdecomp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(sminn_no3_vr) == (/bounds%endc, nlevdecomp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(nfixation_prof) == (/bounds%endc, nlevdecomp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(dzsoi) == (/bounds%endc, nlevdecomp/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(nuptake_prof) == (/bounds%endc, nlevdecomp/)), errMsg(__FILE__, __LINE__)) + + ! init sminn_tot + do fc=1,num_soilc + c = filter_soilc(fc) + sminn_tot(c) = 0. + end do + + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + sminn_tot(c) = sminn_tot(c) + (sminn_nh4_vr(c,j)+sminn_no3_vr(c,j)) * dzsoi(c,j) + end do + end do + + do j = 1, nlevdecomp + do fc=1,num_soilc + c = filter_soilc(fc) + if (sminn_tot(c) > 0.) then + nuptake_prof(c,j) = (sminn_nh4_vr(c,j)+sminn_no3_vr(c,j)) / sminn_tot(c) + else + nuptake_prof(c,j) = nfixation_prof(c,j) + endif + + end do + end do + + + end subroutine calc_nuptake_prof + + + !----------------------------------------------------------------------- + + subroutine calc_plant_nitrogen_uptake_prof(bounds, nlevdecomp, num_soilc, filter_soilc, & + dzsoi, plant_totn_demand_flx_col, nuptake_prof, plant_demand_vr) + ! + ! !DESCRIPTION: + ! + !caluate depth specific demand + ! !USES: + use clm_varcon , only : natomw + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: nlevdecomp ! number of vertical layers + integer , intent(in) :: num_soilc ! number of soil columns in filter + integer , intent(in) :: filter_soilc(:) ! filter for soil columns + real(r8) , intent(in) :: dzsoi(bounds%begc:bounds%endc,1:nlevdecomp) ! layer thickness + real(r8) , intent(in) :: plant_totn_demand_flx_col(bounds%begc:bounds%endc) + real(r8) , intent(in) :: nuptake_prof(bounds%begc:bounds%endc, 1:nlevdecomp) + real(r8) , intent(inout) :: plant_demand_vr(1,bounds%begc:bounds%endc, 1:nlevdecomp) !mol N/m3/s + ! !LOCAL VARIABLES: + integer :: fc, c, j + + + do j = 1, nlevdecomp + do fc = 1, num_soilc + c = filter_soilc(fc) + plant_demand_vr(1,c,j) = plant_totn_demand_flx_col(c) * nuptake_prof(c,j) / dzsoi(c,j) /natomw + enddo + enddo + + + end subroutine calc_plant_nitrogen_uptake_prof + + + !----------------------------------------------------------------------- + + subroutine bgcstate_ext_update_bfdecomp(bounds, lbj, ubj, num_soilc, filter_soilc, & + carbonflux_vars, nitrogenflux_vars, centurybgc_vars, betrtracer_vars, & + tracerflux_vars, y0, cn_ratios, cp_ratios) + ! !DESCRIPTION: + ! update om pools with external input before doing decomposition + ! + ! !USES: + use MathfuncMod , only : safe_div + use CNCarbonFluxType , only : carbonflux_type + use CNNitrogenFluxType , only : nitrogenflux_type + use BetrTracerType , only : betrtracer_type + use tracerstatetype , only : tracerstate_type + use tracerfluxType , only : tracerflux_type + use CNDecompCascadeConType , only : decomp_cascade_con + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_soilc ! number of columns in column filter + integer , intent(in) :: filter_soilc(:) ! column filter + integer , intent(in) :: lbj, ubj + type(carbonflux_type) , intent(in) :: carbonflux_vars + type(nitrogenflux_type) , intent(in) :: nitrogenflux_vars + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(centurybgc_type) , intent(in) :: centurybgc_vars + type(tracerflux_type) , intent(inout) :: tracerflux_vars + real(r8) , intent(inout) :: y0(centurybgc_vars%nstvars, bounds%begc:bounds%endc, lbj:ubj) + real(r8) , intent(inout) :: cn_ratios(centurybgc_vars%nom_pools, bounds%begc:bounds%endc, lbj:ubj) ! + real(r8) , intent(inout) :: cp_ratios(centurybgc_vars%nom_pools, bounds%begc:bounds%endc, lbj:ubj) + ! !LOCAL VARIABLES: + real(r8) :: delta_no3, delta_nh4 + real(r8) :: delta_somn + integer :: k, fc, c, j + + associate( & ! + lid_nh4 => centurybgc_vars%lid_nh4 , & ! + lid_no3 => centurybgc_vars%lid_no3 , & ! + nelm => centurybgc_vars%nelms , & ! + c_loc => centurybgc_vars%c_loc , & ! + n_loc => centurybgc_vars%n_loc , & ! + id_trc_nh3x => betrtracer_vars%id_trc_nh3x , & ! + id_trc_no3x => betrtracer_vars%id_trc_no3x , & ! + ngwmobile_tracers => betrtracer_vars%ngwmobile_tracers , & ! + tracer_flx_netpro_vr => tracerflux_vars%tracer_flx_netpro_vr_col , & ! + bgc_cpool_ext_loss_vr => carbonflux_vars%bgc_cpool_ext_loss_vr_col , & ! + bgc_npool_ext_loss_vr => nitrogenflux_vars%bgc_npool_ext_loss_vr_col , & ! + sminn_nh4_input_vr => nitrogenflux_vars%sminn_nh4_input_vr_col , & ! + sminn_no3_input_vr => nitrogenflux_vars%sminn_no3_input_vr_col , & ! + initial_cn_ratio => decomp_cascade_con%initial_cn_ratio , & ! Output: [real(r8) (:) ] c:n ratio for initialization of pools + floating_cn_ratio_decomp_pools => decomp_cascade_con%floating_cn_ratio_decomp_pools & ! Output: [logical (:) ] TRUE => pool has fixed C:N ratio + ) + + do k = 1, ndecomp_pools + do j = 1, ubj + do fc = 1, num_soilc + c = filter_soilc(fc) + y0((k-1)*nelm+c_loc,c,j) = y0((k-1)*nelm+c_loc,c,j) - bgc_cpool_ext_loss_vr(c,j,k)/catomw + y0((k-1)*nelm+n_loc,c,j) = y0((k-1)*nelm+n_loc,c,j) - bgc_npool_ext_loss_vr(c,j,k)/natomw + if(floating_cn_ratio_decomp_pools(k))then + cn_ratios(k, c,j) = safe_div(y0((k-1)*nelm+c_loc,c,j), y0((k-1)*nelm+n_loc,c,j)) + else + cn_ratios(k,c,j) = initial_cn_ratio(k)*natomw/catomw + + endif + + tracer_flx_netpro_vr(c,j,ngwmobile_tracers+(k-1)*nelm+c_loc) = & + tracer_flx_netpro_vr(c,j,ngwmobile_tracers+(k-1)*nelm+c_loc) - & + bgc_cpool_ext_loss_vr(c,j,k)/catomw + + tracer_flx_netpro_vr(c,j,ngwmobile_tracers+(k-1)*nelm+n_loc) = & + tracer_flx_netpro_vr(c,j,ngwmobile_tracers+(k-1)*nelm+n_loc) - & + bgc_npool_ext_loss_vr(c,j,k)/natomw + + enddo + enddo + enddo + + do j = 1, ubj + do fc = 1, num_soilc + c = filter_soilc(fc) + y0(lid_nh4, c, j) = y0(lid_nh4, c, j) + sminn_nh4_input_vr(c,j)/natomw + y0(lid_no3, c, j) = y0(lid_no3, c, j) + sminn_no3_input_vr(c,j)/natomw + + tracer_flx_netpro_vr(c,j,betrtracer_vars%id_trc_no3x ) = & + tracer_flx_netpro_vr(c,j,betrtracer_vars%id_trc_no3x ) + & + sminn_no3_input_vr(c,j)/natomw + + tracer_flx_netpro_vr(c,j,betrtracer_vars%id_trc_nh3x ) = & + tracer_flx_netpro_vr(c,j,betrtracer_vars%id_trc_nh3x ) + & + sminn_nh4_input_vr(c,j)/natomw + enddo + + enddo + + end associate + end subroutine bgcstate_ext_update_bfdecomp + !----------------------------------------------------------------------- + + subroutine bgcstate_ext_update_afdecomp(bounds, lbj, ubj, num_soilc, filter_soilc, & + carbonflux_vars, nitrogenflux_vars, centurybgc_vars, betrtracer_vars, tracerflux_vars, yf) + + ! !DESCRIPTION: + ! update om state variables after doing decomposition. + ! !USES: + use MathfuncMod , only : safe_div + use CNCarbonFluxType , only : carbonflux_type + use CNNitrogenFluxType , only : nitrogenflux_type + use BetrTracerType , only : betrtracer_type + use tracerstatetype , only : tracerstate_type + use tracerfluxType , only : tracerflux_type + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_soilc ! number of columns in column filter + integer , intent(in) :: filter_soilc(:) ! column filter + integer , intent(in) :: lbj, ubj + type(carbonflux_type) , intent(in) :: carbonflux_vars + type(nitrogenflux_type) , intent(in) :: nitrogenflux_vars + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(centurybgc_type) , intent(in) :: centurybgc_vars + type(tracerflux_type) , intent(inout) :: tracerflux_vars + real(r8) , intent(inout) :: yf(centurybgc_vars%nstvars, bounds%begc:bounds%endc, lbj:ubj) ! + + ! !LOCAL VARIABLES: + real(r8) :: delta_no3, delta_nh4 + real(r8) :: delta_somn + integer :: k, fc, c, j + + associate( & ! + nelm => centurybgc_vars%nelms , & ! + c_loc => centurybgc_vars%c_loc , & ! + n_loc => centurybgc_vars%n_loc , & ! + tracer_flx_netpro_vr => tracerflux_vars%tracer_flx_netpro_vr_col , & ! + bgc_cpool_ext_inputs_vr => carbonflux_vars%bgc_cpool_ext_inputs_vr_col , & ! + bgc_npool_ext_inputs_vr => nitrogenflux_vars%bgc_npool_ext_inputs_vr_col & ! + ) + + do k = 1, ndecomp_pools + do j = 1, ubj + do fc = 1, num_soilc + c = filter_soilc(fc) + + yf((k-1)*nelm+c_loc,c,j) = yf((k-1)*nelm+c_loc,c,j) + bgc_cpool_ext_inputs_vr(c,j,k)/catomw + yf((k-1)*nelm+n_loc,c,j) = yf((k-1)*nelm+n_loc,c,j) + bgc_npool_ext_inputs_vr(c,j,k)/natomw + + enddo + enddo + enddo + + end associate + end subroutine bgcstate_ext_update_afdecomp + !----------------------------------------------------------------------- + subroutine apply_plant_root_respiration_prof(bounds, ubj, num_soilc, filter_soilc, & + rr_col, root_prof_col, rr_col_vr) + ! + ! !DESCRIPTION: + ! obtain root respiration profile + ! + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: ubj + integer , intent(in) :: num_soilc ! number of columns in column filter + integer , intent(in) :: filter_soilc(:) ! column filter + real(r8) , intent(in) :: rr_col(bounds%begc:bounds%endc) + real(r8) , intent(in) :: root_prof_col(bounds%begc:bounds%endc, 1:ubj) + real(r8) , intent(inout):: rr_col_vr(1,bounds%begc:bounds%endc, 1:ubj) ! + ! !LOCAL VARIABLES: + integer :: fc, c, j + + do j = 1, ubj + do fc = 1, num_soilc + c = filter_soilc(fc) + rr_col_vr(1,c,j) = rr_col(c) * root_prof_col(c,j) + enddo + enddo + + end subroutine apply_plant_root_respiration_prof + + !----------------------------------------------------------------------- + subroutine set_reaction_order( nreact, centurybgc_vars, is_zero_order) + ! + ! !DESCRIPTION: + ! set order of the reactions, 0 or 1 + ! + ! !ARGUMENTS: + integer , intent(in) :: nreact + type(centurybgc_type) , intent(in) :: centurybgc_vars + logical , intent(out) :: is_zero_order(nreact) + + + + is_zero_order(:) = .false. + is_zero_order(centurybgc_vars%lid_o2_aere_reac) = .true. + if(spinup_state /= 1)then + is_zero_order(centurybgc_vars%lid_n2o_aere_reac) = .true. + is_zero_order(centurybgc_vars%lid_ar_aere_reac) = .true. + is_zero_order(centurybgc_vars%lid_ch4_aere_reac) = .true. + is_zero_order(centurybgc_vars%lid_o2_aere_reac) = .true. + + is_zero_order(centurybgc_vars%lid_co2_aere_reac) = .true. + is_zero_order(centurybgc_vars%lid_n2_aere_reac) = .true. + endif + + is_zero_order(centurybgc_vars%lid_plant_minn_up_reac) = .true. + is_zero_order(centurybgc_vars%lid_at_rt_reac) = .true. + + end subroutine set_reaction_order + + + !----------------------------------------------------------------------- + subroutine calc_nutrient_compet_rescal(bounds, ubj, num_soilc, filter_soilc, & + dtime, centurybgc_vars, k_nit, decomp_nh4_immob, plant_ndemand, smin_nh4_vr, nh4_compet) + + ! + ! !DESCRIPTION: + ! scaling factor for nitrogen competition + ! !USES: + use MathfuncMod , only : safe_div + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: ubj + integer , intent(in) :: num_soilc ! number of columns in column filter + integer , intent(in) :: filter_soilc(:) ! column filter + type(centurybgc_type) , intent(in) :: centurybgc_vars + real(r8) , intent(in) :: dtime + real(r8) , intent(in) :: k_nit(bounds%begc: , 1: ) + real(r8) , intent(in) :: decomp_nh4_immob(bounds%begc: , 1: ) + real(r8) , intent(in) :: plant_ndemand(bounds%begc: , 1: ) + real(r8) , intent(in) :: smin_nh4_vr(bounds%begc: , 1: ) + real(r8) , intent(inout):: nh4_compet(bounds%begc:bounds%endc,1:ubj) ! + ! !LOCAL VARIABLES: + integer :: j, fc, c + real(r8):: tot_demand + + SHR_ASSERT_ALL((ubound(k_nit) == (/bounds%endc, ubj/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(decomp_nh4_immob) == (/bounds%endc, ubj/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(plant_ndemand) == (/bounds%endc, ubj/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(smin_nh4_vr) == (/bounds%endc, ubj/)), errMsg(__FILE__, __LINE__)) + SHR_ASSERT_ALL((ubound(nh4_compet) == (/bounds%endc, ubj/)), errMsg(__FILE__, __LINE__)) + + do j = 1, ubj + do fc = 1, num_soilc + c = filter_soilc(fc) + + tot_demand= (k_nit(c,j) * smin_nh4_vr(c,j) + decomp_nh4_immob(c,j) + plant_ndemand(c,j))*dtime + if(tot_demand<=smin_nh4_vr(c,j))then + nh4_compet(c,j)=1._r8 + else + nh4_compet(c,j) = smin_nh4_vr(c,j)/tot_demand + endif + enddo + enddo + end subroutine calc_nutrient_compet_rescal + + !----------------------------------------------------------------------- + subroutine assign_OM_CNpools(bounds, num_soilc, filter_soilc, carbonstate_vars, & + nitrogenstate_vars, tracerstate_vars, betrtracer_vars, centurybgc_vars) + + ! !DESCRIPTION: + ! update OM pools + ! !USES: + use clm_varpar , only : i_cwd, i_met_lit, i_cel_lit, i_lig_lit + use CNCarbonStateType , only : carbonstate_type + use CNNitrogenStateType , only : nitrogenstate_type + use tracerstatetype , only : tracerstate_type + use BetrTracerType , only : betrtracer_type + use clm_varpar , only : nlevtrc_soil + + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_soilc ! number of columns in column filter + integer , intent(in) :: filter_soilc(:) ! column filter + type(tracerstate_type) , intent(in) :: tracerstate_vars + type(centurybgc_type) , intent(in) :: centurybgc_vars + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(carbonstate_type) , intent(inout) :: carbonstate_vars + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars ! + + ! !LOCAL VARIABLES: + integer, parameter :: i_soil1 = 5 + integer, parameter :: i_soil2 = 6 + integer, parameter :: i_soil3 = 7 + + integer :: fc, c, j, k + + associate( & + id_trc_no3x => betrtracer_vars%id_trc_no3x , & + id_trc_nh3x => betrtracer_vars%id_trc_nh3x , & + decomp_cpools_vr => carbonstate_vars%decomp_cpools_vr_col , & + decomp_npools_vr => nitrogenstate_vars%decomp_npools_vr_col , & + smin_no3_vr_col => nitrogenstate_vars%smin_no3_vr_col , & + smin_nh4_vr_col => nitrogenstate_vars%smin_nh4_vr_col , & + sminn_vr_col => nitrogenstate_vars%sminn_vr_col , & + tracer_conc_mobile => tracerstate_vars%tracer_conc_mobile_col , & + tracer_conc_solid_passive => tracerstate_vars%tracer_conc_solid_passive_col , & + c_loc => centurybgc_vars%c_loc , & + n_loc => centurybgc_vars%n_loc , & + lit1 => centurybgc_vars%lit1 , & + lit2 => centurybgc_vars%lit2 , & + lit3 => centurybgc_vars%lit3 , & + som1 => centurybgc_vars%som1 , & + som2 => centurybgc_vars%som2 , & + som3 => centurybgc_vars%som3 , & + cwd => centurybgc_vars%cwd , & + nelms => centurybgc_vars%nelms & + ) + + do j = 1, nlevtrc_soil + do fc = 1, num_soilc + c = filter_soilc(fc) + + smin_no3_vr_col(c,j) = tracer_conc_mobile(c,j,id_trc_no3x)*natomw + smin_nh4_vr_col(c,j) = tracer_conc_mobile(c,j,id_trc_nh3x)*natomw + sminn_vr_col (c,j) = smin_no3_vr_col(c,j) + smin_nh4_vr_col(c,j) + + k = lit1; decomp_cpools_vr(c,j,i_met_lit) = tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) * catomw + k = lit2; decomp_cpools_vr(c,j,i_cel_lit) = tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) * catomw + k = lit3; decomp_cpools_vr(c,j,i_lig_lit) = tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) * catomw + k = cwd ; decomp_cpools_vr(c,j,i_cwd ) = tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) * catomw + k = som1; decomp_cpools_vr(c,j,i_soil1 ) = tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) * catomw + k = som2; decomp_cpools_vr(c,j,i_soil2 ) = tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) * catomw + k = som3; decomp_cpools_vr(c,j,i_soil3 ) = tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) * catomw + + k = lit1; decomp_npools_vr(c,j,i_met_lit) = tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) * natomw + k = lit2; decomp_npools_vr(c,j,i_cel_lit) = tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) * natomw + k = lit3; decomp_npools_vr(c,j,i_lig_lit) = tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) * natomw + k = cwd ; decomp_npools_vr(c,j,i_cwd ) = tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) * natomw + k = som1; decomp_npools_vr(c,j,i_soil1 ) = tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) * natomw + k = som2; decomp_npools_vr(c,j,i_soil2 ) = tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) * natomw + k = som3; decomp_npools_vr(c,j,i_soil3 ) = tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) * natomw + enddo + enddo + + + end associate + end subroutine assign_OM_CNpools + !------------------------------------------------------------------------------- + subroutine assign_nitrogen_hydroloss(bounds, num_soilc, filter_soilc, & + tracerflux_vars, nitrogenflux_vars, betrtracer_vars) + + ! + ! !DESCRIPTION: + ! feedback the nitrogen hydrological fluxes, this comes after tracer mass balance, so the flux is with the unit of gN/m2/s + ! + ! !USES: + use tracerfluxType , only : tracerflux_type + use BetrTracerType , only : betrtracer_type + use CNNitrogenFluxType , only : nitrogenflux_type + use clm_varcon , only : natomw + + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_soilc ! number of columns in column filter + integer , intent(in) :: filter_soilc(:) ! column filter + type(tracerflux_type) , intent(in) :: tracerflux_vars + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars ! + + ! !LOCAL VARIABLES: + integer :: fc, c + !get nitrogen leaching, and loss through surface runoff + + associate( & + id_trc_no3x => betrtracer_vars%id_trc_no3x & + ) + + do fc = 1, num_soilc + c = filter_soilc(fc) + nitrogenflux_vars%smin_no3_leached_col(c) = tracerflux_vars%tracer_flx_totleached_col(c,id_trc_no3x)*natomw + nitrogenflux_vars%smin_no3_runoff_col(c) = tracerflux_vars%tracer_flx_surfrun_col(c,id_trc_no3x)*natomw + enddo + + end associate + end subroutine assign_nitrogen_hydroloss + + !------------------------------------------------------------------------------- + subroutine apply_plant_root_nuptake_prof(bounds, ubj, num_soilc, filter_soilc, & + root_prof_col, plantsoilnutrientflux_vars) + ! + ! !DESCRIPTION: + ! nitroge uptake profile + ! !USES: + use PlantSoilnutrientFluxType, only : plantsoilnutrientflux_type + implicit none + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: ubj + integer , intent(in) :: num_soilc ! number of columns in column filter + integer , intent(in) :: filter_soilc(:) ! column filter + real(r8) , intent(in) :: root_prof_col(bounds%begc:bounds%endc, 1:ubj) ! + type(plantsoilnutrientflux_type) , intent(inout) :: plantsoilnutrientflux_vars + + ! !LOCAL VARIABLES: + integer :: fc, c, j + + associate( & + plant_frootsc_col => plantsoilnutrientflux_vars%plant_frootsc_col , & + plant_frootsc_vr => plantsoilnutrientflux_vars%plant_frootsc_vr_col & + ) + + do j = 1, ubj + do fc = 1, num_soilc + c = filter_soilc(fc) + plant_frootsc_vr(c, j) = root_prof_col(c,j) * plant_frootsc_col(c) + enddo + enddo + end associate + + end subroutine apply_plant_root_nuptake_prof + +end module BGCCenturySubCoreMod diff --git a/components/clm/src/betr/bgc_century/BGCCenturySubMod.F90 b/components/clm/src/betr/bgc_century/BGCCenturySubMod.F90 new file mode 100644 index 000000000000..ebd5be85598f --- /dev/null +++ b/components/clm/src/betr/bgc_century/BGCCenturySubMod.F90 @@ -0,0 +1,391 @@ +module BGCCenturySubMod +#include "shr_assert.h" + ! + ! !DESCRIPTION: + ! subroutines for stoichiometric configuration of the century bgc + ! !History, created by Jinyun Tang, Dec, 2014. + ! !USES: + 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_varcon , only : spval + use clm_varpar , only : ndecomp_pools + use ColumnType , only : col + use clm_varctl , only : spinup_state + implicit none + save + private + + public :: calc_cascade_matrix + + logical, public :: ldebug_bgc =.false. + +contains + + !------------------------------------------------------------------------------- + subroutine calc_cascade_matrix(nstvars, nreactions, cn_ratios, cp_ratios, n2_n2o_ratio_denit, pct_sand, & + centurybgc_vars, nitrogen_limit_flag, cascade_matrix) + ! + ! !DESCRIPTION: + ! calculate cascade matrix for the decomposition model + ! + ! !USES: + use clm_varcon , only : nitrif_n2o_loss_frac + use BGCCenturyParMod , only : CNDecompBgcParamsInst, NutrientCompetitionParamsInst + use MathfuncMod , only : safe_div + use BGCCenturySubCoreMod , only : centurybgc_type + + ! !ARGUMENTS: + integer , intent(in) :: nstvars + integer , intent(in) :: nreactions + type(centurybgc_type) , intent(in) :: centurybgc_vars + real(r8) , intent(in) :: cn_ratios(centurybgc_vars%nom_pools) + real(r8) , intent(in) :: cp_ratios(centurybgc_vars%nom_pools) + real(r8) , intent(in) :: n2_n2o_ratio_denit !ratio of n2 to n2o during denitrification + real(r8) , intent(in) :: pct_sand + real(r8) , intent(out) :: cascade_matrix(nstvars, nreactions) + logical , intent(out) :: nitrogen_limit_flag(centurybgc_vars%nom_pools) ! + + ! !LOCAL VARIABLES: + real(r8) :: ftxt, f1, f2 + real(r8) :: compet_plant_no3 + real(r8) :: compet_plant_nh4 + real(r8) :: compet_decomp_no3 + real(r8) :: compet_decomp_nh4 + real(r8) :: compet_denit + real(r8) :: compet_nit + real(r8) :: compet_decomp_no3_scal + real(r8) :: compet_plant_no3_scal + integer :: k, reac + + + associate( & ! + lit1 => centurybgc_vars%lit1 , & ! + lit2 => centurybgc_vars%lit2 , & ! + lit3 => centurybgc_vars%lit3 , & ! + som1 => centurybgc_vars%som1 , & ! + som2 => centurybgc_vars%som2 , & ! + som3 => centurybgc_vars%som3 , & ! + cwd => centurybgc_vars%cwd , & ! + c_loc => centurybgc_vars%c_loc , & ! + n_loc => centurybgc_vars%n_loc , & ! + nelms => centurybgc_vars%nelms , & ! + lid_at_rt => centurybgc_vars%lid_at_rt , & ! + lid_o2 => centurybgc_vars%lid_o2 , & ! + lid_co2 => centurybgc_vars%lid_co2 , & ! + lid_nh4 => centurybgc_vars%lid_nh4 , & ! + lid_ch4 => centurybgc_vars%lid_ch4 , & ! + lid_ar => centurybgc_vars%lid_ar , & ! + lid_no3 => centurybgc_vars%lid_no3 , & ! + lid_n2o => centurybgc_vars%lid_n2o , & ! + lid_n2 => centurybgc_vars%lid_n2 , & ! + lid_co2_hr=> centurybgc_vars%lid_co2_hr , & ! + lid_n2o_nit=> centurybgc_vars%lid_n2o_nit , & ! + lid_plant_minn => centurybgc_vars%lid_plant_minn , & ! + lid_minn_nh4_immob => centurybgc_vars%lid_minn_nh4_immob , & ! + lid_minn_no3_immob => centurybgc_vars%lid_minn_no3_immob , & ! + lid_minn_nh4_plant => centurybgc_vars%lid_minn_nh4_plant , & ! + lid_minn_no3_plant => centurybgc_vars%lid_minn_no3_plant , & ! + lid_nh4_nit => centurybgc_vars%lid_nh4_nit , & ! + lid_n2_paere=> centurybgc_vars%lid_n2_paere , & ! + lid_ch4_paere=> centurybgc_vars%lid_ch4_paere , & ! + lid_n2o_paere=> centurybgc_vars%lid_n2o_paere , & ! + lid_o2_paere=> centurybgc_vars%lid_o2_paere , & ! + lid_ar_paere=> centurybgc_vars%lid_ar_paere , & ! + lid_co2_paere=> centurybgc_vars%lid_co2_paere , & ! + + is_aerobic_reac=> centurybgc_vars%is_aerobic_reac , & + primvarid => centurybgc_vars%primvarid , & ! + lit1_dek_reac=> centurybgc_vars%lit1_dek_reac , & ! + lit2_dek_reac=> centurybgc_vars%lit2_dek_reac , & ! + lit3_dek_reac=> centurybgc_vars%lit3_dek_reac , & ! + som1_dek_reac=> centurybgc_vars%som1_dek_reac , & ! + som2_dek_reac=> centurybgc_vars%som2_dek_reac , & ! + som3_dek_reac=> centurybgc_vars%som3_dek_reac , & ! + cwd_dek_reac=> centurybgc_vars%cwd_dek_reac , & ! + lid_at_rt_reac=> centurybgc_vars%lid_at_rt_reac , & ! + lid_no3_den => centurybgc_vars%lid_no3_den , & ! + lid_plant_minn_up_reac=> centurybgc_vars%lid_plant_minn_up_reac , & ! + + lid_nh4_nit_reac => centurybgc_vars%lid_nh4_nit_reac , & ! + lid_no3_den_reac => centurybgc_vars%lid_no3_den_reac , & ! + lid_n2_aere_reac => centurybgc_vars%lid_n2_aere_reac , & ! + lid_ch4_aere_reac=> centurybgc_vars%lid_ch4_aere_reac , & ! + lid_n2o_aere_reac=> centurybgc_vars%lid_n2o_aere_reac , & ! + lid_o2_aere_reac => centurybgc_vars%lid_o2_aere_reac , & ! + lid_ar_aere_reac => centurybgc_vars%lid_ar_aere_reac , & ! + lid_co2_aere_reac=> centurybgc_vars%lid_co2_aere_reac & ! + ) + + !load parameters + compet_plant_no3 = NutrientCompetitionParamsInst%compet_plant_no3 + compet_plant_nh4 = NutrientCompetitionParamsInst%compet_plant_nh4 + compet_decomp_no3 = NutrientCompetitionParamsInst%compet_decomp_no3 + compet_decomp_nh4 = NutrientCompetitionParamsInst%compet_decomp_nh4 + compet_denit = NutrientCompetitionParamsInst%compet_denit + compet_nit = NutrientCompetitionParamsInst%compet_nit + + !initialize all entries to zero + cascade_matrix = 0._r8 + nitrogen_limit_flag = .false. + !higher [nh4] makes lower [no3] competitiveness + !note all reactions are in the form products - substrates = 0, therefore + !mass balance is automatically ensured. + !set up first order reactions + !---------------------------------------------------------------------- + !reaction1, lit1 -> s1 + reac=lit1_dek_reac + !lit1 + 0.55*o2 -> 0.45 som1 + 0.55co2 + (1/cn_ratios(lit1) - 0.45/cn_ratios(som1))min_n+ (1/cp_ratios(lit1)-0.45/cp_ratios(som1))min_p + cascade_matrix((lit1-1)*nelms+c_loc ,reac) = -1._r8 + cascade_matrix((lit1-1)*nelms+n_loc ,reac) = -safe_div(1._r8,cn_ratios(lit1)) + + cascade_matrix(lid_o2 ,reac) = -CNDecompBgcParamsInst%rf_l1s1_bgc + cascade_matrix((som1-1)*nelms+c_loc ,reac) = 1._r8-CNDecompBgcParamsInst%rf_l1s1_bgc + cascade_matrix((som1-1)*nelms+n_loc ,reac) = safe_div(1._r8-CNDecompBgcParamsInst%rf_l1s1_bgc,cn_ratios(som1)) + cascade_matrix(lid_co2 ,reac) = CNDecompBgcParamsInst%rf_l1s1_bgc + cascade_matrix(lid_nh4 ,reac) = safe_div(1._r8,cn_ratios(lit1)) - safe_div(1._r8-CNDecompBgcParamsInst%rf_l1s1_bgc,cn_ratios(som1)) + + cascade_matrix(lid_minn_nh4_immob ,reac) = -cascade_matrix(lid_nh4 ,reac) + cascade_matrix(lid_co2_hr ,reac) = CNDecompBgcParamsInst%rf_l1s1_bgc + + primvarid(reac) = (lit1-1)*nelms+c_loc + is_aerobic_reac(reac) = .true. + + if(cascade_matrix(lid_nh4, reac)<0._r8)then + + !When a reaction needs mineral nitrogen to balance the elements, it takes mineral nitrogen proportionally from nh4 and no3. + !This formulation assumes that the nitrogen mineralized from om decomposition is equally accessible to plants and decomposers. Such + !a formulation is different from the century BGC in CLM4.5. Rather, CLM4.5 bgc assumes that the nitrogen mineralized from nitrogen releasing + !decomposition pathways is first used to meet the nitrogen demand from nitrogen immobilizing decomposition pathways. In the later case, the stoichiometry becomes + !rate dependent. + !it requires nitrogen uptake + nitrogen_limit_flag(reac) = .true. + endif + !---------------------------------------------------------------------- + !reaction 2, lit2 -> s1 + reac = lit2_dek_reac + !lit2 + 0.5 o2 -> 0.5 som1 + 0.5 co2 + (1/cn_ratios(lit2)-0.5/cn_ratios(som1))min_n +(1/cp_ratios(lit2)-0.5/cp_ratios(som1))min_p + cascade_matrix((lit2-1)*nelms+c_loc ,reac) = -1._r8 + cascade_matrix((lit2-1)*nelms+n_loc ,reac) = -safe_div(1._r8,cn_ratios(lit2)) + + cascade_matrix(lid_o2 ,reac) = -CNDecompBgcParamsInst%rf_l2s1_bgc + cascade_matrix((som1-1)*nelms+c_loc ,reac) = 1._r8-CNDecompBgcParamsInst%rf_l2s1_bgc + cascade_matrix((som1-1)*nelms+n_loc ,reac) = safe_div(1._r8-CNDecompBgcParamsInst%rf_l2s1_bgc,cn_ratios(som1)) + + cascade_matrix(lid_co2 ,reac) = CNDecompBgcParamsInst%rf_l2s1_bgc + cascade_matrix(lid_nh4 ,reac) = safe_div(1._r8,cn_ratios(lit2)) - safe_div(1._r8-CNDecompBgcParamsInst%rf_l2s1_bgc,cn_ratios(som1)) + cascade_matrix(lid_minn_nh4_immob ,reac) = -cascade_matrix(lid_nh4 ,reac) + cascade_matrix(lid_co2_hr ,reac) = CNDecompBgcParamsInst%rf_l2s1_bgc + + primvarid(reac) = (lit2-1)*nelms+c_loc + is_aerobic_reac(reac) = .true. + if(cascade_matrix(lid_nh4, reac)<0._r8)then + !it requires nitrogen uptake + nitrogen_limit_flag(reac) = .true. + + endif + !---------------------------------------------------------------------- + !reaction 3, lit3->s2 + reac = lit3_dek_reac + !lit3 + 0.5 o2 -> 0.5 som2 + 0.5 co2 + (1/cn_ratios(lit3) - 0.5/cn_ratios(som2))min_n + (1/cp_ratios(lit3)-0.5_r8/cp_ratios(som2))minp + cascade_matrix((lit3-1)*nelms+c_loc ,reac) = -1._r8 + cascade_matrix((lit3-1)*nelms+n_loc ,reac) = -safe_div(1._r8,cn_ratios(lit3)) + + cascade_matrix(lid_o2 ,reac) = -CNDecompBgcParamsInst%rf_l3s2_bgc + cascade_matrix((som2-1)*nelms+c_loc ,reac) = 1._r8-CNDecompBgcParamsInst%rf_l3s2_bgc + cascade_matrix((som2-1)*nelms+n_loc ,reac) = safe_div(1._r8-CNDecompBgcParamsInst%rf_l3s2_bgc,cn_ratios(som2)) + + cascade_matrix(lid_co2 ,reac) = CNDecompBgcParamsInst%rf_l3s2_bgc + cascade_matrix(lid_nh4 ,reac) = safe_div(1._r8,cn_ratios(lit3)) - safe_div(1._r8-CNDecompBgcParamsInst%rf_l3s2_bgc,cn_ratios(som2)) + cascade_matrix(lid_minn_nh4_immob ,reac) = -cascade_matrix(lid_nh4 ,reac) + cascade_matrix(lid_co2_hr ,reac) = CNDecompBgcParamsInst%rf_l3s2_bgc + + primvarid(reac) = (lit3-1)*nelms+c_loc + is_aerobic_reac(reac) = .true. + if(cascade_matrix(lid_nh4, reac)<0._r8)then + !it requires nitrogen uptake + nitrogen_limit_flag(reac) = .true. + + + endif + !---------------------------------------------------------------------- + !double check those stoichiometry parameters + !reaction 4, the partition into som2 and som3 is soil texture dependent + reac = som1_dek_reac + + ftxt = 0.85_r8 - 0.68_r8 * 0.01_r8 * (100._r8 - pct_sand) + f1 = 0.996*(1._r8-ftxt) + f2 = 0.004*(1._r8-ftxt) + ftxt = 1._r8-f1-f2 + cascade_matrix((som1-1)*nelms+c_loc ,reac) = -1._r8 + cascade_matrix((som1-1)*nelms+n_loc ,reac) = -safe_div(1._r8,cn_ratios(som1)) + + cascade_matrix(lid_o2 ,reac) = -ftxt + cascade_matrix((som3-1)*nelms+c_loc ,reac) = f2 + cascade_matrix((som3-1)*nelms+n_loc ,reac) = safe_div(f2,cn_ratios(som3)) + + cascade_matrix((som2-1)*nelms+c_loc ,reac) = f1 + cascade_matrix((som2-1)*nelms+n_loc ,reac) = safe_div(f1,cn_ratios(som2)) + + cascade_matrix(lid_co2 ,reac) = ftxt + cascade_matrix(lid_nh4 ,reac) = safe_div(1._r8,cn_ratios(som1))-safe_div(f1,cn_ratios(som2))-safe_div(f2,cn_ratios(som3)) + cascade_matrix(lid_minn_nh4_immob ,reac) = -cascade_matrix(lid_nh4 ,reac) + cascade_matrix(lid_co2_hr ,reac) = ftxt + + primvarid(reac) = (som1-1)*nelms+c_loc + is_aerobic_reac(reac) = .true. + if(cascade_matrix(lid_nh4, reac)<0._r8)then + !it requires nitrogen uptake + nitrogen_limit_flag(reac) = .true. + + endif + !---------------------------------------------------------------------- + !reaction 5, som2->som1, som3 + reac = som2_dek_reac + !som2 + 0.55 o2 -> 0.42 som1 + 0.03som3 + 0.55co2 + (1/cn_ratios(som2)-0.42/cn_ratios(som1)-0.03/cn_ratios(som3)) + (1/cp_raitos(som2)-0.42/cp_ratios(som1)-0.03/cp_ratios(som3)) + cascade_matrix((som2-1)*nelms+c_loc ,reac) = -1._r8 + cascade_matrix((som2-1)*nelms+n_loc ,reac) = -safe_div(1._r8,cn_ratios(som2)) + + cascade_matrix(lid_o2 ,reac) = -CNDecompBgcParamsInst%rf_s2s1_bgc + cascade_matrix((som1-1)*nelms+c_loc ,reac) = 0.93_r8*(1._r8-CNDecompBgcParamsInst%rf_s2s1_bgc) + cascade_matrix((som1-1)*nelms+n_loc ,reac) = 0.93_r8*safe_div(1._r8-CNDecompBgcParamsInst%rf_s2s1_bgc,cn_ratios(som1)) + + cascade_matrix((som3-1)*nelms+c_loc ,reac) = 0.07_r8*(1._r8-CNDecompBgcParamsInst%rf_s2s1_bgc) + cascade_matrix((som3-1)*nelms+n_loc ,reac) = 0.07_r8*safe_div(1._r8-CNDecompBgcParamsInst%rf_s2s1_bgc,cn_ratios(som3)) + + cascade_matrix(lid_co2 ,reac) = CNDecompBgcParamsInst%rf_s2s1_bgc + cascade_matrix(lid_nh4 ,reac) = safe_div(1._r8,cn_ratios(som2))-0.93_r8*safe_div(1._r8-CNDecompBgcParamsInst%rf_s2s1_bgc,cn_ratios(som1)) & + -0.07_r8*safe_div(1._r8-CNDecompBgcParamsInst%rf_s2s1_bgc,cn_ratios(som3)) + cascade_matrix(lid_minn_nh4_immob ,reac) = -cascade_matrix(lid_nh4 ,reac) + cascade_matrix(lid_co2_hr ,reac) = CNDecompBgcParamsInst%rf_s2s1_bgc + + primvarid(reac) = (som2-1)*nelms+c_loc + is_aerobic_reac(reac) = .true. + if(cascade_matrix(lid_nh4, reac)<0._r8)then + !it requires nitrogen uptake + nitrogen_limit_flag(reac) = .true. + + endif + !---------------------------------------------------------------------- + !reaction 6, s3-> s1 + reac = som3_dek_reac + !som3 + 0.55 o2 -> 0.45*som1 + 0.55co2 + (1/cn_ratios(som3)-0.45/cn_ratios(som1)) + (1/cp_ratios(som3)-0.45/cp_ratios(som1)) + cascade_matrix((som3-1)*nelms+c_loc ,reac) = -1._r8 + cascade_matrix((som3-1)*nelms+n_loc ,reac) = -safe_div(1._r8,cn_ratios(som3)) + + cascade_matrix(lid_o2 ,reac) = -CNDecompBgcParamsInst%rf_s3s1_bgc + cascade_matrix((som1-1)*nelms+c_loc ,reac) = 1._r8-CNDecompBgcParamsInst%rf_s3s1_bgc + cascade_matrix((som1-1)*nelms+n_loc ,reac) = safe_div(1._r8-CNDecompBgcParamsInst%rf_s3s1_bgc,cn_ratios(som1)) + + cascade_matrix(lid_co2 ,reac) = CNDecompBgcParamsInst%rf_s3s1_bgc + cascade_matrix(lid_nh4 ,reac) = safe_div(1._r8,cn_ratios(som3)) - safe_div(1._r8-CNDecompBgcParamsInst%rf_s3s1_bgc,cn_ratios(som1)) + cascade_matrix(lid_minn_nh4_immob ,reac) = -cascade_matrix(lid_nh4 ,reac) + cascade_matrix(lid_co2_hr ,reac) = CNDecompBgcParamsInst%rf_s3s1_bgc + primvarid(reac) = (som3-1)*nelms+c_loc + is_aerobic_reac(reac) = .true. + if(cascade_matrix(lid_nh4, reac)<0._r8)then + !it requires nitrogen uptake + nitrogen_limit_flag(reac) = .true. + + endif + !---------------------------------------------------------------------- + !reaction 7, the partition into lit1 and lit2 is nutrient dependent, respires co2? + reac = cwd_dek_reac + !cwd + o2 -> 0.76lit2 + 0.24*lit3 + (1/cn_ratios(cwd)-0.76/cn_ratios(lit2)-0.24/cn_ratios(lit3)) + (1/cp_ratios(cwd)-0.76/cp_ratios(lit2)-0.24/cp_ratios(lit3)) + cascade_matrix((cwd-1)*nelms+c_loc ,reac) = -1._r8 + cascade_matrix((cwd-1)*nelms+n_loc ,reac) = -safe_div(1._r8,cn_ratios(cwd)) + + cascade_matrix((lit2-1)*nelms+c_loc ,reac) = CNDecompBgcParamsInst%cwd_fcel_bgc + cascade_matrix((lit2-1)*nelms+n_loc ,reac) = safe_div(CNDecompBgcParamsInst%cwd_fcel_bgc,cn_ratios(lit2)) + + cascade_matrix((lit3-1)*nelms+c_loc ,reac) = CNDecompBgcParamsInst%cwd_flig_bgc + cascade_matrix((lit3-1)*nelms+n_loc ,reac) = safe_div(CNDecompBgcParamsInst%cwd_flig_bgc,cn_ratios(lit3)) + + cascade_matrix(lid_nh4 ,reac) = safe_div(1._r8,cn_ratios(cwd)) - safe_div(CNDecompBgcParamsInst%cwd_fcel_bgc,cn_ratios(lit2)) - & + safe_div(CNDecompBgcParamsInst%cwd_flig_bgc,cn_ratios(lit3)) + cascade_matrix(lid_minn_nh4_immob ,reac) = -cascade_matrix(lid_nh4 ,reac) + + primvarid(reac) = (cwd-1)*nelms+c_loc + is_aerobic_reac(reac) = .true. + if(cascade_matrix(lid_nh4, reac)<0._r8)then + !it requires nitrogen uptake + nitrogen_limit_flag(reac) = .true. + + endif + + !---------------------------------------------------------------------- + !reaction 8, nitrification + reac = lid_nh4_nit_reac + !NH4(+) + (2-f)O2 + (2-f)OH(-)-> (1-f)NO3(-) + (f/2)N2O + (3-f/2) H2O + cascade_matrix(lid_nh4 ,reac) = -1._r8 + cascade_matrix(lid_o2 ,reac) = -(2._r8 - nitrif_n2o_loss_frac) + cascade_matrix(lid_no3 ,reac) = 1._r8 - nitrif_n2o_loss_frac + cascade_matrix(lid_n2o, reac) = 0.5_r8 * nitrif_n2o_loss_frac + + cascade_matrix(lid_nh4_nit,reac) = 1._r8 + cascade_matrix(lid_n2o_nit,reac) = nitrif_n2o_loss_frac + primvarid(reac) = lid_nh4 + is_aerobic_reac(reac) = .true. + !---------------------------------------------------------------------- + !reaction 9, denitrification + reac = lid_no3_den_reac + !NO3(-) -> 0.5*f N2O + 0.5* (1-f) N2, where f is a function determined from the century denitrification model + cascade_matrix(lid_no3 ,reac) = -1._r8 + cascade_matrix(lid_n2o ,reac) = 0.5_r8 * 1._r8/(1._r8+n2_n2o_ratio_denit) + cascade_matrix(lid_n2 ,reac) = 0.5_r8 * n2_n2o_ratio_denit/(1._r8+n2_n2o_ratio_denit) + cascade_matrix(lid_no3_den,reac) = 1._r8 + primvarid(reac) = lid_no3 + + !---------------------------------------------------------------------- + !below are zero order reactions + !---------------------------------------------------------------------- + !reaction 10, plant mineral nitrogen uptake + reac = lid_plant_minn_up_reac + ! f nh4 + (1-f) no3 -> plant_nitrogen + cascade_matrix(lid_nh4, reac) = -1._r8 + cascade_matrix(lid_no3, reac) = 0._r8 + cascade_matrix(lid_plant_minn, reac) = 1._r8 + + reac = lid_at_rt_reac + + !ar + o2 -> co2 + cascade_matrix(lid_co2, reac) = 1._r8 + cascade_matrix(lid_o2, reac) = -1._r8 + is_aerobic_reac(reac) = .true. + + !-------------------------------------------------------------------- + !arenchyma transport + !second primary variables + reac = lid_o2_aere_reac + cascade_matrix(lid_o2, reac) = -1._r8 + cascade_matrix(lid_o2_paere, reac) = 1._r8 + + is_aerobic_reac(reac) = .true. + if ( spinup_state /= 1 ) then + reac = lid_ch4_aere_reac + cascade_matrix(lid_ch4, reac) = -1._r8 + cascade_matrix(lid_ch4_paere, reac) = 1._r8 + + reac = lid_ar_aere_reac + cascade_matrix(lid_ar, reac) = -1._r8 + cascade_matrix(lid_ar_paere, reac) = 1._r8 + + reac = lid_co2_aere_reac + cascade_matrix(lid_co2, reac) = -1._r8 + cascade_matrix(lid_co2_paere, reac) = 1._r8 + + reac = lid_n2o_aere_reac + cascade_matrix(lid_n2o, reac) = -1._r8 + cascade_matrix(lid_n2o_paere, reac) = 1._r8 + + reac = lid_n2_aere_reac + cascade_matrix(lid_n2, reac) = -1._r8 + cascade_matrix(lid_n2_paere, reac) = 1._r8 + endif + + end associate +end subroutine calc_cascade_matrix + + + +end module BGCCenturySubMod diff --git a/components/clm/src/betr/bgc_century/BGCReactionsCenturyCLM3Type.F90 b/components/clm/src/betr/bgc_century/BGCReactionsCenturyCLM3Type.F90 new file mode 100644 index 000000000000..5d35b4cc96a4 --- /dev/null +++ b/components/clm/src/betr/bgc_century/BGCReactionsCenturyCLM3Type.F90 @@ -0,0 +1,1268 @@ +module BGCReactionsCenturyCLM3Type + +#include "shr_assert.h" + + ! + ! !DESCRIPTION + ! do nitrogen competition using the ad hoc down-regulation scheme, see Tang and Riley, BG, 2015 + ! HISTORY: + ! Created by Jinyun Tang, Oct 2nd, 2014 + ! + + ! !USES + ! + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varctl , only : iulog + use abortutils , only : endrun + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_time_manager , only : get_nstep + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use decompMod , only : bounds_type + use BGCReactionsMod , only : bgc_reaction_type + use clm_varcon , only : spval + use clm_varctl , only : spinup_state + use tracer_varcon , only : bndcond_as_conc, bndcond_as_flux + use BGCCenturySubMod + use BGCCenturySubCoreMod + use LandunitType , only : lun + use ColumnType , only : col + use GridcellType , only : grc + use landunit_varcon , only : istsoil, istcrop + implicit none + + save + private + logical :: ldebug + ! + ! !PUBLIC TYPES: + public :: bgc_reaction_CENTURY_clm3_type + type(centurybgc_type), private :: centurybgc_vars + + !integer, private :: lpr + type, extends(bgc_reaction_type) :: & + bgc_reaction_CENTURY_clm3_type + private +contains + procedure :: Init_betrbgc ! initialize betr bgc + procedure :: set_boundary_conditions ! set top/bottom boundary conditions for various tracers + procedure :: calc_bgc_reaction ! doing bgc calculation + procedure :: init_boundary_condition_type ! initialize type of top boundary conditions + procedure :: do_tracer_equilibration ! do equilibrium tracer chemistry + procedure :: initCold + procedure :: readParams + procedure :: init_betr_alm_bgc_coupler ! update state vars using other bgc parts in alm + procedure :: betr_alm_flux_statevar_feedback +end type bgc_reaction_CENTURY_clm3_type + + +type, private :: Extra_type + real(r8), pointer :: cn_ratios(:) !cn ratio of om pool + real(r8), pointer :: cp_ratios(:) !cp ratio of om pool + real(r8), pointer :: k_decay(:) !decay parameter for all reactions + real(r8), pointer :: scal_f(:) !scaling factor for first order sink + real(r8), pointer :: conv_f(:) !converting factor for first order sink + real(r8), pointer :: conc_f(:) !external forcing strength + real(r8) :: n2_n2o_ratio_denit !ratio of n2 to n2o during denitrification + real(r8) :: cellsand !sand content + logical, pointer :: is_zero_order(:) + integer :: nr !number of reactions involved +contains + procedure, public :: Init_Allocate + procedure, public :: DDeallocate + procedure, public :: AAssign +end type Extra_type +type(Extra_type), private :: Extra_inst + + +interface bgc_reaction_CENTURY_clm3_type + module procedure constructor + +end interface bgc_reaction_CENTURY_clm3_type + + +contains + + subroutine Init_Allocate(this, nompools, nreacts, nprimstvars) + ! + ! !DESCRIPTION: + ! allocate memory + ! + ! !ARGUMENTS: + class(Extra_type) :: this + integer, intent(in) :: nompools + integer, intent(in) :: nreacts + integer, intent(in) :: nprimstvars !number of primary state variables + + allocate(this%cn_ratios(nompools)) + allocate(this%cp_ratios(nompools)) + allocate(this%k_decay(nreacts)) + allocate(this%scal_f(nprimstvars)); this%scal_f(:) = 0._r8 + allocate(this%conv_f(nprimstvars)); this%conv_f(:) = 0._r8 + allocate(this%conc_f(nprimstvars)); this%conc_f(:) = 0._r8 + allocate(this%is_zero_order(nreacts)); this%is_zero_order(:) = .false. + this%nr = nreacts + + end subroutine Init_Allocate + + !------------------------------------------------------------------------------- + + subroutine DDeallocate(this) + ! !DESCRIPTION: + ! Deallocate memory + ! + ! !ARGUMENTS: + class(Extra_type) :: this + + + deallocate(this%cn_ratios) + deallocate(this%cp_ratios) + deallocate(this%k_decay) + deallocate(this%scal_f) + deallocate(this%conv_f) + deallocate(this%conc_f) + + end subroutine DDeallocate + !------------------------------------------------------------------------------- + + subroutine AAssign(this, cn_r,cp_r, k_d, n2_n2o_r_denit, cell_sand, betrtracer_vars, gas2bulkcef, aere_cond, tracer_conc_atm) + ! !DESCRIPTION: + ! update member variables for data specified by this + ! + ! !USES: + use BeTRTracerType , only : betrtracer_type + ! !ARGUMENTS: + class(Extra_type) :: this + real(r8), dimension(:), intent(in) :: cn_r + real(r8), dimension(:), intent(in) :: cp_r + real(r8), dimension(:), intent(in) :: k_d + real(r8) , intent(in) :: n2_n2o_r_denit + real(r8) , intent(in) :: cell_sand + type(BeTRtracer_type ), intent(in) :: betrtracer_vars + real(r8) , intent(in) :: gas2bulkcef(1:betrtracer_vars%nvolatile_tracers) + real(r8) , intent(in) :: aere_cond(1:betrtracer_vars%nvolatile_tracers) + real(r8) , intent(in) :: tracer_conc_atm(1:betrtracer_vars%nvolatile_tracers) + integer :: n1, n2, n3, j + + + n1 = size(cn_r) + n2 = size(cp_r) + n3 = size(k_d) + SHR_ASSERT_ALL((n1 == n2), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((n3 == this%nr), errMsg(__FILE__,__LINE__)) + this%cn_ratios(1:n1) = cn_r + this%cp_ratios(1:n2) = cp_r + + this%n2_n2o_ratio_denit = n2_n2o_r_denit + this%cellsand = cell_sand + this%k_decay = k_d + + + do j = 1, betrtracer_vars%ngwmobile_tracers + if(j == betrtracer_vars%id_trc_o2)then + this%scal_f(centurybgc_vars%lid_o2) = aere_cond(betrtracer_vars%volatileid(j)) + this%conc_f(centurybgc_vars%lid_o2) = tracer_conc_atm(betrtracer_vars%volatileid(j)) + this%conv_f(centurybgc_vars%lid_o2) = 1._r8/gas2bulkcef(betrtracer_vars%volatileid(j)) + + elseif(j == betrtracer_vars%id_trc_n2)then + this%scal_f(centurybgc_vars%lid_n2) = aere_cond(betrtracer_vars%volatileid(j)) + this%conc_f(centurybgc_vars%lid_n2) = tracer_conc_atm(betrtracer_vars%volatileid(j)) + this%conv_f(centurybgc_vars%lid_n2) = 1._r8/gas2bulkcef(betrtracer_vars%volatileid(j)) + + elseif(j == betrtracer_vars%id_trc_ar)then + this%scal_f(centurybgc_vars%lid_ar) = aere_cond(betrtracer_vars%volatileid(j)) + this%conc_f(centurybgc_vars%lid_ar) = tracer_conc_atm(betrtracer_vars%volatileid(j)) + this%conv_f(centurybgc_vars%lid_ar) = 1._r8/gas2bulkcef(betrtracer_vars%volatileid(j)) + + elseif(j==betrtracer_vars%id_trc_co2x)then + this%scal_f(centurybgc_vars%lid_co2) = aere_cond(betrtracer_vars%volatileid(j)) + this%conc_f(centurybgc_vars%lid_co2) = tracer_conc_atm(betrtracer_vars%volatileid(j)) + this%conv_f(centurybgc_vars%lid_co2) = 1._r8/gas2bulkcef(betrtracer_vars%volatileid(j)) + + elseif(j==betrtracer_vars%id_trc_ch4) then + this%scal_f(centurybgc_vars%lid_ch4) = aere_cond(betrtracer_vars%volatileid(j)) + this%conc_f(centurybgc_vars%lid_ch4) = tracer_conc_atm(betrtracer_vars%volatileid(j)) + this%conv_f(centurybgc_vars%lid_ch4) = 1._r8/gas2bulkcef(betrtracer_vars%volatileid(j)) + + elseif(j==betrtracer_vars%id_trc_n2o) then + this%scal_f(centurybgc_vars%lid_n2o) = aere_cond(betrtracer_vars%volatileid(j)) + this%conc_f(centurybgc_vars%lid_n2o) = tracer_conc_atm(betrtracer_vars%volatileid(j)) + this%conv_f(centurybgc_vars%lid_n2o) = 1._r8/gas2bulkcef(betrtracer_vars%volatileid(j)) + endif + enddo + end subroutine AAssign + + !------------------------------------------------------------------------------- + type(bgc_reaction_CENTURY_clm3_type) function constructor() + ! + ! !DESCRIPTION: + ! create an object of type bgc_reaction_CENTURY_clm3_type. + ! Right now it is purposely empty + + end function constructor + + + !------------------------------------------------------------------------------- + subroutine init_boundary_condition_type(this, bounds, betrtracer_vars, tracerboundarycond_vars ) + ! + ! !DESCRIPTION: + ! initialize boundary condition types + ! !USES: + use TracerBoundaryCondType , only : tracerboundarycond_type + use BeTRTracerType , only : betrtracer_type + + ! !ARGUMENTS: + class(bgc_reaction_CENTURY_clm3_type), intent(in) :: this + type(bounds_type) , intent(in) :: bounds + type(BeTRtracer_type ) , intent(in) :: betrtracer_vars + type(tracerboundarycond_type) , intent(in) :: tracerboundarycond_vars + + + ! !LOCAL VARIABLES: + integer :: c + + + associate( & + groupid => betrtracer_vars%groupid & + ) + tracerboundarycond_vars%topbc_type(1:betrtracer_vars%ngwmobile_tracer_groups) = bndcond_as_conc + tracerboundarycond_vars%topbc_type(groupid(betrtracer_vars%id_trc_no3x)) = bndcond_as_flux + + tracerboundarycond_vars%topbc_type(betrtracer_vars%ngwmobile_tracer_groups+1:betrtracer_vars%ntracer_groups) = bndcond_as_flux + + end associate + end subroutine init_boundary_condition_type + + !------------------------------------------------------------------------------- + + subroutine Init_betrbgc(this, bounds, lbj, ubj, betrtracer_vars) + ! + ! !DESCRIPTION: + ! initialize the betrbgc + ! !USES: + use CNSharedParamsMod , only : CNParamsReadShared + use ncdio_pio , only : file_desc_t + use BeTRTracerType , only : betrtracer_type + use MathfuncMod , only : addone + use clm_varctl , only : cnallocate_carbon_only_set + + ! !ARGUMENTS: + class(bgc_reaction_CENTURY_clm3_type), intent(in) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: lbj, ubj ! lower and upper bounds, make sure they are > 0 + type(BeTRtracer_type ) , intent(inout) :: betrtracer_vars + + !LOCAL VARIABLES: + character(len=32) , parameter :: subname ='Init_betrbgc' + integer :: jj + integer :: nelm, itemp_mem + integer :: itemp, itemp_vgrp, itemp_v, itemp_grp + integer :: c_loc, n_loc, trcid + logical :: carbon_only = .false. + + call cnallocate_carbon_only_set(carbon_only) + call centurybgc_vars%Init(bounds, lbj, ubj) + + nelm =centurybgc_vars%nelms + c_loc=centurybgc_vars%c_loc + n_loc=centurybgc_vars%n_loc + + itemp = 0 + betrtracer_vars%id_trc_n2 = addone(itemp) + betrtracer_vars%id_trc_o2 = addone(itemp) + betrtracer_vars%id_trc_ar = addone(itemp) + betrtracer_vars%id_trc_co2x = addone(itemp) + betrtracer_vars%id_trc_ch4 = addone(itemp) + betrtracer_vars%id_trc_nh3x = addone(itemp) + betrtracer_vars%id_trc_no3x = addone(itemp) + betrtracer_vars%id_trc_n2o = addone(itemp) + + betrtracer_vars%ngwmobile_tracer_groups=itemp ! n2, o2, ar, co2, ch4, n2o, nh3x and no3x + betrtracer_vars%ngwmobile_tracers = itemp + betrtracer_vars%nvolatile_tracers=itemp-2 ! n2, o2, ar, co2, ch4 and n2o + betrtracer_vars%nvolatile_tracer_groups = itemp-2 ! + betrtracer_vars%nsolid_passive_tracer_groups = 4 ! som1, som2, som3 and others (lit1, lit2, lit3, cwd) + betrtracer_vars%nsolid_passive_tracers=centurybgc_vars%nom_pools*nelm ! + + betrtracer_vars%nmem_max = nelm*4 ! total number of elemnts, and 4 sub members (lit1, lit2, lit3, cwd) + + call betrtracer_vars%Init() + + betrtracer_vars%is_mobile(:) = .true. + + jj = itemp + itemp_vgrp = 0 !counter for volatile groups + itemp_v = 0 !counter for volatile tracers + itemp_grp = 0 !counter for tracer groups + + trcid = betrtracer_vars%id_trc_n2 + + + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_n2, trc_name='N2' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_o2, trc_name='O2' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_ar, trc_name='AR' , & + is_trc_mobile=.false., is_trc_advective = .false., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_co2x, trc_name='CO2x', & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = addone(itemp_grp) , & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_ch4, trc_name='CH4' , & + is_trc_mobile=.false., is_trc_advective = .false., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_nh3x, trc_name='NH3x', & + is_trc_mobile=.false., is_trc_advective = .false., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.false.) + + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_no3x, trc_name='NO3x', & + is_trc_mobile=.true., is_trc_advective = .true., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.false.,trc_vtrans_scal=1._r8) + + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_n2o, trc_name='N2O' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + + + !------------------------------------------------------------------------------------ + itemp_mem=0 + itemp_grp=addone(itemp_grp) !only one group passive solid litter tracers + trcid = jj+(centurybgc_vars%lit1-1)*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='LIT1C' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%lit1-1)*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='LIT1N' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + !------------------------------------------------------------------------------------ + + trcid = jj+(centurybgc_vars%lit2-1)*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='LIT2C' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%lit2-1)*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='LIT2N' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + !------------------------------------------------------------------------------------ + + trcid = jj+(centurybgc_vars%lit3-1)*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='LIT3C' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%lit3-1)*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='LIT3N' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + !------------------------------------------------------------------------------------ + + trcid = jj+(centurybgc_vars%cwd-1 )*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='CWDC' , & + is_trc_mobile=.false., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%cwd-1 )*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='CWDN' , & + is_trc_mobile=.false., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + !========================================================================================== + !new group + itemp_mem = 0 + itemp_grp = addone(itemp_grp) + trcid = jj+(centurybgc_vars%som1-1)*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='SOM1C' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp , & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%som1-1)*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='SOM1N' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + !------------------------------------------------------------------------------------ + !new group + itemp_mem=0 + itemp_grp = addone(itemp_grp) + trcid = jj+(centurybgc_vars%som2-1)*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='SOM2C' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp , & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%som2-1)*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='SOM2N' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + !------------------------------------------------------------------------------------ + !new group + itemp_mem=0 + itemp_grp = addone(itemp_grp) + trcid = jj+(centurybgc_vars%som3-1)*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='SOM3C' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%som3-1)*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='SOM3N' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + + + + end subroutine Init_betrbgc + + !------------------------------------------------------------------------------- + subroutine set_boundary_conditions(this, bounds, num_soilc, filter_soilc, dz_top, betrtracer_vars, & + waterflux_vars, tracerboundarycond_vars) + ! + ! !DESCRIPTION: + ! set up boundary conditions for tracer movement + ! + ! !USES: + use TracerBoundaryCondType, only : tracerboundarycond_type + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + use BeTRTracerType , only : betrtracer_type + use WaterfluxType , only : waterflux_type + + ! !ARGUMENTS: + class(bgc_reaction_CENTURY_clm3_type), intent(in) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of columns in column filter + integer , intent(in) :: filter_soilc(:) ! column filter + type(betrtracer_type) , intent(in) :: betrtracer_vars + real(r8) , intent(in) :: dz_top(bounds%begc: ) + type(waterflux_type) , intent(in) :: waterflux_vars + type(tracerboundarycond_type) , intent(inout) :: tracerboundarycond_vars + + + ! !LOCAL VARIABLES: + character(len=255) :: subname = 'set_boundary_conditions' + integer :: fc, c + + SHR_ASSERT_ALL((ubound(dz_top) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + + associate( & + groupid => betrtracer_vars%groupid & + ) + do fc = 1, num_soilc + c = filter_soilc(fc) + !values below will be updated with datastream + !eventually, the following code will be implemented using polymorphism + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%ngwmobile_tracers+1:betrtracer_vars%ntracers)=0._r8 !zero incoming flux + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_n2) =32.8_r8 !mol m-3, contant boundary condition + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_o2) =8.78_r8 !mol m-3, contant boundary condition + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_ar) =0.3924_r8 !mol m-3, contant boundary condition + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_co2x)=0.0168_r8 !mol m-3, contant boundary condition + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_ch4) =6.939e-5_r8 !mol m-3, contant boundary condition + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_n2o) =1.195e-5_r8 !mol m-3, contant boundary condition + + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_no3x) = 0._r8 + tracerboundarycond_vars%bot_concflux_col(c,1,:) = 0._r8 !zero flux boundary condition + !those will be updated with snow resistance and hydraulic wicking resistance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_n2)) = 2._r8*1.267e-5_r8/dz_top(c) !m/s surface conductance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_o2)) = 2._r8*1.267e-5_r8/dz_top(c) !m/s surface conductance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_ar)) = 2._r8*1.267e-5_r8/dz_top(c) !m/s surface conductance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_co2x)) = 2._r8*1.267e-5_r8/dz_top(c) !m/s surface conductance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_ch4)) = 2._r8*1.267e-5_r8/dz_top(c) !m/s surface conductance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_n2o)) = 2._r8*1.267e-5_r8/dz_top(c) !m/s surface conductance + enddo + end associate + end subroutine set_boundary_conditions + !------------------------------------------------------------------------------- + + subroutine calc_bgc_reaction(this, bounds, lbj, ubj, num_soilc, filter_soilc, num_soilp, filter_soilp, jtops, dtime, & + betrtracer_vars, tracercoeff_vars, waterstate_vars, temperature_vars, soilstate_vars, chemstate_vars, & + cnstate_vars, carbonstate_vars, carbonflux_vars, nitrogenstate_vars, nitrogenflux_vars, tracerstate_vars, & + tracerflux_vars, plantsoilnutrientflux_vars) + ! + ! !DESCRIPTION: + ! + ! do bgc reaction + ! this returns net carbon fluxes from decay and translocation + ! and also update the related carbon/nitrogen/phosphorus(potentially) pools of OM + ! note it is assumed the stoichiometry of the om pools are not changed during decomposition + ! + ! !USES: + ! + use tracerfluxType , only : tracerflux_type + use tracerstatetype , only : tracerstate_type + use tracercoeffType , only : tracercoeff_type + use BetrTracerType , only : betrtracer_type + use WaterStateType , only : Waterstate_Type + use TemperatureType , only : temperature_type + use ChemStateType , only : chemstate_type + use SoilStatetype , only : soilstate_type + use ODEMod , only : ode_ebbks1,ldebug_ode + use CNStateType , only : cnstate_type + use PlantSoilnutrientFluxType, only : plantsoilnutrientflux_type + use CNVerticalProfileMod , only : decomp_vertprofiles + use CNCarbonStateType , only : carbonstate_type + use CNCarbonFluxType , only : carbonflux_type + use CNNitrogenFluxType , only : nitrogenflux_type + use CNNitrogenStateType , only : nitrogenstate_type + + ! !ARGUMENTS: + class(bgc_reaction_CENTURY_clm3_type) , intent(in) :: this + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_soilc ! number of columns in column filter + integer , intent(in) :: filter_soilc(:) ! column filter + integer , intent(in) :: num_soilp + integer , intent(in) :: filter_soilp(:) ! pft filter + integer , intent(in) :: jtops(bounds%begc: ) ! top index of each column + integer , intent(in) :: lbj, ubj ! lower and upper bounds, make sure they are > 0 + real(r8) , intent(in) :: dtime ! model time step + type(Waterstate_Type) , intent(in) :: waterstate_vars ! water state variables + type(temperature_type) , intent(in) :: temperature_vars ! energy state variable + type(soilstate_type) , intent(in) :: soilstate_vars + type(chemstate_type) , intent(in) :: chemstate_vars + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(tracercoeff_type) , intent(in) :: tracercoeff_vars + type(carbonstate_type) , intent(in) :: carbonstate_vars + type(cnstate_type) , intent(inout) :: cnstate_vars + type(carbonflux_type) , intent(inout) :: carbonflux_vars + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + type(tracerstate_type) , intent(inout) :: tracerstate_vars + type(tracerflux_type) , intent(inout) :: tracerflux_vars + type(plantsoilnutrientflux_type) , intent(inout) :: plantsoilnutrientflux_vars + + ! !LOCAL VARIABLES: + character(len=32), parameter :: subname ='calc_bgc_reaction' + integer :: fc, c, j, k + real(r8) :: time + real(r8) :: y0(centurybgc_vars%nstvars, bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: yf(centurybgc_vars%nstvars, bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: cn_ratios(centurybgc_vars%nom_pools, bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: cp_ratios(centurybgc_vars%nom_pools, bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: k_decay(centurybgc_vars%nreactions, bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: pot_decay_rates(centurybgc_vars%nom_pools, bounds%begc:bounds%endc, lbj:ubj) ![mol C/m3/s] potential decay rates for different om pools without nutrient limitation + real(r8) :: pot_co2_hr(bounds%begc:bounds%endc, lbj:ubj) ![mol C/m3/s], potential co2 respiration rate + real(r8) :: pot_nh3_immob(bounds%begc:bounds%endc,lbj:ubj) + real(r8) :: anaerobic_frac(bounds%begc:bounds%endc,lbj:ubj) + real(r8) :: n2_n2o_ratio_denit(bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: nh4_no3_ratio(bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: nuptake_prof(bounds%begc:bounds%endc,1:ubj) + real(r8) :: pscal + + SHR_ASSERT_ALL((ubound(jtops) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + + call Extra_inst%Init_Allocate(centurybgc_vars%nom_pools, centurybgc_vars%nreactions, centurybgc_vars%nprimvars) + + call set_reaction_order( centurybgc_vars%nreactions, centurybgc_vars, Extra_inst%is_zero_order) + + !initialize local variables + y0(:, :, :) = spval + yf(:, :, :) = spval + cn_ratios(:,:,:) = nan + cp_ratios(:,:,:) = nan + + !initialize the state vector + call init_state_vector(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, centurybgc_vars%nstvars, tracerstate_vars, betrtracer_vars, centurybgc_vars, y0) + + !update the initial vector from external input + !calculate elemental stoichiometry for different om pools and add mineral nutrient input from other than decaying process + + call bgcstate_ext_update_bfdecomp(bounds, 1, ubj, num_soilc, filter_soilc, carbonflux_vars, nitrogenflux_vars, & + centurybgc_vars, betrtracer_vars, tracerflux_vars, y0, cn_ratios, cp_ratios) + + !calculate nitrogen uptake profile + call calc_nuptake_prof(bounds, ubj, num_soilc, filter_soilc, & + tracerstate_vars%tracer_conc_mobile_col(bounds%begc:bounds%endc, 1:ubj, betrtracer_vars%id_trc_nh3x), & + tracerstate_vars%tracer_conc_mobile_col(bounds%begc:bounds%endc, 1:ubj, betrtracer_vars%id_trc_no3x), & + col%dz(bounds%begc:bounds%endc,1:ubj), cnstate_vars%nfixation_prof_col(bounds%begc:bounds%endc,1:ubj), & + nuptake_prof(bounds%begc:bounds%endc,1:ubj)) + + !update plant nitrogen uptake potential + + call plantsoilnutrientflux_vars%calc_nutrient_uptake_potential(bounds, num_soilc, filter_soilc, num_soilp, & + filter_soilp, carbonstate_vars%frootc_patch) + + !calculate multiplicative scalars for decay parameters + call calc_decompK_multiply_scalar(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, & + waterstate_vars%finundated_col(bounds%begc:bounds%endc), col%z(bounds%begc:bounds%endc, lbj:ubj),& + temperature_vars%t_soisno_col(bounds%begc:bounds%endc, lbj:ubj), & + tracerstate_vars%tracer_conc_mobile_col(bounds%begc:bounds%endc, lbj:ubj, betrtracer_vars%id_trc_o2), & + tracercoeff_vars%aqu2bulkcef_mobile_col(bounds%begc:bounds%endc, lbj:ubj, betrtracer_vars%id_trc_o2), & + soilstate_vars, centurybgc_vars, carbonflux_vars) + + !calculate decay coefficients + call calc_som_deacyK(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, centurybgc_vars%nom_pools, tracercoeff_vars, tracerstate_vars, & + betrtracer_vars, centurybgc_vars, carbonflux_vars,dtime, k_decay(1:centurybgc_vars%nom_pools, bounds%begc:bounds%endc, lbj:ubj)) + + !calculate potential decay rates, without nutrient constraint + call calc_sompool_decay(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, centurybgc_vars, & + k_decay(1:centurybgc_vars%nom_pools, bounds%begc:bounds%endc, lbj:ubj), y0(1:centurybgc_vars%nom_totelms, bounds%begc:bounds%endc, lbj:ubj),& + pot_decay_rates) + + !calculate potential respiration rates by summarizing all om decomposition pathways + call calc_potential_aerobic_hr(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, cn_ratios, cp_ratios, centurybgc_vars, pot_decay_rates, & + soilstate_vars%cellsand_col(bounds%begc:bounds%endc,lbj:ubj), pot_co2_hr, pot_nh3_immob) + + !calculate fraction of anerobic environment + call calc_anaerobic_frac(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, temperature_vars%t_soisno_col(bounds%begc:bounds%endc,lbj:ubj),& + soilstate_vars, waterstate_vars%h2osoi_vol_col(bounds%begc:bounds%endc,lbj:ubj), pot_co2_hr, & + tracerstate_vars%tracer_conc_mobile_col(bounds%begc:bounds%endc, lbj:ubj, betrtracer_vars%id_trc_o2), & + anaerobic_frac(bounds%begc:bounds%endc, lbj:ubj)) + + !calculate normalized rate for nitrification and denitrification + call calc_nitrif_denitrif_rate(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, col%dz(bounds%begc:bounds%endc, lbj:ubj), & + temperature_vars%t_soisno_col(bounds%begc:bounds%endc, lbj:ubj), & + chemstate_vars%soil_pH(bounds%begc:bounds%endc, lbj:ubj), pot_co2_hr, anaerobic_frac, & + tracerstate_vars%tracer_conc_mobile_col(bounds%begc:bounds%endc, lbj:ubj, betrtracer_vars%id_trc_nh3x), & + tracerstate_vars%tracer_conc_mobile_col(bounds%begc:bounds%endc, lbj:ubj, betrtracer_vars%id_trc_no3x), & + soilstate_vars, waterstate_vars, carbonflux_vars, n2_n2o_ratio_denit, nh4_no3_ratio, & + k_decay(centurybgc_vars%lid_nh4_nit_reac, bounds%begc:bounds%endc, lbj:ubj), & + k_decay(centurybgc_vars%lid_no3_den_reac, bounds%begc:bounds%endc, lbj:ubj)) + + + call calc_plant_nitrogen_uptake_prof(bounds, ubj, num_soilc, filter_soilc, col%dz(bounds%begc:bounds%endc, lbj:ubj), & + plantsoilnutrientflux_vars%plant_minn_uptake_potential_col(bounds%begc:bounds%endc), & + nuptake_prof(bounds%begc:bounds%endc,1:ubj), & + k_decay(centurybgc_vars%lid_plant_minn_up_reac, bounds%begc:bounds%endc ,1:ubj)) + + !apply root distribution here + call apply_plant_root_respiration_prof(bounds, ubj, num_soilc, filter_soilc, & + carbonflux_vars%rr_col(bounds%begc:bounds%endc), cnstate_vars%nfixation_prof_col(bounds%begc:bounds%endc,1:ubj), & + k_decay(centurybgc_vars%lid_at_rt_reac, bounds%begc:bounds%endc, 1:ubj)) + + do j = lbj, ubj + do fc = 1, num_soilc + c = filter_soilc(fc) + if(j betrtracer_vars%volatileid & + ) + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if (lun%ifspecial(l)) then + if(betrtracer_vars%ngwmobile_tracers>0)then + tracerstate_vars%tracer_conc_mobile_col(c,:,:) = spval + tracerstate_vars%tracer_conc_surfwater_col(c,:) = spval + tracerstate_vars%tracer_conc_aquifer_col(c,:) = spval + tracerstate_vars%tracer_conc_grndwater_col(c,:) = spval + tracerstate_vars%tracer_conc_atm_col(c,:) = spval + endif + if(betrtracer_vars%ntracers > betrtracer_vars%ngwmobile_tracers)then + tracerstate_vars%tracer_conc_solid_passive_col(c,:,:) = spval + endif + if(betrtracer_vars%nsolid_equil_tracers>0)then + tracerstate_vars%tracer_conc_solid_equil_col(c, :, :) = spval + endif + endif + tracerstate_vars%tracer_soi_molarmass_col(c,:) = spval + + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + !dual phase tracers + + tracerstate_vars%tracer_conc_mobile_col(c,:, :) = 0._r8 + tracerstate_vars%tracer_conc_surfwater_col(c,:) = 0._r8 + tracerstate_vars%tracer_conc_aquifer_col(c,:) = 0._r8 + tracerstate_vars%tracer_conc_grndwater_col(c,:) = 0._r8 + tracerstate_vars%tracer_conc_atm_col(c,volatileid(betrtracer_vars%id_trc_n2)) = 32.8_r8 + tracerstate_vars%tracer_conc_atm_col(c,volatileid(betrtracer_vars%id_trc_o2)) = 8.78_r8 + tracerstate_vars%tracer_conc_atm_col(c,volatileid(betrtracer_vars%id_trc_ar)) = 0.3924_r8 + tracerstate_vars%tracer_conc_atm_col(c,volatileid(betrtracer_vars%id_trc_co2x))= 0.0168_r8 + tracerstate_vars%tracer_conc_atm_col(c,volatileid(betrtracer_vars%id_trc_ch4)) = 6.939e-5_r8 + tracerstate_vars%tracer_conc_atm_col(c,volatileid(betrtracer_vars%id_trc_n2o)) = 1.195e-5_r8 + + !solid tracers + if(betrtracer_vars%ngwmobile_tracers < betrtracer_vars%ntracers)then + tracerstate_vars%tracer_conc_solid_passive_col(c,:,:) = 0._r8 + endif + + if(betrtracer_vars%nsolid_equil_tracers>0)then + tracerstate_vars%tracer_conc_solid_equil_col(c, :, :) = 0._r8 + endif + tracerstate_vars%tracer_soi_molarmass_col(c,:) = 0._r8 + endif + enddo + end associate + end subroutine InitCold + + !-------------------------------------------------------------------------------------------------------------------- + subroutine betr_alm_flux_statevar_feedback(this, bounds, num_soilc, filter_soilc, & + carbonstate_vars, nitrogenstate_vars, nitrogenflux_vars, tracerstate_vars, tracerflux_vars, betrtracer_vars) + + ! + ! !DESCRIPTION: + ! do state and flux variable exchange between betr and alm + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use tracerfluxType , only : tracerflux_type + use tracerstatetype , only : tracerstate_type + use decompMod , only : bounds_type + use BeTRTracerType , only : BeTRTracer_Type + use CNCarbonStateType , only : carbonstate_type + use CNNitrogenStateType , only : nitrogenstate_type + use CNNitrogenFluxType , only : nitrogenflux_type + + + ! !ARGUMENTS: + class(bgc_reaction_CENTURY_clm3_type) , intent(in) :: this + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_soilc ! number of columns in column filter + integer , intent(in) :: filter_soilc(:) ! column filter + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(tracerstate_type) , intent(in) :: tracerstate_vars + type(tracerflux_type) , intent(in) :: tracerflux_vars + type(carbonstate_type) , intent(inout) :: carbonstate_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars + + + + call assign_nitrogen_hydroloss(bounds, num_soilc, filter_soilc, tracerflux_vars, nitrogenflux_vars, betrtracer_vars) + + call assign_OM_CNpools(bounds, num_soilc, filter_soilc, carbonstate_vars, nitrogenstate_vars, tracerstate_vars, betrtracer_vars, centurybgc_vars) + + end subroutine betr_alm_flux_statevar_feedback + + !--------------------------------------------------------------- + subroutine init_betr_alm_bgc_coupler(this, bounds, carbonstate_vars, nitrogenstate_vars, betrtracer_vars, tracerstate_vars) + ! + ! !DESCRIPTION: + ! betr and alm state variable exchange + ! + ! !USES: + use clm_varcon , only : natomw, catomw + use clm_varpar , only : i_cwd, i_met_lit, i_cel_lit, i_lig_lit + use CNCarbonStateType , only : carbonstate_type + use CNNitrogenStateType , only : nitrogenstate_type + use tracerstatetype , only : tracerstate_type + use BetrTracerType , only : betrtracer_type + use clm_varpar , only : nlevtrc_soil + use landunit_varcon , only : istsoil, istcrop + + ! !ARGUMENTS: + class(bgc_reaction_CENTURY_clm3_type) , intent(in) :: this + type(bounds_type) , intent(in) :: bounds + type(tracerstate_type) , intent(inout) :: tracerstate_vars + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(carbonstate_type) , intent(in) :: carbonstate_vars + type(nitrogenstate_type) , intent(in) :: nitrogenstate_vars + + ! !LOCAL VARIABLES: + integer, parameter :: i_soil1 = 5 + integer, parameter :: i_soil2 = 6 + integer, parameter :: i_soil3 = 7 + character(len=255) :: subname = 'init_betr_alm_bgc_coupler' + integer :: c, j, k, l + + associate( & + id_trc_no3x => betrtracer_vars%id_trc_no3x , & + id_trc_nh3x => betrtracer_vars%id_trc_nh3x , & + decomp_cpools_vr => carbonstate_vars%decomp_cpools_vr_col , & + decomp_npools_vr => nitrogenstate_vars%decomp_npools_vr_col , & + smin_no3_vr_col => nitrogenstate_vars%smin_no3_vr_col , & + smin_nh4_vr_col => nitrogenstate_vars%smin_nh4_vr_col , & + tracer_conc_mobile => tracerstate_vars%tracer_conc_mobile_col , & + tracer_conc_solid_passive => tracerstate_vars%tracer_conc_solid_passive_col , & + c_loc => centurybgc_vars%c_loc , & + n_loc => centurybgc_vars%n_loc , & + lit1 => centurybgc_vars%lit1 , & + lit2 => centurybgc_vars%lit2 , & + lit3 => centurybgc_vars%lit3 , & + som1 => centurybgc_vars%som1 , & + som2 => centurybgc_vars%som2 , & + som3 => centurybgc_vars%som3 , & + cwd => centurybgc_vars%cwd , & + nelms => centurybgc_vars%nelms & + ) + !initialize tracer based on carbon/nitrogen pools + do j = 1, nlevtrc_soil + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + tracer_conc_mobile(c,j,id_trc_no3x)=smin_no3_vr_col(c,j) /natomw + tracer_conc_mobile(c,j,id_trc_nh3x)=smin_nh4_vr_col(c,j) /natomw + k = lit1; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_met_lit) / catomw + k = lit2; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_cel_lit) / catomw + k = lit3; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_lig_lit) / catomw + k = cwd ; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_cwd ) / catomw + k = som1; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_soil1 ) / catomw + k = som2; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_soil2 ) / catomw + k = som3; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_soil3 ) / catomw + + k = lit1; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_met_lit) / natomw + k = lit2; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_cel_lit) / natomw + k = lit3; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_lig_lit) / natomw + k = cwd ; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_cwd ) / natomw + k = som1; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_soil1 ) / natomw + k = som2; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_soil2 ) / natomw + k = som3; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_soil3 ) / natomw + endif + enddo + enddo + end associate + end subroutine init_betr_alm_bgc_coupler + + !------------------------------------------------------------------------------- + + + subroutine one_box_century_bgc(ystate, dtime, time, nprimvars, nstvars, dydt) + ! + ! !DESCRIPTION: + ! do a single box bgc + ! + !the equations to be solved are in the form + ! + ! dx/dt=I+A*R, where I is the input, A is the stoichiometric matrix, and R is the reaction vector + ! + ! the input only contains litter input and mineral nutrient, som is assumed to be of fixed stoichiometry + ! !USES: + use SOMStateVarUpdateMod , only : calc_dtrend_som_bgc + use BGCCenturySubMod , only : calc_cascade_matrix + implicit none + ! !ARGUMENTS: + integer, intent(in) :: nstvars + integer, intent(in) :: nprimvars + real(r8), intent(in) :: dtime + real(r8), intent(in) :: time + real(r8), intent(in) :: ystate(nstvars) + real(r8), intent(out) :: dydt(nstvars) + + ! !LOCAL VARIABLES: + integer :: lk, jj + real(r8) :: cascade_matrix(nstvars, Extra_inst%nr) + logical :: nitrogen_limit_flag(centurybgc_vars%nom_pools) + real(r8) :: reaction_rates(Extra_inst%nr) + real(r8) :: o2_consump, o2_limit + + !calculate cascade matrix, which contains the stoichiometry for all reactions + call calc_cascade_matrix(nstvars, Extra_inst%nr, Extra_inst%cn_ratios, Extra_inst%cp_ratios, & + Extra_inst%n2_n2o_ratio_denit, Extra_inst%cellsand, centurybgc_vars, nitrogen_limit_flag, cascade_matrix) + + !do pool degradation + do lk = 1, Extra_inst%nr + if(Extra_inst%is_zero_order(lk))then + + if ( spinup_state .eq. 1 ) then + !spinup stage + if(lk == centurybgc_vars%lid_o2_aere_reac)then + jj = centurybgc_vars%lid_o2 + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + !I add the following line to disconnect the nitrogen and oxygen interaction + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + else + reaction_rates(lk) = Extra_inst%k_decay(lk) !this effective defines the plant nitrogen demand + endif + else + ! normal run stage + if(lk == centurybgc_vars%lid_o2_aere_reac)then + jj = centurybgc_vars%lid_o2 + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + elseif(lk == centurybgc_vars%lid_ch4_aere_reac)then + jj = centurybgc_vars%lid_ch4 + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + + elseif(lk == centurybgc_vars%lid_ar_aere_reac)then + jj = centurybgc_vars%lid_ar + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + + elseif(lk == centurybgc_vars%lid_n2_aere_reac)then + jj = centurybgc_vars%lid_n2 + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + + elseif(lk == centurybgc_vars%lid_co2_aere_reac)then + jj = centurybgc_vars%lid_co2 + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + + elseif(lk == centurybgc_vars%lid_n2o_aere_reac)then + jj = centurybgc_vars%lid_n2o + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + + else + reaction_rates(lk) = Extra_inst%k_decay(lk) !this effective defines the plant nitrogen demand + endif + endif + + else + + reaction_rates(lk)=ystate(centurybgc_vars%primvarid(lk))*Extra_inst%k_decay(lk) + endif + enddo + + !obtain total oxygen consumption rate + o2_consump = DOT_PRODUCT(cascade_matrix(centurybgc_vars%lid_o2,1:Extra_inst%nr),reaction_rates(1:Extra_inst%nr)) + if(-o2_consump*dtime > ystate(centurybgc_vars%lid_o2))then + o2_limit=-ystate(centurybgc_vars%lid_o2)/(o2_consump*dtime) + do lk = 1, Extra_inst%nr + if(centurybgc_vars%is_aerobic_reac(lk))then + reaction_rates(lk) = reaction_rates(lk)*o2_limit + endif + enddo + endif + + call apply_nutrient_down_regulation(nstvars, Extra_inst%nr, nitrogen_limit_flag, ystate(centurybgc_vars%lid_nh4), ystate(centurybgc_vars%lid_no3), & + dtime, cascade_matrix, reaction_rates) + + call calc_dtrend_som_bgc(nstvars, Extra_inst%nr, cascade_matrix(1:nstvars, 1:Extra_inst%nr), reaction_rates(1:Extra_inst%nr), dydt) + + + end subroutine one_box_century_bgc + !------------------------------------------------------------------------------- + + + subroutine apply_nutrient_down_regulation(nstvars, nreactions, nitrogen_limit_flag, smin_nh4, smin_no3, dtime, cascade_matrix, reaction_rates) + ! + ! !DESCRIPTION: + ! + ! this down-regulation considers nitrogen made available from gross mineralization + ! this implements is corresponding to the CLM-3 approach as described in Tang and Riley (2015), BG, tehcnique note. + ! + ! !USES: + use clm_varctl, only : CNAllocate_Carbon_only + use MathfuncMod, only : safe_div + + ! !ARGUMENTS: + integer , intent(in) :: nstvars + integer , intent(in) :: nreactions + logical , intent(in) :: nitrogen_limit_flag(centurybgc_vars%nom_pools) + real(r8), intent(in) :: smin_nh4 + real(r8), intent(in) :: smin_no3 + real(r8), intent(in) :: dtime + real(r8), intent(inout) :: cascade_matrix(nstvars, nreactions) + real(r8), intent(inout) :: reaction_rates(nreactions) + ! !LOCAL VARIABLES: + real(r8) :: decomp_plant_minn_demand_flx + real(r8) :: tot_nh4_demand_flx + real(r8) :: tot_no3_demand_flx + real(r8) :: decomp_plant_residual_minn_demand_flx + real(r8) :: smin_nh4_to_decomp_plant_flx + real(r8) :: smin_no3_to_decomp_plant_flx + real(r8) :: tot_sminn_to_decomp_plant_flx + real(r8) :: frac_nh4_to_decomp_plant + real(r8) :: supp_nh4_to_decomp_plant_flx + real(r8) :: frac_supp_nh4_to_decomp_plant + real(r8) :: gross_nh4_to_decomp_plant_flx + real(r8) :: frac_gross_nh4_to_decomp_plant + real(r8) :: gross_min_nh4_flx + real(r8) :: frac_no3_to_decomp_plant + real(r8) :: dnegt + real(r8) :: tot_nh4_to_decomp_plant_flx + real(r8) :: alpha + real(r8) :: frac_gross_immob=1.0_r8 + integer :: reac + + associate( & ! + nom_pools => centurybgc_vars%nom_pools , & ! + lid_nh4 => centurybgc_vars%lid_nh4 , & ! + lid_no3 => centurybgc_vars%lid_no3 , & ! + lid_plant_minn => centurybgc_vars%lid_plant_minn , & ! + lid_minn_nh4_immob => centurybgc_vars%lid_minn_nh4_immob , & ! + lid_minn_no3_immob => centurybgc_vars%lid_minn_no3_immob , & ! + lid_minn_nh4_plant => centurybgc_vars%lid_minn_nh4_plant , & ! + lid_minn_no3_plant => centurybgc_vars%lid_minn_no3_plant , & ! + lid_nh4_supp => centurybgc_vars%lid_nh4_supp , & ! + lid_nh4_nit => centurybgc_vars%lid_nh4_nit , & ! + lid_plant_minn_up_reac=> centurybgc_vars%lid_plant_minn_up_reac, & ! + lid_nh4_nit_reac => centurybgc_vars%lid_nh4_nit_reac , & ! + lid_no3_den_reac => centurybgc_vars%lid_no3_den_reac & ! + ) + + decomp_plant_minn_demand_flx = 0._r8 + gross_min_nh4_flx = 0._r8 + do reac = 1, nom_pools + if(nitrogen_limit_flag(reac))then + decomp_plant_minn_demand_flx = decomp_plant_minn_demand_flx - reaction_rates(reac) * cascade_matrix(lid_nh4, reac) + else + gross_min_nh4_flx = gross_min_nh4_flx + reaction_rates(reac) * cascade_matrix(lid_nh4, reac) + endif + enddo + + !add nitrogen demand from plant + reac = lid_plant_minn_up_reac + decomp_plant_minn_demand_flx = decomp_plant_minn_demand_flx - reaction_rates(reac) * cascade_matrix(lid_nh4, reac) + + !in clm-century, nh4 is first competed between decomposer immobilization, plant and nitrification + !total nh3 demand includes decomposer, plant and nitrifier + reac = lid_nh4_nit_reac + tot_nh4_demand_flx = decomp_plant_minn_demand_flx - reaction_rates(reac) * cascade_matrix(lid_nh4 ,reac) + + if(tot_nh4_demand_flx*dtime>(smin_nh4+gross_min_nh4_flx*dtime))then + !not enought nitrogen + if(CNAllocate_Carbon_only())then + + !nitrifier uses what it is provided + !plant use the remaining nh4 and request external supply from supp nh4 + if(reaction_rates(reac)<1.e-40_r8)then + alpha = 0._r8 + else + alpha = -(smin_nh4+gross_min_nh4_flx*dtime)/(reaction_rates(lid_nh4_nit_reac)*cascade_matrix(lid_nh4,lid_nh4_nit_reac)*dtime) + endif + reaction_rates(lid_nh4_nit_reac) = reaction_rates(lid_nh4_nit_reac) * min(alpha, 1._r8) + + tot_nh4_to_decomp_plant_flx = smin_nh4/dtime+gross_min_nh4_flx+reaction_rates(lid_nh4_nit_reac)* cascade_matrix(lid_nh4 ,lid_nh4_nit_reac) + + else + !nitrifiers, decomposers and plants are nh4 limited + alpha = (smin_nh4+gross_min_nh4_flx*dtime)/(tot_nh4_demand_flx*dtime) !the last term is used to avoid roundoff error + !downregulate nitrification + reaction_rates(lid_nh4_nit_reac) = reaction_rates(lid_nh4_nit_reac)*alpha + + tot_nh4_to_decomp_plant_flx = smin_nh4/dtime+gross_min_nh4_flx+reaction_rates(lid_nh4_nit_reac)* cascade_matrix(lid_nh4 ,lid_nh4_nit_reac) + + endif + else + tot_nh4_to_decomp_plant_flx = decomp_plant_minn_demand_flx + endif + tot_nh4_to_decomp_plant_flx = max(tot_nh4_to_decomp_plant_flx-1.e-21_r8,0._r8) + + decomp_plant_residual_minn_demand_flx = decomp_plant_minn_demand_flx - tot_nh4_to_decomp_plant_flx + + reac = lid_no3_den_reac + tot_no3_demand_flx = decomp_plant_residual_minn_demand_flx - reaction_rates(reac) * cascade_matrix(lid_no3 ,reac) + + !then no3 is competed between denitrification and residual request from decomposer immobilization and plant demand + if(tot_no3_demand_flx * dtime>smin_no3)then + + if(CNAllocate_Carbon_only())then + !denitrifiers is given what is available + if(abs(reaction_rates(reac))<1.e-40_r8)then + alpha = 0._r8 + else + alpha = -smin_no3/(dtime*reaction_rates(lid_no3_den_reac)*cascade_matrix(lid_no3,reac)) + endif + reaction_rates(lid_no3_den_reac ) = reaction_rates(lid_no3_den_reac )*min(alpha,1._r8) + smin_no3_to_decomp_plant_flx = smin_no3/dtime + reaction_rates(lid_no3_den_reac ) * cascade_matrix(lid_no3,lid_no3_den_reac) + else + !denitrifiers, decomposers and plants are no3 limited + alpha = smin_no3/(tot_no3_demand_flx*dtime) + + reaction_rates(lid_no3_den_reac ) = reaction_rates(lid_no3_den_reac )*alpha + + smin_no3_to_decomp_plant_flx = smin_no3/dtime * (decomp_plant_residual_minn_demand_flx/tot_no3_demand_flx) + endif + else + + smin_no3_to_decomp_plant_flx = decomp_plant_residual_minn_demand_flx + endif + + tot_sminn_to_decomp_plant_flx = tot_nh4_to_decomp_plant_flx + smin_no3_to_decomp_plant_flx + if(CNAllocate_Carbon_only())then + supp_nh4_to_decomp_plant_flx = decomp_plant_minn_demand_flx - tot_sminn_to_decomp_plant_flx + tot_sminn_to_decomp_plant_flx = decomp_plant_minn_demand_flx + else + supp_nh4_to_decomp_plant_flx = 0._r8 + endif + + if(tot_sminn_to_decomp_plant_flx < decomp_plant_minn_demand_flx)then + !plant & decomp are nitrogen limited + alpha = tot_sminn_to_decomp_plant_flx/decomp_plant_minn_demand_flx + else + alpha = 1._r8 + endif + + + if(supp_nh4_to_decomp_plant_flx>0._r8)then + frac_supp_nh4_to_decomp_plant=supp_nh4_to_decomp_plant_flx/tot_sminn_to_decomp_plant_flx + else + frac_supp_nh4_to_decomp_plant = 0._r8 + endif + if(smin_no3_to_decomp_plant_flx>0._r8)then + frac_no3_to_decomp_plant = smin_no3_to_decomp_plant_flx/tot_sminn_to_decomp_plant_flx + else + frac_no3_to_decomp_plant = 0._r8 + endif + frac_nh4_to_decomp_plant = 1._r8 - frac_supp_nh4_to_decomp_plant - frac_no3_to_decomp_plant + !revise the stoichiometry matix elements + !for decomposers + + do reac = 1, nom_pools + if(nitrogen_limit_flag(reac))then + reaction_rates(reac) = reaction_rates(reac) * alpha + cascade_matrix(lid_no3, reac) = cascade_matrix(lid_nh4, reac) * frac_no3_to_decomp_plant + if(lid_nh4_supp>0)then + cascade_matrix(lid_nh4_supp, reac) = cascade_matrix(lid_nh4, reac) * frac_supp_nh4_to_decomp_plant + cascade_matrix(lid_nh4,reac) = cascade_matrix(lid_nh4, reac) - cascade_matrix(lid_no3, reac) - cascade_matrix(lid_nh4_supp, reac) + cascade_matrix(lid_minn_nh4_immob, reac) = -cascade_matrix(lid_nh4, reac)-cascade_matrix(lid_nh4_supp, reac) + else + cascade_matrix(lid_nh4,reac) = cascade_matrix(lid_nh4, reac) - cascade_matrix(lid_no3, reac) + cascade_matrix(lid_minn_nh4_immob, reac) = -cascade_matrix(lid_nh4, reac) + endif + cascade_matrix(lid_minn_no3_immob, reac) = -cascade_matrix(lid_no3, reac) + endif + enddo + + !for plant + reac = lid_plant_minn_up_reac + reaction_rates(reac) = reaction_rates(reac) * alpha + + cascade_matrix(lid_no3, reac) = -frac_no3_to_decomp_plant + if(lid_nh4_supp>0)then + cascade_matrix(lid_nh4_supp, reac) = -frac_supp_nh4_to_decomp_plant + cascade_matrix(lid_nh4, reac) = -1._r8-cascade_matrix(lid_nh4_supp, reac)-cascade_matrix(lid_no3, reac) + cascade_matrix(lid_minn_nh4_plant, reac) = -cascade_matrix(lid_nh4, reac)-cascade_matrix(lid_nh4_supp, reac) + else + cascade_matrix(lid_nh4, reac) = -1._r8-cascade_matrix(lid_no3, reac) + cascade_matrix(lid_minn_nh4_plant, reac) = -cascade_matrix(lid_nh4, reac) + endif + cascade_matrix(lid_minn_no3_plant, reac) = -cascade_matrix(lid_no3, reac) + + + end associate + end subroutine apply_nutrient_down_regulation +end module BGCReactionsCenturyCLM3Type diff --git a/components/clm/src/betr/bgc_century/BGCReactionsCenturyCLMOType.F90 b/components/clm/src/betr/bgc_century/BGCReactionsCenturyCLMOType.F90 new file mode 100644 index 000000000000..7af70278d0cb --- /dev/null +++ b/components/clm/src/betr/bgc_century/BGCReactionsCenturyCLMOType.F90 @@ -0,0 +1,1274 @@ +module BGCReactionsCenturyCLMOType + +#include "shr_assert.h" + + ! + ! !DESCRIPTION: + ! + ! do nitrogen downregulation using the ad hoc approach documented in Tang and Riley, BG, 2015. + ! The difference between BGCReactionsCenturyCLMOType and BGCReactionsCenturyCLM3Type is that the former + ! does nitrogen limitation before oxygen limitation, whereas the latter does the opposite. + ! HISTORY: + ! Created by Jinyun Tang, Oct 2nd, 2014 + ! + ! !USES: + ! + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varctl , only : iulog + use abortutils , only : endrun + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_time_manager , only : get_nstep + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use decompMod , only : bounds_type + use BGCReactionsMod , only : bgc_reaction_type + use clm_varcon , only : spval + use clm_varctl , only : spinup_state + use tracer_varcon , only : bndcond_as_conc, bndcond_as_flux + use BGCCenturySubMod + use BGCCenturySubCoreMod + use LandunitType , only : lun + use ColumnType , only : col + use GridcellType , only : grc + use landunit_varcon , only : istsoil, istcrop + implicit none + + save + private + logical :: ldebug + ! + ! !PUBLIC TYPES: + public :: bgc_reaction_CENTURY_CLMO_type + type(centurybgc_type), private :: centurybgc_vars + + !integer, private :: lpr + type, extends(bgc_reaction_type) :: & + bgc_reaction_CENTURY_CLMO_type + private +contains + procedure :: Init_betrbgc ! initialize betr bgc + procedure :: set_boundary_conditions ! set top/bottom boundary conditions for various tracers + procedure :: calc_bgc_reaction ! doing bgc calculation + procedure :: init_boundary_condition_type ! initialize type of top boundary conditions + procedure :: do_tracer_equilibration ! do equilibrium tracer chemistry + procedure :: initCold + procedure :: readParams + procedure :: init_betr_alm_bgc_coupler ! update state vars using other bgc parts in alm + procedure :: betr_alm_flux_statevar_feedback +end type bgc_reaction_CENTURY_CLMO_type + + +type, private :: Extra_type + real(r8), pointer :: cn_ratios(:) !cn ratio of om pool + real(r8), pointer :: cp_ratios(:) !cp ratio of om pool + real(r8), pointer :: k_decay(:) !decay parameter for all reactions + real(r8), pointer :: scal_f(:) !scaling factor for first order sink + real(r8), pointer :: conv_f(:) !converting factor for first order sink + real(r8), pointer :: conc_f(:) !external forcing strength + real(r8) :: n2_n2o_ratio_denit !ratio of n2 to n2o during denitrification + real(r8) :: cellsand !sand content + logical, pointer :: is_zero_order(:) + integer :: nr !number of reactions involved +contains + procedure, public :: Init_Allocate + procedure, public :: DDeallocate + procedure, public :: AAssign +end type Extra_type +type(Extra_type), private :: Extra_inst + + +interface bgc_reaction_CENTURY_CLMO_type + module procedure constructor + +end interface bgc_reaction_CENTURY_CLMO_type + + +contains + + subroutine Init_Allocate(this, nompools, nreacts, nprimstvars) + ! + ! !DESCRIPTION: + ! memory allocation for data type specified by this + ! + ! !ARGUMENTS: + class(Extra_type) :: this + integer, intent(in) :: nompools + integer, intent(in) :: nreacts + integer, intent(in) :: nprimstvars !number of primary state variables + + allocate(this%cn_ratios(nompools)) + allocate(this%cp_ratios(nompools)) + allocate(this%k_decay(nreacts)) + allocate(this%scal_f(nprimstvars)); this%scal_f(:) = 0._r8 + allocate(this%conv_f(nprimstvars)); this%conv_f(:) = 0._r8 + allocate(this%conc_f(nprimstvars)); this%conc_f(:) = 0._r8 + allocate(this%is_zero_order(nreacts)); this%is_zero_order(:) = .false. + this%nr = nreacts + + end subroutine Init_Allocate + + !------------------------------------------------------------------------------- + + subroutine DDeallocate(this) + ! + ! !DESCRIPTION: + ! Deallocate memories + + ! !ARGUMENTS: + class(Extra_type) :: this + + + deallocate(this%cn_ratios) + deallocate(this%cp_ratios) + deallocate(this%k_decay) + deallocate(this%scal_f) + deallocate(this%conv_f) + deallocate(this%conc_f) + + end subroutine DDeallocate + !------------------------------------------------------------------------------- + + subroutine AAssign(this, cn_r,cp_r, k_d, n2_n2o_r_denit, cell_sand, betrtracer_vars, gas2bulkcef, aere_cond, tracer_conc_atm) + ! + ! !DESCRIPTION: + ! assign values to members of the data type specified by this + ! + ! !USES: + use BeTRTracerType , only : betrtracer_type + + ! !ARGUMENTS: + class(Extra_type) :: this + real(r8), dimension(:), intent(in) :: cn_r + real(r8), dimension(:), intent(in) :: cp_r + real(r8), dimension(:), intent(in) :: k_d + real(r8) , intent(in) :: n2_n2o_r_denit + real(r8) , intent(in) :: cell_sand + type(BeTRtracer_type ), intent(in) :: betrtracer_vars + real(r8) , intent(in) :: gas2bulkcef(1:betrtracer_vars%nvolatile_tracers) + real(r8) , intent(in) :: aere_cond(1:betrtracer_vars%nvolatile_tracers) + real(r8) , intent(in) :: tracer_conc_atm(1:betrtracer_vars%nvolatile_tracers) + ! + ! !LOCAL VARIABLES: + integer :: n1, n2, n3, j + + n1 = size(cn_r) + n2 = size(cp_r) + n3 = size(k_d) + SHR_ASSERT_ALL((n1 == n2), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((n3 == this%nr), errMsg(__FILE__,__LINE__)) + this%cn_ratios(1:n1) = cn_r + this%cp_ratios(1:n2) = cp_r + + this%n2_n2o_ratio_denit = n2_n2o_r_denit + this%cellsand = cell_sand + this%k_decay = k_d + + + do j = 1, betrtracer_vars%ngwmobile_tracers + if(j == betrtracer_vars%id_trc_o2)then + this%scal_f(centurybgc_vars%lid_o2) = aere_cond(betrtracer_vars%volatileid(j)) + this%conc_f(centurybgc_vars%lid_o2) = tracer_conc_atm(betrtracer_vars%volatileid(j)) + this%conv_f(centurybgc_vars%lid_o2) = 1._r8/gas2bulkcef(betrtracer_vars%volatileid(j)) + + elseif(j == betrtracer_vars%id_trc_n2)then + this%scal_f(centurybgc_vars%lid_n2) = aere_cond(betrtracer_vars%volatileid(j)) + this%conc_f(centurybgc_vars%lid_n2) = tracer_conc_atm(betrtracer_vars%volatileid(j)) + this%conv_f(centurybgc_vars%lid_n2) = 1._r8/gas2bulkcef(betrtracer_vars%volatileid(j)) + + elseif(j == betrtracer_vars%id_trc_ar)then + this%scal_f(centurybgc_vars%lid_ar) = aere_cond(betrtracer_vars%volatileid(j)) + this%conc_f(centurybgc_vars%lid_ar) = tracer_conc_atm(betrtracer_vars%volatileid(j)) + this%conv_f(centurybgc_vars%lid_ar) = 1._r8/gas2bulkcef(betrtracer_vars%volatileid(j)) + + elseif(j==betrtracer_vars%id_trc_co2x)then + this%scal_f(centurybgc_vars%lid_co2) = aere_cond(betrtracer_vars%volatileid(j)) + this%conc_f(centurybgc_vars%lid_co2) = tracer_conc_atm(betrtracer_vars%volatileid(j)) + this%conv_f(centurybgc_vars%lid_co2) = 1._r8/gas2bulkcef(betrtracer_vars%volatileid(j)) + + elseif(j==betrtracer_vars%id_trc_ch4) then + this%scal_f(centurybgc_vars%lid_ch4) = aere_cond(betrtracer_vars%volatileid(j)) + this%conc_f(centurybgc_vars%lid_ch4) = tracer_conc_atm(betrtracer_vars%volatileid(j)) + this%conv_f(centurybgc_vars%lid_ch4) = 1._r8/gas2bulkcef(betrtracer_vars%volatileid(j)) + + elseif(j==betrtracer_vars%id_trc_n2o) then + this%scal_f(centurybgc_vars%lid_n2o) = aere_cond(betrtracer_vars%volatileid(j)) + this%conc_f(centurybgc_vars%lid_n2o) = tracer_conc_atm(betrtracer_vars%volatileid(j)) + this%conv_f(centurybgc_vars%lid_n2o) = 1._r8/gas2bulkcef(betrtracer_vars%volatileid(j)) + endif + enddo + end subroutine AAssign + + !------------------------------------------------------------------------------- + type(bgc_reaction_CENTURY_CLMO_type) function constructor() + ! + ! !DESCRIPTION: + ! + ! create an object of type bgc_reaction_CENTURY_CLMO_type. + ! Right now it is purposely empty + + end function constructor + + + !------------------------------------------------------------------------------- + subroutine init_boundary_condition_type(this, bounds, betrtracer_vars, tracerboundarycond_vars ) + ! + ! !DESCRIPTION: + ! initialize boundary condition types + ! !USES: + use TracerBoundaryCondType , only : tracerboundarycond_type + use BeTRTracerType , only : betrtracer_type + + ! !ARGUMENTS: + class(bgc_reaction_CENTURY_CLMO_type), intent(in) :: this + type(bounds_type) , intent(in) :: bounds + type(BeTRtracer_type ) , intent(in) :: betrtracer_vars + type(tracerboundarycond_type) , intent(in) :: tracerboundarycond_vars + + + ! !LOCAL VARIABLES: + integer :: c + + associate( & + groupid => betrtracer_vars%groupid & + ) + tracerboundarycond_vars%topbc_type(1:betrtracer_vars%ngwmobile_tracer_groups) = bndcond_as_conc + tracerboundarycond_vars%topbc_type(groupid(betrtracer_vars%id_trc_no3x)) = bndcond_as_flux + + tracerboundarycond_vars%topbc_type(betrtracer_vars%ngwmobile_tracer_groups+1:betrtracer_vars%ntracer_groups) = bndcond_as_flux + + end associate + end subroutine init_boundary_condition_type + + !------------------------------------------------------------------------------- + + subroutine Init_betrbgc(this, bounds, lbj, ubj, betrtracer_vars) + ! + ! !DESCRIPTION: + ! initialize the betrbgc + ! !USES: + use CNSharedParamsMod , only : CNParamsReadShared + use ncdio_pio , only : file_desc_t + use BeTRTracerType , only : betrtracer_type + use MathfuncMod , only : addone + use clm_varctl , only : cnallocate_carbon_only_set + + ! !ARGUMENTS: + class(bgc_reaction_CENTURY_CLMO_type), intent(in) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: lbj, ubj ! lower and upper bounds, make sure they are > 0 + type(BeTRtracer_type ) , intent(inout) :: betrtracer_vars + + ! !LOCAL VARIABLES: + character(len=32) , parameter :: subname ='Init_betrbgc' + integer :: jj + integer :: nelm, itemp_mem + integer :: itemp, itemp_vgrp, itemp_v, itemp_grp + integer :: c_loc, n_loc, trcid + logical :: carbon_only = .false. + + call cnallocate_carbon_only_set(carbon_only) + call centurybgc_vars%Init(bounds, lbj, ubj) + + nelm =centurybgc_vars%nelms + c_loc=centurybgc_vars%c_loc + n_loc=centurybgc_vars%n_loc + + itemp = 0 + betrtracer_vars%id_trc_n2 = addone(itemp) + betrtracer_vars%id_trc_o2 = addone(itemp) + betrtracer_vars%id_trc_ar = addone(itemp) + betrtracer_vars%id_trc_co2x = addone(itemp) + betrtracer_vars%id_trc_ch4 = addone(itemp) + betrtracer_vars%id_trc_nh3x = addone(itemp) + betrtracer_vars%id_trc_no3x = addone(itemp) + betrtracer_vars%id_trc_n2o = addone(itemp) + + betrtracer_vars%ngwmobile_tracer_groups=itemp ! n2, o2, ar, co2, ch4, n2o, nh3x and no3x + betrtracer_vars%ngwmobile_tracers = itemp + betrtracer_vars%nvolatile_tracers=itemp-2 ! n2, o2, ar, co2, ch4 and n2o + betrtracer_vars%nvolatile_tracer_groups = itemp-2 ! + betrtracer_vars%nsolid_passive_tracer_groups = 4 ! som1, som2, som3 and others (lit1, lit2, lit3, cwd) + betrtracer_vars%nsolid_passive_tracers=centurybgc_vars%nom_pools*nelm ! + + betrtracer_vars%nmem_max = nelm*4 ! total number of elemnts, and 4 sub members (lit1, lit2, lit3, cwd) + + call betrtracer_vars%Init() + + betrtracer_vars%is_mobile(:) = .true. + + jj = itemp + itemp_vgrp = 0 !counter for volatile groups + itemp_v = 0 !counter for volatile tracers + itemp_grp = 0 !counter for tracer groups + + trcid = betrtracer_vars%id_trc_n2 + + + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_n2, trc_name='N2' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_o2, trc_name='O2' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_ar, trc_name='AR' , & + is_trc_mobile=.false., is_trc_advective = .false., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_co2x, trc_name='CO2x', & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = addone(itemp_grp) , & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_ch4, trc_name='CH4' , & + is_trc_mobile=.false., is_trc_advective = .false., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_nh3x, trc_name='NH3x', & + is_trc_mobile=.false., is_trc_advective = .false., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.false.) + + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_no3x, trc_name='NO3x', & + is_trc_mobile=.true., is_trc_advective = .true., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.false.,trc_vtrans_scal=1._r8) + + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_n2o, trc_name='N2O' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + + + !------------------------------------------------------------------------------------ + itemp_mem=0 + itemp_grp=addone(itemp_grp) !only one group passive solid litter tracers + trcid = jj+(centurybgc_vars%lit1-1)*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='LIT1C' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%lit1-1)*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='LIT1N' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + !------------------------------------------------------------------------------------ + + trcid = jj+(centurybgc_vars%lit2-1)*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='LIT2C' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%lit2-1)*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='LIT2N' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + !------------------------------------------------------------------------------------ + + trcid = jj+(centurybgc_vars%lit3-1)*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='LIT3C' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%lit3-1)*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='LIT3N' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + !------------------------------------------------------------------------------------ + + trcid = jj+(centurybgc_vars%cwd-1 )*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='CWDC' , & + is_trc_mobile=.false., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%cwd-1 )*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='CWDN' , & + is_trc_mobile=.false., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + !========================================================================================== + !new group + itemp_mem = 0 + itemp_grp = addone(itemp_grp) + trcid = jj+(centurybgc_vars%som1-1)*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='SOM1C' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp , & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%som1-1)*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='SOM1N' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + !------------------------------------------------------------------------------------ + !new group + itemp_mem=0 + itemp_grp = addone(itemp_grp) + trcid = jj+(centurybgc_vars%som2-1)*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='SOM2C' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp , & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%som2-1)*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='SOM2N' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + !------------------------------------------------------------------------------------ + !new group + itemp_mem=0 + itemp_grp = addone(itemp_grp) + trcid = jj+(centurybgc_vars%som3-1)*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='SOM3C' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%som3-1)*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='SOM3N' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + end subroutine Init_betrbgc + + !------------------------------------------------------------------------------- + subroutine set_boundary_conditions(this, bounds, num_soilc, filter_soilc, dz_top, betrtracer_vars, & + waterflux_vars, tracerboundarycond_vars) + ! + ! DESCRIPTION: + ! set up boundary conditions for tracer movement + ! + ! !USES: + use TracerBoundaryCondType, only : tracerboundarycond_type + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + use BeTRTracerType , only : betrtracer_type + use WaterfluxType , only : waterflux_type + + ! !ARGUMENTS: + class(bgc_reaction_CENTURY_CLMO_type), intent(in) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of columns in column filter + integer , intent(in) :: filter_soilc(:) ! column filter + type(betrtracer_type) , intent(in) :: betrtracer_vars + real(r8) , intent(in) :: dz_top(bounds%begc: ) + type(waterflux_type) , intent(in) :: waterflux_vars + type(tracerboundarycond_type) , intent(inout) :: tracerboundarycond_vars + + + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'set_boundary_conditions' + integer :: fc, c + + SHR_ASSERT_ALL((ubound(dz_top) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + + associate( & + groupid => betrtracer_vars%groupid & + ) + do fc = 1, num_soilc + c = filter_soilc(fc) + + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%ngwmobile_tracers+1:betrtracer_vars%ntracers)=0._r8 !zero incoming flux + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_n2) =32.8_r8 !mol m-3, contant boundary condition + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_o2) =8.78_r8 !mol m-3, contant boundary condition + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_ar) =0.3924_r8 !mol m-3, contant boundary condition + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_co2x)=0.0168_r8 !mol m-3, contant boundary condition + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_ch4) =6.939e-5_r8 !mol m-3, contant boundary condition + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_n2o) =1.195e-5_r8 !mol m-3, contant boundary condition + + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_no3x) = 0._r8 + tracerboundarycond_vars%bot_concflux_col(c,1,:) = 0._r8 !zero flux boundary condition + !those will be updated with snow resistance and hydraulic wicking resistance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_n2)) = 2._r8*1.267e-5_r8/dz_top(c) !m/s surface conductance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_o2)) = 2._r8*1.267e-5_r8/dz_top(c) !m/s surface conductance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_ar)) = 2._r8*1.267e-5_r8/dz_top(c) !m/s surface conductance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_co2x)) = 2._r8*1.267e-5_r8/dz_top(c) !m/s surface conductance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_ch4)) = 2._r8*1.267e-5_r8/dz_top(c) !m/s surface conductance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_n2o)) = 2._r8*1.267e-5_r8/dz_top(c) !m/s surface conductance + enddo + end associate + end subroutine set_boundary_conditions + !------------------------------------------------------------------------------- + + subroutine calc_bgc_reaction(this, bounds, lbj, ubj, num_soilc, filter_soilc, num_soilp, filter_soilp, jtops, dtime, & + betrtracer_vars, tracercoeff_vars, waterstate_vars, temperature_vars, soilstate_vars, chemstate_vars, & + cnstate_vars, carbonstate_vars, carbonflux_vars, nitrogenstate_vars, nitrogenflux_vars, tracerstate_vars, & + tracerflux_vars, plantsoilnutrientflux_vars) + ! + ! !DESCRIPTION: + ! do bgc reaction + ! this returns net carbon fluxes from decay and translocation + ! and also update the related carbon/nitrogen/phosphorus(potentially) pools of OM + ! note it is assumed the stoichiometry of the om pools are not changed during decomposition + ! + ! !USES: + ! + use tracerfluxType , only : tracerflux_type + use tracerstatetype , only : tracerstate_type + use tracercoeffType , only : tracercoeff_type + use BetrTracerType , only : betrtracer_type + use WaterStateType , only : Waterstate_Type + use TemperatureType , only : temperature_type + use ChemStateType , only : chemstate_type + use SoilStatetype , only : soilstate_type + use ODEMod , only : ode_ebbks1,ldebug_ode + use CNStateType , only : cnstate_type + use PlantSoilnutrientFluxType, only : plantsoilnutrientflux_type + use CNVerticalProfileMod , only : decomp_vertprofiles + use CNCarbonStateType , only : carbonstate_type + use CNCarbonFluxType , only : carbonflux_type + use CNNitrogenFluxType , only : nitrogenflux_type + use CNNitrogenStateType , only : nitrogenstate_type + + ! !ARGUMENTS + class(bgc_reaction_CENTURY_CLMO_type) , intent(in) :: this + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_soilc ! number of columns in column filter + integer , intent(in) :: filter_soilc(:) ! column filter + integer , intent(in) :: num_soilp + integer , intent(in) :: filter_soilp(:) ! pft filter + integer , intent(in) :: jtops(bounds%begc: ) ! top index of each column + integer , intent(in) :: lbj, ubj ! lower and upper bounds, make sure they are > 0 + real(r8) , intent(in) :: dtime ! model time step + type(Waterstate_Type) , intent(in) :: waterstate_vars ! water state variables + type(temperature_type) , intent(in) :: temperature_vars ! energy state variable + type(soilstate_type) , intent(in) :: soilstate_vars + type(chemstate_type) , intent(in) :: chemstate_vars + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(tracercoeff_type) , intent(in) :: tracercoeff_vars + type(carbonstate_type) , intent(in) :: carbonstate_vars + type(cnstate_type) , intent(inout) :: cnstate_vars + type(carbonflux_type) , intent(inout) :: carbonflux_vars + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + type(tracerstate_type) , intent(inout) :: tracerstate_vars + type(tracerflux_type) , intent(inout) :: tracerflux_vars + type(plantsoilnutrientflux_type) , intent(inout) :: plantsoilnutrientflux_vars + + ! !LOCAL VARIABLES: + character(len=32), parameter :: subname ='calc_bgc_reaction' + integer :: fc, c, j, k + real(r8) :: time + real(r8) :: y0(centurybgc_vars%nstvars, bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: yf(centurybgc_vars%nstvars, bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: cn_ratios(centurybgc_vars%nom_pools, bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: cp_ratios(centurybgc_vars%nom_pools, bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: k_decay(centurybgc_vars%nreactions, bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: pot_decay_rates(centurybgc_vars%nom_pools, bounds%begc:bounds%endc, lbj:ubj) ![mol C/m3/s] potential decay rates for different om pools without nutrient limitation + real(r8) :: pot_co2_hr(bounds%begc:bounds%endc, lbj:ubj) ![mol C/m3/s], potential co2 respiration rate + real(r8) :: pot_nh3_immob(bounds%begc:bounds%endc,lbj:ubj) + real(r8) :: anaerobic_frac(bounds%begc:bounds%endc,lbj:ubj) + real(r8) :: n2_n2o_ratio_denit(bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: nh4_no3_ratio(bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: nuptake_prof(bounds%begc:bounds%endc,1:ubj) + real(r8) :: pscal + + SHR_ASSERT_ALL((ubound(jtops) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + + call Extra_inst%Init_Allocate(centurybgc_vars%nom_pools, centurybgc_vars%nreactions, centurybgc_vars%nprimvars) + + call set_reaction_order( centurybgc_vars%nreactions, centurybgc_vars, Extra_inst%is_zero_order) + + !initialize local variables + y0(:, :, :) = spval + yf(:, :, :) = spval + cn_ratios(:,:,:) = nan + cp_ratios(:,:,:) = nan + + !initialize the state vector + call init_state_vector(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, centurybgc_vars%nstvars, tracerstate_vars, betrtracer_vars, centurybgc_vars, y0) + + !update the initial vector from external input + !calculate elemental stoichiometry for different om pools and add mineral nutrient input from other than decaying process + + + call bgcstate_ext_update_bfdecomp(bounds, 1, ubj, num_soilc, filter_soilc, carbonflux_vars, nitrogenflux_vars, & + centurybgc_vars, betrtracer_vars, tracerflux_vars, y0, cn_ratios, cp_ratios) + + !calculate nitrogen uptake profile + call calc_nuptake_prof(bounds, ubj, num_soilc, filter_soilc, & + tracerstate_vars%tracer_conc_mobile_col(bounds%begc:bounds%endc, 1:ubj, betrtracer_vars%id_trc_nh3x), & + tracerstate_vars%tracer_conc_mobile_col(bounds%begc:bounds%endc, 1:ubj, betrtracer_vars%id_trc_no3x), & + col%dz(bounds%begc:bounds%endc,1:ubj), cnstate_vars%nfixation_prof_col(bounds%begc:bounds%endc,1:ubj), & + nuptake_prof(bounds%begc:bounds%endc,1:ubj)) + + !update plant nitrogen uptake potential + + call plantsoilnutrientflux_vars%calc_nutrient_uptake_potential(bounds, num_soilc, filter_soilc, num_soilp, & + filter_soilp, carbonstate_vars%frootc_patch) + + !calculate multiplicative scalars for decay parameters + call calc_decompK_multiply_scalar(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, & + waterstate_vars%finundated_col(bounds%begc:bounds%endc), col%z(bounds%begc:bounds%endc, lbj:ubj),& + temperature_vars%t_soisno_col(bounds%begc:bounds%endc, lbj:ubj), & + tracerstate_vars%tracer_conc_mobile_col(bounds%begc:bounds%endc, lbj:ubj, betrtracer_vars%id_trc_o2), & + tracercoeff_vars%aqu2bulkcef_mobile_col(bounds%begc:bounds%endc, lbj:ubj, betrtracer_vars%id_trc_o2), & + soilstate_vars, centurybgc_vars, carbonflux_vars) + + !calculate decay coefficients + call calc_som_deacyK(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, centurybgc_vars%nom_pools, tracercoeff_vars, tracerstate_vars, & + betrtracer_vars, centurybgc_vars, carbonflux_vars,dtime, k_decay(1:centurybgc_vars%nom_pools, bounds%begc:bounds%endc, lbj:ubj)) + + !calculate potential decay rates, without nutrient constraint + call calc_sompool_decay(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, centurybgc_vars, & + k_decay(1:centurybgc_vars%nom_pools, bounds%begc:bounds%endc, lbj:ubj), y0(1:centurybgc_vars%nom_totelms, bounds%begc:bounds%endc, lbj:ubj),& + pot_decay_rates) + + !calculate potential respiration rates by summarizing all om decomposition pathways + call calc_potential_aerobic_hr(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, cn_ratios, cp_ratios, centurybgc_vars, pot_decay_rates, & + soilstate_vars%cellsand_col(bounds%begc:bounds%endc,lbj:ubj), pot_co2_hr, pot_nh3_immob) + + !calculate fraction of anerobic environment + call calc_anaerobic_frac(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, temperature_vars%t_soisno_col(bounds%begc:bounds%endc,lbj:ubj),& + soilstate_vars, waterstate_vars%h2osoi_vol_col(bounds%begc:bounds%endc,lbj:ubj), pot_co2_hr, & + tracerstate_vars%tracer_conc_mobile_col(bounds%begc:bounds%endc, lbj:ubj, betrtracer_vars%id_trc_o2), & + anaerobic_frac(bounds%begc:bounds%endc, lbj:ubj)) + + !calculate normalized rate for nitrification and denitrification + call calc_nitrif_denitrif_rate(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, col%dz(bounds%begc:bounds%endc, lbj:ubj), & + temperature_vars%t_soisno_col(bounds%begc:bounds%endc, lbj:ubj), & + chemstate_vars%soil_pH(bounds%begc:bounds%endc, lbj:ubj), pot_co2_hr, anaerobic_frac, & + tracerstate_vars%tracer_conc_mobile_col(bounds%begc:bounds%endc, lbj:ubj, betrtracer_vars%id_trc_nh3x), & + tracerstate_vars%tracer_conc_mobile_col(bounds%begc:bounds%endc, lbj:ubj, betrtracer_vars%id_trc_no3x), & + soilstate_vars, waterstate_vars, carbonflux_vars, n2_n2o_ratio_denit, nh4_no3_ratio, & + k_decay(centurybgc_vars%lid_nh4_nit_reac, bounds%begc:bounds%endc, lbj:ubj), & + k_decay(centurybgc_vars%lid_no3_den_reac, bounds%begc:bounds%endc, lbj:ubj)) + + call calc_plant_nitrogen_uptake_prof(bounds, ubj, num_soilc, filter_soilc, col%dz(bounds%begc:bounds%endc, lbj:ubj), & + plantsoilnutrientflux_vars%plant_minn_uptake_potential_col(bounds%begc:bounds%endc), & + nuptake_prof(bounds%begc:bounds%endc,1:ubj), & + k_decay(centurybgc_vars%lid_plant_minn_up_reac, bounds%begc:bounds%endc ,1:ubj)) + + !apply root distribution here + call apply_plant_root_respiration_prof(bounds, ubj, num_soilc, filter_soilc, & + carbonflux_vars%rr_col(bounds%begc:bounds%endc), cnstate_vars%nfixation_prof_col(bounds%begc:bounds%endc,1:ubj), & + k_decay(centurybgc_vars%lid_at_rt_reac, bounds%begc:bounds%endc, 1:ubj)) + + !do ode integration and update state variables for each layer + !lpr = .true. + do j = lbj, ubj + do fc = 1, num_soilc + c = filter_soilc(fc) + if(j betrtracer_vars%volatileid & + ) + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if (lun%ifspecial(l)) then + if(betrtracer_vars%ngwmobile_tracers>0)then + tracerstate_vars%tracer_conc_mobile_col(c,:,:) = spval + tracerstate_vars%tracer_conc_surfwater_col(c,:) = spval + tracerstate_vars%tracer_conc_aquifer_col(c,:) = spval + tracerstate_vars%tracer_conc_grndwater_col(c,:) = spval + tracerstate_vars%tracer_conc_atm_col(c,:) = spval + endif + if(betrtracer_vars%ntracers > betrtracer_vars%ngwmobile_tracers)then + tracerstate_vars%tracer_conc_solid_passive_col(c,:,:) = spval + endif + if(betrtracer_vars%nsolid_equil_tracers>0)then + tracerstate_vars%tracer_conc_solid_equil_col(c, :, :) = spval + endif + endif + tracerstate_vars%tracer_soi_molarmass_col(c,:) = spval + + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + !dual phase tracers + + tracerstate_vars%tracer_conc_mobile_col(c,:, :) = 0._r8 + tracerstate_vars%tracer_conc_surfwater_col(c,:) = 0._r8 + tracerstate_vars%tracer_conc_aquifer_col(c,:) = 0._r8 + tracerstate_vars%tracer_conc_grndwater_col(c,:) = 0._r8 + tracerstate_vars%tracer_conc_atm_col(c,volatileid(betrtracer_vars%id_trc_n2)) = 32.8_r8 + tracerstate_vars%tracer_conc_atm_col(c,volatileid(betrtracer_vars%id_trc_o2)) = 8.78_r8 + tracerstate_vars%tracer_conc_atm_col(c,volatileid(betrtracer_vars%id_trc_ar)) = 0.3924_r8 + tracerstate_vars%tracer_conc_atm_col(c,volatileid(betrtracer_vars%id_trc_co2x))= 0.0168_r8 + tracerstate_vars%tracer_conc_atm_col(c,volatileid(betrtracer_vars%id_trc_ch4)) = 6.939e-5_r8 + tracerstate_vars%tracer_conc_atm_col(c,volatileid(betrtracer_vars%id_trc_n2o)) = 1.195e-5_r8 + + !solid tracers + if(betrtracer_vars%ngwmobile_tracers < betrtracer_vars%ntracers)then + tracerstate_vars%tracer_conc_solid_passive_col(c,:,:) = 0._r8 + endif + + if(betrtracer_vars%nsolid_equil_tracers>0)then + tracerstate_vars%tracer_conc_solid_equil_col(c, :, :) = 0._r8 + endif + tracerstate_vars%tracer_soi_molarmass_col(c,:) = 0._r8 + endif + enddo + end associate + end subroutine InitCold + + !-------------------------------------------------------------------------------------------------------------------- + subroutine betr_alm_flux_statevar_feedback(this, bounds, num_soilc, filter_soilc, & + carbonstate_vars, nitrogenstate_vars, nitrogenflux_vars, tracerstate_vars, tracerflux_vars, betrtracer_vars) + + ! + ! !DESCRIPTION: + ! do state and flux variable exchange between betr and alm + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use tracerfluxType , only : tracerflux_type + use tracerstatetype , only : tracerstate_type + use decompMod , only : bounds_type + use BeTRTracerType , only : BeTRTracer_Type + use CNCarbonStateType , only : carbonstate_type + use CNNitrogenStateType , only : nitrogenstate_type + use CNNitrogenFluxType , only : nitrogenflux_type + + + ! !ARGUMENTS: + class(bgc_reaction_CENTURY_CLMO_type) , intent(in) :: this + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_soilc ! number of columns in column filter + integer , intent(in) :: filter_soilc(:) ! column filter + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(tracerstate_type) , intent(in) :: tracerstate_vars + type(tracerflux_type) , intent(in) :: tracerflux_vars + type(carbonstate_type) , intent(inout) :: carbonstate_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars + + + + call assign_nitrogen_hydroloss(bounds, num_soilc, filter_soilc, tracerflux_vars, nitrogenflux_vars, betrtracer_vars) + + call assign_OM_CNpools(bounds, num_soilc, filter_soilc, carbonstate_vars, nitrogenstate_vars, tracerstate_vars, betrtracer_vars, centurybgc_vars) + + end subroutine betr_alm_flux_statevar_feedback + + !--------------------------------------------------------------- + subroutine init_betr_alm_bgc_coupler(this, bounds, carbonstate_vars, nitrogenstate_vars, betrtracer_vars, tracerstate_vars) + ! + ! !DESCRIPTION: + ! do state variable exchange between betr and alm + ! !USES: + use clm_varcon , only : natomw, catomw + use clm_varpar , only : i_cwd, i_met_lit, i_cel_lit, i_lig_lit + use CNCarbonStateType , only : carbonstate_type + use CNNitrogenStateType , only : nitrogenstate_type + use tracerstatetype , only : tracerstate_type + use BetrTracerType , only : betrtracer_type + use clm_varpar , only : nlevtrc_soil + use landunit_varcon , only : istsoil, istcrop + + ! !ARGUMENTS: + class(bgc_reaction_CENTURY_CLMO_type) , intent(in) :: this + type(bounds_type) , intent(in) :: bounds + type(tracerstate_type) , intent(inout) :: tracerstate_vars + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(carbonstate_type) , intent(in) :: carbonstate_vars + type(nitrogenstate_type) , intent(in) :: nitrogenstate_vars + + ! !LOCAL VARIABLES: + integer, parameter :: i_soil1 = 5 + integer, parameter :: i_soil2 = 6 + integer, parameter :: i_soil3 = 7 + character(len=255) :: subname = 'init_betr_alm_bgc_coupler' + integer :: c, j, k, l + + associate( & + id_trc_no3x => betrtracer_vars%id_trc_no3x , & + id_trc_nh3x => betrtracer_vars%id_trc_nh3x , & + decomp_cpools_vr => carbonstate_vars%decomp_cpools_vr_col , & + decomp_npools_vr => nitrogenstate_vars%decomp_npools_vr_col , & + smin_no3_vr_col => nitrogenstate_vars%smin_no3_vr_col , & + smin_nh4_vr_col => nitrogenstate_vars%smin_nh4_vr_col , & + tracer_conc_mobile => tracerstate_vars%tracer_conc_mobile_col , & + tracer_conc_solid_passive => tracerstate_vars%tracer_conc_solid_passive_col , & + c_loc => centurybgc_vars%c_loc , & + n_loc => centurybgc_vars%n_loc , & + lit1 => centurybgc_vars%lit1 , & + lit2 => centurybgc_vars%lit2 , & + lit3 => centurybgc_vars%lit3 , & + som1 => centurybgc_vars%som1 , & + som2 => centurybgc_vars%som2 , & + som3 => centurybgc_vars%som3 , & + cwd => centurybgc_vars%cwd , & + nelms => centurybgc_vars%nelms & + ) + !initialize tracer based on carbon/nitrogen pools + do j = 1, nlevtrc_soil + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + tracer_conc_mobile(c,j,id_trc_no3x)=smin_no3_vr_col(c,j) /natomw + tracer_conc_mobile(c,j,id_trc_nh3x)=smin_nh4_vr_col(c,j) /natomw + k = lit1; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_met_lit) / catomw + k = lit2; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_cel_lit) / catomw + k = lit3; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_lig_lit) / catomw + k = cwd ; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_cwd ) / catomw + k = som1; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_soil1 ) / catomw + k = som2; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_soil2 ) / catomw + k = som3; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_soil3 ) / catomw + + k = lit1; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_met_lit) / natomw + k = lit2; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_cel_lit) / natomw + k = lit3; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_lig_lit) / natomw + k = cwd ; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_cwd ) / natomw + k = som1; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_soil1 ) / natomw + k = som2; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_soil2 ) / natomw + k = som3; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_soil3 ) / natomw + endif + enddo + enddo + end associate + end subroutine init_betr_alm_bgc_coupler + + !------------------------------------------------------------------------------- + + + subroutine one_box_century_bgc(ystate, dtime, time, nprimvars, nstvars, dydt) + ! + ! !DESCRIPTION: + ! do a single box bgc + ! + ! the equations to be solved are in the form + ! + ! dx/dt=I+A*R, where I is the input, A is the stoichiometric matrix, and R is the reaction vector + ! the input only contains litter input and mineral nutrient, som is assumed to be of fixed stoichiometry + ! !USES: + use SOMStateVarUpdateMod , only : calc_dtrend_som_bgc + use BGCCenturySubMod , only : calc_cascade_matrix + implicit none + integer, intent(in) :: nstvars + integer, intent(in) :: nprimvars + real(r8), intent(in) :: dtime + real(r8), intent(in) :: time + real(r8), intent(in) :: ystate(nstvars) + real(r8), intent(out) :: dydt(nstvars) + + ! !LOCAL VARIABLES: + integer :: lk, jj + real(r8) :: cascade_matrix(nstvars, Extra_inst%nr) + logical :: nitrogen_limit_flag(centurybgc_vars%nom_pools) + real(r8) :: reaction_rates(Extra_inst%nr) + real(r8) :: o2_consump, o2_limit + + !calculate cascade matrix, which contains the stoichiometry for all reactions + call calc_cascade_matrix(nstvars, Extra_inst%nr, Extra_inst%cn_ratios, Extra_inst%cp_ratios, & + Extra_inst%n2_n2o_ratio_denit, Extra_inst%cellsand, centurybgc_vars, nitrogen_limit_flag, cascade_matrix) + + + !do pool degradation + do lk = 1, Extra_inst%nr + if(Extra_inst%is_zero_order(lk))then + + if ( spinup_state .eq. 1 ) then + !spinup stage + if(lk == centurybgc_vars%lid_o2_aere_reac)then + jj = centurybgc_vars%lid_o2 + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + !I add the following line to disconnect the nitrogen and oxygen interaction + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + else + reaction_rates(lk) = Extra_inst%k_decay(lk) !this effective defines the plant nitrogen demand + endif + else + ! normal run stage + if(lk == centurybgc_vars%lid_o2_aere_reac)then + jj = centurybgc_vars%lid_o2 + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + elseif(lk == centurybgc_vars%lid_ch4_aere_reac)then + jj = centurybgc_vars%lid_ch4 + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + + elseif(lk == centurybgc_vars%lid_ar_aere_reac)then + jj = centurybgc_vars%lid_ar + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + + elseif(lk == centurybgc_vars%lid_n2_aere_reac)then + jj = centurybgc_vars%lid_n2 + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + + elseif(lk == centurybgc_vars%lid_co2_aere_reac)then + jj = centurybgc_vars%lid_co2 + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + + elseif(lk == centurybgc_vars%lid_n2o_aere_reac)then + jj = centurybgc_vars%lid_n2o + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + + else + reaction_rates(lk) = Extra_inst%k_decay(lk) !this effective defines the plant nitrogen demand + endif + endif + + else + + reaction_rates(lk)=ystate(centurybgc_vars%primvarid(lk))*Extra_inst%k_decay(lk) + endif + enddo + + call apply_nutrient_down_regulation(nstvars, Extra_inst%nr, nitrogen_limit_flag, ystate(centurybgc_vars%lid_nh4), ystate(centurybgc_vars%lid_no3), & + dtime, cascade_matrix, reaction_rates) + + !obtain total oxygen consumption rate + o2_consump = DOT_PRODUCT(cascade_matrix(centurybgc_vars%lid_o2,1:Extra_inst%nr),reaction_rates(1:Extra_inst%nr)) + if(-o2_consump*dtime > ystate(centurybgc_vars%lid_o2))then + o2_limit=-ystate(centurybgc_vars%lid_o2)/(o2_consump*dtime) + do lk = 1, Extra_inst%nr + if(centurybgc_vars%is_aerobic_reac(lk))then + reaction_rates(lk) = reaction_rates(lk)*o2_limit + endif + enddo + endif + !reset cascade matrix + call calc_cascade_matrix(nstvars, Extra_inst%nr, Extra_inst%cn_ratios, Extra_inst%cp_ratios, & + Extra_inst%n2_n2o_ratio_denit, Extra_inst%cellsand, centurybgc_vars, nitrogen_limit_flag, cascade_matrix) + + call apply_nutrient_down_regulation(nstvars, Extra_inst%nr, nitrogen_limit_flag, ystate(centurybgc_vars%lid_nh4), ystate(centurybgc_vars%lid_no3), & + dtime, cascade_matrix, reaction_rates) + + call calc_dtrend_som_bgc(nstvars, Extra_inst%nr, cascade_matrix(1:nstvars, 1:Extra_inst%nr), reaction_rates(1:Extra_inst%nr), dydt) + + + end subroutine one_box_century_bgc + !------------------------------------------------------------------------------- + + + subroutine apply_nutrient_down_regulation(nstvars, nreactions, nitrogen_limit_flag, smin_nh4, smin_no3, dtime, cascade_matrix, reaction_rates) + + ! !DESCRIPTION: + ! + ! this down-regulation considers nitrogen made available from gross mineralization + ! this implements is corresponding to the CLM-3 approach as described in Tang and Riley (2015), BG, tehcnique note. + ! + ! !USES: + use clm_varctl, only : CNAllocate_Carbon_only + use MathfuncMod, only : safe_div + + ! !ARGUMENTS: + integer , intent(in) :: nstvars + integer , intent(in) :: nreactions + logical , intent(in) :: nitrogen_limit_flag(centurybgc_vars%nom_pools) + real(r8), intent(in) :: smin_nh4 + real(r8), intent(in) :: smin_no3 + real(r8), intent(in) :: dtime + real(r8), intent(inout) :: cascade_matrix(nstvars, nreactions) + real(r8), intent(inout) :: reaction_rates(nreactions) + ! !LOCAL VARIABLES: + real(r8) :: decomp_plant_minn_demand_flx + real(r8) :: tot_nh4_demand_flx + real(r8) :: tot_no3_demand_flx + real(r8) :: decomp_plant_residual_minn_demand_flx + real(r8) :: smin_nh4_to_decomp_plant_flx + real(r8) :: smin_no3_to_decomp_plant_flx + real(r8) :: tot_sminn_to_decomp_plant_flx + real(r8) :: frac_nh4_to_decomp_plant + real(r8) :: supp_nh4_to_decomp_plant_flx + real(r8) :: frac_supp_nh4_to_decomp_plant + real(r8) :: gross_nh4_to_decomp_plant_flx + real(r8) :: frac_gross_nh4_to_decomp_plant + real(r8) :: gross_min_nh4_flx + real(r8) :: frac_no3_to_decomp_plant + real(r8) :: dnegt + real(r8) :: tot_nh4_to_decomp_plant_flx + real(r8) :: alpha + real(r8) :: frac_gross_immob=1.0_r8 + integer :: reac + + associate( & ! + nom_pools => centurybgc_vars%nom_pools , & ! + lid_nh4 => centurybgc_vars%lid_nh4 , & ! + lid_no3 => centurybgc_vars%lid_no3 , & ! + lid_plant_minn => centurybgc_vars%lid_plant_minn , & ! + lid_minn_nh4_immob => centurybgc_vars%lid_minn_nh4_immob , & ! + lid_minn_no3_immob => centurybgc_vars%lid_minn_no3_immob , & ! + lid_minn_nh4_plant => centurybgc_vars%lid_minn_nh4_plant , & ! + lid_minn_no3_plant => centurybgc_vars%lid_minn_no3_plant , & ! + lid_nh4_supp => centurybgc_vars%lid_nh4_supp , & ! + lid_nh4_nit => centurybgc_vars%lid_nh4_nit , & ! + lid_plant_minn_up_reac=> centurybgc_vars%lid_plant_minn_up_reac, & ! + lid_nh4_nit_reac => centurybgc_vars%lid_nh4_nit_reac , & ! + lid_no3_den_reac => centurybgc_vars%lid_no3_den_reac & ! + ) + + decomp_plant_minn_demand_flx = 0._r8 + gross_min_nh4_flx = 0._r8 + do reac = 1, nom_pools + if(nitrogen_limit_flag(reac))then + decomp_plant_minn_demand_flx = decomp_plant_minn_demand_flx - reaction_rates(reac) * cascade_matrix(lid_nh4, reac) + else + gross_min_nh4_flx = gross_min_nh4_flx + reaction_rates(reac) * cascade_matrix(lid_nh4, reac) + endif + enddo + + !add nitrogen demand from plant + reac = lid_plant_minn_up_reac + decomp_plant_minn_demand_flx = decomp_plant_minn_demand_flx - reaction_rates(reac) * cascade_matrix(lid_nh4, reac) + + !in clm-century, nh4 is first competed between decomposer immobilization, plant and nitrification + !total nh3 demand includes decomposer, plant and nitrifier + reac = lid_nh4_nit_reac + tot_nh4_demand_flx = decomp_plant_minn_demand_flx - reaction_rates(reac) * cascade_matrix(lid_nh4 ,reac) + + if(tot_nh4_demand_flx*dtime>(smin_nh4+gross_min_nh4_flx*dtime))then + !not enought nitrogen + if(CNAllocate_Carbon_only())then + + !nitrifier uses what it is provided + !plant use the remaining nh4 and request external supply from supp nh4 + if(reaction_rates(reac)<1.e-40_r8)then + alpha = 0._r8 + else + alpha = -(smin_nh4+gross_min_nh4_flx*dtime)/(reaction_rates(lid_nh4_nit_reac)*cascade_matrix(lid_nh4,lid_nh4_nit_reac)*dtime) + endif + reaction_rates(lid_nh4_nit_reac) = reaction_rates(lid_nh4_nit_reac) * min(alpha, 1._r8) + + tot_nh4_to_decomp_plant_flx = smin_nh4/dtime+gross_min_nh4_flx+reaction_rates(lid_nh4_nit_reac)* cascade_matrix(lid_nh4 ,lid_nh4_nit_reac) + + else + !nitrifiers, decomposers and plants are nh4 limited + alpha = (smin_nh4+gross_min_nh4_flx*dtime)/(tot_nh4_demand_flx*dtime) !the last term is used to avoid roundoff error + !downregulate nitrification + reaction_rates(lid_nh4_nit_reac) = reaction_rates(lid_nh4_nit_reac)*alpha + + tot_nh4_to_decomp_plant_flx = smin_nh4/dtime+gross_min_nh4_flx+reaction_rates(lid_nh4_nit_reac)* cascade_matrix(lid_nh4 ,lid_nh4_nit_reac) + + endif + else + + !part of nh4 is from smin_nh4, the remaining is from gross mineralization + + tot_nh4_to_decomp_plant_flx = decomp_plant_minn_demand_flx + endif + tot_nh4_to_decomp_plant_flx = max(tot_nh4_to_decomp_plant_flx-1.e-21_r8,0._r8) + + decomp_plant_residual_minn_demand_flx = decomp_plant_minn_demand_flx - tot_nh4_to_decomp_plant_flx + + reac = lid_no3_den_reac + tot_no3_demand_flx = decomp_plant_residual_minn_demand_flx - reaction_rates(reac) * cascade_matrix(lid_no3 ,reac) + + !then no3 is competed between denitrification and residual request from decomposer immobilization and plant demand + if(tot_no3_demand_flx * dtime>smin_no3)then + + if(CNAllocate_Carbon_only())then + !denitrifiers is given what is available + if(abs(reaction_rates(reac))<1.e-40_r8)then + alpha = 0._r8 + else + alpha = -smin_no3/(dtime*reaction_rates(lid_no3_den_reac)*cascade_matrix(lid_no3,reac)) + endif + reaction_rates(lid_no3_den_reac ) = reaction_rates(lid_no3_den_reac )*min(alpha,1._r8) + smin_no3_to_decomp_plant_flx = smin_no3/dtime + reaction_rates(lid_no3_den_reac ) * cascade_matrix(lid_no3,lid_no3_den_reac) + else + !denitrifiers, decomposers and plants are no3 limited + alpha = smin_no3/(tot_no3_demand_flx*dtime) + reaction_rates(lid_no3_den_reac ) = reaction_rates(lid_no3_den_reac )*alpha + + smin_no3_to_decomp_plant_flx = smin_no3/dtime * (decomp_plant_residual_minn_demand_flx/tot_no3_demand_flx) + endif + else + smin_no3_to_decomp_plant_flx = decomp_plant_residual_minn_demand_flx + endif + + tot_sminn_to_decomp_plant_flx = tot_nh4_to_decomp_plant_flx + smin_no3_to_decomp_plant_flx + if(CNAllocate_Carbon_only())then + supp_nh4_to_decomp_plant_flx = decomp_plant_minn_demand_flx - tot_sminn_to_decomp_plant_flx + tot_sminn_to_decomp_plant_flx = decomp_plant_minn_demand_flx + else + supp_nh4_to_decomp_plant_flx = 0._r8 + endif + + if(tot_sminn_to_decomp_plant_flx < decomp_plant_minn_demand_flx)then + !plant & decomp are nitrogen limited + alpha = tot_sminn_to_decomp_plant_flx/decomp_plant_minn_demand_flx + else + alpha = 1._r8 + endif + + + if(supp_nh4_to_decomp_plant_flx>0._r8)then + frac_supp_nh4_to_decomp_plant=supp_nh4_to_decomp_plant_flx/tot_sminn_to_decomp_plant_flx + else + frac_supp_nh4_to_decomp_plant = 0._r8 + endif + if(smin_no3_to_decomp_plant_flx>0._r8)then + frac_no3_to_decomp_plant = smin_no3_to_decomp_plant_flx/tot_sminn_to_decomp_plant_flx + else + frac_no3_to_decomp_plant = 0._r8 + endif + frac_nh4_to_decomp_plant = 1._r8 - frac_supp_nh4_to_decomp_plant - frac_no3_to_decomp_plant + + !revise the stoichiometry matix elements + !for decomposers + do reac = 1, nom_pools + if(nitrogen_limit_flag(reac))then + reaction_rates(reac) = reaction_rates(reac) * alpha + cascade_matrix(lid_no3, reac) = cascade_matrix(lid_nh4, reac) * frac_no3_to_decomp_plant + if(lid_nh4_supp>0)then + cascade_matrix(lid_nh4_supp, reac) = cascade_matrix(lid_nh4, reac) * frac_supp_nh4_to_decomp_plant + cascade_matrix(lid_nh4,reac) = cascade_matrix(lid_nh4, reac) - cascade_matrix(lid_no3, reac) - cascade_matrix(lid_nh4_supp, reac) + + cascade_matrix(lid_minn_nh4_immob, reac) = -cascade_matrix(lid_nh4, reac)-cascade_matrix(lid_nh4_supp, reac) + else + cascade_matrix(lid_nh4,reac) = cascade_matrix(lid_nh4, reac) - cascade_matrix(lid_no3, reac) + + cascade_matrix(lid_minn_nh4_immob, reac) = -cascade_matrix(lid_nh4, reac) + endif + cascade_matrix(lid_minn_no3_immob, reac) = -cascade_matrix(lid_no3, reac) + endif + enddo + !for plant + reac = lid_plant_minn_up_reac + reaction_rates(reac) = reaction_rates(reac) * alpha + + cascade_matrix(lid_no3, reac) = -frac_no3_to_decomp_plant + if(lid_nh4_supp>0)then + cascade_matrix(lid_nh4_supp, reac) = -frac_supp_nh4_to_decomp_plant + cascade_matrix(lid_nh4, reac) = -1._r8-cascade_matrix(lid_nh4_supp, reac)-cascade_matrix(lid_no3, reac) + cascade_matrix(lid_minn_nh4_plant, reac) = -cascade_matrix(lid_nh4, reac)-cascade_matrix(lid_nh4_supp, reac) + else + cascade_matrix(lid_nh4, reac) = -1._r8-cascade_matrix(lid_no3, reac) + cascade_matrix(lid_minn_nh4_plant, reac) = -cascade_matrix(lid_nh4, reac) + endif + cascade_matrix(lid_minn_no3_plant, reac) = -cascade_matrix(lid_no3, reac) + + end associate +end subroutine apply_nutrient_down_regulation +end module BGCReactionsCenturyCLMOType diff --git a/components/clm/src/betr/bgc_century/BGCReactionsCenturyCLMType.F90 b/components/clm/src/betr/bgc_century/BGCReactionsCenturyCLMType.F90 new file mode 100644 index 000000000000..3270808bd9d6 --- /dev/null +++ b/components/clm/src/betr/bgc_century/BGCReactionsCenturyCLMType.F90 @@ -0,0 +1,1257 @@ +module BGCReactionsCenturyCLMType + +#include "shr_assert.h" + +! +! !DESCRIPTION: +! this code uses the ad hoc down-regulation scheme +! described in Tang and Riley, 2015, BG. +! HISTORY: +! Created by Jinyun Tang, Oct 2nd, 2014 +! + +! !USES: +! + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varctl , only : iulog + use abortutils , only : endrun + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_time_manager , only : get_nstep + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use decompMod , only : bounds_type + use BGCReactionsMod , only : bgc_reaction_type + use clm_varcon , only : spval + use clm_varctl , only : spinup_state + use tracer_varcon , only : bndcond_as_conc, bndcond_as_flux + use BGCCenturySubCoreMod + use BGCCenturySubMod + use LandunitType , only : lun + use ColumnType , only : col + use GridcellType , only : grc + use landunit_varcon , only : istsoil, istcrop +implicit none + + save + private + ! + ! !PUBLIC TYPES: + public :: bgc_reaction_CENTURY_clm_type + type(centurybgc_type), private :: centurybgc_vars + logical :: ldebug + !integer, private :: lpr + type, extends(bgc_reaction_type) :: & + bgc_reaction_CENTURY_clm_type + private + contains + procedure :: Init_betrbgc ! initialize betr bgc + procedure :: set_boundary_conditions ! set top/bottom boundary conditions for various tracers + procedure :: calc_bgc_reaction ! doing bgc calculation + procedure :: init_boundary_condition_type ! initialize type of top boundary conditions + procedure :: do_tracer_equilibration ! do equilibrium tracer chemistry + procedure :: initCold + procedure :: readParams + procedure :: init_betr_alm_bgc_coupler ! update state vars using other bgc parts in alm + procedure :: betr_alm_flux_statevar_feedback + end type bgc_reaction_CENTURY_clm_type + + + type, private :: Extra_type + real(r8), pointer :: cn_ratios(:) !cn ratio of om pool + real(r8), pointer :: cp_ratios(:) !cp ratio of om pool + real(r8), pointer :: k_decay(:) !decay parameter for all reactions + real(r8), pointer :: scal_f(:) !scaling factor for first order sink + real(r8), pointer :: conv_f(:) !converting factor for first order sink + real(r8), pointer :: conc_f(:) !external forcing strength + real(r8) :: n2_n2o_ratio_denit !ratio of n2 to n2o during denitrification + real(r8) :: cellsand !sand content + logical, pointer :: is_zero_order(:) + integer :: nr !number of reactions involved + contains + procedure, public :: Init_Allocate + procedure, public :: DDeallocate + procedure, public :: AAssign + end type Extra_type + type(Extra_type), private :: Extra_inst + + + interface bgc_reaction_CENTURY_clm_type + module procedure constructor + + end interface bgc_reaction_CENTURY_clm_type + + +contains + + subroutine Init_Allocate(this, nompools, nreacts, nprimstvars) + ! + ! !DESCRIPTION: + ! memory allocation for data type specified by this + ! + ! !ARGUMENTS: + class(Extra_type) :: this + integer, intent(in) :: nompools + integer, intent(in) :: nreacts + integer, intent(in) :: nprimstvars !number of primary state variables + + allocate(this%cn_ratios(nompools)) + allocate(this%cp_ratios(nompools)) + allocate(this%k_decay(nreacts)) + allocate(this%scal_f(nprimstvars)); this%scal_f(:) = 0._r8 + allocate(this%conv_f(nprimstvars)); this%conv_f(:) = 0._r8 + allocate(this%conc_f(nprimstvars)); this%conc_f(:) = 0._r8 + allocate(this%is_zero_order(nreacts)); this%is_zero_order(:) = .false. + this%nr = nreacts + + end subroutine Init_Allocate + +!------------------------------------------------------------------------------- + + subroutine DDeallocate(this) + + ! + ! !DESCRPTION: + ! deallocate memory for data type specified by this + ! !ARGUMENTS: + class(Extra_type) :: this + + + deallocate(this%cn_ratios) + deallocate(this%cp_ratios) + deallocate(this%k_decay) + deallocate(this%scal_f) + deallocate(this%conv_f) + deallocate(this%conc_f) + + end subroutine DDeallocate +!------------------------------------------------------------------------------- + + subroutine AAssign(this, cn_r,cp_r, k_d, n2_n2o_r_denit, cell_sand, betrtracer_vars, gas2bulkcef, aere_cond, tracer_conc_atm) + ! + ! !DESCRIPTION: + ! assign member values for data type specified by this + ! !USES: + use BeTRTracerType , only : betrtracer_type + ! !ARGUMENTS: + class(Extra_type) :: this + real(r8), dimension(:), intent(in) :: cn_r + real(r8), dimension(:), intent(in) :: cp_r + real(r8), dimension(:), intent(in) :: k_d + real(r8) , intent(in) :: n2_n2o_r_denit + real(r8) , intent(in) :: cell_sand + type(BeTRtracer_type ), intent(in) :: betrtracer_vars + real(r8) , intent(in) :: gas2bulkcef(1:betrtracer_vars%nvolatile_tracers) + real(r8) , intent(in) :: aere_cond(1:betrtracer_vars%nvolatile_tracers) + real(r8) , intent(in) :: tracer_conc_atm(1:betrtracer_vars%nvolatile_tracers) + + ! !LOCAL VARIABLES: + integer :: n1, n2, n3, j + + n1 = size(cn_r) + n2 = size(cp_r) + n3 = size(k_d) + SHR_ASSERT_ALL((n1 == n2), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((n3 == this%nr), errMsg(__FILE__,__LINE__)) + this%cn_ratios(1:n1) = cn_r + this%cp_ratios(1:n2) = cp_r + + this%n2_n2o_ratio_denit = n2_n2o_r_denit + this%cellsand = cell_sand + this%k_decay = k_d + + + do j = 1, betrtracer_vars%ngwmobile_tracers + if(j == betrtracer_vars%id_trc_o2)then + this%scal_f(centurybgc_vars%lid_o2) = aere_cond(betrtracer_vars%volatileid(j)) + this%conc_f(centurybgc_vars%lid_o2) = tracer_conc_atm(betrtracer_vars%volatileid(j)) + this%conv_f(centurybgc_vars%lid_o2) = 1._r8/gas2bulkcef(betrtracer_vars%volatileid(j)) + + elseif(j == betrtracer_vars%id_trc_n2)then + this%scal_f(centurybgc_vars%lid_n2) = aere_cond(betrtracer_vars%volatileid(j)) + this%conc_f(centurybgc_vars%lid_n2) = tracer_conc_atm(betrtracer_vars%volatileid(j)) + this%conv_f(centurybgc_vars%lid_n2) = 1._r8/gas2bulkcef(betrtracer_vars%volatileid(j)) + + elseif(j == betrtracer_vars%id_trc_ar)then + this%scal_f(centurybgc_vars%lid_ar) = aere_cond(betrtracer_vars%volatileid(j)) + this%conc_f(centurybgc_vars%lid_ar) = tracer_conc_atm(betrtracer_vars%volatileid(j)) + this%conv_f(centurybgc_vars%lid_ar) = 1._r8/gas2bulkcef(betrtracer_vars%volatileid(j)) + + elseif(j==betrtracer_vars%id_trc_co2x)then + this%scal_f(centurybgc_vars%lid_co2) = aere_cond(betrtracer_vars%volatileid(j)) + this%conc_f(centurybgc_vars%lid_co2) = tracer_conc_atm(betrtracer_vars%volatileid(j)) + this%conv_f(centurybgc_vars%lid_co2) = 1._r8/gas2bulkcef(betrtracer_vars%volatileid(j)) + + elseif(j==betrtracer_vars%id_trc_ch4) then + this%scal_f(centurybgc_vars%lid_ch4) = aere_cond(betrtracer_vars%volatileid(j)) + this%conc_f(centurybgc_vars%lid_ch4) = tracer_conc_atm(betrtracer_vars%volatileid(j)) + this%conv_f(centurybgc_vars%lid_ch4) = 1._r8/gas2bulkcef(betrtracer_vars%volatileid(j)) + + elseif(j==betrtracer_vars%id_trc_n2o) then + this%scal_f(centurybgc_vars%lid_n2o) = aere_cond(betrtracer_vars%volatileid(j)) + this%conc_f(centurybgc_vars%lid_n2o) = tracer_conc_atm(betrtracer_vars%volatileid(j)) + this%conv_f(centurybgc_vars%lid_n2o) = 1._r8/gas2bulkcef(betrtracer_vars%volatileid(j)) + endif + enddo + end subroutine AAssign + +!------------------------------------------------------------------------------- + type(bgc_reaction_CENTURY_clm_type) function constructor() + ! + ! ! DESCRIPTION: + ! + ! create an object of type bgc_reaction_CENTURY_clm_type. + ! Right now it is purposely empty + + end function constructor + + +!------------------------------------------------------------------------------- + subroutine init_boundary_condition_type(this, bounds, betrtracer_vars, tracerboundarycond_vars ) + ! + ! DESCRIPTION: + ! + ! initialize boundary condition types + ! !USES: + use TracerBoundaryCondType , only : tracerboundarycond_type + use BeTRTracerType , only : betrtracer_type + + ! !ARGUMENTS: + class(bgc_reaction_CENTURY_clm_type), intent(in) :: this + type(bounds_type) , intent(in) :: bounds + type(BeTRtracer_type ) , intent(in) :: betrtracer_vars + type(tracerboundarycond_type) , intent(in) :: tracerboundarycond_vars + + + ! !LOCAL VARIABLES: + integer :: c + + + associate( & + groupid => betrtracer_vars%groupid & + ) + tracerboundarycond_vars%topbc_type(1:betrtracer_vars%ngwmobile_tracer_groups) = bndcond_as_conc + tracerboundarycond_vars%topbc_type(groupid(betrtracer_vars%id_trc_no3x)) = bndcond_as_flux + + tracerboundarycond_vars%topbc_type(betrtracer_vars%ngwmobile_tracer_groups+1:betrtracer_vars%ntracer_groups) = bndcond_as_flux + + end associate + end subroutine init_boundary_condition_type + +!------------------------------------------------------------------------------- + + subroutine Init_betrbgc(this, bounds, lbj, ubj, betrtracer_vars) + ! + ! !DESCRIPTION: + ! initialize the betrbgc + ! !USES: + use CNSharedParamsMod , only : CNParamsReadShared + use ncdio_pio , only : file_desc_t + use BeTRTracerType , only : betrtracer_type + use MathfuncMod , only : addone + use clm_varctl, only : cnallocate_carbon_only_set + + ! !ARGUMENTS: + class(bgc_reaction_CENTURY_clm_type), intent(in) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: lbj, ubj ! lower and upper bounds, make sure they are > 0 + type(BeTRtracer_type ) , intent(inout) :: betrtracer_vars + + ! !LOCAL VARIABLES: + character(len=32) , parameter :: subname ='Init_betrbgc' + integer :: jj + integer :: nelm, itemp_mem + integer :: itemp, itemp_vgrp, itemp_v, itemp_grp + integer :: c_loc, n_loc, trcid + logical :: carbon_only = .false. + + + call cnallocate_carbon_only_set(carbon_only) + call centurybgc_vars%Init(bounds, lbj, ubj) + + nelm =centurybgc_vars%nelms + c_loc=centurybgc_vars%c_loc + n_loc=centurybgc_vars%n_loc + + itemp = 0 + betrtracer_vars%id_trc_n2 = addone(itemp) + betrtracer_vars%id_trc_o2 = addone(itemp) + betrtracer_vars%id_trc_ar = addone(itemp) + betrtracer_vars%id_trc_co2x = addone(itemp) + betrtracer_vars%id_trc_ch4 = addone(itemp) + betrtracer_vars%id_trc_nh3x = addone(itemp) + betrtracer_vars%id_trc_no3x = addone(itemp) + betrtracer_vars%id_trc_n2o = addone(itemp) + + betrtracer_vars%ngwmobile_tracer_groups=itemp ! n2, o2, ar, co2, ch4, n2o, nh3x and no3x + betrtracer_vars%ngwmobile_tracers = itemp + betrtracer_vars%nvolatile_tracers=itemp-2 ! n2, o2, ar, co2, ch4 and n2o + betrtracer_vars%nvolatile_tracer_groups = itemp-2 ! + betrtracer_vars%nsolid_passive_tracer_groups = 4 ! som1, som2, som3 and others (lit1, lit2, lit3, cwd) + betrtracer_vars%nsolid_passive_tracers=centurybgc_vars%nom_pools*nelm ! + + betrtracer_vars%nmem_max = nelm*4 ! total number of elemnts, and 4 sub members (lit1, lit2, lit3, cwd) + + call betrtracer_vars%Init() + + betrtracer_vars%is_mobile(:) = .true. + + jj = itemp + itemp_vgrp = 0 !counter for volatile groups + itemp_v = 0 !counter for volatile tracers + itemp_grp = 0 !counter for tracer groups + + trcid = betrtracer_vars%id_trc_n2 + + + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_n2, trc_name='N2' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_o2, trc_name='O2' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_ar, trc_name='AR' , & + is_trc_mobile=.false., is_trc_advective = .false., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_co2x, trc_name='CO2x', & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = addone(itemp_grp) , & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_ch4, trc_name='CH4' , & + is_trc_mobile=.false., is_trc_advective = .false., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_nh3x, trc_name='NH3x', & + is_trc_mobile=.false., is_trc_advective = .false., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.false.) + + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_no3x, trc_name='NO3x', & + is_trc_mobile=.true., is_trc_advective = .true., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.false.,trc_vtrans_scal=1._r8) + + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_n2o, trc_name='N2O' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + + + !------------------------------------------------------------------------------------ + itemp_mem=0 + itemp_grp=addone(itemp_grp) !only one group passive solid litter tracers + trcid = jj+(centurybgc_vars%lit1-1)*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='LIT1C' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%lit1-1)*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='LIT1N' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + !------------------------------------------------------------------------------------ + + trcid = jj+(centurybgc_vars%lit2-1)*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='LIT2C' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%lit2-1)*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='LIT2N' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + !------------------------------------------------------------------------------------ + + trcid = jj+(centurybgc_vars%lit3-1)*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='LIT3C' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%lit3-1)*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='LIT3N' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + !------------------------------------------------------------------------------------ + + trcid = jj+(centurybgc_vars%cwd-1 )*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='CWDC' , & + is_trc_mobile=.false., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%cwd-1 )*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='CWDN' , & + is_trc_mobile=.false., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + !========================================================================================== + !new group + itemp_mem = 0 + itemp_grp = addone(itemp_grp) + trcid = jj+(centurybgc_vars%som1-1)*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='SOM1C' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp , & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%som1-1)*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='SOM1N' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + !------------------------------------------------------------------------------------ + !new group + itemp_mem=0 + itemp_grp = addone(itemp_grp) + trcid = jj+(centurybgc_vars%som2-1)*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='SOM2C' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp , & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%som2-1)*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='SOM2N' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + !------------------------------------------------------------------------------------ + !new group + itemp_mem=0 + itemp_grp = addone(itemp_grp) + trcid = jj+(centurybgc_vars%som3-1)*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='SOM3C' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%som3-1)*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='SOM3N' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + + end subroutine Init_betrbgc + +!------------------------------------------------------------------------------- + subroutine set_boundary_conditions(this, bounds, num_soilc, filter_soilc, dz_top, betrtracer_vars, & + waterflux_vars, tracerboundarycond_vars) + ! + ! !DESCRIPTION: + ! set up boundary conditions for tracer movement + ! + ! !USES: + use TracerBoundaryCondType, only : tracerboundarycond_type + use shr_log_mod , only : errMsg => shr_log_errMsg + use BeTRTracerType , only : betrtracer_type + use WaterfluxType , only : waterflux_type + + ! !ARGUMENTS: + class(bgc_reaction_CENTURY_clm_type), intent(in) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of columns in column filter + integer , intent(in) :: filter_soilc(:) ! column filter + type(betrtracer_type) , intent(in) :: betrtracer_vars + real(r8) , intent(in) :: dz_top(bounds%begc: ) + type(waterflux_type) , intent(in) :: waterflux_vars + type(tracerboundarycond_type) , intent(inout) :: tracerboundarycond_vars + + + ! !LOCAL VARIABLES: + character(len=255) :: subname = 'set_boundary_conditions' + integer :: fc, c + + SHR_ASSERT_ALL((ubound(dz_top) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + + associate( & + groupid => betrtracer_vars%groupid & + ) + do fc = 1, num_soilc + c = filter_soilc(fc) + !values below will be updated with datastream + !eventually, the following code will be implemented using polymorphism + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%ngwmobile_tracers+1:betrtracer_vars%ntracers)=0._r8 !zero incoming flux + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_n2) =32.8_r8 !mol m-3, contant boundary condition + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_o2) =8.78_r8 !mol m-3, contant boundary condition + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_ar) =0.3924_r8 !mol m-3, contant boundary condition + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_co2x)=0.0168_r8 !mol m-3, contant boundary condition + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_ch4) =6.939e-5_r8 !mol m-3, contant boundary condition + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_n2o) =1.195e-5_r8 !mol m-3, contant boundary condition + + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_no3x) = 0._r8 + tracerboundarycond_vars%bot_concflux_col(c,1,:) = 0._r8 !zero flux boundary condition + !those will be updated with snow resistance and hydraulic wicking resistance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_n2)) = 2._r8*1.267e-5_r8/dz_top(c) !m/s surface conductance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_o2)) = 2._r8*1.267e-5_r8/dz_top(c) !m/s surface conductance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_ar)) = 2._r8*1.267e-5_r8/dz_top(c) !m/s surface conductance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_co2x)) = 2._r8*1.267e-5_r8/dz_top(c) !m/s surface conductance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_ch4)) = 2._r8*1.267e-5_r8/dz_top(c) !m/s surface conductance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_n2o)) = 2._r8*1.267e-5_r8/dz_top(c) !m/s surface conductance + enddo + end associate + end subroutine set_boundary_conditions +!------------------------------------------------------------------------------- + + subroutine calc_bgc_reaction(this, bounds, lbj, ubj, num_soilc, filter_soilc, num_soilp, filter_soilp, jtops, dtime, & + betrtracer_vars, tracercoeff_vars, waterstate_vars, temperature_vars, soilstate_vars, chemstate_vars, & + cnstate_vars, carbonstate_vars, carbonflux_vars, nitrogenstate_vars, nitrogenflux_vars, tracerstate_vars, & + tracerflux_vars, plantsoilnutrientflux_vars) + ! + ! !DESCRIPTION: + ! do bgc reaction + ! this returns net carbon fluxes from decay and translocation + ! and also update the related carbon/nitrogen/phosphorus(potentially) pools of OM + ! note it is assumed the stoichiometry of the om pools are not changed during decomposition + ! + ! !USES: + ! + use tracerfluxType , only : tracerflux_type + use tracerstatetype , only : tracerstate_type + use tracercoeffType , only : tracercoeff_type + use BetrTracerType , only : betrtracer_type + use WaterStateType , only : Waterstate_Type + use TemperatureType , only : temperature_type + use ChemStateType , only : chemstate_type + use SoilStatetype , only : soilstate_type + use ODEMod , only : ode_ebbks1,ldebug_ode + use CNStateType , only : cnstate_type + use PlantSoilnutrientFluxType, only : plantsoilnutrientflux_type + use CNVerticalProfileMod , only : decomp_vertprofiles + use CNCarbonStateType , only : carbonstate_type + use CNCarbonFluxType , only : carbonflux_type + use CNNitrogenFluxType , only : nitrogenflux_type + use CNNitrogenStateType , only : nitrogenstate_type + + ! !ARGUMENTS: + class(bgc_reaction_CENTURY_clm_type) , intent(in) :: this + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_soilc ! number of columns in column filter + integer , intent(in) :: filter_soilc(:) ! column filter + integer , intent(in) :: num_soilp + integer , intent(in) :: filter_soilp(:) ! pft filter + integer , intent(in) :: jtops(bounds%begc: ) ! top index of each column + integer , intent(in) :: lbj, ubj ! lower and upper bounds, make sure they are > 0 + real(r8) , intent(in) :: dtime ! model time step + type(Waterstate_Type) , intent(in) :: waterstate_vars ! water state variables + type(temperature_type) , intent(in) :: temperature_vars ! energy state variable + type(soilstate_type) , intent(in) :: soilstate_vars + type(chemstate_type) , intent(in) :: chemstate_vars + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(tracercoeff_type) , intent(in) :: tracercoeff_vars + type(carbonstate_type) , intent(in) :: carbonstate_vars + type(cnstate_type) , intent(inout) :: cnstate_vars + type(carbonflux_type) , intent(inout) :: carbonflux_vars + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + type(tracerstate_type) , intent(inout) :: tracerstate_vars + type(tracerflux_type) , intent(inout) :: tracerflux_vars + type(plantsoilnutrientflux_type) , intent(inout) :: plantsoilnutrientflux_vars + + ! !LOCAL VARIABLES: + character(len=32), parameter :: subname ='calc_bgc_reaction' + integer :: fc, c, j, k + real(r8) :: time + real(r8) :: y0(centurybgc_vars%nstvars, bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: yf(centurybgc_vars%nstvars, bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: cn_ratios(centurybgc_vars%nom_pools, bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: cp_ratios(centurybgc_vars%nom_pools, bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: k_decay(centurybgc_vars%nreactions, bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: pot_decay_rates(centurybgc_vars%nom_pools, bounds%begc:bounds%endc, lbj:ubj) ![mol C/m3/s] potential decay rates for different om pools without nutrient limitation + real(r8) :: pot_co2_hr(bounds%begc:bounds%endc, lbj:ubj) ![mol C/m3/s], potential co2 respiration rate + real(r8) :: pot_nh3_immob(bounds%begc:bounds%endc,lbj:ubj) + real(r8) :: anaerobic_frac(bounds%begc:bounds%endc,lbj:ubj) + real(r8) :: n2_n2o_ratio_denit(bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: nh4_no3_ratio(bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: nuptake_prof(bounds%begc:bounds%endc,1:ubj) + real(r8) :: pscal + + SHR_ASSERT_ALL((ubound(jtops) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + + call Extra_inst%Init_Allocate(centurybgc_vars%nom_pools, centurybgc_vars%nreactions, centurybgc_vars%nprimvars) + + call set_reaction_order( centurybgc_vars%nreactions, centurybgc_vars, Extra_inst%is_zero_order) + + !initialize local variables + y0(:, :, :) = spval + yf(:, :, :) = spval + cn_ratios(:,:,:) = nan + cp_ratios(:,:,:) = nan + + !initialize the state vector + call init_state_vector(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, centurybgc_vars%nstvars, tracerstate_vars, betrtracer_vars, centurybgc_vars, y0) + + !update the initial vector from external input + !calculate elemental stoichiometry for different om pools and add mineral nutrient input from other than decaying process + + call bgcstate_ext_update_bfdecomp(bounds, 1, ubj, num_soilc, filter_soilc, carbonflux_vars, nitrogenflux_vars, & + centurybgc_vars, betrtracer_vars, tracerflux_vars, y0, cn_ratios, cp_ratios) + + !calculate nitrogen uptake profile + call calc_nuptake_prof(bounds, ubj, num_soilc, filter_soilc, & + tracerstate_vars%tracer_conc_mobile_col(bounds%begc:bounds%endc, 1:ubj, betrtracer_vars%id_trc_nh3x), & + tracerstate_vars%tracer_conc_mobile_col(bounds%begc:bounds%endc, 1:ubj, betrtracer_vars%id_trc_no3x), & + col%dz(bounds%begc:bounds%endc,1:ubj), cnstate_vars%nfixation_prof_col(bounds%begc:bounds%endc,1:ubj), & + nuptake_prof(bounds%begc:bounds%endc,1:ubj)) + + !update plant nitrogen uptake potential + + call plantsoilnutrientflux_vars%calc_nutrient_uptake_potential(bounds, num_soilc, filter_soilc, num_soilp, & + filter_soilp, carbonstate_vars%frootc_patch) + + !calculate multiplicative scalars for decay parameters + call calc_decompK_multiply_scalar(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, & + waterstate_vars%finundated_col(bounds%begc:bounds%endc), col%z(bounds%begc:bounds%endc, lbj:ubj),& + temperature_vars%t_soisno_col(bounds%begc:bounds%endc, lbj:ubj), & + tracerstate_vars%tracer_conc_mobile_col(bounds%begc:bounds%endc, lbj:ubj, betrtracer_vars%id_trc_o2), & + tracercoeff_vars%aqu2bulkcef_mobile_col(bounds%begc:bounds%endc, lbj:ubj, betrtracer_vars%id_trc_o2), & + soilstate_vars, centurybgc_vars, carbonflux_vars) + + !calculate decay coefficients + call calc_som_deacyK(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, centurybgc_vars%nom_pools, tracercoeff_vars, tracerstate_vars, & + betrtracer_vars, centurybgc_vars, carbonflux_vars, dtime, k_decay(1:centurybgc_vars%nom_pools, bounds%begc:bounds%endc, lbj:ubj)) + + !calculate potential decay rates, without nutrient constraint + call calc_sompool_decay(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, centurybgc_vars, & + k_decay(1:centurybgc_vars%nom_pools, bounds%begc:bounds%endc, lbj:ubj), y0(1:centurybgc_vars%nom_totelms, bounds%begc:bounds%endc, lbj:ubj),& + pot_decay_rates) + + !calculate potential respiration rates by summarizing all om decomposition pathways + call calc_potential_aerobic_hr(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, cn_ratios, cp_ratios, centurybgc_vars, pot_decay_rates, & + soilstate_vars%cellsand_col(bounds%begc:bounds%endc,lbj:ubj), pot_co2_hr, pot_nh3_immob) + + !calculate fraction of anerobic environment + call calc_anaerobic_frac(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, temperature_vars%t_soisno_col(bounds%begc:bounds%endc,lbj:ubj),& + soilstate_vars, waterstate_vars%h2osoi_vol_col(bounds%begc:bounds%endc,lbj:ubj), pot_co2_hr, & + tracerstate_vars%tracer_conc_mobile_col(bounds%begc:bounds%endc, lbj:ubj, betrtracer_vars%id_trc_o2), & + anaerobic_frac(bounds%begc:bounds%endc, lbj:ubj)) + + !calculate normalized rate for nitrification and denitrification + call calc_nitrif_denitrif_rate(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, col%dz(bounds%begc:bounds%endc, lbj:ubj), & + temperature_vars%t_soisno_col(bounds%begc:bounds%endc, lbj:ubj), & + chemstate_vars%soil_pH(bounds%begc:bounds%endc, lbj:ubj), pot_co2_hr, anaerobic_frac, & + tracerstate_vars%tracer_conc_mobile_col(bounds%begc:bounds%endc, lbj:ubj, betrtracer_vars%id_trc_nh3x), & + tracerstate_vars%tracer_conc_mobile_col(bounds%begc:bounds%endc, lbj:ubj, betrtracer_vars%id_trc_no3x), & + soilstate_vars, waterstate_vars, carbonflux_vars, n2_n2o_ratio_denit, nh4_no3_ratio, & + k_decay(centurybgc_vars%lid_nh4_nit_reac, bounds%begc:bounds%endc, lbj:ubj), & + k_decay(centurybgc_vars%lid_no3_den_reac, bounds%begc:bounds%endc, lbj:ubj)) + + !now there is no plant nitrogen uptake, I tend to create a new structure to indicate plant nutrient demand when it is hooked + !back with CLM + + call calc_plant_nitrogen_uptake_prof(bounds, ubj, num_soilc, filter_soilc, col%dz(bounds%begc:bounds%endc, lbj:ubj), & + plantsoilnutrientflux_vars%plant_minn_uptake_potential_col(bounds%begc:bounds%endc), & + nuptake_prof(bounds%begc:bounds%endc,1:ubj), & + k_decay(centurybgc_vars%lid_plant_minn_up_reac, bounds%begc:bounds%endc ,1:ubj)) + + !apply root distribution here + call apply_plant_root_respiration_prof(bounds, ubj, num_soilc, filter_soilc, & + carbonflux_vars%rr_col(bounds%begc:bounds%endc), cnstate_vars%nfixation_prof_col(bounds%begc:bounds%endc,1:ubj), & + k_decay(centurybgc_vars%lid_at_rt_reac, bounds%begc:bounds%endc, 1:ubj)) + + !do ode integration and update state variables for each layer + do j = lbj, ubj + do fc = 1, num_soilc + c = filter_soilc(fc) + if(j betrtracer_vars%volatileid & + ) + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if (lun%ifspecial(l)) then + if(betrtracer_vars%ngwmobile_tracers>0)then + tracerstate_vars%tracer_conc_mobile_col(c,:,:) = spval + tracerstate_vars%tracer_conc_surfwater_col(c,:) = spval + tracerstate_vars%tracer_conc_aquifer_col(c,:) = spval + tracerstate_vars%tracer_conc_grndwater_col(c,:) = spval + tracerstate_vars%tracer_conc_atm_col(c,:) = spval + endif + if(betrtracer_vars%ntracers > betrtracer_vars%ngwmobile_tracers)then + tracerstate_vars%tracer_conc_solid_passive_col(c,:,:) = spval + endif + if(betrtracer_vars%nsolid_equil_tracers>0)then + tracerstate_vars%tracer_conc_solid_equil_col(c, :, :) = spval + endif + endif + tracerstate_vars%tracer_soi_molarmass_col(c,:) = spval + + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + !dual phase tracers + + tracerstate_vars%tracer_conc_mobile_col(c,:, :) = 0._r8 + tracerstate_vars%tracer_conc_surfwater_col(c,:) = 0._r8 + tracerstate_vars%tracer_conc_aquifer_col(c,:) = 0._r8 + tracerstate_vars%tracer_conc_grndwater_col(c,:) = 0._r8 + tracerstate_vars%tracer_conc_atm_col(c,volatileid(betrtracer_vars%id_trc_n2)) = 32.8_r8 + tracerstate_vars%tracer_conc_atm_col(c,volatileid(betrtracer_vars%id_trc_o2)) = 8.78_r8 + tracerstate_vars%tracer_conc_atm_col(c,volatileid(betrtracer_vars%id_trc_ar)) = 0.3924_r8 + tracerstate_vars%tracer_conc_atm_col(c,volatileid(betrtracer_vars%id_trc_co2x))= 0.0168_r8 + tracerstate_vars%tracer_conc_atm_col(c,volatileid(betrtracer_vars%id_trc_ch4)) = 6.939e-5_r8 + tracerstate_vars%tracer_conc_atm_col(c,volatileid(betrtracer_vars%id_trc_n2o)) = 1.195e-5_r8 + + !solid tracers + if(betrtracer_vars%ngwmobile_tracers < betrtracer_vars%ntracers)then + tracerstate_vars%tracer_conc_solid_passive_col(c,:,:) = 0._r8 + endif + + if(betrtracer_vars%nsolid_equil_tracers>0)then + tracerstate_vars%tracer_conc_solid_equil_col(c, :, :) = 0._r8 + endif + tracerstate_vars%tracer_soi_molarmass_col(c,:) = 0._r8 + endif + enddo + end associate + end subroutine InitCold + +!-------------------------------------------------------------------------------------------------------------------- + subroutine betr_alm_flux_statevar_feedback(this, bounds, num_soilc, filter_soilc, & + carbonstate_vars, nitrogenstate_vars, nitrogenflux_vars, tracerstate_vars, tracerflux_vars, betrtracer_vars) + + ! + ! !DESCRIPTION: + ! state and flux variable exchange between betr and acme + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use tracerfluxType , only : tracerflux_type + use tracerstatetype , only : tracerstate_type + use decompMod , only : bounds_type + use BeTRTracerType , only : BeTRTracer_Type + use CNCarbonStateType , only : carbonstate_type + use CNNitrogenStateType , only : nitrogenstate_type + use CNNitrogenFluxType , only : nitrogenflux_type + + + ! !ARGUMENTS: + class(bgc_reaction_CENTURY_clm_type) , intent(in) :: this + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_soilc ! number of columns in column filter + integer , intent(in) :: filter_soilc(:) ! column filter + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(tracerstate_type) , intent(in) :: tracerstate_vars + type(tracerflux_type) , intent(in) :: tracerflux_vars + type(carbonstate_type) , intent(inout) :: carbonstate_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars + + + + call assign_nitrogen_hydroloss(bounds, num_soilc, filter_soilc, tracerflux_vars, nitrogenflux_vars, betrtracer_vars) + + call assign_OM_CNpools(bounds, num_soilc, filter_soilc, carbonstate_vars, nitrogenstate_vars, tracerstate_vars, betrtracer_vars, centurybgc_vars) + + end subroutine betr_alm_flux_statevar_feedback + +!--------------------------------------------------------------- + subroutine init_betr_alm_bgc_coupler(this, bounds, carbonstate_vars, nitrogenstate_vars, betrtracer_vars, tracerstate_vars) + ! + ! !DESCRIPTION: + ! state variable exchange between betr and alm + ! !USES: + use clm_varcon , only : natomw, catomw + use clm_varpar , only : i_cwd, i_met_lit, i_cel_lit, i_lig_lit + use CNCarbonStateType , only : carbonstate_type + use CNNitrogenStateType , only : nitrogenstate_type + use tracerstatetype , only : tracerstate_type + use BetrTracerType , only : betrtracer_type + use clm_varpar , only : nlevtrc_soil + use landunit_varcon , only : istsoil, istcrop + + ! !ARGUMENTS: + class(bgc_reaction_CENTURY_clm_type) , intent(in) :: this + type(bounds_type) , intent(in) :: bounds + type(tracerstate_type) , intent(inout) :: tracerstate_vars + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(carbonstate_type) , intent(in) :: carbonstate_vars + type(nitrogenstate_type) , intent(in) :: nitrogenstate_vars + + ! !LOCAL VARIABLES: + integer, parameter :: i_soil1 = 5 + integer, parameter :: i_soil2 = 6 + integer, parameter :: i_soil3 = 7 + character(len=255) :: subname = 'init_betr_alm_bgc_coupler' + integer :: c, j, k, l + + associate( & + id_trc_no3x => betrtracer_vars%id_trc_no3x , & + id_trc_nh3x => betrtracer_vars%id_trc_nh3x , & + decomp_cpools_vr => carbonstate_vars%decomp_cpools_vr_col , & + decomp_npools_vr => nitrogenstate_vars%decomp_npools_vr_col, & + smin_no3_vr_col => nitrogenstate_vars%smin_no3_vr_col , & + smin_nh4_vr_col => nitrogenstate_vars%smin_nh4_vr_col , & + tracer_conc_mobile => tracerstate_vars%tracer_conc_mobile_col, & + tracer_conc_solid_passive => tracerstate_vars%tracer_conc_solid_passive_col, & + c_loc => centurybgc_vars%c_loc , & + n_loc => centurybgc_vars%n_loc , & + lit1 => centurybgc_vars%lit1 , & + lit2 => centurybgc_vars%lit2 , & + lit3 => centurybgc_vars%lit3 , & + som1 => centurybgc_vars%som1 , & + som2 => centurybgc_vars%som2 , & + som3 => centurybgc_vars%som3 , & + cwd => centurybgc_vars%cwd , & + nelms => centurybgc_vars%nelms & + ) + !initialize tracer based on carbon/nitrogen pools + do j = 1, nlevtrc_soil + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + tracer_conc_mobile(c,j,id_trc_no3x)=smin_no3_vr_col(c,j) /natomw + tracer_conc_mobile(c,j,id_trc_nh3x)=smin_nh4_vr_col(c,j) /natomw + k = lit1; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_met_lit) / catomw + k = lit2; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_cel_lit) / catomw + k = lit3; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_lig_lit) / catomw + k = cwd ; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_cwd ) / catomw + k = som1; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_soil1 ) / catomw + k = som2; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_soil2 ) / catomw + k = som3; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_soil3 ) / catomw + + k = lit1; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_met_lit) / natomw + k = lit2; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_cel_lit) / natomw + k = lit3; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_lig_lit) / natomw + k = cwd ; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_cwd ) / natomw + k = som1; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_soil1 ) / natomw + k = som2; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_soil2 ) / natomw + k = som3; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_soil3 ) / natomw + endif + enddo + enddo + end associate + end subroutine init_betr_alm_bgc_coupler + +!------------------------------------------------------------------------------- + + + subroutine one_box_century_bgc(ystate, dtime, time, nprimvars, nstvars, dydt) + ! + ! !DESCRIPTION: + ! do asingle box bgc + ! + !the equations to be solved are in the form + ! + ! dx/dt=I+A*R, where I is the input, A is the stoichiometric matrix, and R is the reaction vector + ! + ! the input only contains litter input and mineral nutrient, som is assumed to be of fixed stoichiometry + ! + ! !USES: + use SOMStateVarUpdateMod , only : calc_dtrend_som_bgc + use BGCCenturySubMod , only : calc_cascade_matrix + implicit none + ! !ARGUMENTS: + integer, intent(in) :: nstvars + integer, intent(in) :: nprimvars + real(r8), intent(in) :: dtime + real(r8), intent(in) :: time + real(r8), intent(in) :: ystate(nstvars) + real(r8), intent(out) :: dydt(nstvars) + + ! !LOCAL VARIABLES: + integer :: lk, jj + real(r8) :: cascade_matrix(nstvars, Extra_inst%nr) + logical :: nitrogen_limit_flag(centurybgc_vars%nom_pools) + real(r8) :: reaction_rates(Extra_inst%nr) + real(r8) :: o2_consump, o2_limit + + !calculate cascade matrix, which contains the stoichiometry for all reactions + call calc_cascade_matrix(nstvars, Extra_inst%nr, Extra_inst%cn_ratios, Extra_inst%cp_ratios, & + Extra_inst%n2_n2o_ratio_denit, Extra_inst%cellsand, centurybgc_vars, nitrogen_limit_flag, cascade_matrix) + + !do pool degradation + do lk = 1, Extra_inst%nr + if(Extra_inst%is_zero_order(lk))then + + if ( spinup_state .eq. 1 ) then + !spinup stage + if(lk == centurybgc_vars%lid_o2_aere_reac)then + jj = centurybgc_vars%lid_o2 + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + !I add the following line to disconnect the nitrogen and oxygen interaction + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + else + reaction_rates(lk) = Extra_inst%k_decay(lk) !this effective defines the plant nitrogen demand + endif + else + ! normal run stage + if(lk == centurybgc_vars%lid_o2_aere_reac)then + jj = centurybgc_vars%lid_o2 + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + elseif(lk == centurybgc_vars%lid_ch4_aere_reac)then + jj = centurybgc_vars%lid_ch4 + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + + elseif(lk == centurybgc_vars%lid_ar_aere_reac)then + jj = centurybgc_vars%lid_ar + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + + elseif(lk == centurybgc_vars%lid_n2_aere_reac)then + jj = centurybgc_vars%lid_n2 + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + + elseif(lk == centurybgc_vars%lid_co2_aere_reac)then + jj = centurybgc_vars%lid_co2 + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + + elseif(lk == centurybgc_vars%lid_n2o_aere_reac)then + jj = centurybgc_vars%lid_n2o + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + + else + reaction_rates(lk) = Extra_inst%k_decay(lk) !this effective defines the plant nitrogen demand + endif + endif + + else + + reaction_rates(lk)=ystate(centurybgc_vars%primvarid(lk))*Extra_inst%k_decay(lk) + endif + enddo + + !obtain total oxygen consumption rate + o2_consump = DOT_PRODUCT(cascade_matrix(centurybgc_vars%lid_o2,1:Extra_inst%nr),reaction_rates(1:Extra_inst%nr)) + if(-o2_consump*dtime > ystate(centurybgc_vars%lid_o2))then + o2_limit=-ystate(centurybgc_vars%lid_o2)/(o2_consump*dtime) + do lk = 1, Extra_inst%nr + if(centurybgc_vars%is_aerobic_reac(lk))then + reaction_rates(lk) = reaction_rates(lk)*o2_limit + endif + enddo + endif + + call apply_nutrient_down_regulation(nstvars, Extra_inst%nr, nitrogen_limit_flag, ystate(centurybgc_vars%lid_nh4), ystate(centurybgc_vars%lid_no3), & + dtime, cascade_matrix, reaction_rates) + + call calc_dtrend_som_bgc(nstvars, Extra_inst%nr, cascade_matrix(1:nstvars, 1:Extra_inst%nr), reaction_rates(1:Extra_inst%nr), dydt) + + + end subroutine one_box_century_bgc +!------------------------------------------------------------------------------- + + + subroutine apply_nutrient_down_regulation(nstvars, nreactions, nitrogen_limit_flag, smin_nh4, smin_no3, dtime, cascade_matrix, reaction_rates) + + ! !DESCRIPTION: + ! this down regulation does not consider the extra nitrogen made available from mineralization + ! this implements is corresponding to the CLM-1 approach as described in Tang and Riley (2015), BG, tehcnique note. + ! + ! !USES: + use clm_varctl, only : CNAllocate_Carbon_only + use MathfuncMod, only : safe_div + + integer , intent(in) :: nstvars + integer , intent(in) :: nreactions + logical , intent(in) :: nitrogen_limit_flag(centurybgc_vars%nom_pools) + real(r8), intent(in) :: smin_nh4 + real(r8), intent(in) :: smin_no3 + real(r8), intent(in) :: dtime + real(r8), intent(inout) :: cascade_matrix(nstvars, nreactions) + real(r8), intent(inout) :: reaction_rates(nreactions) + + real(r8) :: decomp_plant_minn_demand_flx + real(r8) :: tot_nh4_demand_flx + real(r8) :: tot_no3_demand_flx + real(r8) :: decomp_plant_residual_minn_demand_flx + real(r8) :: smin_nh4_to_decomp_plant_flx + real(r8) :: smin_no3_to_decomp_plant_flx + real(r8) :: tot_sminn_to_decomp_plant_flx + real(r8) :: frac_nh4_to_decomp_plant + real(r8) :: supp_nh4_to_decomp_plant_flx + real(r8) :: frac_supp_nh4_to_decomp_plant + real(r8) :: alpha + integer :: reac + + associate( & ! + nom_pools => centurybgc_vars%nom_pools , & ! + lid_nh4 => centurybgc_vars%lid_nh4 , & ! + lid_no3 => centurybgc_vars%lid_no3 , & ! + lid_plant_minn => centurybgc_vars%lid_plant_minn , & ! + lid_minn_nh4_immob => centurybgc_vars%lid_minn_nh4_immob , & ! + lid_minn_no3_immob => centurybgc_vars%lid_minn_no3_immob , & ! + lid_minn_nh4_plant => centurybgc_vars%lid_minn_nh4_plant , & ! + lid_minn_no3_plant => centurybgc_vars%lid_minn_no3_plant , & ! + lid_nh4_supp => centurybgc_vars%lid_nh4_supp , & ! + lid_nh4_nit => centurybgc_vars%lid_nh4_nit , & ! + lid_plant_minn_up_reac=> centurybgc_vars%lid_plant_minn_up_reac, & ! + lid_nh4_nit_reac => centurybgc_vars%lid_nh4_nit_reac , & ! + lid_no3_den_reac => centurybgc_vars%lid_no3_den_reac & ! + ) + + decomp_plant_minn_demand_flx = 0._r8 + do reac = 1, nom_pools + if(nitrogen_limit_flag(reac))then + decomp_plant_minn_demand_flx = decomp_plant_minn_demand_flx - reaction_rates(reac) * cascade_matrix(lid_nh4, reac) + endif + enddo + + !add nitrogen demand from plant + reac = lid_plant_minn_up_reac + decomp_plant_minn_demand_flx = decomp_plant_minn_demand_flx - reaction_rates(reac) * cascade_matrix(lid_nh4, reac) + + !in clm-century, nh4 is first competed between decomposer immobilization, plant and nitrification + reac = lid_nh4_nit_reac + tot_nh4_demand_flx = decomp_plant_minn_demand_flx - reaction_rates(reac) * cascade_matrix(lid_nh4 ,reac) + + if(tot_nh4_demand_flx*dtime>smin_nh4)then + !nitrifiers, decomposers and plants are nh4 limited + if(CNAllocate_Carbon_only())then + + !nitrifier uses what it is provided + !plant use the remaining nh4 and request external supply from supp nh4 + if(reaction_rates(reac)<1.e-40_r8)then + alpha = 0._r8 + else + alpha = -smin_nh4/(reaction_rates(reac)*cascade_matrix(lid_nh4,reac)*dtime) + endif + reaction_rates(reac) = reaction_rates(reac) * min(alpha, 1._r8) + + smin_nh4_to_decomp_plant_flx = smin_nh4/dtime+reaction_rates(reac)*cascade_matrix(lid_nh4,reac) + decomp_plant_residual_minn_demand_flx = decomp_plant_minn_demand_flx - smin_nh4_to_decomp_plant_flx + + + else + alpha = smin_nh4/(tot_nh4_demand_flx*dtime) + !downregulate nitrification + reaction_rates(lid_nh4_nit_reac) = reaction_rates(lid_nh4_nit_reac)*alpha + smin_nh4_to_decomp_plant_flx = smin_nh4/dtime +reaction_rates(reac)*cascade_matrix(lid_nh4,reac) + decomp_plant_residual_minn_demand_flx = decomp_plant_minn_demand_flx - smin_nh4_to_decomp_plant_flx + + endif + + else + !none is nh4 limited + smin_nh4_to_decomp_plant_flx = decomp_plant_minn_demand_flx + decomp_plant_residual_minn_demand_flx = 0._r8 + endif + smin_nh4_to_decomp_plant_flx = max(smin_nh4_to_decomp_plant_flx-1.e-21_r8, 0._r8) + + reac = lid_no3_den_reac + tot_no3_demand_flx = decomp_plant_residual_minn_demand_flx - reaction_rates(reac) * cascade_matrix(lid_no3 ,reac) + !then no3 is competed between denitrification and residual request from decomposer immobilization and plant demand + if(tot_no3_demand_flx * dtime>smin_no3)then + if(CNAllocate_Carbon_only())then + !denitrifiers is given what is available + if(abs(reaction_rates(reac))<1.e-40_r8)then + alpha = 0._r8 + else + alpha = -smin_no3/(dtime*reaction_rates(reac)*cascade_matrix(lid_no3,reac)) + endif + reaction_rates(lid_no3_den_reac ) = reaction_rates(lid_no3_den_reac )*min(alpha,1._r8) + smin_no3_to_decomp_plant_flx = smin_no3/dtime + reaction_rates(lid_no3_den_reac ) * cascade_matrix(lid_no3 ,reac) + + else + !denitrifiers, decomposers and plants are no3 limited + alpha = smin_no3/(tot_no3_demand_flx*dtime) + reaction_rates(lid_no3_den_reac ) = reaction_rates(lid_no3_den_reac )*alpha + + smin_no3_to_decomp_plant_flx = smin_no3/dtime + reaction_rates(lid_no3_den_reac ) * cascade_matrix(lid_no3 ,reac) + + endif + else + smin_no3_to_decomp_plant_flx = tot_no3_demand_flx + endif + !avoid negative smin_no3 due to roundoff + smin_no3_to_decomp_plant_flx = max(smin_no3_to_decomp_plant_flx-1.e-21_r8, 0._r8) + + tot_sminn_to_decomp_plant_flx = smin_nh4_to_decomp_plant_flx + smin_no3_to_decomp_plant_flx + if(CNAllocate_Carbon_only())then + supp_nh4_to_decomp_plant_flx = decomp_plant_minn_demand_flx - tot_sminn_to_decomp_plant_flx + tot_sminn_to_decomp_plant_flx = decomp_plant_minn_demand_flx + else + supp_nh4_to_decomp_plant_flx = 0._r8 + endif + + if(tot_sminn_to_decomp_plant_flx < decomp_plant_minn_demand_flx)then + !plant & decomp are nitrogen limited + alpha = tot_sminn_to_decomp_plant_flx/decomp_plant_minn_demand_flx + else + alpha = 1._r8 + endif + + if(smin_nh4_to_decomp_plant_flx>=tot_sminn_to_decomp_plant_flx)then + frac_nh4_to_decomp_plant = 1._r8 + frac_supp_nh4_to_decomp_plant=0._r8 + else + frac_nh4_to_decomp_plant = smin_nh4_to_decomp_plant_flx/tot_sminn_to_decomp_plant_flx + if(supp_nh4_to_decomp_plant_flx>0._r8)then + frac_supp_nh4_to_decomp_plant=1._r8-frac_nh4_to_decomp_plant + else + frac_supp_nh4_to_decomp_plant = 0._r8 + endif + endif + !revise the stoichiometry matix elements + !for decomposers + + do reac = 1, nom_pools + if(nitrogen_limit_flag(reac))then + reaction_rates(reac) = reaction_rates(reac) * alpha + + cascade_matrix(lid_no3, reac) = cascade_matrix(lid_nh4, reac) * (1._r8-frac_nh4_to_decomp_plant-frac_supp_nh4_to_decomp_plant) + + if(lid_nh4_supp>0)then + cascade_matrix(lid_nh4_supp, reac) = cascade_matrix(lid_nh4, reac) * frac_supp_nh4_to_decomp_plant + cascade_matrix(lid_nh4,reac) = cascade_matrix(lid_nh4, reac) - cascade_matrix(lid_no3, reac) - cascade_matrix(lid_nh4_supp, reac) + cascade_matrix(lid_minn_nh4_immob, reac) = -cascade_matrix(lid_nh4, reac)-cascade_matrix(lid_nh4_supp, reac) + else + cascade_matrix(lid_nh4,reac) = cascade_matrix(lid_nh4, reac) - cascade_matrix(lid_no3, reac) + cascade_matrix(lid_minn_nh4_immob, reac) = -cascade_matrix(lid_nh4, reac) + endif + cascade_matrix(lid_minn_no3_immob, reac) = -cascade_matrix(lid_no3, reac) + endif + enddo + + !for plant + reac = lid_plant_minn_up_reac + reaction_rates(reac) = reaction_rates(reac) * alpha + cascade_matrix(lid_nh4, reac) = -frac_nh4_to_decomp_plant + if(lid_nh4_supp>0)then + cascade_matrix(lid_nh4_supp, reac) = -frac_supp_nh4_to_decomp_plant + cascade_matrix(lid_no3, reac) = -(1._r8-frac_nh4_to_decomp_plant-frac_supp_nh4_to_decomp_plant) + + cascade_matrix(lid_minn_nh4_plant, reac) = -cascade_matrix(lid_nh4, reac)-cascade_matrix(lid_nh4_supp, reac) + else + cascade_matrix(lid_no3, reac) = -(1._r8-frac_nh4_to_decomp_plant) + + cascade_matrix(lid_minn_nh4_plant, reac) = -cascade_matrix(lid_nh4, reac) + endif + cascade_matrix(lid_minn_no3_plant, reac) = -cascade_matrix(lid_no3, reac) + + end associate + end subroutine apply_nutrient_down_regulation +end module BGCReactionsCenturyCLMType diff --git a/components/clm/src/betr/bgc_century/BGCReactionsCenturyECAType.F90 b/components/clm/src/betr/bgc_century/BGCReactionsCenturyECAType.F90 new file mode 100644 index 000000000000..54882cdc9a12 --- /dev/null +++ b/components/clm/src/betr/bgc_century/BGCReactionsCenturyECAType.F90 @@ -0,0 +1,1345 @@ +module BGCReactionsCenturyECAType + +#include "shr_assert.h" + + ! + ! !DESCRIPTION: + ! do ECA based nitrogen competition in betr. + ! this code uses the operator automated down-regulation scheme + ! HISTORY: + ! Created by Jinyun Tang, Oct 2nd, 2014 + ! Note: ECA parameters are note tuned. + ! + ! !USES: + ! + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varctl , only : iulog + use abortutils , only : endrun + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_time_manager , only : get_nstep + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use decompMod , only : bounds_type + use BGCReactionsMod , only : bgc_reaction_type + use clm_varcon , only : spval + use clm_varctl , only : spinup_state + use tracer_varcon , only : bndcond_as_conc, bndcond_as_flux + use BGCCenturySubMod + use BGCCenturySubCoreMod + use LandunitType , only : lun + use ColumnType , only : col + use GridcellType , only : grc + use landunit_varcon , only : istsoil, istcrop + implicit none + + save + private + ! + ! !PUBLIC TYPES: + public :: bgc_reaction_CENTURY_ECA_type + type(centurybgc_type), private :: centurybgc_vars + logical :: ldebug + !integer, private :: lpr + type, extends(bgc_reaction_type) :: & + bgc_reaction_CENTURY_ECA_type + private + +contains + procedure :: Init_betrbgc ! initialize betr bgc + procedure :: set_boundary_conditions ! set top/bottom boundary conditions for various tracers + procedure :: calc_bgc_reaction ! doing bgc calculation + procedure :: init_boundary_condition_type ! initialize type of top boundary conditions + procedure :: do_tracer_equilibration ! do equilibrium tracer chemistry + procedure :: initCold + procedure :: readParams + procedure :: init_betr_alm_bgc_coupler ! update state vars using other bgc parts in alm + procedure :: betr_alm_flux_statevar_feedback + end type bgc_reaction_CENTURY_ECA_type + + type, private :: Extra_type + real(r8), pointer :: cn_ratios(:) !cn ratio of om pool + real(r8), pointer :: cp_ratios(:) !cp ratio of om pool + real(r8), pointer :: k_decay(:) !decay parameter for all reactions + real(r8), pointer :: scal_f(:) !scaling factor for first order sink + real(r8), pointer :: conv_f(:) !converting factor for first order sink + real(r8), pointer :: conc_f(:) !external forcing strength + real(r8) :: n2_n2o_ratio_denit !ratio of n2 to n2o during denitrification + real(r8) :: pct_sand !sand content [0-100] + real(r8) :: pct_clay !clay content [0-100] + real(r8) :: plant_frts !fine roots for nutrient uptake + logical, pointer :: is_zero_order(:) + integer :: nr !number of reactions involved + contains + procedure, public :: Init_Allocate + procedure, public :: DDeallocate + procedure, public :: AAssign + end type Extra_type + type(Extra_type), private :: Extra_inst + + + interface bgc_reaction_CENTURY_ECA_type + module procedure constructor + + end interface bgc_reaction_CENTURY_ECA_type + +contains + + subroutine Init_Allocate(this, nompools, nreacts, nprimstvars) + ! + ! !DESCRIPTION: + ! memory allocation for the data type specified by this + ! + ! !ARGUMENTS: + class(Extra_type) :: this + + integer, intent(in) :: nompools + integer, intent(in) :: nreacts + integer, intent(in) :: nprimstvars !number of primary state variables + + allocate(this%cn_ratios(nompools)) + allocate(this%cp_ratios(nompools)) + allocate(this%k_decay(nreacts)) + allocate(this%scal_f(nprimstvars)); this%scal_f(:) = 0._r8 + allocate(this%conv_f(nprimstvars)); this%conv_f(:) = 0._r8 + allocate(this%conc_f(nprimstvars)); this%conc_f(:) = 0._r8 + allocate(this%is_zero_order(nreacts)); this%is_zero_order(:) = .false. + this%nr = nreacts + + end subroutine Init_Allocate + + !------------------------------------------------------------------------------- + + subroutine DDeallocate(this) + ! + ! !DESCRIPTION: + ! deallocate memory for the data type specified by this + ! + ! !ARGUMENTS: + class(Extra_type) :: this + + + deallocate(this%cn_ratios) + deallocate(this%cp_ratios) + deallocate(this%k_decay) + deallocate(this%scal_f) + deallocate(this%conv_f) + deallocate(this%conc_f) + + end subroutine DDeallocate + !------------------------------------------------------------------------------- + + subroutine AAssign(this, cn_r,cp_r, k_d, n2_n2o_r_denit, cell_sand, cell_clay, & + plant_froots, betrtracer_vars, gas2bulkcef, aere_cond, tracer_conc_atm) + ! + ! !DESCRIPTION: + ! assign member values for the data type specified by this + ! !USES: + use BeTRTracerType , only : betrtracer_type + ! !ARGUMENTS: + class(Extra_type) :: this + real(r8), dimension(:), intent(in) :: cn_r + real(r8), dimension(:), intent(in) :: cp_r + real(r8), dimension(:), intent(in) :: k_d + real(r8) , intent(in) :: n2_n2o_r_denit + real(r8) , intent(in) :: cell_sand + real(r8) , intent(in) :: cell_clay + real(r8) , intent(in) :: plant_froots + type(BeTRtracer_type ), intent(in) :: betrtracer_vars + real(r8) , intent(in) :: gas2bulkcef(1:betrtracer_vars%nvolatile_tracers) + real(r8) , intent(in) :: aere_cond(1:betrtracer_vars%nvolatile_tracers) + real(r8) , intent(in) :: tracer_conc_atm(1:betrtracer_vars%nvolatile_tracers) + + ! !LOCAL VARIABLES: + integer :: n1, n2, n3, j + + n1 = size(cn_r) + n2 = size(cp_r) + n3 = size(k_d) + SHR_ASSERT_ALL((n1 == n2), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((n3 == this%nr), errMsg(__FILE__,__LINE__)) + this%cn_ratios(1:n1) = cn_r + this%cp_ratios(1:n2) = cp_r + + this%n2_n2o_ratio_denit = n2_n2o_r_denit + this%pct_sand = cell_sand + this%pct_clay = cell_clay + this%k_decay = k_d + this%plant_frts = plant_froots + + do j = 1, betrtracer_vars%ngwmobile_tracers + if(j == betrtracer_vars%id_trc_o2)then + this%scal_f(centurybgc_vars%lid_o2) = aere_cond(betrtracer_vars%volatileid(j)) + this%conc_f(centurybgc_vars%lid_o2) = tracer_conc_atm(betrtracer_vars%volatileid(j)) + this%conv_f(centurybgc_vars%lid_o2) = 1._r8/gas2bulkcef(betrtracer_vars%volatileid(j)) + + elseif(j == betrtracer_vars%id_trc_n2)then + this%scal_f(centurybgc_vars%lid_n2) = aere_cond(betrtracer_vars%volatileid(j)) + this%conc_f(centurybgc_vars%lid_n2) = tracer_conc_atm(betrtracer_vars%volatileid(j)) + this%conv_f(centurybgc_vars%lid_n2) = 1._r8/gas2bulkcef(betrtracer_vars%volatileid(j)) + + elseif(j == betrtracer_vars%id_trc_ar)then + this%scal_f(centurybgc_vars%lid_ar) = aere_cond(betrtracer_vars%volatileid(j)) + this%conc_f(centurybgc_vars%lid_ar) = tracer_conc_atm(betrtracer_vars%volatileid(j)) + this%conv_f(centurybgc_vars%lid_ar) = 1._r8/gas2bulkcef(betrtracer_vars%volatileid(j)) + + elseif(j==betrtracer_vars%id_trc_co2x)then + this%scal_f(centurybgc_vars%lid_co2) = aere_cond(betrtracer_vars%volatileid(j)) + this%conc_f(centurybgc_vars%lid_co2) = tracer_conc_atm(betrtracer_vars%volatileid(j)) + this%conv_f(centurybgc_vars%lid_co2) = 1._r8/gas2bulkcef(betrtracer_vars%volatileid(j)) + + elseif(j==betrtracer_vars%id_trc_ch4) then + this%scal_f(centurybgc_vars%lid_ch4) = aere_cond(betrtracer_vars%volatileid(j)) + this%conc_f(centurybgc_vars%lid_ch4) = tracer_conc_atm(betrtracer_vars%volatileid(j)) + this%conv_f(centurybgc_vars%lid_ch4) = 1._r8/gas2bulkcef(betrtracer_vars%volatileid(j)) + + elseif(j==betrtracer_vars%id_trc_n2o) then + this%scal_f(centurybgc_vars%lid_n2o) = aere_cond(betrtracer_vars%volatileid(j)) + this%conc_f(centurybgc_vars%lid_n2o) = tracer_conc_atm(betrtracer_vars%volatileid(j)) + this%conv_f(centurybgc_vars%lid_n2o) = 1._r8/gas2bulkcef(betrtracer_vars%volatileid(j)) + endif + enddo + end subroutine AAssign + + !------------------------------------------------------------------------------- + type(bgc_reaction_CENTURY_ECA_type) function constructor() + ! + ! ! DESCRIPTION: + ! + ! create an object of type bgc_reaction_CENTURY_ECA_type. + ! Right now it is purposely empty + + end function constructor + + + !------------------------------------------------------------------------------- + subroutine init_boundary_condition_type(this, bounds, betrtracer_vars, tracerboundarycond_vars ) + ! + ! DESCRIPTION: + ! initialize boundary condition types + ! !USES: + use TracerBoundaryCondType , only : tracerboundarycond_type + use BeTRTracerType , only : betrtracer_type + + ! !ARGUMENTS: + class(bgc_reaction_CENTURY_ECA_type), intent(in) :: this + type(bounds_type) , intent(in) :: bounds + type(BeTRtracer_type ) , intent(in) :: betrtracer_vars + type(tracerboundarycond_type) , intent(in) :: tracerboundarycond_vars + + + ! !LOCAL VARIABLES: + integer :: c + + + associate( & + groupid => betrtracer_vars%groupid & + ) + + tracerboundarycond_vars%topbc_type(1:betrtracer_vars%ngwmobile_tracer_groups) = bndcond_as_conc + tracerboundarycond_vars%topbc_type(groupid(betrtracer_vars%id_trc_no3x)) = bndcond_as_flux + + tracerboundarycond_vars%topbc_type(betrtracer_vars%ngwmobile_tracer_groups+1:betrtracer_vars%ntracer_groups) = bndcond_as_flux + + end associate + end subroutine init_boundary_condition_type + + !------------------------------------------------------------------------------- + + subroutine Init_betrbgc(this, bounds, lbj, ubj, betrtracer_vars) + ! + ! DESCRIPTION: + ! initialize the betrbgc + ! + ! !USES: + use CNSharedParamsMod , only : CNParamsReadShared + use ncdio_pio , only : file_desc_t + use BeTRTracerType , only : betrtracer_type + use MathfuncMod , only : addone + use clm_varctl , only : cnallocate_carbon_only_set + + ! !ARGUMENTS: + class(bgc_reaction_CENTURY_ECA_type) , intent(in) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: lbj, ubj ! lower and upper bounds, make sure they are > 0 + type(BeTRtracer_type ) , intent(inout) :: betrtracer_vars ! + + ! !LOCAL VARIABLES: + character(len=32), parameter :: subname ='Init_betrbgc' + integer :: jj + integer :: nelm, itemp_mem + integer :: itemp, itemp_vgrp, itemp_v, itemp_grp + integer :: c_loc, n_loc, trcid + logical :: carbon_only = .false. + + call cnallocate_carbon_only_set(carbon_only) + call centurybgc_vars%Init(bounds, lbj, ubj) + + nelm =centurybgc_vars%nelms + c_loc=centurybgc_vars%c_loc + n_loc=centurybgc_vars%n_loc + + itemp = 0 + betrtracer_vars%id_trc_n2 = addone(itemp) + betrtracer_vars%id_trc_o2 = addone(itemp) + betrtracer_vars%id_trc_ar = addone(itemp) + betrtracer_vars%id_trc_co2x = addone(itemp) + betrtracer_vars%id_trc_ch4 = addone(itemp) + betrtracer_vars%id_trc_nh3x = addone(itemp) + betrtracer_vars%id_trc_no3x = addone(itemp) + betrtracer_vars%id_trc_n2o = addone(itemp) + + betrtracer_vars%ngwmobile_tracer_groups = itemp ! n2, o2, ar, co2, ch4, n2o, nh3x and no3x + betrtracer_vars%ngwmobile_tracers = itemp + betrtracer_vars%nvolatile_tracers = itemp-2 ! n2, o2, ar, co2, ch4 and n2o + betrtracer_vars%nvolatile_tracer_groups = itemp-2 ! + betrtracer_vars%nsolid_passive_tracer_groups = 4 ! som1, som2, som3 and others (lit1, lit2, lit3, cwd) + betrtracer_vars%nsolid_passive_tracers = centurybgc_vars%nom_pools*nelm ! + + betrtracer_vars%nmem_max = nelm*4 ! total number of elemnts, and 4 sub members (lit1, lit2, lit3, cwd) + + call betrtracer_vars%Init() + + betrtracer_vars%is_mobile(:) = .true. + + jj = itemp + itemp_vgrp = 0 !counter for volatile groups + itemp_v = 0 !counter for volatile tracers + itemp_grp = 0 !counter for tracer groups + + trcid = betrtracer_vars%id_trc_n2 + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_n2, trc_name='N2' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_o2, trc_name='O2' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_ar, trc_name='AR' , & + is_trc_mobile=.false., is_trc_advective = .false., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_co2x, trc_name='CO2x', & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = addone(itemp_grp) , & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_ch4, trc_name='CH4' , & + is_trc_mobile=.false., is_trc_advective = .false., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_nh3x, trc_name='NH3x', & + is_trc_mobile=.false., is_trc_advective = .false., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.false.) + + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_no3x, trc_name='NO3x', & + is_trc_mobile=.true., is_trc_advective = .true., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.false.,trc_vtrans_scal=1._r8) + + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_n2o, trc_name='N2O' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + !------------------------------------------------------------------------------------ + itemp_mem=0 + itemp_grp=addone(itemp_grp) !only one group passive solid litter tracers + trcid = jj+(centurybgc_vars%lit1-1)*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='LIT1C' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%lit1-1)*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='LIT1N' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + !------------------------------------------------------------------------------------ + + trcid = jj+(centurybgc_vars%lit2-1)*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='LIT2C' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%lit2-1)*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='LIT2N' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + !------------------------------------------------------------------------------------ + + trcid = jj+(centurybgc_vars%lit3-1)*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='LIT3C' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%lit3-1)*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='LIT3N' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + !------------------------------------------------------------------------------------ + + trcid = jj+(centurybgc_vars%cwd-1 )*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='CWDC' , & + is_trc_mobile=.false., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%cwd-1 )*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='CWDN' , & + is_trc_mobile=.false., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + !========================================================================================== + !new group + itemp_mem = 0 + itemp_grp = addone(itemp_grp) + trcid = jj+(centurybgc_vars%som1-1)*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='SOM1C' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp , & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%som1-1)*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='SOM1N' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + !------------------------------------------------------------------------------------ + !new group + itemp_mem=0 + itemp_grp = addone(itemp_grp) + trcid = jj+(centurybgc_vars%som2-1)*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='SOM2C' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp , & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%som2-1)*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='SOM2N' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + !------------------------------------------------------------------------------------ + !new group + itemp_mem=0 + itemp_grp = addone(itemp_grp) + trcid = jj+(centurybgc_vars%som3-1)*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='SOM3C' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%som3-1)*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='SOM3N' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + + end subroutine Init_betrbgc + + !------------------------------------------------------------------------------- + subroutine set_boundary_conditions(this, bounds, num_soilc, filter_soilc, dz_top, betrtracer_vars, & + waterflux_vars, tracerboundarycond_vars) + ! + ! !DESCRIPTION: + ! set up boundary conditions for tracer movement + ! + ! !USES: + use TracerBoundaryCondType, only : tracerboundarycond_type + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + use BeTRTracerType , only : betrtracer_type + use WaterfluxType , only : waterflux_type + + ! !ARGUMENTS: + class(bgc_reaction_CENTURY_ECA_type) , intent(in) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of columns in column filter + integer , intent(in) :: filter_soilc(:) ! column filter + type(betrtracer_type) , intent(in) :: betrtracer_vars + real(r8) , intent(in) :: dz_top(bounds%begc: ) + type(waterflux_type) , intent(in) :: waterflux_vars + type(tracerboundarycond_type) , intent(inout) :: tracerboundarycond_vars ! + + ! !LOCAL VARIABLES: + character(len=255) :: subname = 'set_boundary_conditions' + integer :: fc, c + + SHR_ASSERT_ALL((ubound(dz_top) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + + associate( & + groupid => betrtracer_vars%groupid & + ) + + do fc = 1, num_soilc + c = filter_soilc(fc) + + !values below will be updated with datastream + !eventually, the following code will be implemented using polymorphism + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%ngwmobile_tracers+1:betrtracer_vars%ntracers) =0._r8 !zero incoming flux + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_n2) =32.8_r8 !mol m-3, contant boundary condition + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_o2) =8.78_r8 !mol m-3, contant boundary condition + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_ar) =0.3924_r8 !mol m-3, contant boundary condition + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_co2x) =0.0168_r8 !mol m-3, contant boundary condition + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_ch4) =6.939e-5_r8 !mol m-3, contant boundary condition + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_n2o) =1.195e-5_r8 !mol m-3, contant boundary condition + + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_no3x) = 0._r8 + tracerboundarycond_vars%bot_concflux_col(c,1,:) = 0._r8 !zero flux boundary condition + !those will be updated with snow resistance and hydraulic wicking resistance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_n2)) = 2._r8*1.267e-5_r8/dz_top(c) !m/s surface conductance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_o2)) = 2._r8*1.267e-5_r8/dz_top(c) !m/s surface conductance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_ar)) = 2._r8*1.267e-5_r8/dz_top(c) !m/s surface conductance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_co2x)) = 2._r8*1.267e-5_r8/dz_top(c) !m/s surface conductance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_ch4)) = 2._r8*1.267e-5_r8/dz_top(c) !m/s surface conductance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_n2o)) = 2._r8*1.267e-5_r8/dz_top(c) !m/s surface conductance + enddo + end associate + end subroutine set_boundary_conditions + !------------------------------------------------------------------------------- + + subroutine calc_bgc_reaction(this, bounds, lbj, ubj, num_soilc, filter_soilc, num_soilp, filter_soilp, jtops, dtime, & + betrtracer_vars, tracercoeff_vars, waterstate_vars, temperature_vars, soilstate_vars, chemstate_vars, & + cnstate_vars, carbonstate_vars, carbonflux_vars, nitrogenstate_vars, nitrogenflux_vars, tracerstate_vars, & + tracerflux_vars, plantsoilnutrientflux_vars) + ! + ! !DESCRIPTION: + ! do bgc reaction + ! this returns net carbon fluxes from decay and translocation + ! and also update the related carbon/nitrogen/phosphorus(potentially) pools of OM + ! note it is assumed the stoichiometry of the om pools are not changed during decomposition + ! + ! !USES: + ! + use tracerfluxType , only : tracerflux_type + use tracerstatetype , only : tracerstate_type + use tracercoeffType , only : tracercoeff_type + use BetrTracerType , only : betrtracer_type + use WaterStateType , only : Waterstate_Type + use TemperatureType , only : temperature_type + use ChemStateType , only : chemstate_type + use SoilStatetype , only : soilstate_type + use ODEMod , only : ode_ebbks1 + use CNStateType , only : cnstate_type + use PlantSoilnutrientFluxType, only : plantsoilnutrientflux_type + use CNVerticalProfileMod , only : decomp_vertprofiles + use CNCarbonStateType , only : carbonstate_type + use CNCarbonFluxType , only : carbonflux_type + use CNNitrogenFluxType , only : nitrogenflux_type + use CNNitrogenStateType , only : nitrogenstate_type + ! !ARGUMENTS + class(bgc_reaction_CENTURY_ECA_type) , intent(in) :: this + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_soilc ! number of columns in column filter + integer , intent(in) :: filter_soilc(:) ! column filter + integer , intent(in) :: num_soilp + integer , intent(in) :: filter_soilp(:) ! pft filter + integer , intent(in) :: jtops(bounds%begc: ) ! top index of each column + integer , intent(in) :: lbj, ubj ! lower and upper bounds, make sure they are > 0 + real(r8) , intent(in) :: dtime ! model time step + type(Waterstate_Type) , intent(in) :: waterstate_vars ! water state variables + type(temperature_type) , intent(in) :: temperature_vars ! energy state variable + type(soilstate_type) , intent(in) :: soilstate_vars + type(chemstate_type) , intent(in) :: chemstate_vars + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(tracercoeff_type) , intent(in) :: tracercoeff_vars + type(carbonstate_type) , intent(in) :: carbonstate_vars + type(cnstate_type) , intent(inout) :: cnstate_vars + type(carbonflux_type) , intent(inout) :: carbonflux_vars + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + type(tracerstate_type) , intent(inout) :: tracerstate_vars + type(tracerflux_type) , intent(inout) :: tracerflux_vars + type(plantsoilnutrientflux_type) , intent(inout) :: plantsoilnutrientflux_vars ! + + ! !LOCAL VARIABLES: + character(len=32), parameter :: subname ='calc_bgc_reaction' + integer :: fc, c, j, k + real(r8) :: time + real(r8) :: y0(centurybgc_vars%nstvars, bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: yf(centurybgc_vars%nstvars, bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: cn_ratios(centurybgc_vars%nom_pools, bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: cp_ratios(centurybgc_vars%nom_pools, bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: k_decay(centurybgc_vars%nreactions, bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: pot_decay_rates(centurybgc_vars%nom_pools, bounds%begc:bounds%endc, lbj:ubj) ![mol C/m3/s] potential decay rates for different om pools without nutrient limitation + real(r8) :: pot_co2_hr(bounds%begc:bounds%endc, lbj:ubj) ![mol C/m3/s], potential co2 respiration rate + real(r8) :: pot_nh3_immob(bounds%begc:bounds%endc,lbj:ubj) + real(r8) :: anaerobic_frac(bounds%begc:bounds%endc,lbj:ubj) + real(r8) :: n2_n2o_ratio_denit(bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: nh4_no3_ratio(bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: nuptake_prof(bounds%begc:bounds%endc,1:ubj) + real(r8) :: pscal + + SHR_ASSERT_ALL((ubound(jtops) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + + call Extra_inst%Init_Allocate(centurybgc_vars%nom_pools, centurybgc_vars%nreactions, centurybgc_vars%nprimvars) + + call set_reaction_order( centurybgc_vars%nreactions, centurybgc_vars, Extra_inst%is_zero_order) + + !initialize local variables + y0(:, :, :) = spval + yf(:, :, :) = spval + cn_ratios(:,:,:) = nan + cp_ratios(:,:,:) = nan + + !initialize the state vector + call init_state_vector(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, & + centurybgc_vars%nstvars, tracerstate_vars, betrtracer_vars, centurybgc_vars, y0) + + !update the initial vector from external input + !calculate elemental stoichiometry for different om pools and add mineral nutrient input from other than decaying process + + + call bgcstate_ext_update_bfdecomp(bounds, 1, ubj, num_soilc, filter_soilc, & + carbonflux_vars, nitrogenflux_vars, centurybgc_vars, betrtracer_vars, tracerflux_vars, y0, cn_ratios, cp_ratios) + + !calculate nitrogen uptake profile + call calc_nuptake_prof(bounds, ubj, num_soilc, filter_soilc, & + tracerstate_vars%tracer_conc_mobile_col(bounds%begc:bounds%endc, 1:ubj, betrtracer_vars%id_trc_nh3x), & + tracerstate_vars%tracer_conc_mobile_col(bounds%begc:bounds%endc, 1:ubj, betrtracer_vars%id_trc_no3x), & + col%dz(bounds%begc:bounds%endc,1:ubj), cnstate_vars%nfixation_prof_col(bounds%begc:bounds%endc,1:ubj), & + nuptake_prof(bounds%begc:bounds%endc,1:ubj)) + + !update plant nitrogen uptake potential + + call plantsoilnutrientflux_vars%calc_nutrient_uptake_potential(bounds, num_soilc, filter_soilc, num_soilp, & + filter_soilp, carbonstate_vars%frootc_patch) + + !calculate multiplicative scalars for decay parameters + call calc_decompK_multiply_scalar(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, & + waterstate_vars%finundated_col(bounds%begc:bounds%endc), col%z(bounds%begc:bounds%endc, lbj:ubj), & + temperature_vars%t_soisno_col(bounds%begc:bounds%endc, lbj:ubj), & + tracerstate_vars%tracer_conc_mobile_col(bounds%begc:bounds%endc, lbj:ubj, betrtracer_vars%id_trc_o2), & + tracercoeff_vars%aqu2bulkcef_mobile_col(bounds%begc:bounds%endc, lbj:ubj, betrtracer_vars%id_trc_o2), & + soilstate_vars, centurybgc_vars, carbonflux_vars) + + !calculate decay coefficients + call calc_som_deacyK(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, centurybgc_vars%nom_pools, & + tracercoeff_vars, tracerstate_vars, betrtracer_vars, centurybgc_vars, carbonflux_vars,dtime, & + k_decay(1:centurybgc_vars%nom_pools, bounds%begc:bounds%endc, lbj:ubj)) + + !calculate potential decay rates, without nutrient constraint + call calc_sompool_decay(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, centurybgc_vars, & + k_decay(1:centurybgc_vars%nom_pools, bounds%begc:bounds%endc, lbj:ubj), & + y0(1:centurybgc_vars%nom_totelms, bounds%begc:bounds%endc, lbj:ubj), & + pot_decay_rates) + + !calculate potential respiration rates by summarizing all om decomposition pathways + call calc_potential_aerobic_hr(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, cn_ratios, cp_ratios, & + centurybgc_vars, pot_decay_rates, soilstate_vars%cellsand_col(bounds%begc:bounds%endc,lbj:ubj), & + pot_co2_hr, pot_nh3_immob) + + !calculate fraction of anerobic environment + call calc_anaerobic_frac(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, & + temperature_vars%t_soisno_col(bounds%begc:bounds%endc,lbj:ubj), & + soilstate_vars, waterstate_vars%h2osoi_vol_col(bounds%begc:bounds%endc,lbj:ubj), & + pot_co2_hr, & + tracerstate_vars%tracer_conc_mobile_col(bounds%begc:bounds%endc, lbj:ubj, betrtracer_vars%id_trc_o2), & + anaerobic_frac(bounds%begc:bounds%endc, lbj:ubj)) + + !calculate normalized rate for nitrification and denitrification + call calc_nitrif_denitrif_rate(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, & + col%dz(bounds%begc:bounds%endc, lbj:ubj), & + temperature_vars%t_soisno_col(bounds%begc:bounds%endc, lbj:ubj), & + chemstate_vars%soil_pH(bounds%begc:bounds%endc, lbj:ubj), & + pot_co2_hr, & + anaerobic_frac, & + tracerstate_vars%tracer_conc_mobile_col(bounds%begc:bounds%endc, lbj:ubj, betrtracer_vars%id_trc_nh3x), & + tracerstate_vars%tracer_conc_mobile_col(bounds%begc:bounds%endc, lbj:ubj, betrtracer_vars%id_trc_no3x), & + soilstate_vars, & + waterstate_vars, & + carbonflux_vars, & + n2_n2o_ratio_denit, & + nh4_no3_ratio, & + k_decay(centurybgc_vars%lid_nh4_nit_reac, bounds%begc:bounds%endc, lbj:ubj), & + k_decay(centurybgc_vars%lid_no3_den_reac, bounds%begc:bounds%endc, lbj:ubj)) + + !now there is no plant nitrogen uptake, I tend to create a new structure to indicate plant nutrient demand when it is hooked + !back with CLM + + call calc_plant_nitrogen_uptake_prof(bounds, ubj, num_soilc, filter_soilc, col%dz(bounds%begc:bounds%endc, lbj:ubj), & + plantsoilnutrientflux_vars%plant_minn_uptake_potential_col(bounds%begc:bounds%endc), & + nuptake_prof(bounds%begc:bounds%endc,1:ubj), & + k_decay(centurybgc_vars%lid_plant_minn_up_reac, bounds%begc:bounds%endc ,1:ubj)) + + !apply root distribution here + call apply_plant_root_respiration_prof(bounds, ubj, num_soilc, filter_soilc, & + carbonflux_vars%rr_col(bounds%begc:bounds%endc), cnstate_vars%nfixation_prof_col(bounds%begc:bounds%endc,1:ubj), & + k_decay(centurybgc_vars%lid_at_rt_reac, bounds%begc:bounds%endc, 1:ubj)) + + call apply_plant_root_nuptake_prof(bounds, ubj, num_soilc, filter_soilc , & + cnstate_vars%nfixation_prof_col(bounds%begc:bounds%endc,1:ubj) , & + plantsoilnutrientflux_vars) + + !do ode integration and update state variables for each layer + + do j = lbj, ubj + do fc = 1, num_soilc + c = filter_soilc(fc) + if(j betrtracer_vars%volatileid & + ) + + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if (lun%ifspecial(l)) then + if(betrtracer_vars%ngwmobile_tracers>0)then + tracerstate_vars%tracer_conc_mobile_col(c,:,:) = spval + tracerstate_vars%tracer_conc_surfwater_col(c,:) = spval + tracerstate_vars%tracer_conc_aquifer_col(c,:) = spval + tracerstate_vars%tracer_conc_grndwater_col(c,:) = spval + tracerstate_vars%tracer_conc_atm_col(c,:) = spval + endif + if(betrtracer_vars%ntracers > betrtracer_vars%ngwmobile_tracers)then + tracerstate_vars%tracer_conc_solid_passive_col(c,:,:) = spval + endif + if(betrtracer_vars%nsolid_equil_tracers>0)then + tracerstate_vars%tracer_conc_solid_equil_col(c, :, :) = spval + endif + endif + tracerstate_vars%tracer_soi_molarmass_col(c,:) = spval + + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + !dual phase tracers + + tracerstate_vars%tracer_conc_mobile_col (c,:, : ) = 0._r8 + tracerstate_vars%tracer_conc_surfwater_col (c,: ) = 0._r8 + tracerstate_vars%tracer_conc_aquifer_col (c,: ) = 0._r8 + tracerstate_vars%tracer_conc_grndwater_col (c,: ) = 0._r8 + tracerstate_vars%tracer_conc_atm_col (c,volatileid(betrtracer_vars%id_trc_n2 )) = 32.8_r8 + tracerstate_vars%tracer_conc_atm_col (c,volatileid(betrtracer_vars%id_trc_o2 )) = 8.78_r8 + tracerstate_vars%tracer_conc_atm_col (c,volatileid(betrtracer_vars%id_trc_ar )) = 0.3924_r8 + tracerstate_vars%tracer_conc_atm_col (c,volatileid(betrtracer_vars%id_trc_co2x )) = 0.0168_r8 + tracerstate_vars%tracer_conc_atm_col (c,volatileid(betrtracer_vars%id_trc_ch4 )) = 6.939e-5_r8 + tracerstate_vars%tracer_conc_atm_col (c,volatileid(betrtracer_vars%id_trc_n2o )) = 1.195e-5_r8 + + !solid tracers + if(betrtracer_vars%ngwmobile_tracers < betrtracer_vars%ntracers)then + tracerstate_vars%tracer_conc_solid_passive_col(c,:,:) = 0._r8 + endif + + if(betrtracer_vars%nsolid_equil_tracers>0)then + tracerstate_vars%tracer_conc_solid_equil_col(c, :, :) = 0._r8 + endif + tracerstate_vars%tracer_soi_molarmass_col(c,:) = 0._r8 + endif + enddo + end associate + end subroutine InitCold + + !-------------------------------------------------------------------------------------------------------------------- + subroutine betr_alm_flux_statevar_feedback(this, bounds, num_soilc, filter_soilc, & + carbonstate_vars, nitrogenstate_vars, nitrogenflux_vars, tracerstate_vars, & + tracerflux_vars, betrtracer_vars) + + ! + ! !DESCRIPTION: + ! do state and flux variable exchange between betr and alm + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use tracerfluxType , only : tracerflux_type + use tracerstatetype , only : tracerstate_type + use decompMod , only : bounds_type + use BeTRTracerType , only : BeTRTracer_Type + use CNCarbonStateType , only : carbonstate_type + use CNNitrogenStateType , only : nitrogenstate_type + use CNNitrogenFluxType , only : nitrogenflux_type + + + ! !ARGUMENTS: + class(bgc_reaction_CENTURY_ECA_type) , intent(in) :: this + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_soilc ! number of columns in column filter + integer , intent(in) :: filter_soilc(:) ! column filter + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(tracerstate_type) , intent(in) :: tracerstate_vars + type(tracerflux_type) , intent(in) :: tracerflux_vars + type(carbonstate_type) , intent(inout) :: carbonstate_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars + + + call assign_nitrogen_hydroloss(bounds, num_soilc, filter_soilc, & + tracerflux_vars, nitrogenflux_vars, betrtracer_vars) + + call assign_OM_CNpools(bounds, num_soilc, filter_soilc, & + carbonstate_vars, nitrogenstate_vars, tracerstate_vars, betrtracer_vars, centurybgc_vars) + + end subroutine betr_alm_flux_statevar_feedback + + !--------------------------------------------------------------- + subroutine init_betr_alm_bgc_coupler(this, bounds, carbonstate_vars, & + nitrogenstate_vars, betrtracer_vars, tracerstate_vars) + ! + ! !DESCRIPTION: + ! do state variable exchange between betr and alm + ! !USES: + use clm_varcon , only : natomw, catomw + use clm_varpar , only : i_cwd, i_met_lit, i_cel_lit, i_lig_lit + use CNCarbonStateType , only : carbonstate_type + use CNNitrogenStateType , only : nitrogenstate_type + use tracerstatetype , only : tracerstate_type + use BetrTracerType , only : betrtracer_type + use clm_varpar , only : nlevtrc_soil + use landunit_varcon , only : istsoil, istcrop + + ! !ARGUMENTS: + class(bgc_reaction_CENTURY_ECA_type) , intent(in) :: this + type(bounds_type) , intent(in) :: bounds + type(tracerstate_type) , intent(inout) :: tracerstate_vars + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(carbonstate_type) , intent(in) :: carbonstate_vars + type(nitrogenstate_type) , intent(in) :: nitrogenstate_vars + + ! !LOCAL VARIABLES: + integer, parameter :: i_soil1 = 5 + integer, parameter :: i_soil2 = 6 + integer, parameter :: i_soil3 = 7 + character(len=255) :: subname = 'init_betr_alm_bgc_coupler' + integer :: c, j, k, l + + associate( & + id_trc_no3x => betrtracer_vars%id_trc_no3x , & + id_trc_nh3x => betrtracer_vars%id_trc_nh3x , & + decomp_cpools_vr => carbonstate_vars%decomp_cpools_vr_col , & + decomp_npools_vr => nitrogenstate_vars%decomp_npools_vr_col , & + smin_no3_vr_col => nitrogenstate_vars%smin_no3_vr_col , & + smin_nh4_vr_col => nitrogenstate_vars%smin_nh4_vr_col , & + tracer_conc_mobile => tracerstate_vars%tracer_conc_mobile_col , & + tracer_conc_solid_passive => tracerstate_vars%tracer_conc_solid_passive_col , & + c_loc => centurybgc_vars%c_loc , & + n_loc => centurybgc_vars%n_loc , & + lit1 => centurybgc_vars%lit1 , & + lit2 => centurybgc_vars%lit2 , & + lit3 => centurybgc_vars%lit3 , & + som1 => centurybgc_vars%som1 , & + som2 => centurybgc_vars%som2 , & + som3 => centurybgc_vars%som3 , & + cwd => centurybgc_vars%cwd , & + nelms => centurybgc_vars%nelms & + ) + + !initialize tracer based on carbon/nitrogen pools + do j = 1, nlevtrc_soil + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + tracer_conc_mobile(c,j,id_trc_no3x)=smin_no3_vr_col(c,j) /natomw + tracer_conc_mobile(c,j,id_trc_nh3x)=smin_nh4_vr_col(c,j) /natomw + k = lit1; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_met_lit) / catomw + k = lit2; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_cel_lit) / catomw + k = lit3; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_lig_lit) / catomw + k = cwd ; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_cwd ) / catomw + k = som1; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_soil1 ) / catomw + k = som2; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_soil2 ) / catomw + k = som3; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_soil3 ) / catomw + + k = lit1; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_met_lit) / natomw + k = lit2; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_cel_lit) / natomw + k = lit3; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_lig_lit) / natomw + k = cwd ; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_cwd ) / natomw + k = som1; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_soil1 ) / natomw + k = som2; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_soil2 ) / natomw + k = som3; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_soil3 ) / natomw + endif + enddo + enddo + end associate + end subroutine init_betr_alm_bgc_coupler + + !------------------------------------------------------------------------------- + + + subroutine one_box_century_bgc(ystate, dtime, time, nprimvars, nstvars, dydt) + ! + ! !DESCRIPTION: + ! do single box bgc + ! + ! the equations to be solved are in the form + ! + ! dx/dt=I+A*R, where I is the input, A is the stoichiometric matrix, and R is the reaction vector + ! + ! the input only contains litter input and mineral nutrient, som is assumed to be of fixed stoichiometry + ! !USES: + use SOMStateVarUpdateMod , only : calc_dtrend_som_bgc + use BGCCenturySubMod , only : calc_cascade_matrix + use MathfuncMod , only : pd_decomp + implicit none + ! + ! !ARGUMENTS: + integer, intent(in) :: nstvars + integer, intent(in) :: nprimvars + real(r8), intent(in) :: dtime + real(r8), intent(in) :: time + real(r8), intent(in) :: ystate(nstvars) + real(r8), intent(out) :: dydt(nstvars) + + ! !LOCAL VARIABLES: + integer :: lk, jj + real(r8) :: cascade_matrix(nstvars, Extra_inst%nr) + real(r8) :: cascade_matrixp(nprimvars, Extra_inst%nr) + real(r8) :: cascade_matrixd(nprimvars, Extra_inst%nr) + logical :: nitrogen_limit_flag(centurybgc_vars%nom_pools) + real(r8) :: reaction_rates(Extra_inst%nr) + real(r8) :: pscal(1:nprimvars) + real(r8) :: rscal(1:Extra_inst%nr) + real(r8) :: p_dt(1:nprimvars) + real(r8) :: d_dt(1:nprimvars) + integer :: it + logical :: lneg + + !calculate cascade matrix, which contains the stoichiometry for all reactions + call calc_cascade_matrix(nstvars, Extra_inst%nr, Extra_inst%cn_ratios, Extra_inst%cp_ratios, & + Extra_inst%n2_n2o_ratio_denit, Extra_inst%pct_sand, centurybgc_vars, nitrogen_limit_flag, & + cascade_matrix) + + + !obtain reaction rates + do lk = 1, Extra_inst%nr + if(Extra_inst%is_zero_order(lk))then + + if ( spinup_state .eq. 1 ) then + !spinup stage + if(lk == centurybgc_vars%lid_o2_aere_reac)then + jj = centurybgc_vars%lid_o2 + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + !avoid excessive arenchyma o2 transport into the atmosphere + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + else + reaction_rates(lk) = Extra_inst%k_decay(lk) !this effective defines the plant nitrogen demand + endif + else + ! normal run stage + if(lk == centurybgc_vars%lid_o2_aere_reac)then + jj = centurybgc_vars%lid_o2 + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + !avoid excessive arenchyma o2 transport into the atmosphere + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + elseif(lk == centurybgc_vars%lid_ch4_aere_reac)then + jj = centurybgc_vars%lid_ch4 + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + !avoid excessive arenchyma ch4 transport into the atmosphere + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + elseif(lk == centurybgc_vars%lid_ar_aere_reac)then + jj = centurybgc_vars%lid_ar + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + !avoid excessive arenchyma ar transport into the atmosphere + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + elseif(lk == centurybgc_vars%lid_n2_aere_reac)then + jj = centurybgc_vars%lid_n2 + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + !avoid excessive arenchyma n2 transport into the atmosphere + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + elseif(lk == centurybgc_vars%lid_co2_aere_reac)then + jj = centurybgc_vars%lid_co2 + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + !avoid excessive arenchyma co2 transport into the atmosphere + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + elseif(lk == centurybgc_vars%lid_n2o_aere_reac)then + jj = centurybgc_vars%lid_n2o + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + !avoid excessive arenchyma n2o transport into the atmosphere + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + else + reaction_rates(lk) = Extra_inst%k_decay(lk) !this effective defines the plant nitrogen demand + endif + endif + + else + reaction_rates(lk)=ystate(centurybgc_vars%primvarid(lk))*Extra_inst%k_decay(lk) + endif + enddo + + call apply_ECA_nutrient_regulation(nprimvars, Extra_inst%nr, Extra_inst%pct_clay, nitrogen_limit_flag, ystate(1:nprimvars), & + Extra_inst%plant_frts, reaction_rates(1:Extra_inst%nr), cascade_matrix(1:nprimvars, 1:Extra_inst%nr)) + + call pd_decomp(nprimvars, Extra_inst%nr, cascade_matrix(1:nprimvars, 1:Extra_inst%nr), & + cascade_matrixp(1:nprimvars, 1:Extra_inst%nr), cascade_matrixd(1:nprimvars, 1:Extra_inst%nr)) + it=0 + do + call calc_dtrend_som_bgc(nprimvars, Extra_inst%nr, cascade_matrixp(1:nprimvars, 1:Extra_inst%nr), reaction_rates(1:Extra_inst%nr), p_dt) + + call calc_dtrend_som_bgc(nprimvars, Extra_inst%nr, cascade_matrixd(1:nprimvars, 1:Extra_inst%nr), reaction_rates(1:Extra_inst%nr), d_dt) + + + !update the state variables + call calc_pscal(nprimvars, dtime, ystate(1:nprimvars), p_dt(1:nprimvars), d_dt(1:nprimvars), pscal(1:nprimvars), lneg) + + if(lneg)then + + call calc_rscal(nprimvars, Extra_inst%nr, pscal, cascade_matrixd(1:nprimvars, 1:Extra_inst%nr), rscal) + + call reduce_reaction_rates(Extra_inst%nr, rscal(1:Extra_inst%nr), reaction_rates(1:Extra_inst%nr)) + else + exit + endif + it = it + 1 + if(it>100)then + write(iulog,*)'it',it + call endrun('too many iterations') + endif + enddo + + call calc_dtrend_som_bgc(nstvars, Extra_inst%nr, cascade_matrix(1:nstvars, 1:Extra_inst%nr), & + reaction_rates(1:Extra_inst%nr), dydt) + + end subroutine one_box_century_bgc + !------------------------------------------------------------------------------- + + subroutine calc_pscal(nprimvars, dtime, ystate, p_dt, d_dt, pscal, lneg) + ! + ! !DESCRIPTION: + ! calcualte limiting factor from each primary state variable + ! + implicit none + ! !ARGUMENTS: + integer, intent(in) :: nprimvars + real(r8), intent(in) :: dtime + real(r8), intent(in) :: ystate(1:nprimvars) + real(r8), intent(in) :: p_dt(1:nprimvars) + real(r8), intent(in) :: d_dt(1:nprimvars) + real(r8), intent(out) :: pscal(1:nprimvars) + logical, intent(out) :: lneg + + ! !LOCAL VARIABLES: + real(r8) :: yt + real(r8) :: bb=0.999_r8 + integer :: j + lneg =.false. + + do j = 1, nprimvars + yt = ystate(j) + (p_dt(j)+d_dt(j))*dtime + if(yt<0._r8)then + pscal(j) = -(p_dt(j)*dtime+ystate(j))/(dtime*d_dt(j))*bb + lneg=.true. + if(pscal(j)<0._r8)then + call endrun('ngeative p in calc_pscal') + endif + else + pscal(j) = 1._r8 + endif + enddo + end subroutine calc_pscal + + + + !------------------------------------------------------------------------------- + subroutine calc_rscal(nprimvars, nr, pscal, cascade_matrixd, rscal) + ! + ! !DESCRIPTION: + ! calcualte limiting factor for each reaction + ! !USES: + use MathfuncMod , only : minp + implicit none + ! !ARGUMENTS: + integer , intent(in) :: nprimvars + integer , intent(in) :: nr + real(r8), intent(in) :: pscal(1:nprimvars) + real(r8), intent(in) :: cascade_matrixd(1:nprimvars, 1:nr) + real(r8), intent(out):: rscal(1:nr) + + ! !LOCAL VARIABLES: + integer :: j + + do j = 1, nr + rscal(j) = minp(pscal,cascade_matrixd(1:nprimvars, j)) + enddo + + end subroutine calc_rscal + + !------------------------------------------------------------------------------- + subroutine reduce_reaction_rates(nr, rscal, reaction_rates) + ! + ! !DESCRIPTION: + ! reduce reaction rates using input scalar + ! + implicit none + ! !ARGUMENTS: + integer , intent(in) :: nr + real(r8), intent(in) :: rscal(1:nr) + real(r8), intent(inout) :: reaction_rates(1:nr) + ! !LOCAL VARIABLES: + integer :: j + + do j = 1, nr + reaction_rates(j) = reaction_rates(j)*rscal(j) + enddo + end subroutine reduce_reaction_rates + + !------------------------------------------------------------------------------- + subroutine apply_ECA_nutrient_regulation(nprimvars, nr, pct_clay, nitrogen_limit_flag, & + ystate, plant_frts, reaction_rates, cascade_matrix) + ! + ! !DESCRIPTION: + ! do ECA competition + ! + ! !USES: + use KineticsMod, only : kd_infty, ecacomplex_cell_norm + use MathfuncMod, only : safe_div + implicit none + ! !ARGUMENTS: + integer , intent(in) :: nprimvars + integer , intent(in) :: nr + real(r8), intent(in) :: pct_clay + logical , intent(in) :: nitrogen_limit_flag(centurybgc_vars%nom_pools) + real(r8), intent(in) :: ystate(1:nprimvars) + real(r8), intent(in) :: plant_frts + real(r8), intent(inout) :: reaction_rates(1:nr) + real(r8), intent(inout) :: cascade_matrix(1:nprimvars, 1:nr) + + ! !LOCAL VARIABLES: + real(r8) :: k_mat(2,1:centurybgc_vars%ncompets) + real(r8) :: vcompet(1:centurybgc_vars%ncompets) + real(r8) :: siej_cell_norm(2, 1:centurybgc_vars%ncompets) + real(r8) :: eca_nh4, eca_no3 + integer :: j + + ! the following parameters are arbitrary + real(r8), parameter :: kd_nh4_nit = 1._r8 + real(r8), parameter :: kd_nh4_plant = 1._r8 + real(r8), parameter :: kd_nh4_clay = 1._r8 + real(r8), parameter :: kd_no3_denit = 1._r8 + real(r8), parameter :: kd_no3_plant = 1._r8 + real(r8), parameter :: kd_nh4_decomp= 1._r8 + real(r8), parameter :: kd_no3_decomp= 1._r8 + + + !assume microbial biomass are 1% of the respective som pool + !assume the conversion factor between clay (%) and NH4 adorsption capacity is gamma + !also assume no competition between NH4 adsoprtion and other chemical adsorption + !nh4 adsoprtion follows linear isotherm + + associate( & + lid_nitri_compet => centurybgc_vars%lid_nitri_compet , & + lid_denit_compet => centurybgc_vars%lid_denit_compet , & + lid_plant_compet => centurybgc_vars%lid_plant_compet , & + lid_clay_compet => centurybgc_vars%lid_clay_compet , & + lid_lit1_compet => centurybgc_vars%lid_lit1_compet , & + lid_lit2_compet => centurybgc_vars%lid_lit2_compet , & + lid_lit3_compet => centurybgc_vars%lid_lit3_compet , & + lid_cwd_compet => centurybgc_vars%lid_cwd_compet , & + lid_som1_compet => centurybgc_vars%lid_som1_compet , & + lid_som2_compet => centurybgc_vars%lid_som2_compet , & + lid_som3_compet => centurybgc_vars%lid_som3_compet , & + lit1 => centurybgc_vars%lit1 , & + lit2 => centurybgc_vars%lit2 , & + lit3 => centurybgc_vars%lit3 , & + cwd => centurybgc_vars%cwd , & + som1 => centurybgc_vars%som1 , & + som2 => centurybgc_vars%som2 , & + som3 => centurybgc_vars%som3 , & + lid_nh4 => centurybgc_vars%lid_nh4 , & + lid_no3 => centurybgc_vars%lid_no3 , & + lid_nh4_nit_reac => centurybgc_vars%lid_nh4_nit_reac , & + lid_no3_den_reac => centurybgc_vars%lid_no3_den_reac , & + lid_plant_minn_up_reac=> centurybgc_vars%lid_plant_minn_up_reac , & + nelms => centurybgc_vars%nelms , & + c_loc => centurybgc_vars%c_loc & + ) + + !form the K matrix + + !nh4 + k_mat(1,:) = kd_infty + !no3 + k_mat(2,:) = kd_infty + vcompet=0._r8 + do j = 1, centurybgc_vars%nom_pools + if(nitrogen_limit_flag(j))then + k_mat(1,j) = kd_nh4_decomp + k_mat(2,j) = kd_no3_decomp + endif + enddo + + k_mat(1,lid_nitri_compet) = kd_nh4_nit + k_mat(1,lid_plant_compet) = kd_nh4_plant + k_mat(1,lid_clay_compet) = kd_nh4_clay + ! + k_mat(2,lid_denit_compet) = kd_no3_denit + k_mat(2,lid_plant_compet) = kd_no3_plant + + !form the competitor vector + vcompet(lid_lit1_compet) = ystate((lit1-1)*nelms+c_loc) * 0.01_r8 + vcompet(lid_lit2_compet) = ystate((lit2-1)*nelms+c_loc) * 0.01_r8 + vcompet(lid_lit3_compet) = ystate((lit3-1)*nelms+c_loc) * 0.01_r8 + vcompet(lid_cwd_compet) = ystate((cwd-1)*nelms+c_loc) * 0.01_r8 + + ! by default som decomposition releases mineral nutrient, but I include them as + ! subject to potential change + vcompet(lid_som1_compet) = ystate((som1-1)*nelms+c_loc) * 0.01_r8 + vcompet(lid_som2_compet) = ystate((som2-1)*nelms+c_loc) * 0.01_r8 + vcompet(lid_som3_compet) = ystate((som3-1)*nelms+c_loc) * 0.01_r8 + + vcompet(lid_nitri_compet)= ystate(lid_nh4) * 1.e-3_r8 !this number is arbitrary + vcompet(lid_plant_compet)= plant_frts + vcompet(lid_denit_compet)= ystate(lid_no3) * 1.e-3_r8 !this number is arbitrary + vcompet(lid_clay_compet) = 1._r8 + !form the resource vector + call ecacomplex_cell_norm(k_mat,(/ystate(lid_nh4),ystate(lid_no3)/),vcompet,siej_cell_norm) + + !now modify the reaction rates + do j = 1, centurybgc_vars%nom_pools + if(nitrogen_limit_flag(j))then + eca_nh4 = siej_cell_norm(1,j)/kd_nh4_decomp + eca_no3 = siej_cell_norm(2,j)/kd_no3_decomp + + reaction_rates(j) = reaction_rates(j) * (eca_nh4 + eca_no3) + cascade_matrix(lid_no3, j) = cascade_matrix(lid_nh4,j) * safe_div(eca_no3,eca_nh4+eca_no3) + cascade_matrix(lid_nh4, j) = cascade_matrix(lid_nh4, j) - cascade_matrix(lid_no3,j) + + endif + enddo + + !adjust for nitrification + reaction_rates(lid_nh4_nit_reac) = reaction_rates(lid_nh4_nit_reac) * siej_cell_norm(1,lid_nitri_compet) + !adjust for denitrification + reaction_rates(lid_no3_den_reac) = reaction_rates(lid_no3_den_reac) * siej_cell_norm(2,lid_denit_compet) + + !adjust for plant mineral nitrogen uptake + eca_nh4 = siej_cell_norm(1,lid_plant_compet)/kd_nh4_decomp + eca_no3 = siej_cell_norm(2,lid_plant_compet)/kd_no3_decomp + + + reaction_rates(lid_plant_compet) = reaction_rates(lid_plant_compet) * (eca_nh4+eca_no3) * vcompet(lid_plant_compet) + cascade_matrix(lid_no3, lid_plant_minn_up_reac) = cascade_matrix(lid_nh4, lid_plant_minn_up_reac) * & + safe_div(eca_no3, eca_nh4+eca_no3) + cascade_matrix(lid_nh4,lid_plant_minn_up_reac) = cascade_matrix(lid_nh4,lid_plant_minn_up_reac) - & + cascade_matrix(lid_no3, lid_plant_minn_up_reac) + + end associate + end subroutine apply_ECA_nutrient_regulation + +end module BGCReactionsCenturyECAType diff --git a/components/clm/src/betr/bgc_century/BGCReactionsCenturyType.F90 b/components/clm/src/betr/bgc_century/BGCReactionsCenturyType.F90 new file mode 100644 index 000000000000..37b76406c95e --- /dev/null +++ b/components/clm/src/betr/bgc_century/BGCReactionsCenturyType.F90 @@ -0,0 +1,1289 @@ +module BGCReactionsCenturyType + +#include "shr_assert.h" + + ! + ! !DESCRIPTION: + ! this code uses the operator automated down-regulation scheme described in Tang and Riley, 2015, BG + ! HISTORY: + ! Created by Jinyun Tang, Oct 2nd, 2014 + + ! !USES + ! + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varctl , only : iulog + use abortutils , only : endrun + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_time_manager , only : get_nstep + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use decompMod , only : bounds_type + use BGCReactionsMod , only : bgc_reaction_type + use clm_varcon , only : spval + use clm_varctl , only : spinup_state + use tracer_varcon , only : bndcond_as_conc, bndcond_as_flux + use BGCCenturySubMod + use BGCCenturySubCoreMod + use LandunitType , only : lun + use ColumnType , only : col + use GridcellType , only : grc + use landunit_varcon , only : istsoil, istcrop + implicit none + + save + private + ! + ! !PUBLIC TYPES: + public :: bgc_reaction_CENTURY_type + type(centurybgc_type), private :: centurybgc_vars + + !integer, private :: lpr + type, extends(bgc_reaction_type) :: & + bgc_reaction_CENTURY_type + private +contains + procedure :: Init_betrbgc ! initialize betr bgc + procedure :: set_boundary_conditions ! set top/bottom boundary conditions for various tracers + procedure :: calc_bgc_reaction ! doing bgc calculation + procedure :: init_boundary_condition_type ! initialize type of top boundary conditions + procedure :: do_tracer_equilibration ! do equilibrium tracer chemistry + procedure :: initCold + procedure :: readParams + procedure :: init_betr_alm_bgc_coupler ! update state vars using other bgc parts in alm + procedure :: betr_alm_flux_statevar_feedback ! +end type bgc_reaction_CENTURY_type + + +type, private :: Extra_type + real(r8), pointer :: cn_ratios(:) !cn ratio of om pool + real(r8), pointer :: cp_ratios(:) !cp ratio of om pool + real(r8), pointer :: k_decay(:) !decay parameter for all reactions + real(r8), pointer :: scal_f(:) !scaling factor for first order sink + real(r8), pointer :: conv_f(:) !converting factor for first order sink + real(r8), pointer :: conc_f(:) !external forcing strength + real(r8) :: n2_n2o_ratio_denit !ratio of n2 to n2o during denitrification + real(r8) :: cellsand !sand content + logical, pointer :: is_zero_order(:) + integer :: nr !number of reactions involved +contains + procedure, public :: Init_Allocate + procedure, public :: DDeallocate + procedure, public :: AAssign +end type Extra_type +type(Extra_type), private :: Extra_inst + + + interface bgc_reaction_CENTURY_type + module procedure constructor + end interface bgc_reaction_CENTURY_type + + +contains + + subroutine Init_Allocate(this, nompools, nreacts, nprimstvars) + + ! + ! !DESCRIPTION: + ! do memory allocation for the data type specified by this + ! + ! !ARGUMENTS: + class(Extra_type) :: this + + integer, intent(in) :: nompools + integer, intent(in) :: nreacts + integer, intent(in) :: nprimstvars !number of primary state variables + + allocate(this%cn_ratios(nompools)) + allocate(this%cp_ratios(nompools)) + allocate(this%k_decay(nreacts)) + allocate(this%scal_f(nprimstvars )); this%scal_f(:) = 0._r8 + allocate(this%conv_f(nprimstvars )); this%conv_f(:) = 0._r8 + allocate(this%conc_f(nprimstvars )); this%conc_f(:) = 0._r8 + allocate(this%is_zero_order(nreacts )); this%is_zero_order(:) = .false. + this%nr = nreacts + + end subroutine Init_Allocate + + !------------------------------------------------------------------------------- + + subroutine DDeallocate(this) + ! + ! !DESCRIPTION: + ! deallocate memory for the data type specified by this + ! !ARGUMENTS: + class(Extra_type) :: this + + + deallocate(this%cn_ratios) + deallocate(this%cp_ratios) + deallocate(this%k_decay) + deallocate(this%scal_f) + deallocate(this%conv_f) + deallocate(this%conc_f) + + end subroutine DDeallocate + !------------------------------------------------------------------------------- + + subroutine AAssign(this, cn_r,cp_r, k_d, n2_n2o_r_denit, cell_sand, & + betrtracer_vars, gas2bulkcef, aere_cond, tracer_conc_atm) + ! + ! !DESCRIPTION: + ! assign memmber values for the data type specified by this + ! !USES: + use BeTRTracerType , only : betrtracer_type + ! !ARGUMENTS: + class(Extra_type) :: this + real(r8), dimension(:), intent(in) :: cn_r + real(r8), dimension(:), intent(in) :: cp_r + real(r8), dimension(:), intent(in) :: k_d + real(r8) , intent(in) :: n2_n2o_r_denit + real(r8) , intent(in) :: cell_sand + type(BeTRtracer_type ), intent(in) :: betrtracer_vars + real(r8) , intent(in) :: gas2bulkcef(1:betrtracer_vars%nvolatile_tracers) + real(r8) , intent(in) :: aere_cond(1:betrtracer_vars%nvolatile_tracers) + real(r8) , intent(in) :: tracer_conc_atm(1:betrtracer_vars%nvolatile_tracers) + + ! !LOCAL VARIABLES: + integer :: n1, n2, n3, j + + + n1 = size(cn_r) + n2 = size(cp_r) + n3 = size(k_d) + + SHR_ASSERT_ALL((n1 == n2), errMsg(__FILE__,__LINE__)) + SHR_ASSERT_ALL((n3 == this%nr), errMsg(__FILE__,__LINE__)) + + this%cn_ratios(1:n1) = cn_r + this%cp_ratios(1:n2) = cp_r + this%n2_n2o_ratio_denit = n2_n2o_r_denit + this%cellsand = cell_sand + this%k_decay = k_d + + + do j = 1, betrtracer_vars%ngwmobile_tracers + if(j == betrtracer_vars%id_trc_o2)then + this%scal_f(centurybgc_vars%lid_o2) = aere_cond(betrtracer_vars%volatileid(j)) + this%conc_f(centurybgc_vars%lid_o2) = tracer_conc_atm(betrtracer_vars%volatileid(j)) + this%conv_f(centurybgc_vars%lid_o2) = 1._r8/gas2bulkcef(betrtracer_vars%volatileid(j)) + + elseif(j == betrtracer_vars%id_trc_n2)then + this%scal_f(centurybgc_vars%lid_n2) = aere_cond(betrtracer_vars%volatileid(j)) + this%conc_f(centurybgc_vars%lid_n2) = tracer_conc_atm(betrtracer_vars%volatileid(j)) + this%conv_f(centurybgc_vars%lid_n2) = 1._r8/gas2bulkcef(betrtracer_vars%volatileid(j)) + + elseif(j == betrtracer_vars%id_trc_ar)then + this%scal_f(centurybgc_vars%lid_ar) = aere_cond(betrtracer_vars%volatileid(j)) + this%conc_f(centurybgc_vars%lid_ar) = tracer_conc_atm(betrtracer_vars%volatileid(j)) + this%conv_f(centurybgc_vars%lid_ar) = 1._r8/gas2bulkcef(betrtracer_vars%volatileid(j)) + + elseif(j==betrtracer_vars%id_trc_co2x)then + this%scal_f(centurybgc_vars%lid_co2) = aere_cond(betrtracer_vars%volatileid(j)) + this%conc_f(centurybgc_vars%lid_co2) = tracer_conc_atm(betrtracer_vars%volatileid(j)) + this%conv_f(centurybgc_vars%lid_co2) = 1._r8/gas2bulkcef(betrtracer_vars%volatileid(j)) + + elseif(j==betrtracer_vars%id_trc_ch4) then + this%scal_f(centurybgc_vars%lid_ch4) = aere_cond(betrtracer_vars%volatileid(j)) + this%conc_f(centurybgc_vars%lid_ch4) = tracer_conc_atm(betrtracer_vars%volatileid(j)) + this%conv_f(centurybgc_vars%lid_ch4) = 1._r8/gas2bulkcef(betrtracer_vars%volatileid(j)) + + elseif(j==betrtracer_vars%id_trc_n2o) then + this%scal_f(centurybgc_vars%lid_n2o) = aere_cond(betrtracer_vars%volatileid(j)) + this%conc_f(centurybgc_vars%lid_n2o) = tracer_conc_atm(betrtracer_vars%volatileid(j)) + this%conv_f(centurybgc_vars%lid_n2o) = 1._r8/gas2bulkcef(betrtracer_vars%volatileid(j)) + endif + enddo + end subroutine AAssign + + !------------------------------------------------------------------------------- + type(bgc_reaction_CENTURY_type) function constructor() + ! + ! !DESCRIPTION: + ! + ! create an object of type bgc_reaction_CENTURY_type. + ! Right now it is purposely empty + + end function constructor + + + !------------------------------------------------------------------------------- + subroutine init_boundary_condition_type(this, bounds, betrtracer_vars, tracerboundarycond_vars ) + ! + ! !DESCRIPTION: + ! initialize boundary condition types + ! !USES: + use TracerBoundaryCondType , only : tracerboundarycond_type + use BeTRTracerType , only : betrtracer_type + + ! !ARGUMENTS: + class(bgc_reaction_CENTURY_type), intent(in) :: this + type(bounds_type) , intent(in) :: bounds + type(BeTRtracer_type ) , intent(in) :: betrtracer_vars + type(tracerboundarycond_type) , intent(in) :: tracerboundarycond_vars + + ! !LOCAL VARIABLES: + integer :: c + + associate( & + groupid => betrtracer_vars%groupid & + ) + + + tracerboundarycond_vars%topbc_type(1:betrtracer_vars%ngwmobile_tracer_groups ) = bndcond_as_conc + tracerboundarycond_vars%topbc_type(groupid(betrtracer_vars%id_trc_no3x) ) = bndcond_as_flux + tracerboundarycond_vars%topbc_type(betrtracer_vars%ngwmobile_tracer_groups+1:betrtracer_vars%ntracer_groups ) = bndcond_as_flux + + end associate + + end subroutine init_boundary_condition_type + + !------------------------------------------------------------------------------- + + subroutine Init_betrbgc(this, bounds, lbj, ubj, betrtracer_vars) + ! + ! !DESCRIPTION: + ! initialize the betrbgc + ! !USES: + use CNSharedParamsMod , only : CNParamsReadShared + use ncdio_pio , only : file_desc_t + use BeTRTracerType , only : betrtracer_type + use MathfuncMod , only : addone + use clm_varctl , only : cnallocate_carbon_only_set + ! !ARGUMENTS: + class(bgc_reaction_CENTURY_type), intent(in) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: lbj, ubj ! lower and upper bounds, make sure they are > 0 + type(BeTRtracer_type ) , intent(inout) :: betrtracer_vars + + ! !LOCAL VARIABLES: + character(len=32) , parameter :: subname ='Init_betrbgc' + integer :: jj + integer :: nelm, itemp_mem + integer :: itemp, itemp_vgrp, itemp_v, itemp_grp + integer :: c_loc, n_loc, trcid + logical :: carbon_only = .false. + + call cnallocate_carbon_only_set(carbon_only) + call centurybgc_vars%Init(bounds, lbj, ubj) + + nelm =centurybgc_vars%nelms + c_loc=centurybgc_vars%c_loc + n_loc=centurybgc_vars%n_loc + + itemp = 0 + betrtracer_vars%id_trc_n2 = addone(itemp) + betrtracer_vars%id_trc_o2 = addone(itemp) + betrtracer_vars%id_trc_ar = addone(itemp) + betrtracer_vars%id_trc_co2x = addone(itemp) + betrtracer_vars%id_trc_ch4 = addone(itemp) + betrtracer_vars%id_trc_nh3x = addone(itemp) + betrtracer_vars%id_trc_no3x = addone(itemp) + betrtracer_vars%id_trc_n2o = addone(itemp) + + betrtracer_vars%ngwmobile_tracer_groups = itemp ! n2, o2, ar, co2, ch4, n2o, nh3x and no3x + betrtracer_vars%ngwmobile_tracers = itemp + betrtracer_vars%nvolatile_tracers = itemp-2 ! n2, o2, ar, co2, ch4 and n2o + betrtracer_vars%nvolatile_tracer_groups = itemp-2 ! + betrtracer_vars%nsolid_passive_tracer_groups = 4 ! som1, som2, som3 and others (lit1, lit2, lit3, cwd) + betrtracer_vars%nsolid_passive_tracers = centurybgc_vars%nom_pools*nelm ! + + betrtracer_vars%nmem_max = nelm*4 ! total number of elemnts, and 4 sub members (lit1, lit2, lit3, cwd) + + call betrtracer_vars%Init() + + betrtracer_vars%is_mobile(:) = .true. + + jj = itemp + itemp_vgrp = 0 !counter for volatile groups + itemp_v = 0 !counter for volatile tracers + itemp_grp = 0 !counter for tracer groups + + trcid = betrtracer_vars%id_trc_n2 + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_n2, trc_name='N2' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_o2, trc_name='O2' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_ar, trc_name='AR' , & + is_trc_mobile=.false., is_trc_advective = .false., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_co2x, trc_name='CO2x', & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = addone(itemp_grp) , & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_ch4, trc_name='CH4' , & + is_trc_mobile=.false., is_trc_advective = .false., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_nh3x, trc_name='NH3x', & + is_trc_mobile=.false., is_trc_advective = .false., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.false.) + + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_no3x, trc_name='NO3x', & + is_trc_mobile=.true., is_trc_advective = .true., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.false.,trc_vtrans_scal=1._r8) + + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_n2o, trc_name='N2O' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.true., trc_volatile_id = addone(itemp_v) , & + trc_volatile_group_id = addone(itemp_vgrp)) + + + + !------------------------------------------------------------------------------------ + itemp_mem=0 + itemp_grp=addone(itemp_grp) !only one group passive solid litter tracers + trcid = jj+(centurybgc_vars%lit1-1)*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='LIT1C' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%lit1-1)*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='LIT1N' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + !------------------------------------------------------------------------------------ + + trcid = jj+(centurybgc_vars%lit2-1)*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='LIT2C' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%lit2-1)*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='LIT2N' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + !------------------------------------------------------------------------------------ + + trcid = jj+(centurybgc_vars%lit3-1)*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='LIT3C' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%lit3-1)*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='LIT3N' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + !------------------------------------------------------------------------------------ + + trcid = jj+(centurybgc_vars%cwd-1 )*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='CWDC' , & + is_trc_mobile=.false., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%cwd-1 )*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='CWDN' , & + is_trc_mobile=.false., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + !========================================================================================== + !new group + itemp_mem = 0 + itemp_grp = addone(itemp_grp) + trcid = jj+(centurybgc_vars%som1-1)*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='SOM1C' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp , & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%som1-1)*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='SOM1N' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + !------------------------------------------------------------------------------------ + !new group + itemp_mem=0 + itemp_grp = addone(itemp_grp) + trcid = jj+(centurybgc_vars%som2-1)*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='SOM2C' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp , & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%som2-1)*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='SOM2N' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + !------------------------------------------------------------------------------------ + !new group + itemp_mem=0 + itemp_grp = addone(itemp_grp) + trcid = jj+(centurybgc_vars%som3-1)*nelm+c_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='SOM3C' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + trcid = jj+(centurybgc_vars%som3-1)*nelm+n_loc + call betrtracer_vars%set_tracer(trc_id = trcid, trc_name='SOM3N' , & + is_trc_mobile=.true., is_trc_advective = .false., trc_group_id = itemp_grp, & + trc_group_mem= addone(itemp_mem)) + + end subroutine Init_betrbgc + + !------------------------------------------------------------------------------- + subroutine set_boundary_conditions(this, bounds, num_soilc, filter_soilc, dz_top, betrtracer_vars, & + waterflux_vars, tracerboundarycond_vars) + ! + ! !DESCRIPTION: + ! set up boundary conditions for tracer movement + ! + ! !USES: + use TracerBoundaryCondType, only : tracerboundarycond_type + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + use BeTRTracerType , only : betrtracer_type + use WaterfluxType , only : waterflux_type + + ! !ARGUMENTS: + class(bgc_reaction_CENTURY_type), intent(in) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: num_soilc ! number of columns in column filter + integer , intent(in) :: filter_soilc(:) ! column filter + type(betrtracer_type) , intent(in) :: betrtracer_vars + real(r8) , intent(in) :: dz_top(bounds%begc: ) + type(waterflux_type) , intent(in) :: waterflux_vars + type(tracerboundarycond_type) , intent(inout) :: tracerboundarycond_vars + + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'set_boundary_conditions' + integer :: fc, c + + SHR_ASSERT_ALL((ubound(dz_top) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + + associate( & + groupid => betrtracer_vars%groupid & + ) + + do fc = 1, num_soilc + c = filter_soilc(fc) + + !values below will be updated with datastream + !eventually, the following code will be implemented using polymorphism + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%ngwmobile_tracers+1:betrtracer_vars%ntracers) =0._r8 !zero incoming flux + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_n2) =32.8_r8 !mol m-3, contant boundary condition + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_o2) =8.78_r8 !mol m-3, contant boundary condition + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_ar) =0.3924_r8 !mol m-3, contant boundary condition + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_co2x) =0.0168_r8 !mol m-3, contant boundary condition + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_ch4) =6.939e-5_r8 !mol m-3, contant boundary condition + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_n2o) =1.195e-5_r8 !mol m-3, contant boundary condition + + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_no3x) = 0._r8 + tracerboundarycond_vars%bot_concflux_col(c,1,:) = 0._r8 !zero flux boundary condition + !those will be updated with snow resistance and hydraulic wicking resistance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_n2)) = 2._r8*1.267e-5_r8/dz_top(c) !m/s surface conductance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_o2)) = 2._r8*1.267e-5_r8/dz_top(c) !m/s surface conductance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_ar)) = 2._r8*1.267e-5_r8/dz_top(c) !m/s surface conductance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_co2x)) = 2._r8*1.267e-5_r8/dz_top(c) !m/s surface conductance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_ch4)) = 2._r8*1.267e-5_r8/dz_top(c) !m/s surface conductance + tracerboundarycond_vars%condc_toplay_col(c,groupid(betrtracer_vars%id_trc_n2o)) = 2._r8*1.267e-5_r8/dz_top(c) !m/s surface conductance + enddo + end associate + end subroutine set_boundary_conditions + + !------------------------------------------------------------------------------- + subroutine calc_bgc_reaction(this, bounds, lbj, ubj, num_soilc, filter_soilc, num_soilp, filter_soilp, jtops, dtime, & + betrtracer_vars, tracercoeff_vars, waterstate_vars, temperature_vars, soilstate_vars, chemstate_vars, & + cnstate_vars, carbonstate_vars, carbonflux_vars, nitrogenstate_vars, nitrogenflux_vars, tracerstate_vars, & + tracerflux_vars, plantsoilnutrientflux_vars) + ! + ! !DESCRIPTION: + ! do bgc reaction + ! this returns net carbon fluxes from decay and translocation + ! and also update the related carbon/nitrogen/phosphorus(potentially) pools of OM + ! note it is assumed the stoichiometry of the om pools are not changed during decomposition + ! + ! !USES: + ! + use tracerfluxType , only : tracerflux_type + use tracerstatetype , only : tracerstate_type + use tracercoeffType , only : tracercoeff_type + use BetrTracerType , only : betrtracer_type + use WaterStateType , only : Waterstate_Type + use TemperatureType , only : temperature_type + use ChemStateType , only : chemstate_type + use SoilStatetype , only : soilstate_type + use ODEMod , only : ode_ebbks1 + use CNStateType , only : cnstate_type + use PlantSoilnutrientFluxType, only : plantsoilnutrientflux_type + use CNVerticalProfileMod , only : decomp_vertprofiles + use CNCarbonStateType , only : carbonstate_type + use CNCarbonFluxType , only : carbonflux_type + use CNNitrogenFluxType , only : nitrogenflux_type + use CNNitrogenStateType , only : nitrogenstate_type + ! !ARGUMENTS: + class(bgc_reaction_CENTURY_type) , intent(in) :: this + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_soilc ! number of columns in column filter + integer , intent(in) :: filter_soilc(:) ! column filter + integer , intent(in) :: num_soilp + integer , intent(in) :: filter_soilp(:) ! pft filter + integer , intent(in) :: jtops(bounds%begc: ) ! top index of each column + integer , intent(in) :: lbj, ubj ! lower and upper bounds, make sure they are > 0 + real(r8) , intent(in) :: dtime ! model time step + type(Waterstate_Type) , intent(in) :: waterstate_vars ! water state variables + type(temperature_type) , intent(in) :: temperature_vars ! energy state variable + type(soilstate_type) , intent(in) :: soilstate_vars + type(chemstate_type) , intent(in) :: chemstate_vars + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(tracercoeff_type) , intent(in) :: tracercoeff_vars + type(carbonstate_type) , intent(in) :: carbonstate_vars + type(cnstate_type) , intent(inout) :: cnstate_vars + type(carbonflux_type) , intent(inout) :: carbonflux_vars + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + type(tracerstate_type) , intent(inout) :: tracerstate_vars + type(tracerflux_type) , intent(inout) :: tracerflux_vars + type(plantsoilnutrientflux_type) , intent(inout) :: plantsoilnutrientflux_vars ! + ! + ! !LOCAL VARIABLES: + integer :: fc, c, j, k + real(r8) :: time + real(r8) :: y0(centurybgc_vars%nstvars, bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: yf(centurybgc_vars%nstvars, bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: cn_ratios(centurybgc_vars%nom_pools, bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: cp_ratios(centurybgc_vars%nom_pools, bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: k_decay(centurybgc_vars%nreactions, bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: pot_decay_rates(centurybgc_vars%nom_pools, bounds%begc:bounds%endc, lbj:ubj) ![mol C/m3/s] potential decay rates for different om pools without nutrient limitation + real(r8) :: pot_co2_hr(bounds%begc:bounds%endc, lbj:ubj) ![mol C/m3/s], potential co2 respiration rate + real(r8) :: pot_nh3_immob(bounds%begc:bounds%endc,lbj:ubj) + real(r8) :: anaerobic_frac(bounds%begc:bounds%endc,lbj:ubj) + real(r8) :: n2_n2o_ratio_denit(bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: nh4_no3_ratio(bounds%begc:bounds%endc, lbj:ubj) + real(r8) :: nuptake_prof(bounds%begc:bounds%endc,1:ubj) + real(r8) :: pscal + character(len=32), parameter :: subname ='calc_bgc_reaction' + + SHR_ASSERT_ALL((ubound(jtops) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + + call Extra_inst%Init_Allocate(centurybgc_vars%nom_pools, & + centurybgc_vars%nreactions, centurybgc_vars%nprimvars) + + call set_reaction_order(centurybgc_vars%nreactions, & + centurybgc_vars, Extra_inst%is_zero_order) + + !initialize local variables + y0(:, :, :) = spval + yf(:, :, :) = spval + cn_ratios(:,:,:) = nan + cp_ratios(:,:,:) = nan + + !initialize the state vector + call init_state_vector(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, & + centurybgc_vars%nstvars, tracerstate_vars, betrtracer_vars, centurybgc_vars, y0) + + !update the initial vector from external input + !calculate elemental stoichiometry for different om pools and add mineral nutrient input from other than decaying process + + call bgcstate_ext_update_bfdecomp(bounds, 1, ubj, num_soilc, filter_soilc, carbonflux_vars, nitrogenflux_vars, & + centurybgc_vars, betrtracer_vars, tracerflux_vars, y0, cn_ratios, cp_ratios) + + !calculate nitrogen uptake profile + call calc_nuptake_prof(bounds, ubj, num_soilc, filter_soilc, & + tracerstate_vars%tracer_conc_mobile_col(bounds%begc:bounds%endc, 1:ubj, betrtracer_vars%id_trc_nh3x), & + tracerstate_vars%tracer_conc_mobile_col(bounds%begc:bounds%endc, 1:ubj, betrtracer_vars%id_trc_no3x), & + col%dz(bounds%begc:bounds%endc,1:ubj), cnstate_vars%nfixation_prof_col(bounds%begc:bounds%endc,1:ubj), & + nuptake_prof(bounds%begc:bounds%endc,1:ubj)) + + !update plant nitrogen uptake potential + + call plantsoilnutrientflux_vars%calc_nutrient_uptake_potential(bounds, num_soilc, filter_soilc, num_soilp, & + filter_soilp, carbonstate_vars%frootc_patch) + + !calculate multiplicative scalars for decay parameters + call calc_decompK_multiply_scalar(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, & + waterstate_vars%finundated_col(bounds%begc:bounds%endc), col%z(bounds%begc:bounds%endc, lbj:ubj),& + temperature_vars%t_soisno_col(bounds%begc:bounds%endc, lbj:ubj), & + tracerstate_vars%tracer_conc_mobile_col(bounds%begc:bounds%endc, lbj:ubj, betrtracer_vars%id_trc_o2), & + tracercoeff_vars%aqu2bulkcef_mobile_col(bounds%begc:bounds%endc, lbj:ubj, betrtracer_vars%id_trc_o2), & + soilstate_vars, centurybgc_vars, carbonflux_vars) + + !calculate decay coefficients + call calc_som_deacyK(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, centurybgc_vars%nom_pools, tracercoeff_vars, tracerstate_vars, & + betrtracer_vars, centurybgc_vars, carbonflux_vars,dtime, k_decay(1:centurybgc_vars%nom_pools, bounds%begc:bounds%endc, lbj:ubj)) + + !calculate potential decay rates, without nutrient constraint + call calc_sompool_decay(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, centurybgc_vars, & + k_decay(1:centurybgc_vars%nom_pools, bounds%begc:bounds%endc, lbj:ubj), y0(1:centurybgc_vars%nom_totelms, bounds%begc:bounds%endc, lbj:ubj), & + pot_decay_rates) + + !calculate potential respiration rates by summarizing all om decomposition pathways + call calc_potential_aerobic_hr(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, cn_ratios, cp_ratios, centurybgc_vars, pot_decay_rates, & + soilstate_vars%cellsand_col(bounds%begc:bounds%endc,lbj:ubj), pot_co2_hr, pot_nh3_immob) + + !calculate fraction of anerobic environment + call calc_anaerobic_frac(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, & + temperature_vars%t_soisno_col(bounds%begc:bounds%endc,lbj:ubj), & + soilstate_vars, waterstate_vars%h2osoi_vol_col(bounds%begc:bounds%endc,lbj:ubj), pot_co2_hr, & + tracerstate_vars%tracer_conc_mobile_col(bounds%begc:bounds%endc, lbj:ubj, betrtracer_vars%id_trc_o2), & + anaerobic_frac(bounds%begc:bounds%endc, lbj:ubj)) + + !calculate normalized rate for nitrification and denitrification + call calc_nitrif_denitrif_rate(bounds, lbj, ubj, num_soilc, filter_soilc, jtops, col%dz(bounds%begc:bounds%endc, lbj:ubj), & + temperature_vars%t_soisno_col(bounds%begc:bounds%endc, lbj:ubj), & + chemstate_vars%soil_pH(bounds%begc:bounds%endc, lbj:ubj), pot_co2_hr, anaerobic_frac, & + tracerstate_vars%tracer_conc_mobile_col(bounds%begc:bounds%endc, lbj:ubj, betrtracer_vars%id_trc_nh3x), & + tracerstate_vars%tracer_conc_mobile_col(bounds%begc:bounds%endc, lbj:ubj, betrtracer_vars%id_trc_no3x), & + soilstate_vars, waterstate_vars, carbonflux_vars, n2_n2o_ratio_denit, nh4_no3_ratio, & + k_decay(centurybgc_vars%lid_nh4_nit_reac, bounds%begc:bounds%endc, lbj:ubj), & + k_decay(centurybgc_vars%lid_no3_den_reac, bounds%begc:bounds%endc, lbj:ubj)) + + !now there is no plant nitrogen uptake, I tend to create a new structure to indicate plant nutrient demand when it is hooked + !back with CLM + + call calc_plant_nitrogen_uptake_prof(bounds, ubj, num_soilc, filter_soilc, col%dz(bounds%begc:bounds%endc, lbj:ubj), & + plantsoilnutrientflux_vars%plant_minn_uptake_potential_col(bounds%begc:bounds%endc), & + nuptake_prof(bounds%begc:bounds%endc,1:ubj), & + k_decay(centurybgc_vars%lid_plant_minn_up_reac, bounds%begc:bounds%endc ,1:ubj)) + + !apply root distribution here + call apply_plant_root_respiration_prof(bounds, ubj, num_soilc, filter_soilc, & + carbonflux_vars%rr_col(bounds%begc:bounds%endc), & + cnstate_vars%nfixation_prof_col(bounds%begc:bounds%endc,1:ubj), & + k_decay(centurybgc_vars%lid_at_rt_reac, bounds%begc:bounds%endc, 1:ubj)) + + !do ode integration and update state variables for each layer + !lpr = .true. + do j = lbj, ubj + do fc = 1, num_soilc + c = filter_soilc(fc) + if(j betrtracer_vars%volatileid & + ) + + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if (lun%ifspecial(l)) then + if(betrtracer_vars%ngwmobile_tracers>0)then + tracerstate_vars%tracer_conc_mobile_col(c,:,:) = spval + tracerstate_vars%tracer_conc_surfwater_col(c,:) = spval + tracerstate_vars%tracer_conc_aquifer_col(c,:) = spval + tracerstate_vars%tracer_conc_grndwater_col(c,:) = spval + tracerstate_vars%tracer_conc_atm_col(c,:) = spval + endif + if(betrtracer_vars%ntracers > betrtracer_vars%ngwmobile_tracers)then + tracerstate_vars%tracer_conc_solid_passive_col(c,:,:) = spval + endif + if(betrtracer_vars%nsolid_equil_tracers>0)then + tracerstate_vars%tracer_conc_solid_equil_col(c, :, :) = spval + endif + endif + tracerstate_vars%tracer_soi_molarmass_col(c,:) = spval + + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + !dual phase tracers + + tracerstate_vars%tracer_conc_mobile_col (c,:, : ) = 0._r8 + tracerstate_vars%tracer_conc_surfwater_col (c,: ) = 0._r8 + tracerstate_vars%tracer_conc_aquifer_col (c,: ) = 0._r8 + tracerstate_vars%tracer_conc_grndwater_col (c,: ) = 0._r8 + tracerstate_vars%tracer_conc_atm_col (c,volatileid (betrtracer_vars%id_trc_n2 )) = 32.8_r8 + tracerstate_vars%tracer_conc_atm_col (c,volatileid (betrtracer_vars%id_trc_o2 )) = 8.78_r8 + tracerstate_vars%tracer_conc_atm_col (c,volatileid (betrtracer_vars%id_trc_ar )) = 0.3924_r8 + tracerstate_vars%tracer_conc_atm_col (c,volatileid (betrtracer_vars%id_trc_co2x )) = 0.0168_r8 + tracerstate_vars%tracer_conc_atm_col (c,volatileid (betrtracer_vars%id_trc_ch4 )) = 6.939e-5_r8 + tracerstate_vars%tracer_conc_atm_col (c,volatileid (betrtracer_vars%id_trc_n2o )) = 1.195e-5_r8 + + !solid tracers + if(betrtracer_vars%ngwmobile_tracers < betrtracer_vars%ntracers)then + tracerstate_vars%tracer_conc_solid_passive_col(c,:,:) = 0._r8 + endif + + if(betrtracer_vars%nsolid_equil_tracers>0)then + tracerstate_vars%tracer_conc_solid_equil_col(c, :, :) = 0._r8 + endif + tracerstate_vars%tracer_soi_molarmass_col(c,:) = 0._r8 + endif + enddo + end associate + end subroutine InitCold + + !-------------------------------------------------------------------------------------------------------------------- + subroutine betr_alm_flux_statevar_feedback(this, bounds, num_soilc, filter_soilc, & + carbonstate_vars, nitrogenstate_vars, nitrogenflux_vars, tracerstate_vars, & + tracerflux_vars, betrtracer_vars) + ! + ! !DESCRIPTION: + ! do state and flux variable exchange between betr and alm + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use tracerfluxType , only : tracerflux_type + use tracerstatetype , only : tracerstate_type + use decompMod , only : bounds_type + use BeTRTracerType , only : BeTRTracer_Type + use CNCarbonStateType , only : carbonstate_type + use CNNitrogenStateType , only : nitrogenstate_type + use CNNitrogenFluxType , only : nitrogenflux_type + + + ! !ARGUMENTS: + class(bgc_reaction_CENTURY_type) , intent(in) :: this + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_soilc ! number of columns in column filter + integer , intent(in) :: filter_soilc(:) ! column filter + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(tracerstate_type) , intent(in) :: tracerstate_vars + type(tracerflux_type) , intent(in) :: tracerflux_vars + type(carbonstate_type) , intent(inout) :: carbonstate_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars ! + + call assign_nitrogen_hydroloss(bounds, num_soilc, filter_soilc, tracerflux_vars, & + nitrogenflux_vars, betrtracer_vars) + + call assign_OM_CNpools(bounds, num_soilc, filter_soilc, carbonstate_vars, & + nitrogenstate_vars, tracerstate_vars, betrtracer_vars, centurybgc_vars) + + end subroutine betr_alm_flux_statevar_feedback + + !--------------------------------------------------------------- + subroutine init_betr_alm_bgc_coupler(this, bounds, carbonstate_vars, & + nitrogenstate_vars, betrtracer_vars, tracerstate_vars) + + ! + ! !DESCRIPTION: + ! state variable exchange between betr and alm + ! !USES: + use clm_varcon , only : natomw, catomw + use clm_varpar , only : i_cwd, i_met_lit, i_cel_lit, i_lig_lit + use CNCarbonStateType , only : carbonstate_type + use CNNitrogenStateType , only : nitrogenstate_type + use tracerstatetype , only : tracerstate_type + use BetrTracerType , only : betrtracer_type + use clm_varpar , only : nlevtrc_soil + use landunit_varcon , only : istsoil, istcrop + + ! !ARGUMENTS: + class(bgc_reaction_CENTURY_type) , intent(in) :: this + type(bounds_type) , intent(in) :: bounds + type(tracerstate_type) , intent(inout) :: tracerstate_vars + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(carbonstate_type) , intent(in) :: carbonstate_vars + type(nitrogenstate_type) , intent(in) :: nitrogenstate_vars + + ! !LOCAL VARIABLES: + integer, parameter :: i_soil1 = 5 + integer, parameter :: i_soil2 = 6 + integer, parameter :: i_soil3 = 7 + integer :: c, j, k, l + character(len=255) :: subname = 'init_betr_alm_bgc_coupler' + + associate( & + id_trc_no3x => betrtracer_vars%id_trc_no3x , & + id_trc_nh3x => betrtracer_vars%id_trc_nh3x , & + decomp_cpools_vr => carbonstate_vars%decomp_cpools_vr_col , & + decomp_npools_vr => nitrogenstate_vars%decomp_npools_vr_col , & + smin_no3_vr_col => nitrogenstate_vars%smin_no3_vr_col , & + smin_nh4_vr_col => nitrogenstate_vars%smin_nh4_vr_col , & + tracer_conc_mobile => tracerstate_vars%tracer_conc_mobile_col , & + tracer_conc_solid_passive => tracerstate_vars%tracer_conc_solid_passive_col , & + c_loc => centurybgc_vars%c_loc , & + n_loc => centurybgc_vars%n_loc , & + lit1 => centurybgc_vars%lit1 , & + lit2 => centurybgc_vars%lit2 , & + lit3 => centurybgc_vars%lit3 , & + som1 => centurybgc_vars%som1 , & + som2 => centurybgc_vars%som2 , & + som3 => centurybgc_vars%som3 , & + cwd => centurybgc_vars%cwd , & + nelms => centurybgc_vars%nelms & + ) + + !initialize tracer based on carbon/nitrogen pools + !eventually, this will replace the century bgc + do j = 1, nlevtrc_soil + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + tracer_conc_mobile(c,j,id_trc_no3x)=smin_no3_vr_col(c,j) /natomw + tracer_conc_mobile(c,j,id_trc_nh3x)=smin_nh4_vr_col(c,j) /natomw + k = lit1; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_met_lit) / catomw + k = lit2; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_cel_lit) / catomw + k = lit3; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_lig_lit) / catomw + k = cwd ; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_cwd ) / catomw + k = som1; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_soil1 ) / catomw + k = som2; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_soil2 ) / catomw + k = som3; tracer_conc_solid_passive(c,j,(k-1)*nelms+c_loc) = decomp_cpools_vr(c,j,i_soil3 ) / catomw + + k = lit1; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_met_lit) / natomw + k = lit2; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_cel_lit) / natomw + k = lit3; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_lig_lit) / natomw + k = cwd ; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_cwd ) / natomw + k = som1; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_soil1 ) / natomw + k = som2; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_soil2 ) / natomw + k = som3; tracer_conc_solid_passive(c,j,(k-1)*nelms+n_loc) = decomp_npools_vr(c,j,i_soil3 ) / natomw + endif + enddo + enddo + end associate + end subroutine init_betr_alm_bgc_coupler + + !------------------------------------------------------------------------------- + + + subroutine one_box_century_bgc(ystate, dtime, time, nprimvars, nstvars, dydt) + ! + ! !DESCRIPTION: + ! do single box bgc + ! + !the equations to be solved are in the form + ! + ! dx/dt=I+A*R, where I is the input, A is the stoichiometric matrix, and R is the reaction vector + ! the input only contains litter input and mineral nutrient, som is assumed to be of fixed stoichiometry + ! !USES: + use SOMStateVarUpdateMod , only : calc_dtrend_som_bgc + use BGCCenturySubMod , only : calc_cascade_matrix + implicit none + ! !ARGUMENTS: + integer, intent(in) :: nstvars + integer, intent(in) :: nprimvars + real(r8), intent(in) :: dtime + real(r8), intent(in) :: time + real(r8), intent(in) :: ystate(nstvars) + real(r8), intent(out) :: dydt(nstvars) + + ! !LOCAL VARIABLES: + integer :: lk, jj + real(r8) :: cascade_matrix(nstvars, Extra_inst%nr) + logical :: nitrogen_limit_flag(centurybgc_vars%nom_pools) + real(r8) :: reaction_rates(Extra_inst%nr) + real(r8) :: o2_consump, o2_limit + + !calculate cascade matrix, which contains the stoichiometry for all reactions + call calc_cascade_matrix(nstvars, Extra_inst%nr, Extra_inst%cn_ratios, Extra_inst%cp_ratios, & + Extra_inst%n2_n2o_ratio_denit, Extra_inst%cellsand, centurybgc_vars, nitrogen_limit_flag, cascade_matrix) + + !do pool degradation + do lk = 1, Extra_inst%nr + if(Extra_inst%is_zero_order(lk))then + + if ( spinup_state .eq. 1 ) then + !spinup stage + if(lk == centurybgc_vars%lid_o2_aere_reac)then + jj = centurybgc_vars%lid_o2 + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + !I add the following line to disconnect the nitrogen and oxygen interaction + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + else + reaction_rates(lk) = Extra_inst%k_decay(lk) !this effective defines the plant nitrogen demand + endif + else + ! normal run stage + if(lk == centurybgc_vars%lid_o2_aere_reac)then + jj = centurybgc_vars%lid_o2 + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + elseif(lk == centurybgc_vars%lid_ch4_aere_reac)then + jj = centurybgc_vars%lid_ch4 + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + + elseif(lk == centurybgc_vars%lid_ar_aere_reac)then + jj = centurybgc_vars%lid_ar + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + + elseif(lk == centurybgc_vars%lid_n2_aere_reac)then + jj = centurybgc_vars%lid_n2 + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + + elseif(lk == centurybgc_vars%lid_co2_aere_reac)then + jj = centurybgc_vars%lid_co2 + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + + elseif(lk == centurybgc_vars%lid_n2o_aere_reac)then + jj = centurybgc_vars%lid_n2o + reaction_rates(lk) = Extra_inst%scal_f(jj) *(Extra_inst%conv_f(jj)*ystate(jj) - Extra_inst%conc_f(jj)) + reaction_rates(lk) = min(reaction_rates(lk),ystate(jj)/dtime) + + else + reaction_rates(lk) = Extra_inst%k_decay(lk) !this effective defines the plant nitrogen demand + endif + endif + else + reaction_rates(lk)=ystate(centurybgc_vars%primvarid(lk))*Extra_inst%k_decay(lk) + endif + enddo + + !obtain total oxygen consumption rate + o2_consump = DOT_PRODUCT(cascade_matrix(centurybgc_vars%lid_o2,1:Extra_inst%nr),reaction_rates(1:Extra_inst%nr)) + + if(-o2_consump*dtime > ystate(centurybgc_vars%lid_o2))then + o2_limit=-ystate(centurybgc_vars%lid_o2)/(o2_consump*dtime) + do lk = 1, Extra_inst%nr + if(centurybgc_vars%is_aerobic_reac(lk))then + reaction_rates(lk) = reaction_rates(lk)*o2_limit + endif + enddo + endif + + call apply_nutrient_down_regulation(nstvars, Extra_inst%nr, nitrogen_limit_flag, & + ystate(centurybgc_vars%lid_nh4), ystate(centurybgc_vars%lid_no3), & + dtime, cascade_matrix, reaction_rates) + + call calc_dtrend_som_bgc(nstvars, Extra_inst%nr, & + cascade_matrix(1:nstvars, 1:Extra_inst%nr), & + reaction_rates(1:Extra_inst%nr), dydt) + + end subroutine one_box_century_bgc + + !------------------------------------------------------------------------------- + subroutine apply_nutrient_down_regulation(nstvars, nreactions, nitrogen_limit_flag, & + smin_nh4, smin_no3, dtime, cascade_matrix, reaction_rates) + + ! !DESCRIPTION: + ! + ! this down-regulation considers nitrogen made available from gross mineralization + ! this implements is corresponding to the CLM-2 approach as described in Tang and Riley (2015), BG, tehcnique note. + ! !USES: + use clm_varctl, only : CNAllocate_Carbon_only + use MathfuncMod, only : safe_div + + ! !ARGUMENTS: + integer , intent(in) :: nstvars + integer , intent(in) :: nreactions + logical , intent(in) :: nitrogen_limit_flag(centurybgc_vars%nom_pools) + real(r8), intent(in) :: smin_nh4 + real(r8), intent(in) :: smin_no3 + real(r8), intent(in) :: dtime + real(r8), intent(inout) :: cascade_matrix(nstvars, nreactions) + real(r8), intent(inout) :: reaction_rates(nreactions) + ! !LOCAL VARIABLES: + real(r8) :: decomp_plant_minn_demand_flx + real(r8) :: tot_nh4_demand_flx + real(r8) :: tot_no3_demand_flx + real(r8) :: decomp_plant_residual_minn_demand_flx + real(r8) :: smin_nh4_to_decomp_plant_flx + real(r8) :: smin_no3_to_decomp_plant_flx + real(r8) :: tot_sminn_to_decomp_plant_flx + real(r8) :: frac_nh4_to_decomp_plant + real(r8) :: supp_nh4_to_decomp_plant_flx + real(r8) :: frac_supp_nh4_to_decomp_plant + real(r8) :: gross_min_nh4_flx + real(r8) :: alpha + real(r8) :: frac_gross_immob=1.0_r8 + integer :: reac + + associate( & ! + nom_pools => centurybgc_vars%nom_pools , & ! + lid_nh4 => centurybgc_vars%lid_nh4 , & ! + lid_no3 => centurybgc_vars%lid_no3 , & ! + lid_plant_minn => centurybgc_vars%lid_plant_minn , & ! + lid_minn_nh4_immob => centurybgc_vars%lid_minn_nh4_immob , & ! + lid_minn_no3_immob => centurybgc_vars%lid_minn_no3_immob , & ! + lid_minn_nh4_plant => centurybgc_vars%lid_minn_nh4_plant , & ! + lid_minn_no3_plant => centurybgc_vars%lid_minn_no3_plant , & ! + lid_nh4_supp => centurybgc_vars%lid_nh4_supp , & ! + lid_nh4_nit => centurybgc_vars%lid_nh4_nit , & ! + lid_plant_minn_up_reac=> centurybgc_vars%lid_plant_minn_up_reac, & ! + lid_nh4_nit_reac => centurybgc_vars%lid_nh4_nit_reac , & ! + lid_no3_den_reac => centurybgc_vars%lid_no3_den_reac & ! + ) + + decomp_plant_minn_demand_flx = 0._r8 + gross_min_nh4_flx = 0._r8 + do reac = 1, nom_pools + if(nitrogen_limit_flag(reac))then + decomp_plant_minn_demand_flx = decomp_plant_minn_demand_flx - & + reaction_rates(reac) * cascade_matrix(lid_nh4, reac) + else + gross_min_nh4_flx = gross_min_nh4_flx + & + reaction_rates(reac) * cascade_matrix(lid_nh4, reac) + endif + enddo + + !add nitrogen demand from plant + reac = lid_plant_minn_up_reac + decomp_plant_minn_demand_flx = decomp_plant_minn_demand_flx - & + reaction_rates(reac) * cascade_matrix(lid_nh4, reac) + + !in clm-century, nh4 is first competed between decomposer immobilization, plant and nitrification + ! + reac = lid_nh4_nit_reac + tot_nh4_demand_flx = decomp_plant_minn_demand_flx - & + reaction_rates(reac) * cascade_matrix(lid_nh4 ,reac) & + - gross_min_nh4_flx*frac_gross_immob + + if(tot_nh4_demand_flx*dtime>smin_nh4)then + if(CNAllocate_Carbon_only())then + + !nitrifier uses what it is provided + !plant use the remaining nh4 and request external supply from supp nh4 + if(reaction_rates(reac)<1.e-40_r8)then + alpha = 0._r8 + else + alpha = -smin_nh4/(reaction_rates(reac)*cascade_matrix(lid_nh4,reac)*dtime) + endif + reaction_rates(reac) = reaction_rates(reac) * min(alpha, 1._r8) + + smin_nh4_to_decomp_plant_flx = smin_nh4/dtime+reaction_rates(reac)*cascade_matrix(lid_nh4,reac) + decomp_plant_residual_minn_demand_flx = decomp_plant_minn_demand_flx - smin_nh4_to_decomp_plant_flx + + else + !nitrifiers, decomposers and plants are nh4 limited + alpha = smin_nh4/(tot_nh4_demand_flx*dtime) + + !downregulate nitrification + reaction_rates(lid_nh4_nit_reac) = reaction_rates(lid_nh4_nit_reac)*alpha + smin_nh4_to_decomp_plant_flx = smin_nh4/dtime + reaction_rates(lid_nh4_nit_reac) * cascade_matrix(lid_nh4, reac) + decomp_plant_residual_minn_demand_flx = decomp_plant_minn_demand_flx - smin_nh4_to_decomp_plant_flx + endif + else + !none is nh4 limited + smin_nh4_to_decomp_plant_flx = decomp_plant_minn_demand_flx + decomp_plant_residual_minn_demand_flx = 0._r8 + endif + !avoid negative smin_nh4 due to roundoff + smin_nh4_to_decomp_plant_flx = max(smin_nh4_to_decomp_plant_flx -1.e-21_r8, & + smin_nh4_to_decomp_plant_flx) + + reac = lid_no3_den_reac + tot_no3_demand_flx = decomp_plant_residual_minn_demand_flx - & + reaction_rates(reac) * cascade_matrix(lid_no3 ,reac) + + !then no3 is competed between denitrification and residual request from decomposer immobilization and plant demand + if(tot_no3_demand_flx * dtime>smin_no3)then + + if(CNAllocate_Carbon_only())then + !denitrifiers is given what is available + if(abs(reaction_rates(reac))<1.e-40_r8)then + alpha = 0._r8 + else + alpha = -smin_no3/(dtime*reaction_rates(reac)*cascade_matrix(lid_no3,reac)) + endif + reaction_rates(lid_no3_den_reac ) = reaction_rates(lid_no3_den_reac )*min(alpha,1._r8) + smin_no3_to_decomp_plant_flx = smin_no3/dtime + reaction_rates(lid_no3_den_reac ) * cascade_matrix(lid_no3 ,reac) + else + !denitrifiers, decomposers and plants are no3 limited + alpha = smin_no3/(tot_no3_demand_flx*dtime) + reaction_rates(lid_no3_den_reac ) = reaction_rates(lid_no3_den_reac )*alpha + + smin_no3_to_decomp_plant_flx = smin_no3/dtime + reaction_rates(lid_no3_den_reac ) * cascade_matrix(lid_no3 ,reac) + endif + else + smin_no3_to_decomp_plant_flx = tot_no3_demand_flx + endif + + !avoid negative smin_no3 due to roundoff + smin_no3_to_decomp_plant_flx = max(smin_no3_to_decomp_plant_flx-1.e-21_r8,0._r8) + tot_sminn_to_decomp_plant_flx = smin_nh4_to_decomp_plant_flx + smin_no3_to_decomp_plant_flx + + if(CNAllocate_Carbon_only())then + supp_nh4_to_decomp_plant_flx = decomp_plant_minn_demand_flx - tot_sminn_to_decomp_plant_flx + tot_sminn_to_decomp_plant_flx = decomp_plant_minn_demand_flx + else + supp_nh4_to_decomp_plant_flx = 0._r8 + endif + + if(tot_sminn_to_decomp_plant_flx < decomp_plant_minn_demand_flx)then + !plant & decomp are nitrogen limited + alpha = tot_sminn_to_decomp_plant_flx/decomp_plant_minn_demand_flx + else + alpha = 1._r8 + endif + + if(smin_nh4_to_decomp_plant_flx>=tot_sminn_to_decomp_plant_flx)then + frac_nh4_to_decomp_plant = 1._r8 + else + frac_nh4_to_decomp_plant = smin_nh4_to_decomp_plant_flx/tot_sminn_to_decomp_plant_flx + + if(supp_nh4_to_decomp_plant_flx>0._r8)then + frac_supp_nh4_to_decomp_plant=1._r8-frac_nh4_to_decomp_plant + else + frac_supp_nh4_to_decomp_plant = 0._r8 + endif + endif + !revise the stoichiometry matix elements + !for decomposers + + do reac = 1, nom_pools + if(nitrogen_limit_flag(reac))then + + reaction_rates(reac) = reaction_rates(reac) * alpha + cascade_matrix(lid_no3, reac) = cascade_matrix(lid_nh4, reac)*(1._r8-frac_nh4_to_decomp_plant-frac_supp_nh4_to_decomp_plant) + + if(lid_nh4_supp>0)then + cascade_matrix (lid_nh4_supp , reac) = cascade_matrix(lid_nh4, reac) * frac_supp_nh4_to_decomp_plant + cascade_matrix (lid_nh4 , reac) = cascade_matrix(lid_nh4, reac) - cascade_matrix(lid_no3, reac) - cascade_matrix(lid_nh4_supp, reac) + cascade_matrix (lid_minn_nh4_immob , reac) = -cascade_matrix(lid_nh4, reac) - cascade_matrix(lid_nh4_supp, reac) + else + cascade_matrix(lid_nh4 , reac) = cascade_matrix(lid_nh4, reac) - cascade_matrix(lid_no3, reac) + cascade_matrix(lid_minn_nh4_immob , reac) = -cascade_matrix(lid_nh4, reac) + endif + cascade_matrix(lid_minn_no3_immob, reac) = -cascade_matrix(lid_no3, reac) + endif + enddo + + !for plant + reac = lid_plant_minn_up_reac + reaction_rates(reac) = reaction_rates(reac) * alpha + cascade_matrix(lid_nh4, reac) = -frac_nh4_to_decomp_plant + + if(lid_nh4_supp>0)then + cascade_matrix(lid_nh4_supp , reac) = -frac_supp_nh4_to_decomp_plant + cascade_matrix(lid_no3 , reac) = -(1._r8 - frac_nh4_to_decomp_plant - frac_supp_nh4_to_decomp_plant) + cascade_matrix(lid_minn_nh4_plant , reac) = -cascade_matrix(lid_nh4, reac)-cascade_matrix(lid_nh4_supp, reac) + else + cascade_matrix(lid_no3 , reac) = -(1._r8-frac_nh4_to_decomp_plant) + cascade_matrix(lid_minn_nh4_plant , reac) = -cascade_matrix(lid_nh4, reac) + endif + cascade_matrix(lid_minn_no3_plant, reac) = -cascade_matrix(lid_no3, reac) + end associate + end subroutine apply_nutrient_down_regulation + +end module BGCReactionsCenturyType + diff --git a/components/clm/src/betr/bgc_sminn/BGCReactionsSminNType.F90 b/components/clm/src/betr/bgc_sminn/BGCReactionsSminNType.F90 new file mode 100644 index 000000000000..e15d71f0930a --- /dev/null +++ b/components/clm/src/betr/bgc_sminn/BGCReactionsSminNType.F90 @@ -0,0 +1,531 @@ +module BGCReactionsSminNType + + +#include "shr_assert.h" + ! + ! !DESCRIPTION: + ! do NO3 leaching using betr and the default century bgc + ! + ! HISTORY: + ! Created by Jinyun Tang, Oct 2nd, 2014 + ! !USES: + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_kind_mod , only : r8 => shr_kind_r8 + use decompMod , only : bounds_type + use BGCReactionsMod , only : bgc_reaction_type + use tracer_varcon , only : bndcond_as_conc, bndcond_as_flux + use LandunitType , only : lun + use ColumnType , only : col + implicit none + + save + private + ! + ! !PUBLIC TYPES: + public :: bgc_reaction_sminn_type + + type, extends(bgc_reaction_type) :: & + bgc_reaction_sminn_type + private +contains + procedure :: Init_betrbgc ! initialize betr bgc + procedure :: set_boundary_conditions ! set top/bottom boundary conditions for various tracers + procedure :: calc_bgc_reaction ! doing bgc calculation + procedure :: init_boundary_condition_type ! initialize type of top boundary conditions + procedure :: do_tracer_equilibration ! do equilibrium tracer chemistry + procedure :: InitCold ! do cold initialization + procedure :: readParams ! read in parameters + procedure :: betr_alm_flux_statevar_feedback ! + procedure :: init_betr_alm_bgc_coupler +end type bgc_reaction_sminn_type + + interface bgc_reaction_sminn_type +module procedure constructor + +end interface bgc_reaction_sminn_type + +contains + !------------------------------------------------------------------------------- + type(bgc_reaction_sminn_type) function constructor() + ! + ! ! DESCRIPTION: + ! create an object of type bgc_reaction_sminn_type. + ! Right now it is purposely empty + + end function constructor + + !------------------------------------------------------------------------------- + subroutine init_boundary_condition_type(this, bounds, betrtracer_vars, tracerboundarycond_vars ) + ! + ! !DESCRIPTION: + ! initialize boundary condition types + ! !USES: + use BeTRTracerType , only : betrtracer_type + use TracerBoundaryCondType, only : tracerboundarycond_type + use BeTRTracerType , only : betrtracer_type + + ! !ARGUMENTS: + class(bgc_reaction_sminn_type), intent(in) :: this + type(BeTRtracer_type ), intent(in) :: betrtracer_vars + type(bounds_type), intent(in) :: bounds + type(tracerboundarycond_type), intent(in) :: tracerboundarycond_vars + + ! !LOCAL VARIABLES: + integer, parameter :: bndcond_as_conc = 1 !top boundary conditions as tracer concentration + integer, parameter :: bndcond_as_flx=2 !top boundary condition as tracer flux + integer :: c + + tracerboundarycond_vars%topbc_type(:) = bndcond_as_flx + end subroutine init_boundary_condition_type + + !------------------------------------------------------------------------------- + subroutine Init_betrbgc(this, bounds, lbj, ubj, betrtracer_vars) + ! + ! !DESCRIPTION: + ! initialize the betrbgc + ! !USES: + use BeTRTracerType , only : betrtracer_type + use MathfuncMod , only : addone + + ! !ARGUMENTS: + class(bgc_reaction_sminn_type), intent(in) :: this + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: lbj, ubj + type(BeTRtracer_type ), intent(inout) :: betrtracer_vars + + ! !LOCAL VARIABLES: + character(len=*), parameter :: subname ='Init_betrbgc' + integer :: itemp_gwm + integer :: itemp_gwm_grp + integer :: item_grp + integer :: dum + integer :: itemp_grp + + itemp_gwm = 0; itemp_gwm_grp = 0 + + betrtracer_vars%id_trc_nh3x = addone(itemp_gwm); dum = addone(itemp_gwm_grp) + betrtracer_vars%id_trc_no3x = addone(itemp_gwm); dum = addone(itemp_gwm_grp) + + betrtracer_vars%ngwmobile_tracers = itemp_gwm; betrtracer_vars%ngwmobile_tracer_groups= itemp_gwm_grp + betrtracer_vars%nmem_max = 1 + + call betrtracer_vars%Init() + itemp_grp = 0 !group id + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_nh3x, trc_name='NH3x', & + is_trc_mobile=.false., is_trc_advective = .false., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.false.) + + call betrtracer_vars%set_tracer(trc_id = betrtracer_vars%id_trc_no3x, trc_name='NO3x', & + is_trc_mobile=.true., is_trc_advective = .true., trc_group_id = addone(itemp_grp), & + trc_group_mem = 1, is_trc_volatile=.false.,trc_vtrans_scal=0._r8) + + end subroutine Init_betrbgc + + !------------------------------------------------------------------------------- + subroutine set_boundary_conditions(this, bounds, num_soilc, filter_soilc, dz_top, betrtracer_vars, & + waterflux_vars, tracerboundarycond_vars) + ! + ! !DESCRIPTION: + ! set up boundary conditions for tracer movement + ! !USES: + use clm_varctl , only : iulog + use TracerBoundaryCondType, only : tracerboundarycond_type + use abortutils , only : endrun + use shr_log_mod , only : errMsg => shr_log_errMsg + use BeTRTracerType , only : betrtracer_type + use WaterfluxType , only : waterflux_type + + ! !ARGUMENTS: + class(bgc_reaction_sminn_type), intent(in) :: this + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: num_soilc ! number of columns in column filter_soilc + integer, intent(in) :: filter_soilc(:) ! column filter_soilc + type(betrtracer_type), intent(in) :: betrtracer_vars + real(r8), intent(in) :: dz_top(bounds%begc: ) + type(waterflux_type), intent(in) :: waterflux_vars + type(tracerboundarycond_type), intent(inout) :: tracerboundarycond_vars ! + + ! !LOCAL VARIABLES: + integer :: fc, c + character(len=255) :: subname = 'set_boundary_conditions' + + SHR_ASSERT_ALL((ubound(dz_top) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + + associate( & + groupid => betrtracer_vars%groupid & + ) + + do fc = 1, num_soilc + c = filter_soilc(fc) + + !eventually, the following code will be implemented using polymorphism + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_no3x) = 0._r8 + tracerboundarycond_vars%tracer_gwdif_concflux_top_col(c,1:2,betrtracer_vars%id_trc_nh3x) = 0._r8 + + tracerboundarycond_vars%bot_concflux_col(c,1,:) = 0._r8 !zero flux boundary condition + + enddo + end associate + end subroutine set_boundary_conditions + + !------------------------------------------------------------------------------- + subroutine calc_bgc_reaction(this, bounds, lbj, ubj, num_soilc, filter_soilc, num_soilp, filter_soilp, jtops, & + dtime, betrtracer_vars, tracercoeff_vars, waterstate_vars, temperature_vars, soilstate_vars, chemstate_vars, & + cnstate_vars, carbonstate_vars, carbonflux_vars, nitrogenstate_vars, nitrogenflux_vars, tracerstate_vars, & + tracerflux_vars, plantsoilnutrientflux_vars) + ! + ! !DESCRIPTION: + ! do bgc reaction + ! !USES: + ! + use tracerfluxType , only : tracerflux_type + use tracerstatetype , only : tracerstate_type + use tracercoeffType , only : tracercoeff_type + use BetrTracerType , only : betrtracer_type + use WaterStateType , only : Waterstate_Type + use TemperatureType , only : temperature_type + use SoilStatetype , only : soilstate_type + use ChemStateType , only : chemstate_type + use CanopyStateType , only : canopystate_type + use CNStateType , only : cnstate_type + use PlantSoilnutrientFluxType, only : plantsoilnutrientflux_type + use CNCarbonFluxType , only : carbonflux_type + use CNCarbonStateType , only : carbonstate_type + use CNNitrogenFluxType , only : nitrogenflux_type + use CNNitrogenStateType , only : nitrogenstate_type + use clm_varpar , only : nlevtrc_soil + use clm_varcon , only : natomw + !ARGUMENTS + class(bgc_reaction_sminn_type) , intent(in) :: this + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_soilc ! number of columns in column filter_soilc + integer , intent(in) :: filter_soilc(:) ! column filter_soilc + integer , intent(in) :: num_soilp + integer , intent(in) :: filter_soilp(:) ! pft filter + integer , intent(in) :: jtops(bounds%begc: ) ! top index of each column + integer , intent(in) :: lbj, ubj ! lower and upper bounds, make sure they are > 0 + real(r8) , intent(in) :: dtime ! model time step + type(Waterstate_Type) , intent(in) :: waterstate_vars ! water state variables + type(temperature_type) , intent(in) :: temperature_vars ! energy state variable + type(soilstate_type) , intent(in) :: soilstate_vars + type(cnstate_type) , intent(inout) :: cnstate_vars + type(carbonstate_type) , intent(in) :: carbonstate_vars + type(carbonflux_type) , intent(inout) :: carbonflux_vars + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + type(chemstate_type) , intent(in) :: chemstate_vars + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(tracercoeff_type) , intent(in) :: tracercoeff_vars + type(tracerstate_type) , intent(inout) :: tracerstate_vars + type(tracerflux_type) , intent(inout) :: tracerflux_vars + type(plantsoilnutrientflux_type) , intent(inout) :: plantsoilnutrientflux_vars ! + character(len=*), parameter :: subname ='calc_bgc_reaction' + + !do nothing here + end subroutine calc_bgc_reaction + + !------------------------------------------------------------------------------- + subroutine do_tracer_equilibration(this, bounds, lbj, ubj, jtops, num_soilc, & + filter_soilc, betrtracer_vars, tracercoeff_vars, tracerstate_vars) + ! + ! !DESCRIPTION: + ! requilibrate tracers that has solid and mobile phases + ! using the theory of mass action. + + ! !USES: + use tracerstatetype , only : tracerstate_type + use tracercoeffType , only : tracercoeff_type + use BeTRTracerType , only : betrtracer_type + use BeTRTracerType , only : betrtracer_type + class(bgc_reaction_sminn_type), intent(in) :: this + + ! !ARGUMENTS: + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: lbj, ubj + integer, intent(in) :: jtops(bounds%begc: ) ! top label of each column + integer, intent(in) :: num_soilc + integer, intent(in) :: filter_soilc(:) + type(betrtracer_type), intent(in) :: betrtracer_vars + type(tracercoeff_type), intent(in) :: tracercoeff_vars + type(tracerstate_type), intent(inout) :: tracerstate_vars + character(len=255) :: subname = 'do_tracer_equilibration' + + + SHR_ASSERT_ALL((ubound(jtops) == (/bounds%endc/)), errMsg(__FILE__,__LINE__)) + + !depending on the simulation type, an implementation of aqueous chemistry will be + !employed to separate out the adsorbed phase + !It should be noted that this formulation excludes the use of linear isotherm, which + !can be integrated through the retardation factor + + + end subroutine do_tracer_equilibration + + !----------------------------------------------------------------------- + subroutine InitCold(this, bounds, betrtracer_vars, waterstate_vars, tracerstate_vars) + ! + ! !DESCRIPTION: + ! do cold initialization + ! + ! !USES: + use BeTRTracerType , only : BeTRTracer_Type + use tracerstatetype , only : tracerstate_type + use WaterstateType , only : waterstate_type + use PatchType , only : pft + use clm_varcon , only : spval, ispval + use landunit_varcon , only : istsoil, istcrop + + ! !ARGUMENTS: + class(bgc_reaction_sminn_type) , intent(in) :: this + type(bounds_type) , intent(in) :: bounds + type(BeTRTracer_Type) , intent(in) :: betrtracer_vars + type(waterstate_type) , intent(in) :: waterstate_vars + type(tracerstate_type) , intent(inout) :: tracerstate_vars + + ! + ! !LOCAL VARIABLES: + integer :: p, c, l, k, j + integer :: fc ! filter_soilc index + integer :: begc, endc + integer :: begg, endg + !----------------------------------------------------------------------- + + begc = bounds%begc; endc= bounds%endc + begg = bounds%begg; endg= bounds%endg + !----------------------------------------------------------------------- + + + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if (lun%ifspecial(l)) then + if(betrtracer_vars%ngwmobile_tracers>0)then + tracerstate_vars%tracer_conc_mobile_col(c,:,:) = spval + tracerstate_vars%tracer_conc_surfwater_col(c,:) = spval + tracerstate_vars%tracer_conc_aquifer_col(c,:) = spval + tracerstate_vars%tracer_conc_grndwater_col(c,:) = spval + endif + if(betrtracer_vars%ntracers > betrtracer_vars%ngwmobile_tracers)then + tracerstate_vars%tracer_conc_solid_passive_col(c,:,:) = spval + endif + if(betrtracer_vars%nsolid_equil_tracers>0)then + tracerstate_vars%tracer_conc_solid_equil_col(c, :, :) = spval + endif + endif + tracerstate_vars%tracer_soi_molarmass_col(c,:) = spval + + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + !dual phase tracers + + tracerstate_vars%tracer_conc_mobile_col(c,:, :) = 0._r8 + tracerstate_vars%tracer_conc_surfwater_col(c,:) = 0._r8 + tracerstate_vars%tracer_conc_aquifer_col(c,:) = 0._r8 + tracerstate_vars%tracer_conc_grndwater_col(c,:) = 0._r8 + + + !solid tracers + if(betrtracer_vars%ngwmobile_tracers < betrtracer_vars%ntracers)then + tracerstate_vars%tracer_conc_solid_passive_col(c,:,:) = 0._r8 + endif + + if(betrtracer_vars%nsolid_equil_tracers>0)then + tracerstate_vars%tracer_conc_solid_equil_col(c, :, :) = 0._r8 + endif + tracerstate_vars%tracer_soi_molarmass_col(c,:) = 0._r8 + endif + enddo + + end subroutine InitCold + + !----------------------------------------------------------------------- + subroutine readParams(this, ncid, betrtracer_vars) + + ! !DESCRIPTION: + ! read in parameters + ! !USES: + use ncdio_pio , only : file_desc_t + use BeTRTracerType , only : BeTRTracer_Type + + ! !ARGUMENTS: + class(bgc_reaction_sminn_type) , intent(in) :: this + type(BeTRTracer_Type) , intent(inout) :: betrtracer_vars + type(file_desc_t) , intent(inout) :: ncid ! pio netCDF file id + + !do nothing here + end subroutine readParams + + !------------------------------------------------------------------------------- + subroutine betr_alm_flux_statevar_feedback(this, bounds, num_soilc, filter_soilc, & + carbonstate_vars, nitrogenstate_vars, nitrogenflux_vars, tracerstate_vars, & + tracerflux_vars, betrtracer_vars) + ! + ! !DESCRIPTION: + ! do state variable and flux variable exchange between betr and alm + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use tracerfluxType , only : tracerflux_type + use tracerstatetype , only : tracerstate_type + use decompMod , only : bounds_type + use BeTRTracerType , only : BeTRTracer_Type + use CNCarbonStateType , only : carbonstate_type + use CNNitrogenStateType , only : nitrogenstate_type + use CNNitrogenFluxType , only : nitrogenflux_type + + ! !ARGUMENTS : + class(bgc_reaction_sminn_type) , intent(in) :: this + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_soilc ! number of columns in column filter + integer , intent(in) :: filter_soilc(:) ! column filter + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(tracerstate_type) , intent(in) :: tracerstate_vars + type(tracerflux_type) , intent(in) :: tracerflux_vars + type(carbonstate_type) , intent(inout) :: carbonstate_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars ! + + call assign_sminn_pools(bounds, num_soilc, filter_soilc, carbonstate_vars, & + nitrogenstate_vars, tracerstate_vars, betrtracer_vars) + + call assign_minnitrogen_hydroloss(bounds, num_soilc, filter_soilc, & + tracerflux_vars, nitrogenflux_vars, betrtracer_vars) + + end subroutine betr_alm_flux_statevar_feedback + + !------------------------------------------------------------------------------- + + subroutine init_betr_alm_bgc_coupler(this, bounds, carbonstate_vars, & + nitrogenstate_vars, betrtracer_vars, tracerstate_vars) + ! + ! !DESCRIPTION: + ! initialize state and flux variable exchange between betr and alm + ! !USES: + use clm_varcon , only : natomw, catomw + use clm_varpar , only : i_cwd, i_met_lit, i_cel_lit, i_lig_lit + use CNCarbonStateType , only : carbonstate_type + use CNNitrogenStateType , only : nitrogenstate_type + use tracerstatetype , only : tracerstate_type + use BetrTracerType , only : betrtracer_type + use clm_varpar , only : nlevtrc_soil + use landunit_varcon , only : istsoil, istcrop + + ! !ARGUMENTS : + class(bgc_reaction_sminn_type) , intent(in) :: this + type(bounds_type) , intent(in) :: bounds + type(tracerstate_type) , intent(inout) :: tracerstate_vars + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(carbonstate_type) , intent(in) :: carbonstate_vars + type(nitrogenstate_type) , intent(in) :: nitrogenstate_vars + + ! !LOCAL VARIABLES: + integer :: j, fc, c, l + associate( & + id_trc_no3x => betrtracer_vars%id_trc_no3x , & + id_trc_nh3x => betrtracer_vars%id_trc_nh3x , & + smin_no3_vr_col => nitrogenstate_vars%smin_no3_vr_col , & + smin_nh4_vr_col => nitrogenstate_vars%smin_nh4_vr_col , & + tracer_conc_mobile => tracerstate_vars%tracer_conc_mobile_col & + ) + + do j = 1, nlevtrc_soil + do c = bounds%begc, bounds%endc + l = col%landunit(c) + if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then + + tracer_conc_mobile(c,j,id_trc_no3x) = smin_no3_vr_col(c,j) / natomw + tracer_conc_mobile(c,j,id_trc_nh3x) = smin_nh4_vr_col(c,j) /natomw + endif + enddo + enddo + + end associate + end subroutine init_betr_alm_bgc_coupler + !------------------------------------------------------------------------------- + subroutine assign_minnitrogen_hydroloss(bounds, num_soilc, filter_soilc, tracerflux_vars, & + nitrogenflux_vars, betrtracer_vars) + + ! + ! !DESCRIPTION: + ! feedback the nitrogen hydrological fluxes, this comes after tracer mass balance, so the flux is with the unit of st/m2/s + ! !USES: + use tracerfluxType , only : tracerflux_type + use BetrTracerType , only : betrtracer_type + use CNNitrogenFluxType , only : nitrogenflux_type + use clm_varcon , only : natomw + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_soilc ! number of columns in column filter + integer , intent(in) :: filter_soilc(:) ! column filter + type(tracerflux_type) , intent(in) :: tracerflux_vars + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + + ! !LOCAL VARIABLES: + integer :: fc, c + !get nitrogen leaching, and loss through surface runoff + + associate( & + id_trc_no3x => betrtracer_vars%id_trc_no3x & + ) + + do fc = 1, num_soilc + c = filter_soilc(fc) + nitrogenflux_vars%smin_no3_leached_col(c) = tracerflux_vars%tracer_flx_totleached_col(c,id_trc_no3x)*natomw + nitrogenflux_vars%smin_no3_runoff_col(c) = tracerflux_vars%tracer_flx_surfrun_col(c,id_trc_no3x)*natomw + enddo + + end associate + end subroutine assign_minnitrogen_hydroloss + + !------------------------------------------------------------------------------- + subroutine assign_sminn_pools(bounds, num_soilc, filter_soilc, carbonstate_vars, & + nitrogenstate_vars, tracerstate_vars, betrtracer_vars) + ! + ! !DESCRIPTION: + ! update mineral nitrogen pool + ! !USES: + use clm_varcon , only : natomw, catomw + use clm_varpar , only : i_cwd, i_met_lit, i_cel_lit, i_lig_lit + use CNCarbonStateType , only : carbonstate_type + use CNNitrogenStateType , only : nitrogenstate_type + use tracerstatetype , only : tracerstate_type + use BetrTracerType , only : betrtracer_type + use clm_varpar , only : nlevtrc_soil + ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: num_soilc ! number of columns in column filter + integer , intent(in) :: filter_soilc(:) ! column filter + type(tracerstate_type) , intent(in) :: tracerstate_vars + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(carbonstate_type) , intent(inout) :: carbonstate_vars + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars ! + + ! !LOCAL VARIABLES: + integer, parameter :: i_soil1 = 5 + integer, parameter :: i_soil2 = 6 + integer, parameter :: i_soil3 = 7 + + integer :: fc, c, j, k + associate( & + id_trc_no3x => betrtracer_vars%id_trc_no3x , & + id_trc_nh3x => betrtracer_vars%id_trc_nh3x , & + smin_no3_vr_col => nitrogenstate_vars%smin_no3_vr_col , & + smin_nh4_vr_col => nitrogenstate_vars%smin_nh4_vr_col , & + sminn_vr_col => nitrogenstate_vars%sminn_vr_col , & + tracer_conc_mobile => tracerstate_vars%tracer_conc_mobile_col & + ) + + do j = 1, nlevtrc_soil + do fc = 1, num_soilc + c = filter_soilc(fc) + + smin_no3_vr_col(c,j) = tracer_conc_mobile(c,j,id_trc_no3x)*natomw + smin_nh4_vr_col(c,j) = tracer_conc_mobile(c,j,id_trc_nh3x)*natomw + sminn_vr_col (c,j) = smin_no3_vr_col(c,j) + smin_nh4_vr_col(c,j) + + enddo + enddo + + end associate + end subroutine assign_sminn_pools + +end module BGCReactionsSminNType diff --git a/components/clm/src/biogeochem/CNAllocationBetrMod.F90 b/components/clm/src/biogeochem/CNAllocationBetrMod.F90 new file mode 100644 index 000000000000..7f9589e3e669 --- /dev/null +++ b/components/clm/src/biogeochem/CNAllocationBetrMod.F90 @@ -0,0 +1,974 @@ +module CNAllocationBetrMod + +#include "shr_assert.h" + + !----------------------------------------------------------------------- + ! !DESCRIPTION: + ! Module holding routines used in allocation model for coupled carbon + ! nitrogen code. + ! + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use clm_varcon , only : dzsoi_decomp + use clm_varctl , only : use_c13, use_c14, use_nitrif_denitrif + use abortutils , only : endrun + use decompMod , only : bounds_type + use subgridAveMod , only : p2c + use CanopyStateType , only : canopystate_type + use CNCarbonFluxType , only : carbonflux_type + use CNCarbonStateType , only : carbonstate_type + use CNNitrogenFluxType , only : nitrogenflux_type + use CNNitrogenStateType , only : nitrogenstate_type + use CNStateType , only : cnstate_type + use PhotosynthesisType , only : photosyns_type + use CropType , only : crop_type + use EcophysConType , only : ecophyscon + use LandunitType , only : lun + use ColumnType , only : col + use PatchType , only : pft + ! + implicit none + save + private + ! + ! !PUBLIC MEMBER FUNCTIONS: + public :: readCNAllocBetrParams + public :: CNAllocationBetrInit ! Initialization + public :: calc_plant_nutrient_demand + public :: plantCNAlloc + type :: CNAllocParamsType + real(r8) :: bdnr ! bulk denitrification rate (1/s) + real(r8) :: dayscrecover ! number of days to recover negative cpool + real(r8) :: compet_plant_no3 ! (unitless) relative compettiveness of plants for NO3 + real(r8) :: compet_plant_nh4 ! (unitless) relative compettiveness of plants for NH4 + real(r8) :: compet_decomp_no3 ! (unitless) relative competitiveness of immobilizers for NO3 + real(r8) :: compet_decomp_nh4 ! (unitless) relative competitiveness of immobilizers for NH4 + real(r8) :: compet_denit ! (unitless) relative competitiveness of denitrifiers for NO3 + real(r8) :: compet_nit ! (unitless) relative competitiveness of nitrifiers for NH4 + end type CNAllocParamsType + ! + ! CNAllocParamsInst is populated in readCNAllocParams which is called in + type(CNAllocParamsType),protected :: CNAllocParamsInst + ! + ! !PUBLIC DATA MEMBERS: + character(len=*), parameter, public :: suplnAll='ALL' ! Supplemental Nitrogen for all PFT's + character(len=*), parameter, public :: suplnNon='NONE' ! No supplemental Nitrogen + character(len=15) , public :: suplnitro = suplnNon ! Supplemental Nitrogen mode + ! + ! !PRIVATE DATA MEMBERS: + real(r8) :: dt !decomp timestep (seconds) + real(r8) :: bdnr !bulk denitrification rate (1/s) + real(r8) :: dayscrecover !number of days to recover negative cpool + real(r8), allocatable :: arepr(:) !reproduction allocation coefficient + real(r8), allocatable :: aroot(:) !root allocation coefficient + !----------------------------------------------------------------------- + +contains + + !----------------------------------------------------------------------- + subroutine readCNAllocBetrParams ( ncid ) + ! + ! !USES: + use ncdio_pio , only : file_desc_t,ncd_io + + ! !ARGUMENTS: + implicit none + type(file_desc_t),intent(inout) :: ncid ! pio netCDF file id + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'CNAllocParamsType' ! + character(len=100) :: errCode = '-Error reading in parameters file:' ! + logical :: readv ! has variable been read in or not + real(r8) :: tempr ! temporary to read in parameter + character(len=100) :: tString ! temp. var for reading + !----------------------------------------------------------------------- + + ! read in parameters + + tString='bdnr' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNAllocParamsInst%bdnr=tempr + + tString='dayscrecover' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNAllocParamsInst%dayscrecover=tempr + + tString='compet_plant_no3' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNAllocParamsInst%compet_plant_no3=tempr + + tString='compet_plant_nh4' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNAllocParamsInst%compet_plant_nh4=tempr + + tString='compet_decomp_no3' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNAllocParamsInst%compet_decomp_no3=tempr + + tString='compet_decomp_nh4' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNAllocParamsInst%compet_decomp_nh4=tempr + + tString='compet_denit' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNAllocParamsInst%compet_denit=tempr + + tString='compet_nit' + call ncd_io(varname=trim(tString),data=tempr, flag='read', ncid=ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(__FILE__, __LINE__)) + CNAllocParamsInst%compet_nit=tempr + + end subroutine readCNAllocBetrParams + + !----------------------------------------------------------------------- + subroutine CNAllocationBetrInit ( bounds) + ! + ! !DESCRIPTION: + ! + ! !USES: + use clm_varcon , only: secspday + use clm_time_manager, only: get_step_size + use clm_varpar , only: crop_prog + use clm_varctl , only: iulog, cnallocate_carbon_only_set + use shr_infnan_mod , only: nan => shr_infnan_nan, assignment(=) + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + character(len=32) :: subname = 'CNAllocationInit' + logical :: carbon_only + !----------------------------------------------------------------------- + + if ( crop_prog )then + allocate(arepr(bounds%begp:bounds%endp)); arepr(bounds%begp : bounds%endp) = nan + allocate(aroot(bounds%begp:bounds%endp)); aroot(bounds%begp : bounds%endp) = nan + end if + + + ! set time steps + dt = real( get_step_size(), r8 ) + + ! set space-and-time parameters from parameter file + bdnr = CNAllocParamsInst%bdnr * (dt/secspday) + dayscrecover = CNAllocParamsInst%dayscrecover + + ! Change namelist settings into private logical variables + select case(suplnitro) + case(suplnNon) + Carbon_only = .false. + case(suplnAll) + Carbon_only = .true. + case default + write(iulog,*) 'Supplemental Nitrogen flag (suplnitro) can only be: ', & + suplnNon, ' or ', suplnAll + call endrun(msg='ERROR: supplemental Nitrogen flag is not correct'//& + errMsg(__FILE__, __LINE__)) + end select + + end subroutine CNAllocationBetrInit + + +!------------------------------------------------------------------------------- + + subroutine plantCNAlloc(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + photosyns_vars, cnstate_vars, carbonstate_vars, carbonflux_vars, & + c13_carbonflux_vars, c14_carbonflux_vars, nitrogenstate_vars, nitrogenflux_vars) + ! + ! DESCRIPTION + ! + ! do plant productivity downregulation after considering nutrient limitation + + + ! + ! !USES: + use shr_sys_mod , only: shr_sys_flush + use clm_varctl , only: iulog, cnallocate_carbon_only + use pftvarcon , only: npcropmin, declfact, bfact, aleaff, arootf, astemf + use pftvarcon , only: arooti, fleafi, allconsl, allconss, grperc, grpnow, nsoybean + use clm_varpar , only: nlevsoi, nlevdecomp + use clm_varcon , only: nitrif_n2o_loss_frac, secspday + use landunit_varcon , only: istsoil, istcrop + use clm_time_manager , only: get_step_size + use clm_varctl , only: use_c13, use_c14 + implicit none + ! + ! !ARGUMENTS: + 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_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(photosyns_type) , intent(in) :: photosyns_vars + type(cnstate_type) , intent(inout) :: cnstate_vars + type(carbonstate_type) , intent(in) :: carbonstate_vars + type(carbonflux_type) , intent(inout) :: carbonflux_vars + type(carbonflux_type) , intent(inout) :: c13_carbonflux_vars + type(carbonflux_type) , intent(inout) :: c14_carbonflux_vars + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + + ! + ! !LOCAL VARIABLES: + + ! + integer :: c,p,l,pi,j !indices + integer :: fp !lake filter pft index + integer :: fc !lake filter column index + real(r8):: f1,f2,f3,f4,g1,g2 !allocation parameters + real(r8):: cnl,cnfr,cnlw,cndw !C:N ratios for leaf, fine root, and wood + real(r8):: fcur !fraction of current psn displayed as growth + real(r8):: gresp_storage !temporary variable for growth resp to storage + real(r8):: nlc !temporary variable for total new leaf carbon allocation + real(r8):: f5 !grain allocation parameter + real(r8):: cng !C:N ratio for grain (= cnlw for now; slevis) + !----------------------------------------------------------------------- + + associate( & + ivt => pft%itype , & ! Input: [integer (:) ] pft vegetation type + + woody => ecophyscon%woody , & ! Input: [real(r8) (:) ] binary flag for woody lifeform (1=woody, 0=not woody) + froot_leaf => ecophyscon%froot_leaf , & ! Input: [real(r8) (:) ] allocation parameter: new fine root C per new leaf C (gC/gC) + croot_stem => ecophyscon%croot_stem , & ! Input: [real(r8) (:) ] allocation parameter: new coarse root C per new stem C (gC/gC) + stem_leaf => ecophyscon%stem_leaf , & ! Input: [real(r8) (:) ] allocation parameter: new stem c per new leaf C (gC/gC) + flivewd => ecophyscon%flivewd , & ! Input: [real(r8) (:) ] allocation parameter: fraction of new wood that is live (phloem and ray parenchyma) (no units) + leafcn => ecophyscon%leafcn , & ! Input: [real(r8) (:) ] leaf C:N (gC/gN) + frootcn => ecophyscon%frootcn , & ! Input: [real(r8) (:) ] fine root C:N (gC/gN) + livewdcn => ecophyscon%livewdcn , & ! Input: [real(r8) (:) ] live wood (phloem and ray parenchyma) C:N (gC/gN) + deadwdcn => ecophyscon%deadwdcn , & ! Input: [real(r8) (:) ] dead wood (xylem and heartwood) C:N (gC/gN) + fcur2 => ecophyscon%fcur , & ! Input: [real(r8) (:) ] allocation parameter: fraction of allocation that goes to currently displayed growth, remainder to storage + graincn => ecophyscon%graincn , & ! Input: [real(r8) (:) ] grain C:N (gC/gN) + psnsun => photosyns_vars%psnsun_patch , & ! Input: [real(r8) (:) ] sunlit leaf-level photosynthesis (umol CO2 /m**2/ s) + psnsha => photosyns_vars%psnsha_patch , & ! Input: [real(r8) (:) ] shaded leaf-level photosynthesis (umol CO2 /m**2/ s) + leafc => carbonstate_vars%leafc_patch , & ! Input: [real(r8) (:) ] + frootc => carbonstate_vars%frootc_patch , & ! Input: [real(r8) (:) ] + livestemc => carbonstate_vars%livestemc_patch , & ! Input: [real(r8) (:) ] + croplive => cnstate_vars%croplive_patch , & ! Input: [logical (:) ] flag, true if planted, not harvested + aleaf => cnstate_vars%aleaf_patch , & ! Output: [real(r8) (:) ] leaf allocation coefficient + astem => cnstate_vars%astem_patch , & ! Output: [real(r8) (:) ] stem allocation coefficient + fpg => cnstate_vars%fpg_col , & ! Output: [real(r8) (:) ] fraction of potential gpp (no units) + c_allometry => cnstate_vars%c_allometry_patch , & ! Output: [real(r8) (:) ] C allocation index (DIM) + n_allometry => cnstate_vars%n_allometry_patch , & ! Output: [real(r8) (:) ] N allocation index (DIM) = + downreg => cnstate_vars%downreg_patch , & ! Output: [real(r8) (:) ] fractional reduction in GPP due to N limitation (DIM) + + annsum_npp => carbonflux_vars%annsum_npp_patch , & ! Input: [real(r8) (:) ] annual sum of NPP, for wood allocation + gpp => carbonflux_vars%gpp_before_downreg_patch , & ! Output: [real(r8) (:) ] GPP flux before downregulation (gC/m2/s) + availc => carbonflux_vars%availc_patch , & ! Output: [real(r8) (:) ] C flux available for allocation (gC/m2/s) + excess_cflux => carbonflux_vars%excess_cflux_patch , & ! Output: [real(r8) (:) ] C flux not allocated due to downregulation (gC/m2/s) + plant_calloc => carbonflux_vars%plant_calloc_patch , & ! Output: [real(r8) (:) ] total allocated C flux (gC/m2/s) + psnsun_to_cpool => carbonflux_vars%psnsun_to_cpool_patch , & ! Output: [real(r8) (:) ] + psnshade_to_cpool => carbonflux_vars%psnshade_to_cpool_patch , & ! Output: [real(r8) (:) ] + + cpool_to_leafc => carbonflux_vars%cpool_to_leafc_patch , & ! Output: [real(r8) (:) ] + cpool_to_leafc_storage => carbonflux_vars%cpool_to_leafc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_frootc => carbonflux_vars%cpool_to_frootc_patch , & ! Output: [real(r8) (:) ] + cpool_to_frootc_storage => carbonflux_vars%cpool_to_frootc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_livestemc => carbonflux_vars%cpool_to_livestemc_patch , & ! Output: [real(r8) (:) ] + cpool_to_livestemc_storage => carbonflux_vars%cpool_to_livestemc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_deadstemc => carbonflux_vars%cpool_to_deadstemc_patch , & ! Output: [real(r8) (:) ] + cpool_to_deadstemc_storage => carbonflux_vars%cpool_to_deadstemc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_livecrootc => carbonflux_vars%cpool_to_livecrootc_patch , & ! Output: [real(r8) (:) ] + cpool_to_livecrootc_storage => carbonflux_vars%cpool_to_livecrootc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_deadcrootc => carbonflux_vars%cpool_to_deadcrootc_patch , & ! Output: [real(r8) (:) ] + cpool_to_deadcrootc_storage => carbonflux_vars%cpool_to_deadcrootc_storage_patch , & ! Output: [real(r8) (:) ] + cpool_to_gresp_storage => carbonflux_vars%cpool_to_gresp_storage_patch , & ! Output: [real(r8) (:) ] allocation to growth respiration storage (gC/m2/s) + cpool_to_grainc => carbonflux_vars%cpool_to_grainc_patch , & ! Output: [real(r8) (:) ] allocation to grain C (gC/m2/s) + cpool_to_grainc_storage => carbonflux_vars%cpool_to_grainc_storage_patch , & ! Output: [real(r8) (:) ] allocation to grain C storage (gC/m2/s) + + retransn => nitrogenstate_vars%retransn_patch , & ! Input: [real(r8) (:) ] (gN/m2) plant pool of retranslocated N + + plant_ndemand => nitrogenflux_vars%plant_ndemand_patch , & ! Output: [real(r8) (:) ] N flux required to support initial GPP (gN/m2/s) + plant_nalloc => nitrogenflux_vars%plant_nalloc_patch , & ! Output: [real(r8) (:) ] total allocated N flux (gN/m2/s) + npool_to_grainn => nitrogenflux_vars%npool_to_grainn_patch , & ! Output: [real(r8) (:) ] allocation to grain N (gN/m2/s) + npool_to_grainn_storage => nitrogenflux_vars%npool_to_grainn_storage_patch , & ! Output: [real(r8) (:) ] allocation to grain N storage (gN/m2/s) + retransn_to_npool => nitrogenflux_vars%retransn_to_npool_patch , & ! Output: [real(r8) (:) ] deployment of retranslocated N (gN/m2/s) + sminn_to_npool => nitrogenflux_vars%sminn_to_npool_patch , & ! Output: [real(r8) (:) ] deployment of soil mineral N uptake (gN/m2/s) + npool_to_leafn => nitrogenflux_vars%npool_to_leafn_patch , & ! Output: [real(r8) (:) ] allocation to leaf N (gN/m2/s) + npool_to_leafn_storage => nitrogenflux_vars%npool_to_leafn_storage_patch , & ! Output: [real(r8) (:) ] allocation to leaf N storage (gN/m2/s) + npool_to_frootn => nitrogenflux_vars%npool_to_frootn_patch , & ! Output: [real(r8) (:) ] allocation to fine root N (gN/m2/s) + npool_to_frootn_storage => nitrogenflux_vars%npool_to_frootn_storage_patch , & ! Output: [real(r8) (:) ] allocation to fine root N storage (gN/m2/s) + npool_to_livestemn => nitrogenflux_vars%npool_to_livestemn_patch , & ! Output: [real(r8) (:) ] + npool_to_livestemn_storage => nitrogenflux_vars%npool_to_livestemn_storage_patch , & ! Output: [real(r8) (:) ] + npool_to_deadstemn => nitrogenflux_vars%npool_to_deadstemn_patch , & ! Output: [real(r8) (:) ] + npool_to_deadstemn_storage => nitrogenflux_vars%npool_to_deadstemn_storage_patch , & ! Output: [real(r8) (:) ] + npool_to_livecrootn => nitrogenflux_vars%npool_to_livecrootn_patch , & ! Output: [real(r8) (:) ] + npool_to_livecrootn_storage => nitrogenflux_vars%npool_to_livecrootn_storage_patch , & ! Output: [real(r8) (:) ] + npool_to_deadcrootn => nitrogenflux_vars%npool_to_deadcrootn_patch , & ! Output: [real(r8) (:) ] + npool_to_deadcrootn_storage => nitrogenflux_vars%npool_to_deadcrootn_storage_patch , & ! Output: [real(r8) (:) ] + frootn_to_retransn => nitrogenflux_vars%frootn_to_retransn_patch , & ! Output: [real(r8) (:) ] + sminn_to_plant => nitrogenflux_vars%sminn_to_plant_col , & ! Output: [real(r8) (:) ] + + c13cf => c13_carbonflux_vars, & + c14cf => c14_carbonflux_vars & + ) + + + ! start new pft loop to distribute the available N between the + ! competing patches on the basis of relative demand, and allocate C and N to + ! new growth and storage + + do fp=1,num_soilp + p = filter_soilp(fp) + c = pft%column(p) + + ! set some local allocation variables + f1 = froot_leaf(ivt(p)) + f2 = croot_stem(ivt(p)) + + ! modified wood allocation to be 2.2 at npp=800 gC/m2/yr, 0.2 at npp=0, + ! constrained so that it does not go lower than 0.2 (under negative annsum_npp) + ! There was an error in this formula in previous version, where the coefficient + ! was 0.004 instead of 0.0025. + ! This variable allocation is only for trees. Shrubs have a constant + ! allocation as specified in the pft-physiology file. The value is also used + ! as a trigger here: -1.0 means to use the dynamic allocation (trees). + if (stem_leaf(ivt(p)) == -1._r8) then + f3 = (2.7/(1.0+exp(-0.004*(annsum_npp(p) - 300.0)))) - 0.4 + else + f3 = stem_leaf(ivt(p)) + end if + + f4 = flivewd(ivt(p)) + g1 = grperc(ivt(p)) + g2 = grpnow(ivt(p)) + cnl = leafcn(ivt(p)) + cnfr = frootcn(ivt(p)) + cnlw = livewdcn(ivt(p)) + cndw = deadwdcn(ivt(p)) + fcur = fcur2(ivt(p)) + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + if (croplive(p)) then + f1 = aroot(p) / aleaf(p) + f3 = astem(p) / aleaf(p) + f5 = arepr(p) / aleaf(p) + g1 = 0.25_r8 + else + f1 = 0._r8 + f3 = 0._r8 + f5 = 0._r8 + g1 = 0.25_r8 + end if + end if + + ! increase fcur linearly with ndays_active, until fcur reaches 1.0 at + ! ndays_active = days/year. This prevents the continued storage of C and N. + ! turning off this correction (PET, 12/11/03), instead using bgtr in + ! phenology algorithm. + !fcur = fcur + (1._r8 - fcur)*lgsf(p) + sminn_to_npool(p) = plant_ndemand(p) * fpg(c) + plant_nalloc(p) = sminn_to_npool(p) + retransn_to_npool(p) + + + ! calculate the associated carbon allocation, and the excess + ! carbon flux that must be accounted for through downregulation + plant_calloc(p) = plant_nalloc(p) * (c_allometry(p)/n_allometry(p)) + excess_cflux(p) = availc(p) - plant_calloc(p) + + ! reduce gpp fluxes due to N limitation + if (gpp(p) > 0.0_r8) then + downreg(p) = excess_cflux(p)/gpp(p) + psnsun_to_cpool(p) = psnsun_to_cpool(p) *(1._r8 - downreg(p)) + psnshade_to_cpool(p) = psnshade_to_cpool(p)*(1._r8 - downreg(p)) + if ( use_c13 ) then + c13cf%psnsun_to_cpool_patch(p) = c13cf%psnsun_to_cpool_patch(p) *(1._r8 - downreg(p)) + c13cf%psnshade_to_cpool_patch(p) = c13cf%psnshade_to_cpool_patch(p)*(1._r8 - downreg(p)) + endif + + if ( use_c14 ) then + c14cf%psnsun_to_cpool_patch(p) = c14cf%psnsun_to_cpool_patch(p) *(1._r8 - downreg(p)) + c14cf%psnshade_to_cpool_patch(p) = c14cf%psnshade_to_cpool_patch(p)*(1._r8 - downreg(p)) + endif + end if + + ! calculate the amount of new leaf C dictated by these allocation + ! decisions, and calculate the daily fluxes of C and N to current + ! growth and storage pools + + ! fcur is the proportion of this day's growth that is displayed now, + ! the remainder going into storage for display next year through the + ! transfer pools + + nlc = plant_calloc(p) / c_allometry(p) + + cpool_to_leafc(p) = nlc * fcur + cpool_to_leafc_storage(p) = nlc * (1._r8 - fcur) + cpool_to_frootc(p) = nlc * f1 * fcur + cpool_to_frootc_storage(p) = nlc * f1 * (1._r8 - fcur) + if (woody(ivt(p)) == 1._r8) then + cpool_to_livestemc(p) = nlc * f3 * f4 * fcur + cpool_to_livestemc_storage(p) = nlc * f3 * f4 * (1._r8 - fcur) + cpool_to_deadstemc(p) = nlc * f3 * (1._r8 - f4) * fcur + cpool_to_deadstemc_storage(p) = nlc * f3 * (1._r8 - f4) * (1._r8 - fcur) + cpool_to_livecrootc(p) = nlc * f2 * f3 * f4 * fcur + cpool_to_livecrootc_storage(p) = nlc * f2 * f3 * f4 * (1._r8 - fcur) + cpool_to_deadcrootc(p) = nlc * f2 * f3 * (1._r8 - f4) * fcur + cpool_to_deadcrootc_storage(p) = nlc * f2 * f3 * (1._r8 - f4) * (1._r8 - fcur) + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cpool_to_livestemc(p) = nlc * f3 * f4 * fcur + cpool_to_livestemc_storage(p) = nlc * f3 * f4 * (1._r8 - fcur) + cpool_to_deadstemc(p) = nlc * f3 * (1._r8 - f4) * fcur + cpool_to_deadstemc_storage(p) = nlc * f3 * (1._r8 - f4) * (1._r8 - fcur) + cpool_to_livecrootc(p) = nlc * f2 * f3 * f4 * fcur + cpool_to_livecrootc_storage(p) = nlc * f2 * f3 * f4 * (1._r8 - fcur) + cpool_to_deadcrootc(p) = nlc * f2 * f3 * (1._r8 - f4) * fcur + cpool_to_deadcrootc_storage(p) = nlc * f2 * f3 * (1._r8 - f4) * (1._r8 - fcur) + cpool_to_grainc(p) = nlc * f5 * fcur + cpool_to_grainc_storage(p) = nlc * f5 * (1._r8 -fcur) + end if + + ! corresponding N fluxes + npool_to_leafn(p) = (nlc / cnl) * fcur + npool_to_leafn_storage(p) = (nlc / cnl) * (1._r8 - fcur) + npool_to_frootn(p) = (nlc * f1 / cnfr) * fcur + npool_to_frootn_storage(p) = (nlc * f1 / cnfr) * (1._r8 - fcur) + if (woody(ivt(p)) == 1._r8) then + npool_to_livestemn(p) = (nlc * f3 * f4 / cnlw) * fcur + npool_to_livestemn_storage(p) = (nlc * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadstemn(p) = (nlc * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadstemn_storage(p) = (nlc * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_livecrootn(p) = (nlc * f2 * f3 * f4 / cnlw) * fcur + npool_to_livecrootn_storage(p) = (nlc * f2 * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadcrootn(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadcrootn_storage(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + cng = graincn(ivt(p)) + npool_to_livestemn(p) = (nlc * f3 * f4 / cnlw) * fcur + npool_to_livestemn_storage(p) = (nlc * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadstemn(p) = (nlc * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadstemn_storage(p) = (nlc * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_livecrootn(p) = (nlc * f2 * f3 * f4 / cnlw) * fcur + npool_to_livecrootn_storage(p) = (nlc * f2 * f3 * f4 / cnlw) * (1._r8 - fcur) + npool_to_deadcrootn(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * fcur + npool_to_deadcrootn_storage(p) = (nlc * f2 * f3 * (1._r8 - f4) / cndw) * (1._r8 - fcur) + npool_to_grainn(p) = (nlc * f5 / cng) * fcur + npool_to_grainn_storage(p) = (nlc * f5 / cng) * (1._r8 -fcur) + end if + + ! Calculate the amount of carbon that needs to go into growth + ! respiration storage to satisfy all of the storage growth demands. + ! Allows for the fraction of growth respiration that is released at the + ! time of fixation, versus the remaining fraction that is stored for + ! release at the time of display. Note that all the growth respiration + ! fluxes that get released on a given timestep are calculated in growth_resp(), + ! but that the storage of C for growth resp during display of transferred + ! growth is assigned here. + + gresp_storage = cpool_to_leafc_storage(p) + cpool_to_frootc_storage(p) + if (woody(ivt(p)) == 1._r8) then + gresp_storage = gresp_storage + cpool_to_livestemc_storage(p) + gresp_storage = gresp_storage + cpool_to_deadstemc_storage(p) + gresp_storage = gresp_storage + cpool_to_livecrootc_storage(p) + gresp_storage = gresp_storage + cpool_to_deadcrootc_storage(p) + end if + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + gresp_storage = gresp_storage + cpool_to_livestemc_storage(p) + gresp_storage = gresp_storage + cpool_to_grainc_storage(p) + end if + cpool_to_gresp_storage(p) = gresp_storage * g1 * (1._r8 - g2) + + end do ! end pft loop + + end associate + end subroutine plantCNAlloc + + + !----------------------------------------------------------------------------- + subroutine calc_plant_nutrient_demand(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp,& + photosyns_vars, crop_vars, canopystate_vars, & + cnstate_vars, carbonstate_vars, carbonflux_vars, & + c13_carbonflux_vars, c14_carbonflux_vars, & + nitrogenstate_vars, nitrogenflux_vars, plantsoilnutrientflux_vars ) + + use CNStateType , only : cnstate_type + use CNCarbonFluxType , only : carbonflux_type + use CNCarbonStateType , only : carbonstate_type + use CNNitrogenFluxType , only : nitrogenflux_type + use CNNitrogenStateType , only : nitrogenstate_type + use CanopyStateType , only : canopystate_type + use CanopyStateType , only : canopystate_type + use PhotosynthesisType , only : photosyns_type + use PlantSoilnutrientFluxType, only : plantsoilnutrientflux_type + + implicit none + ! !ARGUMENTS: + 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_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(photosyns_type) , intent(in) :: photosyns_vars ! + type(crop_type) , intent(in) :: crop_vars ! + type(canopystate_type) , intent(in) :: canopystate_vars ! + type(carbonstate_type) , intent(in) :: carbonstate_vars ! + type(cnstate_type) , intent(inout) :: cnstate_vars ! + type(carbonflux_type) , intent(inout) :: carbonflux_vars ! + type(carbonflux_type) , intent(inout) :: c13_carbonflux_vars ! + type(carbonflux_type) , intent(inout) :: c14_carbonflux_vars ! + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars ! + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars ! + type(plantsoilnutrientflux_type), intent(inout) :: plantsoilnutrientflux_vars ! + + call calc_plant_nitrogen_demand(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + photosyns_vars, canopystate_vars, crop_vars, carbonstate_vars, & + cnstate_vars, carbonflux_vars, nitrogenstate_vars, nitrogenflux_vars, & + c13_carbonflux_vars, c14_carbonflux_vars, & + plantsoilnutrientflux_vars%plant_totn_demand_flx_col(bounds%begc:bounds%endc)) + + !this can used to plug in phosphorus? + end subroutine calc_plant_nutrient_demand + + !----------------------------------------------------------------------------- + subroutine calc_plant_nitrogen_demand(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + photosyns_vars, canopystate_vars, crop_vars, carbonstate_vars, & + cnstate_vars, carbonflux_vars, nitrogenstate_vars, nitrogenflux_vars, & + c13_carbonflux_vars, c14_carbonflux_vars, plant_totn_demand_flx_col) + ! + ! DESCRIPTION + ! compute plant nitrogen demand + ! + + ! !USES: + use pftvarcon , only : npcropmin, declfact, bfact, aleaff, arootf, astemf + use pftvarcon , only : arooti, fleafi, allconsl, allconss, grperc, grpnow, nsoybean + use clm_varcon , only : secspday + use clm_varctl , only : use_c13, use_c14 + use clm_time_manager , only : get_step_size + use subgridAveMod , only : p2c + implicit none + + ! !ARGUMENTS: + 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_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(photosyns_type) , intent(in) :: photosyns_vars ! + type(crop_type) , intent(in) :: crop_vars ! + type(canopystate_type) , intent(in) :: canopystate_vars ! + type(carbonstate_type) , intent(in) :: carbonstate_vars ! + type(cnstate_type) , intent(inout) :: cnstate_vars ! + type(carbonflux_type) , intent(inout) :: carbonflux_vars ! + type(carbonflux_type) , intent(inout) :: c13_carbonflux_vars ! + type(carbonflux_type) , intent(inout) :: c14_carbonflux_vars ! + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars ! + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars ! + real(r8) , intent(inout) :: plant_totn_demand_flx_col(bounds%begc:bounds%endc) ! + integer :: c,p,l,pi,j ! indices + integer :: fp ! lake filter pft index + integer :: fc ! lake filter column index + real(r8) :: mr ! maintenance respiration (gC/m2/s) + real(r8) :: f1,f2,f3,f4,g1,g2 ! allocation parameters + real(r8) :: cnl,cnfr,cnlw,cndw ! C:N ratios for leaf, fine root, and wood + real(r8) :: curmr, curmr_ratio ! xsmrpool temporary variables + real(r8) :: f5 ! grain allocation parameter + real(r8) :: cng ! C:N ratio for grain (= cnlw for now; slevis) + real(r8) :: fleaf ! fraction allocated to leaf + real(r8) :: t1 ! temporary variable + real(r8) :: dt ! model time step + real(r8) :: dayscrecover ! + + associate( & + ivt => pft%itype , & ! Input: [integer (:) ] pft vegetation type + woody => ecophyscon%woody , & ! Input: [real(r8) (:) ] binary flag for woody lifeform (1=woody, 0=not woody) + froot_leaf => ecophyscon%froot_leaf , & ! Input: [real(r8) (:) ] allocation parameter: new fine root C per new leaf C (gC/gC) + croot_stem => ecophyscon%croot_stem , & ! Input: [real(r8) (:) ] allocation parameter: new coarse root C per new stem C (gC/gC) + stem_leaf => ecophyscon%stem_leaf , & ! Input: [real(r8) (:) ] allocation parameter: new stem c per new leaf C (gC/gC) + flivewd => ecophyscon%flivewd , & ! Input: [real(r8) (:) ] allocation parameter: fraction of new wood that is live (phloem and ray parenchyma) (no units) + leafcn => ecophyscon%leafcn , & ! Input: [real(r8) (:) ] leaf C:N (gC/gN) + frootcn => ecophyscon%frootcn , & ! Input: [real(r8) (:) ] fine root C:N (gC/gN) + livewdcn => ecophyscon%livewdcn , & ! Input: [real(r8) (:) ] live wood (phloem and ray parenchyma) C:N (gC/gN) + deadwdcn => ecophyscon%deadwdcn , & ! Input: [real(r8) (:) ] dead wood (xylem and heartwood) C:N (gC/gN) + graincn => ecophyscon%graincn , & ! Input: [real(r8) (:) ] grain C:N (gC/gN) + fleafcn => ecophyscon%fleafcn , & ! Input: [real(r8) (:) ] leaf c:n during organ fill + ffrootcn => ecophyscon%ffrootcn , & ! Input: [real(r8) (:) ] froot c:n during organ fill + fstemcn => ecophyscon%fstemcn , & ! Input: [real(r8) (:) ] stem c:n during organ fill + + psnsun => photosyns_vars%psnsun_patch , & ! Input: [real(r8) (:) ] sunlit leaf-level photosynthesis (umol CO2 /m**2/ s) + psnsha => photosyns_vars%psnsha_patch , & ! Input: [real(r8) (:) ] shaded leaf-level photosynthesis (umol CO2 /m**2/ s) + c13_psnsun => photosyns_vars%c13_psnsun_patch , & ! Input: [real(r8) (:) ] sunlit leaf-level photosynthesis (umol CO2 /m**2/ s) + c13_psnsha => photosyns_vars%c13_psnsha_patch , & ! Input: [real(r8) (:) ] shaded leaf-level photosynthesis (umol CO2 /m**2/ s) + c14_psnsun => photosyns_vars%c14_psnsun_patch , & ! Input: [real(r8) (:) ] sunlit leaf-level photosynthesis (umol CO2 /m**2/ s) + c14_psnsha => photosyns_vars%c14_psnsha_patch , & ! Input: [real(r8) (:) ] shaded leaf-level photosynthesis (umol CO2 /m**2/ s) + + laisun => canopystate_vars%laisun_patch , & ! Input: [real(r8) (:) ] sunlit projected leaf area index + laisha => canopystate_vars%laisha_patch , & ! Input: [real(r8) (:) ] shaded projected leaf area index + + hui => crop_vars%gddplant_patch , & ! Input: [real(r8) (:) ] =gdd since planting (gddplant) + leafout => crop_vars%gddtsoi_patch , & ! Input: [real(r8) (:) ] =gdd from top soil layer temperature + + xsmrpool => carbonstate_vars%xsmrpool_patch , & ! Input: [real(r8) (:) ] (gC/m2) temporary photosynthate C pool + leafc => carbonstate_vars%leafc_patch , & ! Input: [real(r8) (:) ] + frootc => carbonstate_vars%frootc_patch , & ! Input: [real(r8) (:) ] + livestemc => carbonstate_vars%livestemc_patch , & ! Input: [real(r8) (:) ] + + gddmaturity => cnstate_vars%gddmaturity_patch , & ! Input: [real(r8) (:) ] gdd needed to harvest + huileaf => cnstate_vars%huileaf_patch , & ! Input: [real(r8) (:) ] heat unit index needed from planting to leaf emergence + huigrain => cnstate_vars%huigrain_patch , & ! Input: [real(r8) (:) ] same to reach vegetative maturity + croplive => cnstate_vars%croplive_patch , & ! Input: [logical (:) ] flag, true if planted, not harvested + peaklai => cnstate_vars%peaklai_patch , & ! Input: [integer (:) ] 1: max allowed lai; 0: not at max + aleafi => cnstate_vars%aleafi_patch , & ! Output: [real(r8) (:) ] saved allocation coefficient from phase 2 + astemi => cnstate_vars%astemi_patch , & ! Output: [real(r8) (:) ] saved allocation coefficient from phase 2 + aleaf => cnstate_vars%aleaf_patch , & ! Output: [real(r8) (:) ] leaf allocation coefficient + astem => cnstate_vars%astem_patch , & ! Output: [real(r8) (:) ] stem allocation coefficient + grain_flag => cnstate_vars%grain_flag_patch , & ! Output: [real(r8) (:) ] 1: grain fill stage; 0: not + c_allometry => cnstate_vars%c_allometry_patch , & ! Output: [real(r8) (:) ] C allocation index (DIM) + n_allometry => cnstate_vars%n_allometry_patch , & ! Output: [real(r8) (:) ] N allocation index (DIM) + tempsum_potential_gpp => cnstate_vars%tempsum_potential_gpp_patch , & ! Output: [real(r8) (:) ] temporary annual sum of potential GPP + tempmax_retransn => cnstate_vars%tempmax_retransn_patch , & ! Output: [real(r8) (:) ] temporary annual max of retranslocated N pool (gN/m2) + annsum_potential_gpp => cnstate_vars%annsum_potential_gpp_patch , & ! Output: [real(r8) (:) ] annual sum of potential GPP + annmax_retransn => cnstate_vars%annmax_retransn_patch , & ! Output: [real(r8) (:) ] annual max of retranslocated N pool + + leaf_mr => carbonflux_vars%leaf_mr_patch , & ! Input: [real(r8) (:) ] + froot_mr => carbonflux_vars%froot_mr_patch , & ! Input: [real(r8) (:) ] + livestem_mr => carbonflux_vars%livestem_mr_patch , & ! Input: [real(r8) (:) ] + livecroot_mr => carbonflux_vars%livecroot_mr_patch , & ! Input: [real(r8) (:) ] + grain_mr => carbonflux_vars%grain_mr_patch , & ! Input: [real(r8) (:) ] + annsum_npp => carbonflux_vars%annsum_npp_patch , & ! Input: [real(r8) (:) ] annual sum of NPP, for wood allocation + gpp => carbonflux_vars%gpp_before_downreg_patch , & ! Output: [real(r8) (:) ] GPP flux before downregulation (gC/m2/s) + availc => carbonflux_vars%availc_patch , & ! Output: [real(r8) (:) ] C flux available for allocation (gC/m2/s) + xsmrpool_recover => carbonflux_vars%xsmrpool_recover_patch , & ! Output: [real(r8) (:) ] C flux assigned to recovery of negative cpool (gC/m2/s) + psnsun_to_cpool => carbonflux_vars%psnsun_to_cpool_patch , & ! Output: [real(r8) (:) ] + psnshade_to_cpool => carbonflux_vars%psnshade_to_cpool_patch , & ! Output: [real(r8) (:) ] + + leaf_curmr => carbonflux_vars%leaf_curmr_patch , & + froot_curmr => carbonflux_vars%froot_curmr_patch , & ! Output: [real(r8) (:) ] + livestem_curmr => carbonflux_vars%livestem_curmr_patch , & ! Output: [real(r8) (:) ] + livecroot_curmr => carbonflux_vars%livecroot_curmr_patch , & ! Output: [real(r8) (:) ] + grain_curmr => carbonflux_vars%grain_curmr_patch , & ! Output: [real(r8) (:) ] + leaf_xsmr => carbonflux_vars%leaf_xsmr_patch , & ! Output: [real(r8) (:) ] + froot_xsmr => carbonflux_vars%froot_xsmr_patch , & ! Output: [real(r8) (:) ] + livestem_xsmr => carbonflux_vars%livestem_xsmr_patch , & ! Output: [real(r8) (:) ] + livecroot_xsmr => carbonflux_vars%livecroot_xsmr_patch , & ! Output: [real(r8) (:) ] + grain_xsmr => carbonflux_vars%grain_xsmr_patch , & ! Output: [real(r8) (:) ] + cpool_to_xsmrpool => carbonflux_vars%cpool_to_xsmrpool_patch , & ! Output: [real(r8) (:) ] + retransn => nitrogenstate_vars%retransn_patch , & ! Input: [real(r8) (:) ] (gN/m2) plant pool of retranslocated N + plant_ndemand => nitrogenflux_vars%plant_ndemand_patch , & ! Output: [real(r8) (:) ] N flux required to support initial GPP (gN/m2/s) + avail_retransn => nitrogenflux_vars%avail_retransn_patch , & ! Output: [real(r8) (:) ] N flux available from retranslocation pool (gN/m2/s) + retransn_to_npool => nitrogenflux_vars%retransn_to_npool_patch , & ! Output: [real(r8) (:) ] deployment of retranslocated N (gN/m2/s) + leafn_to_retransn => nitrogenflux_vars%leafn_to_retransn_patch , & ! Output: [real(r8) (:) ] + frootn_to_retransn => nitrogenflux_vars%frootn_to_retransn_patch , & ! Output: [real(r8) (:) ] + livestemn_to_retransn => nitrogenflux_vars%livestemn_to_retransn_patch , & ! Output: [real(r8) (:) ] + c13cf => c13_carbonflux_vars, & + c14cf => c14_carbonflux_vars & + ) + + ! set time steps + dt = real( get_step_size(), r8 ) + + dayscrecover = CNAllocParamsInst%dayscrecover + ! loop over patches to assess the total plant N demand + do fp=1,num_soilp + p = filter_soilp(fp) + + ! get the time step total gross photosynthesis + ! this is coming from the canopy fluxes code, and is the + ! gpp that is used to control stomatal conductance. + ! For the nitrogen downregulation code, this is assumed + ! to be the potential gpp, and the actual gpp will be + ! reduced due to N limitation. + + ! Convert psn from umol/m2/s -> gC/m2/s + + ! The input psn (psnsun and psnsha) are expressed per unit LAI + ! in the sunlit and shaded canopy, respectively. These need to be + ! scaled by laisun and laisha to get the total gpp for allocation + + ! Note that no associate statement is used for the isotope carbon fluxes below + ! since they are not always allocated AND nag compiler will complain if you try to + ! to have an associate statement with unallocated memory + + psnsun_to_cpool(p) = psnsun(p) * laisun(p) * 12.011e-6_r8 + psnshade_to_cpool(p) = psnsha(p) * laisha(p) * 12.011e-6_r8 + + if ( use_c13 ) then + c13cf%psnsun_to_cpool_patch(p) = c13_psnsun(p) * laisun(p) * 12.011e-6_r8 + c13cf%psnshade_to_cpool_patch(p) = c13_psnsha(p) * laisha(p) * 12.011e-6_r8 + endif + + if ( use_c14 ) then + c14cf%psnsun_to_cpool_patch(p) = c14_psnsun(p) * laisun(p) * 12.011e-6_r8 + c14cf%psnshade_to_cpool_patch(p) = c14_psnsha(p) * laisha(p) * 12.011e-6_r8 + endif + + gpp(p) = psnsun_to_cpool(p) + psnshade_to_cpool(p) + + ! get the time step total maintenance respiration + ! These fluxes should already be in gC/m2/s + + mr = leaf_mr(p) + froot_mr(p) + if (woody(ivt(p)) == 1.0_r8) then + mr = mr + livestem_mr(p) + livecroot_mr(p) + else if (ivt(p) >= npcropmin) then + if (croplive(p)) mr = mr + livestem_mr(p) + grain_mr(p) + end if + + ! carbon flux available for allocation + availc(p) = gpp(p) - mr + + ! new code added for isotope calculations, 7/1/05, PET + ! If mr > gpp, then some mr comes from gpp, the rest comes from + ! cpool (xsmr) + if (mr > 0._r8 .and. availc(p) < 0._r8) then + curmr = gpp(p) + curmr_ratio = curmr / mr + else + curmr_ratio = 1._r8 + end if + leaf_curmr(p) = leaf_mr(p) * curmr_ratio + leaf_xsmr(p) = leaf_mr(p) - leaf_curmr(p) + froot_curmr(p) = froot_mr(p) * curmr_ratio + froot_xsmr(p) = froot_mr(p) - froot_curmr(p) + livestem_curmr(p) = livestem_mr(p) * curmr_ratio + livestem_xsmr(p) = livestem_mr(p) - livestem_curmr(p) + livecroot_curmr(p) = livecroot_mr(p) * curmr_ratio + livecroot_xsmr(p) = livecroot_mr(p) - livecroot_curmr(p) + grain_curmr(p) = grain_mr(p) * curmr_ratio + grain_xsmr(p) = grain_mr(p) - grain_curmr(p) + + ! no allocation when available c is negative + availc(p) = max(availc(p),0.0_r8) + + ! test for an xsmrpool deficit + if (xsmrpool(p) < 0.0_r8) then + ! Running a deficit in the xsmrpool, so the first priority is to let + ! some availc from this timestep accumulate in xsmrpool. + ! Determine rate of recovery for xsmrpool deficit + + xsmrpool_recover(p) = -xsmrpool(p)/(dayscrecover*secspday) + if (xsmrpool_recover(p) < availc(p)) then + ! available carbon reduced by amount for xsmrpool recovery + availc(p) = availc(p) - xsmrpool_recover(p) + else + ! all of the available carbon goes to xsmrpool recovery + xsmrpool_recover(p) = availc(p) + availc(p) = 0.0_r8 + end if + cpool_to_xsmrpool(p) = xsmrpool_recover(p) + end if + + f1 = froot_leaf(ivt(p)) + f2 = croot_stem(ivt(p)) + + ! modified wood allocation to be 2.2 at npp=800 gC/m2/yr, 0.2 at npp=0, + ! constrained so that it does not go lower than 0.2 (under negative annsum_npp) + ! This variable allocation is only for trees. Shrubs have a constant + ! allocation as specified in the pft-physiology file. The value is also used + ! as a trigger here: -1.0 means to use the dynamic allocation (trees). + + if (stem_leaf(ivt(p)) == -1._r8) then + f3 = (2.7/(1.0+exp(-0.004*(annsum_npp(p) - 300.0)))) - 0.4 + else + f3 = stem_leaf(ivt(p)) + end if + + f4 = flivewd(ivt(p)) + g1 = grperc(ivt(p)) + g2 = grpnow(ivt(p)) + cnl = leafcn(ivt(p)) + cnfr = frootcn(ivt(p)) + cnlw = livewdcn(ivt(p)) + cndw = deadwdcn(ivt(p)) + + ! calculate f1 to f5 for prog crops following AgroIBIS subr phenocrop + + f5 = 0._r8 ! continued intializations from above + + if (ivt(p) >= npcropmin) then ! skip 2 generic crops + + if (croplive(p)) then + ! same phases appear in subroutine CropPhenology + + ! Phase 1 completed: + ! ================== + ! if hui is less than the number of gdd needed for filling of grain + ! leaf emergence also has to have taken place for lai changes to occur + ! and carbon assimilation + ! Next phase: leaf emergence to start of leaf decline + + if (leafout(p) >= huileaf(p) .and. hui(p) < huigrain(p)) then + + ! allocation rules for crops based on maturity and linear decrease + ! of amount allocated to roots over course of the growing season + + if (peaklai(p) == 1) then ! lai at maximum allowed + arepr(p) = 0._r8 + aleaf(p) = 1.e-5_r8 + astem(p) = 0._r8 + aroot(p) = 1._r8 - arepr(p) - aleaf(p) - astem(p) + else + arepr(p) = 0._r8 + aroot(p) = max(0._r8, min(1._r8, arooti(ivt(p)) - & + (arooti(ivt(p)) - arootf(ivt(p))) * & + min(1._r8, hui(p)/gddmaturity(p)))) + fleaf = fleafi(ivt(p)) * (exp(-bfact(ivt(p))) - & + exp(-bfact(ivt(p))*hui(p)/huigrain(p))) / & + (exp(-bfact(ivt(p)))-1) ! fraction alloc to leaf (from J Norman alloc curve) + aleaf(p) = max(1.e-5_r8, (1._r8 - aroot(p)) * fleaf) + astem(p) = 1._r8 - arepr(p) - aleaf(p) - aroot(p) + end if + + ! AgroIBIS included here an immediate adjustment to aleaf & astem if the + ! predicted lai from the above allocation coefficients exceeded laimx. + ! We have decided to live with lais slightly higher than laimx by + ! enforcing the cap in the following tstep through the peaklai logic above. + + astemi(p) = astem(p) ! save for use by equations after shift + aleafi(p) = aleaf(p) ! to reproductive phenology stage begins + grain_flag(p) = 0._r8 ! setting to 0 while in phase 2 + + ! Phase 2 completed: + ! ================== + ! shift allocation either when enough gdd are accumulated or maximum number + ! of days has elapsed since planting + + else if (hui(p) >= huigrain(p)) then + + aroot(p) = max(0._r8, min(1._r8, arooti(ivt(p)) - & + (arooti(ivt(p)) - arootf(ivt(p))) * min(1._r8, hui(p)/gddmaturity(p)))) + if (astemi(p) > astemf(ivt(p))) then + astem(p) = max(0._r8, max(astemf(ivt(p)), astem(p) * & + (1._r8 - min((hui(p)- & + huigrain(p))/((gddmaturity(p)*declfact(ivt(p)))- & + huigrain(p)),1._r8)**allconss(ivt(p)) ))) + end if + if (aleafi(p) > aleaff(ivt(p))) then + aleaf(p) = max(1.e-5_r8, max(aleaff(ivt(p)), aleaf(p) * & + (1._r8 - min((hui(p)- & + huigrain(p))/((gddmaturity(p)*declfact(ivt(p)))- & + huigrain(p)),1._r8)**allconsl(ivt(p)) ))) + end if + + !Beth's retranslocation of leafn, stemn, rootn to organ + !Filter excess plant N to retransn pool for organ N + !Only do one time then hold grain_flag till onset next season + + ! slevis: Will astem ever = astemf exactly? + ! Beth's response: ...looks like astem can equal astemf under the right circumstances. + !It might be worth a rewrite to capture what I was trying to do, but the retranslocation for + !corn and wheat begins at the beginning of the grain fill stage, but for soybean I was holding it + !until after the leaf and stem decline were complete. Looking at how astem is calculated, once the + !stem decline is near complete, astem should (usually) be set to astemf. The reason for holding off + !on soybean is that the retranslocation scheme begins at the beginning of the grain phase, when the + !leaf and stem are still growing, but declining. Since carbon is still getting allocated and now + !there is more nitrogen available, the nitrogen can be diverted from grain. For corn and wheat + !the impact was probably enough to boost productivity, but for soybean the nitrogen was better off + !fulfilling the grain fill. It seems that if the peak lai is reached for soybean though that this + !would be bypassed altogether, not the intended outcome. I checked several of my output files and + !they all seemed to be going through the retranslocation loop for soybean - good news. + + if (ivt(p) /= nsoybean .or. astem(p) == astemf(ivt(p))) then + if (grain_flag(p) == 0._r8) then + t1 = 1 / dt + leafn_to_retransn(p) = t1 * ((leafc(p) / leafcn(ivt(p))) - (leafc(p) / & + fleafcn(ivt(p)))) + livestemn_to_retransn(p) = t1 * ((livestemc(p) / livewdcn(ivt(p))) - (livestemc(p) / & + fstemcn(ivt(p)))) + frootn_to_retransn(p) = 0._r8 + if (ffrootcn(ivt(p)) > 0._r8) then + frootn_to_retransn(p) = t1 * ((frootc(p) / frootcn(ivt(p))) - (frootc(p) / & + ffrootcn(ivt(p)))) + end if + grain_flag(p) = 1._r8 + end if + end if + + arepr(p) = 1._r8 - aroot(p) - astem(p) - aleaf(p) + + else ! pre emergence + aleaf(p) = 1.e-5_r8 ! allocation coefficients should be irrelevant + astem(p) = 0._r8 ! because crops have no live carbon pools; + aroot(p) = 0._r8 ! this applies to this "else" and to the "else" + arepr(p) = 0._r8 ! a few lines down + end if + + f1 = aroot(p) / aleaf(p) + f3 = astem(p) / aleaf(p) + f5 = arepr(p) / aleaf(p) + g1 = 0.25_r8 + + else ! .not croplive + f1 = 0._r8 + f3 = 0._r8 + f5 = 0._r8 + g1 = 0.25_r8 + end if + end if + + ! based on available C, use constant allometric relationships to + ! determine N requirements + + if (woody(ivt(p)) == 1.0_r8) then + c_allometry(p) = (1._r8+g1)*(1._r8+f1+f3*(1._r8+f2)) + n_allometry(p) = 1._r8/cnl + f1/cnfr + (f3*f4*(1._r8+f2))/cnlw + & + (f3*(1._r8-f4)*(1._r8+f2))/cndw + else if (ivt(p) >= npcropmin) then ! skip generic crops + cng = graincn(ivt(p)) + c_allometry(p) = (1._r8+g1)*(1._r8+f1+f5+f3*(1._r8+f2)) + n_allometry(p) = 1._r8/cnl + f1/cnfr + f5/cng + (f3*f4*(1._r8+f2))/cnlw + & + (f3*(1._r8-f4)*(1._r8+f2))/cndw + else + c_allometry(p) = 1._r8+g1+f1+f1*g1 + n_allometry(p) = 1._r8/cnl + f1/cnfr + end if + plant_ndemand(p) = availc(p)*(n_allometry(p)/c_allometry(p)) + + ! retranslocated N deployment depends on seasonal cycle of potential GPP + ! (requires one year run to accumulate demand) + + tempsum_potential_gpp(p) = tempsum_potential_gpp(p) + gpp(p) + + ! Adding the following line to carry max retransn info to CN Annual Update + tempmax_retransn(p) = max(tempmax_retransn(p),retransn(p)) + + ! Beth's code: crops pull from retransn pool only during grain fill; + ! retransn pool has N from leaves, stems, and roots for + ! retranslocation + + if (ivt(p) >= npcropmin .and. grain_flag(p) == 1._r8) then + avail_retransn(p) = plant_ndemand(p) + else if (ivt(p) < npcropmin .and. annsum_potential_gpp(p) > 0._r8) then + avail_retransn(p) = (annmax_retransn(p)/2._r8)*(gpp(p)/annsum_potential_gpp(p))/dt + else + avail_retransn(p) = 0.0_r8 + end if + + ! make sure available retrans N doesn't exceed storage + avail_retransn(p) = min(avail_retransn(p), retransn(p)/dt) + + ! modify plant N demand according to the availability of + ! retranslocated N + ! take from retransn pool at most the flux required to meet + ! plant ndemand + + if (plant_ndemand(p) > avail_retransn(p)) then + retransn_to_npool(p) = avail_retransn(p) + else + retransn_to_npool(p) = plant_ndemand(p) + end if + plant_ndemand(p) = plant_ndemand(p) - retransn_to_npool(p) + + end do ! end pft loop + + ! now use the p2c routine to get the column-averaged plant_ndemand + call p2c(bounds, num_soilc, filter_soilc, & + plant_ndemand(bounds%begp:bounds%endp), & + plant_totn_demand_flx_col(bounds%begc:bounds%endc)) + + ! obtain the nutrient uptake potential based on fine root profile + + end associate + end subroutine calc_plant_nitrogen_demand + +end module CNAllocationBetrMod diff --git a/components/clm/src/biogeochem/CNBalanceCheckMod.F90 b/components/clm/src/biogeochem/CNBalanceCheckMod.F90 index 1475766516e0..cf443de2c93f 100644 --- a/components/clm/src/biogeochem/CNBalanceCheckMod.F90 +++ b/components/clm/src/biogeochem/CNBalanceCheckMod.F90 @@ -11,7 +11,7 @@ module CNBalanceCheckMod use decompMod , only : bounds_type use abortutils , only : endrun use clm_varctl , only : iulog, use_nitrif_denitrif, use_ed - use clm_time_manager , only : get_step_size + use clm_time_manager , only : get_step_size,get_nstep use clm_varpar , only : crop_prog use CNCarbonFluxType , only : carbonflux_type use CNCarbonStateType , only : carbonstate_type @@ -236,14 +236,22 @@ subroutine CBalanceCheck(bounds, & err_index = c end if end do ! end of columns loop - + if (.not. use_ed) then if (err_found) then c = err_index write(iulog,*)'column cbalance error = ', col_errcb(c), c write(iulog,*)'Latdeg,Londeg=',grc%latdeg(col%gridcell(c)),grc%londeg(col%gridcell(c)) + write(iulog,*)'input=',col_cinputs*dt + write(iulog,*)'output=',col_coutputs*dt + write(iulog,*)'er=',er(c)*dt,carbonflux_vars%hr_col(c)*dt + write(iulog,*)'fire=',col_fire_closs(c)*dt + write(iulog,*)'dwt=',dwt_closs(c)*dt + write(iulog,*)'product=',product_closs(c)*dt + write(iulog,*)'hrv=',col_hrv_xsmrpool_to_atm(c)*dt + write(iulog,*)'leach=',som_c_leached(c)*dt write(iulog,*)'begcb = ',col_begcb(c) - write(iulog,*)'endcb = ',col_endcb(c) + write(iulog,*)'endcb = ',col_endcb(c),carbonstate_vars%totsomc_col(c) write(iulog,*)'delta store = ',col_endcb(c)-col_begcb(c) call endrun(msg=errMsg(__FILE__, __LINE__)) end if @@ -262,6 +270,7 @@ subroutine NBalanceCheck(bounds, & ! On the radiation time step, perform nitrogen mass conservation check ! for column and pft ! + use tracer_varcon, only : is_active_betr_bgc ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds integer , intent(in) :: num_soilc ! number of soil columns in filter @@ -322,13 +331,19 @@ subroutine NBalanceCheck(bounds, & ! calculate total column-level outputs col_noutputs(c) = denit(c) + col_fire_nloss(c) + dwt_nloss(c) + product_nloss(c) - if (.not. use_nitrif_denitrif) then - col_noutputs(c) = col_noutputs(c) + sminn_leached(c) + if(is_active_betr_bgc)then + col_noutputs(c) = col_noutputs(c) + f_n2o_nit(c) + + col_noutputs(c) = col_noutputs(c) + smin_no3_leached(c) + smin_no3_runoff(c) else + if (.not. use_nitrif_denitrif) then + col_noutputs(c) = col_noutputs(c) + sminn_leached(c) + else col_noutputs(c) = col_noutputs(c) + f_n2o_nit(c) col_noutputs(c) = col_noutputs(c) + smin_no3_leached(c) + smin_no3_runoff(c) - end if + end if + endif col_noutputs(c) = col_noutputs(c) - som_n_leached(c) @@ -356,14 +371,28 @@ subroutine NBalanceCheck(bounds, & if (err_found) then c = err_index - write(iulog,*)'column nbalance error = ', col_errnb(c), c - 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,*)'column nbalance error = ', col_errnb(c), c, get_nstep() + 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,*)'denit = ',denit(c)*dt + write(iulog,*)'n2onit = ',f_n2o_nit(c)*dt + write(iulog,*)'no3 leach = ', smin_no3_leached(c)*dt + write(iulog,*)'no3 runof = ', smin_no3_runoff(c)*dt + write(iulog,*)'ndep = ',ndep_to_sminn(c)*dt + write(iulog,*)'nfix = ', nfix_to_sminn(c)*dt + write(iulog,*)'nsup = ',supplement_to_sminn(c)*dt + if(crop_prog) then + write(iulog,*)'fertm = ',fert_to_sminn(c)*dt + write(iulog,*)'soyfx = ',soyfixn_to_sminn(c)*dt + endif + write(iulog,*)'fire = ',col_fire_nloss(c)*dt + write(iulog,*)'dwt = ',dwt_nloss(c)*dt + write(iulog,*)'prod = ',product_nloss(c)*dt call endrun(msg=errMsg(__FILE__, __LINE__)) end if diff --git a/components/clm/src/biogeochem/CNC14DecayMod.F90 b/components/clm/src/biogeochem/CNC14DecayMod.F90 index e6f0748cf78a..4e758a7d8725 100644 --- a/components/clm/src/biogeochem/CNC14DecayMod.F90 +++ b/components/clm/src/biogeochem/CNC14DecayMod.F90 @@ -40,6 +40,7 @@ subroutine C14Decay( num_soilc, filter_soilc, num_soilp, filter_soilp, & ! !DESCRIPTION: ! On the radiation time step, calculate the radioactive decay of C14 ! + use tracer_varcon, only : is_active_betr_bgc ! !ARGUMENTS: integer , intent(in) :: num_soilc ! number of soil columns filter integer , intent(in) :: filter_soilc(:) ! filter for soil columns @@ -100,20 +101,22 @@ subroutine C14Decay( num_soilc, filter_soilc, num_soilp, filter_soilp, & seedc(c) = seedc(c) * (1._r8 - decay_const * dt) end do ! end of columns loop - do l = 1, ndecomp_pools - if ( spinup_state .eq. 1) then - ! speed up radioactive decay by the same factor as decomposition so tat SOM ages prematurely in all respects - spinup_term = spinup_factor(l) - else - spinup_term = 1. - endif - do j = 1, nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) - decomp_cpools_vr(c,j,l) = decomp_cpools_vr(c,j,l) * (1._r8 - decay_const * spinup_term * dt) + if (is_active_betr_bgc) then + do l = 1, ndecomp_pools + if ( spinup_state .eq. 1) then + ! speed up radioactive decay by the same factor as decomposition so tat SOM ages prematurely in all respects + spinup_term = spinup_factor(l) + else + spinup_term = 1. + endif + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + decomp_cpools_vr(c,j,l) = decomp_cpools_vr(c,j,l) * (1._r8 - decay_const * spinup_term * dt) + end do end do - end do - end do ! end of columns loop + end do ! end of columns loop + endif ! patch loop do fp = 1,num_soilp @@ -163,7 +166,7 @@ subroutine C14BombSpike( num_soilp, filter_soilp, & ! !ARGUMENTS: integer, intent(in) :: num_soilp ! number of soil patches in filter integer, intent(in) :: filter_soilp(:) ! filter for soil patches - type(cnstate_type), intent(in) :: cnstate_vars + type(cnstate_type), intent(inout) :: cnstate_vars ! ! !LOCAL VARIABLES: integer :: yr, mon, day, tod, offset diff --git a/components/clm/src/biogeochem/CNCIsoFluxMod.F90 b/components/clm/src/biogeochem/CNCIsoFluxMod.F90 index c2a2986468cb..ac99913a72a9 100644 --- a/components/clm/src/biogeochem/CNCIsoFluxMod.F90 +++ b/components/clm/src/biogeochem/CNCIsoFluxMod.F90 @@ -44,6 +44,7 @@ subroutine CIsoFlux1(num_soilc, filter_soilc, num_soilp, filter_soilp, & ! !DESCRIPTION: ! On the radiation time step, set the carbon isotopic flux ! variables (except for gap-phase mortality and fire fluxes) + use tracer_varcon, only : is_active_betr_bgc ! ! !ARGUMENTS: integer , intent(in) :: num_soilc ! number of soil columns filter @@ -365,40 +366,42 @@ subroutine CIsoFlux1(num_soilc, filter_soilc, num_soilp, filter_soilp, & call CNCIsoLitterToColumn(num_soilc, filter_soilc, cnstate_vars, isotopeflux_vars) - ! column-level non-mortality fluxes - - do fc = 1,num_soilc - cc = filter_soilc(fc) - do j = 1, nlevdecomp - do l = 1, ndecomp_cascade_transitions - if ( carbonstate_vars%decomp_cpools_vr_col(cc,j,cascade_donor_pool(l)) /= 0._r8) then - isotopeflux_vars%decomp_cascade_hr_vr_col(cc,j,l) = & - carbonflux_vars%decomp_cascade_hr_vr_col(cc,j,l) * & - (isotopestate_vars%decomp_cpools_vr_col(cc,j,cascade_donor_pool(l)) & - / carbonstate_vars%decomp_cpools_vr_col(cc,j,cascade_donor_pool(l))) * 1._r8 - else - isotopeflux_vars%decomp_cascade_hr_vr_col(cc,j,l) = 0._r8 - end if + if (.not. is_active_betr_bgc) then + + ! column-level non-mortality fluxes + + do fc = 1,num_soilc + cc = filter_soilc(fc) + do j = 1, nlevdecomp + do l = 1, ndecomp_cascade_transitions + if ( carbonstate_vars%decomp_cpools_vr_col(cc,j,cascade_donor_pool(l)) /= 0._r8) then + isotopeflux_vars%decomp_cascade_hr_vr_col(cc,j,l) = & + carbonflux_vars%decomp_cascade_hr_vr_col(cc,j,l) * & + (isotopestate_vars%decomp_cpools_vr_col(cc,j,cascade_donor_pool(l)) & + / carbonstate_vars%decomp_cpools_vr_col(cc,j,cascade_donor_pool(l))) * 1._r8 + else + isotopeflux_vars%decomp_cascade_hr_vr_col(cc,j,l) = 0._r8 + end if + end do end do end do - end do - do fc = 1,num_soilc - cc = filter_soilc(fc) - do j = 1, nlevdecomp - do l = 1, ndecomp_cascade_transitions - if ( carbonstate_vars%decomp_cpools_vr_col(cc,j,cascade_donor_pool(l)) /= 0._r8) then - isotopeflux_vars%decomp_cascade_ctransfer_vr_col(cc,j,l) = & - carbonflux_vars%decomp_cascade_ctransfer_vr_col(cc,j,l) * & - (isotopestate_vars%decomp_cpools_vr_col(cc,j,cascade_donor_pool(l)) & - / carbonstate_vars%decomp_cpools_vr_col(cc,j,cascade_donor_pool(l))) * 1._r8 - else - isotopeflux_vars%decomp_cascade_ctransfer_vr_col(cc,j,l) = 0._r8 - end if + do fc = 1,num_soilc + cc = filter_soilc(fc) + do j = 1, nlevdecomp + do l = 1, ndecomp_cascade_transitions + if ( carbonstate_vars%decomp_cpools_vr_col(cc,j,cascade_donor_pool(l)) /= 0._r8) then + isotopeflux_vars%decomp_cascade_ctransfer_vr_col(cc,j,l) = & + carbonflux_vars%decomp_cascade_ctransfer_vr_col(cc,j,l) * & + (isotopestate_vars%decomp_cpools_vr_col(cc,j,cascade_donor_pool(l)) & + / carbonstate_vars%decomp_cpools_vr_col(cc,j,cascade_donor_pool(l))) * 1._r8 + else + isotopeflux_vars%decomp_cascade_ctransfer_vr_col(cc,j,l) = 0._r8 + end if + end do end do end do - end do - + endif end associate end subroutine CIsoFlux1 @@ -411,6 +414,7 @@ subroutine CIsoFlux2(num_soilc, filter_soilc, num_soilp, filter_soilp, & ! !DESCRIPTION: ! On the radiation time step, set the carbon isotopic fluxes for gap mortality ! + use tracer_varcon, only : is_active_betr_bgc ! !ARGUMENTS: integer , intent(in) :: num_soilc ! number of soil columns filter integer , intent(in) :: filter_soilc(:) ! filter for soil columns @@ -683,6 +687,7 @@ subroutine CIsoFlux3(num_soilc, filter_soilc, num_soilp, filter_soilp, & ! ! !DESCRIPTION: ! On the radiation time step, set the carbon isotopic fluxes for fire mortality + use tracer_varcon, only : is_active_betr_bgc ! ! !ARGUMENTS: integer , intent(in) :: num_soilc ! number of soil columns filter @@ -817,42 +822,45 @@ subroutine CIsoFlux3(num_soilc, filter_soilc, num_soilp, filter_soilp, & isotopestate_vars%gresp_xfer_patch , carbonstate_vars%gresp_xfer_patch, & num_soilp , filter_soilp, 1._r8, 0, isotope) - ! calculate the column-level flux of deadstem and deadcrootc to cwdc as the result of fire mortality. - do pi = 1,max_patch_per_col - do fc = 1,num_soilc - cc = filter_soilc(fc) - if ( pi <= col%npfts(cc) ) then - pp = col%pfti(cc) + pi - 1 - if (pft%active(pp)) then - do j = 1, nlevdecomp - isotopeflux_vars%fire_mortality_c_to_cwdc_col(cc,j) = & - isotopeflux_vars%fire_mortality_c_to_cwdc_col(cc,j) + & - isotopeflux_vars%m_deadstemc_to_litter_fire_patch(pp) * pft%wtcol(pp) * stem_prof(pp,j) - isotopeflux_vars%fire_mortality_c_to_cwdc_col(cc,j) = & - isotopeflux_vars%fire_mortality_c_to_cwdc_col(cc,j) + & - isotopeflux_vars%m_deadcrootc_to_litter_fire_patch(pp) * pft%wtcol(pp) * croot_prof(pp,j) - end do - end if - end if - end do - end do + if (.not. is_active_betr_bgc) then + ! calculate the column-level flux of deadstem and deadcrootc to cwdc as the result of fire mortality. - do fc = 1,num_soilc - cc = filter_soilc(fc) - do j = 1, nlevdecomp - do l = 1, ndecomp_pools - if ( carbonstate_vars%decomp_cpools_vr_col(cc,j,l) /= 0._r8) then - isotopeflux_vars%m_decomp_cpools_to_fire_vr_col(cc,j,l) = & - carbonflux_vars%m_decomp_cpools_to_fire_vr_col(cc,j,l) * & - (isotopestate_vars%decomp_cpools_vr_col(cc,j,l) / carbonstate_vars%decomp_cpools_vr_col(cc,j,l)) * 1._r8 - else - isotopeflux_vars%m_decomp_cpools_to_fire_vr_col(cc,j,l) = 0._r8 + do pi = 1,max_patch_per_col + do fc = 1,num_soilc + cc = filter_soilc(fc) + if ( pi <= col%npfts(cc) ) then + pp = col%pfti(cc) + pi - 1 + if (pft%active(pp)) then + do j = 1, nlevdecomp + isotopeflux_vars%fire_mortality_c_to_cwdc_col(cc,j) = & + isotopeflux_vars%fire_mortality_c_to_cwdc_col(cc,j) + & + isotopeflux_vars%m_deadstemc_to_litter_fire_patch(pp) * pft%wtcol(pp) * stem_prof(pp,j) + isotopeflux_vars%fire_mortality_c_to_cwdc_col(cc,j) = & + isotopeflux_vars%fire_mortality_c_to_cwdc_col(cc,j) + & + isotopeflux_vars%m_deadcrootc_to_litter_fire_patch(pp) * pft%wtcol(pp) * croot_prof(pp,j) + end do + end if end if end do end do - end do + + do fc = 1,num_soilc + cc = filter_soilc(fc) + do j = 1, nlevdecomp + do l = 1, ndecomp_pools + if ( carbonstate_vars%decomp_cpools_vr_col(cc,j,l) /= 0._r8) then + isotopeflux_vars%m_decomp_cpools_to_fire_vr_col(cc,j,l) = & + carbonflux_vars%m_decomp_cpools_to_fire_vr_col(cc,j,l) * & + (isotopestate_vars%decomp_cpools_vr_col(cc,j,l) / carbonstate_vars%decomp_cpools_vr_col(cc,j,l)) * 1._r8 + else + isotopeflux_vars%m_decomp_cpools_to_fire_vr_col(cc,j,l) = 0._r8 + end if + end do + end do + end do + endif end associate end subroutine CIsoFlux3 diff --git a/components/clm/src/biogeochem/CNCStateUpdate1Mod.F90 b/components/clm/src/biogeochem/CNCStateUpdate1Mod.F90 index 2f74dc28658d..c2e8d3ee4793 100644 --- a/components/clm/src/biogeochem/CNCStateUpdate1Mod.F90 +++ b/components/clm/src/biogeochem/CNCStateUpdate1Mod.F90 @@ -40,6 +40,7 @@ subroutine CStateUpdate0(& ! !DESCRIPTION: ! On the radiation time step, update cpool carbon state ! + ! !ARGUMENTS: integer , intent(in) :: num_soilp ! number of soil patches in filter integer , intent(in) :: filter_soilp(:) ! filter for soil patches @@ -73,7 +74,7 @@ subroutine CStateUpdate0(& end subroutine CStateUpdate0 !----------------------------------------------------------------------- - subroutine CStateUpdate1(& + subroutine CStateUpdate1(bounds, & num_soilc, filter_soilc, & num_soilp, filter_soilp, & cnstate_vars, carbonflux_vars, carbonstate_vars) @@ -82,12 +83,16 @@ subroutine CStateUpdate1(& ! On the radiation time step, update all the prognostic carbon state ! variables (except for gap-phase mortality and fire fluxes) ! + use tracer_varcon , only : is_active_betr_bgc + use subgridAveMod , only : p2c + use decompMod , only : bounds_type ! !ARGUMENTS: + type(bounds_type) , intent(in) :: bounds integer , intent(in) :: num_soilc ! number of soil columns filter integer , intent(in) :: filter_soilc(:) ! filter for soil columns integer , intent(in) :: num_soilp ! number of soil patches in filter integer , intent(in) :: filter_soilp(:) ! filter for soil patches - type(cnstate_type) , intent(in) :: cnstate_vars + type(cnstate_type) , intent(inout) :: cnstate_vars type(carbonflux_type) , intent(inout) :: carbonflux_vars type(carbonstate_type) , intent(inout) :: carbonstate_vars ! @@ -123,56 +128,74 @@ subroutine CStateUpdate1(& cs%seedc_col(c) = cs%seedc_col(c) - cf%dwt_seedc_to_deadstem_col(c) * dt end do - !------------------------------------------------------------------ - ! if coupled with pflotran, the following updates are NOT needed - if (.not.(use_pflotran .and. pf_cmode)) then - !------------------------------------------------------------------ - ! plant to litter fluxes - do j = 1,nlevdecomp - ! column loop - do fc = 1,num_soilc - c = filter_soilc(fc) - ! phenology and dynamic land cover fluxes - cf%decomp_cpools_sourcesink_col(c,j,i_met_lit) = & - ( cf%phenology_c_to_litr_met_c_col(c,j) + cf%dwt_frootc_to_litr_met_c_col(c,j) ) *dt - cf%decomp_cpools_sourcesink_col(c,j,i_cel_lit) = & - ( cf%phenology_c_to_litr_cel_c_col(c,j) + cf%dwt_frootc_to_litr_cel_c_col(c,j) ) *dt - cf%decomp_cpools_sourcesink_col(c,j,i_lig_lit) = & - ( cf%phenology_c_to_litr_lig_c_col(c,j) + cf%dwt_frootc_to_litr_lig_c_col(c,j) ) *dt - cf%decomp_cpools_sourcesink_col(c,j,i_cwd) = & - ( cf%dwt_livecrootc_to_cwdc_col(c,j) + cf%dwt_deadcrootc_to_cwdc_col(c,j) ) *dt - end do - end do - ! litter and SOM HR fluxes - do k = 1, ndecomp_cascade_transitions + if (is_active_betr_bgc) then + !summarize litter carbon input + ! plant to litter fluxes + do j = 1,nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + ! phenology and dynamic land cover fluxes + cf%bgc_cpool_ext_inputs_vr_col(c,j,i_met_lit) = & + ( cf%phenology_c_to_litr_met_c_col(c,j) + cf%dwt_frootc_to_litr_met_c_col(c,j) ) *dt + cf%bgc_cpool_ext_inputs_vr_col(c,j,i_cel_lit) = & + ( cf%phenology_c_to_litr_cel_c_col(c,j) + cf%dwt_frootc_to_litr_cel_c_col(c,j) ) *dt + cf%bgc_cpool_ext_inputs_vr_col(c,j,i_lig_lit) = & + ( cf%phenology_c_to_litr_lig_c_col(c,j) + cf%dwt_frootc_to_litr_lig_c_col(c,j) ) *dt + cf%bgc_cpool_ext_inputs_vr_col(c,j,i_cwd) = & + ( cf%dwt_livecrootc_to_cwdc_col(c,j) + cf%dwt_deadcrootc_to_cwdc_col(c,j) ) *dt + enddo + enddo + + elseif (.not.(use_pflotran .and. pf_cmode)) then + + ! plant to litter fluxes + do j = 1,nlevdecomp ! column loop do fc = 1,num_soilc c = filter_soilc(fc) - cf%decomp_cpools_sourcesink_col(c,j,cascade_donor_pool(k)) = & - cf%decomp_cpools_sourcesink_col(c,j,cascade_donor_pool(k)) & - - ( cf%decomp_cascade_hr_vr_col(c,j,k) + cf%decomp_cascade_ctransfer_vr_col(c,j,k)) *dt + ! phenology and dynamic land cover fluxes + cf%decomp_cpools_sourcesink_col(c,j,i_met_lit) = & + ( cf%phenology_c_to_litr_met_c_col(c,j) + cf%dwt_frootc_to_litr_met_c_col(c,j) ) *dt + cf%decomp_cpools_sourcesink_col(c,j,i_cel_lit) = & + ( cf%phenology_c_to_litr_cel_c_col(c,j) + cf%dwt_frootc_to_litr_cel_c_col(c,j) ) *dt + cf%decomp_cpools_sourcesink_col(c,j,i_lig_lit) = & + ( cf%phenology_c_to_litr_lig_c_col(c,j) + cf%dwt_frootc_to_litr_lig_c_col(c,j) ) *dt + cf%decomp_cpools_sourcesink_col(c,j,i_cwd) = & + ( cf%dwt_livecrootc_to_cwdc_col(c,j) + cf%dwt_deadcrootc_to_cwdc_col(c,j) ) *dt end do end do - end do - do k = 1, ndecomp_cascade_transitions - if ( cascade_receiver_pool(k) /= 0 ) then ! skip terminal transitions + + ! litter and SOM HR fluxes + do k = 1, ndecomp_cascade_transitions do j = 1,nlevdecomp ! column loop do fc = 1,num_soilc c = filter_soilc(fc) - cf%decomp_cpools_sourcesink_col(c,j,cascade_receiver_pool(k)) = & - cf%decomp_cpools_sourcesink_col(c,j,cascade_receiver_pool(k)) & - + cf%decomp_cascade_ctransfer_vr_col(c,j,k)*dt + cf%decomp_cpools_sourcesink_col(c,j,cascade_donor_pool(k)) = & + cf%decomp_cpools_sourcesink_col(c,j,cascade_donor_pool(k)) & + - ( cf%decomp_cascade_hr_vr_col(c,j,k) + cf%decomp_cascade_ctransfer_vr_col(c,j,k)) *dt end do end do - end if - end do - - endif ! if (.not.(use_pflotran .and. pf_cmode)) - !------------------------------------------------------------------ - + end do + do k = 1, ndecomp_cascade_transitions + if ( cascade_receiver_pool(k) /= 0 ) then ! skip terminal transitions + do j = 1,nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + cf%decomp_cpools_sourcesink_col(c,j,cascade_receiver_pool(k)) = & + cf%decomp_cpools_sourcesink_col(c,j,cascade_receiver_pool(k)) & + + cf%decomp_cascade_ctransfer_vr_col(c,j,k)*dt + end do + end do + end if + end do + endif !end if is_active_betr_bgc() + + ! patch loop do fp = 1,num_soilp p = filter_soilp(fp) @@ -357,6 +380,14 @@ subroutine CStateUpdate1(& end do ! end of patch loop + if(is_active_betr_bgc)then + + !the following is introduced to fix the spinup problem with simultaneous nitrogen competition + + call p2c(bounds, num_soilc, filter_soilc, & + cs%frootc_patch(bounds%begp:bounds%endp), & + cnstate_vars%frootc_nfix_scalar_col(bounds%begc:bounds%endc)) + endif end associate end subroutine CStateUpdate1 diff --git a/components/clm/src/biogeochem/CNCStateUpdate2Mod.F90 b/components/clm/src/biogeochem/CNCStateUpdate2Mod.F90 index 9b745e1f7708..bcd0333c40bd 100644 --- a/components/clm/src/biogeochem/CNCStateUpdate2Mod.F90 +++ b/components/clm/src/biogeochem/CNCStateUpdate2Mod.F90 @@ -14,8 +14,8 @@ module CNCStateUpdate2Mod use CNCarbonFluxType , only : carbonflux_type use PatchType , only : pft use pftvarcon , only : npcropmin - ! bgc interface & pflotran: use clm_varctl , only : use_pflotran, pf_cmode + use PatchType , only : pft ! implicit none save @@ -36,12 +36,13 @@ subroutine CStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & ! On the radiation time step, update all the prognostic carbon state ! variables affected by gap-phase mortality fluxes ! + use tracer_varcon, only : is_active_betr_bgc ! !ARGUMENTS: integer , intent(in) :: num_soilc ! number of soil columns in filter integer , intent(in) :: filter_soilc(:) ! filter for soil columns integer , intent(in) :: num_soilp ! number of soil patches in filter integer , intent(in) :: filter_soilp(:) ! filter for soil patches - type(carbonflux_type) , intent(in) :: carbonflux_vars + type(carbonflux_type) , intent(inout) :: carbonflux_vars type(carbonstate_type) , intent(inout) :: carbonstate_vars ! ! !LOCAL VARIABLES: @@ -58,30 +59,47 @@ subroutine CStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & ! set time steps dt = real( get_step_size(), r8 ) - !------------------------------------------------------------------ - ! if coupled with pflotran, the following updates are NOT needed - if (.not.(use_pflotran .and. pf_cmode)) then - !------------------------------------------------------------------ - ! column level carbon fluxes from gap-phase mortality - do j = 1,nlevdecomp - ! column loop - do fc = 1,num_soilc - c = filter_soilc(fc) - - ! column gap mortality fluxes - cs%decomp_cpools_vr_col(c,j,i_met_lit) = & - cs%decomp_cpools_vr_col(c,j,i_met_lit) + cf%gap_mortality_c_to_litr_met_c_col(c,j) * dt - cs%decomp_cpools_vr_col(c,j,i_cel_lit) = & - cs%decomp_cpools_vr_col(c,j,i_cel_lit) + cf%gap_mortality_c_to_litr_cel_c_col(c,j) * dt - cs%decomp_cpools_vr_col(c,j,i_lig_lit) = & - cs%decomp_cpools_vr_col(c,j,i_lig_lit) + cf%gap_mortality_c_to_litr_lig_c_col(c,j) * dt - cs%decomp_cpools_vr_col(c,j,i_cwd) = & - cs%decomp_cpools_vr_col(c,j,i_cwd) + cf%gap_mortality_c_to_cwdc_col(c,j) * dt + if ( .not. is_active_betr_bgc .and. & + (.not.(use_pflotran .and. pf_cmode))) then + ! column level carbon fluxes from gap-phase mortality + do j = 1,nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + ! column gap mortality fluxes + cs%decomp_cpools_vr_col(c,j,i_met_lit) = & + cs%decomp_cpools_vr_col(c,j,i_met_lit) + cf%gap_mortality_c_to_litr_met_c_col(c,j) * dt + cs%decomp_cpools_vr_col(c,j,i_cel_lit) = & + cs%decomp_cpools_vr_col(c,j,i_cel_lit) + cf%gap_mortality_c_to_litr_cel_c_col(c,j) * dt + cs%decomp_cpools_vr_col(c,j,i_lig_lit) = & + cs%decomp_cpools_vr_col(c,j,i_lig_lit) + cf%gap_mortality_c_to_litr_lig_c_col(c,j) * dt + cs%decomp_cpools_vr_col(c,j,i_cwd) = & + cs%decomp_cpools_vr_col(c,j,i_cwd) + cf%gap_mortality_c_to_cwdc_col(c,j) * dt + + end do + end do + else if (is_active_betr_bgc) then + + do j = 1,nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! column gap mortality fluxes + cf%bgc_cpool_ext_inputs_vr_col(c,j,i_met_lit) = & + cf%bgc_cpool_ext_inputs_vr_col(c,j,i_met_lit) + cf%gap_mortality_c_to_litr_met_c_col(c,j) * dt + cf%bgc_cpool_ext_inputs_vr_col(c,j,i_cel_lit) = & + cf%bgc_cpool_ext_inputs_vr_col(c,j,i_cel_lit) + cf%gap_mortality_c_to_litr_cel_c_col(c,j) * dt + cf%bgc_cpool_ext_inputs_vr_col(c,j,i_lig_lit) = & + cf%bgc_cpool_ext_inputs_vr_col(c,j,i_lig_lit) + cf%gap_mortality_c_to_litr_lig_c_col(c,j) * dt + cf%bgc_cpool_ext_inputs_vr_col(c,j,i_cwd) = & + cf%bgc_cpool_ext_inputs_vr_col(c,j,i_cwd) + cf%gap_mortality_c_to_cwdc_col(c,j) * dt + + end do end do - end do - endif ! if (.not.(use_pflotran .and. pf_cmode)) - !------------------------------------------------------------------ + endif + ! patch loop do fp = 1,num_soilp @@ -95,7 +113,6 @@ subroutine CStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & cs%deadstemc_patch(p) = cs%deadstemc_patch(p) - cf%m_deadstemc_to_litter_patch(p) * dt cs%livecrootc_patch(p) = cs%livecrootc_patch(p) - cf%m_livecrootc_to_litter_patch(p) * dt cs%deadcrootc_patch(p) = cs%deadcrootc_patch(p) - cf%m_deadcrootc_to_litter_patch(p) * dt - ! storage pools cs%leafc_storage_patch(p) = cs%leafc_storage_patch(p) - cf%m_leafc_storage_to_litter_patch(p) * dt cs%frootc_storage_patch(p) = cs%frootc_storage_patch(p) - cf%m_frootc_storage_to_litter_patch(p) * dt @@ -126,12 +143,13 @@ subroutine CStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & ! Update all the prognostic carbon state ! variables affected by harvest mortality fluxes ! + use tracer_varcon, only : is_active_betr_bgc ! !ARGUMENTS: integer , intent(in) :: num_soilc ! number of soil columns in filter integer , intent(in) :: filter_soilc(:) ! filter for soil columns integer , intent(in) :: num_soilp ! number of soil patches in filter integer , intent(in) :: filter_soilp(:) ! filter for soil patches - type(carbonflux_type) , intent(in) :: carbonflux_vars + type(carbonflux_type) , intent(inout) :: carbonflux_vars type(carbonstate_type) , intent(inout) :: carbonstate_vars ! ! !LOCAL VARIABLES: @@ -149,31 +167,44 @@ subroutine CStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & ! set time steps dt = real( get_step_size(), r8 ) - !------------------------------------------------------------------ - ! if coupled with pflotran, the following updates are NOT needed - if (.not.(use_pflotran .and. pf_cmode)) then - !------------------------------------------------------------------ - ! column level carbon fluxes from harvest mortality - do j = 1, nlevdecomp - ! column loop - do fc = 1,num_soilc - c = filter_soilc(fc) - - ! column harvest fluxes - cs%decomp_cpools_vr_col(c,j,i_met_lit) = & - cs%decomp_cpools_vr_col(c,j,i_met_lit) + cf%harvest_c_to_litr_met_c_col(c,j) * dt - cs%decomp_cpools_vr_col(c,j,i_cel_lit) = & - cs%decomp_cpools_vr_col(c,j,i_cel_lit) + cf%harvest_c_to_litr_cel_c_col(c,j) * dt - cs%decomp_cpools_vr_col(c,j,i_lig_lit) = & - cs%decomp_cpools_vr_col(c,j,i_lig_lit) + cf%harvest_c_to_litr_lig_c_col(c,j) * dt - cs%decomp_cpools_vr_col(c,j,i_cwd) = & - cs%decomp_cpools_vr_col(c,j,i_cwd) + cf%harvest_c_to_cwdc_col(c,j) * dt - - ! wood to product pools - states updated in CNWoodProducts() + if ( (.not. is_active_betr_bgc) .and. & + .not.(use_pflotran .and. pf_cmode)) then + ! column level carbon fluxes from harvest mortality + do j = 1, nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! column harvest fluxes + cs%decomp_cpools_vr_col(c,j,i_met_lit) = & + cs%decomp_cpools_vr_col(c,j,i_met_lit) + cf%harvest_c_to_litr_met_c_col(c,j) * dt + cs%decomp_cpools_vr_col(c,j,i_cel_lit) = & + cs%decomp_cpools_vr_col(c,j,i_cel_lit) + cf%harvest_c_to_litr_cel_c_col(c,j) * dt + cs%decomp_cpools_vr_col(c,j,i_lig_lit) = & + cs%decomp_cpools_vr_col(c,j,i_lig_lit) + cf%harvest_c_to_litr_lig_c_col(c,j) * dt + cs%decomp_cpools_vr_col(c,j,i_cwd) = & + cs%decomp_cpools_vr_col(c,j,i_cwd) + cf%harvest_c_to_cwdc_col(c,j) * dt + + ! wood to product pools - states updated in CNWoodProducts() + end do end do - end do - endif ! if (.not.(use_pflotran .and. pf_cmode)) - !------------------------------------------------------------------ + + else if (is_active_betr_bgc) then + do j = 1, nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + cf%bgc_cpool_ext_inputs_vr_col(c,j,i_met_lit) = & + cf%bgc_cpool_ext_inputs_vr_col(c,j,i_met_lit) + cf%harvest_c_to_litr_met_c_col(c,j) * dt + cf%bgc_cpool_ext_inputs_vr_col(c,j,i_cel_lit) = & + cf%bgc_cpool_ext_inputs_vr_col(c,j,i_cel_lit) + cf%harvest_c_to_litr_cel_c_col(c,j) * dt + cf%bgc_cpool_ext_inputs_vr_col(c,j,i_lig_lit) = & + cf%bgc_cpool_ext_inputs_vr_col(c,j,i_lig_lit) + cf%harvest_c_to_litr_lig_c_col(c,j) * dt + cf%bgc_cpool_ext_inputs_vr_col(c,j,i_cwd) = & + cf%bgc_cpool_ext_inputs_vr_col(c,j,i_cwd) + cf%harvest_c_to_cwdc_col(c,j) * dt + end do + end do + endif ! patch loop do fp = 1,num_soilp @@ -198,7 +229,6 @@ subroutine CStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & ! xsmrpool cs%xsmrpool_patch(p) = cs%xsmrpool_patch(p) - cf%hrv_xsmrpool_to_atm_patch(p) * dt - ! storage pools cs%leafc_storage_patch(p) = cs%leafc_storage_patch(p) - cf%hrv_leafc_storage_to_litter_patch(p) * dt cs%frootc_storage_patch(p) = cs%frootc_storage_patch(p) - cf%hrv_frootc_storage_to_litter_patch(p) * dt diff --git a/components/clm/src/biogeochem/CNCStateUpdate3Mod.F90 b/components/clm/src/biogeochem/CNCStateUpdate3Mod.F90 index 752880982406..e38819b4c0a1 100644 --- a/components/clm/src/biogeochem/CNCStateUpdate3Mod.F90 +++ b/components/clm/src/biogeochem/CNCStateUpdate3Mod.F90 @@ -33,12 +33,14 @@ subroutine CStateUpdate3( num_soilc, filter_soilc, num_soilp, filter_soilp, & ! On the radiation time step, update all the prognostic carbon state ! variables affected by fire fluxes ! + use tracer_varcon , only : is_active_betr_bgc + use subgridAveMod , only : p2c ! !ARGUMENTS: integer , intent(in) :: num_soilc ! number of soil columns in filter integer , intent(in) :: filter_soilc(:) ! filter for soil columns integer , intent(in) :: num_soilp ! number of soil patches in filter integer , intent(in) :: filter_soilp(:) ! filter for soil patches - type(carbonflux_type) , intent(in) :: carbonflux_vars + type(carbonflux_type) , intent(inout) :: carbonflux_vars type(carbonstate_type) , intent(inout) :: carbonstate_vars ! ! !LOCAL VARIABLES: @@ -55,37 +57,64 @@ subroutine CStateUpdate3( num_soilc, filter_soilc, num_soilp, filter_soilp, & ! set time steps dt = real( get_step_size(), r8 ) - !------------------------------------------------------------------ - ! column level carbon fluxes from fire - do j = 1, nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) - ! pft-level wood to column-level CWD (uncombusted wood) - cs%decomp_cpools_vr_col(c,j,i_cwd) = cs%decomp_cpools_vr_col(c,j,i_cwd) + cf%fire_mortality_c_to_cwdc_col(c,j) * dt - - ! pft-level wood to column-level litter (uncombusted wood) - cs%decomp_cpools_vr_col(c,j,i_met_lit) = cs%decomp_cpools_vr_col(c,j,i_met_lit) + cf%m_c_to_litr_met_fire_col(c,j)* dt - cs%decomp_cpools_vr_col(c,j,i_cel_lit) = cs%decomp_cpools_vr_col(c,j,i_cel_lit) + cf%m_c_to_litr_cel_fire_col(c,j)* dt - cs%decomp_cpools_vr_col(c,j,i_lig_lit) = cs%decomp_cpools_vr_col(c,j,i_lig_lit) + cf%m_c_to_litr_lig_fire_col(c,j)* dt + if ( .not.is_active_betr_bgc )then + ! column level carbon fluxes from fire + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + ! pft-level wood to column-level CWD (uncombusted wood) + cs%decomp_cpools_vr_col(c,j,i_cwd) = cs%decomp_cpools_vr_col(c,j,i_cwd) + cf%fire_mortality_c_to_cwdc_col(c,j) * dt + + ! pft-level wood to column-level litter (uncombusted wood) + cs%decomp_cpools_vr_col(c,j,i_met_lit) = cs%decomp_cpools_vr_col(c,j,i_met_lit) + cf%m_c_to_litr_met_fire_col(c,j)* dt + cs%decomp_cpools_vr_col(c,j,i_cel_lit) = cs%decomp_cpools_vr_col(c,j,i_cel_lit) + cf%m_c_to_litr_cel_fire_col(c,j)* dt + cs%decomp_cpools_vr_col(c,j,i_lig_lit) = cs%decomp_cpools_vr_col(c,j,i_lig_lit) + cf%m_c_to_litr_lig_fire_col(c,j)* dt + end do end do - end do + ! litter and CWD losses to fire + do l = 1, ndecomp_pools + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + cs%decomp_cpools_vr_col(c,j,l) = cs%decomp_cpools_vr_col(c,j,l) - cf%m_decomp_cpools_to_fire_vr_col(c,j,l) * dt + end do + end do + end do - ! litter and CWD losses to fire - do l = 1, ndecomp_pools + else + + ! column level carbon fluxes from fire do j = 1, nlevdecomp do fc = 1,num_soilc c = filter_soilc(fc) - cs%decomp_cpools_vr_col(c,j,l) = cs%decomp_cpools_vr_col(c,j,l) - cf%m_decomp_cpools_to_fire_vr_col(c,j,l) * dt + ! pft-level wood to column-level CWD (uncombusted wood) + cf%bgc_cpool_ext_inputs_vr_col(c,j,i_cwd) = cf%bgc_cpool_ext_inputs_vr_col(c,j,i_cwd) + cf%fire_mortality_c_to_cwdc_col(c,j) * dt + + ! pft-level wood to column-level litter (uncombusted wood) + cf%bgc_cpool_ext_inputs_vr_col(c,j,i_met_lit) = cf%bgc_cpool_ext_inputs_vr_col(c,j,i_met_lit) + cf%m_c_to_litr_met_fire_col(c,j)* dt + cf%bgc_cpool_ext_inputs_vr_col(c,j,i_cel_lit) = cf%bgc_cpool_ext_inputs_vr_col(c,j,i_cel_lit) + cf%m_c_to_litr_cel_fire_col(c,j)* dt + cf%bgc_cpool_ext_inputs_vr_col(c,j,i_lig_lit) = cf%bgc_cpool_ext_inputs_vr_col(c,j,i_lig_lit) + cf%m_c_to_litr_lig_fire_col(c,j)* dt + end do + end do + + ! litter and CWD losses to fire + do l = 1, ndecomp_pools + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + cf%bgc_cpool_ext_loss_vr_col(c,j,l) = cf%bgc_cpool_ext_loss_vr_col(c,j,l) + cf%m_decomp_cpools_to_fire_vr_col(c,j,l) * dt + end do end do end do - end do + + endif ! ! patch loop do fp = 1,num_soilp p = filter_soilp(fp) - + ! pft-level carbon fluxes from fire ! displayed pools cs%leafc_patch(p) = cs%leafc_patch(p) - cf%m_leafc_to_fire_patch(p) * dt @@ -135,6 +164,8 @@ subroutine CStateUpdate3( num_soilc, filter_soilc, num_soilp, filter_soilp, & end do ! end of pft loop + + end associate end subroutine CStateUpdate3 diff --git a/components/clm/src/biogeochem/CNCarbonFluxType.F90 b/components/clm/src/biogeochem/CNCarbonFluxType.F90 index fdde01ca385f..e86da223a46b 100644 --- a/components/clm/src/biogeochem/CNCarbonFluxType.F90 +++ b/components/clm/src/biogeochem/CNCarbonFluxType.F90 @@ -363,6 +363,8 @@ module CNCarbonFluxType real(r8), pointer :: cwdc_loss_col (:) ! (gC/m2/s) col-level coarse woody debris C loss real(r8), pointer :: litterc_loss_col (:) ! (gC/m2/s) col-level litter C loss + real(r8), pointer :: bgc_cpool_ext_inputs_vr_col (:, :, :) ! col-level extneral organic carbon input gC/m3 /time step + real(r8), pointer :: bgc_cpool_ext_loss_vr_col (:, :, :) ! col-level extneral organic carbon loss gC/m3 /time step ! patch averaged to column variables - to remove need for pcf_a instance real(r8), pointer :: rr_col (:) ! column (gC/m2/s) root respiration (fine root MR + total root GR) (p2c) real(r8), pointer :: ar_col (:) ! column (gC/m2/s) autotrophic respiration (MR + GR) (p2c) @@ -399,7 +401,8 @@ module CNCarbonFluxType procedure , public :: SetValues procedure , public :: ZeroDWT procedure , public :: Summary - procedure , private :: InitAllocate + procedure , public :: summary_rr + procedure , private :: InitAllocate procedure , private :: InitHistory procedure , private :: InitCold ! bgc & pflotran interface @@ -685,6 +688,9 @@ subroutine InitAllocate(this, bounds) allocate(this%prod100c_loss_col (begc:endc)) ; this%prod100c_loss_col (:) =nan allocate(this%product_closs_col (begc:endc)) ; this%product_closs_col (:) =nan + allocate(this%bgc_cpool_ext_inputs_vr_col (begc:endc, 1:nlevdecomp_full,ndecomp_pools));this%bgc_cpool_ext_inputs_vr_col (:,:,:) = nan + allocate(this%bgc_cpool_ext_loss_vr_col (begc:endc, 1:nlevdecomp_full,ndecomp_pools));this%bgc_cpool_ext_loss_vr_col (:,:,:) = nan + allocate(this%lf_conv_cflux_col (begc:endc)) ; this%lf_conv_cflux_col (:) =nan allocate(this%lithr_col (begc:endc)) ; this%lithr_col (:) =nan allocate(this%somhr_col (begc:endc)) ; this%somhr_col (:) =nan @@ -779,7 +785,9 @@ subroutine InitHistory(this, bounds, carbon_type) use clm_varpar , only : nlevdecomp, nlevdecomp_full, crop_prog, nlevgrnd use clm_varctl , only : hist_wrtch4diag use histFileMod, only : hist_addfld1d, hist_addfld2d, hist_addfld_decomp - ! + use tracer_varcon , only : is_active_betr_bgc + use clm_varctl, only : get_carbontag + ! ! !ARGUMENTS: class(carbonflux_type) :: this type(bounds_type) , intent(in) :: bounds @@ -795,6 +803,7 @@ subroutine InitHistory(this, bounds, carbon_type) character(100) :: longname real(r8), pointer :: data1dptr(:) ! temp. pointer for slicing larger arrays real(r8), pointer :: data2dptr(:,:) ! temp. pointer for slicing larger arrays + character(len=3) :: ctag !--------------------------------------------------------------------- begp = bounds%begp; endp = bounds%endp @@ -2753,11 +2762,12 @@ subroutine InitHistory(this, bounds, carbon_type) ptr_col=data2dptr, default='inactive') end do - this%decomp_cascade_hr_col(begc:endc,:) = spval - this%decomp_cascade_hr_vr_col(begc:endc,:,:) = spval - this%decomp_cascade_ctransfer_col(begc:endc,:) = spval - this%decomp_cascade_ctransfer_vr_col(begc:endc,:,:) = spval - do l = 1, ndecomp_cascade_transitions + if(.not. is_active_betr_bgc)then + this%decomp_cascade_hr_col(begc:endc,:) = spval + this%decomp_cascade_hr_vr_col(begc:endc,:,:) = spval + this%decomp_cascade_ctransfer_col(begc:endc,:) = spval + this%decomp_cascade_ctransfer_vr_col(begc:endc,:,:) = spval + do l = 1, ndecomp_cascade_transitions ! output the vertically integrated fluxes only as default !-- HR fluxes (none from CWD) @@ -2835,8 +2845,9 @@ subroutine InitHistory(this, bounds, carbon_type) endif end if - end do - + end do + endif + this%t_scalar_col(begc:endc,:) = spval call hist_addfld_decomp (fname='T_SCALAR', units='unitless', type2d='levdcmp', & avgflag='A', long_name='temperature inhibition of decomposition', & @@ -2857,9 +2868,10 @@ subroutine InitHistory(this, bounds, carbon_type) avgflag='A', long_name='total flux of C from SOM pools due to leaching', & ptr_col=this%som_c_leached_col)!, default='inactive') - this%decomp_cpools_leached_col(begc:endc,:) = spval - this%decomp_cpools_transport_tendency_col(begc:endc,:,:) = spval - do k = 1, ndecomp_pools + if(.not. is_active_betr_bgc)then + this%decomp_cpools_leached_col(begc:endc,:) = spval + this%decomp_cpools_transport_tendency_col(begc:endc,:,:) = spval + do k = 1, ndecomp_pools if ( .not. decomp_cascade_con%is_cwd(k) ) then data1dptr => this%decomp_cpools_leached_col(:,k) fieldname = 'M_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'C_TO_LEACHING' @@ -2875,8 +2887,8 @@ subroutine InitHistory(this, bounds, carbon_type) avgflag='A', long_name=longname, & ptr_col=data2dptr, default='inactive') endif - end do - + end do + endif this%lithr_col(begc:endc) = spval call hist_addfld1d (fname='LITHR', units='gC/m^2/s', & avgflag='A', long_name='litter heterotrophic respiration', & @@ -3054,6 +3066,25 @@ subroutine InitHistory(this, bounds, carbon_type) end if + ctag=get_carbontag(carbon_type) + do k = 1, ndecomp_pools + this%bgc_cpool_ext_inputs_vr_col(begc:endc, :, k) = spval + data2dptr => this%bgc_cpool_ext_inputs_vr_col(:,:,k) + fieldname='BGC_'//trim(ctag)//'POOL_EINPUT_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'_vr' + longname=trim(ctag)//' input to '//trim(decomp_cascade_con%decomp_pool_name_history(k)) + call hist_addfld_decomp (fname=fieldname, units='g'//ctag//'/m^3', type2d='levdcmp', & + avgflag='A', long_name=longname, & + ptr_col=data2dptr, default='inactive') + + this%bgc_cpool_ext_loss_vr_col(begc:endc, :, k) = spval + data2dptr => this%bgc_cpool_ext_loss_vr_col(:,:,k) + fieldname='BGC_'//trim(ctag)//'POOL_ELOSS_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'_vr' + longname=trim(ctag)//' loss of '//trim(decomp_cascade_con%decomp_pool_name_history(k)) + call hist_addfld_decomp (fname=fieldname, units='g'//ctag//'/m^3', type2d='levdcmp', & + avgflag='A', long_name=longname, & + ptr_col=data2dptr, default='inactive') + + enddo !------------------------------- ! C13 flux variables - native to column !------------------------------- @@ -3081,12 +3112,12 @@ subroutine InitHistory(this, bounds, carbon_type) end if endif end do - - this%decomp_cascade_hr_col(begc:endc,:) = spval - this%decomp_cascade_hr_vr_col(begc:endc,:,:) = spval - this%decomp_cascade_ctransfer_col(begc:endc,:) = spval - this%decomp_cascade_ctransfer_vr_col(begc:endc,:,:) = spval - do l = 1, ndecomp_cascade_transitions + if(.not. is_active_betr_bgc)then + this%decomp_cascade_hr_col(begc:endc,:) = spval + this%decomp_cascade_hr_vr_col(begc:endc,:,:) = spval + this%decomp_cascade_ctransfer_col(begc:endc,:) = spval + this%decomp_cascade_ctransfer_vr_col(begc:endc,:,:) = spval + do l = 1, ndecomp_cascade_transitions !-- HR fluxes (none from CWD) if ( .not. decomp_cascade_con%is_cwd(decomp_cascade_con%cascade_donor_pool(l)) ) then data2dptr => this%decomp_cascade_hr_vr_col(:,:,l) @@ -3125,8 +3156,9 @@ subroutine InitHistory(this, bounds, carbon_type) avgflag='A', long_name=longname, & ptr_col=data2dptr, default='inactive') endif - end do - + end do + endif + this%lithr_col(begc:endc) = spval call hist_addfld1d (fname='C13_LITHR', units='gC13/m^2/s', & avgflag='A', long_name='C13 fine root C litterfall to litter 3 C', & @@ -3285,12 +3317,12 @@ subroutine InitHistory(this, bounds, carbon_type) end if endif end do - - this%decomp_cascade_hr_col(begc:endc,:) = spval - this%decomp_cascade_hr_vr_col(begc:endc,:,:) = spval - this%decomp_cascade_ctransfer_col(begc:endc,:) = spval - this%decomp_cascade_ctransfer_vr_col(begc:endc,:,:) = spval - do l = 1, ndecomp_cascade_transitions + if(.not. is_active_betr_bgc)then + this%decomp_cascade_hr_col(begc:endc,:) = spval + this%decomp_cascade_hr_vr_col(begc:endc,:,:) = spval + this%decomp_cascade_ctransfer_col(begc:endc,:) = spval + this%decomp_cascade_ctransfer_vr_col(begc:endc,:,:) = spval + do l = 1, ndecomp_cascade_transitions !-- HR fluxes (none from CWD) if ( .not. decomp_cascade_con%is_cwd(decomp_cascade_con%cascade_donor_pool(l)) ) then data2dptr => this%decomp_cascade_hr_vr_col(:,:,l) @@ -3329,8 +3361,9 @@ subroutine InitHistory(this, bounds, carbon_type) avgflag='A', long_name=longname, & ptr_col=data2dptr, default='inactive') endif - end do - + end do + endif + this%lithr_col(begc:endc) = spval call hist_addfld1d (fname='C14_LITHR', units='gC14/m^2/s', & avgflag='A', long_name='C14 fine root C litterfall to litter 3 C', & @@ -3617,7 +3650,7 @@ subroutine Restart ( this, bounds, ncid, flag ) use shr_infnan_mod , only : isnan => shr_infnan_isnan, nan => shr_infnan_nan, assignment(=) use clm_time_manager , only : is_restart use clm_varcon , only : c13ratio, c14ratio - use clm_varctl , only : use_lch4 + use clm_varctl , only : use_lch4, use_betr use restUtilMod use ncdio_pio @@ -3694,7 +3727,7 @@ subroutine Restart ( this, bounds, ncid, flag ) end if - if (use_lch4) then + if (use_lch4 .or. use_betr) then call restartvar(ncid=ncid, flag=flag, varname='tempavg_agnpp', xtype=ncd_double, & dim1name='pft',& long_name='Temp. Average AGNPP',units='gC/m^2/s', & @@ -4106,6 +4139,8 @@ subroutine SetValues ( this, & i = filter_column(fi) this%decomp_cpools_leached_col(i,k) = value_column this%m_decomp_cpools_to_fire_col(i,k) = value_column + this%bgc_cpool_ext_inputs_vr_col(i,:, k) = value_column + this%bgc_cpool_ext_loss_vr_col(i,:, k) = value_column end do end do @@ -4235,11 +4270,13 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil ! On the radiation time step, perform patch and column-level carbon summary calculations ! ! !USES: - use clm_varctl , only: iulog, use_cndv - use clm_time_manager , only: get_step_size - use clm_varcon , only: secspday - use clm_varpar , only: nlevdecomp, ndecomp_pools, ndecomp_cascade_transitions - use subgridAveMod , only: p2c + use clm_varctl , only : iulog, use_cndv + use clm_time_manager , only : get_step_size + use clm_varcon , only : secspday + use clm_varpar , only : nlevdecomp, ndecomp_pools, ndecomp_cascade_transitions + use subgridAveMod , only : p2c + use tracer_varcon , only : is_active_betr_bgc + use MathfuncMod , only : dot_sum ! ! !ARGUMENTS: class(carbonflux_type) :: this @@ -4352,18 +4389,7 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil this%gr_patch(p) end if - ! root respiration (RR) - this%rr_patch(p) = & - this%froot_mr_patch(p) + & - this%cpool_froot_gr_patch(p) + & - this%cpool_livecroot_gr_patch(p) + & - this%cpool_deadcroot_gr_patch(p) + & - this%transfer_froot_gr_patch(p) + & - this%transfer_livecroot_gr_patch(p) + & - this%transfer_deadcroot_gr_patch(p) + & - this%cpool_froot_storage_gr_patch(p) + & - this%cpool_livecroot_storage_gr_patch(p) + & - this%cpool_deadcroot_storage_gr_patch(p) + ! net primary production (NPP) this%npp_patch(p) = & @@ -4674,12 +4700,13 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil this%cwdc_loss_col(c) = 0._r8 this%som_c_leached_col(c) = 0._r8 end do + + if ( (.not. is_active_betr_bgc ) .and. & + (.not. (use_pflotran .and. pf_cmode))) then + + ! vertically integrate HR and decomposition cascade fluxes + do k = 1, ndecomp_cascade_transitions - ! bgc interface & pflotran: - !---------------------------------------------------------------- - if (.not.(use_pflotran .and. pf_cmode)) then - ! vertically integrate HR and decomposition cascade fluxes - do k = 1, ndecomp_cascade_transitions do j = 1,nlevdecomp do fc = 1,num_soilc c = filter_soilc(fc) @@ -4693,10 +4720,10 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil this%decomp_cascade_ctransfer_vr_col(c,j,k) * dzsoi_decomp(j) end do end do - end do + end do - ! litter heterotrophic respiration (LITHR) - do k = 1, ndecomp_cascade_transitions + ! litter heterotrophic respiration (LITHR) + do k = 1, ndecomp_cascade_transitions if ( is_litter(decomp_cascade_con%cascade_donor_pool(k)) ) then do fc = 1,num_soilc c = filter_soilc(fc) @@ -4705,10 +4732,10 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil this%decomp_cascade_hr_col(c,k) end do end if - end do + end do - ! soil organic matter heterotrophic respiration (SOMHR) - do k = 1, ndecomp_cascade_transitions + ! soil organic matter heterotrophic respiration (SOMHR) + do k = 1, ndecomp_cascade_transitions if ( is_soil(decomp_cascade_con%cascade_donor_pool(k)) ) then do fc = 1,num_soilc c = filter_soilc(fc) @@ -4717,35 +4744,43 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil this%decomp_cascade_hr_col(c,k) end do end if - end do + end do - ! total heterotrophic respiration (HR) - do fc = 1,num_soilc - c = filter_soilc(fc) - this%hr_col(c) = & + ! total heterotrophic respiration (HR) + do fc = 1,num_soilc + c = filter_soilc(fc) + this%hr_col(c) = & this%lithr_col(c) + & this%somhr_col(c) - end do + end do - ! total heterotrophic respiration, vertically resolved (HR) - do j = 1,nlevdecomp - do fc = 1,num_soilc + ! total heterotrophic respiration, vertically resolved (HR) + do j = 1,nlevdecomp + do fc = 1,num_soilc c = filter_soilc(fc) this%hr_vr_col(c,j) = 0._r8 - end do - end do - do k = 1, ndecomp_cascade_transitions - do j = 1,nlevdecomp + end do + end do + + do k = 1, ndecomp_cascade_transitions + do j = 1,nlevdecomp do fc = 1,num_soilc c = filter_soilc(fc) this%hr_vr_col(c,j) = & this%hr_vr_col(c,j) + & this%decomp_cascade_hr_vr_col(c,j,k) end do - end do - end do - end if !!if (.not.(use_pflotran .and. pf_cmode)) - !---------------------------------------------------------------- + end do + end do + + elseif (is_active_betr_bgc) then + + do fc = 1, num_soilc + c = filter_soilc(fc) + this%hr_col(c) = dot_sum(this%hr_vr_col(c,1:nlevdecomp),dzsoi_decomp(1:nlevdecomp)) + enddo + endif + ! bgc interface & pflotran: !---------------------------------------------------------------- @@ -4754,7 +4789,7 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil end if !! CSummary_interface: hr_col(c) will be used below !---------------------------------------------------------------- - + do fc = 1,num_soilc c = filter_soilc(fc) ! total soil respiration, heterotrophic + root respiration (SR) @@ -4846,9 +4881,10 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil end do ! for vertically-resolved soil biogeochemistry, calculate some diagnostics of carbon pools to a given depth - ! ! bgc interface & pflotran - !---------------------------------------------------------------- - if (.not.(use_pflotran .and. pf_cmode)) then + + if ( (.not. is_active_betr_bgc) .and. & + (.not.(use_pflotran .and. pf_cmode)) ) then + ! _col(cWDC_HR) - coarse woody debris heterotrophic respiration do fc = 1,num_soilc c = filter_soilc(fc) @@ -4893,7 +4929,9 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil end do end if end do - do k = 1, ndecomp_cascade_transitions + + + do k = 1, ndecomp_cascade_transitions if ( is_litter(decomp_cascade_con%cascade_donor_pool(k)) ) then do fc = 1,num_soilc c = filter_soilc(fc) @@ -4902,12 +4940,12 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil this%decomp_cascade_ctransfer_col(c,k) end do end if - end do - end if !!if (.not.(use_pflotran .and. pf_cmode)) then - !---------------------------------------------------------------- + end do - ! add up all vertical transport tendency terms and calculate total som leaching loss as the sum of these - do l = 1, ndecomp_pools + else if ((use_pflotran .and. pf_cmode)) then + + ! add up all vertical transport tendency terms and calculate total som leaching loss as the sum of these + do l = 1, ndecomp_pools do fc = 1,num_soilc c = filter_soilc(fc) this%decomp_cpools_leached_col(c,l) = 0._r8 @@ -4926,8 +4964,8 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil this%som_c_leached_col(c) + & this%decomp_cpools_leached_col(c,l) end do - end do - + end do + endif end associate end subroutine Summary @@ -5136,4 +5174,43 @@ subroutine CSummary_interface(this, bounds, num_soilc, filter_soilc) end associate end subroutine CSummary_interface !!------------------------------------------------------------------------------------------------- + + !------------------------------------------------------------ + subroutine summary_rr(this, bounds, num_soilp, filter_soilp, num_soilc, filter_soilc) + ! + ! description + ! summarize root respiration + + use subgridAveMod , only: p2c + class(carbonflux_type) :: this + + type(bounds_type), intent(in) :: bounds + integer, intent(in) :: num_soilp + integer, intent(in) :: filter_soilp(:) + integer, intent(in) :: num_soilc + integer, intent(in) :: filter_soilc(:) + integer :: fp, p + ! patch loop + do fp = 1,num_soilp + p = filter_soilp(fp) + ! root respiration (RR) + this%rr_patch(p) = & + this%froot_mr_patch(p) + & + this%cpool_froot_gr_patch(p) + & + this%cpool_livecroot_gr_patch(p) + & + this%cpool_deadcroot_gr_patch(p) + & + this%transfer_froot_gr_patch(p) + & + this%transfer_livecroot_gr_patch(p) + & + this%transfer_deadcroot_gr_patch(p) + & + this%cpool_froot_storage_gr_patch(p) + & + this%cpool_livecroot_storage_gr_patch(p) + & + this%cpool_deadcroot_storage_gr_patch(p) + enddo + call p2c(bounds, num_soilc, filter_soilc, & + this%rr_patch(bounds%begp:bounds%endp), & + this%rr_col(bounds%begc:bounds%endc)) + + end subroutine summary_rr + + end module CNCarbonFluxType diff --git a/components/clm/src/biogeochem/CNCarbonStateType.F90 b/components/clm/src/biogeochem/CNCarbonStateType.F90 index 34b6a2734694..2988a9b09a0f 100644 --- a/components/clm/src/biogeochem/CNCarbonStateType.F90 +++ b/components/clm/src/biogeochem/CNCarbonStateType.F90 @@ -65,6 +65,7 @@ module CNCarbonStateType real(r8), pointer :: ctrunc_vr_col (:,:) ! col (gC/m3) vertically-resolved column-level sink for C truncation ! pools for dynamic landcover + real(r8), pointer :: frootc_col (:) ! col (gC/m2) column-level C pool for fine root real(r8), pointer :: seedc_col (:) ! col (gC/m2) column-level pool for seeding new Patches real(r8), pointer :: prod10c_col (:) ! col (gC/m2) wood product C pool, 10-year lifespan real(r8), pointer :: prod100c_col (:) ! col (gC/m2) wood product C pool, 100-year lifespan @@ -89,6 +90,7 @@ module CNCarbonStateType real(r8), pointer :: totsomc_1m_col (:) ! col (gC/m2) total soil organic matter carbon to 1 meter real(r8), pointer :: totecosysc_col (:) ! col (gC/m2) total ecosystem carbon, incl veg but excl cpool real(r8), pointer :: totcolc_col (:) ! col (gC/m2) total column carbon, incl veg and cpool + real(r8), pointer :: totabgc_col (:) ! col (gC/m2) total column above ground carbon, excluding som ! Balance checks real(r8), pointer :: begcb_patch (:) ! patch carbon mass, beginning of time step (gC/m**2) @@ -205,6 +207,7 @@ subroutine InitAllocate(this, bounds) allocate(this%totpftc_col (begc :endc)) ; this%totpftc_col (:) = nan allocate(this%totvegc_col (begc :endc)) ; this%totvegc_col (:) = nan + allocate(this%totabgc_col (begc :endc)) ; this%totabgc_col (:) = nan allocate(this%decomp_cpools_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools)) this%decomp_cpools_vr_col(:,:,:)= nan @@ -697,33 +700,36 @@ subroutine InitHistory(this, bounds, carbon_type) if (carbon_type == 'c12') then - this%decomp_cpools_col(begc:endc,:) = spval - do l = 1, ndecomp_pools - if ( nlevdecomp_full > 1 ) then - data2dptr => this%decomp_cpools_vr_col(:,:,l) - fieldname = trim(decomp_cascade_con%decomp_pool_name_history(l))//'C_vr' - longname = trim(decomp_cascade_con%decomp_pool_name_history(l))//' C (vertically resolved)' - call hist_addfld2d (fname=fieldname, units='gC/m^3', type2d='levdcmp', & + + !those variables are now ouput in betr + this%decomp_cpools_col(begc:endc,:) = spval + do l = 1, ndecomp_pools + if ( nlevdecomp_full > 1 ) then + data2dptr => this%decomp_cpools_vr_col(:,:,l) + fieldname = trim(decomp_cascade_con%decomp_pool_name_history(l))//'C_vr' + longname = trim(decomp_cascade_con%decomp_pool_name_history(l))//' C (vertically resolved)' + + call hist_addfld2d (fname=fieldname, units='gC/m^3', type2d='levdcmp', & avgflag='A', long_name=longname, & ptr_col=data2dptr) - endif + endif - data1dptr => this%decomp_cpools_col(:,l) - fieldname = trim(decomp_cascade_con%decomp_pool_name_history(l))//'C' - longname = trim(decomp_cascade_con%decomp_pool_name_history(l))//' C' - call hist_addfld1d (fname=fieldname, units='gC/m^2', & + data1dptr => this%decomp_cpools_col(:,l) + fieldname = trim(decomp_cascade_con%decomp_pool_name_history(l))//'C' + longname = trim(decomp_cascade_con%decomp_pool_name_history(l))//' C' + call hist_addfld1d (fname=fieldname, units='gC/m^2', & avgflag='A', long_name=longname, & ptr_col=data1dptr) - if ( nlevdecomp_full > 1 ) then + if ( nlevdecomp_full > 1 ) then data1dptr => this%decomp_cpools_1m_col(:,l) fieldname = trim(decomp_cascade_con%decomp_pool_name_history(l))//'C_1m' longname = trim(decomp_cascade_con%decomp_pool_name_history(l))//' C to 1 meter' call hist_addfld1d (fname=fieldname, units='gC/m^2', & avgflag='A', long_name=longname, & ptr_col=data1dptr, default = 'inactive') - endif - end do + endif + end do if ( nlevdecomp_full > 1 ) then this%totlitc_1m_col(begc:endc) = spval @@ -806,8 +812,9 @@ subroutine InitHistory(this, bounds, carbon_type) if ( carbon_type == 'c13' ) then - this%decomp_cpools_vr_col(begc:endc,:,:) = spval - do l = 1, ndecomp_pools + + this%decomp_cpools_vr_col(begc:endc,:,:) = spval + do l = 1, ndecomp_pools if ( nlevdecomp_full > 1 ) then data2dptr => this%decomp_cpools_vr_col(:,:,l) fieldname = 'C13_'//trim(decomp_cascade_con%decomp_pool_name_history(l))//'C_vr' @@ -823,7 +830,7 @@ subroutine InitHistory(this, bounds, carbon_type) call hist_addfld1d (fname=fieldname, units='gC13/m^2', & avgflag='A', long_name=longname, & ptr_col=data1dptr) - end do + end do this%seedc_col(begc:endc) = spval call hist_addfld1d (fname='C13_SEEDC', units='gC13/m^2', & @@ -2841,7 +2848,7 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil this%totvegc_patch(p) + & this%xsmrpool_patch(p) + & this%ctrunc_patch(p) - + c = pft%column(p) ! (WOODC) - wood C this%woodc_patch(p) = & this%deadstemc_patch(p) + & @@ -2851,10 +2858,7 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil end do - call p2c(bounds, num_soilc, filter_soilc, & - this%totpftc_patch(bounds%begp:bounds%endp), & - this%totpftc_col(bounds%begc:bounds%endc)) - + call p2c(bounds, num_soilc, filter_soilc, & this%totpftc_patch(bounds%begp:bounds%endp), & this%totpftc_col(bounds%begc:bounds%endc)) @@ -2866,14 +2870,15 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil ! column level summary - ! vertically integrate each of the decomposing C pools - do l = 1, ndecomp_pools + + ! vertically integrate each of the decomposing C pools + do l = 1, ndecomp_pools do fc = 1,num_soilc c = filter_soilc(fc) this%decomp_cpools_col(c,l) = 0._r8 end do - end do - do l = 1, ndecomp_pools + end do + do l = 1, ndecomp_pools do j = 1, nlevdecomp do fc = 1,num_soilc c = filter_soilc(fc) @@ -2882,9 +2887,9 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil this%decomp_cpools_vr_col(c,j,l) * dzsoi_decomp(j) end do end do - end do + end do - if ( nlevdecomp > 1) then + if ( nlevdecomp > 1) then ! vertically integrate each of the decomposing C pools to 1 meter maxdepth = 1._r8 @@ -2946,14 +2951,14 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil end if end do - endif - - ! total litter carbon (TOTLITC) - do fc = 1,num_soilc + endif + + ! total litter carbon (TOTLITC) + do fc = 1,num_soilc c = filter_soilc(fc) this%totlitc_col(c) = 0._r8 - end do - do l = 1, ndecomp_pools + end do + do l = 1, ndecomp_pools if ( decomp_cascade_con%is_litter(l) ) then do fc = 1,num_soilc c = filter_soilc(fc) @@ -2962,14 +2967,14 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil this%decomp_cpools_col(c,l) end do endif - end do + end do - ! total soil organic matter carbon (TOTSOMC) - do fc = 1,num_soilc + ! total soil organic matter carbon (TOTSOMC) + do fc = 1,num_soilc c = filter_soilc(fc) this%totsomc_col(c) = 0._r8 - end do - do l = 1, ndecomp_pools + end do + do l = 1, ndecomp_pools if ( decomp_cascade_con%is_soil(l) ) then do fc = 1,num_soilc c = filter_soilc(fc) @@ -2978,14 +2983,14 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil this%decomp_cpools_col(c,l) end do end if - end do + end do - ! coarse woody debris carbon - do fc = 1,num_soilc + ! coarse woody debris carbon + do fc = 1,num_soilc c = filter_soilc(fc) this%cwdc_col(c) = 0._r8 - end do - do l = 1, ndecomp_pools + end do + do l = 1, ndecomp_pools if ( decomp_cascade_con%is_cwd(l) ) then do fc = 1,num_soilc c = filter_soilc(fc) @@ -2994,7 +2999,7 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil this%decomp_cpools_col(c,l) end do end if - end do + end do ! truncation carbon do fc = 1,num_soilc @@ -3037,6 +3042,12 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil this%totprodc_col(c) + & this%seedc_col(c) + & this%ctrunc_col(c) + + this%totabgc_col(c) = & + this%totpftc_col(c) + & + this%totprodc_col(c) + & + this%seedc_col(c) + & + this%ctrunc_col(c) end do end subroutine Summary diff --git a/components/clm/src/biogeochem/CNDecompCascadeBGCMod.F90 b/components/clm/src/biogeochem/CNDecompCascadeBGCMod.F90 index 48173dfbca5e..c1d8ebddc1da 100644 --- a/components/clm/src/biogeochem/CNDecompCascadeBGCMod.F90 +++ b/components/clm/src/biogeochem/CNDecompCascadeBGCMod.F90 @@ -307,6 +307,7 @@ subroutine init_decompcascade_bgc(bounds, cnstate_vars, soilstate_vars) cn_s2 = CNDecompBgcParamsInst%cn_s2_bgc cn_s3 = CNDecompBgcParamsInst%cn_s3_bgc + ! set respiration fractions for fluxes between compartments rf_l1s1 = CNDecompBgcParamsInst%rf_l1s1_bgc rf_l2s1 = CNDecompBgcParamsInst%rf_l2s1_bgc @@ -322,7 +323,7 @@ subroutine init_decompcascade_bgc(bounds, cnstate_vars, soilstate_vars) cwd_fcel = CNDecompBgcParamsInst%cwd_fcel_bgc cwd_flig = CNDecompBgcParamsInst%cwd_flig_bgc - ! set path fractions + ! set path fractions f_s2s1 = 0.42_r8/(0.45_r8) f_s2s3 = 0.03_r8/(0.45_r8) @@ -358,7 +359,7 @@ subroutine init_decompcascade_bgc(bounds, cnstate_vars, soilstate_vars) decomp_pool_name_restart(i_litr2) = 'litr2' decomp_pool_name_history(i_litr2) = 'LITR2' decomp_pool_name_long(i_litr2) = 'litter 2' - decomp_pool_name_short(i_litr2) = 'L2' + decomp_pool_name_short(i_litr2) = 'L2' is_litter(i_litr2) = .true. is_soil(i_litr2) = .false. is_cwd(i_litr2) = .false. @@ -451,6 +452,7 @@ subroutine init_decompcascade_bgc(bounds, cnstate_vars, soilstate_vars) spinup_factor(i_soil2) = CNDecompBgcParamsInst%spinup_vector(2) spinup_factor(i_soil3) = CNDecompBgcParamsInst%spinup_vector(3) + !---------------- list of transitions and their time-independent coefficients ---------------! i_l1s1 = 1 cascade_step_name(i_l1s1) = 'L1S1' @@ -521,7 +523,7 @@ subroutine init_decompcascade_bgc(bounds, cnstate_vars, soilstate_vars) cascade_donor_pool(i_cwdl3) = i_cwd cascade_receiver_pool(i_cwdl3) = i_litr3 pathfrac_decomp_cascade(bounds%begc:bounds%endc,1:nlevdecomp,i_cwdl3) = cwd_flig - + deallocate(rf_s1s2) deallocate(rf_s1s3) deallocate(f_s1s2) diff --git a/components/clm/src/biogeochem/CNEcosystemDynBetrMod.F90 b/components/clm/src/biogeochem/CNEcosystemDynBetrMod.F90 new file mode 100644 index 000000000000..571979da5f7f --- /dev/null +++ b/components/clm/src/biogeochem/CNEcosystemDynBetrMod.F90 @@ -0,0 +1,638 @@ +module CNEcosystemDynBetrMod + + ! + ! DESCRIPTION + ! betr based aboveground belowground coupling + ! + ! Created by Jinyun Tang + ! Now it is only for generic carbon coupling no isotope is attempted below, but will + ! be enabled gradually. + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_sys_mod , only : shr_sys_flush + use clm_varctl , only : flanduse_timeseries, use_c13, use_c14, use_ed + use decompMod , only : bounds_type + use perf_mod , only : t_startf, t_stopf + use spmdMod , only : masterproc + use clm_varctl , only : use_century_decomp + use CNStateType , only : cnstate_type + use CNCarbonFluxType , only : carbonflux_type + use CNCarbonStateType , only : carbonstate_type + use CNNitrogenFluxType , only : nitrogenflux_type + use CNNitrogenStateType , only : nitrogenstate_type + use CNDVType , only : dgvs_type + use CanopyStateType , only : canopystate_type + use SoilStateType , only : soilstate_type + use TemperatureType , only : temperature_type + use WaterstateType , only : waterstate_type + use WaterfluxType , only : waterflux_type + use atm2lndType , only : atm2lnd_type + use SoilStateType , only : soilstate_type + use CanopyStateType , only : canopystate_type + use TemperatureType , only : temperature_type + use PhotosynthesisType , only : photosyns_type + use ch4Mod , only : ch4_type + use EnergyFluxType , only : energyflux_type + use SoilHydrologyType , only : soilhydrology_type + use FrictionVelocityType , only : frictionvel_type + use PlantSoilnutrientFluxType , only : plantsoilnutrientflux_type + use tracerfluxType , only : tracerflux_type + use tracerstatetype , only : tracerstate_type + use BetrTracerType , only : betrtracer_type + use PhosphorusFluxType , only : phosphorusflux_type + use PhosphorusStateType , only : phosphorusstate_type + + implicit none + + private + public :: CNEcosystemDynBetrVeg + public :: CNEcosystemDynBetrSummary + public :: CNFluxStateBetrSummary + public :: CNEcosystemDynBetrInit + contains + + !----------------------------------------------------------------------- + subroutine CNEcosystemDynBetrInit(bounds) + ! + ! !DESCRIPTION: + ! Initialzation of the CN Ecosystem dynamics. + ! + ! !USES: + use CNAllocationBetrMod, only : CNAllocationBetrInit + use CNPhenologyMod , only : CNPhenologyInit + use CNFireMod , only : CNFireInit + use CNC14DecayMod , only : C14_init_BombSpike + ! + ! !ARGUMENTS: + implicit none + type(bounds_type), intent(in) :: bounds + !----------------------------------------------------------------------- + + call CNAllocationBetrInit (bounds) + call CNPhenologyInit (bounds) + call CNFireInit (bounds) + + if ( use_c14 ) then + call C14_init_BombSpike() + end if + + end subroutine CNEcosystemDynBetrInit + + !----------------------------------------------------------------------- + subroutine CNEcosystemDynBetrVeg(bounds, & + num_soilc, filter_soilc, & + num_soilp, filter_soilp, num_pcropp, filter_pcropp, doalb, & + cnstate_vars, carbonflux_vars, carbonstate_vars, & + c13_carbonflux_vars, c13_carbonstate_vars, & + c14_carbonflux_vars, c14_carbonstate_vars, & + nitrogenflux_vars, nitrogenstate_vars, & + atm2lnd_vars, waterstate_vars, waterflux_vars, & + canopystate_vars, soilstate_vars, temperature_vars, crop_vars, & + dgvs_vars, photosyns_vars, soilhydrology_vars, energyflux_vars, & + plantsoilnutrientflux_vars, & + phosphorusflux_vars, phosphorusstate_vars) + + ! + ! Update vegetation related state variables and fluxes + ! and obtain some belowground fluxes to be applied in belowground bgc + ! + ! !USES: + use CNNDynamicsMod , only: CNNDeposition,CNNFixation, CNNFert, CNSoyfix + use CNMRespMod , only: CNMResp + use CNDecompMod , only: CNDecompAlloc + use CNPhenologyMod , only: CNPhenology + use CNGRespMod , only: CNGResp + use CNCStateUpdate1Mod , only: CStateUpdate1,CStateUpdate0 + use CNNStateUpdate1Mod , only: NStateUpdate1 + use CNGapMortalityMod , only: CNGapMortality + use CNCStateUpdate2Mod , only: CStateUpdate2, CStateUpdate2h + use CNNStateUpdate2Mod , only: NStateUpdate2, NStateUpdate2h + use CNFireMod , only: CNFireArea, CNFireFluxes + use CNCStateUpdate3Mod , only: CStateUpdate3 + use CNCIsoFluxMod , only: CIsoFlux1, CIsoFlux2, CIsoFlux2h, CIsoFlux3 + use CNC14DecayMod , only: C14Decay, C14BombSpike + use CNWoodProductsMod , only: CNWoodProducts + use CNDecompCascadeBGCMod , only: decomp_rate_constants_bgc + use CNDecompCascadeCNMod , only: decomp_rate_constants_cn + use CropType , only: crop_type + use dynHarvestMod , only: CNHarvest + use clm_varpar , only: crop_prog + use PlantSoilnutrientFluxType , only : plantsoilnutrientflux_type + use CNAllocationBetrMod , only : calc_plant_nutrient_demand + use CNVerticalProfileMod , only : decomp_vertprofiles + use CNAllocationBetrMod , only : plantCNAlloc + use CNNStateUpdate3Mod , only : NStateUpdate3 + implicit none + ! + ! !ARGUMENTS: + 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_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_pcropp ! number of prog. crop patches in filter + integer , intent(in) :: filter_pcropp(:) ! filter for prognostic crop patches + logical , intent(in) :: doalb ! true = surface albedo calculation time step + type(cnstate_type) , intent(inout) :: cnstate_vars + type(carbonflux_type) , intent(inout) :: carbonflux_vars + type(carbonstate_type) , intent(inout) :: carbonstate_vars + type(carbonflux_type) , intent(inout) :: c13_carbonflux_vars + type(carbonstate_type) , intent(inout) :: c13_carbonstate_vars + type(carbonflux_type) , intent(inout) :: c14_carbonflux_vars + type(carbonstate_type) , intent(inout) :: c14_carbonstate_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars + type(atm2lnd_type) , intent(in) :: atm2lnd_vars + type(waterstate_type) , intent(in) :: waterstate_vars + type(waterflux_type) , intent(in) :: waterflux_vars + type(canopystate_type) , intent(in) :: canopystate_vars + type(soilstate_type) , intent(in) :: soilstate_vars + type(temperature_type) , intent(inout) :: temperature_vars + type(crop_type) , intent(inout) :: crop_vars + type(dgvs_type) , intent(inout) :: dgvs_vars + type(photosyns_type) , intent(in) :: photosyns_vars + type(soilhydrology_type) , intent(in) :: soilhydrology_vars + type(energyflux_type) , intent(in) :: energyflux_vars + type(plantsoilnutrientflux_type) , intent(inout) :: plantsoilnutrientflux_vars + type(phosphorusflux_type) , intent(inout) :: phosphorusflux_vars + type(phosphorusstate_type) , intent(inout) :: phosphorusstate_vars + + ! -------------------------------------------------- + ! zero the column-level C and N fluxes + ! -------------------------------------------------- + + call t_startf('CNZero') + + call carbonflux_vars%SetValues( & + num_soilp, filter_soilp, 0._r8, & + num_soilc, filter_soilc, 0._r8) + + if ( use_c13 ) then + call c13_carbonflux_vars%SetValues( & + num_soilp, filter_soilp, 0._r8, & + num_soilc, filter_soilc, 0._r8) + end if + + if ( use_c14 ) then + call c14_carbonflux_vars%SetValues( & + num_soilp, filter_soilp, 0._r8, & + num_soilc, filter_soilc, 0._r8) + end if + + call nitrogenflux_vars%SetValues( & + num_soilp, filter_soilp, 0._r8, & + num_soilc, filter_soilc, 0._r8) + + call t_stopf('CNZero') + + ! -------------------------------------------------- + ! Nitrogen Deposition, Fixation and Respiration + ! -------------------------------------------------- + + call t_startf('CNDeposition') + call CNNDeposition(bounds, & + atm2lnd_vars, nitrogenflux_vars) + call t_stopf('CNDeposition') + + call t_startf('CNFixation') + call CNNFixation( num_soilc, filter_soilc, waterflux_vars, & + carbonflux_vars, nitrogenflux_vars) + call t_stopf('CNFixation') + + call t_startf('CNMResp') + if (crop_prog) then + call CNNFert(bounds, num_soilc,filter_soilc, & + nitrogenflux_vars) + + call CNSoyfix(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + waterstate_vars, crop_vars, cnstate_vars, & + nitrogenstate_vars, nitrogenflux_vars) + end if + + call CNMResp(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + canopystate_vars, soilstate_vars, temperature_vars, photosyns_vars, & + carbonflux_vars, nitrogenstate_vars) + + call t_stopf('CNMResp') + + !calculate vertical profiles to destribute various variables, this could also pet put outside this block of codes + call decomp_vertprofiles(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + soilstate_vars, canopystate_vars, cnstate_vars) + + call calc_plant_nutrient_demand(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + photosyns_vars, crop_vars, canopystate_vars, & + cnstate_vars, carbonstate_vars, carbonflux_vars, & + c13_carbonflux_vars, c14_carbonflux_vars, & + nitrogenstate_vars, nitrogenflux_vars, plantsoilnutrientflux_vars ) + + call calc_fpg(bounds, num_soilc, filter_soilc, & + plantsoilnutrientflux_vars%plant_totn_demand_flx_col(bounds%begc:bounds%endc), & + nitrogenstate_vars%plant_nbuffer_col(bounds%begc:bounds%endc), & + cnstate_vars%fpg_col(bounds%begc:bounds%endc)) + + call plantCNAlloc(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + photosyns_vars, cnstate_vars, carbonstate_vars, carbonflux_vars, & + c13_carbonflux_vars, c14_carbonflux_vars, nitrogenstate_vars, nitrogenflux_vars) + + !-------------------------------------------- + ! Phenology + !-------------------------------------------- + + ! CNphenology needs to be called after CNdecompAlloc, because it + ! depends on current time-step fluxes to new growth on the last + ! litterfall timestep in deciduous systems + + call t_startf('CNPhenology') + call CNPhenology(num_soilc, filter_soilc, num_soilp, filter_soilp, & + num_pcropp, filter_pcropp, doalb, & + waterstate_vars, temperature_vars, crop_vars, canopystate_vars, soilstate_vars, & + dgvs_vars, cnstate_vars, carbonstate_vars, carbonflux_vars, & + nitrogenstate_vars, nitrogenflux_vars, & + phosphorusstate_vars, phosphorusflux_vars) + call t_stopf('CNPhenology') + + !-------------------------------------------- + ! Growth respiration + !-------------------------------------------- + + call t_startf('CNGResp') + call CNGResp(num_soilp, filter_soilp, & + carbonflux_vars) + + call carbonflux_vars%summary_rr(bounds,num_soilp, filter_soilp, num_soilc, filter_soilc) + call t_stopf('CNGResp') + + !-------------------------------------------- + ! CNUpdate0 + !-------------------------------------------- + + call t_startf('CNUpdate0') + call CStateUpdate0(& + num_soilp, filter_soilp, & + carbonflux_vars, carbonstate_vars) + + if ( use_c13 ) then + call CStateUpdate0(& + num_soilp, filter_soilp, & + c13_carbonflux_vars, c13_carbonstate_vars) + end if + + if ( use_c14 ) then + call CStateUpdate0(& + num_soilp, filter_soilp, & + c14_carbonflux_vars, c14_carbonstate_vars) + end if + call t_stopf('CNUpdate0') + + !-------------------------------------------- + ! Update1 + !-------------------------------------------- + + call t_startf('CNUpdate1') + + if ( use_c13 ) then + call CIsoFlux1(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnstate_vars, carbonflux_vars, carbonstate_vars, & + isotopeflux_vars=c13_carbonflux_vars, isotopestate_vars=c13_carbonstate_vars, & + isotope='c13') + end if + + if ( use_c14 ) then + call CIsoFlux1(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnstate_vars, carbonflux_vars, carbonstate_vars, & + isotopeflux_vars=c14_carbonflux_vars, isotopestate_vars=c14_carbonstate_vars, & + isotope='c14') + end if + + call CStateUpdate1(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnstate_vars, carbonflux_vars, carbonstate_vars) + + if ( use_c13 ) then + call CStateUpdate1(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnstate_vars, c13_carbonflux_vars, c13_carbonstate_vars) + end if + + if ( use_c14 ) then + call CStateUpdate1(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnstate_vars, c14_carbonflux_vars, c14_carbonstate_vars) + end if + + call NStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnstate_vars, nitrogenflux_vars, nitrogenstate_vars) + call t_stopf('CNUpdate1') + + call t_startf('CNGapMortality') + call CNGapMortality( num_soilc, filter_soilc, num_soilp, filter_soilp, & + dgvs_vars, cnstate_vars, & + carbonstate_vars, nitrogenstate_vars, carbonflux_vars, nitrogenflux_vars, & + phosphorusstate_vars, phosphorusflux_vars) + call t_stopf('CNGapMortality') + + !-------------------------------------------- + ! Update2 + !-------------------------------------------- + + call t_startf('CNUpdate2') + + if ( use_c13 ) then + call CIsoFlux2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnstate_vars, carbonflux_vars, carbonstate_vars, & + isotopeflux_vars=c13_carbonflux_vars, isotopestate_vars=c13_carbonstate_vars, & + isotope='c13') + end if + + if ( use_c14 ) then + call CIsoFlux2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnstate_vars, carbonflux_vars, carbonstate_vars, & + isotopeflux_vars=c14_carbonflux_vars, isotopestate_vars=c14_carbonstate_vars, & + isotope='c14') + end if + + call CStateUpdate2( num_soilc, filter_soilc, num_soilp, filter_soilp, & + carbonflux_vars, carbonstate_vars) + + if ( use_c13 ) then + call CStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + c13_carbonflux_vars, c13_carbonstate_vars) + end if + + if ( use_c14 ) then + call CStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + c14_carbonflux_vars, c14_carbonstate_vars) + end if + + call NStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & + nitrogenflux_vars, nitrogenstate_vars) + + if (flanduse_timeseries /= ' ') then + call CNHarvest(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnstate_vars, carbonstate_vars, nitrogenstate_vars, & + carbonflux_vars, nitrogenflux_vars) + end if + + if ( use_c13 ) then + call CIsoFlux2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnstate_vars, carbonflux_vars, carbonstate_vars, & + isotopeflux_vars=c13_carbonflux_vars, & + isotopestate_vars=c13_carbonstate_vars, & + isotope='c13') + end if + + if ( use_c14 ) then + call CIsoFlux2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnstate_vars, carbonflux_vars, carbonstate_vars, & + isotopeflux_vars=c14_carbonflux_vars, & + isotopestate_vars=c14_carbonstate_vars, & + isotope='c14') + end if + + call CStateUpdate2h( num_soilc, filter_soilc, num_soilp, filter_soilp, & + carbonflux_vars, carbonstate_vars) + + if ( use_c13 ) then + call CStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + c13_carbonflux_vars, c13_carbonstate_vars) + end if + if ( use_c14 ) then + call CStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + c14_carbonflux_vars, c14_carbonstate_vars) + end if + + call NStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & + nitrogenflux_vars, nitrogenstate_vars) + + call CNWoodProducts(num_soilc, filter_soilc, & + carbonstate_vars, c13_carbonstate_vars, c14_carbonstate_vars, nitrogenstate_vars, & + carbonflux_vars, c13_carbonflux_vars, c14_carbonflux_vars, nitrogenflux_vars, & + phosphorusstate_vars, phosphorusflux_vars) + + call CNFireArea(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & + atm2lnd_vars, temperature_vars, energyflux_vars, soilhydrology_vars, waterstate_vars, & + cnstate_vars, carbonstate_vars) + + call CNFireFluxes(num_soilc, filter_soilc, num_soilp, filter_soilp, & + dgvs_vars, cnstate_vars, carbonstate_vars, nitrogenstate_vars, & + carbonflux_vars, nitrogenflux_vars) + + call t_stopf('CNUpdate2') + + !-------------------------------------------- + ! Update3 + !-------------------------------------------- + + if ( use_c13 ) then + call CIsoFlux3(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnstate_vars, carbonflux_vars, carbonstate_vars, & + isotopeflux_vars=c13_carbonflux_vars, isotopestate_vars=c13_carbonstate_vars, & + isotope='c13') + end if + if ( use_c14 ) then + call CIsoFlux3(num_soilc, filter_soilc, num_soilp, filter_soilp, & + cnstate_vars, carbonflux_vars, carbonstate_vars, & + isotopeflux_vars=c14_carbonflux_vars, isotopestate_vars=c14_carbonstate_vars, & + isotope='c14') + end if + + call CStateUpdate3( num_soilc, filter_soilc, num_soilp, filter_soilp, & + carbonflux_vars, carbonstate_vars) + + if ( use_c13 ) then + call CStateUpdate3( num_soilc, filter_soilc, num_soilp, filter_soilp, & + c13_carbonflux_vars, c13_carbonstate_vars) + end if + + if ( use_c14 ) then + call CStateUpdate3( num_soilc, filter_soilc, num_soilp, filter_soilp, & + c14_carbonflux_vars, c14_carbonstate_vars) + end if + + + if ( use_c14 ) then + call C14Decay(num_soilc, filter_soilc, num_soilp, filter_soilp, & + c14_carbonstate_vars) + + call C14BombSpike(num_soilp, filter_soilp, & + cnstate_vars) + end if + + + call t_startf('CNUpdate3') + + call NStateUpdate3(num_soilc, filter_soilc, num_soilp, filter_soilp, & + nitrogenflux_vars, nitrogenstate_vars) + call t_stopf('CNUpdate3') + + end subroutine CNEcosystemDynBetrVeg + + + !------------------------------------------------------------------------------- + subroutine CNEcosystemDynBetrSummary(bounds, & + num_soilc, filter_soilc, & + num_soilp, filter_soilp, num_pcropp, filter_pcropp, doalb, & + cnstate_vars, carbonflux_vars, carbonstate_vars, & + c13_carbonflux_vars, c13_carbonstate_vars, & + c14_carbonflux_vars, c14_carbonstate_vars, & + nitrogenflux_vars, nitrogenstate_vars, & + atm2lnd_vars, waterstate_vars, waterflux_vars, & + canopystate_vars, soilstate_vars, temperature_vars, crop_vars, & + dgvs_vars, photosyns_vars, soilhydrology_vars, energyflux_vars, & + plantsoilnutrientflux_vars, phosphorusstate_vars) + ! + ! this goes after leaching is done + ! !USES: + use CNNDynamicsMod , only: CNNDeposition,CNNFixation, CNNFert, CNSoyfix + use CNMRespMod , only: CNMResp + use CNDecompMod , only: CNDecompAlloc + use CNPhenologyMod , only: CNPhenology + use CNGRespMod , only: CNGResp + use CNCStateUpdate1Mod , only: CStateUpdate1,CStateUpdate0 + use CNNStateUpdate1Mod , only: NStateUpdate1 + use CNGapMortalityMod , only: CNGapMortality + use CNCStateUpdate2Mod , only: CStateUpdate2, CStateUpdate2h + use CNNStateUpdate2Mod , only: NStateUpdate2, NStateUpdate2h + use CNFireMod , only: CNFireArea, CNFireFluxes + use CNCStateUpdate3Mod , only: CStateUpdate3 + use CNCIsoFluxMod , only: CIsoFlux1, CIsoFlux2, CIsoFlux2h, CIsoFlux3 + use CNC14DecayMod , only: C14Decay, C14BombSpike + use CNWoodProductsMod , only: CNWoodProducts + use CNDecompCascadeBGCMod , only: decomp_rate_constants_bgc + use CNDecompCascadeCNMod , only: decomp_rate_constants_cn + use CropType , only: crop_type + use dynHarvestMod , only: CNHarvest + use clm_varpar , only: crop_prog + use PlantSoilnutrientFluxType , only: plantsoilnutrientflux_type + use CNPrecisionControlMod , only: CNPrecisionControl + implicit none + ! + ! !ARGUMENTS: + 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_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + integer , intent(in) :: num_pcropp ! number of prog. crop patches in filter + integer , intent(in) :: filter_pcropp(:) ! filter for prognostic crop patches + logical , intent(in) :: doalb ! true = surface albedo calculation time step + type(cnstate_type) , intent(inout) :: cnstate_vars + type(carbonflux_type) , intent(inout) :: carbonflux_vars + type(carbonstate_type) , intent(inout) :: carbonstate_vars + type(carbonflux_type) , intent(inout) :: c13_carbonflux_vars + type(carbonstate_type) , intent(inout) :: c13_carbonstate_vars + type(carbonflux_type) , intent(inout) :: c14_carbonflux_vars + type(carbonstate_type) , intent(inout) :: c14_carbonstate_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars + type(atm2lnd_type) , intent(in) :: atm2lnd_vars + type(waterstate_type) , intent(in) :: waterstate_vars + type(waterflux_type) , intent(in) :: waterflux_vars + type(canopystate_type) , intent(in) :: canopystate_vars + type(soilstate_type) , intent(in) :: soilstate_vars + type(temperature_type) , intent(inout) :: temperature_vars + type(crop_type) , intent(in) :: crop_vars + type(dgvs_type) , intent(inout) :: dgvs_vars + type(photosyns_type) , intent(in) :: photosyns_vars + type(soilhydrology_type) , intent(in) :: soilhydrology_vars + type(energyflux_type) , intent(in) :: energyflux_vars + type(plantsoilnutrientflux_type) , intent(in) :: plantsoilnutrientflux_vars + type(phosphorusstate_type) , intent(inout) :: phosphorusstate_vars + + call nitrogenstate_vars%nbuffer_update(bounds, num_soilc, filter_soilc, & + plantsoilnutrientflux_vars%plant_minn_active_yield_flx_col(bounds%begc:bounds%endc), & + plantsoilnutrientflux_vars%plant_minn_passive_yield_flx_col(bounds%begc:bounds%endc)) + + call t_startf('CNsum') + call CNPrecisionControl(num_soilc, filter_soilc, num_soilp, filter_soilp, & + carbonstate_vars, c13_carbonstate_vars, c14_carbonstate_vars, nitrogenstate_vars, & + phosphorusstate_vars) + + end subroutine CNEcosystemDynBetrSummary + + !----------------------------------------------------------------------- + subroutine CNFluxStateBetrSummary(bounds, num_soilc, filter_soilc, & + num_soilp, filter_soilp, & + carbonflux_vars, carbonstate_vars, & + c13_carbonflux_vars, c13_carbonstate_vars, & + c14_carbonflux_vars, c14_carbonstate_vars, & + nitrogenflux_vars, nitrogenstate_vars, & + betrtracer_vars, tracerflux_vars, tracerstate_vars) + ! + ! DESCRIPTION + ! summarize all fluxes and state varaibles, prepare for mass balance analysis + ! + implicit none + 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_soilp ! number of soil patches in filter + integer , intent(in) :: filter_soilp(:) ! filter for soil patches + type(carbonflux_type) , intent(inout) :: carbonflux_vars ! + type(carbonstate_type) , intent(inout) :: carbonstate_vars ! + type(carbonflux_type) , intent(inout) :: c13_carbonflux_vars ! + type(carbonstate_type) , intent(inout) :: c13_carbonstate_vars ! + type(carbonflux_type) , intent(inout) :: c14_carbonflux_vars ! + type(carbonstate_type) , intent(inout) :: c14_carbonstate_vars ! + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars ! + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars ! + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(tracerstate_type) , intent(in) :: tracerstate_vars ! + type(tracerflux_type) , intent(in) :: tracerflux_vars ! + + call carbonflux_vars%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, 'bulk') + + call carbonstate_vars%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp) + if ( use_c13 ) then + call c13_carbonflux_vars%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, 'c13') + + call c13_carbonstate_vars%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp) + end if + + if ( use_c14 ) then + call c14_carbonflux_vars%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, 'c14') + call c14_carbonstate_vars%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp) + end if + call nitrogenflux_vars%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp) + call nitrogenstate_vars%Summary(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp) + + call t_stopf('CNsum') + + end subroutine CNFluxStateBetrSummary + + !----------------------------------------------------------------------- + subroutine calc_fpg(bounds, num_soilc, filter_soilc, plant_totn_demand_flx, plant_nbuffer, fpg) + ! + ! DESCRIPTION + ! calculate gpp downregulation factor + use PlantSoilnutrientFluxType, only : plantsoilnutrientflux_type + use clm_time_manager , only : get_step_size + implicit none + 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 + real(r8) , intent(inout) :: plant_totn_demand_flx(bounds%begc:bounds%endc) ! + real(r8) , intent(inout) :: plant_nbuffer(bounds%begc:bounds%endc) ! + real(r8) , intent(inout) :: fpg(bounds%begc:bounds%endc) ! + + integer :: fc, c + real(r8) :: dtime + + dtime = get_step_size() + + do fc=1,num_soilc + c = filter_soilc(fc) + ! calculate the fraction of potential growth that can be + ! acheived with the N available to plants + ! now a silly question here is does plant take more than necessary? + if (plant_totn_demand_flx(c) > 0.0_r8) then + fpg(c) = min(plant_nbuffer(c) / (plant_totn_demand_flx(c)*dtime),1._r8) + if(fpg(c)<1._r8)then + plant_nbuffer(c) = 0._r8 + else + plant_nbuffer(c) = plant_nbuffer(c)-plant_totn_demand_flx(c)*dtime + endif + !plant_totn_demand_flx(c) = plant_totn_demand_flx(c)* (1._r8-fpg(c)) + else + fpg(c) = 1.0_r8 + end if + enddo + end subroutine calc_fpg + +end module CNEcosystemDynBetrMod diff --git a/components/clm/src/biogeochem/CNEcosystemDynMod.F90 b/components/clm/src/biogeochem/CNEcosystemDynMod.F90 index 6a815d8f566c..ef0e6bce2307 100644 --- a/components/clm/src/biogeochem/CNEcosystemDynMod.F90 +++ b/components/clm/src/biogeochem/CNEcosystemDynMod.F90 @@ -356,7 +356,7 @@ subroutine CNEcosystemDynNoLeaching1(bounds, & call t_stopf('CNDeposition') call t_startf('CNFixation') - call CNNFixation( num_soilc, filter_soilc, & + call CNNFixation( num_soilc, filter_soilc, waterflux_vars, & carbonflux_vars, nitrogenflux_vars) call t_stopf('CNFixation') @@ -557,7 +557,7 @@ subroutine CNEcosystemDynNoLeaching2(bounds, & call CNGResp(num_soilp, filter_soilp, & carbonflux_vars) call t_stopf('CNGResp') - + call carbonflux_vars%summary_rr(bounds, num_soilp, filter_soilp, num_soilc, filter_soilc) !-------------------------------------------- ! Dynamic Roots !-------------------------------------------- @@ -613,15 +613,15 @@ subroutine CNEcosystemDynNoLeaching2(bounds, & isotope='c14') end if - call CStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CStateUpdate1(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & cnstate_vars, carbonflux_vars, carbonstate_vars) if ( use_c13 ) then - call CStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CStateUpdate1(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & cnstate_vars, c13_carbonflux_vars, c13_carbonstate_vars) end if if ( use_c14 ) then - call CStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & + call CStateUpdate1(bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & cnstate_vars, c14_carbonflux_vars, c14_carbonstate_vars) end if @@ -782,6 +782,5 @@ subroutine CNEcosystemDynNoLeaching2(bounds, & end if !end of if not use_ed block end subroutine CNEcosystemDynNoLeaching2 -!!------------------------------------------------------------------------------------------------- end module CNEcosystemDynMod diff --git a/components/clm/src/biogeochem/CNGapMortalityMod.F90 b/components/clm/src/biogeochem/CNGapMortalityMod.F90 index ffc839136090..b4f07a09d899 100644 --- a/components/clm/src/biogeochem/CNGapMortalityMod.F90 +++ b/components/clm/src/biogeochem/CNGapMortalityMod.F90 @@ -430,7 +430,6 @@ subroutine CNGapPftToColumn ( & (m_livestemc_to_litter(p) + m_deadstemc_to_litter(p)) * wtcol(p) * stem_prof(p,j) gap_mortality_c_to_cwdc(c,j) = gap_mortality_c_to_cwdc(c,j) + & (m_livecrootc_to_litter(p) + m_deadcrootc_to_litter(p)) * wtcol(p) * croot_prof(p,j) - ! storage gap mortality carbon fluxes gap_mortality_c_to_litr_met_c(c,j) = gap_mortality_c_to_litr_met_c(c,j) + & (m_leafc_storage_to_litter(p) + m_gresp_storage_to_litter(p)) * wtcol(p) * leaf_prof(p,j) diff --git a/components/clm/src/biogeochem/CNNDynamicsMod.F90 b/components/clm/src/biogeochem/CNNDynamicsMod.F90 index 0d0def8a0a61..f5da4af27143 100644 --- a/components/clm/src/biogeochem/CNNDynamicsMod.F90 +++ b/components/clm/src/biogeochem/CNNDynamicsMod.F90 @@ -141,7 +141,7 @@ subroutine CNNDeposition( bounds, & end subroutine CNNDeposition !----------------------------------------------------------------------- - subroutine CNNFixation(num_soilc, filter_soilc, & + subroutine CNNFixation(num_soilc, filter_soilc, waterflux_vars, & carbonflux_vars, nitrogenflux_vars) ! ! !DESCRIPTION: @@ -157,6 +157,7 @@ subroutine CNNFixation(num_soilc, filter_soilc, & ! !ARGUMENTS: integer , intent(in) :: num_soilc ! number of soil columns in filter integer , intent(in) :: filter_soilc(:) ! filter for soil columns + type(waterflux_type) , intent(in) :: waterflux_vars type(carbonflux_type) , intent(inout) :: carbonflux_vars type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars ! @@ -164,39 +165,54 @@ subroutine CNNFixation(num_soilc, filter_soilc, & integer :: c,fc ! indices real(r8) :: t ! temporary real(r8) :: dayspyr ! days per year + real(r8) :: secspyr ! seconds per yr + logical :: do_et_bnf = .false. !----------------------------------------------------------------------- associate(& cannsum_npp => carbonflux_vars%annsum_npp_col , & ! Input: [real(r8) (:)] nitrogen deposition rate (gN/m2/s) col_lag_npp => carbonflux_vars%lag_npp_col , & ! Input: [real(r8) (:)] (gC/m2/s) lagged net primary production + qflx_tran_veg => waterflux_vars%qflx_tran_veg_col , & ! col vegetation transpiration (mm H2O/s) (+ = to atm) + + qflx_evap_veg => waterflux_vars%qflx_evap_veg_col , & ! col vegetation evaporation (mm H2O/s) (+ = to atm) nfix_to_sminn => nitrogenflux_vars%nfix_to_sminn_col & ! Output: [real(r8) (:)] symbiotic/asymbiotic N fixation to soil mineral N (gN/m2/s) ) dayspyr = get_days_per_year() - if ( nfix_timeconst > 0._r8 .and. nfix_timeconst < 500._r8 ) then - ! use exponential relaxation with time constant nfix_timeconst for NPP - NFIX relation - ! Loop through columns - do fc = 1,num_soilc - c = filter_soilc(fc) - - if (col_lag_npp(c) /= spval) then - ! need to put npp in units of gC/m^2/year here first - t = (1.8_r8 * (1._r8 - exp(-0.003_r8 * col_lag_npp(c)*(secspday * dayspyr))))/(secspday * dayspyr) - nfix_to_sminn(c) = max(0._r8,t) - else - nfix_to_sminn(c) = 0._r8 - endif - end do + if (do_et_bnf) then + secspyr = dayspyr * 86400._r8 + do fc = 1, num_soilc + c =filter_soilc(fc) + !use the cleveland equation + t = 0.00102_r8*(qflx_evap_veg(c)+qflx_tran_veg(c))+0.0524_r8/secspyr + nfix_to_sminn(c) = max(0._r8, t) + enddo else - ! use annual-mean values for NPP-NFIX relation - do fc = 1,num_soilc - c = filter_soilc(fc) - - t = (1.8_r8 * (1._r8 - exp(-0.003_r8 * cannsum_npp(c))))/(secspday * dayspyr) - nfix_to_sminn(c) = max(0._r8,t) - end do + if ( nfix_timeconst > 0._r8 .and. nfix_timeconst < 500._r8 ) then + ! use exponential relaxation with time constant nfix_timeconst for NPP - NFIX relation + ! Loop through columns + do fc = 1,num_soilc + c = filter_soilc(fc) + + if (col_lag_npp(c) /= spval) then + ! need to put npp in units of gC/m^2/year here first + t = (1.8_r8 * (1._r8 - exp(-0.003_r8 * col_lag_npp(c)*(secspday * dayspyr))))/(secspday * dayspyr) + nfix_to_sminn(c) = max(0._r8,t) + else + nfix_to_sminn(c) = 0._r8 + endif + end do + else + ! use annual-mean values for NPP-NFIX relation + do fc = 1,num_soilc + c = filter_soilc(fc) + + t = (1.8_r8 * (1._r8 - exp(-0.003_r8 * cannsum_npp(c))))/(secspday * dayspyr) + nfix_to_sminn(c) = max(0._r8,t) + end do + endif endif end associate diff --git a/components/clm/src/biogeochem/CNNStateUpdate1Mod.F90 b/components/clm/src/biogeochem/CNNStateUpdate1Mod.F90 index 5b54f6947ef3..c738cedb5613 100644 --- a/components/clm/src/biogeochem/CNNStateUpdate1Mod.F90 +++ b/components/clm/src/biogeochem/CNNStateUpdate1Mod.F90 @@ -38,6 +38,7 @@ subroutine NStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & ! On the radiation time step, update all the prognostic nitrogen state ! variables (except for gap-phase mortality and fire fluxes) ! + use tracer_varcon, only : is_active_betr_bgc ! !ARGUMENTS: integer , intent(in) :: num_soilc ! number of soil columns in filter integer , intent(in) :: filter_soilc(:) ! filter for soil columns @@ -51,6 +52,7 @@ subroutine NStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & integer :: c,p,j,l,k ! indices integer :: fp,fc ! lake filter indices real(r8):: dt ! radiation time step (seconds) + real(r8), parameter :: frootc_nfix_thc = 10._r8 !threshold fine root carbon for nitrogen fixation gC/m2 !----------------------------------------------------------------------- associate( & @@ -80,200 +82,244 @@ subroutine NStateUpdate1(num_soilc, filter_soilc, num_soilp, filter_soilp, & ns%seedn_col(c) = ns%seedn_col(c) - nf%dwt_seedn_to_deadstem_col(c) * dt end do - !------------------------------------------------------------------ - ! if coupled with pflotran, the following updates are NOT needed - if (.not.(use_pflotran .and. pf_cmode)) then - !------------------------------------------------------------------ - - do j = 1, nlevdecomp - do fc = 1,num_soilc + if (is_active_betr_bgc) then + !summarize Organic N input and mineral nitrogen input from litter, deposition, fixation and fertilization + do fc = 1, num_soilc c = filter_soilc(fc) + ns%plant_nbuffer_col(c) = ns%plant_nbuffer_col(c) + nf%nfix_to_sminn_col(c)*dt * exp(-cnstate_vars%frootc_nfix_scalar_col(c)/frootc_nfix_thc) + enddo - if (.not. use_nitrif_denitrif) then - - ! N deposition and fixation - ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) + nf%ndep_to_sminn_col(c)*dt * ndep_prof(c,j) - ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) + nf%nfix_to_sminn_col(c)*dt * nfixation_prof(c,j) - - else - + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) ! N deposition and fixation (put all into NH4 pool) - ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) + nf%ndep_to_sminn_col(c)*dt * ndep_prof(c,j) - ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) + nf%nfix_to_sminn_col(c)*dt * nfixation_prof(c,j) - - end if - - ! plant to litter fluxes - ! phenology and dynamic landcover fluxes - nf%decomp_npools_sourcesink_col(c,j,i_met_lit) = & - ( nf%phenology_n_to_litr_met_n_col(c,j) + nf%dwt_frootn_to_litr_met_n_col(c,j) ) * dt - - nf%decomp_npools_sourcesink_col(c,j,i_cel_lit) = & - ( nf%phenology_n_to_litr_cel_n_col(c,j) + nf%dwt_frootn_to_litr_cel_n_col(c,j) ) * dt - - nf%decomp_npools_sourcesink_col(c,j,i_lig_lit) = & - ( nf%phenology_n_to_litr_lig_n_col(c,j) + nf%dwt_frootn_to_litr_lig_n_col(c,j) ) * dt - - nf%decomp_npools_sourcesink_col(c,j,i_cwd) = & - ( nf%dwt_livecrootn_to_cwdn_col(c,j) + nf%dwt_deadcrootn_to_cwdn_col(c,j) ) * dt - - end do - end do + nf%sminn_nh4_input_vr_col(c,j) = nf%sminn_nh4_input_vr_col(c,j) + nf%ndep_to_sminn_col(c)*dt * ndep_prof(c,j) + !now a fraction of fixed nitrogen is first added to plant nitrogen pool + nf%sminn_nh4_input_vr_col(c,j) = nf%sminn_nh4_input_vr_col(c,j) + nf%nfix_to_sminn_col(c)*dt * nfixation_prof(c,j) * (1._r8-exp(-cnstate_vars%frootc_nfix_scalar_col(c)/frootc_nfix_thc)) + + ! plant to litter fluxes + ! phenology and dynamic landcover fluxes + nf%bgc_npool_ext_inputs_vr_col(c,j,i_met_lit) = nf%bgc_npool_ext_inputs_vr_col(c,j,i_met_lit) + & + ( nf%phenology_n_to_litr_met_n_col(c,j) + nf%dwt_frootn_to_litr_met_n_col(c,j) ) * dt + + nf%bgc_npool_ext_inputs_vr_col(c,j,i_cel_lit) = nf%bgc_npool_ext_inputs_vr_col(c,j,i_cel_lit) + & + ( nf%phenology_n_to_litr_cel_n_col(c,j) + nf%dwt_frootn_to_litr_cel_n_col(c,j) ) * dt + + nf%bgc_npool_ext_inputs_vr_col(c,j,i_lig_lit) = nf%bgc_npool_ext_inputs_vr_col(c,j,i_lig_lit) + & + ( nf%phenology_n_to_litr_lig_n_col(c,j) + nf%dwt_frootn_to_litr_lig_n_col(c,j) ) * dt + + nf%bgc_npool_ext_inputs_vr_col(c,j,i_cwd) = nf%bgc_npool_ext_inputs_vr_col(c,j,i_cwd) + & + ( nf%dwt_livecrootn_to_cwdn_col(c,j) + nf%dwt_deadcrootn_to_cwdn_col(c,j) ) * dt + enddo + enddo + + ! repeating N dep and fixation for crops + if ( crop_prog )then + do j = 1, nlevdecomp + + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! N deposition and fixation (put all into NH4 pool) + nf%sminn_nh4_input_vr_col(c,j) = nf%sminn_nh4_input_vr_col(c,j) + nf%fert_to_sminn_col(c)*dt * ndep_prof(c,j) + nf%sminn_nh4_input_vr_col(c,j) = nf%sminn_nh4_input_vr_col(c,j) + nf%soyfixn_to_sminn_col(c)*dt * nfixation_prof(c,j) + nf%sminn_nh4_input_vr_col(c,j) = nf%sminn_nh4_input_vr_col(c,j) + nf%supplement_to_sminn_vr_col(c,j)*dt + end do + end do + end if + + elseif (.not.(use_pflotran .and. pf_cmode)) then - ! repeating N dep and fixation for crops - if ( crop_prog )then do j = 1, nlevdecomp - - ! column loop do fc = 1,num_soilc c = filter_soilc(fc) + if (.not. use_nitrif_denitrif) then - + ! N deposition and fixation - ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) + nf%fert_to_sminn_col(c)*dt * ndep_prof(c,j) - ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) + nf%soyfixn_to_sminn_col(c)*dt * nfixation_prof(c,j) + ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) + nf%ndep_to_sminn_col(c)*dt * ndep_prof(c,j) + ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) + nf%nfix_to_sminn_col(c)*dt * nfixation_prof(c,j) + else ! N deposition and fixation (put all into NH4 pool) - ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) + nf%fert_to_sminn_col(c)*dt * ndep_prof(c,j) - ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) + nf%soyfixn_to_sminn_col(c)*dt * nfixation_prof(c,j) - + ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) + nf%ndep_to_sminn_col(c)*dt * ndep_prof(c,j) + ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) + nf%nfix_to_sminn_col(c)*dt * nfixation_prof(c,j) + end if - end do - end do - end if - - ! decomposition fluxes - do k = 1, ndecomp_cascade_transitions - do j = 1, nlevdecomp - ! column loop - do fc = 1,num_soilc - c = filter_soilc(fc) - nf%decomp_npools_sourcesink_col(c,j,cascade_donor_pool(k)) = & - nf%decomp_npools_sourcesink_col(c,j,cascade_donor_pool(k)) - & - nf%decomp_cascade_ntransfer_vr_col(c,j,k) * dt + ! plant to litter fluxes + ! phenology and dynamic landcover fluxes + nf%decomp_npools_sourcesink_col(c,j,i_met_lit) = & + ( nf%phenology_n_to_litr_met_n_col(c,j) + nf%dwt_frootn_to_litr_met_n_col(c,j) ) * dt + + nf%decomp_npools_sourcesink_col(c,j,i_cel_lit) = & + ( nf%phenology_n_to_litr_cel_n_col(c,j) + nf%dwt_frootn_to_litr_cel_n_col(c,j) ) * dt + + nf%decomp_npools_sourcesink_col(c,j,i_lig_lit) = & + ( nf%phenology_n_to_litr_lig_n_col(c,j) + nf%dwt_frootn_to_litr_lig_n_col(c,j) ) * dt + + nf%decomp_npools_sourcesink_col(c,j,i_cwd) = & + ( nf%dwt_livecrootn_to_cwdn_col(c,j) + nf%dwt_deadcrootn_to_cwdn_col(c,j) ) * dt + end do end do - end do - do k = 1, ndecomp_cascade_transitions - if ( cascade_receiver_pool(k) /= 0 ) then ! skip terminal transitions + + ! repeating N dep and fixation for crops + if ( crop_prog )then do j = 1, nlevdecomp + ! column loop do fc = 1,num_soilc c = filter_soilc(fc) - - nf%decomp_npools_sourcesink_col(c,j,cascade_receiver_pool(k)) = & - nf%decomp_npools_sourcesink_col(c,j,cascade_receiver_pool(k)) + & - (nf%decomp_cascade_ntransfer_vr_col(c,j,k) + nf%decomp_cascade_sminn_flux_vr_col(c,j,k)) * dt + if (.not. use_nitrif_denitrif) then + + ! N deposition and fixation + ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) + nf%fert_to_sminn_col(c)*dt * ndep_prof(c,j) + ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) + nf%soyfixn_to_sminn_col(c)*dt * nfixation_prof(c,j) + else + + ! N deposition and fixation (put all into NH4 pool) + ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) + nf%fert_to_sminn_col(c)*dt * ndep_prof(c,j) + ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) + nf%soyfixn_to_sminn_col(c)*dt * nfixation_prof(c,j) + + end if end do end do - else ! terminal transitions + end if + + ! decomposition fluxes + do k = 1, ndecomp_cascade_transitions do j = 1, nlevdecomp ! column loop do fc = 1,num_soilc c = filter_soilc(fc) + nf%decomp_npools_sourcesink_col(c,j,cascade_donor_pool(k)) = & nf%decomp_npools_sourcesink_col(c,j,cascade_donor_pool(k)) - & - nf%decomp_cascade_sminn_flux_vr_col(c,j,k) * dt + nf%decomp_cascade_ntransfer_vr_col(c,j,k) * dt end do end do - end if - end do - - if (.not. use_nitrif_denitrif) then - - !-------------------------------------------------------- - !------------- NITRIF_DENITRIF OFF ------------------- - !-------------------------------------------------------- + end do - ! immobilization/mineralization in litter-to-SOM and SOM-to-SOM fluxes and denitrification fluxes do k = 1, ndecomp_cascade_transitions if ( cascade_receiver_pool(k) /= 0 ) then ! skip terminal transitions do j = 1, nlevdecomp ! column loop do fc = 1,num_soilc c = filter_soilc(fc) - ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) - & - (nf%sminn_to_denit_decomp_cascade_vr_col(c,j,k) + nf%decomp_cascade_sminn_flux_vr_col(c,j,k))* dt + + nf%decomp_npools_sourcesink_col(c,j,cascade_receiver_pool(k)) = & + nf%decomp_npools_sourcesink_col(c,j,cascade_receiver_pool(k)) + & + (nf%decomp_cascade_ntransfer_vr_col(c,j,k) + nf%decomp_cascade_sminn_flux_vr_col(c,j,k)) * dt end do end do - else + else ! terminal transitions do j = 1, nlevdecomp ! column loop do fc = 1,num_soilc c = filter_soilc(fc) - ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) - nf%sminn_to_denit_decomp_cascade_vr_col(c,j,k)* dt - - ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) + nf%decomp_cascade_sminn_flux_vr_col(c,j,k)* dt - + nf%decomp_npools_sourcesink_col(c,j,cascade_donor_pool(k)) = & + nf%decomp_npools_sourcesink_col(c,j,cascade_donor_pool(k)) - & + nf%decomp_cascade_sminn_flux_vr_col(c,j,k) * dt end do end do - endif + end if end do - - do j = 1, nlevdecomp - ! column loop - do fc = 1,num_soilc - c = filter_soilc(fc) - ! "bulk denitrification" - ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) - nf%sminn_to_denit_excess_vr_col(c,j) * dt - - ! total plant uptake from mineral N - ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) - nf%sminn_to_plant_vr_col(c,j)*dt - - ! flux that prevents N limitation (when Carbon_only is set) - ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) + nf%supplement_to_sminn_vr_col(c,j)*dt + + if (.not. use_nitrif_denitrif) then + + !-------------------------------------------------------- + !------------- NITRIF_DENITRIF OFF ------------------- + !-------------------------------------------------------- + + ! immobilization/mineralization in litter-to-SOM and SOM-to-SOM fluxes and denitrification fluxes + do k = 1, ndecomp_cascade_transitions + if ( cascade_receiver_pool(k) /= 0 ) then ! skip terminal transitions + do j = 1, nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) - & + (nf%sminn_to_denit_decomp_cascade_vr_col(c,j,k) + nf%decomp_cascade_sminn_flux_vr_col(c,j,k))* dt + end do + end do + else + do j = 1, nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) - nf%sminn_to_denit_decomp_cascade_vr_col(c,j,k)* dt + + ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) + nf%decomp_cascade_sminn_flux_vr_col(c,j,k)* dt + + end do + end do + endif end do - end do - - else - - !-------------------------------------------------------- - !------------- NITRIF_DENITRIF ON -------------------- - !-------------------------------------------------------- - - do j = 1, nlevdecomp - ! column loop - do fc = 1,num_soilc - c = filter_soilc(fc) - - ! mineralization fluxes (divert a fraction of this stream to nitrification flux, add the rest to NH4 pool) - ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) + nf%gross_nmin_vr_col(c,j)*dt - - ! immobilization fluxes - ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) - nf%actual_immob_nh4_vr_col(c,j)*dt - - ns%smin_no3_vr_col(c,j) = ns%smin_no3_vr_col(c,j) - nf%actual_immob_no3_vr_col(c,j)*dt - - ! plant uptake fluxes - ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) - nf%smin_nh4_to_plant_vr_col(c,j)*dt - - ns%smin_no3_vr_col(c,j) = ns%smin_no3_vr_col(c,j) - nf%smin_no3_to_plant_vr_col(c,j)*dt - - ! Account for nitrification fluxes - ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) - nf%f_nit_vr_col(c,j) * dt - - ns%smin_no3_vr_col(c,j) = ns%smin_no3_vr_col(c,j) + nf%f_nit_vr_col(c,j) * dt * (1._r8 - nitrif_n2o_loss_frac) - - ! Account for denitrification fluxes - ns%smin_no3_vr_col(c,j) = ns%smin_no3_vr_col(c,j) - nf%f_denit_vr_col(c,j) * dt - - ! flux that prevents N limitation (when Carbon_only is set; put all into NH4) - ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) + nf%supplement_to_sminn_vr_col(c,j)*dt - - ! update diagnostic total - ns%sminn_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) + ns%smin_no3_vr_col(c,j) - - end do ! end of column loop - end do - - end if - endif ! if (.not.(use_pflotran .and. pf_cmode)) - !------------------------------------------------------------------ + + do j = 1, nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + ! "bulk denitrification" + ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) - nf%sminn_to_denit_excess_vr_col(c,j) * dt + + ! total plant uptake from mineral N + ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) - nf%sminn_to_plant_vr_col(c,j)*dt + + ! flux that prevents N limitation (when Carbon_only is set) + ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) + nf%supplement_to_sminn_vr_col(c,j)*dt + end do + end do + + else + + !-------------------------------------------------------- + !------------- NITRIF_DENITRIF ON -------------------- + !-------------------------------------------------------- + + do j = 1, nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! mineralization fluxes (divert a fraction of this stream to nitrification flux, add the rest to NH4 pool) + ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) + nf%gross_nmin_vr_col(c,j)*dt + + ! immobilization fluxes + ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) - nf%actual_immob_nh4_vr_col(c,j)*dt + + ns%smin_no3_vr_col(c,j) = ns%smin_no3_vr_col(c,j) - nf%actual_immob_no3_vr_col(c,j)*dt + + ! plant uptake fluxes + ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) - nf%smin_nh4_to_plant_vr_col(c,j)*dt + + ns%smin_no3_vr_col(c,j) = ns%smin_no3_vr_col(c,j) - nf%smin_no3_to_plant_vr_col(c,j)*dt + + ! Account for nitrification fluxes + ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) - nf%f_nit_vr_col(c,j) * dt + + ns%smin_no3_vr_col(c,j) = ns%smin_no3_vr_col(c,j) + nf%f_nit_vr_col(c,j) * dt * (1._r8 - nitrif_n2o_loss_frac) + + ! Account for denitrification fluxes + ns%smin_no3_vr_col(c,j) = ns%smin_no3_vr_col(c,j) - nf%f_denit_vr_col(c,j) * dt + + ! flux that prevents N limitation (when Carbon_only is set; put all into NH4) + ns%smin_nh4_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) + nf%supplement_to_sminn_vr_col(c,j)*dt + + ! update diagnostic total + ns%sminn_vr_col(c,j) = ns%smin_nh4_vr_col(c,j) + ns%smin_no3_vr_col(c,j) + + end do ! end of column loop + end do + + end if + endif !end if is_active_betr_bgc ! patch loop - + do fp = 1,num_soilp p = filter_soilp(fp) diff --git a/components/clm/src/biogeochem/CNNStateUpdate2Mod.F90 b/components/clm/src/biogeochem/CNNStateUpdate2Mod.F90 index 2f70ad066946..405cbe9d16f4 100644 --- a/components/clm/src/biogeochem/CNNStateUpdate2Mod.F90 +++ b/components/clm/src/biogeochem/CNNStateUpdate2Mod.F90 @@ -38,12 +38,13 @@ subroutine NStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & ! NOTE - associate statements have been removed where there are ! no science equations. This increases readability and maintainability ! + use tracer_varcon, only : is_active_betr_bgc ! !ARGUMENTS: integer , intent(in) :: num_soilc ! number of soil columns in filter integer , intent(in) :: filter_soilc(:) ! filter for soil columns integer , intent(in) :: num_soilp ! number of soil patches in filter integer , intent(in) :: filter_soilp(:) ! filter for soil patches - type(nitrogenflux_type) , intent(in) :: nitrogenflux_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars ! ! !LOCAL VARIABLES: @@ -60,29 +61,42 @@ subroutine NStateUpdate2(num_soilc, filter_soilc, num_soilp, filter_soilp, & ! set time steps dt = real( get_step_size(), r8 ) - !------------------------------------------------------------------ - ! if coupled with pflotran, the following updates are NOT needed - if (.not.(use_pflotran .and. pf_cmode)) then - !------------------------------------------------------------------ ! column-level nitrogen fluxes from gap-phase mortality - - do j = 1, nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) - - ns%decomp_npools_vr_col(c,j,i_met_lit) = & - ns%decomp_npools_vr_col(c,j,i_met_lit) + nf%gap_mortality_n_to_litr_met_n_col(c,j) * dt - ns%decomp_npools_vr_col(c,j,i_cel_lit) = & - ns%decomp_npools_vr_col(c,j,i_cel_lit) + nf%gap_mortality_n_to_litr_cel_n_col(c,j) * dt - ns%decomp_npools_vr_col(c,j,i_lig_lit) = & - ns%decomp_npools_vr_col(c,j,i_lig_lit) + nf%gap_mortality_n_to_litr_lig_n_col(c,j) * dt - ns%decomp_npools_vr_col(c,j,i_cwd) = & - ns%decomp_npools_vr_col(c,j,i_cwd) + nf%gap_mortality_n_to_cwdn_col(c,j) * dt + if ( .not. is_active_betr_bgc .and. & + .not.(use_pflotran .and. pf_cmode)) then + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + + ns%decomp_npools_vr_col(c,j,i_met_lit) = & + ns%decomp_npools_vr_col(c,j,i_met_lit) + nf%gap_mortality_n_to_litr_met_n_col(c,j) * dt + ns%decomp_npools_vr_col(c,j,i_cel_lit) = & + ns%decomp_npools_vr_col(c,j,i_cel_lit) + nf%gap_mortality_n_to_litr_cel_n_col(c,j) * dt + ns%decomp_npools_vr_col(c,j,i_lig_lit) = & + ns%decomp_npools_vr_col(c,j,i_lig_lit) + nf%gap_mortality_n_to_litr_lig_n_col(c,j) * dt + ns%decomp_npools_vr_col(c,j,i_cwd) = & + ns%decomp_npools_vr_col(c,j,i_cwd) + nf%gap_mortality_n_to_cwdn_col(c,j) * dt + end do end do - end do - endif ! if (.not.(use_pflotran .and. pf_cmode)) - !------------------------------------------------------------------ + + elseif (is_active_betr_bgc) then + + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + + nf%bgc_npool_ext_inputs_vr_col(c,j,i_met_lit) = & + nf%bgc_npool_ext_inputs_vr_col(c,j,i_met_lit) + nf%gap_mortality_n_to_litr_met_n_col(c,j) * dt + nf%bgc_npool_ext_inputs_vr_col(c,j,i_cel_lit) = & + nf%bgc_npool_ext_inputs_vr_col(c,j,i_cel_lit) + nf%gap_mortality_n_to_litr_cel_n_col(c,j) * dt + nf%bgc_npool_ext_inputs_vr_col(c,j,i_lig_lit) = & + nf%bgc_npool_ext_inputs_vr_col(c,j,i_lig_lit) + nf%gap_mortality_n_to_litr_lig_n_col(c,j) * dt + nf%bgc_npool_ext_inputs_vr_col(c,j,i_cwd) = & + nf%bgc_npool_ext_inputs_vr_col(c,j,i_cwd) + nf%gap_mortality_n_to_cwdn_col(c,j) * dt + end do + end do + endif ! patch -level nitrogen fluxes from gap-phase mortality @@ -130,12 +144,13 @@ subroutine NStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & ! NOTE - associate statements have been removed where there are ! no science equations. This increases readability and maintainability ! + use tracer_varcon, only : is_active_betr_bgc ! !ARGUMENTS: integer , intent(in) :: num_soilc ! number of soil columns in filter integer , intent(in) :: filter_soilc(:) ! filter for soil columns integer , intent(in) :: num_soilp ! number of soil patches in filter integer , intent(in) :: filter_soilp(:) ! filter for soil patches - type(nitrogenflux_type) , intent(in) :: nitrogenflux_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars ! ! !LOCAL VARIABLES: @@ -153,28 +168,40 @@ subroutine NStateUpdate2h(num_soilc, filter_soilc, num_soilp, filter_soilp, & ! set time steps dt = real( get_step_size(), r8 ) - !------------------------------------------------------------------ - ! if coupled with pflotran, the following updates are NOT needed - if (.not.(use_pflotran .and. pf_cmode)) then - !------------------------------------------------------------------ - - ! column-level nitrogen fluxes from harvest mortality - - do j = 1,nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) - ns%decomp_npools_vr_col(c,j,i_met_lit) = & - ns%decomp_npools_vr_col(c,j,i_met_lit) + nf%harvest_n_to_litr_met_n_col(c,j) * dt - ns%decomp_npools_vr_col(c,j,i_cel_lit) = & - ns%decomp_npools_vr_col(c,j,i_cel_lit) + nf%harvest_n_to_litr_cel_n_col(c,j) * dt - ns%decomp_npools_vr_col(c,j,i_lig_lit) = & - ns%decomp_npools_vr_col(c,j,i_lig_lit) + nf%harvest_n_to_litr_lig_n_col(c,j) * dt - ns%decomp_npools_vr_col(c,j,i_cwd) = & - ns%decomp_npools_vr_col(c,j,i_cwd) + nf%harvest_n_to_cwdn_col(c,j) * dt + if (.not. is_active_betr_bgc .and. & + .not.(use_pflotran .and. pf_cmode)) then + ! column-level nitrogen fluxes from harvest mortality + + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + ns%decomp_npools_vr_col(c,j,i_met_lit) = & + ns%decomp_npools_vr_col(c,j,i_met_lit) + nf%harvest_n_to_litr_met_n_col(c,j) * dt + ns%decomp_npools_vr_col(c,j,i_cel_lit) = & + ns%decomp_npools_vr_col(c,j,i_cel_lit) + nf%harvest_n_to_litr_cel_n_col(c,j) * dt + ns%decomp_npools_vr_col(c,j,i_lig_lit) = & + ns%decomp_npools_vr_col(c,j,i_lig_lit) + nf%harvest_n_to_litr_lig_n_col(c,j) * dt + ns%decomp_npools_vr_col(c,j,i_cwd) = & + ns%decomp_npools_vr_col(c,j,i_cwd) + nf%harvest_n_to_cwdn_col(c,j) * dt + end do end do - end do - endif ! if (.not.(use_pflotran .and. pf_cmode)) - !------------------------------------------------------------------ + + elseif (is_active_betr_bgc) then + + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + nf%bgc_npool_ext_inputs_vr_col(c,j,i_met_lit) = & + nf%bgc_npool_ext_inputs_vr_col(c,j,i_met_lit) + nf%harvest_n_to_litr_met_n_col(c,j) * dt + nf%bgc_npool_ext_inputs_vr_col(c,j,i_cel_lit) = & + nf%bgc_npool_ext_inputs_vr_col(c,j,i_cel_lit) + nf%harvest_n_to_litr_cel_n_col(c,j) * dt + nf%bgc_npool_ext_inputs_vr_col(c,j,i_lig_lit) = & + nf%bgc_npool_ext_inputs_vr_col(c,j,i_lig_lit) + nf%harvest_n_to_litr_lig_n_col(c,j) * dt + nf%bgc_npool_ext_inputs_vr_col(c,j,i_cwd) = & + nf%bgc_npool_ext_inputs_vr_col(c,j,i_cwd) + nf%harvest_n_to_cwdn_col(c,j) * dt + end do + end do + endif ! patch-level nitrogen fluxes from harvest mortality diff --git a/components/clm/src/biogeochem/CNNStateUpdate3Mod.F90 b/components/clm/src/biogeochem/CNNStateUpdate3Mod.F90 index a62c50a20e03..057600453fde 100644 --- a/components/clm/src/biogeochem/CNNStateUpdate3Mod.F90 +++ b/components/clm/src/biogeochem/CNNStateUpdate3Mod.F90 @@ -36,12 +36,13 @@ subroutine NStateUpdate3(num_soilc, filter_soilc, num_soilp, filter_soilp, & ! NOTE - associate statements have been removed where there are ! no science equations. This increases readability and maintainability. ! + use tracer_varcon, only : is_active_betr_bgc ! !ARGUMENTS: integer , intent(in) :: num_soilc ! number of soil columns in filter integer , intent(in) :: filter_soilc(:) ! filter for soil columns integer , intent(in) :: num_soilp ! number of soil patches in filter integer , intent(in) :: filter_soilp(:) ! filter for soil patches - type(nitrogenflux_type) , intent(in) :: nitrogenflux_vars + type(nitrogenflux_type) , intent(inout) :: nitrogenflux_vars type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars ! ! !LOCAL VARIABLES: @@ -58,51 +59,78 @@ subroutine NStateUpdate3(num_soilc, filter_soilc, num_soilp, filter_soilp, & ! set time steps dt = real( get_step_size(), r8 ) - do j = 1, nlevdecomp - ! column loop - do fc = 1,num_soilc - c = filter_soilc(fc) - - if (.not. use_nitrif_denitrif) then - ! mineral N loss due to leaching - ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) - nf%sminn_leached_vr_col(c,j) * dt - else - ! mineral N loss due to leaching and runoff - ns%smin_no3_vr_col(c,j) = max( ns%smin_no3_vr_col(c,j) - & - ( nf%smin_no3_leached_vr_col(c,j) + nf%smin_no3_runoff_vr_col(c,j) ) * dt, 0._r8) - - ns%sminn_vr_col(c,j) = ns%smin_no3_vr_col(c,j) + ns%smin_nh4_vr_col(c,j) - end if - - ! column level nitrogen fluxes from fire - ! pft-level wood to column-level CWD (uncombusted wood) - ns%decomp_npools_vr_col(c,j,i_cwd) = ns%decomp_npools_vr_col(c,j,i_cwd) + nf%fire_mortality_n_to_cwdn_col(c,j) * dt - - ! pft-level wood to column-level litter (uncombusted wood) - ns%decomp_npools_vr_col(c,j,i_met_lit) = ns%decomp_npools_vr_col(c,j,i_met_lit) + nf%m_n_to_litr_met_fire_col(c,j)* dt - ns%decomp_npools_vr_col(c,j,i_cel_lit) = ns%decomp_npools_vr_col(c,j,i_cel_lit) + nf%m_n_to_litr_cel_fire_col(c,j)* dt - ns%decomp_npools_vr_col(c,j,i_lig_lit) = ns%decomp_npools_vr_col(c,j,i_lig_lit) + nf%m_n_to_litr_lig_fire_col(c,j)* dt - - end do ! end of column loop - end do - - ! litter and CWD losses to fire - do l = 1, ndecomp_pools + if (.not. is_active_betr_bgc) then do j = 1, nlevdecomp ! column loop do fc = 1,num_soilc c = filter_soilc(fc) - ns%decomp_npools_vr_col(c,j,l) = ns%decomp_npools_vr_col(c,j,l) - nf%m_decomp_npools_to_fire_vr_col(c,j,l) * dt + + if (.not. use_nitrif_denitrif) then + ! mineral N loss due to leaching + ns%sminn_vr_col(c,j) = ns%sminn_vr_col(c,j) - nf%sminn_leached_vr_col(c,j) * dt + else + ! mineral N loss due to leaching and runoff + ns%smin_no3_vr_col(c,j) = max( ns%smin_no3_vr_col(c,j) - & + ( nf%smin_no3_leached_vr_col(c,j) + nf%smin_no3_runoff_vr_col(c,j) ) * dt, 0._r8) + + ns%sminn_vr_col(c,j) = ns%smin_no3_vr_col(c,j) + ns%smin_nh4_vr_col(c,j) + end if + + ! column level nitrogen fluxes from fire + ! pft-level wood to column-level CWD (uncombusted wood) + ns%decomp_npools_vr_col(c,j,i_cwd) = ns%decomp_npools_vr_col(c,j,i_cwd) + nf%fire_mortality_n_to_cwdn_col(c,j) * dt + + ! pft-level wood to column-level litter (uncombusted wood) + ns%decomp_npools_vr_col(c,j,i_met_lit) = ns%decomp_npools_vr_col(c,j,i_met_lit) + nf%m_n_to_litr_met_fire_col(c,j)* dt + ns%decomp_npools_vr_col(c,j,i_cel_lit) = ns%decomp_npools_vr_col(c,j,i_cel_lit) + nf%m_n_to_litr_cel_fire_col(c,j)* dt + ns%decomp_npools_vr_col(c,j,i_lig_lit) = ns%decomp_npools_vr_col(c,j,i_lig_lit) + nf%m_n_to_litr_lig_fire_col(c,j)* dt + end do ! end of column loop + end do + + ! litter and CWD losses to fire + do l = 1, ndecomp_pools + do j = 1, nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + ns%decomp_npools_vr_col(c,j,l) = ns%decomp_npools_vr_col(c,j,l) - nf%m_decomp_npools_to_fire_vr_col(c,j,l) * dt + end do end do end do - end do + else + do j = 1, nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + ! column level nitrogen fluxes from fire + ! pft-level wood to column-level CWD (uncombusted wood) + nf%bgc_npool_ext_inputs_vr_col(c,j,i_cwd) = nf%bgc_npool_ext_inputs_vr_col(c,j,i_cwd) + nf%fire_mortality_n_to_cwdn_col(c,j) * dt + + ! pft-level wood to column-level litter (uncombusted wood) + nf%bgc_npool_ext_inputs_vr_col(c,j,i_met_lit) = nf%bgc_npool_ext_inputs_vr_col(c,j,i_met_lit) + nf%m_n_to_litr_met_fire_col(c,j)* dt + nf%bgc_npool_ext_inputs_vr_col(c,j,i_cel_lit) = nf%bgc_npool_ext_inputs_vr_col(c,j,i_cel_lit) + nf%m_n_to_litr_cel_fire_col(c,j)* dt + nf%bgc_npool_ext_inputs_vr_col(c,j,i_lig_lit) = nf%bgc_npool_ext_inputs_vr_col(c,j,i_lig_lit) + nf%m_n_to_litr_lig_fire_col(c,j)* dt + end do ! end of column loop + end do + + ! litter and CWD losses to fire + do l = 1, ndecomp_pools + do j = 1, nlevdecomp + ! column loop + do fc = 1,num_soilc + c = filter_soilc(fc) + nf%bgc_npool_ext_loss_vr_col(c,j,l) = nf%bgc_npool_ext_loss_vr_col(c,j,l) + nf%m_decomp_npools_to_fire_vr_col(c,j,l) * dt + end do + end do + end do + endif ! patch-level nitrogen fluxes - + do fp = 1,num_soilp p = filter_soilp(fp) - + !from fire displayed pools ns%leafn_patch(p) = ns%leafn_patch(p) - nf%m_leafn_to_fire_patch(p) * dt ns%frootn_patch(p) = ns%frootn_patch(p) - nf%m_frootn_to_fire_patch(p) * dt diff --git a/components/clm/src/biogeochem/CNNitrogenFluxType.F90 b/components/clm/src/biogeochem/CNNitrogenFluxType.F90 index efe84feff230..254ea5379ad7 100644 --- a/components/clm/src/biogeochem/CNNitrogenFluxType.F90 +++ b/components/clm/src/biogeochem/CNNitrogenFluxType.F90 @@ -194,7 +194,7 @@ module CNNitrogenFluxType real(r8), pointer :: nfix_to_sminn_col (:) ! col symbiotic/asymbiotic 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) - + ! phenology: litterfall and crop fluxes real(r8), pointer :: phenology_n_to_litr_met_n_col (:,:) ! col N fluxes associated with phenology (litterfall and crop) to litter metabolic pool (gN/m3/s) real(r8), pointer :: phenology_n_to_litr_cel_n_col (:,:) ! col N fluxes associated with phenology (litterfall and crop) to litter cellulose pool (gN/m3/s) @@ -226,6 +226,15 @@ module CNNitrogenFluxType real(r8), pointer :: net_nmin_vr_col (:,:) ! col vertically-resolved net rate of N mineralization (gN/m3/s) real(r8), pointer :: net_nmin_col (:) ! col vert-int (diagnostic) net rate of N mineralization (gN/m2/s) + real(r8), pointer :: sminn_no3_input_vr_col (:,:) !col no3 input, gN/m3/time step + real(r8), pointer :: sminn_nh4_input_vr_col (:,:) !col nh4 input, gN/m3/time step + real(r8), pointer :: sminn_no3_input_col (:) !col no3 input, gN/m2 + real(r8), pointer :: sminn_nh4_input_col (:) !col nh4 input, gN/m2 + real(r8), pointer :: sminn_input_col (:) !col minn input, gN/m2 + real(r8), pointer :: bgc_npool_ext_inputs_vr_col (:,:,:) !col organic nitrogen input, gN/m3/time step + real(r8), pointer :: bgc_npool_ext_loss_vr_col (:,:,:) !col extneral organic nitrogen loss, gN/m3/time step + + real(r8), pointer :: bgc_npool_inputs_col (:,:) !col organic N input, gN/m2/time step ! ---------- NITRIF_DENITRIF --------------------- ! nitrification / denitrification fluxes @@ -601,6 +610,9 @@ subroutine InitAllocate(this, bounds) allocate(this%actual_immob_nh4_vr_col (begc:endc,1:nlevdecomp_full)) ; this%actual_immob_nh4_vr_col (:,:) = nan allocate(this%smin_no3_to_plant_vr_col (begc:endc,1:nlevdecomp_full)) ; this%smin_no3_to_plant_vr_col (:,:) = nan allocate(this%smin_nh4_to_plant_vr_col (begc:endc,1:nlevdecomp_full)) ; this%smin_nh4_to_plant_vr_col (:,:) = nan + allocate(this%smin_no3_to_plant_col (begc:endc)) ; this%smin_no3_to_plant_col (:) = nan + allocate(this%smin_nh4_to_plant_col (begc:endc)) ; this%smin_nh4_to_plant_col (:) = nan + allocate(this%f_nit_col (begc:endc)) ; this%f_nit_col (:) = nan allocate(this%f_denit_col (begc:endc)) ; this%f_denit_col (:) = nan allocate(this%n2_n2o_ratio_denit_vr_col (begc:endc,1:nlevdecomp_full)) ; this%n2_n2o_ratio_denit_vr_col (:,:) = nan @@ -609,6 +621,16 @@ subroutine InitAllocate(this, bounds) 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%sminn_no3_input_vr_col (begc:endc,1:nlevdecomp_full)) ; this%sminn_no3_input_vr_col (:,:) = nan + allocate(this%sminn_nh4_input_vr_col (begc:endc,1:nlevdecomp_full)) ; this%sminn_nh4_input_vr_col (:,:) = nan + allocate(this%sminn_nh4_input_col (begc:endc)) ; this%sminn_nh4_input_col (:) = nan + allocate(this%sminn_no3_input_col (begc:endc)) ; this%sminn_no3_input_col (:) = nan + allocate(this%sminn_input_col (begc:endc)) ; this%sminn_input_col (:) = nan + allocate(this%bgc_npool_ext_inputs_vr_col (begc:endc,1:nlevdecomp_full,ndecomp_pools)) ;this%bgc_npool_ext_inputs_vr_col (:,:,:) = nan + allocate(this%bgc_npool_ext_loss_vr_col (begc:endc,1:nlevdecomp_full,ndecomp_pools)) ;this%bgc_npool_ext_loss_vr_col (:,:,:) = nan + + allocate(this%bgc_npool_inputs_col (begc:endc,ndecomp_pools)) ;this%bgc_npool_inputs_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 @@ -726,6 +748,7 @@ subroutine InitHistory(this, bounds) use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) use clm_varpar , only : nlevsno, nlevgrnd, crop_prog use histFileMod , only : hist_addfld1d, hist_addfld2d, hist_addfld_decomp + use tracer_varcon , only : is_active_betr_bgc, do_betr_leaching ! ! !ARGUMENTS: class(nitrogenflux_type) :: this @@ -1189,85 +1212,120 @@ subroutine InitHistory(this, bounds) endif end do - do l = 1, ndecomp_cascade_transitions - ! vertically integrated fluxes - !-- mineralization/immobilization fluxes (none from CWD) - if ( .not. decomp_cascade_con%is_cwd(decomp_cascade_con%cascade_donor_pool(l)) ) then - this%decomp_cascade_sminn_flux_col(begc:endc,l) = spval - data1dptr => this%decomp_cascade_sminn_flux_col(:,l) - if ( decomp_cascade_con%cascade_receiver_pool(l) /= 0 ) then - fieldname = 'SMINN_TO_'//& - trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))//'N_'//& - trim(decomp_cascade_con%decomp_pool_name_short(decomp_cascade_con%cascade_donor_pool(l))) - longname = 'mineral N flux for decomp. of '& - //trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))//& - 'to '//trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l))) - else - fieldname = trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))& - //'N_TO_SMINN' - longname = 'mineral N flux for decomp. of '& - //trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l))) - endif - call hist_addfld1d (fname=fieldname, units='gN/m^2', & - avgflag='A', long_name=longname, & - ptr_col=data1dptr) - end if - - !-- transfer fluxes (none from terminal pool, if present) - if ( decomp_cascade_con%cascade_receiver_pool(l) /= 0 ) then - this%decomp_cascade_ntransfer_col(begc:endc,l) = spval - data1dptr => this%decomp_cascade_ntransfer_col(:,l) - fieldname = trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))//'N_TO_'//& - trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))//'N' - longname = 'decomp. of '//trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l)))//& - ' N to '//trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_receiver_pool(l)))//' N' - call hist_addfld1d (fname=fieldname, units='gN/m^2', & - avgflag='A', long_name=longname, & - ptr_col=data1dptr) - end if - - ! vertically resolved fluxes - if ( nlevdecomp_full > 1 ) then + if (.not. is_active_betr_bgc) then + do l = 1, ndecomp_cascade_transitions + ! vertically integrated fluxes !-- mineralization/immobilization fluxes (none from CWD) if ( .not. decomp_cascade_con%is_cwd(decomp_cascade_con%cascade_donor_pool(l)) ) then - this%decomp_cascade_sminn_flux_vr_col(begc:endc,:,l) = spval - data2dptr => this%decomp_cascade_sminn_flux_vr_col(:,:,l) + this%decomp_cascade_sminn_flux_col(begc:endc,l) = spval + data1dptr => this%decomp_cascade_sminn_flux_col(:,l) if ( decomp_cascade_con%cascade_receiver_pool(l) /= 0 ) then - fieldname = 'SMINN_TO_'& - //trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))//'N_'//& - trim(decomp_cascade_con%decomp_pool_name_short(decomp_cascade_con%cascade_donor_pool(l)))//trim(vr_suffix) + fieldname = 'SMINN_TO_'//& + trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))//'N_'//& + trim(decomp_cascade_con%decomp_pool_name_short(decomp_cascade_con%cascade_donor_pool(l))) longname = 'mineral N flux for decomp. of '& //trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))//& 'to '//trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l))) else fieldname = trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))& - //'N_TO_SMINN'//trim(vr_suffix) + //'N_TO_SMINN' longname = 'mineral N flux for decomp. of '& //trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l))) endif - call hist_addfld_decomp (fname=fieldname, units='gN/m^3', type2d='levdcmp', & + call hist_addfld1d (fname=fieldname, units='gN/m^2', & avgflag='A', long_name=longname, & - ptr_col=data2dptr, default='inactive') - endif - + ptr_col=data1dptr) + end if + !-- transfer fluxes (none from terminal pool, if present) if ( decomp_cascade_con%cascade_receiver_pool(l) /= 0 ) then - this%decomp_cascade_ntransfer_vr_col(begc:endc,:,l) = spval - data2dptr => this%decomp_cascade_ntransfer_vr_col(:,:,l) + this%decomp_cascade_ntransfer_col(begc:endc,l) = spval + data1dptr => this%decomp_cascade_ntransfer_col(:,l) fieldname = trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))//'N_TO_'//& - trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))& - //'N'//trim(vr_suffix) - longname = 'decomp. of '& - //trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l)))//& + trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))//'N' + longname = 'decomp. of '//trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l)))//& ' N to '//trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_receiver_pool(l)))//' N' - call hist_addfld_decomp (fname=fieldname, units='gN/m^3', type2d='levdcmp', & + call hist_addfld1d (fname=fieldname, units='gN/m^2', & avgflag='A', long_name=longname, & - ptr_col=data2dptr, default='inactive') + ptr_col=data1dptr) + end if + + ! vertically resolved fluxes + if ( nlevdecomp_full > 1 ) then + !-- mineralization/immobilization fluxes (none from CWD) + if ( .not. decomp_cascade_con%is_cwd(decomp_cascade_con%cascade_donor_pool(l)) ) then + this%decomp_cascade_sminn_flux_vr_col(begc:endc,:,l) = spval + data2dptr => this%decomp_cascade_sminn_flux_vr_col(:,:,l) + if ( decomp_cascade_con%cascade_receiver_pool(l) /= 0 ) then + fieldname = 'SMINN_TO_'& + //trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))//'N_'//& + trim(decomp_cascade_con%decomp_pool_name_short(decomp_cascade_con%cascade_donor_pool(l)))//trim(vr_suffix) + longname = 'mineral N flux for decomp. of '& + //trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))//& + 'to '//trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l))) + else + fieldname = trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))& + //'N_TO_SMINN'//trim(vr_suffix) + longname = 'mineral N flux for decomp. of '& + //trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l))) + endif + call hist_addfld_decomp (fname=fieldname, units='gN/m^3', type2d='levdcmp', & + avgflag='A', long_name=longname, & + ptr_col=data2dptr, default='inactive') + endif + + !-- transfer fluxes (none from terminal pool, if present) + if ( decomp_cascade_con%cascade_receiver_pool(l) /= 0 ) then + this%decomp_cascade_ntransfer_vr_col(begc:endc,:,l) = spval + data2dptr => this%decomp_cascade_ntransfer_vr_col(:,:,l) + fieldname = trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_donor_pool(l)))//'N_TO_'//& + trim(decomp_cascade_con%decomp_pool_name_history(decomp_cascade_con%cascade_receiver_pool(l)))& + //'N'//trim(vr_suffix) + longname = 'decomp. of '& + //trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_donor_pool(l)))//& + ' N to '//trim(decomp_cascade_con%decomp_pool_name_long(decomp_cascade_con%cascade_receiver_pool(l)))//' N' + call hist_addfld_decomp (fname=fieldname, units='gN/m^3', type2d='levdcmp', & + avgflag='A', long_name=longname, & + ptr_col=data2dptr, default='inactive') + endif + endif + end do + endif - endif - end do - + this%sminn_no3_input_vr_col(begc:endc,:) = spval + data2dptr => this%sminn_no3_input_vr_col(:,:) + fieldname='SMINN_NO3_INPUT_vr' + call hist_addfld_decomp (fname=fieldname, units='gN/m^3/s', type2d='levdcmp', & + avgflag='A', long_name=longname, & + ptr_col=data2dptr, default='inactive') + + this%sminn_nh4_input_vr_col(begc:endc,:) = spval + data2dptr => this%sminn_nh4_input_vr_col(:,:) + fieldname='SMINN_NH4_INPUT_vr' + call hist_addfld_decomp (fname=fieldname, units='gN/m^3/s', type2d='levdcmp', & + avgflag='A', long_name=longname, & + ptr_col=data2dptr, default='inactive') + + do k = 1, ndecomp_pools + this%bgc_npool_ext_inputs_vr_col(begc:endc, :, k) = spval + data2dptr => this%bgc_npool_ext_inputs_vr_col(:,:,k) + fieldname='BGC_NPOOL_EINPUT_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'_vr' + longname='N input to '//trim(decomp_cascade_con%decomp_pool_name_history(k)) + call hist_addfld_decomp (fname=fieldname, units='gN/m^3', type2d='levdcmp', & + avgflag='A', long_name=longname, & + ptr_col=data2dptr, default='inactive') + + this%bgc_npool_ext_loss_vr_col(begc:endc, :, k) = spval + data2dptr => this%bgc_npool_ext_loss_vr_col(:,:,k) + fieldname='BGC_NPOOL_ELOSS_'//trim(decomp_cascade_con%decomp_pool_name_history(k))//'_vr' + longname='N LOSS to '//trim(decomp_cascade_con%decomp_pool_name_history(k)) + call hist_addfld_decomp (fname=fieldname, units='gN/m^3', type2d='levdcmp', & + avgflag='A', long_name=longname, & + ptr_col=data2dptr, default='inactive') + + enddo + this%denit_col(begc:endc) = spval call hist_addfld1d (fname='DENIT', units='gN/m^2/s', & avgflag='A', long_name='total rate of denitrification', & @@ -1618,6 +1676,7 @@ subroutine InitHistory(this, bounds) ptr_col=this%sminn_to_plant_vr_col, default='inactive') end if + if ( use_nitrif_denitrif .and. nlevdecomp_full > 1 ) then this%supplement_to_sminn_vr_col(begc:endc,:) = spval call hist_addfld_decomp (fname='SUPPLEMENT_TO_SMINN'//trim(vr_suffix), units='gN/m^3/s', type2d='levdcmp', & @@ -2149,6 +2208,7 @@ subroutine SetValues ( this, & ! !DESCRIPTION: ! Set nitrogen flux variables ! + use tracer_varcon , only : is_active_betr_bgc ! !ARGUMENTS: ! !ARGUMENTS: class (nitrogenflux_type) :: this @@ -2334,7 +2394,7 @@ subroutine SetValues ( this, & this%harvest_n_to_litr_lig_n_col(i,j) = value_column this%harvest_n_to_cwdn_col(i,j) = value_column - if (.not. use_nitrif_denitrif) then + if (.not. use_nitrif_denitrif .and. (.not.is_active_betr_bgc )) then this%sminn_to_denit_excess_vr_col(i,j) = value_column this%sminn_leached_vr_col(i,j) = value_column else @@ -2386,6 +2446,8 @@ subroutine SetValues ( this, & this%supplement_to_sminn_vr_col(i,j) = value_column this%gross_nmin_vr_col(i,j) = value_column this%net_nmin_vr_col(i,j) = value_column + this%sminn_nh4_input_vr_col(i,j) = value_column + this%sminn_no3_input_vr_col(i,j) = value_column end do end do @@ -2410,7 +2472,7 @@ subroutine SetValues ( this, & this%gross_nmin_col(i) = value_column this%net_nmin_col(i) = value_column this%denit_col(i) = value_column - if (use_nitrif_denitrif) then + if (use_nitrif_denitrif .or. is_active_betr_bgc) then this%f_nit_col(i) = value_column this%pot_f_nit_col(i) = value_column this%f_denit_col(i) = value_column @@ -2420,12 +2482,14 @@ subroutine SetValues ( this, & this%smin_no3_leached_col(i) = value_column this%smin_no3_runoff_col(i) = value_column - ! pflotran this%f_ngas_decomp_col(i) = value_column this%f_ngas_nitri_col(i) = value_column this%f_ngas_denit_col(i) = value_column this%f_n2o_soil_col(i) = value_column this%f_n2_soil_col(i) = value_column + + this%smin_nh4_to_plant_col(i) = value_column + this%smin_no3_to_plant_col(i) = value_column else this%sminn_to_denit_excess_col(i) = value_column this%sminn_leached_col(i) = value_column @@ -2434,7 +2498,9 @@ subroutine SetValues ( this, & this%noutputs_col(i) = value_column this%fire_nloss_col(i) = value_column this%som_n_leached_col(i) = value_column - + this%sminn_input_col(i) = value_column + this%sminn_nh4_input_col(i) = value_column + this%sminn_no3_input_col(i) = value_column ! Zero p2c column fluxes this%fire_nloss_col(i) = value_column this%wood_harvestn_col(i) = value_column @@ -2448,6 +2514,9 @@ subroutine SetValues ( this, & i = filter_column(fi) this%decomp_npools_leached_col(i,k) = value_column this%m_decomp_npools_to_fire_col(i,k) = value_column + this%bgc_npool_ext_inputs_vr_col (i,:,k) = value_column + this%bgc_npool_ext_loss_vr_col (i,:,k) = value_column + this%bgc_npool_inputs_col (i,k) = value_column end do end do @@ -2461,29 +2530,31 @@ subroutine SetValues ( this, & end do end do - do l = 1, ndecomp_cascade_transitions - do fi = 1,num_column - i = filter_column(fi) - this%decomp_cascade_ntransfer_col(i,l) = value_column - this%decomp_cascade_sminn_flux_col(i,l) = value_column - if (.not. use_nitrif_denitrif) then - this%sminn_to_denit_decomp_cascade_col(i,l) = value_column - end if - end do - end do - - do l = 1, ndecomp_cascade_transitions - do j = 1, nlevdecomp_full + if (.not. is_active_betr_bgc)then + do l = 1, ndecomp_cascade_transitions do fi = 1,num_column i = filter_column(fi) - this%decomp_cascade_ntransfer_vr_col(i,j,l) = value_column - this%decomp_cascade_sminn_flux_vr_col(i,j,l) = value_column + this%decomp_cascade_ntransfer_col(i,l) = value_column + this%decomp_cascade_sminn_flux_col(i,l) = value_column if (.not. use_nitrif_denitrif) then - this%sminn_to_denit_decomp_cascade_vr_col(i,j,l) = value_column + this%sminn_to_denit_decomp_cascade_col(i,l) = value_column end if end do end do - end do + + do l = 1, ndecomp_cascade_transitions + do j = 1, nlevdecomp_full + do fi = 1,num_column + i = filter_column(fi) + this%decomp_cascade_ntransfer_vr_col(i,j,l) = value_column + this%decomp_cascade_sminn_flux_vr_col(i,j,l) = value_column + if (.not. use_nitrif_denitrif) then + this%sminn_to_denit_decomp_cascade_vr_col(i,j,l) = value_column + end if + end do + end do + end do + endif do k = 1, ndecomp_pools do j = 1, nlevdecomp_full @@ -2574,8 +2645,7 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil use clm_varctl , only: use_nitrif_denitrif use subgridAveMod , only: p2c use pftvarcon , only : npcropmin - ! pflotran -! use clm_varctl , only: use_pflotran, pf_cmode + use tracer_varcon , only: is_active_betr_bgc, do_betr_leaching ! ! !ARGUMENTS: class (nitrogenflux_type) :: this @@ -2647,115 +2717,165 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil this%supplement_to_sminn_col(c) = 0._r8 this%som_n_leached_col(c) = 0._r8 end do + - ! pflotran - !---------------------------------------------------------------- - if (.not.(use_pflotran .and. pf_cmode)) then - ! vertically integrate decomposing N cascade fluxes and soil mineral N fluxes associated with decomposition cascade - do k = 1, ndecomp_cascade_transitions - do j = 1,nlevdecomp - do fc = 1,num_soilc - c = filter_soilc(fc) + if ( (.not. (is_active_betr_bgc )) .and. & + (.not. (use_pflotran .and. pf_cmode)) ) then + + ! BeTR is off AND PFLOTRAN's pf_cmode is false + + ! vertically integrate decomposing N cascade fluxes and + !soil mineral N fluxes associated with decomposition cascade - this%decomp_cascade_ntransfer_col(c,k) = & - this%decomp_cascade_ntransfer_col(c,k) + & - this%decomp_cascade_ntransfer_vr_col(c,j,k) * dzsoi_decomp(j) + do k = 1, ndecomp_cascade_transitions + do j = 1,nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) - this%decomp_cascade_sminn_flux_col(c,k) = & - this%decomp_cascade_sminn_flux_col(c,k) + & - this%decomp_cascade_sminn_flux_vr_col(c,j,k) * dzsoi_decomp(j) + this%decomp_cascade_ntransfer_col(c,k) = & + this%decomp_cascade_ntransfer_col(c,k) + & + this%decomp_cascade_ntransfer_vr_col(c,j,k) * dzsoi_decomp(j) + + this%decomp_cascade_sminn_flux_col(c,k) = & + this%decomp_cascade_sminn_flux_col(c,k) + & + this%decomp_cascade_sminn_flux_vr_col(c,j,k) * dzsoi_decomp(j) + end do end do end do - end do - - if (.not. use_nitrif_denitrif) then - ! vertically integrate each denitrification flux - do l = 1, ndecomp_cascade_transitions + + if (.not. use_nitrif_denitrif) then + ! vertically integrate each denitrification flux + do l = 1, ndecomp_cascade_transitions + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + this%sminn_to_denit_decomp_cascade_col(c,l) = & + this%sminn_to_denit_decomp_cascade_col(c,l) + & + this%sminn_to_denit_decomp_cascade_vr_col(c,j,l) * dzsoi_decomp(j) + end do + end do + end do + + ! vertically integrate bulk denitrification and leaching flux do j = 1, nlevdecomp do fc = 1,num_soilc c = filter_soilc(fc) - this%sminn_to_denit_decomp_cascade_col(c,l) = & - this%sminn_to_denit_decomp_cascade_col(c,l) + & - this%sminn_to_denit_decomp_cascade_vr_col(c,j,l) * dzsoi_decomp(j) + this%sminn_to_denit_excess_col(c) = & + this%sminn_to_denit_excess_col(c) + & + this%sminn_to_denit_excess_vr_col(c,j) * dzsoi_decomp(j) + + this%sminn_leached_col(c) = & + this%sminn_leached_col(c) + & + this%sminn_leached_vr_col(c,j) * dzsoi_decomp(j) end do end do - end do - ! vertically integrate bulk denitrification and leaching flux - do j = 1, nlevdecomp + ! total N denitrification (DENIT) + do l = 1, ndecomp_cascade_transitions + do fc = 1,num_soilc + c = filter_soilc(fc) + this%denit_col(c) = & + this%denit_col(c) + & + this%sminn_to_denit_decomp_cascade_col(c,l) + end do + end do + do fc = 1,num_soilc c = filter_soilc(fc) - this%sminn_to_denit_excess_col(c) = & - this%sminn_to_denit_excess_col(c) + & - this%sminn_to_denit_excess_vr_col(c,j) * dzsoi_decomp(j) - - this%sminn_leached_col(c) = & - this%sminn_leached_col(c) + & - this%sminn_leached_vr_col(c,j) * dzsoi_decomp(j) + this%denit_col(c) = & + this%denit_col(c) + & + this%sminn_to_denit_excess_col(c) end do - end do + + else - ! total N denitrification (DENIT) - do l = 1, ndecomp_cascade_transitions + ! vertically integrate NO3 NH4 N2O fluxes and pools + do j = 1, nlevdecomp + do fc = 1,num_soilc + c = filter_soilc(fc) + + ! nitrification and denitrification fluxes + this%f_nit_col(c) = & + this%f_nit_col(c) + & + this%f_nit_vr_col(c,j) * dzsoi_decomp(j) + + this%f_denit_col(c) = & + this%f_denit_col(c) + & + this%f_denit_vr_col(c,j) * dzsoi_decomp(j) + + this%pot_f_nit_col(c) = & + this%pot_f_nit_col(c) + & + this%pot_f_nit_vr_col(c,j) * dzsoi_decomp(j) + + this%pot_f_denit_col(c) = & + this%pot_f_denit_col(c) + & + this%pot_f_denit_vr_col(c,j) * dzsoi_decomp(j) + + this%f_n2o_nit_col(c) = & + this%f_n2o_nit_col(c) + & + this%f_n2o_nit_vr_col(c,j) * dzsoi_decomp(j) + + this%f_n2o_denit_col(c) = & + this%f_n2o_denit_col(c) + & + this%f_n2o_denit_vr_col(c,j) * dzsoi_decomp(j) + + if (.not. do_betr_leaching) then + ! leaching/runoff flux + this%smin_no3_leached_col(c) = & + this%smin_no3_leached_col(c) + & + this%smin_no3_leached_vr_col(c,j) * dzsoi_decomp(j) + + this%smin_no3_runoff_col(c) = & + this%smin_no3_runoff_col(c) + & + this%smin_no3_runoff_vr_col(c,j) * dzsoi_decomp(j) + endif + end do + end do + do fc = 1,num_soilc c = filter_soilc(fc) - this%denit_col(c) = & - this%denit_col(c) + & - this%sminn_to_denit_decomp_cascade_col(c,l) + this%denit_col(c) = this%f_denit_col(c) end do - end do + + end if - do fc = 1,num_soilc - c = filter_soilc(fc) - this%denit_col(c) = & - this%denit_col(c) + & - this%sminn_to_denit_excess_col(c) - end do + elseif (is_active_betr_bgc) then - else + ! BeTR is active - ! vertically integrate NO3 NH4 N2O fluxes and pools do j = 1, nlevdecomp do fc = 1,num_soilc - c = filter_soilc(fc) - - ! nitrification and denitrification fluxes - this%f_nit_col(c) = & - this%f_nit_col(c) + & - this%f_nit_vr_col(c,j) * dzsoi_decomp(j) - + c = filter_soilc(fc) this%f_denit_col(c) = & this%f_denit_col(c) + & this%f_denit_vr_col(c,j) * dzsoi_decomp(j) - - this%pot_f_nit_col(c) = & - this%pot_f_nit_col(c) + & - this%pot_f_nit_vr_col(c,j) * dzsoi_decomp(j) - - this%pot_f_denit_col(c) = & - this%pot_f_denit_col(c) + & - this%pot_f_denit_vr_col(c,j) * dzsoi_decomp(j) + + this%actual_immob_vr_col(c,j) = & + this%actual_immob_nh4_vr_col(c,j) + & + this%actual_immob_no3_vr_col(c,j) + + this%actual_immob_col(c) = & + this%actual_immob_col(c) + & + this%actual_immob_vr_col(c,j) * dzsoi_decomp(j) + + this%f_nit_col(c) = & + this%f_nit_col(c) + & + this%f_nit_vr_col(c,j) * dzsoi_decomp(j) this%f_n2o_nit_col(c) = & this%f_n2o_nit_col(c) + & this%f_n2o_nit_vr_col(c,j) * dzsoi_decomp(j) - - this%f_n2o_denit_col(c) = & - this%f_n2o_denit_col(c) + & - this%f_n2o_denit_vr_col(c,j) * dzsoi_decomp(j) - - ! leaching/runoff flux - this%smin_no3_leached_col(c) = & - this%smin_no3_leached_col(c) + & - this%smin_no3_leached_vr_col(c,j) * dzsoi_decomp(j) - - this%smin_no3_runoff_col(c) = & - this%smin_no3_runoff_col(c) + & - this%smin_no3_runoff_vr_col(c,j) * dzsoi_decomp(j) - - end do - end do - + + this%smin_nh4_to_plant_col(c) = & + this%smin_nh4_to_plant_col(c) + & + this%smin_nh4_to_plant_vr_col(c,j) * dzsoi_decomp(j) + + this%smin_no3_to_plant_col(c) = & + this%smin_no3_to_plant_col(c) + & + this%smin_no3_to_plant_vr_col(c,j) * dzsoi_decomp(j) + + enddo + enddo do fc = 1,num_soilc c = filter_soilc(fc) this%denit_col(c) = this%f_denit_col(c) @@ -2763,9 +2883,6 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil end if - end if !!if (.not.(use_pflotran .and. pf_cmode)) - !----------------------------------------------------------------- - ! vertically integrate column-level fire N losses do k = 1, ndecomp_pools do j = 1, nlevdecomp @@ -2799,6 +2916,18 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil this%supplement_to_sminn_col(c) = & this%supplement_to_sminn_col(c) + & this%supplement_to_sminn_vr_col(c,j) * dzsoi_decomp(j) + + this%sminn_input_col(c) = & + this%sminn_input_col(c) + & + (this%sminn_nh4_input_vr_col(c,j)+this%sminn_no3_input_vr_col(c,j))*dzsoi_decomp(j) + + this%sminn_nh4_input_col(c) = & + this%sminn_nh4_input_col(c) + & + this%sminn_nh4_input_vr_col(c,j)*dzsoi_decomp(j) + + this%sminn_no3_input_col(c) = & + this%sminn_no3_input_col(c) + & + this%sminn_no3_input_vr_col(c,j)*dzsoi_decomp(j) end do end do @@ -2829,6 +2958,9 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil this%decomp_npools_leached_col(c,l) = & this%decomp_npools_leached_col(c,l) + & this%decomp_npools_transport_tendency_col(c,j,l) * dzsoi_decomp(j) + + this%bgc_npool_inputs_col(c,l) = this%bgc_npool_inputs_col(c,l) + & + (this%bgc_npool_ext_inputs_vr_col(c,j,l)-this%bgc_npool_ext_loss_vr_col(c,j,l))*dzsoi_decomp(j) end do end do diff --git a/components/clm/src/biogeochem/CNNitrogenStateType.F90 b/components/clm/src/biogeochem/CNNitrogenStateType.F90 index 985233b56abf..7b8d3e68fc04 100644 --- a/components/clm/src/biogeochem/CNNitrogenStateType.F90 +++ b/components/clm/src/biogeochem/CNNitrogenStateType.F90 @@ -87,7 +87,8 @@ module CNNitrogenStateType real(r8), pointer :: totsomn_1m_col (:) ! col (gN/m2) total soil organic matter nitrogen to 1 meter real(r8), pointer :: totecosysn_col (:) ! col (gN/m2) total ecosystem nitrogen, incl veg real(r8), pointer :: totcoln_col (:) ! col (gN/m2) total column nitrogen, incl veg - + real(r8), pointer :: totabgn_col (:) ! col (gN/m2) + real(r8), pointer :: totblgn_col (:) ! col (gN/m2) total below ground nitrogen ! patch averaged to column variables real(r8), pointer :: totvegn_col (:) ! col (gN/m2) total vegetation nitrogen (p2c) real(r8), pointer :: totpftn_col (:) ! col (gN/m2) total pft-level nitrogen (p2c) @@ -104,6 +105,7 @@ module CNNitrogenStateType real(r8), pointer :: smin_nh4sorb_vr_col (:,:) ! col (gN/m3) vertically-resolved soil mineral NH4 absorbed real(r8), pointer :: smin_nh4sorb_col (:) ! col (gN/m2) soil mineral NH4 pool absorbed + real(r8), pointer :: plant_nbuffer_col (:) ! col plant nitrogen buffer, (gN/m2), used to exchange info with betr contains procedure , public :: Init @@ -111,7 +113,8 @@ module CNNitrogenStateType procedure , public :: SetValues procedure , public :: ZeroDWT procedure , public :: Summary - procedure , private :: InitAllocate + procedure , public :: nbuffer_update + procedure , private :: InitAllocate procedure , private :: InitHistory procedure , private :: InitCold @@ -211,7 +214,8 @@ subroutine InitAllocate(this, bounds) allocate(this%decomp_npools_1m_col (begc:endc,1:ndecomp_pools)) ; this%decomp_npools_1m_col (:,:) = nan allocate(this%totpftn_col (begc:endc)) ; this%totpftn_col (:) = nan allocate(this%totvegn_col (begc:endc)) ; this%totvegn_col (:) = nan - + allocate(this%totabgn_col (begc:endc)) ; this%totabgn_col (:) = nan + allocate(this%totblgn_col (begc:endc)) ; this%totblgn_col (:) = nan allocate(this%decomp_npools_vr_col(begc:endc,1:nlevdecomp_full,1:ndecomp_pools)); this%decomp_npools_vr_col(:,:,:)= nan @@ -222,10 +226,11 @@ subroutine InitAllocate(this, bounds) allocate(this%errnb_patch (begp:endp)); this%errnb_patch (:) =nan allocate(this%errnb_col (begc:endc)); this%errnb_col (:) =nan - ! pflotran allocate(this%smin_nh4sorb_vr_col (begc:endc,1:nlevdecomp_full)) ; this%smin_nh4sorb_vr_col (:,:) = nan allocate(this%smin_nh4sorb_col (begc:endc)) ; this%smin_nh4sorb_col (:) = nan + allocate(this%plant_nbuffer_col(begc:endc));this%plant_nbuffer_col(:) = nan + end subroutine InitAllocate !------------------------------------------------------------------------ @@ -452,6 +457,11 @@ subroutine InitHistory(this, bounds) ptr_col=this%totsomn_1m_col) endif + this%plant_nbuffer_col(begc:endc) = spval + call hist_addfld1d (fname='PLANTN_BUFFER', units='gN/m^2', & + avgflag='A', long_name='plant nitrogen stored as buffer', & + ptr_col=this%plant_nbuffer_col) + this%ntrunc_col(begc:endc) = spval call hist_addfld1d (fname='COL_NTRUNC', units='gN/m^2', & avgflag='A', long_name='column-level sink for N truncation', & @@ -705,7 +715,6 @@ subroutine InitCold(this, bounds, & this%decomp_npools_col(c,k) = decomp_cpools_col(c,k) / decomp_cascade_con%initial_cn_ratio(k) this%decomp_npools_1m_col(c,k) = decomp_cpools_1m_col(c,k) / decomp_cascade_con%initial_cn_ratio(k) end do - if (use_nitrif_denitrif) then do j = 1, nlevdecomp_full this%smin_nh4_vr_col(c,j) = 0._r8 @@ -730,6 +739,7 @@ subroutine InitCold(this, bounds, & this%prod10n_col(c) = 0._r8 this%prod100n_col(c) = 0._r8 this%totprodn_col(c) = 0._r8 + this%plant_nbuffer_col(c) = 1._r8 end if end do @@ -1023,6 +1033,10 @@ subroutine Restart ( this, bounds, ncid, flag ) end do end do + call restartvar(ncid=ncid, flag=flag, varname='plant_nbuffer', xtype=ncd_double, & + dim1name='column', long_name='', units='', & + interpinic_flag='interp', readvar=readvar, data=this%plant_nbuffer_col) + call restartvar(ncid=ncid, flag=flag, varname='totcoln', xtype=ncd_double, & dim1name='column', long_name='', units='', & interpinic_flag='interp', readvar=readvar, data=this%totcoln_col) @@ -1599,9 +1613,53 @@ subroutine Summary(this, bounds, num_soilc, filter_soilc, num_soilp, filter_soil this%sminn_col(c) + & this%totprodn_col(c) + & this%seedn_col(c) + & - this%ntrunc_col(c) + this%ntrunc_col(c) + & + this%plant_nbuffer_col(c) + + this%totabgn_col (c) = & + this%totpftn_col(c) + & + this%totprodn_col(c) + & + this%seedn_col(c) + & + this%ntrunc_col(c) + & + this%plant_nbuffer_col(c) + + this%totblgn_col(c) = & + this%cwdn_col(c) + & + this%totlitn_col(c) + & + this%totsomn_col(c) + & + this%sminn_col(c) + end do end subroutine Summary + + !----------------------------------------------------------------------- + + subroutine nbuffer_update(this, bounds, num_soilc, filter_soilc, & + plant_minn_active_yield_flx_col, plant_minn_passive_yield_flx_col) + + use clm_time_manager , only : get_step_size + ! !ARGUMENTS: + class (nitrogenstate_type) :: this + 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 + + real(r8) , intent(in) :: plant_minn_active_yield_flx_col(bounds%begc:bounds%endc) + real(r8) , intent(in) :: plant_minn_passive_yield_flx_col(bounds%begc:bounds%endc) + integer :: fc, c + real(r8) :: dtime + + dtime = get_step_size() + + + do fc = 1, num_soilc + c = filter_soilc(fc) + this%plant_nbuffer_col(c) = this%plant_nbuffer_col(c) + & + (plant_minn_active_yield_flx_col(c) + & + plant_minn_passive_yield_flx_col(c))*dtime + enddo + + end subroutine nbuffer_update end module CNNitrogenStateType diff --git a/components/clm/src/biogeochem/CNPrecisionControlMod.F90 b/components/clm/src/biogeochem/CNPrecisionControlMod.F90 index 53bd2e16aacc..30e8aa902aa1 100644 --- a/components/clm/src/biogeochem/CNPrecisionControlMod.F90 +++ b/components/clm/src/biogeochem/CNPrecisionControlMod.F90 @@ -36,6 +36,7 @@ subroutine CNPrecisionControl(num_soilc, filter_soilc, num_soilp, filter_soilp, use clm_varctl , only : iulog, use_c13, use_c14, use_nitrif_denitrif use clm_varpar , only : nlevdecomp, crop_prog use pftvarcon , only : nc3crop + use tracer_varcon , only : is_active_betr_bgc ! ! !ARGUMENTS: integer , intent(in) :: num_soilc ! number of soil columns in filter @@ -663,86 +664,84 @@ subroutine CNPrecisionControl(num_soilc, filter_soilc, num_soilp, filter_soilp, end do ! end of pft loop - ! column loop - do fc = 1,num_soilc - c = filter_soilc(fc) - - do j = 1,nlevdecomp - ! initialize the column-level C and N truncation terms - cc = 0._r8 - if ( use_c13 ) cc13 = 0._r8 - if ( use_c14 ) cc14 = 0._r8 - cn = 0._r8 - cp = 0._r8 - - ! do tests on state variables for precision control - ! for linked C-N state variables, perform precision test on - ! the C component, but truncate both C and N components - - - ! all decomposing pools C and N - ! add P pools -- X.YANG - do k = 1, ndecomp_pools - - if (abs(cs%decomp_cpools_vr_col(c,j,k)) < ccrit) then - cc = cc + cs%decomp_cpools_vr_col(c,j,k) - cs%decomp_cpools_vr_col(c,j,k) = 0._r8 - cn = cn + ns%decomp_npools_vr_col(c,j,k) - ns%decomp_npools_vr_col(c,j,k) = 0._r8 - if ( use_c13 ) then - cc13 = cc13 + c13cs%decomp_cpools_vr_col(c,j,k) - c13cs%decomp_cpools_vr_col(c,j,k) = 0._r8 - endif - if ( use_c14 ) then - cc14 = cc14 + c14cs%decomp_cpools_vr_col(c,j,k) - c14cs%decomp_cpools_vr_col(c,j,k) = 0._r8 - endif - - cp = cp + ps%decomp_ppools_vr_col(c,j,k) - ps%decomp_ppools_vr_col(c,j,k) = 0._r8 - end if - - end do - - ! not doing precision control on soil mineral N, since it will - ! be getting the N truncation flux anyway. - - cs%ctrunc_vr_col(c,j) = cs%ctrunc_vr_col(c,j) + cc - ns%ntrunc_vr_col(c,j) = ns%ntrunc_vr_col(c,j) + cn - ps%ptrunc_vr_col(c,j) = ps%ptrunc_vr_col(c,j) + cp - if ( use_c13 ) then - c13cs%ctrunc_vr_col(c,j) = c13cs%ctrunc_vr_col(c,j) + cc13 - endif - if ( use_c14 ) then - c14cs%ctrunc_vr_col(c,j) = c14cs%ctrunc_vr_col(c,j) + cc14 - endif - end do - - end do ! end of column loop - - if (use_nitrif_denitrif) then - ! remove small negative perturbations for stability purposes, if any should arise. + if (.not. is_active_betr_bgc) then + ! column loop do fc = 1,num_soilc c = filter_soilc(fc) + do j = 1,nlevdecomp - if (abs(ns%smin_no3_vr_col(c,j)) < ncrit/1e4_r8) then - if ( ns%smin_no3_vr_col(c,j) < 0._r8 ) then - write(iulog, *) '-10^-12 < smin_no3 < 0. resetting to zero.' - write(iulog, *) 'smin_no3_vr_col(c,j), c, j: ', ns%smin_no3_vr_col(c,j), c, j - ns%smin_no3_vr_col(c,j) = 0._r8 - endif - end if - if (abs(ns%smin_nh4_vr_col(c,j)) < ncrit/1e4_r8) then - if ( ns%smin_nh4_vr_col(c,j) < 0._r8 ) then - write(iulog, *) '-10^-12 < smin_nh4 < 0. resetting to zero.' - write(iulog, *) 'smin_nh4_vr_col(c,j), c, j: ', ns%smin_nh4_vr_col(c,j), c, j - ns%smin_nh4_vr_col(c,j) = 0._r8 - endif - end if + ! initialize the column-level C and N truncation terms + cc = 0._r8 + if ( use_c13 ) cc13 = 0._r8 + if ( use_c14 ) cc14 = 0._r8 + cn = 0._r8 + + ! do tests on state variables for precision control + ! for linked C-N state variables, perform precision test on + ! the C component, but truncate both C and N components + + + ! all decomposing pools C and N + do k = 1, ndecomp_pools + + if (abs(cs%decomp_cpools_vr_col(c,j,k)) < ccrit) then + cc = cc + cs%decomp_cpools_vr_col(c,j,k) + cs%decomp_cpools_vr_col(c,j,k) = 0._r8 + cn = cn + ns%decomp_npools_vr_col(c,j,k) + ns%decomp_npools_vr_col(c,j,k) = 0._r8 + if ( use_c13 ) then + cc13 = cc13 + c13cs%decomp_cpools_vr_col(c,j,k) + c13cs%decomp_cpools_vr_col(c,j,k) = 0._r8 + endif + if ( use_c14 ) then + cc14 = cc14 + c14cs%decomp_cpools_vr_col(c,j,k) + c14cs%decomp_cpools_vr_col(c,j,k) = 0._r8 + endif + end if + + end do + + ! not doing precision control on soil mineral N, since it will + ! be getting the N truncation flux anyway. + + cs%ctrunc_vr_col(c,j) = cs%ctrunc_vr_col(c,j) + cc + ns%ntrunc_vr_col(c,j) = ns%ntrunc_vr_col(c,j) + cn + if ( use_c13 ) then + c13cs%ctrunc_vr_col(c,j) = c13cs%ctrunc_vr_col(c,j) + cc13 + endif + if ( use_c14 ) then + c14cs%ctrunc_vr_col(c,j) = c14cs%ctrunc_vr_col(c,j) + cc14 + endif end do - end do - endif + + end do ! end of column loop + + if (use_nitrif_denitrif) then + ! remove small negative perturbations for stability purposes, if any should arise. + + do fc = 1,num_soilc + c = filter_soilc(fc) + do j = 1,nlevdecomp + if (abs(ns%smin_no3_vr_col(c,j)) < ncrit/1e4_r8) then + if ( ns%smin_no3_vr_col(c,j) < 0._r8 ) then + write(iulog, *) '-10^-12 < smin_no3 < 0. resetting to zero.' + write(iulog, *) 'smin_no3_vr_col(c,j), c, j: ', ns%smin_no3_vr_col(c,j), c, j + ns%smin_no3_vr_col(c,j) = 0._r8 + endif + end if + if (abs(ns%smin_nh4_vr_col(c,j)) < ncrit/1e4_r8) then + if ( ns%smin_nh4_vr_col(c,j) < 0._r8 ) then + write(iulog, *) '-10^-12 < smin_nh4 < 0. resetting to zero.' + write(iulog, *) 'smin_nh4_vr_col(c,j), c, j: ', ns%smin_nh4_vr_col(c,j), c, j + ns%smin_nh4_vr_col(c,j) = 0._r8 + endif + end if + end do + end do + endif + + endif ! if (.not. is_active_betr_bgc) end associate diff --git a/components/clm/src/biogeochem/CNSoilLittVertTranspMod.F90 b/components/clm/src/biogeochem/CNSoilLittVertTranspMod.F90 index 97f071738fb0..b815c49caeb8 100644 --- a/components/clm/src/biogeochem/CNSoilLittVertTranspMod.F90 +++ b/components/clm/src/biogeochem/CNSoilLittVertTranspMod.F90 @@ -438,7 +438,6 @@ subroutine CNSoilLittVertTransp(bounds, num_soilc, filter_soilc, & end do end do - else ! for CWD pools, just add do j = 1,nlevdecomp diff --git a/components/clm/src/biogeochem/CNStateType.F90 b/components/clm/src/biogeochem/CNStateType.F90 index 8b00256a114d..69a13a2f6564 100644 --- a/components/clm/src/biogeochem/CNStateType.F90 +++ b/components/clm/src/biogeochem/CNStateType.F90 @@ -135,9 +135,10 @@ module CNStateType real(r8), pointer :: tempmax_retransp_patch (:) ! patch temporary annual max of retranslocated P pool (gP/m2) real(r8), pointer :: annmax_retransp_patch (:) ! patch annual max of retranslocated P pool (gP/m2) + real(r8), pointer :: frootc_nfix_scalar_col (:) ! col scalar for nitrogen fixation + real(r8), pointer :: decomp_litpool_rcn_col (:,:,:) ! cn ratios of the decomposition pools - - integer :: CropRestYear ! restart year from initial conditions file - increment as time elapses + integer :: CropRestYear ! restart year from initial conditions file - increment as time elapses contains @@ -262,7 +263,8 @@ subroutine InitAllocate(this, bounds) allocate(this%wtlf_col (begc:endc)) ; this%wtlf_col (:) = nan allocate(this%lfwt_col (begc:endc)) ; this%lfwt_col (:) = nan allocate(this%farea_burned_col (begc:endc)) ; this%farea_burned_col (:) = nan - + allocate(this%decomp_litpool_rcn_col (begc:endc, 1:nlevdecomp_full, 4)); this%decomp_litpool_rcn_col (:,:,:) = nan + allocate(this%frootc_nfix_scalar_col (begc:endc)) ; this%frootc_nfix_scalar_col(:) = nan this%CropRestYear = 0 allocate(this%dormant_flag_patch (begp:endp)) ; this%dormant_flag_patch (:) = nan @@ -289,7 +291,7 @@ subroutine InitAllocate(this, bounds) allocate(this%tempmax_retransn_patch (begp:endp)) ; this%tempmax_retransn_patch (:) = nan allocate(this%annmax_retransn_patch (begp:endp)) ; this%annmax_retransn_patch (:) = nan allocate(this%downreg_patch (begp:endp)) ; this%downreg_patch (:) = nan - allocate(this%rc14_atm_patch (begp:endp)) ; this%rc14_atm_patch (:) = nan + allocate(this%rc14_atm_patch (begp:endp)) ; this%rc14_atm_patch (:) = nan !! add phosphorus -X.YANG diff --git a/components/clm/src/biogeochem/CNWoodProductsMod.F90 b/components/clm/src/biogeochem/CNWoodProductsMod.F90 index e3c45d8b199b..3c5768b2f3eb 100644 --- a/components/clm/src/biogeochem/CNWoodProductsMod.F90 +++ b/components/clm/src/biogeochem/CNWoodProductsMod.F90 @@ -43,10 +43,10 @@ subroutine CNWoodProducts(num_soilc, filter_soilc, & ! !ARGUMENTS: integer , intent(in) :: num_soilc ! number of soil columns in filter integer , intent(in) :: filter_soilc(:) ! filter for soil columns - type(carbonstate_type) , intent(in) :: carbonstate_vars - type(carbonstate_type) , intent(in) :: c13_carbonstate_vars - type(carbonstate_type) , intent(in) :: c14_carbonstate_vars - type(nitrogenstate_type) , intent(in) :: nitrogenstate_vars + type(carbonstate_type) , intent(inout) :: carbonstate_vars + type(carbonstate_type) , intent(inout) :: c13_carbonstate_vars + type(carbonstate_type) , intent(inout) :: c14_carbonstate_vars + type(nitrogenstate_type) , intent(inout) :: nitrogenstate_vars type(carbonflux_type) , intent(inout) :: carbonflux_vars type(carbonflux_type) , intent(inout) :: c13_carbonflux_vars type(carbonflux_type) , intent(inout) :: c14_carbonflux_vars diff --git a/components/clm/src/biogeochem/ChemStateType.F90 b/components/clm/src/biogeochem/ChemStateType.F90 new file mode 100644 index 000000000000..5865c2500087 --- /dev/null +++ b/components/clm/src/biogeochem/ChemStateType.F90 @@ -0,0 +1,65 @@ +module ChemStateType + + !------------------------------------------------------------------------------ + ! !USES: + use shr_kind_mod , only : r8 => shr_kind_r8 + use shr_log_mod , only : errMsg => shr_log_errMsg + use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) + use decompMod , only : bounds_type + use abortutils , only : endrun + + implicit none + save + private + !---------------------------------------------------- + ! column chemical state variables structure + !---------------------------------------------------- + type, public :: chemstate_type + + real(r8), pointer :: soil_pH(:,:) ! soil pH (-nlevsno+1:nlevgrnd) + + contains + procedure, public :: Init + procedure, private :: InitAllocate + end type chemstate_type + + contains + + !------------------------------------------------------------------------ + subroutine Init(this, bounds) + + class(chemstate_type) :: this + type(bounds_type), intent(in) :: bounds + + call this%InitAllocate(bounds) + + end subroutine Init + + !------------------------------------------------------------------------ + subroutine InitAllocate(this, bounds) + ! + ! !DESCRIPTION: + ! Initialize module data structure + ! + ! !USES: + use clm_varpar , only : nlevsoi + ! + ! !ARGUMENTS: + class(chemstate_type) :: this + type(bounds_type), intent(in) :: bounds + ! + ! !LOCAL VARIABLES: + integer :: begp, endp + integer :: begc, endc + integer :: begg, endg + integer :: lbj, ubj + !------------------------------------------------------------------------ + begc = bounds%begc; + endc = bounds%endc + lbj = 1; + ubj = nlevsoi + + allocate(this%soil_pH(begc:endc, lbj:ubj)) + + end subroutine InitAllocate +end module ChemStateType diff --git a/components/clm/src/biogeochem/VOCEmissionMod.F90 b/components/clm/src/biogeochem/VOCEmissionMod.F90 index f6bfb926a257..d42daf546ed0 100644 --- a/components/clm/src/biogeochem/VOCEmissionMod.F90 +++ b/components/clm/src/biogeochem/VOCEmissionMod.F90 @@ -152,7 +152,6 @@ subroutine InitAllocate(this, bounds) allocate(this%vocflx_tot_patch (begp:endp)); this%vocflx_tot_patch (:) = nan allocate(this%efisop_grc (6,begg:endg)); this%efisop_grc (:,:) = nan - allocate(meg_out(shr_megan_megcomps_n)) do i=1,shr_megan_megcomps_n allocate(meg_out(i)%flux_out(begp:endp)) @@ -324,7 +323,6 @@ subroutine InitCold(this, bounds) call getfil (fsurdat, locfn, 0) call ncd_pio_openfile (ncid, locfn, 0) - call ncd_io(ncid=ncid, varname='EF1_BTR', flag='read', data=temp_ef, dim1name=grlnd, readvar=readvar) if (.not. readvar) then call endrun(msg='iniTimeConst: errror reading EF1_BTR'//errMsg(__FILE__, __LINE__)) diff --git a/components/clm/src/biogeophys/BareGroundFluxesMod.F90 b/components/clm/src/biogeophys/BareGroundFluxesMod.F90 index 04f2b559b922..d75c13081bec 100644 --- a/components/clm/src/biogeophys/BareGroundFluxesMod.F90 +++ b/components/clm/src/biogeophys/BareGroundFluxesMod.F90 @@ -177,7 +177,6 @@ subroutine BareGroundFluxes(bounds, num_nolakeurbanp, filter_nolakeurbanp, & qflx_ev_h2osfc => waterflux_vars%qflx_ev_h2osfc_patch , & ! Output: [real(r8) (:) ] evaporation flux from h2osfc (W/m**2) [+ to atm] qflx_evap_soi => waterflux_vars%qflx_evap_soi_patch , & ! Output: [real(r8) (:) ] soil evaporation (mm H2O/s) (+ = to atm) qflx_evap_tot => waterflux_vars%qflx_evap_tot_patch , & ! Output: [real(r8) (:) ] qflx_evap_soi + qflx_evap_can + qflx_tran_veg - begp => bounds%begp , & endp => bounds%endp & ) diff --git a/components/clm/src/biogeophys/CanopyFluxesMod.F90 b/components/clm/src/biogeophys/CanopyFluxesMod.F90 index d791cf895cf4..640776218cad 100644 --- a/components/clm/src/biogeophys/CanopyFluxesMod.F90 +++ b/components/clm/src/biogeophys/CanopyFluxesMod.F90 @@ -100,7 +100,7 @@ subroutine CanopyFluxes(bounds, num_nolakeurbanp, filter_nolakeurbanp, & ! ! !USES: use shr_const_mod , only : SHR_CONST_TKFRZ, SHR_CONST_RGAS - use clm_time_manager , only : get_step_size, get_prev_date + use clm_time_manager , only : get_step_size, get_prev_date, get_nstep use clm_varcon , only : sb, cpair, hvap, vkc, grav, denice use clm_varcon , only : denh2o, tfrz, csoilc, tlsai_crit, alpha_aero use clm_varcon , only : isecspday, degpsec @@ -110,6 +110,7 @@ subroutine CanopyFluxes(bounds, num_nolakeurbanp, filter_nolakeurbanp, & use QSatMod , only : QSat use FrictionVelocityMod, only : FrictionVelocity, MoninObukIni use SoilWaterRetentionCurveMod, only : soil_water_retention_curve_type + use SurfaceResistanceMod, only : getlblcef ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds @@ -341,6 +342,7 @@ subroutine CanopyFluxes(bounds, num_nolakeurbanp, filter_nolakeurbanp, & sabv => solarabs_vars%sabv_patch , & ! Input: [real(r8) (:) ] solar radiation absorbed by vegetation (W/m**2) + lbl_rsc_h2o => canopystate_vars%lbl_rsc_h2o_patch , & ! Output: [real(r8) (:) ] laminar boundary layer resistance for h2o frac_veg_nosno => canopystate_vars%frac_veg_nosno_patch , & ! Input: [integer (:) ] fraction of vegetation not covered by snow (0 OR 1) [-] elai => canopystate_vars%elai_patch , & ! Input: [real(r8) (:) ] one-sided leaf area index with burying by snow esai => canopystate_vars%esai_patch , & ! Input: [real(r8) (:) ] one-sided stem area index with burying by snow @@ -456,6 +458,7 @@ subroutine CanopyFluxes(bounds, num_nolakeurbanp, filter_nolakeurbanp, & cf_bare = forc_pbot(c)/(SHR_CONST_RGAS*0.001_r8*thm(p))*1.e06_r8 rssun(p) = 1._r8/1.e15_r8 * cf_bare rssha(p) = 1._r8/1.e15_r8 * cf_bare + lbl_rsc_h2o(p)=0._r8 do j = 1, nlevgrnd rootr(p,j) = 0._r8 rresis(p,j) = 0._r8 @@ -746,6 +749,7 @@ subroutine CanopyFluxes(bounds, num_nolakeurbanp, filter_nolakeurbanp, & ! Bulk boundary layer resistance of leaves uaf(p) = um(p)*sqrt( 1._r8/(ram1(p)*um(p)) ) + cf = 0.01_r8/(sqrt(uaf(p))*sqrt(dleaf(pft%itype(p)))) rb(p) = 1._r8/(cf*uaf(p)) rb1(p) = rb(p) @@ -1084,6 +1088,11 @@ subroutine CanopyFluxes(bounds, num_nolakeurbanp, filter_nolakeurbanp, & end do ! end of filtered pft loop + do f = 1, fn + p = filterp(f) + lbl_rsc_h2o(p) = getlblcef(forc_rho(c),t_veg(p))*uaf(p)/(uaf(p)**2._r8+1.e-10_r8) !laminar boundary resistance for h2o over leaf, should I make this consistent for latent heat calculation? + enddo + ! Test for convergence itlef = itlef+1 diff --git a/components/clm/src/biogeophys/CanopyHydrologyMod.F90 b/components/clm/src/biogeophys/CanopyHydrologyMod.F90 index 06691d00a5e7..80ae4411ffef 100644 --- a/components/clm/src/biogeophys/CanopyHydrologyMod.F90 +++ b/components/clm/src/biogeophys/CanopyHydrologyMod.F90 @@ -569,7 +569,7 @@ subroutine CanopyHydrology(bounds, & ! update surface water fraction (this may modify frac_sno) call FracH2oSfc(bounds, num_nolakec, filter_nolakec, & - waterstate_vars) + waterstate_vars, waterflux_vars%qflx_h2osfc2topsoi_col) end associate @@ -633,7 +633,7 @@ end subroutine FracWet !----------------------------------------------------------------------- subroutine FracH2OSfc(bounds, num_h2osfc, filter_h2osfc, & - waterstate_vars, no_update) + waterstate_vars, qflx_h2osfc2topsoi, no_update) ! ! !DESCRIPTION: ! Determine fraction of land surfaces which are submerged @@ -643,12 +643,14 @@ subroutine FracH2OSfc(bounds, num_h2osfc, filter_h2osfc, & use shr_const_mod , only : shr_const_pi use shr_spfn_mod , only : erf => shr_spfn_erf use landunit_varcon , only : istsoil, istcrop + use clm_time_manager , only : get_step_size ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds integer , intent(in) :: num_h2osfc ! number of column points in column filter integer , intent(in) :: filter_h2osfc(:) ! column filter type(waterstate_type) , intent(inout) :: waterstate_vars + real(r8) , intent(inout) :: qflx_h2osfc2topsoi(bounds%begc:bounds%endc) integer , intent(in), optional :: no_update ! flag to make calculation w/o updating variables ! ! !LOCAL VARIABLES: @@ -656,6 +658,7 @@ subroutine FracH2OSfc(bounds, num_h2osfc, filter_h2osfc, & real(r8):: d,fd,dfdd ! temporary variable for frac_h2oscs iteration real(r8):: sigma ! microtopography pdf sigma in mm real(r8):: min_h2osfc + real(r8):: dtime !----------------------------------------------------------------------- associate( & @@ -670,13 +673,14 @@ subroutine FracH2OSfc(bounds, num_h2osfc, filter_h2osfc, & frac_h2osfc => waterstate_vars%frac_h2osfc_col & ! Output: [real(r8) (:) ] col fractional area with surface water greater than zero ) + dtime=get_step_size() ! arbitrary lower limit on h2osfc for safer numerics... min_h2osfc=1.e-8_r8 do f = 1, num_h2osfc c = filter_h2osfc(f) l = col%landunit(c) - + qflx_h2osfc2topsoi(c) = 0._r8 ! h2osfc only calculated for soil vegetated land units if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then @@ -703,6 +707,7 @@ subroutine FracH2OSfc(bounds, num_h2osfc, filter_h2osfc, & else frac_h2osfc(c) = 0._r8 h2osoi_liq(c,1) = h2osoi_liq(c,1) + h2osfc(c) + qflx_h2osfc2topsoi(c) = h2osfc(c)/dtime h2osfc(c)=0._r8 endif diff --git a/components/clm/src/biogeophys/CanopyStateType.F90 b/components/clm/src/biogeophys/CanopyStateType.F90 index 5465697591c4..d03fc535793a 100644 --- a/components/clm/src/biogeophys/CanopyStateType.F90 +++ b/components/clm/src/biogeophys/CanopyStateType.F90 @@ -54,6 +54,7 @@ module CanopyStateType real(r8) , pointer :: rscanopy_patch (:) ! patch canopy stomatal resistance (s/m) (ED specific) + real(r8), pointer :: lbl_rsc_h2o_patch (:) ! laminar boundary layer resistance for water over dry leaf (s/m) contains procedure, public :: Init @@ -134,6 +135,7 @@ subroutine InitAllocate(this, bounds) allocate(this%dewmx_patch (begp:endp)) ; this%dewmx_patch (:) = nan allocate(this%rscanopy_patch (begp:endp)) ; this%rscanopy_patch (:) = nan + allocate(this%lbl_rsc_h2o_patch (begp:endp)) ; this%lbl_rsc_h2o_patch (:) = nan end subroutine InitAllocate diff --git a/components/clm/src/biogeophys/HydrologyDrainageMod.F90 b/components/clm/src/biogeophys/HydrologyDrainageMod.F90 index 7f86daa4c0e3..1abb4b26d698 100644 --- a/components/clm/src/biogeophys/HydrologyDrainageMod.F90 +++ b/components/clm/src/biogeophys/HydrologyDrainageMod.F90 @@ -45,10 +45,11 @@ subroutine HydrologyDrainage(bounds, & use landunit_varcon , only : istice, istwet, istsoil, istice_mec, istcrop use column_varcon , only : icol_roof, icol_road_imperv, icol_road_perv, icol_sunwall, icol_shadewall use clm_varcon , only : denh2o, denice, secspday - use clm_varctl , only : glc_snow_persistence_max_days, use_vichydro - use clm_varpar , only : nlevgrnd, nlevurb + use clm_varctl , only : glc_snow_persistence_max_days, use_vichydro, use_betr + use clm_varpar , only : nlevgrnd, nlevurb, nlevsoi use clm_time_manager , only : get_step_size, get_nstep use SoilHydrologyMod , only : CLMVICMap, Drainage + use TracerParamsMod , only : pre_diagnose_soilcol_water_flux, diagnose_drainage_water_flux ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds @@ -122,11 +123,21 @@ subroutine HydrologyDrainage(bounds, & soilhydrology_vars, waterstate_vars) endif + if (use_betr) then + call pre_diagnose_soilcol_water_flux(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, filter_urbanc, & + h2osoi_liq(bounds%begc:bounds%endc, 1:nlevsoi)) + endif + call Drainage(bounds, num_hydrologyc, filter_hydrologyc, & num_urbanc, filter_urbanc,& temperature_vars, soilhydrology_vars, soilstate_vars, & waterstate_vars, waterflux_vars) + if (use_betr) then + call diagnose_drainage_water_flux(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, filter_urbanc, & + h2osoi_liq(bounds%begc:bounds%endc, 1:nlevsoi), waterflux_vars) + endif + do j = 1, nlevgrnd do fc = 1, num_nolakec c = filter_nolakec(fc) diff --git a/components/clm/src/biogeophys/HydrologyNoDrainageMod.F90 b/components/clm/src/biogeophys/HydrologyNoDrainageMod.F90 index 220096bbc1d3..5d7f73276e80 100644 --- a/components/clm/src/biogeophys/HydrologyNoDrainageMod.F90 +++ b/components/clm/src/biogeophys/HydrologyNoDrainageMod.F90 @@ -40,7 +40,7 @@ subroutine HydrologyNoDrainage(bounds, & atm2lnd_vars, soilstate_vars, energyflux_vars, temperature_vars, & waterflux_vars, waterstate_vars, & soilhydrology_vars, aerosol_vars, & - soil_water_retention_curve) + soil_water_retention_curve, betrtracer_vars, tracerflux_vars, tracerstate_vars) ! ! !DESCRIPTION: ! This is the main subroutine to execute the calculation of soil/snow @@ -61,7 +61,7 @@ subroutine HydrologyNoDrainage(bounds, & use landunit_varcon , only : istice, istwet, istsoil, istice_mec, istcrop, istdlak use column_varcon , only : icol_roof, icol_road_imperv, icol_road_perv, icol_sunwall use column_varcon , only : icol_shadewall - use clm_varctl , only : use_cn + use clm_varctl , only : use_cn, use_betr use clm_varpar , only : nlevgrnd, nlevsno, nlevsoi, nlevurb use clm_time_manager , only : get_step_size, get_nstep use SnowHydrologyMod , only : SnowCompaction, CombineSnowLayers, DivideSnowLayers @@ -69,6 +69,11 @@ subroutine HydrologyNoDrainage(bounds, & use SoilHydrologyMod , only : CLMVICMap, SurfaceRunoff, Infiltration, WaterTable use SoilWaterMovementMod , only : SoilWater use SoilWaterRetentionCurveMod, only : soil_water_retention_curve_type + use TracerParamsMod , only : pre_diagnose_soilcol_water_flux, diagnose_advect_water_flux, calc_smp_l + use BetrBGCMod , only : calc_dew_sub_flux + use tracerfluxType , only : tracerflux_type + use tracerstatetype , only : tracerstate_type + use BeTRTracerType , only : betrtracer_type ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds @@ -91,6 +96,9 @@ subroutine HydrologyNoDrainage(bounds, & type(aerosol_type) , intent(inout) :: aerosol_vars type(soilhydrology_type) , intent(inout) :: soilhydrology_vars class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve + type(betrtracer_type) , intent(in) :: betrtracer_vars ! betr configuration information + type(tracerflux_type) , intent(inout) :: tracerflux_vars ! tracer flux + type(tracerstate_type) , intent(inout) :: tracerstate_vars ! tracer state variables data structure ! ! !LOCAL VARIABLES: integer :: g,l,c,j,fc ! indices @@ -142,6 +150,10 @@ subroutine HydrologyNoDrainage(bounds, & h2osno_top => waterstate_vars%h2osno_top_col , & ! Output: [real(r8) (:) ] mass of snow in top layer (col) [kg] wf => waterstate_vars%wf_col , & ! Output: [real(r8) (:) ] soil water as frac. of whc for top 0.05 m wf2 => waterstate_vars%wf2_col , & ! Output: [real(r8) (:) ] soil water as frac. of whc for top 0.17 m + h2osoi_liqvol => waterstate_vars%h2osoi_liqvol_col , & ! Output: [real(r8) (:,:) ] volumetric liquid water content + h2osoi_icevol => waterstate_vars%h2osoi_icevol_col , & ! Output: [real(r8) (:,:) ] volumetric liquid water content + air_vol => waterstate_vars%air_vol_col , & ! Output: [real(r8) (:,:) ] volumetric air porosity + eff_porosity => soilstate_vars%eff_porosity_col , & ! Output: [real(r8) (:,:) ] effective soil porosity watsat => soilstate_vars%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) sucsat => soilstate_vars%sucsat_col , & ! Input: [real(r8) (:,:) ] minimum soil suction (mm) @@ -161,11 +173,14 @@ subroutine HydrologyNoDrainage(bounds, & call BuildSnowFilter(bounds, num_nolakec, filter_nolakec, & num_snowc, filter_snowc, num_nosnowc, filter_nosnowc) + ! Determine the change of snow mass and the snow water onto soil call SnowWater(bounds, num_snowc, filter_snowc, num_nosnowc, filter_nosnowc, & atm2lnd_vars, waterflux_vars, waterstate_vars, aerosol_vars) + + ! mapping soilmoist from CLM to VIC layers for runoff calculations if (use_vichydro) then call CLMVICMap(bounds, num_hydrologyc, filter_hydrologyc, & @@ -179,10 +194,25 @@ subroutine HydrologyNoDrainage(bounds, & energyflux_vars, soilhydrology_vars, soilstate_vars, temperature_vars, & waterflux_vars, waterstate_vars) + if (use_betr) then + call pre_diagnose_soilcol_water_flux(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, filter_urbanc, & + waterstate_vars%h2osoi_liq_col(bounds%begc:bounds%endc, 1:nlevsoi)) + endif + call SoilWater(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, filter_urbanc, & soilhydrology_vars, soilstate_vars, waterflux_vars, waterstate_vars, temperature_vars, & soil_water_retention_curve) - + + if (use_betr) then + call diagnose_advect_water_flux(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, filter_urbanc, & + waterstate_vars%h2osoi_liq_col(bounds%begc:bounds%endc, 1:nlevsoi), & + soilhydrology_vars%qcharge_col(bounds%begc:bounds%endc), waterflux_vars) + + call calc_smp_l(bounds, 1, nlevgrnd, num_hydrologyc, filter_hydrologyc, & + temperature_vars%t_soisno_col(bounds%begc:bounds%endc, 1:nlevgrnd), & + soilstate_vars, waterstate_vars, soil_water_retention_curve) + endif + if (use_vichydro) then ! mapping soilmoist from CLM to VIC layers for runoff calculations call CLMVICMap(bounds, num_hydrologyc, filter_hydrologyc, & @@ -192,6 +222,12 @@ subroutine HydrologyNoDrainage(bounds, & call WaterTable(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, filter_urbanc, & soilhydrology_vars, soilstate_vars, temperature_vars, waterstate_vars, waterflux_vars) + if (use_betr) then + !apply dew and sublimation fluxes, this is a temporary work aroud for tracking water isotope + !Jinyun Tang, Feb 4, 2015 + call calc_dew_sub_flux(bounds, num_hydrologyc, filter_hydrologyc, & + waterstate_vars, waterflux_vars, betrtracer_vars, tracerflux_vars, tracerstate_vars) + endif ! Natural compaction and metamorphosis. call SnowCompaction(bounds, num_snowc, filter_snowc, & temperature_vars, waterstate_vars) @@ -343,6 +379,11 @@ subroutine HydrologyNoDrainage(bounds, & .or. ctype(c) == icol_roof) .and. j > nlevurb) then else h2osoi_vol(c,j) = h2osoi_liq(c,j)/(dz(c,j)*denh2o) + h2osoi_ice(c,j)/(dz(c,j)*denice) + h2osoi_liqvol(c,j) = h2osoi_liq(c,j)/(dz(c,j)*denh2o) + h2osoi_icevol(c,j) = h2osoi_ice(c,j)/(dz(c,j)*denice) + air_vol(c,j) = max(1.e-4_r8,watsat(c,j) - h2osoi_vol(c,j)) + eff_porosity(c,j) = max(0.01_r8,watsat(c,j) - h2osoi_ice(c,j)/(dz(c,j)*denice)) + end if end do end do @@ -373,22 +414,6 @@ subroutine HydrologyNoDrainage(bounds, & end do end if - ! Update smp_l for history and for ch4Mod. - ! ZMS: Note, this form, which seems to be the same as used in SoilWater, DOES NOT distinguish between - ! ice and water volume, in contrast to the soilpsi calculation above. It won't be used in ch4Mod if - ! t_soisno <= tfrz, though. - do j = 1, nlevgrnd - do fc = 1, num_hydrologyc - c = filter_hydrologyc(fc) - - s_node = max(h2osoi_vol(c,j)/watsat(c,j), 0.01_r8) - s_node = min(1.0_r8, s_node) - - smp_l(c,j) = -sucsat(c,j)*s_node**(-bsw(c,j)) - smp_l(c,j) = max(smpmin(c), smp_l(c,j)) - end do - end do - if (use_cn) then ! Available soil water up to a depth of 0.05 m. ! Potentially available soil water (=whc) up to a depth of 0.05 m. diff --git a/components/clm/src/biogeophys/QSatMod.F90 b/components/clm/src/biogeophys/QSatMod.F90 index 53e690e4631c..0dc61b4f3a53 100644 --- a/components/clm/src/biogeophys/QSatMod.F90 +++ b/components/clm/src/biogeophys/QSatMod.F90 @@ -5,41 +5,16 @@ module QSatMod ! Computes saturation mixing ratio and the change in saturation ! ! !PUBLIC TYPES: + use shr_kind_mod , only: r8 => shr_kind_r8 implicit none save + private ! ! !PUBLIC MEMBER FUNCTIONS: public :: QSat + public :: rhoSat !----------------------------------------------------------------------- -contains - - !----------------------------------------------------------------------- - subroutine QSat (T, p, es, esdT, qs, qsdT) - ! - ! !DESCRIPTION: - ! Computes saturation mixing ratio and the change in saturation - ! mixing ratio with respect to temperature. - ! Reference: Polynomial approximations from: - ! Piotr J. Flatau, et al.,1992: Polynomial fits to saturation - ! vapor pressure. Journal of Applied Meteorology, 31, 1507-1513. - ! - ! !USES: - use shr_kind_mod , only: r8 => shr_kind_r8 - use shr_const_mod, only: SHR_CONST_TKFRZ - ! - ! !ARGUMENTS: - implicit none - real(r8), intent(in) :: T ! temperature (K) - real(r8), intent(in) :: p ! surface atmospheric pressure (pa) - real(r8), intent(out) :: es ! vapor pressure (pa) - real(r8), intent(out) :: esdT ! d(es)/d(T) - real(r8), intent(out) :: qs ! humidity (kg/kg) - real(r8), intent(out) :: qsdT ! d(qs)/d(T) - ! - ! !LOCAL VARIABLES: - real(r8) :: T_limit - real(r8) :: td,vp,vp1,vp2 ! For water vapor (temperature range 0C-100C) real(r8), parameter :: a0 = 6.11213476_r8 real(r8), parameter :: a1 = 0.444007856_r8 @@ -79,7 +54,37 @@ subroutine QSat (T, p, es, esdT, qs, qsdT) real(r8), parameter :: d5 = 0.257180651e-08_r8 real(r8), parameter :: d6 = 0.133268878e-10_r8 real(r8), parameter :: d7 = 0.394116744e-13_r8 - real(r8), parameter :: d8 = 0.498070196e-16_r8 + real(r8), parameter :: d8 = 0.498070196e-16_r8 +contains + + + + !----------------------------------------------------------------------- + subroutine QSat (T, p, es, esdT, qs, qsdT) + ! + ! !DESCRIPTION: + ! Computes saturation mixing ratio and the change in saturation + ! mixing ratio with respect to temperature. + ! Reference: Polynomial approximations from: + ! Piotr J. Flatau, et al.,1992: Polynomial fits to saturation + ! vapor pressure. Journal of Applied Meteorology, 31, 1507-1513. + ! + ! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + use shr_const_mod, only: SHR_CONST_TKFRZ + ! + ! !ARGUMENTS: + implicit none + real(r8), intent(in) :: T ! temperature (K) + real(r8), intent(in) :: p ! surface atmospheric pressure (pa) + real(r8), intent(out) :: es ! vapor pressure (pa) + real(r8), intent(out) :: esdT ! d(es)/d(T) + real(r8), intent(out) :: qs ! humidity (kg/kg) + real(r8), intent(out) :: qsdT ! d(qs)/d(T) + ! + ! !LOCAL VARIABLES: + real(r8) :: T_limit + real(r8) :: td,vp,vp1,vp2 !----------------------------------------------------------------------- T_limit = T - SHR_CONST_TKFRZ @@ -90,18 +95,24 @@ subroutine QSat (T, p, es, esdT, qs, qsdT) if (td >= 0.0_r8) then es = a0 + td*(a1 + td*(a2 + td*(a3 + td*(a4 & + td*(a5 + td*(a6 + td*(a7 + td*a8))))))) - esdT = b0 + td*(b1 + td*(b2 + td*(b3 + td*(b4 & + + esdT = b0 + td*(b1 + td*(b2 + td*(b3 + td*(b4 & + td*(b5 + td*(b6 + td*(b7 + td*b8))))))) + else es = c0 + td*(c1 + td*(c2 + td*(c3 + td*(c4 & + td*(c5 + td*(c6 + td*(c7 + td*c8))))))) + esdT = d0 + td*(d1 + td*(d2 + td*(d3 + td*(d4 & + td*(d5 + td*(d6 + td*(d7 + td*d8))))))) + endif es = es * 100._r8 ! pa + esdT = esdT * 100._r8 ! pa/K + vp = 1.0_r8 / (p - 0.378_r8*es) vp1 = 0.622_r8 * vp vp2 = vp1 * vp @@ -109,6 +120,50 @@ subroutine QSat (T, p, es, esdT, qs, qsdT) qs = es * vp1 ! kg/kg qsdT = esdT * vp2 * p ! 1 / K + end subroutine QSat + + +!------------------------------------------------------------------------------- + subroutine rhoSat(T, rho, rhodT) + ! compute the saturated vapor pressure density and its derivative against the temperature + ! jyt + use clm_varcon, only: rwat + use shr_const_mod, only: SHR_CONST_TKFRZ + + implicit none + real(r8) , intent(in) :: T + real(r8) , intent(out) :: rho + real(r8), optional , intent(out) :: rhodT + + + !------------------ + + real(r8) :: T_limit + real(r8) :: td, es, esdT + + T_limit = T - SHR_CONST_TKFRZ + if (T_limit > 100.0_r8) T_limit=100.0_r8 + if (T_limit < -75.0_r8) T_limit=-75.0_r8 + + td = T_limit + if (td >= 0.0_r8) then + es = a0 + td*(a1 + td*(a2 + td*(a3 + td*(a4 & + + td*(a5 + td*(a6 + td*(a7 + td*a8))))))) + esdT = b0 + td*(b1 + td*(b2 + td*(b3 + td*(b4 & + + td*(b5 + td*(b6 + td*(b7 + td*b8))))))) + else + es = c0 + td*(c1 + td*(c2 + td*(c3 + td*(c4 & + + td*(c5 + td*(c6 + td*(c7 + td*c8))))))) + esdT = d0 + td*(d1 + td*(d2 + td*(d3 + td*(d4 & + + td*(d5 + td*(d6 + td*(d7 + td*d8))))))) + endif + + es = es * 100._r8 ! pa + rho = es/(rwat*T) !kg m^-3 + + if(present(rhodT)) rhodT= esdT/(rwat*T)-rho/T !kg m^-3 K^-1 + + end subroutine rhoSat end module QSatMod diff --git a/components/clm/src/biogeophys/SnowHydrologyMod.F90 b/components/clm/src/biogeophys/SnowHydrologyMod.F90 index 89164a0eb550..fa2f0f408190 100644 --- a/components/clm/src/biogeophys/SnowHydrologyMod.F90 +++ b/components/clm/src/biogeophys/SnowHydrologyMod.F90 @@ -590,6 +590,7 @@ subroutine CombineSnowLayers(bounds, num_snowc, filter_snowc, & use landunit_varcon , only : istsoil, istdlak, istsoil, istwet, istice, istice_mec, istcrop use LakeCon , only : lsadz use clm_time_manager , only : get_step_size + use clm_varcon , only : denh2o ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds @@ -641,6 +642,7 @@ subroutine CombineSnowLayers(bounds, num_snowc, filter_snowc, & snw_rds => waterstate_vars%snw_rds_col , & ! Output: [real(r8) (:,:) ] effective snow grain radius (col,lyr) [microns, m^-6] qflx_sl_top_soil => waterflux_vars%qflx_sl_top_soil_col , & ! Output: [real(r8) (:) ] liquid water + ice from layer above soil to top soil layer or sent to qflx_qrgwl (mm H2O/s) + qflx_snow2topsoi => waterflux_vars%qflx_snow2topsoi_col , & ! Output: [real(r8) (:) ] liquid water merged into top soil from snow snl => col%snl , & ! Output: [integer (:) ] number of snow layers dz => col%dz , & ! Output: [real(r8) (:,:) ] layer depth (m) @@ -673,6 +675,7 @@ subroutine CombineSnowLayers(bounds, num_snowc, filter_snowc, & msn_old(c) = snl(c) qflx_sl_top_soil(c) = 0._r8 + qflx_snow2topsoi(c) = 0._r8 end do ! The following loop is NOT VECTORIZED @@ -807,6 +810,7 @@ subroutine CombineSnowLayers(bounds, num_snowc, filter_snowc, & if (ltype(l) == istsoil .or. urbpoi(l) .or. ltype(l) == istcrop) then h2osoi_liq(c,0) = 0.0_r8 h2osoi_liq(c,1) = h2osoi_liq(c,1) + zwliq(c) + qflx_snow2topsoi(c) = zwliq(c)/dtime end if if (ltype(l) == istwet) then h2osoi_liq(c,0) = 0.0_r8 diff --git a/components/clm/src/biogeophys/SoilHydrologyMod.F90 b/components/clm/src/biogeophys/SoilHydrologyMod.F90 index eb4f157f5099..d55e2cbd3b57 100644 --- a/components/clm/src/biogeophys/SoilHydrologyMod.F90 +++ b/components/clm/src/biogeophys/SoilHydrologyMod.F90 @@ -303,51 +303,53 @@ subroutine Infiltration(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, f real(r8) :: top_icefrac ! temporary, ice fraction in top VIC layers !----------------------------------------------------------------------- - associate( & - snl => col%snl , & ! Input: [integer (:) ] minus number of snow layers - dz => col%dz , & ! Input: [real(r8) (:,:) ] layer depth (m) - - t_soisno => temperature_vars%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) - - frac_h2osfc => waterstate_vars%frac_h2osfc_col , & ! Input: [real(r8) (:) ] fraction of ground covered by surface water (0 to 1) - frac_sno => waterstate_vars%frac_sno_eff_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) - h2osoi_ice => waterstate_vars%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens (kg/m2) - h2osoi_liq => waterstate_vars%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water (kg/m2) - h2osno => waterstate_vars%h2osno_col , & ! Input: [real(r8) (:) ] snow water (mm H2O) - snow_depth => waterstate_vars%snow_depth_col , & ! Input: [real(r8) (:) ] snow height (m) - h2osfc => waterstate_vars%h2osfc_col , & ! Output: [real(r8) (:) ] surface water (mm) - - qflx_ev_soil => waterflux_vars%qflx_ev_soil_col , & ! Input: [real(r8) (:) ] evaporation flux from soil (W/m**2) [+ to atm] - qflx_evap_soi => waterflux_vars%qflx_evap_soi_col , & ! Input: [real(r8) (:) ] ground surface evaporation rate (mm H2O/s) [+] - qflx_evap_grnd => waterflux_vars%qflx_evap_grnd_col , & ! Input: [real(r8) (:) ] ground surface evaporation rate (mm H2O/s) [+] - qflx_top_soil => waterflux_vars%qflx_top_soil_col , & ! Input: [real(r8) (:) ] net water input into soil from top (mm/s) - qflx_ev_h2osfc => waterflux_vars%qflx_ev_h2osfc_col , & ! Input: [real(r8) (:) ] evaporation flux from h2osfc (W/m**2) [+ to atm] - qflx_surf => waterflux_vars%qflx_surf_col , & ! Output: [real(r8) (:) ] surface runoff (mm H2O /s) - qflx_h2osfc_surf => waterflux_vars%qflx_h2osfc_surf_col , & ! Output: [real(r8) (:) ] surface water runoff (mm/s) - qflx_infl => waterflux_vars%qflx_infl_col , & ! Output: [real(r8) (:) ] infiltration (mm H2O /s) - - smpmin => soilstate_vars%smpmin_col , & ! Input: [real(r8) (:) ] restriction for min of soil potential (mm) - sucsat => soilstate_vars%sucsat_col , & ! Input: [real(r8) (:,:) ] minimum soil suction (mm) - watsat => soilstate_vars%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) - bsw => soilstate_vars%bsw_col , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b" - hksat => soilstate_vars%hksat_col , & ! Input: [real(r8) (:,:) ] hydraulic conductivity at saturation (mm H2O /s) - eff_porosity => soilstate_vars%eff_porosity_col , & ! Output: [real(r8) (:,:) ] effective porosity = porosity - vol_ice - - h2osfc_thresh => soilhydrology_vars%h2osfc_thresh_col, & ! Input: [real(r8) (:) ] level at which h2osfc "percolates" - zwt => soilhydrology_vars%zwt_col , & ! Input: [real(r8) (:) ] water table depth (m) - zwt_perched => soilhydrology_vars%zwt_perched_col , & ! Input: [real(r8) (:) ] perched water table depth (m) - fcov => soilhydrology_vars%fcov_col , & ! Input: [real(r8) (:) ] fractional area with water table at surface - b_infil => soilhydrology_vars%b_infil_col , & ! Input: [real(r8) (:) ] VIC b infiltration parameter - frost_table => soilhydrology_vars%frost_table_col , & ! Input: [real(r8) (:) ] frost table depth (m) - fsat => soilhydrology_vars%fsat_col , & ! Input: [real(r8) (:) ] fractional area with water table at surface - moist => soilhydrology_vars%moist_col , & ! Input: [real(r8) (:,:) ] soil moisture in each VIC layers (liq, mm) - max_moist => soilhydrology_vars%max_moist_col , & ! Input: [real(r8) (:,:) ] maximum soil moisture (ice + liq, mm) - max_infil => soilhydrology_vars%max_infil_col , & ! Input: [real(r8) (:) ] maximum infiltration capacity in VIC (mm) - ice => soilhydrology_vars%ice_col , & ! Input: [real(r8) (:,:) ] ice len in each VIC layers(ice, mm) - i_0 => soilhydrology_vars%i_0_col , & ! Input: [real(r8) (:) ] column average soil moisture in top VIC layers (mm) - h2osfcflag => soilhydrology_vars%h2osfcflag , & ! Input: logical - icefrac => soilhydrology_vars%icefrac_col & ! Output: [real(r8) (:,:) ] fraction of ice - ) + associate( & + snl => col%snl , & ! Input: [integer (:) ] minus number of snow layers + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer depth (m) + + t_soisno => temperature_vars%t_soisno_col , & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) + + frac_h2osfc => waterstate_vars%frac_h2osfc_col , & ! Input: [real(r8) (:) ] fraction of ground covered by surface water (0 to 1) + frac_sno => waterstate_vars%frac_sno_eff_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) + h2osoi_ice => waterstate_vars%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens (kg/m2) + h2osoi_liq => waterstate_vars%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water (kg/m2) + h2osno => waterstate_vars%h2osno_col , & ! Input: [real(r8) (:) ] snow water (mm H2O) + snow_depth => waterstate_vars%snow_depth_col , & ! Input: [real(r8) (:) ] snow height (m) + h2osfc => waterstate_vars%h2osfc_col , & ! Output: [real(r8) (:) ] surface water (mm) + + qflx_ev_soil => waterflux_vars%qflx_ev_soil_col , & ! Input: [real(r8) (:) ] evaporation flux from soil (W/m**2) [+ to atm] + qflx_evap_soi => waterflux_vars%qflx_evap_soi_col , & ! Input: [real(r8) (:) ] ground surface evaporation rate (mm H2O/s) [+] + qflx_evap_grnd => waterflux_vars%qflx_evap_grnd_col , & ! Input: [real(r8) (:) ] ground surface evaporation rate (mm H2O/s) [+] + qflx_top_soil => waterflux_vars%qflx_top_soil_col , & ! Input: [real(r8) (:) ] net water input into soil from top (mm/s) + qflx_ev_h2osfc => waterflux_vars%qflx_ev_h2osfc_col , & ! Input: [real(r8) (:) ] evaporation flux from h2osfc (W/m**2) [+ to atm] + qflx_surf => waterflux_vars%qflx_surf_col , & ! Output: [real(r8) (:) ] surface runoff (mm H2O /s) + qflx_h2osfc_surf => waterflux_vars%qflx_h2osfc_surf_col , & ! Output: [real(r8) (:) ] surface water runoff (mm/s) + qflx_infl => waterflux_vars%qflx_infl_col , & ! Output: [real(r8) (:) ] infiltration (mm H2O /s) + qflx_gross_infl_soil => waterflux_vars%qflx_gross_infl_soil_col , & ! Output: [real(r8) (:)] gross infiltration (mm H2O/s) + qflx_gross_evap_soil => waterflux_vars%qflx_gross_evap_soil_col , & ! Output: [real(r8) (:)] gross evaporation (mm H2O/s) + + smpmin => soilstate_vars%smpmin_col , & ! Input: [real(r8) (:) ] restriction for min of soil potential (mm) + sucsat => soilstate_vars%sucsat_col , & ! Input: [real(r8) (:,:) ] minimum soil suction (mm) + watsat => soilstate_vars%watsat_col , & ! Input: [real(r8) (:,:) ] volumetric soil water at saturation (porosity) + bsw => soilstate_vars%bsw_col , & ! Input: [real(r8) (:,:) ] Clapp and Hornberger "b" + hksat => soilstate_vars%hksat_col , & ! Input: [real(r8) (:,:) ] hydraulic conductivity at saturation (mm H2O /s) + eff_porosity => soilstate_vars%eff_porosity_col , & ! Output: [real(r8) (:,:) ] effective porosity = porosity - vol_ice + + h2osfc_thresh => soilhydrology_vars%h2osfc_thresh_col , & ! Input: [real(r8) (:) ] level at which h2osfc "percolates" + zwt => soilhydrology_vars%zwt_col , & ! Input: [real(r8) (:) ] water table depth (m) + zwt_perched => soilhydrology_vars%zwt_perched_col , & ! Input: [real(r8) (:) ] perched water table depth (m) + fcov => soilhydrology_vars%fcov_col , & ! Input: [real(r8) (:) ] fractional area with water table at surface + b_infil => soilhydrology_vars%b_infil_col , & ! Input: [real(r8) (:) ] VIC b infiltration parameter + frost_table => soilhydrology_vars%frost_table_col , & ! Input: [real(r8) (:) ] frost table depth (m) + fsat => soilhydrology_vars%fsat_col , & ! Input: [real(r8) (:) ] fractional area with water table at surface + moist => soilhydrology_vars%moist_col , & ! Input: [real(r8) (:,:) ] soil moisture in each VIC layers (liq, mm) + max_moist => soilhydrology_vars%max_moist_col , & ! Input: [real(r8) (:,:) ] maximum soil moisture (ice + liq, mm) + max_infil => soilhydrology_vars%max_infil_col , & ! Input: [real(r8) (:) ] maximum infiltration capacity in VIC (mm) + ice => soilhydrology_vars%ice_col , & ! Input: [real(r8) (:,:) ] ice len in each VIC layers(ice, mm) + i_0 => soilhydrology_vars%i_0_col , & ! Input: [real(r8) (:) ] column average soil moisture in top VIC layers (mm) + h2osfcflag => soilhydrology_vars%h2osfcflag , & ! Input: logical + icefrac => soilhydrology_vars%icefrac_col & ! Output: [real(r8) (:,:) ] fraction of ice + ) dtime = get_step_size() @@ -380,11 +382,19 @@ subroutine Infiltration(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, f !1. partition surface inputs between soil and h2osfc qflx_in_soil(c) = (1._r8 - frac_h2osfc(c)) * (qflx_top_soil(c) - qflx_surf(c)) qflx_in_h2osfc(c) = frac_h2osfc(c) * (qflx_top_soil(c) - qflx_surf(c)) - + qflx_gross_infl_soil(c) = (1._r8 - frac_h2osfc(c)) * (qflx_top_soil(c) - qflx_surf(c)) + !2. remove evaporation (snow treated in SnowHydrology) qflx_in_soil(c) = qflx_in_soil(c) - (1.0_r8 - fsno - frac_h2osfc(c))*qflx_evap(c) qflx_in_h2osfc(c) = qflx_in_h2osfc(c) - frac_h2osfc(c) * qflx_ev_h2osfc(c) + if (qflx_evap(c)>0._r8) then + qflx_gross_evap_soil(c) = (1.0_r8 - fsno - frac_h2osfc(c))*qflx_evap(c) + else + qflx_gross_evap_soil(c) = 0._r8 + qflx_gross_infl_soil(c) = qflx_gross_infl_soil(c)-(1.0_r8 - fsno - frac_h2osfc(c))*qflx_evap(c) + endif + !3. determine maximum infiltration rate if (use_vichydro) then top_moist(c)= 0._r8 @@ -417,6 +427,7 @@ subroutine Infiltration(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, f !4. soil infiltration and h2osfc "run-on" qflx_infl(c) = qflx_in_soil(c) - qflx_infl_excess(c) qflx_in_h2osfc(c) = qflx_in_h2osfc(c) + qflx_infl_excess(c) + qflx_gross_infl_soil(c) = qflx_gross_infl_soil(c)- qflx_infl_excess(c) !5. surface runoff from h2osfc if (h2osfcflag==1) then @@ -459,6 +470,7 @@ subroutine Infiltration(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, f !-- if all water evaporates, there will be no bottom drainage if (h2osfc(c) < 0.0) then qflx_infl(c) = qflx_infl(c) + h2osfc(c)/dtime + qflx_gross_evap_soil(c) = qflx_gross_evap_soil(c) - h2osfc(c)/dtime h2osfc(c) = 0.0 qflx_h2osfc_drain(c)= 0._r8 else @@ -472,14 +484,19 @@ subroutine Infiltration(bounds, num_hydrologyc, filter_hydrologyc, num_urbanc, f !7. remove drainage from h2osfc and add to qflx_infl h2osfc(c) = h2osfc(c) - qflx_h2osfc_drain(c) * dtime qflx_infl(c) = qflx_infl(c) + qflx_h2osfc_drain(c) + qflx_gross_infl_soil(c) = qflx_gross_infl_soil(c) + qflx_h2osfc_drain(c) else ! non-vegetated landunits (i.e. urban) use original CLM4 code if (snl(c) >= 0) then ! when no snow present, sublimation is removed in Drainage qflx_infl(c) = qflx_top_soil(c) - qflx_surf(c) - qflx_evap_grnd(c) + qflx_gross_infl_soil(c) = qflx_top_soil(c) - qflx_surf(c) + qflx_gross_evap_soil(c) = qflx_evap_grnd(c) else qflx_infl(c) = qflx_top_soil(c) - qflx_surf(c) & - (1.0_r8 - frac_sno(c)) * qflx_ev_soil(c) + qflx_gross_infl_soil(c) = qflx_top_soil(c) - qflx_surf(c) + qflx_gross_evap_soil(c) = (1.0_r8 - frac_sno(c)) * qflx_ev_soil(c) end if qflx_h2osfc_surf(c) = 0._r8 endif diff --git a/components/clm/src/biogeophys/SoilHydrologyType.F90 b/components/clm/src/biogeophys/SoilHydrologyType.F90 index 31870293a01e..f7349484a01a 100644 --- a/components/clm/src/biogeophys/SoilHydrologyType.F90 +++ b/components/clm/src/biogeophys/SoilHydrologyType.F90 @@ -31,6 +31,7 @@ Module SoilHydrologyType ! NON-VIC real(r8), pointer :: frost_table_col (:) ! col frost table depth real(r8), pointer :: zwt_col (:) ! col water table depth + real(r8), pointer :: zwts_col (:) ! col water table depth, the shallower of the two water depths real(r8), pointer :: zwt_perched_col (:) ! col perched water table depth real(r8), pointer :: wa_col (:) ! col water in the unconfined aquifer (mm) real(r8), pointer :: qcharge_col (:) ! col aquifer recharge rate (mm/s) @@ -115,6 +116,7 @@ subroutine InitAllocate(this, bounds) allocate(this%frost_table_col (begc:endc)) ; this%frost_table_col (:) = nan allocate(this%zwt_col (begc:endc)) ; this%zwt_col (:) = nan allocate(this%zwt_perched_col (begc:endc)) ; this%zwt_perched_col (:) = nan + allocate(this%zwts_col (begc:endc)) ; this%zwts_col (:) = nan allocate(this%wa_col (begc:endc)) ; this%wa_col (:) = nan allocate(this%qcharge_col (begc:endc)) ; this%qcharge_col (:) = nan diff --git a/components/clm/src/biogeophys/SoilWaterMovementMod.F90 b/components/clm/src/biogeophys/SoilWaterMovementMod.F90 index 28a17d622f55..fb3ace80f708 100644 --- a/components/clm/src/biogeophys/SoilWaterMovementMod.F90 +++ b/components/clm/src/biogeophys/SoilWaterMovementMod.F90 @@ -43,6 +43,9 @@ subroutine SoilWater(bounds, num_hydrologyc, filter_hydrologyc, & ! select one subroutine to do the soil and root water coupling ! !USES + use clm_varctl , only : use_betr + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_varpar , only : nlevsoi use decompMod , only : bounds_type use abortutils , only : endrun use SoilHydrologyType , only : soilhydrology_type @@ -51,6 +54,8 @@ subroutine SoilWater(bounds, num_hydrologyc, filter_hydrologyc, & use WaterFluxType , only : waterflux_type use WaterStateType , only : waterstate_type use SoilWaterRetentionCurveMod, only : soil_water_retention_curve_type + use clm_varcon , only : denh2o, denice, watmin + use ColumnType , only : col ! ! !ARGUMENTS: implicit none @@ -67,8 +72,20 @@ subroutine SoilWater(bounds, num_hydrologyc, filter_hydrologyc, & class(soil_water_retention_curve_type), intent(in) :: soil_water_retention_curve ! ! !LOCAL VARIABLES: - character(len=32) :: subname = 'SoilWater' ! subroutine name + character(len=32) :: subname = 'SoilWater' ! subroutine name + real(r8) :: xs(bounds%begc:bounds%endc) !excess soil water above urban ponding limit + + integer :: fc, c, j + + !------------------------------------------------------------------------------ + associate( & + wa => soilhydrology_vars%wa_col , & ! Input: [real(r8) (:) ] water in the unconfined aquifer (mm) + dz => col%dz , & ! Input: [real(r8) (:,:) ] layer thickness (m) + h2osoi_ice => waterstate_vars%h2osoi_ice_col , & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) + h2osoi_vol => waterstate_vars%h2osoi_vol_col , & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) + h2osoi_liq => waterstate_vars%h2osoi_liq_col & ! Output: [real(r8) (:,:) ] liquid water (kg/m2) + ) select case(soilroot_water_method) @@ -84,6 +101,46 @@ subroutine SoilWater(bounds, num_hydrologyc, filter_hydrologyc, & end select + if(use_betr)then + !a work around of the negative liquid water embarrassment, which is + !critical for a meaningufl tracer transport in betr. Jinyun Tang, Jan 14, 2015 + + do j = 1, nlevsoi-1 + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + if (h2osoi_liq(c,j) < 0._r8) then + xs(c) = watmin - h2osoi_liq(c,j) + else + xs(c) = 0._r8 + end if + h2osoi_liq(c,j ) = h2osoi_liq(c,j ) + xs(c) + h2osoi_liq(c,j+1) = h2osoi_liq(c,j+1) - xs(c) + end do + end do + + j = nlevsoi + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + if (h2osoi_liq(c,j) < watmin) then + xs(c) = watmin-h2osoi_liq(c,j) + else + xs(c) = 0._r8 + end if + h2osoi_liq(c,j) = h2osoi_liq(c,j) + xs(c) + wa(c) = wa(c) - xs(c) + end do + + !update volumetric soil moisture for bgc calculation + do j = 1, nlevsoi + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + h2osoi_vol(c,j) = h2osoi_liq(c,j)/(dz(c,j)*denh2o) & + + h2osoi_ice(c,j)/(dz(c,j)*denice) + enddo + enddo + endif + end associate + end subroutine SoilWater !----------------------------------------------------------------------- @@ -268,6 +325,7 @@ subroutine soilwater_zengdecker2009(bounds, num_hydrologyc, filter_hydrologyc, & qflx_infl => waterflux_vars%qflx_infl_col , & ! Input: [real(r8) (:) ] infiltration (mm H2O /s) qflx_tran_veg_col => waterflux_vars%qflx_tran_veg_col , & ! Input: [real(r8) (:) ] vegetation transpiration (mm H2O/s) (+ = to atm) qflx_tran_veg_pft => waterflux_vars%qflx_tran_veg_patch , & ! Input: [real(r8) (:) ] vegetation transpiration (mm H2O/s) (+ = to atm) + qflx_rootsoi => waterflux_vars%qflx_rootsoi_col , & ! Output: [real(r8) (:,:) ] vegetation/soil water exchange (m H2O/s) (+ = to atm) t_soisno => temperature_vars%t_soisno_col & ! Input: [real(r8) (:,:) ] soil temperature (Kelvin) ) @@ -695,8 +753,15 @@ subroutine soilwater_zengdecker2009(bounds, num_hydrologyc, filter_hydrologyc, & enddo enddo + do j = 1, nlevsoi + do fc = 1, num_hydrologyc + c = filter_hydrologyc(fc) + qflx_rootsoi(c,j) = qflx_tran_veg_col(c) * rootr_col(c,j) * 1.e-3_r8 ![m H2O/s] + enddo + enddo + end associate - - end subroutine soilwater_zengdecker2009 + + end subroutine soilwater_zengdecker2009 end module SoilWaterMovementMod diff --git a/components/clm/src/biogeophys/SurfaceResistanceMod.F90 b/components/clm/src/biogeophys/SurfaceResistanceMod.F90 index f98b27d2e209..46a1915b6a29 100644 --- a/components/clm/src/biogeophys/SurfaceResistanceMod.F90 +++ b/components/clm/src/biogeophys/SurfaceResistanceMod.F90 @@ -25,6 +25,7 @@ module SurfaceResistanceMod public :: calc_soilevap_stress public :: do_soilevap_beta public :: init_soil_stress + public :: getlblcef ! ! !REVISION HISTORY: ! 6/25/2013 Created by Jinyun Tang @@ -183,4 +184,37 @@ function do_soilevap_beta()result(lres) end function do_soilevap_beta + !------------------------------------------------------------------------------ + + function getlblcef(rho,temp)result(cc) + !compute the scaling paramter for laminar boundary resistance + !the laminar boundary layer resistance is formulated as + !Rb=2/(k*ustar)*(Sci/Pr)^(2/3) + !cc = Rb*ustar + ! = 2/k*(Sci/Pr)^(2/3) + ! Pr=0.72, Prandtl number + ! Sci = v/Di, Di is diffusivity of gas i + ! v : kinetic viscosity + + use clm_varcon , only : vkc + + real(r8), intent(in) :: rho + real(r8), intent(in) :: temp ! air temperature + + real(r8), parameter :: C = 120._r8 ! K + real(r8), parameter :: T0 = 291.25_r8 ! K + real(r8), parameter :: mu0 = 18.27e-6_r8 ! Pa s + real(r8), parameter :: prandtl = 0.72 ! + real(r8) :: mu, diffh2o, sc + real(r8) :: cc ! unitless scaling factor + + !compute the kinetic viscosity + mu = mu0 * (T0+C)/(temp+C) * (temp/T0)**(1.5)/rho !m^2 s^-1 + diffh2o = 0.229e-4_r8*(temp/273.15_r8)**1.75_r8 !m^2 s^-1 + sc = mu/diffh2o !schmidt number + + cc = 2._r8/vkc*(Sc/Prandtl)**(2._r8/3._r8) + + return + end function getlblcef end module SurfaceResistanceMod diff --git a/components/clm/src/biogeophys/TridiagonalMod.F90 b/components/clm/src/biogeophys/TridiagonalMod.F90 index 81a091c00fbf..1d0ac6759207 100644 --- a/components/clm/src/biogeophys/TridiagonalMod.F90 +++ b/components/clm/src/biogeophys/TridiagonalMod.F90 @@ -1,7 +1,5 @@ module TridiagonalMod -#include "shr_assert.h" - !----------------------------------------------------------------------- ! !DESCRIPTION: ! Tridiagonal matrix solution @@ -12,104 +10,314 @@ module TridiagonalMod ! ! !PUBLIC MEMBER FUNCTIONS: public :: Tridiagonal + public :: trisim + interface Tridiagonal + module procedure :: Tridiagonal_sr, Tridiagonal_mr + end interface Tridiagonal + !----------------------------------------------------------------------- contains !----------------------------------------------------------------------- - subroutine Tridiagonal (bounds, lbj, ubj, jtop, numf, filter, a, b, c, r, u) + subroutine Tridiagonal_sr (bounds, lbj, ubj, jtop, numf, filter, a, b, c, r, u, is_col_active) ! ! !DESCRIPTION: ! Tridiagonal matrix solution - ! + ! A x = r + ! where x and r are vectors ! !USES: - use shr_kind_mod , only : r8 => shr_kind_r8 - use shr_log_mod , only : errMsg => shr_log_errMsg - use clm_varpar , only : nlevurb - use column_varcon , only : icol_roof, icol_sunwall, icol_shadewall + use shr_kind_mod , only: r8 => shr_kind_r8 use clm_varctl , only : iulog use decompMod , only : bounds_type - use ColumnType , only : col ! ! !ARGUMENTS: implicit none - type(bounds_type), intent(in) :: bounds - integer , intent(in) :: lbj, ubj ! lbinning and ubing level indices - integer , intent(in) :: jtop( bounds%begc: ) ! top level for each column [col] - integer , intent(in) :: numf ! filter dimension - integer , intent(in) :: filter(:) ! filter - real(r8), intent(in) :: a( bounds%begc: , lbj: ) ! "a" left off diagonal of tridiagonal matrix [col, j] - real(r8), intent(in) :: b( bounds%begc: , lbj: ) ! "b" diagonal column for tridiagonal matrix [col, j] - real(r8), intent(in) :: c( bounds%begc: , lbj: ) ! "c" right off diagonal tridiagonal matrix [col, j] - real(r8), intent(in) :: r( bounds%begc: , lbj: ) ! "r" forcing term of tridiagonal matrix [col, j] - real(r8), intent(inout) :: u( bounds%begc: , lbj: ) ! solution [col, j] - ! - integer :: j,ci,fc !indices - real(r8) :: gam(bounds%begc:bounds%endc,lbj:ubj) !temporary - real(r8) :: bet(bounds%begc:bounds%endc) !temporary + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: lbj, ubj ! lbinning and ubing level indices + integer , intent(in) :: jtop( bounds%begc: bounds%endc) ! top level for each column [col] + integer , intent(in) :: numf ! filter dimension + integer , intent(in) :: filter(:) ! filter + real(r8) , intent(in) :: a( bounds%begc:bounds%endc , lbj:ubj) ! "a" left off diagonal of tridiagonal matrix [col , j] + real(r8) , intent(in) :: b( bounds%begc:bounds%endc , lbj:ubj) ! "b" diagonal column for tridiagonal matrix [col , j] + real(r8) , intent(in) :: c( bounds%begc:bounds%endc , lbj:ubj) ! "c" right off diagonal tridiagonal matrix [col , j] + real(r8) , intent(in) :: r( bounds%begc:bounds%endc , lbj:ubj) ! "r" forcing term of tridiagonal matrix [col , j] + real(r8) , intent(inout) :: u( bounds%begc:bounds%endc , lbj:ubj) ! solution [col , j] + ! + integer :: j,ci,fc ! indices + logical, optional, intent(in) :: is_col_active(bounds%begc:bounds%endc) ! + logical :: l_is_col_active(bounds%begc:bounds%endc) ! + real(r8) :: gam(bounds%begc:bounds%endc,lbj:ubj) ! temporary + real(r8) :: bet(bounds%begc:bounds%endc) ! temporary + + character(len=255) :: subname ='Tridiagonal_sr' !----------------------------------------------------------------------- - ! Enforce expected array sizes - SHR_ASSERT_ALL((ubound(jtop) == (/bounds%endc/)), errMsg(__FILE__, __LINE__)) - SHR_ASSERT_ALL((ubound(a) == (/bounds%endc, ubj/)), errMsg(__FILE__, __LINE__)) - SHR_ASSERT_ALL((ubound(b) == (/bounds%endc, ubj/)), errMsg(__FILE__, __LINE__)) - SHR_ASSERT_ALL((ubound(c) == (/bounds%endc, ubj/)), errMsg(__FILE__, __LINE__)) - SHR_ASSERT_ALL((ubound(r) == (/bounds%endc, ubj/)), errMsg(__FILE__, __LINE__)) - SHR_ASSERT_ALL((ubound(u) == (/bounds%endc, ubj/)), errMsg(__FILE__, __LINE__)) ! Solve the matrix + if(present(is_col_active))then + l_is_col_active(:) = is_col_active(:) + else + l_is_col_active(:) = .true. + endif do fc = 1,numf - ci = filter(fc) - bet(ci) = b(ci,jtop(ci)) + ci = filter(fc) + if(l_is_col_active(ci))then + bet(ci) = b(ci,jtop(ci)) + endif end do do j = lbj, ubj do fc = 1,numf - ci = filter(fc) - if ((col%itype(ci) == icol_sunwall .or. col%itype(ci) == icol_shadewall & - .or. col%itype(ci) == icol_roof) .and. j <= nlevurb) then + ci = filter(fc) + if(l_is_col_active(ci))then if (j >= jtop(ci)) then - if (j == jtop(ci)) then - u(ci,j) = r(ci,j) / bet(ci) - else - gam(ci,j) = c(ci,j-1) / bet(ci) - bet(ci) = b(ci,j) - a(ci,j) * gam(ci,j) - u(ci,j) = (r(ci,j) - a(ci,j)*u(ci,j-1)) / bet(ci) - end if + if (j == jtop(ci)) then + u(ci,j) = r(ci,j) / bet(ci) + else + gam(ci,j) = c(ci,j-1) / bet(ci) + bet(ci) = b(ci,j) - a(ci,j) * gam(ci,j) + u(ci,j) = (r(ci,j) - a(ci,j)*u(ci,j-1)) / bet(ci) + end if end if - else if (col%itype(ci) /= icol_sunwall .and. col%itype(ci) /= icol_shadewall & - .and. col%itype(ci) /= icol_roof) then + endif + end do + end do + + do j = ubj-1,lbj,-1 + do fc = 1,numf + ci = filter(fc) + if(l_is_col_active(ci))then if (j >= jtop(ci)) then - if (j == jtop(ci)) then - u(ci,j) = r(ci,j) / bet(ci) + u(ci,j) = u(ci,j) - gam(ci,j+1) * u(ci,j+1) + end if + endif + end do + end do + + + end subroutine Tridiagonal_sr + !----------------------------------------------------------------------- + subroutine Tridiagonal_mr (bounds, lbj, ubj, jtop, numf, filter, ntrcs, a, b, c, r, u, is_col_active) + ! + ! !DESCRIPTION: + ! Tridiagonal matrix solution + ! A X = R + ! where A, X and R are all matrices. + ! !USES: + use shr_kind_mod , only: r8 => shr_kind_r8 + use clm_varctl , only : iulog + use decompMod , only : bounds_type + ! + ! !ARGUMENTS: + implicit none + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: lbj, ubj ! lbinning and ubing level indices + integer , intent(in) :: jtop( bounds%begc: bounds%endc) ! top level for each column [col] + integer , intent(in) :: numf ! filter dimension + integer , intent(in) :: ntrcs ! + integer , intent(in) :: filter(:) ! filter + real(r8) , intent(in) :: a( bounds%begc:bounds%endc , lbj:ubj) ! "a" left off diagonal of tridiagonal matrix [col , j] + real(r8) , intent(in) :: b( bounds%begc:bounds%endc , lbj:ubj) ! "b" diagonal column for tridiagonal matrix [col , j] + real(r8) , intent(in) :: c( bounds%begc:bounds%endc , lbj:ubj) ! "c" right off diagonal tridiagonal matrix [col , j] + real(r8) , intent(in) :: r( bounds%begc:bounds%endc , lbj:ubj, 1:ntrcs) ! "r" forcing term of tridiagonal matrix [col , j] + real(r8) , intent(inout) :: u( bounds%begc:bounds%endc , lbj:ubj, 1:ntrcs) ! solution [col, j] + ! + integer :: j,ci,fc,k ! indices + logical, optional, intent(in) :: is_col_active(bounds%begc:bounds%endc) ! + logical :: l_is_col_active(bounds%begc:bounds%endc) ! + real(r8) :: gam(bounds%begc:bounds%endc,lbj:ubj) ! temporary + real(r8) :: bet(bounds%begc:bounds%endc) ! temporary + + character(len=255) :: subname ='Tridiagonal_sr' + !----------------------------------------------------------------------- + + ! Solve the matrix + if (present(is_col_active)) then + l_is_col_active(:) = is_col_active(:) + else + l_is_col_active(:) = .true. + endif + + do fc = 1,numf + ci = filter(fc) + if (l_is_col_active(ci))then + bet(ci) = b(ci,jtop(ci)) + endif + end do + + do j = lbj, ubj + do fc = 1,numf + ci = filter(fc) + if (l_is_col_active(ci))then + if (j >= jtop(ci)) then + if (j == jtop(ci))then + do k = 1, ntrcs + u(ci,j,k) = r(ci,j,k)/bet(ci) + enddo else gam(ci,j) = c(ci,j-1) / bet(ci) bet(ci) = b(ci,j) - a(ci,j) * gam(ci,j) - u(ci,j) = (r(ci,j) - a(ci,j)*u(ci,j-1)) / bet(ci) - end if + do k = 1, ntrcs + u(ci,j,k) = (r(ci,j, k) - a(ci,j)*u(ci,j-1, k)) / bet(ci) + end do + end if end if end if end do end do + do j = ubj-1,lbj,-1 do fc = 1,numf ci = filter(fc) - if ((col%itype(ci) == icol_sunwall .or. col%itype(ci) == icol_shadewall & - .or. col%itype(ci) == icol_roof) .and. j <= nlevurb-1) then + if (l_is_col_active(ci)) then if (j >= jtop(ci)) then - u(ci,j) = u(ci,j) - gam(ci,j+1) * u(ci,j+1) - end if - else if (col%itype(ci) /= icol_sunwall .and. col%itype(ci) /= icol_shadewall & - .and. col%itype(ci) /= icol_roof) then - if (j >= jtop(ci)) then - u(ci,j) = u(ci,j) - gam(ci,j+1) * u(ci,j+1) + do k = 1, ntrcs + u(ci,j, k) = u(ci,j, k) - gam(ci,j+1) * u(ci,j+1, k) + end do end if end if end do end do - end subroutine Tridiagonal + end subroutine Tridiagonal_mr + +!---------------- + subroutine Trisim(bounds, lbj, ubj, numf, filter, a1,b1,c1,d1,e1,a2,b2,c2,d2,e2,w1, w2) + ! + !DESCRIPTIONS + ! This subroutine solves two coupled tridiagonal equations + ! A1*W1(J-1)+B1*W1(j)+C1*W1(J+1) = D1*W2(j) + E1 AND + ! A2*W2(J-1)+B2*W2(j)+C2*W2(J+1) = D2*W1(j) + E2 + ! BOUNDARY CONDITIONS ARE APPLIED AT J=1 AND J=JFLT + ! for the input coefficients array + ! A1(1)=A2(1)=B1(1)=B2(1)=C1(1)=C2(1)=D1(1)=D2(1)=E1(1)=E2(1)=0 + ! A1(2)=A2(2)=C1(M)=C2(M)=0 + ! the solution is solved at 2 ... M + ! but I have changed solution location to 1.. M-1 in the code implemented below + ! Reference: + ! Deshpande, M. D. and Giddens, D. P. (1977), Direct solution of two linear systems of equations + ! forming coupled tridiagonal-type matrices. Int. J. Numer. Meth. Engng., + ! 11: 1049�1052. doi: 10.1002/nme.1620110612 + !Created by Jinyun Tang + !Attention: Now the code is specifically written for the soil water coupling with hydraulic + !redistribution. Idealy, the code should fit well with the purpose of solving coupled heat and + !water transport equation, but I did not make any attempt here. + use shr_kind_mod , only : r8 => shr_kind_r8 + use clm_varctl , only : iulog + use decompMod , only : bounds_type + implicit none + type(bounds_type) , intent(in) :: bounds ! bounds + integer , intent(in) :: lbj, ubj ! lbinning and ubing level indices + integer , intent(in) :: numf ! filter dimension + integer , intent(in) :: filter(:) ! filter + real(r8) , intent(in) :: a1(bounds%begc:bounds%endc, lbj:ubj) ! + real(r8) , intent(in) :: b1(bounds%begc:bounds%endc, lbj:ubj) ! + real(r8) , intent(in) :: c1(bounds%begc:bounds%endc, lbj:ubj) ! + real(r8) , intent(in) :: d1(bounds%begc:bounds%endc, lbj:ubj) ! + real(r8) , intent(in) :: e1(bounds%begc:bounds%endc, lbj:ubj) ! + real(r8) , intent(in) :: a2(bounds%begc:bounds%endc, lbj:ubj) ! + real(r8) , intent(in) :: b2(bounds%begc:bounds%endc, lbj:ubj) ! + real(r8) , intent(in) :: c2(bounds%begc:bounds%endc, lbj:ubj) ! + real(r8) , intent(in) :: d2(bounds%begc:bounds%endc, lbj:ubj) ! + real(r8) , intent(in) :: e2(bounds%begc:bounds%endc, lbj:ubj) ! + real(r8) , intent(out) :: w1(bounds%begc:bounds%endc, lbj:ubj-1) ! + real(r8) , intent(out) :: w2(bounds%begc:bounds%endc, lbj:ubj-1) ! + !local variables + real(r8) :: gam1(bounds%begc:bounds%endc, lbj:ubj) ! + real(r8) :: gam2(bounds%begc:bounds%endc, lbj:ubj) ! + real(r8) :: xi1(bounds%begc:bounds%endc, lbj:ubj) ! + real(r8) :: xi2(bounds%begc:bounds%endc, lbj:ubj) ! + real(r8) :: phi1(bounds%begc:bounds%endc, lbj:ubj) ! + real(r8) :: phi2(bounds%begc:bounds%endc, lbj:ubj) ! + real(r8) :: bp1, bp2, dg1, dg2, ee1, ee2 ! + real(r8) :: q ! + integer :: m, l1, j, j2, k, fc, ci ! + character(len=255) :: subname='Trisim' + + m = ubj + l1= ubj - 1 + j = lbj + 1 + do fc = 1,numf + ci = filter(fc) + + bp1 = b1(ci,j) + dg1 = d1(ci,j) + bp2 = b2(ci,j) + dg2 = d2(ci,j) + + q = 1._r8 / (bp1 * bp2 - dg1 * dg2) + + phi1(ci,j) = q * bp2 * c1(ci,j) + phi2(ci,j) = q * bp1 * c2(ci,j) + gam1(ci,j) =-q * dg1 * c2(ci,j) + gam2(ci,j) =-q * dg2 * c1(ci,j) + + ee1 = e1(ci,j) + ee2 = e2(ci,j) + + xi1(ci,j) = q* (bp2 * ee1+dg1 * ee2) + xi2(ci,j) = q* (dg2 * ee1+bp1 * ee2) + enddo + + do j= lbj+2 , l1 + do fc = 1, numf + ci = filter(fc) + + bp1 =b1(ci,j) -a1(ci,j) * phi1(ci,j - 1) + dg1 =d1(ci,j) -a1(ci,j) * gam1(ci,j - 1) + bp2 =b2(ci,j) -a2(ci,j) * phi2(ci,j - 1) + dg2 =d2(ci,j) -a2(ci,j) * gam2(ci,j - 1) + + q = 1._r8/(bp1 * bp2 - dg1 * dg2) + + ee1 = e1(ci,j)-a1(ci,j) * xi1(ci,j - 1) + ee2 = e2(ci,j)-a2(ci,j) * xi2(ci,j - 1) + + phi1(ci,j) =q * bp2 * c1(ci,j) + phi2(ci,j) =q * bp1 * c2(ci,j) + + gam1(ci,j) = - q * dg1 * c2(ci,j) + gam2(ci,j) = - q * dg2 * c1(ci,j) + + xi1(ci,j) = q * (bp2 * ee1 + dg1 * ee2) + xi2(ci,j) = q * (dg2 * ee1 + bp1 * ee2) + enddo + enddo + j=m + do fc = 1, numf + + ci = filter(fc) + + bp1 =b1(ci,j) -a1(ci,j) * phi1(ci, j - 1) + dg1 =d1(ci,j) -a1(ci,j) * gam1(ci, j - 1) + bp2 =b2(ci,j) -a2(ci,j) * phi2(ci, j - 1) + dg2= d2(ci,j) -a2(ci,j) * gam2(ci, j - 1) + + q = 1.0/(bp1*bp2-dg1*dg2) + + ee1 = e1(ci,j) - a1(ci,j) * xi1(ci,j - 1) + ee2 = e2(ci,j) - a2(ci,j) * xi2(ci,j - 1) + + xi1(ci,j) = q* ( bp2* ee1+dg1* ee2) + xi2(ci,j) = q* ( dg2* ee1+bp1* ee2) + + w1(ci,m-1) = xi1(ci,m) + w2(ci,m-1) = xi2(ci,m) + enddo + + do j2 = lbj+1, l1 + j=m+ 1-j2 + k =j -1 + do fc = 1, numf + ci = filter(fc) + w1 (ci, k )=-phi1(ci, j) *w1(ci, k+ 1) + gam1(ci, j)*w2(ci, k+1)+xi1(ci, j) + w2 (ci, k )=-phi2(ci, j) *w2(ci, k+ 1) + gam2(ci, j)*w1(ci, k+1)+xi2(ci, j) + enddo + enddo + + end subroutine trisim end module TridiagonalMod diff --git a/components/clm/src/biogeophys/WaterStateType.F90 b/components/clm/src/biogeophys/WaterStateType.F90 index 6d704292225d..3d8b78e7386a 100644 --- a/components/clm/src/biogeophys/WaterStateType.F90 +++ b/components/clm/src/biogeophys/WaterStateType.F90 @@ -32,14 +32,18 @@ module WaterstateType real(r8), pointer :: int_snow_col (:) ! col integrated snowfall (mm H2O) real(r8), pointer :: snow_layer_unity_col (:,:) ! value 1 for each snow layer, used for history diagnostics real(r8), pointer :: bw_col (:,:) ! col partial density of water in the snow pack (ice + liquid) [kg/m3] + real(r8), pointer :: finundated_col (:) ! fraction of column that is inundated, this is for bgc caclulation in betr + real(r8), pointer :: smp_l_col (:,:) ! col liquid phase soil matric potential, mm real(r8), pointer :: h2osno_col (:) ! col snow water (mm H2O) real(r8), pointer :: h2osno_old_col (:) ! col snow mass for previous time step (kg/m2) (new) 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_liqice_10cm_col (:) ! col liquid water + ice lens in top 10cm of soil (kg/m2) - real(r8), pointer :: h2osoi_vol_col (:,:) ! col volumetric soil water (0<=h2osoi_vol<=watsat) [m3/m3] (nlevgrnd) + 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) + real(r8), pointer :: h2osoi_icevol_col (:,:) ! col volumetric ice content (v/v) real(r8), pointer :: h2ocan_patch (:) ! patch canopy water (mm H2O) real(r8), pointer :: h2ocan_col (:) ! col canopy water (mm H2O) real(r8), pointer :: h2osfc_col (:) ! col surface water (mm H2O) @@ -160,12 +164,18 @@ subroutine InitAllocate(this, bounds) allocate(this%int_snow_col (begc:endc)) ; this%int_snow_col (:) = nan allocate(this%snow_layer_unity_col (begc:endc,-nlevsno+1:0)) ; this%snow_layer_unity_col (:,:) = nan allocate(this%bw_col (begc:endc,-nlevsno+1:0)) ; this%bw_col (:,:) = nan + allocate(this%smp_l_col (begc:endc,-nlevsno+1:nlevgrnd)) ; this%smp_l_col (:,:) = nan + allocate(this%finundated_col (begc:endc)) ; this%finundated_col (:) = nan 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 + allocate(this%h2osoi_liqice_10cm_col (begc:endc)) ; this%h2osoi_liqice_10cm_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 + allocate(this%h2osoi_icevol_col (begc:endc,-nlevsno+1:nlevgrnd)) ; this%h2osoi_icevol_col (:,:) = nan + allocate(this%h2osoi_ice_col (begc:endc,-nlevsno+1:nlevgrnd)) ; this%h2osoi_ice_col (:,:) = nan allocate(this%h2osoi_liq_col (begc:endc,-nlevsno+1:nlevgrnd)) ; this%h2osoi_liq_col (:,:) = nan allocate(this%h2ocan_patch (begp:endp)) ; this%h2ocan_patch (:) = nan diff --git a/components/clm/src/biogeophys/WaterfluxType.F90 b/components/clm/src/biogeophys/WaterfluxType.F90 index 1c879a4bd8c1..259418501f63 100644 --- a/components/clm/src/biogeophys/WaterfluxType.F90 +++ b/components/clm/src/biogeophys/WaterfluxType.F90 @@ -58,6 +58,11 @@ module WaterfluxType real(r8), pointer :: qflx_ev_h2osfc_patch (:) ! patch evaporation heat flux from soil (W/m**2) [+ to atm] real(r8), pointer :: qflx_ev_h2osfc_col (:) ! col evaporation heat flux from soil (W/m**2) [+ to atm] + real(r8), pointer :: qflx_gross_evap_soil_col (:) ! col gross infiltration from soil, this satisfies the relationship qflx_infl_col = qflx_gross_infl_soil_col-qflx_gross_evap_soil_col + real(r8), pointer :: qflx_gross_infl_soil_col (:) ! col gross infiltration, before considering the evaporation + 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) @@ -81,6 +86,10 @@ module WaterfluxType real(r8), pointer :: qflx_glcice_col (:) ! col net flux of new glacial ice (growth - melt) (mm H2O/s), passed to GLC real(r8), pointer :: qflx_glcice_frz_col (:) ! col ice growth (positive definite) (mm H2O/s) real(r8), pointer :: qflx_glcice_melt_col (:) ! col ice melt (positive definite) (mm H2O/s) + real(r8), pointer :: qflx_drain_vr_col (:,:) ! col liquid water losted as drainage (m /time step) + real(r8), pointer :: qflx_h2osfc2topsoi_col (:) ! col liquid water coming from surface standing water top soil (mm H2O/s) + real(r8), pointer :: qflx_snow2topsoi_col (:) ! col liquid water coming from residual snow to topsoil (mm H2O/s) + real(r8), pointer :: snow_sources_col (:) ! col snow sources (mm H2O/s) real(r8), pointer :: snow_sinks_col (:) ! col snow sinks (mm H2O/s) @@ -98,6 +107,7 @@ module WaterfluxType procedure, public :: Init procedure, public :: Restart + procedure, public :: Reset procedure, private :: InitAllocate procedure, private :: InitHistory procedure, private :: InitCold @@ -127,7 +137,7 @@ subroutine InitAllocate(this, bounds) ! ! !USES: use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) - use clm_varpar , only : nlevsno, nlevgrnd + use clm_varpar , only : nlevsno, nlevgrnd, nlevsoi ! ! !ARGUMENTS: class(waterflux_type) :: this @@ -183,6 +193,12 @@ subroutine InitAllocate(this, bounds) 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_gross_evap_soil_col (begc:endc)) ; this%qflx_gross_evap_soil_col (:) = nan + allocate(this%qflx_gross_infl_soil_col (begc:endc)) ; this%qflx_gross_infl_soil_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 @@ -217,6 +233,9 @@ subroutine InitAllocate(this, bounds) allocate(this%irrig_rate_patch (begp:endp)) ; this%irrig_rate_patch (:) = nan allocate(this%n_irrig_steps_left_patch (begp:endp)) ; this%n_irrig_steps_left_patch (:) = 0 + allocate(this%qflx_snow2topsoi_col (begc:endc)) ; this%qflx_snow2topsoi_col (:) = nan + allocate(this%qflx_h2osfc2topsoi_col (begc:endc)) ; this%qflx_h2osfc2topsoi_col (:) = nan + end subroutine InitAllocate !------------------------------------------------------------------------ @@ -225,7 +244,7 @@ subroutine InitHistory(this, bounds) ! !USES: use shr_infnan_mod , only : nan => shr_infnan_nan, assignment(=) use clm_varctl , only : create_glacier_mec_landunit, use_cn, use_lch4 - use clm_varpar , only : nlevsno, crop_prog + use clm_varpar , only : nlevsno, crop_prog, nlevsoi use histFileMod , only : hist_addfld1d, hist_addfld2d, no_snow_normal ! ! !ARGUMENTS: @@ -595,4 +614,26 @@ subroutine Restart(this, bounds, ncid, flag) end subroutine Restart + + subroutine Reset(this, bounds, numf, filter) + ! + ! !DESCRIPTION: + ! Intitialize SNICAR variables for fresh snow column + ! + ! !ARGUMENTS: + class(waterflux_type) :: this + type(bounds_type) , intent(in) :: bounds + integer , intent(in) :: numf + integer , intent(in) :: filter(:) + !----------------------------------------------------------------------- + + integer :: fc, column + + do fc = 1, numf + column = filter(fc) + this%qflx_snow2topsoi_col (column) = 0._r8 + this%qflx_h2osfc2topsoi_col (column) = 0._r8 + enddo + end subroutine Reset + end module WaterfluxType diff --git a/components/clm/src/main/clm_driver.F90 b/components/clm/src/main/clm_driver.F90 index 2509ff603138..a55b1eb6ac1d 100644 --- a/components/clm/src/main/clm_driver.F90 +++ b/components/clm/src/main/clm_driver.F90 @@ -10,6 +10,8 @@ module clm_driver ! !USES: use shr_kind_mod , only : r8 => shr_kind_r8 use clm_varctl , only : wrtdia, iulog, create_glacier_mec_landunit, use_ed + use clm_varpar , only : nlevtrc_soil + use clm_varctl , only : wrtdia, iulog, create_glacier_mec_landunit, use_ed, use_betr use clm_varctl , only : use_cn, use_cndv, use_lch4, use_voc, use_noio, use_c13, use_c14 use clm_time_manager , only : get_step_size, get_curr_date, get_ref_date, get_nstep, is_beg_curr_day use clm_varpar , only : nlevsno, nlevgrnd, crop_prog @@ -113,7 +115,20 @@ module clm_driver use clm_initializeMod , only : lnd2glc_vars use clm_initializeMod , only : EDbio_vars use clm_initializeMod , only : soil_water_retention_curve - + use clm_initializeMod , only : chemstate_vars + use betr_initializeMod , only : betrtracer_vars + use betr_initializeMod , only : tracercoeff_vars + use betr_initializeMod , only : tracerflux_vars + use betr_initializeMod , only : tracerState_vars + use betr_initializeMod , only : tracerboundarycond_vars + use betr_initializeMod , only : bgc_reaction + use betr_initializeMod , only : plantsoilnutrientflux_vars + use BetrBGCMod , only : run_betr_one_step_without_drainage + use BetrBGCMod , only : run_betr_one_step_with_drainage + use TracerBalanceMod , only : betr_tracer_massbalance_check + use TracerBalanceMod , only : begin_betr_tracer_massbalance + use tracer_varcon , only : is_active_betr_bgc, do_betr_leaching + use CNEcosystemDynBetrMod , only : CNEcosystemDynBetrVeg, CNEcosystemDynBetrSummary, CNFluxStateBetrSummary use GridcellType , only : grc use LandunitType , only : lun use ColumnType , only : col @@ -273,6 +288,14 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) do nc = 1,nclumps call get_clump_bounds(nc, bounds_clump) + if (use_betr .and. (.not. do_betr_leaching)) then + + call begin_betr_tracer_massbalance(bounds_clump, 1, nlevtrc_soil, & + filter(nc)%num_soilc, filter(nc)%soilc, betrtracer_vars , & + tracerstate_vars, tracerflux_vars) + + endif + if (use_cn) then call t_startf('begcnbal') @@ -457,6 +480,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) call t_startf('bgflux') + call waterflux_vars%Reset(bounds_clump, filter(nc)%num_nolakec , filter(nc)%nolakec) ! Bareground fluxes for all patches except lakes and urban landunits call BareGroundFluxes(bounds_clump, & @@ -588,7 +612,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) filter(nc)%num_nosnowc, filter(nc)%nosnowc, & atm2lnd_vars, soilstate_vars, energyflux_vars, temperature_vars, & waterflux_vars, waterstate_vars, soilhydrology_vars, aerosol_vars, & - soil_water_retention_curve) + soil_water_retention_curve, betrtracer_vars, tracerflux_vars, tracerstate_vars) ! Calculate column-integrated aerosol masses, and ! mass concentrations for radiative calculations and output @@ -676,9 +700,58 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) call t_startf('ecosysdyn') - ! FIX(SPM,032414) push these checks into the routines below and/or make this consistent. - if (.not. use_ed) then - if (use_cn) then + if(is_active_betr_bgc)then + !right now betr bgc is intended only for non-ed mode + + !this returns the plant nutrient demand to soil bgc + call CNEcosystemDynBetrVeg(bounds_clump, & + filter(nc)%num_soilc, filter(nc)%soilc, & + filter(nc)%num_soilp, filter(nc)%soilp, & + filter(nc)%num_pcropp, filter(nc)%pcropp, doalb, & + cnstate_vars, carbonflux_vars, carbonstate_vars, & + c13_carbonflux_vars, c13_carbonstate_vars, & + c14_carbonflux_vars, c14_carbonstate_vars, & + nitrogenflux_vars, nitrogenstate_vars, & + atm2lnd_vars, waterstate_vars, waterflux_vars, & + canopystate_vars, soilstate_vars, temperature_vars, crop_vars, & + dgvs_vars, photosyns_vars, soilhydrology_vars, energyflux_vars,& + plantsoilnutrientflux_vars, & + phosphorusflux_vars, phosphorusstate_vars) + + !do belowground bgc and transport + call t_startf('betr_nodrain') + + call run_betr_one_step_without_drainage(bounds_clump, 1, nlevtrc_soil, & + filter(nc)%num_soilc, filter(nc)%soilc, & + filter(nc)%num_soilp, filter(nc)%soilp, & + col, atm2lnd_vars, & + soilhydrology_vars, soilstate_vars, waterstate_vars, temperature_vars, & + waterflux_vars, chemstate_vars, cnstate_vars, canopystate_vars, & + carbonstate_vars, carbonflux_vars, nitrogenstate_vars, nitrogenflux_vars,& + betrtracer_vars, bgc_reaction, & + tracerboundarycond_vars, tracercoeff_vars, tracerstate_vars, & + tracerflux_vars, plantsoilnutrientflux_vars) + + call t_stopf('betr_nodrain') + + !do ecosystem variable summary + call CNEcosystemDynBetrSummary(bounds_clump, & + filter(nc)%num_soilc, filter(nc)%soilc, & + filter(nc)%num_soilp, filter(nc)%soilp, & + filter(nc)%num_pcropp, filter(nc)%pcropp, doalb, & + cnstate_vars, carbonflux_vars, carbonstate_vars, & + c13_carbonflux_vars, c13_carbonstate_vars, & + c14_carbonflux_vars, c14_carbonstate_vars, & + nitrogenflux_vars, nitrogenstate_vars, & + atm2lnd_vars, waterstate_vars, waterflux_vars, & + canopystate_vars, soilstate_vars, temperature_vars, crop_vars, & + dgvs_vars, photosyns_vars, soilhydrology_vars, energyflux_vars,& + plantsoilnutrientflux_vars, phosphorusstate_vars) + else + + ! FIX(SPM,032414) push these checks into the routines below and/or make this consistent. + if (.not. use_ed) then + if (use_cn) then ! fully prognostic canopy structure and C-N biogeochemistry ! - CNDV defined: prognostic biogeography; else prescribed @@ -809,46 +882,80 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) end if call t_stopf('ecosysdyn') - end if ! end of if-use_cn + end if ! end of if-use_cn - else ! use_ed + else ! use_ed - call carbonflux_vars%SetValues(& + call carbonflux_vars%SetValues(& filter(nc)%num_soilp, filter(nc)%soilp, 0._r8, filter(nc)%num_soilc, filter(nc)%soilc, 0._r8) - if ( use_c13 ) then + if ( use_c13 ) then call c13_carbonflux_vars%SetValues(& filter(nc)%num_soilp, filter(nc)%soilp, 0._r8, filter(nc)%num_soilc, filter(nc)%soilc, 0._r8) - end if - if ( use_c14 ) then + end if + if ( use_c14 ) then call c14_carbonflux_vars%SetValues(& filter(nc)%num_soilp, filter(nc)%soilp, 0._r8, filter(nc)%num_soilc, filter(nc)%soilc, 0._r8) - end if - call nitrogenflux_vars%SetValues(& + end if + call nitrogenflux_vars%SetValues(& filter(nc)%num_soilp, filter(nc)%soilp, 0._r8, filter(nc)%num_soilc, filter(nc)%soilc, 0._r8) - call EDbio_vars%SetValues( 0._r8 ) + call EDbio_vars%SetValues( 0._r8 ) - end if ! end of if-use_ed - - ! Dry Deposition of chemical tracers (Wesely (1998) parameterizaion) - call t_startf('depvel') - call depvel_compute(bounds_clump, & - atm2lnd_vars, canopystate_vars, waterstate_vars, frictionvel_vars, & - photosyns_vars, drydepvel_vars) - call t_stopf('depvel') - - if (use_lch4) then - call t_startf('ch4') - call ch4 (bounds_clump, & + end if ! end of if-use_ed + + call t_stopf('ecosysdyn') + + ! Dry Deposition of chemical tracers (Wesely (1998) parameterizaion) + call t_startf('depvel') + call depvel_compute(bounds_clump, & + atm2lnd_vars, canopystate_vars, waterstate_vars, frictionvel_vars, & + photosyns_vars, drydepvel_vars) + call t_stopf('depvel') + + if (use_betr)then + if (do_betr_leaching)then + call bgc_reaction%init_betr_alm_bgc_coupler(bounds_proc, & + carbonstate_vars, nitrogenstate_vars, betrtracer_vars, tracerstate_vars) + + !the following is dirty hack, I'll reconsider this in later modifcations, Jinyun Tang May 14, 2015 + call begin_betr_tracer_massbalance(bounds_clump, 1, nlevtrc_soil, & + filter(nc)%num_soilc, filter(nc)%soilc, betrtracer_vars , & + tracerstate_vars, tracerflux_vars) + + endif + + !this is used for non-online bgc with betr + call run_betr_one_step_without_drainage(bounds_clump, 1, nlevtrc_soil, & + filter(nc)%num_soilc, filter(nc)%soilc, & + filter(nc)%num_soilp, filter(nc)%soilp, & + col, atm2lnd_vars, & + soilhydrology_vars, soilstate_vars, waterstate_vars, temperature_vars, & + waterflux_vars, chemstate_vars, cnstate_vars, canopystate_vars, & + carbonstate_vars, carbonflux_vars, nitrogenstate_vars, & + nitrogenflux_vars, betrtracer_vars, bgc_reaction, & + tracerboundarycond_vars, tracercoeff_vars, tracerstate_vars, & + tracerflux_vars, plantsoilnutrientflux_vars) + endif + + if (use_lch4) then + call t_startf('ch4') + call ch4 (bounds_clump, & filter(nc)%num_soilc, filter(nc)%soilc, & filter(nc)%num_lakec, filter(nc)%lakec, & filter(nc)%num_soilp, filter(nc)%soilp, & atm2lnd_vars, lakestate_vars, canopystate_vars, soilstate_vars, soilhydrology_vars, & temperature_vars, energyflux_vars, waterstate_vars, waterflux_vars, & carbonstate_vars, carbonflux_vars, nitrogenflux_vars, ch4_vars, lnd2atm_vars) - call t_stopf('ch4') - end if + call t_stopf('ch4') + end if + endif !end of if is_active_betr_bgc + ! Dry Deposition of chemical tracers (Wesely (1998) parameterizaion) + call t_startf('depvel') + call depvel_compute(bounds_clump, & + atm2lnd_vars, canopystate_vars, waterstate_vars, frictionvel_vars, & + photosyns_vars, drydepvel_vars) + call t_stopf('depvel') ! ============================================================================ ! Calculate soil/snow hydrology with drainage (subsurface runoff) ! ============================================================================ @@ -865,15 +972,49 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) call t_stopf('hydro2 drainage') + if (use_betr) then + + call t_startf('betr drainage') + call run_betr_one_step_with_drainage(bounds_clump, 1, nlevtrc_soil, & + filter(nc)%num_soilc, filter(nc)%soilc, & + tracerboundarycond_vars%jtops_col(bounds_clump%begc:bounds_clump%endc), & + waterflux_vars%qflx_drain_vr_col(bounds_clump%begc:bounds_clump%endc, 1:nlevtrc_soil), & + col, betrtracer_vars , tracercoeff_vars, tracerstate_vars, tracerflux_vars) + call t_stopf('betr drainage') + + call t_startf('betr balchk') + call betr_tracer_massbalance_check(bounds_clump, 1, nlevtrc_soil, & + filter(nc)%num_soilc, filter(nc)%soilc, betrtracer_vars, & + tracerstate_vars, tracerflux_vars) + call t_stopf('betr balchk') + + call bgc_reaction%betr_alm_flux_statevar_feedback(bounds_clump, & + filter(nc)%num_soilc, filter(nc)%soilc, & + carbonstate_vars, nitrogenstate_vars, nitrogenflux_vars, & + tracerstate_vars, tracerflux_vars, betrtracer_vars) + endif + ! ============================================================================ ! Check the energy and water balance, also carbon and nitrogen balance ! ============================================================================ if (.not. use_ed) then + if (use_cn) then + + if (is_active_betr_bgc)then + !extract nitrogen pool and flux from betr + !summarize total column nitrogen and carbon + call CNFluxStateBetrSummary(bounds_clump, filter(nc)%num_soilc, filter(nc)%soilc, & + filter(nc)%num_soilp, filter(nc)%soilp, & + carbonflux_vars, carbonstate_vars, & + c13_carbonflux_vars, c13_carbonstate_vars, & + c14_carbonflux_vars, c14_carbonstate_vars, nitrogenflux_vars, nitrogenstate_vars, & + betrtracer_vars, tracerflux_vars, tracerstate_vars) + else ! FIX(SPM,032414) there are use_ed checks in this routine...be consistent ! (see comment above re: no leaching - call CNEcosystemDynLeaching(bounds_clump, & + call CNEcosystemDynLeaching(bounds_clump, & filter(nc)%num_soilc, filter(nc)%soilc, & filter(nc)%num_soilp, filter(nc)%soilp, & filter(nc)%num_pcropp, filter(nc)%pcropp, doalb, & @@ -881,14 +1022,17 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) c13_carbonflux_vars, c13_carbonstate_vars, & c14_carbonflux_vars, c14_carbonstate_vars, dgvs_vars, & nitrogenflux_vars, nitrogenstate_vars, & - waterstate_vars, waterflux_vars, frictionvel_vars, canopystate_vars,& + waterstate_vars, waterflux_vars, frictionvel_vars, & + canopystate_vars, & phosphorusflux_vars,phosphorusstate_vars) + end if if (doalb) then - call CNVegStructUpdate(filter(nc)%num_soilp, filter(nc)%soilp, & + call CNVegStructUpdate(filter(nc)%num_soilp, filter(nc)%soilp, & waterstate_vars, frictionvel_vars, dgvs_vars, cnstate_vars, & carbonstate_vars, canopystate_vars) - end if + end if + end if end if @@ -899,7 +1043,7 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) waterstate_vars, energyflux_vars, canopystate_vars) call t_stopf('balchk') - if(.not. use_ed)then + if (.not. use_ed)then if (use_cn) then nstep = get_nstep() @@ -1174,9 +1318,11 @@ subroutine clm_drv(doalb, nextsw_cday, declinp1, declin, rstwr, nlend, rdate) carbonstate_vars, c13_carbonstate_vars, c14_carbonstate_vars, carbonflux_vars, & ch4_vars, dgvs_vars, energyflux_vars, frictionvel_vars, lakestate_vars, & nitrogenstate_vars, nitrogenflux_vars, photosyns_vars, soilhydrology_vars, & - soilstate_vars, solarabs_vars, surfalb_vars, temperature_vars, & - waterflux_vars, waterstate_vars, EDbio_vars,& - phosphorusstate_vars,phosphorusflux_vars,rdate=rdate) + soilstate_vars, solarabs_vars, surfalb_vars, temperature_vars, & + waterflux_vars, waterstate_vars, EDbio_vars, & + phosphorusstate_vars,phosphorusflux_vars, & + betrtracer_vars, tracerstate_vars, tracerflux_vars, & + tracercoeff_vars, rdate=rdate ) call t_stopf('clm_drv_io_wrest') end if @@ -1438,6 +1584,13 @@ subroutine clm_drv_patch2col (bounds, num_nolakec, filter_nolakec, & waterflux_vars%qflx_irrig_patch(bounds%begp:bounds%endp), & waterflux_vars%qflx_irrig_col(bounds%begc:bounds%endc)) + call p2c (bounds, num_nolakec, filter_nolakec, & + waterflux_vars%qflx_tran_veg_patch(bounds%begp:bounds%endp), & + waterflux_vars%qflx_tran_veg_col(bounds%begc:bounds%endc) ) + + call p2c (bounds, num_nolakec, filter_nolakec, & + waterflux_vars%qflx_evap_veg_patch(bounds%begp:bounds%endp), & + waterflux_vars%qflx_evap_veg_col (bounds%begc:bounds%endc)) end subroutine clm_drv_patch2col !------------------------------------------------------------------------ diff --git a/components/clm/src/main/clm_initializeMod.F90 b/components/clm/src/main/clm_initializeMod.F90 index b9659644cb96..471983e2bef9 100644 --- a/components/clm/src/main/clm_initializeMod.F90 +++ b/components/clm/src/main/clm_initializeMod.F90 @@ -11,10 +11,11 @@ module clm_initializeMod use abortutils , only : endrun use clm_varctl , only : nsrest, nsrStartup, nsrContinue, nsrBranch use clm_varctl , only : create_glacier_mec_landunit, iulog - use clm_varctl , only : use_lch4, use_cn, use_cndv, use_voc, use_c13, use_c14, use_ed + use clm_varctl , only : use_lch4, use_cn, use_cndv, use_voc, use_c13, use_c14, use_ed, use_betr use clm_varsur , only : wt_lunit, urban_valid, wt_nat_patch, wt_cft, wt_glc_mec, topo_glc_mec use perf_mod , only : t_startf, t_stopf - use readParamsMod , only : readParameters + !use readParamsMod , only : readParameters + use readParamsMod , only : readSharedParameters, readPrivateParameters use ncdio_pio , only : file_desc_t ! !----------------------------------------- @@ -70,8 +71,8 @@ module clm_initializeMod use EDBioType , only : EDbio_type ! ED type used to interact with CLM variables use EDVecPatchType , only : EDpft use EDVecCohortType , only : coh ! unique to ED, used for domain decomp - ! bgc interface use clm_bgc_interface_data , only : clm_bgc_interface_data_type + use ChemStateType , only : chemstate_type ! structure for chemical indices of the soil, such as pH and Eh ! implicit none save @@ -118,11 +119,10 @@ module clm_initializeMod type(glc_diagnostics_type) :: glc_diagnostics_vars class(soil_water_retention_curve_type), allocatable :: soil_water_retention_curve type(EDbio_type) :: EDbio_vars - type(phosphorusstate_type) :: phosphorusstate_vars type(phosphorusflux_type) :: phosphorusflux_vars - !! bgc interface: type(clm_bgc_interface_data_type) :: clm_bgc_data + type(chemstate_type) :: chemstate_vars ! public :: initialize1 ! Phase one initialization public :: initialize2 ! Phase two initialization @@ -370,7 +370,7 @@ subroutine initialize2( ) use shr_orb_mod , only : shr_orb_decl use shr_scam_mod , only : shr_scam_getCloseLatLon use seq_drydep_mod , only : n_drydep, drydep_method, DD_XLND - use clm_varpar , only : nlevsno, numpft, crop_prog + use clm_varpar , only : nlevsno, numpft, crop_prog, nlevsoi use clm_varcon , only : h2osno_max, bdsno, c13ratio, c14ratio, spval use landunit_varcon , only : istice, istice_mec, istsoil use clm_varctl , only : finidat, finidat_interp_source, finidat_interp_dest, fsurdat @@ -395,7 +395,8 @@ subroutine initialize2( ) use restFileMod , only : restFile_read, restFile_write use accumulMod , only : print_accum_fields use ndepStreamMod , only : ndep_init, ndep_interp - use CNEcosystemDynMod , only : CNEcosystemDynInit + use CNEcosystemDynMod , only : CNEcosystemDynInit + use CNEcosystemDynBetrMod , only : CNEcosystemDynBetrInit use CNDecompCascadeBGCMod , only : init_decompcascade_bgc use CNDecompCascadeCNMod , only : init_decompcascade_cn use CNDecompCascadeContype, only : init_decomp_cascade_constants @@ -412,9 +413,12 @@ subroutine initialize2( ) use glc2lndMod , only : glc2lnd_type use lnd2glcMod , only : lnd2glc_type use SoilWaterRetentionCurveFactoryMod , only : create_soil_water_retention_curve - ! bgc interface & pflotran: use clm_varctl , only : use_bgc_interface, use_pflotran use clm_pflotran_interfaceMod , only : clm_pf_interface_init !!, clm_pf_set_restart_stamp + use betr_initializeMod , only : betr_initialize + use betr_initializeMod , only : betrtracer_vars, tracerstate_vars, tracerflux_vars, tracercoeff_vars + use betr_initializeMod , only : bgc_reaction + use tracer_varcon , only : is_active_betr_bgc ! ! !ARGUMENTS implicit none @@ -463,11 +467,10 @@ subroutine initialize2( ) nclumps = get_proc_clumps() ! ------------------------------------------------------------------------ - ! Read in parameters files + ! Read in shared parameters files ! ------------------------------------------------------------------------ - call readParameters() - + call readSharedParameters() ! ------------------------------------------------------------------------ ! Initialize time manager ! ------------------------------------------------------------------------ @@ -642,8 +645,10 @@ subroutine initialize2( ) soilstate_vars%watsat_col(begc:endc, 1:), & temperature_vars%t_soisno_col(begc:endc, -nlevsno+1:) ) + call waterflux_vars%init(bounds_proc) + call chemstate_vars%Init(bounds_proc) ! WJS (6-24-14): Without the following write statement, the assertion in ! energyflux_vars%init fails with pgi 13.9 on yellowstone. So for now, I'm leaving ! this write statement in place as a workaround for this problem. @@ -675,6 +680,16 @@ subroutine initialize2( ) allocate(soil_water_retention_curve, & source=create_soil_water_retention_curve()) + + ! -------------------------------------------------------------- + ! Initialise the BeTR + ! -------------------------------------------------------------- + + if(use_betr)then + !state variables will be initialized inside betr_initialize + call betr_initialize(bounds_proc, 1, nlevsoi, waterstate_vars) + endif + call SnowOptics_init( ) ! SNICAR optical parameters: call SnowAge_init( ) ! SNICAR aging parameters: @@ -689,16 +704,26 @@ subroutine initialize2( ) call vocemis_vars%Init(bounds_proc) end if - if (use_cn) then - + ! ------------------------------------------------------------------------ + ! Read in private parameters files, this should be preferred for mulitphysics + ! implementation, jinyun Tang, Feb. 11, 2015 + ! ------------------------------------------------------------------------ + if(use_cn) then call init_decomp_cascade_constants() - if (use_century_decomp) then - ! Note that init_decompcascade_bgc needs cnstate_vars to be initialized - call init_decompcascade_bgc(bounds_proc, cnstate_vars, soilstate_vars) - else - ! Note that init_decompcascade_cn needs cnstate_vars to be initialized - call init_decompcascade_cn(bounds_proc, cnstate_vars) - end if + endif + !read bgc implementation specific parameters when needed + call readPrivateParameters() + + if (use_cn) then + if (.not. is_active_betr_bgc)then + if (use_century_decomp) then + ! Note that init_decompcascade_bgc needs cnstate_vars to be initialized + call init_decompcascade_bgc(bounds_proc, cnstate_vars, soilstate_vars) + else + ! Note that init_decompcascade_cn needs cnstate_vars to be initialized + call init_decompcascade_cn(bounds_proc, cnstate_vars) + end if + endif ! Note - always initialize the memory for the c13_carbonstate_vars and ! c14_carbonstate_vars data structure so that they can be used in @@ -807,7 +832,11 @@ subroutine initialize2( ) ! ------------------------------------------------------------------------ if (use_cn) then - call CNEcosystemDynInit(bounds_proc) + if(is_active_betr_bgc)then + call CNEcosystemDynBetrInit(bounds_proc) + else + call CNEcosystemDynInit(bounds_proc) + endif else call SatellitePhenologyInit(bounds_proc) end if @@ -856,9 +885,10 @@ subroutine initialize2( ) carbonstate_vars, c13_carbonstate_vars, c14_carbonstate_vars, carbonflux_vars, & ch4_vars, dgvs_vars, energyflux_vars, frictionvel_vars, lakestate_vars, & nitrogenstate_vars, nitrogenflux_vars, photosyns_vars, soilhydrology_vars, & - soilstate_vars, solarabs_vars, surfalb_vars, temperature_vars, & - waterflux_vars, waterstate_vars, EDbio_vars,& - phosphorusstate_vars,phosphorusflux_vars ) + soilstate_vars, solarabs_vars, surfalb_vars, temperature_vars, & + waterflux_vars, waterstate_vars, EDbio_vars, & + phosphorusstate_vars,phosphorusflux_vars, & + betrtracer_vars, tracerstate_vars, tracerflux_vars, tracercoeff_vars ) end if else if ((nsrest == nsrContinue) .or. (nsrest == nsrBranch)) then @@ -870,12 +900,17 @@ subroutine initialize2( ) carbonstate_vars, c13_carbonstate_vars, c14_carbonstate_vars, carbonflux_vars, & ch4_vars, dgvs_vars, energyflux_vars, frictionvel_vars, lakestate_vars, & nitrogenstate_vars, nitrogenflux_vars, photosyns_vars, soilhydrology_vars, & - soilstate_vars, solarabs_vars, surfalb_vars, temperature_vars, & - waterflux_vars, waterstate_vars, EDbio_vars,& - phosphorusstate_vars,phosphorusflux_vars ) + soilstate_vars, solarabs_vars, surfalb_vars, temperature_vars, & + waterflux_vars, waterstate_vars, EDbio_vars, & + phosphorusstate_vars,phosphorusflux_vars, & + betrtracer_vars, tracerstate_vars, tracerflux_vars, tracercoeff_vars) end if - + + if (use_betr)then + call bgc_reaction%init_betr_alm_bgc_coupler(bounds_proc, & + carbonstate_vars, nitrogenstate_vars, betrtracer_vars, tracerstate_vars) + endif ! ------------------------------------------------------------------------ ! Initialize filters and weights ! ------------------------------------------------------------------------ @@ -910,9 +945,10 @@ subroutine initialize2( ) carbonstate_vars, c13_carbonstate_vars, c14_carbonstate_vars, carbonflux_vars, & ch4_vars, dgvs_vars, energyflux_vars, frictionvel_vars, lakestate_vars, & nitrogenstate_vars, nitrogenflux_vars, photosyns_vars, soilhydrology_vars, & - soilstate_vars, solarabs_vars, surfalb_vars, temperature_vars, & - waterflux_vars, waterstate_vars, EDbio_vars,& - phosphorusstate_vars,phosphorusflux_vars ) + soilstate_vars, solarabs_vars, surfalb_vars, temperature_vars, & + waterflux_vars, waterstate_vars, EDbio_vars, & + phosphorusstate_vars,phosphorusflux_vars, & + betrtracer_vars, tracerstate_vars, tracerflux_vars, tracercoeff_vars) ! Interpolate finidat onto new template file call getfil( finidat_interp_source, fnamer, 0 ) @@ -924,9 +960,10 @@ subroutine initialize2( ) carbonstate_vars, c13_carbonstate_vars, c14_carbonstate_vars, carbonflux_vars, & ch4_vars, dgvs_vars, energyflux_vars, frictionvel_vars, lakestate_vars, & nitrogenstate_vars, nitrogenflux_vars, photosyns_vars, soilhydrology_vars, & - soilstate_vars, solarabs_vars, surfalb_vars, temperature_vars, & - waterflux_vars, waterstate_vars, EDbio_vars,& - phosphorusstate_vars,phosphorusflux_vars ) + soilstate_vars, solarabs_vars, surfalb_vars, temperature_vars, & + waterflux_vars, waterstate_vars, EDbio_vars, & + phosphorusstate_vars,phosphorusflux_vars, & + betrtracer_vars, tracerstate_vars, tracerflux_vars, tracercoeff_vars) ! Reset finidat to now be finidat_interp_dest ! (to be compatible with routines still using finidat) diff --git a/components/clm/src/main/clm_varcon.F90 b/components/clm/src/main/clm_varcon.F90 index e9a6499516a6..455805557f29 100644 --- a/components/clm/src/main/clm_varcon.F90 +++ b/components/clm/src/main/clm_varcon.F90 @@ -65,6 +65,7 @@ module clm_varcon real(r8) :: tfrz = SHR_CONST_TKFRZ ! freezing temperature [K] real(r8), parameter :: tcrit = 2.5_r8 ! critical temperature to determine rain or snow real(r8) :: o2_molar_const = 0.209_r8 ! constant atmospheric O2 molar ratio (mol/mol) + real(r8) :: oneatm = 1.01325e5_r8 ! one standard atmospheric pressure [Pa] real(r8) :: bdsno = 250._r8 ! bulk density snow (kg/m**3) real(r8) :: alpha_aero = 1.0_r8 ! constant for aerodynamic parameter weighting @@ -167,8 +168,9 @@ module clm_varcon !------------------------------------------------------------------ ! Note some of these constants are also used in CNNitrifDenitrifMod - real(r8), parameter :: catomw = 12.011_r8 ! molar mass of C atoms (g/mol) - + real(r8), parameter :: catomw = 12.011_r8 ! molar mass of C atoms (g/mol) + real(r8), parameter :: natomw = 14.007_r8 ! molar mass of N atoms (g/mol) + real(r8) :: s_con(ngases,4) ! Schmidt # calculation constants (spp, #) data (s_con(1,i),i=1,4) /1898_r8, -110.1_r8, 2.834_r8, -0.02791_r8/ ! CH4 data (s_con(2,i),i=1,4) /1801_r8, -120.1_r8, 3.7818_r8, -0.047608_r8/ ! O2 diff --git a/components/clm/src/main/clm_varctl.F90 b/components/clm/src/main/clm_varctl.F90 index 0c00bf9fa663..afdffeea0aef 100644 --- a/components/clm/src/main/clm_varctl.F90 +++ b/components/clm/src/main/clm_varctl.F90 @@ -17,6 +17,7 @@ module clm_varctl public :: cnallocate_carbonnitrogen_only public :: cnallocate_carbonphosphorus_only_set public :: cnallocate_carbonphosphorus_only + public :: get_carbontag ! get the tag for carbon simulations ! private save @@ -190,6 +191,11 @@ module clm_varctl logical, public :: use_ed = .false. ! true => use ED logical, public :: use_ed_spit_fire = .false. ! true => use spitfire model + !---------------------------------------------------------- + ! BeTR switches + !---------------------------------------------------------- + logical, public :: use_betr = .false. ! true=> use BeTR + !---------------------------------------------------------- ! lai streams switch for Sat. Phenology !---------------------------------------------------------- @@ -363,7 +369,6 @@ logical function CNAllocate_Carbon_only() cnallocate_carbon_only = carbon_only end function CNAllocate_Carbon_only - ! Set module carbonnitrogen_only flag subroutine cnallocate_carbonnitrogen_only_set(carbonnitrogen_only_in) logical, intent(in) :: carbonnitrogen_only_in @@ -387,6 +392,19 @@ logical function CNAllocate_CarbonPhosphorus_only() cnallocate_carbonphosphorus_only = carbonphosphorus_only end function CNAllocate_CarbonPhosphorus_only - - + function get_carbontag(carbon_type)result(ctag) + implicit none + character(len=*) :: carbon_type + + character(len=3) :: ctag + + if(carbon_type=='c12')then + ctag = 'C' + elseif(carbon_type=='c13')then + ctag = 'C13' + elseif(carbon_type=='c14')then + ctag = 'C14' + endif + end function get_carbontag + end module clm_varctl diff --git a/components/clm/src/main/clm_varpar.F90 b/components/clm/src/main/clm_varpar.F90 index f351b7148778..44bd6ec79e5c 100644 --- a/components/clm/src/main/clm_varpar.F90 +++ b/components/clm/src/main/clm_varpar.F90 @@ -6,7 +6,7 @@ module clm_varpar ! ! !USES: use shr_kind_mod , only: r8 => shr_kind_r8 - use clm_varctl , only: use_extralakelayers, use_vertsoilc, use_crop + use clm_varctl , only: use_extralakelayers, use_vertsoilc, use_crop, use_betr use clm_varctl , only: use_century_decomp, use_c13, use_c14 use clm_varctl , only: iulog, create_crop_landunit, irrigate, flanduse_timeseries use clm_varctl , only: use_vichydro @@ -30,6 +30,9 @@ module clm_varpar integer :: nlevdecomp ! number of biogeochemically active soil layers integer :: nlevdecomp_full ! number of biogeochemical layers ! (includes lower layers that are biogeochemically inactive) + integer :: nlevtrc_soil + integer :: nlevtrc_full + integer, parameter :: nlevsno = 5 ! maximum number of snow layers integer, parameter :: ngases = 3 ! CH4, O2, & CO2 integer, parameter :: nlevcan = 1 ! number of leaf layers in canopy layer @@ -160,6 +163,11 @@ subroutine clm_varpar_init() nlevdecomp = 1 nlevdecomp_full = 1 end if + + nlevtrc_full = nlevsoi + if(use_betr) then + nlevtrc_soil = nlevsoi + endif if (.not. use_extralakelayers) then nlevlak = 10 ! number of lake layers diff --git a/components/clm/src/main/controlMod.F90 b/components/clm/src/main/controlMod.F90 index d0188259cbaf..de94cffc2ffa 100644 --- a/components/clm/src/main/controlMod.F90 +++ b/components/clm/src/main/controlMod.F90 @@ -49,6 +49,7 @@ module controlMod public :: control_setNL ! Set namelist filename public :: control_init ! initial run control information public :: control_print ! print run control information + ! ! ! !PRIVATE TYPES: @@ -101,12 +102,12 @@ subroutine control_init( ) ! Initialize CLM run control information ! ! !USES: - use clm_time_manager , only : set_timemgr_init, get_timemgr_defaults - use fileutils , only : getavu, relavu - use shr_string_mod , only : shr_string_getParentDir - ! pflotran - use clm_pflotran_interfaceMod, only : clm_pf_readnl - + use clm_time_manager , only : set_timemgr_init, get_timemgr_defaults + use fileutils , only : getavu, relavu + use shr_string_mod , only : shr_string_getParentDir + use clm_pflotran_interfaceMod , only : clm_pf_readnl + use betr_initializeMod , only : betr_readNL + ! implicit none ! ! !LOCAL VARIABLES: @@ -202,7 +203,9 @@ subroutine control_init( ) namelist /clm_inparm / use_c13, use_c14 namelist /clm_inparm / use_ed, use_ed_spit_fire - + + namelist /clm_inparm / use_betr + namelist /clm_inparm / use_lai_streams namelist /clm_inparm/ & @@ -381,6 +384,11 @@ subroutine control_init( ) if (use_pflotran) then call clm_pf_readnl(NLFilename) end if + + if (use_betr) then + call betr_readNL( NLFilename ) + endif + ! ---------------------------------------------------------------------- ! consistency checks ! ---------------------------------------------------------------------- @@ -533,6 +541,8 @@ subroutine control_spmd() call mpi_bcast (use_ed, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (use_ed_spit_fire, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (use_betr, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (use_lai_streams, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (use_dynroot, 1, MPI_LOGICAL, 0, mpicom, ier) diff --git a/components/clm/src/main/histFileMod.F90 b/components/clm/src/main/histFileMod.F90 index 27307ee3fb2e..e0b2c942e488 100644 --- a/components/clm/src/main/histFileMod.F90 +++ b/components/clm/src/main/histFileMod.F90 @@ -1672,7 +1672,7 @@ subroutine htape_create (t, histrest) ! ! !USES: use clm_varpar , only : nlevgrnd, nlevsno, nlevlak, nlevurb, numrad - use clm_varpar , only : natpft_size, cft_size, maxpatch_glcmec, nlevdecomp_full + use clm_varpar , only : natpft_size, cft_size, maxpatch_glcmec, nlevdecomp_full, nlevtrc_full use landunit_varcon , only : max_lunit use clm_varctl , only : caseid, ctitle, fsurdat, finidat, paramfile use clm_varctl , only : version, hostname, username, conventions, source @@ -1835,6 +1835,7 @@ subroutine htape_create (t, histrest) end do call ncd_defdim(lnfid, 'string_length', 8, strlen_dimid) call ncd_defdim( lnfid, 'levdcmp', nlevdecomp_full, dimid) + call ncd_defdim( lnfid, 'levtrc', nlevtrc_full, dimid) if ( .not. lhistrest )then call ncd_defdim(lnfid, 'hist_interval', 2, hist_interval_dimid) call ncd_defdim(lnfid, 'time', ncd_unlimited, time_dimid) @@ -4259,7 +4260,7 @@ subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out, ! initial or branch run to initialize the actual history tapes. ! ! !USES: - use clm_varpar , only : nlevgrnd, nlevsno, nlevlak, numrad, nlevdecomp_full + use clm_varpar , only : nlevgrnd, nlevsno, nlevlak, numrad, nlevdecomp_full, nlevtrc_soil use clm_varpar , only : natpft_size, cft_size, maxpatch_glcmec use landunit_varcon , only : max_lunit ! @@ -4338,6 +4339,8 @@ subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out, num2d = numrad case ('levdcmp') num2d = nlevdecomp_full + case ('levtrc') + num2d = nlevtrc_soil case('ltype') num2d = max_lunit case('natpft') @@ -4373,7 +4376,7 @@ subroutine hist_addfld2d (fname, type2d, units, avgflag, long_name, type1d_out, case default write(iulog,*) trim(subname),' ERROR: unsupported 2d type ',type2d, & ' currently supported types for multi level fields are: ', & - '[levgrnd,levlak,numrad,levdcmp,ltype,natpft,cft,glc_nec,elevclas,levsno]' + '[levgrnd,levlak,numrad,levdcmp,levtrc,ltype,natpft,cft,glc_nec,elevclas,levsno]' call endrun(msg=errMsg(__FILE__, __LINE__)) end select diff --git a/components/clm/src/main/lnd2atmMod.F90 b/components/clm/src/main/lnd2atmMod.F90 index 1143cb529339..0d61f7e86fce 100644 --- a/components/clm/src/main/lnd2atmMod.F90 +++ b/components/clm/src/main/lnd2atmMod.F90 @@ -12,6 +12,7 @@ module lnd2atmMod 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_voc + use tracer_varcon , only : is_active_betr_bgc use seq_drydep_mod , only : n_drydep, drydep_method, DD_XLND use decompMod , only : bounds_type use subgridAveMod , only : p2g, c2g @@ -262,7 +263,7 @@ subroutine lnd2atm(bounds, & ! ch4 flux - if (use_lch4) then + if (use_lch4 .and. (.not. is_active_betr_bgc)) then call c2g( bounds, & ch4_vars%ch4_surf_flux_tot_col (bounds%begc:bounds%endc), & lnd2atm_vars%flux_ch4_grc (bounds%begg:bounds%endg), & diff --git a/components/clm/src/main/readParamsMod.F90 b/components/clm/src/main/readParamsMod.F90 index d9aac931ac42..7cb67609b117 100644 --- a/components/clm/src/main/readParamsMod.F90 +++ b/components/clm/src/main/readParamsMod.F90 @@ -12,22 +12,24 @@ module readParamsMod save private ! - public :: readParameters + public :: readSharedParameters + public :: readPrivateParameters + !----------------------------------------------------------------------- contains !----------------------------------------------------------------------- - subroutine readParameters () + subroutine readSharedParameters () ! implicit none !----------------------------------------------------------------------- - call CNParamsReadFile() + call CNParamsSharedReadFile() ! calls for ED parameters call EDParamsReadFile() - end subroutine readParameters + end subroutine readSharedParameters !----------------------------------------------------------------------- subroutine EDParamsReadFile () ! @@ -74,11 +76,54 @@ subroutine EDParamsReadFile () end subroutine EDParamsReadFile !----------------------------------------------------------------------- - subroutine CNParamsReadFile () + subroutine CNParamsSharedReadFile () ! ! read CN and BGC shared parameters ! - use CNAllocationMod , only : readCNAllocParams + + use CNSharedParamsMod , only : CNParamsReadShared + + use clm_varctl , only : paramfile, iulog + use spmdMod , only : masterproc + use fileutils , only : getfil + use ncdio_pio , only : ncd_pio_closefile, ncd_pio_openfile, & + file_desc_t, ncd_inqdid, ncd_inqdlen + ! + ! !ARGUMENTS: + implicit none + ! + ! !OTHER LOCAL VARIABLES: + character(len=32) :: subname = 'CNParamsSharedReadFile' + character(len=256) :: locfn ! local file name + type(file_desc_t) :: ncid ! pio netCDF file id + integer :: dimid ! netCDF dimension id + integer :: npft ! number of pfts on pft-physiology file + !----------------------------------------------------------------------- + + if (masterproc) then + write(iulog,*) 'readParamsMod.F90::'//trim(subname)//' :: reading CN '//& + 'and BGC parameter file' + end if + + call getfil (paramfile, locfn, 0) + call ncd_pio_openfile (ncid, trim(locfn), 0) + call ncd_inqdid(ncid,'pft',dimid) + call ncd_inqdlen(ncid,dimid,npft) + + ! + ! some parameters (eg. organic_max) are used in non-CN, non-BGC cases + ! + call CNParamsReadShared(ncid) + + + end subroutine CNParamsSharedReadFile + + !----------------------------------------------------------------------- + subroutine readPrivateParameters + ! read CN and BGC shared parameters + ! + use CNAllocationBetrMod , only : readCNAllocBetrParams + use CNAllocationMod , only : readCNAllocParams use CNDecompMod , only : readCNDecompParams use CNDecompCascadeBGCMod , only : readCNDecompBgcParams use CNDecompCascadeCNMod , only : readCNDecompCnParams @@ -88,19 +133,21 @@ subroutine CNParamsReadFile () use CNGapMortalityMod , only : readCNGapMortParams use CNNitrifDenitrifMod , only : readCNNitrifDenitrifParams use CNSoilLittVertTranspMod , only : readCNSoilLittVertTranspParams - use CNSharedParamsMod , only : CNParamsReadShared use ch4Mod , only : readCH4Params - use clm_varctl , only : paramfile, iulog + use clm_varctl , only : paramfile, iulog, use_betr use spmdMod , only : masterproc use fileutils , only : getfil use ncdio_pio , only : ncd_pio_closefile, ncd_pio_openfile, & file_desc_t, ncd_inqdid, ncd_inqdlen + use tracer_varcon , only : is_active_betr_bgc + use betr_initializeMod , only : bgc_reaction, betrtracer_vars + ! ! !ARGUMENTS: implicit none ! ! !OTHER LOCAL VARIABLES: - character(len=32) :: subname = 'CNParamsReadShared' + character(len=32) :: subname = 'readPrivateParameters' character(len=256) :: locfn ! local file name type(file_desc_t) :: ncid ! pio netCDF file id integer :: dimid ! netCDF dimension id @@ -115,45 +162,51 @@ subroutine CNParamsReadFile () call getfil (paramfile, locfn, 0) call ncd_pio_openfile (ncid, trim(locfn), 0) call ncd_inqdid(ncid,'pft',dimid) - call ncd_inqdlen(ncid,dimid,npft) - - ! - ! some parameters (eg. organic_max) are used in non-CN, non-BGC cases - ! - call CNParamsReadShared(ncid) - + call ncd_inqdlen(ncid,dimid,npft) + + if(use_betr)then + call bgc_reaction%readParams(ncid, betrtracer_vars) + endif + if (use_cn) then ! ! populate each module with private parameters - ! - call readCNAllocParams(ncid) - call readCNDecompParams(ncid) - if (use_century_decomp) then - call readCNDecompBgcParams(ncid) + ! + if (is_active_betr_bgc)then + + call readCNAllocBetrParams(ncid) + else - call readCNDecompCnParams(ncid) - end if + call readCNAllocParams(ncid) + + call readCNDecompParams(ncid) + if (use_century_decomp) then + call readCNDecompBgcParams(ncid) + else + call readCNDecompCnParams(ncid) + end if + if (use_nitrif_denitrif) then + call readCNNitrifDenitrifParams(ncid) + end if + + call readCNSoilLittVertTranspParams(ncid) + + if (use_lch4) then + call readCH4Params (ncid) + end if + endif + call readCNPhenolParams(ncid) call readCNMRespParams (ncid) call readCNNDynamicsParams (ncid) call readCNGapMortParams (ncid) - if (use_nitrif_denitrif) then - call readCNNitrifDenitrifParams(ncid) - end if - - call readCNSoilLittVertTranspParams(ncid) - - if (use_lch4) then - call readCH4Params (ncid) - end if - - ! - ! close CN params file - ! - call ncd_pio_closefile(ncid) end if - end subroutine CNParamsReadFile + ! + ! close CN params file + ! + call ncd_pio_closefile(ncid) + end subroutine readPrivateParameters end module readParamsMod diff --git a/components/clm/src/main/restFileMod.F90 b/components/clm/src/main/restFileMod.F90 index 1d6b2bb8dcde..a875f47699b2 100644 --- a/components/clm/src/main/restFileMod.F90 +++ b/components/clm/src/main/restFileMod.F90 @@ -15,7 +15,7 @@ module restFileMod use accumulMod , only : accumulRest use histFileMod , only : hist_restart_ncd use clm_varpar , only : crop_prog - use clm_varctl , only : use_cn, use_c13, use_c14, use_lch4, use_cndv, use_ed + use clm_varctl , only : use_cn, use_c13, use_c14, use_lch4, use_cndv, use_ed, use_betr use clm_varctl , only : create_glacier_mec_landunit, iulog use clm_varcon , only : c13ratio, c14ratio use clm_varcon , only : nameg, namel, namec, namep, nameCohort @@ -48,7 +48,11 @@ module restFileMod use atm2lndType , only : atm2lnd_type use lnd2atmType , only : lnd2atm_type use glc2lndMod , only : glc2lnd_type - use lnd2glcMod , only : lnd2glc_type + use lnd2glcMod , only : lnd2glc_type + use BeTRTracerType , only : BeTRTracer_Type + use TracerStateType , only : TracerState_type + use TracerFluxType , only : TracerFlux_Type + use tracercoefftype , only : tracercoeff_type use ncdio_pio , only : file_desc_t, ncd_pio_createfile, ncd_pio_openfile, ncd_global use ncdio_pio , only : ncd_pio_closefile, ncd_defdim, ncd_putatt, ncd_enddef, check_dim use ncdio_pio , only : check_att, ncd_getatt @@ -92,9 +96,11 @@ subroutine restFile_write( bounds, file, carbonstate_vars, c13_carbonstate_vars, c14_carbonstate_vars, carbonflux_vars, & ch4_vars, dgvs_vars, energyflux_vars, frictionvel_vars, lakestate_vars, & nitrogenstate_vars, nitrogenflux_vars, photosyns_vars, soilhydrology_vars, & - soilstate_vars, solarabs_vars, surfalb_vars, temperature_vars, & - waterflux_vars, waterstate_vars, EDbio_vars, & - phosphorusstate_vars,phosphorusflux_vars,rdate,noptr) + soilstate_vars, solarabs_vars, surfalb_vars, temperature_vars, & + waterflux_vars, waterstate_vars, EDbio_vars, & + phosphorusstate_vars, phosphorusflux_vars, & + betrtracer_vars, tracerstate_vars, tracerflux_vars, tracercoeff_vars, & + rdate, noptr) ! ! !DESCRIPTION: ! Define/write CLM restart file. @@ -126,10 +132,12 @@ subroutine restFile_write( bounds, file, type(waterstate_type) , intent(inout) :: waterstate_vars ! due to EDrest call type(waterflux_type) , intent(in) :: waterflux_vars type(EDbio_type) , intent(inout) :: EDbio_vars ! due to EDrest call - type(phosphorusstate_type),intent(inout) :: phosphorusstate_vars type(phosphorusflux_type) ,intent(in) :: phosphorusflux_vars - + type(tracerstate_type) , intent(inout) :: tracerstate_vars ! due to Betrrest call + type(BeTRTracer_Type) , intent(in) :: betrtracer_vars + type(tracerflux_type) , intent(inout) :: tracerflux_vars + type(tracercoeff_type) , intent(inout) :: tracercoeff_vars character(len=*) , intent(in), optional :: rdate ! restart file time stamp for name logical , intent(in), optional :: noptr ! if should NOT write to the restart pointer file ! @@ -239,6 +247,12 @@ subroutine restFile_write( bounds, file, carbonflux_vars=carbonflux_vars) end if + if (use_betr) then + call tracerstate_vars%Restart(bounds, ncid, flag='define', betrtracer_vars=betrtracer_vars) + call tracerflux_vars%Restart( bounds, ncid, flag='define', betrtracer_vars=betrtracer_vars) + call tracercoeff_vars%Restart(bounds, ncid, flag='define', betrtracer_vars=betrtracer_vars) + endif + if (present(rdate)) then call hist_restart_ncd (bounds, ncid, flag='define', rdate=rdate ) end if @@ -330,6 +344,12 @@ subroutine restFile_write( bounds, file, carbonflux_vars=carbonflux_vars) end if + if (use_betr) then + call tracerstate_vars%Restart(bounds, ncid, flag='write', betrtracer_vars=betrtracer_vars) + call tracerflux_vars%Restart( bounds, ncid, flag='write', betrtracer_vars=betrtracer_vars) + call tracercoeff_vars%Restart(bounds, ncid, flag='write', betrtracer_vars=betrtracer_vars) + endif + call hist_restart_ncd (bounds, ncid, flag='write' ) ! -------------------------------------------- @@ -358,9 +378,10 @@ subroutine restFile_read( bounds, file, carbonstate_vars, c13_carbonstate_vars, c14_carbonstate_vars, carbonflux_vars, & ch4_vars, dgvs_vars, energyflux_vars, frictionvel_vars, lakestate_vars, & nitrogenstate_vars, nitrogenflux_vars, photosyns_vars, soilhydrology_vars, & - soilstate_vars, solarabs_vars, surfalb_vars, temperature_vars, & - waterflux_vars, waterstate_vars, EDbio_vars,& - phosphorusstate_vars,phosphorusflux_vars) + soilstate_vars, solarabs_vars, surfalb_vars, temperature_vars, & + waterflux_vars, waterstate_vars, EDbio_vars, & + phosphorusstate_vars,phosphorusflux_vars, & + betrtracer_vars, tracerstate_vars, tracerflux_vars, tracercoeff_vars) ! ! !DESCRIPTION: ! Read a CLM restart file. @@ -397,10 +418,12 @@ subroutine restFile_read( bounds, file, type(waterstate_type) , intent(inout) :: waterstate_vars type(waterflux_type) , intent(inout) :: waterflux_vars type(EDbio_type) , intent(inout) :: EDbio_vars - type(phosphorusstate_type) , intent(inout) :: phosphorusstate_vars type(phosphorusflux_type) , intent(inout) :: phosphorusflux_vars - + type(tracerstate_type) , intent(inout) :: tracerstate_vars ! due to Betrrest call + type(BeTRTracer_Type) , intent(in) :: betrtracer_vars + type(tracerflux_type) , intent(inout) :: tracerflux_vars + type(tracercoeff_type) , intent(inout) :: tracercoeff_vars ! ! !LOCAL VARIABLES: type(file_desc_t) :: ncid ! netcdf id @@ -502,6 +525,12 @@ subroutine restFile_read( bounds, file, carbonflux_vars=carbonflux_vars) end if + if (use_betr) then + call tracerstate_vars%Restart(bounds, ncid, flag='read',betrtracer_vars=betrtracer_vars) + call tracerflux_vars%Restart( bounds, ncid, flag='read',betrtracer_vars=betrtracer_vars) + call tracercoeff_vars%Restart(bounds, ncid, flag='read', betrtracer_vars=betrtracer_vars) + endif + call hist_restart_ncd (bounds, ncid, flag='read') ! Do error checking on file @@ -762,7 +791,7 @@ subroutine restFile_dimset( ncid ) use clm_time_manager , only : get_nstep use clm_varctl , only : caseid, ctitle, version, username, hostname, fsurdat use clm_varctl , only : flanduse_timeseries, conventions, source - use clm_varpar , only : numrad, nlevlak, nlevsno, nlevgrnd, nlevurb, nlevcan + use clm_varpar , only : numrad, nlevlak, nlevsno, nlevgrnd, nlevurb, nlevcan, nlevtrc_full use clm_varpar , only : cft_lb, cft_ub, maxpatch_glcmec use decompMod , only : get_proc_global ! @@ -803,6 +832,7 @@ subroutine restFile_dimset( ncid ) call ncd_defdim(ncid , 'numrad' , numrad , dimid) call ncd_defdim(ncid , 'levcan' , nlevcan , dimid) call ncd_defdim(ncid , 'string_length', 64 , dimid) + call ncd_defdim(ncid , 'levtrc' , nlevtrc_full , dimid) if (create_glacier_mec_landunit) then call ncd_defdim(ncid , 'glc_nec', maxpatch_glcmec, dimid) end if