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