<HTML> <BODY BGCOLOR=#ccccdd LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE>
<A NAME='DA_CHECK_PSFC'><A href='../../html_code/test/da_check_psfc.inc.html#DA_CHECK_PSFC' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
subroutine da_check_psfc(grid, iv, y),4
!-----------------------------------------------------------------------
! 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