1 | ! radiation_interface.F90 - Public interface to radiation scheme |
---|
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-04-11 R. Hogan Changes to enable generalized surface description |
---|
17 | ! 2017-09-08 R. Hogan Reverted some changes |
---|
18 | ! |
---|
19 | ! To use the radiation scheme, create a configuration_type object, |
---|
20 | ! call "setup_radiation" on it once to load the look-up-tables and |
---|
21 | ! data describing how gas and hydrometeor absorption/scattering are to |
---|
22 | ! be represented, and call "radiation" multiple times on different |
---|
23 | ! input profiles. |
---|
24 | |
---|
25 | module radiation_interface |
---|
26 | |
---|
27 | implicit none |
---|
28 | |
---|
29 | public :: setup_radiation, set_gas_units, radiation |
---|
30 | private :: radiation_reverse |
---|
31 | |
---|
32 | contains |
---|
33 | |
---|
34 | !--------------------------------------------------------------------- |
---|
35 | ! Load the look-up-tables and data describing how gas and |
---|
36 | ! hydrometeor absorption/scattering are to be represented |
---|
37 | subroutine setup_radiation(config) |
---|
38 | |
---|
39 | use parkind1, only : jprb |
---|
40 | use yomhook, only : lhook, dr_hook |
---|
41 | use radiation_config, only : config_type, ISolverMcICA, & |
---|
42 | & IGasModelMonochromatic, IGasModelIFSRRTMG, IGasModelECCKD |
---|
43 | use radiation_spectral_definition, only & |
---|
44 | & : SolarReferenceTemperature, TerrestrialReferenceTemperature |
---|
45 | |
---|
46 | ! Currently there are two gas absorption models: RRTMG (default) |
---|
47 | ! and monochromatic |
---|
48 | use radiation_monochromatic, only : & |
---|
49 | & setup_gas_optics_mono => setup_gas_optics, & |
---|
50 | & setup_cloud_optics_mono => setup_cloud_optics, & |
---|
51 | & setup_aerosol_optics_mono => setup_aerosol_optics |
---|
52 | use radiation_ifs_rrtm, only : setup_gas_optics_rrtmg => setup_gas_optics |
---|
53 | use radiation_ecckd_interface,only : setup_gas_optics_ecckd => setup_gas_optics |
---|
54 | use radiation_cloud_optics, only : setup_cloud_optics |
---|
55 | use radiation_general_cloud_optics, only : setup_general_cloud_optics |
---|
56 | use radiation_aerosol_optics, only : setup_aerosol_optics |
---|
57 | |
---|
58 | type(config_type), intent(inout) :: config |
---|
59 | |
---|
60 | real(jprb) :: hook_handle |
---|
61 | |
---|
62 | if (lhook) call dr_hook('radiation_interface:setup_radiation',0,hook_handle) |
---|
63 | |
---|
64 | ! Consolidate configuration data, including setting data file |
---|
65 | ! names |
---|
66 | call config%consolidate() |
---|
67 | |
---|
68 | ! Load the look-up tables from files in the specified directory |
---|
69 | if (config%i_gas_model == IGasModelMonochromatic) then |
---|
70 | call setup_gas_optics_mono(config, trim(config%directory_name)) |
---|
71 | else if (config%i_gas_model == IGasModelIFSRRTMG) then |
---|
72 | call setup_gas_optics_rrtmg(config, trim(config%directory_name)) |
---|
73 | else if (config%i_gas_model == IGasModelECCKD) then |
---|
74 | call setup_gas_optics_ecckd(config) |
---|
75 | end if |
---|
76 | |
---|
77 | ! Whether or not the "radiation" subroutine needs ssa_lw and g_lw |
---|
78 | ! arrays depends on whether longwave scattering by aerosols is to |
---|
79 | ! be included. If not, one of the array dimensions will be set to |
---|
80 | ! zero. |
---|
81 | if (config%do_lw_aerosol_scattering) then |
---|
82 | config%n_g_lw_if_scattering = config%n_g_lw |
---|
83 | else |
---|
84 | config%n_g_lw_if_scattering = 0 |
---|
85 | end if |
---|
86 | |
---|
87 | ! Whether or not the "radiation" subroutine needs ssa_lw_cloud and |
---|
88 | ! g_lw_cloud arrays depends on whether longwave scattering by |
---|
89 | ! hydrometeors is to be included. If not, one of the array |
---|
90 | ! dimensions will be set to zero. |
---|
91 | if (config%do_lw_cloud_scattering) then |
---|
92 | config%n_bands_lw_if_scattering = config%n_bands_lw |
---|
93 | else |
---|
94 | config%n_bands_lw_if_scattering = 0 |
---|
95 | end if |
---|
96 | |
---|
97 | ! If we have longwave scattering and McICA then even if there is |
---|
98 | ! no aerosol, it is convenient if single scattering albedo and |
---|
99 | ! g factor arrays are allocated before the call to |
---|
100 | ! solver_lw as they will be needed. |
---|
101 | if (config%do_lw_cloud_scattering & |
---|
102 | & .and. config%i_solver_lw == ISolverMcICA) then |
---|
103 | config%n_g_lw_if_scattering = config%n_g_lw |
---|
104 | end if |
---|
105 | |
---|
106 | ! Consolidate the albedo/emissivity intervals with the shortwave |
---|
107 | ! and longwave spectral bands |
---|
108 | if (config%do_sw) then |
---|
109 | call config%consolidate_sw_albedo_intervals |
---|
110 | end if |
---|
111 | if (config%do_lw) then |
---|
112 | call config%consolidate_lw_emiss_intervals |
---|
113 | end if |
---|
114 | |
---|
115 | if (config%do_clouds) then |
---|
116 | if (config%i_gas_model == IGasModelMonochromatic) then |
---|
117 | ! call setup_cloud_optics_mono(config) |
---|
118 | elseif (config%use_general_cloud_optics) then |
---|
119 | call setup_general_cloud_optics(config) |
---|
120 | else |
---|
121 | call setup_cloud_optics(config) |
---|
122 | end if |
---|
123 | end if |
---|
124 | |
---|
125 | if (config%use_aerosols) then |
---|
126 | if (config%i_gas_model == IGasModelMonochromatic) then |
---|
127 | ! call setup_aerosol_optics_mono(config) |
---|
128 | else |
---|
129 | call setup_aerosol_optics(config) |
---|
130 | end if |
---|
131 | end if |
---|
132 | |
---|
133 | ! Load cloud water PDF look-up table for McICA |
---|
134 | if ( config%i_solver_sw == ISolverMcICA & |
---|
135 | & .or. config%i_solver_lw == ISolverMcICA) then |
---|
136 | call config%pdf_sampler%setup(config%cloud_pdf_file_name, & |
---|
137 | & iverbose=config%iverbosesetup) |
---|
138 | end if |
---|
139 | |
---|
140 | if (lhook) call dr_hook('radiation_interface:setup_radiation',1,hook_handle) |
---|
141 | |
---|
142 | end subroutine setup_radiation |
---|
143 | |
---|
144 | |
---|
145 | !--------------------------------------------------------------------- |
---|
146 | ! Scale the gas mixing ratios so that they have the units (and |
---|
147 | ! possibly scale factors) required by the specific gas absorption |
---|
148 | ! model. This subroutine simply passes the gas object on to the |
---|
149 | ! module of the currently active gas model. |
---|
150 | subroutine set_gas_units(config, gas) |
---|
151 | |
---|
152 | use radiation_config |
---|
153 | use radiation_gas, only : gas_type |
---|
154 | use radiation_monochromatic, only : set_gas_units_mono => set_gas_units |
---|
155 | use radiation_ifs_rrtm, only : set_gas_units_ifs => set_gas_units |
---|
156 | use radiation_ecckd_interface, only : set_gas_units_ecckd => set_gas_units |
---|
157 | |
---|
158 | type(config_type), intent(in) :: config |
---|
159 | type(gas_type), intent(inout) :: gas |
---|
160 | |
---|
161 | if (config%i_gas_model == IGasModelMonochromatic) then |
---|
162 | call set_gas_units_mono(gas) |
---|
163 | elseif (config%i_gas_model == IGasModelECCKD) then |
---|
164 | call set_gas_units_ecckd(gas) |
---|
165 | else |
---|
166 | call set_gas_units_ifs(gas) |
---|
167 | end if |
---|
168 | |
---|
169 | end subroutine set_gas_units |
---|
170 | |
---|
171 | |
---|
172 | !--------------------------------------------------------------------- |
---|
173 | ! Run the radiation scheme according to the configuration in the |
---|
174 | ! config object. There are ncol profiles of which only istartcol to |
---|
175 | ! iendcol are to be processed, and there are nlev model levels. The |
---|
176 | ! output fluxes are written to the flux object, and all other |
---|
177 | ! objects contain the input variables. The variables may be defined |
---|
178 | ! either in order of increasing or decreasing pressure, but if in |
---|
179 | ! order of decreasing pressure then radiation_reverse will be called |
---|
180 | ! to reverse the order for the computation and then reverse the |
---|
181 | ! order of the output fluxes to match the inputs. |
---|
182 | subroutine radiation(ncol, nlev, istartcol, iendcol, config, & |
---|
183 | & single_level, thermodynamics, gas, cloud, aerosol, flux) |
---|
184 | |
---|
185 | use parkind1, only : jprb |
---|
186 | use yomhook, only : lhook, dr_hook |
---|
187 | |
---|
188 | use radiation_io, only : nulout |
---|
189 | use radiation_config, only : config_type, & |
---|
190 | & IGasModelMonochromatic, IGasModelIFSRRTMG, & |
---|
191 | & ISolverMcICA, ISolverSpartacus, ISolverHomogeneous, & |
---|
192 | & ISolverTripleclouds |
---|
193 | use radiation_single_level, only : single_level_type |
---|
194 | use radiation_thermodynamics, only : thermodynamics_type |
---|
195 | use radiation_gas, only : gas_type |
---|
196 | use radiation_cloud, only : cloud_type |
---|
197 | use radiation_aerosol, only : aerosol_type |
---|
198 | use radiation_flux, only : flux_type |
---|
199 | use radiation_spartacus_sw, only : solver_spartacus_sw |
---|
200 | use radiation_spartacus_lw, only : solver_spartacus_lw |
---|
201 | use radiation_tripleclouds_sw,only : solver_tripleclouds_sw |
---|
202 | use radiation_tripleclouds_lw,only : solver_tripleclouds_lw |
---|
203 | use radiation_mcica_sw, only : solver_mcica_sw |
---|
204 | use radiation_mcica_lw, only : solver_mcica_lw |
---|
205 | use radiation_cloudless_sw, only : solver_cloudless_sw |
---|
206 | use radiation_cloudless_lw, only : solver_cloudless_lw |
---|
207 | use radiation_homogeneous_sw, only : solver_homogeneous_sw |
---|
208 | use radiation_homogeneous_lw, only : solver_homogeneous_lw |
---|
209 | use radiation_save, only : save_radiative_properties |
---|
210 | |
---|
211 | ! Treatment of gas and hydrometeor optics |
---|
212 | use radiation_monochromatic, only : & |
---|
213 | & gas_optics_mono => gas_optics, & |
---|
214 | & cloud_optics_mono => cloud_optics, & |
---|
215 | & add_aerosol_optics_mono => add_aerosol_optics |
---|
216 | use radiation_ifs_rrtm, only : gas_optics_rrtmg => gas_optics |
---|
217 | use radiation_ecckd_interface,only : gas_optics_ecckd => gas_optics |
---|
218 | use radiation_cloud_optics, only : cloud_optics |
---|
219 | use radiation_general_cloud_optics, only : general_cloud_optics |
---|
220 | use radiation_aerosol_optics, only : add_aerosol_optics |
---|
221 | |
---|
222 | ! Inputs |
---|
223 | integer, intent(in) :: ncol ! number of columns |
---|
224 | integer, intent(in) :: nlev ! number of model levels |
---|
225 | integer, intent(in) :: istartcol, iendcol ! range of columns to process |
---|
226 | type(config_type), intent(in) :: config |
---|
227 | type(single_level_type), intent(in) :: single_level |
---|
228 | type(thermodynamics_type),intent(in) :: thermodynamics |
---|
229 | type(gas_type), intent(in) :: gas |
---|
230 | type(cloud_type), intent(inout):: cloud |
---|
231 | type(aerosol_type), intent(in) :: aerosol |
---|
232 | ! Output |
---|
233 | type(flux_type), intent(inout):: flux |
---|
234 | |
---|
235 | |
---|
236 | ! Local variables |
---|
237 | |
---|
238 | ! Layer optical depth, single scattering albedo and asymmetry factor of |
---|
239 | ! gases and aerosols at each longwave g-point, where the latter |
---|
240 | ! two variables are only defined if aerosol longwave scattering is |
---|
241 | ! enabled (otherwise both are treated as zero). |
---|
242 | real(jprb), dimension(config%n_g_lw,nlev,istartcol:iendcol) :: od_lw |
---|
243 | real(jprb), dimension(config%n_g_lw_if_scattering,nlev,istartcol:iendcol) :: & |
---|
244 | & ssa_lw, g_lw |
---|
245 | |
---|
246 | ! Layer in-cloud optical depth, single scattering albedo and |
---|
247 | ! asymmetry factor of hydrometeors in each longwave band, where |
---|
248 | ! the latter two variables are only defined if hydrometeor |
---|
249 | ! longwave scattering is enabled (otherwise both are treated as |
---|
250 | ! zero). |
---|
251 | real(jprb), dimension(config%n_bands_lw,nlev,istartcol:iendcol) :: od_lw_cloud |
---|
252 | real(jprb), dimension(config%n_bands_lw_if_scattering,nlev,istartcol:iendcol) :: & |
---|
253 | & ssa_lw_cloud, g_lw_cloud |
---|
254 | |
---|
255 | ! Layer optical depth, single scattering albedo and asymmetry factor of |
---|
256 | ! gases and aerosols at each shortwave g-point |
---|
257 | real(jprb), dimension(config%n_g_sw,nlev,istartcol:iendcol) :: od_sw, ssa_sw, g_sw |
---|
258 | |
---|
259 | ! Layer in-cloud optical depth, single scattering albedo and |
---|
260 | ! asymmetry factor of hydrometeors in each shortwave band |
---|
261 | real(jprb), dimension(config%n_bands_sw,nlev,istartcol:iendcol) :: & |
---|
262 | & od_sw_cloud, ssa_sw_cloud, g_sw_cloud |
---|
263 | |
---|
264 | ! The Planck function (emitted flux from a black body) at half |
---|
265 | ! levels |
---|
266 | real(jprb), dimension(config%n_g_lw,nlev+1,istartcol:iendcol) :: planck_hl |
---|
267 | |
---|
268 | ! The longwave emission from and albedo of the surface in each |
---|
269 | ! longwave g-point; note that these are weighted averages of the |
---|
270 | ! values from individual tiles |
---|
271 | real(jprb), dimension(config%n_g_lw, istartcol:iendcol) :: lw_emission |
---|
272 | real(jprb), dimension(config%n_g_lw, istartcol:iendcol) :: lw_albedo |
---|
273 | |
---|
274 | ! Direct and diffuse shortwave surface albedo in each shortwave |
---|
275 | ! g-point; note that these are weighted averages of the values |
---|
276 | ! from individual tiles |
---|
277 | real(jprb), dimension(config%n_g_sw, istartcol:iendcol) :: sw_albedo_direct |
---|
278 | real(jprb), dimension(config%n_g_sw, istartcol:iendcol) :: sw_albedo_diffuse |
---|
279 | |
---|
280 | ! The incoming shortwave flux into a plane perpendicular to the |
---|
281 | ! incoming radiation at top-of-atmosphere in each of the shortwave |
---|
282 | ! g-points |
---|
283 | real(jprb), dimension(config%n_g_sw,istartcol:iendcol) :: incoming_sw |
---|
284 | |
---|
285 | character(len=100) :: rad_prop_file_name |
---|
286 | character(*), parameter :: rad_prop_base_file_name = "radiative_properties" |
---|
287 | |
---|
288 | real(jprb) :: hook_handle |
---|
289 | |
---|
290 | if (lhook) call dr_hook('radiation_interface:radiation',0,hook_handle) |
---|
291 | |
---|
292 | if (thermodynamics%pressure_hl(istartcol,2) & |
---|
293 | & < thermodynamics%pressure_hl(istartcol,1)) then |
---|
294 | ! Input arrays are arranged in order of decreasing pressure / |
---|
295 | ! increasing height: the following subroutine reverses them, |
---|
296 | ! call the radiation scheme and then reverses the returned |
---|
297 | ! fluxes |
---|
298 | call radiation_reverse(ncol, nlev, istartcol, iendcol, config, & |
---|
299 | & single_level, thermodynamics, gas, cloud, aerosol, flux) |
---|
300 | else |
---|
301 | |
---|
302 | ! Input arrays arranged in order of increasing pressure / |
---|
303 | ! decreasing height: progress normally |
---|
304 | |
---|
305 | ! Extract surface albedos at each gridpoint |
---|
306 | call single_level%get_albedos(istartcol, iendcol, config, & |
---|
307 | & sw_albedo_direct, sw_albedo_diffuse, & |
---|
308 | & lw_albedo) |
---|
309 | |
---|
310 | ! Compute gas absorption optical depth in shortwave and |
---|
311 | ! longwave, shortwave single scattering albedo (i.e. fraction of |
---|
312 | ! extinction due to Rayleigh scattering), Planck functions and |
---|
313 | ! incoming shortwave flux at each g-point, for the specified |
---|
314 | ! range of atmospheric columns |
---|
315 | if (config%i_gas_model == IGasModelMonochromatic) then |
---|
316 | call gas_optics_mono(ncol,nlev,istartcol,iendcol, config, & |
---|
317 | & single_level, thermodynamics, gas, lw_albedo, & |
---|
318 | & od_lw, od_sw, ssa_sw, & |
---|
319 | & planck_hl, lw_emission, incoming_sw) |
---|
320 | else if (config%i_gas_model == IGasModelIFSRRTMG) then |
---|
321 | call gas_optics_rrtmg(ncol,nlev,istartcol,iendcol, config, & |
---|
322 | & single_level, thermodynamics, gas, & |
---|
323 | & od_lw, od_sw, ssa_sw, lw_albedo=lw_albedo, & |
---|
324 | & planck_hl=planck_hl, lw_emission=lw_emission, & |
---|
325 | & incoming_sw=incoming_sw) |
---|
326 | else |
---|
327 | call gas_optics_ecckd(ncol,nlev,istartcol,iendcol, config, & |
---|
328 | & single_level, thermodynamics, gas, & |
---|
329 | & od_lw, od_sw, ssa_sw, lw_albedo=lw_albedo, & |
---|
330 | & planck_hl=planck_hl, lw_emission=lw_emission, & |
---|
331 | & incoming_sw=incoming_sw) |
---|
332 | end if |
---|
333 | |
---|
334 | if (config%do_clouds) then |
---|
335 | ! Crop the cloud fraction to remove clouds that have too small |
---|
336 | ! a fraction or water content; after this, we can safely |
---|
337 | ! assume that a cloud is present if cloud%fraction > 0.0. |
---|
338 | call cloud%crop_cloud_fraction(istartcol, iendcol, & |
---|
339 | & config%cloud_fraction_threshold, & |
---|
340 | & config%cloud_mixing_ratio_threshold) |
---|
341 | |
---|
342 | ! Compute hydrometeor absorption/scattering properties in each |
---|
343 | ! shortwave and longwave band |
---|
344 | if (config%i_gas_model == IGasModelMonochromatic) then |
---|
345 | call cloud_optics_mono(nlev, istartcol, iendcol, & |
---|
346 | & config, thermodynamics, cloud, & |
---|
347 | & od_lw_cloud, ssa_lw_cloud, g_lw_cloud, & |
---|
348 | & od_sw_cloud, ssa_sw_cloud, g_sw_cloud) |
---|
349 | elseif (config%use_general_cloud_optics) then |
---|
350 | call general_cloud_optics(nlev, istartcol, iendcol, & |
---|
351 | & config, thermodynamics, cloud, & |
---|
352 | & od_lw_cloud, ssa_lw_cloud, g_lw_cloud, & |
---|
353 | & od_sw_cloud, ssa_sw_cloud, g_sw_cloud) |
---|
354 | else |
---|
355 | call cloud_optics(nlev, istartcol, iendcol, & |
---|
356 | & config, thermodynamics, cloud, & |
---|
357 | & od_lw_cloud, ssa_lw_cloud, g_lw_cloud, & |
---|
358 | & od_sw_cloud, ssa_sw_cloud, g_sw_cloud) |
---|
359 | end if |
---|
360 | end if ! do_clouds |
---|
361 | |
---|
362 | if (config%use_aerosols) then |
---|
363 | if (config%i_gas_model == IGasModelMonochromatic) then |
---|
364 | ! call add_aerosol_optics_mono(nlev,istartcol,iendcol, & |
---|
365 | ! & config, thermodynamics, gas, aerosol, & |
---|
366 | ! & od_lw, ssa_lw, g_lw, od_sw, ssa_sw, g_sw) |
---|
367 | else |
---|
368 | call add_aerosol_optics(nlev,istartcol,iendcol, & |
---|
369 | & config, thermodynamics, gas, aerosol, & |
---|
370 | & od_lw, ssa_lw, g_lw, od_sw, ssa_sw, g_sw) |
---|
371 | end if |
---|
372 | else |
---|
373 | g_sw(:,:,istartcol:iendcol) = 0.0_jprb |
---|
374 | if (config%do_lw_aerosol_scattering) then |
---|
375 | ssa_lw(:,:,istartcol:iendcol) = 0.0_jprb |
---|
376 | g_lw(:,:,istartcol:iendcol) = 0.0_jprb |
---|
377 | end if |
---|
378 | end if |
---|
379 | |
---|
380 | ! For diagnostic purposes, save these intermediate variables to |
---|
381 | ! a NetCDF file |
---|
382 | if (config%do_save_radiative_properties) then |
---|
383 | if (istartcol == 1 .and. iendcol == ncol) then |
---|
384 | rad_prop_file_name = rad_prop_base_file_name // ".nc" |
---|
385 | else |
---|
386 | write(rad_prop_file_name,'(a,a,i4.4,a,i4.4,a)') & |
---|
387 | & rad_prop_base_file_name, '_', istartcol, '-',iendcol,'.nc' |
---|
388 | end if |
---|
389 | call save_radiative_properties(trim(rad_prop_file_name), & |
---|
390 | & nlev, istartcol, iendcol, & |
---|
391 | & config, single_level, thermodynamics, cloud, & |
---|
392 | & planck_hl, lw_emission, lw_albedo, & |
---|
393 | & sw_albedo_direct, sw_albedo_diffuse, incoming_sw, & |
---|
394 | & od_lw, ssa_lw, g_lw, od_sw, ssa_sw, g_sw, & |
---|
395 | & od_lw_cloud, ssa_lw_cloud, g_lw_cloud, & |
---|
396 | & od_sw_cloud, ssa_sw_cloud, g_sw_cloud) |
---|
397 | end if |
---|
398 | |
---|
399 | if (config%do_lw) then |
---|
400 | if (config%iverbose >= 2) then |
---|
401 | write(nulout,'(a)') 'Computing longwave fluxes' |
---|
402 | end if |
---|
403 | |
---|
404 | if (config%i_solver_lw == ISolverMcICA) then |
---|
405 | ! Compute fluxes using the McICA longwave solver |
---|
406 | call solver_mcica_lw(nlev,istartcol,iendcol, & |
---|
407 | & config, single_level, cloud, & |
---|
408 | & od_lw, ssa_lw, g_lw, od_lw_cloud, ssa_lw_cloud, & |
---|
409 | & g_lw_cloud, planck_hl, lw_emission, lw_albedo, flux) |
---|
410 | else if (config%i_solver_lw == ISolverSPARTACUS) then |
---|
411 | ! Compute fluxes using the SPARTACUS longwave solver |
---|
412 | call solver_spartacus_lw(nlev,istartcol,iendcol, & |
---|
413 | & config, thermodynamics, cloud, & |
---|
414 | & od_lw, ssa_lw, g_lw, od_lw_cloud, ssa_lw_cloud, g_lw_cloud, & |
---|
415 | & planck_hl, lw_emission, lw_albedo, flux) |
---|
416 | else if (config%i_solver_lw == ISolverTripleclouds) then |
---|
417 | ! Compute fluxes using the Tripleclouds longwave solver |
---|
418 | call solver_tripleclouds_lw(nlev,istartcol,iendcol, & |
---|
419 | & config, cloud, & |
---|
420 | & od_lw, ssa_lw, g_lw, od_lw_cloud, ssa_lw_cloud, g_lw_cloud, & |
---|
421 | & planck_hl, lw_emission, lw_albedo, flux) |
---|
422 | elseif (config%i_solver_lw == ISolverHomogeneous) then |
---|
423 | ! Compute fluxes using the homogeneous solver |
---|
424 | call solver_homogeneous_lw(nlev,istartcol,iendcol, & |
---|
425 | & config, cloud, & |
---|
426 | & od_lw, ssa_lw, g_lw, od_lw_cloud, ssa_lw_cloud, & |
---|
427 | & g_lw_cloud, planck_hl, lw_emission, lw_albedo, flux) |
---|
428 | else |
---|
429 | ! Compute fluxes using the cloudless solver |
---|
430 | call solver_cloudless_lw(nlev,istartcol,iendcol, & |
---|
431 | & config, od_lw, ssa_lw, g_lw, & |
---|
432 | & planck_hl, lw_emission, lw_albedo, flux) |
---|
433 | end if |
---|
434 | end if |
---|
435 | |
---|
436 | if (config%do_sw) then |
---|
437 | if (config%iverbose >= 2) then |
---|
438 | write(nulout,'(a)') 'Computing shortwave fluxes' |
---|
439 | end if |
---|
440 | |
---|
441 | if (config%i_solver_sw == ISolverMcICA) then |
---|
442 | ! Compute fluxes using the McICA shortwave solver |
---|
443 | call solver_mcica_sw(nlev,istartcol,iendcol, & |
---|
444 | & config, single_level, cloud, & |
---|
445 | & od_sw, ssa_sw, g_sw, od_sw_cloud, ssa_sw_cloud, & |
---|
446 | & g_sw_cloud, sw_albedo_direct, sw_albedo_diffuse, & |
---|
447 | & incoming_sw, flux) |
---|
448 | else if (config%i_solver_sw == ISolverSPARTACUS) then |
---|
449 | ! Compute fluxes using the SPARTACUS shortwave solver |
---|
450 | call solver_spartacus_sw(nlev,istartcol,iendcol, & |
---|
451 | & config, single_level, thermodynamics, cloud, & |
---|
452 | & od_sw, ssa_sw, g_sw, od_sw_cloud, ssa_sw_cloud, & |
---|
453 | & g_sw_cloud, sw_albedo_direct, sw_albedo_diffuse, & |
---|
454 | & incoming_sw, flux) |
---|
455 | else if (config%i_solver_sw == ISolverTripleclouds) then |
---|
456 | ! Compute fluxes using the Tripleclouds shortwave solver |
---|
457 | call solver_tripleclouds_sw(nlev,istartcol,iendcol, & |
---|
458 | & config, single_level, cloud, & |
---|
459 | & od_sw, ssa_sw, g_sw, od_sw_cloud, ssa_sw_cloud, & |
---|
460 | & g_sw_cloud, sw_albedo_direct, sw_albedo_diffuse, & |
---|
461 | & incoming_sw, flux) |
---|
462 | elseif (config%i_solver_sw == ISolverHomogeneous) then |
---|
463 | ! Compute fluxes using the homogeneous solver |
---|
464 | call solver_homogeneous_sw(nlev,istartcol,iendcol, & |
---|
465 | & config, single_level, cloud, & |
---|
466 | & od_sw, ssa_sw, g_sw, od_sw_cloud, ssa_sw_cloud, & |
---|
467 | & g_sw_cloud, sw_albedo_direct, sw_albedo_diffuse, & |
---|
468 | & incoming_sw, flux) |
---|
469 | else |
---|
470 | ! Compute fluxes using the cloudless solver |
---|
471 | call solver_cloudless_sw(nlev,istartcol,iendcol, & |
---|
472 | & config, single_level, od_sw, ssa_sw, g_sw, & |
---|
473 | & sw_albedo_direct, sw_albedo_diffuse, & |
---|
474 | & incoming_sw, flux) |
---|
475 | end if |
---|
476 | end if |
---|
477 | |
---|
478 | ! Store surface downwelling fluxes in bands from fluxes in g |
---|
479 | ! points |
---|
480 | call flux%calc_surface_spectral(config, istartcol, iendcol) |
---|
481 | |
---|
482 | end if |
---|
483 | |
---|
484 | if (lhook) call dr_hook('radiation_interface:radiation',1,hook_handle) |
---|
485 | |
---|
486 | end subroutine radiation |
---|
487 | |
---|
488 | |
---|
489 | !--------------------------------------------------------------------- |
---|
490 | ! If the input arrays are arranged in order of decreasing pressure / |
---|
491 | ! increasing height then this subroutine reverses them, calls the |
---|
492 | ! radiation scheme and then reverses the returned fluxes. Since this |
---|
493 | ! subroutine calls, and is called by "radiation", it must be in this |
---|
494 | ! module to avoid circular dependencies. |
---|
495 | subroutine radiation_reverse(ncol, nlev, istartcol, iendcol, config, & |
---|
496 | & single_level, thermodynamics, gas, cloud, aerosol, flux) |
---|
497 | |
---|
498 | use parkind1, only : jprb |
---|
499 | |
---|
500 | use radiation_io, only : nulout |
---|
501 | use radiation_config, only : config_type |
---|
502 | use radiation_single_level, only : single_level_type |
---|
503 | use radiation_thermodynamics, only : thermodynamics_type |
---|
504 | use radiation_gas, only : gas_type |
---|
505 | use radiation_cloud, only : cloud_type |
---|
506 | use radiation_aerosol, only : aerosol_type |
---|
507 | use radiation_flux, only : flux_type |
---|
508 | |
---|
509 | ! Inputs |
---|
510 | integer, intent(in) :: ncol ! number of columns |
---|
511 | integer, intent(in) :: nlev ! number of model levels |
---|
512 | integer, intent(in) :: istartcol, iendcol ! range of columns to process |
---|
513 | type(config_type), intent(in) :: config |
---|
514 | type(single_level_type), intent(in) :: single_level |
---|
515 | type(thermodynamics_type),intent(in) :: thermodynamics |
---|
516 | type(gas_type), intent(in) :: gas |
---|
517 | type(cloud_type), intent(in) :: cloud |
---|
518 | type(aerosol_type), intent(in) :: aerosol |
---|
519 | ! Output |
---|
520 | type(flux_type), intent(inout):: flux |
---|
521 | |
---|
522 | ! Reversed data structures |
---|
523 | type(thermodynamics_type) :: thermodynamics_rev |
---|
524 | type(gas_type) :: gas_rev |
---|
525 | type(cloud_type) :: cloud_rev |
---|
526 | type(aerosol_type) :: aerosol_rev |
---|
527 | type(flux_type) :: flux_rev |
---|
528 | |
---|
529 | ! Start and end levels for aerosol data |
---|
530 | integer :: istartlev, iendlev |
---|
531 | |
---|
532 | if (config%iverbose >= 2) then |
---|
533 | write(nulout,'(a)') 'Reversing arrays to be in order of increasing pressure' |
---|
534 | end if |
---|
535 | |
---|
536 | ! Allocate reversed arrays |
---|
537 | call thermodynamics_rev%allocate(ncol, nlev) |
---|
538 | call cloud_rev%allocate(ncol, nlev) |
---|
539 | call flux_rev%allocate(config, istartcol, iendcol, nlev) |
---|
540 | if (allocated(aerosol%mixing_ratio)) then |
---|
541 | istartlev = nlev + 1 - aerosol%iendlev |
---|
542 | iendlev = nlev + 1 - aerosol%istartlev |
---|
543 | call aerosol_rev%allocate(ncol, istartlev, iendlev, & |
---|
544 | & config%n_aerosol_types) |
---|
545 | end if |
---|
546 | |
---|
547 | ! Fill reversed thermodynamic arrays |
---|
548 | thermodynamics_rev%pressure_hl(istartcol:iendcol,:) & |
---|
549 | & = thermodynamics%pressure_hl(istartcol:iendcol, nlev+1:1:-1) |
---|
550 | thermodynamics_rev%temperature_hl(istartcol:iendcol,:) & |
---|
551 | & = thermodynamics%temperature_hl(istartcol:iendcol, nlev+1:1:-1) |
---|
552 | |
---|
553 | ! Fill reversed gas arrays |
---|
554 | call gas%reverse(istartcol, iendcol, gas_rev) |
---|
555 | |
---|
556 | if (config%do_clouds) then |
---|
557 | ! Fill reversed cloud arrays |
---|
558 | cloud_rev%q_liq(istartcol:iendcol,:) & |
---|
559 | & = cloud%q_liq(istartcol:iendcol,nlev:1:-1) |
---|
560 | cloud_rev%re_liq(istartcol:iendcol,:) & |
---|
561 | & = cloud%re_liq(istartcol:iendcol,nlev:1:-1) |
---|
562 | cloud_rev%q_ice(istartcol:iendcol,:) & |
---|
563 | & = cloud%q_ice(istartcol:iendcol,nlev:1:-1) |
---|
564 | cloud_rev%re_ice(istartcol:iendcol,:) & |
---|
565 | & = cloud%re_ice(istartcol:iendcol,nlev:1:-1) |
---|
566 | cloud_rev%fraction(istartcol:iendcol,:) & |
---|
567 | & = cloud%fraction(istartcol:iendcol,nlev:1:-1) |
---|
568 | cloud_rev%overlap_param(istartcol:iendcol,:) & |
---|
569 | & = cloud%overlap_param(istartcol:iendcol,nlev-1:1:-1) |
---|
570 | if (allocated(cloud%fractional_std)) then |
---|
571 | cloud_rev%fractional_std(istartcol:iendcol,:) & |
---|
572 | & = cloud%fractional_std(istartcol:iendcol,nlev:1:-1) |
---|
573 | else |
---|
574 | cloud_rev%fractional_std(istartcol:iendcol,:) = 0.0_jprb |
---|
575 | end if |
---|
576 | if (allocated(cloud%inv_cloud_effective_size)) then |
---|
577 | cloud_rev%inv_cloud_effective_size(istartcol:iendcol,:) & |
---|
578 | & = cloud%inv_cloud_effective_size(istartcol:iendcol,nlev:1:-1) |
---|
579 | else |
---|
580 | cloud_rev%inv_cloud_effective_size(istartcol:iendcol,:) = 0.0_jprb |
---|
581 | end if |
---|
582 | end if |
---|
583 | |
---|
584 | if (allocated(aerosol%mixing_ratio)) then |
---|
585 | aerosol_rev%mixing_ratio(:,istartlev:iendlev,:) & |
---|
586 | & = aerosol%mixing_ratio(:,aerosol%iendlev:aerosol%istartlev:-1,:) |
---|
587 | end if |
---|
588 | |
---|
589 | ! Run radiation scheme on reversed profiles |
---|
590 | call radiation(ncol, nlev,istartcol,iendcol, & |
---|
591 | & config, single_level, thermodynamics_rev, gas_rev, & |
---|
592 | & cloud_rev, aerosol_rev, flux_rev) |
---|
593 | |
---|
594 | ! Reorder fluxes |
---|
595 | if (allocated(flux%lw_up)) then |
---|
596 | flux%lw_up(istartcol:iendcol,:) & |
---|
597 | & = flux_rev%lw_up(istartcol:iendcol,nlev+1:1:-1) |
---|
598 | flux%lw_dn(istartcol:iendcol,:) & |
---|
599 | & = flux_rev%lw_dn(istartcol:iendcol,nlev+1:1:-1) |
---|
600 | if (allocated(flux%lw_up_clear)) then |
---|
601 | flux%lw_up_clear(istartcol:iendcol,:) & |
---|
602 | & = flux_rev%lw_up_clear(istartcol:iendcol,nlev+1:1:-1) |
---|
603 | flux%lw_dn_clear(istartcol:iendcol,:) & |
---|
604 | & = flux_rev%lw_dn_clear(istartcol:iendcol,nlev+1:1:-1) |
---|
605 | end if |
---|
606 | end if |
---|
607 | if (allocated(flux%sw_up)) then |
---|
608 | flux%sw_up(istartcol:iendcol,:) & |
---|
609 | & = flux_rev%sw_up(istartcol:iendcol,nlev+1:1:-1) |
---|
610 | flux%sw_dn(istartcol:iendcol,:) & |
---|
611 | & = flux_rev%sw_dn(istartcol:iendcol,nlev+1:1:-1) |
---|
612 | if (allocated(flux%sw_dn_direct)) then |
---|
613 | flux%sw_dn_direct(istartcol:iendcol,:) & |
---|
614 | & = flux_rev%sw_dn_direct(istartcol:iendcol,nlev+1:1:-1) |
---|
615 | end if |
---|
616 | if (allocated(flux%sw_up_clear)) then |
---|
617 | flux%sw_up_clear(istartcol:iendcol,:) & |
---|
618 | & = flux_rev%sw_up_clear(istartcol:iendcol,nlev+1:1:-1) |
---|
619 | flux%sw_dn_clear(istartcol:iendcol,:) & |
---|
620 | & = flux_rev%sw_dn_clear(istartcol:iendcol,nlev+1:1:-1) |
---|
621 | if (allocated(flux%sw_dn_direct_clear)) then |
---|
622 | flux%sw_dn_direct_clear(istartcol:iendcol,:) & |
---|
623 | & = flux_rev%sw_dn_direct_clear(istartcol:iendcol,nlev+1:1:-1) |
---|
624 | end if |
---|
625 | end if |
---|
626 | end if |
---|
627 | |
---|
628 | ! Deallocate reversed arrays |
---|
629 | call thermodynamics_rev%deallocate |
---|
630 | call gas_rev%deallocate |
---|
631 | call cloud_rev%deallocate |
---|
632 | call flux_rev%deallocate |
---|
633 | if (allocated(aerosol%mixing_ratio)) then |
---|
634 | call aerosol_rev%deallocate |
---|
635 | end if |
---|
636 | |
---|
637 | end subroutine radiation_reverse |
---|
638 | |
---|
639 | end module radiation_interface |
---|