da_tp_to_qs_adj.inc
References to this file elsewhere.
1 subroutine da_tp_to_qs_adj( xb, xp, xa, qs_prime_over_qs )
2
3 !---------------------------------------------------------------------------
4 ! Purpose: Adjoint of da_tp_to_qs_lin
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 real, intent(in) :: qs_prime_over_qs(xp%its:xp%ite,xp%jts:xp%jte,xp%kts:xp%kte)
13
14 integer :: is, ie ! 1st dim. end points.
15 integer :: js, je ! 2nd dim. end points.
16 integer :: ks, ke ! 3rd dim. end points.
17 integer :: i, j, k ! Loop counters.
18 real :: temp ! Temporary array.
19 real :: es_prime_over_es ! Sat Vap pressure ratio.
20
21 !---------------------------------------------------------------------------
22 ! [1.0] initialise:
23 !---------------------------------------------------------------------------
24
25 is = xp%its; ie = xp%ite
26 js = xp%jts; je = xp%jte
27 ks = xp%kts; ke = xp%kte
28
29 if ( Testing_WRFVAR ) then
30 is = xb%its-1
31 js = xb%jts-1
32
33 ie = xb%ite+1
34 je = xb%jte+1
35
36 if ( is < xb%ids ) is = xb%ids
37 if ( js < xb%jds ) js = xb%jds
38
39 if ( ie > xb%ide ) ie = xb%ide
40 if ( je > xb%jde ) je = xb%jde
41 end if
42
43 !---------------------------------------------------------------------------
44 ! [3.0] Calculate saturation specific humidity increment:
45 !---------------------------------------------------------------------------
46
47 do k = ks, ke
48 do j = js, je
49 do i = is, ie
50
51 temp = qs_prime_over_qs(i,j,k) / &
52 ( xb % p(i,j,k) - rd_over_rv1 * xb % es(i,j,k) )
53
54 es_prime_over_es = temp * xb % p(i,j,k)
55
56 xa % p(i,j,k) = xa % p(i,j,k) - temp
57
58 !---------------------------------------------------------------------------
59 ! [2.0] Calculate saturation vapour pressure increment:
60 !---------------------------------------------------------------------------
61
62 temp = xb % t(i,j,k) + es_gammakelvin
63
64 xa % t(i,j,k) = xa % t(i,j,k) + es_gammabeta * es_prime_over_es / &
65 ( temp * temp )
66 end do
67 end do
68 end do
69
70 end subroutine da_tp_to_qs_adj
71
72 !subroutine da_tp_to_qs_adj( t, p, es, t_prime, p_prime, &
73 ! qs_prime_over_qs, n )
74
75 !---------------------------------------------------------------------------
76 ! Purpose: Adjoint of da_tp_to_qs_lin
77 !---------------------------------------------------------------------------
78
79 ! implicit none
80
81 ! integer i, n
82 ! real t, p, es, t_prime, p_prime, qs_prime_over_qs
83 ! dimension t (n) ! Temperature.
84 ! dimension p (n) ! Pressure.
85 ! dimension es (n) ! Sat. vapour pressure.
86 ! dimension t_prime (n) ! Temperature increment.
87 ! dimension p_prime (n) ! Pressure increment.
88 ! dimension qs_prime_over_qs(n) ! qs~/qs.
89
90 ! real temp ! Temporary storage.
91 ! real es_prime_over_es ! es~/es
92 !
93 ! do i = 1,n
94 !------------------------------------------------------------------------
95 ! [3.0] Calculate saturation specific humidity increment:
96 !------------------------------------------------------------------------
97
98 ! temp = qs_prime_over_qs(i) / ( p(i) - rd_over_rv1 * es(i) )
99
100 ! es_prime_over_es = temp * p(i)
101
102 ! p_prime(i) = p_prime(i) - temp
103
104 !------------------------------------------------------------------------
105 ! [2.0] Calculate saturation vapour pressure increment:
106 !------------------------------------------------------------------------
107
108 ! temp = t(i) + es_gammakelvin
109
110 ! t_prime(i) = t_prime(i) + es_gammabeta * es_prime_over_es / ( temp * temp )
111 ! end do
112
113 ! end subroutine da_tp_to_qs_adj
114
115