da_prho_to_t_adj.inc

1 subroutine da_prho_to_t_adj(xb, xp, xa) 
2 
3    !---------------------------------------------------------------------------
4    !  Purpose: Adjoint of da_prho_to_t.
5    !
6    !  Method:  Standard adjoint coding.
7    !
8    !  Assumptions: 1) Model level stored top down.
9    !---------------------------------------------------------------------------
10 
11    implicit none
12    
13    type (xb_type), intent(in)    :: xb           ! First guess structure.
14    type (xpose_type), intent(in) :: xp           ! Dimensions and xpose buffers.
15    type (x_type), intent(inout)  :: xa           ! increment structure.
16 
17    integer                       :: is, ie       ! 1st dim. end points.
18    integer                       :: js, je       ! 2nd dim. end points.
19    integer                       :: ks, ke       ! 3rd dim. end points.
20    integer                       :: k            ! Loop counter.
21    real                  :: temp(xp%its:xp%ite,xp%jts:xp%jte) ! Temporary array.
22 
23    !---------------------------------------------------------------------------
24    !  [1.0] initialise:
25    !---------------------------------------------------------------------------
26 
27    is = xp%its
28    ie = xp%ite
29    js = xp%jts
30    je = xp%jte
31    ks = xp%kts
32    ke = xp%kte
33    
34    if (Testing_WRFVAR) then
35       is = xb%its-1
36       js = xb%jts-1
37 
38       ie = xb%ite+1
39       je = xb%jte+1
40 
41       if (is < xb%ids) is = xb%ids
42       if (js < xb%jds) js = xb%jds
43 
44       if (ie > xb%ide) ie = xb%ide
45       if (je > xb%jde) je = xb%jde
46    end if
47 
48    !---------------------------------------------------------------------------
49    ! [2.0] Calculate temperature increments:
50    !---------------------------------------------------------------------------
51 
52    do k = ks, ke
53       temp(is:ie,js:je) = xa % t(is:ie,js:je,k) * xb % t(is:ie,js:je,k)
54 
55       xa % p(is:ie,js:je,k) = xa % p(is:ie,js:je,k) + &
56                             temp(is:ie,js:je) / xb % p(is:ie,js:je,k)
57                          
58       xa % rho(is:ie,js:je,k) = xa % rho(is:ie,js:je,k) - &
59                               temp(is:ie,js:je) / xb % rho(is:ie,js:je,k)
60    end do  
61                              
62 end subroutine da_prho_to_t_adj
63 
64