Line data Source code
1 :
2 : module radlw
3 : !-----------------------------------------------------------------------
4 : !
5 : ! Purpose: Longwave radiation calculations.
6 : !
7 : !-----------------------------------------------------------------------
8 : use shr_kind_mod, only: r8 => shr_kind_r8
9 : use ppgrid, only: pcols, pver, pverp
10 : use scamMod, only: single_column, scm_crm_mode
11 : use parrrtm, only: nbndlw, ngptlw
12 : use rrtmg_lw_init, only: rrtmg_lw_ini
13 : use rrtmg_lw_rad, only: rrtmg_lw
14 : use spmd_utils, only: masterproc
15 : use perf_mod, only: t_startf, t_stopf
16 : use cam_logfile, only: iulog
17 : use cam_abortutils, only: endrun
18 : use radconstants, only: nlwbands
19 :
20 : implicit none
21 :
22 : private
23 : save
24 :
25 : ! Public methods
26 :
27 : public ::&
28 : radlw_init, &! initialize constants
29 : rad_rrtmg_lw ! driver for longwave radiation code
30 :
31 : ! Private data
32 : integer :: ntoplw ! top level to solve for longwave cooling
33 :
34 : ! Flag for cloud overlap method
35 : ! 0=clear, 1=random, 2=maximum/random, 3=maximum
36 : integer, parameter :: icld = 2
37 :
38 :
39 : !===============================================================================
40 : CONTAINS
41 : !===============================================================================
42 :
43 32496 : subroutine rad_rrtmg_lw(lchnk ,ncol ,rrtmg_levs,r_state, &
44 : pmid ,aer_lw_abs,cld ,tauc_lw, &
45 : qrl ,qrlc , &
46 : flns ,flnt ,flnsc ,flntc ,flwds, &
47 : flut ,flutc ,fnl ,fcnl ,fldsc, &
48 : lu ,ld )
49 :
50 : !-----------------------------------------------------------------------
51 : use cam_history, only: outfld
52 : use mcica_subcol_gen_lw, only: mcica_subcol_lw
53 : use physconst, only: cpair
54 : use rrtmg_state, only: rrtmg_state_t
55 :
56 : !------------------------------Arguments--------------------------------
57 : !
58 : ! Input arguments
59 : !
60 : integer, intent(in) :: lchnk ! chunk identifier
61 : integer, intent(in) :: ncol ! number of atmospheric columns
62 : integer, intent(in) :: rrtmg_levs ! number of levels rad is applied
63 :
64 : !
65 : ! Input arguments which are only passed to other routines
66 : !
67 : type(rrtmg_state_t), intent(in) :: r_state
68 :
69 : real(r8), intent(in) :: pmid(pcols,pver) ! Level pressure (Pascals)
70 :
71 : real(r8), intent(in) :: aer_lw_abs (pcols,pver,nbndlw) ! aerosol absorption optics depth (LW)
72 :
73 : real(r8), intent(in) :: cld(pcols,pver) ! Cloud cover
74 : real(r8), intent(in) :: tauc_lw(nbndlw,pcols,pver) ! Cloud longwave optical depth by band
75 :
76 : !
77 : ! Output arguments
78 : !
79 : real(r8), intent(out) :: qrl (pcols,pver) ! Longwave heating rate
80 : real(r8), intent(out) :: qrlc(pcols,pver) ! Clearsky longwave heating rate
81 : real(r8), intent(out) :: flns(pcols) ! Surface cooling flux
82 : real(r8), intent(out) :: flnt(pcols) ! Net outgoing flux
83 : real(r8), intent(out) :: flut(pcols) ! Upward flux at top of model
84 : real(r8), intent(out) :: flnsc(pcols) ! Clear sky surface cooing
85 : real(r8), intent(out) :: flntc(pcols) ! Net clear sky outgoing flux
86 : real(r8), intent(out) :: flutc(pcols) ! Upward clear-sky flux at top of model
87 : real(r8), intent(out) :: flwds(pcols) ! Down longwave flux at surface
88 : real(r8), intent(out) :: fldsc(pcols) ! Down longwave clear flux at surface
89 : real(r8), intent(out) :: fcnl(pcols,pverp) ! clear sky net flux at interfaces
90 : real(r8), intent(out) :: fnl(pcols,pverp) ! net flux at interfaces
91 :
92 : real(r8), pointer, dimension(:,:,:) :: lu ! longwave spectral flux up
93 : real(r8), pointer, dimension(:,:,:) :: ld ! longwave spectral flux down
94 :
95 : !
96 : !---------------------------Local variables-----------------------------
97 : !
98 : integer :: i, k, kk, nbnd ! indices
99 :
100 : real(r8) :: ful(pcols,pverp) ! Total upwards longwave flux
101 : real(r8) :: fsul(pcols,pverp) ! Clear sky upwards longwave flux
102 : real(r8) :: fdl(pcols,pverp) ! Total downwards longwave flux
103 : real(r8) :: fsdl(pcols,pverp) ! Clear sky downwards longwv flux
104 :
105 : real(r8) :: tsfc(pcols) ! surface temperature
106 : real(r8) :: emis(pcols,nbndlw) ! surface emissivity
107 :
108 61920 : real(r8) :: taua_lw(pcols,rrtmg_levs-1,nbndlw) ! aerosol optical depth by band
109 :
110 : real(r8), parameter :: dps = 1._r8/86400._r8 ! Inverse of seconds per day
111 :
112 : ! Cloud arrays for McICA
113 : integer, parameter :: nsubclw = ngptlw ! rrtmg_lw g-point (quadrature point) dimension
114 : integer :: permuteseed ! permute seed for sub-column generator
115 :
116 61920 : real(r8) :: cicewp(pcols,rrtmg_levs-1) ! in-cloud cloud ice water path
117 61920 : real(r8) :: cliqwp(pcols,rrtmg_levs-1) ! in-cloud cloud liquid water path
118 61920 : real(r8) :: rei(pcols,rrtmg_levs-1) ! ice particle effective radius (microns)
119 61920 : real(r8) :: rel(pcols,rrtmg_levs-1) ! liquid particle radius (micron)
120 :
121 61920 : real(r8) :: cld_stolw(nsubclw, pcols, rrtmg_levs-1) ! cloud fraction (mcica)
122 61920 : real(r8) :: cicewp_stolw(nsubclw, pcols, rrtmg_levs-1) ! cloud ice water path (mcica)
123 61920 : real(r8) :: cliqwp_stolw(nsubclw, pcols, rrtmg_levs-1) ! cloud liquid water path (mcica)
124 61920 : real(r8) :: rei_stolw(pcols,rrtmg_levs-1) ! ice particle size (mcica)
125 61920 : real(r8) :: rel_stolw(pcols,rrtmg_levs-1) ! liquid particle size (mcica)
126 61920 : real(r8) :: tauc_stolw(nsubclw, pcols, rrtmg_levs-1) ! cloud optical depth (mcica - optional)
127 :
128 : ! Includes extra layer above model top
129 61920 : real(r8) :: uflx(pcols,rrtmg_levs+1) ! Total upwards longwave flux
130 61920 : real(r8) :: uflxc(pcols,rrtmg_levs+1) ! Clear sky upwards longwave flux
131 61920 : real(r8) :: dflx(pcols,rrtmg_levs+1) ! Total downwards longwave flux
132 61920 : real(r8) :: dflxc(pcols,rrtmg_levs+1) ! Clear sky downwards longwv flux
133 61920 : real(r8) :: hr(pcols,rrtmg_levs) ! Longwave heating rate (K/d)
134 61920 : real(r8) :: hrc(pcols,rrtmg_levs) ! Clear sky longwave heating rate (K/d)
135 : real(r8) lwuflxs(nbndlw,pcols,pverp+1) ! Longwave spectral flux up
136 : real(r8) lwdflxs(nbndlw,pcols,pverp+1) ! Longwave spectral flux down
137 : !-----------------------------------------------------------------------
138 :
139 : ! mji/rrtmg
140 :
141 : ! Calculate cloud optical properties here if using CAM method, or if using one of the
142 : ! methods in RRTMG_LW, then pass in cloud physical properties and zero out cloud optical
143 : ! properties here
144 :
145 : ! Zero optional cloud optical depth input array tauc_lw,
146 : ! if inputting cloud physical properties into RRTMG_LW
147 : ! tauc_lw(:,:,:) = 0.
148 : ! Or, pass in CAM cloud longwave optical depth to RRTMG_LW
149 : ! do nbnd = 1, nbndlw
150 : ! tauc_lw(nbnd,:ncol,:pver) = cldtau(:ncol,:pver)
151 : ! end do
152 :
153 : ! Call mcica sub-column generator for RRTMG_LW
154 :
155 : ! Call sub-column generator for McICA in radiation
156 30960 : call t_startf('mcica_subcol_lw')
157 :
158 : ! Set permute seed (must be offset between LW and SW by at least 140 to insure
159 : ! effective randomization)
160 30960 : permuteseed = 150
161 :
162 : ! These fields are no longer supplied by CAM.
163 48452400 : cicewp = 0.0_r8
164 48452400 : cliqwp = 0.0_r8
165 48452400 : rei = 0.0_r8
166 48452400 : rel = 0.0_r8
167 :
168 0 : call mcica_subcol_lw(lchnk, ncol, rrtmg_levs-1, icld, permuteseed, pmid(:, pverp-rrtmg_levs+1:pverp-1), &
169 0 : cld(:, pverp-rrtmg_levs+1:pverp-1), cicewp, cliqwp, rei, rel, tauc_lw(:, :ncol, pverp-rrtmg_levs+1:pverp-1), &
170 30960 : cld_stolw, cicewp_stolw, cliqwp_stolw, rei_stolw, rel_stolw, tauc_stolw)
171 :
172 30960 : call t_stopf('mcica_subcol_lw')
173 :
174 :
175 30960 : call t_startf('rrtmg_lw')
176 :
177 : ! Convert incoming water amounts from specific humidity to vmr as needed;
178 : ! Convert other incoming molecular amounts from mmr to vmr as needed;
179 : ! Convert pressures from Pa to hPa;
180 : ! Set surface emissivity to 1.0 here, this is treated in land surface model;
181 : ! Set surface temperature
182 : ! Set aerosol optical depth to zero for now
183 :
184 8302320 : emis(:ncol,:nbndlw) = 1._r8
185 516960 : tsfc(:ncol) = r_state%tlev(:ncol,rrtmg_levs+1)
186 761522400 : taua_lw(:ncol, 1:rrtmg_levs-1, :nbndlw) = aer_lw_abs(:ncol,pverp-rrtmg_levs+1:pverp-1,:nbndlw)
187 :
188 30960 : if (associated(lu)) lu(1:ncol,:,:) = 0.0_r8
189 30960 : if (associated(ld)) ld(1:ncol,:,:) = 0.0_r8
190 :
191 : call rrtmg_lw(lchnk ,ncol ,rrtmg_levs ,icld , &
192 : r_state%pmidmb ,r_state%pintmb ,r_state%tlay ,r_state%tlev ,tsfc ,r_state%h2ovmr, &
193 : r_state%o3vmr ,r_state%co2vmr ,r_state%ch4vmr ,r_state%o2vmr ,r_state%n2ovmr ,r_state%cfc11vmr,r_state%cfc12vmr, &
194 : r_state%cfc22vmr,r_state%ccl4vmr ,emis ,&
195 : cld_stolw,tauc_stolw,cicewp_stolw,cliqwp_stolw ,rei, rel, &
196 : taua_lw, &
197 : uflx ,dflx ,hr ,uflxc ,dflxc ,hrc, &
198 30960 : lwuflxs, lwdflxs)
199 :
200 : !
201 : !----------------------------------------------------------------------
202 : ! All longitudes: store history tape quantities
203 : ! Flux units are in W/m2 on output from rrtmg_lw and contain output for
204 : ! extra layer above model top with vertical indexing from bottom to top.
205 : ! Heating units are in K/d on output from RRTMG and contain output for
206 : ! extra layer above model top with vertical indexing from bottom to top.
207 : ! Heating units are converted to J/kg/s below for use in CAM.
208 :
209 547920 : flwds(:ncol) = dflx (:ncol,1)
210 516960 : fldsc(:ncol) = dflxc(:ncol,1)
211 516960 : flns(:ncol) = uflx (:ncol,1) - dflx (:ncol,1)
212 516960 : flnsc(:ncol) = uflxc(:ncol,1) - dflxc(:ncol,1)
213 516960 : flnt(:ncol) = uflx (:ncol,rrtmg_levs) - dflx (:ncol,rrtmg_levs)
214 516960 : flntc(:ncol) = uflxc(:ncol,rrtmg_levs) - dflxc(:ncol,rrtmg_levs)
215 516960 : flut(:ncol) = uflx (:ncol,rrtmg_levs)
216 516960 : flutc(:ncol) = uflxc(:ncol,rrtmg_levs)
217 :
218 : !
219 : ! Reverse vertical indexing here for CAM arrays to go from top to bottom.
220 : !
221 30960 : ful = 0._r8
222 30960 : fdl = 0._r8
223 30960 : fsul = 0._r8
224 30960 : fsdl = 0._r8
225 48108240 : ful (:ncol,pverp-rrtmg_levs+1:pverp)= uflx(:ncol,rrtmg_levs:1:-1)
226 48108240 : fdl (:ncol,pverp-rrtmg_levs+1:pverp)= dflx(:ncol,rrtmg_levs:1:-1)
227 48108240 : fsul(:ncol,pverp-rrtmg_levs+1:pverp)=uflxc(:ncol,rrtmg_levs:1:-1)
228 48108240 : fsdl(:ncol,pverp-rrtmg_levs+1:pverp)=dflxc(:ncol,rrtmg_levs:1:-1)
229 :
230 30960 : if (single_column.and.scm_crm_mode) then
231 0 : call outfld('FUL ',ful,pcols,lchnk)
232 0 : call outfld('FDL ',fdl,pcols,lchnk)
233 0 : call outfld('FULC ',fsul,pcols,lchnk)
234 0 : call outfld('FDLC ',fsdl,pcols,lchnk)
235 : endif
236 :
237 48625200 : fnl(:ncol,:) = ful(:ncol,:) - fdl(:ncol,:)
238 : ! mji/ cam excluded this?
239 48625200 : fcnl(:ncol,:) = fsul(:ncol,:) - fsdl(:ncol,:)
240 :
241 : ! Pass longwave heating to CAM arrays and convert from K/d to J/kg/s
242 30960 : qrl = 0._r8
243 30960 : qrlc = 0._r8
244 47591280 : qrl (:ncol,pverp-rrtmg_levs+1:pver)=hr (:ncol,rrtmg_levs-1:1:-1)*cpair*dps
245 47591280 : qrlc(:ncol,pverp-rrtmg_levs+1:pver)=hrc(:ncol,rrtmg_levs-1:1:-1)*cpair*dps
246 :
247 : ! Return 0 above solution domain
248 30960 : if ( ntoplw > 1 )then
249 0 : qrl(:ncol,:ntoplw-1) = 0._r8
250 0 : qrlc(:ncol,:ntoplw-1) = 0._r8
251 : end if
252 :
253 : ! Pass spectral fluxes, reverse layering
254 : ! order=(/3,1,2/) maps the first index of lwuflxs to the third index of lu.
255 30960 : if (associated(lu)) then
256 0 : lu(:ncol,pverp-rrtmg_levs+1:pverp,:) = reshape(lwuflxs(:,:ncol,rrtmg_levs:1:-1), &
257 0 : (/ncol,rrtmg_levs,nbndlw/), order=(/3,1,2/))
258 : end if
259 :
260 30960 : if (associated(ld)) then
261 0 : ld(:ncol,pverp-rrtmg_levs+1:pverp,:) = reshape(lwdflxs(:,:ncol,rrtmg_levs:1:-1), &
262 0 : (/ncol,rrtmg_levs,nbndlw/), order=(/3,1,2/))
263 : end if
264 :
265 30960 : call t_stopf('rrtmg_lw')
266 :
267 30960 : end subroutine rad_rrtmg_lw
268 :
269 : !-------------------------------------------------------------------------------
270 :
271 1536 : subroutine radlw_init()
272 : !-----------------------------------------------------------------------
273 : !
274 : ! Purpose:
275 : ! Initialize various constants for radiation scheme.
276 : !
277 : !-----------------------------------------------------------------------
278 :
279 30960 : use ref_pres, only : pref_mid
280 :
281 : integer :: k
282 :
283 : ! If the top model level is above ~90 km (0.1 Pa), set the top level to compute
284 : ! longwave cooling to about 80 km (1 Pa)
285 1536 : if (pref_mid(1) .lt. 0.1_r8) then
286 0 : do k = 1, pver
287 0 : if (pref_mid(k) .lt. 1._r8) ntoplw = k
288 : end do
289 : else
290 1536 : ntoplw = 1
291 : end if
292 1536 : if (masterproc) then
293 2 : write(iulog,*) 'radlw_init: ntoplw =',ntoplw
294 : endif
295 :
296 1536 : call rrtmg_lw_ini
297 :
298 1536 : end subroutine radlw_init
299 :
300 : !-------------------------------------------------------------------------------
301 :
302 : end module radlw
|
