!------------------------------------------------------------------------------- ! Water management module (wam) !------------------------------------------------------------------------------- !------------------------------------------------------------------------------- ! Author : stefan.liersch@pik-potsdam.de, lobanova@pik-potsdam.de ! Version : 0.7 ! Crated : 2014-10-16 ! Modified: 2018-06-27 ! !------------------------------------------------------------------------------- ! !------------------------------------------------------------------------------- ! - Existing SWIM code files where small changes are necessary: ! - common.f90 ! - swim.f ! - reservoir.f90 ! - open.f90 ! - route.f90 ! - subbasin.f90 ! - readbas.f90 ! - hydrotop.f90 ! - vegfun.f90 ! To locate the required changes, search files for following line: !#### WATER MANAGEMENT MODULE #### ! NOTE: This module must be compiled before reservoir in MAKEFILE! !------------------------------------------------------------------------------- ! - Existing SWIM input files where small changes are necessary: ! - basin.bsn (water management switch) ! - column 'irr' required in *.str file after column NCELLS !------------------------------------------------------------------------------- ! !------------------------------------------------------------------------------- ! REQUIRED INPUT FILES ! - Water transfer control file ! "wam.ctrl" ! - Constant monthly, monthly, or daily time series data of each water users (input / output) ! "transWU000x.ts" => NOTE: The water user number in the file name must be provided as 4 digits integer!!! !------------------------------------------------------------------------------- ! OUTPUT FILES in directory "Res" ! - One output file for each water user ! "transWUxxxx.out" where x is the water user number ! - One output file for each subbasin involved in water transfers ! "transSUBxxxx.out" where x is the subbasin number ! - One summary output file for irrigation ! "wam_irrigation_summary.out" !------------------------------------------------------------------------------- ! ! PURPOSE: ! ! All globally used variables, subroutines, and functions in this module should have the prefix "wam_" ! ! ! !------------------------------------------------------------------------------- ! IDEAS TO IMPROVE THE MODULE !------------------------------------------------------------------------------- ! - In this version, all water users are treated according to their demand, meaning that ! if not enough water is available to satisfy the demand of all water users, ! the water user with highest demand gets highest share. ! An alternative option to distribute the available volume is for instance: ! - by water user priorities (highest gets all, second and third only what remains from higher priority users) !------------------------------------------------------------------------------- ! #### ToDo #### !------------------------------------------------------------------------------- ! - Water balance ! - Water withdrawn from the system should appear in the water balance! ! - Any kind of transmission losses should appear in the water balance! ! => to which output file? daily/monthly/annual output? => convert to [mm] ! ! - Priorities ! - One should be able to assign priorities to water users in case not sufficient water is available for all ! ! - Replace time series ! - This option is not yet implemented! The idea of this option is to read in a time series ! that replaces simulated discharge at a subbasin outlet (for calibration purposes). ! ! - Irrigation ! - Only one irrigation water user per subbasin possible, is this acceptable? ! - distinguish between sprinkler and drip irrigation by adding irrigation water ! to either rainfall (precip) or preinf, not sure if this is correctly implemented ! - wam_irrigation_summary output file: it seems not everything is summarised correctly ! - if 2 destination subbasins with irrigation water users .and. from input ts, then the second receives sometimes more than requested !------------------------------------------------------------------------------- module management use utilities, only : dp, & open_file, & path_max_length, & logger, & log_info, & log_debug, & log_warn, & log_error implicit none ! module switch logical, save :: bWAM_Module = .false. !############################################################################# ! ! VARIABLES & PARAMETERS ! !############################################################################# !------------------------------------------------------------------------------ ! WATER TRANSFER VARIABLES !------------------------------------------------------------------------------ ! switch module on (TRUE) or off (FALSE). Read in readbas.f90 from *.bsn file !logical, save :: wam_bTransfer defined in common.f90 logical, save, dimension(:), allocatable :: bWAMHydrograph ! transfer control file character(path_max_length) :: management_input_file = 'management.csv' integer :: management_input_file_id = 0 type(logger), save :: management_log character(path_max_length) :: management_users_input_dir = 'input/water_users' ! total number of water users integer, save :: wam_nWU = 0 logical, save, dimension(:), allocatable :: wam_bTransReplace ! number of subbasins with water transfer users integer, save :: wam_nsub !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ ! IRRIGATION VARIABLES !------------------------------------------------------------------------------ ! switch module on (TRUE) or off (FALSE). Read in readbas.f90 from *.bsn file !logical, save :: wam_bIrrigation ! defined in common.f90 ! irrigation control file !character(12), save :: wam_irr_ctrl = 'wam_irr.ctrl' ! total number of irrigation water users !integer, save :: wam_nIrr_WU = 0 ! efficiency of irrigation practice real(dp), save :: wam_eff_drip = 0.9 real(dp), save :: wam_eff_sprinkler = 0.65 !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ ! DATE ARRAYS for output only !------------------------------------------------------------------------------ ! array of current years and days of year integer, save, dimension(:), allocatable :: wam_y, wam_d !------------------------------------------------------------------------------ ! m3 / s real(dp), save, dimension(:), allocatable :: wam_plantDemand_summary ! m3 / s real(dp), save, dimension(:), allocatable :: wam_irrigationDemand_summary ! m3 / s real(dp), save, dimension(:), allocatable :: wam_supplied_summary !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ ! User-defined data types !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ TYPE :: TWaterUser ! water transfer user name character(len=path_max_length) :: name ! first year where water user is active integer :: fyr ! last year where water user is active integer :: lyr ! time step of input time series: integer :: ts_ ! 1 = constant monthly, ! 2 = monthly, ! 3 = daily ! water use option: integer :: wu_opt ! 1 transfer (from subbasin x to subbasin y) ! 2 transfer (from subbasin x to external destination) ! 3 input (from external source to subbasin x) ! 4 agr = irrigation (agricultural use) ! subbasin number of source integer :: subs ! subbasin number of destination integer :: subd ! efficiency of transfer from one subbasin to another within the basin real(dp) :: tr_eff ! 0 = 100% losses ! 1 = 0% losses ! area in m^2 only relevant for irrigation water users real(dp) :: area ! daily time series of withdrawal or supply (read from time series input file) ! [m3 / s], dimension (number of days of simulation + 1) real(dp), dimension(:), pointer :: data ! daily time series of plant water demand for irrigation ! [m3 / s], dimension (number of days of simulation + 1) real(dp), dimension(:), pointer :: plantDemand ! daily time series of total irrigation demand, including losses due to irrigation practice ! [m3 / s], dimension (number of days of simulation + 1) real(dp), dimension(:), pointer :: irrigationDemand ! daily time series of water supplied to this user, excluding transmission losses (calculated during simulation) ! [m3 / s] real(dp), dimension(:), pointer :: supplied ! daily time series of water transmission losses (calculated during simulation) ! [m3 / s] real(dp), dimension(:), pointer :: tr_losses !------------------------------------------------------------------- ! Following variables are required for water users of type irrigation only ! wu_opt = 4 !------------------------------------------------------------------- ! method to compute/read the daily irrigation demand integer :: irr_opt ! 1 = get daily values from input time series (format as indicated by ts_) ! 2 = compute demand from deficit method 1 ! 3 = compute demand from deficit method 2 ! 4 = compute demand from deficit method 3 ! 1 = sprinkler irrigation integer :: irr_practice ! 2 = drip irrigation ! Factor of deficit irrigation. 1. = no deficit irrigation: < 1. = deficit irrigation real(dp) :: irr_deficit_fac ! julian day (day of year) indicating the start of the irrigation period integer :: day_irr_start ! julian day (day of year) indicating the end of the irrigation period integer :: day_irr_end ! source of water: 1 = river; 2 = ground water; 3 = both integer :: w_source integer :: irr_eff_fac !------------------------------------------------------------------- END TYPE TWaterUser ! The size of the TWU array corresponds to the number of water users in the input file. ! Each TWU is associated with a subbasin of the data TYPE TSub. ! TWU is a target for pointers. TYPE (TWaterUser), dimension(:), allocatable, TARGET :: TWU !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ TYPE :: TSubbasin ! subbasin number integer :: subnr ! number of water transfer users integer :: nWU ! number of output and input water users integer :: nWUout, nWUin ! array position(s) of water user(s) in TWU array integer, dimension(:), pointer :: pos ! array position (only one allowed) of water user type: irrigation in TWU array integer :: pos_irr ! daily time series of minimal flows to be guaranteed in source subbasin [m3 / s], dimension(nDaysSim + 1) real(dp), dimension(:), pointer :: Q_min ! daily discharge time series of subbasin after including inflows and subtracting withdrawals [m3 / s], dimension(nDaysSim + 1) real(dp), dimension(:), pointer :: Q_act ! daily demand from irrigation, [m3 / s], dimension(nDaysSim + 1) real(dp), dimension(:), pointer :: irrDemand ! daily demand time series of all water users [m3 / s], dimension(nDaysSim + 1) real(dp), dimension(:), pointer :: totDemand ! daily inflow time series of all water users [m3 / s], dimension(nDaysSim + 1) real(dp), dimension(:), pointer :: inflow ! daily time series of total water withdrawals [m3 / s], including losses, dimension(nDaysSim + 1) real(dp), dimension(:), pointer :: withdrawal ! daily time series of total water losses from inflows [m3 / s] (using tr_eff), dimension(nDaysSim + 1) real(dp), dimension(:), pointer :: tr_losses_in ! daily time series of total water losses from withdrawals [m3 / s] (using tr_eff), dimension(nDaysSim + 1) real(dp), dimension(:), pointer :: tr_losses_out END TYPE TSubbasin ! The TYPE TSub represents a subbasin and contains the number of water users in the subbasin, ! the position of the respective water user(s) in the TWU array, ! and the daily time series of minimal flows. TYPE (TSubbasin), dimension(:), allocatable, TARGET :: TSub !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ TYPE :: TwamSub ! Subbasin number where water management is associated to. integer :: subnum ! pointer on TSub (TSubbasin) TYPE (TSubbasin), POINTER :: pSub END TYPE TwamSub ! The TYPE wamTSub represents more or less the interface through which the TSub and TWU ! variables can be accessed in any part of the SWIM code where this module is included ! using the 'use' statement. ! However, I recommend to use function "wam_get_pointer_subbasin(sub)" to get a pointer ! on TSub of the current subbasin (sub). ! dimension(mb) TYPE (TwamSub), dimension(:), allocatable :: wamTSub !------------------------------------------------------------------------------ ! Input file variables only temporarily allocated in management_read_ctrl ! water user name(s) character(len=path_max_length), save, dimension(:), allocatable :: wam_UName ! first year (yyyy) when transfer or irrigation takes place integer, save, dimension(:), allocatable :: wam_firstyr ! last year (yyyy) when transfer or irrigation takes place integer, save, dimension(:), allocatable :: wam_lastyr ! time step of input time series (1 = const. monthly; 2 = monthly; 3 = daily) integer, save, dimension(:), allocatable :: wam_ts ! water allocation type integer, save, dimension(:), allocatable :: wam_opt ! 1 = transfer from sub x to sub y) ! 2 = transfer to external destination) ! 3 = input (supply/inflow from external source) ! 4 = irrigation ! source subbasin number integer, save, dimension(:), allocatable :: wam_source ! destination subbasin number integer, save, dimension(:), allocatable :: wam_destination ! transfer efficiency (0 = 100 % losses; 1 = 0 % losses) real(dp), save, dimension(:), allocatable :: wam_eff ! Following the variables required for irrigation water users ! 1 = from input time series; 2 = from plant deficit integer, save, dimension(:), allocatable :: wam_irr_opt ! 1 = sprinkler irrigation; 2 = drip irrigation integer, save, dimension(:), allocatable :: wam_irr_practice ! Factor of deficit irrigation (1 = no deficit irrigation; < 1 = deficit irrigation) real(dp), save, dimension(:), allocatable :: wam_irr_deficit_fac ! julian day (day of year), start of irrigation period integer, save, dimension(:), allocatable :: wam_day_irr_start ! julian day (day of year), end of irrigation period integer, save, dimension(:), allocatable :: wam_day_irr_end ! water source: 1 = river; 2 = ground water; 3 = both (the latter two are not yet implemented) integer, save, dimension(:), allocatable :: wam_w_source NAMELIST / MANAGEMENT_PARAMETERS / & management_users_input_dir, & management_input_file, & bWAM_Module contains subroutine management_initialise(config_fid, frar, icodes, inum1s, iyr, mb, mhyd, mstruc, ndayssim, nbyr, neap, sbar, output_path) use utilities, only: log_create integer, intent(in) :: config_fid real(dp), dimension(:, :), intent(in) :: frar integer, dimension(:), intent(in) :: icodes integer, dimension(:), intent(in) :: inum1s integer, intent(in) :: iyr integer, intent(in) :: mb integer, intent(in) :: mhyd integer, dimension(:, :, :), intent(in) :: mstruc integer, intent(in) :: nDaysSim integer, intent(in) :: nbyr integer, dimension(:), intent(in) :: neap real(dp), dimension(:), intent(in) :: sbar character(len=path_max_length), intent(in) :: output_path integer :: i, logicalint ! overwrite parameters with user input read(config_fid, nml=MANAGEMENT_PARAMETERS) if (.not. bWAM_Module) return !------------------------------------------------------- ! initialise some required variables !------------------------------------------------------- allocate(wam_y(nDaysSim)) wam_y = 0 allocate(wam_d(nDaysSim)) wam_d = 0 allocate(wam_plantDemand_summary(nDaysSim)) wam_plantDemand_summary = 0. allocate(wam_irrigationDemand_summary(nDaysSim)) wam_irrigationDemand_summary = 0. allocate(wam_supplied_summary(nDaysSim)) wam_supplied_summary = 0. ! create water users configuration output file management_log = log_create(trim(output_path)//'/wam_transfer.log', & stdout_level='warn', stderr_level='warn', logfile_level='debug') call log_debug('management_initialise', 'Water Management Module logfile: '// & management_log%logfile) !------------------------------------------------------- ! read water transfer control file !------------------------------------------------------- ! read transfer control file ! and allocate water transfer arrays, pointers, and user-defined data types call management_read_ctrl(frar, mb, mstruc, nDaysSim, neap, sbar) !------------------------------------------------------- ! read water transfer time series input files !------------------------------------------------------- ! input time series will be converted to daily if necessary and ! stored in TWU%data and wamTSub%pSub%Q_min call management_read_wu_inout(iyr, nDaysSim, nbyr) ! Identify hydrograph storage locations of water transfer points (hydrograph storage locations) allocate(bWAMHydrograph(mhyd)) bWAMHydrograph = .false. call management_route_transfer(icodes, inum1s, mhyd) call log_info("management_initialise", 'Hydrograph storage locations identified', & log=management_log) do i = 1, mhyd if (bWAMHydrograph(i)) then logicalint = transfer(bWAMHydrograph(i), logicalint) call log_info('management_initialise', ' (HYDST) bWAMHyd', i1=i, int=logicalint, log=management_log) end if end do end subroutine management_initialise !------------------------------------------------------------------------------ !////////////////////////////////////////////////////////////////////////////// ! ! READ INPUT FILES ! !////////////////////////////////////////////////////////////////////////////// !------------------------------------------------------------------------------ subroutine management_read_ctrl(frar, mb, mstruc, ndayssim, neap, sbar) use input, only : & read_real_column, & read_integer_column, & read_string_column, & input_count_rows, & input_open_file real(dp), dimension(:, :), intent(in) :: frar integer, intent(in) :: mb integer, dimension(:, :, :), intent(in) :: mstruc integer, intent(in) :: nDaysSim integer, dimension(:), intent(in) :: neap real(dp), dimension(:), intent(in) :: sbar ! This subroutine reads the water transfer control file (wam_transfer.ctrl) ! and assigns the corresponding values to water users of TYPE TWU, ! the required subbasin variables and wamTSub. integer :: i, sub, hru, k, a real(dp) :: area ! pointer on subbasin TYPE (TSubbasin), POINTER :: pS ! pointer on actual water user (TWU) TYPE (TWaterUser), POINTER :: pWU !------------------------------------------------------------ ! open wam control file management_input_file_id = input_open_file(management_input_file) wam_nWU = input_count_rows(management_input_file_id, .true.) call management_allocate_transfer(wam_nWU) ! continue reading control file call read_string_column(management_input_file_id, 'name', wam_UName) call read_integer_column(management_input_file_id, 'first_year', wam_firstyr) call read_integer_column(management_input_file_id, 'last_year', wam_lastyr) call read_integer_column(management_input_file_id, 'ts', wam_ts) call read_integer_column(management_input_file_id, 'source', wam_source) call read_integer_column(management_input_file_id, 'destination', wam_destination) call read_real_column(management_input_file_id, 'trs_eff', wam_eff) call read_integer_column(management_input_file_id, 'irr_opt', wam_irr_opt) call read_integer_column(management_input_file_id, 'irr_practice', wam_irr_practice) call read_real_column(management_input_file_id, 'irr_deficit', wam_irr_deficit_fac, 1.0_dp) call read_integer_column(management_input_file_id, 'day_irr_start', wam_day_irr_start, 1) call read_integer_column(management_input_file_id, 'day_irr_end', wam_day_irr_end, 365) call read_integer_column(management_input_file_id, 'irr_water_source', wam_w_source, 1) close(management_input_file_id) !------------------------------------------------------------ !------------------------------------------------------------ ! assign water user options (transfer or irrigation) do i = 1, wam_nWU if (wam_source(i) > mb ) then call log_error("wam", "Subbasin number (subs) of water user does not exist!", int=i) end if if (wam_destination(i) > mb ) then call log_error("wam", "Subbasin number (subd) of water user does not exist!", int=i) end if wam_opt(i) = 0 ! transfer from sub x to sub y) if (wam_source(i) > 0 .AND. wam_destination(i) > 0 & .AND. wam_irr_opt(i) == 0 ) wam_opt(i) = 1 ! transfer to external destination) if (wam_source(i) > 0 .AND. wam_destination(i) == 0 ) wam_opt(i) = 2 ! input (supply/inflow from external source) if (wam_source(i) == 0 .AND. wam_destination(i) > 0 & .AND. wam_irr_opt(i) == 0 ) wam_opt(i) = 3 ! irrigation if (wam_irr_opt(i) > 0 ) wam_opt(i) = 4 ! if source and destination subbasins are the same, it should be irrigation if (wam_source(i) > 0 & .AND. wam_source(i) == wam_destination(i) ) wam_opt(i) = 4 end do !------------------------------------------------------------ !------------------------------------------------------------ ! allocate and assign data to water users of TYPE TWU !------------------------------------------------------------ ! array of water users (corresponds to the number of water users defined in the control file) allocate(TWU(wam_nWU)) do i = 1, wam_nWU ! loop over water users pWU => TWU(i) ! pointer on current water user pWU % name = wam_UName(i) pWU % fyr = wam_firstyr(i) pWU % lyr = wam_lastyr(i) pWU % ts_ = wam_ts(i) ! type of time series (daily, monthly...) pWU % wu_opt = wam_opt(i) ! type of water user (transfer or irrigation) pWU % subs = wam_source(i) if (pWU % subs > mb .OR. pWU % subs < 0) then call log_error("wam", "Subbasin number (subs) of water user does not exist!", int=i) end if pWU % subd = wam_destination(i) if (pWU % subd > mb .OR. pWU % subd < 0) then call log_error("wam", "Subbasin number (subd) of water user does not exist!", int=i) end if pWU % tr_eff = wam_eff(i) if (pWU % tr_eff > 1.) then pWU % tr_eff = 1. call log_error("wam", "Transfer efficiency of water user ...set to 1.0", int=i) end if if (pWU % tr_eff < 0.) then pWU % tr_eff = 0. call log_error("wam", "Transfer efficiency of water user ...set to 0.0", int=i) end if allocate(pWU % data(0:nDaysSim)) pWU % data = 0. ! daily time series (data) of respective water user(s) are assigned later! allocate(pWU % supplied(0:nDaysSim)) pWU % supplied = 0. ! data assigned day by day during simulation allocate(pWU % tr_losses(0:nDaysSim)) pWU % tr_losses = 0. ! data assigned day by day during simulation allocate(pWU % plantDemand(0:nDaysSim)) pWU % plantDemand = 0. ! data assigned day by day during simulation allocate(pWU % irrigationDemand(0:nDaysSim)) pWU % irrigationDemand = 0. ! data assigned day by day during simulation ! irrigation variables pWU % irr_opt = wam_irr_opt(i) pWU % irr_practice = wam_irr_practice(i) pWU % irr_deficit_fac = wam_irr_deficit_fac(i) pWU % day_irr_start = wam_day_irr_start(i) pWU % day_irr_end = wam_day_irr_end(i) pWU % w_source = wam_w_source(i) !------------------------------------------------------------ ! Check, if the irrigated area, summarised for each subbasin from *.str file is ! > 0 for irrigation water users ! = 0 for transfer water users ! otherwise, the *.str file (column IRR) requires correction !------------------------------------------------------------ pWU % area = 0. ! check for irrigation water users if (pWU % wu_opt == 4) then do sub = 1, mb area = 0. do hru = 1, neap(sub) ! loop over number HRUs in current subbasin if (mstruc(sub, hru, 7) >= 1 .AND. sub == pWU % subd ) & pWU % area = real(pWU % area + frar(sub, hru) * sbar(sub)) end do end do ! stop execution, if area == 0 (no HRU with irrigation > 0 in *.str file) if (pWU % area <= 0.) then call log_error("wam", & "There was no HRU with irrigation option identified in (subbasin) for water user: "//trim(pWU%name), & i1=pWU%subd) end if end if ! check for transfer water users if (pWU % wu_opt /= 4) then do sub = 1, mb area = 0. do hru = 1, neap(sub) ! loop over number HRUs in current subbasin if (mstruc(sub, hru, 7) >= 1 .AND. sub == pWU % subd ) then call log_error("wam", "In (subbasin, HRU) was identified as irrigated area, "// & "which should not be the case, because it was assigned as "// & "Set respective value to 0 in the column in the *.str file!", i1=sub, i2=hru) end if end do end do end if !------------------------------------------------------------ end do ! do i = 1, wam_nWU ! loop over water users !------------------------------------------------------------ call management_deallocate_transfer ! deallocate arrays not required anymore !------------------------------------------------------------ !------------------------------------------------------------ ! allocate and initialise array of TYPE wamTSub that contains information on ! - whether subbasin consists of water users (subnum = subbasin number) or no water users (subnum = 0) ! - and pointer to respective location in array TYPE of TSub !------------------------------------------------------------ allocate(wamTSub(mb)) wamTSub % subnum = 0 ! set all subnum values to 0 do i = 1, mb NULLIFY (wamTSub(i) % pSub) ! nullify all pointers end do ! identify and assign subbasin numbers used for water allocation and/or irrigation do i = 1, wam_nWU pWU => TWU(i) if (pWU % subs > 0) wamTSub(pWU % subs) % subnum = pWU % subs ! If a water user transfers water to another (destination) subbasin, ! this destination subbasin will be identified here as a water allocation subbasin, too. if (pWU % subd > 0) wamTSub(pWU % subd) % subnum = pWU % subd end do call log_info("wam", 'Subbasin numbers where water allocation takes place, either as a source or destination', & log=management_log) do i = 1, mb if (wamTSub(i)%subnum == i ) call log_info("wam", "", int=wamTSub(i)%subnum, log=management_log) end do !------------------------------------------------------------ !------------------------------------------------------------ !count number of subbasins with water allocation users !------------------------------------------------------------ wam_nsub = 0 do i = 1, mb if (wamTSub(i) % subnum > 0 ) wam_nsub = wam_nsub + 1 end do call log_info("wam", 'Number of subbasins with water allocation users:', & int=wam_nsub, log=management_log) !------------------------------------------------------------ !------------------------------------------------------------ ! initialise variables of TYPE TSub !------------------------------------------------------------ allocate(TSub(wam_nsub)) do i = 1, wam_nsub TSub(i) % nWU = 0 TSub(i) % nWUout = 0 TSub(i) % nWUin = 0 allocate(TSub(i) % Q_min(0:nDaysSim)) TSub(i) % Q_min = 0. allocate(TSub(i) % Q_act(0:nDaysSim)) TSub(i) % Q_act = 0. allocate(TSub(i) % irrDemand(0:nDaysSim)) TSub(i) % irrDemand = 0. ! data assigned day by day during simulation allocate(TSub(i) % totDemand(0:nDaysSim)) TSub(i) % totDemand = 0. ! data assigned day by day during simulation allocate(TSub(i) % inflow(0:nDaysSim)) TSub(i) % inflow = 0. ! data assigned day by day during simulation allocate(TSub(i) % tr_losses_in(0:nDaysSim)) TSub(i) % tr_losses_in = 0. ! data assigned day by day during simulation allocate(TSub(i) % tr_losses_out(0:nDaysSim)) TSub(i) % tr_losses_out = 0. ! data assigned day by day during simulation allocate(TSub(i) % withdrawal(0:nDaysSim)) TSub(i) % withdrawal = 0. ! data assigned day by day during simulation ! TSub%pos will be initialised when nWU is known end do !------------------------------------------------------------ !------------------------------------------------------------ ! assign pointers from wamTSub to each TSub !------------------------------------------------------------ k = 0 do i = 1, mb if (wamTSub(i) % subnum > 0 ) then k = k + 1 wamTSub(i) % pSub => TSub(k) TSub(k) % subnr = wamTSub(i) % subnum end if end do !------------------------------------------------------------ !------------------------------------------------------------ ! count number of water users per subbasin and assign to TSub%nWU !------------------------------------------------------------ do i = 1, wam_nWU ! loop over total number of water users if (management_is_transfer_subbasin(TWU(i) % subs) ) then pS => management_subbasin_pointer(TWU(i) % subs) ! pointer on source subbasin pS % nWU = pS % nWU + 1 ! add water user pS % nWUout = pS % nWUout + 1 ! add water user of type output end if if (management_is_transfer_subbasin(TWU(i) % subd) ) then pS => management_subbasin_pointer(TWU(i) % subd) ! pointer on destination subbasin if (TWU(i) % wu_opt == 4 .AND. TWU(i) % subs /= TWU(i) % subd ) pS % nWU = pS % nWU + 1 ! add water user if (TWU(i) % wu_opt /= 4 ) pS % nWU = pS % nWU + 1 ! add water user pS % nWUin = pS % nWUin + 1 ! add water user of type input end if end do !------------------------------------------------------------ !------------------------------------------------------------ !allocate TSub%pos !------------------------------------------------------------ do i = 1, wam_nsub ! loop over number of subbasins where water allocation takes place pS => management_subbasin_pointer(TSub(i) % subnr) allocate(pS % pos(pS % nWU)) ! assign position of current water user in water user array to %pos a = 0 do k = 1, wam_nWU ! loop over water users if (TWU(k) % subs == pS % subnr .OR. TWU(k) % subd == pS % subnr ) then a = a + 1 if (TWU(k) % wu_opt == 4) pS % pos_irr = k ! if water user is of type irrigation pS % pos(a) = k end if end do end do !------------------------------------------------------------ !------------------------------------------------------------ ! write log file !------------------------------------------------------------ call log_info("wam", 'Water users per subbasin', log=management_log) call log_info("wam", ' sub No_of_WU', log=management_log) do i = 1, wam_nsub pS => management_subbasin_pointer(TSub(i) % subnr) call log_info("wam", '', ints=(/pS%subnr, pS%nWU/), log=management_log) end do call log_info("wam", 'Type of Water users per subbasin', log=management_log) call log_info("wam", ' sub No_of_WU nWUin nWUout', log=management_log) do i = 1, wam_nsub pS => management_subbasin_pointer(TSub(i) % subnr) call log_info("wam", '', ints=(/pS%subnr, pS%nWU, pS%nWUin, pS%nWUout/), log=management_log) end do call log_info("wam", 'wu_opt (transfer or irrigation)', log=management_log) call log_info("wam", 'wu_opt: 1 = transfer from subbasin x to subbasin y', log=management_log) call log_info("wam", 'wu_opt: 2 = transfer from subbasin x to external destination', log=management_log) call log_info("wam", 'wu_opt: 3 = transfer from external source to subbasin x', log=management_log) call log_info("wam", 'wu_opt: 4 = irrigation', log=management_log) call log_info("wam", 'WU_name subd subs wu_opt', log=management_log) do i = 1, wam_nWU call log_info("wam", trim(TWU(i)%name), ints=(/TWU(i)%subs, TWU(i)%subd, TWU(i)%wu_opt/), log=management_log) end do !------------------------------------------------------------ end subroutine management_read_ctrl !------------------------------------------------------------------------------ subroutine management_allocate_transfer(n) ! number of water users integer, intent(in) :: n allocate(wam_UName(n)) wam_UName = '' allocate(wam_firstyr(n)) wam_firstyr = 0 allocate(wam_lastyr(n)) wam_lastyr = 0 allocate(wam_ts(n)) wam_ts = 0 allocate(wam_opt(n)) wam_opt = 0 allocate(wam_source(n)) wam_source = 0 allocate(wam_destination(n)) wam_destination = 0 allocate(wam_eff(n)) wam_eff = 0. ! irrigation variables allocate(wam_irr_opt(n)) wam_irr_opt = 0 allocate(wam_irr_practice(n)) wam_irr_practice = 0 allocate(wam_irr_deficit_fac(n)) wam_irr_deficit_fac = 0. allocate(wam_day_irr_start(n)) wam_day_irr_start = 0 allocate(wam_day_irr_end(n)) wam_day_irr_end = 0 allocate(wam_w_source(n)) wam_w_source = 0 end subroutine management_allocate_transfer !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ subroutine management_deallocate_transfer deallocate(wam_UName) deallocate(wam_firstyr) deallocate(wam_lastyr) deallocate(wam_ts) deallocate(wam_opt) deallocate(wam_source) deallocate(wam_destination) deallocate(wam_eff) deallocate(wam_irr_opt) deallocate(wam_irr_practice) deallocate(wam_irr_deficit_fac) deallocate(wam_day_irr_start) deallocate(wam_day_irr_end) end subroutine management_deallocate_transfer !------------------------------------------------------------------------------ subroutine management_read_wu_inout(iyr, ndayssim, nbyr) integer, intent(in) :: iyr integer, intent(in) :: nDaysSim integer, intent(in) :: nbyr integer :: wu_id, ts_type character(len=path_max_length) :: fname do wu_id = 1, wam_nWU ! total number of water transfer users ! generate input time series file name fname = trim(TWU(wu_id)%name)//".csv" ts_type = TWU(wu_id) % ts_ ! format of input time series (constant monthly / monthly / daily) select case (ts_type) case(1) ! read constant monthly (nval = 12) and convert to daily ts ! and store in: TWU(wu_id)%data call management_read_time_series(12, fname, len_trim(fname), wu_id, iyr, nDaysSim, nbyr) case(2) ! read monthly time series (nval=years*12) and convert to daily ts ! and store in: TWU(wu_id)%data call management_read_time_series(12*nbyr, fname, len_trim(fname), wu_id, iyr, nDaysSim, nbyr) case(3) ! read daily time series (nval = nDaysSim) ! and store in: TWU(wu_id)%data call management_read_time_series(nDaysSim, fname, len_trim(fname), wu_id, iyr, nDaysSim, nbyr) end select end do end subroutine management_read_wu_inout !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ subroutine management_read_time_series(nval, fname, n, wu_id, iyr, ndayssim, nbyr) use input, only : read_real_column use utilities, only : open_file integer, intent(in) :: iyr integer, intent(in) :: nDaysSim integer, intent(in) :: nbyr ! number of values in InOut and Q_min integer, intent(in) :: nval ! length of file name and transfer user ID integer, intent(in) :: n, wu_id ! number of columns in input files ! file name character(len = n) :: fname ! first column of input file (indicates the month) ! number of years * 12 monthly values m3 / s real(dp), dimension(nval) :: InOut, Q_min integer :: fid ! subbasin number integer :: sub sub = TWU(wu_id) % subs fid = open_file(trim(management_users_input_dir)//'/'//trim(fname)) call read_real_column(fid, "Q_in_out_m3s", InOut) call read_real_column(fid, "Qmin_m3s", Q_min) close(fid) ! Assign water user data to: TWU(i)%data and convert to daily if necessary. call management_convert_to_daily(nval, TWU(wu_id) % data, InOut, wu_id, iyr, nDaysSim, nbyr) ! Assign subbasin's minimal flow data to: (TSub)%Q_min and convert to daily if necessary. ! NOTE: Subbasin (TSub)%Q_min values might be overwritten if the number of water users in a subbasin > 1 ! In this case, the values of the last water user are considered! if (TWU(wu_id) % wu_opt <= 2 .OR. TWU(wu_id) % wu_opt == 4 .AND. sub > 0 ) & call management_convert_to_daily(nval, wamTSub(sub) % pSub % Q_min, Q_min, wu_id, iyr, nDaysSim, nbyr) ! in case WU is of type irrigation .AND. demand is calculated from plant demand, ! overwrite values of data with 0. if (TWU(wu_id) % wu_opt == 4 .AND. TWU(wu_id) % irr_opt > 1 ) TWU(wu_id) % data = 0. RETURN end subroutine management_read_time_series !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ subroutine management_convert_to_daily(nval, dailyarray, val, wu_id, iyr, ndayssim, nbyr) use utilities, only: days_in_month integer, intent(in) :: iyr integer, intent(in) :: nDaysSim integer, intent(in) :: nbyr ! converts constant monthly or monthly input time series to daily times series (dimension: nDaysSim) ! number of input values in "val" integer, intent(in) :: nval ! input values real(dp), dimension(nval), intent(in) :: val integer, intent(in) :: wu_id real(dp), dimension(nDaysSim + 1), intent(inout) :: dailyArray integer :: y, d, ndays integer, TARGET :: dc, m, mc integer, POINTER :: pCounter dc = 0 ! if nval = nDaysSim ( day counter) m = 0 ! if nval = 12 (month counter) mc = 0 ! if nval = 12 * nbyr (month counter) if (nval == 12) pCounter => m if (nval == nbyr * 12) pCounter => mc if (nval == nDaysSim) pCounter => dc ! convert monthly time series to daily do y = 1, nbyr ! loop over years do m = 1, 12 ! loop over months ndays = days_in_month(m, y - 1 + iyr) ! function defined in common.f90 mc = mc + 1 do d = 1, ndays dc = dc + 1 ! check if current year is within water users' operational mode period if (y + iyr - 1 >= TWU(wu_id) % fyr .AND. y + iyr - 1 <= TWU(wu_id) % lyr) then dailyArray(dc) = val(pCounter) else dailyArray(dc) = 0. end if end do end do end do end subroutine management_convert_to_daily !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ subroutine management_route_transfer(icodes, inum1s, mhyd) integer, dimension(:), intent(in) :: icodes integer, dimension(:), intent(in) :: inum1s integer, intent(in) :: mhyd ! identify hydrograph storage locations for water transfer subbasins integer :: i, j ! identify subbasins where nothing is routed through logical, dimension(wam_nWU) :: notRouted_n, notRouted_d notRouted_n = .true. notRouted_d = .true. ! identify hydrograph storage location for each transfer point (subbasin) ! identify only those which are subbasins where water is routed through do i = 1, mhyd if (icodes(i) == 2 ) then ! ROUTE command do j = 1, wam_nWU if (inum1s(i) == TWU(j) % subs ) then bWAMHydrograph(i + 1) = .true. !ihouts(i) notRouted_n(j) = .false. end if if (inum1s(i) == TWU(j) % subd ) then ! check for destination subbasin bWAMHydrograph(i + 1) = .true. !ihouts(i) notRouted_d(j) = .false. end if end do end if end do ! Some subbasins will certainly not be captured by the algorithm above. ! Normally these are headwater subbasins. ! The following loop captures those headwater subbasins. do j = 1, wam_nWU if (notRouted_n(j) .AND. TWU(j) % subs > 0 ) & bWAMHydrograph(TWU(j) % subs) = .true. !TWU(j) % subs if (notRouted_d(j) .AND. TWU(j) % subd > 0 ) & bWAMHydrograph(TWU(j) % subd) = .true. !TWU(j) % subd end do end subroutine management_route_transfer !------------------------------------------------------------------------------ !////////////////////////////////////////////////////////////////////////////// !////////////////////////////////////////////////////////////////////////////// ! ! WATER TRANSFER PROCESSES ! CALLED FROM MAINPRO during daily SUBBASIN command ! !////////////////////////////////////////////////////////////////////////////// !////////////////////////////////////////////////////////////////////////////// !------------------------------------------------------------------------------ subroutine management_external_supply(sub, day, ida, iyr) integer, intent(in) :: ida integer, intent(in) :: iyr ! calculate total inputs from external source(s) where this subbain is a destination subbasin ! external supply is true, if source subbasin number == 0 .AND. destination subbasin number >=1 .AND. <=mb ! this condition is true if TWU(sub)%wu_opt == 3 ! CALLED FROM MONTHLY (in daily SUBBASIN command) ! current subbasin number integer, intent(in) :: sub ! current day of simulation integer, intent(in) :: day integer :: i ! pointer on actual subbasin (TSub) TYPE (TSubbasin), POINTER :: pS, pSd ! pointer on actual water user (TWU) TYPE (TWaterUser), POINTER :: pWU ! NOTE: If subbasin receives water from another subbasin, this supply volume ! is added later on in subroutine wam_withdraw_Transfer_Out if (management_is_transfer_subbasin(sub) ) then pS => management_subbasin_pointer(sub) if (pS % nWUin > 0) then do i = 1, pS % nWU ! loop over water users in subbasin pWU => management_user_pointer(pS % pos(i)) ! pointer on current water user !----------------------------------------------------------------- ! if destination subbasin receives water from external source !----------------------------------------------------------------- if (pWU % wu_opt == 3 .AND. management_is_active_period(iyr, ida, pWU) ) then !----------------------------------------------------------------- ! TSub (current subbasin) !----------------------------------------------------------------- ! add external supply to destination subbasin inflow pS % inflow(day) = pS % inflow(day) & ! [m3 / s] + pWU % data(day) & ! add supply from external source (daily time series input file) * pWU % tr_eff ! subtract losses ! add losses to destination subbasin pS % tr_losses_in(day) = pS % tr_losses_in(day) & + pWU % data(day) * (1. - pWU % tr_eff) ! summarise losses [m3 / s] !----------------------------------------------------------------- !----------------------------------------------------------------- ! TWU (current water user) !----------------------------------------------------------------- ! calculate volume delivered to water user pWU % supplied(day) = pWU % data(day) * pWU % tr_eff ! [m3 / s] ! calculate losses during transfer pWU % tr_losses(day) = pWU % data(day) * (1. - pWU % tr_eff) ! [m3 / s] !----------------------------------------------------------------- end if !----------------------------------------------------------------- ! Water user type: IRRIGATION, unlimited external source, from input file !----------------------------------------------------------------- ! Put on the field what is provided by external source if (pWU % wu_opt == 4 .AND. pWU % subs == 0 .AND. pWU % irr_opt == 1 & .AND. management_is_active_period(iyr, ida, pWU) .AND. pWU % data(day) > 0. ) then pSd => management_subbasin_pointer(pWU % subd) !----------------------------------------------------------------- ! TWU (current water user) !----------------------------------------------------------------- pWU % supplied(day) = pWU % data(day) * pWU % tr_eff ! [m3 / s] wam_supplied_summary(day) = wam_supplied_summary(day) + pWU % supplied(day) ! [m3 / s] pWU % tr_losses(day) = pWU % data(day) * (1. - pWU % tr_eff) ! [m3 / s] !----------------------------------------------------------------- ! TSub (current subbasin) !----------------------------------------------------------------- !!!! pWU%supplied should not be added to %inflow, because the irrigation supply is added in hydrotope !!!! %inflow is added to sda or varoute in "subbasin" and/or "add" !pSd%inflow(day) = pSd%inflow(day) + pWU%supplied(day) pSd % tr_losses_in(day) = pSd % tr_losses_in(day) + pWU % tr_losses(day) end if !----------------------------------------------------------------- ! Water user type: IRRIGATION, unlimited external source, demand from plant deficit !----------------------------------------------------------------- ! assuming an unlimited source providing exactly the required irrigation demand if (day > 1) then if (pWU % wu_opt == 4 .AND. pWU % subs == 0 .AND. pWU % irr_opt == 2 & .AND. management_is_active_period(iyr, ida, pWU) .AND. pWU % irrigationDemand(day - 1) > 0. ) then ! .AND. pWU % supplied(day - 1) > 0. ) then pSd => management_subbasin_pointer(pWU % subd) !----------------------------------------------------------------- ! TWU (current water user) !----------------------------------------------------------------- pWU % data(day) = pWU % irrigationDemand(day - 1) ! [m3 / s] pWU % supplied(day) = pWU % irrigationDemand(day - 1) ! [m3 / s] wam_supplied_summary(day) = wam_supplied_summary(day) + pWU % supplied(day) ! [m3 / s] pWU % tr_losses(day) = pWU % supplied(day - 1) * (1. - pWU % tr_eff) ! [m3 / s] !----------------------------------------------------------------- ! TSub (current subbasin) !----------------------------------------------------------------- pSd % irrDemand(day) = pSd % irrDemand(day) + pWU % irrigationDemand(day - 1) !!!! pWU%supplied should not be added to %inflow, because the irrigation supply is added in hydrotope !!!! %inflow is added to sda or varoute in "subbasin" and/or "add" !pSd%inflow(day) = pSd%inflow(day) + pWU%supplied(day) pSd % tr_losses_in(day) = pWU % tr_losses(day) end if end if ! ( day > 1 ) end do end if else call log_warn("wam", "Water allocation module was called for (subbasin) "// & "although it has no water users !!!", i1=sub) end if end subroutine management_external_supply !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ subroutine management_total_demand(sub, day, ida, iyr) integer, intent(in) :: ida integer, intent(in) :: iyr ! calculate total outputs of all water user(s) ! CALLED FROM MONTHLY (in daily SUBBASIN command) ! current subbasin number integer, intent(in) :: sub ! current day of simulation integer, intent(in) :: day integer :: i ! pointer on current TSub TYPE (TSubbasin), POINTER :: pS ! pointer on actual TWU TYPE (TWaterUser), POINTER :: pWU if (management_is_transfer_subbasin(sub) ) then pS => management_subbasin_pointer(sub) !wamTSub(sub) % pSub if (pS % nWUout > 0) then do i = 1, pS % nWU ! loop over water users in subbasin pWU => management_user_pointer(pS % pos(i)) !----------------------------------------------------------------- ! if the current subbasin is a water source for transfer to another subbasin or external destination !----------------------------------------------------------------- if (pWU % wu_opt <= 2 .AND. pWU % subs == pS % subnr .AND. management_is_active_period(iyr, ida, pWU) ) then ! add demands of water user(s) pS % totDemand(day) = pS % totDemand(day) + pWU % data(day) ! [m3 / s] end if !----------------------------------------------------------------- ! add irrigation demand of previous day !----------------------------------------------------------------- if (day > 1) then ! if source is another subbasin if (pWU % wu_opt == 4 .AND. pWU % subs > 0 .AND. management_is_active_period(iyr, ida, pWU) ) then ! add inputs from input time series if (pWU % irr_opt == 1) then pS % totDemand(day) = pS % totDemand(day) + pWU % data(day) pS % irrDemand(day) = pS % irrDemand(day) + pWU % data(day) end if ! add irrigation demand of previous day to total demand if (pWU % irr_opt > 1 .AND. pWU % irrigationDemand(day - 1) > 0. ) then pS % totDemand(day) = pS % totDemand(day) + pWU % irrigationDemand(day - 1) pS % irrDemand(day) = pS % irrDemand(day) + pWU % irrigationDemand(day - 1) end if end if end if ! (day > 1) end do end if else call log_warn("wam", "Water allocation module was called for (subbasin) although it has no water users", i1=sub) end if end subroutine management_total_demand !------------------------------------------------------------------------------ !////////////////////////////////////////////////////////////////////////////// ! ! WATER TRANSFER PROCESSES ! CALLED FROM subroutine 'subbasin' ! !////////////////////////////////////////////////////////////////////////////// !------------------------------------------------------------------------------ subroutine management_transfer_out(sub, surfacer, subsurfacer, day, ida, iyr) integer, intent(in) :: ida integer, intent(in) :: iyr ! integer, dimension(:), intent(in) :: subs ! This subroutine is called from subroutine 'subbasin' (if subbasin is a headwater) ! OR from subroutine 'add' if it is a subbasin where the water is routed through ! It calculates withdrawals, supply, and transmission losses. ! subbasin number integer, intent(in) :: sub ! sda(2, sub), sda(8, sub) real(dp), intent(inout) :: surfaceR, subsurfaceR ! current day of simulation, not julian day integer, intent(in) :: day integer :: i ! [m3] subbasins' inflow + own contributions real(dp) :: voltot ! [m3] volume of water available for downstream routing real(dp) :: available_vol ! fraction of surface runoff contribution to gw contribution real(dp) :: frac_sr ! pointer on actual TSub TYPE (TSubbasin), POINTER :: pS ! pointer on destination TSub TYPE (TSubbasin), POINTER :: pSd ! pointer on actual TWU TYPE (TWaterUser), POINTER :: pWU available_vol = 0. pS => management_subbasin_pointer(sub) ! pointer on actual subbasin if (pS % nWUout > 0) then ! do water users exist receiving water from this subbasin !------------------------------------------------------- ! check if flow values are negative !------------------------------------------------------- if (surfaceR < 0.) then call log_warn("wam", "Surface runoff (varoute2, x) is negative! Subbasin:", int=sub) surfaceR = 1.e-6 end if if (subsurfaceR < 0.) then call log_warn("wam", "Subsurface runoff (varoute8, x) is negative! Subbasin:", int=sub) subsurfaceR = 1.e-6 end if !------------------------------------------------------- ! calculate available volume at subbains' outlet !------------------------------------------------------- voltot = max(0.0_dp, surfaceR) + max(0.0_dp, subsurfaceR) ! [m3] ! correct on minimal flows required in subbasin available_vol = voltot - pS % Q_min(day) * 86400. ! [m3] if (available_vol > 0. .AND. pS % totDemand(day) > 0. ) then frac_sr = max(0.0_dp, surfaceR) / voltot !------------------------------------------------------- ! If there is enough water to satisfy total demand of all users in subbasin !------------------------------------------------------- if (available_vol >= pS % totDemand(day) * 86400. ) then ! in [m3] ! allocate water to corresponding water user(s) do i = 1, pS % nWU ! loop over water user(s) in actual subbasin pWU => management_user_pointer(pS % pos(i)) ! pointer on current water user ! transfer to another subbasin .OR. to external destination .OR. to irrigation user if (pWU % wu_opt <= 2 .AND. management_is_active_period(iyr, ida, pWU) ) then if (pWU % subs == pS % subnr) then ! if the current subbasin is a water source !----------------------------------------------------------------- ! TSub (current subbasin) !----------------------------------------------------------------- ! add actual withdrawals of all water users from source subbasin pS % withdrawal(day) = pS % withdrawal(day) + pWU % data(day) ! deliver what is demanded ! add actual losses of all water users from source subbasin pS % tr_losses_out(day) = pS % tr_losses_out(day) + pWU % data(day) * (1. - pWU % tr_eff) ! knowing that demand can be delivered ! add withdrawal day as %inflow and %tr_losses_in to destination subbasin if (pWU % wu_opt == 1) then pSd => management_subbasin_pointer(pWU % subd) pSd % inflow(day) = pSd % inflow(day) + pWU % data(day) * pWU % tr_eff pSd % tr_losses_in(day) = pSd % tr_losses_in(day) + pWU % data(day) * (1. - pWU % tr_eff) end if !----------------------------------------------------------------- !----------------------------------------------------------------- ! TWU (current water user) !----------------------------------------------------------------- ! calculate volume delivered to water user pWU % supplied(day) = pWU % data(day) * pWU % tr_eff ! [m3 / s] ! calculate losses during transfer pWU % tr_losses(day) = pWU % data(day) * (1. - pWU % tr_eff) ! [m3 / s] !----------------------------------------------------------------- end if ! ( pWU % wu_opt <= 2 .OR. pWU % wu_opt == 4 ) end if ! pWU % wu_opt <= 2 !----------------------------------------------------------------- ! Irrigation !----------------------------------------------------------------- if (day > 1) then ! account for irrigation water users if (pWU % wu_opt == 4 .AND. pWU % subs > 0 .AND. management_is_active_period(iyr, ida, pWU) ) then ! calculate volume delivered to water user ! add actual withdrawals from irrigation WU ! pS%irrDemand is corrected by irrigation practices and efficiencies if (pWU % irr_opt == 1) & ! deliver what is demanded according to input time series pS % withdrawal(day) = pS % withdrawal(day) + pWU % data(day - 1) if (pWU % irr_opt == 2) & ! deliver what is demanded according to calculated plant demand pS % withdrawal(day) = pS % withdrawal(day) + pWU % irrigationDemand(day - 1) ! add actual losses of irrigation water user pS % tr_losses_out(day) = pS % tr_losses_out(day) + pWU % irrigationDemand(day - 1) * (1. - pWU % tr_eff) ! knowing that demand can be delivered if (pWU % irr_opt == 1) pWU % supplied(day) = pWU % data(day) * pWU % tr_eff ! [m3 / s] if (pWU % irr_opt == 2) pWU % supplied(day) = pWU % irrigationDemand(day - 1) * pWU % tr_eff ! [m3 / s] wam_supplied_summary(day) = wam_supplied_summary(day) + pWU % supplied(day) !pWU%tr_losses(day) = pWU%irrigationDemand(day-1) * (1.-pWU%tr_eff) ! [m3/s] pWU % tr_losses(day) = pWU % supplied(day) * (1. - pWU % tr_eff) ! [m3 / s] if (pWU % subs /= pWU % subd) then pSd => management_subbasin_pointer(pWU % subd) !!!! pWU%supplied should not be added to %inflow, because the irrigation supply is added in hydrotope !!!! %inflow is added to sda or varoute in "subbasin" and/or "add" !pSd%inflow(day) = pSd%inflow(day) + pWU%supplied(day) ! pWU%irrigationDemand(day) * pWU%tr_eff ! [m3/s] pSd % tr_losses_in(day) = pSd % tr_losses_in(day) + pWU % tr_losses(day) ! pWU % irrigationDemand(day) * (1. - pWU % tr_eff) end if end if !( pWU % wu_opt == 4 .AND. pWU % subs > 0 .AND. pS % irrDemand(day) > 0. ) end if !----------------------------------------------------------------- end do ! i = 1, pS % nWU ! withdraw total demand from surface and subsurface runoff !!! NOTE: the values of varoute(2, ihout) and varaoute(8, ihout) are modified here !!! surfaceR = surfaceR - (pS % totDemand(day) * 86400. * frac_sr) ! [m3] subsurfaceR = subsurfaceR - (pS % totDemand(day) * 86400. * (1. - frac_sr)) ! [m3] end if ! ( available_vol >= pS % totDemand(day)) !------------------------------------------------------- !------------------------------------------------------- ! ***** ! If there is NOT enough water to satisfy total demand of all users in subbasin ! ***** !------------------------------------------------------- if (available_vol < pS % totDemand(day) * 86400. ) then ! in [m3] ! The amount of available water might be shared by several competing water users. ! In this version, all water users are treated according to their demand, meaning that ! water user with highest demand gets highest share. ! Another option to distribute the available volume is for instance: ! - by water user priorities (highest gets all, second and third only what remains from higher priority users) frac_sr = max(0.0_dp, surfaceR) / (max(0.0_dp, surfaceR) + max(0.0_dp, subsurfaceR)) do i = 1, pS % nWU ! loop over water user(s) in actual subbasin pWU => TWU(pS % pos(i)) ! pointer to current water user if (pWU%wu_opt <= 2 .AND. management_is_active_period(iyr, ida, pWU) ) then ! if water user is of type 'output' if (pWU % subs == pS % subnr) then ! if the current subbasin is a water source !----------------------------------------------------------------- ! TSub (current subbasin) !----------------------------------------------------------------- pS % withdrawal(day) = real( & pS % withdrawal(day) + & pWU % data(day) / pS % totDemand(day) * & available_vol / 86400.) ! * pWU % tr_eff ! [m3 / s] ! calculate losses during transfer pS % tr_losses_out(day) = real( & pS % tr_losses_out(day) + & pWU % data(day) / pS % totDemand(day) * & available_vol / 86400. * (1. - pWU % tr_eff)) ! [m3 / s] ! add withdrawal as %inflow and %tr_losses_in to destination subbasin if (pWU % wu_opt == 1) then pSd => management_subbasin_pointer(pWU % subd) pSd % inflow(day) = real( & pSd % inflow(day) + & pWU % data(day) / pS % totDemand(day) * & available_vol / 86400. * pWU % tr_eff) pSd % tr_losses_in(day) = real( & pSd % tr_losses_in(day) + & pWU % data(day) / pS % totDemand(day) * & available_vol / 86400. * (1. - pWU % tr_eff)) end if !----------------------------------------------------------------- ! TWU (current water user) !----------------------------------------------------------------- ! add actual withdrawals of all water users from source subbasin pWU % supplied(day) = real( & pWU % data(day) / pS % totDemand(day) * & available_vol / 86400. * pWU % tr_eff) ! [m3 / s] ! calculate losses during transfer pWU % tr_losses(day) = real( & pWU % data(day) / pS % totDemand(day) * & available_vol / 86400. * (1. - pWU % tr_eff)) ! [m3 / s] !----------------------------------------------------------------- end if end if ! ( pWU % wu_opt <= 2 ) !----------------------------------------------------------------- ! Irrigation !----------------------------------------------------------------- ! account for irrigation water users if (day > 1) then if (pWU % wu_opt == 4 .AND. pWU % subs > 0 .AND. management_is_active_period(iyr, ida, pWU) ) then ! add actual withdrawals from irrigation WU ! pS%irrDemand is corrected by irrigation practices and efficiencies ! demand/supply from input time series if (pWU % irr_opt == 1) & pS % withdrawal(day) = real( & pS % withdrawal(day) + & pWU % data(day - 1) / pS % totDemand(day) * & available_vol / 86400.) ! demand/supply from plant demand if (pWU % irr_opt == 2) & pS % withdrawal(day) = real(pS % withdrawal(day) + pWU % irrigationDemand(day - 1) / pS % totDemand(day) & * available_vol / 86400.) ! add actual losses of irrigation water user pS % tr_losses_out(day) = real(pS % tr_losses_out(day) + pWU % irrigationDemand(day - 1) / pS % totDemand(day) & * available_vol / 86400. * (1. - pWU % tr_eff)) ! knowing that demand can be delivered ! calculate volume delivered to water user pWU % supplied(day) = real(pWU % irrigationDemand(day - 1) / pS % totDemand(day) * available_vol / 86400. * pWU % tr_eff) ! [m3 / s] wam_supplied_summary(day) = wam_supplied_summary(day) + pWU % supplied(day) pWU % tr_losses(day) = pWU % supplied(day) * (1. - pWU % tr_eff) ! pS % irrDemand(day) / pS % totDemand(day) * available_vol / 86400. * (1. - pWU % tr_eff) ! [m3 / s] if (pWU % subs /= pWU % subd) then pSd => management_subbasin_pointer(pWU % subd) !!!! pWU%supplied should not be added to %inflow, because the irrigation supply is added in hydrotope !!!! %inflow is added to sda or varoute in "subbasin" and/or "add" !pSd%inflow(day) = pSd%inflow(day) + pWU%supplied(day) ! pWU%irrigationDemand(day-1)/pS%totDemand(day) * available_vol/86400. * pWU%tr_eff ! [m3/s] pSd % tr_losses_in(day) = pSd % tr_losses_in(day) + pWU % tr_losses(day) ! pWU % irrigationDemand(day - 1) / pS % totDemand(day) * available_vol / 86400. * (1. - pWU % tr_eff) end if end if end if !----------------------------------------------------------------- end do ! i = 1, pS % nWU ! withdraw total demand from surface and subsurface runoff !!! NOTE: the values of varoute(2, ihout) and varaoute(8, ihout) are modified here !!! surfaceR = surfaceR - (available_vol * frac_sr) ! [m3] subsurfaceR = subsurfaceR - (available_vol * (1. - frac_sr)) ! [m3] end if ! ( available_vol < pS % totDemand(day) * 86400. ) !------------------------------------------------------- else ! The available volume at subbasin outlet minus minimal flows is negative. ! Hence, there is nothing to do here because all variables affected, such as ! pWU%delivered, pS%tr_losses, pS%supply were initialised with 0. for every day. end if ! if (available_vol > 0. .AND. pS % totDemand(day) > 0. ) else ! no output water user in this subbasin end if end subroutine management_transfer_out !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ subroutine management_distribribute(ps, withdrawal_act, daycounter, ida, iyr) integer, intent(in) :: daycounter integer, intent(in) :: ida integer, intent(in) :: iyr ! called from RESERVOIR module ! pointer on actual subbasin TYPE (TSubbasin), POINTER :: pS ! [m3] amount of water withdrawn from reservoir real(dp), intent(in) :: withdrawal_act ! pointer on destination subbasin (TSub) TYPE (TSubbasin), POINTER :: pSd ! pointer on actual wtaer user (TWU) TYPE (TWaterUser), POINTER :: pWU integer :: i, day day = daycounter !------------------------------------------------------- ! If there is enough water to satisfy total demand of all users in subbasin !------------------------------------------------------- if (withdrawal_act >= pS % totDemand(day) * 86400.) then ! allocate water to corresponding water user(s) do i = 1, pS % nWU ! loop over water user(s) in actual subbasin pWU => management_user_pointer(pS % pos(i)) ! pointer on current water user ! transfer to another subbasin .OR. to external destination .OR. to irrigation user if (pWU % wu_opt <= 2 .AND. management_is_active_period(iyr, ida, pWU) ) then if (pWU % subs == pS % subnr) then ! if the current subbasin is a water source !----------------------------------------------------------------- ! TSub (current subbasin) !----------------------------------------------------------------- ! add actual withdrawals of all water users from source subbasin pS % withdrawal(day) = pS % withdrawal(day) + pWU % data(day) ! deliver what is demanded ! add actual losses of all water users from source subbasin pS % tr_losses_out(day) = pS % tr_losses_out(day) + pWU % data(day) * (1. - pWU % tr_eff) ! knowing that demand can be delivered ! add withdrawal day as %inflow and %tr_losses_in to destination subbasin if (pWU % wu_opt == 1) then pSd => management_subbasin_pointer(pWU % subd) pSd % inflow(day) = pSd % inflow(day) + pWU % data(day) * pWU % tr_eff pSd % tr_losses_in(day) = pSd % tr_losses_in(day) + pWU % data(day) * (1. - pWU % tr_eff) end if !----------------------------------------------------------------- !----------------------------------------------------------------- ! TWU (current water user) !----------------------------------------------------------------- ! calculate volume delivered to water user pWU % supplied(day) = pWU % data(day) * pWU % tr_eff ! [m3 / s] ! calculate losses during transfer pWU % tr_losses(day) = pWU % data(day) * (1. - pWU % tr_eff) ! [m3 / s] !----------------------------------------------------------------- end if end if ! ( pWU % wu_opt <= 2 ) !----------------------------------------------------------------- ! Irrigation !----------------------------------------------------------------- ! account for irrigation water users if (day > 1) then if (pWU % wu_opt == 4 .AND. management_is_active_period(iyr, ida, pWU) ) then ! calculate volume delivered to water user ! add actual withdrawals from irrigation WU ! pS%irrDemand is corrected by irrigation practices and efficiencies pS % withdrawal(day) = pS % withdrawal(day) + pWU % irrigationDemand(day - 1) ! deliver what is demanded ! add actual losses of irrigation water user pS % tr_losses_out(day) = pS % tr_losses_out(day) + pWU % irrigationDemand(day - 1) * (1. - pWU % tr_eff) ! knowing that demand can be delivered pWU % supplied(day) = pWU % irrigationDemand(day - 1) * pWU % tr_eff ! [m3 / s] wam_supplied_summary(day) = wam_supplied_summary(day) + pWU % supplied(day) pWU % tr_losses(day) = pWU % irrigationDemand(day - 1) * (1. - pWU % tr_eff) ! [m3 / s] if (pWU % subs /= pWU % subd) then pSd => management_subbasin_pointer(pWU % subd) !!!! pWU%supplied should not be added to %inflow, because the irrigation supply is added in hydrotope !!!! %inflow is added to sda or varoute in "subbasin" and/or "add" !pSd%inflow(day) = pSd%inflow(day) + pWU%supplied(day) ! [m3/s] pSd % tr_losses_in(day) = pSd % tr_losses_in(day) + pWU % tr_losses(day) end if end if end if !----------------------------------------------------------------- end do ! i = 1, pS % nWU end if !------------------------------------------------------- ! ***** ! If there is NOT enough water to satisfy total demand of all users in subbasin ! ***** !------------------------------------------------------- if (withdrawal_act < pS % totDemand(day) * 86400. ) then ! in [m3] ! The amount of available water might be shared by several competing water users. ! In this version, all water users are treated according to their demand, meaning that ! water user with highest demand gets highest share. ! Another option to distribute the available volume is for instance: ! - by water user priorities (highest gets all, second and third only what remains from higher priority users) do i = 1, pS % nWU ! loop over water user(s) in actual subbasin pWU => management_user_pointer(pS % pos(i)) ! pointer on current water user if (pWU%wu_opt <= 2 .AND. management_is_active_period(iyr, ida, pWU) ) then ! if water user is of type 'output' if (pWU % subs == pS % subnr) then ! if the current subbasin is a water source !----------------------------------------------------------------- ! TSub (current subbasin) !----------------------------------------------------------------- pS % withdrawal(day) = real( & pS % withdrawal(day) + & pWU % data(day) / pS % totDemand(day) * & withdrawal_act / 86400.) ! * pWU % tr_eff ! [m3 / s] ! calculate losses during transfer pS % tr_losses_out(day) = real( & pS % tr_losses_out(day) + & pWU % data(day) / pS % totDemand(day) * & withdrawal_act / 86400. * (1. - pWU % tr_eff)) ! [m3 / s] ! add withdrawal as %inflow and %tr_losses_in to destination subbasin if (pWU % wu_opt == 1) then pSd => management_subbasin_pointer(pWU % subd) pSd % inflow(day) = real( & pSd % inflow(day) + & pWU % data(day) / pS % totDemand(day) * & withdrawal_act / 86400. * pWU % tr_eff) pSd % tr_losses_in(day) = real( & pSd % tr_losses_in(day) + & pWU % data(day) / pS % totDemand(day) * & withdrawal_act / 86400. * (1. - pWU % tr_eff)) end if !----------------------------------------------------------------- ! TWU (current water user) !----------------------------------------------------------------- ! add actual withdrawals of all water users from source subbasin pWU % supplied(day) = real( & pWU % data(day) / pS % totDemand(day) * & withdrawal_act / 86400. * pWU % tr_eff) ! [m3 / s] ! calculate losses during transfer pWU % tr_losses(day) = real( & pWU % data(day) / pS % totDemand(day) * & withdrawal_act / 86400. * (1. - pWU % tr_eff)) ! [m3 / s] !----------------------------------------------------------------- end if end if ! ( pWU % wu_opt <= 2 ) !----------------------------------------------------------------- ! Irrigation !----------------------------------------------------------------- ! account for irrigation water users if (day > 1) then if (pWU % wu_opt == 4 .AND. management_is_active_period(iyr, ida, pWU) ) then ! add actual withdrawals from irrigation WU ! pS%irrDemand is corrected by irrigation practices and efficiencies pS % withdrawal(day) = real( & pS % withdrawal(day) + & pWU % irrigationDemand(day - 1) / pS % totDemand(day) * & withdrawal_act / 86400.) ! add actual losses of irrigation water user, knowing that demand can be delivered pS % tr_losses_out(day) = real( & pS % tr_losses_out(day) + & pWU % irrigationDemand(day - 1) / & pS % totDemand(day) * withdrawal_act / 86400. * (1. - pWU % tr_eff)) ! calculate volume delivered to water user pWU % supplied(day) = real( & pWU % irrigationDemand(day - 1) / pS % totDemand(day) * & withdrawal_act / 86400. * pWU % tr_eff) ! [m3 / s] wam_supplied_summary(day) = wam_supplied_summary(day) + pWU % supplied(day) pWU % tr_losses(day) = real( & pWU % irrigationDemand(day - 1) / pS % totDemand(day) * & withdrawal_act / 86400. * (1. - pWU % tr_eff)) ! [m3 / s] if (pWU % subs /= pWU % subd) then pSd => management_subbasin_pointer(pWU % subd) !!!! pWU%supplied should not be added to %inflow, because the irrigation supply is added in hydrotope !!!! %inflow is added to sda or varoute in "subbasin" and/or "add" !pSd%inflow(day) = pSd%inflow(day) + pWU%supplied(day) ! pWU%irrigationDemand(day)/pS%totDemand(day) * withdrawal_act/86400. * pWU%tr_eff ! [m3/s] pSd % tr_losses_in(day) = pSd % tr_losses_in(day) + pWU % tr_losses(day) ! pWU % irrigationDemand(day) / pS % totDemand(day) * withdrawal_act / 86400. * (1. - pWU % tr_eff) end if end if end if !----------------------------------------------------------------- end do ! i = 1, pS % nWU end if ! ( withdrawal_act < pS % totDemand(day) * 86400. ) end subroutine management_distribribute !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ real(dp) function wam_correct_irrigationdemand(pwu, plantdemand) TYPE (TWaterUser), POINTER :: pWU real(dp), intent(in) :: plantDemand real(dp) :: irr_fac = 0. ! To satisfy the required plant demand, the actual demand will be higher due to irrigation losses. ! This depends on irrigation practices. These losses are incorporated here. if (pWU % irr_practice == 1) irr_fac = 1. / wam_eff_sprinkler ! sprinkler irrigation if (pWU % irr_practice == 2) irr_fac = 1. / wam_eff_drip ! drip irrigation wam_correct_irrigationDemand = plantDemand * irr_fac * pWU % irr_deficit_fac * (1. / pWU % tr_eff) ! m3 / s end function wam_correct_irrigationDemand !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ function management_subbasin_pointer(sub) result(ps) ! real(dp), dimension(30), intent(in) :: sub ! returns a pointer on the current subbasin integer, intent(in) :: sub TYPE (TSubbasin), POINTER :: pS if (wamTSub(sub) % subnum > 0 ) then pS => wamTSub(sub) % pSub else NULLIFY(pS) end if end function management_subbasin_pointer !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ function management_user_pointer(id) result(pwu) ! returns a pointer on the current water user in subbasin ! id of water user in water user array (ps % pos(i)) integer, intent(in) :: id TYPE (TWaterUser), POINTER :: pWU if (id <= wam_nWU) then pWU => TWU(id) else NULLIFY(pWU) call log_error("wam", "Water User ID not valid. management_user_pointer(), ID:", int=id) end if end function management_user_pointer !------------------------------------------------------------------------------ logical function management_is_transfer_subbasin(sub) ! returns .true. if water transfer actions take place in this subbasin integer, intent(in) :: sub management_is_transfer_subbasin = .false. if (sub > 0) then if (wamTSub(sub) % subnum > 0 ) management_is_transfer_subbasin = .true. end if end function management_is_transfer_subbasin !------------------------------------------------------------------------------ logical function management_is_active_period(year, day, pwu) ! returns .true. if period defined by first and last year AND day_irr_start and day_irr_end is true integer, intent(in) :: year, day TYPE (TWaterUser), POINTER :: pWU management_is_active_period = .false. if (year >= pWU % fyr .AND. year <= pWU % lyr) then if (pWU % day_irr_start < pWU % day_irr_end) then if (day >= pWU % day_irr_start .AND. day <= pWU % day_irr_end) management_is_active_period = .true. else if (day >= pWU % day_irr_end .AND. day <= pWU % day_irr_start) management_is_active_period = .true. end if end if !(year) end function management_is_active_period !------------------------------------------------------------------------------ character(len=path_max_length) function gen_filename(i, ch, ext, n) ! generate file names for output ! i=file number, n=number of characters in "ch" integer, intent(in) :: i, n ! file name (without extension) character(len = n), intent(in) :: ch ! file extension (e.g. ".out") character(len=*), intent(in) :: ext character(len = len_trim(ch)) :: fname_ ! conversion from interger to character character(len = 4) :: i_ch i_ch = "" fname_ = trim(ch) if (i < 10) then write(i_ch, fmt='(i1)') i gen_filename = fname_//"000"//trim(i_ch)//trim(ext) end if if (i >= 10 .AND. i < 100) then write(i_ch, fmt='(i2)') i gen_filename = fname_//"00"//trim(i_ch)//trim(ext) end if if (i >= 100 .AND. i < 1000) then write(i_ch, fmt='(i3)') i gen_filename = fname_//"0"//trim(i_ch)//trim(ext) end if if (i >= 1000) then write(i_ch, fmt='(i4)') i gen_filename = fname_ // trim(i_ch) // trim(ext) end if end function gen_filename !------------------------------------------------------------------------------ !------------------------------------------------------------------------------ subroutine management_write_user_output(mb, ndayssim) use output, only : output_open_file integer, intent(in) :: mb integer, intent(in) :: nDaysSim ! this subroutine is called by mainpro at the end of the simulation ! it writes one file for each water user and one file for each subbasin involved in transfers integer :: i, j, funit character(len=path_max_length) :: fname TYPE (TWaterUser), POINTER :: pWU TYPE (TSubbasin), POINTER :: pS !-------------------------------------------------------- ! write water user output file(s) !-------------------------------------------------------- do i = 1, wam_nWU fname = "wam_WU_"//trim(TWU(i)%name)//".csv" pWU => TWU(i) ! pointer on current water user funit = output_open_file(trim(fname)) ! if water user is a destination (subbasin or external destination) that receives water from a subbasin if (pWU % wu_opt <= 2) then ! a water user providing water to another subbasin or external destination write(funit, fmt='(A43)')"Year, Day, Demand_m3s, Supplied_m3s, Losses_m3s" do j = 1, nDaysSim write(funit, fmt='(i4, ", ", i3, 3(", ", f10.2))') wam_y(j), wam_d(j), pWU%data(j), pWU%supplied(j), pWU%tr_losses(j) end do close(funit) end if ! if water user receives water from an external source if (pWU % wu_opt == 3) then ! a water user receiving water from an external source write(funit, fmt='(A32)')"Year, Day, Supplied_m3s, Losses_m3s" do j = 1, nDaysSim write(funit, fmt='(i4, ", ", i3, 2(", ", f10.2))') wam_y(j), wam_d(j), pWU%supplied(j), pWU%tr_losses(j) end do close(funit) end if ! if water user is irrigation if (pWU % wu_opt == 4) then ! a water user providing water to another subbasin or external destination ! if ( pWU%subs == 0 ) pS => wam_get_pointer_subbasin(pWU%subd) ! if ( pWU%subs > 0 ) pS => wam_get_pointer_subbasin(pWU%subs) write(funit, fmt='(A83)')"Year, Day, PlantDemand_mm, PlantDemand_m3s, totIrrDemand_m3s, Supplied_m3s, tr_Losses_m3s" do j = 1, nDaysSim write(funit, fmt='(i4, ", ", i3, 5(", ", f13.6))') wam_y(j), wam_d(j), (pWU%plantDemand(j)*86400./pWU%area*1000.), & pWU % plantDemand(j), pWU % irrigationDemand(j), pWU % supplied(j), pWU % tr_losses(j) end do close(funit) end if end do ! i = 1, wam_nWU !-------------------------------------------------------- !-------------------------------------------------------- ! write subbasin output file(s) !-------------------------------------------------------- do i = 1, mb if (wamTSub(i) % subnum > 0 ) then pS => wamTSub(i) % pSub !fname = "transSUB"// !fname = gen_filename(pS%subnr, "transSUB", ".out", len_trim("transSUB")) fname = gen_filename(pS%subnr, "wam_SUB", ".csv", len_trim("wam_SUB")) funit = output_open_file(trim(fname)) write(funit, fmt='(A99)') & "Year, Day, Q_act_m3s, Q_Min_m3s, extInflow_m3s, lossesIn_m3s, totDemand_m3s, withdrawal_m3s, losses_out_m3s" do j = 1, nDaysSim write(funit, fmt='(i4, ", ", i3, 7(", ", f12.2))') wam_y(j), wam_d(j), pS%Q_act(j), pS%Q_min(j), & pS % inflow(j), pS % tr_losses_in(j), pS % totDemand(j), pS % withdrawal(j), pS % tr_losses_out(j) end do close(funit) end if end do !-------------------------------------------------------- ! write irrigation summary output file !-------------------------------------------------------- funit = output_open_file("wam_irrigation_summary.csv") write(funit, fmt='(A58)')"Year, Day, plantDemand_m3s, irrigationDemand_m3s, supplied_m3s" do j = 1, nDaysSim write(funit, fmt='(i4, ", ", i3, 3(", ", f12.2))') & wam_y(j), wam_d(j), wam_plantDemand_summary(j), & wam_irrigationDemand_summary(j), wam_supplied_summary(j) end do close(funit) end subroutine management_write_user_output end module management