diff --git a/src/builtin/sum.F90 b/src/builtin/sum.F90 index f89f9b62..01aa99f1 100644 --- a/src/builtin/sum.F90 +++ b/src/builtin/sum.F90 @@ -10,7 +10,7 @@ module fabm_builtin_sum private - public type_weighted_sum, type_horizontal_weighted_sum + public type_base_sum, type_weighted_sum, type_horizontal_weighted_sum type type_sum_term type (type_dependency_id) :: id @@ -24,55 +24,47 @@ module fabm_builtin_sum type type_component character(len=attribute_length) :: name = '' + type (type_link), pointer :: link => null() real(rk) :: weight = 1._rk logical :: include_background = .false. - type (type_dependency_id) :: id type (type_component), pointer :: next => null() end type - type type_horizontal_component - character(len=attribute_length) :: name = '' - real(rk) :: weight = 1._rk - logical :: include_background = .false. - type (type_horizontal_dependency_id) :: id - type (type_horizontal_component), pointer :: next => null() - end type - - type, extends(type_reduction_operator) :: type_weighted_sum + type, extends(type_reduction_operator) :: type_base_sum character(len=attribute_length) :: units = '' integer :: result_output = output_instantaneous real(rk) :: offset = 0.0_rk real(rk) :: missing_value = -2.e20_rk - type (type_add_id) :: id_output + logical :: components_frozen = .false. type (type_component), pointer :: first => null() - type (type_sum_term), allocatable :: sources(:) + contains + procedure :: add_component + procedure :: finalize + end type + + type, extends(type_base_sum) :: type_weighted_sum + type (type_dependency_id), allocatable :: id_terms(:) + type (type_add_id) :: id_output + type (type_sum_term), allocatable :: sources(:) contains procedure :: initialize => weighted_sum_initialize - procedure :: add_component => weighted_sum_add_component procedure :: do => weighted_sum_do procedure :: after_coupling => weighted_sum_after_coupling procedure :: add_to_parent => weighted_sum_add_to_parent procedure :: merge_components => weighted_sum_merge_components - procedure :: finalize => weighted_sum_finalize end type - type, extends(type_reduction_operator) :: type_horizontal_weighted_sum - character(len=attribute_length) :: units = '' - integer :: result_output = output_instantaneous - real(rk) :: offset = 0.0_rk - real(rk) :: missing_value = -2.e20_rk - integer :: domain = domain_horizontal - type (type_horizontal_add_id) :: id_output - type (type_horizontal_component), pointer :: first => null() - type (type_horizontal_sum_term), allocatable :: sources(:) + type, extends(type_base_sum) :: type_horizontal_weighted_sum + integer :: domain = domain_horizontal + type (type_horizontal_dependency_id), allocatable :: id_terms(:) + type (type_horizontal_add_id) :: id_output + type (type_horizontal_sum_term), allocatable :: sources(:) contains - procedure :: add_component => horizontal_weighted_sum_add_component procedure :: initialize => horizontal_weighted_sum_initialize procedure :: do_horizontal => horizontal_weighted_sum_do_horizontal procedure :: after_coupling => horizontal_weighted_sum_after_coupling procedure :: add_to_parent => horizontal_weighted_sum_add_to_parent procedure :: merge_components => horizontal_weighted_sum_merge_components - procedure :: finalize => horizontal_weighted_sum_finalize end type type, extends(type_base_model) :: type_weighted_sum_sms_distributor @@ -85,11 +77,23 @@ module fabm_builtin_sum contains + subroutine request_coupling_to_component(parent, target_link, component) + class (type_base_model), intent(inout), target :: parent + type (type_link), target :: target_link + class (type_component), intent(in) :: component + + if (associated(component%link)) then + call parent%request_coupling(target_link, component%link) + else + call parent%request_coupling(target_link, component%name) + end if + end subroutine + function weighted_sum_add_to_parent(self, parent, link, create_for_one, aggregate_variable) result(sum_used) class (type_weighted_sum), intent(inout), target :: self class (type_base_model), intent(inout), target :: parent type (type_link), intent(in), target :: link - logical,optional, intent(in) :: create_for_one + logical, optional, intent(in) :: create_for_one type (type_interior_standard_variable), intent(in), optional :: aggregate_variable logical :: sum_used, create_for_one_ @@ -112,19 +116,19 @@ function weighted_sum_add_to_parent(self, parent, link, create_for_one, aggregat ! One component only. if (self%first%weight == 1.0_rk .and. .not. create_for_one_) then ! One component with scale factor 1 - directly link to the component's source variable. - call parent%request_coupling(link, self%first%name) + call request_coupling_to_component(parent, link, self%first) else ! One component with scale factor other than 1 (or a user-specified requirement NOT to make a direct link to the source variable) allocate(scaled_variable) call parent%add_child(scaled_variable, trim(link%name) // '_calculator') call scaled_variable%register_dependency(scaled_variable%id_source, 'source', self%units, 'source variable') - call scaled_variable%request_coupling(scaled_variable%id_source, self%first%name) + call request_coupling_to_component(scaled_variable, scaled_variable%id_source%link, self%first) call scaled_variable%register_diagnostic_variable(scaled_variable%id_result, 'result', self%units, 'result', & missing_value=self%missing_value, output=self%result_output, act_as_state_variable=link%target%fake_state_variable) scaled_variable%weight = self%first%weight scaled_variable%include_background = self%first%include_background scaled_variable%offset = self%offset - call parent%request_coupling(link, trim(link%name)//'_calculator/result') + call parent%request_coupling(link, trim(link%name) // '_calculator/result') if (link%target%fake_state_variable) then ! This scaled variable acts as a state variable. Create a child model to distribute source terms to the original source variable. call copy_fluxes(scaled_variable, scaled_variable%id_result, self%first%name, scale_factor=1.0_rk / scaled_variable%weight) @@ -145,27 +149,35 @@ subroutine weighted_sum_initialize(self, configunit) integer, intent(in) :: configunit type (type_component), pointer :: component - integer :: ncomponents, i + integer :: i, n character(len=10) :: temp class (type_weighted_sum_sms_distributor), pointer :: sms_distributor logical, parameter :: act_as_state_variable = .false. call self%register_implemented_routines((/source_do/)) - call self%get_parameter(ncomponents, 'n', '', 'number of terms in summation', default=0, minimum=0) - do i = 1, ncomponents + call self%get_parameter(n, 'n', '', 'number of terms in summation', default=0, minimum=0) + do i = 1, n call self%add_component('') end do call self%get_parameter(self%units, 'units', '', 'units', default=trim(self%units)) - ncomponents = 0 + n = 0 component => self%first do while (associated(component)) - ncomponents = ncomponents + 1 - write (temp,'(i0)') ncomponents + n = n + 1 + component => component%next + end do + allocate(self%id_terms(n)) + + n = 0 + component => self%first + do while (associated(component)) + n = n + 1 + write (temp,'(i0)') n call self%get_parameter(component%weight, 'weight' // trim(temp), '-', 'weight for term ' // trim(temp), default=component%weight) - call self%register_dependency(component%id, 'term' // trim(temp), self%units, 'term ' // trim(temp)) - if (component%name /= '') call self%request_coupling(component%id, trim(component%name)) + call self%register_dependency(self%id_terms(n), 'term' // trim(temp), self%units, 'term ' // trim(temp)) + call request_coupling_to_component(self, self%id_terms(n)%link, component) component => component%next end do @@ -182,32 +194,35 @@ subroutine weighted_sum_initialize(self, configunit) call self%add_child(sms_distributor, 'sms_distributor') call sms_distributor%register_dependency(sms_distributor%id_total_sms, 'total_sms', trim(self%units) // '/s', 'sources-sinks of sum') call sms_distributor%request_coupling(sms_distributor%id_total_sms, 'result_sms_tot') - allocate(sms_distributor%weights(ncomponents)) - allocate(sms_distributor%id_targets(ncomponents)) + allocate(sms_distributor%weights(n)) + allocate(sms_distributor%id_targets(n)) - ncomponents = 0 + n = 0 component => self%first do while (associated(component)) - ncomponents = ncomponents + 1 - write (temp,'(i0)') ncomponents - call sms_distributor%register_state_dependency(sms_distributor%id_targets(ncomponents), 'target'//trim(temp), self%units, 'target '//trim(temp)) - call sms_distributor%request_coupling(sms_distributor%id_targets(ncomponents), trim(component%name)) - sms_distributor%weights(ncomponents) = component%weight + n = n + 1 + write (temp,'(i0)') n + call sms_distributor%register_state_dependency(sms_distributor%id_targets(n), 'target'//trim(temp), self%units, 'target '//trim(temp)) + call sms_distributor%request_coupling(sms_distributor%id_targets(n), trim(component%name)) + sms_distributor%weights(n) = component%weight component => component%next end do end if + + self%components_frozen = .true. end subroutine - subroutine weighted_sum_add_component(self, name, weight, include_background) - class (type_weighted_sum),intent(inout) :: self + subroutine add_component(self, name, weight, include_background, link) + class (type_base_sum),intent(inout) :: self character(len=*), intent(in) :: name real(rk), optional, intent(in) :: weight logical, optional, intent(in) :: include_background + type (type_link), target, optional :: link type (type_component), pointer :: component - if (_VARIABLE_REGISTERED_(self%id_output)) & - call self%fatal_error('weighted_sum_add_component', 'cannot be called after model initialization') + if (self%components_frozen) & + call self%fatal_error('base_sum_add_component', 'cannot be called after model initialization') if (.not. associated(self%first)) then allocate(self%first) @@ -221,6 +236,7 @@ subroutine weighted_sum_add_component(self, name, weight, include_background) component => component%next end if component%name = name + if (present(link)) component%link => link if (present(weight)) component%weight = weight if (present(include_background)) component%include_background = include_background end subroutine @@ -230,16 +246,20 @@ subroutine weighted_sum_after_coupling(self) type (type_component), pointer :: component real(rk) :: background + integer :: i ! At this stage, the background values for all variables (if any) are fixed. We can therefore ! compute background contributions already, and add those to the space- and time-invariant offset. background = 0 + i = 0 component => self%first do while (associated(component)) + i = i + 1 + component%link => self%id_terms(i)%link if (component%include_background) then - self%offset = self%offset + component%weight * component%id%background + self%offset = self%offset + component%weight * self%id_terms(i)%background else - background = background + component%weight * component%id%background + background = background + component%weight * self%id_terms(i)%background end if component => component%next end do @@ -263,7 +283,7 @@ subroutine weighted_sum_merge_components(self, log_unit) n = 0 do while (associated(component)) component_next => component%next - if (merge_component(component%id%link, component%weight, sum_variable, log_unit)) then + if (merge_component(component%link, component%weight, sum_variable, log_unit)) then ! Component was merged into target if (associated(component_previous)) then component_previous%next => component_next @@ -296,13 +316,13 @@ subroutine weighted_sum_merge_components(self, log_unit) component => self%first do i = 1, n self%sources(i)%weight = component%weight - call component%id%link%target%read_indices%append(self%sources(i)%id%index) + call component%link%target%read_indices%append(self%sources(i)%id%index) component => component%next end do end subroutine weighted_sum_merge_components - subroutine weighted_sum_finalize(self) - class (type_weighted_sum), intent(inout) :: self + subroutine finalize(self) + class (type_base_sum), intent(inout) :: self type (type_component), pointer :: component, component_next @@ -314,7 +334,7 @@ subroutine weighted_sum_finalize(self) end do self%first => null() call self%type_reduction_operator%finalize() - end subroutine weighted_sum_finalize + end subroutine finalize logical function merge_component(component_link, weight, target_variable, log_unit) type (type_link), intent(inout) :: component_link @@ -358,9 +378,9 @@ subroutine horizontal_weighted_sum_merge_components(self, log_unit) class (type_horizontal_weighted_sum), intent(inout) :: self integer, optional, intent(in) :: log_unit - integer :: i, n - type (type_internal_variable), pointer :: sum_variable - type (type_horizontal_component), pointer :: component, component_next, component_previous + integer :: i, n + type (type_internal_variable), pointer :: sum_variable + type (type_component), pointer :: component, component_next, component_previous sum_variable => self%id_output%link%target sum_variable%prefill_value = sum_variable%prefill_value + self%offset @@ -371,7 +391,7 @@ subroutine horizontal_weighted_sum_merge_components(self, log_unit) n = 0 do while (associated(component)) component_next => component%next - if (merge_component(component%id%link, component%weight, sum_variable, log_unit)) then + if (merge_component(component%link, component%weight, sum_variable, log_unit)) then ! Component was merged into target if (associated(component_previous)) then component_previous%next => component_next @@ -404,26 +424,11 @@ subroutine horizontal_weighted_sum_merge_components(self, log_unit) component => self%first do i = 1, n self%sources(i)%weight = component%weight - call component%id%link%target%read_indices%append(self%sources(i)%id%horizontal_index) + call component%link%target%read_indices%append(self%sources(i)%id%horizontal_index) component => component%next end do end subroutine horizontal_weighted_sum_merge_components - subroutine horizontal_weighted_sum_finalize(self) - class (type_horizontal_weighted_sum), intent(inout) :: self - - type (type_horizontal_component), pointer :: component, component_next - - component => self%first - do while (associated(component)) - component_next => component%next - deallocate(component) - component => component_next - end do - self%first => null() - call self%type_reduction_operator%finalize() - end subroutine horizontal_weighted_sum_finalize - subroutine weighted_sum_do(self, _ARGUMENTS_DO_) class (type_weighted_sum), intent(in) :: self _DECLARE_ARGUMENTS_DO_ @@ -444,7 +449,7 @@ function horizontal_weighted_sum_add_to_parent(self, parent, link, create_for_on class (type_horizontal_weighted_sum), intent(inout), target :: self class (type_base_model), intent(inout), target :: parent type (type_link), intent(in), target :: link - logical,optional, intent(in) :: create_for_one + logical, optional, intent(in) :: create_for_one class (type_horizontal_standard_variable), intent(in), optional :: aggregate_variable logical :: sum_used, create_for_one_ @@ -468,20 +473,20 @@ function horizontal_weighted_sum_add_to_parent(self, parent, link, create_for_on ! One component only. if (self%first%weight == 1.0_rk .and. .not. create_for_one_) then ! One component with scale factor 1 - directly link to the component's source variable. - call parent%request_coupling(link, self%first%name) + call request_coupling_to_component(parent, link, self%first) else ! One component with scale factor other than 1 (or a user-specified requirement NOT to make a direct link to the source variable) allocate(scaled_variable) call parent%add_child(scaled_variable, trim(link%name) // '_calculator') call scaled_variable%register_dependency(scaled_variable%id_source, 'source', self%units, 'source variable') - call scaled_variable%request_coupling(scaled_variable%id_source, self%first%name) + call request_coupling_to_component(scaled_variable, scaled_variable%id_source%link, self%first) call scaled_variable%register_diagnostic_variable(scaled_variable%id_result, 'result', self%units, 'result', & missing_value=self%missing_value, output=self%result_output, act_as_state_variable= & link%target%fake_state_variable, source=source_do_horizontal, domain=link%target%domain) scaled_variable%weight = self%first%weight scaled_variable%include_background = self%first%include_background scaled_variable%offset = self%offset - call parent%request_coupling(link, trim(link%name)//'_calculator/result') + call parent%request_coupling(link, trim(link%name) // '_calculator/result') if (link%target%fake_state_variable) then call copy_horizontal_fluxes(scaled_variable, scaled_variable%id_result, self%first%name, scale_factor=1.0_rk / scaled_variable%weight) if (present(aggregate_variable)) call scaled_variable%add_to_aggregate_variable(aggregate_variable, scaled_variable%id_result) @@ -500,80 +505,67 @@ subroutine horizontal_weighted_sum_initialize(self, configunit) class (type_horizontal_weighted_sum), intent(inout), target :: self integer, intent(in) :: configunit - type (type_horizontal_component),pointer :: component - integer :: i,n + type (type_component), pointer :: component + integer :: i, n character(len=10) :: temp call self%register_implemented_routines((/source_do_horizontal/)) call self%get_parameter(n,'n','','number of terms in summation',default=0,minimum=0) - do i=1,n + do i = 1, n call self%add_component('') end do call self%get_parameter(self%units,'units','','units',default=trim(self%units)) - i = 0 + n = 0 component => self%first do while (associated(component)) - i = i + 1 - write (temp,'(i0)') i - call self%get_parameter(component%weight,'weight'//trim(temp),'-','weight for term '//trim(temp),default=component%weight) - call self%register_dependency(component%id,'term'//trim(temp),self%units,'term '//trim(temp)) - call self%request_coupling(component%id,trim(component%name)) + n = n + 1 + component => component%next + end do + allocate(self%id_terms(n)) + + n = 0 + component => self%first + do while (associated(component)) + n = n + 1 + write (temp,'(i0)') n + call self%get_parameter(component%weight, 'weight' // trim(temp), '-', 'weight for term ' // trim(temp), default=component%weight) + call self%register_dependency(self%id_terms(n), 'term' // trim(temp), self%units, 'term ' // trim(temp)) + call request_coupling_to_component(self, self%id_terms(n)%link, component) component => component%next end do call self%add_horizontal_variable('result', self%units, 'result', missing_value=self%missing_value, fill_value=0.0_rk, output=self%result_output, & write_index=self%id_output%horizontal_sum_index, link=self%id_output%link, source=source_do_horizontal) + + self%components_frozen = .true. end subroutine subroutine horizontal_weighted_sum_after_coupling(self) class (type_horizontal_weighted_sum),intent(inout) :: self - type (type_horizontal_component),pointer :: component + type (type_component), pointer :: component real(rk) :: background + integer :: i ! At this stage, the background values for all variables (if any) are fixed. We can therefore ! compute background contributions already, and add those to the space- and time-invariant offset. background = 0 component => self%first + i = 0 do while (associated(component)) + i = i + 1 + component%link => self%id_terms(i)%link if (component%include_background) then - self%offset = self%offset + component%weight*component%id%background + self%offset = self%offset + component%weight * self%id_terms(i)%background else - background = background + component%weight*component%id%background + background = background + component%weight * self%id_terms(i)%background end if component => component%next end do call self%id_output%link%target%background_values%set_value(background) end subroutine - subroutine horizontal_weighted_sum_add_component(self,name,weight,include_background) - class (type_horizontal_weighted_sum),intent(inout) :: self - character(len=*), intent(in) :: name - real(rk),optional, intent(in) :: weight - logical,optional, intent(in) :: include_background - - type (type_horizontal_component),pointer :: component - - if (_VARIABLE_REGISTERED_(self%id_output)) & - call self%fatal_error('weighted_sum_add_component','cannot be called after model initialization') - - if (.not.associated(self%first)) then - allocate(self%first) - component => self%first - else - component => self%first - do while (associated(component%next)) - component => component%next - end do - allocate(component%next) - component => component%next - end if - component%name = name - if (present(weight)) component%weight = weight - if (present(include_background)) component%include_background = include_background - end subroutine - subroutine horizontal_weighted_sum_do_horizontal(self,_ARGUMENTS_HORIZONTAL_) class (type_horizontal_weighted_sum), intent(in) :: self _DECLARE_ARGUMENTS_HORIZONTAL_ diff --git a/src/fabm_coupling.F90 b/src/fabm_coupling.F90 index 29a26815..7c8dcfec 100644 --- a/src/fabm_coupling.F90 +++ b/src/fabm_coupling.F90 @@ -71,6 +71,7 @@ subroutine freeze_model_info(self) ! Create summations of source terms and surface/bottom fluxes. call create_flux_sums(self) + call request_flux_sum_coupling(self) ! Process the any remaining coupling tasks. call process_coupling_tasks(self, final=.true.) @@ -353,7 +354,7 @@ subroutine create_sum(parent, link, link_list) sum%missing_value = 0 component_link => link_list%first do while (associated(component_link)) - call sum%add_component(component_link%target%name) + call sum%add_component('', link=component_link) component_link => component_link%next end do if (.not. sum%add_to_parent(parent, link)) deallocate(sum) @@ -371,7 +372,7 @@ subroutine create_horizontal_sum(parent, link, link_list) sum%missing_value = 0 component_link => link_list%first do while (associated(component_link)) - call sum%add_component(component_link%target%name) + call sum%add_component('', link=component_link) component_link => component_link%next end do if (.not. sum%add_to_parent(parent, link)) deallocate(sum) @@ -413,18 +414,6 @@ recursive subroutine create_flux_sums(self) case (domain_horizontal, domain_surface, domain_bottom) call create_horizontal_sum(self, link%target%sms_sum, link%target%sms_list) end select - else - ! We do not own this variable. - ! Couple to summations for sources-sinks and surface/bottom fluxes created by the target. - select case (link%target%domain) - case (domain_interior) - call self%request_coupling(link%original%sms_sum, trim(link%target%name) // '_sms_tot') - call self%request_coupling(link%original%surface_flux_sum, trim(link%target%name) // '_sfl_tot') - call self%request_coupling(link%original%bottom_flux_sum, trim(link%target%name) // '_bfl_tot') - call self%request_coupling(link%original%movement_sum, trim(link%target%name) // '_w_tot') - case (domain_horizontal, domain_surface, domain_bottom) - call self%request_coupling(link%original%sms_sum, trim(link%target%name) // '_sms_tot') - end select end if end if link => link%next @@ -438,6 +427,39 @@ recursive subroutine create_flux_sums(self) end do end subroutine create_flux_sums + recursive subroutine request_flux_sum_coupling(self) + class (type_base_model), intent(inout), target :: self + + type (type_link), pointer :: link + type (type_model_list_node), pointer :: child + + link => self%links%first + do while (associated(link)) + if (index(link%name, '/') == 0 .and. (link%original%source == source_state .or. link%original%fake_state_variable) .and. .not. associated(link%target, link%original)) then + ! This is a state variable, or a diagnostic pretending to be one, that we have registered (it is owned by "self") + ! We do not own this variable. + ! Couple to summations for sources-sinks and surface/bottom fluxes created by the target. + select case (link%target%domain) + case (domain_interior) + call self%request_coupling(link%original%sms_sum, link%target%sms_sum) + call self%request_coupling(link%original%surface_flux_sum, link%target%surface_flux_sum) + call self%request_coupling(link%original%bottom_flux_sum, link%target%bottom_flux_sum) + call self%request_coupling(link%original%movement_sum, link%target%movement_sum) + case (domain_horizontal, domain_surface, domain_bottom) + call self%request_coupling(link%original%sms_sum, link%target%sms_sum) + end select + end if + link => link%next + end do + + ! Process child models + child => self%children%first + do while (associated(child)) + call request_flux_sum_coupling(child%model) + child => child%next + end do + end subroutine request_flux_sum_coupling + subroutine aggregate_variable_list_print(self) class (type_aggregate_variable_list), intent(in) :: self diff --git a/src/fabm_particle.F90 b/src/fabm_particle.F90 index b2053e8d..44a2d201 100644 --- a/src/fabm_particle.F90 +++ b/src/fabm_particle.F90 @@ -437,15 +437,15 @@ subroutine build_state_id_list(self, reference, domain) case (domain_interior) call self%register_state_dependency(reference%id%state(n), trim(reference%name) // '_state' // trim(strindex), & link%target%units, trim(reference%name) // ' state variable ' // trim(strindex)) - call self%request_coupling(reference%id%state(n), link%target%name) + call self%request_coupling(reference%id%state(n), link) case (domain_bottom) call self%register_state_dependency(reference%id%bottom_state(n), trim(reference%name) // '_bottom_state' // trim(strindex), & link%target%units, trim(reference%name) // ' bottom state variable ' // trim(strindex)) - call self%request_coupling(reference%id%bottom_state(n), link%target%name) + call self%request_coupling(reference%id%bottom_state(n), link) case (domain_surface) call self%register_state_dependency(reference%id%surface_state(n), trim(reference%name) // '_surface_state' // trim(strindex), & link%target%units, trim(reference%name) // ' surface state variable ' // trim(strindex)) - call self%request_coupling(reference%id%surface_state(n), link%target%name) + call self%request_coupling(reference%id%surface_state(n), link) end select end if link => link%next diff --git a/src/fabm_types.F90 b/src/fabm_types.F90 index 6e3851e6..015838b8 100644 --- a/src/fabm_types.F90 +++ b/src/fabm_types.F90 @@ -175,7 +175,7 @@ module fabm_types type, extends(type_coupling_task) :: type_link_coupling_task type (type_link), pointer :: master => null() contains - procedure :: remove => link_coupling_task_resolve + procedure :: resolve => link_coupling_task_resolve end type type type_coupling_task_list @@ -497,6 +497,7 @@ module fabm_types ! Procedures for requesting coupling between variables procedure :: request_coupling_lt + procedure :: request_coupling_il procedure :: request_coupling_for_link procedure :: request_coupling_for_name procedure :: request_coupling_for_id @@ -505,7 +506,7 @@ module fabm_types procedure :: request_link_coupling_for_link generic :: request_coupling => request_coupling_for_link, request_coupling_for_name, request_coupling_for_id, & request_standard_coupling_for_link, request_standard_coupling_for_id, & - request_link_coupling_for_link, request_coupling_lt + request_link_coupling_for_link, request_coupling_lt, request_coupling_il ! Procedures that may be used to query parameter values during initialization. procedure :: get_real_parameter @@ -1492,22 +1493,28 @@ subroutine request_standard_coupling_for_id(self, id, master) end subroutine request_standard_coupling_for_id subroutine request_link_coupling_for_link(self, link, master) - use fabm_standard_variables ! workaround for bug in Cray compiler 8.3.4 - class (type_base_model), intent(inout) :: self - type (type_link), target, intent(inout) :: link - type (type_link), target, intent(inout) :: master + class (type_base_model), intent(inout) :: self + type (type_link), target, intent(inout) :: link + type (type_link), target, intent(inout) :: master class (type_link_coupling_task), pointer :: task class (type_coupling_task), pointer :: base_class_pointer allocate(task) base_class_pointer => task - allocate(task) call self%request_coupling(link, base_class_pointer) if (.not. associated(base_class_pointer)) return task%master => master end subroutine request_link_coupling_for_link + subroutine request_coupling_il(self, id, master) + class (type_base_model), intent(inout) :: self + class (type_variable_id), intent(in) :: id + type (type_link), target, intent(inout) :: master + + call self%request_coupling(id%link, master) + end subroutine request_coupling_il + subroutine integer_pointer_set_append(self, value) class (type_integer_pointer_set), intent(inout) :: self integer, target :: value