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