40 USE modd_prep, ONLY : xzs_ls, xt_clim_grad
42 USE modd_csts, ONLY : xtt, xday, xlmtt, xrholw
45 USE modi_prep_ver_snow
48 USE yomhook
,ONLY : lhook, dr_hook
49 USE parkind1
,ONLY : jprb
59 TYPE(isba_t
),
INTENT(INOUT) :: i
65 REAL,
DIMENSION(:),
ALLOCATABLE :: zwgtot
66 REAL,
DIMENSION(:),
ALLOCATABLE :: zdw
67 REAL,
DIMENSION(:),
ALLOCATABLE :: zzsfreeze
70 REAL,
DIMENSION(:,:,:),
ALLOCATABLE :: zwgi_clim_grad
72 REAL,
DIMENSION(:,:,:),
ALLOCATABLE :: ztg_ls
74 REAL :: zgradx = 5.e-4
76 REAL(KIND=JPRB) :: zhook_handle
81 IF (lhook) CALL dr_hook(
'PREP_VER_ISBA',0,zhook_handle)
82 ALLOCATE(zwgi_clim_grad(
SIZE(i%XWG,1),
SIZE(i%XWG,2),
SIZE(i%XWG,3)))
84 zwgi_clim_grad(:,:,:) = zgradx * exp( - i%XDG(:,:,:) / zh0 )
89 ALLOCATE(ztg_ls(
SIZE(i%XTG,1),
SIZE(i%XTG,2),
SIZE(i%XTG,3)))
90 ztg_ls(:,:,:) = i%XTG(:,:,:)
94 WHERE(i%XTG(:,jl,jp)/=xundef) &
95 i%XTG(:,jl,jp) = i%XTG(:,jl,jp) + xt_clim_grad * (i%XZS - xzs_ls)
103 ALLOCATE(zzsfreeze(
SIZE(i%XWG,1)))
104 ALLOCATE(zwgtot(
SIZE(i%XWG,1)))
105 ALLOCATE(zdw(
SIZE(i%XWG,1)))
115 DO jp=1,
SIZE(i%XWG,3)
121 zzsfreeze(:) = i%XZS + (xtt - i%XTG(:,jl,jp)) / xt_clim_grad
123 WHERE(i%XTG(:,jl,jp)/=xundef)
125 WHERE (ztg_ls(:,jl,jp) < xtt)
127 WHERE (i%XZS <= xzs_ls)
129 WHERE (i%XZS > zzsfreeze)
130 zdw(:) = zwgi_clim_grad(:,jl,jp) * (i%XZS - xzs_ls)
132 zdw(:) = zwgi_clim_grad(:,jl,jp) * (zzsfreeze - xzs_ls) + zgradx * (i%XZS - zzsfreeze)
137 zdw(:) = zwgi_clim_grad(:,jl,jp) * (i%XZS - xzs_ls)
143 WHERE (i%XZS <= xzs_ls)
145 zdw(:) = zgradx * (i%XZS - xzs_ls)
149 zdw(:) = zwgi_clim_grad(:,jl,jp) * (i%XZS - zzsfreeze)
157 WHERE(i%XWG(:,jl,jp)/=xundef)
158 zwgtot(:) = i%XWG(:,jl,jp) + i%XWGI(:,jl,jp)
161 WHERE(i%XWG(:,jl,jp)/=xundef)
162 i%XWGI(:,jl,jp) = i%XWGI(:,jl,jp) + zdw(:)
163 i%XWG (:,jl,jp) = i%XWG (:,jl,jp) - zdw(:)
166 WHERE (i%XWGI(:,jl,jp)<0.0.AND.i%XWGI(:,jl,jp)/=xundef)
168 i%XWG (:,jl,jp) = zwgtot(:)
171 WHERE (i%XWG(:,jl,jp)<xwgmin.AND.i%XWG(:,jl,jp)/=xundef)
172 i%XWG (:,jl,jp) = xwgmin
173 i%XWGI(:,jl,jp) = zwgtot(:) - xwgmin
176 WHERE(i%XWGI(:,jl,jp)>0.0.AND.i%XWGI(:,jl,jp)/=xundef)
177 i%XTG(:,jl,jp) = min(xtt,i%XTG(:,jl,jp))
179 i%XTG(:,jl,jp) = max(xtt,i%XTG(:,jl,jp))
191 IF (i%CISBA==
'2-L'.OR.i%CISBA==
'3-L')
THEN
192 i%XWG(:,2,:)=max(i%XWG(:,1,:)*i%XDG(:,1,:),i%XWG(:,2,:)*i%XDG(:,2,:))/i%XDG(:,2,:)
193 i%XWGI(:,2,:)=max(i%XWGI(:,1,:)*i%XDG(:,1,:),i%XWGI(:,2,:)*i%XDG(:,2,:))/i%XDG(:,2,:)
195 IF (i%CISBA==
'3-L')
THEN
196 DO jp=1,
SIZE(i%XWG,3)
197 WHERE (i%XWGI(:,3,jp) /= xundef)
198 i%XWG (:,3,jp) = i%XWG(:,3,jp)+i%XWGI(:,3,jp)
200 i%XTG (:,3,jp) = ztg_ls(:,3,jp) + xt_clim_grad * (i%XZS - xzs_ls)
203 i%XTG (:,4:
SIZE(i%XTG,2),jp) = ztg_ls(:,4:
SIZE(i%XTG,2),jp)
206 ELSEIF(i%CISBA==
'2-L'.AND.i%LTEMP_ARP)
THEN
207 DO jp=1,
SIZE(i%XWG,3)
208 i%XTG (:,3:
SIZE(i%XTG,2),jp) = ztg_ls(:,3:
SIZE(i%XTG,2),jp)
212 DEALLOCATE(zzsfreeze)
213 DEALLOCATE(zwgi_clim_grad)
218 WHERE (i%XTG(:,1:
SIZE(i%XWG,2),:) == xundef)
219 i%XWG (:,:,:) = xundef
220 i%XWGI(:,:,:) = xundef
228 IF (.NOT.lsnow_ideal)
THEN
229 IF (i%CISBA==
'DIF')
THEN
230 ideep_soil = i%NGROUND_LAYER
234 CALL
prep_ver_snow(i%TSNOW,xzs_ls,i%XZS,ztg_ls,i%XTG,ideep_soil)
242 IF (lhook) CALL dr_hook(
'PREP_VER_ISBA',1,zhook_handle)
subroutine prep_ver_snow(TPSNOW, PZS_LS, PZS, PTG_LS, PTG, KDEEP_SOIL)
subroutine prep_ver_isba(I)