subroutine da_w_adjustment_adj(xb,WZ_a) 1,3
!---------------------------------------------------------------------------
! Purpose: Adjust vertical velocity increments
!
! Assumptions: 1) Model level stored top down.
!---------------------------------------------------------------------------
implicit none
type (xb_type), intent(in) :: xb ! First guess structure.
real, dimension(ims:ime,jms:jme,kms:kme), intent(inout) :: WZ_a
integer :: I,J,K
real, dimension(ims:ime,jms:jme,kms:kme) :: WZ_b
real :: EBXL1,EBXL2
real :: EBXL19,EBXL29
if (trace_use) call da_trace_entry
("da_w_adjustment_adj")
call da_wz_base
(xb,WZ_b)
do J=jts,jte
do I=its,ite
EBXL19=0.0
EBXL29=0.0
do K=kte,kts,-1
EBXL19=EBXL19+WZ_b(I,J,K)*(xb%hf(I,J,K)-xb%hf(I,J,K+1))
EBXL29=EBXL29+ABS(WZ_b(I,J,K))*(xb%hf(I,J,K)-xb%hf(I,J,K+1))
end do
EBXL1=0.0
EBXL2=0.0
do K=kts,kte
EBXL1=EBXL1-WZ_a(I,J,K)*ABS(WZ_b(I,J,K))/EBXL29
EBXL2=EBXL2-WZ_a(I,J,K)* &
ABS(WZ_b(I,J,K))*(-EBXL19)/EBXL29**2
WZ_a(I,J,K)=WZ_a(I,J,K)*(1.0-EBXL19/EBXL29 &
*SIGN(1.0,WZ_b(I,J,K)))
end do
do K=kte,kts,-1
WZ_a(I,J,K)=WZ_a(I,J,K)+EBXL2*(xb%hf(I,J,K)-xb%hf(I,J,K+1)) &
*SIGN(1.0,WZ_b(I,J,K))
WZ_a(I,J,K)=WZ_a(I,J,K)+EBXL1*(xb%hf(I,J,K)-xb%hf(I,J,K+1))
end do
end do
end do
if (trace_use) call da_trace_exit
("da_w_adjustment_adj")
end subroutine da_w_adjustment_adj