da_pt_to_rho_adj.inc

1 subroutine da_pt_to_rho_adj(xb, xa) 
2 
3    !---------------------------------------------------------------------------
4    !  Purpose: Adjoint of da_pt_to_rho.
5    !
6    !  Assumptions: 1) Model level stored top down
7    !---------------------------------------------------------------------------
8 
9    implicit none
10    
11    type (xb_type), intent(in)    :: xb           ! First guess structure.
12    type (x_type),  intent(inout) :: xa           ! increment structure.
13 
14    integer                       :: i,j,k        ! Loop counter.
15 
16    integer                       :: is, ie, js, je
17 
18    real                          :: temp
19 
20    if (trace_use) call da_trace_entry("da_pt_to_rho_adj")
21    
22    is = xb%its
23    js = xb%jts
24 
25    ie = xb%ite
26    je = xb%jte
27 
28    if (Testing_WRFVAR) then
29       is = xb%its-1
30       js = xb%jts-1
31 
32       ie = xb%ite+1
33       je = xb%jte+1
34 
35       if (is < xb%ids) is = xb%ids
36       if (js < xb%jds) js = xb%jds
37 
38       if (ie > xb%ide) ie = xb%ide
39       if (je > xb%jde) je = xb%jde
40    end if
41 
42    !---------------------------------------------------------------------------
43    ! Calculate rho increments:
44    !---------------------------------------------------------------------------
45 
46    do j=js, je
47       do k=xb%kts, xb%kte
48          do i=is, ie
49             temp = xa%rho(i,j,k) * xb%rho(i,j,k)
50 
51             xa%p(i,j,k) = xa%p(i,j,k) + temp/xb%p(i,j,k)
52                            
53             xa%t(i,j,k) = xa%t(i,j,k) - temp/xb%t(i,j,k)
54 
55             xa%rho(i,j,k) = 0.0
56          end do        
57       end do        
58    end do        
59 
60    if (trace_use) call da_trace_exit("da_pt_to_rho_adj")
61 
62 end subroutine da_pt_to_rho_adj
63 
64