Line data Source code
1 : !> \file mo_mpr_read_config.f90
2 : !> \brief \copybrief mo_mpr_read_config
3 : !> \details \copydetails mo_mpr_read_config
4 :
5 : !> \brief read mpr config
6 : !> \details This module contains all mpr subroutines related to reading the mpr configuration from file.
7 : !> \changelog
8 : !! - Robert Schweppe Dec 2017
9 : !! - adapted for MPR
10 : !! - Robert Schweppe Jun 2018
11 : !! - refactoring and reformatting
12 : !! - M. Cuneyd Demirel, Simon Stisen Jun 2020
13 : !! - added Feddes and FC dependency on root fraction coefficient processCase(3) = 4
14 : !! - Rohini Kumar Oct 2021
15 : !! - Added Neutron count module to mHM integrate into develop branch (5.11.2)
16 : !> \authors Stephan Thober
17 : !> \date Aug 2015
18 : !> \copyright Copyright 2005-\today, the mHM Developers, Luis Samaniego, Sabine Attinger: All rights reserved.
19 : !! mHM is released under the LGPLv3+ license \license_note
20 : !> \ingroup f_mpr
21 : module mo_mpr_read_config
22 :
23 : use mo_kind, only : i4, dp
24 :
25 : implicit none
26 :
27 : public :: mpr_read_config
28 :
29 : contains
30 :
31 : ! ------------------------------------------------------------------
32 :
33 : ! NAME
34 : ! mpr_read_config
35 :
36 : ! PURPOSE
37 : !> \brief Read the general config of mpr
38 :
39 : !> \details Depending on the variable mrm_coupling_config, the
40 : !> mRM config is either read from mrm.nml and parameters from
41 : !> mrm_parameter.nml or copied from mHM.
42 :
43 : ! INTENT(IN)
44 : !> \param[in] "character(*) :: file_namelist"
45 : !> \param[in] "integer :: unamelist"
46 : !> \param[in] "character(*) :: file_namelist_param"
47 : !> \param[in] "integer :: unamelist_param"
48 :
49 : ! HISTORY
50 : !> \authors Stephan Thober
51 :
52 : !> \date Aug 2015
53 :
54 : ! Modifications:
55 : ! Stephan Thober Sep 2015 - removed stop condition when routing resolution is smaller than hydrologic resolution
56 : ! Stephan Thober Oct 2015 - added NLoutputResults namelist, fileLatLon to directories_general namelist, and readLatLon flag
57 : ! Robert Schweppe Dec 2017 - adapted for MPR
58 : ! Rohini Kumar Oct 2021 - Added Neutron count module to mHM integrate into develop branch (5.11.2)
59 :
60 14 : subroutine mpr_read_config(file_namelist, unamelist, file_namelist_param, unamelist_param)
61 :
62 : use mo_append, only : append
63 : use mo_common_constants, only : eps_dp, maxNoDomains, nColPars, nodata_dp
64 : use mo_common_functions, only : in_bound
65 : use mo_common_variables, only : global_parameters, global_parameters_name, domainMeta, processMatrix
66 : use mo_message, only : message, error_message
67 : use mo_mpr_constants, only : maxGeoUnit, &
68 : maxNoSoilHorizons
69 : use mo_mpr_global_variables, only : HorizonDepth_mHM, dirgridded_LAI, fracSealed_cityArea, iFlag_soilDB, &
70 : inputFormat_gridded_LAI, nGeoUnits, nSoilHorizons_mHM, tillageDepth, &
71 : timeStep_LAI_input
72 : use mo_nml, only : close_nml, open_nml, position_nml
73 : use mo_string_utils, only : num2str
74 : use mo_utils, only : EQ
75 :
76 : implicit none
77 :
78 : character(*), intent(in) :: file_namelist
79 :
80 : integer, intent(in) :: unamelist
81 :
82 : character(*), intent(in) :: file_namelist_param
83 :
84 : integer, intent(in) :: unamelist_param
85 :
86 : integer(i4) :: ii
87 :
88 : ! depth of the single horizons
89 154 : real(dp), dimension(maxNoSoilHorizons) :: soil_Depth
90 :
91 : ! directory of gridded LAI data
92 : ! used when timeStep_LAI_input<0
93 : character(256), dimension(maxNoDomains) :: dir_gridded_LAI
94 :
95 : character(256) :: dummy
96 :
97 : ! space holder for routing parameters
98 434 : real(dp), dimension(5, nColPars) :: dummy_2d_dp
99 :
100 : ! space holder for routing parameters
101 154 : real(dp), dimension(1, nColPars) :: dummy_2d_dp_2
102 :
103 84 : real(dp), dimension(nColPars) :: canopyInterceptionFactor
104 :
105 84 : real(dp), dimension(nColPars) :: snowTreshholdTemperature
106 :
107 84 : real(dp), dimension(nColPars) :: degreeDayFactor_forest
108 :
109 84 : real(dp), dimension(nColPars) :: degreeDayFactor_impervious
110 :
111 84 : real(dp), dimension(nColPars) :: degreeDayFactor_pervious
112 :
113 84 : real(dp), dimension(nColPars) :: increaseDegreeDayFactorByPrecip
114 :
115 84 : real(dp), dimension(nColPars) :: maxDegreeDayFactor_forest
116 :
117 84 : real(dp), dimension(nColPars) :: maxDegreeDayFactor_impervious
118 :
119 84 : real(dp), dimension(nColPars) :: maxDegreeDayFactor_pervious
120 :
121 84 : real(dp), dimension(nColPars) :: orgMatterContent_forest
122 :
123 84 : real(dp), dimension(nColPars) :: orgMatterContent_impervious
124 :
125 84 : real(dp), dimension(nColPars) :: orgMatterContent_pervious
126 :
127 84 : real(dp), dimension(nColPars) :: PTF_lower66_5_constant
128 :
129 84 : real(dp), dimension(nColPars) :: PTF_lower66_5_clay
130 :
131 84 : real(dp), dimension(nColPars) :: PTF_lower66_5_Db
132 :
133 84 : real(dp), dimension(nColPars) :: PTF_higher66_5_constant
134 :
135 84 : real(dp), dimension(nColPars) :: PTF_higher66_5_clay
136 :
137 84 : real(dp), dimension(nColPars) :: PTF_higher66_5_Db
138 :
139 84 : real(dp), dimension(nColPars) :: infiltrationShapeFactor
140 :
141 84 : real(dp), dimension(nColPars) :: PTF_Ks_constant
142 :
143 84 : real(dp), dimension(nColPars) :: PTF_Ks_sand
144 :
145 84 : real(dp), dimension(nColPars) :: PTF_Ks_clay
146 :
147 84 : real(dp), dimension(nColPars) :: PTF_Ks_curveSlope
148 :
149 84 : real(dp), dimension(nColPars) :: rootFractionCoefficient_forest
150 :
151 84 : real(dp), dimension(nColPars) :: rootFractionCoefficient_impervious
152 :
153 84 : real(dp), dimension(nColPars) :: rootFractionCoefficient_pervious
154 :
155 84 : real(dp), dimension(nColPars) :: jarvis_sm_threshold_c1
156 :
157 84 : real(dp), dimension(nColPars) :: FCmin_glob
158 :
159 84 : real(dp), dimension(nColPars) :: FCdelta_glob
160 :
161 84 : real(dp), dimension(nColPars) :: rootFractionCoefficient_sand
162 :
163 84 : real(dp), dimension(nColPars) :: rootFractionCoefficient_clay
164 :
165 84 : real(dp), dimension(nColPars) :: imperviousStorageCapacity
166 :
167 84 : real(dp), dimension(nColPars) :: PET_a_forest
168 :
169 84 : real(dp), dimension(nColPars) :: PET_a_impervious
170 :
171 84 : real(dp), dimension(nColPars) :: PET_a_pervious
172 :
173 84 : real(dp), dimension(nColPars) :: PET_b
174 :
175 84 : real(dp), dimension(nColPars) :: PET_c
176 :
177 84 : real(dp), dimension(nColPars) :: minCorrectionFactorPET
178 :
179 84 : real(dp), dimension(nColPars) :: maxCorrectionFactorPET
180 :
181 84 : real(dp), dimension(nColPars) :: aspectTresholdPET
182 :
183 84 : real(dp), dimension(nColPars) :: HargreavesSamaniCoeff
184 :
185 84 : real(dp), dimension(nColPars) :: PriestleyTaylorCoeff
186 :
187 84 : real(dp), dimension(nColPars) :: PriestleyTaylorLAIcorr
188 :
189 84 : real(dp), dimension(nColPars) :: canopyheigth_forest
190 :
191 84 : real(dp), dimension(nColPars) :: canopyheigth_impervious
192 :
193 84 : real(dp), dimension(nColPars) :: canopyheigth_pervious
194 :
195 84 : real(dp), dimension(nColPars) :: displacementheight_coeff
196 :
197 84 : real(dp), dimension(nColPars) :: roughnesslength_momentum_coeff
198 :
199 84 : real(dp), dimension(nColPars) :: roughnesslength_heat_coeff
200 :
201 84 : real(dp), dimension(nColPars) :: stomatal_resistance
202 :
203 84 : real(dp), dimension(nColPars) :: interflowStorageCapacityFactor
204 :
205 84 : real(dp), dimension(nColPars) :: interflowRecession_slope
206 :
207 84 : real(dp), dimension(nColPars) :: fastInterflowRecession_forest
208 :
209 84 : real(dp), dimension(nColPars) :: slowInterflowRecession_Ks
210 :
211 84 : real(dp), dimension(nColPars) :: exponentSlowInterflow
212 :
213 84 : real(dp), dimension(nColPars) :: rechargeCoefficient
214 :
215 84 : real(dp), dimension(nColPars) :: rechargeFactor_karstic
216 :
217 84 : real(dp), dimension(nColPars) :: gain_loss_GWreservoir_karstic
218 :
219 1834 : real(dp), dimension(maxGeoUnit, nColPars) :: GeoParam
220 :
221 84 : real(dp), dimension(nColPars) :: Desilets_N0
222 :
223 84 : real(dp), dimension(nColPars) :: Desilets_LW0
224 :
225 84 : real(dp), dimension(nColPars) :: Desilets_LW1
226 :
227 84 : real(dp), dimension(nColPars) :: COSMIC_N0
228 :
229 84 : real(dp), dimension(nColPars) :: COSMIC_N1
230 :
231 84 : real(dp), dimension(nColPars) :: COSMIC_N2
232 :
233 84 : real(dp), dimension(nColPars) :: COSMIC_alpha0
234 :
235 84 : real(dp), dimension(nColPars) :: COSMIC_alpha1
236 :
237 84 : real(dp), dimension(nColPars) :: COSMIC_L30
238 :
239 84 : real(dp), dimension(nColPars) :: COSMIC_L31
240 :
241 84 : real(dp), dimension(nColPars) :: COSMIC_LW0
242 :
243 84 : real(dp), dimension(nColPars) :: COSMIC_LW1
244 :
245 : integer(i4) :: iDomain, domainID
246 :
247 :
248 : ! namelist directories
249 : namelist /directories_MPR/ dir_gridded_LAI
250 : ! namelist soil database
251 : namelist /soildata/ iFlag_soilDB, tillageDepth, nSoilHorizons_mHM, soil_Depth
252 : ! namelist for LAI related data
253 : namelist /LAI_data_information/ inputFormat_gridded_LAI, timeStep_LAI_input
254 : ! namelist for land cover scenes
255 : namelist /LCover_MPR/ fracSealed_cityArea
256 :
257 : ! namelist parameters
258 : namelist /interception1/ canopyInterceptionFactor
259 : namelist /snow1/snowTreshholdTemperature, degreeDayFactor_forest, degreeDayFactor_impervious, &
260 : degreeDayFactor_pervious, increaseDegreeDayFactorByPrecip, maxDegreeDayFactor_forest, &
261 : maxDegreeDayFactor_impervious, maxDegreeDayFactor_pervious
262 : namelist /soilmoisture1/ orgMatterContent_forest, orgMatterContent_impervious, orgMatterContent_pervious, &
263 : PTF_lower66_5_constant, PTF_lower66_5_clay, PTF_lower66_5_Db, PTF_higher66_5_constant, &
264 : PTF_higher66_5_clay, PTF_higher66_5_Db, PTF_Ks_constant, &
265 : PTF_Ks_sand, PTF_Ks_clay, PTF_Ks_curveSlope, &
266 : rootFractionCoefficient_forest, rootFractionCoefficient_impervious, &
267 : rootFractionCoefficient_pervious, infiltrationShapeFactor
268 : namelist /soilmoisture2/ orgMatterContent_forest, orgMatterContent_impervious, orgMatterContent_pervious, &
269 : PTF_lower66_5_constant, PTF_lower66_5_clay, PTF_lower66_5_Db, PTF_higher66_5_constant, &
270 : PTF_higher66_5_clay, PTF_higher66_5_Db, PTF_Ks_constant, &
271 : PTF_Ks_sand, PTF_Ks_clay, PTF_Ks_curveSlope, &
272 : rootFractionCoefficient_forest, rootFractionCoefficient_impervious, &
273 : rootFractionCoefficient_pervious, infiltrationShapeFactor, jarvis_sm_threshold_c1
274 : namelist /soilmoisture3/ orgMatterContent_forest, orgMatterContent_impervious, orgMatterContent_pervious, &
275 : PTF_lower66_5_constant, PTF_lower66_5_clay, PTF_lower66_5_Db, PTF_higher66_5_constant, &
276 : PTF_higher66_5_clay, PTF_higher66_5_Db, PTF_Ks_constant, &
277 : PTF_Ks_sand, PTF_Ks_clay, PTF_Ks_curveSlope, &
278 : rootFractionCoefficient_forest, rootFractionCoefficient_impervious, &
279 : rootFractionCoefficient_pervious, infiltrationShapeFactor,rootFractionCoefficient_sand, &
280 : rootFractionCoefficient_clay, FCmin_glob, FCdelta_glob, jarvis_sm_threshold_c1
281 : namelist /soilmoisture4/ orgMatterContent_forest, orgMatterContent_impervious, orgMatterContent_pervious, &
282 : PTF_lower66_5_constant, PTF_lower66_5_clay, PTF_lower66_5_Db, PTF_higher66_5_constant, &
283 : PTF_higher66_5_clay, PTF_higher66_5_Db, PTF_Ks_constant, &
284 : PTF_Ks_sand, PTF_Ks_clay, PTF_Ks_curveSlope, &
285 : rootFractionCoefficient_forest, rootFractionCoefficient_impervious, &
286 : rootFractionCoefficient_pervious, infiltrationShapeFactor,rootFractionCoefficient_sand, &
287 : rootFractionCoefficient_clay, FCmin_glob, FCdelta_glob
288 : namelist /directRunoff1/ imperviousStorageCapacity
289 : ! PET is input, LAI driven correction
290 : namelist /PETminus1/ PET_a_forest, PET_a_impervious, PET_a_pervious, PET_b, PET_c
291 : ! PET is input, aspect driven correction
292 : namelist /PET0/ minCorrectionFactorPET, maxCorrectionFactorPET, aspectTresholdPET
293 : ! Hargreaves-Samani
294 : namelist /PET1/ minCorrectionFactorPET, maxCorrectionFactorPET, aspectTresholdPET, HargreavesSamaniCoeff
295 : ! Priestely-Taylor
296 : namelist /PET2/ PriestleyTaylorCoeff, PriestleyTaylorLAIcorr
297 : ! Penman-Monteith
298 : namelist /PET3/ canopyheigth_forest, canopyheigth_impervious, canopyheigth_pervious, displacementheight_coeff, &
299 : roughnesslength_momentum_coeff, roughnesslength_heat_coeff, stomatal_resistance
300 : namelist /interflow1/ interflowStorageCapacityFactor, interflowRecession_slope, fastInterflowRecession_forest, &
301 : slowInterflowRecession_Ks, exponentSlowInterflow
302 : namelist /percolation1/ rechargeCoefficient, rechargeFactor_karstic, gain_loss_GWreservoir_karstic
303 : namelist /neutrons1/ Desilets_N0, Desilets_LW0, Desilets_LW1
304 : namelist /neutrons2/ COSMIC_N0, COSMIC_N1, COSMIC_N2, COSMIC_alpha0, COSMIC_alpha1, COSMIC_L30, COSMIC_L31, &
305 : COSMIC_LW0, COSMIC_LW1
306 :
307 : !
308 : namelist /geoparameter/ GeoParam
309 :
310 : !===============================================================
311 : ! INITIALIZATION
312 : !===============================================================
313 14 : soil_Depth = 0.0_dp
314 434 : dummy_2d_dp = nodata_dp
315 154 : dummy_2d_dp_2 = nodata_dp
316 :
317 14 : call open_nml(file_namelist, unamelist, quiet = .true.)
318 :
319 : !===============================================================
320 : ! Read namelist for LCover
321 : !===============================================================
322 14 : call position_nml('LCover_MPR', unamelist)
323 14 : read(unamelist, nml = LCover_MPR)
324 :
325 : !===============================================================
326 : ! Read soil layering information
327 : !===============================================================
328 14 : call position_nml('soildata', unamelist)
329 14 : read(unamelist, nml = soildata)
330 :
331 42 : allocate(HorizonDepth_mHM(nSoilHorizons_mHM))
332 42 : HorizonDepth_mHM(:) = 0.0_dp
333 : ! last layer is reset to 0 in MPR in case of iFlag_soilDB is 0
334 42 : HorizonDepth_mHM(1 : nSoilHorizons_mHM) = soil_Depth(1 : nSoilHorizons_mHM)
335 :
336 : ! counter checks -- soil horizons
337 14 : if (nSoilHorizons_mHM .GT. maxNoSoilHorizons) then
338 0 : call error_message('***ERROR: Number of soil horizons is resticted to ', trim(num2str(maxNoSoilHorizons)), '!')
339 : end if
340 :
341 : ! the default is the HorizonDepths are all set up to last
342 : ! as is the default for option-1 where horizon specific information are taken into consideration
343 14 : if(iFlag_soilDB .eq. 0) then
344 : ! classical mhm soil database
345 14 : HorizonDepth_mHM(nSoilHorizons_mHM) = 0.0_dp
346 0 : else if(iFlag_soilDB .ne. 1) then
347 0 : call error_message('***ERROR: iFlag_soilDB option given does not exist. Only 0 and 1 is taken at the moment.')
348 : end if
349 :
350 : ! some consistency checks for the specification of the tillage depth
351 14 : if(iFlag_soilDB .eq. 1) then
352 0 : if(count(abs(HorizonDepth_mHM(:) - tillageDepth) .lt. eps_dp) .eq. 0) then
353 0 : call error_message('***ERROR: Soil tillage depth must conform with one of the specified horizon (lower) depth.')
354 : end if
355 : end if
356 :
357 : !===============================================================
358 : ! Read LAI related information
359 : !===============================================================
360 14 : call position_nml('LAI_data_information', unamelist)
361 14 : read(unamelist, nml = LAI_data_information)
362 :
363 14 : if (timeStep_LAI_input .ne. 0) then
364 : !===============================================================
365 : ! Read namelist for main directories
366 : !===============================================================
367 1 : call position_nml('directories_MPR', unamelist)
368 1 : read(unamelist, nml = directories_MPR)
369 :
370 3 : allocate(dirgridded_LAI(domainMeta%nDomains))
371 4 : do iDomain = 1, domainMeta%nDomains
372 3 : domainID = domainMeta%indices(iDomain)
373 4 : dirgridded_LAI(iDomain) = dir_gridded_LAI(domainID)
374 : end do
375 :
376 1 : if (timeStep_LAI_input .GT. 1) then
377 0 : call error_message('***ERROR: option for selected timeStep_LAI_input not coded yet')
378 : end if
379 : end if
380 :
381 14 : call close_nml(unamelist)
382 :
383 : !===============================================================
384 : ! Read namelist global parameters
385 : !===============================================================
386 14 : call open_nml(file_namelist_param, unamelist_param, quiet = .true.)
387 : ! decide which parameters to read depending on specified processes
388 :
389 : ! Process 1 - interception
390 28 : select case (processMatrix(1, 1))
391 : ! 1 - maximum Interception
392 : case(1)
393 14 : call position_nml('interception1', unamelist_param)
394 14 : read(unamelist_param, nml = interception1)
395 :
396 14 : processMatrix(1, 2) = 1_i4
397 14 : processMatrix(1, 3) = 1_i4
398 14 : call append(global_parameters, reshape(canopyInterceptionFactor, (/1, nColPars/)))
399 :
400 : call append(global_parameters_name, (/ &
401 28 : 'canopyInterceptionFactor'/))
402 :
403 : ! check if parameter are in range
404 14 : if (.not. in_bound(global_parameters)) then
405 : call error_message('***ERROR: parameter in namelist "interception1" out of bound in ', &
406 0 : trim(adjustl(file_namelist_param)))
407 : end if
408 :
409 : case DEFAULT
410 14 : call error_message('***ERROR: Process description for process "interception" does not exist!')
411 : end select
412 :
413 : ! Process 2 - snow
414 28 : select case (processMatrix(2, 1))
415 : ! 1 - degree-day approach
416 : case(1)
417 14 : call position_nml('snow1', unamelist_param)
418 14 : read(unamelist_param, nml = snow1)
419 :
420 14 : processMatrix(2, 2) = 8_i4
421 42 : processMatrix(2, 3) = sum(processMatrix(1 : 2, 2))
422 14 : call append(global_parameters, reshape(snowTreshholdTemperature, (/1, nColPars/)))
423 14 : call append(global_parameters, reshape(degreeDayFactor_forest, (/1, nColPars/)))
424 14 : call append(global_parameters, reshape(degreeDayFactor_impervious, (/1, nColPars/)))
425 14 : call append(global_parameters, reshape(degreeDayFactor_pervious, (/1, nColPars/)))
426 14 : call append(global_parameters, reshape(increaseDegreeDayFactorByPrecip, (/1, nColPars/)))
427 14 : call append(global_parameters, reshape(maxDegreeDayFactor_forest, (/1, nColPars/)))
428 14 : call append(global_parameters, reshape(maxDegreeDayFactor_impervious, (/1, nColPars/)))
429 14 : call append(global_parameters, reshape(maxDegreeDayFactor_pervious, (/1, nColPars/)))
430 :
431 : call append(global_parameters_name, (/ &
432 : 'snowTreshholdTemperature ', &
433 : 'degreeDayFactor_forest ', &
434 : 'degreeDayFactor_impervious ', &
435 : 'degreeDayFactor_pervious ', &
436 : 'increaseDegreeDayFactorByPrecip', &
437 : 'maxDegreeDayFactor_forest ', &
438 : 'maxDegreeDayFactor_impervious ', &
439 126 : 'maxDegreeDayFactor_pervious '/))
440 :
441 : ! check if parameter are in range
442 14 : if (.not. in_bound(global_parameters)) then
443 : call error_message('***ERROR: parameter in namelist "snow1" out of bound in ', &
444 0 : trim(adjustl(file_namelist_param)))
445 : end if
446 :
447 : case DEFAULT
448 14 : call error_message('***ERROR: Process description for process "snow" does not exist!')
449 : end select
450 :
451 : ! Process 3 - soilmoisture
452 25 : select case (processMatrix(3, 1))
453 :
454 : ! 1 - Feddes equation for PET reduction, bucket approach, Brooks-Corey like
455 : case(1)
456 11 : call position_nml('soilmoisture1', unamelist_param)
457 11 : read(unamelist_param, nml = soilmoisture1)
458 11 : processMatrix(3, 2) = 17_i4
459 44 : processMatrix(3, 3) = sum(processMatrix(1 : 3, 2))
460 11 : call append(global_parameters, reshape(orgMatterContent_forest, (/1, nColPars/)))
461 11 : call append(global_parameters, reshape(orgMatterContent_impervious, (/1, nColPars/)))
462 11 : call append(global_parameters, reshape(orgMatterContent_pervious, (/1, nColPars/)))
463 11 : call append(global_parameters, reshape(PTF_lower66_5_constant, (/1, nColPars/)))
464 11 : call append(global_parameters, reshape(PTF_lower66_5_clay, (/1, nColPars/)))
465 11 : call append(global_parameters, reshape(PTF_lower66_5_Db, (/1, nColPars/)))
466 11 : call append(global_parameters, reshape(PTF_higher66_5_constant, (/1, nColPars/)))
467 11 : call append(global_parameters, reshape(PTF_higher66_5_clay, (/1, nColPars/)))
468 11 : call append(global_parameters, reshape(PTF_higher66_5_Db, (/1, nColPars/)))
469 11 : call append(global_parameters, reshape(PTF_Ks_constant, (/1, nColPars/)))
470 11 : call append(global_parameters, reshape(PTF_Ks_sand, (/1, nColPars/)))
471 11 : call append(global_parameters, reshape(PTF_Ks_clay, (/1, nColPars/)))
472 11 : call append(global_parameters, reshape(PTF_Ks_curveSlope, (/1, nColPars/)))
473 11 : call append(global_parameters, reshape(rootFractionCoefficient_forest, (/1, nColPars/)))
474 11 : call append(global_parameters, reshape(rootFractionCoefficient_impervious, (/1, nColPars/)))
475 11 : call append(global_parameters, reshape(rootFractionCoefficient_pervious, (/1, nColPars/)))
476 11 : call append(global_parameters, reshape(infiltrationShapeFactor, (/1, nColPars/)))
477 :
478 : call append(global_parameters_name, (/ &
479 : 'orgMatterContent_forest ', &
480 : 'orgMatterContent_impervious ', &
481 : 'orgMatterContent_pervious ', &
482 : 'PTF_lower66_5_constant ', &
483 : 'PTF_lower66_5_clay ', &
484 : 'PTF_lower66_5_Db ', &
485 : 'PTF_higher66_5_constant ', &
486 : 'PTF_higher66_5_clay ', &
487 : 'PTF_higher66_5_Db ', &
488 : 'PTF_Ks_constant ', &
489 : 'PTF_Ks_sand ', &
490 : 'PTF_Ks_clay ', &
491 : 'PTF_Ks_curveSlope ', &
492 : 'rootFractionCoefficient_forest ', &
493 : 'rootFractionCoefficient_impervious', &
494 : 'rootFractionCoefficient_pervious ', &
495 198 : 'infiltrationShapeFactor '/))
496 :
497 : ! check if parameter are in range
498 11 : if (.not. in_bound(global_parameters)) then
499 : call error_message('***ERROR: parameter in namelist "soilmoisture1" out of bound in ', &
500 0 : trim(adjustl(file_namelist_param)))
501 : end if
502 :
503 : ! 2- Jarvis equation for PET reduction, bucket approach, Brooks-Corey like
504 : case(2)
505 1 : call position_nml('soilmoisture2', unamelist_param)
506 1 : read(unamelist_param, nml = soilmoisture2)
507 1 : processMatrix(3, 2) = 18_i4
508 4 : processMatrix(3, 3) = sum(processMatrix(1 : 3, 2))
509 1 : call append(global_parameters, reshape(orgMatterContent_forest, (/1, nColPars/)))
510 1 : call append(global_parameters, reshape(orgMatterContent_impervious, (/1, nColPars/)))
511 1 : call append(global_parameters, reshape(orgMatterContent_pervious, (/1, nColPars/)))
512 1 : call append(global_parameters, reshape(PTF_lower66_5_constant, (/1, nColPars/)))
513 1 : call append(global_parameters, reshape(PTF_lower66_5_clay, (/1, nColPars/)))
514 1 : call append(global_parameters, reshape(PTF_lower66_5_Db, (/1, nColPars/)))
515 1 : call append(global_parameters, reshape(PTF_higher66_5_constant, (/1, nColPars/)))
516 1 : call append(global_parameters, reshape(PTF_higher66_5_clay, (/1, nColPars/)))
517 1 : call append(global_parameters, reshape(PTF_higher66_5_Db, (/1, nColPars/)))
518 1 : call append(global_parameters, reshape(PTF_Ks_constant, (/1, nColPars/)))
519 1 : call append(global_parameters, reshape(PTF_Ks_sand, (/1, nColPars/)))
520 1 : call append(global_parameters, reshape(PTF_Ks_clay, (/1, nColPars/)))
521 1 : call append(global_parameters, reshape(PTF_Ks_curveSlope, (/1, nColPars/)))
522 1 : call append(global_parameters, reshape(rootFractionCoefficient_forest, (/1, nColPars/)))
523 1 : call append(global_parameters, reshape(rootFractionCoefficient_impervious, (/1, nColPars/)))
524 1 : call append(global_parameters, reshape(rootFractionCoefficient_pervious, (/1, nColPars/)))
525 1 : call append(global_parameters, reshape(infiltrationShapeFactor, (/1, nColPars/)))
526 1 : call append(global_parameters, reshape(jarvis_sm_threshold_c1, (/1, nColPars/)))
527 :
528 : call append(global_parameters_name, (/ &
529 : 'orgMatterContent_forest ', &
530 : 'orgMatterContent_impervious ', &
531 : 'orgMatterContent_pervious ', &
532 : 'PTF_lower66_5_constant ', &
533 : 'PTF_lower66_5_clay ', &
534 : 'PTF_lower66_5_Db ', &
535 : 'PTF_higher66_5_constant ', &
536 : 'PTF_higher66_5_clay ', &
537 : 'PTF_higher66_5_Db ', &
538 : 'PTF_Ks_constant ', &
539 : 'PTF_Ks_sand ', &
540 : 'PTF_Ks_clay ', &
541 : 'PTF_Ks_curveSlope ', &
542 : 'rootFractionCoefficient_forest ', &
543 : 'rootFractionCoefficient_impervious', &
544 : 'rootFractionCoefficient_pervious ', &
545 : 'infiltrationShapeFactor ', &
546 19 : 'jarvis_sm_threshold_c1 '/))
547 :
548 : ! check if parameter are in range
549 1 : if (.not. in_bound(global_parameters)) then
550 : call error_message('***ERROR: parameter in namelist "soilmoisture2" out of bound in ', &
551 0 : trim(adjustl(file_namelist_param)))
552 : end if
553 :
554 : ! 3- Jarvis equation for ET reduction and FC dependency on root fraction coefficient
555 : case(3)
556 1 : call position_nml('soilmoisture3', unamelist_param)
557 1 : read(unamelist_param, nml = soilmoisture3)
558 1 : processMatrix(3, 2) = 22_i4
559 4 : processMatrix(3, 3) = sum(processMatrix(1 : 3, 2))
560 1 : call append(global_parameters, reshape(orgMatterContent_forest, (/1, nColPars/)))
561 1 : call append(global_parameters, reshape(orgMatterContent_impervious, (/1, nColPars/)))
562 1 : call append(global_parameters, reshape(orgMatterContent_pervious, (/1, nColPars/)))
563 1 : call append(global_parameters, reshape(PTF_lower66_5_constant, (/1, nColPars/)))
564 1 : call append(global_parameters, reshape(PTF_lower66_5_clay, (/1, nColPars/)))
565 1 : call append(global_parameters, reshape(PTF_lower66_5_Db, (/1, nColPars/)))
566 1 : call append(global_parameters, reshape(PTF_higher66_5_constant, (/1, nColPars/)))
567 1 : call append(global_parameters, reshape(PTF_higher66_5_clay, (/1, nColPars/)))
568 1 : call append(global_parameters, reshape(PTF_higher66_5_Db, (/1, nColPars/)))
569 1 : call append(global_parameters, reshape(PTF_Ks_constant, (/1, nColPars/)))
570 1 : call append(global_parameters, reshape(PTF_Ks_sand, (/1, nColPars/)))
571 1 : call append(global_parameters, reshape(PTF_Ks_clay, (/1, nColPars/)))
572 1 : call append(global_parameters, reshape(PTF_Ks_curveSlope, (/1, nColPars/)))
573 1 : call append(global_parameters, reshape(rootFractionCoefficient_forest, (/1, nColPars/)))
574 1 : call append(global_parameters, reshape(rootFractionCoefficient_impervious, (/1, nColPars/)))
575 1 : call append(global_parameters, reshape(rootFractionCoefficient_pervious, (/1, nColPars/)))
576 1 : call append(global_parameters, reshape(infiltrationShapeFactor, (/1, nColPars/)))
577 1 : call append(global_parameters, reshape(rootFractionCoefficient_sand, (/1, nColPars/)))
578 1 : call append(global_parameters, reshape(rootFractionCoefficient_clay, (/1, nColPars/)))
579 1 : call append(global_parameters, reshape(FCmin_glob, (/1, nColPars/)))
580 1 : call append(global_parameters, reshape(FCdelta_glob, (/1, nColPars/)))
581 1 : call append(global_parameters, reshape(jarvis_sm_threshold_c1, (/1, nColPars/)))
582 :
583 :
584 : call append(global_parameters_name, (/ &
585 : 'orgMatterContent_forest ', &
586 : 'orgMatterContent_impervious ', &
587 : 'orgMatterContent_pervious ', &
588 : 'PTF_lower66_5_constant ', &
589 : 'PTF_lower66_5_clay ', &
590 : 'PTF_lower66_5_Db ', &
591 : 'PTF_higher66_5_constant ', &
592 : 'PTF_higher66_5_clay ', &
593 : 'PTF_higher66_5_Db ', &
594 : 'PTF_Ks_constant ', &
595 : 'PTF_Ks_sand ', &
596 : 'PTF_Ks_clay ', &
597 : 'PTF_Ks_curveSlope ', &
598 : 'rootFractionCoefficient_forest ', &
599 : 'rootFractionCoefficient_impervious', &
600 : 'rootFractionCoefficient_pervious ', &
601 : 'infiltrationShapeFactor ', &
602 : 'rootFractionCoefficient_sand ', &
603 : 'rootFractionCoefficient_clay ', &
604 : 'FCmin_glob ', &
605 : 'FCdelta_glob ', &
606 23 : 'jarvis_sm_threshold_c1 '/))
607 :
608 : ! check if parameter are in range
609 1 : if (.not. in_bound(global_parameters)) then
610 : call error_message('***ERROR: parameter in namelist "soilmoisture3" out of bound in ', &
611 0 : trim(adjustl(file_namelist_param)))
612 : end if
613 :
614 : ! 4- Feddes equation for ET reduction and FC dependency on root fraction coefficient
615 : case(4)
616 1 : call position_nml('soilmoisture4', unamelist_param)
617 1 : read(unamelist_param, nml = soilmoisture4)
618 1 : processMatrix(3, 2) = 21_i4
619 4 : processMatrix(3, 3) = sum(processMatrix(1 : 3, 2))
620 1 : call append(global_parameters, reshape(orgMatterContent_forest, (/1, nColPars/)))
621 1 : call append(global_parameters, reshape(orgMatterContent_impervious, (/1, nColPars/)))
622 1 : call append(global_parameters, reshape(orgMatterContent_pervious, (/1, nColPars/)))
623 1 : call append(global_parameters, reshape(PTF_lower66_5_constant, (/1, nColPars/)))
624 1 : call append(global_parameters, reshape(PTF_lower66_5_clay, (/1, nColPars/)))
625 1 : call append(global_parameters, reshape(PTF_lower66_5_Db, (/1, nColPars/)))
626 1 : call append(global_parameters, reshape(PTF_higher66_5_constant, (/1, nColPars/)))
627 1 : call append(global_parameters, reshape(PTF_higher66_5_clay, (/1, nColPars/)))
628 1 : call append(global_parameters, reshape(PTF_higher66_5_Db, (/1, nColPars/)))
629 1 : call append(global_parameters, reshape(PTF_Ks_constant, (/1, nColPars/)))
630 1 : call append(global_parameters, reshape(PTF_Ks_sand, (/1, nColPars/)))
631 1 : call append(global_parameters, reshape(PTF_Ks_clay, (/1, nColPars/)))
632 1 : call append(global_parameters, reshape(PTF_Ks_curveSlope, (/1, nColPars/)))
633 1 : call append(global_parameters, reshape(rootFractionCoefficient_forest, (/1, nColPars/)))
634 1 : call append(global_parameters, reshape(rootFractionCoefficient_impervious, (/1, nColPars/)))
635 1 : call append(global_parameters, reshape(rootFractionCoefficient_pervious, (/1, nColPars/)))
636 1 : call append(global_parameters, reshape(infiltrationShapeFactor, (/1, nColPars/)))
637 1 : call append(global_parameters, reshape(rootFractionCoefficient_sand, (/1, nColPars/)))
638 1 : call append(global_parameters, reshape(rootFractionCoefficient_clay, (/1, nColPars/)))
639 1 : call append(global_parameters, reshape(FCmin_glob, (/1, nColPars/)))
640 1 : call append(global_parameters, reshape(FCdelta_glob, (/1, nColPars/)))
641 :
642 : call append(global_parameters_name, (/ &
643 : 'orgMatterContent_forest ', &
644 : 'orgMatterContent_impervious ', &
645 : 'orgMatterContent_pervious ', &
646 : 'PTF_lower66_5_constant ', &
647 : 'PTF_lower66_5_clay ', &
648 : 'PTF_lower66_5_Db ', &
649 : 'PTF_higher66_5_constant ', &
650 : 'PTF_higher66_5_clay ', &
651 : 'PTF_higher66_5_Db ', &
652 : 'PTF_Ks_constant ', &
653 : 'PTF_Ks_sand ', &
654 : 'PTF_Ks_clay ', &
655 : 'PTF_Ks_curveSlope ', &
656 : 'rootFractionCoefficient_forest ', &
657 : 'rootFractionCoefficient_impervious', &
658 : 'rootFractionCoefficient_pervious ', &
659 : 'infiltrationShapeFactor ', &
660 : 'rootFractionCoefficient_sand ', &
661 : 'rootFractionCoefficient_clay ', &
662 : 'FCmin_glob ', &
663 22 : 'FCdelta_glob '/))
664 :
665 : ! check if parameter are in range
666 1 : if (.not. in_bound(global_parameters)) then
667 : call error_message('***ERROR: parameter in namelist "soilmoisture4" out of bound in ', &
668 0 : trim(adjustl(file_namelist_param)))
669 : end if
670 :
671 :
672 : case DEFAULT
673 14 : call error_message('***ERROR: Process description for process "soilmoisture" does not exist!')
674 : end select
675 :
676 : ! Process 4 - sealed area directRunoff
677 28 : select case (processMatrix(4, 1))
678 : ! 1 - bucket exceedance approach
679 : case(1)
680 14 : call position_nml('directRunoff1', unamelist_param)
681 14 : read(unamelist_param, nml = directRunoff1)
682 14 : processMatrix(4, 2) = 1_i4
683 70 : processMatrix(4, 3) = sum(processMatrix(1 : 4, 2))
684 14 : call append(global_parameters, reshape(imperviousStorageCapacity, (/1, nColPars/)))
685 :
686 28 : call append(global_parameters_name, (/'imperviousStorageCapacity'/))
687 :
688 : ! check if parameter are in range
689 14 : if (.not. in_bound(global_parameters)) then
690 : call error_message('***ERROR: parameter in namelist "directRunoff1" out of bound in ', &
691 0 : trim(adjustl(file_namelist_param)))
692 : end if
693 :
694 : case DEFAULT
695 14 : call error_message('***ERROR: Process description for process "directRunoff" does not exist!')
696 : end select
697 :
698 : ! Process 5 - potential evapotranspiration (PET)
699 16 : select case (processMatrix(5, 1))
700 : case(-1) ! 0 - PET is input, correct PET by LAI
701 2 : call position_nml('PETminus1', unamelist_param)
702 2 : read(unamelist_param, nml = PETminus1)
703 2 : processMatrix(5, 2) = 5_i4
704 12 : processMatrix(5, 3) = sum(processMatrix(1 : 5, 2))
705 2 : call append(global_parameters, reshape(PET_a_forest, (/1, nColPars/)))
706 2 : call append(global_parameters, reshape(PET_a_impervious, (/1, nColPars/)))
707 2 : call append(global_parameters, reshape(PET_a_pervious, (/1, nColPars/)))
708 2 : call append(global_parameters, reshape(PET_b, (/1, nColPars/)))
709 2 : call append(global_parameters, reshape(PET_c, (/1, nColPars/)))
710 :
711 : call append(global_parameters_name, (/ &
712 : 'PET_a_forest ', &
713 : 'PET_a_impervious ', &
714 : 'PET_a_pervious ', &
715 : 'PET_b ', &
716 12 : 'PET_c '/))
717 :
718 : ! check if parameter are in range
719 2 : if (.not. in_bound(global_parameters)) then
720 : call error_message('***ERROR: parameter in namelist "PETminus1" out of bound n ', &
721 0 : trim(adjustl(file_namelist_param)))
722 : end if
723 :
724 : case(0) ! 0 - PET is input, correct PET by aspect
725 8 : call position_nml('PET0', unamelist_param)
726 8 : read(unamelist_param, nml = PET0)
727 8 : processMatrix(5, 2) = 3_i4
728 48 : processMatrix(5, 3) = sum(processMatrix(1 : 5, 2))
729 8 : call append(global_parameters, reshape(minCorrectionFactorPET, (/1, nColPars/)))
730 8 : call append(global_parameters, reshape(maxCorrectionFactorPET, (/1, nColPars/)))
731 8 : call append(global_parameters, reshape(aspectTresholdPET, (/1, nColPars/)))
732 :
733 : call append(global_parameters_name, (/ &
734 : 'minCorrectionFactorPET ', &
735 : 'maxCorrectionFactorPET ', &
736 32 : 'aspectTresholdPET '/))
737 :
738 : ! check if parameter are in range
739 8 : if (.not. in_bound(global_parameters)) then
740 : call error_message('***ERROR: parameter in namelist "PET0" out of bound in ', &
741 0 : trim(adjustl(file_namelist_param)))
742 : end if
743 :
744 : case(1) ! 1 - Hargreaves-Samani method (HarSam) - additional input needed: Tmin, Tmax
745 2 : call position_nml('PET1', unamelist_param)
746 2 : read(unamelist_param, nml = PET1)
747 2 : processMatrix(5, 2) = 4_i4
748 12 : processMatrix(5, 3) = sum(processMatrix(1 : 5, 2))
749 2 : call append(global_parameters, reshape(minCorrectionFactorPET, (/1, nColPars/)))
750 2 : call append(global_parameters, reshape(maxCorrectionFactorPET, (/1, nColPars/)))
751 2 : call append(global_parameters, reshape(aspectTresholdPET, (/1, nColPars/)))
752 2 : call append(global_parameters, reshape(HargreavesSamaniCoeff, (/1, nColPars/)))
753 : call append(global_parameters_name, (/ &
754 : 'minCorrectionFactorPET', &
755 : 'maxCorrectionFactorPET', &
756 : 'aspectTresholdPET ', &
757 10 : 'HargreavesSamaniCoeff '/))
758 :
759 : ! check if parameter are in range
760 2 : if (.not. in_bound(global_parameters)) then
761 : call error_message('***ERROR: parameter in namelist "PET1" out of bound in ', &
762 0 : trim(adjustl(file_namelist_param)))
763 : end if
764 :
765 : case(2) ! 2 - Priestley-Taylor method (PrieTay) - additional input needed: net_rad
766 1 : call position_nml('PET2', unamelist_param)
767 1 : read(unamelist_param, nml = PET2)
768 1 : processMatrix(5, 2) = 2_i4
769 6 : processMatrix(5, 3) = sum(processMatrix(1 : 5, 2))
770 1 : call append(global_parameters, reshape(PriestleyTaylorCoeff, (/1, nColPars/)))
771 1 : call append(global_parameters, reshape(PriestleyTaylorLAIcorr, (/1, nColPars/)))
772 : call append(global_parameters_name, (/ &
773 : 'PriestleyTaylorCoeff ', &
774 3 : 'PriestleyTaylorLAIcorr'/))
775 :
776 : ! check if parameter are in range
777 1 : if (.not. in_bound(global_parameters)) then
778 : call error_message('***ERROR: parameter in namelist "PET2" out of bound in ', &
779 0 : trim(adjustl(file_namelist_param)))
780 : end if
781 :
782 : case(3) ! 3 - Penman-Monteith method - additional input needed: net_rad, abs. vapour pressue, windspeed
783 1 : call position_nml('PET3', unamelist_param)
784 1 : read(unamelist_param, nml = PET3)
785 1 : processMatrix(5, 2) = 7_i4
786 6 : processMatrix(5, 3) = sum(processMatrix(1 : 5, 2))
787 :
788 1 : call append(global_parameters, reshape(canopyheigth_forest, (/1, nColPars/)))
789 1 : call append(global_parameters, reshape(canopyheigth_impervious, (/1, nColPars/)))
790 1 : call append(global_parameters, reshape(canopyheigth_pervious, (/1, nColPars/)))
791 1 : call append(global_parameters, reshape(displacementheight_coeff, (/1, nColPars/)))
792 1 : call append(global_parameters, reshape(roughnesslength_momentum_coeff, (/1, nColPars/)))
793 1 : call append(global_parameters, reshape(roughnesslength_heat_coeff, (/1, nColPars/)))
794 1 : call append(global_parameters, reshape(stomatal_resistance, (/1, nColPars/)))
795 :
796 : call append(global_parameters_name, (/ &
797 : 'canopyheigth_forest ', &
798 : 'canopyheigth_impervious ', &
799 : 'canopyheigth_pervious ', &
800 : 'displacementheight_coeff ', &
801 : 'roughnesslength_momentum_coeff', &
802 : 'roughnesslength_heat_coeff ', &
803 8 : 'stomatal_resistance '/))
804 :
805 : ! check if parameter are in range
806 1 : if (.not. in_bound(global_parameters)) then
807 : call error_message('***ERROR: parameter in namelist "PET3" out of bound in ', &
808 0 : trim(adjustl(file_namelist_param)))
809 : end if
810 :
811 : case DEFAULT
812 14 : call error_message('***ERROR: Process description for process "actualET" does not exist!')
813 : end select
814 :
815 :
816 : ! Process 6 - interflow
817 28 : select case (processMatrix(6, 1))
818 : ! 1 - parallel soil reservoir approach
819 : case(1)
820 14 : call position_nml('interflow1', unamelist_param)
821 14 : read(unamelist_param, nml = interflow1)
822 14 : processMatrix(6, 2) = 5_i4
823 98 : processMatrix(6, 3) = sum(processMatrix(1 : 6, 2))
824 14 : call append(global_parameters, reshape(interflowStorageCapacityFactor, (/1, nColPars/)))
825 14 : call append(global_parameters, reshape(interflowRecession_slope, (/1, nColPars/)))
826 14 : call append(global_parameters, reshape(fastInterflowRecession_forest, (/1, nColPars/)))
827 14 : call append(global_parameters, reshape(slowInterflowRecession_Ks, (/1, nColPars/)))
828 14 : call append(global_parameters, reshape(exponentSlowInterflow, (/1, nColPars/)))
829 :
830 : call append(global_parameters_name, (/ &
831 : 'interflowStorageCapacityFactor', &
832 : 'interflowRecession_slope ', &
833 : 'fastInterflowRecession_forest ', &
834 : 'slowInterflowRecession_Ks ', &
835 84 : 'exponentSlowInterflow '/))
836 :
837 : ! check if parameter are in range
838 14 : if (.not. in_bound(global_parameters)) then
839 : call error_message('***ERROR: parameter in namelist "interflow1" out of bound in ', &
840 0 : trim(adjustl(file_namelist_param)))
841 : end if
842 :
843 : case DEFAULT
844 14 : call error_message('***ERROR: Process description for process "interflow" does not exist!')
845 : end select
846 :
847 : ! Process 7 - percolation
848 28 : select case (processMatrix(7, 1))
849 : ! 1 - GW layer is assumed as bucket
850 : case(1)
851 14 : call position_nml('percolation1', unamelist_param)
852 14 : read(unamelist_param, nml = percolation1)
853 14 : processMatrix(7, 2) = 3_i4
854 112 : processMatrix(7, 3) = sum(processMatrix(1 : 7, 2))
855 14 : call append(global_parameters, reshape(rechargeCoefficient, (/1, nColPars/)))
856 14 : call append(global_parameters, reshape(rechargeFactor_karstic, (/1, nColPars/)))
857 14 : call append(global_parameters, reshape(gain_loss_GWreservoir_karstic, (/1, nColPars/)))
858 :
859 : call append(global_parameters_name, (/ &
860 : 'rechargeCoefficient ', &
861 : 'rechargeFactor_karstic ', &
862 56 : 'gain_loss_GWreservoir_karstic'/))
863 :
864 : ! check if parameter are in range
865 14 : if (.not. in_bound(global_parameters)) then
866 : call error_message('***ERROR: parameter in namelist "percolation1" out of bound in ', &
867 0 : trim(adjustl(file_namelist_param)))
868 : end if
869 :
870 : case DEFAULT
871 14 : call error_message('***ERROR: Process description for process "percolation" does not exist!')
872 : end select
873 :
874 : ! Process 8 - routing
875 15 : select case (processMatrix(8, 1))
876 : case(0)
877 : ! 0 - deactivated
878 1 : call message()
879 1 : call message('***CAUTION: Routing is deativated! ')
880 :
881 1 : processMatrix(8, 2) = 0_i4
882 9 : processMatrix(8, 3) = sum(processMatrix(1 : 8, 2))
883 : case(1)
884 : ! parameter values and names are set in mRM
885 : ! 1 - Muskingum approach
886 9 : processMatrix(8, 2) = 5_i4
887 81 : processMatrix(8, 3) = sum(processMatrix(1 : 8, 2))
888 9 : call append(global_parameters, dummy_2d_dp)
889 54 : call append(global_parameters_name, (/'dummy', 'dummy', 'dummy', 'dummy', 'dummy'/))
890 : case(2)
891 1 : processMatrix(8, 2) = 1_i4
892 9 : processMatrix(8, 3) = sum(processMatrix(1 : 8, 2))
893 1 : call append(global_parameters, dummy_2d_dp_2)
894 2 : call append(global_parameters_name, (/'dummy'/))
895 : case(3)
896 3 : processMatrix(8, 2) = 1_i4
897 27 : processMatrix(8, 3) = sum(processMatrix(1 : 8, 2))
898 3 : call append(global_parameters, dummy_2d_dp_2)
899 6 : call append(global_parameters_name, (/'dummy'/))
900 : case DEFAULT
901 14 : call error_message('***ERROR: Process description for process "routing" does not exist!')
902 : end select
903 :
904 : !===============================================================
905 : ! Geological formations
906 : !===============================================================
907 14 : dummy = dummy // '' ! only to avoid warning
908 :
909 : ! Process 9 - geoparameter
910 28 : select case (processMatrix(9, 1))
911 : case(1)
912 : ! read in global parameters (NOT REGIONALIZED, i.e. these are <beta> and not <gamma>) for each geological formation used
913 14 : call position_nml('geoparameter', unamelist_param)
914 1834 : GeoParam = nodata_dp
915 14 : read(unamelist_param, nml = geoparameter)
916 :
917 : ! search number of geological parameters
918 154 : do ii = 1, size(GeoParam, 1) ! no while loop to avoid risk of endless loop
919 154 : if (EQ(GeoParam(ii, 1), nodata_dp)) then
920 14 : nGeoUnits = ii - 1
921 14 : exit
922 : end if
923 : end do
924 :
925 : ! for geology parameters
926 14 : processMatrix(9, 2) = nGeoUnits
927 140 : processMatrix(9, 3) = sum(processMatrix(1 : 9, 2))
928 :
929 14 : call append(global_parameters, GeoParam(1 : nGeoUnits, :))
930 :
931 : ! create names
932 154 : do ii = 1, nGeoUnits
933 140 : dummy = 'GeoParam(' // trim(adjustl(num2str(ii))) // ',:)'
934 294 : call append(global_parameters_name, (/ trim(dummy) /))
935 : end do
936 :
937 : ! check if parameter are in range
938 14 : if (.not. in_bound(global_parameters)) then
939 : call error_message('***ERROR: parameter in namelist "geoparameter" out of bound in ', &
940 0 : trim(adjustl(file_namelist_param)))
941 : end if
942 :
943 : case DEFAULT
944 14 : call error_message('***ERROR: Process description for process "geoparameter" does not exist!')
945 : end select
946 :
947 : !===============================================================
948 : ! NEUTRON COUNT
949 : !===============================================================
950 : ! Process 10 - neutrons
951 : ! 0 - deactivated
952 : ! 1 - inverse N0 based on Desilets et al. 2010
953 : ! 2 - COSMIC forward operator by Shuttlworth et al. 2013
954 27 : select case (processMatrix(10, 1))
955 : case(0)
956 : ! 0 - deactivated
957 13 : call message()
958 13 : call message('***SELECTION: Neutron count routine is deativated! ')
959 :
960 : case(1)
961 : ! 1 - inverse N0 based on Desilets et al. 2010
962 1 : call position_nml('neutrons1', unamelist_param)
963 1 : read(unamelist_param, nml = neutrons1)
964 :
965 1 : processMatrix(10,2) = 3_i4
966 11 : processMatrix(10,3) = sum(processMatrix(1:10, 2))
967 1 : call append(global_parameters, reshape(Desilets_N0, (/1, nColPars/)))
968 1 : call append(global_parameters, reshape(Desilets_LW0, (/1, nColPars/)))
969 1 : call append(global_parameters, reshape(Desilets_LW1, (/1, nColPars/)))
970 :
971 : call append(global_parameters_name, (/ &
972 : 'Desilets_N0 ', &
973 : 'Desilets_LW0 ', &
974 4 : 'Desilets_LW1 '/))
975 :
976 : ! check if parameter are in range
977 1 : if (.not. in_bound(global_parameters)) then
978 : call error_message('***ERROR: parameter in namelist "neutrons1" out of bound in ', &
979 0 : trim(adjustl(file_namelist_param)))
980 : end if
981 :
982 : case(2)
983 : ! 2 - COSMIC version
984 0 : call position_nml('neutrons2', unamelist_param)
985 0 : read(unamelist_param, nml = neutrons2)
986 :
987 0 : processMatrix(10,2) = 9_i4
988 0 : processMatrix(10,3) = sum(processMatrix(1:10, 2))
989 0 : call append(global_parameters, reshape(COSMIC_N0, (/1, nColPars/)))
990 0 : call append(global_parameters, reshape(COSMIC_N1, (/1, nColPars/)))
991 0 : call append(global_parameters, reshape(COSMIC_N2, (/1, nColPars/)))
992 0 : call append(global_parameters, reshape(COSMIC_alpha0, (/1, nColPars/)))
993 0 : call append(global_parameters, reshape(COSMIC_alpha1, (/1, nColPars/)))
994 0 : call append(global_parameters, reshape(COSMIC_L30, (/1, nColPars/)))
995 0 : call append(global_parameters, reshape(COSMIC_L31, (/1, nColPars/)))
996 0 : call append(global_parameters, reshape(COSMIC_LW0, (/1, nColPars/)))
997 0 : call append(global_parameters, reshape(COSMIC_LW1, (/1, nColPars/)))
998 :
999 : call append(global_parameters_name, (/ &
1000 : 'COSMIC_N0 ', &
1001 : 'COSMIC_N1 ', &
1002 : 'COSMIC_N2 ', &
1003 : 'COSMIC_alpha0 ', &
1004 : 'COSMIC_alpha1 ', &
1005 : 'COSMIC_L30 ', &
1006 : 'COSMIC_L31 ', &
1007 : 'COSMIC_LW0 ', &
1008 0 : 'COSMIC_LW1 '/))
1009 : ! check if parameter are in range
1010 0 : if (.not. in_bound(global_parameters)) then
1011 : call error_message('***ERROR: parameter in namelist "neutrons2" out of bound in ', &
1012 0 : trim(adjustl(file_namelist_param)))
1013 : end if
1014 :
1015 : case DEFAULT
1016 14 : call error_message('***ERROR: Process description for process "NEUTRON count" does not exist!')
1017 : end select
1018 :
1019 :
1020 14 : call close_nml(unamelist_param)
1021 :
1022 14 : end subroutine mpr_read_config
1023 :
1024 : end module mo_mpr_read_config
|
