UFO
ufo_aodluts_mod.F90
Go to the documentation of this file.
1 ! (c) copyright 2017-2018 ucar
2 !
3 ! this software is licensed under the terms of the apache licence version 2.0
4 ! which can be obtained at http://www.apache.org/licenses/license-2.0.
5 
6 !> fortran module to handle aod observations
7 
9 
10  USE fckit_configuration_module, ONLY: fckit_configuration
11  USE iso_c_binding
12  USE kinds
13  USE missing_values_mod
14 
16  USE ufo_vars_mod
20  USE crtm_module
21  USE crtm_spccoeff, ONLY: sc
22  USE obsspace_mod
23 
24  USE fv3_mieobs_mod, ONLY: get_fv3_aod
25 
26  IMPLICIT NONE
27  PRIVATE
28 
29 !> fortran derived type for aod trajectory
30  TYPE, PUBLIC :: ufo_aodluts
31  PRIVATE
32  CHARACTER(len=maxvarlen), PUBLIC, ALLOCATABLE :: varin(:) ! variablesrequested from the model
33  INTEGER, ALLOCATABLE :: channels(:)
34  REAL(kind_real), ALLOCATABLE :: wavelenghts(:)
35  INTEGER :: n_aerosols
36  TYPE(luts_conf) :: conf
37  CONTAINS
38  PROCEDURE :: setup => ufo_aodluts_setup
39  PROCEDURE :: delete => ufo_aodluts_delete
40  PROCEDURE :: simobs => ufo_aodluts_simobs
41  END TYPE ufo_aodluts
42  CHARACTER(len=maxvarlen), DIMENSION(4), PARAMETER :: varin_default = &
44 
45  CHARACTER(maxvarlen), PARAMETER :: varname_tmplate="aerosol_optical_depth"
46 
47 CONTAINS
48 
49 ! ------------------------------------------------------------------------------
50 
51  SUBROUTINE ufo_aodluts_setup(self, f_confoper, channels)
52 
53  IMPLICIT NONE
54  CLASS(ufo_aodluts), INTENT(inout) :: self
55  TYPE(fckit_configuration), INTENT(in) :: f_confoper
56  INTEGER(c_int), INTENT(in) :: channels(:) !list of channels to use
57 
58  INTEGER :: nvars_in, rc
59  CHARACTER(len=max_string) :: err_msg
60  TYPE(fckit_configuration) :: f_confopts
61 
62  CHARACTER(len=maxvarlen), ALLOCATABLE :: var_aerosols(:)
63 
64  CALL f_confoper%get_or_die("obs options",f_confopts)
65 
66  CALL luts_conf_setup(self%conf, f_confopts, f_confoper)
67 
68  CALL assign_aerosol_names(self%conf%aerosol_option,var_aerosols)
69 
70  self%n_aerosols=SIZE(var_aerosols)
71  nvars_in = SIZE(varin_default)+self%n_aerosols
72 
73  ALLOCATE(self%varin(nvars_in))
74  self%varin(1:SIZE(varin_default)) = varin_default
75  self%varin(SIZE(varin_default)+1:) = var_aerosols
76 
77  ALLOCATE(self%channels(SIZE(channels)))
78  ALLOCATE(self%wavelenghts(SIZE(channels)))
79 
80  self%channels(:) = channels(:)
81 
82  DEALLOCATE(var_aerosols)
83 
84  END SUBROUTINE ufo_aodluts_setup
85 
86 ! ------------------------------------------------------------------------------
87 
88  SUBROUTINE ufo_aodluts_delete(self)
89 
90  IMPLICIT NONE
91  CLASS(ufo_aodluts), INTENT(inout) :: self
92 
93  CALL luts_conf_delete(self%conf)
94 
95  IF (ALLOCATED(self%varin)) DEALLOCATE(self%varin)
96  IF (ALLOCATED(self%channels)) DEALLOCATE(self%channels)
97  IF (ALLOCATED(self%wavelenghts)) DEALLOCATE(self%wavelenghts)
98 
99  END SUBROUTINE ufo_aodluts_delete
100 
101 ! ------------------------------------------------------------------------------
102 
103  SUBROUTINE ufo_aodluts_simobs(self, geovals, obss, nvars, nlocs, hofx)
104 
105  IMPLICIT NONE
106  CLASS(ufo_aodluts), INTENT(inout) :: self
107  TYPE(ufo_geovals), INTENT(in) :: geovals
108  INTEGER, INTENT(in) :: nvars, nlocs
109  REAL(c_double), INTENT(inout) :: hofx(nvars, nlocs)
110  TYPE(c_ptr), VALUE, INTENT(in) :: obss
111 
112 ! local variables
113  CHARACTER(*), PARAMETER :: program_name = 'ufo_aodluts_mod.f90'
114  CHARACTER(255) :: message, version
115  INTEGER :: err_stat, alloc_stat
116  INTEGER :: l, m, n, i
117  TYPE(ufo_geoval), POINTER :: temp
118  REAL(c_double) :: missing
119 
120  INTEGER :: n_profiles
121  INTEGER :: n_layers
122  INTEGER :: n_channels
123  INTEGER :: n_aerosols
124 
125 ! define the "non-demoninational" arguments
126  TYPE(crtm_channelinfo_type) :: chinfo(self%conf%n_sensors)
127 
128  REAL(kind_real), ALLOCATABLE :: wavelenghts_all(:)
129  REAL(kind_real), ALLOCATABLE :: aero_layers(:,:,:),rh(:,:)
130 
131  CHARACTER(len=maxvarlen), ALLOCATABLE :: var_aerosols(:)
132 
133  INTEGER :: rc
134 
135  CALL assign_aerosol_names(self%conf%aerosol_option,var_aerosols)
136 
137  n_profiles = geovals%nlocs
138  CALL ufo_geovals_get_var(geovals, var_aerosols(1), temp)
139  n_layers = temp%nval
140  NULLIFY(temp)
141 
142  n_aerosols=self%n_aerosols
143 
144  ALLOCATE(aero_layers(n_aerosols,n_layers,n_profiles),&
145  &rh(n_layers,n_profiles))
146 
147  err_stat = crtm_init( self%conf%sensor_id, &
148  chinfo, &
149  file_path=trim(self%conf%coefficient_path), &
150  quiet=.true.)
151 
152  IF ( err_stat /= success ) THEN
153  message = 'error initializing crtm'
154  CALL display_message( program_name, message, failure )
155  stop
156  END IF
157 
158  sensor_loop:DO n = 1, self%conf%n_sensors
159 
160  n_channels = crtm_channelinfo_n_channels(chinfo(n))
161 
162  IF (ALLOCATED(wavelenghts_all)) DEALLOCATE(wavelenghts_all)
163 
164  ALLOCATE(wavelenghts_all(n_channels), stat = alloc_stat)
165 
166  IF ( alloc_stat /= 0 ) THEN
167  message = 'error allocating wavelenghts_all'
168  CALL display_message( program_name, message, failure )
169  stop
170  END IF
171 
172  wavelenghts_all=1.e7/sc(chinfo(n)%sensor_index)%wavenumber(:)
173 
174  self%wavelenghts=wavelenghts_all(self%channels)
175 
176  CALL calculate_aero_layers(self%conf%aerosol_option,&
177  &n_aerosols, n_profiles, n_layers,&
178  &geovals, aero_layers=aero_layers, rh=rh)
179 
180  CALL get_fv3_aod(n_layers, n_profiles, nvars, n_aerosols, &
181  &self%conf%rcfile, &
182  &self%wavelenghts, var_aerosols, aero_layers, rh, &
183  &aod_tot = hofx, rc = rc)
184 
185  DEALLOCATE(aero_layers,rh,wavelenghts_all)
186 
187  IF (rc /= 0) THEN
188  message = 'error on exit from get_fv3_aod'
189  CALL display_message( program_name, message, failure )
190  stop
191  END IF
192 
193  END DO sensor_loop
194 
195  err_stat = crtm_destroy( chinfo )
196  IF ( err_stat /= success ) THEN
197  message = 'error destroying crtm (settraj)'
198  CALL display_message( program_name, message, failure )
199  stop
200  END IF
201 
202  END SUBROUTINE ufo_aodluts_simobs
203 
204 ! ------------------------------------------------------------------------------
205 
206 END MODULE ufo_aodluts_mod
ufo_avgkernel_mod::max_string
integer, parameter max_string
Definition: ufo_avgkernel_mod.F90:17
ufo_aodluts_mod::ufo_aodluts_simobs
subroutine ufo_aodluts_simobs(self, geovals, obss, nvars, nlocs, hofx)
Definition: ufo_aodluts_mod.F90:104
ufo_crtm_utils_mod::assign_aerosol_names
subroutine, public assign_aerosol_names(aerosol_option, var_aerosols)
Definition: ufo_crtm_utils_mod.F90:1008
ufo_aodluts_mod
fortran module to handle aod observations
Definition: ufo_aodluts_mod.F90:8
ufo_luts_utils_mod::calculate_aero_layers
subroutine, public calculate_aero_layers(aerosol_option, n_aerosols, n_profiles, n_layers, geovals, aero_layers, rh, layer_factors)
Definition: ufo_luts_utils_mod.F90:93
ufo_luts_utils_mod
fortran module to provide code shared between nonlinear and tlm/adm radiance calculations
Definition: ufo_luts_utils_mod.F90:8
ufo_aodluts_mod::ufo_aodluts
fortran derived type for aod trajectory
Definition: ufo_aodluts_mod.F90:30
ufo_crtm_utils_mod
Fortran module to provide code shared between nonlinear and tlm/adm radiance calculations.
Definition: ufo_crtm_utils_mod.F90:8
ufo_geovals_mod
Definition: ufo_geovals_mod.F90:7
ufo_aodcrtm_mod::varname_tmplate
character(maxvarlen), parameter varname_tmplate
Definition: ufo_aodcrtm_mod.F90:37
ufo_vars_mod::var_prsi
character(len=maxvarlen), parameter, public var_prsi
Definition: ufo_variables_mod.F90:26
ufo_luts_utils_mod::luts_conf_delete
subroutine, public luts_conf_delete(conf)
Definition: ufo_luts_utils_mod.F90:80
ufo_aodcrtm_mod::varin_default
character(len=maxvarlen), dimension(5), parameter varin_default
Definition: ufo_aodcrtm_mod.F90:35
ufo_vars_mod
Definition: ufo_variables_mod.F90:8
ufo_geovals_mod::ufo_geovals_get_var
subroutine, public ufo_geovals_get_var(self, varname, geoval)
Definition: ufo_geovals_mod.F90:128
ufo_vars_mod::var_q
character(len=maxvarlen), parameter, public var_q
Definition: ufo_variables_mod.F90:22
ufo_luts_utils_mod::luts_conf
Definition: ufo_luts_utils_mod.F90:37
ufo_vars_mod::var_ts
character(len=maxvarlen), parameter, public var_ts
Definition: ufo_variables_mod.F90:19
ufo_geovals_mod::ufo_geovals
type to hold interpolated fields required by the obs operators
Definition: ufo_geovals_mod.F90:47
ufo_aodluts_mod::ufo_aodluts_setup
subroutine ufo_aodluts_setup(self, f_confoper, channels)
Definition: ufo_aodluts_mod.F90:52
ufo_geovals_mod::ufo_geoval
type to hold interpolated field for one variable, one observation
Definition: ufo_geovals_mod.F90:40
conf
Definition: conf.py:1
ufo_vars_mod::var_prs
character(len=maxvarlen), parameter, public var_prs
Definition: ufo_variables_mod.F90:25
ufo_luts_utils_mod::luts_conf_setup
subroutine, public luts_conf_setup(conf, f_confopts, f_confoper)
Definition: ufo_luts_utils_mod.F90:51
ufo_aodluts_mod::ufo_aodluts_delete
subroutine ufo_aodluts_delete(self)
Definition: ufo_aodluts_mod.F90:89