da_transform_xtoy_ships_adj.inc

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