133 & LBi, UBi, LBj, UBj, &
134 & IminS, ImaxS, JminS, JmaxS &
137 & rmask, umask, vmask, &
141 & rho, ad_rho, t, ad_t, &
142 & Hair, Pair, Tair, &
147# ifdef BBL_MODEL_NOT_YET
159 & ad_sustr, ad_svstr)
173 integer,
intent(in) :: ng, tile
174 integer,
intent(in) :: LBi, UBi, LBj, UBj
175 integer,
intent(in) :: IminS, ImaxS, JminS, JmaxS
176 integer,
intent(in) :: nrhs
180 real(r8),
intent(in) :: rmask(LBi:,LBj:)
181 real(r8),
intent(in) :: umask(LBi:,LBj:)
182 real(r8),
intent(in) :: vmask(LBi:,LBj:)
184 real(r8),
intent(in) :: alpha(LBi:,LBj:)
185 real(r8),
intent(in) :: beta(LBi:,LBj:)
186 real(r8),
intent(in) :: rho(LBi:,LBj:,:)
187 real(r8),
intent(in) :: t(LBi:,LBj:,:,:,:)
188 real(r8),
intent(in) :: Hair(LBi:,LBj:)
189 real(r8),
intent(in) :: Pair(LBi:,LBj:)
190 real(r8),
intent(in) :: Tair(LBi:,LBj:)
191 real(r8),
intent(in) :: Uwind(LBi:,LBj:)
192 real(r8),
intent(in) :: Vwind(LBi:,LBj:)
193 real(r8),
intent(inout) :: ad_alpha(LBi:,LBj:)
194 real(r8),
intent(inout) :: ad_beta(LBi:,LBj:)
195 real(r8),
intent(inout) :: ad_rho(LBi:,LBj:,:)
196 real(r8),
intent(inout) :: ad_t(LBi:,LBj:,:,:,:)
198 real(r8),
intent(in) :: cloud(LBi:,LBj:)
200# ifdef BBL_MODEL_NOT_YET
201 real(r8),
intent(in) :: Awave(LBi:,LBj:)
202 real(r8),
intent(in) :: Pwave(LBi:,LBj:)
204 real(r8),
intent(in) :: rain(LBi:,LBj:)
206 real(r8),
intent(inout) :: lhflx(LBi:,LBj:)
207 real(r8),
intent(inout) :: lrflx(LBi:,LBj:)
208 real(r8),
intent(inout) :: shflx(LBi:,LBj:)
209 real(r8),
intent(inout) :: srflx(LBi:,LBj:)
210 real(r8),
intent(inout) :: stflx(LBi:,LBj:,:)
211 real(r8),
intent(inout) :: ad_lhflx(LBi:,LBj:)
212 real(r8),
intent(inout) :: ad_lrflx(LBi:,LBj:)
213 real(r8),
intent(inout) :: ad_shflx(LBi:,LBj:)
214 real(r8),
intent(inout) :: ad_stflx(LBi:,LBj:,:)
217 real(r8),
intent(in) :: evap(LBi:,LBj:)
218 real(r8),
intent(inout) :: ad_evap(LBi:,LBj:)
220 real(r8),
intent(inout) :: ad_sustr(LBi:,LBj:)
221 real(r8),
intent(inout) :: ad_svstr(LBi:,LBj:)
224 real(r8),
intent(in) :: rmask(LBi:UBi,LBj:UBj)
225 real(r8),
intent(in) :: umask(LBi:UBi,LBj:UBj)
226 real(r8),
intent(in) :: vmask(LBi:UBi,LBj:UBj)
228 real(r8),
intent(in) :: alpha(LBi:UBi,LBj:UBj)
229 real(r8),
intent(in) :: beta(LBi:UBi,LBj:UBj)
230 real(r8),
intent(in) :: rho(LBi:UBi,LBj:UBj,N(ng))
231 real(r8),
intent(in) :: t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
232 real(r8),
intent(in) :: Hair(LBi:UBi,LBj:UBj)
233 real(r8),
intent(in) :: Pair(LBi:UBi,LBj:UBj)
234 real(r8),
intent(in) :: Tair(LBi:UBi,LBj:UBj)
235 real(r8),
intent(in) :: Uwind(LBi:UBi,LBj:UBj)
236 real(r8),
intent(in) :: Vwind(LBi:UBi,LBj:UBj)
237 real(r8),
intent(inout) :: ad_alpha(LBi:UBi,LBj:UBj)
238 real(r8),
intent(inout) :: ad_beta(LBi:UBi,LBj:UBj)
239 real(r8),
intent(inout) :: ad_rho(LBi:UBi,LBj:UBj,N(ng))
240 real(r8),
intent(inout) :: ad_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
242 real(r8),
intent(in) :: cloud(LBi:UBi,LBj:UBj)
244# ifdef BBL_MODEL_NOT_YET
245 real(r8),
intent(in) :: Awave(LBi:UBi,LBj:UBj)
246 real(r8),
intent(in) :: Pwave(LBi:UBi,LBj:UBj)
248 real(r8),
intent(in) :: rain(LBi:UBi,LBj:UBj)
250 real(r8),
intent(inout) :: lhflx(LBi:UBi,LBj:UBj)
251 real(r8),
intent(inout) :: lrflx(LBi:UBi,LBj:UBj)
252 real(r8),
intent(inout) :: shflx(LBi:UBi,LBj:UBj)
253 real(r8),
intent(inout) :: srflx(LBi:UBi,LBj:UBj)
254 real(r8),
intent(inout) :: stflx(LBi:UBi,LBj:UBj,NT(ng))
255 real(r8),
intent(inout) :: ad_lhflx(LBi:UBi,LBj:UBj)
256 real(r8),
intent(inout) :: ad_lrflx(LBi:UBi,LBj:UBj)
257 real(r8),
intent(inout) :: ad_shflx(LBi:UBi,LBj:UBj)
258 real(r8),
intent(inout) :: ad_stflx(LBi:UBi,LBj:UBj,NT(ng))
261 real(r8),
intent(in) :: evap(LBi:UBi,LBj:UBj)
262 real(r8),
intent(inout) :: ad_evap(LBi:UBi,LBj:UBj)
264 real(r8),
intent(inout) :: ad_sustr(LBi:UBi,LBj:UBj)
265 real(r8),
intent(inout) :: ad_svstr(LBi:UBi,LBj:UBj)
270 integer :: Iter, IterA, i, j, k
271 integer,
parameter :: IterMax = 3
273 real(r8),
parameter :: eps = 1.0e-20_r8
274 real(r8),
parameter :: r3 = 1.0_r8/3.0_r8
276 real(r8) :: Bf, Cd, Hl, Hlw, Hscale, Hs, Hsr, IER
277 real(r8) :: ad_Bf, ad_Cd, ad_Hl, ad_Hlw, ad_Hsr, ad_Hs
278 real(r8) :: PairM, RH, Taur
279 real(r8) :: Wspeed, ZQoL, ZToL
281 real(r8) :: cff, cff1, cff2, diffh, diffw, oL, upvel
282 real(r8) :: twopi_inv, wet_bulb
283 real(r8) :: ad_wet_bulb, ad_Wspeed
284 real(r8) :: fac, ad_fac, fac1, ad_fac1, fac2, ad_fac2
285 real(r8) :: fac3, ad_fac3, ad_cff, ad_upvel
286 real(r8) :: adfac, adfac1, adfac2
288 real(r8) :: e_sat, vap_p
291 real(r8) :: Clam, Fc, Hcool, Hsb, Hlb, Qbouy, Qcool, lambd
292 real(r8) :: ad_Clam, ad_Hcool, ad_Hsb, ad_Hlb
293 real(r8) :: ad_Qbouy, ad_Qcool, ad_lambd
296 real(r8),
dimension(IminS:ImaxS) :: CC
297 real(r8),
dimension(IminS:ImaxS) :: Cd10
298 real(r8),
dimension(IminS:ImaxS) :: Ch10
299 real(r8),
dimension(IminS:ImaxS) :: Ct10
300 real(r8),
dimension(IminS:ImaxS) :: charn
301 real(r8),
dimension(IminS:ImaxS) :: Ct
302 real(r8),
dimension(IminS:ImaxS) :: Cwave
303 real(r8),
dimension(IminS:ImaxS) :: Cwet
304 real(r8),
dimension(IminS:ImaxS) :: delQ
305 real(r8),
dimension(IminS:ImaxS) :: delQc
306 real(r8),
dimension(IminS:ImaxS) :: delT
307 real(r8),
dimension(IminS:ImaxS) :: delTc
308 real(r8),
dimension(IminS:ImaxS) :: delW
309 real(r8),
dimension(IminS:ImaxS) :: delW1
310 real(r8),
dimension(IminS:ImaxS) :: L
311 real(r8),
dimension(IminS:ImaxS) :: L10
312 real(r8),
dimension(IminS:ImaxS) :: Lwave
313 real(r8),
dimension(IminS:ImaxS) :: Q
314 real(r8),
dimension(IminS:ImaxS) :: Qair
315 real(r8),
dimension(IminS:ImaxS) :: Qpsi
316 real(r8),
dimension(IminS:ImaxS) :: Qsea
317 real(r8),
dimension(IminS:ImaxS) :: Qstar
318 real(r8),
dimension(IminS:ImaxS) :: rhoAir
319 real(r8),
dimension(IminS:ImaxS) :: rhoSea
320 real(r8),
dimension(IminS:ImaxS) :: Ri
321 real(r8),
dimension(IminS:ImaxS) :: Ribcu
322 real(r8),
dimension(IminS:ImaxS) :: Rr
323 real(r8),
dimension(IminS:ImaxS) :: Scff
324 real(r8),
dimension(IminS:ImaxS) :: TairC
325 real(r8),
dimension(IminS:ImaxS) :: TairK
326 real(r8),
dimension(IminS:ImaxS) :: Tcff
327 real(r8),
dimension(IminS:ImaxS) :: Tpsi
328 real(r8),
dimension(IminS:ImaxS) :: TseaC
329 real(r8),
dimension(IminS:ImaxS) :: TseaK
330 real(r8),
dimension(IminS:ImaxS) :: Tstar
331 real(r8),
dimension(IminS:ImaxS) :: u10
332 real(r8),
dimension(IminS:ImaxS) :: VisAir
333 real(r8),
dimension(IminS:ImaxS) :: Wgus
334 real(r8),
dimension(IminS:ImaxS) :: Wmag
335 real(r8),
dimension(IminS:ImaxS) :: Wpsi
336 real(r8),
dimension(IminS:ImaxS) :: Wstar
337 real(r8),
dimension(IminS:ImaxS) :: Zetu
338 real(r8),
dimension(IminS:ImaxS) :: Zo10
339 real(r8),
dimension(IminS:ImaxS) :: ZoT10
340 real(r8),
dimension(IminS:ImaxS) :: ZoL
341 real(r8),
dimension(IminS:ImaxS) :: ZoQ
342 real(r8),
dimension(IminS:ImaxS) :: ZoT
343 real(r8),
dimension(IminS:ImaxS) :: ZoW
344 real(r8),
dimension(IminS:ImaxS) :: ZWoL
346 real(r8),
dimension(IminS:ImaxS) :: Wstar1
347 real(r8),
dimension(IminS:ImaxS) :: Tstar1
348 real(r8),
dimension(IminS:ImaxS) :: Qstar1
349 real(r8),
dimension(IminS:ImaxS) :: delTc1
351 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: Hlv
352 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: LHeat
353 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: LRad
354 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: SHeat
355 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: SRad
356 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: Taux
357 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: Tauy
359 real(r8),
dimension(IminS:ImaxS) :: ad_CC
360 real(r8),
dimension(IminS:ImaxS) :: ad_charn
361 real(r8),
dimension(IminS:ImaxS) :: ad_Ct
362 real(r8),
dimension(IminS:ImaxS) :: ad_Cd10
363 real(r8),
dimension(IminS:ImaxS) :: ad_Ct10
364 real(r8),
dimension(IminS:ImaxS) :: ad_Cwet
365 real(r8),
dimension(IminS:ImaxS) :: ad_delQ
366 real(r8),
dimension(IminS:ImaxS) :: ad_delQc
367 real(r8),
dimension(IminS:ImaxS) :: ad_delT
368 real(r8),
dimension(IminS:ImaxS) :: ad_delTc
369 real(r8),
dimension(IminS:ImaxS) :: ad_delW
370 real(r8),
dimension(IminS:ImaxS) :: ad_L
371 real(r8),
dimension(IminS:ImaxS) :: ad_L10
372 real(r8),
dimension(IminS:ImaxS) :: ad_Q
373 real(r8),
dimension(IminS:ImaxS) :: ad_Qpsi
374 real(r8),
dimension(IminS:ImaxS) :: ad_Qsea
375 real(r8),
dimension(IminS:ImaxS) :: ad_Qstar
376 real(r8),
dimension(IminS:ImaxS) :: ad_rhoSea
377 real(r8),
dimension(IminS:ImaxS) :: ad_Ri
378 real(r8),
dimension(IminS:ImaxS) :: ad_Rr
379 real(r8),
dimension(IminS:ImaxS) :: ad_Scff
380 real(r8),
dimension(IminS:ImaxS) :: ad_Tcff
381 real(r8),
dimension(IminS:ImaxS) :: ad_Tpsi
382 real(r8),
dimension(IminS:ImaxS) :: ad_TseaC
383 real(r8),
dimension(IminS:ImaxS) :: ad_TseaK
384 real(r8),
dimension(IminS:ImaxS) :: ad_Tstar
385 real(r8),
dimension(IminS:ImaxS) :: ad_u10
386 real(r8),
dimension(IminS:ImaxS) :: ad_Wgus
387 real(r8),
dimension(IminS:ImaxS) :: ad_Wpsi
388 real(r8),
dimension(IminS:ImaxS) :: ad_Wstar
389 real(r8),
dimension(IminS:ImaxS) :: ad_Zetu
390 real(r8),
dimension(IminS:ImaxS) :: ad_Zo10
391 real(r8),
dimension(IminS:ImaxS) :: ad_ZoT10
392 real(r8),
dimension(IminS:ImaxS) :: ad_ZoL
393 real(r8),
dimension(IminS:ImaxS) :: ad_ZoQ
394 real(r8),
dimension(IminS:ImaxS) :: ad_ZoT
395 real(r8),
dimension(IminS:ImaxS) :: ad_ZoW
396 real(r8),
dimension(IminS:ImaxS) :: ad_ZWoL
398 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: ad_Hlv
399 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: ad_LHeat
400 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: ad_LRad
401 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: ad_SHeat
402 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: ad_Taux
403 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: ad_Tauy
405# include "set_bounds.h"
499 & lbi, ubi, lbj, ubj, &
502 & ad_sustr, ad_svstr)
512 & lbi, ubi, lbj, ubj, &
516 & ad_stflx(:,:,
isalt))
526 & lbi, ubi, lbj, ubj, &
529 & ad_lrflx, ad_lhflx, ad_shflx, &
530 & ad_stflx(:,:,
itemp))
537 CALL ad_exchange_v2d_tile (ng, tile, &
538 & lbi, ubi, lbj, ubj, &
544 CALL ad_exchange_u2d_tile (ng, tile, &
545 & lbi, ubi, lbj, ubj, &
552 CALL ad_exchange_r2d_tile (ng, tile, &
553 & lbi, ubi, lbj, ubj, &
554 & ad_stflx(:,:,
isalt))
559 CALL ad_exchange_r2d_tile (ng, tile, &
560 & lbi, ubi, lbj, ubj, &
567 CALL ad_exchange_r2d_tile (ng, tile, &
568 & lbi, ubi, lbj, ubj, &
569 & ad_stflx(:,:,
itemp))
574 CALL ad_exchange_r2d_tile (ng, tile, &
575 & lbi, ubi, lbj, ubj, &
581 CALL ad_exchange_r2d_tile (ng, tile, &
582 & lbi, ubi, lbj, ubj, &
588 CALL ad_exchange_r2d_tile (ng, tile, &
589 & lbi, ubi, lbj, ubj, &
630 ad_sustr(i,j)=ad_sustr(i,j)*umask(i,j)
633 adfac=cff*ad_sustr(i,j)
634 ad_taux(i-1,j)=ad_taux(i-1,j)+adfac
635 ad_taux(i ,j)=ad_taux(i ,j)+adfac
636# if !(defined AD_SENSITIVITY || defined ADJUST_WSTRESS || \
637 defined i4dvar_ana_sensitivity || defined opt_observations || \
647 ad_svstr(i,j)=ad_svstr(i,j)*vmask(i,j)
650 adfac=cff*ad_svstr(i,j)
651 ad_tauy(i,j-1)=ad_tauy(i,j-1)+adfac
652 ad_tauy(i,j )=ad_tauy(i,j )+adfac
653# if !(defined AD_SENSITIVITY || defined ADJUST_WSTRESS || \
654 defined i4dvar_ana_sensitivity || defined opt_observations || \
666 tseac(i)=t(i,j,n(ng),nrhs,
itemp)
667 hlv(i,j)=(2.501_r8-0.00237_r8*tseac(i))*1.0e+6_r8
678 ad_evap(i,j)=ad_evap(i,j)*rmask(i,j)
680 ad_stflx(i,j,
isalt)=ad_stflx(i,j,
isalt)*rmask(i,j)
683 ad_stflx(i,j,
itemp)=ad_stflx(i,j,
itemp)*rmask(i,j)
687 ad_evap(i,j)=ad_evap(i,j)+cff*ad_stflx(i,j,
isalt)
688# if !(defined AD_SENSITIVITY || defined ADJUST_STFLUX || \
689 defined i4dvar_ana_sensitivity || defined opt_observations || \
691 ad_stflx(i,j,
isalt)=0.0_r8
695 adfac=ad_evap(i,j)/hlv(i,j)
696 ad_lheat(i,j)=ad_lheat(i,j)+adfac
697 ad_hlv(i,j)=ad_hlv(i,j)-adfac*evap(i,j)
698# if !(defined AD_SENSITIVITY || defind I4DVAR_ANA_SENSITIVITY || \
699 defined opt_observations || defined so_semi)
705 ad_lrflx(i,j)=ad_lrflx(i,j)+ad_stflx(i,j,
itemp)
706 ad_lhflx(i,j)=ad_lhflx(i,j)+ad_stflx(i,j,
itemp)
707 ad_shflx(i,j)=ad_shflx(i,j)+ad_stflx(i,j,
itemp)
708# if !(defined AD_SENSITIVITY || defined I4DVAR_ANA_SENSITIVITY || \
709 defined opt_observations || defined so_semi)
710 ad_stflx(i,j,
itemp)=0.0_r8
713 ad_sheat(i,j)=ad_sheat(i,j)-ad_shflx(i,j)*hscale
714# if !(defined AD_SENSITIVITY || defined I4DVAR_ANA_SENSITIVITY || \
715 defined opt_observations || defined so_semi)
719 ad_lheat(i,j)=ad_lheat(i,j)-ad_lhflx(i,j)*hscale
720# if !(defined AD_SENSITIVITY || defined I4DVAR_ANA_SENSITIVITY || \
721 defined opt_observations || defined so_semi)
725 ad_lrad(i,j)=ad_lrad(i,j)+ad_lrflx(i,j)*hscale
744 wmag(i)=sqrt(uwind(i,j)*uwind(i,j)+vwind(i,j)*vwind(i,j))
747 tairk(i)=tairc(i)+273.16_r8
748 tseac(i)=t(i,j,n(ng),nrhs,
itemp)
749 tseak(i)=tseac(i)+273.16_r8
750 rhosea(i)=rho(i,j,n(ng))+1000.0_r8
752 srad(i,j)=srflx(i,j)*hscale
760 lheat(i,j)=lhflx(i,j)*hscale
761 sheat(i,j)=shflx(i,j)*hscale
778 cff=(0.7859_r8+0.03477_r8*tairc(i))/ &
779 & (1.0_r8+0.00412_r8*tairc(i))
782 cff2=tairk(i)*tairk(i)*tairk(i)
785 & (cff1*(0.39_r8-0.05_r8*sqrt(vap_p))* &
786 & (1.0_r8-0.6823_r8*cloud(i,j)*cloud(i,j))+ &
787 & cff2*4.0_r8*(tseak(i)-tairk(i)))
789# elif defined LONGWAVE_OUT
794 lrad(i,j)=lrflx(i,j)*hscale- &
798 lrad(i,j)=lrflx(i,j)*hscale
801 lrad(i,j)=lrad(i,j)*rmask(i,j)
836 cff=(1.0007_r8+3.46e-6_r8*pairm)*6.1121_r8* &
837 & exp(17.502_r8*tairc(i)/(240.97_r8+tairc(i)))
841 qair(i)=0.62197_r8*(cff/(pairm-0.378_r8*cff))
845 IF (rh.lt.2.0_r8)
THEN
847 q(i)=0.62197_r8*(cff/(pairm-0.378_r8*cff))
854 cff=(1.0007_r8+3.46e-6_r8*pairm)*6.1121_r8* &
855 & exp(17.502_r8*tseac(i)/(240.97_r8+tseac(i)))
863 qsea(i)=0.62197_r8*(cff/(pairm-0.378_r8*cff))
872 rhoair(i)=pairm*100.0_r8/(
blk_rgas*tairk(i)* &
873 & (1.0_r8+0.61_r8*q(i)))
877 visair(i)=1.326e-5_r8* &
878 & (1.0_r8+tairc(i)*(6.542e-3_r8+tairc(i)* &
879 & (8.301e-6_r8-4.84e-9_r8*tairc(i))))
883 hlv(i,j)=(2.501_r8-0.00237_r8*tseac(i))*1.0e+6_r8
889 delw(i)=sqrt(wmag(i)*wmag(i)+wgus(i)*wgus(i))
891 delt(i)=tseac(i)-tairc(i)
896 u10(i)=delw(i)*log(10.0_r8/zow(i))/log(
blk_zw(ng)/zow(i))
897 wstar(i)=0.035_r8*u10(i)
898 zo10(i)=0.011_r8*wstar(i)*wstar(i)/
g+ &
899 & 0.11_r8*visair(i)/wstar(i)
900 cd10(i)=(
vonkar/log(10.0_r8/zo10(i)))**2
902 ct10(i)=ch10(i)/sqrt(cd10(i))
903 zot10(i)=10.0_r8/exp(
vonkar/ct10(i))
915 ri(i)=-
g*
blk_zw(ng)*((delt(i)-deltc(i))+ &
916 & 0.61_r8*tairk(i)*delq(i))/ &
917 & (tairk(i)*delw(i)*delw(i))
918 IF (ri(i).lt.0.0_r8)
THEN
919 zetu(i)=cc(i)*ri(i)/(1.0_r8+ri(i)/ribcu(i))
921 zetu(i)=cc(i)*ri(i)/(1.0_r8+3.0_r8*ri(i)/cc(i))
929 tstar(i)=-(delt(i)-deltc(i))*
vonkar/ &
930 & (log(
blk_zt(ng)/zot10(i))- &
932 qstar(i)=-(delq(i)-delqc(i))*
vonkar/ &
933 & (log(
blk_zq(ng)/zot10(i))- &
939 IF (delw(i).gt.18.0_r8)
THEN
941 ELSE IF ((10.0_r8.lt.delw(i)).and.(delw(i).le.18.0_r8))
THEN
943 & 0.125_r8*(0.018_r8-0.011_r8)*(delw(i)-10._r8)
947# ifdef BBL_MODEL_NOT_YET
948 cwave(i)=
g*pwave(i,j)*twopi_inv
949 lwave(i)=cwave(i)*pwave(i,j)
957# ifdef BBL_MODEL_NOT_YET
962 zow(i)=(25._r8/
pi)*lwave(i)*(wstar(i)/cwave(i))**4.5+ &
963 & 0.11_r8*visair(i)/(wstar(i)+eps)
965 zow(i)=1200._r8*awave(i,j)*(awave(i,j)/lwave(i))**4.5+ &
966 & 0.11_r8*visair(i)/(wstar(i)+eps)
969 zow(i)=charn(i)*wstar(i)*wstar(i)/
g+ &
970 & 0.11_r8*visair(i)/(wstar(i)+eps)
972 rr(i)=zow(i)*wstar(i)/visair(i)
976 zoq(i)=min(1.15e-4_r8,5.5e-5_r8/rr(i)**0.6)
979 & (tstar(i)*(1.0_r8+0.61_r8*q(i))+ &
980 & 0.61_r8*tairk(i)*qstar(i))/ &
981 & (tairk(i)*wstar(i)*wstar(i)* &
982 & (1.0_r8+0.61_r8*q(i))+eps)
983 l(i)=
blk_zw(ng)/(zol(i)+eps)
991 cwet(i)=0.622_r8*hlv(i,j)*qsea(i)/ &
993 delqc(i)=cwet(i)*deltc(i)
998 wstar(i)=max(eps,delw(i)*
vonkar/ &
999 & (log(
blk_zw(ng)/zow(i))-wpsi(i)))
1000 tstar(i)=-(delt(i)-deltc(i))*
vonkar/ &
1001 & (log(
blk_zt(ng)/zot(i))-tpsi(i))
1002 qstar(i)=-(delq(i)-delqc(i))*
vonkar/ &
1003 & (log(
blk_zq(ng)/zoq(i))-qpsi(i))
1008 & wstar(i)*(tstar(i)+0.61_r8*tairk(i)*qstar(i))
1009 IF (bf.gt.0.0_r8)
THEN
1014 delw(i)=sqrt(wmag(i)*wmag(i)+wgus(i)*wgus(i))
1033 hsb=-rhoair(i)*
blk_cpa*wstar(i)*tstar(i)
1034 hlb=-rhoair(i)*hlv(i,j)*wstar(i)*qstar(i)
1038 fc=0.065_r8+11.0_r8*hcool- &
1039 & (1.0_r8-exp(-hcool*1250.0_r8))*6.6e-5_r8/hcool
1043 qcool=lrad(i,j)+hsb+hlb-srad(i,j)*fc
1044 qbouy=tcff(i)*qcool+scff(i)*hlb*
blk_cpw/hlv(i,j)
1048 IF ((qcool.gt.0.0_r8).and.(qbouy.gt.0.0_r8))
THEN
1050 & (1.0_r8+(clam*qbouy/(wstar(i)+eps)**4)**0.75_r8)**r3
1051 hcool=lambd*
blk_visw/(sqrt(rhoair(i)/rhosea(i))* &
1057 delqc(i)=cwet(i)*deltc(i)
1072 wspeed=sqrt(wmag(i)*wmag(i)+wgus(i)*wgus(i))
1073 cd=wstar(i)*wstar(i)/(wspeed*wspeed+eps)
1077 hs=-
blk_cpa*rhoair(i)*wstar(i)*tstar(i)
1081 diffw=2.11e-5_r8*(tairk(i)/273.16_r8)**1.94_r8
1082 diffh=0.02411_r8*(1.0_r8+tairc(i)* &
1083 & (3.309e-3_r8-1.44e-6_r8*tairc(i)))/ &
1085 cff=qair(i)*hlv(i,j)/(
blk_rgas*tairk(i)*tairk(i))
1086 wet_bulb=1.0_r8/(1.0_r8+0.622_r8*(cff*hlv(i,j)*diffw)/ &
1088 hsr=rain(i,j)*wet_bulb*
blk_cpw* &
1089 & ((tseac(i)-tairc(i))+(qsea(i)-q(i))*hlv(i,j)/
blk_cpa)
1092 sheat(i,j)=sheat(i,j)*rmask(i,j)
1097 hl=-hlv(i,j)*rhoair(i)*wstar(i)*qstar(i)
1101 upvel=-1.61_r8*wstar(i)*qstar(i)- &
1102 & (1.0_r8+1.61_r8*q(i))*wstar(i)*tstar(i)/tairk(i)
1103 hlw=rhoair(i)*hlv(i,j)*upvel*q(i)
1106 lheat(i,j)=lheat(i,j)*rmask(i,j)
1114 ad_tauy(i,j)=ad_tauy(i,j)*rmask(i,j)
1117 ad_cff=ad_cff+ad_tauy(i,j)*vwind(i,j)
1121 ad_taux(i,j)=ad_taux(i,j)*rmask(i,j)
1124 ad_cff=ad_cff+ad_taux(i,j)*uwind(i,j)
1128 adfac=rhoair(i)*ad_cff
1129 ad_cd=ad_cd+wspeed*adfac
1130 ad_wspeed=ad_wspeed+cd*adfac
1139 ad_lheat(i,j)=ad_lheat(i,j)*rmask(i,j)
1142 ad_hl=ad_hl+ad_lheat(i,j)
1143 ad_hlw=ad_hlw+ad_lheat(i,j)
1144 ad_lheat(i,j)=0.0_r8
1148 adfac=rhoair(i)*q(i)*ad_hlw
1149 ad_hlv(i,j)=ad_hlv(i,j)+upvel*adfac
1150 ad_upvel=ad_upvel+hlv(i,j)*adfac
1157 adfac=-1.61_r8*ad_upvel
1158 adfac1=-(1.0_r8+1.61_r8*q(i))*ad_upvel/tairk(i)
1159 ad_wstar(i)=ad_wstar(i)+qstar(i)*adfac+tstar(i)*adfac1
1160 ad_qstar(i)=ad_qstar(i)+wstar(i)*adfac
1161 ad_tstar(i)=ad_tstar(i)+wstar(i)*adfac1
1167 adfac=hlv(i,j)*rhoair(i)*ad_hl
1168 ad_hlv(i,j)=ad_hlv(i,j)-rhoair(i)*wstar(i)*qstar(i)*ad_hl
1169 ad_wstar(i)=ad_wstar(i)-qstar(i)*adfac
1170 ad_qstar(i)=ad_qstar(i)-wstar(i)*adfac
1179 ad_sheat(i,j)=ad_sheat(i,j)*rmask(i,j)
1183 ad_hs=ad_hs+ad_sheat(i,j)
1184 ad_hsr=ad_hsr+ad_sheat(i,j)
1185 ad_sheat(i,j)=0.0_r8
1191 adfac=rain(i,j)*wet_bulb*
blk_cpw*ad_hsr
1193 ad_wet_bulb=ad_wet_bulb+hsr*ad_hsr/wet_bulb
1194 ad_tseac(i)=ad_tseac(i)+adfac
1195 ad_qsea(i)=ad_qsea(i)+hlv(i,j)*adfac1
1196 ad_hlv(i,j)=ad_hlv(i,j)+(qsea(i)-q(i))*adfac1
1200 ad_fac=-wet_bulb*wet_bulb*ad_wet_bulb
1205 adfac=0.622_r8*diffw*ad_fac/(
blk_cpa*diffh)
1206 ad_cff=ad_cff+hlv(i,j)*adfac
1207 ad_hlv(i,j)=ad_hlv(i,j)+cff*adfac
1211 ad_hlv(i,j)=ad_hlv(i,j)+qair(i)*ad_cff/ &
1220 adfac=-
blk_cpa*rhoair(i)*ad_hs
1221 ad_wstar(i)=ad_wstar(i)+tstar(i)*adfac
1222 ad_tstar(i)=ad_tstar(i)+wstar(i)*adfac
1230 adfac=2.0_r8*ad_cd/(wspeed*wspeed+eps)
1231 ad_wstar(i)=ad_wstar(i)+wstar(i)*adfac
1232 ad_wspeed=ad_wspeed-wspeed*cd*adfac
1235 IF (wspeed.ne.0.0_r8)
THEN
1237 ad_wgus(i)=ad_wgus(i)+wgus(i)*ad_wspeed/wspeed
1249 DO iter=itermax,1,-1
1258 wmag(i)=sqrt(uwind(i,j)*uwind(i,j)+vwind(i,j)*vwind(i,j))
1261 tairk(i)=tairc(i)+273.16_r8
1262 tseac(i)=t(i,j,n(ng),nrhs,
itemp)
1263 tseak(i)=tseac(i)+273.16_r8
1264 rhosea(i)=rho(i,j,n(ng))+1000.0_r8
1266 srad(i,j)=srflx(i,j)*hscale
1274 lheat(i,j)=lhflx(i,j)*hscale
1275 sheat(i,j)=shflx(i,j)*hscale
1284# if defined LONGWAVE
1292 cff=(0.7859_r8+0.03477_r8*tairc(i))/ &
1293 & (1.0_r8+0.00412_r8*tairc(i))
1296 cff2=tairk(i)*tairk(i)*tairk(i)
1299 & (cff1*(0.39_r8-0.05_r8*sqrt(vap_p))* &
1300 & (1.0_r8-0.6823_r8*cloud(i,j)*cloud(i,j))+ &
1301 & cff2*4.0_r8*(tseak(i)-tairk(i)))
1303# elif defined LONGWAVE_OUT
1308 lrad(i,j)=lrflx(i,j)*hscale- &
1312 lrad(i,j)=lrflx(i,j)*hscale
1315 lrad(i,j)=lrad(i,j)*rmask(i,j)
1350 cff=(1.0007_r8+3.46e-6_r8*pairm)*6.1121_r8* &
1351 & exp(17.502_r8*tairc(i)/(240.97_r8+tairc(i)))
1355 qair(i)=0.62197_r8*(cff/(pairm-0.378_r8*cff))
1359 IF (rh.lt.2.0_r8)
THEN
1361 q(i)=0.62197_r8*(cff/(pairm-0.378_r8*cff))
1368 cff=(1.0007_r8+3.46e-6_r8*pairm)*6.1121_r8* &
1369 & exp(17.502_r8*tseac(i)/(240.97_r8+tseac(i)))
1377 qsea(i)=0.62197_r8*(cff/(pairm-0.378_r8*cff))
1386 rhoair(i)=pairm*100.0_r8/(
blk_rgas*tairk(i)* &
1387 & (1.0_r8+0.61_r8*q(i)))
1391 visair(i)=1.326e-5_r8* &
1392 & (1.0_r8+tairc(i)*(6.542e-3_r8+tairc(i)* &
1393 & (8.301e-6_r8-4.84e-9_r8*tairc(i))))
1397 hlv(i,j)=(2.501_r8-0.00237_r8*tseac(i))*1.0e+6_r8
1403 delw(i)=sqrt(wmag(i)*wmag(i)+wgus(i)*wgus(i))
1404 delq(i)=qsea(i)-q(i)
1405 delt(i)=tseac(i)-tairc(i)
1410 u10(i)=delw(i)*log(10.0_r8/zow(i))/log(
blk_zw(ng)/zow(i))
1411 wstar(i)=0.035_r8*u10(i)
1412 zo10(i)=0.011_r8*wstar(i)*wstar(i)/
g+ &
1413 & 0.11_r8*visair(i)/wstar(i)
1414 cd10(i)=(
vonkar/log(10.0_r8/zo10(i)))**2
1416 ct10(i)=ch10(i)/sqrt(cd10(i))
1417 zot10(i)=10.0_r8/exp(
vonkar/ct10(i))
1429 ri(i)=-
g*
blk_zw(ng)*((delt(i)-deltc(i))+ &
1430 & 0.61_r8*tairk(i)*delq(i))/ &
1431 & (tairk(i)*delw(i)*delw(i))
1432 IF (ri(i).lt.0.0_r8)
THEN
1433 zetu(i)=cc(i)*ri(i)/(1.0_r8+ri(i)/ribcu(i))
1435 zetu(i)=cc(i)*ri(i)/(1.0_r8+3.0_r8*ri(i)/cc(i))
1437 l10(i)=
blk_zw(ng)/zetu(i)
1443 tstar(i)=-(delt(i)-deltc(i))*
vonkar/ &
1444 & (log(
blk_zt(ng)/zot10(i))- &
1446 qstar(i)=-(delq(i)-delqc(i))*
vonkar/ &
1447 & (log(
blk_zq(ng)/zot10(i))- &
1453 IF (delw(i).gt.18.0_r8)
THEN
1455 ELSE IF ((10.0_r8.lt.delw(i)).and.(delw(i).le.18.0_r8))
THEN
1456 charn(i)=0.011_r8+ &
1457 & 0.125_r8*(0.018_r8-0.011_r8)*(delw(i)-10._r8)
1461# ifdef BBL_MODEL_NOT_YET
1462 cwave(i)=
g*pwave(i,j)*twopi_inv
1463 lwave(i)=cwave(i)*pwave(i,j)
1471# ifdef BBL_MODEL_NOT_YET
1476 zow(i)=(25._r8/
pi)*lwave(i)*(wstar(i)/cwave(i))**4.5+ &
1477 & 0.11_r8*visair(i)/(wstar(i)+eps)
1479 zow(i)=1200._r8*awave(i,j)*(awave(i,j)/lwave(i))**4.5+ &
1480 & 0.11_r8*visair(i)/(wstar(i)+eps)
1483 zow(i)=charn(i)*wstar(i)*wstar(i)/
g+ &
1484 & 0.11_r8*visair(i)/(wstar(i)+eps)
1486 rr(i)=zow(i)*wstar(i)/visair(i)
1490 zoq(i)=min(1.15e-4_r8,5.5e-5_r8/rr(i)**0.6)
1493 & (tstar(i)*(1.0_r8+0.61_r8*q(i))+ &
1494 & 0.61_r8*tairk(i)*qstar(i))/ &
1495 & (tairk(i)*wstar(i)*wstar(i)* &
1496 & (1.0_r8+0.61_r8*q(i))+eps)
1497 l(i)=
blk_zw(ng)/(zol(i)+eps)
1505 cwet(i)=0.622_r8*hlv(i,j)*qsea(i)/ &
1507 delqc(i)=cwet(i)*deltc(i)
1512 wstar(i)=max(eps,delw(i)*
vonkar/ &
1513 & (log(
blk_zw(ng)/zow(i))-wpsi(i)))
1514 tstar(i)=-(delt(i)-deltc(i))*
vonkar/ &
1515 & (log(
blk_zt(ng)/zot(i))-tpsi(i))
1516 qstar(i)=-(delq(i)-delqc(i))*
vonkar/ &
1517 & (log(
blk_zq(ng)/zoq(i))-qpsi(i))
1522 & wstar(i)*(tstar(i)+0.61_r8*tairk(i)*qstar(i))
1523 IF (bf.gt.0.0_r8)
THEN
1528 delw(i)=sqrt(wmag(i)*wmag(i)+wgus(i)*wgus(i))
1547 hsb=-rhoair(i)*
blk_cpa*wstar(i)*tstar(i)
1548 hlb=-rhoair(i)*hlv(i,j)*wstar(i)*qstar(i)
1552 fc=0.065_r8+11.0_r8*hcool- &
1553 & (1.0_r8-exp(-hcool*1250.0_r8))*6.6e-5_r8/hcool
1557 qcool=lrad(i,j)+hsb+hlb-srad(i,j)*fc
1558 qbouy=tcff(i)*qcool+scff(i)*hlb*
blk_cpw/hlv(i,j)
1562 IF ((qcool.gt.0.0_r8).and.(qbouy.gt.0.0_r8))
THEN
1564 & (1.0_r8+(clam*qbouy/(wstar(i)+eps)**4)**0.75_r8)**r3
1565 hcool=lambd*
blk_visw/(sqrt(rhoair(i)/rhosea(i))* &
1571 delqc(i)=cwet(i)*deltc(i)
1582# ifdef BBL_MODEL_NOT_YET
1587 zow(i)=(25._r8/
pi)*lwave(i)*(wstar(i)/cwave(i))**4.5+ &
1588 & 0.11_r8*visair(i)/(wstar(i)+eps)
1590 zow(i)=1200._r8*awave(i,j)*(awave(i,j)/lwave(i))**4.5+ &
1591 & 0.11_r8*visair(i)/(wstar(i)+eps)
1594 zow(i)=charn(i)*wstar(i)*wstar(i)/
g+ &
1595 & 0.11_r8*visair(i)/(wstar(i)+eps)
1597 rr(i)=zow(i)*wstar(i)/visair(i)
1601 zoq(i)=min(1.15e-4_r8,5.5e-5_r8/rr(i)**0.6)
1604 & (tstar(i)*(1.0_r8+0.61_r8*q(i))+ &
1605 & 0.61_r8*tairk(i)*qstar(i))/ &
1606 & (tairk(i)*wstar(i)*wstar(i)* &
1607 & (1.0_r8+0.61_r8*q(i))+eps)
1608 l(i)=
blk_zw(ng)/(zol(i)+eps)
1616 delqc(i)=cwet(i)*deltc(i)
1621 wstar1(i)=max(eps,delw(i)*
vonkar/ &
1622 & (log(
blk_zw(ng)/zow(i))-wpsi(i)))
1623 tstar1(i)=-(delt(i)-deltc(i))*
vonkar/ &
1624 & (log(
blk_zt(ng)/zot(i))-tpsi(i))
1625 qstar1(i)=-(delq(i)-delqc(i))*
vonkar/ &
1626 & (log(
blk_zq(ng)/zoq(i))-qpsi(i))
1631 & wstar1(i)*(tstar1(i)+0.61_r8*tairk(i)*qstar1(i))
1632 IF (bf.gt.0.0_r8)
THEN
1637 delw1(i)=sqrt(wmag(i)*wmag(i)+wgus(i)*wgus(i))
1656 hsb=-rhoair(i)*
blk_cpa*wstar1(i)*tstar1(i)
1657 hlb=-rhoair(i)*hlv(i,j)*wstar1(i)*qstar1(i)
1661 fc=0.065_r8+11.0_r8*hcool- &
1662 & (1.0_r8-exp(-hcool*1250.0_r8))*6.6e-5_r8/hcool
1666 qcool=lrad(i,j)+hsb+hlb-srad(i,j)*fc
1667 qbouy=tcff(i)*qcool+scff(i)*hlb*
blk_cpw/hlv(i,j)
1671 IF ((qcool.gt.0.0_r8).and.(qbouy.gt.0.0_r8))
THEN
1673 & (1.0_r8+(clam*qbouy/(wstar1(i)+eps)**4)**0.75_r8)**r3
1674 hcool=lambd*
blk_visw/(sqrt(rhoair(i)/rhosea(i))* &
1680 delqc(i)=cwet(i)*deltc1(i)
1691 ad_cwet(i)=ad_cwet(i)+deltc1(i)*ad_delqc(i)
1692 ad_deltc(i)=ad_deltc(i)+cwet(i)*ad_delqc(i)
1695 IF ((qcool.gt.0.0_r8).and.(qbouy.gt.0.0_r8))
THEN
1696 fac1=sqrt(rhoair(i)/rhosea(i))
1697 fac2=fac1*wstar1(i)+eps
1702 ad_qcool=ad_qcool+hcool*adfac
1703 ad_hcool=ad_hcool+qcool*adfac
1709 ad_fac2=-hcool*adfac
1712 IF (fac1.ne.0.0_r8)
THEN
1714 ad_rhosea(i)=ad_rhosea(i)-0.5*fac1*ad_fac1/rhosea(i)
1721 fac1=(wstar1(i)+eps)**4
1723 fac3=(fac2/fac1)**0.75_r8
1724 lambd=6.0_r8/(1.0_r8+fac3)**r3
1727 ad_fac3=-r3*6.0_r8*ad_lambd/(1.0_r8+fac3)**(r3+1.0_r8)
1732 adfac=0.75_r8*(fac2/fac1)**(-0.25_r8)*ad_fac3
1734 ad_fac1=-fac2*adfac/(fac1*fac1)
1739 ad_clam=ad_clam+qbouy*ad_fac2
1740 ad_qbouy=ad_qbouy+clam*ad_fac2
1745 ad_wstar(i)=ad_wstar(i)+4.0_r8*ad_fac1*(wstar1(i)+eps)**3
1764 hsb=-rhoair(i)*
blk_cpa*wstar1(i)*tstar1(i)
1765 hlb=-rhoair(i)*hlv(i,j)*wstar1(i)*qstar1(i)
1769 fc=0.065_r8+11.0_r8*hcool- &
1770 & (1.0_r8-exp(-hcool*1250.0_r8))*6.6e-5_r8/hcool
1774 qcool=lrad(i,j)+hsb+hlb-srad(i,j)*fc
1775 qbouy=tcff(i)*qcool+scff(i)*hlb*
blk_cpw/hlv(i,j)
1782 adfac=ad_qbouy*
blk_cpw/hlv(i,j)
1783 ad_tcff(i)=ad_tcff(i)+qcool*ad_qbouy
1784 ad_qcool=ad_qcool+tcff(i)*ad_qbouy
1785 ad_scff(i)=ad_scff(i)+hlb*adfac
1786 ad_hlb=ad_hlb+scff(i)*adfac
1787 ad_hlv(i,j)=ad_hlv(i,j)- &
1788 & scff(i)*hlb*adfac/hlv(i,j)
1793 ad_lrad(i,j)=ad_lrad(i,j)+ad_qcool
1794 ad_hsb=ad_hsb+ad_qcool
1795 ad_hlb=ad_hlb+ad_qcool
1804 adfac=-rhoair(i)*ad_hlb
1805 adfac1=hlv(i,j)*adfac
1806 ad_hlv(i,j)=ad_hlv(i,j)+wstar1(i)*qstar1(i)*adfac
1807 ad_wstar(i)=ad_wstar(i)+qstar1(i)*adfac1
1808 ad_qstar(i)=ad_qstar(i)+wstar1(i)*adfac1
1813 adfac=-rhoair(i)*
blk_cpa*ad_hsb
1814 ad_wstar(i)=ad_wstar(i)+tstar1(i)*adfac
1815 ad_tstar(i)=ad_tstar(i)+wstar1(i)*adfac
1826 ad_rhosea(i)=ad_rhosea(i)+ &
1836 IF (delw1(i).ne.0.0_r8)
THEN
1838 ad_wgus(i)=ad_wgus(i)+wgus(i)*ad_delw(i)/delw1(i)
1845 IF (bf.gt.0.0_r8)
THEN
1859 adfac=-
g/tairk(i)*ad_bf
1860 adfac1=wstar1(i)*adfac
1861 ad_wstar(i)=ad_wstar(i)+ &
1862 & (tstar1(i)+0.61_r8*tairk(i)*qstar1(i))*adfac
1863 ad_tstar(i)=ad_tstar(i)+adfac1
1864 ad_qstar(i)=ad_qstar(i)+0.61_r8*tairk(i)*adfac1
1876 adfac=-ad_qstar(i)*
vonkar/(fac2-qpsi(i))
1877 adfac1=-ad_qstar(i)*qstar1(i)/(fac2-qpsi(i))
1878 ad_delq(i)=ad_delq(i)+adfac
1879 ad_delqc(i)=ad_delqc(i)-adfac
1881 ad_qpsi(i)=ad_qpsi(i)-adfac1
1885 ad_fac1=ad_fac2/fac1
1889 ad_zoq(i)=ad_zoq(i)-fac1*ad_fac1/zoq(i)
1897 adfac=-ad_tstar(i)*
vonkar/(fac2-tpsi(i))
1898 adfac1=-ad_tstar(i)*tstar1(i)/(fac2-tpsi(i))
1899 ad_delt(i)=ad_delt(i)+adfac
1900 ad_deltc(i)=ad_deltc(i)-adfac
1902 ad_tpsi(i)=ad_tpsi(i)-adfac1
1906 ad_fac1=ad_fac1+ad_fac2/fac1
1910 ad_zot(i)=ad_zot(i)-fac1*ad_fac1/zot(i)
1915 fac3=delw(i)*
vonkar/(fac2-wpsi(i))
1918 ad_fac3=ad_wstar(i)*(0.5_r8-sign(0.5_r8,eps-fac3))
1923 adfac=ad_fac3/(fac2-wpsi(i))
1925 ad_delw(i)=ad_delw(i)+
vonkar*adfac
1927 ad_wpsi(i)=ad_wpsi(i)+adfac1
1931 ad_fac1=ad_fac1+ad_fac2/fac1
1935 ad_zow(i)=ad_zow(i)-fac1*ad_fac1/zow(i)
1940 ad_cwet(i)=ad_cwet(i)+deltc(i)*ad_delqc(i)
1941 ad_deltc(i)=ad_deltc(i)+cwet(i)*ad_delqc(i)
1950 adfac=ad_cwet(i)/(
blk_rgas*tseak(i)*tseak(i))
1951 adfac1=2.0_r8*
blk_rgas*tseak(i)*cwet(i)*adfac
1952 adfac2=0.622_r8*adfac
1953 ad_hlv(i,j)=ad_hlv(i,j)+qsea(i)*adfac2
1954 ad_qsea(i)=ad_qsea(i)+hlv(i,j)*adfac2
1955 ad_tseak(i)=ad_tseak(i)-adfac1
1969 ad_l(i)=ad_l(i)-ad_fac*fac/l(i)
1978 ad_l(i)=ad_l(i)-ad_fac*fac/l(i)
1989 ad_zol(i)=ad_zol(i)-l(i)*ad_l(i)/(zol(i)+eps)
2002 & (tairk(i)*wstar(i)*wstar(i)* &
2003 & (1.0_r8+0.61_r8*q(i))+eps)
2004 ad_tstar(i)=ad_tstar(i)+(1.0_r8+0.61_r8*q(i))*adfac
2005 ad_qstar(i)=ad_qstar(i)+0.61_r8*tairk(i)*adfac
2006 ad_wstar(i)=ad_wstar(i)-2.0_r8*tairk(i)*wstar(i)* &
2007 & (1.0_r8+0.61_r8*q(i))*zol(i)*ad_zol(i)/ &
2008 & (tairk(i)*wstar(i)*wstar(i)* &
2009 & (1.0_r8+0.61_r8*q(i))+eps)
2013 ad_zoq(i)=ad_zoq(i)+ad_zot(i)
2019 ad_rr(i)=ad_rr(i)- &
2020 & (0.5_r8-sign(0.5_r8,5.5e-5_r8/rr(i)**0.6-1.15e-4_r8)) &
2021 & *0.6_r8*5.5e-5_r8*ad_zoq(i)/rr(i)**1.6
2025 adfac=ad_rr(i)/visair(i)
2026 ad_zow(i)=ad_zow(i)+wstar(i)*adfac
2027 ad_wstar(i)=ad_wstar(i)+zow(i)*adfac
2030# ifdef BBL_MODEL_NOT_YET
2036 ad_wstar(i)=ad_wstar(i)+(25._r8/
pi)*lwave(i)*4.5_r8* &
2037 & (wstar(i)/cwave(i))**3.5*ad_zow(i)/cwave(i)- &
2038 & 0.11_r8*visair(i)*ad_zow(i)/ &
2039 & ((wstar(i)+eps)*(wstar(i)+eps))
2044 ad_wstar(i)=ad_wstar(i)-0.11_r8*visair(i)*ad_zow(i)/ &
2045 & ((wstar(i)+eps)*(wstar(i)+eps))
2053 ad_wstar(i)=ad_wstar(i)+2.0_r8*charn(i)*wstar(i)*adfac- &
2054 & 0.11_r8*visair(i)*ad_zow(i)/ &
2055 & ((wstar(i)+eps)*(wstar(i)+eps))
2069 wmag(i)=sqrt(uwind(i,j)*uwind(i,j)+vwind(i,j)*vwind(i,j))
2072 tairk(i)=tairc(i)+273.16_r8
2073 tseac(i)=t(i,j,n(ng),nrhs,
itemp)
2074 tseak(i)=tseac(i)+273.16_r8
2075 rhosea(i)=rho(i,j,n(ng))+1000.0_r8
2077 srad(i,j)=srflx(i,j)*hscale
2085 lheat(i,j)=lhflx(i,j)*hscale
2086 sheat(i,j)=shflx(i,j)*hscale
2095# if defined LONGWAVE
2103 cff=(0.7859_r8+0.03477_r8*tairc(i))/ &
2104 & (1.0_r8+0.00412_r8*tairc(i))
2107 cff2=tairk(i)*tairk(i)*tairk(i)
2110 & (cff1*(0.39_r8-0.05_r8*sqrt(vap_p))* &
2111 & (1.0_r8-0.6823_r8*cloud(i,j)*cloud(i,j))+ &
2112 & cff2*4.0_r8*(tseak(i)-tairk(i)))
2114# elif defined LONGWAVE_OUT
2119 lrad(i,j)=lrflx(i,j)*hscale- &
2123 lrad(i,j)=lrflx(i,j)*hscale
2126 lrad(i,j)=lrad(i,j)*rmask(i,j)
2161 cff=(1.0007_r8+3.46e-6_r8*pairm)*6.1121_r8* &
2162 & exp(17.502_r8*tairc(i)/(240.97_r8+tairc(i)))
2166 qair(i)=0.62197_r8*(cff/(pairm-0.378_r8*cff))
2170 IF (rh.lt.2.0_r8)
THEN
2172 q(i)=0.62197_r8*(cff/(pairm-0.378_r8*cff))
2179 cff=(1.0007_r8+3.46e-6_r8*pairm)*6.1121_r8* &
2180 & exp(17.502_r8*tseac(i)/(240.97_r8+tseac(i)))
2188 qsea(i)=0.62197_r8*(cff/(pairm-0.378_r8*cff))
2197 rhoair(i)=pairm*100.0_r8/(
blk_rgas*tairk(i)* &
2198 & (1.0_r8+0.61_r8*q(i)))
2202 visair(i)=1.326e-5_r8* &
2203 & (1.0_r8+tairc(i)*(6.542e-3_r8+tairc(i)* &
2204 & (8.301e-6_r8-4.84e-9_r8*tairc(i))))
2208 hlv(i,j)=(2.501_r8-0.00237_r8*tseac(i))*1.0e+6_r8
2214 delw(i)=sqrt(wmag(i)*wmag(i)+wgus(i)*wgus(i))
2215 delq(i)=qsea(i)-q(i)
2216 delt(i)=tseac(i)-tairc(i)
2221 u10(i)=delw(i)*log(10.0_r8/zow(i))/log(
blk_zw(ng)/zow(i))
2222 wstar(i)=0.035_r8*u10(i)
2223 zo10(i)=0.011_r8*wstar(i)*wstar(i)/
g+ &
2224 & 0.11_r8*visair(i)/wstar(i)
2225 cd10(i)=(
vonkar/log(10.0_r8/zo10(i)))**2
2227 ct10(i)=ch10(i)/sqrt(cd10(i))
2228 zot10(i)=10.0_r8/exp(
vonkar/ct10(i))
2240 ri(i)=-
g*
blk_zw(ng)*((delt(i)-deltc(i))+ &
2241 & 0.61_r8*tairk(i)*delq(i))/ &
2242 & (tairk(i)*delw(i)*delw(i))
2243 IF (ri(i).lt.0.0_r8)
THEN
2244 zetu(i)=cc(i)*ri(i)/(1.0_r8+ri(i)/ribcu(i))
2246 zetu(i)=cc(i)*ri(i)/(1.0_r8+3.0_r8*ri(i)/cc(i))
2248 l10(i)=
blk_zw(ng)/zetu(i)
2254 tstar(i)=-(delt(i)-deltc(i))*
vonkar/ &
2255 & (log(
blk_zt(ng)/zot10(i))- &
2257 qstar(i)=-(delq(i)-delqc(i))*
vonkar/ &
2258 & (log(
blk_zq(ng)/zot10(i))- &
2264 IF (delw(i).gt.18.0_r8)
THEN
2266 ELSE IF ((10.0_r8.lt.delw(i)).and.(delw(i).le.18.0_r8))
THEN
2267 charn(i)=0.011_r8+ &
2268 & 0.125_r8*(0.018_r8-0.011_r8)*(delw(i)-10._r8)
2279 IF (delw(i).gt.18.0_r8)
THEN
2282 ELSE IF ((10.0_r8.lt.delw(i)).and.(delw(i).le.18.0_r8))
THEN
2295 fac2=log(
blk_zq(ng)/zot10(i))
2302 adfac=ad_qstar(i)*
vonkar/ &
2305 ad_delq(i)=ad_delq(i)-adfac
2306 ad_delqc(i)=ad_delqc(i)+adfac
2307 ad_fac2=-cff*ad_qstar(i)
2313 ad_zot10(i)=ad_zot10(i)-ad_fac2/zot10(i)
2317 ad_l10(i)=ad_l10(i)-ad_fac1*fac1/l10(i)
2321 fac2=log(
blk_zt(ng)/zot10(i))
2327 adfac=ad_tstar(i)*
vonkar/ &
2330 ad_delt(i)=ad_delt(i)-adfac
2331 ad_deltc(i)=ad_deltc(i)+adfac
2332 ad_fac2=-cff*ad_tstar(i)
2338 ad_zot10(i)=ad_zot10(i)-ad_fac2/zot10(i)
2342 ad_l10(i)=ad_l10(i)-fac1*ad_fac1/l10(i)
2346 fac2=log(
blk_zw(ng)/zo10(i))
2351 ad_fac2=-cff*ad_wstar(i)
2357 ad_zo10(i)=ad_zo10(i)-ad_fac2/zo10(i)
2361 ad_l10(i)=ad_l10(i)-ad_fac1*fac1/l10(i)
2369 ad_zetu(i)=ad_zetu(i)-l10(i)*l10(i)*ad_l10(i)/
blk_zw(ng)
2372 IF (ri(i).lt.0.0_r8)
THEN
2376 adfac=ad_zetu(i)/(1.0_r8+ri(i)/ribcu(i))
2377 ad_cc(i)=ad_cc(i)+ri(i)*adfac
2378 ad_ri(i)=ad_ri(i)+cc(i)*adfac-zetu(i)*adfac/ribcu(i)
2381 fac=3.0_r8*ri(i)/cc(i)
2384 adfac=ad_zetu(i)/(1.0_r8+fac)
2385 ad_cc(i)=ad_cc(i)+ri(i)*adfac
2386 ad_ri(i)=ad_ri(i)+cc(i)*adfac
2387 ad_fac=-zetu(i)*adfac
2391 ad_ri(i)=ad_ri(i)+3.0_r8*ad_fac/cc(i)
2392 ad_cc(i)=ad_cc(i)-ad_fac*fac/cc(i)
2396 fac=1.0/(tairk(i)*delw(i)*delw(i))
2401 adfac=-fac*
g*
blk_zw(ng)*ad_ri(i)
2402 ad_delt(i)=ad_delt(i)+adfac
2403 ad_deltc(i)=ad_deltc(i)-adfac
2404 ad_delq(i)=ad_delq(i)+0.61_r8*tairk(i)*adfac
2417 ad_ct(i)=ad_ct(i)+
vonkar*adfac
2418 ad_cd=ad_cd-cc(i)*adfac
2421 fac=log(
blk_zt(ng)/zot10(i))
2424 ad_fac=-ad_ct(i)*ct(i)/fac
2427 ad_zot10(i)=ad_zot10(i)-ad_fac/zot10(i)
2433 fac=log(
blk_zw(ng)/zo10(i))
2436 ad_fac=-2.0_r8*ad_cd/fac
2440 ad_zo10(i)=ad_zo10(i)-ad_fac/zo10(i)
2446 ad_fac=-ad_zot10(i)*zot10(i)
2450 ad_ct10(i)=ad_ct10(i)-fac*ad_fac/ct10(i)
2454 ad_cd10(i)=ad_cd10(i)-0.5_r8*ct10(i)*ad_ct10(i)/cd10(i)
2457 fac=log(10.0_r8/zo10(i))
2460 ad_fac=-2.0_r8*cd10(i)*ad_cd10(i)/fac
2464 ad_zo10(i)=ad_zo10(i)-ad_fac/zo10(i)
2470 ad_wstar(i)=ad_wstar(i)+0.022_r8*wstar(i)*ad_zo10(i)/
g- &
2471 & 0.11_r8*visair(i)*ad_zo10(i)/(wstar(i)*wstar(i))
2475 ad_u10(i)=ad_u10(i)+0.035_r8*ad_wstar(i)
2492 ad_tseac(i)=ad_tseac(i)+ad_delt(i)
2496 ad_qsea(i)=ad_qsea(i)+ad_delq(i)
2510 ad_tseac(i)=ad_tseac(i)-0.00237_r8*1.0e+6_r8*ad_hlv(i,j)
2515 cff=(1.0007_r8+3.46e-6_r8*pairm)*6.1121_r8* &
2516 & exp(17.502_r8*tseac(i)/(240.97_r8+tseac(i)))
2520 ad_fac=ad_qsea(i)*(1.0_r8+0.378_r8*cff/((pairm-0.378_r8*cff)))
2524 ad_cff=ad_cff+0.62197_r8*ad_fac/(pairm-0.378_r8*cff)
2532 ad_cff=ad_cff*0.98_r8
2536 fac=17.502_r8*tseac(i)/(240.97_r8+tseac(i))
2537 cff=(1.0007_r8+3.46e-6_r8*pairm)*6.1121_r8* &
2538 & exp(17.502_r8*tseac(i)/(240.97_r8+tseac(i)))
2546 ad_tseac(i)=ad_tseac(i)+ &
2547 & 17.502_r8*ad_fac/(240.97_r8+tseac(i))- &
2548 & fac*ad_fac/(240.97_r8+tseac(i))
2558 ad_lrad(i,j)=ad_lrad(i,j)*rmask(i,j)
2560# if defined LONGWAVE
2568 cff2=tairk(i)*tairk(i)*tairk(i)
2571 ad_tseak(i)=ad_tseak(i)-
emmiss*
stefbo*cff2*4.0_r8*ad_lrad(i,j)
2574# elif defined LONGWAVE_OUT
2583 ad_lrflx(i,j)=ad_lrflx(i,j)+ad_lrad(i,j)*hscale
2584 ad_tseak(i)=ad_tseak(i)- &
2586 & tseak(i)*tseak(i)*tseak(i)
2591 ad_lrflx(i,j)=ad_lrflx(i,j)+ad_lrad(i,j)*hscale
2606 ad_lhflx(i,j)=ad_lhflx(i,j)+ad_lheat(i,j)*hscale
2607 ad_lheat(i,j)=0.0_r8
2610 ad_shflx(i,j)=ad_shflx(i,j)+ad_sheat(i,j)*hscale
2611 ad_sheat(i,j)=0.0_r8
2620 ad_beta(i,j)=ad_beta(i,j)+ad_scff(i)
2624 ad_alpha(i,j)=ad_alpha(i,j)+ad_tcff(i)
2628 ad_rho(i,j,n(ng))=ad_rho(i,j,n(ng))+ad_rhosea(i)
2632 ad_tseac(i)=ad_tseac(i)+ad_tseak(i)
2636 ad_t(i,j,n(ng),nrhs,
itemp)=ad_t(i,j,n(ng),nrhs,
itemp)+ &