1 | ! ecrad_driver_read_input.F90 - Read input structures from NetCDF file |
---|
2 | ! |
---|
3 | ! (C) Copyright 2018- 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 | module ecrad_driver_read_input |
---|
16 | |
---|
17 | public |
---|
18 | |
---|
19 | contains |
---|
20 | |
---|
21 | subroutine read_input(file, config, driver_config, ncol, nlev, & |
---|
22 | & single_level, thermodynamics, & |
---|
23 | & gas, cloud, aerosol) |
---|
24 | |
---|
25 | use parkind1, only : jprb, jpim |
---|
26 | use radiation_io, only : nulout |
---|
27 | use radiation_config, only : config_type, ISolverSPARTACUS |
---|
28 | use ecrad_driver_config, only : driver_config_type |
---|
29 | use radiation_single_level, only : single_level_type |
---|
30 | use radiation_thermodynamics, only : thermodynamics_type |
---|
31 | use radiation_gas, only : gas_type, & |
---|
32 | & IVolumeMixingRatio, IMassMixingRatio, & |
---|
33 | & IH2O, ICO2, IO3, IN2O, ICO, ICH4, IO2, ICFC11, ICFC12, & |
---|
34 | & IHCFC22, ICCl4, INO2, GasName, GasLowerCaseName, NMaxGases |
---|
35 | use radiation_cloud, only : cloud_type |
---|
36 | use radiation_aerosol, only : aerosol_type |
---|
37 | use easy_netcdf, only : netcdf_file |
---|
38 | |
---|
39 | implicit none |
---|
40 | |
---|
41 | type(netcdf_file), intent(in) :: file |
---|
42 | type(config_type), intent(in) :: config |
---|
43 | type(driver_config_type), intent(in) :: driver_config |
---|
44 | type(single_level_type), intent(inout) :: single_level |
---|
45 | type(thermodynamics_type), intent(inout) :: thermodynamics |
---|
46 | type(gas_type), intent(inout) :: gas |
---|
47 | type(cloud_type), target, intent(inout) :: cloud |
---|
48 | type(aerosol_type), intent(inout) :: aerosol |
---|
49 | |
---|
50 | ! Number of columns and levels of input data |
---|
51 | integer, intent(out) :: ncol, nlev |
---|
52 | |
---|
53 | integer :: ngases ! Num of gases with concs described in 2D |
---|
54 | integer :: nwellmixedgases ! Num of globally well-mixed gases |
---|
55 | |
---|
56 | ! Mixing ratio of gases described in 2D (ncol,nlev); this is |
---|
57 | ! volume mixing ratio (m3/m3) except for water vapour and ozone |
---|
58 | ! for which it is mass mixing ratio (kg/kg) |
---|
59 | real(jprb), allocatable, dimension(:,:) :: gas_mr |
---|
60 | |
---|
61 | ! Volume mixing ratio (m3/m3) of globally well-mixed gases |
---|
62 | real(jprb) :: well_mixed_gas_vmr |
---|
63 | |
---|
64 | ! Name of gas concentration variable in the file |
---|
65 | character(40) :: gas_var_name |
---|
66 | |
---|
67 | ! Cloud overlap decorrelation length (m) |
---|
68 | real(jprb), parameter :: decorr_length_default = 2000.0_jprb |
---|
69 | |
---|
70 | ! General property to be read and then modified before used in an |
---|
71 | ! ecRad structure |
---|
72 | real(jprb), allocatable, dimension(:,:) :: prop_2d |
---|
73 | |
---|
74 | integer :: jgas ! Loop index for reading gases |
---|
75 | integer :: irank ! Dimensions of gas data |
---|
76 | |
---|
77 | ! Can we scale cloud size using namelist parameters? No if the |
---|
78 | ! cloud size came from namelist parameters in the first place, yes |
---|
79 | ! if it came from the NetCDF file in the first place |
---|
80 | logical :: is_cloud_size_scalable |
---|
81 | |
---|
82 | ! The following calls read in the data, allocating memory for 1D and |
---|
83 | ! 2D arrays. The program will stop if any variables are not found. |
---|
84 | |
---|
85 | ! Pressure and temperature (SI units) are on half-levels, i.e. of |
---|
86 | ! length (ncol,nlev+1) |
---|
87 | call file%get('pressure_hl', thermodynamics%pressure_hl) |
---|
88 | call file%get('temperature_hl',thermodynamics%temperature_hl) |
---|
89 | |
---|
90 | ! Extract array dimensions |
---|
91 | ncol = size(thermodynamics%pressure_hl,1) |
---|
92 | nlev = size(thermodynamics%pressure_hl,2)-1 |
---|
93 | |
---|
94 | if (driver_config%solar_irradiance_override > 0.0_jprb) then |
---|
95 | ! Optional override of solar irradiance |
---|
96 | single_level%solar_irradiance = driver_config%solar_irradiance_override |
---|
97 | if (driver_config%iverbose >= 2) then |
---|
98 | write(nulout,'(a,f10.1)') ' Overriding solar irradiance with ', & |
---|
99 | & driver_config%solar_irradiance_override |
---|
100 | end if |
---|
101 | else if (file%exists('solar_irradiance')) then |
---|
102 | call file%get('solar_irradiance', single_level%solar_irradiance) |
---|
103 | else |
---|
104 | single_level%solar_irradiance = 1366.0_jprb |
---|
105 | if (driver_config%iverbose >= 1 .and. config%do_sw) then |
---|
106 | write(nulout,'(a,g10.3,a)') 'Warning: solar irradiance set to ', & |
---|
107 | & single_level%solar_irradiance, ' W m-2' |
---|
108 | end if |
---|
109 | end if |
---|
110 | |
---|
111 | ! Configure the amplitude of the spectral variations in solar |
---|
112 | ! output associated with the 11-year solar cycle: +1.0 means solar |
---|
113 | ! maximum, -1.0 means solar minimum, 0.0 means use the mean solar |
---|
114 | ! spectrum. |
---|
115 | if (driver_config%solar_cycle_multiplier_override > -1.0e6_jprb) then |
---|
116 | single_level%spectral_solar_cycle_multiplier & |
---|
117 | & = driver_config%solar_cycle_multiplier_override |
---|
118 | if (driver_config%iverbose >= 2) then |
---|
119 | write(nulout,'(a,f10.1)') ' Overriding solar spectral multiplier with ', & |
---|
120 | & driver_config%solar_cycle_multiplier_override |
---|
121 | end if |
---|
122 | else if (file%exists('solar_spectral_multiplier')) then |
---|
123 | call file%get('spectral_solar_cycle_multiplier', single_level%spectral_solar_cycle_multiplier) |
---|
124 | else |
---|
125 | single_level%spectral_solar_cycle_multiplier = 0.0_jprb |
---|
126 | end if |
---|
127 | |
---|
128 | if (driver_config%cos_sza_override >= 0.0_jprb) then |
---|
129 | ! Optional override of cosine of solar zenith angle |
---|
130 | allocate(single_level%cos_sza(ncol)) |
---|
131 | single_level%cos_sza = driver_config%cos_sza_override |
---|
132 | if (driver_config%iverbose >= 2) then |
---|
133 | write(nulout,'(a,g10.3)') ' Overriding cosine of the solar zenith angle with ', & |
---|
134 | & driver_config%cos_sza_override |
---|
135 | end if |
---|
136 | else if (file%exists('cos_solar_zenith_angle')) then |
---|
137 | ! Single-level variables, all with dimensions (ncol) |
---|
138 | call file%get('cos_solar_zenith_angle',single_level%cos_sza) |
---|
139 | else if (.not. config%do_sw) then |
---|
140 | ! If cos_solar_zenith_angle not present and shortwave radiation |
---|
141 | ! not to be performed, we create an array of zeros as some gas |
---|
142 | ! optics schemes still need to be run in the shortwave |
---|
143 | allocate(single_level%cos_sza(ncol)) |
---|
144 | single_level%cos_sza = 0.0_jprb |
---|
145 | else |
---|
146 | write(nulout,'(a,a)') '*** Error: cos_solar_zenith_angle not provided' |
---|
147 | stop |
---|
148 | end if |
---|
149 | |
---|
150 | if (config%do_clouds) then |
---|
151 | |
---|
152 | ! -------------------------------------------------------- |
---|
153 | ! Read cloud properties needed by most solvers |
---|
154 | ! -------------------------------------------------------- |
---|
155 | |
---|
156 | ! Read cloud descriptors with dimensions (ncol, nlev) |
---|
157 | call file%get('cloud_fraction',cloud%fraction) |
---|
158 | |
---|
159 | ! Fractional standard deviation of in-cloud water content |
---|
160 | if (file%exists('fractional_std')) then |
---|
161 | call file%get('fractional_std', cloud%fractional_std) |
---|
162 | end if |
---|
163 | |
---|
164 | ! Cloud water content and effective radius may be provided |
---|
165 | ! generically, in which case they have dimensions (ncol, nlev, |
---|
166 | ! ntype) |
---|
167 | if (file%exists('q_hydrometeor')) then |
---|
168 | call file%get('q_hydrometeor', cloud%mixing_ratio, ipermute=[2,1,3]) ! kg/kg |
---|
169 | call file%get('re_hydrometeor', cloud%effective_radius, ipermute=[2,1,3]) ! m |
---|
170 | else |
---|
171 | ! Ice and liquid properties provided in separate arrays |
---|
172 | allocate(cloud%mixing_ratio(ncol,nlev,2)) |
---|
173 | allocate(cloud%effective_radius(ncol,nlev,2)) |
---|
174 | call file%get('q_liquid', prop_2d) ! kg/kg |
---|
175 | cloud%mixing_ratio(:,:,1) = prop_2d |
---|
176 | call file%get('q_ice', prop_2d) ! kg/kg |
---|
177 | cloud%mixing_ratio(:,:,2) = prop_2d |
---|
178 | call file%get('re_liquid', prop_2d) ! m |
---|
179 | cloud%effective_radius(:,:,1) = prop_2d |
---|
180 | call file%get('re_ice', prop_2d) ! m |
---|
181 | cloud%effective_radius(:,:,2) = prop_2d |
---|
182 | end if |
---|
183 | ! For backwards compatibility, associate pointers for liquid and |
---|
184 | ! ice to the first and second slices of cloud%mixing_ratio and |
---|
185 | ! cloud%effective_radius |
---|
186 | cloud%q_liq => cloud%mixing_ratio(:,:,1) |
---|
187 | cloud%q_ice => cloud%mixing_ratio(:,:,2) |
---|
188 | cloud%re_liq => cloud%effective_radius(:,:,1) |
---|
189 | cloud%re_ice => cloud%effective_radius(:,:,2) |
---|
190 | cloud%ntype = size(cloud%mixing_ratio,3) |
---|
191 | |
---|
192 | ! Simple initialization of the seeds for the Monte Carlo scheme |
---|
193 | call single_level%init_seed_simple(1,ncol) |
---|
194 | ! Overwrite with user-specified values if available |
---|
195 | if (file%exists('iseed')) then |
---|
196 | call file%get('iseed', single_level%iseed) |
---|
197 | end if |
---|
198 | |
---|
199 | ! Cloud overlap parameter |
---|
200 | if (file%exists('overlap_param')) then |
---|
201 | call file%get('overlap_param', cloud%overlap_param) |
---|
202 | end if |
---|
203 | |
---|
204 | ! Optional scaling of liquid water mixing ratio |
---|
205 | if (driver_config%q_liq_scaling >= 0.0_jprb & |
---|
206 | & .and. driver_config%q_liq_scaling /= 1.0_jprb) then |
---|
207 | cloud%q_liq = cloud%q_liq * driver_config%q_liq_scaling |
---|
208 | if (driver_config%iverbose >= 2) then |
---|
209 | write(nulout,'(a,g10.3)') ' Scaling liquid water mixing ratio by a factor of ', & |
---|
210 | & driver_config%q_liq_scaling |
---|
211 | end if |
---|
212 | end if |
---|
213 | |
---|
214 | ! Optional scaling of ice water mixing ratio |
---|
215 | if (driver_config%q_ice_scaling >= 0.0_jprb .and. driver_config%q_ice_scaling /= 1.0_jprb) then |
---|
216 | cloud%q_ice = cloud%q_ice * driver_config%q_ice_scaling |
---|
217 | if (driver_config%iverbose >= 2) then |
---|
218 | write(nulout,'(a,g10.3)') ' Scaling ice water mixing ratio by a factor of ', & |
---|
219 | & driver_config%q_ice_scaling |
---|
220 | end if |
---|
221 | end if |
---|
222 | |
---|
223 | ! Optional scaling of cloud fraction |
---|
224 | if (driver_config%cloud_fraction_scaling >= 0.0_jprb & |
---|
225 | & .and. driver_config%cloud_fraction_scaling /= 1.0_jprb) then |
---|
226 | cloud%fraction = cloud%fraction * driver_config%cloud_fraction_scaling |
---|
227 | if (driver_config%iverbose >= 2) then |
---|
228 | write(nulout,'(a,g10.3)') ' Scaling cloud_fraction by a factor of ', & |
---|
229 | & driver_config%cloud_fraction_scaling |
---|
230 | end if |
---|
231 | end if |
---|
232 | |
---|
233 | ! Cloud overlap is currently treated by an overlap decorrelation |
---|
234 | ! length (m) that is constant everywhere, and specified in one |
---|
235 | ! of the namelists |
---|
236 | if (driver_config%overlap_decorr_length_override > 0.0_jprb) then |
---|
237 | ! Convert overlap decorrelation length to overlap parameter between |
---|
238 | ! adjacent layers, stored in cloud%overlap_param |
---|
239 | call cloud%set_overlap_param(thermodynamics, & |
---|
240 | & driver_config%overlap_decorr_length_override) |
---|
241 | else if (.not. allocated(cloud%overlap_param)) then |
---|
242 | if (driver_config%iverbose >= 1) then |
---|
243 | write(nulout,'(a,g10.3,a)') 'Warning: overlap decorrelation length set to ', & |
---|
244 | & decorr_length_default, ' m' |
---|
245 | end if |
---|
246 | call cloud%set_overlap_param(thermodynamics, decorr_length_default) |
---|
247 | else if (driver_config%overlap_decorr_length_scaling > 0.0_jprb) then |
---|
248 | ! Scale the overlap decorrelation length by taking the overlap |
---|
249 | ! parameter to a power |
---|
250 | ! where (cloud%overlap_param > 0.99_jprb) cloud%overlap_param = 0.99_jprb |
---|
251 | |
---|
252 | where (cloud%overlap_param > 0.0_jprb) |
---|
253 | cloud%overlap_param = cloud%overlap_param**(1.0_jprb & |
---|
254 | & / driver_config%overlap_decorr_length_scaling) |
---|
255 | end where |
---|
256 | |
---|
257 | if (driver_config%iverbose >= 2) then |
---|
258 | write(nulout,'(a,g10.3)') ' Scaling overlap decorrelation length by a factor of ', & |
---|
259 | & driver_config%overlap_decorr_length_scaling |
---|
260 | end if |
---|
261 | else if (driver_config%overlap_decorr_length_scaling == 0.0_jprb) then |
---|
262 | cloud%overlap_param = 0.0_jprb |
---|
263 | if (driver_config%iverbose >= 2) then |
---|
264 | write(nulout,'(a)') ' Setting overlap decorrelation length to zero (random overlap)' |
---|
265 | end if |
---|
266 | end if |
---|
267 | |
---|
268 | ! Cloud inhomogeneity is specified by the fractional standard |
---|
269 | ! deviation of cloud water content, that is currently constant |
---|
270 | ! everywhere (and the same for water and ice). The following copies |
---|
271 | ! this constant into the cloud%fractional_std array. |
---|
272 | if (driver_config%fractional_std_override >= 0.0_jprb) then |
---|
273 | if (driver_config%iverbose >= 2) then |
---|
274 | write(nulout,'(a,g10.3,a)') ' Overriding cloud fractional standard deviation with ', & |
---|
275 | & driver_config%fractional_std_override |
---|
276 | end if |
---|
277 | call cloud%create_fractional_std(ncol, nlev, & |
---|
278 | & driver_config%fractional_std_override) |
---|
279 | else if (.not. allocated(cloud%fractional_std)) then |
---|
280 | call cloud%create_fractional_std(ncol, nlev, 0.0_jprb) |
---|
281 | if (driver_config%iverbose >= 1) then |
---|
282 | write(nulout,'(a)') 'Warning: cloud optical depth fractional standard deviation set to zero' |
---|
283 | end if |
---|
284 | end if |
---|
285 | |
---|
286 | ! -------------------------------------------------------- |
---|
287 | ! Read cloud properties needed by SPARTACUS |
---|
288 | ! -------------------------------------------------------- |
---|
289 | |
---|
290 | if (config%i_solver_sw == ISolverSPARTACUS & |
---|
291 | & .or. config%i_solver_lw == ISolverSPARTACUS) then |
---|
292 | |
---|
293 | ! 3D radiative effects are governed by the length of cloud |
---|
294 | ! edge per area of gridbox, which is characterized by the |
---|
295 | ! inverse of the cloud effective size (m-1). Order of |
---|
296 | ! precedence: (1) effective size namelist overrides, (2) |
---|
297 | ! separation namelist overrides, (3) inv_cloud_effective_size |
---|
298 | ! present in NetCDF, (4) inv_cloud_effective_separation |
---|
299 | ! present in NetCDF. Only in the latter two cases may the |
---|
300 | ! effective size be scaled by the namelist variable |
---|
301 | ! "effective_size_scaling". |
---|
302 | |
---|
303 | is_cloud_size_scalable = .false. ! Default for cases (1) and (2) |
---|
304 | |
---|
305 | if (driver_config%low_inv_effective_size_override >= 0.0_jprb & |
---|
306 | & .or. driver_config%middle_inv_effective_size_override >= 0.0_jprb & |
---|
307 | & .or. driver_config%high_inv_effective_size_override >= 0.0_jprb) then |
---|
308 | ! (1) Cloud effective size specified in namelist |
---|
309 | |
---|
310 | ! First check all three ranges provided |
---|
311 | if (driver_config%low_inv_effective_size_override < 0.0_jprb & |
---|
312 | & .or. driver_config%middle_inv_effective_size_override < 0.0_jprb & |
---|
313 | & .or. driver_config%high_inv_effective_size_override < 0.0_jprb) then |
---|
314 | write(nulout,'(a,a)') '*** Error: if one of [low|middle|high]_inv_effective_size_override', & |
---|
315 | & ' is provided then all must be' |
---|
316 | stop |
---|
317 | end if |
---|
318 | if (driver_config%iverbose >= 2) then |
---|
319 | write(nulout,'(a,g10.3,a)') ' Overriding inverse cloud effective size with:' |
---|
320 | write(nulout,'(a,g10.3,a)') ' ', driver_config%low_inv_effective_size_override, & |
---|
321 | & ' m-1 (low clouds)' |
---|
322 | write(nulout,'(a,g10.3,a)') ' ', driver_config%middle_inv_effective_size_override, & |
---|
323 | & ' m-1 (mid-level clouds)' |
---|
324 | write(nulout,'(a,g10.3,a)') ' ', driver_config%high_inv_effective_size_override, & |
---|
325 | & ' m-1 (high clouds)' |
---|
326 | end if |
---|
327 | call cloud%create_inv_cloud_effective_size_eta(ncol, nlev, & |
---|
328 | & thermodynamics%pressure_hl, & |
---|
329 | & driver_config%low_inv_effective_size_override, & |
---|
330 | & driver_config%middle_inv_effective_size_override, & |
---|
331 | & driver_config%high_inv_effective_size_override, 0.8_jprb, 0.45_jprb) |
---|
332 | |
---|
333 | else if (driver_config%cloud_separation_scale_surface > 0.0_jprb & |
---|
334 | & .and. driver_config%cloud_separation_scale_toa > 0.0_jprb) then |
---|
335 | ! (2) Cloud separation scale provided in namelist |
---|
336 | |
---|
337 | if (driver_config%iverbose >= 2) then |
---|
338 | write(nulout,'(a)') ' Effective cloud separation parameterized versus eta:' |
---|
339 | write(nulout,'(a,f8.1,a)') ' ', & |
---|
340 | & driver_config%cloud_separation_scale_surface, ' m at the surface' |
---|
341 | write(nulout,'(a,f8.1,a)') ' ', & |
---|
342 | & driver_config%cloud_separation_scale_toa, ' m at top-of-atmosphere' |
---|
343 | write(nulout,'(a,f6.2)') ' Eta power is', & |
---|
344 | & driver_config%cloud_separation_scale_power |
---|
345 | write(nulout,'(a,f6.2)') ' Inhomogeneity separation scaling is', & |
---|
346 | & driver_config%cloud_inhom_separation_factor |
---|
347 | end if |
---|
348 | call cloud%param_cloud_effective_separation_eta(ncol, nlev, & |
---|
349 | & thermodynamics%pressure_hl, & |
---|
350 | & driver_config%cloud_separation_scale_surface, & |
---|
351 | & driver_config%cloud_separation_scale_toa, & |
---|
352 | & driver_config%cloud_separation_scale_power, & |
---|
353 | & driver_config%cloud_inhom_separation_factor) |
---|
354 | |
---|
355 | else if (file%exists('inv_cloud_effective_size')) then |
---|
356 | ! (3) NetCDF file contains cloud effective size |
---|
357 | |
---|
358 | is_cloud_size_scalable = .true. |
---|
359 | |
---|
360 | call file%get('inv_cloud_effective_size', cloud%inv_cloud_effective_size) |
---|
361 | ! For finer control we can specify the effective size for |
---|
362 | ! in-cloud inhomogeneities as well |
---|
363 | if (file%exists('inv_inhom_effective_size')) then |
---|
364 | if (.not. driver_config%do_ignore_inhom_effective_size) then |
---|
365 | call file%get('inv_inhom_effective_size', cloud%inv_inhom_effective_size) |
---|
366 | else |
---|
367 | if (driver_config%iverbose >= 1) then |
---|
368 | write(nulout,'(a)') 'Ignoring inv_inhom_effective_size so treated as equal to inv_cloud_effective_size' |
---|
369 | write(nulout,'(a)') 'Warning: ...this is unlikely to be accurate for cloud fraction near one' |
---|
370 | end if |
---|
371 | end if |
---|
372 | else |
---|
373 | if (driver_config%iverbose >= 1) then |
---|
374 | write(nulout,'(a)') 'Warning: inv_inhom_effective_size not set so treated as equal to inv_cloud_effective_size' |
---|
375 | write(nulout,'(a)') 'Warning: ...this is unlikely to be accurate for cloud fraction near one' |
---|
376 | end if |
---|
377 | end if |
---|
378 | |
---|
379 | else if (file%exists('inv_cloud_effective_separation')) then |
---|
380 | ! (4) Alternative way to specify cloud scale |
---|
381 | |
---|
382 | is_cloud_size_scalable = .true. |
---|
383 | |
---|
384 | call file%get('inv_cloud_effective_separation', prop_2d) |
---|
385 | allocate(cloud%inv_cloud_effective_size(ncol,nlev)) |
---|
386 | allocate(cloud%inv_inhom_effective_size(ncol,nlev)) |
---|
387 | where (cloud%fraction > config%cloud_fraction_threshold & |
---|
388 | & .and. cloud%fraction < 1.0_jprb - config%cloud_fraction_threshold) |
---|
389 | ! Convert effective cloud separation to effective cloud |
---|
390 | ! size, noting divisions rather than multiplications |
---|
391 | ! because we're working in terms of inverse sizes |
---|
392 | cloud%inv_cloud_effective_size = prop_2d / sqrt(cloud%fraction*(1.0_jprb-cloud%fraction)) |
---|
393 | elsewhere |
---|
394 | cloud%inv_cloud_effective_size = 0.0_jprb |
---|
395 | end where |
---|
396 | if (file%exists('inv_inhom_effective_separation')) then |
---|
397 | if (driver_config%iverbose >= 2) then |
---|
398 | write(nulout,'(a)') ' Effective size of clouds and their inhomogeneities being computed from input' |
---|
399 | write(nulout,'(a)') ' ...variables inv_cloud_effective_separation and inv_inhom_effective_separation' |
---|
400 | end if |
---|
401 | call file%get('inv_inhom_effective_separation', prop_2d) |
---|
402 | where (cloud%fraction > config%cloud_fraction_threshold) |
---|
403 | ! Convert effective separation of cloud inhomogeneities |
---|
404 | ! to effective size of cloud inhomogeneities, assuming |
---|
405 | ! here that the Tripleclouds treatment of cloud |
---|
406 | ! inhomogeneity will divide the cloudy part of the area |
---|
407 | ! into regions of equal area |
---|
408 | cloud%inv_inhom_effective_size = prop_2d & |
---|
409 | & / sqrt(0.5_jprb*cloud%fraction * (1.0_jprb-0.5_jprb*cloud%fraction)) |
---|
410 | elsewhere |
---|
411 | cloud%inv_inhom_effective_size = 0.0_jprb |
---|
412 | end where |
---|
413 | else |
---|
414 | ! Assume that the effective separation of cloud |
---|
415 | ! inhomogeneities is equal to that of clouds but |
---|
416 | ! multiplied by a constant provided by the user; note that |
---|
417 | ! prop_2d at this point contains |
---|
418 | ! inv_cloud_effective_separation |
---|
419 | if (driver_config%iverbose >= 2) then |
---|
420 | write(nulout,'(a)') ' Effective size of clouds being computed from inv_cloud_effective_separation' |
---|
421 | write(nulout,'(a,f6.2,a)') ' ...and multiplied by ', driver_config%cloud_inhom_separation_factor, & |
---|
422 | & ' to get effective size of inhomogeneities' |
---|
423 | end if |
---|
424 | where (cloud%fraction > config%cloud_fraction_threshold) |
---|
425 | ! Note divisions rather than multiplications because |
---|
426 | ! we're working in terms of inverse sizes |
---|
427 | cloud%inv_inhom_effective_size = (1.0_jprb / driver_config%cloud_inhom_separation_factor) * prop_2d & |
---|
428 | & / sqrt(0.5_jprb*cloud%fraction * (1.0_jprb-0.5_jprb*cloud%fraction)) |
---|
429 | elsewhere |
---|
430 | cloud%inv_inhom_effective_size = 0.0_jprb |
---|
431 | end where |
---|
432 | end if ! exists inv_inhom_effective_separation |
---|
433 | deallocate(prop_2d) |
---|
434 | |
---|
435 | else |
---|
436 | |
---|
437 | write(nulout,'(a)') '*** Error: SPARTACUS solver specified but cloud size not, either in namelist or input file' |
---|
438 | stop |
---|
439 | |
---|
440 | end if ! Select method of specifying cloud effective size |
---|
441 | |
---|
442 | ! In cases (3) and (4) above the effective size obtained from |
---|
443 | ! the NetCDF may be scaled by a namelist variable |
---|
444 | if (is_cloud_size_scalable .and. driver_config%effective_size_scaling > 0.0_jprb) then |
---|
445 | ! Scale cloud effective size |
---|
446 | cloud%inv_cloud_effective_size = cloud%inv_cloud_effective_size & |
---|
447 | & / driver_config%effective_size_scaling |
---|
448 | if (allocated(cloud%inv_inhom_effective_size)) then |
---|
449 | if (driver_config%iverbose >= 2) then |
---|
450 | write(nulout, '(a,g10.3)') ' Scaling effective size of clouds and their inhomogeneities with ', & |
---|
451 | & driver_config%effective_size_scaling |
---|
452 | end if |
---|
453 | cloud%inv_inhom_effective_size = cloud%inv_inhom_effective_size & |
---|
454 | & / driver_config%effective_size_scaling |
---|
455 | else |
---|
456 | if (driver_config%iverbose >= 2) then |
---|
457 | write(nulout, '(a,g10.3)') ' Scaling cloud effective size with ', & |
---|
458 | & driver_config%effective_size_scaling |
---|
459 | end if |
---|
460 | end if |
---|
461 | end if |
---|
462 | |
---|
463 | end if ! Using SPARTACUS solver |
---|
464 | |
---|
465 | end if ! do_cloud |
---|
466 | |
---|
467 | ! -------------------------------------------------------- |
---|
468 | ! Read surface properties |
---|
469 | ! -------------------------------------------------------- |
---|
470 | |
---|
471 | single_level%is_simple_surface = .true. |
---|
472 | |
---|
473 | ! Single-level variable with dimensions (ncol) |
---|
474 | if (file%exists('skin_temperature')) then |
---|
475 | call file%get('skin_temperature',single_level%skin_temperature) ! K |
---|
476 | else |
---|
477 | allocate(single_level%skin_temperature(ncol)) |
---|
478 | single_level%skin_temperature(1:ncol) = thermodynamics%temperature_hl(1:ncol,nlev+1) |
---|
479 | if (driver_config%iverbose >= 1 .and. config%do_lw & |
---|
480 | & .and. driver_config%skin_temperature_override < 0.0_jprb) then |
---|
481 | write(nulout,'(a)') 'Warning: skin temperature set equal to lowest air temperature' |
---|
482 | end if |
---|
483 | end if |
---|
484 | |
---|
485 | if (driver_config%sw_albedo_override >= 0.0_jprb) then |
---|
486 | ! Optional override of shortwave albedo |
---|
487 | allocate(single_level%sw_albedo(ncol,1)) |
---|
488 | single_level%sw_albedo = driver_config%sw_albedo_override |
---|
489 | if (driver_config%iverbose >= 2) then |
---|
490 | write(nulout,'(a,g10.3)') ' Overriding shortwave albedo with ', & |
---|
491 | & driver_config%sw_albedo_override |
---|
492 | end if |
---|
493 | !if (allocated(single_level%sw_albedo_direct)) then |
---|
494 | ! single_level%sw_albedo_direct = driver_config%sw_albedo_override |
---|
495 | !end if |
---|
496 | else |
---|
497 | ! Shortwave albedo is stored with dimensions (ncol,nalbedobands) |
---|
498 | if (file%get_rank('sw_albedo') == 1) then |
---|
499 | ! ...but if in the NetCDF file it has only dimension (ncol), in |
---|
500 | ! order that nalbedobands is correctly set to 1, we need to turn |
---|
501 | ! off transposition |
---|
502 | call file%get('sw_albedo', single_level%sw_albedo, do_transp=.false.) |
---|
503 | if (file%exists('sw_albedo_direct')) then |
---|
504 | call file%get('sw_albedo_direct', single_level%sw_albedo_direct, do_transp=.false.) |
---|
505 | end if |
---|
506 | else |
---|
507 | call file%get('sw_albedo', single_level%sw_albedo, do_transp=.true.) |
---|
508 | if (file%exists('sw_albedo_direct')) then |
---|
509 | call file%get('sw_albedo_direct', single_level%sw_albedo_direct, do_transp=.true.) |
---|
510 | end if |
---|
511 | end if |
---|
512 | end if |
---|
513 | |
---|
514 | ! Longwave emissivity |
---|
515 | if (driver_config%lw_emissivity_override >= 0.0_jprb) then |
---|
516 | ! Optional override of longwave emissivity |
---|
517 | allocate(single_level%lw_emissivity(ncol,1)) |
---|
518 | single_level%lw_emissivity = driver_config%lw_emissivity_override |
---|
519 | if (driver_config%iverbose >= 2) then |
---|
520 | write(nulout,'(a,g10.3)') ' Overriding longwave emissivity with ', & |
---|
521 | & driver_config%lw_emissivity_override |
---|
522 | end if |
---|
523 | else |
---|
524 | if (file%get_rank('lw_emissivity') == 1) then |
---|
525 | call file%get('lw_emissivity',single_level%lw_emissivity, do_transp=.false.) |
---|
526 | else |
---|
527 | call file%get('lw_emissivity',single_level%lw_emissivity, do_transp=.true.) |
---|
528 | end if |
---|
529 | end if |
---|
530 | |
---|
531 | ! Optional override of skin temperature |
---|
532 | if (driver_config%skin_temperature_override >= 0.0_jprb) then |
---|
533 | single_level%skin_temperature = driver_config%skin_temperature_override |
---|
534 | if (driver_config%iverbose >= 2) then |
---|
535 | write(nulout,'(a,g10.3)') ' Overriding skin_temperature with ', & |
---|
536 | & driver_config%skin_temperature_override |
---|
537 | end if |
---|
538 | end if |
---|
539 | |
---|
540 | ! -------------------------------------------------------- |
---|
541 | ! Read aerosol and gas concentrations |
---|
542 | ! -------------------------------------------------------- |
---|
543 | |
---|
544 | if (config%use_aerosols) then |
---|
545 | ! Load aerosol data |
---|
546 | call file%get('aerosol_mmr', aerosol%mixing_ratio, ipermute=[2,3,1]); |
---|
547 | ! Store aerosol level bounds |
---|
548 | aerosol%istartlev = lbound(aerosol%mixing_ratio, 2) |
---|
549 | aerosol%iendlev = ubound(aerosol%mixing_ratio, 2) |
---|
550 | end if |
---|
551 | |
---|
552 | ! Load in gas volume mixing ratios, which can be either 2D arrays |
---|
553 | ! (varying with height and column) or 0D scalars (constant volume |
---|
554 | ! mixing ratio everywhere). |
---|
555 | ngases = 0 ! Gases with varying mixing ratio |
---|
556 | nwellmixedgases = 0 ! Gases with constant mixing ratio |
---|
557 | |
---|
558 | ! Water vapour and ozone are always in terms of mass mixing ratio |
---|
559 | ! (kg/kg) and always 2D arrays with dimensions (ncol,nlev), unlike |
---|
560 | ! other gases (see below) |
---|
561 | |
---|
562 | call gas%allocate(ncol, nlev) |
---|
563 | |
---|
564 | ! Loop through all radiatively important gases |
---|
565 | do jgas = 1,NMaxGases |
---|
566 | if (jgas == IH2O) then |
---|
567 | if (file%exists('q')) then |
---|
568 | call file%get('q', gas_mr) |
---|
569 | call gas%put(IH2O, IMassMixingRatio, gas_mr) |
---|
570 | else if (file%exists('h2o_mmr')) then |
---|
571 | call file%get('h2o_mmr', gas_mr) |
---|
572 | call gas%put(IH2O, IMassMixingRatio, gas_mr) |
---|
573 | else |
---|
574 | call file%get('h2o' // trim(driver_config%vmr_suffix_str), gas_mr); |
---|
575 | call gas%put(IH2O, IVolumeMixingRatio, gas_mr) |
---|
576 | end if |
---|
577 | else if (jgas == IO3) then |
---|
578 | if (file%exists('o3_mmr')) then |
---|
579 | call file%get('o3_mmr', gas_mr) |
---|
580 | call gas%put(IO3, IMassMixingRatio, gas_mr) |
---|
581 | else |
---|
582 | call file%get('o3' // trim(driver_config%vmr_suffix_str), gas_mr) |
---|
583 | call gas%put(IO3, IVolumeMixingRatio, gas_mr) |
---|
584 | end if |
---|
585 | else |
---|
586 | ! Find number of dimensions of the variable holding gas "jgas" in |
---|
587 | ! the input file, where the following function returns -1 if the |
---|
588 | ! gas is not found |
---|
589 | gas_var_name = trim(GasLowerCaseName(jgas)) // trim(driver_config%vmr_suffix_str) |
---|
590 | irank = file%get_rank(trim(gas_var_name)) |
---|
591 | ! Note that if the gas is not present then a warning will have |
---|
592 | ! been issued, and irank will be returned as -1 |
---|
593 | if (irank == 0) then |
---|
594 | ! Store this as a well-mixed gas |
---|
595 | call file%get(trim(gas_var_name), well_mixed_gas_vmr) |
---|
596 | call gas%put_well_mixed(jgas, IVolumeMixingRatio, well_mixed_gas_vmr) |
---|
597 | else if (irank == 2) then |
---|
598 | call file%get(trim(gas_var_name), gas_mr) |
---|
599 | call gas%put(jgas, IVolumeMixingRatio, gas_mr) |
---|
600 | else if (irank > 0) then |
---|
601 | write(nulout,'(a,a,a)') '*** Error: ', trim(gas_var_name), ' does not have 0 or 2 dimensions' |
---|
602 | stop |
---|
603 | end if |
---|
604 | end if |
---|
605 | if (allocated(gas_mr)) deallocate(gas_mr) |
---|
606 | end do |
---|
607 | |
---|
608 | ! Scale gas concentrations if needed |
---|
609 | call gas%scale(IH2O, driver_config%h2o_scaling, driver_config%iverbose >= 2) |
---|
610 | call gas%scale(ICO2, driver_config%co2_scaling, driver_config%iverbose >= 2) |
---|
611 | call gas%scale(IO3, driver_config%o3_scaling, driver_config%iverbose >= 2) |
---|
612 | call gas%scale(IN2O, driver_config%n2o_scaling, driver_config%iverbose >= 2) |
---|
613 | call gas%scale(ICO, driver_config%co_scaling, driver_config%iverbose >= 2) |
---|
614 | call gas%scale(ICH4, driver_config%ch4_scaling, driver_config%iverbose >= 2) |
---|
615 | call gas%scale(IO2, driver_config%o2_scaling, driver_config%iverbose >= 2) |
---|
616 | call gas%scale(ICFC11, driver_config%cfc11_scaling, driver_config%iverbose >= 2) |
---|
617 | call gas%scale(ICFC12, driver_config%cfc12_scaling, driver_config%iverbose >= 2) |
---|
618 | call gas%scale(IHCFC22, driver_config%hcfc22_scaling, driver_config%iverbose >= 2) |
---|
619 | call gas%scale(ICCL4, driver_config%ccl4_scaling, driver_config%iverbose >= 2) |
---|
620 | call gas%scale(INO2, driver_config%no2_scaling, driver_config%iverbose >= 2) |
---|
621 | |
---|
622 | end subroutine read_input |
---|
623 | |
---|
624 | end module ecrad_driver_read_input |
---|