22 nfxr, nday, lsswr, lslwr, lssav, fhlwr, fhswr, raddt, coszen, &
23 coszdg, prsi, tgrs, aerodp, cldsa, mtopa, mbota, clouds1, &
24 cldtaulw, cldtausw, sfcflw, sfcfsw, topflw, topfsw, scmpsw, &
25 fluxr, total_albedo, errmsg, errflg)
35 integer,
intent(in) :: im, km, kmp1, lm, ltp, kt, kb, kd, &
37 logical,
intent(in) :: lsswr, lslwr, lssav
38 real(kind=kind_phys),
intent(in) :: raddt, fhlwr, fhswr
40 real(kind=kind_phys),
dimension(im),
intent(in) :: coszen, coszdg
42 real(kind=kind_phys),
dimension(im,kmp1),
intent(in) :: prsi
43 real(kind=kind_phys),
dimension(im,km),
intent(in) :: tgrs
45 real(kind=kind_phys),
dimension(im,NSPC1),
intent(in) :: aerodp
46 real(kind=kind_phys),
dimension(im,5),
intent(in) :: cldsa
47 integer,
dimension(im,3),
intent(in) :: mbota, mtopa
48 real(kind=kind_phys),
dimension(im,lm+LTP),
intent(in) :: clouds1
49 real(kind=kind_phys),
dimension(im,lm+LTP),
intent(in) :: cldtausw
50 real(kind=kind_phys),
dimension(im,lm+LTP),
intent(in) :: cldtaulw
51 real(kind=kind_phys),
dimension(im),
intent(inout) :: total_albedo
53 type(
sfcflw_type),
dimension(im),
intent(in) :: sfcflw
54 type(
sfcfsw_type),
dimension(im),
intent(in) :: sfcfsw
55 type(
cmpfsw_type),
dimension(im),
intent(in) :: scmpsw
56 type(
topflw_type),
dimension(im),
intent(in) :: topflw
57 type(
topfsw_type),
dimension(im),
intent(in) :: topfsw
59 real(kind=kind_phys),
dimension(im,nfxr),
intent(inout) :: fluxr
61 character(len=*),
intent(out) :: errmsg
62 integer,
intent(out) :: errflg
65 integer :: i, j, k, k1, itop, ibtc
66 real(kind=kind_phys) :: tem0d, tem1, tem2
72 if (.not. (lsswr .or. lslwr))
return
91 fluxr(i,34) = aerodp(i,1)
92 fluxr(i,35) = aerodp(i,2)
93 fluxr(i,36) = aerodp(i,3)
94 fluxr(i,37) = aerodp(i,4)
95 fluxr(i,38) = aerodp(i,5)
96 fluxr(i,39) = aerodp(i,6)
104 fluxr(i,1 ) = fluxr(i,1 ) + fhlwr * topflw(i)%upfxc
105 fluxr(i,19) = fluxr(i,19) + fhlwr * sfcflw(i)%dnfxc
106 fluxr(i,20) = fluxr(i,20) + fhlwr * sfcflw(i)%upfxc
108 fluxr(i,28) = fluxr(i,28) + fhlwr * topflw(i)%upfx0
109 fluxr(i,30) = fluxr(i,30) + fhlwr * sfcflw(i)%dnfx0
110 fluxr(i,33) = fluxr(i,33) + fhlwr * sfcflw(i)%upfx0
118 if (coszen(i) > 0.)
then
121 tem0d = fhswr * coszdg(i) / coszen(i)
122 fluxr(i,2 ) = fluxr(i,2) + topfsw(i)%upfxc * tem0d
123 fluxr(i,3 ) = fluxr(i,3) + sfcfsw(i)%upfxc * tem0d
124 fluxr(i,4 ) = fluxr(i,4) + sfcfsw(i)%dnfxc * tem0d
127 fluxr(i,21) = fluxr(i,21) + scmpsw(i)%uvbfc * tem0d
128 fluxr(i,22) = fluxr(i,22) + scmpsw(i)%uvbf0 * tem0d
131 fluxr(i,23) = fluxr(i,23) + topfsw(i)%dnfxc * tem0d
134 fluxr(i,24) = fluxr(i,24) + scmpsw(i)%visbm * tem0d
135 fluxr(i,25) = fluxr(i,25) + scmpsw(i)%visdf * tem0d
136 fluxr(i,26) = fluxr(i,26) + scmpsw(i)%nirbm * tem0d
137 fluxr(i,27) = fluxr(i,27) + scmpsw(i)%nirdf * tem0d
140 fluxr(i,29) = fluxr(i,29) + topfsw(i)%upfx0 * tem0d
141 fluxr(i,31) = fluxr(i,31) + sfcfsw(i)%upfx0 * tem0d
142 fluxr(i,32) = fluxr(i,32) + sfcfsw(i)%dnfx0 * tem0d
149 if (lsswr .or. lslwr)
then
151 fluxr(i,17) = fluxr(i,17) + raddt * cldsa(i,4)
152 fluxr(i,18) = fluxr(i,18) + raddt * cldsa(i,5)
161 tem0d = raddt * cldsa(i,j)
162 itop = mtopa(i,j) - kd
163 ibtc = mbota(i,j) - kd
164 fluxr(i, 8-j) = fluxr(i, 8-j) + tem0d
165 fluxr(i,11-j) = fluxr(i,11-j) + tem0d * prsi(i,itop+kt)
166 fluxr(i,14-j) = fluxr(i,14-j) + tem0d * prsi(i,ibtc+kb)
167 fluxr(i,17-j) = fluxr(i,17-j) + tem0d * tgrs(i,itop)
172 if (lsswr .and. (nday > 0))
then
175 tem0d = raddt * cldsa(i,j)
176 itop = mtopa(i,j) - kd
177 ibtc = mbota(i,j) - kd
180 tem1 = tem1 + cldtausw(i,k)
182 fluxr(i,43-j) = fluxr(i,43-j) + tem0d * tem1
190 tem0d = raddt * cldsa(i,j)
191 itop = mtopa(i,j) - kd
192 ibtc = mbota(i,j) - kd
195 tem2 = tem2 + cldtaulw(i,k)
197 fluxr(i,46-j) = fluxr(i,46-j) + tem0d * (1.0-exp(-tem2))
209 where(topfsw(:)%dnfxc>0) total_albedo(:) = topfsw(:)%upfxc/topfsw(:)%dnfxc
subroutine gfs_rrtmg_post_run(im, km, kmp1, lm, ltp, kt, kb, kd, nspc1, nfxr, nday, lsswr, lslwr, lssav, fhlwr, fhswr, raddt, coszen, coszdg, prsi, tgrs, aerodp, cldsa, mtopa, mbota, clouds1, cldtaulw, cldtausw, sfcflw, sfcfsw, topflw, topfsw, scmpsw, fluxr, total_albedo, errmsg, errflg)