| 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 |
|---|