subroutine da_check_psfc(grid, iv, y)

   !-----------------------------------------------------------------------
   ! Purpose: TBD
   !-----------------------------------------------------------------------
     
   implicit none
   
   type (domain),  intent(inout)     :: grid
   type (iv_type), intent(inout)     :: iv  ! ob. increment vector.
   type (y_type),  intent(inout)     :: y   ! residual

   real                           :: adj_ttl_lhs   ! < y, y >
   real                           :: adj_ttl_rhs   ! < x, x_adj >

   real                           :: partial_lhs   ! < y, y >
   real                           :: partial_rhs   ! < x, x_adj >

   real                           :: pertile_lhs   ! < y, y >
   real                           :: pertile_rhs   ! < x, x_adj >

   integer                        :: n

   real, dimension(ims:ime, jms:jme) :: xa2_u10, xa2_v10, xa2_t2, &
                                        xa2_q2, xa2_psfc

   if (trace_use) call da_trace_entry("da_check_psfc")
   
   write(unit=stdout, fmt='(/3a,i6/a)') &
        'File: ', __FILE__, ', line:', __LINE__, &
        'Adjoint Test Results:'

   ! save input

   xa2_psfc(ims:ime, jms:jme) = grid%xa%p   (ims:ime, jms:jme, kts)
   xa2_u10 (ims:ime, jms:jme) = grid%xa%u10 (ims:ime, jms:jme)
   xa2_v10 (ims:ime, jms:jme) = grid%xa%v10 (ims:ime, jms:jme)
   xa2_t2  (ims:ime, jms:jme) = grid%xa%t2  (ims:ime, jms:jme)
   xa2_q2  (ims:ime, jms:jme) = grid%xa%q2  (ims:ime, jms:jme)

   !----------------------------------------------------------------------

   partial_lhs = 0.0
   pertile_lhs = 0.0

   do n=1, iv%info(synop)%nlocal
      call da_transform_xtopsfc(grid, iv, synop, iv%synop(:), y%synop(:))
      pertile_lhs = pertile_lhs &
                  + y%synop(n)%u * y%synop(n)%u &
                  + y%synop(n)%v * y%synop(n)%v &
                  + y%synop(n)%t * y%synop(n)%t &
                  + y%synop(n)%p * y%synop(n)%p &
                  + y%synop(n)%q * y%synop(n)%q

      if (iv%info(synop)%proc_domain(1,n)) then
         partial_lhs = partial_lhs & 
                     + y%synop(n)%u * y%synop(n)%u &
                     + y%synop(n)%v * y%synop(n)%v &
                     + y%synop(n)%t * y%synop(n)%t &
                     + y%synop(n)%p * y%synop(n)%p &
                     + y%synop(n)%q * y%synop(n)%q
      end if
   end do

   !-------------------------------------------------------------------------
   ! [5.0] Perform adjoint operation:
   !-------------------------------------------------------------------------

   grid%xa%psfc(ims:ime, jms:jme) = 0.0
   grid%xa%tgrn(ims:ime, jms:jme) = 0.0
   grid%xa%u10 (ims:ime, jms:jme) = 0.0
   grid%xa%v10 (ims:ime, jms:jme) = 0.0
   grid%xa%t2  (ims:ime, jms:jme) = 0.0
   grid%xa%q2  (ims:ime, jms:jme) = 0.0
   
   do n=1, iv%info(synop)%nlocal
      call da_transform_xtopsfc_adj(grid,iv,synop,iv%synop(:),y%synop(:),grid%xa)
   end do

   pertile_rhs = sum(grid%xa%u10 (ims:ime, jms:jme) * xa2_u10 (ims:ime, jms:jme)) &
               + sum(grid%xa%v10 (ims:ime, jms:jme) * xa2_v10 (ims:ime, jms:jme)) &
               + sum(grid%xa%t2  (ims:ime, jms:jme) * xa2_t2  (ims:ime, jms:jme)) &
               + sum(grid%xa%q2  (ims:ime, jms:jme) * xa2_q2  (ims:ime, jms:jme)) &
               + sum(grid%xa%psfc(ims:ime, jms:jme) * xa2_psfc(ims:ime, jms:jme))

   partial_rhs = sum(grid%xa%u10 (its:ite, jts:jte) * xa2_u10 (its:ite, jts:jte)) &
               + sum(grid%xa%v10 (its:ite, jts:jte) * xa2_v10 (its:ite, jts:jte)) &
               + sum(grid%xa%t2  (its:ite, jts:jte) * xa2_t2  (its:ite, jts:jte)) &
               + sum(grid%xa%q2  (its:ite, jts:jte) * xa2_q2  (its:ite, jts:jte)) &
               + sum(grid%xa%psfc(its:ite, jts:jte) * xa2_psfc(its:ite, jts:jte))
   
   !----------------------------------------------------------------------
   ! [6.0] Calculate RHS of adjoint test equation:
   !----------------------------------------------------------------------

   !----------------------------------------------------------------------
   ! [7.0] Print output:
   !----------------------------------------------------------------------
   
   write(unit=stdout, fmt='(A,1pe22.14)') &
      ' Tile < y, y     > = ', pertile_lhs, &
      ' Tile < x, x_adj > = ', pertile_rhs

   adj_ttl_lhs = wrf_dm_sum_real(partial_lhs)
   adj_ttl_rhs = wrf_dm_sum_real(partial_rhs)
   write (unit=stdout,fmt='(A,2F10.2)') &
      'TEST_COVERAGE_check_sfc_assi_B:  adj_ttl_lhs,adj_ttl_rhs = ', &
      adj_ttl_lhs,adj_ttl_rhs
   if (rootproc) then
      write(unit=stdout, fmt='(A,1pe22.14)') ' Whole Domain < y, y     > = ', &
         adj_ttl_lhs
      write(unit=stdout, fmt='(A,1pe22.14)') ' Whole Domain < x, x_adj > = ', &
         adj_ttl_rhs
   end if

   ! recover
   grid%xa%psfc(ims:ime, jms:jme) = xa2_psfc(ims:ime, jms:jme)
   grid%xa%u10 (ims:ime, jms:jme) = xa2_u10 (ims:ime, jms:jme)
   grid%xa%v10 (ims:ime, jms:jme) = xa2_v10 (ims:ime, jms:jme)
   grid%xa%t2  (ims:ime, jms:jme) = xa2_t2  (ims:ime, jms:jme)
   grid%xa%q2  (ims:ime, jms:jme) = xa2_q2  (ims:ime, jms:jme)

   if (trace_use) call da_trace_exit("da_check_psfc")

end subroutine da_check_psfc