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

standardized do_column

parent 9f0d2912
...@@ -227,6 +227,7 @@ ...@@ -227,6 +227,7 @@
#define _ARGUMENTS_DO_SURFACE_ _ARGUMENTS_HORIZONTAL_ #define _ARGUMENTS_DO_SURFACE_ _ARGUMENTS_HORIZONTAL_
#define _ARGUMENTS_DO_BOTTOM_ _ARGUMENTS_HORIZONTAL_ #define _ARGUMENTS_DO_BOTTOM_ _ARGUMENTS_HORIZONTAL_
#define _ARGUMENTS_DO_BOTTOM_PPDD_ _ARGUMENTS_HORIZONTAL_,pp,dd,benthos_offset #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_VERTICAL_MOVEMENT_ _ARGUMENTS_INTERIOR_
#define _ARGUMENTS_GET_EXTINCTION_ _ARGUMENTS_INTERIOR_ #define _ARGUMENTS_GET_EXTINCTION_ _ARGUMENTS_INTERIOR_
#define _ARGUMENTS_GET_DRAG_ _ARGUMENTS_HORIZONTAL_ #define _ARGUMENTS_GET_DRAG_ _ARGUMENTS_HORIZONTAL_
...@@ -242,6 +243,7 @@ ...@@ -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_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_ _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_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_DO_SURFACE_ _DECLARE_ARGUMENTS_HORIZONTAL_
#define _DECLARE_ARGUMENTS_GET_VERTICAL_MOVEMENT_ _DECLARE_ARGUMENTS_INTERIOR_ #define _DECLARE_ARGUMENTS_GET_VERTICAL_MOVEMENT_ _DECLARE_ARGUMENTS_INTERIOR_
#define _DECLARE_ARGUMENTS_GET_EXTINCTION_ _DECLARE_ARGUMENTS_INTERIOR_ #define _DECLARE_ARGUMENTS_GET_EXTINCTION_ _DECLARE_ARGUMENTS_INTERIOR_
......
...@@ -129,7 +129,7 @@ module fabm_builtin_models ...@@ -129,7 +129,7 @@ module fabm_builtin_models
logical :: average = .false. logical :: average = .false.
contains contains
procedure :: initialize => depth_integral_initialize 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 procedure :: after_coupling => depth_integral_after_coupling
end type end type
...@@ -137,7 +137,7 @@ module fabm_builtin_models ...@@ -137,7 +137,7 @@ module fabm_builtin_models
real(rk) :: minimum_depth = 0.0_rk real(rk) :: minimum_depth = 0.0_rk
real(rk) :: maximum_depth = huge(1.0_rk) real(rk) :: maximum_depth = huge(1.0_rk)
contains contains
procedure :: get_light => bounded_depth_integral_do_column procedure :: do_column => bounded_depth_integral_do_column
end type end type
type, extends(type_base_model) :: type_interior_constant type, extends(type_base_model) :: type_interior_constant
...@@ -833,9 +833,9 @@ module fabm_builtin_models ...@@ -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' 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 end subroutine depth_integral_after_coupling
subroutine depth_integral_do_column(self,_ARGUMENTS_VERTICAL_) subroutine depth_integral_do_column(self, _ARGUMENTS_DO_COLUMN_)
class (type_depth_integral),intent(in) :: self class (type_depth_integral), intent(in) :: self
_DECLARE_ARGUMENTS_VERTICAL_ _DECLARE_ARGUMENTS_DO_COLUMN_
real(rk) :: h,value,result,depth real(rk) :: h,value,result,depth
...@@ -852,9 +852,9 @@ module fabm_builtin_models ...@@ -852,9 +852,9 @@ module fabm_builtin_models
_SET_HORIZONTAL_DIAGNOSTIC_(self%id_output, result) _SET_HORIZONTAL_DIAGNOSTIC_(self%id_output, result)
end subroutine depth_integral_do_column end subroutine depth_integral_do_column
subroutine bounded_depth_integral_do_column(self,_ARGUMENTS_VERTICAL_) subroutine bounded_depth_integral_do_column(self, _ARGUMENTS_DO_COLUMN_)
class (type_bounded_depth_integral),intent(in) :: self class (type_bounded_depth_integral), intent(in) :: self
_DECLARE_ARGUMENTS_VERTICAL_ _DECLARE_ARGUMENTS_DO_COLUMN_
real(rk) :: h,value,cum,depth real(rk) :: h,value,cum,depth
logical :: started logical :: started
......
...@@ -583,13 +583,8 @@ module fabm_types ...@@ -583,13 +583,8 @@ module fabm_types
procedure :: do_horizontal => base_do_horizontal procedure :: do_horizontal => base_do_horizontal
procedure :: do_ppdd => base_do_ppdd procedure :: do_ppdd => base_do_ppdd
procedure :: do_bottom_ppdd => base_do_bottom_ppdd procedure :: do_bottom_ppdd => base_do_bottom_ppdd
procedure :: do_column => base_do_column
! Advanced functionality: variable vertical movement and light attenuation, feedbacks to drag and albedo.
procedure :: get_vertical_movement => base_get_vertical_movement 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. ! Bookkeeping: calculate total of conserved quantities, check and repair model state.
procedure :: check_state => base_check_state procedure :: check_state => base_check_state
...@@ -605,6 +600,12 @@ module fabm_types ...@@ -605,6 +600,12 @@ module fabm_types
procedure :: implements procedure :: implements
procedure :: register_implemented_routines 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 end type type_base_model
! ==================================================================================================== ! ====================================================================================================
...@@ -731,45 +732,52 @@ contains ...@@ -731,45 +732,52 @@ contains
_DECLARE_ARGUMENTS_HORIZONTAL_ _DECLARE_ARGUMENTS_HORIZONTAL_
end subroutine 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_) subroutine base_get_vertical_movement(self, _ARGUMENTS_GET_VERTICAL_MOVEMENT_)
class (type_base_model), intent(in) :: self class (type_base_model), intent(in) :: self
_DECLARE_ARGUMENTS_GET_VERTICAL_MOVEMENT_ _DECLARE_ARGUMENTS_GET_VERTICAL_MOVEMENT_
end subroutine 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 class (type_base_model), intent(in) :: self
_DECLARE_ARGUMENTS_GET_EXTINCTION_ _DECLARE_ARGUMENTS_CHECK_STATE_
end subroutine 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 class (type_base_model), intent(in) :: self
_DECLARE_ARGUMENTS_GET_DRAG_ _DECLARE_ARGUMENTS_CHECK_SURFACE_STATE_
end subroutine 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 class (type_base_model), intent(in) :: self
_DECLARE_ARGUMENTS_GET_ALBEDO_ _DECLARE_ARGUMENTS_CHECK_BOTTOM_STATE_
end subroutine 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 class (type_base_model), intent(in) :: self
_DECLARE_ARGUMENTS_VERTICAL_ _DECLARE_ARGUMENTS_GET_EXTINCTION_
end subroutine 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 class (type_base_model), intent(in) :: self
_DECLARE_ARGUMENTS_CHECK_STATE_ _DECLARE_ARGUMENTS_GET_DRAG_
end subroutine 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 class (type_base_model), intent(in) :: self
_DECLARE_ARGUMENTS_CHECK_SURFACE_STATE_ _DECLARE_ARGUMENTS_GET_ALBEDO_
end subroutine 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 class (type_base_model), intent(in) :: self
_DECLARE_ARGUMENTS_CHECK_BOTTOM_STATE_ _DECLARE_ARGUMENTS_DO_COLUMN_
end subroutine end subroutine
function base_get_path(self) result(path) function base_get_path(self) result(path)
......
...@@ -753,7 +753,7 @@ end subroutine end_vertical_task ...@@ -753,7 +753,7 @@ end subroutine end_vertical_task
call invalidate_vertical_call_output(task%calls(icall), cache) call invalidate_vertical_call_output(task%calls(icall), cache)
#endif #endif
call task%calls(icall)%model%get_light(cache) call task%calls(icall)%model%do_column(cache)
#ifndef NDEBUG #ifndef NDEBUG
call check_vertical_call_output(task%calls(icall), cache) call check_vertical_call_output(task%calls(icall), cache)
......
...@@ -31,7 +31,7 @@ module akvaplan_plume_injection ...@@ -31,7 +31,7 @@ module akvaplan_plume_injection
contains contains
! Model procedures ! Model procedures
procedure :: initialize procedure :: initialize
procedure :: get_light => do_column ! NB operating in the vertical is currently only supported in "get_light" procedure :: do_column
end type end type
contains contains
...@@ -52,9 +52,9 @@ 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) 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 end subroutine initialize
subroutine do_column(self,_ARGUMENTS_VERTICAL_) subroutine do_column(self,_ARGUMENTS_DO_COLUMN_)
class (type_plume_injection),intent(in) :: self class (type_plume_injection),intent(in) :: self
_DECLARE_ARGUMENTS_VERTICAL_ _DECLARE_ARGUMENTS_DO_COLUMN_
real(rk) :: flux_int,rho,h real(rk) :: flux_int,rho,h
......
...@@ -41,17 +41,17 @@ module nonlocal ...@@ -41,17 +41,17 @@ module nonlocal
type (type_dependency_id) :: id_thickness type (type_dependency_id) :: id_thickness
contains contains
procedure :: initialize => depth_integral_initialize 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 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_integral ! Depth-integrated target variable
type (type_horizontal_dependency_id) :: id_sms ! Depth-integrated sources-sinks of 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_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 type (type_dependency_id) :: id_weights ! Weights for the vertical distribution of the sinks and sources
contains contains
procedure :: initialize => depth_integral_rate_distributor_initialize 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 end type
contains contains
...@@ -114,9 +114,9 @@ contains ...@@ -114,9 +114,9 @@ contains
call rate_distributor%request_coupling(rate_distributor%id_sms,'result_sms_tot') call rate_distributor%request_coupling(rate_distributor%id_sms,'result_sms_tot')
end subroutine depth_integral_initialize 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 class (type_depth_integral),intent(in) :: self
_DECLARE_ARGUMENTS_VERTICAL_ _DECLARE_ARGUMENTS_DO_COLUMN_
real(rk) :: local,weight,thickness,integral real(rk) :: local,weight,thickness,integral
...@@ -128,7 +128,7 @@ contains ...@@ -128,7 +128,7 @@ contains
integral = integral + local*weight*thickness integral = integral + local*weight*thickness
_VERTICAL_LOOP_END_ _VERTICAL_LOOP_END_
_SET_HORIZONTAL_DIAGNOSTIC_(self%id_integral,integral) _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) subroutine depth_integral_rate_distributor_initialize(self,configunit)
class (type_depth_integral_rate_distributor),intent(inout),target :: self class (type_depth_integral_rate_distributor),intent(inout),target :: self
......
...@@ -20,16 +20,16 @@ module gotm_light ...@@ -20,16 +20,16 @@ module gotm_light
type (type_surface_diagnostic_variable_id) :: id_par0 ! Surface photosynthetically active radiation type (type_surface_diagnostic_variable_id) :: id_par0 ! Surface photosynthetically active radiation
! Parameters ! Parameters
real(rk) :: a,g1,g2 real(rk) :: a, g1, g2
contains contains
! Model procedures ! Model procedures
procedure :: initialize procedure :: initialize
procedure :: get_light procedure :: do_column
end type type_gotm_light end type type_gotm_light
contains contains
subroutine initialize(self,configunit) subroutine initialize(self, configunit)
class (type_gotm_light), intent(inout), target :: self class (type_gotm_light), intent(inout), target :: self
integer, intent(in) :: configunit integer, intent(in) :: configunit
...@@ -46,14 +46,14 @@ contains ...@@ -46,14 +46,14 @@ contains
standard_variable=standard_variables%surface_downwelling_photosynthetic_radiative_flux, source=source_do_column) standard_variable=standard_variables%surface_downwelling_photosynthetic_radiative_flux, source=source_do_column)
! Register environmental dependencies (temperature, shortwave radiation) ! 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_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_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_dz, standard_variables%cell_thickness)
end subroutine end subroutine
subroutine get_light(self, _ARGUMENTS_VERTICAL_) subroutine do_column(self, _ARGUMENTS_DO_COLUMN_)
class (type_gotm_light), intent(in) :: self class (type_gotm_light), intent(in) :: self
_DECLARE_ARGUMENTS_VERTICAL_ _DECLARE_ARGUMENTS_DO_COLUMN_
real(rk) :: swr0, dz, swr, par, z, ext, bioext real(rk) :: swr0, dz, swr, par, z, ext, bioext
...@@ -71,7 +71,7 @@ contains ...@@ -71,7 +71,7 @@ contains
! Calculate photosynthetically active radiation (PAR), shortwave radiation, and PAR attenuation. ! Calculate photosynthetically active radiation (PAR), shortwave radiation, and PAR attenuation.
par = swr0 * (1.0_rk - self%a) * exp(-z / self%g2 - bioext) 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 ! Move to bottom of layer
z = z + dz * 0.5_rk z = z + dz * 0.5_rk
...@@ -80,6 +80,6 @@ contains ...@@ -80,6 +80,6 @@ contains
_SET_DIAGNOSTIC_(self%id_swr,swr) ! Shortwave radiation at layer centre _SET_DIAGNOSTIC_(self%id_swr,swr) ! Shortwave radiation at layer centre
_SET_DIAGNOSTIC_(self%id_par,par) ! Photosynthetically active radiation at layer centre _SET_DIAGNOSTIC_(self%id_par,par) ! Photosynthetically active radiation at layer centre
_VERTICAL_LOOP_END_ _VERTICAL_LOOP_END_
end subroutine get_light end subroutine do_column
end module gotm_light end module gotm_light
...@@ -42,7 +42,7 @@ contains ...@@ -42,7 +42,7 @@ contains
procedure :: do procedure :: do
procedure :: do_surface procedure :: do_surface
procedure :: do_bottom procedure :: do_bottom
procedure :: get_light procedure :: do_column
procedure :: get_vertical_movement procedure :: get_vertical_movement
end type end type
...@@ -103,7 +103,7 @@ subroutine initialize(self,configunit) ...@@ -103,7 +103,7 @@ subroutine initialize(self,configunit)
end do end do
do i=1,self%nhz_diag_vert do i=1,self%nhz_diag_vert
write (strindex,'(i0)') i 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 do
end subroutine initialize end subroutine initialize
...@@ -234,9 +234,9 @@ subroutine do_bottom(self,_ARGUMENTS_DO_SURFACE_) ...@@ -234,9 +234,9 @@ subroutine do_bottom(self,_ARGUMENTS_DO_SURFACE_)
_HORIZONTAL_LOOP_END_ _HORIZONTAL_LOOP_END_
end subroutine do_bottom end subroutine do_bottom
subroutine get_light(self,_ARGUMENTS_VERTICAL_) subroutine do_column(self, _ARGUMENTS_DO_COLUMN_)
class (type_test_model),intent(in) :: self class (type_test_model),intent(in) :: self
_DECLARE_ARGUMENTS_VERTICAL_ _DECLARE_ARGUMENTS_DO_COLUMN_
integer :: i integer :: i
real(rk) :: value real(rk) :: value
...@@ -246,29 +246,29 @@ subroutine get_light(self,_ARGUMENTS_VERTICAL_) ...@@ -246,29 +246,29 @@ subroutine get_light(self,_ARGUMENTS_VERTICAL_)
do i=1,self%nsurface_state do i=1,self%nsurface_state
_GET_HORIZONTAL_(self%id_surface_state(i),value) _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 end do
do i=1,self%nbottom_state do i=1,self%nbottom_state
_GET_HORIZONTAL_(self%id_bottom_state(i),value) _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 end do
_GET_HORIZONTAL_(self%id_hz_dep,value) _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_ _VERTICAL_LOOP_BEGIN_
do i=1,self%nstate do i=1,self%nstate
_GET_(self%id_state(i),value) _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 end do
_GET_(self%id_dep,value) _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) _GET_(self%id_depth,value)
if (value <= old_depth) & 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 old_depth = value
do i=1,self%nint_diag_vert do i=1,self%nint_diag_vert
...@@ -281,7 +281,7 @@ subroutine get_light(self,_ARGUMENTS_VERTICAL_) ...@@ -281,7 +281,7 @@ subroutine get_light(self,_ARGUMENTS_VERTICAL_)
do i=1,self%nhz_diag_vert do i=1,self%nhz_diag_vert
_SET_HORIZONTAL_DIAGNOSTIC_(self%id_horizontal_diag(self%nsurface_diag + self%nbottom_diag + i),4999._rk+i) _SET_HORIZONTAL_DIAGNOSTIC_(self%id_horizontal_diag(self%nsurface_diag + self%nbottom_diag + i),4999._rk+i)
end do end do
end subroutine get_light end subroutine do_column
subroutine get_vertical_movement(self,_ARGUMENTS_GET_VERTICAL_MOVEMENT_) subroutine get_vertical_movement(self,_ARGUMENTS_GET_VERTICAL_MOVEMENT_)
class (type_test_model),intent(in) :: self 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