Line data Source code
1 : ! path: $Source: /storm/rc1/cvsroot/rc/rrtmg_sw/src/rrtmg_sw.f90,v $
2 : ! author: $Author: mike $
3 : ! revision: $Revision: 1.6 $
4 : ! created: $Date: 2008/01/03 21:35:35 $
5 : !
6 :
7 : module rrtmg_sw_rad
8 :
9 : ! --------------------------------------------------------------------------
10 : ! | |
11 : ! | Copyright 2002-2007, Atmospheric & Environmental Research, Inc. (AER). |
12 : ! | This software may be used, copied, or redistributed as long as it is |
13 : ! | not sold and this copyright notice is reproduced on each copy made. |
14 : ! | This model is provided as is without any express or implied warranties. |
15 : ! | (http://www.rtweb.aer.com/) |
16 : ! | |
17 : ! --------------------------------------------------------------------------
18 : !
19 : ! ****************************************************************************
20 : ! * *
21 : ! * RRTMG_SW *
22 : ! * *
23 : ! * *
24 : ! * *
25 : ! * a rapid radiative transfer model *
26 : ! * for the solar spectral region *
27 : ! * for application to general circulation models *
28 : ! * *
29 : ! * *
30 : ! * Atmospheric and Environmental Research, Inc. *
31 : ! * 131 Hartwell Avenue *
32 : ! * Lexington, MA 02421 *
33 : ! * *
34 : ! * *
35 : ! * Eli J. Mlawer *
36 : ! * Jennifer S. Delamere *
37 : ! * Michael J. Iacono *
38 : ! * Shepard A. Clough *
39 : ! * *
40 : ! * *
41 : ! * *
42 : ! * *
43 : ! * *
44 : ! * *
45 : ! * email: miacono@aer.com *
46 : ! * email: emlawer@aer.com *
47 : ! * email: jdelamer@aer.com *
48 : ! * *
49 : ! * The authors wish to acknowledge the contributions of the *
50 : ! * following people: Steven J. Taubman, Patrick D. Brown, *
51 : ! * Ronald E. Farren, Luke Chen, Robert Bergstrom. *
52 : ! * *
53 : ! ****************************************************************************
54 :
55 : ! --------- Modules ---------
56 :
57 : use shr_kind_mod, only: r8=>shr_kind_r8
58 :
59 : use mcica_subcol_gen_sw, only: mcica_subcol_sw
60 : use rrtmg_sw_cldprmc, only: cldprmc_sw
61 : use rrtmg_sw_setcoef, only: setcoef_sw
62 : use rrtmg_sw_spcvmc, only: spcvmc_sw
63 :
64 : implicit none
65 :
66 : public :: rrtmg_sw
67 :
68 : ! CAM supplies shortwave cloud optical properties
69 : integer, parameter :: inflag = 0 ! flag for cloud parameterization method
70 : integer, parameter :: iceflag = 0 ! flag for ice cloud parameterization method
71 : integer, parameter :: liqflag = 0 ! flag for liquid cloud parameterization method
72 :
73 : ! Set iaer to select aerosol option
74 : ! iaer = 0, no aerosols
75 : ! iaer = 10, input total aerosol optical depth, single scattering albedo
76 : ! and asymmetry parameter (tauaer, ssaaer, asmaer) directly
77 : integer, parameter :: iaer = 10
78 :
79 : ! Set idelm to select between delta-M scaled or unscaled output direct and diffuse fluxes
80 : ! NOTE: total downward fluxes are always delta scaled
81 : ! idelm = 0, output direct and diffuse flux components are not delta scaled
82 : ! (direct flux does not include forward scattering peak)
83 : ! idelm = 1, output direct and diffuse flux components are delta scaled (default)
84 : ! (direct flux includes part or most of forward scattering peak)
85 : integer, parameter :: idelm = 1
86 :
87 : !=========================================================================================
88 : contains
89 : !=========================================================================================
90 :
91 2304 : subroutine rrtmg_sw &
92 : (lchnk ,ncol ,nlay ,icld , &
93 2304 : play ,plev ,tlay ,tlev ,tsfc , &
94 2304 : h2ovmr ,o3vmr ,co2vmr ,ch4vmr ,o2vmr ,n2ovmr , &
95 2304 : asdir ,asdif ,aldir ,aldif , &
96 2304 : coszen ,adjes ,dyofyr ,solvar, &
97 2304 : cldfmcl ,taucmcl ,ssacmcl ,asmcmcl ,fsfcmcl, &
98 2304 : ciwpmcl ,clwpmcl ,reicmcl ,relqmcl , &
99 2304 : tauaer ,ssaaer ,asmaer , &
100 4608 : swuflx ,swdflx ,swhr ,swuflxc ,swdflxc ,swhrc, &
101 4608 : dirdnuv, dirdnir, difdnuv, difdnir, ninflx, ninflxc, &
102 2304 : swuflxs, swdflxs)
103 :
104 :
105 : ! ------- Description -------
106 :
107 : ! This program is the driver for RRTMG_SW, the AER SW radiation model for
108 : ! application to GCMs, that has been adapted from RRTM_SW for improved
109 : ! efficiency and to provide fractional cloudiness and cloud overlap
110 : ! capability using McICA.
111 : !
112 : ! This routine
113 : ! b) calls INATM_SW to read in the atmospheric profile;
114 : ! all layering in RRTMG is ordered from surface to toa.
115 : ! c) calls CLDPRMC_SW to set cloud optical depth for McICA based
116 : ! on input cloud properties
117 : ! d) calls SETCOEF_SW to calculate various quantities needed for
118 : ! the radiative transfer algorithm
119 : ! e) calls SPCVMC to call the two-stream model that in turn
120 : ! calls TAUMOL to calculate gaseous optical depths for each
121 : ! of the 16 spectral bands and to perform the radiative transfer
122 : ! using McICA, the Monte-Carlo Independent Column Approximation,
123 : ! to represent sub-grid scale cloud variability
124 : ! f) passes the calculated fluxes and cooling rates back to GCM
125 : !
126 : ! *** This version uses McICA ***
127 : ! Monte Carlo Independent Column Approximation (McICA, Pincus et al.,
128 : ! JC, 2003) method is applied to the forward model calculation
129 : ! This method is valid for clear sky or partial cloud conditions.
130 : !
131 : ! This call to RRTMG_SW must be preceeded by a call to the module
132 : ! mcica_subcol_gen_sw.f90 to run the McICA sub-column cloud generator,
133 : ! which will provide the cloud physical or cloud optical properties
134 : ! on the RRTMG quadrature point (ngptsw) dimension.
135 : !
136 : ! *** This version only allows input of cloud optical properties ***
137 : ! Input cloud fraction, cloud optical depth, single scattering albedo
138 : ! and asymmetry parameter directly (inflg = 0)
139 : !
140 : ! *** This version only allows input of aerosol optical properties ***
141 : ! Input aerosol optical depth, single scattering albedo and asymmetry
142 : ! parameter directly by layer and spectral band (iaer=10)
143 : !
144 : !
145 : ! ------- Modifications -------
146 : !
147 : ! This version of RRTMG_SW has been modified from RRTM_SW to use a reduced
148 : ! set of g-point intervals and a two-stream model for application to GCMs.
149 : !
150 : !-- Original version (derived from RRTM_SW)
151 : ! 2002: AER. Inc.
152 : !-- Conversion to F90 formatting; addition of 2-stream radiative transfer
153 : ! Feb 2003: J.-J. Morcrette, ECMWF
154 : !-- Additional modifications for GCM application
155 : ! Aug 2003: M. J. Iacono, AER Inc.
156 : !-- Total number of g-points reduced from 224 to 112. Original
157 : ! set of 224 can be restored by exchanging code in module parrrsw.f90
158 : ! and in file rrtmg_sw_init.f90.
159 : ! Apr 2004: M. J. Iacono, AER, Inc.
160 : !-- Modifications to include output for direct and diffuse
161 : ! downward fluxes. There are output as "true" fluxes without
162 : ! any delta scaling applied. Code can be commented to exclude
163 : ! this calculation in source file rrtmg_sw_spcvrt.f90.
164 : ! Jan 2005: E. J. Mlawer, M. J. Iacono, AER, Inc.
165 : !-- Revised to add McICA capability.
166 : ! Nov 2005: M. J. Iacono, AER, Inc.
167 : !-- Reformatted for consistency with rrtmg_lw.
168 : ! Feb 2007: M. J. Iacono, AER, Inc.
169 : !-- Modifications to formatting to use assumed-shape arrays.
170 : ! Aug 2007: M. J. Iacono, AER, Inc.
171 : !-- Modified to output direct and diffuse fluxes either with or without
172 : ! delta scaling based on setting of idelm flag
173 : ! Dec 2008: M. J. Iacono, AER, Inc.
174 :
175 : use parrrsw, only: nbndsw, ngptsw, mxmol, jpband, jpb1, jpb2
176 : use rrsw_con, only: heatfac, oneminus, pi
177 :
178 :
179 : ! ----- Input -----
180 : integer, intent(in) :: lchnk ! chunk identifier
181 : integer, intent(in) :: ncol ! Number of horizontal columns
182 : integer, intent(in) :: nlay ! Number of model layers
183 : integer, intent(in) :: icld ! Cloud overlap method
184 : ! 0: Clear only
185 : ! 1: Random
186 : ! 2: Maximum/random
187 : ! 3: Maximum
188 : real(kind=r8), intent(in) :: play(:,:) ! Layer pressures (hPa, mb)
189 : ! Dimensions: (ncol,nlay)
190 : real(kind=r8), intent(in) :: plev(:,:) ! Interface pressures (hPa, mb)
191 : ! Dimensions: (ncol,nlay+1)
192 : real(kind=r8), intent(in) :: tlay(:,:) ! Layer temperatures (K)
193 : ! Dimensions: (ncol,nlay)
194 : real(kind=r8), intent(in) :: tlev(:,:) ! Interface temperatures (K)
195 : ! Dimensions: (ncol,nlay+1)
196 : real(kind=r8), intent(in) :: tsfc(:) ! Surface temperature (K)
197 : ! Dimensions: (ncol)
198 : real(kind=r8), intent(in) :: h2ovmr(:,:) ! H2O volume mixing ratio
199 : ! Dimensions: (ncol,nlay)
200 : real(kind=r8), intent(in) :: o3vmr(:,:) ! O3 volume mixing ratio
201 : ! Dimensions: (ncol,nlay)
202 : real(kind=r8), intent(in) :: co2vmr(:,:) ! CO2 volume mixing ratio
203 : ! Dimensions: (ncol,nlay)
204 : real(kind=r8), intent(in) :: ch4vmr(:,:) ! Methane volume mixing ratio
205 : ! Dimensions: (ncol,nlay)
206 : real(kind=r8), intent(in) :: o2vmr(:,:) ! O2 volume mixing ratio
207 : ! Dimensions: (ncol,nlay)
208 : real(kind=r8), intent(in) :: n2ovmr(:,:) ! Nitrous oxide volume mixing ratio
209 : ! Dimensions: (ncol,nlay)
210 : real(kind=r8), intent(in) :: asdir(:) ! UV/vis surface albedo direct rad
211 : ! Dimensions: (ncol)
212 : real(kind=r8), intent(in) :: aldir(:) ! Near-IR surface albedo direct rad
213 : ! Dimensions: (ncol)
214 : real(kind=r8), intent(in) :: asdif(:) ! UV/vis surface albedo: diffuse rad
215 : ! Dimensions: (ncol)
216 : real(kind=r8), intent(in) :: aldif(:) ! Near-IR surface albedo: diffuse rad
217 : ! Dimensions: (ncol)
218 :
219 : integer, intent(in) :: dyofyr ! Day of the year (used to get Earth/Sun
220 : ! distance if adjflx not provided)
221 : real(kind=r8), intent(in) :: adjes ! Flux adjustment for Earth/Sun distance
222 : real(kind=r8), intent(in) :: coszen(:) ! Cosine of solar zenith angle
223 : ! Dimensions: (ncol)
224 : real(kind=r8), intent(in) :: solvar(1:nbndsw) ! Solar constant (Wm-2) scaling per band
225 :
226 : real(kind=r8), intent(in) :: cldfmcl(:,:,:) ! Cloud fraction
227 : ! Dimensions: (ngptsw,ncol,nlay)
228 : real(kind=r8), intent(in) :: taucmcl(:,:,:) ! Cloud optical depth
229 : ! Dimensions: (ngptsw,ncol,nlay)
230 : real(kind=r8), intent(in) :: ssacmcl(:,:,:) ! Cloud single scattering albedo
231 : ! Dimensions: (ngptsw,ncol,nlay)
232 : real(kind=r8), intent(in) :: asmcmcl(:,:,:) ! Cloud asymmetry parameter
233 : ! Dimensions: (ngptsw,ncol,nlay)
234 : real(kind=r8), intent(in) :: fsfcmcl(:,:,:) ! Cloud forward scattering parameter
235 : ! Dimensions: (ngptsw,ncol,nlay)
236 : real(kind=r8), intent(in) :: ciwpmcl(:,:,:) ! Cloud ice water path (g/m2)
237 : ! Dimensions: (ngptsw,ncol,nlay)
238 : real(kind=r8), intent(in) :: clwpmcl(:,:,:) ! Cloud liquid water path (g/m2)
239 : ! Dimensions: (ngptsw,ncol,nlay)
240 : real(kind=r8), intent(in) :: reicmcl(:,:) ! Cloud ice effective radius (microns)
241 : ! Dimensions: (ncol,nlay)
242 : real(kind=r8), intent(in) :: relqmcl(:,:) ! Cloud water drop effective radius (microns)
243 : ! Dimensions: (ncol,nlay)
244 : real(kind=r8), intent(in) :: tauaer(:,:,:) ! Aerosol optical depth (iaer=10 only)
245 : ! Dimensions: (ncol,nlay,nbndsw)
246 : ! (non-delta scaled)
247 : real(kind=r8), intent(in) :: ssaaer(:,:,:) ! Aerosol single scattering albedo (iaer=10 only)
248 : ! Dimensions: (ncol,nlay,nbndsw)
249 : ! (non-delta scaled)
250 : real(kind=r8), intent(in) :: asmaer(:,:,:) ! Aerosol asymmetry parameter (iaer=10 only)
251 : ! Dimensions: (ncol,nlay,nbndsw)
252 : ! (non-delta scaled)
253 :
254 : ! ----- Output -----
255 :
256 : real(kind=r8), intent(out) :: swuflx(:,:) ! Total sky shortwave upward flux (W/m2)
257 : ! Dimensions: (ncol,nlay+1)
258 : real(kind=r8), intent(out) :: swdflx(:,:) ! Total sky shortwave downward flux (W/m2)
259 : ! Dimensions: (ncol,nlay+1)
260 : real(kind=r8), intent(out) :: swhr(:,:) ! Total sky shortwave radiative heating rate (K/d)
261 : ! Dimensions: (ncol,nlay)
262 : real(kind=r8), intent(out) :: swuflxc(:,:) ! Clear sky shortwave upward flux (W/m2)
263 : ! Dimensions: (ncol,nlay+1)
264 : real(kind=r8), intent(out) :: swdflxc(:,:) ! Clear sky shortwave downward flux (W/m2)
265 : ! Dimensions: (ncol,nlay+1)
266 : real(kind=r8), intent(out) :: swhrc(:,:) ! Clear sky shortwave radiative heating rate (K/d)
267 : ! Dimensions: (ncol,nlay)
268 :
269 : real(kind=r8), intent(out) :: dirdnuv(:,:) ! Direct downward shortwave flux, UV/vis
270 : real(kind=r8), intent(out) :: difdnuv(:,:) ! Diffuse downward shortwave flux, UV/vis
271 : real(kind=r8), intent(out) :: dirdnir(:,:) ! Direct downward shortwave flux, near-IR
272 : real(kind=r8), intent(out) :: difdnir(:,:) ! Diffuse downward shortwave flux, near-IR
273 :
274 : real(kind=r8), intent(out) :: ninflx(:,:) ! Net shortwave flux, near-IR
275 : real(kind=r8), intent(out) :: ninflxc(:,:) ! Net clear sky shortwave flux, near-IR
276 :
277 : real(kind=r8), intent(out) :: swuflxs(:,:,:) ! shortwave spectral flux up
278 : real(kind=r8), intent(out) :: swdflxs(:,:,:) ! shortwave spectral flux down
279 :
280 : ! ----- Local -----
281 :
282 : ! Control
283 : integer :: istart ! beginning band of calculation
284 : integer :: iend ! ending band of calculation
285 : integer :: icpr ! cldprop/cldprmc use flag
286 : integer :: iout = 0 ! output option flag (inactive)
287 : integer :: isccos ! instrumental cosine response flag (inactive)
288 : integer :: iplon ! column loop index
289 : integer :: i ! layer loop index ! jk
290 : integer :: ib ! band loop index ! jsw
291 : integer :: ia, ig ! indices
292 : integer :: k ! layer loop index
293 : integer :: ims ! value for changing mcica permute seed
294 :
295 : real(kind=r8) :: zepsec, zepzen ! epsilon
296 : real(kind=r8) :: zdpgcp ! flux to heating conversion ratio
297 :
298 : ! Atmosphere
299 4608 : real(kind=r8) :: pavel(ncol,nlay) ! layer pressures (mb)
300 4608 : real(kind=r8) :: tavel(ncol,nlay) ! layer temperatures (K)
301 4608 : real(kind=r8) :: pz(ncol,0:nlay) ! level (interface) pressures (hPa, mb)
302 4608 : real(kind=r8) :: tz(ncol,0:nlay) ! level (interface) temperatures (K)
303 4608 : real(kind=r8) :: tbound(ncol) ! surface temperature (K)
304 4608 : real(kind=r8) :: pdp(ncol,nlay) ! layer pressure thickness (hPa, mb)
305 4608 : real(kind=r8) :: coldry(ncol,nlay) ! dry air column amount
306 4608 : real(kind=r8) :: wkl(ncol,mxmol,nlay) ! molecular amounts (mol/cm-2)
307 :
308 4608 : real(kind=r8) :: cossza(ncol) ! Cosine of solar zenith angle
309 4608 : real(kind=r8) :: adjflux(ncol,jpband) ! adjustment for current Earth/Sun distance
310 : ! default value of 1368.22 Wm-2 at 1 AU
311 4608 : real(kind=r8) :: albdir(ncol,nbndsw) ! surface albedo, direct ! zalbp
312 4608 : real(kind=r8) :: albdif(ncol,nbndsw) ! surface albedo, diffuse ! zalbd
313 :
314 : ! Atmosphere - setcoef
315 4608 : integer :: laytrop(ncol) ! tropopause layer index
316 4608 : integer :: layswtch(ncol) !
317 4608 : integer :: laylow(ncol) !
318 4608 : integer :: jp(ncol,nlay) !
319 4608 : integer :: jt(ncol,nlay) !
320 4608 : integer :: jt1(ncol,nlay) !
321 :
322 4608 : real(kind=r8) :: colh2o(ncol,nlay) ! column amount (h2o)
323 4608 : real(kind=r8) :: colco2(ncol,nlay) ! column amount (co2)
324 4608 : real(kind=r8) :: colo3(ncol,nlay) ! column amount (o3)
325 4608 : real(kind=r8) :: coln2o(ncol,nlay) ! column amount (n2o)
326 4608 : real(kind=r8) :: colch4(ncol,nlay) ! column amount (ch4)
327 4608 : real(kind=r8) :: colo2(ncol,nlay) ! column amount (o2)
328 4608 : real(kind=r8) :: colmol(ncol,nlay) ! column amount
329 4608 : real(kind=r8) :: co2mult(ncol,nlay) ! column amount
330 :
331 4608 : integer :: indself(ncol,nlay)
332 4608 : integer :: indfor(ncol,nlay)
333 4608 : real(kind=r8) :: selffac(ncol,nlay)
334 4608 : real(kind=r8) :: selffrac(ncol,nlay)
335 4608 : real(kind=r8) :: forfac(ncol,nlay)
336 4608 : real(kind=r8) :: forfrac(ncol,nlay)
337 :
338 4608 : real(kind=r8) :: fac00(ncol,nlay)
339 4608 : real(kind=r8) :: fac01(ncol,nlay)
340 4608 : real(kind=r8) :: fac11(ncol,nlay)
341 4608 : real(kind=r8) :: fac10(ncol,nlay)
342 :
343 : ! Atmosphere/clouds - cldprmc [mcica]
344 4608 : real(kind=r8) :: ciwpmc(ncol,ngptsw,nlay) ! cloud ice water path [mcica]
345 4608 : real(kind=r8) :: clwpmc(ncol,ngptsw,nlay) ! cloud liquid water path [mcica]
346 4608 : real(kind=r8) :: relqmc(ncol,nlay) ! liquid particle size (microns)
347 4608 : real(kind=r8) :: reicmc(ncol,nlay) ! ice particle effective radius (microns)
348 4608 : real(kind=r8) :: dgesmc(ncol,nlay) ! ice particle generalized effective size (microns)
349 4608 : real(kind=r8) :: fsfcmc(ncol,ngptsw,nlay) ! cloud forward scattering fraction [mcica]
350 :
351 : ! Atmosphere/clouds/aerosol - spcvrt,spcvmc
352 4608 : real(kind=r8) :: ztaua(ncol,nlay,nbndsw) ! total aerosol optical depth
353 4608 : real(kind=r8) :: zasya(ncol,nlay,nbndsw) ! total aerosol asymmetry parameter
354 4608 : real(kind=r8) :: zomga(ncol,nlay,nbndsw) ! total aerosol single scattering albedo
355 4608 : real(kind=r8) :: zcldfmc(ncol,nlay,ngptsw) ! cloud fraction [mcica]
356 4608 : real(kind=r8) :: ztaucmc(ncol,nlay,ngptsw) ! cloud optical depth [mcica]
357 4608 : real(kind=r8) :: ztaormc(ncol,nlay,ngptsw) ! unscaled cloud optical depth [mcica]
358 4608 : real(kind=r8) :: zasycmc(ncol,nlay,ngptsw) ! cloud asymmetry parameter [mcica]
359 4608 : real(kind=r8) :: zomgcmc(ncol,nlay,ngptsw) ! cloud single scattering albedo [mcica]
360 :
361 4608 : real(kind=r8) :: zbbfddir(ncol,nlay+2) ! temporary downward direct shortwave flux (w/m2)
362 4608 : real(kind=r8) :: zbbcddir(ncol,nlay+2) ! temporary clear sky downward direct shortwave flux (w/m2)
363 4608 : real(kind=r8) :: zuvfd(ncol,nlay+2) ! temporary UV downward shortwave flux (w/m2)
364 4608 : real(kind=r8) :: zuvcd(ncol,nlay+2) ! temporary clear sky UV downward shortwave flux (w/m2)
365 4608 : real(kind=r8) :: zuvcddir(ncol,nlay+2) ! temporary clear sky UV downward direct shortwave flux (w/m2)
366 4608 : real(kind=r8) :: znifd(ncol,nlay+2) ! temporary near-IR downward shortwave flux (w/m2)
367 4608 : real(kind=r8) :: znicd(ncol,nlay+2) ! temporary clear sky near-IR downward shortwave flux (w/m2)
368 4608 : real(kind=r8) :: znicddir(ncol,nlay+2) ! temporary clear sky near-IR downward direct shortwave flux (w/m2)
369 :
370 : ! Added for near-IR flux diagnostic
371 4608 : real(kind=r8) :: znifu(ncol,nlay+2) ! temporary near-IR downward shortwave flux (w/m2)
372 4608 : real(kind=r8) :: znicu(ncol,nlay+2) ! temporary clear sky near-IR downward shortwave flux (w/m2)
373 :
374 : ! Optional output fields
375 4608 : real(kind=r8) :: swnflx(nlay+2) ! Total sky shortwave net flux (W/m2)
376 4608 : real(kind=r8) :: swnflxc(nlay+2) ! Clear sky shortwave net flux (W/m2)
377 4608 : real(kind=r8) :: dirdflux(nlay+2) ! Direct downward shortwave surface flux
378 4608 : real(kind=r8) :: difdflux(nlay+2) ! Diffuse downward shortwave surface flux
379 4608 : real(kind=r8) :: uvdflx(nlay+2) ! Total sky downward shortwave flux, UV/vis
380 4608 : real(kind=r8) :: nidflx(nlay+2) ! Total sky downward shortwave flux, near-IR
381 :
382 : ! Initializations
383 :
384 2304 : zepsec = 1.e-06_r8
385 2304 : zepzen = 1.e-10_r8
386 2304 : oneminus = 1.0_r8 - zepsec
387 2304 : pi = 2._r8 * asin(1._r8)
388 :
389 2304 : istart = jpb1
390 2304 : iend = jpb2
391 2304 : icpr = 0
392 2304 : ims = 2
393 :
394 : ! Prepare atmosphere profile from GCM for use in RRTMG, and define
395 : ! other input parameters
396 : call inatm_sw (ncol,nlay, icld, iaer, &
397 : play, plev, tlay, tlev, tsfc, &
398 : h2ovmr, o3vmr, co2vmr, ch4vmr, o2vmr, n2ovmr, adjes, dyofyr, solvar, &
399 : cldfmcl, taucmcl, ssacmcl, asmcmcl, fsfcmcl, ciwpmcl, clwpmcl, &
400 : reicmcl, relqmcl, tauaer, ssaaer, asmaer, &
401 : pavel, pz, pdp, tavel, tz, tbound, coldry, wkl, &
402 : adjflux, zcldfmc, ztaucmc, &
403 : zomgcmc, zasycmc, fsfcmc, ciwpmc, clwpmc, reicmc, dgesmc, relqmc, &
404 2304 : ztaua, zomga, zasya)
405 :
406 : ! Cloud fraction and cloud
407 : ! optical properties are transferred to rrtmg_sw arrays in cldprop.
408 :
409 : call cldprmc_sw(ncol,nlay, inflag, iceflag, liqflag, zcldfmc, &
410 : ciwpmc, clwpmc, reicmc, dgesmc, relqmc, &
411 2304 : ztaormc, ztaucmc, zomgcmc, zasycmc, fsfcmc)
412 2304 : icpr = 1
413 :
414 : ! This is the main longitude/column loop in RRTMG.
415 : ! Modify to loop over all columns (nlon) or over daylight columns
416 :
417 16128 : do iplon = 1, ncol
418 :
419 : ! Calculate coefficients for the temperature and pressure dependence of the
420 : ! molecular absorption coefficients by interpolating data from stored
421 : ! reference atmospheres.
422 :
423 : call setcoef_sw(nlay, pavel(iplon,:), tavel(iplon,:), pz(iplon,:), &
424 13824 : tz(iplon,:), tbound(iplon), coldry(iplon,:), wkl(iplon,:,:), &
425 : laytrop(iplon), layswtch(iplon), laylow(iplon), &
426 : jp(iplon,:), jt(iplon,:), jt1(iplon,:), &
427 : co2mult(iplon,:), colch4(iplon,:), colco2(iplon,:),&
428 : colh2o(iplon,:), colmol(iplon,:), coln2o(iplon,:), &
429 : colo2(iplon,:), colo3(iplon,:), fac00(iplon,:),&
430 : fac01(iplon,:), fac10(iplon,:), fac11(iplon,:), &
431 : selffac(iplon,:), selffrac(iplon,:), indself(iplon,:),&
432 29952 : forfac(iplon,:), forfrac(iplon,:), indfor(iplon,:))
433 : end do
434 :
435 : ! Cosine of the solar zenith angle
436 : ! Prevent using value of zero; ideally, SW model is not called from host model when sun
437 : ! is below horizon
438 :
439 16128 : do iplon = 1, ncol
440 13824 : cossza(iplon) = coszen(iplon)
441 :
442 16128 : if (cossza(iplon) .lt. zepzen) cossza(iplon) = zepzen
443 : end do
444 :
445 : ! Transfer albedo, cloud and aerosol properties into arrays for 2-stream radiative transfer
446 :
447 : ! Surface albedo
448 : ! Near-IR bands 16-24 and 29 (1-9 and 14), 820-16000 cm-1, 0.625-12.195 microns
449 : ! do ib=1,9
450 20736 : do ib=1,8
451 131328 : do iplon = 1, ncol
452 110592 : albdir(iplon,ib) = aldir(iplon)
453 129024 : albdif(iplon,ib) = aldif(iplon)
454 : enddo
455 : enddo
456 :
457 16128 : do iplon = 1, ncol
458 13824 : albdir(iplon,nbndsw) = aldir(iplon)
459 13824 : albdif(iplon,nbndsw) = aldif(iplon)
460 : ! Set band 24 (or, band 9 counting from 1) to use linear average of UV/visible
461 : ! and near-IR values, since this band straddles 0.7 microns:
462 13824 : albdir(iplon,9) = 0.5*(aldir(iplon) + asdir(iplon))
463 16128 : albdif(iplon,9) = 0.5*(aldif(iplon) + asdif(iplon))
464 : enddo
465 :
466 : ! UV/visible bands 25-28 (10-13), 16000-50000 cm-1, 0.200-0.625 micron
467 11520 : do ib=10,13
468 66816 : do iplon = 1, ncol
469 55296 : albdir(iplon,ib) = asdir(iplon)
470 64512 : albdif(iplon,ib) = asdif(iplon)
471 : enddo
472 : enddo
473 :
474 : ! Clouds
475 2304 : if (icld.eq.0) then
476 0 : do iplon = 1, ncol
477 0 : zcldfmc(iplon,1:nlay,1:ngptsw) = 0._r8
478 0 : ztaucmc(iplon,1:nlay,1:ngptsw) = 0._r8
479 0 : ztaormc(iplon,1:nlay,1:ngptsw) = 0._r8
480 0 : zasycmc(iplon,1:nlay,1:ngptsw) = 0._r8
481 0 : zomgcmc(iplon,1:nlay,1:ngptsw) = 1._r8
482 : enddo
483 : endif
484 :
485 : ! Aerosol
486 : ! IAER = 0: no aerosols
487 : if (iaer.eq.0) then
488 : do iplon = 1, ncol
489 : ztaua(iplon,:,:) = 0._r8
490 : zasya(iplon,:,:) = 0._r8
491 : zomga(iplon,:,:) = 1._r8
492 : enddo
493 : endif
494 :
495 : ! Call the 2-stream radiation transfer model
496 :
497 : call spcvmc_sw &
498 : (lchnk, ncol, nlay, istart, iend, icpr, idelm, iout, &
499 : pavel, tavel, pz, tz, tbound, albdif, albdir, &
500 : zcldfmc, ztaucmc, zasycmc, zomgcmc, ztaormc, &
501 : ztaua, zasya, zomga, cossza, coldry, wkl, adjflux, &
502 : laytrop, layswtch, laylow, jp, jt, jt1, &
503 : co2mult, colch4, colco2, colh2o, colmol, coln2o, colo2, colo3, &
504 : fac00, fac01, fac10, fac11, &
505 : selffac, selffrac, indself, forfac, forfrac, indfor, &
506 : swdflx, swuflx, swdflxc, swuflxc, zuvfd, zuvcd, znifd, znicd, znifu, znicu, &
507 2304 : zbbfddir, zbbcddir, dirdnuv, zuvcddir, dirdnir, znicddir, swuflxs, swdflxs)
508 :
509 : ! Transfer up and down, clear and total sky fluxes to output arrays.
510 : ! Vertical indexing goes from bottom to top
511 :
512 147456 : do i = 1, nlay+1
513 145152 : uvdflx(i) = zuvfd(ncol,i)
514 145152 : nidflx(i) = znifd(ncol,i)
515 :
516 1018368 : do iplon = 1, ncol
517 : ! Direct/diffuse fluxes
518 870912 : dirdflux(i) = zbbfddir(iplon,i)
519 870912 : difdflux(i) = swdflx(iplon,i) - dirdflux(i)
520 : ! UV/visible direct/diffuse fluxes
521 870912 : difdnuv(iplon,i) = zuvfd(iplon,i) - dirdnuv(iplon,i)
522 : ! Near-IR direct/diffuse fluxes
523 870912 : difdnir(iplon,i) = znifd(iplon,i) - dirdnir(iplon,i)
524 : ! Added for net near-IR diagnostic
525 870912 : ninflx(iplon,i) = znifd(iplon,i) - znifu(iplon,i)
526 1016064 : ninflxc(iplon,i) = znicd(iplon,i) - znicu(iplon,i)
527 : end do
528 : end do
529 :
530 16128 : do iplon = 1, ncol
531 : ! Total and clear sky net fluxes
532 884736 : do i = 1, nlay+1
533 870912 : swnflxc(i) = swdflxc(iplon,i) - swuflxc(iplon,i)
534 884736 : swnflx(i) = swdflx(iplon,i) - swuflx(iplon,i)
535 : end do
536 :
537 : ! Total and clear sky heating rates
538 : ! Heating units are in K/d. Flux units are in W/m2.
539 870912 : do i = 1, nlay
540 857088 : zdpgcp = heatfac / pdp(iplon,i)
541 857088 : swhrc(iplon,i) = (swnflxc(i+1) - swnflxc(i)) * zdpgcp
542 870912 : swhr(iplon,i) = (swnflx(i+1) - swnflx(i)) * zdpgcp
543 : end do
544 13824 : swhrc(iplon,nlay) = 0._r8
545 16128 : swhr(iplon,nlay) = 0._r8
546 :
547 : end do
548 :
549 2304 : end subroutine rrtmg_sw
550 :
551 : !=========================================================================================
552 :
553 0 : real(kind=r8) function earth_sun(idn)
554 :
555 : ! Purpose: Function to calculate the correction factor of Earth's orbit
556 : ! for current day of the year
557 :
558 : ! idn : Day of the year
559 : ! earth_sun : square of the ratio of mean to actual Earth-Sun distance
560 :
561 : ! ------- Modules -------
562 :
563 : use rrsw_con, only : pi
564 :
565 : integer, intent(in) :: idn
566 :
567 : real(kind=r8) :: gamma
568 :
569 0 : gamma = 2._r8*pi*(idn-1)/365._r8
570 :
571 : ! Use Iqbal's equation 1.2.1
572 :
573 : earth_sun = 1.000110_r8 + .034221_r8 * cos(gamma) + .001289_r8 * sin(gamma) + &
574 0 : .000719_r8 * cos(2._r8*gamma) + .000077_r8 * sin(2._r8*gamma)
575 :
576 0 : end function earth_sun
577 :
578 : !=========================================================================================
579 :
580 2304 : subroutine inatm_sw (ncol, nlay, icld, iaer, &
581 13824 : play, plev, tlay, tlev, tsfc, &
582 2304 : h2ovmr, o3vmr, co2vmr, ch4vmr, o2vmr, n2ovmr, adjes, dyofyr, solvar, &
583 18432 : cldfmcl, taucmcl, ssacmcl, asmcmcl, fsfcmcl, ciwpmcl, clwpmcl, &
584 16128 : reicmcl, relqmcl, tauaer, ssaaer, asmaer, &
585 2304 : pavel, pz, pdp, tavel, tz, tbound, coldry, wkl, &
586 4608 : adjflux, zcldfmc, ztaucmc, &
587 2304 : zssacmc, zasmcmc, fsfcmc, ciwpmc, clwpmc, reicmc, dgesmc, relqmc, &
588 2304 : taua, ssaa, asma)
589 :
590 : ! Input atmospheric profile from GCM, and prepare it for use in RRTMG_SW.
591 : ! Set other RRTMG_SW input parameters.
592 :
593 : use parrrsw, only: nbndsw, ngptsw, nmol, mxmol, &
594 : jpband, jpb1, jpb2
595 : use rrsw_con, only: grav, avogad
596 :
597 : ! ----- Input -----
598 : integer, intent(in) :: ncol ! column end index
599 : integer, intent(in) :: nlay ! number of model layers
600 : integer, intent(in) :: icld ! clear/cloud and cloud overlap flag
601 : integer, intent(in) :: iaer ! aerosol option flag
602 :
603 : real(kind=r8), intent(in) :: play(:,:) ! Layer pressures (hPa, mb)
604 : ! Dimensions: (ncol,nlay)
605 : real(kind=r8), intent(in) :: plev(:,:) ! Interface pressures (hPa, mb)
606 : ! Dimensions: (ncol,nlay+1)
607 : real(kind=r8), intent(in) :: tlay(:,:) ! Layer temperatures (K)
608 : ! Dimensions: (ncol,nlay)
609 : real(kind=r8), intent(in) :: tlev(:,:) ! Interface temperatures (K)
610 : ! Dimensions: (ncol,nlay+1)
611 : real(kind=r8), intent(in) :: tsfc(:) ! Surface temperature (K)
612 : ! Dimensions: (ncol)
613 : real(kind=r8), intent(in) :: h2ovmr(:,:) ! H2O volume mixing ratio
614 : ! Dimensions: (ncol,nlay)
615 : real(kind=r8), intent(in) :: o3vmr(:,:) ! O3 volume mixing ratio
616 : ! Dimensions: (ncol,nlay)
617 : real(kind=r8), intent(in) :: co2vmr(:,:) ! CO2 volume mixing ratio
618 : ! Dimensions: (ncol,nlay)
619 : real(kind=r8), intent(in) :: ch4vmr(:,:) ! Methane volume mixing ratio
620 : ! Dimensions: (ncol,nlay)
621 : real(kind=r8), intent(in) :: o2vmr(:,:) ! O2 volume mixing ratio
622 : ! Dimensions: (ncol,nlay)
623 : real(kind=r8), intent(in) :: n2ovmr(:,:) ! Nitrous oxide volume mixing ratio
624 : ! Dimensions: (ncol,nlay)
625 :
626 : integer, intent(in) :: dyofyr ! Day of the year (used to get Earth/Sun
627 : ! distance if adjflx not provided)
628 : real(kind=r8), intent(in) :: adjes ! Flux adjustment for Earth/Sun distance
629 : real(kind=r8), intent(in) :: solvar(jpb1:jpb2) ! Solar constant (Wm-2) scaling per band
630 :
631 : real(kind=r8), intent(in) :: cldfmcl(:,:,:) ! Cloud fraction
632 : ! Dimensions: (ngptsw,ncol,nlay)
633 : real(kind=r8), intent(in) :: taucmcl(:,:,:) ! Cloud optical depth (optional)
634 : ! Dimensions: (ngptsw,ncol,nlay)
635 : real(kind=r8), intent(in) :: ssacmcl(:,:,:) ! Cloud single scattering albedo
636 : ! Dimensions: (ngptsw,ncol,nlay)
637 : real(kind=r8), intent(in) :: asmcmcl(:,:,:) ! Cloud asymmetry parameter
638 : ! Dimensions: (ngptsw,ncol,nlay)
639 : real(kind=r8), intent(in) :: fsfcmcl(:,:,:) ! Cloud forward scattering fraction
640 : ! Dimensions: (ngptsw,ncol,nlay)
641 : real(kind=r8), intent(in) :: ciwpmcl(:,:,:) ! Cloud ice water path (g/m2)
642 : ! Dimensions: (ngptsw,ncol,nlay)
643 : real(kind=r8), intent(in) :: clwpmcl(:,:,:) ! Cloud liquid water path (g/m2)
644 : ! Dimensions: (ngptsw,ncol,nlay)
645 : real(kind=r8), intent(in) :: reicmcl(:,:) ! Cloud ice effective radius (microns)
646 : ! Dimensions: (ncol,nlay)
647 : real(kind=r8), intent(in) :: relqmcl(:,:) ! Cloud water drop effective radius (microns)
648 : ! Dimensions: (ncol,nlay)
649 :
650 : real(kind=r8), intent(in) :: tauaer(:,:,:) ! Aerosol optical depth
651 : ! Dimensions: (ncol,nlay,nbndsw)
652 : real(kind=r8), intent(in) :: ssaaer(:,:,:) ! Aerosol single scattering albedo
653 : ! Dimensions: (ncol,nlay,nbndsw)
654 : real(kind=r8), intent(in) :: asmaer(:,:,:) ! Aerosol asymmetry parameter
655 : ! Dimensions: (ncol,nlay,nbndsw)
656 :
657 : ! Atmosphere
658 :
659 : real(kind=r8), intent(out) :: pavel(ncol,nlay) ! layer pressures (mb)
660 : ! Dimensions: (ncol,nlay)
661 : real(kind=r8), intent(out) :: tavel(ncol,nlay) ! layer temperatures (K)
662 : ! Dimensions: (ncol,nlay)
663 : real(kind=r8), intent(out) :: pz(ncol,0:nlay) ! level (interface) pressures (hPa, mb)
664 : ! Dimensions: (ncol,0:nlay)
665 : real(kind=r8), intent(out) :: tz(ncol,0:nlay) ! level (interface) temperatures (K)
666 : ! Dimensions: (ncol,0:nlay)
667 : real(kind=r8), intent(out) :: tbound(ncol) ! surface temperature (K)
668 : ! Dimensions: (ncol)
669 : real(kind=r8), intent(out) :: pdp(ncol,nlay) ! layer pressure thickness (hPa, mb)
670 : ! Dimensions: (ncol,nlay)
671 : real(kind=r8), intent(out) :: coldry(ncol,nlay) ! dry air column density (mol/cm2)
672 : ! Dimensions: (ncol,nlay)
673 : real(kind=r8), intent(out) :: wkl(ncol,mxmol,nlay) ! molecular amounts (mol/cm-2)
674 : ! Dimensions: (ncol,mxmol,nlay)
675 :
676 : real(kind=r8), intent(out) :: adjflux(ncol,jpband) ! adjustment for current Earth/Sun distance
677 : ! Dimensions: (ncol,jpband)
678 : real(kind=r8), intent(out) :: taua(ncol,nlay,nbndsw) ! Aerosol optical depth
679 : ! Dimensions: (ncol,nlay,nbndsw)
680 : real(kind=r8), intent(out) :: ssaa(ncol,nlay,nbndsw) ! Aerosol single scattering albedo
681 : ! Dimensions: (ncol,nlay,nbndsw)
682 : real(kind=r8), intent(out) :: asma(ncol,nlay,nbndsw) ! Aerosol asymmetry parameter
683 : ! Dimensions: (ncol,nlay,nbndsw)
684 :
685 : ! Atmosphere/clouds - cldprop
686 :
687 : real(kind=r8), intent(out) :: zcldfmc(ncol,nlay,ngptsw) ! layer cloud fraction
688 : ! Dimensions: (ncol,nlay,ngptsw)
689 : real(kind=r8), intent(out) :: ztaucmc(ncol,nlay,ngptsw) ! cloud optical depth (non-delta scaled)
690 : ! Dimensions: (ncol,nlay,ngptsw)
691 : real(kind=r8), intent(out) :: zssacmc(ncol,nlay,ngptsw) ! cloud single scattering albedo (non-delta-scaled)
692 : ! Dimensions: (ncol,nlay,ngptsw)
693 : real(kind=r8), intent(out) :: zasmcmc(ncol,nlay,ngptsw) ! cloud asymmetry parameter (non-delta scaled)
694 : real(kind=r8), intent(out) :: fsfcmc(ncol,ngptsw,nlay) ! cloud forward scattering fraction (non-delta scaled)
695 : ! Dimensions: (ncol,ngptsw,nlay)
696 : real(kind=r8), intent(out) :: ciwpmc(ncol,ngptsw,nlay) ! cloud ice water path
697 : ! Dimensions: (ncol,ngptsw,nlay)
698 : real(kind=r8), intent(out) :: clwpmc(ncol,ngptsw,nlay) ! cloud liquid water path
699 : ! Dimensions: (ncol,ngptsw,nlay)
700 : real(kind=r8), intent(out) :: reicmc(ncol,nlay) ! cloud ice particle effective radius
701 : ! Dimensions: (ncol,nlay)
702 : real(kind=r8), intent(out) :: dgesmc(ncol,nlay) ! cloud ice particle effective radius
703 : ! Dimensions: (ncol,nlay)
704 : real(kind=r8), intent(out) :: relqmc(ncol,nlay) ! cloud liquid particle size
705 : ! Dimensions: (ncol,nlay)
706 :
707 : ! ----- Local -----
708 : real(kind=r8), parameter :: amd = 28.9660_r8 ! Effective molecular weight of dry air (g/mol)
709 : real(kind=r8), parameter :: amw = 18.0160_r8 ! Molecular weight of water vapor (g/mol)
710 :
711 : ! Set molecular weight ratios (for converting mmr to vmr)
712 : ! e.g. h2ovmr = h2ommr * amdw)
713 : real(kind=r8), parameter :: amdw = 1.607793_r8 ! Molecular weight of dry air / water vapor
714 : real(kind=r8), parameter :: amdc = 0.658114_r8 ! Molecular weight of dry air / carbon dioxide
715 : real(kind=r8), parameter :: amdo = 0.603428_r8 ! Molecular weight of dry air / ozone
716 : real(kind=r8), parameter :: amdm = 1.805423_r8 ! Molecular weight of dry air / methane
717 : real(kind=r8), parameter :: amdn = 0.658090_r8 ! Molecular weight of dry air / nitrous oxide
718 :
719 : real(kind=r8), parameter :: sbc = 5.67e-08_r8 ! Stefan-Boltzmann constant (W/m2K4)
720 :
721 : integer :: isp, l, ix, n, imol, ib, ig, iplon ! Loop indices
722 : real(kind=r8) :: amm, summol !
723 : real(kind=r8) :: adjflx ! flux adjustment for Earth/Sun distance
724 : !-----------------------------------------------------------------------------------------
725 :
726 : ! Set flux adjustment for current Earth/Sun distance (two options).
727 : ! 1) Use Earth/Sun distance flux adjustment provided by GCM (input as adjes);
728 2304 : adjflx = adjes
729 :
730 : ! 2) Calculate Earth/Sun distance from DYOFYR, the cumulative day of the year.
731 : ! (Set adjflx to 1. to use constant Earth/Sun distance of 1 AU).
732 2304 : if (dyofyr .gt. 0) then
733 0 : adjflx = earth_sun(dyofyr)
734 : endif
735 :
736 : ! Set incoming solar flux adjustment to include adjustment for
737 : ! current Earth/Sun distance (ADJFLX) and scaling of default internal
738 : ! solar constant (rrsw_scon = 1368.22 Wm-2) by band (SOLVAR). SOLVAR can be set
739 : ! to a single scaling factor as needed, or to a different value in each
740 : ! band, which may be necessary for paleoclimate simulations.
741 :
742 16128 : do iplon = 1 ,ncol
743 417024 : adjflux(iplon,:) = 0._r8
744 : end do
745 :
746 34560 : do ib = jpb1,jpb2
747 228096 : do iplon = 1, ncol
748 225792 : adjflux(iplon,ib) = adjflx * solvar(ib)
749 : end do
750 : end do
751 :
752 16128 : do iplon = 1, ncol
753 : ! Set surface temperature.
754 13824 : tbound(iplon) = tsfc(iplon)
755 :
756 : ! Install input GCM arrays into RRTMG_SW arrays for pressure, temperature,
757 : ! and molecular amounts.
758 : ! Pressures are input in mb, or are converted to mb here.
759 : ! Molecular amounts are input in volume mixing ratio, or are converted from
760 : ! mass mixing ratio (or specific humidity for h2o) to volume mixing ratio
761 : ! here. These are then converted to molecular amount (molec/cm2) below.
762 : ! The dry air column COLDRY (in molec/cm2) is calculated from the level
763 : ! pressures, pz (in mb), based on the hydrostatic equation and includes a
764 : ! correction to account for h2o in the layer. The molecular weight of moist
765 : ! air (amm) is calculated for each layer.
766 : ! Note: In RRTMG, layer indexing goes from bottom to top, and coding below
767 : ! assumes GCM input fields are also bottom to top. Input layer indexing
768 : ! from GCM fields should be reversed here if necessary.
769 13824 : pz(iplon,0) = plev(iplon,nlay+1)
770 16128 : tz(iplon,0) = tlev(iplon,nlay+1)
771 : end do
772 :
773 145152 : do l = 1, nlay
774 1002240 : do iplon = 1, ncol
775 857088 : pavel(iplon,l) = play(iplon,nlay-l+1)
776 857088 : tavel(iplon,l) = tlay(iplon,nlay-l+1)
777 857088 : pz(iplon,l) = plev(iplon,nlay-l+1)
778 857088 : tz(iplon,l) = tlev(iplon,nlay-l+1)
779 999936 : pdp(iplon,l) = pz(iplon,l-1) - pz(iplon,l)
780 : end do
781 : end do
782 :
783 16128 : do iplon = 1, ncol
784 870912 : do l = 1, nlay
785 :
786 : ! For h2o input in vmr:
787 857088 : wkl(iplon,1,l) = h2ovmr(iplon,nlay-l+1)
788 857088 : wkl(iplon,2,l) = co2vmr(iplon,nlay-l+1)
789 857088 : wkl(iplon,3,l) = o3vmr(iplon,nlay-l+1)
790 857088 : wkl(iplon,4,l) = n2ovmr(iplon,nlay-l+1)
791 857088 : wkl(iplon,5,l) = 0._r8
792 857088 : wkl(iplon,6,l) = ch4vmr(iplon,nlay-l+1)
793 857088 : wkl(iplon,7,l) = o2vmr(iplon,nlay-l+1)
794 857088 : amm = (1._r8 - wkl(iplon,1,l)) * amd + wkl(iplon,1,l) * amw
795 857088 : coldry(iplon,l) = (pz(iplon,l-1)-pz(iplon,l)) * 1.e3_r8 * avogad / &
796 1728000 : (1.e2_r8 * grav * amm * (1._r8 + wkl(iplon,1,l)))
797 : end do
798 :
799 41472 : coldry(iplon,nlay) = (pz(iplon,nlay-1)) * 1.e3_r8 * avogad / &
800 41472 : (1.e2_r8 * grav * amm * (1._r8 + wkl(iplon,1,nlay-1)))
801 :
802 : ! At this point all molecular amounts in wkl are in volume mixing ratio;
803 : ! convert to molec/cm2 based on coldry for use in rrtm.
804 :
805 873216 : do l = 1, nlay
806 6870528 : do imol = 1, nmol
807 6856704 : wkl(iplon,imol,l) = coldry(iplon,l) * wkl(iplon,imol,l)
808 : end do
809 : end do
810 : end do
811 :
812 : ! Transfer aerosol optical properties to RRTM variables;
813 : ! modify to reverse layer indexing here if necessary.
814 :
815 2304 : if (iaer .ge. 1) then
816 142848 : do l = 1, nlay-1
817 2110464 : do ib = 1, nbndsw
818 13913856 : do iplon = 1, ncol
819 11805696 : taua(iplon,l,ib) = tauaer(iplon,nlay-l,ib)
820 11805696 : ssaa(iplon,l,ib) = ssaaer(iplon,nlay-l,ib)
821 13773312 : asma(iplon,l,ib) = asmaer(iplon,nlay-l,ib)
822 : end do
823 : end do
824 : end do
825 : end if
826 :
827 : ! Transfer cloud fraction and cloud optical properties to RRTM variables;
828 : ! modify to reverse layer indexing here if necessary.
829 :
830 2304 : if (icld .ge. 1) then
831 : ! Move incoming GCM cloud arrays to RRTMG cloud arrays.
832 : ! For GCM input, incoming reice is in effective radius; for Fu parameterization (iceflag = 3)
833 : ! convert effective radius to generalized effective size using method of Mitchell, JAS, 2002:
834 :
835 142848 : do l = 1, nlay-1
836 :
837 15881472 : do ig = 1, ngptsw
838 110327040 : do iplon = 1, ncol
839 94445568 : zcldfmc(iplon,l,ig) = cldfmcl(ig,iplon,nlay-l)
840 94445568 : ztaucmc(iplon,l,ig) = taucmcl(ig,iplon,nlay-l)
841 94445568 : zssacmc(iplon,l,ig) = ssacmcl(ig,iplon,nlay-l)
842 94445568 : zasmcmc(iplon,l,ig) = asmcmcl(ig,iplon,nlay-l)
843 :
844 94445568 : fsfcmc(iplon,ig,l) = fsfcmcl(ig,iplon,nlay-l)
845 94445568 : ciwpmc(iplon,ig,l) = ciwpmcl(ig,iplon,nlay-l)
846 110186496 : clwpmc(iplon,ig,l) = clwpmcl(ig,iplon,nlay-l)
847 : end do
848 : end do
849 :
850 986112 : do iplon = 1, ncol
851 843264 : reicmc(iplon,l) = reicmcl(iplon,nlay-l)
852 : if (iceflag .eq. 3) then
853 : dgesmc(iplon,l) = 1.5396_r8 * reicmcl(iplon,nlay-l)
854 : end if
855 983808 : relqmc(iplon,l) = relqmcl(iplon,nlay-l)
856 : end do
857 : end do
858 :
859 : ! If an extra layer is being used in RRTMG, set all cloud properties to zero
860 : ! in the extra layer.
861 16128 : do iplon = 1, ncol
862 1562112 : zcldfmc(iplon,nlay,:) = 0.0_r8
863 1562112 : ztaucmc(iplon,nlay,:) = 0.0_r8
864 1562112 : zssacmc(iplon,nlay,:) = 1.0_r8
865 1562112 : zasmcmc(iplon,nlay,:) = 0.0_r8
866 1562112 : fsfcmc(iplon,:,nlay) = 0.0_r8
867 1562112 : ciwpmc(iplon,:,nlay) = 0.0_r8
868 1562112 : clwpmc(iplon,:,nlay) = 0.0_r8
869 13824 : reicmc(iplon,nlay) = 0.0_r8
870 13824 : dgesmc(iplon,nlay) = 0.0_r8
871 13824 : relqmc(iplon,nlay) = 0.0_r8
872 207360 : taua(iplon,nlay,:) = 0.0_r8
873 207360 : ssaa(iplon,nlay,:) = 1.0_r8
874 209664 : asma(iplon,nlay,:) = 0.0_r8
875 : end do
876 : end if
877 :
878 2304 : end subroutine inatm_sw
879 :
880 : end module rrtmg_sw_rad
881 :
882 :
|
