52 SUBROUTINE swrad(dt,RTHRATEN,SDOWN3D,GSW,XLAT,XLONG,ALBEDO, &
53 rho_phy,T3D,P3D,pi3D,dz8w, &
55 QV3D,QC3D,QR3D,QI3D,QS3D,QG3D, &
56 F_QV,F_QC,F_QR,F_QI,F_QS,F_QG, &
69 real(DP),
INTENT(IN) :: dt
70 real(RP),
INTENT(INOUT) :: RTHRATEN(
ia,
ka,
ja)
71 real(RP),
INTENT(INOUT) :: SDOWN3D(
ia,
ka,
ja)
72 real(RP),
INTENT(INOUT) :: GSW(
ia,
ja)
74 real(RP),
INTENT(IN) :: XLAT(
ia,
ja), XLONG(
ia,
ja), ALBEDO(
ia,
ja)
75 real(RP),
INTENT(IN) :: rho_phy(
ia,
ka,
ja)
76 real(RP),
INTENT(IN) :: P3D(
ia,
ka,
ja), &
80 real(RP),
INTENT(IN) :: solins(
ia,
ja),cosSZA(
ia,
ja)
81 real(RP),
OPTIONAL,
INTENT(IN) :: QV3D (
ia,
ka,
ja), &
88 LOGICAL,
OPTIONAL,
INTENT(IN ) :: F_QV,F_QC,F_QR,F_QI,F_QS,F_QG
89 INTEGER,
INTENT(IN ) :: icloud
90 LOGICAL,
INTENT(IN ) :: warm_rain
95 integer :: its,ite,jts,jte,kts,kte
96 real(RP) :: R, CP, G, SOLCON
100 real(RP),
DIMENSION( KS:KE ) :: TTEN1D, &
112 real(RP) :: SDOWN1D(
ks:
ke+1)
114 real(RP) :: XLAT0,XLONG0,ALB0,GSW0,cosSZA0,solins0
115 real(RP) :: aer_dry1(
ks:
ke),aer_water1(
ks:
ke)
119 LOGICAL :: predicate , do_topo_shading
153 rho01d(k)=rho_phy(i,nk,j)
170 IF (
PRESENT(f_qv) .AND.
PRESENT(qv3d))
THEN 176 qv1d(k)=max(0.0_rp,qv1d(k))
181 IF (
PRESENT(f_qc) .AND.
PRESENT(qc3d))
THEN 187 qc1d(k)=max(0.0_rp,qc1d(k))
192 IF (
PRESENT(f_qr) .AND.
PRESENT(qr3d))
THEN 198 qr1d(k)=max(0.0_rp,qr1d(k))
204 IF (
PRESENT( f_qi ) )
THEN 210 IF ( predicate .AND.
PRESENT( qi3d ) )
THEN 215 qi1d(k)=max(0.0_rp,qi1d(k))
218 IF (.NOT. warm_rain)
THEN 220 IF(t1d(k) < 273.15)
THEN 230 IF (
PRESENT(f_qs) .AND.
PRESENT(qs3d))
THEN 236 qs1d(k)=max(0.0_rp,qs1d(k))
241 IF (
PRESENT(f_qg) .AND.
PRESENT(qg3d))
THEN 247 qg1d(k)=max(0.0_rp,qg1d(k))
258 CALL swpara(tten1d,sdown1d,gsw0,alb0,cossza0, &
259 t1d,qv1d,qc1d,qr1d,qi1d,qs1d,qg1d,p1d, &
263 icloud,aer_dry1,aer_water1, &
280 rthraten(i,k,j)=rthraten(i,k,j)+tten1d(nk)/pi3d(i,k,j)
281 sdown3d(i,k,j)=sdown1d(nk)
285 sdown3d(i,
ks-1,j)=sdown1d(
ke+1)
295 SUBROUTINE swpara(TTEN,SDOWN,GSW,ALBEDO,cosSZA, &
296 T,QV,QC,QR,QI,QS,QG,P, &
300 ICLOUD,aer_dry1,aer_water1, &
304 nowdate =>
time_nowdate !< current time [yyyy mm dd hh mm ss]
317 INTEGER,
INTENT(IN ) :: kts,kte
319 real(RP),
DIMENSION( kts:kte ),
INTENT(IN ) :: &
331 real(RP),
DIMENSION( kts:kte ),
INTENT(INOUT) :: TTEN
332 real(RP),
DIMENSION( kts:kte+1 ),
INTENT(OUT) :: SDOWN
334 real(RP),
INTENT(IN ) :: R,CP,G
335 real(RP),
INTENT(IN) :: ALBEDO,cosSZA,solins
336 integer ,
INTENT(IN) :: icloud
337 real(RP),
INTENT(INOUT) :: GSW
338 real(RP),
INTENT(IN ) :: XXLAT,XXLON
349 real(RP) :: XLWP( kts:kte )
350 real(RP) :: XATP( kts:kte )
351 real(RP) :: XWVP( kts:kte )
352 real(RP) :: aer_dry1( kts:kte )
353 real(RP) :: aer_water1( kts:kte )
354 real(RP) :: RO( kts:kte )
356 real(RP) :: ALBTAB(4,5), ABSTAB(4,5)
357 real(RP) :: XMUVAL(4)
360 real(RP) :: DayOfYear
363 DATA albtab/0.0,0.0,0.0,0.0, &
364 69.0,58.0,40.0,15.0, &
365 90.0,80.0,70.0,60.0, &
366 94.0,90.0,82.0,78.0, &
369 DATA abstab/0.0,0.0,0.0,0.0, &
375 DATA xmuval/0.0,0.2,0.5,1.0/
377 real(RP) :: bext340, absc, alba, alw, csza,dabsa,dsca,dabs
378 real(RP) :: bexth2o, dscld, ff,oldalb,oldabs,oldabc
379 real(RP) :: soltop, totabs, ugcm, uv,xabs,xabsa,wv
380 real(RP) :: wgm, xalb, xi, xsca, xmu,xabsc,trans0,yj
381 real(RP) :: HRANG,XT24,TLOCTM,tloc,dsec,lon,lat
384 INTEGER :: iil,ii,jjl,ju,k,iu
388 real(RP) :: diffuse_frac, corr_fac, csza_slp
406 tloc = mod((nowdate(4) + int(lon/15.0_rp)),24 )
407 dsec =
real(NOWDATE(5)*60 + NOWDATE(6)) / 60.0_RP /60.0_RP
408 tloctm =
real(NOWDATE(4)) + LON/15.0_RP + dsec
409 hrang = 15.*(tloctm-12.)*d2r
414 IF(csza <= 1.0e-9_rp)
GOTO 7
420 xwvp(k)=ro(k)*qv(k)*dz(k)*1000.
435 xlwp(k)=ro(k)*1000.*dz(k)*(qc(k)+0.1*qi(k)+0.05* &
436 qr(k)+0.02*qs(k)+0.05*qg(k))
443 sdown(kts)=soltop * max(cossza,0.0_rp)
470 totabs=2.9*ugcm/((1.+141.5*ugcm)**0.635+5.925*ugcm)
474 beta=0.4*(1.0-xmu)+0.1
476 xsca=(cssca*xatp(k)+beta*aer_dry1(k)*bext340*dz(k) &
477 +beta*aer_water1(k)*bexth2o*dz(k))/xmu
481 xabs=(totabs-oldabs)*(sdown(kts)-dscld-dsca-dabsa)/sdown(k)
486 alw=log10(wgm+1.0_rp)
487 IF(alw>3.999)alw=3.999_rp
490 IF(xmu>xmuval(ii))
THEN 493 xi=(xmu-xmuval(ii))/(xmuval(ii+1)-xmuval(ii))+
float(iil)
501 alba=(albtab(iu,ju)*(xi-iil)*(yj-jjl) &
502 +albtab(iil,ju)*(iu-xi)*(yj-jjl) &
503 +albtab(iu,jjl)*(xi-iil)*(ju-yj) &
504 +albtab(iil,jjl)*(iu-xi)*(ju-yj)) &
507 absc=(abstab(iu,ju)*(xi-iil)*(yj-jjl) &
508 +abstab(iil,ju)*(iu-xi)*(yj-jjl) &
509 +abstab(iu,jjl)*(xi-iil)*(ju-yj) &
510 +abstab(iil,jjl)*(iu-xi)*(ju-yj)) &
515 xalb=(alba-oldalb)*(sdown(kts)-dsca-dabs)/sdown(k)
516 xabsc=(absc-oldabc)*(sdown(kts)-dsca-dabs)/sdown(k)
519 dscld=dscld+(xalb+xabsc)*sdown(k)*0.01
520 dsca=dsca+xsca*sdown(k)
521 dabs=dabs+xabs*sdown(k)
522 dabsa=dabsa+xabsa*sdown(k)
526 trans0=100.0_rp-xalb-xabsc-xabs*100.0_rp-xsca*100.0_rp
528 ff=99.0_rp/(xalb+xabsc+xabs*100.0_rp+xsca*100.0_rp)
535 sdown(k+1)=max(1.0e-9_rp,sdown(k)*trans0*0.01_rp)
536 tten(k)=sdown(k)*(xabsc+xabs*100._rp+xabsa*100._rp)*0.01_rp/(ro(k)*cp*dz(k))
539 gsw=(1.-albedo)*sdown(kte+1)
602 LOGICAL :: allowed_to_read = .true.
603 real :: swrad_scat = 1
607 cssca = swrad_scat * 1.e-5
real(rp), public atmos_solarins_constant
subroutine swpara(TTEN, SDOWN, GSW, ALBEDO, cosSZA, T, QV, QC, QR, QI, QS, QG, P, RHO0, DZ, R, CP, G, solins, XXLAT, XXLON, ICLOUD, aer_dry1, aer_water1, kts, kte)
integer, public ia
of whole cells: x, local, with HALO
integer, public ja
of whole cells: y, local, with HALO
real(rp), public const_d2r
degree to radian
integer, public is
start point of inner domain: x, local
integer, public ie
end point of inner domain: x, local
module atmosphere / grid / cartesC index
integer, public ke
end point of inner domain: z, local
integer, public je
end point of inner domain: y, local
real(rp), public const_grav
standard acceleration of gravity [m/s2]
integer, public ks
start point of inner domain: z, local
subroutine, public swinit
integer, public js
start point of inner domain: y, local
subroutine, public swrad(dt, RTHRATEN, SDOWN3D, GSW, XLAT, XLONG, ALBEDO, rho_phy, T3D, P3D, pi3D, dz8w, solins, cosSZA, QV3D, QC3D, QR3D, QI3D, QS3D, QG3D, F_QV, F_QC, F_QR, F_QI, F_QS, F_QG, icloud, warm_rain)
integer, public ka
of whole cells: z, local, with HALO
module atmosphere / SOLARINS
integer, dimension(6), public time_nowdate
current time [YYYY MM DD HH MM SS]
module ATMOSPHERE / Physics Radiation