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    if (trace_use) call da_trace_entry("da_transform_xtowtq_adj")
17 
18    kz = xp%kts
19 
20    is = xb%its
21    js = xb%jts
22 
23    ie = xb%ite
24    je = xb%jte
25 
26    if (Testing_WRFVAR) then
27       is = xb%its-1
28       js = xb%jts-1
29 
30       ie = xb%ite+1
31       je = xb%jte+1
32 
33       if (is < xb%ids) is = xb%ids
34       if (js < xb%jds) js = xb%jds
35 
36       if (ie > xb%ide) ie = xb%ide
37       if (je > xb%jde) je = xb%jde
38    end if
39 
40    ! Adjoint from Gridded 10-m wind and 2-m moisture and temperature
41    ! to the model adjoint variables
42 
43    do j=js, je
44       do i=is, ie
45          jo_grad_x%tgrn(i,j)=0.0
46 
47          height = xb%h(i,j,kz) - xb%terr(i,j)                 
48          if( height <= 0.) then
49          print*,i,j,' ht = ',xb%h(i,j,kz) ,' terr =  ',xb%terr(i,j)
50          stop
51          endif
52          call da_sfc_wtq_adj(xb%psfc(i,j), xb%tgrn(i,j), &
53             xb%p(i,j,kz), xb%t(i,j,kz), xb%q(i,j,kz), &
54             xb%u(i,j,kz), xb%v(i,j,kz), &
55             xb%regime(i,j),  &
56             jo_grad_x%psfc(i,j), jo_grad_x%tgrn(i,j), &
57             jo_grad_x%p(i,j,kz), jo_grad_x%t(i,j,kz), jo_grad_x%q(i,j,kz), &
58             jo_grad_x%u(i,j,kz), jo_grad_x%v(i,j,kz), &
59             height      , xb%rough(i,j), xb%xland(i,j), &
60             jo_grad_x%u10(i,j),jo_grad_x%v10(i,j), &
61             jo_grad_x%t2 (i,j),jo_grad_x%q2 (i,j))
62 
63          jo_grad_x%tgrn(i,j)=0.0
64       end do
65    end do
66 
67    if (trace_use) call da_trace_exit("da_transform_xtowtq_adj")
68 
69 end subroutine da_transform_xtowtq_adj
70 
71