Home

Context Navigation

rrtmg_sw_rad.nomcica.f90 @ 3775

Last change on this file since 3775 was 3272, checked in by suehring, 6 years ago
Merge with branch radition - improved representation of diffuse radiation
File size: 57.3 KB

Line
1	! path: $Source$
2	! author: $Author: miacono $
3	! revision: $Revision: 23308 $
4	! created: $Date: 2013-12-27 17:23:51 -0500 (Fri, 27 Dec 2013) $
5	!
6
7	module rrtmg_sw_rad
8
9	! --------------------------------------------------------------------------
10	! \| \|
11	! \| Copyright 2002-2009, 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: emlawer@aer.com *
46	! * email: jdelamer@aer.com *
47	! * email: miacono@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	use parkind, only : im => kind_im, rb => kind_rb
57	use rrsw_vsn
58	use rrtmg_sw_cldprop, only: cldprop_sw
59	! *** Move the required call to rrtmg_sw_ini below and the following
60	! use association to GCM initialization area ***
61	! use rrtmg_sw_init, only: rrtmg_sw_ini
62	use rrtmg_sw_setcoef, only: setcoef_sw
63	use rrtmg_sw_spcvrt, only: spcvrt_sw
64
65	implicit none
66
67	! public interfaces/functions/subroutines
68	public :: rrtmg_sw, inatm_sw, earth_sun
69
70	!------------------------------------------------------------------
71	contains
72	!------------------------------------------------------------------
73
74	!------------------------------------------------------------------
75	! Public subroutines
76	!------------------------------------------------------------------
77
78	subroutine rrtmg_sw &
79	(ncol ,nlay ,icld ,iaer , &
80	play ,plev ,tlay ,tlev , &
81	tsfc ,h2ovmr ,o3vmr ,co2vmr , &
82	ch4vmr ,n2ovmr ,o2vmr ,asdir , &
83	asdif ,aldir ,aldif ,coszen , &
84	adjes ,dyofyr ,scon ,inflgsw , &
85	iceflgsw,liqflgsw,cldfr ,taucld , &
86	ssacld ,asmcld ,fsfcld ,cicewp , &
87	cliqwp ,reice ,reliq ,tauaer , &
88	ssaaer ,asmaer ,ecaer ,swuflx , &
89	swdflx ,swhr ,swuflxc ,swdflxc , &
90	swhrc ,dirdflux,difdflux)
91
92	! ------- Description -------
93
94	! This program is the driver for RRTMG_SW, the AER SW radiation model for
95	! application to GCMs, that has been adapted from RRTM_SW for improved
96	! efficiency and to provide fractional cloudiness and cloud overlap
97	! capability using McICA.
98	!
99	! Note: The call to RRTMG_SW_INI should be moved to the GCM initialization
100	! area, since this has to be called only once.
101	!
102	! This routine
103	! b) calls INATM_SW to read in the atmospheric profile from GCM;
104	! all layering in RRTMG is ordered from surface to toa.
105	! c) calls CLDPROP_SW to set cloud optical depth based on input
106	! cloud properties
107	! d) calls SETCOEF_SW to calculate various quantities needed for
108	! the radiative transfer algorithm
109	! e) calls SPCVRT to call the two-stream model that in turn
110	! calls TAUMOL to calculate gaseous optical depths for each
111	! of the 16 spectral bands and to perform the radiative transfer;
112	! f) passes the calculated fluxes and cooling rates back to GCM
113	!
114	! Two modes of operation are possible:
115	! The mode is chosen by using either rrtmg_sw.nomcica.f90 (to not use
116	! McICA) or rrtmg_sw.f90 (to use McICA) to interface with a GCM.
117	!
118	! 1) Standard, single forward model calculation (imca = 0); this is
119	! valid only for clear sky or fully overcast clouds
120	! 2) Monte Carlo Independent Column Approximation (McICA, Pincus et al.,
121	! JC, 2003) method is applied to the forward model calculation (imca = 1)
122	! This method is valid for clear sky and full or partial cloud conditions.
123	!
124	! Two methods of cloud property input are possible:
125	! Cloud properties can be input in one of two ways (controlled by input
126	! flags inflag, iceflag and liqflag; see text file rrtmg_sw_instructions
127	! and subroutine rrtmg_sw_cldprop.f90 for further details):
128	!
129	! 1) Input cloud fraction, cloud optical depth, single scattering albedo
130	! and asymmetry parameter directly (inflgsw = 0)
131	! 2) Input cloud fraction and cloud physical properties: ice fracion,
132	! ice and liquid particle sizes (inflgsw = 1 or 2);
133	! cloud optical properties are calculated by cldprop or cldprmc based
134	! on input settings of iceflgsw and liqflgsw
135	!
136	! Two methods of aerosol property input are possible:
137	! Aerosol properties can be input in one of two ways (controlled by input
138	! flag iaer, see text file rrtmg_sw_instructions for further details):
139	!
140	! 1) Input aerosol optical depth, single scattering albedo and asymmetry
141	! parameter directly by layer and spectral band (iaer=10)
142	! 2) Input aerosol optical depth and 0.55 micron directly by layer and use
143	! one or more of six ECMWF aerosol types (iaer=6)
144	!
145	!
146	! ------- Modifications -------
147	!
148	! This version of RRTMG_SW has been modified from RRTM_SW to use a reduced
149	! set of g-point intervals and a two-stream model for application to GCMs.
150	!
151	!-- Original version (derived from RRTM_SW)
152	! 2002: AER. Inc.
153	!-- Conversion to F90 formatting; addition of 2-stream radiative transfer
154	! Feb 2003: J.-J. Morcrette, ECMWF
155	!-- Additional modifications for GCM application
156	! Aug 2003: M. J. Iacono, AER Inc.
157	!-- Total number of g-points reduced from 224 to 112. Original
158	! set of 224 can be restored by exchanging code in module parrrsw.f90
159	! and in file rrtmg_sw_init.f90.
160	! Apr 2004: M. J. Iacono, AER, Inc.
161	!-- Modifications to include output for direct and diffuse
162	! downward fluxes. There are output as "true" fluxes without
163	! any delta scaling applied. Code can be commented to exclude
164	! this calculation in source file rrtmg_sw_spcvrt.f90.
165	! Jan 2005: E. J. Mlawer, M. J. Iacono, AER, Inc.
166	!-- Reformatted for consistency with rrtmg_lw.
167	! Feb 2007: M. J. Iacono, AER, Inc.
168	!-- Modifications to formatting to use assumed-shape arrays.
169	! Aug 2007: M. J. Iacono, AER, Inc.
170	!-- Modified to output direct and diffuse fluxes either with or without
171	! delta scaling based on setting of idelm flag.
172	! Dec 2008: M. J. Iacono, AER, Inc.
173	!-- Added the output direct and diffuse fluxes to the argument of rrtmg_sw
174	! Aug 2018: M. Salim, Humboldt Uni, Berlin, Germany
175
176	! --------- Modules ---------
177
178	use parrrsw, only : nbndsw, ngptsw, naerec, nstr, nmol, mxmol, &
179	jpband, jpb1, jpb2
180	use rrsw_aer, only : rsrtaua, rsrpiza, rsrasya
181	use rrsw_con, only : heatfac, oneminus, pi
182	use rrsw_wvn, only : wavenum1, wavenum2
183
184	! ------- Declarations
185
186	! ----- Input -----
187	! Note: All volume mixing ratios are in dimensionless units of mole fraction obtained
188	! by scaling mass mixing ratio (g/g) with the appropriate molecular weights (g/mol)
189	integer(kind=im), intent(in) :: ncol ! Number of horizontal columns
190	integer(kind=im), intent(in) :: nlay ! Number of model layers
191	integer(kind=im), intent(inout) :: icld ! Cloud overlap method
192	! 0: Clear only
193	! 1: Random
194	! 2: Maximum/random
195	! 3: Maximum
196	integer(kind=im), intent(inout) :: iaer ! Aerosol option flag
197	! 0: No aerosol
198	! 6: ECMWF method
199	! 10:Input aerosol optical
200	! properties
201
202	real(kind=rb), intent(in) :: play(:,:) ! Layer pressures (hPa, mb)
203	! Dimensions: (ncol,nlay)
204	real(kind=rb), intent(in) :: plev(:,:) ! Interface pressures (hPa, mb)
205	! Dimensions: (ncol,nlay+1)
206	real(kind=rb), intent(in) :: tlay(:,:) ! Layer temperatures (K)
207	! Dimensions: (ncol,nlay)
208	real(kind=rb), intent(in) :: tlev(:,:) ! Interface temperatures (K)
209	! Dimensions: (ncol,nlay+1)
210	real(kind=rb), intent(in) :: tsfc(:) ! Surface temperature (K)
211	! Dimensions: (ncol)
212	real(kind=rb), intent(in) :: h2ovmr(:,:) ! H2O volume mixing ratio
213	! Dimensions: (ncol,nlay)
214	real(kind=rb), intent(in) :: o3vmr(:,:) ! O3 volume mixing ratio
215	! Dimensions: (ncol,nlay)
216	real(kind=rb), intent(in) :: co2vmr(:,:) ! CO2 volume mixing ratio
217	! Dimensions: (ncol,nlay)
218	real(kind=rb), intent(in) :: ch4vmr(:,:) ! Methane volume mixing ratio
219	! Dimensions: (ncol,nlay)
220	real(kind=rb), intent(in) :: n2ovmr(:,:) ! Nitrous oxide volume mixing ratio
221	! Dimensions: (ncol,nlay)
222	real(kind=rb), intent(in) :: o2vmr(:,:) ! Oxygen volume mixing ratio
223	! Dimensions: (ncol,nlay)
224	real(kind=rb), intent(in) :: asdir(:) ! UV/vis surface albedo direct rad
225	! Dimensions: (ncol)
226	real(kind=rb), intent(in) :: aldir(:) ! Near-IR surface albedo direct rad
227	! Dimensions: (ncol)
228	real(kind=rb), intent(in) :: asdif(:) ! UV/vis surface albedo: diffuse rad
229	! Dimensions: (ncol)
230	real(kind=rb), intent(in) :: aldif(:) ! Near-IR surface albedo: diffuse rad
231	! Dimensions: (ncol)
232
233	integer(kind=im), intent(in) :: dyofyr ! Day of the year (used to get Earth/Sun
234	! distance if adjflx not provided)
235	real(kind=rb), intent(in) :: adjes ! Flux adjustment for Earth/Sun distance
236	real(kind=rb), intent(in) :: coszen(:) ! Cosine of solar zenith angle
237	! Dimensions: (ncol)
238	real(kind=rb), intent(in) :: scon ! Solar constant (W/m2)
239
240	integer(kind=im), intent(in) :: inflgsw ! Flag for cloud optical properties
241	integer(kind=im), intent(in) :: iceflgsw ! Flag for ice particle specification
242	integer(kind=im), intent(in) :: liqflgsw ! Flag for liquid droplet specification
243
244	real(kind=rb), intent(in) :: cldfr(:,:) ! Cloud fraction
245	! Dimensions: (ncol,nlay)
246	real(kind=rb), intent(in) :: taucld(:,:,:) ! In-cloud optical depth
247	! Dimensions: (nbndsw,ncol,nlay)
248	real(kind=rb), intent(in) :: ssacld(:,:,:) ! In-cloud single scattering albedo
249	! Dimensions: (nbndsw,ncol,nlay)
250	real(kind=rb), intent(in) :: asmcld(:,:,:) ! In-cloud asymmetry parameter
251	! Dimensions: (nbndsw,ncol,nlay)
252	real(kind=rb), intent(in) :: fsfcld(:,:,:) ! In-cloud forward scattering fraction
253	! Dimensions: (nbndsw,ncol,nlay)
254	real(kind=rb), intent(in) :: cicewp(:,:) ! In-cloud ice water path (g/m2)
255	! Dimensions: (ncol,nlay)
256	real(kind=rb), intent(in) :: cliqwp(:,:) ! In-cloud liquid water path (g/m2)
257	! Dimensions: (ncol,nlay)
258	real(kind=rb), intent(in) :: reice(:,:) ! Cloud ice effective radius (microns)
259	! Dimensions: (ncol,nlay)
260	! specific definition of reice depends on setting of iceflgsw:
261	! iceflgsw = 0: (inactive)
262	!
263	! iceflgsw = 1: ice effective radius, r_ec, (Ebert and Curry, 1992),
264	! r_ec range is limited to 13.0 to 130.0 microns
265	! iceflgsw = 2: ice effective radius, r_k, (Key, Streamer Ref. Manual, 1996)
266	! r_k range is limited to 5.0 to 131.0 microns
267	! iceflgsw = 3: generalized effective size, dge, (Fu, 1996),
268	! dge range is limited to 5.0 to 140.0 microns
269	! [dge = 1.0315 * r_ec]
270	real(kind=rb), intent(in) :: reliq(:,:) ! Cloud water drop effective radius (microns)
271	! Dimensions: (ncol,nlay)
272	real(kind=rb), intent(in) :: tauaer(:,:,:) ! Aerosol optical depth (iaer=10 only)
273	! Dimensions: (ncol,nlay,nbndsw)
274	! (non-delta scaled)
275	real(kind=rb), intent(in) :: ssaaer(:,:,:) ! Aerosol single scattering albedo (iaer=10 only)
276	! Dimensions: (ncol,nlay,nbndsw)
277	! (non-delta scaled)
278	real(kind=rb), intent(in) :: asmaer(:,:,:) ! Aerosol asymmetry parameter (iaer=10 only)
279	! Dimensions: (ncol,nlay,nbndsw)
280	! (non-delta scaled)
281	real(kind=rb), intent(in) :: ecaer(:,:,:) ! Aerosol optical depth at 0.55 micron (iaer=6 only)
282	! Dimensions: (ncol,nlay,naerec)
283	! (non-delta scaled)
284
285	! ----- Output -----
286
287	real(kind=rb), intent(out) :: swuflx(:,:) ! Total sky shortwave upward flux (W/m2)
288	! Dimensions: (ncol,nlay+1)
289	real(kind=rb), intent(out) :: swdflx(:,:) ! Total sky shortwave downward flux (W/m2)
290	! Dimensions: (ncol,nlay+1)
291	real(kind=rb), intent(out) :: swhr(:,:) ! Total sky shortwave radiative heating rate (K/d)
292	! Dimensions: (ncol,nlay)
293	real(kind=rb), intent(out) :: swuflxc(:,:) ! Clear sky shortwave upward flux (W/m2)
294	! Dimensions: (ncol,nlay+1)
295	real(kind=rb), intent(out) :: swdflxc(:,:) ! Clear sky shortwave downward flux (W/m2)
296	! Dimensions: (ncol,nlay+1)
297	real(kind=rb), intent(out) :: swhrc(:,:) ! Clear sky shortwave radiative heating rate (K/d)
298	! Dimensions: (ncol,nlay)
299
300	! ----- Local -----
301
302	! Control
303	integer(kind=im) :: nlayers ! total number of layers
304	integer(kind=im) :: istart ! beginning band of calculation
305	integer(kind=im) :: iend ! ending band of calculation
306	integer(kind=im) :: icpr ! cldprop/cldprmc use flag
307	integer(kind=im) :: iout ! output option flag
308	integer(kind=im) :: idelm ! delta-m scaling flag
309	! [0 = direct and diffuse fluxes are unscaled]
310	! [1 = direct and diffuse fluxes are scaled]
311	! (total downward fluxes are always delta scaled)
312	integer(kind=im) :: isccos ! instrumental cosine response flag (inactive)
313	integer(kind=im) :: iplon ! column loop index
314	integer(kind=im) :: i ! layer loop index ! jk
315	integer(kind=im) :: ib ! band loop index ! jsw
316	integer(kind=im) :: ia, ig ! indices
317	integer(kind=im) :: k ! layer loop index
318	integer(kind=im) :: ims ! value for changing mcica permute seed
319	integer(kind=im) :: imca ! flag for mcica [0=off, 1=on]
320
321	real(kind=rb) :: zepsec, zepzen ! epsilon
322	real(kind=rb) :: zdpgcp ! flux to heating conversion ratio
323
324	! Atmosphere
325	real(kind=rb) :: pavel(nlay+1) ! layer pressures (mb)
326	real(kind=rb) :: tavel(nlay+1) ! layer temperatures (K)
327	real(kind=rb) :: pz(0:nlay+1) ! level (interface) pressures (hPa, mb)
328	real(kind=rb) :: tz(0:nlay+1) ! level (interface) temperatures (K)
329	real(kind=rb) :: tbound ! surface temperature (K)
330	real(kind=rb) :: pdp(nlay+1) ! layer pressure thickness (hPa, mb)
331	real(kind=rb) :: coldry(nlay+1) ! dry air column amount
332	real(kind=rb) :: wkl(mxmol,nlay+1) ! molecular amounts (mol/cm-2)
333
334	! real(kind=rb) :: earth_sun ! function for Earth/Sun distance factor
335	real(kind=rb) :: cossza ! Cosine of solar zenith angle
336	real(kind=rb) :: adjflux(jpband) ! adjustment for current Earth/Sun distance
337	real(kind=rb) :: solvar(jpband) ! solar constant scaling factor from rrtmg_sw
338	! default value of 1368.22 Wm-2 at 1 AU
339	real(kind=rb) :: albdir(nbndsw) ! surface albedo, direct ! zalbp
340	real(kind=rb) :: albdif(nbndsw) ! surface albedo, diffuse ! zalbd
341
342	real(kind=rb) :: taua(nlay+1,nbndsw) ! Aerosol optical depth
343	real(kind=rb) :: ssaa(nlay+1,nbndsw) ! Aerosol single scattering albedo
344	real(kind=rb) :: asma(nlay+1,nbndsw) ! Aerosol asymmetry parameter
345
346	! Atmosphere - setcoef
347	integer(kind=im) :: laytrop ! tropopause layer index
348	integer(kind=im) :: layswtch ! tropopause layer index
349	integer(kind=im) :: laylow ! tropopause layer index
350	integer(kind=im) :: jp(nlay+1) !
351	integer(kind=im) :: jt(nlay+1) !
352	integer(kind=im) :: jt1(nlay+1) !
353
354	real(kind=rb) :: colh2o(nlay+1) ! column amount (h2o)
355	real(kind=rb) :: colco2(nlay+1) ! column amount (co2)
356	real(kind=rb) :: colo3(nlay+1) ! column amount (o3)
357	real(kind=rb) :: coln2o(nlay+1) ! column amount (n2o)
358	real(kind=rb) :: colch4(nlay+1) ! column amount (ch4)
359	real(kind=rb) :: colo2(nlay+1) ! column amount (o2)
360	real(kind=rb) :: colmol(nlay+1) ! column amount
361	real(kind=rb) :: co2mult(nlay+1) ! column amount
362
363	integer(kind=im) :: indself(nlay+1)
364	integer(kind=im) :: indfor(nlay+1)
365	real(kind=rb) :: selffac(nlay+1)
366	real(kind=rb) :: selffrac(nlay+1)
367	real(kind=rb) :: forfac(nlay+1)
368	real(kind=rb) :: forfrac(nlay+1)
369
370	real(kind=rb) :: & !
371	fac00(nlay+1), fac01(nlay+1), &
372	fac10(nlay+1), fac11(nlay+1)
373
374	! Atmosphere/clouds - cldprop
375	integer(kind=im) :: ncbands ! number of cloud spectral bands
376	integer(kind=im) :: inflag ! flag for cloud property method
377	integer(kind=im) :: iceflag ! flag for ice cloud properties
378	integer(kind=im) :: liqflag ! flag for liquid cloud properties
379
380	real(kind=rb) :: cldfrac(nlay+1) ! layer cloud fraction
381	real(kind=rb) :: tauc(nbndsw,nlay+1) ! in-cloud optical depth (non-delta scaled)
382	real(kind=rb) :: ssac(nbndsw,nlay+1) ! in-cloud single scattering albedo (non-delta scaled)
383	real(kind=rb) :: asmc(nbndsw,nlay+1) ! in-cloud asymmetry parameter (non-delta scaled)
384	real(kind=rb) :: fsfc(nbndsw,nlay+1) ! in-cloud forward scattering fraction (non-delta scaled)
385	real(kind=rb) :: ciwp(nlay+1) ! in-cloud ice water path
386	real(kind=rb) :: clwp(nlay+1) ! in-cloud liquid water path
387	real(kind=rb) :: rel(nlay+1) ! cloud liquid particle effective radius (microns)
388	real(kind=rb) :: rei(nlay+1) ! cloud ice particle effective size (microns)
389
390	real(kind=rb) :: taucloud(nlay+1,jpband) ! in-cloud optical depth
391	real(kind=rb) :: taucldorig(nlay+1,jpband)! in-cloud optical depth (non-delta scaled)
392	real(kind=rb) :: ssacloud(nlay+1,jpband) ! in-cloud single scattering albedo
393	real(kind=rb) :: asmcloud(nlay+1,jpband) ! in-cloud asymmetry parameter
394
395	! Atmosphere/clouds/aerosol - spcvrt,spcvmc
396	real(kind=rb) :: ztauc(nlay+1,nbndsw) ! cloud optical depth
397	real(kind=rb) :: ztaucorig(nlay+1,nbndsw) ! unscaled cloud optical depth
398	real(kind=rb) :: zasyc(nlay+1,nbndsw) ! cloud asymmetry parameter
399	! (first moment of phase function)
400	real(kind=rb) :: zomgc(nlay+1,nbndsw) ! cloud single scattering albedo
401	real(kind=rb) :: ztaua(nlay+1,nbndsw) ! total aerosol optical depth
402	real(kind=rb) :: zasya(nlay+1,nbndsw) ! total aerosol asymmetry parameter
403	real(kind=rb) :: zomga(nlay+1,nbndsw) ! total aerosol single scattering albedo
404
405	real(kind=rb) :: zbbfu(nlay+2) ! temporary upward shortwave flux (w/m2)
406	real(kind=rb) :: zbbfd(nlay+2) ! temporary downward shortwave flux (w/m2)
407	real(kind=rb) :: zbbcu(nlay+2) ! temporary clear sky upward shortwave flux (w/m2)
408	real(kind=rb) :: zbbcd(nlay+2) ! temporary clear sky downward shortwave flux (w/m2)
409	real(kind=rb) :: zbbfddir(nlay+2) ! temporary downward direct shortwave flux (w/m2)
410	real(kind=rb) :: zbbcddir(nlay+2) ! temporary clear sky downward direct shortwave flux (w/m2)
411	real(kind=rb) :: zuvfd(nlay+2) ! temporary UV downward shortwave flux (w/m2)
412	real(kind=rb) :: zuvcd(nlay+2) ! temporary clear sky UV downward shortwave flux (w/m2)
413	real(kind=rb) :: zuvfddir(nlay+2) ! temporary UV downward direct shortwave flux (w/m2)
414	real(kind=rb) :: zuvcddir(nlay+2) ! temporary clear sky UV downward direct shortwave flux (w/m2)
415	real(kind=rb) :: znifd(nlay+2) ! temporary near-IR downward shortwave flux (w/m2)
416	real(kind=rb) :: znicd(nlay+2) ! temporary clear sky near-IR downward shortwave flux (w/m2)
417	real(kind=rb) :: znifddir(nlay+2) ! temporary near-IR downward direct shortwave flux (w/m2)
418	real(kind=rb) :: znicddir(nlay+2) ! temporary clear sky near-IR downward direct shortwave flux (w/m2)
419
420	! Optional output fields
421	real(kind=rb) :: swnflx(nlay+2) ! Total sky shortwave net flux (W/m2)
422	real(kind=rb) :: swnflxc(nlay+2) ! Clear sky shortwave net flux (W/m2)
423	real(kind=rb), intent(out) :: dirdflux(nlay+2) ! Direct downward shortwave surface flux
424	real(kind=rb), intent(out) :: difdflux(nlay+2) ! Diffuse downward shortwave surface flux
425	real(kind=rb) :: uvdflx(nlay+2) ! Total sky downward shortwave flux, UV/vis
426	real(kind=rb) :: nidflx(nlay+2) ! Total sky downward shortwave flux, near-IR
427	real(kind=rb) :: dirdnuv(nlay+2) ! Direct downward shortwave flux, UV/vis
428	real(kind=rb) :: difdnuv(nlay+2) ! Diffuse downward shortwave flux, UV/vis
429	real(kind=rb) :: dirdnir(nlay+2) ! Direct downward shortwave flux, near-IR
430	real(kind=rb) :: difdnir(nlay+2) ! Diffuse downward shortwave flux, near-IR
431
432	! Output - inactive
433	! real(kind=rb) :: zuvfu(nlay+2) ! temporary upward UV shortwave flux (w/m2)
434	! real(kind=rb) :: zuvfd(nlay+2) ! temporary downward UV shortwave flux (w/m2)
435	! real(kind=rb) :: zuvcu(nlay+2) ! temporary clear sky upward UV shortwave flux (w/m2)
436	! real(kind=rb) :: zuvcd(nlay+2) ! temporary clear sky downward UV shortwave flux (w/m2)
437	! real(kind=rb) :: zvsfu(nlay+2) ! temporary upward visible shortwave flux (w/m2)
438	! real(kind=rb) :: zvsfd(nlay+2) ! temporary downward visible shortwave flux (w/m2)
439	! real(kind=rb) :: zvscu(nlay+2) ! temporary clear sky upward visible shortwave flux (w/m2)
440	! real(kind=rb) :: zvscd(nlay+2) ! temporary clear sky downward visible shortwave flux (w/m2)
441	! real(kind=rb) :: znifu(nlay+2) ! temporary upward near-IR shortwave flux (w/m2)
442	! real(kind=rb) :: znifd(nlay+2) ! temporary downward near-IR shortwave flux (w/m2)
443	! real(kind=rb) :: znicu(nlay+2) ! temporary clear sky upward near-IR shortwave flux (w/m2)
444	! real(kind=rb) :: znicd(nlay+2) ! temporary clear sky downward near-IR shortwave flux (w/m2)
445
446
447	! Initializations
448
449	zepsec = 1.e-06_rb
450	zepzen = 1.e-10_rb
451	oneminus = 1.0_rb - zepsec
452	pi = 2._rb * asin(1._rb)
453
454	istart = jpb1
455	iend = jpb2
456	iout = 0
457	icpr = 0
458
459	! In a GCM with or without McICA, set nlon to the longitude dimension
460	!
461	! Set imca to select calculation type:
462	! imca = 0, use standard forward model calculation (clear and overcast only)
463	! imca = 1, use McICA for Monte Carlo treatment of sub-grid cloud variability
464	! (clear, overcast or partial cloud conditions)
465
466	! * This version does not use McICA (imca = 0) *
467
468	! Set icld to select of clear or cloud calculation and cloud
469	! overlap method (read by subroutine readprof from input file INPUT_RRTM):
470	! Without McICA, SW calculation is limited to clear or fully overcast conditions.
471	! icld = 0, clear only
472	! icld = 1, with clouds using random cloud overlap (McICA only)
473	! icld = 2, with clouds using maximum/random cloud overlap (McICA only)
474	! icld = 3, with clouds using maximum cloud overlap (McICA only)
475	if (icld.lt.0.or.icld.gt.3) icld = 2
476
477	! Set iaer to select aerosol option
478	! iaer = 0, no aerosols
479	! iaer = 6, use six ECMWF aerosol types
480	! input aerosol optical depth at 0.55 microns for each aerosol type (ecaer)
481	! iaer = 10, input total aerosol optical depth, single scattering albedo
482	! and asymmetry parameter (tauaer, ssaaer, asmaer) directly
483	if (iaer.ne.0.and.iaer.ne.6.and.iaer.ne.10) iaer = 0
484
485	! Set idelm to select between delta-M scaled or unscaled output direct and diffuse fluxes
486	! NOTE: total downward fluxes are always delta scaled
487	! idelm = 0, output direct and diffuse flux components are not delta scaled
488	! (direct flux does not include forward scattering peak)
489	! idelm = 1, output direct and diffuse flux components are delta scaled (default)
490	! (direct flux includes part or most of forward scattering peak)
491	idelm = 1
492
493	! Call model and data initialization, compute lookup tables, perform
494	! reduction of g-points from 224 to 112 for input absorption
495	! coefficient data and other arrays.
496	!
497	! In a GCM this call should be placed in the model initialization
498	! area, since this has to be called only once.
499	! call rrtmg_sw_ini(cpdair)
500
501	! This is the main longitude/column loop in RRTMG.
502	! Modify to loop over all columns (nlon) or over daylight columns
503
504	do iplon = 1, ncol
505
506	! Prepare atmosphere profile from GCM for use in RRTMG, and define
507	! other input parameters
508
509	call inatm_sw (iplon, nlay, icld, iaer, &
510	play, plev, tlay, tlev, tsfc, h2ovmr, &
511	o3vmr, co2vmr, ch4vmr, n2ovmr, o2vmr, &
512	adjes, dyofyr, scon, inflgsw, iceflgsw, liqflgsw, &
513	cldfr, taucld, ssacld, asmcld, fsfcld, cicewp, cliqwp, &
514	reice, reliq, tauaer, ssaaer, asmaer, &
515	nlayers, pavel, pz, pdp, tavel, tz, tbound, coldry, wkl, &
516	adjflux, solvar, inflag, iceflag, liqflag, cldfrac, tauc, &
517	ssac, asmc, fsfc, ciwp, clwp, rei, rel, taua, ssaa, asma)
518
519	! For cloudy atmosphere, use cldprop to set cloud optical properties based on
520	! input cloud physical properties. Select method based on choices described
521	! in cldprop. Cloud fraction, water path, liquid droplet and ice particle
522	! effective radius must be passed in cldprop. Cloud fraction and cloud
523	! optical properties are transferred to rrtmg_sw arrays in cldprop.
524
525	! Without McICA, SW calculation is limited to clear or fully overcast conditions.
526	! Stop model if partial cloudiness is present.
527
528	do i = 1, nlayers
529	if (cldfrac(i).gt.zepsec .and. cldfrac(i).lt.oneminus) then
530	stop 'PARTIAL CLOUD NOT ALLOWED'
531	endif
532	enddo
533	call cldprop_sw(nlayers, inflag, iceflag, liqflag, cldfrac, &
534	tauc, ssac, asmc, fsfc, ciwp, clwp, rei, rel, &
535	taucldorig, taucloud, ssacloud, asmcloud)
536	icpr = 1
537
538	! Calculate coefficients for the temperature and pressure dependence of the
539	! molecular absorption coefficients by interpolating data from stored
540	! reference atmospheres.
541
542	call setcoef_sw(nlayers, pavel, tavel, pz, tz, tbound, coldry, wkl, &
543	laytrop, layswtch, laylow, jp, jt, jt1, &
544	co2mult, colch4, colco2, colh2o, colmol, coln2o, &
545	colo2, colo3, fac00, fac01, fac10, fac11, &
546	selffac, selffrac, indself, forfac, forfrac, indfor)
547
548
549	! Cosine of the solar zenith angle
550	! Prevent using value of zero; ideally, SW model is not called from host model when sun
551	! is below horizon
552
553	cossza = coszen(iplon)
554	if (cossza .lt. zepzen) cossza = zepzen
555
556
557	! Transfer albedo, cloud and aerosol properties into arrays for 2-stream radiative transfer
558
559	! Surface albedo
560	! Near-IR bands 16-24 and 29 (1-9 and 14), 820-16000 cm-1, 0.625-12.195 microns
561	do ib=1,9
562	albdir(ib) = aldir(iplon)
563	albdif(ib) = aldif(iplon)
564	enddo
565	albdir(nbndsw) = aldir(iplon)
566	albdif(nbndsw) = aldif(iplon)
567	! UV/visible bands 25-28 (10-13), 16000-50000 cm-1, 0.200-0.625 micron
568	do ib=10,13
569	albdir(ib) = asdir(iplon)
570	albdif(ib) = asdif(iplon)
571	enddo
572
573
574	! Clouds
575	if (icld.eq.0) then
576
577	ztauc(:,:) = 0._rb
578	ztaucorig(:,:) = 0._rb
579	zasyc(:,:) = 0._rb
580	zomgc(:,:) = 1._rb
581
582	elseif (icld.ge.1) then
583	do i=1,nlayers
584	do ib=1,nbndsw
585	ztauc(i,ib) = taucloud(i,jpb1-1+ib)
586	ztaucorig(i,ib) = taucldorig(i,jpb1-1+ib)
587	zasyc(i,ib) = asmcloud(i,jpb1-1+ib)
588	zomgc(i,ib) = ssacloud(i,jpb1-1+ib)
589	enddo
590	enddo
591
592	endif
593
594	! Aerosol
595	! IAER = 0: no aerosols
596	if (iaer.eq.0) then
597
598	ztaua(:,:) = 0._rb
599	zasya(:,:) = 0._rb
600	zomga(:,:) = 1._rb
601
602	! IAER = 6: Use ECMWF six aerosol types. See rrsw_aer.f90 for details.
603	! Input aerosol optical thickness at 0.55 micron for each aerosol type (ecaer),
604	! or set manually here for each aerosol and layer.
605	elseif (iaer.eq.6) then
606
607	! do i = 1, nlayers
608	! do ia = 1, naerec
609	! ecaer(iplon,i,ia) = 1.0e-15_rb
610	! enddo
611	! enddo
612
613	do i = 1, nlayers
614	do ib = 1, nbndsw
615	ztaua(i,ib) = 0._rb
616	zasya(i,ib) = 0._rb
617	zomga(i,ib) = 0._rb
618	do ia = 1, naerec
619	ztaua(i,ib) = ztaua(i,ib) + rsrtaua(ib,ia) * ecaer(iplon,i,ia)
620	zomga(i,ib) = zomga(i,ib) + rsrtaua(ib,ia) * ecaer(iplon,i,ia) * &
621	rsrpiza(ib,ia)
622	zasya(i,ib) = zasya(i,ib) + rsrtaua(ib,ia) * ecaer(iplon,i,ia) * &
623	rsrpiza(ib,ia) * rsrasya(ib,ia)
624	enddo
625	if (ztaua(i,ib) == 0._rb) then
626	ztaua(i,ib) = 0._rb
627	zasya(i,ib) = 0._rb
628	zomga(i,ib) = 1._rb
629	else
630	if (zomga(i,ib) /= 0._rb) then
631	zasya(i,ib) = zasya(i,ib) / zomga(i,ib)
632	endif
633	if (ztaua(i,ib) /= 0._rb) then
634	zomga(i,ib) = zomga(i,ib) / ztaua(i,ib)
635	endif
636	endif
637	enddo
638	enddo
639
640	! IAER=10: Direct specification of aerosol optical properties from GCM
641	elseif (iaer.eq.10) then
642
643	do i = 1 ,nlayers
644	do ib = 1 ,nbndsw
645	ztaua(i,ib) = taua(i,ib)
646	zasya(i,ib) = asma(i,ib)
647	zomga(i,ib) = ssaa(i,ib)
648	enddo
649	enddo
650
651	endif
652
653
654	! Call the 2-stream radiation transfer model
655
656	do i=1,nlayers+1
657	zbbcu(i) = 0._rb
658	zbbcd(i) = 0._rb
659	zbbfu(i) = 0._rb
660	zbbfd(i) = 0._rb
661	zbbcddir(i) = 0._rb
662	zbbfddir(i) = 0._rb
663	zuvcd(i) = 0._rb
664	zuvfd(i) = 0._rb
665	zuvcddir(i) = 0._rb
666	zuvfddir(i) = 0._rb
667	znicd(i) = 0._rb
668	znifd(i) = 0._rb
669	znicddir(i) = 0._rb
670	znifddir(i) = 0._rb
671	enddo
672
673	call spcvrt_sw &
674	(nlayers, istart, iend, icpr, idelm, iout, &
675	pavel, tavel, pz, tz, tbound, albdif, albdir, &
676	cldfrac, ztauc, zasyc, zomgc, ztaucorig, &
677	ztaua, zasya, zomga, cossza, coldry, wkl, adjflux, &
678	laytrop, layswtch, laylow, jp, jt, jt1, &
679	co2mult, colch4, colco2, colh2o, colmol, coln2o, colo2, colo3, &
680	fac00, fac01, fac10, fac11, &
681	selffac, selffrac, indself, forfac, forfrac, indfor, &
682	zbbfd, zbbfu, zbbcd, zbbcu, zuvfd, zuvcd, znifd, znicd, &
683	zbbfddir, zbbcddir, zuvfddir, zuvcddir, znifddir, znicddir)
684
685	! Transfer up and down, clear and total sky fluxes to output arrays.
686	! Vertical indexing goes from bottom to top; reverse here for GCM if necessary.
687
688	do i = 1, nlayers+1
689	swuflxc(iplon,i) = zbbcu(i)
690	swdflxc(iplon,i) = zbbcd(i)
691	swuflx(iplon,i) = zbbfu(i)
692	swdflx(iplon,i) = zbbfd(i)
693	uvdflx(i) = zuvfd(i)
694	nidflx(i) = znifd(i)
695	! Direct/diffuse fluxes
696	dirdflux(i) = zbbfddir(i)
697	difdflux(i) = swdflx(iplon,i) - dirdflux(i)
698	! UV/visible direct/diffuse fluxes
699	dirdnuv(i) = zuvfddir(i)
700	difdnuv(i) = zuvfd(i) - dirdnuv(i)
701	! Near-IR direct/diffuse fluxes
702	dirdnir(i) = znifddir(i)
703	difdnir(i) = znifd(i) - dirdnir(i)
704	enddo
705
706	! Total and clear sky net fluxes
707	do i = 1, nlayers+1
708	swnflxc(i) = swdflxc(iplon,i) - swuflxc(iplon,i)
709	swnflx(i) = swdflx(iplon,i) - swuflx(iplon,i)
710	enddo
711
712	! Total and clear sky heating rates
713	do i = 1, nlayers
714	zdpgcp = heatfac / pdp(i)
715	swhrc(iplon,i) = (swnflxc(i+1) - swnflxc(i)) * zdpgcp
716	swhr(iplon,i) = (swnflx(i+1) - swnflx(i)) * zdpgcp
717	enddo
718	swhrc(iplon,nlayers) = 0._rb
719	swhr(iplon,nlayers) = 0._rb
720
721	! End longitude loop
722	enddo
723
724	end subroutine rrtmg_sw
725
726	!*************************************************************************
727	real(kind=rb) function earth_sun(idn)
728	!*************************************************************************
729	!
730	! Purpose: Function to calculate the correction factor of Earth's orbit
731	! for current day of the year
732
733	! idn : Day of the year
734	! earth_sun : square of the ratio of mean to actual Earth-Sun distance
735
736	! ------- Modules -------
737
738	use rrsw_con, only : pi
739
740	integer(kind=im), intent(in) :: idn
741
742	real(kind=rb) :: gamma
743
744	gamma = 2._rbpi(idn-1)/365._rb
745
746	! Use Iqbal's equation 1.2.1
747
748	earth_sun = 1.000110_rb + .034221_rb * cos(gamma) + .001289_rb * sin(gamma) + &
749	.000719_rb * cos(2._rbgamma) + .000077_rb sin(2._rb*gamma)
750
751	end function earth_sun
752
753	!***************************************************************************
754	subroutine inatm_sw (iplon, nlay, icld, iaer, &
755	play, plev, tlay, tlev, tsfc, h2ovmr, &
756	o3vmr, co2vmr, ch4vmr, n2ovmr, o2vmr, &
757	adjes, dyofyr, scon, inflgsw, iceflgsw, liqflgsw, &
758	cldfr, taucld, ssacld, asmcld, fsfcld, cicewp, cliqwp, &
759	reice, reliq, tauaer, ssaaer, asmaer, &
760	nlayers, pavel, pz, pdp, tavel, tz, tbound, coldry, wkl, &
761	adjflux, solvar, inflag, iceflag, liqflag, cldfrac, tauc, &
762	ssac, asmc, fsfc, ciwp, clwp, rei, rel, taua, ssaa, asma)
763	!***************************************************************************
764	!
765	! Input atmospheric profile from GCM, and prepare it for use in RRTMG_SW.
766	! Set other RRTMG_SW input parameters.
767	!
768	!***************************************************************************
769
770	! --------- Modules ----------
771
772	use parrrsw, only : nbndsw, ngptsw, nstr, nmol, mxmol, &
773	jpband, jpb1, jpb2, rrsw_scon
774	use rrsw_con, only : fluxfac, heatfac, oneminus, pi, grav, avogad
775	use rrsw_wvn, only : ng, nspa, nspb, wavenum1, wavenum2, delwave
776
777	! ------- Declarations -------
778
779	! ----- Input -----
780	! Note: All volume mixing ratios are in dimensionless units of mole fraction obtained
781	! by scaling mass mixing ratio (g/g) with the appropriate molecular weights (g/mol)
782	integer(kind=im), intent(in) :: iplon ! column loop index
783	integer(kind=im), intent(in) :: nlay ! number of model layers
784	integer(kind=im), intent(in) :: icld ! clear/cloud flag
785	integer(kind=im), intent(in) :: iaer ! aerosol option flag
786
787	real(kind=rb), intent(in) :: play(:,:) ! Layer pressures (hPa, mb)
788	! Dimensions: (ncol,nlay)
789	real(kind=rb), intent(in) :: plev(:,:) ! Interface pressures (hPa, mb)
790	! Dimensions: (ncol,nlay+1)
791	real(kind=rb), intent(in) :: tlay(:,:) ! Layer temperatures (K)
792	! Dimensions: (ncol,nlay)
793	real(kind=rb), intent(in) :: tlev(:,:) ! Interface temperatures (K)
794	! Dimensions: (ncol,nlay+1)
795	real(kind=rb), intent(in) :: tsfc(:) ! Surface temperature (K)
796	! Dimensions: (ncol)
797	real(kind=rb), intent(in) :: h2ovmr(:,:) ! H2O volume mixing ratio
798	! Dimensions: (ncol,nlay)
799	real(kind=rb), intent(in) :: o3vmr(:,:) ! O3 volume mixing ratio
800	! Dimensions: (ncol,nlay)
801	real(kind=rb), intent(in) :: co2vmr(:,:) ! CO2 volume mixing ratio
802	! Dimensions: (ncol,nlay)
803	real(kind=rb), intent(in) :: ch4vmr(:,:) ! Methane volume mixing ratio
804	! Dimensions: (ncol,nlay)
805	real(kind=rb), intent(in) :: n2ovmr(:,:) ! Nitrous oxide volume mixing ratio
806	! Dimensions: (ncol,nlay)
807	real(kind=rb), intent(in) :: o2vmr(:,:) ! Oxygen volume mixing ratio
808	! Dimensions: (ncol,nlay)
809
810	integer(kind=im), intent(in) :: dyofyr ! Day of the year (used to get Earth/Sun
811	! distance if adjflx not provided)
812	real(kind=rb), intent(in) :: adjes ! Flux adjustment for Earth/Sun distance
813	real(kind=rb), intent(in) :: scon ! Solar constant (W/m2)
814
815	integer(kind=im), intent(in) :: inflgsw ! Flag for cloud optical properties
816	integer(kind=im), intent(in) :: iceflgsw ! Flag for ice particle specification
817	integer(kind=im), intent(in) :: liqflgsw ! Flag for liquid droplet specification
818
819	real(kind=rb), intent(in) :: cldfr(:,:) ! Cloud fraction
820	! Dimensions: (ncol,nlay)
821	real(kind=rb), intent(in) :: taucld(:,:,:) ! In-cloud optical depth (optional)
822	! Dimensions: (nbndsw,ncol,nlay)
823	real(kind=rb), intent(in) :: ssacld(:,:,:) ! In-cloud single scattering albedo
824	! Dimensions: (nbndsw,ncol,nlay)
825	real(kind=rb), intent(in) :: asmcld(:,:,:) ! In-cloud asymmetry parameter
826	! Dimensions: (nbndsw,ncol,nlay)
827	real(kind=rb), intent(in) :: fsfcld(:,:,:) ! In-cloud forward scattering fraction
828	! Dimensions: (nbndsw,ncol,nlay)
829	real(kind=rb), intent(in) :: cicewp(:,:) ! In-cloud ice water path (g/m2)
830	! Dimensions: (ncol,nlay)
831	real(kind=rb), intent(in) :: cliqwp(:,:) ! In-cloud liquid water path (g/m2)
832	! Dimensions: (ncol,nlay)
833	real(kind=rb), intent(in) :: reice(:,:) ! Cloud ice effective size (microns)
834	! Dimensions: (ncol,nlay)
835	real(kind=rb), intent(in) :: reliq(:,:) ! Cloud water drop effective radius (microns)
836	! Dimensions: (ncol,nlay)
837
838	real(kind=rb), intent(in) :: tauaer(:,:,:) ! Aerosol optical depth
839	! Dimensions: (ncol,nlay,nbndsw)
840	real(kind=rb), intent(in) :: ssaaer(:,:,:) ! Aerosol single scattering albedo
841	! Dimensions: (ncol,nlay,nbndsw)
842	real(kind=rb), intent(in) :: asmaer(:,:,:) ! Aerosol asymmetry parameter
843	! Dimensions: (ncol,nlay,nbndsw)
844
845	! Atmosphere
846	integer(kind=im), intent(out) :: nlayers ! number of layers
847
848	real(kind=rb), intent(out) :: pavel(:) ! layer pressures (mb)
849	! Dimensions: (nlay)
850	real(kind=rb), intent(out) :: tavel(:) ! layer temperatures (K)
851	! Dimensions: (nlay)
852	real(kind=rb), intent(out) :: pz(0:) ! level (interface) pressures (hPa, mb)
853	! Dimensions: (0:nlay)
854	real(kind=rb), intent(out) :: tz(0:) ! level (interface) temperatures (K)
855	! Dimensions: (0:nlay)
856	real(kind=rb), intent(out) :: tbound ! surface temperature (K)
857	real(kind=rb), intent(out) :: pdp(:) ! layer pressure thickness (hPa, mb)
858	! Dimensions: (nlay)
859	real(kind=rb), intent(out) :: coldry(:) ! dry air column density (mol/cm2)
860	! Dimensions: (nlay)
861	real(kind=rb), intent(out) :: wkl(:,:) ! molecular amounts (mol/cm-2)
862	! Dimensions: (mxmol,nlay)
863
864	real(kind=rb), intent(out) :: adjflux(:) ! adjustment for current Earth/Sun distance
865	! Dimensions: (jpband)
866	real(kind=rb), intent(out) :: solvar(:) ! solar constant scaling factor from rrtmg_sw
867	! Dimensions: (jpband)
868	! default value of 1368.22 Wm-2 at 1 AU
869	real(kind=rb), intent(out) :: taua(:,:) ! Aerosol optical depth
870	! Dimensions: (nlay,nbndsw)
871	real(kind=rb), intent(out) :: ssaa(:,:) ! Aerosol single scattering albedo
872	! Dimensions: (nlay,nbndsw)
873	real(kind=rb), intent(out) :: asma(:,:) ! Aerosol asymmetry parameter
874	! Dimensions: (nlay,nbndsw)
875
876	! Atmosphere/clouds - cldprop
877	integer(kind=im), intent(out) :: inflag ! flag for cloud property method
878	integer(kind=im), intent(out) :: iceflag ! flag for ice cloud properties
879	integer(kind=im), intent(out) :: liqflag ! flag for liquid cloud properties
880
881	real(kind=rb), intent(out) :: cldfrac(:) ! layer cloud fraction
882	! Dimensions: (nlay)
883	real(kind=rb), intent(out) :: tauc(:,:) ! in-cloud optical depth (non-delta scaled)
884	! Dimensions: (nbndsw,nlay)
885	real(kind=rb), intent(out) :: ssac(:,:) ! in-cloud single scattering albedo (non-delta-scaled)
886	! Dimensions: (nbndsw,nlay)
887	real(kind=rb), intent(out) :: asmc(:,:) ! in-cloud asymmetry parameter (non-delta scaled)
888	! Dimensions: (nbndsw,nlay)
889	real(kind=rb), intent(out) :: fsfc(:,:) ! in-cloud forward scattering fraction (non-delta scaled)
890	! Dimensions: (nbndsw,nlay)
891	real(kind=rb), intent(out) :: ciwp(:) ! in-cloud ice water path
892	! Dimensions: (nlay)
893	real(kind=rb), intent(out) :: clwp(:) ! in-cloud liquid water path
894	! Dimensions: (nlay)
895	real(kind=rb), intent(out) :: rel(:) ! cloud liquid particle effective radius (microns)
896	! Dimensions: (nlay)
897	real(kind=rb), intent(out) :: rei(:) ! cloud ice particle effective size (microns)
898	! Dimensions: (nlay)
899
900	! ----- Local -----
901	real(kind=rb), parameter :: amd = 28.9660_rb ! Effective molecular weight of dry air (g/mol)
902	real(kind=rb), parameter :: amw = 18.0160_rb ! Molecular weight of water vapor (g/mol)
903	! real(kind=rb), parameter :: amc = 44.0098_rb ! Molecular weight of carbon dioxide (g/mol)
904	! real(kind=rb), parameter :: amo = 47.9998_rb ! Molecular weight of ozone (g/mol)
905	! real(kind=rb), parameter :: amo2 = 31.9999_rb ! Molecular weight of oxygen (g/mol)
906	! real(kind=rb), parameter :: amch4 = 16.0430_rb ! Molecular weight of methane (g/mol)
907	! real(kind=rb), parameter :: amn2o = 44.0128_rb ! Molecular weight of nitrous oxide (g/mol)
908
909	! Set molecular weight ratios (for converting mmr to vmr)
910	! e.g. h2ovmr = h2ommr * amdw)
911	real(kind=rb), parameter :: amdw = 1.607793_rb ! Molecular weight of dry air / water vapor
912	real(kind=rb), parameter :: amdc = 0.658114_rb ! Molecular weight of dry air / carbon dioxide
913	real(kind=rb), parameter :: amdo = 0.603428_rb ! Molecular weight of dry air / ozone
914	real(kind=rb), parameter :: amdm = 1.805423_rb ! Molecular weight of dry air / methane
915	real(kind=rb), parameter :: amdn = 0.658090_rb ! Molecular weight of dry air / nitrous oxide
916	real(kind=rb), parameter :: amdo2 = 0.905140_rb ! Molecular weight of dry air / oxygen
917
918	real(kind=rb), parameter :: sbc = 5.67e-08_rb ! Stefan-Boltzmann constant (W/m2K4)
919
920	integer(kind=im) :: isp, l, ix, n, imol, ib ! Loop indices
921	real(kind=rb) :: amm, summol !
922	real(kind=rb) :: adjflx ! flux adjustment for Earth/Sun distance
923	! real(kind=rb) :: earth_sun ! function for Earth/Sun distance adjustment
924
925	! Add one to nlayers here to include extra model layer at top of atmosphere
926	nlayers = nlay
927
928	! Initialize all molecular amounts to zero here, then pass input amounts
929	! into RRTM array WKL below.
930
931	wkl(:,:) = 0.0_rb
932	cldfrac(:) = 0.0_rb
933	tauc(:,:) = 0.0_rb
934	ssac(:,:) = 1.0_rb
935	asmc(:,:) = 0.0_rb
936	fsfc(:,:) = 0.0_rb
937	ciwp(:) = 0.0_rb
938	clwp(:) = 0.0_rb
939	rei(:) = 0.0_rb
940	rel(:) = 0.0_rb
941	taua(:,:) = 0.0_rb
942	ssaa(:,:) = 1.0_rb
943	asma(:,:) = 0.0_rb
944
945	! Set flux adjustment for current Earth/Sun distance (two options).
946	! 1) Use Earth/Sun distance flux adjustment provided by GCM (input as adjes);
947	adjflx = adjes
948	!
949	! 2) Calculate Earth/Sun distance from DYOFYR, the cumulative day of the year.
950	! (Set adjflx to 1. to use constant Earth/Sun distance of 1 AU).
951	if (dyofyr .gt. 0) then
952	adjflx = earth_sun(dyofyr)
953	endif
954
955	! Set incoming solar flux adjustment to include adjustment for
956	! current Earth/Sun distance (ADJFLX) and scaling of default internal
957	! solar constant (rrsw_scon = 1368.22 Wm-2) by band (SOLVAR). SOLVAR can be set
958	! to a single scaling factor as needed, or to a different value in each
959	! band, which may be necessary for paleoclimate simulations.
960	!
961	do ib = jpb1,jpb2
962	! solvar(ib) = 1._rb
963	solvar(ib) = scon / rrsw_scon
964	adjflux(ib) = adjflx * solvar(ib)
965	enddo
966
967	! Set surface temperature.
968	tbound = tsfc(iplon)
969
970	! Install input GCM arrays into RRTMG_SW arrays for pressure, temperature,
971	! and molecular amounts.
972	! Pressures are input in mb, or are converted to mb here.
973	! Molecular amounts are input in volume mixing ratio, or are converted from
974	! mass mixing ratio (or specific humidity for h2o) to volume mixing ratio
975	! here. These are then converted to molecular amount (molec/cm2) below.
976	! The dry air column COLDRY (in molec/cm2) is calculated from the level
977	! pressures, pz (in mb), based on the hydrostatic equation and includes a
978	! correction to account for h2o in the layer. The molecular weight of moist
979	! air (amm) is calculated for each layer.
980	! Note: In RRTMG, layer indexing goes from bottom to top, and coding below
981	! assumes GCM input fields are also bottom to top. Input layer indexing
982	! from GCM fields should be reversed here if necessary.
983
984	pz(0) = plev(iplon,1)
985	tz(0) = tlev(iplon,1)
986	do l = 1, nlayers
987	pavel(l) = play(iplon,l)
988	tavel(l) = tlay(iplon,l)
989	pz(l) = plev(iplon,l+1)
990	tz(l) = tlev(iplon,l+1)
991	pdp(l) = pz(l-1) - pz(l)
992	! For h2o input in vmr:
993	wkl(1,l) = h2ovmr(iplon,l)
994	! For h2o input in mmr:
995	! wkl(1,l) = h2o(iplon,l)*amdw
996	! For h2o input in specific humidity;
997	! wkl(1,l) = (h2o(iplon,l)/(1._rb - h2o(iplon,l)))*amdw
998	wkl(2,l) = co2vmr(iplon,l)
999	wkl(3,l) = o3vmr(iplon,l)
1000	wkl(4,l) = n2ovmr(iplon,l)
1001	wkl(6,l) = ch4vmr(iplon,l)
1002	wkl(7,l) = o2vmr(iplon,l)
1003	amm = (1._rb - wkl(1,l)) * amd + wkl(1,l) * amw
1004	coldry(l) = (pz(l-1)-pz(l)) * 1.e3_rb * avogad / &
1005	(1.e2_rb * grav * amm * (1._rb + wkl(1,l)))
1006	enddo
1007
1008	! The following section can be used to set values for an additional layer (from
1009	! the GCM top level to 1.e-4 mb) for improved calculation of TOA fluxes.
1010	! Temperature and molecular amounts in the extra model layer are set to
1011	! their values in the top GCM model layer, though these can be modified
1012	! here if necessary.
1013	! If this feature is utilized, increase nlayers by one above, limit the two
1014	! loops above to (nlayers-1), and set the top most (nlayers) layer values here.
1015
1016	! pavel(nlayers) = 0.5_rb * pz(nlayers-1)
1017	! tavel(nlayers) = tavel(nlayers-1)
1018	! pz(nlayers) = 1.e-4_rb
1019	! tz(nlayers-1) = 0.5_rb * (tavel(nlayers)+tavel(nlayers-1))
1020	! tz(nlayers) = tz(nlayers-1)
1021	! pdp(nlayers) = pz(nlayers-1) - pz(nlayers)
1022	! wkl(1,nlayers) = wkl(1,nlayers-1)
1023	! wkl(2,nlayers) = wkl(2,nlayers-1)
1024	! wkl(3,nlayers) = wkl(3,nlayers-1)
1025	! wkl(4,nlayers) = wkl(4,nlayers-1)
1026	! wkl(6,nlayers) = wkl(6,nlayers-1)
1027	! wkl(7,nlayers) = wkl(7,nlayers-1)
1028	! amm = (1._rb - wkl(1,nlayers-1)) * amd + wkl(1,nlayers-1) * amw
1029	! coldry(nlayers) = (pz(nlayers-1)) * 1.e3_rb * avogad / &
1030	! (1.e2_rb * grav * amm * (1._rb + wkl(1,nlayers-1)))
1031
1032	! At this point all molecular amounts in wkl are in volume mixing ratio;
1033	! convert to molec/cm2 based on coldry for use in rrtm.
1034
1035	do l = 1, nlayers
1036	do imol = 1, nmol
1037	wkl(imol,l) = coldry(l) * wkl(imol,l)
1038	enddo
1039	enddo
1040
1041	! Transfer aerosol optical properties to RRTM variables;
1042	! modify to reverse layer indexing here if necessary.
1043
1044	if (iaer .ge. 1) then
1045	do l = 1, nlayers
1046	do ib = 1, nbndsw
1047	taua(l,ib) = tauaer(iplon,l,ib)
1048	ssaa(l,ib) = ssaaer(iplon,l,ib)
1049	asma(l,ib) = asmaer(iplon,l,ib)
1050	enddo
1051	enddo
1052	endif
1053
1054	! Transfer cloud fraction and cloud optical properties to RRTM variables;
1055	! modify to reverse layer indexing here if necessary.
1056
1057	if (icld .ge. 1) then
1058	inflag = inflgsw
1059	iceflag = iceflgsw
1060	liqflag = liqflgsw
1061
1062	! Move incoming GCM cloud arrays to RRTMG cloud arrays.
1063	! For GCM input, incoming reice is defined based on selected ice parameterization (inflglw)
1064
1065	do l = 1, nlayers
1066	cldfrac(l) = cldfr(iplon,l)
1067	ciwp(l) = cicewp(iplon,l)
1068	clwp(l) = cliqwp(iplon,l)
1069	rei(l) = reice(iplon,l)
1070	rel(l) = reliq(iplon,l)
1071	do n = 1,nbndsw
1072	tauc(n,l) = taucld(n,iplon,l)
1073	ssac(n,l) = ssacld(n,iplon,l)
1074	asmc(n,l) = asmcld(n,iplon,l)
1075	fsfc(n,l) = fsfcld(n,iplon,l)
1076	enddo
1077	enddo
1078
1079	! If an extra layer is being used in RRTMG, set all cloud properties to zero in the extra layer.
1080
1081	! cldfrac(nlayers) = 0.0_rb
1082	! tauc(:,nlayers) = 0.0_rb
1083	! ssac(:,nlayers) = 1.0_rb
1084	! asmc(:,nlayers) = 0.0_rb
1085	! fsfc(:,nlayers) = 0.0_rb
1086	! ciwp(nlayers) = 0.0_rb
1087	! clwp(nlayers) = 0.0_rb
1088	! rei(nlayers) = 0.0_rb
1089	! rel(nlayers) = 0.0_rb
1090
1091	endif
1092
1093	end subroutine inatm_sw
1094
1095	end module rrtmg_sw_rad
1096
1097

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: palm/trunk/LIB/rrtmg/rrtmg_sw_rad.nomcica.f90 @ 3775

Download in other formats: