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