Context Navigation

radiation_cloud_optics.F90 @ 4660

Last change on this file since 4660 was 4489, checked in by lguez, 21 months ago
Merge LMDZ_ECRad branch back into trunk!
File size: 23.2 KB

Rev	Line
[3908]	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
[4489]	21
[3908]	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
[4489]	274	integer :: jcol, jlev, jb
[3908]	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
[4489]	348	! Delta-Eddington scaling in the shortwave only
[3908]	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
[4489]	352	!call delta_eddington_scat_od(od_lw_liq, scat_od_lw_liq, g_lw_liq)
	353
[3908]	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
[4489]	442	! Delta-Eddington scaling in both longwave and shortwave
	443	! (assume that particles are larger than wavelength even
	444	! in longwave)
[3908]	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
[4489]	448	call delta_eddington_scat_od(od_lw_ice, scat_od_lw_ice, g_lw_ice)
[3908]	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
[4489]	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
[3908]	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
[4489]	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
[3908]	487	end if
[4489]	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
[3908]	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