mo_mpr_eval.f90

Go to the documentation of this file.

!> \file mo_mpr_eval.f90
!> \brief \copybrief mo_mpr_eval
!> \details \copydetails mo_mpr_eval
 
!> \brief Runs MPR
!> \details Runs MPR and writes to global effective parameters
!> \authors Robert Schweppe
!> \date Feb 2018
!> \copyright Copyright 2005-\today, the mHM Developers, Luis Samaniego, Sabine Attinger: All rights reserved.
!! mHM is released under the LGPLv3+ license \license_note
!> \ingroup f_mpr
MODULE mo_mpr_eval
 
  USE mo_kind, ONLY : i4, dp
 
  IMPLICIT NONE
 
  PRIVATE
 
  PUBLIC :: mpr_eval
 
  ! ------------------------------------------------------------------
 
CONTAINS
 
  ! ------------------------------------------------------------------
 
  !    NAME
  !        mpr_eval
 
  !    PURPOSE
  !>       \brief Runs MPR and writes to global effective parameters
 
  !>       \details Runs MPR and writes to global effective parameters
 
  !    INTENT(IN), OPTIONAL
  !>       \param[in] "real(dp), dimension(:), optional :: parameterset" a set of global parameter (gamma) to run mHM,
  !>       DIMENSION [no. of global_Parameters]
 
  !    HISTORY
  !>       \authors Juliane Mai, Rohini Kumar
 
  !>       \date Feb 2013
 
  ! Modifications:
  ! R. Kumar             Jun 2013 - restart_flag_states_read is passed to mhm call for the soil moisture initalisation
  ! R. Kumar             Jun 2013 - frac_sealed_city_area is added
  ! R. Kumar & S. Thober Aug 2013 - code change to incorporate output timestep during writing of the netcdf file
  ! R. Kumar             Aug 2013 - added iFlag_LAI_data_format to handle LAI options, and changed within the code made accordingly
  ! R. Kumar, J. Mai     Sep 2013 - Splitting allocation and initialization of arrays
  ! R. Kumar             Nov 2013 - update intent variables in documentation
  ! L. Samaniego         Nov 2013 - relational statements == to .eq., etc.
  ! M. Zink              Feb 2014 - added PET calculation: Hargreaves-Samani (Process 5)
  ! M. Zink              Mar 2014 - added inflow from upstream areas
  ! Stephan Thober       Jun 2014 - added chunk read for meteorological input
  ! Stephan Thober       Jun 2014 - updated flag for read_restart
  ! M. Cuntz & J. Mai    Nov 2014 - LAI input from daily, monthly or yearly files
  ! Matthias Zink        Dec 2014 - adopted inflow gauges to ignore headwater cells
  ! Stephan Thober       Aug 2015 - moved writing of daily discharge to mo_write_routing, included routing related variables from mRM
  ! David Schaefer       Aug 2015 - changed to new netcdf-writing scheme
  ! Stephan Thober       Sep 2015 - updated mrm_routing call
  ! O. Rakovec, R. Kumar Oct 2015 - added optional output for domain averaged TWS
  ! Rohini Kumar         Mar 2016 - changes for handling multiple soil database options
  ! Stephan Thober       Nov 2016 - added two options for routing
  ! Rohini Kuamr         Dec  2016 - option to handle monthly mean gridded fields of LAI
  ! Stephan Thober       Jan 2017 - added prescribed weights for tavg and pet
  ! Zink M. Demirel C.   Mar 2017 - Added Jarvis soil water stress function at SM process(3)
  ! Robert Schweppe      Dec 2017 - extracted call to mpr from inside mhm
 
  SUBROUTINE mpr_eval(parameterset, opti_domain_indices)
 
    use mo_common_variables, only : l0_lcover, l0_l1_remap, level0, level1, domainmeta
    use mo_message, only : message
    use mo_mpr_global_variables, only : l0_asp, l0_geounit, l0_gridded_lai, &
                                        l0_slope_emp, l0_soilid, l1_harsamcoeff, l1_prietayalpha, l1_aeroresist, &
                                        l1_alpha, l1_degdayinc, l1_degdaymax, l1_degdaynopre, l1_fasp, l1_froots, &
                                        l1_fsealed, l1_jarvis_thresh_c1, l1_kbaseflow, l1_kperco, l1_kslowflow, &
                                        l1_karstloss, l1_kfastflow, l1_maxinter, l1_petlaicorfactor, l1_sealedthresh, &
                                        l1_soilmoistexp, l1_soilmoistfc, l1_soilmoistsat, l1_surfresist, l1_tempthresh, &
                                        l1_unsatthresh, l1_wiltingpoint, &
                                        ! neutron count
                                        l1_no_count, l1_bulkdens, l1_latticewater, l1_cosmicl3
 
    use mo_multi_param_reg, only : mpr
    use mo_string_utils, only : num2str
    use mo_timer, only : timer_clear, timer_get, timer_start, timer_stop
 
    implicit none
 
    ! a set of global parameter (gamma) to run mHM, DIMENSION [no. of global_Parameters]
    real(dp), dimension(:), intent(in), optional :: parameterset
 
    integer(i4), dimension(:), optional, intent(in) :: opti_domain_indices
 
    ! Counters
    integer(i4) :: idomain, ii, ndomains, itimer
 
    ! start and end index at level 0 for current domain
    integer(i4) :: s0, e0
 
    ! start and end index at level 1 for current domain
    integer(i4) :: s1, e1
 
 
    !-------------------------------------------------------------------
    ! NOW call MPR
    !-------------------------------------------------------------------
    call message('  Executing MPR ...')
    itimer = 10
    call timer_start(itimer)
 
    !----------------------------------------
    ! loop over domains
    !----------------------------------------
    if (present(opti_domain_indices)) then
      ndomains = size(opti_domain_indices)
    else
      ndomains = domainmeta%nDomains
    end if
    do ii = 1, ndomains
      if (present(opti_domain_indices)) then
        idomain = opti_domain_indices(ii)
      else
        idomain = ii
      end if
 
      ! get domain information
      s0 = level0(domainmeta%L0DataFrom(idomain))%iStart
      e0 = level0(domainmeta%L0DataFrom(idomain))%iEnd
      s1 = level1(idomain)%iStart
      e1 = level1(idomain)%iEnd
 
      call mpr(level0(domainmeta%L0DataFrom(idomain))%mask, l0_geounit(s0 : e0), &
              l0_soilid(s0 : e0, :), l0_asp(s0 : e0), l0_gridded_lai(s0 : e0, :), &
              l0_lcover(s0 : e0, :), l0_slope_emp(s0 : e0), &
              pack(level0(domainmeta%L0DataFrom(idomain))%y, level0(domainmeta%L0DataFrom(idomain))%mask), &
              level0(domainmeta%L0DataFrom(idomain))%Id, &
              l0_l1_remap(idomain)%upper_bound, l0_l1_remap(idomain)%lower_bound, &
              l0_l1_remap(idomain)%left_bound, l0_l1_remap(idomain)%right_bound, &
              l0_l1_remap(idomain)%n_subcells, &
              l1_fsealed(s1 : e1, :, :), &
              l1_alpha(s1 : e1, :, :), l1_degdayinc(s1 : e1, :, :), l1_degdaymax(s1 : e1, :, :), &
              l1_degdaynopre(s1 : e1, :, :), l1_fasp(s1 : e1, :, :), l1_harsamcoeff(s1 : e1, :, :), &
              l1_prietayalpha(s1 : e1, :, :), l1_aeroresist(s1 : e1, :, :), l1_surfresist(s1 : e1, :, :), &
              l1_froots(s1 : e1, :, :), l1_kfastflow(s1 : e1, :, :), &
              l1_kslowflow(s1 : e1, :, :), l1_kbaseflow(s1 : e1, :, :), l1_kperco(s1 : e1, :, :), &
              l1_karstloss(s1 : e1, :, :), l1_soilmoistfc(s1 : e1, :, :), l1_soilmoistsat(s1 : e1, :, :), &
              l1_soilmoistexp(s1 : e1, :, :), l1_jarvis_thresh_c1(s1 : e1, :, :), &
              l1_tempthresh(s1 : e1, :, :), l1_unsatthresh(s1 : e1, :, :), l1_sealedthresh(s1 : e1, :, :), &
              l1_wiltingpoint(s1 : e1, :, :), l1_maxinter(s1 : e1, :, :), l1_petlaicorfactor(s1 : e1, :, :), &
              l1_no_count(s1:e1,:,:), l1_bulkdens(s1:e1,:,:), l1_latticewater(s1:e1,:,:), l1_cosmicl3(s1:e1,:,:), &
              parameterset )
 
    end do
    call timer_stop(itimer)
    call message('  in ', trim(num2str(timer_get(itimer), '(F9.3)')), ' seconds.')
    call timer_clear(itimer)
 
  END SUBROUTINE mpr_eval
 
END MODULE mo_mpr_eval