da_transform_xtowtq.inc

1 subroutine da_transform_xtowtq (xp, xb, xa)
2 
3    !--------------------------------------------------------------------------
4    ! Purpose: TBD
5    !--------------------------------------------------------------------------
6  
7    implicit none
8 
9    type (x_type),  intent(inout) :: xa       ! gridded analysis increment.
10    type (xb_type), intent(in)    :: xb       ! first guess state.
11    type (xpose_type), intent(in) :: xp       ! domain decomposition vars.
12 
13    integer                      :: i, j, kz
14    real                         :: height
15 
16    !------------------------------------------------------------------------
17    ! [1.0] Calculate surface variable(1-m wind, 2-m moisture and temperature)
18    !------------------------------------------------------------------------
19 
20    kz = xp%kts
21 
22    !------------------------------------------------------------------------
23    ! [2.0] Calculate sfc variable perturbations at the cross point
24    !------------------------------------------------------------------------
25 
26    do j=xp%jts, xp%jte
27       do i=xp%its, xp%ite
28          xa%tgrn(i,j) = 0.0
29          height = xb%h(i,j,kz) - xb%terr(i,j)                 
30          if( height <= 0.) then
31          print*,i,j,' ht = ',xb%h(i,j,kz) ,' terr =  ',xb%terr(i,j)                 
32          stop
33          endif
34          call da_sfc_wtq_lin(xb%psfc(i,j), xb%tgrn(i,j), &
35                        xb%p(i,j,kz), xb%t(i,j,kz), xb%q(i,j,kz), &
36                        xb%u(i,j,kz), xb%v(i,j,kz), &
37                        xb%regime(i,j), &
38                        xa%psfc(i,j), xa%tgrn(i,j), &
39                        xa%p(i,j,kz), xa%t(i,j,kz), xa%q(i,j,kz), &
40                        xa%u(i,j,kz), xa%v(i,j,kz), &
41                        height      , xb%rough(i,j), xb%xland(i,j), &
42                        xa%u10(i,j), xa%v10(i,j), &
43                        xa%t2(i,j),  xa%q2(i,j))
44       end do
45    end do
46 
47 end subroutine da_transform_xtowtq
48  
49