Context Navigation

radiation_cloud_optics.F90 @ 4190

Last change on this file since 4190 was 3908, checked in by idelkadi, 3 years ago

Online implementation of the radiative transfer code ECRAD in the LMDZ model.

Inclusion of the ecrad directory containing the sources of the ECRAD code
- interface routine : radiation_scheme.F90
Adaptation of compilation scripts :
- compilation under CPP key CPP_ECRAD
- compilation with option "-rad ecard" or "-ecard true"
- The "-rad old/rtm/ecran" build option will need to replace the "-rrtm true" and "-ecrad true" options in the future.
Runing LMDZ simulations with ecrad, you need :
- logical key iflag_rrtm = 2 in physiq.def
- namelist_ecrad (DefLists?)
- the directory "data" containing the configuration files is temporarily placed in ../libfphylmd/ecrad/
Compilation and execution are tested in the 1D case. The repository under svn would allow to continue the implementation work: tests, verification of the results, ...

File size: 22.7 KB

Line
1	! radiation_cloud_optics.F90 - Computing cloud optical properties
2	!
3	! (C) Copyright 2014- ECMWF.
4	!
5	! This software is licensed under the terms of the Apache Licence Version 2.0
6	! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
7	!
8	! In applying this licence, ECMWF does not waive the privileges and immunities
9	! granted to it by virtue of its status as an intergovernmental organisation
10	! nor does it submit to any jurisdiction.
11	!
12	! Author: Robin Hogan
13	! Email: r.j.hogan@ecmwf.int
14	!
15	! Modifications
16	! 2017-07-22 R. Hogan Added Yi et al. ice optics model
17
18	module radiation_cloud_optics
19
20	implicit none
21	public
22
23	contains
24
25	! Provides elemental function "delta_eddington_scat_od"
26	#include "radiation_delta_eddington.h"
27
28	!---------------------------------------------------------------------
29	! Load cloud scattering data; this subroutine delegates to one
30	! in radiation_cloud_optics_data.F90, but checks the size of
31	! what is returned
32	subroutine setup_cloud_optics(config)
33
34	use parkind1, only : jprb
35	use yomhook, only : lhook, dr_hook
36
37	use radiation_io, only : nulerr, radiation_abort
38	use radiation_config, only : config_type, IIceModelFu, IIceModelBaran, &
39	& IIceModelBaran2016, IIceModelBaran2017, &
40	& IIceModelYi, &
41	& ILiquidModelSOCRATES, ILiquidModelSlingo
42	use radiation_cloud_optics_data, only : cloud_optics_type
43	use radiation_ice_optics_fu, only : NIceOpticsCoeffsFuSW, &
44	& NIceOpticsCoeffsFuLW
45	use radiation_ice_optics_baran, only : NIceOpticsCoeffsBaran, &
46	& NIceOpticsCoeffsBaran2016
47	use radiation_ice_optics_baran2017, only : NIceOpticsCoeffsBaran2017, &
48	& NIceOpticsGeneralCoeffsBaran2017
49	use radiation_ice_optics_yi, only : NIceOpticsCoeffsYiSW, &
50	& NIceOpticsCoeffsYiLW
51	use radiation_liquid_optics_socrates, only : NLiqOpticsCoeffsSOCRATES
52	use radiation_liquid_optics_slingo, only : NLiqOpticsCoeffsSlingoSW, &
53	& NLiqOpticsCoeffsLindnerLiLW
54
55	type(config_type), intent(inout) :: config
56
57	real(jprb) :: hook_handle
58
59	if (lhook) call dr_hook('radiation_cloud_optics:setup_cloud_optics',0,hook_handle)
60
61	call config%cloud_optics%setup(trim(config%liq_optics_file_name), &
62	& trim(config%ice_optics_file_name), iverbose=config%iverbosesetup)
63
64	! Check liquid coefficients
65	if (size(config%cloud_optics%liq_coeff_lw, 1) /= config%n_bands_lw) then
66	write(nulerr,'(a,i0,a,i0,a)') &
67	& '*** Error: number of longwave bands for droplets (', &
68	& size(config%cloud_optics%liq_coeff_lw, 1), &
69	& ') does not match number for gases (', config%n_bands_lw, ')'
70	call radiation_abort()
71	end if
72	if (size(config%cloud_optics%liq_coeff_sw, 1) /= config%n_bands_sw) then
73	write(nulerr,'(a,i0,a,i0,a)') &
74	& '*** Error: number of shortwave bands for droplets (', &
75	& size(config%cloud_optics%liq_coeff_sw, 1), &
76	& ') does not match number for gases (', config%n_bands_sw, ')'
77	call radiation_abort()
78	end if
79
80	if (config%i_liq_model == ILiquidModelSOCRATES) then
81	if (size(config%cloud_optics%liq_coeff_lw, 2) /= NLiqOpticsCoeffsSOCRATES) then
82	write(nulerr,'(a,i0,a,i0,a,i0,a)') &
83	& '*** Error: number of liquid cloud optical coefficients (', &
84	& size(config%cloud_optics%liq_coeff_lw, 2), &
85	& ') does not match number expected (', NLiqOpticsCoeffsSOCRATES,')'
86	call radiation_abort()
87	end if
88	else if (config%i_liq_model == ILiquidModelSlingo) then
89	if (size(config%cloud_optics%liq_coeff_sw, 2) /= NLiqOpticsCoeffsSlingoSW) then
90	write(nulerr,'(a,i0,a,i0,a,i0,a)') &
91	& '*** Error: number of shortwave liquid cloud optical coefficients (', &
92	& size(config%cloud_optics%liq_coeff_sw, 2), &
93	& ') does not match number expected (', NLiqOpticsCoeffsSlingoSW,')'
94	call radiation_abort()
95	end if
96	if (size(config%cloud_optics%liq_coeff_lw, 2) /= NLiqOpticsCoeffsLindnerLiLW) then
97	write(nulerr,'(a,i0,a,i0,a,i0,a)') &
98	& '*** Error: number of longwave liquid cloud optical coefficients (', &
99	& size(config%cloud_optics%liq_coeff_lw, 2), &
100	& ') does not match number expected (', NLiqOpticsCoeffsLindnerLiLw,')'
101	call radiation_abort()
102	end if
103	end if
104
105	! Check ice coefficients
106	if (size(config%cloud_optics%ice_coeff_lw, 1) /= config%n_bands_lw) then
107	write(nulerr,'(a,i0,a,i0,a)') &
108	& '*** Error: number of longwave bands for ice particles (', &
109	& size(config%cloud_optics%ice_coeff_lw, 1), &
110	& ') does not match number for gases (', config%n_bands_lw, ')'
111	call radiation_abort()
112	end if
113	if (size(config%cloud_optics%ice_coeff_sw, 1) /= config%n_bands_sw) then
114	write(nulerr,'(a,i0,a,i0,a)') &
115	& '*** Error: number of shortwave bands for ice particles (', &
116	& size(config%cloud_optics%ice_coeff_sw, 1), &
117	& ') does not match number for gases (', config%n_bands_sw, ')'
118	call radiation_abort()
119	end if
120
121	if (config%i_ice_model == IIceModelFu) then
122	if (size(config%cloud_optics%ice_coeff_lw, 2) &
123	& /= NIceOpticsCoeffsFuLW) then
124	write(nulerr,'(a,i0,a,i0,a,i0,a)') &
125	& '*** Error: number of LW ice-particle optical coefficients (', &
126	& size(config%cloud_optics%ice_coeff_lw, 2), &
127	& ') does not match number expected (', NIceOpticsCoeffsFuLW,')'
128	call radiation_abort()
129	end if
130	if (size(config%cloud_optics%ice_coeff_sw, 2) &
131	& /= NIceOpticsCoeffsFuSW) then
132	write(nulerr,'(a,i0,a,i0,a,i0,a)') &
133	& '*** Error: number of SW ice-particle optical coefficients (', &
134	& size(config%cloud_optics%ice_coeff_sw, 2), &
135	& ') does not match number expected (', NIceOpticsCoeffsFuSW,')'
136	call radiation_abort()
137	end if
138	else if (config%i_ice_model == IIceModelBaran &
139	& .and. size(config%cloud_optics%ice_coeff_lw, 2) &
140	& /= NIceOpticsCoeffsBaran) then
141	write(nulerr,'(a,i0,a,i0,a,i0,a)') &
142	& '*** Error: number of ice-particle optical coefficients (', &
143	& size(config%cloud_optics%ice_coeff_lw, 2), &
144	& ') does not match number expected (', NIceOpticsCoeffsBaran,')'
145	call radiation_abort()
146	else if (config%i_ice_model == IIceModelBaran2016 &
147	& .and. size(config%cloud_optics%ice_coeff_lw, 2) &
148	& /= NIceOpticsCoeffsBaran2016) then
149	write(nulerr,'(a,i0,a,i0,a,i0,a)') &
150	& '*** Error: number of ice-particle optical coefficients (', &
151	& size(config%cloud_optics%ice_coeff_lw, 2), &
152	& ') does not match number expected (', NIceOpticsCoeffsBaran2016,')'
153	call radiation_abort()
154	else if (config%i_ice_model == IIceModelBaran2017) then
155	if (size(config%cloud_optics%ice_coeff_lw, 2) &
156	& /= NIceOpticsCoeffsBaran2017) then
157	write(nulerr,'(a,i0,a,i0,a,i0,a)') &
158	& '*** Error: number of ice-particle optical coefficients (', &
159	& size(config%cloud_optics%ice_coeff_lw, 2), &
160	& ') does not match number expected (', NIceOpticsCoeffsBaran2017,')'
161	call radiation_abort()
162	else if (.not. allocated(config%cloud_optics%ice_coeff_gen)) then
163	write(nulerr,'(a)') &
164	& '*** Error: coeff_gen needed for Baran-2017 ice optics parameterization'
165	call radiation_abort()
166	else if (size(config%cloud_optics%ice_coeff_gen) &
167	& /= NIceOpticsGeneralCoeffsBaran2017) then
168	write(nulerr,'(a,i0,a,i0,a,i0,a)') &
169	& '*** Error: number of general ice-particle optical coefficients (', &
170	& size(config%cloud_optics%ice_coeff_gen), &
171	& ') does not match number expected (', NIceOpticsGeneralCoeffsBaran2017,')'
172	call radiation_abort()
173	end if
174	else if (config%i_ice_model == IIceModelYi) then
175	if (size(config%cloud_optics%ice_coeff_lw, 2) &
176	& /= NIceOpticsCoeffsYiLW) then
177	write(nulerr,'(a,i0,a,i0,a,i0,a)') &
178	& '*** Error: number of LW ice-particle optical coefficients (', &
179	& size(config%cloud_optics%ice_coeff_lw, 2), &
180	& ') does not match number expected (', NIceOpticsCoeffsYiLW,')'
181	call radiation_abort()
182	end if
183	if (size(config%cloud_optics%ice_coeff_sw, 2) &
184	& /= NIceOpticsCoeffsYiSW) then
185	write(nulerr,'(a,i0,a,i0,a,i0,a)') &
186	& '*** Error: number of SW ice-particle optical coefficients (', &
187	& size(config%cloud_optics%ice_coeff_sw, 2), &
188	& ') does not match number expected (', NIceOpticsCoeffsYiSW,')'
189	call radiation_abort()
190	end if
191	end if
192
193	if (lhook) call dr_hook('radiation_cloud_optics:setup_cloud_optics',1,hook_handle)
194
195	end subroutine setup_cloud_optics
196
197
198	!---------------------------------------------------------------------
199	! Compute cloud optical properties
200	subroutine cloud_optics(nlev,istartcol,iendcol, &
201	& config, thermodynamics, cloud, &
202	& od_lw_cloud, ssa_lw_cloud, g_lw_cloud, &
203	& od_sw_cloud, ssa_sw_cloud, g_sw_cloud)
204
205	use parkind1, only : jprb
206	use yomhook, only : lhook, dr_hook
207
208	use radiation_io, only : nulout, nulerr, radiation_abort
209	use radiation_config, only : config_type, IIceModelFu, IIceModelBaran, &
210	& IIceModelBaran2016, IIceModelBaran2017, &
211	& IIceModelYi, &
212	& ILiquidModelSOCRATES, ILiquidModelSlingo
213	use radiation_thermodynamics, only : thermodynamics_type
214	use radiation_cloud, only : cloud_type
215	use radiation_constants, only : AccelDueToGravity
216	use radiation_cloud_optics_data, only : cloud_optics_type
217	use radiation_ice_optics_fu, only : calc_ice_optics_fu_sw, &
218	& calc_ice_optics_fu_lw
219	use radiation_ice_optics_baran, only : calc_ice_optics_baran, &
220	& calc_ice_optics_baran2016
221	use radiation_ice_optics_baran2017, only : calc_ice_optics_baran2017
222	use radiation_ice_optics_yi, only : calc_ice_optics_yi_sw, &
223	& calc_ice_optics_yi_lw
224	use radiation_liquid_optics_socrates, only:calc_liq_optics_socrates
225	use radiation_liquid_optics_slingo, only:calc_liq_optics_slingo, &
226	& calc_liq_optics_lindner_li
227
228	integer, intent(in) :: nlev ! number of model levels
229	integer, intent(in) :: istartcol, iendcol ! range of columns to process
230	type(config_type), intent(in), target :: config
231	type(thermodynamics_type),intent(in) :: thermodynamics
232	type(cloud_type), intent(in) :: cloud
233
234	! Layer optical depth, single scattering albedo and g factor of
235	! clouds in each longwave band, where the latter two
236	! variables are only defined if cloud longwave scattering is
237	! enabled (otherwise both are treated as zero).
238	real(jprb), dimension(config%n_bands_lw,nlev,istartcol:iendcol), intent(out) :: &
239	& od_lw_cloud
240	real(jprb), dimension(config%n_bands_lw_if_scattering,nlev,istartcol:iendcol), &
241	& intent(out) :: ssa_lw_cloud, g_lw_cloud
242
243	! Layer optical depth, single scattering albedo and g factor of
244	! clouds in each shortwave band
245	real(jprb), dimension(config%n_bands_sw,nlev,istartcol:iendcol), intent(out) :: &
246	& od_sw_cloud, ssa_sw_cloud, g_sw_cloud
247
248	! Longwave and shortwave optical depth, scattering optical depth
249	! and asymmetry factor, for liquid and ice in all bands but a
250	! single cloud layer
251	real(jprb), dimension(config%n_bands_lw) :: &
252	& od_lw_liq, scat_od_lw_liq, g_lw_liq, &
253	& od_lw_ice, scat_od_lw_ice, g_lw_ice
254	real(jprb), dimension(config%n_bands_sw) :: &
255	& od_sw_liq, scat_od_sw_liq, g_sw_liq, &
256	& od_sw_ice, scat_od_sw_ice, g_sw_ice
257
258	! In-cloud water path of cloud liquid or ice (i.e. liquid or ice
259	! gridbox-mean water path divided by cloud fraction); kg m-2
260	real(jprb) :: lwp_in_cloud, iwp_in_cloud
261
262	! Full-level temperature (K)
263	real(jprb) :: temperature
264
265	! Factor to convert gridbox-mean mixing ratio to in-cloud water
266	! path
267	real(jprb) :: factor
268
269	! Pointer to the cloud optics coefficients for brevity of
270	! access
271	type(cloud_optics_type), pointer :: ho
272
273	integer :: jcol, jlev
274
275	real(jprb) :: hook_handle
276
277	if (lhook) call dr_hook('radiation_cloud_optics:cloud_optics',0,hook_handle)
278
279	if (config%iverbose >= 2) then
280	write(nulout,'(a)') 'Computing cloud absorption/scattering properties'
281	end if
282
283	ho => config%cloud_optics
284
285	! Array-wise assignment
286	od_lw_cloud = 0.0_jprb
287	od_sw_cloud = 0.0_jprb
288	ssa_sw_cloud = 0.0_jprb
289	g_sw_cloud = 0.0_jprb
290	if (config%do_lw_cloud_scattering) then
291	ssa_lw_cloud = 0.0_jprb
292	g_lw_cloud = 0.0_jprb
293	end if
294
295	do jlev = 1,nlev
296	do jcol = istartcol,iendcol
297	! Only do anything if cloud is present (assume that
298	! cloud%crop_cloud_fraction has already been called)
299	if (cloud%fraction(jcol,jlev) > 0.0_jprb) then
300
301	! Compute in-cloud liquid and ice water path
302	if (config%is_homogeneous) then
303	! Homogeneous solvers assume cloud fills the box
304	! horizontally, so we don't divide by cloud fraction
305	factor = ( thermodynamics%pressure_hl(jcol,jlev+1) &
306	& -thermodynamics%pressure_hl(jcol,jlev ) ) &
307	& / AccelDueToGravity
308	else
309	factor = ( thermodynamics%pressure_hl(jcol,jlev+1) &
310	& -thermodynamics%pressure_hl(jcol,jlev ) ) &
311	& / (AccelDueToGravity * cloud%fraction(jcol,jlev))
312	end if
313	lwp_in_cloud = factor * cloud%q_liq(jcol,jlev)
314	iwp_in_cloud = factor * cloud%q_ice(jcol,jlev)
315
316	! Only compute liquid properties if liquid cloud is
317	! present
318	if (lwp_in_cloud > 0.0_jprb) then
319	if (config%i_liq_model == ILiquidModelSOCRATES) then
320	! Compute longwave properties
321	call calc_liq_optics_socrates(config%n_bands_lw, &
322	& config%cloud_optics%liq_coeff_lw, &
323	& lwp_in_cloud, cloud%re_liq(jcol,jlev), &
324	& od_lw_liq, scat_od_lw_liq, g_lw_liq)
325	! Compute shortwave properties
326	call calc_liq_optics_socrates(config%n_bands_sw, &
327	& config%cloud_optics%liq_coeff_sw, &
328	& lwp_in_cloud, cloud%re_liq(jcol,jlev), &
329	& od_sw_liq, scat_od_sw_liq, g_sw_liq)
330	else if (config%i_liq_model == ILiquidModelSlingo) then
331	! Compute longwave properties
332	call calc_liq_optics_lindner_li(config%n_bands_lw, &
333	& config%cloud_optics%liq_coeff_lw, &
334	& lwp_in_cloud, cloud%re_liq(jcol,jlev), &
335	& od_lw_liq, scat_od_lw_liq, g_lw_liq)
336	! Compute shortwave properties
337	call calc_liq_optics_slingo(config%n_bands_sw, &
338	& config%cloud_optics%liq_coeff_sw, &
339	& lwp_in_cloud, cloud%re_liq(jcol,jlev), &
340	& od_sw_liq, scat_od_sw_liq, g_sw_liq)
341	else
342	write(nulerr,) '** Error: Unknown liquid model with code', &
343	& config%i_liq_model
344	call radiation_abort()
345	end if
346
347	if (.not. config%do_sw_delta_scaling_with_gases) then
348	! Delta-Eddington scaling in the shortwave only
349	call delta_eddington_scat_od(od_sw_liq, scat_od_sw_liq, g_sw_liq)
350	end if
351	else
352	! Liquid not present: set properties to zero
353	od_lw_liq = 0.0_jprb
354	scat_od_lw_liq = 0.0_jprb
355	g_lw_liq = 0.0_jprb
356
357	od_sw_liq = 0.0_jprb
358	scat_od_sw_liq = 0.0_jprb
359	g_sw_liq = 0.0_jprb
360	end if ! Liquid present
361
362	! Only compute ice properties if ice cloud is present
363	if (iwp_in_cloud > 0.0_jprb) then
364	if (config%i_ice_model == IIceModelBaran) then
365	! Compute longwave properties
366	call calc_ice_optics_baran(config%n_bands_lw, &
367	& config%cloud_optics%ice_coeff_lw, &
368	& iwp_in_cloud, cloud%q_ice(jcol,jlev), &
369	& od_lw_ice, scat_od_lw_ice, g_lw_ice)
370	! Compute shortwave properties
371	call calc_ice_optics_baran(config%n_bands_sw, &
372	& config%cloud_optics%ice_coeff_sw, &
373	& iwp_in_cloud, cloud%q_ice(jcol,jlev), &
374	& od_sw_ice, scat_od_sw_ice, g_sw_ice)
375	else if (config%i_ice_model == IIceModelBaran2016) then
376	temperature = 0.5_jprb * (thermodynamics%temperature_hl(jcol,jlev) &
377	& +thermodynamics%temperature_hl(jcol,jlev+1))
378	! Compute longwave properties
379	call calc_ice_optics_baran2016(config%n_bands_lw, &
380	& config%cloud_optics%ice_coeff_lw, &
381	& iwp_in_cloud, cloud%q_ice(jcol,jlev), &
382	& temperature, &
383	& od_lw_ice, scat_od_lw_ice, g_lw_ice)
384	! Compute shortwave properties
385	call calc_ice_optics_baran2016(config%n_bands_sw, &
386	& config%cloud_optics%ice_coeff_sw, &
387	& iwp_in_cloud, cloud%q_ice(jcol,jlev), &
388	& temperature, &
389	& od_sw_ice, scat_od_sw_ice, g_sw_ice)
390	else if (config%i_ice_model == IIceModelBaran2017) then
391	temperature = 0.5_jprb * (thermodynamics%temperature_hl(jcol,jlev) &
392	& +thermodynamics%temperature_hl(jcol,jlev+1))
393	! Compute longwave properties
394	call calc_ice_optics_baran2017(config%n_bands_lw, &
395	& config%cloud_optics%ice_coeff_gen, &
396	& config%cloud_optics%ice_coeff_lw, &
397	& iwp_in_cloud, cloud%q_ice(jcol,jlev), &
398	& temperature, &
399	& od_lw_ice, scat_od_lw_ice, g_lw_ice)
400	! Compute shortwave properties
401	call calc_ice_optics_baran2017(config%n_bands_sw, &
402	& config%cloud_optics%ice_coeff_gen, &
403	& config%cloud_optics%ice_coeff_sw, &
404	& iwp_in_cloud, cloud%q_ice(jcol,jlev), &
405	& temperature, &
406	& od_sw_ice, scat_od_sw_ice, g_sw_ice)
407	else if (config%i_ice_model == IIceModelFu) then
408	! Compute longwave properties
409	call calc_ice_optics_fu_lw(config%n_bands_lw, &
410	& config%cloud_optics%ice_coeff_lw, &
411	& iwp_in_cloud, cloud%re_ice(jcol,jlev), &
412	& od_lw_ice, scat_od_lw_ice, g_lw_ice)
413	if (config%do_fu_lw_ice_optics_bug) then
414	! Reproduce bug in old IFS scheme
415	scat_od_lw_ice = od_lw_ice - scat_od_lw_ice
416	end if
417	! Compute shortwave properties
418	call calc_ice_optics_fu_sw(config%n_bands_sw, &
419	& config%cloud_optics%ice_coeff_sw, &
420	& iwp_in_cloud, cloud%re_ice(jcol,jlev), &
421	& od_sw_ice, scat_od_sw_ice, g_sw_ice)
422	else if (config%i_ice_model == IIceModelYi) then
423	! Compute longwave properties
424	call calc_ice_optics_yi_lw(config%n_bands_lw, &
425	& config%cloud_optics%ice_coeff_lw, &
426	& iwp_in_cloud, cloud%re_ice(jcol,jlev), &
427	& od_lw_ice, scat_od_lw_ice, g_lw_ice)
428	! Compute shortwave properties
429	call calc_ice_optics_yi_sw(config%n_bands_sw, &
430	& config%cloud_optics%ice_coeff_sw, &
431	& iwp_in_cloud, cloud%re_ice(jcol,jlev), &
432	& od_sw_ice, scat_od_sw_ice, g_sw_ice)
433	else
434	write(nulerr,) '** Error: Unknown ice model with code', &
435	& config%i_ice_model
436	call radiation_abort()
437	end if
438
439	if (.not. config%do_sw_delta_scaling_with_gases) then
440	! Delta-Eddington scaling in both longwave and shortwave
441	! (assume that particles are larger than wavelength even
442	! in longwave)
443	call delta_eddington_scat_od(od_sw_ice, scat_od_sw_ice, g_sw_ice)
444	end if
445
446	call delta_eddington_scat_od(od_lw_ice, scat_od_lw_ice, g_lw_ice)
447	else
448	! Ice not present: set properties to zero
449	od_lw_ice = 0.0_jprb
450	scat_od_lw_ice = 0.0_jprb
451	g_lw_ice = 0.0_jprb
452
453	od_sw_ice = 0.0_jprb
454	scat_od_sw_ice = 0.0_jprb
455	g_sw_ice = 0.0_jprb
456	end if ! Ice present
457
458	! Combine liquid and ice
459	if (config%do_lw_cloud_scattering) then
460	od_lw_cloud(:,jlev,jcol) = od_lw_liq + od_lw_ice
461	where (scat_od_lw_liq+scat_od_lw_ice > 0.0_jprb)
462	g_lw_cloud(:,jlev,jcol) = (g_lw_liq * scat_od_lw_liq &
463	& + g_lw_ice * scat_od_lw_ice) &
464	& / (scat_od_lw_liq+scat_od_lw_ice)
465	elsewhere
466	g_lw_cloud(:,jlev,jcol) = 0.0_jprb
467	end where
468	ssa_lw_cloud(:,jlev,jcol) = (scat_od_lw_liq + scat_od_lw_ice) &
469	& / (od_lw_liq + od_lw_ice)
470	else
471	! If longwave scattering is to be neglected then the
472	! best approximation is to set the optical depth equal
473	! to the absorption optical depth
474	od_lw_cloud(:,jlev,jcol) = od_lw_liq - scat_od_lw_liq &
475	& + od_lw_ice - scat_od_lw_ice
476	end if
477	od_sw_cloud(:,jlev,jcol) = od_sw_liq + od_sw_ice
478	g_sw_cloud(:,jlev,jcol) = (g_sw_liq * scat_od_sw_liq &
479	& + g_sw_ice * scat_od_sw_ice) &
480	& / (scat_od_sw_liq + scat_od_sw_ice)
481	ssa_sw_cloud(:,jlev,jcol) &
482	& = (scat_od_sw_liq + scat_od_sw_ice) / (od_sw_liq + od_sw_ice)
483	end if ! Cloud present
484	end do ! Loop over column
485	end do ! Loop over level
486
487	if (lhook) call dr_hook('radiation_cloud_optics:cloud_optics',1,hook_handle)
488
489	end subroutine cloud_optics
490
491	end module radiation_cloud_optics

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

Download in other formats:

Original Format