LCOV - code coverage report
Current view: top level - mRM - mo_mrm_read_config.f90 (source / functions) Hit Total Coverage
Test: mHM coverage Lines: 181 206 87.9 %
Date: 2024-04-30 08:53:32 Functions: 2 2 100.0 %

          Line data    Source code
       1             : !> \file mo_mrm_read_config.f90
       2             : !> \brief \copybrief mo_mrm_read_config
       3             : !> \details \copydetails mo_mrm_read_config
       4             : 
       5             : !> \brief read mRM config
       6             : !> \details This module contains all mRM subroutines related to reading the mRM configuration either from file or copy from mHM.
       7             : !> \authors Stephan Thober
       8             : !> \date Aug 2015
       9             : !> \copyright Copyright 2005-\today, the mHM Developers, Luis Samaniego, Sabine Attinger: All rights reserved.
      10             : !! mHM is released under the LGPLv3+ license \license_note
      11             : !> \ingroup f_mrm
      12             : module mo_mrm_read_config
      13             : 
      14             :   use mo_kind, only : i4, dp
      15             :   use mo_message, only: message, error_message
      16             : 
      17             :   implicit none
      18             : 
      19             :   public :: mrm_read_config
      20             : 
      21             : contains
      22             : 
      23             :   ! ------------------------------------------------------------------
      24             : 
      25             :   !    NAME
      26             :   !        mrm_read_config
      27             : 
      28             :   !    PURPOSE
      29             :   !>       \brief Read the general config of mRM
      30             : 
      31             :   !>       \details Depending on the variable mrm_coupling_config, the
      32             :   !>       mRM config is either read from mrm.nml and parameters from
      33             :   !>       mrm_parameter.nml or copied from mHM.
      34             : 
      35             :   !    INTENT(IN)
      36             :   !>       \param[in] "character(*) :: file_namelist, file_namelist_param"
      37             :   !>       \param[in] "integer :: unamelist, unamelist_param"
      38             :   !>       \param[in] "character(*) :: file_namelist, file_namelist_param"
      39             :   !>       \param[in] "integer :: unamelist, unamelist_param"
      40             :   !>       \param[in] "logical :: do_message"                              - flag for writing mHM standard messages
      41             : 
      42             :   !    HISTORY
      43             :   !>       \authors Stephan Thober
      44             : 
      45             :   !>       \date Aug 2015
      46             : 
      47             :   ! Modifications:
      48             :   ! Stephan Thober  Sep 2015 - removed stop condition when routing resolution is smaller than hydrologic resolution
      49             :   ! Stephan Thober  Oct 2015 - added NLoutputResults namelist, fileLatLon to directories_general namelist, and readLatLon flag
      50             :   ! Robert Schweppe Jun 2018 - refactoring and reformatting
      51             : 
      52          14 :   subroutine mrm_read_config(file_namelist, unamelist, file_namelist_param, unamelist_param, do_message)
      53             : 
      54             :     use mo_common_constants, only : maxNoDomains, nodata_i4
      55             :     use mo_common_mHM_mRM_read_config, only : common_check_resolution
      56             :     use mo_common_variables, only : ALMA_convention, domainMeta, processMatrix
      57             :     use mo_mrm_constants, only : maxNoGauges
      58             :     use mo_mrm_file, only : file_defOutput, udefOutput
      59             :     use mo_mrm_global_variables, only : InflowGauge, domainInfo_mRM, domain_mrm, &
      60             :                                         dirGauges, dirTotalRunoff, filenameTotalRunoff, dirBankfullRunoff, gauge, is_start, &
      61             :                                         nGaugesTotal, nGaugesLocal, nInflowGaugesTotal, outputFlxState_mrm, &
      62             :                                         timeStep_model_outputs_mrm, &
      63             :                                         varnameTotalRunoff, gw_coupling, &
      64             :                                         output_deflate_level_mrm, output_double_precision_mrm, output_time_reference_mrm, &
      65             :                                         readLatLon
      66             :     use mo_nml, only : close_nml, open_nml, position_nml
      67             :     use mo_string_utils, only : num2str
      68             : 
      69             :     implicit none
      70             : 
      71             :     character(*), intent(in) :: file_namelist, file_namelist_param
      72             : 
      73             :     integer, intent(in) :: unamelist, unamelist_param
      74             : 
      75             :     ! - flag for writing mHM standard messages
      76             :     logical, intent(in) :: do_message
      77             : 
      78             :     integer(i4), dimension(maxNoDomains) :: NoGauges_domain
      79             : 
      80             :     integer(i4), dimension(maxNoDomains, maxNoGauges) :: Gauge_id
      81             : 
      82             :     character(256), dimension(maxNoDomains, maxNoGauges) :: Gauge_filename
      83             : 
      84             :     integer(i4), dimension(maxNoDomains) :: NoInflowGauges_domain
      85             : 
      86             :     integer(i4), dimension(maxNoDomains, maxNoGauges) :: InflowGauge_id
      87             : 
      88             :     character(256), dimension(maxNoDomains, maxNoGauges) :: InflowGauge_filename
      89             : 
      90             :     logical, dimension(maxNoDomains, maxNoGauges) :: InflowGauge_Headwater
      91             : 
      92             :     integer(i4) :: domainID, iDomain
      93             : 
      94             :     integer(i4) :: iGauge
      95             : 
      96             :     integer(i4) :: idx
      97             : 
      98             :     character(256), dimension(maxNoDomains) :: dir_Gauges
      99             : 
     100             :     character(256), dimension(maxNoDomains) :: dir_Total_Runoff
     101             : 
     102             :     character(256), dimension(maxNoDomains) :: dir_Bankfull_Runoff
     103             : 
     104             :     logical :: file_exists
     105             : 
     106             :     type(domainInfo_mRM), pointer :: domain_mrm_iDomain
     107             : 
     108             : 
     109             :     ! namelist spatial & temporal resolution, optmization information
     110             :     namelist /mainconfig_mrm/ ALMA_convention, &
     111             :       filenameTotalRunoff, varnameTotalRunoff, gw_coupling
     112             :     ! namelist directories
     113             :     namelist /directories_mRM/ dir_Gauges, dir_Total_Runoff, dir_Bankfull_Runoff
     114             :     namelist /evaluation_gauges/ nGaugesTotal, NoGauges_domain, Gauge_id, gauge_filename
     115             :     ! namelist for inflow gauges
     116             :     namelist /inflow_gauges/ nInflowGaugesTotal, NoInflowGauges_domain, InflowGauge_id, &
     117             :             InflowGauge_filename, InflowGauge_Headwater
     118             :     ! name list regarding output
     119             :     namelist /NLoutputResults/ &
     120             :             output_deflate_level_mrm, &
     121             :             output_double_precision_mrm, &
     122             :             output_time_reference_mrm, &
     123             :             timeStep_model_outputs_mrm, &
     124             :             outputFlxState_mrm
     125             : 
     126             :     !===============================================================
     127             :     ! INITIALIZATION
     128             :     !===============================================================
     129          14 :     is_start = .True.
     130          14 :     nGaugesTotal = nodata_i4
     131         714 :     NoGauges_domain = nodata_i4
     132      142814 :     Gauge_id = nodata_i4
     133      142814 :     gauge_filename = num2str(nodata_i4)
     134             : 
     135             :     ! default arguments
     136          14 :     ALMA_convention = .false.
     137          14 :     filenameTotalRunoff = 'total_runoff'
     138          14 :     varnameTotalRunoff = 'total_runoff'
     139          14 :     gw_coupling = .false.
     140             : 
     141             :     !===============================================================
     142             :     !  Read namelist main directories
     143             :     !===============================================================
     144          14 :     call open_nml(file_namelist, unamelist, quiet = .true.)
     145             : 
     146             :     !===============================================================
     147             :     !  Read namelist for mainconfig for mRM
     148             :     !===============================================================
     149          14 :     call position_nml('mainconfig_mrm', unamelist)
     150          14 :     read(unamelist, nml = mainconfig_mrm)
     151             : 
     152             :     !===============================================================
     153             :     !  Read namelist for mainpaths
     154             :     !===============================================================
     155          14 :     call position_nml('directories_mRM', unamelist)
     156          14 :     read(unamelist, nml = directories_mRM)
     157             : 
     158          70 :     allocate(dirGauges(domainMeta%nDomains), dirTotalRunoff(domainMeta%nDomains), dirBankfullRunoff(domainMeta%nDomains))
     159          40 :     do iDomain = 1, domainMeta%nDomains
     160          26 :       domainID = domainMeta%indices(iDomain)
     161          26 :       dirGauges(iDomain)         = dir_Gauges(domainID)
     162          26 :       dirTotalRunoff(iDomain)    = dir_Total_Runoff(domainID)
     163          40 :       dirBankfullRunoff(iDomain) = dir_Bankfull_Runoff(domainID)
     164             :     end do
     165             : 
     166             :     !===============================================================
     167             :     ! READ EVALUATION GAUGES
     168             :     !===============================================================
     169          14 :     call position_nml('evaluation_gauges', unamelist)
     170          14 :     read(unamelist, nml = evaluation_gauges)
     171             : 
     172          14 :     if (nGaugesTotal .GT. maxNoGauges) then
     173             :       call error_message('***ERROR: ', trim(file_namelist), ': Total number of evaluation gauges is restricted to', &
     174           0 :               num2str(maxNoGauges), raise=.false.)
     175           0 :       call error_message('          Error occured in namlist: evaluation_gauges')
     176             :     end if
     177             : 
     178             :     ! ToDo: check
     179          14 :     nGaugesLocal = 0
     180          40 :     do iDomain = 1, domainMeta%nDomains
     181          26 :       domainID = domainMeta%indices(iDomain)
     182          40 :       nGaugesLocal = nGaugesLocal + NoGauges_domain(domainID)
     183             :     end do
     184             :     ! End ToDo
     185             : 
     186          65 :     allocate(gauge%gaugeId(nGaugesLocal)) ; gauge%gaugeId = nodata_i4
     187          65 :     allocate(gauge%domainId(nGaugesLocal)) ; gauge%domainId = nodata_i4
     188          42 :     allocate(gauge%fName  (nGaugesLocal))
     189          14 :     if (nGaugesLocal > 0) then
     190          14 :       gauge%fName(1) = num2str(nodata_i4)
     191             :     end if
     192          68 :     allocate(domain_mrm(domainMeta%nDomains))
     193             : 
     194          14 :     idx = 0
     195          40 :     do iDomain = 1, domainMeta%nDomains
     196          26 :       domainID = domainMeta%indices(iDomain)
     197          26 :       domain_mrm_iDomain => domain_mrm(iDomain)
     198             :       ! initialize
     199          26 :       domain_mrm_iDomain%nGauges = nodata_i4
     200        1378 :       allocate(domain_mrm_iDomain%gaugeIdList(maxval(NoGauges_domain(:))))
     201          55 :       domain_mrm_iDomain%gaugeIdList = nodata_i4
     202        1378 :       allocate(domain_mrm_iDomain%gaugeIndexList(maxval(NoGauges_domain(:))))
     203          55 :       domain_mrm_iDomain%gaugeIndexList = nodata_i4
     204        1378 :       allocate(domain_mrm_iDomain%gaugeNodeList(maxval(NoGauges_domain(:))))
     205          55 :       domain_mrm_iDomain%gaugeNodeList = nodata_i4
     206             :       ! check if NoGauges_domain has a valid value
     207          26 :       if (NoGauges_domain(domainID) .EQ. nodata_i4) then
     208             :         call error_message('***ERROR: ', trim(file_namelist), ': Number of evaluation gauges for subdomain ', &
     209           0 :                 trim(adjustl(num2str(domainID))), ' is not defined!', raise=.false.)
     210           0 :         call error_message('          Error occured in namelist: evaluation_gauges')
     211             :       end if
     212             : 
     213          26 :       domain_mrm_iDomain%nGauges = NoGauges_domain(domainID)
     214             : 
     215          63 :       do iGauge = 1, NoGauges_domain(domainID)
     216             :         ! check if NoGauges_domain has a valid value
     217          23 :         if (Gauge_id(domainID, iGauge) .EQ. nodata_i4) then
     218             :           call error_message('***ERROR: ', trim(file_namelist), ': ID ', &
     219           0 :                   trim(adjustl(num2str(Gauge_id(domainID, iGauge)))), ' of evaluation gauge ', &
     220             :                   trim(adjustl(num2str(iGauge))), ' for subdomain ', &
     221           0 :                   trim(adjustl(num2str(iDomain))), ' is not defined!', raise=.false.)
     222           0 :           call error_message('          Error occured in namelist: evaluation_gauges')
     223          46 :         else if (trim(gauge_filename(domainID, iGauge)) .EQ. trim(num2str(nodata_i4))) then
     224             :           call error_message('***ERROR: ', trim(file_namelist), ': Filename of evaluation gauge ', &
     225             :                   trim(adjustl(num2str(iGauge))), ' for subdomain ', &
     226           0 :                   trim(adjustl(num2str(iDomain))), ' is not defined!', raise=.false.)
     227          23 :           call error_message('          Error occured in namelist: evaluation_gauges')
     228             :         end if
     229             :         !
     230          23 :         idx = idx + 1
     231          23 :         gauge%domainId(idx) = iDomain
     232          23 :         gauge%gaugeId(idx) = Gauge_id(domainID, iGauge)
     233          23 :         gauge%fname(idx) = trim(dirGauges(iDomain)) // trim(gauge_filename(domainID, iGauge))
     234          23 :         domain_mrm_iDomain%gaugeIdList(iGauge) = Gauge_id(domainID, iGauge)
     235          49 :         domain_mrm_iDomain%gaugeIndexList(iGauge) = idx
     236             :       end do
     237             :     end do
     238             : 
     239          14 :     if (nGaugesLocal .NE. idx) then
     240             :       call error_message('***ERROR: ', trim(file_namelist), ': Total number of evaluation gauges (', &
     241             :               trim(adjustl(num2str(nGaugesLocal))), &
     242           0 :               ') different from sum of gauges in subdomains (', trim(adjustl(num2str(idx))), ')!', raise=.false.)
     243           0 :       call error_message('          Error occured in namelist: evaluation_gauges')
     244             :     end if
     245             : 
     246             :     !===============================================================
     247             :     ! Read inflow gauge information
     248             :     !===============================================================
     249             : 
     250          14 :     nInflowGaugesTotal = 0
     251          14 :     NoInflowGauges_domain = 0
     252      142814 :     InflowGauge_id = nodata_i4
     253      142814 :     InflowGauge_filename = num2str(nodata_i4)
     254             : 
     255          14 :     call position_nml('inflow_gauges', unamelist)
     256          14 :     read(unamelist, nml = inflow_gauges)
     257             : 
     258          14 :     if (nInflowGaugesTotal .GT. maxNoGauges) then
     259             :       call error_message('***ERROR: ', trim(file_namelist), &
     260           0 :               ':read_gauge_lut: Total number of inflow gauges is restricted to', num2str(maxNoGauges), raise=.false.)
     261           0 :       call error_message('          Error occured in namlist: inflow_gauges')
     262             :     end if
     263             : 
     264             :     ! allocation - max() to avoid allocation with zero, needed for mhm call
     265          42 :     allocate(InflowGauge%gaugeId (max(1, nInflowGaugesTotal)))
     266          28 :     allocate(InflowGauge%domainId (max(1, nInflowGaugesTotal)))
     267          42 :     allocate(InflowGauge%fName   (max(1, nInflowGaugesTotal)))
     268             :     ! dummy initialization
     269          29 :     InflowGauge%gaugeId = nodata_i4
     270          29 :     InflowGauge%domainId = nodata_i4
     271          29 :     InflowGauge%fName = num2str(nodata_i4)
     272             : 
     273          14 :     idx = 0
     274          40 :     do iDomain = 1, domainMeta%nDomains
     275          26 :       domainID = domainMeta%indices(iDomain)
     276          26 :       domain_mrm_iDomain => domain_mrm(iDomain)
     277             : 
     278        1378 :       allocate(domain_mrm_iDomain%InflowGaugeIdList    (max(1, maxval(NoInflowGauges_domain(:)))))
     279        1378 :       allocate(domain_mrm_iDomain%InflowGaugeHeadwater (max(1, maxval(NoInflowGauges_domain(:)))))
     280        1378 :       allocate(domain_mrm_iDomain%InflowGaugeIndexList (max(1, maxval(NoInflowGauges_domain(:)))))
     281        1378 :       allocate(domain_mrm_iDomain%InflowGaugeNodeList  (max(1, maxval(NoInflowGauges_domain(:)))))
     282             :       ! dummy initialization
     283          26 :       domain_mrm_iDomain%nInflowGauges = 0
     284          52 :       domain_mrm_iDomain%InflowGaugeIdList = nodata_i4
     285          52 :       domain_mrm_iDomain%InflowGaugeHeadwater = .FALSE.
     286          52 :       domain_mrm_iDomain%InflowGaugeIndexList = nodata_i4
     287          52 :       domain_mrm_iDomain%InflowGaugeNodeList = nodata_i4
     288             :       ! no inflow gauge for subdomain i
     289          26 :       if (NoInflowGauges_domain(domainID) .EQ. nodata_i4) then
     290           0 :         NoInflowGauges_domain(domainID) = 0
     291             :       end if
     292             : 
     293          26 :       domain_mrm_iDomain%nInflowGauges = NoInflowGauges_domain(domainID)
     294             : 
     295          42 :       do iGauge = 1, NoInflowGauges_domain(domainID)
     296             :         ! check if NoInflowGauges_domain has a valid value
     297           2 :         if (InflowGauge_id(domainID, iGauge) .EQ. nodata_i4) then
     298             :           call error_message('***ERROR: ', trim(file_namelist), ':ID of inflow gauge ', &
     299             :                   trim(adjustl(num2str(iGauge))), ' for subdomain ', &
     300           0 :                   trim(adjustl(num2str(iDomain))), ' is not defined!', raise=.false.)
     301           0 :           call error_message('          Error occured in namlist: inflow_gauges')
     302           4 :         else if (trim(InflowGauge_filename(domainID, iGauge)) .EQ. trim(num2str(nodata_i4))) then
     303             :           call error_message('***ERROR: ', trim(file_namelist), ':Filename of inflow gauge ', &
     304             :                   trim(adjustl(num2str(iGauge))), ' for subdomain ', &
     305           0 :                   trim(adjustl(num2str(iDomain))), ' is not defined!', raise=.false.)
     306           2 :           call error_message('          Error occured in namlist: inflow_gauges')
     307             :         end if
     308             :         !
     309           2 :         idx = idx + 1
     310           2 :         InflowGauge%domainId(idx) = iDomain
     311           2 :         InflowGauge%gaugeId(idx) = InflowGauge_id(domainID, iGauge)
     312           2 :         InflowGauge%fname(idx) = trim(dirGauges(domainID)) // trim(InflowGauge_filename(domainID, iGauge))
     313           2 :         domain_mrm_iDomain%InflowGaugeIdList(iGauge) = InflowGauge_id(domainID, iGauge)
     314           2 :         domain_mrm_iDomain%InflowGaugeHeadwater(iGauge) = InflowGauge_Headwater(domainID, iGauge)
     315          28 :         domain_mrm_iDomain%InflowGaugeIndexList(iGauge) = idx
     316             :       end do
     317             :     end do
     318             : 
     319          14 :     if (nInflowGaugesTotal .NE. idx) then
     320             :       call error_message('***ERROR: ', trim(file_namelist), ': Total number of inflow gauges (', &
     321             :               trim(adjustl(num2str(nInflowGaugesTotal))), &
     322           0 :               ') different from sum of inflow gauges in subdomains (', trim(adjustl(num2str(idx))), ')!', raise=.false.)
     323           0 :       call error_message('          Error occured in namlist: inflow_gauges')
     324             :     end if
     325             : 
     326          14 :     call common_check_resolution(do_message, .true.)
     327             : 
     328          14 :     call close_nml(unamelist)
     329             : 
     330             :     !===============================================================
     331             :     ! Read namelist global parameters
     332             :     !===============================================================
     333          14 :     call read_mrm_routing_params(processMatrix(8, 1), file_namelist_param, unamelist_param)
     334             : 
     335             :     !===============================================================
     336             :     ! Read Output specifications for mRM
     337             :     !===============================================================
     338          14 :     output_deflate_level_mrm = 6
     339          14 :     output_time_reference_mrm = 0
     340          14 :     output_double_precision_mrm = .true.
     341          14 :     outputFlxState_mrm = .FALSE.
     342          14 :     timeStep_model_outputs_mrm = -2
     343          14 :     inquire(file = file_defOutput, exist = file_exists)
     344          14 :     if (file_exists) then
     345             :       ! file exists
     346           4 :       call open_nml(file_defOutput, udefOutput, quiet = .true.)
     347           4 :       call position_nml('NLoutputResults', udefOutput)
     348           4 :       read(udefOutput, nml = NLoutputResults)
     349           4 :       call close_nml(udefOutput)
     350             :     else
     351          10 :       call message('')
     352          10 :       call message('No file specifying mRM output fluxes exists')
     353             :     end if
     354          34 :     readLatLon = any(outputFlxState_mrm)
     355             : 
     356          34 :     if (any(outputFlxState_mrm)) then
     357           4 :       call message('')
     358           4 :       call message('    Following output will be written:')
     359           4 :       call message('    NetCDF deflate level: ', adjustl(trim(num2str(output_deflate_level_mrm))))
     360           4 :       if ( output_double_precision_mrm ) then
     361           4 :         call message('    NetCDF output precision: double')
     362             :       else
     363           0 :         call message('    NetCDF output precision: single')
     364             :       end if
     365           4 :       select case(output_time_reference_mrm)
     366             :         case(0)
     367           4 :           call message('    NetCDF output time reference point: start of time interval')
     368             :         case(1)
     369           0 :           call message('    NetCDF output time reference point: center of time interval')
     370             :         case(2)
     371           4 :           call message('    NetCDF output time reference point: end of time interval')
     372             :       end select
     373           4 :       call message('    FLUXES:')
     374           4 :       if (outputFlxState_mrm(1)) then
     375           4 :         call message('      routed streamflow      (L11_qMod)                [m3 s-1]')
     376             :       end if
     377           4 :       if (outputFlxState_mrm(2)) then
     378           1 :         call message('      river temperature      (RivTemp)                 [deg C]')
     379             :       end if
     380           4 :       if (gw_coupling) then
     381           0 :         call message('      river head             (river_head)              [m]')
     382             :       end if
     383             :     end if
     384             : 
     385          14 :     call message('')
     386          14 :     call message('    FINISHED reading config')
     387          14 :     call message('')
     388             : 
     389          14 :   end subroutine mrm_read_config
     390             : 
     391             :   ! ---------------------------------------------------------------------------
     392             :   ! SUBROUTINE READ_MRM_ROUTING_PARAMS
     393             :   ! ---------------------------------------------------------------------------
     394             :   !    NAME
     395             :   !        read_mrm_routing_params
     396             : 
     397             :   !    PURPOSE
     398             :   !>       \brief TODO: add description
     399             : 
     400             :   !>       \details TODO: add description
     401             : 
     402             :   !    INTENT(IN)
     403             :   !>       \param[in] "integer(i4) :: processCase"          it is the default case, should be one
     404             :   !>       \param[in] "character(*) :: file_namelist_param" file name containing parameter namelist
     405             :   !>       \param[in] "integer(i4) :: unamelist_param"      file name id containing parameter namelist
     406             : 
     407             :   !    HISTORY
     408             :   !>       \authors Robert Schweppe
     409             : 
     410             :   !>       \date Jun 2018
     411             : 
     412             :   ! Modifications:
     413             : 
     414          14 :   subroutine read_mrm_routing_params(processCase, file_namelist_param, unamelist_param)
     415             : 
     416          14 :     use mo_common_constants, only : nColPars
     417             :     use mo_common_functions, only : in_bound
     418             :     use mo_common_variables, only : global_parameters, global_parameters_name, processMatrix
     419             :     use mo_nml, only : close_nml, open_nml, position_nml
     420             : 
     421             :     implicit none
     422             : 
     423             :     ! it is the default case, should be one
     424             :     integer(i4), intent(in) :: processCase
     425             : 
     426             :     ! file name containing parameter namelist
     427             :     character(*), intent(in) :: file_namelist_param
     428             : 
     429             :     ! file name id containing parameter namelist
     430             :     integer(i4), intent(in) :: unamelist_param
     431             : 
     432             :     ! equals sum of previous parameters
     433             :     integer(i4) :: start_index
     434             : 
     435          84 :     real(dp), dimension(nColPars) :: muskingumTravelTime_constant
     436             : 
     437          84 :     real(dp), dimension(nColPars) :: muskingumTravelTime_riverLength
     438             : 
     439          84 :     real(dp), dimension(nColPars) :: muskingumTravelTime_riverSlope
     440             : 
     441          84 :     real(dp), dimension(nColPars) :: muskingumTravelTime_impervious
     442             : 
     443          84 :     real(dp), dimension(nColPars) :: muskingumAttenuation_riverSlope
     444             : 
     445          84 :     real(dp), dimension(nColPars) :: streamflow_celerity
     446          84 :     real(dp), dimension(nColPars) :: slope_factor
     447             : 
     448             :     namelist /routing1/ muskingumTravelTime_constant, muskingumTravelTime_riverLength, &
     449             :             muskingumTravelTime_riverSlope, muskingumTravelTime_impervious, muskingumAttenuation_riverSlope
     450             :     namelist /routing2/ streamflow_celerity
     451             :     namelist /routing3/ slope_factor
     452             :     !
     453          14 :     call open_nml(file_namelist_param, unamelist_param, quiet = .true.)
     454             : 
     455          14 :     if (processCase .eq. 1_i4) then
     456           9 :       call position_nml('routing1', unamelist_param)
     457           9 :       read(unamelist_param, nml = routing1)
     458           5 :     else if (processCase .eq. 2_i4) then
     459           1 :        call position_nml('routing2', unamelist_param)
     460           1 :        read(unamelist_param, nml = routing2)
     461           4 :     else if (processCase .eq. 3_i4) then
     462           3 :        call position_nml('routing3', unamelist_param)
     463           3 :        read(unamelist_param, nml = routing3)
     464             :     end if
     465             : 
     466             :     ! -------------------------------------------------------------------------
     467             :     ! INCLUDE MRM PARAMETERS IN PARAMETERS OF MHM
     468             :     ! -------------------------------------------------------------------------
     469             :     ! Muskingum routing parameters with MPR
     470          14 :     if (processCase .eq. 1_i4) then
     471             :       ! insert parameter values and names at position required by mhm
     472           9 :       processMatrix(8, 1) = processCase
     473           9 :       processMatrix(8, 2) = 5_i4
     474          81 :       processMatrix(8, 3) = sum(processMatrix(1 : 8, 2))
     475           9 :       start_index = processMatrix(8, 3) - processMatrix(8, 2)
     476          54 :       global_parameters(start_index + 1, :) = muskingumTravelTime_constant
     477          54 :       global_parameters(start_index + 2, :) = muskingumTravelTime_riverLength
     478          54 :       global_parameters(start_index + 3, :) = muskingumTravelTime_riverSlope
     479          54 :       global_parameters(start_index + 4, :) = muskingumTravelTime_impervious
     480          54 :       global_parameters(start_index + 5, :) = muskingumAttenuation_riverSlope
     481             : 
     482           0 :       global_parameters_name(start_index + 1 : start_index + processMatrix(8, 2)) = (/ &
     483             :               'muskingumTravelTime_constant   ', &
     484             :                       'muskingumTravelTime_riverLength', &
     485             :                       'muskingumTravelTime_riverSlope ', &
     486             :                       'muskingumTravelTime_impervious ', &
     487          54 :                       'muskingumAttenuation_riverSlope'/)
     488             :       ! adaptive timestep routing
     489           5 :     else if (processCase .eq. 2_i4) then
     490           1 :       processMatrix(8, 1) = processCase
     491           1 :       processMatrix(8, 2) = 1_i4
     492           9 :       processMatrix(8, 3) = sum(processMatrix(1 : 8, 2))
     493           1 :       start_index = processMatrix(8, 3) - processMatrix(8, 2)
     494           6 :       global_parameters(start_index + 1, :) = streamflow_celerity
     495             : 
     496           0 :       global_parameters_name(start_index + 1 : start_index + processMatrix(8, 2)) = (/ &
     497           2 :               'streamflow_celerity'/)
     498             :      ! adaptive timestep routing - varying celerity
     499           4 :      else if (processCase .eq. 3_i4) then
     500             :         ! insert parameter values and names at position required by mhm
     501           3 :         processMatrix(8, 1) = processCase
     502           3 :         processMatrix(8, 2) = 1_i4
     503          27 :         processMatrix(8, 3) = sum(processMatrix(1:8, 2))
     504           3 :         start_index         = processMatrix(8, 3) - processMatrix(8, 2)
     505          18 :         global_parameters(start_index + 1, :) = slope_factor
     506             : 
     507           0 :         global_parameters_name(start_index + 1 : start_index + processMatrix(8,2)) = (/ &
     508           6 :              'slope_factor'/)
     509             :     end if
     510             : 
     511             :     ! check if parameter are in range
     512          14 :     if (.not. in_bound(global_parameters)) then
     513             :       call error_message('***ERROR: parameter in routing namelist out of bound in ', &
     514           0 :               trim(adjustl(file_namelist_param)))
     515             :     end if
     516             : 
     517          14 :     call close_nml(unamelist_param)
     518             : 
     519          14 :   end subroutine read_mrm_routing_params
     520             : end module mo_mrm_read_config

Generated by: LCOV version 1.16