da_pt_to_rho_adj.inc

1 subroutine da_pt_to_rho_adj(grid) 
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 (domain), intent(inout)  :: grid
12 
13    integer                       :: i,j,k        ! Loop counter.
14 
15    integer                       :: is, ie, js, je
16 
17    real                          :: temp
18 
19    if (trace_use) call da_trace_entry("da_pt_to_rho_adj")
20    
21    is = its
22    js = jts
23 
24    ie = ite
25    je = jte
26 
27    if (test_wrfvar) then
28       is = its-1
29       js = jts-1
30 
31       ie = ite+1
32       je = jte+1
33 
34       if (is < ids) is = ids
35       if (js < jds) js = jds
36 
37       if (ie > ide) ie = ide
38       if (je > jde) je = jde
39    end if
40 
41    !---------------------------------------------------------------------------
42    ! Calculate rho increments:
43    !---------------------------------------------------------------------------
44 
45    do j=js, je
46       do k=kts, kte
47          do i=is, ie
48             temp = grid%xa%rho(i,j,k) * grid%xb%rho(i,j,k)
49 
50             grid%xa%p(i,j,k) = grid%xa%p(i,j,k) + temp/grid%xb%p(i,j,k)
51                            
52             grid%xa%t(i,j,k) = grid%xa%t(i,j,k) - temp/grid%xb%t(i,j,k)
53 
54             grid%xa%rho(i,j,k) = 0.0
55          end do        
56       end do        
57    end do        
58 
59    if (trace_use) call da_trace_exit("da_pt_to_rho_adj")
60 
61 end subroutine da_pt_to_rho_adj
62 
63