Line data Source code
1 : !> \file mo_write_ascii.f90
2 : !> \brief \copybrief mo_write_ascii
3 : !> \details \copydetails mo_write_ascii
4 :
5 : !> \brief Module to write ascii file output.
6 : !> \details Module to write ascii file output.
7 : !! Writing model output to ASCII should be the exception. Therefore, output is written usually as NetCDF
8 : !! and only:
9 : !! 1. The configuration file of mHM,
10 : !! 2. the final parameter set after optimization, and
11 : !! 3. the simulated vs. observed daily discharge
12 : !! is written in ASCII file format to allow for a quick assurance of proper model runs.
13 : !> \changelog
14 : !! - Modified, Juliane Mai, May 2013
15 : !! - module version and documentation
16 : !! - Modified, Luis Samaniego, Nov 2013
17 : !! - improving all formats
18 : !! - Modified, Luis Samaniego, Mar 2014
19 : !! - added inflow gauge information write out
20 : !! - Modified, Stephan Thober, Jun 2014
21 : !! - bug fixed: in writing network properties
22 : !! - Modified, Rohini Kumar, Jun 2014
23 : !! - bug fixed: writing of max and min value of discharge
24 : !! - Modified, Stephan Thober, Aug 2015
25 : !! - moved write_daily_obs_sim_discharge to mRM
26 : !> \authors Christoph Schneider, Juliane Mai, Luis Samaniego
27 : !> \date May 2013
28 : !> \copyright Copyright 2005-\today, the mHM Developers, Luis Samaniego, Sabine Attinger: All rights reserved.
29 : !! mHM is released under the LGPLv3+ license \license_note
30 : !> \ingroup f_mhm
31 : MODULE mo_write_ascii
32 :
33 :
34 : USE mo_kind, ONLY : i4, dp
35 : use mo_message, only: message, error_message
36 :
37 : IMPLICIT NONE
38 :
39 : PUBLIC :: write_configfile ! Writes configuration file
40 : PUBLIC :: write_optifile ! Write final OF and best parameter set
41 : PUBLIC :: write_optinamelist ! Write final OF and best parameter set in a namelist format
42 : ! ------------------------------------------------------------------
43 :
44 : ! NAME
45 : ! write_configfile
46 :
47 : ! PURPOSE
48 : !> \brief This modules writes the results of the configuration into an ASCII-file
49 : !> \details
50 :
51 : !> \details TODO: add description
52 :
53 : ! HISTORY
54 : !> \authors Christoph Schneider
55 :
56 : !> \date May 2013
57 :
58 : ! Modifications:
59 : ! Juliane Mai May 2013 - module version and documentation
60 : ! Stephan Thober Jun 2014 - bug fix in L11 config print out
61 : ! Stephan Thober Jun 2014 - updated read_restart
62 : ! Rohini, Luis Jul 2015 - updated version, L1 level prints
63 : ! Stephan Thober Nov 2016 - moved processMatrix to common variables
64 : ! Robert Schweppe Jun 2018 - refactoring and reformatting
65 :
66 : PRIVATE
67 :
68 : ! ------------------------------------------------------------------
69 :
70 : CONTAINS
71 :
72 : ! NAME
73 : ! write_configfile
74 :
75 : ! PURPOSE
76 : !> \brief TODO: add description
77 :
78 : !> \details TODO: add description
79 :
80 : ! HISTORY
81 : !> \authors Robert Schweppe
82 :
83 : !> \date Jun 2018
84 :
85 : ! Modifications:
86 : ! Robert Schweppe Jun 2018 - refactoring and reformatting
87 : ! P Shrestha, S Thober Aug 2018 - resolved bug while printing River Network in
88 : ! cases with multiple outlets.
89 :
90 28 : Subroutine write_configfile(dirPrecipitation, dirReferenceET, dirTemperature)
91 :
92 : use mo_common_file, only : file_config, uconfig
93 : use mo_common_mHM_mRM_variables, only : LCyearId, SimPer, evalPer, read_restart, timeStep, warmPer
94 : use mo_common_variables, only : LC_year_end, &
95 : LC_year_start, LCfilename, dirConfigOut, dirLCover, dirMorpho, dirOut, mhmFileRestartOut, &
96 : global_parameters, global_parameters_name, iFlag_cordinate_sys, level0, level1, &
97 : domainMeta, nLCoverScene, resolutionHydrology, write_restart
98 : use mo_file, only : version
99 : use mo_kind, only : i4
100 : use mo_string_utils, only : num2str
101 : use mo_os, only : check_path_isdir
102 : use mo_common_constants, only : nodata_dp
103 : use mo_common_mHM_mRM_variables, only : resolutionRouting
104 : use mo_common_variables, only : processMatrix
105 : use mo_mrm_global_variables, only : InflowGauge, L11_fromN, L11_label, L11_length, L11_netPerm, L11_rOrder, &
106 : L11_slope, L11_toN, L1_L11_ID, dirGauges, gauge, level11, nGaugesTotal, &
107 : nGaugesLocal, nInflowGaugesTotal, L11_nOutlets
108 :
109 : implicit none
110 :
111 : character(256), dimension(:), intent(in) :: dirPrecipitation !< Directory where precipitation files are located
112 : character(256), dimension(:), intent(in) :: dirReferenceET !< Directory where reference-ET files are located
113 : character(256), dimension(:), intent(in) :: dirTemperature !< Directory where temperature files are located
114 :
115 : character(256) :: fName
116 :
117 : integer(i4) :: i, j, iDomain, domainID
118 :
119 : integer(i4) :: err
120 :
121 :
122 14 : fName = trim(adjustl(dirConfigOut)) // trim(adjustl(file_config))
123 14 : call message()
124 14 : call message(' Log-file written to ', trim(fName))
125 : !checking whether the directory exists where the file shall be created or opened
126 14 : call check_path_isdir(trim(adjustl(dirConfigOut)), raise=.true.)
127 14 : open(uconfig, file = fName, status = 'unknown', action = 'write', iostat = err)
128 14 : if (err .ne. 0) then
129 0 : call error_message(' Problems while creating File. ', 'Error-Code ', num2str(err))
130 : end if
131 14 : write(uconfig, 200)
132 14 : write(uconfig, 100) 'mHM-UFZ v-' // trim(version)
133 14 : write(uconfig, 100) 'L. Samaniego & R. Kumar, UFZ'
134 14 : write(uconfig, 200)
135 14 : write(uconfig, 100)
136 14 : write(uconfig, 201) ' M A I N mHM C O N F I G U R A T I O N I N F O R M A T I O N '
137 14 : write(uconfig, 100)
138 14 : write(uconfig, 103) 'Number of domain ', domainMeta%overallNumberOfDomains
139 14 : if (processMatrix(8, 1) > 0) then
140 13 : write(uconfig, 103) 'Total No. of gauges ', nGaugesTotal
141 : end if
142 14 : write(uconfig, 103) 'Time Step [h] ', timeStep
143 40 : do iDomain = 1, domainMeta%nDomains
144 26 : domainID = domainMeta%indices(iDomain)
145 26 : write(uconfig, 103) 'Domain ', domainID, 'No. of cells L0 ', level0(domainMeta%L0DataFrom(iDomain))%nCells
146 26 : write(uconfig, 103) 'Domain ', domainID, 'No. of cells L1 ', level1(iDomain)%nCells
147 26 : if (domainMeta%doRouting(iDomain)) then
148 20 : write(uconfig, 103) 'Total No. of nodes ', level11(iDomain)%nCells
149 20 : write(uconfig, 103) 'Total No. of reaches ', level11(iDomain)%nCells - 1
150 20 : if (domainMeta%doRouting(iDomain)) then
151 20 : write(uconfig, 103) 'No. of cells L11 ', level11(iDomain)%nCells
152 20 : write(uconfig, 103) 'Total No. of gauges ', nGaugesTotal
153 : end if
154 : end if
155 :
156 14 : select case (iFlag_cordinate_sys)
157 : case (0)
158 26 : write(uconfig, 301) 'Domain ', domainID, ' Hydrology Resolution [m] ', resolutionHydrology(iDomain)
159 26 : if (domainMeta%doRouting(iDomain)) then
160 20 : write(uconfig, 301) 'Domain ', domainID, ' Routing Resolution [m] ', resolutionRouting(iDomain)
161 : end if
162 : case(1)
163 0 : write(uconfig, 302) 'Domain ', domainID, ' Hydrology Resolution [o] ', resolutionHydrology(iDomain)
164 26 : if (domainMeta%doRouting(iDomain)) then
165 0 : write(uconfig, 302) 'Domain ', domainID, ' Routing Resolution [o] ', resolutionRouting(iDomain)
166 : end if
167 : end select
168 : end do
169 14 : write(uconfig, 126) 'Flag READ restart ', read_restart
170 14 : write(uconfig, 126) 'Flag WRITE restart ', write_restart
171 : !
172 : !******************
173 : ! Model Run period
174 : !******************
175 40 : do iDomain = 1, domainMeta%nDomains
176 26 : domainID = domainMeta%indices(iDomain)
177 26 : write(uconfig, 115) ' Model Run Periods for Domain ', num2str(domainID)
178 : write(uconfig, 116) &
179 26 : 'From To', &
180 52 : ' Day Month Year Day Month Year'
181 : write(uconfig, 117) &
182 26 : 'Warming Period (1) ', &
183 26 : warmPer(iDomain)%dStart, warmPer(iDomain)%mStart, warmPer(iDomain)%yStart, &
184 52 : warmPer(iDomain)%dEnd, warmPer(iDomain)%mEnd, warmPer(iDomain)%yEnd
185 : write(uconfig, 117) &
186 26 : 'Evaluation Period (2) ', &
187 26 : evalPer(iDomain)%dStart, evalPer(iDomain)%mStart, evalPer(iDomain)%yStart, &
188 52 : evalPer(iDomain)%dEnd, evalPer(iDomain)%mEnd, evalPer(iDomain)%yEnd
189 : write(uconfig, 117) &
190 26 : 'Simulation Period (1)+(2) ', &
191 26 : SimPer(iDomain)%dStart, SimPer(iDomain)%mStart, SimPer(iDomain)%yStart, &
192 66 : SimPer(iDomain)%dEnd, SimPer(iDomain)%mEnd, SimPer(iDomain)%yEnd
193 : end do
194 :
195 : !*********************************
196 : ! Model Land Cover Observations
197 : !*********************************
198 40 : do iDomain = 1, domainMeta%nDomains
199 26 : domainID = domainMeta%indices(iDomain)
200 26 : write(uconfig, 118) ' Land Cover Observations for Domain ', num2str(domainID)
201 26 : write(uconfig, 119) ' Start Year', ' End Year', ' Land cover scene', 'Land Cover File'
202 92 : do i = 1, nLCoverScene
203 52 : write(uconfig, 120) LC_year_start(i), LC_year_end(i), &
204 130 : LCyearId(max(evalPer(iDomain)%yStart, LC_year_start(i)), iDomain), trim(LCfilename(i))
205 : end do
206 : end do
207 : !*********************************
208 : ! Initial Parameter Ranges
209 : !*********************************
210 14 : write(uconfig, 121) ' Initial Transfer Function Parameter Ranges (gammas) '
211 : !
212 : ! Transfer functions
213 : write(uconfig, 122) &
214 14 : ' i', ' min', ' max', ' current', &
215 28 : ' name'
216 757 : do i = 1, size(global_parameters, 1)
217 : write(uconfig, 123) &
218 743 : i, global_parameters(i, 1), global_parameters(i, 2), global_parameters(i, 3), &
219 1500 : trim(adjustl(global_parameters_name(i)))
220 : end do
221 : ! domain runoff data
222 14 : if (processMatrix(8, 1) > 0) then
223 13 : write(uconfig, 202) ' Domain Runoff Data '
224 13 : write(uconfig, 107) ' Gauge No.', ' Domain Id', ' Qmax[m3/s]', ' Qmin[m3/s]'
225 35 : do i = 1, nGaugesLocal
226 766 : if(any(gauge%Q(:, i) > nodata_dp)) then
227 10632 : write(uconfig, 108) i, gauge%domainId(i), maxval(gauge%Q(:, i), gauge%Q(:, i) > nodata_dp), &
228 10653 : minval(gauge%Q(:, i), gauge%Q(:, i) > nodata_dp)
229 : else
230 1 : write(uconfig, 108) i, gauge%domainId(i), nodata_dp, nodata_dp
231 : end if
232 : end do
233 : end if
234 : ! inflow gauge data
235 14 : if (nInflowGaugesTotal .GT. 0) then
236 1 : write(uconfig, 202) ' Domain Inflow Data '
237 1 : write(uconfig, 107) ' Gauge No.', ' Domain Id', ' Qmax[m3/s]', ' Qmin[m3/s]'
238 3 : do i = 1, nInflowGaugesTotal
239 1095 : if(all(InflowGauge%Q(:, i) > nodata_dp)) then
240 1096 : write(uconfig, 108) i, InflowGauge%domainId(i), maxval(InflowGauge%Q(:, i), InflowGauge%Q(:, i) > nodata_dp), &
241 1098 : minval(InflowGauge%Q(:, i), InflowGauge%Q(:, i) > nodata_dp)
242 : else
243 0 : write(uconfig, 108) i, InflowGauge%domainId(i), nodata_dp, nodata_dp
244 : end if
245 : end do
246 : end if
247 :
248 : ! domain config
249 14 : write(uconfig, 218) 'Domain-wise Configuration'
250 40 : do iDomain = 1, domainMeta%nDomains
251 26 : domainID = domainMeta%indices(iDomain)
252 : !ST has to be moved to the config write of mRM
253 : ! if (domainMeta%doRouting(iDomain)) then
254 : ! write(uconfig,103) 'Domain No. ', domainID, &
255 : ! 'No. of gauges ', domain%nGauges(iDomain)
256 : ! end if
257 :
258 26 : write(uconfig, 222) 'Directory list'
259 :
260 26 : write(uconfig, 224) 'Directory to morphological input ', dirMorpho(iDomain)
261 26 : write(uconfig, 224) 'Directory to land cover input ', dirLCover(iDomain)
262 26 : if (domainMeta%doRouting(iDomain)) then
263 20 : write(uconfig, 224) 'Directory to gauging station input ', dirGauges(iDomain)
264 : end if
265 26 : write(uconfig, 224) 'Directory to precipitation input ', dirPrecipitation(iDomain)
266 26 : write(uconfig, 224) 'Directory to temperature input ', dirTemperature(iDomain)
267 26 : write(uconfig, 224) 'Directory to reference ET input ', dirReferenceET(iDomain)
268 26 : write(uconfig, 224) 'Directory to write output by default ', dirOut(iDomain)
269 26 : write(uconfig, 224) 'File to write mHM output when restarted ', mhmFileRestartOut(iDomain)
270 :
271 40 : if (domainMeta%doRouting(iDomain)) then
272 20 : write(uconfig, 102) 'River Network (Routing level)'
273 20 : write(uconfig, 100) 'Label 0 = intermediate draining cell '
274 20 : write(uconfig, 100) 'Label 1 = headwater cell '
275 20 : write(uconfig, 100) 'Label 2 = sink cell '
276 :
277 20 : if (processMatrix(8, 1) .eq. 1_i4) then
278 16 : write(uconfig, 104) ' Overall', &
279 16 : ' From', &
280 16 : ' To', &
281 16 : ' Routing', &
282 16 : ' Label', &
283 16 : ' Length', &
284 16 : ' Mean', &
285 16 : ' Link', &
286 16 : ' Routing', &
287 16 : ' Routing', &
288 16 : ' Sequence', &
289 16 : ' ', &
290 16 : ' ', &
291 32 : ' Slope'
292 : !
293 16 : write(uconfig, 105) ' Id', &
294 16 : ' Node', &
295 16 : ' Node', &
296 16 : '', &
297 16 : '', &
298 16 : ' [km]', &
299 32 : ' [o/oo]'
300 : !
301 664 : do j = level11(iDomain)%iStart, level11(iDomain)%iEnd - L11_nOutlets(iDomain)
302 648 : i = L11_netPerm(j) + level11(iDomain)%iStart - 1 ! adjust permutation for multi-domain option
303 648 : write(uconfig, 106) i, L11_fromN(i), L11_toN(i), L11_rOrder(i), L11_label(i), &
304 1312 : L11_length(i) / 1000.0_dp, L11_slope(i) * 1.0e3_dp
305 : end do
306 :
307 4 : else if (processMatrix(8, 1) .eq. 2_i4) then
308 1 : write(uconfig, 134) ' Overall', &
309 1 : ' From', &
310 1 : ' To', &
311 1 : ' Routing', &
312 1 : ' Label', &
313 1 : ' Link', &
314 1 : ' Routing', &
315 1 : ' Routing', &
316 1 : ' Sequence', &
317 2 : ' '
318 : !
319 1 : write(uconfig, 135) ' Id', &
320 1 : ' Node', &
321 1 : ' Node', &
322 1 : '', &
323 2 : ''
324 : !
325 34 : do j = level11(iDomain)%iStart, level11(iDomain)%iEnd - L11_nOutlets(iDomain)
326 33 : i = L11_netPerm(j) + level11(iDomain)%iStart - 1 ! adjust permutation for multi-domain option
327 34 : write(uconfig, 136) i, L11_fromN(i), L11_toN(i), L11_rOrder(i), L11_label(i)
328 : end do
329 : end if
330 : ! draining node at L11
331 20 : write(uconfig, 109) ' Overall', ' Domain', &
332 20 : ' Cell', ' Routing', &
333 40 : ' Id', ' Node Id'
334 820 : do i = 1, level11(iDomain)%nCells
335 820 : write(uconfig, 110) i
336 : end do
337 :
338 : ! L1 level information
339 20 : write(uconfig, 111) ' Modeling', ' Routing', ' Effective', &
340 20 : ' Cell', ' Cell Id', ' Area', &
341 40 : ' Id', ' [-]', ' [km2]'
342 :
343 895 : do i = 1, level1(iDomain)%nCells
344 895 : write(uconfig, 113) i, L1_L11_Id(i), level1(iDomain)%CellArea(i) * 1.0E-6_dp
345 : end do
346 895 : write(uconfig, 114) ' Total[km2]', sum(level1(iDomain)%CellArea) * 1.0E-6_dp
347 : end if
348 : !
349 : end do
350 :
351 14 : write(uconfig, *)
352 14 : close(uconfig)
353 :
354 : !! Formats
355 : 100 format (a80)
356 : 102 format (/ 30('-') / a30 / 30('-'))
357 : 103 format (a20, 10x, i10)
358 : 104 format (/ 75('-') / 5a10, 5x, 2a10 / 5a10, 5x, 2a10)
359 : 105 format (5a10, 5x, 2a10 / 75('-'))
360 : 106 format (5i10, 5x, 2f10.3)
361 : 107 format (2a10, 2a15)
362 : 108 format (2i10, 2f15.3)
363 : !
364 : 109 format (/ 20('-') / 2a10 / 2a10 / 2a10 / 20('-'))
365 : 110 format (i10)
366 : !
367 : 111 format (/ 30('-') / 3a10 / 3a10 / 3a10 / 30('-'))
368 : 113 format (2i10, 1f10.3)
369 : 114 format (30('-') / a15, 5x, 1f10.3 /)
370 : !
371 : 115 format (/61('-')/ a50, a10 /61('-'))
372 : 116 format (39x, a22 / 25x, a36)
373 : 117 format (3(a25, 6(i6)))
374 : !
375 : 118 format (/50('-')/ a40, a10 /50('-'))
376 : 119 format (a10, a10, a20, a20/)
377 : 120 format (i10, i10, 10x, i10, a20)
378 : !
379 : 121 format (/55('-')/ a55 /55('-'))
380 : 122 format (a10, 3a15, a35)
381 : 123 format (i10, 3f15.3, a35)
382 : !
383 : 126 format (a30, 9x, L1)
384 : !
385 : 134 format (/ 50('-') / 5a10 / 5a10)
386 : 135 format (5a10 / 50('-'))
387 : 136 format (5i10)
388 : !
389 : 200 format (80('-'))
390 : 201 format (a80)
391 : 202 format (/50('-')/ a50 /50('-'))
392 : !
393 : 218 format (/ 80('-')/ 26x, a24, 26x, /80('-'))
394 : 222 format (/80('-')/ 26x, a21 /80('-'))
395 : 224 format (a40, 5x, a256)
396 :
397 : 301 format (a7, i2, a32, f15.0)
398 : 302 format (a7, i2, a32, es20.8)
399 14 : end Subroutine write_configfile
400 :
401 :
402 : ! ------------------------------------------------------------------
403 :
404 : ! NAME
405 : ! write_optifile
406 :
407 : ! PURPOSE
408 : !> \brief Write briefly final optimization results.
409 :
410 : !> \details Write overall best objective function and the best optimized parameter set to a file_opti.
411 :
412 : ! INTENT(IN)
413 : !> \param[in] "real(dp) :: best_OF" best objective function value as returnedby the
414 : !> optimization routine
415 : !> \param[in] "real(dp), dimension(:) :: best_paramSet" best associated global parameter setCalled only
416 : !> when optimize is .TRUE.
417 : !> \param[in] "character(len = *), dimension(:) :: param_names"
418 :
419 : ! HISTORY
420 : !> \authors David Schaefer
421 :
422 : !> \date July 2013
423 :
424 : ! Modifications:
425 : ! Rohini Kumar Aug 2013 - change in structure of the code including call statements
426 : ! Juliane Mai Oct 2013 - clear parameter names added
427 : ! - double precision written
428 : ! Robert Schweppe Jun 2018 - refactoring and reformatting
429 : ! M. Cuneyd Demirel, Simon Stisen Jun 2020 - added Feddes and FC dependency on root fraction coefficient processCase(3) = 4
430 :
431 10 : subroutine write_optifile(best_OF, best_paramSet, param_names)
432 :
433 14 : use mo_common_mhm_mrm_file, only : file_opti, uopti
434 : use mo_common_variables, only : dirConfigOut
435 : use mo_string_utils, only : num2str
436 : use mo_os, only : check_path_isdir
437 :
438 : implicit none
439 :
440 : ! best objective function value as returnedby the optimization routine
441 : real(dp), intent(in) :: best_OF
442 :
443 : ! best associated global parameter setCalled only when optimize is .TRUE.
444 : real(dp), dimension(:), intent(in) :: best_paramSet
445 :
446 : character(len = *), dimension(:), intent(in) :: param_names
447 :
448 : character(256) :: fName, formHeader, formParams
449 :
450 : integer(i4) :: ii, err, n_params
451 :
452 :
453 : ! number of parameters
454 5 : n_params = size(best_paramSet)
455 :
456 : ! open file
457 5 : fName = trim(adjustl(dirConfigOut)) // trim(adjustl(file_opti))
458 : !checking whether the directory exists where the file shall be created or opened
459 5 : call check_path_isdir(trim(adjustl(dirConfigOut)), raise=.true.)
460 5 : open(uopti, file = fName, status = 'unknown', action = 'write', iostat = err, recl = (n_params + 1) * 40)
461 5 : if(err .ne. 0) then
462 0 : call error_message(' IOError while openening "', trim(fName), '". Error-Code ', num2str(err))
463 : end if
464 :
465 : ! header
466 5 : write(formHeader, *) '(a40,', n_params, 'a40)'
467 : ! len(param_names(1))=256 but only 39 characters taken here
468 : ! write(uopti, formHeader) 'OF', (trim(adjustl(param_names(ii))), ii=1, n_params)
469 273 : write(uopti, formHeader) 'OF', (trim(adjustl(param_names(ii)(1 : 39))), ii = 1, n_params)
470 :
471 : ! output
472 5 : write(formParams, *) '( es40.14, ', n_params, '(es40.14) )'
473 273 : write(uopti, formParams) best_OF, (best_paramSet(ii), ii = 1, n_params)
474 :
475 : ! close file
476 5 : close(uopti)
477 :
478 : ! screen output
479 5 : call message()
480 5 : call message(' Optimized parameters written to ', trim(fName))
481 :
482 5 : end subroutine write_optifile
483 :
484 : ! ------------------------------------------------------------------
485 :
486 : ! NAME
487 : ! write_optinamelist
488 :
489 : ! PURPOSE
490 : !> \brief Write final, optimized parameter set in a namelist format.
491 :
492 : !> \details Write final, optimized parameter set in a namelist format.
493 : !> Only parameters of processes which were switched on are written to the namelist.
494 : !> All others are discarded.
495 :
496 : ! INTENT(IN)
497 : !> \param[in] "integer(i4), dimension(nProcesses, 3) :: processMatrix" information about which
498 : !> process
499 : !> case was used
500 : !> \param[in] "real(dp), dimension(:, :) :: parameters" (min, max, opti)
501 : !> \param[in] "logical, dimension(size(parameters, 1)) :: maskpara" .true. if parameter was
502 : !> calibrated
503 : !> \param[in] "character(len = *), dimension(size(parameters, 1)) :: parameters_name" clear names of parameters
504 :
505 : ! HISTORY
506 : !> \authors Juliane Mai
507 :
508 : !> \date Dec 2013
509 :
510 : ! Modifications:
511 : ! Stephan Thober Nov 2016 - moved nProcesses to common variables
512 : ! Stephan Thober Nov 2016 - write namelist for routing process 2
513 : ! Robert Schweppe Jun 2018 - refactoring and reformatting
514 :
515 5 : subroutine write_optinamelist(processMatrix, parameters, maskpara, parameters_name)
516 :
517 5 : use mo_common_mhm_mrm_file, only : file_opti_nml, uopti_nml
518 : use mo_common_variables, only : dirConfigOut, nProcesses
519 : use mo_string_utils, only : num2str
520 : use mo_os, only : check_path_isdir
521 :
522 : implicit none
523 :
524 : ! information about which process
525 : ! case was used
526 : integer(i4), dimension(nProcesses, 3), intent(in) :: processMatrix
527 :
528 : ! (min, max, opti)
529 : real(dp), dimension(:, :), intent(in) :: parameters
530 :
531 : ! .true. if parameter was calibrated
532 : logical, dimension(size(parameters, 1)), intent(in) :: maskpara
533 :
534 : ! clear names of parameters
535 : character(len = *), dimension(size(parameters, 1)), intent(in) :: parameters_name
536 :
537 : character(256) :: fName
538 :
539 : character(len = 28), dimension(nProcesses) :: Process_descr
540 :
541 : integer(i4) :: err, flag
542 :
543 : integer(i4) :: iProc, iPar, iPar_start
544 :
545 :
546 5 : Process_descr(1) = 'interception'
547 5 : Process_descr(2) = 'snow'
548 5 : Process_descr(3) = 'soilmoisture'
549 5 : Process_descr(4) = 'directSealedAreaRunoff'
550 5 : Process_descr(5) = 'potential evapotranspiration'
551 5 : Process_descr(6) = 'interflow'
552 5 : Process_descr(7) = 'percolation'
553 5 : Process_descr(8) = 'routing'
554 5 : Process_descr(9) = 'geology'
555 5 : Process_descr(10) = 'neutrons'
556 :
557 : ! open file
558 5 : fName = trim(adjustl(dirConfigOut)) // trim(adjustl(file_opti_nml))
559 : !checking whether the directory exists where the file shall be created or opened
560 5 : call check_path_isdir(trim(adjustl(dirConfigOut)), raise=.true.)
561 5 : open(uopti_nml, file = fName, status = 'unknown', action = 'write', iostat = err)
562 5 : if(err .ne. 0) then
563 0 : call error_message(' IOError while openening "', trim(fName), '". Error-Code ', num2str(err))
564 : end if
565 :
566 5 : write(uopti_nml, *) '!global_parameters'
567 5 : write(uopti_nml, '( A47,T50,3(A20,2x),2(A8,1x) )') "!PARAMETER", "lower_bound", "upper_bound", "value", "FLAG", "SCALING"
568 :
569 5 : iPar_start = 1
570 60 : do iProc = 1, nProcesses
571 :
572 55 : write(uopti_nml, *) '! ', trim(adjustl(process_descr(iProc)))
573 :
574 : select case (iProc)
575 : case(1)
576 5 : if (processMatrix(iProc, 1) .eq. 1) then
577 5 : write(uopti_nml, *) '&interception1'
578 : end if
579 : case(2)
580 5 : if (processMatrix(iProc, 1) .eq. 1) then
581 5 : write(uopti_nml, *) '&snow1'
582 : end if
583 : case(3)
584 5 : select case (processMatrix(iProc, 1))
585 : case(1)
586 5 : write(uopti_nml, *) '&soilmoisture1'
587 : case(2)
588 0 : write(uopti_nml, *) '&soilmoisture2'
589 : case(3)
590 0 : write(uopti_nml, *) '&soilmoisture3'
591 : case(4)
592 0 : write(uopti_nml, *) '&soilmoisture4'
593 : end select
594 : case(4)
595 5 : if (processMatrix(iProc, 1) .eq. 1) then
596 5 : write(uopti_nml, *) '&directRunoff1'
597 : end if
598 : case(5)
599 5 : select case (processMatrix(iProc, 1))
600 : case(-1)
601 0 : write(uopti_nml, *) '&PETminus1'
602 : case(0)
603 4 : write(uopti_nml, *) '&PET0'
604 : case(1)
605 0 : write(uopti_nml, *) '&PET1'
606 : case(2)
607 0 : write(uopti_nml, *) '&PET2'
608 : case(3)
609 1 : write(uopti_nml, *) '&PET3'
610 : end select
611 : case(6)
612 5 : if (processMatrix(iProc, 1) .eq. 1) then
613 5 : write(uopti_nml, *) '&interflow1'
614 : end if
615 : case(7)
616 5 : if (processMatrix(iProc, 1) .eq. 1) then
617 5 : write(uopti_nml, *) '&percolation1'
618 : end if
619 : case(8)
620 5 : if (processMatrix(iProc, 1) .eq. 1) then
621 4 : write(uopti_nml, *) '&routing1'
622 : end if
623 5 : if (processMatrix(iProc, 1) .eq. 2) then
624 0 : write(uopti_nml, *) '&routing2'
625 : end if
626 5 : if (processMatrix(iProc, 1) .eq. 3) then
627 1 : write(uopti_nml, *) '&routing3'
628 : end if
629 : case(9)
630 5 : if (processMatrix(iProc, 1) .eq. 1) then
631 5 : write(uopti_nml, *) '&geoparameter'
632 : end if
633 : case(10)
634 55 : if (processMatrix(iProc, 1) .ge. 1) then
635 1 : write(uopti_nml, *) '&neutrons1'
636 : end if
637 : end select
638 :
639 323 : do iPar = iPar_Start, processMatrix(iProc, 3)
640 :
641 268 : if (maskpara(iPar)) then
642 239 : flag = 1
643 : else
644 29 : flag = 0
645 : end if
646 :
647 : write(uopti_nml, '( A47," = ",T50,3(f20.12,", "),I8,", 1" )') &
648 268 : trim(adjustl(parameters_name(iPar))), &
649 268 : parameters(iPar, 1), &
650 268 : parameters(iPar, 2), &
651 268 : parameters(iPar, 3), &
652 591 : flag
653 : end do
654 :
655 55 : iPar_Start = processMatrix(iProc, 3) + 1
656 :
657 55 : write(uopti_nml, *) '/'
658 60 : write(uopti_nml, *) ' '
659 :
660 : end do ! loop over processes
661 :
662 : ! close file
663 5 : close(uopti_nml)
664 :
665 : ! screen output
666 5 : call message()
667 5 : call message(' Optimized parameters written in namelist format to ', trim(fName))
668 :
669 5 : end subroutine write_optinamelist
670 :
671 : END MODULE mo_write_ascii
|
