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    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    !---------------------------------------------------------------------------
41    ! Calculate rho increments:
42    !---------------------------------------------------------------------------
43 
44    do j=js, je
45       do k=xb%kts, xb%kte
46          do i=is, ie
47             temp = xa%rho(i,j,k) * xb%rho(i,j,k)
48 
49             xa%p(i,j,k) = xa%p(i,j,k) + temp/xb%p(i,j,k)
50                            
51             xa%t(i,j,k) = xa%t(i,j,k) - temp/xb%t(i,j,k)
52 
53             xa%rho(i,j,k) = 0.0
54          end do        
55       end do        
56    end do        
57 
58 end subroutine da_pt_to_rho_adj
59 
60