63 USE modi_dustflux_get_mb
65 USE yomhook
,ONLY : lhook, dr_hook
66 USE parkind1
,ONLY : jprb
72 TYPE(dst_t),
INTENT(INOUT) :: dst
75 CHARACTER(LEN=*),
INTENT(IN) :: hprogram
76 INTEGER,
INTENT(IN) :: ki
77 INTEGER,
INTENT(IN) :: kdst
78 INTEGER,
INTENT(IN) :: kpatch
79 REAL,
DIMENSION(KI),
INTENT(IN) :: pclay
80 REAL,
DIMENSION(KI),
INTENT(IN) :: pps
81 REAL,
DIMENSION(KI),
INTENT(IN) :: pts
82 REAL,
DIMENSION(KI),
INTENT(IN) :: pqa
83 REAL,
DIMENSION(KI),
INTENT(IN) :: pra
84 REAL,
DIMENSION(KI),
INTENT(IN) :: prhoa
85 REAL,
DIMENSION(KI),
INTENT(IN) :: psand
86 REAL,
DIMENSION(KI),
INTENT(IN) :: ppa
87 REAL,
DIMENSION(KI),
INTENT(IN) :: pta
88 REAL,
DIMENSION(KI),
INTENT(IN) :: ptg
89 REAL,
DIMENSION(KI),
INTENT(IN) :: pu
90 REAL,
DIMENSION(KI),
INTENT(IN) :: puref
91 REAL,
DIMENSION(KI),
INTENT(IN) :: pv
92 REAL,
DIMENSION(KI),
INTENT(IN) :: pwg
93 REAL,
DIMENSION(KI),
INTENT(IN) :: pwsat
94 REAL,
DIMENSION(KI),
INTENT(IN) :: pzref
95 REAL,
DIMENSION(KI),
INTENT(IN) :: pcd
96 REAL,
DIMENSION(KI),
INTENT(IN) :: pcdn
97 REAL,
DIMENSION(KI),
INTENT(IN) :: pch
98 REAL,
DIMENSION(KI),
INTENT(IN) :: pri
99 REAL,
DIMENSION(KI),
INTENT(IN) :: pz0h_with_snow
100 REAL,
DIMENSION(KI,KDST),
INTENT(OUT) :: psfdst
103 REAL,
DIMENSION(KI,NVEGNO_DST,NDSTMDE) :: zsfdst_tile
105 REAL(KIND=JPRB) :: zhook_handle
110 IF (lhook) CALL dr_hook(
'COUPLING_DST_N',0,zhook_handle)
114 zsfdst_tile(:,:,:)=0.d0
119 IF (dst%NSIZE_PATCH_DST(jveg,kpatch)==0) cycle
122 dst%NSIZE_PATCH_DST(jveg,kpatch), &
123 dst%NR_PATCH_DST(:,jveg,kpatch) &
135 IF (lhook) CALL dr_hook(
'COUPLING_DST_N',1,zhook_handle)
143 INTEGER,
INTENT(IN) :: ksize
144 INTEGER,
DIMENSION(:),
INTENT(IN) :: kmask
147 REAL,
DIMENSION(KSIZE) :: zp_clay
148 REAL,
DIMENSION(KSIZE) :: zp_mer10m
149 REAL,
DIMENSION(KSIZE) :: zp_ps
150 REAL,
DIMENSION(KSIZE) :: zp_ts
151 REAL,
DIMENSION(KSIZE) :: zp_qa
152 REAL,
DIMENSION(KSIZE) :: zp_q2m
153 REAL,
DIMENSION(KSIZE) :: zp_hu2m
154 REAL,
DIMENSION(KSIZE) :: zp_rhoa
155 REAL,
DIMENSION(KSIZE) :: zp_rhoa_2m
156 REAL,
DIMENSION(KSIZE) :: zp_sand
157 REAL,
DIMENSION(KSIZE) :: zp_sfdst
158 REAL,
DIMENSION(KSIZE,NDSTMDE) :: zp_sfdst_mde
159 REAL,
DIMENSION(KSIZE) :: zp_sfmer
160 REAL,
DIMENSION(KSIZE) :: zp_sfzon
161 REAL,
DIMENSION(KSIZE) :: zp_pa
162 REAL,
DIMENSION(KSIZE) :: zp_ta
163 REAL,
DIMENSION(KSIZE) :: zp_tg
164 REAL,
DIMENSION(KSIZE) :: zp_t2m
165 REAL,
DIMENSION(KSIZE) :: zp_u
166 REAL,
DIMENSION(KSIZE) :: zp_uref
167 REAL,
DIMENSION(KSIZE) :: zp_ustar
168 REAL,
DIMENSION(KSIZE) :: zp_v
169 REAL,
DIMENSION(KSIZE) :: zp_vmod
170 REAL,
DIMENSION(KSIZE) :: zp_wg
171 REAL,
DIMENSION(KSIZE) :: zp_wind10m
172 REAL,
DIMENSION(KSIZE) :: zp_wsat
173 REAL,
DIMENSION(KSIZE) :: zp_zon10m
174 REAL,
DIMENSION(KSIZE) :: zp_zref
175 REAL,
DIMENSION(KSIZE) :: zp_z0_erod
176 REAL,
DIMENSION(KSIZE,3) :: zp_mss_frc_src
177 REAL,
DIMENSION(KSIZE) :: zp_inter
178 REAL,
DIMENSION(KSIZE) :: zp_cd
179 REAL,
DIMENSION(KSIZE) :: zp_ch
180 REAL,
DIMENSION(KSIZE) :: zp_cd_dst
181 REAL,
DIMENSION(KSIZE) :: zp_cdn
182 REAL,
DIMENSION(KSIZE) :: zp_ri
183 REAL,
DIMENSION(KSIZE) :: zp_z0h_with_snow
184 REAL,
DIMENSION(KSIZE) :: zp_dst_erod
185 REAL,
DIMENSION(KSIZE) :: zh
186 REAL,
DIMENSION(5) :: zseuil
187 REAL,
DIMENSION(6,2) :: zpcen
190 REAL(KIND=JPRB) :: zhook_handle
192 IF (lhook) CALL dr_hook(
'COUPLING_DST_n:TREAT_SURF',0,zhook_handle)
197 zp_clay(jj) = pclay(kmask(jj))
198 zp_ps(jj) = pps(kmask(jj))
199 zp_ts(jj) = pts(kmask(jj))
200 zp_qa(jj) = pqa(kmask(jj))
201 zp_rhoa(jj) = prhoa(kmask(jj))
202 zp_sand(jj) = psand(kmask(jj))
203 zp_pa(jj) = ppa(kmask(jj))
204 zp_ta(jj) = pta(kmask(jj))
205 zp_tg(jj) = ptg(kmask(jj))
206 zp_u(jj) = pu(kmask(jj))
207 zp_uref(jj) = puref(kmask(jj))
208 zp_v(jj) = pv(kmask(jj))
209 zp_wg(jj) = pwg(kmask(jj))
210 zp_wsat(jj) = pwsat(kmask(jj))
211 zp_zref(jj) = pzref(kmask(jj))
212 zp_cd(jj) = pcd(kmask(jj))
213 zp_cdn(jj) = pcdn(kmask(jj))
214 zp_ch(jj) = pch(kmask(jj))
215 zp_ri(jj) = pri(kmask(jj))
216 zp_z0h_with_snow(jj) = pz0h_with_snow(kmask(jj))
220 zp_z0_erod(:) = dst%Z0_EROD_DST(jveg)
225 zp_dst_erod(:) = 0.01
228 zp_cd_dst(:) = zp_cd(:)
230 IF (cvermod/=
'CMDVER')
THEN
234 CALL
surface_cd(zp_ri, zp_zref, zp_uref, zp_z0_erod, zp_z0h_with_snow, zp_cd_dst, zp_cdn)
238 zp_vmod(:) = sqrt(zp_u(:)**2 + zp_v(:)**2)
240 zp_ustar(:) = sqrt(zp_cd_dst(:))*zp_vmod
242 zp_sfzon(:) = - sqrt(zp_cd_dst(:))*zp_u(:)
244 zp_sfmer(:) = - sqrt(zp_cd_dst(:))*zp_v(:)
249 CALL
cls_wind(zp_u, zp_v, zp_uref, zp_cd_dst, zp_cdn, zp_ri, zh, &
250 zp_zon10m, zp_mer10m )
252 CALL
cls_t(zp_ta, zp_qa, zp_pa, zp_ps, zp_zref, zp_cd_dst, zp_ch, zp_ri, &
253 zp_ts, zp_z0h_with_snow, zh, zp_t2m )
256 zp_rhoa_2m(:) = zp_ps(:)/(zp_t2m(:)*xrd)
259 zp_wind10m(:) = sqrt(zp_zon10m(:)**2 + zp_mer10m(:)**2)
262 zp_wind10m(:) = max(zp_wind10m(:), 1e-2)
264 IF (cvermod==
'CMDVER')
THEN
296 zp_mss_frc_src(:,:) = 0.
298 IF (cemisparam_dst ==
"EXPLI" .OR. cemisparam_dst ==
"AMMA ")
THEN
301 zp_ustar(:) = sqrt(zp_cd_dst(:))*zp_vmod(:)
303 zseuil = (/0., 0.35, 0.42, 0.50 ,0.66/)
305 IF (cemisparam_dst ==
"EXPLI")
THEN
307 zpcen(:,1) = (/0., 0., 0.01, 0.08, 0.15, 0.15/)
308 zpcen(:,2) = (/0., 0., 0.36, 0.43, 0.76, 0.76/)
330 ELSEIF (cemisparam_dst ==
"AMMA ")
THEN
334 zpcen(:,1) = (/0., 0., 0.0023, 0.0185, 0.0345, 0.0345/)
335 zpcen(:,2) = (/0., 0., 0.0077, 0.0615, 0.1155, 0.1155/)
359 DO js = 1,
SIZE(zseuil) - 1
360 WHERE (zp_ustar(:) >= zseuil(js) .AND. zp_ustar(:) < zseuil(js+1))
361 zp_inter(:) = (zp_ustar(:) - zseuil(js)) / (zseuil(js+1) - zseuil(js))
362 zp_mss_frc_src(:,1) = zpcen(js,1) + (zpcen(js+1,1) - zpcen(js,1)) * zp_inter(:)
363 zp_mss_frc_src(:,2) = zpcen(js,2) + (zpcen(js+1,2) - zpcen(js,2)) * zp_inter(:)
367 WHERE (zp_ustar(:) >= zseuil(
SIZE(zseuil)))
368 zp_mss_frc_src(:,1) = zpcen(
SIZE(zseuil)+1,1)
369 zp_mss_frc_src(:,2) = zpcen(
SIZE(zseuil)+1,2)
372 zp_mss_frc_src(:,3) = 1. - zp_mss_frc_src(:,1) - zp_mss_frc_src(:,2)
376 zp_mss_frc_src(:,jorder_dst(jmode)) = dst%XMSS_FRC_SRC(jmode)
382 zp_sfdst_mde(:,jmode) = zp_sfdst(:) &
383 * zp_mss_frc_src(:,jorder_dst(jmode))
390 zsfdst_tile(kmask(jj),jveg,jmode) = zp_sfdst_mde(jj,jmode)
394 IF (lhook) CALL dr_hook(
'COUPLING_DST_n:TREAT_SURF',1,zhook_handle)
408 INTEGER,
INTENT(IN) :: ktile
416 REAL :: vegfrac_in_patch
417 REAL(KIND=JPRB) :: zhook_handle
423 IF (lhook) CALL dr_hook(
'AVG_FLUX_DST',0,zhook_handle)
425 nmoment = int(
SIZE(psfdst,2) / ndstmde)
430 IF (nmoment == 1)
THEN
431 jsv_idx = (jmode-1)*nmoment + 1
433 jsv_idx = (jmode-1)*nmoment + 2
443 vegfrac_in_patch = sum(pki%XP_VEGTYPE_PATCH(ii,:))
447 psfdst(ii,jsv_idx) = psfdst(ii,jsv_idx) &
448 + (zsfdst_tile(ii,jj,jmode) &
449 * pki%XP_VEGTYPE_PATCH(ii,dst%NVT_DST(jj)) &
456 IF (lhook) CALL dr_hook(
'AVG_FLUX_DST',1,zhook_handle)
subroutine cls_wind(PZONA, PMERA, PHW, PCD, PCDN, PRI, PHV, PZON10M, PMER10M)
subroutine cls_t(PTA, PQA, PPA, PPS, PHT, PCD, PCH, PRI, PTS, PZ0H, PH, PTNM)
subroutine dustflux_get_mb(PUSTAR, PRHOA, PWG, PZ0, PWSAT, PCLAY, PSAND, PDST_EROD, PWIND10M, PSFDST, KSIZE)
subroutine coupling_dst_n(DST, PKI, HPROGRAM, KI, KDST, KPATCH, PCLAY, PPS, PTS, PQA, PRA, PRHOA, PSAND, PPA, PTA, PTG, PU, PUREF, PV, PWG, PWSAT, PZREF, PCD, PCDN, PCH, PRI, PZ0H_WITH_SNOW, PSFDST)
subroutine dustflux_get(PUSTAR, PRHOA, PWG, PZ0, PWSAT, PCLAY, PSAND, PWIND10M, PSFDST, KSIZE)
subroutine surface_cd(PRI, PZREF, PUREF, PZ0EFF, PZ0H, PCD, PCDN)
subroutine treat_surf(KMASK, YTYPE)
subroutine avg_flux_dst(KTILE)