da_transform_xtoy_synop_adj.inc

1 subroutine da_transform_xtoy_synop_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_synop > 0) then
21       if (sfc_assi_options == 1) then
22          do n=iv%ob_numb(iv%current_ob_time-1)%synop + 1, iv%ob_numb(iv%current_ob_time)%synop
23 
24             ! [1.1] Get horizontal interpolation weights:
25 
26             i = iv%synop(n)%loc%i
27             j = iv%synop(n)%loc%j
28             dx = iv%synop(n)%loc%dx
29             dy = iv%synop(n)%loc%dy
30             dxm = iv%synop(n)%loc%dxm
31             dym = iv%synop(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, dxm, dym, &
35                             jo_grad_y%synop(n)%u, iv%synop(n)%zk)
36             call da_interp_obs_lin_2d_adj(jo_grad_x % v, xp, i, j, dx, dy, dxm, dym, &
37                             jo_grad_y%synop(n)%v, iv%synop(n)%zk)
38             call da_interp_obs_lin_2d_adj(jo_grad_x % t, xp, i, j, dx, dy, dxm, dym, &
39                             jo_grad_y%synop(n)%t, iv%synop(n)%zk)
40             call da_interp_obs_lin_2d_adj(jo_grad_x % q, xp, i, j, dx, dy, dxm, dym, &
41                             jo_grad_y%synop(n)%q, iv%synop(n)%zk)
42 
43             call da_interp_lin_2d_adj(jo_grad_x % psfc, xp%ims, xp%ime, xp%jms, xp%jme, &
44                                    i, j, dx, dy, dxm, dym, jo_grad_y%synop(n)%p)
45          end do
46       else if (sfc_assi_options == 2) then
47          do n=iv%ob_numb(iv%current_ob_time-1)%synop + 1, iv%ob_numb(iv%current_ob_time)%synop
48             call da_transform_xtopsfc_adj(xb,xp,iv%synop(n), &
49                                             jo_grad_y%synop(n),jo_grad_x)
50          end do
51       end if
52    end if
53 
54 end subroutine da_transform_xtoy_synop_adj
55 
56