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    if (trace_use) call da_trace_entry("da_w_adjustment_adj")
23 
24    call da_wz_base(xb,WZ_b)
25 
26    do J=jts,jte
27       do I=its,ite
28          EBXL19=0.0
29          EBXL29=0.0
30 
31          do K=kte,kts,-1
32             EBXL19=EBXL19+WZ_b(I,J,K)*(xb%hf(I,J,K)-xb%hf(I,J,K+1))
33             EBXL29=EBXL29+ABS(WZ_b(I,J,K))*(xb%hf(I,J,K)-xb%hf(I,J,K+1))
34          end do
35 
36          EBXL1=0.0
37          EBXL2=0.0
38 
39          do K=kts,kte
40             EBXL1=EBXL1-WZ_a(I,J,K)*ABS(WZ_b(I,J,K))/EBXL29
41             EBXL2=EBXL2-WZ_a(I,J,K)*   &
42                   ABS(WZ_b(I,J,K))*(-EBXL19)/EBXL29**2
43             WZ_a(I,J,K)=WZ_a(I,J,K)*(1.0-EBXL19/EBXL29   &
44                                    *SIGN(1.0,WZ_b(I,J,K)))
45          end do
46 
47          do K=kte,kts,-1
48             WZ_a(I,J,K)=WZ_a(I,J,K)+EBXL2*(xb%hf(I,J,K)-xb%hf(I,J,K+1))   &
49                           *SIGN(1.0,WZ_b(I,J,K))
50             WZ_a(I,J,K)=WZ_a(I,J,K)+EBXL1*(xb%hf(I,J,K)-xb%hf(I,J,K+1))
51          end do
52       end do
53    end do
54 
55    if (trace_use) call da_trace_exit("da_w_adjustment_adj")
56 
57 end subroutine da_w_adjustment_adj
58 
59