da_transform_xtowtq_adj.inc

1 subroutine da_transform_xtowtq_adj (xp, xb, jo_grad_x)
2 
3    !--------------------------------------------------------------------------
4    ! Purpose: TBD
5    !--------------------------------------------------------------------------
6 
7    implicit none
8 
9    type (xpose_type), intent(in)    :: xp          ! domain decomposition vars.
10    type (xb_type),    intent(in)    :: xb          ! first guess state.
11    type (x_type),     intent(inout) :: jo_grad_x   ! grad_x(jo)
12 
13    integer :: i, j, kz, is, js, ie, je
14    real    :: height
15 
16    kz = xp%kts
17 
18    is = xb%its
19    js = xb%jts
20 
21    ie = xb%ite
22    je = xb%jte
23 
24    if (Testing_WRFVAR) then
25       is = xb%its-1
26       js = xb%jts-1
27 
28       ie = xb%ite+1
29       je = xb%jte+1
30 
31       if (is < xb%ids) is = xb%ids
32       if (js < xb%jds) js = xb%jds
33 
34       if (ie > xb%ide) ie = xb%ide
35       if (je > xb%jde) je = xb%jde
36    end if
37 
38    ! Adjoint from Gridded 10-m wind and 2-m moisture and temperature
39    ! to the model adjoint variables
40 
41    do j=js, je
42       do i=is, ie
43          jo_grad_x%tgrn(i,j)=0.0
44 
45          height = xb%h(i,j,kz) - xb%terr(i,j)                 
46          if( height <= 0.) then
47          print*,i,j,' ht = ',xb%h(i,j,kz) ,' terr =  ',xb%terr(i,j)
48          stop
49          endif
50          call da_sfc_wtq_adj(xb%psfc(i,j), xb%tgrn(i,j), &
51             xb%p(i,j,kz), xb%t(i,j,kz), xb%q(i,j,kz), &
52             xb%u(i,j,kz), xb%v(i,j,kz), &
53             xb%regime(i,j),  &
54             jo_grad_x%psfc(i,j), jo_grad_x%tgrn(i,j), &
55             jo_grad_x%p(i,j,kz), jo_grad_x%t(i,j,kz), jo_grad_x%q(i,j,kz), &
56             jo_grad_x%u(i,j,kz), jo_grad_x%v(i,j,kz), &
57             height      , xb%rough(i,j), xb%xland(i,j), &
58             jo_grad_x%u10(i,j),jo_grad_x%v10(i,j), &
59             jo_grad_x%t2 (i,j),jo_grad_x%q2 (i,j))
60 
61          jo_grad_x%tgrn(i,j)=0.0
62       end do
63    end do
64 
65 end subroutine da_transform_xtowtq_adj
66 
67