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