source: LMDZ6/trunk/libf/phylmd/ecrad/radiation/radiation_aerosol_optics_data.F90 @ 5212

Last change on this file since 5212 was 4860, checked in by idelkadi, 8 months ago

Bug correction (https://github.com/ecmwf-ifs/ecrad/issues/14)

File size: 29.5 KB
Line 
1! radiation_aerosol_optics_data.F90 - Type to store aerosol optical properties
2!
3! (C) Copyright 2015- ECMWF.
4!
5! This software is licensed under the terms of the Apache Licence Version 2.0
6! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
7!
8! In applying this licence, ECMWF does not waive the privileges and immunities
9! granted to it by virtue of its status as an intergovernmental organisation
10! nor does it submit to any jurisdiction.
11!
12! Author:  Robin Hogan
13! Email:   r.j.hogan@ecmwf.int
14!
15! Modifications
16!   2017-10-23  R. Hogan  Renamed single-character variables
17!   2018-04-20  A. Bozzo  Read optical properties at selected wavelengths
18
19#include "ecrad_config.h"
20
21module radiation_aerosol_optics_data
22
23  use parkind1,      only : jprb
24  use radiation_io,  only : nulerr, radiation_abort
25
26  implicit none
27  public
28
29  private :: get_line
30
31  ! The following provide possible values for
32  ! aerosol_optics_type%iclass, which is used to map the user's type
33  ! index to the hydrophobic or hydrophilic types loaded from the
34  ! aerosol optics file. Initially iclass is equal to
35  ! AerosolClassUndefined, which will throw an error if ever the user
36  ! tries to use this aerosol type. The user may specify that an
37  ! aerosol type is to be ignored in the radiation calculation, in
38  ! which case iclass will be set equal to AerosolClassIgnored.
39  enum, bind(c)
40     enumerator IAerosolClassUndefined,   IAerosolClassIgnored, &
41          &     IAerosolClassHydrophobic, IAerosolClassHydrophilic
42  end enum
43
44  integer, parameter :: NMaxStringLength = 2000
45  integer, parameter :: NMaxLineLength   = 200
46
47  !---------------------------------------------------------------------
48  ! This type holds the configuration information to compute
49  ! aerosol optical properties
50  type aerosol_optics_type
51     ! A vector of length ntype, iclass maps user-defined types on to
52     ! the hydrophilic or hydrophobic aerosol classes using the
53     ! enumerators above
54     integer, allocatable, dimension(:) :: iclass
55
56     ! Also a vector of length ntype, itype maps user-defined types on
57     ! to specific hydrophilic or hydrophobic aerosol types
58     integer, allocatable, dimension(:) :: itype
59
60     ! Wavenumber (cm-1) upper and lower bounds of each spectral
61     ! interval, which if used in the RRTMG gas optics scheme should
62     ! match its band bounds
63     real(jprb), allocatable, dimension(:) :: wavenumber1_sw, wavenumber2_sw
64     real(jprb), allocatable, dimension(:) :: wavenumber1_lw, wavenumber2_lw
65
66     ! Scattering properties are provided separately in the shortwave
67     ! and longwave for hydrophobic and hydrophilic aerosols.
68     ! Hydrophobic aerosols are dimensioned (nband,n_type_phobic):
69     real(jprb), allocatable, dimension(:,:) :: &
70          &  mass_ext_sw_phobic, & ! Mass-extinction coefficient (m2 kg-1)
71          &  ssa_sw_phobic,      & ! Single scattering albedo
72          &  g_sw_phobic,        & ! Asymmetry factor
73!          &  ssa_g_sw_phobic,    & ! ssa*g
74          &  mass_ext_lw_phobic, & ! Mass-extinction coefficient (m2 kg-1)
75!          &  mass_abs_lw_phobic, & ! Mass-absorption coefficient (m2 kg-1)
76          &  ssa_lw_phobic,      & ! Single scattering albedo
77          &  g_lw_phobic           ! Asymmetry factor
78
79     ! Hydrophilic aerosols are dimensioned (nband,nrh,n_type_philic):
80     real(jprb), allocatable, dimension(:,:,:) :: &
81          &  mass_ext_sw_philic, & ! Mass-extinction coefficient (m2 kg-1)
82          &  ssa_sw_philic,      & ! Single scattering albedo
83          &  g_sw_philic,        & ! Asymmetry factor
84 !         &  ssa_g_sw_philic,    & ! ssa*g
85          &  mass_ext_lw_philic, & ! Mass-extinction coefficient (m2 kg-1)
86 !         &  mass_abs_lw_philic, & ! Mass-absorption coefficient (m2 kg-1)
87          &  ssa_lw_philic,      & ! Single scattering albedo
88          &  g_lw_philic           ! Asymmetry factor
89
90     ! Wavelengths at which monochromatic properties are stored,
91     ! dimensioned (n_mono_wl), units metres
92     real(jprb), allocatable :: wavelength_mono(:)
93
94     ! Scattering properties at selected monochromatic wavelengths
95     ! (n_mono_wl,n_type_phobic)
96     real(jprb), allocatable, dimension(:,:) :: &
97          &  mass_ext_mono_phobic, & ! Mass-extinction coefficient (m2 kg-1)
98          &  ssa_mono_phobic,      & ! Single scattering albedo
99          &  g_mono_phobic,        & ! Asymmetry factor
100          &  lidar_ratio_mono_phobic ! Lidar Ratio
101     ! ...hydrophilic aerosols dimensioned (n_mono_wl,nrh,n_type_philic):
102     real(jprb), allocatable, dimension(:,:,:) :: &
103          &  mass_ext_mono_philic, & ! Mass-extinction coefficient (m2 kg-1)
104          &  ssa_mono_philic,      & ! Single scattering albedo
105          &  g_mono_philic,        & ! Asymmetry factor
106          &  lidar_ratio_mono_philic ! Lidar Ratio
107
108     ! For hydrophilic aerosols, the lower bounds of the relative
109     ! humidity bins is a vector of length nrh:
110     real(jprb), allocatable, dimension(:) :: &
111          &  rh_lower    ! Dimensionless (1.0 = 100% humidity)
112
113     ! Strings describing the aerosol types
114     character(len=NMaxStringLength) :: description_phobic_str = ' '
115     character(len=NMaxStringLength) :: description_philic_str = ' '
116
117     ! The number of user-defined aerosol types
118     integer :: ntype
119
120     ! The number of hydrophobic and hydrophilic types read from the
121     ! aerosol optics file
122     integer :: n_type_phobic = 0
123     integer :: n_type_philic = 0
124
125     ! Number of relative humidity bins
126     integer :: nrh = 0
127
128     ! Number of longwave and shortwave bands of the data in the file,
129     ! and monochromatic wavelengths
130     integer :: n_bands_lw = 0, n_bands_sw = 0, n_mono_wl = 0
131
132     ! Do we have any hydrophilic types?
133     logical :: use_hydrophilic = .true.
134
135     ! Do we have monochromatic optical properties
136     logical :: use_monochromatic = .false.
137
138   contains
139     procedure :: setup => setup_aerosol_optics
140     procedure :: save  => save_aerosol_optics
141     procedure :: allocate
142     procedure :: initialize_types
143     procedure :: set_hydrophobic_type
144     procedure :: set_hydrophilic_type
145     procedure :: set_empty_type
146     procedure :: set_types
147     procedure :: calc_rh_index
148     procedure :: print_description
149
150  end type aerosol_optics_type
151
152contains
153
154
155  !---------------------------------------------------------------------
156  ! Setup aerosol optics coefficients by reading them from a file
157  subroutine setup_aerosol_optics(this, file_name, iverbose)
158
159    use yomhook,              only : lhook, dr_hook, jphook
160#ifdef EASY_NETCDF_READ_MPI
161    use easy_netcdf_read_mpi, only : netcdf_file
162#else
163    use easy_netcdf,          only : netcdf_file
164#endif
165    use radiation_io,         only : nulerr, radiation_abort
166
167    class(aerosol_optics_type), intent(inout) :: this
168    character(len=*), intent(in)              :: file_name
169    integer, intent(in), optional             :: iverbose
170
171    ! The NetCDF file containing the aerosol optics data
172    type(netcdf_file)  :: file
173
174    real(jprb), allocatable :: wavelength_tmp(:)
175    integer            :: iverb
176
177    real(jphook) :: hook_handle
178
179    if (lhook) call dr_hook('radiation_aerosol_optics_data:setup',0,hook_handle)
180
181    if (present(iverbose)) then
182       iverb = iverbose
183    else
184       iverb = 2
185    end if
186
187    ! Open the aerosol scattering file and configure the way it is
188    ! read
189    call file%open(trim(file_name), iverbose=iverb)
190
191    if (file%exists('mass_ext_sw_hydrophilic')) then
192      this%use_hydrophilic = .true.
193    else
194      this%use_hydrophilic = .false.
195    end if
196
197    ! Read the wavenumber bounds
198    call file%get('wavenumber1_sw', this%wavenumber1_sw)
199    call file%get('wavenumber2_sw', this%wavenumber2_sw)
200    call file%get('wavenumber1_lw', this%wavenumber1_lw)
201    call file%get('wavenumber2_lw', this%wavenumber2_lw)
202
203    ! Read the raw scattering data
204    call file%get('mass_ext_sw_hydrophobic', this%mass_ext_sw_phobic)
205    call file%get('ssa_sw_hydrophobic',      this%ssa_sw_phobic)
206    call file%get('asymmetry_sw_hydrophobic',this%g_sw_phobic)
207    call file%get('mass_ext_lw_hydrophobic', this%mass_ext_lw_phobic)
208    call file%get('ssa_lw_hydrophobic',      this%ssa_lw_phobic)
209    call file%get('asymmetry_lw_hydrophobic',this%g_lw_phobic)
210
211    call file%get_global_attribute('description_hydrophobic', &
212         &                         this%description_phobic_str)
213
214    ! Precompute ssa*g for the shortwave and mass-absorption for the
215    ! longwave - TBD FIX
216    !allocate(this%ssa_g_sw_phobic(...
217
218    if (this%use_hydrophilic) then
219      call file%get('mass_ext_sw_hydrophilic', this%mass_ext_sw_philic)
220      call file%get('ssa_sw_hydrophilic',      this%ssa_sw_philic)
221      call file%get('asymmetry_sw_hydrophilic',this%g_sw_philic)
222      call file%get('mass_ext_lw_hydrophilic', this%mass_ext_lw_philic)
223      call file%get('ssa_lw_hydrophilic',      this%ssa_lw_philic)
224      call file%get('asymmetry_lw_hydrophilic',this%g_lw_philic)
225
226      call file%get('relative_humidity1',      this%rh_lower)
227
228      call file%get_global_attribute('description_hydrophilic', &
229           &                         this%description_philic_str)
230    end if
231
232    ! Read the monochromatic scattering data at selected wavelengths
233    ! if available in the input file
234    if (file%exists('mass_ext_mono_hydrophobic')) then
235      this%use_monochromatic = .true.
236
237      if (allocated(this%wavelength_mono)) then
238        ! User has provided required monochromatic wavelengths, which
239        ! must match those in the file (in the more recent "general"
240        ! aerosol optics, interpolation provides optical properties at
241        ! the requested wavelengths)
242        call file%get('wavelength_mono', wavelength_tmp)
243        if (size(wavelength_tmp) /= size(this%wavelength_mono)) then
244          write(nulerr,'(a,i0,a,i0,a)') '*** Error: ', size(this%wavelength_mono), &
245               &  ' monochromatic wavelengths requested but ', &
246               &  size(wavelength_tmp), ' in file'
247          call radiation_abort('Radiation configuration error')
248        end if
249        if (any(abs(this%wavelength_mono-wavelength_tmp) &
250               &  / this%wavelength_mono > 0.01_jprb)) then
251          write(nulerr,'(a,a)') '*** Error: requested monochromatic wavelengths', &
252               &  'must all be within 1% of values in file'
253          call radiation_abort('Radiation configuration error')
254        end if
255      else
256        ! User has not provided required wavelengths, so we save the
257        ! monochromatic wavelengths in the file
258        call file%get('wavelength_mono', this%wavelength_mono)
259      end if
260
261      call file%get('mass_ext_mono_hydrophobic', this%mass_ext_mono_phobic)
262      call file%get('ssa_mono_hydrophobic',      this%ssa_mono_phobic)
263      call file%get('asymmetry_mono_hydrophobic',this%g_mono_phobic)
264      call file%get('lidar_ratio_mono_hydrophobic',this%lidar_ratio_mono_phobic)
265      if (this%use_hydrophilic) then
266        call file%get('mass_ext_mono_hydrophilic', this%mass_ext_mono_philic)
267        call file%get('ssa_mono_hydrophilic',      this%ssa_mono_philic)
268        call file%get('asymmetry_mono_hydrophilic',this%g_mono_philic)
269        call file%get('lidar_ratio_mono_hydrophilic',this%lidar_ratio_mono_philic)
270      end if
271    else
272      this%use_monochromatic = .false.
273    end if
274
275    ! Close aerosol scattering file
276    call file%close()
277
278    ! Get array sizes
279    this%n_bands_lw    = size(this%mass_ext_lw_phobic, 1)
280    this%n_bands_sw    = size(this%mass_ext_sw_phobic, 1)
281    if (this%use_monochromatic) then
282      this%n_mono_wl   = size(this%mass_ext_mono_phobic, 1)
283    else
284      this%n_mono_wl   = 0
285    end if
286    this%n_type_phobic = size(this%mass_ext_lw_phobic, 2)
287
288    if (this%use_hydrophilic) then
289      this%n_type_philic = size(this%mass_ext_lw_philic, 3)
290      this%nrh           = size(this%mass_ext_lw_philic, 2)
291
292      ! Check agreement of dimensions
293      if (size(this%mass_ext_lw_philic,1) /= this%n_bands_lw) then
294        write(nulerr,'(a,a)') '*** Error: mass extinction for hydrophilic and hydrophobic ', &
295             &                'aerosol have different numbers of longwave bands'
296        call radiation_abort('Radiation configuration error')
297      end if
298      if (size(this%mass_ext_sw_philic,1) /= this%n_bands_sw) then
299        write(nulerr,'(a,a)') '*** Error: mass extinction for hydrophilic and hydrophobic ', &
300             &                'aerosol have different numbers of shortwave bands'
301        call radiation_abort('Radiation configuration error')
302      end if
303      if (size(this%rh_lower) /= this%nrh) then
304        write(nulerr,'(a)') '*** Error: size(relative_humidity1) /= size(mass_ext_sw_hydrophilic,2)'
305        call radiation_abort('Radiation configuration error')
306      end if
307
308    else
309      this%n_type_philic = 0
310      this%nrh           = 0
311    end if
312
313    if (lhook) call dr_hook('radiation_aerosol_optics_data:setup',1,hook_handle)
314
315  end subroutine setup_aerosol_optics
316
317
318  !---------------------------------------------------------------------
319  ! Initialize the arrays describing the user's aerosol types
320  subroutine initialize_types(this, ntype)
321
322    class(aerosol_optics_type), intent(inout) :: this
323    integer,                    intent(in)    :: ntype
324
325    ! Allocate memory for mapping arrays
326    this%ntype = ntype
327    allocate(this%iclass(ntype))
328    allocate(this%itype(ntype))
329
330    this%iclass = IAerosolClassUndefined
331    this%itype  = 0
332
333  end subroutine initialize_types
334
335  !---------------------------------------------------------------------
336  ! Allocate arrays for aerosol optics data type
337  subroutine allocate(this, n_type_phobic, n_type_philic, nrh, &
338       &              n_bands_lw, n_bands_sw, n_mono_wl)
339
340    use yomhook,     only : lhook, dr_hook, jphook
341
342    class(aerosol_optics_type), intent(inout) :: this
343    integer, intent(in) :: n_type_phobic, n_type_philic, nrh
344    integer, intent(in) :: n_bands_lw, n_bands_sw, n_mono_wl
345
346    real(jphook) :: hook_handle
347
348    if (lhook) call dr_hook('radiation_aerosol_optics_data:allocate',0,hook_handle)
349
350    this%n_type_phobic = n_type_phobic
351    this%n_type_philic = n_type_philic
352    this%nrh           = nrh
353    this%n_bands_lw    = n_bands_lw
354    this%n_bands_sw    = n_bands_sw
355    this%n_mono_wl     = n_mono_wl
356
357    if (n_type_philic > 0) then
358      this%use_hydrophilic = .true.
359    else
360      this%use_hydrophilic = .false.
361    end if
362
363    if (n_bands_sw > 0) then
364      allocate(this%mass_ext_sw_phobic(n_bands_sw, n_type_phobic))
365      allocate(this%ssa_sw_phobic(n_bands_sw, n_type_phobic))
366      allocate(this%g_sw_phobic(n_bands_sw, n_type_phobic))
367    end if
368    if (n_bands_lw > 0) then
369      allocate(this%mass_ext_lw_phobic(n_bands_lw, n_type_phobic))
370      allocate(this%ssa_lw_phobic(n_bands_lw, n_type_phobic))
371      allocate(this%g_lw_phobic(n_bands_lw, n_type_phobic))
372    end if
373    if (n_mono_wl > 0) then
374      allocate(this%mass_ext_mono_phobic(n_mono_wl, n_type_phobic))
375      allocate(this%ssa_mono_phobic(n_mono_wl, n_type_phobic))
376      allocate(this%g_mono_phobic(n_mono_wl, n_type_phobic))
377      allocate(this%lidar_ratio_mono_phobic(n_mono_wl, n_type_phobic))
378    end if
379
380    if (n_type_philic > 0 .and. nrh > 0) then
381      if (n_bands_sw > 0) then
382        allocate(this%mass_ext_sw_philic(n_bands_sw, nrh, n_type_philic))
383        allocate(this%ssa_sw_philic(n_bands_sw, nrh, n_type_philic))
384        allocate(this%g_sw_philic(n_bands_sw, nrh, n_type_philic))
385      end if
386      if (n_bands_lw > 0) then
387        allocate(this%mass_ext_lw_philic(n_bands_lw, nrh, n_type_philic))
388        allocate(this%ssa_lw_philic(n_bands_lw, nrh, n_type_philic))
389        allocate(this%g_lw_philic(n_bands_lw, nrh, n_type_philic))
390      end if
391      if (n_mono_wl > 0) then
392        allocate(this%mass_ext_mono_philic(n_mono_wl, nrh, n_type_philic))
393        allocate(this%ssa_mono_philic(n_mono_wl, nrh, n_type_philic))
394        allocate(this%g_mono_philic(n_mono_wl, nrh, n_type_philic))
395        allocate(this%lidar_ratio_mono_philic(n_mono_wl, nrh, n_type_philic))
396      end if
397    end if
398
399    if (lhook) call dr_hook('radiation_aerosol_optics_data:allocate',1,hook_handle)
400
401  end subroutine allocate
402
403
404  !---------------------------------------------------------------------
405  ! Save aerosol optical properties in the named file
406  subroutine save_aerosol_optics(this, file_name, iverbose)
407
408    use yomhook,              only : lhook, dr_hook, jphook
409    use easy_netcdf,          only : netcdf_file
410
411    class(aerosol_optics_type), intent(inout) :: this
412    character(len=*),           intent(in)    :: file_name
413    integer,          optional, intent(in)    :: iverbose
414
415    ! Object for output NetCDF file
416    type(netcdf_file) :: out_file
417
418    real(jphook) :: hook_handle
419
420    if (lhook) call dr_hook('radiation_aerosol_optics_data:save',0,hook_handle)
421
422    ! Create the file
423    call out_file%create(trim(file_name), iverbose=iverbose)
424
425    ! Define dimensions
426    call out_file%define_dimension("band_lw", this%n_bands_lw)
427    call out_file%define_dimension("band_sw", this%n_bands_sw)
428    call out_file%define_dimension("hydrophilic", this%n_type_philic)
429    call out_file%define_dimension("hydrophobic", this%n_type_phobic)
430    call out_file%define_dimension("relative_humidity", this%nrh)
431    !if (this%use_monochromatic) then
432    !  call out_file%define_dimension("wavelength_mono", this%n_mono_wl)
433    !end if
434
435    ! Put global attributes
436    call out_file%put_global_attributes( &
437         &   title_str="Aerosol optical properties in the spectral intervals of the gas-optics scheme for ecRad", &
438         &   source_str="ecRad offline radiation model")
439    call out_file%put_global_attribute( &
440         &  "description_hydrophobic", this%description_phobic_str)
441    call out_file%put_global_attribute( &
442         &  "description_hydrophilic", this%description_philic_str)
443
444    ! Define variables
445    call out_file%define_variable("mass_ext_sw_hydrophobic", units_str="m2 kg-1", &
446         &  long_name="Shortwave mass-extinction coefficient of hydrophobic aerosols", &
447         &  dim2_name="hydrophobic", dim1_name="band_sw")
448    call out_file%define_variable("ssa_sw_hydrophobic", units_str="1", &
449         &  long_name="Shortwave single scattering albedo of hydrophobic aerosols", &
450         &  dim2_name="hydrophobic", dim1_name="band_sw")
451    call out_file%define_variable("asymmetry_sw_hydrophobic", units_str="1", &
452         &  long_name="Shortwave asymmetry factor of hydrophobic aerosols", &
453         &  dim2_name="hydrophobic", dim1_name="band_sw")
454
455    call out_file%define_variable("mass_ext_lw_hydrophobic", units_str="m2 kg-1", &
456         &  long_name="Longwave mass-extinction coefficient of hydrophobic aerosols", &
457         &  dim2_name="hydrophobic", dim1_name="band_lw")
458    call out_file%define_variable("ssa_lw_hydrophobic", units_str="1", &
459         &  long_name="Longwave single scattering albedo of hydrophobic aerosols", &
460         &  dim2_name="hydrophobic", dim1_name="band_lw")
461    call out_file%define_variable("asymmetry_lw_hydrophobic", units_str="1", &
462         &  long_name="Longwave asymmetry factor of hydrophobic aerosols", &
463         &  dim2_name="hydrophobic", dim1_name="band_lw")
464
465    call out_file%define_variable("mass_ext_sw_hydrophilic", units_str="m2 kg-1", &
466         &  long_name="Shortwave mass-extinction coefficient of hydrophilic aerosols", &
467         &  dim3_name="hydrophilic", dim2_name="relative_humidity", dim1_name="band_sw")
468    call out_file%define_variable("ssa_sw_hydrophilic", units_str="1", &
469         &  long_name="Shortwave single scattering albedo of hydrophilic aerosols", &
470         &  dim3_name="hydrophilic", dim2_name="relative_humidity", dim1_name="band_sw")
471    call out_file%define_variable("asymmetry_sw_hydrophilic", units_str="1", &
472         &  long_name="Shortwave asymmetry factor of hydrophilic aerosols", &
473         &  dim3_name="hydrophilic", dim2_name="relative_humidity", dim1_name="band_sw")
474
475    call out_file%define_variable("mass_ext_lw_hydrophilic", units_str="m2 kg-1", &
476         &  long_name="Longwave mass-extinction coefficient of hydrophilic aerosols", &
477         &  dim3_name="hydrophilic", dim2_name="relative_humidity", dim1_name="band_lw")
478    call out_file%define_variable("ssa_lw_hydrophilic", units_str="1", &
479         &  long_name="Longwave single scattering albedo of hydrophilic aerosols", &
480         &  dim3_name="hydrophilic", dim2_name="relative_humidity", dim1_name="band_lw")
481    call out_file%define_variable("asymmetry_lw_hydrophilic", units_str="1", &
482         &  long_name="Longwave asymmetry factor of hydrophilic aerosols", &
483         &  dim3_name="hydrophilic", dim2_name="relative_humidity", dim1_name="band_lw")
484
485    ! Write variables
486    call out_file%put("mass_ext_sw_hydrophobic", this%mass_ext_sw_phobic)
487    call out_file%put("ssa_sw_hydrophobic", this%ssa_sw_phobic)
488    call out_file%put("asymmetry_sw_hydrophobic", this%g_sw_phobic)
489    call out_file%put("mass_ext_lw_hydrophobic", this%mass_ext_lw_phobic)
490    call out_file%put("ssa_lw_hydrophobic", this%ssa_lw_phobic)
491    call out_file%put("asymmetry_lw_hydrophobic", this%g_lw_phobic)
492    call out_file%put("mass_ext_sw_hydrophilic", this%mass_ext_sw_philic)
493    call out_file%put("ssa_sw_hydrophilic", this%ssa_sw_philic)
494    call out_file%put("asymmetry_sw_hydrophilic", this%g_sw_philic)
495    call out_file%put("mass_ext_lw_hydrophilic", this%mass_ext_lw_philic)
496    call out_file%put("ssa_lw_hydrophilic", this%ssa_lw_philic)
497    call out_file%put("asymmetry_lw_hydrophilic", this%g_lw_philic)
498
499    call out_file%close()
500
501    if (lhook) call dr_hook('radiation_aerosol_optics_data:save',1,hook_handle)
502
503  end subroutine save_aerosol_optics
504
505
506  !---------------------------------------------------------------------
507  ! Map user type "itype" onto stored hydrophobic type "i_type_phobic"
508  subroutine set_hydrophobic_type(this, itype, i_type_phobic)
509
510    use yomhook,     only : lhook, dr_hook, jphook
511
512    class(aerosol_optics_type), intent(inout) :: this
513    integer, intent(in)                       :: itype, i_type_phobic
514    real(jphook) :: hook_handle
515
516    if (lhook) call dr_hook('radiation_aerosol_optics_data:set_hydrophobic_type',0,hook_handle)
517
518    if (itype < 1 .or. itype > this%ntype) then
519      write(nulerr,'(a,i0)') '*** Error: aerosol type must be in the range 1 to ', &
520           &                  this%ntype
521       call radiation_abort('Error setting up aerosols')
522    end if
523    if (i_type_phobic < 1 .or. i_type_phobic > this%n_type_phobic) then
524      write(nulerr,'(a,i0)') '*** Error: hydrophobic type must be in the range 1 to ', &
525           &                  this%n_type_phobic
526      call radiation_abort('Error setting up aerosols')
527    end if
528
529    this%iclass(itype) = IAerosolClassHydrophobic
530    this%itype (itype) = i_type_phobic
531
532    if (lhook) call dr_hook('radiation_aerosol_optics_data:set_hydrophobic_type',1,hook_handle)
533
534  end subroutine set_hydrophobic_type
535
536
537  !---------------------------------------------------------------------
538  ! Map user type "itype" onto stored hydrophilic type "i_type_philic"
539  subroutine set_hydrophilic_type(this, itype, i_type_philic)
540
541    use yomhook,     only : lhook, dr_hook, jphook
542
543    class(aerosol_optics_type), intent(inout) :: this
544    integer, intent(in)                       :: itype, i_type_philic
545    real(jphook) :: hook_handle
546
547    if (lhook) call dr_hook('radiation_aerosol_optics_data:set_hydrophilic_type',0,hook_handle)
548
549    if (.not. this%use_hydrophilic) then
550      write(nulerr,'(a)') '*** Error: attempt to set hydrophilic aerosol type when no such types present'
551      call radiation_abort('Error setting up aerosols')
552    end if
553
554    if (itype < 1 .or. itype > this%ntype) then
555      write(nulerr,'(a,i0)') '*** Error: aerosol type must be in the range 1 to ', &
556            &          this%ntype
557      call radiation_abort('Error setting up aerosols')
558    end if
559    if (i_type_philic < 1 .or. i_type_philic > this%n_type_philic) then
560      write(nulerr,'(a,i0)') '*** Error: hydrophilic type must be in the range 1 to ', &
561           &                 this%n_type_philic
562      call radiation_abort('Error setting up aerosols')
563    end if
564
565    this%iclass(itype) = IAerosolClassHydrophilic
566    this%itype (itype) = i_type_philic
567
568    if (lhook) call dr_hook('radiation_aerosol_optics_data:set_hydrophilic_type',1,hook_handle)
569
570  end subroutine set_hydrophilic_type
571
572
573  !---------------------------------------------------------------------
574  ! Set a user type "itype" to be ignored in the radiation scheme
575  subroutine set_empty_type(this, itype)
576
577    use yomhook,     only : lhook, dr_hook, jphook
578
579    class(aerosol_optics_type), intent(inout) :: this
580    integer, intent(in)                       :: itype
581    real(jphook) :: hook_handle
582
583    if (lhook) call dr_hook('radiation_aerosol_optics_data:set_empty_type',0,hook_handle)
584
585    if (itype < 1 .or. itype > this%ntype) then
586      write(nulerr,'(a,i0)') '*** Error: aerosol type must be in the range 1 to ', &
587           &                 this%ntype
588      call radiation_abort('Error setting up aerosols')
589    end if
590
591    this%iclass(itype) = IAerosolClassIgnored
592
593    if (lhook) call dr_hook('radiation_aerosol_optics_data:set_empty_type',1,hook_handle)
594
595  end subroutine set_empty_type
596
597
598  !---------------------------------------------------------------------
599  ! Set user types "itypes" to map onto the stored hydrophobic and
600  ! hydrophilic types according to its sign and value, with a value of
601  ! 0 indicating that this type is to be ignored.  Thus if itypes=(/
602  ! 3, 4, -6, 0 /) then user types 1 and 2 map on to hydrophobic types
603  ! 3 and 4, user type 3 maps on to hydrophilic type 6 and user type 4
604  ! is ignored.
605  subroutine set_types(this, itypes)
606
607    use yomhook,     only : lhook, dr_hook, jphook
608
609    class(aerosol_optics_type), intent(inout) :: this
610    integer, dimension(:), intent(in)         :: itypes
611
612    integer :: jtype
613    integer :: istart, iend
614    real(jphook) :: hook_handle
615
616    if (lhook) call dr_hook('radiation_aerosol_optics_data:set_types',0,hook_handle)
617
618    istart = lbound(itypes,1)
619    iend   = ubound(itypes,1)
620
621    do jtype = istart, iend
622      if (itypes(jtype) == 0) then
623        call this%set_empty_type(jtype)
624      else if (itypes(jtype) > 0) then
625        call this%set_hydrophobic_type(jtype, itypes(jtype))
626      else
627        call this%set_hydrophilic_type(jtype, -itypes(jtype))
628      end if
629    end do
630
631    if (lhook) call dr_hook('radiation_aerosol_optics_data:set_types',1,hook_handle)
632
633  end subroutine set_types
634
635
636  !---------------------------------------------------------------------
637  ! Return an index to the relative-humdity array, or zero if no
638  ! hydrophilic types are present. This function does so little that
639  ! it is best to remove the Dr Hook call.
640  function calc_rh_index(this, rh)
641
642    !use yomhook,     only : lhook, dr_hook, jphook
643
644    class(aerosol_optics_type), intent(in)    :: this
645    real(jprb),                 intent(in)    :: rh
646    integer                                   :: calc_rh_index
647    !real(jphook) :: hook_handle
648
649    !if (lhook) call dr_hook('radiation_aerosol_optics_data:calc_rh_index',0,hook_handle)
650
651    if (.not. this%use_hydrophilic) then
652      calc_rh_index = 0
653    else if (rh > this%rh_lower(this%nrh)) then
654      calc_rh_index = this%nrh
655    else
656      calc_rh_index = 1
657      do while (rh > this%rh_lower(calc_rh_index + 1))
658        calc_rh_index = calc_rh_index + 1
659      end do
660    end if
661
662    !if (lhook) call dr_hook('radiation_aerosol_optics_data:calc_rh_index',1,hook_handle)
663
664  end function calc_rh_index
665
666
667  !---------------------------------------------------------------------
668  ! Print a description of the aerosol types to nulout
669  subroutine print_description(this, i_type_map)
670
671    use radiation_io, only : nulout
672
673    class(aerosol_optics_type), intent(in) :: this
674    integer,                    intent(in) :: i_type_map(:)
675
676    integer :: jtype
677
678    if (size(i_type_map) > 0) then
679      write(nulout,'(a)') 'Aerosol mapping:'
680    else
681      write(nulout,'(a)') 'No aerosol types in radiation scheme'
682    end if
683
684    do jtype = 1,size(i_type_map)
685      if (i_type_map(jtype) > 0) then
686        write(nulout,'(i4,a,a)') jtype, ' -> hydrophobic type ', &
687             &  trim(get_line(this%description_phobic_str, i_type_map(jtype)))
688      else if (i_type_map(jtype) < 0) then
689        write(nulout,'(i4,a,a)') jtype, ' -> hydrophilic type ', &
690             &  trim(get_line(this%description_philic_str, -i_type_map(jtype)))
691      else
692        write(nulout,'(i4,a)') jtype, ' is unused'
693      end if
694    end do
695
696  end subroutine print_description
697
698
699  !---------------------------------------------------------------------
700  ! Private helper function for print_description
701  pure function get_line(str,iline) result(line_str)
702    character(len=*), intent(in)  :: str
703    integer,          intent(in)  :: iline
704    character(len=NMaxLineLength) :: line_str
705
706    integer :: istart, iend, i_start_new, ioffset, ilength, i_line_current
707    logical :: is_fail
708
709    i_line_current = 1
710    istart = 1
711    iend = len(str)
712    is_fail = .false.
713    line_str = ' '
714
715    ! Find index of first character
716    do while (i_line_current < iline)
717      i_start_new = scan(str(istart:iend), new_line(' '))
718      if (i_start_new == 0) then
719        is_fail = .true.
720       ! https://github.com/ecmwf-ifs/ecrad/issues/14
721       ! cycle
722        exit
723      else
724        istart = istart + i_start_new
725      end if
726      i_line_current = i_line_current + 1
727    end do
728
729    if (.not. is_fail) then
730      ! Find index of last character
731      ioffset = scan(str(istart:iend), new_line(' '))
732      if (ioffset == 0) then
733        ilength = len(trim(str(istart:iend)))
734      else
735        ilength = ioffset - 1
736      end if
737
738      if (ilength > NMaxLineLength) then
739        ilength = NMaxLineLength
740      end if
741      iend = istart + ilength - 1
742
743      line_str = str(istart:iend)
744    else
745      write(line_str,'(i0,a)') iline, ': <unknown>'
746    end if
747
748  end function get_line
749
750end module radiation_aerosol_optics_data
Note: See TracBrowser for help on using the repository browser.