UFO
ufo_gnssro_bndropp2d_tlad_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 for gnssro bending angle ropp2d tangent linear and adjoint
7 !> following the ROPP (2018 Aug) implementation
8 
9 module ufo_gnssro_bndropp2d_tlad_mod
10 
11 use fckit_configuration_module, only: fckit_configuration
12 !use iso_c_binding
13 use kinds
14 use ufo_vars_mod
15 use ufo_geovals_mod
16 use ufo_geovals_mod_c, only: ufo_geovals_registry
17 use vert_interp_mod
18 use ufo_basis_tlad_mod, only: ufo_basis_tlad
19 use obsspace_mod
20 use gnssro_mod_conf
21 use missing_values_mod
22 use ufo_gnssro_ropp1d_utils_mod
23 use ufo_gnssro_ropp2d_utils_mod
24 use fckit_log_module, only : fckit_log
25 
26 integer, parameter :: max_string=800
27 
28 !> Fortran derived type for gnssro trajectory
29 type, extends(ufo_basis_tlad) :: ufo_gnssro_bndropp2d_tlad
30  private
31  integer :: nval, nlocs
32  real(kind_real), allocatable :: prs(:,:), t(:,:), q(:,:), gph(:,:), gph_sfc(:,:)
33  integer :: iflip ! geoval ascending order flag
34  type(gnssro_conf) :: roconf ! ro configuration
35  real(kind_real), allocatable :: obslon2d(:), obslat2d(:) !2d locations - nlocs*n_horiz
36  contains
37  procedure :: setup => ufo_gnssro_bndropp2d_tlad_setup
38  procedure :: delete => ufo_gnssro_bndropp2d_tlad_delete
39  procedure :: settraj => ufo_gnssro_bndropp2d_tlad_settraj
40  procedure :: simobs_tl => ufo_gnssro_bndropp2d_simobs_tl
41  procedure :: simobs_ad => ufo_gnssro_bndropp2d_simobs_ad
42 end type ufo_gnssro_bndropp2d_tlad
43 
44 contains
45 
46 ! ------------------------------------------------------------------------------
47 subroutine ufo_gnssro_bndropp2d_tlad_setup(self, f_conf)
48  implicit none
49  class(ufo_gnssro_bndropp2d_tlad), intent(inout) :: self
50  type(fckit_configuration), intent(in) :: f_conf
51 
52  call gnssro_conf_setup(self%roconf,f_conf)
53 
54 end subroutine ufo_gnssro_bndropp2d_tlad_setup
55 
56 ! ------------------------------------------------------------------------------
57 subroutine ufo_gnssro_bndropp2d_tlad_settraj(self, geovals, obss)
58 
59  implicit none
60  class(ufo_gnssro_bndropp2d_tlad), intent(inout) :: self
61  type(ufo_geovals), intent(in) :: geovals
62  type(c_ptr), value, intent(in) :: obss
63  character(len=*), parameter :: myname_="ufo_gnssro_bndropp2d_tlad_settraj"
64  character(max_string) :: err_msg
65  type(ufo_geoval), pointer :: t, q, prs, gph, gph_sfc
66  integer :: i, kerror
67  real(kind_real), allocatable :: obsAzim(:) ! nlocs
68  real(kind_real), allocatable :: obsLat(:), obsLon(:) ! nlocs
69  real(kind_real), allocatable :: obsLonnh(:),obsLatnh(:) ! n_horiz
70  integer :: n_horiz
71  real(kind_real) :: dtheta
72 
73  write(err_msg,*) "TRACE: ufo_gnssro_bndropp2d_tlad_settraj: begin"
74  call fckit_log%info(err_msg)
75 
76 ! get model state variables from geovals
77  call ufo_geovals_get_var(geovals, var_ts, t) ! temperature
78  call ufo_geovals_get_var(geovals, var_q, q) ! specific humidity
79  call ufo_geovals_get_var(geovals, var_prs, prs) ! pressure
80  call ufo_geovals_get_var(geovals, var_z, gph) ! geopotential height
81  call ufo_geovals_get_var(geovals, var_sfc_geomz, gph_sfc) ! surface geopotential height
82  call self%delete()
83 
84  self%nval = prs%nval
85  self%nlocs = obsspace_get_nlocs(obss)
86  self%iflip = 0
87 
88  n_horiz = self%roconf%n_horiz
89  dtheta = self%roconf%dtheta
90 
91  if (prs%vals(1,1) .lt. prs%vals(prs%nval,1) ) then
92  self%iflip = 1
93  write(err_msg,'(a)') ' ufo_gnssro_bndropp2d_tlad_settraj:'//new_line('a')// &
94  ' Model vertical height profile is in descending order,'//new_line('a')// &
95  ' but ROPP requires it to be ascending order, need flip'
96  call fckit_log%info(err_msg)
97  end if
98 
99  allocate(self%obsLat2d(self%nlocs*n_horiz))
100  allocate(self%obsLon2d(self%nlocs*n_horiz))
101 
102  allocate(obslon(self%nlocs))
103  allocate(obslat(self%nlocs))
104  allocate(obsazim(self%nlocs))
105 
106  call obsspace_get_db(obss, "MetaData", "longitude", obslon)
107  call obsspace_get_db(obss, "MetaData", "latitude", obslat)
108  call obsspace_get_db(obss, "MetaData", "sensor_azimuth_angle", obsazim)
109 
110  allocate(obslatnh(n_horiz))
111  allocate(obslonnh(n_horiz))
112 
113  do i = 1, self%nlocs
114  call ropp_fm_2d_plane(obslat(i),obslon(i),obsazim(i),dtheta,n_horiz,obslatnh,obslonnh,kerror)
115  self%obsLon2d((i-1)*n_horiz+1:i*n_horiz) = obslonnh
116  self%obsLat2d((i-1)*n_horiz+1:i*n_horiz) = obslatnh
117  end do
118 
119  deallocate(obslat)
120  deallocate(obslon)
121  deallocate(obslonnh)
122  deallocate(obslatnh)
123  deallocate(obsazim)
124 
125  allocate(self%t(self%nval,self%nlocs*n_horiz))
126  allocate(self%q(self%nval,self%nlocs*n_horiz))
127  allocate(self%prs(self%nval,self%nlocs*n_horiz))
128  allocate(self%gph(self%nval,self%nlocs*n_horiz))
129  allocate(self%gph_sfc(1,self%nlocs*n_horiz))
130 
131 ! allocate
132  self%gph = gph%vals
133  self%t = t%vals
134  self%q = q%vals
135  self%prs = prs%vals
136  self%gph_sfc = gph_sfc%vals
137 
138  self%ltraj = .true.
139 
140 end subroutine ufo_gnssro_bndropp2d_tlad_settraj
141 
142 ! ------------------------------------------------------------------------------
143 ! ------------------------------------------------------------------------------
144 subroutine ufo_gnssro_bndropp2d_simobs_tl(self, geovals, hofx, obss)
145 
146  use ropp_fm_types, only: state2dfm, state1dfm
147  use ropp_fm_types, only: obs1dbangle
148  use datetimetypes, only: dp
149  implicit none
150  class(ufo_gnssro_bndropp2d_tlad), intent(in) :: self
151  type(ufo_geovals), intent(in) :: geovals ! perturbed quantities
152  real(kind_real), intent(inout) :: hofx(:)
153  type(c_ptr), value, intent(in) :: obss
154  real(c_double) :: missing
155 
156  type(state2dfm) :: x,x_tl
157  type(state1dfm) :: x1d,x1d_tl
158  type(obs1dbangle) :: y,y_tl
159 
160  integer :: iobs,nlev, nlocs,nvprof
161 
162  character(len=*), parameter :: myname_="ufo_gnssro_bndropp2d_simobs_tl"
163  character(max_string) :: err_msg
164  type(ufo_geoval), pointer :: t_d, q_d, prs_d
165 
166 ! hack - set local geopotential height to zero for ropp routines
167  real(kind_real), allocatable :: gph_d_zero(:,:)
168  real(kind_real) :: gph_sfc_d_zero
169 ! hack - set local geopotential height to zero for ropp routines
170  real(kind_real), allocatable :: obsImpP(:),obsLocR(:),obsGeoid(:),obsAzim(:) !nlocs
171  real(kind_real), allocatable :: obsLat(:),obsLon(:) !nlocs
172  integer :: n_horiz
173  real(kind_real) :: dtheta
174  real(kind_real) :: ob_time
175 
176  missing = missing_value(missing)
177 
178  n_horiz = self%roconf%n_horiz
179  dtheta = self%roconf%dtheta
180 
181  write(err_msg,*) "TRACE: ufo_gnssro_bndropp2d_simobs_tl: begin"
182  call fckit_log%info(err_msg)
183 
184 ! check if trajectory was set
185  if (.not. self%ltraj) then
186  write(err_msg,*) myname_, ' trajectory wasnt set!'
187  call abor1_ftn(err_msg)
188  endif
189 
190 ! check if nlocs is consistent in geovals & hofx
191  if (geovals%nlocs /= size(hofx)*n_horiz ) then
192  write(err_msg,*) myname_, ' error: 2d nlocs inconsistent! geovals%nlocs, size(hofx), &
193  and n_horiz are', geovals%nlocs, size(hofx), n_horiz
194  call abor1_ftn(err_msg)
195  endif
196 
197 ! get variables from geovals
198  call ufo_geovals_get_var(geovals, var_ts, t_d) ! temperature
199  call ufo_geovals_get_var(geovals, var_q, q_d) ! specific humidity
200  call ufo_geovals_get_var(geovals, var_prs, prs_d) ! pressure
201 
202  nlev = self%nval
203  nlocs = self%nlocs
204 
205  allocate(gph_d_zero(nlev,nlocs*n_horiz))
206  gph_d_zero = 0.0
207  gph_sfc_d_zero = 0.0
208 
209 ! set obs space struture
210  allocate(obslon(nlocs))
211  allocate(obslat(nlocs))
212  allocate(obsimpp(nlocs))
213  allocate(obslocr(nlocs))
214  allocate(obsgeoid(nlocs))
215  allocate(obsazim(nlocs))
216  call obsspace_get_db(obss, "MetaData", "longitude", obslon)
217  call obsspace_get_db(obss, "MetaData", "latitude", obslat)
218  call obsspace_get_db(obss, "MetaData", "impact_parameter", obsimpp)
219  call obsspace_get_db(obss, "MetaData", "earth_radius_of_curvature", obslocr)
220  call obsspace_get_db(obss, "MetaData", "geoid_height_above_reference_ellipsoid", obsgeoid)
221  call obsspace_get_db(obss, "MetaData", "sensor_azimuth_angle", obsazim)
222 
223  nvprof = 1 ! no. of bending angles in profile
224  ob_time = 0.0
225 
226 ! loop through the obs
227  obs_loop: do iobs = 1, nlocs ! order of loop doesn't matter
228 
229  if ( ( obsimpp(iobs)-obslocr(iobs)-obsgeoid(iobs) ) <= self%roconf%top_2d .and. &
230  obsazim(iobs) /= missing ) then
231 
232 ! map the trajectory to ROPP 2D structure x
233  call init_ropp_2d_statevec(self%obsLon2d( (iobs-1)*n_horiz+1:iobs*n_horiz ), &
234  self%obsLat2d( (iobs-1)*n_horiz+1:iobs*n_horiz ), &
235  self%t(:,(iobs-1)*n_horiz+1:iobs*n_horiz), &
236  self%q(:,(iobs-1)*n_horiz+1:iobs*n_horiz), &
237  self%prs(:,(iobs-1)*n_horiz+1:iobs*n_horiz), &
238  self%gph(:,(iobs-1)*n_horiz+1:iobs*n_horiz), &
239  nlev, x, n_horiz, dtheta, self%iflip)
240 
241 ! hack -- make non zero humidity to avoid zero denominator in tangent linear
242 ! see ropp_fm/bangle_1d/ropp_fm_bangle_1d_tl.f90
243  where(x%shum .le. 1e-8) x%shum = 1e-8
244 ! hack -- make non zero humidity to avoid zero denominator in tangent linear
245 
246  call init_ropp_2d_statevec(self%obsLon2d( (iobs-1)*n_horiz+1:iobs*n_horiz ), &
247  self%obsLat2d( (iobs-1)*n_horiz+1:iobs*n_horiz ), &
248  t_d%vals(:,(iobs-1)*n_horiz+1:iobs*n_horiz), &
249  q_d%vals(:,(iobs-1)*n_horiz+1:iobs*n_horiz), &
250  prs_d%vals(:,(iobs-1)*n_horiz+1:iobs*n_horiz), &
251  gph_d_zero(:,(iobs-1)*n_horiz+1:iobs*n_horiz), &
252  nlev, x_tl, n_horiz, dtheta, self%iflip)
253 
254 ! set both y and y_tl structures
255  call init_ropp_2d_obvec_tlad(iobs, nvprof, &
256  obsimpp(iobs), &
257  obslat(iobs), &
258  obslon(iobs), &
259  obslocr(iobs), &
260  obsgeoid(iobs), &
261  y,y_tl)
262 
263 ! now call TL of forward model
264  call ropp_fm_bangle_2d_tl(x,x_tl,y, y_tl)
265  hofx(iobs) = y_tl%bangle(nvprof) ! this will need to change if profile is passed
266 
267 ! tidy up -deallocate ropp structures
268  call ropp_tidy_up_tlad_2d(x,x_tl,y,y_tl)
269 
270  else ! apply ropp1d above top_2d or when azimuth angle is missing
271 
272 ! map the trajectory to ROPP 1D structure x1d
273  call init_ropp_1d_statevec(ob_time, &
274  obslon(iobs), &
275  obslat(iobs), &
276  self%t(:,(iobs-1)*n_horiz+1+(n_horiz-1)/2), &
277  self%q(:,(iobs-1)*n_horiz+1+(n_horiz-1)/2), &
278  self%prs(:,(iobs-1)*n_horiz+1+(n_horiz-1)/2), &
279  self%gph(:,(iobs-1)*n_horiz+1+(n_horiz-1)/2), &
280  nlev, &
281  self%gph_sfc(1,(iobs-1)*n_horiz+1+(n_horiz-1)/2), &
282  x1d, self%iflip)
283 
284  where(x1d%shum .le. 1e-8) x1d%shum = 1e-8
285 
286  call init_ropp_1d_statevec( ob_time, &
287  obslon(iobs), &
288  obslat(iobs), &
289  t_d%vals(:,(iobs-1)*n_horiz+1+(n_horiz-1)/2), &
290  q_d%vals(:,(iobs-1)*n_horiz+1+(n_horiz-1)/2), &
291  prs_d%vals(:,(iobs-1)*n_horiz+1+(n_horiz-1)/2), &
292  gph_d_zero(:,(iobs-1)*n_horiz+1+(n_horiz-1)/2), &
293  nlev, &
294  gph_sfc_d_zero, &
295  x1d_tl, self%iflip)
296 
297 ! y and y_tl structures
298  call init_ropp_1d_obvec_tlad(iobs, nvprof, &
299  obsimpp(iobs), &
300  obslat(iobs), &
301  obslon(iobs), &
302  obslocr(iobs), &
303  obsgeoid(iobs), &
304  y,y_tl)
305 
306 ! TL
307  call ropp_fm_bangle_1d_tl(x1d,x1d_tl,y,y_tl%bangle(nvprof))
308  hofx(iobs) = y_tl%bangle(nvprof)
309 
310 ! tidy up
311  call ropp_tidy_up_tlad_1d(x1d,x1d_tl,y,y_tl)
312  end if
313  end do obs_loop
314 
315 ! tidy up - deallocate obsspace structures
316  deallocate(obslat)
317  deallocate(obslon)
318  deallocate(obsimpp)
319  deallocate(obslocr)
320  deallocate(obsgeoid)
321  deallocate(obsazim)
322  deallocate(gph_d_zero)
323 
324  write(err_msg,*) "TRACE: ufo_gnssro_bndropp2d_simobs_tl: complete"
325  call fckit_log%info(err_msg)
326 
327  return
328 
329 end subroutine ufo_gnssro_bndropp2d_simobs_tl
330 
331 ! ------------------------------------------------------------------------------
332 ! ------------------------------------------------------------------------------
333 subroutine ufo_gnssro_bndropp2d_simobs_ad(self, geovals, hofx, obss)
334 
335  use ropp_fm_types, only: state2dfm, state1dfm
336  use ropp_fm_types, only: obs1dbangle
337  use typesizes, only: wp => eightbytereal
338  use datetimetypes, only: dp
339 
340  implicit none
341  class(ufo_gnssro_bndropp2d_tlad), intent(in) :: self
342  type(ufo_geovals), intent(inout) :: geovals ! perturbed quantities
343  real(kind_real), intent(in) :: hofx(:)
344  type(c_ptr), value, intent(in) :: obss
345  real(c_double) :: missing
346 
347  type(ufo_geoval), pointer :: t_d, q_d, prs_d
348 
349 ! set local geopotential height to zero for ropp routines
350  real(kind_real), allocatable :: gph_d_zero(:,:)
351  real(kind_real) :: gph_sfc_d_zero
352 
353  real(kind_real), allocatable :: obsLat(:), obsLon(:), obsImpP(:), obsLocR(:), obsGeoid(:)
354  real(kind_real), allocatable :: obsAzim(:)
355  type(state2dfm) :: x,x_ad
356  type(state1dfm) :: x1d,x1d_ad
357  type(obs1dbangle) :: y,y_ad
358  integer :: iobs,nlev,nlocs,nvprof
359  character(len=*), parameter :: myname_="ufo_gnssro_bndropp2d_simobs_ad"
360  character(max_string) :: err_msg
361  integer :: n_horiz
362  real(kind_real) :: dtheta
363  real(kind_real) :: ob_time
364 
365  n_horiz = self%roconf%n_horiz
366  dtheta = self%roconf%dtheta
367 
368  write(err_msg,*) "TRACE: ufo_gnssro_bndropp2d_simobs_ad: begin"
369  call fckit_log%info(err_msg)
370 
371 ! check if trajectory was set
372  if (.not. self%ltraj) then
373  write(err_msg,*) myname_, ' trajectory wasnt set!'
374  call abor1_ftn(err_msg)
375  endif
376 ! check if nlocs is consistent in geovals & hofx
377  if (geovals%nlocs /= size(hofx)*n_horiz) then
378  write(err_msg,*) myname_, ' error: 2d nlocs inconsistent!'
379  call abor1_ftn(err_msg)
380  endif
381 
382 ! get variables from geovals
383  call ufo_geovals_get_var(geovals, var_ts, t_d) ! temperature
384  call ufo_geovals_get_var(geovals, var_q, q_d) ! specific humidity
385  call ufo_geovals_get_var(geovals, var_prs, prs_d) ! pressure
386 
387  nlev = self%nval
388  nlocs = self%nlocs
389 
390  allocate(gph_d_zero(nlev,nlocs*n_horiz))
391  gph_d_zero = 0.0
392  gph_sfc_d_zero = 0.0
393 
394 ! set obs space struture
395  allocate(obslon(nlocs))
396  allocate(obslat(nlocs))
397  allocate(obsimpp(nlocs))
398  allocate(obslocr(nlocs))
399  allocate(obsgeoid(nlocs))
400  allocate(obsazim(nlocs))
401 
402  call obsspace_get_db(obss, "MetaData", "longitude", obslon)
403  call obsspace_get_db(obss, "MetaData", "latitude", obslat)
404  call obsspace_get_db(obss, "MetaData", "impact_parameter", obsimpp)
405  call obsspace_get_db(obss, "MetaData", "earth_radius_of_curvature", obslocr)
406  call obsspace_get_db(obss, "MetaData", "geoid_height_above_reference_ellipsoid", obsgeoid)
407  call obsspace_get_db(obss, "MetaData", "sensor_azimuth_angle", obsazim)
408 
409  missing = missing_value(missing)
410 
411 ! loop through the obs
412  nvprof = 1 ! no. of bending angles in profile
413  ob_time = 0.0
414 
415  obs_loop: do iobs = 1, nlocs
416 
417  if (hofx(iobs) .gt. missing) then
418  if ( ( obsimpp(iobs)-obslocr(iobs)-obsgeoid(iobs) ) <= self%roconf%top_2d .and. &
419  obsazim(iobs) /= missing ) then
420 
421 ! map the trajectory to ROPP structure x
422  call init_ropp_2d_statevec(self%obsLon2d((iobs-1)*n_horiz+1:iobs*n_horiz), &
423  self%obsLat2d((iobs-1)*n_horiz+1:iobs*n_horiz), &
424  self%t(:,(iobs-1)*n_horiz+1:iobs*n_horiz), &
425  self%q(:,(iobs-1)*n_horiz+1:iobs*n_horiz), &
426  self%prs(:,(iobs-1)*n_horiz+1:iobs*n_horiz), &
427  self%gph(:,(iobs-1)*n_horiz+1:iobs*n_horiz), &
428  nlev, x, n_horiz, dtheta, self%iflip)
429 
430  call init_ropp_2d_statevec(self%obsLon2d( (iobs-1)*n_horiz+1:iobs*n_horiz ), &
431  self%obsLat2d( (iobs-1)*n_horiz+1:iobs*n_horiz ), &
432  t_d%vals(:,(iobs-1)*n_horiz+1:iobs*n_horiz), &
433  q_d%vals(:,(iobs-1)*n_horiz+1:iobs*n_horiz), &
434  prs_d%vals(:,(iobs-1)*n_horiz+1:iobs*n_horiz), &
435  gph_d_zero(:,(iobs-1)*n_horiz+1:iobs*n_horiz), &
436  nlev, x_ad, n_horiz, dtheta, self%iflip)
437 
438  ! x_ad is local so initialise to 0.0
439  x_ad%temp(:,:) = 0.0_wp
440  x_ad%pres(:,:) = 0.0_wp
441  x_ad%shum(:,:) = 0.0_wp
442  x_ad%geop(:,:) = 0.0_wp
443 
444  ! set both y and y_ad structures
445  call init_ropp_2d_obvec_tlad(iobs, nvprof, &
446  obsimpp(iobs), &
447  obslat(iobs), &
448  obslon(iobs), &
449  obslocr(iobs), &
450  obsgeoid(iobs), &
451  y,y_ad)
452 
453 
454 ! local variable initialise
455  y_ad%bangle(:) = 0.0_wp
456 
457 ! now call AD of forward model
458  y_ad%bangle(nvprof) = y_ad%bangle(nvprof) + hofx(iobs)
459  call ropp_fm_bangle_2d_ad(x,x_ad,y,y_ad)
460 
461  call init_ropp_2d_statevec_ad( &
462  t_d%vals(:,(iobs-1)*n_horiz+1:iobs*n_horiz), &
463  q_d%vals(:,(iobs-1)*n_horiz+1:iobs*n_horiz), &
464  prs_d%vals(:,(iobs-1)*n_horiz+1:iobs*n_horiz), &
465  gph_d_zero(:,(iobs-1)*n_horiz+1:iobs*n_horiz), &
466 
467  nlev, x_ad, n_horiz,self%iflip)
468 
469 ! tidy up - deallocate ropp structures
470  call ropp_tidy_up_tlad_2d(x,x_ad,y,y_ad)
471 
472  else ! apply ropp1d above top_2d or when azimuth angle is missing
473 
474 ! map the trajectory to ROPP 1D structure x1d
475  call init_ropp_1d_statevec( ob_time, &
476  obslon(iobs), &
477  obslat(iobs), &
478  self%t(:,(iobs-1)*n_horiz+1+(n_horiz-1)/2), &
479  self%q(:,(iobs-1)*n_horiz+1+(n_horiz-1)/2), &
480  self%prs(:,(iobs-1)*n_horiz+1+(n_horiz-1)/2), &
481  self%gph(:,(iobs-1)*n_horiz+1+(n_horiz-1)/2), &
482  nlev, &
483  self%gph_sfc(1,(iobs-1)*n_horiz+1+(n_horiz-1)/2), &
484  x1d, self%iflip)
485 
486  call init_ropp_1d_statevec( ob_time, &
487  obslon(iobs), &
488  obslat(iobs), &
489  t_d%vals(:,(iobs-1)*n_horiz+1+(n_horiz-1)/2), &
490  q_d%vals(:,(iobs-1)*n_horiz+1+(n_horiz-1)/2), &
491  prs_d%vals(:,(iobs-1)*n_horiz+1+(n_horiz-1)/2), &
492  gph_d_zero(:,(iobs-1)*n_horiz+1+(n_horiz-1)/2), &
493  nlev, &
494  gph_sfc_d_zero, &
495  x1d_ad, self%iflip)
496 
497 
498  ! x_ad is local so initialise to 0.0
499  x1d_ad%temp(:) = 0.0_wp
500  x1d_ad%pres(:) = 0.0_wp
501  x1d_ad%shum(:) = 0.0_wp
502  x1d_ad%geop(:) = 0.0_wp
503 
504  ! set both y and y_ad structures
505  call init_ropp_1d_obvec_tlad(iobs, nvprof, &
506  obsimpp(iobs), &
507  obslat(iobs), &
508  obslon(iobs), &
509  obslocr(iobs), &
510  obsgeoid(iobs), &
511  y,y_ad)
512 
513 
514 ! local variable initialise
515  y_ad%bangle(:) = 0.0_wp
516 
517 ! now call AD of forward model
518  y_ad%bangle(nvprof) = y_ad%bangle(nvprof) + hofx(iobs)
519  call ropp_fm_bangle_1d_ad(x1d,x1d_ad,y,y_ad)
520  call init_ropp_1d_statevec_ad( &
521  t_d%vals(:,(iobs-1)*n_horiz+1+(n_horiz-1)/2), &
522  q_d%vals(:,(iobs-1)*n_horiz+1+(n_horiz-1)/2), &
523  prs_d%vals(:,(iobs-1)*n_horiz+1+(n_horiz-1)/2), &
524  gph_d_zero(:,(iobs-1)*n_horiz+1+(n_horiz-1)/2), &
525  nlev, x1d_ad, self%iflip)
526 
527 ! tidy up
528  call ropp_tidy_up_tlad_1d(x1d,x1d_ad,y,y_ad)
529 
530  end if ! end top_2d check
531 
532  end if ! end missing value check
533 
534  end do obs_loop
535 
536 ! tidy up - deallocate obsspace structures
537  deallocate(obslat)
538  deallocate(obslon)
539  deallocate(obsimpp)
540  deallocate(obslocr)
541  deallocate(obsgeoid)
542  deallocate(obsazim)
543  deallocate(gph_d_zero)
544 
545  write(err_msg,*) "TRACE: ufo_gnssro_bndropp2d_simobs_ad: complete"
546  call fckit_log%info(err_msg)
547 
548  return
549 
550 end subroutine ufo_gnssro_bndropp2d_simobs_ad
551 
552 !-------------------------------------------------------------------------
553 !-------------------------------------------------------------------------
554 subroutine ufo_gnssro_bndropp2d_tlad_delete(self)
555 
556  implicit none
557  class(ufo_gnssro_bndropp2d_tlad), intent(inout) :: self
558  character(len=*), parameter :: myname_="ufo_gnssro_bndropp_tlad_delete"
559 
560  self%nval = 0
561  if (allocated(self%prs)) deallocate(self%prs)
562  if (allocated(self%t)) deallocate(self%t)
563  if (allocated(self%q)) deallocate(self%q)
564  if (allocated(self%gph)) deallocate(self%gph)
565  if (allocated(self%gph_sfc)) deallocate(self%gph_sfc)
566  if (allocated(self%obsLat2d)) deallocate(self%obsLat2d)
567  if (allocated(self%obsLon2d)) deallocate(self%obsLon2d)
568 
569  self%ltraj = .false.
570 
571 end subroutine ufo_gnssro_bndropp2d_tlad_delete
572 
573 !-------------------------------------------------------------------------
574 
575 end module ufo_gnssro_bndropp2d_tlad_mod
gnssro_mod_conf
Definition: gnssro_mod_conf.F90:2
gnssro_mod_conf::gnssro_conf_setup
subroutine, public gnssro_conf_setup(roconf, f_conf)
Definition: gnssro_mod_conf.F90:36
ufo_basis_tlad_mod
Definition: ufo_basis_tlad_mod.F90:6
ufo_geovals_mod_c
Definition: GeoVaLs.interface.F90:7
ufo_geovals_mod_c::ufo_geovals_registry
type(registry_t), public ufo_geovals_registry
Linked list interface - defines registry_t type.
Definition: GeoVaLs.interface.F90:27
ufo_geovals_mod
Definition: ufo_geovals_mod.F90:7
ufo_geovals_mod::ufo_geovals_get_var
subroutine, public ufo_geovals_get_var(self, varname, geoval)
Definition: ufo_geovals_mod.F90:206
ufo_gnssro_bndropp2d_tlad_mod
Fortran module for gnssro bending angle ropp2d tangent linear and adjoint following the ROPP (2018 Au...
Definition: ufo_gnssro_bndropp2d_tlad_mod.F90:9
ufo_gnssro_bndropp2d_tlad_mod::ufo_gnssro_bndropp2d_simobs_ad
subroutine ufo_gnssro_bndropp2d_simobs_ad(self, geovals, hofx, obss)
Definition: ufo_gnssro_bndropp2d_tlad_mod.F90:334
ufo_gnssro_bndropp2d_tlad_mod::ufo_gnssro_bndropp2d_tlad_settraj
subroutine ufo_gnssro_bndropp2d_tlad_settraj(self, geovals, obss)
Definition: ufo_gnssro_bndropp2d_tlad_mod.F90:58
ufo_gnssro_bndropp2d_tlad_mod::ufo_gnssro_bndropp2d_tlad_delete
subroutine ufo_gnssro_bndropp2d_tlad_delete(self)
Definition: ufo_gnssro_bndropp2d_tlad_mod.F90:555
ufo_gnssro_bndropp2d_tlad_mod::ufo_gnssro_bndropp2d_simobs_tl
subroutine ufo_gnssro_bndropp2d_simobs_tl(self, geovals, hofx, obss)
Definition: ufo_gnssro_bndropp2d_tlad_mod.F90:145
ufo_gnssro_bndropp2d_tlad_mod::max_string
integer, parameter max_string
Definition: ufo_gnssro_bndropp2d_tlad_mod.F90:26
ufo_gnssro_bndropp2d_tlad_mod::ufo_gnssro_bndropp2d_tlad_setup
subroutine ufo_gnssro_bndropp2d_tlad_setup(self, f_conf)
Definition: ufo_gnssro_bndropp2d_tlad_mod.F90:48
ufo_gnssro_ropp1d_utils_mod
Fortran module to handle gnssro bending angle observations following the ROPP (2018 Aug) implementati...
Definition: ufo_gnssro_ropp1d_utils_mod.F90:9
ufo_gnssro_ropp1d_utils_mod::init_ropp_1d_statevec_ad
subroutine, public init_ropp_1d_statevec_ad(temp_d, shum_d, pres_d, phi_d, lm, x_ad, iflip)
Definition: ufo_gnssro_ropp1d_utils_mod.F90:166
ufo_gnssro_ropp1d_utils_mod::init_ropp_1d_statevec
subroutine, public init_ropp_1d_statevec(step_time, rlon, rlat, temp, shum, pres, phi, lm, phi_sfc, x, iflip)
Definition: ufo_gnssro_ropp1d_utils_mod.F90:37
ufo_gnssro_ropp1d_utils_mod::ropp_tidy_up_tlad_1d
subroutine, public ropp_tidy_up_tlad_1d(x, x_p, y, y_p)
Definition: ufo_gnssro_ropp1d_utils_mod.F90:399
ufo_gnssro_ropp1d_utils_mod::init_ropp_1d_obvec_tlad
subroutine, public init_ropp_1d_obvec_tlad(iloop, nvprof, obs_impact, rlat, rlon, roc, undulat, y, y_p)
Definition: ufo_gnssro_ropp1d_utils_mod.F90:326
ufo_gnssro_ropp2d_utils_mod
Fortran module to handle gnssro bending angle observations following the ROPP (2018 Aug) implementati...
Definition: ufo_gnssro_ropp2d_utils_mod.F90:9
ufo_gnssro_ropp2d_utils_mod::init_ropp_2d_statevec
subroutine, public init_ropp_2d_statevec(rlon, rlat, temp, shum, pres, phi, lm, x, n_horiz, dtheta, iflip)
Definition: ufo_gnssro_ropp2d_utils_mod.F90:36
ufo_gnssro_ropp2d_utils_mod::ropp_tidy_up_tlad_2d
subroutine, public ropp_tidy_up_tlad_2d(x, x_p, y, y_p)
Definition: ufo_gnssro_ropp2d_utils_mod.F90:374
ufo_gnssro_ropp2d_utils_mod::init_ropp_2d_obvec_tlad
subroutine, public init_ropp_2d_obvec_tlad(iloop, nvprof, obs_impact, rlat, rlon, roc, undulat, y, y_p)
Definition: ufo_gnssro_ropp2d_utils_mod.F90:271
ufo_gnssro_ropp2d_utils_mod::init_ropp_2d_statevec_ad
subroutine, public init_ropp_2d_statevec_ad(temp_d, shum_d, pres_d, phi_d, lm, x_ad, n_horiz, iflip)
Definition: ufo_gnssro_ropp2d_utils_mod.F90:125
ufo_vars_mod
Definition: ufo_variables_mod.F90:8
ufo_vars_mod::var_prs
character(len=maxvarlen), parameter, public var_prs
Definition: ufo_variables_mod.F90:25
ufo_vars_mod::var_q
character(len=maxvarlen), parameter, public var_q
Definition: ufo_variables_mod.F90:22
ufo_vars_mod::var_sfc_geomz
character(len=maxvarlen), parameter, public var_sfc_geomz
Definition: ufo_variables_mod.F90:75
ufo_vars_mod::var_z
character(len=maxvarlen), parameter, public var_z
Definition: ufo_variables_mod.F90:29
ufo_vars_mod::var_ts
character(len=maxvarlen), parameter, public var_ts
Definition: ufo_variables_mod.F90:19
vert_interp_mod
Fortran module to perform linear interpolation.
Definition: vert_interp.F90:8
gnssro_mod_conf::gnssro_conf
Definition: gnssro_mod_conf.F90:14
ufo_basis_tlad_mod::ufo_basis_tlad
Definition: ufo_basis_tlad_mod.F90:12
ufo_geovals_mod::ufo_geoval
type to hold interpolated field for one variable, one observation
Definition: ufo_geovals_mod.F90:40
ufo_geovals_mod::ufo_geovals
type to hold interpolated fields required by the obs operators
Definition: ufo_geovals_mod.F90:47
ufo_gnssro_bndropp2d_tlad_mod::ufo_gnssro_bndropp2d_tlad
Fortran derived type for gnssro trajectory.
Definition: ufo_gnssro_bndropp2d_tlad_mod.F90:29