7 pz0, pz0h, pz0eff, ph_veg, pzref, &
8 ptc, pta, pqc, pqa, puref, pvmod, &
9 pexna, pexns, pdircoszw, pdisph, &
10 pvelc, pzvmod, pri, pra, &
56 USE modd_csts, ONLY : xpi, xkarman, xg, xcpd, xrd
60 USE modi_surface_aero_cond
63 USE modi_wind_threshold
65 USE modi_surface_cdch_1darp
67 USE yomhook
,ONLY : lhook, dr_hook
68 USE parkind1
,ONLY : jprb
74 REAL,
DIMENSION(:),
INTENT(IN) :: pz0, pz0h, pz0eff,ph_veg, pzref, puref, pvmod
86 REAL,
DIMENSION(:),
INTENT(IN) :: ptc, pta, pqc, pqa
92 REAL,
DIMENSION(:),
INTENT(IN) :: pexna, pexns, pdircoszw, pdisph
99 REAL,
DIMENSION(:),
INTENT(OUT) :: pvelc, pzvmod, pri, pra, pch, pcdn, pcd
109 LOGICAL,
INTENT(IN) :: lcvel, lforc_measure
115 REAL,
DIMENSION(SIZE(PZ0)) :: zreveg, zcd, zcur, zucur, zratvv, zac
116 REAL,
DIMENSION(SIZE(PZ0)) :: zbn, zbd, zcbnvv, zcbsvv, zcbuvv, zredvv
118 REAL(KIND=JPRB) :: zhook_handle
122 REAL,
PARAMETER :: zul = 1.
123 REAL,
PARAMETER :: zny = 0.15e-04
124 REAL,
PARAMETER :: zvelclim = 0.1
129 IF (lhook) CALL dr_hook(
'PREPS_FOR_MEB_DRAG',0,zhook_handle)
133 zcur(:) = max(pzref(:),xlimh)
134 zucur(:) = max(puref(:),xlimh)
138 IF(lforc_measure)
THEN
140 zcur(:) = pzref(:)-pdisph(:)
141 zucur(:) = puref(:)-pdisph(:)
143 IF (any(zcur<0.0 .OR. zucur<0.0))
THEN
144 print *,
'MAXVAL(PH_VEG)=',maxval(ph_veg)
145 print *,
'MAXVAL(PDISPH)=',maxval(pdisph)
146 print *,
'MINVAL(PZREF)=',minval(pzref)
147 print *,
'MINVAL(PUREF)=',minval(puref)
148 stop
"Forcing height for wind or temperature too low!!"
156 zcur(:) = max(pzref(:),ph_veg(:)-pdisph(:)+xlimh)
157 zucur(:) = max(puref(:),ph_veg(:)-pdisph(:)+xlimh)
164 CALL
surface_ri(ptc, pqc, pexns, pexna, pta, pqa, &
165 zcur, zucur, pdircoszw, pvmod, pri )
167 pri(:) = min(pri(:),xrimax)
171 IF (ldrag_coef_arp)
THEN
174 pqa, pqc, pcd, pcdn, pch )
175 pra(:) = 1. / ( pch(:) * pzvmod(:) )
189 CALL
surface_cd(pri, zcur, zucur, pz0eff, pz0h, pcd, pcdn)
198 zratvv(:) = min((ph_veg(:)-pdisph(:))/zcur(:),1.)
200 zbn(:) = xkarman/sqrt(pcdn(:))
201 zbd(:) = xkarman/sqrt(pcd(:))
202 zcbnvv(:) = alog(1.+(exp(zbn(:))-1.)*zratvv(:))
203 zcbsvv(:) = -(zbn(:)-zbd(:))*zratvv(:)
204 zcbuvv(:) = -alog(1.+(exp(zbn(:)-zbd(:))-1.)*zratvv(:))
207 zredvv(:) = (zcbnvv(:) + zcbsvv(:))/zbd(:)
209 zredvv(:) = (zcbnvv(:) + zcbuvv(:))/zbd(:)
212 pvelc(:) = max(zredvv(:)*pzvmod(:),zvelclim)
216 IF (lhook) CALL dr_hook(
'PREPS_FOR_MEB_DRAG',1,zhook_handle)
real function, dimension(size(pwind)) wind_threshold(PWIND, PUREF)
subroutine surface_ri(PTG, PQS, PEXNS, PEXNA, PTA, PQA, PZREF, PUREF, PDIRCOSZW, PVMOD, PRI)
subroutine preps_for_meb_drag(LCVEL, LFORC_MEASURE, PZ0, PZ0H, PZ0EFF, PH_VEG, PZREF, PTC, PTA, PQC, PQA, PUREF, PVMOD, PEXNA, PEXNS, PDIRCOSZW, PDISPH, PVELC, PZVMOD, PRI, PRA, PCH, PCDN, PCD)
subroutine surface_aero_cond(PRI, PZREF, PUREF, PVMOD, PZ0, PZ0H, PAC, PRA, PCH)
subroutine surface_cd(PRI, PZREF, PUREF, PZ0EFF, PZ0H, PCD, PCDN)
subroutine surface_cdch_1darp(PZREF, PZ0EFF, PZ0H, PVMOD, PTA, PTG, PQA, PQS, PCD, PCDN, PCH)