6 SUBROUTINE teb_canopy(KI,KLVL,PZ,PZF,PDZ,PDZF,PBLD,PBLD_HEIGHT,PWALL_O_HOR,PPA,PRHOA,PU, &
7 pduwdu_road, puw_roof, pduwdu_roof, &
8 ph_wall,ph_roof,pe_roof,pac_road,pac_road_wat, &
9 pforc_u,pdforc_udu,pforc_e,pdforc_ede,pforc_t,pdforc_tdt,pforc_q,pdforc_qdq)
34 USE modd_csts, ONLY : xrd, xcpd, xp00, xg, xpi
37 USE yomhook
,ONLY : lhook, dr_hook
38 USE parkind1
,ONLY : jprb
46 INTEGER,
INTENT(IN) :: ki
47 INTEGER,
INTENT(IN) :: klvl
48 REAL,
DIMENSION(KI,KLVL),
INTENT(IN) :: pz
49 REAL,
DIMENSION(KI,KLVL),
INTENT(IN) :: pzf
50 REAL,
DIMENSION(KI,KLVL),
INTENT(IN) :: pdz
51 REAL,
DIMENSION(KI,KLVL),
INTENT(IN) :: pdzf
52 REAL,
DIMENSION(KI),
INTENT(IN) :: pbld
53 REAL,
DIMENSION(KI),
INTENT(IN) :: pbld_height
54 REAL,
DIMENSION(KI),
INTENT(IN) :: pwall_o_hor
56 REAL,
DIMENSION(KI,KLVL),
INTENT(IN) :: pu
58 REAL,
DIMENSION(KI),
INTENT(IN) :: ppa
59 REAL,
DIMENSION(KI),
INTENT(IN) :: prhoa
61 REAL,
DIMENSION(KI),
INTENT(IN) :: pduwdu_road
62 REAL,
DIMENSION(KI),
INTENT(IN) :: puw_roof
63 REAL,
DIMENSION(KI),
INTENT(IN) :: pduwdu_roof
64 REAL,
DIMENSION(KI),
INTENT(IN) :: ph_wall
65 REAL,
DIMENSION(KI),
INTENT(IN) :: ph_roof
66 REAL,
DIMENSION(KI),
INTENT(IN) :: pe_roof
67 REAL,
DIMENSION(KI),
INTENT(IN) :: pac_road
68 REAL,
DIMENSION(KI),
INTENT(IN) :: pac_road_wat
70 REAL,
DIMENSION(KI,KLVL),
INTENT(OUT) :: pforc_u
71 REAL,
DIMENSION(KI,KLVL),
INTENT(OUT) :: pdforc_udu
73 REAL,
DIMENSION(KI,KLVL),
INTENT(OUT) :: pforc_e
74 REAL,
DIMENSION(KI,KLVL),
INTENT(OUT) :: pdforc_ede
76 REAL,
DIMENSION(KI,KLVL),
INTENT(OUT) :: pforc_t
77 REAL,
DIMENSION(KI,KLVL),
INTENT(OUT) :: pdforc_tdt
79 REAL,
DIMENSION(KI,KLVL),
INTENT(OUT) :: pforc_q
80 REAL,
DIMENSION(KI,KLVL),
INTENT(OUT) :: pdforc_qdq
87 REAL,
DIMENSION(KI,KLVL) :: zcdrag
88 REAL,
DIMENSION(KI,KLVL) :: zsh
90 REAL,
DIMENSION(KI,KLVL) :: zsv
92 REAL,
DIMENSION(KI,KLVL) :: zforc
93 REAL,
DIMENSION(KI,KLVL) :: zdensity
94 REAL,
DIMENSION(KI,KLVL) :: zairvol
95 REAL,
DIMENSION(KI,KLVL) :: zp
96 REAL,
DIMENSION(KI,KLVL) :: zexn
97 REAL(KIND=JPRB) :: zhook_handle
107 IF (lhook) CALL dr_hook(
'TEB_CANOPY',0,zhook_handle)
109 zsh(:,1) = (1.-pbld(:))
111 WHERE( pzf(:,2)>=pbld_height(:) ) zsh(:,2) = pbld(:)
113 WHERE( pzf(:,jlayer)<pbld_height(:) .AND. pzf(:,jlayer+1)>=pbld_height(:) ) zsh(:,jlayer) = pbld(:)
115 WHERE( pzf(:,klvl)<pbld_height(:) ) zsh(:,klvl) = pbld(:)
122 zcdrag(:,:) = zcdrag(:,:) / xpi
137 zdensity(:,jlayer) = pwall_o_hor(:)
140 CALL
canopy(ki, klvl, pzf, pdz, pbld_height, zdensity, zcdrag, pu, zairvol, &
141 zsv, zforc, pforc_u, pdforc_udu, pforc_e, pdforc_ede )
159 zforc(:,:) = zsh(:,:)/zairvol(:,:)/pdz(:,:)
167 pforc_u(:,jlayer) = pforc_u(:,jlayer) + puw_roof(:) * zforc(:,jlayer)
168 pdforc_udu(:,jlayer) = pdforc_udu(:,jlayer) + pduwdu_roof(:) * zforc(:,jlayer)
175 pforc_u(:,1) = pforc_u(:,1)
176 pdforc_udu(:,1) = pdforc_udu(:,1) + pduwdu_road(:) * zsh(:,1)/pdz(:,1)
191 pdforc_tdt(:,1) = pdforc_tdt(:,1) - pac_road(:)
207 zforc(:,jlayer) = 1. / zairvol(:,jlayer) / pdz(:,jlayer) / prhoa(:) / xcpd
208 pforc_t(:,jlayer) = pforc_t(:,jlayer) + ph_wall * zsv(:,jlayer) * zforc(:,jlayer)
209 pdforc_tdt(:,jlayer) = pdforc_tdt(:,jlayer) + 0.
216 pforc_t(:,jlayer) = pforc_t(:,jlayer) + ph_roof * zsh(:,jlayer) * zforc(:,jlayer)
217 pdforc_tdt(:,jlayer) = pdforc_tdt(:,jlayer) + 0.
226 zp(:,jlayer) = ppa(:) + xg * prhoa(:) * (pz(:,klvl) - pz(:,jlayer))
228 zexn = (zp/xp00)**(xrd/xcpd)
230 pforc_t = pforc_t * zexn
231 pdforc_tdt = pdforc_tdt * zexn
249 pdforc_qdq(:,1) = pdforc_qdq(:,1) - pac_road_wat(:)
264 pforc_q(:,jlayer) = pforc_q(:,jlayer) + pe_roof * zsh(:,jlayer)/zairvol(:,jlayer)/pdz(:,jlayer)
265 pdforc_qdq(:,jlayer) = pdforc_qdq(:,jlayer) + 0.
267 IF (lhook) CALL dr_hook(
'TEB_CANOPY',1,zhook_handle)
subroutine teb_canopy(KI, KLVL, PZ, PZF, PDZ, PDZF, PBLD, PBLD_HEIGHT, PWALL_O_HOR, PPA, PRHOA, PU, PDUWDU_ROAD, PUW_ROOF, PDUWDU_ROOF, PH_WALL, PH_ROOF, PE_ROOF, PAC_ROAD, PAC_ROAD_WAT, PFORC_U, PDFORC_UDU, PFORC_E, PDFORC_EDE, PFORC_T, PDFORC_TDT, PFORC_Q, PDFORC_QDQ)
subroutine canopy(KI, KLVL, PZF, PDZ, PHEIGHT, PDENSITY, PCDRAG, PU, PAIRVOL, PSV, PFORC, PFORC_U, PDFORC_UDU, PFORC_E, PDFORC_EDE)