7 pqa, pqs, pcd, pcdn, pch )
40 USE modd_csts, ONLY : xg, xrd, xrv, xcpd, xkarman
41 USE modd_surf_atm, ONLY : xedb, xedc, xedd, xedk, xusuric, xusurid, xusuricl
44 USE yomhook
,ONLY : lhook, dr_hook
45 USE parkind1
,ONLY : jprb
49 REAL,
DIMENSION(:),
INTENT(IN) :: pzref
50 REAL,
DIMENSION(:),
INTENT(IN) :: pz0eff
51 REAL,
DIMENSION(:),
INTENT(IN) :: pz0h
52 REAL,
DIMENSION(:),
INTENT(IN) :: pvmod
53 REAL,
DIMENSION(:),
INTENT(IN) :: pta
54 REAL,
DIMENSION(:),
INTENT(IN) :: ptg
55 REAL,
DIMENSION(:),
INTENT(IN) :: pqa
56 REAL,
DIMENSION(:),
INTENT(IN) :: pqs
57 REAL,
DIMENSION(:),
INTENT(OUT) :: pcd
58 REAL,
DIMENSION(:),
INTENT(OUT) :: pcdn
59 REAL,
DIMENSION(:),
INTENT(OUT) :: pch
63 REAL,
DIMENSION(0:3,1:4) :: gcz0h
65 REAL,
DIMENSION(SIZE(PTA)) :: zstab
67 REAL,
DIMENSION(SIZE(PTA)) :: zcdnh, zrti, zu
73 REAL :: z2b, z3b, z3bc, zcd, zcd0, zch, zch0, zcis, zdid, &
74 zdih, zds, zloi, zlos, zmu, zpd, zph, zrzd, zrzh, &
75 zusuric, zsta, zixp, zstah, zhs
76 REAL(KIND=JPRB) :: zhook_handle
82 IF (lhook) CALL dr_hook(
'SURFACE_CDCH_1DARP',0,zhook_handle)
101 zusuric=xusuric*xusuricl
129 IF(xusurid == 0.0)
THEN
137 zr = xrd + (xrv-xrd)*pqa(jlon)
138 zrs = xrd + (xrv-xrd)*pqs(jlon)
143 zrzd=1.0+pzref(jlon)/pz0eff(jlon)
144 pcdn(jlon)=(xkarman/log(zrzd))**2
159 zrzh=1.0+pzref(jlon)/pz0h(jlon)
160 zcdnh(jlon)=xkarman**2/(log(zrzh)*log(zrzd))
161 zmu=log(pz0eff(jlon)/pz0h(jlon))
162 zcd0=(gcz0h(0,1)+zmu*(gcz0h(1,1)+zmu*(gcz0h(2,1)+zmu &
163 *gcz0h(3,1))))/(1.5*xedc)
164 zpd=(gcz0h(0,2)+zmu*(gcz0h(1,2)+zmu*(gcz0h(2,2)+zmu*gcz0h(3,2))))-0.5
165 zch0=(gcz0h(0,3)+zmu*(gcz0h(1,3)+zmu*(gcz0h(2,3)+zmu*gcz0h(3,3))))/xedc
166 zph=(gcz0h(0,4)+zmu*(gcz0h(1,4)+zmu*(gcz0h(2,4)+zmu*gcz0h(3,4))))-0.5
191 zrti(jlon)=2.0/(zr*pta(jlon)+(xrd/xcpd)*xg*pzref(jlon)&
193 zsta=xg*pzref(jlon)*(zr*pta(jlon)+(xrd/xcpd) &
194 *xg*pzref(jlon)-zrs*ptg(jlon))*zrti(jlon)
195 zstah=zsta/(1.0+zixp*zusuric*max(0.0,zsta)/zcis)**(1.0/zixp)
196 zsta=zsta/(1.0+zusuric*max(0.0,zsta)/zcis)
197 zstab(jlon)=max(0.0,sign(1.0,zsta))
202 zds=sqrt(zcis+xedd/xedk*abs(zsta))
203 zhs=sqrt(zcis+xedd*xedk*abs(zstah))
204 zdid=1.0/(zu(jlon)+zcd*z3bc*pcdn(jlon)*sqrt(abs(zsta)*zrzd))
205 zdih=1.0/(zu(jlon)+zch*z3bc*zcdnh(jlon)*sqrt(abs(zsta)*zrzh))
212 zlos=zcis*zds/(zu(jlon)*zds+z2b*abs(zsta))
213 zloi=zu(jlon)-z2b*zsta*zdid
214 pcd(jlon)=(zloi+zstab(jlon)*(zlos-zloi))*pcdn(jlon)/zu(jlon)
219 zlos=zcis**2/(zu(jlon)*zcis+z3b*abs(zstah)*zhs)
220 zloi=zu(jlon)-z3b*zsta*zdih
221 pch(jlon)=(zloi+zstab(jlon)*(zlos-zloi))*zcdnh(jlon)/zu(jlon)
224 IF (lhook) CALL dr_hook(
'SURFACE_CDCH_1DARP',1,zhook_handle)
subroutine surface_cdch_1darp(PZREF, PZ0EFF, PZ0H, PVMOD, PTA, PTG, PQA, PQS, PCD, PCDN, PCH)