Line data Source code
1 : !> \file mo_mpr_neutrons.f90
2 : !> \brief \copybrief mo_mpr_neutrons
3 : !> \details \copydetails mo_mpr_neutrons
4 :
5 : !> \brief Multiscale parameter regionalization (MPR) for neutrons
6 : !> \details This module contains all routines required for parametrizing neutrons processes.
7 : !> \author Maren Kaluza
8 : !> \date Dec 2017
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
12 : module mo_mpr_neutrons
13 :
14 : use mo_kind, only: i4, dp
15 :
16 : implicit none
17 :
18 : public :: mpr_neutrons
19 :
20 : private
21 :
22 : contains
23 : ! ----------------------------------------------------------------------------
24 :
25 : ! NAME
26 : ! mpr_neutrons
27 :
28 : !> \brief multiscale parameter regionalization for neutrons
29 :
30 : !> \details calculates neutron variables on L0
31 : !> Global parameters needed (see mhm_parameter.nml):\n
32 : !> - param( 1) = Desilets_N0 \n
33 : !> - param( 2) = COSMIC_N0 \n
34 : !> - param( 3) = COSMIC_N1 \n
35 : !> - param( 4) = COSMIC_N2 \n
36 : !> - param( 5) = COSMIC_alpha0 \n
37 : !> - param( 6) = COSMIC_alpha1 \n
38 : !> - param( 7) = COSMIC_L30 \n
39 : !> - param( 8) = COSMIC_L31 \n
40 : !> - param( 9) = COSMIC_LW0 \n
41 : !> - param(10) = COSMIC_LW1 \n
42 :
43 : ! INTENT(IN)
44 : !> \param[in] "real(dp) :: param(10)" - global parameters
45 : !> \param[in] "integer(i4) :: is_present(:)" - indicates whether soiltype is present
46 : !> \param[in] "integer(i4) :: nHorizons(:)" - Number of Horizons per soiltype2
47 : !> \param[in] "integer(i4) :: nTillHorizons(:)" - Number of Tillage Horizons
48 : !> \param[in] "integer(i4) :: LCover0(:)" - land cover ids at level 0
49 : !> \param[in] "real(dp) :: clay(:,:)" - clay content
50 : !> \param[in] "real(dp) :: DbM(:,:)" - mineral Bulk density
51 : !> \param[in] "real(dp) :: Db(:,:)" - Bulk density
52 :
53 : ! INTENT(INOUT)
54 : ! None
55 :
56 : !> INTENT(OUT)
57 : !> \param[out] "real(dp) :: COSMIC_L3_till(:,:,:)" - COSMIC paramter L3 tillage layer
58 : !> \param[out] "real(dp) :: latWat_till(:,:,:)" - lattice water content tillage layer
59 : !> \param[out] "real(dp) :: COSMIC_L3(:,:)" - COSMIC paramter L3 tillage layer
60 : !> \param[out] "real(dp) :: latWat(:,:)" - lattice water contente
61 :
62 : ! INTENT(IN), OPTIONAL
63 : ! None
64 :
65 : ! INTENT(INOUT), OPTIONAL
66 : ! None
67 :
68 : ! INTENT(OUT), OPTIONAL
69 : ! None
70 :
71 : ! RETURN
72 : ! None
73 :
74 : ! RESTRICTIONS
75 : ! None
76 :
77 : ! EXAMPLE
78 : ! None
79 :
80 : ! LITERATURE
81 : ! None
82 :
83 : ! HISTORY
84 : !> \author Maren Kaluza
85 : !> \date Dec 2017
86 :
87 :
88 12 : subroutine mpr_neutrons( process_case, & ! IN: process case
89 24 : param , & ! IN: global parameter set
90 24 : is_present , & ! IN: flag indicating presence of soil
91 12 : nHorizons , & ! IN: Number of Horizons of Soiltype
92 24 : nTillHorizons , & ! IN: Number of tillage Horizons
93 12 : LCover0 , & ! IN: land cover ids at level 0
94 12 : clay , & ! IN: clay content
95 12 : DbM , & ! IN: mineral Bulk density
96 12 : Db , & ! IN: Bulk density
97 12 : COSMIC_L3_till , & ! OUT: COSMIC paramter L3 tillage layer
98 24 : latWat_till , & ! OUT: lattice water content tillage layer
99 12 : COSMIC_L3 , & ! OUT: COSMIC paramter L3 tillage layer
100 12 : latWat & ! OUT: lattice water contente
101 : )
102 :
103 : ! lots of lines copy-pasted from mo_mpr_soilmoist.f90
104 : use mo_message, only: error_message
105 : use mo_mpr_global_variables, only: iFlag_soilDB
106 : !$ use omp_lib
107 :
108 : implicit none
109 :
110 : ! Input --------------------------------------------------------------------
111 : integer(i4), intent(in) :: process_case ! process case
112 : real(dp), dimension(:), intent(in) :: param ! global parameters !! dim = 3 for case 1 and 9 for case 2
113 : integer(i4), dimension(:), intent(in) :: is_present ! indicates whether soiltype is present
114 : integer(i4), dimension(:), intent(in) :: nHorizons ! Number of Horizons per soiltype
115 : integer(i4), dimension(:), intent(in) :: nTillHorizons! Number of Tillage Horizons
116 : real(dp), dimension(:,:), intent(in) :: DbM ! mineral Bulk density
117 : real(dp), dimension(:,:,:), intent(in) :: Db ! Bulk density
118 : integer(i4), dimension(:), intent(in) :: LCOVER0 ! land cover ids at level 0
119 : real(dp), dimension(:,:), intent(in) :: clay ! clay content
120 :
121 : ! Output -------------------------------------------------------------------
122 : real(dp), dimension(:,:,:), intent(out) :: COSMIC_L3_till ! COSMIC parameter L3 tillage layer
123 : real(dp), dimension(:,:,:), intent(out) :: latWat_till ! lattice water content tillage layer
124 : real(dp), dimension(:,:), intent(out) :: COSMIC_L3 ! COSMIC parameter L3
125 : real(dp), dimension(:,:), intent(out) :: latWat ! lattice water content
126 :
127 : ! Local variables
128 : integer(i4) :: i ! loop index
129 : integer(i4) :: j ! loop index
130 : integer(i4) :: l ! loop index
131 : integer(i4) :: tmp_minSoilHorizon
132 :
133 :
134 : !min soil horizon
135 17712 : tmp_minSoilHorizon = minval(nTillHorizons(:))
136 :
137 : ! with zero there will be problem with
138 : ! upscaling with harmonic mean for the COMSIC_L3
139 : ! in case of process_case .EQ. 1
140 53184 : COSMIC_L3_till = 0.000001_dp
141 53148 : COSMIC_L3 = 0.000001_dp
142 53184 : latWat_till = 0.000001_dp
143 53148 : latWat = 0.000001_dp
144 :
145 : ! select case according to a given soil database flag
146 12 : SELECT CASE(iFlag_soilDB)
147 :
148 : ! classical mHM soil database format
149 : CASE(0)
150 17724 : do i = 1, size(is_present)
151 17700 : if ( is_present(i) .lt. 1 ) cycle
152 1596 : horizon: do j = 1, nHorizons(i)
153 : ! calculating other soil hydraulic properties
154 : ! tillage horizons
155 18888 : if ( j .le. nTillHorizons(i) ) then
156 : ! LC class
157 18433800 : do L = 1, maxval( LCOVER0 )
158 1188 : if(process_case .EQ. 1) call latticeWater(param(2:3), clay(i,j), latWat_till(i,j,L))
159 1584 : if(process_case .EQ. 2) then
160 0 : call calcL3(param(6:7), Db(i,j,L), COSMIC_L3_till(i,j,L))
161 0 : call latticeWater(param(8:9), clay(i,j), latWat_till(i,j,L))
162 : end if
163 : end do
164 : ! deeper layers
165 : else
166 792 : if(process_case .EQ. 1) call latticeWater(param(2:3), clay(i,j), latWat(i,j-tmp_minSoilHorizon))
167 792 : if(process_case .EQ. 2) then
168 0 : call calcL3(param(6:7), DbM(i,j), COSMIC_L3(i,j-tmp_minSoilHorizon))
169 0 : call latticeWater(param(8:9), clay(i,j), latWat(i,j-tmp_minSoilHorizon))
170 : end if
171 : end if
172 : end do horizon
173 : end do
174 :
175 : ! to handle multiple soil horizons with unique soil class
176 : CASE(1)
177 0 : do i = 1, size(is_present)
178 0 : if ( is_present(i) .lt. 1 ) cycle
179 : ! **** FOR THE TILLAGE TYPE OF SOIL *****
180 : ! there is actually no soil horizons/soil type in this case
181 : ! but we assign of j = 1 to use variables as defined in the classical option (iFlag_soil = 0)
182 0 : do j = 1, 1
183 : ! tillage horizons properties depending on the LC class
184 0 : do L = 1, maxval( LCOVER0 )
185 0 : if(process_case .EQ. 1) call latticeWater(param(2:3), clay(i,j), latWat_till(i,j,L))
186 0 : if(process_case .EQ. 2) then
187 0 : call calcL3(param(6:7), Db(i,j,L), COSMIC_L3_till(i,j,L))
188 0 : call latticeWater(param(8:9), clay(i,j), latWat_till(i,j,L))
189 : end if
190 : end do
191 :
192 : ! *** FOR NON-TILLAGE TYPE OF SOILS ***
193 : ! note j = 1
194 0 : if(process_case .EQ. 1) call latticeWater(param(2:3), clay(i,j), latWat(i,j))
195 0 : if(process_case .EQ. 2) then
196 0 : call calcL3(param(6:7), DbM(i,j), COSMIC_L3(i,j))
197 0 : call latticeWater(param(8:9), clay(i,j), latWat(i,j))
198 : end if
199 :
200 : end do ! >> HORIZON
201 : end do ! >> SOIL TYPE
202 :
203 : CASE DEFAULT
204 12 : call error_message('***ERROR: iFlag_soilDB option given does not exist. Only 0 and 1 is taken at the moment.')
205 : END SELECT
206 : !
207 :
208 12 : end subroutine
209 :
210 :
211 : !! >> L3 parameter
212 0 : subroutine calcL3(param, bulkDensity, L3)
213 : ! param(1) = COSMIC_L30
214 : ! param(2) = COSMIC_L31
215 : implicit none
216 : real(dp), dimension(2), intent(in) :: param
217 : real(dp), intent(in) :: bulkDensity
218 : real(dp), intent(inout) :: L3
219 :
220 0 : L3 = bulkDensity*param(1) - param(2)
221 0 : if( bulkDensity .LT. 0.4_dp ) then ! bulkDensity<0.39 yields negative L3, bulkDensity=0.39 yields L3=0
222 0 : L3 = 1.0_dp ! Prevent division by zero later on; added by joost Iwema to COSMIC 1.13, Feb. 2017
223 : endif
224 :
225 12 : end subroutine calcL3
226 :
227 :
228 : !! >>>> lattice water
229 1980 : subroutine latticeWater( param, clay, latWat )
230 : ! param(1) = COSMIC_LW0 or deslet_LW0
231 : ! param(2) = COSMIC_LW1 or deslet_LW0
232 : implicit none
233 : ! Input
234 : real(dp), dimension(2), intent(in) :: param
235 : real(dp), intent(in) :: clay
236 : ! Output
237 : real(dp), intent(out) :: latWat
238 :
239 : !Martin Schroen's dissertation
240 1980 : latWat = ( param(1)*clay/100.0_dp + param(2) )
241 :
242 0 : end subroutine latticeWater
243 :
244 : end module mo_mpr_neutrons
|
