Context Navigation

radiation_cloud_optics.F90 @ 4444

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

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

Download in other formats:

Original Format