Line data Source code
1 : !> \file mo_mrm_init.f90
2 : !> \brief \copybrief mo_mrm_init
3 : !> \details \copydetails mo_mrm_init
4 :
5 : !> \brief Wrapper for initializing Routing.
6 : !> \details Calling all routines to initialize all mRM variables
7 : !> \authors Luis Samaniego, Rohini Kumar and 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_init
13 :
14 : use mo_common_variables, only : dirOut
15 : use mo_message, only : message, error_message
16 :
17 : ! This module sets the river network characteristics and routing order.
18 :
19 : ! Written Luis Samaniego, Mar 2005
20 :
21 : IMPLICIT NONE
22 :
23 : public :: mrm_init, mrm_configuration
24 : public :: variables_default_init_routing
25 : public :: fluxes_states_default_init_routing
26 :
27 : private
28 :
29 : CONTAINS
30 :
31 : !> \brief read mRM configuration from namelists
32 14 : subroutine mrm_configuration(file_namelist, unamelist, file_namelist_param, unamelist_param)
33 : use mo_common_mHM_mRM_variables, only : mrm_coupling_mode
34 : use mo_common_variables, only : processMatrix
35 : use mo_mrm_read_config, only : mrm_read_config
36 : use mo_mrm_global_variables, only: riv_temp_pcs
37 : use mo_common_read_config, only : common_read_config
38 : use mo_common_mHM_mRM_read_config, only : check_optimization_settings, common_mHM_mRM_read_config
39 : use mo_kind, only : i4
40 : implicit none
41 :
42 : character(*), intent(in) :: file_namelist !< namelist file name
43 : integer, intent(in) :: unamelist !< unit to open namelist
44 : character(*), intent(in) :: file_namelist_param !< parameter namelist file name
45 : integer, intent(in) :: unamelist_param !< unit to open parameter namelist
46 :
47 14 : if (mrm_coupling_mode .eq. 0_i4) then
48 0 : call common_read_config(file_namelist, unamelist)
49 0 : call common_mHM_mRM_read_config(file_namelist, unamelist)
50 : !-----------------------------------------------------------
51 : ! PRINT STARTUP MESSAGE
52 : !-----------------------------------------------------------
53 0 : call print_startup_message(file_namelist, file_namelist_param)
54 : else
55 14 : call message('')
56 14 : call message(' Inititalize mRM')
57 14 : if ( processMatrix(11, 1) .ne. 0 ) then
58 : ! processCase(11): river temperature routing
59 1 : riv_temp_pcs%active = .true.
60 1 : riv_temp_pcs%case = processMatrix(11, 1)
61 1 : call message('')
62 1 : call message(' Read config: river temperature routing')
63 1 : call riv_temp_pcs%config(file_namelist, unamelist, file_namelist_param, unamelist_param)
64 : end if
65 : end if
66 :
67 : ! read config for mrm, readlatlon is set here depending on whether output is needed
68 14 : call mrm_read_config(file_namelist, unamelist, file_namelist_param, unamelist_param, (mrm_coupling_mode .eq. 0_i4))
69 :
70 : ! this was moved here, because it depends on global_parameters that are only set in mrm_read_config
71 14 : if (mrm_coupling_mode .eq. 0_i4) then
72 0 : call check_optimization_settings()
73 : !-----------------------------------------------------------
74 : ! CONFIG OUTPUT
75 : !-----------------------------------------------------------
76 0 : call config_output()
77 : end if
78 14 : end subroutine mrm_configuration
79 :
80 :
81 : !> \brief Initialize all mRM variables at all levels (i.e., L0, L1, and L11).
82 : !> \details Initialize all mRM variables at all levels (i.e., L0, L1, and L11)
83 : !! either with default values or with values from restart file. The L0 mask (L0_mask),
84 : !! L0 elevation (L0_elev), and L0 land cover (L0_LCover) can be provided as optional
85 : !! variables to save memory because these variable will then not be read in again.
86 : !> \changelog
87 : !! - Stephan Thober Sep 2015
88 : !! - added L0_mask, L0_elev, and L0_LCover
89 : !! - Stephan Thober May 2016
90 : !! - added warning message in case no gauge is found in modelling domain
91 : !! - Matthias Kelbling Aug 2017
92 : !! - added L11_flow_accumulation to Initialize Stream Netwo
93 : !! - Lennart Schueler May 2018
94 : !! - added initialization for groundwater coupling
95 : !! - Stephan Thober Jun 2018
96 : !! - refactored for mpr_extract version
97 : !! - Stephan Thober May 2019
98 : !! - added init of level0 in case of read restart
99 : !> \authors Stephan Thober
100 : !> \date Aug 2015
101 13 : subroutine mrm_init(file_namelist, unamelist, file_namelist_param, unamelist_param)
102 :
103 14 : use mo_common_constants, only : nodata_dp, nodata_i4
104 : use mo_common_mHM_mRM_variables, only : mrmFileRestartIn, mrm_coupling_mode, mrm_read_river_network, &
105 : resolutionRouting
106 : use mo_common_restart, only : read_grid_info
107 : use mo_common_variables, only : global_parameters, l0_l1_remap, level0, level1, domainMeta, &
108 : processMatrix, resolutionHydrology
109 : use mo_grid, only : L0_grid_setup, init_lowres_level, set_domain_indices
110 : use mo_kind, only : i4
111 : use mo_mrm_global_variables, only : domain_mrm, &
112 : l0_l11_remap, level11, &
113 : gw_coupling, L0_river_head_mon_sum, &
114 : L11_netPerm, L11_fromN, L11_length, L11_nOutlets, &
115 : riv_temp_pcs, &
116 : readLatLon
117 : use mo_mrm_net_startup, only : L11_flow_direction, L11_flow_accumulation, L11_fraction_sealed_floodplain, &
118 : L11_link_location, L11_routing_order, L11_set_drain_outlet_gauges, &
119 : L11_set_network_topology, L11_stream_features, l11_l1_mapping
120 : use mo_mrm_read_data, only : mrm_read_L0_data, mrm_read_discharge, &
121 : mrm_read_total_runoff, mrm_read_bankfull_runoff
122 : use mo_mrm_restart, only : mrm_read_restart_config
123 : use mo_read_latlon, only : read_latlon
124 : use mo_mrm_river_head, only: init_masked_zeros_l0, calc_channel_elevation
125 : use mo_mrm_mpr, only : mrm_init_param
126 :
127 : implicit none
128 :
129 : character(*), intent(in) :: file_namelist !< namelist file name
130 : integer, intent(in) :: unamelist !< unit to open namelist
131 : character(*), intent(in) :: file_namelist_param !< parameter namelist file name
132 : integer, intent(in) :: unamelist_param !< unit to open parameter namelist
133 :
134 : ! start and end index for routing parameters
135 : integer(i4) :: iStart, iEnd
136 : ! start and end index at L11
137 : integer(i4) :: s11, e11
138 :
139 : integer(i4) :: domainID, iDomain, gauge_counter
140 :
141 :
142 13 : if (mrm_coupling_mode .eq. 0_i4) then
143 0 : allocate(l0_l1_remap(domainMeta%nDomains))
144 0 : allocate(level1(domainMeta%nDomains))
145 : end if
146 :
147 : ! ----------------------------------------------------------
148 : ! READ DATA
149 : ! ----------------------------------------------------------
150 64 : allocate(level11(domainMeta%nDomains))
151 64 : allocate(l0_l11_remap(domainMeta%nDomains))
152 :
153 13 : if (.not. mrm_read_river_network) then
154 : ! read all (still) necessary level 0 data
155 12 : if (processMatrix(8, 1) .eq. 1_i4) call mrm_read_L0_data(mrm_coupling_mode .eq. 0_i4, ReadLatLon, .true.)
156 12 : if (processMatrix(8, 1) .eq. 2_i4) call mrm_read_L0_data(mrm_coupling_mode .eq. 0_i4, ReadLatLon, .false.)
157 12 : if (processMatrix(8, 1) .eq. 3_i4) call mrm_read_L0_data(mrm_coupling_mode .eq. 0_i4, ReadLatLon, .false.)
158 : end if
159 :
160 38 : do iDomain = 1, domainMeta%nDomains
161 25 : domainID = domainMeta%indices(iDomain)
162 38 : if (mrm_read_river_network) then
163 : ! this reads the domain properties
164 1 : if (.not. allocated(level0)) allocate(level0(domainMeta%nDomains))
165 : ! ToDo: L0_Domain, parallel
166 1 : call read_grid_info(mrmFileRestartIn(iDomain), "0", level0(domainMeta%L0DataFrom(iDomain)))
167 1 : if (mrm_coupling_mode .eq. 0_i4) then
168 0 : call read_grid_info(mrmFileRestartIn(iDomain), "1", level1(iDomain))
169 : end if
170 1 : call read_grid_info(mrmFileRestartIn(iDomain), "11", level11(iDomain))
171 1 : call mrm_read_restart_config(iDomain, domainID, mrmFileRestartIn(iDomain))
172 : else
173 24 : if (iDomain .eq. 1) then
174 12 : call L0_check_input_routing(domainMeta%L0DataFrom(iDomain))
175 12 : if (mrm_coupling_mode .eq. 0_i4) then
176 0 : call L0_grid_setup(level0(domainMeta%L0DataFrom(iDomain)))
177 : end if
178 12 : else if ((domainMeta%L0DataFrom(iDomain) == iDomain)) then
179 : call L0_check_input_routing(domainMeta%L0DataFrom(iDomain))
180 9 : if (mrm_coupling_mode .eq. 0_i4) then
181 0 : call L0_grid_setup(level0(domainMeta%L0DataFrom(iDomain)))
182 : end if
183 : end if
184 :
185 24 : if (mrm_coupling_mode .eq. 0_i4) then
186 0 : call init_lowres_level(level0(domainMeta%L0DataFrom(iDomain)), resolutionHydrology(iDomain), &
187 0 : level1(iDomain), l0_l1_remap(iDomain))
188 : end if
189 0 : call init_lowres_level(level0(domainMeta%L0DataFrom(iDomain)), resolutionRouting(iDomain), &
190 24 : level11(iDomain), l0_l11_remap(iDomain))
191 24 : call L11_L1_mapping(iDomain)
192 :
193 24 : if (ReadLatLon) then
194 : ! read lat lon coordinates of each domain
195 4 : call read_latlon(iDomain, "lon", "lat", "level1", level1(iDomain))
196 4 : call read_latlon(iDomain, "lon_l11", "lat_l11", "level11", level11(iDomain))
197 : else
198 : ! allocate the memory and set to nodata
199 80 : allocate(level11(iDomain)%x(level11(iDomain)%nrows, level11(iDomain)%ncols))
200 80 : allocate(level11(iDomain)%y(level11(iDomain)%nrows, level11(iDomain)%ncols))
201 1576 : level11(iDomain)%x = nodata_dp
202 1576 : level11(iDomain)%y = nodata_dp
203 : end if
204 : end if
205 : end do
206 :
207 : call set_domain_indices(level11)
208 : call set_domain_indices(level1)
209 : call set_domain_indices(level0, indices=domainMeta%L0DataFrom)
210 :
211 : ! ----------------------------------------------------------
212 : ! INITIALIZE STATES AND AUXILLIARY VARIABLES
213 : ! ----------------------------------------------------------
214 38 : do iDomain = 1, domainMeta%nDomains
215 38 : call variables_alloc_routing(iDomain)
216 : end do
217 :
218 : ! ----------------------------------------------------------
219 : ! INITIALIZE STREAM NETWORK
220 : ! ----------------------------------------------------------
221 38 : do iDomain = 1, domainMeta%nDomains
222 38 : if (.not. mrm_read_river_network) then
223 24 : call L11_flow_direction(iDomain)
224 24 : call L11_flow_accumulation(iDomain)
225 24 : call L11_set_network_topology(iDomain)
226 24 : call L11_routing_order(iDomain)
227 24 : call L11_link_location(iDomain)
228 24 : call L11_set_drain_outlet_gauges(iDomain)
229 : ! stream characteristics
230 24 : call L11_stream_features(iDomain)
231 : end if
232 : end do
233 :
234 : ! ----------------------------------------------------------
235 : ! INITIALIZE PARAMETERS
236 : ! ----------------------------------------------------------
237 38 : do iDomain = 1, domainMeta%nDomains
238 25 : iStart = processMatrix(8, 3) - processMatrix(8, 2) + 1
239 25 : iEnd = processMatrix(8, 3)
240 38 : call mrm_init_param(iDomain, global_parameters(iStart : iEnd, 3))
241 : end do
242 :
243 : ! check whether there are gauges within the modelling domain
244 13 : if (allocated(domain_mrm)) then
245 13 : gauge_counter = 0
246 38 : do iDomain = 1, domainMeta%nDomains
247 44 : if (.not. all(domain_mrm(iDomain)%gaugeNodeList .eq. nodata_i4)) then
248 19 : gauge_counter = gauge_counter + 1
249 : end if
250 : end do
251 13 : if (gauge_counter .lt. 1) then
252 0 : call message('')
253 0 : call message(' WARNING: no gauge found within modelling domain')
254 : end if
255 : end if
256 : ! mpr-like definiton of sealed floodplain fraction
257 13 : if ((processMatrix(8, 1) .eq. 1_i4) .and. (.not. mrm_read_river_network)) then
258 9 : call L11_fraction_sealed_floodplain(2_i4, .true.)
259 : else
260 : ! dummy initialization
261 4 : call L11_fraction_sealed_floodplain(2_i4, .false.)
262 : end if
263 :
264 : ! -------------------------------------------------------
265 : ! READ INPUT DATA AND OBSERVED DISCHARGE DATA
266 : ! -------------------------------------------------------
267 : ! read simulated runoff at level 1
268 13 : if (mrm_coupling_mode .eq. 0_i4) then
269 0 : do iDomain = 1, domainMeta%nDomains
270 0 : call mrm_read_total_runoff(iDomain)
271 : end do
272 : end if
273 : ! discharge data
274 13 : call mrm_read_discharge()
275 :
276 : ! init groundwater coupling
277 13 : if (gw_coupling) then
278 0 : do iDomain = 1, domainMeta%nDomains
279 0 : call init_masked_zeros_l0(iDomain, L0_river_head_mon_sum)
280 0 : call mrm_read_bankfull_runoff(iDomain)
281 : end do
282 0 : call calc_channel_elevation()
283 : end if
284 :
285 : ! init riv temp
286 13 : if ( riv_temp_pcs%active ) then
287 1 : call message('')
288 1 : call message(' Initialization of river temperature routing.')
289 2 : do iDomain = 1, domainMeta%nDomains
290 1 : s11 = level11(iDomain)%iStart
291 1 : e11 = level11(iDomain)%iEnd
292 1 : call riv_temp_pcs%init(level11(iDomain)%nCells)
293 : call riv_temp_pcs%init_area( &
294 : iDomain, &
295 0 : L11_netPerm(s11 : e11), & ! routing order at L11
296 0 : L11_fromN(s11 : e11), & ! link source at L11
297 0 : L11_length(s11 : e11 - 1), & ! link length
298 0 : level11(iDomain)%nCells - L11_nOutlets(iDomain), &
299 : level11(iDomain)%nCells, &
300 : level11(iDomain)%nrows, &
301 : level11(iDomain)%ncols, &
302 0 : level11(iDomain)%mask &
303 2 : )
304 : end do
305 : end if
306 13 : call message('')
307 13 : call message(' Finished Initialization of mRM')
308 :
309 13 : end subroutine mrm_init
310 :
311 :
312 : !> \brief Print mRM startup message
313 : !> \authors Robert Schweppe
314 : !> \date Jun 2018
315 0 : subroutine print_startup_message(file_namelist, file_namelist_param)
316 :
317 13 : use mo_kind, only : i4
318 : use mo_mrm_file, only : file_defOutput, file_main, version, version_date
319 : use mo_string_utils, only : num2str, separator
320 :
321 : implicit none
322 :
323 : character(*), intent(in) :: file_namelist !< namelist file name
324 : character(*), intent(in) :: file_namelist_param !< parameter namelist file name
325 :
326 : ! Date and time
327 : integer(i4), dimension(8) :: datetime
328 :
329 : CHARACTER(len=1024) :: message_text = ''
330 :
331 0 : call message(separator)
332 0 : call message(' mRM-UFZ')
333 0 : call message()
334 0 : call message(' MULTISCALE ROUTING MODEL')
335 0 : call message(' Version ', trim(version))
336 0 : call message(' ', trim(version_date))
337 0 : call message()
338 0 : call message('Made available by S. Thober & M. Cuntz')
339 0 : call message()
340 0 : call message('Based on mHM-UFZ by L. Samaniego & R. Kumar')
341 :
342 0 : call message(separator)
343 :
344 0 : call message()
345 0 : call date_and_time(values = datetime)
346 : message_text = trim(num2str(datetime(3), '(I2.2)')) // "." // trim(num2str(datetime(2), '(I2.2)')) &
347 : // "." // trim(num2str(datetime(1), '(I4.4)')) // " " // trim(num2str(datetime(5), '(I2.2)')) &
348 0 : // ":" // trim(num2str(datetime(6), '(I2.2)')) // ":" // trim(num2str(datetime(7), '(I2.2)'))
349 0 : call message('Start at ', trim(message_text), '.')
350 0 : call message('Using main file ', trim(file_main), ' and namelists: ')
351 0 : call message(' ', trim(file_namelist))
352 0 : call message(' ', trim(file_namelist_param))
353 0 : call message(' ', trim(file_defOutput), ' (if it is given)')
354 0 : call message()
355 :
356 0 : end subroutine print_startup_message
357 :
358 :
359 : !> \brief print mRM configuration
360 : !> \authors Robert Schweppe
361 : !> \date Jun 2018
362 0 : subroutine config_output
363 :
364 0 : use mo_common_variables, only : dirLCover, dirMorpho, dirOut, domainMeta
365 : use mo_kind, only : i4
366 : use mo_mrm_file, only : file_defOutput, file_namelist_mrm, file_namelist_param_mrm
367 : use mo_mrm_global_variables, only : domain_mrm, &
368 : dirGauges
369 : use mo_string_utils, only : num2str
370 :
371 : implicit none
372 :
373 : integer(i4) :: domainID, iDomain
374 :
375 : integer(i4) :: jj
376 :
377 :
378 : !
379 0 : call message()
380 0 : call message('Read namelist file: ', trim(file_namelist_mrm))
381 0 : call message('Read namelist file: ', trim(file_namelist_param_mrm))
382 0 : call message('Read namelist file: ', trim(file_defOutput), ' (if it is given)')
383 :
384 0 : call message()
385 0 : call message(' # of domains: ', trim(num2str(domainMeta%nDomains)))
386 0 : call message()
387 0 : call message(' Input data directories:')
388 0 : do iDomain = 1, domainMeta%nDomains
389 0 : domainID = domainMeta%indices(iDomain)
390 0 : call message(' --------------')
391 0 : call message(' DOMAIN ', num2str(domainID, '(I3)'))
392 0 : call message(' --------------')
393 0 : call message(' Morphological directory: ', trim(dirMorpho(iDomain)))
394 0 : call message(' Land cover directory: ', trim(dirLCover(iDomain)))
395 0 : call message(' Discharge directory: ', trim(dirGauges(iDomain)))
396 0 : call message(' Output directory: ', trim(dirOut(iDomain)))
397 0 : call message(' Evaluation gauge ', 'ID')
398 0 : do jj = 1, domain_mrm(iDomain)%nGauges
399 : call message(' ', trim(adjustl(num2str(jj))), ' ', &
400 0 : trim(adjustl(num2str(domain_mrm(iDomain)%gaugeIdList(jj)))))
401 : end do
402 0 : if (domain_mrm(iDomain)%nInflowGauges .GT. 0) then
403 0 : call message(' Inflow gauge ', 'ID')
404 0 : do jj = 1, domain_mrm(iDomain)%nInflowGauges
405 : call message(' ', trim(adjustl(num2str(jj))), ' ', &
406 0 : trim(adjustl(num2str(domain_mrm(iDomain)%InflowGaugeIdList(jj)))))
407 : end do
408 : end if
409 : end do
410 0 : end subroutine config_output
411 :
412 :
413 : !> \brief Default initalization mRM related L11 variables
414 : !> \details Default initalization of mHM related L11 variables (e.g., states,
415 : !! fluxes, and parameters) as per given constant values given in mo_mhm_constants.
416 : !! Variables initalized here is defined in the mo_global_variables.f90 file.
417 : !! Only Variables that are defined in the variables_alloc subroutine are
418 : !! intialized here.
419 : !! If a variable is added or removed here, then it also has to be added or removed
420 : !! in the subroutine state_variables_set in the module mo_restart and in the
421 : !! subroutine set_state in the module mo_set_netcdf_restart.
422 : !> \authors Stephan Thober, Rohini Kumar, and Juliane Mai
423 : !> \date Aug 2015
424 : !> \authors Robert Schweppe
425 : !> \date Jun 2018
426 59 : subroutine variables_default_init_routing
427 :
428 0 : use mo_common_constants, only : P1_InitStateFluxes
429 : use mo_mrm_global_variables, only : L11_C1, L11_C2, L11_K, L11_xi
430 :
431 : implicit none
432 :
433 : !-------------------------------------------
434 : ! L11 ROUTING STATE VARIABLES, FLUXES AND
435 : ! PARAMETERS
436 : !-------------------------------------------
437 :
438 : ! fluxes and states
439 59 : call fluxes_states_default_init_routing()
440 :
441 : ! kappa: Muskingum travel time parameter.
442 7617 : L11_K = P1_InitStateFluxes
443 : ! xi: Muskingum diffusion parameter
444 7617 : L11_xi = P1_InitStateFluxes
445 : ! Routing parameter C1=f(K,xi, DT) (Chow, 25-41)
446 7617 : L11_C1 = P1_InitStateFluxes
447 : ! Routing parameter C2 =f(K,xi, DT) (Chow, 25-41)
448 7617 : L11_C2 = P1_InitStateFluxes
449 :
450 59 : end subroutine variables_default_init_routing
451 :
452 : !> \brief initialize fluxes and states with default values for mRM
453 59 : subroutine fluxes_states_default_init_routing(iDomain)
454 :
455 59 : use mo_kind, only: i4
456 : use mo_mrm_global_variables, only : level11
457 : use mo_common_constants, only : P1_InitStateFluxes
458 : use mo_mrm_global_variables, only : L11_Qmod, L11_qOUT, L11_qTIN, L11_qTR
459 :
460 : implicit none
461 :
462 : !> number of Domain (if not present, set for all)
463 : integer(i4), intent(in), optional :: iDomain
464 :
465 : integer(i4) :: s11, e11
466 :
467 : !-------------------------------------------
468 : ! L11 ROUTING STATE VARIABLES, FLUXES AND
469 : ! PARAMETERS
470 : !-------------------------------------------
471 :
472 59 : if (present(iDomain)) then
473 0 : s11 = level11(iDomain)%iStart
474 0 : e11 = level11(iDomain)%iEnd
475 : ! simulated discharge at each node
476 0 : L11_Qmod(s11 : e11) = P1_InitStateFluxes
477 : ! Total outflow from cells L11 at time tt
478 0 : L11_qOUT(s11 : e11) = P1_InitStateFluxes
479 : ! Total discharge inputs at t-1 and t
480 0 : L11_qTIN(s11 : e11, :) = P1_InitStateFluxes
481 : ! Routed outflow leaving a node
482 0 : L11_qTR(s11 : e11, :) = P1_InitStateFluxes
483 : else
484 : ! simulated discharge at each node
485 7617 : L11_Qmod = P1_InitStateFluxes
486 : ! Total outflow from cells L11 at time tt
487 7617 : L11_qOUT = P1_InitStateFluxes
488 : ! Total discharge inputs at t-1 and t
489 15234 : L11_qTIN = P1_InitStateFluxes
490 : ! Routed outflow leaving a node
491 15234 : L11_qTR = P1_InitStateFluxes
492 : end if
493 :
494 59 : end subroutine fluxes_states_default_init_routing
495 :
496 :
497 : !> \brief check routing input on level-0
498 : !> \authors Robert Schweppe
499 : !> \date Jun 2018
500 21 : subroutine L0_check_input_routing(L0Domain_iDomain)
501 :
502 59 : use mo_common_constants, only : nodata_i4
503 : use mo_common_variables, only : level0
504 : use mo_kind, only : i4
505 : use mo_mrm_global_variables, only : L0_fAcc, L0_fDir
506 : use mo_string_utils, only : num2str
507 :
508 : implicit none
509 :
510 : integer(i4), intent(in) :: L0Domain_iDomain !< domain index for associated level-0 data
511 :
512 : integer(i4) :: k
513 :
514 : CHARACTER(len=1024) :: message_text = ''
515 :
516 926426 : do k = level0(L0Domain_iDomain)%iStart, level0(L0Domain_iDomain)%iEnd
517 : ! flow direction [-]
518 926405 : if (L0_fDir(k) .eq. nodata_i4) then
519 0 : message_text = trim(num2str(k, '(I5)')) // ',' // trim(num2str(L0Domain_iDomain, '(I5)'))
520 : call error_message(' Error: flow direction has missing value within the valid masked area at cell in domain ', &
521 0 : trim(message_text))
522 : end if
523 : ! flow accumulation [-]
524 926426 : if (L0_fAcc(k) .eq. nodata_i4) then
525 0 : message_text = trim(num2str(k, '(I5)')) // ',' // trim(num2str(L0Domain_iDomain, '(I5)'))
526 : call error_message(' Error: flow accumulation has missing values within the valid masked area at cell in domain ', &
527 0 : trim(message_text))
528 : end if
529 : end do
530 :
531 21 : end subroutine L0_check_input_routing
532 :
533 :
534 : !> \brief allocated routing related variables
535 : !> \authors Robert Schweppe
536 : !> \date Jun 2018
537 25 : subroutine variables_alloc_routing(iDomain)
538 :
539 21 : use mo_append, only : append
540 : use mo_kind, only : dp, i4
541 : use mo_mrm_constants, only : nRoutingStates
542 : use mo_common_variables, only : level0, domainMeta
543 : use mo_mrm_global_variables, only : L11_C1, L11_C2, L11_K, &
544 : L11_Qmod, L11_qOUT, L11_qTIN, L11_qTR, L11_xi, &
545 : level11, L11_celerity, L0_celerity
546 :
547 : implicit none
548 :
549 : integer(i4), intent(in) :: iDomain !< domain index
550 :
551 25 : real(dp), dimension(:), allocatable :: dummy_Vector11
552 :
553 25 : real(dp), dimension(:, :), allocatable :: dummy_Matrix11_IT
554 :
555 :
556 : ! dummy vector and matrix
557 75 : allocate(dummy_Vector11 (level11(iDomain)%nCells))
558 100 : allocate(dummy_Matrix11_IT(level11(iDomain)%nCells, nRoutingStates))
559 :
560 : ! simulated discharge at each node
561 995 : dummy_Vector11(:) = 0.0_dp
562 25 : call append(L11_Qmod, dummy_Vector11)
563 :
564 : ! Total outflow from cells L11 at time tt
565 995 : dummy_Vector11(:) = 0.0_dp
566 25 : call append(L11_qOUT, dummy_Vector11)
567 :
568 : ! Total discharge inputs at t-1 and t
569 2015 : dummy_Matrix11_IT(:, :) = 0.0_dp
570 25 : call append(L11_qTIN, dummy_Matrix11_IT)
571 :
572 : ! Routed outflow leaving a node
573 2015 : dummy_Matrix11_IT(:, :) = 0.0_dp
574 25 : call append(L11_qTR, dummy_Matrix11_IT)
575 :
576 : ! kappa: Muskingum travel time parameter.
577 995 : dummy_Vector11(:) = 0.0_dp
578 25 : call append(L11_K, dummy_Vector11)
579 :
580 : ! xi: Muskingum diffusion parameter
581 995 : dummy_Vector11(:) = 0.0_dp
582 25 : call append(L11_xi, dummy_Vector11)
583 :
584 : ! Routing parameter C1=f(K,xi, DT) (Chow, 25-41)
585 995 : dummy_Vector11(:) = 0.0_dp
586 25 : call append(L11_C1, dummy_Vector11)
587 :
588 : ! Routing parameter C2 =f(K,xi, DT) (Chow, 25-41)
589 995 : dummy_Vector11(:) = 0.0_dp
590 25 : call append(L11_C2, dummy_Vector11)
591 :
592 : ! Celerity at each link
593 995 : dummy_Vector11(:) = 0.0_dp
594 25 : call append(L11_celerity, dummy_Vector11)
595 :
596 : ! celerity at level 0
597 25 : if (allocated(dummy_Vector11)) deallocate(dummy_Vector11)
598 75 : allocate(dummy_Vector11(level0(domainMeta%L0DataFrom(iDomain))%ncells))
599 1112610 : dummy_Vector11(:) = 0.0_dp
600 25 : call append(L0_celerity, dummy_Vector11)
601 :
602 : ! free space
603 25 : if (allocated(dummy_Vector11)) deallocate(dummy_Vector11)
604 25 : if (allocated(dummy_Matrix11_IT)) deallocate(dummy_Matrix11_IT)
605 :
606 25 : end subroutine variables_alloc_routing
607 :
608 : END MODULE mo_mrm_init
|
