catchment.f95 Source File

module catchment

  use utilities, only : dp, path_max_length, log_info, log_warn
  use input, only : get_config_fid
  use subbasin, only : subcatch_id

  implicit none

  integer, save :: n_subcatch
  ! Catchment ids read from catchment.csv
  integer, dimension(:), allocatable :: catchment_ids
  ! subcatchment name read from subcatch.def
  character(len=20), dimension(:), allocatable :: subcatch_name
  ! area of subcatchment in [m2]
  real(dp), save, dimension(:), allocatable :: subcatch_area
  ! array storing annual subcatch output (nbyr, nSubcatch, 30)
  real(dp), save, dimension(:, :, :), allocatable :: subcatch_an
  ! basin area, km2
  real(dp), save :: da
  ! 1000. * da, basin area (1000 * km ** 2)
  real(dp), save :: af
  ! 100. * da = basin area in ha, from readbas
  real(dp), save :: da9
  !
  real(dp), save :: wy
  ! Subcatchment parameters on/off
  logical, save :: bSubcatch

  integer :: catchment_input_file_id

  character(len=path_max_length) :: catchment_input_file = "catchment.csv"

  namelist / CATCHMENT_PARAMETERS / &
    bSubcatch

contains

  subroutine catchment_initialise(sbar, flu)
    use input, only : input_open_file, get_config_fid
    real(dp), intent(in) :: sbar(:)
    real(dp), intent(out) :: flu(:)

    read(get_config_fid(), CATCHMENT_PARAMETERS)

    catchment_input_file_id = input_open_file(catchment_input_file)

    call catchment_allocate

    ! calculate total catchment (drainage) area "da" in km2
    da = sum(sbar(:)) / 10 ** 6
    da9 = 100. * da
    ! fraction of subbasin area of total catchment area
    flu(:) = sbar(:) / (da * 10 ** 6)
  end subroutine catchment_initialise

  subroutine catchment_allocate

  end subroutine catchment_allocate

  subroutine dealloc_catchment

  end subroutine dealloc_catchment

  subroutine catchment_initialise_parameters(mb, nbyr, sbar)
    !-------------------------------------------------------------------------------
    ! Author : stefan.liersch@pik-potsdam.de
    ! Date : 2010-02-24
    ! modified: 2010-02-25
    !
    ! PURPOSE : Reading file subcatch.def
    !           count number of subcatchments (user defined aggregation of subbasins)
    !
    ! CALLED : from subroutine main program
    !
    ! ToDo : - Writing output like pcp etc. at subcatchment level to specific output files
    !
    !-------------------------------------------------------------------------------
    integer, intent(in) :: mb
    integer, intent(in) :: nbyr
    real(dp), dimension(:), intent(in) :: sbar

    ! read file subcatch.def
    ! enable assignment of individual subbasin parameters

    integer :: i, n, nosub
    character(len=20) :: temp_name

    ! skip this routine if no subcatch parameters
    if (.not. bSubcatch) then
      allocate(catchment_ids(1))
      catchment_ids = 1
      return
    end if

    nosub = 0
    do n = 1, mb
      if (subcatch_id(n) < 0) nosub = nosub + 1
    end do
    if (nosub > 0) then
      call log_warn("catchment_initialise_parameters", &
        "You are simulating with a subset of n subbasins:", int=mb - nosub)
    end if

    ! allocate arrays
    n_subcatch = MAXVAL(subcatch_id)
    call catchment_initialise_subcatchm(n_subcatch, nbyr)
    do i = 1, mb
      if (subcatch_id(i) /= 0) then
        write(temp_name, '(I5)') subcatch_id(i)
        subcatch_name(subcatch_id(i)) = trim(adjustl(temp_name))
        subcatch_area(subcatch_id(i)) = subcatch_area(subcatch_id(i)) + sbar(i) !subarea(i)
      end if
    end do

    ! read individual subcatchment bsn parameters
    call catchment_read_subcatch_params

    ! assign parameters at the subcatchment level
    call catchment_assign_subcatch(mb)

  end subroutine catchment_initialise_parameters

  !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

  subroutine catchment_read_subcatch_params
    use input, only : read_integer_column, read_real_column
    use groundwater, only : &
      gw_abf, &
      gw_bff, &
      gw_delay, &
      gw_rchrgc, &
      gw_revapc, &
      gw_revapmn
    use soil, only: bsn_cncor, bsn_sccor
    use river, only: bsn_roc2, bsn_roc4
    use snow, only: &
      bsn_gmrate, &
      bsn_smrate, &
      bsn_tmelt, &
      bsn_tsnfall
    use evapotranspiration, only: bsn_thc, bsn_ecal
    use utilities, only: check_range, log_debug

    ! read file subcatch.prm
    ! enable assignment of individual subbasin parameters

    allocate(catchment_ids(n_subcatch))

    call read_integer_column(catchment_input_file_id, "catchment_id", catchment_ids, 0)
    call read_real_column(catchment_input_file_id, "ecal", bsn_ecal, 0.0_dp)
    call read_real_column(catchment_input_file_id, "thc", bsn_thc, 0.0_dp)
    call read_real_column(catchment_input_file_id, "roc2", bsn_roc2, 0.0_dp)
    call read_real_column(catchment_input_file_id, "roc4", bsn_roc4, 0.0_dp)
    call read_real_column(catchment_input_file_id, "cncor", bsn_cncor, 0.0_dp, range=(/0.25, 1.25/))
    call read_real_column(catchment_input_file_id, "sccor", bsn_sccor, 0.0_dp)
    call read_real_column(catchment_input_file_id, "tsnfall", bsn_tsnfall, 0.0_dp)
    call read_real_column(catchment_input_file_id, "tmelt", bsn_tmelt, 0.0_dp)
    call read_real_column(catchment_input_file_id, "smrate", bsn_smrate, 0.0_dp)
    call read_real_column(catchment_input_file_id, "gmrate", bsn_gmrate, 0.0_dp)
    call read_real_column(catchment_input_file_id, "bff", gw_bff, 0.0_dp)
    call read_real_column(catchment_input_file_id, "abf", gw_abf, 0.0_dp)
    call read_real_column(catchment_input_file_id, "delay", gw_delay, 0.0_dp)
    call read_real_column(catchment_input_file_id, "revapc", gw_revapc, 0.0_dp)
    call read_real_column(catchment_input_file_id, "rchrgc", gw_rchrgc, 0.0_dp)
    call read_real_column(catchment_input_file_id, "revapmn", gw_revapmn, 0.0_dp)

    call log_debug("catchment_read_subcatch_params", "Subcatchment parameters:")
    call log_debug("catchment_read_subcatch_params", "id", ints=catchment_ids)
    call log_debug("catchment_read_subcatch_params", "ecal", reals=bsn_ecal)
    call log_debug("catchment_read_subcatch_params", "thc", reals=bsn_thc)
    call log_debug("catchment_read_subcatch_params", "roc2", reals=bsn_roc2)
    call log_debug("catchment_read_subcatch_params", "roc4", reals=bsn_roc4)
    call log_debug("catchment_read_subcatch_params", "cncor", reals=bsn_cncor)
    call log_debug("catchment_read_subcatch_params", "sccor", reals=bsn_sccor)
    call log_debug("catchment_read_subcatch_params", "tsnfall", reals=bsn_tsnfall)
    call log_debug("catchment_read_subcatch_params", "tmelt", reals=bsn_tmelt)
    call log_debug("catchment_read_subcatch_params", "smrate", reals=bsn_smrate)
    call log_debug("catchment_read_subcatch_params", "gmrate", reals=bsn_gmrate)
    call log_debug("catchment_read_subcatch_params", "bff", reals=gw_bff)
    call log_debug("catchment_read_subcatch_params", "abf", reals=gw_abf)
    call log_debug("catchment_read_subcatch_params", "delay", reals=gw_delay)
    call log_debug("catchment_read_subcatch_params", "revapc", reals=gw_revapc)
    call log_debug("catchment_read_subcatch_params", "rchrgc", reals=gw_rchrgc)
    call log_debug("catchment_read_subcatch_params", "revapmn", reals=gw_revapmn)

  end subroutine catchment_read_subcatch_params

  !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

  subroutine catchment_assign_subcatch(mb)
    !-------------------------------------------------------------------------------
    ! Author : stefan.liersch@pik-potsdam.de
    ! Date : 2010-02-25
    ! modified: 2010-02-26
    !
    ! PURPOSE : Assigning individual subbasin parameters read from subcatch.prm
    !
    ! CALLED : from subroutine read_subcatch_def
    !-------------------------------------------------------------------------------
    use groundwater, only : &
      gw_abf, &
      gw_bff, &
      gw_delay, &
      gw_rchrgc, &
      gw_revapc, &
      gw_revapmn, &
      abf, &
      bff, &
      delay, &
      gwht, &
      gwq, &
      syld, &
      rchrgc, &
      revapc, &
      revapmn
    use soil, only: bsn_cncor, bsn_sccor, cncor, sccor
    use river, only: bsn_roc2, bsn_roc4, roc2, roc4
    use snow, only: &
      bsn_gmrate, &
      bsn_smrate, &
      bsn_tmelt, &
      bsn_tsnfall, &
      smrate, &
      gmrate, &
      tmelt, &
      tsnfall
    use evapotranspiration, only: bsn_thc, bsn_ecal, thc, ecal

    integer, intent(in) :: mb
    integer :: i, si

    do i = 1, mb
      si = subcatch_id(i)
      if (si /= 0) then
        ! groundwater parameters
        bff(i) = gw_bff(subcatch_id(i))
        gwht(i) = .5 ! gw_gwht(subcatch_id(i))
        gwq(i) = .5 ! gw_gwq(subcatch_id(i))
        abf(i) = gw_abf(subcatch_id(i))
        syld(i) = .003 ! gw_syld(subcatch_id(i))
        delay(i) = gw_delay(subcatch_id(i))
        revapc(i) = gw_revapc(subcatch_id(i))
        rchrgc(i) = gw_rchrgc(subcatch_id(i))
        revapmn(i) = gw_revapmn(subcatch_id(i))

        ! bsn parameters
        ecal(i) = bsn_ecal(subcatch_id(i))
        thc(i) = bsn_thc(subcatch_id(i))
        sccor(i) = bsn_sccor(subcatch_id(i))
        roc2(i) = bsn_roc2(subcatch_id(i))
        roc4(i) = bsn_roc4(subcatch_id(i))
        cncor(i) = bsn_cncor(subcatch_id(i))
        tsnfall(i) = bsn_tsnfall(subcatch_id(i))
        tmelt(i) = bsn_tmelt(subcatch_id(i))
        smrate(i) = bsn_smrate(subcatch_id(i))
        gmrate(i) = bsn_gmrate(subcatch_id(i))
      end if
    end do

  end subroutine catchment_assign_subcatch

  subroutine catchment_initialise_subcatchm(n, nbyr)
    use groundwater, only: groundwater_allocate_subcatch
    use evapotranspiration, only: evapotranspiration_allocate_sc
    use river, only: river_allocate_subcatch
    use soil, only: soil_allocate_subcatch
    use snow, only: snow_allocate_subcatch

    integer, intent(in) :: nbyr
    integer, intent(in) :: n

    allocate(subcatch_an(nbyr, n + 1, 30))
    subcatch_an = 0.
    allocate(subcatch_area(n))
    subcatch_area = 0.
    allocate(subcatch_name(n))
    subcatch_name = ''

    call groundwater_allocate_subcatch(n)
    call evapotranspiration_allocate_sc(n)
    call snow_allocate_subcatch(n)
    call river_allocate_subcatch(n)
    call soil_allocate_subcatch(n)

  end subroutine catchment_initialise_subcatchm

end module catchment