da_transform_xtoy_sonde_sfc_adj.inc

1 subroutine da_transform_xtoy_sonde_sfc_adj(xb, iv, xp, jo_grad_y, jo_grad_x)
2 
3    !-----------------------------------------------------------------------
4    ! Purpose: TBD
5    !-----------------------------------------------------------------------
6 
7    implicit none
8 
9    type (xb_type), intent(in)    :: xb          ! first guess state.
10    type (ob_type), intent(in)    :: iv          ! obs. inc vector (o-b).
11    type (xpose_type), intent(in) :: xp          ! Domain decomposition vars.
12    type (y_type) , intent(inout) :: jo_grad_y   ! grad_y(jo)
13    type (x_type) , intent(inout) :: jo_grad_x   ! grad_x(jo)
14 
15    integer                       :: n        ! Loop counter.
16    integer                       :: i, j     ! Index dimension.
17    real                          :: dx, dxm  ! 
18    real                          :: dy, dym  !
19 
20    if (iv%num_sound > 0) then
21       if (sfc_assi_options == 1) then
22          do n=iv%ob_numb(iv%current_ob_time-1)%sound + 1, &
23             iv%ob_numb(iv%current_ob_time)%sound
24             ! [1.1] Get horizontal interpolation weights:
25 
26             i = iv%sonde_sfc(n)%loc%i
27             j = iv%sonde_sfc(n)%loc%j
28             dx = iv%sonde_sfc(n)%loc%dx
29             dy = iv%sonde_sfc(n)%loc%dy
30             dxm = iv%sonde_sfc(n)%loc%dxm
31             dym = iv%sonde_sfc(n)%loc%dym
32 
33             ! [1.2] Interpolate horizontally:
34             call da_interp_obs_lin_2d_adj(jo_grad_x % u, xp, i, j, dx, dy, &
35                dxm, dym, jo_grad_y%sonde_sfc(n)%u, iv%sonde_sfc(n)%zk)
36             call da_interp_obs_lin_2d_adj(jo_grad_x % v, xp, i, j, dx, dy, &
37                dxm, dym, jo_grad_y%sonde_sfc(n)%v, iv%sonde_sfc(n)%zk)
38             call da_interp_obs_lin_2d_adj(jo_grad_x % t, xp, i, j, dx, dy, &
39                dxm, dym, jo_grad_y%sonde_sfc(n)%t, iv%sonde_sfc(n)%zk)
40             call da_interp_obs_lin_2d_adj(jo_grad_x % q, xp, i, j, dx, dy, &
41                dxm, dym, jo_grad_y%sonde_sfc(n)%q, iv%sonde_sfc(n)%zk)
42 
43             call da_interp_lin_2d_adj(jo_grad_x % psfc, xp%ims, xp%ime, &
44                xp%jms, xp%jme, i, j, dx, dy, dxm, dym, &
45                jo_grad_y%sonde_sfc(n)%p)
46          end do
47       else if (sfc_assi_options == 2) then
48          do n=iv%ob_numb(iv%current_ob_time-1)%sound + 1, &
49             iv%ob_numb(iv%current_ob_time)%sound
50             call da_transform_xtopsfc_adj(xb,xp,iv%sonde_sfc(n), &
51                                           jo_grad_y%sonde_sfc(n),jo_grad_x)
52          end do
53       end if
54    end if
55 
56 end subroutine da_transform_xtoy_sonde_sfc_adj
57 
58