Subroutine vom_adapt_roots

2197 : 
2198 : !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
2199 : !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
2200 : !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
2201 : !*------ADJUSTMENT OF ROOT SURFACE--------------------------------------
2202 : 
2203 :       subroutine vom_adapt_roots ()
2204 :       use vom_vegwat_mod
2205 :       implicit none
2206 : 
2207 :       REAL*8 :: maxval_tmp
2208 : 
2209 : !     *-----PERENNIAL VEGETATION---------------
2210 : 
2211 :       refft(:) = 0.d0
2212 :       if (q_md .gt. 0.d0) then          ! if q_md=0, then changef is calculated elsewhere
2213 :         changef = (0.95d0 * q_mqx - mqsstmin) / (0.05d0 * q_mqx)  ! (3.47)
2214 :       else
2215 : !       * changef for q_md=0 is either 0 or 1. Change it to be either -1 or + 1:
2216 :         changef = 2.d0 * changef - 1.d0
2217 :       endif
2218 :       refft(:) = 0.d0
2219 :       maxval_tmp = MAXVAL(ruptkt_d(1:pos_slt) / rsurft_(1:pos_slt))
2220 :       if (maxval_tmp .ne. 0.d0) then
2221 :         refft(1:pos_slt) = 0.5d0 * ruptkt_d(1:pos_slt) / rsurft_(1:pos_slt) / maxval_tmp  ! (3.48)
2222 :       endif
2223 :       where (ruptkt_d(1:pos_slt) .lt. 0.d0)
2224 :         refft(:) = 0.d0
2225 :       end where
2226 :       if (changef .lt. 0.d0) then
2227 :         refft(:) = 1.d0 - refft(:)
2228 :       endif
2229 : 
2230 : !     * rsurf=(2*c_epsln/i_rootrad) if all pores filled by roots
2231 : 
2232 :       rsurftnew(1:pos_slt) = MIN(2.d0 * c_epsln / i_rootrad * s_delz(1:pos_slt), &
2233 :      &                     MAX(i_rsurfmin * s_delz(1:pos_slt), rsurft_(1:pos_slt) &
2234 :      &                     + rsurft_(1:pos_slt) * i_growthmax * changef &
2235 :      &                     * refft(1:pos_slt) * s_delz(1:pos_slt)))
2236 : 
2237 : !     *-----SEASONAL VEGETATION---------------
2238 : 
2239 : !     * rootlim is either 0 or 1. Change it to be either -1 or + 1:
2240 :       rootlim(posmna(1),posmna(2), posmna(3)) = 2.d0 * rootlim(posmna(1),posmna(2),posmna(3)) - 1.d0
2241 : 
2242 :       reffg(:) = 0.d0
2243 :       maxval_tmp = MAXVAL(ruptkg_d(1:pos_slg) / rsurfg_(1:pos_slg))
2244 :       if (maxval_tmp .ne. 0.d0) then
2245 :         reffg(1:pos_slg) = 0.5d0 * ruptkg_d(1:pos_slg) / rsurfg_(1:pos_slg) / maxval_tmp  ! (3.48)
2246 :       endif
2247 : 
2248 : !     * if roots are going to be reduced, reverse effectivity vector
2249 : 
2250 :       if (rootlim(posmna(1),posmna(2),posmna(3)) .lt. 0.d0) then
2251 :         reffg(:) = 1.d0 - reffg(:)
2252 :       endif
2253 : 
2254 : !     * maximum rsurfg depends on rsurf of trees in same layer.
2255 : 
2256 :       rsurfgnew(1:pos_slg) = MIN(2.d0 * c_epsln / i_rootrad            &
2257 :      &                     * s_delz(1:pos_slg) - rsurft_(1:pos_slg),   &
2258 :      &                     MAX(i_rsurfmin * s_delz(1:pos_slg),         &
2259 :      &                     rsurfg_(1:pos_slg) + rsurfg_(1:pos_slg)     &
2260 :      &                     * i_growthmax * rootlim(posmna(1),posmna(2),posmna(3))&
2261 :      &                     * reffg(1:pos_slg)))
2262 :       rsurfgnew(pos_slg+1:s_maxlayer) = 0.d0
2263 : 
2264 :       rootlim(:,:,:) = 0.d0
2265 :       ruptkt_d(:)  = 0.d0
2266 :       changef      = 0.d0
2267 : 
2268 :       return
2269 :       end subroutine vom_adapt_roots