da_balance_cycloterm_adj.inc
References to this file elsewhere.
1 subroutine da_balance_cycloterm_adj (rho, ub, vb, u, v, coefx, coefy, term_x, term_y)
2
3 !---------------------------------------------------------------------------
4 ! Purpose: Adjoint of da_balance_cycloterm
5 !---------------------------------------------------------------------------
6
7 implicit none
8
9 real, intent(in) :: rho(ims:ime,jms:jme) ! Density.
10 real, intent(in) :: ub(ims:ime,jms:jme) ! Background u wind
11 real, intent(in) :: vb(ims:ime,jms:jme) ! Background u wind
12 real, intent(in) :: term_x(ims:ime,jms:jme) ! x component of term
13 real, intent(in) :: term_y(ims:ime,jms:jme) ! y component of term
14 real, intent(in) :: coefx(ims:ime,jms:jme)
15 real, intent(in) :: coefy(ims:ime,jms:jme) ! Mulplicative coeff.
16
17 real, intent(inout) :: u(ims:ime,jms:jme) ! u wind increment
18 real, intent(inout) :: v(ims:ime,jms:jme) ! v wind increment
19
20 integer :: i, j ! Loop counters.
21 integer :: is, ie ! 1st dim. end points.
22 integer :: js, je ! 2nd dim. end points.
23 real :: data(ims:ime,jms:jme) ! Work array.
24
25 real :: var, varb, uar
26
27 if (trace_use) call da_trace_entry("da_balance_cycloterm_adj")
28
29 !---------------------------------------------------------------------------
30 ! [1.0] Initialise:
31 !---------------------------------------------------------------------------
32
33 ! Computation to check for edge of domain:
34 is = its; ie = ite; js = jts; je = jte
35 if (.not. global .and. its == ids) is = ids+1
36 if (.not. global .and. ite == ide) ie = ide-1
37 if (jts == jds) js = jds+1
38 if (jte == jde) je = jde-1
39
40 !---------------------------------------------------------------------------
41 ! [3.0] Calculate term_y = rho M ( u'dv/dx + v'dv/dy + udv'/dx + vdv'/dy ):
42 !---------------------------------------------------------------------------
43
44 ! [3.7] Multiply by rho and add to term_y
45
46 data(its:ite,jts:jte) = rho(its:ite,jts:jte) * term_y(its:ite,jts:jte)
47
48 if (.NOT. global) then
49
50 ! [3.6] Corner points:
51
52 if (its == ids .AND. jts == jds ) then
53 data(its,jts+1) = data(its,jts+1) + 0.5 * data(its,jts)
54 data(its+1,jts) = data(its+1,jts) + 0.5 * data(its,jts)
55 end if
56
57 if (ite == ide .AND. jts == jds ) then
58 data(ite-1,jts) = data(ite-1,jts) + 0.5 * data(ite,jts)
59 data(ite,jts+1) = data(ite,jts+1) + 0.5 * data(ite,jts)
60 end if
61
62 if (its == ids .AND. jte == jde ) then
63 data(its,jde-1) = data(its,jde-1) + 0.5 * data(its,jde)
64 data(its+1,jde) = data(its+1,jde) + 0.5 * data(its,jde)
65 end if
66
67 if (ite == ide .AND. jte == jde ) then
68 data(ite-1,jte) = data(ite-1,jte) + 0.5 * data(ite,jte)
69 data(ite,jte-1) = data(ite,jte-1) + 0.5 * data(ite,jte)
70 end if
71
72 ! [3.5] Right boundaries:
73
74 if (jte == jde ) then
75 j = jte
76
77 do i = is, ie
78 varb = 3.0*vb(i,j)-4.0*vb(i,j-1)+vb(i,j-2)
79
80 var = coefy(i,j)* vb(i,j) * data(i,j)
81 uar = coefx(i,j)* data(i,j) * ub(i,j)
82
83 u(i,j) = u(i,j) + coefx(i,j)*data(i,j) * ( vb(i+1,j) - vb(i-1,j) )
84 v(i,j) = v(i,j) + coefy(i,j)*data(i,j) * varb
85 v(i+1,j) = v(i+1,j) + uar
86 v(i-1,j) = v(i-1,j) - uar
87
88 v(i,j) = v(i,j) + 3.0*var
89 v(i,j-1) = v(i,j-1) -4.0*var
90 v(i,j-2) = v(i,j-2) + var
91 end do
92 end if
93
94 ! [3.4] Left boundaries:
95
96 if (jts == jds ) then
97 j = jts
98
99 do i = is, ie
100 varb = -3.0*vb(i,j)+4.0*vb(i,j+1)-vb(i,j+2)
101
102 var = coefy(i,j)*vb(i,j) * data(i,j)
103 uar = coefx(i,j)*ub(i,j) * data(i,j)
104
105 v(i,j) = v(i,j) + coefy(i,j)*data(i,j) * varb
106 v(i+1,j) = v(i+1,j) + uar
107 v(i-1,j) = v(i-1,j) - uar
108
109 v(i,j) = v(i,j) - 3.0*var
110 v(i,j+1) = v(i,j+1) +4.0*var
111 v(i,j+2) = v(i,j+2) - var
112 end do
113 end if
114
115 ! [3.3] Top boundaries:
116
117 if (ite == ide ) then
118 i = ite
119
120 do j = js, je
121 varb = 3.0*vb(i,j)-4.0*vb(i-1,j)+vb(i-2,j)
122
123 var = coefx(i,j)* ub(i,j) * data(i,j)
124 uar = coefy(i,j)* vb(i,j) * data(i,j)
125
126 u(i,j) = u(i,j) + coefx(i,j)*data(i,j) * varb
127 v(i,j) = v(i,j) + coefy(i,j)*data(i,j) * ( vb(i,j+1) - vb(i,j-1) )
128 v(i,j+1) = v(i,j+1) + uar
129 v(i,j-1) = v(i,j-1) - uar
130
131 v(i,j) = v(i,j) + 3.0*var
132 v(i-1,j) = v(i-1,j) -4.0**var
133 v(i-2,j) = v(i-2,j) + var
134 end do
135 end if
136
137 ! [3.2] Bottom boundaries:
138
139 if (its == ids ) then
140 i = its
141
142 do j = js, je
143 varb = -3.0*vb(i,j)+4.0*vb(i+1,j)-vb(i+2,j)
144
145 var = coefx(i,j)* ub(i,j) * data(i,j)
146 uar = coefy(i,j)* vb(i,j) * data(i,j)
147
148 u(i,j) = u(i,j) + coefx(i,j)*data(i,j) * varb
149 v(i,j) = v(i,j) + coefy(i,j)*data(i,j) * ( vb(i,j+1) - vb(i,j-1) )
150 v(i,j+1) = v(i,j+1) + uar
151 v(i,j-1) = v(i,j-1) - uar
152
153 v(i,j) = v(i,j) - 3.0*var
154 v(i+1,j) = v(i+1,j) +4.0**var
155 v(i+2,j) = v(i+2,j) - var
156 end do
157 end if
158 end if ! not global
159
160 ! [3.1] Interior points:
161
162 do j = je, js, -1
163 do i = ie, is, -1
164 uar = coefx(i,j) * ub(i,j) * data(i,j)
165 var = coefy(i,j) * vb(i,j) * data(i,j)
166
167 u(i,j) = u(i,j) + coefx(i,j)*data(i,j)*( vb(i+1,j) - vb(i-1,j) )
168 v(i,j) = v(i,j) + coefy(i,j)*data(i,j)*( vb(i,j+1) - vb(i,j-1) )
169 v(i+1,j) = v(i+1,j) + uar
170 v(i-1,j) = v(i-1,j) - uar
171 v(i,j+1) = v(i,j+1) + var
172 v(i,j-1) = v(i,j-1) - var
173 end do
174 end do
175
176 !---------------------------------------------------------------------------
177 ! [2.0] Calculate term_x = rho M ( u'du/dx + v'du/dy + udu'/dx + vdu'/dy ):
178 !---------------------------------------------------------------------------
179
180 ! [2.7] Multiply by rho and add to term_x:
181
182 data(its:ite,jts:jte) = rho(its:ite,jts:jte) * term_x(its:ite,jts:jte)
183
184 if( .NOT. global) then
185 ! [2.6] Corner points:
186
187 if (its == ids .AND. jts == jds ) then
188 data(its,jts+1) = data(its,jts+1) + 0.5 * data(its,jts)
189 data(its+1,jts) = data(its+1,jts) + 0.5 * data(its,jts)
190 end if
191
192 if (ite == ide .AND. jts == jds ) then
193 data(ite-1,jts) = data(ite-1,jts) + 0.5 * data(ite,jts)
194 data(ite,jts+1) = data(ite,jts+1) + 0.5 * data(ite,jts)
195 end if
196
197 if (its == ids .AND. jte == jde ) then
198 data(its,jde-1) = data(its,jde-1) + 0.5 * data(its,jde)
199 data(its+1,jde) = data(its+1,jde) + 0.5 * data(its,jde)
200 end if
201
202 if (ite == ide .AND. jte == jde ) then
203 data(ite-1,jte) = data(ite-1,jte) + 0.5 * data(ite,jte)
204 data(ite,jte-1) = data(ite,jte-1) + 0.5 * data(ite,jte)
205 end if
206
207 ! [2.5] Right boundaries:
208
209 if (jte == jde ) then
210 j = jte
211
212 do i = is, ie
213 varb = 3.0*ub(i,j)-4.0*ub(i,j-1)+ub(i,j-2)
214 var = coefy(i,j) * vb(i,j) * data(i,j)
215 uar = coefx(i,j) * ub(i,j) * data(i,j)
216
217 u(i+1,j) = u(i+1,j) + uar
218 u(i-1,j) = u(i-1,j) - uar
219 v(i,j) = v(i,j) + coefy(i,j)*data(i,j) * varb
220 u(i,j) = u(i,j) + coefx(i,j)*data(i,j) * ( ub(i+1,j) - ub(i-1,j) )
221
222 u(i,j) = u(i,j) + 3.0*var
223 u(i,j-1) = u(i,j-1) -4.0*var
224 u(i,j-2) = u(i,j-2) + var
225 end do
226 end if
227
228 ! [2.4] Left boundaries:
229
230 if (jts == jds ) then
231 j = jts
232
233 do i = is, ie
234 varb = -3.0*ub(i,j)+4.0*ub(i,j+1)-ub(i,j+2)
235 var = coefy(i,j)*vb(i,j) * data(i,j)
236 uar = coefx(i,j)*ub(i,j) * data(i,j)
237
238 u(i+1,j) = u(i+1,j) + uar
239 u(i-1,j) = u(i-1,j) - uar
240 v(i,j) = v(i,j) + coefy(i,j)*data(i,j) * varb
241 u(i,j) = u(i,j) + coefx(i,j)*data(i,j) * ( ub(i+1,j) - ub(i-1,j) )
242
243 u(i,j) = u(i,j) - 3.0*var
244 u(i,j+1) = u(i,j+1) +4.0*var
245 u(i,j+2) = u(i,j+2) - var
246 end do
247 end if
248
249 ! [2.3] Top boundaries:
250
251 if (ite == ide ) then
252 i = ite
253
254 do j = js, je
255 varb = 3.0*ub(i,j)-4.0*ub(i-1,j)+ub(i-2,j)
256 var = coefx(i,j)*ub(i,j) * data(i,j)
257 uar = coefy(i,j)*vb(i,j) * data(i,j)
258
259 u(i,j+1) = u(i,j+1) + uar
260 u(i,j-1) = u(i,j-1) - uar
261 v(i,j) = v(i,j) + coefy(i,j)*data(i,j) * ( ub(i,j+1) - ub(i,j-1) )
262 u(i,j) = u(i,j) + coefx(i,j)*data(i,j) * varb
263
264 u(i,j) = u(i,j) + 3.0*var
265 u(i-1,j) = u(i-1,j) - 4.0*var
266 u(i-2,j) = u(i-2,j) + var
267 end do
268 end if
269
270 ! [2.2] Bottom boundaries:
271
272 if (its == ids ) then
273 i = its
274
275 do j = js, je
276 varb = -3.0*ub(i,j)+4.0*ub(i+1,j)-ub(i+2,j)
277 var = coefy(i,j)*ub(i,j) * data(i,j)
278 uar = coefy(i,j)*vb(i,j) * data(i,j)
279
280 u(i,j+1) = u(i,j+1) + uar
281 u(i,j-1) = u(i,j-1) - uar
282 v(i,j) = v(i,j) + coefy(i,j)*data(i,j) * ( ub(i,j+1) - ub(i,j-1) )
283 u(i,j) = u(i,j) + coefx(i,j)*data(i,j) * varb
284
285 u(i,j) = u(i,j) - 3.0*var
286 u(i+1,j) = u(i+1,j) + 4.0*var
287 u(i+2,j) = u(i+2,j) - var
288 end do
289 end if
290 end if ! not global
291
292 ! [2.1] Interior points:
293
294 do j = je, js, -1
295 do i = ie, is, -1
296 uar = coefx(i,j) * ub(i,j) * data(i,j)
297 var = coefy(i,j) * vb(i,j) * data(i,j)
298
299 u(i,j) = u(i,j) + coefx(i,j)*( ub(i+1,j) - ub(i-1,j) ) * data(i,j)
300 v(i,j) = v(i,j) + coefy(i,j)*( ub(i,j+1) - ub(i,j-1) ) * data(i,j)
301 u(i+1,j) = u(i+1,j) + uar
302 u(i-1,j) = u(i-1,j) - uar
303 u(i,j+1) = u(i,j+1) + var
304 u(i,j-1) = u(i,j-1) - var
305 end do
306 end do
307
308 if (trace_use) call da_trace_exit("da_balance_cycloterm_adj")
309
310 end subroutine da_balance_cycloterm_adj
311
312