6 SUBROUTINE init_isba_sbl(HISBA, HCPSURF, KLVL, PTSTEP, PPA, PPS, PTA, PQA, PRHOA, PU, PV, &
7 pdir_sw, psca_sw, psw_bands, prain, psnow, &
8 pzref, puref, ptg, ppatch, pwg, pwgi, pz0, psso_slope, &
9 presa, pveg, plai, pwr, prgl, prsmin, pgamma, pwrmax_cf, &
10 pz0_o_z0h, pwfc, pwsat, ptsnow, pz, pt, pq, pwind, ptke, pp)
36 USE modd_csts, ONLY : xcpd, xrd, xp00, xg, xlvtt
41 USE modi_isba_snow_frac
42 USE modi_wet_leaves_frac
47 USE yomhook
,ONLY : lhook, dr_hook
48 USE parkind1
,ONLY : jprb
54 CHARACTER(LEN=*) ,
INTENT(IN) :: hisba
55 CHARACTER(LEN=*) ,
INTENT(IN) :: hcpsurf
56 REAL,
INTENT(IN) :: ptstep
57 INTEGER ,
INTENT(IN) :: klvl
58 REAL,
DIMENSION(:),
INTENT(IN) :: ppa
59 REAL,
DIMENSION(:),
INTENT(IN) :: pps
60 REAL,
DIMENSION(:),
INTENT(IN) :: pta
61 REAL,
DIMENSION(:),
INTENT(IN) :: pqa
62 REAL,
DIMENSION(:),
INTENT(IN) :: prhoa
63 REAL,
DIMENSION(:),
INTENT(IN) :: pu
64 REAL,
DIMENSION(:),
INTENT(IN) :: pv
65 REAL,
DIMENSION(:,:),
INTENT(IN) :: pdir_sw
67 REAL,
DIMENSION(:,:),
INTENT(IN) :: psca_sw
69 REAL,
DIMENSION(:),
INTENT(IN) :: psw_bands
70 REAL,
DIMENSION(:),
INTENT(IN) :: psnow
71 REAL,
DIMENSION(:),
INTENT(IN) :: prain
72 REAL,
DIMENSION(:),
INTENT(IN) :: pzref
73 REAL,
DIMENSION(:),
INTENT(IN) :: puref
74 REAL,
DIMENSION(:,:),
INTENT(IN):: ptg
75 REAL,
DIMENSION(:,:),
INTENT(IN):: ppatch
76 REAL,
DIMENSION(:,:),
INTENT(IN):: pwg
77 REAL,
DIMENSION(:,:),
INTENT(IN):: pwgi
78 REAL,
DIMENSION(:,:),
INTENT(IN):: pz0
79 REAL,
DIMENSION(:),
INTENT(IN) :: psso_slope
80 REAL,
DIMENSION(:,:),
INTENT(IN):: presa
81 REAL,
DIMENSION(:,:),
INTENT(IN):: pveg
82 REAL,
DIMENSION(:,:),
INTENT(IN):: plai
83 REAL,
DIMENSION(:,:),
INTENT(IN):: pwr
86 REAL,
DIMENSION(:,:),
INTENT(IN):: prgl
88 REAL,
DIMENSION(:,:),
INTENT(IN):: prsmin
89 REAL,
DIMENSION(:,:),
INTENT(IN):: pgamma
92 REAL,
DIMENSION(:,:),
INTENT(IN):: pwrmax_cf
95 REAL,
DIMENSION(:,:),
INTENT(IN):: pz0_o_z0h
97 REAL,
DIMENSION(:,:),
INTENT(IN):: pwfc
99 REAL,
DIMENSION(:,:),
INTENT(IN):: pwsat
101 REAL,
DIMENSION(:,:),
INTENT(IN):: pz
103 REAL,
DIMENSION(:,:),
INTENT(OUT) :: pt
104 REAL,
DIMENSION(:,:),
INTENT(OUT) :: pq
105 REAL,
DIMENSION(:,:),
INTENT(OUT) :: pwind
106 REAL,
DIMENSION(:,:),
INTENT(OUT) :: ptke
107 REAL,
DIMENSION(:,:),
INTENT(OUT) :: pp
113 REAL,
DIMENSION(SIZE(PTA)) :: zwind
114 REAL,
DIMENSION(SIZE(PTA)) :: zexna
115 REAL,
DIMENSION(SIZE(PTA)) :: zqa
119 REAL,
DIMENSION(SIZE(PTA)) ::zri
120 REAL,
DIMENSION(SIZE(PTA)) ::zcd
121 REAL,
DIMENSION(SIZE(PTA)) ::zcdn
122 REAL,
DIMENSION(SIZE(PTA)) ::zch
123 REAL,
DIMENSION(SIZE(PTA)) ::ztnm
124 REAL,
DIMENSION(SIZE(PTA)) ::zqnm
125 REAL,
DIMENSION(SIZE(PTA)) ::zhunm
126 REAL,
DIMENSION(SIZE(PTA)) ::zp_slope_cos
127 REAL,
DIMENSION(SIZE(PTA)) ::zz0
128 REAL,
DIMENSION(SIZE(PTA)) ::zz0h
129 REAL,
DIMENSION(SIZE(PTA)) ::zexns
130 REAL,
DIMENSION(SIZE(PTA)) ::zts
131 REAL,
DIMENSION(SIZE(PTA)) ::zhu
132 REAL,
DIMENSION(SIZE(PTA)) ::zqs
133 REAL,
DIMENSION(SIZE(PTA)) ::zz0eff
134 REAL,
DIMENSION(SIZE(PTA)) ::zwg
135 REAL,
DIMENSION(SIZE(PTA)) ::zwgi
136 REAL,
DIMENSION(SIZE(PTA)) ::zveg
137 REAL,
DIMENSION(SIZE(PTA)) ::zresa
138 REAL,
DIMENSION(SIZE(PTA)) ::zhug
139 REAL,
DIMENSION(SIZE(PTA)) ::zhugi
140 REAL,
DIMENSION(SIZE(PTA)) ::zhv
141 REAL,
DIMENSION(SIZE(PTA)) ::zcps
142 REAL,
DIMENSION(SIZE(PTA)) ::zwrmax_cf
143 REAL,
DIMENSION(SIZE(PTA)) ::zwr
144 REAL,
DIMENSION(SIZE(PTA)) ::zz0_with_snow
145 REAL,
DIMENSION(SIZE(PTA)) ::zpsng
146 REAL,
DIMENSION(SIZE(PTA)) ::zpsnv
147 REAL,
DIMENSION(SIZE(PTA)) ::zpsnv_a
148 REAL,
DIMENSION(SIZE(PTA)) ::zpsn
149 REAL,
DIMENSION(SIZE(PTA)) ::zsnowalb
150 REAL,
DIMENSION(SIZE(PTA),SIZE(PTSNOW%WSNOW,2)) ::zsnowswe
151 REAL,
DIMENSION(SIZE(PTA),SIZE(PTSNOW%WSNOW,2)) ::zsnowrho
152 REAL,
DIMENSION(SIZE(PTA)) ::zffg
153 REAL,
DIMENSION(SIZE(PTA)) ::zffgnos
154 REAL,
DIMENSION(SIZE(PTA)) ::zffv
155 REAL,
DIMENSION(SIZE(PTA)) ::zffvnos
156 REAL,
DIMENSION(SIZE(PTA)) ::zff
157 REAL,
DIMENSION(SIZE(PTA)) ::zrs
158 REAL,
DIMENSION(SIZE(PTA)) ::zp_global_sw
159 REAL,
DIMENSION(SIZE(PTA)) ::zf2
160 REAL,
DIMENSION(SIZE(PTA)) ::zf5
161 REAL,
DIMENSION(SIZE(PTA)) ::zlai
162 REAL,
DIMENSION(SIZE(PTA)) ::zgamma
163 REAL,
DIMENSION(SIZE(PTA)) ::zrgl
164 REAL,
DIMENSION(SIZE(PTA)) ::zrsmin
165 REAL,
DIMENSION(SIZE(PTA)) ::zdelta
166 REAL,
DIMENSION(SIZE(PTA)) ::zwrmax
167 REAL,
DIMENSION(SIZE(PTA)) ::zcls_wind_zon
168 REAL,
DIMENSION(SIZE(PTA)) ::zcls_wind_mer
169 REAL,
DIMENSION(SIZE(PTA),SIZE(PTSNOW%WSNOW,2)) ::zsum_layer
170 REAL,
DIMENSION(SIZE(PTA)) ::zsum
171 REAL,
DIMENSION(SIZE(PTA)) :: zleg_delta
172 REAL,
DIMENSION(SIZE(PTA)) :: zlegi_delta
173 REAL,
DIMENSION(SIZE(PTA)) :: zlvtt
179 REAL,
DIMENSION(SIZE(PTA),SIZE(PPATCH,2)) ::zwsnow
180 REAL(KIND=JPRB) :: zhook_handle
183 IF (lhook) CALL dr_hook(
'INIT_ISBA_SBL',0,zhook_handle)
186 zts = sum(ptg(:,:)*ppatch(:,:) ,dim=2)
187 zwg = sum(pwg(:,:)*ppatch(:,:) ,dim=2)
188 zwgi = sum(pwgi(:,:)*ppatch(:,:),dim=2)
189 zz0 = sum(ppatch(:,:)*pz0(:,:) ,dim=2)
194 zz0h(:) = sum(ppatch(:,:) * pz0(:,:)/pz0_o_z0h(:,:),dim=2)
195 zveg(:) = sum(ppatch(:,:) * pveg(:,:) ,dim=2)
197 zp_slope_cos(:) = 1./sqrt(1.+psso_slope(:)**2)
198 IF (lnosof) zp_slope_cos(:) = 1.0
200 zresa(:) = sum(ppatch(:,:)*presa(:,:),dim=2)
202 zlai(:)= sum(ppatch(:,:)*pveg(:,:)*plai(:,:) ,dim=2,mask=pveg(:,:)>0) / zveg(:)
203 zwrmax_cf(:)= sum(ppatch(:,:)*pveg(:,:)*pwrmax_cf(:,:),dim=2,mask=pveg(:,:)>0) / zveg(:)
204 zwr(:)= sum(ppatch(:,:)*pveg(:,:)*pwr(:,:) ,dim=2,mask=pveg(:,:)>0) / zveg(:)
207 zwrmax_cf(:) = pwrmax_cf(:,1)
214 DO jlayer=1,
SIZE(ptsnow%WSNOW,2)
215 zsnowswe(:,jlayer) = sum(ppatch(:,:)*ptsnow%WSNOW(:,jlayer,:),dim=2)
216 zsum_layer(:,jlayer) = sum(ppatch(:,:),dim=2,mask=ptsnow%WSNOW(:,jlayer,:)>0)
217 WHERE(zsum_layer(:,jlayer)>0)
218 zsnowrho(:,jlayer)= sum( ppatch(:,:)*ptsnow%RHO(:,jlayer,:), dim=2, &
219 mask=ptsnow%WSNOW(:,jlayer,:)>0) / zsum_layer(:,jlayer)
221 zsnowrho(:,jlayer)=ptsnow%RHO(:,jlayer,1)
225 zsum(:)=sum(zsum_layer(:,:),dim=2)
228 DO jpatch=1,
SIZE(ptsnow%WSNOW,3)
229 DO jlayer=1,
SIZE(ptsnow%WSNOW,2)
230 zwsnow(:,jpatch) = zwsnow(:,jpatch) + ptsnow%WSNOW(:,jlayer,jpatch)
235 zsnowalb(:) = sum(ppatch(:,:)*ptsnow%ALB(:,:),dim=2,mask=zwsnow(:,:)>0) / zsum(:)
237 zsnowalb(:) = ptsnow%ALB(:,1)
240 zrgl(:) = sum(ppatch(:,:) * prgl(:,:),dim=2)
241 zrsmin(:) = sum(ppatch(:,:) * prsmin(:,:),dim=2)
242 zgamma(:) = sum(ppatch(:,:) * pgamma(:,:),dim=2)
244 zexna(:) = (ppa(:)/xp00)**(xrd/xcpd)
245 zexns(:) = (pps(:)/xp00)**(xrd/xcpd)
246 zqa(:) = pqa(:) / prhoa(:)
247 zwind(:) = sqrt(pu**2+pv**2)
251 zsnowswe, zsnowrho, zsnowalb, &
253 zpsn, zpsnv_a, zpsng, zpsnv )
257 DO jswb=1,
SIZE(psw_bands)
258 zp_global_sw(:) = zp_global_sw(:) + (pdir_sw(:,jswb) + psca_sw(:,jswb))
263 CALL
veg(zp_global_sw, pta, zqa, pps, zrgl, zlai, zrsmin, zgamma, zf2, zrs)
265 CALL
wet_leaves_frac(zwr, zveg, zwrmax_cf, zz0_with_snow, zlai, zwrmax, zdelta)
277 CALL
drag(hisba, ptsnow%SCHEME, hcpsurf, ptstep, &
278 zts, zwg, zwgi, zexns, zexna, pta, &
279 zwind, zqa, prain, psnow, pps, zrs, &
280 zveg, zz0, zz0eff, zz0h, pwfc(:,1), pwsat(:,1), &
281 zpsng, zpsnv, pzref, puref, zp_slope_cos, zdelta, zf5, &
282 zresa, zch, zcd, zcdn, zri, zhug, zhugi, zhv, zhu, zcps, &
283 zqs, zffg, zffv, zff, zffgnos, zffvnos, zleg_delta, zlegi_delta, &
289 CALL
cls_tq(pta, zqa, ppa, pps, pzref, zcd, zch, zri, zts, zhu, zz0h, &
290 pz(:,jlayer), ztnm, zqnm, zhunm )
295 CALL
cls_wind(pu, pv, puref, zcd, zcdn, zri, pz(:,jlayer), &
296 zcls_wind_zon, zcls_wind_mer )
298 pwind(:,jlayer) = sqrt( zcls_wind_zon(:)**2 + zcls_wind_mer(:)**2 )
299 ptke(:,jlayer) = xalpsbl * zcd(:) * ( pu(:)**2 + pv(:)**2 )
300 pp(:,jlayer) = ppa(:) + xg * prhoa(:) * (pz(:,klvl) - pz(:,jlayer))
304 IF (lhook) CALL dr_hook(
'INIT_ISBA_SBL',1,zhook_handle)
subroutine cls_wind(PZONA, PMERA, PHW, PCD, PCDN, PRI, PHV, PZON10M, PMER10M)
subroutine init_isba_sbl(HISBA, HCPSURF, KLVL, PTSTEP, PPA, PPS, PTA, PQA, PRHOA, PU, PV, PDIR_SW, PSCA_SW, PSW_BANDS, PRAIN, PSNOW, PZREF, PUREF, PTG, PPATCH, PWG, PWGI, PZ0, PSSO_SLOPE, PRESA, PVEG, PLAI, PWR, PRGL, PRSMIN, PGAMMA, PWRMAX_CF, PZ0_O_Z0H, PWFC, PWSAT, PTSNOW, PZ, PT, PQ, PWIND, PTKE, PP)
subroutine wet_leaves_frac(PWRM, PVEG, PWRMAX_CF, PZ0, PLAI, PWRMAX, PDELTA)
subroutine veg(PSW_RAD, PTA, PQA, PPS, PRGL, PLAI, PRSMIN, PGAMMA, PF2, PRS)
subroutine drag(HISBA, HSNOW_ISBA, HCPSURF, PTSTEP, PTG, PWG, PWGI, PEXNS, PEXNA, PTA, PVMOD, PQA, PRR, PSR, PPS, PRS, PVEG, PZ0, PZ0EFF, PZ0H, PWFC, PWSAT, PPSNG, PPSNV, PZREF, PUREF, PDIRCOSZW, PDELTA, PF5, PRA, PCH, PCD, PCDN, PRI, PHUG, PHUGI, PHV, PHU, PCPS, PQS, PFFG, PFFV, PFF, PFFG_NOSNOW, PFFV_NOSNOW, PLEG_DELTA, PLEGI_DELTA, PWR, PRHOA, PLVTT, PQSAT)
subroutine cls_tq(PTA, PQA, PPA, PPS, PHT, PCD, PCH, PRI, PTS, PHU, PZ0H, PH, PTNM, PQNM, PHUNM)
subroutine isba_snow_frac(HSNOW, PWSNOW, PRSNOW, PASNOW, PVEG, PLAI, PZ0, PPSN, PPSNV_A, PPSNG, PPSNV)