var/da/da_dynamics/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