da_tprh_to_q_adj.inc

References to this file elsewhere.
1 subroutine da_tprh_to_q_adj( xb, xp, xa )
2 
3    !---------------------------------------------------------------------------
4    !  Purpose: Adjoint of da_tprh_to_q_adj.
5    !---------------------------------------------------------------------------
6 
7    implicit none
8 
9    type (xb_type), intent(in)    :: xb       ! First guess structure.
10    type (xpose_type), intent(in) :: xp       ! Dimensions and xpose buffers.
11    type (x_type), intent(inout)  :: xa       ! increment structure
12 
13    integer                       :: is, ie   ! 1st dim. end points.
14    integer                       :: js, je   ! 2nd dim. end points.
15    integer                       :: ks, ke   ! 3rd dim. end points.
16    integer                       :: i, j, k  ! Loop counter.
17    real :: qs_prime_over_qs(xp%its:xp%ite,xp%jts:xp%jte,xp%kts:xp%kte) ! Temp.
18 
19    !---------------------------------------------------------------------------
20    ! [1.0] initialise:
21    !---------------------------------------------------------------------------
22 
23    is = xp%its; ie = xp%ite
24    js = xp%jts; je = xp%jte
25    ks = xp%kts; ke = xp%kte   
26 
27    if (Testing_WRFVAR) then
28       is = xb%its-1
29       js = xb%jts-1
30 
31       ie = xb%ite+1
32       je = xb%jte+1
33 
34       if ( is < xb%ids ) is = xb%ids
35       if ( js < xb%jds ) js = xb%jds
36 
37       if ( ie > xb%ide ) ie = xb%ide
38       if ( je > xb%jde ) je = xb%jde
39    end if
40 
41    !---------------------------------------------------------------------------
42    ! [2.0] Calculate relative humidity increment:
43    !---------------------------------------------------------------------------
44 
45    do k = ks, ke
46       do j = js, je
47          do i = is, ie
48             qs_prime_over_qs(i,j,k) = xb % q(i,j,k) * xa % q(i,j,k)
49 
50             xa % rh(i,j,k) = xa % rh(i,j,k) + qs_prime_over_qs(i,j,k) / &
51                              xb % rh(i,j,k)
52          end do
53       end do
54    end do
55 
56    !---------------------------------------------------------------------------
57    ! [2.0] Calculate saturation specific humidity ratio qs~/qs:
58    !---------------------------------------------------------------------------
59 
60    call da_tp_to_qs_adj( xb, xp, xa, qs_prime_over_qs )
61 
62 end subroutine da_tprh_to_q_adj
63 
64    !subroutine da_tprh_to_q_adj( t, p, es, q, rh, &
65    !                             t_prime, p_prime, rh_prime, q_prime, n )
66 
67    !---------------------------------------------------------------------------
68    !  Purpose: Adjoint of da_tprh_to_q_adj.
69    !---------------------------------------------------------------------------
70 
71    !   implicit none
72 
73    !   integer        i, n
74    !   real           t, es, p, q, rh,t_prime, p_prime, rh_prime, q_prime  
75    !   dimension      t       (n) ! Temperature.
76    !   dimension      es      (n) ! Saturation vapour pressure.
77    !   dimension      p       (n) ! Pressure.
78    !   dimension      q       (n) ! Specific humidity.
79    !   dimension      rh      (n) ! Relative Humidity.
80    !   dimension      t_prime (n) ! Temperature increment.
81    !   dimension      p_prime (n) ! Pressure increment.
82    !   dimension      rh_prime(n) ! Pressure increment.
83    !   dimension      q_prime (n) ! Pressure increment.
84 
85    !   real        temp, qs_prime_over_qs  ! Temporary storage.
86    !   dimension   qs_prime_over_qs(n)     ! qs~/qs.
87 
88    !   do i = 1,n
89    !   temp = q(i) * q_prime(i)
90 
91    !---------------------------------------------------------------------------
92    !  [2.0] Calculate relative humidity increment:
93    !---------------------------------------------------------------------------
94 
95    !   rh_prime(i) = rh_prime(i) + temp / rh(i)
96    !   qs_prime_over_qs(i) = temp
97    !   end do
98 
99    !---------------------------------------------------------------------------
100    !  [1.0] Calculate saturation specific humidity ratio qs~/qs:
101    !---------------------------------------------------------------------------
102 
103    !   call da_tp_to_qs_adj( t, p, es, t_prime, p_prime, qs_prime_over_qs, n )
104 
105    !end subroutine da_tprh_to_q_adj
106 
107