da_w_adjustment_adj.inc

1 subroutine da_w_adjustment_adj(xb,WZ_a)
2 
3    !---------------------------------------------------------------------------
4    ! Purpose: Adjust vertical velocity increments
5    !
6    ! Assumptions: 1) Model level stored top down.
7    !---------------------------------------------------------------------------
8 
9    implicit none
10 
11    type (xb_type), intent(in)    :: xb                ! First guess structure.
12 
13    real, dimension(ims:ime,jms:jme,kms:kme), intent(inout) :: WZ_a
14 
15    integer :: I,J,K
16 
17    real, dimension(ims:ime,jms:jme,kms:kme)   :: WZ_b
18 
19    real :: EBXL1,EBXL2
20    real :: EBXL19,EBXL29
21 
22    call da_wz_base(xb,WZ_b)
23 
24    do J=jts,jte
25       do I=its,ite
26          EBXL19=0.
27          EBXL29=0.
28 
29          do K=kte,kts,-1
30             EBXL19=EBXL19+WZ_b(I,J,K)*(xb%hf(I,J,K)-xb%hf(I,J,K+1))
31             EBXL29=EBXL29+ABS(WZ_b(I,J,K))*(xb%hf(I,J,K)-xb%hf(I,J,K+1))
32          end do
33 
34          EBXL1=0.
35          EBXL2=0.
36 
37          do K=kts,kte
38             EBXL1=EBXL1-WZ_a(I,J,K)*ABS(WZ_b(I,J,K))/EBXL29
39             EBXL2=EBXL2-WZ_a(I,J,K)*   &
40                   ABS(WZ_b(I,J,K))*(-EBXL19)/EBXL29**2
41             WZ_a(I,J,K)=WZ_a(I,J,K)*(1.-EBXL19/EBXL29   &
42                                    *SIGN(1.,WZ_b(I,J,K)))
43          end do
44 
45          do K=kte,kts,-1
46             WZ_a(I,J,K)=WZ_a(I,J,K)+EBXL2*(xb%hf(I,J,K)-xb%hf(I,J,K+1))   &
47                           *SIGN(1.,WZ_b(I,J,K))
48             WZ_a(I,J,K)=WZ_a(I,J,K)+EBXL1*(xb%hf(I,J,K)-xb%hf(I,J,K+1))
49          end do
50       end do
51    end do
52 
53 end subroutine da_w_adjustment_adj
54 
55