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