Commit 50317b5f authored by Jorn Bruggeman's avatar Jorn Bruggeman
Browse files

standardized do_column

parent 9f0d2912
......@@ -227,6 +227,7 @@
#define _ARGUMENTS_DO_SURFACE_ _ARGUMENTS_HORIZONTAL_
#define _ARGUMENTS_DO_BOTTOM_ _ARGUMENTS_HORIZONTAL_
#define _ARGUMENTS_DO_BOTTOM_PPDD_ _ARGUMENTS_HORIZONTAL_,pp,dd,benthos_offset
#define _ARGUMENTS_DO_COLUMN_ _ARGUMENTS_VERTICAL_
#define _ARGUMENTS_GET_VERTICAL_MOVEMENT_ _ARGUMENTS_INTERIOR_
#define _ARGUMENTS_GET_EXTINCTION_ _ARGUMENTS_INTERIOR_
#define _ARGUMENTS_GET_DRAG_ _ARGUMENTS_HORIZONTAL_
......@@ -242,6 +243,7 @@
#define _DECLARE_ARGUMENTS_DO_PPDD_ _DECLARE_ARGUMENTS_INTERIOR_;real(rke) _DIMENSION_SLICE_PLUS_2_,intent(inout) :: pp,dd
#define _DECLARE_ARGUMENTS_DO_BOTTOM_ _DECLARE_ARGUMENTS_HORIZONTAL_
#define _DECLARE_ARGUMENTS_DO_BOTTOM_PPDD_ _DECLARE_ARGUMENTS_HORIZONTAL_;real(rke) _DIMENSION_HORIZONTAL_SLICE_PLUS_2_,intent(inout) :: pp,dd;integer,intent(in) :: benthos_offset
#define _DECLARE_ARGUMENTS_DO_COLUMN_ _DECLARE_ARGUMENTS_VERTICAL_
#define _DECLARE_ARGUMENTS_DO_SURFACE_ _DECLARE_ARGUMENTS_HORIZONTAL_
#define _DECLARE_ARGUMENTS_GET_VERTICAL_MOVEMENT_ _DECLARE_ARGUMENTS_INTERIOR_
#define _DECLARE_ARGUMENTS_GET_EXTINCTION_ _DECLARE_ARGUMENTS_INTERIOR_
......
......@@ -129,7 +129,7 @@ module fabm_builtin_models
logical :: average = .false.
contains
procedure :: initialize => depth_integral_initialize
procedure :: get_light => depth_integral_do_column
procedure :: do_column => depth_integral_do_column
procedure :: after_coupling => depth_integral_after_coupling
end type
......@@ -137,7 +137,7 @@ module fabm_builtin_models
real(rk) :: minimum_depth = 0.0_rk
real(rk) :: maximum_depth = huge(1.0_rk)
contains
procedure :: get_light => bounded_depth_integral_do_column
procedure :: do_column => bounded_depth_integral_do_column
end type
type, extends(type_base_model) :: type_interior_constant
......@@ -833,9 +833,9 @@ module fabm_builtin_models
if (associated(self%id_output%link%target, self%id_output%link%original)) self%id_output%link%target%units = trim(self%id_input%link%target%units)//'*m'
end subroutine depth_integral_after_coupling
subroutine depth_integral_do_column(self,_ARGUMENTS_VERTICAL_)
class (type_depth_integral),intent(in) :: self
_DECLARE_ARGUMENTS_VERTICAL_
subroutine depth_integral_do_column(self, _ARGUMENTS_DO_COLUMN_)
class (type_depth_integral), intent(in) :: self
_DECLARE_ARGUMENTS_DO_COLUMN_
real(rk) :: h,value,result,depth
......@@ -852,9 +852,9 @@ module fabm_builtin_models
_SET_HORIZONTAL_DIAGNOSTIC_(self%id_output, result)
end subroutine depth_integral_do_column
subroutine bounded_depth_integral_do_column(self,_ARGUMENTS_VERTICAL_)
class (type_bounded_depth_integral),intent(in) :: self
_DECLARE_ARGUMENTS_VERTICAL_
subroutine bounded_depth_integral_do_column(self, _ARGUMENTS_DO_COLUMN_)
class (type_bounded_depth_integral), intent(in) :: self
_DECLARE_ARGUMENTS_DO_COLUMN_
real(rk) :: h,value,cum,depth
logical :: started
......
......@@ -583,13 +583,8 @@ module fabm_types
procedure :: do_horizontal => base_do_horizontal
procedure :: do_ppdd => base_do_ppdd
procedure :: do_bottom_ppdd => base_do_bottom_ppdd
! Advanced functionality: variable vertical movement and light attenuation, feedbacks to drag and albedo.
procedure :: do_column => base_do_column
procedure :: get_vertical_movement => base_get_vertical_movement
procedure :: get_light_extinction => base_get_light_extinction
procedure :: get_drag => base_get_drag
procedure :: get_albedo => base_get_albedo
procedure :: get_light => base_get_light
! Bookkeeping: calculate total of conserved quantities, check and repair model state.
procedure :: check_state => base_check_state
......@@ -605,6 +600,12 @@ module fabm_types
procedure :: implements
procedure :: register_implemented_routines
! Deprecated as of FABM 1.0
procedure :: get_light => base_get_light
procedure :: get_light_extinction => base_get_light_extinction
procedure :: get_drag => base_get_drag
procedure :: get_albedo => base_get_albedo
end type type_base_model
! ====================================================================================================
......@@ -731,45 +732,52 @@ contains
_DECLARE_ARGUMENTS_HORIZONTAL_
end subroutine
! Vertical movement, light attenuation, feedbacks to drag and albedo
subroutine base_do_column(self, _ARGUMENTS_DO_COLUMN_)
class (type_base_model), intent(in) :: self
_DECLARE_ARGUMENTS_DO_COLUMN_
call self%get_light(_ARGUMENTS_DO_COLUMN_)
end subroutine
subroutine base_get_vertical_movement(self, _ARGUMENTS_GET_VERTICAL_MOVEMENT_)
class (type_base_model), intent(in) :: self
_DECLARE_ARGUMENTS_GET_VERTICAL_MOVEMENT_
end subroutine
subroutine base_get_light_extinction(self, _ARGUMENTS_GET_EXTINCTION_)
subroutine base_check_state(self, _ARGUMENTS_CHECK_STATE_)
class (type_base_model), intent(in) :: self
_DECLARE_ARGUMENTS_GET_EXTINCTION_
_DECLARE_ARGUMENTS_CHECK_STATE_
end subroutine
subroutine base_get_drag(self, _ARGUMENTS_GET_DRAG_)
subroutine base_check_surface_state(self, _ARGUMENTS_CHECK_SURFACE_STATE_)
class (type_base_model), intent(in) :: self
_DECLARE_ARGUMENTS_GET_DRAG_
_DECLARE_ARGUMENTS_CHECK_SURFACE_STATE_
end subroutine
subroutine base_get_albedo(self, _ARGUMENTS_GET_ALBEDO_)
subroutine base_check_bottom_state(self, _ARGUMENTS_CHECK_BOTTOM_STATE_)
class (type_base_model), intent(in) :: self
_DECLARE_ARGUMENTS_GET_ALBEDO_
_DECLARE_ARGUMENTS_CHECK_BOTTOM_STATE_
end subroutine
subroutine base_get_light(self, _ARGUMENTS_VERTICAL_)
! Deprecated as of FABM 1.0:
subroutine base_get_light_extinction(self, _ARGUMENTS_GET_EXTINCTION_)
class (type_base_model), intent(in) :: self
_DECLARE_ARGUMENTS_VERTICAL_
_DECLARE_ARGUMENTS_GET_EXTINCTION_
end subroutine
subroutine base_check_state(self, _ARGUMENTS_CHECK_STATE_)
subroutine base_get_drag(self, _ARGUMENTS_GET_DRAG_)
class (type_base_model), intent(in) :: self
_DECLARE_ARGUMENTS_CHECK_STATE_
_DECLARE_ARGUMENTS_GET_DRAG_
end subroutine
subroutine base_check_surface_state(self, _ARGUMENTS_CHECK_SURFACE_STATE_)
subroutine base_get_albedo(self, _ARGUMENTS_GET_ALBEDO_)
class (type_base_model), intent(in) :: self
_DECLARE_ARGUMENTS_CHECK_SURFACE_STATE_
_DECLARE_ARGUMENTS_GET_ALBEDO_
end subroutine
subroutine base_check_bottom_state(self, _ARGUMENTS_CHECK_BOTTOM_STATE_)
subroutine base_get_light(self, _ARGUMENTS_DO_COLUMN_)
class (type_base_model), intent(in) :: self
_DECLARE_ARGUMENTS_CHECK_BOTTOM_STATE_
_DECLARE_ARGUMENTS_DO_COLUMN_
end subroutine
function base_get_path(self) result(path)
......
......@@ -753,7 +753,7 @@ end subroutine end_vertical_task
call invalidate_vertical_call_output(task%calls(icall), cache)
#endif
call task%calls(icall)%model%get_light(cache)
call task%calls(icall)%model%do_column(cache)
#ifndef NDEBUG
call check_vertical_call_output(task%calls(icall), cache)
......
......@@ -31,7 +31,7 @@ module akvaplan_plume_injection
contains
! Model procedures
procedure :: initialize
procedure :: get_light => do_column ! NB operating in the vertical is currently only supported in "get_light"
procedure :: do_column
end type
contains
......@@ -52,9 +52,9 @@ contains
call self%register_diagnostic_variable(self%id_flux,'flux','quantity m-3 s-1','depth-explicit tracer flux',source=source_do_column,prefill_value=0.0_rk)
end subroutine initialize
subroutine do_column(self,_ARGUMENTS_VERTICAL_)
subroutine do_column(self,_ARGUMENTS_DO_COLUMN_)
class (type_plume_injection),intent(in) :: self
_DECLARE_ARGUMENTS_VERTICAL_
_DECLARE_ARGUMENTS_DO_COLUMN_
real(rk) :: flux_int,rho,h
......
......@@ -41,17 +41,17 @@ module nonlocal
type (type_dependency_id) :: id_thickness
contains
procedure :: initialize => depth_integral_initialize
procedure :: get_light => depth_integral_do ! currently only get_light supports non-local action in depth
procedure :: do_column => depth_integral_do_column
end type
type,extends(type_base_model) :: type_depth_integral_rate_distributor
type, extends(type_base_model) :: type_depth_integral_rate_distributor
type (type_horizontal_dependency_id) :: id_integral ! Depth-integrated target variable
type (type_horizontal_dependency_id) :: id_sms ! Depth-integrated sources-sinks of target variable
type (type_state_variable_id) :: id_target ! Depth-explicit variable that should absorp the sources-sinks
type (type_dependency_id) :: id_weights ! Weights for the vertical distribution of the sinks and sources
contains
procedure :: initialize => depth_integral_rate_distributor_initialize
procedure :: do => depth_integral_rate_distributor_do ! currently only get_light supports non-local action in depth
procedure :: do => depth_integral_rate_distributor_do
end type
contains
......@@ -114,9 +114,9 @@ contains
call rate_distributor%request_coupling(rate_distributor%id_sms,'result_sms_tot')
end subroutine depth_integral_initialize
subroutine depth_integral_do(self,_ARGUMENTS_VERTICAL_)
subroutine depth_integral_do_column(self, _ARGUMENTS_DO_COLUMN_)
class (type_depth_integral),intent(in) :: self
_DECLARE_ARGUMENTS_VERTICAL_
_DECLARE_ARGUMENTS_DO_COLUMN_
real(rk) :: local,weight,thickness,integral
......@@ -128,7 +128,7 @@ contains
integral = integral + local*weight*thickness
_VERTICAL_LOOP_END_
_SET_HORIZONTAL_DIAGNOSTIC_(self%id_integral,integral)
end subroutine depth_integral_do
end subroutine depth_integral_do_column
subroutine depth_integral_rate_distributor_initialize(self,configunit)
class (type_depth_integral_rate_distributor),intent(inout),target :: self
......
......@@ -20,16 +20,16 @@ module gotm_light
type (type_surface_diagnostic_variable_id) :: id_par0 ! Surface photosynthetically active radiation
! Parameters
real(rk) :: a,g1,g2
real(rk) :: a, g1, g2
contains
! Model procedures
procedure :: initialize
procedure :: get_light
procedure :: do_column
end type type_gotm_light
contains
subroutine initialize(self,configunit)
subroutine initialize(self, configunit)
class (type_gotm_light), intent(inout), target :: self
integer, intent(in) :: configunit
......@@ -46,14 +46,14 @@ contains
standard_variable=standard_variables%surface_downwelling_photosynthetic_radiative_flux, source=source_do_column)
! Register environmental dependencies (temperature, shortwave radiation)
call self%register_dependency(self%id_swr0,standard_variables%surface_downwelling_shortwave_flux)
call self%register_dependency(self%id_ext, standard_variables%attenuation_coefficient_of_photosynthetic_radiative_flux)
call self%register_dependency(self%id_dz, standard_variables%cell_thickness)
call self%register_dependency(self%id_swr0, standard_variables%surface_downwelling_shortwave_flux)
call self%register_dependency(self%id_ext, standard_variables%attenuation_coefficient_of_photosynthetic_radiative_flux)
call self%register_dependency(self%id_dz, standard_variables%cell_thickness)
end subroutine
subroutine get_light(self, _ARGUMENTS_VERTICAL_)
subroutine do_column(self, _ARGUMENTS_DO_COLUMN_)
class (type_gotm_light), intent(in) :: self
_DECLARE_ARGUMENTS_VERTICAL_
_DECLARE_ARGUMENTS_DO_COLUMN_
real(rk) :: swr0, dz, swr, par, z, ext, bioext
......@@ -71,7 +71,7 @@ contains
! Calculate photosynthetically active radiation (PAR), shortwave radiation, and PAR attenuation.
par = swr0 * (1.0_rk - self%a) * exp(-z / self%g2 - bioext)
swr = par + swr0 * self%A * exp(-z / self%g1)
swr = par + swr0 * self%a * exp(-z / self%g1)
! Move to bottom of layer
z = z + dz * 0.5_rk
......@@ -80,6 +80,6 @@ contains
_SET_DIAGNOSTIC_(self%id_swr,swr) ! Shortwave radiation at layer centre
_SET_DIAGNOSTIC_(self%id_par,par) ! Photosynthetically active radiation at layer centre
_VERTICAL_LOOP_END_
end subroutine get_light
end subroutine do_column
end module gotm_light
......@@ -42,7 +42,7 @@ contains
procedure :: do
procedure :: do_surface
procedure :: do_bottom
procedure :: get_light
procedure :: do_column
procedure :: get_vertical_movement
end type
......@@ -103,7 +103,7 @@ subroutine initialize(self,configunit)
end do
do i=1,self%nhz_diag_vert
write (strindex,'(i0)') i
call self%register_diagnostic_variable(self%id_horizontal_diag(self%nsurface_diag + self%nbottom_diag + i),'vert_hz_diagnostic'//trim(strindex),'','horizontal diagnostic variable set from get_light #'//trim(strindex),missing_value=-4999._rk - i,source=source_do_column)
call self%register_diagnostic_variable(self%id_horizontal_diag(self%nsurface_diag + self%nbottom_diag + i),'vert_hz_diagnostic'//trim(strindex),'','horizontal diagnostic variable set from do_column #'//trim(strindex),missing_value=-4999._rk - i,source=source_do_column)
end do
end subroutine initialize
......@@ -234,9 +234,9 @@ subroutine do_bottom(self,_ARGUMENTS_DO_SURFACE_)
_HORIZONTAL_LOOP_END_
end subroutine do_bottom
subroutine get_light(self,_ARGUMENTS_VERTICAL_)
subroutine do_column(self, _ARGUMENTS_DO_COLUMN_)
class (type_test_model),intent(in) :: self
_DECLARE_ARGUMENTS_VERTICAL_
_DECLARE_ARGUMENTS_DO_COLUMN_
integer :: i
real(rk) :: value
......@@ -246,29 +246,29 @@ subroutine get_light(self,_ARGUMENTS_VERTICAL_)
do i=1,self%nsurface_state
_GET_HORIZONTAL_(self%id_surface_state(i),value)
if (value/=i+surface_state_offset) call self%fatal_error('get_light','invalid value of surface state variable.')
if (value/=i+surface_state_offset) call self%fatal_error('do_column','invalid value of surface state variable.')
end do
do i=1,self%nbottom_state
_GET_HORIZONTAL_(self%id_bottom_state(i),value)
if (value/=i+bottom_state_offset) call self%fatal_error('get_light','invalid value of bottom state variable.')
if (value/=i+bottom_state_offset) call self%fatal_error('do_column','invalid value of bottom state variable.')
end do
_GET_HORIZONTAL_(self%id_hz_dep,value)
if (value/=1+horizontal_dependency_offset) call self%fatal_error('get_light','invalid value of horizontal dependency #1.')
if (value/=1+horizontal_dependency_offset) call self%fatal_error('do_column','invalid value of horizontal dependency #1.')
_VERTICAL_LOOP_BEGIN_
do i=1,self%nstate
_GET_(self%id_state(i),value)
if (value/=i+interior_state_offset) call self%fatal_error('get_light','invalid value of interior state variable.')
if (value/=i+interior_state_offset) call self%fatal_error('do_column','invalid value of interior state variable.')
end do
_GET_(self%id_dep,value)
if (value/=1+interior_dependency_offset) call self%fatal_error('get_light','invalid value of interior dependency #1.')
if (value/=1+interior_dependency_offset) call self%fatal_error('do_column','invalid value of interior dependency #1.')
_GET_(self%id_depth,value)
if (value <= old_depth) &
call self%fatal_error('get_light','depth is not increasing as expected.')
call self%fatal_error('do_column','depth is not increasing as expected.')
old_depth = value
do i=1,self%nint_diag_vert
......@@ -281,7 +281,7 @@ subroutine get_light(self,_ARGUMENTS_VERTICAL_)
do i=1,self%nhz_diag_vert
_SET_HORIZONTAL_DIAGNOSTIC_(self%id_horizontal_diag(self%nsurface_diag + self%nbottom_diag + i),4999._rk+i)
end do
end subroutine get_light
end subroutine do_column
subroutine get_vertical_movement(self,_ARGUMENTS_GET_VERTICAL_MOVEMENT_)
class (type_test_model),intent(in) :: self
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment