<HTML> <BODY BGCOLOR=#ccccdd LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE>
<A NAME='DA_WZ_BASE'><A href='../../html_code/dynamics/da_wz_base.inc.html#DA_WZ_BASE' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
subroutine da_wz_base(xb,WZ_b) 2,4
!--------------------------------------------------------------------
! Purpose: TBD
!--------------------------------------------------------------------
implicit none
type (xb_type), intent(in) :: xb ! First guess structure.
real, dimension(ims:ime,jms:jme,kms:kme), intent(inout) :: WZ_b
integer :: is, ie ! 1st dim. end points.
integer :: js, je ! 2nd dim. end points.
integer :: I,J,K
real :: TERM3
real, dimension(ims:ime,jms:jme,kms:kme) :: URHO, VRHO
real, dimension(ims:ime,jms:jme,kms:kme) :: DIV
if (trace_use) call da_trace_entry
("da_wz_base")
! Computation to check for edge of domain:
is = its
ie = ite
js = jts
je = jte
if (its == ids) is = ids+1
if (ite == ide) ie = ide-1
if (jts == jds) js = jds+1
if (jte == jde) je = jde-1
do K=kts,kte
do J=js,je
do I=is,ie
WZ_b(I,J,K)=-xb%u(I,J,K)*(xb%p(I+1,J,K)-xb%p(I-1,J,K))*xb%coefx(I,J)
end do
end do
do J=js,je
do I=is,ie
WZ_b(I,J,K)=WZ_b(I,J,K)-xb%v(I,J,K)*(xb%p(I,J+1,K)-xb%p(I,J-1,K))*xb%coefy(I,J)
end do
end do
end do
if (its == ids) then
i = its
do K=kts,kte
do J=js,je
WZ_b(I,J,K)=WZ_b(I+1,J,K)
end do
end do
end if
if (ite == ide) then
i = ite
do K=kts,kte
do J=js,je
WZ_b(I,J,K)=WZ_b(I-1,J,K)
end do
end do
end if
if (jts == jds) then
j = jts
do K=kts,kte
do I=its, ite
WZ_b(I,J,K)=WZ_b(I,J+1,K)
end do
end do
end if
if (jte == jde) then
j = jte
do K=kts,kte
do I=its, ite
WZ_b(I,J,K)=WZ_b(I,J-1,K)
end do
end do
end if
call da_uv_to_divergence(xb, xb%u,xb%v, DIV)
do K=kts,kte
do J=jts,jte
do I=its,ite
WZ_b(I,J,K)=WZ_b(I,J,K)-GAMMA*xb%p(I,J,K)*DIV(I,J,K)
end do
end do
end do
! Computation to check for edge of domain:
is = its-1; ie = ite+1; js = jts-1; je = jte+1
if (its == ids) is = ids; if (ite == ide) ie = ide
if (jts == jds) js = jds; if (jte == jde) je = jde
do K=kts,kte
do J=js,je
do I=is,ie
URHO(I,J,K)=xb%rho(I,J,K)*xb%u(I,J,K)
VRHO(I,J,K)=xb%rho(I,J,K)*xb%v(I,J,K)
end do
end do
end do
call da_uv_to_divergence(xb, URHO, VRHO, DIV)
do J=jts,jte
do I=its,ite
TERM3=0.0
do K=kte-1,kts,-1
TERM3=TERM3+GRAVITY*(DIV(I,J,K+1)+DIV(I,J,K))*0.5 &
*(xb%h(I,J,K+1)-xb%h(I,J,K))
WZ_b(I,J,K)=WZ_b(I,J,K)+TERM3
end do
end do
end do
do K=kts,kte
do J=jts,jte
do I=its,ite
WZ_b(I,J,K)=WZ_b(I,J,K)/(GAMMA*xb%p(I,J,K))
end do
end do
end do
if (trace_use) call da_trace_exit("da_wz_base")
end subroutine da_wz_base