Subroutine waterbalance_fluxes
155 :
156 : !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
157 : !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
158 : !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
159 : !*-----FLUXES (inf, infx, qbl, esoil__, spgfcf__)--------------------
160 :
161 : subroutine waterbalance_fluxes ()
162 : use vom_vegwat_mod
163 : implicit none
164 :
165 : REAL*8 :: dummy
166 : INTEGER :: ii, jj
167 :
168 : ! * infiltration
169 :
170 : if (rain_h(th_) .gt. 0.d0) then
171 : if (wlayer_ .ge. 1) then
172 : inf__ = MIN((s_ksat(1) + kunsat_(1)) / 2.d0 *(1.d0 &
173 : & + (2.d0 * pcap_(1)) / s_delz(1)), rain_h(th_)) ! (3.6), (Out[60])
174 : else
175 : inf__ = 0.d0
176 : endif
177 : infx__ = rain_h(th_) - inf__
178 : else
179 : inf__ = 0.d0
180 : infx__ = 0.d0
181 : endif
182 :
183 : ! * unsaturated flow
184 :
185 : qbl(:) = 0.d0
186 : if (wlayer_ .gt. 1) then
187 : ! * Runoff occurs only from the layer 'wlayer_',
188 : ! therefore no downward flow into the layers below is allowed.
189 : do jj = 1, wlayer_ - 1
190 : qbl(jj) = -0.5d0 * (2.d0 * (pcap_(jj+1) - pcap_(jj)) / (s_delz(jj+1) &
191 : & + s_delz(jj)) + 1.d0) * (kunsat_(jj+1) + kunsat_(jj))
192 : enddo
193 : endif
194 :
195 : ! * soil evaporation
196 :
197 : esoil__ = (par_h(th_)/(srad2par_h * l_E_* rho_wat) ) * &
198 : (1.d0 - (1.d0-i_trans_vegcov) * (o_cai + pcg_d(2))) * su__(1)
199 :
200 : ! * Seepage face flow as a function of zw_ following eq_spgfcf in Watbal3.
201 :
202 : spgfcf__ = 0.d0
203 : if (zw_ .gt. i_zr) then
204 : spgfcf__ = MAX(0.d0, 0.5d0 * (SQRT(i_cz - i_zr) &
205 : & - SQRT(i_cz - zw_)) * (zw_ - i_zr) * s_ksat(wlayer_) &
206 : & / (SQRT(i_cz - i_zr) * i_cgs * COS(i_go)))
207 : endif
208 :
209 : ! * MAKING SURE THAT NO SUBLAYER 'OVERFLOWS'
210 : ! * 1.d-16 makes sure that 0 does not get transformed to tiny positive
211 :
212 : if (MAXVAL(su__(1:wlayer_)) .ge. 1.d0) then
213 :
214 : if (wlayer_ .gt. 1) then
215 : if (su__(1) .ge. 0.99d0) then
216 : dummy = esoil__ - inf__ + ruptkt__(1) + ruptkg__(1)
217 : if (qbl(1) - dummy .gt. 0.d0) then
218 : qbl(1) = dummy - 1.d-16 ! (Out[156])+ruptkg__(1)
219 : endif
220 : endif
221 : endif
222 :
223 : if (wlayer_ .gt. 2) then
224 : do ii = 2, wlayer_ - 1
225 : if (su__(ii) .ge. 0.99d0) then
226 : dummy = qbl(ii-1) + ruptkt__(ii) + ruptkg__(ii)
227 : if (qbl(ii) - dummy .gt. 0.d0) then
228 : qbl(ii) = dummy - 1.d-16 ! (Out[158])+ruptkg__(ii)
229 : endif
230 : endif
231 : enddo
232 : endif
233 :
234 : if (wlayer_ .gt. 1) then
235 : if (su__(wlayer_) .ge. 1.d0) then
236 : dummy = -qbl(wlayer_-1) - ruptkt__(wlayer_) - ruptkg__(wlayer_)
237 : ! * make sure that any surplus water runs off
238 : spgfcf__ = MAX(spgfcf__, dummy + 1.d-16)
239 : endif
240 : else
241 : if (su__(wlayer_) .ge. 1.d0) then
242 : dummy = inf__ - esoil__ - ruptkt__(1) - ruptkg__(1)
243 : spgfcf__ = MAX(spgfcf__, dummy + 1.d-16)
244 : endif
245 : endif
246 :
247 : endif
248 :
249 : return
250 : end subroutine waterbalance_fluxes