5.13.2
mHM
The mesoscale Hydrological Model
Loading...
Searching...
No Matches
mo_upscaling_operators.f90
Go to the documentation of this file.
1!> \file mo_upscaling_operators.f90
2!> \brief \copybrief mo_upscaling_operators
3!> \details \copydetails mo_upscaling_operators
4
5!> \brief Module containing upscaling operators.
6!> \details This module provides the routines for upscaling_operators.
7!> \authors Giovanni Dalmasso, Rohini Kumar
8!> \date Dec 2012
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_mpr
12module mo_upscaling_operators
13
14 ! This module contains the functions for upscaling grid L0_fineScale_2D_data.
15
16 ! Written Giovanni Dalmasso, Rohini Kumar, Dec 2012
17
18 use mo_kind, only : i4, dp
19
20 implicit none
21
22 private
23
24 public :: majority_statistics ! upscale grid L0_fineScale_2D_data based on a majority statistics
25 public :: l0_fractionalcover_in_lx ! fractional coverage of a given class of L0 fields in Lx field (Lx = L1 or L11)
26 public :: upscale_arithmetic_mean ! upscale grid L0_fineScale_2D_data based on a ARITHMETIC MEAN
27 public :: upscale_harmonic_mean ! upscale grid L0_fineScale_2D_data based on a HARMONIC MEAN
28 public :: upscale_geometric_mean ! upscale grid L0_fineScale_2D_data based on a GEOMETRIC MEAN
29
30contains
31
32 ! ----------------------------------------------------------------------------
33
34 ! NAME
35 ! majority_statistics
36
37 ! PURPOSE
38 !> \brief majority statistics
39
40 !> \details upscale grid L0_fineScale_2D_data based on a majority statistics
41
42 ! INTENT(IN)
43 !> \param[in] "integer(i4) :: nClass" number of classes
44 !> \param[in] "integer(i4), dimension(:) :: L1_upper_rowId_cell" upper row boundary (level-0) of a level-1
45 !> cell
46 !> \param[in] "integer(i4), dimension(:) :: L1_lower_rowId_cell" lower row boundary (level-0) of a level-1
47 !> cell
48 !> \param[in] "integer(i4), dimension(:) :: L1_left_colonId_cell" left colon boundary (level-0) of a level-1
49 !> cell
50 !> \param[in] "integer(i4), dimension(:) :: L1_right_colonId_cell" right colon boundary (level-0) of a level-1
51 !> cell
52 !> \param[in] "integer(i4), dimension(:, :) :: L0_fineScale_2D_data" high resolution data
53
54 ! RETURN
55 !> \return integer(i4) :: majority_statistics(:) — Upscaled variable based on majority.
56
57 ! HISTORY
58 !> \authors Giovanni Dalmasso, Rohini Kumar
59
60 !> \date Dec 2012
61
62 ! Modifications:
63 ! Robert Schweppe Jun 2018 - refactoring and reformatting
64
65 function majority_statistics(nClass, L1_upper_rowId_cell, L1_lower_rowId_cell, L1_left_colonId_cell, &
66 L1_right_colonId_cell, L0_fineScale_2D_data)
67 implicit none
68
69 ! number of classes
70 integer(i4), intent(in) :: nclass
71
72 ! upper row boundary (level-0) of a level-1 cell
73 integer(i4), dimension(:), intent(in) :: l1_upper_rowid_cell
74
75 ! lower row boundary (level-0) of a level-1 cell
76 integer(i4), dimension(:), intent(in) :: l1_lower_rowid_cell
77
78 ! left colon boundary (level-0) of a level-1 cell
79 integer(i4), dimension(:), intent(in) :: l1_left_colonid_cell
80
81 ! right colon boundary (level-0) of a level-1 cell
82 integer(i4), dimension(:), intent(in) :: l1_right_colonid_cell
83
84 ! high resolution data
85 integer(i4), dimension(:, :), intent(in) :: l0_finescale_2d_data
86
87 integer(i4), dimension(size(L1_upper_rowId_cell, 1)) :: majority_statistics
88
89 integer(i4) :: l1_ncells
90
91 integer(i4) :: iu, id, jl, jr
92
93 integer(i4) :: nc
94
95 integer(i4) :: max_val
96
97 integer(i4) :: kk, ll
98
99
100 l1_ncells = size(majority_statistics, 1)
101
102 do kk = 1, l1_ncells
103 iu = l1_upper_rowid_cell(kk)
104 id = l1_lower_rowid_cell(kk)
105 jl = l1_left_colonid_cell(kk)
106 jr = l1_right_colonid_cell(kk)
107
108 max_val = -9999
109 do ll = 1, nclass
110 nc = count(l0_finescale_2d_data(iu : id, jl : jr) == ll)
111 if(nc > max_val) then
112 majority_statistics(kk) = ll
113 max_val = nc
114 end if
115 end do
116 end do
117
118 end function majority_statistics
119
120 ! ------------------------------------------------------------------
121
122 ! NAME
123 ! L0_fractionalCover_in_Lx
124
125 ! PURPOSE
126 !> \brief fractional coverage of a given class of L0 fields in Lx field (Lx = L1 or L11)
127
128 !> \details Fractional coverage of a given class of L0 fields in Lx field (Lx = L1 or L11).
129 !> For example, this routine can be used for calculating the karstic fraction.
130
131 ! INTENT(IN)
132 !> \param[in] "integer(i4), dimension(:) :: dataIn0" input fields at finer scale
133 !> \param[in] "integer(i4) :: classId" class id for which fraction has to be estimated
134 !> \param[in] "logical, dimension(:, :) :: mask0" finer scale L0 mask
135 !> \param[in] "integer(i4), dimension(:) :: L0upBound_inLx" row start at finer L0 scale
136 !> \param[in] "integer(i4), dimension(:) :: L0downBound_inLx" row end at finer L0 scale
137 !> \param[in] "integer(i4), dimension(:) :: L0leftBound_inLx" col start at finer L0 scale
138 !> \param[in] "integer(i4), dimension(:) :: L0rightBound_inLx" col end at finer L0 scale
139 !> \param[in] "integer(i4), dimension(:) :: nTCells0_inLx" total number of valid L0 cells in a given Lx cell
140
141 ! RETURN
142 !> \return real(dp) :: L0_fractionalCover_in_Lx(:) — packed 1D fraction coverage (Lx) of given class id
143
144 ! HISTORY
145 !> \authors Rohini Kumar
146
147 !> \date Feb 2013
148
149 ! Modifications:
150 ! Robert Schweppe Jun 2018 - refactoring and reformatting
151
152 function l0_fractionalcover_in_lx(dataIn0, classId, mask0, L0upBound_inLx, L0downBound_inLx, L0leftBound_inLx, &
153 L0rightBound_inLx, nTCells0_inLx) result(frac_cover_Lx)
154
155 use mo_common_constants, only : nodata_i4
156
157 implicit none
158
159 ! input fields at finer scale
160 integer(i4), dimension(:), intent(in) :: datain0
161
162 ! class id for which fraction has to be estimated
163 integer(i4), intent(in) :: classid
164
165 ! finer scale L0 mask
166 logical, dimension(:, :), intent(in) :: mask0
167
168 ! row start at finer L0 scale
169 integer(i4), dimension(:), intent(in) :: l0upbound_inlx
170
171 ! row end at finer L0 scale
172 integer(i4), dimension(:), intent(in) :: l0downbound_inlx
173
174 ! col start at finer L0 scale
175 integer(i4), dimension(:), intent(in) :: l0leftbound_inlx
176
177 ! col end at finer L0 scale
178 integer(i4), dimension(:), intent(in) :: l0rightbound_inlx
179
180 ! total number of valid L0 cells in a given Lx cell
181 integer(i4), dimension(:), intent(in) :: ntcells0_inlx
182
183 real(dp), dimension(size(L0upBound_inLx, 1)) :: frac_cover_lx
184
185 integer(i4) :: kk, iu, id, jl, jr, nt
186
187 integer(i4) :: nrows0, ncols0
188
189 integer(i4), dimension(:, :), allocatable :: dummy_matrix
190
191 integer(i4), dimension(:, :), allocatable :: nodata_val
192
193 integer(i4) :: ncells1
194
195
196 ! estimate number of cells
197 ncells1 = size(l0upbound_inlx, 1)
198
199 ! get nrows and ncols
200 nrows0 = size(mask0, 1)
201 ncols0 = size(mask0, 2)
202
203 !unpack input data from 1D to 2D
204 allocate(dummy_matrix(nrows0, ncols0))
205 allocate(nodata_val(nrows0, ncols0))
206 nodata_val(:, :) = nodata_i4
207 dummy_matrix(:, :) = unpack(datain0(:), mask0(:, :), nodata_val(:, :))
208
209 ! initalize return variable
210 frac_cover_lx(:) = 0.0_dp
211
212 ! start calculation
213 do kk = 1, ncells1
214 iu = l0upbound_inlx(kk)
215 id = l0downbound_inlx(kk)
216 jl = l0leftbound_inlx(kk)
217 jr = l0rightbound_inlx(kk)
218 nt = ntcells0_inlx(kk)
219
220 frac_cover_lx(kk) = real(count(dummy_matrix(iu : id, jl : jr) == classid), dp) / real(nt, dp)
221
222 end do
223
224 ! free space
225 deallocate(dummy_matrix, nodata_val)
226
227 end function l0_fractionalcover_in_lx
228
229 ! ----------------------------------------------------------------------------
230
231 ! NAME
232 ! upscale_arithmetic_mean
233
234 ! PURPOSE
235 !> \brief aritmetic mean
236
237 !> \details upscaling of level-0 grid data to level-1 using aritmetic mean
238
239 ! INTENT(IN)
240 !> \param[in] "integer(i4), dimension(:) :: nL0_cells_in_L1_cell" number of level-0 cells within a level-1 cell
241 !> \param[in] "integer(i4), dimension(:) :: L1_upper_rowId_cell" upper row boundary (level-0) of a level-1
242 !> cell
243 !> \param[in] "integer(i4), dimension(:) :: L1_lower_rowId_cell" lower row boundary (level-0) of a level-1
244 !> cell
245 !> \param[in] "integer(i4), dimension(:) :: L1_left_colonId_cell" left colon boundary (level-0) of a level-1
246 !> cell
247 !> \param[in] "integer(i4), dimension(:) :: L1_right_colonId_cell" right colon boundary (level-0) of a level-1
248 !> cell
249 !> \param[in] "integer(i4), dimension(:) :: L0_cellId" cell ID at level-0
250 !> \param[in] "logical, dimension(:, :) :: mask0" mask at level 0
251 !> \param[in] "real(dp) :: nodata_value" no data value
252 !> \param[in] "real(dp), dimension(:) :: L0_fineScale_data" high resolution data
253
254 ! RETURN
255 !> \return real(dp) :: upscale_arithmetic_mean(:) — Upscaled variable from L0 to L1 using arithmetic mean
256
257 ! HISTORY
258 !> \authors Giovanni Dalmasso, Rohini Kumar
259
260 !> \date Dec 2012
261
262 ! Modifications:
263 ! Stephan Thober Feb 2013 - changed dimension of L0 input from 2d to 1d
264 ! Robert Schweppe Jun 2018 - refactoring and reformatting
265
266 function upscale_arithmetic_mean(nL0_cells_in_L1_cell, L1_upper_rowId_cell, L1_lower_rowId_cell, L1_left_colonId_cell, &
267 L1_right_colonId_cell, L0_cellId, mask0, nodata_value, L0_fineScale_data)
268 implicit none
269
270 ! number of level-0 cells within a level-1 cell
271 integer(i4), dimension(:), intent(in) :: nl0_cells_in_l1_cell
272
273 ! upper row boundary (level-0) of a level-1 cell
274 integer(i4), dimension(:), intent(in) :: l1_upper_rowid_cell
275
276 ! lower row boundary (level-0) of a level-1 cell
277 integer(i4), dimension(:), intent(in) :: l1_lower_rowid_cell
278
279 ! left colon boundary (level-0) of a level-1 cell
280 integer(i4), dimension(:), intent(in) :: l1_left_colonid_cell
281
282 ! right colon boundary (level-0) of a level-1 cell
283 integer(i4), dimension(:), intent(in) :: l1_right_colonid_cell
284
285 ! cell ID at level-0
286 integer(i4), dimension(:), intent(in) :: l0_cellid
287
288 ! mask at level 0
289 logical, dimension(:, :), intent(in) :: mask0
290
291 ! no data value
292 real(dp), intent(in) :: nodata_value
293
294 ! high resolution data
295 real(dp), dimension(:), intent(in) :: l0_finescale_data
296
297 real(dp), dimension(size(nL0_cells_in_L1_cell, 1)) :: upscale_arithmetic_mean
298
299 integer(i4) :: l1_ncells
300
301 integer(i4) :: iu, id, jl, jr
302
303 integer(i4) :: kk
304
305 integer(i4), dimension(size(mask0, 1), size(mask0, 2)) :: nodata_2d
306
307 integer(i4), dimension(size(mask0, 1), size(mask0, 2)) :: l0_cellid_2d
308
309 real(dp), dimension(size(mask0, 1), size(mask0, 2)) :: l0_finescale_2d_data
310
311
312 ! allocation and initialisation
313 upscale_arithmetic_mean(:) = 0.0_dp
314 nodata_2d = int(nodata_value, i4)
315 l0_cellid_2d = unpack(l0_cellid, mask0, nodata_2d)
316 l0_finescale_2d_data = unpack(l0_finescale_data, mask0, nodata_value)
317
318 l1_ncells = size(upscale_arithmetic_mean, 1)
319
320 do kk = 1, l1_ncells
321 iu = l1_upper_rowid_cell(kk)
322 id = l1_lower_rowid_cell(kk)
323 jl = l1_left_colonid_cell(kk)
324 jr = l1_right_colonid_cell(kk)
325 upscale_arithmetic_mean(kk) = sum(l0_finescale_2d_data(iu : id, jl : jr), l0_cellid_2d(iu : id, jl : jr) /= &
326 int(nodata_value, i4)) / real(nl0_cells_in_l1_cell(kk), dp)
327 end do
328
329 end function upscale_arithmetic_mean
330
331 ! ----------------------------------------------------------------------------
332
333 ! NAME
334 ! upscale_harmonic_mean
335
336 ! PURPOSE
337 !> \brief harmonic mean
338
339 !> \details upscaling of level-0 grid data to level-1 using harmonic mean
340
341 ! INTENT(IN)
342 !> \param[in] "integer(i4), dimension(:) :: nL0_cells_in_L1_cell" number of level-0 cells within a level-1 cell
343 !> \param[in] "integer(i4), dimension(:) :: L1_upper_rowId_cell" upper row boundary (level-0) of a level-1
344 !> cell
345 !> \param[in] "integer(i4), dimension(:) :: L1_lower_rowId_cell" lower row boundary (level-0) of a level-1
346 !> cell
347 !> \param[in] "integer(i4), dimension(:) :: L1_left_colonId_cell" left colon boundary (level-0) of a level-1
348 !> cell
349 !> \param[in] "integer(i4), dimension(:) :: L1_right_colonId_cell" right colon boundary (level-0) of a level-1
350 !> cell
351 !> \param[in] "integer(i4), dimension(:) :: L0_cellId" cell ID at level-0
352 !> \param[in] "logical, dimension(:, :) :: mask0" mask at Level 0
353 !> \param[in] "real(dp) :: nodata_value" no data value
354 !> \param[in] "real(dp), dimension(:) :: L0_fineScale_data" high resolution data
355
356 ! RETURN
357 !> \return real(dp) :: upscale_harmonic_mean(:) — Upscaled variable from L0 to L1 using harmonic mean
358
359 ! HISTORY
360 !> \authors Giovanni Dalmasso, Rohini Kumar
361
362 !> \date Dec 2012
363
364 ! Modifications:
365 ! Stephan Thober Jan 2013 - change example calling sequence
366 ! Stephan Thober Feb 2013 - added Level 0 mask
367 ! Robert Schweppe Jun 2018 - refactoring and reformatting
368
369 function upscale_harmonic_mean(nL0_cells_in_L1_cell, L1_upper_rowId_cell, L1_lower_rowId_cell, L1_left_colonId_cell, &
370 L1_right_colonId_cell, L0_cellId, mask0, nodata_value, L0_fineScale_data)
371 implicit none
372
373 ! number of level-0 cells within a level-1 cell
374 integer(i4), dimension(:), intent(in) :: nl0_cells_in_l1_cell
375
376 ! upper row boundary (level-0) of a level-1 cell
377 integer(i4), dimension(:), intent(in) :: l1_upper_rowid_cell
378
379 ! lower row boundary (level-0) of a level-1 cell
380 integer(i4), dimension(:), intent(in) :: l1_lower_rowid_cell
381
382 ! left colon boundary (level-0) of a level-1 cell
383 integer(i4), dimension(:), intent(in) :: l1_left_colonid_cell
384
385 ! right colon boundary (level-0) of a level-1 cell
386 integer(i4), dimension(:), intent(in) :: l1_right_colonid_cell
387
388 ! cell ID at level-0
389 integer(i4), dimension(:), intent(in) :: l0_cellid
390
391 ! mask at Level 0
392 logical, dimension(:, :), intent(in) :: mask0
393
394 ! no data value
395 real(dp), intent(in) :: nodata_value
396
397 ! high resolution data
398 real(dp), dimension(:), intent(in) :: l0_finescale_data
399
400 real(dp), dimension(size(nL0_cells_in_L1_cell, 1)) :: upscale_harmonic_mean
401
402 integer(i4) :: l1_ncells
403
404 integer(i4) :: iu, id, jl, jr
405
406 integer(i4) :: kk
407
408 integer(i4), dimension(size(mask0, 1), size(mask0, 2)) :: nodata_2d
409
410 integer(i4), dimension(size(mask0, 1), size(mask0, 2)) :: l0_cellid_2d
411
412 real(dp), dimension(size(mask0, 1), size(mask0, 2)) :: l0_finescale_2d_data
413
414
415 ! allocation and initialisation
416 upscale_harmonic_mean(:) = 0.0_dp
417 nodata_2d = int(nodata_value, i4)
418 l0_cellid_2d = unpack(l0_cellid, mask0, nodata_2d)
419 l0_finescale_2d_data = unpack(l0_finescale_data, mask0, nodata_value)
420
421 l1_ncells = size(upscale_harmonic_mean, 1)
422
423 do kk = 1, l1_ncells
424 iu = l1_upper_rowid_cell(kk)
425 id = l1_lower_rowid_cell(kk)
426 jl = l1_left_colonid_cell(kk)
427 jr = l1_right_colonid_cell(kk)
428 upscale_harmonic_mean(kk) = real(nl0_cells_in_l1_cell(kk), dp) &
429 / sum(1.0_dp / l0_finescale_2d_data(iu : id, jl : jr), l0_cellid_2d(iu : id, jl : jr) /= int(nodata_value, i4))
430 end do
431
432 end function upscale_harmonic_mean
433
434 ! ----------------------------------------------------------------------------
435
436 ! NAME
437 ! upscale_geometric_mean
438
439 ! PURPOSE
440 !> \brief geometric mean
441
442 !> \details upscaling of level-0 grid data to level-1 using geometric mean
443
444 ! INTENT(IN)
445 !> \param[in] "integer(i4), dimension(:) :: L1_upper_rowId_cell" upper row boundary (level-0) of a level-1
446 !> cell
447 !> \param[in] "integer(i4), dimension(:) :: L1_lower_rowId_cell" lower row boundary (level-0) of a level-1
448 !> cell
449 !> \param[in] "integer(i4), dimension(:) :: L1_left_colonId_cell" left colon boundary (level-0) of a level-1
450 !> cell
451 !> \param[in] "integer(i4), dimension(:) :: L1_right_colonId_cell" right colon boundary (level-0) of a level-1
452 !> cell
453 !> \param[in] "logical, dimension(:, :) :: mask0" mask at level 0
454 !> \param[in] "real(dp) :: nodata_value" no data value
455 !> \param[in] "real(dp), dimension(:) :: L0_fineScale_data" high resolution data
456
457 ! RETURN
458 !> \return real(dp) :: upscale_geometric_mean(:) — Upscaled variable from L0 to L1 using geometric mean
459
460 ! HISTORY
461 !> \authors Giovanni Dalmasso, Rohini Kumar
462
463 !> \date Dec 2012
464
465 ! Modifications:
466 ! Rohini Kumar Jun 2016 - fixed bug
467 ! Robert Schweppe Jun 2018 - refactoring and reformatting
468
469 function upscale_geometric_mean(L1_upper_rowId_cell, L1_lower_rowId_cell, L1_left_colonId_cell, L1_right_colonId_cell, &
470 mask0, nodata_value, L0_fineScale_data)
471
472 use mo_utils, only : ne
473
474 implicit none
475
476 ! upper row boundary (level-0) of a level-1 cell
477 integer(i4), dimension(:), intent(in) :: l1_upper_rowid_cell
478
479 ! lower row boundary (level-0) of a level-1 cell
480 integer(i4), dimension(:), intent(in) :: l1_lower_rowid_cell
481
482 ! left colon boundary (level-0) of a level-1 cell
483 integer(i4), dimension(:), intent(in) :: l1_left_colonid_cell
484
485 ! right colon boundary (level-0) of a level-1 cell
486 integer(i4), dimension(:), intent(in) :: l1_right_colonid_cell
487
488 ! mask at level 0
489 logical, dimension(:, :), intent(in) :: mask0
490
491 ! no data value
492 real(dp), intent(in) :: nodata_value
493
494 ! high resolution data
495 real(dp), dimension(:), intent(in) :: l0_finescale_data
496
497 real(dp), dimension(size(L1_upper_rowId_cell, 1)) :: upscale_geometric_mean
498
499 integer(i4) :: iu, id, jl, jr
500
501 integer(i4) :: kk
502
503 integer(i4) :: ncells_l0_in_l1
504
505 real(dp), dimension(size(mask0, 1), size(mask0, 2)) :: l0_finescale_2d_data
506
507 real(dp), dimension(size(mask0, 1), size(mask0, 2)) :: nodata_2d
508
509 real(dp), dimension(:), allocatable :: dummy_v
510
511
512 ! allocation and initialisation
513 upscale_geometric_mean(:) = nodata_value
514 nodata_2d = nodata_value
515 l0_finescale_2d_data = unpack(l0_finescale_data, mask0, nodata_2d)
516
517 do kk = 1, size(upscale_geometric_mean, 1)
518 iu = l1_upper_rowid_cell(kk)
519 id = l1_lower_rowid_cell(kk)
520 jl = l1_left_colonid_cell(kk)
521 jr = l1_right_colonid_cell(kk)
522 ncells_l0_in_l1 = count(ne(l0_finescale_2d_data(iu : id, jl : jr), nodata_value))
523 allocate(dummy_v(ncells_l0_in_l1))
524 dummy_v(:) = pack(l0_finescale_2d_data(iu : id, jl : jr), mask = (ne(l0_finescale_2d_data(iu : id, jl : jr), nodata_value)))
525 upscale_geometric_mean(kk) = product(dummy_v(:))
526 if(ne(upscale_geometric_mean(kk), 0.0_dp)) then
527 upscale_geometric_mean(kk) = upscale_geometric_mean(kk)**(1.0_dp / real(ncells_l0_in_l1, dp))
528 else
529 upscale_geometric_mean(kk) = 0.0_dp
530 end if
531 deallocate(dummy_v)
532 !!
533 end do
534
535 end function upscale_geometric_mean
536
537
538 ! ----------------------------------------------------------------------------
539
540 ! NAME
541 ! upscale_p_norm
542
543 ! PURPOSE
544 !> \brief aritmetic mean
545
546 !> \details upscaling of level-0 grid data to level-1 using aritmetic mean
547
548 ! INTENT(IN)
549 !> \param[in] "integer(i4), dimension(:) :: nL0_cells_in_L1_cell" number of level-0 cells within a level-1 cell
550 !> \param[in] "integer(i4), dimension(:) :: L1_upper_rowId_cell" upper row boundary (level-0) of a level-1
551 !> cell
552 !> \param[in] "integer(i4), dimension(:) :: L1_lower_rowId_cell" lower row boundary (level-0) of a level-1
553 !> cell
554 !> \param[in] "integer(i4), dimension(:) :: L1_left_colonId_cell" left colon boundary (level-0) of a level-1
555 !> cell
556 !> \param[in] "integer(i4), dimension(:) :: L1_right_colonId_cell" right colon boundary (level-0) of a level-1
557 !> cell
558 !> \param[in] "integer(i4), dimension(:) :: L0_cellId" cell ID at level-0
559 !> \param[in] "logical, dimension(:, :) :: mask0" mask at level 0
560 !> \param[in] "real(dp) :: nodata_value" no data value
561 !> \param[in] "real(dp) :: p_norm" p_norm value
562 !> \param[in] "real(dp), dimension(:) :: L0_fineScale_data" high resolution data
563
564 ! RETURN
565 !> \return real(dp) :: upscale_arithmetic_mean(:) — Upscaled variable from L0 to L1 using arithmetic mean
566
567 ! HISTORY
568 !> \authors Giovanni Dalmasso, Rohini Kumar
569
570 !> \date Dec 2012
571
572 ! Modifications:
573 ! Stephan Thober Feb 2013 - changed dimension of L0 input from 2d to 1d
574 ! Robert Schweppe Jun 2018 - refactoring and reformatting
575
576 function upscale_p_norm(nL0_cells_in_L1_cell, L1_upper_rowId_cell, L1_lower_rowId_cell, L1_left_colonId_cell, &
577 L1_right_colonId_cell, L0_cellId, mask0, nodata_value, p_norm, L0_fineScale_data)
578
579 use mo_utils, only : ne
580
581 implicit none
582
583 ! number of level-0 cells within a level-1 cell
584 integer(i4), dimension(:), intent(in) :: nl0_cells_in_l1_cell
585
586 ! upper row boundary (level-0) of a level-1 cell
587 integer(i4), dimension(:), intent(in) :: l1_upper_rowid_cell
588
589 ! lower row boundary (level-0) of a level-1 cell
590 integer(i4), dimension(:), intent(in) :: l1_lower_rowid_cell
591
592 ! left colon boundary (level-0) of a level-1 cell
593 integer(i4), dimension(:), intent(in) :: l1_left_colonid_cell
594
595 ! right colon boundary (level-0) of a level-1 cell
596 integer(i4), dimension(:), intent(in) :: l1_right_colonid_cell
597
598 ! cell ID at level-0
599 integer(i4), dimension(:), intent(in) :: l0_cellid
600
601 ! mask at level 0
602 logical, dimension(:, :), intent(in) :: mask0
603
604 ! no data value
605 real(dp), intent(in) :: nodata_value
606
607 ! p_norm value
608 real(dp), intent(in) :: p_norm
609
610 ! high resolution data
611 real(dp), dimension(:), intent(in) :: l0_finescale_data
612
613 real(dp), dimension(size(nL0_cells_in_L1_cell, 1)) :: upscale_p_norm
614
615 integer(i4) :: l1_ncells
616
617 integer(i4) :: iu, id, jl, jr
618
619 integer(i4) :: kk
620
621 integer(i4), dimension(size(mask0, 1), size(mask0, 2)) :: nodata_2d
622
623 integer(i4), dimension(size(mask0, 1), size(mask0, 2)) :: l0_cellid_2d
624
625 real(dp), dimension(size(mask0, 1), size(mask0, 2)) :: l0_finescale_2d_data
626
627
628 ! allocation and initialisation
629 upscale_p_norm(:) = 0.0_dp
630 nodata_2d = int(nodata_value, i4)
631 l0_cellid_2d = unpack(l0_cellid, mask0, nodata_2d)
632 l0_finescale_2d_data = unpack(l0_finescale_data, mask0, nodata_value)
633
634 l1_ncells = size(upscale_p_norm, 1)
635
636 if (ne(p_norm, 0.0_dp)) then
637 ! geometric mean special case
638 do kk = 1, l1_ncells
639 iu = l1_upper_rowid_cell(kk)
640 id = l1_lower_rowid_cell(kk)
641 jl = l1_left_colonid_cell(kk)
642 jr = l1_right_colonid_cell(kk)
643 upscale_p_norm(kk) = product(l0_finescale_2d_data(iu : id, jl : jr) ** p_norm, l0_cellid_2d(iu : id, jl : jr) /= &
644 int(nodata_value, i4)) ** (1.0_dp / real(nl0_cells_in_l1_cell(kk), dp))
645 end do
646 else
647 ! all other cases
648 do kk = 1, l1_ncells
649 iu = l1_upper_rowid_cell(kk)
650 id = l1_lower_rowid_cell(kk)
651 jl = l1_left_colonid_cell(kk)
652 jr = l1_right_colonid_cell(kk)
653 upscale_p_norm(kk) = sum(l0_finescale_2d_data(iu : id, jl : jr) ** p_norm, l0_cellid_2d(iu : id, jl : jr) /= &
654 int(nodata_value, i4)) / real(nl0_cells_in_l1_cell(kk), dp) ** (1.0_dp / p_norm)
655 end do
656 end if
657
658 end function upscale_p_norm
659
660
661end module mo_upscaling_operators
mo_common_constants
Provides constants commonly used by mHM, mRM and MPR.
Definition mo_common_constants.f90:15
mo_common_constants::nodata_i4
integer(i4), parameter, public nodata_i4
Definition mo_common_constants.f90:30
mo_upscaling_operators
Module containing upscaling operators.
Definition mo_upscaling_operators.f90:12
mo_upscaling_operators::majority_statistics
integer(i4) function, dimension(size(l1_upper_rowid_cell, 1)), public majority_statistics(nclass, l1_upper_rowid_cell, l1_lower_rowid_cell, l1_left_colonid_cell, l1_right_colonid_cell, l0_finescale_2d_data)
majority statistics
Definition mo_upscaling_operators.f90:67
mo_upscaling_operators::upscale_p_norm
real(dp) function, dimension(size(nl0_cells_in_l1_cell, 1)) upscale_p_norm(nl0_cells_in_l1_cell, l1_upper_rowid_cell, l1_lower_rowid_cell, l1_left_colonid_cell, l1_right_colonid_cell, l0_cellid, mask0, nodata_value, p_norm, l0_finescale_data)
aritmetic mean
Definition mo_upscaling_operators.f90:578
mo_upscaling_operators::upscale_arithmetic_mean
real(dp) function, dimension(size(nl0_cells_in_l1_cell, 1)), public upscale_arithmetic_mean(nl0_cells_in_l1_cell, l1_upper_rowid_cell, l1_lower_rowid_cell, l1_left_colonid_cell, l1_right_colonid_cell, l0_cellid, mask0, nodata_value, l0_finescale_data)
aritmetic mean
Definition mo_upscaling_operators.f90:268
mo_upscaling_operators::upscale_harmonic_mean
real(dp) function, dimension(size(nl0_cells_in_l1_cell, 1)), public upscale_harmonic_mean(nl0_cells_in_l1_cell, l1_upper_rowid_cell, l1_lower_rowid_cell, l1_left_colonid_cell, l1_right_colonid_cell, l0_cellid, mask0, nodata_value, l0_finescale_data)
harmonic mean
Definition mo_upscaling_operators.f90:371
mo_upscaling_operators::upscale_geometric_mean
real(dp) function, dimension(size(l1_upper_rowid_cell, 1)), public upscale_geometric_mean(l1_upper_rowid_cell, l1_lower_rowid_cell, l1_left_colonid_cell, l1_right_colonid_cell, mask0, nodata_value, l0_finescale_data)
geometric mean
Definition mo_upscaling_operators.f90:471
mo_upscaling_operators::l0_fractionalcover_in_lx
real(dp) function, dimension(size(l0upbound_inlx, 1)), public l0_fractionalcover_in_lx(datain0, classid, mask0, l0upbound_inlx, l0downbound_inlx, l0leftbound_inlx, l0rightbound_inlx, ntcells0_inlx)
fractional coverage of a given class of L0 fields in Lx field (Lx = L1 or L11)
Definition mo_upscaling_operators.f90:154