da_transform_vptox_adj.inc

1 subroutine da_transform_vptox_adj(xb, xa, vp, be, ep, xp)
2 
3    !--------------------------------------------------------------------------
4    ! Purpose: Adjoint for Physical transform of variables 
5    !--------------------------------------------------------------------------
6 
7    implicit none
8 
9    type (xb_type), intent(in)           :: xb  ! First guess structure.
10    type (x_type), intent(inout)         :: xa  ! Grad_x(Jo)
11    type (vp_type), intent(inout)        :: vp  ! CV on grid structure.
12    type (ep_type), intent(in)           :: ep  ! Ensemble perturbation.
13    type (be_type), intent(in), optional :: be  ! Background errors.
14    type (xpose_type), intent(inout)     :: xp  ! Transpose variables.
15 
16    integer         :: k, j, k1              ! Loop counters.
17 
18    if (trace_use) call da_trace_entry("da_transform_vptox_adj")
19 
20    !---------------------------------------------------------------------------
21    !  [4] Add flow-dependent increments in model space (xa):
22    !---------------------------------------------------------------------------
23       
24    if (be % ne > 0 .and. alphacv_method == 2) then
25       call da_add_flow_dependence_xa_adj(be % ne, ep, xa, vp)
26    end if
27 
28    !--------------------------------------------------------------------------
29    ! [3] Transform to model variable space:
30    !--------------------------------------------------------------------------
31 
32    if (use_radarobs .and. use_radar_rf) then
33 
34       ! Pseudo RH --> Total water mixing ratio:
35 
36       vp%v4(its:ite,jts:jte,kts:kte)  = vp%v4(its:ite,jts:jte,kts:kte) + &
37                                         xa%qt(its:ite,jts:jte,kts:kte) * &
38                                         xb%qs(its:ite,jts:jte,kts:kte)
39 
40    else 
41 
42    ! Pseudo RH --> Water vapor mixing ratio:
43 
44       vp%v4(its:ite,jts:jte,kts:kte)  = vp%v4(its:ite,jts:jte,kts:kte) + &
45                                         xa%q (its:ite,jts:jte,kts:kte) * &
46                                         xb%qs(its:ite,jts:jte,kts:kte)
47 
48    endif
49 
50    call wrf_dm_halo(xp%domdesc,xp%comms,xp%halo_id3)
51 
52    ! Transform psi and chi to u and v:
53    call da_psichi_to_uv_adj(xa % u, xa % v, xb % coefx,   &
54                              xb % coefy, vp % v1, vp % v2)
55 
56    !--------------------------------------------------------------------------
57    ! [2] Impose statistical balance constraints:
58    !--------------------------------------------------------------------------
59 
60    ! Surface Pressure
61    do k=kts,kte
62       do j=jts,jte
63          vp%v1(its:ite,j,k) = vp%v1(its:ite,j,k) + &
64                               be%reg_ps(j,k)*xa%psfc(its:ite,j)
65       end do
66    end do
67    vp%v5(its:ite,jts:jte,1) = xa%psfc(its:ite,jts:jte) 
68 
69    ! Temperature
70    do k1 = kts,kte
71       do k = kts,kte
72          do j = jts,jte
73             vp%v1(its:ite,j,k1) = vp%v1(its:ite,j,k1) + &
74                                   be%reg_t(j,k,k1)*xa%t(its:ite,j,k)
75          end do
76       end do
77    end do
78    vp%v3(its:ite,jts:jte,kts:kte) = xa%t(its:ite,jts:jte,kts:kte)
79 
80    ! Chi
81    do k = kts,kte
82       do j = jts,jte
83          vp%v1(its:ite,j,k) = vp%v1(its:ite,j,k)  + &
84                               be%reg_chi(j,k)*vp%v2(its:ite,j,k)
85  
86       end do
87    end do
88 
89    !---------------------------------------------------------------------------
90    !  [1] Add flow-dependent increments in control variable space (vp):
91    !---------------------------------------------------------------------------
92    
93    if (be % ne > 0 .and. alphacv_method == 1) then
94       call da_add_flow_dependence_vp_adj(be % ne, ep, vp)
95    end if
96 
97    if (trace_use) call da_trace_exit("da_transform_vptox_adj")
98 
99 end subroutine da_transform_vptox_adj
100 
101