Commit 7cd90438 authored by Jorn Bruggeman's avatar Jorn Bruggeman
Browse files

test case clean-up

parent f9b2abdf
#include "fabm_driver.h" #include "fabm_driver.h"
!-----------------------------------------------------------------------
!BOP ! Fennel & Neumann 1996 NPZD model - detritus component
!
! !MODULE: examples_npzd_det - Fennel & Neumann 1996 NPZD model - detritus component
!
! !INTERFACE:
module examples_npzd_det
!
! !DESCRIPTION:
! This model features a single detritus variable, characterized by a rate of decay (rdn) ! This model features a single detritus variable, characterized by a rate of decay (rdn)
! and a sinking rate. Mineralized detritus feeds into a dissolved mineral pool that must ! and a sinking rate. Mineralized detritus feeds into a dissolved mineral pool that must
! be provided by an external model (e.g., examples_npzd_nut). ! be provided by an external model (e.g., examples_npzd_nut).
!
! !USES: module examples_npzd_det
use fabm_types use fabm_types
implicit none implicit none
private private
!
! !PUBLIC DERIVED TYPES: type, extends(type_base_model),public :: type_examples_npzd_det
type,extends(type_base_model),public :: type_examples_npzd_det ! Variable identifiers
! Variable identifiers
type (type_state_variable_id) :: id_d type (type_state_variable_id) :: id_d
type (type_state_variable_id) :: id_mintarget type (type_state_variable_id) :: id_mintarget
! Model parameters ! Model parameters
real(rk) :: rdn real(rk) :: rdn
contains contains
procedure :: initialize procedure :: initialize
procedure :: do procedure :: do
procedure :: do_ppdd procedure :: do_ppdd
end type end type
!EOP
!-----------------------------------------------------------------------
contains contains
!----------------------------------------------------------------------- subroutine initialize(self, configunit)
!BOP class (type_examples_npzd_det), intent(inout), target :: self
! integer, intent(in) :: configunit
! !IROUTINE: Initialise the Detritus model
! real(rk), parameter :: d_per_s = 1.0_rk/86400.0_rk
! !INTERFACE: real(rk) :: w_d, kc
subroutine initialize(self,configunit)
! ! Store parameter values in our own derived type
! !DESCRIPTION: ! NB: all rates must be provided in values per day and are converted here to values per second.
! Here, parameter values are read and variables exported call self%get_parameter(w_d, 'w_d', 'm d-1', 'vertical velocity (<0 for sinking)', default=-5.0_rk, scale_factor=d_per_s)
! by the model are registered with FABM. call self%get_parameter(kc, 'kc', 'm2 mmol-1', 'specific light extinction', default=0.03_rk)
! call self%get_parameter(self%rdn, 'rdn', 'd-1', 'remineralization rate', default=0.003_rk, scale_factor=d_per_s)
! !INPUT PARAMETERS:
class (type_examples_npzd_det), intent(inout), target :: self
integer, intent(in) :: configunit
!
! !LOCAL VARIABLES:
real(rk), parameter :: d_per_s = 1.0_rk/86400.0_rk
real(rk) :: w_d, kc
!EOP
!-----------------------------------------------------------------------
!BOC
! Store parameter values in our own derived type
! NB: all rates must be provided in values per day and are converted here to values per second.
call self%get_parameter(w_d, 'w_d', 'm d-1', 'vertical velocity (<0 for sinking)', default=-5.0_rk, scale_factor=d_per_s)
call self%get_parameter(kc, 'kc', 'm2 mmol-1', 'specific light extinction', default=0.03_rk)
call self%get_parameter(self%rdn, 'rdn', 'd-1', 'remineralization rate', default=0.003_rk, scale_factor=d_per_s)
! Register state variables ! Register state variables
call self%register_state_variable(self%id_d, 'c','mmol m-3', 'concentration', 4.5_rk, & call self%register_state_variable(self%id_d, 'c','mmol m-3', 'concentration', 4.5_rk, &
minimum=0.0_rk, vertical_movement=w_d, specific_light_extinction=kc) minimum=0.0_rk, vertical_movement=w_d, specific_light_extinction=kc)
! Register contribution of state to global aggregate variables. ! Register contribution of state to global aggregate variables.
call self%add_to_aggregate_variable(standard_variables%total_nitrogen, self%id_d) call self%add_to_aggregate_variable(standard_variables%total_nitrogen, self%id_d)
! Register dependencies on external state variables ! Register dependencies on external state variables
call self%register_state_dependency(self%id_mintarget, 'mineralisation_target', 'mmol m-3', 'sink for remineralized matter') call self%register_state_dependency(self%id_mintarget, 'mineralisation_target', 'mmol m-3', 'sink for remineralized matter')
end subroutine initialize end subroutine initialize
!EOC
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: Right hand sides of Detritus model
!
! !INTERFACE:
subroutine do(self, _ARGUMENTS_DO_) subroutine do(self, _ARGUMENTS_DO_)
! class (type_examples_npzd_det), intent(in) :: self
! !INPUT PARAMETERS: _DECLARE_ARGUMENTS_DO_
class (type_examples_npzd_det), intent(in) :: self
_DECLARE_ARGUMENTS_DO_ real(rk) :: d
!
! !LOCAL VARIABLES:
real(rk) :: d
!EOP
!-----------------------------------------------------------------------
!BOC
! Enter spatial loops (if any)
_LOOP_BEGIN_
! Retrieve current (local) state variable values. ! Enter spatial loops (if any)
_GET_(self%id_d, d) ! detritus _LOOP_BEGIN_
! Set temporal derivatives ! Retrieve current (local) state variable values.
_SET_ODE_(self%id_d, -self%rdn*d) _GET_(self%id_d, d) ! detritus
_SET_ODE_(self%id_mintarget, self%rdn*d)
! Leave spatial loops (if any) ! Set temporal derivatives
_LOOP_END_ _SET_ODE_(self%id_d, -self%rdn*d)
_SET_ODE_(self%id_mintarget, self%rdn*d)
! Leave spatial loops (if any)
_LOOP_END_
end subroutine do end subroutine do
!EOC
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: Right hand sides of Detritus model exporting production/destruction matrices
!
! !INTERFACE:
subroutine do_ppdd(self, _ARGUMENTS_DO_PPDD_) subroutine do_ppdd(self, _ARGUMENTS_DO_PPDD_)
! class (type_examples_npzd_det), intent(in) :: self
! !INPUT PARAMETERS: _DECLARE_ARGUMENTS_DO_PPDD_
class (type_examples_npzd_det), intent(in) :: self
_DECLARE_ARGUMENTS_DO_PPDD_
!
! !LOCAL VARIABLES:
real(rk) :: d
!EOP
!-----------------------------------------------------------------------
!BOC
! Enter spatial loops (if any)
_LOOP_BEGIN_
! Retrieve current (local) state variable values. real(rk) :: d
_GET_(self%id_d, d) ! detritus
! Assign destruction rates to different elements of the destruction matrix. ! Enter spatial loops (if any)
! By assigning with _SET_DD_SYM_ [as opposed to _SET_DD_], assignments to dd(i,j) _LOOP_BEGIN_
! are automatically assigned to pp(j,i) as well.
_SET_DD_SYM_(self%id_d, self%id_mintarget, self%rdn*d)
! Leave spatial loops (if any) ! Retrieve current (local) state variable values.
_LOOP_END_ _GET_(self%id_d, d) ! detritus
end subroutine do_ppdd ! Assign destruction rates to different elements of the destruction matrix.
!EOC ! By assigning with _SET_DD_SYM_ [as opposed to _SET_DD_], assignments to dd(i,j)
! are automatically assigned to pp(j,i) as well.
_SET_DD_SYM_(self%id_d, self%id_mintarget, self%rdn*d)
!----------------------------------------------------------------------- ! Leave spatial loops (if any)
_LOOP_END_
end subroutine do_ppdd
end module examples_npzd_det end module examples_npzd_det
......
#include "fabm_driver.h" #include "fabm_driver.h"
!-----------------------------------------------------------------------
!BOP ! Fennel & Neumann 1996 NPZD model - nutrient component
!
! !MODULE: examples_npzd_nut - Fennel & Neumann 1996 NPZD model - nutrient component
!
! !INTERFACE:
module examples_npzd_nut
!
! !DESCRIPTION:
! This is a general nutrient (passive non-sinking, non-floating tracer), characterized by ! This is a general nutrient (passive non-sinking, non-floating tracer), characterized by
! an initial concentration only. ! an initial concentration only.
!
! !USES: module examples_npzd_nut
use fabm_types use fabm_types
implicit none implicit none
! default: all is private.
private private
!
! !PUBLIC DERIVED TYPES: type, extends(type_base_model),public :: type_examples_npzd_nut
type,extends(type_base_model),public :: type_examples_npzd_nut ! Variable identifiers
! Variable identifiers
type (type_state_variable_id) :: id_n type (type_state_variable_id) :: id_n
contains contains
procedure :: initialize procedure :: initialize
end type end type
!EOP
!-----------------------------------------------------------------------
contains contains
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: Initialise the nutrient component
!
! !INTERFACE:
subroutine initialize(self, configunit) subroutine initialize(self, configunit)
! class (type_examples_npzd_nut), intent(inout), target :: self
! !DESCRIPTION: integer, intent(in) :: configunit
! Here, parameter values are read and variables exported
! by the model are registered with FABM.
!
! !INPUT PARAMETERS:
class (type_examples_npzd_nut), intent(inout), target :: self
integer, intent(in) :: configunit
!EOP
!-----------------------------------------------------------------------
!BOC
! Register state variables
call self%register_state_variable(self%id_n, 'c', 'mmol m-3', 'concentration', 1.0_rk, minimum=0.0_rk, no_river_dilution=.true.)
! Register contribution of state to global aggregate variables. ! Register state variables
call self%add_to_aggregate_variable(standard_variables%total_nitrogen, self%id_n) call self%register_state_variable(self%id_n, 'c', 'mmol m-3', 'concentration', 1.0_rk, minimum=0.0_rk, no_river_dilution=.true.)
! Register contribution of state to global aggregate variables.
call self%add_to_aggregate_variable(standard_variables%total_nitrogen, self%id_n)
end subroutine initialize end subroutine initialize
!EOC
!-----------------------------------------------------------------------
end module examples_npzd_nut end module examples_npzd_nut
......
#include "fabm_driver.h" #include "fabm_driver.h"
!----------------------------------------------------------------------- ! Fennel & Neumann 1996 NPZD model - phytoplankton component
!BOP
!
! !MODULE: examples_npzd_phy - Fennel & Neumann 1996 NPZD model - phytoplankton component
!
! !INTERFACE:
module examples_npzd_phy module examples_npzd_phy
!
! !DESCRIPTION:
!
! !USES:
use fabm_types use fabm_types
implicit none implicit none
! default: all is private.
private private
!
! !PUBLIC DERIVED TYPES:
type,extends(type_base_model),public :: type_examples_npzd_phy
! Variable identifiers
type (type_state_variable_id) :: id_p
type (type_state_variable_id) :: id_exctarget,id_morttarget,id_upttarget
type (type_dependency_id) :: id_par
type (type_horizontal_dependency_id) :: id_I_0
type (type_diagnostic_variable_id) :: id_GPP,id_NCP,id_PPR,id_NPR,id_dPAR
! Model parameters
real(rk) :: p0,z0,kc,i_min,rmax,gmax,iv,alpha,rpn,rpdu,rpdl
real(rk) :: dic_per_n
contains type, extends(type_base_model), public :: type_examples_npzd_phy
! Variable identifiers
type (type_state_variable_id) :: id_p
type (type_state_variable_id) :: id_exctarget,id_morttarget,id_upttarget
type (type_dependency_id) :: id_par
type (type_surface_dependency_id) :: id_I_0
type (type_diagnostic_variable_id) :: id_GPP,id_NCP,id_PPR,id_NPR,id_dPAR
! Model parameters
real(rk) :: p0,z0,kc,i_min,rmax,gmax,iv,alpha,rpn,rpdu,rpdl
real(rk) :: dic_per_n
contains
procedure :: initialize procedure :: initialize
procedure :: do procedure :: do
procedure :: do_ppdd procedure :: do_ppdd
procedure :: get_light_extinction
end type end type
!EOP
!-----------------------------------------------------------------------
contains contains
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: Initialise the NPZD model
!
! !INTERFACE:
subroutine initialize(self, configunit) subroutine initialize(self, configunit)
! class (type_examples_npzd_phy), intent(inout), target :: self
! !DESCRIPTION: integer, intent(in) :: configunit
! Here, parameter values are read and variables exported
! by the model are registered with FABM. real(rk), parameter :: d_per_s = 1.0_rk/86400.0_rk
! real(rk) :: w_p
! !INPUT PARAMETERS:
class (type_examples_npzd_phy), intent(inout), target :: self ! Store parameter values in our own derived type
integer, intent(in) :: configunit ! NB: all rates must be provided in values per day and are converted here to values per second.
! call self%get_parameter(self%p0, 'p0', 'mmol m-3', 'background concentration ', default=0.0225_rk)
! !LOCAL VARIABLES: call self%get_parameter(self%kc, 'kc', 'm2 mmol-1', 'specific light extinction', default=0.03_rk)
real(rk), parameter :: d_per_s = 1.0_rk/86400.0_rk call self%get_parameter(self%i_min, 'i_min', 'W m-2', 'minimum light intensity in euphotic zone', default=25.0_rk)
real(rk) :: w_p call self%get_parameter(self%rmax, 'rmax', 'd-1', 'maximum specific growth rate', default=1.0_rk, scale_factor=d_per_s)
!EOP call self%get_parameter(self%alpha, 'alpha', 'mmol m-3', 'half-saturation nutrient concentration', default=0.3_rk)
!----------------------------------------------------------------------- call self%get_parameter(self%rpn, 'rpn', 'd-1', 'excretion rate', default=0.01_rk, scale_factor=d_per_s)
!BOC call self%get_parameter(self%rpdu, 'rpdu', 'd-1', 'mortality in euphotic zone', default=0.02_rk, scale_factor=d_per_s)
! Store parameter values in our own derived type call self%get_parameter(self%rpdl, 'rpdl', 'd-1', 'mortality below euphotic zone', default=0.1_rk, scale_factor=d_per_s)
! NB: all rates must be provided in values per day and are converted here to values per second. call self%get_parameter(w_p, 'w_p', 'm d-1', 'vertical velocity (<0 for sinking)', default=-1.0_rk, scale_factor=d_per_s)
call self%get_parameter(self%p0, 'p0', 'mmol m-3', 'background concentration ', default=0.0225_rk)
call self%get_parameter(self%kc, 'kc', 'm2 mmol-1', 'specific light extinction', default=0.03_rk) ! Register state variables
call self%get_parameter(self%i_min, 'i_min', 'W m-2', 'minimum light intensity in euphotic zone', default=25.0_rk) call self%register_state_variable(self%id_p, 'c', 'mmol m-3', 'concentration', 0.0_rk, minimum=0.0_rk, vertical_movement=w_p)
call self%get_parameter(self%rmax, 'rmax', 'd-1', 'maximum specific growth rate', default=1.0_rk, scale_factor=d_per_s)
call self%get_parameter(self%alpha, 'alpha', 'mmol m-3', 'half-saturation nutrient concentration', default=0.3_rk) ! Register contribution of state to global aggregate variables.
call self%get_parameter(self%rpn, 'rpn', 'd-1', 'excretion rate', default=0.01_rk, scale_factor=d_per_s) call self%add_to_aggregate_variable(standard_variables%total_nitrogen, self%id_p)
call self%get_parameter(self%rpdu, 'rpdu', 'd-1', 'mortality in euphotic zone', default=0.02_rk, scale_factor=d_per_s)
call self%get_parameter(self%rpdl, 'rpdl', 'd-1', 'mortality below euphotic zone', default=0.1_rk, scale_factor=d_per_s) ! Register dependencies on external state variables
call self%get_parameter(w_p, 'w_p', 'm d-1', 'vertical velocity (<0 for sinking)', default=-1.0_rk, scale_factor=d_per_s) call self%register_state_dependency(self%id_upttarget, 'uptake_target', 'mmol m-3', 'nutrient source')
call self%register_state_dependency(self%id_exctarget, 'excretion_target', 'mmol m-3', 'sink for excreted matter')
! Register state variables call self%register_state_dependency(self%id_morttarget, 'mortality_target', 'mmol m-3', 'sink for dead matter')
call self%register_state_variable(self%id_p, 'c', 'mmol m-3', 'concentration', 0.0_rk, minimum=0.0_rk, vertical_movement=w_p)
! Register diagnostic variables
! Register contribution of state to global aggregate variables. call self%register_diagnostic_variable(self%id_GPP, 'GPP', 'mmol m-3', 'gross primary production')
call self%add_to_aggregate_variable(standard_variables%total_nitrogen, self%id_p) call self%register_diagnostic_variable(self%id_NCP, 'NCP', 'mmol m-3', 'net community production')
call self%register_diagnostic_variable(self%id_PPR, 'PPR', 'mmol m-3 d-1', 'gross primary production rate')
! Register dependencies on external state variables call self%register_diagnostic_variable(self%id_NPR, 'NPR', 'mmol m-3 d-1', 'net community production rate')
call self%register_state_dependency(self%id_upttarget, 'uptake_target', 'mmol m-3', 'nutrient source') call self%register_diagnostic_variable(self%id_dPAR, 'PAR', 'W m-2', 'photosynthetically active radiation')
call self%register_state_dependency(self%id_exctarget, 'excretion_target', 'mmol m-3', 'sink for excreted matter')
call self%register_state_dependency(self%id_morttarget, 'mortality_target', 'mmol m-3', 'sink for dead matter') ! Register environmental dependencies
call self%register_dependency(self%id_par, standard_variables%downwelling_photosynthetic_radiative_flux)
! Register diagnostic variables call self%register_dependency(self%id_I_0, standard_variables%surface_downwelling_photosynthetic_radiative_flux)
call self%register_diagnostic_variable(self%id_GPP, 'GPP', 'mmol m-3', 'gross primary production')
call self%register_diagnostic_variable(self%id_NCP, 'NCP', 'mmol m-3', 'net community production') ! Contribute to light attentuation
call self%register_diagnostic_variable(self%id_PPR, 'PPR', 'mmol m-3 d-1', 'gross primary production rate') call self%add_to_aggregate_variable(standard_variables%attenuation_coefficient_of_photosynthetic_radiative_flux, self%id_p, scale_factor=self%kc)
call self%register_diagnostic_variable(self%id_NPR, 'NPR', 'mmol m-3 d-1', 'net community production rate') call self%add_to_aggregate_variable(standard_variables%attenuation_coefficient_of_photosynthetic_radiative_flux, self%p0 * self%kc)
call self%register_diagnostic_variable(self%id_dPAR, 'PAR', 'W m-2', 'photosynthetically active radiation')
! Register environmental dependencies
call self%register_dependency(self%id_par, standard_variables%downwelling_photosynthetic_radiative_flux)
call self%register_dependency(self%id_I_0, standard_variables%surface_downwelling_photosynthetic_radiative_flux)
end subroutine initialize end subroutine initialize
!EOC
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: Right hand sides of NPZD model
!
! !INTERFACE:
subroutine do(self, _ARGUMENTS_DO_) subroutine do(self, _ARGUMENTS_DO_)
! class (type_examples_npzd_phy), intent(in) :: self
! !INPUT PARAMETERS: _DECLARE_ARGUMENTS_DO_
class (type_examples_npzd_phy), intent(in) :: self
_DECLARE_ARGUMENTS_DO_ real(rk) :: n, p, par, I_0
! real(rk) :: iopt, rpd, primprod
! !LOCAL VARIABLES: real(rk), parameter :: secs_pr_day = 86400.0_rk
real(rk) :: n, p, par, I_0
real(rk) :: iopt, rpd, primprod ! Enter spatial loops (if any)
real(rk), parameter :: secs_pr_day = 86400.0_rk _LOOP_BEGIN_
!EOP
!----------------------------------------------------------------------- ! Retrieve current (local) state variable values.
!BOC _GET_(self%id_p,p) ! phytoplankton
! Enter spatial loops (if any) _GET_(self%id_upttarget,n) ! nutrients
_LOOP_BEGIN_
! Retrieve current environmental conditions.
! Retrieve current (local) state variable values. _GET_(self%id_par,par) ! local photosynthetically active radiation
_GET_(self%id_p,p) ! phytoplankton _GET_SURFACE_(self%id_I_0,I_0) ! surface photosynthetically active radiation
_GET_(self%id_upttarget,n) ! nutrients
! Light acclimation formulation based on surface light intensity.
! Retrieve current environmental conditions. iopt = max(0.25*I_0,self%I_min)
_GET_(self%id_par,par) ! local photosynthetically active radiation
_GET_HORIZONTAL_(self%id_I_0,I_0) ! surface short wave radiation ! Loss rate of phytoplankton to detritus depends on local light intensity.
if (par>=self%I_min) then
! Light acclimation formulation based on surface light intensity. rpd = self%rpdu
iopt = max(0.25*I_0,self%I_min) else
rpd = self%rpdl
! Loss rate of phytoplankton to detritus depends on local light intensity. end if
if (par>=self%I_min) then
rpd = self%rpdu ! Define some intermediate quantities that will be reused multiple times.
else primprod = fnp(self%rmax, self%alpha, n, p + self%p0, par, iopt)
rpd = self%rpdl
end if ! Set temporal derivatives
_SET_ODE_(self%id_p,primprod - self%rpn*p - rpd*p)
! Define some intermediate quantities that will be reused multiple times.
primprod = fnp(self,n,p,par,iopt) ! If an externally maintained ...
_SET_ODE_(self%id_upttarget,-primprod)
! Set temporal derivatives _SET_ODE_(self%id_morttarget,rpd*p)
_SET_ODE_(self%id_p,primprod - self%rpn*p - rpd*p) _SET_ODE_(self%id_exctarget,self%rpn*p)
! If an externally maintained ... ! Export diagnostic variables
_SET_ODE_(self%id_upttarget,-primprod) _SET_DIAGNOSTIC_(self%id_dPAR,par)
_SET_ODE_(self%id_morttarget,rpd*p) _SET_DIAGNOSTIC_(self%id_GPP ,primprod)
_SET_ODE_(self%id_exctarget,self%rpn*p) _SET_DIAGNOSTIC_(self%id_NCP ,primprod - self%rpn*p)
_SET_DIAGNOSTIC_(self%id_PPR ,primprod*secs_pr_day)
! Export diagnostic variables _SET_DIAGNOSTIC_(self%id_NPR ,(primprod - self%rpn*p)*secs_pr_day)
_SET_DIAGNOSTIC_(self%id_dPAR,par)
_SET_DIAGNOSTIC_(self%id_GPP ,primprod) ! Leave spatial loops (if any)