source: LMDZ6/branches/contrails/libf/phylmd/ecrad/driver/ecrad_driver_read_input.F90

Last change on this file was 4773, checked in by idelkadi, 12 months ago
  • Update of Ecrad in LMDZ The same organization of the Ecrad offline version is retained in order to facilitate the updating of Ecrad in LMDZ and the comparison between online and offline results. version 1.6.1 of Ecrad (https://github.com/lguez/ecrad.git)
  • Implementation of the double call of Ecrad in LMDZ


File size: 29.4 KB
Line 
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
15module ecrad_driver_read_input
16
17  public
18 
19contains
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
624end module ecrad_driver_read_input
Note: See TracBrowser for help on using the repository browser.