var/da/da_ships/da_transform_xtoy_ships_adj.inc

   1 subroutine da_transform_xtoy_ships_adj(grid, iv, jo_grad_y, jo_grad_x)
   2
   3    !-----------------------------------------------------------------------
   4    ! Purpose: TBD
   5    !    Updated for Analysis on Arakawa-C grid
   6    !    Author: Syed RH Rizvi,  MMM/ESSL/NCAR,  Date: 10/22/2008
   7    !-----------------------------------------------------------------------
   8
   9    implicit none
  10
  11    type (domain),  intent(in)    :: grid
  12    type (iv_type), intent(in)    :: iv          ! obs. inc vector (o-b).
  13    type (y_type) , intent(inout) :: jo_grad_y   ! grad_y(jo)
  14    type (x_type) , intent(inout) :: jo_grad_x   ! grad_x(jo)
  15
  16    integer :: n        ! Loop counter.
  17
  18    real, allocatable :: model_u(:,:)
  19    real, allocatable :: model_v(:,:)
  20    real, allocatable :: model_t(:,:)
  21    real, allocatable :: model_q(:,:)
  22    real, allocatable :: model_psfc(:)
  23    real, allocatable :: ub(:,:)
  24    real, allocatable :: vb(:,:)
  25    if (trace_use_dull) call da_trace_entry("da_transform_xtoy_ships_adj")
  26
  27    if (sfc_assi_options == sfc_assi_options_1) then
  28       allocate (model_u(1,iv%info(ships)%n1:iv%info(ships)%n2))
  29       allocate (model_v(1,iv%info(ships)%n1:iv%info(ships)%n2))
  30       allocate (model_t(1,iv%info(ships)%n1:iv%info(ships)%n2))
  31       allocate (model_q(1,iv%info(ships)%n1:iv%info(ships)%n2))
  32       allocate (model_psfc(iv%info(ships)%n1:iv%info(ships)%n2))
  33       allocate (ub(1,iv%info(ships)%n1:iv%info(ships)%n2))
  34       allocate (vb(1,iv%info(ships)%n1:iv%info(ships)%n2))
  35
  36       call da_interp_lin_3d (grid%xb%u, iv%info(ships), ub)
  37       call da_interp_lin_3d (grid%xb%v, iv%info(ships), vb)
  38
  39       ! [1.2] Interpolate horizontally:
  40       do n=iv%info(ships)%n1,iv%info(ships)%n2
  41          if(wind_sd_ships)then
  42             call da_uv_to_sd_adj(jo_grad_y%ships(n)%u, &
  43                                  jo_grad_y%ships(n)%v, model_u(1,n), model_v(1,n), ub(1,n), vb(1,n))
  44          else
  45             model_u(1,n)  = jo_grad_y%ships(n)%u
  46             model_v(1,n)  = jo_grad_y%ships(n)%v
  47          end if
  48          model_t(1,n)  = jo_grad_y%ships(n)%t
  49          model_q(1,n)  = jo_grad_y%ships(n)%q
  50          model_psfc(n) = jo_grad_y%ships(n)%p
  51       end do
  52 #ifdef A2C
  53       call da_interp_lin_3d_adj (jo_grad_x%u, iv%info(ships), model_u,'u')
  54       call da_interp_lin_3d_adj (jo_grad_x%v, iv%info(ships), model_v,'v')
  55 #else
  56       call da_interp_lin_3d_adj (jo_grad_x%u, iv%info(ships), model_u)
  57       call da_interp_lin_3d_adj (jo_grad_x%v, iv%info(ships), model_v)
  58 #endif
  59       call da_interp_lin_3d_adj (jo_grad_x%t, iv%info(ships), model_t)
  60       call da_interp_lin_3d_adj (jo_grad_x%q, iv%info(ships), model_q)
  61
  62       call da_interp_lin_2d_adj (jo_grad_x%psfc, iv%info(ships), 1, model_psfc)
  63       deallocate (model_u)
  64       deallocate (model_v)
  65       deallocate (model_t)
  66       deallocate (model_q)
  67       deallocate (model_psfc)
  68       deallocate (ub)
  69       deallocate (vb)
  70    else if (sfc_assi_options == sfc_assi_options_2) then
  71       call da_transform_xtopsfc_adj(grid,iv,ships,iv%ships(:), jo_grad_y%ships(:),jo_grad_x)
  72    end if
  73
  74    if (trace_use_dull) call da_trace_exit("da_transform_xtoy_ships_adj")
  75
  76 end subroutine da_transform_xtoy_ships_adj
  77
  78