Author : stefan.liersch@pik-potsdam.de, lobanova@pik-potsdam.de Version : 0.7 Crated : 2014-10-16 Modified: 2018-06-27
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_"
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
!------------------------------------------------------------------------------- ! 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 <transfer>"// & "Set respective value to 0 in the <IRR> 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