7 hisba,hrunoff,hrain,prain,pmuf,pfsat,ptopqs)
58 USE modd_sgh_par, ONLY : ndimtab, xmtokm, xstohr, x001, &
63 USE yomhook
,ONLY : lhook, dr_hook
64 USE parkind1
,ONLY : jprb
71 TYPE(isba_grid_t
),
INTENT(INOUT) :: ig
72 TYPE(isba_t
),
INTENT(INOUT) :: i
74 CHARACTER(LEN=*),
INTENT(IN) :: hisba
79 CHARACTER(LEN=*),
INTENT(IN) :: hrunoff
85 CHARACTER(LEN=*),
INTENT(IN) :: hrain
89 REAL,
DIMENSION(:),
INTENT(IN) :: prain
92 REAL,
DIMENSION(:),
INTENT(OUT) :: pmuf
95 REAL,
DIMENSION(:),
INTENT(OUT) :: pfsat
98 REAL,
DIMENSION(:,:,:),
INTENT(OUT):: ptopqs
103 REAL,
DIMENSION(SIZE(PRAIN)) :: zdist, zbeta
107 REAL,
DIMENSION(SIZE(PRAIN)) :: zd_top, zw_top, zqtop
112 INTEGER,
DIMENSION(SIZE(PRAIN)) :: iup,idown
115 INTEGER,
DIMENSION(SIZE(PRAIN)) :: nmask
117 REAL,
DIMENSION(SIZE(PRAIN)) :: zwsat_avg, zwwilt_avg
120 REAL :: zw_up, zw_down
121 REAL :: zf_up, zf_down, zslopef
122 REAL :: zq_up, zq_down, zslopeq
124 INTEGER :: ini, jj, ji, jpatch, jtab, icount, &
126 REAL(KIND=JPRB) :: zhook_handle
130 IF (lhook) CALL dr_hook(
'ISBA_SGH_UPDATE',0,zhook_handle)
149 zdist(:) = sqrt(ig%XMESH_SIZE(:))/xmtokm
151 WHERE(zdist(:)>=15.0)
155 zbeta(:) = xmurega + xmuregp * exp(-x001*zdist(:))
159 pmuf(:) = 1.0 - exp(-zbeta(:)*(prain(:)*xstohr))
168 IF(hrunoff==
'SGH')
THEN
182 IF (i%NSIZE_NATURE_P(jpatch)>0 )
THEN
185 zd_top(jj) = zd_top(jj) + i%XPATCH(jj,jpatch)*i%XSOILWGHT(jj,jl,jpatch)
186 zwsat_avg(jj) = zwsat_avg(jj) + i%XPATCH(jj,jpatch)*i%XSOILWGHT(jj,jl,jpatch)*i%XWSAT(jj,jl)
187 zwwilt_avg(jj) = zwwilt_avg(jj) + i%XPATCH(jj,jpatch)*i%XSOILWGHT(jj,jl,jpatch)*i%XWD0 (jj,jl)
188 zw_top(jj) = zw_top(jj) + i%XPATCH(jj,jpatch)*i%XSOILWGHT(jj,jl,jpatch)*i%XWG(jj,jl,jpatch)
195 zwsat_avg(:) = zwsat_avg(:)/zd_top(:)
196 zwwilt_avg(:) = zwwilt_avg(:)/zd_top(:)
197 zw_top(:) = zw_top(:)/zd_top(:)
203 IF (i%NSIZE_NATURE_P(jpatch)>0 )
THEN
205 zd_top(jj) = zd_top(jj)+i%XRUNOFFD(jj,jpatch)*i%XPATCH(jj,jpatch)
206 zw_top(jj) = zw_top(jj)+i%XRUNOFFD(jj,jpatch)*i%XPATCH(jj,jpatch)*i%XWG(jj,2,jpatch)
212 zw_top(:) = zw_top(:) / zd_top(:)
215 zwsat_avg(:) = i%XWSAT(:,1)
216 zwwilt_avg(:) = i%XWD0 (:,1)
226 IF((i%XTI_MEAN(jj)/=xundef.AND.zw_top(jj)<zwsat_avg(jj).AND.zw_top(jj)>zwwilt_avg(jj)))
THEN
230 IF(zw_top(jj)>=zwsat_avg(jj))
THEN
241 IF(i%XTAB_WTOP(ji,jtab)>zw_top(ji))
THEN
244 ELSEIF(i%XTAB_WTOP(ji,jtab)==zw_top(ji))
THEN
259 zf_up = i%XTAB_FSAT(ji,iup(jj))
260 zf_down = i%XTAB_FSAT(ji,idown(jj))
261 zq_up = i%XTAB_QTOP(ji,iup(jj))
262 zq_down = i%XTAB_QTOP(ji,idown(jj))
263 zw_up = i%XTAB_WTOP(ji,iup(jj))
264 zw_down = i%XTAB_WTOP(ji,idown(jj))
269 IF(iup(jj)/=idown(jj))
THEN
270 zslopef = (zf_up-zf_down)/(zw_up-zw_down)
271 zslopeq = (zq_up-zq_down)/(zw_up-zw_down)
274 pfsat(ji) = zf_down+(zw_top(ji)-zw_down)*zslopef
275 zqtop(ji) = zq_down+(zw_top(ji)-zw_down)*zslopeq
285 IF(i%NSIZE_NATURE_P(jpatch)>0)
THEN
288 ptopqs(jj,jl,jpatch)=i%XKANISO(jj,jl)*i%XCONDSAT(jj,1,jpatch)*zqtop(jj)*i%XSOILWGHT(jj,jl,jpatch)/i%XRUNOFFD(jj,jpatch)
298 IF (lhook) CALL dr_hook(
'ISBA_SGH_UPDATE',1,zhook_handle)
subroutine isba_sgh_update(IG, I, HISBA, HRUNOFF, HRAIN, PRAIN, PMUF, PFSAT, PTOPQS)