da_transform_xtoy_buoy_adj.inc

1 subroutine da_transform_xtoy_buoy_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_buoy > 0) then
21       if (sfc_assi_options == 1) then
22          do n=iv%ob_numb(iv%current_ob_time-1)%buoy + 1, iv%ob_numb(iv%current_ob_time)%buoy
23 
24             ! [1.1] Get horizontal interpolation weights:
25 
26             i = iv%buoy(n)%loc%i
27             dy = iv%buoy(n)%loc%dy
28             dym = iv%buoy(n)%loc%dym
29             j = iv%buoy(n)%loc%j
30             dx = iv%buoy(n)%loc%dx
31             dxm = iv%buoy(n)%loc%dxm
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%buoy(n)%u, iv%buoy(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%buoy(n)%v, iv%buoy(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%buoy(n)%t, iv%buoy(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%buoy(n)%q, iv%buoy(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%buoy(n)%p)
45          end do
46       else if (sfc_assi_options == 2) then
47          do n=iv%ob_numb(iv%current_ob_time-1)%buoy + 1, iv%ob_numb(iv%current_ob_time)%buoy
48             call da_transform_xtopsfc_adj(xb,xp,iv%buoy(n), jo_grad_y%buoy(n),jo_grad_x)
49          end do
50       end if
51    end if
52 
53 end subroutine da_transform_xtoy_buoy_adj
54 
55