management_read_ctrl Subroutine

  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