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