var/da/da_mtgirs/da_transform_xtoy_mtgirs.inc

   1 subroutine da_transform_xtoy_mtgirs (grid, iv, y)
   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       ! Innovation vector (O-B).
  13    type (y_type),     intent(inout) :: y        ! y = h (grid%xa) (linear)
  14
  15    real, allocatable :: u(:,:)
  16    real, allocatable :: v(:,:)
  17    real, allocatable :: t(:,:)
  18    real, allocatable :: q(:,:)
  19    real, allocatable :: ub(:,:)
  20    real, allocatable :: vb(:,:)
  21
  22    integer :: n,k
  23
  24    if (trace_use_dull) call da_trace_entry("da_transform_xtoy_mtgirs")
  25
  26    allocate (u(iv%info(mtgirs)%max_lev,iv%info(mtgirs)%n1:iv%info(mtgirs)%n2))
  27    allocate (v(iv%info(mtgirs)%max_lev,iv%info(mtgirs)%n1:iv%info(mtgirs)%n2))
  28    allocate (t(iv%info(mtgirs)%max_lev,iv%info(mtgirs)%n1:iv%info(mtgirs)%n2))
  29    allocate (q(iv%info(mtgirs)%max_lev,iv%info(mtgirs)%n1:iv%info(mtgirs)%n2))
  30
  31    allocate (ub(iv%info(mtgirs)%max_lev,iv%info(mtgirs)%n1:iv%info(mtgirs)%n2))
  32    allocate (vb(iv%info(mtgirs)%max_lev,iv%info(mtgirs)%n1:iv%info(mtgirs)%n2))
  33
  34 #ifdef A2C
  35    call da_interp_lin_3d (grid%xa%u, iv%info(mtgirs), u,'u')
  36    call da_interp_lin_3d (grid%xa%v, iv%info(mtgirs), v,'v')
  37 #else
  38    call da_interp_lin_3d (grid%xa%u, iv%info(mtgirs), u)
  39    call da_interp_lin_3d (grid%xa%v, iv%info(mtgirs), v)
  40 #endif
  41    call da_interp_lin_3d (grid%xa%t, iv%info(mtgirs), t)
  42    call da_interp_lin_3d (grid%xa%q, iv%info(mtgirs), q)
  43
  44    call da_interp_lin_3d (grid%xb%u, iv%info(mtgirs), ub)
  45    call da_interp_lin_3d (grid%xb%v, iv%info(mtgirs), vb)
  46
  47    do n=iv%info(mtgirs)%n1,iv%info(mtgirs)%n2
  48       do k = 1, iv%info(mtgirs)%levels(n)
  49          if(wind_sd_mtgirs) then
  50             call da_uv_to_sd_lin(y%mtgirs(n)%u(k),y%mtgirs(n)%v(k),u(k,n),v(k,n),ub(k,n),vb(k,n))
  51          else
  52             y%mtgirs(n)%u(k) = u(k,n)
  53             y%mtgirs(n)%v(k) = v(k,n)
  54          end if
  55       end do
  56       y%mtgirs(n)%t(:) = t(1:size(y%mtgirs(n)%t),n)
  57       y%mtgirs(n)%q(:) = q(1:size(y%mtgirs(n)%q),n)
  58    end do
  59
  60    deallocate (u)
  61    deallocate (v)
  62    deallocate (t)
  63    deallocate (q)
  64    deallocate (ub)
  65    deallocate (vb)
  66
  67    if (trace_use_dull) call da_trace_exit("da_transform_xtoy_mtgirs")
  68
  69 end subroutine da_transform_xtoy_mtgirs
  70
  71