da_w_adjustment_lin.inc

1 subroutine da_w_adjustment_lin(xb,W_a,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    integer :: I,J,K
14 
15    real, dimension(ims:ime,jms:jme,kms:kme), intent(out) :: W_a
16    real, dimension(ims:ime,jms:jme,kms:kme), intent(inout) :: WZ_a
17 
18    real, dimension(ims:ime,jms:jme,kms:kme) :: WZ_b
19 
20    real :: EBXL1,EBXL2
21    real :: EBXL19,EBXL29
22 
23    call da_wz_base(xb,WZ_b)
24 
25    do J=jts,jte
26       do I=its,ite
27          EBXL1=0.
28          EBXL19=0.
29          EBXL2=0.
30          EBXL29=0.
31          do K=kte,kts,-1
32             EBXL1=EBXL1+WZ_a(I,J,K)*(xb%hf(I,J,K)-xb%hf(I,J,K+1))
33             EBXL19=EBXL19+WZ_b(I,J,K)*(xb%hf(I,J,K)-xb%hf(I,J,K+1))
34             EBXL2=EBXL2+WZ_a(I,J,K)*(xb%hf(I,J,K)-xb%hf(I,J,K+1))   &
35                   *SIGN(1.,WZ_b(I,J,K))
36             EBXL29=EBXL29+ABS(WZ_b(I,J,K))*(xb%hf(I,J,K)-xb%hf(I,J,K+1))
37          end do
38 
39          do K=kts,kte
40             WZ_a(I,J,K)=WZ_a(I,J,K)*(1.-EBXL19/EBXL29*SIGN(1.,WZ_b(I,J,K)))-  &
41                         EBXL1*ABS(WZ_b(I,J,K))/EBXL29+                        &
42                         EBXL2*ABS(WZ_b(I,J,K))*EBXL19/EBXL29**2
43          end do
44 
45       end do
46    end do
47 
48 end subroutine da_w_adjustment_lin
49 
50