output_initialise_unit_shares Subroutine

public subroutine output_initialise_unit_shares(hydrotope_subbasin, subbasin_catchment, hydrotope_area)

Arguments

Type IntentOptional AttributesName
integer, intent(in), dimension(:):: hydrotope_subbasin
integer, intent(in), dimension(:):: subbasin_catchment
real, intent(in), dimension(:):: hydrotope_area

Called by

proc~~output_initialise_unit_shares~~CalledByGraph proc~output_initialise_unit_shares output_initialise_unit_shares proc~output_initialise output_initialise proc~output_initialise->proc~output_initialise_unit_shares proc~initialise initialise proc~initialise->proc~output_initialise program~swim swim program~swim->proc~initialise

Contents


Source Code

  subroutine output_initialise_unit_shares( &
    hydrotope_subbasin, subbasin_catchment, hydrotope_area)
    ! Get array indeces of subbasin and catchment maps and create areal weights
    integer, dimension(:), intent(in) :: hydrotope_subbasin, subbasin_catchment
    real, dimension(:), intent(in) :: hydrotope_area
    integer h, s, c

    output_catchment_basin_share = 0
    output_subbasin_catchment_share = 0
    ! indeces and area sums
    do s = 1, output_nsubbasins
      do h = 1, output_nhydrotopes
        if (hydrotope_subbasin(h) == output_subbasin_id(s)) then
          output_hydrotope_subbasin_ix(h) = s
          output_subbasin_catchment_share(s) = &
            output_subbasin_catchment_share(s) + hydrotope_area(h)
        end if
      end do
    end do
    do c = 2, output_ncatchments
      do s = 1, output_nsubbasins
        if (subbasin_catchment(s) == output_catchment_id(c)) then
          output_subbasin_catchment_ix(s) = c
          output_catchment_basin_share(c) = output_catchment_basin_share(c) &
            + output_subbasin_catchment_share(s)
        end if
      end do
    end do
  ! Make shares
  output_hydrotope_subbasin_share = hydrotope_area / &
    output_subbasin_catchment_share(output_hydrotope_subbasin_ix)
  output_subbasin_catchment_share = output_subbasin_catchment_share &
    / output_catchment_basin_share(output_subbasin_catchment_ix)
  output_catchment_basin_share(1) = sum(hydrotope_area)  ! entire catchment
  output_catchment_basin_share = output_catchment_basin_share &
    / output_catchment_basin_share(1)
  end subroutine output_initialise_unit_shares