var/da/da_dynamics/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    real,           intent(out)   :: w_a(ims:ime,jms:jme,kms:kme)
  13    real,           intent(inout) :: wz_a(ims:ime,jms:jme,kms:kme)
  14
  15    integer :: i,j,k
  16    real    :: wz_b(ims:ime,jms:jme,kms:kme)
  17    real    :: ebxl1,ebxl2
  18    real    :: ebxl19,ebxl29
  19
  20    if (trace_use) call da_trace_entry("da_w_adjustment_lin")
  21
  22    call da_wz_base(xb,WZ_b)
  23
  24    do j=jts,jte
  25       do i=its,ite
  26          ebxl1=0.0
  27          ebxl19=0.0
  28          ebxl2=0.0
  29          ebxl29=0.0
  30          do k=kte,kts,-1
  31             ebxl1=ebxl1+wz_a(i,j,k)*(xb%hf(i,j,k)-xb%hf(i,j,k+1))
  32             ebxl19=ebxl19+wz_b(i,j,k)*(xb%hf(i,j,k)-xb%hf(i,j,k+1))
  33             ebxl2=ebxl2+wz_a(i,j,k)*(xb%hf(i,j,k)-xb%hf(i,j,k+1))   &
  34                   *sign(1.0,wz_b(i,j,k))
  35             ebxl29=ebxl29+abs(wz_b(i,j,k))*(xb%hf(i,j,k)-xb%hf(i,j,k+1))
  36          end do
  37
  38          do k=kts,kte
  39             wz_a(i,j,k)=wz_a(i,j,k)*(1.-ebxl19/ebxl29*sign(1.0,wz_b(i,j,k)))-  &
  40                         ebxl1*abs(wz_b(i,j,k))/ebxl29+                        &
  41                         ebxl2*abs(wz_b(i,j,k))*ebxl19/ebxl29**2
  42          end do
  43
  44       end do
  45    end do
  46
  47    if (trace_use) call da_trace_exit("da_w_adjustment_lin")
  48
  49 end subroutine da_w_adjustment_lin
  50
  51